translate.c

Go to the documentation of this file.

/* $Id: translate.c,v 1.10 2007/03/06 19:52:18 seymour Exp $ */
/* $UTK_Copyright: $ */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include "idl_export.h"
#include "grpc.h"
#include "translate.h"

UCHAR gs_idl_types[] = {
  IDL_TYP_LONG,
  IDL_TYP_FLOAT,
  IDL_TYP_DOUBLE,
  IDL_TYP_COMPLEX,
  IDL_TYP_DCOMPLEX,
  IDL_TYP_STRING,
  IDL_TYP_UNDEF
};

void
print_array(int m, int n, double *A)
{
  int i, j;
  for(i = 0; i < m; i++) {
    for(j = 0; j < n; j++) {
      printf("%f ", *(A+i*n+j));
    }
    printf("\n");
  }
}

int
trunc_fname(char *fname)
{
  char *p;

  p = strchr(fname, '(');

  if(p)
    *p = 0;

  return 0;
}

void
die_type_mismatch(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  char msg[1024];

  sprintf(msg, "Type mismatch in argument:");
  IDL_Message(IDL_M_GENERIC, IDL_MSG_INFO, msg);

  sprintf(msg, "    IDL arg name is '%s', corresponding GridSolve arg name is '%s'",
     IDL_VarName(arg_idl), argp->name);
  IDL_Message(IDL_M_GENERIC, IDL_MSG_INFO, msg);

  sprintf(msg, "    provided type = %s, expected type = %s",
     IDL_TypeName[arg_idl->type], IDL_TypeName[gs_idl_types[argp->datatype]]);
  IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, msg);
}

int
convert_idl(gs_problem_t *pd, IDL_VPTR *argv_idl)
{
  gs_argument_t *argp;
  int i;

  for(i=0, argp = pd->arglist; argp != NULL; argp = argp->next) {
    if(argp->inout != GS_WORKSPACE) {
      assign_arg(argp, argv_idl[i]);
      i++;
    }
  }

  return 0;
}

char **
create_packed_file_array(gs_argument_t *argp, IDL_VPTR arg_idl)
{
  char **result;
  int i, nelem;

  IDL_ENSURE_ARRAY(arg_idl);

  nelem = arg_idl->value.arr->n_elts;

  result = (char **)malloc(nelem * sizeof(char *));

  if(!result)
    IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
       "Error: malloc failed in create_packed_file_array().");

  for(i=0;i<nelem;i++)
    result[i] = ((IDL_STRING *)arg_idl->value.arr->data)[i].s;

  return result;
}

void
free_varout(UCHAR *mem)
{
  free(mem);
}

int
find_varout_vector_len(gs_problem_t *pd, gs_argument_t *argp)
{
  gs_argument_t *carg;

  for(carg = pd->arglist; carg; carg=carg->next) {
    if((carg->inout == GS_OUT) && (carg->datatype == GS_INT) &&
       (carg->objecttype == GS_SCALAR) &&
       !strcasecmp(carg->name, argp->rowexp))
      return carg->scalar_val.int_val;
  }

  return -1;
}

IDL_VPTR
get_idl_string_from_unterminated_char(int len, char *str)
{
  char *nt_str;
  IDL_VPTR tmp;

  /* the variable length char array from gridsolve is not guaranteed
   * to be null terminated, so do that before creating the IDL string.
   */
  nt_str = (char *)malloc(len + 1);
  if(!nt_str)
    IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
       "Error: malloc failed in get_idl_string_from_unterminated_char().");

  strncpy(nt_str, str, len);
  nt_str[len] = 0;

  tmp = IDL_StrToSTRING(nt_str);

  return tmp;
}

void
copy_varout(gs_problem_t *pd, gs_argument_t *argp, IDL_VPTR arg_idl)
{
  IDL_MEMINT dims[2];
  IDL_VPTR tmp;

  if(argp->objecttype == GS_VECTOR) {
    int veclen;

    veclen = find_varout_vector_len(pd, argp);

    if(veclen < 0)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
         "Error: could not determine VAROUT length.");

    if(argp->datatype == GS_CHAR) {
      tmp = get_idl_string_from_unterminated_char(veclen, (char *)(arg_idl->value.arr));
      IDL_VarCopy(tmp, arg_idl);
    }
    else {
      dims[0] = veclen;
      tmp = IDL_ImportArray(1, dims, gs_idl_types[argp->datatype],
        (char *)arg_idl->value.arr, free_varout, NULL);
      IDL_VarCopy(tmp, arg_idl);
    }
  }
  else {
    char msg[2048];

    sprintf(msg, "Error in arg %s: VAROUT only supported for vectors.",
      IDL_VarName(arg_idl));
    IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, msg);
  }

  return;
}

