/***********************************************************************
 *
 *	C - Smalltalk Interface module
 *
 *	$Revision: 1.7 $
 *	$Date: 1995/09/12 04:34:44 $
 *	$Author: sbb $
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright (C) 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc.
 * Written by Steve Byrne.
 *
 * This file is part of GNU Smalltalk.
 *
 * GNU Smalltalk is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by the Free
 * Software Foundation; either version 1, or (at your option) any later 
 * version.
 * 
 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
 * more details.
 * 
 * You should have received a copy of the GNU General Public License along with
 * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
 * Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
 *
 ***********************************************************************/


/*
 *    Change Log
 * ============================================================================
 * Author      Date       Change 
 * sbb	      9 Sep 95	  Removed Sun Windows hacks from the file.
 *
 * sbb	      9 Sep 95	  Added incubator support for created objects.
 *
 * sbb	     26 Jul 95	  Fixed the makeDescriptor function to issue an error
 *			  if it cannot find a named C function.  Already
 *			  located some bugs in UnixStream.st which have been
 *			  there since it's inception.
 *
 * sbb	     11 Jul 95	  Added John Stanhope (jehu@vt.edu)'s changes for
 *			  Objective-C calling (Thanks John!!!)
 *
 * sbb	      6 Jun 95	  Switched to new file naming scheme.
 *
 * brd       19 Mar 95    Conditionally enable GC of Smalltalk objects  
 *                        referenced in callouts. 
 *
 * sbb	     31 May 95	  Fixed cFuncInfo to grow dynamically.
 *
 * sbb	      3 Sep 94	  Yanked out DLD -- it's now in the parent directory. 
 *
 * sbb	      3 Sep 94	  Factored out initUserCFuncs to enable easier
 *			  extension by developers.
 *
 * sbb	     22 Jun 94	  Added support for cObjectPtr type, to allow for
 *			  passing CObject parameters by reference.  It is up to
 *			  the client to ensure that the passed CObject type
 *			  corresponds to the desired C datatype.
 *
 * sbb	     20 Jun 94	  Fixed stringInfo to be local to the call stack,
 *			  instead of using a static, to allow recursive
 *			  invocations. 
 *
 * sbb	     23 Feb 92	  Added support for reading and writing scalar types.
 *
 * sbb	     19 Jul 91	  Started adding support for the DLD package.
 *
 * sbb	     22 Jan 91	  Added putenv().
 *
 * sbb	     17 Nov 90	  Added support for UnixStream primitives.
 *
 * sbb	     11 Aug 90	  Added knowledge of byteArrayOut type.
 *
 * sbyrne     4 Jun 89	  Added Smalltalk data conversion type.
 *
 * sbyrne    29 May 89	  Created.
 *
 */

#include "gst.h"
#include "interp.h"
#include "dict.h"
#include "oop.h"
#include "sym.h"
#include "callin.h"
#include "lex.h"
#if STDC_HEADERS
# include <string.h>
# include <stdlib.h>
#endif /* STDC_HEADERS */
/* brd 6/7/95 */
#include <sys/types.h>
#if defined(HAVE_UNISTD_H)
# include <unistd.h>		/* SBB  4-Jul-95 14:45:43 I think this is no longer necessary. */
#endif 
#include <stdio.h>

#if defined(HAVE_IO_H)
# include <io.h>
#endif

#define ARG_VEC_SIZE		20 /* 20 ints, 10 longs or ptrs, 5 dbls */
#define CFUNC_VEC_CHUNK_SIZE	25 /* grow in 25 slot chunks  */


typedef enum {
  intAlign,
  longAlign,
  ptrAlign,
  floatAlign,
  doubleAlign
} AlignmentType;

typedef enum {			/* types for C parameters */
  unknownType,			/* when there is no type a priori */
  charType,
  stringType,
  stringOutType,		/* for things that modify string params */
  symbolType,
  byteArrayType,
  byteArrayOutType,
  intType,
  longType,
  floatType, 
  doubleType,
  voidType,			/* valid only as a return type */
  variadicType,			/* for parameters, this param is an array
				   to be interpreted as arguments.  Note that
				   only simple conversions are performed in
				   this case. */
  cObjectType,			/* a C object is being passed */
  cObjectPtrType,		/* a C object pointer is being passed */
  smalltalkType,		/* no conversion to-from C...C sees this
				   as "void *".  */
  selfType			/* pass self as the corresponding argument  */
} CDataType;

typedef struct CFuncDescriptorStruct {
  OBJ_HEADER;
  OOP		cFunction;	/* CObject whose C value is func addr */
  OOP		cFunctionName;	/* Name of C function in mapping table */
  OOP		returnType;	/* Smalltalk return type */
  OOP		numFixedArgs;	/* number of real arguments passed from */
				/* smalltalk (excluding "self" parameters */
				/* which are synthetically added by the */
				/* callout mechanism when calling the C */
				/* function). */
  OOP		argTypes[1];	/* variable length, really numFixedArgs long */
} *CFuncDescriptor;

