/* ** 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; }
/* ** 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; }
/* ** 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; }
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 void vmThrow (ficlVm *vm, int except) { ficlVmThrow(vm, except); }
/* * Shim for taking commands from BF and passing them out to 'standard' * argv/argc command functions. */ static void bf_command(ficlVm *vm) { char *name, *line, *tail, *cp; size_t len; struct bootblk_command **cmdp; bootblk_cmd_t *cmd; int nstrings, i; int argc, result; char **argv; /* Get the name of the current word */ name = vm->runningWord->name; /* Find our command structure */ cmd = NULL; SET_FOREACH(cmdp, Xcommand_set) { if (((*cmdp)->c_name != NULL) && strcmp(name, (*cmdp)->c_name) == 0) cmd = (*cmdp)->c_fn; } if (cmd == NULL) panic("callout for unknown command '%s'", name); /* Check whether we have been compiled or are being interpreted */ if (ficlStackPopInteger(ficlVmGetDataStack(vm))) { /* * Get parameters from stack, in the format: * an un ... a2 u2 a1 u1 n -- * Where n is the number of strings, a/u are pairs of * address/size for strings, and they will be concatenated * in LIFO order. */ nstrings = ficlStackPopInteger(ficlVmGetDataStack(vm)); for (i = 0, len = 0; i < nstrings; i++) { ficlStack *stack = ficlVmGetDataStack(vm); len += ficlStackFetch(stack, i * 2).i + 1; } line = malloc(strlen(name) + len + 1); strcpy(line, name); if (nstrings) for (i = 0; i < nstrings; i++) { ficlStack *stack = ficlVmGetDataStack(vm); len = ficlStackPopInteger(stack); cp = ficlStackPopPointer(stack); strcat(line, " "); strncat(line, cp, len); } } else { /* Get remainder of invocation */ tail = ficlVmGetInBuf(vm); len = 0; cp = tail; for (; cp != vm->tib.end && *cp != 0 && *cp != '\n'; cp++) len++; line = malloc(strlen(name) + len + 2); strcpy(line, name); if (len > 0) { strcat(line, " "); strncat(line, tail, len); ficlVmUpdateTib(vm, tail + len); } } DPRINTF("cmd '%s'", line); command_errmsg = command_errbuf; command_errbuf[0] = 0; if (!parse(&argc, &argv, line)) { result = (cmd)(argc, argv); free(argv); } else { result = BF_PARSE; } switch (result) { case CMD_CRIT: printf("%s\n", command_errmsg); command_errmsg = NULL; break; case CMD_FATAL: panic("%s", command_errmsg); } free(line); /* * If there was error during nested ficlExec(), we may no longer have * valid environment to return. Throw all exceptions from here. */ if (result != CMD_OK) ficlVmThrow(vm, result); /* This is going to be thrown!!! */ ficlStackPushInteger(ficlVmGetDataStack(vm), result); }
static void ficlPrimitiveLoad_(ficlVm *vm, int warn, int icat_special) { char filename[FICL_COUNTED_STRING_MAX]; ficlCountedString *counted = (ficlCountedString *)filename; char *file_data; unsigned size = 0; int line_num; char *line, *c, *end; ficlCell oldSourceId; ficlString s; int result = 0; char *context; int offset; if (icat_special) { int index; FICL_STACK_CHECK(vm->dataStack,1,0); index = ficlStackPopInteger(vm->dataStack); sprintf(filename,"%sicat_config%02d.tbl",ICAT_DEV_PREFIX,index); file_data = find_and_load(filename,&size,&offset); } else { ficlVmGetString(vm, counted, '\n'); if (FICL_COUNTED_STRING_GET_LENGTH(*counted) <= 0) { ficlVmTextOut(vm, "Warning (load): nothing happened\n"); return; } file_data = find_and_load(FICL_COUNTED_STRING_GET_POINTER(*counted),&size,&offset); } /* ** get the file's size and make sure it exists */ if (file_data == NULL) if (warn) { ficlVmTextOut(vm, "Unable to open file "); ficlVmTextOut(vm, FICL_COUNTED_STRING_GET_POINTER(*counted)); ficlVmTextOut(vm, "\n"); ficlVmThrow(vm, FICL_VM_STATUS_QUIT); } else return; oldSourceId = vm->sourceId; vm->sourceId.i = -1; /* feed each line to ficlExec */ for (end = file_data + size + offset, line = file_data + offset, line_num = 1; line < end; line = ++c, line_num++) { int length; for (c = line; *c != '\n' && c<end; c++); length = c-line; if (length > 0) { FICL_STRING_SET_POINTER(s, line); FICL_STRING_SET_LENGTH(s, length); 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; free(file_data); file_data = NULL; ficlVmThrowError(vm, "Error loading file <%s> line %d", FICL_COUNTED_STRING_GET_POINTER(*counted), line_num); break; } } } if (file_data != NULL) free(file_data); vm->sourceId = oldSourceId; /* handle "bye" in loaded files. --lch */ if (result == FICL_VM_STATUS_USER_EXIT) ficlVmThrow(vm, FICL_VM_STATUS_USER_EXIT); return; }
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; }