int
assign_arg(gs_argument_t* argp, IDL_VPTR argv_idl)
{
  if(argp->inout == GS_IN && argp->objecttype == GS_SCALAR) {
    IDL_ENSURE_SCALAR(argv_idl);
    copy_scalar_input(argp, argv_idl);
    return 0;
  }

  if(argp->objecttype == GS_FILE) {
    argp->data = IDL_VarGetString(argv_idl);
    return 0;
  }

  if(argp->objecttype == GS_PACKEDFILE) {
    argp->data = create_packed_file_array(argp, argv_idl);
    return 0;
  }

  if(argp->objecttype == GS_SPARSEMATRIX) {
    IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
         "Error: Sparse matrices not supported yet.");
  }

  switch(argp->inout) {
    case GS_IN:
      /* Input passed by reference */
      copy_ptr_input(argp, argv_idl);
      break;
    case GS_INOUT:
      /* Inout passed by reference */
      IDL_EXCLUDE_EXPR(argv_idl);
      check_ptr_inout(argp, argv_idl);
      break;
    case GS_OUT:
      /* Output passed by reference */
      IDL_EXCLUDE_EXPR(argv_idl);
      copy_ptr_output(argp, argv_idl);
      break;
    case GS_WORKSPACE:
      /* skip workspace arguments */
      argp->data = NULL;
      break;
    case GS_VAROUT:
      argp->data = &(argv_idl->value.arr);
      break;
    default:
      /* shouldn't hit this case since we checked for bad 
       * values already.
       */
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
         "Error: Bad arg inout type");
  }

  return 0;
}

int
copy_scalar_input(gs_argument_t* argp, IDL_VPTR arg_idl)
{
  switch(argp->datatype) {
    case GS_INT: 
      argp->scalar_val.int_val = IDL_LongScalar(arg_idl);
      break;
    case GS_CHAR:
      argp->scalar_val.char_val = *IDL_VarGetString(arg_idl);
      break;
    case GS_FLOAT:
      argp->scalar_val.float_val = (float) IDL_DoubleScalar(arg_idl);
      break;
    case GS_DOUBLE:
      argp->scalar_val.double_val = IDL_DoubleScalar(arg_idl);
      break;
    case GS_SCOMPLEX:
      if(arg_idl->type == IDL_TYP_COMPLEX) {
        argp->scalar_val.scomplex_val.r = arg_idl->value.cmp.r;
        argp->scalar_val.scomplex_val.i = arg_idl->value.cmp.i;
      }
      else if(arg_idl->type == IDL_TYP_DCOMPLEX) {
        argp->scalar_val.scomplex_val.r = (float)arg_idl->value.dcmp.r;
        argp->scalar_val.scomplex_val.i = (float)arg_idl->value.dcmp.i;
      }
      else {
        argp->scalar_val.scomplex_val.r = (float) IDL_DoubleScalar(arg_idl);
        argp->scalar_val.scomplex_val.i = 0.0;
      }
      break;
    case GS_DCOMPLEX:
      if(arg_idl->type == IDL_TYP_COMPLEX) {
        argp->scalar_val.dcomplex_val.r = (double)arg_idl->value.cmp.r;
        argp->scalar_val.dcomplex_val.i = (double)arg_idl->value.cmp.i;
      }
      else if(arg_idl->type == IDL_TYP_DCOMPLEX) {
        argp->scalar_val.dcomplex_val.r = arg_idl->value.dcmp.r;
        argp->scalar_val.dcomplex_val.i = arg_idl->value.dcmp.i;
      }
      else {
        argp->scalar_val.dcomplex_val.r = IDL_DoubleScalar(arg_idl);
        argp->scalar_val.dcomplex_val.i = 0.0;
      }
      break;
    default:
      die_type_mismatch(arg_idl, argp);
  }

  argp->data = &(argp->scalar_val);      

  return 0;
}

