home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / f68k / f68k.s < prev    next >
Encoding:
Text File  |  1993-10-23  |  190.6 KB  |  6,198 lines
  1.                 OPT O+,W+
  2.                 OUTPUT 'D:\F68K\KERN_TA.IMG'
  3.  
  4. version         EQU $19920401
  5.  
  6.  
  7.                 TEXT
  8.  
  9. magic:          DC.W 'JP'
  10. iscodelen:      DC.L HERE-sys
  11. isdatalen:      DC.L dataHERE-datas
  12.                 DS.W 9          ;yet unused
  13.  
  14. *************************************************************************
  15. *                                                                       *
  16. *                                                                       *
  17. *                               F68K                                    *
  18. *                       a portable FORTHsystem                          *
  19. *                                                                       *
  20. *                            Version 1.0                                *
  21. *                                                                       *
  22. *                                by                                     *
  23. *                             Joerg Plewe                               *
  24. *                          Grossenbaumerstr. 27                         *
  25. *                        4330 Muelheim a.d. Ruhr                        *
  26. *                                                                       *
  27. *                       started 5-2-1990 at 2.00pm                      *
  28. *                                                                       *
  29. *                       assembled with TurboAss                         *
  30. *                                                                       *
  31. *                                                                       *
  32. * last changed: 04-01-92                                                *
  33. *************************************************************************
  34.  
  35. *****************************************************************
  36.                 >PART 'comments'
  37. *************************************************************************
  38. *       usage of registers:                                             *
  39. *                                                                       *
  40. * us       equr     d5      ;userarea                                   *
  41. * seg      equr     a2      ;pointer to actual segment                  *
  42. * DT       equr     a3      ;pointer to data segment                    *
  43. * fs       equr     a4      ;Floatingpointstack                         *
  44. * SB       equr     a5      ;pointer to start of system                 *
  45. * ds       equr     a6      ;data-stackpointer                          *
  46. * rp       equr     a7      ;returnstackpointer                         *
  47. *       d6,d7 are used for DO...LOOP                                    *
  48. *                                                                       *
  49. *       a0-a2,d0-d4 are for common use                                  *
  50. *       BE CAREFULL!    not all words save theire registers!!!          *
  51. *************************************************************************
  52. *                                                                       *
  53. *       HEADER                                                          *
  54. *                                                                       *
  55. *       $0      controlword, see below                                  *
  56. *       $4      CFA, the CodeFieldAddress, points to code               *
  57. *       $8      linkfield, words of ONE vocabulary                      *
  58. *       $C      countWORD, gives length of the name                     *
  59. *       $10...  the name                                                *
  60. *                                                                       *
  61. *************************************************************************
  62. *                                                                       *
  63. *       CODE                                                            *
  64. *                                                                       *
  65. *       -$4     VIEW, contains a number of a block                      *
  66. *       $0      the code itself, see CFA above                          *
  67. *                                                                       *
  68. *************************************************************************
  69. *                                                                       *
  70. *       Bitusage in the controlword:                                    *
  71. *                                                                       *
  72. *       Bit0    smudge, word cannot be found                            *
  73. *       Bit1    immediate, word will execute during compilation         *
  74. *       Bit2    restrict, word may only be used in compiletime          *
  75. *       Bit3    macro, word is a macro                                  *
  76. *                                                                       *
  77. *************************************************************************
  78.                 ENDPART
  79.  
  80. *****************************************************************
  81.                 >PART 'EQU'
  82.  
  83. *       for codegeneration during runtime:
  84. jmp_code        EQU $4EFC
  85. jsr_code        EQU $4EAA       ;jsr    off(seg)
  86. jsrSB_code      EQU $4EAD       ;jsr    off(SB)
  87. move_seg_code   EQU $246B       ;move.l off(DT),seg
  88. rts_code        EQU $4E75
  89. bsr_code        EQU $6100
  90. bsrb_code       EQU $61
  91. movesp_anull    EQU $205F
  92. moveimm_sp      EQU $2D3C
  93.  
  94. BKSP            EQU $08
  95. CR              EQU 13
  96.  
  97. headsize        EQU 10
  98. of              EQU $8000       ;half a code segment
  99. bytesperblock   EQU 2000
  100.  
  101. *************************************************************************
  102. *       offset into user-table                                          *
  103. *************************************************************************
  104. ounext          EQU $00
  105. ornull          EQU $04
  106. osnull          EQU $08
  107. ofnull          EQU $0C
  108. ostate          EQU $10
  109. onumber_quest   EQU $14
  110. obase           EQU $18
  111. odpl            EQU $1C
  112. ohld            EQU $20
  113. odp             EQU $24
  114. odata           EQU $28
  115. ototib          EQU $28+4
  116. o_tib           EQU $2C+4
  117. otoin           EQU $30+4
  118. ospan           EQU $34+4
  119. ocurrent        EQU $38+4
  120. ovoc_link       EQU $3C+4
  121. ovocpa          EQU $40+4
  122. olast           EQU $44+4
  123. ;ofence          EQU $48+4
  124. oerror          EQU $4C         ;+4
  125. okey            EQU $50         ;+4
  126. oemit           EQU $54         ;+4
  127. okey_quest      EQU $58         ;+4
  128. or_w            EQU $60-4
  129. oreadsys        EQU $64-4
  130. owritesys       EQU $68-4
  131. olkey           EQU $6C-4
  132. olemit          EQU $70-4
  133. olkey_quest     EQU $74-4
  134. olr_w           EQU $78-4
  135. olreadsys       EQU $7C-4
  136. olwritesys      EQU $80-4
  137. oexpect         EQU $6C+20
  138. otype           EQU $70+20
  139. omacro          EQU $74+20
  140. ois_macro       EQU $78+20
  141. owarning        EQU $7C+20
  142. oout            EQU $80+20
  143. ofwidth         EQU $84+20
  144. oliteral        EQU $88+20
  145. ofliteral       EQU $8C+20
  146. oblk            EQU $88+8+20
  147. orootblk        EQU $8C+8+20
  148. oprev           EQU $90+8+20
  149. ouserbufs       EQU $94+8+20
  150. ocaps           EQU $98+8+20
  151. oudp            EQU $9C+8+20
  152.  
  153.                 ENDPART
  154.  
  155. *****************************************************************
  156.                 >PART 'initialising'
  157. *********************************************************************
  158. *       initialising the system
  159. *********************************************************************
  160. *On the returnstack there will come only one pointer to a structure,
  161. *which contains all necessary data to run F68K which are
  162. ;registers:    DS.L 16         ;d0,d1,d2,d3.......,a5,a6,a7
  163. ;forthregs:    DS.L 4          ;a3,a5,a6,a7
  164. ;TIBptr        DS.L 1
  165. ;codelen:      DS.L 1
  166. ;datalen:      DS.L 1
  167. ;emittable:    DS.L 1
  168. ;keytable:     DS.L 1
  169. ;keyqtable:    DS.L 1
  170. ;r_wtable:     DS.L 1
  171. ;readsystable: DS.L 1
  172. ;writesystable:DS.L 1
  173. ;roottable:    DS.L 1
  174.  
  175.  
  176.  
  177. forthregs       EQU 16*4
  178. TIBptr          EQU forthregs+(4*4)
  179. codelen         EQU TIBptr+4
  180. datalen         EQU codelen+4
  181. emittable       EQU datalen+4
  182. keytable        EQU emittable+4
  183. keyqtable       EQU keytable+4
  184. r_wtable        EQU keyqtable+4
  185. readsystable    EQU r_wtable+4
  186. writesystable   EQU readsystable+4
  187. roottbl         EQU writesystable+4
  188.  
  189.  
  190. ;; A0 is important during initialisation!!!
  191.  
  192. sys:
  193. init:           move.l  A0,-(SP)
  194.                 addq.l  #8,SP           ;A7 to returnheigth
  195.                 movea.l (SP),A0         ;Pointer to parastruc
  196.                 movem.l D0-A7,(A0)      ;save all registers
  197.                 move.l  -8(SP),8*4(A0)  ;save old A0, too
  198.                 movea.l -4(SP),A1       ;get returnaddress
  199.                 movem.l forthregs(A0),A3/A5-A7 ;load forth registers
  200.  
  201.                 adda.l  #of,A5          ;points to the middle of first segment
  202.                 move.l  A0,D0
  203.                 sub.l   A3,D0
  204.                 move.l  D0,(tforthparas-datas)(A3)
  205.                 move.l  A1,(bootsys-datas)(A3) ;remember exit
  206.                 move.l  (15*4)(A0),(saveret-datas)(A3) ;remember loaders SP
  207.  
  208. * relocate the segment table
  209.                 lea     (table-datas)(A3),A1 ;pointer to the table
  210.                 move.l  A5,D1           ;0.th segment pointer
  211.                 move.l  #(tablesize-1),D0
  212. relo_loop:
  213.                 move.l  D1,(A1)+
  214.                 addi.l  #$010000,D1
  215.                 dbra    D0,relo_loop
  216.  
  217.  
  218.                 move.l  (bootuser-datas)(A3),D5 ;USER-Pointer
  219.  
  220.                 move.l  codelen(A0),D0  ;fetch length of code
  221.                 add.l   A5,D0           ;calculate systop
  222.                 sub.l   A3,D0           ;make ist rel. to DT
  223.                 subi.l  #of,D0          ;substract offset
  224.                 move.l  D0,(tsystop-datas)(A3) ;set systop
  225.  
  226.                 move.l  datalen(A0),D0  ;fetch length of data
  227.                 move.l  D0,(tdatatop-datas)(A3) ;set datatop
  228.                 move.l  #0,(tdatabot-datas)(A3) ;because all rel. to DT
  229.                 lea     -of(A5),A1
  230.                 suba.l  A3,A1           ;calculate offset of segm.
  231.                 move.l  A1,(tsysbot-datas)(A3) ;set it
  232.  
  233.  
  234. * fetch stackbases
  235.                 move.l  D5,D0
  236.                 addi.l  #ototib,D0
  237.                 move.l  TIBptr(A0),D1
  238.                 sub.l   A3,D1           ;make pointer relativ
  239.                 move.l  D1,0(A3,D0.w)   ;set >TIB
  240.  
  241. * now fetch I/O-addresses
  242.                 move.l  D5,D0
  243.                 addi.l  #olemit,D0
  244.                 move.l  emittable(A0),D1
  245.                 sub.l   A3,D1           ;make pointer relativ to SB
  246.                 move.l  D1,(temits-datas)(A3) ;EMITs
  247.                 move.l  4(A3,D1.l),D1
  248.                 move.l  D1,0(A3,D0.l)   ;set EMIT
  249.  
  250.                 move.l  D5,D0
  251.                 addi.l  #olkey,D0
  252.                 move.l  keytable(A0),D1
  253.                 sub.l   A3,D1           ;make pointer relativ to SB
  254.                 move.l  D1,(tkeys-datas)(A3) ;KEYs
  255.                 move.l  4(A3,D1.l),D1
  256.                 move.l  D1,0(A3,D0.l)   ;set KEY
  257.  
  258.                 move.l  D5,D0
  259.                 addi.l  #olkey_quest,D0
  260.                 move.l  keyqtable(A0),D1
  261.                 sub.l   A3,D1           ;make pointer relativ to SB
  262.                 move.l  D1,(tkey_quests-datas)(A3) ;KEY?s
  263.                 move.l  4(A3,D1.l),D1
  264.                 move.l  D1,0(A3,D0.l)   ;set KEY?
  265.  
  266.                 move.l  D5,D0
  267.                 addi.l  #olr_w,D0
  268.                 move.l  r_wtable(A0),D1
  269.                 sub.l   A3,D1           ;make pointer relativ to SB
  270.                 move.l  D1,(tr_ws-datas)(A3) ;R/Ws
  271.                 move.l  4(A3,D1.l),D1
  272.                 move.l  D1,0(A3,D0.l)   ;set R/W
  273.  
  274.                 move.l  D5,D0
  275.                 addi.l  #olreadsys,D0
  276.                 move.l  readsystable(A0),D1
  277.                 sub.l   A3,D1           ;make pointer relativ to SB
  278.                 move.l  D1,(treadsyses-datas)(A3) ;R/Ws
  279.                 move.l  4(A3,D1.l),D1
  280.                 move.l  D1,0(A3,D0.l)   ;set R/W
  281.  
  282.                 move.l  D5,D0
  283.                 addi.l  #olwritesys,D0
  284.                 move.l  writesystable(A0),D1
  285.                 sub.l   A3,D1           ;make pointer relativ to SB
  286.                 move.l  D1,(twritesyses-datas)(A3) ;R/Ws
  287.                 move.l  4(A3,D1.l),D1
  288.                 move.l  D1,0(A3,D0.l)   ;set R/W
  289.  
  290.                 movea.l roottbl(A0),A1  ;pointer to roottable
  291.                 beq.s   mark_roottable  ;is there a device?
  292.                 move.l  D5,D0           ;mark first device in
  293.                 addi.l  #orootblk,D0    ;table as ROOTBLK
  294.                 move.l  4(A1),0(A3,D0.l)
  295. mark_roottable:
  296.                 suba.l  A3,A1
  297.                 move.l  A1,(troot-datas)(A3)
  298.  
  299.  
  300. * now initialise with given pointers
  301.  
  302.                 move.l  D5,D0
  303.                 addi.l  #osnull,D0
  304.                 move.l  A6,D1
  305.                 sub.l   A3,D1           ;make pointer relativ
  306.                 move.l  D1,0(A3,D0.l)   ;set data-stackbase
  307.  
  308.                 move.l  D5,D0
  309.                 addi.l  #ornull,D0
  310.                 move.l  SP,D1
  311.                 sub.l   A3,D1           ;make pointer relativ
  312.                 move.l  D1,0(A3,D0.l)   ;set returnstack
  313.  
  314.                 move.l  #(hello-datas),-(A6)
  315.                 move.l  #47,-(A6)
  316.                 bsr     type
  317.  
  318.                 jmp     (cold-(sys+of))(A5) ;jump into the system
  319.  
  320.  
  321. *************************************************************************
  322.                 ENDPART
  323.  
  324. *****************************************************************
  325.                 >PART 'vocabularies'
  326.  
  327. dovoca:         move.l  D5,D0           ;get user-pointer
  328.                 addi.l  #ovocpa,D0      ;add offset
  329.                 movea.l 0(A3,D0.l),A0   ;fetch address of voc-stack base
  330.                 adda.l  A3,A0           ;calc. abs. address
  331.                 adda.l  (A0),A0         ;fetch height of voc-stack
  332.                 movea.l (SP)+,A1        ;fetch address of voc-pointer
  333.                 move.l  (A1),D0
  334.                 move.l  D0,(A0)         ;save it on voc-stack
  335.                 rts
  336.  
  337. onlyvoc:        move.l  D5,D0
  338.                 addi.l  #ovocpa,D0
  339.                 move.l  0(A3,D0.l),D0
  340.                 move.l  #8,0(A3,D0.l)
  341.                 move.l  #(last_only-datas),4(A3,D0.l)
  342.                 bra.s   dovoca
  343.  
  344.  
  345. *------------------------------------------------
  346.                 DC.L 0
  347. only:           jsr     (onlyvoc-sys-of)(A5) ;only becomes transient context
  348.                 DC.L (last_only-datas) ;ptr to ptr to last lfa
  349. only_link:      DC.L 0
  350.  
  351.  
  352. *------------------------------------------------
  353.                 DC.L 0          ;view
  354. forth:          jsr     (dovoca-sys-of)(A5) ;makes forth transient context
  355.                 DC.L (last_forth-datas) ;ptr to ptr to last lfa
  356. forth_link:     DC.L (only_link-sys-of) ;voc-link, addr of this field of last voc.
  357.  
  358.  
  359. *------------------------------------------------
  360. first:          rts
  361.  
  362.                 ENDPART
  363.  
  364. *****************************************************************
  365.                 >PART 'DEFER primitive and PAUSE'
  366. *****************************************************************
  367. * DEFER-runtime primitive                                       *
  368. *****************************************************************
  369. dodefer:        movea.l (SP)+,A0
  370.                 move.l  (A0),D0         ;fetch pointer to pointer to code
  371.                 movea.l 0(A3,D0.l),A0   ;fetch pointer to code
  372.                 adda.l  A5,A0           ;make it absolute
  373.                 jmp     (A0)            ;and branch
  374.  
  375.  
  376.                 DC.L 0
  377. pause:          jsr     (dodefer-sys-of)(A5) ;s.u.
  378.                 DC.L (pauseptr-datas) ; ' unknown IS notfound
  379. *                rts
  380.  
  381.                 ENDPART
  382.  
  383. *****************************************************************
  384.                 >PART 'I/O-words'
  385. *****************************************************************
  386.                 DC.L 0          ;VIEW
  387. osexpect:       move.l  D5,D0
  388.                 addi.l  #ospan,D0
  389.                 clr.l   0(A3,D0.l)      ;clear span
  390.                 move.l  (A6)+,D2        ;get count
  391.                 move.l  (A6)+,D1        ;get address(offset)
  392.                 dbra    D2,osexp_loop
  393. osexp_loop:     bsr     key
  394.  
  395.                 move.l  D5,D0
  396.                 addi.l  #ospan,D0
  397.                 addq.l  #1,0(A3,D0.l)   ;increase span
  398.                 cmpi.b  #CR,3(A6)       ;is character a cr?
  399.                 beq.s   abort_osexp     ;then exit
  400.                 cmpi.b  #BKSP,3(A6)     ;maybe a backspace?
  401.                 bne.s   osexp_emit      ;if not, then EMIT the character
  402.                 addq.l  #1,D2           ;increase counter
  403.                 clr.b   0(A3,D1.l)      ;clear character
  404.                 subq.l  #1,0(A3,D0.l)   ;SPAN--
  405.                 beq.s   osexp_noemit    ;then there's nothing to emit
  406.                 movem.l D1-D2,-(SP)     ;save registers
  407.                 move.l  #BKSP,-(A6)     ;we want to emit backspace
  408.                 bsr     emit            ;do the emit
  409.                 move.l  #$20,-(A6)      ;we want to emit space
  410.                 bsr     emit            ;do the emit
  411.                 bsr     emit            ;second BKSP
  412.                 movem.l (SP)+,D1-D2     ;restore registers
  413.  
  414.                 subq.l  #1,D1           ;decrease pointer
  415.                 clr.b   0(A3,D1.l)      ;clear character
  416.                 move.l  D5,D0
  417.                 addi.l  #ospan,D0
  418.                 subq.l  #1,0(A3,D0.l)   ;decrease span
  419.                 bra.s   osexp_loop
  420.  
  421. osexp_emit:     move.b  3(A6),0(A3,D1.l)
  422.                 addq.l  #1,D1
  423.                 movem.l D1-D2,-(SP)
  424.                 bsr     emit
  425.                 movem.l (SP)+,D1-D2
  426. osexp_noemit:   dbra    D2,osexp_loop
  427. osexp_end:      rts
  428. abort_osexp:    subq.l  #1,D1           ;decrease pointer
  429.  
  430.                 move.l  D5,D0
  431.                 addi.l  #ospan,D0
  432.                 subq.l  #1,0(A3,D0.l)   ;decrease span
  433.                 addq.l  #4,A6           ;DROP
  434.                 rts
  435.  
  436.  
  437. *-------------------------------------------------------
  438.                 DC.L 0
  439. ostype:         move.l  (A6)+,D2        ;count
  440.                 move.l  (A6)+,D1        ;address
  441.                 dbra    D2,ostype_loop
  442.                 bra.s   ostype_end
  443. ostype_loop:    tst.b   0(A3,D1.l)
  444.                 beq.s   ostype_end
  445.                 clr.l   -(A6)
  446.                 move.b  0(A3,D1.l),3(A6)
  447.                 addq.l  #1,D1
  448.                 movem.l D1-D2,-(SP)
  449.                 bsr     emit
  450.                 movem.l (SP)+,D1-D2
  451.                 dbra    D2,ostype_loop
  452. ostype_end:     rts
  453.  
  454.                 ENDPART
  455.  
  456. *****************************************************************
  457.                 >PART 'some system words'
  458. *-------------------------------------------------------
  459.                 DC.L 0
  460. bye:            movea.l (saveret-datas)(A3),SP
  461.                 move.l  (bootsys-datas)(A3),-(SP)
  462.                 rts
  463.  
  464.  
  465. *-------------------------------------------------------
  466.                 DC.L 0
  467. b_cold:         move.l  #(tcold-datas),-(A6)
  468.                 rts
  469.  
  470. *-------------------------------------------------------
  471.                 DC.L 0
  472. systop:         move.l  (tsystop-datas)(A3),-(A6)
  473.                 rts
  474.  
  475.  
  476. *-------------------------------------------------------
  477.                 DC.L 0
  478. sysbot:         move.l  (tsysbot-datas)(A3),-(A6)
  479.                 rts
  480.  
  481.  
  482. *-------------------------------------------------------
  483.                 DC.L 0
  484. datatop:        move.l  (tdatatop-datas)(A3),-(A6)
  485.                 rts
  486.  
  487.  
  488. *-------------------------------------------------------
  489.                 DC.L 0
  490. databot:        move.l  (tdatabot-datas)(A3),-(A6)
  491.                 rts
  492.  
  493. *-------------------------------------------------------
  494.                 DC.L 0
  495. forthparas:     move.l  (tforthparas-datas)(A3),-(A6)
  496.                 rts
  497.  
  498. *-------------------------------------------------------
  499.                 DC.L 0
  500. roottable:      move.l  (troot-datas)(A3),-(A6)
  501.                 rts
  502.  
  503. *-------------------------------------------------------
  504.                 DC.L 0
  505. keys:           move.l  (tkeys-datas)(A3),-(A6)
  506.                 rts
  507.  
  508. *-------------------------------------------------------
  509.                 DC.L 0
  510. key_quests:     move.l  (tkey_quests-datas)(A3),-(A6)
  511.                 rts
  512.  
  513. *-------------------------------------------------------
  514.                 DC.L 0
  515. emits:          move.l  (temits-datas)(A3),-(A6)
  516.                 rts
  517.  
  518. *-------------------------------------------------------
  519.                 DC.L 0
  520. r_ws:           move.l  (tr_ws-datas)(A3),-(A6)
  521.                 rts
  522.  
  523. *-------------------------------------------------------
  524.                 DC.L 0
  525. readsyses:      move.l  (treadsyses-datas)(A3),-(A6)
  526.                 rts
  527.  
  528. *-------------------------------------------------------
  529.                 DC.L 0
  530. writesyses:     move.l  (twritesyses-datas)(A3),-(A6)
  531.                 rts
  532.  
  533. *-------------------------------------------------------
  534.                 DC.L 0
  535. fence:          move.l  #(tfence-datas),-(A6)
  536.                 rts
  537.  
  538. *-------------------------------------------------------
  539.                 DC.L 0
  540. b_front_opt:    move.l  #(twritesyses-datas),-(A6)
  541.                 rts
  542.  
  543.  
  544. *-------------------------------------------------------
  545.                 DC.L 0
  546. b_end_opt:      move.l  #(tend_opt-datas),-(A6)
  547.                 rts
  548.  
  549.  
  550. *-------------------------------------------------------
  551.                 DC.L 0
  552. noop:           rts
  553.  
  554. *-------------------------------------------------------
  555.  
  556.                 DC.L 0
  557. ver:            move.l  #version,-(A6)
  558.                 rts
  559.  
  560.  
  561.                 ENDPART
  562.  
  563. *****************************************************************
  564.                 >PART 'USER variables'
  565.  
  566.                 DC.L 0
  567. nextuser:       move.l  D5,-(A6)        ;2 Bytes
  568.                 addi.l  #ounext,(A6)    ;6
  569.                 rts                     ;--------
  570. ;8 Bytes = 4 words
  571.                 DC.L 0
  572. r_null:         move.l  D5,-(A6)
  573.                 addi.l  #ornull,(A6)
  574.                 rts
  575.  
  576.                 DC.L 0
  577. s_null:         move.l  D5,-(A6)
  578.                 addi.l  #osnull,(A6)
  579.                 rts
  580.  
  581.                 DC.L 0
  582. f_null:         move.l  D5,-(A6)
  583.                 addi.l  #ofnull,(A6)
  584.                 rts
  585.  
  586.                 DC.L 0
  587. state:          move.l  D5,-(A6)
  588.                 addi.l  #ostate,(A6)
  589.                 rts
  590.  
  591.                 DC.L 0
  592. b_number_quest: move.l  D5,-(A6)
  593.                 addi.l  #onumber_quest,(A6)
  594.                 rts
  595.  
  596.                 DC.L 0
  597. base:           move.l  D5,-(A6)
  598.                 addi.l  #obase,(A6)
  599.                 rts
  600.  
  601.                 DC.L 0
  602. dpl:            move.l  D5,-(A6)
  603.                 addi.l  #odpl,(A6)
  604.                 rts
  605.  
  606.                 DC.L 0
  607. hld:            move.l  D5,-(A6)
  608.                 addi.l  #ohld,(A6)
  609.                 rts
  610.  
  611.                 DC.L 0
  612. cp:             move.l  D5,-(A6)
  613.                 addi.l  #odp,(A6)
  614.                 rts
  615.  
  616.                 DC.L 0
  617. dp:             move.l  D5,-(A6)
  618.  
  619.                 addi.l  #odata,(A6)
  620.                 rts
  621.  
  622.                 DC.L 0
  623. totib:          move.l  D5,-(A6)
  624.                 addi.l  #ototib,(A6)
  625.                 rts
  626.  
  627.                 DC.L 0
  628. _tib:           move.l  D5,-(A6)
  629.                 addi.l  #o_tib,(A6)
  630.                 rts
  631.  
  632.                 DC.L 0
  633. toin:           move.l  D5,-(A6)
  634.                 addi.l  #otoin,(A6)
  635.                 rts
  636.  
  637.                 DC.L 0
  638. span:           move.l  D5,-(A6)
  639.                 addi.l  #ospan,(A6)
  640.                 rts
  641.  
  642.                 DC.L 0
  643. current:        move.l  D5,-(A6)
  644.                 addi.l  #ocurrent,(A6)
  645.                 rts
  646.  
  647.                 DC.L 0
  648. voc_link:       move.l  D5,-(A6)
  649.                 addi.l  #ovoc_link,(A6)
  650.                 rts
  651.  
  652.                 DC.L 0
  653. vocpa:          move.l  D5,-(A6)
  654.                 addi.l  #ovocpa,(A6)
  655.                 rts
  656.  
  657.                 DC.L 0
  658. last:           move.l  D5,-(A6)
  659.                 addi.l  #olast,(A6)
  660.                 rts
  661.  
  662. ;                DC.L 0
  663. ;fence:          move.l  D5,-(A6)
  664. ;                addi.l  #ofence,(A6)
  665. ;                rts
  666.  
  667.                 DC.L 0
  668. b_error:        move.l  D5,-(A6)
  669.                 addi.l  #oerror,(A6)
  670.                 rts
  671.  
  672.                 DC.L 0
  673. b_key:          move.l  D5,-(A6)
  674.                 addi.l  #okey,(A6)
  675.                 rts
  676.  
  677.                 DC.L 0
  678. b_emit:         move.l  D5,-(A6)
  679.                 addi.l  #oemit,(A6)
  680.                 rts
  681.  
  682.                 DC.L 0
  683. b_key_quest:    move.l  D5,-(A6)
  684.                 addi.l  #okey_quest,(A6)
  685.                 rts
  686.  
  687.                 DC.L 0
  688. b_r_w:          move.l  D5,-(A6)
  689.                 addi.l  #or_w,(A6)
  690.                 rts
  691.  
  692.                 DC.L 0
  693. b_readsys:      move.l  D5,-(A6)
  694.                 addi.l  #oreadsys,(A6)
  695.                 rts
  696.  
  697.                 DC.L 0
  698. b_writesys:     move.l  D5,-(A6)
  699.                 addi.l  #owritesys,(A6)
  700.                 rts
  701.  
  702.                 DC.L 0
  703. t_key:          move.l  D5,-(A6)
  704.                 addi.l  #olkey,(A6)
  705.                 rts
  706.  
  707.                 DC.L 0
  708. t_emit:         move.l  D5,-(A6)
  709.                 addi.l  #olemit,(A6)
  710.                 rts
  711.  
  712.                 DC.L 0
  713. t_key_quest:    move.l  D5,-(A6)
  714.                 addi.l  #olkey_quest,(A6)
  715.                 rts
  716.  
  717.                 DC.L 0
  718. t_r_w:          move.l  D5,-(A6)
  719.                 addi.l  #olr_w,(A6)
  720.                 rts
  721.  
  722.                 DC.L 0
  723. t_readsys:      move.l  D5,-(A6)
  724.                 addi.l  #olreadsys,(A6)
  725.                 rts
  726.  
  727.                 DC.L 0
  728. t_writesys:     move.l  D5,-(A6)
  729.                 addi.l  #olwritesys,(A6)
  730.                 rts
  731.  
  732.  
  733.                 DC.L 0
  734. b_expect:       move.l  D5,-(A6)
  735.                 addi.l  #oexpect,(A6)
  736.                 rts
  737.  
  738.                 DC.L 0
  739. b_type:         move.l  D5,-(A6)
  740.                 addi.l  #otype,(A6)
  741.                 rts
  742.  
  743.                 DC.L 0
  744. b_literal:      move.l  D5,-(A6)
  745.                 addi.l  #oliteral,(A6)
  746.                 rts
  747.  
  748.                 DC.L 0
  749. b_fliteral:     move.l  D5,-(A6)
  750.                 addi.l  #ofliteral,(A6)
  751.                 rts
  752.  
  753.                 DC.L 0
  754. macro:          move.l  D5,-(A6)
  755.                 addi.l  #omacro,(A6)
  756.                 rts
  757.  
  758.                 DC.L 0
  759. is_macro:       move.l  D5,-(A6)
  760.                 addi.l  #ois_macro,(A6)
  761.                 rts
  762.  
  763.                 DC.L 0
  764. warning:        move.l  D5,-(A6)
  765.                 addi.l  #owarning,(A6)
  766.                 rts
  767.  
  768.                 DC.L 0
  769. fwidth:         move.l  D5,-(A6)
  770.                 addi.l  #ofwidth,(A6)
  771.                 rts
  772.  
  773.                 DC.L 0
  774. blk:            move.l  D5,-(A6)
  775.                 addi.l  #oblk,(A6)
  776.                 rts
  777.  
  778.  
  779.                 DC.L 0
  780. rootblk:        move.l  D5,-(A6)
  781.                 addi.l  #orootblk,(A6)
  782.                 rts
  783.  
  784.  
  785.                 DC.L 0
  786. prev:           move.l  D5,-(A6)
  787.                 addi.l  #oprev,(A6)
  788.                 rts
  789.  
  790.  
  791.                 DC.L 0
  792. userbufs:       move.l  D5,-(A6)
  793.                 addi.l  #ouserbufs,(A6)
  794.                 rts
  795.  
  796.                 DC.L 0
  797. caps:           move.l  D5,-(A6)
  798.                 addi.l  #ocaps,(A6)
  799.                 rts
  800.  
  801.                 DC.L 0
  802. udp:            move.l  D5,-(A6)
  803.                 addi.l  #oudp,(A6)
  804.                 rts
  805.  
  806.                 DC.L 0
  807. out:            move.l  D5,-(A6)
  808.                 addi.l  #oout,(A6)
  809.                 rts
  810.  
  811. *-----------------------------------------------------------
  812.                 DC.L 0
  813. pad:            move.l  D5,D0           ;2
  814.                 addi.l  #odata,D0       ;6
  815.                 move.l  0(A3,D0.l),D0   ;2
  816.                 move.l  D0,D1
  817.                 andi.l  #1,D0
  818.                 add.l   D1,D0
  819.                 addi.l  #$0100,D0
  820.                 move.l  D0,-(A6)        ;6
  821.                 rts
  822.  
  823.  
  824.                 DC.L 0
  825. here:           move.l  D5,D0
  826.                 addi.l  #odata,D0
  827.                 move.l  0(A3,D0.l),-(A6)
  828.                 rts
  829.  
  830.                 ENDPART
  831.  
  832. *****************************************************************
  833.                 >PART 'executing the words in vectors'
  834. *-----------------------------------------------------------
  835.                 DC.L 0
  836. number_quest:   move.l  D5,D0           ;2
  837.                 addi.l  #onumber_quest,D0 ;6
  838.                 move.l  0(A3,D0.l),D0   ;2
  839.                 jsr     0(A5,D0.l)      ;2
  840.                 rts
  841.  
  842. *-----------------------------------------------------------
  843.                 DC.L 0
  844. loaderkey:                              * jsr     (pause-sys-of)(A5)
  845.                 movem.l D1-A6,-(SP)
  846.                 move.l  (tforthparas-datas)(A3),D0
  847.                 pea     0(A3,D0.l)
  848.                 move.l  D5,D0
  849.                 addi.l  #olkey,D0
  850.                 movea.l 0(A3,D0.l),A0
  851.                 jsr     (A0)
  852.                 addq.l  #4,SP
  853.                 movem.l (SP)+,D1-A6
  854.                 move.l  D0,-(A6)
  855.                 rts
  856.  
  857. *-----------------------------------------------------------
  858.                 DC.L 0          ;( char -- )
  859. loaderemit:                             *jsr     (pause-sys-of)(A5)
  860.                 movem.l D1-A6,-(SP)
  861.                 move.l  (tforthparas-datas)(A3),D0
  862.                 pea     0(A3,D0.l)
  863.                 move.l  (A6),-(SP)
  864.                 move.l  D5,D0
  865.                 addi.l  #olemit,D0
  866.                 movea.l 0(A3,D0.l),A0
  867.                 jsr     (A0)
  868.                 addq.l  #8,SP
  869.                 movem.l (SP)+,D1-A6
  870.                 addq.l  #4,A6
  871.                 move.l  D5,D0
  872.                 addi.l  #oout,D0
  873.                 addq.l  #1,0(A3,D0.l)   ;increase OUT
  874.                 rts
  875.  
  876. *-----------------------------------------------------------
  877.                 DC.L 0
  878. loaderkey_quest:                        *jsr     (pause-sys-of)(A5)
  879.                 movem.l D1-A6,-(SP)
  880.                 move.l  (tforthparas-datas)(A3),D0
  881.                 pea     0(A3,D0.l)
  882.                 move.l  D5,D0
  883.                 addi.l  #olkey_quest,D0
  884.                 movea.l 0(A3,D0.l),A0
  885.                 jsr     (A0)
  886.                 addq.l  #4,SP
  887.                 movem.l (SP)+,D1-A6
  888.                 move.l  D0,-(A6)
  889.                 rts
  890.  
  891. *-----------------------------------------------------------
  892.                 DC.L 0
  893. loaderr_w:                              *jsr     (pause-sys-of)(A5)
  894.                 movem.l D1-A6,-(SP)
  895.                 move.l  (tforthparas-datas)(A3),D0
  896.                 pea     0(A3,D0.l)
  897.                 move.l  8(A6),D0
  898.                 add.l   A3,D0
  899.                 move.l  D0,8(A6)        ;make addr abs.
  900.                 move.l  (A6)+,-(SP)
  901.                 move.l  (A6)+,-(SP)
  902.                 move.l  (A6)+,-(SP)
  903.                 move.l  D5,D0           ;( addr block flag -- flag )
  904.                 addi.l  #olr_w,D0
  905.                 movea.l 0(A3,D0.l),A0
  906.                 jsr     (A0)
  907.                 lea     $10(SP),SP
  908.                 movem.l (SP)+,D1-A6
  909.                 lea     $0C(A6),A6
  910.                 move.l  D0,-(A6)
  911.                 rts
  912. *
  913. * flag = 0:     read
  914. * flag > 0:     write
  915. * flag < 0:     now write, may be changed in future
  916.  
  917.  
  918.                 DC.L 0
  919. loaderwritesys: movem.l D1-A6,-(SP)     ;( addr count -- flag )
  920.                 move.l  (tforthparas-datas)(A3),D0
  921.                 pea     0(A3,D0.l)
  922.                 move.l  A3,D0
  923.                 add.l   D0,4(A6)        ;make pointer absolute
  924.                 move.l  (A6)+,-(SP)
  925.                 move.l  (A6)+,-(SP)
  926.                 move.l  D5,D0
  927.                 addi.l  #olwritesys,D0
  928.                 movea.l 0(A3,D0.l),A0
  929.                 jsr     (A0)
  930.                 lea     $0C(SP),SP
  931.                 movem.l (SP)+,D1-A6
  932.                 addq.l  #8,A6
  933.                 move.l  D0,-(A6)
  934.                 rts
  935.  
  936. *-------------------------------------------------------
  937.                 DC.L 0
  938. loaderreadsys:  movem.l D1-A6,-(SP)     ;( addr count -- flag )
  939.                 move.l  (tforthparas-datas)(A3),D0
  940.                 pea     0(A3,D0.l)
  941.                 move.l  A3,D0
  942.                 add.l   D0,4(A6)        ;make pointer absolute
  943.                 move.l  (A6)+,-(SP)
  944.                 move.l  (A6)+,-(SP)
  945.                 move.l  D5,D0
  946.                 addi.l  #olreadsys,D0
  947.                 movea.l 0(A3,D0.l),A0
  948.                 jsr     (A0)
  949.                 lea     $0C(SP),SP
  950.                 movem.l (SP)+,D1-A6
  951.                 addq.l  #8,A6
  952.                 move.l  D0,-(A6)
  953.                 rts
  954.  
  955.  
  956. *-----------------------------------------------------------
  957.                 DC.L 0
  958. key:            bsr     pause
  959.                 move.l  D5,D0
  960.                 addi.l  #okey,D0
  961.                 move.l  0(A3,D0.l),D0
  962.                 jmp     0(A5,D0.l)
  963.  
  964.  
  965.                 DC.L 0
  966. key_quest:      bsr     pause
  967.                 move.l  D5,D0
  968.                 addi.l  #okey_quest,D0
  969.                 move.l  0(A3,D0.l),D0
  970.                 jmp     0(A5,D0.l)
  971.  
  972.  
  973.                 DC.L 0
  974. emit:           bsr     pause
  975.                 move.l  D5,D0
  976.                 addi.l  #oemit,D0
  977.                 move.l  0(A3,D0.l),D0
  978.                 jmp     0(A5,D0.l)
  979.  
  980.  
  981.                 DC.L 0
  982. r_w:            bsr     pause
  983.                 move.l  D5,D0
  984.                 addi.l  #or_w,D0
  985.                 move.l  0(A3,D0.l),D0
  986.                 jmp     0(A5,D0.l)
  987.  
  988.  
  989.  
  990.                 DC.L 0
  991. expect:         bsr     pause
  992.                 move.l  D5,D0
  993.                 addi.l  #oexpect,D0
  994.                 move.l  0(A3,D0.l),D0
  995.                 jmp     0(A5,D0.l)
  996.  
  997.  
  998. *-----------------------------------------------------------
  999.                 DC.L 0
  1000. type:           bsr     pause
  1001.                 move.l  D5,D0
  1002.                 addi.l  #otype,D0
  1003.                 move.l  0(A3,D0.l),D0
  1004.                 jmp     0(A5,D0.l)
  1005.  
  1006. *-------------------------------------------------------
  1007.  
  1008.  
  1009.                 DC.L 0
  1010. readsys:        bsr     pause
  1011.                 move.l  D5,D0
  1012.                 addi.l  #oreadsys,D0
  1013.                 move.l  0(A3,D0.l),D0
  1014.                 jmp     0(A5,D0.l)
  1015.  
  1016.  
  1017.                 DC.L 0
  1018. writesys:       bsr     pause
  1019.                 move.l  D5,D0
  1020.                 addi.l  #owritesys,D0
  1021.                 move.l  0(A3,D0.l),D0
  1022.                 jmp     0(A5,D0.l)
  1023.  
  1024.  
  1025.  
  1026. *---------------------------------------------------------------
  1027.  
  1028.  
  1029.  
  1030.                 ENDPART
  1031.  
  1032. *****************************************************************
  1033.                 >PART 'Compiler stuff'
  1034. *                                                               *
  1035. *****************************************************************
  1036.                 DC.L 0
  1037. komma:          move.l  D5,D0           ;( value -- )
  1038.                 addi.l  #odata,D0
  1039.                 move.l  0(A3,D0.l),D1
  1040.                 move.l  D1,D2
  1041.                 andi.l  #1,D2
  1042.                 add.l   D2,D1           ;make DP even
  1043.                 move.l  (A6)+,0(A3,D1.l) ;32b
  1044.                 addq.l  #4,D1           ;increment
  1045.                 move.l  D1,0(A3,D0.l)   ;new DP
  1046.                 rts
  1047.  
  1048.  
  1049. get_segment:    movem.l D0-D2,-(SP)     ;( addr -- codeoff segtableoff )
  1050.                 move.l  #-1,D0          ;init segment counter
  1051.                 move.l  (A6)+,D1        ;get addr
  1052.                 addi.l  #of,D1          ;make addr positiv
  1053. g_s_loop:       addq.l  #1,D0           ;increase segment counter
  1054.                 move.l  D1,D2
  1055.                 subi.l  #$010000,D1     ;decrease address by 64k
  1056.                 andi.l  #$FFFF0000,D2   ;is it < 64k
  1057.                 bne.s   g_s_loop        ;no? then try next segment
  1058.                 addi.l  #($010000-of),D1 ;take back last decrement
  1059.                 move.l  D1,-(A6)        ;push codeoffset
  1060.                 move.l  #(table-datas),D1 ;table base
  1061.                 lsl.l   #2,D0           ;*4, pointer to LONGs
  1062.                 add.l   D1,D0           ;rel. tableaddress
  1063.                 move.l  D0,-(A6)        ;push pointer to segment (in data)
  1064.                 movem.l (SP)+,D0-D2
  1065.                 rts
  1066.  
  1067.                 ENDPART
  1068.  
  1069. *****************************************************************
  1070.                 >PART 'JSR, creates code'
  1071. *                     of defined length (8 bytes)               *
  1072. *                                                               *
  1073. *       movea.l segoff(DT),seg          ( seg = A2 )            *
  1074. *       jsr     codeoff(seg)                                    *
  1075. *                                                               *
  1076. *****************************************************************
  1077.                 DC.L 0
  1078. jsr_komma:      movem.l D1-D2,-(SP)
  1079.                 move.l  D5,D0           ;( addr -- )
  1080.                 addi.l  #odp,D0
  1081.                 move.l  0(A3,D0.l),D1   ;fetch DP
  1082.                 move.l  D1,D2
  1083.                 andi.l  #1,D2
  1084.                 add.l   D2,D1           ;make DP even
  1085.                 lea     0(A5,D1.l),A0   ;calculate absolute address
  1086.                 bsr.s   get_segment     ;calculate seg & off
  1087.                 move.w  #move_seg_code,0(A5,D1.l) ;create opcode ...
  1088.                 addq.l  #2,A6
  1089.                 move.w  (A6)+,2(A5,D1.l) ;... with it's argument
  1090.                 move.w  #jsr_code,4(A5,D1.l) ;create opcode ...
  1091.                 addq.l  #2,A6
  1092.                 move.w  (A6)+,6(A5,D1.l) ;... with it's argument
  1093.                 addq.l  #8,D1
  1094.                 move.l  D1,0(A3,D0.l)   ;new DP
  1095.                 movem.l (SP)+,D1-D2
  1096.                 rts
  1097.  
  1098.                 ENDPART
  1099.  
  1100. *****************************************************************
  1101.                 >PART 'THE COMPILER'
  1102. *                                                                       *
  1103. *************************************************************************
  1104.                 DC.L 0
  1105. com_komma:      movem.l D0-D2/A0-A1,-(SP) ;( CFA -- )
  1106.                 move.l  (tfront_opt-datas)(A3),D0 ;front_OPT
  1107.                 jsr     0(A5,D0.l)      ;execute
  1108.                 move.l  D5,D0
  1109.                 addi.l  #odp,D0
  1110.                 move.l  0(A3,D0.l),D1   ;fetch DP
  1111.                 move.l  D1,D2
  1112.                 andi.l  #1,D2
  1113.                 add.l   D2,D1           ;make DP even
  1114.  
  1115.                 move.l  D5,D0
  1116.                 addi.l  #omacro,D0
  1117.                 tst.l   0(A3,D0.l)      ;soll ein Macro kompiliert werden?
  1118.                 beq.s   com_no_macro    ;dann eben nicht
  1119.                 move.l  (A6),D0         ;cfa to d0
  1120.                 btst    #3,-1(A3,D0.l)  ;Macrobit gesetzt?
  1121.                 beq.s   com_no_macro    ;wenn nicht, dann normal kompilieren
  1122.                 addq.l  #4,A6           ;drop cfa
  1123.                 move.b  -2(A3,D0.l),D2  ;Codelänge holen (#Worte)
  1124.                 and.l   #$FF,D2         ;maskieren
  1125.                 movea.l A5,A0
  1126.                 adda.l  0(A3,D0.l),A0   ;fetch pfa = cfa @       > abs. address
  1127.                 dbra    D2,com_macro_loop
  1128.                 bra     com_kom_end
  1129. com_macro_loop: move.w  (A0)+,0(A5,D1.l) ;Code wortweise übertragen
  1130.                 addq.l  #2,D1
  1131.                 dbra    D2,com_macro_loop
  1132.                 bra     com_kom_end
  1133. com_no_macro:   move.l  (A6),D0         ;cfa
  1134.                 move.l  0(A3,D0.l),(A6) ;@
  1135.                 move.l  D5,D0
  1136.                 addi.l  #ois_macro,D0
  1137.                 tst.l   0(A3,D0.l)      ;soll es ein Macro werden?
  1138.                 bne.s   com_no_bsr      ;dann darf kein BSR kompiliert werden
  1139.                 move.l  D1,D0
  1140.                 addq.l  #2,D0
  1141.                 sub.l   (A6),D0         ;rel. Adressdistanz
  1142.                 cmp.l   #$80,D0         ;>128 Byte
  1143.                 bpl.s   no_bsr_word
  1144.                 neg.b   D0
  1145.                 addq.l  #4,A6
  1146.                 move.b  #bsrb_code,0(A5,D1.l)
  1147.                 move.b  D0,1(A5,D1.l)
  1148.                 addq.l  #2,D1
  1149.                 bra.s   com_kom_end
  1150. no_bsr_word:    cmp.l   #$8000,D0       ;>32k?
  1151.                 bpl.s   com_no_bsr      ;dann kompiliere direkten Sprung
  1152.                 neg.w   D0              ;Sprung soll zurück führen
  1153.                 addq.l  #4,A6           ;drop adr
  1154.                 move.w  #bsr_code,0(A5,D1.l)
  1155.                 move.w  D0,2(A5,D1.l)
  1156.                 addq.l  #4,D1
  1157.                 bra.s   com_kom_end
  1158.  
  1159. com_no_bsr:     bsr     get_segment
  1160.                 move.l  (A6)+,D0        ;get pointer to segment
  1161.                 cmpi.l  #(table-datas),D0 ;segment = rootsegment?
  1162.                 beq.s   com_jsr_SB
  1163.                 move.w  #move_seg_code,0(A5,D1.l) ;create opcode ...
  1164.                 move.w  D0,2(A5,D1.l)   ;... with it's argument
  1165.                 addq.l  #4,D1
  1166. com_jsr_seg:    move.w  #jsr_code,0(A5,D1.l) ;create opcode ...
  1167.                 addq.l  #2,A6
  1168.                 move.w  (A6)+,2(A5,D1.l) ;... with it's argument
  1169.                 addq.l  #4,D1
  1170.                 bra.s   com_kom_end
  1171. com_jsr_SB:     move.w  #jsrSB_code,0(A5,D1.l) ;create opcode ...
  1172.                 addq.l  #2,A6
  1173.                 move.w  (A6)+,2(A5,D1.l) ;... with it's argument
  1174.                 addq.l  #4,D1
  1175. com_kom_end:    move.l  D5,D0
  1176.                 addi.l  #odp,D0
  1177.                 move.l  D1,0(A3,D0.l)
  1178.                 move.l  (tend_opt-datas)(A3),D0 ;front_OPT
  1179.                 jsr     0(A5,D0.l)      ;execute
  1180.                 movem.l (SP)+,D0-D2/A0-A1
  1181.                 rts
  1182.  
  1183.                 ENDPART
  1184.  
  1185. *****************************************************************
  1186.                 >PART 'compiler utilities, used later'
  1187. *                                                               *
  1188. *****************************************************************
  1189.                 DC.L 0
  1190. code_komma:     move.l  D5,D0
  1191.                 addi.l  #odp,D0
  1192.                 move.l  0(A3,D0.l),D1
  1193.                 move.l  (A6)+,0(A5,D1.l)
  1194. *                addq.l  #4,d1
  1195.                 addi.l  #4,0(A3,D0.l)
  1196.                 rts
  1197.  
  1198.                 DC.L 0
  1199. code_wkomma:    move.l  D5,D0
  1200.                 addi.l  #odp,D0
  1201.                 move.l  0(A3,D0.l),D1
  1202.                 addq.l  #2,A6
  1203.                 move.w  (A6)+,0(A5,D1.l)
  1204.                 addq.l  #2,D1
  1205.                 move.l  D1,0(A3,D0.l)
  1206.                 rts
  1207.  
  1208.  
  1209.                 DC.L 0
  1210. jsrSB_komma:    move.l  D5,D0           ;( codeaddr -- )
  1211.                 addi.l  #odp,D0
  1212.                 move.l  0(A3,D0.l),D1
  1213.                 move.w  #jsrSB_code,0(A5,D1.l)
  1214.                 addq.l  #2,A6
  1215.                 move.w  (A6)+,2(A5,D1.l)
  1216.                 addq.l  #4,D1
  1217.                 move.l  D1,0(A3,D0.l)
  1218.                 rts
  1219.  
  1220.  
  1221.  
  1222.  
  1223.                 DC.L 0
  1224. wkomma:         move.l  D5,D0           ;( value16 -- )
  1225.                 addi.l  #odata,D0
  1226.                 move.l  0(A3,D0.l),D1
  1227.                 move.l  D1,D2
  1228.                 andi.l  #1,D2
  1229.                 add.l   D2,D1           ;make DP even
  1230.                 addq.l  #2,A6           ;stack: long>word
  1231.                 move.w  (A6)+,0(A3,D1.l) ;16b
  1232.                 addq.l  #2,D1           ;increment
  1233.                 move.l  D1,0(A3,D0.l)   ;new DP
  1234.                 rts
  1235.  
  1236.  
  1237.                 DC.L 0
  1238. ckomma:         move.l  D5,D0           ;( value8 -- )
  1239.                 addi.l  #odata,D0
  1240.                 move.l  0(A3,D0.l),D1   ;fetch DP
  1241.                 addq.l  #3,A6           ;
  1242.                 move.b  (A6)+,0(A3,D1.l) ;8b
  1243.                 addq.l  #1,D1           ;increment
  1244.                 move.l  D1,0(A3,D0.l)   ;new DP
  1245.                 rts
  1246.  
  1247.                 DC.L 0
  1248. fkomma:         move.l  D5,D0
  1249.                 addi.l  #odata,D0
  1250.                 move.l  0(A3,D0.l),D1   ;fetch DP
  1251.                 move.l  D1,D2
  1252.                 andi.l  #1,D2
  1253.                 add.l   D2,D1           ;make DP even
  1254.                 move.l  D5,D0
  1255.                 addi.l  #ofwidth,D0
  1256.                 move.l  0(A3,D0.l),D0
  1257.                 lsr.l   #2,D0
  1258.                 subq.l  #1,D0
  1259. f_komma_loop:   move.l  (A4)+,0(A3,D1.l)
  1260.                 addq.l  #4,D1
  1261.                 dbra    D0,f_komma_loop
  1262.                 move.l  D5,D0
  1263.                 addi.l  #odata,D0
  1264.                 move.l  D1,0(A3,D0.l)
  1265.                 rts
  1266.  
  1267.                 ENDPART
  1268.  
  1269. *****************************************************************
  1270.                 >PART 'Arithmetic'
  1271. *****************************************************************
  1272.                 DC.L 0
  1273. plus_store:     move.l  (A6)+,D1
  1274.                 move.l  0(A3,D1.l),D0
  1275.                 add.l   (A6)+,D0
  1276.                 move.l  D0,0(A3,D1.l)
  1277.                 rts
  1278.  
  1279.                 DC.L 0
  1280. plus:           move.l  (A6)+,D0
  1281.                 add.l   D0,(A6)
  1282.                 rts
  1283.  
  1284.                 DC.L 0
  1285. minus:          move.l  (A6)+,D0
  1286.                 sub.l   D0,(A6)
  1287.                 rts
  1288.  
  1289.                 DC.L 0
  1290. mult:           move.l  (A6)+,D0
  1291.                 move.l  (A6),D1
  1292.                 move.l  D0,D2
  1293.                 move.l  D0,D3
  1294.                 swap    D3
  1295.                 move.l  D1,D4
  1296.                 swap    D4
  1297.                 mulu    D1,D0
  1298.                 mulu    D3,D1
  1299.                 mulu    D4,D2
  1300.                 swap    D0
  1301.                 add.w   D1,D0
  1302.                 add.w   D2,D0
  1303.                 swap    D0
  1304.                 move.l  D0,(A6)
  1305.                 rts
  1306.  
  1307.                 DC.L 0
  1308. udivmod:        move.l  (A6)+,D0        ;Divisor
  1309.                 move.l  (A6),D1         ;Divident
  1310.                 tst.l   D0
  1311.                 bne.s   udi_noerr
  1312. *                divu    #0,d0           ;force trap
  1313.                 move.l  #$FFFFFFFF,-(A6)
  1314.                 rts
  1315. udi_noerr:      cmp.l   D0,D1
  1316.                 bhi.s   dent_gt_isor
  1317.                 beq.s   dent_eq_isor
  1318. dent_ls_isor:   clr.l   -(A6)
  1319.                 rts
  1320. dent_eq_isor:   clr.l   (A6)
  1321.                 move.l  #1,-(A6)
  1322.                 rts
  1323. dent_gt_isor:   moveq   #31,D2          ;Bitzähler
  1324.                 moveq   #0,D3           ;darin wird geschoben
  1325.                 moveq   #0,D4           ;für das Ergebnis
  1326. udivmod0:       add.l   D3,D3           ;2*
  1327.                 add.l   D4,D4
  1328.                 btst    D2,D1           ;Bit gesetzt?
  1329.                 beq.s   udivmod1
  1330.                 bset    #0,D3
  1331. udivmod1:       cmp.l   D3,D0           ;d3<d0?
  1332.                 bgt.s   udivmod2        ;dann nichts machen
  1333.                 sub.l   D0,D3           ;abziehen
  1334.                 bset    #0,D4
  1335. udivmod2:       subq.l  #1,D2
  1336.                 bpl.s   udivmod0
  1337.                 move.l  D3,(A6)
  1338.                 move.l  D4,-(A6)
  1339.                 rts
  1340.  
  1341.  
  1342.                 DC.L 0
  1343. divmod:         moveq   #0,D0
  1344.                 move.l  (A6),D1
  1345.                 bpl.s   divmod1         ;wenn nicht dann weiter
  1346.                 bset    #0,D0
  1347.                 bset    #1,D0           ;sonst Flag setzen ...
  1348.                 neg.l   (A6)            ;und negieren
  1349.                 neg.l   D1
  1350. divmod1:        tst.l   4(A6)           ;das gleiche für Dividenden
  1351.                 bpl.s   divmod2
  1352.                 bchg    #1,D0
  1353.                 neg.l   4(A6)
  1354. divmod2:        movem.l D0-D1,-(SP)     ;Flag merken
  1355.                 bsr.s   udivmod
  1356.                 movem.l (SP)+,D0-D1
  1357.                 btst    #1,D0           ;bei ungleichen Vorzeichen ...
  1358.                 beq.s   divmod3
  1359.                 tst.l   4(A6)
  1360.                 beq.s   divmod5
  1361.                 addq.l  #1,(A6)         ;Betrag d. Quotienten erhöhen ...
  1362.                 sub.l   4(A6),D1        ;Divisor-Rest
  1363.                 move.l  D1,4(A6)
  1364.                 neg.l   (A6)
  1365. divmod3:        btst    #0,D0           ;Divisor negativ? (Bit NICHT gesetzt)
  1366.                 beq.s   divmod4
  1367.                 neg.l   4(A6)           ;Rest --> -Rest
  1368. divmod4:        rts
  1369. divmod5:        neg.l   (A6)            ;Quotient negieren
  1370.                 rts
  1371.  
  1372.                 DC.L 0
  1373. div:            bsr.s   divmod
  1374.                 move.l  (A6)+,(A6)
  1375.                 rts
  1376.  
  1377.                 DC.L 0
  1378. muldivmod:      move.l  (A6)+,-(SP)
  1379.                 bsr     mult
  1380.                 move.l  (SP)+,-(A6)
  1381.                 bsr.s   divmod
  1382.                 rts
  1383.  
  1384.                 DC.L 0
  1385. muldiv:         bsr.s   muldivmod
  1386.                 move.l  (A6)+,(A6)
  1387.                 rts
  1388.  
  1389.                 DC.L 0
  1390. and:            move.l  (A6)+,D0
  1391.                 and.l   D0,(A6)
  1392.                 rts
  1393.  
  1394.                 DC.L 0
  1395. or:             move.l  (A6)+,D0
  1396.                 or.l    D0,(A6)
  1397.                 rts
  1398.  
  1399.                 DC.L 0
  1400. xor:            move.l  (A6)+,D0
  1401.                 eor.l   D0,(A6)
  1402.                 rts
  1403.  
  1404.                 DC.L 0
  1405. not:            not.l   (A6)
  1406.                 rts
  1407.  
  1408.                 DC.L 0
  1409. negate:         neg.l   (A6)
  1410.                 rts
  1411.  
  1412.                 DC.L 0
  1413. abs:            tst.l   (A6)
  1414.                 bpl.s   abs_end
  1415.                 neg.l   (A6)
  1416. abs_end:        rts
  1417.  
  1418.  
  1419.                 ENDPART
  1420.  
  1421. *****************************************************************
  1422.                 >PART 'ALLOT, EXIT, EXECUTE'
  1423. *----------------------------------------------------------------------
  1424.                 DC.L 0
  1425. allot:          move.l  D5,D0
  1426.                 addi.l  #odata,D0
  1427.                 move.l  0(A3,D0.l),D1
  1428.                 add.l   (A6)+,D1
  1429.                 move.l  D1,0(A3,D0.l)
  1430.                 rts
  1431.  
  1432.                 DC.L 0
  1433. exit:           move.l  D5,D0
  1434.                 addi.l  #odp,D0
  1435.                 move.l  0(A3,D0.l),D1
  1436.                 move.w  #rts_code,0(A5,D1.l)
  1437.                 addq.l  #2,D1
  1438.                 move.l  D1,0(A3,D0.l)
  1439.                 rts
  1440.  
  1441.  
  1442.                 DC.L 0
  1443. execute:        move.l  (A6)+,D0
  1444.                 jmp     0(A5,D0.l)
  1445.  
  1446.                 ENDPART
  1447.  
  1448. *****************************************************************
  1449.                 >PART 'basic stack manipulations'
  1450. *****************************************************************
  1451.                 DC.L 0
  1452. sp_fetch:       move.l  A6,D0           ;get stackpointer
  1453.                 sub.l   A3,D0           ;make it relativ in DT
  1454.                 move.l  D0,-(A6)        ;push it on the stack
  1455.                 rts
  1456.  
  1457.  
  1458.                 DC.L 0
  1459. sp_store:       move.l  (A6)+,D0
  1460.                 add.l   A3,D0
  1461.                 movea.l D0,A6
  1462.                 rts
  1463.  
  1464.  
  1465.                 DC.L 0
  1466. to_r:           movea.l (SP),A0         ;Rücksprung sichern
  1467.                 move.l  (A6)+,D0
  1468.                 add.l   A5,D0           ;calculate abs. address
  1469.                 move.l  D0,(SP)
  1470.                 jmp     (A0)            ;statt RTS
  1471.  
  1472.                 DC.L 0
  1473. r_from:         movea.l (SP)+,A0        ;Rücksprung sichern
  1474.                 move.l  (SP)+,D0
  1475.                 sub.l   A5,D0           ;make pointer relativ
  1476.                 move.l  D0,-(A6)
  1477.                 jmp     (A0)            ;statt RTS
  1478.  
  1479.                 DC.L 0
  1480. r_fetch:        move.l  4(SP),D0
  1481.                 sub.l   A5,D0
  1482.                 move.l  D0,-(A6)
  1483.                 rts
  1484.  
  1485.                 ENDPART
  1486.  
  1487. *****************************************************************
  1488.                 >PART 'I/O basics'
  1489. *****************************************************************
  1490.                 DC.L 0
  1491. cr:             move.l  #$0D,-(A6)
  1492.                 bsr     emit
  1493.                 move.l  #$0A,-(A6)
  1494.                 bsr     emit
  1495.                 move.l  D5,D0
  1496.                 addi.l  #oout,D0
  1497.                 clr.l   0(A3,D0.l)
  1498.                 rts
  1499.  
  1500.  
  1501.                 DC.L 0
  1502. space:          move.l  #$20,-(A6)
  1503.                 bsr     emit
  1504.                 rts
  1505.  
  1506.                 ENDPART
  1507.  
  1508. *****************************************************************
  1509.                 >PART 'compiling numbers'
  1510. *****************************************************************
  1511.                 DC.L 0
  1512. lit:            move.l  D5,D0           ;( number -- )
  1513.                 addi.l  #odp,D0
  1514.                 move.l  0(A3,D0.l),D1   ; CP @
  1515.                 move.w  #moveimm_sp,0(A5,D1.l) ; codew,
  1516.                 move.l  (A6)+,2(A5,D1.l) ; code,
  1517.                 addq.l  #6,D1           ;increment CP
  1518.                 move.l  D1,0(A3,D0.l)   ;write it back
  1519.                 rts
  1520.  
  1521.  
  1522.                 DC.L 0
  1523. literal:        move.l  D5,D0
  1524.                 addi.l  #oliteral,D0
  1525.                 move.l  0(A3,D0.l),D0
  1526.                 jmp     0(A5,D0.l)
  1527.  
  1528.  
  1529.  
  1530.                 DC.L 0
  1531. floatlit:       move.l  D5,D0
  1532.                 addi.l  #ofwidth,D0
  1533.                 move.l  0(A3,D0.l),D0
  1534.                 move.l  D0,D1
  1535.                 lsr.l   #2,D0
  1536.                 subq.l  #1,D0
  1537.                 movea.l (SP)+,A0
  1538.                 movea.l A0,A1           ;save a0 for return
  1539.                 movea.l (A0),A0         ;fetch pointer in  DT
  1540.                 adda.l  A3,A0           ;calculate abs. address
  1541.                 adda.l  D1,A0           ;point to end of float
  1542. flit_loop:      move.l  -(A0),-(A4)
  1543.                 dbra    D0,flit_loop
  1544.                 jmp     4(A1)
  1545.  
  1546.  
  1547.                 DC.L 0
  1548. flit:           move.l  #(floatlit-sys-of),-(A6) ;floatlit
  1549.                 bsr     jsrSB_komma     ;compile
  1550.                 move.l  D5,D0
  1551.                 addi.l  #odata,D0
  1552.                 move.l  0(A3,D0.l),-(A6) ;data @
  1553.                 bsr     code_komma
  1554. *                move.l  d5,d0
  1555. *                addi.l  #odp,d0
  1556. *                move.l  (a3,d0.l),d1
  1557. *                move.l  d2,(a5,d1.l)
  1558. *                addi.l  #4,(a3,d0.l)    ; ',' in code segment
  1559.                 bsr     fkomma          ;compile number in data segment
  1560.                 rts
  1561.  
  1562.  
  1563.                 DC.L 0
  1564. fliteral:       move.l  D5,D0
  1565.                 addi.l  #ofliteral,D0
  1566.                 move.l  0(A3,D0.l),D0
  1567.                 jmp     0(A5,D0.l)
  1568.  
  1569.  
  1570.                 ENDPART
  1571.  
  1572. *****************************************************************
  1573.                 >PART 'runtimes for strings and error'
  1574. *****************************************************************
  1575.  
  1576.                 DC.L 0
  1577. b_str_quote:    movem.l D0/A0,-(A6)
  1578.                 movea.l (SP)+,A0        ;get pointer to stringaddress
  1579.                 move.l  (A0),D0         ;get string address
  1580.                 adda.l  #4,A0           ;increace return pointer
  1581.                 move.l  A0,-(SP)        ;push it back on the stack
  1582.                 move.l  D0,-(SP)        ;save ptr to text there, too
  1583.                 movem.l (A6)+,D0/A0     ;restore registers
  1584.                 move.l  (SP)+,-(A6)     ;move result
  1585.                 rts
  1586.  
  1587.  
  1588.                 DC.L 0
  1589. b_string_emit:  movem.l D0/A0,-(A6)
  1590.                 movea.l (SP)+,A0        ;get pointer to stringaddress
  1591.                 move.l  (A0),D0         ;get string address
  1592.                 adda.l  #4,A0           ;increace return pointer
  1593.                 move.l  A0,-(SP)        ;pd5h it back on the stack
  1594.                 move.l  D0,-(A6)        ;push strings address
  1595.                 addq.l  #1,(A6)         ;for countbyte
  1596.                 clr.l   -(A6)           ;prepare stack for byte op.
  1597.                 move.b  0(A3,D0.l),3(A6) ;push countbyte
  1598.                 bsr     type            ;emit the string
  1599.                 movem.l (A6)+,D0/A0     ;restore registers
  1600.                 rts
  1601.  
  1602.  
  1603.                 DC.L 0
  1604. b_error_quote:  tst.l   (A6)+           ;Flag testen
  1605.                 beq.s   end_b_error_quote ;Fehlerbehandlung nicht ausführen
  1606.                 move.l  (A6)+,D1        ;Stringadresse
  1607.                 moveq   #0,D0
  1608.                 move.b  0(A3,D1.l),D0   ;Länge
  1609.                 addq.l  #1,D1
  1610.                 move.l  D1,-(A6)        ;Adresse
  1611.                 move.l  D0,-(A6)        ;count
  1612.                 bsr     type            ;String, der Fehler erzeugt hat, ausgeben
  1613.                 movea.l (SP)+,A0        ;Stringadresse holen
  1614.                 move.l  (A0),D1         ;fetch rel. pointer
  1615.                 moveq   #0,D0
  1616.                 move.b  0(A3,D1.l),D0   ;get length
  1617.                 addq.l  #1,D1
  1618.                 move.l  D1,-(A6)
  1619.                 move.l  D0,-(A6)
  1620.                 bsr     type            ;Fehlermeldung ausgeben
  1621.                 bsr     space
  1622.                 move.l  D5,D0
  1623.                 addi.l  #oerror,D0
  1624.                 move.l  0(A3,D0.l),D0
  1625.                 jmp     0(A5,D0.l)      ;über Fehlervektor raus
  1626. end_b_error_quote:
  1627.                 addi.l  #4,(SP)
  1628.                 rts
  1629.  
  1630.  
  1631.                 DC.L 0
  1632. b_abort_quote:  tst.l   (A6)+           ;Flag testen
  1633.                 beq.s   end_b_abort_quote ;Fehlerbehandlung nicht ausführen
  1634.                 movea.l (SP)+,A0        ;Stringadresse holen
  1635.                 move.l  (A0),D1         ;fetch rel. pointer
  1636.                 moveq   #0,D0
  1637.                 move.b  0(A3,D1.l),D0   ;get length
  1638.                 addq.l  #1,D1
  1639.                 move.l  D1,-(A6)
  1640.                 move.l  D0,-(A6)
  1641.                 bsr     type            ;Fehlermeldung ausgeben
  1642.                 bsr     space
  1643.                 move.l  D5,D0
  1644.                 addi.l  #oerror,D0
  1645.                 move.l  0(A3,D0.l),D0
  1646.                 jmp     0(A5,D0.l)      ;über Fehlervektor raus
  1647. end_b_abort_quote:
  1648.                 addi.l  #4,(SP)
  1649.                 rts
  1650.  
  1651.                 ENDPART
  1652.  
  1653. *****************************************************************
  1654.                 >PART 'mass storage interface'
  1655. *                                                               *
  1656. *****************************************************************
  1657. *                                                               *
  1658. *       structure of a buffer:                                  *
  1659. *                                                               *
  1660. *       1.      bufheader (14 bytes) RAM only                   *
  1661. *       2.      bufheader (48 bytes) on disk too                *
  1662. *       3.      data      (2000 bytes) on disk                      *
  1663. *                                                               *
  1664. *                                                               *
  1665. *       1.)                                                     *
  1666. *               pointer to next buffer (cyclic)                 *
  1667. *               phys. blocknumber                               *
  1668. *               log. blocknumber (yet unused)                   *
  1669. *               UPDATE  flag                                    *
  1670. *                                                               *
  1671. *       2.)                                                     *
  1672. *               yet unused                                      *
  1673. *                                                               *
  1674. *****************************************************************
  1675.  
  1676.                 DC.L 0
  1677. quest_core:     move.l  D5,D1           ;( blk -- bufaddr|ff )
  1678.                 addi.l  #oprev,D1
  1679.                 move.l  0(A3,D1.l),D1
  1680.                 move.l  D1,D0
  1681.                 move.l  (A6)+,D2        ;blk
  1682. q_core_loop:    cmp.l   4(A3,D0.l),D2   ;aktiv?
  1683.                 beq.s   q_core_found
  1684.                 move.l  0(A3,D0.l),D0   ;link to next buffer
  1685.                 cmp.l   D1,D0           ;first buffer again?
  1686.                 beq.s   q_core_notfound
  1687.                 bra.s   q_core_loop
  1688. q_core_found:   move.l  D0,-(A6)        ;push address of buffer
  1689.                 rts
  1690. q_core_notfound:clr.l   -(A6)           ;FALSE
  1691.                 rts
  1692.  
  1693.  
  1694.                 DC.L 0
  1695. lastblk:        move.l  #(lastblkptr-datas),-(A6)
  1696.                 rts
  1697.  
  1698.  
  1699.                 DC.L 0
  1700. lastbuf:        move.l  #(lastbufptr-datas),-(A6)
  1701.                 rts
  1702.  
  1703.  
  1704.                 DC.L 0
  1705. b_buffer:       move.l  (A6),-(SP)      ;( blk -- addr )
  1706.                 bsr.s   quest_core
  1707.                 tst.l   (A6)            ;block already in memory?
  1708.                 bne.s   buf_ok
  1709.                 move.l  D5,D1
  1710.                 addi.l  #oprev,D1
  1711.                 move.l  0(A3,D1.l),D0   ; PREV @
  1712.                 move.l  0(A3,D0.l),D0   ; latest used buffer
  1713.                 tst.w   $0C(A3,D0.l)    ; UPDATE ?
  1714.                 beq.s   nosave
  1715.                 move.l  D0,-(SP)
  1716.                 move.l  D0,-(A6)        ;address
  1717.                 addi.l  #$0E,(A6)       ;pointer to block
  1718.                 move.l  4(A3,D0.l),-(A6) ;phys. block
  1719.                 move.l  #1,-(A6)        ;flag: write
  1720.                 bsr     r_w
  1721.                 move.l  (SP)+,D0
  1722.                 clr.w   $0C(A3,D0.l)    ;clear UPDATE
  1723.                 tst.l   (A6)+
  1724.                 beq.s   buffer_err
  1725. nosave:         move.l  D0,(A6)
  1726. buf_ok:         move.l  (SP)+,4(A3,D0.l) ;new (or old) phys. block
  1727.                 move.l  D5,D0
  1728.                 addi.l  #oprev,D0
  1729.                 move.l  (A6),0(A3,D0.l) ;mark new PREV
  1730.                 addi.l  #(14+48),(A6)   ;pointer to data
  1731.                 rts
  1732. buffer_err:     addq.l  #4,SP
  1733.                 addq.l  #4,A6
  1734.                 move.l  #-1,-(A6)
  1735.                 bsr     b_abort_quote
  1736.                 DC.L (buferrmess-datas)
  1737.  
  1738.                 DC.L 0
  1739. buffer:         jsr     (dodefer-sys-of)(A5)
  1740.                 DC.L (bufferptr-datas)
  1741. *                rts
  1742.  
  1743.  
  1744.  
  1745.                 DC.L 0          ;( blk -- addr )
  1746. b_block:        move.l  D5,D0
  1747.                 addi.l  #orootblk,D0
  1748.                 move.l  0(A3,D0.l),D0
  1749.                 add.l   D0,(A6)         ;blk + rootblk
  1750. *                move.l  (lastblkptr-datas)(A3),D0 ;get last blocknumber
  1751. *                cmp.l   (A6),D0         ;try to get the same?
  1752. *                bne     bb_block        ;no?, then do full procedure
  1753. *                move.l  (lastbufptr-datas)(A3),(A6) ;or return last buffer
  1754. *                rts
  1755. bb_block:       move.l  (A6),(lastblkptr-datas)(A3)
  1756.                 move.l  (A6),-(SP)      ;save blk
  1757.                 bsr     quest_core      ;already in memory
  1758.                 tst.l   (A6)
  1759.                 bne.s   blk_ok
  1760.                 move.l  (SP),(A6)
  1761.                 bsr     b_buffer        ;( blk -- addr )
  1762.                 move.l  (A6),-(A6)
  1763.                 subi.l  #48,(A6)        ;to start of block
  1764.                 move.l  (SP)+,-(A6)
  1765.                 clr.l   -(A6)
  1766.                 bsr     r_w
  1767.                 tst.l   (A6)+
  1768.                 beq.s   block_err
  1769.                 move.l  (A6),(lastbufptr-datas)(A3)
  1770.                 rts
  1771. blk_ok:         addi.l  #(14+48),(A6)
  1772.                 addq.l  #4,SP
  1773.                 move.l  (A6),(lastbufptr-datas)(A3)
  1774.                 rts
  1775. block_err:      move.l  D5,D0
  1776.                 addi.l  #oprev,D0
  1777.                 move.l  0(A3,D0.l),D0   ;pointer to buffer
  1778.                 move.l  #-1,4(A3,D0.l)  ;mark buffer as unused
  1779.                 move.l  #-1,(A6)
  1780.                 bsr     b_abort_quote
  1781.                 DC.L (blkerrmess-datas)
  1782.  
  1783.  
  1784.                 DC.L 0          ;( block -- adr )
  1785. block:          jsr     (dodefer-sys-of)(A5)
  1786.                 DC.L (blockptr-datas)
  1787. *                rts
  1788.  
  1789.                 ENDPART
  1790.  
  1791. *****************************************************************
  1792.                 >PART 'interpreter words'
  1793. *****************************************************************
  1794.                 DC.L 0
  1795. tib:            move.l  D5,D0           ;( -- tib )
  1796.                 addi.l  #ototib,D0
  1797.                 move.l  0(A3,D0.l),-(A6)
  1798.                 rts
  1799.  
  1800.                 DC.L 0
  1801. query:          move.l  D5,D0           ;( -- )
  1802.                 addi.l  #ototib,D0
  1803.                 move.l  0(A3,D0.l),-(A6)
  1804.                 move.l  #255,-(A6)
  1805.                 bsr     expect
  1806.                 move.l  D5,D0
  1807.                 addi.l  #otoin,D0
  1808.                 clr.l   0(A3,D0.l)      ;>IN to 0
  1809.                 move.l  D5,D0
  1810.                 addi.l  #oblk,D0
  1811.                 clr.l   0(A3,D0.l)      ;BLK to 0
  1812.                 move.l  D5,D0
  1813.                 move.l  D5,D1
  1814.                 addi.l  #ospan,D0
  1815.                 addi.l  #o_tib,D1
  1816.                 move.l  0(A3,D0.l),0(A3,D1.l) ;SPAN to #TIB
  1817.                 bsr     space
  1818.                 rts
  1819.  
  1820.  
  1821.                 DC.L 0
  1822. skip:           movem.l D0-D2,-(SP)     ;( ad1 n1 char -- ad2 n2 )
  1823.                 move.l  (A6)+,D0        ;char
  1824.                 tst.l   (A6)
  1825.                 ble.s   no_skip         ;n1<=0?
  1826.                 move.l  (A6)+,D1        ;n1
  1827.                 move.l  (A6)+,D2        ;ad1
  1828. skip_loop:      cmp.b   0(A3,D2.l),D0   ;Zeichen vergleichen und weiterzählen
  1829.                 bne.s   skip_end        ;Zeichen ungleich dann raus
  1830.                 addq.l  #1,D2           ;increase pointer
  1831.                 subq.w  #1,D1           ;Zähler dekrementieren
  1832.                 bne.s   skip_loop       ;bis auf 0 runtergezählt
  1833. skip_end:       move.l  D2,-(A6)        ;ad2
  1834.                 move.l  D1,-(A6)        ;n2
  1835. no_skip:        movem.l (SP)+,D0-D2
  1836.                 rts
  1837.  
  1838.  
  1839.                 DC.L 0
  1840. scan:           movem.l D0-D2,-(SP)     ;( ad1 n1 char -- ad2 n2 )
  1841.                 move.l  (A6)+,D0        ;char
  1842.                 tst.l   (A6)
  1843.                 ble.s   no_scan         ;n1<=0?
  1844.                 move.l  (A6)+,D1        ;n1
  1845.                 move.l  (A6)+,D2        ;ad1
  1846. scan_loop:      cmp.b   0(A3,D2.l),D0   ;Zeichen vergleichen und weiterzählen
  1847.                 beq.s   scan_end        ;Zeichen gleich dann raus
  1848.                 addq.l  #1,D2           ;increase pointer
  1849.                 subq.l  #1,D1           ;Zähler dekrementieren
  1850.                 bne.s   scan_loop       ;bis auf 0 runtergezählt
  1851. scan_end:       move.l  D2,-(A6)        ;ad2
  1852.                 move.l  D1,-(A6)        ;n2
  1853. no_scan:        movem.l (SP)+,D0-D2
  1854.                 rts
  1855.  
  1856.  
  1857.                 DC.L 0
  1858. source:         move.l  D5,D0           ;( -- addr len )
  1859.                 addi.l  #oblk,D0
  1860.                 move.l  0(A3,D0.l),D0
  1861.                 beq.s   src_is_tib
  1862.                 movem.l D1-D2,-(SP)
  1863.                 move.l  D0,-(A6)
  1864.                 bsr     b_block
  1865.                 movem.l (SP)+,D1-D2
  1866.                 move.l  #bytesperblock,-(A6)
  1867.                 rts
  1868. src_is_tib:     move.l  D5,D0
  1869.                 addi.l  #ototib,D0
  1870.                 move.l  0(A3,D0.l),-(A6)
  1871.                 move.l  D5,D0
  1872.                 addi.l  #o_tib,D0
  1873.                 move.l  0(A3,D0.l),-(A6)
  1874.                 rts
  1875.  
  1876.  
  1877.                 DC.L 0
  1878. word:           movem.l D0-D4/A0,-(SP)  ;( char -- addr )
  1879.                 move.l  D5,D0
  1880.                 addi.l  #odata,D0
  1881.                 move.l  0(A3,D0.l),D1   ;fetch DP
  1882.                 move.l  D1,D2
  1883.                 andi.l  #1,D2
  1884.                 add.l   D2,D1           ;make DP even, DP in d1
  1885.  
  1886.                 bsr.s   source
  1887.                 move.l  (A6)+,D3        ;len of source
  1888.                 add.l   (A6),D3         ;calculate end of source
  1889.                 move.l  (A6)+,D2
  1890.                 move.l  D2,-(SP)
  1891.                 move.l  D5,D0
  1892.                 addi.l  #otoin,D0
  1893.                 add.l   0(A3,D0.l),D2   ;actual pointer in the source
  1894.  
  1895.                 move.l  (A6)+,D0        ;char as delimiter in d0
  1896.                 sub.l   D2,D3           ;length of rest of source in d3
  1897.  
  1898.                 move.l  D2,-(A6)
  1899.                 move.l  D3,-(A6)
  1900.                 move.l  D0,-(A6)
  1901.                 bsr     skip
  1902.                 move.l  4(A6),-(SP)     ;save startaddress on stack
  1903.                 move.l  D0,-(A6)
  1904.                 bsr     scan
  1905.                 move.l  (SP),D4         ;startaddress of string
  1906.  
  1907.                 move.l  4(A6),D3        ;endaddress
  1908.                 sub.l   D4,D3           ;end-start
  1909.                 move.b  D3,0(A3,D1.l)   ;mark length at HERE
  1910.                 addq.l  #1,D1           ;increase dest. pointer
  1911.  
  1912.                 movea.l (SP)+,A0        ;get back startaddr.
  1913.                 adda.l  A3,A0           ;calc. abs. address
  1914.  
  1915.                 move.l  (SP)+,D2        ;
  1916.                 sub.l   4(A6),D2        ;end - >WORD = >IN
  1917.                 neg.l   D2
  1918.                 addq.l  #1,D2
  1919.                 move.l  D5,D0
  1920.                 addi.l  #otoin,D0
  1921.                 move.l  D2,0(A3,D0.l)   ;set new >IN
  1922.  
  1923.                 dbra    D3,word_loop    ;startaddr. in A0
  1924.                 bra.s   word_end
  1925. word_loop:      move.b  (A0)+,0(A3,D1.l)
  1926.                 addq.l  #1,D1
  1927.                 dbra    D3,word_loop
  1928.                 move.b  #0,0(A3,D1.l)
  1929. word_end:       addq.l  #8,A6           ;2DROP
  1930.                 move.l  D5,D0
  1931.                 addi.l  #odata,D0
  1932.                 move.l  0(A3,D0.l),D1   ;fetch DP
  1933.                 move.l  D1,D0
  1934.                 andi.l  #1,D0
  1935.                 add.l   D0,D1           ;make it even s.a.
  1936.                 move.l  D1,-(A6)        ;here's the string now
  1937.                 movem.l (SP)+,D0-D4/A0
  1938.                 rts
  1939.  
  1940.  
  1941.                 DC.L 0
  1942. char:           move.l  #$20,-(A6)
  1943.                 bsr     word
  1944.                 move.l  (A6),D0
  1945.                 clr.l   (A6)
  1946.                 move.b  1(A3,D0.l),3(A6)
  1947.                 rts
  1948.  
  1949.  
  1950.                 DC.L 0
  1951. b_char:         bsr.s   char
  1952.                 bsr     literal
  1953.                 rts
  1954.  
  1955.  
  1956.                 DC.L 0
  1957. capital:        cmpi.l  #'a',(A6)
  1958.                 blt.s   capital_end
  1959.                 cmpi.l  #'z',(A6)
  1960.                 bgt.s   capital_end
  1961.                 subi.l  #$20,(A6)
  1962. capital_end:    rts
  1963.  
  1964.  
  1965.                 DC.L 0
  1966. capitalize:     movea.l (A6),A0         ;adr
  1967.                 adda.l  A3,A0           ;calculate abs. pointer
  1968.                 moveq   #0,D0
  1969.                 move.b  (A0)+,D0        ;count
  1970.                 beq.s   cap_end
  1971.                 moveq   #0,D1
  1972. cap_loop:       move.b  (A0),D1         ;fetch character
  1973.                 cmp.b   #'a',D1
  1974.                 blt.s   no_cap
  1975.                 cmp.b   #'z',D1
  1976.                 bgt.s   no_cap
  1977.                 subi.b  #$20,D1
  1978. no_cap:         move.b  D1,(A0)+        ;restore converted character
  1979.                 subq.l  #1,D0
  1980.                 bne.s   cap_loop
  1981. cap_end:        rts
  1982.  
  1983.  
  1984.                 DC.L 0
  1985. name:           move.l  #$20,-(A6)      ;BL on the stack
  1986.                 bsr     word
  1987.                 move.l  D5,D0
  1988.                 addi.l  #ocaps,D0
  1989.                 tst.l   0(A3,D0.l)
  1990.                 beq.s   nocap
  1991.                 bsr.s   capitalize
  1992. nocap:          rts
  1993.  
  1994.  
  1995. * preparations for FIND
  1996.                 DC.L 0
  1997. vocsearch:      movem.l D0/A0-A2,-(SP)  ;( str voc -- cfa controlword / str -1 )
  1998.                 move.l  (A6)+,D0        ;pointer to vocabulary
  1999.                 lea     0(A3,D0.l),A0   ;pointer to header of last word
  2000.                 movea.l (A6),A1         ;str in a1
  2001.                 adda.l  A3,A1
  2002. vocsearch_loop: movea.l (A0),A0         ;link to next LFA
  2003.                 adda.l  A3,A0           ;make pointer absolute
  2004.                 tst.l   (A0)            ;das 0-Linkfeld?
  2005.                 beq.s   vocsearch_false ;-> das Ende des Voc.
  2006.                 movea.l A0,A2           ;und in a2
  2007.                 addq.l  #4,A2           ;Zeiger auf String
  2008.                 move.w  (A2),D1
  2009.                 cmp.w   (A1),D1         ;gleich ?
  2010.                 bne.s   vocsearch_loop
  2011.                 moveq   #0,D0
  2012.                 move.b  (A2)+,D0        ;Länge
  2013.                 addq.l  #1,A1
  2014.                 subq.b  #1,D0
  2015. exef_str_cmp:   cmpm.b  (A2)+,(A1)+     ;Zeichen vergleichen
  2016.                 dbne    D0,exef_str_cmp
  2017.                 movea.l (A6),A1
  2018.                 adda.l  A3,A1
  2019.                 bne.s   vocsearch_loop
  2020. vocsearch_true: move.l  A0,D0           ;for rel. addressing
  2021.                 sub.l   A3,D0
  2022.                 subq.l  #4,D0           ;lfa > cfa
  2023.                 btst    #0,-1(A3,D0.l)  ;smudge?
  2024.                 bne.s   vocsearch_loop  ;then go on searching
  2025.                 move.l  D0,(A6)         ;cfa > stack
  2026.                 move.w  -2(A3,D0.l),-(A6) ;fetch control word
  2027.                 clr.w   -(A6)
  2028.                 movem.l (SP)+,D0/A0-A2
  2029.                 rts                     ;and ready ...
  2030. vocsearch_false:move.l  #-1,-(A6)       ;the TRUE-flag for "not found"
  2031.                 movem.l (SP)+,D0/A0-A2
  2032.                 rts
  2033.  
  2034.  
  2035.                 DC.L 0          ;( addr -- cfa controlword | addr -1 )
  2036. b_find:         move.l  #-1,-(A6)       ;ein Dummy-Flag ( str -1 )
  2037.                 move.l  D5,D0
  2038.                 addi.l  #ovocpa,D0
  2039.                 movea.l 0(A3,D0.l),A0   ;Basis des Vocabularstacks
  2040.                 adda.l  A3,A0           ;convert to abs. pointer
  2041.                 move.l  (A0)+,D0        ;Höhe dieses Stacks
  2042. find_loop:      subq.w  #4,D0
  2043.                 bmi.s   find_false      ;Vocabulare alle durch?
  2044.                 move.l  0(A0,D0.w),(A6) ;( str *name ) 'CONTEXT @'
  2045.                 bsr.s   vocsearch       ;search vocabulary
  2046.                 cmpi.l  #-1,(A6)        ;gefunden?
  2047.                 beq.s   find_loop       ;nein, dann nächstes Vocabular
  2048.                 rts                     ;sonst mit Freudenschrei zurück
  2049. find_false:     move.l  #-1,(A6)        ;das widersinnige TRUE-Flag
  2050.                 rts                     ;und nach Hause
  2051.  
  2052.  
  2053.                 DC.L 0
  2054. find:           jsr     (dodefer-sys-of)(A5)
  2055.                 DC.L (findptr-datas)
  2056.  
  2057.  
  2058.  
  2059.                 DC.L 0          ;( addr -- addr false | true )
  2060. nulst_quest:    move.l  (A6),D0
  2061.                 tst.b   0(A3,D0.l)      ;Countbyte=0?
  2062.                 beq.s   nulst_true
  2063.                 clr.l   -(A6)           ;additional falseflag
  2064.                 rts
  2065. nulst_true:     move.l  #-1,(A6)        ;trueflag
  2066.                 rts
  2067.  
  2068.  
  2069.                 DC.L 0
  2070. notfound:       jsr     (dodefer-sys-of)(A5) ;s.u.
  2071.                 DC.L (notfndptr-datas) ; ' unknown IS notfound
  2072. *                rts
  2073.  
  2074.  
  2075.                 DC.L 0
  2076. unknown:        move.l  #-1,-(A6)       ;TRUE-Flag
  2077.                 bsr     b_error_quote   ;error"
  2078.                 DC.L (unknownmess-datas) ;9,' unknown!'
  2079.                 rts
  2080.  
  2081.  
  2082.                 DC.L 0
  2083. h_tick:         bsr     name
  2084.                 bsr.s   find
  2085.                 cmpi.l  #-1,(A6)+
  2086.                 beq.s   h_tick_err
  2087.                 rts
  2088. h_tick_err:     bsr.s   notfound
  2089.                 rts
  2090.  
  2091.  
  2092.                 DC.L 0
  2093. tick:           bsr.s   h_tick
  2094.                 move.l  (A6)+,D0
  2095.                 move.l  0(A3,D0.l),-(A6) ;fetch pfa
  2096.                 rts
  2097.  
  2098.  
  2099.                 DC.L 0
  2100. b_tick:         bsr.s   tick
  2101.                 bsr     literal
  2102.                 rts
  2103.  
  2104.  
  2105.                 DC.L 0
  2106. quest_stack:    movem.l D0-D1,-(SP)
  2107.                 move.l  D5,D0
  2108.                 addi.l  #osnull,D0
  2109.                 move.l  0(A3,D0.l),D1
  2110.                 add.l   A3,D1
  2111.                 cmpa.l  D1,A6
  2112.                 ble.s   quest_stck1
  2113.                 movea.l 0(A3,D0.l),A6
  2114.                 adda.l  A3,A6
  2115.                 move.l  #-1,-(A6)
  2116.                 bsr     b_abort_quote
  2117.                 DC.L (stkundermess-datas) ;
  2118. quest_stck1:    move.l  D5,D0
  2119.                 addi.l  #ofnull,D0
  2120.                 move.l  0(A3,D0.l),D1
  2121.                 add.l   A3,D1
  2122.                 cmpa.l  D1,A4
  2123.                 ble.s   stack_ok
  2124.                 movea.l 0(A3,D0.l),A4
  2125.                 adda.l  A3,A4
  2126.                 move.l  #-1,-(A6)
  2127.                 bsr     b_abort_quote
  2128.                 DC.L (fltundermess-datas) ;
  2129. stack_ok:       movem.l (SP)+,D0-D1
  2130.                 rts
  2131.  
  2132.  
  2133.  
  2134.                 DC.L 0          ;( addr -- )
  2135. compiler:       bsr     find
  2136.                 cmpi.l  #-1,(A6)
  2137.                 beq.s   cnot_found
  2138.                 btst    #1,3(A6)        ;immediate?
  2139.                 beq.s   cnot_immediate
  2140. cnorestrict:    addq.l  #4,A6           ;drop Kontrollwort
  2141.                 move.l  (A6)+,D0        ;execute
  2142.                 move.l  0(A3,D0.l),D0
  2143.                 jsr     0(A5,D0.l)
  2144.                 rts                     ;success
  2145. cnot_immediate: addq.l  #4,A6           ;drop controlword
  2146.                 bsr     com_komma       ;com,
  2147.                 rts                     ;success
  2148. cnot_found:     addq.l  #4,A6           ;drop controlword
  2149.                 bsr     number_quest    ;number? ( adr -- string false/Zahl #longs )
  2150.                 tst.l   (A6)            ;test flag
  2151.                 beq.s   cno_number      ;no number
  2152.                 move.l  (A6)+,D1        ;d1<0 => number on floatstack
  2153.                 bpl.s   comp_num
  2154. comp_fnum:      bsr     fliteral
  2155.                 rts
  2156. comp_num:       bsr     literal         ;compile number
  2157.                 rts                     ;UFF!!!!
  2158. cno_number:     addq.l  #4,A6           ;drop falseflag
  2159.                 bra     notfound        ;neither word nor number
  2160.  
  2161.  
  2162.  
  2163.                 DC.L 0          ;( addr -- )
  2164. interpreter:    bsr     find
  2165.                 cmpi.l  #-1,(A6)
  2166.                 beq.s   inot_found
  2167.                 btst    #2,3(A6)        ;restrict?
  2168.                 beq.s   inorestrict
  2169.                 move.l  D5,D0
  2170.                 addi.l  #odata,D0
  2171.                 move.l  0(A3,D0.l),4(A6) ;string is at HERE
  2172.                 bsr     b_error_quote   ;error"        ( str flag -- )
  2173.                 DC.L (restrmess-datas)
  2174. inorestrict:    addq.l  #4,A6           ;drop Kontrollwort
  2175.                 move.l  (A6)+,D0        ;execute
  2176.                 move.l  0(A3,D0.l),D0
  2177.                 jsr     0(A5,D0.l)
  2178.                 rts                     ;success
  2179. inot_found:     addq.l  #4,A6           ;drop controlword
  2180.                 bsr     number_quest    ;number? ( adr -- string false/n #longs )
  2181.                 tst.l   (A6)+           ;test flag
  2182.                 beq.s   ino_number      ;no_number?
  2183.                 rts
  2184. ino_number:     bra     notfound        ;no success
  2185.  
  2186.  
  2187.  
  2188.                 DC.L 0
  2189. parser:         jsr     (dodefer-sys-of)(A5)
  2190.                 DC.L (parserptr-datas)
  2191. *                rts
  2192.  
  2193.  
  2194.                 DC.L 0
  2195. interpret:      bsr     name            ;nächstes Wort suchen
  2196.                 bsr     nulst_quest     ;Ende des Eingabestroms?
  2197.                 tst.l   (A6)+
  2198.                 bne.s   end_interpret
  2199.                 bsr.s   parser
  2200.                 bra.s   interpret
  2201. end_interpret:  rts
  2202.  
  2203.                 ENDPART
  2204.  
  2205. *****************************************************************
  2206.                 >PART 'PUSH and EVALUATE'
  2207.  
  2208. repush:         movea.l (SP)+,A0
  2209.                 move.l  (SP)+,(A0)
  2210.                 rts
  2211.  
  2212.  
  2213.                 DC.L 0          ;( addr -- )
  2214. push:           movea.l (SP)+,A0        ;get return
  2215.                 movea.l (A6)+,A1        ;addr in A1
  2216.                 adda.l  A3,A1           ;make it absolute
  2217.                 move.l  (A1),-(SP)      ;push variable on stack
  2218.                 move.l  A1,-(SP)        ;push addr on stack
  2219.                 move.l  #(repush-sys-of),D0
  2220.                 add.l   A5,D0
  2221.                 move.l  D0,-(SP)        ;push runtimecode
  2222.                 jmp     (A0)            ;return
  2223.  
  2224.  
  2225. poparea:        movea.l (SP)+,A0        ;get back addr
  2226.                 move.l  (SP)+,D0        ;get back count
  2227. poparealoop:    move.w  (SP)+,-(A0)
  2228.                 dbra    D0,poparealoop
  2229.                 rts
  2230.  
  2231.  
  2232.                 DC.L 0          ;( addr count -- )
  2233. savearea:       movea.l (SP)+,A1
  2234.                 move.l  (A6)+,D0        ;get count
  2235.                 lsr.l   #1,D0           ;only words are moved
  2236.                 move.l  D0,D1           ;save in D1
  2237.                 movea.l (A6)+,A0        ;get addr
  2238.                 adda.l  A3,A0           ;make it absolute
  2239. savearealoop:   move.w  (A0)+,-(SP)
  2240.                 dbra    D1,savearealoop
  2241.                 move.l  D0,-(SP)
  2242.                 move.l  A0,-(SP)
  2243.                 move.l  #(poparea-sys-of),D0
  2244.                 add.l   A5,D0
  2245.                 move.l  D0,-(SP)        ;push runtimecode
  2246.                 jmp     (A1)
  2247.  
  2248.  
  2249.                 DC.L 0          ;( c-addr u -- )
  2250. evaluate:       move.l  D5,D0
  2251.                 addi.l  #ototib,D0
  2252.                 move.l  0(A3,D0.l),-(A6)
  2253.                 move.l  4(A6),-(A6)
  2254.                 bsr.s   savearea        ;save TIB
  2255.                 move.l  D5,D0
  2256.                 addi.l  #o_tib,-(A6)
  2257.                 bsr.s   push            ;save #TIB
  2258.                 move.l  D5,D0
  2259.                 addi.l  #otoin,-(A6)
  2260.                 bsr.s   push            ;save >IN
  2261.                 move.l  D5,D0
  2262.                 addi.l  #oblk,-(A6)
  2263.                 bsr.s   push            ;save BLK
  2264.                 move.l  D5,D0
  2265.                 addi.l  #oblk,D0
  2266.                 clr.l   0(A3,D0.l)      ;BLK off
  2267.                 move.l  (A6),D0         ;get count u
  2268.                 movea.l 4(A6),A0        ;get c-addr
  2269.                 adda.l  A3,A0           ;make it absolute
  2270.                 move.l  D5,D1
  2271.                 addi.l  #ototib,D1
  2272.                 movea.l 0(A3,D1.l),A1   ;get TIB
  2273.                 adda.l  A3,A1           ;make it absolute
  2274.                 lsr.l   #1,D0           ;move word-wise
  2275. evalloop:       move.w  (A0)+,(A1)+     ;move string
  2276.                 dbra    D0,evalloop
  2277.                 move.l  D5,D0
  2278.                 addi.l  #o_tib,D0
  2279.                 move.l  (A6)+,0(A3,D0.l) ;count #TIB !
  2280.                 move.l  D5,D0
  2281.                 addi.l  #otoin,D0
  2282.                 clr.l   0(A3,D0.l)      ;0 >IN !
  2283.                 addq.l  #4,A6           ;drop c-addr
  2284.                 bsr     interpret
  2285.                 rts
  2286.                 ENDPART
  2287.  
  2288. *****************************************************************
  2289.                 >PART 'convert number --> string'
  2290. *****************************************************************
  2291.                 DC.L 0
  2292. less_sharp:     move.l  D5,D0
  2293.                 move.l  D5,D1
  2294.                 addi.l  #odata,D0
  2295.                 addi.l  #ohld,D1
  2296.                 move.l  0(A3,D0.l),0(A3,D1.l)
  2297.                 addi.l  #$0100,0(A3,D1.l) ;PAD
  2298.                 rts
  2299.  
  2300.  
  2301.                 DC.L 0
  2302. sharp_greater:  addq.l  #4,A6           ;drop
  2303.                 move.l  D5,D0
  2304.                 move.l  D5,D1
  2305.                 addi.l  #odata,D0
  2306.                 addi.l  #ohld,D1
  2307.                 move.l  0(A3,D0.l),D0
  2308.                 addi.l  #$0100,D0       ;PAD in d0
  2309.                 move.l  0(A3,D1.l),D1   ;HLD in d1
  2310.                 sub.l   D1,D0           ;Länge
  2311.                 move.l  D1,-(A6)        ;addr
  2312.                 move.l  D0,-(A6)
  2313.                 rts
  2314.  
  2315.  
  2316.                 DC.L 0
  2317. hold:           move.l  D5,D0
  2318.                 addi.l  #ohld,D0
  2319.                 move.l  0(A3,D0.l),D1   ;fetch HLD
  2320.                 subq.l  #1,D1           ;predecrement
  2321.                 addq.l  #3,A6
  2322.                 move.b  (A6)+,0(A3,D1.l)
  2323.                 move.l  D1,0(A3,D0.l)
  2324.                 rts
  2325.  
  2326.  
  2327.                 DC.L 0
  2328. sign:           tst.l   (A6)+
  2329.                 bpl.s   sign_end
  2330.                 move.l  #'-',-(A6)
  2331.                 bsr.s   hold
  2332. sign_end:       rts
  2333.  
  2334.  
  2335.                 DC.L 0
  2336. sharp:          move.l  D5,D0
  2337.                 addi.l  #obase,D0
  2338.                 move.l  0(A3,D0.l),-(A6)
  2339.                 bsr     udivmod         ;( mod / )
  2340.                 move.l  (A6)+,-(SP)     ;Quotient retten
  2341.                 cmpi.l  #10,(A6)        ;Rest > 9
  2342.                 bmi.s   sharp1
  2343.                 addi.l  #7,(A6)
  2344. sharp1:         addi.l  #'0',(A6)
  2345.                 bsr.s   hold
  2346.                 move.l  (SP)+,-(A6)     ;Quotient zurück
  2347.                 rts
  2348.  
  2349.  
  2350.                 DC.L 0
  2351. sharp_s:        bsr.s   sharp
  2352.                 tst.l   (A6)
  2353.                 bne.s   sharp_s
  2354.                 rts
  2355.  
  2356.  
  2357.                 DC.L 0
  2358. udot:           bsr     less_sharp      ;<#
  2359.                 bsr.s   sharp_s         ;#s
  2360.                 bsr     sharp_greater   ;#>
  2361.                 bsr     type            ;type
  2362.                 bsr     space
  2363.                 rts
  2364.  
  2365.  
  2366.                 DC.L 0
  2367. dot:            move.l  (A6),-(A6)      ;dup
  2368.                 bpl.s   dot_pos
  2369.                 move.l  #-1,4(A6)       ;-1 unterschieben
  2370.                 neg.l   (A6)            ;negieren
  2371. dot_pos:        bsr     less_sharp
  2372.                 bsr.s   sharp_s
  2373.                 move.l  4(A6),(A6)
  2374.                 bsr.s   sign
  2375.                 bsr     sharp_greater
  2376.                 bsr     type
  2377.                 bsr     space
  2378.                 rts
  2379.  
  2380.  
  2381.                 DC.L 0
  2382. prompt:         move.l  D5,D0
  2383.                 addi.l  #ostate,D0
  2384.                 tst.l   0(A3,D0.l)
  2385.                 bne.s   prompt_end
  2386.                 bsr     space
  2387.                 move.l  #'o',-(A6)
  2388.                 bsr     emit
  2389.                 move.l  #'k',-(A6)
  2390.                 bsr     emit
  2391. prompt_end:     rts
  2392.  
  2393.                 ENDPART
  2394.  
  2395. *****************************************************************
  2396.                 >PART 'compiler words'
  2397. *                                                               *
  2398. *****************************************************************
  2399.                 DC.L 0
  2400. left_brack:     move.l  D5,D0
  2401.                 addi.l  #ostate,D0
  2402.                 clr.l   0(A3,D0.l)
  2403.                 move.l  #(interpreter-sys-of),parserptr-datas(A3)
  2404.                 rts
  2405.  
  2406.                 DC.L 0
  2407. right_brack:    move.l  D5,D0
  2408.                 addi.l  #ostate,D0
  2409.                 move.l  #-1,0(A3,D0.l)
  2410.                 move.l  #(compiler-sys-of),parserptr-datas(A3)
  2411.                 rts
  2412.  
  2413.  
  2414.                 DC.L 0
  2415. align:          move.l  D5,D0
  2416.                 addi.l  #odata,D0
  2417.                 move.l  0(A3,D0.l),D1
  2418.                 move.l  D1,D2
  2419.                 andi.l  #1,D2
  2420.                 add.l   D1,D2
  2421.                 move.l  D2,0(A3,D0.l)
  2422.                 rts
  2423.  
  2424.                 ENDPART
  2425.  
  2426. *****************************************************************
  2427.                 >PART 'the main loop'
  2428. *                                                               *
  2429. *****************************************************************
  2430.                 DC.L 0
  2431. quit:           move.l  D5,D0
  2432.                 addi.l  #ornull,D0
  2433.                 move.l  0(A3,D0.l),D0
  2434.                 lea     0(A3,D0.l),SP   ;set returnstack
  2435.  
  2436.                 move.l  D5,D0
  2437.                 addi.l  #ostate,D0
  2438.                 clr.l   0(A3,D0.l)      ;State auf NULL
  2439.                 move.l  #(interpreter-sys-of),parserptr-datas(A3)
  2440.  
  2441.                 move.l  D5,D0
  2442.                 addi.l  #osnull,D0
  2443.                 move.l  0(A3,D0.l),D0
  2444.                 add.l   A3,D0
  2445.                 cmpa.l  D0,A6           ;datastack underflow?
  2446.                 ble.s   test_fstack
  2447.                 movea.l D0,A6           ;reset datastack
  2448. test_fstack:    move.l  D5,D0
  2449.                 addi.l  #ofnull,D0
  2450.                 move.l  0(A3,D0.l),D0
  2451.                 add.l   A3,D0
  2452.                 cmpa.l  D0,A4           ;floatstack underflow?
  2453.                 ble.s   quit_loop
  2454.                 movea.l D0,A4           ;reset floatstack
  2455. quit_loop:      bsr     prompt
  2456.                 bsr     cr
  2457.                 bsr     query
  2458.                 bsr     interpret
  2459.                 bsr     quest_stack
  2460.                 bra.s   quit_loop
  2461.  
  2462.  
  2463.                 DC.L 0
  2464. cold:           move.l  (tcold-datas)(A3),D0
  2465.                 jsr     0(A5,D0.l)
  2466.                 rts
  2467.  
  2468.                 ENDPART
  2469.  
  2470. *****************************************************************
  2471.                 >PART 'convert string --> number'
  2472. *****************************************************************
  2473.                 DC.L 0
  2474. digit_quest:    movem.l D0-D1,-(SP)
  2475.                 move.l  (A6),D0         ;Zeichen nach d0
  2476.                 sub.b   #'0',D0         ;Zeichen -> Zahl
  2477.                 bmi.s   digit_false     ;<0? dann keine Ziffer
  2478.                 cmp.b   #16,D0          ;vergl. Ziffer mit 15
  2479.                 bgt.s   dig_quest1      ;Ziffer>15?, dann mach weiter
  2480.                 cmp.b   #10,D0          ;10<=Ziffer<=15?, dann keine Ziffer
  2481.                 bge.s   digit_false
  2482.                 bra.s   dig_quest2
  2483. dig_quest1:     sub.b   #7,D0           ;'A' -> 10
  2484. dig_quest2:     move.l  D5,D1
  2485.                 addi.l  #obase,D1
  2486.                 cmp.l   0(A3,D1.l),D0
  2487.                 bmi.s   digit_true
  2488. digit_false:    clr.l   (A6)            ;FALSE
  2489.                 movem.l (SP)+,D0-D1
  2490.                 rts
  2491. digit_true:     move.l  D0,(A6)         ;Digit
  2492.                 move.l  #-1,-(A6)       ;TRUE
  2493.                 movem.l (SP)+,D0-D1
  2494.                 rts
  2495.  
  2496.  
  2497.                 DC.L 0
  2498. accumulate:     move.l  (A6)+,-(SP)     ;digit retten
  2499.                 move.l  (A6),-(SP)      ;adr retten
  2500.                 move.l  D5,D0
  2501.                 addi.l  #obase,D0
  2502.                 move.l  0(A3,D0.l),(A6)
  2503.                 bsr     mult            ;n1*BASE
  2504.                 move.l  4(SP),D0
  2505.                 add.l   D0,(A6)         ;+digit
  2506.                 move.l  (SP)+,-(A6)     ;adr zurück
  2507.                 addq.l  #4,SP           ;rdrop digit
  2508.                 rts
  2509.  
  2510.  
  2511.                 DC.L 0
  2512. count:          move.l  (A6),D1
  2513.                 moveq   #0,D0
  2514.                 move.b  0(A3,D1.l),D0
  2515.                 addq.l  #1,D1
  2516.                 move.l  D1,(A6)
  2517.                 move.l  D0,-(A6)
  2518.                 rts
  2519.  
  2520.  
  2521.                 DC.L 0
  2522. convert:        bsr.s   count           ;( akku adr [digit true / false] )
  2523.                 bsr     digit_quest
  2524.                 tst.l   (A6)+
  2525.                 beq.s   convert_end
  2526.                 bsr.s   accumulate
  2527.                 bra.s   convert
  2528. convert_end:    subq.l  #1,(A6)
  2529.                 rts
  2530.  
  2531.  
  2532.                 DC.L 0
  2533. n_number_quest: move.l  D5,D0           ;( adr -- n #longs )
  2534.                 addi.l  #obase,D0
  2535.                 move.l  0(A3,D0.l),-(SP) ;save BASE
  2536.                 move.l  (A6),-(SP)      ;save address
  2537.                 moveq   #0,D1
  2538.                 movea.l (A6)+,A0        ;address to a0
  2539.                 adda.l  A3,A0           ;calculate abs. address
  2540.                 movea.l A0,A1           ;copy for error handling
  2541.                 addq.l  #1,A0           ;countbyte
  2542.                 clr.l   -(A6)           ;0 on the stack
  2543. check_char:     addq.l  #4,A6           ;DROP
  2544.                 moveq   #0,D0
  2545.                 move.b  (A0)+,D0        ;fetch first character
  2546.                 move.l  D0,-(A6)        ;push it on the stack
  2547.                 move.l  D0,-(A6)        ;DUP
  2548.                 bsr     digit_quest     ;a valid numbercharacter?
  2549.                 tst.l   (A6)+           ;( char1 digit )/ ( char )
  2550.                 beq.s   nnum1           ;no numeral? possible: -,$,&,.
  2551.                 move.l  (A6)+,(A6)      ;( digit ) is accumulator
  2552.                 move.l  A0,-(A6)        ;( akku adr )
  2553.                 bra.s   do_conversion
  2554. nnum1:          cmpi.l  #'-',(A6)       ;is it negative
  2555.                 bne.s   not_neg
  2556.                 bset    #0,D1           ;set a flag
  2557.                 bra.s   check_char
  2558. not_neg:        cmpi.l  #'$',(A6)       ;is it HEX
  2559.                 bne.s   not_hex
  2560.                 move.l  D5,D0
  2561.                 addi.l  #obase,D0
  2562.                 move.l  #16,0(A3,D0.l)  ;set BASE to hex
  2563.                 bra.s   check_char
  2564. not_hex:        cmpi.l  #'&',(A6)       ;is it decimal
  2565.                 bne.s   not_dec
  2566.                 move.l  D5,D0
  2567.                 addi.l  #obase,D0
  2568.                 move.l  #10,0(A3,D0.l)  ;set BASE to decimal
  2569.                 bra.s   check_char
  2570. not_dec:        cmpi.l  #'.',(A6)       ;is it a dot?
  2571.                 bne.s   number_err      ;no?, then it isn't a number
  2572.                 clr.l   (A6)
  2573.                 move.l  A0,-(A6)        ;( akku adr )
  2574.                 bra.s   do_conv_after_dot
  2575. number_err:     move.l  (SP)+,(A6)      ;restore address
  2576.                 clr.l   -(A6)           ;FALSE
  2577.                 bra     nnum_out
  2578. do_conversion:  move.l  D5,D0
  2579.                 addi.l  #odpl,D0
  2580.                 move.l  #-1,0(A3,D0.l)  ;clear DPL
  2581.                 move.l  D1,-(SP)        ;save d1
  2582.                 move.l  (A6),D0
  2583.                 sub.l   A3,D0           ;make pointer rel. again
  2584.                 move.l  D0,(A6)
  2585.                 bsr     convert         ;do conversion
  2586.                 move.l  (SP)+,D1
  2587.                 movea.l (A6),A0         ;address of first not-numeral
  2588.                 adda.l  A3,A0           ;make it absolut
  2589.                 moveq   #0,D0
  2590.                 move.b  (A0)+,D0        ;fetch not-numeral
  2591.                 move.l  A0,(A6)         ;abs. address remains on stack
  2592.                 tst.b   D0              ;end of string?
  2593.                 beq.s   nnum3           ;then leave succuessfully
  2594.                 cmp.b   #32,D0          ;is it a blank
  2595.                 beq.s   nnum3           ;then, end of string, too
  2596.                 cmp.b   #'.',D0         ;is it a dot?
  2597.                 beq.s   do_conv_after_dot ;then there's something to do
  2598.                 bra.s   nnum_err        ;otherwise error
  2599. nnum3:          move.l  #1,(A6)         ;it is ONE long
  2600.                 btst    #0,D1           ;did we find a '-'?
  2601.                 beq.s   nnum2
  2602.                 neg.l   4(A6)           ;then negate the number
  2603. nnum2:          addq.l  #4,SP           ;drop saved address
  2604.                 bra.s   nnum_out        ;and finish
  2605. nnum_err:       clr.l   (A6)            ;FALSE
  2606.                 move.l  (SP)+,4(A6)     ;put back address
  2607.                 bra.s   nnum_out        ;and finish
  2608. do_conv_after_dot:
  2609.                 move.l  A0,-(SP)        ;remember actual address
  2610.                 move.l  D1,-(SP)        ;save d1
  2611.                 move.l  (A6),D0
  2612.                 sub.l   A3,D0           ;make pointer rel. again
  2613.                 move.l  D0,(A6)
  2614.                 bsr     convert
  2615.                 move.l  (A6),D0
  2616.                 add.l   A3,D0           ;make pointer rel. again
  2617.                 move.l  D0,(A6)
  2618.                 move.l  (SP)+,D1        ;restore d1
  2619.                 movea.l (SP)+,A1        ;addr of dot
  2620.                 moveq   #0,D0
  2621.                 movea.l (A6),A0         ;fetch actual address
  2622.                 move.b  (A0),D0         ;fetch first character
  2623.                 beq.s   nnum5           ;end of string
  2624.                 cmp.b   #32,D0          ;when blank, too
  2625.                 bne.s   nnum_err        ;otherwise error
  2626. nnum5:          suba.l  A1,A0           ;calculate position of dot
  2627.                 move.l  D5,D0
  2628.                 addi.l  #odpl,D0
  2629.                 move.l  A0,0(A3,D0.l)   ;set DPL
  2630.                 move.l  #1,(A6)         ;there was ONe long
  2631.                 btst    #0,D1           ;did we find a '-'??
  2632.                 beq.s   nnum4           ;no
  2633.                 neg.l   4(A6)           ;negate
  2634. nnum4:          addq.l  #4,SP           ;drop saved address
  2635. nnum_out:       move.l  D5,D0
  2636.                 addi.l  #obase,D0
  2637.                 move.l  (SP)+,0(A3,D0.l) ;restore base
  2638.                 rts                     ;finish
  2639.  
  2640.                 ENDPART
  2641.  
  2642. *****************************************************************
  2643.                 >PART 'memory manipulation'
  2644. *                                                               *
  2645. *****************************************************************
  2646.                 DC.L 0
  2647. fetch:          move.l  (A6),D0         ;( adr -- value )
  2648.                 move.l  0(A3,D0.l),(A6)
  2649.                 rts
  2650.  
  2651.                 DC.L 0
  2652. cfetch:         move.l  (A6),D0
  2653.                 clr.l   (A6)
  2654.                 move.b  0(A3,D0.l),3(A6)
  2655.                 rts
  2656.  
  2657.                 DC.L 0
  2658. wfetch:         move.l  (A6),D0
  2659.                 clr.l   (A6)
  2660.                 move.w  0(A3,D0.l),2(A6)
  2661.                 rts
  2662.  
  2663.                 DC.L 0
  2664. store:          move.l  (A6)+,D0        ;( value adr -- )
  2665.                 move.l  (A6)+,0(A3,D0.l)
  2666.                 rts
  2667.  
  2668.                 DC.L 0
  2669. cstore:         move.l  (A6)+,D0
  2670.                 addq.l  #3,A6
  2671.                 move.b  (A6)+,0(A3,D0.l)
  2672.                 rts
  2673.  
  2674.                 DC.L 0
  2675. wstore:         move.l  (A6)+,D0
  2676.                 addq.l  #2,A6
  2677.                 move.w  (A6)+,0(A3,D0.l)
  2678.                 rts
  2679.  
  2680.                 ENDPART
  2681.  
  2682. *****************************************************************
  2683.                 >PART 'BASE settings'
  2684. *****************************************************************
  2685.                 DC.L 0
  2686. hex:            move.l  D5,D0
  2687.                 addi.l  #obase,D0
  2688.                 move.l  #16,0(A3,D0.l)
  2689.                 rts
  2690.  
  2691.  
  2692.                 DC.L 0
  2693. decimal:        move.l  D5,D0
  2694.                 addi.l  #obase,D0
  2695.                 move.l  #10,0(A3,D0.l)
  2696.                 rts
  2697.  
  2698.                 ENDPART
  2699.  
  2700. *****************************************************************
  2701.                 >PART 'creating a header'
  2702. *****************************************************************
  2703.                 DC.L 0
  2704. header_colon:   bsr     align
  2705.                 move.l  #headsize,-(A6)
  2706.                 bsr     allot           ;for header fields
  2707.                 bsr     name            ;get name
  2708.                 bsr     nulst_quest     ;is there a name?
  2709.                 tst.l   (A6)+
  2710.                 bne     hd_col_err
  2711.  
  2712.                 move.l  D5,D0
  2713.                 addi.l  #owarning,D0
  2714.                 tst.l   0(A3,D0.l)      ;WARNING ?
  2715.                 beq.s   do_head_col
  2716.                 move.l  (A6),-(A6)      ;dup name
  2717.                 move.l  D5,D0
  2718.                 addi.l  #ocurrent,D0
  2719.                 move.l  0(A3,D0.l),-(A6) ;CURRENT @
  2720.                 bsr     vocsearch
  2721.                 move.l  (A6)+,(A6)      ;NIP, CFA of no interest
  2722.                 tst.l   (A6)+
  2723.                 bmi.s   do_head_col     ;not found
  2724.                 move.l  (A6),-(A6)
  2725.                 bsr     count
  2726.                 bsr     type
  2727.                 bsr     b_str_quote
  2728.                 DC.L (notuniquemess-datas)
  2729.                 bsr     count
  2730.                 bsr     type
  2731.  
  2732. do_head_col:    move.l  (A6),D0         ;fetch address of name
  2733.                 clr.l   -(A6)
  2734.                 move.b  0(A3,D0.l),3(A6) ;countbyte on stack
  2735.                 addi.l  #1,(A6)         ;string incl. countbyte
  2736.                 bsr     allot           ;allocate memory
  2737.                 move.l  (A6)+,D0        ;address of name again
  2738.                 subi.l  #headsize,D0    ;to start of header
  2739.                 move.l  D5,D1
  2740.                 addi.l  #olast,D1
  2741.                 move.l  D0,0(A3,D1.l)   ;mark new LAST
  2742.                 move.w  #1,0(A3,D0.l)   ;controlword = smudge
  2743.                 move.l  D5,D2
  2744.                 addi.l  #ocurrent,D2
  2745.                 move.l  0(A3,D2.l),D2   ;pointer to pointer to last link
  2746.                 move.l  0(A3,D2.l),D1   ;LFA of last word
  2747.                 move.l  D1,6(A3,D0.l)   ;link in voc.
  2748.                 addi.l  #6,D0
  2749.                 move.l  D0,0(A3,D2.l)   ;notate new link
  2750.  
  2751.                 move.l  D5,D0
  2752.                 addi.l  #odp,D0
  2753.                 move.l  0(A3,D0.l),D1   ;CP @
  2754.                 addq.l  #4,0(A3,D0.l)   ;make room for view-field
  2755.                 move.l  D5,D0
  2756.                 addi.l  #oblk,D0
  2757.                 move.l  0(A3,D0.l),0(A5,D1.l) ;save BLK@ in view-field
  2758.                 move.l  D5,D2
  2759.                 addi.l  #orootblk,D2
  2760.                 move.l  0(A3,D2.l),D2
  2761.                 add.l   D2,0(A5,D1.l)   ;add ROOTBLK in VIEW field
  2762.                 addq.l  #4,D1
  2763.                 move.l  D5,D0
  2764.                 addi.l  #olast,D0
  2765.                 move.l  0(A3,D0.l),D0
  2766.                 move.l  D1,2(A3,D0.l)   ;set CFA in header
  2767.                 bsr     align           ;make DP even again
  2768.                 rts
  2769. hd_col_err:     move.l  #-1,-(A6)
  2770.                 bsr     b_abort_quote
  2771.                 DC.L (noheadermess-datas)
  2772.  
  2773.                 ENDPART
  2774.  
  2775. *****************************************************************
  2776.                 >PART 'the ':' compiler'
  2777. *                                                               *
  2778. *****************************************************************
  2779.                 DC.L 0
  2780. colon:          bsr     header_colon    ;create header
  2781.                 bsr     right_brack     ;switch compiler on
  2782.                 rts
  2783.  
  2784.                 DC.L 0
  2785. m_colon:        bsr.s   colon
  2786.                 move.l  D5,D0
  2787.                 addi.l  #ois_macro,D0
  2788.                 move.l  #-1,0(A3,D0.l)
  2789.                 rts
  2790.  
  2791.                 DC.L 0
  2792. reveal:         move.l  D5,D0
  2793.                 addi.l  #olast,D0
  2794.                 move.l  0(A3,D0.l),D0   ;pointer to last header
  2795.                 andi.w  #$FFFE,0(A3,D0.l) ;delete SMUDGE-Bit
  2796.                 rts
  2797.  
  2798.  
  2799.                 DC.L 0
  2800. semi_colon:     move.l  D5,D0
  2801.                 addi.l  #odp,D0
  2802.                 move.l  0(A3,D0.l),D1
  2803.                 move.w  #rts_code,0(A5,D1.l)
  2804.                 addq.l  #2,D1
  2805.                 move.l  D1,0(A3,D0.l)
  2806.                 bsr.s   reveal
  2807.                 bsr     left_brack
  2808.  
  2809.                 tst.l   (was_local-datas)(A3)
  2810.                 beq.s   tst_macro
  2811.  
  2812. forget_locals:  clr.l   (was_local-datas)(A3)
  2813.                 move.l  D5,D0
  2814.                 addi.l  #ocurrent,D0
  2815.                 move.l  0(A3,D0.l),D0
  2816.                 move.l  (save_cur-datas)(A3),0(A3,D0.l)
  2817.                 move.l  D5,D0
  2818.                 addi.l  #odata,D0
  2819.                 move.l  (save_dp-datas)(A3),0(A3,D0.l)
  2820.  
  2821. tst_macro:      move.l  D5,D0
  2822.                 addi.l  #ois_macro,D0
  2823.                 tst.l   0(A3,D0.l)
  2824.                 bne.s   semi_col_m
  2825.                 rts
  2826. semi_col_m:     move.l  D5,D0
  2827.                 addi.l  #olast,D0
  2828.                 move.l  0(A3,D0.l),D1   ;fetch LAST
  2829.                 move.l  2(A3,D1.l),D0   ;fetch CFA
  2830.                 lea     0(A5,D0.l),A0   ;address of code (abs.)
  2831.  
  2832.                 move.l  D5,D0
  2833.                 addi.l  #odp,D0
  2834.                 move.l  0(A3,D0.l),D0   ;fetch CP
  2835.                 add.l   A5,D0           ;calc. abs. address
  2836.  
  2837.                 sub.l   A0,D0           ;length of code
  2838.                 subq.l  #2,D0           ;-2 for the RTS
  2839.                 lsr.l   #1,D0           ;length in words
  2840.                 mulu    #$0100,D0       ;shift 8 bit
  2841.                 bset    #3,D0           ;set macrobit
  2842.                 or.w    D0,0(A3,D1.l)   ;mark in control word
  2843.                 move.l  D5,D0
  2844.                 addi.l  #ois_macro,D0
  2845.                 clr.l   0(A3,D0.l)      ;clear IS_MACRO
  2846.                 rts
  2847.  
  2848.                 ENDPART
  2849.  
  2850. *****************************************************************
  2851.                 >PART 'simple stack words'
  2852. *                                                               *
  2853. *****************************************************************
  2854.                 DC.L 0
  2855. dup:            move.l  (A6),-(A6)
  2856.                 rts
  2857.  
  2858.  
  2859.                 DC.L 0
  2860. drop:           addq.l  #4,A6
  2861.                 rts
  2862.  
  2863.  
  2864.                 DC.L 0
  2865. swap:           movea.l (A6)+,A0        ;2
  2866.                 movea.l (A6),A1         ;2
  2867.                 move.l  A0,(A6)         ;2
  2868.                 move.l  A1,-(A6)        ;2
  2869.                 rts
  2870.  
  2871.  
  2872.                 DC.L 0
  2873. rot:            move.l  (A6)+,D0
  2874.                 movea.l (A6)+,A1
  2875.                 movea.l (A6),A0
  2876.                 move.l  A1,(A6)
  2877.                 move.l  D0,-(A6)
  2878.                 move.l  A0,-(A6)
  2879.                 rts
  2880.  
  2881.  
  2882.                 DC.L 0
  2883. quest_dup:      tst.l   (A6)
  2884.                 beq.s   quest_dup_end
  2885.                 move.l  (A6),-(A6)
  2886. quest_dup_end:  rts
  2887.  
  2888.  
  2889.                 DC.L 0
  2890. over:           move.l  4(A6),-(A6)
  2891.                 rts
  2892.  
  2893.  
  2894.                 DC.L 0
  2895. _2drop:         addq.l  #8,(A6)
  2896.                 rts
  2897.  
  2898.  
  2899.                 DC.L 0
  2900. _2dup:          move.l  4(A6),-(A6)
  2901.                 move.l  4(A6),-(A6)
  2902.                 rts
  2903.  
  2904.  
  2905.                 DC.L 0
  2906. _2over:         move.l  8(A6),-(A6)
  2907.                 move.l  8(A6),-(A6)
  2908.                 rts
  2909.  
  2910.  
  2911.                 DC.L 0
  2912. _2swap:         move.l  (A6)+,D0
  2913.                 move.l  (A6)+,D1
  2914.                 move.l  4(A6),-(A6)
  2915.                 move.l  4(A6),-(A6)
  2916.                 move.l  D0,8(A6)
  2917.                 move.l  D1,$0C(A6)
  2918.                 rts
  2919.  
  2920.                 ENDPART
  2921.  
  2922. *****************************************************************
  2923.                 >PART 'moving memory byte by byte'
  2924. *                                                               *
  2925. *****************************************************************
  2926.                 DC.L 0
  2927. cmove:          move.l  (A6)+,D0        ;( from to count -- )
  2928.                 movea.l (A6)+,A0        ;to
  2929.                 adda.l  A3,A0           ;convert to abs. address
  2930.                 movea.l (A6)+,A1        ;from
  2931.                 adda.l  A3,A1           ;dto.
  2932.                 tst.l   D0
  2933.                 beq.s   cmove_end
  2934. cmove_loop:     move.b  (A1)+,(A0)+
  2935.                 subq.l  #1,D0
  2936.                 bne.s   cmove_loop
  2937. cmove_end:      rts
  2938.  
  2939.  
  2940.                 DC.L 0
  2941. cmove_up:       move.l  (A6)+,D0        ;( from to count -- )
  2942.                 movea.l (A6)+,A0        ;to
  2943.                 adda.l  A3,A0           ;convert to abs. address
  2944.                 movea.l (A6)+,A1        ;from
  2945.                 adda.l  A3,A1           ;dto.
  2946.                 tst.l   D0
  2947.                 beq.s   cmove_up_end
  2948.                 adda.l  D0,A0
  2949.                 adda.l  D0,A1
  2950. cmove_up_loop:  move.b  -(A1),-(A0)
  2951.                 subq.l  #1,D0
  2952.                 bpl.s   cmove_up_loop
  2953. cmove_up_end:   rts
  2954.  
  2955.                 ENDPART
  2956.  
  2957. *****************************************************************
  2958.                 >PART 'the CREATE ... DOES> structure'
  2959. *                                                               *
  2960. *****************************************************************
  2961. * CREATE <name>  produces the following structure:              *
  2962. *       in data segment:        header                          *
  2963. *       in code segment:        move.l  seg(DT),seg             *
  2964. *                               jsr (dodoes-sys-of)(seg)        *
  2965. *                               HERE ,                          *
  2966. *****************************************************************
  2967. dodoes:         movea.l (SP)+,A0
  2968.                 move.l  (A0),-(A6)
  2969.                 rts
  2970.  
  2971.                 DC.L 0
  2972. create:         bsr     header_colon
  2973.                 bsr     reveal
  2974.                 move.l  #(dodoes-sys-of),-(A6) ;rel. address of dodoes
  2975.                 bsr     jsr_komma
  2976.                 move.l  D5,D0
  2977.                 addi.l  #odata,D0
  2978.                 move.l  0(A3,D0.l),-(A6)
  2979.                 bsr     code_komma
  2980.                 rts
  2981. * remark:  jsrSB_komma would be possible for CREATE, too, but DOES> needs
  2982. *          jsr_komma, because the address of the DOES>-code does not have
  2983. *          to be within the first codesegment
  2984.  
  2985.  
  2986. b_code:         move.l  (SP)+,D0        ;fetch address of code
  2987.                 sub.l   A5,D0           ;make it relative
  2988.                 move.l  D0,-(A6)        ;push it for JSR,
  2989.                 move.l  D5,D0
  2990.                 addi.l  #olast,D0
  2991.                 move.l  0(A3,D0.l),D0   ;address of last header
  2992.                 move.l  2(A3,D0.l),D0   ;address of code
  2993.                 move.l  D5,D1
  2994.                 addi.l  #odp,D1
  2995.                 move.l  0(A3,D1.l),-(SP) ;save CP
  2996.                 move.l  D0,0(A3,D1.l)   ;set CP to codeaddress
  2997.                 bsr     jsr_komma
  2998.                 move.l  (SP)+,0(A3,D1.l) ;restore CP
  2999.                 rts
  3000.  
  3001. does_code:      movea.l (SP)+,A0        ;save return vector
  3002.                 movea.l (SP)+,A1        ;get pointer to pointer to data
  3003.                 move.l  (A1),-(A6)      ;push pointer to data
  3004.                 jmp     (A0)            ;jump thru saved vector
  3005.  
  3006.  
  3007.                 DC.L 0
  3008. does:           move.l  #(b_code-sys-of),-(A6)
  3009.                 bsr     jsrSB_komma     ;this runs while definition
  3010.                 move.l  #(does_code-sys-of),-(A6)
  3011.                 bsr     jsrSB_komma     ;this runs while execution
  3012.                 rts
  3013.  
  3014.  
  3015. codedoes:       movea.l (SP)+,A1
  3016.                 movea.l (SP)+,A0        ;pointer to pointer to data
  3017.                 move.l  (A0),D0         ;pointer to data in A0
  3018.                 jmp     (A1)
  3019.  
  3020.                 DC.L 0
  3021. semcl_code:     move.l  #(b_code-sys-of),-(A6)
  3022.                 bsr     jsrSB_komma     ;this runs while definition
  3023.                 move.l  #(codedoes-sys-of),-(A6)
  3024.                 bsr     jsrSB_komma     ;this runs while execution
  3025.                 rts
  3026.  
  3027.                 ENDPART
  3028.  
  3029. *****************************************************************
  3030.                 >PART 'creating deferred words'
  3031. *                                                               *
  3032. *****************************************************************
  3033.  
  3034. defercrash:     move.l  #-1,-(A6)
  3035.                 bsr     b_abort_quote
  3036.                 DC.L (defercrashmess-datas)
  3037.                 rts
  3038.  
  3039.                 DC.L 0
  3040. defer:          bsr     header_colon
  3041.                 bsr     reveal
  3042.                 move.l  #(dodefer-sys-of),-(A6)
  3043.                 bsr     jsrSB_komma
  3044.                 move.l  D5,D0
  3045.                 addi.l  #odata,D0
  3046.                 move.l  0(A3,D0.l),-(A6)
  3047.                 bsr     code_komma      ;create pointer to pointer to code
  3048.                 move.l  #(defercrash-sys-of),-(A6)
  3049.                 bra     komma
  3050.  
  3051.                 ENDPART
  3052.  
  3053. *****************************************************************
  3054.                 >PART 'variables and constants'
  3055. *                                                               *
  3056. *****************************************************************
  3057.  
  3058.                 DC.L 0
  3059. variable:       bsr     create
  3060.                 clr.l   -(A6)
  3061.                 bra     komma
  3062.  
  3063.  
  3064.                 DC.L 0
  3065. constant:       bsr     header_colon
  3066.                 bsr     reveal
  3067.                 move.l  #moveimm_sp,-(A6) ;instead of LIT,
  3068.                 bsr     code_wkomma     ;real code
  3069.                 bsr     code_komma      ;is generated
  3070.                 move.l  #rts_code,-(A6)
  3071.                 bra     code_wkomma
  3072.  
  3073.  
  3074.                 DC.L 0
  3075. bl:             move.l  #$20,-(A6)
  3076.                 rts
  3077.  
  3078.  
  3079.                 ENDPART
  3080.  
  3081. *****************************************************************
  3082.                 >PART 'values and locals'
  3083. *                                                               *
  3084. *****************************************************************
  3085. *
  3086. * VALUEs and LOCALs generate the same kind of code and access it
  3087. * in a very similar manner:
  3088. *
  3089. *       Call Fetcher
  3090. *       Address of Data
  3091. *       Call Storer
  3092. *
  3093. * The fetcher expects the address of data as an in-line address
  3094. * behind his call, whereas the storer expects it in front of it's
  3095. * call.
  3096. * Fetcher and storer are compiled using 'JSR,', because a defined
  3097. * length of code (8 bytes, worst case) is important for 'TO'.
  3098.  
  3099. * writing access using 'TO'
  3100.                 DC.L 0
  3101. to:             bsr     tick            ;get address of code
  3102.                 addi.l  #$0C,(A6)       ;> address of storer
  3103.                 move.l  D5,D0
  3104.                 addi.l  #ostate,D0
  3105.                 tst.l   0(A3,D0.l)      ;test STATE
  3106.                 bne.s   comp_val
  3107.                 move.l  (A6)+,D0
  3108.                 jmp     0(A5,D0.l)      ;execute ...
  3109. comp_val:       bra     jsr_komma       ;... or compile
  3110.  
  3111.  
  3112. val_fetch:      movea.l (SP)+,A0        ;get pointer to in-line
  3113.                 move.l  (A0),D0
  3114.                 move.l  0(A3,D0.l),-(A6)
  3115.                 rts
  3116.  
  3117. val_store:      movea.l (SP)+,A0
  3118.                 move.l  -8(A0),D0
  3119.                 move.l  (A6)+,0(A3,D0.l)
  3120.                 rts
  3121.  
  3122.                 DC.L 0
  3123. value:          bsr     header_colon
  3124.                 bsr     reveal
  3125.                 move.l  #(val_fetch-sys-of),-(A6)
  3126.                 bsr     jsr_komma
  3127.                 move.l  D5,D0
  3128.                 addi.l  #odata,D0
  3129.                 move.l  0(A3,D0.l),-(A6)
  3130.                 bsr     code_komma
  3131.                 move.l  #(val_store-sys-of),-(A6)
  3132.                 bsr     jsrSB_komma
  3133.                 bra     komma
  3134.  
  3135.  
  3136.  
  3137. free_loc:       addq.l  #4,SP
  3138.                 rts
  3139.  
  3140. loc_init:       movea.l (SP),A0         ;get pointer to the fetcher
  3141.                 move.l  (A6)+,(SP)      ;put value on the stack
  3142.                 move.l  8(A0),D0        ;fetch datapointer
  3143.                 move.l  SP,0(A3,D0.l)   ;set address of data on stack
  3144.                 move.l  #(free_loc-sys-of),D0 ;address of free_loc for later use
  3145.                 pea     0(A5,D0.l)
  3146.                 jmp     $10(A0)         ;jump behind storer
  3147.  
  3148. loc_fetch:      movea.l (SP)+,A0        ;get inline pointer
  3149.                 move.l  (A0),D0         ;get offset into data segment
  3150.                 movea.l 0(A3,D0.l),A0   ;get the pointer to the data
  3151.                 move.l  (A0),-(A6)      ;fetch the data
  3152.                 rts
  3153.  
  3154. loc_store:      movea.l (SP)+,A0
  3155.                 move.l  -8(A0),D0
  3156.                 movea.l 0(A3,D0.l),A0
  3157.                 move.l  (A6)+,(A0)
  3158.                 rts
  3159.  
  3160.                 DC.L 0
  3161. local:          tst.l   (was_local-datas)(A3) ;first local?
  3162.                 bne.s   no_save         ;not?, nothing has to be saved
  3163.                 move.l  D5,D0           ;otherwise save CURRENT@@ und HERE
  3164.                 addi.l  #ocurrent,D0
  3165.                 move.l  0(A3,D0.l),D0   ;CURRENT @
  3166.                 move.l  0(A3,D0.l),(save_cur-datas)(A3) ;@ SAVE_CUR !
  3167.                 move.l  D5,D0
  3168.                 addi.l  #odata,D0
  3169.                 move.l  0(A3,D0.l),(save_dp-datas)(A3) ;HERE SAVE_DP !
  3170.                 move.l  #-1,(was_local-datas)(A3) ;WAS_LOCAL ON
  3171. no_save:        move.l  D5,D0
  3172.                 addi.l  #olast,D0
  3173.                 move.l  0(A3,D0.l),-(SP) ;LAST PUSH
  3174.                 bsr     header_colon    ;HEADER:
  3175.                 bsr     reveal          ;create a header
  3176.                 move.l  D5,D0
  3177.                 addi.l  #odp,D0
  3178.                 subi.l  #4,0(A3,D0.l)   ;-4 CP +!    remove VIEW-field
  3179.                 move.l  #(loc_init-sys-of),-(A6)
  3180.                 bsr     jsrSB_komma     ;compile loc_init
  3181.                 move.l  D5,D0
  3182.                 addi.l  #odp,D0
  3183.                 move.l  D5,D1
  3184.                 addi.l  #olast,D1
  3185.                 move.l  0(A3,D1.l),D1   ;LAST @
  3186.                 move.l  0(A3,D0.l),2(A3,D1.l) ;CP @ SWAP 2+ !
  3187. *                                       ;set pointer in header to loc_init
  3188.  
  3189.                 move.l  #(loc_fetch-sys-of),-(A6)
  3190.                 bsr     jsr_komma       ;compile fetcher
  3191.                 move.l  save_dp-datas(A3),-(A6)
  3192.                 addq.l  #4,save_dp-datas(A3) ;allocate space in data segment
  3193.                 bsr     code_komma      ;compile pointer to it
  3194.                 move.l  #(loc_store-sys-of),-(A6)
  3195.                 bsr     jsrSB_komma     ;compile storer
  3196.  
  3197.                 move.l  D5,D0
  3198.                 addi.l  #olast,D0
  3199.                 move.l  (SP)+,0(A3,D0.l) ;restore LAST
  3200.                 rts
  3201.  
  3202.                 ENDPART
  3203.  
  3204. *****************************************************************
  3205. *                                                               *
  3206. *       structures controlling program flow                     *
  3207. *                                                               *
  3208. *****************************************************************
  3209.  
  3210. *****************************************************************
  3211.                 >PART 'a.) LOOPs   and general stuff'
  3212. *****************************************************************
  3213.                 DC.L 0
  3214. b_do:           movea.l (SP)+,A0        ;return pointer
  3215.                 movem.l D6-D7,-(SP)
  3216.                 addq.l  #4,A0           ;behind (DO is a pointer to behind LOOP
  3217.                 move.l  A0,-(SP)
  3218.                 move.l  (A6)+,D7        ;initial value
  3219.                 move.l  (A6)+,D6
  3220.                 sub.l   D6,D7           ;start-limit    (<0)
  3221.                 jmp     (A0)            ;
  3222.  
  3223.  
  3224.                 DC.L 0
  3225. b_quest_do:     movea.l (SP)+,A0        ;return pointer
  3226.                 move.l  (A6),D0
  3227.                 cmp.l   4(A6),D0
  3228.                 beq.s   no_do
  3229.                 movem.l D6-D7,-(SP)
  3230.                 addq.l  #4,A0           ;behind (DO is a pointer to behind LOOP
  3231.                 move.l  A0,-(SP)
  3232.                 move.l  (A6)+,D7        ;initial value
  3233.                 move.l  (A6)+,D6
  3234.                 sub.l   D6,D7           ;start-limit    (<0)
  3235.                 jmp     (A0)            ;
  3236. no_do:          addq.l  #8,A6           ;drop limits
  3237.                 move.l  (A0),D0         ;fetch pointer to behind LOOP
  3238.                 jmp     0(A5,D0.l)
  3239.  
  3240.  
  3241.                 DC.L 0
  3242. b_loop:         addq.l  #1,D7           ;increase index
  3243.                 bcs.s   no_more_loop    ;enough?
  3244.                 addq.l  #4,SP           ;drop return address
  3245.                 movea.l (SP),A0         ;fetch pointer to (DO
  3246.                 jmp     (A0)            ;and jump back
  3247. no_more_loop:   movea.l (SP)+,A0        ;get return pointer
  3248.                 addq.l  #4,SP           ;drop pointer to (DO
  3249.                 movem.l (SP)+,D6-D7     ;restore registers
  3250.                 jmp     (A0)            ;and LOOP has finished
  3251.  
  3252.  
  3253.                 DC.L 0
  3254. b_plus_loop:    tst.l   (A6)
  3255.                 bpl.s   incr
  3256.                 neg.l   (A6)
  3257.                 sub.l   (A6)+,D7
  3258.                 bls.s   no_more_pl_lp
  3259.                 addq.l  #4,SP
  3260.                 movea.l (SP),A0
  3261.                 jmp     (A0)
  3262. incr:           add.l   (A6)+,D7
  3263.                 bcs.s   no_more_pl_lp
  3264.                 addq.l  #4,SP
  3265.                 movea.l (SP),A0
  3266.                 jmp     (A0)
  3267. no_more_pl_lp:  movea.l (SP)+,A0
  3268.                 addq.l  #4,SP
  3269.                 movem.l (SP)+,D6-D7
  3270.                 jmp     (A0)
  3271.  
  3272.  
  3273.                 DC.L 0
  3274. i:              move.l  D6,-(A6)        ;limit
  3275.                 add.l   D7,(A6)         ;+index (<0)
  3276.                 rts
  3277.  
  3278.  
  3279.                 DC.L 0
  3280. j:              movea.l (SP)+,A0
  3281.                 move.l  8(SP),D0
  3282.                 add.l   4(SP),D0
  3283.                 move.l  D0,-(A6)
  3284.                 jmp     (A0)
  3285.  
  3286.  
  3287.                 DC.L 0
  3288. unloop:         movea.l (SP)+,A1
  3289.                 movea.l (SP)+,A0
  3290.                 movem.l (SP)+,D6-D7
  3291. *                lea     $0C(SP),SP
  3292.                 jmp     (A1)
  3293.  
  3294.  
  3295.                 DC.L 0
  3296. to_mark:        move.l  D5,D0
  3297.                 addi.l  #odp,D0
  3298.                 move.l  0(A3,D0.l),-(A6) ;CP @
  3299.                 clr.l   -(A6)           ;0
  3300.                 jmp     (code_komma-sys-of)(A5) ; CODE,
  3301.  
  3302.  
  3303.                 DC.L 0
  3304. to_resolve:     move.l  D5,D0
  3305.                 addi.l  #odp,D0
  3306.                 move.l  0(A3,D0.l),D0   ;CP @
  3307.                 movea.l (A6)+,A0
  3308.                 adda.l  A5,A0
  3309.                 move.l  D0,(A0)         ;SWAP !
  3310.                 rts
  3311.  
  3312.                 DC.L 0
  3313. less_mark:      move.l  D5,D0
  3314.                 addi.l  #odp,D0
  3315.                 move.l  0(A3,D0.l),-(A6) ;CP @
  3316.                 rts
  3317.  
  3318.  
  3319.                 DC.L 0
  3320. less_resolve:   bsr     code_komma
  3321.                 rts
  3322.  
  3323.  
  3324.                 DC.L 0
  3325. do:             move.l  #(b_do-sys-of),-(A6)
  3326.                 bsr     jsrSB_komma     ;compile (do
  3327.                 bsr.s   to_mark         ;>mark
  3328.                 move.l  D5,D0
  3329.                 addi.l  #ois_macro,D0
  3330.                 clr.l   0(A3,D0.l)
  3331.                 rts
  3332.  
  3333.  
  3334.                 DC.L 0
  3335. loop:           move.l  #(b_loop-sys-of),-(A6)
  3336.                 bsr     jsrSB_komma
  3337.                 bra.s   to_resolve
  3338.  
  3339.  
  3340.                 DC.L 0
  3341. quest_do:       move.l  #(b_quest_do-sys-of),-(A6)
  3342.                 bsr     jsrSB_komma     ;compile (?do
  3343.                 bsr     to_mark         ;>mark
  3344.                 move.l  D5,D0
  3345.                 addi.l  #ois_macro,D0
  3346.                 clr.l   0(A3,D0.l)
  3347.                 rts
  3348.  
  3349.  
  3350.                 DC.L 0
  3351. p_loop:         move.l  #(b_plus_loop-sys-of),-(A6)
  3352.                 bsr     jsrSB_komma
  3353.                 bra     to_resolve
  3354.  
  3355.  
  3356.                 DC.L 0
  3357. leave:          addq.l  #4,SP           ;drop retrun address
  3358.                 movea.l (SP)+,A0        ;get LOOP-pointer
  3359.                 move.l  -4(A0),D0       ;fetch address, that points after LOOP
  3360.                 movem.l (SP)+,D6-D7     ;restore registers
  3361.                 jmp     0(A5,D0.l)      ;jump behind loop
  3362.  
  3363.                 ENDPART
  3364.  
  3365. *****************************************************************
  3366.                 >PART 'b.) decisions'
  3367. *****************************************************************
  3368. * IF-Code for high-level branches, see ?BRANCH
  3369. if_code:        movea.l (SP)+,A0
  3370.                 tst.l   (A6)+
  3371.                 beq.s   if_false
  3372.                 addq.l  #4,A0           ;adr Überbrücken
  3373.                 jmp     (A0)
  3374. if_false:       move.l  (A0),D0
  3375.                 jmp     0(A5,D0.l)
  3376.  
  3377.  
  3378.                 DC.L 0
  3379. quest_branch:   move.l  #(if_code-sys-of),-(A6)
  3380.                 bsr     jsrSB_komma
  3381.                 rts
  3382.  
  3383.  
  3384.  
  3385.                 DC.L 0
  3386. if:             bsr.s   quest_branch    ;: IF ?branch >mark ;
  3387.                 jmp     (to_mark-sys-of)(A5)
  3388.  
  3389.  
  3390.                 DC.L 0
  3391. then:           bra     to_resolve
  3392.  
  3393.  
  3394. * ELSE-Code for high-level branches, s. BRANCH
  3395. else_code:      movea.l (SP)+,A0
  3396.                 move.l  (A0),D0
  3397.                 jmp     0(A5,D0.l)
  3398.  
  3399.                 DC.L 0
  3400. branch:         move.l  #(else_code-sys-of),-(A6)
  3401.                 jmp     (jsrSB_komma-sys-of)(A5)
  3402.  
  3403.  
  3404. * else_cd:      bra     #$12345678
  3405.  
  3406.                 DC.L 0
  3407. else:           bsr.s   branch
  3408.                 bsr     to_mark
  3409.                 bsr     swap
  3410.                 bra     to_resolve
  3411.  
  3412. *               move.l  d5,d0
  3413. *               addi.l  #odp,d0
  3414. *               move.l  (a3,d0.l),d1            ;CP @
  3415. *               move.l  #(else_cd-sys-of),a0
  3416. *               adda.l  a5,a0
  3417. *               move.l  (a0)+,(a5,d1.l)         ;copy code
  3418. *               addq.l  #4,d1
  3419. *               move.l  d1,(a3,d0.l)            ;CP !
  3420. *               subq.l  #2,d1
  3421. *               move.l  (a6)+,d2                ;position of IF
  3422. *               move.l  d1,-(a6)                ;something like >MARK
  3423. *               addq.l  #2,d1
  3424. *               sub.l   d2,d1                   ;distance
  3425. *               move.w  d1,(a5,d2.l)            ;fix offset
  3426. *               rts
  3427.  
  3428.                 ENDPART
  3429.  
  3430. *****************************************************************
  3431.                 >PART 'c.) conditional loops'
  3432. *****************************************************************
  3433.                 DC.L 0
  3434. begin:          bsr     less_mark
  3435.                 move.l  D5,D0
  3436.                 addi.l  #ois_macro,D0
  3437.                 clr.l   0(A3,D0.l)
  3438.                 rts
  3439.  
  3440.                 DC.L 0
  3441. until:          bsr.s   quest_branch    ;?BRANCH
  3442.                 bra     code_komma      ;CODE,
  3443.  
  3444.                 DC.L 0
  3445. again:          bsr.s   branch          ;BRANCH
  3446.                 bra     code_komma      ;CODE,
  3447.  
  3448.  
  3449.                 DC.L 0
  3450. repeat:         bsr.s   branch          ;BRANCH
  3451.                 bsr     code_komma      ;CODE,
  3452.                 bra     to_resolve      ;THEN
  3453.  
  3454.                 DC.L 0
  3455. while:          bsr     quest_branch    ;?BRANCH
  3456.                 bsr     to_mark         ;>MARK
  3457.                 bra     swap            ;SWAP
  3458.  
  3459.                 ENDPART
  3460.  
  3461. *****************************************************************
  3462.                 >PART 'comparisons'
  3463. *                                                               *
  3464. *****************************************************************
  3465.  
  3466.  
  3467.                 DC.L 0
  3468. null_gleich:    tst.l   (A6)
  3469.                 seq     D0
  3470.                 ext.w   D0
  3471.                 ext.l   D0
  3472.                 move.l  D0,(A6)
  3473.                 rts
  3474.  
  3475.                 DC.L 0
  3476. null_greater:   tst.l   (A6)
  3477.                 sgt     D0
  3478.                 ext.w   D0
  3479.                 ext.l   D0
  3480.                 move.l  D0,(A6)
  3481.                 rts
  3482.  
  3483.                 DC.L 0
  3484. null_less:      tst.l   (A6)
  3485.                 slt     D0
  3486.                 ext.w   D0
  3487.                 ext.l   D0
  3488.                 move.l  D0,(A6)
  3489.                 rts
  3490.  
  3491.                 DC.L 0
  3492. null_grgl:      tst.l   (A6)
  3493.                 sge     D0
  3494.                 ext.w   D0
  3495.                 ext.l   D0
  3496.                 move.l  D0,(A6)
  3497.                 rts
  3498.  
  3499.                 DC.L 0
  3500. null_legl:      tst.l   (A6)
  3501.                 sle     D0
  3502.                 ext.w   D0
  3503.                 ext.l   D0
  3504.                 move.l  D0,(A6)
  3505.                 rts
  3506.  
  3507.                 DC.L 0
  3508. gleich:         move.l  (A6)+,D0
  3509.                 cmp.l   (A6),D0
  3510.                 seq     D0
  3511.                 ext.w   D0
  3512.                 ext.l   D0
  3513.                 move.l  D0,(A6)
  3514.                 rts
  3515.  
  3516.  
  3517.                 DC.L 0
  3518. ungleich:       move.l  (A6)+,D0
  3519.                 cmp.l   (A6),D0
  3520.                 sne     D0
  3521.                 ext.w   D0
  3522.                 ext.l   D0
  3523.                 move.l  D0,(A6)
  3524.                 rts
  3525.  
  3526.  
  3527.                 DC.L 0
  3528. less:           move.l  (A6)+,D0
  3529.                 cmp.l   (A6),D0
  3530.                 sgt     D0
  3531.                 ext.w   D0
  3532.                 ext.l   D0
  3533.                 move.l  D0,(A6)
  3534.                 rts
  3535.  
  3536.  
  3537.                 DC.L 0
  3538. greater:        move.l  (A6)+,D0
  3539.                 cmp.l   (A6),D0
  3540.                 slt     D0
  3541.                 ext.w   D0
  3542.                 ext.l   D0
  3543.                 move.l  D0,(A6)
  3544.                 rts
  3545.  
  3546.                 DC.L 0
  3547. grgl:           move.l  (A6)+,D0
  3548.                 cmp.l   (A6),D0
  3549.                 sle     D0
  3550.                 ext.w   D0
  3551.                 ext.l   D0
  3552.                 move.l  D0,(A6)
  3553.                 rts
  3554.  
  3555.  
  3556.                 DC.L 0
  3557. legl:           move.l  (A6)+,D0
  3558.                 cmp.l   (A6),D0
  3559.                 sge     D0
  3560.                 ext.w   D0
  3561.                 ext.l   D0
  3562.                 move.l  D0,(A6)
  3563.                 rts
  3564.  
  3565.  
  3566.  
  3567.  
  3568.                 DC.L 0
  3569. min:            move.l  (A6)+,D0
  3570.                 cmp.l   (A6),D0
  3571.                 bpl.s   min_end
  3572.                 move.l  D0,(A6)
  3573. min_end:        rts
  3574.  
  3575.                 DC.L 0
  3576. max:            move.l  (A6)+,D0
  3577.                 cmp.l   (A6),D0
  3578.                 bmi.s   max_end
  3579.                 move.l  D0,(A6)
  3580. max_end:        rts
  3581.  
  3582.  
  3583.  
  3584.  
  3585.                 ENDPART
  3586.  
  3587. *****************************************************************
  3588.                 >PART 'forgeting words'
  3589. *                                                               *
  3590. *****************************************************************
  3591. forget_words:   movem.l D0-D2,-(SP)     ;( to_pfa voc -- )
  3592.                 move.l  (A6)+,D1
  3593.                 move.l  0(A5,D1.l),D1   ;ptr to ptr to last header
  3594.                 move.l  0(A3,D1.l),D0   ;fetch address of last header
  3595. frgt_wds_loop:  move.l  -4(A3,D0.l),D2  ;fetch  PFA
  3596.                 cmp.l   (A6),D2         ;> to_pfa
  3597.                 bmi.s   frgt_wds_end    ;no? , then stop
  3598.  
  3599.                 move.l  D5,D2
  3600.                 addi.l  #odata,D2
  3601.                 move.l  D0,0(A3,D2.l)   ;new DP
  3602.                 subi.l  #6,0(A3,D2.l)   ;for control word and CFA
  3603.  
  3604.                 move.l  0(A3,D0.l),D0   ;next LFA
  3605.                 move.l  D0,0(A3,D1.l)   ;new entry in voc.
  3606.  
  3607.                 bra.s   frgt_wds_loop
  3608. frgt_wds_end:   addq.l  #4,A6           ;drop to_pfa
  3609.                 movem.l (SP)+,D0-D2
  3610.                 rts
  3611.  
  3612.  
  3613. voc_remove:     move.l  D5,D0           ;( to_pfa -- )
  3614.                 addi.l  #ovocpa,D0
  3615.                 movea.l 0(A3,D0.l),A1   ;base of vocstack
  3616.                 adda.l  A3,A1           ;calc. abs. address
  3617.                 move.l  (A1)+,D0        ;VOCPA stack heigth
  3618.                 addq.l  #4,A1
  3619.                 subq.l  #4,D0           ;ONLY cannot be forgotten
  3620. vc_rm_loop:     move.l  (A1)+,D1        ;fetch first vocabulary
  3621.                 move.l  4(A3,D1.l),D1   ;link back to code
  3622.                 cmp.l   (A6),D1         ;< to_addr?
  3623.                 ble.s   vc_rm1
  3624.                 move.l  -8(A1),-4(A1)   ;replace voc by the last
  3625. vc_rm1:         subq.l  #4,D0           ;no more vocabulary?
  3626.                 bne.s   vc_rm_loop      ;do the others
  3627.  
  3628.                 move.l  D5,D0
  3629.                 addi.l  #ocurrent,D0
  3630.                 move.l  0(A3,D0.l),D1
  3631.                 move.l  4(A3,D1.l),D1   ;link back to code
  3632.                 cmp.l   (A6),D1         ;forget current?
  3633.                 blt.s   vc_rm2
  3634.                 move.l  -8(A1),0(A3,D0.l) ;new current
  3635.  
  3636. * now all vocs, which had to be forgotten, all removed from search order
  3637. * they have to be unlinked:
  3638. vc_rm2:         move.l  D5,D0
  3639.                 addi.l  #ovoc_link,D0
  3640.                 move.l  0(A3,D0.l),D1   ;VOC-LINK @
  3641.                 movea.l D1,A0
  3642.                 subq.l  #8,A0           ;pointer to pfa
  3643. vc_rm_unlink:   tst.l   D1              ;end of Voc-Link?
  3644.                 beq.s   vc_rm_end
  3645.                 cmpa.l  (A6),A0         ;> to_pfa?
  3646.                 bge.s   vc_rm3          ;then next voc
  3647.                 move.l  D1,0(A3,D0.l)   ;otherwise shorten linklist
  3648.                 bra.s   vc_rm_end
  3649. vc_rm3:         move.l  0(A5,D1.l),D1   ; next Voc.
  3650.                 movea.l D1,A0
  3651.                 subq.l  #8,A0           ;pointer to pfa
  3652.                 bra.s   vc_rm_unlink
  3653. vc_rm_end:      addq.l  #4,A6           ;drop to_pfa
  3654.                 rts
  3655.  
  3656.  
  3657.                 DC.L 0
  3658. b_forget:       move.l  (A6)+,-(SP)     ;( to_pfa -- ) save to_pfa
  3659.                 move.l  D5,D0
  3660.                 addi.l  #ovoc_link,D0
  3661.                 move.l  0(A3,D0.l),D0   ;VOC-LINK @
  3662. b_frgt_loop:    tst.l   D0
  3663.                 beq.s   b_forget_vocs   ;last voc?
  3664.                 move.l  D0,D1
  3665.                 subi.l  #4,D1
  3666.                 move.l  (SP),-(A6)      ;DUP to_pfa
  3667.                 move.l  D1,-(A6)
  3668.                 bsr     forget_words
  3669.                 move.l  0(A5,D0.l),D0
  3670.                 bra.s   b_frgt_loop
  3671. b_forget_vocs:  move.l  (SP),-(A6)      ;DUP to_pfa
  3672.                 bsr     voc_remove      ;remove vocabularies
  3673.                 move.l  D5,D0
  3674.                 addi.l  #odp,D0
  3675.                 move.l  (SP)+,0(A3,D0.l) ;new CP
  3676.                 subq.l  #4,0(A3,D0.l)   ;kill VIEW-field, too
  3677.                 move.l  D5,D0
  3678.                 addi.l  #olast,D0
  3679.                 clr.l   0(A3,D0.l)      ; 0 LAST !
  3680.                 rts
  3681.  
  3682.  
  3683.                 DC.L 0
  3684. forget:         bsr     name
  3685.                 bsr     find
  3686.                 cmpi.l  #-1,(A6)+
  3687.                 bne.s   frgt_weiter
  3688.                 bra     notfound
  3689. frgt_weiter:    move.l  (A6),D0
  3690.                 move.l  0(A3,D0.l),D0   ;fetch pfa
  3691. ;                move.l  D5,D1
  3692. ;                addi.l  #ofence,D1
  3693. ;                cmp.l   0(A3,D1.l),D0
  3694.                 cmp.l   (tfence-datas)(A3),D0
  3695.                 bmi.s   cannot_frgt
  3696.                 move.l  D0,(A6)
  3697.                 bra.s   b_forget
  3698. cannot_frgt:    addi.l  #8,(A6)
  3699.                 move.l  #-1,-(A6)       ;TRUE-Flag
  3700.                 bsr     b_error_quote
  3701.                 DC.L (fencemess-datas)
  3702.                 rts
  3703.  
  3704.                 ENDPART
  3705.  
  3706. *****************************************************************
  3707.                 >PART 'words using existing runtimes'
  3708. *                                                               *
  3709. *****************************************************************
  3710.                 DC.L 0
  3711. string_komma:   move.l  #'"',-(A6)
  3712.                 bsr     word
  3713.                 moveq   #0,D0
  3714.                 move.l  (A6)+,D0
  3715.                 moveq   #0,D1
  3716.                 move.b  0(A3,D0.l),D1   ;fetch count
  3717.                 addq.b  #1,D1           ;count byte
  3718.                 move.l  D1,-(A6)
  3719.                 bsr     allot
  3720.                 rts
  3721.  
  3722.  
  3723.                 DC.L 0
  3724. string_emit:    move.l  #(b_string_emit-sys-of),-(A6)
  3725.                 bsr     jsrSB_komma
  3726.                 bsr     align
  3727.                 bsr     here
  3728.                 bsr     code_komma
  3729.                 bsr.s   string_komma
  3730.                 rts
  3731.  
  3732.  
  3733.                 DC.L 0
  3734. dot_brack:      move.l  #')',-(A6)
  3735.                 bsr     word
  3736.                 bsr     count
  3737.                 bsr     type
  3738.                 rts
  3739.  
  3740.  
  3741.                 DC.L 0
  3742. comment_brack:  move.l  #')',-(A6)
  3743.                 bsr     word
  3744.                 addq.l  #4,A6
  3745.                 rts
  3746.  
  3747.  
  3748.                 DC.L 0
  3749. error_quote:    move.l  #(b_error_quote-sys-of),-(A6) ;cfa
  3750.                 bsr     jsrSB_komma
  3751.                 bsr     align
  3752.                 bsr     here
  3753.                 bsr     code_komma
  3754.                 bsr     string_komma
  3755.                 rts
  3756.  
  3757.  
  3758.                 DC.L 0
  3759. abort:          move.l  D5,D0
  3760.                 addi.l  #oerror,D0
  3761.                 move.l  0(A3,D0.l),D0
  3762.                 jsr     0(A5,D0.l)
  3763.                 rts
  3764.  
  3765.  
  3766.                 DC.L 0
  3767. abort_quote:    move.l  #(b_abort_quote-sys-of),-(A6)
  3768.                 bsr     jsrSB_komma
  3769.                 bsr     align
  3770.                 bsr     here
  3771.                 bsr     code_komma
  3772.                 bsr     string_komma
  3773.                 rts
  3774.  
  3775.  
  3776.                 DC.L 0
  3777. quote:          move.l  D5,D0
  3778.                 addi.l  #ostate,D0
  3779.                 tst.l   0(A3,D0.l)      ;STATE @ IF
  3780.                 beq.s   quote1
  3781.                 move.l  #(b_str_quote-sys-of),-(A6)
  3782.                 bsr     jsrSB_komma
  3783.                 bsr     align
  3784.                 bsr     here
  3785.                 bsr     code_komma
  3786.                 bra     string_komma
  3787. quote1:         move.l  #'"',-(A6)      ;ELSE ASCII " WORD
  3788.                 bsr     word
  3789.                 bsr     pad
  3790.                 move.l  4(A6),D0        ;COUNT 1+
  3791.                 clr.l   -(A6)
  3792.                 move.b  0(A3,D0.l),3(A6) ;PAD    SWAP CMOVE
  3793.                 addq.l  #1,(A6)
  3794.                 bsr     cmove
  3795.                 bra     pad             ;PAD
  3796.  
  3797. ******************************************************************
  3798.                 DC.L 0
  3799. postpone:       bsr     name
  3800.                 bsr     find
  3801.                 move.l  (A6)+,D0
  3802.                 cmp.l   #-1,D0
  3803.                 beq.s   post_err
  3804.                 btst    #1,D0           ;immediate?
  3805.                 bne.s   compile         ;then compile it
  3806.                 bsr     literal
  3807.                 move.l  #(__com_komma-datas-4),-(A6) ;pfa of COM,
  3808. compile:        bra     com_komma
  3809. post_err:       bra     notfound
  3810.  
  3811.  
  3812.                 DC.L 0
  3813. immediate:      move.l  D5,D0
  3814.                 addi.l  #olast,D0
  3815.                 move.l  0(A3,D0.l),D0   ;header of last word
  3816.                 ori.w   #2,0(A3,D0.l)   ;set immediate bit
  3817.                 rts
  3818.  
  3819.                 DC.L 0
  3820. restrict:       move.l  D5,D0
  3821.                 addi.l  #olast,D0
  3822.                 move.l  0(A3,D0.l),D0   ;header of last word
  3823.                 ori.w   #4,0(A3,D0.l)   ;set restrict bit
  3824.                 rts
  3825.  
  3826.                 ENDPART
  3827.  
  3828. *****************************************************************
  3829.                 >PART 'creating vocabularies'
  3830. *                                                               *
  3831. *****************************************************************
  3832.  
  3833.                 DC.L 0
  3834. vocabulary:     bsr     header_colon
  3835.                 move.l  #(dovoca-sys-of),-(A6)
  3836.                 bsr     jsrSB_komma
  3837.                 bsr     here
  3838.                 bsr     code_komma
  3839.                 move.l  #(__first-datas),-(A6)
  3840.                 bsr     komma
  3841.                 move.l  D5,D0
  3842.                 addi.l  #odp,D0
  3843.                 move.l  0(A3,D0.l),-(A6) ;CP @
  3844.                 move.l  (A6),-(A6)      ;DUP
  3845.                 subq.l  #4,(A6)
  3846.                 bsr     komma
  3847.  
  3848.                 move.l  D5,D0
  3849.                 addi.l  #ovoc_link,D0
  3850.                 move.l  0(A3,D0.l),-(A6)
  3851.                 move.l  D0,-(SP)
  3852.                 bsr     code_komma
  3853.                 move.l  (SP)+,D0
  3854.                 move.l  (A6)+,0(A3,D0.l)
  3855.                 bra     reveal
  3856.  
  3857.                 ENDPART
  3858.  
  3859. *****************************************************************
  3860.                 >PART 'FILL, ERASE'
  3861.  
  3862.                 DC.L 0
  3863. fill:           move.l  (A6)+,D0
  3864.                 move.l  (A6)+,D1
  3865.                 movea.l (A6)+,A0
  3866.                 adda.l  A3,A0
  3867.                 subq.l  #1,D1
  3868. fill_loop:      move.b  D0,(A0)+
  3869.                 dbra    D1,fill_loop
  3870.                 rts
  3871.  
  3872.  
  3873.                 DC.L 0
  3874. erase:          move.l  (A6)+,D0
  3875.                 movea.l (A6)+,A0
  3876.                 adda.l  A3,A0
  3877.                 subq.l  #1,D0
  3878. eraseloop:      clr.b   (A0)+
  3879.                 dbra    D0,eraseloop
  3880.                 rts
  3881.  
  3882.                 ENDPART
  3883.  
  3884. *****************************************************************
  3885.                 >PART '1+, CELL+, etc.'
  3886.  
  3887.                 DC.L 0
  3888. one_plus:       addq.l  #1,(A6)
  3889.                 rts
  3890.  
  3891.  
  3892.                 DC.L 0
  3893. one_minus:      subq.l  #1,(A6)
  3894.                 rts
  3895.  
  3896.                 DC.L 0
  3897. two_plus:       addq.l  #2,(A6)
  3898.                 rts
  3899.  
  3900.                 DC.L 0
  3901. two_minus:      subq.l  #2,(A6)
  3902.                 rts
  3903.  
  3904.                 DC.L 0
  3905. two_mult:       move.l  (A6),D0
  3906.                 add.l   D0,D0
  3907.                 move.l  D0,(A6)
  3908.                 rts
  3909.  
  3910.                 DC.L 0
  3911. two_div:        move.l  (A6),D0
  3912.                 asr.l   #1,D0
  3913.                 move.l  D0,(A6)
  3914.                 rts
  3915.  
  3916.  
  3917.                 DC.L 0
  3918. cell_plus:      addq.l  #4,(A6)
  3919.                 rts
  3920.  
  3921.  
  3922.                 DC.L 0          ;( n -- n*4 )
  3923. cells:          move.l  (A6),D0
  3924.                 asl.l   #2,D0
  3925.                 move.l  D0,(A6)
  3926.                 rts
  3927.  
  3928.  
  3929.                 DC.L 0          ;( n -- n+1 )
  3930. char_plus:      addq.l  #1,(A6)
  3931.                 rts
  3932.  
  3933.  
  3934.                 DC.L 0          ; ( n -- n ) * this is ANSI
  3935. chars:          rts
  3936.  
  3937.  
  3938.                 ENDPART
  3939.  
  3940. *****************************************************************
  3941.                 >PART 'other mass storage words'
  3942. *                                                               *
  3943. *****************************************************************
  3944.  
  3945.                 DC.L 0
  3946. update:         move.l  D5,D0
  3947.                 addi.l  #oprev,D0
  3948.                 move.l  0(A3,D0.l),D0
  3949.                 move.w  #1,$0C(A3,D0.l)
  3950.                 rts
  3951.  
  3952.  
  3953.                 DC.L 0          ;( blk -- )
  3954. b_load:         move.l  D5,D0
  3955.                 addi.l  #oblk,D0
  3956.                 move.l  0(A3,D0.l),-(SP) ;save BLK on stack
  3957.                 move.l  (A6)+,0(A3,D0.l) ;set BLK
  3958.                 move.l  D5,D0
  3959.                 addi.l  #otoin,D0
  3960.                 move.l  0(A3,D0.l),-(SP) ;save >IN on stack
  3961.                 clr.l   0(A3,D0.l)      ;clear >IN
  3962.                 bsr     interpret
  3963.                 move.l  D5,D0
  3964.                 addi.l  #otoin,D0
  3965.                 move.l  (SP)+,0(A3,D0.l)
  3966.                 move.l  D5,D0
  3967.                 addi.l  #oblk,D0
  3968.                 move.l  (SP)+,0(A3,D0.l)
  3969.                 rts
  3970.  
  3971.  
  3972.                 DC.L 0          ;( blk -- )
  3973. load:           jsr     (dodefer-sys-of)(A5)
  3974.                 DC.L (loadptr-datas)
  3975. *                rts
  3976.  
  3977.                 ENDPART
  3978.  
  3979. HERE:
  3980.  
  3981.  
  3982.  
  3983. *****************************************************************
  3984. *                                                               *
  3985. *                                                               *
  3986. *                                                               *
  3987. *               End of Code, Start of Data                      *
  3988. *                                                               *
  3989. *                                                               *
  3990. *                                                               *
  3991. *****************************************************************
  3992.  
  3993.                 DATA
  3994.                 EVEN
  3995. datas:
  3996. *****************************************************************
  3997.                 >PART 'System tables and variables'
  3998.  
  3999. tablesize       EQU 10
  4000. table:          DS.L tablesize  ;table of segment pointers
  4001. *               SB
  4002. *               SB + $10000
  4003. *               SB + $20000
  4004. *               .
  4005. *               .
  4006. *               .
  4007. *               SB + (tablesize * $10000)
  4008.  
  4009. hello:          DC.B '*** F68K  Ver. 1.0, Copyright by J. Plewe ***',13,10
  4010.                 EVEN
  4011.  
  4012. *************************************************************************
  4013. *       system variables                                                *
  4014. *************************************************************************
  4015. mtable:
  4016. tcold:          DC.L (quit-sys-of) ;vector for cold
  4017. tsystop:        DS.L 1          ;highest possible address
  4018. tsysbot:        DS.L 1
  4019. tdatatop:       DS.L 1
  4020. tdatabot:       DS.L 1
  4021. tforthparas:    DC.L 0
  4022. bootsys:        DC.L 0          ;return to loader
  4023. saveret:        DC.L 0          ;SP of loader
  4024. bootuser:       DC.L (usertable-datas) ;
  4025. troot:          DS.L 1          ;pointer to table of devices
  4026. tkeys:          DS.L 1
  4027. tkey_quests:    DS.L 1
  4028. temits:         DS.L 1
  4029. tr_ws:          DS.L 1
  4030. treadsyses:     DS.L 1
  4031. twritesyses:    DS.L 1
  4032. tfence:         DC.L (HERE-sys-of)
  4033. tfront_opt:     DC.L (noop-sys-of) ;for an optimizer
  4034. tend_opt:       DC.L (noop-sys-of) ;dto.
  4035.                 EVEN
  4036.  
  4037.                 ENDPART
  4038.  
  4039. *****************************************************************
  4040.                 >PART 'USER variables'
  4041. *****************************************************************
  4042. *       USER variables                                          *
  4043. *****************************************************************
  4044.                 DS.L (16+24+10) ;room to save registers in multitasking
  4045. usertable:
  4046. tnextuser:      DC.L (usertable-datas) ;points to usertable of next task
  4047. trnull:         DC.L 0          ;r0 -- returnstackbase
  4048. tsnull:         DC.L 0          ;s0 -- datastackbase
  4049. tfnull:         DC.L 0          ;f0 -- floatstackbase
  4050. tstate:         DC.L 0          ;compiler on/off
  4051. tnumber_qu:     DC.L (n_number_quest-sys-of) ;numberconversion
  4052. tbase:          DC.L 10         ;base
  4053. tdpl:           DC.L -1         ;decimalpoint?
  4054. thld:           DC.L 0          ;temporary for numberconversion
  4055. tdp:            DC.L (HERE-sys-of) ;dictionary pointer (code)
  4056. tdata:          DC.L (dataHERE-datas) ;dictionary pointer (data)
  4057. ttotib:         DC.L 0          ;>tib, maybe as s0
  4058. t_tib:          DC.L 0          ;number of characters in tib
  4059. ttoin:          DC.L 0          ;>in
  4060. tspan:          DC.L 0          ;number of characters caught by expect
  4061. tcurrent:       DC.L (last_forth-datas) ;current (pfa)
  4062. tvoc_link:      DC.L (forth_link-sys-of) ;voc-link
  4063. tvocpa:         DC.L (VOCPA-datas) ;points to vocabularystack
  4064. tlast:          DC.L (lasthead-datas) ;address of last header
  4065. ;tfence:         DC.L (HERE-sys-of+4) ;pfa of first unprotected word
  4066. terror:         DC.L (quit-sys-of) ;vector for errorhandling
  4067. tkey:           DC.L (loaderkey-sys-of)
  4068. temit:          DC.L (loaderemit-sys-of)
  4069. tkey_quest:     DC.L (loaderkey_quest-sys-of)
  4070. tr_w:           DC.L (loaderr_w-sys-of)
  4071. treadsys:       DC.L (loaderreadsys-sys-of)
  4072. twritesys:      DC.L (loaderwritesys-sys-of)
  4073. tlkey:          DC.L 0
  4074. tlemit:         DC.L 0
  4075. tlkey_quest:    DC.L 0
  4076. tlr_w:          DC.L 0
  4077. tlreadsys:      DC.L 0
  4078. tlwritesys:     DC.L 0
  4079. texpect:        DC.L (osexpect-sys-of)
  4080. ttype:          DC.L (ostype-sys-of)
  4081. tmacro:         DC.L 0          ;should macros be used?
  4082. tis_macro:      DC.L 0          ;shall the new word be a macro?
  4083. twarning:       DC.L 0          ;give out warnings?
  4084. tout:           DC.L 0          ;counts characters emitted
  4085. tfwidth:        DC.L 8          ;bytes per float
  4086. tliteral:       DC.L (lit-sys-of) ;routine for numbercompilation
  4087. tfliteral:      DC.L (flit-sys-of) ;routine for floatcompilation
  4088. tblk:           DC.L 0          ;number of actual block
  4089. trootblk:       DC.L 0          ;log. block 0
  4090. tprev:          DC.L (buf-datas) ;start of buffers list
  4091. tuserbufs:      DC.L (VOCPA-datas-8) ;pointer to list of buffers
  4092. tcaps:          DC.L -1         ;use uppercase only?
  4093. tudp:           DC.L oudp+4
  4094.  
  4095.                 DS.B ($0800-oudp+4) ;room for the rest
  4096.                 EVEN
  4097.  
  4098.                 ENDPART
  4099.  
  4100. *****************************************************************
  4101.                 >PART 'vocabulary stack'
  4102.  
  4103. *************************************************************************
  4104. *       vocabulary stack                                                *
  4105. *************************************************************************
  4106.                 DC.L 0          ;last    user's buffer
  4107.                 DC.L 96         ;length is 96 bytes
  4108. VOCPA:          DC.L 12         ;height of voc-stacks
  4109.                 DC.L (last_only-datas) ;context (pfa)
  4110.                 DC.L (last_forth-datas) ;context (pfa)
  4111.                 DC.L (last_forth-datas) ;transient (pfa)
  4112.                 DS.L 21         ;room for another 20
  4113.                 EVEN
  4114.  
  4115.                 ENDPART
  4116.  
  4117. *****************************************************************
  4118.                 >PART 'header'
  4119.  
  4120. *************************************************************************
  4121. *       header                                                          *
  4122. *************************************************************************
  4123.  
  4124. dummy:          DC.L 0
  4125.  
  4126.                 DC.W 0
  4127.                 DC.L (only-sys-of)
  4128. __only:         DC.L (dummy-datas)
  4129.                 DC.B 4,'ONLY'
  4130.                 EVEN
  4131. last_only:      DC.L (__forth-datas)
  4132.                 DC.L (only-sys-of+4) ;link back to code
  4133.  
  4134.  
  4135.                 DC.W 0
  4136.                 DC.L (forth-sys-of)
  4137. __forth:        DC.L (__only-datas)
  4138.                 DC.B 5,'FORTH'
  4139.                 EVEN
  4140. last_forth:     DC.L (lastword-datas)
  4141.                 DC.L (forth-sys-of+4) ;link back to code
  4142.  
  4143.                 DC.W 0
  4144.                 DC.L (first-sys-of)
  4145. __first:        DC.L (dummy-datas)
  4146.                 DC.B 0
  4147.                 EVEN
  4148.  
  4149.                 DC.W $0408      ;macro
  4150.                 DC.L (pause-sys-of)
  4151. __pause:        DC.L (__first-datas)
  4152.                 DC.B 5,'PAUSE'
  4153.                 EVEN
  4154. pauseptr:       DC.L (first-sys-of)
  4155.  
  4156.                 DC.W 0
  4157.                 DC.L (osexpect-sys-of)
  4158. __osexpect:     DC.L (__pause-datas)
  4159.                 DC.B 8,'OSEXPECT'
  4160.                 EVEN
  4161.  
  4162.  
  4163.                 DC.W 0
  4164.                 DC.L (ostype-sys-of)
  4165. __ostype:       DC.L (__osexpect-datas)
  4166.                 DC.B 6,'OSTYPE'
  4167.                 EVEN
  4168.  
  4169.                 DC.W 0
  4170.                 DC.L (bye-sys-of)
  4171. __bye:          DC.L (__ostype-datas)
  4172.                 DC.B 3,'BYE'
  4173.                 EVEN
  4174.  
  4175.  
  4176.                 DC.W 0
  4177.                 DC.L (b_cold-sys-of)
  4178. __b_cold:       DC.L (__bye-datas)
  4179.                 DC.B 6,'(COLD)'
  4180.                 EVEN
  4181.  
  4182.  
  4183.                 DC.W $0208
  4184.                 DC.L (systop-sys-of)
  4185. __systop:       DC.L (__b_cold-datas)
  4186.                 DC.B 6,'SYSTOP'
  4187.                 EVEN
  4188.  
  4189.  
  4190.                 DC.W $0208
  4191.                 DC.L (sysbot-sys-of)
  4192. __sysbot:       DC.L (__systop-datas)
  4193.                 DC.B 6,'SYSBOT'
  4194.                 EVEN
  4195.  
  4196.  
  4197.                 DC.W $0208
  4198.                 DC.L (datatop-sys-of)
  4199. __datatop:      DC.L (__sysbot-datas)
  4200.                 DC.B 7,'DATATOP'
  4201.                 EVEN
  4202.  
  4203.  
  4204.                 DC.W $0208
  4205.                 DC.L (databot-sys-of)
  4206. __databot:      DC.L (__datatop-datas)
  4207.                 DC.B 7,'DATABOT'
  4208.                 EVEN
  4209.  
  4210.  
  4211.                 DC.W 0
  4212.                 DC.L (forthparas-sys-of)
  4213. __forthparas:   DC.L (__databot-datas)
  4214.                 DC.B 10,'FORTHPARAS'
  4215.                 EVEN
  4216.  
  4217.  
  4218.                 DC.W 0
  4219.                 DC.L (roottable-sys-of)
  4220. __roottable:    DC.L (__forthparas-datas)
  4221.                 DC.B 9,'ROOTTABLE'
  4222.                 EVEN
  4223.  
  4224.  
  4225.                 DC.W 0
  4226.                 DC.L (keys-sys-of)
  4227. __keys:         DC.L (__roottable-datas)
  4228.                 DC.B 4,'KEYS'
  4229.                 EVEN
  4230.  
  4231.  
  4232.                 DC.W 0
  4233.                 DC.L (emits-sys-of)
  4234. __emits:        DC.L (__keys-datas)
  4235.                 DC.B 5,'EMITS'
  4236.                 EVEN
  4237.  
  4238.  
  4239.                 DC.W 0
  4240.                 DC.L (key_quests-sys-of)
  4241. __key_quests:   DC.L (__emits-datas)
  4242.                 DC.B 5,'KEY?S'
  4243.                 EVEN
  4244.  
  4245.                 DC.W 0
  4246.                 DC.L (r_ws-sys-of)
  4247. __r_ws:         DC.L (__key_quests-datas)
  4248.                 DC.B 4,'R/WS'
  4249.                 EVEN
  4250.  
  4251.                 DC.W 0
  4252.                 DC.L (readsyses-sys-of)
  4253. __readsyses:    DC.L (__r_ws-datas)
  4254.                 DC.B 9,'READSYSES'
  4255.                 EVEN
  4256.  
  4257.                 DC.W 0
  4258.                 DC.L (writesyses-sys-of)
  4259. __writesyses:   DC.L (__readsyses-datas)
  4260.                 DC.B 10,'WRITESYSES'
  4261.                 EVEN
  4262.  
  4263.  
  4264.                 DC.W $0308
  4265.                 DC.L (fence-sys-of)
  4266. __fence:        DC.L (__writesyses-datas)
  4267.                 DC.B 5,'FENCE'
  4268.                 EVEN
  4269.  
  4270.  
  4271.                 DC.W 0
  4272.                 DC.L (b_front_opt-sys-of)
  4273. __b_front_opt:  DC.L (__fence-datas)
  4274.                 DC.B 11,'(FRONT_OPT)'
  4275.                 EVEN
  4276.  
  4277.  
  4278.                 DC.W 0
  4279.                 DC.L (b_end_opt-sys-of)
  4280. __b_end_opt:    DC.L (__b_front_opt-datas)
  4281.                 DC.B 9,'(END_OPT)'
  4282.                 EVEN
  4283.  
  4284.  
  4285.                 DC.W $08
  4286.                 DC.L (noop-sys-of)
  4287. __noop:         DC.L (__b_end_opt-datas)
  4288.                 DC.B 4,'NOOP'
  4289.                 EVEN
  4290.  
  4291.  
  4292.                 DC.W 0
  4293.                 DC.L (ver-sys-of)
  4294. __ver:          DC.L (__noop-datas)
  4295.                 DC.B 3,'VER'
  4296.                 EVEN
  4297.  
  4298.  
  4299.                 DC.W $0408
  4300.                 DC.L (nextuser-sys-of)
  4301. __nextuser:     DC.L (__ver-datas)
  4302.                 DC.B 8,'NEXTUSER'
  4303.                 EVEN
  4304.  
  4305.  
  4306.                 DC.W $0408
  4307.                 DC.L (r_null-sys-of)
  4308. __r_null:       DC.L (__nextuser-datas)
  4309.                 DC.B 2,'R0'
  4310.                 EVEN
  4311.  
  4312.  
  4313.                 DC.W $0408
  4314.                 DC.L (s_null-sys-of)
  4315. __s_null:       DC.L (__r_null-datas)
  4316.                 DC.B 2,'S0'
  4317.                 EVEN
  4318.  
  4319.  
  4320.                 DC.W $0408
  4321.                 DC.L (f_null-sys-of)
  4322. __f_null:       DC.L (__s_null-datas)
  4323.                 DC.B 2,'F0'
  4324.                 EVEN
  4325.  
  4326.  
  4327.                 DC.W $0408
  4328.                 DC.L (state-sys-of)
  4329. __state:        DC.L (__f_null-datas)
  4330.                 DC.B 5,'STATE'
  4331.                 EVEN
  4332.  
  4333.  
  4334.                 DC.W $0408
  4335.                 DC.L (b_number_quest-sys-of)
  4336. __b_number_quest:DC.L (__state-datas)
  4337.                 DC.B 9,'(NUMBER?)'
  4338.                 EVEN
  4339.  
  4340.  
  4341.                 DC.W $0408
  4342.                 DC.L (base-sys-of)
  4343. __base:         DC.L (__b_number_quest-datas)
  4344.                 DC.B 4,'BASE'
  4345.                 EVEN
  4346.  
  4347.  
  4348.                 DC.W $0408
  4349.                 DC.L (dpl-sys-of)
  4350. __dpl:          DC.L (__base-datas)
  4351.                 DC.B 3,'DPL'
  4352.                 EVEN
  4353.  
  4354.  
  4355.                 DC.W $0408
  4356.                 DC.L (hld-sys-of)
  4357. __hld:          DC.L (__dpl-datas)
  4358.                 DC.B 3,'HLD'
  4359.                 EVEN
  4360.  
  4361.  
  4362.                 DC.W $0408
  4363.                 DC.L (cp-sys-of)
  4364. __cp:           DC.L (__hld-datas)
  4365.                 DC.B 2,'CP'
  4366.                 EVEN
  4367.  
  4368.  
  4369.                 DC.W $0408
  4370.                 DC.L (dp-sys-of)
  4371. __dp:           DC.L (__cp-datas)
  4372.                 DC.B 2,'DP'
  4373.                 EVEN
  4374.  
  4375.  
  4376.                 DC.W $0408
  4377.                 DC.L (totib-sys-of)
  4378. __totib:        DC.L (__dp-datas)
  4379.                 DC.B 4,'>TIB'
  4380.                 EVEN
  4381.  
  4382.  
  4383.                 DC.W $0408
  4384.                 DC.L (_tib-sys-of)
  4385. ___tib:         DC.L (__totib-datas)
  4386.                 DC.B 4,'#TIB'
  4387.                 EVEN
  4388.  
  4389.  
  4390.                 DC.W $0408
  4391.                 DC.L (toin-sys-of)
  4392. __toin:         DC.L (___tib-datas)
  4393.                 DC.B 3,'>IN'
  4394.                 EVEN
  4395.  
  4396.  
  4397.                 DC.W $0408
  4398.                 DC.L (span-sys-of)
  4399. __span:         DC.L (__toin-datas)
  4400.                 DC.B 4,'SPAN'
  4401.                 EVEN
  4402.  
  4403.  
  4404.                 DC.W $0408
  4405.                 DC.L (current-sys-of)
  4406. __current:      DC.L (__span-datas)
  4407.                 DC.B 7,'CURRENT'
  4408.                 EVEN
  4409.  
  4410.  
  4411.                 DC.W $0408
  4412.                 DC.L (voc_link-sys-of)
  4413. __voc_link:     DC.L (__current-datas)
  4414.                 DC.B 8,'VOC-LINK'
  4415.                 EVEN
  4416.  
  4417.  
  4418.                 DC.W $0408
  4419.                 DC.L (vocpa-sys-of)
  4420. __vocpa:        DC.L (__voc_link-datas)
  4421.                 DC.B 5,'VOCPA'
  4422.                 EVEN
  4423.  
  4424.  
  4425.                 DC.W $0408
  4426.                 DC.L (last-sys-of)
  4427. __last:         DC.L (__vocpa-datas)
  4428.                 DC.B 4,'LAST'
  4429.                 EVEN
  4430.  
  4431.  
  4432.  
  4433.  
  4434.                 DC.W $0408
  4435.                 DC.L (b_error-sys-of)
  4436. __b_error:      DC.L (__last-datas)
  4437.                 DC.B 7,'(ERROR)'
  4438.                 EVEN
  4439.  
  4440.  
  4441.                 DC.W $0408
  4442.                 DC.L (b_key-sys-of)
  4443. __b_key:        DC.L (__b_error-datas)
  4444.                 DC.B 5,'(KEY)'
  4445.                 EVEN
  4446.  
  4447.  
  4448.                 DC.W $0408
  4449.                 DC.L (b_emit-sys-of)
  4450. __b_emit:       DC.L (__b_key-datas)
  4451.                 DC.B 6,'(EMIT)'
  4452.                 EVEN
  4453.  
  4454.  
  4455.                 DC.W $0408
  4456.                 DC.L (b_key_quest-sys-of)
  4457. __b_key_quest:  DC.L (__b_emit-datas)
  4458.                 DC.B 6,'(KEY?)'
  4459.                 EVEN
  4460.  
  4461.  
  4462.                 DC.W $0408
  4463.                 DC.L (b_r_w-sys-of)
  4464. __b_r_w:        DC.L (__b_key_quest-datas)
  4465.                 DC.B 5,'(R/W)'
  4466.                 EVEN
  4467.  
  4468.                 DC.W $0408
  4469.                 DC.L (b_readsys-sys-of)
  4470. __b_readsys:    DC.L (__b_r_w-datas)
  4471.                 DC.B 9,'(READSYS)'
  4472.                 EVEN
  4473.  
  4474.                 DC.W $0408
  4475.                 DC.L (b_writesys-sys-of)
  4476. __b_writesys:   DC.L (__b_readsys-datas)
  4477.                 DC.B 10,'(WRITESYS)'
  4478.                 EVEN
  4479.  
  4480.  
  4481.                 DC.W $0408
  4482.                 DC.L (t_key-sys-of)
  4483. __t_key:        DC.L (__b_writesys-datas)
  4484.                 DC.B 4,'^KEY'
  4485.                 EVEN
  4486.  
  4487.  
  4488.                 DC.W $0408
  4489.                 DC.L (t_emit-sys-of)
  4490. __t_emit:       DC.L (__t_key-datas)
  4491.                 DC.B 5,'^EMIT'
  4492.                 EVEN
  4493.  
  4494.  
  4495.                 DC.W $0408
  4496.                 DC.L (t_key_quest-sys-of)
  4497. __t_key_quest:  DC.L (__t_emit-datas)
  4498.                 DC.B 5,'^KEY?'
  4499.                 EVEN
  4500.  
  4501.  
  4502.                 DC.W $0408
  4503.                 DC.L (t_r_w-sys-of)
  4504. __t_r_w:        DC.L (__t_key_quest-datas)
  4505.                 DC.B 4,'^R/W'
  4506.                 EVEN
  4507.  
  4508.                 DC.W $0408
  4509.                 DC.L (t_readsys-sys-of)
  4510. __t_readsys:    DC.L (__t_r_w-datas)
  4511.                 DC.B 8,'^READSYS'
  4512.                 EVEN
  4513.  
  4514.                 DC.W $0408
  4515.                 DC.L (t_writesys-sys-of)
  4516. __t_writesys:   DC.L (__t_readsys-datas)
  4517.                 DC.B 9,'^WRITESYS'
  4518.                 EVEN
  4519.  
  4520.  
  4521.                 DC.W $0408
  4522.                 DC.L (b_expect-sys-of)
  4523. __b_expect:     DC.L (__t_writesys-datas)
  4524.                 DC.B 8,'(EXPECT)'
  4525.                 EVEN
  4526.  
  4527.  
  4528.                 DC.W $0408
  4529.                 DC.L (b_type-sys-of)
  4530. __b_type:       DC.L (__b_expect-datas)
  4531.                 DC.B 6,'(TYPE)'
  4532.                 EVEN
  4533.  
  4534.  
  4535.                 DC.W $0408
  4536.                 DC.L (b_literal-sys-of)
  4537. __b_literal:    DC.L (__b_type-datas)
  4538.                 DC.B 9,'(LITERAL)'
  4539.                 EVEN
  4540.  
  4541.  
  4542.                 DC.W $0408
  4543.                 DC.L (b_fliteral-sys-of)
  4544. __b_fliteral:   DC.L (__b_literal-datas)
  4545.                 DC.B 10,'(FLITERAL)'
  4546.                 EVEN
  4547.  
  4548.  
  4549.                 DC.W $0408
  4550.                 DC.L (macro-sys-of)
  4551. __macro:        DC.L (__b_fliteral-datas)
  4552.                 DC.B 5,'MACRO'
  4553.                 EVEN
  4554.  
  4555.  
  4556.                 DC.W $0408
  4557.                 DC.L (is_macro-sys-of)
  4558. __is_macro:     DC.L (__macro-datas)
  4559.                 DC.B 8,'IS_MACRO'
  4560.                 EVEN
  4561.  
  4562.  
  4563.                 DC.W $0408
  4564.                 DC.L (warning-sys-of)
  4565. __warning:      DC.L (__is_macro-datas)
  4566.                 DC.B 7,'WARNING'
  4567.                 EVEN
  4568.  
  4569.  
  4570.                 DC.W $0408
  4571.                 DC.L (fwidth-sys-of)
  4572. __fwidth:       DC.L (__warning-datas)
  4573.                 DC.B 6,'FWIDTH'
  4574.                 EVEN
  4575.  
  4576.  
  4577.                 DC.W $0408
  4578.                 DC.L (blk-sys-of)
  4579. __blk:          DC.L (__fwidth-datas)
  4580.                 DC.B 3,'BLK'
  4581.                 EVEN
  4582.  
  4583.  
  4584.                 DC.W $0408
  4585.                 DC.L (rootblk-sys-of)
  4586. __rootblk:      DC.L (__blk-datas)
  4587.                 DC.B 7,'ROOTBLK'
  4588.                 EVEN
  4589.  
  4590.  
  4591.                 DC.W $0408
  4592.                 DC.L (prev-sys-of)
  4593. __prev:         DC.L (__rootblk-datas)
  4594.                 DC.B 4,'PREV'
  4595.                 EVEN
  4596.  
  4597.  
  4598.                 DC.W $0408
  4599.                 DC.L (userbufs-sys-of)
  4600. __userbufs:     DC.L (__prev-datas)
  4601.                 DC.B 8,'USERBUFS'
  4602.                 EVEN
  4603.  
  4604.                 DC.W $0408
  4605.                 DC.L (caps-sys-of)
  4606. __caps:         DC.L (__userbufs-datas)
  4607.                 DC.B 4,'CAPS'
  4608.                 EVEN
  4609.  
  4610.                 DC.W $0408
  4611.                 DC.L (udp-sys-of)
  4612. __udp:          DC.L (__caps-datas)
  4613.                 DC.B 3,'UDP'
  4614.                 EVEN
  4615.  
  4616.  
  4617.                 DC.W $0408
  4618.                 DC.L (out-sys-of)
  4619. __out:          DC.L (__udp-datas)
  4620.                 DC.B 3,'OUT'
  4621.                 EVEN
  4622.  
  4623.  
  4624.                 DC.W 0
  4625.                 DC.L (pad-sys-of)
  4626. __pad:          DC.L (__out-datas)
  4627.                 DC.B 3,'PAD'
  4628.                 EVEN
  4629.  
  4630.  
  4631.                 DC.W 0
  4632.                 DC.L (here-sys-of)
  4633. __here:         DC.L (__pad-datas)
  4634.                 DC.B 4,'HERE'
  4635.                 EVEN
  4636.  
  4637.  
  4638.                 DC.W 0
  4639.                 DC.L (number_quest-sys-of)
  4640. __number_quest: DC.L (__here-datas)
  4641.                 DC.B 7,'NUMBER?'
  4642.                 EVEN
  4643.  
  4644.  
  4645.                 DC.W 0
  4646.                 DC.L (loaderkey-sys-of)
  4647. __loaderkey:    DC.L (__number_quest-datas)
  4648.                 DC.B 9,'LOADERKEY'
  4649.                 EVEN
  4650.  
  4651.  
  4652.                 DC.W 0
  4653.                 DC.L (loaderemit-sys-of)
  4654. __loaderemit:   DC.L (__loaderkey-datas)
  4655.                 DC.B 10,'LOADEREMIT'
  4656.                 EVEN
  4657.  
  4658.  
  4659.                 DC.W 0
  4660.                 DC.L (loaderkey_quest-sys-of)
  4661. __loaderkey_quest:DC.L (__loaderemit-datas)
  4662.                 DC.B 10,'LOADERKEY?'
  4663.                 EVEN
  4664.  
  4665.  
  4666.                 DC.W 0
  4667.                 DC.L (loaderr_w-sys-of)
  4668. __loaderr_w:    DC.L (__loaderkey_quest-datas)
  4669.                 DC.B 9,'LOADERR/W'
  4670.                 EVEN
  4671.  
  4672.  
  4673.                 DC.W 0
  4674.                 DC.L (loaderwritesys-sys-of)
  4675. __loaderwritesys:DC.L (__loaderr_w-datas)
  4676.                 DC.B 14,'LOADERWRITESYS'
  4677.                 EVEN
  4678.  
  4679.  
  4680.                 DC.W 0
  4681.                 DC.L (loaderreadsys-sys-of)
  4682. __loaderreadsys:DC.L (__loaderwritesys-datas)
  4683.                 DC.B 13,'LOADERREADSYS'
  4684.                 EVEN
  4685.  
  4686.  
  4687.                 DC.W 0
  4688.                 DC.L (key-sys-of)
  4689. __key:          DC.L (__loaderreadsys-datas)
  4690.                 DC.B 3,'KEY'
  4691.                 EVEN
  4692.  
  4693.  
  4694.                 DC.W 0
  4695.                 DC.L (emit-sys-of)
  4696. __emit:         DC.L (__key-datas)
  4697.                 DC.B 4,'EMIT'
  4698.                 EVEN
  4699.  
  4700.  
  4701.                 DC.W 0
  4702.                 DC.L (key_quest-sys-of)
  4703. __key_quest:    DC.L (__emit-datas)
  4704.                 DC.B 4,'KEY?'
  4705.                 EVEN
  4706.  
  4707.  
  4708.                 DC.W 0
  4709.                 DC.L (r_w-sys-of)
  4710. __r_w:          DC.L (__key_quest-datas)
  4711.                 DC.B 3,'R/W'
  4712.                 EVEN
  4713.  
  4714.  
  4715.                 DC.W 0
  4716.                 DC.L (writesys-sys-of)
  4717. __writesys:     DC.L (__r_w-datas)
  4718.                 DC.B 8,'WRITESYS'
  4719.                 EVEN
  4720.  
  4721.                 DC.W 0
  4722.                 DC.L (readsys-sys-of)
  4723. __readsys:      DC.L (__writesys-datas)
  4724.                 DC.B 7,'READSYS'
  4725.                 EVEN
  4726.  
  4727.  
  4728.                 DC.W 0
  4729.                 DC.L (expect-sys-of)
  4730. __expect:       DC.L (__readsys-datas)
  4731.                 DC.B 6,'EXPECT'
  4732.                 EVEN
  4733.  
  4734.  
  4735.                 DC.W 0
  4736.                 DC.L (type-sys-of)
  4737. __type:         DC.L (__expect-datas)
  4738.                 DC.B 4,'TYPE'
  4739.                 EVEN
  4740.  
  4741.                 DC.W 0
  4742.                 DC.L (komma-sys-of)
  4743. __komma:        DC.L (__type-datas)
  4744.                 DC.B 1,','
  4745.                 EVEN
  4746.  
  4747.  
  4748.                 DC.W 0
  4749.                 DC.L (jsr_komma-sys-of)
  4750. __jsr_komma:    DC.L (__komma-datas)
  4751.                 DC.B 4,'JSR,'
  4752.                 EVEN
  4753.  
  4754.  
  4755.                 DC.W 0
  4756.                 DC.L (com_komma-sys-of)
  4757. __com_komma:    DC.L (__jsr_komma-datas)
  4758.                 DC.B 4,'COM,'
  4759.                 EVEN
  4760.  
  4761.  
  4762.                 DC.W 0
  4763.                 DC.L (code_komma-sys-of)
  4764. __code_komma:   DC.L (__com_komma-datas)
  4765.                 DC.B 5,'CODE,'
  4766.                 EVEN
  4767.  
  4768.  
  4769.                 DC.W 0
  4770.                 DC.L (code_wkomma-sys-of)
  4771. __code_wkomma:  DC.L (__code_komma-datas)
  4772.                 DC.B 6,'CODEW,'
  4773.                 EVEN
  4774.  
  4775.  
  4776.                 DC.W 0
  4777.                 DC.L (jsrSB_komma-sys-of)
  4778. __jsrSB_komma:  DC.L (__code_wkomma-datas)
  4779.                 DC.B 6,'JSRSB,'
  4780.                 EVEN
  4781.  
  4782.  
  4783.                 DC.W 0
  4784.                 DC.L (wkomma-sys-of)
  4785. __wkomma:       DC.L (__jsrSB_komma-datas)
  4786.                 DC.B 2,'W,'
  4787.                 EVEN
  4788.  
  4789.  
  4790.                 DC.W 0
  4791.                 DC.L (ckomma-sys-of)
  4792. __ckomma:       DC.L (__wkomma-datas)
  4793.                 DC.B 2,'C,'
  4794.                 EVEN
  4795.  
  4796.  
  4797.                 DC.W 0
  4798.                 DC.L (fkomma-sys-of)
  4799. __fkomma:       DC.L (__ckomma-datas)
  4800.                 DC.B 2,'F,'
  4801.                 EVEN
  4802.  
  4803.  
  4804.                 DC.W 0
  4805.                 DC.L (plus_store-sys-of)
  4806. __plus_store:   DC.L (__fkomma-datas)
  4807.                 DC.B 2,'+!'
  4808.                 EVEN
  4809.  
  4810.  
  4811.                 DC.W $0208
  4812.                 DC.L (plus-sys-of)
  4813. __plus:         DC.L (__plus_store-datas)
  4814.                 DC.B 1,'+'
  4815.                 EVEN
  4816.  
  4817.  
  4818.                 DC.W $0208
  4819.                 DC.L (minus-sys-of)
  4820. __minus:        DC.L (__plus-datas)
  4821.                 DC.B 1,'-'
  4822.                 EVEN
  4823.  
  4824.  
  4825.                 DC.W 0
  4826.                 DC.L (mult-sys-of)
  4827. __mult:         DC.L (__minus-datas)
  4828.                 DC.B 1,'*'
  4829.                 EVEN
  4830.  
  4831.  
  4832.                 DC.W 0
  4833.                 DC.L (udivmod-sys-of)
  4834. __udivmod:      DC.L (__mult-datas)
  4835.                 DC.B 5,'U/MOD'
  4836.                 EVEN
  4837.  
  4838.  
  4839.                 DC.W 0
  4840.                 DC.L (divmod-sys-of)
  4841. __divmod:       DC.L (__udivmod-datas)
  4842.                 DC.B 4,'/MOD'
  4843.                 EVEN
  4844.  
  4845.  
  4846.                 DC.W 0
  4847.                 DC.L (div-sys-of)
  4848. __div:          DC.L (__divmod-datas)
  4849.                 DC.B 1,'/'
  4850.                 EVEN
  4851.  
  4852.  
  4853.                 DC.W 0
  4854.                 DC.L (muldivmod-sys-of)
  4855.  
  4856. __muldivmod:    DC.L (__div-datas)
  4857.                 DC.B 5,'*/MOD'
  4858.                 EVEN
  4859.  
  4860.  
  4861.                 DC.W $0308
  4862.                 DC.L (muldiv-sys-of)
  4863. __muldiv:       DC.L (__muldivmod-datas)
  4864.                 DC.B 2,'*/'
  4865.                 EVEN
  4866.  
  4867.  
  4868.                 DC.W $0208
  4869.                 DC.L (and-sys-of)
  4870. __and:          DC.L (__muldiv-datas)
  4871.                 DC.B 3,'AND'
  4872.                 EVEN
  4873.  
  4874.  
  4875.                 DC.W $0208
  4876.                 DC.L (or-sys-of)
  4877. __or:           DC.L (__and-datas)
  4878.                 DC.B 2,'OR'
  4879.                 EVEN
  4880.  
  4881.  
  4882.                 DC.W $0208
  4883.                 DC.L (xor-sys-of)
  4884. __xor:          DC.L (__or-datas)
  4885.                 DC.B 3,'XOR'
  4886.                 EVEN
  4887.  
  4888.  
  4889.                 DC.W $0108
  4890.                 DC.L (not-sys-of)
  4891. __not:          DC.L (__xor-datas)
  4892.                 DC.B 3,'NOT'
  4893.                 EVEN
  4894.  
  4895.  
  4896.                 DC.W $0108
  4897.                 DC.L (negate-sys-of)
  4898. __negate:       DC.L (__not-datas)
  4899.                 DC.B 6,'NEGATE'
  4900.                 EVEN
  4901.  
  4902.  
  4903.                 DC.W $0408
  4904.                 DC.L (abs-sys-of)
  4905. __abs:          DC.L (__negate-datas)
  4906.                 DC.B 3,'ABS'
  4907.                 EVEN
  4908.  
  4909.  
  4910.                 DC.W 0
  4911.                 DC.L (allot-sys-of)
  4912. __allot:        DC.L (__abs-datas)
  4913.                 DC.B 5,'ALLOT'
  4914.                 EVEN
  4915.  
  4916.  
  4917.                 DC.W 6          ;immediate restrict
  4918.                 DC.L (exit-sys-of)
  4919. __exit:         DC.L (__allot-datas)
  4920.                 DC.B 4,'EXIT'
  4921.                 EVEN
  4922.  
  4923.  
  4924.                 DC.W 0
  4925.                 DC.L (execute-sys-of)
  4926. __execute:      DC.L (__exit-datas)
  4927.                 DC.B 7,'EXECUTE'
  4928.                 EVEN
  4929.  
  4930.  
  4931.                 DC.W 0
  4932.                 DC.L (sp_fetch-sys-of)
  4933. __sp_fetch:     DC.L (__execute-datas)
  4934.                 DC.B 3,'SP@'
  4935.                 EVEN
  4936.  
  4937.  
  4938.                 DC.W 0
  4939.                 DC.L (sp_store-sys-of)
  4940. __sp_store:     DC.L (__sp_fetch-datas)
  4941.                 DC.B 3,'SP!'
  4942.                 EVEN
  4943.  
  4944.  
  4945.                 DC.W 4          ;restrict
  4946.                 DC.L (to_r-sys-of)
  4947. __to_r:         DC.L (__sp_store-datas)
  4948.                 DC.B 2,'>R'
  4949.                 EVEN
  4950.  
  4951.  
  4952.                 DC.W 4          ;restrict
  4953.                 DC.L (r_from-sys-of)
  4954. __r_from:       DC.L (__to_r-datas)
  4955.                 DC.B 2,'R>'
  4956.                 EVEN
  4957.  
  4958.  
  4959.                 DC.W 0
  4960.                 DC.L (r_fetch-sys-of)
  4961. __r_fetch:      DC.L (__r_from-datas)
  4962.                 DC.B 2,'R@'
  4963.                 EVEN
  4964.  
  4965.  
  4966.                 DC.W 0
  4967.                 DC.L (cr-sys-of)
  4968. __cr:           DC.L (__r_fetch-datas)
  4969.                 DC.B 2,'CR'
  4970.                 EVEN
  4971.  
  4972.  
  4973.                 DC.W 0
  4974.                 DC.L (space-sys-of)
  4975. __space:        DC.L (__cr-datas)
  4976.                 DC.B 5,'SPACE'
  4977.                 EVEN
  4978.  
  4979.  
  4980.                 DC.W 4          ;restrict
  4981.                 DC.L (lit-sys-of)
  4982. __lit:          DC.L (__space-datas)
  4983.                 DC.B 3,'LIT'
  4984.                 EVEN
  4985.  
  4986.  
  4987.                 DC.W 2          ;immediate
  4988.                 DC.L (literal-sys-of)
  4989. __literal:      DC.L (__lit-datas)
  4990.                 DC.B 7,'LITERAL'
  4991.                 EVEN
  4992.  
  4993.  
  4994.                 DC.W 4          ;restrict
  4995.                 DC.L (floatlit-sys-of)
  4996. __floatlit:     DC.L (__literal-datas)
  4997.                 DC.B 8,'FLOATLIT'
  4998.                 EVEN
  4999.  
  5000.  
  5001.                 DC.W 4          ;restrict
  5002.                 DC.L (flit-sys-of)
  5003. __flit:         DC.L (__floatlit-datas)
  5004.                 DC.B 4,'FLIT'
  5005.                 EVEN
  5006.  
  5007.  
  5008.                 DC.W 0
  5009.                 DC.L (fliteral-sys-of)
  5010. __fliteral:     DC.L (__flit-datas)
  5011.                 DC.B 8,'FLITERAL'
  5012.                 EVEN
  5013.  
  5014.  
  5015.                 DC.W 4          ;restrict
  5016.                 DC.L (b_str_quote-sys-of)
  5017. __b_str_quote:  DC.L (__fliteral-datas)
  5018.                 DC.B 3,'(")'
  5019.                 EVEN
  5020.  
  5021.  
  5022.                 DC.W 4          ;restrict
  5023.                 DC.L (b_string_emit-sys-of)
  5024. __b_string_emit:DC.L (__b_str_quote-datas)
  5025.                 DC.B 4,'(.")'
  5026.                 EVEN
  5027.  
  5028.  
  5029.                 DC.W 4          ;restrict
  5030.                 DC.L (b_error_quote-sys-of)
  5031. __b_error_quote:DC.L (__b_string_emit-datas)
  5032.                 DC.B 7,'(ERROR"'
  5033.                 EVEN
  5034.  
  5035.  
  5036.                 DC.W 4          ;restrict
  5037.                 DC.L (b_abort_quote-sys-of)
  5038. __b_abort_quote:DC.L (__b_error_quote-datas)
  5039.                 DC.B 7,'(ABORT"'
  5040.                 EVEN
  5041.  
  5042.  
  5043.                 DC.W 0
  5044.                 DC.L (quest_core-sys-of)
  5045. __quest_core:   DC.L (__b_abort_quote-datas)
  5046.                 DC.B 5,'?CORE'
  5047.                 EVEN
  5048.  
  5049.                 DC.W 0
  5050.                 DC.L (lastblk-sys-of)
  5051. __lastblk:      DC.L (__quest_core-datas)
  5052.                 DC.B 7,'LASTBLK'
  5053.                 EVEN
  5054. lastblkptr:     DC.L 0
  5055.  
  5056.                 DC.W 0
  5057.                 DC.L (lastbuf-sys-of)
  5058. __lastbuf:      DC.L (__lastblk-datas)
  5059.                 DC.B 7,'LASTBUF'
  5060.                 EVEN
  5061. lastbufptr:     DC.L 0
  5062.  
  5063.                 DC.W 0
  5064.                 DC.L (b_buffer-sys-of)
  5065. __b_buffer:     DC.L (__lastbuf-datas)
  5066.                 DC.B 7,'(BUFFER'
  5067.                 EVEN
  5068. buferrmess:     DC.B 25,'cannot write back buffer!'
  5069.                 EVEN
  5070.  
  5071.                 DC.W 0
  5072.                 DC.L (buffer-sys-of)
  5073. __buffer:       DC.L (__b_buffer-datas)
  5074.                 DC.B 6,'BUFFER'
  5075.                 EVEN
  5076. bufferptr:      DC.L (b_buffer-sys-of)
  5077.  
  5078.  
  5079.                 DC.W 0
  5080.                 DC.L (b_block-sys-of)
  5081. __b_block:      DC.L (__buffer-datas)
  5082.                 DC.B 6,'(BLOCK'
  5083.                 EVEN
  5084. blkerrmess:     DC.B 18,'cannot read block!'
  5085.                 EVEN
  5086.  
  5087.                 DC.W 0
  5088.                 DC.L (block-sys-of)
  5089. __block:        DC.L (__b_block-datas)
  5090.                 DC.B 5,'BLOCK'
  5091.                 EVEN
  5092. blockptr:       DC.L (b_block-sys-of)
  5093.  
  5094.                 DC.W 0
  5095.                 DC.L (tib-sys-of)
  5096. __htib:         DC.L (__block-datas)
  5097.                 DC.B 3,'TIB'
  5098.                 EVEN
  5099.  
  5100.  
  5101.                 DC.W 0
  5102.                 DC.L (query-sys-of)
  5103. __query:        DC.L (__htib-datas)
  5104.                 DC.B 5,'QUERY'
  5105.                 EVEN
  5106.  
  5107.  
  5108.                 DC.W 0
  5109.                 DC.L (skip-sys-of)
  5110. __skip:         DC.L (__query-datas)
  5111.                 DC.B 4,'SKIP'
  5112.                 EVEN
  5113.  
  5114.  
  5115.                 DC.W 0
  5116.                 DC.L (scan-sys-of)
  5117. __scan:         DC.L (__skip-datas)
  5118.                 DC.B 4,'SCAN'
  5119.                 EVEN
  5120.  
  5121.  
  5122.                 DC.W 0
  5123.                 DC.L (source-sys-of)
  5124. __source:       DC.L (__scan-datas)
  5125.                 DC.B 6,'SOURCE'
  5126.                 EVEN
  5127.  
  5128.  
  5129.                 DC.W 0
  5130.                 DC.L (word-sys-of)
  5131. __word:         DC.L (__source-datas)
  5132.                 DC.B 4,'WORD'
  5133.                 EVEN
  5134.  
  5135.  
  5136.                 DC.W 0
  5137.                 DC.L (char-sys-of)
  5138. __char:         DC.L (__word-datas)
  5139.                 DC.B 4,'CHAR'
  5140.                 EVEN
  5141.  
  5142.  
  5143.                 DC.W 2          ;immediate
  5144.                 DC.L (b_char-sys-of)
  5145. __b_char:       DC.L (__char-datas)
  5146.                 DC.B 6,'[CHAR]'
  5147.                 EVEN
  5148.  
  5149.  
  5150.                 DC.W 0
  5151.                 DC.L (capital-sys-of)
  5152. __captl:        DC.L (__b_char-datas)
  5153.                 DC.B 7,'CAPITAL'
  5154.                 EVEN
  5155.  
  5156.  
  5157.                 DC.W 0
  5158.                 DC.L (capitalize-sys-of)
  5159. __capitalize:   DC.L (__captl-datas)
  5160.                 DC.B 10,'CAPITALIZE'
  5161.                 EVEN
  5162.  
  5163.  
  5164.                 DC.W 0
  5165.                 DC.L (name-sys-of)
  5166. __name:         DC.L (__capitalize-datas)
  5167.                 DC.B 4,'NAME'
  5168.                 EVEN
  5169.  
  5170.                 DC.W 0
  5171.                 DC.L (vocsearch-sys-of)
  5172. __vocsearch:    DC.L (__name-datas)
  5173.                 DC.B 9,'VOCSEARCH'
  5174.                 EVEN
  5175.  
  5176.  
  5177.                 DC.W 0
  5178.                 DC.L (b_find-sys-of)
  5179. __b_find:       DC.L (__vocsearch-datas)
  5180.                 DC.B 5,'(FIND'
  5181.                 EVEN
  5182.  
  5183.  
  5184.                 DC.W 0
  5185.                 DC.L (find-sys-of)
  5186. __find:         DC.L (__b_find-datas)
  5187.                 DC.B 4,'FIND'
  5188.                 EVEN
  5189. findptr:        DC.L (b_find-sys-of)
  5190.  
  5191.  
  5192.                 DC.W 0
  5193.                 DC.L (nulst_quest-sys-of)
  5194. __nulst_quest:  DC.L (__find-datas)
  5195.                 DC.B 8,'NULLSTR?'
  5196.                 EVEN
  5197.  
  5198.  
  5199.                 DC.W 0
  5200.                 DC.L (notfound-sys-of)
  5201. __notfound:     DC.L (__nulst_quest-datas)
  5202.                 DC.B 8,'NOTFOUND'
  5203.                 EVEN
  5204. notfndptr:      DC.L (unknown-sys-of) ; ' unknown IS notfound
  5205.  
  5206.  
  5207.                 DC.W 0
  5208.                 DC.L (unknown-sys-of)
  5209. __unknown:      DC.L (__notfound-datas)
  5210.                 DC.B 7,'UNKNOWN'
  5211.                 EVEN
  5212.  
  5213. unknownmess:    DC.B 9," unknown!"
  5214.                 EVEN
  5215.  
  5216.  
  5217.                 DC.W 0
  5218.                 DC.L (h_tick-sys-of)
  5219. __h_tick:       DC.L (__unknown-datas)
  5220.                 DC.B 2,'H',$27  ; '
  5221.                 EVEN
  5222.  
  5223.  
  5224.                 DC.W 0
  5225.                 DC.L (tick-sys-of)
  5226. __tick:         DC.L (__h_tick-datas)
  5227.                 DC.B 1,$27      ; '
  5228.                 EVEN
  5229.  
  5230.  
  5231.                 DC.W 2
  5232.                 DC.L (b_tick-sys-of)
  5233. __b_tick:       DC.L (__tick-datas)
  5234.                 DC.B 3,"[']"
  5235.                 EVEN
  5236.  
  5237.  
  5238.                 DC.W 0
  5239.                 DC.L (quest_stack-sys-of)
  5240. __quest_stack:  DC.L (__b_tick-datas)
  5241.                 DC.B 6,'?STACK'
  5242.                 EVEN
  5243.  
  5244. stkundermess:   DC.B 17,'<stack underflow>'
  5245. fltundermess:   DC.B 23,'<floatstack underflow!>'
  5246.                 EVEN
  5247.  
  5248.  
  5249.                 DC.W 0
  5250.                 DC.L (compiler-sys-of)
  5251. __compiler:     DC.L (__quest_stack-datas)
  5252.                 DC.B 8,'COMPILER'
  5253.                 EVEN
  5254.  
  5255. restrmess:      DC.B 14,' compile only!'
  5256.                 EVEN
  5257.  
  5258.  
  5259.                 DC.W 0
  5260.                 DC.L (interpreter-sys-of)
  5261. __interpreter:  DC.L (__compiler-datas)
  5262.                 DC.B 11,'INTERPRETER'
  5263.                 EVEN
  5264.  
  5265.  
  5266.                 DC.W 0
  5267.                 DC.L (parser-sys-of)
  5268. __parser:       DC.L (__interpreter-datas)
  5269.                 DC.B 6,'PARSER'
  5270.                 EVEN
  5271.  
  5272. parserptr:      DC.L (interpreter-sys-of) ; ' interpreter Is parser
  5273.  
  5274.  
  5275.  
  5276.                 DC.W 0
  5277.                 DC.L (interpret-sys-of)
  5278. __interpret:    DC.L (__parser-datas)
  5279.                 DC.B 9,'INTERPRET'
  5280.                 EVEN
  5281.  
  5282.  
  5283.                 DC.W 4
  5284.                 DC.L (push-sys-of)
  5285. __push:         DC.L (__interpret-datas)
  5286.                 DC.B 4,'PUSH'
  5287.                 EVEN
  5288.  
  5289.  
  5290.                 DC.W 4
  5291.                 DC.L (savearea-sys-of)
  5292. __savearea:     DC.L (__push-datas)
  5293.                 DC.B 8,'SAVEAREA'
  5294.                 EVEN
  5295.  
  5296.  
  5297.                 DC.W 0
  5298.                 DC.L (evaluate-sys-of)
  5299. __evaluate:     DC.L (__savearea-datas)
  5300.                 DC.B 8,'EVALUATE'
  5301.                 EVEN
  5302.  
  5303.  
  5304.                 DC.W 0
  5305.                 DC.L (less_sharp-sys-of)
  5306. __less_sharp:   DC.L (__evaluate-datas)
  5307.                 DC.B 2,'<#'
  5308.                 EVEN
  5309.  
  5310.  
  5311.                 DC.W 0
  5312.                 DC.L (sharp_greater-sys-of)
  5313. __sharp_greater:DC.L (__less_sharp-datas)
  5314.                 DC.B 2,'#>'
  5315.                 EVEN
  5316.  
  5317.  
  5318.                 DC.W 0
  5319.                 DC.L (hold-sys-of)
  5320. __hold:         DC.L (__sharp_greater-datas)
  5321.                 DC.B 4,'HOLD'
  5322.                 EVEN
  5323.  
  5324.  
  5325.                 DC.W 0
  5326.                 DC.L (sign-sys-of)
  5327. __sign:         DC.L (__hold-datas)
  5328.                 DC.B 4,'SIGN'
  5329.                 EVEN
  5330.  
  5331.  
  5332.                 DC.W 0
  5333.                 DC.L (sharp-sys-of)
  5334. __sharp:        DC.L (__sign-datas)
  5335.                 DC.B 1,'#'
  5336.                 EVEN
  5337.  
  5338.  
  5339.                 DC.W 0
  5340.                 DC.L (sharp_s-sys-of)
  5341. __sharp_s:      DC.L (__sharp-datas)
  5342.                 DC.B 2,'#S'
  5343.                 EVEN
  5344.  
  5345.  
  5346.                 DC.W 0
  5347.                 DC.L (udot-sys-of)
  5348. __udot:         DC.L (__sharp_s-datas)
  5349.                 DC.B 2,'U.'
  5350.                 EVEN
  5351.  
  5352.  
  5353.                 DC.W 0
  5354.                 DC.L (dot-sys-of)
  5355. __dot:          DC.L (__udot-datas)
  5356.                 DC.B 1,'.'
  5357.                 EVEN
  5358.  
  5359.  
  5360.                 DC.W 0
  5361.                 DC.L (prompt-sys-of)
  5362. __prompt:       DC.L (__dot-datas)
  5363.                 DC.B 6,'PROMPT'
  5364.                 EVEN
  5365.  
  5366.  
  5367.                 DC.W 2          ;immediate
  5368.                 DC.L (left_brack-sys-of)
  5369. __left_brack:   DC.L (__prompt-datas)
  5370.                 DC.B 1,'['
  5371.                 EVEN
  5372.  
  5373.  
  5374.  
  5375.                 DC.W 0
  5376.                 DC.L (right_brack-sys-of)
  5377. __right_brack:  DC.L (__left_brack-datas)
  5378.                 DC.B 1,']'
  5379.                 EVEN
  5380.  
  5381.  
  5382.                 DC.W 0
  5383.                 DC.L (align-sys-of)
  5384. __align:        DC.L (__right_brack-datas)
  5385.                 DC.B 5,'ALIGN'
  5386.                 EVEN
  5387.  
  5388.  
  5389.                 DC.W 0
  5390.                 DC.L (quit-sys-of)
  5391. __quit:         DC.L (__align-datas)
  5392.                 DC.B 4,'QUIT'
  5393.                 EVEN
  5394.  
  5395.  
  5396.                 DC.W 0
  5397.                 DC.L (cold-sys-of)
  5398. __cold:         DC.L (__quit-datas)
  5399.                 DC.B 4,'COLD'
  5400.                 EVEN
  5401.  
  5402.  
  5403.                 DC.W 0
  5404.                 DC.L (digit_quest-sys-of)
  5405. __digit_quest:  DC.L (__cold-datas)
  5406.                 DC.B 6,'DIGIT?'
  5407.                 EVEN
  5408.  
  5409.  
  5410.                 DC.W 0
  5411.                 DC.L (accumulate-sys-of)
  5412. __accumulate:   DC.L (__digit_quest-datas)
  5413.                 DC.B 10,'ACCUMULATE'
  5414.                 EVEN
  5415.  
  5416.  
  5417.                 DC.W 0
  5418.                 DC.L (count-sys-of)
  5419. __count:        DC.L (__accumulate-datas)
  5420.                 DC.B 5,'COUNT'
  5421.                 EVEN
  5422.  
  5423.  
  5424.                 DC.W 0
  5425.                 DC.L (convert-sys-of)
  5426. __convert:      DC.L (__count-datas)
  5427.                 DC.B 7,'CONVERT'
  5428.                 EVEN
  5429.  
  5430.  
  5431.                 DC.W 0
  5432.                 DC.L (n_number_quest-sys-of)
  5433. __nnumber_quest:DC.L (__convert-datas)
  5434.                 DC.B 8,'NNUMBER?'
  5435.                 EVEN
  5436.  
  5437.  
  5438.                 DC.W $0308
  5439.                 DC.L (fetch-sys-of)
  5440. __fetch:        DC.L (__nnumber_quest-datas)
  5441.                 DC.B 1,'@'
  5442.                 EVEN
  5443.  
  5444.  
  5445.                 DC.W $0508
  5446.                 DC.L (cfetch-sys-of)
  5447. __cfetch:       DC.L (__fetch-datas)
  5448.                 DC.B 2,'C@'
  5449.                 EVEN
  5450.  
  5451.  
  5452.                 DC.W $0508
  5453.                 DC.L (wfetch-sys-of)
  5454. __wfetch:       DC.L (__cfetch-datas)
  5455.                 DC.B 2,'W@'
  5456.                 EVEN
  5457.  
  5458.  
  5459.                 DC.W $0308
  5460.                 DC.L (store-sys-of)
  5461. __store:        DC.L (__wfetch-datas)
  5462.                 DC.B 1,'!'
  5463.                 EVEN
  5464.  
  5465.  
  5466.                 DC.W $0408
  5467.                 DC.L (cstore-sys-of)
  5468. __cstore:       DC.L (__store-datas)
  5469.                 DC.B 2,'C!'
  5470.                 EVEN
  5471.  
  5472.  
  5473.                 DC.W $0408
  5474.                 DC.L (wstore-sys-of)
  5475. __wstore:       DC.L (__cstore-datas)
  5476.                 DC.B 2,'W!'
  5477.                 EVEN
  5478.  
  5479.  
  5480.                 DC.W 0
  5481.                 DC.L (hex-sys-of)
  5482. __hex:          DC.L (__wstore-datas)
  5483.                 DC.B 3,'HEX'
  5484.                 EVEN
  5485.  
  5486.  
  5487.                 DC.W 0
  5488.                 DC.L (decimal-sys-of)
  5489. __decimal:      DC.L (__hex-datas)
  5490.                 DC.B 7,'DECIMAL'
  5491.                 EVEN
  5492.  
  5493.  
  5494.                 DC.W 0
  5495.                 DC.L (header_colon-sys-of)
  5496. __header_colon: DC.L (__decimal-datas)
  5497.                 DC.B 7,'HEADER:'
  5498.                 EVEN
  5499.  
  5500. noheadermess:   DC.B 21,'<no name for header!>'
  5501. notuniquemess:  DC.B 17,' is not unique!',13,10
  5502.                 EVEN
  5503.                 DC.W 0
  5504.                 DC.L (colon-sys-of)
  5505. __colon:        DC.L (__header_colon-datas)
  5506.                 DC.B 1,':'
  5507.                 EVEN
  5508.  
  5509.  
  5510.                 DC.W 0
  5511.                 DC.L (m_colon-sys-of)
  5512. __m_colon:      DC.L (__colon-datas)
  5513.                 DC.B 2,'M:'
  5514.                 EVEN
  5515.  
  5516.  
  5517.                 DC.W 0
  5518.                 DC.L (reveal-sys-of)
  5519. __reveal:       DC.L (__m_colon-datas)
  5520.                 DC.B 6,'REVEAL'
  5521.                 EVEN
  5522.  
  5523.  
  5524.  
  5525.                 DC.W 2          ;immediate
  5526.                 DC.L (semi_colon-sys-of)
  5527. __semi_colon:   DC.L (__reveal-datas)
  5528.                 DC.B 1,';'
  5529.                 EVEN
  5530.  
  5531.  
  5532.                 DC.W $0108
  5533.                 DC.L (dup-sys-of)
  5534. __dup:          DC.L (__semi_colon-datas)
  5535.                 DC.B 3,'DUP'
  5536.                 EVEN
  5537.  
  5538.  
  5539.                 DC.W $0108
  5540.                 DC.L (drop-sys-of)
  5541. __drop:         DC.L (__dup-datas)
  5542.                 DC.B 4,'DROP'
  5543.                 EVEN
  5544.  
  5545.  
  5546.                 DC.W $0408
  5547.                 DC.L (swap-sys-of)
  5548. __swap:         DC.L (__drop-datas)
  5549.                 DC.B 4,'SWAP'
  5550.                 EVEN
  5551.  
  5552.  
  5553.                 DC.W $0608
  5554.                 DC.L (rot-sys-of)
  5555. __rot:          DC.L (__swap-datas)
  5556.                 DC.B 3,'ROT'
  5557.                 EVEN
  5558.  
  5559.  
  5560.                 DC.W 0
  5561.                 DC.L (quest_dup-sys-of)
  5562. __quest_dup:    DC.L (__rot-datas)
  5563.                 DC.B 4,'?DUP'
  5564.                 EVEN
  5565.  
  5566.  
  5567.                 DC.W $0208
  5568.                 DC.L (over-sys-of)
  5569. __over:         DC.L (__quest_dup-datas)
  5570.                 DC.B 4,'OVER'
  5571.                 EVEN
  5572.  
  5573.  
  5574.                 DC.W $0108
  5575.                 DC.L (_2drop-sys-of)
  5576. __2drop:        DC.L (__over-datas)
  5577.                 DC.B 5,'2DROP'
  5578.                 EVEN
  5579.  
  5580.  
  5581.                 DC.W $0208
  5582.                 DC.L (_2dup-sys-of)
  5583. __2dup:         DC.L (__2drop-datas)
  5584.                 DC.B 4,'2DUP'
  5585.                 EVEN
  5586.  
  5587.  
  5588.                 DC.W $0208
  5589.                 DC.L (_2over-sys-of)
  5590. __2over:        DC.L (__2dup-datas)
  5591.                 DC.B 5,'2OVER'
  5592.                 EVEN
  5593.  
  5594.  
  5595.                 DC.W 0
  5596.                 DC.L (_2swap-sys-of)
  5597. __2swap:        DC.L (__2over-datas)
  5598.                 DC.B 5,'2SWAP'
  5599.                 EVEN
  5600.  
  5601.  
  5602.                 DC.W 0
  5603.                 DC.L (cmove-sys-of)
  5604. __cmove:        DC.L (__2swap-datas)
  5605.                 DC.B 5,'CMOVE'
  5606.                 EVEN
  5607.  
  5608.  
  5609.                 DC.W 0
  5610.                 DC.L (cmove_up-sys-of)
  5611. __cmove_up:     DC.L (__cmove-datas)
  5612.                 DC.B 6,'CMOVE>'
  5613.                 EVEN
  5614.  
  5615.  
  5616.                 DC.W 0
  5617.                 DC.L (create-sys-of)
  5618. __create:       DC.L (__cmove_up-datas)
  5619.                 DC.B 6,'CREATE'
  5620.                 EVEN
  5621.  
  5622.  
  5623.                 DC.W 6          ;immediate restrict
  5624.                 DC.L (does-sys-of)
  5625. __does:         DC.L (__create-datas)
  5626.                 DC.B 5,'DOES>'
  5627.                 EVEN
  5628.  
  5629.  
  5630.                 DC.W 0
  5631.                 DC.L (semcl_code-sys-of)
  5632. __semcl_code:   DC.L (__does-datas)
  5633.                 DC.B 6,';CODE)'
  5634.                 EVEN
  5635.  
  5636.  
  5637.                 DC.W 0
  5638.                 DC.L (defer-sys-of)
  5639. __defer:        DC.L (__semcl_code-datas)
  5640.                 DC.B 5,'DEFER'
  5641.                 EVEN
  5642. defercrashmess: DC.B 20,'<missing deference!> '
  5643.                 EVEN
  5644.  
  5645.  
  5646.                 DC.W 0
  5647.                 DC.L (variable-sys-of)
  5648. __variable:     DC.L (__defer-datas)
  5649.                 DC.B 8,'VARIABLE'
  5650.                 EVEN
  5651.  
  5652.  
  5653.                 DC.W 0
  5654.                 DC.L (constant-sys-of)
  5655. __constant:     DC.L (__variable-datas)
  5656.                 DC.B 8,'CONSTANT'
  5657.                 EVEN
  5658.  
  5659.                 DC.W $0308
  5660.                 DC.L (bl-sys-of)
  5661. __bl:           DC.L (__constant-datas)
  5662.                 DC.B 2,'BL'
  5663.                 EVEN
  5664.  
  5665.  
  5666.                 DC.W 2          ;immediate
  5667.                 DC.L (to-sys-of)
  5668. __to:           DC.L (__bl-datas)
  5669.                 DC.B 2,'TO'
  5670.                 EVEN
  5671.  
  5672.                 DC.W 0
  5673.                 DC.L (value-sys-of)
  5674. __value:        DC.L (__to-datas)
  5675.                 DC.B 5,'VALUE'
  5676.                 EVEN
  5677.  
  5678.  
  5679. * variables used by LOCAL
  5680. was_local:      DC.L 0
  5681. save_cur:       DC.L 0
  5682. save_dp:        DC.L 0
  5683.  
  5684.                 DC.W 6
  5685.                 DC.L (local-sys-of)
  5686. __local:        DC.L (__value-datas)
  5687.                 DC.B 5,'LOCAL'
  5688.                 EVEN
  5689.  
  5690.  
  5691.                 DC.W 4          ;restrict
  5692.                 DC.L (b_do-sys-of)
  5693. __b_do:         DC.L (__local-datas)
  5694.                 DC.B 3,'(DO'
  5695.                 EVEN
  5696.  
  5697.  
  5698.                 DC.W 4          ;restrict
  5699.                 DC.L (b_quest_do-sys-of)
  5700. __b_quest_do:   DC.L (__b_do-datas)
  5701.                 DC.B 4,'(?DO'
  5702.                 EVEN
  5703.  
  5704.  
  5705.                 DC.W 4          ;restrict
  5706.                 DC.L (b_loop-sys-of)
  5707. __b_loop:       DC.L (__b_quest_do-datas)
  5708.                 DC.B 5,'(LOOP'
  5709.                 EVEN
  5710.  
  5711.  
  5712.                 DC.W 4          ;restrict
  5713.                 DC.L (b_plus_loop-sys-of)
  5714. __b_plus_loop:  DC.L (__b_loop-datas)
  5715.                 DC.B 6,'(+LOOP'
  5716.                 EVEN
  5717.  
  5718.  
  5719.                 DC.W $020C      ;restrict, macro
  5720.                 DC.L (i-sys-of)
  5721. __i:            DC.L (__b_plus_loop-datas)
  5722.                 DC.B 1,'I'
  5723.                 EVEN
  5724.  
  5725.  
  5726.                 DC.W 4          ;restrict
  5727.                 DC.L (j-sys-of)
  5728. __j:            DC.L (__i-datas)
  5729.                 DC.B 1,'J'
  5730.                 EVEN
  5731.  
  5732.  
  5733.                 DC.W 4          ;restrict
  5734.                 DC.L (unloop-sys-of)
  5735. __unloop:       DC.L (__j-datas)
  5736.                 DC.B 6,'UNLOOP'
  5737.                 EVEN
  5738.  
  5739.  
  5740.                 DC.W 0
  5741.                 DC.L (to_mark-sys-of)
  5742. __to_mark:      DC.L (__unloop-datas)
  5743.                 DC.B 5,'>MARK'
  5744.                 EVEN
  5745.  
  5746.  
  5747.                 DC.W 0
  5748.                 DC.L (to_resolve-sys-of)
  5749. __to_resolve:   DC.L (__to_mark-datas)
  5750.                 DC.B 8,'>RESOLVE'
  5751.                 EVEN
  5752.  
  5753.  
  5754.                 DC.W 0
  5755.                 DC.L (less_mark-sys-of)
  5756. __less_mark:    DC.L (__to_resolve-datas)
  5757.                 DC.B 5,'<MARK'
  5758.                 EVEN
  5759.  
  5760.  
  5761.                 DC.W 0
  5762.                 DC.L (less_resolve-sys-of)
  5763. __less_resolve: DC.L (__less_mark-datas)
  5764.                 DC.B 8,'<RESOLVE'
  5765.                 EVEN
  5766.  
  5767.  
  5768.                 DC.W 6          ;immediate restrict
  5769.                 DC.L (do-sys-of)
  5770. __do:           DC.L (__less_resolve-datas)
  5771.                 DC.B 2,'DO'
  5772.                 EVEN
  5773.  
  5774.  
  5775.                 DC.W 6          ;immediate restrict
  5776.                 DC.L (loop-sys-of)
  5777. __loop:         DC.L (__do-datas)
  5778.                 DC.B 4,'LOOP'
  5779.                 EVEN
  5780.  
  5781.  
  5782.                 DC.W 6          ;immediate restrict
  5783.                 DC.L (quest_do-sys-of)
  5784. __quest_do:     DC.L (__loop-datas)
  5785.                 DC.B 3,'?DO'
  5786.                 EVEN
  5787.  
  5788.  
  5789.                 DC.W 6          ;immediate restrict
  5790.                 DC.L (p_loop-sys-of)
  5791. __p_loop:       DC.L (__quest_do-datas)
  5792.                 DC.B 5,'+LOOP'
  5793.                 EVEN
  5794.  
  5795.  
  5796.                 DC.W 4          ;restrict
  5797.                 DC.L (leave-sys-of)
  5798. __leave:        DC.L (__p_loop-datas)
  5799.                 DC.B 5,'LEAVE'
  5800.                 EVEN
  5801.  
  5802.  
  5803.                 DC.W 6          ;immediate restrict
  5804.                 DC.L (quest_branch-sys-of)
  5805. __quest_branch: DC.L (__leave-datas)
  5806.                 DC.B 7,'?BRANCH'
  5807.                 EVEN
  5808.  
  5809.  
  5810.                 DC.W 6          ;immediate restrict
  5811.                 DC.L (if-sys-of)
  5812. __if:           DC.L (__quest_branch-datas)
  5813.                 DC.B 2,'IF'
  5814.                 EVEN
  5815.  
  5816.  
  5817.                 DC.W 6          ;immediate restrict
  5818.                 DC.L (then-sys-of)
  5819. __then:         DC.L (__if-datas)
  5820.                 DC.B 4,'THEN'
  5821.                 EVEN
  5822.  
  5823.  
  5824.                 DC.W 6          ;immediate restrict
  5825.                 DC.L (branch-sys-of)
  5826. __branch:       DC.L (__then-datas)
  5827.                 DC.B 6,'BRANCH'
  5828.                 EVEN
  5829.  
  5830.  
  5831.                 DC.W 6          ;immediate restrict
  5832.                 DC.L (else-sys-of)
  5833. __else:         DC.L (__branch-datas)
  5834.                 DC.B 4,'ELSE'
  5835.                 EVEN
  5836.  
  5837.  
  5838.                 DC.W 6          ;immediate restrict
  5839.                 DC.L (begin-sys-of)
  5840. __begin:        DC.L (__else-datas)
  5841.                 DC.B 5,'BEGIN'
  5842.                 EVEN
  5843.  
  5844.  
  5845.                 DC.W 6
  5846.                 DC.L (until-sys-of)
  5847. __until:        DC.L (__begin-datas)
  5848.                 DC.B 5,'UNTIL'
  5849.                 EVEN
  5850.  
  5851.  
  5852.                 DC.W 6
  5853.                 DC.L (again-sys-of)
  5854. __again:        DC.L (__until-datas)
  5855.                 DC.B 5,'AGAIN'
  5856.                 EVEN
  5857.  
  5858.  
  5859.                 DC.W 6
  5860.                 DC.L (repeat-sys-of)
  5861. __repeat:       DC.L (__again-datas)
  5862.                 DC.B 6,'REPEAT'
  5863.                 EVEN
  5864.  
  5865.  
  5866.                 DC.W 6
  5867.                 DC.L (while-sys-of)
  5868. __while:        DC.L (__repeat-datas)
  5869.                 DC.B 5,'WHILE'
  5870.                 EVEN
  5871.  
  5872.  
  5873.                 DC.W 0
  5874.                 DC.L (null_gleich-sys-of)
  5875. __null_gleich:  DC.L (__while-datas)
  5876.                 DC.B 2,'0='
  5877.                 EVEN
  5878.  
  5879.  
  5880.                 DC.W 0
  5881.                 DC.L (null_greater-sys-of)
  5882. __null_greater: DC.L (__null_gleich-datas)
  5883.                 DC.B 2,'0>'
  5884.                 EVEN
  5885.  
  5886.  
  5887.                 DC.W 0
  5888.                 DC.L (null_less-sys-of)
  5889. __null_less:    DC.L (__null_greater-datas)
  5890.                 DC.B 2,'0<'
  5891.                 EVEN
  5892.  
  5893.  
  5894.                 DC.W 0
  5895.                 DC.L (null_grgl-sys-of)
  5896. __null_grgl:    DC.L (__null_less-datas)
  5897.                 DC.B 3,'0>='
  5898.                 EVEN
  5899.  
  5900.  
  5901.                 DC.W 0
  5902.                 DC.L (null_legl-sys-of)
  5903. __null_legl:    DC.L (__null_grgl-datas)
  5904.                 DC.B 3,'0<='
  5905.                 EVEN
  5906.  
  5907.  
  5908.                 DC.W 0
  5909.                 DC.L (gleich-sys-of)
  5910. __gleich:       DC.L (__null_legl-datas)
  5911.                 DC.B 1,'='
  5912.                 EVEN
  5913.  
  5914.  
  5915.                 DC.W 0
  5916.                 DC.L (ungleich-sys-of)
  5917. __ungleich:     DC.L (__gleich-datas)
  5918.                 DC.B 2,'<>'
  5919.                 EVEN
  5920.  
  5921.  
  5922.                 DC.W 0
  5923.                 DC.L (less-sys-of)
  5924. __less:         DC.L (__ungleich-datas)
  5925.                 DC.B 1,'<'
  5926.                 EVEN
  5927.  
  5928.  
  5929.                 DC.W 0
  5930.                 DC.L (greater-sys-of)
  5931. __greater:      DC.L (__less-datas)
  5932.                 DC.B 1,'>'
  5933.                 EVEN
  5934.  
  5935.  
  5936.                 DC.W 0
  5937.                 DC.L (grgl-sys-of)
  5938. __grgl:         DC.L (__greater-datas)
  5939.                 DC.B 2,'>='
  5940.                 EVEN
  5941.  
  5942.  
  5943.                 DC.W 0
  5944.                 DC.L (legl-sys-of)
  5945. __legl:         DC.L (__grgl-datas)
  5946.                 DC.B 2,'<='
  5947.                 EVEN
  5948.  
  5949.  
  5950.                 DC.W 0
  5951.                 DC.L (min-sys-of)
  5952. __min:          DC.L (__legl-datas)
  5953.                 DC.B 3,'MIN'
  5954.                 EVEN
  5955.  
  5956.  
  5957.                 DC.W 0
  5958.                 DC.L (max-sys-of)
  5959. __max:          DC.L (__min-datas)
  5960.                 DC.B 3,'MAX'
  5961.                 EVEN
  5962.  
  5963.  
  5964.                 DC.W 0
  5965.                 DC.L (b_forget-sys-of)
  5966. __b_forget:     DC.L (__max-datas)
  5967.                 DC.B 7,'(FORGET'
  5968.                 EVEN
  5969.  
  5970.  
  5971.                 DC.W 0
  5972.                 DC.L (forget-sys-of)
  5973. __forget:       DC.L (__b_forget-datas)
  5974.                 DC.B 6,'FORGET'
  5975.                 EVEN
  5976.  
  5977. fencemess:      DC.B 17,' is beyond fence!'
  5978.                 EVEN
  5979.  
  5980.  
  5981.                 DC.W 0
  5982.                 DC.L (string_komma-sys-of)
  5983. __string_komma: DC.L (__forget-datas)
  5984.                 DC.B 2,',"'
  5985.                 EVEN
  5986.  
  5987.  
  5988.                 DC.W 6          ;immediate, restrict
  5989.                 DC.L (string_emit-sys-of)
  5990. __string_emit:  DC.L (__string_komma-datas)
  5991.                 DC.B 2,'."'
  5992.                 EVEN
  5993.  
  5994.  
  5995.                 DC.W 2          ;immediate
  5996.                 DC.L (dot_brack-sys-of)
  5997. __dot_brack:    DC.L (__string_emit-datas)
  5998.                 DC.B 2,'.('
  5999.                 EVEN
  6000.  
  6001.  
  6002.                 DC.W 2          ;immediate
  6003.                 DC.L (comment_brack-sys-of)
  6004. __comment_brack:DC.L (__dot_brack-datas)
  6005.                 DC.B 1,'('
  6006.                 EVEN
  6007.  
  6008.  
  6009.                 DC.W 6          ;immediate restrict
  6010.                 DC.L (error_quote-sys-of)
  6011. __error_quote:  DC.L (__comment_brack-datas)
  6012.                 DC.B 6,'ERROR"'
  6013.                 EVEN
  6014.  
  6015.  
  6016.                 DC.W 0
  6017.                 DC.L (abort-sys-of)
  6018. __abort:        DC.L (__error_quote-datas)
  6019.                 DC.B 5,'ABORT'
  6020.                 EVEN
  6021.  
  6022.  
  6023.                 DC.W 6          ;immediate restrict
  6024.                 DC.L (abort_quote-sys-of)
  6025. __abort_quote:  DC.L (__abort-datas)
  6026.                 DC.B 6,'ABORT"'
  6027.                 EVEN
  6028.  
  6029.  
  6030.                 DC.W 2          ;immediate
  6031.                 DC.L (quote-sys-of)
  6032. __quote:        DC.L (__abort_quote-datas)
  6033.                 DC.B 1,'"'
  6034.                 EVEN
  6035.  
  6036.  
  6037.                 DC.W 6          ;immediate restrict
  6038.                 DC.L (postpone-sys-of)
  6039. __postpone:     DC.L (__quote-datas)
  6040.                 DC.B 8,'POSTPONE'
  6041.                 EVEN
  6042.  
  6043.  
  6044.                 DC.W 0
  6045.                 DC.L (immediate-sys-of)
  6046. __immediate:    DC.L (__postpone-datas)
  6047.                 DC.B 9,'IMMEDIATE'
  6048.                 EVEN
  6049.  
  6050.  
  6051.                 DC.W 0
  6052.                 DC.L (restrict-sys-of)
  6053. __restrict:     DC.L (__immediate-datas)
  6054.                 DC.B 8,'RESTRICT'
  6055.                 EVEN
  6056.  
  6057.  
  6058.                 DC.W 0
  6059.                 DC.L (vocabulary-sys-of)
  6060. __vocabulary:   DC.L (__restrict-datas)
  6061.                 DC.B 10,'VOCABULARY'
  6062.                 EVEN
  6063.  
  6064.  
  6065.                 DC.W 0
  6066.                 DC.L (fill-sys-of)
  6067. __fill:         DC.L (__vocabulary-datas)
  6068.                 DC.B 4,'FILL'
  6069.                 EVEN
  6070.  
  6071.  
  6072.                 DC.W 0
  6073.                 DC.L (erase-sys-of)
  6074. __erase:        DC.L (__fill-datas)
  6075.                 DC.B 5,'ERASE'
  6076.                 EVEN
  6077.  
  6078.  
  6079.                 DC.W $0108
  6080.                 DC.L (one_plus-sys-of)
  6081. __one_plus:     DC.L (__erase-datas)
  6082.                 DC.B 2,'1+'
  6083.                 EVEN
  6084.  
  6085.  
  6086.                 DC.W $0108
  6087.                 DC.L (one_minus-sys-of)
  6088. __one_minus:    DC.L (__one_plus-datas)
  6089.                 DC.B 2,'1-'
  6090.                 EVEN
  6091.  
  6092.  
  6093.                 DC.W $0108
  6094.                 DC.L (two_plus-sys-of)
  6095. __two_plus:     DC.L (__one_minus-datas)
  6096.                 DC.B 2,'2+'
  6097.                 EVEN
  6098.  
  6099.  
  6100.                 DC.W $0108
  6101.                 DC.L (two_minus-sys-of)
  6102. __two_minus:    DC.L (__two_plus-datas)
  6103.                 DC.B 2,'2-'
  6104.                 EVEN
  6105.  
  6106.  
  6107.                 DC.W $0308
  6108.                 DC.L (two_mult-sys-of)
  6109. __two_mult:     DC.L (__two_minus-datas)
  6110.                 DC.B 2,'2*'
  6111.                 EVEN
  6112.  
  6113.  
  6114.                 DC.W $0308
  6115.                 DC.L (two_div-sys-of)
  6116. __two_div:      DC.L (__two_mult-datas)
  6117.                 DC.B 2,'2/'
  6118.                 EVEN
  6119.  
  6120.  
  6121.                 DC.W $0108
  6122.                 DC.L (cell_plus-sys-of)
  6123. __cell_plus:    DC.L (__two_div-datas)
  6124.                 DC.B 5,'CELL+'
  6125.                 EVEN
  6126.  
  6127.  
  6128.                 DC.W $0308
  6129.                 DC.L (cells-sys-of)
  6130. __cells:        DC.L (__cell_plus-datas)
  6131.                 DC.B 5,'CELLS'
  6132.                 EVEN
  6133.  
  6134.  
  6135.                 DC.W $0108
  6136.                 DC.L (char_plus-sys-of)
  6137. __char_plus:    DC.L (__cells-datas)
  6138.                 DC.B 5,'CHAR+'
  6139.                 EVEN
  6140.  
  6141.  
  6142.                 DC.W $08
  6143.                 DC.L (chars-sys-of)
  6144. __chars:        DC.L (__char_plus-datas)
  6145.                 DC.B 5,'CHARS'
  6146.                 EVEN
  6147.  
  6148.  
  6149.                 DC.W 0
  6150.                 DC.L (update-sys-of)
  6151. __update:       DC.L (__chars-datas)
  6152.                 DC.B 6,'UPDATE'
  6153.                 EVEN
  6154.  
  6155.                 DC.L -1         ;left free for USERBUFS ...
  6156.                 DC.L -1         ;... mechanism
  6157. buf:            DC.L (buf-datas) ;pointer to next buffer (0)
  6158.                 DC.L -1         ;phys. block            (4)
  6159.                 DC.L -1         ;log. block             (8)
  6160.                 DC.W 0          ;UPDATE                 (C)
  6161.                 DS.B 48         ;blockheader            (E)
  6162.                 DS.B 2000       ;data
  6163.                 EVEN
  6164.  
  6165.  
  6166.                 DC.W 0
  6167.                 DC.L (b_load-sys-of)
  6168. __b_load:       DC.L (__update-datas)
  6169.                 DC.B 5,'(LOAD'
  6170.                 EVEN
  6171.  
  6172.  
  6173. lasthead:
  6174.                 DC.W 0
  6175.                 DC.L (load-sys-of)
  6176. lastword:
  6177. __load:         DC.L (__b_load-datas)
  6178.                 DC.B 4,'LOAD'
  6179.                 EVEN
  6180. loadptr:        DC.L (b_load-sys-of)
  6181.  
  6182.  
  6183.  
  6184.  
  6185.  
  6186. *               dc.w    0
  6187. *               dc.l    (-sys-of)
  6188. *__:    dc.l    (__-datas)
  6189. *               dc.b    ,''
  6190. * even
  6191.  
  6192.                 ENDPART
  6193.  
  6194. *****************************************************************
  6195. dataHERE:
  6196.                 END
  6197.                 DC.W 0
  6198.