d/freebsd-dev
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Update to FICL 3.03 (the last release before FICL4 rewrite).

Browse Source 
The relevant changes for FreeBSD (excerpt from the release note):

  * Newly implemented CORE EXT words: CASE, OF, ENDOF, and ENDCASE. Also
    added FALLTHROUGH, which works like ENDOF but jumps to the instruction
    just after the next OF.
  * Bugfix: John-Hopkins locals syntax now accepts | and -- in the comment
    (between the first -- and the }.)
  * Bugfix: Changed vmGetWord0() to make Purify happier. The resulting
    code is no slower, no larger, and slightly more robust.
This commit is contained in:
Jung-uk Kim 2007-03-23 22:26:01 +00:00
parent 793a8b5fd4
commit 5bf7a61bb3
Notes: svn2git 2020-12-20 02:59:44 +00:00 
svn path=/head/; revision=167850
11 changed files with 410 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
sys/boot/ficl/ficl.h
View File

@ -237,9 +237,9 @@ typedef struct ficl_system_info FICL_SYSTEM_INFO;
/*
** the Good Stuff starts here...
*/
#define FICL_VER "3.02"
#define FICL_VER "3.03"
#define FICL_VER_MAJOR 3
#define FICL_VER_MINOR 2
#define FICL_VER_MINOR 3
#if !defined (FICL_PROMPT)
#define FICL_PROMPT "ok> "
#endif
@ -857,7 +857,7 @@ struct ficl_system
FICL_WORD *pDoesParen;
FICL_WORD *pExitInner;
FICL_WORD *pExitParen;
FICL_WORD *pIfParen;
FICL_WORD *pBranch0;
FICL_WORD *pInterpret;
FICL_WORD *pLitParen;
FICL_WORD *pTwoLitParen;
@ -865,7 +865,9 @@ struct ficl_system
FICL_WORD *pPLoopParen;
FICL_WORD *pQDoParen;
FICL_WORD *pSemiParen;
FICL_WORD *pOfParen;
FICL_WORD *pStore;
FICL_WORD *pDrop;
FICL_WORD *pCStringLit;
FICL_WORD *pStringLit;
@ -1086,6 +1088,7 @@ typedef enum
IF,
LITERAL,
LOOP,
OF,
PLOOP,
PRIMITIVE,
QDO,

3
sys/boot/ficl/float.c
View File

@ -977,6 +977,8 @@ int ficlParseFloatNumber( FICL_VM *pVM, STRINGINFO si )
}
PUSHFLOAT(accum);
if (pVM->state == COMPILE)
fliteralIm(pVM);
return(1);
}
@ -1062,3 +1064,4 @@ void ficlCompileFloat(FICL_SYSTEM *pSys)
#endif
return;
}

3
sys/boot/ficl/softwords/fileaccess.fr
View File

@ -15,12 +15,11 @@
r/o bin open-file 0= if
locals| f | end-locals
f include-file
f close-file drop
else
drop
endif
;
: include parse-word included ; immediate
: include parse-word included ;
\ #endif

19
sys/boot/ficl/softwords/jhlocal.fr
View File

@ -17,8 +17,10 @@
\ $FreeBSD$
hide
0 constant zero
: ?-- ( c-addr u -- c-addr u flag )
2dup s" --" compare 0= ;
: ?} ( c-addr u -- c-addr u flag )
@ -74,23 +76,24 @@ set-current
parse-word
?delim dup to locstate
0= while
?2loc if
postpone zero postpone zero (2local)
else
postpone zero (local)
endif
?2loc if
postpone zero postpone zero (2local)
else
postpone zero (local)
endif
repeat
endif
0 0 (local)
\ toss words until }
\ (explicitly allow | and -- in the comment)
locstate 2 = if
begin
parse-word
?delim dup to locstate
0= while
2drop
?delim dup to locstate
3 < while
locstate 0= if 2drop endif
repeat
endif

15
sys/boot/ficl/softwords/oo.fr
View File

