static void ficlFileOpen(ficlVm *vm, char *writeMode) /* ( c-addr u fam -- fileid ior ) */
{
int fam = ficlStackPopInteger(vm->dataStack);
int length = ficlStackPopInteger(vm->dataStack);
void *address = (void *)ficlStackPopPointer(vm->dataStack);
char mode[4];
FILE *f;
char *filename = (char *)malloc(length + 1);
memcpy(filename, address, length);
filename[length] = 0;
*mode = 0;
switch (FICL_FAM_OPEN_MODE(fam))
{
case 0:
ficlStackPushPointer(vm->dataStack, NULL);
ficlStackPushInteger(vm->dataStack, EINVAL);
goto EXIT;
case FICL_FAM_READ:
strcat(mode, "r");
break;
case FICL_FAM_WRITE:
strcat(mode, writeMode);
break;
case FICL_FAM_READ | FICL_FAM_WRITE:
strcat(mode, writeMode);
strcat(mode, "+");
break;
}
strcat(mode, (fam & FICL_FAM_BINARY) ? "b" : "t");
f = fopen(filename, mode);
if (f == NULL)
ficlStackPushPointer(vm->dataStack, NULL);
else
{
ficlFile *ff = (ficlFile *)malloc(sizeof(ficlFile));
strcpy(ff->filename, filename);
ff->f = f;
ficlStackPushPointer(vm->dataStack, ff);
fseek(f, 0, SEEK_SET);
}
pushIor(vm, f != NULL);
EXIT:
free(filename);
}
/*
* g e t - c u r r e n t
* SEARCH ( -- wid )
* Return wid, the identifier of the compilation word list.
*/
static void
ficlPrimitiveGetCurrent(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
ficlDictionaryLock(dictionary, FICL_TRUE);
ficlStackPushPointer(vm->dataStack, dictionary->compilationWordlist);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* f i c l - w o r d l i s t
* SEARCH ( -- wid )
* Create a new empty word list, returning its word list identifier wid.
* The new word list may be returned from a pool of preallocated word
* lists or may be dynamically allocated in data space. A system shall
* allow the creation of at least 8 new word lists in addition to any
* provided as part of the system.
* Notes:
* 1. Ficl creates a new single-list hash in the dictionary and returns
* its address.
* 2. ficl-wordlist takes an arg off the stack indicating the number of
* hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
* : wordlist 1 ficl-wordlist ;
*/
static void
ficlPrimitiveFiclWordlist(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
ficlHash *hash;
ficlUnsigned nBuckets;
FICL_STACK_CHECK(vm->dataStack, 1, 1);
nBuckets = ficlStackPopUnsigned(vm->dataStack);
hash = ficlDictionaryCreateWordlist(dictionary, nBuckets);
ficlStackPushPointer(vm->dataStack, hash);
}
/*
* S E A R C H >
* Ficl ( -- wid )
* Pop wid off the search order. Error if the search order is empty
*/
static void
ficlPrimitiveSearchPop(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
int wordlistCount;
ficlDictionaryLock(dictionary, FICL_TRUE);
wordlistCount = dictionary->wordlistCount;
if (wordlistCount == 0) {
ficlVmThrowError(vm, "search> error: empty search order");
}
ficlStackPushPointer(vm->dataStack,
dictionary->wordlists[--dictionary->wordlistCount]);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* g e t - o r d e r
* SEARCH ( -- widn ... wid1 n )
* Returns the number of word lists n in the search order and the word list
* identifiers widn ... wid1 identifying these word lists. wid1 identifies
* the word list that is searched first, and widn the word list that is
* searched last. The search order is unaffected.
*/
static void
ficlPrimitiveGetOrder(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
int wordlistCount = dictionary->wordlistCount;
int i;
ficlDictionaryLock(dictionary, FICL_TRUE);
for (i = 0; i < wordlistCount; i++) {
ficlStackPushPointer(vm->dataStack, dictionary->wordlists[i]);
}
ficlStackPushUnsigned(vm->dataStack, wordlistCount);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* s e a r c h - w o r d l i s t
* SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
* Find the definition identified by the string c-addr u in the word list
* identified by wid. If the definition is not found, return zero. If the
* definition is found, return its execution token xt and one (1) if the
* definition is immediate, minus-one (-1) otherwise.
*/
static void
ficlPrimitiveSearchWordlist(ficlVm *vm)
{
ficlString name;
ficlUnsigned16 hashCode;
ficlWord *word;
ficlHash *hash = ficlStackPopPointer(vm->dataStack);
name.length = (ficlUnsigned8)ficlStackPopUnsigned(vm->dataStack);
name.text = ficlStackPopPointer(vm->dataStack);
hashCode = ficlHashCode(name);
ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_TRUE);
word = ficlHashLookup(hash, name, hashCode);
ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_FALSE);
if (word) {
ficlStackPushPointer(vm->dataStack, word);
ficlStackPushInteger(vm->dataStack,
(ficlWordIsImmediate(word) ? 1 : -1));
} else {
ficlStackPushUnsigned(vm->dataStack, 0);
}
}
FICL_PLATFORM_EXTERN void stackPushPtr (ficlStack *stack, void *pointer) { ficlStackPushPointer(stack, pointer); }
/*
* f o r t h - w o r d l i s t
* SEARCH ( -- wid )
* Return wid, the identifier of the word list that includes all standard
* words provided by the implementation. This word list is initially the
* compilation word list and is part of the initial search order.
*/
static void
ficlPrimitiveForthWordlist(ficlVm *vm)
{
ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
ficlStackPushPointer(vm->dataStack, hash);
}
