home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / compile.s < prev    next >
Encoding:
Text File  |  1993-10-23  |  37.4 KB  |  1,394 lines
  1. ; COMPILE.S: compilation words 20/07/90.
  2. ; Copyright <C> John Redmond 1989, 1990.
  3. ; Public domain for non-commercial use.
  4. ;
  5.         section text
  6.         even
  7. ;
  8. ;****************************************
  9. ;*                                      *
  10. ;* general entry for compilation code:  *
  11. ;*                                      *
  12. ;****************************************
  13. ;
  14. ifval = 17
  15. bval = 18
  16. doval = 19
  17. wval = 20
  18. casval = 30
  19. colval = 999
  20. ;
  21. fstate: ds.l    1               ;compilation flag
  22. codestart: ds.l 1               ;address of current code
  23. ffa:    ds.l    1               ;address for flags & length
  24. edge:   ds.w    1               ;just expanded a macro?
  25. edges:  ds.l    2               ;active edges
  26. ;
  27. call:   lea     mcro,a1
  28.         tst.l   (a1)            ;macros allowed
  29.         beq.s   mustcall        ;force call if not
  30. call2:  bsr     flag
  31.         tst.w   d2
  32.         beq     mustcall        ;not a macro
  33.         move.l  d2,d4
  34.         swap    d4
  35.         and.w   #maxsize,d4     ;max macro length
  36.         lea     longest,a1
  37.         move.l  (a1),d3
  38.         cmp.w   d3,d4
  39.         ble     inline
  40. mustcall: lea   origin,a1
  41.         move.l  (a1),d0
  42.         cmp.l   d0,a0
  43.         bcc     .mc5
  44.         bsr     warn
  45. .mc5:   push    a0              ;code address
  46.         bsr     only_16
  47.         bcs     toofar
  48.         move.l  d1,(a6)         ;replace code address with distance
  49.         push    #$6100          ;bsr
  50.         bsr     _comma          ;opcode
  51.         bsr     only_8
  52.         bne.s   .c5             ;long call
  53.         bsr     tocode          ;in a1
  54.         pop     d0
  55.         move.b  d0,-1(a1)       ;short call
  56.         bra.s   callx
  57. .c5:    bsr     _comma          ;branch value
  58. callx:  bsr     edgeoff
  59.         bsr     clrflag
  60.         bsr     toptypoff
  61.         rts
  62. ;
  63. toofar: pop     d0
  64.         sub.l   origin(pc),d0   ;convert code address to an offset
  65.         push    d0
  66.         push    #$203c          ;move.l #32bit,d0
  67.         bsr     _comma          ;opcode
  68.         bsr     _lcomma         ;immed value
  69.         push    #$4eb50800      ;jsr 0(a5,d0.l)
  70.         bsr     _lcomma
  71.         bra     callx
  72. ;
  73. warn:   movem.l d2/d4/a0,-(a7)
  74.         lea     pocket,a0
  75.         move.l  (a0),a0
  76.         moveq.l #0,d0
  77.         move.b  (a0)+,d0
  78.         addq.l  #1,d0
  79.         push    a0
  80.         push    d0
  81.         bsr     _type
  82.         movem.l (a7)+,d2/d4/a0
  83.         rts
  84. ;
  85. ;force compilation of inline code
  86. ;
  87. nocall: bsr     tocode          ;force an expansion
  88.         bra     copycode
  89. ;
  90. expand: bsr     flag            ;update flag for current word
  91. inline: bsr     tocode
  92.         lea     edge,a2
  93.         move.w  (a2),d5         ;just compiled any pushes?
  94.         tst.w   d5              ;test for pushes
  95.         beq.s   copycode        ;if not
  96.         btst    #31,d2          ;expecting any edges?
  97.         beq     copycode        ;no try at optimisation
  98.         bsr.s   opt             ;otherwise optimise
  99. ;
  100. copycode: subq.w #1,d4          ;ready for DBRA
  101.         blt.s   .finis
  102. .nclp:  move.w  (a0)+,(a1)+
  103.         dbra    d4,.nclp
  104. .finis: suba.l  a5,a1           ;offset of dictionary space
  105.         lea     cp,a0
  106.         move.l  a1,(a0)         ;update HERE
  107.         bsr     doedge
  108.         rts
  109. ;
  110. tocode: lea     cp,a1
  111.         move.l  (a1),a1
  112.         adda.l  a5,a1           ;free code space
  113.         rts
  114. ;
  115. opt:    move.w  -(a1),d1        ;last word compiled
  116.         cmp.w   d1,d2           ;useless push?
  117.         beq.s   .optx
  118.         and.w   #$ffc0,d1
  119.         cmp.w   #$2d00,d1       ;was it a push?
  120.         bne.s   .noopt
  121.         move.w  (a0),d0         ;first word to compile
  122.         and.w   #$f03f,d0
  123.         cmp.w   #$201e,d0       ;is it a pop?
  124.         bne.s   .noopt
  125.         move.w  (a1),d0         ;old push
  126.         and.w   #$f03f,d0       ;mask out dest field
  127.         move.w  (a0),d1         ;new pop
  128.         and.w   #$0fc0,d1       ;get new dest field
  129.         or.w    d1,d0           ;merge into old push
  130.         move.w  d0,(a1)+        ;put it back
  131. .optx:  addq.l  #2,a0           ;push and pop not needed
  132.         subq.w  #1,d4           ;less words to copy
  133.         cmp.w   #99,d5
  134.         beq.s   .opty           ;previous word was a test
  135.         subq.w  #1,d5           ;decrease # edges
  136.         beq     .opty           ;all edges used up
  137.         btst    #30,d2          ;set if 2 edges expected
  138.         beq.s   .opty           ;no further optimization
  139.         bsr     ptchpush        ;patch the lower edge
  140.         moveq   #0,d5           ;no more valid edges
  141.         addq.l  #2,a0           ;yet one less word to compile
  142.         subq.w  #1,d4
  143.         rts
  144. .noopt: addq.l  #2,a1
  145. .opty:  rts
  146. ;
  147. ;update macro flag for word being compiled:
  148. ;
  149. flag:   lea     fstate,a4
  150.         tst.w   d2              ;latest flag
  151.         beq.s   .fl5            ;force change if zero
  152.         move.w  2(a4),d3        ;current flag state
  153.         beq.s   .no
  154.         cmp.w   #-2,d3          ;flag not yet altered?
  155.         bne.s   .no             ;quit if already altered
  156. .fl5:   move.l  d2,d0           ;save macro specs
  157.         and.l   #$c000ffff,d2   ;isolate the edges expected
  158.         move.l  d2,(a4)         ;flag state of first word in definition
  159.         move.l  d0,d2           ;restore macro specs
  160. .no:    tst.w   d2
  161.         rts                     ;return flags for d2
  162. ;
  163. kpflag: move.l  #$ffff,d2       ;fake true macro flag
  164.         bsr.s   flag
  165.         rts
  166. ;
  167. clrflag: lea    fstate,a0
  168.         clr.l   (a0)
  169.         rts
  170. ;
  171. ;check whether address is within 32k (16 bits signed relative):
  172. ;
  173. only_16: bsr    _here
  174.         pop     d0              ;free dictionary space
  175.         addq.l  #2,d0
  176.         move.l  (a6),d1         ;copy code address
  177.         sub.l   d0,d1           ;how far?
  178.         cmp.l   #-32768,d1
  179.         rts
  180. ;
  181. ;check whether displacement on stack is within 8 bits signed relative:
  182. ;
  183. only_8: move.l  (a6),d1         ;copy displacement
  184.         ext.w   d1
  185.         cmp.w   2(a6),d1
  186.         rts
  187. ;
  188. ; manipulate the edge flag to indicate how many valid edges:
  189. ;
  190. doedge: bsr     toptypoff
  191.         btst    #29,d2          ;returning an edge?
  192.         beq     edgeoff
  193.         btst    #28,d2          ;just done a DUP or SWAP?
  194.         bne     twoon
  195.         btst    #27,d2          ;just done a test?
  196.         bne     doedge3
  197.         btst    #26,d2
  198.         bne     plusedge        ;just done SP@ or RP@?
  199.         beq     oneon           ;force just one new edge
  200. doedge3: move.w #99,d5          ;99 is the test flag
  201. doedge4: lea    edge,a0
  202.         move.w  d5,(a0)         ;update the edge
  203.         lea     edges,a0
  204.         move.l  4(a0),(a0)      ;shuffle left
  205.         bsr     tocode          ;address in a1
  206.         suba.l  #2,a1           ;^ latest push
  207.         move.l  a1,4(a0)
  208.         rts
  209. ;
  210. oneon:  moveq   #1,d5           ;force one edge
  211.         bra     doedge4
  212. ;
  213. twoon:  lea     edges,a0        ;force two edges
  214.         bsr     tocode          ;address in a1
  215.         suba.l  #2,a1           ;^ latest push
  216.         move.l  a1,4(a0)
  217.         suba.l  #2,a1
  218.         move.l  a1,(a0)         ;^ previous push
  219.         lea     edge,a0
  220.         move.w  #2,(a0)         ;update the edge
  221.         bsr     toptypoff
  222.         rts
  223. ;
  224. edgeoff: lea    edge,a0
  225.         clr.w   (a0)            ;no valid edge
  226.         bsr     toptypoff
  227.         rts
  228. ;
  229. plusedge: lea   edge,a0
  230.         move.w  (a0),d5
  231.         addq.w  #1,d5
  232.         bra     doedge4
  233. ;
  234. toptypoff: lea  toptyp,a0
  235.         clr.w   (a0)
  236.         rts
  237. ;
  238. ;patch push in second edge to move to register d1:
  239. ;
  240. ptchpush: lea   edges,a3
  241.         move.l  (a3),a3         ;^ previous push
  242.         move.w  (a3),d0
  243.         and.w   #$f03f,d0
  244.         or.w    #$0200,d0       ;'move to d1'
  245.         move.w  d0,(a3)         ;patch code back
  246.         rts
  247. ;
  248. ;system compilation utilities
  249. ;
  250. comphead: bsr   _ifcomp
  251.         bsr     _head           ;get cfa
  252.         pop     a0
  253.         rts
  254. ;
  255. setstart: lea   cp,a0
  256.         move.l  (a0),d0
  257.         add.l   a5,d0
  258.         lea     codestart,a0
  259.         move.l  d0,(a0)
  260.         rts
  261. ;
  262. setffa: push    a0              ;ffa is in d0
  263.         lea     ffa,a0
  264.         move.l  d0,(a0) 
  265.         pop     a0
  266.         rts
  267. ;
  268. virgin: lea     mcro,a1
  269.         lea     fstate,a0
  270.         move.l  #$fffe,d0       ;virgin flag state
  271.         and.l   (a1),d0         ;only if macros allowed
  272.         move.l  d0,(a0)
  273.         rts
  274. ;       
  275. fillffa: clr.l  d0              ;start with zero ffa
  276.         lea     edge,a0
  277.         move.w  (a0),d0
  278.         beq.s   .ff5
  279.         cmp.w   #1,d0
  280.         bne.s   .ff1
  281.         move.w  #$2000,d0       ;one edge returned
  282.         bra.s   .ff4
  283. .ff1:   cmp.w   #99,d0
  284.         bne.s   .ff2
  285.         move.w  #$2800,d0       ;a test returned
  286.         bra.s   .ff4
  287. .ff2:   move.w  #$3000,d0       ;two edges returned
  288. .ff4:   swap    d0
  289. .ff5:   lea     fstate,a1
  290.         or.l    (a1),d0         ;merge edges expected
  291.         lea     ffa,a0
  292.         move.l  (a0),a0         ;where to store flags & length
  293.         move.l  d0,(a0)         ;do the store
  294. ;
  295.         push    a0              ;still need the address
  296.         bsr     _here
  297.         pop     d0
  298.         lea     codestart,a0
  299.         sub.l   (a0),d0
  300.         subq.l  #2,d0           ;ignore RTS
  301.         asr.l   #1,d0           ;convert to words
  302.         and.w   #maxsize,d0     ;limit it to maxsize
  303.         pop     a0              ;address of ffa
  304.         or.w    d0,(a0)         ;merge in the code length
  305.         bsr     edgeoff
  306.         rts
  307. ;
  308. colonbody: lea  hp,a0
  309.         lea     headmark,a1
  310.         move.l  (a0),(a1)       ;in case of error
  311.         bsr     header
  312.         lea     cp,a0
  313.         push    (a0)
  314.         move.l  (a6),-(a6)      ;two copies
  315.         bsr     _there
  316.         pop     d0
  317.         subq.l  #4,d0
  318.         bsr     setffa          ;where to patch flags and length
  319.         bsr     _hcomma         ;offset ^code in cfa
  320.         bsr     _hcomma         ;offset ^code flag in pfa
  321.         bsr     dolength        ;add length field to header
  322.         bsr     setstart        ;mark start of compiled code
  323.         rts
  324. ;
  325. ;*******************************;
  326. ;*  User                        ;
  327. ;*  Compilation utilities       ;
  328. ;*                              ;
  329. ;*******************************;
  330. ;
  331. _laddat: pop    a0
  332.         pop     d1
  333.         add.l   d1,(a0)
  334.         rts
  335. ;
  336. _ccomma: lea    cp,a0
  337.         move.l  (a0),d0
  338.         addq.l  #1,(a0)
  339.         pop     d1
  340.         move.b  d1,(a5,d0.l)
  341.         rts
  342. ;
  343.  
  344. _comma: bsr     _align
  345.         lea     cp,a0
  346.         move.l  (a0),d0
  347.         addq.l  #2,(a0)
  348.         pop     d1
  349.         move.w  d1,(a5,d0.l)
  350.         rts
  351. ;
  352. _lcomma: bsr    _align
  353.         lea     cp,a0
  354.         move.l  (a0),a1
  355.         addq.l  #4,(a0)
  356.         adda.l  a5,a1
  357.         pop     (a1)
  358.         rts
  359. ;
  360. _hcomma: bsr    _align
  361.         lea     hp,a0
  362.         move.l  (a0),a1
  363.         addq.l  #4,(a0)
  364.         adda.l  a5,a1
  365.         pop     (a1)
  366.         rts
  367. ;
  368. _allot: bsr     _even
  369.         lea     cp,a0
  370.         push    a0
  371.         bsr     _laddat
  372.         rts
  373. ;
  374. _hallot: bsr    _even
  375.         lea     hp,a0
  376.         push    a0
  377.         bsr     _laddat
  378.         rts
  379. ;
  380. _align: bsr     _here
  381.         pop     d0
  382.         btst    #0,d0
  383.         beq     .alx
  384.         push    #1
  385.         bsr     _allot
  386. .alx:   rts
  387. ;
  388. _halign: bsr    _there
  389.         pop     d0
  390.         btst    #0,d0
  391.         beq     .alx
  392.         push    #1
  393.         bsr     _hallot
  394. .alx:   rts
  395. ;
  396. _even:  pop     d0
  397.         move.l  d0,d1
  398.         and.l   #1,d1
  399.         add.l   d1,d0
  400.         push    d0
  401.         rts
  402. ;
  403. name:   push    #32
  404.         bsr     _word
  405.         move.l  (a6),a0         ;copy ^name
  406.         move.b  (a0),d0
  407.         beq     namerror
  408.         cmp.b   #31,d0
  409.         bgt     lenerror
  410.         bsr     upper
  411.         rts
  412. ;
  413. upper:  move.l  (a6),a0         ;copy ^name
  414.         clr.w   d1
  415.         move.b  (a0)+,d1        ;get length
  416.         sub.w   #1,d1
  417. .uplp:  move.b  (a0),d0
  418.         cmp.b   #$61,d0
  419.         blt     .up5
  420.         cmp.b   #$7a,d0
  421.         bgt     .up5
  422.         and.b   #$5f,d0
  423. .up5:   move.b  d0,(a0)+
  424.         dbra    d1,.uplp
  425.         rts
  426. ;
  427. ;***************************************;
  428. ;*                                      ;
  429. ;* Higher-level compilation words       ;
  430. ;*                                      ;
  431. ;***************************************;
  432. ;
  433. _literal: bsr   _ifcomp
  434.         bsr.s   bliteral
  435.         push    #$2d00          ;push d0
  436.         bsr     _comma
  437.         bsr     plusedge
  438. ;       bsr     toptypoff
  439.         bsr     kpflag
  440.         rts
  441. ;
  442. bliteral: move.l (a6),d0        ;copy literal value
  443.         beq.s   .lit2           ;easy if it is zero
  444.         move.l  d0,d1           ;a test copy
  445.         ext.w   d1
  446.         ext.l   d1              ;sign extend 8 bits to 32
  447.         cmp.l   d0,d1
  448.         bne.s   .lit5           ;longer than 8 bits
  449.         andi.l  #$ff,d0         ;mask off high bits
  450. .lit2:  ori.l   #$7000,d0       ;moveq #XX,d0 opcode
  451.         move.l  d0,(a6)         ;overwrite literal value
  452.         bsr     _comma
  453.         moveq.l #-1,d0          ;short literal
  454.         bra.s   .litx
  455. .lit5:  push    #$203c          ;move.l #32-bit,d0
  456.         bsr     _comma
  457.         bsr     _lcomma         ;immediate value
  458.         moveq.l #-2,d0          ;long literal
  459. .litx:  lea     toptyp,a0
  460.         move.w  d0,(a0)
  461.         rts
  462. ;
  463. _const: push    4(a0)           ;constant value in pfa
  464.         bsr     stateat
  465.         beq     .cox
  466.         bsr     _literal
  467. .cox:   rts
  468. ;
  469. _def:   move.l  4(a0),a0        ;pfa has offset of ^variable address
  470.         adda.l  a5,a0
  471.         push    a0
  472.         bsr     stateat
  473.         beq     dodef
  474.         bsr     bvar
  475.         push    #$2010          ;move.l (a0),d0
  476.         bsr     _comma
  477.         push    #$4eb50800      ;jsr (a5,d0.l)
  478.         bsr     _lcomma
  479.         bsr     toptypoff
  480.         bsr     kpflag
  481.         bsr     edgeoff
  482.         rts
  483. dodef:  pop     a0
  484.         move.l  (a0),d0
  485.         jsr     (a5,d0.l)
  486.         rts
  487. ;
  488. _vect:  move.l  4(a0),a0        ;^^code
  489.         adda.l  a5,a0
  490.         push    a0
  491.         bsr     stateat
  492.         beq     dodef
  493.         pop     a0
  494.         move.l  4(a0),d2        ;flags and length
  495.         move.l  (a0),a0
  496.         adda.l  a5,a0           ;code address
  497.         bsr     call
  498.         rts
  499. ;
  500. _var:   move.l  4(a0),a0        ;pfa has offset of ^variable address
  501.         adda.l  a5,a0
  502.         push    a0              ;code address
  503.         bsr     stateat
  504.         beq.s   direct          ;execution mode
  505. pvar:   bsr.s   bvar
  506.         push    #$2d08          ;'push a0'
  507.         bsr     _comma
  508.         moveq.l #1,d0           ;return non-zero
  509.         bsr     plusedge
  510. direct: rts                     ;return zero if not compiling
  511. ;
  512. bvar:   bsr     only_16         ;displacement returned in d1
  513.         bge     .dolea          ;lea if close enough
  514.         pop     a0              ;else get ready for offset reference
  515.         suba.l  a5,a0
  516.         push    a0              ;address offset
  517.         push    #$217c          ;movea.l #32-bit,a0
  518.         bsr     _comma
  519.         bsr     _lcomma         ;32-bit immediate value
  520.         push    #$d1cd          ;adda.l a5,a0
  521.         bsr     _comma
  522.         moveq.l #-4,d0          ;long address
  523.         bra.s   var5
  524. .dolea: move.l  d1,(a6)         ;overwrite address with displacement
  525.         push    #$41fa
  526.         bsr     _comma          ;lea
  527.         bsr     _comma          ;displacement
  528.         moveq.l #-3,d0          ;short address
  529. var5:   lea     toptyp,a0
  530.         move.w  d0,(a0)
  531. ;       bsr     toptypoff
  532.         bsr     clrflag
  533. bvarx:  rts
  534. ;
  535. _bdoes: move.l  (a7)+,-(a6)     ;get return address
  536.         bsr     castore         ;patch into cfa of generic word
  537.         bsr     _immediate      ;make generic word immediate
  538.         rts
  539. ;
  540. xplace: move.l  4(a0),a0        ;pfa has offset of ^variable address
  541.         adda.l  a5,a0
  542.         push    a0
  543.         push    #-1
  544.         bsr     pushin          ;read input from text
  545.         pop     a0
  546.         moveq.l #0,d0
  547.         move.b  (a0)+,d0
  548.         lea     hmac,a1
  549.         move.l  d0,(a1)         ;text length
  550.         lea     macptr,a1
  551.         move.l  a0,(a1)         ;text address
  552.         lea     macin,a1
  553.         clr.l   (a1)            ;zero pointer offset
  554.         rts
  555. ;
  556. xdoes:  bsr     _var            ;used during action of generic word
  557.         beq.s   .xd5            ;normal execution mode
  558.         move.l  (a7)+,a1        ;return address = compilation record
  559.         move.l  (a1)+,a0        ;get code offset from compilation record
  560.         move.l  (a1)+,d2        ;and the length and flags
  561.         adda.l  a5,a0           ;point to code
  562.         bsr     call            ;call it
  563.         rts
  564. .xd5:   move.l  (a7)+,a1
  565.         move.l  (a1),d0
  566.         jmp     (a5,d0.l)       ;skip over compilation record
  567.         rts
  568. ;
  569. _does:  lea     _bdoes,a0       ;definition of defining word
  570.         bsr     mustcall        ;defining word calls it
  571.         lea     xdoes,a0
  572.         bsr     mustcall        ;defined word calls it
  573.         lea     cp,a0
  574.         move.l  (a0),d0
  575.         lea     hp,a1
  576.         move.l  (a1),a1
  577.         adda.l  a5,a1           ;point to end of header
  578.         move.l  d0,-6(a1)       ;pfa now points to compilation record
  579.         addq.l  #8,d0           ;for now, point past compilation record
  580.         push    d0
  581.         subq.l  #4,d0           ;point back into compilation record
  582.         add.l   a5,d0           ;make it a real address
  583.         bsr     setffa          ;ffa for later patching
  584.         bsr     _lcomma         ;code pointer in compilation record
  585.         push    #0              ;save it for _semicolon
  586.         bsr     _lcomma         ;dummy length and flags
  587.         bsr     setstart        ;new start for code
  588.         bsr     virgin          ;virgin flag state
  589.         bsr     edgeoff
  590.         rts
  591. ;
  592. _recurse: lea codestart,a0
  593.         move.l  (a0),a0
  594.         bsr     mustcall        ;latest definition calls itself
  595.         rts
  596. ;
  597. _bra:   lea     state,a0
  598.         move.l  #0,(a0)
  599.         rts
  600. ;
  601. _ket:   lea     state,a0
  602.         move.l  #-1,(a0)
  603.         rts
  604. ;
  605. _create: bsr    header
  606.         lea     _var,a0
  607.         bsr     do_ptrs
  608.         bsr     dolength
  609.         bsr     _immediate
  610.         rts
  611. ;
  612. _variable: bsr  _create
  613.         push    #0
  614.         bsr     _lcomma
  615.         rts
  616. ;
  617. _constant: bsr  header
  618.         lea     _const,a0
  619.         suba.l  a5,a0           ;convert to offset
  620.         push    a0
  621.         bsr     _hcomma         ;code pointer in cfa
  622.         bsr     _hcomma         ;constant value in pfa
  623.         bsr     dolength
  624.         bsr     _immediate
  625.         rts
  626. ;
  627. _address: bsr   header
  628.         lea     _var,a0
  629.         suba.l  a5,a0           ;convert to offset
  630.         push    a0
  631.         bsr     _hcomma         ;code pointer in cfa
  632.         pop     d0
  633.         sub.l   a5,d0           ;convert address to offset
  634.         push    d0
  635.         bsr     _hcomma         ;constant value in pfa
  636.         bsr     dolength
  637.         bsr     _immediate
  638.         rts
  639. ;
  640. _defer: bsr     header
  641.         lea     _def,a0
  642. def5:   suba.l  a5,a0           ;convert to offset
  643.         push    a0
  644.         bsr     _hcomma         ;code pointer in cfa
  645.         lea     cp,a0
  646.         push    (a0)
  647.         bsr     _hcomma         ;offset ^value in pfa
  648.         lea     _noop,a0        ;point to noop
  649.         sub.l   a5,a0           ;convert address to offset
  650.         push    a0
  651.         bsr     _lcomma         ;code offset in compilation record
  652.         push    #0              ;dummy length and flag field
  653.         bsr     _lcomma
  654.         bsr     dolength
  655.         bsr     _immediate
  656.         rts
  657. ;
  658. _vector: bsr    header
  659.         lea     _vect,a0
  660.         bra     def5
  661. ;
  662. _is:    bsr     _head
  663.         bsr     stateat
  664.         beq     .is7            ;no compilation
  665.         pop     -(a7)           ;header of vector word
  666.         pop     a0              ;header of vectored word
  667.         push    -4(a0)          ;flags and length
  668.         move.l  4(a0),a0        ;code offset from pfa
  669.         adda.l  a5,a0
  670.         push    a0              ;code address
  671.         bsr     bvar            ;'load address to a0'
  672.         bsr     bliteral        ;'flags and length to d0'
  673.         push    #$91cd2208      ;'suba.l a5,a0 move.l a0,d1'
  674.         bsr     _lcomma
  675.         move.l  (a7)+,a1        ;address of vector word
  676.         move.l  4(a1),a1
  677.         adda.l  a5,a1           ;^data fields
  678.         push    a1
  679.         bsr     bvar            ;'dest address to a0'
  680.         push    #$20c12080      ;'move.l d1,(a0)+,move.l d0,(a0)'
  681.         bsr     _lcomma
  682.         rts
  683. .is7:   pop     a1              ;header of vector word
  684.         move.l  4(a1),a1
  685.         adda.l  a5,a1           ;^data fields
  686.         pop     a0              ;header of vectored word
  687.         move.l  -4(a0),4(a1)    ;copy flags and length
  688.         move.l  4(a0),(a1)      ;code offset
  689.         rts
  690. ;
  691. _file:  bsr     _create
  692.         push    #24
  693.         bsr     _allot
  694.         rts
  695. ;
  696. _colon: bsr     clrlve          ;clear leave stack
  697.         bsr     edgeoff
  698.         bsr     colonbody
  699.         bsr     _ket
  700.         bsr     _smudge
  701.         bsr     virgin          ;initialise push flag
  702.         push    #colval         ;balance marker
  703.         rts
  704. ;
  705. _semicolon: bsr _ifcomp
  706.         pop     d0
  707.         cmp.l   #colval,d0
  708.         bne     strerror
  709.         push    #$4e75          ;RTS
  710.         bsr     _comma
  711.         bsr     _bra
  712.         bsr     _smudge
  713.         bsr     fillffa
  714.         rts
  715. ;
  716. _dotq:  bsr     _q
  717.         lea     _type,a0
  718.         bsr     mustcall        ;force a call
  719.         rts
  720. ;
  721. _abortq: bsr    _if
  722.         bsr     _dotq
  723.         lea     _abort,a0
  724.         bsr     mustcall        ;force a call
  725.         bsr     _then
  726.         rts
  727. ;
  728. _q:     bsr     _ifcomp
  729.         lea     _bq,a0
  730.         bsr     mustcall        ;force a call
  731.         bsr     _qcomma
  732.         rts
  733. ;
  734. _qcomma: push   #34             ;"
  735. qc2:    bsr     _word           ;get string with this delimiter
  736.         move.l  (a6),a0         ;copy ^name
  737.         clr.l   d0
  738.         move.b  (a0),d0         ;get string length
  739.         beq     namerror
  740.         addq.l  #2,d0
  741.         clr.b   -1(a0,d0.w)     ;null at end of string
  742.         move.l  d0,-(a7)
  743.         bsr     _here           ;destination
  744.         move.l  (a7),-(a6)      ;length
  745.         bsr     _cmove
  746.         move.l  (a7)+,-(a6)     ;length
  747.         bsr     _allot
  748.         bsr     _align
  749.         rts
  750. ;
  751. _bq:    move.l  (a7)+,a0        ;^string in a0
  752.         clr.l   d0
  753.         move.b  (a0)+,d0        ;string length
  754.         movem.l d0/a0,-(a6)     ;address and length
  755.         add.l   a0,d0           ;end of string
  756.         addq.l  #1,d0           ;bump past null
  757.         move.l  d0,d1
  758.         andi.l  #1,d1
  759.         add.l   d1,d0           ;adjust to even address
  760.         move.l  d0,-(a7)        ;return address
  761.         rts
  762. ;
  763. _rplace: bsr    _ifexec 
  764.         bsr     header
  765.         lea     xplace,a0
  766.         bsr     do_ptrs
  767.         bsr     dolength
  768.         bsr     _immediate
  769.         lea    delim,a0
  770.         push    (a0)        ;delimiter has been set
  771.         bsr     qc2
  772.         rts
  773. ;
  774. _ifcomp: bsr    stateat
  775.         bne.s   .ifcx
  776.         lea     stterr,a0
  777.         bra     _error
  778. .ifcx:  rts
  779. ;
  780. _ifexec: bsr    stateat
  781.         beq.s   .ifex
  782.         lea     exerr,a0
  783.         bra     _error
  784. .ifex:  rts
  785. ;
  786. ; _compile is used to define a defining word which will compile code
  787. ; as it is at the time of definition of the DEFINING word
  788. ;
  789. _compile: bsr   comphead
  790.         bsr     special
  791.         bne     .c5
  792.         move.l  4(a0),a0        ;indirection needed
  793.         adda.l  a5,a0
  794.         push    4(a0)           ;length and macro flag if deferred
  795.         bra.s   .c6
  796. .c5:    push    -4(a0)          ;normal length and macro flag
  797. .c6:    move.l  (a0),a0
  798.         adda.l  a5,a0
  799.         push    a0              ;code address
  800.         bsr     bvar            ;'load code address into a0'
  801.         push    #$243c
  802.         bsr     _comma          ;'load immed val of length & flag
  803.         bsr     _lcomma         ;into d2'
  804.         lea     call,a0         ;code for child word
  805.         bsr     mustcall        ;'call or expand in child word'
  806.         rts
  807. ;
  808. ;_delay is used in a definition of a defining word.  It will compile
  809. ;the code to to used by @execute when the defining word is used.
  810. _delay: bsr     comphead
  811.         bsr     special
  812.         bne     deferror        ;cannot delay normal words
  813.         move.l  4(a0),a0        ;indirection needed
  814.         adda.l  a5,a0
  815.         push    a0              ;code address
  816.         bsr     bvar            ;'load comp record address into a0'
  817.         lea     delaycall,a0    ;code for child word
  818.         bsr     mustcall        ;'call or expand in child word'
  819.         rts
  820. ;
  821. delaycall: move.l 4(a0),d2
  822.         move.l  (a0),a0
  823.         adda.l  a5,a0
  824.         bsr     call
  825.         rts
  826. ;
  827. special: move.l (a0),d0
  828.         add.l   a5,d0
  829.         lea     _vect,a1
  830.         cmp.l   d0,a1           ;is it a vectored word?
  831.         beq     .sx
  832.         lea     _def,a1
  833.         cmp.l   d0,a1
  834. .sx:    rts                     ;return zero if OK
  835. ;
  836. _call:  bsr     comphead
  837.         move.l  (a0),a0
  838.         adda.l  a5,a0
  839.         bsr     mustcall
  840.         rts
  841. ;
  842. _btick: bsr     _ifcomp
  843.         bsr     _tick           ;fetch address
  844.         bsr     pvar            ;code to put it onto stack
  845.         rts
  846. ;
  847. _bcompile: bsr  comphead
  848.         move.l  (a0),d0
  849.         cmp.l   4(a0),d0        ;equal in normal words
  850.         beq     .bc5
  851.         bra     deferror
  852. .bc5:   move.l  -4(a0),d2       ;length and macro flag
  853.         move.l  (a0),a0
  854.         adda.l  a5,a0           ;code address
  855.         bsr     call
  856.         rts
  857. ;
  858. _stcsp: bsr     _spat
  859.         lea     csp,a0
  860.         pop     (a0)
  861.         rts
  862. ;
  863. _pairs: bsr     _equal
  864.         pop     d0
  865.         bne     .pairsx
  866.         lea     strerr,a0
  867.         bra     _error
  868. .pairsx: rts
  869. ;
  870. ;*********************************************************;
  871. ;                                                        ;
  872. ; Low-level words for defining logical structures        ;
  873. ;                                                        ;
  874. ;*********************************************************;
  875. ;
  876.  
  877. _fmark: bsr     _here
  878.         push    #0
  879.         bsr     _comma
  880.         bsr     edgeoff
  881.         rts
  882. ;
  883. _bmark: bsr     _here
  884.         bsr     edgeoff
  885.         rts
  886. ;
  887. _fresolve:
  888.         bsr     _here
  889.         bsr     _over
  890.         bsr     _sub
  891.         bsr     _swap
  892.         bsr     _wstore
  893.         bsr     edgeoff
  894.         rts
  895. ;
  896. _bresolve:
  897.         bsr     _here
  898.         bsr     _sub
  899.         bsr     only_8
  900.         bne     .br5
  901.         bsr     tocode          ;returned in a1
  902.         pop     d0
  903.         move.b  d0,-1(a1)       ;short branch
  904.         bra.s   .brx
  905. .br5:   bsr     _comma
  906. .brx:   bsr     edgeoff
  907.         rts
  908. ;
  909. _bif:   pop     d0
  910.         dc.w    $6700           ;beq
  911.         rts
  912. ;
  913. doif:   move.w  edge(pc),d0
  914.         cmp.w   #99,d0
  915.         bne     .di5            ;last instruct not a test
  916.         bsr     tocode          ;address in a1
  917.         subq.l  #8,a1
  918.         move.w  (a1),d0
  919.         andi.w  #$0f00,d0
  920.         eori.w  #$0100,d0       ;reverse the logic
  921.         ori.w   #$6000,d0
  922.         move.w  d0,(a1)+        ;replace as a branch
  923.         suba.l  a5,a1
  924.         lea     cp,a0
  925.         move.l  a1,(a0)         ;correct HERE
  926.         bsr     edgeoff
  927.         rts
  928. .di5:   lea     _bif,a0         ;start of code
  929.         move.l  #exp_d0,d2      ;macro flag & one edge
  930.         moveq   #2,d4           ;length
  931.         bsr     inline
  932.         rts
  933. ;
  934. clrlve: lea     lstkptr,a0
  935.         move.l  a0,(a0)
  936.         rts
  937. ;
  938. pushlve: lea    lstkptr,a1
  939.         move.l  (a1),a0
  940.         subq.l  #4,a0
  941.         pop     (a0)
  942.         move.l  a0,(a1)
  943.         rts
  944. ;
  945. poplve: lea     lstkptr,a1
  946.         move.l  (a1),a0
  947.         push    (a0)
  948.         addq.l  #4,a0
  949.         move.l  a0,(a1)
  950.         rts
  951. ;
  952. reslve: bsr     poplve          ;value on leave stack
  953.         move.l  (a6),d0
  954.         beq     .reslx
  955.         bsr     _fresolve
  956.         bra     reslve
  957. .reslx: addq.l  #4,a6           ;discard zero
  958.         bsr     edgeoff
  959.         rts
  960. ;
  961. _bdo:   move.l  (a7)+,a0
  962.         lea     lpstkptr,a1     ;loop stack pointer
  963.         move.l  (a1),a2
  964.         movem.l d6-d7,-(a2)
  965.         move.l  a2,(a1)         ;keep altered stack pointer
  966.         movem.l (a6)+,d6-d7
  967.         add.l   #$80000000,d7
  968.         sub.l   d7,d6
  969.         cmp.l   #$80000000,d6   ;indexes equal?
  970.         jmp     (a0)
  971. ;
  972. _bunloop: lea   lpstkptr,a1
  973.         move.l  (a1),a2
  974.         movem.l (a2)+,d6-d7     ;pop loop stack
  975.         move.l  a2,(a1)
  976.         rts
  977. ;
  978. bloop:  addq.l  #1,d6
  979.         dc.w    $6800           ;BVC xxxx
  980.         rts
  981. ;
  982. bploop: pop     d0
  983.         add.l   d0,d6
  984.         dc.w    $6800           ;BVC xxxx
  985.         rts
  986. ;
  987. bi:     move.l  d6,d0
  988.         add.l   d7,d0
  989.         push    d0
  990.         rts
  991. ;
  992. bip:    move.l  d7,d0
  993.         add.l   #$80000000,d0
  994.         push    d0
  995.         rts
  996. ;
  997. bj:     lea     lpstkptr,a0
  998.         move.l  (a0),a0
  999.         push    (a0)
  1000.         rts
  1001. ;
  1002. bof:    pop     d0
  1003.         cmp.l   d0,d6
  1004.         dc.w    $6600
  1005. ;
  1006. ;***************************************;
  1007. ;*                                      ;
  1008. ;* User words for logical structures    ;
  1009. ;*                                      ;
  1010. ;***************************************;
  1011. ;
  1012. _case:  bsr     _ifcomp
  1013.         push    #0
  1014.         bsr     pushlve         ;zero marker
  1015.         push    #$2f062c1e      ;move.l d6,-(a7) pop d6
  1016.         bsr     _lcomma
  1017.         push    #casval
  1018.         bsr     edgeoff
  1019.         rts
  1020. ;
  1021. _endcase: bsr   _ifcomp
  1022.         pop     d0
  1023.         cmp.l   #casval,d0
  1024.         bne     strerror
  1025.         bsr     reslve
  1026.         push    #$2c1f          ;move.l (a7)+,d6
  1027.         bsr     _comma
  1028.         rts
  1029. ;       
  1030. _of:    move.l  (a6),d0
  1031.         cmp.l   #casval,d0
  1032.         bne     strerror
  1033.         lea     bof,a0
  1034.         move.l  #exp_d0,d2      ;one edge, 'pop d0' required
  1035.         move.w  #3,d4
  1036.         bsr     inline
  1037.         bsr.s   if2
  1038.         rts
  1039. ;
  1040. _endof: bsr     _ifcomp
  1041.         pop     d0
  1042.         cmp.l   #ifval,d0
  1043.         bne     strerror
  1044.         bsr     lv2
  1045.         bsr     _fresolve
  1046.         rts
  1047. ;
  1048. _if:    bsr     _ifcomp
  1049.         bsr     doif
  1050. if2:    bsr     _fmark
  1051.         push    #ifval
  1052.         rts
  1053. ;
  1054. _then:  bsr     _ifcomp
  1055.         pop     d0
  1056.         cmp.l   #ifval,d0
  1057.         bne     strerror
  1058.         bsr     _fresolve
  1059.         rts
  1060. ;
  1061. _else:  bsr     _ifcomp
  1062.         pop     d0
  1063.         cmp.l   #ifval,d0
  1064.         bne     strerror
  1065.         push    #$6000          ;bra
  1066.         bsr     _comma 
  1067.         bsr     _fmark
  1068.         bsr     _swap
  1069.         bsr     _fresolve
  1070.         push    #ifval
  1071.         rts
  1072. ;
  1073. _begin: bsr     _ifcomp
  1074.         push    #0
  1075.         bsr     pushlve         ;zero marker
  1076.         bsr     _bmark
  1077.         push    #bval
  1078.         rts
  1079. ;
  1080. _until: bsr     _ifcomp
  1081.         pop     d0
  1082.         cmp.l   #bval,d0
  1083.         bne     strerror
  1084.         bsr     doif
  1085.         bsr     _bresolve
  1086.         bsr     reslve
  1087.         rts
  1088. ;
  1089. _again: bsr     _ifcomp
  1090.         pop     d0
  1091.         cmp.l   #bval,d0
  1092.         bne     strerror
  1093.         push    #$6000
  1094.         bsr     _comma
  1095.         bsr     _bresolve
  1096.         bsr     reslve
  1097.         rts
  1098. ;
  1099. _while: bsr     _ifcomp
  1100.         pop     d0
  1101.         cmp.l   #bval,d0
  1102.         bne     strerror
  1103.         bsr     doif
  1104.         bsr     _fmark
  1105.         push    #wval
  1106.         rts
  1107. ;
  1108. _repeat: bsr    _ifcomp
  1109.         pop     d0
  1110.         cmp.l   #wval,d0
  1111.         bne     strerror
  1112.         push    #$6000          ;bra
  1113.         bsr     _comma
  1114.         bsr     _swap
  1115.         bsr     _bresolve
  1116.         bsr     _fresolve
  1117.         bsr     reslve
  1118.         rts
  1119. ;
  1120. _leave: bsr     _ifcomp
  1121. lv2:    push    #$6000          ;bra
  1122.         bsr     _comma
  1123.         bsr     _fmark
  1124.         bsr     pushlve
  1125.         rts
  1126. ;
  1127. _exit:  push    #$4e75          ;rts
  1128.         bsr     _comma
  1129.         rts
  1130. ;
  1131. _do:    bsr     _ifcomp
  1132.         push    #0
  1133.         bsr     pushlve         ;zero marker
  1134.         lea     _bdo,a0
  1135.         bsr     mustcall
  1136.         push    #$6700
  1137.         bsr     _comma
  1138.         bsr     _fmark          ;beq XXXX
  1139.         bsr     _bmark          ;for backward branch
  1140.         push    #doval
  1141.         rts
  1142. ;
  1143. _loop:  bsr     _ifcomp
  1144.         pop     d0
  1145.         cmp.l   #doval,d0
  1146.         bne     strerror
  1147.         lea     bloop,a0
  1148.         moveq   #2,d4           ;length
  1149.         bsr     nocall
  1150. lp5:    bsr     _bresolve       ;<resolve
  1151.         bsr     reslve
  1152.         bsr     _fresolve       ;>resolve if indexes equal
  1153.         lea     _bunloop,a0
  1154.         bsr     mustcall
  1155.         bsr     edgeoff
  1156.         rts
  1157. ;
  1158. _ploop: bsr     _ifcomp
  1159.         pop     d0
  1160.         cmp.l   #doval,d0
  1161.         bne     strerror
  1162.         lea     bploop,a0       ;start of inline code
  1163.         move.l  #exp_d0,d2      ;look for one edge
  1164.         move.w  #3,d4
  1165.         bsr     inline
  1166.         bra     lp5
  1167. ;
  1168. _i:     bsr     _ifcomp
  1169.         lea     bi,a0
  1170.         move.l  #ret1_any,d2
  1171.         moveq   #3,d4           ;length
  1172.         bsr     inline
  1173.         rts
  1174. ;
  1175. _ip:    bsr     _ifcomp
  1176.         move.l  #ret1_any,d2
  1177.         lea     bip,a0
  1178.         moveq   #5,d4           ;length
  1179.         bsr     inline
  1180.         rts
  1181. ;
  1182. _j:     bsr     _ifcomp
  1183.         lea     bj,a0
  1184.         bsr     mustcall
  1185.         rts
  1186. ;
  1187.         section data
  1188.         even
  1189. ;
  1190.         dc.b    $c6,'MACROS',$a0
  1191.         ptrs    _macros,20
  1192. ;
  1193.         dc.b    $c5,'CALL','S'!$80
  1194.         ptrs    _calls,18
  1195. ;
  1196.         dc.b    $c1,'I'!$80
  1197.         ptrs    _i,14
  1198. ;
  1199.         dc.b    $c1,'J'!$80
  1200.         ptrs    _j,14
  1201. ;
  1202.         dc.b    $c2,"I'",$a0
  1203.         ptrs    _ip,16
  1204. ;
  1205.         dc.b    $c2,'R>',$a0
  1206.         ptrs    _rgt,16
  1207. ;
  1208.         dc.b    $c2,'>R',$a0
  1209.         ptrs    _gtr,16
  1210. ;
  1211.         dc.b    $c2,'R@',$a0
  1212.         ptrs    _rat,16
  1213. ;
  1214.         dc.b    $c1,'['!$80
  1215.         ptrs    _bra,14
  1216. ;
  1217.         dc.b    $c1,']'!$80
  1218.         ptrs    _ket,14
  1219. ;
  1220.         dc.b    $84,'!CSP',$a0
  1221.         ptrs    _stcsp,18
  1222. ;
  1223.         dc.b    $86,'?PAIRS',$a0
  1224.         ptrs    _pairs,20
  1225. ;
  1226.         dc.b    $85,'>MAR','K'!$80
  1227.         ptrs    _fmark,18
  1228. ;
  1229.         dc.b    $88,'>RESOLVE',$a0
  1230.         ptrs    _fresolve,22
  1231. ;
  1232.         dc.b    $85,'<MAR','K'!$80
  1233.         ptrs    _bmark,18
  1234. ;
  1235.         dc.b    $88,'<RESOLVE',$a0
  1236.         ptrs    _bresolve,22
  1237. ;
  1238.         dc.b    $85,'?COM','P'!$80
  1239.         ptrs    _ifcomp,18
  1240. ;
  1241.         dc.b    $85,'?EXE','C'!$80
  1242.         ptrs    _ifexec,18
  1243. ;
  1244.         dc.b    $c3,"['","]"!$80
  1245.         ptrs    _btick,16
  1246. ;
  1247.         dc.b    $c7,'LITERA','L'!$80
  1248.         ptrs    _literal,20
  1249. ;
  1250.         dc.b    $c6,'SMUDGE',$a0
  1251.         ptrs    _smudge,20
  1252. ;
  1253.         dc.b    $c9,'IMMEDIAT','E'!$80
  1254.         ptrs    _immediate,22
  1255. ;
  1256.         dc.b    $85,'ALLO','T'!$80
  1257.         ptrs    _allot,18
  1258. ;
  1259.         dc.b    $84,'EVEN',$a0
  1260.         ptrs    _even,18
  1261. ;
  1262.         dc.b    $85,'ALIG','N'!$80
  1263.         ptrs    _align,18
  1264. ;
  1265.         dc.b    $81,','!$80
  1266.         ptrs    _lcomma,14
  1267. ;
  1268.         dc.b    $82,'W,',$a0
  1269.         ptrs    _comma,16
  1270. ;
  1271.         dc.b    $82,'C,',$a0
  1272.         ptrs    _ccomma,16
  1273. ;
  1274.         dc.b    $82,'",',$a0
  1275.         ptrs    _qcomma,16
  1276. ;
  1277.         dc.b    $81,':'!$80
  1278.         ptrs    _colon,14
  1279. ;
  1280.         dc.b    $c1,';'!$80
  1281.         ptrs    _semicolon,14
  1282. ;
  1283.         dc.b    $c2,'IF',$a0
  1284.         ptrs    _if,16
  1285. ;
  1286.         dc.b    $c4,'ELSE',$a0
  1287.         ptrs    _else,18
  1288. ;
  1289.         dc.b    $c4,'THEN',$a0
  1290.         ptrs    _then,18
  1291. ;
  1292.         dc.b    $c2,'DO',$a0
  1293.         ptrs    _do,16
  1294. ;
  1295.         dc.b    $c4,'LOOP',$a0
  1296.         ptrs    _loop,18
  1297. ;
  1298.         dc.b    $c5,'+LOO','P'!$80
  1299.         ptrs    _ploop,18
  1300. ;
  1301.         dc.b    $c5,'LEAV','E'!$80
  1302.         ptrs    _leave,18
  1303. ;
  1304.         dc.b    $c4,'EXIT',$a0
  1305.         ptrs    _exit,18
  1306. ;
  1307.         dc.b    $c5,'BEGI','N'!$80
  1308.         ptrs    _begin,18
  1309. ;
  1310.         dc.b    $c5,'UNTI','L'!$80
  1311.         ptrs    _until,18
  1312. ;
  1313.         dc.b    $c5,'AGAI','N'!$80
  1314.         ptrs    _again,18
  1315. ;
  1316.         dc.b    $c5,'WHIL','E'!$80
  1317.         ptrs    _while,18
  1318. ;
  1319.         dc.b    $c6,'REPEAT',$a0
  1320.         ptrs    _repeat,20
  1321. ;
  1322.         dc.b    $c4,'CASE',$a0
  1323.         ptrs    _case,18
  1324. ;
  1325.         dc.b    $c7,'ENDCAS','E'!$80
  1326.         ptrs    _endcase,20
  1327. ;
  1328.         dc.b    $c2,'OF',$a0
  1329.         ptrs    _of,16
  1330. ;
  1331.         dc.b    $c5,'ENDO','F'!$80
  1332.         ptrs    _endof,18
  1333. ;
  1334.         dc.b    $86,'CREATE',$a0
  1335.         ptrs    _create,20
  1336. ;
  1337.         dc.b    $c5,'DOES','>'!$80
  1338.         ptrs    _does,18
  1339. ;
  1340.         dc.b    $87,'REPLAC','E'!$80
  1341.         ptrs    _rplace,20
  1342. ;
  1343.         dc.b    $c6,'ABORT"',$a0
  1344.         ptrs    _abortq,20
  1345. ;
  1346.         dc.b    $c2,46,34,$a0
  1347.         ptrs    _dotq,16
  1348. ;
  1349.         dc.b    $c1,34!$80
  1350.         ptrs    _q,14
  1351. ;
  1352.         dc.b    $88,'VARIABLE',$A0
  1353.         ptrs    _variable,22
  1354. ;
  1355.         dc.b    $88,'CONSTANT',$a0
  1356.         ptrs    _constant,22
  1357. ;
  1358.         dc.b    $87,'ADDRES','S'!$80
  1359.         ptrs    _address,20
  1360. ;
  1361.         dc.b    $c5,'DEFE','R'!$80
  1362.         ptrs    _defer,18
  1363. ;
  1364.         dc.b    $c2,'IS',$a0
  1365.         ptrs    _is,16
  1366. ;
  1367.         dc.b    $c7,'COMPIL','E'!$80
  1368.         ptrs    _compile,20
  1369. ;
  1370.         dc.b    $c9,'[COMPILE',']'!$80
  1371.         ptrs    _bcompile,22
  1372. ;
  1373.         dc.b    $c5,'DELA','Y'!$80
  1374.         ptrs    _delay,18
  1375. ;
  1376.         dc.b    $c4,'CALL',$a0
  1377.         ptrs    _call,18
  1378. ;       
  1379.         dc.b    $c6,'VECTOR',$a0
  1380.         ptrs    _vector,20
  1381. ;
  1382.         dc.b    $84,'FILE',$a0
  1383.         ptrs    _file,18
  1384. ;
  1385.         dc.b    $c7,'RECURS','E'!$80
  1386.         ptrs    _recurse,20
  1387. ;
  1388.         dc.b    $87,'EXECUT','E'!$80
  1389.         ptrs    _execute,20
  1390. ;
  1391.         dc.b    $88,'@EXECUTE',$a0
  1392.         ptrs    _atexec,22
  1393. ;
  1394.