CP/M

home *** CD-ROM | disk | FTP | other *** search

/ CP/M / CPM_CDROM.iso / cpm / debug / ddtz27.ark / DDTDISA.MAC < prev next >

Wrap

Text File | 1988-05-29 | 29.3 KB | 1,409 lines

title Assembler/Dissasembler segment for DDTZ. ; MUST be integral # of pages. MUST be first segment linked. ; ; 88/04/25 Modified to use 64180 op codes. DDT Version 27. ; 2.7 DO NOT mix with earlier main system. LXI X and LXI Y ; now assemble. Most undocumented ops disassemble cbf. ; 87/07/11 Minor change so that MOV disassembles correctly when ; 2.6 run on 8080 (or under v20-80 under MSDOS). cbf. ; 86/02/12 Corrected to allow assembly of push/pop inx/dcx x/y ; still accepts faulty operands ldax h, ldax sp, etc. ; but any correction will cause DDTY (z80 false) to swell ; by another 256 bytes. This IS a crude assembler. cbf. ; cseg entry disassem; a=aflag entry assemble; pcnt just called entry keep; code file entry begin, .bdos; for overlay checks ; ; Main system routines useable by assembler/disassembler extrn dblblk, blank, couta, crlf extrn qbrk, csta, nextch, skipblks extrn t4hx, t2hx, tstr; a,f extrn qdelim; flags extrn getline; a,f,b,c,d,e extrn pcnt; a,f,d,e,h,l. Get params & count extrn nextparm; d,e,h,l extrn rdhex, rdhexc; a:=exit ch, de := value extrn chkop; all. de^ to op, exit hl^ past op extrn err; abort exit to DDT extrn foperate, dos; without disturbing regs. arg a extrn index, indexwd; a,f,h,l extrn casexfr; a,f,h,l + routine extrn sdem, ldem; hl^ =:= de; hl:=hl+2 extrn delesshl; a,f. comparator, unsigned ; extrn codesize, pages; To set relocation data ; ; external data areas used extrn disasmp, dendptr, aflag; for trace display extrn storeptr, exitstk, buff;[16] scratch vars. ; ; read only data from main system extrn opkind, zopkind; set by chkop extrn z80flg; set if running on Z80 extrn unloaded; memory not yet loaded ; true equ -1 false equ not true z80 equ true; false strips z80 code tfcb equ 05ch defdma equ 080h ; ; Transfers around system on startup. Overwritten later ; The next module should be the main program. begin: jmp ddtbgn; overlayed by serial no. ; ; Following for loader information. overlayed by serial no. dw codesize + (ddtbgn-begin) db pages + (ddtbgn-begin)/256 ; place connecter at bdos equiv locn .bdos: jmp $-$; becomes bdos connector ; assemble: dcr a; main system has just called pcnt jnz err; need exactly 1 param call nextparm shld disasmp ; " " ; Master assembly loop assm: lxi h,buff+4 xra a ! mov m,a; no index register inx h ! mov m,a; mark code buffer empty call crlf lhld disasmp xchg call typepc call blank call getline call skipblks rz; empty line, exit cpi '.' rz; exit call asmln cnc savecd; and advance disasmp jnc assm; no error call crlf mvi a,'?' call couta jmp assm ; if z80 ; Set flags on z80flg qz80: lda z80flg ora a ret endif ; subttl 'Disassembler' ; disassem: sta aflag ora a ! jz dsasm; 0 means do to dendptr lxi h,0ffffh shld dendptr; else set default end inr a ! jnz dsasm; >= 1 means show n lines inr a; -1 means 1 opcode, no header sta aflag; set lines to 1 lhld disasmp xchg push d call chkop; set up pointers, opkind pop d dcx h shld dendptr; point to last byte of opcode inx h; de := disasmp, hl^ next opcode jmp dsasm2 ; ; main disassembly loop dsasm: call qbrk lxi h,aflag mov a,m ora a ! jz dsasm1; using dendptr dcr m rz; lines done dsasm1: lhld dendptr xchg lhld disasmp call delesshl xchg rc; past end marker call craddr mvi c,-10; field size to use call showcd; hl^ next opcode, de^ this opcode ; " " opkind/z80flg set dsasm2: shld disasmp; de := this, disasmp := next lxi h,dsasm push h; set return on stack lxi h,opcd1 ldax d mvi b,ni1 mvi c,'H'; default index reg. id call stbl jz t4chb; all one byte no operand opcodes mvi b,ni2 call stbl jz immops; all immediate to a opcodes mvi b,ni3 call stbl jz wdops; all immediate word opnd opcodes if z80 call qz80 ldax d; was jz dsasm3 ! ldax d; 87/7/11 jz dsasm3 mvi b,ni4 call stbl jz t4chb; one byte z80 only opcodes endif dsasm3: ani 0c0h lxi h,mmov+1 cpi 040h ! jz movops cpi 080h ! jz aritop dsasm4: ldax d ! ani 0c7h; entry for indexed inrdcr sui 4 ! jz inrops dcr a ! jz dcrops dcr a ! jz mviops ldax d ani 0c0h ! jz dsasm6 ldax d ! ani 7 sui 2 ! jz jmpcc sui 2 ! jz callcc sui 3 ! jz rstop ldax d ani 8 ! jnz prefix; leaving cb,d9,dd,ed,fd dsasm5: ldax d ! ani 0c5h; entry for push/pop x/y jmp wdrgs; pop, push ; dsasm6: ldax d ! ani 7 if z80 jz jrops; exaf removed earlier else jz bad endif dsasm7: ldax d ! ani 0fh; entry for inx/dcx x/y dcr a ! jz lxiops inr a ; " " ; one byte opcodes operating on word registers ; a,f,b,h,l wdrgs: lxi h,mstax mvi b,nwdr; stax, ldax, inx, dcx, dad, pop, push call stbl wdrgs2: call t4chb; entry from dadc/dsbc ldax d ani 0ah ! jnz wdrgid; not pop/push ldax d ! ani 030h cpi 030h lxi h,mpsw+1 ! mvi a,3 jz tchars ; " " ; show word register id ; a,f wdrgid: call toreg ani 6 cpi 4 ! jz txrgid cpi 6 ! jnz tregid push h lxi h,msp+1 mvi a,2 call tchars pop h ret ; ; All above exits return to dsasm via stacked return address ; In general, de points to next byte to disassemble, c holds ; an index register specifier (H, X, or Y). When operands ; are listed de is normally destroyed. The z80 only opcodes ; are enable/disabled by the main system Z80FLG variable. The ; system depends on classification of operators by the main ; system CHKOP procedure, which also returns the opcode length. ; ; lxi R opn lxiops: lxi h,mlxi+1 call t4chb call wdrgid call comma jmp wdopnd ; if z80 ; relative jump z80 ops jrops: call qz80 jz bad ldax d lxi h,mdjnz mvi b,njrs call stbl; must succeed call t4chb inx d ! ldax d mov l,a; convert rel to absolute rlc sbb a mov h,a inx d dad d jmp t4hx endif ; ; restart opcode rstop: lxi h,mrst+1 ; " " ; display mnemnonic and middle 3 bits of (a) as digit 0..7 ; a,f,h,l num: call t4chb call toreg adi '0' jmp couta ; ; conditional calls callcc: mvi a,'C' jmp jmpcc1 ; ; conditional jumps jmpcc: mvi a,'J' jmpcc1: call couta call toreg mov l,a ! add a ! add a ! add l; *5 lxi h,mcrtn+2 call index mvi a,2 call tchars call dblblk jmp wdopnd ; ; inr/dcr ops ; a,f,h,l (de on index) inrops: lxi h,minr+1 jmp dcrop1 dcrops: lxi h,mdcr+1 dcrop1: call t4chb if z80 mov a,c cpi 'H' jnz ixdisp endif ; " " lftrid: call toreg jmp tregid ; ; arithmetic immediate ops ; a,f,b,h,l aritop: call aritmn ; " " ; operations on single register. hl point to mnemonic ; a,f bregop: call t4chb ; " " ; show from reg id ; a,f fromrg: ldax d ! ani 7 jmp tregid ; ; get pointer to arithmetic op mnemnonic ; a,f,b,h,l aritmn: lxi h,madd+1 ; " " ; index to mnemonic via hl^ on toreg field mnmix: ldax d ! ani 038h; index by 5*toreg field rrc mov b,a rrc ! rrc; div 8 and mul 5 add b jmp index ; ; immediate to a opcodes ; a,f,d,e immops: call t4chb jmp bopnd ; ; immediate 1 byte operators, with reg. id mviops: lxi h,mmvi+1 ; " " ; Mnemnonic, register, immediate byte value rgiops: call t4chb call lftrid ; " " ; show immediate as 2nd operand ; a,f,d,e imopnd: call comma ; " " ; list byte operand ; a,f,d,e bopnd: inx d ! ldax d jmp t2hx ; ; word ops. hl is opmnem pointer, output 1 word operand ; a,f,d,e,h,l wdops: call t4chb ; " " ; show word operand ; a,f,d,e,h,l wdopnd: inx d xchg call ldem xchg jmp t4hx ; ; move ops ; a,f,h,l movops: call t4chb call lftrid ; " " ; Show source register id. ; a,f source: call comma ldax d ! ani 7 ; " " ; convert a into regid listing ; a,f tregid: push h lxi h,mreg call index mov a,m pop h jmp couta ; ; extract middle bits (to reg id) ; a,f toreg: ldax d ani 38h rrc ! rrc ! rrc ret ; ; write 4 chars from hl^ with trailing blank ; a,f,h,l t4chb: call t4char jmp blank ; ; show code bytes at de^ up with at least one trailing blank. ; Set up opkind, hl := endptr ; -c specifies minimum field to use. ; a,f,b,c,d,e showcd: push b ! push d call chkop pop d ! pop b ; " " ; display code at de^ thru hl-1^, min field -c bytes ; at least one trailing blank ; a,f,b,c dspcd: push d xchg dspcd1: mov a,m call t2hx inx h ! inr c ! inr c mov a,l ! cmp e jnz dspcd1 dspcd2: call blank inr c ! jm dspcd2 xchg pop d ret ; ; crlf, show address de. ; a,f,h,l craddr: call crlf ; " " ; show address de. ; a,f typepc: xchg call t4hx xchg jmp dblblk ; ; output 4 chars from hl^ up ; a,f,h,l t4char: mvi a,4 ; " " ; output a chars from hl^ up ; a,f,h,l tchars: push b mov b,a tchrs1: mov a,m call couta inx h ! dcr b jnz tchrs1 pop b ret ; comma: mvi a,',' jmp couta ; ; search opcode table hl^ for a, max b entries. ; Z flag if found, when hl point to mnemnonic entry ; f,b,h,l stbl: cmp m ! inx h rz inx h ! inx h ! inx h ! inx h dcr b ! jnz stbl dcr b; remove z flag, not found ret ; ; show index register id ; a,f txrgid: mov a,c jmp couta ; ; prefixed z80 ops prefix: if z80 call qz80; (not d9 if z80 running) jz bad lhld disasmp; check for length 1 dcx h call delesshl; if so jz bad; invalid z80 opcode ldax d cpi 0cbh ! jz bitpic cpi 0edh ! jz xtend ; " " ; index register operations, prefix 0ddh/0fdh ani 020h rlc ! rlc ! rlc adi 'X' mov c,a; save index identifier inx d; point to specifier lda zopkind dcr a; type 0 never valid lxi h,ixcase jmp casexfr ; ; ** CAUTION ** locked to main table in DDTZ. Notes from main ixcase: dw dadx; 1 (No 0th value used) 9 19 29 39 dw slixd; 2 lhld shld 22 2a dw dsasm7; 3 inxdcxx 23 2b dw dsasm4; 4 inrdcrx 34 35 dw mvix; 5 mvi m 36 dw movrx; 6 mov rr,m 46 43 56 53 66 63 (76) 7e dw movxr; 7 mov m,e 73 dw movxr; 8 mov h,h, mov m,h 64 74 (64180) dw movxr; 9 mov m,r 70 71 72 (73 74) 75 (76) 77 dw arithx; 10 arith m 86 83 96 9e a6 ae b6 be dw lxiops; 11 lxi h 21 dw bitx; 12 set/res etc cb dw xtix; 13 xthl e3 dw dsasm5; 14 popushx e1 e5 dw xtix; 15 pchl e9 dw xtix; 16 sphl f9 dw bad; 17 extension ed dw undoc; 18 mov rr,e 43 4b 53 5b 63 6b 73 7b dw undoc; 19 mov (retn,reti) 45 4d dw bad; 20 x/y prefixes dd fd dw bad; 21 exaf,nop 0 8 dw bad; 22 jr/djnz (0 8) 10 18 20 28 30 38 dw bad; 23 jmp 0c3 dw bad; 24 call 0cd dw bad; 25 lda sta 32 3a dw bad; 26 ret 0c9 dw bad; 27 rst c7 cf d7 df e7 ef f7 ff dw mvixy; 28 mvi 6 e 16 1e 26 2e (36) 3e dw bad; 29 aritopi c6 ce d6 de e6 ee f6 fe dw bad; 30 j(ccd) c2 ca d2 da e2 ea f2 fa dw bad; 31 c(ccd) c4 cc d4 dc e4 ec f4 fc dw bad; 32 r(ccd) c0 c8 d0 d8 e0 e8 f0 f8 dw bad; 33 lxi 1 11 (21) 31 dw bad; 34 in/out d3 db dw undoc; 35 the rest, all 1 byte ; ; undocumented, except the MVI xh/xl/yh/yl,value opcodes. C is 'X' or 'Y' undoc: call movx ! rnc jmp bad ; aritx: sui 80h ! cmc ! rc; Not original 80..bf ldax d ! ani 7 call hlm ! rc; reject m stc ! rnz; reject other than h/l lxi h,xtraops+1 mov a,c ! cpi 'X' jz aritx1 lxi h,ytraops+1 aritx1: call mnmix jmp bregop ; xinrdcr: lxi h,xidrops+1 mov a,c ! cpi 'X' jz xidr1 lxi h,yidrops+1 xidr1: ldax d ! ani 1 ! mov b,a add a ! add a ! add b; *5 call index jmp inps1; mnem, leftreg output ; ; One register must be h or l, and none may be m movx: ldax d ! ani 0f6h cpi 024h ! jz xinrdcr ldax d ! ani 0c0h sui 040h ! rc jnz aritx ldax d ! call toreg call hlm ! rc; reject m jz movx2; have hl, other must be non h/l ldax d ! ani 7 call hlm ! rc; reject m stc ! rnz; no h/l found jmp movx3 movx2: ldax d ! ani 7 call hlm ! rc; reject m stc ! rz; both h/l found ; " " ; Regs ok, now act like a mov, with appropriate mnemnonic movx3: lxi h,movxops+1 mov a,c ! cpi 'X' jz movx4 lxi h,movxops+6 movx4: jmp movops ; ; check a for h,l,or m. Carry for m, zero for h or l ; a,f hlm: cpi 6 ! stc ! rz; m cpi 4 ! rz; h cpi 5 ! stc ! cmc; z flag for l ret ; ; Undocumented mvi xh/xl/yh/yl,value opcodes (MVIX h/l) mvixy: ldax d; c has 'X' or 'Y', de points to 2nd op byte ani 0f7h cpi 026h ! jnz bad lxi h,mvixops+1 mov a,c ! cpi 'X' jz mvixy1 lxi h,mvixops+6; else MVIY mvixy1: jmp rgiops ; mvix: lxi h,mmvi+1 call t4chb call ixdisp jmp imopnd ; bitx: inx d; past the 0cbh inx d; past the displacement ldax d dcx d ani 7 cpi 6 ! jz bitpic dcx d ! dcx d jmp bad ; slixd: ldax d ani 8 lxi h,msixd+1 jz slixd1 lxi h,mlixd+1 slixd1: mvi a,2 call tchars mov a,c call couta mvi a,'D' call couta call blank jmp wdopnd ; xtix: ldax d lxi h,mxtix mvi b,nxtixs call stbl ; " " mnx: mvi a,3 call tchars jmp txrgid ; movrx: lxi h,mmov+1 call t4chb call lftrid call comma jmp ixdisp ; movxr: lxi h,mmov+1 call t4chb call ixdisp dcx d jmp source ; ; arithmetic indexed immediate ops arithx: call aritmn call t4chb ; " " ; show indexed operand ; a,f,d,e ixdisp: mvi a,'[' call couta call txrgid inx d ! ldax d ora a ! jp ixdp1 mvi a,'-' call couta ldax d ! cma ! inr a jmp ixdp2 ixdp1: mvi a,'+' call couta ldax d ixdp2: call t2hx mvi a,']' jmp couta ; dadx: lxi h,mdad+1 call mnx call blank jmp wdrgid ; ; Prefix 0cbh, bitpicking bitpic: inx d ldax d cpi 040h ! jc sftops ani 0c0h lxi h,mbp mvi b,nbps call stbl; must work mov a,c call num call comma jmp sftop2 ; ; shift operations sftops: ldax d ! ani 038h lxi h,msft mvi b,nsfts call stbl; must work ; " " ; operations on single register. hl points to mnemonic sftop1: call t4chb ; " " ; show from reg id sftop2: mov a,c cpi 'H' ! jz fromrg dcx d ! dcx d jmp ixdisp ; ; extension ops prefix 0edh xtend: inx d ! ldax d lxi h,mtstip+1 cpi 064h ! jz immops lxi h,mtsiop+1 cpi 074h ! jz immops ani 0c7h ! jz in0s; 00, 08, 10, 18, 20, 28, 30, 38 dcr a ! jz out0s; 01, 09, 11, 19, 21, 29, 31, 39 lxi h,mtstp+1; TST sui 3 ! jz inps1; 04, 0c, 14, 1c, 24, 2c, 34, 3c sui 03ch ! jz inps; 040 dcr a ! jz outps; 041 dcr a ! jz dadc; 042 dcr a ! jz xxlds; 043 ldax d ! ani 0cfh lxi h,mmlt+1 sui 04ch ! jz wdrgs2; 04c,05c,06c,07c ldax d lxi h,mxtop mvi b,nxtops call stbl jz t4chb dcx d endif ; " " ; Unidentifiable op codes bad: lxi h,badop+1 mvi a,3 call tchars lhld disasmp; the next opcode marks end mvi c,0; use minimum field jmp dspcd; display de..hl-1 ; if z80 inps: lxi h,minp+1 inps1: call t4chb jmp lftrid ; outps: lxi h,moutp+1 jmp inps1 ; in0s: lxi h,min0p+1 jmp rgiops ; out0s: lxi h,mout0p+1 call t4chb inx d ! ldax d ! dcx d call t2hx call comma jmp lftrid ; ; word add/subtract/mlt with carry dadc: ldax d ! ani 08 lxi h,mdadc+1 jnz wdrgs2 lxi h,mdsbc+1 jmp wdrgs2 ; xxlds: ldax d lxi h,mlsxd mvi b,nlsxds call stbl; must work jmp wdops endif ; subttl 'Symbol Tables' ; ; The order of sections is wired into the assembler code opcd1: db 000h,'NOP ', 007h,'RLC ', 00fh,'RRC ', 017h,'RAL ' db 01fh,'RAR ', 027h,'DAA ', 02fh,'CMA ', 037h,'STC ' db 03fh,'CMC ', 076h,'HLT ', 0c9h,'RET ', 0e3h,'XTHL' db 0e9h,'PCHL', 0ebh,'XCHG', 0f3h,'DI ', 0f9h,'SPHL' db 0fbh,'EI ' ; mcrtn: db 0c0h,'RNZ ', 0c8h,'RZ ', 0d0h,'RNC ', 0d8h,'RC ' db 0e0h,'RPO ', 0e8h,'RPE ', 0f0h,'RP ', 0f8h,'RM ' ncrtns equ ($-mcrtn)/5 ni1 equ ($-opcd1)/5 ; opcd2: db 0c6h,'ADI ', 0ceh,'ACI ', 0d3h,'OUT ', 0d6h,'SUI ' db 0dbh,'IN ', 0deh,'SBI ', 0e6h,'ANI ', 0eeh,'XRI ' db 0f6h,'ORI ', 0feh,'CPI ' ni2 equ ($-opcd2)/5 ; opcd3: db 022h,'SHLD', 02ah,'LHLD', 032h,'STA ', 03ah,'LDA ' db 0c3h,'JMP ', 0cdh,'CALL' ni3 equ ($-opcd3)/5 ; if z80 opcd4: db 008h,'EXAF', 0d9h,'EXX ' ni4 equ ($-opcd4)/5 endif ; madd: db 080h,'ADD ', 088h,'ADC ', 090h,'SUB ', 098h,'SBB ' db 0a0h,'ANA ', 0a8h,'XRA ', 0b0h,'ORA ', 0b8h,'CMP ' nadds equ ($-madd)/5 ; minr: db 004h,'INR ' mdcr: db 005h,'DCR ' nrops equ ($-minr)/5 ; mmvi: db 006h,'MVI ' mmov: db 040h,'MOV ' mrst: db 0c7h,'RST ' ; if z80 mdjnz: db 010h,'DJNZ', 018h,'JR ', 020h,'JRNZ', 028h,'JRZ ' db 030h,'JRNC', 038h,'JRC ' njrs equ ($-mdjnz)/5 endif ; mlxi: db 001h,'LXI ' ; mstax: db 002h,'STAX', 00ah,'LDAX' mdad: db 009h,'DAD ' nwdrxx equ ($-mstax)/5 db 003h,'INX ', 00bh,'DCX ', 0c1h,'POP ', 0c5h,'PUSH' nwdr equ ($-mstax)/5 nwdrxy equ nwdr-nwdrxx ; if z80 ; additional to allow input parsing. not used in disassembly mdadxy: db 009h,'DADY', 009h,'DADX' ndadxys equ ($-mdadxy)/5 ; ; used in disassembly msft: db 000h,'RLCR', 008h,'RRCR', 010h,'RALR', 018h,'RARR' db 020h,'SLAR', 028h,'SRAR', 030h,'SLLR', 038h,'SRLR' nsfts equ ($-msft)/5 ; mbp: db 040h,'BIT ', 080h,'RES ', 0c0h,'SET ' nbps: equ ($-mbp)/5 ; ; additional to allow input parsing, not used in disassembly mxtiy: db 0e3h,'XTIY', 0e9h,'PCIY', 0f9h,'SPIY' nxtiys: equ ($-mxtiy)/5 ; ; used in disassembly mxtix: db 0e3h,'XTIX', 0e9h,'PCIX', 0f9h,'SPIX' nxtixs equ ($-mxtix)/5 ; ; additional to allow input parsing, not used in disassembly msiyd: db 022h,'SIYD', 02ah,'LIYD' nslyds equ ($-msiyd)/5 ; ; used in disassembly msixd: db 022h,'SIXD' mlixd: db 02ah,'LIXD' nslxds equ ($-msixd)/5 ; mlsxd: db 043h,'SBCD', 04bh,'LBCD', 053h,'SDED', 05bh,'LDED' db 063h,'shld', 06bh,'lhld', 073h,'SSPD', 07bh,'LSPD' nlsxds equ ($-mlsxd)/5 ; mdsbc: db 042h,'DSBC' mdadc: db 04ah,'DADC' mmlt: db 04ch,'MLT ' ndadcs equ ($-mdsbc)/5 ; min0p: db 000h,'IN0 ' mout0p: db 001h,'OUT0' mtstp: db 004h,'TST ' minp: db 040h,'INP ' moutp: db 041h,'OUTP' mtstip: db 064h,'TSTI' mtsiop: db 074h,'TSIO' niops equ ($-min0p)/5 ; mxtop: db 044h,'NEG ', 045h,'RETN', 046h,'IM0 ', 047h,'LDIA' db 04dh,'RETI', 04fh,'LDRA', 056h,'IM1 ', 057h,'LDAI' db 05eh,'IM2 ', 05fh,'LDAR', 067h,'RRD ', 06fh,'RLD ' db 076h,'SLP ' db 083h,'OTIM', 08bh,'OTDM', 093h,'OIMR', 09bh,'ODMR' db 0a0h,'LDI ', 0a1h,'CCI ', 0a2h,'INI ', 0a3h,'OTI ' db 0a8h,'LDD ', 0a9h,'CCD ', 0aah,'IND ', 0abh,'OTD ' db 0b0h,'LDIR', 0b1h,'CCIR', 0b2h,'INIR', 0b3h,'OTIR' db 0b8h,'LDDR', 0b9h,'CCDR', 0bah,'INDR', 0bbh,'OTDR' nxtops equ ($-mxtop)/5 mvixops: db 026h,'MVIX', 026h,'MVIY'; undocumented codes movxops: db 040h,'MOVX', 040h,'MOVY' xtraops: db 080h,'ADXR', 088h,'ACXR', 090h,'SUXR', 098h,'SBXR' db 0a0h,'NDXR', 0a8h,'XRXR', 0b0h,'ORXR', 0b8h,'CPXR' ytraops: db 080h,'ADYR', 088h,'ACYR', 090h,'SUYR', 098h,'SBYR' db 0a0h,'NDYR', 0a8h,'XRYR', 0b0h,'ORYR', 0b8h,'CPYR' xidrops: db 024h,'INRX', 025h,'DCRX' yidrops: db 024h,'INRY', 025h,'DCRY' nxyxops equ ($-mvixops)/5 endif badop: db 0ffh,'??= ' ; mreg: db 'BCDEHLMA' if z80 db '[XY' endif nregs equ $-mreg ; mpsw: db 031h,'PSW '; added 1 bit in value msp db 030h,'SP ', 020h,'H '; <<dyn. altered db 010h,'D ', 000h,'B ' if z80 db 020h,'X ', 020h,'Y ' endif db 0ffh; table end marker ixrid equ msp+6 ; subttl 'Assembler' ; ; assemble line, 1st char in a. Write results to buffer ; Carry for error. Code must agree with table order. asmln: if z80 lxi h,ixrid; preserve a, is 1st char. mvi m,'H'; reset XY id endif call getmnc lxi h,opcd1 call search; returns hl^=opcode, a=index jc asmln2; not found, check jmp/call ccode mov b,m; master opcode sui ni1+1 ! jc wrtcdb; 1 byte no argument (nop, xthl) sui ni2 ! jc bytimm; immediate 1 byte arg (adi 5) sui ni3 ! jc wdimm; immediate word arg (lhld 5) if z80 sui ni4 ! jc chkz80; 1 byte no arg, Z80 only (exaf) endif sui nadds ! jc sfromr; 1 byte, 1 reg argument (add a) sui nrops ! jc inrdcrg;inr/dcr jz mviop; mvi dcr a ! jz movop; mov dcr a ! jz rstn; rst if z80 sui njrs+1 ! jc jrop else dcr a endif jz lxiop; lxi if not z80 sui nwdr+1 ! jc dblrg; ldax/stax dad push/pop inx/dcx else; z80 sui nwdrxx+1 ! jc dblrg; ldax/stax dad sui nwdrxy ! jc dblxrg; push/pop inx/dcx sui ndadxys ! jc xydad sui nsfts ! jc sfts; ralr etc sui nbps ! jc bps; bit/set/res sui nxtiys ! jc yop sui nxtixs ! jc xop sui nslyds ! jc yopwd sui nslxds ! jc xopwd sui nlsxds ! jc lsxds; lbcd etc sui ndadcs ! jc dadcs; dadc/dsbc sui niops ! jc iops; inp/outp sui nxtops ! jc xtops; all extended z80 ops sui nxyxops ! rc; All undocumented ops endif asmln2: lxi h,buff ! mov a,m cpi 'J' mvi b,0c2h jz cjmps; jnz etc cpi 'C' ! stc ! rnz; not jmp/call. Error mvi b,0c4h; cnz etc cjmps: mvi m,'R' lxi h,opcd1; modify mnemonic and re-search call search ! rc mov a,m ! ora b ! mov b,a jmp wdimm; jcc/ccc ; ; fill buffer with next input, blank padded. ; a,f,b,h,l getmn: call nextch ; " " ; Entry with first character in (a) ; a,f,b,h,l getmnc: cpi ' ' jz getmn; skip initial blanks lxi h,buff mvi b,4 getmn1: call qdelim jz getmn2; short, blank fill (or empty line) mov m,a ! inx h dcr b cnz nextch jnz getmn1; else end or input line end call nextch; jams at cr call qdelim stc rnz; error, no delimiter getmn2: ora a inr b; (a) is delimiting char. getmn3: dcr b rz; buffer full mvi m,' ' ! inx h jmp getmn3 ; ; get word register identifier ; a,f,h,l getwrg: push b call getmn pop b rc lxi h,mpsw ; " " ; search for buff^ in hl^. Slow simple minded serial search. ; Return hl pointing to entry if found, with a=index of ; entry (1 based). Return a=0 and carry if not found. ; a,f,h,l search: push d ! push b lxi b,0100h; b := 1; c := 0 dcx h srch1: inx h ! dcr b jnz srch1; advance pointer to next item lxi d,buff inr c; count table entries searched mvi b,4; size of mnemnonic entry mov a,m; 0ffh opcode marks table end inr a stc jz srch4; end of table, exit w/carry srch3: ldax d ! inx d ! inx h cmp m ! jnz srch1; not this one dcr b ! jnz srch3; not complete mnemnonic yet dcx h ! dcx h dcx h ! dcx h; back up to opcode mov a,c; get mnem id srch4: pop b ! pop d ret ; if z80 ; extended z80 op xtops: mvi a,0edh call wrtcd ; " " ; write code byte hl^ if on Z80 only, else carry for error ; a,f chkz80: call qz80 ! stc rz endif ; " " ; write code byte b into buffer. Clear carry ; a,f wrtcdb: mov a,b ; " " ; write code byte (a) into buffer. Clear carry ; f wrtcd: push h ! push b lxi h,buff+5 inr m mov c,m; 1 up mvi b,0 dad b; must clear carry mov m,a pop b ! pop h ret ; ; Save one lines stored code and advance disasmp ; Make one line of input indivisible. ; b,d,e,h,l savecd: push psw lhld disasmp lxi d,buff+4 if z80 ldax d ora a ! jz savcd1; no index prefix to put mov m,a ! inx h endif savcd1: inx d ! ldax d ! mov b,a; count inx d ! dcr b jm savcd3; was zero savcd2: ldax d ! inx d; code mov m,a ! inx h dcr b ! jp savcd2; more to move shld disasmp; point to unfilled byte savcd3: pop psw ret ; ; return a byte register id identifier in A ; a,f,h,l getbrg: call skipblks push b lxi h,mreg lxi b,nregs; b=0; c=nregs gbr1: cmp m ! jz gbr3; found inr b ! inx h dcr c ! jnz gbr1 stc; not found gbr3: mov a,b pop b ret ; ; get word size argument to hl ; a,f,d,e,h,l getwd: call rdhex xchg call qdelim rz stc ret ; ; get byte size argument to hl ; a,f,d,e,h,l getbyt: call getwd ! rc inr h ! dcr h ! rz; in range stc ret ; if z80 jrop: call chkz80 ! rc call getwd ! rc xchg lhld disasmp inx h ! inx h mov a,e ! sub l ! mov l,a mov a,d ! sbb h ! mov h,a lxi d,080h ! dad d; negative carries mov a,h ! ora a ! stc rnz; overrange mov a,l ! xri 080h ! mov b,a jmp putbyt endif ; lxiop: call getwrg ! rc if z80 cpi 6 ! jc lxiop1; Not lxi x or lxi y sui 6 rrc ! rrc ! rrc adi 0ddh; form indexing prefix sta buff+4; and set x/y prefix mvi b,021h; opcode jmp wdimm lxiop1: endif mov a,m ! cpi 031h ! stc rz; no psw ora b ! mov b,a ; " " ; put opcode b and word immediate argument wdimm: call wrtcdb ; " " ; put word immediate argument putwd: call getwd ! rc mov a,l ! call wrtcd mov b,h ! jmp putbyt ; ; opcode, regid ',' immediate opnd mviop: call getbrg ! rc if z80 cpi 8 jc mviop1 call ixitlf ! rc jmp mviop2 endif mviop1: add a ! add a ! add a ora b ! mov b,a mviop2: call skipblks cpi ',' ! stc rnz ; " " ; put opcode b and byte immediate argument bytimm: call wrtcdb call getbyt ! rc mov b,l ! jmp putbyt ; if z80 out0ps: call getbyt ! rc; port to l cpi ',' ! stc ! rnz; not comma terminator push h call getbrg; register pop h rc; bad cpi 8 ! cmc ! rc; bad, xy not allowed add a ! add a ! add a ora b ! call wrtcd; opcode with reg mov b,l jmp putbyt; port iops: mvi a,0edh call wrtcd mov a,b ora a ! jz mviop; in0 reg,port dcr a ! jz out0ps; out0 port,reg ani 0efh ! cpi 063h; orig 64h or 74h jz bytimm; tsio port or tsti value endif ; " " inrdcrg: call getbrg ! rc if not z80 jmp leftrg else cpi 8 jc leftrg call ixitlf jmp putbyt ; ixitlf: call ixit ! rc; index left operand add a ! add a ! add a ora b call wrtcd mov b,c ret endif ; ; opcode with to/from regs embedded movop: call getbrg ! rc if z80 cpi 8 jc movop1; not "[" call ixitlf ! rc jmp movop2 endif movop1: add a ! add a ! add a ora b ! mov b,a movop2: call skipblks cpi ',' ! stc ! rnz ; " " ; set source register in b and write sfromr: call getbrg ! rc; get register id 0..7 if not z80 jmp orbout else cpi 8 jc orbout; not '[' call ixit ! rc ora b ! call wrtcd; opcode mov b,c jmp putbyt; and displacement endif ; rstn: call getbyt ! rc mov a,l ! cpi 8 ! cmc rc ; " " leftrg: add a ! add a ! add a ; " " ; insert field a in b (or vice versa) and output. Check for eol orbout: ora b ! mov b,a ; " " ; Check for eol, and write byte b putbyt: call skipblks stc rnz; need eol jmp wrtcdb ; if z80 ; convert into index/displacement. Just parsed '[' or X or Y ; Carry set on entry, 8 <= a <= nregs ; Returns c=displacement, a=reg id code (=6), sets ix prefix ; NO code is output. ; a,f,b,d,e,h,l ixit: stc ! rnz; eliminate X and Y call qz80 stc ! rz; indexing on z80 only lda buff+4 ora a ! stc ! rnz; left op already indexed call getbrg ! rc cpi 9 ! rc; not x/y mvi a,0ddh jz ixit1; X mvi a,0fdh; Y ixit1: sta buff+4; identify index used (prefix) call skipblks cpi '+' ! jz ixit3; with carry clear cpi '-' ! stc ! rnz; if not +/- call getbyt ! rc push psw mov a,l ! cma ! inr a ! mov l,a pop psw jmp ixit4 ixit3: cnc getbyt ! rc ixit4: sui ']' ! stc ! rnz; if no closing ']' found mov c,l; the displacement ori 6; convert to M register address ret ; dadcs: mvi a,0edh call wrtcd endif ; " " dblrg: call getwrg ! rc if z80 cpi 6 ! cmc ! rc; eliminate x/y endif dbl1: ora b mvi a,030h jm dbl2; pop/push mvi a,031h dbl2: cmp m ! stc ! rz; select one of sp/psw mov a,m ! jmp orbout ; if z80 dblxrg: call getwrg ! rc cpi 6 ! jc dbl1; not x or y argument sui 6; before must keep a +ve rrc ! rrc ! rrc; bit to 020h posn adi 0ddh sta buff+4; set x/y prefix xra a jmp dbl1; rest as before ; lsxds: mvi a,0edh call wrtcd jmp wdimm ; sfts: mvi a,0cbh call wrtcd sfts1: call qz80 stc ! rz call getbrg ! rc; get register id 0..7 cpi 8 jc orbout call ixit ! rc ora b ! mov b,a mov a,c call wrtcd; displacement jmp putbyt; opcode and check eol ; bps: mvi a,0cbh call wrtcd call skipblks cpi '0' ! rc cpi '9'+1 ! cmc ! rc ani 07h ral ! ral ! ral ora b ! mov b,a call nextch call qdelim stc rnz jmp sfts1 ; xydad: inr a mvi a,0fdh jnz xydad1 mvi a,0ddh xydad1: sta buff+4 lda buff+3; xy reg id sta ixrid; alter index reg id jmp dblrg ; yop: mvi a,0fdh jmp xop1 xop: mvi a,0ddh xop1: sta buff+4 jmp wrtcdb ; yopwd: mvi a,0fdh jmp xopwd1 xopwd: mvi a,0ddh xopwd1: sta buff+4 jmp wdimm endif ; subttl File writing ; ask: lxi h,tfcb+1 mvi a,8 call tchars mvi a,'.' call couta mvi a,3 call tchars lxi d,m2 call tstr call getline call skipblks sui 'Y' ret ; keep: lxi h,0100h shld storeptr lhld unloaded dcx h jz keep1 cpi 2 jnz err call nextparm shld storeptr call nextparm keep1: inx h shld dendptr call rsdma call crlf lda tfcb+1 cpi ' ' lxi d,m1 jz tstr mvi a,17 call foperate inr a cnz ask rnz sta tfcb+32 sta tfcb+12 mvi a,19; purge call foperate mvi a,22; make call foperate; make/write inr a jz err keep3: lhld storeptr xchg lhld dendptr call delesshl jnc done lxi h,0080h dad d shld storeptr mvi a,26 call dos; set dma mvi a,21; write call foperate ora a jz keep3 call rsdma jmp err ; done: call rsdma mvi a,16; fclose jmp foperate; and exit to system ; rsdma: lxi d,defdma mvi a,26 jmp dos ; m1: db 'File?$' m2: db ' exists, purge (y/n)?$' ; if ($-begin) AND 0ffh; align it .align equ ($-begin) AND 0ffh ds 256-.align,0 endif ; ; transfer around segment on startup ddtbgn: ds 0 end W║