# 7
( LOADED-BY EDIT POLYED ASM       ) 
FORTH DEFINITIONS DECIMAL

: LOADED-BY
  <BUILDS , DOES> @ LOAD ;

34 LOADED-BY EDIT ( fig-FORTH )
15 LOADED-BY POLYED ( poly-FORTH)
42 LOADED-BY ASM ( ASSEMBLER)

PAGE
CR ." EDIT   for fig-FORTH editor"
CR CR
." POLYED for poly-FORTH editor"
CR CR
." ASM    for 8080-Z80 assembler" 
CR CR

1 DENSITY !
CR CR ." DENSITY set for double "
CR CR ;S
# 34
( LOAD fig-FORTH EDITOR           ) 

18 LOAD 19 LOAD ( COMMON BLOCKS )

35 LOAD  36 LOAD  37 LOAD  38 LOAD

39 LOAD  40 LOAD 41 LOAD

FORTH DEFINITIONS DECIMAL

;S
# 35
( fig-EDITOR H E S D              ) 
EDITOR DEFINITIONS DECIMAL

: H  ( HOLD NUMBERED LINE AT PAD)
  LINE PAD 1+ C/L DUP PAD C! CMOVE ;

: E  ( ERASE LINE-1 WITH BLANKS)
  LINE C/L BLANKS UPDATE ;

: S  ( SPREAD MAKING LINE-1 BLANK)
  DUP 1 - ( LIMIT ) 19 ( FIRST )
  DO I LINE I 1+ -MOVE -1 +LOOP
  E ;

: D  ( DELETE LINE-1, BUT HOLD IN
       PAD )
  DUP EDITOR H 20 DUP ROT
  DO I 1+ LINE I -MOVE LOOP E ;

;S
# 36
( fig-EDITOR M T L R              ) 
EDITOR DEFINITIONS HEX

: M  ( MOVE CURSOR BY SIGNED
       AMOUNT-1, PRINT ITS LINE)
  R# +! CR SPACE #LEAD TYPE
  FF EMIT #LAG TYPE #LOCATE .
  DROP QUIT ;

: T  ( TYPE LINE BY #-1, SAVE
       ALSO IN PAD )
  DUP C/L * R# ! DUP H 0 M ;

: L  ( RE-LIST SCREEN )
  SCR @ LIST 0 M ;

DECIMAL
;S
# 37
( fig-EDITOR  R P I TOP           ) 
EDITOR DEFINITIONS DECIMAL

: R  ( REPLACE ON LINE-1, FROM
       PAD )
  PAD 1+ SWAP -MOVE ;

: P  ( PUT FOLLOWING TEXT ON LINE-1)
   1 TEXT R ;

: I  ( INSERT TEXT FROM PAD ONTO
       LINE-1)
  DUP S R ;

: TOP  ( HOME CURSOR TO TOP LEFT
         OF SCREEN )
  0 R# ! ;

;S
# 38
( fig-EDITOR  CLEAR COPY          ) 
EDITOR DEFINITIONS DECIMAL

: CLEAR  ( CLEAR SCREEN BY NUMBER-1)
  DUP SCR ! CLEAR UPDATE ;


: COPY  ( DUPLICATE SCREEN-2, ONTO
          SCREEN-1 )
  B/SCR * OFFSET @ + SWAP B/SCR
  * B/SCR OVER + SWAP
  DO DUP FORTH I BLOCK 2 - ! 1+
  UPDATE LOOP DROP FLUSH ;

;S
# 39
( fig-EDITOR advanced facilities  ) 
DECIMAL 16 LOAD 17 LOAD ( MATCH   ) 
EDITOR DEFINITIONS DECIMAL

: 1LINE  #LAG PAD COUNT MATCH R# +! 
;
: FIND
  BEGIN 755 R# @ < IF TOP PAD HERE
    C/L 1+ CMOVE 0 ERROR ENDIF 1LINE
  UNTIL ;

: DELETE
  >R #LAG + FORTH R - #LAG R MINUS
  R# +! #LEAD + SWAP CMOVE R>
  BLANKS UPDATE ;

: N  FIND 0 M ;

: F  1 TEXT N ;

: B  PAD C@ MINUS M ; ;S
# 40
( fig-EDITOR advanced  facilities ) 
EDITOR DEFINITIONS DECIMAL

: X  1 TEXT FIND PAD C@ DELETE 0 M ;

: TILL
  #LEAD + 1 TEXT 1LINE 0= 0 ?ERROR
  #LEAD + SWAP - DELETE 0 M ;

