/*************************************************************************
 *                  
 *       (c) Copyright 1992,1993,1994 by G & A Technical Software, Inc.,
 *             28 Research Drive, Hampton, Virginia, 23666.
 *
 *   All Rights Reserved. No part of this software or publication may be
 *   reproduced, stored in a retrieval system, or transmitted, in any form
 *   or by any means, electronic, mechanical, photocopying, recording, or
 *   otherwise without the prior written permission of G & A Technical
 *   Software, Inc.
 *  
 *************************************************************************
 *
 * Filename: callcr.c
 *
 * Purpose:  Provides S3 calling mechanism for C subroutines and functions.
 *
 * Author:   John Burton
 *
 * Date:     5/31/94
 *
 *************************************************************************
 *
 * Modification History:
 *
 * $Log: s3_callcr.c,v $
 * Revision 2.1  1994/07/08  18:07:38  jcburt
 * No changes since last commit. Just bringing everything up to the same
 * revision number
 *
 * Revision 2.0.0.1  1994/06/28  18:48:27  jcburt
 * S3 Version 2.0 Initial Source
 *
 *
 *************************************************************************
 *
 * Revision Control Information:
 */
   static char rcsid[]  = "$Id: s3_callcr.c,v 2.1 1994/07/08 18:07:38 jcburt Exp $";
   static char rcsrev[] = "$Revision: 2.1 $";

/****************************************************************************/
/*  Written by:                                                             */
/*    John Burton                                                           */
/*    jcburt@gatsibm.larc.nasa.gov                                          */
/*  Date:                                                                   */
/*    02/20/92                                                              */
/****************************************************************************/
/*  Routines and Revision History:                                          */
/*                                                                          */
/*    #define MULTIDIM                                                      */
/*      - 10/15/91 Original version created                 (John Burton)   */
/*                                                                          */
/*    int call_c_function                                                   */
/*      - 10/20/91 Original version created                 (John Burton)   */
/*      - 01/30/92 Added dataset bounds violation checking  (John Burton)   */
/*                                                                          */
/*    void call_c_subroutine                                                */
/*      - 10/20/91 Original version created                 (John Burton)   */
/*      - 01/30/92 Added dataset bounds violation checking  (John Burton)   */
/*                                                                          */
/****************************************************************************/

/*************************************************************************
 * 
 * Include Files
 *
 *************************************************************************/
#ifdef _AIX
#pragma alloca
#endif

#include "s3_defines.h"
#include "s3_typedefs.h"
#include "s3_externals.h"
#include "s3_globals.h"


/*************************************************************************
 * 
 * Defines and Macros
 *
 *************************************************************************/

/*      - Creates N levels of indirection for the data pointed to by data   */
/*        allowing called routines to manipulate data as if it were an N    */
/*        dimensional array                                                 */

#define MULTIDIM(arr,data,type,nd,dims)  {\
   int k,l,size,*q;\
   char *start,**r,**s1,*t;\
   r = &start;\
   q = dims;\
   size = 1;\
   for(k=0;k<nd-1;k++,q++) {\
       size *= (*q);\
       if((r[0]=(char *)alloca(size*sizeof(char **))) == NULL)\
         s3_error(SYS,"MULTIDIM: alloca");\
       r=(char **)r[0];\
     }\
   r[0] = (char *)data;\
   r = (char **)start;\
   q = dims;\
   size = 1;\
   for(k=0;k<nd-2;k++,q++) {\
       size *= (*q);\
       for(k=1,s1=r+1,t=r[0];k<size;k++)\
	 *s1++ = (t += sizeof(char **) * *(q+1));\
       r = (char **)r[0];\
     }\
   size *= (*q);\
   for(k=1,s1=r+1,t=r[0];k<size;k++)\
      *s1++ = (t += sizeof(type) * *(q+1));\
   arr = (char *)start;\
}

 
/*************************************************************************
 * 
 * Global Variables
 *
 *************************************************************************/
 


/*************************************************************************
 *
 * Module:      s3_call_c_function
 *
 * Description: Steps through the list of nds datasets and coverts the
 *              multi-dimensional datasets to multi-dimensional arrays.
 *              Passes information to s3_call_function to actually call the 
 *              function.
 *
 * Syntax:      int s3_call_c_function(int (*func)(), int nds, DataSet **dl)
 *
 * Inputs:      *func: A pointer to the integer function to be called.
 *              nds:   Number of datasets to be passed to "func".
 *              **dl:  An array of pointers to the datasets to be passed
 *                     to "func".
 * 
 * Outputs:     None
 *
 * Returns:     An integer value corresponding to the value returned by
 *              "func".
 *
 * Modules Called: s3_call_function, s3_check_bounds
 *
 *************************************************************************/

