"
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
ExecutableFunction subclass:#ExternalFunction
instanceVariableNames:''
classVariableNames:'InvalidCustomFunctionSignal'
poolDictionaries:''
category:'System-Support'
!
!ExternalFunction primitiveFunctions!
%{
/*
* given an ST-object, make something useful for C
* cast it to an int
*
* CAVEAT: floats are not allowed.
*/
int
convertST_to_C(stObj)
OBJ stObj;
{
if (__isString(stObj) || __isSymbol(stObj)) {
return (int)(__stringVal(stObj));
}
if (__isSmallInteger(stObj)) {
return (int)(__intVal(stObj));
}
if (__isCharacter(stObj)) {
return (int)(__intVal(__characterVal(stObj)));
}
if (stObj == true) {
return 1;
}
if (stObj == false) {
return 0;
}
if (stObj == nil) {
return 0;
}
return 0;
}
%}
! !
!ExternalFunction class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
Instances of this class represent external (non-Smalltalk) functions.
Also, the class provides access to custom functions
These custom functions enable you to call c functions
even if no stc compiler is available
(they are kind of what user-primitives are in ST-80).
You can register your own custom C-functions in a private main.c
and relink ST/X from the binaries.
(see the demo functions provided in main.c).
If you have the stc compiler, we recommend using inline primitive
code: its much easier to enter, compile, debug and maintain.
(especially, to maintain, since the primitive code is contained
in the classes source/object file - while custom functions are
external to the classLibraries).
In the furture, non custom externalFunctions will be created when
a non-ST shared library is loaded, and the contained C Functions will
be callable via those handles.
- however, this is still in construction and NOT yet published for
general use. For now, either use inline C-code, or use the customFunction call
mechanism.
[author:]
Claus Gittinger
"
! !
!ExternalFunction class methodsFor:'initialization'!
initialize
"create signals"
InvalidCustomFunctionSignal isNil ifTrue:[
InvalidCustomFunctionSignal := ExecutionErrorSignal newSignalMayProceed:true.
InvalidCustomFunctionSignal nameClass:self message:#invalidCustomFunctionSignal.
InvalidCustomFunctionSignal notifierString:'attempt to execute unknown custom function'.
]
"Modified: 22.4.1996 / 18:08:55 / cg"
! !
!ExternalFunction class methodsFor:'Signal constants'!
invalidCustomFunctionSignal
"return the signal raised when a non existent custom function is
called for."
^ InvalidCustomFunctionSignal
! !
!ExternalFunction class methodsFor:'calling custom functions'!
callCustomFunction:nr
"call the custom function #nr without arguments"
^ self callCustomFunction:nr withArguments:#()
"
ExternalFunction callCustomFunction:0
ExternalFunction callCustomFunction:999
"
"Modified: 22.4.1996 / 18:06:52 / cg"
!
callCustomFunction:nr with:arg
"call the custom function #nr with a single argument"
^ self callCustomFunction:nr withArguments:(Array with:arg)
"
ExternalFunction callCustomFunction:1 with:'hello world'
"
"Modified: 22.4.1996 / 18:07:03 / cg"
!
callCustomFunction:nr with:arg1 with:arg2
"call the custom function #nr with two arguments"
^ self callCustomFunction:nr withArguments:(Array with:arg1 with:arg2)
"
ExternalFunction callCustomFunction:2 with:(Float pi) with:1.0
"
"Modified: 22.4.1996 / 18:07:11 / cg"
!
callCustomFunction:nr with:arg1 with:arg2 with:arg3
"call the custom function #nr with three arguments"
^ self callCustomFunction:nr
withArguments:(Array with:arg1 with:arg2 with:arg3)
"Modified: 22.4.1996 / 18:07:18 / cg"
!
callCustomFunction:nr withArguments:argArray
"call the custom function #nr with arguments from argArray"
|retVal called|
%{
#ifndef __stxNCustomFunctions__
extern int __stxNCustomFunctions__;
extern CUSTOMFUNCTION __stxCustomFunctions__[];
#endif
int (* func)();
called = false;
if (__isSmallInteger(nr) && __isArray(argArray)) {
int nargs = __arraySize(argArray);
int functionNr;
functionNr = __intVal(nr);
if ((functionNr >= 0) && (functionNr < __stxNCustomFunctions__)) {
/*
* now, call the function; passing nargs and arg-vector
*/
func = __stxCustomFunctions__[functionNr].func;
if (func) {
int ok;
retVal = self;
ok = (*func)(nargs, &retVal, __ArrayInstPtr(argArray)->a_element);
if (ok) {
RETURN (retVal);
}
called = true;
}
}
}
%}.
called ifTrue:[
"
the customFunction returned 0 (failure)
"
^ self primitiveFailed
].
"
an invalid customFunction-nr was given,
"
InvalidCustomFunctionSignal raise
"
ExternalFunction callCustomFunction:2 withArguments:#(1.0 1.0)
ExternalFunction callCustomFunction:999 withArguments:#(1.0 1.0)
"
!
callCustomFunctionNamed:name withArguments:argArray
"call a custom function by name with arguments from argArray"
|index|
index := self indexOfCustomFunctionNamed:name.
index notNil ifTrue:[
^ self callCustomFunction:index withArguments:argArray
].
"
no such function exists
"
InvalidCustomFunctionSignal raise
"
ExternalFunction callCustomFunctionNamed:'demoFunction0'
withArguments:#()
"
"Modified: 22.4.1996 / 18:08:09 / cg"
!
indexOfCustomFunctionNamed:functionName
"return the index of a named custom function"
%{ /* NOCONTEXT */
#ifndef __stxNCustomFunctions__
extern int __stxNCustomFunctions__;
extern CUSTOMFUNCTION __stxCustomFunctions__[];
#endif
if (__isString(functionName)) {
char *nm;
int i;
nm = __stringVal(functionName);
for (i=0; i < __stxNCustomFunctions__; i++) {
if (strcmp(__stxCustomFunctions__[i].name, nm) == 0) {
RETURN (__MKSMALLINT(i));
}
}
}
%}.
^ nil
"
ExternalFunction indexOfCustomFunctionNamed:'demoFunction0'
ExternalFunction indexOfCustomFunctionNamed:'fooBar'
"
! !
!ExternalFunction class methodsFor:'queries'!
isBuiltInClass
"return true if this class is known by the run-time-system.
Here, true is returned for myself, false for subclasses."
^ self == ExternalFunction
"Created: 16.4.1996 / 11:24:50 / cg"
"Modified: 23.4.1996 / 15:58:55 / cg"
! !
!ExternalFunction methodsFor:'function calling'!
call
"call the underlying C function, passing no argument.
The return value is interpreted as an integer
(and must be converted to an externalBytes object,
if it is a pointer to something).
DANGER alert: This is an unprotected low-level entry.
Not for normal application usage.
"
%{
INTFUNC func;
int retVal;
func = (INTFUNC) __INST(code_);
retVal = (*func)();
RETURN (__MKINT(retVal));
%}
!
callWith:arg
"call the underlying C function, passing a single argument.
The argument arg is converted to a corresponding C data type,
as defined in the convertST_to_C() function.
The return value is interpreted as an integer
(and must be converted to an externalBytes object,
if it is a pointer to something).
DANGER alert: This is an unprotected low-level entry.
Not for normal application usage.
"
%{
INTFUNC func;
int retVal;
func = (INTFUNC) __INST(code_);
retVal = (*func)(convertST_to_C(arg));
RETURN (__MKINT(retVal));
%}
!
callWithArguments:argArray
"call the underlying C function, passing up to 10 arguments.
The arguments are converted to a corresponding C data type,
as defined in the convertST_to_C() function.
The return value is interpreted as an integer
(and must be converted to an externalBytes object,
if it is a pointer to something).
DANGER alert: This is an unprotected low-level entry.
Not for normal application usage.
"
%{
INTFUNC func;
# define NUMARGS 10
int args[NUMARGS];
int retVal;
OBJ *ap;
if (__isArray(argArray)) {
int n = __arraySize(argArray);
int i;
if (n <= 10) {
ap = __ArrayInstPtr(argArray)->a_element;
for (i=0; i<NUMARGS; i++) {
args[i] = convertST_to_C(*ap++);
}
}
func = (INTFUNC) __INST(code_);
switch (n) {
case 0:
retVal = (*func)();
break;
case 1:
retVal = (*func)(args[0]);
break;
case 2:
retVal = (*func)(args[0], args[1]);
break;
case 3:
retVal = (*func)(args[0], args[1], args[2]);
break;
case 4:
retVal = (*func)(args[0], args[1], args[2], args[3]);
break;
case 5:
retVal = (*func)(args[0], args[1], args[2], args[3],
args[4]);
break;
case 6:
retVal = (*func)(args[0], args[1], args[2], args[3],
args[4], args[5]);
break;
case 7:
retVal = (*func)(args[0], args[1], args[2], args[3],
args[4], args[5], args[6]);
break;
case 8:
retVal = (*func)(args[0], args[1], args[2], args[3],
args[4], args[5], args[6], args[7]);
break;
case 9:
retVal = (*func)(args[0], args[1], args[2], args[3],
args[4], args[5], args[6], args[7],
args[8]);
break;
case 10:
retVal = (*func)(args[0], args[1], args[2], args[3],
args[4], args[5], args[6], args[7],
args[8], args[9]);
break;
default:
goto err;
}
RETURN (__MKINT(retVal));
}
err: ;
%}.
self primitiveFailed
! !
!ExternalFunction class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtFunc.st,v 1.8 1996-04-25 15:59:43 cg Exp $'
! !
ExternalFunction initialize!