void
ficlUnsetenv(FICL_VM *pVM)
{
#ifndef TESTMAIN
char *name;
#endif
char *namep;
int names;
#if FICL_ROBUST > 1
vmCheckStack(pVM, 2, 0);
#endif
names = stackPopINT(pVM->pStack);
namep = (char*) stackPopPtr(pVM->pStack);
#ifndef TESTMAIN
name = (char*) ficlMalloc(names+1);
if (!name)
vmThrowErr(pVM, "Error: out of memory");
strncpy(name, namep, names);
name[names] = '\0';
unsetenv(name);
ficlFree(name);
#endif
return;
}
/**************************************************************************
v m C r e a t e
** Creates a virtual machine either from scratch (if pVM is NULL on entry)
** or by resizing and reinitializing an existing VM to the specified stack
** sizes.
**************************************************************************/
FICL_VM *vmCreate(FICL_VM *pVM, unsigned nPStack, unsigned nRStack)
{
if (pVM == NULL)
{
pVM = (FICL_VM *)ficlMalloc(sizeof (FICL_VM));
assert (pVM);
memset(pVM, 0, sizeof (FICL_VM));
}
if (pVM->pStack)
stackDelete(pVM->pStack);
pVM->pStack = stackCreate(nPStack);
if (pVM->rStack)
stackDelete(pVM->rStack);
pVM->rStack = stackCreate(nRStack);
#if FICL_WANT_FLOAT
if (pVM->fStack)
stackDelete(pVM->fStack);
pVM->fStack = stackCreate(nPStack);
#endif
pVM->textOut = ficlTextOut;
vmReset(pVM);
return pVM;
}
void
ficlGetenv(FICL_VM *pVM)
{
#ifndef TESTMAIN
char *name;
#endif
char *namep, *value;
int names;
#if FICL_ROBUST > 1
vmCheckStack(pVM, 2, 2);
#endif
names = stackPopINT(pVM->pStack);
namep = (char*) stackPopPtr(pVM->pStack);
#ifndef TESTMAIN
name = (char*) ficlMalloc(names+1);
if (!name)
vmThrowErr(pVM, "Error: out of memory");
strncpy(name, namep, names);
name[names] = '\0';
value = getenv(name);
ficlFree(name);
if(value != NULL) {
stackPushPtr(pVM->pStack, value);
stackPushINT(pVM->pStack, strlen(value));
} else
#endif
stackPushINT(pVM->pStack, -1);
return;
}
FICL_DICT *dictCreateHashed(unsigned nCells, unsigned nHash)
{
FICL_DICT *pDict;
size_t nAlloc;
nAlloc = sizeof (FICL_HASH) + nCells * sizeof (CELL)
+ (nHash - 1) * sizeof (FICL_WORD *);
pDict = ficlMalloc(sizeof (FICL_DICT));
assert(pDict);
memset(pDict, 0, sizeof (FICL_DICT));
pDict->dict = ficlMalloc(nAlloc);
assert(pDict->dict);
pDict->size = nCells;
dictEmpty(pDict, nHash);
return pDict;
}
void dictCheckThreshold(FICL_DICT* dp)
{
if( dictCellsAvail(dp) < dictThreshold.u ) {
dp->dict = ficlMalloc( dictIncrease.u * sizeof (CELL) );
assert(dp->dict);
dp->here = dp->dict;
dp->size = dictIncrease.u;
dictAlign(dp);
}
}
void
ficlUuidFromString(FICL_VM *pVM)
{
#ifndef TESTMAIN
char *uuid;
uint32_t status;
#endif
char *uuidp;
int uuids;
uuid_t *u;
#if FICL_ROBUST > 1
vmCheckStack(pVM, 2, 0);
#endif
uuids = stackPopINT(pVM->pStack);
uuidp = (char *) stackPopPtr(pVM->pStack);
#ifndef TESTMAIN
uuid = (char *)ficlMalloc(uuids + 1);
if (!uuid)
vmThrowErr(pVM, "Error: out of memory");
strncpy(uuid, uuidp, uuids);
uuid[uuids] = '\0';
u = (uuid_t *)ficlMalloc(sizeof (*u));
uuid_from_string(uuid, u, &status);
ficlFree(uuid);
if (status != uuid_s_ok) {
ficlFree(u);
u = NULL;
}
#else
u = NULL;
#endif
stackPushPtr(pVM->pStack, u);
return;
}
void
ficlFindfile(FICL_VM *pVM)
{
#ifndef TESTMAIN
char *name;
#endif
char *type, *namep, *typep;
struct preloaded_file* fp;
int names, types;
#if FICL_ROBUST > 1
vmCheckStack(pVM, 4, 1);
#endif
types = stackPopINT(pVM->pStack);
typep = (char*) stackPopPtr(pVM->pStack);
names = stackPopINT(pVM->pStack);
namep = (char*) stackPopPtr(pVM->pStack);
#ifndef TESTMAIN
name = (char*) ficlMalloc(names+1);
if (!name)
vmThrowErr(pVM, "Error: out of memory");
strncpy(name, namep, names);
name[names] = '\0';
type = (char*) ficlMalloc(types+1);
if (!type)
vmThrowErr(pVM, "Error: out of memory");
strncpy(type, typep, types);
type[types] = '\0';
fp = file_findfile(name, type);
#else
fp = NULL;
#endif
stackPushPtr(pVM->pStack, fp);
return;
}
void
ficlSetenvq(FICL_VM *pVM)
{
#ifndef TESTMAIN
char *name, *value;
#endif
char *namep, *valuep;
int names, values, overwrite;
#if FICL_ROBUST > 1
vmCheckStack(pVM, 5, 0);
#endif
overwrite = stackPopINT(pVM->pStack);
names = stackPopINT(pVM->pStack);
namep = (char*) stackPopPtr(pVM->pStack);
values = stackPopINT(pVM->pStack);
valuep = (char*) stackPopPtr(pVM->pStack);
#ifndef TESTMAIN
name = (char*) ficlMalloc(names+1);
if (!name)
vmThrowErr(pVM, "Error: out of memory");
strncpy(name, namep, names);
name[names] = '\0';
value = (char*) ficlMalloc(values+1);
if (!value)
vmThrowErr(pVM, "Error: out of memory");
strncpy(value, valuep, values);
value[values] = '\0';
setenv(name, value, overwrite);
ficlFree(name);
ficlFree(value);
#endif
return;
}
FICL_STACK *stackCreate(unsigned nCells)
{
size_t size = sizeof (FICL_STACK) + nCells * sizeof (CELL);
FICL_STACK *pStack = ficlMalloc(size);
#if FICL_ROBUST
assert (nCells != 0);
assert (pStack != NULL);
#endif
pStack->nCells = nCells;
pStack->sp = pStack->base;
pStack->pFrame = NULL;
return pStack;
}
ficlDictionary *
ficlDictionaryCreateHashed(ficlSystem *system, unsigned size,
unsigned bucketCount)
{
ficlDictionary *dictionary;
size_t nAlloc;
nAlloc = sizeof (ficlDictionary) + (size * sizeof (ficlCell))
+ sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *);
dictionary = ficlMalloc(nAlloc);
FICL_SYSTEM_ASSERT(system, dictionary != NULL);
dictionary->size = size;
dictionary->system = system;
ficlDictionaryEmpty(dictionary, bucketCount);
return (dictionary);
}
/**************************************************************************
f i c l I n i t S y s t e m
** Binds a global dictionary to the interpreter system.
** You specify the address and size of the allocated area.
** After that, Ficl manages it.
** First step is to set up the static pointers to the area.
** Then write the "precompiled" portion of the dictionary in.
** The dictionary needs to be at least large enough to hold the
** precompiled part. Try 1K cells minimum. Use "words" to find
** out how much of the dictionary is used at any time.
**************************************************************************/
ficlSystem *ficlSystemCreate(ficlSystemInformation *fsi)
{
ficlInteger dictionarySize;
ficlInteger environmentSize;
ficlInteger stackSize;
ficlSystem *system;
ficlCallback callback;
ficlSystemInformation fauxInfo;
ficlDictionary *environment;
if (fsi == NULL)
{
fsi = &fauxInfo;
ficlSystemInformationInitialize(fsi);
}
callback.context = fsi->context;
callback.textOut = fsi->textOut;
callback.errorOut = fsi->errorOut;
callback.system = NULL;
callback.vm = NULL;
FICL_ASSERT(&callback, sizeof(ficlInteger) == sizeof(void *));
FICL_ASSERT(&callback, sizeof(ficlUnsigned) == sizeof(void *));
#if (FICL_WANT_FLOAT)
FICL_ASSERT(&callback, sizeof(ficlFloat) == sizeof(void *));
#endif
system = ficlMalloc(sizeof(ficlSystem));
FICL_ASSERT(&callback, system);
memset(system, 0, sizeof(ficlSystem));
dictionarySize = fsi->dictionarySize;
if (dictionarySize <= 0)
dictionarySize = FICL_DEFAULT_DICTIONARY_SIZE;
environmentSize = fsi->environmentSize;
if (environmentSize <= 0)
environmentSize = FICL_DEFAULT_DICTIONARY_SIZE;
stackSize = fsi->stackSize;
if (stackSize < FICL_DEFAULT_STACK_SIZE)
stackSize = FICL_DEFAULT_STACK_SIZE;
system->dictionary = ficlDictionaryCreateHashed(system, (unsigned)dictionarySize, FICL_HASH_SIZE);
system->dictionary->forthWordlist->name = "forth-wordlist";
environment = ficlDictionaryCreate(system, (unsigned)environmentSize);
system->environment = environment;
system->environment->forthWordlist->name = "environment";
system->callback.textOut = fsi->textOut;
system->callback.errorOut = fsi->errorOut;
system->callback.context = fsi->context;
system->callback.system = system;
system->callback.vm = NULL;
system->stackSize = stackSize;
#if FICL_WANT_LOCALS
/*
** The locals dictionary is only searched while compiling,
** but this is where speed is most important. On the other
** hand, the dictionary gets emptied after each use of locals
** The need to balance search speed with the cost of the 'empty'
** operation led me to select a single-threaded list...
*/
system->locals = ficlDictionaryCreate(system, (unsigned)FICL_MAX_LOCALS * FICL_CELLS_PER_WORD);
#endif /* FICL_WANT_LOCALS */
/*
** Build the precompiled dictionary and load softwords. We need a temporary
** VM to do this - ficlNewVM links one to the head of the system VM list.
** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
*/
ficlSystemCompileCore(system);
ficlSystemCompilePrefix(system);
#if FICL_WANT_FLOAT
ficlSystemCompileFloat(system);
#endif /* FICL_WANT_FLOAT */
#if FICL_WANT_PLATFORM
ficlSystemCompilePlatform(system);
#endif /* FICL_WANT_PLATFORM */
ficlSystemSetVersion(system);
/*
** Establish the parse order. Note that prefixes precede numbers -
** this allows constructs like "0b101010" which might parse as a
** hex value otherwise.
*/
ficlSystemAddPrimitiveParseStep(system, "?word", ficlVmParseWord);
ficlSystemAddPrimitiveParseStep(system, "?prefix", ficlVmParsePrefix);
ficlSystemAddPrimitiveParseStep(system, "?number", ficlVmParseNumber);
#if FICL_WANT_FLOAT
ficlSystemAddPrimitiveParseStep(system, "?float", ficlVmParseFloatNumber);
#endif
/*
** Now create a temporary VM to compile the softwords. Since all VMs are
** linked into the vmList of ficlSystem, we don't have to pass the VM
** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
** Ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
** dictionary, so a VM can be created before the dictionary is built. It just
** can't do much...
*/
ficlSystemCreateVm(system);
#define ADD_COMPILE_FLAG(name) ficlDictionarySetConstant(environment, #name, name)
ADD_COMPILE_FLAG(FICL_WANT_LZ_SOFTCORE);
ADD_COMPILE_FLAG(FICL_WANT_FILE);
ADD_COMPILE_FLAG(FICL_WANT_FLOAT);
ADD_COMPILE_FLAG(FICL_WANT_DEBUGGER);
ADD_COMPILE_FLAG(FICL_WANT_EXTENDED_PREFIX);
ADD_COMPILE_FLAG(FICL_WANT_USER);
ADD_COMPILE_FLAG(FICL_WANT_LOCALS);
ADD_COMPILE_FLAG(FICL_WANT_OOP);
ADD_COMPILE_FLAG(FICL_WANT_SOFTWORDS);
ADD_COMPILE_FLAG(FICL_WANT_MULTITHREADED);
ADD_COMPILE_FLAG(FICL_WANT_OPTIMIZE);
ADD_COMPILE_FLAG(FICL_WANT_VCALL);
ADD_COMPILE_FLAG(FICL_PLATFORM_ALIGNMENT);
ADD_COMPILE_FLAG(FICL_ROBUST);
#define ADD_COMPILE_STRING(name) ficlDictionarySetConstantString(environment, #name, name)
ADD_COMPILE_STRING(FICL_PLATFORM_ARCHITECTURE);
ADD_COMPILE_STRING(FICL_PLATFORM_OS);
ficlSystemCompileSoftCore(system);
ficlSystemDestroyVm(system->vmList);
if (ficlSystemGlobal == NULL)
ficlSystemGlobal = system;
return system;
}
/**************************************************************************
f i c l I n i t S y s t e m
** Binds a global dictionary to the interpreter system.
** You specify the address and size of the allocated area.
** After that, ficl manages it.
** First step is to set up the static pointers to the area.
** Then write the "precompiled" portion of the dictionary in.
** The dictionary needs to be at least large enough to hold the
** precompiled part. Try 1K cells minimum. Use "words" to find
** out how much of the dictionary is used at any time.
**************************************************************************/
FICL_SYSTEM *ficlInitSystemEx(FICL_SYSTEM_INFO *fsi)
{
int nDictCells;
int nEnvCells;
FICL_SYSTEM *pSys = ficlMalloc(sizeof (FICL_SYSTEM));
assert(pSys);
assert(fsi->size == sizeof (FICL_SYSTEM_INFO));
memset(pSys, 0, sizeof (FICL_SYSTEM));
nDictCells = fsi->nDictCells;
if (nDictCells <= 0)
nDictCells = FICL_DEFAULT_DICT;
nEnvCells = fsi->nEnvCells;
if (nEnvCells <= 0)
nEnvCells = FICL_DEFAULT_DICT;
pSys->dp = dictCreateHashed((unsigned)nDictCells, HASHSIZE);
pSys->dp->pForthWords->name = "forth-wordlist";
pSys->envp = dictCreate((unsigned)nEnvCells);
pSys->envp->pForthWords->name = "environment";
pSys->textOut = fsi->textOut;
pSys->pExtend = fsi->pExtend;
#if FICL_WANT_LOCALS
/*
** The locals dictionary is only searched while compiling,
** but this is where speed is most important. On the other
** hand, the dictionary gets emptied after each use of locals
** The need to balance search speed with the cost of the 'empty'
** operation led me to select a single-threaded list...
*/
pSys->localp = dictCreate((unsigned)FICL_MAX_LOCALS * CELLS_PER_WORD);
#endif
/*
** Build the precompiled dictionary and load softwords. We need a temporary
** VM to do this - ficlNewVM links one to the head of the system VM list.
** ficlCompilePlatform (defined in win32.c, for example) adds platform specific words.
*/
ficlCompileCore(pSys);
ficlCompilePrefix(pSys);
#if FICL_WANT_FLOAT
ficlCompileFloat(pSys);
#endif
#if FICL_PLATFORM_EXTEND
ficlCompilePlatform(pSys);
#endif
ficlSetVersionEnv(pSys);
/*
** Establish the parse order. Note that prefixes precede numbers -
** this allows constructs like "0b101010" which might parse as a
** hex value otherwise.
*/
ficlAddPrecompiledParseStep(pSys, "?prefix", ficlParsePrefix);
ficlAddPrecompiledParseStep(pSys, "?number", ficlParseNumber);
#if FICL_WANT_FLOAT
ficlAddPrecompiledParseStep(pSys, ">float", ficlParseFloatNumber);
#endif
/*
** Now create a temporary VM to compile the softwords. Since all VMs are
** linked into the vmList of FICL_SYSTEM, we don't have to pass the VM
** to ficlCompileSoftCore -- it just hijacks whatever it finds in the VM list.
** ficl 2.05: vmCreate no longer depends on the presence of INTERPRET in the
** dictionary, so a VM can be created before the dictionary is built. It just
** can't do much...
*/
ficlNewVM(pSys);
ficlCompileSoftCore(pSys);
ficlFreeVM(pSys->vmList);
return pSys;
}