int
copy_scalar_output(IDL_VPTR arg_idl, gs_argument_t* argp)
{
  double dval_r = 0.0, dval_i = 0.0;

  switch(argp->datatype) {
    case GS_INT:
      dval_r = (double)argp->scalar_val.int_val;
      break;
    case GS_CHAR:
      dval_r = (double)argp->scalar_val.char_val;
      break;
    case GS_FLOAT:
      dval_r = (double)argp->scalar_val.float_val;
      break;
    case GS_DOUBLE:
      dval_r = (double)argp->scalar_val.double_val;
      break;
    case GS_SCOMPLEX:
      dval_r = (double)argp->scalar_val.scomplex_val.r;
      dval_i = (double)argp->scalar_val.scomplex_val.i;
      break;
    case GS_DCOMPLEX:
      dval_r = (double)argp->scalar_val.dcomplex_val.r;
      dval_i = (double)argp->scalar_val.dcomplex_val.i;
      break;
    default:
      die_type_mismatch(arg_idl, argp);
  }

  if(arg_idl->type == IDL_TYP_UNDEF)
    arg_idl->type = gs_idl_types[argp->datatype];

  switch(arg_idl->type) {
    case IDL_TYP_INT:
      arg_idl->value.i = (short) dval_r;
      break;
    case IDL_TYP_LONG:
      arg_idl->value.l = (int) dval_r;
      break;
    case IDL_TYP_STRING:
      arg_idl->value.str.slen = 1;
      arg_idl->value.str.s[0] = (char) dval_r;
      arg_idl->value.str.s[1] = (char) 0;
      break;
    case IDL_TYP_FLOAT:
      arg_idl->value.f = (float) dval_r;
      break;
    case IDL_TYP_DOUBLE:
      arg_idl->value.d = dval_r;
      break;
    case IDL_TYP_COMPLEX:
      arg_idl->value.cmp.r = (float) dval_r;
      arg_idl->value.cmp.i = (float) dval_i;
      break;
    case IDL_TYP_DCOMPLEX:
      arg_idl->value.dcmp.r = dval_r;
      arg_idl->value.dcmp.i = dval_i;
      break;
    default:
      die_type_mismatch(arg_idl, argp);
  }

  return 0;
}

int
copy_ptr_input(gs_argument_t* argp, IDL_VPTR arg_idl)
{
  switch(argp->objecttype) {
    case GS_VECTOR:
    case GS_MATRIX:
      translate_array_input(argp, arg_idl); /*include string*/
      break;
    case GS_SCALAR:
    case GS_SPARSEMATRIX:
    case GS_FILE:
    case GS_PACKEDFILE:
      /* above cases should have been handled before calling this routine */
    default:
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, "Error: unknown object type!");
  }

  return 0;
}

int
check_ptr_inout(gs_argument_t* argp, IDL_VPTR arg_idl)
{
  if(gs_idl_types[argp->datatype] != arg_idl->type)
    die_type_mismatch(arg_idl, argp);

  switch(argp->objecttype) {
    case GS_VECTOR:
      if(argp->datatype == GS_CHAR) {
        /* dup the string in case it was assigned from a constant string */

        argp->data = strdup(IDL_VarGetString(arg_idl));
      }
      else
        argp->data = arg_idl->value.arr->data;
      break;
    case GS_MATRIX:
      if(argp->datatype == GS_CHAR)
        translate_array_input(argp, arg_idl);
      else
        argp->data = arg_idl->value.arr->data;
      break;
    case GS_SCALAR:
      copy_scalar_input(argp, arg_idl);
      break;
    case GS_SPARSEMATRIX:
    case GS_FILE:
    case GS_PACKEDFILE:
      /* above cases should have been handled before calling this routine */
    default:
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, "Error: unknown/unsupported object type!");
  }

  return 0;
}