: C
  1 TEXT PAD COUNT #LAG ROT OVER MIN
  >R FORTH R R# +! R - >R DUP HERE
  R CMOVE HERE #LEAD + R> CMOVE R>
  CMOVE UPDATE 0 M ;

FORTH DEFINITIONS DECIMAL
;S
# 41
( fig-EDITOR   NEW UNDER          ) 
EDITOR DEFINITIONS DECIMAL
: ENTER?  ( START-LINE-2,
           CURRENT-LINE-1 -- f )
  OVER = ;
: ENTER  ( - ) QUERY 1 TEXT ;
: NULL?  ( - f )  TIB @ C@ 0= ;
: .BS   ( - ) 8 EMIT ;
: NEW  ( START-LINE# -- )
  FORTH 21 0 DO CR I 3 .R SPACE
  I ENTER? IF ENTER NULL? IF .BS
  I SCR @ .LINE ELSE I EDITOR R
  FORTH 1+ THEN ELSE I SCR @
  .LINE THEN LOOP DROP ;
: UNDER  ( START-LINE# -- )
  FORTH 1+ 21 0 DO CR I 3 .R SPACE
  I ENTER? IF ENTER NULL? IF .BS
  I SCR @ .LINE ELSE I EDITOR I
  FORTH 1+ THEN ELSE I SCR @ .LINE
  THEN LOOP DROP ;
FORTH DEFINITIONS    ;S
# 42
( LOADING BLOCK FOR ASSEMBLER     ) 
DECIMAL
: ASM ;
43 LOAD 44 LOAD 45 LOAD 46 LOAD
66 LOAD 67 LOAD ( Z80-addition )
FORTH DEFINITIONS DECIMAL
;S
# 43
( ASSEMBLER 1                     ) 
HEX VOCABULARY ASSEMBLER IMMEDIATE
' ASSEMBLER CFA ' ;CODE 08 + !
: CODE ?EXEC CREATE /COMPILE/
  ASSEMBLER !CSP ; IMMEDIATE
: C; CURRENT @ CONTEXT ! ?EXEC
  ?CSP SMUDGE ; IMMEDIATE
: LABEL ?EXEC 0 VARIABLE SMUDGE -2
  ALLOT /COMPILE/ ASSEMBLER !CSP ;
  IMMEDIATE
: 8* DUP + DUP + DUP + ;
ASSEMBLER DEFINITIONS
4 CONSTANT H   5 CONSTANT L
2 CONSTANT D   3 CONSTANT E
6 CONSTANT M   6 CONSTANT SP
7 CONSTANT A   6 CONSTANT PSW
0 CONSTANT B   1 CONSTANT C
: 1MI <BUILDS C, DOES> C@ C, ;
: 2MI <BUILDS C, DOES> C@ + C, ;
DECIMAL             ;S
# 44
( ASSEMBLER 2                     ) 
ASSEMBLER DEFINITIONS HEX
: 3MI <BUILDS C, DOES> C@ SWAP
  8* + C, ;
: 4MI <BUILDS C, DOES> C@ C, C, ;
: 5MI <BUILDS C, DOES> C@ C, , ;
00 1MI NOP  76 1MI HLT  F3 1MI DI
FB 1MI EI   07 1MI RLC  0F 1MI RRC
17 1MI RAL  1F 1MI RAR  E9 1MI PCHL 
F9 1MI SPHL E3 1MI XTHL EB 1MI XCHG 
27 1MI DAA  2F 1MI CMA  37 1MI STC
3F 1MI CMC  80 2MI ADD  88 2MI ADC
90 2MI SUB  98 2MI SBB  A0 2MI ANA
A8 2MI XRA  B0 2MI ORA  B8 2MI CMP
09 3MI DAD  C1 3MI POP  C5 3MI PUSH 
02 3MI STAX 0A 3MI LDAX 04 3MI INR
05 3MI DCR  03 3MI INX  0B 3MI DCX
C7 3MI RST  D3 4MI OUT  DB 4MI IN
C6 4MI ADI  CE 4MI ACI  D6 4MI SUI
DE 4MI SBI  E6 4MI ANI  EE 4MI XRI
DECIMAL  ;S
# 45
( ASSEMBLER 3                     ) 
ASSEMBLER DEFINITIONS HEX
F6 4MI ORI  FE 4MI CPI  22 5MI SHLD 
2A 5MI LHLD 32 5MI STA  3A 5MI LDA
C4 5MI CNZ  CC 5MI CZ   D4 5MI CNC
DC 5MI CC   E4 5MI CPO  EC 5MI CPE
F4 5MI CP   FC 5MI CM   CD 5MI CALL 
C0 1MI RNZ  C8 1MI RZ   D0 1MI RNC
D8 1MI RC   E0 1MI RPO  E8 1MI RPE
F8 1MI RM   C9 1MI RET  C3 5MI JMP
F0 1MI RP
C2 CONSTANT 0=   D2 CONSTANT CS
E2 CONSTANT PE   F2 CONSTANT 0<
: NOT 8 + ; : MOV 8* 40 + + C, ;
: MVI 8* 6 + C, C, ;
: LXI 8* 1+ C, , ;
: ENDIF 2 ?PAIRS HERE SWAP ! ;
: THEN /COMPILE/ ENDIF ;
: IF C, HERE 0 , 2 ;
: ELSE 2 ?PAIRS C3 IF ROT SWAP
  ENDIF 2 ; DECIMAL  ;S
# 46
( ASSEMBLER 4                     ) 
ASSEMBLER DEFINITIONS HEX
: BEGIN   HERE 1 ;
: UNTIL   SWAP 1 ?PAIRS C, , ;
: AGAIN   1 ?PAIRS C3 C, , ;
: WHILE   IF 2+ ;
: REPEAT  >R >R AGAIN R> R> 2 -
  ENDIF ;
FORTH DEFINITIONS DECIMAL
;S
# 47
( assembler examples              ) 

FORTH DEFINITIONS HEX

ASM ( assembler must be loaded    ) 

CODE ><     ( WORD-1 -- SWAPS HI
              AND LOW BYTE      )
H POP L A MOV H L MOV A H MOV NEXT
1 - JMP C;

CODE LCFOLD ( addr, number --     ) 
( converts lower case to upper case)
     D POP H POP
     BEGIN D A MOV E ORA 0= NOT
     WHILE M A MOV 60 CPI CS NOT
        IF 20 SUI A M MOV
        ENDIF D DCX H INX
     REPEAT NEXT JMP C;

DECIMAL ;S
# 48
( assembler example               ) 
ASM  ( assembler must be loaded   ) 

FORTH DEFINITIONS HEX

80 CONSTANT CMMD  ( command byte  ) 
F0 CONSTANT CMMDPORT ( commandport) 
F1 CONSTANT STATUSPORT

LABEL DELAY ( delay constant in DE
              don't use the stack ) 
   BEGIN D DCX D A MOV E ORA 0=
   UNTIL RET C;

CODE STATUS ( bit-mask -- )
   H POP CMMD A MVI CMMDPORT OUT
   1234 D LXI DELAY CALL
   BEGIN
     STATUSPORT IN L ANA 0= NOT
   UNTIL NEXT JMP C;
DECIMAL ;S
# 49
( HIPLOT DEMO                     ) 
FORTH DEFINITIONS DECIMAL
: N  112 ASCII-OUT ; ( NORTH )
: NE 113 ASCII-OUT ; ( NORTHEAST )
: E  114 ASCII-OUT ; ( EAST )
: SE 115 ASCII-OUT ; ( SOUTHEAST )
: S  116 ASCII-OUT ; ( SOUTH )
: SW 117 ASCII-OUT ; ( SOUTHWEST )
: W  118 ASCII-OUT ; ( WEST )
: NW 119 ASCII-OUT ; ( NORTHWEST )
: DELAY 10 0 DO 32 ASCII-OUT LOOP ; 
: PEN-UP 121 ASCII-OUT DELAY ;
: PEN-DOWN 122 ASCII-OUT DELAY ;
: NS 0 DO N LOOP ;
: NES 0 DO NE LOOP ;
: ES 0 DO E LOOP ;
: SES 0 DO SE LOOP ;
: SS 0 DO S LOOP ;
: SWS 0 DO SW LOOP ;
: WS 0 DO W LOOP ;
: NWS 0 DO NW LOOP ; ;S
# 50
( HIPLOT CONTINUED                ) 
: CIRCLE ( STEP-LENGTH -- )
  >R PEN-DOWN R NS R NES R ES R SES 
  R SS R SWS R WS R> NWS PEN-UP ;

: DRAW DUP CIRCLE 3 * ES ;

: HIPLOT 9600 BAUD 255 ASCII-OUT ;

112 CVARIABLE CHAR 113 C, 114 C,
113 C, 114 C, 115 C, 116 C, 115 C,
116 C, 117 C, 118 C, 117 C,
118 C, 119 C, 112 C, 119 C,

0 VARIABLE PARAM 0 , 0 , 0 , 0 ,

0 VARIABLE X

0 VARIABLE Y
-->
# 51
( HIPLOT CONTINUED                ) 
: BESTLINE ( X Y -- )
  0 PARAM ! DUP Y ! ABS SWAP DUP
X ! ABS - PARAM 2+ !
Y @ 0< NOT IF 2 PARAM !
THEN X @ Y @ + DUP PARAM 4 + !
0< NOT IF 2 PARAM +!
THEN Y @ X @ - DUP PARAM 4 + !
0< NOT IF 2 PARAM +!
THEN X @ 0< IF 10 PARAM +!
       ELSE 8 PARAM @ - PARAM !
THEN PARAM 2+ @ 0<
IF Y @ ABS PARAM 4 + ! ELSE
 X @ ABS PARAM 4 + ! PARAM 2+ DUP
@ MINUS SWAP ! THEN 0 PARAM 8 + !
X @ ABS Y @ ABS + PARAM 6 + !
BEGIN PARAM 6 + @ 0 > WHILE
PARAM DUP 4 + @ SWAP DUP 2+ @
SWAP 8 + @ DUP + + + 0<
IF PARAM DUP 4 + @ SWAP 8 + +!
-1 PARAM 6 + +! 2 -->
# 52
( HIPLOT CONTINUED                ) 
ELSE PARAM DUP 2+ @ SWAP 8 + +!
-2 PARAM 6 + +! 1
THEN PARAM @ SWAP - CHAR + C@
ASCII-OUT
REPEAT ;
;S
# 53
( HIPAD                           ) 
FORTH DEFINITIONS DECIMAL
1130 BAUD
: HIPAD
  15 0 DO ASCII-IN LOOP ;
: PRPAD
  0 15 DO CR I 3 .R 5 .R -1 +LOOP ; 
;S
# 54
( CLOCK ROUTINES SCREEN 1 OF 2    ) 
FORTH DEFINITIONS DECIMAL
0 VARIABLE MYCLOCK 0 ,
: INVERT.CLOCK
  ( ADDR.-1 --                    ) 
  DUP DUP C@ 1 - 255 XOR SWAP C!
  1+ DUP @ 65535 XOR SWAP ! ;



: SET.TIME ( hr-3, min-2, sec-1 --) 
  SWAP 60 * + ( sec )
  50 U* ( units)
  ROT 60 * ( min ) 3000 U* ( units)
  D+
  SWAP MYCLOCK !
  MYCLOCK 2+ C!
  MYCLOCK INVERT.CLOCK
  MYCLOCK CLOCK 3 CMOVE ;
-->
# 55
( CLOCK 2 OF 2                    ) 
 FORTH DEFINITIONS DECIMAL
 : CHECK.CLOCK  ( -- T/F          ) 
   ( FALSE IF IDENTICAL           ) 
   3 0 DO
       MYCLOCK I + C@ PAD I + C@
       XOR LOOP + + ;

 : READ.CLOCK  ( -- )
   BEGIN CLOCK PAD 3 CLOCK MYCLOCK
   3 CMOVE CMOVE CHECK.CLOCK 0=
     UNTIL
   MYCLOCK INVERT.CLOCK ;

 : READ.TIME
   ( -- 50 msec-4,SEC-3,MIN-2,H-1 ) 
   READ.CLOCK MYCLOCK DUP @ SWAP 2+ 
   C@ 3000 U/ SWAP  50 /MOD
   ROT 60 /MOD 24 MOD ;
;S
# 56
( CASE                            ) 
FORTH DEFINITIONS DECIMAL
: CASE:
   <BUILDS SMUDGE RB
   DOES> SWAP 2 * + @ EXECUTE
;
;S
: CASE-EXAMPLE ;
: 0PET   ." AARDVARK " ;
: 1PET   ." BEAVER " ;
: 2PET   ." COUGAR " ;
CASE: ANIMAL 0PET 1PET 2PET ;
0 ANIMAL
1 ANIMAL
2 ANIMAL
;S
# 57
( (CASE- CASE                     ) 
FORTH DEFINITIONS DECIMAL
: (CASE)
  OVER = IF DROP 1 ELSE 0 THEN ;

: CASE

  COMPILE (CASE) /COMPILE/ IF ;
  IMMEDIATE
-->
# 58
( VEDIT def. YXCUR .CUR !CUR +CUR ) 
FORTH DEFINITIONS DECIMAL
: YXCUR  ( X Y -- )
  YCUR C! XCUR C! ;
: .CUR ( display current curs.pos ) 
  R# @ C/L /MOD 2+ SWAP 3 + SWAP
  YXCUR ;
: !CUR  ( N -- )
  0 MAX 755 MIN R# ! ;
: +CUR  ( N -- )
  R# @ + !CUR ;
: +.CUR  ( N -- )
  +CUR .CUR ;
: +LIN ( start of next line )
  R# @ C/L / 1+ C/L * !CUR ;
: HOM  0 R# ! ;
: LIMITS
  21 0 DO C/L 3 + FORTH I 2+ YXCUR
  127 EMIT LOOP ;
: !BLK  SCR @ BLOCK R# @ + C! UPDATE
  1 +.CUR ; -->
# 59
( VEDIT                           ) 
FORTH DEFINITIONS DECIMAL
: VEDIT
  PAGE LIST LIMITS HOM .CUR BEGIN
  KEY  0 CASE 0 23 YXCUR QUIT ELSE
      19 CASE -1 +.CUR ELSE ( left) 
      24 CASE C/L +.CUR ELSE ( down)
       5 CASE C/L MINUS +.CUR ELSE
       4 CASE 1 +.CUR ELSE ( right) 
      13 CASE 1 +LIN .CUR ELSE
      DUP DUP 32 < SWAP 127 > +
      IF DROP 32 THEN
      DUP EMIT !BLK
  THEN THEN THEN THEN THEN THEN
  AGAIN ;
;S
# 60
( grafics                         ) 
FORTH DEFINITIONS DECIMAL
1 CVARIABLE PATTERN 2 C, 4 C, 8 C,
16 C, 64 C,
: GRAFIK.LINE  ( line# --         ) 
  0 SWAP CURADDR 151 SWAP C! ;
: GRAFIK.SCR   ( -- )
  PAGE 24 0 DO I GRAFIK.LINE LOOP ; 
: DOT.ADDR  ( X, Y -- pattern, addr)
  0 MAX 71 MIN SWAP 0 MAX 77 MIN
  SWAP ( keep X,Y within bounds   ) 
  3 /MOD SWAP DUP + ROT 2 /MOD 1+
  ROT  ROT + >R SWAP CURADDR R>
  PATTERN + C@ SWAP ;
: SET.DOT      ( X, Y --          ) 
  DOT.ADDR DUP C@ ROT OR SWAP C! ;
: CLEAR.DOT    ( X, Y --          ) 
  DOT.ADDR SWAP 255 XOR SWAP DUP C@ 
  ROT AND SWAP C! ;
: ?DOT         ( X, Y -- true/false)
  DOT.ADDR C@ AND ;
# 61
( grafics demo                    ) 
FORTH DEFINITIONS DECIMAL
: VERTICAL
  GRAFIK.SCR 72 0 DO 78 0 DO
     I J SET.DOT ?TERMINAL IF LEAVE 
      THEN LOOP ?TERMINAL IF LEAVE
     THEN LOOP 72 0 DO 78 0 DO
     I J CLEAR.DOT ?TERMINAL IF
     LEAVE THEN LOOP ?TERMINAL IF
     LEAVE THEN LOOP ;
: CROSS
  GRAFIK.SCR
  72 0 DO I I SET.DOT LOOP
  72 0 DO I DUP 71 SWAP - SET.DOT
  LOOP      QUIT ;
# 62
( grafics documentation           ) 
;S
GRAFIK.LINE sets one line in graphic
mode.
GRAFIK.SCR  sets the entire screen
in graphic mode.
DOT.ADDR expects an X value between 
0 and 77 and a Y value between
0 and 71.  It first forces X and Y
to be within these limits.
Next, the Y value is converted to a 
row-value, with a bit left over,
which shows which of three vertical 
levels within the character is mark-
ed.  X is then converted to a column
value, with a bit to show 1 of 2
horizontal positions within the char
acter is marked. The X, Y mark bits 
are combined and the bit pattern for
the character is fetched from the
CVARIABLE PATTERN.
# 63
( Y/N                             ) 
FORTH DEFINITIONS DECIMAL
: Y/N
  ( wait for Y or N and return with 
    1 for Y and 0 for N           ) 
  ( --T/F)
  ." (Y/N) "
  BEGIN
    KEY 127 32 - AND ( small to cap)
    DUP 89      = IF DROP 2
       ELSE 78      = IF 1
          ELSE 0
          THEN
       THEN -DUP
    UNTIL
  1 - DUP IF ." Y"
          ELSE ." N"
  THEN CR
;
;S
# 64
( EXAMPLE OF INTERACTIVITY        ) 
FORTH DEFINITIONS DECIMAL
: PLAY
  PAGE ." Hit any key, and you"
  ."  will win the game " KEY
  CR ." You pressed  " EMIT ;
: GAME
  BEGIN
  PLAY
  CR CR ." Do you want to play "
  ." again ? " Y/N
  0= UNTIL
  CR CR ." That's all then " CR ;
;S
# 65
( ASSEMBLER examples              ) 
 FORTH DEFINITIONS DECIMAL
CODE ODD.PARITY.SEND ( ascii-1 -- ) 
     D POP ( char. in E reg )
     E A MOV A ANA ( set flags )
     PE IF E 7 SET
        THEN
     TXD CALL NEXT JMP
 END-CODE
CODE ODD.PARITY.RECEIVE
( -- ascii-2, flag-1 )
     RXD CALL ( char. in E )
     2 H LXI 65013 LDA A 7 BIT 0=
     IF H DCX E A MOV A ANA PE
        IF H DCX THEN
     THEN DPUSH JMP END-CODE     ;S
# 66
( ASSEMBLER 5                     ) 
ASSEMBLER DEFINITIONS HEX
NEXT 1 - CONSTANT HPUSH
NEXT 2 - CONSTANT DPUSH
: END-CODE  /COMPILE/ C; ;
 D9 1MI EXX
: BITAD <BUILDS C, DOES> CB C, C@
  SWAP 8* + + C, ;
 40 BITAD BIT
 80 BITAD RES
 C0 BITAD SET
: 2BYTE <BUILDS C, DOES> ED C, C@
  C, ;
 67 2BYTE RRD    6F 2BYTE RLD
 A0 2BYTE LDI    A1 2BYTE CPII
 A2 2BYTE INI    A3 2BYTE OUTI
 A8 2BYTE LDD    A9 2BYTE CPD
 AA 2BYTE IND    AB 2BYTE OUTD
 B0 2BYTE LDIR   B1 2BYTE CPIR
 FORTH DEFINITIONS DECIMAL
 ;S
# 67
( ASSEMBLER 6                     ) 
ASSEMBLER DEFINITIONS HEX
 B2 2BYTE INIR    B3 2BYTE OTIR
 B8 2BYTE LDDR    B9 2BYTE CPDR
 BA 2BYTE INDR    BB 2BYTE OTDR
: 2BZ80 <BUILDS C, DOES>
 CB C, C@ + C, ;
 00 2BZ80 RLCZ    08 2BZ80 RRCZ
 10 2BZ80 RL      18 2BZ80 RR
 20 2BZ80 SLA     28 2BZ80 SRA
                  38 2BZ80 SRL
 FORTH DEFINITIONS DECIMAL ;S
 Z80 mnemonics   FORTH mnemonics
     CPI               CPII
     RLC               RLCZ
     RRC               RRCZ
# 68
( FORTH-79 DEFINITIONS            ) 
 FORTH DEFINITIONS DECIMAL
: 1- 1 - ;
: 2- 2 - ;
: <> = 0= ;
: DEPTH ( -- n )
  SP@ S0 @ SWAP - 2 / ;
: PICK ( n1 -- n2 )
( If n1 >0, get the n1th. number  ) 
( from the stack, and return it on) 
( top of the stack )
  DEPTH 1- OVER < OVER 1 < OR
( check for bad index: leave true
  if bad, false if OK )
  IF ." INDEX OUTSIDE LIMITS"
     7 EMIT QUIT
  ELSE DUP + SP@ + @
  THEN ;
: ROLL ( n -- re-arranged stack )
  >R R PICK SP@ DUP 2+ R> DUP +
  <CMOVE DROP ;         -->
# 69
( FORTH-79 DEFINITIONS            ) 
 FORTH DEFINITIONS DECIMAL
: >< ( swap bytes )  ( FORTH DEF. ) 
  DUP 256 / SWAP 255 AND 256 * + ;
VOCABULARY FORTH-79 IMMEDIATE
FORTH-79 DEFINITIONS DECIMAL
: CREATE ( agrees with Brodie )
  0 VARIABLE -2 ALLOT ;
: WORD ( -- address )
  WORD HERE ;
 ;S