diff options
Diffstat (limited to 'stand/ficl/tools.c')
| -rw-r--r-- | stand/ficl/tools.c | 918 |
1 files changed, 918 insertions, 0 deletions
diff --git a/stand/ficl/tools.c b/stand/ficl/tools.c new file mode 100644 index 0000000..db1e948 --- /dev/null +++ b/stand/ficl/tools.c @@ -0,0 +1,918 @@ +/******************************************************************* +** t o o l s . c +** Forth Inspired Command Language - programming tools +** Author: John Sadler (john_sadler@alum.mit.edu) +** Created: 20 June 2000 +** $Id: tools.c,v 1.11 2001/12/05 07:21:34 jsadler Exp $ +*******************************************************************/ +/* +** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) +** All rights reserved. +** +** Get the latest Ficl release at http://ficl.sourceforge.net +** +** I am interested in hearing from anyone who uses ficl. If you have +** a problem, a success story, a defect, an enhancement request, or +** if you would like to contribute to the ficl release, please +** contact me by email at the address above. +** +** L I C E N S E and D I S C L A I M E R +** +** Redistribution and use in source and binary forms, with or without +** modification, are permitted provided that the following conditions +** are met: +** 1. Redistributions of source code must retain the above copyright +** notice, this list of conditions and the following disclaimer. +** 2. Redistributions in binary form must reproduce the above copyright +** notice, this list of conditions and the following disclaimer in the +** documentation and/or other materials provided with the distribution. +** +** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +** SUCH DAMAGE. +*/ + +/* +** NOTES: +** SEE needs information about the addresses of functions that +** are the CFAs of colon definitions, constants, variables, DOES> +** words, and so on. It gets this information from a table and supporting +** functions in words.c. +** colonParen doDoes createParen variableParen userParen constantParen +** +** Step and break debugger for Ficl +** debug ( xt -- ) Start debugging an xt +** Set a breakpoint +** Specify breakpoint default action +*/ + +/* $FreeBSD$ */ + +#ifdef TESTMAIN +#include <stdlib.h> +#include <stdio.h> /* sprintf */ +#include <ctype.h> +#else +#include <stand.h> +#endif +#include <string.h> +#include "ficl.h" + + +#if 0 +/* +** nBREAKPOINTS sizes the breakpoint array. One breakpoint (bp 0) is reserved +** for the STEP command. The rest are user programmable. +*/ +#define nBREAKPOINTS 32 + +#endif + + +/************************************************************************** + v m S e t B r e a k +** Set a breakpoint at the current value of IP by +** storing that address in a BREAKPOINT record +**************************************************************************/ +static void vmSetBreak(FICL_VM *pVM, FICL_BREAKPOINT *pBP) +{ + FICL_WORD *pStep = ficlLookup(pVM->pSys, "step-break"); + assert(pStep); + + pBP->address = pVM->ip; + pBP->origXT = *pVM->ip; + *pVM->ip = pStep; +} + + +/************************************************************************** +** d e b u g P r o m p t +**************************************************************************/ +static void debugPrompt(FICL_VM *pVM) +{ + vmTextOut(pVM, "dbg> ", 0); +} + + +/************************************************************************** +** i s A F i c l W o r d +** Vet a candidate pointer carefully to make sure +** it's not some chunk o' inline data... +** It has to have a name, and it has to look +** like it's in the dictionary address range. +** NOTE: this excludes :noname words! +**************************************************************************/ +int isAFiclWord(FICL_DICT *pd, FICL_WORD *pFW) +{ + + if (!dictIncludes(pd, pFW)) + return 0; + + if (!dictIncludes(pd, pFW->name)) + return 0; + + if ((pFW->link != NULL) && !dictIncludes(pd, pFW->link)) + return 0; + + if ((pFW->nName <= 0) || (pFW->name[pFW->nName] != '\0')) + return 0; + + if (strlen(pFW->name) != pFW->nName) + return 0; + + return 1; +} + + +#if 0 +static int isPrimitive(FICL_WORD *pFW) +{ + WORDKIND wk = ficlWordClassify(pFW); + return ((wk != COLON) && (wk != DOES)); +} +#endif + + +/************************************************************************** + f i n d E n c l o s i n g W o r d +** Given a pointer to something, check to make sure it's an address in the +** dictionary. If so, search backwards until we find something that looks +** like a dictionary header. If successful, return the address of the +** FICL_WORD found. Otherwise return NULL. +** nSEARCH_CELLS sets the maximum neighborhood this func will search before giving up +**************************************************************************/ +#define nSEARCH_CELLS 100 + +static FICL_WORD *findEnclosingWord(FICL_VM *pVM, CELL *cp) +{ + FICL_WORD *pFW; + FICL_DICT *pd = vmGetDict(pVM); + int i; + + if (!dictIncludes(pd, (void *)cp)) + return NULL; + + for (i = nSEARCH_CELLS; i > 0; --i, --cp) + { + pFW = (FICL_WORD *)(cp + 1 - (sizeof (FICL_WORD) / sizeof (CELL))); + if (isAFiclWord(pd, pFW)) + return pFW; + } + + return NULL; +} + + +/************************************************************************** + s e e +** TOOLS ( "<spaces>name" -- ) +** Display a human-readable representation of the named word's definition. +** The source of the representation (object-code decompilation, source +** block, etc.) and the particular form of the display is implementation +** defined. +**************************************************************************/ +/* +** seeColon (for proctologists only) +** Walks a colon definition, decompiling +** on the fly. Knows about primitive control structures. +*/ +static void seeColon(FICL_VM *pVM, CELL *pc) +{ + char *cp; + CELL *param0 = pc; + FICL_DICT *pd = vmGetDict(pVM); + FICL_WORD *pSemiParen = ficlLookup(pVM->pSys, "(;)"); + assert(pSemiParen); + + for (; pc->p != pSemiParen; pc++) + { + FICL_WORD *pFW = (FICL_WORD *)(pc->p); + + cp = pVM->pad; + if ((void *)pc == (void *)pVM->ip) + *cp++ = '>'; + else + *cp++ = ' '; + cp += sprintf(cp, "%3d ", (int)(pc-param0)); + + if (isAFiclWord(pd, pFW)) + { + WORDKIND kind = ficlWordClassify(pFW); + CELL c; + + switch (kind) + { + case LITERAL: + c = *++pc; + if (isAFiclWord(pd, c.p)) + { + FICL_WORD *pLit = (FICL_WORD *)c.p; + sprintf(cp, "%.*s ( %#lx literal )", + pLit->nName, pLit->name, (unsigned long)c.u); + } + else + sprintf(cp, "literal %ld (%#lx)", + (long)c.i, (unsigned long)c.u); + break; + case STRINGLIT: + { + FICL_STRING *sp = (FICL_STRING *)(void *)++pc; + pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1; + sprintf(cp, "s\" %.*s\"", sp->count, sp->text); + } + break; + case CSTRINGLIT: + { + FICL_STRING *sp = (FICL_STRING *)(void *)++pc; + pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1; + sprintf(cp, "c\" %.*s\"", sp->count, sp->text); + } + break; + case IF: + c = *++pc; + if (c.i > 0) + sprintf(cp, "if / while (branch %d)", (int)(pc+c.i-param0)); + else + sprintf(cp, "until (branch %d)", (int)(pc+c.i-param0)); + break; + case BRANCH: + c = *++pc; + if (c.i == 0) + sprintf(cp, "repeat (branch %d)", (int)(pc+c.i-param0)); + else if (c.i == 1) + sprintf(cp, "else (branch %d)", (int)(pc+c.i-param0)); + else + sprintf(cp, "endof (branch %d)", (int)(pc+c.i-param0)); + break; + + case OF: + c = *++pc; + sprintf(cp, "of (branch %d)", (int)(pc+c.i-param0)); + break; + + case QDO: + c = *++pc; + sprintf(cp, "?do (leave %d)", (int)((CELL *)c.p-param0)); + break; + case DO: + c = *++pc; + sprintf(cp, "do (leave %d)", (int)((CELL *)c.p-param0)); + break; + case LOOP: + c = *++pc; + sprintf(cp, "loop (branch %d)", (int)(pc+c.i-param0)); + break; + case PLOOP: + c = *++pc; + sprintf(cp, "+loop (branch %d)", (int)(pc+c.i-param0)); + break; + default: + sprintf(cp, "%.*s", pFW->nName, pFW->name); + break; + } + + } + else /* probably not a word - punt and print value */ + { + sprintf(cp, "%ld ( %#lx )", (long)pc->i, (unsigned long)pc->u); + } + + vmTextOut(pVM, pVM->pad, 1); + } + + vmTextOut(pVM, ";", 1); +} + +/* +** Here's the outer part of the decompiler. It's +** just a big nested conditional that checks the +** CFA of the word to decompile for each kind of +** known word-builder code, and tries to do +** something appropriate. If the CFA is not recognized, +** just indicate that it is a primitive. +*/ +static void seeXT(FICL_VM *pVM) +{ + FICL_WORD *pFW; + WORDKIND kind; + + pFW = (FICL_WORD *)stackPopPtr(pVM->pStack); + kind = ficlWordClassify(pFW); + + switch (kind) + { + case COLON: + sprintf(pVM->pad, ": %.*s", pFW->nName, pFW->name); + vmTextOut(pVM, pVM->pad, 1); + seeColon(pVM, pFW->param); + break; + + case DOES: + vmTextOut(pVM, "does>", 1); + seeColon(pVM, (CELL *)pFW->param->p); + break; + + case CREATE: + vmTextOut(pVM, "create", 1); + break; + + case VARIABLE: + sprintf(pVM->pad, "variable = %ld (%#lx)", + (long)pFW->param->i, (unsigned long)pFW->param->u); + vmTextOut(pVM, pVM->pad, 1); + break; + +#if FICL_WANT_USER + case USER: + sprintf(pVM->pad, "user variable %ld (%#lx)", + (long)pFW->param->i, (unsigned long)pFW->param->u); + vmTextOut(pVM, pVM->pad, 1); + break; +#endif + + case CONSTANT: + sprintf(pVM->pad, "constant = %ld (%#lx)", + (long)pFW->param->i, (unsigned long)pFW->param->u); + vmTextOut(pVM, pVM->pad, 1); + + default: + sprintf(pVM->pad, "%.*s is a primitive", pFW->nName, pFW->name); + vmTextOut(pVM, pVM->pad, 1); + break; + } + + if (pFW->flags & FW_IMMEDIATE) + { + vmTextOut(pVM, "immediate", 1); + } + + if (pFW->flags & FW_COMPILE) + { + vmTextOut(pVM, "compile-only", 1); + } + + return; +} + + +static void see(FICL_VM *pVM) +{ + ficlTick(pVM); + seeXT(pVM); + return; +} + + +/************************************************************************** + f i c l D e b u g X T +** debug ( xt -- ) +** Given an xt of a colon definition or a word defined by DOES>, set the +** VM up to debug the word: push IP, set the xt as the next thing to execute, +** set a breakpoint at its first instruction, and run to the breakpoint. +** Note: the semantics of this word are equivalent to "step in" +**************************************************************************/ +void ficlDebugXT(FICL_VM *pVM) +{ + FICL_WORD *xt = stackPopPtr(pVM->pStack); + WORDKIND wk = ficlWordClassify(xt); + + stackPushPtr(pVM->pStack, xt); + seeXT(pVM); + + switch (wk) + { + case COLON: + case DOES: + /* + ** Run the colon code and set a breakpoint at the next instruction + */ + vmExecute(pVM, xt); + vmSetBreak(pVM, &(pVM->pSys->bpStep)); + break; + + default: + vmExecute(pVM, xt); + break; + } + + return; +} + + +/************************************************************************** + s t e p I n +** FICL +** Execute the next instruction, stepping into it if it's a colon definition +** or a does> word. This is the easy kind of step. +**************************************************************************/ +void stepIn(FICL_VM *pVM) +{ + /* + ** Do one step of the inner loop + */ + { + M_VM_STEP(pVM) + } + + /* + ** Now set a breakpoint at the next instruction + */ + vmSetBreak(pVM, &(pVM->pSys->bpStep)); + + return; +} + + +/************************************************************************** + s t e p O v e r +** FICL +** Execute the next instruction atomically. This requires some insight into +** the memory layout of compiled code. Set a breakpoint at the next instruction +** in this word, and run until we hit it +**************************************************************************/ +void stepOver(FICL_VM *pVM) +{ + FICL_WORD *pFW; + WORDKIND kind; + FICL_WORD *pStep = ficlLookup(pVM->pSys, "step-break"); + assert(pStep); + + pFW = *pVM->ip; + kind = ficlWordClassify(pFW); + + switch (kind) + { + case COLON: + case DOES: + /* + ** assume that the next cell holds an instruction + ** set a breakpoint there and return to the inner interp + */ + pVM->pSys->bpStep.address = pVM->ip + 1; + pVM->pSys->bpStep.origXT = pVM->ip[1]; + pVM->ip[1] = pStep; + break; + + default: + stepIn(pVM); + break; + } + + return; +} + + +/************************************************************************** + s t e p - b r e a k +** FICL +** Handles breakpoints for stepped execution. +** Upon entry, bpStep contains the address and replaced instruction +** of the current breakpoint. +** Clear the breakpoint +** Get a command from the console. +** i (step in) - execute the current instruction and set a new breakpoint +** at the IP +** o (step over) - execute the current instruction to completion and set +** a new breakpoint at the IP +** g (go) - execute the current instruction and exit +** q (quit) - abort current word +** b (toggle breakpoint) +**************************************************************************/ +void stepBreak(FICL_VM *pVM) +{ + STRINGINFO si; + FICL_WORD *pFW; + FICL_WORD *pOnStep; + + if (!pVM->fRestart) + { + assert(pVM->pSys->bpStep.address); + assert(pVM->pSys->bpStep.origXT); + /* + ** Clear the breakpoint that caused me to run + ** Restore the original instruction at the breakpoint, + ** and restore the IP + */ + pVM->ip = (IPTYPE)(pVM->pSys->bpStep.address); + *pVM->ip = pVM->pSys->bpStep.origXT; + + /* + ** If there's an onStep, do it + */ + pOnStep = ficlLookup(pVM->pSys, "on-step"); + if (pOnStep) + ficlExecXT(pVM, pOnStep); + + /* + ** Print the name of the next instruction + */ + pFW = pVM->pSys->bpStep.origXT; + sprintf(pVM->pad, "next: %.*s", pFW->nName, pFW->name); +#if 0 + if (isPrimitive(pFW)) + { + strcat(pVM->pad, " ( primitive )"); + } +#endif + + vmTextOut(pVM, pVM->pad, 1); + debugPrompt(pVM); + } + else + { + pVM->fRestart = 0; + } + + si = vmGetWord(pVM); + + if (!strincmp(si.cp, "i", si.count)) + { + stepIn(pVM); + } + else if (!strincmp(si.cp, "g", si.count)) + { + return; + } + else if (!strincmp(si.cp, "l", si.count)) + { + FICL_WORD *xt; + xt = findEnclosingWord(pVM, (CELL *)(pVM->ip)); + if (xt) + { + stackPushPtr(pVM->pStack, xt); + seeXT(pVM); + } + else + { + vmTextOut(pVM, "sorry - can't do that", 1); + } + vmThrow(pVM, VM_RESTART); + } + else if (!strincmp(si.cp, "o", si.count)) + { + stepOver(pVM); + } + else if (!strincmp(si.cp, "q", si.count)) + { + ficlTextOut(pVM, FICL_PROMPT, 0); + vmThrow(pVM, VM_ABORT); + } + else if (!strincmp(si.cp, "x", si.count)) + { + /* + ** Take whatever's left in the TIB and feed it to a subordinate ficlExec + */ + int ret; + char *cp = pVM->tib.cp + pVM->tib.index; + int count = pVM->tib.end - cp; + FICL_WORD *oldRun = pVM->runningWord; + + ret = ficlExecC(pVM, cp, count); + + if (ret == VM_OUTOFTEXT) + { + ret = VM_RESTART; + pVM->runningWord = oldRun; + vmTextOut(pVM, "", 1); + } + + vmThrow(pVM, ret); + } + else + { + vmTextOut(pVM, "i -- step In", 1); + vmTextOut(pVM, "o -- step Over", 1); + vmTextOut(pVM, "g -- Go (execute to completion)", 1); + vmTextOut(pVM, "l -- List source code", 1); + vmTextOut(pVM, "q -- Quit (stop debugging and abort)", 1); + vmTextOut(pVM, "x -- eXecute the rest of the line as ficl words", 1); + debugPrompt(pVM); + vmThrow(pVM, VM_RESTART); + } + + return; +} + + +/************************************************************************** + b y e +** TOOLS +** Signal the system to shut down - this causes ficlExec to return +** VM_USEREXIT. The rest is up to you. +**************************************************************************/ +static void bye(FICL_VM *pVM) +{ + vmThrow(pVM, VM_USEREXIT); + return; +} + + +/************************************************************************** + d i s p l a y S t a c k +** TOOLS +** Display the parameter stack (code for ".s") +**************************************************************************/ +static void displayPStack(FICL_VM *pVM) +{ + FICL_STACK *pStk = pVM->pStack; + int d = stackDepth(pStk); + int i; + CELL *pCell; + + vmCheckStack(pVM, 0, 0); + + if (d == 0) + vmTextOut(pVM, "(Stack Empty) ", 0); + else + { + pCell = pStk->base; + for (i = 0; i < d; i++) + { + vmTextOut(pVM, ltoa((*pCell++).i, pVM->pad, pVM->base), 0); + vmTextOut(pVM, " ", 0); + } + } + return; +} + + +static void displayRStack(FICL_VM *pVM) +{ + FICL_STACK *pStk = pVM->rStack; + int d = stackDepth(pStk); + int i; + CELL *pCell; + FICL_DICT *dp = vmGetDict(pVM); + + vmCheckStack(pVM, 0, 0); + + if (d == 0) + vmTextOut(pVM, "(Stack Empty) ", 0); + else + { + pCell = pStk->base; + for (i = 0; i < d; i++) + { + CELL c = *pCell++; + /* + ** Attempt to find the word that contains the + ** stacked address (as if it is part of a colon definition). + ** If this works, print the name of the word. Otherwise print + ** the value as a number. + */ + if (dictIncludes(dp, c.p)) + { + FICL_WORD *pFW = findEnclosingWord(pVM, c.p); + if (pFW) + { + int offset = (CELL *)c.p - &pFW->param[0]; + sprintf(pVM->pad, "%s+%d ", pFW->name, offset); + vmTextOut(pVM, pVM->pad, 0); + continue; /* no need to print the numeric value */ + } + } + vmTextOut(pVM, ltoa(c.i, pVM->pad, pVM->base), 0); + vmTextOut(pVM, " ", 0); + } + } + + return; +} + + +/************************************************************************** + f o r g e t - w i d +** +**************************************************************************/ +static void forgetWid(FICL_VM *pVM) +{ + FICL_DICT *pDict = vmGetDict(pVM); + FICL_HASH *pHash; + + pHash = (FICL_HASH *)stackPopPtr(pVM->pStack); + hashForget(pHash, pDict->here); + + return; +} + + +/************************************************************************** + f o r g e t +** TOOLS EXT ( "<spaces>name" -- ) +** Skip leading space delimiters. Parse name delimited by a space. +** Find name, then delete name from the dictionary along with all +** words added to the dictionary after name. An ambiguous +** condition exists if name cannot be found. +** +** If the Search-Order word set is present, FORGET searches the +** compilation word list. An ambiguous condition exists if the +** compilation word list is deleted. +**************************************************************************/ +static void forget(FICL_VM *pVM) +{ + void *where; + FICL_DICT *pDict = vmGetDict(pVM); + FICL_HASH *pHash = pDict->pCompile; + + ficlTick(pVM); + where = ((FICL_WORD *)stackPopPtr(pVM->pStack))->name; + hashForget(pHash, where); + pDict->here = PTRtoCELL where; + + return; +} + + +/************************************************************************** + l i s t W o r d s +** +**************************************************************************/ +#define nCOLWIDTH 8 +static void listWords(FICL_VM *pVM) +{ + FICL_DICT *dp = vmGetDict(pVM); + FICL_HASH *pHash = dp->pSearch[dp->nLists - 1]; + FICL_WORD *wp; + int nChars = 0; + int len; + int y = 0; + unsigned i; + int nWords = 0; + char *cp; + char *pPad = pVM->pad; + + for (i = 0; i < pHash->size; i++) + { + for (wp = pHash->table[i]; wp != NULL; wp = wp->link, nWords++) + { + if (wp->nName == 0) /* ignore :noname defs */ + continue; + + cp = wp->name; + nChars += sprintf(pPad + nChars, "%s", cp); + + if (nChars > 70) + { + pPad[nChars] = '\0'; + nChars = 0; + y++; + if(y>23) { + y=0; + vmTextOut(pVM, "--- Press Enter to continue ---",0); + getchar(); + vmTextOut(pVM,"\r",0); + } + vmTextOut(pVM, pPad, 1); + } + else + { + len = nCOLWIDTH - nChars % nCOLWIDTH; + while (len-- > 0) + pPad[nChars++] = ' '; + } + + if (nChars > 70) + { + pPad[nChars] = '\0'; + nChars = 0; + y++; + if(y>23) { + y=0; + vmTextOut(pVM, "--- Press Enter to continue ---",0); + getchar(); + vmTextOut(pVM,"\r",0); + } + vmTextOut(pVM, pPad, 1); + } + } + } + + if (nChars > 0) + { + pPad[nChars] = '\0'; + nChars = 0; + vmTextOut(pVM, pPad, 1); + } + + sprintf(pVM->pad, "Dictionary: %d words, %ld cells used of %u total", + nWords, (long) (dp->here - dp->dict), dp->size); + vmTextOut(pVM, pVM->pad, 1); + return; +} + + +/************************************************************************** + l i s t E n v +** Print symbols defined in the environment +**************************************************************************/ +static void listEnv(FICL_VM *pVM) +{ + FICL_DICT *dp = pVM->pSys->envp; + FICL_HASH *pHash = dp->pForthWords; + FICL_WORD *wp; + unsigned i; + int nWords = 0; + + for (i = 0; i < pHash->size; i++) + { + for (wp = pHash->table[i]; wp != NULL; wp = wp->link, nWords++) + { + vmTextOut(pVM, wp->name, 1); + } + } + + sprintf(pVM->pad, "Environment: %d words, %ld cells used of %u total", + nWords, (long) (dp->here - dp->dict), dp->size); + vmTextOut(pVM, pVM->pad, 1); + return; +} + + +/************************************************************************** + e n v C o n s t a n t +** Ficl interface to ficlSetEnv and ficlSetEnvD - allow ficl code to set +** environment constants... +**************************************************************************/ +static void envConstant(FICL_VM *pVM) +{ + unsigned value; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 1, 0); +#endif + + vmGetWordToPad(pVM); + value = POPUNS(); + ficlSetEnv(pVM->pSys, pVM->pad, (FICL_UNS)value); + return; +} + +static void env2Constant(FICL_VM *pVM) +{ + unsigned v1, v2; + +#if FICL_ROBUST > 1 + vmCheckStack(pVM, 2, 0); +#endif + + vmGetWordToPad(pVM); + v2 = POPUNS(); + v1 = POPUNS(); + ficlSetEnvD(pVM->pSys, pVM->pad, v1, v2); + return; +} + + +/************************************************************************** + f i c l C o m p i l e T o o l s +** Builds wordset for debugger and TOOLS optional word set +**************************************************************************/ + +void ficlCompileTools(FICL_SYSTEM *pSys) +{ + FICL_DICT *dp = pSys->dp; + assert (dp); + + /* + ** TOOLS and TOOLS EXT + */ + dictAppendWord(dp, ".s", displayPStack, FW_DEFAULT); + dictAppendWord(dp, "bye", bye, FW_DEFAULT); + dictAppendWord(dp, "forget", forget, FW_DEFAULT); + dictAppendWord(dp, "see", see, FW_DEFAULT); + dictAppendWord(dp, "words", listWords, FW_DEFAULT); + + /* + ** Set TOOLS environment query values + */ + ficlSetEnv(pSys, "tools", FICL_TRUE); + ficlSetEnv(pSys, "tools-ext", FICL_FALSE); + + /* + ** Ficl extras + */ + dictAppendWord(dp, "r.s", displayRStack, FW_DEFAULT); /* guy carver */ + dictAppendWord(dp, ".env", listEnv, FW_DEFAULT); + dictAppendWord(dp, "env-constant", + envConstant, FW_DEFAULT); + dictAppendWord(dp, "env-2constant", + env2Constant, FW_DEFAULT); + dictAppendWord(dp, "debug-xt", ficlDebugXT, FW_DEFAULT); + dictAppendWord(dp, "parse-order", + ficlListParseSteps, + FW_DEFAULT); + dictAppendWord(dp, "step-break",stepBreak, FW_DEFAULT); + dictAppendWord(dp, "forget-wid",forgetWid, FW_DEFAULT); + dictAppendWord(dp, "see-xt", seeXT, FW_DEFAULT); + + return; +} + |
