home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PARASOL / PARASOLS.ARK / LMISC.ASM < prev    next >
Assembly Source File  |  1986-10-05  |  107KB  |  7,062 lines
  1. ;--------misc compiler procedures---------------
  2. ;
  3. ;
  4. ;
  5. ;-----------------------------------------------
  6. ;     get word
  7. ;
  8. ;  returns:
  9. ;    word - type string
  10. ;    word.length - integer
  11. ;    word.type - integer
  12. ;        0 - unrecognized
  13. ;        1 - identifier (possibly reserved word)
  14. ;        2 - string
  15. ;        3 - number
  16. ;        4 - operator
  17. ;        5 - delimiter
  18. ;----------------------------------------------------
  19. ;
  20. get.word:
  21.     xra    a
  22.     sta    word.length
  23.     sta    minus.word.flag
  24.     sta    word.type
  25.     sta    rsvd.wd.ix
  26. ;
  27.     lxi    h,0
  28.     shld    cnst.value
  29.     shld    cnst.value + 2
  30. ;
  31.     lda    src.char
  32.     lxi    h,word
  33. ;
  34.     cpi    '0'
  35.     jc    check.char.further
  36.     cpi    '9'+1
  37.     jc    word.is.number
  38. ;
  39.     cpi    'A'
  40.     jc    check.char.further
  41.     cpi    'Z'+1
  42.     jc    word.is.alpha
  43.     cpi    'a'
  44.     jc    check.char.further
  45.     cpi    'z'+1
  46.     jc    word.is.alpha
  47. ;
  48. check.char.further:
  49.     call    switch
  50.     db ' '    ! dw get.word.null
  51.     db 09h    ! dw get.word.null
  52.     db 0dh    ! dw get.word.null
  53.     db 0ah    ! dw get.word.null
  54.     db '^'    ! dw word.is.cnst
  55.     db 1ah    ! dw gw.chk.copy.end
  56.     db '='    ! dw one.ch.word
  57.     db '('    ! dw cnst.paren
  58.     db ')'    ! dw one.ch.word
  59.     db '['    ! dw one.ch.word
  60.     db ']'    ! dw one.ch.word
  61.     db '{'    ! dw skip.comment
  62.     db '}'    ! dw one.ch.word
  63.     db '*'    ! dw one.ch.word
  64.     db '/'    ! dw one.ch.word
  65.     db '+'    ! dw plus.word
  66.     db '-'    ! dw minus.word
  67.     db '$'    ! dw one.ch.word
  68.     db ':'    ! dw one.ch.word
  69.     db ';'    ! dw one.ch.word
  70.     db '.'    ! dw word.is.alpha
  71.     db '_'    ! dw word.is.alpha
  72.     db '`'    ! dw word.is.alpha
  73.     db ','    ! dw one.ch.word
  74.     db '!'    ! dw one.ch.word
  75.     db '@'    ! dw ptr.word
  76.     db '#'    ! dw lit.label.word
  77.     db '>'    ! dw chk.geq.neq.leq
  78.     db '<'    ! dw chk.geq.neq.leq
  79.     db ''''    ! dw word.is.string
  80.     db '"'    ! dw word.is.string
  81.     db 0    ! dw inv.input.char
  82. ;
  83. inv.input.char:
  84.     lxi    h,em.inv.SRC.char
  85.     call    print.error
  86.     call    get.src.char
  87.     jmp    get.word
  88. ;
  89. ;
  90. ;
  91. get.word.null:
  92.     call    get.src.char
  93.     jmp    get.word
  94. ;
  95. ;
  96. skip.comment:
  97.     call    get.src.char
  98.     lda    src.char
  99.     cpi    1ah
  100.     jz    one.ch.word
  101.     cpi    0dh
  102.     jz    end.skip.comment
  103.     cpi    '}'
  104.     jnz    skip.comment
  105. end.skip.comment:
  106.     call    get.src.char
  107.     jmp    get.word
  108. ;
  109. ;
  110. plus.word:
  111.     mov    m,a
  112.     inx    h
  113.     shld    word.cnst.ptr
  114.     jmp    plus.minus.word.common
  115. ;
  116. ;
  117. minus.word:
  118.     mov    m,a
  119.     inx    h
  120.     shld    word.cnst.ptr
  121.     mvi    a,0ffh
  122.     sta    minus.word.flag
  123. plus.minus.word.common:
  124.     call    get.src.char
  125.     lda    src.char
  126.     cpi    '^'
  127.     jz    word.is.cnst
  128.     cpi    '0'
  129.     jc    one.ch.word.entry
  130.     cpi    '9'+1
  131.     jnc    one.ch.word.entry
  132.     jmp    word.is.number
  133. ;
  134. ;
  135. ;
  136. gw.chk.copy.end:
  137.     mov    b,a
  138.     lda    copy.nest.count
  139.     ora    a
  140.     mov    a,b
  141.     jz    one.ch.word
  142. ;
  143. ;---restore source data, etc---
  144. ;
  145.     lxi    d,src.in    ;close for MP/M
  146.     mvi    c,16
  147.     call    entry
  148.     lxi    h,copy.swap.area
  149.     lxi    d,src.in
  150.     lxi    b,copy.move.size
  151.     call    move.h.2.d.cnt.b
  152. ;
  153.     lxi    h,copy.nest.count
  154.     dcr    m
  155. ;
  156.     jmp    get.word
  157. ;
  158. ;
  159. ;
  160. one.ch.word:
  161.     mov    m,a
  162.     inx    h
  163.     call    get.src.char
  164. one.ch.word.entry:
  165.     mvi    a,1
  166.     sta    word.length
  167.     mvi    m,0
  168.     jmp    get.word.type
  169. ;
  170. ;
  171. ;
  172. chk.geq.neq.leq:
  173.     mov    m,a
  174.     mov    b,a
  175.     inx    h
  176.     call    get.src.char
  177.     lda    src.char
  178.     cpi    '='
  179.     jnz    chk.neq
  180.     mov    m,a
  181. two.ch.word.entry:
  182.     inx    h
  183.     mvi    m,0
  184.     mvi    a,2
  185.     sta    word.length
  186.     call    get.word.type
  187.     jmp    get.src.char
  188. ;
  189. ;
  190. chk.neq:
  191.     cpi    '>'
  192.     jnz    one.ch.word.entry
  193.     mov    m,a
  194.     mov    a,b
  195.     cpi    '<'
  196.     jnz    one.ch.word.entry
  197.     jmp    two.ch.word.entry
  198. ;
  199. ;
  200. ;
  201. ;
  202. ptr.word:
  203.     call    get.src.char
  204.     call    get.word
  205.     call    chk.word.id.only
  206.     mvi    a,wtp.ident + wtp.ptr
  207.     sta    word.type
  208.     ret
  209. ;
  210. ;
  211. ;
  212. ;
  213. lit.label.word:
  214.         ;---save sym.tbl entry---
  215.     lxi    h,symbol.table.entry
  216.     lxi    d,lllw.ste.save
  217.     lxi    b,ste.B.type - ste.A.type
  218.     call    move.h.2.d.cnt.b
  219. ;
  220.     call    get.src.char
  221. ;---check for '##' --> length of id---
  222.     xra    a
  223.     sta    length.label.flag
  224.     lda    src.char
  225.     cpi    '#'
  226.     jnz    lit.label.cont
  227. ;
  228.     call    get.src.char
  229.     mvi    a,0ffh
  230.     sta    length.label.flag
  231. lit.label.cont:
  232.     call    get.word
  233.     call    chk.word.id.only
  234.     mvi    a,wtp.cnst
  235.     sta    word.type
  236.     call    get.var.sym.tbl.entry
  237.     lhld    ste.address
  238.     lda    length.label.flag
  239.     ora    a
  240.     jz    lit.really.label
  241.     lhld    ste.length
  242.     ;--special check for file, since length not in sym-tbl
  243.     lda    ste.type
  244.     cpi    stet.file
  245.     jnz    lit.really.label
  246.     lxi    h,fcb.rec.buffer + 128    ;rec-mode includes buff in len
  247.     lda    ste.FILE.misc.flag
  248.     ani    FILE.c.flag.rec.mode
  249.     jnz    lit.really.label
  250.     lxi    h,fcb.limit
  251. lit.really.label:
  252.     shld    cnst.value
  253.     lda    ste.type
  254.     cpi    stet.end.tbl
  255.     cz    err.undef.label
  256.         ;---restore sym tbl---
  257.     lxi    h,lllw.ste.save
  258.     lxi    d,symbol.table.entry
  259.     lxi    b,ste.B.type - ste.A.type
  260.     jmp    move.h.2.d.cnt.b
  261. ;
  262. length.label.flag:
  263.     db    0
  264. lllw.ste.save:
  265.     ds    ste.B.type - ste.A.type
  266. ;
  267. ;
  268. ;
  269. ;
  270. word.is.string:
  271.     mvi    c,0    ;length
  272.     mov    b,a    ;save delimiter
  273. get.string.word.lup:
  274.     call    get.src.char
  275.     lda    src.char
  276.     cpi    0dh
  277.     jz    end.string.line
  278.     cmp    b    ;ending delim?
  279.     jz    end.string.word
  280.     cpi    '~'
  281.     jz    string.in.hex
  282. more.string:
  283.     mov    m,a
  284.     inx    h
  285.     inr    c
  286.     jmp    get.string.word.lup
  287. ;
  288. string.in.hex:
  289.     call    get.src.char
  290.     lda    src.char
  291.     cpi    '~'
  292.     jz    more.string
  293. string.hex.lup:
  294.     lda    src.char
  295.     cpi    '~'
  296.     jz    get.string.word.lup
  297.     call    str.hex.chk
  298.     jc    err.inv.cnst
  299.     call    str.hex.cvt
  300.     rlc ! rlc ! rlc ! rlc
  301.     mov    e,a
  302.     call    get.src.char
  303.     lda    src.char
  304.     call    str.hex.chk
  305.     jc    err.inv.cnst
  306.     call    str.hex.cvt
  307.     ora    e
  308.     mov    m,a
  309.     inx    h
  310.     inr    c
  311.     call    get.src.char
  312.     jmp    string.hex.lup
  313. ;
  314. end.string.word:
  315.     call    get.src.char
  316. end.string.line:
  317.     mvi    m,0
  318.     mvi    a,wtp.string
  319.     sta    word.type
  320.     mov    a,c
  321.     sta    word.length
  322.     cpi    3
  323.     rnc
  324.     lhld    word
  325.     shld    cnst.value
  326.     mvi    a,wtp.string + wtp.cnst
  327.     sta    word.type
  328.     ret
  329. ;
  330. ;
  331. str.hex.chk:
  332.     cpi    '0'
  333.     rc
  334.     cpi    '9'+1
  335.     cmc
  336.     rnc
  337.     cpi    'A'
  338.     rc
  339.     cpi    'F' + 1
  340.     cmc
  341.     rnc
  342.     cpi    'a'
  343.     rc
  344.     cpi    'f' + 1
  345.     cmc
  346.     ret
  347. ;
  348. str.hex.cvt:
  349.     sui    '0'
  350.     cpi    10
  351.     rc
  352.     sui    7
  353.     ani    0fh
  354.     ret
  355. ;
  356. ;
  357. ;
  358. word.is.number:
  359.     push    psw
  360.     shld    word.cnst.ptr
  361.     mvi    a,wtp.cnst
  362.     sta    word.type
  363.     pop    psw
  364.     jmp    word.is.cnst.D.entry
  365. ;
  366. ;
  367. word.is.cnst:
  368.     mov    m,a
  369.     inx    h
  370.     shld    word.cnst.ptr
  371.     mvi    a,wtp.cnst
  372.     sta    word.type
  373.     call    get.src.char
  374.     lda    src.char
  375.     call    put.cnst.word.byte
  376.     cpi    'H'
  377.     jz    word.is.cnst.H
  378.     cpi    'h'
  379.     jz    word.is.cnst.H
  380.     cpi    'O'
  381.     jz    word.is.cnst.Q
  382.     cpi    'o'
  383.     jz    word.is.cnst.Q
  384.     cpi    'Q'
  385.     jz    word.is.cnst.Q
  386.     cpi    'q'
  387.     jz    word.is.cnst.Q
  388.     cpi    'D'
  389.     jz    word.is.cnst.D
  390.     cpi    'd'
  391.     jz    word.is.cnst.D
  392.     cpi    'B'
  393.     jz    word.is.cnst.B
  394.     cpi    'b'
  395.     jz    word.is.cnst.B
  396. ;
  397.     lxi    h,em.inv.cnst
  398.     jmp    print.error
  399. ;
  400. ;
  401. word.is.cnst.H:
  402.     call    get.src.char
  403.     lda    src.char
  404.     call    put.cnst.word.byte
  405.     cpi    '0'
  406.     jc    word.is.cnst.end
  407.     cpi    '9'+1
  408.     jc    word.is.cnst.H.ok
  409.     cpi    'A'
  410.     jc    word.is.cnst.end
  411.     cpi    'F'+1
  412.     jc    word.is.cnst.H.ltr
  413.     cpi    'a'
  414.     jc    word.is.cnst.end
  415.     cpi    'f'+1
  416.     jnc    word.is.cnst.end
  417. word.is.cnst.H.ltr:
  418.     sui    7
  419. word.is.cnst.H.ok:
  420.     mvi    c,4
  421.     call    shl.value.add.a
  422.     jmp    word.is.cnst.H
  423. ;
  424. ;
  425. word.is.cnst.Q:
  426.     call    get.src.char
  427.     lda    src.char
  428.     call    put.cnst.word.byte
  429.     cpi    '0'
  430.     jc    word.is.cnst.end
  431.     cpi    '7'+1
  432.     jnc    word.is.cnst.end
  433.     mvi    c,3
  434.     call    shl.value.add.a
  435.     jmp    word.is.cnst.Q
  436. ;
  437. ;
  438. word.is.cnst.B:
  439.     call    get.src.char
  440.     lda    src.char
  441.     call    put.cnst.word.byte
  442.     cpi    '0'
  443.     jc    word.is.cnst.end
  444.     cpi    '1'+1
  445.     jnc    word.is.cnst.end
  446.     mvi    c,1
  447.     call    shl.value.add.a
  448.     jmp    word.is.cnst.B
  449. ;
  450. ;
  451. word.is.cnst.D:
  452.     call    get.src.char
  453.     lda    src.char
  454. word.is.cnst.D.entry:
  455.     cpi    '0'
  456.     jc    word.is.cnst.end
  457.     cpi    '9'+1
  458.     jnc    word.is.cnst.end
  459.     call    put.cnst.word.byte
  460.     push    psw
  461.     lhld    cnst.value
  462.     shld    cnst.value.save
  463.     lhld    cnst.value + 2
  464.     shld    cnst.value.save + 2
  465.     mvi    a,'0'
  466.     mvi    c,2
  467.     call    shl.value.add.a
  468. ;
  469.     lhld    cnst.value.save
  470.     xchg
  471.     lhld    cnst.value
  472.     dad    d
  473.     shld    cnst.value
  474. ;
  475.     lhld    cnst.value.save + 2
  476.     xchg
  477.     lhld    cnst.value + 2
  478.     mvi    a,0
  479.     adc    l
  480.     mov    l,a
  481.     mvi    a,0
  482.     adc    h
  483.     mov    h,a
  484.     dad    d
  485.     shld    cnst.value + 2
  486.     pop    psw
  487.     mvi    c,1
  488.     call    shl.value.add.a
  489.     jmp    word.is.cnst.D
  490. ;
  491. ;
  492. word.is.cnst.end:
  493.     lda    minus.word.flag
  494.     ora    a
  495.     jz    word.cnst.end.plus
  496. ;
  497.     lhld    cnst.value
  498.     call    negate.hl
  499.     shld    cnst.value
  500. word.cnst.end.plus:
  501.     xra    a
  502. ;
  503. ;
  504. ;
  505. put.cnst.word.byte:
  506.     push    h
  507.     lhld    word.cnst.ptr
  508.     mov    m,a
  509.     inx    h
  510.     shld    word.cnst.ptr
  511.     lxi    h,word.length
  512.     inr    m
  513.     pop    h
  514.     ret
  515. ;
  516. ;
  517. ;
  518. ;
  519. cnst.paren:
  520.     call    get.src.char
  521.     call    get.word
  522.     lda    word.type
  523.     ani    wtp.cnst
  524.     jz    err.inv.cnst
  525. ;
  526.     lhld    cnst.value
  527.     push    h
  528.     call    get.word
  529.     pop    h
  530. ;
  531. cnst.paren.chk.rpar:
  532.     lda    rsvd.wd.ix
  533.     cpi    rwix.rpar
  534.     jnz    cnst.paren.not.rpar
  535.     shld    cnst.value
  536.     mvi    a,wtp.cnst
  537.     sta    word.type
  538.     ret
  539. ;
  540. cnst.paren.not.rpar:
  541.     push    h
  542.     lda    word.type
  543.     ani    wtp.oprtr
  544.     jnz    cnst.paren.got.oprtr
  545.     lda    word.type
  546.     ani    wtp.cnst
  547.     pop    h
  548.     jz    err.inv.cnst
  549.     push    h
  550.     mvi    a,rwix.plus
  551.     push    psw
  552.     jmp    cnst.paren.dflt
  553. ;
  554. cnst.paren.got.oprtr:
  555.     lda    rsvd.wd.ix
  556.     push    psw
  557.     call    get.word
  558. cnst.paren.dflt:
  559.     lda    word.type
  560.     ani    wtp.cnst
  561.     pop    h
  562.     pop    d
  563.     jz    err.inv.cnst
  564.     push    d
  565.     push    h
  566.     lhld    cnst.value
  567.     push    h
  568.     call    get.word
  569.     pop    d
  570.     pop    psw
  571.     pop    h
  572. ;
  573.     cpi    rwix.plus
  574.     jz    cnst.paren.plus
  575.     cpi    rwix.minus
  576.     jz    cnst.paren.minus
  577.     cpi    rwix.star
  578.     jz    cnst.paren.star
  579.     cpi    rwix.slash
  580.     jz    cnst.paren.slash
  581.     cpi    rwix.AND
  582.     jz    cnst.paren.AND
  583.     cpi    rwix.OR
  584.     jz    cnst.paren.OR
  585.     cpi    rwix.XOR
  586.     jz    cnst.paren.XOR
  587.     cpi    rwix.MAX
  588.     jz    cnst.paren.MAX
  589.     cpi    rwix.MIN
  590.     jz    cnst.paren.MIN
  591.     cpi    rwix.MOD
  592.     jz    cnst.paren.MOD
  593.     jmp    err.inv.cnst
  594. ;
  595. cnst.paren.plus:
  596.     dad    d
  597.     jmp    cnst.paren.chk.rpar
  598. ;
  599. cnst.paren.minus:
  600.     call    sub.de.fm.hl.2.hl
  601.     jmp    cnst.paren.chk.rpar
  602. ;
  603. cnst.paren.star:
  604.     call    mul.h.by.d.2.h
  605.     jmp    cnst.paren.chk.rpar
  606. ;
  607. cnst.paren.slash:
  608.     xchg
  609.     call    div.d.by.h.2.d.r.h
  610.     xchg
  611.     jmp    cnst.paren.chk.rpar
  612. ;
  613. cnst.paren.MAX:
  614.     call    cmp.de.fm.hl
  615.     jnc    cnst.paren.chk.rpar
  616.     xchg
  617.     jmp    cnst.paren.chk.rpar
  618. ;
  619. cnst.paren.MIN:
  620.     call    cmp.de.fm.hl
  621.     jc    cnst.paren.chk.rpar
  622.     xchg
  623.     jmp    cnst.paren.chk.rpar
  624. ;
  625. cnst.paren.MOD:
  626.     xchg
  627.     call    div.d.by.h.2.d.r.h
  628.     jmp    cnst.paren.chk.rpar
  629. ;
  630. cnst.paren.AND:
  631.     call    AND.d.and.h
  632.     jmp    cnst.paren.chk.rpar
  633. ;
  634. cnst.paren.OR:
  635.     call    OR.d.and.h
  636.     jmp    cnst.paren.chk.rpar
  637. ;
  638. cnst.paren.XOR:
  639.     call    XOR.d.and.h
  640.     jmp    cnst.paren.chk.rpar
  641. ;
  642. ;
  643. ;
  644. ;
  645. ;
  646. ;
  647. ;
  648. shl.value.add.a:
  649.     push    psw
  650. svaa.lup:
  651.     ora    a
  652.     lxi    h,cnst.value
  653.     mov    a,m
  654.     ral
  655.     mov    m,a
  656.     inx    h
  657.     mov    a,m
  658.     ral
  659.     mov    m,a
  660.     inx    h
  661.     mov    a,m
  662.     ral
  663.     mov    m,a
  664.     inx    h
  665.     mov    a,m
  666.     ral
  667.     mov    m,a
  668.     dcr    c
  669.     jnz    svaa.lup
  670.     pop    psw
  671.     ani    0fh
  672.     lxi    h,cnst.value
  673.     add    m
  674.     mov    m,a
  675.     inx    h
  676.     mvi    a,0
  677.     adc    m
  678.     mov    m,a
  679.     inx    h
  680.     mvi    a,0
  681.     adc    m
  682.     mov    m,a
  683.     inx    h
  684.     mvi    a,0
  685.     adc    m
  686.     mov    m,a
  687.     ret
  688. ;
  689. ;
  690. ;
  691. ;
  692. ;
  693. ;
  694. ;
  695. ;
  696. ;
  697. ;---alpha word (identifier)
  698. ;---must start with letter
  699. ;---may contain 0-9,A-Z,a-z,`,_,.
  700. ;
  701. word.is.alpha:
  702.     mov    m,a
  703.     inx    h
  704.     mvi    c,1
  705. alpha.word.lup:
  706.     call    get.src.char
  707.     lda    src.char
  708.     cpi    '.'
  709.     jz    more.alpha.word
  710.     cpi    '0'
  711.     jc    end.alpha.word
  712.     cpi    '9'+1
  713.     jc    more.alpha.word
  714.     cpi    'A'
  715.     jc    end.alpha.word
  716.     cpi    'Z'+1
  717.     jc    more.alpha.word
  718.     cpi    '_'
  719.     jc    end.alpha.word
  720.     cpi    'z'+1
  721.     jc    more.alpha.word
  722. end.alpha.word:
  723.     mvi    m,0
  724.     mov    a,c
  725.     sta    word.length
  726.     jmp    get.word.type
  727. more.alpha.word:
  728.     mov    m,a
  729.     inx    h
  730.     inr    c
  731.     jmp    alpha.word.lup
  732. ;
  733. ;
  734. ;
  735. ;
  736. ;
  737. get.word.type:
  738.     call    lookup.reserved.word
  739. ;
  740.     lda    rsvd.wd.ix
  741.     cpi    rwix.TRUE
  742.     jz    gwt.TRUE
  743.     cpi    rwix.FALSE
  744.     jz    gwt.FALSE
  745.     ora    a
  746.     jz    gwt.lukup.rsvd
  747.     lda    limit.word.flag
  748.     ora    a
  749.     rnz        ;don't lookup rvsd-wd in sym-tbl
  750. gwt.lukup.rsvd:
  751. ;
  752.     call    lookup.word
  753.     lhld    wk.sym.tbl.addr
  754.     mov    a,m
  755.     cpi    stet.SET.cnst
  756.     jz    gwt.cnst
  757.     cpi    stet.SET.word
  758.     jz    gwt.word.SET
  759. ;
  760.     lda    word.type
  761.     cpi    wtp.unreq
  762.     rnz
  763. ;
  764.     mvi    a,wtp.ident
  765.     sta    word.type
  766.     ret
  767. ;
  768. ;
  769. gwt.word.SET:
  770.     lxi    d,ste.address - ste.type + 1
  771.     dad    d
  772.     mov    a,m
  773.     sta    word.type
  774.     dcx    h
  775.     mov    a,m
  776.     sta    rsvd.wd.ix
  777.     cpi    rwix.NULL
  778.     jz    get.word
  779.     ret
  780. ;
  781. ;
  782. gwt.TRUE:
  783.     mvi    a,wtp.ident + wtp.cnst
  784.     sta    word.type
  785.     lxi    h,0ffffh
  786.     shld    cnst.value
  787.     jmp    gwt.T.F.move.word
  788. ;
  789. ;
  790. gwt.FALSE:
  791.     mvi    a,wtp.ident + wtp.cnst
  792.     sta    word.type
  793.     lxi    h,0
  794.     shld    cnst.value
  795. gwt.T.F.move.word:
  796.     lxi    h,ste.name
  797.     lxi    d,word
  798.     call    move.string
  799.     lda    ste.length
  800.     sta    word.length
  801.     ret
  802.     jmp    gwt.set.word
  803. ;
  804. ;
  805. ;
  806. gwt.cnst:
  807.     mvi    a,wtp.cnst + wtp.string
  808.     sta    word.type
  809.     lhld    wk.sym.tbl.addr
  810.     lxi    d,ste.address - ste.type
  811.     dad    d
  812.     mov    e,m
  813.     inx    h
  814.     mov    d,m
  815.     xchg
  816.     shld    cnst.value
  817.     shld    word
  818.     xra    a
  819.     sta    word + 2
  820.     ret
  821. ;
  822. ;
  823. gwt.set.word:
  824.     lxi    h,ste.name
  825.     lxi    d,word
  826.     call    move.string
  827.     lda    ste.length
  828.     sta    word.length
  829. ;
  830.     cpi    3
  831.     rnc
  832. ;
  833.     lhld    word
  834.     shld    cnst.value
  835.     mvi    a,wtp.string + wtp.cnst
  836.     sta    word.type
  837.     ret
  838. ;
  839. ;
  840. ;
  841. chk.word.id.only:
  842.     lda    word.type
  843.     ani    wtp.ident
  844.     rnz
  845.     jmp    err.expect.id
  846. ;
  847. ;
  848. ;
  849. chk.not.blk.ender:
  850.     lda    rsvd.wd.ix
  851.     cpi    rwix.ELSE
  852.     rz
  853.     cpi    rwix.END
  854.     rz
  855.     cpi    rwix.ENDREC
  856.     rz
  857.     cpi    rwix.ENDREDEF
  858.     rz
  859.     cpi    rwix.ENDSWITCH
  860.     rz
  861.     cpi    rwix.end.of.source
  862.     rz
  863.     cpi    rwix.FI
  864.     rz
  865.     cpi    rwix.OD
  866.     rz
  867.     cpi    rwix.UNTIL
  868.     ret
  869. ;
  870. ;
  871. ;
  872. ;
  873. ;
  874. ;-----------------------------------------------
  875. ;
  876. ;        R E S E R V E D    W O R D
  877. ;        L O O K U P
  878. ;
  879. ;-----------------------------------------------
  880. ;
  881. ;
  882. ;
  883. ;
  884. ;
  885. ;---if word has any upper-case letters in it,
  886. ;---convert it to lower-case and check for a
  887. ;---match in reserved-word table.
  888. ;
  889. lookup.reserved.word:
  890.     lxi    h,word
  891.     lxi    d,word.save
  892.     call    move.string
  893.     lxi    h,word
  894.     call    cvt.str.to.lower.case
  895.     call    do.rsvd.lukup
  896.     lxi    h,word.save
  897.     lxi    d,word
  898.     jmp    move.string
  899. ;
  900. ;
  901. ;
  902. do.rsvd.lukup:
  903.     mvi    a,wtp.unreq
  904.     sta    word.type
  905.     mvi    a,rwix.not.rsvd
  906.     sta    rsvd.wd.ix
  907.     mvi    c,0    ;ix ctr
  908.     lxi    h,reserved.word.table
  909. drl.nxt.word:
  910.     inr    c
  911.     lxi    d,word
  912.     mov    a,m
  913.     ora    a
  914.     rz        ;end of table - not found
  915. drl.nxt.char:
  916.     ldax    d
  917.     cmp    m
  918.     jnz    drl.skip.word
  919.     inx    h
  920.     inx    d
  921.     ora    a
  922.     jnz    drl.nxt.char
  923. ;---found match---
  924.     mov    a,c
  925.     sta    rsvd.wd.ix
  926.     mov    a,m
  927.     sta    word.type
  928.     ret
  929. ;
  930. drl.skip.word:
  931.     mov    a,m
  932.     ora    a
  933.     jz    drl.skip.tween
  934.     inx    h
  935.     jmp    drl.skip.word
  936. ;
  937. drl.skip.tween:
  938.     inx    h
  939.     inx    h
  940.     jmp    drl.nxt.word
  941. ;
  942. ;----------------------------------
  943. ;
  944. switch.A:
  945.     lda    ste.A.type
  946.     jmp    switch
  947. ;
  948. switch.B:
  949.     lda    ste.B.type
  950.     jmp    switch
  951. ;
  952. switch.C:
  953.     lda    ste.C.type
  954.     jmp    switch
  955. ;
  956. switch.rsvd.wd.ix:
  957.     lda    rsvd.wd.ix
  958.     jmp    switch
  959. ;
  960. switch.expr.oprtr:
  961.     lda    curr.expr.oprtr
  962. switch:
  963.     xthl
  964.     push    psw
  965.     push    b
  966.     mov    c,a
  967. switch.lup:
  968.     mov    a,m
  969.     inx    h
  970.     ora    a
  971.     jz    switch.match
  972.     cmp    c
  973.     jz    switch.match
  974.     inx    h
  975.     inx    h
  976.     jmp    switch.lup
  977. ;
  978. switch.match:
  979.     mov    a,m
  980.     inx    h
  981.     mov    h,m
  982.     mov    l,a
  983.     pop    b
  984.     pop    psw
  985.     xthl
  986.     ret
  987. ;
  988. ;
  989. ;----------------------------------------
  990. ;
  991. compare.sym.tbl.entries:
  992.     mvi    c,ste.name - symbol.table.entry
  993. cste.lup:
  994.     ldax    d
  995.     cmp    m
  996.     rnz
  997.     inx    h
  998.     inx    d
  999.     dcr    c
  1000.     jnz    cste.lup
  1001.     jmp    compare.strings
  1002. ;
  1003. ;---------------------------------------
  1004. ;
  1005. ;
  1006. get.var.A.word:
  1007.     call    get.var.sym.tbl.entry
  1008.     lda    word.type
  1009.     sta    A.word.type
  1010.     sta    gvx.word.type
  1011.     lhld    cnst.value
  1012.     shld    gvx.cnst.value
  1013.     lxi    h,word
  1014.     lxi    d,gvx.word
  1015.     call    move.string
  1016.     call    get.word
  1017.     lda    rsvd.wd.ix
  1018.     cpi    rwix.lbrckt
  1019.     cz    gvx.override
  1020.     lxi    d,sym.tbl.entry.A
  1021.     lda    A.word.type
  1022.     jmp    gvx.mv.sym
  1023. ;
  1024. ;
  1025. get.var.B.word:
  1026.     call    get.var.sym.tbl.entry
  1027.     lda    word.type
  1028.     sta    B.word.type
  1029.     sta    gvx.word.type
  1030.     lhld    cnst.value
  1031.     shld    gvx.cnst.value
  1032.     lxi    h,word
  1033.     lxi    d,gvx.word
  1034.     call    move.string
  1035.     call    get.word
  1036.     lda    rsvd.wd.ix
  1037.     cpi    rwix.lbrckt
  1038.     cz    gvx.override
  1039.     lxi    d,sym.tbl.entry.B
  1040.     lda    B.word.type
  1041.     jmp    gvx.mv.sym
  1042. ;
  1043. ;
  1044. get.var.C.word:
  1045.     call    get.var.sym.tbl.entry
  1046.     lda    word.type
  1047.     sta    C.word.type
  1048.     sta    gvx.word.type
  1049.     lhld    cnst.value
  1050.     shld    gvx.cnst.value
  1051.     lxi    h,word
  1052.     lxi    d,gvx.word
  1053.     call    move.string
  1054.     call    get.word
  1055.     lda    rsvd.wd.ix
  1056.     cpi    rwix.lbrckt
  1057.     cz    gvx.override
  1058.     lxi    d,sym.tbl.entry.C
  1059.     lda    C.word.type
  1060. ;
  1061. ;
  1062. gvx.mv.sym:
  1063.     sta    gvx.word.type
  1064.     lxi    h,symbol.table.entry
  1065.     push    d
  1066.     call    move.sym.tbl.entry
  1067.     pop    d
  1068.     lda    gvx.word.type
  1069.     ani    wtp.cnst
  1070.     jz    gvx.not.cnst
  1071. ;
  1072.     mvi    a,stet.spcl.cnst
  1073.     stax    d
  1074.     push    d
  1075.     lxi    h,(ste.address - symbol.table.entry)
  1076.     dad    d
  1077.     xchg
  1078.     lhld    gvx.cnst.value
  1079.     shld    cnst.value
  1080.     xchg
  1081.     mov    m,e
  1082.     inx    h
  1083.     mov    m,d
  1084.     pop    d
  1085.     jmp    gvx.move.word
  1086. ;
  1087. gvx.not.cnst:
  1088.     lda    gvx.word.type
  1089.     ani    wtp.string
  1090.     jz    gvx.not.lit.str
  1091. ;
  1092.     mvi    a,stet.spcl.lit.str
  1093.     stax    d
  1094. ;
  1095. gvx.move.word:
  1096.     push    d
  1097.     lxi    h,(ste.name - symbol.table.entry)
  1098.     dad    d
  1099.     xchg
  1100.     lxi    h,gvx.word
  1101.     call    move.string
  1102.     lxi    d,gvx.word
  1103.     call    sub.de.fm.hl.2.hl
  1104.     xchg
  1105.     pop    b
  1106.     lxi    h,(ste.length - symbol.table.entry)
  1107.     dad    b
  1108.     mov    m,e
  1109.     inx    h
  1110.     mov    m,d
  1111.     ret
  1112. ;
  1113. gvx.not.lit.str:
  1114.     lda    gvx.word.type
  1115.     ani    wtp.ptr
  1116.     jz    gvx.not.ptr
  1117. ;
  1118.     ldax    d
  1119.     cpi    stet.word.ptr
  1120.     jz    gvx.WP
  1121.     cpi    stet.byte.ptr
  1122.     jz    gvx.BP
  1123.     cpi    stet.string.ptr
  1124.     jz    gvx.SP
  1125.     cpi    stet.BCD.ptr
  1126.     jz    gvx.BCDPTR
  1127.     jmp    err.inv.ptr.var
  1128. ;
  1129. gvx.SP:
  1130.     mvi    a,stet.spcl.string.ptr
  1131.     stax    d
  1132.     ret
  1133. ;
  1134. gvx.BP:
  1135.     mvi    a,stet.spcl.byte.ptr
  1136.     stax    d
  1137.     ret
  1138. ;
  1139. gvx.WP:
  1140.     mvi    a,stet.spcl.word.ptr
  1141.     stax    d
  1142.     ret
  1143. ;
  1144. gvx.BCDPTR:
  1145.     mvi    a,stet.spcl.bcd.ptr
  1146.     stax    d
  1147.     ret
  1148. ;
  1149. ;
  1150. gvx.not.ptr:
  1151.     push    d
  1152.     lxi    d,gvx.word
  1153.     call    lookup.word.at.d
  1154.     pop    d
  1155.     lhld    wk.sym.tbl.addr
  1156.     mov    a,m
  1157.     call    switch
  1158.     db stet.SET.cnst    ! dw gvx.SET.cnst
  1159.     db stet.byte.ptr    ! dw gvx.make.WORD
  1160.     db stet.word.ptr    ! dw gvx.make.WORD
  1161.     db stet.string.ptr    ! dw gvx.make.WORD
  1162.     db stet.BCD.ptr        ! dw gvx.make.WORD
  1163.     db 0            ! dw gvx.not.ptr.exit
  1164. gvx.not.ptr.exit:
  1165.     ret
  1166. ;
  1167. gvx.SET.cnst:
  1168.     mvi    a,stet.spcl.cnst
  1169.     stax    d
  1170.     lxi    h,(ste.address - symbol.table.entry)
  1171.     dad    d
  1172.     mov    e,m
  1173.     inx    h
  1174.     mov    d,m
  1175.     xchg
  1176.     shld    cnst.value
  1177.     ret
  1178. ;
  1179. gvx.make.WORD:
  1180.     mvi    a,stet.WORD
  1181.     stax    d
  1182.     ret
  1183. ;
  1184. ;
  1185. ;
  1186. ;-----------------------------------------------
  1187. ;   process variable-name overrides
  1188. ;-----------------------------------------------
  1189. ;
  1190. gvx.override:
  1191.     lda    word.type
  1192.     ani    wtp.cnst + wtp.string
  1193.     jnz    gvx.override.lup
  1194.     lda    ste.type
  1195.     cpi    stet.end.tbl
  1196.     cz    err.undef.var
  1197. gvx.override.lup:
  1198.     call    get.word
  1199.     lda    word.type
  1200.     ani    wtp.cnst
  1201.     jnz    gvxo.offset
  1202. ;
  1203.     call    switch.rsvd.wd.ix
  1204.     db rwix.comma    ! dw gvx.override.lup
  1205.     db rwix.plus    ! dw gvxo.plus
  1206.     db rwix.minus    ! dw gvxo.minus
  1207.     db rwix.BCD    ! dw gvxo.BCD
  1208.     db rwix.BCDPTR    ! dw gvxo.BCDP
  1209.     db rwix.BIT    ! dw gvxo.BIT
  1210.     db rwix.BP    ! dw gvxo.BP
  1211.     db rwix.WORD    ! dw gvxo.WORD
  1212.     db rwix.BYTE    ! dw gvxo.BYTE
  1213.     db rwix.FIELD    ! dw gvxo.FIELD
  1214.     db rwix.LENGTH    ! dw gvxo.LENGTH
  1215.     db rwix.RECORD    ! dw gvxo.RECORD
  1216.     db rwix.SP    ! dw gvxo.SP
  1217.     db rwix.STRING    ! dw gvxo.STRING
  1218.     db rwix.WP    ! dw gvxo.WP
  1219.     db rwix.rbrckt    ! dw gvxo.rbrckt
  1220.     db    0    ! dw err.inv.override
  1221. gvxo.rbrckt:
  1222.     call    get.word
  1223.     lda    rsvd.wd.ix
  1224.     cpi    rwix.lbrckt
  1225.     jz    gvx.override.lup
  1226.     ret
  1227. ;
  1228. ;
  1229. gvxo.plus:
  1230.     call    get.word
  1231.     lda    word.type
  1232.     ani    wtp.cnst
  1233.     jz    err.inv.cnst
  1234. gvxo.offset:
  1235.     lhld    cnst.value
  1236.     xchg
  1237.     lhld    ste.address
  1238.     dad    d
  1239.     shld    ste.address
  1240.     lda    ste.type
  1241.     call    switch
  1242.     db stet.RECORD    ! dw gvxo.offset.length
  1243.     db stet.FIELD    ! dw gvxo.offset.length
  1244.     db stet.STRING    ! dw gvxo.offset.length
  1245.     db    0    ! dw gvx.override.lup
  1246. ;
  1247. gvxo.offset.length:
  1248.     lhld    cnst.value
  1249.     call    negate.HL
  1250.     xchg
  1251.     lhld    ste.length
  1252.     dad    d
  1253.     shld    ste.length
  1254.     jmp    gvx.override.lup
  1255. ;
  1256. ;
  1257. gvxo.minus:
  1258.     call    get.word
  1259.     lda    word.type
  1260.     ani    wtp.cnst
  1261.     jz    err.inv.cnst
  1262.     lhld    cnst.value
  1263.     call    negate.HL
  1264.     shld    cnst.value
  1265.     jmp    gvxo.offset
  1266. ;
  1267. ;
  1268. gvxo.BCD:
  1269.     mvi    a,stet.BCD
  1270.     jmp    gvxo.general.type
  1271. ;
  1272. ;
  1273. gvxo.BCDP:
  1274.     mvi    a,stet.BCD.ptr
  1275.     jmp    gvxo.general.pointer
  1276. ;
  1277. ;
  1278. gvxo.BIT:
  1279.     call    get.word
  1280.     lda    rsvd.wd.ix
  1281.     cpi    rwix.colon
  1282.     cz    get.word
  1283.     lda    word.type
  1284.     ani    wtp.cnst
  1285.     jz    err.inv.cnst
  1286. ;
  1287.     mvi    a,stet.BIT
  1288.     sta    ste.type
  1289.     lda    cnst.value
  1290.     sta    ste.BIT.posn
  1291.     jmp    gvx.override.lup
  1292. ;
  1293. ;
  1294. gvxo.BP:
  1295.     mvi    a,stet.byte.ptr
  1296. gvxo.general.pointer:
  1297.     sta    ste.type
  1298.     lda    gvx.word.type
  1299.     ani    wtp.ptr
  1300.     cz    err.inv.override
  1301.     jmp    gvx.override.lup
  1302. ;
  1303. ;
  1304. gvxo.BYTE:
  1305.     mvi    a,stet.BYTE
  1306. gvxo.general.type:
  1307.     sta    ste.type
  1308.     lda    gvx.word.type
  1309.     ani    wtp.ptr
  1310.     cnz    err.inv.override
  1311.     jmp    gvx.override.lup
  1312. ;
  1313. ;
  1314. gvxo.LENGTH:
  1315.     call    get.word
  1316.     lda    word.type
  1317.     ani    wtp.cnst
  1318.     jz    err.inv.override
  1319.     lhld    cnst.value
  1320.     shld    ste.length
  1321.     jmp    gvx.override.lup
  1322. ;
  1323. ;
  1324. gvxo.RECORD:
  1325.     mvi    a,stet.RECORD
  1326.     jmp    gvxo.general.type
  1327. ;
  1328. ;
  1329. gvxo.SP:
  1330.     mvi    a,stet.string.ptr
  1331.     jmp    gvxo.general.pointer
  1332. ;
  1333. ;
  1334. gvxo.STRING:
  1335.     mvi    a,stet.STRING
  1336.     jmp    gvxo.general.type
  1337. ;
  1338. ;
  1339. gvxo.WORD:
  1340.     mvi    a,stet.WORD
  1341.     jmp    gvxo.general.type
  1342. ;
  1343. ;
  1344. gvxo.WP:
  1345.     mvi    a,stet.word.ptr
  1346.     jmp    gvxo.general.pointer
  1347. ;
  1348. ;
  1349. gvxo.FIELD:
  1350.     mvi    a,stet.FIELD
  1351.     jmp    gvxo.general.type
  1352. ;
  1353. ;
  1354. ;
  1355. ;
  1356. ;
  1357. ;
  1358. ;--------------------------------------------------
  1359. ;-------------get symbol-table entry for word-------
  1360. ;--------------------------------------------------
  1361. ;
  1362. get.var.sym.tbl.entry:
  1363.     lhld    start.sym.tbl.addr
  1364. gvste.sym.entry.lup:
  1365.     shld    wk.sym.tbl.addr
  1366.     mov    a,m
  1367.     cpi    stet.end.tbl
  1368.     jz    get.sym.tbl.entry    ;not found
  1369.     lxi    b,(ste.name - symbol.table.entry)
  1370.     dad    b
  1371.     cpi    stet.deleted
  1372.     jnc    gvste.skip.sym.lup
  1373.     cpi    stet.fwd.ref
  1374.     jz    gvste.skip.sym.lup
  1375.     push    h
  1376.     lxi    d,word
  1377.     call    compare.strings
  1378.     pop    h
  1379.     jz    get.sym.tbl.entry    ;found -- move to w/a
  1380. gvste.skip.sym.lup:
  1381.     mov    a,m
  1382.     inx    h
  1383.     ora    a
  1384.     jnz    gvste.skip.sym.lup
  1385.     jmp    gvste.sym.entry.lup
  1386. ;
  1387. ;----------------------------------
  1388. ;
  1389. chk.word.not.in.tbl:
  1390.     call    get.var.sym.tbl.entry
  1391.     lda    ste.type
  1392.     cpi    stet.end.tbl
  1393.     rz
  1394.     lxi    h,ste.block.level
  1395.     lda    curr.block.level
  1396.     cmp    m
  1397.     rnz
  1398.     jmp    err.dupl.name
  1399. ;
  1400. ;
  1401. ;
  1402. ;
  1403. ;
  1404. ;
  1405. ;
  1406. ;---lookup word in symbol table---
  1407. ;
  1408. ; in:    word
  1409. ;
  1410. ; out:    wk.sym.tbl.addr
  1411. ;
  1412. ;
  1413. lookup.word:
  1414.     lxi    d,word
  1415. lookup.word.at.d:
  1416.     lhld    start.sym.tbl.addr
  1417. lkp.sym.entry.lup:
  1418.     shld    wk.sym.tbl.addr
  1419.     mov    a,m
  1420.     cpi    stet.end.tbl
  1421.     rz        ;---not found
  1422.     lxi    b,(ste.name - symbol.table.entry)
  1423.     dad    b
  1424.     push    d
  1425.     push    h
  1426.     call    compare.strings
  1427.     pop    h
  1428.     pop    d
  1429.     rz
  1430. lkp.skip.sym.lup:
  1431.     mov    a,m
  1432.     inx    h
  1433.     ora    a
  1434.     jnz    lkp.skip.sym.lup
  1435.     jmp    lkp.sym.entry.lup
  1436. ;
  1437. ;
  1438. ;----get backwards symbol table entry-----
  1439. ;  (used for symbol table cleanup at block-end)
  1440. ;    returns symbol table entries in reverse order
  1441. ;    skips deleted entries
  1442. ;
  1443. ; in:    prev.sym.tbl.addr
  1444. ;    start.sym.tbl.addr
  1445. ;    wk.sym.tbl.addr
  1446. ;    start.wk.sym.tbl.addr
  1447. ;
  1448. ; out:    prev.sym.tbl.addr
  1449. ;    Carry = 1 indicates no more
  1450. ;
  1451. get.backwards:
  1452.     lhld    prev.sym.tbl.addr
  1453.     xchg
  1454.     lhld    start.sym.tbl.addr
  1455.     call    cmp.de.fm.hl
  1456.     jz    get.backwards.finish
  1457. ;
  1458.     call    init.sym.tbl.srch
  1459. get.backwards.lup:
  1460.     lhld    prev.sym.tbl.addr
  1461.     xchg
  1462.     lhld    wk.sym.tbl.addr
  1463.     call    cmp.de.fm.hl
  1464.     jnc    get.backwards.endloop
  1465. ;
  1466.     call    get.sym.tbl.entry
  1467.     jmp    get.backwards.lup
  1468. ;
  1469. get.backwards.endloop:
  1470.     lhld    start.wk.sym.tbl.addr
  1471.     shld    prev.sym.tbl.addr
  1472.     ora    a
  1473.     ret
  1474. ;
  1475. get.backwards.finish:
  1476.     stc
  1477.     ret
  1478. ;
  1479. ;;
  1480. ;
  1481. ;---squish symbol table-----
  1482. ;
  1483. ;    called at end-of-block to clean-up symbol table
  1484. ;    removes local data from previous block, and
  1485. ;    temporary labels, &c. generated by the compiler
  1486. ;
  1487. squish.sym.tbl:
  1488.     lda    curr.block.level
  1489.     ora    a
  1490.     rz        ;skip final squish
  1491.     call    init.sym.tbl.srch
  1492. squish.get.start:
  1493.     call    get.sym.tbl.entry
  1494.     lda    ste.type
  1495.     cpi    stet.end.tbl
  1496.     rz
  1497. ;
  1498.     lda    ste.block.level
  1499.     mov    c,a
  1500.     lda    curr.block.level
  1501.     cmp    c
  1502.     jc    squish.get.start
  1503. ;
  1504.     lhld    start.wk.sym.tbl.addr
  1505.     shld    prev.sym.tbl.addr
  1506.     shld    curr.sym.tbl.bottom
  1507. ;
  1508. squish.lup:
  1509.     call    get.backwards
  1510.     jc    squish.finished
  1511. ;
  1512.     lda    ste.type
  1513.     cpi    stet.deleted
  1514.     jnc    squish.lup
  1515. ;
  1516.     lhld    start.wk.sym.tbl.addr
  1517.     lxi    d,ste.name - ste.type
  1518.     dad    d
  1519.     xchg
  1520.     call    size.d.2.h
  1521.     lxi    b,ste.name - ste.type
  1522.     dad    b
  1523.     inx    h    ;past terminator
  1524.     inx    d
  1525.     mov    b,h
  1526.     mov    c,l
  1527.     lhld    curr.sym.tbl.bottom
  1528.     xchg
  1529.     call    move.bkwds.h.2.d.cnt.b
  1530.     xchg
  1531.     shld    curr.sym.tbl.bottom
  1532.     jmp    squish.lup
  1533. ;
  1534. squish.finished:
  1535.     lhld    curr.sym.tbl.bottom
  1536.     shld    start.sym.tbl.addr
  1537.     ret
  1538. ;
  1539. ;
  1540. ;
  1541. ;
  1542. ;
  1543. ;
  1544. ;----------------------------------------------------
  1545. ;
  1546. ;    M I S C.   C O D E - G E N E R A T I O N
  1547. ;    S U P P O R T   R O U T I N E S
  1548. ;
  1549. ;----------------------------------------------------
  1550. ;
  1551. ;
  1552. ;
  1553. chk.strt.data:
  1554.     lda    redef.ctr
  1555.     ora    a
  1556.     jnz    csd.fini
  1557. ;
  1558.     lda    data.started.this.blk
  1559.     ora    a
  1560.     jnz    csd.fini
  1561.     mvi    a,0ffh
  1562.     sta    data.started.this.blk
  1563.     lda    code.started.this.blk
  1564.     ora    a
  1565.     jz    csd.data.ok
  1566.     call    err.data.after.code
  1567.     jmp    csd.fini
  1568. csd.data.ok:
  1569.     mvi    a,bir.1st.code
  1570.     call    put.bir.jmp.fwd
  1571.     jmp    csd.new.addr
  1572. csd.fini:
  1573.     lhld    curr.print.addr
  1574.     mov    a,h
  1575.     ora    l
  1576.     rnz
  1577. csd.new.addr:
  1578.     lhld    curr.code.addr
  1579.     shld    curr.print.addr
  1580.     ret
  1581. ;
  1582. ;
  1583. ;
  1584. chk.strt.code:
  1585.     call    set.byte.boundary
  1586.     lda    code.started.this.blk
  1587.     ora    a
  1588.     jnz    csc.fini
  1589.     mvi    a,0ffh
  1590.     sta    code.started.this.blk
  1591.     lda    data.started.this.blk
  1592.     ora    a
  1593.     jz    csc.fini
  1594.     mvi    a,bir.1st.code
  1595.     call    fix.up.built.in.rtn
  1596. csc.fini:
  1597.     lhld    curr.print.addr
  1598.     mov    a,h
  1599.     ora    l
  1600.     rnz
  1601.     lhld    curr.code.addr
  1602.     shld    curr.print.addr
  1603.     ret
  1604. ;
  1605. ;
  1606. ;
  1607. bump.block.level:
  1608.     xra    a
  1609.     sta    ste.name
  1610.     mvi    a,stet.level.marker
  1611.     sta    ste.type
  1612.     lda    curr.block.level
  1613.     sta    ste.block.level
  1614. ;
  1615.     lhld    curr.ovl.start.key
  1616.     lda    overlay.in.process
  1617.     ora    a
  1618.     jnz    bbl.is.ovl
  1619.     lxi    h,0ffffh
  1620. bbl.is.ovl:
  1621.     shld    ste.ovl.key
  1622. ;
  1623.     call    move.entry.to.sym.tbl
  1624.     lxi    h,curr.block.level
  1625.     inr    m
  1626.     ret
  1627. ;
  1628. ;
  1629. ;
  1630. decr.block.level:
  1631.     lxi    h,curr.block.level
  1632.     dcr    m
  1633.     mov    a,m
  1634.     inr    a
  1635.     jnz    decr.bl.delete
  1636.     lxi    h,em.blk.lvl.ofl
  1637.     call    print.error
  1638. ;
  1639. decr.bl.delete:
  1640.     call    init.sym.tbl.srch
  1641. dbd.lup:
  1642.     call    get.sym.tbl.entry
  1643.     lhld    start.wk.sym.tbl.addr
  1644.     lda    ste.type
  1645.     cpi    stet.end.tbl
  1646.     rz
  1647.     cpi    stet.blk.scope.limit
  1648.     jnc    dbd.lup
  1649.     cpi    stet.level.marker
  1650.     jz    dbd.end
  1651.     mov    a,m
  1652.     ori    stet.deleted
  1653.     mov    m,a
  1654.     jmp    dbd.lup
  1655. ;
  1656. dbd.end:
  1657.     mov    a,m
  1658.     ori    stet.deleted
  1659.     mov    m,a
  1660.     ret
  1661. ;
  1662. ;
  1663. ;
  1664. set.byte.boundary:
  1665.     lda    curr.BIT.posn
  1666.     cpi    80h
  1667.     jz    set.byte.bndry.clr
  1668.     mvi    a,80h
  1669.     sta    curr.bit.posn
  1670.     lda    curr.BIT.build
  1671.     call    put.code.byte
  1672. set.byte.bndry.clr:
  1673.     xra    a
  1674.     sta    curr.BIT.build
  1675.     ret
  1676. ;
  1677. ;
  1678. ;
  1679. chk.stk.overflow:
  1680.     lxi    h,0
  1681.     dad    sp
  1682.     lxi    d,base.stk.addr + 10
  1683.     call    cmp.hl.fm.de
  1684.     rc
  1685.     call    err.L.stk.ofl
  1686.     jmp    MAIN.end.pgm
  1687. ;
  1688. ;------------------------------------------------------
  1689. ;        debugging routine
  1690. ;------------------------------------------------------
  1691. ;
  1692. debug.routine:
  1693. ;
  1694.     lda    print.console
  1695.     mov    c,a
  1696.     lda    print.flag
  1697.     mov    b,a
  1698.     push    b
  1699. ;
  1700.     lda    print.printer.flag
  1701.     mov    c,a
  1702.     lda    print.disk.flag
  1703.     mov    b,a
  1704.     push    b
  1705. ;
  1706.     mvi    a,0ffh
  1707.     sta    print.console
  1708.     sta    print.flag
  1709. ;
  1710.     xra    a
  1711.     sta    print.disk.flag
  1712.     lda    dbg.print.flag
  1713.     sta    print.printer.flag
  1714. ;
  1715.     lda    debug.sngl.step.flag
  1716.     ora    a
  1717.     jnz    debug.go
  1718. ;
  1719.     mvi    c,11
  1720.     call    entry
  1721.     ora    a
  1722.     jz    debug.return
  1723. debug.go:
  1724.     call    listing.crlf
  1725.     lxi    d,word
  1726.     call    listing.string.out
  1727. debug.lup:
  1728.     call    listing.crlf
  1729.     lxi    d,debug.prompt
  1730.     call    listing.string.out
  1731.     call    con.ch.in
  1732.     ani    5fh    ;upper case
  1733.     cpi    'E'
  1734.     jz    debug.exit
  1735. ;
  1736.     cpi    03    ;^C
  1737.     jz    boot
  1738.     cpi    'T'
  1739.     jz    debug.sym.tbl
  1740.     cpi    'S'
  1741.     jz    debug.sngl.step
  1742.     cpi    'D'
  1743.     jz    debug.ddt
  1744.     cpi    'P'
  1745.     jz    debug.print
  1746. debug.exit:
  1747.     lhld    err.ctr
  1748.     lxi    d,pst.line.wk
  1749.     call    cvt.bin.2.dec.str
  1750.     call    listing.crlf
  1751.     lxi    d,pst.line.wk
  1752.     call    listing.string.out
  1753.     lxi    d,dbg.txt.err
  1754.     call    listing.string.out
  1755.     lxi    d,last.label
  1756.     call    listing.string.out
  1757.     call    listing.crlf
  1758. ;
  1759. ;
  1760. debug.return:
  1761.     pop    b
  1762.     mov    a,b
  1763.     sta    print.disk.flag
  1764.     mov    a,c
  1765.     sta    print.printer.flag
  1766. ;
  1767.     pop    b
  1768.     mov    a,b
  1769.     sta    print.flag
  1770.     mov    a,c
  1771.     sta    print.console
  1772.     ret
  1773. ;
  1774. dbg.txt.err:    db    ' errors ',0
  1775. ;
  1776. ;
  1777. ;
  1778. ;
  1779. debug.print:
  1780.     lda    dbg.print.flag
  1781.     cma
  1782.     sta    dbg.print.flag
  1783.     sta    print.printer.flag
  1784.     lxi    d,dbg.prt.msg
  1785.     jmp    dbg.off.on
  1786. ;
  1787. ;
  1788. ;
  1789. debug.sngl.step:
  1790.     lda    debug.sngl.step.flag
  1791.     cma
  1792.     sta    debug.sngl.step.flag
  1793.     lxi    d,dbg.sngl.step.msg
  1794. dbg.off.on:
  1795.     push    psw
  1796.     call    listing.string.out
  1797.     pop    psw
  1798.     ora    a
  1799.     jz    dbg.sngl.off
  1800.     lxi    d,dbg.sngl.on.msg
  1801.     jmp    dbg.sngl.msg
  1802. dbg.sngl.off:
  1803.     lxi    d,dbg.sngl.off.msg
  1804. dbg.sngl.msg:
  1805.     call    listing.string.out
  1806.     jmp    debug.lup
  1807. ;
  1808. dbg.sngl.step.msg:
  1809.     db    'single step ',0
  1810. dbg.prt.msg:
  1811.     db    'debug print ',0
  1812. dbg.sngl.on.msg:
  1813.     db    'on',0
  1814. dbg.sngl.off.msg:
  1815.     db    'off',0
  1816. debug.sngl.step.flag:
  1817.     db    0
  1818. dbg.print.flag:
  1819.     db    0
  1820. ;
  1821. ;
  1822. ;
  1823. debug.ddt:
  1824.     rst    7
  1825. ;
  1826. ;
  1827. ;
  1828. ;
  1829. debug.prompt:
  1830.     db    '-',0
  1831. ;
  1832. ;
  1833. ;
  1834. ;
  1835. debug.sym.tbl:
  1836.     call    init.sym.tbl.srch
  1837.     call    listing.crlf
  1838. debug.st.lup:
  1839.     call    get.sym.tbl.entry
  1840.     call    print.sym.tbl.entry
  1841.     call    con.ch.in
  1842.     ani    5fh
  1843.     cpi    'E'
  1844.     jz    debug.go
  1845.     jmp    debug.st.lup
  1846. ;
  1847. ;
  1848. ;
  1849. ;
  1850. ;
  1851. ;
  1852. set.up.src.fcb:
  1853.     lxi    h,sctr.size * src.buf.sctrs
  1854.     shld    src.buf.ix
  1855.     xra    a
  1856.     sta    src.in+fcb.ext.num
  1857.     sta    src.in+fcb.cur.rec
  1858.     ret
  1859. ;
  1860. ;
  1861. ;
  1862. get.src.char:
  1863.     push    b
  1864.     push    d
  1865.     push    h
  1866.     lhld    src.buf.ix
  1867.     lxi    d,sctr.size * src.buf.sctrs
  1868.     call    cmp.hl.fm.de
  1869.     jnz    src.ch.fm.buf
  1870.     lxi    h,0
  1871.     shld    src.buf.ix
  1872.     mvi    b,src.buf.sctrs
  1873.     lxi    h,src.buffer
  1874. src.rd.lup:
  1875.     push    b
  1876.     push    h
  1877.     xchg
  1878.     mvi    c,26
  1879.     call    entry
  1880.     mvi    c,20    ;read
  1881.     lxi    d,src.in
  1882.     call    entry
  1883.     push    psw
  1884.     lxi    d,dflt.dma
  1885.     mvi    c,26
  1886.     call    entry
  1887.     pop    psw
  1888.     pop    h
  1889.     pop    b
  1890.     ora    a
  1891.     jnz    src.eof
  1892.     lxi    d,sctr.size
  1893.     dad    d
  1894.     dcr    b
  1895.     jnz    src.rd.lup
  1896.     jmp    src.ch.fm.buf
  1897. src.eof:
  1898.     cpi    3
  1899.     jnc    abort.src.err
  1900.     mvi    c,sctr.size
  1901. make.src.eof:
  1902.     mvi    m,1ah
  1903.     inx    h
  1904.     dcr    c
  1905.     jnz    make.src.eof
  1906. src.ch.fm.buf:
  1907.     lxi    d,src.buffer
  1908.     lhld    src.buf.ix
  1909.     inx    h
  1910.     shld    src.buf.ix
  1911.     dcx    h
  1912.     dad    d
  1913.     mov    a,m
  1914.     ani    7fh
  1915.     sta    src.char
  1916. ;
  1917. ;---put char into print buffer---
  1918. ;
  1919.     cpi    09h
  1920.     jz    prt.tab
  1921.     cpi    0ah
  1922.     jz    gsc.exit
  1923. ;
  1924.     cpi    1ah    ;don't print eof char
  1925.     jz    gsc.exit
  1926. ;
  1927.     lhld    print.line.ix
  1928.     mov    m,a
  1929.     inx    h
  1930.     shld    print.line.ix
  1931.     lda    curr.print.colm
  1932.     inr    a
  1933.     sta    curr.print.colm
  1934. ;
  1935.     lda    src.char
  1936.     cpi    0dh
  1937.     jnz    gsc.exit
  1938. ;
  1939. ;---end of line   ---   print if needed -----
  1940. ;
  1941.     mvi    m,0ah
  1942.     inx    h
  1943.     mvi    m,0
  1944.     xra    a
  1945.     sta    curr.print.colm
  1946. ;
  1947.     lxi    h,print.line
  1948.     shld    print.line.ix
  1949. ;
  1950. ;-----don't print if 'PRINT OFF' is in effect-----
  1951. ;
  1952.     lda    print.on.off.flag
  1953.     cpi    rwix.OFF
  1954.     jz    gsc.exit.count.line
  1955. ;
  1956.     lda    print.flag
  1957.     ora    a
  1958.     jnz    print.yes
  1959.     lda    error.this.line
  1960.     ora    a
  1961.     jz    gsc.exit.count.line
  1962. print.yes:
  1963. ;
  1964. ;--- check for block match ---
  1965. ;
  1966.     lda    print.blk.match.flag
  1967.     ora    a
  1968.     jz    print.blk.mtch.end
  1969. ;
  1970.     lhld    curr.block.match
  1971.     mov    a,h
  1972.     ora    l
  1973.     jnz    print.yes.blk.mtch
  1974. ;
  1975.     mvi    c,6
  1976.     call    print.out.c.blanks
  1977.     jmp    print.blk.mtch.end
  1978. ;
  1979. print.yes.blk.mtch:
  1980.     lxi    d,decimal.work
  1981.     call    cvt.bin.2.dec.str
  1982.     lxi    d,decimal.work
  1983.     call    size.d.2.h
  1984.     mvi    a,5
  1985.     sub    l
  1986.     mov    c,a
  1987.     call    print.out.c.blanks
  1988.     lxi    d,decimal.work
  1989.     call    listing.string.out
  1990.     mvi    e,' '
  1991.     call    print.out
  1992. print.blk.mtch.end:
  1993. ;
  1994. ;--- check for block level ---
  1995. ;
  1996.     lda    print.blk.lvl.flag
  1997.     ora    a
  1998.     jz    print.blk.lvl.end
  1999. ;
  2000.     lhld    curr.block.level
  2001.     mvi    h,0
  2002.     lxi    d,decimal.work
  2003.     call    cvt.bin.2.dec.str
  2004.     lxi    d,decimal.work
  2005.     call    size.d.2.h
  2006.     mvi    a,2
  2007.     sub    l
  2008.     mov    c,a
  2009.     call    print.out.c.blanks
  2010.     lxi    d,decimal.work
  2011.     call    listing.string.out
  2012.     mvi    e,' '
  2013.     call    print.out
  2014. print.blk.lvl.end:
  2015. ;
  2016. ;---check for address ---
  2017. ;
  2018.     lda    print.code.addr.flag
  2019.     ora    a
  2020.     jz    print.code.addr.end
  2021. ;
  2022.     lhld    curr.print.addr
  2023.     mov    a,h
  2024.     ora    l
  2025.     jnz    print.yes.code.addr
  2026. ;
  2027.     mvi    c,5
  2028.     call    print.out.c.blanks
  2029.     jmp    print.code.addr.end
  2030. ;
  2031. print.yes.code.addr:
  2032.     lxi    d,decimal.work
  2033.     call    cvt.bin.2.hex.str
  2034.     lxi    d,decimal.work
  2035.     call    listing.string.out
  2036.     mvi    e,' '
  2037.     call    print.out
  2038. print.code.addr.end:
  2039. ;
  2040. ;--- check if to print line number ---
  2041. ;
  2042.     lda    print.line.num.flag
  2043.     ora    a
  2044.     jz    print.line.num.end
  2045. ;
  2046.     lhld    curr.src.line.num
  2047.     lxi    d,decimal.work
  2048.     call    cvt.bin.2.dec.str
  2049. prt.lin.no.lup:
  2050.     lxi    d,decimal.work
  2051.     call    size.d.2.h
  2052.     mov    a,l
  2053.     cpi    5
  2054.     jnc    prt.lin.no.ok
  2055.     lxi    h,decimal.work + 7
  2056.     lxi    d,decimal.work + 8
  2057.     lxi    b,7
  2058.     call    move.bkwds.h.2.d.cnt.b
  2059.     lda    copy.nest.count
  2060.     ora    a
  2061.     mvi    a,' '
  2062.     jz    prt.lin.sp
  2063.     mvi    a,'0'
  2064. prt.lin.sp:
  2065.     sta    decimal.work
  2066.     jmp    prt.lin.no.lup
  2067. prt.lin.no.ok:
  2068.     lda    copy.nest.count
  2069.     ora    a
  2070.     jz    prt.lin.no.go
  2071.     ori    40h        ;show copy level "A", "B", etc.
  2072.     sta    decimal.work
  2073. prt.lin.no.go:
  2074.     lxi    d,decimal.work
  2075.     call    listing.string.out
  2076.     mvi    e,' '
  2077.     call    print.out
  2078. print.line.num.end:
  2079. ;
  2080. ;--- reset stuff ---
  2081. ;
  2082.     xra    a
  2083.     sta    error.this.line
  2084.     lxi    h,0
  2085.     shld    curr.print.addr
  2086.     shld    curr.block.match
  2087.     lxi    d,print.line
  2088.     call    listing.string.out
  2089.     lhld    print.line.ctr
  2090.     inx    h
  2091.     shld    print.line.ctr
  2092. ;
  2093. gsc.exit.count.line:
  2094.     lhld    curr.src.line.num
  2095.     inx    h
  2096.     shld    curr.src.line.num
  2097.     jmp    gsc.exit
  2098. ;
  2099. ;
  2100. abort.src.err:
  2101.     lxi    h,txt.src.rd.err
  2102.     mvi    c,9
  2103.     call    entry
  2104.     jmp    boot
  2105. ;
  2106. ;
  2107. prt.tab:
  2108.     mvi    a,' '
  2109.     lhld    print.line.ix
  2110.     mov    m,a
  2111.     inx    h
  2112.     shld    print.line.ix
  2113.     lhld    print.tab.mask
  2114.     lda    curr.print.colm
  2115.     inr    a
  2116.     sta    curr.print.colm
  2117.     ana    l
  2118.     jnz    prt.tab
  2119. ;            ;fall into gsc.exit
  2120. ;
  2121. ;
  2122. gsc.exit:
  2123.     pop    h
  2124.     pop    d
  2125.     pop    b
  2126.     lda    src.char
  2127.     ret
  2128. ;
  2129. ;
  2130. ;
  2131. debug.st.end:
  2132.     jmp    listing.crlf
  2133. ;
  2134. ;
  2135. ;
  2136. ;----------------------------------------------
  2137. ;
  2138. ;
  2139. ;
  2140. ;
  2141. ;
  2142. ;--------------------------------------
  2143. ;
  2144. ;
  2145. put.bir.jmp.fwd:
  2146.     lhld    word    ;save bir type
  2147.     push    h
  2148.     sta    word
  2149.     xra    a
  2150.     sta    word + 1
  2151.     call    put.JMP
  2152.     call    put.fwd.ref.addr
  2153.     pop    h
  2154.     shld    word
  2155.     ret
  2156. ;
  2157. ;
  2158. ;-----------------------------------
  2159. ;
  2160. ;
  2161. put.word.addr:
  2162.     call    lookup.word
  2163.     lhld    wk.sym.tbl.addr
  2164.     mov    a,m
  2165.     cpi    stet.end.tbl
  2166.     jz    put.fwd.ref.addr
  2167.     cpi    stet.fwd.ref
  2168.     jz    put.fwd.ref.addr
  2169.     lxi    d,(ste.address - ste.type)
  2170.     dad    d
  2171.     mov    e,m
  2172.     inx    h
  2173.     mov    d,m
  2174.     xchg
  2175.     jmp    put.code.word
  2176. ;
  2177. ;
  2178. ;----------------------------------
  2179. ;
  2180. ;
  2181. put.inline.A.string:
  2182.     mvi    a,stet.string
  2183.     sta    ste.A.type
  2184.     call    put.JMP
  2185.     lhld    curr.code.addr
  2186.     lda    ste.A.length
  2187.     mov    e,a
  2188.     mvi    d,0
  2189.     dad    d
  2190.     inx    h
  2191.     inx    h
  2192.     call    put.code.word
  2193.     lhld    curr.code.addr
  2194.     shld    ste.A.address
  2195. ;
  2196.     lhld    ste.A.length
  2197.     mov    b,h
  2198.     mov    c,l
  2199.     lxi    h,ste.A.name
  2200.     jmp    put.code.block
  2201. ;
  2202. ;
  2203. ;---------------------------------
  2204. ;
  2205. ;
  2206. put.inline.B.string:
  2207.     mvi    a,stet.string
  2208.     sta    ste.B.type
  2209.     call    put.JMP
  2210.     lhld    curr.code.addr
  2211.     lda    ste.B.length
  2212.     mov    e,a
  2213.     mvi    d,0
  2214.     dad    d
  2215.     inx    h
  2216.     inx    h
  2217.     call    put.code.word
  2218.     lhld    curr.code.addr
  2219.     shld    ste.B.address
  2220. ;
  2221.     lhld    ste.B.length
  2222.     mov    b,h
  2223.     mov    c,l
  2224.     lxi    h,ste.B.name
  2225.     jmp    put.code.block
  2226. ;
  2227. ;
  2228. ;----------------------------------
  2229. ;
  2230. ;
  2231. put.inline.BCD:
  2232.     mvi    m,stet.BCD
  2233.     push    h
  2234.     lxi    d,ste.name - ste.type
  2235.     dad    d
  2236.     lxi    d,bcd.cnst.value.wk
  2237.     call    cvt.str.2.bcd
  2238. ;
  2239.     call    put.JMP
  2240.     lhld    curr.code.addr
  2241.     lxi    d,bcd.size + 2
  2242.     dad    d
  2243.     call    put.code.word
  2244. ;
  2245.     lhld    curr.code.addr
  2246.     xchg
  2247.     pop    h
  2248.     lxi    b,ste.address - ste.type
  2249.     dad    b
  2250.     mov    m,e
  2251.     inx    h
  2252.     mov    m,d
  2253. ;
  2254.     lxi    b,bcd.size
  2255.     lxi    h,bcd.cnst.value.wk
  2256.     jmp    put.code.block
  2257. ;
  2258. ;
  2259. ;------------------------------------
  2260. ;
  2261. ;
  2262. ;
  2263. ;
  2264. ;
  2265. ;
  2266. ;
  2267. ;---------------------------------------
  2268. ;
  2269. ;
  2270. swap.A.B.sym.entries:
  2271.     lda    A.word.type
  2272.     mov    l,a
  2273.     lda    B.word.type
  2274.     sta    A.word.type
  2275.     mov    a,l
  2276.     sta    B.word.type
  2277. ;
  2278.     lxi    h,sym.tbl.entry.A
  2279.     lxi    d,symbol.table.entry
  2280.     call    move.sym.tbl.entry
  2281. ;
  2282.     lxi    h,sym.tbl.entry.B
  2283.     lxi    d,sym.tbl.entry.A
  2284.     call    move.sym.tbl.entry
  2285. ;
  2286.     lxi    h,symbol.table.entry
  2287.     lxi    d,sym.tbl.entry.B
  2288.     jmp    move.sym.tbl.entry
  2289. ;
  2290. ;
  2291. ;
  2292. ;
  2293. ;---------------------------------
  2294. ;   put code block
  2295. ;
  2296. ; in:    hl -> code
  2297. ;    bc = # bytes
  2298. ;
  2299. put.code.block:
  2300.     mov    a,b
  2301.     ora    c
  2302.     rz
  2303.     mov    a,m
  2304.     inx    h
  2305.     push    h
  2306.     push    b
  2307.     call    put.code.byte
  2308.     pop    b
  2309.     pop    h
  2310.     dcx    b
  2311.     jmp    put.code.block
  2312. ;
  2313. ;
  2314. ;
  2315. ;
  2316. ;
  2317. ;
  2318. ;
  2319. ;
  2320. ;
  2321. ;
  2322. ;=================================================================
  2323. ;
  2324. ;    INTERMEDIATE-LEVEL OBJECT-CODE OUTPUT ROUTINES
  2325. ;
  2326. ;        AN = word A cnst
  2327. ;        A8 = word A byte
  2328. ;        A16 = word A word
  2329. ;        ABP = word A byte-pointer
  2330. ;        AWP = word A word-pointer
  2331. ;            similar for B8,B16,BBP,BWP,etc
  2332. ;
  2333. ;=================================================================
  2334. ;
  2335. ;
  2336. ;
  2337. ;
  2338. ;
  2339. ;
  2340. put.add.2.A16.B8:
  2341.     call    err.truncate
  2342. put.add.2.A8.B8:
  2343.     call    put.LDA.A
  2344. put.add.2.x.B8:
  2345.     call    put.LXI.H.B
  2346.     call    put.ADD.M
  2347.     jmp    put.MOV.M.A
  2348. ;
  2349. ;
  2350. put.add.2.AN.B8:
  2351.     lda    ste.A.address
  2352.     ora    a
  2353.     rz
  2354.     dcr    a
  2355.     jz    put.add.2.A1.B8
  2356.     dcr    a
  2357.     jz    put.add.2.A2.B8
  2358. ;
  2359.     call    put.MVI.A.A
  2360.     jmp    put.add.2.x.B8
  2361. ;
  2362. put.add.2.A1.B8:
  2363.     call    put.LXI.H.B
  2364.     jmp    put.INR.M
  2365. ;
  2366. put.add.2.A2.B8:
  2367.     call    put.LXI.H.B
  2368.     call    put.INR.M
  2369.     jmp    put.INR.M
  2370. ;
  2371. put.add.2.A8.BBP:
  2372.     call    put.LDA.A
  2373.     call    put.LHLD.B
  2374.     call    put.ADD.M
  2375.     jmp    put.MOV.M.A
  2376. ;
  2377. put.add.2.ABP.B8:
  2378.     call    put.LHLD.A
  2379.     call    put.MOV.A.M
  2380.     call    put.LXI.H.B
  2381.     call    put.ADD.M
  2382.     jmp    put.MOV.M.A
  2383. ;
  2384. put.add.2.ABP.BBP:
  2385.     call    put.LHLD.A
  2386.     call    put.MOV.A.M
  2387.     call    put.LHLD.B
  2388.     call    put.ADD.M
  2389.     jmp    put.MOV.M.A
  2390. ;
  2391. ;
  2392. put.add.2.AN.BBP:
  2393.     lda    ste.A.address
  2394.     ora    a
  2395.     rz
  2396.     push    psw
  2397.     call    put.LHLD.B
  2398.     pop    psw
  2399.     dcr    a
  2400.     jz    put.add.2.A1.BBP
  2401.     dcr    a
  2402.     jz    put.add.2.A2.BBP
  2403.     dcr    a
  2404.     jz    put.add.2.A3.BBP
  2405.     call    put.MVI.A.A
  2406.     call    put.ADD.M
  2407.     jmp    put.MOV.M.A
  2408. put.add.2.A3.BBP:
  2409.     call    put.INR.M
  2410. put.add.2.A2.BBP:
  2411.     call    put.INR.M
  2412. put.add.2.A1.BBP:
  2413.     jmp    put.INR.M
  2414. ;
  2415. ;
  2416. ;
  2417. put.add.3.A8.B8.C8.tru:
  2418.     call    err.truncate
  2419. put.add.3.A8.B8.C8:
  2420.     call    put.LDA.A
  2421.     call    put.LXI.H.B
  2422.     call    put.ADD.M
  2423.     jmp    put.STA.C
  2424. ;
  2425. put.add.3.AN.B8.C8.tru:
  2426.     call    err.truncate
  2427. put.add.3.AN.B8.C8:
  2428.     lda    ste.A.address
  2429.     ora    a
  2430.     jz    put.add.3.A0.B8.C8
  2431.     dcr    a
  2432.     jz    put.add.3.A1.B8.C8
  2433. ;
  2434.     call    put.LDA.B
  2435.     call    put.ADI.A
  2436.     jmp    put.STA.C
  2437. ;
  2438. put.add.3.A0.B8.C8:
  2439.     call    put.LDA.B
  2440.     jmp    put.STA.C
  2441. ;
  2442. put.add.3.A1.B8.C8:
  2443.     call    put.LDA.B
  2444.     call    put.INR.A
  2445.     jmp    put.STA.C
  2446. ;
  2447. put.add.3.A8.BN.C8:
  2448.     lda    ste.B.address
  2449.     ora    a
  2450.     jz    put.add.3.A8.0.C8
  2451.     dcr    a
  2452.     jz    put.add.3.A8.1.C8
  2453. ;
  2454.     call    put.LDA.A
  2455.     call    put.ADI.B
  2456.     jmp    put.STA.C
  2457. ;
  2458. put.add.3.A8.0.C8:
  2459.     call    put.LDA.A
  2460.     jmp    put.STA.C
  2461. ;
  2462. put.add.3.A8.1.C8:
  2463.     call    put.LDA.A
  2464.     call    put.INR.A
  2465.     jmp    put.STA.C
  2466. ;
  2467. ;
  2468. put.add.misc.A.WORD:
  2469.     call    put.get.A.into.HL
  2470.     call    put.XCHG
  2471.     jmp    put.add.misc.B
  2472. ;
  2473. put.add.misc.A.eql.B:
  2474.     call    put.get.A.into.HL
  2475.     call    put.DAD.H
  2476.     jmp    put.store.HL.at.C
  2477. ;
  2478. put.add.AN.B16.C16:
  2479.     lhld    ste.A.address
  2480.     mov    a,h
  2481.     ora    l
  2482.     jz    put.add.misc.0
  2483.     dcx    h
  2484.     mov    a,h
  2485.     ora    l
  2486.     jz    put.add.misc.1
  2487.     dcx    h
  2488.     mov    a,h
  2489.     ora    l
  2490.     jz    put.add.misc.2
  2491.     dcx    h
  2492.     mov    a,h
  2493.     ora    l
  2494.     jz    put.add.misc.3
  2495.     lxi    d,4
  2496.     dad    d
  2497.     mov    a,h
  2498.     ora    l
  2499.     jz    put.add.minus.1
  2500.     inx    h
  2501.     mov    a,h
  2502.     ora    l
  2503.     jz    put.add.minus.2
  2504.     inx    h
  2505.     mov    a,h
  2506.     ora    l
  2507.     jz    put.add.minus.3
  2508.     call    put.LXI.D.A
  2509.     jmp    put.add.misc.B
  2510. ;
  2511. put.add.misc.c.c:
  2512.     lhld    ste.A.address
  2513.     xchg
  2514.     lhld    ste.B.address
  2515.     dad    d
  2516.     call    put.LXI.H.hl
  2517.     jmp    put.store.HL.at.C
  2518. ;
  2519. put.add.misc.0:
  2520.     call    put.get.B.into.HL
  2521.     jmp    put.store.HL.at.C
  2522. ;
  2523. put.add.misc.1:
  2524.     call    put.get.B.into.HL
  2525.     call    put.INX.H
  2526.     jmp    put.store.HL.at.C
  2527. ;
  2528. put.add.misc.2:
  2529.     call    put.get.B.into.HL
  2530.     call    put.INX.H
  2531.     call    put.INX.H
  2532.     jmp    put.store.HL.at.C
  2533. ;
  2534. put.add.misc.3:
  2535.     call    put.get.B.into.HL
  2536.     call    put.INX.H
  2537.     call    put.INX.H
  2538.     call    put.INX.H
  2539.     jmp    put.store.HL.at.C
  2540. ;
  2541. put.add.minus.1:
  2542.     call    put.get.B.into.HL
  2543.     call    put.DCX.H
  2544.     jmp    put.store.HL.at.C
  2545. ;
  2546. put.add.minus.2:
  2547.     call    put.get.B.into.HL
  2548.     call    put.DCX.H
  2549.     call    put.DCX.H
  2550.     jmp    put.store.HL.at.C
  2551. ;
  2552. put.add.minus.3:
  2553.     call    put.get.B.into.HL
  2554.     call    put.DCX.H
  2555.     call    put.DCX.H
  2556.     call    put.DCX.H
  2557.     jmp    put.store.HL.at.C
  2558. ;
  2559. put.add.misc.BP:
  2560.     call    put.LHLD.A
  2561.     call    put.mv.@HLB.to.DE
  2562.     jmp    put.add.misc.B
  2563. ;
  2564. put.add.misc.WP:
  2565.     call    put.LHLD.A
  2566.     call    put.mv.@HL.to.DE
  2567. ;
  2568. put.add.misc.B:
  2569.     call    put.get.B.into.HL
  2570.     call    put.DAD.D
  2571.     jmp    put.store.HL.at.C
  2572. ;
  2573. ;
  2574. ;
  2575. ;----move A-cnst to B-byte---
  2576. ;
  2577. put.mv.AN.B8:
  2578.     lda    ste.A.address
  2579.     ora    a
  2580.     jz    put.mv.A0.B8
  2581.     call    put.MVI.A.A
  2582.     jmp    put.sta.B
  2583. put.mv.A0.B8:
  2584.     call    put.XRA.A
  2585.     jmp    put.STA.B
  2586. ;
  2587. ;-----move A-word to B-byte-----
  2588. ;
  2589. put.mv.A16.B8:
  2590.     call    err.truncate
  2591. ;
  2592. ;-----move A-byte to B-byte-----
  2593. ;
  2594. put.mv.A8.B8:
  2595.     call    put.LDA.A
  2596.     jmp    put.STA.B
  2597. ;
  2598. ;-----move A-word-ptr to B-byte-----
  2599. ;
  2600. put.mv.AWP.B8:
  2601.     call    err.truncate
  2602. ;
  2603. ;-----move A-byte-ptr to B-byte-----
  2604. ;
  2605. put.mv.ABP.B8:
  2606.     call    put.LHLD.A
  2607.     call    put.MOV.A.M
  2608.     jmp    put.STA.B
  2609. ;
  2610. ;-----move A-cnst to B-word-----
  2611. ;
  2612. put.mv.AN.B16:
  2613.     call    put.LXI.H.A
  2614.     jmp    put.SHLD.B
  2615. ;
  2616. ;-----move A-byte to B-word-----
  2617. ;
  2618. put.mv.A8.B16:
  2619.     call    put.LHLD.A
  2620.     call    put.MVI.H.0
  2621.     jmp    put.SHLD.B
  2622. ;
  2623. ;-----move A-word to B-word-----
  2624. ;
  2625. put.mv.A16.B16:
  2626.     call    put.LHLD.A
  2627.     jmp    put.SHLD.B
  2628. ;
  2629. ;-----move A-byte-ptr to B-word-----
  2630. ;
  2631. put.mv.ABP.B16:
  2632.     call    put.LHLD.A
  2633.     call    put.mv.@HLB.to.HL
  2634.     jmp    put.SHLD.B
  2635. ;
  2636. ;-----move A-word-ptr to B-word-----
  2637. ;
  2638. put.mv.AWP.B16:
  2639.     call    put.LHLD.A
  2640.     call    put.mv.@HL.to.HL
  2641.     jmp    put.SHLD.B
  2642. ;
  2643. ;-----move A-cnst to B-byte-ptr-----
  2644. ;
  2645. put.mv.AN.BBP:
  2646.     call    put.LHLD.B
  2647.     call    put.MVI.M
  2648.     jmp    put.A.byte.value
  2649. ;
  2650. ;-----move A-word to B-byte-ptr-----
  2651. ;
  2652. put.mv.A16.BBP:
  2653.     call    err.truncate
  2654. ;
  2655. ;-----move A-byte to B-byte-ptr-----
  2656. ;
  2657. put.mv.A8.BBP:
  2658.     call    put.LDA.A
  2659.     call    put.LHLD.B
  2660.     jmp    put.MOV.M.A
  2661. ;
  2662. ;-----move A-word.ptr to B-byte-ptr-----
  2663. ;
  2664. put.mv.AWP.BBP:
  2665.     call    err.truncate
  2666. ;
  2667. ;-----move A-byte-ptr to B-byte-ptr-----
  2668. ;
  2669. put.mv.ABP.BBP:
  2670.     call    put.LHLD.A
  2671.     call    put.MOV.A.M
  2672.     call    put.LHLD.B
  2673.     jmp    put.MOV.M.A
  2674. ;
  2675. ;-----move A-cnst to B-word-ptr-----
  2676. ;
  2677. put.mv.AN.BWP:
  2678.     call    put.LHLD.B
  2679.     call    put.MVI.M
  2680.     call    put.A.byte.value
  2681.     call    put.INX.H
  2682.     call    put.MVI.M
  2683.     lda    ste.A.address + 1
  2684.     jmp    put.code.byte
  2685. ;
  2686. ;-----move A-byte to B-word-ptr-----
  2687. ;
  2688. put.mv.A8.BWP:
  2689.     call    LHLD.A.to.DE.B.to.HL
  2690.     jmp    put.mv.DEB.to.@HL
  2691. ;
  2692. ;-----move A-word to B-word-ptr-----
  2693. ;
  2694. put.mv.A16.BWP:
  2695.     call    LHLD.A.to.DE.B.to.HL
  2696.     jmp    put.mv.DE.to.@HL
  2697. ;
  2698. ;-----move A-byte-ptr to B-word-ptr-----
  2699. ;
  2700. put.mv.ABP.BWP:
  2701.     call    LHLD.A.to.DE.B.to.HL
  2702.     call    put.LDAX.D
  2703.     jmp    put.mv.A.to.@HL
  2704. ;
  2705. ;-----move A-word-ptr to B-word-ptr-----
  2706. ;
  2707. put.mv.AWP.BWP:
  2708.     call    LHLD.A.to.HL.B.to.DE
  2709.     call    put.MOV.A.M
  2710.     call    put.STAX.D
  2711.     call    put.INX.H
  2712.     call    put.INX.D
  2713.     call    put.MOV.A.M
  2714.     jmp    put.STAX.D
  2715. ;
  2716. ;
  2717. put.sub.2.AB.BB:
  2718.     call    put.LDA.B
  2719.     call    put.LXI.H.A
  2720.     call    put.SUB.M
  2721.     jmp    put.STA.B
  2722. ;
  2723. put.sub.2.AN.B8:
  2724.     lda    ste.A.address
  2725.     ora    a
  2726.     rz        ;exit
  2727.     lda    ste.B.type
  2728.     cpi    stet.spcl.byte.ptr
  2729.     jz    put.sub.2.AN.BBP
  2730.     call    put.LXI.H.B
  2731.     jmp    put.sub.2.AN.B8.cont
  2732. put.sub.2.AN.BBP:
  2733.     call    put.LHLD.B
  2734. put.sub.2.AN.B8.cont:
  2735.     lda    ste.A.address
  2736.     dcr    a
  2737.     jz    put.DCR.M
  2738. ;
  2739.     call    put.MOV.A.M
  2740.     lhld    ste.A.address
  2741.     call    put.SUI.L
  2742.     jmp    put.MOV.M.A
  2743. ;
  2744. ;
  2745. put.sub.AN.BB.CB:
  2746.     lda    ste.A.address
  2747.     ora    a
  2748.     jz    put.sub.A0.BB.CB
  2749.     dcr    a
  2750.     jz    put.sub.A1.BB.CB
  2751. ;
  2752.     call    put.LDA.B
  2753.     lhld    ste.A.address
  2754.     call    put.SUI.L
  2755.     jmp    put.STA.C
  2756. ;
  2757. put.sub.A0.BB.CB:
  2758.     call    put.LDA.B
  2759.     jmp    put.STA.C
  2760. ;
  2761. put.sub.A1.BB.CB:
  2762.     call    put.LDA.B
  2763.     call    put.DCR.A
  2764.     jmp    put.STA.C
  2765. ;
  2766. put.sub.AN.BN.C8:
  2767.     lda    ste.B.address
  2768.     lxi    h,ste.A.address
  2769.     sub    m
  2770.     call    put.MVI.A.A
  2771.     jmp    p.SUBTRACT.g.8.C
  2772. ;
  2773. put.sub.AN.BN.C16:
  2774.     lhld    ste.A.address
  2775.     call    negate.hl
  2776.     xchg
  2777.     lhld    ste.B.address
  2778.     dad    d
  2779.     call    put.LXI.H.hl
  2780.     jmp    put.store.HL.at.C
  2781. ;
  2782. put.sub.g.A8.B16.C16:
  2783. put.sub.g.A16.B16.C16:
  2784.     call    put.get.A.into.HL
  2785.     call    put.XCHG
  2786.     jmp    put.sub.AX.B16.CX
  2787. ;
  2788. put.sub.g.ABP.B16.C16:
  2789.     call    put.LHLD.A
  2790.     call    put.mv.@HLB.to.DE
  2791.     jmp    put.sub.AX.B16.CX
  2792. ;
  2793. put.sub.g.AWP.B16.C16:
  2794.     call    put.LHLD.A
  2795.     call    put.mv.@HL.to.DE
  2796.     jmp    put.sub.AX.B16.CX
  2797. ;
  2798. put.sub.g.ANsmall:
  2799.     lhld    ste.A.address
  2800.     mov    a,h
  2801.     ora    a
  2802.     jnz    put.sub.ANbig.B16.C16
  2803.     mov    a,l
  2804.     cpi    6
  2805.     jnc    put.sub.ANbig.B16.C16
  2806.     call    put.get.B.into.HL
  2807. put.sub.g.lup.DCX.H:
  2808.     lda    ste.A.address
  2809.     ora    a
  2810.     jz    put.store.HL.at.C
  2811.     dcr    a
  2812.     sta    ste.A.address
  2813.     call    put.DCX.H
  2814.     jmp    put.sub.g.lup.DCX.H
  2815. ;
  2816. put.sub.ANbig.B16.C16:
  2817.     call    put.LXI.D.A
  2818. put.sub.AX.B16.CX:
  2819.     call    put.get.B.into.HL
  2820.     call    put.SUB.16
  2821.     jmp    put.store.HL.at.C
  2822. ;
  2823. put.sub.g.AN.BN.C16:
  2824.     lhld    ste.A.address
  2825.     call    negate.HL
  2826.     xchg
  2827.     lhld    ste.B.address
  2828.     dad    d
  2829.     call    put.LXI.H.hl
  2830.     jmp    put.store.HL.at.C
  2831. ;
  2832. ;
  2833. ;
  2834. ;
  2835. ;
  2836. ;
  2837. ;---get word-A contents to HL, word-B contents to DE---
  2838. LHLD.A.to.HL.B.to.DE:
  2839.     call    put.LHLD.B
  2840.     call    put.XCHG
  2841.     jmp    put.LHLD.A
  2842. ;
  2843. ;
  2844. ;---get word-A contents to DE, word-B contents to HL---
  2845. LHLD.A.to.DE.B.to.HL:
  2846.     call    put.LHLD.A
  2847.     call    put.XCHG
  2848.     jmp    put.LHLD.B
  2849. ;
  2850. ;
  2851. put.store.HL.at.B:
  2852.     call    switch.B
  2853.     db stet.BYTE        ! dw psHLaB.BYTE
  2854.     db stet.WORD        ! dw psHLaB.WORD
  2855.     db stet.spcl.byte.ptr    ! dw psHLaB.BP
  2856.     db stet.spcl.word.ptr    ! dw psHLaB.WP
  2857.     db    0        ! dw err.inv.var.type
  2858. ;
  2859. psHLaB.BYTE:
  2860.     call    err.truncate
  2861.     call    put.MOV.A.L
  2862.     jmp    put.STA.B
  2863. ;
  2864. psHLaB.WORD:
  2865.     jmp    put.SHLD.B
  2866. ;
  2867. psHLaB.BP:
  2868.     call    err.truncate
  2869.     call    put.XCHG
  2870.     call    put.LHLD.B
  2871.     jmp    put.MOV.M.E
  2872. ;
  2873. psHLaB.WP:
  2874.     call    put.XCHG
  2875.     call    put.LHLD.B
  2876.     jmp    put.mv.DE.to.@HL
  2877. ;
  2878. ;
  2879. ;--------------------------------------
  2880. ;
  2881. ;
  2882. put.store.HL.at.C:
  2883.     call    switch.C
  2884.     db stet.BYTE        ! dw psHLaC.BYTE
  2885.     db stet.WORD        ! dw psHLaC.WORD
  2886.     db stet.spcl.byte.ptr    ! dw psHLaC.BP
  2887.     db stet.spcl.word.ptr    ! dw psHLaC.WP
  2888.     db    0        ! dw err.inv.var.type
  2889. ;
  2890. psHLaC.BYTE:
  2891.     call    err.truncate
  2892.     call    put.MOV.A.L
  2893.     jmp    put.STA.C
  2894. ;
  2895. psHLaC.WORD:
  2896.     jmp    put.SHLD.C
  2897. ;
  2898. psHLaC.BP:
  2899.     call    err.truncate
  2900.     call    put.XCHG
  2901.     call    put.LHLD.C
  2902.     jmp    put.MOV.M.E
  2903. ;
  2904. psHLaC.WP:
  2905.     call    put.XCHG
  2906.     call    put.LHLD.C
  2907.     jmp    put.mv.DE.to.@HL
  2908. ;
  2909. ;
  2910. ;---------------------------------
  2911. ;
  2912. ;
  2913. put.store.A.at.A:
  2914.     call    switch.A
  2915.     db stet.BYTE        ! dw psAaA.BYTE
  2916.     db stet.WORD        ! dw psAaA.WORD
  2917.     db stet.spcl.byte.ptr    ! dw psAaA.BP
  2918.     db stet.spcl.word.ptr    ! dw psAaA.WP
  2919.     db    0        ! dw err.inv.var.type
  2920. ;
  2921. psAaA.BYTE:
  2922.     jmp    put.STA.A
  2923. ;
  2924. psAaA.WORD:
  2925.     call    put.mv.A.to.HL
  2926.     jmp    put.SHLD.A
  2927. ;
  2928. psAaA.BP:
  2929.     call    put.LHLD.A
  2930.     jmp    put.MOV.M.A
  2931. ;
  2932. psAaA.WP:
  2933.     call    put.LHLD.A
  2934.     jmp    put.mv.A.to.@HL
  2935. ;
  2936. ;
  2937. ;---------------------------------
  2938. ;
  2939. ;
  2940. put.store.A.at.B:
  2941.     call    switch.B
  2942.     db stet.BYTE        ! dw psAaB.BYTE
  2943.     db stet.WORD        ! dw psAaB.WORD
  2944.     db stet.spcl.byte.ptr    ! dw psAaB.BP
  2945.     db stet.spcl.word.ptr    ! dw psAaB.WP
  2946.     db    0        ! dw err.inv.var.type
  2947. ;
  2948. psAaB.BYTE:
  2949.     jmp    put.STA.B
  2950. ;
  2951. psAaB.WORD:
  2952.     call    put.mv.A.to.HL
  2953.     jmp    put.SHLD.B
  2954. ;
  2955. psAaB.BP:
  2956.     call    put.LHLD.B
  2957.     jmp    put.MOV.M.A
  2958. ;
  2959. psAaB.WP:
  2960.     call    put.LHLD.B
  2961.     jmp    put.mv.A.to.@HL
  2962. ;
  2963. ;
  2964. ;
  2965. ;---------------------------------
  2966. ;
  2967. ;
  2968. put.store.A.at.C:
  2969.     call    switch.C
  2970.     db stet.BYTE        ! dw psAaC.BYTE
  2971.     db stet.WORD        ! dw psAaC.WORD
  2972.     db stet.spcl.byte.ptr    ! dw psAaC.BP
  2973.     db stet.spcl.word.ptr    ! dw psAaC.WP
  2974.     db    0        ! dw err.inv.var.type
  2975. ;
  2976. psAaC.BYTE:
  2977.     jmp    put.STA.C
  2978. ;
  2979. psAaC.WORD:
  2980.     call    put.mv.A.to.HL
  2981.     jmp    put.SHLD.C
  2982. ;
  2983. psAaC.BP:
  2984.     call    put.LHLD.C
  2985.     jmp    put.MOV.M.A
  2986. ;
  2987. psAaC.WP:
  2988.     call    put.LHLD.C
  2989.     jmp    put.mv.A.to.@HL
  2990. ;
  2991. ;
  2992. ;-------------------------------------
  2993. ;
  2994. ;
  2995. put.get.A.into.HL:
  2996.     lda    A.word.type
  2997.     ani    wtp.cnst
  2998.     jnz    pgAiHL.cnst
  2999. ;
  3000.     call    switch.A
  3001.     db stet.BYTE        ! dw pgAiHL.BYTE
  3002.     db stet.WORD        ! dw pgAiHL.WORD
  3003.     db stet.spcl.byte.ptr    ! dw pgAiHL.BP
  3004.     db stet.spcl.word.ptr    ! dw pgAiHL.WP
  3005.     db    0        ! dw err.inv.var.type
  3006. ;
  3007. pgAiHL.BYTE:
  3008.     call    put.LHLD.A
  3009.     jmp    put.MVI.H.0
  3010. ;
  3011. pgAiHL.WORD:
  3012.     jmp    put.LHLD.A
  3013. ;
  3014. pgAihl.BP:
  3015.     call    put.LHLD.A
  3016.     jmp    put.mv.@HLB.to.HL
  3017. ;
  3018. pgAiHL.WP:
  3019.     call    put.LHLD.A
  3020.     jmp    put.mv.@HL.to.HL
  3021. ;
  3022. pgAihl.cnst:
  3023.     jmp    put.LXI.H.A
  3024. ;
  3025. ;
  3026. ;-------------------------------------
  3027. ;
  3028. ;
  3029. put.get.B.into.HL:
  3030.     lda    B.word.type
  3031.     ani    wtp.cnst
  3032.     jnz    pgBiHL.cnst
  3033. ;
  3034.     call    switch.B
  3035.     db stet.BYTE        ! dw pgBiHL.BYTE
  3036.     db stet.WORD        ! dw pgBiHL.WORD
  3037.     db stet.spcl.byte.ptr    ! dw pgBiHL.BP
  3038.     db stet.spcl.word.ptr    ! dw pgBiHL.WP
  3039.     db    0        ! dw err.inv.var.type
  3040. ;
  3041. pgBiHL.BYTE:
  3042.     call    put.LHLD.B
  3043.     jmp    put.MVI.H.0
  3044. ;
  3045. pgBiHL.WORD:
  3046.     jmp    put.LHLD.B
  3047. ;
  3048. pgBihl.BP:
  3049.     call    put.LHLD.B
  3050.     jmp    put.mv.@HLB.to.HL
  3051. ;
  3052. pgBiHL.WP:
  3053.     call    put.LHLD.B
  3054.     jmp    put.mv.@HL.to.HL
  3055. ;
  3056. pgBihl.cnst:
  3057.     jmp    put.LXI.H.B
  3058. ;
  3059. ;
  3060. ;-------------------------------------
  3061. ;
  3062. ;
  3063. put.get.C.into.HL:
  3064.     lda    C.word.type
  3065.     ani    wtp.cnst
  3066.     jnz    pgCihl.cnst
  3067. ;
  3068.     call    switch.C
  3069.     db stet.BYTE        ! dw pgCiHL.BYTE
  3070.     db stet.WORD        ! dw pgCiHL.WORD
  3071.     db stet.spcl.byte.ptr    ! dw pgCiHL.BP
  3072.     db stet.spcl.word.ptr    ! dw pgCiHL.WP
  3073.     db    0        ! dw err.inv.var.type
  3074. ;
  3075. pgCiHL.BYTE:
  3076.     call    put.LHLD.C
  3077.     jmp    put.MVI.H.0
  3078. ;
  3079. pgCiHL.WORD:
  3080.     jmp    put.LHLD.C
  3081. ;
  3082. pgCihl.BP:
  3083.     call    put.LHLD.C
  3084.     jmp    put.mv.@HLB.to.HL
  3085. ;
  3086. pgCiHL.WP:
  3087.     call    put.LHLD.C
  3088.     jmp    put.mv.@HL.to.HL
  3089. ;
  3090. pgCihl.cnst:
  3091.     jmp    put.LXI.H.C
  3092. ;
  3093. ;
  3094. ;---------------------------------
  3095. ;
  3096. ;
  3097. put.get.A.into.A:
  3098.     lda    A.word.type
  3099.     ani    wtp.cnst
  3100.     jnz    pgAiA.cnst
  3101. ;
  3102.     call    switch.A
  3103.     db stet.BYTE        ! dw pgAiA.BYTE
  3104.     db stet.WORD        ! dw pgAiA.WORD
  3105.     db stet.spcl.byte.ptr    ! dw pgAiA.BP
  3106.     db stet.spcl.word.ptr    ! dw pgAiA.WP
  3107.     db    0        ! dw err.inv.var.type
  3108. ;
  3109. pgAiA.WORD:
  3110.     call    err.truncate
  3111. pgAiA.BYTE:
  3112.     jmp    put.LDA.A
  3113. ;
  3114. pgAiA.WP:
  3115.     call    err.truncate
  3116. pgAiA.BP:
  3117.     call    put.LHLD.A
  3118.     jmp    put.MOV.A.M
  3119. ;
  3120. pgAiA.cnst:
  3121.     jmp    put.MVI.A.A
  3122. ;
  3123. ;
  3124. ;
  3125. ;---------------------------------
  3126. ;
  3127. ;
  3128. put.get.B.into.A:
  3129.     lda    B.word.type
  3130.     ani    wtp.cnst
  3131.     jnz    pgBiA.cnst
  3132. ;
  3133.     call    switch.B
  3134.     db stet.BYTE        ! dw pgBiA.BYTE
  3135.     db stet.WORD        ! dw pgBiA.WORD
  3136.     db stet.spcl.byte.ptr    ! dw pgBiA.BP
  3137.     db stet.spcl.word.ptr    ! dw pgBiA.WP
  3138.     db    0        ! dw err.inv.var.type
  3139. ;
  3140. pgBiA.WORD:
  3141.     call    err.truncate
  3142. pgBiA.BYTE:
  3143.     jmp    put.LDA.B
  3144. ;
  3145. pgBiA.WP:
  3146.     call    err.truncate
  3147. pgBiA.BP:
  3148.     call    put.LHLD.B
  3149.     jmp    put.MOV.A.M
  3150. ;
  3151. pgBiA.cnst:
  3152.     jmp    put.MVI.A.B
  3153. ;
  3154. ;
  3155. ;
  3156. ;
  3157. ;=======================================================
  3158. ;
  3159. ;    MISCELLANEOUS REGISTER / REGISTER AND
  3160. ;    REGISTER / MEMORY   AND   MEMORY / MEMORY
  3161. ;
  3162. ;=======================================================
  3163. ;
  3164. ;
  3165. ;---get what HL is pointing to into HL---
  3166. put.mv.@HL.to.HL:
  3167.     call    put.MOV.A.M
  3168.     call    put.INX.H
  3169.     call    put.MOV.H.M
  3170.     jmp    put.MOV.L.A
  3171. ;
  3172. ;
  3173. ;---store byte pointed to by HL into BC---
  3174. put.mv.@HLB.to.BC:
  3175.     call    put.MOV.C.M
  3176.     jmp    put.MVI.B.0
  3177. ;
  3178. ;
  3179. ;---store word pointed to by HL into BC---
  3180. put.mv.@HL.to.BC:
  3181.     call    put.MOV.C.M
  3182.     call    put.INX.H
  3183.     jmp    put.MOV.B.M
  3184. ;
  3185. ;
  3186. ;---store byte pointed to by HL into DE---
  3187. put.mv.@HLB.to.DE:
  3188.     call    put.MOV.E.M
  3189.     jmp    put.MVI.D.0
  3190. ;
  3191. ;
  3192. ;---store word pointed to by HL into DE---
  3193. put.mv.@HL.to.DE:
  3194.     call    put.MOV.E.M
  3195.     call    put.INX.H
  3196.     jmp    put.MOV.D.M
  3197. ;
  3198. ;
  3199. ;---store byte pointed to by HL into HL---
  3200. put.mv.@HLB.to.HL:
  3201.     call    put.MOV.L.M
  3202.     jmp    put.MVI.H.0
  3203. ;
  3204. ;
  3205. ;---put contents of HL into BC---
  3206. put.mv.HL.to.BC:
  3207.     call    put.MOV.B.H
  3208.     jmp    put.MOV.C.L
  3209. ;
  3210. ;
  3211. ;---put.contents of BC into HL---
  3212. put.mv.BC.to.HL:
  3213.     call    put.MOV.H.B
  3214.     jmp    put.MOV.L.C
  3215. ;
  3216. ;
  3217. ;---put reg A into HL---
  3218. put.mv.A.to.HL:
  3219.     call    put.MOV.L.A
  3220.     jmp    put.MVI.H.0
  3221. ;
  3222. ;
  3223. ;---put reg A into word pointed to by hl---
  3224. put.mv.A.to.@HL:
  3225.     call    put.MOV.M.A
  3226.     jmp    put.zero.fill.@HL
  3227. ;
  3228. ;
  3229. ;---store reg E into word pointed to by HL---
  3230. put.mv.DEB.to.@HL:
  3231.     call    put.MOV.M.E
  3232. ;            --finish filling out 16-bits--
  3233. put.zero.fill.@HL:
  3234.     call    put.INX.H
  3235.     jmp    put.MVI.M.0
  3236. ;
  3237. ;
  3238. ;---store DE at word pointed to by HL---
  3239. put.mv.DE.to.@HL:
  3240.     call    put.MOV.M.E
  3241.     call    put.INX.H
  3242.     jmp    put.MOV.M.D
  3243. ;
  3244. ;
  3245. put.A.length:
  3246.     lhld    ste.A.length
  3247.     jmp    put.code.word
  3248. ;
  3249. put.B.length:
  3250.     lhld    ste.B.length
  3251.     jmp    put.code.word
  3252. ;
  3253. put.C.length:
  3254.     lhld    ste.C.length
  3255.     jmp    put.code.word
  3256. ;
  3257. put.A.address:
  3258.     lhld    ste.A.address
  3259.     jmp    put.code.word
  3260. ;
  3261. put.B.address:
  3262.     lhld    ste.B.address
  3263.     jmp    put.code.word
  3264. ;
  3265. put.C.address:
  3266.     lhld    ste.C.address
  3267.     jmp    put.code.word
  3268. ;
  3269. put.A.byte.value:
  3270.     lda    ste.A.address
  3271.     jmp    put.code.byte
  3272. ;
  3273. put.B.byte.value:
  3274.     lda    ste.B.address
  3275.     jmp    put.code.byte
  3276. ;
  3277. put.zero.code.byte:
  3278.     xra    a
  3279.     jmp    put.code.byte
  3280. ;
  3281. ;
  3282. ;
  3283. put.bir.xor.16:
  3284.     mvi    a,bir.xor.16
  3285.     jmp    put.bir.call.fwd
  3286. ;
  3287. put.bir.and.16:
  3288.     mvi    a,bir.and.16
  3289.     jmp    put.bir.call.fwd
  3290. ;
  3291. put.bir.or.16:
  3292.     mvi    a,bir.or.16
  3293.     jmp    put.bir.call.fwd
  3294. ;
  3295. put.bir.APPEND:
  3296.     mvi    a,bir.APPEND    ;ends w/ move string A=0 always
  3297.     call    put.bir.call.fwd
  3298. opt.A.zero:
  3299.     mvi    a,opt.cnst
  3300.     sta    opt.A.status
  3301.     xra    a
  3302.     sta    opt.A.value
  3303.     ret
  3304. ;
  3305. put.bir.move.bcd:
  3306.     lda    opt.HL.status
  3307.     push    psw
  3308.     mvi    a,bir.move.bcd    ;HL=HL+bcd.size...A=0 always
  3309.     call    put.bir.call.fwd
  3310.     pop    psw
  3311.     sta    opt.HL.status
  3312.     lxi    h,bcd.size
  3313.     call    opt.add.HL.value
  3314.     jmp    opt.A.zero
  3315. ;
  3316. put.bir.mov.rev:
  3317.     mvi    a,bir.mov.rev    ;a=0 always
  3318.     call    put.bir.call.fwd
  3319.     jmp    opt.A.zero
  3320. ;
  3321. ;
  3322. ;---------------------------------
  3323. ;
  3324. ;
  3325. ;=============================================================
  3326. ;
  3327. ;    LOW-LEVEL OBJECT-CODE OUTPUT ROUTINES
  3328. ;
  3329. ;=============================================================
  3330. ;
  3331. ;
  3332. ;
  3333. put.ADD.M:
  3334.     mvi    a,86h
  3335.     call    put.code.byte
  3336.     lda    opt.A.status
  3337.     ani    opt.cnst
  3338.     jz    opt.undef.A
  3339.     lda    opt.HL.status
  3340.     ani    opt.byte.contents + opt.cnst
  3341.     cpi    opt.byte.contents + opt.cnst
  3342.     jnz    opt.undef.A
  3343.     lhld    opt.HL.offset
  3344.     mov    a,h
  3345.     ora    l
  3346.     jnz    opt.undef.A
  3347.     lhld    opt.HL.value
  3348.     call    opt.add.A.value
  3349.     jmp    opt.make.A.cnst
  3350. ;
  3351. ;
  3352. put.ADI:
  3353.     call    opt.undef.A
  3354. do.put.ADI:
  3355.     mvi    a,(adi)
  3356.     jmp    put.code.byte
  3357. ;
  3358. put.ADI.A:
  3359.     lhld    ste.A.address
  3360.     jmp    put.ADI.L
  3361. ;
  3362. put.ADI.B:
  3363.     lhld    ste.B.address
  3364. ;
  3365. put.ADI.L:
  3366.     mov    a,l
  3367.     ora    a
  3368.     rz        ;adding zero -- skip
  3369.     dcr    a
  3370.     jz    put.INR.A
  3371.     inr a ! inr a
  3372.     jz    put.DCR.A
  3373.     mov    a,l
  3374.     lda    opt.A.value
  3375.     add    l
  3376.     sta    opt.A.value
  3377.     push    h
  3378.     call    do.put.ADI
  3379.     pop    h
  3380.     mov    a,l
  3381.     jmp    put.code.byte
  3382. ;
  3383. ;
  3384. put.ANA.M:
  3385.     call    opt.undef.A
  3386.     mvi    a,0a6h
  3387.     jmp    put.code.byte
  3388. ;
  3389. ;
  3390. put.and.16:
  3391.     jmp    put.bir.and.16    ;**change when able
  3392. ;
  3393. ;
  3394. put.ANI:
  3395.     call    opt.undef.A
  3396. do.put.ANI:
  3397.     mvi    a,(ani)
  3398.     jmp    put.code.byte
  3399. ;
  3400. put.ANI.B:
  3401.     lhld    ste.B.address
  3402. ;
  3403. put.ANI.L:
  3404.     mov    a,l
  3405.     ora    a
  3406.     jz    put.XRA.A    ;and with 0 = 0
  3407.     lda    opt.A.status
  3408.     ani    opt.cnst
  3409.     jz    put.ANI.L.undef
  3410.     mov    a,l
  3411.     lxi    h,opt.A.value
  3412.     ana    m
  3413.     cmp    m
  3414.     rz        ;still no change
  3415.     mov    m,a
  3416.     jmp    do.put.ANI.L
  3417. put.ANI.L.undef:
  3418.     call    opt.undef.A
  3419. do.put.ANI.L:
  3420.     push    h
  3421.     call    do.put.ANI
  3422.     pop    h
  3423.     mov    a,l
  3424.     jmp    put.code.byte
  3425. ;
  3426. ;
  3427. put.CALL:
  3428.     call    opt.undef.all
  3429.     mvi    a,(call)
  3430.     jmp    put.code.byte
  3431. ;
  3432. ;
  3433. put.CALL.ENTRY:
  3434.     call    put.CALL
  3435.     lxi    h,ENTRY
  3436.     call    put.code.word
  3437. put.x.chk.standalone:
  3438.     lda    standalone.flag
  3439.     ora    a
  3440.     rz
  3441.     jmp    err.CPM.call
  3442. ;
  3443. ;
  3444. put.CNZ:
  3445.     call    opt.undef.all
  3446.     mvi    a,(cnz)
  3447.     jmp    put.code.byte
  3448. ;
  3449. ;
  3450. put.CMA:
  3451.     lda    opt.A.status
  3452.     ani    opt.cnst
  3453.     cz    opt.undef.A
  3454.     lda    opt.A.value
  3455.     cma
  3456.     sta    opt.A.value
  3457.     call    opt.make.A.cnst
  3458.     mvi    a,(cma)
  3459.     jmp    put.code.byte
  3460. ;
  3461. ;
  3462. put.CMC:
  3463.     mvi    a,(cmc)
  3464.     jmp    put.code.byte
  3465. ;
  3466. ;
  3467. put.cmp.BCD:
  3468.     mvi    a,bir.BCD.compare
  3469.     jmp    put.bir.call.fwd
  3470. ;
  3471. ;
  3472. put.cmp.blk:
  3473.     mvi    a,bir.cmp.blk
  3474.     jmp    put.bir.call.fwd
  3475. ;
  3476. ;
  3477. put.CMP.C:
  3478.     mvi    a,0b9h
  3479.     jmp    put.code.byte
  3480. ;
  3481. ;
  3482. put.CMP.M:
  3483.     mvi    a,0beh    ;cmp m
  3484.     jmp    put.code.byte
  3485. ;
  3486. ;
  3487. put.cmp.str:
  3488.     mvi    a,bir.cmp.str
  3489.     jmp    put.bir.call.fwd
  3490. ;
  3491. ;
  3492. put.CPI:
  3493.     mvi    a,(cpi)
  3494.     jmp    put.code.byte
  3495. ;
  3496. ;
  3497. put.CPI.B:
  3498.     call    put.CPI
  3499.     jmp    put.B.byte.value
  3500. ;
  3501. ;
  3502. put.cmp.16:
  3503.     lda    opt.HL.status
  3504.     push    psw
  3505.     mvi    a,bir.cmp.16
  3506.     call    put.bir.call.fwd
  3507.     pop    psw
  3508.     sta    opt.HL.status    ;cmp.16 doesn't change HL
  3509.     ret
  3510. ;
  3511. ;
  3512. put.CZ:
  3513.     call    opt.undef.all
  3514.     mvi    a,(cz)
  3515.     jmp    put.code.byte
  3516. ;
  3517. ;
  3518. put.DAD.B:
  3519.     call    opt.undef.HL
  3520.     mvi    a,09h
  3521.     jmp    put.code.byte
  3522. ;
  3523. ;
  3524. put.DAD.D:
  3525.     call    opt.undef.HL
  3526.     mvi    a,19h
  3527.     jmp    put.code.byte
  3528. ;
  3529. ;
  3530. put.DAD.H:
  3531.     lda    opt.HL.status
  3532.     push    psw
  3533.     mvi    a,29h
  3534.     call    put.code.byte
  3535.     pop    psw
  3536.     ani    opt.cnst
  3537.     jnz    opt.undef.HL
  3538.     lhld    opt.HL.value
  3539.     call    opt.add.HL.value
  3540.     jmp    opt.make.HL.cnst
  3541. ;
  3542. ;
  3543. put.DAD.SP:
  3544.     call    opt.undef.HL
  3545.     mvi    a,39h
  3546.     jmp    put.code.byte
  3547. ;
  3548. ;
  3549. put.DCR.A.double:
  3550.     call    put.DCR.A
  3551. put.DCR.A:
  3552.     lxi    h,-1
  3553.     call    opt.add.A.value
  3554.     mvi    a,3dh
  3555.     jmp    put.code.byte
  3556. ;
  3557. ;
  3558. put.DCR.M:
  3559.     call    opt.@HL.modify
  3560.     mvi    a,35h
  3561.     jmp    put.code.byte
  3562. ;
  3563. ;
  3564. put.DCX.H.double:
  3565.     call    put.DCX.H
  3566. put.DCX.H:
  3567.     lxi    h,-1
  3568.     call    opt.add.HL.value
  3569.     mvi    a,2bh
  3570.     jmp    put.code.byte
  3571. ;
  3572. ;
  3573. put.DI:
  3574.     mvi    a,(di)
  3575.     jmp    put.code.byte
  3576. ;
  3577. ;
  3578. put.div.16:
  3579.     mvi    a,bir.div.16
  3580.     jmp    put.bir.call.fwd
  3581. ;
  3582. ;
  3583. put.EI:
  3584.     mvi    a,(ei)
  3585.     jmp    put.code.byte
  3586. ;
  3587. ;
  3588. put.execute.program:
  3589.     mvi    a,bir.execute.program
  3590.     call    put.bir.call.fwd
  3591.     jmp    put.x.chk.standalone
  3592. ;
  3593. ;
  3594. put.format.file.name:
  3595.     mvi    a,bir.fmt.filnm
  3596.     call    put.bir.call.fwd
  3597.     jmp    put.x.chk.standalone
  3598. ;
  3599. ;
  3600. put.INR.A.double:
  3601.     call    put.INR.A
  3602. put.INR.A:
  3603.     lxi    h,1
  3604.     call    opt.add.A.value
  3605.     mvi    a,3ch
  3606.     jmp    put.code.byte
  3607. ;
  3608. ;
  3609. put.INR.M:
  3610.     call    opt.@HL.modify
  3611.     mvi    a,34h
  3612.     jmp    put.code.byte
  3613. ;
  3614. ;
  3615. put.INX.D:
  3616.     mvi    a,13h
  3617.     jmp    put.code.byte
  3618. ;
  3619. ;
  3620. put.INX.H.double:
  3621.     call    put.INX.H
  3622. put.INX.H:
  3623.     lxi    h,1
  3624.     call    opt.add.HL.value
  3625.     mvi    a,23h
  3626.     jmp    put.code.byte
  3627. ;
  3628. ;
  3629. put.IN:
  3630.     call    opt.undef.A
  3631.     mvi    a,(in)
  3632.     jmp    put.code.byte
  3633. ;
  3634. ;
  3635. put.JC:
  3636.     mvi    a,(jc)
  3637.     jmp    put.code.byte
  3638. ;
  3639. put.JMP:
  3640.     mvi    a,(jmp)
  3641.     jmp    put.code.byte
  3642. ;
  3643. put.JNC:
  3644.     mvi    a,(jnc)
  3645.     jmp    put.code.byte
  3646. ;
  3647. put.JNZ:
  3648.     mvi    a,(jnz)
  3649.     jmp    put.code.byte
  3650. ;
  3651. put.JZ:
  3652.     mvi    a,(jz)
  3653.     jmp    put.code.byte
  3654. ;
  3655. ;
  3656. put.LDA:
  3657.     call    opt.undef.A
  3658. do.put.LDA:
  3659.     mvi    a,(lda)
  3660.     jmp    put.code.byte
  3661. ;
  3662. put.LDA.A:
  3663.     lhld    ste.A.address
  3664.     jmp    put.LDA.hl
  3665. ;
  3666. put.LDA.B:
  3667.     lhld    ste.B.address
  3668. ;
  3669. ;-----get into 'A' what is at address in 'HL'-----
  3670. put.LDA.hl:
  3671.     lda    opt.A.status    ;see if A is already loaded
  3672.     ani    opt.byte.contents
  3673.     jz    do.put.LDA.hl    ;no - go check what HL has
  3674.     xchg        ;yes - see if addr is same
  3675.     lhld    opt.A.address
  3676.     xchg
  3677.     call    cmp.hl.fm.de
  3678.     jnz    do.put.LDA.hl    ;no - go check HL
  3679. ;
  3680.     lda    opt.A.offset    ;see if 'A' off by 1 or 2
  3681.     ora    a
  3682.     rz        ;same
  3683.     dcr    a
  3684.     jz    put.DCR.A
  3685.     dcr    a
  3686.     jz    put.DCR.A.double
  3687.     adi    3
  3688.     jz    put.INR.A
  3689.     inr    a
  3690.     jz    put.INR.A.double
  3691. ;---something needs to be loaded into 'A'-----
  3692. ;---see if HL is close enough to avoid 'LDA'-----
  3693. do.put.LDA.hl:
  3694.     push    h
  3695.     lda    opt.HL.status
  3696.     ani    opt.cnst
  3697.     jz    put.LDA.not.MOV
  3698.     xchg
  3699.     lhld    opt.HL.value
  3700.     call    sub.de.fm.hl.2.hl
  3701.     mov    a,h
  3702.     ora    l
  3703.     jnz    put.LDA.not.0
  3704.     call    put.MOV.A.M
  3705.     jmp    put.LDA.set.up
  3706. ;
  3707. put.LDA.not.0:
  3708.     dcx    h
  3709.     mov    a,h
  3710.     ora    l
  3711.     jnz    put.LDA.not.1
  3712.     call    put.DCX.H
  3713.     call    put.MOV.A.M
  3714.     jmp    put.LDA.set.up
  3715. ;
  3716. put.LDA.not.1:
  3717.     inx    h
  3718.     inx    h
  3719.     mov    a,h
  3720.     ora    l
  3721.     xchg
  3722.     jnz    put.LDA.not.MOV
  3723.     call    put.INX.H
  3724.     call    put.MOV.A.M
  3725.     jmp    put.LDA.set.up
  3726. ;
  3727. ;-----tried everything, but nothing close enough-----
  3728. put.LDA.not.MOV:
  3729.     call    do.put.LDA
  3730.     pop    h
  3731.     call    put.code.word
  3732.     push    h
  3733. put.LDA.set.up:
  3734.     mvi    a,opt.byte.contents    ;only
  3735.     sta    opt.A.status
  3736.     lxi    h,0
  3737.     shld    opt.A.offset
  3738.     pop    h
  3739.     shld    opt.A.address
  3740.     ret
  3741. ;
  3742. ;
  3743. put.LDAX.B:
  3744.     call    opt.undef.A
  3745.     mvi    a,0ah
  3746.     jmp    put.code.byte
  3747. ;
  3748. ;
  3749. put.LDAX.D:
  3750.     call    opt.undef.A
  3751.     mvi    a,1ah
  3752.     jmp    put.code.byte
  3753. ;
  3754. ;
  3755. put.LHLD:
  3756.     call    opt.undef.HL
  3757. do.put.LHLD:
  3758.     mvi    a,(lhld)
  3759.     jmp    put.code.byte
  3760. ;
  3761. put.LHLD.A:
  3762.     lhld    ste.A.address
  3763.     jmp    put.LHLD.hl
  3764. ;
  3765. put.LHLD.B:
  3766.     lhld    ste.B.address
  3767.     jmp    put.LHLD.hl
  3768. ;
  3769. put.LHLD.C:
  3770.     lhld    ste.C.address
  3771. ;
  3772. put.LHLD.hl:
  3773.     lda    opt.HL.status
  3774.     ani    opt.word.contents
  3775.     jz    do.put.LHLD.hl
  3776.     xchg
  3777.     lhld    opt.HL.address
  3778.     call    cmp.hl.fm.de
  3779.     xchg
  3780.     jnz    do.put.LHLD.hl
  3781.     xchg        ;save value in DE
  3782.     lhld    opt.HL.offset
  3783.     mov a,h ! ora l
  3784.     rz        ;same
  3785.     dcx h ! mov a,h ! ora l
  3786.     jz    put.DCX.H
  3787.     dcx h ! mov a,h ! ora l
  3788.     jz    put.DCX.H.double
  3789.     inx h ! inx h ! inx h
  3790.     mov a,h ! ora l
  3791.     jz    put.INX.H
  3792.     inx h ! mov a,h ! ora l
  3793.     jz    put.INX.H.double
  3794.     xchg
  3795. do.put.LHLD.HL:
  3796.     push    h
  3797.     call    do.put.LHLD
  3798.     mvi    a,opt.word.contents + opt.byte.contents
  3799.     sta    opt.HL.status
  3800.     lxi    h,0
  3801.     shld    opt.HL.offset
  3802.     pop    h
  3803.     shld    opt.HL.address
  3804.     jmp    put.code.word
  3805. ;
  3806. ;
  3807. put.LXI.B:
  3808.     mvi    a,01h
  3809.     jmp    put.code.byte
  3810. ;
  3811. put.LXI.B.A.length:
  3812.     lhld    ste.A.length
  3813.     jmp    put.LXI.B.hl
  3814. ;
  3815. put.LXI.B.B:
  3816.     lhld    ste.B.address
  3817.     jmp    put.LXI.B.hl
  3818. ;
  3819. put.LXI.B.B.length:
  3820.     lhld    ste.B.length
  3821.     jmp    put.LXI.B.hl
  3822. ;
  3823. put.LXI.B.C.length:
  3824.     lhld    ste.C.length
  3825.     jmp    put.LXI.B.hl
  3826. ;
  3827. put.LXI.B.C:
  3828.     lhld    ste.C.address
  3829. ;
  3830. put.LXI.B.hl:
  3831.     push    h
  3832.     call    put.LXI.B
  3833.     pop    h
  3834.     jmp    put.code.word
  3835. ;
  3836. ;
  3837. put.LXI.D:
  3838.     mvi    a,11h
  3839.     jmp    put.code.byte
  3840. ;
  3841. put.LXI.D.A:
  3842.     lhld    ste.A.address
  3843.     jmp    put.LXI.D.hl
  3844. ;
  3845. put.LXI.D.B:
  3846.     lhld    ste.B.address
  3847.     jmp    put.LXI.D.hl
  3848. ;
  3849. put.LXI.D.C:
  3850.     lhld    ste.C.address
  3851.     jmp    put.LXI.D.hl
  3852. ;
  3853. put.LXI.D.A.length:
  3854.     lhld    ste.A.length
  3855.     jmp    put.LXI.D.hl
  3856. ;
  3857. put.LXI.D.dflt.fcb:
  3858.     lxi    h,dflt.fcb
  3859. ;
  3860. put.LXI.D.hl:
  3861.     push    h
  3862.     call    put.LXI.D
  3863.     pop    h
  3864.     jmp    put.code.word
  3865. ;
  3866. ;
  3867. put.LXI.H:
  3868.     call    opt.undef.HL
  3869. do.put.LXI.H:
  3870.     mvi    a,21h
  3871.     jmp    put.code.byte
  3872. ;
  3873. put.LXI.H.A:
  3874.     lhld    ste.A.address
  3875.     jmp    put.LXI.H.hl
  3876. ;
  3877. put.LXI.H.A.length:
  3878.     lhld    ste.A.length
  3879.     jmp    put.LXI.H.hl
  3880. ;
  3881. put.LXI.H.B:
  3882.     lhld    ste.B.address
  3883.     jmp    put.LXI.H.hl
  3884. ;
  3885. put.LXI.H.C:
  3886.     lhld    ste.C.address
  3887. ;
  3888. put.LXI.H.hl:
  3889.     lda    opt.HL.status
  3890.     ani    opt.cnst
  3891.     jz    do.put.LXI.H.hl
  3892.     xchg
  3893.     lhld    opt.HL.value
  3894.     call    sub.de.fm.hl.2.hl
  3895.     mov a,h ! ora l
  3896.     rz        ;same
  3897.     dcx h ! mov a,h ! ora l
  3898.     jz    put.DCX.H
  3899.     dcx h ! mov a,h ! ora l
  3900.     jz    put.DCX.H.double
  3901.     inx h ! inx h ! inx h
  3902.     mov a,h ! ora l
  3903.     jz    put.INX.H
  3904.     inx h ! mov a,h ! ora l
  3905.     jz    put.INX.H.double
  3906.     xchg
  3907. do.put.LXI.H.hl:
  3908.     push    h
  3909.     call    put.LXI.H
  3910.     mvi    a,opt.cnst
  3911.     sta    opt.HL.status
  3912.     pop    h
  3913.     shld    opt.HL.value
  3914.     jmp    put.code.word
  3915. ;
  3916. put.LXI.H.fwd:
  3917.     push    psw
  3918.     call    opt.undef.HL
  3919.     call    do.put.LXI.H
  3920.     pop    psw
  3921.     jmp    put.fwd.bir.sv.word
  3922. ;
  3923. put.LXI.H.fixup:
  3924.     push    psw
  3925.     call    opt.undef.HL
  3926.     call    put.LXI.H
  3927.     pop    psw
  3928.     call    fix.up.built.in.rtn
  3929.     lxi    h,0
  3930.     jmp    put.code.word
  3931. ;
  3932. ;
  3933. put.LXI.SP:
  3934.     mvi    a,31h    ;lxi sp
  3935.     jmp    put.code.byte
  3936. ;
  3937. ;
  3938. put.MOV.A.B:
  3939.     call    opt.undef.A
  3940.     mvi    a,78h
  3941.     jmp    put.code.byte
  3942. ;
  3943. ;
  3944. put.MOV.A.E:
  3945.     call    opt.undef.A
  3946.     mvi    a,7bh
  3947.     jmp    put.code.byte
  3948. ;
  3949. put.MOV.A.H:
  3950.     lda    opt.HL.status
  3951.     ani    opt.cnst
  3952.     jz    put.MOV.A.H.undef
  3953.     ;---H is value, so it's known what A will be
  3954.     lda    opt.A.status
  3955.     ani    opt.cnst
  3956.     jz    put.MOV.A.H.ok
  3957.     lda    opt.A.value
  3958.     lxi    h,opt.HL.value + 1    ;reg.H value
  3959.     cmp    m
  3960.     rz        ;no effect, skip
  3961. put.MOV.A.H.ok:
  3962.     mvi    a,opt.cnst
  3963.     sta    opt.A.status
  3964.     lda    opt.HL.value + 1
  3965.     sta    opt.A.value
  3966.     jmp    go.put.MOV.A.H
  3967. put.MOV.A.H.undef:
  3968.     call    opt.undef.A
  3969. go.put.MOV.A.H:
  3970.     mvi    a,7ch
  3971.     jmp    put.code.byte
  3972. ;
  3973. put.MOV.A.L:
  3974.     lda    opt.HL.status
  3975.     ani    opt.cnst
  3976.     jz    put.MOV.A.L.undef
  3977.     ;---L is value, so it's known what A will be
  3978.     lda    opt.A.status
  3979.     ani    opt.cnst
  3980.     jz    put.MOV.A.L.ok
  3981.     lda    opt.A.value
  3982.     lxi    h,opt.HL.value    ;reg.L value
  3983.     cmp    m
  3984.     rz        ;no effect, skip
  3985. put.MOV.A.L.ok:
  3986.     lda    opt.HL.status
  3987.     ani    0ffh - opt.word.contents
  3988.     sta    opt.A.status
  3989.     lhld    opt.HL.address
  3990.     shld    opt.A.address
  3991.     lhld    opt.HL.offset
  3992.     shld    opt.A.offset
  3993.     lhld    opt.HL.value
  3994.     shld    opt.A.value
  3995.     jmp    go.put.MOV.A.L
  3996. put.MOV.A.L.undef:
  3997.     call    opt.undef.A
  3998. go.put.MOV.A.L:
  3999.     mvi    a,7dh
  4000.     jmp    put.code.byte
  4001. ;
  4002. put.MOV.A.M:
  4003.     lda    opt.A.status
  4004.     ani    opt.byte.contents
  4005.     jz    put.MOV.A.M.undef
  4006.     lda    opt.HL.status
  4007.     ani    opt.cnst
  4008.     jz    put.MOV.A.M.undef
  4009.     lhld    opt.HL.value
  4010.     xchg
  4011.     lhld    opt.A.address
  4012.     call    cmp.hl.fm.de
  4013.     jnz    put.MOV.A.M.undef
  4014.     lda    opt.A.offset
  4015.     ora    a    ;anything added to it?
  4016.     rz        ;no - A will still be the same
  4017. put.MOV.A.M.undef:
  4018.     call    opt.undef.A
  4019.     mvi    a,7eh
  4020.     call    put.code.byte
  4021.     ;---if HL is cnst, then A is now contents
  4022.     lda    opt.HL.status
  4023.     ani    opt.cnst
  4024.     rz        ;no
  4025.     mvi    a,opt.byte.contents
  4026.     sta    opt.A.status
  4027.     xra    a
  4028.     sta    opt.A.offset
  4029.     lhld    opt.HL.value
  4030.     shld    opt.A.address
  4031.     ret
  4032. ;
  4033. ;
  4034. put.MOV.B.H:
  4035.     mvi    a,44h
  4036.     jmp    put.code.byte
  4037. ;
  4038. ;
  4039. put.MOV.B.M:
  4040.     mvi    a,46h
  4041.     jmp    put.code.byte
  4042. ;
  4043. ;
  4044. put.mov.blk:
  4045.     call    opt.undef.all
  4046.     lda    Z80.flag
  4047.     ora    a
  4048.     jz    put.mov.blk.8080
  4049.     lxi    h,0b0edh    ;LDIR backwards
  4050.     jmp    put.code.word
  4051. put.mov.blk.8080:
  4052.     mvi    a,bir.mov.blk
  4053.     jmp    put.bir.call.fwd
  4054. ;
  4055. ;
  4056. put.MOV.C.L:
  4057.     mvi    a,4dh
  4058.     jmp    put.code.byte
  4059. ;
  4060. ;
  4061. put.MOV.C.M:
  4062.     mvi    a,4eh
  4063.     jmp    put.code.byte
  4064. ;
  4065. ;
  4066. put.MOV.D.M:
  4067.     mvi    a,56h
  4068.     jmp    put.code.byte
  4069. ;
  4070. ;
  4071. put.MOV.E.M:
  4072.     mvi    a,5eh
  4073.     jmp    put.code.byte
  4074. ;
  4075. ;
  4076. put.MOV.H.B:
  4077.     call    opt.undef.HL
  4078.     mvi    a,60h
  4079.     jmp    put.code.byte
  4080. ;
  4081. ;
  4082. put.MOV.H.M:
  4083.     call    opt.undef.HL
  4084.     mvi    a,66h
  4085.     jmp    put.code.byte
  4086. ;
  4087. ;
  4088. put.MOV.L.A:
  4089.     lda    opt.A.status
  4090.     ani    opt.cnst
  4091.     jz    put.MOV.L.A.undef
  4092. put.MOV.L.A.value:
  4093.     lda    opt.HL.status
  4094.     ani    opt.cnst
  4095.     jz    put.MOV.L.A.undef
  4096.     lxi    h,opt.HL.value    ;reg L
  4097.     lda    opt.A.value
  4098.     cmp    m
  4099.     rz        ;same value, skip
  4100.     lda    opt.A.value
  4101.     sta    opt.HL.value
  4102.     call    opt.make.HL.cnst
  4103.     jmp    do.put.MOV.L.A
  4104. put.MOV.L.A.undef:
  4105.     call    opt.undef.HL
  4106. do.put.MOV.L.A:
  4107.     mvi    a,6fh
  4108.     jmp    put.code.byte
  4109. ;
  4110. ;
  4111. put.MOV.L.C:
  4112.     mvi    a,69h
  4113.     jmp    put.code.byte
  4114. ;
  4115. ;
  4116. put.MOV.L.M:
  4117.     lda    opt.HL.status
  4118.     ani    opt.cnst
  4119.     jz    put.MOV.L.M.undef
  4120.     mvi    a,opt.byte.contents
  4121.     sta    opt.HL.status
  4122.     lhld    opt.HL.value
  4123.     shld    opt.HL.address
  4124.     lxi    h,0
  4125.     shld    opt.hl.offset
  4126.     jmp    go.put.MOV.L.M
  4127. put.MOV.L.M.undef:
  4128.     call    opt.undef.HL
  4129. go.put.MOV.L.M:
  4130.     mvi    a,6eh
  4131.     jmp    put.code.byte
  4132. ;
  4133. ;
  4134. put.MOV.M.A:
  4135.     mvi    a,77h
  4136.     call    put.code.byte
  4137.     ;---if A is already byte cont., don't change it
  4138.     lda    opt.A.status
  4139.     ani    opt.byte.contents
  4140.     rnz
  4141. ;
  4142.     lda    opt.HL.status
  4143.     ani    opt.byte.contents
  4144.     cnz    put.MOV.M.A.BC
  4145.     lda    opt.HL.status
  4146.     ani    opt.cnst
  4147.     rz        ;no change to A
  4148.     ;---HL is cnst, so A is now byte contents---
  4149.     lhld    opt.HL.value
  4150.     shld    opt.A.address
  4151.     lxi    h,0
  4152.     shld    opt.A.offset
  4153.     jmp    opt.add.A.BC
  4154. ;---HL is byte/word contents, A is also byte-contents---
  4155. put.MOV.M.A.BC:
  4156.     lhld    opt.HL.address
  4157.     shld    opt.A.address
  4158.     lhld    opt.HL.offset
  4159.     shld    opt.A.offset
  4160. opt.add.A.BC:
  4161.     mvi    a,opt.byte.contents
  4162.     jmp    opt.add.A.status
  4163. ;
  4164. put.MOV.M.B:
  4165.     call    opt.@HL.modify
  4166.     mvi    a,70h
  4167.     jmp    put.code.byte
  4168. ;
  4169. put.MOV.M.C:
  4170.     call    opt.@HL.modify
  4171.     mvi    a,71h
  4172.     jmp    put.code.byte
  4173. ;
  4174. put.MOV.M.D:
  4175.     call    opt.@HL.modify
  4176.     mvi    a,72h
  4177.     jmp    put.code.byte
  4178. ;
  4179. put.MOV.M.E:
  4180.     call    opt.@HL.modify
  4181.     mvi    a,73h
  4182.     jmp    put.code.byte
  4183. ;
  4184. ;
  4185. put.move.string:
  4186.     call    opt.memory.modify
  4187.     mvi    a,bir.mov.str
  4188.     call    put.bir.call.fwd
  4189.     jmp    opt.A.zero
  4190. ;
  4191. ;
  4192. put.MVI.A:
  4193.     call    opt.undef.A
  4194. do.put.MVI.A:
  4195.     mvi    a,3eh
  4196.     jmp    put.code.byte
  4197. ;
  4198. put.MVI.A.A:
  4199.     lhld    ste.A.address
  4200.     jmp    put.MVI.A.L
  4201. ;
  4202. put.MVI.A.B:
  4203.     lhld    ste.B.address
  4204. put.MVI.A.L:
  4205.     lda    opt.A.status
  4206.     ani    opt.cnst
  4207.     jz    put.MVI.A.undef
  4208.     lda    opt.A.value
  4209.     sub    l
  4210.     rz
  4211.     dcr    a
  4212.     jz    put.DCR.A
  4213.     adi    2
  4214.     jz    put.INR.A
  4215. put.MVI.A.undef:
  4216.     mvi    a,opt.cnst
  4217.     sta    opt.A.status
  4218.     mov    a,l
  4219.     sta    opt.A.value
  4220.     mov    a,l
  4221.     ora    a
  4222.     jz    put.XRA.A
  4223.     push    h
  4224.     call    do.put.MVI.A
  4225.     pop    h
  4226.     mov    a,l
  4227.     jmp    put.code.byte
  4228. ;
  4229. ;
  4230. put.MVI.B:
  4231.     mvi    a,06h
  4232.     jmp    put.code.byte
  4233. ;
  4234. ;
  4235. put.MVI.B.0:
  4236.     call    put.MVI.B
  4237.     jmp    put.zero.code.byte
  4238. ;
  4239. ;
  4240. put.MVI.C:
  4241.     mvi    a,0eh
  4242.     jmp    put.code.byte
  4243. ;
  4244. ;
  4245. put.MVI.D:
  4246.     mvi    a,16h
  4247.     jmp    put.code.byte
  4248. ;
  4249. ;
  4250. put.MVI.D.0:
  4251.     call    put.MVI.D
  4252.     jmp    put.zero.code.byte
  4253. ;
  4254. ;
  4255. put.MVI.E:
  4256.     mvi    a,1eh
  4257.     jmp    put.code.byte
  4258. ;
  4259. ;
  4260. put.MVI.E.L:
  4261.     push    h
  4262.     call    put.MVI.E
  4263.     pop    h
  4264.     mov    a,l
  4265.     jmp    put.code.byte
  4266. ;
  4267. ;
  4268. put.MVI.H.0:
  4269.     lda    opt.HL.status
  4270.     ani    opt.cnst
  4271.     jz    put.MVI.H.0.undef
  4272.     lda    opt.HL.value + 1
  4273.     ora    a
  4274.     rz        ;it's already zero
  4275.     xra    a
  4276.     sta    opt.HL.value + 1
  4277.     jmp    do.put.MVI.H.0
  4278. put.MVI.H.0.undef:
  4279.     call    opt.undef.HL
  4280. do.put.MVI.H.0:
  4281.     mvi    a,26h
  4282.     call    put.code.byte
  4283.     call    put.zero.code.byte
  4284.     jmp    opt.make.HL.cnst
  4285. ;
  4286. ;
  4287. put.MVI.M:
  4288.     call    opt.@HL.modify
  4289.     mvi    a,36h
  4290.     jmp    put.code.byte
  4291. ;
  4292. ;
  4293. put.MVI.M.0:
  4294.     call    put.MVI.M
  4295.     jmp    put.zero.code.byte
  4296. ;
  4297. ;
  4298. put.mul.16:
  4299.     mvi    a,bir.mul.16
  4300.     jmp    put.bir.call.fwd
  4301. ;
  4302. ;
  4303. put.ORA.A:
  4304.     mvi    a,0b7h
  4305.     jmp    put.code.byte
  4306. ;
  4307. ;
  4308. put.ORA.H:        ;not optimised - used for status flags
  4309.     mvi    a,0b4h
  4310.     jmp    put.code.byte
  4311. ;
  4312. ;
  4313. put.ORA.L:        ;not optimised - used for status flags
  4314.     mvi    a,0b5h
  4315.     jmp    put.code.byte
  4316. ;
  4317. ;
  4318. put.ORA.M:        ;not optimised - used for status flags
  4319.     mvi    a,0b6h
  4320.     jmp    put.code.byte
  4321. ;
  4322. ;
  4323. put.ORI:
  4324.     call    opt.undef.A
  4325. do.put.ORI:
  4326.     mvi    a,(ori)
  4327.     jmp    put.code.byte
  4328. ;
  4329. put.ORI.B:
  4330.     lhld    ste.B.address
  4331. ;
  4332. put.ORI.L:
  4333.     lda    opt.A.status
  4334.     ani    opt.cnst
  4335.     jz    put.ORI.L.undef
  4336.     mov    a,l
  4337.     ora    a
  4338.     rz        ;oring w/ zero = no change
  4339.     lxi    h,opt.A.value
  4340.     ora    m
  4341.     cmp    m
  4342.     rz        ;still no change
  4343.     mov    m,a
  4344.     call    opt.make.A.cnst
  4345.     jmp    do.put.ORI.L
  4346. put.ORI.L.undef:
  4347.     call    opt.undef.A
  4348. do.put.ORI.L:
  4349.     push    h
  4350.     call    do.put.ORI
  4351.     pop    h
  4352.     mov    a,l
  4353.     jmp    put.code.byte
  4354. ;
  4355. ;
  4356. put.or.16:
  4357.     mvi    a,bir.or.16
  4358.     jmp    put.bir.call.fwd
  4359. ;
  4360. ;
  4361. put.OUT:
  4362.     mvi    a,(out)
  4363.     jmp    put.code.byte
  4364. ;
  4365. ;
  4366. put.PCHL:
  4367.     mvi    a,(pchl)
  4368.     jmp    put.code.byte
  4369. ;
  4370. ;
  4371. put.POP.H:
  4372.     call    opt.undef.HL
  4373.     mvi    a,0e1h
  4374.     jmp    put.code.byte
  4375. ;
  4376. ;
  4377. put.PUSH.H:
  4378.     call    opt.memory.modify
  4379.     mvi    a,0e5h
  4380.     jmp    put.code.byte
  4381. ;
  4382. ;
  4383. put.RET:
  4384.     mvi    a,(ret)
  4385.     jmp    put.code.byte
  4386. ;
  4387. ;
  4388. put.SHLD:
  4389.     call    opt.memory.modify
  4390. do.put.SHLD:
  4391.     mvi    a,(shld)
  4392.     jmp    put.code.byte
  4393. ;
  4394. put.SHLD.A:
  4395.     lhld    ste.A.address
  4396.     jmp    put.SHLD.hl
  4397. ;
  4398. put.SHLD.B:
  4399.     lhld    ste.B.address
  4400.     jmp    put.SHLD.hl
  4401. ;
  4402. put.SHLD.C:
  4403.     lhld    ste.C.address
  4404. ;
  4405. put.SHLD.hl:
  4406.     push    h
  4407.     call    do.put.SHLD
  4408.     pop    h
  4409.     push    h
  4410.     call    put.code.word
  4411.     mvi    a,opt.word.contents + opt.byte.contents
  4412.     call    opt.add.HL.status
  4413.     pop    h
  4414.     push    h
  4415.     shld    opt.HL.address
  4416.     lxi    h,0
  4417.     shld    opt.HL.offset
  4418.     ;--check if wiping out anything--
  4419.     pop    d
  4420.     lda    opt.A.status
  4421.     ani    opt.byte.contents
  4422.     rz
  4423.     lhld    opt.A.address
  4424.     call    sub.de.fm.hl.2.hl
  4425.     mov    a,h
  4426.     ora    a
  4427.     rnz        ;not even close
  4428.     mov    a,l
  4429.     cpi    2
  4430.     rnc        ;not close enough
  4431.     jmp    opt.undef.A    ;close enough
  4432. ;
  4433. put.SHLD.fwd:
  4434.     push    psw
  4435.     call    opt.memory.modify
  4436.     call    do.put.SHLD
  4437.     pop    psw
  4438.     jmp    put.fwd.bir.sv.word
  4439. ;
  4440. ;
  4441. put.SPHL:
  4442.     mvi    a,(sphl)
  4443.     jmp    put.code.byte
  4444. ;
  4445. ;
  4446. put.STA:
  4447.     call    opt.memory.modify
  4448. do.put.STA:
  4449.     mvi    a,(sta)
  4450.     jmp    put.code.byte
  4451. ;
  4452. put.STA.A:
  4453.     lhld    ste.A.address
  4454.     jmp    put.STA.hl
  4455. ;
  4456. put.STA.B:
  4457.     lhld    ste.B.address
  4458.     jmp    put.STA.hl
  4459. ;
  4460. put.STA.C:
  4461.     lhld    ste.C.address
  4462. ;
  4463. put.STA.hl:
  4464.     push    h
  4465.     lda    opt.HL.status
  4466.     ani    opt.cnst
  4467.     jz    put.STA.not.MOV
  4468. ;
  4469.     xchg
  4470.     lhld    opt.HL.value
  4471.     call    sub.de.fm.hl.2.hl
  4472.     mov    a,h
  4473.     ora    l
  4474.     jnz    put.STA.not.0
  4475.     call    put.MOV.M.A
  4476.     jmp    put.STA.set.up
  4477. ;
  4478. put.STA.not.0:
  4479.     dcx    h
  4480.     mov    a,h
  4481.     ora    l
  4482.     jnz    put.STA.chk.1
  4483.     call    put.DCX.H
  4484.     call    put.MOV.M.A
  4485.     jmp    put.STA.set.up
  4486. ;
  4487. put.STA.chk.1:
  4488.     inx    h
  4489.     inx    h
  4490.     mov    a,h
  4491.     ora    l
  4492.     xchg
  4493.     jnz    put.STA.not.MOV
  4494.     call    put.INX.H
  4495.     call    put.MOV.M.A
  4496.     jmp    put.STA.set.up
  4497. ;
  4498. put.STA.not.MOV:
  4499.     call    do.put.STA
  4500.     pop    h
  4501.     push    h
  4502.     call    put.code.word
  4503.     ;---A is now also a byte-contents---
  4504. put.STA.set.up:
  4505. ;---if A is already byte-cont., don't change it---
  4506.     lda    opt.A.status
  4507.     ani    opt.byte.contents
  4508.     jnz    put.STA.already.b.c
  4509.     pop    h
  4510.     push    h
  4511.     shld    opt.A.address
  4512.     lxi    h,0
  4513.     shld    opt.A.offset
  4514.     mvi    a,opt.byte.contents
  4515.     call    opt.add.A.status
  4516. put.STA.already.b.c:
  4517.     pop    d
  4518.     lda    opt.HL.status
  4519.     ani    opt.word.contents + opt.byte.contents
  4520.     rz        ;don't worry about it
  4521.     lhld    opt.HL.address
  4522.     xchg
  4523.     call    sub.de.fm.hl.2.hl
  4524.     mov    a,h
  4525.     ora    a
  4526.     rnz        ;not close enough
  4527.     mov    a,l
  4528.     cpi    2
  4529.     rnc        ;not close enough
  4530.     jmp    opt.undef.HL
  4531. ;
  4532. ;
  4533. put.STAX.D:
  4534.     call    opt.memory.modify
  4535.     mvi    a,12h
  4536.     jmp    put.code.byte
  4537. ;
  4538. ;
  4539. put.SUI:
  4540.     call    opt.undef.A
  4541. do.put.SUI:
  4542.     mvi    a,(sui)
  4543.     jmp    put.code.byte
  4544. ;
  4545. put.SUI.L:
  4546.     mov    a,l
  4547.     ora    a
  4548.     rz
  4549.     lda    opt.A.status
  4550.     ani    opt.cnst
  4551.     jz    do.put.SUI.L
  4552.     mov    a,l
  4553.     dcr    a
  4554.     jz    put.DCR.A
  4555.     inr a ! inr a
  4556.     jz    put.INR.A
  4557. do.put.SUI.L:
  4558.     push    h
  4559.     call    do.put.SUI
  4560.     pop    h
  4561.     push    h
  4562.     call    negate.HL
  4563.     call    opt.add.A.value
  4564.     pop    h
  4565.     mov    a,l
  4566.     jmp    put.code.byte
  4567. ;
  4568. ;
  4569. put.SUB.M:
  4570.     call    opt.undef.A
  4571.     mvi    a,96h
  4572.     jmp    put.code.byte
  4573. ;
  4574. ;
  4575. put.sub.16:
  4576.     call    opt.undef.all
  4577.     lda    Z80.flag
  4578.     ora    a
  4579.     jz    put.sub.16.8080
  4580.     call    put.ORA.A
  4581.     lxi    h,52edh        ;SBC
  4582.     jmp    put.code.word
  4583. put.sub.16.8080:
  4584.     mvi    a,bir.sub.16
  4585.     jmp    put.bir.call.fwd
  4586. ;
  4587. ;
  4588. put.xor.16:
  4589.     mvi    a,bir.xor.16
  4590.     jmp    put.bir.call.fwd
  4591. ;
  4592. ;
  4593. put.XRA.A:
  4594.     mvi    a,0afh
  4595.     call    put.code.byte
  4596.     jmp    opt.A.zero
  4597. ;
  4598. ;
  4599. put.XRA.M:
  4600.     call    opt.undef.A
  4601.     mvi    a,0AEh
  4602.     jmp    put.code.byte
  4603. ;
  4604. ;
  4605. put.XRI:
  4606.     call    opt.undef.A
  4607. do.put.XRI:
  4608.     mvi    a,(xri)
  4609.     jmp    put.code.byte
  4610. ;
  4611. put.XRI.B:
  4612.     lhld    ste.B.address
  4613. put.XRI.L:
  4614.     lda    opt.A.status
  4615.     ani    opt.cnst
  4616.     jz    put.XRI.A.undef
  4617.     mov    a,l
  4618.     ora    a
  4619.     rz        ;xoring w/ zero = no change
  4620.     inr    a
  4621.     jz    put.CMA    ;xor w/ FF = complement
  4622.     lxi    h,opt.A.value
  4623.     xra    m
  4624.     cmp    m
  4625.     rz        ;still no change
  4626.     mov    m,a
  4627.     jmp    do.put.XRI.L
  4628. put.XRI.A.undef:
  4629.     call    opt.undef.A
  4630. do.put.XRI.L:
  4631.     push    h
  4632.     call    do.put.XRI
  4633.     pop    h
  4634.     mov    a,l
  4635.     jmp    put.code.byte
  4636. ;
  4637. ;
  4638.     
  4639. ;
  4640. ;
  4641. put.XCHG:
  4642.     call    opt.undef.HL
  4643.     mvi    a,(xchg)
  4644.     jmp    put.code.byte
  4645. ;
  4646. ;
  4647. ;
  4648. ;
  4649. ;
  4650. ;
  4651. ;======================
  4652. ;    OPTIMISATION
  4653. ;======================
  4654. ;
  4655. opt.undef        equ    0
  4656. opt.cnst        equ    1
  4657. opt.byte.contents    equ    2
  4658. opt.word.contents    equ    4
  4659. ;
  4660. ;
  4661. opt.A.status:    db    0
  4662. opt.A.value:    dw    0
  4663. opt.A.address:    dw    0
  4664. opt.A.offset:    dw    0
  4665. ;
  4666. opt.HL.status:    db    0
  4667. opt.HL.value:    dw    0
  4668. opt.HL.address:    dw    0
  4669. opt.HL.offset:    dw    0
  4670. ;
  4671. ;---called at labels, CALLs, and whenever not sure---
  4672. ;
  4673. opt.undef.all:
  4674.     mvi    a,opt.undef
  4675.     sta    opt.A.status
  4676.     sta    opt.HL.status
  4677.     ret
  4678. ;
  4679. ;
  4680. ;
  4681. ;
  4682. opt.make.HL.cnst:
  4683.     mvi    a,opt.cnst
  4684.     jmp    opt.set.HL.status
  4685. ;
  4686. opt.add.HL.status:
  4687.     lhld    opt.HL.status
  4688.     ora    l
  4689.     jmp    opt.set.HL.status
  4690. ;
  4691. opt.undef.HL:
  4692.     mvi    a,opt.undef
  4693. opt.set.HL.status:
  4694.     sta    opt.HL.status
  4695.     ret
  4696. ;
  4697. ;
  4698. opt.add.HL.value:
  4699.     xchg
  4700.     lhld    opt.HL.value
  4701.     dad    d
  4702.     shld    opt.HL.value
  4703.     lhld    opt.HL.offset
  4704.     dad    d
  4705.     shld    opt.HL.offset
  4706.     ret
  4707. opt.make.A.cnst:
  4708.     mvi    a,opt.cnst
  4709.     jmp    opt.set.A.status
  4710. ;
  4711. opt.add.A.status:
  4712.     lhld    opt.A.status
  4713.     ora    l
  4714.     jmp    opt.set.A.status
  4715. ;
  4716. opt.undef.A:
  4717.     mvi    a,opt.undef
  4718. opt.set.A.status:
  4719.     sta    opt.A.status
  4720.     ret
  4721. ;
  4722. ;
  4723. opt.add.A.value:
  4724.     xchg
  4725.     lhld    opt.A.value
  4726.     dad    d
  4727.     shld    opt.A.value
  4728.     lhld    opt.A.offset
  4729.     dad    d
  4730.     shld    opt.A.offset
  4731.     ret
  4732. ;
  4733. ;---called when something changes something in memory---
  4734. ;
  4735. opt.@HL.modify:
  4736.     lda    opt.HL.status
  4737.     ani    opt.cnst + opt.byte.contents
  4738.     cpi    opt.cnst + opt.byte.contents
  4739.     jnz    opt.memory.modify
  4740.     lhld    opt.HL.address
  4741.     xchg
  4742.     lhld    opt.HL.offset
  4743.     dad    d
  4744.     xchg
  4745.     lhld    opt.HL.value
  4746.     call    sub.de.fm.hl.2.hl
  4747.     mov    a,h
  4748.     ora    l
  4749.     jnz    opt.A.mem.mod
  4750. ;---modifying where HL points - undef---
  4751. opt.memory.modify:
  4752.     lxi    h,opt.HL.status
  4753.     mov    a,m
  4754.     ani    0ffh - (opt.byte.contents OR opt.word.contents)
  4755.     mov    m,a
  4756. opt.A.mem.mod:
  4757.     lxi    h,opt.A.status
  4758.     mov    a,m
  4759.     ani    0ffh - (opt.byte.contents OR opt.word.contents)
  4760.     mov    m,a
  4761.     ret
  4762. ;
  4763. ;
  4764. ;
  4765. ;
  4766. ;===================================================
  4767. ;
  4768. ;    ERROR MESSAGE ROUTINES
  4769. ;
  4770. ;===================================================
  4771. ;
  4772. ;
  4773. ;
  4774. err.eof.on.src:
  4775.     lxi    h,em.SRC.eof
  4776.     jmp    print.error
  4777. ;
  4778. ;
  4779. err.buf.size:
  4780.     lxi    h,em.buf.size
  4781.     jmp    print.error
  4782. ;
  4783. err.COM.SRC:
  4784.     lxi    d,em.COM.SRC
  4785.     jmp    err.disp.and.abort
  4786. ;
  4787. ;
  4788. err.CPM.call:
  4789.     lxi    h,em.CPM.call
  4790.     jmp    print.warning
  4791. ;
  4792. ;
  4793. err.data.after.code:
  4794.     lxi    h,em.data.after.code
  4795.     jmp    print.warning
  4796. ;
  4797. ;
  4798. err.dupl.name:
  4799.     lxi    h,em.dupl.name
  4800.     jmp    print.error
  4801. ;
  4802. ;
  4803. err.expect.id:
  4804.     lxi    h,em.expect.id
  4805.     call    print.error.and.word
  4806.     jmp    print.error.colm
  4807. ;
  4808. ;
  4809. err.file.cant.io:
  4810.     lxi    h,em.file.cant.io
  4811.     jmp    print.error.and.colm
  4812. ;
  4813. ;
  4814. err.inv.cnst:
  4815.     lxi    h,em.inv.cnst
  4816.     jmp    print.error.and.colm
  4817. ;
  4818. ;
  4819. err.inv.dev.io:
  4820.     lxi    h,em.inv.dev.io
  4821.     jmp    print.error.and.colm
  4822. ;
  4823. ;
  4824. err.inv.FILE.id:
  4825.     lxi    h,em.inv.file.id
  4826.     jmp    print.error
  4827. ;
  4828. ;
  4829. err.inv.numeric.var:
  4830.     lxi    h,em.inv.num.var
  4831.     jmp    print.error.and.colm
  4832. ;
  4833. ;
  4834. err.inv.oprnd:
  4835.     lxi    h,em.inv.expr.oprnd
  4836.     jmp    print.error.and.colm
  4837. ;
  4838. ;
  4839. err.inv.override:
  4840.     lxi    h,em.inv.override
  4841.     call    print.error.and.word
  4842.     jmp    print.error.colm
  4843. ;
  4844. ;
  4845. err.inv.oprtr:
  4846.     lxi    h,em.inv.expr.oprtr
  4847.     jmp    print.error.and.colm
  4848. ;
  4849. ;
  4850. err.inv.ptr.var:
  4851.     lxi    h,em.inv.ptr.var
  4852.     jmp    print.error.and.colm
  4853. ;
  4854. ;
  4855. err.inv.STRING.size:
  4856.     lxi    h,em.inv.STRING.size
  4857.     jmp    print.error.and.colm
  4858. ;
  4859. ;
  4860. err.inv.VALUE:
  4861.     lxi    h,em.inv.VALUE
  4862.     jmp    print.error.and.colm
  4863. ;
  4864. ;
  4865. err.inv.var.type:
  4866.     lxi    h,em.inv.var.type
  4867.     jmp    print.error.and.colm
  4868. ;
  4869. ;
  4870. err.L.stk.ofl:
  4871.     lxi    h,em.L.stk.ofl
  4872.     jmp    print.error
  4873. ;
  4874. ;
  4875. err.missing.END:
  4876.     lxi    h,em.missing.END
  4877.     jmp    print.error
  4878. ;
  4879. ;
  4880. err.missing.ENDREC:
  4881.     lxi    h,em.missing.ENDREC
  4882.     jmp    print.error
  4883. ;
  4884. ;
  4885. err.missing.ENDREDEF:
  4886.     lxi    h,em.missing.ENDREDEF
  4887.     jmp    print.error
  4888. ;
  4889. ;
  4890. err.missing.ENDSWITCH:
  4891.     lxi    h,em.missing.ENDSWITCH
  4892.     jmp    print.error
  4893. ;
  4894. ;
  4895. err.missing.FI:
  4896.     lxi    h,em.missing.FI
  4897.     jmp    print.error
  4898. ;
  4899. ;
  4900. err.missing.OD:
  4901.     lxi    h,em.missing.OD
  4902.     jmp    print.error
  4903. ;
  4904. ;
  4905. err.mssng.rsvd.wd:
  4906.     lxi    h,em.mssng.rsvd.wd
  4907.     jmp    print.error.and.colm
  4908. ;
  4909. ;
  4910. err.nested.copy:
  4911.     lxi    h,em.nested.copy
  4912.     jmp    print.error
  4913. ;
  4914. ;
  4915. err.nested.overlay:
  4916.     lxi    h,em.nested.overlay
  4917.     jmp    print.error
  4918. ;
  4919. ;
  4920. err.no.rec:
  4921.     lxi    h,em.no.rec
  4922.     jmp    print.error
  4923. ;
  4924. ;
  4925. err.no.SRC:
  4926.     lxi    d,em.no.SRC
  4927. err.disp.and.abort:
  4928.     mvi    c,9
  4929.     call    entry
  4930.     jmp    boot
  4931. ;
  4932. ;
  4933. err.no.term.byte:
  4934.     lxi    h,em.no.term.byte
  4935.     jmp    print.warning
  4936. ;
  4937. ;
  4938. err.not.rom.able:
  4939.     lxi    h,em.not.rom.able
  4940.     jmp    print.warning
  4941. ;
  4942. ;
  4943. err.ovl.call.ovl:
  4944.     lxi    h,em.ovl.call.ovl
  4945.     jmp    print.error
  4946. ;
  4947. ;
  4948. err.pad.string:
  4949.     lxi    h,em.pad.string
  4950.     jmp    print.warning
  4951. ;
  4952. ;
  4953. err.redef.sz:
  4954.     lxi    h,em.redef.sz
  4955.     jmp    print.error
  4956. ;
  4957. ;
  4958. err.truncate:
  4959.     lxi    h,em.truncate
  4960.     jmp    print.warning
  4961. ;
  4962. ;
  4963. err.undef.file.name:
  4964.     lxi    h,em.undef.file.name
  4965.     jmp    print.error.and.colm
  4966. ;
  4967. ;
  4968. err.undef.label:
  4969.     lxi    h,em.undef.label
  4970.     jmp    print.error.and.colm
  4971. ;
  4972. ;
  4973. err.undef.var:
  4974.     lxi    h,em.undef.var
  4975.     jmp    print.error
  4976. ;
  4977. ;
  4978. err.unexpect.word:
  4979.     lxi    h,em.unexpect.word
  4980.     call    print.error.and.word
  4981.     call    get.word
  4982.     jmp    print.error.colm
  4983. ;
  4984. ;
  4985. err.unmtchd.ELSE:
  4986.     lxi    h,em.unmtchd.ELSE
  4987.     jmp    print.error
  4988. ;
  4989. ;
  4990. err.unmtchd.END:
  4991.     lxi    h,em.unmtchd.END
  4992.     jmp    print.error
  4993. ;
  4994. ;
  4995. err.unmtchd.ENDREC:
  4996.     lxi    h,em.unmtchd.ENDREC
  4997.     jmp    print.error
  4998. ;
  4999. ;
  5000. err.unmtchd.ENDREDEF:
  5001.     lxi    h,em.unmtchd.ENDREDEF
  5002.     jmp    print.error
  5003. ;
  5004. ;
  5005. err.unmtchd.ENDSWITCH:
  5006.     lxi    h,em.unmtchd.ENDSWITCH
  5007.     jmp    print.error
  5008. ;
  5009. ;
  5010. err.unmtchd.FI:
  5011.     lxi    h,em.unmtchd.FI
  5012.     jmp    print.error
  5013. ;
  5014. ;
  5015. err.unmtchd.OD:
  5016.     lxi    h,em.unmtchd.OD
  5017.     jmp    print.error
  5018. ;
  5019. ;
  5020. ;
  5021. err.unreq.stmt:
  5022.     lxi    h,em.unreq.stmt
  5023.     call    print.error
  5024.     jmp    get.word
  5025. ;
  5026. ;
  5027. ;
  5028. ;
  5029. ;
  5030. ;
  5031. ;
  5032. ;--------------misc text literals--------
  5033. ;
  5034. em.blk.lvl.ofl:
  5035.     db    'block level underflow (internal)',0
  5036. em.buf.size:
  5037.     db    'invalid RECORD / BUFFER size',0
  5038. em.COM.SRC:
  5039.     db    'Can''t write object to .SRC',13,10,'$'
  5040. em.CPM.call:
  5041.     db    'CP/M call in standalone program',0
  5042. em.data.after.code:
  5043.     db    'warning - data following code',0
  5044. em.dupl.name:
  5045.     db    'duplicate identifier',0
  5046. em.expect.id:
  5047.     db    'expecting identifier',0
  5048. em.file.cant.io:
  5049.     db    'file can''t be opened I/O',0
  5050. em.inv.cnst:
  5051.     db    'invalid constant',0
  5052. em.inv.dev.io:
  5053.     db    'I/O action inconsistant with device',0
  5054. em.inv.SRC.char:
  5055.     db    'invalid character in source - ignored',0
  5056. em.inv.STRING.size:
  5057.     db    'invalid string size',0
  5058. em.inv.VALUE:
  5059.     db    'invalid value this type',0
  5060. em.inv.expr.oprnd:
  5061.     db    'invalid expression operand',0
  5062. em.inv.expr.oprtr:
  5063.     db    'invalid expression operator',0
  5064. em.inv.file.id:
  5065.     db    'invalid file id',0
  5066. em.inv.num.var:
  5067.     db    'invalid numeric variable',0
  5068. em.inv.override:
  5069.     db    'invalid override - ',0
  5070. em.inv.ptr.var:
  5071.     db    'invalid pointer variable',0
  5072. em.inv.var.type:
  5073.     db    'invalid variable type',0
  5074. em.L.stk.ofl:
  5075.     db    'compiler stack overflow - '
  5076.     db    'increase CSTACK',0
  5077. em.missing.END:
  5078.     db    'missing END',0
  5079. em.missing.ENDREC:
  5080.     db    'missing ENDREC',0
  5081. em.missing.ENDREDEF:
  5082.     db    'missing ENDREDEF',0
  5083. em.missing.ENDSWITCH:
  5084.     db    'missing ENDSWITCH',0
  5085. em.missing.FI:
  5086.     db    'missing FI',0
  5087. em.missing.OD:
  5088.     db    'missing OD',0
  5089. em.mssng.rsvd.wd:
  5090.      db    'missing reserved word',0
  5091. em.nested.copy:
  5092.     db    'COPY nesting exceeded',0
  5093. em.nested.overlay:
  5094.     db    'nested overlay',0
  5095. em.no.rec:
  5096.     db    'record not declared for file',0
  5097. em.no.term.byte:
  5098.     db    'warning -- no space for string '
  5099.     db    'terminator',0
  5100. em.not.rom.able:
  5101.     db    'warning --- non-rom-able code',0
  5102. em.ovl.call.ovl:
  5103.     db    'Can''t call overlay from overlay',0
  5104. em.pad.string:
  5105.     db    'warning --- string value larger than'
  5106.     db    ' size declared, truncated',0
  5107. em.SRC.eof:
  5108.     db    'unexpected end of input',0
  5109. em.redef.sz:
  5110.     db    'redefine size error',0
  5111. em.truncate:
  5112.     db    'truncation warning',0
  5113. em.undef.label:
  5114.     db    'undefined label',0
  5115. em.undef.file.name:
  5116.     db    'undefined file name',0
  5117. em.undef.var:
  5118.     db    'undefined variable',0
  5119. em.unexpect.word:
  5120.     db    'unexpected word near - ',0
  5121. em.unmtchd.ELSE:
  5122.     db    'unmatched ELSE',0
  5123. em.unmtchd.END:
  5124.     db    'unmatched END',0
  5125. em.unmtchd.ENDREC:
  5126.     db    'unmatched ENDREC',0
  5127. em.unmtchd.ENDREDEF:
  5128.     db    'unmatched ENDREDEF',0
  5129. em.unmtchd.ENDSWITCH:
  5130.     db    'unmatched ENDSWITCH',0
  5131. em.unmtchd.FI:
  5132.     db    'unmatched FI',0
  5133. em.unmtchd.OD:
  5134.     db    'unmatched OD',0
  5135. em.unreq.stmt:
  5136.     db    'unrecognized statement',0
  5137. ;
  5138. ;
  5139. ;
  5140. txt.src.rd.err:
  5141.     db    'SRC file read error',13,10,'$'
  5142. em.no.SRC:
  5143.     db    'no SRC file present',13,10,'$'
  5144. ;
  5145. ;
  5146. ;
  5147. ;
  5148. ;
  5149. ;
  5150. ;
  5151. ;
  5152. ;
  5153. ;------misc utility routines--------
  5154. ;
  5155. ;
  5156. ; in:    hl -> buffer area
  5157. ;    c  =  buffer size - 1
  5158. ;
  5159. ; out:    buffer = string which was input
  5160. ;    2 CP/M bytes at front stripped off
  5161. ;
  5162. ;
  5163. ACCEPT.from.console:
  5164.     mov    m,c
  5165.     inx    h
  5166.     mov    m,c
  5167.     push    h
  5168.     dcx    h
  5169.     xchg
  5170.     mvi    c,10
  5171.     call    entry
  5172.     pop    h
  5173.     push    h
  5174.     mov    e,m
  5175.     mvi    d,0
  5176.     dad    d
  5177.     inx    h
  5178.     mvi    m,0
  5179.     call    display.crlf
  5180.     pop    h
  5181.     mov    e,l
  5182.     mov    d,h
  5183.     inx    h
  5184.     dcx    d
  5185.     jmp    move.string
  5186. ;
  5187. ;
  5188. ;--------------------------------------------------
  5189. ;
  5190. AND.d.and.h:
  5191.     mov    a,d
  5192.     ana    h
  5193.     mov    h,a
  5194.     mov    a,e
  5195.     ana    l
  5196.     mov    l,a
  5197.     ora    h
  5198.     ret
  5199. ;
  5200. ;--------------------------------------------------
  5201. ;
  5202. ;
  5203. ;
  5204. ;   bcd compare
  5205. ; in:    hl -> #1
  5206. ;    de -> #2
  5207. ;
  5208. ; out:    non-zero + carry:    @hl > @de
  5209. ;    zero            @hl = @de
  5210. ;    non-zero + no carry:    @hl < @de
  5211. ;
  5212. bcd.compare:
  5213.     ldax    d
  5214.     ani    80h
  5215.     jz    bcd.comp.de.pos
  5216. ;
  5217.     mov    a,m
  5218.     ani    80h
  5219.     jz    bcd.comp.de.neg.hl.pos
  5220. ;  de- hl-
  5221.     call    bcd.comp.de.pos.hl.pos
  5222.     cmc
  5223.     ret
  5224. ;
  5225. bcd.comp.de.pos:
  5226.     mov    a,m
  5227.     ani    80h
  5228.     jz    bcd.comp.de.pos.hl.pos
  5229. ;  de+ hl-
  5230.     mvi    a,1
  5231.     ora    a
  5232.     ret
  5233. ;
  5234. bcd.comp.de.neg.hl.pos:
  5235.     mvi    a,1
  5236.     ora    a
  5237.     stc
  5238.     ret
  5239. ;
  5240. bcd.comp.de.pos.hl.pos:
  5241.     inx    d
  5242.     inx    h
  5243.     lxi    b,bcd.size - 1
  5244.             ;fall into cmp.blk
  5245. ;
  5246. cmp.blk:
  5247.     mov    a,b
  5248.     ora    c
  5249.     rz
  5250.     ldax    d
  5251.     cmp    m
  5252.     rnz
  5253.     dcx    b
  5254.     inx    h
  5255.     inx    d
  5256.     jmp    cmp.blk
  5257. ;
  5258. ;
  5259. ;--------------------------------------------------
  5260. ;
  5261. compare.strings:
  5262.     ldax    d
  5263.     cmp    m
  5264.     rnz
  5265.     inx    h
  5266.     inx    d
  5267.     ora    a
  5268.     rz
  5269.     jmp    compare.strings
  5270. ;
  5271. ;--------------------------------------------------
  5272. ;
  5273. cmp.de.fm.hl:
  5274.     mov    a,h
  5275.     cmp    d
  5276.     rnz
  5277.     mov    a,l
  5278.     cmp    e
  5279.     ret
  5280. ;
  5281. ;--------------------------------------------------
  5282. ;
  5283. cmp.hl.fm.de:
  5284.     mov    a,d
  5285.     cmp    h
  5286.     rnz
  5287.     mov    a,e
  5288.     cmp    l
  5289.     ret
  5290. ;
  5291. ;===========================================
  5292. ;
  5293. ; in:    hl = #
  5294. ;    de -> str
  5295. ;
  5296. cvt.bin.2.dec.str:
  5297.     xchg
  5298.     push    h
  5299.     lxi    h,cb2d.wk + 5
  5300.     mvi    m,0
  5301. cb2d.lup:
  5302.     dcx    h
  5303.     push    h
  5304.     lxi    h,10
  5305.     call    cmp.hl.fm.de
  5306.     jc    cb2d.done
  5307.     call    div.d.by.h.2.d.r.h
  5308.     mov    a,l
  5309.     pop    h
  5310.     ori    '0'
  5311.     mov    m,a
  5312.     jmp    cb2d.lup
  5313. cb2d.done:
  5314.     pop    h
  5315.     mov    a,e
  5316.     ori    '0'
  5317.     mov    m,a
  5318.     pop    d
  5319.     jmp    move.string
  5320. ;
  5321. cb2d.wk:    db    '000000'
  5322. ;
  5323. ;--------------------------------------------------
  5324. ;
  5325. ; in:    hl = #
  5326. ;    de -> str
  5327. ;
  5328. cvt.bin.2.hex.str:
  5329.     xchg
  5330.     mov    a,d
  5331.     call    hex.left
  5332.     call    hex.right
  5333.     mov    a,e
  5334.     call    hex.left
  5335.     call    hex.right
  5336.     mvi    m,0
  5337.     ret
  5338. hex.left:
  5339.     push    psw
  5340.     rrc
  5341.     rrc
  5342.     rrc
  5343.     rrc
  5344.     jmp    hex.digit
  5345. hex.right:
  5346.     push    psw
  5347. hex.digit:
  5348.     ani    0fh
  5349.     adi    '0'
  5350.     cpi    '9'+1
  5351.     jc    hex.9
  5352.     adi    7
  5353. hex.9:
  5354.     mov    m,a
  5355.     inx    h
  5356.     pop    psw
  5357.     ret
  5358. ;
  5359. ;
  5360. ;--------------------------------------------------
  5361. ;
  5362. ;
  5363. ;
  5364. ; in:    hl -> string
  5365. ;    de -> bcd
  5366. cvt.str.2.bcd:
  5367.     push    h
  5368.     mov    h,d
  5369.     mov    l,e
  5370.     push    h
  5371.     inx    d
  5372.     xra    a
  5373.     mov    m,a
  5374.     lxi    b,(bcd.size - 1)
  5375.     call    move.h.2.d.cnt.b
  5376. ;
  5377.     pop    d
  5378.     pop    h
  5379.     mov    a,m
  5380.     cpi    '-'
  5381.     jnz    cs2bcd.plus
  5382.     inx    h
  5383.     mvi    a,80h
  5384.     jmp    cs2bcd.sign
  5385. cs2bcd.plus:
  5386.     xra    a
  5387. cs2bcd.sign:
  5388.     push    psw
  5389. cs2bcd.lup:
  5390.     mov    a,m
  5391.     cpi    '.'
  5392.     jz    cs2bcd.point
  5393.     sui    '0'
  5394.     jc    cs2bcd.end
  5395.     cpi    9 + 1
  5396.     jnc    cs2bcd.end
  5397. ;
  5398.     push    h
  5399.     push    d
  5400.     push    psw
  5401.     lxi    b,bcd.size - 1
  5402.     inx    d
  5403.     xchg
  5404.     call    bcd.shift.left
  5405.     pop    psw
  5406.     pop    d
  5407.     lxi    h,(bcd.size - 1)
  5408.     dad    d
  5409.     ora    m
  5410.     mov    m,a
  5411.     pop    h
  5412. cs2bcd.point:
  5413.     inx    h
  5414.     jmp    cs2bcd.lup
  5415. ;
  5416. cs2bcd.end:
  5417.     pop    psw
  5418.     stax    d
  5419.     ret
  5420. ;
  5421. ;
  5422. ;
  5423. bcd.shift.left:
  5424.     push    h
  5425.     push    d
  5426.     mov    e,c
  5427.     mvi    d,0
  5428.     dcx    d
  5429.     dad    d
  5430. bcd.shl.lup:
  5431.     mov    a,m
  5432.     rrc ! rrc ! rrc ! rrc
  5433.     ani    0fh
  5434.     mov    e,a
  5435.     mov    a,m
  5436.     rlc ! rlc ! rlc ! rlc
  5437.     ani    0f0h
  5438.     ora    d
  5439.     mov    m,a
  5440.     mov    d,e
  5441.     dcx    h
  5442.     dcr    c
  5443.     jnz    bcd.shl.lup
  5444.     mov    a,e
  5445.     pop    d
  5446.     pop    h
  5447.     ret
  5448. ;
  5449. ;
  5450. ;--------------------------------------------------
  5451. ;
  5452. display.crlf:
  5453.     lxi    d,display.txt.crlf
  5454.     mvi    c,9
  5455.     jmp    entry
  5456. display.txt.crlf:
  5457.     db    13,10,'$'
  5458. ;
  5459. ;
  5460. ;
  5461. ;
  5462. ;===========================================
  5463. ;
  5464. ; in:    hl -> string
  5465. ;
  5466. ; out:    hl -> string terminator
  5467. ;
  5468. cvt.str.to.lower.case:
  5469.     mov    a,m
  5470.     ora    a
  5471.     rz
  5472.     cpi    'A'
  5473.     jc    cslc.no
  5474.     cpi    'Z'+1
  5475.     jnc    cslc.no
  5476.     adi    'a'-'A'
  5477.     mov    m,a
  5478. cslc.no:
  5479.     inx    h
  5480.     jmp    cvt.str.to.lower.case
  5481. cslc.map:
  5482. ;----------------------------------------------
  5483. ;  DIVIDE  DE  BY  HL
  5484. ;    QUOTIENT IS RETURNED IN  DE
  5485. ;    REMAINDER IS RETURNED IN  HL
  5486. ;----------------------------------------------
  5487. div.d.by.h.2.d.r.h:
  5488.     mov    b,h
  5489.     mov    c,l
  5490.     xra    a
  5491.     mov    l,a
  5492.     mov    h,a
  5493.     mvi    a,16
  5494. divdhb2drhloop:
  5495.     push    psw
  5496.     dad    h
  5497.     xra    a
  5498.     xchg
  5499.     dad    h
  5500.     xchg
  5501.     adc    l
  5502.     sub    c
  5503.     mov    l,a
  5504.     mov    a,h
  5505.     sbb    b
  5506.     mov    h,a
  5507.     inx    d
  5508.     jnc    divdhb2drhover
  5509.     dad    b
  5510.     dcx    d
  5511. divdhb2drhover:
  5512.     pop    psw
  5513.     dcr    a
  5514.     rz
  5515.     jmp    divdhb2drhloop
  5516. ;===============================================
  5517. ;-------------------------------------------
  5518. ;  format file name
  5519. ;
  5520. ;  incoming parameters:
  5521. ;  de points to fcb
  5522. ;  hl points to alpha file-name
  5523. ;
  5524. ;  outgoing parameters:
  5525. ;  hl points to the character after the last one used
  5526. ;  the fcb will be fully initialized (for 33 bytes)
  5527. ;--------------------------------------------------
  5528. format.file.name:
  5529.     push    d
  5530.     mvi    c,fcb.rnd.rec + 2
  5531.     xra    a
  5532.     call    ffn.fill
  5533.     pop    d
  5534.     mvi    c,8
  5535.     inx    h
  5536.     mov    a,m
  5537.     dcx    h
  5538.     inx    d
  5539.     cpi    ':'
  5540.     jnz    ffn.name.lup
  5541.     dcx    d
  5542.     mov    a,m
  5543.     inx    h
  5544.     inx    h
  5545.     sui    'A'-1
  5546.     stax    d
  5547.     inx    d
  5548. ffn.name.lup:
  5549.     mov    a,m
  5550.     inx    h
  5551.     ora    a
  5552.     jz    ffn.delim.found
  5553.     cpi    '.'
  5554.     jz    ffn.end.name
  5555.     cpi    '*'
  5556.     jnz    ffn.name.not.star
  5557.     call    ffn.fill.q
  5558.     jmp    ffn.skip.name
  5559. ;
  5560. ffn.name.not.star:
  5561.     stax    d
  5562.     inx    d
  5563.     dcr    c
  5564.     jnz    ffn.name.lup
  5565. ffn.skip.name:
  5566.     mov    a,m
  5567.     inx    h
  5568.     cpi    '.'
  5569.     jz    ffn.end.name
  5570.     ora    a
  5571.     jz    ffn.delim.found
  5572.     jmp    ffn.skip.name
  5573. ;
  5574. ffn.end.name:
  5575.     mov    a,c
  5576.     ora    a
  5577.     jz    ffn.do.ext
  5578.     call    ffn.fill.b
  5579. ffn.do.ext:
  5580.     mvi    c,3
  5581. ffn.ext.lup:
  5582.     mov    a,m
  5583.     inx    h
  5584.     ora    a
  5585.     jz    ffn.fill.b
  5586.     cpi    '*'
  5587.     jz    ffn.fill.q
  5588.     stax    d
  5589.     inx    d
  5590.     dcr    c
  5591.     jnz    ffn.ext.lup
  5592.     ret
  5593. ;
  5594. ;
  5595. ffn.delim.found:
  5596.     mov    a,c
  5597.     ora    a
  5598.     cnz    ffn.fill.b
  5599.     mvi    c,3
  5600. ffn.fill.b:
  5601.     mvi    a,' '
  5602. ffn.fill:
  5603.     stax    d
  5604.     inx    d
  5605.     dcr    c
  5606.     jnz    ffn.fill
  5607.     ret
  5608. ;
  5609. ffn.fill.q:
  5610.     mvi    a,'?'
  5611.     jmp    ffn.fill
  5612. ;
  5613. ;
  5614. ;--------------------------------------------------
  5615. ;
  5616. ;
  5617. ;
  5618. ;====================================================
  5619. ;
  5620. ; in:    hl -> byte after last in src
  5621. ;    de -> byte after last in dst
  5622. ;    bc =  # bytes to move
  5623. ;
  5624. move.bkwds.h.2.d.cnt.b:
  5625.     mov    a,c
  5626.     ora    b
  5627.     rz
  5628.     dcx    h
  5629.     dcx    d
  5630.     mov    a,m
  5631.     stax    d
  5632.     dcx    b
  5633.     jmp    move.bkwds.h.2.d.cnt.b
  5634. ;
  5635. ;--------------------------------------------------
  5636. ;
  5637. move.h.2.d.cnt.b:
  5638.     mov    a,c
  5639.     ora    b
  5640.     rz
  5641.     mov    a,m
  5642.     stax    d
  5643.     inx    h
  5644.     inx    d
  5645.     dcx    b
  5646.     jmp    move.h.2.d.cnt.b
  5647. ;
  5648. ;--------------------------------------------------
  5649. ;
  5650. ; in:    hl -> src
  5651. ;    de -> dst
  5652. ;
  5653. move.string:
  5654.     mov    a,m
  5655.     stax    d
  5656.     inx    h
  5657.     inx    d
  5658.     ora    a
  5659.     rz
  5660.     jmp    move.string
  5661. ;
  5662. ;
  5663. ;------------------------------------
  5664. ;  MULTIPLY  HL  BY  DE  GIVING  HL
  5665. ;------------------------------------
  5666. mul.h.by.d.2.h:
  5667.     mov    b,h
  5668.     mov    c,l
  5669.     xra    a
  5670.     mov    h,a
  5671.     mov    l,a
  5672.     mvi    a,16
  5673. mulhbd2hloop:
  5674.     dad    h
  5675.     xchg
  5676.     dad    h
  5677.     xchg
  5678.     jnc    mulhbd2hover
  5679.     dad    b
  5680. mulhbd2hover:
  5681.     dcr    a
  5682.     rz
  5683.     jmp    mulhbd2hloop
  5684. ;
  5685. ;--------------------------------------------------
  5686. ;
  5687. negate.HL:
  5688.     mov    a,h
  5689.     cma
  5690.     mov    h,a
  5691.     mov    a,l
  5692.     cma
  5693.     mov    l,a
  5694.     inx    h
  5695.     ret
  5696. ;
  5697. ;
  5698. ;--------------------------------------------------
  5699. ;
  5700. OR.d.and.h:
  5701.     mov    a,d
  5702.     ora    h
  5703.     mov    h,a
  5704.     mov    a,e
  5705.     ora    l
  5706.     mov    l,a
  5707.     ora    h
  5708.     ret
  5709. ;
  5710. ;--------------------------------------------------
  5711. ;
  5712. ; in:    de -> string
  5713. ;
  5714. ; out:    hl = size (excluding terminator)
  5715. ;    de -> string terminator
  5716. ;
  5717. size.d.2.h:
  5718.     lxi    h,0
  5719. sd2h.lup:
  5720.     ldax    d
  5721.     ora    a
  5722.     rz
  5723.     inx    h
  5724.     inx    d
  5725.     jmp    sd2h.lup
  5726. ;
  5727. ;
  5728. ;--------------------------------------------------
  5729. ;
  5730. sub.de.fm.hl.2.hl:
  5731.     mov    a,l
  5732.     sub    e
  5733.     mov    l,a
  5734.     mov    a,h
  5735.     sbb    d
  5736.     mov    h,a
  5737.     ret
  5738. ;
  5739. XOR.d.and.h:
  5740.     mov    a,d
  5741.     xra    h
  5742.     mov    h,a
  5743.     mov    a,e
  5744.     xra    l
  5745.     mov    l,a
  5746.     ora    h
  5747.     ret
  5748. ;
  5749. ;%%%%%%%%%%BOJ routine only%%%%%%%%%
  5750. ;
  5751. ;
  5752. ;
  5753. ;--------------------------------------------------
  5754. ;
  5755. ; in:    de -> fcb
  5756. ;    c = open-type (15 or 22)
  5757. ;    a = run-time flags value
  5758. ;
  5759. ; out:    a = open status
  5760. ;
  5761. ;
  5762. open.disk.file:
  5763.     lxi    h,fcb.flags
  5764.     dad    d
  5765.     mov    m,a
  5766. ;
  5767.     lxi    h,fcb.ext.num
  5768.     xra    a
  5769.     dad    d
  5770.     mov    m,a
  5771. ;
  5772.     lxi    h,fcb.cur.rec
  5773.     dad    d
  5774.     mov    m,a
  5775. ;
  5776.     push    d
  5777.     call    entry
  5778.     pop    d
  5779. ;
  5780.     lxi    h,fcb.status
  5781.     dad    d
  5782.     mov    m,a
  5783.     ret
  5784. ;
  5785. ;
  5786. ; in:    de -> fcb
  5787. ;
  5788. disk.ch.in.open:
  5789.     lxi    h,fcb.buf.size + 1
  5790.     dad    d
  5791.     mov    b,m
  5792.     dcx    h
  5793.     mov    c,m
  5794.     dcx    h
  5795.     mov    m,b
  5796.     dcx    h
  5797.     mov    m,c
  5798.     ret
  5799. ;
  5800. ;--------------------------------------------------
  5801. ;
  5802. ; in:    de -> fcb
  5803. ;
  5804. disk.ch.out.open:
  5805.     lxi    h,fcb.buf.ix + 1
  5806.     dad    d
  5807.     xra    a
  5808.     mov    m,a
  5809.     dcx    h
  5810.     mov    m,a
  5811.     ret
  5812. ;
  5813. ;--------------------------------------------------
  5814. ;
  5815. ; in:    de -> fcb
  5816. ;
  5817. ; out:    de -> buffer address of character
  5818. ;    a  =  character
  5819. ;
  5820. disk.char.in:
  5821.     mvi    a,20
  5822.     call    disk.char.help
  5823.     ora    a
  5824.     mov    a,m
  5825.     rz
  5826.     mvi    c,sctr.size
  5827.     mvi    a,1ah
  5828. dci.lup:
  5829.     mov    m,a
  5830.     inx    h
  5831.     dcr    c
  5832.     jnz    dci.lup
  5833.     lxi    h,fcb.buf.addr
  5834.     dad    d
  5835.     mov    e,m
  5836.     inx    h
  5837.     mov    d,m
  5838.     ldax    d
  5839.     ret
  5840. ;
  5841. ;--------------------------------------------------
  5842. ;
  5843. ; in:    de -> fcb
  5844. ;    a  =  character
  5845. ;
  5846. ; out:    de = buffer address of character
  5847. ;
  5848. disk.char.out:
  5849.     push    psw
  5850.     mvi    a,21
  5851.     call    disk.char.help
  5852.     ora    a
  5853.     jz    dco.old
  5854.     lxi    h,fcb.buf.addr
  5855.     dad    d
  5856.     mov    e,m
  5857.     inx    h
  5858.     mov    d,m
  5859.     xchg
  5860. dco.old:
  5861.     pop    psw
  5862.     mov    m,a
  5863.     ret
  5864. ;
  5865. ;--------------------------------------------------
  5866. ;
  5867. ; in:    de -> fcb
  5868. ;    a  =  I/O operator (20/21)
  5869. ;
  5870. ; out:    a  =  I/O status
  5871. ;    hl =  buffer address for current character
  5872. ;
  5873. disk.char.help:
  5874.     push    psw
  5875.     push    d
  5876.     lxi    h,fcb.buf.ix
  5877.     dad    d
  5878.     mov    c,m    ;bc <- buf ix
  5879.     inx    h
  5880.     mov    b,m
  5881.     inx    h
  5882.     mov    e,m    ;de <- buf size
  5883.     inx    h
  5884.     mov    d,m
  5885.     push    h
  5886.     mov    h,b
  5887.     mov    l,c
  5888.     call    cmp.hl.fm.de
  5889.     pop    h
  5890.     jnz    dch.ch.fm.buf
  5891.     dcx    h
  5892.     dcx    h    ;clr buf ix
  5893.     xra    a
  5894.     mov    m,a
  5895.     dcx    h
  5896.     mov    m,a
  5897.     xchg        ;hl <- buf size
  5898.     dad    h    ;h = #sctrs/buf
  5899.     mov    b,h    ;b = #sctrs/buf
  5900.     xchg
  5901.     dcx    h
  5902.     mov    d,m    ;de <- buf addr
  5903.     dcx    h
  5904.     mov    e,m
  5905.     xchg        ;hl <- buf addr
  5906. dch.read.lup:
  5907.     push    b
  5908.     push    h
  5909.     xchg
  5910.     mvi    c,26
  5911.     call    entry
  5912.     pop    h
  5913.     pop    b
  5914.     pop    d    ;fcb addr
  5915.     pop    psw    ;read/write code
  5916.     push    psw
  5917.     push    d
  5918.     push    b
  5919.     push    h
  5920.     mov    c,a    ;read/write code
  5921.     call    entry
  5922.     push    psw    ;status
  5923.     lxi    d,dflt.dma
  5924.     mvi    c,26
  5925.     call    entry
  5926.     pop    psw    ;status
  5927.     pop    h
  5928.     pop    b
  5929.     ora    a    ;status ok?
  5930.     jnz    dch.src.eof    ;no
  5931.     lxi    d,sctr.size
  5932.     dad    d    ;new dma addr
  5933.     dcr    b    ;count # sctrs
  5934.     jnz    dch.read.lup
  5935. dch.ch.fm.buf:
  5936.     pop    d    ;fcb ptr
  5937.     pop    psw    ;restore stack
  5938.     lxi    h,fcb.buf.ix
  5939.     dad    d
  5940.     mov    c,m
  5941.     inx    h
  5942.     mov    b,m
  5943.     inx    b    ;incr buf ix
  5944.     mov    m,b
  5945.     dcx    h
  5946.     mov    m,c
  5947.     dcx    h
  5948.     mov    d,m    ;de <- buf ptr
  5949.     dcx    h
  5950.     mov    e,m
  5951.     dcx    b    ;old buf.ix
  5952.     mov    h,b
  5953.     mov    l,c
  5954.     dad    d    ;plus buf start = char ptr
  5955.     xra    a
  5956.     ret
  5957. ;
  5958. dch.src.eof:
  5959.     pop    d
  5960.     push    h
  5961.     lxi    h,fcb.status
  5962.     dad    d
  5963.     mov    m,a
  5964.     inx    h
  5965.     inx    h
  5966.     inx    h    ;point to buf.ix
  5967.     mov    c,m
  5968.     inx    h
  5969.     mov    b,m
  5970.     inx    b    ;incr buf.ix
  5971.     mov    m,b
  5972.     dcx    h
  5973.     mov    m,c
  5974.     pop    h
  5975.     pop    psw
  5976.     ret
  5977. ;
  5978. ;
  5979. ;
  5980. ;
  5981. ;
  5982. ;
  5983. ;
  5984. ;
  5985. ;
  5986. ;
  5987. ;
  5988. ;
  5989. ;
  5990. base.stk.addr:
  5991.     ds    256
  5992. my.stack.top:
  5993. ;
  5994. ;
  5995. ;
  5996. ;
  5997. ;
  5998. ;--------------------------------
  5999. ;---check for compiler options---
  6000. ;--------------------------------
  6001. ;    NOTE:    NSTAR option is only for older versions of n/STAR
  6002. ;        which do not support (get-date) and (get-console-num)
  6003. ;        calls.  Newer versions are handled with MPM option only
  6004. ;
  6005. process.options:
  6006.     lda    rsvd.wd.ix
  6007.     cpi    rwix.lbrckt
  6008.     jnz    option.end
  6009. option.skip:
  6010.     call    get.word
  6011. option.switch:
  6012.     call    debug.routine
  6013.     call    switch.rsvd.wd.ix
  6014.     db rwix.ADDRESS        ! dw option.ADDRESS
  6015.     db rwix.CSTACK        ! dw option.CSTACK
  6016.     db rwix.EXECUTE        ! dw option.EXECUTE
  6017.     db rwix.INPUT        ! dw option.INPUT
  6018.     db rwix.LEVEL        ! dw option.LEVEL
  6019.     db rwix.LIMIT        ! dw option.LIMIT
  6020.     db rwix.MAP        ! dw option.MAP
  6021.     db rwix.MATCH        ! dw option.MATCH
  6022.     db rwix.MPM        ! dw option.MPM
  6023.     db rwix.NOWARN        ! dw option.NOWARN
  6024.     db rwix.NSTAR        ! dw option.NSTAR
  6025.     db rwix.NUMBER        ! dw option.NUMBER
  6026.     db rwix.PRINT        ! dw option.PRINT
  6027.     db rwix.STACK        ! dw option.STACK
  6028.     db rwix.STANDALONE    ! dw option.STANDALONE
  6029.     db rwix.TAB        ! dw option.TAB
  6030.     db rwix.TABLE        ! dw option.TABLE
  6031.     db rwix.Z80        ! dw option.Z80
  6032.     db rwix.comma        ! dw option.skip
  6033.     db rwix.semicolon    ! dw option.skip
  6034.     db rwix.rbrckt        ! dw option.end
  6035.     db    0        ! dw option.err
  6036. ;
  6037. option.err:
  6038.     call    err.unexpect.word
  6039.     jmp    option.end
  6040. ;
  6041. ;
  6042. option.INPUT:
  6043.     lda    cmd.line.flag
  6044.     ora    a
  6045.     jz    option.err
  6046.     call    get.word
  6047.     lda    word.length
  6048.     cpi    1
  6049.     jnz    option.switch
  6050.     lda    word
  6051.     cpi    'A'
  6052.     jc    option.switch
  6053.     cpi    'P'+1
  6054.     jc    option.INPUT.ok
  6055.     cpi    'a'
  6056.     jc    option.switch
  6057.     cpi    'p'+1
  6058.     jnc    option.switch
  6059. option.INPUT.ok:
  6060.     ani    0fh
  6061.     sta    src.in
  6062.     jmp    option.skip
  6063. ;
  6064. ;
  6065. option.Z80:
  6066.     mvi    a,0ffh
  6067.     sta    Z80.flag
  6068.     jmp    option.skip
  6069. ;
  6070. ;
  6071. option.NSTAR:
  6072.     lxi    h,01feh        ;pseudo version for forced NSTAR
  6073.     shld    NSTAR.patch.addr.2 + 1
  6074.     mvi    a,(jmp)
  6075.     sta    NSTAR.patch.1
  6076.     lxi    h,NSTAR.patch.2
  6077.     shld    NSTAR.patch.1 + 1
  6078.     lxi    h,NSTAR.patch.3
  6079.     mvi    m,(lda)
  6080.     inx    h
  6081.     mvi    m,02h
  6082.     inx    h
  6083.     mvi    m,0f8h    ;patch to get unit-id
  6084. ;---fall into MPM option---
  6085. option.MPM:
  6086.     mvi    a,0ffh
  6087.     sta    MPM.flag
  6088.     jmp    option.skip
  6089. ;
  6090. ;
  6091. option.LIMIT:
  6092.     call    get.word
  6093.     lda    rsvd.wd.ix
  6094.     cpi    rwix.STRING
  6095.     jnz    option.LIMIT.WORD
  6096.     mvi    a,0ffh
  6097.     sta    string.move.block.flag
  6098.     jmp    option.skip
  6099. ;
  6100. ;
  6101. option.LIMIT.WORD:
  6102.     cpi    rwix.WORD
  6103.     cnz    err.mssng.rsvd.wd
  6104.     mvi    a,0ffh
  6105.     sta    limit.word.flag
  6106.     jmp    option.skip
  6107. ;
  6108. ;
  6109. option.STANDALONE:
  6110.     mvi    a,0ffh
  6111.     sta    standalone.flag
  6112.     jmp    option.skip
  6113. ;
  6114. ;
  6115. option.NOWARN:
  6116.     mvi    a,0ffh
  6117.     sta    nowarn.flag
  6118.     jmp    option.skip
  6119. ;
  6120. ;
  6121. option.STACK:
  6122.     lda    cmd.line.flag
  6123.     ora    a
  6124.     jnz    option.skip
  6125.     call    get.word
  6126.     lda    rsvd.wd.ix
  6127.     cpi    rwix.SAVE
  6128.     jnz    option.STK.no.save
  6129. ;
  6130.     mvi    a,0ffh
  6131.     sta    stack.save.flag
  6132. ;--dflt STACK 256 if STACK SAVE---
  6133.     lda    stack.id.flag
  6134.     ora    a
  6135.     jnz    option.skip
  6136.     lxi    h,256
  6137.     jmp    MAIN.dflt.STACK.id
  6138. ;
  6139. ;
  6140. option.STK.no.save:
  6141.     lda    rsvd.wd.ix
  6142.     cpi    rwix.NONE
  6143.     jnz    option.STK.not.NONE
  6144. ;
  6145.     mvi    a,0ffh
  6146.     sta    stack.none.flag
  6147.     jmp    option.skip
  6148. ;
  6149. ;
  6150. option.STK.not.NONE:
  6151.     lda    word.type
  6152.     ani    wtp.cnst
  6153.     cz    err.inv.cnst
  6154.     lhld    cnst.value
  6155. MAIN.dflt.STACK.id:
  6156.     shld    stack.id.size
  6157.     mvi    a,0ffh
  6158.     sta    stack.id.flag
  6159.     jmp    option.skip
  6160. ;
  6161. ;
  6162. option.CSTACK:
  6163.     call    get.word
  6164.     lda    rsvd.wd.ix
  6165.     cpi    rwix.SIZE
  6166.     cz    get.word
  6167.     lda    word.type
  6168.     ani    wtp.cnst
  6169.     jnz    option.CSTACK.ok
  6170.     call    err.inv.cnst
  6171.     jmp    option.switch
  6172. option.CSTACK.ok:
  6173.     lhld    cnst.value
  6174.     shld    my.stack.size
  6175.     jmp    option.skip
  6176. ;
  6177. ;
  6178. ;
  6179. option.TABLE:
  6180.     mvi    a,0ffh
  6181.     sta    table.fwd.flag
  6182.     jmp    option.skip
  6183. ;
  6184. ;
  6185. option.EXECUTE:
  6186.     mvi    a,0ffh
  6187.     sta    auto.execute.flag
  6188.     jmp    option.skip
  6189. ;
  6190. ;
  6191. option.MAP:
  6192.     mvi    a,0ffh
  6193.     sta    reloc.map.flag
  6194.     jmp    option.skip
  6195. ;
  6196. ;
  6197. option.ADDRESS:
  6198.     mvi    a,0ffh
  6199.     sta    print.code.addr.flag
  6200.     jmp    option.skip
  6201. ;
  6202. option.LEVEL:
  6203.     mvi    a,0ffh
  6204.     sta    print.blk.lvl.flag
  6205.     jmp    option.skip
  6206. ;
  6207. option.MATCH:
  6208.     mvi    a,0ffh
  6209.     sta    print.blk.match.flag
  6210.     jmp    option.skip
  6211. ;
  6212. option.NUMBER:
  6213.     mvi    a,0ffh
  6214.     sta    print.line.num.flag
  6215.     jmp    option.skip
  6216. ;
  6217. ;
  6218. ;
  6219. option.PRINT:
  6220.     call    get.word
  6221. option.PRN.lup:
  6222.     call    switch.rsvd.wd.ix
  6223.     db rwix.CON        ! dw option.PRN.CON
  6224.     db rwix.PRN        ! dw option.PRN.PRN
  6225.     db rwix.LST        ! dw option.PRN.PRN
  6226.     db rwix.DISK        ! dw option.PRN.DISK
  6227.     db rwix.FULL        ! dw option.PRN.FULL
  6228.     db rwix.comma        ! dw option.PRINT
  6229.     db    0        ! dw option.switch
  6230. ;
  6231. ;
  6232. option.PRN.CON:
  6233.     mvi    a,0ffh
  6234.     sta    print.console
  6235.     jmp    option.PRINT
  6236. ;
  6237. option.PRN.PRN:
  6238.     mvi    a,0ffh
  6239.     sta    print.printer.flag
  6240.     jmp    option.PRINT
  6241. ;
  6242. option.PRN.DISK:
  6243.     mvi    a,0ffh
  6244.     sta    print.disk.flag
  6245.     call    get.word
  6246.     lda    word
  6247.     cpi    '.'    ;possibly .EXT
  6248.     jz    MAIN.PRN.chk.ext
  6249.     lda    word.length
  6250.     cpi    1
  6251.     jnz    option.PRN.lup
  6252.     lda    word
  6253.     cpi    'A'
  6254.     jc    option.PRN.lup
  6255.     cpi    'P'+1
  6256.     jc    option.PRN.drive
  6257.     cpi    'a'
  6258.     jc    option.prn.lup
  6259.     cpi    'p'+1
  6260.     jnc    option.prn.lup
  6261. option.PRN.drive:
  6262.     ani    5fh
  6263.     sui    '@'
  6264.     sta    print.fcb
  6265.     jmp    option.PRN.DISK
  6266. ;
  6267. MAIN.PRN.chk.ext:
  6268.     lda    word.length
  6269.     cpi    5
  6270.     jnc    option.PRN.lup
  6271.     ;---fill out to 3 spaces
  6272.     lxi    h,word + 3
  6273.     cpi    4
  6274.     jz    MAIN.PRN.4
  6275.     cpi    3
  6276.     jz    MAIN.PRN.3
  6277.     cpi    2
  6278.     jnz    option.PRN.lup
  6279.     mvi    m,' '
  6280.     dcx    h
  6281. MAIN.PRN.3:
  6282.     mvi    m,' '
  6283. MAIN.PRN.4:
  6284.     lxi    h,word + 1
  6285.     lxi    d,print.fcb + fcb.ext
  6286.     lxi    b,3
  6287.     call    move.h.2.d.cnt.b
  6288.     jmp    option.PRN.DISK
  6289. ;
  6290. option.PRN.FULL:
  6291.     sta    print.on.off.flag
  6292.     jmp    option.PRINT
  6293. ;
  6294. option.TAB:
  6295.     call    get.word
  6296.     lda    cnst.value
  6297.     cpi    2
  6298.     jz    option.TAB.ok
  6299.     cpi    4
  6300.     jz    option.TAB.ok
  6301.     cpi    8
  6302.     jz    option.TAB.ok
  6303.     call    err.inv.cnst
  6304.     jmp    option.switch
  6305. ;
  6306. option.TAB.ok:
  6307.     dcr    a
  6308.     sta    print.tab.mask
  6309.     call    get.word
  6310.     jmp    option.switch
  6311. ;
  6312. ;
  6313. option.end:
  6314.     ret
  6315. ;
  6316. ;
  6317. ;
  6318. ;
  6319. ;-----------------------------
  6320. ;   start program execution
  6321. ;-----------------------------
  6322. ;
  6323. start:
  6324.     lxi    sp,my.stack.top
  6325. ;
  6326.     lxi    d,copyright.notice
  6327.     mvi    c,9
  6328.     call    entry
  6329. ;
  6330. ;---init source file---
  6331. ;
  6332.     lxi    d,src.in
  6333.     lxi    h,dflt.fcb
  6334.     lxi    b,9
  6335.     call    move.h.2.d.cnt.b
  6336.     lxi    h,src.in + fcb.ext
  6337.     mvi    m,'S'
  6338.     inx    h
  6339.     mvi    m,'R'
  6340.     inx    h
  6341.     mvi    m,'C'
  6342. ;
  6343. ;---init overlay fcb---
  6344. ;
  6345.     lxi    d,ovl.fcb
  6346.     lxi    h,dflt.fcb
  6347.     lxi    b,9
  6348.     call    move.h.2.d.cnt.b
  6349. ;
  6350. ;---init code file---
  6351. ;
  6352.     lxi    h,dflt.fcb
  6353.     lxi    d,code.fcb
  6354.     lxi    b,12    ;drv:name.ext
  6355.     call    move.h.2.d.cnt.b
  6356.     lxi    h,code.fcb + fcb.ext
  6357.     mov    a,m
  6358.     cpi    ' '
  6359.     jnz    start.COM.override
  6360.     push    h
  6361.     mov    a,m
  6362.     cpi    'S'
  6363.     jnz    start.COM.not.SRC
  6364.     inx    h
  6365.     mov    a,m
  6366.     cpi    'R'
  6367.     jnz    start.COM.not.SRC
  6368.     inx    h
  6369.     mov    a,m
  6370.     cpi    'C'
  6371.     jnz    start.COM.not.SRC
  6372. ;
  6373.     call    err.COM.SRC
  6374.     jmp    boot
  6375. ;
  6376. start.COM.not.SRC:
  6377.     pop    h
  6378.     mvi    m,'C'
  6379.     inx    h
  6380.     mvi    m,'O'
  6381.     inx    h
  6382.     mvi    m,'M'
  6383. start.COM.override:
  6384.     lxi    h,0
  6385.     shld    code.fcb + fcb.rnd.rec
  6386. ;
  6387. ;---init disk print file---
  6388. ;
  6389.     lxi    h,dflt.fcb
  6390.     lxi    d,print.fcb
  6391.     lxi    b,9
  6392.     call    move.h.2.d.cnt.b
  6393.     ;--disk output fcb already coded for
  6394.     ;--TEXT OUTPUT OPEN & ready for 1st char
  6395. ;
  6396. ;-----check for command-line parameters-----
  6397. ;
  6398.     lxi    h,dflt.dma
  6399. start.cl.lup:
  6400.     mov    a,m
  6401.     ora    a
  6402.     jz    start.no.cl
  6403.     cpi    '['
  6404.     inx    h
  6405.     jnz    start.cl.lup
  6406.     dcx    h
  6407.     lxi    d,src.buffer
  6408. move.cmd.line.lup:
  6409.     mov    a,m
  6410.     stax    d
  6411.     inx    h
  6412.     inx    d
  6413.     cpi    ']'
  6414.     jz    start.end.cmd.line
  6415.     ora    a
  6416.     jnz    move.cmd.line.lup
  6417.     dcx    d
  6418.     mvi    a,']'
  6419.     stax    d
  6420.     inx    d
  6421. start.end.cmd.line:
  6422.     mvi    a,0dh
  6423.     stax    d
  6424.     inx    d
  6425.     xra    a
  6426.     stax    d
  6427. ;
  6428.     mvi    a,0ffh
  6429.     sta    cmd.line.flag
  6430.     lxi    h,0
  6431.     shld    src.buf.ix
  6432.     shld    curr.src.line.num
  6433.     call    get.src.char
  6434.     call    get.word
  6435.     call    process.options
  6436. ;
  6437. start.no.cl:
  6438.     xra    a
  6439.     sta    cmd.line.flag
  6440. ;
  6441. ;---initialize symbol table
  6442. ;
  6443.     lhld    entry + 1
  6444.     dcx    h
  6445.     mvi    m,stet.end.tbl
  6446.     shld    start.sym.tbl.addr
  6447.     shld    end.sym.tbl.addr
  6448.     shld    lowest.sym.tbl.addr
  6449. ;
  6450.     mvi    a,stet.end.tbl
  6451.     sta    ste.type
  6452.     xra    a
  6453.     sta    ste.block.level
  6454.     sta    ste.name
  6455.     call    move.entry.to.sym.tbl
  6456. ;
  6457. ;---open source file---
  6458. ;
  6459.     lxi    d,src.in
  6460.     mvi    c,15    ;open
  6461.     call    entry
  6462.     cpi    0ffh
  6463.     jz    err.no.SRC
  6464.     call    set.up.src.fcb
  6465. ;
  6466. ;---start processing .SRC file---
  6467. ;
  6468.     call    get.src.char
  6469.     call    get.word
  6470.     lda    rsvd.wd.ix
  6471.     cpi    rwix.COPY
  6472.     cz    process.COPY
  6473. ;
  6474.     call    process.options
  6475.     call    get.word    ;skip ']'
  6476.     ;-----open the code-file
  6477.     lxi    d,code.fcb
  6478.     mvi    c,19    ;delete old
  6479.     call    entry
  6480.     lxi    d,code.fcb
  6481.     mvi    c,22    ;create
  6482.     call    entry
  6483.     inr    a
  6484.     jz    err.COM.open
  6485.     ;-----open the print-file if needed
  6486.     lda    print.disk.flag
  6487.     cpi    0ffh
  6488.     jnz    MAIN.no.print.dsk
  6489.     lxi    d,print.fcb
  6490.     mvi    c,19    ;delete
  6491.     call    entry
  6492. ;
  6493.     lxi    d,print.fcb
  6494.     mvi    c,22    ;create
  6495.     call    entry
  6496.     inr    a
  6497.     jz    err.PRN.open
  6498.     jmp    MAIN.print.dsk.ok
  6499. MAIN.no.print.dsk:
  6500.     xra    a
  6501.     sta    print.disk.flag
  6502. MAIN.print.dsk.ok:
  6503.     lda    MPM.flag
  6504.     ora    a
  6505.     jz    MAIN.not.MPM
  6506.     lxi    h,MPM.hdr.rtn
  6507.     lxi    b,MPM.hdr.end - MPM.hdr.rtn
  6508.     call    put.code.block
  6509.     xra    a
  6510.     sta    stack.save.flag
  6511.     sta    stack.none.flag
  6512. MAIN.not.MPM:
  6513.     lda    stack.save.flag
  6514.     ora    a
  6515.     jz    MAIN.not.stk.sv
  6516.     lxi    h,0
  6517.     call    put.LXI.H.hl
  6518.     call    put.DAD.SP
  6519.     mvi    a,bir.cpm.stack
  6520.     call    put.SHLD.fwd
  6521. MAIN.not.stk.sv:
  6522.     lda    stack.id.flag
  6523.     ora    a
  6524.     jz    MAIN.not.stk.id
  6525.     call    put.LXI.SP
  6526.     mvi    a,bir.stack.fwd
  6527.     call    put.fwd.ref.bir
  6528.     jmp    MAIN.stack.ready
  6529. MAIN.not.stk.id:
  6530.     lda    stack.none.flag
  6531.     lxi    h,stack.id.flag
  6532.     ora    m
  6533.     jnz    MAIN.stack.ready
  6534. ;
  6535.     lxi    h,entry + 1
  6536.     call    put.LHLD.hl
  6537.     call    put.SPHL
  6538. MAIN.stack.ready:
  6539. ;
  6540. ;---set compiler stack---
  6541. ;
  6542.     lxi    d,base.stk.addr
  6543.     lhld    my.stack.size
  6544.     dad    d
  6545.     shld    my.top.stk.addr
  6546.     sphl
  6547. ;
  6548. ;
  6549. ;---check for forward table in code file---
  6550. ;
  6551.     lda    table.fwd.flag
  6552.     ora    a
  6553.     jz    MAIN.no.fwd.tbl
  6554. ;
  6555. ;---normal flow branch around fwd tbl---
  6556. ;
  6557.     call    put.JMP
  6558.     lhld    curr.code.addr
  6559.     push    h
  6560.     lxi    h,0
  6561.     call    put.code.word
  6562. ;
  6563.     lhld    curr.code.addr
  6564.     shld    fwd.tbl.addr
  6565. ;
  6566.     mvi    a,bir.routine.base
  6567. MAIN.bir.tbl.lup:
  6568.     push    psw
  6569.     call    put.JMP
  6570.     lxi    h,0
  6571.     call    put.code.word
  6572.     pop    psw
  6573.     inr    a
  6574.     cpi    bir.actual.limit
  6575.     jc    MAIN.bir.tbl.lup
  6576. ;
  6577.     lhld    curr.code.addr
  6578. ;---extra space for 'dividend'---
  6579.     lxi    b,(bcd.size - 1) * 2 - 3
  6580.     dad    b
  6581. ;
  6582.     xthl        ;hl <- jmp addr
  6583.     shld    curr.code.addr
  6584.     pop    h
  6585.     push    h
  6586.     call    put.code.word
  6587.     pop    h
  6588.     shld    curr.code.addr
  6589. ;
  6590. MAIN.no.fwd.tbl:
  6591. ;
  6592. ;----------------------------------------------
  6593. ;    end of compiler options
  6594. ;----------------------------------------------
  6595. ;
  6596.     lda    rsvd.wd.ix
  6597.     cpi    rwix.semicolon
  6598.     cz    get.word
  6599. ;
  6600.     xra    a
  6601.     sta    code.started.this.blk
  6602.     sta    data.started.this.blk
  6603. ;
  6604.     lda    rsvd.wd.ix
  6605.     cpi    rwix.BEGIN
  6606.     jz    MAIN.no.pgm.name
  6607.     lxi    h,word
  6608.     lxi    d,program.name
  6609.     call    move.string
  6610.     call    get.word
  6611.     lda    rsvd.wd.ix
  6612.     cpi    rwix.colon
  6613.     cnz    err.inv.pgm.name.delim
  6614. ;
  6615.     lda    word.type
  6616.     ani    wtp.delim
  6617.     cnz    get.word
  6618.     lda    rsvd.wd.ix
  6619.     cpi    rwix.BEGIN
  6620.     cnz    err.mssng.BEGIN
  6621. MAIN.no.pgm.name:
  6622.     jmp    compile.the.program
  6623. ;
  6624. program.name:
  6625.     ds    max.word.length
  6626. ;
  6627. ;
  6628. ;
  6629. ;
  6630. ;
  6631. ;
  6632. err.COM.open:
  6633.     lxi    h,em.COM.open
  6634.     call    print.error
  6635.     jmp    boot
  6636. ;
  6637. ;
  6638. err.PRN.open:
  6639.     lxi    h,em.PRN.open
  6640.     call    print.error
  6641.     jmp    boot
  6642. ;
  6643. ;
  6644. err.inv.pgm.name.delim:
  6645.     lxi    h,em.inv.pgm.name.delim
  6646.     jmp    print.error
  6647. ;
  6648. ;
  6649. err.mssng.BEGIN:
  6650.     lxi    h,em.missng.BEGIN
  6651.     jmp    print.error
  6652. ;
  6653. em.inv.pgm.name.delim:
  6654.     db    'invalid program-name delimiter',0
  6655. em.missng.BEGIN:
  6656.     db    'missing BEGIN at start of program',0
  6657. em.COM.open:
  6658.     db    'Code-file Open Error',0
  6659. em.PRN.open:
  6660.     db    'Print-file Open Error',0
  6661. ;
  6662. ;
  6663. ;
  6664. ;===============================================================
  6665. ;MP/M INTERCEPT ROUTINE
  6666. ;===============================================================
  6667. ;    This routine must be included in any program
  6668. ;    using the MPM compile option.
  6669. ;    It provides:
  6670. ;
  6671. ;    1.    record locking & unlocking with automatic extension
  6672. ;        of the file for non-existant records
  6673. ;
  6674. ;    2.    detaching the LST: device when a EOF (1ah) is sent
  6675. ;        to it.
  6676. ;
  6677. ;    3.    for programs running under CP/M, it provides automatic
  6678. ;        extension of the file for non-existant records
  6679. ;
  6680. ;    4.    For programs running under Molecular Computer's n/STAR,
  6681. ;        it provides simulation of the MP/M delay & dispatch
  6682. ;        calls which are not supported by n/STAR.
  6683. ;
  6684. ;
  6685. ;
  6686. ;    Possible problems:
  6687. ;
  6688. ;        When a random-read returns a status that the sector
  6689. ;    is not allocated, the method used is that specified in the
  6690. ;    MP/M-II Programmers Guide Release 2.1 Programming Guidelines.
  6691. ;    This is to write a record of binary zeros with call 40 (write
  6692. ;    random with zero fill) in order to allocate the record, then
  6693. ;    to retry the lock.  The only possible problem with this is
  6694. ;    if a competing process does the same thing and allocates the
  6695. ;    record, locks it, reads it, updates it, writes it, and 
  6696. ;    unlocks it (all this) before this process executes the write,
  6697. ;    then this process will have written over the other process's
  6698. ;    record with binary zeros.
  6699. ;
  6700. ;    Calling procedure:
  6701. ;        mvi    a,0ffh
  6702. ;        sta    MPM.lock.flag
  6703. ;        lxi    h,0
  6704. ;        shld    fcb.rec.buf.sctr    ;force fresh read
  6705. ;        <normal read call>
  6706. ;        xra    a
  6707. ;        sta    MPM.lock.flag
  6708. ;
  6709. ;        write is same, but no need to clear fcb.rec.buf.sctr
  6710. ;        unless locking for pre-read
  6711. ;
  6712. ;
  6713. ;
  6714. ;    This is ORG'ed at 100h, since that is where it will have to go.
  6715. ;
  6716. ;
  6717. MPM.hdr.rtn:
  6718. ;
  6719. ;---make a new BDOS vector to jump to the intercept routine---
  6720. ;
  6721.     lhld    entry + 1
  6722.     shld    MPM.bdos.jmp + 1
  6723.     dcx    h
  6724.     mvi    m,intercept / 100h
  6725.     dcx    h
  6726.     mvi    m,intercept and 0ffh
  6727.     dcx    h
  6728.     mvi    m,(jmp)
  6729.     shld    entry + 1
  6730. ;
  6731. ;---check whether MP/M, CP/M 2.2, CP/M 3.0 plus, or n/STAR---
  6732. ;
  6733.     mvi    c,12
  6734.     call    MPM.bdos.jmp    ;really call BDOS for this
  6735. NSTAR.patch.1:        ;referenced only by compiler in-place
  6736.     shld    icpt.version
  6737.     mov    a,h
  6738.     cpi    1        ;MP/M version flag
  6739.     jz    end.of.intercept    ;really MP/M
  6740.     mov    a,l
  6741.     cpi    30h        ;CP/M plus??
  6742.     jc    icpt.chk.NSTAR    ;CP/M 2.2 or n/STAR
  6743.     mvi    a,1        ;CP/M plus -- looks like MP/M
  6744.     shld    icpt.version + 1    ;fake MPM
  6745.     jmp    end.of.intercept
  6746. ;
  6747. icpt.chk.NSTAR            equ    $ - MPM.hdr.rtn + 100h
  6748.     mvi    c,155    ;get date & time call
  6749.     lxi    d,icpt.TOD
  6750.     call    MPM.bdos.jmp
  6751.     lda    icpt.TOD
  6752.     cpi    0ffh
  6753.     jz    end.of.intercept    ;yep, really CP/M
  6754. NSTAR.patch.2            equ    $ - MPM.hdr.rtn + 100h
  6755. NSTAR.patch.addr.2:        ;referenced only internally to compiler
  6756.     lxi    h,01ffh        ;pseudo MP/M version for n/STAR
  6757.     shld    icpt.version
  6758.     jmp    end.of.intercept
  6759. ;
  6760. ;
  6761. icpt.TOD    equ    $ - MPM.hdr.rtn + 100h
  6762.     db    0ffh,0ffh,0ffh,0ffh,0ffh
  6763. ;
  6764. ;
  6765. intercept    equ    $ - MPM.hdr.rtn + 100h
  6766.     mov    a,c
  6767.     cpi    33
  6768.     jz    icpt.read
  6769.     cpi    34
  6770.     jz    icpt.write
  6771.     cpi    40
  6772.     jz    icpt.write
  6773.     cpi    26
  6774.     jz    icpt.dma
  6775.     cpi    05
  6776.     jz    icpt.list
  6777.     cpi    15
  6778.     jz    icpt.open
  6779.     cpi    22
  6780.     jz    icpt.open
  6781.     cpi    16
  6782.     jz    icpt.close
  6783.     cpi    12
  6784.     jz    icpt.get.version
  6785.     cpi    141
  6786.     jz    icpt.delay
  6787.     cpi    142
  6788.     jz    icpt.dispatch
  6789.     cpi    153
  6790.     jz    icpt.get.con.num
  6791. MPM.bdos.jmp    equ    $ - MPM.hdr.rtn + 100h
  6792.     jmp    MPM.bdos.jmp
  6793. ;
  6794. ;
  6795. icpt.version        equ    $ - MPM.hdr.rtn + 100h + 1
  6796. icpt.get.version    equ    $ - MPM.hdr.rtn + 100h
  6797.     lxi    h,0000    ;MP/M CP/M version stored here
  6798.     mov    a,l    ;always return internal version
  6799.     mov    b,h
  6800.     ret
  6801. ;
  6802. ;
  6803. icpt.get.con.num    equ    $ - MPM.hdr.rtn + 100h
  6804. NSTAR.patch.3:
  6805.     jmp    MPM.bdos.jmp    ;patch = (LDA F802) for n/STAR
  6806.     cma
  6807.     dcr    a
  6808.     ret
  6809. ;
  6810. ;
  6811. ;
  6812. icpt.chk.true.MPM        equ    $ - MPM.hdr.rtn + 100h
  6813.     lxi    h,icpt.version + 1
  6814.     mov    a,m
  6815.     ora    a
  6816.     rz        ;return here if CP/M
  6817.     dcx    h
  6818.     mov    a,m
  6819.     cpi    0f0h    ;lowest possible internal version
  6820.     ret        ;if carry is set, this is CP/M plus or MP/M
  6821. ;
  6822. ;
  6823. icpt.delay        equ    $ - MPM.hdr.rtn + 100h
  6824.     call    icpt.chk.true.MPM
  6825.     jc    MPM.bdos.jmp
  6826. icpt.fake.delay        equ    $ - MPM.hdr.rtn + 100h
  6827.     lxi    h,0b00h    ;delay cnst for 1/60th sec at 4MHz clock
  6828. icpt.delay.1        equ    $ - MPM.hdr.rtn + 100h
  6829.     dcx    h
  6830.     mov    a,l
  6831.     ora    h
  6832.     jnz    icpt.delay.1
  6833.     dcx    d
  6834.     mov    a,e
  6835.     ora    d
  6836.     jnz    icpt.fake.delay
  6837.     ret
  6838. ;
  6839. ;
  6840. icpt.dispatch        equ    $ - MPM.hdr.rtn + 100h
  6841.     call    icpt.chk.true.MPM
  6842.     jc    MPM.bdos.jmp
  6843.     ret
  6844. ;
  6845. ;
  6846. icpt.open    equ    $ - MPM.hdr.rtn + 100h
  6847. ;---save key in case shared open which wipes it out---
  6848.     lxi    h,fcb.rnd.rec
  6849.     dad    d
  6850.     mov    a,m
  6851.     inx    h
  6852.     push    h    ;stk <- rec.addr + 1
  6853.     mov    h,m
  6854.     mov    l,a
  6855.     xthl        ;stk <- rec.value
  6856.             ;HL  <- rec.addr + 1
  6857.     push    h    ;stk <- rec.addr + 1
  6858.     call    MPM.bdos.jmp
  6859. ;---move file-id from 'rnd.rec' to 'file.id'---
  6860.     pop    h    ;HL  <- rec.addr + 1
  6861.     push    h    ;stk <- rec.addr + 1
  6862.     mov    d,m
  6863.     dcx    h
  6864.     mov    e,m
  6865.     lxi    b,fcb.file.id - fcb.rnd.rec
  6866.     dad    b
  6867.     mov    m,e
  6868.     inx    h
  6869.     mov    m,d
  6870. ;---restore key---
  6871.     pop    h    ;HL  <- rec.addr + 1
  6872.     pop    d    ;DE  <- rec.value
  6873.     mov    m,d
  6874.     dcx    h
  6875.     mov    m,e
  6876.     ret
  6877. ;
  6878. ;
  6879. ;---on MPM, shared files are updated with every write,---
  6880. ;---so partial-close is wasted effort---
  6881. ;
  6882. icpt.close    equ    $ - MPM.hdr.rtn + 100h
  6883.     lda    icpt.version + 1
  6884.     ora    a
  6885.     jz    icpt.close.CPM
  6886.     lxi    h,fcb.flags
  6887.     dad    d
  6888.     mov    a,m
  6889.     ani    FILE.r.flag.SHARED
  6890.     jz    MPM.bdos.jmp
  6891.     lxi    h,5
  6892.     dad    d
  6893.     mov    a,m
  6894.     ani    80h    ;partial?
  6895.     jz    MPM.bdos.jmp
  6896.     mov    a,m
  6897.     ani    7fh
  6898.     mov    m,a
  6899.     ret
  6900. ;
  6901. icpt.close.CPM    equ    $ - MPM.hdr.rtn + 100h
  6902.     lxi    h,5
  6903.     dad    d
  6904.     mov    a,m
  6905.     ani    7fh
  6906.     mov    m,a
  6907.     jmp    MPM.bdos.jmp
  6908. ;
  6909. ;
  6910. MPM.lock.flag    equ    $ - MPM.hdr.rtn + 100h + 1
  6911. icpt.read    equ    $ - MPM.hdr.rtn + 100h
  6912.     mvi    a,0
  6913.     ora    a
  6914.     jz    MPM.bdos.jmp
  6915. icpt.try.lock    equ    $ - MPM.hdr.rtn + 100h
  6916.     lda    icpt.version + 1
  6917.     ora    a
  6918.     jz    icpt.read.CPM
  6919.     push    d
  6920.     call    icpt.set.dma
  6921.     mvi    c,42
  6922.     call    MPM.bdos.jmp
  6923.     call    icpt.rset.dma
  6924.     pop    d
  6925.     mvi    c,33
  6926.     ora    a
  6927.     push    d
  6928.     cz    MPM.bdos.jmp    ;go do the read
  6929.     pop    d
  6930. ;
  6931.     cpi    01
  6932.     jz    icpt.unalloc
  6933.     cpi    04
  6934.     jz    icpt.unalloc
  6935.     cpi    08
  6936.     rnz
  6937.     call    delay
  6938.     jmp    icpt.try.lock
  6939. ;
  6940. icpt.read.CPM    equ    $ - MPM.hdr.rtn + 100h
  6941.     mvi    c,33
  6942.     push    d
  6943.     call    MPM.bdos.jmp
  6944.     pop    d
  6945.     ora    a
  6946.     rz
  6947.     cpi    01
  6948.     jz    icpt.unalloc
  6949.     cpi    04
  6950.     rnz
  6951. ;
  6952. icpt.unalloc    equ    $ - MPM.hdr.rtn + 100h
  6953.     lhld    icpt.org.dma
  6954.     mvi    c,128
  6955.     xra    a
  6956. icpt.clr.sct.lup    equ    $ - MPM.hdr.rtn + 100h
  6957.     mov    m,a
  6958.     inx    h
  6959.     dcr    c
  6960.     jnz    icpt.clr.sct.lup
  6961. ;
  6962.     push    d
  6963.     mvi    c,40
  6964.     call    MPM.bdos.jmp
  6965.     pop    d
  6966.     jmp    icpt.try.lock
  6967. ;
  6968. ;
  6969. ;
  6970. MPM.unlock.flag    equ    $ - MPM.hdr.rtn + 100h + 1
  6971. icpt.write    equ    $ - MPM.hdr.rtn + 100h
  6972.     mvi    a,0
  6973.     mvi    c,40
  6974.     ora    a
  6975.     jz    MPM.bdos.jmp
  6976.     push    d
  6977.     call    MPM.bdos.jmp
  6978.     pop    d
  6979.     ora    a
  6980.     rnz
  6981.     lda    icpt.version + 1
  6982.     ora    a
  6983.     rz
  6984.     call    icpt.set.dma
  6985.     mvi    c,43
  6986.     call    MPM.bdos.jmp
  6987.     jmp    icpt.rset.dma
  6988. ;
  6989. ;
  6990. ;
  6991. icpt.dma    equ    $ - MPM.hdr.rtn + 100h
  6992.     xchg
  6993.     shld    icpt.org.dma
  6994.     xchg
  6995.     jmp    MPM.bdos.jmp
  6996. ;
  6997. icpt.org.dma    equ    $ - MPM.hdr.rtn + 100h
  6998.     dw    0080h
  6999. ;
  7000. ;
  7001. ;
  7002. icpt.set.dma    equ    $ - MPM.hdr.rtn + 100h
  7003.     push    d
  7004.     lxi    h,fcb.file.id
  7005.     dad    d
  7006.     xchg
  7007.     mvi    c,26
  7008.     call    MPM.bdos.jmp
  7009.     pop    d
  7010.     ret
  7011. ;
  7012. ;
  7013. ;
  7014. icpt.rset.dma    equ    $ - MPM.hdr.rtn + 100h
  7015.     push    h
  7016.     push    d
  7017.     push    psw
  7018.     lhld    icpt.org.dma
  7019.     xchg
  7020.     mvi    c,26
  7021.     call    MPM.bdos.jmp
  7022.     pop    psw
  7023.     pop    d
  7024.     pop    h
  7025.     ret
  7026. ;
  7027. ;
  7028. ;
  7029. delay    equ    $ - MPM.hdr.rtn + 100h
  7030.     push    d
  7031.     lxi    d,6    ;1/10 sec.
  7032.     mvi    c,141    ;delay
  7033.     call    entry    ;may need internal delay
  7034.     pop    d
  7035.     ret
  7036. ;
  7037. ;
  7038. ;
  7039. ;
  7040. icpt.list    equ    $ - MPM.hdr.rtn + 100h
  7041.     mov    a,e
  7042.     cpi    1ah
  7043.     jnz    MPM.bdos.jmp
  7044.     lda    icpt.version
  7045.     ora    a
  7046.     rz
  7047.     mvi    c,159    ;detach list
  7048.     jmp    MPM.bdos.jmp
  7049. ;
  7050. ;
  7051. ;
  7052. end.of.intercept    equ    $ - MPM.hdr.rtn + 100h
  7053. ;
  7054. ;
  7055. ;
  7056. MPM.hdr.end:
  7057. ;
  7058. ;
  7059. ;
  7060. ;
  7061.     end
  7062.