/*
* d e f i n i t i o n s
* SEARCH ( -- )
* Make the compilation word list the same as the first word list in the
* search order. Specifies that the names of subsequent definitions will
* be placed in the compilation word list. Subsequent changes in the search
* order will not affect the compilation word list.
*/
static void
ficlPrimitiveDefinitions(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
FICL_VM_ASSERT(vm, dictionary);
if (dictionary->wordlistCount < 1) {
ficlVmThrowError(vm, "DEFINITIONS error - empty search order");
}
dictionary->compilationWordlist =
dictionary->wordlists[dictionary->wordlistCount-1];
}
/**************************************************************************
f i c l F r e e V M
** Removes the VM in question from the system VM list and deletes the
** memory allocated to it. This is an optional call, since ficlTermSystem
** will do this cleanup for you. This function is handy if you're going to
** do a lot of dynamic creation of VMs.
**************************************************************************/
void ficlSystemDestroyVm(ficlVm *vm)
{
ficlSystem *system = vm->callback.system;
ficlVm *pList = system->vmList;
FICL_VM_ASSERT(vm, vm != NULL);
if (system->vmList == vm)
{
system->vmList = system->vmList->link;
}
else for (; pList != NULL; pList = pList->link)
{
if (pList->link == vm)
{
pList->link = vm->link;
break;
}
}
if (pList)
ficlVmDestroy(vm);
return;
}
/*
** m u l t i c a l l
**
** The be-all, end-all, swiss-army-chainsaw of native function call methods in Ficl.
**
** Usage:
** ( x*argumentCount [this] [vtable] argumentCount floatArgumentBitfield cstringArgumentBitfield functionAddress flags -- returnValue | )
** Note that any/all of the arguments (x*argumentCount) and the return value can use the
** float stack instead of the data stack.
**
** To call a simple native function:
** call with flags = MULTICALL_CALLTYPE_FUNCTION
** To call a method on an object:
** pass in the "this" pointer just below argumentCount,
** call with flags = MULTICALL_CALLTYPE_METHOD
** *do not* include the "this" pointer for the purposes of argumentCount
** To call a virtual method on an object:
** pass in the "this" pointer just below argumentCount,
** call with flags = MULTICALL_CALLTYPE_VIRTUAL_METHOD
** *do not* include the "this" pointer for the purposes of argumentCount
** the function address must be the offset into the vtable for that function
** It doesn't matter whether the function you're calling is "stdcall" (caller pops
** the stack) or "fastcall" (callee pops the stack); for robustness, multicall
** always restores the original stack pointer anyway.
**
**
** To handle floating-point arguments:
** To thunk an argument from the float stack instead of the data stack, set the corresponding bit
** in the "floatArgumentBitfield" argument. Argument zero is bit 0 (1), argument one is bit 1 (2),
** argument 2 is is bit 2 (4), argument 3 is bit 3 (8), etc. For instance, to call this function:
** float greasyFingers(int a, float b, int c, float d)
** you would call
** 4 \ argumentCount
** 2 8 or \ floatArgumentBitfield, thunk argument 2 (2) and 4 (8)
** 0 \ cstringArgumentBitfield, don't thunk any arguments
** (addressOfGreasyFingers) MULTICALL-CALLTYPE-FUNCTION MULTICALL-RETURNTYPE-FLOAT or multicall
**
** To handle automatic conversion of addr-u arguments to C-style strings:
** This is much like handling float arguments. The bit set in cstringArgumentBitfield specifies
** the *length* argument (the higher of the two arguments) for each addr-u you want converted.
** You must count *both* arguments for the purposes of the argumentCount parameter.
** For instance, to call the Win32 function MessageBoxA:
**
** 0 "Howdy there!" "Title" 0
** 6 \ argument count is 6! flags text-addr text-u title-addr title-u hwnd
** 0 \ floatArgumentBitfield, don't thunk any float arguments
** 2 8 or \ cstringArgumentBitfield, thunk for title-u (argument 2, 2) and text-u (argument 4, 8)
** (addressOfMessageBoxA) MULTICALL-CALLTYPE-FUNCTION MULTICALL-RETURNTYPE-INTEGER or multicall
** The strings are copied to temporary storage and appended with a zero. These strings are freed
** before multicall returns. If you need to call functions that write to these string buffers,
** you'll need to handle thunking those arguments yourself.
**
** (If you want to call a function with more than 32 parameters, and do thunking, you need to hit somebody
** in the head with a rock. Note: this could be you!)
**
** Note that, big surprise, this function is really really really dependent
** on predefined behavior of Win32 and MSVC. It would be non-zero amounts of
** work to port to Win64, Linux, other compilers, etc.
**
** --lch
*/
static void ficlPrimitiveMulticall(ficlVm *vm)
{
int flags;
int functionAddress;
int argumentCount;
int *thisPointer;
int integerReturnValue;
#if FICL_WANT_FLOAT
float floatReturnValue;
#endif /* FICL_WANT_FLOAT */
int cstringArguments;
int floatArguments;
int i;
char **fixups;
int fixupCount;
int fixupIndex;
int *argumentPointer;
int finalArgumentCount;
int argumentDirection;
int *adjustedArgumentPointer;
int originalESP;
int vtable;
flags = ficlStackPopInteger(vm->dataStack);
functionAddress = ficlStackPopInteger(vm->dataStack);
if (FICL_MULTICALL_GET_CALLTYPE(flags) == FICL_MULTICALL_CALLTYPE_VIRTUAL_METHOD)
functionAddress *= 4;
cstringArguments = ficlStackPopInteger(vm->dataStack);
floatArguments = ficlStackPopInteger(vm->dataStack);
#if !FICL_WANT_FLOAT
FICL_VM_ASSERT(vm, !floatArguments);
FICL_VM_ASSERT(vm, FICL_MULTICALL_GET_RETURNTYPE(flags) != FICL_MULTICALL_RETURNTYPE_FLOAT);
#endif /* !FICL_WANT_FLOAT */
argumentCount = ficlStackPopInteger(vm->dataStack);
fixupCount = 0;
if (cstringArguments)
{
for (i = 0; i < argumentCount; i++)
if (cstringArguments & (1 << i))
fixupCount++;
fixups = (char **)malloc(fixupCount * sizeof(char *));
}
else
{
fixups = NULL;
}
/* argumentCount does *not* include the *this* pointer! */
if (FICL_MULTICALL_GET_CALLTYPE(flags) != FICL_MULTICALL_CALLTYPE_FUNCTION)
{
if (flags & FICL_MULTICALL_EXPLICIT_VTABLE)
vtable = ficlStackPopInteger(vm->dataStack);
__asm push ecx
thisPointer = (int *)ficlStackPopPointer(vm->dataStack);
if ((flags & FICL_MULTICALL_EXPLICIT_VTABLE) == 0)
vtable = *thisPointer;
}
__asm mov originalESP, esp
fixupIndex = 0;
finalArgumentCount = argumentCount - fixupCount;
__asm mov argumentPointer, esp
adjustedArgumentPointer = argumentPointer - finalArgumentCount;
__asm mov esp, adjustedArgumentPointer
if (flags & FICL_MULTICALL_REVERSE_ARGUMENTS)
{
argumentDirection = -1;
argumentPointer--;
}
else
{
argumentPointer = adjustedArgumentPointer;
argumentDirection = 1;
}
for (i = 0; i < argumentCount; i++)
{
int argument;
/* a single argument can't be both a float and a cstring! */
FICL_VM_ASSERT(vm, !((floatArguments & 1) && (cstringArguments & 1)));
#if FICL_WANT_FLOAT
if (floatArguments & 1)
argument = ficlStackPopInteger(vm->floatStack);
else
#endif /* FICL_WANT_FLOAT */
argument = ficlStackPopInteger(vm->dataStack);
if (cstringArguments & 1)
{
int length;
char *address;
char *buffer;
address = ficlStackPopPointer(vm->dataStack);
length = argument;
buffer = malloc(length + 1);
memcpy(buffer, address, length);
buffer[length] = 0;
fixups[fixupIndex++] = buffer;
argument = (int)buffer;
argumentCount--;
floatArguments >>= 1;
cstringArguments >>= 1;
}
*argumentPointer = argument;
argumentPointer += argumentDirection;
floatArguments >>= 1;
cstringArguments >>= 1;
}