typedef struct SymbolTypeMapStruct {
  OOP		*symbol;
  CDataType	type;
} SymbolTypeMap;

/* Holds onto allocated C strings and Smalltalk strings for the duration of
 * a call to a C function.  Used in invokeCRoutine and pushSmalltalkObj. */
typedef struct StringInfoStruct {
  Byte		*cString;
  OOP		stringOOP;
  CDataType	returnedType;
} StringInfo;

typedef union CParamUnionUnion {
  int		intVal;
  long		longVal;
  voidPtr	ptrVal;
  float		floatVal;
  double	doubleVal;
  int		valueVec[sizeof(double) / sizeof(int)];
} CParamUnion;

/* Element type for the name-to-C-function mapping table. */ 
typedef struct 	CFuncInfoStruct {
  char		*funcName;
  void		(*funcAddr)();
} CFuncInfo;

extern int			errno;
extern mst_Boolean 		enableGC;
extern void			initUserCFuncs();


void				defineCFunc();

static void 			pushObj(), callCFunction(),
				badType(), pushSmalltalkObj(), initCFuncVec();
static CDataType 		getCType();
static CFuncDescriptor 		getCFuncDescriptor();
static OOP			classifyTypeSymbol();
static int			savedErrno;

static OOP			readChar();
static OOP			readUChar();
static OOP			readShort();
static OOP			readUShort();
static OOP			readLong();
static OOP			readULong();
static OOP			readFloat();
static OOP			readDouble();

static void			writeChar();
static void			writeShort();
static void			writeLong();
static void			writeFloat();
static void			writeDouble();

static CFuncInfo		*cFuncInfo, *cFuncIndex;
static unsigned long		cFuncVecSize;

static int			cArgVec[ARG_VEC_SIZE];
static int			*cArg;
#ifdef old_code /* Mon Jun 20 19:39:53 1994 */
/**/static StringInfo		stringInfo[ARG_VEC_SIZE], *sip;
#endif /* old_code Mon Jun 20 19:39:53 1994 */
static StringInfo		*stringInfoBase, *sip;
/* printable names for corresponding C types */
static char			*cTypeName[] = {
  "void?",			/* unknownType */
  "char",			/* charType */
  "char *",			/* stringType */
  "char *",			/* stringOutType */
  "char *",			/* symbolType */
  "char *",			/* byteArrayType */
  "char *",			/* byteArrayOutType */
  "int",			/* intType */
  "long",			/* longType */
  "float",		        /* floatType */
  "double",			/* doubleType */
  "void?",			/* voidType */
  "var args?",			/* variadicType */
  "void *",			/* cObjectType -- this is misleading */
  "void *",			/* cObjectPtrType */
  "void *",			/* smalltalkType */
  "self",			/* selfType */
};

static SymbolTypeMap	symbolTypeMap[] = {
  &unknownSymbol, unknownType,
  &charSymbol, charType,
  &stringSymbol, stringType,
  &stringOutSymbol, stringOutType,
  &symbolSymbol, symbolType,
  &byteArraySymbol, byteArrayType,
  &byteArrayOutSymbol, byteArrayOutType,
  &intSymbol, intType,
  &longSymbol, longType,
  &floatSymbol, floatType,
  &doubleSymbol, doubleType,
  &voidSymbol, voidType,
  &variadicSymbol, variadicType,
  &cObjectSymbol, cObjectType,
  &cObjectPtrSymbol, cObjectPtrType,
  &smalltalkSymbol, smalltalkType,
  &selfSymbol, selfType,
  nil, unknownType
};

/* the arg vec pointer must be = 0 mod alignments[align] */
/* This is quite likely to be machine dependent.  Currently it is set up
 * to work correctly on sun2's, sun3's and sun4's, and other RISC (type size == alignment) platforms */
/* The order of the array elements for alignments and typeSizes must equal the 
 * enum value order in AlignmentType */
static int 		alignments[] = {
  sizeof(int),			/* intType */
  sizeof(long),			/* longType */
  sizeof(voidPtr),		/* ptrType */
  sizeof(float),		/* floatType */
  DOUBLE_ALIGNMENT		/* doubleType */
};

static int		typeSizes[] = {
  sizeof(int),			/* intType */
  sizeof(long),			/* longType */
  sizeof(voidPtr),		/* ptrType */
  sizeof(float),		/* floatType */
  sizeof(double)		/* doubleType */
};

