/*
* d i c t A p p e n d W o r d
* Create a new word in the dictionary with the specified
* name, code, and flags. Name must be NULL-terminated.
*/
ficlWord *
ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name,
ficlPrimitive code, ficlUnsigned8 flags)
{
ficlString s;
FICL_STRING_SET_FROM_CSTRING(s, name);
return (ficlDictionaryAppendWord(dictionary, s, code, flags));
}
ficlWord *
ficlDictionarySetConstant(ficlDictionary *dictionary, char *name,
ficlInteger value)
{
ficlString s;
FICL_STRING_SET_FROM_CSTRING(s, name);
return (ficlDictionarySetConstantInstruction(dictionary, s,
ficlInstructionConstantParen, value));
}
ficlWord *
ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name,
char *value)
{
ficlString s;
ficl2Integer valueAs2Integer;
FICL_2INTEGER_SET(strlen(value), (intptr_t)value, valueAs2Integer);
FICL_STRING_SET_FROM_CSTRING(s, name);
return (ficlDictionarySet2ConstantInstruction(dictionary, s,
ficlInstruction2ConstantParen, valueAs2Integer));
}
ficlWord *
ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name,
ficlPrimitive code, ficlUnsigned8 flags)
{
ficlString s;
ficlWord *word;
FICL_STRING_SET_FROM_CSTRING(s, name);
word = ficlDictionaryLookup(dictionary, s);
if (word == NULL) {
word = ficlDictionaryAppendPrimitive(dictionary, name,
code, flags);
} else {
word->code = (ficlPrimitive)code;
word->flags = flags;
}
return (word);
}
static void ficlPrimitiveIncludeFile(ficlVm *vm) /* ( i*x fileid -- j*x ) */
{
ficlFile *ff = (ficlFile *)ficlStackPopPointer(vm->dataStack);
ficlCell id = vm->sourceId;
int except = FICL_VM_STATUS_OUT_OF_TEXT;
long currentPosition, totalSize;
long size;
ficlString s;
vm->sourceId.p = (void *)ff;
currentPosition = ftell(ff->f);
totalSize = ficlFileSize(ff);
size = totalSize - currentPosition;
if ((totalSize != -1) && (currentPosition != -1) && (size > 0))
{
char *buffer = (char *)malloc(size);
long got = fread(buffer, 1, size, ff->f);
if (got == size)
{
FICL_STRING_SET_POINTER(s, buffer);
FICL_STRING_SET_LENGTH(s, size);
except = ficlVmExecuteString(vm, s);
}
}
if ((except < 0) && (except != FICL_VM_STATUS_OUT_OF_TEXT))
ficlVmThrow(vm, except);
/*
** Pass an empty line with SOURCE-ID == -1 to flush
** any pending REFILLs (as required by FILE wordset)
*/
vm->sourceId.i = -1;
FICL_STRING_SET_FROM_CSTRING(s, "");
ficlVmExecuteString(vm, s);
vm->sourceId = id;
ficlFileClose(ff);
}
FICL_PLATFORM_EXTERN int ficlExec (ficlVm *vm, char *pText) { ficlString s; FICL_STRING_SET_FROM_CSTRING(s, pText); return ficlVmExecuteString(vm, s); }
static void ficlPrimitiveLoad(ficlVm *vm)
{
char buffer[BUFFER_SIZE];
char filename[BUFFER_SIZE];
ficlCountedString *counted = (ficlCountedString *)filename;
int line = 0;
FILE *f;
int result = 0;
ficlCell oldSourceId;
ficlString s;
ficlVmGetString(vm, counted, '\n');
if (FICL_COUNTED_STRING_GET_LENGTH(*counted) <= 0)
{
ficlVmTextOut(vm, "Warning (load): nothing happened\n");
return;
}
/*
** get the file's size and make sure it exists
*/
f = fopen(FICL_COUNTED_STRING_GET_POINTER(*counted), "r");
if (!f)
{
ficlVmTextOut(vm, "Unable to open file ");
ficlVmTextOut(vm, FICL_COUNTED_STRING_GET_POINTER(*counted));
ficlVmTextOut(vm, "\n");
ficlVmThrow(vm, FICL_VM_STATUS_QUIT);
}
oldSourceId = vm->sourceId;
vm->sourceId.p = (void *)f;
/* feed each line to ficlExec */
while (fgets(buffer, BUFFER_SIZE, f))
{
int length = strlen(buffer) - 1;
line++;
if (length <= 0)
continue;
if (buffer[length] == '\n')
buffer[length--] = '\0';
FICL_STRING_SET_POINTER(s, buffer);
FICL_STRING_SET_LENGTH(s, length + 1);
result = ficlVmExecuteString(vm, s);
/* handle "bye" in loaded files. --lch */
switch (result)
{
case FICL_VM_STATUS_OUT_OF_TEXT:
case FICL_VM_STATUS_USER_EXIT:
break;
default:
vm->sourceId = oldSourceId;
fclose(f);
ficlVmThrowError(vm, "Error loading file <%s> line %d", FICL_COUNTED_STRING_GET_POINTER(*counted), line);
break;
}
}
/*
** Pass an empty line with SOURCE-ID == -1 to flush
** any pending REFILLs (as required by FILE wordset)
*/
vm->sourceId.i = -1;
FICL_STRING_SET_FROM_CSTRING(s, "");
ficlVmExecuteString(vm, s);
vm->sourceId = oldSourceId;
fclose(f);
/* handle "bye" in loaded files. --lch */
if (result == FICL_VM_STATUS_USER_EXIT)
ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT);
return;
}
/**************************************************************************
f i c l L o o k u p
** Look in the system dictionary for a match to the given name. If
** found, return the address of the corresponding ficlWord. Otherwise
** return NULL.
**************************************************************************/
ficlWord *ficlSystemLookup(ficlSystem *system, char *name)
{
ficlString s;
FICL_STRING_SET_FROM_CSTRING(s, name);
return ficlDictionaryLookup(system->dictionary, s);
}