int s3_call_c_function(int (*func)(), int nds, DataSet **dl)
{
  int    h,i,j,quit;
  int    dims[MAXDIMS];
  char  *a[MAXARGS];

  if(bounds)
    for(i=0;i<nds;i++)
      s3_check_bounds(dl[i],"Before Call");
  for(i=0;i<nds;i++)
    {
      if(dl[i]->NDIMS > 1)
	{
	  for(j=0,h=(dl[i]->NDIMS)-1;j<dl[i]->NDIMS;j++,h--)
	    dims[h] = dl[i]->dimlist[j]->co.value;
	  switch(dl[i]->type)
	    {
	    case BYTE:
	      MULTIDIM(a[i],dl[i]->d.data,byte,dl[i]->NDIMS,dims);
	      break;
	    case STRING:
	      MULTIDIM(a[i],dl[i]->d.data,char,dl[i]->NDIMS,dims);
	      break;
	    case CHAR:
	      MULTIDIM(a[i],dl[i]->d.data,char,dl[i]->NDIMS,dims);
	      break;
	    case INT:
	      MULTIDIM(a[i],dl[i]->d.data,int,dl[i]->NDIMS,dims);
	      break;
	    case REAL:
	      MULTIDIM(a[i],dl[i]->d.data,float,dl[i]->NDIMS,dims);
	      break;
	    case DREAL:
	      MULTIDIM(a[i],dl[i]->d.data,double,dl[i]->NDIMS,dims);
	      break;
	    case COMP:
	      MULTIDIM(a[i],dl[i]->d.data,complex,dl[i]->NDIMS,dims);
	      break;
	    case DCOMP:
	      MULTIDIM(a[i],dl[i]->d.data,dbl_complex,dl[i]->NDIMS,dims);
	      break;
	    }
	}
      else
	a[i] = (char *)dl[i]->d.data;
    }
  quit = s3_call_function(func,a,nds);
  if(bounds)
    for(i=0;i<nds;i++)
      s3_check_bounds(dl[i],"After Call");
  return quit;
}





/*************************************************************************
 *
 * Module:      s3_call_c_subroutine
 *
 * Description: Steps through the list of nds datasets and coverts the
 *              multi-dimensional datasets to multi-dimensional arrays.
 *              Passes information to s3_call_function to actually call the 
 *              function.
 *
 * Syntax:      int s3_call_c_function(int (*func)(), int nds, DataSet **dl)
 *
 * Inputs:      *func: A pointer to the integer function to be called.
 *              nds:   Number of datasets to be passed to "func".
 *              **dl:  An array of pointers to the datasets to be passed
 *                     to "func".
 * 
 * Outputs:     None
 *
 * Returns:     None
 *
 * Modules Called: s3_call_subroutine, s3_check_bounds
 *
 *************************************************************************/

void s3_call_c_subroutine(int (*func)(), int nds, DataSet **dl)
{
  int    h,i,j,quit;
  int    dims[MAXDIMS];
  char  *a[MAXARGS];

  if(bounds)
    for(i=0;i<nds;i++)
      s3_check_bounds(dl[i],"Before Call");
  for(i=0;i<nds;i++)
    {
      if(dl[i]->NDIMS > 1)
	{
	  for(j=0,h=(dl[i]->NDIMS)-1;j<dl[i]->NDIMS;j++,h--)
	    dims[h] = dl[i]->dimlist[j]->co.value;
	  switch(dl[i]->type)
	    {
	    case BYTE:
	      MULTIDIM(a[i],dl[i]->d.data,byte,dl[i]->NDIMS,dims);
	      break;
	    case CHAR:
	      MULTIDIM(a[i],dl[i]->d.data,char,dl[i]->NDIMS,dims);
	      break;
	    case STRING:
	      MULTIDIM(a[i],dl[i]->d.data,char,dl[i]->NDIMS,dims);
	      break;
	    case INT:
	      MULTIDIM(a[i],dl[i]->d.data,int,dl[i]->NDIMS,dims);
	      break;
	    case REAL:
	      MULTIDIM(a[i],dl[i]->d.data,float,dl[i]->NDIMS,dims);
	      break;
	    case DREAL:
	      MULTIDIM(a[i],dl[i]->d.data,double,dl[i]->NDIMS,dims);
	      break;
	    case COMP:
	      MULTIDIM(a[i],dl[i]->d.data,complex,dl[i]->NDIMS,dims);
	      break;
	    case DCOMP:
	      MULTIDIM(a[i],dl[i]->d.data,dbl_complex,dl[i]->NDIMS,dims);
	      break;
	    }
	}
      else
	a[i] = (char *)dl[i]->d.data;
    }
  s3_call_subroutine(func,a,nds);
  if(bounds)
    for(i=0;i<nds;i++)
      s3_check_bounds(dl[i],"After Call");
}