home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / forth / fig86.arc / FORTH.ASM next >
Encoding:
Assembly Source File  |  1982-11-20  |  44.1 KB  |  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.  
  1024.         DM    87H,"+ORIGIN"
  1025.         DW    BSCR - 8
  1026. PORIG:         DW    DOCOL
  1027.         DW    LIT,    ORIG
  1028.         DW    PLUS,    SEMIS
  1029. ;
  1030. ;        ( Page 31 )
  1031. ;
  1032.         DM    82H,"S0"
  1033.     ALIGN
  1034.         DW    PORIG - 10
  1035. SZERO:         DW    DOUSE
  1036.         DW    6
  1037. ;
  1038.         DM    82H,"R0"
  1039.     ALIGN
  1040.         DW    SZERO - 6
  1041. RZERO:         DW    DOUSE
  1042.         DW    8
  1043. ;
  1044.         DM    83H,"TIB"
  1045.         DW    RZERO - 6
  1046. TIB:         DW    DOUSE
  1047.         DW    10
  1048. ;
  1049.         DM    85H,"WIDTH"
  1050.         DW    TIB - 6
  1051. WIDTH:         DW    DOUSE
  1052.         DW    12
  1053. ;
  1054.         DM    87H,"WARNING"
  1055.         DW    WIDTH - 8
  1056. WARN:         DW    DOUSE
  1057.         DW    14
  1058. ;
  1059. ;        ( Page 32 )
  1060. ;
  1061.         DM    85H,"FENCE"
  1062.         DW    WARN - 10
  1063. FENCE:         DW    DOUSE
  1064.         DW    16
  1065. ;
  1066.         DM    82H,"DP"
  1067.     ALIGN
  1068.         DW    FENCE - 8
  1069. DP:         DW    DOUSE
  1070.         DW    18
  1071. ;
  1072.         DM    88H,"VOC-LINK"
  1073.     ALIGN
  1074.         DW    DP - 6
  1075. VOCL:         DW    DOUSE
  1076.         DW    20
  1077. ;
  1078.         DM    83H,"BLK"
  1079.         DW    VOCL - 12
  1080. BLK:         DW    DOUSE
  1081.         DW    22
  1082. ;
  1083. ;        ( Page 33 )
  1084. ;
  1085.         DM    82H,"IN"
  1086.     ALIGN
  1087.         DW    BLK - 6
  1088. INN:         DW    DOUSE
  1089.         DW    24
  1090. ;
  1091.         DM    83H,"OUT"
  1092.         DW    INN - 6
  1093. OUTT:         DW    DOUSE
  1094.         DW    26
  1095. ;
  1096.         DM    83H,"SCR"
  1097.         DW    OUTT - 6
  1098. SCR:         DW    DOUSE
  1099.         DW    28
  1100. ;
  1101.         DM    86H,"OFFSET"
  1102.     ALIGN
  1103.         DW    SCR - 6
  1104. OFSET:         DW    DOUSE
  1105.         DW    30
  1106. ;
  1107.         DM    87H,"CONTEXT"
  1108.         DW    OFSET - 10
  1109. CONT:         DW    DOUSE
  1110.         DW    32
  1111. ;
  1112.         DM    87H,"CURRENT"
  1113.         DW    CONT - 10
  1114. CURR:         DW    DOUSE
  1115.         DW    34
  1116. ;
  1117.         DM    85H,"STATE"
  1118.         DW    CURR - 10
  1119. STATE:         DW    DOUSE
  1120.         DW    36
  1121. ;
  1122.         DM    84H,"BASE"
  1123.     ALIGN
  1124.         DW    STATE - 8
  1125. BASE:         DW    DOUSE
  1126.         DW    38
  1127. ;
  1128.         DM    83H,"DPL"
  1129.         DW    BASE - 8
  1130. DPL:         DW    DOUSE
  1131.         DW    40
  1132. ;
  1133.         DM    83H,"FLD"
  1134.         DW    DPL - 6
  1135. FLD:         DW    DOUSE
  1136.         DW    42
  1137. ;
  1138. ;        ( Page 35 )
  1139. ;
  1140.         DM    83H,"CSP"
  1141.         DW    FLD - 6
  1142. CSPP:         DW    DOUSE
  1143.         DW    44
  1144. ;
  1145.         DM    82H,"R#"
  1146.     ALIGN
  1147.         DW    CSPP - 6
  1148. RNUM:         DW    DOUSE
  1149.         DW    46
  1150. ;
  1151.         DM    83H,"HLD"
  1152.         DW    RNUM - 6
  1153. HLD:         DW    DOUSE
  1154.         DW    48
  1155. ;
  1156. ;        ( Page 36 )
  1157. ;
  1158.         DM    82H,"1+"
  1159.     ALIGN
  1160.         DW    HLD - 6
  1161. ONEP:         DW    $ + 2
  1162.         POP    AX
  1163.         INC    AX
  1164.         JMP    APUSH
  1165. ;
  1166.     ALIGN
  1167.         DM    82H,"2+"
  1168.     ALIGN
  1169.         DW    ONEP - 6
  1170. TWOP:         DW    $ + 2
  1171.         POP    AX
  1172.         INC    AX
  1173.         INC    AX
  1174.         JMP    APUSH
  1175. ;
  1176.     ALIGN
  1177.         DM    82H,"1-"
  1178.     ALIGN
  1179.         DW    TWOP - 6
  1180. ONEM:        DW    $ + 2
  1181.         POP    AX
  1182.         DEC    AX
  1183.         JMP    APUSH
  1184.     ALIGN
  1185.         DM    82H,"2-"
  1186.     ALIGN
  1187.         DW    ONEM - 6
  1188. TWOM:        DW    $ + 2
  1189.         POP    AX
  1190.         DEC    AX
  1191.         DEC    AX
  1192.         JMP    APUSH
  1193.     ALIGN
  1194.         DM    84H,"HERE"
  1195.     ALIGN
  1196.         DW    TWOM - 6
  1197. HERE:         DW    DOCOL
  1198.         DW    DP,    AT,    SEMIS
  1199. ;
  1200.         DM    85H,"ALLOT"
  1201.         DW    HERE - 8
  1202. ALLOT:         DW    DOCOL
  1203.         DW    DP,    PSTOR,    SEMIS
  1204. ;
  1205. ;        ( Page 37 )
  1206. ;
  1207.         DM    81H,","
  1208.         DW    ALLOT - 8
  1209. COMMA:         DW    DOCOL
  1210.         DW    HERE,    STORE
  1211.         DW    TWO,    ALLOT,    SEMIS
  1212. ;
  1213.         DM    82H,"C,"
  1214.     ALIGN
  1215.         DW    COMMA - 4
  1216. CCOMM:         DW    DOCOL
  1217.         DW    HERE,    CSTOR
  1218.         DW    ONE,    ALLOT,    SEMIS
  1219. ;
  1220.         DM    81H,"-"
  1221.         DW    CCOMM - 6
  1222. SUBB:         DW    $ + 2
  1223.         POP    DX
  1224.         POP    AX
  1225.         SUB    AX,DX
  1226.         JMP    APUSH
  1227. ;
  1228. ;        ( Page 38 )
  1229. ;
  1230.     ALIGN
  1231.         DM    81H,"="
  1232.         DW    SUBB - 4
  1233. EQUAL:         DW    DOCOL
  1234.         DW    SUBB,    ZEQU,    SEMIS
  1235. ;
  1236.         DM    81H,"<"
  1237.         DW    EQUAL - 4
  1238. LESS:         DW    $ + 2
  1239.         POP    DX
  1240.         POP    AX
  1241.         MOV    BX,DX
  1242.         XOR    BX,AX
  1243.         JS    LES1
  1244.         SUB    AX,DX
  1245. LES1:         OR    AX,AX
  1246.         MOV    AX,0
  1247.         JNS    LES2
  1248.         INC    AX
  1249. LES2:         JMP    APUSH
  1250. ;
  1251.     ALIGN
  1252.         DM    82H,"U<"
  1253.     ALIGN
  1254.         DW    LESS - 4
  1255. ULESS:         DW    DOCOL
  1256.         DW    TDUP,    XORR,    ZLESS
  1257.         DW    ZBRAN,    ULES1-$-2
  1258.         DW    DROP,    ZLESS,    ZEQU
  1259.         DW    BRAN,    ULES2-$-2
  1260. ULES1:         DW    SUBB,    ZLESS
  1261. ULES2:         DW    SEMIS
  1262. ;
  1263. ;        ( Page 39 )
  1264. ;
  1265.         DM    81H,">"
  1266.         DW    ULESS - 6
  1267. GREAT:         DW    DOCOL
  1268.         DW    SWAP,    LESS,    SEMIS
  1269. ;
  1270.         DM    83H,"ROT"
  1271.         DW    GREAT - 4
  1272. ROT:         DW    $ + 2
  1273.         POP    DX
  1274.         POP    BX
  1275.         POP    AX
  1276.         PUSH    BX
  1277.         JMP    DPUSH
  1278. ;
  1279.     ALIGN
  1280.         DM    85H,"SPACE"
  1281.         DW    ROT - 6
  1282. SPACE:         DW    DOCOL
  1283.         DW    BLS,    EMIT,    SEMIS
  1284. ;
  1285.         DM    84H,"-DUP"
  1286.     ALIGN
  1287.         DW    SPACE - 8
  1288. DDUP:         DW    DOCOL
  1289.         DW    DUP
  1290.         DW    ZBRAN,    DDUP1-$-2
  1291.         DW    DUP
  1292. DDUP1:         DW    SEMIS
  1293. ;
  1294. ;        ( Page 40 )
  1295. ;
  1296.         DM    88H,"TRAVERSE"
  1297.     ALIGN
  1298.         DW    DDUP - 8
  1299. TRAV:         DW    DOCOL
  1300.         DW    SWAP
  1301. TRAV1:         DW    OVER,    PLUS
  1302.         DW    LIT,    7FH
  1303.         DW    OVER,    CAT,    LESS
  1304.         DW    ZBRAN,    TRAV1-$-2
  1305.         DW    SWAP,    DROP,    SEMIS
  1306. ;
  1307.         DM    86H,"LATEST"
  1308.     ALIGN
  1309.         DW    TRAV - 12
  1310. LATES:         DW    DOCOL
  1311.         DW    CURR,    AT,    AT,    SEMIS
  1312. ;
  1313.         DM    83H,"LFA"
  1314.         DW    LATES - 10
  1315. LFA:         DW    DOCOL
  1316.         DW    LIT,    4
  1317.         DW    SUBB,    SEMIS
  1318. ;
  1319. ;        ( Page 41 )
  1320. ;
  1321.         DM    83H,"CFA"
  1322.         DW    LFA - 6
  1323. CFA:         DW    DOCOL
  1324.         DW    TWO,    SUBB,    SEMIS
  1325. ;
  1326.         DM    83H,"NFA"
  1327.         DW    CFA - 6
  1328. NFA:         DW    DOCOL
  1329.         DW    LIT,    5        ;Could be 5 or 6
  1330.         DW    SUBB
  1331.         DW    DUP,    CAT
  1332.         DW    LIT,    80H,    ANDD,    ZEQU
  1333.         DW    ZBRAN,    NFA1-$-2    ;MSB set, OK
  1334.         DW    ONEM            ;MSB not set, adjust
  1335. NFA1:        DW    LIT,    -1
  1336.         DW    TRAV,    SEMIS
  1337. ;
  1338.         DM    83H,"PFA"
  1339.         DW    NFA - 6
  1340. PFA:         DW    $ + 2
  1341.         POP    BX        ;BX:=NFA
  1342.         MOV    AL,[BX]        ;AL:=count
  1343.         AND    AL,1FH        ;Only lowest 5 bits
  1344.         ADD    AL,6
  1345.         SUB    AH,AH
  1346.         ADD    BX,AX        ;BX:=NFA+count+6
  1347.         AND    BX,0FFFEH    ;Clear LSB to align
  1348.         MOV    AX,BX
  1349.         JMP    APUSH        ;Save PFA
  1350. ;
  1351. ;        ( Page 42 )
  1352. ;
  1353.     ALIGN
  1354.         DM    84H,"!CSP"
  1355.     ALIGN
  1356.         DW    PFA - 6
  1357. SCSP:         DW    DOCOL
  1358.         DW    SPAT,    CSPP
  1359.         DW    STORE,    SEMIS
  1360. ;
  1361.         DM    86H,"?ERROR"
  1362.     ALIGN
  1363.         DW    SCSP - 8
  1364. QERR:         DW    DOCOL
  1365.         DW    SWAP
  1366.         DW    ZBRAN,    QERR1-$-2
  1367.         DW    ERROR
  1368.         DW    BRAN,    QERR2-$-2
  1369. QERR1:         DW    DROP
  1370. QERR2:         DW    SEMIS
  1371. ;
  1372.         DM    85H,"?COMP"
  1373.         DW    QERR - 10
  1374. QCOMP:         DW    DOCOL
  1375.         DW    STATE,    AT
  1376.         DW    ZEQU,    LIT,    17
  1377.         DW    QERR,    SEMIS
  1378. ;
  1379. ;        ( Page 43 )
  1380. ;
  1381.         DM    85H,"?EXEC"
  1382.         DW    QCOMP - 8
  1383. QEXEC:         DW    DOCOL
  1384.         DW    STATE,    AT
  1385.         DW    LIT,    18
  1386.         DW    QERR,    SEMIS
  1387. ;
  1388.         DM    86H,"?PAIRS"
  1389.     ALIGN
  1390.         DW    QEXEC - 8
  1391. QPAIR:         DW    DOCOL
  1392.         DW    SUBB
  1393.         DW    LIT,    19
  1394.         DW    QERR,    SEMIS
  1395. ;
  1396.         DM    84H,"?CSP"
  1397.     ALIGN
  1398.         DW    QPAIR - 10
  1399. QCSP:         DW    DOCOL
  1400.         DW    SPAT,    CSPP,    AT,    SUBB
  1401.         DW    LIT,    20
  1402.         DW    QERR,    SEMIS
  1403. ;
  1404.         DM    88H,"?LOADING"
  1405.     ALIGN
  1406.         DW    QCSP - 8
  1407. QLOAD:         DW    DOCOL
  1408.         DW    BLK,    AT,    ZEQU
  1409.         DW    LIT,    22
  1410.         DW    QERR,    SEMIS
  1411. ;
  1412. ;        ( Page 45 )
  1413. ;
  1414.         DM    87H,"COMPILE"
  1415.         DW    QLOAD - 12
  1416. COMP:         DW    DOCOL
  1417.         DW    QCOMP
  1418.         DW    FROMR,    DUP,    TWOP,    TOR
  1419.         DW    AT,    COMMA,    SEMIS
  1420. ;
  1421.         DM    0C1H,"["
  1422.         DW    COMP - 10
  1423. LBRAC:         DW    DOCOL
  1424.         DW    ZERO,    STATE,    STORE,    SEMIS
  1425. ;
  1426.         DM    81H,"]"
  1427.         DW    LBRAC - 4
  1428. RBRAC:         DW    DOCOL
  1429.         DW    LIT,    0C0H
  1430.         DW    STATE,    STORE,    SEMIS
  1431. ;
  1432. ;        ( Page 46 )
  1433. ;
  1434.         DM    86H,"SMUDGE"
  1435.     ALIGN
  1436.         DW    RBRAC - 4
  1437. SMUDG:         DW    DOCOL
  1438.         DW    LATES
  1439.         DW    LIT,    20H
  1440.         DW    TOGGL,    SEMIS
  1441. ;
  1442.         DM    83H,"HEX"
  1443.         DW    SMUDG - 10
  1444. HEX:         DW    DOCOL
  1445.         DW    LIT,    16
  1446.         DW    BASE,    STORE,    SEMIS
  1447. ;
  1448.         DM    87H,"DECIMAL"
  1449.         DW    HEX - 6
  1450. DECA:         DW    DOCOL
  1451.         DW    LIT,    10
  1452.         DW    BASE,    STORE,    SEMIS
  1453. ;
  1454. ;        ( Page 47 )
  1455. ;
  1456.         DM    87H,"(;CODE)"
  1457.         DW    DECA - 10
  1458. PSCOD:         DW    DOCOL
  1459.         DW    FROMR,    LATES,    PFA
  1460.         DW    CFA,    STORE,    SEMIS
  1461. ;
  1462.         DM    0C5H,";CODE"
  1463.         DW    PSCOD - 10
  1464. SEMIC:         DW    DOCOL
  1465.         DW    QCSP
  1466.         DW    COMP,    PSCOD,    LBRAC
  1467. SEMI1        DW    NOOP
  1468.         DW    SEMIS
  1469. ;
  1470.         DM    87H,"<BUILDS"
  1471.         DW    SEMIC - 8
  1472. BUILD:         DW    DOCOL
  1473.         DW    ZERO,    CON,    SEMIS
  1474. ;
  1475.         DM    85H,"DOES>"
  1476.         DW    BUILD - 10
  1477. DOES:         DW    DOCOL
  1478.         DW    FROMR,    LATES,    PFA,    STORE
  1479.         DW    PSCOD
  1480. DODOE:         XCHG    BP,SP
  1481.         PUSH    SI
  1482.         XCHG    BP,SP
  1483.         INC    DX
  1484.         MOV    BX,DX
  1485.         MOV    SI,[BX]
  1486.         INC    DX
  1487.         INC    DX
  1488.         PUSH    DX
  1489.         JMP    NEXT
  1490. ;
  1491. ;        ( Page 48 )
  1492. ;
  1493.     ALIGN
  1494.         DM    85H,"COUNT"
  1495.         DW    DOES - 8
  1496. COUNT:         DW    DOCOL
  1497.         DW    DUP,    ONEP,    SWAP,    CAT,    SEMIS
  1498. ;
  1499.         DM    84H,"TYPE"
  1500.     ALIGN
  1501.         DW    COUNT - 8
  1502. TYPES:         DW    DOCOL
  1503.         DW    DDUP
  1504.         DW    ZBRAN,    TYPE1-$-2
  1505.         DW    OVER,    PLUS
  1506.         DW    SWAP,    XDO
  1507. TYPE2:         DW    IDO,    CAT,    EMIT
  1508.         DW    XLOOP,    TYPE2-$-2
  1509.         DW    BRAN,    TYPE3-$-2
  1510. TYPE1:         DW    DROP
  1511. TYPE3:         DW    SEMIS
  1512. ;
  1513. ;        ( Page 49 )
  1514. ;
  1515.         DM    89H,"-TRAILING"
  1516.         DW    TYPES - 8
  1517. DTRAI:         DW    DOCOL
  1518.         DW    DUP,    ZERO,    XDO
  1519. DTRA1:         DW    OVER,    OVER,    PLUS
  1520.         DW    ONE,    SUBB,    CAT
  1521.         DW    BLS,    SUBB
  1522.         DW    ZBRAN,    DTRA2-$-2
  1523.         DW    LEAVE
  1524.         DW    BRAN,    DTRA3-$-2
  1525. DTRA2:         DW    ONE,    SUBB
  1526. DTRA3:         DW    XLOOP,    DTRA1-$-2
  1527.         DW    SEMIS
  1528. ;
  1529. ;        ( Page 50 )
  1530. ;
  1531.         DM    84H,'(.")'
  1532.     ALIGN
  1533.         DW    DTRAI - 12
  1534. PDOTQ:         DW    DOCOL
  1535.         DW    RR
  1536.         DW    COUNT,    DUP,    ONEP
  1537.         DW    FROMR,    PLUS,    TOR
  1538.         DW    TYPES,    SEMIS
  1539. ;
  1540.         DM    0C2H,'."'
  1541.     ALIGN
  1542.         DW    PDOTQ - 8
  1543. DOTQ:         DW    DOCOL
  1544.         DW    LIT,    '"'
  1545.         DW    STATE,    AT
  1546.         DW    ZBRAN,    DOTQ1-$-2
  1547.         DW    COMP
  1548.         DW    PDOTQ,    WORDS,    HERE
  1549.         DW    CAT,    ONEP,    ALLOT
  1550.         DW    BRAN,    DOTQ2-$-2
  1551. DOTQ1:         DW    WORDS,    HERE,    COUNT,    TYPES
  1552. DOTQ2:         DW    SEMIS
  1553. ;
  1554. ;        ( Page 51 )
  1555. ;
  1556.         DM    86H,"EXPECT"
  1557.     ALIGN
  1558.         DW    DOTQ - 6
  1559. EXPEC:         DW    DOCOL
  1560.         DW    OVER,    PLUS,    OVER
  1561.         DW    XDO
  1562. EXPE1:         DW    KEY,    DUP
  1563.         DW    LIT,    0EH
  1564.         DW    PORIG,    AT,    EQUAL
  1565.         DW    ZBRAN,    EXPE2-$-2
  1566.         DW    DROP,    DUP,    IDO
  1567.         DW    EQUAL,    DUP,    FROMR
  1568.         DW    TWO,    SUBB,    PLUS
  1569.         DW    TOR
  1570.         DW    ZBRAN,    EXPE6-$-2
  1571.         DW    LIT,    BELL
  1572.         DW    BRAN,    EXPE7-$-2
  1573. EXPE6:         DW    LIT,    BSOUT,    EMIT
  1574.         DW    BLS,    EMIT
  1575.         DW    LIT,    BSOUT
  1576. EXPE7:         DW    BRAN,    EXPE3-$-2
  1577. EXPE2:         DW    DUP,    LIT,    ACR
  1578.         DW    EQUAL
  1579.         DW    ZBRAN,    EXPE4-$-2
  1580.         DW    LEAVE,    DROP,    BLS,    ZERO
  1581.         DW    BRAN,    EXPE5-$-2
  1582. EXPE4:         DW    DUP
  1583. EXPE5:         DW    IDO
  1584.         DW    CSTOR,    ZERO,    IDO,    ONEP
  1585.         DW    STORE
  1586. EXPE3:         DW    EMIT
  1587.         DW    XLOOP,    EXPE1-$-2
  1588.         DW    DROP,    SEMIS
  1589. ;
  1590. ;        ( Page 52 )
  1591. ;
  1592.         DM    85H,"QUERY"
  1593.         DW    EXPEC - 10
  1594. QUERY:         DW    DOCOL
  1595.         DW    TIB,    AT
  1596.         DW    LIT,    80,    EXPEC
  1597.         DW    ZERO,    INN,    STORE,    SEMIS
  1598. ;
  1599. ;        ( Page 53 )
  1600. ;
  1601.         DB    0C1H,80H
  1602.         DW    QUERY - 8
  1603. NULL:         DW    DOCOL
  1604.         DW    BLK,    AT
  1605.         DW    ZBRAN,    NULL1-$-2
  1606.         DW    ONE,    BLK,    PSTOR
  1607.         DW    ZERO,    INN,    STORE
  1608.         DW    BLK,    AT
  1609.         DW    BSCR,    ONE,    SUBB,    ANDD
  1610.         DW    ZEQU
  1611.         DW    ZBRAN,    NULL2-$-2
  1612.         DW    QEXEC,    FROMR,    DROP
  1613. NULL2:         DW    BRAN,    NULL3-$-2
  1614. NULL1:         DW    FROMR,    DROP
  1615. NULL3:         DW    SEMIS
  1616. ;
  1617.         DM    84H,"FILL"
  1618.     ALIGN
  1619.         DW    NULL - 4
  1620. FILL:         DW    $ + 2
  1621.         POP    AX
  1622.         POP    CX
  1623.         POP    DI
  1624.         MOV    BX,DS
  1625.         MOV    ES,BX
  1626.         CLD
  1627.         REP
  1628.         STOB
  1629.         JMP    NEXT
  1630. ;
  1631. ;        ( Page 54 )
  1632. ;
  1633.     ALIGN
  1634.         DM    85H,"ERASE"
  1635.         DW    FILL - 8
  1636. ERASEE:     DW    DOCOL
  1637.         DW    ZERO,    FILL,    SEMIS
  1638. ;
  1639.         DM    86H,"BLANKS"
  1640.     ALIGN
  1641.         DW    ERASEE - 8
  1642. BLANK:         DW    DOCOL
  1643.         DW    BLS,    FILL,    SEMIS
  1644. ;
  1645.         DM    84H,"HOLD"
  1646.     ALIGN
  1647.         DW    BLANK - 10
  1648. HOLD:         DW    DOCOL
  1649.         DW    LIT,    -1
  1650.         DW    HLD,    PSTOR
  1651.         DW    HLD,    AT,    CSTOR,    SEMIS
  1652. ;
  1653.         DM    83H,"PAD"
  1654.         DW    HOLD - 8
  1655. PAD:         DW    DOCOL
  1656.         DW    HERE,    LIT,    68,    PLUS,    SEMIS
  1657.         DW    PLUS,    SEMIS
  1658. ;
  1659. ;        ( Page 55 )
  1660. ;
  1661.         DM    84H,"WORD"
  1662.     ALIGN
  1663.         DW    PAD - 6
  1664. WORDS:         DW    DOCOL
  1665.         DW    BLK,    AT
  1666.         DW    ZBRAN,    WORD1-$-2
  1667.         DW    BLK,    AT,    BLOCK
  1668.         DW    BRAN,    WORD2-$-2
  1669. WORD1:         DW    TIB,    AT
  1670. WORD2:         DW    INN,    AT,    PLUS,    SWAP
  1671.         DW    ENCL,    HERE
  1672.         DW    LIT,    34
  1673.         DW    BLANK,    INN,    PSTOR
  1674.         DW    OVER,    SUBB,    TOR
  1675.         DW    RR,    HERE,    CSTOR
  1676.         DW    PLUS,    HERE,    ONEP
  1677.         DW    FROMR,    CMOVE,    SEMIS
  1678. ;
  1679. ;        ( Page 56 )
  1680. ;
  1681.         DM    88H,"(NUMBER)"
  1682.     ALIGN
  1683.         DW    WORDS - 8
  1684. PNUMB:         DW    DOCOL
  1685. PNUM1:         DW    ONEP
  1686.         DW    DUP,    TOR
  1687.         DW    CAT,    BASE,    AT,    DIGIT
  1688.         DW    ZBRAN,    PNUM2-$-2
  1689.         DW    SWAP,    BASE,    AT,    USTAR
  1690.         DW    DROP,    ROT,    BASE,    AT
  1691.         DW    USTAR,    DPLUS
  1692.         DW    DPL,    AT,    ONEP
  1693.         DW    ZBRAN,    PNUM3-$-2
  1694.         DW    ONE,    DPL,    PSTOR
  1695. PNUM3:         DW    FROMR
  1696.         DW    BRAN,    PNUM1-$-2
  1697. PNUM2:         DW    FROMR,    SEMIS
  1698. ;
  1699. ;        ( Page 57 )
  1700. ;
  1701.         DM    86H,"NUMBER"
  1702.     ALIGN
  1703.         DW    PNUMB - 12
  1704. NUMB:         DW    DOCOL
  1705.         DW    ZERO,    ZERO
  1706.         DW    ROT,    DUP,    ONEP,    CAT
  1707.         DW    LIT,    "-",    EQUAL
  1708.         DW    DUP,    TOR,    PLUS
  1709.         DW    LIT,    -1
  1710. NUMB1:         DW    DPL,    STORE
  1711.         DW    PNUMB
  1712.         DW    DUP,    CAT,    BLS,    SUBB
  1713.         DW    ZBRAN,    NUMB2-$-2
  1714.         DW    DUP,    CAT
  1715.         DW    LIT,    ".",    SUBB
  1716.         DW    ZERO,    QERR,    ZERO
  1717.         DW    BRAN,    NUMB1-$-2
  1718. NUMB2:         DW    DROP,    FROMR
  1719.         DW    ZBRAN,    NUMB3-$-2
  1720.         DW    DMINU
  1721.     ALIGN
  1722. NUMB3:         DW    SEMIS
  1723. ;
  1724. ;        ( Page 58 )
  1725. ;
  1726.         DM    85H,"-FIND"
  1727.         DW    NUMB - 10
  1728. DFIND:         DW    DOCOL
  1729.         DW    BLS,    WORDS
  1730.         DW    HERE,    CONT,    AT,    AT
  1731.         DW    PFIND,    DUP,    ZEQU
  1732.         DW    ZBRAN,    DFIN1-$-2
  1733.         DW    DROP
  1734.         DW    HERE,    LATES,    PFIND
  1735. DFIN1:         DW    SEMIS
  1736. ;
  1737.         DM    87H,"(ABORT)"
  1738.         DW    DFIND - 8
  1739. PABOR:         DW    DOCOL
  1740.         DW    ABORT,    SEMIS
  1741. ;
  1742.         DM    85H,"ERROR"
  1743.         DW    PABOR - 10
  1744. ERROR:         DW    DOCOL
  1745.         DW    WARN,    AT,    ZLESS
  1746.         DW    ZBRAN,    ERRO1-$-2
  1747.         DW    PABOR
  1748. ERRO1:         DW    HERE,    COUNT,    TYPES
  1749.         DW    PDOTQ
  1750.         DB    2,"? "
  1751.         DW    MESS
  1752.         DW    SPSTO
  1753.         DW    BLK,    AT,    DDUP
  1754.         DW    ZBRAN,    ERRO2-$-2
  1755.         DW    INN,    AT,    SWAP
  1756. ERRO2:         DW    QUIT
  1757. ;
  1758. ;        ( Page 59 )
  1759. ;
  1760.     ALIGN
  1761.         DM    83H,"ID."
  1762.         DW    ERROR - 8
  1763. IDDOT:         DW    DOCOL
  1764.         DW    PAD
  1765.         DW    LIT,    32
  1766.         DW    LIT,    '_'
  1767.         DW    FILL
  1768.         DW    DUP,    PFA,    LFA
  1769.         DW    OVER,    SUBB
  1770.         DW    PAD,    SWAP,    CMOVE
  1771.         DW    PAD,    COUNT
  1772.         DW    LIT,    1FH
  1773.         DW    ANDD,    TYPES,    SPACE,    SEMIS
  1774. ;
  1775. ;        ( Page 60 )
  1776. ;
  1777.         DM    86H,"CREATE"
  1778.     ALIGN
  1779.         DW    IDDOT - 6
  1780. CREAT:         DW    DOCOL
  1781.         DW    DFIND
  1782.         DW    ZBRAN,    CREA1-$-2
  1783.         DW    DROP,    NFA,    IDDOT
  1784.         DW    LIT,    4,    MESS
  1785.         DW    SPACE
  1786. CREA1:         DW    HERE,    DUP,    CAT
  1787.         DW    WIDTH,    AT,    MIN
  1788.         DW    ONEP,    ALLOT
  1789.         DW    DUP
  1790.         DW    LIT,    0A0H
  1791.         DW    TOGGL
  1792.         DW    HERE,    ONE,    SUBB
  1793.         DW    LIT,    80H
  1794.         DW    TOGGL
  1795. ;
  1796.         DW    DP,    AT
  1797.         DW    ONEP
  1798.         DW    LIT,    0FFFEH,    ANDD
  1799.         DW    DP,    STORE
  1800. ;
  1801.         DW    LATES,    COMMA
  1802.         DW    CURR,    AT,    STORE
  1803.         DW    HERE,    TWOP,    COMMA,    SEMIS
  1804. ;
  1805. ;        ( Page 61 )
  1806. ;
  1807.         DM    0C9H,"[COMPILE]"
  1808.         DW    CREAT - 10
  1809. BCOMP:         DW    DOCOL
  1810.         DW    DFIND
  1811.         DW    ZEQU,    ZERO,    QERR
  1812.         DW    DROP,    CFA,    COMMA,    SEMIS
  1813. ;
  1814.         DM    0C7H,"LITERAL"
  1815.         DW    BCOMP - 12
  1816. LITER:         DW    DOCOL
  1817.         DW    STATE,    AT
  1818.         DW    ZBRAN,    LITE1-$-2
  1819.         DW    COMP,    LIT,    COMMA
  1820. LITE1:         DW    SEMIS
  1821. ;
  1822. ;        ( Page 62 )
  1823. ;
  1824.         DM    0C8H,"DLITERAL"
  1825.     ALIGN
  1826.         DW    LITER - 10
  1827. DLITE:         DW    DOCOL
  1828.         DW    STATE,    AT
  1829.         DW    ZBRAN,    DLIT1-$-2
  1830.         DW    SWAP,    LITER,    LITER
  1831. DLIT1:        DW    SEMIS
  1832. ;
  1833.         DM    86H,"?STACK"
  1834.     ALIGN
  1835.         DW    DLITE-12
  1836. QSTAC:        DW    DOCOL
  1837.         DW    SPAT,    SZERO,    AT
  1838.         DW    SWAP,    ULESS,    ONE,    QERR
  1839.         DW    SPAT,    HERE
  1840.         DW    LIT,    80H
  1841.         DW    PLUS,    ULESS
  1842.         DW    LIT,    7
  1843.         DW    QERR
  1844.         DW    SEMIS
  1845. ;
  1846. ;        ( Page 63 )
  1847. ;
  1848.         DM    89H,"INTERPRET"
  1849.         DW    QSTAC - 10
  1850. INTER:         DW    DOCOL
  1851. INTE1:         DW    DFIND
  1852.         DW    ZBRAN,    INTE2-$-2
  1853.         DW    STATE,     AT,    LESS
  1854.         DW    ZBRAN,    INTE3-$-2
  1855.         DW    CFA,    COMMA
  1856.         DW    BRAN,    INTE4-$-2
  1857. INTE3:         DW    CFA,    EXEC
  1858. INTE4:         DW    QSTAC
  1859.         DW    BRAN,    INTE5-$-2
  1860. INTE2:         DW    HERE,    NUMB,    DPL,    AT,    ONEP
  1861.         DW    ZBRAN,    INTE6-$-2
  1862.         DW    DLITE
  1863.         DW    BRAN,    INTE7-$-2
  1864. INTE6:         DW    DROP,    LITER
  1865. INTE7:        DW    QSTAC
  1866. INTE5:        DW    BRAN,    INTE1-$-2
  1867. ;
  1868. ;        ( Page 64 )
  1869. ;
  1870.         DM    89H,"IMMEDIATE"
  1871.         DW    INTER-12
  1872. IMMED:        DW    DOCOL
  1873.         DW    LATES
  1874.         DW    LIT,    40H
  1875.         DW    TOGGL,    SEMIS
  1876. ;
  1877.         DM    8AH,"VOCABULARY"
  1878.     ALIGN
  1879.         DW    IMMED - 12
  1880. VOCAB:         DW    DOCOL
  1881.         DW    BUILD
  1882.         DW    LIT,    0A081H
  1883.         DW    COMMA
  1884.         DW    CURR,    AT
  1885.         DW    CFA,    COMMA,    HERE,    VOCL
  1886.         DW    AT,    COMMA,    VOCL,    STORE
  1887.         DW    DOES
  1888. DOVOC:         DW    TWOP,    CONT,    STORE,    SEMIS
  1889. ;
  1890. ;        ( Page 65 )
  1891. ;
  1892.         DM    0C5H,"FORTH"
  1893.         DW    VOCAB - 14
  1894. FORTH:         DW    DODOE
  1895.         DW    DOVOC
  1896.         DW    0A081H
  1897.         DW    TASK - 8
  1898.         DW    0
  1899. ;
  1900.         DM    8BH,"DEFINITIONS"
  1901.         DW    FORTH - 8
  1902. DEFIN:         DW    DOCOL
  1903.         DW    CONT,    AT
  1904.         DW    CURR,    STORE,    SEMIS
  1905. ;
  1906.         DM    0C1H,"("
  1907.         DW    DEFIN - 14
  1908. PAREN:         DW    DOCOL
  1909.         DW    LIT,    ')',    WORDS,    SEMIS
  1910. ;
  1911. ;        ( Page 66 )
  1912. ;
  1913.         DM    84H,"QUIT"
  1914.     ALIGN
  1915.         DW    PAREN - 4
  1916. QUIT:         DW    DOCOL
  1917.         DW    ZERO,    BLK,    STORE
  1918.         DW    LBRAC
  1919. QUIT1:         DW    RPSTO,    CR,    QUERY
  1920.         DW    INTER
  1921.         DW    STATE,    AT,    ZEQU
  1922.         DW    ZBRAN,    QUIT2-$-2
  1923.         DW    PDOTQ
  1924.         DB    2,"ok"
  1925. QUIT2:         DW    BRAN,    QUIT1-$-2
  1926. ;
  1927.     ALIGN
  1928.         DM    85H,"ABORT"
  1929.         DW    QUIT - 8
  1930. ABORT:         DW    DOCOL
  1931.         DW    SPSTO,    DECA,    QSTAC,    CR
  1932.         DW    DOTCPU,    PDOTQ
  1933.         DB    16H,'Fig-FORTH  Version '
  1934.         DB    FIGREL+30H, ADOT, FIGREV+30H
  1935.         DW    LIT,    10,    PORIG,    CAT
  1936.         DW    LIT,    41H,    PLUS,    EMIT
  1937.         DW    FORTH,    DEFIN
  1938.         DW    LIT,    0,    PRTER,    STORE    ;Reset echo
  1939.         DW    QUIT
  1940. ;
  1941. ;        ( Page 67 )
  1942. ;
  1943. CTRLC:        
  1944. WRM:         MOV    SI,WRM1
  1945.         JMP    NEXT
  1946. WRM1        DW    PABOR
  1947. ;
  1948.     ALIGN
  1949.         DM    84H,"WARM"
  1950.     ALIGN
  1951.         DW    ABORT - 8
  1952. WARM:         DW    DOCOL
  1953.         DW    MTBUF,    ABORT
  1954. ;
  1955. CLD:         MOV    SI,CLD1
  1956.         MOV    AX,CS
  1957.         MOV    DS,AX
  1958.         MOV    SP,[ ORIG + 12H ]
  1959.         MOV    SS,AX
  1960.         MOV    ES,AX
  1961.         CLD
  1962.         MOV    BP,[RPP]
  1963. ;
  1964.         MOV    AH,37
  1965.         MOV    AL,35
  1966.         MOV    DX,CTRLC
  1967.         INT    33        ;Set ^C exit address
  1968. ;
  1969.         JMP    NEXT
  1970. CLD1:         DW    COLD
  1971. ;
  1972.     ALIGN
  1973.         DM    84H,"COLD"
  1974.     ALIGN
  1975.         DW    WARM - 8
  1976. COLD:         DW    DOCOL
  1977.         DW    MTBUF
  1978.         DW    ZERO,    DENSTY,    STORE
  1979.         DW    FIRST,    USE,    STORE
  1980.         DW    FIRST,    PREV,    STORE
  1981.         DW    DRZER
  1982.         DW    LIT,    ORIG+12H
  1983.         DW    LIT,    UP,    AT
  1984.         DW    LIT,    6,    PLUS
  1985.         DW    LIT,    16,    CMOVE
  1986.         DW    LIT,    ORIG+12,AT
  1987.         DW    LIT,    FORTH+6,STORE
  1988.         DW    LIT,    4,    SCR,    STORE
  1989.         DW    ABORT
  1990. ;
  1991. ;        ( Page 69 )
  1992. ;
  1993.         DM    84H,"S->D"
  1994.     ALIGN
  1995.         DW    COLD - 8
  1996. STOD:         DW    $ + 2
  1997.         POP    DX
  1998.         SUB    AX,AX
  1999.         OR    DX,DX
  2000.         JNS    STOD1
  2001.         DEC    AX
  2002. STOD1:         JMP    DPUSH
  2003. ;
  2004.     ALIGN
  2005.         DM    82H,"+-"
  2006.     ALIGN
  2007.         DW    STOD - 8
  2008. PM:         DW    DOCOL
  2009.         DW    ZLESS
  2010.         DW    ZBRAN,    PM1-$-2
  2011.         DW    MINUS
  2012. PM1:         DW    SEMIS
  2013. ;
  2014.         DM    83H,"D+-"
  2015.         DW    PM - 6
  2016. DPM:         DW    DOCOL
  2017.         DW    ZLESS
  2018.         DW    ZBRAN,    DPM1-$-2
  2019.         DW    DMINU
  2020. DPM1:         DW    SEMIS
  2021. ;
  2022.         DM    83H,"ABS"
  2023.         DW    DPM - 6
  2024. ABS:         DW    DOCOL
  2025.         DW    DUP,    PM,    SEMIS
  2026. ;
  2027. ;        ( Page 70 )
  2028. ;
  2029.         DM    84H,"DABS"
  2030.     ALIGN
  2031.         DW    ABS - 6
  2032. DABS:         DW    DOCOL
  2033.         DW    DUP,    DPM,    SEMIS
  2034. ;
  2035.         DM    83H,"MIN"
  2036.         DW    DABS - 8
  2037. MIN:         DW    DOCOL
  2038.         DW    TDUP,    GREAT
  2039.         DW    ZBRAN,    MIN1-$-2
  2040.         DW    SWAP
  2041. MIN1:         DW    DROP,    SEMIS
  2042. ;
  2043.         DM    83H,"MAX"
  2044.         DW    MIN - 6
  2045. MAX:         DW    DOCOL
  2046.         DW    TDUP,    LESS
  2047.         DW    ZBRAN,    MAX1-$-2
  2048.         DW    SWAP
  2049. MAX1:         DW    DROP,    SEMIS
  2050. ;
  2051. ;        ( Page 71 )
  2052. ;
  2053.         DM    82H,"M*"
  2054.     ALIGN
  2055.         DW    MAX - 6
  2056. MSTAR:        DW    DOCOL
  2057.         DW    TDUP,    XORR,    TOR
  2058.         DW    ABS
  2059.         DW    SWAP,    ABS,    USTAR
  2060.         DW    FROMR,    DPM,    SEMIS
  2061. ;
  2062.         DM    82H,"M/"
  2063.     ALIGN
  2064.         DW    MSTAR - 6
  2065. MSLAS:         DW    DOCOL
  2066.         DW    OVER,    TOR,    TOR
  2067.         DW    DABS
  2068.         DW    RR,    ABS,    USLAS
  2069.         DW    FROMR,    RR,    XORR
  2070.         DW    PM,    SWAP,    FROMR
  2071.         DW    PM,    SWAP,    SEMIS
  2072. ;
  2073.         DM    81H,"*"
  2074.         DW    MSLAS - 6
  2075. STAR:         DW    DOCOL
  2076.         DW    MSTAR,    DROP,    SEMIS
  2077. ;
  2078. ;        ( Page 72 )
  2079. ;
  2080.         DM    84H,"/MOD"
  2081.     ALIGN
  2082.         DW    STAR - 4
  2083. SLMOD:         DW    DOCOL
  2084.         DW    TOR,    STOD,    FROMR
  2085.         DW    MSLAS,    SEMIS
  2086. ;
  2087.         DM    81H,"/"
  2088.         DW    SLMOD - 8
  2089. SLASH:         DW    DOCOL
  2090.         DW    SLMOD,    SWAP,    DROP,    SEMIS
  2091. ;
  2092.         DM    83H,"MOD"
  2093.         DW    SLASH - 4
  2094. MODD:         DW    DOCOL
  2095.         DW    SLMOD,    DROP,    SEMIS
  2096. ;
  2097.         DM    85H,"*/MOD"
  2098.         DW    MODD - 6
  2099. SSMOD:         DW    DOCOL
  2100.         DW    TOR,    MSTAR,    FROMR
  2101.         DW    MSLAS,    SEMIS
  2102. ;
  2103. ;        ( Page 73 )
  2104. ;
  2105.         DM    82H,"*/"
  2106.     ALIGN
  2107.         DW    SSMOD - 8
  2108. SSLA:         DW    DOCOL
  2109.         DW    SSMOD,    SWAP,    DROP,    SEMIS
  2110. ;
  2111.         DM    85H,"M/MOD"
  2112.         DW    SSLA - 6
  2113. MSMOD:         DW    DOCOL
  2114.         DW    TOR,    ZERO,    RR,    USLAS
  2115.         DW    FROMR,    SWAP,    TOR
  2116.         DW    USLAS,    FROMR,    SEMIS
  2117. ;
  2118. ;        ( Page 74 )
  2119. ;
  2120.         DM    86H,"(LINE)"
  2121.     ALIGN
  2122.         DW    MSMOD - 8
  2123. PLINE:         DW    DOCOL
  2124.         DW    TOR
  2125.         DW    LIT,    64
  2126.         DW    BBUF,    SSMOD
  2127.         DW    FROMR,    BSCR,    STAR
  2128.         DW    PLUS
  2129.         DW    BLOCK,    PLUS
  2130.         DW    LIT,    64,    SEMIS
  2131. ;
  2132.         DM    85H,".LINE"
  2133.         DW    PLINE - 10
  2134. DLINE:         DW    DOCOL
  2135.         DW    PLINE,    DTRAI,    TYPES,    SEMIS
  2136. ;
  2137.         DM    87H,"MESSAGE"
  2138.         DW    DLINE - 8
  2139. MESS:         DW    DOCOL
  2140.         DW    WARN,    AT
  2141.         DW    ZBRAN,    MESS1-$-2
  2142.         DW    DDUP
  2143.         DW    ZBRAN,    MESS2-$-2
  2144.         DW    LIT,    4
  2145.         DW    OFSET,    AT,    BSCR,    SLASH
  2146.         DW    SUBB,    DLINE,    SPACE
  2147. MESS2:         DW    BRAN,    MESS3-$-2
  2148. MESS1:         DW    PDOTQ
  2149.         DB    6,"MSG # "
  2150.         DW    DOT
  2151. MESS3:         DW    SEMIS
  2152. ;
  2153. ;        ( Page 76 )
  2154. ;
  2155.     ALIGN
  2156.         DM    83H,"PC@"
  2157.         DW    MESS - 10
  2158. PTCAT:         DW    $ + 2
  2159.         POP    DX
  2160.         INB    DX
  2161.         SUB    AH,AH
  2162.         JMP    APUSH
  2163. ;
  2164.     ALIGN
  2165.         DM    83H,"PC!"
  2166.         DW    PTCAT - 6
  2167. PTCSTO:     DW    $ + 2
  2168.         POP    DX
  2169.         POP    AX
  2170.         OUTB    DX
  2171.         JMP    NEXT
  2172. ;
  2173.     ALIGN
  2174.         DM    82H,"P@"
  2175.     ALIGN
  2176.         DW    PTCSTO - 6
  2177. PTAT:         DW    $ + 2
  2178.         POP    DX
  2179.         INW    DX
  2180.         JMP    APUSH
  2181. ;
  2182. ;        ( Page 77 )
  2183. ;
  2184.     ALIGN
  2185.         DM    82H,"P!"
  2186.     ALIGN
  2187.         DW    PTAT - 6
  2188. PTSTO:         DW    $ + 2
  2189.         POP    DX
  2190.         POP    AX
  2191.         OUTW    DX
  2192.         JMP    NEXT
  2193. ;
  2194. ;        ( Page 78 )
  2195. ;
  2196. ;        Disk Interface Words for MS-DOS, etc.
  2197. ;        --------------------------------
  2198. ;
  2199. ;
  2200.     ALIGN
  2201.         DM    85H,"DRIVE"
  2202.         DW    PTSTO - 6
  2203. DRIVE:         DW    DOVAR,    0
  2204. ;
  2205.         DM    86H,"RECORD"    ;Not in fig listing
  2206.     ALIGN
  2207.         DW    DRIVE - 8
  2208. REC:         DW    DOVAR,    0
  2209. ;
  2210. ;        ( Page 79 )
  2211. ;
  2212.         DM    83H,"USE"
  2213.         DW    REC - 10
  2214. USE:         DW    DOVAR,    BUF1
  2215. ;
  2216.         DM    84H,"PREV"
  2217.     ALIGN
  2218.         DW    USE - 6
  2219. PREV:         DW    DOVAR,    BUF1
  2220. ;
  2221.         DM    87H,"SEC/BLK"
  2222.         DW    PREV - 8
  2223. SPBLK:         DW    DOCON,    SPBL    ; KBBUF / BPS
  2224. ;
  2225. ;        ( Page 80 )
  2226. ;
  2227.         DM    85H,"#BUFF"
  2228.         DW    SPBLK - 10
  2229. NOBUF:         DW    DOCON,    NBUF
  2230. ;
  2231.         DM    87H,"DENSITY"
  2232.         DW    NOBUF - 8
  2233. DENSTY:     DW    DOVAR,    DD
  2234. ;
  2235.         DM    8AH,"DISK-ERROR"
  2236.     ALIGN
  2237.         DW    DENSTY - 10
  2238. DSKERR:     DW    DOVAR,    0
  2239. ;
  2240.         DM    87H,"PRINTER"        ;EPRINT in fig
  2241.         DW    DSKERR - 14
  2242. PRTER:        DW    DOVAR, 0
  2243. ;
  2244. ;        ( Page 81 )
  2245. ;
  2246.         DM    84H,"+BUF"
  2247.     ALIGN
  2248.         DW    PRTER - 10
  2249. PBUF:         DW    DOCOL
  2250.         DW    BBUF,    TWOP,    TWOP    ;B/BUF+4
  2251.         DW    PLUS,    DUP,    LIMIT,    EQUAL
  2252.         DW    ZBRAN,    PBUF1-$-2
  2253.         DW    DROP,    FIRST
  2254. PBUF1:         DW    DUP,    PREV,    AT
  2255.         DW    SUBB,    SEMIS
  2256. ;
  2257.         DM    86H,"UPDATE"
  2258.     ALIGN
  2259.         DW    PBUF - 8
  2260. UPDAT:         DW    DOCOL
  2261.         DW    PREV,    AT,    AT
  2262.         DW    LIT,    8000H
  2263.         DW    ORR
  2264.         DW    PREV,    AT,    STORE,    SEMIS
  2265. ;
  2266.         DM    8DH,"EMPTY-BUFFERS"
  2267.         DW    UPDAT - 10
  2268. MTBUF:         DW    DOCOL
  2269.         DW    FIRST,    LIMIT,    OVER
  2270.         DW    SUBB,    ERASEE,    SEMIS
  2271. ;
  2272. ;        ( Page 82 )
  2273. ;
  2274.         DM    83H,"DR0"
  2275.         DW    MTBUF - 16
  2276. DRZER:         DW    DOCOL
  2277.         DW    ZERO,    OFSET,    STORE,    SEMIS
  2278. ;
  2279.         DM    83H,"DR1"
  2280.         DW    DRZER - 6
  2281. DRONE:         DW    DOCOL
  2282.         DW    DENSTY,    AT
  2283.         DW    ZBRAN,    DRON1-$-2
  2284.         DW    LIT,    SPDRV2
  2285.         DW    BRAN,    DRON2-$-2
  2286. DRON1:         DW    LIT,    SPDRV1
  2287. DRON2:         DW    OFSET,    STORE,    SEMIS
  2288. ;
  2289. ;        ( Page 83 )
  2290. ;
  2291.         DM    86H,"BUFFER"
  2292.     ALIGN
  2293.         DW    DRONE - 6
  2294. BUFFE:         DW    DOCOL
  2295.         DW    USE,    AT,    DUP,    TOR
  2296. BUFF1:         DW    PBUF
  2297.         DW    ZBRAN,    BUFF1-$-2
  2298.         DW    USE,    STORE
  2299.         DW    RR,    AT,    ZLESS
  2300.         DW    ZBRAN,    BUFF2-$-2
  2301.         DW    RR,    TWOP
  2302.         DW    RR,    AT
  2303.         DW    LIT,    7FFFH
  2304.         DW    ANDD,    ZERO,    RSLW
  2305. BUFF2:         DW    RR,    STORE
  2306.         DW    RR,    PREV,    STORE
  2307.         DW    FROMR,    TWOP,    SEMIS
  2308. ;
  2309. ;        ( Page 84 )
  2310. ;
  2311.         DM    85H,"BLOCK"
  2312.         DW    BUFFE - 10
  2313. BLOCK:         DW    DOCOL
  2314.         DW    OFSET,    AT,    PLUS,    TOR
  2315.         DW    PREV,    AT,    DUP
  2316.         DW    AT,    RR,    SUBB
  2317.         DW    DUP,    PLUS
  2318.         DW    ZBRAN,    BLOC1-$-2
  2319. BLOC2:         DW    PBUF,    ZEQU
  2320.         DW    ZBRAN,    BLOC3-$-2
  2321.         DW    DROP,    RR
  2322.         DW    BUFFE,    DUP
  2323.         DW    RR,    ONE,    RSLW
  2324.         DW    TWO,    SUBB
  2325. BLOC3:         DW    DUP,    AT,    RR,    SUBB
  2326.         DW    DUP,    PLUS,    ZEQU
  2327.         DW    ZBRAN,    BLOC2-$-2
  2328.         DW    DUP,    PREV,    STORE
  2329. BLOC1:         DW    FROMR,    DROP
  2330.         DW    TWOP,    SEMIS
  2331. ;
  2332. ;        ( Page 85 )
  2333. ;        ( Page 86 )
  2334. ;
  2335.         DM    87H,"T&SCALC"
  2336.         DW    BLOCK-8
  2337. TSCALC:        DW    DOCOL
  2338.         DW    DENSTY,    AT
  2339.         DW    ZBRAN,    TSCALS-$-2
  2340.         DW    LIT,    SPDRV2,    SLMOD
  2341. ;        DW    LIT,    MXDRV,    MIN
  2342.         DW    DRIVE,    STORE
  2343.         DW    REC,    STORE,    SEMIS
  2344. ;        single density calculations :
  2345. TSCALS:        DW    LIT,    SPDRV1,    SLMOD
  2346. ;        DW    LIT,    MXDRV,    MIN
  2347.         DW    DRIVE,    STORE
  2348.         DW    REC,    STORE,    SEMIS
  2349. ;
  2350. ;        ( Page 87 )
  2351. ;
  2352.         DM    8AH,"BLOCK-READ"
  2353.     ALIGN
  2354.         DW    TSCALC - 10
  2355. BLKRD:        DW    $ + 2
  2356.         MOV    [DSKERR+2],0    ;reset error flag
  2357.         MOV    AX,[DRIVE+2]    ;AL = drive no.
  2358.         MOV    BX,[USE+2]    ;BX = transfer address
  2359.         MOV    CX,[SPBLK+2]    ;CX = no. records to transfer
  2360.         MOV    DX,[REC+2]    ;DX = logical record #
  2361.         PUSH    SI
  2362.         PUSH    BP
  2363.         INT    37        ;BIOS disk read function
  2364.         JNC    READOK
  2365.         MOV    B,[DSKERR+2],AL    ;READ ERROR!
  2366. READOK:        POPF
  2367.         POP    BP
  2368.         POP    SI
  2369.         JMP    NEXT
  2370. ;
  2371.     ALIGN
  2372.         DM    8BH,"BLOCK-WRITE"
  2373.         DW    BLKRD - 14
  2374. BLKWRT:        DW    $ + 2
  2375.         MOV    [DSKERR+2],0    ;reset error flag
  2376.         MOV    AX,[DRIVE+2]
  2377.         MOV    BX,[USE+2]
  2378.         MOV    CX,[SPBLK+2]
  2379.         MOV    DX,[REC+2]
  2380.         PUSH    SI
  2381.         PUSH    BP
  2382.         INT    38        ;BIOS disk write function
  2383.         JNC    WRTOK
  2384.         XOR    AH,AH        ;return negative error code
  2385.         NEG    AX
  2386.         MOV    [DSKERR+2],AX    ;WRITE ERROR!
  2387. WRTOK:        POPF
  2388.         POP    BP
  2389.         POP    SI
  2390.         JMP    NEXT
  2391. ;
  2392. ;        ( Page 88 )
  2393. ;
  2394.     ALIGN
  2395.         DM    83H,"R/W"
  2396.         DW    BLKWRT - 14
  2397. RSLW:         DW    DOCOL
  2398.         DW    USE,    AT,    TOR
  2399.         DW    TOR
  2400.         DW    SWAP,    USE, STORE
  2401.         DW    SPBLK,    STAR
  2402.         DW    TSCALC
  2403.         DW    FROMR
  2404.         DW    ZBRAN,    RSLW1-$-2
  2405.         DW    BLKRD
  2406.         DW    BRAN,    RSLW2-$-2
  2407. RSLW1:        DW    BLKWRT
  2408. RSLW2:        DW    FROMR,    USE,    STORE
  2409.         DW    DSKERR,    AT,    DDUP
  2410.         DW    ZBRAN,    RSLW5-$-2        ;OK
  2411.         DW    ZLESS
  2412.         DW    ZBRAN,    RSLW3-$-2
  2413.         DW    LIT,    9            ;Write error
  2414.         DW    BRAN,    RSLW4-$-2
  2415. RSLW3:        DW    LIT,    8            ;Read error
  2416. RSLW4:        DW    ZERO,    PREV,    AT,    STORE    ;This  buffer
  2417.                             ; is no good!
  2418.         DW    QERR
  2419. RSLW5:        DW    SEMIS
  2420. ;
  2421. ;        ( Page 89 )
  2422. ;
  2423.         DM    85H,"FLUSH"
  2424.         DW    RSLW - 6
  2425. FLUSH:         DW    DOCOL
  2426.         DW    NOBUF,    ONEP
  2427.         DW    ZERO,    XDO
  2428. FLUS1:         DW    ZERO,    BUFFE,    DROP
  2429.         DW    XLOOP,    FLUS1-$-2
  2430.         DW    SEMIS
  2431. ;
  2432.         DM    84H,"LOAD"
  2433.     ALIGN
  2434.         DW    FLUSH - 8
  2435. LOAD:         DW    DOCOL
  2436.         DW    BLK,    AT,    TOR
  2437.         DW    INN,    AT,    TOR
  2438.         DW    ZERO,    INN,    STORE
  2439.         DW    BSCR,    STAR,    BLK,    STORE
  2440.         DW    INTER
  2441.         DW    FROMR,    INN,    STORE
  2442.         DW    FROMR,    BLK,    STORE
  2443.         DW    SEMIS
  2444. ;
  2445. ;        ( Page 90 )
  2446. ;
  2447.         DM    0C3H,"-->"
  2448.         DW    LOAD - 8
  2449. ARROW:         DW    DOCOL
  2450.         DW    QLOAD
  2451.         DW    ZERO,    INN,    STORE
  2452.         DW    BSCR,    BLK,    AT
  2453.         DW    OVER,    MODD,    SUBB
  2454.         DW    BLK,    PSTOR,    SEMIS
  2455. ;
  2456. ;        ( Page 91 )
  2457. ;
  2458. ;****************************************
  2459. ;*                    *
  2460. ;*    i/o primitives :        *
  2461. ;*                    *
  2462. ;*    PQTER, PKEY, PEMIT, PCR,    *
  2463. ;*    CONOUT, LSTOUT            *
  2464. ;*                    *
  2465. ;****************************************
  2466. ;
  2467. REQUEST        EQU    33        ;BIOS function request intr.
  2468. CONOUT        EQU    2        ;BIOS console output function
  2469. LSTOUT        EQU    5        ;BIOS printer output function
  2470. CONIO        EQU    8        ;BIOS console i/o fctn, no echo
  2471. CONSTAT        EQU    11        ;BIOS console status check fctn
  2472. ;
  2473. ACTRLC        EQU    3        ;ASCII ^C
  2474. ;
  2475. PQTER:         MOV    AH,CONSTAT
  2476.         INT    REQUEST
  2477.         SUB    AH,AH
  2478.         JMP    APUSH
  2479. ;
  2480. PKEY:        MOV    DX,0FFH
  2481.         MOV    AH,CONIO
  2482.         INT    REQUEST
  2483.         OR    AL,AL
  2484.         JZ    PKEY
  2485.         AND    AX,7FH
  2486.         CMP    AL,ACTRLC    ;check for ^C
  2487.         JNZ    PKEY1        ;pass anything else
  2488.         INT    35        ;Force ^C interrupt 
  2489. PKEY1:        JMP    APUSH
  2490. ;
  2491. PEMIT:         DW    $ + 2
  2492.         POP    DX
  2493.         CALL    POUT
  2494.         JMP    NEXT
  2495. ;
  2496. ;        ( Page 92 )
  2497. ;
  2498. PCR:         MOV    DX,ACR
  2499.         CALL    POUT
  2500.         MOV    DX,LF
  2501.         CALL    POUT
  2502.         JMP    NEXT
  2503. ;
  2504. POUT:         AND    DX,7FH
  2505.         MOV    AH,CONOUT
  2506.         INT    REQUEST
  2507.         MOV    BX,[ PRTER+2 ]    ;Check echo flag
  2508.         OR    BX,BX
  2509.         JZ    RET
  2510.         MOV    AH,LSTOUT
  2511.         INT    REQUEST        ;Echo to printer
  2512.         RET
  2513. ;
  2514. ;********************************************************
  2515. ;*                            *
  2516. ;*        TIME@, TIME!, DATE@, DATE!        *
  2517. ;*                            *
  2518. ;********************************************************
  2519. ;
  2520.     ALIGN
  2521.         DM    85H,"TIME@"
  2522.         DW    ARROW - 6
  2523. TIMAT:        DW    $ + 2
  2524.         MOV    AH,2CH        ;Get time
  2525.         INT    REQUEST
  2526.         PUSH    DX        ;[sec sec/100]
  2527.         PUSH    CX        ;[hr min]
  2528.         JMP    NEXT
  2529. ;
  2530.     ALIGN
  2531.         DM    85H,"TIME!"
  2532.         DW    TIMAT - 8
  2533. TIMST:        DW    $ + 2
  2534.         POP    CX        ;[hr min]
  2535.         POP    DX        ;[sec sec/100]
  2536.         MOV    AH,2DH
  2537.         INT    REQUEST
  2538.         JMP    NEXT
  2539. ;
  2540.     ALIGN
  2541.         DM    85H,"DATE@"
  2542.         DW    TIMST - 8
  2543. DATAT:        DW    $ + 2
  2544.         MOV    AH,2AH
  2545.         INT    REQUEST
  2546.         PUSH    CX        ;year
  2547.         MOV    AL,DH        ;month
  2548.         XOR    AH,AH
  2549.         XOR    DH,DH
  2550.         JMP    DPUSH        ;DL=day
  2551. ;
  2552.     ALIGN
  2553.         DM    85H,"DATE!"
  2554.         DW    DATAT - 8
  2555. DATST:        DW    $ + 2
  2556.         POP    CX        ;year
  2557.         POP    DX        ;DL=day
  2558.         POP    AX
  2559.         MOV    DH,AL        ;DH=month
  2560.         MOV    AH,2BH
  2561.         INT    REQUEST
  2562.         JMP    NEXT
  2563. ;
  2564. ;        ( Page 93 )
  2565. ;        ( Page 94 )
  2566. ;
  2567. EXIT:         INT    32
  2568. ;
  2569. ;        ( Page 96 )
  2570. ;        ( Page 98 )
  2571. ;
  2572.     ALIGN
  2573.         DM    0C1H,"'"
  2574.         DW    DATST - 8
  2575. TICK:         DW    DOCOL
  2576.         DW    DFIND,    ZEQU
  2577.         DW    ZERO,    QERR
  2578.         DW    DROP,    LITER,    SEMIS
  2579. ;
  2580.         DM    86H,"FORGET"
  2581.     ALIGN
  2582.         DW    TICK - 4
  2583. FORG:         DW    DOCOL
  2584.         DW    CURR,    AT
  2585.         DW    CONT,    AT
  2586.         DW    SUBB
  2587.         DW    LIT,    24,    QERR
  2588.         DW    TICK,    DUP
  2589.         DW    FENCE,    AT,    LESS
  2590.         DW    LIT,    21,    QERR
  2591.         DW    DUP
  2592.         DW    NFA,    DP,    STORE
  2593.         DW    LFA,    AT
  2594.         DW    CONT,    AT,    STORE,    SEMIS
  2595. ;
  2596. ;        ( Page 99 )
  2597. ;
  2598.         DM    84H,"BACK"
  2599.     ALIGN
  2600.         DW    FORG - 10
  2601. BACK:         DW    DOCOL
  2602.         DW    HERE,    SUBB
  2603.         DW    COMMA,    SEMIS
  2604. ;
  2605.         DM    0C5H,"BEGIN"
  2606.         DW    BACK - 8
  2607. BEGIN:         DW    DOCOL
  2608.         DW    QCOMP
  2609.         DW    HERE,    ONE,    SEMIS
  2610. ;
  2611.         DM    0C5H,"ENDIF"
  2612.         DW    BEGIN - 8
  2613. ENDIFF:     DW    DOCOL
  2614.         DW    QCOMP
  2615.         DW    TWO,    QPAIR
  2616.         DW    HERE,    OVER,    SUBB
  2617.         DW    SWAP,    STORE,    SEMIS
  2618. ;
  2619. ;        ( Page 100 )
  2620. ;
  2621.         DM    0C4H,"THEN"
  2622.     ALIGN
  2623.         DW    ENDIFF - 8
  2624. THEN:         DW    DOCOL
  2625.         DW    ENDIFF,    SEMIS
  2626. ;
  2627.         DM    0C2H,"DO"
  2628.     ALIGN
  2629.         DW    THEN - 8
  2630. DO:         DW    DOCOL
  2631.         DW    COMP,    XDO
  2632.         DW    HERE,    THREE,    SEMIS
  2633. ;
  2634.         DM    0C4H,"LOOP"
  2635.     ALIGN
  2636.         DW    DO - 6
  2637. LOOPC:         DW    DOCOL
  2638.         DW    THREE,    QPAIR
  2639.         DW    COMP,    XLOOP
  2640.         DW    BACK,    SEMIS
  2641. ;
  2642. ;        ( Page 101 )
  2643. ;
  2644.         DM    0C5H,"+LOOP"
  2645.         DW    LOOPC - 8
  2646. PLOOP:         DW    DOCOL
  2647.         DW    THREE,    QPAIR
  2648.         DW    COMP,    XPLOO
  2649.         DW    BACK,    SEMIS
  2650. ;
  2651.         DM    0C5H,"UNTIL"
  2652.         DW    PLOOP - 8
  2653. UNTIL:         DW    DOCOL
  2654.         DW    ONE,    QPAIR
  2655.         DW    COMP,    ZBRAN
  2656.         DW    BACK,    SEMIS
  2657. ;
  2658.         DM    0C3H,"END"
  2659.         DW    UNTIL - 8
  2660. ENDD:         DW    DOCOL
  2661.         DW    UNTIL,    SEMIS
  2662. ;
  2663. ;        ( Page 102 )
  2664. ;
  2665.         DM    0C5H,"AGAIN"
  2666.         DW    ENDD - 6
  2667. AGAIN:         DW    DOCOL
  2668.         DW    ONE,    QPAIR
  2669.         DW    COMP,    BRAN
  2670.         DW    BACK,    SEMIS
  2671. ;
  2672.         DM    0C6H,"REPEAT"
  2673.     ALIGN
  2674.         DW    AGAIN - 8
  2675. REPEA:         DW    DOCOL
  2676.         DW    TOR,    TOR
  2677.         DW    AGAIN
  2678.         DW    FROMR,    FROMR
  2679.         DW    TWO,    SUBB
  2680.         DW    ENDIFF,    SEMIS
  2681. ;
  2682.         DM    0C2H,"IF"
  2683.     ALIGN
  2684.         DW    REPEA - 10
  2685. IFF:         DW    DOCOL
  2686.         DW    COMP,    ZBRAN
  2687.         DW    HERE,    ZERO,    COMMA
  2688.         DW    TWO,    SEMIS
  2689. ;
  2690. ;        ( Page 103 )
  2691. ;
  2692.         DM    0C4H,"ELSE"
  2693.     ALIGN
  2694.         DW    IFF - 6
  2695. ELSEE:         DW    DOCOL
  2696.         DW    TWO,    QPAIR
  2697.         DW    COMP,    BRAN
  2698.         DW    HERE,    ZERO,    COMMA
  2699.         DW    SWAP
  2700.         DW    TWO,    ENDIFF,    TWO
  2701.         DW    SEMIS
  2702. ;
  2703.         DM    0C5H,"WHILE"
  2704.         DW    ELSEE - 8
  2705. WHILE:         DW    DOCOL
  2706.         DW    IFF,    TWOP,    SEMIS
  2707. ;
  2708. ;        ( Page 104 )
  2709. ;
  2710.         DM    86H,"SPACES"
  2711.     ALIGN
  2712.         DW    WHILE - 8
  2713. SPACS:         DW    DOCOL
  2714.         DW    ZERO,    MAX
  2715.         DW    DDUP
  2716.         DW    ZBRAN,    SPAX1-$-2
  2717.         DW    ZERO,    XDO
  2718. SPAX2:         DW    SPACE
  2719.         DW    XLOOP,    SPAX2-$-2
  2720. SPAX1:         DW    SEMIS
  2721. ;
  2722.         DM    82H,"<#"
  2723.     ALIGN
  2724.         DW    SPACS - 10
  2725. BDIGS:         DW    DOCOL
  2726.         DW    PAD,    HLD,    STORE
  2727.         DW    SEMIS
  2728. ;
  2729.         DM    82H,"#>"
  2730.     ALIGN
  2731.         DW    BDIGS - 6
  2732. EDIGS:         DW    DOCOL
  2733.         DW    DROP,    DROP
  2734.         DW    HLD,    AT
  2735.         DW    PAD
  2736.         DW    OVER,    SUBB,    SEMIS
  2737. ;
  2738. ;        ( Page 105 )
  2739. ;
  2740.         DM    84H,"SIGN"
  2741.     ALIGN
  2742.         DW    EDIGS - 6
  2743. SIGN:         DW    DOCOL
  2744.         DW    ROT,    ZLESS
  2745.         DW    ZBRAN,    SIGN1-$-2
  2746.         DW    LIT,    '-',    HOLD
  2747. SIGN1:         DW    SEMIS
  2748. ;
  2749.         DM    81H,"#"
  2750.         DW    SIGN - 8
  2751. DIG:         DW    DOCOL
  2752.         DW    BASE,    AT,    MSMOD
  2753.         DW    ROT
  2754.         DW    LIT,    9
  2755.         DW    OVER,    LESS
  2756.         DW    ZBRAN,    DIG1-$-2
  2757.         DW    LIT,    7,    PLUS
  2758. DIG1:         DW    LIT,    '0',    PLUS
  2759.         DW    HOLD,    SEMIS
  2760. ;
  2761.         DM    82H,"#S"
  2762.     ALIGN
  2763.         DW    DIG - 4
  2764. DIGS:         DW    DOCOL
  2765. DIGS1:         DW    DIG
  2766.         DW    OVER,    OVER
  2767.         DW    ORR,    ZEQU
  2768.         DW    ZBRAN,    DIGS1-$-2
  2769.         DW    SEMIS
  2770. ;
  2771. ;        ( Page 106 )
  2772. ;
  2773.         DM    83H,"D.R"
  2774.         DW    DIGS - 6
  2775. DDOTR:         DW    DOCOL
  2776.         DW    TOR,    SWAP,    OVER
  2777.         DW    DABS
  2778.         DW    BDIGS
  2779.         DW    DIGS,    SIGN
  2780.         DW    EDIGS
  2781.         DW    FROMR,    OVER,    SUBB
  2782.         DW    SPACS,    TYPES,    SEMIS
  2783. ;
  2784.         DM    82H,".R"
  2785.     ALIGN
  2786.         DW    DDOTR - 6
  2787. DOTR:         DW    DOCOL
  2788.         DW    TOR
  2789.         DW    STOD,    FROMR,    DDOTR,    SEMIS
  2790. ;
  2791. ;        ( Page 107 )
  2792. ;
  2793.         DM    82H,"D."
  2794.     ALIGN
  2795.         DW    DOTR - 6
  2796. DDOT:         DW    DOCOL
  2797.         DW    ZERO
  2798.         DW    DDOTR,    SPACE,    SEMIS
  2799. ;
  2800.         DM    81H,"."
  2801.         DW    DDOT - 6
  2802. DOT:         DW    DOCOL
  2803.         DW    STOD,    DDOT,    SEMIS
  2804. ;
  2805.         DM    81H,"?"
  2806.         DW    DOT - 4
  2807. QUES:         DW    DOCOL
  2808.         DW    AT,    DOT,    SEMIS
  2809. ;
  2810.         DM    82H,"U."
  2811.     ALIGN
  2812.         DW    QUES - 4
  2813. UDOT:         DW    DOCOL
  2814.         DW    ZERO,    DDOT,    SEMIS
  2815. ;
  2816. ;        ( Page 108 )
  2817. ;
  2818.         DM    85H,"VLIST"
  2819.         DW    UDOT - 6
  2820. VLIST:         DW    DOCOL
  2821.         DW    LIT,    80H
  2822.         DW    OUTT,    STORE
  2823.         DW    CONT,    AT,    AT
  2824. VLIS1:         DW    OUTT,    AT
  2825.         DW    CSLL,    GREAT
  2826.         DW    ZBRAN,    VLIS2-$-2
  2827.         DW    CR
  2828.         DW    ZERO,    OUTT,    STORE
  2829. VLIS2:         DW    DUP
  2830.         DW    IDDOT
  2831.         DW    SPACE,    SPACE
  2832.         DW    PFA,    LFA,    AT
  2833.         DW    DUP,    ZEQU
  2834.         DW    QTERM,    ORR
  2835.         DW    ZBRAN,    VLIS1-$-2
  2836.         DW    DROP,    SEMIS
  2837. ;
  2838.         DM    83H,"BYE"
  2839.         DW    VLIST - 8
  2840. BYE:         DW    $ + 2
  2841.         JMP    EXIT
  2842. ;
  2843. ;        ( Page 109 )
  2844. ;
  2845.     ALIGN
  2846.         DM    84H,"LIST"
  2847.     ALIGN
  2848.         DW    BYE - 6
  2849. LISTC:         DW    DOCOL
  2850.         DW    DECA,    CR
  2851.         DW    DUP,    SCR,    STORE
  2852.         DW    PDOTQ
  2853.         DB    6,"SCR # "
  2854.         DW    DOT
  2855.         DW    LIT,    16,    ZERO,    XDO
  2856. LIST1:         DW    CR,    IDO
  2857.         DW    LIT,    3,    DOTR,    SPACE
  2858.         DW    IDO,    SCR,    AT,    DLINE
  2859.         DW    QTERM
  2860.         DW    ZBRAN,    LIST2-$-2
  2861.         DW    LEAVE
  2862. LIST2:         DW    XLOOP,    LIST1-$-2
  2863.         DW    CR,    SEMIS
  2864. ;
  2865.     ALIGN
  2866.         DM    85H,"INDEX"
  2867.         DW    LISTC - 8
  2868. INDEX:         DW    DOCOL
  2869.         DW    LIT,    FF,    EMIT,    CR
  2870.         DW    ONEP,    SWAP,    XDO
  2871. INDE1:         DW    CR,    IDO
  2872.         DW    LIT,    3,    DOTR,    SPACE
  2873.         DW    ZERO,    IDO,    DLINE
  2874.         DW    QTERM
  2875.         DW    ZBRAN,    INDE2-$-2
  2876.         DW    LEAVE
  2877. INDE2:         DW    XLOOP,    INDE1-$-2
  2878.         DW    SEMIS
  2879. ;
  2880. ;        ( Page 110 )
  2881. ;
  2882.         DM    85H,"TRIAD"
  2883.         DW    INDEX - 8
  2884. TRIAD:         DW    DOCOL
  2885.         DW    LIT,    FF,    EMIT
  2886.         DW    LIT,    3,    SLASH
  2887.         DW    LIT,    3,    STAR
  2888.         DW    LIT,    3,    OVER
  2889.         DW    PLUS,    SWAP,    XDO
  2890. TRIA1:         DW    CR,    IDO,    LISTC
  2891.         DW    QTERM
  2892.         DW    ZBRAN,    TRIA2-$-2
  2893.         DW    LEAVE
  2894. TRIA2:         DW    XLOOP,    TRIA1-$-2
  2895.         DW    CR
  2896.         DW    LIT,    15,    MESS,    CR
  2897.         DW    SEMIS
  2898. ;
  2899.         DM    84H,".CPU"
  2900.     ALIGN
  2901.         DW    TRIAD - 8
  2902. DOTCPU:     DW    DOCOL
  2903.         DW    BASE,    AT
  2904.         DW    LIT,    36,    BASE,    STORE
  2905.         DW    LIT,    22H,    PORIG,    TAT
  2906.         DW    DDOT
  2907.         DW    BASE,    STORE,    SEMIS
  2908. ;
  2909. ;        ( Page 111 )
  2910. ;
  2911.         DM    85H,"MATCH"
  2912.         DW    DOTCPU - 8
  2913. MATCH:         DW    $ + 2
  2914.         MOV    DI,SI
  2915.         POP    CX
  2916.         POP    BX
  2917.         POP    DX
  2918.         POP    SI
  2919.         PUSH    SI
  2920. MAT1:         LODB
  2921.         CMP    AL,[BX]
  2922.         JNZ    MAT3
  2923.         PUSH    BX
  2924.         PUSH    CX
  2925.         PUSH    SI
  2926. MAT2:         DEC    CX
  2927.         JZ    MATCHOK
  2928.         DEC    DX
  2929.         JZ    NOMATCH
  2930.         INC    BX
  2931.         LODB
  2932.         CMP    AL,[BX]
  2933.         JZ    MAT2
  2934.         POP    SI
  2935.         POP    CX
  2936.         POP    BX
  2937. MAT3:         DEC    DX
  2938.         JNZ    MAT1
  2939.         JMP    MAT4
  2940. MATCHOK:
  2941. NOMATCH:     POP    CX
  2942.         POP    CX
  2943.         POP    CX
  2944. MAT4:         MOV    AX,SI
  2945.         POP    SI
  2946.         SUB    AX,SI
  2947.         MOV    SI,DI
  2948.         JMP    DPUSH
  2949. ;
  2950. ;        ( Page 113 )
  2951. ;
  2952.     ALIGN
  2953.         DM    84H,"TASK"
  2954.     ALIGN
  2955.         DW    MATCH - 8
  2956. TASK:         DW    DOCOL
  2957.         DW    SEMIS
  2958. ;
  2959. INITDP        EQU    $
  2960.