/************************************************************************** f i c l E x e c X T ** Given a pointer to a FICL_WORD, push an inner interpreter and ** execute the word to completion. This is in contrast with vmExecute, ** which does not guarantee that the word will have completed when ** the function returns (ie in the case of colon definitions, which ** need an inner interpreter to finish) ** ** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal ** exit condition is VM_INNEREXIT, ficl's private signal to exit the ** inner loop under normal circumstances. If another code is thrown to ** exit the loop, this function will re-throw it if it's nested under ** itself or ficlExec. ** ** NOTE: this function is intended so that C code can execute ficlWords ** given their address in the dictionary (xt). **************************************************************************/ int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord) { int except; jmp_buf vmState; jmp_buf *oldState; FICL_WORD *oldRunningWord; assert(pVM); assert(pVM->pSys->pExitInner); /* ** Save the runningword so that RESTART behaves correctly ** over nested calls. */ oldRunningWord = pVM->runningWord; /* ** Save and restore VM's jmp_buf to enable nested calls */ oldState = pVM->pState; pVM->pState = &vmState; /* This has to come before the setjmp! */ except = setjmp(vmState); if (except) vmPopIP(pVM); else vmPushIP(pVM, &(pVM->pSys->pExitInner)); switch (except) { case 0: vmExecute(pVM, pWord); vmInnerLoop(pVM); break; case VM_INNEREXIT: case VM_BREAK: break; case VM_RESTART: case VM_OUTOFTEXT: case VM_USEREXIT: case VM_QUIT: case VM_ERREXIT: case VM_ABORT: case VM_ABORTQ: default: /* user defined exit code?? */ if (oldState) { pVM->pState = oldState; vmThrow(pVM, except); } break; } pVM->pState = oldState; pVM->runningWord = oldRunningWord; return (except); }
/* ** Dump a tab delimited file that summarizes the contents of the ** dictionary hash table by hashcode... */ static void spewHash(FICL_VM *pVM) { FICL_HASH *pHash = vmGetDict(pVM)->pForthWords; FICL_WORD *pFW; FILE *pOut; unsigned i; unsigned nHash = pHash->size; if (!vmGetWordToPad(pVM)) vmThrow(pVM, VM_OUTOFTEXT); pOut = fopen(pVM->pad, "w"); if (!pOut) { vmTextOut(pVM, "unable to open file", 1); return; } for (i=0; i < nHash; i++) { int n = 0; pFW = pHash->table[i]; while (pFW) { n++; pFW = pFW->link; } fprintf(pOut, "%d\t%d", i, n); pFW = pHash->table[i]; while (pFW) { fprintf(pOut, "\t%s", pFW->name); pFW = pFW->link; } fprintf(pOut, "\n"); } fclose(pOut); return; }
/* ** Ficl interface to chdir ** Gets a newline (or NULL) delimited string from the input ** and feeds it to chdir() ** Example: ** cd c:\tmp */ static void ficlChDir(FICL_VM *pVM) { FICL_STRING *pFS = (FICL_STRING *)pVM->pad; vmGetString(pVM, pFS, '\n'); if (pFS->count > 0) { int err = chdir(pFS->text); if (err) { vmTextOut(pVM, "Error: path not found", 1); vmThrow(pVM, VM_QUIT); } } else { vmTextOut(pVM, "Warning (chdir): nothing happened", 1); } return; }
/* ** Ficl interface to system (ANSI) ** Gets a newline (or NULL) delimited string from the input ** and feeds it to system() ** Example: ** system rm -rf / ** \ ouch! */ static void ficlSystem(FICL_VM *pVM) { FICL_STRING *pFS = (FICL_STRING *)pVM->pad; vmGetString(pVM, pFS, '\n'); if (pFS->count > 0) { int err = system(pFS->text); if (err) { sprintf(pVM->pad, "System call returned %d", err); vmTextOut(pVM, pVM->pad, 1); vmThrow(pVM, VM_QUIT); } } else { vmTextOut(pVM, "Warning (system): nothing happened", 1); } return; }
static void ficlLoad(FICL_VM *pVM) { char cp[nLINEBUF]; char filename[nLINEBUF]; FICL_STRING *pFilename = (FICL_STRING *)filename; int nLine = 0; FILE *fp; int result; CELL id; struct stat buf; vmGetString(pVM, pFilename, '\n'); if (pFilename->count <= 0) { vmTextOut(pVM, "Warning (load): nothing happened", 1); return; } /* ** get the file's size and make sure it exists */ result = stat( pFilename->text, &buf ); if (result != 0) { vmTextOut(pVM, "Unable to stat file: ", 0); vmTextOut(pVM, pFilename->text, 1); vmThrow(pVM, VM_QUIT); } fp = fopen(pFilename->text, "r"); if (!fp) { vmTextOut(pVM, "Unable to open file ", 0); vmTextOut(pVM, pFilename->text, 1); vmThrow(pVM, VM_QUIT); } id = pVM->sourceID; pVM->sourceID.p = (void *)fp; /* feed each line to ficlExec */ while (fgets(cp, nLINEBUF, fp)) { int len = strlen(cp) - 1; nLine++; if (len <= 0) continue; result = ficlExecC(pVM, cp, len); if (result != VM_QUIT && result != VM_USEREXIT && result != VM_OUTOFTEXT ) { pVM->sourceID = id; fclose(fp); vmThrowErr(pVM, "Error loading file <%s> line %d", pFilename->text, nLine); break; } } /* ** Pass an empty line with SOURCE-ID == -1 to flush ** any pending REFILLs (as required by FILE wordset) */ pVM->sourceID.i = -1; ficlExec(pVM, ""); pVM->sourceID = id; fclose(fp); /* handle "bye" in loaded files. --lch */ if (result == VM_USEREXIT) vmThrow(pVM, VM_USEREXIT); return; }
/* * Shim for taking commands from BF and passing them out to 'standard' * argv/argc command functions. */ static void bf_command(FICL_VM *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)) 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 (stackPopINT(vm->pStack)) { /* * 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 = stackPopINT(vm->pStack); for (i = 0, len = 0; i < nstrings; i++) len += stackFetch(vm->pStack, i * 2).i + 1; line = malloc(strlen(name) + len + 1); strcpy(line, name); if (nstrings) for (i = 0; i < nstrings; i++) { len = stackPopINT(vm->pStack); cp = stackPopPtr(vm->pStack); strcat(line, " "); strncat(line, cp, len); } } else { /* Get remainder of invocation */ tail = vmGetInBuf(vm); for (cp = tail, len = 0; 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); vmUpdateTib(vm, tail + len); } } DEBUG("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; } 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 != 0) vmThrow(vm, result); /* This is going to be thrown!!! */ stackPushINT(vm->pStack,result); }