CASE construct by George Beckett.

A new implementation of a CASE construct for the ACE. Original based from the version in Personal Computing World March 1984.
Its a new working version many thanks to George Beckett.

The code below is fully commented and is worth reading for a full understanding of how the FORTH code works on the Jupiter ACE.

A TAP/TZX file can be found here (CRC-32 57AB8211).

( CASE CONSTRUCT FOR JUPITER ACE / MINSTREL 4TH )
(                                               )
( ORIGINALLY PRINTED IN PERSONAL COMPUTER       )
( WORLD, MARCH 1985. IMPLEMENTATION TWEEKED BY  )
( GEORGE BECKETT, SEPT 2020, TO REMOVE          )
( POTENTIAL BUG.                                )
(                                               )
( SYNTAX:                                       )
( CASE                                          )
(   xx OF ... ENDOF                             )
(   xx OF ... ENDOF 				)
(   OTHERWISE ... 				)
( ENDCASE     					)
(                                               )
( NOTES: 					)
( - CAN BE LISTED, EDITED, AND REDEFINED.       )
( - MUST HAVE 'OTHERWISE' CLAUSE.		)
( - ERROR 5, IF SYNTAX ERROR.			)
( - CASE STATEMENTS MAY BE NESTED, SUBJECT TO   )
(   RESPECTING SYNTAX                           )

( CHECK SYNTAX GUIDES MATCH )
: ?PAIRS ( M N -- )
  = 0= ( ARE THEY NOT EQUAL? )
  IF
    ." ERROR 5" CR ABORT ( ABORT COMPILATION, IF NOT EQUAL )
  THEN
;

0 COMPILER CASE
  0 ( MARKER ON STACK, USED BY ENDCASE TO CHECK DONE )
  9 ( SYNTAX GUIDE, MUST MATCH WITH 'OF' )
RUNS>
  DROP ( NOTHING TO DO EXCEPT DROP ADDR OF PARAMETER FIELD )
;

2 COMPILER OF
  9 ?PAIRS ( CHECK PRECEDED BY CASE OR ENDOF )
  HERE ( SAVE CURRENT DICTIONARY LOCATION FOR ENDOF )
  0 , ( RESERVE TWO BYTES AT THAT LOCATION )
  7 ( SYNTAX GUIDE, MUST MATCH WITH 'ENDOF' )
RUNS>
  >R ( SAVE PARAMETER-FIELD ADDR )
  OVER = ( CHECK FOR MATCH WITH CASE VALUE, PRESERVING COPY OF INPUT )
  R> ( RECOVER PARAMETER-FIELD ADDR )
  SWAP ( BRING MATCH RESULT BACK TO TOP OF STACK )
  IF ( INDICATES MATCH )
    DROP DROP ( DROP PARAMETER-FIELD ADDR AND INPUT, AS DONE )
  ELSE
    @ ( RETRIEVE OFFSET TO NEXT 'OF' FROM PARAMETER FIELD )
    R> + >R ( ADVANCE TO NEXT 'OF' STATEMENT )
  THEN
;

( IF SYNTAX IS CORRECT, TOS = 7 AND 2OS = PARAM FIELD OF 'OF'
2 COMPILER ENDOF
  7 ?PAIRS ( CHECK PRECEDED BY 'OF' )
  HERE ( PUT CURRENT DICTIONARY LOCATION ON STACK )
  SWAP ( SWAP WITH ADDRESS OF PARAM FIELD FOR 'OF' )
  0 , ( RESERVE TWO BYTES IN DICTIONARY )
  OVER OVER - ( WORK OUT OFFSET FROM 'OF' TO 'HERE' )
  SWAP ! ( STORE IN PARAMETER FIELD OF 'OF' )
  9 ( SYNTAX GUIDE, MUST MATCH TO 'OF' OR 'OTHERWISE' )
RUNS>
  @ ( RETRIEVE OFFSET TO JUST AFTER 'ENDCASE' FROM PARAMETER FIELD )
  R> + 4 - >R ( APPLY TO RETURN ADDRESS, NEED TO BACKTRACK BY 4 )
;

0 COMPILER OTHERWISE
  9 ?PAIRS ( CHECK PRECEDED BY 'CASE' OR 'ENDOF' )
  8 ( SYNTAX GUIDE, MUST MATCH WITH 'ENDCASE' )
RUNS>
  DROP DROP ( DROP PARAMETER-FIELD ADDR AND INPUT, AS DONE )
;

0 COMPILER ENDCASE
  8 ?PAIRS ( CHECK PRECEDED BY 'OTHERWISE' )
  BEGIN
    ?DUP ( IF PARAMETER-FIELD ADDRESS NON-ZERO, DUPLICATE )
  WHILE ( OTHERWISE, ALL DONE )
    HERE OVER - ( WORK OUT OFFSET )
    SWAP ! ( STORE IN PARAMETER FIELD OF 'ENDOF' )
  REPEAT ( DO FOR EACH 'ENDOF' )
RUNS>
  DROP ( DROP PARAMETER FIELD, AS DONE )
;

: SILLY ( EXAMPLE USE OF CASE )
  CASE
    1 OF CR ." NUMBER ONE!" CR ENDOF
    6 OF CR ." NUMBER SIX!" CR ENDOF
    40 OF CR ." NUMBER FORTY!" CR ENDOF
    OTHERWISE CR ." NOT 1, NOT 6, NOT 40!" CR
  ENDCASE

  ." The end of a pointless word."

  CR
;