@ -86,8 +86,6 @@ user current-class
\ execute it at run-time...
\
hide
\ p a r s e - m e t h o d
\ compiles a method name so that it pushes
\ the string base address and count at run-time.
@ -97,6 +95,13 @@ hide
postpone sliteral
; compile-only
: (lookup-method) { class 2:name -- class 0 | class xt 1 | class xt -1 }
class name class cell+ @ ( class c-addr u wid )
search-wordlist
;
\ l o o k u p - m e t h o d
\ takes a counted string method name from the stack (as compiled
\ by parse-method) and attempts to look this method up in the method list of
@ -104,22 +109,18 @@ hide
\ and pushes the xt of the method. If not, it aborts with an error message.
: lookup-method { class 2:name -- class xt }
name class cell+ @ ( c-addr u wid )
search-wordlist ( 0 | xt 1 | xt -1 )
class name (lookup-method) ( 0 | xt 1 | xt -1 )
0= if
name type ." not found in "
class body> >name type
cr abort
endif
class swap
;
: find-method-xt \ name ( class -- class xt )
parse-word lookup-method
;
set-current ( stop hiding definitions )
: catch-method ( instance class c-addr u -- <method-signature> exc-flag )
lookup-method catch
;

2
sys/boot/ficl/softwords/prefix.fr
View File