int
create_linear_char_matrix(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  char *char_buf, *str;
  int i, j, len, max_len, n_elts;
  int idl_type, *argv;
  IDL_ARRAY *arr;

  arr = arg_idl->value.arr;
  idl_type = arg_idl->type;
  argv = (int*) &argp->data;

  max_len = 0;

  for(i=0;i<arr->n_elts;i++) {
    len = strlen(((IDL_STRING *)arr->data)[i].s);
    if(len > max_len)
      max_len = len;
  }
  char_buf = (char *)malloc(arr->n_elts * max_len);

  if(!char_buf)
    IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
      "Error: malloc failed in create_linear_char_matrix()");

  n_elts = arr->n_elts;

  for(i=0;i<n_elts;i++) {
    str = ((IDL_STRING *)arr->data)[i].s;
    len = strlen(str);

    for(j=0;j<max_len;j++) {
      if(j >= len)
        char_buf[j*n_elts + i] = ' ';
      else
        char_buf[j*n_elts + i] = str[j];
    }
  }

  *argv = (int)char_buf;

  return 0;
}

int
copy_char_vector_output(IDL_VPTR arg_idl, gs_argument_t* argp)
{
  IDL_VPTR tmp;

  tmp = get_idl_string_from_unterminated_char(argp->rows, (char *)argp->data);
  IDL_VarCopy(tmp, arg_idl);

  return 0;
}

int
copy_char_matrix_output(IDL_VPTR arg_idl, gs_argument_t* argp)
{
  char *tmpstr, *char_buf;
  int i, j, len;
  IDL_STRING *str_arr = 0 ;
  IDL_VPTR arr_data;
  IDL_MEMINT dims[1];

  char_buf = argp->data;
  dims[0] = argp->rows;
  str_arr = (IDL_STRING *)IDL_MakeTempArray( IDL_TYP_STRING,
     1, dims, IDL_BARR_INI_NOP, &arr_data);

  for(i=0;i<argp->rows;i++) {
    len = strlen(((IDL_STRING *)arg_idl->value.arr->data)[i].s);

    tmpstr = (char *)calloc(len + 1, 1);
    if(!tmpstr)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
        "Error: malloc failed in copy_char_matrix_output()");

    for(j=0;j<argp->cols;j++) {
      if(j < len)
        tmpstr[j] = char_buf[j*argp->rows + i];
    }

    IDL_StrStore(&(str_arr[i]), tmpstr);
  }

  IDL_VarCopy(arr_data, arg_idl);

  return 0;
}

int
translate_int_array(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  int idl_type, *int_buf, *argv;
  IDL_ARRAY *arr;

  arr = arg_idl->value.arr;
  idl_type = arg_idl->type;
  argv = (int*) &argp->data;

  if(idl_type == IDL_TYP_INT || idl_type == IDL_TYP_BYTE) {
    int_buf  = (int* )malloc(arr->n_elts*sizeof(int));

    if(!int_buf)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
        "Error: malloc failed in translate_int_array()");

    if(idl_type == IDL_TYP_INT)
      COPY_A_TO_B(short, int, arr->n_elts, arr->data, int_buf)
    else
      COPY_A_TO_B(unsigned char, int, arr->n_elts, arr->data, int_buf)

    *argv = (int)int_buf;
  }
  else  if(idl_type == IDL_TYP_LONG) {
    *argv = (int)arr->data;
  }
  else {
    die_type_mismatch(arg_idl, argp);
  }

  return 0;
}

int
translate_dcomplex_array(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  IDL_DCOMPLEX*   pdcomplex;
  int idl_type, *argv;
  IDL_ARRAY *arr;

  arr = arg_idl->value.arr;
  idl_type = arg_idl->type;
  argv = (int*) &argp->data;

  if(idl_type == IDL_TYP_COMPLEX || idl_type == IDL_TYP_BYTE
      || idl_type == IDL_TYP_INT  || idl_type == IDL_TYP_LONG
      || idl_type == IDL_TYP_FLOAT|| idl_type == IDL_TYP_DOUBLE) {
    int i;
    pdcomplex  = (IDL_DCOMPLEX* )malloc(sizeof(IDL_DCOMPLEX)*arr->n_elts);

    if(!pdcomplex)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
         "Error: malloc failed in translate_dcomplex_array()");

    if(idl_type == IDL_TYP_COMPLEX) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(float, double, 1, arr->data+2*i, &(pdcomplex+i)->r);
        COPY_A_TO_B(float, double, 1, arr->data+2*i+1, &(pdcomplex+i)->i);
      }
    }
    else if(idl_type == IDL_TYP_DOUBLE) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(double, double, 1, arr->data+i, &(pdcomplex+i)->r);
        (pdcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_FLOAT) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(float, double, 1, arr->data+i, &(pdcomplex+i)->r);
        (pdcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_LONG) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(int, double, 1, arr->data+i, &(pdcomplex+i)->r);
        (pdcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_INT) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(short, double, 1, arr->data+i, &(pdcomplex+i)->r);
        (pdcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_BYTE) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(unsigned char, double, 1, arr->data+i, &(pdcomplex+i)->r);
        (pdcomplex+i)->i = 0;
      }
    }
    *argv = (int)pdcomplex;
  }
  else if(idl_type == IDL_TYP_DCOMPLEX) {
    *argv = (int) arr->data;
  }
  else
    die_type_mismatch(arg_idl, argp);

  return 0;
}

