HEADER "of", NOT_IMMEDIATE      ; ( n1 n2 -- )    if n1 =  n2
_of:    PRIMITIVE                       ; ( n1 n2 -- n1 ) if n1 <> n2
        LDA   0,X         ; Take top stack item, and
        CMP   2,X         ; compare to next stack item.
        BNE   ofend       ; If not equal, get ready to try the next OF.
        INX4              ; Otherwise, drop the top two stack items,
        JMP   bump        ; skip the branch address, and execute what's
                          ; inside the OF, until you get to ENDOF.
                          ; (Label "bump" is inside of Zbranch.)
ofend:  INX2              ; If there wasn't a match, drop the top stack
        JMP   branch+2    ; item and go on to check the next OF.
 ;-------------------

The structure:
 
  CASE                                  \ the word CASE compiles nothing
     n1 OF  actions1  ENDOF
     n2 OF  actions2  ENDOF
     n3 OF  actions3  ENDOF
     (default actions)
  ENDCASE                               \ ENDCASE only compiles a DROP and the
                                        \ address needed at each ENDOF
 
 can be compiled without the internal " of ", but it becomes far less efficient,
 both memory- and speedwise.  It would be as if you wrote:
 
  n1 OVER = IF DROP  actions1  ELSE
  n2 OVER = IF DROP  actions2  ELSE
  n3 OVER = IF DROP  actions3  ELSE
  (default actions)
  THEN THEN THEN
 

 Parenthetical note:  Default actions don't have to be all at the end.  For
 example, you could have three comparisons, and if none of those are met, do
 some other processing before continuing on to the fourth comparison.  This can
 be done at various places along the CASE structure, as many as you want.
 
 Using the " of " internal, each line saves three cells (six bytes), in addition
 to running faster.  Clearly, it doesn't take much to justify having the " of "
 primitive.  OF and IF both compile an internal ( of  and 0branch ) plus a
 branch address.  Both ENDOF and ELSE compile the internal " branch ", plus the
 branch address.  The OVER , = , and DROP on every line are extra.  The book
 Thinking Forth, on page 239, says the CASE statement offers no efficiency
 improvement in either execution speed or memory used.  This is clearly false
 when you have the internal " of ".  The book is not very favorable to the CASE
 structure, but the X3J14 committee thought highly enough of it to put it in the
 ANS standard Forth!

 
        HEADER "of", NOT_IMMEDIATE      ; ( n1 n2 -- )    if n1 =  n2
_of:    PRIMITIVE                       ; ( n1 n2 -- n1 ) if n1 <> n2
        LDA     0,X             ; Take top stack item,
        CMP     2,X             ; compare to next stack item, & if
        BNE     ofend           ; not equal, get ready to try next OF.
        INX4                    ; Otherwise, drop the top two stack items,
                                ; skip the branch address, and execute what's
        JMP     bump            ; inside the OF, until you get to ENDOF.
 ofend: INX2                    ; If there wasn't a match, drop the top stack
        JMP     branch+2        ; item and go on to check the next OF.
 ;-------------------

 
\ CASE below just puts the structure-check number (6) on the stack at compile
\ time so OF and ENDCASE could check for illegal constructs, and an initialized
\ number (0) of how many branch addresses ENDCASE will have to fill in at the
\ ENDOFs.  CASE does not actually compile anything.
 
 
: CASE   ?COMP          \ (compile only)                 TF239-240  ANS_CORE_EXT
  6 0                           ;  IMMEDIATE
 
 
\ OF below compiles the internal of , which compares the two numbers on the top
\ of the stack.  If the two are equal, it drops them, and increments the IP to
\ the first cell after the two-cell OF instruction.  The second cell of this OF
\ instruction is the address of the next OF statement , which the IP would be
\ set to if the match failed.  If the match does fail, of would only drop the
\ very top stack cell so the next of could continue with the next value check.
 
 
: OF     ?COMP          \ (compile only)                            ANS_CORE_EXT
   DUP >R  PICK  6 ?PAIRS  COMPILE of               \ Related:  SET_OF  RANGE_OF
   HERE 0 ,    R> 1+  7         ;  IMMEDIATE
 
 
 
\ After making sure it's in the right kind of structure (by using ?PAIRS), ENDOF
\ below compiles the branch to the first cell after the ENDCASE.  Actually, it
\ only compiles the branch internal, then leaves room for the address to be
\ compiled by ENDCASE later on, when that address is known.  So that ENDCASE
\ will know where to put the address of the cell following it, the address
\ following the ENDOF is left on the stack, and n, the number of addresses left
\ by ENDOFs in the structure, is incremented by each "of" so ENDCASE will know
\ how many cells on the stack at compile time are addresses that it needs to
\ fill in.  ENDOF also stores the address of the following cell in the last
\ previous of (compiled by OF ) so that if the test fails at run time, that of
\ will send the IP to the right place to check the next possibility.
 
 
         ( 6 [...] of's_branch_operand_adr n 7 -- 6 [...] ENDOF's_branch_adr n )
