diff options
Diffstat (limited to 'extras.c')
| -rw-r--r-- | extras.c | 267 |
1 files changed, 267 insertions, 0 deletions
diff --git a/extras.c b/extras.c new file mode 100644 index 000000000000..69ac8fd31bcc --- /dev/null +++ b/extras.c @@ -0,0 +1,267 @@ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <time.h> +#include <unistd.h> + +#include "ficl.h" + + +#ifndef FICL_ANSI + +/* +** Ficl interface to _getcwd (Win32) +** Prints the current working directory using the VM's +** textOut method... +*/ +static void ficlPrimitiveGetCwd(ficlVm *vm) +{ + char *directory; + + directory = getcwd(NULL, 80); + ficlVmTextOut(vm, directory); + ficlVmTextOut(vm, "\n"); + free(directory); + return; +} + + + +/* +** Ficl interface to _chdir (Win32) +** Gets a newline (or NULL) delimited string from the input +** and feeds it to the Win32 chdir function... +** Example: +** cd c:\tmp +*/ +static void ficlPrimitiveChDir(ficlVm *vm) +{ + ficlCountedString *counted = (ficlCountedString *)vm->pad; + ficlVmGetString(vm, counted, '\n'); + if (counted->length > 0) + { + int err = chdir(counted->text); + if (err) + { + ficlVmTextOut(vm, "Error: path not found\n"); + ficlVmThrow(vm, FICL_VM_STATUS_QUIT); + } + } + else + { + ficlVmTextOut(vm, "Warning (chdir): nothing happened\n"); + } + return; +} + + + +static void ficlPrimitiveClock(ficlVm *vm) +{ + clock_t now = clock(); + ficlStackPushUnsigned(vm->dataStack, (ficlUnsigned)now); + return; +} + +#endif /* FICL_ANSI */ + + +/* +** Ficl interface to system (ANSI) +** Gets a newline (or NULL) delimited string from the input +** and feeds it to the ANSI system function... +** Example: +** system del *.* +** \ ouch! +*/ +static void ficlPrimitiveSystem(ficlVm *vm) +{ + ficlCountedString *counted = (ficlCountedString *)vm->pad; + + ficlVmGetString(vm, counted, '\n'); + if (FICL_COUNTED_STRING_GET_LENGTH(*counted) > 0) + { + int returnValue = system(FICL_COUNTED_STRING_GET_POINTER(*counted)); + if (returnValue) + { + sprintf(vm->pad, "System call returned %d\n", returnValue); + ficlVmTextOut(vm, vm->pad); + ficlVmThrow(vm, FICL_VM_STATUS_QUIT); + } + } + else + { + ficlVmTextOut(vm, "Warning (system): nothing happened\n"); + } + return; +} + + + +/* +** Ficl add-in to load a text file and execute it... +** Cheesy, but illustrative. +** Line oriented... filename is newline (or NULL) delimited. +** Example: +** load test.f +*/ +#define BUFFER_SIZE 256 +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; +} + + + +/* +** Dump a tab delimited file that summarizes the contents of the +** dictionary hash table by hashcode... +*/ +static void ficlPrimitiveSpewHash(ficlVm *vm) +{ + ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist; + ficlWord *word; + FILE *f; + unsigned i; + unsigned hashSize = hash->size; + + if (!ficlVmGetWordToPad(vm)) + ficlVmThrow(vm, FICL_VM_STATUS_OUT_OF_TEXT); + + f = fopen(vm->pad, "w"); + if (!f) + { + ficlVmTextOut(vm, "unable to open file\n"); + return; + } + + for (i = 0; i < hashSize; i++) + { + int n = 0; + + word = hash->table[i]; + while (word) + { + n++; + word = word->link; + } + + fprintf(f, "%d\t%d", i, n); + + word = hash->table[i]; + while (word) + { + fprintf(f, "\t%s", word->name); + word = word->link; + } + + fprintf(f, "\n"); + } + + fclose(f); + return; +} + +static void ficlPrimitiveBreak(ficlVm *vm) +{ + vm->state = vm->state; + return; +} + + + +void ficlSystemCompileExtras(ficlSystem *system) +{ + ficlDictionary *dictionary = ficlSystemGetDictionary(system); + + ficlDictionarySetPrimitive(dictionary, "break", ficlPrimitiveBreak, FICL_WORD_DEFAULT); + ficlDictionarySetPrimitive(dictionary, "load", ficlPrimitiveLoad, FICL_WORD_DEFAULT); + ficlDictionarySetPrimitive(dictionary, "spewhash", ficlPrimitiveSpewHash, FICL_WORD_DEFAULT); + ficlDictionarySetPrimitive(dictionary, "system", ficlPrimitiveSystem, FICL_WORD_DEFAULT); + +#ifndef FICL_ANSI + ficlDictionarySetPrimitive(dictionary, "clock", ficlPrimitiveClock, FICL_WORD_DEFAULT); + ficlDictionarySetConstant(dictionary, "clocks/sec", CLOCKS_PER_SEC); + ficlDictionarySetPrimitive(dictionary, "pwd", ficlPrimitiveGetCwd, FICL_WORD_DEFAULT); + ficlDictionarySetPrimitive(dictionary, "cd", ficlPrimitiveChDir, FICL_WORD_DEFAULT); +#endif /* FICL_ANSI */ + + return; +} + |