int
translate_scomplex_array(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  IDL_COMPLEX*    pcomplex;
  int idl_type, *argv;
  IDL_ARRAY *arr;

  arr = arg_idl->value.arr;
  idl_type = arg_idl->type;
  argv = (int*) &argp->data;

  if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT
      || idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT
      || idl_type == IDL_TYP_DOUBLE) {
    int i;
    pcomplex  = (IDL_COMPLEX* )malloc(sizeof(IDL_COMPLEX)*arr->n_elts);

    if(!pcomplex)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
        "Error: malloc failed in translate_scomplex_array()");

    if(idl_type == IDL_TYP_DOUBLE) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(double, double, 1, arr->data+i,   &(pcomplex+i)->r);
        (pcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_FLOAT) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(float, double, 1, arr->data+i,   &(pcomplex+i)->r);
        (pcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_LONG) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(int, double, 1, arr->data+i,   &(pcomplex+i)->r);
        (pcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_INT) {
      for(i = 0; i < arr->n_elts; i++) {
        COPY_A_TO_B(short, double, 1, arr->data+i,   &(pcomplex+i)->r);
        (pcomplex+i)->i = 0;
      }
    }
    else if(idl_type == IDL_TYP_BYTE) {
      for(i = 0; i < arr->n_elts; i++) {
          COPY_A_TO_B(unsigned char, double, 1, arr->data+i,   &(pcomplex+i)->r);
        (pcomplex+i)->i = 0;
      }
    }
    *argv = (int)pcomplex;
  }
  else if(idl_type == IDL_TYP_COMPLEX) {/* matched! */
    *argv = (int) arr->data;
  }
  else
    die_type_mismatch(arg_idl, argp);

  return 0;
}

int
translate_double_array(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  double *dbl_buf;
  int idl_type, *argv;
  IDL_ARRAY *arr;

  arr = arg_idl->value.arr;
  idl_type = arg_idl->type;
  argv = (int*) &argp->data;

  if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT ||
      idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT) {
    dbl_buf  = (double* )malloc(arr->n_elts*sizeof(double));

    if(!dbl_buf)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
         "Error: malloc failed in translate_double_array()");

    if(idl_type == IDL_TYP_BYTE)
      COPY_A_TO_B(unsigned char, double, arr->n_elts, arr->data, dbl_buf)
    else if(idl_type == IDL_TYP_INT)
      COPY_A_TO_B(short, double, arr->n_elts, arr->data, dbl_buf)
    else if(idl_type == IDL_TYP_LONG)
      COPY_A_TO_B(int, double, arr->n_elts, arr->data, dbl_buf)
    else
      COPY_A_TO_B(float, double, arr->n_elts, arr->data, dbl_buf)
    *argv = (int)dbl_buf;
  }
  else if(idl_type == IDL_TYP_DOUBLE) {
    *argv = (int)arr->data;
  }
  else
    die_type_mismatch(arg_idl, argp);

  return 0;
}

