home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / debug / ddtz27.ark / DDTDISA.MAC < prev    next >
Text File  |  1988-05-29  |  30KB  |  1,409 lines
  1. title    Assembler/Dissasembler segment for DDTZ.
  2. ; MUST be integral # of pages. MUST be first segment linked.
  3. ;
  4. ; 88/04/25 Modified to use 64180 op codes.  DDT Version 27.
  5. ; 2.7    DO NOT mix with earlier main system. LXI X and LXI Y
  6. ;    now assemble. Most undocumented ops disassemble       cbf.
  7. ; 87/07/11 Minor change so that MOV disassembles correctly when
  8. ; 2.6    run on 8080 (or under v20-80 under MSDOS).        cbf.
  9. ; 86/02/12 Corrected to allow assembly of push/pop inx/dcx x/y
  10. ;    still accepts faulty operands ldax h, ldax sp, etc.
  11. ;    but any correction will cause DDTY (z80 false) to swell
  12. ;    by another 256 bytes.  This IS a crude assembler.  cbf.
  13. ;
  14.     cseg
  15.     entry    disassem;    a=aflag
  16.     entry    assemble;    pcnt just called
  17.     entry    keep;        code file
  18.     entry    begin, .bdos;    for overlay checks
  19. ;
  20. ; Main system routines useable by assembler/disassembler
  21.     extrn    dblblk, blank, couta, crlf
  22.     extrn    qbrk, csta, nextch, skipblks
  23.     extrn    t4hx, t2hx, tstr;    a,f
  24.     extrn    qdelim;        flags
  25.     extrn    getline;    a,f,b,c,d,e
  26.     extrn    pcnt;        a,f,d,e,h,l. Get params & count
  27.     extrn    nextparm;    d,e,h,l
  28.     extrn    rdhex, rdhexc;    a:=exit ch, de := value
  29.     extrn    chkop;        all. de^ to op, exit hl^ past op
  30.     extrn    err;        abort exit to DDT
  31.     extrn    foperate, dos;    without disturbing regs. arg a
  32.     extrn    index, indexwd;    a,f,h,l
  33.     extrn    casexfr;    a,f,h,l + routine
  34.     extrn    sdem, ldem;    hl^ =:= de; hl:=hl+2
  35.     extrn    delesshl;    a,f. comparator, unsigned
  36. ;
  37.     extrn    codesize, pages;    To set relocation data
  38. ;
  39. ; external data areas used
  40.     extrn    disasmp, dendptr, aflag;    for trace display
  41.     extrn    storeptr, exitstk, buff;[16]     scratch vars.
  42. ;
  43. ; read only data from main system
  44.     extrn    opkind, zopkind;    set by chkop
  45.     extrn    z80flg;            set if running on Z80
  46.     extrn    unloaded;        memory not yet loaded
  47. ;
  48. true    equ    -1
  49. false    equ    not true
  50. z80    equ    true;        false strips z80 code
  51. tfcb    equ    05ch
  52. defdma    equ    080h
  53. ;
  54. ; Transfers around system on startup.  Overwritten later
  55. ; The next module should be the main program.
  56. begin:    jmp    ddtbgn;        overlayed by serial no.
  57. ;
  58. ; Following for loader information. overlayed by serial no.
  59.     dw    codesize + (ddtbgn-begin)
  60.     db    pages + (ddtbgn-begin)/256
  61. ;                place connecter at bdos equiv locn
  62. .bdos:    jmp    $-$;        becomes bdos connector
  63. ;
  64. assemble:
  65.     dcr    a;        main system has just called pcnt
  66.     jnz    err;        need exactly 1 param
  67.     call    nextparm
  68.     shld    disasmp
  69. ;    "    "
  70. ; Master assembly loop
  71. assm:    lxi    h,buff+4
  72.     xra a    ! mov m,a;    no index register
  73.     inx h    ! mov m,a;    mark code buffer empty
  74.     call    crlf
  75.     lhld    disasmp
  76.     xchg
  77.     call    typepc
  78.     call    blank
  79.     call    getline
  80.     call    skipblks
  81.     rz;            empty line, exit
  82.     cpi    '.'
  83.     rz;            exit
  84.     call    asmln
  85.     cnc    savecd;        and advance disasmp
  86.     jnc    assm;        no error
  87.     call    crlf
  88.     mvi    a,'?'
  89.     call    couta
  90.     jmp    assm
  91. ;
  92.     if    z80
  93. ; Set flags on z80flg
  94. qz80:     lda    z80flg
  95.      ora    a
  96.      ret
  97.     endif
  98. ;
  99. subttl    'Disassembler'
  100. ;
  101. disassem:
  102.     sta    aflag
  103.     ora a    ! jz dsasm;    0 means do to dendptr
  104.     lxi    h,0ffffh
  105.     shld    dendptr;    else set default end
  106.     inr a    ! jnz dsasm;    >= 1 means show n lines
  107.     inr    a;        -1 means 1 opcode, no header
  108.     sta    aflag;        set lines to 1
  109.     lhld    disasmp
  110.     xchg
  111.     push    d
  112.     call    chkop;        set up pointers, opkind
  113.     pop    d
  114.     dcx    h
  115.     shld    dendptr;    point to last byte of opcode
  116.     inx    h;        de := disasmp, hl^ next opcode
  117.     jmp    dsasm2
  118. ;
  119. ; main disassembly loop
  120. dsasm:    call    qbrk
  121.     lxi    h,aflag
  122.     mov    a,m
  123.     ora a    ! jz dsasm1;    using dendptr
  124.     dcr    m
  125.     rz;            lines done
  126. dsasm1:    lhld    dendptr
  127.     xchg
  128.     lhld    disasmp
  129.     call    delesshl
  130.     xchg
  131.     rc;            past end marker
  132.     call    craddr
  133.     mvi    c,-10;        field size to use
  134.     call    showcd;        hl^ next opcode, de^ this opcode
  135. ;    "    "        opkind/z80flg set
  136. dsasm2:    shld    disasmp;    de := this, disasmp := next
  137.     lxi    h,dsasm
  138.     push    h;        set return on stack
  139.     lxi    h,opcd1
  140.     ldax    d
  141.     mvi    b,ni1
  142.     mvi    c,'H';        default index reg. id
  143.     call    stbl
  144.     jz    t4chb;        all one byte no operand opcodes
  145.     mvi    b,ni2
  146.     call    stbl
  147.     jz    immops;        all immediate to a opcodes
  148.     mvi    b,ni3
  149.     call    stbl
  150.     jz    wdops;        all immediate word opnd opcodes
  151.     if    z80
  152.      call    qz80
  153.      ldax    d;        was jz dsasm3 ! ldax d; 87/7/11
  154.      jz    dsasm3
  155.      mvi    b,ni4
  156.      call    stbl
  157.      jz    t4chb;        one byte z80 only opcodes
  158.     endif
  159. dsasm3:    ani    0c0h
  160.     lxi    h,mmov+1
  161.     cpi 040h ! jz movops
  162.     cpi 080h ! jz aritop
  163. dsasm4:    ldax d    ! ani 0c7h;    entry for indexed inrdcr
  164.     sui 4    ! jz inrops
  165.     dcr a    ! jz dcrops
  166.     dcr a    ! jz mviops
  167.     ldax    d
  168.     ani 0c0h ! jz dsasm6
  169.     ldax d    ! ani 7
  170.     sui 2    ! jz jmpcc
  171.     sui 2    ! jz callcc
  172.     sui 3    ! jz rstop
  173.     ldax    d
  174.     ani 8    ! jnz prefix;    leaving cb,d9,dd,ed,fd
  175. dsasm5:    ldax d    ! ani 0c5h;    entry for push/pop x/y
  176.     jmp    wdrgs;        pop, push
  177. ;
  178. dsasm6:    ldax d    ! ani 7
  179.     if    z80
  180.      jz    jrops;        exaf removed earlier
  181.     else
  182.      jz    bad
  183.     endif
  184. dsasm7:    ldax d    ! ani 0fh;    entry for inx/dcx x/y
  185.     dcr a    ! jz lxiops
  186.     inr    a
  187. ;    "    "
  188. ; one byte opcodes operating on word registers
  189. ; a,f,b,h,l
  190. wdrgs:    lxi    h,mstax
  191.     mvi    b,nwdr;        stax, ldax, inx, dcx, dad, pop, push
  192.     call    stbl
  193. wdrgs2:    call    t4chb;        entry from dadc/dsbc
  194.     ldax    d
  195.     ani 0ah    ! jnz wdrgid;    not pop/push
  196.     ldax d ! ani 030h
  197.     cpi    030h
  198.     lxi h,mpsw+1 ! mvi a,3
  199.     jz    tchars
  200. ;    "    "
  201. ; show word register id
  202. ; a,f
  203. wdrgid:    call    toreg
  204.     ani 6
  205.     cpi 4    ! jz txrgid
  206.     cpi 6    ! jnz tregid
  207.     push    h
  208.     lxi    h,msp+1
  209.     mvi    a,2
  210.     call    tchars
  211.     pop    h
  212.     ret
  213. ;
  214. ; All above exits return to dsasm via stacked return address
  215. ; In general, de points to next byte to disassemble, c holds
  216. ; an index register specifier (H, X, or Y).  When operands
  217. ; are listed de is normally destroyed.  The z80 only opcodes
  218. ; are enable/disabled by the main system Z80FLG variable.  The
  219. ; system depends on classification of operators by the main
  220. ; system CHKOP procedure, which also returns the opcode length.
  221. ;
  222. ; lxi R opn
  223. lxiops:    lxi    h,mlxi+1
  224.     call    t4chb
  225.     call    wdrgid
  226.     call    comma
  227.     jmp    wdopnd
  228. ;
  229.     if    z80
  230. ; relative jump z80 ops
  231. jrops:     call    qz80
  232.      jz    bad
  233.      ldax    d
  234.      lxi    h,mdjnz
  235.      mvi    b,njrs
  236.      call    stbl;        must succeed
  237.      call    t4chb
  238.      inx d ! ldax d
  239.      mov    l,a;        convert rel to absolute
  240.      rlc
  241.      sbb    a
  242.      mov    h,a
  243.      inx    d
  244.      dad    d
  245.      jmp    t4hx
  246.     endif
  247. ;
  248. ; restart opcode
  249. rstop:    lxi    h,mrst+1
  250. ;    "    "
  251. ; display mnemnonic and middle 3 bits of (a) as digit 0..7
  252. ; a,f,h,l
  253. num:    call    t4chb
  254.     call    toreg
  255.     adi    '0'
  256.     jmp    couta
  257. ;
  258. ; conditional calls
  259. callcc:    mvi    a,'C'
  260.     jmp    jmpcc1
  261. ;
  262. ; conditional jumps
  263. jmpcc:    mvi    a,'J'
  264. jmpcc1:    call    couta
  265.     call    toreg
  266.     mov l,a    ! add a ! add a ! add l; *5
  267.     lxi    h,mcrtn+2
  268.     call    index
  269.     mvi    a,2
  270.     call    tchars
  271.     call    dblblk
  272.     jmp    wdopnd
  273. ;
  274. ; inr/dcr ops
  275. ; a,f,h,l (de on index)
  276. inrops:    lxi    h,minr+1
  277.     jmp    dcrop1
  278. dcrops:    lxi    h,mdcr+1
  279. dcrop1:    call    t4chb
  280.     if    z80
  281.      mov    a,c
  282.      cpi    'H'
  283.      jnz    ixdisp
  284.     endif
  285. ;    "    "
  286. lftrid:    call    toreg
  287.     jmp    tregid
  288. ;
  289. ; arithmetic immediate ops
  290. ; a,f,b,h,l
  291. aritop:    call    aritmn
  292. ;    "    "
  293. ; operations on single register. hl point to mnemonic
  294. ; a,f
  295. bregop:    call    t4chb
  296. ;    "    "
  297. ; show from reg id
  298. ; a,f
  299. fromrg:    ldax d    ! ani 7
  300.     jmp    tregid
  301. ;
  302. ; get pointer to arithmetic op mnemnonic
  303. ; a,f,b,h,l
  304. aritmn:    lxi    h,madd+1
  305. ;    "    "
  306. ; index to mnemonic via hl^ on toreg field
  307. mnmix:    ldax d    ! ani 038h;    index by 5*toreg field
  308.     rrc
  309.     mov    b,a
  310.     rrc    ! rrc;        div 8 and mul 5
  311.     add    b
  312.     jmp    index
  313. ;
  314. ; immediate to a opcodes
  315. ; a,f,d,e
  316. immops:    call    t4chb
  317.     jmp    bopnd
  318. ;
  319. ; immediate 1 byte operators, with reg. id
  320. mviops:    lxi    h,mmvi+1
  321. ;    "    "
  322. ; Mnemnonic, register, immediate byte value
  323. rgiops:    call    t4chb
  324.     call    lftrid
  325. ;    "    "
  326. ; show immediate as 2nd operand
  327. ; a,f,d,e
  328. imopnd:    call    comma
  329. ;    "    "
  330. ; list byte operand
  331. ; a,f,d,e
  332. bopnd:    inx d    ! ldax d
  333.     jmp    t2hx
  334. ;
  335. ; word ops.  hl is opmnem pointer, output 1 word operand
  336. ; a,f,d,e,h,l
  337. wdops:    call    t4chb
  338. ;    "    "
  339. ; show word operand
  340. ; a,f,d,e,h,l
  341. wdopnd:    inx    d
  342.     xchg
  343.     call    ldem
  344.     xchg
  345.     jmp    t4hx
  346. ;
  347. ; move ops
  348. ; a,f,h,l
  349. movops:    call    t4chb
  350.     call    lftrid
  351. ;    "    "
  352. ; Show source register id.
  353. ; a,f
  354. source:    call    comma
  355.     ldax d    ! ani 7
  356. ;    "    "
  357. ; convert a into regid listing
  358. ; a,f
  359. tregid:    push    h
  360.     lxi    h,mreg
  361.     call    index
  362.     mov    a,m
  363.     pop    h
  364.     jmp    couta
  365. ;
  366. ; extract middle bits (to reg id)
  367. ; a,f
  368. toreg:    ldax    d
  369.     ani    38h
  370.     rrc ! rrc ! rrc
  371.     ret
  372. ;
  373. ; write 4 chars from hl^ with trailing blank
  374. ; a,f,h,l
  375. t4chb:    call    t4char
  376.     jmp    blank    
  377. ;
  378. ; show code bytes at de^ up with at least one trailing blank.
  379. ; Set up opkind, hl := endptr
  380. ; -c specifies minimum field to use.
  381. ; a,f,b,c,d,e
  382. showcd:    push b    ! push d
  383.     call    chkop
  384.     pop d    ! pop b
  385. ;    "    "
  386. ; display code at de^ thru hl-1^, min field -c bytes
  387. ; at least one trailing blank
  388. ; a,f,b,c
  389. dspcd:    push    d
  390.     xchg
  391. dspcd1:    mov    a,m
  392.     call    t2hx
  393.     inx h    ! inr c    ! inr c
  394.     mov a,l    ! cmp e
  395.     jnz    dspcd1
  396. dspcd2:    call    blank
  397.     inr c    ! jm dspcd2
  398.     xchg
  399.     pop    d
  400.     ret
  401. ;
  402. ; crlf, show address de.
  403. ; a,f,h,l
  404. craddr:    call    crlf
  405. ;    "    "
  406. ; show address de.
  407. ; a,f
  408. typepc:    xchg
  409.     call    t4hx
  410.     xchg
  411.     jmp    dblblk
  412. ;
  413. ; output 4 chars from hl^ up
  414. ; a,f,h,l
  415. t4char:    mvi    a,4
  416. ;    "    "
  417. ; output a chars from hl^ up
  418. ; a,f,h,l
  419. tchars:    push    b
  420.     mov    b,a
  421. tchrs1:    mov    a,m
  422.     call    couta
  423.     inx h    ! dcr b
  424.     jnz    tchrs1
  425.     pop    b
  426.     ret
  427. ;
  428. comma:    mvi     a,','
  429.     jmp    couta
  430. ;
  431. ; search opcode table hl^ for a, max b entries.
  432. ; Z flag if found, when hl point to mnemnonic entry
  433. ; f,b,h,l
  434. stbl:    cmp m    ! inx h
  435.     rz
  436.     inx h ! inx h ! inx h ! inx h
  437.     dcr b    ! jnz stbl
  438.     dcr    b;        remove z flag, not found
  439.     ret
  440. ;
  441. ; show index register id
  442. ; a,f
  443. txrgid:    mov    a,c
  444.     jmp    couta
  445. ;
  446. ; prefixed z80 ops
  447. prefix:    if    z80
  448.      call    qz80;        (not d9 if z80 running)
  449.      jz    bad
  450.      lhld    disasmp;    check for length 1
  451.      dcx    h
  452.      call    delesshl;    if so
  453.      jz    bad;        invalid z80 opcode
  454.      ldax    d
  455.      cpi 0cbh ! jz bitpic
  456.      cpi 0edh ! jz xtend
  457. ;     "    "
  458. ; index register operations, prefix 0ddh/0fdh
  459.      ani    020h
  460.      rlc ! rlc ! rlc
  461.      adi    'X'
  462.      mov    c,a;        save index identifier
  463.      inx    d;        point to specifier
  464.      lda    zopkind
  465.      dcr    a;        type 0 never valid
  466.      lxi    h,ixcase
  467.      jmp    casexfr
  468. ;
  469. ; ** CAUTION ** locked to main table in DDTZ. Notes from main
  470. ixcase:     dw    dadx;        1 (No 0th value used)    9 19 29 39
  471.      dw    slixd;        2  lhld shld    22 2a
  472.      dw    dsasm7;        3  inxdcxx    23 2b
  473.      dw    dsasm4;        4  inrdcrx    34 35
  474.      dw    mvix;        5  mvi m    36
  475.      dw    movrx;        6  mov rr,m    46 43 56 53 66 63 (76) 7e
  476.      dw    movxr;        7  mov m,e    73
  477.      dw    movxr;        8  mov h,h, mov m,h    64 74 (64180)
  478.      dw    movxr;        9  mov m,r   70 71 72 (73 74) 75 (76) 77
  479.      dw    arithx;        10 arith m    86 83 96 9e a6 ae b6 be
  480.      dw    lxiops;        11 lxi h    21
  481.      dw    bitx;        12 set/res etc    cb
  482.      dw    xtix;        13 xthl        e3
  483.      dw    dsasm5;        14 popushx    e1 e5
  484.      dw    xtix;        15 pchl        e9
  485.      dw    xtix;        16 sphl        f9
  486.      dw    bad;        17 extension    ed
  487.      dw    undoc;        18 mov rr,e    43 4b 53 5b 63 6b 73 7b
  488.      dw    undoc;        19 mov (retn,reti)    45 4d
  489.      dw    bad;        20 x/y prefixes        dd fd
  490.      dw    bad;        21 exaf,nop        0 8
  491.      dw    bad;        22 jr/djnz    (0 8) 10 18 20 28 30 38
  492.      dw    bad;        23 jmp        0c3
  493.      dw    bad;        24 call        0cd
  494.      dw    bad;        25 lda sta    32 3a
  495.      dw    bad;        26 ret        0c9
  496.      dw    bad;        27 rst        c7 cf d7 df e7 ef f7 ff
  497.      dw    mvixy;        28 mvi        6 e 16 1e 26 2e (36) 3e
  498.      dw    bad;        29 aritopi    c6 ce d6 de e6 ee f6 fe
  499.      dw    bad;        30 j(ccd)    c2 ca d2 da e2 ea f2 fa
  500.      dw    bad;        31 c(ccd)    c4 cc d4 dc e4 ec f4 fc
  501.      dw    bad;        32 r(ccd)    c0 c8 d0 d8 e0 e8 f0 f8
  502.      dw    bad;        33 lxi        1 11 (21) 31
  503.      dw    bad;        34 in/out    d3 db
  504.      dw    undoc;        35 the rest, all 1 byte
  505. ;
  506. ; undocumented, except the MVI xh/xl/yh/yl,value opcodes. C is 'X' or 'Y'
  507. undoc:     call movx ! rnc
  508.      jmp    bad
  509. ;
  510. aritx:     sui 80h ! cmc ! rc;    Not original 80..bf
  511.      ldax d ! ani 7
  512.      call hlm ! rc;        reject m
  513.      stc ! rnz;        reject other than h/l
  514.      lxi    h,xtraops+1
  515.      mov a,c ! cpi 'X'
  516.      jz    aritx1
  517.      lxi    h,ytraops+1
  518. aritx1:     call    mnmix
  519.      jmp    bregop
  520. ;
  521. xinrdcr: lxi    h,xidrops+1
  522.      mov a,c ! cpi 'X'
  523.      jz    xidr1
  524.      lxi    h,yidrops+1
  525. xidr1:     ldax d ! ani 1 ! mov b,a
  526.      add a ! add a ! add b;    *5
  527.      call    index
  528.      jmp    inps1;        mnem, leftreg output     
  529. ;
  530. ; One register must be h or l, and none may be m
  531. movx:     ldax d ! ani 0f6h
  532.      cpi 024h ! jz xinrdcr
  533.      ldax d ! ani 0c0h
  534.      sui 040h ! rc
  535.      jnz    aritx
  536.      ldax d ! call toreg
  537.      call hlm ! rc;        reject m
  538.      jz    movx2;        have hl, other must be non h/l
  539.      ldax d ! ani 7
  540.      call hlm ! rc;        reject m
  541.      stc ! rnz;        no h/l found
  542.      jmp    movx3
  543. movx2:     ldax d ! ani 7
  544.      call hlm ! rc;        reject m
  545.      stc ! rz;        both h/l found
  546. ;    "    "
  547. ; Regs ok, now act like a mov, with appropriate mnemnonic
  548. movx3:     lxi    h,movxops+1
  549.      mov a,c ! cpi 'X'
  550.      jz    movx4
  551.      lxi    h,movxops+6
  552. movx4:     jmp    movops
  553. ;
  554. ; check a for h,l,or m.  Carry for m, zero for h or l
  555. ; a,f
  556. hlm:    cpi 6 ! stc ! rz;    m
  557.     cpi 4 ! rz;        h
  558.     cpi 5 ! stc ! cmc;    z flag for l
  559.     ret
  560. ;
  561. ; Undocumented mvi xh/xl/yh/yl,value opcodes (MVIX h/l)
  562. mvixy:     ldax    d;        c has 'X' or 'Y', de points to 2nd op byte
  563.      ani    0f7h
  564.      cpi 026h ! jnz bad
  565.      lxi    h,mvixops+1
  566.      mov a,c ! cpi 'X'
  567.      jz    mvixy1
  568.      lxi    h,mvixops+6;    else MVIY
  569. mvixy1:     jmp    rgiops
  570. ;
  571. mvix:     lxi    h,mmvi+1
  572.      call    t4chb
  573.      call    ixdisp
  574.      jmp    imopnd
  575. ;
  576. bitx:     inx    d;        past the 0cbh
  577.      inx    d;        past the displacement
  578.      ldax    d
  579.      dcx    d
  580.      ani    7
  581.      cpi 6    ! jz bitpic
  582.      dcx d    ! dcx d
  583.      jmp    bad
  584. ;
  585. slixd:     ldax    d
  586.      ani    8
  587.      lxi    h,msixd+1
  588.      jz    slixd1
  589.      lxi    h,mlixd+1
  590. slixd1:     mvi    a,2
  591.      call    tchars
  592.      mov    a,c
  593.      call    couta
  594.      mvi    a,'D'
  595.      call    couta
  596.      call    blank
  597.      jmp    wdopnd
  598. ;
  599. xtix:     ldax    d
  600.      lxi    h,mxtix
  601.      mvi    b,nxtixs
  602.      call    stbl
  603. ;     "    "
  604. mnx:     mvi    a,3
  605.      call    tchars
  606.      jmp    txrgid
  607. ;
  608. movrx:     lxi    h,mmov+1
  609.      call    t4chb
  610.      call    lftrid
  611.      call    comma
  612.      jmp    ixdisp
  613. ;
  614. movxr:     lxi    h,mmov+1
  615.      call    t4chb
  616.      call    ixdisp
  617.      dcx    d
  618.      jmp    source
  619. ;
  620. ; arithmetic indexed immediate ops
  621. arithx:     call    aritmn
  622.      call    t4chb
  623. ;     "    "
  624. ; show indexed operand
  625. ; a,f,d,e
  626. ixdisp:     mvi    a,'['
  627.      call    couta
  628.      call    txrgid
  629.      inx d    ! ldax d
  630.      ora a    ! jp ixdp1
  631.      mvi    a,'-'
  632.      call    couta
  633.      ldax d ! cma ! inr a
  634.      jmp    ixdp2
  635. ixdp1:     mvi    a,'+'
  636.      call    couta
  637.      ldax    d
  638. ixdp2:     call    t2hx
  639.      mvi    a,']'
  640.      jmp    couta
  641. ;
  642. dadx:     lxi    h,mdad+1
  643.      call    mnx
  644.      call    blank
  645.      jmp    wdrgid
  646. ;
  647. ; Prefix 0cbh, bitpicking
  648. bitpic:     inx    d
  649.      ldax    d
  650.      cpi 040h ! jc sftops
  651.      ani    0c0h
  652.      lxi    h,mbp
  653.      mvi    b,nbps
  654.      call    stbl;        must work
  655.      mov    a,c
  656.      call    num
  657.      call    comma
  658.      jmp    sftop2
  659. ;
  660. ; shift operations
  661. sftops:     ldax d    ! ani 038h
  662.      lxi    h,msft
  663.      mvi    b,nsfts
  664.      call    stbl;        must work
  665. ;     "    "
  666. ; operations on single register. hl points to mnemonic
  667. sftop1:     call    t4chb
  668. ;     "    "
  669. ; show from reg id
  670. sftop2:     mov    a,c
  671.      cpi 'H' ! jz fromrg
  672.      dcx d    ! dcx d
  673.      jmp    ixdisp
  674. ;
  675. ; extension ops prefix 0edh
  676. xtend:     inx d    ! ldax d
  677.      lxi    h,mtstip+1
  678.      cpi 064h ! jz immops
  679.      lxi    h,mtsiop+1
  680.      cpi 074h ! jz immops
  681.      ani 0c7h ! jz in0s;    00, 08, 10, 18, 20, 28, 30, 38
  682.      dcr a    ! jz out0s;    01, 09, 11, 19, 21, 29, 31, 39
  683.      lxi    h,mtstp+1;    TST
  684.      sui 3    ! jz inps1;    04, 0c, 14, 1c, 24, 2c, 34, 3c
  685.      sui 03ch ! jz inps;    040
  686.      dcr a    ! jz outps;    041
  687.      dcr a    ! jz dadc;    042
  688.      dcr a    ! jz xxlds;    043
  689.      ldax d ! ani 0cfh
  690.      lxi    h,mmlt+1
  691.      sui 04ch ! jz wdrgs2;    04c,05c,06c,07c
  692.      ldax    d
  693.      lxi    h,mxtop
  694.      mvi    b,nxtops
  695.      call    stbl
  696.      jz    t4chb
  697.      dcx    d
  698.     endif
  699. ;     "    "
  700. ; Unidentifiable op codes
  701. bad:    lxi    h,badop+1
  702.     mvi    a,3
  703.     call    tchars
  704.     lhld    disasmp;    the next opcode marks end
  705.     mvi    c,0;        use minimum field
  706.     jmp    dspcd;        display de..hl-1
  707. ;
  708.     if    z80
  709. inps:     lxi    h,minp+1
  710. inps1:     call    t4chb
  711.      jmp    lftrid
  712. ;
  713. outps:     lxi    h,moutp+1
  714.      jmp    inps1
  715. ;
  716. in0s:     lxi    h,min0p+1
  717.      jmp    rgiops
  718. ;
  719. out0s:     lxi    h,mout0p+1
  720.      call    t4chb
  721.      inx d    ! ldax d ! dcx d
  722.      call    t2hx
  723.      call    comma
  724.      jmp    lftrid
  725. ;
  726. ; word add/subtract/mlt with carry
  727. dadc:     ldax d    ! ani 08
  728.      lxi    h,mdadc+1
  729.      jnz    wdrgs2
  730.      lxi    h,mdsbc+1
  731.      jmp    wdrgs2
  732. ;
  733. xxlds:     ldax    d
  734.      lxi    h,mlsxd
  735.      mvi    b,nlsxds
  736.      call    stbl;        must work
  737.      jmp    wdops
  738.     endif
  739. ;
  740. subttl    'Symbol Tables'
  741. ;
  742. ; The order of sections is wired into the assembler code
  743. opcd1:    db    000h,'NOP ', 007h,'RLC ', 00fh,'RRC ', 017h,'RAL '
  744.     db    01fh,'RAR ', 027h,'DAA ', 02fh,'CMA ', 037h,'STC '
  745.     db    03fh,'CMC ', 076h,'HLT ', 0c9h,'RET ', 0e3h,'XTHL'
  746.     db    0e9h,'PCHL', 0ebh,'XCHG', 0f3h,'DI  ', 0f9h,'SPHL'
  747.     db    0fbh,'EI  '
  748. ;
  749. mcrtn:    db    0c0h,'RNZ ', 0c8h,'RZ  ', 0d0h,'RNC ', 0d8h,'RC  '
  750.     db    0e0h,'RPO ', 0e8h,'RPE ', 0f0h,'RP  ', 0f8h,'RM  '
  751. ncrtns    equ    ($-mcrtn)/5
  752. ni1    equ    ($-opcd1)/5
  753. ;
  754. opcd2:    db    0c6h,'ADI ', 0ceh,'ACI ', 0d3h,'OUT ', 0d6h,'SUI '
  755.     db    0dbh,'IN  ', 0deh,'SBI ', 0e6h,'ANI ', 0eeh,'XRI '
  756.     db    0f6h,'ORI ', 0feh,'CPI '
  757. ni2    equ    ($-opcd2)/5
  758. ;
  759. opcd3:    db    022h,'SHLD', 02ah,'LHLD', 032h,'STA ', 03ah,'LDA '
  760.     db    0c3h,'JMP ', 0cdh,'CALL'
  761. ni3    equ    ($-opcd3)/5
  762. ;
  763.     if    z80
  764. opcd4:     db    008h,'EXAF', 0d9h,'EXX '
  765. ni4     equ    ($-opcd4)/5
  766.     endif
  767. ;
  768. madd:    db    080h,'ADD ', 088h,'ADC ', 090h,'SUB ', 098h,'SBB '
  769.     db    0a0h,'ANA ', 0a8h,'XRA ', 0b0h,'ORA ', 0b8h,'CMP '
  770. nadds    equ    ($-madd)/5
  771. ;
  772. minr:    db    004h,'INR '
  773. mdcr:    db    005h,'DCR '
  774. nrops    equ    ($-minr)/5
  775. ;
  776. mmvi:    db    006h,'MVI '
  777. mmov:    db    040h,'MOV '
  778. mrst:    db    0c7h,'RST '
  779. ;
  780.     if    z80
  781. mdjnz:     db    010h,'DJNZ', 018h,'JR  ', 020h,'JRNZ', 028h,'JRZ '
  782.      db    030h,'JRNC', 038h,'JRC '
  783. njrs     equ    ($-mdjnz)/5
  784.     endif
  785. ;
  786. mlxi:    db    001h,'LXI '
  787. ;
  788. mstax:    db    002h,'STAX', 00ah,'LDAX'
  789. mdad:    db    009h,'DAD '
  790. nwdrxx    equ    ($-mstax)/5
  791.     db    003h,'INX ', 00bh,'DCX ', 0c1h,'POP ', 0c5h,'PUSH'
  792. nwdr    equ    ($-mstax)/5
  793. nwdrxy    equ    nwdr-nwdrxx
  794. ;
  795.     if    z80
  796. ; additional to allow input parsing. not used in disassembly
  797. mdadxy:     db    009h,'DADY', 009h,'DADX'
  798. ndadxys     equ    ($-mdadxy)/5
  799. ;
  800. ; used in disassembly
  801. msft:     db    000h,'RLCR', 008h,'RRCR', 010h,'RALR', 018h,'RARR'
  802.      db    020h,'SLAR', 028h,'SRAR', 030h,'SLLR', 038h,'SRLR'
  803. nsfts     equ    ($-msft)/5
  804. ;
  805. mbp:     db    040h,'BIT ', 080h,'RES ', 0c0h,'SET '
  806. nbps:     equ    ($-mbp)/5
  807. ;
  808. ; additional to allow input parsing, not used in disassembly
  809. mxtiy:     db    0e3h,'XTIY', 0e9h,'PCIY', 0f9h,'SPIY'
  810. nxtiys:     equ    ($-mxtiy)/5
  811. ;
  812. ; used in disassembly
  813. mxtix:     db    0e3h,'XTIX', 0e9h,'PCIX', 0f9h,'SPIX'
  814. nxtixs     equ    ($-mxtix)/5
  815. ;
  816. ; additional to allow input parsing, not used in disassembly
  817. msiyd:     db    022h,'SIYD', 02ah,'LIYD'
  818. nslyds     equ    ($-msiyd)/5
  819. ;
  820. ; used in disassembly
  821. msixd:     db    022h,'SIXD'
  822. mlixd:     db    02ah,'LIXD'
  823. nslxds     equ    ($-msixd)/5
  824. ;
  825. mlsxd:     db    043h,'SBCD', 04bh,'LBCD', 053h,'SDED', 05bh,'LDED'
  826.      db    063h,'shld', 06bh,'lhld', 073h,'SSPD', 07bh,'LSPD'
  827. nlsxds     equ    ($-mlsxd)/5
  828. ;
  829. mdsbc:     db    042h,'DSBC'
  830. mdadc:     db    04ah,'DADC'
  831. mmlt:     db    04ch,'MLT '
  832. ndadcs     equ    ($-mdsbc)/5
  833. ;
  834. min0p:     db    000h,'IN0 '
  835. mout0p:     db    001h,'OUT0'
  836. mtstp:     db    004h,'TST '
  837. minp:     db    040h,'INP '
  838. moutp:     db    041h,'OUTP'
  839. mtstip:     db    064h,'TSTI'
  840. mtsiop:     db    074h,'TSIO'
  841. niops     equ    ($-min0p)/5
  842. ;
  843. mxtop:     db    044h,'NEG ', 045h,'RETN', 046h,'IM0 ', 047h,'LDIA'
  844.      db    04dh,'RETI', 04fh,'LDRA', 056h,'IM1 ', 057h,'LDAI'
  845.      db    05eh,'IM2 ', 05fh,'LDAR', 067h,'RRD ', 06fh,'RLD '
  846.      db    076h,'SLP '
  847.      db    083h,'OTIM', 08bh,'OTDM', 093h,'OIMR', 09bh,'ODMR'
  848.      db    0a0h,'LDI ', 0a1h,'CCI ', 0a2h,'INI ', 0a3h,'OTI '
  849.      db    0a8h,'LDD ', 0a9h,'CCD ', 0aah,'IND ', 0abh,'OTD '
  850.      db    0b0h,'LDIR', 0b1h,'CCIR', 0b2h,'INIR', 0b3h,'OTIR'
  851.      db    0b8h,'LDDR', 0b9h,'CCDR', 0bah,'INDR', 0bbh,'OTDR'
  852. nxtops     equ    ($-mxtop)/5
  853.  
  854. mvixops: db    026h,'MVIX', 026h,'MVIY';    undocumented codes
  855. movxops: db    040h,'MOVX', 040h,'MOVY'
  856. xtraops: db    080h,'ADXR', 088h,'ACXR', 090h,'SUXR', 098h,'SBXR'
  857.      db    0a0h,'NDXR', 0a8h,'XRXR', 0b0h,'ORXR', 0b8h,'CPXR'
  858. ytraops: db    080h,'ADYR', 088h,'ACYR', 090h,'SUYR', 098h,'SBYR'
  859.      db    0a0h,'NDYR', 0a8h,'XRYR', 0b0h,'ORYR', 0b8h,'CPYR'
  860. xidrops: db    024h,'INRX', 025h,'DCRX'
  861. yidrops: db    024h,'INRY', 025h,'DCRY'
  862. nxyxops     equ    ($-mvixops)/5
  863.     endif
  864. badop:    db    0ffh,'??= '
  865. ;
  866. mreg:    db    'BCDEHLMA'
  867.     if    z80
  868.      db    '[XY'
  869.     endif
  870. nregs    equ    $-mreg
  871. ;
  872. mpsw:    db    031h,'PSW ';    added 1 bit in value
  873. msp    db    030h,'SP  ', 020h,'H   ';    <<dyn. altered
  874.     db    010h,'D   ', 000h,'B   '
  875.     if    z80
  876.      db    020h,'X   ', 020h,'Y   '
  877.     endif
  878.     db    0ffh;        table end marker
  879. ixrid    equ    msp+6
  880. ;
  881. subttl    'Assembler'
  882. ;
  883. ; assemble line, 1st char in a.  Write results to buffer
  884. ; Carry for error.  Code must agree with table order.
  885. asmln:    if    z80
  886.      lxi    h,ixrid;    preserve a, is 1st char.
  887.      mvi    m,'H';        reset XY id
  888.     endif
  889.     call    getmnc
  890.     lxi    h,opcd1
  891.     call    search;        returns hl^=opcode, a=index
  892.     jc    asmln2;        not found, check jmp/call ccode
  893.     mov    b,m;        master opcode
  894.     sui ni1+1  ! jc wrtcdb;    1 byte no argument  (nop, xthl)
  895.     sui ni2    ! jc bytimm;    immediate 1 byte arg (adi 5)
  896.     sui ni3    ! jc wdimm;    immediate word arg (lhld 5)
  897.     if    z80
  898.      sui ni4   ! jc chkz80;    1 byte no arg, Z80 only (exaf)
  899.     endif
  900.     sui nadds  ! jc sfromr;    1 byte, 1 reg argument (add a)
  901.     sui nrops  ! jc inrdcrg;inr/dcr
  902.              jz mviop;    mvi
  903.     dcr a       ! jz movop;    mov
  904.     dcr a       ! jz rstn;    rst
  905.     if    z80
  906.      sui njrs+1 ! jc jrop
  907.     else
  908.      dcr    a
  909.     endif
  910.     jz    lxiop;        lxi
  911.     if    not z80
  912.      sui nwdr+1 ! jc dblrg;    ldax/stax dad push/pop inx/dcx
  913.     else;                z80
  914.      sui nwdrxx+1 ! jc dblrg;    ldax/stax dad
  915.      sui nwdrxy ! jc dblxrg;    push/pop inx/dcx
  916.      sui ndadxys ! jc xydad
  917.      sui nsfts  ! jc sfts;        ralr etc
  918.      sui nbps   ! jc bps;        bit/set/res
  919.      sui nxtiys ! jc yop
  920.      sui nxtixs ! jc xop
  921.      sui nslyds ! jc yopwd
  922.      sui nslxds ! jc xopwd
  923.      sui nlsxds ! jc lsxds;        lbcd etc
  924.      sui ndadcs ! jc dadcs;        dadc/dsbc
  925.      sui niops  ! jc iops;        inp/outp
  926.      sui nxtops ! jc xtops;        all extended z80 ops
  927.      sui nxyxops ! rc;        All undocumented ops
  928.     endif
  929. asmln2:    lxi h,buff ! mov a,m
  930.     cpi    'J'
  931.     mvi    b,0c2h
  932.     jz    cjmps;        jnz etc
  933.     cpi 'C' ! stc ! rnz;    not jmp/call.  Error
  934.     mvi    b,0c4h;        cnz etc
  935. cjmps:    mvi    m,'R'
  936.     lxi    h,opcd1;    modify mnemonic and re-search
  937.     call    search ! rc
  938.     mov a,m    ! ora b ! mov b,a
  939.     jmp    wdimm;        jcc/ccc
  940. ;
  941. ; fill buffer with next input, blank padded.
  942. ; a,f,b,h,l
  943. getmn:    call    nextch
  944. ;    "    "
  945. ; Entry with first character in (a)
  946. ; a,f,b,h,l
  947. getmnc:    cpi    ' '
  948.     jz    getmn;        skip initial blanks
  949.     lxi    h,buff
  950.     mvi    b,4
  951. getmn1:    call    qdelim
  952.     jz    getmn2;        short, blank fill (or empty line)
  953.     mov m,a ! inx h
  954.     dcr    b
  955.     cnz    nextch
  956.     jnz    getmn1;        else end or input line end
  957.     call    nextch;        jams at cr
  958.     call    qdelim
  959.     stc
  960.     rnz;            error, no delimiter
  961. getmn2:    ora    a
  962.     inr    b;        (a) is delimiting char.
  963. getmn3:    dcr    b
  964.     rz;            buffer full
  965.     mvi m,' ' ! inx h
  966.     jmp    getmn3
  967. ;
  968. ; get word register identifier
  969. ; a,f,h,l
  970. getwrg:    push    b
  971.     call    getmn
  972.     pop    b
  973.     rc
  974.     lxi    h,mpsw
  975. ;    "    "
  976. ; search for buff^ in hl^.  Slow simple minded serial search.
  977. ; Return hl pointing to entry if found, with a=index of
  978. ; entry (1 based).  Return a=0 and carry if not found.
  979. ; a,f,h,l
  980. search:    push d    ! push b
  981.     lxi    b,0100h;    b := 1; c := 0
  982.     dcx    h
  983. srch1:    inx h    ! dcr b
  984.     jnz    srch1;        advance pointer to next item
  985.     lxi    d,buff
  986.     inr    c;        count table entries searched
  987.     mvi    b,4;        size of mnemnonic entry
  988.     mov    a,m;        0ffh opcode marks table end
  989.     inr    a
  990.     stc
  991.     jz    srch4;        end of table, exit w/carry
  992. srch3:    ldax d    ! inx d ! inx h
  993.     cmp m    ! jnz srch1;    not this one
  994.     dcr b    ! jnz srch3;    not complete mnemnonic yet
  995.     dcx h    ! dcx h
  996.     dcx h    ! dcx h;    back up to opcode
  997.     mov    a,c;        get mnem id
  998. srch4:    pop b    ! pop d
  999.     ret
  1000. ;
  1001.     if    z80
  1002. ; extended z80 op
  1003. xtops:     mvi    a,0edh
  1004.      call    wrtcd
  1005. ;     "    "
  1006. ; write code byte hl^ if on Z80 only, else carry for error
  1007. ; a,f
  1008. chkz80:     call qz80 ! stc
  1009.      rz
  1010.     endif
  1011. ;    "    "
  1012. ; write code byte b into buffer. Clear carry
  1013. ; a,f
  1014. wrtcdb:    mov    a,b
  1015. ;    "    "
  1016. ; write code byte (a) into buffer. Clear carry
  1017. ; f
  1018. wrtcd:    push h    ! push b
  1019.     lxi    h,buff+5
  1020.     inr    m
  1021.     mov    c,m;        1 up
  1022.     mvi    b,0
  1023.     dad    b;        must clear carry
  1024.     mov    m,a
  1025.     pop b    ! pop h
  1026.     ret
  1027. ;
  1028. ; Save one lines stored code and advance disasmp
  1029. ; Make one line of input indivisible.
  1030. ; b,d,e,h,l
  1031. savecd:    push    psw
  1032.     lhld    disasmp
  1033.     lxi    d,buff+4
  1034.     if    z80
  1035.      ldax    d
  1036.      ora a    ! jz savcd1;    no index prefix to put
  1037.      mov m,a ! inx h
  1038.     endif
  1039. savcd1:    inx d    ! ldax d ! mov b,a;    count
  1040.     inx d    ! dcr b
  1041.     jm    savcd3;        was zero
  1042. savcd2:    ldax d    ! inx d;    code
  1043.     mov m,a ! inx h
  1044.     dcr b    ! jp savcd2;    more to move
  1045.     shld    disasmp;    point to unfilled byte
  1046. savcd3:    pop    psw
  1047.     ret
  1048. ;
  1049. ; return a byte register id identifier in A
  1050. ; a,f,h,l
  1051. getbrg:    call    skipblks
  1052.     push    b
  1053.     lxi    h,mreg
  1054.     lxi    b,nregs;    b=0; c=nregs
  1055. gbr1:    cmp m    ! jz gbr3;    found
  1056.     inr b    ! inx h
  1057.     dcr c    ! jnz gbr1
  1058.     stc;            not found
  1059. gbr3:    mov    a,b
  1060.     pop    b
  1061.     ret
  1062. ;
  1063. ; get word size argument to hl
  1064. ; a,f,d,e,h,l
  1065. getwd:    call    rdhex
  1066.     xchg
  1067.     call    qdelim
  1068.     rz
  1069.     stc
  1070.     ret
  1071. ;
  1072. ; get byte size argument to hl
  1073. ; a,f,d,e,h,l
  1074. getbyt:    call    getwd ! rc
  1075.     inr h ! dcr h ! rz;        in range
  1076.     stc
  1077.     ret
  1078. ;
  1079.     if    z80
  1080. jrop:     call    chkz80 ! rc
  1081.      call    getwd ! rc
  1082.      xchg
  1083.      lhld    disasmp
  1084.      inx h    ! inx h
  1085.      mov a,e ! sub l ! mov l,a
  1086.      mov a,d ! sbb h ! mov h,a
  1087.      lxi d,080h ! dad d;    negative carries 
  1088.      mov a,h ! ora a ! stc
  1089.      rnz;            overrange
  1090.      mov a,l ! xri 080h ! mov b,a
  1091.      jmp    putbyt
  1092.     endif
  1093. ;
  1094. lxiop:    call    getwrg ! rc
  1095.     if    z80
  1096.      cpi 6 ! jc lxiop1;    Not lxi x or lxi y
  1097.      sui    6
  1098.      rrc ! rrc ! rrc
  1099.      adi    0ddh;        form indexing prefix
  1100.      sta    buff+4;        and set x/y prefix
  1101.      mvi    b,021h;        opcode
  1102.      jmp    wdimm
  1103. lxiop1:
  1104.     endif
  1105.     mov a,m    ! cpi 031h ! stc
  1106.     rz;            no psw
  1107.     ora b    ! mov b,a
  1108. ;    "    "
  1109. ; put opcode b and word immediate argument
  1110. wdimm:    call    wrtcdb
  1111. ;    "    "
  1112. ; put word immediate argument
  1113. putwd:    call    getwd ! rc
  1114.     mov a,l ! call wrtcd
  1115.     mov b,h ! jmp  putbyt
  1116. ;
  1117. ; opcode, regid ',' immediate opnd
  1118. mviop:    call    getbrg ! rc
  1119.     if    z80
  1120.      cpi    8
  1121.      jc    mviop1
  1122.      call    ixitlf ! rc
  1123.      jmp    mviop2
  1124.     endif
  1125. mviop1:    add a ! add a ! add a
  1126.     ora b    ! mov b,a
  1127. mviop2:    call    skipblks
  1128.     cpi ','    ! stc
  1129.     rnz
  1130. ;    "    "
  1131. ; put opcode b and byte immediate argument
  1132. bytimm:    call    wrtcdb
  1133.     call    getbyt ! rc
  1134.     mov b,l ! jmp putbyt
  1135. ;
  1136.     if    z80
  1137. out0ps:     call getbyt ! rc;    port to l
  1138.      cpi ',' ! stc ! rnz;    not comma terminator
  1139.      push    h
  1140.      call    getbrg;        register
  1141.      pop    h    
  1142.      rc;            bad
  1143.      cpi 8 ! cmc ! rc;    bad, xy not allowed
  1144.      add a ! add a ! add a
  1145.      ora b ! call wrtcd;    opcode with reg
  1146.      mov    b,l
  1147.      jmp    putbyt;        port
  1148.  
  1149. iops:     mvi    a,0edh
  1150.      call    wrtcd
  1151.      mov    a,b
  1152.      ora a    ! jz mviop;    in0 reg,port
  1153.      dcr a    ! jz out0ps;    out0 port,reg
  1154.      ani 0efh ! cpi 063h;    orig 64h or 74h
  1155.      jz    bytimm;        tsio port or tsti value
  1156.     endif
  1157. ;    "    "
  1158. inrdcrg:
  1159.     call    getbrg ! rc
  1160.     if    not z80
  1161.      jmp    leftrg
  1162.     else
  1163.      cpi    8
  1164.      jc    leftrg
  1165.      call    ixitlf
  1166.      jmp    putbyt
  1167. ;
  1168. ixitlf:     call ixit ! rc;    index left operand
  1169.      add a ! add a ! add a
  1170.      ora    b
  1171.      call    wrtcd
  1172.      mov    b,c
  1173.      ret
  1174.     endif
  1175. ;
  1176. ; opcode with to/from regs embedded
  1177. movop:    call    getbrg ! rc
  1178.     if    z80
  1179.      cpi    8
  1180.      jc    movop1;        not "["
  1181.      call    ixitlf ! rc
  1182.      jmp    movop2
  1183.     endif
  1184. movop1:    add a ! add a ! add a
  1185.     ora b    ! mov b,a
  1186. movop2:    call    skipblks
  1187.     cpi ','    ! stc ! rnz
  1188. ;    "    "
  1189. ; set source register in b and write
  1190. sfromr:    call    getbrg ! rc;    get register id 0..7
  1191.     if    not z80
  1192.      jmp    orbout
  1193.     else
  1194.      cpi    8
  1195.      jc    orbout;        not '['
  1196.      call    ixit ! rc
  1197.      ora b    ! call    wrtcd;    opcode
  1198.      mov    b,c
  1199.      jmp    putbyt;        and displacement
  1200.     endif
  1201. ;
  1202. rstn:    call    getbyt ! rc
  1203.     mov a,l ! cpi 8 ! cmc
  1204.     rc
  1205. ;    "    "
  1206. leftrg:    add a ! add a ! add a
  1207. ;    "    "
  1208. ; insert field a in b (or vice versa) and output. Check for eol
  1209. orbout:    ora b    ! mov b,a
  1210. ;    "    "
  1211. ; Check for eol, and write byte b
  1212. putbyt:    call    skipblks
  1213.     stc
  1214.     rnz;            need eol
  1215.     jmp    wrtcdb
  1216. ;
  1217.     if    z80
  1218. ; convert into index/displacement.  Just parsed '[' or X or Y
  1219. ; Carry set on entry, 8 <= a <= nregs
  1220. ; Returns c=displacement, a=reg id code (=6), sets ix prefix
  1221. ; NO code is output.
  1222. ; a,f,b,d,e,h,l
  1223. ixit:     stc    ! rnz;        eliminate X and Y
  1224.      call    qz80
  1225.      stc    ! rz;        indexing on z80 only
  1226.      lda    buff+4
  1227.      ora a ! stc ! rnz;    left op already indexed
  1228.      call getbrg ! rc
  1229.      cpi 9    ! rc;        not x/y
  1230.      mvi    a,0ddh
  1231.      jz    ixit1;        X
  1232.      mvi    a,0fdh;        Y
  1233. ixit1:     sta    buff+4;        identify index used (prefix)
  1234.      call    skipblks
  1235.      cpi '+' ! jz ixit3;    with carry clear
  1236.      cpi '-' ! stc ! rnz;    if not +/-
  1237.      call    getbyt ! rc
  1238.      push    psw
  1239.      mov a,l ! cma ! inr a ! mov l,a
  1240.      pop    psw
  1241.      jmp    ixit4
  1242. ixit3:     cnc    getbyt ! rc
  1243. ixit4:     sui ']' ! stc ! rnz;    if no closing ']' found
  1244.      mov    c,l;        the displacement
  1245.      ori    6;        convert to M register address
  1246.      ret
  1247. ;
  1248. dadcs:     mvi    a,0edh
  1249.      call    wrtcd
  1250.     endif
  1251. ;    "    "    
  1252. dblrg:    call getwrg ! rc
  1253.     if    z80
  1254.      cpi 6    ! cmc ! rc;    eliminate x/y
  1255.     endif
  1256. dbl1:    ora    b
  1257.     mvi    a,030h
  1258.     jm    dbl2;        pop/push
  1259.     mvi    a,031h
  1260. dbl2:    cmp m    ! stc ! rz;    select one of sp/psw
  1261.     mov a,m    ! jmp orbout
  1262. ;
  1263.     if    z80
  1264. dblxrg:     call getwrg ! rc
  1265.      cpi 6    ! jc dbl1;    not x or y argument
  1266.      sui 6;            before must keep a +ve
  1267.      rrc ! rrc ! rrc;    bit to 020h posn
  1268.      adi    0ddh
  1269.      sta    buff+4;        set x/y prefix
  1270.      xra    a
  1271.      jmp    dbl1;        rest as before
  1272. ;
  1273. lsxds:     mvi    a,0edh
  1274.      call    wrtcd
  1275.      jmp    wdimm
  1276. ;
  1277. sfts:     mvi    a,0cbh
  1278.      call    wrtcd
  1279. sfts1:     call    qz80
  1280.      stc     ! rz
  1281.      call    getbrg ! rc;    get register id 0..7
  1282.      cpi    8
  1283.      jc    orbout
  1284.      call    ixit ! rc
  1285.      ora b ! mov b,a
  1286.      mov    a,c
  1287.      call    wrtcd;        displacement
  1288.      jmp    putbyt;        opcode and check eol
  1289. ;
  1290. bps:     mvi    a,0cbh
  1291.      call    wrtcd
  1292.      call    skipblks
  1293.      cpi '0' ! rc
  1294.      cpi '9'+1 ! cmc ! rc
  1295.      ani    07h
  1296.      ral ! ral ! ral
  1297.      ora b    ! mov b,a
  1298.      call    nextch
  1299.      call    qdelim
  1300.      stc
  1301.      rnz
  1302.      jmp    sfts1
  1303. ;
  1304. xydad:     inr    a
  1305.      mvi    a,0fdh
  1306.      jnz    xydad1
  1307.      mvi    a,0ddh
  1308. xydad1:     sta    buff+4
  1309.      lda    buff+3;        xy reg id
  1310.      sta    ixrid;        alter index reg id
  1311.      jmp    dblrg
  1312. ;
  1313. yop:     mvi    a,0fdh
  1314.      jmp    xop1
  1315. xop:     mvi    a,0ddh
  1316. xop1:     sta    buff+4
  1317.      jmp    wrtcdb
  1318. ;
  1319. yopwd:     mvi    a,0fdh
  1320.      jmp    xopwd1
  1321. xopwd:     mvi    a,0ddh
  1322. xopwd1:     sta    buff+4
  1323.      jmp    wdimm
  1324.     endif
  1325. ;
  1326. subttl    File writing
  1327. ;
  1328. ask:    lxi    h,tfcb+1
  1329.     mvi    a,8
  1330.     call    tchars
  1331.     mvi    a,'.'
  1332.     call    couta
  1333.     mvi    a,3
  1334.     call    tchars
  1335.     lxi    d,m2
  1336.     call    tstr
  1337.     call    getline
  1338.     call    skipblks
  1339.     sui    'Y'
  1340.     ret
  1341. ;
  1342. keep:    lxi    h,0100h
  1343.     shld    storeptr
  1344.     lhld    unloaded
  1345.     dcx    h
  1346.     jz    keep1
  1347.     cpi    2
  1348.     jnz    err
  1349.     call    nextparm
  1350.     shld    storeptr
  1351.     call    nextparm
  1352. keep1:    inx    h
  1353.     shld    dendptr
  1354.     call    rsdma
  1355.     call    crlf
  1356.     lda    tfcb+1
  1357.     cpi    ' '
  1358.     lxi    d,m1
  1359.     jz    tstr
  1360.     mvi    a,17
  1361.     call    foperate
  1362.     inr    a
  1363.     cnz    ask
  1364.     rnz
  1365.     sta    tfcb+32
  1366.     sta    tfcb+12
  1367.     mvi    a,19;        purge
  1368.     call    foperate
  1369.     mvi    a,22;        make
  1370.     call    foperate;    make/write
  1371.     inr    a
  1372.     jz    err
  1373. keep3:    lhld    storeptr
  1374.     xchg
  1375.     lhld    dendptr
  1376.     call    delesshl
  1377.     jnc    done
  1378.     lxi    h,0080h
  1379.     dad    d
  1380.     shld    storeptr
  1381.     mvi    a,26
  1382.     call    dos;        set dma
  1383.     mvi    a,21;        write
  1384.     call    foperate
  1385.     ora    a
  1386.     jz    keep3
  1387.     call    rsdma
  1388.     jmp    err
  1389. ;
  1390. done:    call    rsdma
  1391.     mvi    a,16;        fclose
  1392.     jmp    foperate;    and exit to system
  1393. ;
  1394. rsdma:    lxi    d,defdma
  1395.     mvi    a,26
  1396.     jmp    dos
  1397. ;
  1398. m1:    db    'File?$'
  1399. m2:    db    ' exists, purge (y/n)?$'
  1400. ;
  1401.     if    ($-begin) AND 0ffh;    align it
  1402. .align     equ    ($-begin) AND 0ffh
  1403.      ds    256-.align,0
  1404.     endif
  1405. ;
  1406. ; transfer around segment on startup
  1407. ddtbgn:    ds    0
  1408.     end
  1409. W║