@ -22,7 +22,7 @@ start-prefixes
\ make .( a prefix (we just create an alias for it in the prefixes list)
: .( .( ;
: .( postpone .( ; immediate
\ make \ a prefix, and add // (same thing) as a prefix too

49
sys/boot/ficl/softwords/softcore.awk
View File

@ -14,21 +14,59 @@
BEGIN \
{
printf "/***************************************************************\n";
printf "/*******************************************************************\n";
printf "** s o f t c o r e . c\n";
printf "** Forth Inspired Command Language -\n";
printf "** Words from CORE set written in FICL\n";
printf "** Author: John Sadler (john_sadler@alum.mit.edu)\n";
printf "** Created: 27 December 1997\n";
printf "** Last update: %s\n", datestamp;
printf "***************************************************************/\n";
printf "\n/*\n";
printf "*******************************************************************/\n";
printf "/*\n";
printf "** DO NOT EDIT THIS FILE -- it is generated by softwords/softcore.awk\n";
printf "** Make changes to the .fr files in ficl/softwords instead.\n";
printf "** This file contains definitions that are compiled into the\n";
printf "** system dictionary by the first virtual machine to be created.\n";
printf "** Created automagically by ficl/softwords/softcore.awk\n";
printf "*/\n";
printf "/*\n";
printf "** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)\n";
printf "** All rights reserved.\n";
printf "**\n";
printf "** Get the latest Ficl release at http://ficl.sourceforge.net\n";
printf "**\n";
printf "** I am interested in hearing from anyone who uses ficl. If you have\n";
printf "** a problem, a success story, a defect, an enhancement request, or\n";
printf "** if you would like to contribute to the ficl release, please send\n";
printf "** contact me by email at the address above.\n";
printf "**\n";
printf "** L I C E N S E and D I S C L A I M E R\n";
printf "** \n";
printf "** Redistribution and use in source and binary forms, with or without\n";
printf "** modification, are permitted provided that the following conditions\n";
printf "** are met:\n";
printf "** 1. Redistributions of source code must retain the above copyright\n";
printf "** notice, this list of conditions and the following disclaimer.\n";
printf "** 2. Redistributions in binary form must reproduce the above copyright\n";
printf "** notice, this list of conditions and the following disclaimer in the\n";
printf "** documentation and/or other materials provided with the distribution.\n";
printf "**\n";
printf "** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND\n";
printf "** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\n";
printf "** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\n";
printf "** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE\n";
printf "** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\n";
printf "** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS\n";
printf "** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)\n";
printf "** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT\n";
printf "** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY\n";
printf "** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\n";
printf "** SUCH DAMAGE.\n";
printf "*/\n";
printf "\n";
printf "\n#include \"ficl.h\"\n";
printf "\nstatic char softWords[] =\n";
printf "#if FICL_WANT_SOFTWORDS\n";
commenting = 0;
}
@ -127,14 +165,17 @@ function end_comments()
END \
{
if (commenting) end_comments();
printf "#endif /* WANT_SOFTWORDS */\n";
printf " \"quit \";\n";
printf "\n\nvoid ficlCompileSoftCore(FICL_SYSTEM *pSys)\n";
printf "{\n";
printf " FICL_VM *pVM = pSys->vmList;\n";
printf " CELL id = pVM->sourceID;\n";
printf " int ret = sizeof (softWords);\n";
printf " assert(pVM);\n";
printf "\n"
printf " pVM->sourceID.i = -1;\n";
printf " ret = ficlExec(pVM, softWords);\n";
printf " pVM->sourceID = id;\n";
printf " if (ret == VM_ERREXIT)\n";
printf " assert(FALSE);\n";
printf " return;\n";

11
sys/boot/ficl/tools.c
View File

@ -244,10 +244,17 @@ static void seeColon(FICL_VM *pVM, CELL *pc)
break;
case BRANCH:
c = *++pc;
if (c.i > 0)
if (c.i == 0)
sprintf(cp, "repeat (branch %d)", pc+c.i-param0);
else if (c.i == 1)
sprintf(cp, "else (branch %d)", pc+c.i-param0);
else
sprintf(cp, "repeat (branch %d)", pc+c.i-param0);
sprintf(cp, "endof (branch %d)", pc+c.i-param0);
break;
case OF:
c = *++pc;
sprintf(cp, "of (branch %d)", pc+c.i-param0);
break;
case QDO:

6
sys/boot/ficl/unix.c
View File

@ -8,9 +8,9 @@
unsigned long ficlNtohl(unsigned long number)
{
return ntohl(number);
}
{
return ntohl(number);
}

16
sys/boot/ficl/vm.c
View File

@ -316,15 +316,29 @@ STRINGINFO vmGetWord0(FICL_VM *pVM)
char *pEnd = vmGetInBufEnd(pVM);
STRINGINFO si;
FICL_UNS count = 0;
char ch;
char ch = 0;
pSrc = skipSpace(pSrc, pEnd);
SI_SETPTR(si, pSrc);
/*
for (ch = *pSrc; (pEnd != pSrc) && !isspace(ch); ch = *++pSrc)
{
count++;
}
*/
/* Changed to make Purify happier. --lch */
for (;;)
{
if (pEnd == pSrc)
break;
ch = *pSrc;
if (isspace(ch))
break;
count++;
pSrc++;
}
SI_SETLEN(si, count);

350
sys/boot/ficl/words.c
View File

@ -71,6 +71,10 @@ static char leaveTag[] = "leave";
static char destTag[] = "target";
static char origTag[] = "origin";
static char caseTag[] = "case";
static char ofTag[] = "of";
static char fallthroughTag[] = "fallthrough";
#if FICL_WANT_LOCALS
static void doLocalIm(FICL_VM *pVM);
static void do2LocalIm(FICL_VM *pVM);
@ -1220,34 +1224,26 @@ static void cStore(FICL_VM *pVM)
/**************************************************************************
i f C o I m
** IMMEDIATE
** Compiles code for a conditional branch into the dictionary
** and pushes the branch patch address on the stack for later
** patching by ELSE or THEN/ENDIF.
b r a n c h P a r e n
**
** Runtime for "(branch)" -- expects a literal offset in the next
** compilation address, and branches to that location.
**************************************************************************/
static void ifCoIm(FICL_VM *pVM)
static void branchParen(FICL_VM *pVM)
{
FICL_DICT *dp = vmGetDict(pVM);
assert(pVM->pSys->pIfParen);
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
markBranch(dp, pVM, origTag);
dictAppendUNS(dp, 1);
vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
return;
}
/**************************************************************************
i f P a r e n
** Runtime code to do "if" or "until": pop a flag from the stack,
** fall through if true, branch if false. Probably ought to be
** called (not?branch) since it does "branch if false".
b r a n c h 0
** Runtime code for "(branch0)"; pop a flag from the stack,
** branch if 0. fall through otherwise. The heart of "if" and "until".
**************************************************************************/
static void ifParen(FICL_VM *pVM)
static void branch0(FICL_VM *pVM)
{
FICL_UNS flag;
@ -1269,10 +1265,32 @@ static void ifParen(FICL_VM *pVM)
}
/**************************************************************************
i f C o I m
** IMMEDIATE COMPILE-ONLY
** Compiles code for a conditional branch into the dictionary
** and pushes the branch patch address on the stack for later
** patching by ELSE or THEN/ENDIF.
**************************************************************************/
static void ifCoIm(FICL_VM *pVM)
{
FICL_DICT *dp = vmGetDict(pVM);
assert(pVM->pSys->pBranch0);
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranch0));
markBranch(dp, pVM, origTag);
dictAppendUNS(dp, 1);
return;
}
/**************************************************************************
e l s e C o I m
**
** IMMEDIATE -- compiles an "else"...
** IMMEDIATE COMPILE-ONLY
** compiles an "else"...
** 1) Compile a branch and a patch address; the address gets patched
** by "endif" to point past the "else" code.
** 2) Pop the the "if" patch address
@ -1302,23 +1320,9 @@ static void elseCoIm(FICL_VM *pVM)
}
/**************************************************************************
b r a n c h P a r e n
**
** Runtime for "(branch)" -- expects a literal offset in the next
** compilation address, and branches to that location.
**************************************************************************/
static void branchParen(FICL_VM *pVM)
{
vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
return;
}
/**************************************************************************
e n d i f C o I m
**
** IMMEDIATE COMPILE-ONLY
**************************************************************************/
static void endifCoIm(FICL_VM *pVM)
@ -1329,6 +1333,234 @@ static void endifCoIm(FICL_VM *pVM)
}
/**************************************************************************
c a s e C o I m
** IMMEDIATE COMPILE-ONLY
**
**
** At compile-time, a CASE-SYS (see DPANS94 6.2.0873) looks like this:
** i*addr i caseTag
** and an OF-SYS (see DPANS94 6.2.1950) looks like this:
** i*addr i caseTag addr ofTag
** The integer under caseTag is the count of fixup addresses that branch
** to ENDCASE.
**************************************************************************/
static void caseCoIm(FICL_VM *pVM)
{
#if FICL_ROBUST > 1
vmCheckStack(pVM, 0, 2);
#endif
PUSHUNS(0);
markControlTag(pVM, caseTag);
return;
}
/**************************************************************************
e n d c a s eC o I m
** IMMEDIATE COMPILE-ONLY
**************************************************************************/
static void endcaseCoIm(FICL_VM *pVM)
{
FICL_UNS fixupCount;
FICL_DICT *dp;
CELL *patchAddr;
FICL_INT offset;
assert(pVM->pSys->pDrop);
/*
** if the last OF ended with FALLTHROUGH,
** just add the FALLTHROUGH fixup to the
** ENDOF fixups
*/
if (stackGetTop(pVM->pStack).p == fallthroughTag)
{
matchControlTag(pVM, fallthroughTag);
patchAddr = POPPTR();
matchControlTag(pVM, caseTag);
fixupCount = POPUNS();
PUSHPTR(patchAddr);
PUSHUNS(fixupCount + 1);
markControlTag(pVM, caseTag);
}
matchControlTag(pVM, caseTag);
#if FICL_ROBUST > 1
vmCheckStack(pVM, 1, 0);
#endif
fixupCount = POPUNS();
#if FICL_ROBUST > 1
vmCheckStack(pVM, fixupCount, 0);
#endif
dp = vmGetDict(pVM);
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pDrop));
while (fixupCount--)
{
patchAddr = (CELL *)stackPopPtr(pVM->pStack);
offset = dp->here - patchAddr;
*patchAddr = LVALUEtoCELL(offset);
}
return;
}
static void ofParen(FICL_VM *pVM)
{
FICL_UNS a, b;
#if FICL_ROBUST > 1
vmCheckStack(pVM, 2, 1);
#endif
a = POPUNS();
b = stackGetTop(pVM->pStack).u;
if (a == b)
{ /* fall through */
stackDrop(pVM->pStack, 1);
vmBranchRelative(pVM, 1);
}
else
{ /* take branch to next of or endswitch */
vmBranchRelative(pVM, *(int *)(pVM->ip));
}
return;
}
/**************************************************************************
o f C o I m
** IMMEDIATE COMPILE-ONLY
**************************************************************************/
static void ofCoIm(FICL_VM *pVM)
{
FICL_DICT *dp = vmGetDict(pVM);
CELL *fallthroughFixup = NULL;
assert(pVM->pSys->pBranch0);
#if FICL_ROBUST > 1
vmCheckStack(pVM, 1, 3);
#endif
if (stackGetTop(pVM->pStack).p == fallthroughTag)
{
matchControlTag(pVM, fallthroughTag);
fallthroughFixup = POPPTR();
}
matchControlTag(pVM, caseTag);
markControlTag(pVM, caseTag);
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pOfParen));
markBranch(dp, pVM, ofTag);
dictAppendUNS(dp, 2);
if (fallthroughFixup != NULL)
{
FICL_INT offset = dp->here - fallthroughFixup;
*fallthroughFixup = LVALUEtoCELL(offset);
}
return;
}
/**************************************************************************
e n d o f C o I m
** IMMEDIATE COMPILE-ONLY
**************************************************************************/
static void endofCoIm(FICL_VM *pVM)
{
CELL *patchAddr;
FICL_UNS fixupCount;
FICL_INT offset;
FICL_DICT *dp = vmGetDict(pVM);
#if FICL_ROBUST > 1
vmCheckStack(pVM, 4, 3);
#endif
assert(pVM->pSys->pBranchParen);
/* ensure we're in an OF, */
matchControlTag(pVM, ofTag);
/* grab the address of the branch location after the OF */
patchAddr = (CELL *)stackPopPtr(pVM->pStack);
/* ensure we're also in a "case" */
matchControlTag(pVM, caseTag);
/* grab the current number of ENDOF fixups */
fixupCount = POPUNS();
/* compile branch runtime */
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
/* push a new ENDOF fixup, the updated count of ENDOF fixups, and the caseTag */
PUSHPTR(dp->here);
PUSHUNS(fixupCount + 1);
markControlTag(pVM, caseTag);
/* reserve space for the ENDOF fixup */
dictAppendUNS(dp, 2);
/* and patch the original OF */
offset = dp->here - patchAddr;
*patchAddr = LVALUEtoCELL(offset);
}
/**************************************************************************
f a l l t h r o u g h C o I m
** IMMEDIATE COMPILE-ONLY
**************************************************************************/
static void fallthroughCoIm(FICL_VM *pVM)
{
CELL *patchAddr;
FICL_INT offset;
FICL_DICT *dp = vmGetDict(pVM);
#if FICL_ROBUST > 1
vmCheckStack(pVM, 4, 3);
#endif
/* ensure we're in an OF, */
matchControlTag(pVM, ofTag);
/* grab the address of the branch location after the OF */
patchAddr = (CELL *)stackPopPtr(pVM->pStack);
/* ensure we're also in a "case" */
matchControlTag(pVM, caseTag);
/* okay, here we go. put the case tag back. */
markControlTag(pVM, caseTag);
/* compile branch runtime */
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranchParen));
/* push a new FALLTHROUGH fixup and the fallthroughTag */
PUSHPTR(dp->here);
markControlTag(pVM, fallthroughTag);
/* reserve space for the FALLTHROUGH fixup */
dictAppendUNS(dp, 2);
/* and patch the original OF */
offset = dp->here - patchAddr;
*patchAddr = LVALUEtoCELL(offset);
}
/**************************************************************************
h a s h
** hash ( c-addr u -- code)
@ -2990,9 +3222,9 @@ static void untilCoIm(FICL_VM *pVM)
{
FICL_DICT *dp = vmGetDict(pVM);
assert(pVM->pSys->pIfParen);
assert(pVM->pSys->pBranch0);
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranch0));
resolveBackBranch(dp, pVM, destTag);
return;
}
@ -3001,9 +3233,9 @@ static void whileCoIm(FICL_VM *pVM)
{
FICL_DICT *dp = vmGetDict(pVM);
assert(pVM->pSys->pIfParen);
assert(pVM->pSys->pBranch0);
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pIfParen));
dictAppendCell(dp, LVALUEtoCELL(pVM->pSys->pBranch0));
markBranch(dp, pVM, origTag);
twoSwap(pVM);
dictAppendUNS(dp, 1);
@ -4554,9 +4786,10 @@ WORDKIND ficlWordClassify(FICL_WORD *pFW)
{CREATE, createParen},
{DO, doParen},
{DOES, doDoes},
{IF, ifParen},
{IF, branch0},
{LITERAL, literalParen},
{LOOP, loopParen},
{OF, ofParen},
{PLOOP, plusLoopParen},
{QDO, qDoParen},
{CSTRINGLIT, cstringLit},
@ -4582,6 +4815,28 @@ WORDKIND ficlWordClassify(FICL_WORD *pFW)
}
#ifdef TESTMAIN
/**************************************************************************
** r a n d o m
** FICL-specific
**************************************************************************/
static void ficlRandom(FICL_VM *pVM)
{
PUSHINT(rand());
}
/**************************************************************************
** s e e d - r a n d o m
** FICL-specific
**************************************************************************/
static void ficlSeedRandom(FICL_VM *pVM)
{
srand(POPINT());
}
#endif
/**************************************************************************
f i c l C o m p i l e C o r e
** Builds the primitive wordset and the environment-query namespace.
@ -4651,6 +4906,7 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
dictAppendWord(dp, "c!", cStore, FW_DEFAULT);
dictAppendWord(dp, "c,", cComma, FW_DEFAULT);
dictAppendWord(dp, "c@", cFetch, FW_DEFAULT);
dictAppendWord(dp, "case", caseCoIm, FW_COMPIMMED);
dictAppendWord(dp, "cell+", cellPlus, FW_DEFAULT);
dictAppendWord(dp, "cells", cells, FW_DEFAULT);
dictAppendWord(dp, "char", ficlChar, FW_DEFAULT);
@ -4664,14 +4920,18 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
dictAppendWord(dp, "depth", depth, FW_DEFAULT);
dictAppendWord(dp, "do", doCoIm, FW_COMPIMMED);
dictAppendWord(dp, "does>", doesCoIm, FW_COMPIMMED);
pSys->pDrop =
dictAppendWord(dp, "drop", drop, FW_DEFAULT);
dictAppendWord(dp, "dup", dup, FW_DEFAULT);
dictAppendWord(dp, "else", elseCoIm, FW_COMPIMMED);
dictAppendWord(dp, "emit", emit, FW_DEFAULT);
dictAppendWord(dp, "endcase", endcaseCoIm, FW_COMPIMMED);
dictAppendWord(dp, "endof", endofCoIm, FW_COMPIMMED);
dictAppendWord(dp, "environment?", environmentQ,FW_DEFAULT);
dictAppendWord(dp, "evaluate", evaluate, FW_DEFAULT);
dictAppendWord(dp, "execute", execute, FW_DEFAULT);
dictAppendWord(dp, "exit", exitCoIm, FW_COMPIMMED);
dictAppendWord(dp, "fallthrough",fallthroughCoIm,FW_COMPIMMED);
dictAppendWord(dp, "fill", fill, FW_DEFAULT);
dictAppendWord(dp, "find", cFind, FW_DEFAULT);
dictAppendWord(dp, "fm/mod", fmSlashMod, FW_DEFAULT);
@ -4693,6 +4953,7 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
dictAppendWord(dp, "mod", ficlMod, FW_DEFAULT);
dictAppendWord(dp, "move", move, FW_DEFAULT);
dictAppendWord(dp, "negate", negate, FW_DEFAULT);
dictAppendWord(dp, "of", ofCoIm, FW_COMPIMMED);
dictAppendWord(dp, "or", bitwiseOr, FW_DEFAULT);
dictAppendWord(dp, "over", over, FW_DEFAULT);
dictAppendWord(dp, "postpone", postponeCoIm, FW_COMPIMMED);
@ -4741,7 +5002,6 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
dictAppendWord(dp, "?do", qDoCoIm, FW_COMPIMMED);
dictAppendWord(dp, "again", againCoIm, FW_COMPIMMED);
dictAppendWord(dp, "c\"", cstringQuoteIm, FW_IMMEDIATE);
/* case of endof endcase */
dictAppendWord(dp, "hex", hex, FW_DEFAULT);
dictAppendWord(dp, "pad", pad, FW_DEFAULT);
dictAppendWord(dp, "parse", parse, FW_DEFAULT);
@ -4888,6 +5148,10 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
dictAppendWord(dp, "(user)", userParen, FW_DEFAULT);
dictAppendWord(dp, "user", userVariable, FW_DEFAULT);
#endif
#ifdef TESTMAIN
dictAppendWord(dp, "random", ficlRandom, FW_DEFAULT);
dictAppendWord(dp, "seed-random",ficlSeedRandom,FW_DEFAULT);
#endif
/*
** internal support words
@ -4905,8 +5169,8 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
dictAppendWord(dp, "(.\")", stringLit, FW_COMPILE);
pSys->pCStringLit =
dictAppendWord(dp, "(c\")", cstringLit, FW_COMPILE);
pSys->pIfParen =
dictAppendWord(dp, "(if)", ifParen, FW_COMPILE);
pSys->pBranch0 =
dictAppendWord(dp, "(branch0)", branch0, FW_COMPILE);
pSys->pBranchParen =
dictAppendWord(dp, "(branch)", branchParen, FW_COMPILE);
pSys->pDoParen =
@ -4922,6 +5186,8 @@ void ficlCompileCore(FICL_SYSTEM *pSys)
pSys->pInterpret =
dictAppendWord(dp, "interpret", interpret, FW_DEFAULT);
dictAppendWord(dp, "lookup", lookup, FW_DEFAULT);
pSys->pOfParen =
dictAppendWord(dp, "(of)", ofParen, FW_DEFAULT);
dictAppendWord(dp, "(variable)",variableParen, FW_COMPILE);
dictAppendWord(dp, "(constant)",constantParen, FW_COMPILE);
dictAppendWord(dp, "(parse-step)",