: ENDOF  ?COMP                    \ (compile only)                  ANS_CORE_EXT
   7 ?PAIRS                       \ OF's compiler security # is 7.  CASE's is 6.
   >R                             \ Hold n, the number of previous ENDOFs.
      COMPILE branch   HERE 0 ,   \ Get branch's operand adr, & allot its field.
      >R                          \ Hold ENDOF's branch operand adr.
         HERE SWAP !              \ Fill in of's operand to point to next inst.
      R>
   R>                ;  IMMEDIATE
 
 
\ I would like to call them END_OF and END_CASE, but ANS and earlier Forths call
\ them ENDOF and ENDCASE without the _ character.  Since these are so common, I
\ won't change them.
 
 
\ { and } below are primarily for use with SET_OF .  You can start a series of
\ stack entries with {, and end it with }.  The final } puts a number on TOS
\ telling how many items  got added to the stack, not including itself, since
\ the {.  This way, code can appropriately handle an arbitrary number of stack
\ entries.  { and } have been valuable for other uses besides with SET_OF too.
\ The idea for SET_OF came from FD May/Jun '97, but I modified it (including the
\ SET[ to { and ]SET-OF to } SET_OF ) to be of wider usefulness, making the {
\ and } useful anywhere you want to correctly handle an undetermined number of
\ inputs on the stack, whether compiling, interpreting, or executing.
 
: {   ( -- )    R>   DEPTH >R          >R    ;  \ R>...>R preserve the return
: }   ( -- n )  R>   DEPTH R> -  SWAP  >R    ;  \ adr's position in return stk.
 
 
\ Actually, it looks like { and } would only be one byte longer as primitives!
 
 
\ The idea for SET_OF below is from FD, May/Jun '97.  It's nice for situations
\ where you want something like
 
   DUP  14 =
   OVER 15 = OR
   OVER 18 = OR
   OVER 20 = OR
   OVER 25 = OR
   OVER 65 = OR
   IF bla bla bla ELSE ...
 
\ but in a CASE statement.  Normally in a case statement, you'd have to test for
\ each of these numbers, and then have the same code between the OF and ENDOF
\ that follows each.  You can't give OF more than one number to compare to, so
\ SET_OF takes care of that.  The situation above now all fits on the first OF
\ line of the example
 
   CASE
      { 14 15 18 20 25 65 } SET_OF   bla bla bla   ENDOF
                                OF                 ENDOF
                                OF                 ENDOF
      if-no-match-then-do-this-other-stuff
   ENDCASE
 
\ SET_OF allows a type of OF that can compare to several possible values that
\ can result in the same action.  The values can be literals, or they can be
\ fetched or calculated between the { and the } .   set_of is the internal
\ compiled by SET_OF.
 
