/***********************************************************************
 *
 *	C - Smalltalk Interface module
 *
 ***********************************************************************/

/***********************************************************************
 *
 * Copyright (C) 1990, 1991 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 
 * sbyrne     4 Jun 89	  Added Smalltalk data conversion type.
 *
 * sbyrne    29 May 89	  Created.
 *
 */

/* Define this to enable initialization of the SunView hacks in the
   ./examples directory */
/* #define SUN_WIN_HACKS */

#include "mst.h"
#include "mstintrp.h"
#include "mstdict.h"
#include "mstoop.h"
#include "mstsym.h"

#define ARG_VEC_SIZE		20 /* 20 ints, 10 longs or ptrs, 5 dbls */


typedef enum {
  intAlign,
  longAlign,
  ptrAlign,
  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,
  intType,
  longType,
  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 */
  smalltalkType			/* no conversion to-from C...C sees this
				   as "void *".  */
} CDataType;

typedef struct CFuncDescriptorStruct {
  OBJ_HEADER;
  OOP		cFunction;
  OOP		cFunctionName;
  OOP		returnType;
  OOP		numFixedArgs;
  OOP		argTypes[1];	/* variable length, really numFixedArgs long */
} *CFuncDescriptor;

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

typedef struct StringInfoStruct {
  Byte		*cString;
  OOP		stringOOP;
  CDataType	returnedType;
} StringInfo;

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

typedef struct 	CFuncInfoStruct {
  char		*funcName;
  void		(*funcAddr)();
} CFuncInfo;

void				defineCFunc();

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

static CFuncInfo		cFuncInfo[100], *cFuncIndex = cFuncInfo;
static int			cArgVec[ARG_VEC_SIZE];
static int			*cArg;
static StringInfo		stringInfo[ARG_VEC_SIZE], *sip;
/* printable names for corresponding C types */
static char			*cTypeName[] = {
  "void?",			/* unknownType */
  "char",			/* charType */
  "char *",			/* stringType */
  "char *",			/* stringType */
  "char *",			/* symbolType */
  "char *",			/* byteArrayType */
  "int",			/* intType */
  "long",			/* longType */
  "double",			/* doubleType */
  "void?",			/* voidType */
  "var args?",			/* variadicType */
  "void *",			/* cObjectType */
  "void *",			/* smalltalkType */
};

static SymbolTypeMap	symbolTypeMap[] = {
  &unknownSymbol, unknownType,
  &charSymbol, charType,
  &stringSymbol, stringType,
  &stringOutSymbol, stringOutType,
  &symbolSymbol, symbolType,
  &byteArraySymbol, byteArrayType,
  &intSymbol, intType,
  &longSymbol, longType,
  &doubleSymbol, doubleType,
  &voidSymbol, voidType,
  &variadicSymbol, variadicType,
  &cObjectSymbol, cObjectType,
  &smalltalkSymbol, smalltalkType,
  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 */
static int 		alignments[] = {
  sizeof(int),			/* intType */
  sizeof(long),			/* longType */
  sizeof(voidPtr),		/* ptrType */
  DOUBLE_ALIGNMENT		/* doubleType */
};

static int		typeSizes[] = {
  sizeof(int),			/* intType */
  sizeof(long),			/* longType */
  sizeof(voidPtr),		/* ptrType */
  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");
  }
}

void initCFuncs()
{
  extern void marli(), windowLoop();
  extern char *jeff(), *getAttrName();
  extern voidPtr *getAttrValue();
  extern void window_create();
  extern int system();
  extern char *getenv();

  defineCFunc("system", system);
  defineCFunc("getenv", getenv);
  defineCFunc("marli", marli);
#ifdef SUN_WIN_HACKS
  defineWindowFuncs();
#endif /* SUN_WIN_HACKS */

#ifdef notdefined
  defineCFunc("jeff", jeff);
  defineCFunc("getAttrName", getAttrName);
  defineCFunc("getAttrValue", getAttrValue);
#endif
}

void defineCFunc(funcName, funcAddr)
char	*funcName;
void	(*funcAddr)();
{
  cFuncIndex->funcName = funcName;
  cFuncIndex->funcAddr = funcAddr;
  cFuncIndex++;
}

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: 
 *		
 *	methodOOP: 
 *		
 *
 */
void invokeCRoutine(numArgs, methodOOP)
long	numArgs;
OOP	methodOOP;
{
  CFuncDescriptor desc;
  CDataType	cType;
  OOP		oop; /* oopArgVec[32]; */
  Byte		*stringArg;
  int		i;

  cArg = cArgVec;
  
  desc = getCFuncDescriptor(methodOOP);

  sip = stringInfo;

  for (i = 0; i < numArgs; i++) {
    oop = stackAt(numArgs - i - 1);
    cType = getCType(desc, i);
    pushSmalltalkObj(oop, cType);
  }

  popNOOPs(numArgs);

  callCFunction(desc);

  /* Fixup all returned string variables */
  for ( ; sip-- != stringInfo; ) {
    if (sip->returnedType == stringOutType) {
      setOOPString(sip->stringOOP, sip->cString);
    }
    free(sip->cString);
  }
}

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)
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;
  int		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;
    pushObj(&u, ptrAlign);
  } 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 - stringInfo >= ARG_VEC_SIZE) {
	errorf("Too many string arguments, max is %d.  Extra ignored",
	       ARG_VEC_SIZE);
      }
      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 - stringInfo >= ARG_VEC_SIZE) {
	errorf("Too many string arguments, max is %d.  Extra ignored",
	       ARG_VEC_SIZE);
      }
      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 == unknownType) {
      if (sip - stringInfo >= ARG_VEC_SIZE) {
	errorf("Too many string arguments, max is %d.  Extra ignored",
	       ARG_VEC_SIZE);
      }
      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 {
      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 (class == undefinedObjectClass) {
    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;
{
  int i, 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;

  cFunction = (int (*)())cObjectValue(desc->cFunction);
  returnType = (CDataType)toInt(desc->returnType);

  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 {
	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;
  }

}

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)
OOP	funcNameOOP, returnTypeOOP, argsOOP;
{
  char		*funcName;
  void		(*funcAddr)();
  int		numArgs, i;
  CFuncDescriptor desc;

  funcName = (char *)toCString(funcNameOOP);
  funcAddr = lookupFunction(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
   */
  desc = (CFuncDescriptor)newInstanceWith(cFuncDescriptorClass, numArgs);
  desc->cFunction = cObjectNew(funcAddr);
  desc->cFunctionName = stringNew(funcName);
  desc->numFixedArgs = fromInt(numArgs);
  desc->returnType = classifyTypeSymbol(returnTypeOOP);
  for (i = 1; i <= numArgs; i++) {
    desc->argTypes[i - 1] = classifyTypeSymbol(arrayAt(argsOOP, i));
  }

  return (allocOOP(desc));
}

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

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

  symbolName = toCString(symbolOOP); /* yeah yeah...but they have the same
				        representation! */
  errorf("Unknown data type symbol: %s", 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);
  setCObjectValue(desc->cFunction, funcAddr);
}