/*
 *	void marli(n)
 *
 * Description
 *
 *	Test/example C function.
 *
 * Inputs
 *
 *	n     : number of times to emit message.
 *
 */
void marli(n)
int n;
{
  int		i;

  for (i = 0; i < n; i++) {
    printf("Marli loves Steve!!!\n");
  }
}

static int getErrno()
{
  return (savedErrno);
}
 

#ifdef test_hack /* Thu Nov 26 19:12:37 1992 */
/**//* !!! Remove this */
/**/#include <sys/types.h>
/**/#include <unistd.h>
/**/#include <fcntl.h>
/**/
/**/void siggy()
/**/{
/**/  int	initial;
/**/
/**/  initial = fcntl(0, F_GETFL, 0);
/**/  initial |= FASYNC;
/**/  printf("Setting said %d\n", 
/**/	 fcntl(0, F_SETFL, initial));
/**/}
#endif /* test_hack Thu Nov 26 19:12:37 1992 */


#ifdef debugging /* Wed Nov 14 12:34:44 1990 */
/**/myioctl(fd, request, arg)
/**/int	fd, request;
/**/char	*arg;
/**/{
/**/  printf("fd %d request %x arg %x\n", fd, request, arg);
/**/  return (ioctl(fd, request, arg));
/**/}
#endif /* debugging Wed Nov 14 12:34:44 1990 */

/*
 *	static int my_putenv(str)
 *
 * Description
 *
 *	Does a putenv library call.  Exists because putenv (at least Sun's)
 *	expects that the string passed in will exist for the duration, and
 *	Smalltalk will free the string it passed to this this routine when
 *	control returns to it.
 *
 * Inputs
 *
 *	str   : String to stuff into the environment.  Of the form name=value.
 *
 * Outputs
 *
 *	Returned value from putenv() call.
 */
static int my_putenv(str)
char	*str;
{
  char		*clone;
  int		len;

  len = strlen(str) + 1;	/* hold the null */
  clone = (char *)malloc(len);
  strcpy(clone, str);
  return (putenv(clone));
}


static void testCallin(oop)
OOP	oop;
{
  strMsgSend(oop, "inspect", nil);
#ifdef preserved /* Tue Dec 31 21:55:47 1991 */
/**/  OOP		o, sel;
/**/  double	f;
/**/
/**/  sel = symbolToOOP("printNl");
/**/  o = msgSend(stringToOOP(msg), sel, nil);
/**/  strMsgSend(o, "inspect", nil);
/**/  strMsgSend(strMsgSend(o, ",", o, nil), "printNl", nil);
/**/  msgSendf(nil, "%s %s printNl", "this is a test");
/**/  msgSendf(&f, "%f %i + %f", 3, 4.7);
/**/  printf("result = %f\n", f);
#endif /* preserved Tue Dec 31 21:55:47 1991 */
}

static void testCString(char **string)
{
  printf("The string is %s\n", *string);
}

static void testCStringArray(int numElements, char **string)
{
  int i;
  for (i = 0; i < numElements; i++) {
    printf("Str[%d] = %s\n", i, string[i]);
  }
}

void initCFuncs()
{
  extern void marli();
  extern int system();
  extern char *getenv();
#if !defined(HAVE_IO_H)
  extern int open(), tell();
#if !defined(HAVE_UNISTD_H)
  extern int read(), write(), close();
#endif
#if !defined(IOCTL_IN_UNISTD_H) /* IRIX has a problem with this */
  extern int ioctl();
#endif
  extern off_t lseek();
#endif

  initCFuncVec();

  defineCFunc("system", system);
  defineCFunc("getenv", getenv);
  defineCFunc("putenv", my_putenv);

  defineCFunc("open", open);
  defineCFunc("close", close);
  defineCFunc("read", read);
  defineCFunc("write", write);
  /* defineCFunc("ioctl", myioctl); */
#if defined(HAVE_IOCTL) /* appears not to be present in DJGPP nor OS/2*/
  defineCFunc("ioctl", ioctl);
#endif
  defineCFunc("lseek", lseek);
  defineCFunc("tell", tell);

  /* just to round out the set */
  defineCFunc("readChar", readChar);
  defineCFunc("readUChar", readUChar);
  defineCFunc("readShort", readShort);
  defineCFunc("readUShort", readUShort);
  defineCFunc("readLong", readLong);
  defineCFunc("readULong", readULong);
  defineCFunc("readFloat", readFloat);
  defineCFunc("readDouble", readDouble);

  defineCFunc("writeChar", writeChar);
  defineCFunc("writeShort", writeShort);
  defineCFunc("writeLong", writeLong);
  defineCFunc("writeFloat", writeFloat);
  defineCFunc("writeDouble", writeDouble);

  defineCFunc("getErrno", getErrno);

  defineCFunc("testCallin", testCallin);

  defineCFunc("testCString", testCString);
  defineCFunc("testCStringArray", testCStringArray);

  /* Non standard routines */

  defineCFunc("marli", marli);

  /* Hack test routines */

#ifdef test_hack /* Thu Nov 26 19:12:44 1992 */
/**/  defineCFunc("siggy", siggy);
#endif /* test_hack Thu Nov 26 19:12:44 1992 */

  /* call to initialize any user C function definitions */
  initUserCFuncs();		/* external function, defined in cfuncs.c */
				/* and overridden by explicit definition */
				/* before linking with the Smalltalk */
				/* library.  */
}