int
translate_float_array(IDL_VPTR arg_idl, gs_argument_t *argp)
{
  float *flt_buf;
  int idl_type, *argv;
  IDL_ARRAY *arr;

  arr = arg_idl->value.arr;
  idl_type = arg_idl->type;
  argv = (int*) &argp->data;

  if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT ||
      idl_type == IDL_TYP_LONG) {
    flt_buf  = (float* )malloc(arr->n_elts*sizeof(float));

    if(!flt_buf)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
        "Error: malloc failed in translate_float_array()");

    if(idl_type == IDL_TYP_BYTE)
      COPY_A_TO_B(unsigned char, float, arr->n_elts, arr->data, flt_buf)
    else if(idl_type == IDL_TYP_INT)
      COPY_A_TO_B(short, float, arr->n_elts, arr->data, flt_buf)
    else
      COPY_A_TO_B(int, float, arr->n_elts, arr->data, flt_buf)
    *argv = (int) flt_buf;
  }
  else if(idl_type == IDL_TYP_FLOAT) {
    *argv = (int)arr->data;
  }
  else
    die_type_mismatch(arg_idl, argp);

  return 0;
}

int
translate_array_input(gs_argument_t* argp, IDL_VPTR arg_idl)
{
  int rv;

  rv = 0;

  if(argp->datatype != GS_CHAR)
    IDL_ENSURE_ARRAY(arg_idl);

  switch(argp->datatype) {
    case GS_CHAR: /* string */
      if(argp->objecttype == GS_MATRIX)
        rv = create_linear_char_matrix(arg_idl, argp);
      else
        argp->data = IDL_VarGetString(arg_idl);
      break;
    case GS_INT: /* int array */
      rv = translate_int_array(arg_idl, argp);
      break;
    case GS_DCOMPLEX: /* dcomplex array */
      rv = translate_dcomplex_array(arg_idl, argp);
      break;
    case GS_SCOMPLEX: /* complex array */
      rv = translate_scomplex_array(arg_idl, argp);
      break;
    case GS_DOUBLE: /* double array */
      rv = translate_double_array(arg_idl, argp);
      break;
    case GS_FLOAT: /* float array */
      rv = translate_float_array(arg_idl, argp);
      break;
    default:
      die_type_mismatch(arg_idl, argp);
  }

  return rv;
}

int
copy_ptr_output(gs_argument_t* argp, IDL_VPTR arg_idl)
{
  switch(argp->objecttype) {
    case GS_VECTOR:
    case GS_MATRIX:
      if((gs_idl_types[argp->datatype] != arg_idl->type) && (argp->datatype != GS_CHAR))
        die_type_mismatch(arg_idl, argp);
      translate_array_output(argp, arg_idl);
      break;
    case GS_SCALAR:
      /* GS arg has its own space, do nothing. */
      argp->data = &(argp->scalar_val);    
      break;
    case GS_SPARSEMATRIX:
    case GS_FILE:
    case GS_PACKEDFILE:
      /* above cases should have been handled before calling this routine */
    default:
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, "Error: unknown object type!");
  }
  return 0;
}

int
translate_array_output(gs_argument_t* argp, IDL_VPTR arg_idl)
{
  if(argp->datatype == GS_CHAR) {
    if(arg_idl->type == IDL_TYP_UNDEF)
      IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP, 
        "Error: can't pass empty variable for output-only string arg.");
    else if(gs_idl_types[argp->datatype] != arg_idl->type)
      die_type_mismatch(arg_idl, argp);

    if(argp->objecttype == GS_MATRIX) {
      create_linear_char_matrix(arg_idl, argp);
    }
    else {
      arg_idl->type = IDL_TYP_STRING;
      argp->data = malloc(arg_idl->value.str.slen);
      if(!argp->data)
        IDL_Message(IDL_M_GENERIC, IDL_MSG_LONGJMP,
           "Error: malloc failed in translate_array_output().");
    }
  }
  else {
    IDL_ENSURE_ARRAY(arg_idl);
    argp->data = arg_idl->value.arr->data; 
  }

  return 0;
}

