home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The CDPD Public Domain Collection for CDTV 3
/
CDPDIII.bin
/
pd
/
programming
/
gnusmalltalk
/
mstcint.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-06-03
|
25KB
|
1,103 lines
/***********************************************************************
*
* C - Smalltalk Interface module
*
***********************************************************************/
/***********************************************************************
*
* Copyright (C) 1990, 1991, 1992 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 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.
*
*/
/* Define this to enable initialization of the SunView hacks in the
./examples directory */
/* #define SUN_WIN_HACKS */
#include "mst.h"
#include "mstinterp.h"
#include "mstdict.h"
#include "mstoop.h"
#include "mstsym.h"
#include "mstcallin.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,
byteArrayOutType,
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;
extern int errno;
void defineCFunc();
static void pushObj(), callCFunction(),
badType(), pushSmalltalkObj();
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[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 *", /* stringOutType */
"char *", /* symbolType */
"char *", /* byteArrayType */
"char *", /* byteArrayOutType */
"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,
&byteArrayOutSymbol, byteArrayOutType,
&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");
}
}
static int getErrno()
{
return (savedErrno);
}
#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 */
}
void initCFuncs()
{
extern void marli(), windowLoop();
extern char *getAttrName();
extern voidPtr *getAttrValue();
extern void window_create();
extern int system();
extern char *getenv();
extern int read(), write(), open(), close(), ioctl(), lseek()/*, tell()*/;
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); */
defineCFunc("ioctl", ioctl);
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);
#ifdef DLD
initDldLib();
#endif
/* Non standard routines */
defineCFunc("marli", marli);
#ifdef SUN_WIN_HACKS
defineWindowFuncs();
#endif /* SUN_WIN_HACKS */
#ifdef notdefined
defineCFunc("getAttrName", getAttrName);
defineCFunc("getAttrValue", getAttrValue);
#endif
}
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));
}
#ifdef DLD
/***********************************************************************
*
* GNU Dynamic Linking support code
*
***********************************************************************/
#include <dld.h>
char *dldArgv0;
static int getUndefinedSymCount()
{
return (dld_undefined_sym_count);
}
initDldLib()
{
if (dld_init (dld_find_executable (dldArgv0)) == 0) {
defineCFunc("dldLink", dld_link);
defineCFunc("dldUnlinkByFile", dld_unlink_by_file);
defineCFunc("dldUnlinkBySymbol", dld_unlink_by_symbol);
defineCFunc("dldGetSymbol", dld_get_symbol);
defineCFunc("dldGetFunc", dld_get_func);
defineCFunc("dldFunctionExecutableP", dld_function_executable_p);
defineCFunc("dldListUndefinedSym", dld_list_undefined_sym);
defineCFunc("dldCreateReference", dld_create_reference);
defineCFunc("dldDefineSym", dld_define_sym);
defineCFunc("dldRemoveDefinedSymbol", dld_remove_defined_symbol);
defineCFunc("getUndefinedSymCount", getUndefinedSymCount);
/* so user level code can invoke it! */
defineCFunc("defineCFunc", defineCFunc);
}
}
#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]; */
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);
} else if (sip->returnedType == byteArrayOutType) {
setOOPBytes(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;
registerOOP(oop); /* make sure it doesn't get gc'd */
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 == byteArrayOutType
|| 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 ((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;
{
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;
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)
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, true);
for (i = 1; i <= numArgs; i++) {
desc->argTypes[i - 1] = classifyTypeSymbol(arrayAt(argsOOP, i), false);
}
return (allocOOP(desc));
}
static OOP classifyTypeSymbol(symbolOOP, isReturn)
OOP symbolOOP;
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);
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);
}
/***********************************************************************
*
* Call-in support code
*
***********************************************************************/
#ifdef not_working_yet
send(receiver, selectorStr, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
arg8, arg9, arg10, arg11, arg12, arg13, arg14, arg15, arg16, arg17,
arg18, arg19, arg20)
OOP receiver, selector;
OOP arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10, arg11, arg12,
arg13, arg14, arg15, arg16, arg17, arg18, arg19, arg20;
{
}
OOP newIntObject(i)
long i;
{
return (fromInt(i));
}
OOP newCharObject(c)
Byte c;
{
return (charOOPAt(c));
}
OOP newFloatObject(f)
double f;
{
OOP oop;
oop = floatNew(f);
registerOOP(oop);
return (oop);
}
??? Want byte array types ???
OOP newStringObject(str)
char *str;
{
OOP oop;
if (str == nil) {
return (nilOOP);
} else {
oop = stringNew(str);
registerOOP(oop);
return (oop);
}
}
OOP newSymbolObject(str)
char *str;
{
OOP oop;
if (str == nil) {
return (nilOOP);
} else {
oop = internString(str);
return (oop);
}
}
OOP newCObject(cObject)
voidPtr cObject;
{
OOP oop;
if (cObject == nil) {
return (nilOOP);
} else {
oop = cObjectNew(cObject);
registerOOP(oop);
return (oop);
}
}
objectType(oop)
returns the type of an object, an enum, or unknown
need back conversion routines
void freeObject(oop)
OOP oop;
{
printf("!!! IMPLEMENT freeObject\n");
}
static void registerOOP(oop)
OOP oop;
{
printf("!!! IMPLEMENT registerOOP\n");
}
#endif /* not_done_yet */