static OOP readChar(fd)
int	fd;
{
  char		c;

  if (read(fd, &c, sizeof(c)) != sizeof(c)) {
    return (nilOOP);
  }

  return (charOOPAt(c));
}

static OOP readUChar(fd)
int	fd;
{
  unsigned char	c;

  if (read(fd, &c, sizeof(c)) != sizeof(c)) {
    return (nilOOP);
  }

  return (charOOPAt(c));
}

static OOP readShort(fd)
int	fd;
{
  short		s;

  if (read(fd, &s, sizeof(s)) != sizeof(s)) {
    return (nilOOP);
  }

  return (fromInt(s));
}

static OOP readUShort(fd)
int	fd;
{
  unsigned short s;

  if (read(fd, &s, sizeof(s)) != sizeof(s)) {
    return (nilOOP);
  }

  return (fromInt(s));
}

static OOP readLong(fd)
int	fd;
{
  long		l;

  if (read(fd, &l, sizeof(l)) != sizeof(l)) {
    return (nilOOP);
  }

  return (fromInt(l));
}

static OOP readULong(fd)
int	fd;
{
  unsigned long l;

  if (read(fd, &l, sizeof(l)) != sizeof(l)) {
    return (nilOOP);
  }

  return (fromInt(l));
}

static OOP readFloat(fd)
int	fd;
{
  float 	f;

  if (read(fd, &f, sizeof(f)) != sizeof(f)) {
    return (nilOOP);
  }

  return (floatNew(f));
}

static OOP readDouble(fd)
int	fd;
{
  double 	d;

  if (read(fd, &d, sizeof(d)) != sizeof(d)) {
    return (nilOOP);
  }

  return (floatNew(d));
}

static void writeChar(fd, c)
int	fd;
char	c;
{
  write(fd, &c, sizeof(c));
}

static void writeShort(fd, s)
int	fd;
short	s;
{
  write(fd, &s, sizeof(s));
}

static void writeLong(fd, l)
int	fd;
long	l;
{
  write(fd, &l, sizeof(l));
}

static void writeFloat(fd, f)
int	fd;
float	f;
{
  write(fd, &f, sizeof(f));
}

static void writeDouble(fd, d)
int	fd;
double	d;
{
  write(fd, &d, sizeof(d));
}

/*
 *	static void initCFuncVec()
 *
 * Description
 *
 *	Initialize the name-to-C-function mapping table.  The map can grow
 *	as needed without limit.
 *
 */
static void initCFuncVec()
{
  cFuncVecSize = CFUNC_VEC_CHUNK_SIZE;
  cFuncInfo = (CFuncInfo *)malloc(cFuncVecSize * sizeof(CFuncInfo));
  cFuncIndex = cFuncInfo;
}



/*
 *	void defineCFunc(funcName, funcAddr)
 *
 * Description
 *
 *	Defines the mapping between a string function name and the address
 *	of that function, for later use in lookupFunction.  The mapping
 *	table will expand as needed to hold new entries as they are added.
 *
 * Inputs
 *
 *	funcName: 
 *		The string name of the function to register.
 *	funcAddr: 
 *		The address of the C function to register in the mapping table.
 *
 */
void defineCFunc(funcName, funcAddr)
char	*funcName;
void	(*funcAddr)();
{
  if (cFuncIndex - cFuncInfo >= (long)cFuncVecSize) {
    unsigned long oldIndex;
    
    oldIndex = cFuncIndex - cFuncInfo;
    cFuncVecSize += CFUNC_VEC_CHUNK_SIZE;
    cFuncInfo = (CFuncInfo *)realloc(cFuncInfo, cFuncVecSize * sizeof(CFuncInfo));
    cFuncIndex = cFuncInfo + oldIndex;
  }

#ifdef debug_trace_on
  printf("Define C func %s(%x)\n", funcName, funcAddr);
  printf("CFuncIndex %x info %x\n", cFuncIndex, cFuncInfo);
#endif 

  cFuncIndex->funcName = funcName;
  cFuncIndex->funcAddr = funcAddr;
  cFuncIndex++;

#ifdef debug_trace_on
  printf("after defining index %d name %s(%x)\n", cFuncIndex,
	 cFuncIndex[-1].funcName, cFuncIndex[-1].funcAddr);
#endif
}


