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

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.

11 files changed, 405 insertions, 68 deletions

diff --git a/sys/boot/ficl/ficl.h b/sys/boot/ficl/ficl.h
index d10c850..7892ee9 100644
--- a/sys/boot/ficl/ficl.h
+++ b/sys/boot/ficl/ficl.h
@@ -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,
diff --git a/sys/boot/ficl/float.c b/sys/boot/ficl/float.c
index 3fe8581..d757b23 100644
--- a/sys/boot/ficl/float.c
+++ b/sys/boot/ficl/float.c
@@ -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;
 }
+
diff --git a/sys/boot/ficl/softwords/fileaccess.fr b/sys/boot/ficl/softwords/fileaccess.fr
index 10ec5bd..7297df6 100644
--- a/sys/boot/ficl/softwords/fileaccess.fr
+++ b/sys/boot/ficl/softwords/fileaccess.fr
@@ -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
diff --git a/sys/boot/ficl/softwords/jhlocal.fr b/sys/boot/ficl/softwords/jhlocal.fr
index b6e8467..12ccb9f 100644
--- a/sys/boot/ficl/softwords/jhlocal.fr
+++ b/sys/boot/ficl/softwords/jhlocal.fr
@@ -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
 
diff --git a/sys/boot/ficl/softwords/oo.fr b/sys/boot/ficl/softwords/oo.fr
index 9e6a04e..b1c8e21 100644
--- a/sys/boot/ficl/softwords/oo.fr
+++ b/sys/boot/ficl/softwords/oo.fr
@@ -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
 ;
diff --git a/sys/boot/ficl/softwords/prefix.fr b/sys/boot/ficl/softwords/prefix.fr
index 53a1d54..ae1727f 100644
--- a/sys/boot/ficl/softwords/prefix.fr
+++ b/sys/boot/ficl/softwords/prefix.fr
@@ -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
diff --git a/sys/boot/ficl/softwords/softcore.awk b/sys/boot/ficl/softwords/softcore.awk
index c41996a..5a97999 100644
--- a/sys/boot/ficl/softwords/softcore.awk
+++ b/sys/boot/ficl/softwords/softcore.awk
@@ -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";
diff --git a/sys/boot/ficl/tools.c b/sys/boot/ficl/tools.c
index dc321f8..02f9acf 100644
--- a/sys/boot/ficl/tools.c
+++ b/sys/boot/ficl/tools.c
@@ -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:
diff --git a/sys/boot/ficl/unix.c b/sys/boot/ficl/unix.c
index 4400752..5b56440 100644
--- a/sys/boot/ficl/unix.c
+++ b/sys/boot/ficl/unix.c
@@ -8,9 +8,9 @@
 
 
 unsigned long ficlNtohl(unsigned long number)
-	{
-	return ntohl(number);
-	}
+{
+    return ntohl(number);
+}
 
 
 
diff --git a/sys/boot/ficl/vm.c b/sys/boot/ficl/vm.c
index 7bcb19a..97a4f04 100644
--- a/sys/boot/ficl/vm.c
+++ b/sys/boot/ficl/vm.c
@@ -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);
 
diff --git a/sys/boot/ficl/words.c b/sys/boot/ficl/words.c
index 3419938..ddeb1af 100644
--- a/sys/boot/ficl/words.c
+++ b/sys/boot/ficl/words.c
@@ -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;
     
@@ -1270,9 +1266,31 @@ 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
@@ -1303,33 +1321,247 @@ 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.
+                        e n d i f C o I m
+** IMMEDIATE COMPILE-ONLY
 **************************************************************************/
 
-static void branchParen(FICL_VM *pVM)
+static void endifCoIm(FICL_VM *pVM)
 {
-    vmBranchRelative(pVM, (uintptr_t)*(pVM->ip));
+    FICL_DICT *dp = vmGetDict(pVM);
+    resolveForwardBranch(dp, pVM, origTag);
     return;
 }
 
 
 /**************************************************************************
-                        e n d i f C o I m
-** 
+                        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 endifCoIm(FICL_VM *pVM)
+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);
-    resolveForwardBranch(dp, pVM, origTag);
+	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)
 ** calculates hashcode of specified string and leaves it on the stack
@@ -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)",