\ Notice that { and } are not limited to have only literals between them.  You
\ can just as easily have some of the values calculated on the fly, as long as
\ you keep in mind that the number of comparisons that will be made by SET_OF
\ will be the difference between the stack depth immediately before } minus the
\ stack depth at { .  You cannot, for example, remove a previously existing cell
\ from the stack to calculate one of the comparison values unless you
\ specifically take action to correct the resulting stack-depth discrepancy.
 
 
 
: set_of                \ Syn: { 13 16 20 24 } SET_OF ... ENDOF       (internal)
   DUP 1+ PICK          \ Copy the argument that went into CASE
                        \ ^ arg T1 T2 ... Tn n arg
   FALSE  ROT 0         \ ^ arg T1 T2 ... Tn arg FALSE n 0
   DO                   \ 1st time into loop: ^ arg T1 T2 ... Tn arg FALSE
      OVER 3ROLL = OR
   LOOP                 \ After last loop: ^ arg arg flag
   ?EXIT   NOT     ;    \ If flag was false, change one copy
                        \ of arg so they don't match.



\ set_of as a primitive that doesn't need to be followed by of:

 NO_HEADERS             ; (This macro makes the HEADER macro below go dormant.)
 
         HEADER "set_of", NOT_IMMEDIATE
_set_of: PRIMITIVE
         LDA    0,X
         STA    N+2     ; Store in N+2 the number of cells to compare, and
         INX2           ; remove that number from the stack.
         STZ    N       ; Zero N & N+1.  Two bytes get zeroed, which is ok.
                        ;   Non-0 will get put in N later if we find a match.
         TXY            ; We can't do LDA (N+2),X, so get ready to use Y.
         LDA    (N+2),Y ; Get the number for SET_OF to compare to.
         LSR    N+2     ; Number of comparisons = number of bytes divided by 2.
         LDY    N+2     ; Set up to loop enough times to compare all the numbrs.
 s_o1:     CMP  0,X     ; Compare the next number on the stack.
           BNE  s_o2    ; If there's no match, skip putting something in N.
             STX  N     ; (N got zeroed before this loop.)
 s_o2:     INX2         ; Drop the top of stack to be ready for next comparison.
           DEY          ; Decrement the number of comparisons left to be done.
         BNE    s_o1    ; If there's one or more left, loop back again.
 
         LDY    N
         BEQlong branch+2 ; If there was no match, skip past ENDOF for next OF .
 
         INX2           ; If match was found, drop the input number, and
         JMP    bump    ; bump the IP past the address cell following set_of.
 HEADERS
 ;-------------------
 
 
 
\ SET_OF works very much like OF .  It does not make sure you preceded it with
\ { ... } .  I may decide to add that to the compiler security in the future.
 
 
: SET_OF   ( CASECODE n -- CASECODE ADR n+1 OFCODE )        \   (FD May/Jun '97)
   ?COMP                                                    \ Related:  RANGE_OF
   >R R@ PICK 6 ?PAIRS
      COMPILE set_of  COMPILE of
      HERE 0 ,
   R> 1+     7          ;       IMMEDIATE
 
 
\ Then in FD Jan/Feb '98, someone suggested RANGE_OF to add to SET_OF above.  It
\ lets you compare to a range of values.  Like BETWEEN in ANS Forth, the range
\ includes the limit numbers.  range_of is the internal compiled by RANGE_OF .
\ Similar to SET_OF , it doesn't matter where the input limits for RANGE_OF come
\ from.  OF , SET_OF , and RANGE_OF can be mixed in the same CASE statement.
 
 
: range_of      ( Syn:   14 20 RANGE_OF ... ENDOF  )                \ (internal)
   2PICK -ROT RANGE
   IF   DUP EXIT
   THEN DUP NOT         ;
 
 
: RANGE_OF ( CASECODE n -- CASECODE ADR n+1 OFCODE )          \ (FD Jan/Feb '98)
   ?COMP                                                      \ Related:  SET_OF
   >R R@ PICK 6 ?PAIRS
      COMPILE range_of
      COMPILE of
      HERE 0 ,
   R> 1+     7          ;       IMMEDIATE
 
 
\ ENDCASE below first reaches back in the stack for the case structure number,
\ which is 6 in this case.  The ROLL reaches back behind all the addresses put
\ on the stack by all the ENDOFs that preceded the ENDCASE, and ?PAIRS makes
\ sure ENDCASE goes in the right kind of structure.  DROP is compiled to drop
\ the number that would have failed all the OF comparisons (at run time) if it
\ actually got to the ENDCASE instead of being routed around it by an ENDOF at
\ the end of one of the normal statements.  (Remember that if encountered,
\ ENDCASE wants to drop a cell off the stack even if it's after some "else"-type
\ code after the last ENDOF.  For this reason, you might need to put an
\ otherwise-unnecessary DUP in that part of the code.  Sometimes DUMMYCELL,
\ which just puts a 0 on the stack, is the more readable way to show what's
\ happening in that situation.)
\ Next in the compilation process, the ?DO...LOOP puts the address of the cell
\ following the ENDCASE after each of the ENDOFs in the structure so the IP can
\ skip the rest of the CASE statement after executing an ENDOF.
 
 
: ENDCASE  ?COMP                \ (compile only)    ( casecode adr...adr n -- )
   DUP 1+ ROLL  6 ?PAIRS                                         \  ANS_CORE_EXT
   COMPILE DROP
   0  ?DO  HERE SWAP !  LOOP    ;  IMMEDIATE
 
 
 
─────────────── What the program structures actually compile: ──────────────────
Each compiled cell is given one line, except where it says (actions), which
could be any amount of other Forth code.
 
 
CASE actions OF actions ENDOF actions OF actions ENDOF actions ENDCASE
                                        compiles:
 
        (actions)       ( CASE does not compile anything)
        of              (compiled by OF )
 ┌──────addr of
 │      (actions)
 │      branch          (compiled by ENDOF )
 │ ┌────addr of
 └─┼──> (actions)
   │    of              (compiled by OF )
 ┌─┼────addr of
 │ │    (actions)
 │ │    branch          (compiled by ENDOF )
 │ │<───addr of
 └─┼──> (actions)
   │    DROP            (compiled by ENDCASE )
   └──> (next instruction after ENDCASE)
 
 
set_of and range_of are not as complete at this time as of , and they need to be
followed by of .  I may rewrite them in the future * * * * *
 
 
CASE actions SET_OF actions ENDOF actions RANGE_OF actions ENDOF actions ENDCASE
                                        compiles:
 
        (actions)       ( CASE does not compile anything)
        set_of          (compiled by SET_OF )
        of              (compiled by SET_OF )
 ┌──────addr of
 │      (actions)
 │      branch          (compiled by ENDOF )
 │ ┌────addr of
 └─┼──> (actions)
   │    range_of        (compiled by RANGE_OF )
   │    of              (compiled by RANGE_OF )
 ┌─┼────addr of
 │ │    (actions)
 │ │    branch          (compiled by ENDOF )
 │ │<───addr of
 └─┼──> (actions)
   │    DROP            (compiled by ENDCASE )
   └──> (next instruction after ENDCASE)