/*
 *	void (*lookupFunction(funcName))()
 *
 * Description
 *
 *	Returns the address of a C function which has been registered using
 *	defineCFunc with the name "funcName".  Returns nil if there is no
 *	such function.
 *
 * Inputs
 *
 *	funcName: 
 *		The name of the function to lookup.
 *
 * Outputs
 *
 *	Address of a C function, or nil if non was registered with "funcName"
 */
void (*lookupFunction(funcName))()
char	*funcName;
{
  CFuncInfo	*fip;

  for (fip = cFuncInfo; fip < cFuncIndex; fip++) {
    if (strcmp(funcName, fip->funcName) == 0) {
      return (fip->funcAddr);
    }
  }
  return (nil);
}



/*
 *	void invokeCRoutine(numArgs, methodOOP)
 *
 * Description
 *
 *	Invokes a C routine.  The Smalltalk arguments have been popped off the
 *	Smalltalk stack when this routine returns.
 *
 * Inputs
 *
 *	numArgs: 
 *		The number of actual arguments to the C function.
 *	methodOOP: 
 *		The C function wrapper method which contains the CObject
 *		which contains the C function descriptor used to control the
 *		mapping of argument types from Smalltalk to C types and
 *		determines the mapping of the C function's return type into
 *		a Smalltalk type.
 *
 */
void invokeCRoutine(numArgs, methodOOP)
long	numArgs;
OOP	methodOOP;
{
  CFuncDescriptor desc;
  CDataType	cType;
  OOP		oop;
  OOP		selfObject;
  int		i, si, fixedArgs;
  StringInfo	stringInfo[ARG_VEC_SIZE], *localSip;

  cArg = cArgVec;
  
  desc = getCFuncDescriptor(methodOOP);

  stringInfoBase = stringInfo;
  sip = stringInfo;

  selfObject = stackAt(numArgs); /* 0 == stop of stack, stack at n is n away */
				 /* from the top, the receiver is pushed */
				 /* first before the other arguments */
  fixedArgs = toInt(desc->numFixedArgs);

  for (si = i = 0; i < fixedArgs; i++) {
    cType = getCType(desc, i);
    if (cType == selfType) {
      pushSmalltalkObj(selfObject, unknownType);
    } else {
      oop = stackAt(numArgs - si - 1);
      pushSmalltalkObj(oop, cType);
      si++;
    }
  }

  popNOOPs(numArgs);

  localSip = sip;

  callCFunction(desc);
  /* Fixup all returned string variables */
  for ( ; localSip-- != stringInfo; ) {
    if (localSip->returnedType == stringOutType) {
      setOOPString(localSip->stringOOP, localSip->cString);
    } else if (localSip->returnedType == byteArrayOutType) {
      setOOPBytes(localSip->stringOOP, localSip->cString);
    }
    free(localSip->cString);
  }
}

/*
 *	static CFuncDescriptor getCFuncDescriptor(methodOOP)
 *
 * Description
 *
 *	Retrieves the C function descriptor (a C structure, not an OOP), from a
 *	method.  This function is part of the policy that the 0th method
 *	literal in a method which is a C callout method is the holder of a
 *	CObject instance for the C function descriptor.
 *
 * Inputs
 *
 *	methodOOP: 
 *		The method to retrieve the C function descriptor from.
 *
 * Outputs
 *
 *	The C data structure which is the function descriptor.
 */
static CFuncDescriptor getCFuncDescriptor(methodOOP)
OOP	methodOOP;
{
  OOP		associationOOP, descOOP;

  associationOOP = methodLiteralExt(methodOOP, 0);
  descOOP = associationValue(associationOOP);
  return ((CFuncDescriptor)oopToObj(descOOP));
}

/*
 *	static CDataType getCType(desc, index)
 *
 * Description
 *
 *	Returns the C type (the internal enumeration value of argument "index"
 *	in descriptor "desc".  If index is outside the range, returns
 *	unknownType (presumably for dealing with variadic parameter lists).
 *
 * Inputs
 *
 *	desc  : A CFunction descriptor (not the OOP, the real C structure)
 *	index : Index of the argument in the descriptor to get the C data type
 *		of.  0 based.
 *
 * Outputs
 *
 *	The CDataType enumeration value corresponding to the type of the
 *	index'th parameter.
 */
static CDataType getCType(desc, index)
CFuncDescriptor desc;
int	index;
{
  if (index < toInt(desc->numFixedArgs)) {
    return ((CDataType)toInt(desc->argTypes[index]));
  } else {
    return (unknownType);
  }
}

