translate.c

Go to the documentation of this file.
00001 
00006 /* $Id: translate.c,v 1.10 2007/03/06 19:52:18 seymour Exp $ */
00007 /* $UTK_Copyright: $ */
00008 
00009 #include <stdio.h>
00010 #include <stdlib.h>
00011 #include <string.h>
00012 
00013 #include "idl_export.h"
00014 #include "grpc.h"
00015 #include "translate.h"
00016 
00018 UCHAR gs_idl_types[] = {
00019   IDL_TYP_LONG,
00020   IDL_TYP_FLOAT,
00021   IDL_TYP_DOUBLE,
00022   IDL_TYP_COMPLEX,
00023   IDL_TYP_DCOMPLEX,
00024   IDL_TYP_STRING,
00025   IDL_TYP_UNDEF
00026 };
00027 
00036 void
00037 print_array(int m, int n, double *A)
00038 {
00039   int i, j;
00040   for(i = 0; i < m; i++) {
00041     for(j = 0; j < n; j++) {
00042       printf("%f ", *(A+i*n+j));
00043     }
00044     printf("\n");
00045   }
00046 }
00047 
00056 int
00057 trunc_fname(char *fname)
00058 {
00059   char *p;
00060 
00061   p = strchr(fname, '(');
00062 
00063   if(p)
00064     *p = 0;
00065 
00066   return 0;
00067 }
00068 
00076 void
00077 die_type_mismatch(IDL_VPTR arg_idl, gs_argument_t *argp)
00078 {
00079   char msg[1024];
00080 
00081   sprintf(msg, "Type mismatch in argument:");
00082   IDL_Message(IDL_M_GENERIC, IDL_MSG_INFO, msg);
00083 
00084   sprintf(msg, "    IDL arg name is '%s', corresponding GridSolve arg name is '%s'",
00085      IDL_VarName(arg_idl), argp->name);
00086   IDL_Message(IDL_M_GENERIC, IDL_MSG_INFO, msg);
00087 
00088   sprintf(msg, "    provided type = %s, expected type = %s",
00089      IDL_TypeName[arg_idl->type], IDL_TypeName[gs_idl_types[argp->datatype]]);
00090   IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, msg);
00091 }
00092 
00103 int
00104 convert_idl(gs_problem_t *pd, IDL_VPTR *argv_idl)
00105 {
00106   gs_argument_t *argp;
00107   int i;
00108 
00109   for(i=0, argp = pd->arglist; argp != NULL; argp = argp->next) {
00110     if(argp->inout != GS_WORKSPACE) {
00111       assign_arg(argp, argv_idl[i]);
00112       i++;
00113     }
00114   }
00115 
00116   return 0;
00117 }
00118 
00128 char **
00129 create_packed_file_array(gs_argument_t *argp, IDL_VPTR arg_idl)
00130 {
00131   char **result;
00132   int i, nelem;
00133 
00134   IDL_ENSURE_ARRAY(arg_idl);
00135 
00136   nelem = arg_idl->value.arr->n_elts;
00137 
00138   result = (char **)malloc(nelem * sizeof(char *));
00139 
00140   if(!result)
00141     IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
00142        "Error: malloc failed in create_packed_file_array().");
00143 
00144   for(i=0;i<nelem;i++)
00145     result[i] = ((IDL_STRING *)arg_idl->value.arr->data)[i].s;
00146 
00147   return result;
00148 }
00149 
00157 void
00158 free_varout(UCHAR *mem)
00159 {
00160   free(mem);
00161 }
00162 
00172 int
00173 find_varout_vector_len(gs_problem_t *pd, gs_argument_t *argp)
00174 {
00175   gs_argument_t *carg;
00176 
00177   for(carg = pd->arglist; carg; carg=carg->next) {
00178     if((carg->inout == GS_OUT) && (carg->datatype == GS_INT) &&
00179        (carg->objecttype == GS_SCALAR) &&
00180        !strcasecmp(carg->name, argp->rowexp))
00181       return carg->scalar_val.int_val;
00182   }
00183 
00184   return -1;
00185 }
00186 
00197 IDL_VPTR
00198 get_idl_string_from_unterminated_char(int len, char *str)
00199 {
00200   char *nt_str;
00201   IDL_VPTR tmp;
00202 
00203   /* the variable length char array from gridsolve is not guaranteed
00204    * to be null terminated, so do that before creating the IDL string.
00205    */
00206   nt_str = (char *)malloc(len + 1);
00207   if(!nt_str)
00208     IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
00209        "Error: malloc failed in get_idl_string_from_unterminated_char().");
00210 
00211   strncpy(nt_str, str, len);
00212   nt_str[len] = 0;
00213 
00214   tmp = IDL_StrToSTRING(nt_str);
00215 
00216   return tmp;
00217 }
00218 
00227 void
00228 copy_varout(gs_problem_t *pd, gs_argument_t *argp, IDL_VPTR arg_idl)
00229 {
00230   IDL_MEMINT dims[2];
00231   IDL_VPTR tmp;
00232 
00233   if(argp->objecttype == GS_VECTOR) {
00234     int veclen;
00235 
00236     veclen = find_varout_vector_len(pd, argp);
00237 
00238     if(veclen < 0)
00239       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
00240          "Error: could not determine VAROUT length.");
00241 
00242     if(argp->datatype == GS_CHAR) {
00243       tmp = get_idl_string_from_unterminated_char(veclen, (char *)(arg_idl->value.arr));
00244       IDL_VarCopy(tmp, arg_idl);
00245     }
00246     else {
00247       dims[0] = veclen;
00248       tmp = IDL_ImportArray(1, dims, gs_idl_types[argp->datatype],
00249         (char *)arg_idl->value.arr, free_varout, NULL);
00250       IDL_VarCopy(tmp, arg_idl);
00251     }
00252   }
00253   else {
00254     char msg[2048];
00255 
00256     sprintf(msg, "Error in arg %s: VAROUT only supported for vectors.",
00257       IDL_VarName(arg_idl));
00258     IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, msg);
00259   }
00260 
00261   return;
00262 }
00263 
00274 int
00275 assign_arg(gs_argument_t* argp, IDL_VPTR argv_idl)
00276 {
00277   if(argp->inout == GS_IN && argp->objecttype == GS_SCALAR) {
00278     IDL_ENSURE_SCALAR(argv_idl);
00279     copy_scalar_input(argp, argv_idl);
00280     return 0;
00281   }
00282 
00283   if(argp->objecttype == GS_FILE) {
00284     argp->data = IDL_VarGetString(argv_idl);
00285     return 0;
00286   }
00287 
00288   if(argp->objecttype == GS_PACKEDFILE) {
00289     argp->data = create_packed_file_array(argp, argv_idl);
00290     return 0;
00291   }
00292 
00293   if(argp->objecttype == GS_SPARSEMATRIX) {
00294     IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
00295          "Error: Sparse matrices not supported yet.");
00296   }
00297 
00298   switch(argp->inout) {
00299     case GS_IN:
00300       /* Input passed by reference */
00301       copy_ptr_input(argp, argv_idl);
00302       break;
00303     case GS_INOUT:
00304       /* Inout passed by reference */
00305       IDL_EXCLUDE_EXPR(argv_idl);
00306       check_ptr_inout(argp, argv_idl);
00307       break;
00308     case GS_OUT:
00309       /* Output passed by reference */
00310       IDL_EXCLUDE_EXPR(argv_idl);
00311       copy_ptr_output(argp, argv_idl);
00312       break;
00313     case GS_WORKSPACE:
00314       /* skip workspace arguments */
00315       argp->data = NULL;
00316       break;
00317     case GS_VAROUT:
00318       argp->data = &(argv_idl->value.arr);
00319       break;
00320     default:
00321       /* shouldn't hit this case since we checked for bad 
00322        * values already.
00323        */
00324       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
00325          "Error: Bad arg inout type");
00326   }
00327 
00328   return 0;
00329 }
00330 
00341 int
00342 copy_scalar_input(gs_argument_t* argp, IDL_VPTR arg_idl)
00343 {
00344   switch(argp->datatype) {
00345     case GS_INT: 
00346       argp->scalar_val.int_val = IDL_LongScalar(arg_idl);
00347       break;
00348     case GS_CHAR:
00349       argp->scalar_val.char_val = *IDL_VarGetString(arg_idl);
00350       break;
00351     case GS_FLOAT:
00352       argp->scalar_val.float_val = (float) IDL_DoubleScalar(arg_idl);
00353       break;
00354     case GS_DOUBLE:
00355       argp->scalar_val.double_val = IDL_DoubleScalar(arg_idl);
00356       break;
00357     case GS_SCOMPLEX:
00358       if(arg_idl->type == IDL_TYP_COMPLEX) {
00359         argp->scalar_val.scomplex_val.r = arg_idl->value.cmp.r;
00360         argp->scalar_val.scomplex_val.i = arg_idl->value.cmp.i;
00361       }
00362       else if(arg_idl->type == IDL_TYP_DCOMPLEX) {
00363         argp->scalar_val.scomplex_val.r = (float)arg_idl->value.dcmp.r;
00364         argp->scalar_val.scomplex_val.i = (float)arg_idl->value.dcmp.i;
00365       }
00366       else {
00367         argp->scalar_val.scomplex_val.r = (float) IDL_DoubleScalar(arg_idl);
00368         argp->scalar_val.scomplex_val.i = 0.0;
00369       }
00370       break;
00371     case GS_DCOMPLEX:
00372       if(arg_idl->type == IDL_TYP_COMPLEX) {
00373         argp->scalar_val.dcomplex_val.r = (double)arg_idl->value.cmp.r;
00374         argp->scalar_val.dcomplex_val.i = (double)arg_idl->value.cmp.i;
00375       }
00376       else if(arg_idl->type == IDL_TYP_DCOMPLEX) {
00377         argp->scalar_val.dcomplex_val.r = arg_idl->value.dcmp.r;
00378         argp->scalar_val.dcomplex_val.i = arg_idl->value.dcmp.i;
00379       }
00380       else {
00381         argp->scalar_val.dcomplex_val.r = IDL_DoubleScalar(arg_idl);
00382         argp->scalar_val.dcomplex_val.i = 0.0;
00383       }
00384       break;
00385     default:
00386       die_type_mismatch(arg_idl, argp);
00387   }
00388 
00389   argp->data = &(argp->scalar_val);      
00390 
00391   return 0;
00392 }
00393 
00405 int
00406 copy_scalar_output(IDL_VPTR arg_idl, gs_argument_t* argp)
00407 {
00408   double dval_r = 0.0, dval_i = 0.0;
00409 
00410   switch(argp->datatype) {
00411     case GS_INT:
00412       dval_r = (double)argp->scalar_val.int_val;
00413       break;
00414     case GS_CHAR:
00415       dval_r = (double)argp->scalar_val.char_val;
00416       break;
00417     case GS_FLOAT:
00418       dval_r = (double)argp->scalar_val.float_val;
00419       break;
00420     case GS_DOUBLE:
00421       dval_r = (double)argp->scalar_val.double_val;
00422       break;
00423     case GS_SCOMPLEX:
00424       dval_r = (double)argp->scalar_val.scomplex_val.r;
00425       dval_i = (double)argp->scalar_val.scomplex_val.i;
00426       break;
00427     case GS_DCOMPLEX:
00428       dval_r = (double)argp->scalar_val.dcomplex_val.r;
00429       dval_i = (double)argp->scalar_val.dcomplex_val.i;
00430       break;
00431     default:
00432       die_type_mismatch(arg_idl, argp);
00433   }
00434 
00435   if(arg_idl->type == IDL_TYP_UNDEF)
00436     arg_idl->type = gs_idl_types[argp->datatype];
00437 
00438   switch(arg_idl->type) {
00439     case IDL_TYP_INT:
00440       arg_idl->value.i = (short) dval_r;
00441       break;
00442     case IDL_TYP_LONG:
00443       arg_idl->value.l = (int) dval_r;
00444       break;
00445     case IDL_TYP_STRING:
00446       arg_idl->value.str.slen = 1;
00447       arg_idl->value.str.s[0] = (char) dval_r;
00448       arg_idl->value.str.s[1] = (char) 0;
00449       break;
00450     case IDL_TYP_FLOAT:
00451       arg_idl->value.f = (float) dval_r;
00452       break;
00453     case IDL_TYP_DOUBLE:
00454       arg_idl->value.d = dval_r;
00455       break;
00456     case IDL_TYP_COMPLEX:
00457       arg_idl->value.cmp.r = (float) dval_r;
00458       arg_idl->value.cmp.i = (float) dval_i;
00459       break;
00460     case IDL_TYP_DCOMPLEX:
00461       arg_idl->value.dcmp.r = dval_r;
00462       arg_idl->value.dcmp.i = dval_i;
00463       break;
00464     default:
00465       die_type_mismatch(arg_idl, argp);
00466   }
00467 
00468   return 0;
00469 }
00470 
00481 int
00482 copy_ptr_input(gs_argument_t* argp, IDL_VPTR arg_idl)
00483 {
00484   switch(argp->objecttype) {
00485     case GS_VECTOR:
00486     case GS_MATRIX:
00487       translate_array_input(argp, arg_idl); /*include string*/
00488       break;
00489     case GS_SCALAR:
00490     case GS_SPARSEMATRIX:
00491     case GS_FILE:
00492     case GS_PACKEDFILE:
00493       /* above cases should have been handled before calling this routine */
00494     default:
00495       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, "Error: unknown object type!");
00496   }
00497 
00498   return 0;
00499 }
00500 
00511 int
00512 check_ptr_inout(gs_argument_t* argp, IDL_VPTR arg_idl)
00513 {
00514   if(gs_idl_types[argp->datatype] != arg_idl->type)
00515     die_type_mismatch(arg_idl, argp);
00516 
00517   switch(argp->objecttype) {
00518     case GS_VECTOR:
00519       if(argp->datatype == GS_CHAR) {
00520         /* dup the string in case it was assigned from a constant string */
00521 
00522         argp->data = strdup(IDL_VarGetString(arg_idl));
00523       }
00524       else
00525         argp->data = arg_idl->value.arr->data;
00526       break;
00527     case GS_MATRIX:
00528       if(argp->datatype == GS_CHAR)
00529         translate_array_input(argp, arg_idl);
00530       else
00531         argp->data = arg_idl->value.arr->data;
00532       break;
00533     case GS_SCALAR:
00534       copy_scalar_input(argp, arg_idl);
00535       break;
00536     case GS_SPARSEMATRIX:
00537     case GS_FILE:
00538     case GS_PACKEDFILE:
00539       /* above cases should have been handled before calling this routine */
00540     default:
00541       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, "Error: unknown/unsupported object type!");
00542   }
00543 
00544   return 0;
00545 }
00546 
00553 int
00554 create_linear_char_matrix(IDL_VPTR arg_idl, gs_argument_t *argp)
00555 {
00556   char *char_buf, *str;
00557   int i, j, len, max_len, n_elts;
00558   int idl_type, *argv;
00559   IDL_ARRAY *arr;
00560 
00561   arr = arg_idl->value.arr;
00562   idl_type = arg_idl->type;
00563   argv = (int*) &argp->data;
00564 
00565   max_len = 0;
00566 
00567   for(i=0;i<arr->n_elts;i++) {
00568     len = strlen(((IDL_STRING *)arr->data)[i].s);
00569     if(len > max_len)
00570       max_len = len;
00571   }
00572   char_buf = (char *)malloc(arr->n_elts * max_len);
00573 
00574   if(!char_buf)
00575     IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
00576       "Error: malloc failed in create_linear_char_matrix()");
00577 
00578   n_elts = arr->n_elts;
00579 
00580   for(i=0;i<n_elts;i++) {
00581     str = ((IDL_STRING *)arr->data)[i].s;
00582     len = strlen(str);
00583 
00584     for(j=0;j<max_len;j++) {
00585       if(j >= len)
00586         char_buf[j*n_elts + i] = ' ';
00587       else
00588         char_buf[j*n_elts + i] = str[j];
00589     }
00590   }
00591 
00592   *argv = (int)char_buf;
00593 
00594   return 0;
00595 }
00596 
00601 int
00602 copy_char_vector_output(IDL_VPTR arg_idl, gs_argument_t* argp)
00603 {
00604   IDL_VPTR tmp;
00605 
00606   tmp = get_idl_string_from_unterminated_char(argp->rows, (char *)argp->data);
00607   IDL_VarCopy(tmp, arg_idl);
00608 
00609   return 0;
00610 }
00611 
00616 int
00617 copy_char_matrix_output(IDL_VPTR arg_idl, gs_argument_t* argp)
00618 {
00619   char *tmpstr, *char_buf;
00620   int i, j, len;
00621   IDL_STRING *str_arr = 0 ;
00622   IDL_VPTR arr_data;
00623   IDL_MEMINT dims[1];
00624 
00625   char_buf = argp->data;
00626   dims[0] = argp->rows;
00627   str_arr = (IDL_STRING *)IDL_MakeTempArray( IDL_TYP_STRING,
00628      1, dims, IDL_BARR_INI_NOP, &arr_data);
00629 
00630   for(i=0;i<argp->rows;i++) {
00631     len = strlen(((IDL_STRING *)arg_idl->value.arr->data)[i].s);
00632 
00633     tmpstr = (char *)calloc(len + 1, 1);
00634     if(!tmpstr)
00635       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
00636         "Error: malloc failed in copy_char_matrix_output()");
00637 
00638     for(j=0;j<argp->cols;j++) {
00639       if(j < len)
00640         tmpstr[j] = char_buf[j*argp->rows + i];
00641     }
00642 
00643     IDL_StrStore(&(str_arr[i]), tmpstr);
00644   }
00645 
00646   IDL_VarCopy(arr_data, arg_idl);
00647 
00648   return 0;
00649 }
00650 
00663 int
00664 translate_int_array(IDL_VPTR arg_idl, gs_argument_t *argp)
00665 {
00666   int idl_type, *int_buf, *argv;
00667   IDL_ARRAY *arr;
00668 
00669   arr = arg_idl->value.arr;
00670   idl_type = arg_idl->type;
00671   argv = (int*) &argp->data;
00672 
00673   if(idl_type == IDL_TYP_INT || idl_type == IDL_TYP_BYTE) {
00674     int_buf  = (int* )malloc(arr->n_elts*sizeof(int));
00675 
00676     if(!int_buf)
00677       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
00678         "Error: malloc failed in translate_int_array()");
00679 
00680     if(idl_type == IDL_TYP_INT)
00681       COPY_A_TO_B(short, int, arr->n_elts, arr->data, int_buf)
00682     else
00683       COPY_A_TO_B(unsigned char, int, arr->n_elts, arr->data, int_buf)
00684 
00685     *argv = (int)int_buf;
00686   }
00687   else  if(idl_type == IDL_TYP_LONG) {
00688     *argv = (int)arr->data;
00689   }
00690   else {
00691     die_type_mismatch(arg_idl, argp);
00692   }
00693 
00694   return 0;
00695 }
00696 
00709 int
00710 translate_dcomplex_array(IDL_VPTR arg_idl, gs_argument_t *argp)
00711 {
00712   IDL_DCOMPLEX*   pdcomplex;
00713   int idl_type, *argv;
00714   IDL_ARRAY *arr;
00715 
00716   arr = arg_idl->value.arr;
00717   idl_type = arg_idl->type;
00718   argv = (int*) &argp->data;
00719 
00720   if(idl_type == IDL_TYP_COMPLEX || idl_type == IDL_TYP_BYTE
00721       || idl_type == IDL_TYP_INT  || idl_type == IDL_TYP_LONG
00722       || idl_type == IDL_TYP_FLOAT|| idl_type == IDL_TYP_DOUBLE) {
00723     int i;
00724     pdcomplex  = (IDL_DCOMPLEX* )malloc(sizeof(IDL_DCOMPLEX)*arr->n_elts);
00725 
00726     if(!pdcomplex)
00727       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
00728          "Error: malloc failed in translate_dcomplex_array()");
00729 
00730     if(idl_type == IDL_TYP_COMPLEX) {
00731       for(i = 0; i < arr->n_elts; i++) {
00732         COPY_A_TO_B(float, double, 1, arr->data+2*i, &(pdcomplex+i)->r);
00733         COPY_A_TO_B(float, double, 1, arr->data+2*i+1, &(pdcomplex+i)->i);
00734       }
00735     }
00736     else if(idl_type == IDL_TYP_DOUBLE) {
00737       for(i = 0; i < arr->n_elts; i++) {
00738         COPY_A_TO_B(double, double, 1, arr->data+i, &(pdcomplex+i)->r);
00739         (pdcomplex+i)->i = 0;
00740       }
00741     }
00742     else if(idl_type == IDL_TYP_FLOAT) {
00743       for(i = 0; i < arr->n_elts; i++) {
00744         COPY_A_TO_B(float, double, 1, arr->data+i, &(pdcomplex+i)->r);
00745         (pdcomplex+i)->i = 0;
00746       }
00747     }
00748     else if(idl_type == IDL_TYP_LONG) {
00749       for(i = 0; i < arr->n_elts; i++) {
00750         COPY_A_TO_B(int, double, 1, arr->data+i, &(pdcomplex+i)->r);
00751         (pdcomplex+i)->i = 0;
00752       }
00753     }
00754     else if(idl_type == IDL_TYP_INT) {
00755       for(i = 0; i < arr->n_elts; i++) {
00756         COPY_A_TO_B(short, double, 1, arr->data+i, &(pdcomplex+i)->r);
00757         (pdcomplex+i)->i = 0;
00758       }
00759     }
00760     else if(idl_type == IDL_TYP_BYTE) {
00761       for(i = 0; i < arr->n_elts; i++) {
00762         COPY_A_TO_B(unsigned char, double, 1, arr->data+i, &(pdcomplex+i)->r);
00763         (pdcomplex+i)->i = 0;
00764       }
00765     }
00766     *argv = (int)pdcomplex;
00767   }
00768   else if(idl_type == IDL_TYP_DCOMPLEX) {
00769     *argv = (int) arr->data;
00770   }
00771   else
00772     die_type_mismatch(arg_idl, argp);
00773 
00774   return 0;
00775 }
00776 
00789 int
00790 translate_scomplex_array(IDL_VPTR arg_idl, gs_argument_t *argp)
00791 {
00792   IDL_COMPLEX*    pcomplex;
00793   int idl_type, *argv;
00794   IDL_ARRAY *arr;
00795 
00796   arr = arg_idl->value.arr;
00797   idl_type = arg_idl->type;
00798   argv = (int*) &argp->data;
00799 
00800   if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT
00801       || idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT
00802       || idl_type == IDL_TYP_DOUBLE) {
00803     int i;
00804     pcomplex  = (IDL_COMPLEX* )malloc(sizeof(IDL_COMPLEX)*arr->n_elts);
00805 
00806     if(!pcomplex)
00807       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
00808         "Error: malloc failed in translate_scomplex_array()");
00809 
00810     if(idl_type == IDL_TYP_DOUBLE) {
00811       for(i = 0; i < arr->n_elts; i++) {
00812         COPY_A_TO_B(double, double, 1, arr->data+i,   &(pcomplex+i)->r);
00813         (pcomplex+i)->i = 0;
00814       }
00815     }
00816     else if(idl_type == IDL_TYP_FLOAT) {
00817       for(i = 0; i < arr->n_elts; i++) {
00818         COPY_A_TO_B(float, double, 1, arr->data+i,   &(pcomplex+i)->r);
00819         (pcomplex+i)->i = 0;
00820       }
00821     }
00822     else if(idl_type == IDL_TYP_LONG) {
00823       for(i = 0; i < arr->n_elts; i++) {
00824         COPY_A_TO_B(int, double, 1, arr->data+i,   &(pcomplex+i)->r);
00825         (pcomplex+i)->i = 0;
00826       }
00827     }
00828     else if(idl_type == IDL_TYP_INT) {
00829       for(i = 0; i < arr->n_elts; i++) {
00830         COPY_A_TO_B(short, double, 1, arr->data+i,   &(pcomplex+i)->r);
00831         (pcomplex+i)->i = 0;
00832       }
00833     }
00834     else if(idl_type == IDL_TYP_BYTE) {
00835       for(i = 0; i < arr->n_elts; i++) {
00836           COPY_A_TO_B(unsigned char, double, 1, arr->data+i,   &(pcomplex+i)->r);
00837         (pcomplex+i)->i = 0;
00838       }
00839     }
00840     *argv = (int)pcomplex;
00841   }
00842   else if(idl_type == IDL_TYP_COMPLEX) {/* matched! */
00843     *argv = (int) arr->data;
00844   }
00845   else
00846     die_type_mismatch(arg_idl, argp);
00847 
00848   return 0;
00849 }
00850 
00863 int
00864 translate_double_array(IDL_VPTR arg_idl, gs_argument_t *argp)
00865 {
00866   double *dbl_buf;
00867   int idl_type, *argv;
00868   IDL_ARRAY *arr;
00869 
00870   arr = arg_idl->value.arr;
00871   idl_type = arg_idl->type;
00872   argv = (int*) &argp->data;
00873 
00874   if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT ||
00875       idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT) {
00876     dbl_buf  = (double* )malloc(arr->n_elts*sizeof(double));
00877 
00878     if(!dbl_buf)
00879       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
00880          "Error: malloc failed in translate_double_array()");
00881 
00882     if(idl_type == IDL_TYP_BYTE)
00883       COPY_A_TO_B(unsigned char, double, arr->n_elts, arr->data, dbl_buf)
00884     else if(idl_type == IDL_TYP_INT)
00885       COPY_A_TO_B(short, double, arr->n_elts, arr->data, dbl_buf)
00886     else if(idl_type == IDL_TYP_LONG)
00887       COPY_A_TO_B(int, double, arr->n_elts, arr->data, dbl_buf)
00888     else
00889       COPY_A_TO_B(float, double, arr->n_elts, arr->data, dbl_buf)
00890     *argv = (int)dbl_buf;
00891   }
00892   else if(idl_type == IDL_TYP_DOUBLE) {
00893     *argv = (int)arr->data;
00894   }
00895   else
00896     die_type_mismatch(arg_idl, argp);
00897 
00898   return 0;
00899 }
00900 
00913 int
00914 translate_float_array(IDL_VPTR arg_idl, gs_argument_t *argp)
00915 {
00916   float *flt_buf;
00917   int idl_type, *argv;
00918   IDL_ARRAY *arr;
00919 
00920   arr = arg_idl->value.arr;
00921   idl_type = arg_idl->type;
00922   argv = (int*) &argp->data;
00923 
00924   if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT ||
00925       idl_type == IDL_TYP_LONG) {
00926     flt_buf  = (float* )malloc(arr->n_elts*sizeof(float));
00927 
00928     if(!flt_buf)
00929       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
00930         "Error: malloc failed in translate_float_array()");
00931 
00932     if(idl_type == IDL_TYP_BYTE)
00933       COPY_A_TO_B(unsigned char, float, arr->n_elts, arr->data, flt_buf)
00934     else if(idl_type == IDL_TYP_INT)
00935       COPY_A_TO_B(short, float, arr->n_elts, arr->data, flt_buf)
00936     else
00937       COPY_A_TO_B(int, float, arr->n_elts, arr->data, flt_buf)
00938     *argv = (int) flt_buf;
00939   }
00940   else if(idl_type == IDL_TYP_FLOAT) {
00941     *argv = (int)arr->data;
00942   }
00943   else
00944     die_type_mismatch(arg_idl, argp);
00945 
00946   return 0;
00947 }
00948 
00959 int
00960 translate_array_input(gs_argument_t* argp, IDL_VPTR arg_idl)
00961 {
00962   int rv;
00963 
00964   rv = 0;
00965 
00966   if(argp->datatype != GS_CHAR)
00967     IDL_ENSURE_ARRAY(arg_idl);
00968 
00969   switch(argp->datatype) {
00970     case GS_CHAR: /* string */
00971       if(argp->objecttype == GS_MATRIX)
00972         rv = create_linear_char_matrix(arg_idl, argp);
00973       else
00974         argp->data = IDL_VarGetString(arg_idl);
00975       break;
00976     case GS_INT: /* int array */
00977       rv = translate_int_array(arg_idl, argp);
00978       break;
00979     case GS_DCOMPLEX: /* dcomplex array */
00980       rv = translate_dcomplex_array(arg_idl, argp);
00981       break;
00982     case GS_SCOMPLEX: /* complex array */
00983       rv = translate_scomplex_array(arg_idl, argp);
00984       break;
00985     case GS_DOUBLE: /* double array */
00986       rv = translate_double_array(arg_idl, argp);
00987       break;
00988     case GS_FLOAT: /* float array */
00989       rv = translate_float_array(arg_idl, argp);
00990       break;
00991     default:
00992       die_type_mismatch(arg_idl, argp);
00993   }
00994 
00995   return rv;
00996 }
00997 
01008 int
01009 copy_ptr_output(gs_argument_t* argp, IDL_VPTR arg_idl)
01010 {
01011   switch(argp->objecttype) {
01012     case GS_VECTOR:
01013     case GS_MATRIX:
01014       if((gs_idl_types[argp->datatype] != arg_idl->type) && (argp->datatype != GS_CHAR))
01015         die_type_mismatch(arg_idl, argp);
01016       translate_array_output(argp, arg_idl);
01017       break;
01018     case GS_SCALAR:
01019       /* GS arg has its own space, do nothing. */
01020       argp->data = &(argp->scalar_val);    
01021       break;
01022     case GS_SPARSEMATRIX:
01023     case GS_FILE:
01024     case GS_PACKEDFILE:
01025       /* above cases should have been handled before calling this routine */
01026     default:
01027       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, "Error: unknown object type!");
01028   }
01029   return 0;
01030 }
01031 
01042 int
01043 translate_array_output(gs_argument_t* argp, IDL_VPTR arg_idl)
01044 {
01045   if(argp->datatype == GS_CHAR) {
01046     if(arg_idl->type == IDL_TYP_UNDEF)
01047       IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
01048         "Error: can't pass empty variable for output-only string arg.");
01049     else if(gs_idl_types[argp->datatype] != arg_idl->type)
01050       die_type_mismatch(arg_idl, argp);
01051 
01052     if(argp->objecttype == GS_MATRIX) {
01053       create_linear_char_matrix(arg_idl, argp);
01054     }
01055     else {
01056       arg_idl->type = IDL_TYP_STRING;
01057       argp->data = malloc(arg_idl->value.str.slen);
01058       if(!argp->data)
01059         IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
01060            "Error: malloc failed in translate_array_output().");
01061     }
01062   }
01063   else {
01064     IDL_ENSURE_ARRAY(arg_idl);
01065     argp->data = arg_idl->value.arr->data; 
01066   }
01067 
01068   return 0;
01069 }
01070 
01080 int
01081 store_scalar_to_idl(IDL_VPTR argv_idl, gs_argument_t* argp)
01082 {
01083   IDL_VPTR tmp;
01084 
01085   argp->data = &argp->scalar_val;
01086 
01087   switch(argp->datatype) {
01088     case GS_INT: 
01089       argv_idl->value.l = argp->scalar_val.int_val;
01090       break;
01091     case GS_CHAR:
01092       tmp = get_idl_string_from_unterminated_char(1, &(argp->scalar_val.char_val));
01093       IDL_VarCopy(tmp, argv_idl);
01094       break;
01095     case GS_FLOAT:
01096       argv_idl->value.f = argp->scalar_val.float_val;
01097       break;
01098     case GS_DOUBLE:
01099       argv_idl->value.d = argp->scalar_val.double_val;
01100       break;
01101     case GS_SCOMPLEX:
01102       argv_idl->value.cmp.r = argp->scalar_val.scomplex_val.r;
01103       argv_idl->value.cmp.i = argp->scalar_val.scomplex_val.i;
01104       break;
01105     case GS_DCOMPLEX:
01106       argv_idl->value.dcmp.r = argp->scalar_val.dcomplex_val.r;
01107       argv_idl->value.dcmp.i = argp->scalar_val.dcomplex_val.i;
01108       break;
01109     default:
01110       die_type_mismatch(argv_idl, argp);
01111   }
01112   return 0;
01113 }
01114 
01125 int
01126 postproc_argv_c(gs_problem_t* pd, IDL_VPTR* argv_idl)
01127 {
01128   gs_argument_t*   argp;
01129   int i;
01130 
01131   for(i=0, argp = pd->arglist; argp != NULL; argp = argp->next) {
01132     if(argp->inout == GS_WORKSPACE)
01133       continue;
01134 
01135     if((argp->inout == GS_IN) && (argp->objecttype == GS_SCALAR)) {
01136       ; /* no upcasting for args passed by value */
01137     }
01138     else if(argp->objecttype == GS_FILE) {
01139       ; /* nothing needs to be done here */
01140     }
01141     else if(argp->objecttype == GS_PACKEDFILE) {
01142       if(argp->data != NULL)
01143         free(argp->data);
01144     }
01145     else if(argp->inout == GS_VAROUT) {
01146       copy_varout(pd, argp, argv_idl[i]);
01147     }
01148     else if(argp->inout == GS_IN) {
01149       /* This is an input-only object type, so if any space
01150        * was allocated for it, free that here.
01151        */
01152 
01153       if(is_input_upcasted(argv_idl[i], argp->datatype, argp->objecttype)) {
01154         if(argp->data != NULL)
01155           free(argp->data);
01156       }
01157     }
01158     else {
01159       /* Either in/out or output object type.  We only care about
01160        * doing conversions on scalar types.
01161        */
01162 
01163       if(argp->datatype == GS_CHAR) {
01164         if(argp->objecttype == GS_MATRIX) {
01165           if(argp->data != NULL) {
01166             copy_char_matrix_output(argv_idl[i], argp);
01167             free(argp->data);
01168           }
01169         }
01170         else if(argp->objecttype == GS_VECTOR) {
01171           if(argp->data != NULL) {
01172             copy_char_vector_output(argv_idl[i], argp);
01173             free(argp->data);
01174           }
01175         }
01176       }
01177 
01178       if(argp->objecttype == GS_SCALAR) {
01179         store_scalar_to_idl(argv_idl[i], argp);
01180 
01181         if(argp->inout == GS_OUT) {
01182           /* output only scalar */
01183           if(gs_idl_types[argp->datatype] != argv_idl[i]->type)
01184             copy_scalar_output(argv_idl[i], argp);
01185         }
01186       }
01187     }
01188 
01189     /* don't move this increment into the for loop stmt since we don't
01190      * want it to be incremented for workspace args
01191      */
01192     i++;
01193   }
01194 
01195   return 0;
01196 }
01197 
01208 int
01209 is_input_upcasted(IDL_VPTR idl, int gs_data_type, int gs_object_type)
01210 {
01211   int idl_type;
01212   int ret;
01213 
01214   ret = 0;
01215   idl_type = idl->type;
01216 
01217   switch(gs_data_type) {
01218     case GS_CHAR:
01219       if(gs_object_type == GS_MATRIX)
01220         ret = 1;
01221       break;
01222     case GS_INT:
01223       if(idl->type == IDL_TYP_INT || idl_type == IDL_TYP_BYTE)
01224         ret = 1;
01225       break;
01226     case GS_FLOAT:
01227       if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT
01228          || idl_type == IDL_TYP_LONG)
01229         ret = 1;
01230       break;
01231     case GS_DOUBLE:
01232       if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT
01233          || idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT)
01234         ret = 1;
01235       break;
01236     case GS_DCOMPLEX: 
01237       if(idl_type == IDL_TYP_COMPLEX || idl_type == IDL_TYP_BYTE 
01238          || idl_type == IDL_TYP_INT  || idl_type == IDL_TYP_LONG 
01239          || idl_type == IDL_TYP_FLOAT|| idl_type == IDL_TYP_DOUBLE)
01240         ret = 1;
01241       break;
01242     case GS_SCOMPLEX: 
01243       if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT  
01244          || idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT
01245          || idl_type == IDL_TYP_DOUBLE)
01246         ret = 1;
01247       break;
01248   }
01249 
01250   return ret;
01251 }