home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / forth / fig86.arc / FORTH.ASM next >
Assembly Source File  |  1982-11-20  |  45KB  |  2,957 lines
  1. ;        Forth Interest Group  8086 FORTH 
  2. ;
  3. ;       Adapted to run under Microsoft's MS-DOS 8086 operating
  4. ;    system by:
  5. ;
  6. ;        J. E. Smith
  7. ;        Univ. of Pennsylvania, Dept. of Chemistry
  8. ;        250 S. 33rd St.
  9. ;        Philadelphia, PA 19104 .
  10. ;
  11. ;       Additional modifications and enhancements
  12. ;    as described below were also implemented by Mr. Smith.
  13. ;    These changes are more fully described in a text file
  14. ;    FORTH.DOC which should accompany this source code.
  15. ;
  16. ;       This listing is placed in the public domain, and may
  17. ;    be freely distributed.
  18. ;
  19. ;
  20. ;    Current Source Version:
  21. ;
  22. ;    1.01    06-02-82    First to assemble with no errors;
  23. ;                all CPM/86 code, but 86-DOS ASM
  24. ;                source format.
  25. ;    1.02    06-02-82    Deleted all CPM/86 dependant code,
  26. ;                    substituted 86-DOS calls
  27. ;                    for console i/o.
  28. ;                Changed R/W to RAM simulation.
  29. ;    1.03    06-11-82    First working version !  Some minor
  30. ;                    aesthetic modifications.
  31. ;    1.10    06-12-82    Initial disk-based version.
  32. ;    1.1B    06-22-82    Configured to use 64K and 2 screens.
  33. ;                    Set ^C to cause warm start.
  34. ;    1.2A    07-02-82    Modified to word align pointers.
  35. ;                    Aside from assembler source
  36. ;                    alignment, the following FORTH
  37. ;                    words were modified:
  38. ;                    (FIND),PFA,NFA,and CREATE.
  39. ;    1.2B    07-08-82    1+, 2+ changed to CODE; added 1-, 2-.
  40. ;    1.2C    07-14-82    Added (ARRAY), (2ARR), and (XOF)
  41. ;    1.2D    07-18-82    Added (CARR), (2CARR) and PRINTER for
  42. ;                    echo to list output.
  43. ;    1.2E    08-18-82    Added :@, :!, :C@, :C!, MYSEG,
  44. ;                    DATE@, DATE!, TIME@, TIME!.
  45. ;                Changed ^C to use (ABORT).
  46. ;                Replaced all parameters with symbols
  47. ;                    defined by EQU at the start.
  48. ;---------------------------------------------------------------------
  49. ;    1.2E distributed as version 1.0
  50. ;---------------------------------------------------------------------
  51. ;
  52. ;        ( Page 2 )
  53. ;
  54. ; Version numbering and ASCII equates:
  55. ;
  56. FIGREL        EQU    1
  57. FIGREV        EQU    0
  58. USRVER        EQU    0
  59. ;
  60. ABL        EQU    20H
  61. ACR        EQU    0DH
  62. ADOT        EQU    2EH
  63. BELL        EQU    07H
  64. BSIN        EQU    7FH
  65. BSOUT        EQU    08H
  66. DLE        EQU    10H
  67. LF        EQU    0AH
  68. FF        EQU    0CH
  69. ;
  70. ; Memory allocation parameters:
  71. ;
  72. EM        EQU    0000        ;64K top of memory + 1
  73. NSCR        EQU    2        ;No. of 1024 byte screens
  74. KBBUF        EQU    128        ;No. of bytes per block
  75. US        EQU    40H        ;User area size ( in bytes )
  76. RTS        EQU    0A0H        ;Return stack/TIB size
  77. ;
  78. CO        EQU    KBBUF+4        ;No. bytes per block buffer
  79. NBUF        EQU    16        ;No. of block buffers =
  80.                     ; NSCR*1024 / KBBUF
  81. BUF1        EQU    0F7C0H        ;Addr. of first block buffer =
  82.                     ; EM - CO*NBUF
  83. INITR0        EQU    BUF1-US        ;Start of return stack (R0)
  84. INITS0        EQU    INITR0-RTS    ;Start of param. stack (S0)
  85. ;
  86. ; Disk parameters:
  87. ;
  88. TRKS        EQU    77        ;Tracks on 8" disk
  89. SPT2        EQU    52        ;8" Double density sectors/track
  90. SPT1        EQU    26        ;8" Single density sectors/track
  91. SPDRV2        EQU    3744        ;8" Double density sectors/drive
  92. SPDRV1        EQU    1872        ;8" Single density sectors/drive
  93. BPS        EQU    128        ;Bytes/sector
  94. SPBL        EQU    1        ;Sectors/block=KBBUF/BPS
  95. BPSC        EQU    8        ;Blocks/screen=1024/KBBUF
  96. MXDRV        EQU    2        ;Max. number of disk drives
  97. DD        EQU    0        ;Density(0=single,1=double)
  98. ;
  99. ;
  100. ;        ( Page 3 )
  101. ;
  102.         ORG    100H
  103. ORIG:         NOP
  104.         JMP    CLD
  105.         NOP
  106.         JMP    WRM
  107. ;
  108.         DB    FIGREL
  109.         DB    FIGREV
  110.         DB    USRVER
  111.         DB    0EH
  112.         DW    TASK-8
  113.         DW    BSIN
  114.         DW    INITR0
  115. ;
  116.         DW    INITS0
  117.         DW    INITR0
  118.         DW    INITS0
  119.         DW    32
  120.         DW    0
  121.         DW    INITDP
  122.         DW    INITDP
  123.         DW    FORTH+6
  124. ;
  125.         DW    05H,0B326H        ;"8086" ( in base 36 ! )
  126. UP:         DW    INITR0
  127. RPP:         DW    INITR0
  128. ;
  129. ;        ( Page 6 )
  130. ;
  131. BIP:         DW    0
  132. BIPE:         DW    0
  133. ;
  134. ;        ( Page 7 )
  135. ;
  136. TNEXT:         PUSHF
  137.         PUSH    AX
  138.         MOV    AX,[BIP]
  139.         OR    AX,AX
  140.         JZ    TNEXT2
  141.         CMP    AX,-1
  142.         JZ    TNEXT1
  143.         CMP    AX,SI
  144.         JZ    TNEXT1
  145.         JA    TNEXT2
  146.         MOV    AX,[BIPE]
  147.         OR    AX,AX
  148.         JZ    TNEXT2
  149.         CMP    AX,SI
  150.         JB    TNEXT2
  151. ;
  152. TNEXT1:     POP    AX
  153.         POPF
  154. BREAK:         JP    TNEXT3
  155. TNEXT2:     POP    AX
  156.         POPF
  157. TNEXT3:     LODW
  158.         MOV    BX,AX
  159.         JP    NEXT1
  160. ;
  161. ;        ( Page 8 )
  162. ;
  163. DPUSH:         PUSH    DX
  164. APUSH:         PUSH    AX
  165. ;
  166. NEXT:         LODW
  167.         MOV    BX,AX
  168. NEXT1:         MOV    DX,BX
  169.         INC    DX
  170.         JMP    [BX]
  171. ;        ( Page 9 )
  172. ;
  173.     ALIGN
  174. DP0:         DM    83H,"LIT"
  175.         DW    0
  176. LIT:         DW    $ + 2
  177.         LODW
  178.         JMP    APUSH
  179. ;
  180.     ALIGN
  181.         DM    87H,"EXECUTE"
  182.         DW    LIT - 6
  183. EXEC:         DW    $ + 2
  184.         POP    BX
  185.         JMP    NEXT1
  186. ;
  187.     ALIGN
  188.         DM    86H,"BRANCH"
  189.     ALIGN
  190.         DW    EXEC - 10
  191. BRAN:         DW    $ + 2
  192. BRAN1:         ADD    SI,[SI]
  193.         JMP    NEXT
  194. ;
  195.     ALIGN
  196.         DM    87H,"0BRANCH"
  197.         DW    BRAN - 10
  198. ZBRAN:         DW    $ + 2
  199.         POP    AX
  200.         OR    AX,AX
  201.         JZ    BRAN1
  202.         INC    SI
  203.         INC    SI
  204.         JMP    NEXT
  205. ;
  206. ;        ( Page 10 )
  207. ;
  208.     ALIGN
  209.         DM    86H,"(LOOP)"
  210.     ALIGN
  211.         DW    ZBRAN - 10
  212. XLOOP:         DW    $ + 2
  213.         MOV    BX,1
  214. XLOO1:         ADD    [BP],BX
  215.         MOV    AX,[BP]
  216.         SUB    AX,[BP+2]
  217.         XOR    AX,BX
  218.         JS    BRAN1
  219. ;
  220.         ADD    BP,4
  221.         INC    SI
  222.         INC    SI
  223.         JMP    NEXT
  224. ;
  225.     ALIGN
  226.         DM    87H,"(+LOOP)"
  227.         DW    XLOOP - 10
  228. XPLOO:         DW    $ + 2
  229.         POP    BX
  230.         JMP    XLOO1
  231. ;
  232.     ALIGN
  233.         DM    84H,"(DO)"
  234.     ALIGN
  235.         DW    XPLOO - 10
  236. XDO:         DW    $ + 2
  237.         POP    DX
  238.         POP    AX
  239.         XCHG    BP,SP
  240.         PUSH    AX
  241.         PUSH    DX
  242.         XCHG    BP,SP
  243.         JMP    NEXT
  244. ;
  245. ;************************
  246. ;*            *
  247. ;*    (XOF)        *
  248. ;*            *
  249. ;************************
  250. ;
  251. ;    Code added for Dr. Eaker's CASE construct
  252. ;    After John Cassady's 8080 code in FD 3:187 1982
  253. ;    (jes ver1.2C,1982)
  254. ;
  255.     ALIGN
  256.         DM    85H,"(XOF)"
  257.         DW    XDO - 8
  258. XOF:        DW    $ + 2
  259.         POP    BX        ;BX := case tag
  260.         POP    AX        ;AX := search tag
  261.         CMP    AX,BX        ;This one ?
  262.         JE    XOF1        ;Yes...
  263.         PUSH    AX        ;No, save search tag,
  264.         JMP    BRAN1        ;   and check the next case.
  265. XOF1:        INC    SI        ;...skip the branch offset,
  266.         INC    SI        ;   and
  267.         JMP    NEXT        ;   don't save the search tag.
  268. ;
  269. ;        ( Page 11 )
  270. ;
  271.     ALIGN
  272.         DM    81H,"I"
  273.         DW    XOF - 8
  274. IDO:         DW    $ + 2
  275.         MOV    AX,[BP]
  276.         JMP    APUSH
  277. ;
  278.     ALIGN
  279.         DM    85H,"DIGIT"
  280.         DW    IDO - 4
  281. DIGIT:         DW    $ + 2
  282.         POP    DX
  283.         POP    AX
  284.         SUB    AL,'0'
  285.         JB    DIGI2
  286.         CMP    AL,9
  287.         JBE    DIGI1
  288.         SUB    AL,7
  289.         CMP    AL,10
  290.         JB    DIGI2
  291. DIGI1:         CMP    AL,DL
  292.         JAE    DIGI2
  293.         SUB    DX,DX
  294.         MOV    DL,AL
  295.         MOV    AL,1
  296.         JMP    DPUSH
  297. DIGI2:         SUB    AX,AX
  298.         JMP    APUSH
  299. ;
  300. ;        ( Page 12 )
  301. ;
  302.     ALIGN
  303.         DM    86H,"(FIND)"
  304.     ALIGN
  305.         DW    DIGIT - 8
  306. PFIND:         DW    $ + 2
  307.         MOV    AX,DS
  308.         MOV    ES,AX
  309.         POP    BX
  310.         POP    CX
  311. PFIN1:         MOV    DI,CX
  312.         MOV    AL,[BX]
  313.         MOV    DL,AL
  314.         XOR    AL,[DI]
  315.         AND    AL,3FH
  316.         JNZ    PFIN5
  317. PFIN2:         INC    BX
  318.         INC    DI
  319.         MOV    AL,[BX]
  320.         XOR    AL,[DI]
  321.         ADD    AL,AL
  322.         JNZ    PFIN5
  323.         JNB    PFIN2
  324. ;
  325.         ADD    BX,6        ;Compute PFA (could be 5 or 6)
  326.         AND    BX,0FFFEH    ;Clear LSB to align
  327. ;
  328.         PUSH    BX
  329.         MOV    AX,1
  330.         SUB    DH,DH
  331.         JMP    DPUSH
  332. PFIN5:         INC    BX
  333.         JB    PFIN6
  334.         MOV    AL,[BX]
  335.         ADD    AL,AL
  336.         JMP    PFIN5
  337. ;
  338. PFIN6:        INC    BX        ;This could be one too many...
  339.         AND    BX,0FFFEH    ;Clear LSB to align
  340. ;
  341.         MOV    BX,[BX]
  342.         OR    BX,BX
  343.         JNZ    PFIN1
  344.         MOV    AX,0
  345.         JMP    APUSH
  346. ;
  347. ;        ( Page 13 )
  348. ;
  349.     ALIGN
  350.         DM    87H,"ENCLOSE"
  351.         DW    PFIND - 10
  352. ENCL:         DW    $ + 2
  353.         POP    AX
  354.         POP    BX
  355.         PUSH    BX
  356.         MOV    AH,0
  357.         MOV    DX,-1
  358.         DEC    BX
  359. ENCL1:         INC    BX
  360.         INC    DX
  361.         CMP    AL,[BX]
  362.         JZ    ENCL1
  363.         PUSH    DX
  364.         CMP    AH,[BX]
  365.         JNZ    ENCL2
  366.         MOV    AX,DX
  367.         INC    DX
  368.         JMP    DPUSH
  369. ENCL2:         INC    BX
  370.         INC    DX
  371.         CMP    AL,[BX]
  372.         JZ    ENCL4
  373.         CMP    AH,[BX]
  374.         JNZ    ENCL2
  375. ENCL3:         MOV    AX,DX
  376.         JMP    DPUSH
  377. ENCL4:         MOV    AX,DX
  378.         INC    AX
  379.         JMP    DPUSH
  380. ;
  381. ;        ( Page 14 )
  382. ;
  383.     ALIGN
  384.         DM    84H,"EMIT"
  385.     ALIGN
  386.         DW    ENCL - 10
  387. EMIT:         DW    DOCOL
  388.         DW    PEMIT
  389.         DW    ONE,OUTT
  390.         DW    PSTOR,SEMIS
  391. ;
  392.     ALIGN
  393.         DM    83H,"KEY"
  394.         DW    EMIT - 8
  395. KEY:         DW    $ + 2
  396.         JMP    PKEY
  397. ;
  398.     ALIGN
  399.         DM    89H,"?TERMINAL"
  400.         DW    KEY - 6
  401. QTERM:         DW    $ + 2
  402.         JMP    PQTER
  403. ;
  404.     ALIGN
  405.         DM    82H,"CR"
  406.     ALIGN
  407.         DW    QTERM - 12
  408. CR:         DW    $ + 2
  409.         JMP    PCR
  410. ;
  411.     ALIGN
  412.         DM    85H,"CMOVE"
  413.         DW    CR - 6
  414. CMOVE:         DW    $ + 2
  415.         CLD
  416.         MOV    BX,SI
  417.         POP    CX
  418.         POP    DI
  419.         POP    SI
  420.         MOV    AX,DS
  421.         MOV    ES,AX
  422.         REP
  423.         MOVB
  424.         MOV    SI,BX
  425.         JMP    NEXT
  426. ;
  427.     ALIGN
  428.         DM    82H,"U*"
  429.     ALIGN
  430.         DW    CMOVE - 8
  431. USTAR:         DW    $ + 2
  432.         POP    AX
  433.         POP    BX
  434.         MUL    AX,BX
  435.         XCHG    AX,DX
  436.         JMP    DPUSH
  437. ;
  438.     ALIGN
  439.         DM    82H,"U/"
  440.     ALIGN
  441.         DW    USTAR - 6
  442. USLAS:         DW    $ + 2
  443.         POP    BX
  444.         POP    DX
  445.         POP    AX
  446.         CMP    DX,BX
  447.         JNB    DZERO
  448.         DIV    AX,BX
  449.         JMP    DPUSH
  450. DZERO:         MOV    AX,-1
  451.         MOV    DX,AX
  452.         JMP    DPUSH
  453. ;
  454. ;        ( Page 16 )
  455. ;
  456.     ALIGN
  457.         DM    83H,"AND"
  458.         DW    USLAS - 6
  459. ANDD:         DW    $ + 2
  460.         POP    AX
  461.         POP    BX
  462.         AND    AX,BX
  463.         JMP    APUSH
  464. ;
  465.     ALIGN
  466.         DM    82H,"OR"
  467.     ALIGN
  468.         DW    ANDD - 6
  469. ORR:         DW    $ + 2
  470.         POP    AX
  471.         POP    BX
  472.         OR    AX,BX
  473.         JMP    APUSH
  474. ;
  475.     ALIGN
  476.         DM    83H,"XOR"
  477.         DW    ORR - 6
  478. XORR:         DW    $ + 2
  479.         POP    AX
  480.         POP    BX
  481.         XOR    AX,BX
  482.         JMP    APUSH
  483. ;
  484. ;        ( Page 17 )
  485. ;
  486.     ALIGN
  487.         DM    83H,"SP@"
  488.         DW    XORR - 6
  489. SPAT:         DW    $ + 2
  490.         MOV    AX,SP
  491.         JMP    APUSH
  492. ;
  493.     ALIGN
  494.         DM    83H,"SP!"
  495.         DW    SPAT - 6
  496. SPSTO:         DW    $ + 2
  497.         MOV    BX,[UP]
  498.         MOV    SP,[BX+6]
  499.         JMP    NEXT
  500. ;
  501.     ALIGN
  502.         DM    83H,"RP@"
  503.         DW    SPSTO - 6
  504. RPAT:         DW    $ + 2
  505.         MOV    AX,BP
  506.         JMP    APUSH
  507. ;
  508.     ALIGN
  509.         DM    83H,"RP!"
  510.         DW    RPAT - 6
  511. RPSTO:         DW    $ + 2
  512.         MOV    BX,[UP]
  513.         MOV    BP,[BX+8]
  514.         JMP    NEXT
  515. ;
  516. ;        ( Page 18 )
  517. ;
  518.     ALIGN
  519.         DM    82H,";S"
  520.     ALIGN
  521.         DW    RPSTO - 6
  522. SEMIS:         DW    $ + 2
  523.         MOV    SI,[BP]
  524.         INC    BP
  525.         INC    BP
  526.         JMP    NEXT
  527. ;
  528.     ALIGN
  529.         DM    85H,"LEAVE"
  530.         DW    SEMIS - 6
  531. LEAVE:         DW    $ + 2
  532.         MOV    AX,[BP]
  533.         MOV    [BP+2],AX
  534.         JMP    NEXT
  535. ;
  536. ;        ( Page 19 )
  537. ;
  538.     ALIGN
  539.         DM    82H,">R"
  540.     ALIGN
  541.         DW    LEAVE - 8
  542. TOR:         DW    $ + 2
  543.         POP    BX
  544.         DEC    BP
  545.         DEC    BP
  546.         MOV    [BP],BX
  547.         JMP    NEXT
  548. ;
  549.     ALIGN
  550.         DM    82H,"R>"
  551.     ALIGN
  552.         DW    TOR - 6
  553. FROMR:         DW    $ + 2
  554.         MOV    AX,[BP]
  555.         INC    BP
  556.         INC    BP
  557.         JMP    APUSH
  558. ;
  559.     ALIGN
  560.         DM    81H,"R"
  561.         DW    FROMR - 6
  562. RR:         DW    IDO + 2
  563. ;
  564. ;        ( Page 20 )
  565. ;
  566.     ALIGN
  567.         DM    82H,"0="
  568.     ALIGN
  569.         DW    RR - 4
  570. ZEQU:         DW    $ + 2
  571.         POP    AX
  572.         OR    AX,AX
  573.         MOV    AX,1
  574.         JZ    ZEQU1
  575.         DEC    AX
  576. ZEQU1:        JMP    APUSH
  577. ;
  578.     ALIGN
  579.         DM    82H,"0<"
  580.     ALIGN
  581.         DW    ZEQU - 6
  582. ZLESS:         DW    $ + 2
  583.         POP    AX
  584.         OR    AX,AX
  585.         MOV    AX,1
  586.         JS    ZLESS1
  587.         DEC    AX
  588. ZLESS1:        JMP    APUSH
  589. ;
  590.     ALIGN
  591.         DM    81H,"+"
  592.         DW    ZLESS - 6
  593. PLUS:         DW    $ + 2
  594.         POP    AX
  595.         POP    BX
  596.         ADD    AX,BX
  597.         JMP    APUSH
  598. ;
  599. ;        ( Page 21 )
  600. ;
  601.     ALIGN
  602.         DM    82H,"D+"
  603.     ALIGN
  604.         DW    PLUS - 4
  605. DPLUS:         DW    $ + 2
  606.         POP    AX
  607.         POP    DX
  608.         POP    BX
  609.         POP    CX
  610.         ADD    DX,CX
  611.         ADC    AX,BX
  612.         JMP    DPUSH
  613. ;
  614.     ALIGN
  615.         DM    85H,"MINUS"
  616.         DW    DPLUS - 6
  617. MINUS:         DW    $ + 2
  618.         POP    AX
  619.         NEG    AX
  620.         JMP    APUSH
  621. ;
  622.     ALIGN
  623.         DM    86H,"DMINUS"
  624.     ALIGN
  625.         DW    MINUS - 8
  626. DMINU:         DW    $ + 2
  627.         POP    BX
  628.         POP    CX
  629.         SUB    AX,AX
  630.         MOV    DX,AX
  631.         SUB    DX,CX
  632.         SBB    AX,BX
  633.         JMP    DPUSH
  634. ;
  635. ;        ( Page 22 )
  636. ;
  637.     ALIGN
  638.         DM    84H,"OVER"
  639.     ALIGN
  640.         DW    DMINU - 10
  641. OVER:         DW    $ + 2
  642.         POP    DX
  643.         POP    AX
  644.         PUSH    AX
  645.         JMP    DPUSH
  646. ;
  647.     ALIGN
  648.         DM    84H,"DROP"
  649.     ALIGN
  650.         DW    OVER - 8
  651. DROP:         DW    $ + 2
  652.         POP    AX
  653.         JMP    NEXT
  654. ;
  655.     ALIGN
  656.         DM    84H,"SWAP"
  657.     ALIGN
  658.         DW    DROP - 8
  659. SWAP:         DW    $ + 2
  660.         POP    DX
  661.         POP    AX
  662.         JMP    DPUSH
  663. ;
  664.     ALIGN
  665.         DM    83H,"DUP"
  666.         DW    SWAP - 8
  667. DUP:         DW    $ + 2
  668.         POP    AX
  669.         PUSH    AX
  670.         JMP    APUSH
  671. ;
  672. ;        ( Page 23 )
  673. ;
  674.     ALIGN
  675.         DM    84H,"2DUP"
  676.     ALIGN
  677.         DW    DUP - 6
  678. TDUP:         DW    $ + 2
  679.         POP    AX
  680.         POP    DX
  681.         PUSH    DX
  682.         PUSH    AX
  683.         JMP    DPUSH
  684. ;
  685.     ALIGN
  686.         DM    82H,"+!"
  687.     ALIGN
  688.         DW    TDUP - 8
  689. PSTOR:         DW    $ + 2
  690.         POP    BX
  691.         POP    AX
  692.         ADD    [BX],AX
  693.         JMP    NEXT
  694. ;
  695.     ALIGN
  696.         DM    86H,"TOGGLE"
  697.     ALIGN
  698.         DW    PSTOR - 6
  699. TOGGL:         DW    $ + 2
  700.         POP    AX
  701.         POP    BX
  702.         XOR    [BX],AL
  703.         JMP    NEXT
  704. ;
  705.     ALIGN
  706.         DM    81H,"@"
  707.         DW    TOGGL - 10
  708. AT:         DW    $ + 2
  709.         POP    BX
  710.         MOV    AX,[BX]
  711.         JMP    APUSH
  712. ;
  713. ;        ( Page 24 )
  714. ;
  715.     ALIGN
  716.         DM    82H,"C@"
  717.     ALIGN
  718.         DW    AT - 4
  719. CAT:         DW    $ + 2
  720.         POP    BX
  721.         MOV    AL,[BX]
  722.         SUB    AH,AH
  723.         JMP    APUSH
  724. ;
  725.     ALIGN
  726.         DM    82H,"2@"
  727.     ALIGN
  728.         DW    CAT - 6
  729. TAT:         DW    $ + 2
  730.         POP    BX
  731.         MOV    AX,[BX]
  732.         MOV    DX,[BX+2]
  733.         JMP    DPUSH
  734. ;
  735.     ALIGN
  736.         DM    81H,"!"
  737.         DW    TAT - 6
  738. STORE:         DW    $ + 2
  739.         POP    BX
  740.         POP    AX
  741.         MOV    [BX],AX
  742.         JMP    NEXT
  743. ;
  744.     ALIGN
  745.         DM    82H,"C!"
  746.     ALIGN
  747.         DW    STORE - 4
  748. CSTOR:         DW    $ + 2
  749.         POP    BX
  750.         POP    AX
  751.         MOV    [BX],AL
  752.         JMP    NEXT
  753. ;
  754. ;        ( Page 25 )
  755. ;
  756.     ALIGN
  757.         DM    82H,"2!"
  758.     ALIGN
  759.         DW    CSTOR - 6
  760. TSTOR:         DW    $ + 2
  761.         POP    BX
  762.         POP    AX
  763.         MOV    [BX],AX
  764.         POP    AX
  765.         MOV    [BX+2],AX
  766.         JMP    NEXT
  767. ;
  768. ;********************************************************
  769. ;*                            *
  770. ;*    long fetch/store operators:    :@, :!        *
  771. ;*                    :C@, :C!    *
  772. ;*                    MYSEG        *
  773. ;*                            *
  774. ;********************************************************
  775. ;
  776.     ALIGN
  777.         DM    82H,":@"
  778.     ALIGN
  779.         DW    TSTOR - 6
  780. FARAT:        DW    $ + 2
  781.         POP    BX        ;Offset
  782.         MOV    DX,DS        ;Save current segment
  783.         POP    DS        ;Segment
  784.         MOV    AX,[BX]        ;Fetch word at DS:BX
  785.         MOV    DS,DX        ;Restore segment register
  786.         JMP    APUSH        ;Return
  787. ;
  788.     ALIGN
  789.         DM    82H,":!"
  790.     ALIGN
  791.         DW    FARAT - 6
  792. FARST:        DW    $ + 2
  793.         MOV    DX,DS
  794.         POP    BX        ;Offset
  795.         POP    DS        ;Segment
  796.         POP    AX        ;Data
  797.         MOV    [BX],AX
  798.         MOV    DS,DX
  799.         JMP    NEXT
  800. ;
  801.     ALIGN
  802.         DM    83H,":C@"
  803.         DW    FARST - 6
  804. FARCAT:        DW    $ + 2
  805.         MOV    DX,DS
  806.         POP    BX
  807.         POP    DS
  808.         MOV    B,AL,[BX]
  809.         XOR    AH,AH
  810.         MOV    DS,DX
  811.         JMP    APUSH
  812. ;
  813.     ALIGN
  814.         DM    83H,":C!"
  815.         DW    FARCAT - 6
  816. FARCST:        DW    $ + 2
  817.         MOV    DX,DS
  818.         POP    BX
  819.         POP    DS
  820.         POP    AX
  821.         MOV    B,[BX],AL
  822.         MOV    DS,DX
  823.         JMP    NEXT
  824. ;
  825.     ALIGN
  826.         DM    85H,"MYSEG"
  827.         DW    FARCST - 6
  828. MYSEG:        DW    $ + 2
  829.         MOV    AX,DS
  830.         JMP    APUSH
  831. ;
  832. ;        ( Page 26 )
  833. ;
  834.     ALIGN
  835.         DM    0C1H,":"
  836.         DW    MYSEG - 8
  837. COLON:         DW    DOCOL
  838.         DW    QEXEC,    SCSP
  839.         DW    CURR,    AT
  840.         DW    CONT,    STORE
  841.         DW    CREAT,    RBRAC
  842.         DW    PSCOD
  843. DOCOL:         INC    DX
  844.         DEC    BP
  845.         DEC    BP
  846.         MOV    [BP],SI
  847.         MOV    SI,DX
  848.         JMP    NEXT
  849. ;
  850.     ALIGN
  851.         DM    0C1H,";"
  852.         DW    COLON - 4
  853. SEMI:         DW    DOCOL
  854.         DW    QCSP,    COMP
  855.         DW    SEMIS,    SMUDG
  856.         DW    LBRAC,    SEMIS
  857. ;
  858.     ALIGN
  859.         DM    84H,"NOOP"
  860.     ALIGN
  861.         DW    SEMI - 4
  862. NOOP:         DW    DOCOL,    SEMIS
  863. ;
  864. ;        ( Page 27 )
  865. ;
  866.     ALIGN
  867.         DM    88H,"CONSTANT"
  868.     ALIGN
  869.         DW    NOOP - 8
  870. CON:         DW    DOCOL
  871.         DW    CREAT,    SMUDG
  872.         DW    COMMA,    PSCOD
  873. DOCON:         INC    DX
  874.         MOV    BX,DX
  875.         MOV    AX,[BX]
  876.         JMP    APUSH
  877. ;
  878.     ALIGN
  879.         DM    88H,"VARIABLE"
  880.     ALIGN
  881.         DW    CON - 12
  882. VAR:         DW    DOCOL
  883.         DW    CON,    PSCOD
  884. DOVAR:         INC    DX
  885.         PUSH    DX
  886.         JMP    NEXT
  887. ;
  888.     ALIGN
  889.         DM    84H,"USER"
  890.     ALIGN
  891.         DW    VAR - 12
  892. USER:        DW    DOCOL
  893.         DW    CON,    PSCOD
  894. DOUSE:         INC    DX
  895.         MOV    BX,DX
  896.         MOV    BL,[BX]
  897.         SUB    BH,BH
  898.         MOV    DI,[UP]
  899.         LEA    AX,[BX+DI]
  900.         JMP    APUSH
  901. ;
  902. ;************************
  903. ;*            *
  904. ;*    (ARRAY)        *
  905. ;*            *
  906. ;************************
  907. ;
  908. ;    Code added to support array references.
  909. ;    Used by ARRAY to calculate the address of the
  910. ;    nth element of the array.
  911. ;    (jes ver1.2c,1982)
  912. ;
  913.     ALIGN
  914.         DM    87H,"(ARRAY)"
  915.         DW    USER - 8
  916. PARR:        DW    $ + 2
  917.         POP    BX        ;BX -> SIZE
  918.         POP    AX        ;AX := n
  919.         ADD    AX,AX        ;AX := AX*2
  920.         ADD    AX,BX        ;AX -> ARRAY[n]
  921.         ADD    AX,2        ;Offset to ARRAY[0]
  922.         JMP    APUSH
  923. ;
  924.     ALIGN
  925.         DM    86H,"(2ARR)"
  926.     ALIGN
  927.         DW    PARR - 10
  928. P2ARR:        DW    $ + 2
  929.         POP    BX        ;BX -> rowsize
  930.         POP    CX        ;CX := column
  931.         POP    AX        ;AX := row
  932.         MUL    AX,[BX]        ;AX := row*row dim.
  933.         ADD    AX,CX        ;AX := AX + col
  934.         ADD    AX,AX        ;2 bytes per element
  935.         ADD    AX,BX        ;AX := AX+PFA
  936.         ADD    AX,4        ;Offset to ARRAY[0]
  937.         JMP    APUSH
  938. ;
  939.     ALIGN
  940.         DM    86H,"(CARR)"
  941.     ALIGN
  942.         DW    P2ARR - 10
  943. PCARR:        DW    $ + 2
  944.         POP    BX
  945.         POP    AX
  946.         ADD    AX,BX
  947.         ADD    AX,2
  948.         JMP    APUSH
  949. ;
  950.     ALIGN
  951.         DM    87H,"(2CARR)"
  952.         DW    PCARR - 10
  953. P2CAR:        DW    $ + 2
  954.         POP    BX
  955.         POP    CX
  956.         POP    AX
  957.         MUL    AX,[BX]
  958.         ADD    AX,CX
  959.         ADD    AX,BX
  960.         ADD    AX,4
  961.         JMP    APUSH
  962. ;
  963. ;        ( Page 28 )
  964. ;
  965.     ALIGN
  966.         DM    81H,"0"
  967.         DW    P2CAR - 10
  968. ZERO:         DW    DOCON
  969.         DW    0
  970. ;
  971.         DM    81H,"1"
  972.         DW    ZERO - 4
  973. ONE:         DW    DOCON
  974.         DW    1
  975. ;
  976.         DM    81H,"2"
  977.         DW    ONE - 4
  978. TWO:         DW    DOCON
  979.         DW    2
  980. ;
  981.         DM    81H,"3"
  982.         DW    TWO - 4
  983. THREE:         DW    DOCON
  984.         DW    3
  985. ;
  986.         DM    82H,"BL"
  987.     ALIGN
  988.         DW    THREE - 4
  989. BLS:         DW    DOCON
  990.         DW    20H
  991. ;
  992. ;        ( Page 29 )
  993. ;
  994.         DM    83H,"C/L"
  995.         DW    BLS - 6
  996. CSLL:         DW    DOCON
  997.         DW    64
  998. ;
  999.         DM    85H,"FIRST"
  1000.         DW    CSLL - 6
  1001. FIRST:         DW    DOCON
  1002.         DW    BUF1
  1003. ;
  1004.         DM    85H,"LIMIT"
  1005.         DW    FIRST - 8
  1006. LIMIT:         DW    DOCON
  1007.         DW    EM
  1008. ;
  1009.         DM    85H,"B/BUF"
  1010.         DW    LIMIT - 8
  1011. BBUF:         DW    DOCON
  1012.         DW    KBBUF
  1013. ;
  1014.         DM    85H,"B/SCR"
  1015.         DW    BBUF - 8
  1016. BSCR:         DW    DOCON
  1017.         DW    BPSC        ; 400H/KBBUF
  1018. ;
  1019. ;        ( Page 30 )
  1020. ;
  1021.  
  1022.  
  1023.         DM    87H,"+ORIGIN"
  1024.         DW    BSCR - 8
  1025. PORIG:         DW    DOCOL
  1026.         DW    LIT,    ORIG
  1027.         DW    PLUS,    SEMIS
  1028. ;
  1029. ;        ( Page 31 )
  1030. ;
  1031.         DM    82H,"S0"
  1032.     ALIGN
  1033.         DW    PORIG - 10
  1034. SZERO:         DW    DOUSE
  1035.         DW    6
  1036. ;
  1037.         DM    82H,"R0"
  1038.     ALIGN
  1039.         DW    SZERO - 6
  1040. RZERO:         DW    DOUSE
  1041.         DW    8
  1042. ;
  1043.         DM    83H,"TIB"
  1044.         DW    RZERO - 6
  1045. TIB:         DW    DOUSE
  1046.         DW    10
  1047. ;
  1048.         DM    85H,"WIDTH"
  1049.         DW    TIB - 6
  1050. WIDTH:         DW    DOUSE
  1051.         DW    12
  1052. ;
  1053.         DM    87H,"WARNING"
  1054.         DW    WIDTH - 8
  1055. WARN:         DW    DOUSE
  1056.         DW    14
  1057. ;
  1058. ;        ( Page 32 )
  1059. ;
  1060.         DM    85H,"FENCE"
  1061.         DW    WARN - 10
  1062. FENCE:         DW    DOUSE
  1063.         DW    16
  1064. ;
  1065.         DM    82H,"DP"
  1066.     ALIGN
  1067.         DW    FENCE - 8
  1068. DP:         DW    DOUSE
  1069.         DW    18
  1070. ;
  1071.         DM    88H,"VOC-LINK"
  1072.     ALIGN
  1073.         DW    DP - 6
  1074. VOCL:         DW    DOUSE
  1075.         DW    20
  1076. ;
  1077.         DM    83H,"BLK"
  1078.         DW    VOCL - 12
  1079. BLK:         DW    DOUSE
  1080.         DW    22
  1081. ;
  1082. ;        ( Page 33 )
  1083. ;
  1084.         DM    82H,"IN"
  1085.     ALIGN
  1086.         DW    BLK - 6
  1087. INN:         DW    DOUSE
  1088.         DW    24
  1089. ;
  1090.         DM    83H,"OUT"
  1091.         DW    INN - 6
  1092. OUTT:         DW    DOUSE
  1093.         DW    26
  1094. ;
  1095.         DM    83H,"SCR"
  1096.         DW    OUTT - 6
  1097. SCR:         DW    DOUSE
  1098.         DW    28
  1099. ;
  1100.         DM    86H,"OFFSET"
  1101.     ALIGN
  1102.         DW    SCR - 6
  1103. OFSET:         DW    DOUSE
  1104.         DW    30
  1105. ;
  1106.         DM    87H,"CONTEXT"
  1107.         DW    OFSET - 10
  1108. CONT:         DW    DOUSE
  1109.         DW    32
  1110. ;
  1111.         DM    87H,"CURRENT"
  1112.         DW    CONT - 10
  1113. CURR:         DW    DOUSE
  1114.         DW    34
  1115. ;
  1116.         DM    85H,"STATE"
  1117.         DW    CURR - 10
  1118. STATE:         DW    DOUSE
  1119.         DW    36
  1120. ;
  1121.         DM    84H,"BASE"
  1122.     ALIGN
  1123.         DW    STATE - 8
  1124. BASE:         DW    DOUSE
  1125.         DW    38
  1126. ;
  1127.         DM    83H,"DPL"
  1128.         DW    BASE - 8
  1129. DPL:         DW    DOUSE
  1130.         DW    40
  1131. ;
  1132.         DM    83H,"FLD"
  1133.         DW    DPL - 6
  1134. FLD:         DW    DOUSE
  1135.         DW    42
  1136. ;
  1137. ;        ( Page 35 )
  1138. ;
  1139.         DM    83H,"CSP"
  1140.         DW    FLD - 6
  1141. CSPP:         DW    DOUSE
  1142.         DW    44
  1143. ;
  1144.         DM    82H,"R#"
  1145.     ALIGN
  1146.         DW    CSPP - 6
  1147. RNUM:         DW    DOUSE
  1148.         DW    46
  1149. ;
  1150.         DM    83H,"HLD"
  1151.         DW    RNUM - 6
  1152. HLD:         DW    DOUSE
  1153.         DW    48
  1154. ;
  1155. ;        ( Page 36 )
  1156. ;
  1157.         DM    82H,"1+"
  1158.     ALIGN
  1159.         DW    HLD - 6
  1160. ONEP:         DW    $ + 2
  1161.         POP    AX
  1162.         INC    AX
  1163.         JMP    APUSH
  1164. ;
  1165.     ALIGN
  1166.         DM    82H,"2+"
  1167.     ALIGN
  1168.         DW    ONEP - 6
  1169. TWOP:         DW    $ + 2
  1170.         POP    AX
  1171.         INC    AX
  1172.         INC    AX
  1173.         JMP    APUSH
  1174. ;
  1175.     ALIGN
  1176.         DM    82H,"1-"
  1177.     ALIGN
  1178.         DW    TWOP - 6
  1179. ONEM:        DW    $ + 2
  1180.         POP    AX
  1181.         DEC    AX
  1182.         JMP    APUSH
  1183.     ALIGN
  1184.         DM    82H,"2-"
  1185.     ALIGN
  1186.         DW    ONEM - 6
  1187. TWOM:        DW    $ + 2
  1188.         POP    AX
  1189.         DEC    AX
  1190.         DEC    AX
  1191.         JMP    APUSH
  1192.     ALIGN
  1193.         DM    84H,"HERE"
  1194.     ALIGN
  1195.         DW    TWOM - 6
  1196. HERE:         DW    DOCOL
  1197.         DW    DP,    AT,    SEMIS
  1198. ;
  1199.         DM    85H,"ALLOT"
  1200.         DW    HERE - 8
  1201. ALLOT:         DW    DOCOL
  1202.         DW    DP,    PSTOR,    SEMIS
  1203. ;
  1204. ;        ( Page 37 )
  1205. ;
  1206.         DM    81H,","
  1207.         DW    ALLOT - 8
  1208. COMMA:         DW    DOCOL
  1209.         DW    HERE,    STORE
  1210.         DW    TWO,    ALLOT,    SEMIS
  1211. ;
  1212.         DM    82H,"C,"
  1213.     ALIGN
  1214.         DW    COMMA - 4
  1215. CCOMM:         DW    DOCOL
  1216.         DW    HERE,    CSTOR
  1217.         DW    ONE,    ALLOT,    SEMIS
  1218. ;
  1219.         DM    81H,"-"
  1220.         DW    CCOMM - 6
  1221. SUBB:         DW    $ + 2
  1222.         POP    DX
  1223.         POP    AX
  1224.         SUB    AX,DX
  1225.         JMP    APUSH
  1226. ;
  1227. ;        ( Page 38 )
  1228. ;
  1229.     ALIGN
  1230.         DM    81H,"="
  1231.         DW    SUBB - 4
  1232. EQUAL:         DW    DOCOL
  1233.         DW    SUBB,    ZEQU,    SEMIS
  1234. ;
  1235.         DM    81H,"<"
  1236.         DW    EQUAL - 4
  1237. LESS:         DW    $ + 2
  1238.         POP    DX
  1239.         POP    AX
  1240.         MOV    BX,DX
  1241.         XOR    BX,AX
  1242.         JS    LES1
  1243.         SUB    AX,DX
  1244. LES1:         OR    AX,AX
  1245.         MOV    AX,0
  1246.         JNS    LES2
  1247.         INC    AX
  1248. LES2:         JMP    APUSH
  1249. ;
  1250.     ALIGN
  1251.         DM    82H,"U<"
  1252.     ALIGN
  1253.         DW    LESS - 4
  1254. ULESS:         DW    DOCOL
  1255.         DW    TDUP,    XORR,    ZLESS
  1256.         DW    ZBRAN,    ULES1-$-2
  1257.         DW    DROP,    ZLESS,    ZEQU
  1258.         DW    BRAN,    ULES2-$-2
  1259. ULES1:         DW    SUBB,    ZLESS
  1260. ULES2:         DW    SEMIS
  1261. ;
  1262. ;        ( Page 39 )
  1263. ;
  1264.         DM    81H,">"
  1265.         DW    ULESS - 6
  1266. GREAT:         DW    DOCOL
  1267.         DW    SWAP,    LESS,    SEMIS
  1268. ;
  1269.         DM    83H,"ROT"
  1270.         DW    GREAT - 4
  1271. ROT:         DW    $ + 2
  1272.         POP    DX
  1273.         POP    BX
  1274.         POP    AX
  1275.         PUSH    BX
  1276.         JMP    DPUSH
  1277. ;
  1278.     ALIGN
  1279.         DM    85H,"SPACE"
  1280.         DW    ROT - 6
  1281. SPACE:         DW    DOCOL
  1282.         DW    BLS,    EMIT,    SEMIS
  1283. ;
  1284.         DM    84H,"-DUP"
  1285.     ALIGN
  1286.         DW    SPACE - 8
  1287. DDUP:         DW    DOCOL
  1288.         DW    DUP
  1289.         DW    ZBRAN,    DDUP1-$-2
  1290.         DW    DUP
  1291. DDUP1:         DW    SEMIS
  1292. ;
  1293. ;        ( Page 40 )
  1294. ;
  1295.         DM    88H,"TRAVERSE"
  1296.     ALIGN
  1297.         DW    DDUP - 8
  1298. TRAV:         DW    DOCOL
  1299.         DW    SWAP
  1300. TRAV1:         DW    OVER,    PLUS
  1301.         DW    LIT,    7FH
  1302.         DW    OVER,    CAT,    LESS
  1303.         DW    ZBRAN,    TRAV1-$-2
  1304.         DW    SWAP,    DROP,    SEMIS
  1305. ;
  1306.         DM    86H,"LATEST"
  1307.     ALIGN
  1308.         DW    TRAV - 12
  1309. LATES:         DW    DOCOL
  1310.         DW    CURR,    AT,    AT,    SEMIS
  1311. ;
  1312.         DM    83H,"LFA"
  1313.         DW    LATES - 10
  1314. LFA:         DW    DOCOL
  1315.         DW    LIT,    4
  1316.         DW    SUBB,    SEMIS
  1317. ;
  1318. ;        ( Page 41 )
  1319. ;
  1320.         DM    83H,"CFA"
  1321.         DW    LFA - 6
  1322. CFA:         DW    DOCOL
  1323.         DW    TWO,    SUBB,    SEMIS
  1324. ;
  1325.         DM    83H,"NFA"
  1326.         DW    CFA - 6
  1327. NFA:         DW    DOCOL
  1328.         DW    LIT,    5        ;Could be 5 or 6
  1329.         DW    SUBB
  1330.         DW    DUP,    CAT
  1331.         DW    LIT,    80H,    ANDD,    ZEQU
  1332.         DW    ZBRAN,    NFA1-$-2    ;MSB set, OK
  1333.         DW    ONEM            ;MSB not set, adjust
  1334. NFA1:        DW    LIT,    -1
  1335.         DW    TRAV,    SEMIS
  1336. ;
  1337.         DM    83H,"PFA"
  1338.         DW    NFA - 6
  1339. PFA:         DW    $ + 2
  1340.         POP    BX        ;BX:=NFA
  1341.         MOV    AL,[BX]        ;AL:=count
  1342.         AND    AL,1FH        ;Only lowest 5 bits
  1343.         ADD    AL,6
  1344.         SUB    AH,AH
  1345.         ADD    BX,AX        ;BX:=NFA+count+6
  1346.         AND    BX,0FFFEH    ;Clear LSB to align
  1347.         MOV    AX,BX
  1348.         JMP    APUSH        ;Save PFA
  1349. ;
  1350. ;        ( Page 42 )
  1351. ;
  1352.     ALIGN
  1353.         DM    84H,"!CSP"
  1354.     ALIGN
  1355.         DW    PFA - 6
  1356. SCSP:         DW    DOCOL
  1357.         DW    SPAT,    CSPP
  1358.         DW    STORE,    SEMIS
  1359. ;
  1360.         DM    86H,"?ERROR"
  1361.     ALIGN
  1362.         DW    SCSP - 8
  1363. QERR:         DW    DOCOL
  1364.         DW    SWAP
  1365.         DW    ZBRAN,    QERR1-$-2
  1366.         DW    ERROR
  1367.         DW    BRAN,    QERR2-$-2
  1368. QERR1:         DW    DROP
  1369. QERR2:         DW    SEMIS
  1370. ;
  1371.         DM    85H,"?COMP"
  1372.         DW    QERR - 10
  1373. QCOMP:         DW    DOCOL
  1374.         DW    STATE,    AT
  1375.         DW    ZEQU,    LIT,    17
  1376.         DW    QERR,    SEMIS
  1377. ;
  1378. ;        ( Page 43 )
  1379. ;
  1380.         DM    85H,"?EXEC"
  1381.         DW    QCOMP - 8
  1382. QEXEC:         DW    DOCOL
  1383.         DW    STATE,    AT
  1384.         DW    LIT,    18
  1385.         DW    QERR,    SEMIS
  1386. ;
  1387.         DM    86H,"?PAIRS"
  1388.     ALIGN
  1389.         DW    QEXEC - 8
  1390. QPAIR:         DW    DOCOL
  1391.         DW    SUBB
  1392.         DW    LIT,    19
  1393.         DW    QERR,    SEMIS
  1394. ;
  1395.         DM    84H,"?CSP"
  1396.     ALIGN
  1397.         DW    QPAIR - 10
  1398. QCSP:         DW    DOCOL
  1399.         DW    SPAT,    CSPP,    AT,    SUBB
  1400.         DW    LIT,    20
  1401.         DW    QERR,    SEMIS
  1402. ;
  1403.         DM    88H,"?LOADING"
  1404.     ALIGN
  1405.         DW    QCSP - 8
  1406. QLOAD:         DW    DOCOL
  1407.         DW    BLK,    AT,    ZEQU
  1408.         DW    LIT,    22
  1409.         DW    QERR,    SEMIS
  1410. ;
  1411. ;        ( Page 45 )
  1412. ;
  1413.         DM    87H,"COMPILE"
  1414.         DW    QLOAD - 12
  1415. COMP:         DW    DOCOL
  1416.         DW    QCOMP
  1417.         DW    FROMR,    DUP,    TWOP,    TOR
  1418.         DW    AT,    COMMA,    SEMIS
  1419. ;
  1420.         DM    0C1H,"["
  1421.         DW    COMP - 10
  1422. LBRAC:         DW    DOCOL
  1423.         DW    ZERO,    STATE,    STORE,    SEMIS
  1424. ;
  1425.         DM    81H,"]"
  1426.         DW    LBRAC - 4
  1427. RBRAC:         DW    DOCOL
  1428.         DW    LIT,    0C0H
  1429.         DW    STATE,    STORE,    SEMIS
  1430. ;
  1431. ;        ( Page 46 )
  1432. ;
  1433.         DM    86H,"SMUDGE"
  1434.     ALIGN
  1435.         DW    RBRAC - 4
  1436. SMUDG:         DW    DOCOL
  1437.         DW    LATES
  1438.         DW    LIT,    20H
  1439.         DW    TOGGL,    SEMIS
  1440. ;
  1441.         DM    83H,"HEX"
  1442.         DW    SMUDG - 10
  1443. HEX:         DW    DOCOL
  1444.         DW    LIT,    16
  1445.         DW    BASE,    STORE,    SEMIS
  1446. ;
  1447.         DM    87H,"DECIMAL"
  1448.         DW    HEX - 6
  1449. DECA:         DW    DOCOL
  1450.         DW    LIT,    10
  1451.         DW    BASE,    STORE,    SEMIS
  1452. ;
  1453. ;        ( Page 47 )
  1454. ;
  1455.         DM    87H,"(;CODE)"
  1456.         DW    DECA - 10
  1457. PSCOD:         DW    DOCOL
  1458.         DW    FROMR,    LATES,    PFA
  1459.         DW    CFA,    STORE,    SEMIS
  1460. ;
  1461.         DM    0C5H,";CODE"
  1462.         DW    PSCOD - 10
  1463. SEMIC:         DW    DOCOL
  1464.         DW    QCSP
  1465.         DW    COMP,    PSCOD,    LBRAC
  1466. SEMI1        DW    NOOP
  1467.         DW    SEMIS
  1468. ;
  1469.         DM    87H,"<BUILDS"
  1470.         DW    SEMIC - 8
  1471. BUILD:         DW    DOCOL
  1472.         DW    ZERO,    CON,    SEMIS
  1473. ;
  1474.         DM    85H,"DOES>"
  1475.         DW    BUILD - 10
  1476. DOES:         DW    DOCOL
  1477.         DW    FROMR,    LATES,    PFA,    STORE
  1478.         DW    PSCOD
  1479. DODOE:         XCHG    BP,SP
  1480.         PUSH    SI
  1481.         XCHG    BP,SP
  1482.         INC    DX
  1483.         MOV    BX,DX
  1484.         MOV    SI,[BX]
  1485.         INC    DX
  1486.         INC    DX
  1487.         PUSH    DX
  1488.         JMP    NEXT
  1489. ;
  1490. ;        ( Page 48 )
  1491. ;
  1492.     ALIGN
  1493.         DM    85H,"COUNT"
  1494.         DW    DOES - 8
  1495. COUNT:         DW    DOCOL
  1496.         DW    DUP,    ONEP,    SWAP,    CAT,    SEMIS
  1497. ;
  1498.         DM    84H,"TYPE"
  1499.     ALIGN
  1500.         DW    COUNT - 8
  1501. TYPES:         DW    DOCOL
  1502.         DW    DDUP
  1503.         DW    ZBRAN,    TYPE1-$-2
  1504.         DW    OVER,    PLUS
  1505.         DW    SWAP,    XDO
  1506. TYPE2:         DW    IDO,    CAT,    EMIT
  1507.         DW    XLOOP,    TYPE2-$-2
  1508.         DW    BRAN,    TYPE3-$-2
  1509. TYPE1:         DW    DROP
  1510. TYPE3:         DW    SEMIS
  1511. ;
  1512. ;        ( Page 49 )
  1513. ;
  1514.         DM    89H,"-TRAILING"
  1515.         DW    TYPES - 8
  1516. DTRAI:         DW    DOCOL
  1517.         DW    DUP,    ZERO,    XDO
  1518. DTRA1:         DW    OVER,    OVER,    PLUS
  1519.         DW    ONE,    SUBB,    CAT
  1520.         DW    BLS,    SUBB
  1521.         DW    ZBRAN,    DTRA2-$-2
  1522.         DW    LEAVE
  1523.         DW    BRAN,    DTRA3-$-2
  1524. DTRA2:         DW    ONE,    SUBB
  1525. DTRA3:         DW    XLOOP,    DTRA1-$-2
  1526.         DW    SEMIS
  1527. ;
  1528. ;        ( Page 50 )
  1529. ;
  1530.         DM    84H,'(.")'
  1531.     ALIGN
  1532.         DW    DTRAI - 12
  1533. PDOTQ:         DW    DOCOL
  1534.         DW    RR
  1535.         DW    COUNT,    DUP,    ONEP
  1536.         DW    FROMR,    PLUS,    TOR
  1537.         DW    TYPES,    SEMIS
  1538. ;
  1539.         DM    0C2H,'."'
  1540.     ALIGN
  1541.         DW    PDOTQ - 8
  1542. DOTQ:         DW    DOCOL
  1543.         DW    LIT,    '"'
  1544.         DW    STATE,    AT
  1545.         DW    ZBRAN,    DOTQ1-$-2
  1546.         DW    COMP
  1547.         DW    PDOTQ,    WORDS,    HERE
  1548.         DW    CAT,    ONEP,    ALLOT
  1549.         DW    BRAN,    DOTQ2-$-2
  1550. DOTQ1:         DW    WORDS,    HERE,    COUNT,    TYPES
  1551. DOTQ2:         DW    SEMIS
  1552. ;
  1553. ;        ( Page 51 )
  1554. ;
  1555.         DM    86H,"EXPECT"
  1556.     ALIGN
  1557.         DW    DOTQ - 6
  1558. EXPEC:         DW    DOCOL
  1559.         DW    OVER,    PLUS,    OVER
  1560.         DW    XDO
  1561. EXPE1:         DW    KEY,    DUP
  1562.         DW    LIT,    0EH
  1563.         DW    PORIG,    AT,    EQUAL
  1564.         DW    ZBRAN,    EXPE2-$-2
  1565.         DW    DROP,    DUP,    IDO
  1566.         DW    EQUAL,    DUP,    FROMR
  1567.         DW    TWO,    SUBB,    PLUS
  1568.         DW    TOR
  1569.         DW    ZBRAN,    EXPE6-$-2
  1570.         DW    LIT,    BELL
  1571.         DW    BRAN,    EXPE7-$-2
  1572. EXPE6:         DW    LIT,    BSOUT,    EMIT
  1573.         DW    BLS,    EMIT
  1574.         DW    LIT,    BSOUT
  1575. EXPE7:         DW    BRAN,    EXPE3-$-2
  1576. EXPE2:         DW    DUP,    LIT,    ACR
  1577.         DW    EQUAL
  1578.         DW    ZBRAN,    EXPE4-$-2
  1579.         DW    LEAVE,    DROP,    BLS,    ZERO
  1580.         DW    BRAN,    EXPE5-$-2
  1581. EXPE4:         DW    DUP
  1582. EXPE5:         DW    IDO
  1583.         DW    CSTOR,    ZERO,    IDO,    ONEP
  1584.         DW    STORE
  1585. EXPE3:         DW    EMIT
  1586.         DW    XLOOP,    EXPE1-$-2
  1587.         DW    DROP,    SEMIS
  1588. ;
  1589. ;        ( Page 52 )
  1590. ;
  1591.         DM    85H,"QUERY"
  1592.         DW    EXPEC - 10
  1593. QUERY:         DW    DOCOL
  1594.         DW    TIB,    AT
  1595.         DW    LIT,    80,    EXPEC
  1596.         DW    ZERO,    INN,    STORE,    SEMIS
  1597. ;
  1598. ;        ( Page 53 )
  1599. ;
  1600.         DB    0C1H,80H
  1601.         DW    QUERY - 8
  1602. NULL:         DW    DOCOL
  1603.         DW    BLK,    AT
  1604.         DW    ZBRAN,    NULL1-$-2
  1605.         DW    ONE,    BLK,    PSTOR
  1606.         DW    ZERO,    INN,    STORE
  1607.         DW    BLK,    AT
  1608.         DW    BSCR,    ONE,    SUBB,    ANDD
  1609.         DW    ZEQU
  1610.         DW    ZBRAN,    NULL2-$-2
  1611.         DW    QEXEC,    FROMR,    DROP
  1612. NULL2:         DW    BRAN,    NULL3-$-2
  1613. NULL1:         DW    FROMR,    DROP
  1614. NULL3:         DW    SEMIS
  1615. ;
  1616.         DM    84H,"FILL"
  1617.     ALIGN
  1618.         DW    NULL - 4
  1619. FILL:         DW    $ + 2
  1620.         POP    AX
  1621.         POP    CX
  1622.         POP    DI
  1623.         MOV    BX,DS
  1624.         MOV    ES,BX
  1625.         CLD
  1626.         REP
  1627.         STOB
  1628.         JMP    NEXT
  1629. ;
  1630. ;        ( Page 54 )
  1631. ;
  1632.     ALIGN
  1633.         DM    85H,"ERASE"
  1634.         DW    FILL - 8
  1635. ERASEE:     DW    DOCOL
  1636.         DW    ZERO,    FILL,    SEMIS
  1637. ;
  1638.         DM    86H,"BLANKS"
  1639.     ALIGN
  1640.         DW    ERASEE - 8
  1641. BLANK:         DW    DOCOL
  1642.         DW    BLS,    FILL,    SEMIS
  1643. ;
  1644.         DM    84H,"HOLD"
  1645.     ALIGN
  1646.         DW    BLANK - 10
  1647. HOLD:         DW    DOCOL
  1648.         DW    LIT,    -1
  1649.         DW    HLD,    PSTOR
  1650.         DW    HLD,    AT,    CSTOR,    SEMIS
  1651. ;
  1652.         DM    83H,"PAD"
  1653.         DW    HOLD - 8
  1654. PAD:         DW    DOCOL
  1655.         DW    HERE,    LIT,    68,    PLUS,    SEMIS
  1656.         DW    PLUS,    SEMIS
  1657. ;
  1658. ;        ( Page 55 )
  1659. ;
  1660.         DM    84H,"WORD"
  1661.     ALIGN
  1662.         DW    PAD - 6
  1663. WORDS:         DW    DOCOL
  1664.         DW    BLK,    AT
  1665.         DW    ZBRAN,    WORD1-$-2
  1666.         DW    BLK,    AT,    BLOCK
  1667.         DW    BRAN,    WORD2-$-2
  1668. WORD1:         DW    TIB,    AT
  1669. WORD2:         DW    INN,    AT,    PLUS,    SWAP
  1670.         DW    ENCL,    HERE
  1671.         DW    LIT,    34
  1672.         DW    BLANK,    INN,    PSTOR
  1673.         DW    OVER,    SUBB,    TOR
  1674.         DW    RR,    HERE,    CSTOR
  1675.         DW    PLUS,    HERE,    ONEP
  1676.         DW    FROMR,    CMOVE,    SEMIS
  1677. ;
  1678. ;        ( Page 56 )
  1679. ;
  1680.         DM    88H,"(NUMBER)"
  1681.     ALIGN
  1682.         DW    WORDS - 8
  1683. PNUMB:         DW    DOCOL
  1684. PNUM1:         DW    ONEP
  1685.         DW    DUP,    TOR
  1686.         DW    CAT,    BASE,    AT,    DIGIT
  1687.         DW    ZBRAN,    PNUM2-$-2
  1688.         DW    SWAP,    BASE,    AT,    USTAR
  1689.         DW    DROP,    ROT,    BASE,    AT
  1690.         DW    USTAR,    DPLUS
  1691.         DW    DPL,    AT,    ONEP
  1692.         DW    ZBRAN,    PNUM3-$-2
  1693.         DW    ONE,    DPL,    PSTOR
  1694. PNUM3:         DW    FROMR
  1695.         DW    BRAN,    PNUM1-$-2
  1696. PNUM2:         DW    FROMR,    SEMIS
  1697. ;
  1698. ;        ( Page 57 )
  1699. ;
  1700.         DM    86H,"NUMBER"
  1701.     ALIGN
  1702.         DW    PNUMB - 12
  1703. NUMB:         DW    DOCOL
  1704.         DW    ZERO,    ZERO
  1705.         DW    ROT,    DUP,    ONEP,    CAT
  1706.         DW    LIT,    "-",    EQUAL
  1707.         DW    DUP,    TOR,    PLUS
  1708.         DW    LIT,    -1
  1709. NUMB1:         DW    DPL,    STORE
  1710.         DW    PNUMB
  1711.         DW    DUP,    CAT,    BLS,    SUBB
  1712.         DW    ZBRAN,    NUMB2-$-2
  1713.         DW    DUP,    CAT
  1714.         DW    LIT,    ".",    SUBB
  1715.         DW    ZERO,    QERR,    ZERO
  1716.         DW    BRAN,    NUMB1-$-2
  1717. NUMB2:         DW    DROP,    FROMR
  1718.         DW    ZBRAN,    NUMB3-$-2
  1719.         DW    DMINU
  1720.     ALIGN
  1721. NUMB3:         DW    SEMIS
  1722. ;
  1723. ;        ( Page 58 )
  1724. ;
  1725.         DM    85H,"-FIND"
  1726.         DW    NUMB - 10
  1727. DFIND:         DW    DOCOL
  1728.         DW    BLS,    WORDS
  1729.         DW    HERE,    CONT,    AT,    AT
  1730.         DW    PFIND,    DUP,    ZEQU
  1731.         DW    ZBRAN,    DFIN1-$-2
  1732.         DW    DROP
  1733.         DW    HERE,    LATES,    PFIND
  1734. DFIN1:         DW    SEMIS
  1735. ;
  1736.         DM    87H,"(ABORT)"
  1737.         DW    DFIND - 8
  1738. PABOR:         DW    DOCOL
  1739.         DW    ABORT,    SEMIS
  1740. ;
  1741.         DM    85H,"ERROR"
  1742.         DW    PABOR - 10
  1743. ERROR:         DW    DOCOL
  1744.         DW    WARN,    AT,    ZLESS
  1745.         DW    ZBRAN,    ERRO1-$-2
  1746.         DW    PABOR
  1747. ERRO1:         DW    HERE,    COUNT,    TYPES
  1748.         DW    PDOTQ
  1749.         DB    2,"? "
  1750.         DW    MESS
  1751.         DW    SPSTO
  1752.         DW    BLK,    AT,    DDUP
  1753.         DW    ZBRAN,    ERRO2-$-2
  1754.         DW    INN,    AT,    SWAP
  1755. ERRO2:         DW    QUIT
  1756. ;
  1757. ;        ( Page 59 )
  1758. ;
  1759.     ALIGN
  1760.         DM    83H,"ID."
  1761.         DW    ERROR - 8
  1762. IDDOT:         DW    DOCOL
  1763.         DW    PAD
  1764.         DW    LIT,    32
  1765.         DW    LIT,    '_'
  1766.         DW    FILL
  1767.         DW    DUP,    PFA,    LFA
  1768.         DW    OVER,    SUBB
  1769.         DW    PAD,    SWAP,    CMOVE
  1770.         DW    PAD,    COUNT
  1771.         DW    LIT,    1FH
  1772.         DW    ANDD,    TYPES,    SPACE,    SEMIS
  1773. ;
  1774. ;        ( Page 60 )
  1775. ;
  1776.         DM    86H,"CREATE"
  1777.     ALIGN
  1778.         DW    IDDOT - 6
  1779. CREAT:         DW    DOCOL
  1780.         DW    DFIND
  1781.         DW    ZBRAN,    CREA1-$-2
  1782.         DW    DROP,    NFA,    IDDOT
  1783.         DW    LIT,    4,    MESS
  1784.         DW    SPACE
  1785. CREA1:         DW    HERE,    DUP,    CAT
  1786.         DW    WIDTH,    AT,    MIN
  1787.         DW    ONEP,    ALLOT
  1788.         DW    DUP
  1789.         DW    LIT,    0A0H
  1790.         DW    TOGGL
  1791.         DW    HERE,    ONE,    SUBB
  1792.         DW    LIT,    80H
  1793.         DW    TOGGL
  1794. ;
  1795.         DW    DP,    AT
  1796.         DW    ONEP
  1797.         DW    LIT,    0FFFEH,    ANDD
  1798.         DW    DP,    STORE
  1799. ;
  1800.         DW    LATES,    COMMA
  1801.         DW    CURR,    AT,    STORE
  1802.         DW    HERE,    TWOP,    COMMA,    SEMIS
  1803. ;
  1804. ;        ( Page 61 )
  1805. ;
  1806.         DM    0C9H,"[COMPILE]"
  1807.         DW    CREAT - 10
  1808. BCOMP:         DW    DOCOL
  1809.         DW    DFIND
  1810.         DW    ZEQU,    ZERO,    QERR
  1811.         DW    DROP,    CFA,    COMMA,    SEMIS
  1812. ;
  1813.         DM    0C7H,"LITERAL"
  1814.         DW    BCOMP - 12
  1815. LITER:         DW    DOCOL
  1816.         DW    STATE,    AT
  1817.         DW    ZBRAN,    LITE1-$-2
  1818.         DW    COMP,    LIT,    COMMA
  1819. LITE1:         DW    SEMIS
  1820. ;
  1821. ;        ( Page 62 )
  1822. ;
  1823.         DM    0C8H,"DLITERAL"
  1824.     ALIGN
  1825.         DW    LITER - 10
  1826. DLITE:         DW    DOCOL
  1827.         DW    STATE,    AT
  1828.         DW    ZBRAN,    DLIT1-$-2
  1829.         DW    SWAP,    LITER,    LITER
  1830. DLIT1:        DW    SEMIS
  1831. ;
  1832.         DM    86H,"?STACK"
  1833.     ALIGN
  1834.         DW    DLITE-12
  1835. QSTAC:        DW    DOCOL
  1836.         DW    SPAT,    SZERO,    AT
  1837.         DW    SWAP,    ULESS,    ONE,    QERR
  1838.         DW    SPAT,    HERE
  1839.         DW    LIT,    80H
  1840.         DW    PLUS,    ULESS
  1841.         DW    LIT,    7
  1842.         DW    QERR
  1843.         DW    SEMIS
  1844. ;
  1845. ;        ( Page 63 )
  1846. ;
  1847.         DM    89H,"INTERPRET"
  1848.         DW    QSTAC - 10
  1849. INTER:         DW    DOCOL
  1850. INTE1:         DW    DFIND
  1851.         DW    ZBRAN,    INTE2-$-2
  1852.         DW    STATE,     AT,    LESS
  1853.         DW    ZBRAN,    INTE3-$-2
  1854.         DW    CFA,    COMMA
  1855.         DW    BRAN,    INTE4-$-2
  1856. INTE3:         DW    CFA,    EXEC
  1857. INTE4:         DW    QSTAC
  1858.         DW    BRAN,    INTE5-$-2
  1859. INTE2:         DW    HERE,    NUMB,    DPL,    AT,    ONEP
  1860.         DW    ZBRAN,    INTE6-$-2
  1861.         DW    DLITE
  1862.         DW    BRAN,    INTE7-$-2
  1863. INTE6:         DW    DROP,    LITER
  1864. INTE7:        DW    QSTAC
  1865. INTE5:        DW    BRAN,    INTE1-$-2
  1866. ;
  1867. ;        ( Page 64 )
  1868. ;
  1869.         DM    89H,"IMMEDIATE"
  1870.         DW    INTER-12
  1871. IMMED:        DW    DOCOL
  1872.         DW    LATES
  1873.         DW    LIT,    40H
  1874.         DW    TOGGL,    SEMIS
  1875. ;
  1876.         DM    8AH,"VOCABULARY"
  1877.     ALIGN
  1878.         DW    IMMED - 12
  1879. VOCAB:         DW    DOCOL
  1880.         DW    BUILD
  1881.         DW    LIT,    0A081H
  1882.         DW    COMMA
  1883.         DW    CURR,    AT
  1884.         DW    CFA,    COMMA,    HERE,    VOCL
  1885.         DW    AT,    COMMA,    VOCL,    STORE
  1886.         DW    DOES
  1887. DOVOC:         DW    TWOP,    CONT,    STORE,    SEMIS
  1888. ;
  1889. ;        ( Page 65 )
  1890. ;
  1891.         DM    0C5H,"FORTH"
  1892.         DW    VOCAB - 14
  1893. FORTH:         DW    DODOE
  1894.         DW    DOVOC
  1895.         DW    0A081H
  1896.         DW    TASK - 8
  1897.         DW    0
  1898. ;
  1899.         DM    8BH,"DEFINITIONS"
  1900.         DW    FORTH - 8
  1901. DEFIN:         DW    DOCOL
  1902.         DW    CONT,    AT
  1903.         DW    CURR,    STORE,    SEMIS
  1904. ;
  1905.         DM    0C1H,"("
  1906.         DW    DEFIN - 14
  1907. PAREN:         DW    DOCOL
  1908.         DW    LIT,    ')',    WORDS,    SEMIS
  1909. ;;        ( Page 66 )
  1910. ;
  1911.         DM    84H,"QUIT"
  1912.     ALIGN
  1913.         DW    PAREN - 4
  1914. QUIT:         DW    DOCOL
  1915.         DW    ZERO,    BLK,    STORE
  1916.         DW    LBRAC
  1917. QUIT1:         DW    RPSTO,    CR,    QUERY
  1918.         DW    INTER
  1919.         DW    STATE,    AT,    ZEQU
  1920.         DW    ZBRAN,    QUIT2-$-2
  1921.         DW    PDOTQ
  1922.         DB    2,"ok"
  1923. QUIT2:         DW    BRAN,    QUIT1-$-2
  1924. ;
  1925.     ALIGN
  1926.         DM    85H,"ABORT"
  1927.         DW    QUIT - 8
  1928. ABORT:         DW    DOCOL
  1929.         DW    SPSTO,    DECA,    QSTAC,    CR
  1930.         DW    DOTCPU,    PDOTQ
  1931.         DB    16H,'Fig-FORTH  Version '
  1932.         DB    FIGREL+30H, ADOT, FIGREV+30H
  1933.         DW    LIT,    10,    PORIG,    CAT
  1934.         DW    LIT,    41H,    PLUS,    EMIT
  1935.         DW    FORTH,    DEFIN
  1936.         DW    LIT,    0,    PRTER,    STORE    ;Reset echo
  1937.         DW    QUIT
  1938. ;
  1939. ;        ( Page 67 )
  1940. ;
  1941. CTRLC:        
  1942. WRM:         MOV    SI,WRM1
  1943.         JMP    NEXT
  1944. WRM1        DW    PABOR
  1945. ;
  1946.     ALIGN
  1947.         DM    84H,"WARM"
  1948.     ALIGN
  1949.         DW    ABORT - 8
  1950. WARM:         DW    DOCOL
  1951.         DW    MTBUF,    ABORT
  1952. ;
  1953. CLD:         MOV    SI,CLD1
  1954.         MOV    AX,CS
  1955.         MOV    DS,AX
  1956.         MOV    SP,[ ORIG + 12H ]
  1957.         MOV    SS,AX
  1958.         MOV    ES,AX
  1959.         CLD
  1960.         MOV    BP,[RPP]
  1961. ;
  1962.         MOV    AH,37
  1963.         MOV    AL,35
  1964.         MOV    DX,CTRLC
  1965.         INT    33        ;Set ^C exit address
  1966. ;
  1967.         JMP    NEXT
  1968. CLD1:         DW    COLD
  1969. ;
  1970.     ALIGN
  1971.         DM    84H,"COLD"
  1972.     ALIGN
  1973.         DW    WARM - 8
  1974. COLD:         DW    DOCOL
  1975.         DW    MTBUF
  1976.         DW    ZERO,    DENSTY,    STORE
  1977.         DW    FIRST,    USE,    STORE
  1978.         DW    FIRST,    PREV,    STORE
  1979.         DW    DRZER
  1980.         DW    LIT,    ORIG+12H
  1981.         DW    LIT,    UP,    AT
  1982.         DW    LIT,    6,    PLUS
  1983.         DW    LIT,    16,    CMOVE
  1984.         DW    LIT,    ORIG+12,AT
  1985.         DW    LIT,    FORTH+6,STORE
  1986.         DW    LIT,    4,    SCR,    STORE
  1987.         DW    ABORT
  1988. ;
  1989. ;        ( Page 69 )
  1990. ;
  1991.         DM    84H,"S->D"
  1992.     ALIGN
  1993.         DW    COLD - 8
  1994. STOD:         DW    $ + 2
  1995.         POP    DX
  1996.         SUB    AX,AX
  1997.         OR    DX,DX
  1998.         JNS    STOD1
  1999.         DEC    AX
  2000. STOD1:         JMP    DPUSH
  2001. ;
  2002.     ALIGN
  2003.         DM    82H,"+-"
  2004.     ALIGN
  2005.         DW    STOD - 8
  2006. PM:         DW    DOCOL
  2007.         DW    ZLESS
  2008.         DW    ZBRAN,    PM1-$-2
  2009.         DW    MINUS
  2010. PM1:         DW    SEMIS
  2011. ;
  2012.         DM    83H,"D+-"
  2013.         DW    PM - 6
  2014. DPM:         DW    DOCOL
  2015.         DW    ZLESS
  2016.         DW    ZBRAN,    DPM1-$-2
  2017.         DW    DMINU
  2018. DPM1:         DW    SEMIS
  2019. ;
  2020.         DM    83H,"ABS"
  2021.         DW    DPM - 6
  2022. ABS:         DW    DOCOL
  2023.         DW    DUP,    PM,    SEMIS
  2024. ;;        ( Page 70 )
  2025. ;
  2026.         DM    84H,"DABS"
  2027.     ALIGN
  2028.         DW    ABS - 6
  2029. DABS:         DW    DOCOL
  2030.         DW    DUP,    DPM,    SEMIS
  2031. ;
  2032.         DM    83H,"MIN"
  2033.         DW    DABS - 8
  2034. MIN:         DW    DOCOL
  2035.         DW    TDUP,    GREAT
  2036.         DW    ZBRAN,    MIN1-$-2
  2037.         DW    SWAP
  2038. MIN1:         DW    DROP,    SEMIS
  2039. ;
  2040.         DM    83H,"MAX"
  2041.         DW    MIN - 6
  2042. MAX:         DW    DOCOL
  2043.         DW    TDUP,    LESS
  2044.         DW    ZBRAN,    MAX1-$-2
  2045.         DW    SWAP
  2046. MAX1:         DW    DROP,    SEMIS
  2047. ;
  2048. ;        ( Page 71 )
  2049. ;
  2050.         DM    82H,"M*"
  2051.     ALIGN
  2052.         DW    MAX - 6
  2053. MSTAR:        DW    DOCOL
  2054.         DW    TDUP,    XORR,    TOR
  2055.         DW    ABS
  2056.         DW    SWAP,    ABS,    USTAR
  2057.         DW    FROMR,    DPM,    SEMIS
  2058. ;
  2059.         DM    82H,"M/"
  2060.     ALIGN
  2061.         DW    MSTAR - 6
  2062. MSLAS:         DW    DOCOL
  2063.         DW    OVER,    TOR,    TOR
  2064.         DW    DABS
  2065.         DW    RR,    ABS,    USLAS
  2066.         DW    FROMR,    RR,    XORR
  2067.         DW    PM,    SWAP,    FROMR
  2068.         DW    PM,    SWAP,    SEMIS
  2069. ;
  2070.         DM    81H,"*"
  2071.         DW    MSLAS - 6
  2072. STAR:         DW    DOCOL
  2073.         DW    MSTAR,    DROP,    SEMIS
  2074. ;
  2075. ;        ( Page 72 )
  2076. ;
  2077.         DM    84H,"/MOD"
  2078.     ALIGN
  2079.         DW    STAR - 4
  2080. SLMOD:         DW    DOCOL
  2081.         DW    TOR,    STOD,    FROMR
  2082.         DW    MSLAS,    SEMIS
  2083. ;
  2084.         DM    81H,"/"
  2085.         DW    SLMOD - 8
  2086. SLASH:         DW    DOCOL
  2087.         DW    SLMOD,    SWAP,    DROP,    SEMIS
  2088. ;
  2089.         DM    83H,"MOD"
  2090.         DW    SLASH - 4
  2091. MODD:         DW    DOCOL
  2092.         DW    SLMOD,    DROP,    SEMIS
  2093. ;
  2094.         DM    85H,"*/MOD"
  2095.         DW    MODD - 6
  2096. SSMOD:         DW    DOCOL
  2097.         DW    TOR,    MSTAR,    FROMR
  2098.         DW    MSLAS,    SEMIS
  2099. ;
  2100. ;        ( Page 73 )
  2101. ;
  2102.         DM    82H,"*/"
  2103.     ALIGN
  2104.         DW    SSMOD - 8
  2105. SSLA:         DW    DOCOL
  2106.         DW    SSMOD,    SWAP,    DROP,    SEMIS
  2107. ;
  2108.         DM    85H,"M/MOD"
  2109.         DW    SSLA - 6
  2110. MSMOD:         DW    DOCOL
  2111.         DW    TOR,    ZERO,    RR,    USLAS
  2112.         DW    FROMR,    SWAP,    TOR
  2113.         DW    USLAS,    FROMR,    SEMIS
  2114. ;
  2115. ;        ( Page 74 )
  2116. ;
  2117.         DM    86H,"(LINE)"
  2118.     ALIGN
  2119.         DW    MSMOD - 8
  2120. PLINE:         DW    DOCOL
  2121.         DW    TOR
  2122.         DW    LIT,    64
  2123.         DW    BBUF,    SSMOD
  2124.         DW    FROMR,    BSCR,    STAR
  2125.         DW    PLUS
  2126.         DW    BLOCK,    PLUS
  2127.         DW    LIT,    64,    SEMIS
  2128. ;
  2129.         DM    85H,".LINE"
  2130.         DW    PLINE - 10
  2131. DLINE:         DW    DOCOL
  2132.         DW    PLINE,    DTRAI,    TYPES,    SEMIS
  2133. ;
  2134.         DM    87H,"MESSAGE"
  2135.         DW    DLINE - 8
  2136. MESS:         DW    DOCOL
  2137.         DW    WARN,    AT
  2138.         DW    ZBRAN,    MESS1-$-2
  2139.         DW    DDUP
  2140.         DW    ZBRAN,    MESS2-$-2
  2141.         DW    LIT,    4
  2142.         DW    OFSET,    AT,    BSCR,    SLASH
  2143.         DW    SUBB,    DLINE,    SPACE
  2144. MESS2:         DW    BRAN,    MESS3-$-2
  2145. MESS1:         DW    PDOTQ
  2146.         DB    6,"MSG # "
  2147.         DW    DOT
  2148. MESS3:         DW    SEMIS
  2149. ;
  2150. ;        ( Page 76 )
  2151. ;
  2152.     ALIGN
  2153.         DM    83H,"PC@"
  2154.         DW    MESS - 10
  2155. PTCAT:         DW    $ + 2
  2156.         POP    DX
  2157.         INB    DX
  2158.         SUB    AH,AH
  2159.         JMP    APUSH
  2160. ;
  2161.     ALIGN
  2162.         DM    83H,"PC!"
  2163.         DW    PTCAT - 6
  2164. PTCSTO:     DW    $ + 2
  2165.         POP    DX
  2166.         POP    AX
  2167.         OUTB    DX
  2168.         JMP    NEXT
  2169. ;
  2170.     ALIGN
  2171.         DM    82H,"P@"
  2172.     ALIGN
  2173.         DW    PTCSTO - 6
  2174. PTAT:         DW    $ + 2
  2175.         POP    DX
  2176.         INW    DX
  2177.         JMP    APUSH
  2178. ;
  2179. ;        ( Page 77 )
  2180. ;
  2181.     ALIGN
  2182.         DM    82H,"P!"
  2183.     ALIGN
  2184.         DW    PTAT - 6
  2185. PTSTO:         DW    $ + 2
  2186.         POP    DX
  2187.         POP    AX
  2188.         OUTW    DX
  2189.         JMP    NEXT
  2190. ;
  2191. ;        ( Page 78 )
  2192. ;
  2193. ;        Disk Interface Words for MS-DOS, etc.
  2194. ;        --------------------------------
  2195. ;
  2196. ;
  2197.     ALIGN
  2198.         DM    85H,"DRIVE"
  2199.         DW    PTSTO - 6
  2200. DRIVE:         DW    DOVAR,    0
  2201. ;
  2202.         DM    86H,"RECORD"    ;Not in fig listing
  2203.     ALIGN
  2204.         DW    DRIVE - 8
  2205. REC:         DW    DOVAR,    0
  2206. ;
  2207. ;        ( Page 79 )
  2208. ;
  2209.         DM    83H,"USE"
  2210.         DW    REC - 10
  2211. USE:         DW    DOVAR,    BUF1
  2212. ;
  2213.         DM    84H,"PREV"
  2214.     ALIGN
  2215.         DW    USE - 6
  2216. PREV:         DW    DOVAR,    BUF1
  2217. ;
  2218.         DM    87H,"SEC/BLK"
  2219.         DW    PREV - 8
  2220. SPBLK:         DW    DOCON,    SPBL    ; KBBUF / BPS
  2221. ;
  2222. ;        ( Page 80 )
  2223. ;
  2224.         DM    85H,"#BUFF"
  2225.         DW    SPBLK - 10
  2226. NOBUF:         DW    DOCON,    NBUF
  2227. ;
  2228.         DM    87H,"DENSITY"
  2229.         DW    NOBUF - 8
  2230. DENSTY:     DW    DOVAR,    DD
  2231. ;
  2232.         DM    8AH,"DISK-ERROR"
  2233.     ALIGN
  2234.         DW    DENSTY - 10
  2235. DSKERR:     DW    DOVAR,    0
  2236. ;
  2237.         DM    87H,"PRINTER"        ;EPRINT in fig
  2238.         DW    DSKERR - 14
  2239. PRTER:        DW    DOVAR, 0
  2240. ;
  2241. ;        ( Page 81 )
  2242. ;
  2243.         DM    84H,"+BUF"
  2244.     ALIGN
  2245.         DW    PRTER - 10
  2246. PBUF:         DW    DOCOL
  2247.         DW    BBUF,    TWOP,    TWOP    ;B/BUF+4
  2248.         DW    PLUS,    DUP,    LIMIT,    EQUAL
  2249.         DW    ZBRAN,    PBUF1-$-2
  2250.         DW    DROP,    FIRST
  2251. PBUF1:         DW    DUP,    PREV,    AT
  2252.         DW    SUBB,    SEMIS
  2253. ;
  2254.         DM    86H,"UPDATE"
  2255.     ALIGN
  2256.         DW    PBUF - 8
  2257. UPDAT:         DW    DOCOL
  2258.         DW    PREV,    AT,    AT
  2259.         DW    LIT,    8000H
  2260.         DW    ORR
  2261.         DW    PREV,    AT,    STORE,    SEMIS
  2262. ;
  2263.         DM    8DH,"EMPTY-BUFFERS"
  2264.         DW    UPDAT - 10
  2265. MTBUF:         DW    DOCOL
  2266.         DW    FIRST,    LIMIT,    OVER
  2267.         DW    SUBB,    ERASEE,    SEMIS
  2268. ;
  2269. ;        ( Page 82 )
  2270. ;
  2271.         DM    83H,"DR0"
  2272.         DW    MTBUF - 16
  2273. DRZER:         DW    DOCOL
  2274.         DW    ZERO,    OFSET,    STORE,    SEMIS
  2275. ;
  2276.         DM    83H,"DR1"
  2277.         DW    DRZER - 6
  2278. DRONE:         DW    DOCOL
  2279.         DW    DENSTY,    AT
  2280.         DW    ZBRAN,    DRON1-$-2
  2281.         DW    LIT,    SPDRV2
  2282.         DW    BRAN,    DRON2-$-2
  2283. DRON1:         DW    LIT,    SPDRV1
  2284. DRON2:         DW    OFSET,    STORE,    SEMIS
  2285. ;
  2286. ;        ( Page 83 )
  2287. ;
  2288.         DM    86H,"BUFFER"
  2289.     ALIGN
  2290.         DW    DRONE - 6
  2291. BUFFE:         DW    DOCOL
  2292.         DW    USE,    AT,    DUP,    TOR
  2293. BUFF1:         DW    PBUF
  2294.         DW    ZBRAN,    BUFF1-$-2
  2295.         DW    USE,    STORE
  2296.         DW    RR,    AT,    ZLESS
  2297.         DW    ZBRAN,    BUFF2-$-2
  2298.         DW    RR,    TWOP
  2299.         DW    RR,    AT
  2300.         DW    LIT,    7FFFH
  2301.         DW    ANDD,    ZERO,    RSLW
  2302. BUFF2:         DW    RR,    STORE
  2303.         DW    RR,    PREV,    STORE
  2304.         DW    FROMR,    TWOP,    SEMIS
  2305. ;
  2306. ;        ( Page 84 )
  2307. ;
  2308.         DM    85H,"BLOCK"
  2309.         DW    BUFFE - 10
  2310. BLOCK:         DW    DOCOL
  2311.         DW    OFSET,    AT,    PLUS,    TOR
  2312.         DW    PREV,    AT,    DUP
  2313.         DW    AT,    RR,    SUBB
  2314.         DW    DUP,    PLUS
  2315.         DW    ZBRAN,    BLOC1-$-2
  2316. BLOC2:         DW    PBUF,    ZEQU
  2317.         DW    ZBRAN,    BLOC3-$-2
  2318.         DW    DROP,    RR
  2319.         DW    BUFFE,    DUP
  2320.         DW    RR,    ONE,    RSLW
  2321.         DW    TWO,    SUBB
  2322. BLOC3:         DW    DUP,    AT,    RR,    SUBB
  2323.         DW    DUP,    PLUS,    ZEQU
  2324.         DW    ZBRAN,    BLOC2-$-2
  2325.         DW    DUP,    PREV,    STORE
  2326. BLOC1:         DW    FROMR,    DROP
  2327.         DW    TWOP,    SEMIS
  2328. ;
  2329. ;        ( Page 85 )
  2330. ;        ( Page 86 )
  2331. ;
  2332.         DM    87H,"T&SCALC"
  2333.         DW    BLOCK-8
  2334. TSCALC:        DW    DOCOL
  2335.         DW    DENSTY,    AT
  2336.         DW    ZBRAN,    TSCALS-$-2
  2337.         DW    LIT,    SPDRV2,    SLMOD
  2338. ;        DW    LIT,    MXDRV,    MIN
  2339.         DW    DRIVE,    STORE
  2340.         DW    REC,    STORE,    SEMIS
  2341. ;        single density calculations :
  2342. TSCALS:        DW    LIT,    SPDRV1,    SLMOD
  2343. ;        DW    LIT,    MXDRV,    MIN
  2344.         DW    DRIVE,    STORE
  2345.         DW    REC,    STORE,    SEMIS
  2346. ;
  2347. ;        ( Page 87 )
  2348. ;
  2349.         DM    8AH,"BLOCK-READ"
  2350.     ALIGN
  2351.         DW    TSCALC - 10
  2352. BLKRD:        DW    $ + 2
  2353.         MOV    [DSKERR+2],0    ;reset error flag
  2354.         MOV    AX,[DRIVE+2]    ;AL = drive no.
  2355.         MOV    BX,[USE+2]    ;BX = transfer address
  2356.         MOV    CX,[SPBLK+2]    ;CX = no. records to transfer
  2357.         MOV    DX,[REC+2]    ;DX = logical record #
  2358.         PUSH    SI
  2359.         PUSH    BP
  2360.         INT    37        ;BIOS disk read function
  2361.         JNC    READOK
  2362.         MOV    B,[DSKERR+2],AL    ;READ ERROR!
  2363. READOK:        POPF
  2364.         POP    BP
  2365.         POP    SI
  2366.         JMP    NEXT
  2367. ;
  2368.     ALIGN
  2369.         DM    8BH,"BLOCK-WRITE"
  2370.         DW    BLKRD - 14
  2371. BLKWRT:        DW    $ + 2
  2372.         MOV    [DSKERR+2],0    ;reset error flag
  2373.         MOV    AX,[DRIVE+2]
  2374.         MOV    BX,[USE+2]
  2375.         MOV    CX,[SPBLK+2]
  2376.         MOV    DX,[REC+2]
  2377.         PUSH    SI
  2378.         PUSH    BP
  2379.         INT    38        ;BIOS disk write function
  2380.         JNC    WRTOK
  2381.         XOR    AH,AH        ;return negative error code
  2382.         NEG    AX
  2383.         MOV    [DSKERR+2],AX    ;WRITE ERROR!
  2384. WRTOK:        POPF
  2385.         POP    BP
  2386.         POP    SI
  2387.         JMP    NEXT
  2388. ;
  2389. ;        ( Page 88 )
  2390. ;
  2391.     ALIGN
  2392.         DM    83H,"R/W"
  2393.         DW    BLKWRT - 14
  2394. RSLW:         DW    DOCOL
  2395.         DW    USE,    AT,    TOR
  2396.         DW    TOR
  2397.         DW    SWAP,    USE, STORE
  2398.         DW    SPBLK,    STAR
  2399.         DW    TSCALC
  2400.         DW    FROMR
  2401.         DW    ZBRAN,    RSLW1-$-2
  2402.         DW    BLKRD
  2403.         DW    BRAN,    RSLW2-$-2
  2404. RSLW1:        DW    BLKWRT
  2405. RSLW2:        DW    FROMR,    USE,    STORE
  2406.         DW    DSKERR,    AT,    DDUP
  2407.         DW    ZBRAN,    RSLW5-$-2        ;OK
  2408.         DW    ZLESS
  2409.         DW    ZBRAN,    RSLW3-$-2
  2410.         DW    LIT,    9            ;Write error
  2411.         DW    BRAN,    RSLW4-$-2
  2412. RSLW3:        DW    LIT,    8            ;Read error
  2413. RSLW4:        DW    ZERO,    PREV,    AT,    STORE    ;This  buffer
  2414.                             ; is no good!
  2415.         DW    QERR
  2416. RSLW5:        DW    SEMIS
  2417. ;
  2418. ;        ( Page 89 )
  2419. ;
  2420.         DM    85H,"FLUSH"
  2421.         DW    RSLW - 6
  2422. FLUSH:         DW    DOCOL
  2423.         DW    NOBUF,    ONEP
  2424.         DW    ZERO,    XDO
  2425. FLUS1:         DW    ZERO,    BUFFE,    DROP
  2426.         DW    XLOOP,    FLUS1-$-2
  2427.         DW    SEMIS
  2428. ;
  2429.         DM    84H,"LOAD"
  2430.     ALIGN
  2431.         DW    FLUSH - 8
  2432. LOAD:         DW    DOCOL
  2433.         DW    BLK,    AT,    TOR
  2434.         DW    INN,    AT,    TOR
  2435.         DW    ZERO,    INN,    STORE
  2436.         DW    BSCR,    STAR,    BLK,    STORE
  2437.         DW    INTER
  2438.         DW    FROMR,    INN,    STORE
  2439.         DW    FROMR,    BLK,    STORE
  2440.         DW    SEMIS
  2441. ;
  2442. ;        ( Page 90 )
  2443. ;
  2444.         DM    0C3H,"-->"
  2445.         DW    LOAD - 8
  2446. ARROW:         DW    DOCOL
  2447.         DW    QLOAD
  2448.         DW    ZERO,    INN,    STORE
  2449.         DW    BSCR,    BLK,    AT
  2450.         DW    OVER,    MODD,    SUBB
  2451.         DW    BLK,    PSTOR,    SEMIS
  2452. ;
  2453. ;        ( Page 91 )
  2454. ;
  2455. ;****************************************
  2456. ;*                    *
  2457. ;*    i/o primitives :        *
  2458. ;*                    *
  2459. ;*    PQTER, PKEY, PEMIT, PCR,    *
  2460. ;*    CONOUT, LSTOUT            *
  2461. ;*                    *
  2462. ;****************************************
  2463. ;
  2464. REQUEST        EQU    33        ;BIOS function request intr.
  2465. CONOUT        EQU    2        ;BIOS console output function
  2466. LSTOUT        EQU    5        ;BIOS printer output function
  2467. CONIO        EQU    8        ;BIOS console i/o fctn, no echo
  2468. CONSTAT        EQU    11        ;BIOS console status check fctn
  2469. ;
  2470. ACTRLC        EQU    3        ;ASCII ^C
  2471. ;
  2472. PQTER:         MOV    AH,CONSTAT
  2473.         INT    REQUEST
  2474.         SUB    AH,AH
  2475.         JMP    APUSH
  2476. ;
  2477. PKEY:        MOV    DX,0FFH
  2478.         MOV    AH,CONIO
  2479.         INT    REQUEST
  2480.         OR    AL,AL
  2481.         JZ    PKEY
  2482.         AND    AX,7FH
  2483.         CMP    AL,ACTRLC    ;check for ^C
  2484.         JNZ    PKEY1        ;pass anything else
  2485.         INT    35        ;Force ^C interrupt 
  2486. PKEY1:        JMP    APUSH
  2487. ;
  2488. PEMIT:         DW    $ + 2
  2489.         POP    DX
  2490.         CALL    POUT
  2491.         JMP    NEXT
  2492. ;
  2493. ;        ( Page 92 )
  2494. ;
  2495. PCR:         MOV    DX,ACR
  2496.         CALL    POUT
  2497.         MOV    DX,LF
  2498.         CALL    POUT
  2499.         JMP    NEXT
  2500. ;
  2501. POUT:         AND    DX,7FH
  2502.         MOV    AH,CONOUT
  2503.         INT    REQUEST
  2504.         MOV    BX,[ PRTER+2 ]    ;Check echo flag
  2505.         OR    BX,BX
  2506.         JZ    RET
  2507.         MOV    AH,LSTOUT
  2508.         INT    REQUEST        ;Echo to printer
  2509.         RET
  2510. ;
  2511. ;********************************************************
  2512. ;*                            *
  2513. ;*        TIME@, TIME!, DATE@, DATE!        *
  2514. ;*                            *
  2515. ;********************************************************
  2516. ;
  2517.     ALIGN
  2518.         DM    85H,"TIME@"
  2519.         DW    ARROW - 6
  2520. TIMAT:        DW    $ + 2
  2521.         MOV    AH,2CH        ;Get time
  2522.         INT    REQUEST
  2523.         PUSH    DX        ;[sec sec/100]
  2524.         PUSH    CX        ;[hr min]
  2525.         JMP    NEXT
  2526. ;
  2527.     ALIGN
  2528.         DM    85H,"TIME!"
  2529.         DW    TIMAT - 8
  2530. TIMST:        DW    $ + 2
  2531.         POP    CX        ;[hr min]
  2532.         POP    DX        ;[sec sec/100]
  2533.         MOV    AH,2DH
  2534.         INT    REQUEST
  2535.         JMP    NEXT
  2536. ;
  2537.     ALIGN
  2538.         DM    85H,"DATE@"
  2539.         DW    TIMST - 8
  2540. DATAT:        DW    $ + 2
  2541.         MOV    AH,2AH
  2542.         INT    REQUEST
  2543.         PUSH    CX        ;year
  2544.         MOV    AL,DH        ;month
  2545.         XOR    AH,AH
  2546.         XOR    DH,DH
  2547.         JMP    DPUSH        ;DL=day
  2548. ;
  2549.     ALIGN
  2550.         DM    85H,"DATE!"
  2551.         DW    DATAT - 8
  2552. DATST:        DW    $ + 2
  2553.         POP    CX        ;year
  2554.         POP    DX        ;DL=day
  2555.         POP    AX
  2556.         MOV    DH,AL        ;DH=month
  2557.         MOV    AH,2BH
  2558.         INT    REQUEST
  2559.         JMP    NEXT
  2560. ;
  2561. ;        ( Page 93 )
  2562. ;        ( Page 94 )
  2563. ;
  2564. EXIT:         INT    32
  2565. ;
  2566. ;        ( Page 96 )
  2567. ;        ( Page 98 )
  2568. ;
  2569.     ALIGN
  2570.         DM    0C1H,"'"
  2571.         DW    DATST - 8
  2572. TICK:         DW    DOCOL
  2573.         DW    DFIND,    ZEQU
  2574.         DW    ZERO,    QERR
  2575.         DW    DROP,    LITER,    SEMIS
  2576. ;
  2577.         DM    86H,"FORGET"
  2578.     ALIGN
  2579.         DW    TICK - 4
  2580. FORG:         DW    DOCOL
  2581.         DW    CURR,    AT
  2582.         DW    CONT,    AT
  2583.         DW    SUBB
  2584.         DW    LIT,    24,    QERR
  2585.         DW    TICK,    DUP
  2586.         DW    FENCE,    AT,    LESS
  2587.         DW    LIT,    21,    QERR
  2588.         DW    DUP
  2589.         DW    NFA,    DP,    STORE
  2590.         DW    LFA,    AT
  2591.         DW    CONT,    AT,    STORE,    SEMIS
  2592. ;
  2593. ;        ( Page 99 )
  2594. ;
  2595.         DM    84H,"BACK"
  2596.     ALIGN
  2597.         DW    FORG - 10
  2598. BACK:         DW    DOCOL
  2599.         DW    HERE,    SUBB
  2600.         DW    COMMA,    SEMIS
  2601. ;
  2602.         DM    0C5H,"BEGIN"
  2603.         DW    BACK - 8
  2604. BEGIN:         DW    DOCOL
  2605.         DW    QCOMP
  2606.         DW    HERE,    ONE,    SEMIS
  2607. ;
  2608.         DM    0C5H,"ENDIF"
  2609.         DW    BEGIN - 8
  2610. ENDIFF:     DW    DOCOL
  2611.         DW    QCOMP
  2612.         DW    TWO,    QPAIR
  2613.         DW    HERE,    OVER,    SUBB
  2614.         DW    SWAP,    STORE,    SEMIS
  2615. ;
  2616. ;        ( Page 100 )
  2617. ;
  2618.         DM    0C4H,"THEN"
  2619.     ALIGN
  2620.         DW    ENDIFF - 8
  2621. THEN:         DW    DOCOL
  2622.         DW    ENDIFF,    SEMIS
  2623. ;
  2624.         DM    0C2H,"DO"
  2625.     ALIGN
  2626.         DW    THEN - 8
  2627. DO:         DW    DOCOL
  2628.         DW    COMP,    XDO
  2629.         DW    HERE,    THREE,    SEMIS
  2630. ;
  2631.         DM    0C4H,"LOOP"
  2632.     ALIGN
  2633.         DW    DO - 6
  2634. LOOPC:         DW    DOCOL
  2635.         DW    THREE,    QPAIR
  2636.         DW    COMP,    XLOOP
  2637.         DW    BACK,    SEMIS
  2638. ;
  2639. ;        ( Page 101 )
  2640. ;
  2641.         DM    0C5H,"+LOOP"
  2642.         DW    LOOPC - 8
  2643. PLOOP:         DW    DOCOL
  2644.         DW    THREE,    QPAIR
  2645.         DW    COMP,    XPLOO
  2646.         DW    BACK,    SEMIS
  2647. ;
  2648.         DM    0C5H,"UNTIL"
  2649.         DW    PLOOP - 8
  2650. UNTIL:         DW    DOCOL
  2651.         DW    ONE,    QPAIR
  2652.         DW    COMP,    ZBRAN
  2653.         DW    BACK,    SEMIS
  2654. ;
  2655.         DM    0C3H,"END"
  2656.         DW    UNTIL - 8
  2657. ENDD:         DW    DOCOL
  2658.         DW    UNTIL,    SEMIS
  2659. ;
  2660. ;        ( Page 102 )
  2661. ;
  2662.         DM    0C5H,"AGAIN"
  2663.         DW    ENDD - 6
  2664. AGAIN:         DW    DOCOL
  2665.         DW    ONE,    QPAIR
  2666.         DW    COMP,    BRAN
  2667.         DW    BACK,    SEMIS
  2668. ;
  2669.         DM    0C6H,"REPEAT"
  2670.     ALIGN
  2671.         DW    AGAIN - 8
  2672. REPEA:         DW    DOCOL
  2673.         DW    TOR,    TOR
  2674.         DW    AGAIN
  2675.         DW    FROMR,    FROMR
  2676.         DW    TWO,    SUBB
  2677.         DW    ENDIFF,    SEMIS
  2678. ;
  2679.         DM    0C2H,"IF"
  2680.     ALIGN
  2681.         DW    REPEA - 10
  2682. IFF:         DW    DOCOL
  2683.         DW    COMP,    ZBRAN
  2684.         DW    HERE,    ZERO,    COMMA
  2685.         DW    TWO,    SEMIS
  2686. ;
  2687. ;        ( Page 103 )
  2688. ;
  2689.         DM    0C4H,"ELSE"
  2690.     ALIGN
  2691.         DW    IFF - 6
  2692. ELSEE:         DW    DOCOL
  2693.         DW    TWO,    QPAIR
  2694.         DW    COMP,    BRAN
  2695.         DW    HERE,    ZERO,    COMMA
  2696.         DW    SWAP
  2697.         DW    TWO,    ENDIFF,    TWO
  2698.         DW    SEMIS
  2699. ;
  2700.         DM    0C5H,"WHILE"
  2701.         DW    ELSEE - 8
  2702. WHILE:         DW    DOCOL
  2703.         DW    IFF,    TWOP,    SEMIS
  2704. ;
  2705. ;        ( Page 104 )
  2706. ;
  2707.         DM    86H,"SPACES"
  2708.     ALIGN
  2709.         DW    WHILE - 8
  2710. SPACS:         DW    DOCOL
  2711.         DW    ZERO,    MAX
  2712.         DW    DDUP
  2713.         DW    ZBRAN,    SPAX1-$-2
  2714.         DW    ZERO,    XDO
  2715. SPAX2:         DW    SPACE
  2716.         DW    XLOOP,    SPAX2-$-2
  2717. SPAX1:         DW    SEMIS
  2718. ;
  2719.         DM    82H,"<#"
  2720.     ALIGN
  2721.         DW    SPACS - 10
  2722. BDIGS:         DW    DOCOL
  2723.         DW    PAD,    HLD,    STORE
  2724.         DW    SEMIS
  2725. ;
  2726.         DM    82H,"#>"
  2727.     ALIGN
  2728.         DW    BDIGS - 6
  2729. EDIGS:         DW    DOCOL
  2730.         DW    DROP,    DROP
  2731.         DW    HLD,    AT
  2732.         DW    PAD
  2733.         DW    OVER,    SUBB,    SEMIS
  2734. ;
  2735. ;        ( Page 105 )
  2736. ;
  2737.         DM    84H,"SIGN"
  2738.     ALIGN
  2739.         DW    EDIGS - 6
  2740. SIGN:         DW    DOCOL
  2741.         DW    ROT,    ZLESS
  2742.         DW    ZBRAN,    SIGN1-$-2
  2743.         DW    LIT,    '-',    HOLD
  2744. SIGN1:         DW    SEMIS
  2745. ;
  2746.         DM    81H,"#"
  2747.         DW    SIGN - 8
  2748. DIG:         DW    DOCOL
  2749.         DW    BASE,    AT,    MSMOD
  2750.         DW    ROT
  2751.         DW    LIT,    9
  2752.         DW    OVER,    LESS
  2753.         DW    ZBRAN,    DIG1-$-2
  2754.         DW    LIT,    7,    PLUS
  2755. DIG1:         DW    LIT,    '0',    PLUS
  2756.         DW    HOLD,    SEMIS
  2757. ;
  2758.         DM    82H,"#S"
  2759.     ALIGN
  2760.         DW    DIG - 4
  2761. DIGS:         DW    DOCOL
  2762. DIGS1:         DW    DIG
  2763.         DW    OVER,    OVER
  2764.         DW    ORR,    ZEQU
  2765.         DW    ZBRAN,    DIGS1-$-2
  2766.         DW    SEMIS
  2767. ;
  2768. ;        ( Page 106 )
  2769. ;
  2770.         DM    83H,"D.R"
  2771.         DW    DIGS - 6
  2772. DDOTR:         DW    DOCOL
  2773.         DW    TOR,    SWAP,    OVER
  2774.         DW    DABS
  2775.         DW    BDIGS
  2776.         DW    DIGS,    SIGN
  2777.         DW    EDIGS
  2778.         DW    FROMR,    OVER,    SUBB
  2779.         DW    SPACS,    TYPES,    SEMIS
  2780. ;
  2781.         DM    82H,".R"
  2782.     ALIGN
  2783.         DW    DDOTR - 6
  2784. DOTR:         DW    DOCOL
  2785.         DW    TOR
  2786.         DW    STOD,    FROMR,    DDOTR,    SEMIS
  2787. ;
  2788. ;        ( Page 107 )
  2789. ;
  2790.         DM    82H,"D."
  2791.     ALIGN
  2792.         DW    DOTR - 6
  2793. DDOT:         DW    DOCOL
  2794.         DW    ZERO
  2795.         DW    DDOTR,    SPACE,    SEMIS
  2796. ;
  2797.         DM    81H,"."
  2798.         DW    DDOT - 6
  2799. DOT:         DW    DOCOL
  2800.         DW    STOD,    DDOT,    SEMIS
  2801. ;
  2802.         DM    81H,"?"
  2803.         DW    DOT - 4
  2804. QUES:         DW    DOCOL
  2805.         DW    AT,    DOT,    SEMIS
  2806. ;
  2807.         DM    82H,"U."
  2808.     ALIGN
  2809.         DW    QUES - 4
  2810. UDOT:         DW    DOCOL
  2811.         DW    ZERO,    DDOT,    SEMIS
  2812. ;
  2813. ;        ( Page 108 )
  2814. ;
  2815.         DM    85H,"VLIST"
  2816.         DW    UDOT - 6
  2817. VLIST:         DW    DOCOL
  2818.         DW    LIT,    80H
  2819.         DW    OUTT,    STORE
  2820.         DW    CONT,    AT,    AT
  2821. VLIS1:         DW    OUTT,    AT
  2822.         DW    CSLL,    GREAT
  2823.         DW    ZBRAN,    VLIS2-$-2
  2824.         DW    CR
  2825.         DW    ZERO,    OUTT,    STORE
  2826. VLIS2:         DW    DUP
  2827.         DW    IDDOT
  2828.         DW    SPACE,    SPACE
  2829.         DW    PFA,    LFA,    AT
  2830.         DW    DUP,    ZEQU
  2831.         DW    QTERM,    ORR
  2832.         DW    ZBRAN,    VLIS1-$-2
  2833.         DW    DROP,    SEMIS
  2834. ;
  2835.         DM    83H,"BYE"
  2836.         DW    VLIST - 8
  2837. BYE:         DW    $ + 2
  2838.         JMP    EXIT
  2839. ;
  2840. ;        ( Page 109 )
  2841. ;
  2842.     ALIGN
  2843.         DM    84H,"LIST"
  2844.     ALIGN
  2845.         DW    BYE - 6
  2846. LISTC:         DW    DOCOL
  2847.         DW    DECA,    CR
  2848.         DW    DUP,    SCR,    STORE
  2849.         DW    PDOTQ
  2850.         DB    6,"SCR # "
  2851.         DW    DOT
  2852.         DW    LIT,    16,    ZERO,    XDO
  2853. LIST1:         DW    CR,    IDO
  2854.         DW    LIT,    3,    DOTR,    SPACE
  2855.         DW    IDO,    SCR,    AT,    DLINE
  2856.         DW    QTERM
  2857.         DW    ZBRAN,    LIST2-$-2
  2858.         DW    LEAVE
  2859. LIST2:         DW    XLOOP,    LIST1-$-2
  2860.         DW    CR,    SEMIS
  2861. ;
  2862.     ALIGN
  2863.         DM    85H,"INDEX"
  2864.         DW    LISTC - 8
  2865. INDEX:         DW    DOCOL
  2866.         DW    LIT,    FF,    EMIT,    CR
  2867.         DW    ONEP,    SWAP,    XDO
  2868. INDE1:         DW    CR,    IDO
  2869.         DW    LIT,    3,    DOTR,    SPACE
  2870.         DW    ZERO,    IDO,    DLINE
  2871.         DW    QTERM
  2872.         DW    ZBRAN,    INDE2-$-2
  2873.         DW    LEAVE
  2874. INDE2:         DW    XLOOP,    INDE1-$-2
  2875.         DW    SEMIS
  2876. ;
  2877. ;        ( Page 110 )
  2878. ;
  2879.         DM    85H,"TRIAD"
  2880.         DW    INDEX - 8
  2881. TRIAD:         DW    DOCOL
  2882.         DW    LIT,    FF,    EMIT
  2883.         DW    LIT,    3,    SLASH
  2884.         DW    LIT,    3,    STAR
  2885.         DW    LIT,    3,    OVER
  2886.         DW    PLUS,    SWAP,    XDO
  2887. TRIA1:         DW    CR,    IDO,    LISTC
  2888.         DW    QTERM
  2889.         DW    ZBRAN,    TRIA2-$-2
  2890.         DW    LEAVE
  2891. TRIA2:         DW    XLOOP,    TRIA1-$-2
  2892.         DW    CR
  2893.         DW    LIT,    15,    MESS,    CR
  2894.         DW    SEMIS
  2895. ;
  2896.         DM    84H,".CPU"
  2897.     ALIGN
  2898.         DW    TRIAD - 8
  2899. DOTCPU:     DW    DOCOL
  2900.         DW    BASE,    AT
  2901.         DW    LIT,    36,    BASE,    STORE
  2902.         DW    LIT,    22H,    PORIG,    TAT
  2903.         DW    DDOT
  2904.         DW    BASE,    STORE,    SEMIS
  2905. ;
  2906. ;        ( Page 111 )
  2907. ;
  2908.         DM    85H,"MATCH"
  2909.         DW    DOTCPU - 8
  2910. MATCH:         DW    $ + 2
  2911.         MOV    DI,SI
  2912.         POP    CX
  2913.         POP    BX
  2914.         POP    DX
  2915.         POP    SI
  2916.         PUSH    SI
  2917. MAT1:         LODB
  2918.         CMP    AL,[BX]
  2919.         JNZ    MAT3
  2920.         PUSH    BX
  2921.         PUSH    CX
  2922.         PUSH    SI
  2923. MAT2:         DEC    CX
  2924.         JZ    MATCHOK
  2925.         DEC    DX
  2926.         JZ    NOMATCH
  2927.         INC    BX
  2928.         LODB
  2929.         CMP    AL,[BX]
  2930.         JZ    MAT2
  2931.         POP    SI
  2932.         POP    CX
  2933.         POP    BX
  2934. MAT3:         DEC    DX
  2935.         JNZ    MAT1
  2936.         JMP    MAT4
  2937. MATCHOK:
  2938. NOMATCH:     POP    CX
  2939.         POP    CX
  2940.         POP    CX
  2941. MAT4:         MOV    AX,SI
  2942.         POP    SI
  2943.         SUB    AX,SI
  2944.         MOV    SI,DI
  2945.         JMP    DPUSH
  2946. ;
  2947. ;        ( Page 113 )
  2948. ;
  2949.     ALIGN
  2950.         DM    84H,"TASK"
  2951.     ALIGN
  2952.         DW    MATCH - 8
  2953. TASK:         DW    DOCOL
  2954.         DW    SEMIS
  2955. ;
  2956. INITDP        EQU    $
  2957.