static void pushSmalltalkObj(oop, cType)
OOP	oop;
CDataType cType;
{
  OOP		class;
  unsigned	i;
  CParamUnion	u;

  if (cArg - cArgVec >= ARG_VEC_SIZE) {
    errorf("Attempt to push more than %d ints; extra parameters ignored",
	   ARG_VEC_SIZE);
    return;
  }

  if (isInt(oop)) {
    class = integerClass;
  } else if (oop == trueOOP || oop == falseOOP) {
    class = booleanClass;
  } else {
    class = oopClass(oop);
  }

  if (cType == smalltalkType) {
    u.ptrVal = (voidPtr)oop;
/* brd Sun Mar 19 20:52:56 GMT-0800 1995 */
/* if enableGC is true, do not put object in registry */
    if (!enableGC) {
      registerOOP(oop);		/* make sure it doesn't get gc'd */
    }
    pushObj(&u, ptrAlign);
  } else if (cType == cObjectPtrType) {
    if (isAKindOf(class, cObjectClass)) {
      CObject cObject;
      cObject = (CObject)oopToObj(oop);
      u.ptrVal = cObject->addr;
      pushObj(&u, ptrAlign);
    } else {
      errorf("Attempted to pass a non-CObject as a cObjectPtr");
    }
  } else if (class == integerClass) {
    if (cType == longType || cType == unknownType) {
      u.longVal = toInt(oop);
      pushObj(&u, longAlign);
    } else if (cType == intType || cType == charType) {
      u.intVal = toInt(oop);
      pushObj(&u, intAlign);
    } else {
      badType("Integer", cType);
    }
  } else if (class == booleanClass) {
    if (cType == intType || cType == charType || cType == unknownType) {
      u.intVal = (oop == trueOOP);
      pushObj(&u, intAlign);
    } else if (cType == longType) {
      u.longVal = (oop == trueOOP);
      pushObj(&u, longAlign);
    } else {
      badType("Boolean", cType);
    }
  } else if (class == charClass) {
    if (cType == charType || cType == unknownType) {
      u.intVal = charOOPValue(oop);
      pushObj(&u, intAlign);
    } else {
      badType("Character", cType);
    }
  } else if (class == stringClass) {
    if (cType == stringType || cType == stringOutType
	|| cType == unknownType) {
      if (sip - stringInfoBase >= ARG_VEC_SIZE) {
	errorf("Too many string arguments, max is %d.  Extras ignored.",
	       ARG_VEC_SIZE);
	return;
      }
      sip->cString = toCString(oop);
      u.ptrVal = (voidPtr)sip->cString;
      sip->stringOOP = oop;
      sip->returnedType = cType;
      sip++;
      pushObj(&u, ptrAlign);
    } else {
      badType("String", cType);
    }
  } else if (class == symbolClass) {
    if (cType == symbolType || cType == stringType || cType == unknownType) {
      if (sip - stringInfoBase >= ARG_VEC_SIZE) {
	errorf("Too many string arguments, max is %d.  Extras ignored.",
	       ARG_VEC_SIZE);
	return;
      }
      sip->cString = toCString(oop);
      u.ptrVal = (voidPtr)sip->cString;
      sip->stringOOP = oop;
      sip->returnedType = cType;
      sip++;
      pushObj(&u, ptrAlign);
    } else {
      badType("Symbol", cType);
    }
  } else if (class == byteArrayClass) {
    if (cType == byteArrayType || cType == byteArrayOutType
	|| cType == unknownType) {
      if (sip - stringInfoBase >= ARG_VEC_SIZE) {
	errorf("Too many string arguments, max is %d.  Extras ignored.",
	       ARG_VEC_SIZE);
	return;
      }
      sip->cString = toByteArray(oop);
      u.ptrVal = (voidPtr)sip->cString;
      sip->stringOOP = oop;
      sip->returnedType = cType;
      sip++;
      pushObj(&u, ptrAlign);
    } else {
      badType("ByteArray", cType);
    }
  } else if (class == floatClass) {
    if (cType == doubleType || cType == unknownType) {
      u.doubleVal = floatOOPValue(oop);
      pushObj(&u, doubleAlign);
    } else if (cType == floatType) {
      u.floatVal = (float)floatOOPValue(oop);
      pushObj(&u, floatAlign);
    } else {
      badType("Float", cType);
    }
  } else if (class == cObjectClass) { 
    if (cType == cObjectType || cType == unknownType) {
      u.ptrVal = cObjectValue(oop);
      pushObj(&u, ptrAlign);
    } else {
      badType("CObject", cType);
    }
  } else if ((cType == cObjectType || cType == unknownType)
	     && isAKindOf(class, cObjectClass)) {
    u.ptrVal = cObjectValue(oop);
    pushObj(&u, ptrAlign);
  } else if (class == undefinedObjectClass) { /* how to encode nil */
    switch (cType) {
    case cObjectType:
    case stringType:
    case symbolType:
    case unknownType:
      u.ptrVal = nil;
      pushObj(&u, ptrAlign);
      break;

    default:
      badType("UndefinedObject", cType);
    }
  } else if (class == arrayClass) {
    for (i = 1; i <= numOOPs(oopToObj(oop)); i++) {
      pushSmalltalkObj(arrayAt(oop, i), unknownType);
    }
  }
  
}