int
store_scalar_to_idl(IDL_VPTR argv_idl, gs_argument_t* argp)
{
  IDL_VPTR tmp;

  argp->data = &argp->scalar_val;

  switch(argp->datatype) {
    case GS_INT: 
      argv_idl->value.l = argp->scalar_val.int_val;
      break;
    case GS_CHAR:
      tmp = get_idl_string_from_unterminated_char(1, &(argp->scalar_val.char_val));
      IDL_VarCopy(tmp, argv_idl);
      break;
    case GS_FLOAT:
      argv_idl->value.f = argp->scalar_val.float_val;
      break;
    case GS_DOUBLE:
      argv_idl->value.d = argp->scalar_val.double_val;
      break;
    case GS_SCOMPLEX:
      argv_idl->value.cmp.r = argp->scalar_val.scomplex_val.r;
      argv_idl->value.cmp.i = argp->scalar_val.scomplex_val.i;
      break;
    case GS_DCOMPLEX:
      argv_idl->value.dcmp.r = argp->scalar_val.dcomplex_val.r;
      argv_idl->value.dcmp.i = argp->scalar_val.dcomplex_val.i;
      break;
    default:
      die_type_mismatch(argv_idl, argp);
  }
  return 0;
}

int
postproc_argv_c(gs_problem_t* pd, IDL_VPTR* argv_idl)
{
  gs_argument_t*   argp;
  int i;

  for(i=0, argp = pd->arglist; argp != NULL; argp = argp->next) {
    if(argp->inout == GS_WORKSPACE)
      continue;

    if((argp->inout == GS_IN) && (argp->objecttype == GS_SCALAR)) {
      ; /* no upcasting for args passed by value */
    }
    else if(argp->objecttype == GS_FILE) {
      ; /* nothing needs to be done here */
    }
    else if(argp->objecttype == GS_PACKEDFILE) {
      if(argp->data != NULL)
        free(argp->data);
    }
    else if(argp->inout == GS_VAROUT) {
      copy_varout(pd, argp, argv_idl[i]);
    }
    else if(argp->inout == GS_IN) {
      /* This is an input-only object type, so if any space
       * was allocated for it, free that here.
       */

      if(is_input_upcasted(argv_idl[i], argp->datatype, argp->objecttype)) {
        if(argp->data != NULL)
          free(argp->data);
      }
    }
    else {
      /* Either in/out or output object type.  We only care about
       * doing conversions on scalar types.
       */

      if(argp->datatype == GS_CHAR) {
        if(argp->objecttype == GS_MATRIX) {
          if(argp->data != NULL) {
            copy_char_matrix_output(argv_idl[i], argp);
            free(argp->data);
          }
        }
        else if(argp->objecttype == GS_VECTOR) {
          if(argp->data != NULL) {
            copy_char_vector_output(argv_idl[i], argp);
            free(argp->data);
          }
        }
      }

      if(argp->objecttype == GS_SCALAR) {
        store_scalar_to_idl(argv_idl[i], argp);

        if(argp->inout == GS_OUT) {
          /* output only scalar */
          if(gs_idl_types[argp->datatype] != argv_idl[i]->type)
            copy_scalar_output(argv_idl[i], argp);
        }
      }
    }

    /* don't move this increment into the for loop stmt since we don't
     * want it to be incremented for workspace args
     */
    i++;
  }

  return 0;
}

int
is_input_upcasted(IDL_VPTR idl, int gs_data_type, int gs_object_type)
{
  int idl_type;
  int ret;

  ret = 0;
  idl_type = idl->type;

  switch(gs_data_type) {
    case GS_CHAR:
      if(gs_object_type == GS_MATRIX)
        ret = 1;
      break;
    case GS_INT:
      if(idl->type == IDL_TYP_INT || idl_type == IDL_TYP_BYTE)
        ret = 1;
      break;
    case GS_FLOAT:
      if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT
         || idl_type == IDL_TYP_LONG)
        ret = 1;
      break;
    case GS_DOUBLE:
      if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT
         || idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT)
        ret = 1;
      break;
    case GS_DCOMPLEX: 
      if(idl_type == IDL_TYP_COMPLEX || idl_type == IDL_TYP_BYTE 
         || idl_type == IDL_TYP_INT  || idl_type == IDL_TYP_LONG 
         || idl_type == IDL_TYP_FLOAT|| idl_type == IDL_TYP_DOUBLE)
        ret = 1;
      break;
    case GS_SCOMPLEX: 
      if(idl_type == IDL_TYP_BYTE || idl_type == IDL_TYP_INT  
         || idl_type == IDL_TYP_LONG || idl_type == IDL_TYP_FLOAT
         || idl_type == IDL_TYP_DOUBLE)
        ret = 1;
      break;
  }

  return ret;
}