Fig-FORTH 1.0 for BBC Micro (6502 Assembler)#


   LST   OFF

*  This  public domain publication
*  is   provided   through   the
*  courtesy  of   Forth  Interest
*  Group  P.O.   Box   1105,  San
*  Carlos,CA 94070
*  Further   distribution   must
*  include this notice 
*  Last amended 2/2/87

   TTL   'FIG Forth V.1.0'

SSIZE   EQU   256   ; size of disk sector
NBUF   EQU   2   ; no of buffers in RAM
SECTOR   EQU   400   ; no of sects/drive
SECTL   EQU   800   ; sector limit 2 drives
BMAG   EQU   $404   ; total buffer magnitude

BOS   EQU   $02   ; bottom of FORTH stack
TOS   EQU   $70   ; top of FORTH stack
N   EQU   $78   ; scratch workspace
IP   EQU   $80   ; interpretive pointer
W   EQU   $83   ; codefield pointer
UP   EQU   $85   ; user area pointer
XSAVE   EQU   $87   ; temp store for X reg

ORIG   EQU   $1900   ; origin of FORTHs dictionary
MEM   EQU   $5800   ; top of assigned memory + 1
UAREA   EQU   $480   ; 128 bytes of user area
DAREA   EQU   $5800   ; disk buffer area

RUBOUT   EQU   $7F   ; DEL

TIBX   EQU   $100   ; terminal input buffer

;    MOS entry points

OSBYTE   EQU   -12
OSWORD   EQU   -15
OSWRCH   EQU   -18
OSRDCH   EQU   -32
OSNEWL   EQU   -25
OSCLI   EQU   -9
OSASCI   EQU   -29

   ORG   $1900

   NOP      ; these 2 locations are stamped
   NOP      ; on by BASIC initialisation
    NOP      ; adjust so that CFA does not
    NOP      ; cross page boundary so that
    NOP      ; JMP(W-1) works properly !!!

ENTER   JMP   COLD+2   ; cold start   

REENTR   JMP   WARM   ; warm start

   DW   $6502   ; for 6502
   DW   $0000
    DW   NTOP   ; top word in FORTH
   DW   RUBOUT
   DW   UAREA   ; pointer to user area   
   DW   TOS
   DW   $1FF   ; top of return stack
   DW   TIBX   ; terminal input buffer
   DW   $1F   ; initial WIDTH
    DW   $00   ; warning : 0=no disk
   DW   TOP   ; initial FENCE
   DW   TOP   ; initial top of dictionary
   DW   VLO   ; initial VOC-LINK pointer
   DW   0   ; fiddle for JMP W-1

* LIT *

L22   DFB   $83
   ASC   'LI'
   DFB   $D4

   DW   0   ; bottom word LFA contains 0
LIT   DW   *+2   ; CFA points to itself

   LDA   (IP),Y
       PHA
   INC   IP
   BNE   L30
   INC   IP+1
L30   LDA   (IP),Y
L31   INC   IP
   BNE   PUSH
   INC   IP+1
PUSH   DEX      ; adjust FORTH stack ptr
   DEX
PUT   STA   1,X   ; store (high) byte on FTH stack
   PLA
   STA   0,X   ;  "    (low)   "
NEXT   LDY   #1
   LDA   (IP),Y   ; fetch CFA pointed to by IP
   STA   W+1
   DEY
   LDA   (IP),Y
   STA   W
   CLC
   LDA   IP
        ADC   #2   ; bump IP
   STA   IP
   BCC   L54
   INC   IP+1
L54   JMP   W-1   ; W-1 contains JMP (aaaa) 

* CLIT *

L35   DFB   $84
   ASC   'CLI'
   DFB   $D4

   DW   L22   ; LFA
CLIT   DW   *+2   ; CFA (points to itself)

   LDA   (IP),Y
   PHA
   TYA
   BEQ   L31   ; forced branch into LIT 
SETUP   ASL      ; A = no of (16-bit) words to be
   STA   N-1   ; tfr ed to scratchpad
L63   LDA   0,X   ; from FTH stack
   STA   N,Y
   INX
   INY
   CPY   N-1   ; # of bytes
   BNE   L63
   LDY   #0
   RTS

* EXECUTE *

L75   DFB   $87
   ASC   'EXECUT'
   DFB   $C5

   DW   L35   ; LFA
EXEC   DW   *+2   ; CFA   

   LDA   0,X   ; pokes address from top of
   STA   W   ; FTH stack into W
   LDA   1,X
   STA   W+1
   INX
   INX
   JMP   W-1   ; vector through W

* BRANCH *

L89   DFB   $86
   ASC   'BRANC'
   DFB   $C8

   DW   L75   ; LFA
BRANCH   DW   *+2   ; CFA

   CLC
   LDA   (IP),Y   ; adds following (signed) 16-bit
   ADC   IP   ; value to IP, thus forcing a
   PHA       ; relative branch
   INY
   LDA   (IP),Y
   ADC   IP+1
   STA   IP+1
   PLA
   STA   IP
   JMP   NEXT+2   ; Y already = 1

* 0BRANCH *

L107   DFB   $87
   ASC   '0BRANC'
   DFB   $C8

   DW   L89   ; LFA
ZBRAN   DW   *+2   ; CFA

   INX       ; test top stack item
   INX
   LDA   $FE,X   ; if false then BRANCH
   ORA   $FF,X
   BEQ   BRANCH+2
BUMP   CLC      ; else bump IP
   LDA   IP
   ADC   #2   ; by 2
   STA   IP
   BCC   L122
   INC   IP+1
L122   JMP   NEXT

* (LOOP) *

L127   DFB   $86
   ASC   '(LOOP'
   DFB   $A9

   DW   L107   ; LFA
PLOOP   DW   L130   ; CFA

