Quote:
CASE - compact version that does not use OF, ENDOF, ENDCASE
You can make it more efficient with of being a primitive. This is from my '816 Forth assembly-language source code:
Code:
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.
;-------------------
(INX2 and INX4 are just two and four INX's.)
The following is from the "shadow screen" file (which is really just another text file, but instead of having the Forth assembly-language source code, it has more explanations and what the Forth source would look like if I were compiling a Forth from a metacompiler.
Code:
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
Paranthetical note: Default actions don't have to be all at the end. For
example, you could have thee 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 commitee thought highly enough of it to put it in the
ANS standard Forth!
\ 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.
Not shown here:
of (internal)
: 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.
<snip>
\ 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
Then I also have SET_OF and RANGE_OF. The internal set_of (compiled by SET_OF) is a primitive, but I have not written range_of (compiled by RANGE_OF) as a primitive.
Code:
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.
;-------------------
(BEQlong is just a BNE around a JMP to the desired label.)
The "shadow screen" file portion for it is as follows:
Code:
\ { 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 undertermined 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 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
I've used SET_OF more than RANGE_OF, but neither of them very much. You'll definitely want of and the other CASE-statement words though.
I might add more good stuff later.
Login
Register
FAQ
Search