static void pushObj(up, align)
CParamUnion *up;
AlignmentType align;
{
  unsigned	i;
  int		alignInts;

  alignInts = alignments[ENUM_INT(align)] / sizeof(int);

  /* Align the stack properly */
  if ((cArg - cArgVec) % alignInts) {
    cArg += alignInts - ((cArg - cArgVec) % alignInts);
  }
  
  for (i = 0; i < typeSizes[ENUM_INT(align)] / sizeof(int); i++) {
    if (cArg - cArgVec >= ARG_VEC_SIZE) {
      errorf("Too many parameters, max = %d.  Extra parameters ignored",
	     ARG_VEC_SIZE);
      return;
    }
    *cArg++ = up->valueVec[i];
  }
}

static void callCFunction(desc)
CFuncDescriptor desc;
{  
  int		intResult;
  long		longResult;
  double	doubleResult;
  int		(*cFunction)();
  CDataType	returnType;
  OOP		returnTypeOOP;

  cFunction = (int (*)())cObjectValue(desc->cFunction);
  if (isInt(desc->returnType)) {
    returnType = (CDataType)toInt(desc->returnType);
    returnTypeOOP = nil;
  } else {
    returnTypeOOP = desc->returnType;
    returnType = cObjectType;
  }
    
  switch (returnType) {
  case voidType:
    (*cFunction)(
      cArgVec[0],  cArgVec[1],  cArgVec[2],  cArgVec[3],
      cArgVec[4],  cArgVec[5],  cArgVec[6],  cArgVec[7],
      cArgVec[8],  cArgVec[9],  cArgVec[10], cArgVec[11],
      cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
      cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
    break;

  case charType:
  case intType:
    intResult = (*cFunction)(
      cArgVec[0],  cArgVec[1],  cArgVec[2],  cArgVec[3],
      cArgVec[4],  cArgVec[5],  cArgVec[6],  cArgVec[7],
      cArgVec[8],  cArgVec[9],  cArgVec[10], cArgVec[11],
      cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
      cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
    switch (returnType) {

    case intType: 
      setStackTop(fromInt((long)intResult));
      break;

    case charType:
      setStackTop(charOOPAt((Byte)intResult));
      break;
    }
    break;

  case longType:
  case stringType:
  case symbolType:
  case cObjectType:
  case smalltalkType:
    longResult = (*(long (*)())cFunction)(
      cArgVec[0],  cArgVec[1],  cArgVec[2],  cArgVec[3],
      cArgVec[4],  cArgVec[5],  cArgVec[6],  cArgVec[7],
      cArgVec[8],  cArgVec[9],  cArgVec[10], cArgVec[11],
      cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
      cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
    switch (returnType) {
    case longType:
      setStackTop(fromInt(longResult));
      break;
    case stringType:
      if (longResult == 0) {
	setStackTop(nilOOP);
      } else {
	setStackTop(stringNew((char *)longResult));
      }
      break;
    case symbolType:
      if (longResult == 0) {
	setStackTop(nilOOP);
      } else {
	setStackTop(internString((char *)longResult));
      }
      break;
    case cObjectType:
      if (longResult == 0) {
	setStackTop(nilOOP);
      } else {
	if (returnTypeOOP) {
	  setStackTop(cObjectNewTyped((voidPtr)longResult, returnTypeOOP));
	} else {
	  setStackTop(cObjectNew((voidPtr)longResult));
	}
      }
      break;
    case smalltalkType:
      setStackTop((OOP)longResult);
      break;
    }
    break;

  case doubleType:
    doubleResult = (*(double (*)())cFunction)(
      cArgVec[0],  cArgVec[1],  cArgVec[2],  cArgVec[3],
      cArgVec[4],  cArgVec[5],  cArgVec[6],  cArgVec[7],
      cArgVec[8],  cArgVec[9],  cArgVec[10], cArgVec[11],
      cArgVec[12], cArgVec[13], cArgVec[14], cArgVec[15],
      cArgVec[16], cArgVec[17], cArgVec[18], cArgVec[19]);
    setStackTop(floatNew(doubleResult));
    break;

  default:
    errorf("Invalid C function return type specified, index %d\n",
	   returnType);
    break;
  }

  savedErrno = errno;
}

static void badType(smalltalkTypeName, cType)
char	*smalltalkTypeName;
CDataType cType;
{
  errorf("Attempt to pass a %s as a %s", smalltalkTypeName,
	 cTypeName[ENUM_INT(cType)]);
}


/*
 *	OOP makeDescriptor(funcNameOOP, returnTypeOOP, argsOOP)
 *
 * Description
 *
 *	Makes a C based descriptor for a callout-able function.  Returns a
 *	CFuncDescriptor object which holds onto the descriptor.  This
 *	descriptor is subsequently used when the called out function is
 *	invoked. 
 *
 * Inputs
 *
 *	funcNameOOP: 
 *		A Smalltalk string which contains the name of the C function to
 *		be invoked.
 *	returnTypeOOP: 
 *		A CType object or a symbol which indicates the return type.
 *	argsOOP: 
 *		An Array containing the argument type names.
 *
 * Outputs
 *
 *	CFuncDescriptor object which is used later when the callout function is
 *	invoked. 
 */
OOP makeDescriptor(funcNameOOP, returnTypeOOP, argsOOP)
OOP	funcNameOOP, returnTypeOOP, argsOOP;
{
  char		*funcName;
  void		(*funcAddr)();
  int		numArgs, i;
  CFuncDescriptor desc;
  IncPtr	incPtr;
  OOP		cFunction, cFunctionName;

  funcName = (char *)toCString(funcNameOOP);
  funcAddr = lookupFunction(funcName);
  if (funcAddr == nil) {
    errorf("No C function called %s is registered", funcName);
  }
  if (argsOOP == nilOOP) {
    numArgs = 0;
  } else {
    numArgs = numOOPs(oopToObj(argsOOP));
  }

  /*
   * since these are all either ints or new objects, I'm not moving the
   * oops
   */
  incPtr = incSavePointer();

  cFunction = cObjectNew(funcAddr);
  incAddOOP(cFunction);

  cFunctionName = stringNew(funcName);
  incAddOOP(cFunctionName);

  desc = (CFuncDescriptor)newInstanceWith(cFuncDescriptorClass, numArgs);
  desc->cFunction = cFunction;
  desc->cFunctionName = cFunctionName;
  desc->numFixedArgs = fromInt(numArgs);
  desc->returnType = classifyTypeSymbol(returnTypeOOP, true);
  for (i = 1; i <= numArgs; i++) {
    desc->argTypes[i - 1] = classifyTypeSymbol(arrayAt(argsOOP, i), false);
  }

  free(funcName);
  incRestorePointer(incPtr);
  return (allocOOP(desc));
}

static OOP classifyTypeSymbol(symbolOOP, isReturn)
OOP	symbolOOP;
mst_Boolean	isReturn;
{
  SymbolTypeMap	*sp;
  Byte		*symbolName;

  for (sp = symbolTypeMap; sp->symbol != nil; sp++) {
    if (*sp->symbol == symbolOOP) {
      return (fromInt(sp->type));
    }
  }

  if (isReturn) {
    if (isClass(symbolOOP, cTypeClass)) {
      return (symbolOOP);	/* this is the type we want! */
    }
  }

  symbolName = toCString(symbolOOP); /* yeah, yeah...but they have the same
				        representation! */
  errorf("Unknown data type symbol: %s", symbolName);

  free(symbolName);

  return (fromInt(unknownType));
}

/*
 *	void restoreCFuncDescriptor(cFuncDescOOP)
 *
 * Description
 *
 *	This routine is called during image loading to restore a C function
 *	descriptor pointer.  This is because between the time that the image
 *	was made and now, the executable image may have changed, so any
 *	reference to the C function address may be invalid.  We therefore just
 *	perform the function lookup again and use that value.
 *
 * Inputs
 *
 *	cFuncDescOOP: 
 *		A C function descriptor object to be adjusted.  Contains the
 *		name of the function to be looked up.
 *
 */
void restoreCFuncDescriptor(cFuncDescOOP)
OOP	cFuncDescOOP;
{
  CFuncDescriptor desc;
  void		(*funcAddr)();
  char		*funcName;

  desc = (CFuncDescriptor)oopToObj(cFuncDescOOP);
  funcName = (char *)toCString(desc->cFunctionName);
  funcAddr = lookupFunction(funcName);
  free(funcName);
  setCObjectValue(desc->cFunction, funcAddr);
}


/***********************************************************************
 *
 *	Call-in support code
 *
 ***********************************************************************/


#ifdef not_working_yet

??? Want byte array types ???


objectType(oop)
returns the type of an object, an enum, or unknown 


#endif /* not_done_yet */