L130   STX   XSAVE
   TSX
   INC   $101,X   ; bump loop count by 1
   BNE   PL1    ; (on ret'n stack)
   INC   $102,X   ;    "
PL1   CLC
   LDA   $103,X    ; tests loop count vs loop limit
   SBC   $101,X
   LDA   $104,X
   SBC   $102,X
PL2   LDX   XSAVE
   ASL
   BCC   BRANCH+2
   PLA       ; drop loop parameters
   PLA
   PLA
   PLA
   JMP   BUMP   ; leave loop

* (+LOOP) *

L154   DFB   $87
   ASC   '(+LOOP'
   DFB   $A9   ; (there is an extra parm. on stack)
         ; (c.f. (LOOP))
   DW   L127   ; LFA
PPLOO   DW   *+2   ; CFA

   INX
   INX
   STX   XSAVE
   LDA   $FF,X
   PHA
   PHA
   LDA   $FE,X
   TSX
   INX
   INX
   CLC
   ADC   $101,X   ; add increment to loop count
   STA   $101,X
   PLA      ; inc. h.
   ADC   $102,X
   STA   $102,X
   PLA
   BPL   PL1   ; full parm comp'son test if inc. +ve
   CLC
   LDA   $101,X   ; reverse comparison
   SBC   $103,X
   LDA   $102,X
   SBC   $104,X
   JMP   PL2

* (DO) *

L185   DFB   $84   ;
   ASC   '(DO'
   DFB   $A9   ; (transfers loop parameters from)
         ; (FORTH stack to ret'n stack)
   DW   L154   ; LFA
PDO   DW   *+2   ; CFA

   LDA   3,X   ; loop limit hi   
   PHA
   LDA   2,X    ; loop limit lo
   PHA
   LDA   1,X   ; loop start hi
   PHA
   LDA   0,X   ; loop start lo
   PHA
POPTWO   INX      ; drop FORTH stack item
   INX       
POP   INX      ; drop another FORTH stack item
   INX
   JMP   NEXT

* I *

L207   DFB   $81,$C9               'I'

   DW   L185   ; LFA - copy loop counter to FTH stack
I   DW   R+2   ; CFA - same as 'R'

* DIGIT  *

L214   DFB   $85   
   ASC   'DIGI'   ; converts ASCII chr to binary equiv
   DFB   $D4   ; in relevant BASE leaving num on 
         ; FTH stack + tf if valid ff only
   DW   L207   ; if not valid char
DIGIT   DW   *+2

   SEC
   LDA   2,X   ; get char
   SBC   #$30   ; unprintable ?
   BMI   L234
   CMP   #$A   ; 0-9 ?
   BMI   L227
   SEC
   SBC   #7   ; A-F ?
   CMP   #$A
   BMI   L234
L227   CMP   0,X   ; compare with number base
   BPL   L234
   STA   2,X   ; number valid - stack it
   LDA   #1   ; with tf
   PHA
   TYA
   JMP   PUT   ; exit (true) char valid

L234   TYA
   PHA
   INX
   INX
   JMP   PUT   ; exit (false) char invalid

* (FIND) *

L243   DFB   $86   ; dictionary search for word
   ASC    '(FIND'   ; from NFA on top of F. stack
   DFB   $A9   ; which matches text at addr.

   DW   L214   ; beneath it on stack
PFIND   DW   *+2   ; CFA (self)

   LDA    #2
   JSR   SETUP
   STX   XSAVE
L249   LDY   #0
       LDA   (N),Y
   EOR   (N+2),Y
   AND   #$3F
   BNE   L281
L254   INY
   LDA   (N),Y
   EOR   (N+2),Y
   ASL
   BNE   L280
   BCC   L254
   LDX    XSAVE
   DEX
   DEX
   DEX
   DEX
   CLC
   TYA
   ADC   #5
   ADC   N
   STA   2,X
   LDY   #0
   TYA
   ADC   N+1
   STA   3,X
   STY   1,X
   LDA   (N),Y
   STA   0,X
   LDA   #1
   PHA
   JMP   PUSH   ; exit (true) 

L280   BCS   L284
L281   INY
   LDA   (N),Y
   BPL   L281
L284   INY
   LDA   (N),Y
   TAX
   INY
   LDA   (N),Y
   STA   N+1
   STX   N
   ORA   N
   BNE   L249
   LDX   XSAVE
   LDA   #0
   PHA
   JMP   PUSH   ; exit (false)

* ENCLOSE *

L301   DFB   $87
   ASC   'ENCLOS'
   DFB   $C5

   DW   L243   ; LFA
ENCL   DW   *+2   ; CFA

   LDA   #2
   JSR   SETUP   ; copy 2 words to scratchpad
   TXA
   SEC
   SBC   #8
   TAX      ; bump stack ptr by 8 bytes
   STY   3,X   ; Y=0
   STY   1,X
   DEY
L313   INY
   LDA   (N+2),Y
   CMP   N
   BEQ   L313
   STY   4,X
L318   LDA   (N+2),Y
   BNE   L327
   STY   2,X
   STY   0,X
   TYA
   CMP   4,X
   BNE   L326
   INC   2,X
L326   JMP   NEXT

L327   STY   2,X
   INY
   CMP   N
   BNE   L318
   STY   0,X
   JMP   NEXT

* EMIT *

L337   DFB   $84
   ASC   'EMI'
   DFB   $D4
   DW   L301   ; LFA

EMIT   DW   XEMIT   ; vectored

* KEY *

L344   DFB   $83
   ASC   'KE'
   DFB   $D9

   DW   L337   ; LFA

KEY   DW   XKEY   ; vectored

* ?TERMINAL *

L351   DFB   $89
   ASC   '?TERMINA'
   DFB   $CC

   DW   L344   ; LFA
QTERM   DW   XQTER   ; vectored

* CR *

L358   DFB   $82
   ASC   'C'
   DFB   $D2

   DW   L351   ; LFA
CR   DW   XCR   ; vectored

* CMOVE *

L365   DFB   $85
   ASC   'CMOV'
   DFB   $C5

   DW   L358   ; LFA
CMOVE   DW   *+2   ; CFA

   LDA   #3
   JSR   SETUP
L370   CPY   N
   BNE   L375
   DEC   N+1
   BPL   L375
   JMP   NEXT   ; finished

L375   LDA   (N+4),Y
   STA   (N+2),Y
   INY
   BNE   L370
   INC   N+5
   INC   N+3
   JMP   L370

* U* *

L386   DFB   $82
   ASC   'U'
   DFB   $AA

   DW   L365   ; LFA
USTAR   DW   *+2   ; CFA

   LDA   2,X
   STA   N
   STA   2,X
   LDA   3,X
   STA   N+1
   STY   3,X
   LDY   #16
L396   ASL   2,X
   ROL   3,X
   ROL   0,X
   ROL   1,X
   BCC   L411
   CLC
   LDA   N
   ADC   2,X
   STA   2,X
   LDA   N+1
   ADC   3,X
   STA   3,X
   LDA   #0
   ADC   0,X
   STA   0,X
L411   DEY
   BNE   L396
   JMP   NEXT

* U/ *

L418   DFB   $82
   ASC   'U'
   DFB   $AF

   DW   L386   ; LFA
USLASH   DW   *+2   ; CFA

   LDA   4,X
   LDY   2,X
   STY   4,X
   ASL
   STA   2,X
   LDA   5,X
   LDY   3,X
   STY   5,X
   ROL
   STA   3,X
   LDA   #16
   STA   N
L433   ROL   4,X
   ROL   5,X
   SEC
   LDA   4,X
   SBC   0,X
   TAY
   LDA   5,X
   SBC   1,X
   BCC   L444
   STY   4,X
   STA   5,X
L444   ROL   2,X
   ROL   3,X
   DEC   N
   BNE   L433
   JMP   POP

* AND *

L453   DFB   $83
   ASC   'AN'
   DFB   $C4

   DW   L418   ; LFA
ANDD   DW   *+2   ; CFA

   LDA   0,X
   AND   2,X
   PHA
   LDA   1,X
   AND   3,X

BINARY   INX
   INX
   JMP   PUT

* OR *

L469   DFB   $82
   ASC   'O'   
   DFB   $D2

   DW   L453   ; LFA
OR   DW   *+2   ; CFA

   LDA   0,X
   ORA   2,X
   PHA
   LDA   1,X
   ORA   3,X
   INX
   INX
   JMP   PUT

* XOR *

L484   DFB   $83
   ASC   'XO'
   DFB   $D2

   DW   L469   ; LFA
XOR   DW   *+2   ; CFA

   LDA   0,X
   EOR   2,X
   PHA
   LDA   1,X
   EOR   3,X
   INX
   INX
   JMP   PUT

* SP@ *

L499   DFB   $83
   ASC   'SP'
   DFB   $C0

   DW   L484   ; LFA
SPAT   DW   *+2   ; CFA

   TXA
PUSH0A   PHA
   LDA   #0
   JMP   PUSH

* SP! *

L511   DFB   $83
   ASC   'SP'
   DFB   $A1

   DW   L499   ; LFA
SPSTO   DW   *+2   ; CFA

   LDY   #6
   LDA   (UP),Y
   CLC      ; MJR
   ADC   #2   ; MJR
   TAX
   JMP   NEXT

* RP! *

L522   DFB   $83
   ASC   'RP'
   DFB    $A1

   DW   L511   ; LFA
RPSTO   DW   *+2   ; CFA

   STX   XSAVE
   LDY   #8
   LDA   (UP),Y
   TAX
   TXS
   LDX   XSAVE
   JMP   NEXT

* ;S *

L536   DFB   $82
   ASC   ';'
   DFB   $D3

   DW   L522
SEMIS   DW   *+2

   PLA
   STA   IP
   PLA
   STA   IP+1
   JMP   NEXT

* LEAVE *

L548   DFB   $85
   ASC   'LEAV'
   DFB   $C5

   DW   L536
LEAVE   DW   *+2

   STX   XSAVE
   TSX
   LDA   $101,X
   STA   $103,X
   LDA   $102,X
   STA   $104,X
   LDX   XSAVE
   JMP   NEXT

* >R *

L563   DFB   $82
   ASC   '>'
   DFB   $D2

   DW   L548   ; LFA
TOR   DW   *+2   ; CFA   

   LDA   1,X
   PHA
   LDA   0,X
   PHA   
   INX
   INX
   JMP   NEXT

* R> *

L577   DFB   $82
   ASC   'R'   
   DFB   $BE

   DW   L563   ; LFA
RFROM   DW   *+2   ; CFA

   DEX
   DEX
   PLA
   STA   0,X
   PLA
   STA   1,X
   JMP   NEXT

* R *

L591   DFB   $81,$D2

   DW   L577   ; LFA
R   DW   *+2    ; CFA

   STX   XSAVE   ; copy
   TSX             ; top of
   LDA   $101,X    ; m/c stack
   PHA      ; to
   LDA   $102,X   ; 4th stack
   LDX   XSAVE   ; = 'I'
   JMP   PUSH

* 0= *

L605   DFB   $82
   ASC   '0'
   DFB   $BD

   DW   L591   ; LFA
ZEQU   DW   *+2   ; CFA

   LDA   0,X
   ORA   1,X
   STY   1,X
   BNE   L613
   INY
L613   STY   0,X
   JMP   NEXT

* 0< *

L619   DFB   $82
   ASC   '0'
   DFB   $BC

   DW   L605   ; LFA
ZLESS   DW   *+2   ; CFA

   ASL   1,X   ; leave true
   TYA      ; if BOS
   ROL   A    ; -ve else
   STY   1,X   ; leave false
   STA   0,X
   JMP   NEXT

* + *

L632   DFB   $81,$AB

   DW   L619     ; LFA
PLUS   DW   *+2   ; CFA

   CLC
   LDA   0,X
   ADC   2,X
   STA   2,X
   LDA   1,X
   ADC   3,X
   STA   3,X
   INX
   INX
   JMP   NEXT

* D+ *

L649   DFB   $82
   ASC   'D'
   DFB   $AB

   DW   L632   ; LFA
DPLUS   DW   *+2   ; CFA

   CLC
   LDA   2,X
   ADC   6,X
   STA   6,X
   LDA   3,X
   ADC   7,X
   STA   7,X
   LDA   0,X
   ADC   4,X
   STA   4,X
   LDA   1,X
   ADC   5,X
   STA   5,X
   JMP   POPTWO

* MINUS *

L670   DFB   $85
   ASC   'MINU'
   DFB   $D3

   DW   L649   ; LFA
MINUS   DW   *+2   ; CFA

   SEC
   TYA
   SBC   0,X   ; leave
   STA   0,X   ; 2's compliment
   TYA       ; of BOS
   SBC   1,X
   STA   1,X
   JMP   NEXT

* DMINUS *

L685   DFB   $86
   ASC   'DMINU'
   DFB   $D3

   DW   L670   ; LFA
DMINUS   DW   *+2   ; CFA

   SEC
   TYA
   SBC   2,X
   STA   2,X
   TYA
   SBC   3,X
   STA   3,X
   JMP   MINUS+3

* OVER *

L700   DFB   $84
   ASC   'OVE'
   DFB   $D2

   DW   L685   ; LFA
OVER   DW   *+2   ; CFA

   LDA   2,X
   PHA
   LDA   3,X
   JMP   PUSH

* DROP *

L711   DFB   $84
   ASC   'DRO'
   DFB   $D0

   DW   L700      ; LFA
DROP   DW   POP   ; CFA

* SWAP *

L718   DFB   $84
   ASC   'SWA'
   DFB   $D0

   DW   L711   ; LFA
SWAP   DW   *+2

   LDA   2,X
   PHA
   LDA   0,X
   STA   2,X
   LDA   3,X
   LDY   1,X
   STY   3,X
   JMP   PUT

* DUP *

L733   DFB   $83
   ASC   'DU'
   DFB   $D0

   DW   L718   ; LFA
DUP   DW   *+2   ; CFA

   LDA   0,X
   PHA
   LDA   1,X
   JMP   PUSH

* +! *

L744   DFB   $82
   ASC   '+'
   DFB   $A1   

   DW   L733   ; LFA
PSTORE   DW   *+2

   CLC
   LDA   (0,X)
   ADC   2,X
   STA   (0,X)
   INC   0,X
   BNE   L754
   INC   1,X
L754   LDA   (0,X)
   ADC   3,X
   STA   (0,X)
   JMP   POPTWO

* TOGGLE *

L762   DFB   $86
   ASC   'TOGGL'
   DFB   $C5

   DW   L744   ; LFA
TOGGLE   DW   *+2   ; CFA

   LDA   (2,X)
   EOR   0,X
   STA   (2,X)   
   JMP   POPTWO

* @ *

L773   DFB   $81,$C0

   DW   L762   ; LFA
AT   DW   *+2   ; CFA

   LDA   (0,X)
   PHA
   INC   0,X
   BNE   L781
   INC   1,X
L781   LDA   (0,X)
   JMP   PUT

* C@ *

L787   DFB   $82
   ASC   'C'
   DFB   $C0

   DW   L773   ; LFA
CAT   DW   *+2   ; CFA

   LDA   (0,X)
   STA   0,X
   STY   1,X
   JMP   NEXT

* ! *

L798   DFB   $81,$A1

   DW   L787   ; LFA
STORE   DW   *+2   ; CFA

   LDA   2,X
   STA   (0,X)
   INC   0,X
   BNE   L806
   INC   1,X
L806   LDA   3,X
   STA   (0,X)
   JMP   POPTWO

* C! *

L813   DFB   $82
   ASC   'C'
   DFB   $A1

   DW   L798   ; LFA
CSTORE   DW   *+2   ; CFA

   LDA   2,X
   STA   (0,X)
   JMP   POPTWO

* : *

L823   DFB   $C1,$BA

   DW   L813   ; LFA
COLON   DW   DOCOL   ; CFA

   DW   QEXEC
   DW   SCSP
   DW   CURR
   DW   AT
   DW   CON
   DW   STORE
   DW   CREATE
   DW   RBRACK
   DW   PSCOD

DOCOL   LDA   IP+1
   PHA
   LDA   IP
   PHA
   CLC
   LDA   W
   ADC   #2
   STA   IP
   TYA
   ADC   W+1
   STA   IP+1
   JMP   NEXT

* ; *

L853   DFB   $C1,$BB

   DW   L823   ; LFA
   DW   DOCOL   ; CFA

   DW   QCSP
   DW   COMP
   DW   SEMIS
   DW   SMUDGE
   DW   LBRACK
   DW   SEMIS

* CONSTANT *

L867   DFB   $88
   ASC   'CONSTAN'
   DFB   $D4

   DW   L853   ; LFA
CONST   DW   DOCOL   ; CFA

   DW   CREATE
   DW   SMUDGE
   DW   COMMA
   DW   PSCOD

DOCON   LDY   #2
   LDA   (W),Y
   PHA
   INY
   LDA   (W),Y
   JMP   PUSH

* VARIABLE *

L885   DFB   $88
   ASC   'VARIABL'
   DFB   $C5

   DW   L867   ; LFA
VAR   DW   DOCOL   ; CFA

   DW   CONST
   DW   PSCOD

DOVAR   CLC
   LDA   W
   ADC   #2
   PHA
   TYA
   ADC   W+1
   JMP   PUSH

* USER *

L902   DFB   $84
   ASC   'USE'
   DFB   $D2

   DW   L885   ; LFA
USER   DW   DOCOL   ; CFA

   DW   CONST
   DW   PSCOD

DOUSE   LDY   #2
   CLC
   LDA   (W),Y
   ADC   UP
   PHA
   LDA   #0
   ADC   UP+1
   JMP   PUSH

* 0 *

L920   DFB   $81,$B0

   DW   L902   ; LFA
ZERO   DW   DOCON   ; CFA

   DW   0

* 1 *

L928   DFB   $81,$B1

   DW   L920   ; LFA
ONE   DW   DOCON   ; CFA

   DW   1

* 2 *

L936   DFB   $81,$B2

   DW   L928   ; LFA
TWO   DW   DOCON   ; CFA

   DW   2

* 3 *

L944   DFB   $81,$B3

   DW   L936   ; LFA
THREE   DW   DOCON   ; CFA

   DW   3

* BL *

L952   DFB   $82
   ASC   'B'
   DFB   $CC

   DW   L944   ; LFA
BL   DW   DOCON   ; CFA

   DW   32   ; ASCII blank

* C/L *

L960   DFB   $83
   ASC   'C/'
   DFB   $CC

   DW   L952   ; LFA
CSLL   DW   DOCON   ; CFA

   DW   64   ; 64 chars/line

   DW   SEMIS   ; MJR - padding

* FIRST *

L968   DFB   $85
   ASC   'FIRS'
   DFB   $D4

   DW   L960   ; LFA
FIRST   DW   DOCON   ; CFA
          
   DW   DAREA   ; bottom of disk
         ; buffer

* LIMIT *

L976   DFB   $85
   ASC   'LIMI'
   DFB   $D4

   DW   L968   ; LFA
LIMIT   DW   DOCON   ; CFA

   DW   $5800   ; end of buffers-see Harrison

* B/BUF *

L984   DFB   $85
   ASC   'B/BU'
   DFB   $C6

   DW   L976   ; LFA
BBUF   DW   DOCON   ; CFA

   DW   256   ; sector size

* B/SCR *

L992   DFB   $85
   ASC   'B/SC'
   DFB   $D2

   DW   L984   ; LFA
BSCR   DW   DOCON   ; CFA

   DW   4   ; blocks per screen   

L1000   DFB   $87
   ASC   '+ORIGI'
   DFB   $CE

   DW   L992   ; LFA
PORIG   DW   DOCOL   ; CFA

   DW   LIT
   DW   ORIG
   DW   PLUS
   DW   SEMIS

* TIB *

L1010   DFB   $83
   ASC   'TI'
   DFB   $C2

   DW   L1000   ; LFA
TIB   DW   DOUSE   ; CFA

   DFB   $A

* WIDTH *

L1018   DFB   $85
   ASC   'WIDT'
   DFB   $C8

   DW   L1010    ; LFA
WIDTH   DW   DOUSE   ; CFA

   DFB   $C

* WARNING *

L1026   DFB   $87
   ASC   'WARNIN'
   DFB   $C7

   DW   L1018   ; LFA
WARN   DW   DOUSE   ; CFA

   DFB   $E

* FENCE *

L1034   DFB   $85
   ASC   'FENC'
   DFB   $C5

   DW   L1026   ; LFA
FENCE   DW   DOUSE   ; CFA

   DFB   $10

* DP *

L1042   DFB   $82
   ASC   'D'
   DFB   $D0

   DW   L1034   ; LFA
DP   DW   DOUSE   ; CFA

   DFB   $12

* VOC-LINK *

L1050   DFB   $88
   ASC   'VOC-LIN'
   DFB   $CB

   DW   L1042   ; LFA
VOCLNK   DW   DOUSE   ; CFA

   DFB   $14

* BLK *

L1058   DFB   $83
   ASC   'BL'
   DFB   $CB

   DW   L1050   ; LFA
BLK   DW   DOUSE   ; CFA

   DFB   $16

* IN *

L1066   DFB   $82
   ASC   'I'
   DFB   $CE

   DW   L1058   ; LFA
IN   DW   DOUSE   ; CFA

   DFB   $18

* OUT *

L1074   DFB   $83
   ASC   'OU'
   DFB   $D4

   DW   L1066   ; LFA
OUT   DW   DOUSE   ; CFA

   DFB   $1A

* SCR *

L1082   DFB   $83
   ASC   'SC'
   DFB   $D2

   DW   L1074   ; LFA
SCR   DW   DOUSE   ; CFA

   DFB   $1C

* OFFSET *

L1090   DFB   $86
   ASC   'OFFSE'
   DFB   $D4   

   DW   L1082   ; LFA
OFFSET   DW   DOUSE   ; CFA

   DFB   $1E

* CONTEXT *

L1098   DFB   $87
   ASC   'CONTEX'
   DFB   $D4

   DW   L1090   ; LFA
CON   DW   DOUSE   ; CFA

   DFB   $20

* CURRENT *

L1106   DFB   $87
   ASC   'CURREN'
   DFB   $D4

   DW   L1098   ; LFA
CURR   DW   DOUSE   ; CFA

   DFB   $22

* STATE *

L1114   DFB   $85
   ASC   'STAT'
   DFB   $C5

   DW   L1106   ; LFA
STATE   DW   DOUSE   ; CFA

   DFB   $24

* BASE *

L1122   DFB   $84
   ASC   'BAS'
   DFB   $C5

   DW   L1114   ; LFA
BASE   DW   DOUSE   ; CFA

   DFB   $26

* DPL *

L1130   DFB   $83
   ASC   'DP'
   DFB   $CC

   DW   L1122   ; LFA
DPL   DW   DOUSE   ; CFA

   DFB   $28

* FLD *

L1138   DFB   $83
   ASC   'FL'
   DFB   $C4

   DW   L1130   ; LFA
FLD   DW   DOUSE   ; CFA

   DFB   $2A

* CSP *

L1146   DFB   $83
   ASC   'CS'
   DFB   $D0

   DW   L1138   ; LFA
CSP   DW   DOUSE   ; CFA

   DFB   $2C

* R# *

L1154   DFB   $82
   ASC   'R'
   DFB   $A3

   DW   L1146   ; LFA
RNUM   DW   DOUSE   ; CFA

   DFB   $2E

* HLD *

L1162   DFB   $83
   ASC   'HL'
   DFB   $C4

   DW   L1154   ; LFA
HLD   DW   DOUSE   ; CFA

   DFB   $30

* 1+ *

L1170   DFB   $82
   ASC   '1'
   DFB   $AB

   DW   L1162   ; LFA
ONEP   DW   DOCOL   ; CFA

   DW   ONE
   DW   PLUS
   DW   SEMIS

* 2+ *

L1180   DFB   $82
   ASC   '2'
   DFB   $AB

   DW   L1170   ; LFA
TWOP   DW   DOCOL   ; CFA

   DW   TWO
   DW   PLUS
   DW   SEMIS

* HERE *

L1190   DFB   $84
   ASC   'HER'
   DFB   $C5

   DW   L1180   ; LFA
HERE   DW   DOCOL   ; CFA

   DW   DP
   DW   AT
   DW   SEMIS

* ALLOT *

L1200   DFB   $85
   ASC   'ALLO'
   DFB   $D4

   DW   L1190   ; LFA
ALLOT   DW   DOCOL   ; CFA

   DW   DP
   DW   PSTORE
   DW   SEMIS

* , *

L1210   DFB   $81,$AC

   DW   L1200   ; LFA
COMMA   DW   DOCOL   ; CFA

   DW   HERE
   DW   STORE
   DW   TWO
   DW   ALLOT
   DW   SEMIS

* C, *

L1222   DFB   $82
   ASC   'C'
   DFB   $AC

   DW   L1210   ; LFA
CCOMMA   DW   DOCOL   ; CFA

   DW   HERE
   DW   CSTORE
   DW   ONE
   DW   ALLOT
   DW   SEMIS

* - *

L1234   DFB   $81,$AD

   DW   L1222   ; LFA
SUB   DW   DOCOL   ; CFA

   DW   MINUS
   DW   PLUS
   DW   SEMIS

* = *

L1244   DFB   $81,$BD

   DW   L1234   ; LFA
EQUALS   DW   DOCOL   ; CFA

   DW   SUB
   DW   ZEQU
   DW   SEMIS

* U< *

L1246   DFB   $82
   ASC   'U'
   DFB   $BC

   DW   L1244   ; LFA
ULESS   DW   DOCOL   ; CFA

   DW   SUB
   DW   ZLESS
   DW   SEMIS

* < *

L1254   DFB   $81,$BC

   DW   L1246   ; LFA
LESS   DW   *+2   ; CFA

   SEC
   LDA   2,X
   SBC   0,X
   LDA   3,X
   SBC   1,X
   STY   3,X   ; zero hi byte
   BVC   L1258
   EOR   #$80   ; correct o/flow
L1258   BPL   L1260
   INY      ; invrt flag
L1260   STY   2,X
   JMP   POP

* > *

L1264   DFB   $81,$BE

   DW   L1254   ; LFA
GREAT   DW   DOCOL   : CFA

   DW   SWAP
   DW   LESS
   DW   SEMIS

* ROT *

L1274   DFB   $83
   ASC   'RO'
   DFB   $D4

   DW   L1264   ; LFA
ROT   DW   DOCOL   ; CFA

   DW   TOR
   DW   SWAP
   DW   RFROM
   DW   SWAP
   DW   SEMIS

* SPACE *

L1286   DFB   $85
   ASC   'SPAC'
   DFB   $C5

   DW   L1274   ; LFA
SPACE   DW   DOCOL

   DW   BL
   DW   EMIT
   DW   SEMIS

* -DUP *

L1296   DFB   $84
   ASC   '-DU'
   DFB   $D0

   DW   L1286   ; LFA
DDUP   DW   DOCOL   ; CFA

   DW   DUP
       DW   ZBRAN
   DW   4
   DW   DUP
   DW   SEMIS

* TRAVERSE *

L1308   DFB   $88
   ASC   'TRAVERS'
   DFB   $C5

   DW   L1296   ; LFA
TRAV   DW   DOCOL   ; CFA

   DW   SWAP
   DW   OVER
   DW   PLUS
   DW   CLIT
   DFB   $7F
   DW   OVER
   DW   CAT
   DW   LESS
   DW   ZBRAN
   DW   -15
   DW   SWAP
   DW   DROP
   DW   SEMIS

* LATEST *

L1328   DFB   $86
   ASC   'LATES'
   DFB   $D4

   DW   L1308   ; LFA
LATEST   DW   DOCOL   ; CFA

   DW   CURR
   DW   AT
   DW   AT
   DW   SEMIS

* LFA *

L1339   DFB   $83
   ASC   'LF'
   DFB   $C1

   DW   L1328   ; LFA
LFA   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   4
   DW   SUB
   DW   SEMIS

* CFA *

L1350   DFB   $83
   ASC   'CF'
   DFB   $C1

   DW   L1339   ; LFA
CFA   DW   DOCOL   ; CFA

   DW   TWO
   DW   SUB
   DW   SEMIS

* NFA *

L1360   DFB   $83
   ASC   'NF'
   DFB   $C1

   DW   L1350   ; LFA
NFA   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   5
   DW   SUB
   DW   LIT
   DW   -1
   DW   TRAV
   DW   SEMIS

* PFA *

L1373   DFB   $83
   ASC   'PF'
   DFB   $C1

   DW   L1360   ; LFA
PFA   DW   DOCOL   ; CFA

   DW   ONE
   DW   TRAV
   DW   CLIT
   DFB   5
   DW   PLUS
   DW   SEMIS

* !CSP *

L1386   DFB   $84
   ASC   '!CS'
   DFB   $D0

   DW   L1373   ; LFA
SCSP   DW   DOCOL   ; CFA

   DW   SPAT
   DW   CSP
   DW   STORE
   DW   SEMIS

* ?ERROR *

L1397   DFB   $86
   ASC   '?ERRO'
   DFB   $D2

   DW   L1386   ; LFA
QERROR   DW   DOCOL   ; CFA

   DW   SWAP
   DW   ZBRAN
   DW   8
   DW   ERROR
   DW   BRANCH
   DW   4
   DW   DROP
   DW   SEMIS

* ?COMP *

L1412   DFB   $85
   ASC   '?COM'
   DFB   $D0

   DW   L1397   ; LFA
QCOMP   DW   DOCOL   ; CFA

   DW   STATE
   DW   AT
   DW   ZEQU
   DW   CLIT
   DFB   17
   DW   QERROR
   DW   SEMIS

* ?EXEC *

L1426   DFB   $85
   ASC   '?EXE'
   DFB   $C3

   DW   L1412   ; LFA
QEXEC   DW   DOCOL   ; CFA

   DW   STATE
   DW   AT
   DW   CLIT
   DFB   18
   DW   QERROR
   DW   SEMIS

* ?PAIRS *

L1439   DFB   $85
   ASC   '?PAIR'
   DFB   $D3

   DW   L1426   ; LFA
QPAIR   DW   DOCOL   ; CFA

   DW   SUB
   DW   CLIT
   DFB   19
   DW   QERROR
   DW   SEMIS

* ?CSP *

L1451   DFB   $84
   ASC   '?CS'
   DFB   $D0

   DW   L1439   ; LFA
QCSP   DW   DOCOL   ; CFA

   DW   SPAT
   DW   CSP
   DW   AT
   DW   SUB
   DW   CLIT
   DFB   20
   DW   QERROR
   DW   SEMIS

* ?LOADING *

L1466   DFB   $88
   ASC   '?LOADIN'
   DFB   $C7

   DW   L1451   ; LFA
QLOAD   DW   DOCOL   ; CFA

   DW   BLK
   DW   AT
   DW   ZEQU
   DW   CLIT
   DFB   22
   DW   QERROR
   DW   SEMIS

* COMPILE *

L1480   DFB   $87
   ASC   'COMPIL'
   DFB   $C5

   DW   L1466   ; LFA
COMP   DW   DOCOL   ; CFA

   DW   QCOMP
   DW   RFROM
   DW   DUP
   DW   TWOP
   DW   TOR
   DW   AT
   DW   COMMA
   DW   SEMIS

* ~[ *

L1495   DFB   $81,$DB

   DW   L1480   ; LFA
LBRACK   DW   DOCOL   ; CFA

   DW   ZERO
   DW   STATE
   DW   STORE
   DW   SEMIS

* ] *

L1507   DFB   $81,$DD

   DW   L1495   ; LFA
RBRACK   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   $C0
   DW   STATE
   DW   STORE
   DW   SEMIS

* SMUDGE *

L1519   DFB   $86
   ASC   'SMUDG'
   DFB   $C5

   DW   L1507   ; LFA
SMUDGE   DW   DOCOL   ; CFA

   DW   LATEST
   DW   CLIT
   DFB   32
   DW   TOGGLE
   DW   SEMIS

* HEX *

L1531   DFB   $83
   ASC   'HE'
   DFB   $D8

   DW   L1519   ; LFA
HEX   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   16
   DW   BASE
   DW   STORE
   DW   SEMIS

* DECIMAL *

L1543   DFB   $87
   ASC   'DECIMA'
   DFB   $CC

   DW   L1531   ; LFA
DECIM   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   10
   DW   BASE
   DW   STORE
   DW   SEMIS

* (;CODE) *

L1555   DFB   $87
   ASC   '(;COD'
   DFB   $A9

   DW   L1543   ; LFA
PSCOD   DW   DOCOL   ; CFA

   DW   RFROM
   DW   LATEST
   DW   PFA
   DW   CFA
   DW   STORE
   DW   SEMIS

* ;CODE *

L1568   DFB   $85
   ASC   ';COD'
   DFB   $C5

   DW   L1555   ; LFA
   DW   DOCOL
   DW   QCSP
   DW   COMP
   DW   PSCOD
   DW   LBRACK
   DW   SMUDGE
   DW   SEMIS

* <BUILDS *

L1582   DFB   $87
   ASC   '<BUILD'
   DFB   $D3

   DW   L1568   ; LFA
BUILD   DW   DOCOL   ; CFA

   DW   ZERO
   DW   CONST
   DW   SEMIS

* DOES> *

L1592   DFB   $85
   ASC   'DOES'
   DFB   $BE

   DW   L1582   ; LFA
DOES   DW   DOCOL   ; CFA

   DW   RFROM
   DW   LATEST
   DW   PFA
   DW   STORE
   DW   PSCOD

DODOE   LDA   IP+1
   PHA
   LDA   IP
   PHA
   LDY   #2
   LDA   (W),Y
   STA   IP
   INY
   LDA   (W),Y
   STA   IP+1
   CLC
   LDA   W
   ADC   #4
   PHA
   LDA   W+1
   ADC   #0
   JMP   PUSH

* COUNT *

L1622   DFB   $85
   ASC   'COUN'
   DFB   $D4

   DW   L1592   ; LFA
COUNT   DW   DOCOL   ; CFA

   DW   DUP
   DW   ONEP
   DW   SWAP
   DW   CAT
   DW   SEMIS

* TYPE *

L1634   DFB   $84
   ASC   'TYP'
   DFB   $C5

   DW   L1622   ; LFA
TYPE   DW   DOCOL   ; CFA

   DW   DDUP
   DW   ZBRAN
   DW    24
   DW   OVER
   DW   PLUS
   DW   SWAP
   DW   PDO
   DW   I
   DW   CAT
   DW   EMIT
   DW   PLOOP
   DW   -8
   DW   BRANCH
   DW   4
   DW   DROP
   DW   SEMIS

* -TRAILING *

L1657   DFB   $89
   ASC   '-TRAILIN'
   DFB   $C7

   DW   L1634   ; LFA
DTRAI   DW   DOCOL   ; CFA

   DW   DUP
   DW   ZERO
   DW   PDO
   DW   OVER
   DW   OVER
   DW   PLUS
   DW   ONE
   DW   SUB
   DW   CAT
   DW   BL
   DW   SUB
   DW   ZBRAN
   DW   8
   DW   LEAVE
   DW   BRANCH
   DW   6
   DW   ONE
   DW   SUB
   DW   PLOOP
   DW   $FFE0
   DW   SEMIS

* (.") *

L1685   DFB   $84
   ASC   '(."'
   DFB   $A9

   DW   L1657   ; LFA
PDOTQ   DW   DOCOL   ; CFA

   DW   R
   DW   COUNT
   DW   DUP
   DW   ONEP
   DW   RFROM
   DW   PLUS
   DW   TOR
   DW   TYPE
   DW   SEMIS

* ." *

L1701   DFB   $C2
   ASC   '.'
   DFB   $A2

   DW   L1685   ; LFA
   DW   DOCOL   ; CFA

   DW   CLIT   
   DFB   34
   DW   STATE
   DW   AT
   DW   ZBRAN
   DW   20
   DW   COMP
   DW   PDOTQ
   DW   WORD
   DW   HERE
   DW   CAT
   DW   ONEP
   DW   ALLOT
   DW   BRANCH
   DW   10
   DW   WORD
   DW   HERE
   DW   COUNT
   DW   TYPE
   DW   SEMIS

* EXPECT *

L1729   DFB   $86
   ASC   'EXPEC'
   DFB   $D4

   DW   L1701   ; LFA
EXPECT   DW   DOCOL   ; CFA

   DW   OVER
   DW   PLUS
   DW   OVER
   DW   PDO
   DW   KEY
   DW   DUP
   DW   CLIT
   DFB   17   ; adjust as appropriate
   DW   PORIG   ; rel. NOPS at ORG
   DW   AT
   DW   EQUALS
   DW   ZBRAN
   DW   31
   DW   DROP
   DW   CLIT
   DFB   $7F
   DW   OVER
   DW   I
   DW   EQUALS
   DW   DUP
   DW   RFROM
   DW   TWO
   DW   SUB
   DW   PLUS
   DW   TOR
*   DW   SUB
   DW   DROP   ; MJR
   DW   BRANCH
   DW   39
   DW   DUP
   DW   CLIT
   DFB   13
   DW   EQUALS
   DW   ZBRAN
   DW   14
   DW   LEAVE
   DW   DROP
   DW   BL
   DW   ZERO
   DW   BRANCH
   DW   4
   DW   DUP
   DW   I
   DW   CSTORE
   DW   ZERO
   DW   I
   DW   ONEP
   DW   STORE
   DW   EMIT
   DW   PLOOP
   DW   $FFA9
   DW   DROP
   DW   SEMIS

* QUERY *

L1788   DFB   $85
   ASC   'QUER'
   DFB   $D9

   DW   L1729   ; LFA
QUERY   DW   DOCOL   ; CFA

   DW   TIB
   DW   AT
   DW   CLIT
   DFB   80
   DW   EXPECT
   DW   ZERO
   DW   IN
   DW   STORE
   DW   SEMIS

* <ASCII NULL> *

L1804   DFB   $C1,$80

   DW   L1788   ; LFA
   DW   DOCOL   ; CFA

   DW   BLK
   DW   AT
   DW   ZBRAN
   DW   42
   DW   ONE
   DW   BLK
   DW   PSTORE
   DW   ZERO
   DW   IN
   DW   STORE
   DW   BLK
   DW   AT
   DW   ZERO
   DW   BSCR
   DW   USLASH
   DW   DROP
   DW   ZEQU
   DW   ZBRAN
   DW   8
   DW   QEXEC
   DW   RFROM
   DW   DROP
   DW   BRANCH
   DW   6
   DW   RFROM
   DW   DROP
   DW   SEMIS

* FILL *

L1838   DFB   $84
   ASC   'FIL'
   DFB   $CC

   DW   L1804   ; LFA
FILL   DW   DOCOL   ; CFA

   DW   SWAP
   DW   TOR
   DW   OVER
   DW   CSTORE
   DW   DUP
   DW   ONEP
   DW   RFROM
   DW   ONE
   DW   SUB
   DW   CMOVE
   DW   SEMIS

* ERASE *

L1856   DFB   $85
   ASC   'ERAS'
   DFB   $C5

   DW   L1838   ; LFA
ERASE   DW   DOCOL   ; CFA

   DW   ZERO
   DW   FILL
   DW   SEMIS

* BLANKS *

L1866   DFB   $86
   ASC   'BLANK'
   DFB   $D3

   DW   L1856   ; LFA
BLANKS   DW   DOCOL   ; CFA

   DW   BL
   DW   FILL
   DW   SEMIS

* HOLD *

L1876   DFB   $84
   ASC   'HOL'
   DFB   $C4

   DW   L1866   ; LFA
HOLD   DW   DOCOL   ; CFA

   DW   LIT
   DW   -1
   DW   HLD
   DW   PSTORE
   DW   HLD
   DW   AT
   DW   CSTORE
   DW   SEMIS

* PAD *

L1890   DFB   $83
   ASC   'PA'
   DFB   $C4

   DW   L1876   ; LFA
PAD   DW   DOCOL   ; CFA

   DW   HERE
   DW   CLIT
   DFB   68
   DW   PLUS
   DW   SEMIS

* WORD *

L1902   DFB   $84
   ASC   'WOR'
   DFB   $C4

   DW   L1890   ; LFA
WORD   DW   DOCOL   ; CFA

   DW   BLK
   DW   AT
   DW   ZBRAN
   DW   12
   DW   BLK
   DW   AT
   DW   BLOCK
   DW   BRANCH
   DW   6
   DW   TIB
   DW   AT
   DW   IN
   DW   AT
   DW   PLUS
   DW   SWAP
   DW   ENCL
   DW   HERE
   DW   CLIT
   DFB   34
   DW   BLANKS
   DW   IN
   DW   PSTORE
   DW   OVER
   DW   SUB
   DW   TOR
   DW   R
   DW   HERE
   DW   CSTORE
   DW   PLUS
   DW   HERE
   DW   ONEP
   DW   RFROM
   DW   CMOVE
   DW   SEMIS

* UPPER *

L1943   DFB   $85
   ASC   'UPPE'
   DFB   $D2

   DW   L1902   ; LFA
UPPER   DW   DOCOL   ; CFA

   DW   OVER
   DW   PLUS
   DW   SWAP
   DW   PDO
   DW   I
   DW   CAT
   DW   CLIT
   DFB   95
   DW   GREAT
   DW   ZBRAN
   DW   9
   DW   I
   DW   CLIT
   DFB   32
   DW   TOGGLE
   DW   PLOOP
   DW   $FFEA
   DW   SEMIS

* (NUMBER) *

L1968   DFB   $88
   ASC   '(NUMBER'
   DFB   $A9

   DW   L1943   ; LFA
PNUMB   DW   DOCOL   ; CFA

   DW   ONEP
   DW   DUP
   DW   TOR
   DW   CAT
   DW   BASE
   DW   AT
   DW   DIGIT
   DW   ZBRAN
   DW   44
   DW   SWAP
   DW   BASE
   DW   AT
   DW   USTAR
   DW   DROP
   DW   ROT
   DW   BASE
   DW   AT
   DW   USTAR
   DW   DPLUS
   DW   DPL
   DW   AT
   DW   ONEP
   DW   ZBRAN
   DW   8
   DW   ONE
   DW   DPL
   DW   PSTORE
   DW   RFROM
   DW   BRANCH
   DW   $FFC6
   DW   RFROM
   DW   SEMIS

* NUMBER *

L2007   DFB   $86
   ASC   'NUMBE'
   DFB   $D2

   DW   L1968   ; LFA
NUMBER   DW   DOCOL   ; CFA

   DW    ZERO
   DW    ZERO
   DW   ROT
   DW   DUP
   DW   ONEP
   DW   CAT
   DW   CLIT
   DFB   45
   DW   EQUALS
   DW   DUP
   DW   TOR
   DW   PLUS
   DW   LIT
   DW   -1
   DW   DPL
   DW   STORE
   DW   PNUMB
   DW   DUP
   DW   CAT
   DW   BL
   DW   SUB
   DW   ZBRAN
   DW   21
   DW   DUP
   DW   CAT
   DW   CLIT
   DFB   46
   DW   SUB
   DW   ZERO
   DW   QERROR
   DW   ZERO
   DW   BRANCH
   DW   $FFDD
   DW   DROP
   DW   RFROM
   DW   ZBRAN
   DW   4
   DW   DMINUS
   DW   SEMIS

* -FIND *

L2052   DFB   $85
   ASC   '-FIN'
   DFB   $C4

   DW   L2007   ; LFA
DFIND   DW   DOCOL   ; CFA

   DW   BL
   DW   WORD
   DW   HERE
   DW   COUNT
   DW   UPPER
   DW   HERE
   DW   CON
   DW   AT
   DW   AT
   DW   PFIND
   DW   DUP
   DW   ZEQU
   DW   ZBRAN
   DW   $A
   DW   DROP
   DW   HERE
   DW   LATEST
   DW   PFIND
   DW   SEMIS

* (ABORT) *

L2078   DFB   $87
   ASC   '(ABORT'
   DFB   $A9

   DW   L2052    ; LFA
PABORT   DW   DOCOL   ; CFA

   DW   ABORT
   DW   SEMIS

* ERROR *

L2087   DFB   $85
   ASC   'ERRO'
   DFB   $D2

   DW   L2078   ; LFA
ERROR   DW   DOCOL   ; CFA

   DW   WARN
   DW   AT
   DW   ZLESS
   DW   ZBRAN
   DW   4
   DW   PABORT
   DW   HERE
   DW   COUNT
   DW   TYPE
   DW   PDOTQ
   DFB   4
   ASC   '  ? '
   DW   MESS
   DW   SPSTO
   DW   DROP
   DW   DROP   ; make room 
   DW   IN   ; for 2 error   
   DW   AT   ; values
   DW   BLK
   DW   AT
   DW   QUIT
   DW   SEMIS

* ID. *

L2113   DFB   $83
   ASC   'ID'
   DFB   $AE

   DW   L2087   ; LFA
IDDOT   DW   DOCOL   ; CFA

   DW   PAD
   DW   CLIT
   DFB   32
   DW   CLIT
   DFB   95
   DW   FILL
   DW   DUP
   DW   PFA
   DW   LFA
   DW   OVER
   DW   SUB
   DW   PAD
   DW   SWAP
   DW   CMOVE
   DW   PAD
   DW   COUNT
   DW   CLIT
   DFB   31
   DW   ANDD
   DW   TYPE
   DW   SPACE
   DW   SEMIS

* CREATE *

L2142   DFB   $86
   ASC   'CREAT'
   DFB   $C5

   DW   L2113   ; LFA
CREATE   DW   DOCOL   ; CFA

   DW   FIRST   ; ensure
   DW   HERE   ; room
   DW   CLIT   ; exists
   DFB   $A0   ; in
   DW   PLUS   ; diction'y
   DW   ULESS
   DW   TWO
   DW   QERROR
   DW   DFIND
   DW   ZBRAN
   DW   $F
   DW   DROP
   DW   NFA
   DW   IDDOT
   DW   CLIT
   DFB   4
   DW   MESS
   DW   SPACE
   DW   HERE
   DW   DUP   
   DW   CAT
   DW   WIDTH
   DW   AT
   DW   MIN
   DW   ONEP
   DW   ALLOT
   DW   DP   ; code
   DW   CAT   ; field
   DW   CLIT   ; mustn't
   DFB   $FD   ; cross
   DW   EQUALS   ; page
   DW   ALLOT   ; boundary
   DW   DUP
   DW   CLIT
   DFB   $A0
   DW   TOGGLE
   DW   HERE
   DW   ONE
   DW   SUB
   DW   CLIT
   DFB   $80
   DW   TOGGLE
   DW   LATEST
   DW   COMMA
   DW   CURR
   DW   AT
   DW   STORE
   DW   HERE
   DW   TWOP
   DW   COMMA
   DW   SEMIS

* ~[COMPILE] *

L2200   DFB   $C9
   ASC   '~[COMPILE'
   DFB   $DD

   DW   L2142   ; LFA
   DW   DOCOL   ; CFA

   DW   DFIND
   DW   ZEQU
   DW   ZERO
   DW   QERROR
   DW   DROP
   DW   CFA
   DW   COMMA
   DW   SEMIS

* LITERAL *

L2217   DFB   $C7
   ASC   'LITERA'
   DFB   $CC

   DW   L2200   ; LFA
LITER   DW   DOCOL   ; CFA

   DW   STATE
   DW   AT
   DW   ZBRAN
   DW   8
   DW   COMP
   DW   LIT
   DW   COMMA
   DW   SEMIS

* DLITERAL *

L2232   DFB   $C8
   ASC   'DLITERA'
   DFB   $CC

   DW   L2217   ; LFA
DLIT   DW   DOCOL   ; CFA

   DW   STATE
   DW   AT
   DW   ZBRAN
   DW   8
   DW   SWAP
   DW   LITER
   DW   LITER
   DW   SEMIS

* ?STACK *

L2248   DFB   $86
   ASC   '?STAC'
   DFB   $CB

   DW   L2232   ; LFA
QSTACK   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   TOS
   DW   SPAT
   DW   ULESS
   DW   ONE
   DW   QERROR
   DW   SPAT
   DW   CLIT
   DFB   BOS
   DW   ULESS
   DW   CLIT
   DFB   7
   DW   QERROR
   DW   SEMIS

* INTERPRET *

L2269   DFB   $89
   ASC   'INTERPRE'
   DFB   $D4

   DW   L2248   ; LFA
INTER   DW   DOCOL   ; CFA

   DW   DFIND
   DW   ZBRAN
   DW   30
   DW   STATE
   DW   AT
   DW   LESS
   DW   ZBRAN
   DW   $A
   DW   CFA
   DW   COMMA
   DW   BRANCH
   DW   6
   DW   CFA
   DW   EXEC
   DW   QSTACK
   DW   BRANCH
   DW   28
   DW   HERE
   DW   NUMBER
   DW   DPL
   DW   AT
   DW   ONEP
   DW   ZBRAN
   DW   8
   DW   DLIT
   DW   BRANCH
   DW   6
   DW   DROP
   DW   LITER
   DW   QSTACK
   DW   BRANCH
   DW   $FFC2

* IMMEDIATE *

L2309   DFB   $89
   ASC   'IMMEDIAT'
   DFB   $C5

   DW   L2269   ; LFA
   DW   DOCOL   ; CFA

   DW   LATEST
   DW   CLIT
   DFB   64
   DW   TOGGLE
   DW   SEMIS

* VOCABULARY *

L2321   DFB   $8A
   ASC   'VOCABULAR'
   DFB   $D9

   DW   L2309   ; LFA
   DW   DOCOL   ; CFA

   DW   BUILD
   DW   LIT
   DW   $A081
   DW   COMMA
   DW   CURR
   DW   AT   
   DW   CFA
   DW   COMMA
   DW   HERE
   DW   VOCLNK
   DW   AT
   DW   COMMA
   DW   VOCLNK
   DW   STORE
   DW   DOES
DOVOC   DW   TWOP
   DW   CON
   DW   STORE
   DW   SEMIS

* FORTH *

L2346   DFB   $85
   ASC   'FORT'   
   DFB   $C8

   DW   L2321   ; LFA
FORTH   DW   DODOE   ; CFA

   DW   DOVOC
   DW   $A081
XFOR   DW   NTOP
VLO   DW   0

* DEFINITIONS *

L2357   DFB   $8B
   ASC   'DEFINITION'
   DFB   $D3

   DW   L2346   ; LFA
DEFIN   DW   DOCOL   ; CFA

   DW   CON
   DW   AT
   DW   CURR
   DW   STORE
   DW   SEMIS

* ( *

L2369   DFB   $C1,$A8

   DW   L2357   ; LFA
   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   41
   DW   WORD
   DW   SEMIS

* QUIT *

L2381   DFB   $84
   ASC   'QUI'
   DFB   $D4

   DW   L2369   ; LFA
QUIT   DW   DOCOL   ; CFA

   DW   ZERO
   DW   BLK
   DW   STORE
   DW   LBRACK
   DW   RPSTO
   DW   CR
   DW   QUERY
   DW   INTER
   DW   STATE
   DW   AT
   DW   ZEQU
   DW   ZBRAN
   DW   9
   DW   PDOTQ
   DFB   4
   ASC   ' ok '
   DW   BRANCH
   DW   -25
   DW   SEMIS

* ABORT *

L2406   DFB   $85
   ASC   'ABOR'
   DFB   $D4

   DW   L2381   ; LFA
ABORT   DW   DOCOL   ; CFA

   DW   SPSTO
   DW   DECIM
   DW   CR
   DW   PDOTQ
   DFB   14
   ASC   'FIG-Forth V1.0'
   DW   CR
   DW   FORTH
   DW   DEFIN
   DW   QUIT

* COLD *

L2423   DFB   $84
   ASC   'COL'
   DFB   $C4

   DW   L2406   ; LFA
COLD   DW   *+2   ; CFA

   LDA   ORIG+15   ; from cold start area
   STA   FORTH+6
   LDA   ORIG+16
   STA   FORTH+7
   LDY   #21
   BNE   L2433
WARM   LDY   #15   
L2433   LDA   ORIG+19
   STA   UP
   LDA   ORIG+20
   STA   UP+1
L2437   LDA   ORIG+15,Y
   STA   (UP),Y
   DEY
   BPL   L2437
   LDA   #<ABORT
   STA   IP+1
   LDA   #>ABORT+2
   STA   IP
   CLD
   LDA   #$6C
   STA   W-1
   JMP   RPSTO+2

* S->D *

L2453   DFB   $84
   ASC   'S->'
   DFB   $C4

   DW   L2423   ; LFA
STOD   DW   DOCOL   ; CFA

   DW   DUP
   DW   ZLESS
   DW   MINUS
   DW   SEMIS

* +- *

L2464   DFB   $82
   ASC   '+'
   DFB   $AD

   DW   L2453   ; LFA
PM   DW   DOCOL

   DW   ZLESS
   DW   ZBRAN
   DW   4
   DW   MINUS
   DW   SEMIS

* D+- *

L2476   DFB   $83
   ASC   'D+'
   DFB   $AD

   DW   L2464   ; LFA
DPM   DW   DOCOL   ; CFA

   DW   ZLESS
   DW   ZBRAN
   DW   4
   DW   DMINUS
   DW   SEMIS

* ABS *

L2488   DFB   $83
   ASC   'AB'
   DFB   $D3

   DW   L2476   ; LFA
ABS   DW   DOCOL   ; CFA

   DW   DUP
   DW   PM
   DW   SEMIS

* DABS *

L2498   DFB   $84
   ASC   'DAB'
   DFB   $D3

   DW   L2488   ; LFA
DABS   DW   DOCOL   ; CFA

   DW   DUP
   DW   DPM
   DW   SEMIS

* MIN *

L2508   DFB   $83
   ASC   'MI'
   DFB   $CE

   DW   L2498   ; LFA
MIN   DW   DOCOL   ; CFA

   DW   OVER
   DW   OVER
   DW   GREAT
   DW   ZBRAN
   DW   4
   DW   SWAP
   DW   DROP
   DW   SEMIS

* MAX *

L2523   DFB   $83
   ASC   'MA'
   DFB   $D8

   DW   L2508   ; LFA
MAX   DW   DOCOL   ; CFA

   DW   OVER
   DW   OVER
   DW   LESS
   DW   ZBRAN
   DW   4
   DW   SWAP
   DW   DROP
   DW   SEMIS

* M* *

L2538   DFB   $82
   ASC   'M'
   DFB   $AA

   DW   L2523   ; LFA
MSTAR   DW   DOCOL   ; CFA

   DW   OVER
   DW   OVER
   DW   XOR
   DW   TOR
   DW   ABS
   DW   SWAP
   DW   ABS
   DW   USTAR
   DW   RFROM
   DW   DPM
   DW   SEMIS

* M/ *

L2556   DFB   $82
   ASC   'M'
   DFB   $AF

   DW   L2538   ; LFA
MSLASH   DW   DOCOL   ; CFA

   DW   OVER
   DW   TOR
   DW   TOR
   DW   DABS
   DW   R
   DW   ABS
   DW   USLASH
   DW   RFROM
   DW   R
   DW   XOR
   DW   PM
   DW   SWAP
   DW   RFROM
   DW   PM
   DW   SWAP
   DW   SEMIS

* * *

L2579   DFB   $81,$AA

   DW   L2556   ; LFA
STAR   DW   DOCOL   ; CFA

   DW   USTAR
   DW   DROP
   DW   SEMIS

* /MOD *

L2589   DFB   $84
   ASC   '/MO'
   DFB   $C4

   DW   L2579   ; LFA
SLMOD   DW   DOCOL   ; CFA

   DW   TOR
   DW   STOD
   DW   RFROM
   DW   MSLASH
   DW   SEMIS

* / *

L2601   DFB   $81,$AF

   DW   L2589   ; LFA
SLASH   DW   DOCOL   ; CFA

   DW   SLMOD
   DW   SWAP
   DW   DROP
   DW   SEMIS

* MOD *

L2612   DFB   $83
   ASC   'MO'
   DFB   $C4

   DW   L2601   ; LFA
MOD   DW   DOCOL   ; CFA

   DW   SLMOD
   DW   DROP
   DW   SEMIS

* */MOD *

L2622   DFB   $85
   ASC   '*/MO'
   DFB   $C4

   DW   L2612   ; LFA
SSMOD   DW   DOCOL   ; CFA

   DW   TOR
   DW   MSTAR
   DW   RFROM
   DW   MSLASH
   DW   SEMIS

* */ *

L2634   DFB   $82
   ASC   '*'
   DFB   $AF

   DW   L2622   ; LFA
SSLASH   DW   DOCOL   ; CFA

   DW   SSMOD
   DW   SWAP
   DW   DROP
   DW   SEMIS

* M/MOD *

L2645   DFB   $85
   ASC   'M/MO'
   DFB   $C4

   DW   L2634   ; LFA
MSMOD   DW    DOCOL   ; CFA

   DW   TOR
   DW   ZERO
   DW   R
   DW   USLASH
   DW   RFROM
   DW   SWAP
   DW   TOR
   DW   USLASH
   DW   RFROM
   DW   SEMIS

* USE *

L2662   DFB   $83
   ASC   'US'
   DFB   $C5

   DW   L2645   ; LFA
USE   DW   DOVAR   ; CFA

   DW   DAREA

* PREV *

L2670   DFB   $84
   ASC   'PRE'
   DFB   $D6

   DW   L2662   ; LFA
PREV   DW   DOVAR

   DW   DAREA

* +BUF *

L2678   DFB   $84
   ASC   '+BU'
   DFB   $C6

   DW   L2670   ; LFA
PBUF   DW   DOCOL   ; CFA

   DW   LIT
   DW   SSIZE+4
   DW   PLUS
   DW   DUP
   DW   LIMIT
   DW   EQUALS
   DW   ZBRAN
   DW   6
   DW   DROP
   DW   FIRST
   DW   DUP
   DW   PREV
   DW   AT
   DW   SUB
   DW   SEMIS

* UPDATE *

L2700   DFB   $86
   ASC   'UPDAT'
   DFB   $C5

   DW   L2678   ; LFA
UPDATE   DW   DOCOL   ; CFA

   DW   PREV
   DW   AT
   DW   AT
   DW   LIT
   DW   $8000
   DW   OR
   DW   PREV
   DW   AT
   DW   STORE
   DW   SEMIS

* FLUSH *

L2705   DFB   $85
   ASC   'FLUS'
   DFB   $C8

   DW   L2700   ; LFA
   DW   DOCOL   ; CFA

   DW   LIMIT
   DW   FIRST
   DW   SUB
   DW   BBUF
   DW   CLIT
   DFB   4
   DW   PLUS
   DW   SLASH
   DW   ONEP
   DW   ZERO
   DW   PDO
   DW   LIT
   DW   $7FFF
   DW   BUFFER
   DW   DROP
   DW   PLOOP
   DW   -10
   DW   SEMIS

* EMPTY-BUFFERS *

L2716   DFB   $8D
   ASC   'EMPTY-BUFFER'
   DFB   $D3

   DW   L2705   ; LFA
   DW   DOCOL   ; CFA

   DW   FIRST
   DW   LIMIT
   DW   OVER
   DW   SUB
   DW   ERASE
   DW   SEMIS

* BUFFER *

L2751   DFB   $86
   ASC   'BUFFE'
   DFB   $D2

   DW   L2716   ; LFA
BUFFER   DW   DOCOL   ; CFA

   DW   USE
   DW   AT
   DW   DUP
   DW   TOR
   DW   PBUF
   DW   ZBRAN
   DW   -4
   DW   USE
   DW   STORE
   DW   R
   DW   AT
   DW   ZLESS
   DW   ZBRAN
   DW   20
   DW   R
   DW   TWOP
   DW   R
   DW   AT
   DW   LIT
   DW   $7FFF
   DW   ANDD
   DW   ZERO
   DW   R
   DW   STORE
   DW   R
   DW   PREV
   DW   STORE
   DW   RFROM
   DW   TWOP
   DW   SEMIS

* BLOCK *

L2788   DFB   $85
   ASC   'BLOC'
   DFB   $CB

   DW   L2751   ; LFA
BLOCK   DW   DOCOL   ; CFA

   DW   OFFSET
   DW   AT
   DW   PLUS
   DW   TOR
   DW   PREV
   DW   AT
   DW   DUP
   DW   AT
   DW   R
   DW   SUB
   DW   DUP
   DW   PLUS
   DW   ZBRAN
   DW   52
   DW   PBUF
   DW   ZEQU
   DW   ZBRAN
   DW   20
   DW   DROP
   DW   R
   DW   BUFFER
   DW   DUP
   DW   R
   DW   ONE
   DW   TWO
   DW   SUB
   DW   DUP
   DW   AT
   DW   R
   DW   SUB
   DW   DUP
   DW   PLUS
   DW   ZEQU
   DW   ZBRAN
   DW   $FFD6
   DW   DUP
   DW   PREV
   DW   STORE
   DW   RFROM
   DW   DROP
   DW   TWOP
   DW   SEMIS

* (LINE) *

L2838   DFB   $86
   ASC   '(LINE'
   DFB   $A9

   DW   L2788   ; LFA
PLINE   DW   DOCOL

   DW   TOR
   DW   CSLL
   DW   BBUF
   DW   SSMOD
   DW   RFROM
   DW   BSCR
   DW   STAR
   DW   PLUS
   DW   BLOCK
   DW   PLUS
   DW   CSLL
   DW   SEMIS

* .LINE *

L2857   DFB   $85
   ASC   '.LIN'
   DFB   $C5

   DW   L2838   ; LFA
DLINE   DW   DOCOL   ; CFA

   DW   PLINE
   DW   DTRAI
   DW   TYPE
   DW   SEMIS

* MESSAGE *

L2868   DFB   $87
   ASC   'MESSAG'
   DFB   $C5

   DW   L2857   ; LFA
MESS   DW   DOCOL   ; CFA

   DW   WARN
   DW   AT
   DW   ZBRAN
   DW   27
   DW   DDUP
   DW   ZBRAN
   DW   17
   DW   CLIT
   DFB   4
   DW   OFFSET
   DW   AT
   DW   BSCR
   DW   SLASH
   DW   SUB
   DW   DLINE
   DW   BRANCH
   DW   13
   DW   PDOTQ
   DFB   6
   ASC   'MSG # '
   DW   DOT
   DW   SEMIS

* LOAD *

L2896   DFB   $84
   ASC   'LOA'
   DFB   $C4

   DW   L2868   ; LFA
LOAD   DW   DOCOL   ; CFA

   DW   BLK
   DW   AT
   DW   TOR
   DW   IN
   DW   AT
   DW   TOR
   DW   ZERO
   DW   IN
   DW   STORE
   DW   BSCR
   DW   STAR
   DW   BLK
   DW   STORE
   DW   INTER
   DW   RFROM
   DW   IN
   DW   STORE
   DW   RFROM
   DW   BLK
   DW   STORE
   DW   SEMIS

* --> *

L2924   DFB   $C3
   ASC   '--'
   DFB   $BE

   DW   L2896   ; LFA
   DW   DOCOL   ; CFA

   DW   QLOAD
   DW   ZERO
   DW   IN
   DW   STORE
   DW   BSCR
   DW   BLK
   DW   AT
   DW   OVER
   DW   MOD
   DW   SUB
   DW   BLK
   DW   PSTORE
   DW   SEMIS

XEMIT   TYA      ; writes 1 
   SEC      ; ASCII
   LDY   #$1A   ; char to
   ADC   (UP),Y   ; terminal
   STA   (UP),Y
   INY      ; bump OUT
   LDA   #0
   ADC   (UP),Y
   STA   (UP),Y
   LDA   0,X   ; fetch char
   AND   #&7F
   STX   XSAVE
   JSR   OSWRCH   ; display it
   LDX   XSAVE
   JMP   POP

* >VDU *

L3000   DFB   $84
   ASC   '>VD'
   DFB   $D5

   DW   L2924
   DW   *+2

   LDA   0,X
   JSR   OSWRCH
   JMP   POP


XKEY   STX   XSAVE   ; reads one keystroke
   JSR   OSRDCH
   BIT   $FF   ; MJR
   BPL   NOESC   ; MJR
   LDA   $7E   ; MJR
   JSR   OSBYTE   ; MJR
       LDA   $FF   ; MJR
   AND   #127   ; MJR
   STA   $FF   ; MJR
   JMP   REENTR   ; MJR

NOESC   LDX   XSAVE
   JMP   PUSH0A


XQTER   LDA   #0
   JMP   PUSH0A   ; dummied

*
* leave boolean representing terminal break *
*
* system dependent test *
*


XCR   STX   XSAVE   ; CRLF to terminal
   JSR   OSNEWL   ; monitor call
   LDX   XSAVE
   JMP   NEXT

* -BCD *

L3050   DFB   $84
   ASC   '-BC'
   DFB   $C4

   DW   L3000   ; LFA
DBCD   DW   DOCOL   ; CFA

   DW   ZERO
   DW   CLIT
   DFB   10
   DW   USLASH
   DW   CLIT
   DFB   16
   DW   STAR
   DW   OR
   DW   SEMIS


* ' (TICK) *

L3202   DFB   $C1,$A7

   DW   L3050   ; LFA
TICK   DW   DOCOL   ; CFA

   DW   DFIND
   DW   ZEQU
   DW   ZERO
   DW   QERROR
   DW   DROP
   DW   LITER
   DW   SEMIS

* FORGET *

L3217   DFB   $86
   ASC   'FORGE'
   DFB   $D4

   DW   L3202   ; LFA
FORGET   DW   DOCOL   ; CFA

   DW   TICK
   DW   NFA
   DW   DUP
   DW   FENCE
   DW   AT
   DW   ULESS
   DW   CLIT
   DFB   $15
   DW   QERROR
   DW   TOR
   DW   VOCLNK
   DW   AT
   DW   R
   DW   OVER
   DW   ULESS
   DW   ZBRAN
   DW   L3225-*
   DW   FORTH
   DW   DEFIN
   DW   AT
   DW   DUP
   DW   VOCLNK
   DW   STORE
   DW   BRANCH
   DW   -24
L3225   DW   DUP
   DW   CLIT
   DFB   4
   DW   SUB
   DW   PFA
   DW   LFA
   DW   AT
   DW   DUP
   DW   R
   DW   ULESS
   DW   ZBRAN
   DW   -14
   DW   OVER
   DW   TWO
   DW   SUB
   DW   STORE
   DW   AT
   DW   DDUP
   DW   ZEQU
   DW   ZBRAN
   DW   -39
   DW   RFROM
   DW   DP
   DW   STORE
   DW   SEMIS

* BACK *

L3250   DFB   $84
   ASC   'BAC'
   DFB   $CB

   DW   L3217   ; LFA
BACK   DW   DOCOL   ; CFA

   DW   HERE
   DW   SUB
   DW   COMMA
   DW   SEMIS

* BEGIN *

L3261   DFB   $C5
   ASC   'BEGI'
   DFB   $CE

   DW   L3250   ; LFA
   DW   DOCOL   ; CFA

   DW   QCOMP
   DW   HERE
   DW   ONE
   DW   SEMIS

* ENDIF *

L3273   DFB   $C5
   ASC   'ENDI'
   DFB   $C6

   DW   L3261   ; LFA
ENDIF   DW   DOCOL   ; CFA

   DW   QCOMP
   DW   TWO
   DW   QPAIR
   DW   HERE
   DW   OVER
   DW   SUB
   DW   SWAP
   DW   STORE
   DW   SEMIS

* THEN *      ; (= ENDIF)

L3290   DFB   $C4
   ASC   'THE'
   DFB   $CE

   DW   L3273   ; LFA
   DW   DOCOL   ; CFA

   DW   ENDIF
   DW   SEMIS

* DO *

L3300   DFB   $C2
   ASC   'D'
   DFB   $CF

   DW   L3290   ; LFA
   DW   DOCOL   ; CFA

   DW   COMP
   DW   PDO
   DW   HERE
   DW   THREE
   DW   SEMIS

* LOOP *

L3313   DFB   $C4
   ASC   'LOO'
   DFB   $D0

   DW   L3300   ; LFA
   DW   DOCOL   ; CFA

   DW   THREE
   DW   QPAIR
   DW   COMP
   DW   PLOOP
   DW   BACK
   DW   SEMIS

* +LOOP *

L3327   DFB   $C5
   ASC   '+LOO'
   DFB   $D0

   DW   L3313   ; LFA
   DW   DOCOL   ; CFA

   DW   THREE
   DW   QPAIR
   DW   COMP
   DW   PPLOO
   DW   BACK
   DW   SEMIS

* UNTIL *

L3341   DFB   $C5
   ASC   'UNTI'
   DFB   $CC

   DW   L3327   ; LFA
UNTIL   DW   DOCOL   ; CFA

   DW   ONE
   DW   QPAIR
   DW   COMP
   DW   ZBRAN
   DW   BACK
   DW   SEMIS

* END *      ; (=UNTIL)

L3355   DFB   $C3
   ASC   'EN'
   DFB   $C4

   DW   L3341   ; LFA
   DW   DOCOL   ; CFA

   DW   UNTIL
   DW   SEMIS

* AGAIN *

L3365   DFB   $C5
   ASC   'AGAI'
   DFB   $CE

   DW   L3355   ; LFA
AGAIN   DW   DOCOL   ; CFA

   DW   ONE
   DW   QPAIR
   DW   COMP
   DW   BRANCH
   DW   BACK
   DW   SEMIS

* REPEAT *

L3379   DFB   $C6
   ASC   'REPEA'
   DFB   $D4

   DW   L3365   ; LFA
   DW   DOCOL   ; CFA

   DW   TOR
   DW   TOR
   DW   AGAIN
   DW   RFROM
   DW   RFROM
   DW   TWO
   DW   SUB
   DW   ENDIF
   DW   SEMIS

* IF *

L3396   DFB   $C2
   ASC   'I'
   DFB   $C6

   DW   L3379   ; LFA
IF   DW   DOCOL   ; CFA

   DW   COMP
   DW   ZBRAN
   DW   HERE
   DW   ZERO
   DW   COMMA
   DW   TWO
   DW   SEMIS

* ELSE *

L3411   DFB   $C4
   ASC   'ELS'
   DFB   $C5

   DW   L3396   ; LFA
   DW   DOCOL   ; CFA

   DW   TWO
   DW   QPAIR
   DW   COMP
   DW   BRANCH
   DW   HERE
   DW   ZERO
   DW   COMMA
   DW   SWAP
   DW   TWO
   DW   ENDIF
   DW   TWO
   DW   SEMIS

* WHILE *

L3431   DFB   $C5
   ASC   'WHIL'
   DFB   $C5

   DW   L3411   ; LFA
   DW   DOCOL   ; CFA
   DW   IF
   DW   TWOP
   DW   SEMIS

* SPACES *

L3442   DFB   $86
   ASC   'SPACE'
   DFB   $D3

   DW   L3431   ; LFA
SPACES   DW   DOCOL   ; CFA

   DW   ZERO
   DW   MAX
   DW   DDUP
   DW   ZBRAN
   DW   12
   DW   ZERO
   DW   PDO
   DW   SPACE   
   DW   PLOOP
   DW   -4
   DW   SEMIS

* <# *

L3460   DFB   $82
   ASC   '<'
   DFB   $A3

   DW   L3442   ; LFA
BDIGS   DW   DOCOL   ; CFA

   DW   PAD
   DW   HLD
   DW   STORE
   DW   SEMIS

* #> *

L3471   DFB   $82
   ASC   '#'
   DFB   $BE

   DW   L3460   ; LFA
EDIGS   DW   DOCOL   ; CFA

   DW   DROP
   DW   DROP
   DW   HLD
   DW   AT
   DW   PAD
   DW   OVER
   DW   SUB
   DW   SEMIS

* SIGN *

L3486   DFB   $84
   ASC   'SIG'
   DFB   $CE

   DW   L3471   ; LFA
SIGN   DW   DOCOL   ; CFA

   DW   ROT
   DW   ZLESS
   DW   ZBRAN
   DW   7
   DW   CLIT
   DFB   45
   DW   HOLD
   DW   SEMIS

* # *

L3501   DFB   $81,$A3

   DW   L3486   ; LFA
DIG   DW   DOCOL   ; CFA

   DW   BASE
   DW   AT
   DW   MSMOD
   DW   ROT
   DW   CLIT
   DFB   9
   DW   OVER
   DW   LESS
   DW   ZBRAN
   DW   7
   DW   CLIT
   DFB   7
   DW   PLUS
   DW   CLIT
   DFB   48
   DW   PLUS
   DW   HOLD
   DW   SEMIS

* #S *

L3526   DFB   $82
   ASC   '#'
   DFB   $D3

   DW   L3501   ; LFA
DIGS   DW   DOCOL   ; CFA

   DW   DIG
   DW   OVER
   DW   OVER
   DW   OR
   DW   ZEQU
   DW   ZBRAN
   DW   -12
   DW   SEMIS
   DW   SEMIS
   
* D.R *

L3541   DFB   $83
   ASC   'D.'
   DFB   $D2

   DW   L3526   ; LFA
DDOTR   DW   DOCOL   ; CFA

   DW   TOR
   DW   SWAP
   DW   OVER
   DW   DABS
   DW   BDIGS
   DW   DIGS
   DW   SIGN
   DW   EDIGS
   DW   RFROM
   DW   OVER
   DW   SUB
   DW   SPACES
   DW   TYPE
   DW   SEMIS

* D. *

L3562   DFB   $82
   ASC   'D'
   DFB   $AE

   DW   L3541   ; LFA
DDOT   DW   DOCOL   ; CFA

   DW   ZERO
   DW   DDOTR
   DW   SPACE
   DW   SEMIS

* .R *

L3567   DFB   $82
   ASC   '.'
   DFB   $D2

   DW   L3562   ; LFA
DOTR   DW   DOCOL   ; CFA

   DW   TOR
   DW   STOD
   DW   RFROM
   DW   DDOTR
   DW   SEMIS

* . *

L3585   DFB   $81,$AE

   DW   L3567   ; LFA
DOT   DW   DOCOL   ; CFA

   DW   STOD
   DW   DDOT
   DW   SEMIS

* ? *

L3595   DFB   $81,$BF

   DW   L3585   ; LFA
QUES   DW   DOCOL   ; CFA

   DW   AT
   DW   DOT
   DW   SEMIS

* LIST *

L3605   DFB   $84
   ASC   'LIS'
   DFB   $D4

   DW   L3595   ; LFA
LIST   DW   DOCOL   ; CFA

   DW   DECIM
   DW   CR
   DW   DUP
   DW   SCR
   DW   STORE
   DW   PDOTQ
   DFB   6
   ASC   'SCR # '
   DW   DOT
   DW   CLIT
   DFB   16
   DW   ZERO
   DW   PDO
   DW   CR
   DW   I
   DW   THREE
   DW   DOTR
   DW   SPACE
   DW   I
   DW   SCR
   DW   AT
   DW   DLINE
   DW   PLOOP
   DW   -20
   DW   CR
   DW   SEMIS

* INDEX *

L3637   DFB   $85
   ASC   'INDE'
   DFB   $D8

   DW   L3605   ; LFA
   DW   DOCOL   ; CFA

   DW   CR
   DW   ONEP
   DW   SWAP
   DW   PDO
   DW   CR
   DW   I
   DW   THREE
   DW   DOTR
   DW   SPACE
   DW   ZERO
   DW   I
   DW   DLINE
   DW   QTERM
   DW   ZBRAN
   DW   4
   DW   LEAVE
   DW   PLOOP
   DW   -26
   DW   CLIT
   DFB   12   ; FF for printer
   DW   EMIT
   DW   SEMIS

* TRIAD *

L3666   DFB   $85
   ASC   'TRIA'
   DFB   $C4

   DW   L3637   ; LFA
   DW   DOCOL   ; CFA

   DW   THREE
   DW   SLASH
   DW   THREE
   DW   STAR
   DW   THREE
   DW   OVER
   DW   PLUS
   DW   SWAP
   DW   PDO
   DW   CR
   DW   I
   DW   LIST
   DW   PLOOP
   DW   -8
   DW   CR
   DW   CLIT
   DFB   15
   DW   MESS
   DW   CR
   DW   CLIT
   DFB   12   ; FF for printer
   DW   EMIT
   DW   SEMIS

* VLIST *

L3696   DFB   $85
   ASC   'VLIS'
   DFB   $D4

   DW   L3666   ; LFA
VLIST   DW   DOCOL   ; CFA

   DW   CLIT
   DFB   $80
   DW   OUT
   DW   STORE
   DW   CON
   DW   AT
   DW   AT
   DW   OUT
   DW   AT
   DW   CSLL
   DW   GREAT
   DW   ZBRAN
   DW   10
   DW   CR
   DW   ZERO
   DW   OUT
   DW   STORE
   DW   DUP
   DW   IDDOT
   DW   SPACE
   DW   SPACE
   DW   PFA
   DW   LFA
   DW   AT
   DW   DUP
   DW   ZEQU
   DW   QTERM
   DW   OR
   DW   ZBRAN
   DW   $FFD4
   DW   DROP
   DW   SEMIS

* MON *

L4000   DFB   $83
   ASC   'MO'
   DFB   $CE

   DW   L3696   ; LFA
MON   DW   *+2   ; CFA

   STX   XSAVE
   BRK      ; break out
   LDX   XSAVE   ; to monitor
   JMP   NEXT   ; and reenter


NTOP   DFB   $84
   ASC   'NOO'
   DFB   $D0

   DW   L4000   ; LFA
NOOP   DW   DOCOL   ; CFA

   DW   SEMIS   ; NULL DEF'N

TOP         ; of dictionary   LST ON 

   LST   OFF