/* * Initialise the Forth interpreter, create all our commands as words. */ void bf_init(void) { struct bootblk_command **cmdp; char create_buf[41]; /* 31 characters-long builtins */ int fd; ficlInitSystem(8000); /* Default dictionary ~4000 cells */ bf_vm = ficlNewVM(); /* Builtin constructor word */ ficlExec(bf_vm, BUILTIN_CONSTRUCTOR, -1); /* make all commands appear as Forth words */ SET_FOREACH(cmdp, Xcommand_set) { ficlBuild((*cmdp)->c_name, bf_command, FW_DEFAULT); sprintf(create_buf, "builtin: %s", (*cmdp)->c_name); ficlExec(bf_vm, create_buf, -1); }
/* * Initialise the Forth interpreter, create all our commands as words. */ void bf_init(void) { struct bootblk_command **cmdp; char create_buf[41]; /* 31 characters-long builtins */ int fd; bf_sys = ficlInitSystem(10000); /* Default dictionary ~4000 cells */ bf_vm = ficlNewVM(bf_sys); /* Put all private definitions in a "builtins" vocabulary */ ficlExec(bf_vm, "vocabulary builtins also builtins definitions"); /* Builtin constructor word */ ficlExec(bf_vm, BUILTIN_CONSTRUCTOR); /* make all commands appear as Forth words */ SET_FOREACH(cmdp, Xcommand_set) { ficlBuild(bf_sys, (char *)(*cmdp)->c_name, bf_command, FW_DEFAULT); ficlExec(bf_vm, "forth definitions builtins"); sprintf(create_buf, "builtin: %s", (*cmdp)->c_name); ficlExec(bf_vm, create_buf); ficlExec(bf_vm, "builtins definitions"); }
int ficlExecFD(FICL_VM *pVM, int fd) { char cp[nLINEBUF]; int nLine = 0, rval = VM_OUTOFTEXT; char ch; CELL id; id = pVM->sourceID; pVM->sourceID.i = fd; /* feed each line to ficlExec */ while (1) { int status, i; i = 0; while ((status = read(fd, &ch, 1)) > 0 && ch != '\n') cp[i++] = ch; nLine++; if (!i) { if (status < 1) break; continue; } rval = ficlExecC(pVM, cp, i); if(rval != VM_QUIT && rval != VM_USEREXIT && rval != VM_OUTOFTEXT) { pVM->sourceID = id; return rval; } } /* ** 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; return rval; }
int main(int argc, char **argv) { char in[256]; FICL_VM *pVM; FICL_SYSTEM *pSys; pSys = ficlInitSystem(10000); buildTestInterface(pSys); pVM = ficlNewVM(pSys); ficlEvaluate(pVM, ".ver .( " __DATE__ " ) cr quit"); /* ** load file from cmd line... */ if (argc > 1) { sprintf(in, ".( loading %s ) cr load %s\n cr", argv[1], argv[1]); ficlEvaluate(pVM, in); } for (;;) { int ret; if (fgets(in, sizeof(in) - 1, stdin) == NULL) break; ret = ficlExec(pVM, in); if (ret == VM_USEREXIT) { ficlTermSystem(pSys); break; } } return 0; }
static void ficlIncludeFile(FICL_VM *pVM) /* ( i*x fileid -- j*x ) */ { ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); CELL id = pVM->sourceID; int result = VM_OUTOFTEXT; long currentPosition, totalSize; long size; pVM->sourceID.p = (void *)ff; currentPosition = ftell(ff->f); totalSize = fileSize(ff->f); 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) result = ficlExecC(pVM, buffer, size); } #if 0 ficlFILE *ff = (ficlFILE *)stackPopPtr(pVM->pStack); CELL id = pVM->sourceID; char cp[nLINEBUF]; int nLine = 0; int keepGoing; int result; pVM->sourceID.p = (void *)ff; /* feed each line to ficlExec */ keepGoing = TRUE; while (keepGoing && fgets(cp, nLINEBUF, ff->f)) { int len = strlen(cp) - 1; nLine++; if (len <= 0) continue; if (cp[len] == '\n') cp[len] = '\0'; result = ficlExec(pVM, cp); switch (result) { case VM_OUTOFTEXT: case VM_USEREXIT: break; default: pVM->sourceID = id; keepGoing = FALSE; break; } } #endif /* 0 */ /* ** 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; closeFiclFILE(ff); }
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; }