X-Git-Url: http://cloudbase.mooo.com/gitweb/ddt180.git/blobdiff_plain/ac35765efd1937a9ddb97405b06ce6d9052171ee..fb2242116670a4c60e8ace16df4bfb8c9ffc5a27:/ddt180.z80 diff --git a/ddt180.z80 b/ddt180.z80 index 0d78e82..fd16076 100644 --- a/ddt180.z80 +++ b/ddt180.z80 @@ -6,174 +6,508 @@ ; - Use Digital Research Link-80 to generate a .PRL file (op switch). ; - Cut the .PRL header (first 256 byte) end rename the result to DDTZ.COM. -;------------------------------------------------------------------------------- -; Relocation loader -; - -TPA equ 0100h - cseg - .phase TPA - jp start - -ldr_end: -ldr_size equ $ - TPA -current_phase defl $ - - .dephase -current_cseg defl $ - -;------------------------------------------------------------------------------- -; DDT/Z core -; + maclib config.inc ; Some greneral definitions -TAB equ 9 -LF equ 10 -CR equ 13 +BS equ 08h +TAB equ 09h +CR equ 0dh +LF equ 0ah +DEL equ 7fh +CNTRX equ 'X'-'@' ; CP/M memory layout BDOS equ 5 -dfcb1 equ 05ch -dfcb2 equ 06ch -DMA_BUF equ 080h TPA equ 0100h -; BDOS function calls - -BDOS_CIN equ 1 ;Console Input -BDOS_COUT equ 2 ;Console Output -BDOS_PSTR equ 9 ;Print String -BDOS_CBUF equ 10 ;Read Console Buffer -BDOS_CSTAT equ 11 ;Get Console Status -BDOS_OPEN equ 15 ;Open File -BDOS_CLOSE equ 16 ;Close File -BDOS_DELETE equ 19 ;Delete File -BDOS_READ equ 20 ;Read Sequential -BDOS_WRITE equ 21 ;Write Sequential -BDOS_CREATE equ 22 ;Make File -BDOS_SETDMA equ 26 ;Set DMA Address - ; ddtz specific definitions -STACK_SIZE equ 64 ;ddtz internal stack +STACK_SIZE equ 80 ;ddtz internal stack CONBUF_SIZE equ 80 ;Size of console input buffer -EXPR_BUF_SIZE equ 128 ;expressen buffer for conditional breakpoints BP_CNT equ 12 ;Number of breakpoints -BP_SIZE equ 8 ;Size of a breakpoint record -YREG_CNT equ 10 ;Number of Y registers (0..9) +BP_SIZE equ 4 ;Size of a breakpoint record + +bitmap_size equ (prog_size+7)/8 ;------------------------------------------------------------------------------- + cseg +start: ddtz_base: - jp ddtz_bdos + jr reloc + nop l0003h: - rst 30h -sub_0004h: + rst 30h ;rst used by ddtz +di_or_ei: ;ints enabled/disabled while ddtz is running nop ret -ddtz_bdos: - jp 0 -current_cseg defl $ - current_cseg - .phase current_phase + current_cseg +;------------------------------------------------------------------------------- + signon: - db 'DDT/180',TAB - db '[8101] 003',CR,LF,'$' -msgz80: - db 'Z80 or better required!',cr,lf,'$' + db 'DDTZ/180' + db ' - Version ' + maclib version.inc + defvers + dc ' (' -current_phase defl $ - .dephase -current_cseg defl $ - ds STACK_SIZE - (current_phase - signon) +;------------------------------------------------------------------------------- +reloc_getbit macro + local nextbit + exx + djnz nextbit + ld b,8 ;reload bit counter + ld e,(hl) ;get next 8 relocation bits + inc hl +nextbit: + sla e + exx + endm -stack: -reg.l2: db 000h -reg.h2: db 000h -reg.e2: db 000h -reg.d2: db 000h -reg.c2: db 000h -reg.b2: db 000h -reg.f2: db 000h -reg.a2: db 000h -l004eh: db 000h -reg.i: db 000h -reg.iy: dw 0000h -reg.ix: dw 0000h -reg.f: db 000h -reg.a: db 000h -reg.c: db 000h -reg.b: db 000h -reg.e: db 000h -reg.d: db 000h -reg.l: db 000h -reg.h: db 000h -reg_sp: dw TPA -reg.iff: - db 0f3h - db 0c3h -reg.pc: dw TPA -var.$: dw 0000h -var.@: dw 0 +;------------------------------------------------------------------------------- +; Clear old position -error_func:dw l0146h -cmd_rpt:dw mainloop +cmde_clr: + ld (hl),0 + inc hl + dec bc + ld a,b + or c + jr nz,cmde_clr -conbuf: - db CONBUF_SIZE +; Determine current position - ld sp,stack +reloc: + ld bc,(028h-2) + ld de,(028h) + ld a,i ;get iff2 + ex af,af' + di + ld sp,028h ;rst instr needs a minimal stack + ld hl,0e9e1h ;opcpdes pop hl/jp (hl) + ld (028h),hl + rst 028h +wearehere: + ld (028h-2),bc + ld (028h),de + ld de,-(wearehere-ddtz_base) + add hl,de ; hl: + + ld de,ddtz_base ; de: + or a + sbc hl,de + ex de,hl ; de: reloc offset + ld hl,stack + add hl,de + ld sp,hl + ex af,af' + push af + pop bc + bit 2,c + jr z,$+3 + ei + ld hl,ddtz_end ;start of reloc bitmap + add hl,de + push hl exx - ld de,ddtz_base - or a - sbc hl,de - add hl,de - jr c,l0079h - ex de,hl -l0079h: - ld de,TPA -l007ch: - dec hl - ld (hl),000h - ld a,h - sub d - ld b,a - ld a,l - sub e - or b - jr nz,l007ch - ld a,i - ld (reg.i),a - ld a,0f3h - jp po,l0093h - ld a,0fbh + pop hl + ld b,1 ;init bit counter b + exx + + LD HL,ddtz_base + add hl,de ;--> ddtz_base + +reloc_lp: + push de + push hl + + ld de,4 + ld a,2 + ld hl,0 +reloc_l: + reloc_getbit + jr nc,reloc_got + cp 16 + jr z,reloc_done + add hl,de + ld b,a + ex de,hl +reloc_l1: + add hl,hl + djnz reloc_l1 + ex de,hl + add a,a + jr reloc_l +reloc_got: + ex de,hl + ld hl,0 + ld b,a +reloc_bitloop: + reloc_getbit + adc hl,hl + djnz reloc_bitloop + add hl,de + pop de + add hl,de + pop de + + LD A,(HL) + ADD A,E + LD (HL),A + INC HL + LD A,(HL) + ADC A,D + LD (HL),A + inc hl + jr reloc_lp +reloc_done: + exx + ld (bitmap_end),hl +;------------------------------------------------------------------------------- + + +init: + LD SP,stack + + if CPM + + ld hl,(1) ;wboot addr + ld de,convec + ex de,hl + ld b,3 +vini_l: + inc de + inc de + inc de + inc hl + ld (hl),e + inc hl + ld (hl),d + inc hl + djnz vini_l + else + xor a + dec a + daa ; Z80: 099H, x180+: 0F9H + cp 99h ; Result on 180 type cpus is F9 here. Thanks Hitachi + jr z,ini_z80 + + xor a + call cinit + ld a,1 + call cinit + jr ini_sign +ini_z80: +; if ... +; .printx Error: Not yet implemented! +; db "Stop +; endif + endif ; CPM + +ini_sign: + ld hl,signon + call pstr + ld hl,ddtz_base + call out_hl + call pstr_inl + dc ' - ' + ld hl,(bitmap_end) + dec hl + call out_hl + call pstr_inl + dc ')',CR,LF + + ld a,i + ld (reg.i),a + ld a,0f3h + jp po,l0093h + ld a,0fbh l0093h: - ld (reg.iff),a - call sub_0004h - ld hl,ddtz_base - ld l,000h - ld (reg_sp),hl - call cpy_fcb2 - ld a,(dfcb1+1) - cp ' ' - ld hl,0 - call nz,read_file - jr mainloop + ld (reg.iff),a + call di_or_ei + ld hl,ddtz_base + ld l,000h + ld (reg_sp),hl + + jp mainloop + +;------------------------------------------------------------------------------- + + if CPM + +convec: +const: jp 0 ; return console input status +conin: jp 0 ; return console input character +conout: jp 0 ; send console output character + + else + + include z180reg.inc + +iobyte equ 3 + +max_device equ 3 + +;------------------------------------------------------------------------------- + +; init device +cinit: ; a = device + call vector_io_0 + dw as0init + dw rret + dw rret + dw rret + +; character input status +const: ; return a != 0 if character waiting + call vector_io + dw as0ista + dw null$status + dw csio_ista + dw null$status + +; character input +conin: ; return a = input char + call vector_io + dw as0inp + dw null$input + dw csio_inp + dw null$input + +; character output +conout: ; c = output char + call vector_io + dw as0out + dw rret + dw csio_out + dw rret + +;------------------------------------------------------------------------------- + +vector_io: + ld a,(iobyte) +vector_io_0: + pop hl + cp max_device + jr c,exist + ld a,max_device ; use null device if a >= max$device +exist: + call add_hl_a2 + ld a,(hl) + inc hl + ld h,(hl) + ld l,a + jp (hl) + +;------------------------------------------------------------------------------- + +null$input: + ld a,1Ah +rret: + ret +ret$true: + or 0FFh + ret + +null$status: + xor a + ret + +;------------------------------------------------------------------------------- +; +; TC = (f PHI /(2*baudrate*Clock_mode)) - 2 +; +; TC = (f PHI / (32 * baudrate)) - 2 +; +; Init Serial I/O for console input and output (ASCI1) +; + + - ds CONBUF_SIZE + 3 - ($ - conbuf) +as0init: + ld hl,initab0 + jp ioiniml + +as1init: + ld hl,initab1 + jp ioiniml + + + ld a,M_MPBT + out0 (cntlb1),a + ld a,M_RE + M_TE + M_MOD2 ;Rx/Tx enable + out0 (cntla1),a + ld a,M_RIE + out0 (stat1),a ;Enable rx interrupts + + ret ; + + +initab0: + db 1,stat0,0 ;Disable rx/tx interrupts + ;Enable baud rate generator + db 1,asext0,M_BRGMOD+M_DCD0DIS+M_CTS0DIS + db 2,astc0l,low 28, high 28 + db 1,cntlb0,M_MPBT ;No MP Mode, X16 + db 1,cntla0,M_RE+M_TE+M_MOD2 ;Rx/Tx enable, 8N1 + db 0 + +initab1: + db 1,stat1,0 ;Disable rx/tx ints, disable CTS1 + db 1,asext1,M_BRGMOD ;Enable baud rate generator + db 2,astc1l,low 3, high 3 + db 1,cntlb1,M_MPBT ;No MP Mode, X16 + db 1,cntla1,M_RE+M_TE+M_MOD2 ;Rx/Tx enable, 8N1 + db 0 + +;------------------------------------------------------------------------------- + +ioiniml: + push bc + xor a +ioml_lp: + ld b,(hl) + inc hl + cp b + jr z,ioml_e + + ld c,(hl) + inc hl + otimr + jr ioml_lp +ioml_e: + pop bc + ret + +;------------------------------------------------------------------------------- + +as0ista: + in0 a,(stat0) + rlca + sbc a,a + ret + +as1ista: + in0 a,(stat1) + rlca + sbc a,a + ret + +as0inp: + in0 a,(stat0) + rlca + jr nc,as0inp + in0 a,rdr0 + ret + +as1inp: + in0 a,(stat1) + rlca + jr nc,as1inp + in0 a,rdr1 + ret + +as0out: + in0 a,(stat0) + and M_TDRE + jr z,as0out + out0 (tdr0),c + ld a,c + ret + +as1out: + in0 a,(stat1) + and M_TDRE + jr z,as1out + out0 (tdr1),c + ld a,c + ret + +;------------------------------------------------------------------------------- + + +csio_rx_tmp: db 0ffh + +csio_ista: + ld hl,csio_rx_tmp + ld a,(hl) + cp 0ffh + jr nz,csist_1 + ld a,01 + call csio_wr + call csio_rd + call csio_rd + ld (hl),a + sub a,0ffh + ret z +csist_1: + or 0ffh + ret + +csio_inp: + ld hl,csio_rx_tmp + ld a,(hl) + ld (hl),0ffh + cp 0ffh + ret nz +csin_1: + ld a,01 + call csio_wr + call csio_rd + call csio_rd + cp 0ffh + jr z,csin_1 + ret + +csio_rd: + ld a,M_CSIO_RE + call csio_cmd_wait + in0 a,(trdr) + ret + +csio_out: + ld a,02 + call csio_wr + call csio_rd + call csio_rd + or a + jr z,csio_out + + ld a,c + inc a ;ff..02 --> 00..03 + cp 04h + jr nc,csout_1 + ld a,00h + call csio_wr +csout_1: + ld a,c +csio_wr: + out0 (trdr),a + ld a,M_CSIO_TE +csio_cmd_wait: + out0 (cntr),a +cswr_wait: + in0 a,(cntr) + and M_CSIO_TE+M_CSIO_RE + jr nz,cswr_wait + ret + + endif ; CPM + +;------------------------------------------------------------------------------- CMDTAB: - dw cmd_@ ;examine/substitute the displacement register @ - dw cmd_A ;Assemble +; dw ERROR ;cmd_@ ;examine/substitute the displacement register @ +; dw ERROR ;cmd_A ;Assemble dw cmd_B ;Breakpoints display/set/clear - dw cmd_C ;trace over Calls + dw ERROR ;cmd_C ;trace over Calls dw cmd_D ;Display memory in hex and ascii - dw ERROR ; - dw cmd_F ;specify Filename and command line + dw cmd_E ;rElocate debugger + dw ERROR ;cmd_F ;specify Filename and command line dw cmd_G ;Go dw cmd_H ;compute Hex and other expressions dw cmd_I ;Input a byte from port @@ -185,25 +519,27 @@ CMDTAB: dw cmd_O ;Output a byte to port dw ERROR ; dw cmd_Q ;Qery memory for byte string - dw cmd_R ;Read binary or hex file and/or symbol file + dw cmd_R ;Read binary or hex file dw cmd_S ;Substitute memory dw cmd_T ;Trace dw ERROR ; dw cmd_V ;Verify (compare) two memory areas - dw cmd_W ;Write a file to disk + dw ERROR ;cmd_W ;Write a file to disk dw cmd_X ;eXamine [and substitute] registers - dw cmd_Y ;examine [and substitute] Y variables + dw ERROR ;cmd_Y ;examine [and substitute] Y variables dw cmd_Z ;Zap (fill) memory with a byte string +ERROR: + call pstr_inl + dc '?',CR,LF + ;fall thru mainloop: ld sp,stack - ld hl,l0146h - ld (error_func),hl ld hl,(reg.pc) - ld (var.$),hl call bp_clr_temporary ld hl,(cmd_rpt) ld de,mainloop + push de call cp_hl_de ld a,'>' call outchar @@ -212,185 +548,79 @@ mainloop: call get_line call skipbl jr z,exe_hl - ld hl,mainloop + pop hl + push hl ld (cmd_rpt),hl inc de - sub '@' + sub 'B' jr c,ERROR cp 'Z'+1-'@' jr nc,ERROR - add a,a ld hl,CMDTAB - call add_hl_a + call add_hl_a2 ld a,(hl) inc hl ld h,(hl) ld l,a - jr exe_hl - -ERROR: - ld hl,(error_func) exe_hl: - call CALL_HL - jr mainloop +CALL_HL: + jp (hl) + +;------------------------------------------------------------------------------- -l0146h: - ld a,'?' - call outchar - ;fall thru crlf: - call inchar - ld a,CR - call outchar - ld a,LF - call outchar - ld a,0 + call pstr_inl + dc CR,LF + xor a ld (con_col),a + call inchar jr c,mainloop ret -get_line: +sub_01d9h: + call pstr_inl + dc '-' + jp neg.hl + +out_hl_dec_neg: push hl - ld de,conbuf - ld c,BDOS_CBUF - call ddtz_bdos - call crlf - ld de,conbuf+1 - ld a,(de) - ld b,a - ld c,0 - inc b -l0162h: - inc de + call sub_01d9h + defb 03eh ;ld a,.. swallow push hl +out.hl.dec: + push hl + ld b,006h + call sub_01f9h + pop hl + call pstr_inl + dc '.' +l01f3h: + call outbl + djnz l01f3h + ret + +sub_01f9h: dec b - jr z,l0194h - ld a,(de) - bit 0,c - call z,toupper - ld (de),a - cp '''' - jr nz,l0162h push de - dec de - ld a,(de) - cp '''' - jr z,l0190h - dec de - ld a,(de) - cp '^' - jr z,l0184h - dec de - ld a,(de) - cp '^' - jr nz,l0190h -l0184h: - inc de - push bc - call sub_0303h - pop bc - dec de - ld a,(de) - cp '''' - jr z,l0191h -l0190h: - inc c -l0191h: + ld de,10 + call div_hl_de + ld a,h + or l + call nz,sub_01f9h + ld a,e pop de - jr l0162h -l0194h: - xor a - ld (de),a - ld de,conbuf+2 + jr out_dgt + +out_hl_neg: + push hl + call sub_01d9h + call out_hl pop hl ret -toupper: - cp 'a' - ret c - cp 'z'+1 - ret nc - and 05fh - ret - -out.hl.@: - call out_hl - push de - push hl - ld de,(var.@) - ld a,d - or e - jr z,l01bfh - call outbl - ld a,'@' - call outchar - and a - sbc hl,de - call out_hl -l01bfh: - pop hl - pop de - ret -out.bin.w: - ld a,h - call out.bin.b - ld a,l -out.bin.b: - ld b,8 -l01c9h: - add a,a - push af - ld a,00 - adc a,a - call out_dgt - pop af - djnz l01c9h - ld a,'"' - jp outchar - -sub_01d9h: - ld a,'-' - call outchar - dec hl - jp cpl.hl - -out_hl_dec_neg: - push hl - call sub_01d9h - defb 03eh -out.hl.dec: - push hl - ld b,006h - call sub_01f9h - pop hl - ld a,'.' - call outchar -l01f3h: - call outbl - djnz l01f3h - ret -sub_01f9h: - dec b - push de - ld de,10 - call div_hl_de - ld a,h - or l - call nz,sub_01f9h - ld a,e - pop de - jr out_dgt - -out_hl_neg: - push hl - call sub_01d9h - call out_hl - pop hl - ret - -out_hl: - ld a,h - call out_hex - ld a,l +out_hl: + ld a,h + call out_hex + ld a,l out_hex: push af @@ -402,135 +632,226 @@ out_hex: pop af out_dgt: - and 0fh - cp 10 - jr c,l0229h - add a,007h -l0229h: - add a,'0' + or 0f0h + daa + add a,0a0h + adc a,040h jr outchar -l022dh: - ld a,'-' - call outchar - ld a,040h + +out.bin.w: + ld a,h + call out.bin.b + ld a,l +out.bin.b: + ld b,8 +l01c9h: + rlca + push af + and 1 + call out_dgt + pop af + djnz l01c9h + ld a,'"' + jr outchar + out.ascii: - ex af,af' - call outquote - ex af,af' - push af + push bc + ld c,a res 7,a cp ' ' + push af + call nc,outbl + call pstr_inl + dc '''' + pop af jr nc,l0242h sub 0c0h + ld b,a + call pstr_inl + dc '^' + ld a,b l0242h: call outchar - push af cp '''' call z,outchar - pop af - ex af,af' - call outquote - pop af - or a + call pstr_inl + dc '''' + sla c + pop bc + ret nc ld a,'.' - call m,outchar - ex af,af' - jr c,l022dh - ret - -p_char_lparen: - ld a,'(' jr outchar -outquote: - ld a,'''' +outbl6: + call outbl2 +outbl4: + call outbl2 +outbl2: + call outbl +outbl: + ld a,' ' outchar: + push ix + push iy push hl push de push bc push af and 07fh - ld e,a - ld c,BDOS_COUT - call ddtz_bdos + ld c,a + call conout ld hl,con_col inc (hl) pop af pop bc pop de pop hl + pop iy + pop ix + ret + +p_goto_col: + ld a,(con_col) + cp c + ret nc + ret z + call outbl + jr p_goto_col + +;------------------------------------------------------------------------------- + +incharw: + call inchar + jr nc,incharw ret +;------------------------------------------------------------------------------- + inchar: + push ix push hl push de push bc - ld c,BDOS_CSTAT - call ddtz_bdos + call const and a - jr z,l0284h - ld c,BDOS_CIN - call ddtz_bdos + jr z,inch1 + call conin scf -l0284h: +inch1: pop bc pop de pop hl + pop ix ret -pstr: - ld c,0 -l028ah: - ld a,(hl) - inc hl - and a - ret z - call outchar - inc c - and a - ret m - jr l028ah +;------------------------------------------------------------------------------- -pstr_inl: - ex (sp),hl - call pstr - ex (sp),hl +DELC: + ld a,b + or a + ret z + call DELC1 + dec hl + dec b + ld a,(hl) + cp ' ' + ret nc +DELC1: + call pstr_inl + dc BS,' ',BS ret -outbl6: - call outbl2 -outbl4: - call outbl2 -outbl2: - call outbl -outbl: - ld a,' ' - jr outchar +DELL: + ld a,b ; + or a ; + ret z ; + call DELC ; + jr DELL ; -add_hl_a: - add a,l - ld l,a - ret nc - inc h +;------------------------------------------------------------------------------- + +get_line: + push hl ; + ld hl,conbuf ; + ld b,0 ; +inlnxtch: + ld a,b ; + cp CONBUF_SIZE ; + jr z,inl_e ; + call incharw ; + cp CR ; + jr z,inl_e ;Accept line + cp LF ; + jr z,inl_e ;Accept line + + cp BS ; + jr z,gl_1 ; + cp DEL ; + jr nz,gl_2 ; +gl_1: + call DELC ;Delete Char + jr inlnxtch ; +gl_2: + cp CNTRX ; + jr nz,gl_3 ; + call DELL ;Delete Line + jr inlnxtch ; +gl_3: + cp TAB ; + jr nz,gl_4 ; + ld a,' ' ; +gl_4: + ld (hl),a ; + cp ' ' ; + jr nc,gl_5 ; + ld a,'^' ;Controll characters + call outchar ; + ld a,(hl) ; + add a,'@' ; +gl_5: + call outchar ; + inc hl ; + inc b ; + jr inlnxtch ; + +inl_e: + ld (hl),0 + call CRLF ; + ld de,conbuf ; + pop hl ; + ret ; + +;------------------------------------------------------------------------------- + +get_char_upper: + ld a,(de) +toupper: + cp 'a' + ret c + cp 'z'+1 + ccf + ret c + and 05fh ret +;------------------------------------------------------------------------------- + skipbl0: inc de skipbl: - ld a,(de) + call get_char_upper cp ' ' jr z,skipbl0 - cp TAB - jr z,skipbl0 or a ret +;------------------------------------------------------------------------------- + next_arg: call skipbl cp ',' ret nz - inc de - call skipbl + call skipbl0 cp a ret @@ -540,31 +861,46 @@ assert_eol: to_error: jp ERROR -chk_sp: +;------------------------------------------------------------------------------- + +chk_stack: push hl push de ld hl,0 add hl,sp - ld de,stack-40 + ld de,stack-(STACK_SIZE-28) call cp_hl_de pop de pop hl jr c,to_error ret +;------------------------------------------------------------------------------- + +add_hl_a2: + add a,a +add_hl_a: + add a,l + ld l,a + ret nc + inc h + ret + cp_hl_de: and a sbc hl,de add hl,de ret +;------------------------------------------------------------------------------- + lookupch: ld b,0 l02f5h: ld a,(hl) and a ret z - ld a,(de) + call get_char_upper cp (hl) jr z,l0300h inc hl @@ -576,12 +912,8 @@ l0300h: ret sub_0303h: - ld hl,b_0cc3_start + ld hl,t_reg_names ld b,07fh - jr l030ch - -sub_030ah: - ld b,0ffh l030ch: inc b ld a,(hl) @@ -592,15 +924,11 @@ l030ch: res 7,b ret -sub_0318h: - push bc - res 7,b - defb 03eh sub_031ch: push bc push de l031eh: - ld a,(de) + call get_char_upper xor (hl) and 07fh jr nz,l0336h @@ -617,22 +945,23 @@ l031eh: pop bc ret l0336h: - call sub_0345h + call str_sel_next l0339h: pop de and a pop bc ret -sel_dc_string: +str_sel: inc b -l033eh: - dec b - ret z - call sub_0345h - jr l033eh + jr str_sel2 +str_sel1: + call str_sel_next +str_sel2: + djnz str_sel1 + ret -sub_0345h: +str_sel_next: ld a,(hl) and a ret z @@ -643,12 +972,12 @@ l0348h: ret m jr l0348h -sub_034eh: +get_arg_range_target: call get_arg_range push hl push bc call next_arg - call sub_0363h + call get_arg_final ex de,hl pop bc pop hl @@ -659,7 +988,7 @@ sub_035dh: jr c,error0 ret -sub_0363h: +get_arg_final: call sub_035dh l0366h: jp assert_eol @@ -682,7 +1011,7 @@ sub_0377h: jr l0366h b_037c_start: - defb 0e6h + defb 0e6h ;and a,.. clear carry get_arg_range: scf ex af,af' @@ -694,7 +1023,7 @@ get_arg_range: jr c,error0 ex af,af' pop hl - defb 03eh + defb 03eh ;ld a,.. swallow pop af l038ch: pop af call get_range @@ -715,14 +1044,14 @@ get_range: inc de l03a2h: push hl - push af + push af ;'S' flag call expr jr c,l03b8h ld b,h ld c,l pop af pop hl - jr z,l03b6h + jr z,l03b6h ;'S'? ld a,c sub l ld c,a @@ -736,96 +1065,15 @@ l03b6h: l03b8h: pop af pop hl - jr z,error0 + jr z,error0 ;'S', but no expression following scf ret +;------------------------------------------------------------------------------- + expr: call skipbl expr1: - call do_subexpr - ret c - call do_rel_op - ret nc - push bc - push hl - call do_subexpr - jr c,error0 - ex de,hl - ex (sp),hl - and a - sbc hl,de - ld hl,0ffffh - pop de - ret - -do_op_eq: - jr z,l03edh - jr l03ech -do_op_ne: - jr nz,l03edh - jr l03ech -do_op_le: - jr z,l03edh -do_op_lt: - jr c,l03edh - jr l03ech -do_op_gt: - jr z,l03ech -do_op_ge: - jr nc,l03edh -l03ech: - inc hl -l03edh: - and a - ret -do_rel_op: - push hl - ld hl,tab_eq_le_ge - call lookupch - jr nc,l041dh - ld a,b - or a - jr z,l0411h - ld a,(de) - cp '=' - jr nz,l0406h - inc de - inc b - inc b - jr l0411h -l0406h: - bit 0,b - jr z,l0411h - cp '>' - jr nz,l0411h - inc de - ld b,005h -l0411h: - ld hl,tab_func_eqlege - ld a,b - add a,a - call add_hl_a - ld c,(hl) - inc hl - ld b,(hl) - scf -l041dh: - pop hl - ret - -tab_eq_le_ge: - db '=<>',0 - -tab_func_eqlege: - dw do_op_eq - dw do_op_lt - dw do_op_gt - dw do_op_le - dw do_op_ge - dw do_op_ne - -do_subexpr: call do_factor ret c l0433h: @@ -897,40 +1145,33 @@ doop_mod: ; de: r (x%y) div_hl_de: - push bc - ex de,hl - ld b,h - ld c,l - ld hl,0 - ld a,16 + push bc + ex de,hl ;de: x + ld b,h ;bc: y + ld c,l + ld hl,0 ;hl: r + ld a,16 ; de: x (x shifted out, q shifted in) ; bc: y ; hl: r (initially 0) -l047eh: - push af - add hl,hl - ex de,hl - xor a - add hl,hl - ex de,hl - adc a,l - sub c - ld l,a - ld a,h - sbc a,b - ld h,a - inc de - jr nc,l048fh - add hl,bc - dec de -l048fh: - pop af - dec a - jr nz,l047eh - ex de,hl - pop bc +div_lp: + ex de,hl + add hl,hl ;x <<= 1 + ex de,hl + adc hl,hl ;r <<= 1 + inc de + or a + sbc hl,bc + jr nc,div_norestore + dec de + add hl,bc +div_norestore: + dec a + jr nz,div_lp + ex de,hl + pop bc ret doop_and: @@ -966,8 +1207,7 @@ do_binary_op: call lookupch ld a,b ld hl,tblf_opa - add a,a - call add_hl_a + call add_hl_a2 ld c,(hl) inc hl ld b,(hl) @@ -988,17 +1228,19 @@ tblf_opa: dw doop_xor dw 0 +;------------------------------------------------------------------------------- + fact_factor: call do_factor ret nc jp ERROR do_factor: - call chk_sp + call chk_stack call get.number ret nc inc de - ld hl,(BDOS+1) + ld hl,ddtz_base-1 cp 'T' ret z ld hl,(high_load) @@ -1010,10 +1252,7 @@ do_factor: ld hl,TPA cp 'L' ret z - ld hl,(var.@) - cp '@' - ret z - ld hl,(var.$) + ld hl,(reg.pc) cp '$' ret z cp '-' @@ -1024,31 +1263,17 @@ do_factor: jr z,fact_factor cp '^' jr z,fact_reg.CPU - cp 'Y' - jr z,fact_reg.Y cp '(' jr z,fact_mem cp '[' - jp z,expr_brckt + jr z,expr_brckt cp '''' jr z,fact_factstring dec de scf ret -fact_reg.Y: - call get.decdigit - jp c,ERROR - inc de - add a,a - ld hl,reg_Y - call add_hl_a - ld a,(hl) - inc hl - ld h,(hl) - ld l,a - and a - ret +;------------------------------------------------------------------------------- fact_factstring: ld hl,0 @@ -1077,7 +1302,7 @@ l0557h: fact_reg.CPU: call sub_0caeh - jr nc,error4 + jr nc,error1 ld a,(hl) inc hl ld h,(hl) @@ -1088,8 +1313,13 @@ fact_reg.CPU: ld h,000h ret +fact_factinv: + call fact_factor + jr cpl.hl + fact_factneg: call fact_factor +neg.hl: dec hl cpl.hl: ld a,h @@ -1100,16 +1330,12 @@ cpl.hl: ld l,a ret -fact_factinv: - call fact_factor - jr cpl.hl - fact_mem: call expr1 - jr c,error4 + jr c,error1 ld a,(de) cp ')' - jr nz,error4 + jr nz,error1 inc de ld a,(hl) inc hl @@ -1126,14 +1352,16 @@ fact_mem: expr_brckt: call expr1 - jr c,error4 + jr c,error1 ld a,(de) cp ']' inc de ret z -error4: +error1: jp ERROR +;------------------------------------------------------------------------------- + get.number: call get.hexdigit ret c @@ -1177,7 +1405,7 @@ l05dbh: jr next_bindigit l05e4h: cp '"' - jp nz,ERROR + jr nz,error11 call get.bindigit jr nc,l05dbh or a @@ -1202,16 +1430,18 @@ next_decdigit: decnum_done: cp '.' ret z +error11: jp ERROR sub_060ch: - ld a,(de) - cp '[' + call get_char_upper + cp 'Z'+1 jr l0614h get.hexdigit: ld a,(de) hex_digit: + call toupper cp 'F'+1 l0614h: ccf @@ -1222,13 +1452,13 @@ l0614h: ret get.decdigit: - ld a,(de) + call get_char_upper l061eh: cp '9'+1 jr l0625h get.bindigit: - ld a,(de) + call get_char_upper cp '1'+1 l0625h: ccf @@ -1238,6 +1468,8 @@ l0625h: sub '0' ret +;------------------------------------------------------------------------------- + p_cpustat0: call assert_eol p_cpustat: @@ -1249,28 +1481,20 @@ p_cpustat: l063eh: call p_regs djnz l063eh + call outbl6 push hl push de ld iy,(reg.pc) call p_disas_instr - exx - ex af,af' + pop de + pop hl call crlf call p_f2 call outbl2 - pop de - pop hl ld b,7 l065bh: call p_regs djnz l065bh - exx - ex af,af' - and a - jr z,l066bh - call outbl6 - call p_offset -l066bh: jp crlf p_f: @@ -1278,39 +1502,40 @@ p_f: call p_flags ld a,(reg.iff) cp 0f3h - jp z,outbl + jr z,outbl_1 ld a,'E' jp outchar p_f2: ld a,(reg.f2) call p_flags - jp outbl + jr outbl_1 + p_flags: - ld b,a - ld a,'S' - call sub_06aah - ld a,'Z' - call sub_06aah - rl b - ld a,'H' - call sub_06aah - rl b - ld a,'V' - call sub_06aah - ld a,'N' - call sub_06aah - ld a,'C' -sub_06aah: - rl b - jp c,outchar - jp outbl + push hl + ld hl,t_flag_names+7 + ld c,a + ld b,8 +fl_loop: + ld a,' ' + cp (hl) + ld a,c + rlca + ld c,a + jr z,fl_skip + ld a,(hl) + call c,outchar + call nc,outbl +fl_skip: + dec hl + djnz fl_loop + pop hl + ret p_regs: - push bc push de call pstr - ld a,'=' - call outchar + call pstr_inl + dc '=' ex (sp),hl ld e,(hl) inc hl @@ -1321,30 +1546,21 @@ p_regs: push hl and a jr z,l06deh - push af - ld a,(de) - ld l,a - inc de - ld a,(de) - ld h,a - pop af - dec a - jr z,l06d9h - call out.hl.@ - call z,outbl6 - jr l06e2h -l06d9h: + ex de,hl + ld e,(hl) + inc hl + ld d,(hl) + ex de,hl call out_hl jr l06e2h l06deh: ld a,(de) call out_hex l06e2h: - call outbl pop de pop hl - pop bc - ret +outbl_1: + jp outbl b_06e9_start: DC 'A ' @@ -1391,63 +1607,149 @@ b_0709_start: db 000h db 000h +;------------------------------------------------------------------------------- +; > E addr +; relocate debugger to addr +; > ER addr +; relocate just below addr +; +; Move debugger to given address and restart. +; New location must not overlap with current location. + + +cmd_E: + call skipbl + sub 'R' + jr nz,$+3 + inc de + push af + call get_arg_final + + ex de,hl + ld hl,(bitmap_end) + ld bc,ddtz_base + or a + sbc hl,bc + ld b,h + ld c,l + ex de,hl + pop af + jr nz,cmde_bottom + sbc hl,bc +cmde_bottom: + ld ix,cmde_clr-ddtz_base + ex de,hl ;de = dst + add ix,de + ld hl,ddtz_base ;hl = src + + push hl + or a + sbc hl,de + call c,neg.hl ;abs(distance) + or a + sbc hl,bc + jp c,error + pop hl + push hl + push bc + ldir + pop bc + pop hl + jp (ix) + +;------------------------------------------------------------------------------- +; > G [startaddr] [;breakp..] +; Go [to start] [with temporary breakpoints] + cmd_G: sub a - ld (trace_call_flag),a - ld (l0941h),a + ld (bp_p_cpu_flag),a call expr jr c,l0740h ld (reg.pc),hl l0740h: call skipbl - jp z,user_go + jr z,user_go0 cp ';' jp nz,ERROR inc de ld a,002h call bp_enter +user_go0: jp user_go +;------------------------------------------------------------------------------- + +bpl_init: + ld b,BP_CNT + ld ix,bp_tab + ex (sp),hl + ld (pbl_loop_adr),hl + ex (sp),hl + ret + +bpl_next: + ld de,BP_SIZE + push af + add ix,de + pop af + dec b + ret z + + ex (sp),hl + ld hl,(pbl_loop_adr) + ex (sp),hl + ret + bp_clr_temporary: - ld b,BP_CNT - ld ix,bp_tab -l075ah: + call bpl_init + ld a,(ix+000h) and 0f1h ld (ix+000h),a - call bp_clr_condition - ld de,BP_SIZE - add ix,de - djnz l075ah + + call bpl_next ret +;------------------------------------------------------------------------------- +; > B +; display all breakpoints +; > B breakp [breakp..] +; set breakpoints +; > BX +; clear all breakpoints +; > BX breakp [breakp..] +; clear breakpoints +; +; breakp can be any valid expression + cmd_B: call skipbl - jr z,l07b7h + jr z,bp_print inc de cp 'X' - jr z,l077dh + jr z,bp_clr0 dec de ld a,001h jp bp_enter -l077dh: + +bp_clr0: call skipbl jr z,bp_clr_all -l0782h: +bp_clr_next: call expr jp c,assert_eol push de call bp_clr pop de call next_arg - jr l0782h + jr bp_clr_next bp_clr_all: scf bp_clr: - ld b,BP_CNT - ld ix,bp_tab -l0799h: + call bpl_init + push af jr c,l07a7h ld e,(ix+002h) @@ -1456,54 +1758,30 @@ l0799h: jr nz,l07aeh l07a7h: ld (ix+000h),000h - call bp_clr_condition l07aeh: - ld de,BP_SIZE - add ix,de pop af - djnz l0799h + call bpl_next ret -l07b7h: - ld b,BP_CNT - ld ix,bp_tab -l07bdh: +bp_print: + ld c,0 + call bpl_init + bit 0,(ix+000h) - jr z,l0808h - ld a,'R' - bit 4,(ix+000h) - jr nz,l07cdh - ld a,' ' -l07cdh: - call outchar - call outbl + jr z,bp_pr_cont ld l,(ix+002h) ld h,(ix+003h) - call out.hl.@ - call outbl2 - ld a,':' - call outchar - ld l,(ix+004h) - ld h,(ix+005h) call out_hl - ld l,(ix+006h) - ld h,(ix+007h) - ld a,h - or l - jr z,l0805h - call outbl4 - ld a,'I' - call outchar call outbl2 - call pstr -l0805h: - call crlf -l0808h: - ld de,BP_SIZE - add ix,de - djnz l07bdh + inc c +bp_pr_cont: + call bpl_next + ld a,c + or a + call nz,crlf ret +;------------------------------------------------------------------------------- ; Add break points to list ; A = 1 Permanent (B command) ; A = 2 Temporary (G command) @@ -1512,14 +1790,10 @@ bp_enter: ld b,a call skipbl ret z - cp 'R' - jr nz,l081ch - inc de - set 4,b -l081ch: + push bc call expr - jp c,ERROR + jr c,error12 pop bc bit 0,b push bc @@ -1531,12 +1805,6 @@ l081ch: pop de ld (ix+002h),l ld (ix+003h),h - call bp_get_count - ld (ix+004h),l - ld (ix+005h),h - call bp_get_condition - ld (ix+006h),l - ld (ix+007h),h call next_arg pop af ld (ix+000h),a @@ -1544,63 +1812,19 @@ l081ch: jr bp_enter bp_get_freeslot: - ld b,BP_CNT - ld ix,bp_tab -l085ah: + call bpl_init + ld a,(ix+000h) and 00fh ret z - push bc - ld bc,BP_SIZE - add ix,bc - pop bc - djnz l085ah + + call bpl_next +error12 jp ERROR -bp_get_count: - call skipbl - ld hl,1 - cp ':' - ret nz - inc de - call expr - jp c,ERROR - ret -bp_get_condition: - call skipbl - cp 'I' - ld hl,0 - ret nz - inc de - call skipbl - push de - call expr - jp c,ERROR - ex de,hl - pop de - push de - sbc hl,de - ld b,h - ld c,l - ld hl,(expr_p1) - push hl - add hl,bc - ld de,expr_bufe - call cp_hl_de - jp nc,ERROR - pop hl - ld (expr_p2),hl - pop de - ex de,hl - ldir - xor a - ld (de),a - inc de - ex de,hl - ld (expr_p1),hl - ld hl,(expr_p2) - ret +;------------------------------------------------------------------------------- +; Breakpoint handling routine. bpddtz: ld (reg.l),hl @@ -1615,13 +1839,13 @@ bpddtz: push ix push iy ld a,i - call sub_0004h + call di_or_ei ld h,a ld l,000h push hl - ld a,0f3h + ld a,0f3h ; EI jp po,l08dfh - ld a,0fbh + ld a,0fbh ; DI l08dfh: ld (reg.iff),a ex af,af' @@ -1630,18 +1854,18 @@ l08dfh: push bc push de push hl - call sub_097ah + call bp_restore_mem ld a,(b_21e2_start) dec a jr z,l090bh - call inchar - jr c,l0902h + call inchar ;Keyboard hit? + jr c,do_break ;yes call sub_0913h and a jp z,user_go and 083h jp z,l2151h -l0902h: +do_break: call bp_clr_temporary call p_cpustat jp mainloop @@ -1655,10 +1879,9 @@ sub_0913h: ld a,080h ex af,af' sub a - ld (l0941h),a - ld b,BP_CNT - ld ix,bp_tab -l0920h: + ld (bp_p_cpu_flag),a + call bpl_init + ld a,(ix+000h) and 007h jr z,l0938h @@ -1666,53 +1889,19 @@ l0920h: ld d,(ix+003h) ld hl,(reg.pc) call cp_hl_de - push bc - call z,sub_0942h - pop bc -l0938h: - ld de,BP_SIZE - add ix,de - djnz l0920h - ex af,af' - ret - -sub_0942h: + jr nz,l0938h ex af,af' res 7,a - ex af,af' - ld e,(ix+006h) - ld d,(ix+007h) - ld a,d - or e - ld hl,0ffffh - call nz,expr - ld a,h - or l - jr z,l0969h - ld e,(ix+004h) - ld d,(ix+005h) - dec de - ld a,d - or e - jr z,l0974h - ld (ix+004h),e - ld (ix+005h),d -l0969h: - bit 4,(ix+000h) - ret z - ld a,001h - ld (l0941h),a - ret -l0974h: - ex af,af' or (ix+000h) ex af,af' +l0938h: + call bpl_next + ex af,af' ret -sub_097ah: - ld b,BP_CNT - ld ix,bp_tab -l0980h: +bp_restore_mem: + call bpl_init + bit 5,(ix+000h) res 5,(ix+000h) jr z,l099ah @@ -1725,52 +1914,43 @@ l0980h: ld (hl),a l099ah: res 3,(ix+000h) - ld de,BP_SIZE - add ix,de - djnz l0980h + + call bpl_next ret -sub_09a6h: - ld b,BP_CNT - ld ix,bp_tab -l09ach: +bp_tst_@pc: + call bpl_init + ld a,(ix+000h) and 003h - jr z,l09c0h + jr z,bp_tst_e ld e,(ix+002h) ld d,(ix+003h) ld hl,(reg.pc) call cp_hl_de ret z -l09c0h: - ld de,BP_SIZE - add ix,de - djnz l09ach +bp_tst_e: + call bpl_next sub a inc a ret -sub_09cah: +bp_trace_enter: call bp_get_freeslot - ld (ix+004h),001h - ld (ix+005h),000h ld (ix+002h),l ld (ix+003h),h - ld (ix+006h),000h - ld (ix+007h),000h ld a,(b_21e2_start) and a ld a,008h - jr nz,l09edh - ld a,004h -l09edh: + jr nz,bp_t_e + rra +bp_t_e: ld (ix+000h),a ret -sub_09f1h: - ld b,BP_CNT - ld ix,bp_tab -l09f7h: +bp_set_to_mem: + call bpl_init + ld a,(ix+000h) and c jr z,l0a1dh @@ -1791,26 +1971,27 @@ l09f7h: inc hl ld (hl),d l0a1dh: - ld de,BP_SIZE - add ix,de - djnz l09f7h + + call bpl_next ret +;------------------------------------------------------------------------------- + user_go: sub a ld (b_21e2_start),a - ld a,(l0941h) + ld a,(bp_p_cpu_flag) and a call nz,p_cpustat - call sub_09a6h + call bp_tst_@pc ld c,007h jr nz,l0a41h ld a,001h ld (b_21e2_start),a - call sub_1ffeh + call tc_set_bp ld c,008h l0a41h: - call sub_09f1h + call bp_set_to_mem ld sp,reg.l2 pop hl pop de @@ -1829,97 +2010,20 @@ l0a41h: ld sp,(reg_sp) jp reg.iff -bp_clr_condition: - ld a,(ix+000h) - and 003h - ret nz - ld e,(ix+006h) - ld d,(ix+007h) - ld a,d - or e - ret z - push bc - ld h,d - ld l,e - sub a - ld (ix+006h),a - ld (ix+007h),a - ld bc,0ffffh - cpir -l0a7dh: - push de - ld de,(expr_p1) - call cp_hl_de - pop de - jr nc,l0a93h - call sub_0a99h -l0a8bh: - ld a,(hl) - ldi - and a - jr nz,l0a8bh - jr l0a7dh -l0a93h: - ld (expr_p1),de - pop bc - ret +;------------------------------------------------------------------------------- +; > Y +; examine all Y variables +; > Y[0..9] +; examine (and substitute) an Y variable -sub_0a99h: - ld iy,bp_tab - push de -l0a9eh: - ld e,(iy+006h) - ld d,(iy+007h) - call cp_hl_de - jr z,l0ab0h - ld de,BP_SIZE - add iy,de - jr l0a9eh -l0ab0h: - pop de - ld (iy+006h),e - ld (iy+007h),d - ret -cmd_Y: - call get.decdigit - jr c,l0bc3h - inc de - push af - call assert_eol - pop af - call sub_0bdch - jp l0c15h -l0bc3h: - call assert_eol - xor a -l0bc7h: - push af - call sub_0bdch - call outbl4 - pop af - inc a - bit 0,a - push af - call z,crlf - pop af - cp YREG_CNT - jr c,l0bc7h - ret +;------------------------------------------------------------------------------- +; > X +; eXamine (display) all cpu registers and +; the instruction at the current program counter +; > X register +; eXamine (and substitute) a register -sub_0bdch: - ld c,a - ld b,0 - add a,'0'+080h - ld de,msg_Y+1 - ld (de),a - dec de - ld hl,reg_Y - add hl,bc - add hl,bc - ex de,hl - ld c,003h - jp l0c33h cmd_X: call skipbl @@ -1927,34 +2031,30 @@ cmd_X: jp nc,p_cpustat0 call assert_eol ld a,b - cp 01eh + cp 25 jr z,l0c5fh - cp 01fh + cp 26 jr z,l0c4fh - cp 01dh - jp z,ERROR ex de,hl - ld hl,b_0cc3_start - call sel_dc_string -l0c12h: + ld hl,t_reg_names + call pstr_sel call l0c33h -l0c15h: + call outbl push de push bc call get_line call skipbl jr z,l0c30h - call sub_0363h - ld b,h - ld c,l - pop af + call get_arg_final + ex de,hl + pop bc pop hl - ld (hl),c - bit 0,a + ld (hl),e + bit 0,c ret z inc hl - ld (hl),b + ld (hl),d ret l0c30h: pop af @@ -1962,21 +2062,17 @@ l0c30h: ret l0c33h: - ld b,c - call pstr - ld a,'=' - call outchar + call pstr_inl + dc '=' ld a,(de) - bit 0,b + bit 0,c jp z,out_hex ld l,a inc de ld a,(de) dec de ld h,a - bit 1,b - jp z,out_hl - jp out.hl.@ + jp out_hl l0c4fh: call p_f @@ -1992,43 +2088,44 @@ l0c5fh: call sub_0c6ah ld (reg.f2),a ret + sub_0c6ah: - ex af,af' - ld b,000h + push af call outbl call assert_eol call get_line + pop af + ex af,af' + ld b,0 l0c76h: call skipbl ld a,b ret z push bc - ld hl,b_0ca4_start + ld hl,t_flag_names call lookupch jp nc,ERROR - ld a,b - cp 008h - jr z,l0c97h - pop bc - rlca - rlca - rlca - add a,0c0h - ld (l0c94h),a - defb 0cbh -l0c94h: - defb 0c0h + inc b + xor a + scf +nxt_f: + rla + djnz nxt_f + pop bc + jr c,l0c97h + or b + ld b,a jr l0c76h + l0c97h: ex af,af' jp nc,ERROR ex af,af' ld a,0fbh ld (reg.iff),a - pop bc jr l0c76h -b_0ca4_start: +t_flag_names: db 'CNV H ZSE',0 sub_0caeh: @@ -2048,39 +2145,34 @@ sub_0caeh: scf ret -b_0cc3_start: - DC 'BC''' - DC 'DE''' - DC 'HL''' - DC 'BC' - DC 'DE' - DC 'HL' - DC 'A''' - DC 'B''' - DC 'C''' - DC 'D''' - DC 'E''' - DC 'H''' - DC 'L''' - DC 'A' - DC 'B' - DC 'C' - DC 'D' - DC 'E' - DC 'H' - DC 'L' - DC 'IX' - DC 'IY' - DC 'SP' - DC 'PC' - DC 'X' - DC 'Y' - DC 'S' - DC 'P' - DC 'I' - DC 'IP' - DC 'F''' - DC 'F' +t_reg_names: + DC 'BC''' ;0 + DC 'DE''' ;1 + DC 'HL''' ;2 + DC 'BC' ;3 + DC 'DE' ;4 + DC 'HL' ;5 + DC 'A''' ;6 + DC 'B''' ;7 + DC 'C''' ;8 + DC 'D''' ;9 + DC 'E''' ;10 + DC 'H''' ;11 + DC 'L''' ;12 + DC 'A' ;13 + DC 'B' ;14 + DC 'C' ;15 + DC 'D' ;16 + DC 'E' ;17 + DC 'H' ;18 + DC 'L' ;19 + DC 'IX' ;20 + DC 'IY' ;21 + DC 'SP' ;22 + DC 'PC' ;23 + DC 'I' ;24 + DC 'F''' ;25 + DC 'F' ;26 DB 0 b_0cfa_start: @@ -2132,29 +2224,23 @@ b_0cfa_start: dw reg_sp db 003h dw reg.pc - db 003h - dw reg.ix - db 003h - dw reg.iy - db 003h - dw reg_sp - db 003h - dw reg.pc db 000h dw reg.i - db 003h - dw l004eh db 000h dw reg.f2 db 000h dw reg.f +;------------------------------------------------------------------------------- +; > S [startaddr] +; Substitute memory + cmd_S: ld hl,(last_S) call get_lastarg_def l0d60h: ld (last_S),hl - call out.hl.@ + call out_hl call outbl ld a,(hl) call out_hex @@ -2166,10 +2252,16 @@ l0d60h: dec hl inc de cp '.' + jr nz,cmds_dash + call get_char_upper + or a + jr nz,l0d8ah + ret +cmds_dash: jp z,assert_eol cp '-' jr nz,l0d8ah - ld a,(de) + call get_char_upper or a dec hl jr z,l0d60h @@ -2179,18 +2271,17 @@ l0d8ah: call sub_0ef8h jr l0d60h -cmd_@: - call assert_eol - ld hl,msg_@ - ld de,var.@ - ld c,001h - jp l0c12h +;------------------------------------------------------------------------------- +; > @ +; examine (substitute) displacement register @ -msg_@: - dc '@' +;cmd_@: + +;------------------------------------------------------------------------------- +; >>I [port] +; Input a byte from port cmd_I: - ld hl,cmd_I ld (cmd_rpt),hl ld hl,(last_I) call get_lastarg_def @@ -2205,8 +2296,11 @@ cmd_I: call out.bin.b jp crlf +;------------------------------------------------------------------------------- +; >>O [byte] [port] +; Output a byte to a port + cmd_O: - ld hl,cmd_O ld (cmd_rpt),hl ld hl,(last_O_val) call get_arg_def @@ -2223,8 +2317,12 @@ cmd_O: out (c),a ret +;------------------------------------------------------------------------------- +; > V startaddr endaddr targetaddr +; Verify (compare) two memory areas + cmd_V: - call sub_034eh + call get_arg_range_target l0dedh: push bc ld a,(de) @@ -2232,7 +2330,7 @@ l0dedh: cp b jr z,l0e10h ld c,a - call out.hl.@ + call out_hl call outbl ld a,b call out_hex @@ -2241,32 +2339,24 @@ l0dedh: call out_hex call outbl ex de,hl - call out.hl.@ + call out_hl ex de,hl call crlf l0e10h: pop bc - inc hl inc de - dec bc - ld a,b - or c - jr nz,l0dedh + cpi + jp pe,l0dedh ret +;------------------------------------------------------------------------------- +; > M startaddr endaddr destaddr +; Move memory + cmd_M: - ld a,(de) - cp 'V' - jr nz,l0e1fh - inc de -l0e1fh: - push af - call sub_034eh - push hl - push de - push bc + call get_arg_range_target call cp_hl_de - jr nc,$+11 + jr nc,cmdm_up add hl,bc ex de,hl add hl,bc @@ -2274,35 +2364,22 @@ l0e1fh: dec hl dec de lddr - ld bc,0b0edh - pop bc - pop de - pop hl - pop af - jr z,l0dedh ret +cmdm_up: + ldir + ret + +;------------------------------------------------------------------------------- +; > H +; display Highest load address of last filed loaded, Maximum "High" +; off all loaded files, and Top address of available memory +; > H expression +; evaluate expression and display result in hex, decimal and other formats cmd_H: call expr jp c,p_max_high0 - call next_arg - push hl - call expr - push af call assert_eol - pop af - ex de,hl - pop hl - jr c,l0e5eh - push hl - push de - add hl,de - call l0e5eh - pop de - pop hl - and a - sbc hl,de -l0e5eh: call out_hl call outbl2 call out_hl_neg @@ -2317,33 +2394,36 @@ l0e5eh: call out.ascii jp crlf +;------------------------------------------------------------------------------- +; > Q[J] startaddr endaddr bytes +; Query memory for a byte string [Justified] + cmd_Q: - ld a,(de) - sub 'J' - ld (cmd_Q_jopt),a - jr nz,l0e8dh - inc de -l0e8dh: call get_arg_range push bc push hl call sub_0ee6h pop hl l0e96h: - call sub_0ed7h + push hl + push de + push bc +l0edah: + ld a,(de) + cp (hl) + jr nz,l0ee2h + inc de + inc hl + djnz l0edah +l0ee2h: + pop bc + pop de + pop hl jr nz,l0eb0h push bc - push hl - ld a,(cmd_Q_jopt) - or a - jr nz,l0ea7h - ld bc,-8 - add hl,bc -l0ea7h: ld bc,16 - and a + and a ;clear carry call sub_0f58h - pop hl pop bc l0eb0h: inc hl @@ -2356,6 +2436,10 @@ l0eb0h: pop bc ret +;------------------------------------------------------------------------------- +; > Z startaddr endaddr bytes +; Zap (fill) memory with a byte string + cmd_Z: call get_arg_range push bc @@ -2378,53 +2462,23 @@ l0ed3h: pop hl ret -sub_0ed7h: - push hl - push de - push bc -l0edah: - ld a,(de) - cp (hl) - jr nz,l0ee2h - inc de - inc hl - djnz l0edah -l0ee2h: - pop bc - pop de - pop hl - ret - sub_0ee6h: - ld hl,conbuf+1 + ld hl,conbuf call sub_0ef7h - ld de,conbuf+1 + ld de,conbuf and a sbc hl,de ld b,l ret nz jp ERROR -sub_0ef7h: - db 0e6h ; and 037h (clear carry) -sub_0ef8h: +sub_0ef7h: ;from cmd_Q, cmd_Z + db 0e6h ;and 037h (clear carry) +sub_0ef8h: ;from cmd_S scf l0ef9h: push af call next_arg - cp 'W' - jr nz,l0f0eh - inc de - push hl - call sub_035dh - ex de,hl - ex (sp),hl - ld (hl),e - inc hl - ld a,d - pop de - jr l0f1ah -l0f0eh: cp '''' jr z,l0f1eh push hl @@ -2432,7 +2486,6 @@ l0f0eh: ld a,l pop hl jr c,l0f42h -l0f1ah: ld (hl),a inc hl jr l0f3ah @@ -2469,8 +2522,11 @@ l0f42h: ld (last_S),hl ret +;------------------------------------------------------------------------------- +; >>D [startaddr] [endaddr] +; Display memory in hex and ASCII + cmd_D: - ld hl,cmd_D ld (cmd_rpt),hl ld hl,(last_D) ld bc,128 @@ -2480,11 +2536,10 @@ sub_0f58h: push bc push de push hl - ex af,af' + push af l0f5ch: - call out.hl.@ - call z,outbl2 - call outbl + call out_hl + call outbl2 ld de,0 l0f68h: ld a,(hl) @@ -2512,15 +2567,16 @@ l0f86h: inc hl dec e jr nz,l0f86h - ex af,af' + pop af + push af jr nc,l0f97h ld (last_D),hl l0f97h: - ex af,af' call crlf ld a,b or c jr nz,l0f5ch + pop af pop hl pop de pop bc @@ -2536,205 +2592,98 @@ l0fach: ld a,'.' ret -cmd_F: - push de - ld hl,DMA_BUF+1 - ld (hl),' ' - inc hl -l0fb6h: - ld a,(de) - ld (hl),a - inc hl - inc de - and a - jr nz,l0fb6h - ld a,l - sub DMA_BUF+2 - ld (DMA_BUF),a - pop hl - ld de,dfcb1 - call parse_filename - ld de,dfcb2 - call parse_filename - ;fall thru +;------------------------------------------------------------------------------- +; > Fcommandline +; specifiy filenames and command line -cpy_fcb2: - ld hl,dfcb2 - ld de,fcbsym - ld bc,16 - ldir - ret +;cmd_F: -parse_filename: - call sub_102ch - push de - push bc - ld b,(hl) - inc hl - ld a,(hl) +;------------------------------------------------------------------------------- +; > R [displacement] +; Read Intel Hex File from console [add displacement] + +cmd_R: + ld hl,0 + call get_lastarg_def ;get offset from command line + push hl + ld hl,0 + ld (high_load),hl +w_recstart: + call i.getchar + jr z,rdhex_done cp ':' - jr nz,l0fe1h - inc hl + jr nz,w_recstart + ld c,0 ;init checksum + call i.gethexbyte ;record len + ld b,a + call i.gethexbyte ;address high + ld h,a + call i.gethexbyte ;address low + ld l,a + call i.gethexbyte ;record type (ignored) ld a,b - sub 040h - and 01fh - jr l0fe3h -l0fe1h: - dec hl - xor a -l0fe3h: - ld (de),a - inc de - ld b,8 - call sub_0ff2h - ld b,3 - call sub_0ff2h - pop bc - pop de - ret - -sub_0ff2h: - call sub_1012h - jr z,l0ffeh + and a ;record len == 0? + jr z,rdhex_done +l16c6h: + call i.gethexbyte + pop de ;offset + push de + push hl + add hl,de + call i.storebyte + pop hl inc hl - ld (de),a - inc de - djnz sub_0ff2h - jr l1003h -l0ffeh: + djnz l16c6h ;repeat for record len + call i.gethexbyte ;checksum ld a,c -l0fffh: - ld (de),a - inc de - djnz l0fffh -l1003h: - call sub_1012h - inc hl - jr nz,l1003h - cp '*' - jr z,l1003h - cp '.' - ret z - dec hl - ret + and a + jr nz,error2 ;exit if checksum error + jr w_recstart ;next record -sub_1012h: - ld a,(hl) - ld c,' ' - and 01fh - ret z - ld a,(hl) - cp ' ' - ret z - call sub_1043h - ret z - cp '/' - ret z - cp '.' - ret z - ld c,'?' - cp '*' - ret +rdhex_done: + pop hl + call i.gethexbyte + jp p_max_high -l102bh: - inc hl -sub_102ch: - ld a,(hl) - cp '/' - jr z,l103bh - call sub_1043h - jr z,l102bh -l1036h: - cp ' ' - jr z,l102bh +i.gethexbyte: + call sub_16f6h + rlca + rlca + rlca + rlca + ld d,a + call sub_16f6h + add a,d + ld d,a + add a,c + ld c,a + ld a,d ret -l103bh: - ld a,(hl) - cp ' '+1 - jr c,l1036h - inc hl - jr l103bh +sub_16f6h: + call i.getchar + jr z,error2 + call hex_digit + ret nc +error2: + jp ERROR -sub_1043h: - cp '=' - ret z - cp '_' - ret z - cp ',' +i.getchar: + call incharw + cp 01ah ret -setup_fcb: +i.storebyte: + push af push de - ld hl,12 - add hl,de - xor a - ld b,21 -l1052h: - ld (hl),a - inc hl - djnz l1052h - ld de,DMA_BUF - ld c,BDOS_SETDMA - call ddtz_bdos - pop de - ret + ld de,ddtz_base ;don't load over ddtz + call cp_hl_de + jr nc,ist_1 -file_open: - ld (cur_fcb),de - call setup_fcb - ld c,BDOS_OPEN - call ddtz_bdos - inc a - jp z,ERROR - ld a,080h - ld (cmdR_rindex),a - ret - -read_byte: - ld a,(cmdR_rindex) - cp 080h - jr nz,l1111h - call read_sector - ret z - sub a -l1111h: - inc a - ld (cmdR_rindex),a - push hl - add a,07fh - ld l,a - ld h,000h - ld a,(hl) - pop hl - cp 01ah - ret - -read_sector: - push hl - push de - push bc - ld de,(cur_fcb) - ld c,BDOS_READ - call ddtz_bdos - dec a - jr z,l1132h - jp p,ERROR -l1132h: - pop bc - pop de - pop hl - ret - -cmdR_storebyte: - push af - push de - ld de,TPA - call cp_hl_de - jp c,ERROR - ld de,(BDOS+1) + ld de,(bitmap_end) call cp_hl_de - jp nc,ERROR + jr nc,error2 +ist_1: ld de,(high_load) call cp_hl_de jr c,l1157h @@ -2747,223 +2696,10 @@ l1157h: l1163h: pop de pop af - ld (hl),a - ret - -strncmp: - ld a,(de) - cp (hl) - inc de - inc hl - ret nz - djnz strncmp - ret - -str_hex: - db 'HEX' - -read_hexchar: - call read_hexdigit - rlca - rlca - rlca - rlca - ld d,a - call read_hexdigit - add a,d - ld d,a - add a,c - ld c,a - ld a,d - ret - -read_hexdigit: - call read_byte - jr z,error8 -hex_digit_v: - call hex_digit - ret nc -error8: - jp ERROR - -read_hexbyte: - call read_byte -read_hexbyte0: - push bc - call hex_digit_v - rlca - rlca - rlca - rlca - ld c,a - call read_byte - call hex_digit_v - or c - pop bc + ld (hl),a ;store byte ret -cmd_R: - ld hl,0 - call get_lastarg_def -read_file: - ld de,dfcb1+1 - ld a,(de) - cp '?' - jr z,read_symfile - dec de - push hl - ld hl,0 - ld (high_load),hl - call file_open - ld hl,dfcb1+9 - ld de,str_hex - ld b,3 - call strncmp - pop hl - jr z,read_hexfile - ld de,TPA - add hl,de - push hl -l108eh: - call read_sector - pop hl - jr z,read_symfile - ld de,DMA_BUF - ld b,080h -l109ah: - ld a,(de) - call cmdR_storebyte - inc de - inc hl - djnz l109ah - push hl - jr l108eh - -read_hexfile: - push hl -l10aeh: - call read_byte - jr z,rdhex_done - cp ':' - jr nz,l10aeh - ld c,0 - call read_hexchar - ld b,a - call read_hexchar - ld h,a - call read_hexchar - ld l,a - ld a,b - and a - jr z,rdhex_done - call read_hexchar -l10cch: - call read_hexchar - pop de - push de - push hl - add hl,de - call cmdR_storebyte - pop hl - inc hl - djnz l10cch - call read_hexchar - ld a,c - and a - jr nz,error9 - jr l10aeh -rdhex_done: - pop hl - jr read_symfile - -read_symfile: - ld de,fcbsym+1 - ld a,(de) - cp ' ' - jp z,p_max_high - - call pstr_inl - db 'SYMBOLS',CR,LF+80h - - dec de - call file_open -;------------------------------------------------------------------------ -rs_1: - call read_byte -rs_2: - cp 1ah - jr z,p_max_high - cp '!' - jr c,rs_1 - call read_hexbyte0 - ld d,a - call read_hexbyte ; symval - ld e,a - push de ; symval - call read_byte - cp ' ' - jr z,rs_4 - pop hl ; discard symval -rs_3: call read_byte - cp ' ' - jr c,rs_2 - jr rs_3 -; -rs_4: ld hl,(BDOS+1) ; - ld e,0 ; setup symlen -rs_5: dec hl ; - call read_byte ; - cp TAB ; - jr z,rs_6 ; - cp CR ; - jr z,rs_6 ; - cp '!' ; - jr c,error9 ; - ld (hl),a ; - inc e ; symlen++ - ld a,e ; - cp 10h+1 ; - jr c,rs_5 ; -error9: - jp ERROR ; -; -rs_6: push de ; symlen - push hl ; - ex de,hl ; - ld hl,(BDOS+1) ; - inc hl ; - ld e,(hl) ; - inc hl ; - ld d,(hl) ; - pop hl ; - ld (hl),d ; - dec hl ; - ld (hl),e ; - dec hl ; - ld (hl),0c3h ; - - ld de,(max_load) ; - call cp_hl_de ; - jr c,error9 ; - - ld de,(reg_sp) ; - call cp_hl_de ; - jr nc,rs_61 ; - ld (reg_sp),hl ; -rs_61: - - ld de,(BDOS+1) ; - ld (BDOS+1),hl ; - ex de,hl ; - pop de ; - ld (hl),e ; symlen - inc hl ; - pop de ; symval - ld (hl),e ; - inc hl ; - ld (hl),d ; - jp rs_1 ; -;------------------------------------------------------------------------ +;------------------------------------------------------------------------------- p_max_high0: call assert_eol @@ -2976,1222 +2712,34 @@ p_max_high: DC ' Max = ' ld hl,(max_load) call out_hl + call pstr_inl + DC ' Top = ' + ld hl,ddtz_base-1 + call out_hl jp crlf -cmd_W: - call get_arg_range - call assert_eol - push hl - ld a,c - add a,07fh - jr nc,l11adh - inc b -l11adh: - and 080h - ld c,a - push bc - ld a,(dfcb1+1) - cp ' ' - jr z,error5 - ld de,dfcb1 - call setup_fcb - push de - ld c,BDOS_DELETE - call ddtz_bdos - pop de - ld c,BDOS_CREATE - call ddtz_bdos - inc a - jr z,error5 - pop bc - pop hl -l11cch: - ld a,b - or c - jr z,close_file - push bc - ld de,080h ; DMA_BUF - ld b,d - ld c,e - ldir - call write_sector - ex (sp),hl - ld bc,0ff80h - add hl,bc - ex (sp),hl - pop bc - jr l11cch - -write_sector: - push hl - ld de,dfcb1 - ld c,BDOS_WRITE - call ddtz_bdos - pop hl - and a - ret z - call close_file -error5: - jp ERROR - -close_file: - ld de,dfcb1 - ld c,BDOS_CLOSE - jp ddtz_bdos - -cmd_A: - ld hl,(last_A) - call get_lastarg_def - push hl - pop iy - ld hl,l1259h - ld (error_func),hl - ld (l1262h),sp -l1211h: - push iy - pop hl - ld (last_A),hl - ld (var.$),hl - push hl - call p_disas_line - pop iy - ld c,b - ld de,(var.@) - ld a,d - or e - ld b,011h - jr z,l122dh - ld b,019h -l122dh: - call outbl - ld a,(con_col) - cp b - jr c,l122dh - push bc - call get_line - pop bc - call skipbl - cp '.' - ret z - cp '-' - jr nz,l124bh - ld iy,(cmd_A_prev) - jr l1211h -l124bh: - and a - call nz,sub_1268h - ld (cmd_A_prev),iy - ld b,0 - add iy,bc - jr l1211h - -l1259h: - call l0146h - ld sp,(l1262h) - jr l1211h - -sub_1268h: - call skipbl - ld hl,t_MNEMONICS - call sub_030ah - jp nc,ERROR - call skipbl - push de - ld a,b - add a,b - add a,b - ld hl,b_1289_start - call add_hl_a - ld e,(hl) - inc hl - ld d,(hl) - inc hl - ld b,(hl) - ex de,hl - pop de - -CALL_HL: - jp (hl) - -b_1289_start: - dw as.ADC_SBC ;ADC - db 088h ; - dw as.ADD ;ADD - db 080h ; - dw as.AND_CP_OR_SUB_XOR ;AND - db 0a0h ; - dw as.BITOP ;BIT - db 040h ; - dw as.CALL ;CALL - db 0c4h ; - dw as.opc.noarg ;CCF - db 03fh ; - dw as.AND_CP_OR_SUB_XOR ;CP - db 0b8h ; - dw gen.opc.ED2 ;CPD - db 0a9h ; - dw gen.opc.ED2 ;CPDR - db 0b9h ; - dw gen.opc.ED2 ;CPI - db 0a1h ; - dw gen.opc.ED2 ;CPIR - db 0b1h ; - dw as.opc.noarg ;CPL - db 02fh ; - dw as.opc.noarg ;DAA - db 027h ; - dw as.DEC_INC ;DEC - db 005h ; - dw as.opc.noarg ;DI - db 0f3h ; - dw as.DJNZ ;DJNZ - db 010h ; - dw as.opc.noarg ;EI - db 0fbh ; - dw as.EX ;EX - db 0e3h ; - dw as.opc.noarg ;EXX - db 0d9h ; - dw as.opc.noarg ;HALT - db 076h ; - dw as.IM ;IM - db 046h ; - dw as.IN ;IN - db 040h ; - dw as.DEC_INC ;INC - db 004h ; - dw gen.opc.ED2 ;IND - db 0aah ; - dw gen.opc.ED2 ;INDR - db 0bah ; - dw gen.opc.ED2 ;INI - db 0a2h ; - dw gen.opc.ED2 ;INIR - db 0b2h ; - dw as.JP ;JP - db 0c2h ; - dw as.JR ;JR - db 020h ; - dw as.LD ;LD - db 040h ; - dw gen.opc.ED2 ;LDD - db 0a8h ; - dw gen.opc.ED2 ;LDDR - db 0b8h ; - dw gen.opc.ED2 ;LDI - db 0a0h ; - dw gen.opc.ED2 ;LDIR - db 0b0h ; - dw gen.opc.ED2 ;NEG - db 044h ; - dw as.opc.noarg ;NOP - db 000h ; - dw as.AND_CP_OR_SUB_XOR ;OR - db 0b0h ; - dw gen.opc.ED2 ;OTDR - db 0bbh ; - dw gen.opc.ED2 ;OTIR - db 0b3h ; - dw as.OUT ;OUT - db 041h ; - dw gen.opc.ED2 ;OUTD - db 0abh ; - dw gen.opc.ED2 ;OUTI - db 0a3h ; - dw as.POP_PUSH ;POP - db 0c1h ; - dw as.POP_PUSH ;PUSH - db 0c5h ; - dw as.BITOP ;RES - db 080h ; - dw as.RET ;RET - db 0c0h ; - dw gen.opc.ED2 ;RETI - db 04dh ; - dw gen.opc.ED2 ;RETN - db 045h ; - dw as.SHIFTOP ;RL - db 010h ; - dw as.opc.noarg ;RLA - db 017h ; - dw as.SHIFTOP ;RLC - db 000h ; - dw as.opc.noarg ;RLCA - db 007h ; - dw gen.opc.ED2 ;RLD - db 06fh ; - dw as.SHIFTOP ;RR - db 018h ; - dw as.opc.noarg ;RRA - db 01fh ; - dw as.SHIFTOP ;RRC - db 008h ; - dw as.opc.noarg ;RRCA - db 00fh ; - dw gen.opc.ED2 ;RRD - db 067h ; - dw as.RST ;RST - db 0c7h ; - dw as.ADC_SBC ;SBC - db 098h ; - dw as.opc.noarg ;SCF - db 037h ; - dw as.BITOP ;SET - db 0c0h ; - dw as.SHIFTOP ;SLA - db 020h ; - dw as.SHIFTOP ;SRA - db 028h ; - dw as.SHIFTOP ;SRL - db 038h ; - dw as.AND_CP_OR_SUB_XOR ;SUB - db 090h ; - dw as.AND_CP_OR_SUB_XOR ;XOR - db 0a8h ; - - dw as.IN0 ;IN0 - db 000h ; - dw as.MLT ;MLT - db 04ch ; - dw gen.opc.ED2 ;OTDM - db 08bh ; - dw gen.opc.ED2 ;OTDMR - db 09bh ; - dw gen.opc.ED2 ;OTIM - db 083h ; - dw gen.opc.ED2 ;OTIMR - db 093h ; - dw as.OUTO ;OUT0 - db 001h ; - dw gen.opc.ED2 ;SLP - db 076h ; - dw as.TST ;TST - db 004h ; - dw as.TSTIO ;TSTIO - db 074h ; - -as.TST: - call arg.r_HL_A ; - jr nc,as.tst_0 - rlca - rlca - rlca - add a,b - ld b,a - jp gen.opc.ED2 -as.tst_0: - ld b,064h -as.TSTIO: - call arg.imm_8bit ; - jr as.store_io0 - -as.IN0: - call arg.r_HL_A ; - jr nc,error7 - cp 006h - jr z,error7 - rlca - rlca - rlca - add a,b - ld b,a - call assert_comma ; - call arg.addr_8bit ; - jr as.store_io0 - -as.OUTO: - call arg.addr_8bit ; - call assert_comma ; - call arg.r_HL_A ; - jr nc,error7 - cp 006h - jr z,error7 - rlca - rlca - rlca - add a,b - ld b,a - -as.store_io0: - call assert_eol - ld (iy+000h),0edh - ld (iy+001h),b - ld (iy+002h),l - ld c,003h - ret - -as.MLT: - call arg.ww ; - jr nc,error7 - add a,b - ld b,a - jp gen.opc.ED2 - -error7: - jp ERROR - -as.LD: - call arg.r_HL_A - jr c,l13d4h - call arg.IDX_displcmnt - jp c,l1471h - call arg.ww - jp c,l149ch - call arg.IX_IY - jp c,l14f5h - ld a,(de) - cp 'I' - jp z,l1511h - cp 'R' - jp z,l1519h - cp '(' - jp nz,ERROR - inc de - call arg.ww - jp c,l1528h - call test_expr - call test_paren_close - call assert_comma - call arg.ww - jr c,l13c2h - call arg.IX_IY - jr nc,l13aah - ld b,022h -l1395h: - call assert_eol - ld a,(prefix_ixiy) -l139bh: - ld (iy+000h),a - ld (iy+001h),b - ld (iy+002h),l - ld (iy+003h),h - ld c,004h - ret -l13aah: - ld a,(de) - cp 'A' - jp nz,ERROR - inc de - ld b,032h -as.store_3: - call assert_eol - ld (iy+000h),b - ld (iy+001h),l - ld (iy+002h),h - ld c,003h - ret -l13c2h: - cp 020h - jr z,l13d0h - add a,043h - ld b,a -l13c9h: - call assert_eol - ld a,0edh - jr l139bh -l13d0h: - ld b,022h - jr as.store_3 -l13d4h: - ld b,a - call assert_comma - call arg.r_HL_A - jr nc,l13f0h - push af - ld a,b - rlca - rlca - rlca - ld b,a - pop af - add a,b - add a,040h - cp 076h - jp z,ERROR -l13ech: - ld b,a - jp as.opc.noarg -l13f0h: - call arg.IDX_displcmnt - jr nc,l1413h - ld a,b - rlca - rlca - rlca - add a,046h - cp 076h - jp z,ERROR - -l1400h: - ld b,a - call assert_eol - ld (iy+001h),b - ld (iy+002h),c - ld a,(prefix_ixiy) - ld (iy+000h),a - ld c,003h - ret -l1413h: - ld a,(de) - cp 'I' - jr z,l1426h - cp 'R' - jr nz,l1432h - ld a,b - cp 007h - jp nz,ERROR - ld b,05fh - jr l142eh -l1426h: - ld a,b - cp 007h - jp nz,ERROR - ld b,057h -l142eh: - inc de - jp gen.opc.ED2 -l1432h: - cp '(' - jr z,l144ch - call arg.imm_8bit - ld a,b - rlca - rlca - rlca - add a,006h -l143fh: - ld b,a -as.store_2: - call assert_eol - ld (iy+000h),b - ld (iy+001h),l - ld c,002h - ret -l144ch: - inc de - ld a,b - cp 007h - jp nz,ERROR - call arg.ww - jr nc,l1466h - cp 030h - jp nc,ERROR - add a,00ah - ld b,a - call test_paren_close - jp as.opc.noarg -l1466h: - call test_expr - call test_paren_close - ld b,03ah - jp as.store_3 - -l1471h: - call assert_comma - call arg.r_HL_A - jr nc,l1483h - cp 006h - jp z,ERROR - add a,070h - jp l1400h - -l1483h: - call arg.imm_8bit - call assert_eol - ld a,(prefix_ixiy) - ld (iy+000h),a - ld (iy+001h),036h - ld (iy+002h),c - ld (iy+003h),l - ld c,004h - ret -l149ch: - ld b,a - call assert_comma - ld hl,t_HL.AF - call sub_0318h - jr c,l14c3h - call arg.IX_IY - jr nc,l14cch - ld a,b - cp 030h - jr nz,error6 - ld b,0f9h -l14b4h: - call assert_eol - ld a,(prefix_ixiy) - ld (iy+000h),a - ld (iy+001h),b - ld c,002h - ret -l14c3h: - ld a,b - cp 030h - jr nz,error6 - ld b,0f9h - jr as.opc.noarg ;14ca -l14cch: - ld a,(de) - cp '(' - jr nz,l14e8h - inc de - call test_expr - call test_paren_close - ld a,b - cp 020h - jr z,l14e3h - add a,04bh - ld b,a - jp l13c9h -l14e3h: - ld b,02ah - jp as.store_3 -l14e8h: - call test_expr - call assert_eol - ld a,001h - add a,b - ld b,a - jp as.store_3 -l14f5h: - call assert_comma - ld a,(de) - cp '(' - jr nz,l1509h - inc de - call test_expr - call test_paren_close - ld b,02ah - jp l1395h -l1509h: - call test_expr - ld b,021h - jp l1395h -l1511h: - inc de - call assert_comma - ld b,047h - jr l151fh -l1519h: - inc de - call assert_comma - ld b,04fh -l151fh: - ld a,(de) - inc de - cp 'A' - jr z,gen.opc.ED2 -error6: - jp ERROR - -l1528h: - cp 020h - jr nc,error6 - add a,002h - ld b,a - call test_paren_close - call assert_comma - ld a,(de) - cp 'A' - jr nz,error6 - inc de -as.opc.noarg: - call assert_eol - ld (iy+000h),b - ld c,001h - ret - -gen.opc.ED2: - call assert_eol - ld (iy+000h),0edh - ld (iy+001h),b - ld c,002h - ret - -as.ADC_SBC: - ld hl,t_HL.AF - call sub_0318h - jr nc,as.AND_CP_OR_SUB_XOR - call assert_comma - call arg.ww - jp nc,ERROR - push af - ld a,b - cp 088h - ld b,04ah - jr z,l156ch - ld b,042h -l156ch: - pop af - add a,b -l156eh: - ld b,a - jr gen.opc.ED2 -as.ADD: - ld hl,t_HL.AF - call sub_0318h - jr c,l159ah - call arg.IX_IY - jr nc,as.AND_CP_OR_SUB_XOR - call assert_comma - ld hl,t_BC.DE.IX.SP - ld a,(prefix_ixiy) - cp 0fdh - jr nz,l158eh - ld hl,t_BC.DE.IY.SP -l158eh: - call arg.reg_16bit - jp nc,ERROR - add a,009h -l1596h: - ld b,a - jp l14b4h -l159ah: - call assert_comma - call arg.ww - jp nc,ERROR - add a,009h - jp l13ech -as.AND_CP_OR_SUB_XOR: - ld a,(de) - cp 'A' - jr nz,l15b8h - push de - inc de - call next_arg - jr z,l15b7h - pop de - jr l15b8h -l15b7h: - pop af -l15b8h: - call arg.r_HL_A - jr c,l15cbh - call arg.IDX_displcmnt - jr c,l15cfh - call arg.imm_8bit - ld a,b - add a,046h - jp l143fh -l15cbh: - add a,b - jp l13ech -l15cfh: - ld a,b - add a,006h - jp l1400h - -as.SHIFTOP: - call arg.r_HL_A - jr c,l15fah - call arg.IDX_displcmnt - jp nc,ERROR - ld a,b - add a,006h - ld b,a -l15e4h: - call assert_eol - ld a,(prefix_ixiy) - ld (iy+000h),a - ld (iy+001h),0cbh - ld (iy+002h),c - ld (iy+003h),b - ld c,004h - ret - -l15fah: - add a,b -l15fbh: - ld b,a - call assert_eol - ld (iy+001h),b - ld (iy+000h),0cbh - ld c,002h - ret - -as.BITOP: - call arg.bit - call assert_comma - call arg.r_HL_A - jr c,l1624h - call arg.IDX_displcmnt - jp nc,ERROR - ld a,l - rlca - rlca - rlca - add a,006h - add a,b - ld b,a - jr l15e4h -l1624h: - add a,b - ld b,a - ld a,l - rlca - rlca - rlca - add a,b - jr l15fbh - -as.CALL: - push de - call arg.cc_ZCPS - jr nc,l163ch - add a,b - ld b,a - call next_arg - jr z,l163eh - pop de - push de -l163ch: - ld b,0cdh -l163eh: - pop af - call test_expr - jp as.store_3 - -as.RET: - call arg.cc_ZCPS - jr nc,l164eh - add a,b - ld b,a - jr l1650h -l164eh: - ld b,0c9h -l1650h: - jp as.opc.noarg - -as.JP: - push de - call arg.cc_ZCPS - jr c,l1666h -l1659h: - pop de - ld hl,l168ch - call sub_030ah - jr c,l1674h - ld b,0c3h - jr l166eh - -l1666h: - add a,b - ld b,a - call next_arg - jr nz,l1659h - pop af -l166eh: - call test_expr - jp as.store_3 -l1674h: - call assert_eol - ld a,b - and a - jr nz,l1680h - ld b,0e9h - jp as.opc.noarg -l1680h: - ld b,0ddh - dec a - jr z,l1687h - ld b,0fdh -l1687h: - ld l,0e9h - jp as.store_2 - -l168ch: - DC '(HL)' - DC '(IX)' - DC '(IY)' - DB 0 - -as.DJNZ: - call next_arg - ld b,010h - jr l16aeh -as.JR: - call arg.cc_ZC - jr c,l16a9h - ld b,018h - jr l16aeh -l16a9h: - add a,b - ld b,a - call assert_comma -l16aeh: - call arg.j_displ - jp as.store_2 - -as.IM: - call arg.imm_8bit - ld a,l - cp 003h - jr nc,error2 - and a - jr z,l16c7h - ld b,056h - cp 001h - jr z,l16c7h - ld b,05eh -l16c7h: - jp gen.opc.ED2 - -as.RST: - call arg.imm_8bit - ld a,l - push af - add a,b - ld b,a - pop af - and 0c7h - jr nz,error2 - jp as.opc.noarg - -as.POP_PUSH: - call arg.IX_IY - jr c,l16e7h - call arg.zz - jr nc,error2 - add a,b - jp l13ech -l16e7h: - ld a,b - add a,020h - jp l1596h - -as.IN: - call arg.r_HL_A - jr nc,error2 - cp 006h - jr z,error2 - rlca - rlca - rlca - add a,b - ld b,a - cp 078h - jr nz,l170fh - call assert_comma - call sub_171bh - jr c,l1715h - call arg.addr_8bit - ld b,0dbh - jp as.store_2 -l170fh: - call assert_comma - call sub_171bh -l1715h: - jp c,gen.opc.ED2 -error2: - jp ERROR - -sub_171bh: - ld hl,t__C_ - jp sub_0318h - -as.OUT: - call sub_171bh - jr nc,l1739h - call assert_comma - call arg.r_HL_A - jr nc,error2 - cp 006h - jr z,error2 - rlca - rlca - rlca - add a,b - jp l156eh - -l1739h: - call arg.addr_8bit - call assert_comma - cp 'A' - jr nz,error2 - inc de - ld b,0d3h - jp as.store_2 - -as.EX: - ld hl,b_176d_start - call sub_030ah - jp nc,ERROR - ld c,b - call assert_eol - ld b,000h - ld hl,l178eh - add hl,bc - add hl,bc - ld a,(hl) - ld (iy+000h),a - ld c,001h - inc hl - ld a,(hl) - and a - ret z - ld (iy+001h),a - ld c,002h - ret - -b_176d_start: - DC 'AF,AF''' -l1773h: - DC 'DE,HL' - DC '(SP),HL' - DC '(SP),IX' - DC '(SP),IY' - db 0 -l178eh: - db 008h,000h - db 0ebh,000h - db 0e3h,000h - db 0ddh,0e3h - db 0fdh,0e3h - -as.DEC_INC: - call arg.IX_IY - jr c,l17b3h - call arg.ww - jr c,l17bfh - call arg.r_HL_A - jr c,l17cch - call arg.IDX_displcmnt - jp nc,ERROR - ld a,b - add a,030h - jp l1400h -l17b3h: - ld a,b - ld b,023h - cp 004h - jr z,l17bch - ld b,02bh -l17bch: - jp l14b4h -l17bfh: - push af - ld a,b - ld b,003h - cp 004h - jr z,l17c9h - ld b,00bh -l17c9h: - pop af - jr l17cfh -l17cch: - rlca - rlca - rlca -l17cfh: - add a,b - jp l13ech - -arg.bit: - call arg.imm_8bit - ld a,l - cp 008h - jr nc,error3 - ret - -arg.j_displ: - call test_expr - push bc - push iy - pop bc - and a - sbc hl,bc - dec hl - dec hl - pop bc - call sub_1802h - ld a,h - xor l - bit 7,a - jr nz,error3 - ret - -arg.addr_8bit: - ld a,(de) - cp '(' - jr nz,arg.imm_8bit - inc de - call arg.imm_8bit - jp test_paren_close - -arg.imm_8bit: - call test_expr -sub_1802h: - ld a,h - and a - ret z - inc a - ret z - jr error3 - -test_expr: - push bc - call expr - pop bc - ret nc -error3: - jp ERROR - -arg.zz: - push hl - ld hl,t_BC.DE.HL.AF - jr l181fh - -arg.reg_16bit: - push hl - jr l181fh - -arg.ww: - push hl - ld hl,t_BC.DE.HL.SP -l181fh: - push bc - call sub_030ah - jr nc,l182bh - ld a,b - rlca - rlca - rlca - rlca - scf -l182bh: - pop bc - pop hl - ret - -arg.r_HL_A: - call skipbl - push bc - push hl - ld hl,t_BCDEHL_HL_A - call sub_030ah - ld a,b - pop hl - pop bc - ret - -arg.IX_IY: - push hl - push bc - ld hl,t_IX.IY - call sub_030ah - jr nc,l1852h - ld a,0ddh - dec b - jr nz,l184eh - ld a,0fdh -l184eh: - ld (prefix_ixiy),a - scf -l1852h: - pop bc - pop hl - ret - -arg.IDX_displcmnt: - push hl - push bc - ld a,(de) - cp '(' - jr nz,l18a1h - push de - inc de - ld hl,t_IX.IY - call sub_030ah - jr nc,l18a0h - pop af - ld a,0ddh - dec b - jr nz,l186eh - ld a,0fdh -l186eh: - ld (prefix_ixiy),a - ld a,(de) - cp '+' - jr z,l1882h - cp ')' - ld hl,0 - jr z,l189ah - cp '-' - jp nz,ERROR -l1882h: - push af - inc de - call arg.imm_8bit - pop af - cp '+' - jr z,l1894h - ld b,h - ld c,l - ld hl,0 - and a - sbc hl,bc -l1894h: - ld a,(de) - cp ')' - jp nz,ERROR -l189ah: - inc de - pop bc - ld c,l - pop hl - scf - ret -l18a0h: - pop de -l18a1h: - pop bc - pop hl - and a - ret - -arg.cc_ZCPS: - ld hl,t_tstfl_ZCPS - ld c,007h - jr l18b1h - -arg.cc_ZC: - ld hl,t_tstfl_ZC - ld c,003h -l18b1h: - push bc - call sub_030ah - ld a,b - pop bc - ret nc - and c - rlca - rlca - rlca - scf - ret +;------------------------------------------------------------------------------- +; > Wstartaddr endaddr +; Write a file to disk -assert_comma: - call next_arg - ret z -l18c2h: - jp ERROR +;cmd_W: -test_paren_close: - ld a,(de) - cp ')' - jr nz,l18c2h - inc de - ret +;------------------------------------------------------------------------------- +; > A [startaddr] +; Assemble Zilog Z180 mnemonics + +;cmd_A: + +;------------------------------------------------------------------------------- +; >>L [startaddr] [endaddr] +; List disassembled code cmd_L: - ld hl,cmd_L ld (cmd_rpt),hl call expr jr nc,l18dbh ld hl,(last_L) l18dbh: - push hl - pop iy call next_arg call get_range jr nc,l1905h @@ -4199,94 +2747,64 @@ l18dbh: ld b,16 l18ebh: push bc - push iy - pop hl - push hl - call p_disas_line - call crlf - pop iy - ld c,b - ld b,0 - add iy,bc - ld (last_L),iy + call cmdl_p_line pop bc djnz l18ebh ret + l1905h: call assert_eol - ld h,b - ld l,c - ld a,b - or c - jr nz,l190fh - dec hl + ld d,h + ld e,l + add hl,bc + ex de,hl l190fh: - push hl - push iy - pop hl - push hl - call p_disas_line - call crlf - pop iy - ld e,b - ld d,000h - add iy,de - ld (last_L),iy - pop hl - and a - sbc hl,de - ret z - ret c - jr l190fh + push de + call cmdl_p_line + pop de + call cp_hl_de + jr c,l190fh + ret -p_disas_line: - call out.hl.@ - call z,outbl - call outbl +;------------------------------------------------------------------------------- + +cmdl_p_line: + push hl + call out_hl + call outbl2 sub a ld (con_col),a + push hl + pop iy call p_disas_instr - and a - ret z - -l193fh: - call outbl - ld a,(con_col) - cp 16 - jr c,l193fh + call crlf + pop hl + ld c,b + ld b,0 + add hl,bc + ld (last_L),hl + ret -p_offset: - ld de,(var.@) - ld a,d - or e - ret z - call p_char_lparen - ld a,'@' - call outchar - and a - sbc hl,de - call out_hl - jp out_rparen +;------------------------------------------------------------------------------- p_disas_instr: - sub a - ld (l1ffdh),a call disas_get_instrlen jr nc,l197fh - push bc - call p_mnemonic - ex de,hl - call call_hl + push bc + ld a,(con_col) + add a,5 + ld c,a + call pstr ;print mnemonic + call p_goto_col + call pr_instr_args ;print arguments pop bc - ld a,(l1ffdh) - ld hl,(l1ffbh) scf ret l197fh: call pstr_inl DC '???' - ld b,001h + ld b,1 sub a ret @@ -4295,7 +2813,7 @@ disas_get_instrlen: ld (isprefix_ixiy),a ld a,(iy+000h) cp 0edh - jp z,disas_pfx.ED + jr z,disas_pfx.ED cp 0ddh jr z,l19abh cp 0fdh @@ -4303,8 +2821,8 @@ disas_get_instrlen: sub_19a0h: ld a,(iy+000h) cp 0cbh - jp z,disas_pfx.CB - jp disas_nopfx + jr z,disas_pfx.CB + jr disas_nopfx l19abh: ld a,1 jr l19b1h @@ -4322,6 +2840,83 @@ l19b1h: scf ret +;------------------------------------------------------------------------------- + +disas_nopfx: + ld hl,b_1b54_start ;2 byte opcodes + call lookup_op_arg + ld b,2 + ret c + ld hl,b_1ab6_start ;1 byte opcodes (no parameters) + call lookup_op + ld b,1 + ret c + ld hl,b_1ad1_start ;1 byte opcodes + call lookup_op_arg + ld b,1 + ret c + ld hl,b_1b9b_start ;3 byte opcodes + call lookup_op_arg + ld b,3 + ret + +;------------------------------------------------------------------------------- + +disas_pfx.ED: + inc iy + ld hl,l228bh + call lookup_op_arg + ld b,3 + ret c + ld hl,b_1c40_start + call lookup_op_arg + ld b,4 + ret c + + ld hl,b_1bc9_start ;1 byte opcode, no arguments + call lookup_op + jr c,da_ed1 + + ld hl,b_1bf4_start + call lookup_op_arg + ret nc + + ld a,e + cp a_noarg + jr nz,da_ed0 + ld c,(iy+0) + ld a,c + rra + and 0ch + ld b,a + ld a,c + and 03h + call str_sel_ab + +da_ed0: + scf +da_ed1: + ld b,2 + ret + +;------------------------------------------------------------------------------- + +disas_pfx.CB: + push iy + inc iy + ld a,(isprefix_ixiy) + and a + jr z,l1a42h + inc iy +l1a42h: + ld hl,b_1c55_start + call lookup_op_arg + pop iy + ld b,2 + ret + +;------------------------------------------------------------------------------- + disas_pfx.DDFD: inc iy ld hl,b_19ef_start @@ -4348,6 +2943,7 @@ l19edh: and a ret +;------------------------------------------------------------------------------- ; DD/FD 3 byte (ix+d)/(iy+d) b_19ef_start: db 034h @@ -4395,454 +2991,523 @@ l1a0ah: db 0f9h db 0 -disas_pfx.ED: - inc iy - ld hl,b_1bc9_start - call sub_1a72h - ld b,2 - ret c - ld hl,b_1bf4_start - call lookup_opc - ld b,2 - ret c - - ld hl,l228bh - call lookup_opc - ld b,3 - ret c - ld hl,b_1c40_start - call lookup_opc - ld b,4 - ret +;------------------------------------------------------------------------------- -disas_pfx.CB: - push iy - inc iy - ld a,(isprefix_ixiy) +test_DDFD: + ld a,(hl) and a - jr z,l1a42h - inc iy -l1a42h: - ld hl,b_1c55_start - call lookup_opc - pop iy - ld b,2 - ret - -disas_nopfx: - ld hl,b_1b54_start - call lookup_opc - ld b,2 - ret c - ld hl,b_1ab6_start - call sub_1a72h - ld b,1 - ret c - ld hl,b_1ad1_start - call lookup_opc - ld b,1 - ret c - ld hl,b_1b9b_start - call lookup_opc - ret nc - ld b,3 + ret z + inc hl + cp (iy+000h) + jr nz,test_DDFD + scf ret -sub_1a72h: +lookup_op: ld a,(hl) + inc hl cp 0ffh ret z cp (iy+000h) jr z,l1a7fh inc hl - inc hl - jr sub_1a72h + jr lookup_op l1a7fh: - inc hl - ld c,(hl) + ld b,(hl) + ld e,a_noarg + jr get_mnemonic + +lookup_op_arg: + call lookup_branch_op + ret nc + ld a,e + ld e,d + cp a,0ffh + ret z ;carry clear + ld b,a + +get_mnemonic: ld hl,t_MNEMONICS - ld b,0 - add hl,bc - ld de,l1c97h + bit 7,b + jr z,get_m1 + res 7,b + ld a,(iy+000h) + rra + rra + rra + and 07h +str_sel_ab: + add b + ld b,a +get_m1: + call str_sel scf ret -test_DDFD: +lookup_branch_op ;TODO ld a,(hl) and a ret z inc hl - cp (iy+000h) - jr nz,test_DDFD - scf - ret - -lookup_opc: - ld a,(iy+000h) - and (hl) - inc hl + and (iy+000h) cp (hl) - jr z,l1aa8h inc hl + jr z,l1aa8_br inc hl inc hl - inc hl - ld a,(hl) - and a - jr nz,lookup_opc - ret -l1aa8h: - inc hl - ld c,(hl) - inc hl + jr lookup_branch_op + +l1aa8_br: ld e,(hl) inc hl ld d,(hl) - ld hl,t_MNEMONICS - ld b,000h - add hl,bc scf ret +;------------------------------------------------------------------------------- ; 1 byte opcodes (no parameters) ; Format: db opcode, t_MNEMONICS-index b_1ab6_start: - db 076h,039h ;halt - db 0d9h,036h ;exx - db 0f3h,02ch ;di - db 0fbh,032h ;ei - db 000h,069h ;nop - db 007h,09eh ;rlca - db 00fh,0adh ;rrca - db 017h,098h ;rla - db 01fh,0a7h ;rra - db 027h,026h ;daa - db 02fh,023h ;cpl - db 037h,0bah ;scf - db 03fh,010h ;ccf + db 076h,i_HALT ;halt + db 0d9h,i_EXX ;exx + db 0f3h,i_DI ;di + db 0fbh,i_EI ;ei + db 000h,i_NOP ;nop +; db 007h,i_RLCA ;rlca +; db 00fh,i_RRCA ;rrca +; db 017h,i_RLA ;rla +; db 01fh,i_RRA ;rra +; db 027h,i_DAA ;daa +; db 02fh,i_CPL ;cpl +; db 037h,i_SCF ;scf +; db 03fh,i_CCF ;ccf + db 0c9h,i_RET ;ret db 0ffh -; 1 byte opcodes +; 1 byte opcodes ; Format: db mask, match, t_MNEMONICS-index -; dw argument formating fuction +; dw argument formating function b_1ad1_start: - db 0c0h,040h,056h ;ld r,r - dw p_arg_r_r - db 0f8h,080h,003h ;add a,r - dw p_arg_a_r - db 0f8h,088h,000h ;adc a,r - dw p_arg_a_r - db 0f8h,090h,0c9h ;sub r - dw p_arg_rs - db 0f8h,098h,0b7h ;sbc a,r - dw p_arg_a_r - db 0f8h,0a0h,006h ;and r - dw p_arg_rs - db 0f8h,0a8h,0cch ;xor r - dw p_arg_rs - db 0f8h,0b0h,06ch ;or r - dw p_arg_rs - db 0f8h,0b8h,013h ;cp r - dw p_arg_rs - db 0c7h,0c0h,08bh ;ret cc - dw p_arg_cc - db 0c7h,0c7h,0b4h ;rst - dw l1c98h - db 0ffh,0c9h,08bh ;ret - dw l1c97h - db 0cfh,0c1h,081h ;pop rr - dw p_arg_zz - db 0cfh,0c5h,084h ;push rr - dw p_arg_zz - db 0ffh,0e3h,034h ;ex (sp),hl - dw l1ca0h - db 0ffh,0e9h,052h ;jp (hl) - dw l1caeh - db 0ffh,0ebh,034h ;ex de,hl - dw p_arg_ex_dehl - db 0ffh,0f9h,056h ;ld sp,hl - dw l1cc1h - db 0cfh,003h,041h ;inc rr - dw p_arg_ww - db 0cfh,00bh,029h ;dec rr - dw p_arg_ww - db 0c7h,004h,041h ;inc r - dw p_arg_r - db 0c7h,005h,029h ;dec r - dw p_arg_r - db 0ffh,008h,034h ;ex af,af' - dw p_arg_ex_afaf - db 0cfh,009h,003h ;add hl,rr - dw l1cd3h - db 0efh,002h,056h ;ld (rr),a ;rr=bc,de - dw l1cdch - db 0efh,00ah,056h ;ld a,(rr) ;rr=bc,de - dw l1ce5h + db 0c0h,040h,i_LD ;ld r[y],r[z] + db a_rr + + db 0c0h,080h,i_ADD+080h ;add a,r[z] + db a_r + +; db 0f8h,080h,i_ADD ;add a,r[z] +; db a_ar +; db 0f8h,088h,i_ADC ;adc a,r[z] +; db a_ar +; db 0f8h,090h,i_SUB ;sub r[z] +; db a_r +; db 0f8h,098h,i_SBC ;sbc a,r[z] +; db a_ar +; db 0f8h,0a0h,i_AND ;and r[z] +; db a_r +; db 0f8h,0a8h,i_XOR ;xor r[z] +; db a_r +; db 0f8h,0b0h,i_OR ;or r[z] +; db a_r +; db 0f8h,0b8h,i_CP ;cp r[z] +; db a_r + + db 0c7h,0c0h,i_RET ;ret cc + db a_cc + db 0c7h,0c7h,i_RST ;rst + db a_rst + db 0cfh,0c1h,i_POP ;pop rp2 + db a_p2 + db 0cfh,0c5h,i_PUSH ;push rp2 + db a_p2 + db 0ffh,0e3h,i_EX ;ex (sp),hl + db a_esphl + db 0ffh,0e9h,i_JP ;jp (hl) + db a_hl + db 0ffh,0ebh,i_EX ;ex de,hl + db a_dehl + db 0ffh,0f9h,i_LD ;ld sp,hl + db a_lsphl + db 0cfh,003h,i_INC ;inc rp + db a_p + db 0cfh,00bh,i_DEC ;dec rp + db a_p + db 0c7h,004h,i_INC ;inc r[y] + db a_ry + db 0c7h,005h,i_DEC ;dec r[y] + db a_ry + db 0ffh,008h,i_EX ;ex af,af' + db a_eaf + db 0cfh,009h,i_ADD ;add hl,rp + db a_hlp + db 0efh,002h,i_LD ;ld (rp),a ;rp=bc,de + db a_pa + db 0efh,00ah,i_LD ;ld a,(rp) ;rp=bc,de + db a_ap + + db 0c7h,007h,i_RLCA+080h;rlca + db a_noarg + db 0 -; 2 byte opdodes +; 2 byte opcodes b_1b54_start: - db 0c7h,006h,056h ;ld r,nn - dw l1cfah - db 0ffh,0c6h,003h ;add a,nn - dw l1cf5h - db 0ffh,0ceh,000h ;adc a,nn - dw l1cf5h - db 0ffh,0d6h,0c9h ;sub a,nn - dw l1d09h - db 0ffh,0deh,0b7h ;sbc a,nn - dw l1cf5h - db 0ffh,0e6h,006h ;and a,nn - dw l1d09h - db 0ffh,0eeh,0cch ;xor nn - dw l1d09h - db 0ffh,0f6h,06ch ;or nn - dw l1d09h - db 0ffh,0feh,013h ;cp a,nn - dw l1d09h - db 0ffh,010h,02eh ;djnz - dw l1d1ah - db 0ffh,018h,054h ;jr - dw l1d1ah - db 0e7h,020h,054h ;jr,cc - dw l1d0fh - db 0ffh,0d3h,076h ;out (nn),a - dw l1d37h - db 0ffh,0dbh,03fh ;in a,(nn) - dw l1d29h + db 0c7h,006h,i_LD ;ld r[y],nn + db a_rn + + db 0c7h,0c6h,i_ADD+080h ;add a,r[z] + db a_n + +; db 0ffh,0c6h,i_ADD ;add a,nn +; db a_an +; db 0ffh,0ceh,i_ADC ;adc a,nn +; db a_an +; db 0ffh,0d6h,i_SUB ;sub nn +; db a_n +; db 0ffh,0deh,i_SBC ;sbc a,nn +; db a_an +; db 0ffh,0e6h,i_AND ;and nn +; db a_n +; db 0ffh,0eeh,i_XOR ;xor nn +; db a_n +; db 0ffh,0f6h,i_OR ;or nn +; db a_n +; db 0ffh,0feh,i_CP ;cp nn +; db a_n + + db 0ffh,010h,i_DJNZ ;djnz + db a_j + db 0ffh,018h,i_JR ;jr + db a_j + db 0e7h,020h,i_JR ;jr cc, + db a_ccj + db 0ffh,0d3h,i_OUT ;out (nn),a + db a_ma + db 0ffh,0dbh,i_IN ;in a,(nn) + db a_am db 0 -; 3 byte opcodes +; 3 byte opcodes b_1b9b_start: - db 0c7h,0c2h,052h ;jp cc,mn - dw p_arg_cc_mn - db 0c7h,0c4h,00ch ;call cc,mn - dw p_arg_cc_mn - db 0cfh,001h,056h ;ld ww,mn - dw p_arg_ww_mn - db 0ffh,0c3h,052h ;jp mn - dw p_arg_mn - db 0ffh,0cdh,00ch ;call mn - dw p_arg_mn - db 0ffh,022h,056h ;ld (mn),hl - dw p_arg_addr_hl - db 0ffh,02ah,056h ;ld hl,(mn) - dw p_arg_hl_addr - db 0ffh,032h,056h ;ld (mn),a - dw p_arg_addr_a - db 0ffh,03ah,056h ;ld a,(mn) - dw p_arg_a_addr + db 0c7h,0c2h,i_JP ;jp cc,mn + db a_ccnn + db 0c7h,0c4h,i_CALL ;call cc,mn + db a_ccnn + db 0cfh,001h,i_LD ;ld ww,mn + db a_rnn + db 0ffh,0c3h,i_JP ;jp mn + db a_nn + db 0ffh,0cdh,i_CALL ;call mn + db a_nn + db 0ffh,022h,i_LD ;ld (mn),hl + db a_mmhl + db 0ffh,02ah,i_LD ;ld hl,(mn) + db a_hlmm + db 0ffh,032h,i_LD ;ld (mn),a + db a_mma + db 0ffh,03ah,i_LD ;ld a,(mn) + db a_amm db 0 ; Prefix ED + 1 byte opcode, no arguments ; Format: opcode, t_MNEMONICS index b_1bc9_start: - db 044h,066h ;neg - db 045h,092h ;retn - db 04dh,08eh ;reti - db 067h,0b1h ;rrd - db 06fh,0a2h ;rld - db 0a0h,05fh ;ldi - db 0a1h,01ch ;cpi - db 0a2h,04bh ;ini - db 0a3h,07dh ;outi - db 0a8h,058h ;ldd - db 0a9h,015h ;cpd - db 0aah,044h ;ind - db 0abh,079h ;outd - db 0b0h,062h ;ldir - db 0b1h,01fh ;cpir - db 0b2h,04eh ;inir - db 0b3h,072h ;otir - db 0b8h,05bh ;lddr - db 0b9h,018h ;cpdr - db 0bah,047h ;indr - db 0bbh,06eh ;otdr - db 08bh,0d5h ;otdm - db 09bh,0d9h ;otdmr - db 083h,0deh ;otim - db 093h,0e2h ;otimr - db 076h,0ebh ;slp + db 044h,i_NEG ;neg + db 045h,i_RETN ;retn + db 04dh,i_RETI ;reti + db 067h,i_RRD ;rrd + db 06fh,i_RLD ;rld +; db 0a0h,i_LDI ;ldi +; db 0a1h,i_CPI ;cpi +; db 0a2h,i_INI ;ini +; db 0a3h,i_OUTI ;outi +; db 0a8h,i_LDD ;ldd +; db 0a9h,i_CPD ;cpd +; db 0aah,i_IND ;ind +; db 0abh,i_OUTD ;outd +; db 0b0h,i_LDIR ;ldir +; db 0b1h,i_CPIR ;cpir +; db 0b2h,i_INIR ;inir +; db 0b3h,i_OTIR ;otir +; db 0b8h,i_LDDR ;lddr +; db 0b9h,i_CPDR ;cpdr +; db 0bah,i_INDR ;indr +; db 0bbh,i_OTDR ;otdr + db 08bh,i_OTDM ;otdm + db 09bh,i_OTDMR ;otdmr + db 083h,i_OTIM ;otim + db 093h,i_OTIMR ;otimr + db 076h,i_SLP ;slp db 0ffh ; b_1bf4_start: - db 0e7h,040h,03fh ;in r,(c) ;r=b,c,d,e - dw p_arg_in_c ; - db 0f7h,060h,03fh ;in r,(c) ;r=h,l - dw p_arg_in_c ; - db 0ffh,078h,03fh ;in r,(c) ;r=a - dw p_arg_in_c ; - db 0e7h,041h,076h ;out (c),r ;r=b,c,d,e - dw p_arg_out_c ; - db 0f7h,061h,076h ;out (c),r ;r=h,l - dw p_arg_out_c ; - db 0ffh,079h,076h ;out (c),r ;r=a - dw p_arg_out_c ; - db 0cfh,042h,0b7h ;sbc hl,rr - dw l1dcah ; - db 0cfh,04ah,000h ;adc hl,rr - dw l1dcah ; - db 0ffh,046h,03dh ;im 0 - dw l1d85h ; - db 0ffh,056h,03dh ;im 1 - dw l1d89h ; - db 0ffh,05eh,03dh ;im 2 - dw l1d8dh ; - db 0ffh,047h,056h ;ld i,a - dw l1d92h ; - db 0ffh,057h,056h ;ld a,i - dw l1d97h ; - db 0ffh,04fh,056h ;ld r,a - dw l1d9ch ; - db 0ffh,05fh,056h ;ld a,r - dw l1da1h - db 0cfh,04ch,0d2h ;mlt rr - dw p_arg_ww - db 0c7h,004h,0eeh ;tst r - dw p_arg_r + db 0e4h,0a0h,i_LDI + db a_noarg + db 0ffh,070h,i_IN ;in (c) ; + db a_c + db 0c7h,040h,i_IN ;in r,(c) ;r=b,c,d,e,h,l,a + db a_rc + db 0ffh,071h,0ffh ;out (c),0 ; + db a_cr + db 0c7h,041h,i_OUT ;out (c),r ;r=b,c,d,e,h,l,a + db a_cr + db 0cfh,042h,i_SBC ;sbc hl,rp + db a_hlp + db 0cfh,04ah,i_ADC ;adc hl,rp + db a_hlp + db 0ffh,046h,i_IM ;im 0 + db a_im0 + db 0ffh,056h,i_IM ;im 1 + db a_im1 + db 0ffh,05eh,i_IM ;im 2 + db a_im2 + db 0e7h,047h,i_LD ;ld i,a ... ld a,r + db a_ai + db 0cfh,04ch,i_MLT ;mlt rr + db a_p + db 0c7h,004h,i_TST ;tst r + db a_ry db 0 l228bh: - db 0e7h,000h,0cfh ;in0 r,(m) ;r=b,c,d,e - dw p_arg_r_m - db 0f7h,020h,0cfh ;in0 r,(m) ;r=h,l - dw p_arg_r_m - db 0ffh,038h,0cfh ;in0 a,(m) - dw p_arg_r_m - db 0e7h,001h,0e7h ;out0 (m),r ;r=b,c,d,e - dw p_arg_m_r - db 0f7h,021h,0e7h ;out0 (m),r ;r=h,l - dw p_arg_m_r - db 0ffh,039h,0e7h ;out0 (m),a - dw p_arg_m_r - db 0ffh,064h,0eeh ;tst m - dw l1d09h - db 0ffh,074h,0f1h ;tstio m - dw l1d09h + db 0ffh,030h,i_IN0 ;in0 (m) + db a_m + db 0c7h,000h,i_IN0 ;in0 r,(m) ;r=b,c,d,e,h,l,a + db a_rm + db 0ffh,031h,0ffh ;out0 (m),0 + db a_mr + db 0c7h,001h,i_OUT0 ;out0 (m),r ;r=b,c,d,e + db a_mr + db 0ffh,064h,i_TST ;tst m + db a_n + db 0ffh,074h,i_TSTIO ;tstio m + db a_n db 0 +; Prefix ED + 1 byte opcode + 2 byte address +; Format: db mask, match, t_MNEMONICS-index +; dw argument formating function b_1c40_start: - db 0efh,043h,056h ;ld (mn),ww ;ww=bc,de - dw p_arg_addr_ww - db 0ffh,073h,056h ;ld (mn),sp - dw p_arg_addr_ww - db 0efh,04bh,056h ;ld ww,(mn) ;ww=bc,de - dw p_arg_ww_addr - db 0ffh,07bh,056h ;ld sp,(mn) - dw p_arg_ww_addr + db 0cfh,043h,i_LD ;ld (mn),ww ;ww=bc,de,hl,sp + db a_mmp + db 0cfh,04bh,i_LD ;ld ww,(mn) ;ww=bc,de,hl,sp + db a_pmm db 0 ; CB b_1c55_start: - db 0f8h,000h,09bh ;rlc g - dw l1e03h - db 0f8h,008h,0aah ;rrc g - dw l1e03h - db 0f8h,010h,096h ;rl g - dw l1e03h - db 0f8h,018h,0a5h ;rr g - dw l1e03h - db 0f8h,020h,0c0h ;sla g - dw l1e03h - db 0f8h,028h,0c3h ;sra g - dw l1e03h - db 0f8h,038h,0c6h ;srl g - dw l1e03h - db 0c0h,040h,009h ;bit b,g - dw p_arg_bitop - db 0c0h,080h,088h ;res b,g - dw p_arg_bitop - db 0c0h,0c0h,0bdh ;set b,g - dw p_arg_bitop + db 0c0h,000h,i_RLC+080h ;rlc g + db a_cbr + +; db 0f8h,000h,i_RLC ;rlc g +; db a_cbr +; db 0f8h,008h,i_RRC ;rrc g +; db a_cbr +; db 0f8h,010h,i_RL ;rl g +; db a_cbr +; db 0f8h,018h,i_RR ;rr g +; db a_cbr +; db 0f8h,020h,i_SLA ;sla g +; db a_cbr +; db 0f8h,028h,i_SRA ;sra g +; db a_cbr +; db 0f8h,038h,i_SRL ;srl g +; db a_cbr + db 0c0h,040h,i_BIT ;bit b,g + db a_bcbr + db 0c0h,080h,i_RES ;res b,g + db a_bcbr + db 0c0h,0c0h,i_SET ;set b,g + db a_bcbr db 0 -p_arg_r_r: - call p_arg_r - call p_char_comma - jp p_arg_rs -p_arg_a_r: - call p_A_comma - jp p_arg_rs -l1c97h: - ret +;------------------------------------------------------------------------------- +;------------------------------------------------------------------------------- -p_arg_r_m: - call p_arg_r - call p_char_comma - jp sub_1d2ch -p_arg_m_r: - call sub_1d2ch - call p_char_comma - jp p_arg_r +pr_instr_args: + ld hl,t_argf + ld d,0 + add hl,de +pria_l: + ld a,(hl) ;get next token + inc hl + or a + ret z ; + jp m,pria_1 + call outchar ;print as normal character + jr pria_l + +pria_1: ; + push hl + ld hl,do_arg_n + and 07fh + call add_hl_a2 + ld a,(hl) + inc hl + ld h,(hl) + ld l,a + ld a,(iy+000h) + call CALL_HL + pop hl + jr pria_l -l1c98h: - ld a,(iy+000h) - and 038h - jp out_hex +; +; http://www.z80.info/decoding.htm +; +; | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | +; | x | y | z | +; | p | q | +; + +t_argf: +; 1 byte opcodes +a_rr equ $-t_argf + db fi_ry,',' ;ld r[y],r[z] +a_r equ $-t_argf + db fi_rz,0 ;op r[z] +;a_ar equ $-t_argf +; db 'A,',fi_rz,0 ;op A,r[z] +a_cc equ $-t_argf + db fi_ccy,0 ;op cc[y] +a_rst equ $-t_argf + db fi_rst,0 ;rst y*8 +a_p2 equ $-t_argf + db fi_rp2,0 ;rp2[p] +a_esphl equ $-t_argf + db '(SP),',fi_hlixiy,0 ;ex (sp),hl +a_hl equ $-t_argf + db '(',fi_hlixiy,')',0 ;jp (hl) +a_dehl equ $-t_argf + db 'DE,HL',0 +a_lsphl equ $-t_argf + db 'SP,',fi_hlixiy,0 ;ld SP,HL +a_eaf equ $-t_argf + db 'AF,AF''',0 ;ex af,af' +a_hlp equ $-t_argf + db fi_hlixiy,',' ;add hl,rp +a_p equ $-t_argf + db fi_rp,0 ;rp[p] +a_pa equ $-t_argf + db '(',fi_rp,'),A',0 ;ld (rp),a ;rp=bc,de +a_ap equ $-t_argf + db 'A,(',fi_rp,')',0 ;ld a,(rp) ;rp=bc,de + +; 2 byte opcodes +a_rn equ $-t_argf + db fi_ry,',',fi_n,0 ;ld r[y],n +;a_an equ $-t_argf +; db 'A,' ;op a,n +a_n equ $-t_argf + db fi_n,0 ;op n +a_ccj equ $-t_argf + db fi_ccy2,',' ;jr cc,j ;cc = nz,z,nc,c +a_j equ $-t_argf + db fi_j,0 ;jr j +a_ma equ $-t_argf + db '(',fi_n,'),A',0 ;out (n),a +a_am equ $-t_argf + db 'A,(',fi_n,')',0 ;in a,(n) + +; 3 byte opcodes +a_ccnn equ $-t_argf + db fi_ccy,',',fi_nn,0 ;op cc[y],nn +a_rnn equ $-t_argf + db fi_rp,',' ;ld rp[p],nn +a_nn equ $-t_argf + db fi_nn,0 ;jp nn +a_mmhl equ $-t_argf + db '(',fi_nn,'),',fi_hlixiy,0 ;ld (nn),hl +a_hlmm equ $-t_argf + db fi_hlixiy,',(',fi_nn,')',0 ;ld hl,(nn) +a_mma equ $-t_argf + db '(',fi_nn,'),A',0 ;ld (nn),a +a_amm equ $-t_argf + db 'A,(',fi_nn,')',0 ;ld a,(nn) + +; Prefix ED + 1 byte opcode +a_rc equ $-t_argf + db fi_ry,',' ;in r[y],(c) +a_c equ $-t_argf + db '(C)',0 ;in (c) +a_cr equ $-t_argf + db '(C),' ;out (c),r[y] +a_ry equ $-t_argf + db fi_ry,0 ;inc r[y] +a_im0 equ $-t_argf + db '0',0 ;im 0 +a_im1 equ $-t_argf + db '1',0 ;im 1 +a_im2 equ $-t_argf + db '2',0 ;im 2 +a_ai equ $-t_argf + db fi_ir,0 ;ld a,i ... r,a + +; Prefix ED + 2 byte (opcode + immediate) +a_rm equ $-t_argf + db fi_ry,',' ;in0 r[y],(n) +a_m equ $-t_argf + db '(',fi_n,')',0 ;in0 (n) +a_mr equ $-t_argf + db '(',fi_n,'),',fi_ry,0 ;out0 (n),r[y] + +; Prefix ED + 3 byte (opcode + address) +a_mmp equ $-t_argf + db '(',fi_nn,'),',fi_rp,0 ;ld (nn),rp +a_pmm equ $-t_argf + db fi_rp,',(',fi_nn,')',0 ;ld rp,(nn) + +; Prefix CB + 1 byte opcode +a_bcbr equ $-t_argf + db fi_y,',' ;op y,r[z] +a_cbr equ $-t_argf + db fi_rz_cb,0 ;op r[z] +a_noarg equ $-t_argf + db 0 -l1ca0h: - call pstr_inl - DC '(SP),' - jp p_arg_hlixiy -l1caeh: - call p_char_lparen - call p_arg_hlixiy - jr out_rparen +;------------------------------------------------------------------------------- -p_arg_ex_dehl: - ld hl,l1773h - jp pstr +argpf_index defl 0 -l1cc1h: - call pstr_inl - DC 'SP,' - jp p_arg_hlixiy - -p_arg_ex_afaf: - ld hl,b_176d_start - jp pstr - -l1cd3h: - call p_arg_hlixiy - call p_char_comma - jp p_arg_ww -l1cdch: - call sub_1ce8h - call p_char_comma - jp p_char_A - -l1ce5h: - call p_A_comma -sub_1ce8h: - call p_char_lparen - call p_arg_ww -out_rparen: - jp p_char_rparen - -l1cf5h: - call p_A_comma - jr l1d09h -l1cfah: - call p_arg_r - call p_char_comma +argpf macro x +fi_&x equ 80h+argpf_index + dw p_&x +argpf_index defl argpf_index+1 + endm + +do_arg_n: + argpf ry + argpf rz + argpf ccy + argpf ccy2 + argpf rst + argpf rp + argpf rp2 + argpf hlixiy + argpf n + argpf j + argpf nn + argpf ir + argpf rz_cb + argpf y + + +p_n: ld a,(isprefix_ixiy) and a - ld a,(iy+002h) - jr nz,l1d0ch -l1d09h: ld a,(iy+001h) -l1d0ch: + jr z,out_hex_0 + ld a,(iy+002h) + jr out_hex_0 + +p_rst: + and 038h +out_hex_0: jp out_hex -l1d0fh: - ld a,(iy+000h) - and 018h - call p_arg_cc0 - call p_char_comma -l1d1ah: + +p_j: ld c,(iy+001h) ld a,c rla @@ -4853,335 +3518,230 @@ l1d1ah: add hl,bc inc hl inc hl - jr l1d4eh -l1d29h: - call p_A_comma -sub_1d2ch: - call p_char_lparen - ld a,(iy+001h) - jp l1e6bh -l1d37h: - call sub_1d2ch - jr p_char_comma_A - -p_arg_cc_mn: - call p_arg_cc - call p_char_comma -p_arg_mn: + jr out_hl_0 + +p_nn: ld l,(iy+001h) ld h,(iy+002h) -l1d4eh: - ld a,002h -sub_1d50h: - ld (l1ffdh),a - ld (l1ffbh),hl - call out_hl - ret -p_arg_ww_mn: - call p_arg_ww - call p_char_comma - jr p_arg_mn - -p_arg_addr_hl: - call sub_1e13h - call p_char_comma - jp p_arg_hlixiy -p_arg_hl_addr: - call p_arg_hlixiy - call p_char_comma - jp sub_1e13h - -p_arg_addr_a: - call sub_1e13h -p_char_comma_A: - call p_char_comma -p_char_A: - ld a,'A' - jr outchar1 -p_arg_a_addr: - call p_A_comma - jp sub_1e13h -l1d85h: - ld a,'0' - jr outchar1 -l1d89h: - ld a,'1' - jr outchar1 -l1d8dh: - ld a,'2' - jr outchar1 - -p_A_comma: - call p_char_A -p_char_comma: - ld a,',' -outchar1: - jp outchar - -l1d92h: - ld hl,b_1da7_start - jr l1da4h -l1d97h: - ld hl,l1daah - jr l1da4h -l1d9ch: - ld hl,l1dadh - jr l1da4h -l1da1h: - ld hl,l1db0h -l1da4h: - jp pstr - -b_1da7_start: - DC 'I,A' -l1daah: - DC 'A,I' -l1dadh: - DC 'R,A' -l1db0h: - DC 'A,R' +out_hl_0: + jp out_hl -p_arg_in_c: - call p_arg_r - call p_char_comma - ld hl,t__C_ - jp pstr - -p_arg_out_c: - ld hl,t__C_ - call pstr - call p_char_comma - jr p_arg_r - -l1dcah: - call p_arg_hlixiy - call p_char_comma - jp p_arg_ww - -p_arg_addr_ww: - call sub_1e13h - call p_char_comma - jp p_arg_ww - -p_arg_ww_addr: - call p_arg_ww - call p_char_comma - jr sub_1e13h - -p_arg_bitop: - ld a,(isprefix_ixiy) - and a - jr nz,l1defh - ld a,(iy+001h) - jr l1df2h -l1defh: - ld a,(iy+002h) -l1df2h: - push af - rra +p_ir: rra - rra - and 007h - add a,'0' - call outchar - call p_char_comma - pop af - jr p_arg_r0 + rra + rra + and 03 + ld hl,t_arg_IR + jr p_arg + -l1e03h: +get_cb_opc: ld a,(isprefix_ixiy) and a - jr nz,l1e0eh ld a,(iy+001h) - jr l1e11h -l1e0eh: + ret z ld a,(iy+002h) -l1e11h: - jr p_arg_r0 + ret -sub_1e13h: - call p_char_lparen - ld l,(iy+001h) - ld h,(iy+002h) - ld a,001h - call sub_1d50h +p_y: + call get_cb_opc + rra + rra + rra + and 007h + jp out_dgt -p_char_rparen: - ld a,')' - jp outchar +p_rz_cb: + call get_cb_opc + jr p_rz -p_arg_r: - ld a,(iy+000h) +p_ry: rra rra rra - jr p_arg_r0 -p_arg_rs: - ld a,(iy+000h) -p_arg_r0: +p_rz: and 007h cp 006h - jr nz,p_arg_r1 + ld b,a + ld hl,t_arg_r + jr nz,p_arg0 ld a,(isprefix_ixiy) and a - ld a,006h - jr z,p_arg_r1 - ld hl,b_1e78_start - ld a,(isprefix_ixiy) + jr z,p_arg0 + ld hl,t_lp_IXIY dec a - jr z,l1e4dh - ld hl,l1e7bh -l1e4dh: - call pstr + call p_arg ld a,(iy+001h) - and a - jp m,l1e61h + push af + rlca ld a,'+' - call outchar - ld a,(iy+001h) - jr l1e6bh -l1e61h: + jr nc,l1e61h + pop af + neg + push af ld a,'-' +l1e61h: call outchar - ld a,(iy+001h) - neg -l1e6bh: + pop af call out_hex - jr p_char_rparen - -p_arg_r1: - ld hl,t_BCDEHL_HL_A - jr p_arg - -b_1e78_start: - DC '(IX' -l1e7bh: - DC '(IY' + ld a,')' + jp outchar -p_arg_hlixiy: - ld a,(isprefix_ixiy) - ld hl,t_HL.IX.IY - jr p_arg -p_arg_zz: - ld hl,t_BC.DE.HL.AF - jr l1e8eh -p_arg_ww: - ld hl,t_BC.DE.HL.SP -l1e8eh: - ld a,(iy+000h) +p_rp2: + ld hl,t_arg_rp2 + db 0ddh ;swallow t_arg_rp in ix +p_rp: + ld hl,t_arg_rp rra rra rra rra and 003h cp 002h - jr z,p_arg_hlixiy + jr nz,p_arg +p_hlixiy: + ld a,(isprefix_ixiy) + ld hl,t_HL.IX.IY jr p_arg -p_arg_cc: - ld a,(iy+000h) -p_arg_cc0: +p_ccy2: + and 018h +p_ccy: rra rra rra and 007h - ld hl,t_tstfl_ZCPS + ld hl,t_arg_cc p_arg: ld b,a - call sel_dc_string - jp pstr +p_arg0: + ;fall thru -p_mnemonic: - call pstr -l1ebch: - call outbl - inc c - ld a,c - cp 5 - jr c,l1ebch +pstr_sel: + call str_sel + ;fall thru +pstr: + ld a,(hl) + inc hl + and a + ret z + call outchar + ret m + jr pstr + +pstr_inl: + ex (sp),hl + call pstr + ex (sp),hl ret +;------------------------------------------------------------------------------- + +opc macro x + +i_&x equ opc_index +;o_&x equ $-opc_tabstart + dc '&x' +opc_index defl opc_index+1 + endm + t_MNEMONICS: - DC 'ADC' - DC 'ADD' - DC 'AND' - DC 'BIT' - DC 'CALL' - DC 'CCF' - DC 'CP' - DC 'CPD' - DC 'CPDR' - DC 'CPI' - DC 'CPIR' - DC 'CPL' - DC 'DAA' - DC 'DEC' - DC 'DI' - DC 'DJNZ' - DC 'EI' - DC 'EX' - DC 'EXX' - DC 'HALT' - DC 'IM' - DC 'IN' - DC 'INC' - DC 'IND' - DC 'INDR' - DC 'INI' - DC 'INIR' - DC 'JP' - DC 'JR' - DC 'LD' - DC 'LDD' - DC 'LDDR' - DC 'LDI' - DC 'LDIR' - DC 'NEG' - DC 'NOP' - DC 'OR' - DC 'OTDR' - DC 'OTIR' - DC 'OUT' - DC 'OUTD' - DC 'OUTI' - DC 'POP' - DC 'PUSH' - DC 'RES' - DC 'RET' - DC 'RETI' - DC 'RETN' - DC 'RL' - DC 'RLA' - DC 'RLC' - DC 'RLCA' - DC 'RLD' - DC 'RR' - DC 'RRA' - DC 'RRC' - DC 'RRCA' - DC 'RRD' - DC 'RST' - DC 'SBC' - DC 'SCF' - DC 'SET' - DC 'SLA' - DC 'SRA' - DC 'SRL' - DC 'SUB' - DC 'XOR' - DC 'IN0' - DC 'MLT' - DC 'OTDM' - DC 'OTDMR' - DC 'OTIM' - DC 'OTIMR' - DC 'OUT0' - DC 'SLP' - DC 'TST' - DC 'TSTIO' +;opc_tabstart defl $ +opc_index defl 0 +; 1-byte other + opc NOP + opc LD + opc INC + opc DEC + opc DJNZ + opc JR + opc HALT + + opc RLCA + opc RRCA + opc RLA + opc RRA + opc DAA + opc CPL + opc SCF + opc CCF + +; 1-byte "alu" + opc ADD + opc ADC + opc SUB + opc SBC + opc AND + opc XOR + opc OR + opc CP + + opc RET + opc POP + opc JP + opc CALL + opc PUSH + opc RST + opc OUT + opc EXX + opc IN + opc EX + opc DI + opc EI +; CB + opc RLC + opc RRC + opc RL + opc RR + opc SLA + opc SRA + opc SLL + opc SRL + opc BIT + opc RES + opc SET + +; ED + opc NEG + opc RETN + opc RETI + opc IM + opc RRD + opc RLD + +; Block instructions + opc LDI + opc CPI + opc INI + opc OUTI + opc LDD + opc CPD + opc IND + opc OUTD + opc LDIR + opc CPIR + opc INIR + opc OTIR + opc LDDR + opc CPDR + opc INDR + opc OTDR + +; Z180 + opc IN0 + opc OUT0 + opc TST + opc MLT + opc TSTIO + opc SLP + opc OTIM + opc OTDM + opc OTIMR + opc OTDMR + DB 0 -t_BCDEHL_HL_A: +t_arg_r: DC 'B' DC 'C' DC 'D' @@ -5191,48 +3751,24 @@ t_BCDEHL_HL_A: DC '(HL)' DC 'A' DB 0 -t_BC.DE.HL.SP: +t_arg_rp: DC 'BC' DC 'DE' DC 'HL' DC 'SP' DB 0 -t_BC.DE.HL.AF: +t_arg_rp2: DC 'BC' DC 'DE' -t_HL.AF: DC 'HL' DC 'AF' DB 0 -t_BC.DE.IY.SP: - DC 'BC' - DC 'DE' - DC 'IY' - DC 'SP' - DB 0 -t_BC.DE.IX.SP: - DC 'BC' - DC 'DE' - DC 'IX' - DC 'SP' - DB 0 t_HL.IX.IY: DC 'HL' -t_IX.IY: DC 'IX' DC 'IY' DB 0 -t_tstfl_ZC: - DC 'NZ' - DC 'Z' - DC 'NC' - DC 'C' - DC 'NE' - DC 'EQ' - DC 'GE' - DC 'LT' - DB 0 -t_tstfl_ZCPS: +t_arg_cc: DC 'NZ' DC 'Z' DC 'NC' @@ -5241,18 +3777,23 @@ t_tstfl_ZCPS: DC 'PE' DC 'P' DC 'M' - DC 'NE' - DC 'EQ' - DC 'GE' - DC 'LT' - DC 'NV' - DC 'V' - DB 0 -t__C_: - DC '(C)' DB 0 -sub_1ffeh: +t_lp_IXIY: + DC '(IX' + DC '(IY' + +t_arg_IR: + DC 'I,A' + DC 'R,A' + DC 'A,I' + DC 'A,R' + db 0 + + +;------------------------------------------------------------------------------- + +tc_set_bp: ld hl,(reg.pc) ld a,h or l @@ -5260,74 +3801,74 @@ sub_1ffeh: ld de,BDOS and a sbc hl,de - ld hl,l20edh + ld hl,l20edh ;set break after BDOS call jr z,l2031h ld iy,(reg.pc) call disas_get_instrlen jp nc,ERROR ld c,b - ld b,000h + ld b,0 ld hl,(reg.pc) add hl,bc - call sub_09cah + call bp_trace_enter ld iy,(reg.pc) - ld hl,b_2039_start - call lookup_opc + ld hl,t_op_branch + call lookup_branch_op ccf ret c ex de,hl l2031h: call CALL_HL - call c,sub_09cah + call c,bp_trace_enter l2037h: scf ret -b_2039_start: - db 0ffh,0ddh,000h ;Prefix DD +;------------------------------------------------------------------------------- + +t_op_branch: + db 0ffh,0ddh ;Prefix DD dw l20a7h - db 0ffh,0fdh,000h ;Prefix FD + db 0ffh,0fdh ;Prefix FD dw l20ach - db 0ffh,0edh,000h ;Prefix ED + db 0ffh,0edh ;Prefix ED dw l20b8h -b_2048_start: - db 0ffh,0cdh,000h ;call mn + db 0ffh,0cdh ;call mn dw l2080h - db 0ffh,0c3h,000h ;jp mn + db 0ffh,0c3h ;jp mn dw l208bh - db 0ffh,0e9h,000h ;jp () + db 0ffh,0e9h ;jp () dw l20a2h - db 0ffh,0c9h,000h ;ret + db 0ffh,0c9h ;ret dw l20dch - db 0ffh,0cfh,000h ;rst 8 + db 0ffh,0cfh ;rst 8 dw l2115h - db 0c7h,0c7h,000h ; + db 0c7h,0c7h ;rst n dw l20f9h - db 0c7h,0c4h,000h ; + db 0c7h,0c4h ;call cc,mn dw l2080h - db 0f7h,010h,000h ; + db 0f7h,010h ;djnz d; jr d dw l2093h - db 0e7h,020h,000h ; + db 0e7h,020h ;jr cc,d dw l2093h - db 0c7h,0c2h,000h ; + db 0c7h,0c2h ;jp cc,mn dw l208bh - db 0c7h,0c0h,000h ; + db 0c7h,0c0h ;ret cc dw l20c5h db 0 +;------------------------------------------------------------------------------- +; call mn call cc,mn l2080h: - ld a,(b_21e2_start) - and a - jr nz,l208bh - ld a,(trace_call_flag) - and a - ret nz + +; jp mn jp cc,mn l208bh: ld l,(iy+001h) ld h,(iy+002h) scf ret + l2093h: ld c,(iy+001h) ld a,c @@ -5340,27 +3881,34 @@ l2093h: inc hl scf ret + +; jp (hl) l20a2h: ld hl,(reg.l) scf ret + +; Prefix DD l20a7h: ld hl,(reg.ix) jr l20afh +; Prefix FD l20ach: ld hl,(reg.iy) l20afh: ld a,(iy+001h) - cp 0e9h + cp 0e9h ; jp (ix); jp (iy) scf ret z and a ret + +; Prefix ED l20b8h: ld a,(iy+001h) - cp 04dh + cp 04dh ; reti jr z,l20dch - cp 045h + cp 045h ; retn jr z,l20dch and a ret @@ -5382,22 +3930,14 @@ l20d7h: jp (hl) l20dch: - ld a,(b_21e2_start) - and a - jr nz,l20edh - ld a,(trace_call_flag) - and a - jr z,l20edh - call l20edh - pop hl - ret l20edh: - ld hl,(reg_sp) + ld hl,(reg_sp) ;break on return address ld e,(hl) inc hl ld d,(hl) ex de,hl - call sub_09cah + call bp_trace_enter +l2115h: and a ret @@ -5411,152 +3951,62 @@ l20f9h: ld h,000h ld a,(b_21e2_start) and a - jr nz,l2113h - ld a,(trace_call_flag) - and a - ret nz -l2113h: + ret z scf ret -l2115h: - and a - ret -cmd_C: - ld hl,cmd_C - ld a,001h - jr l2122h + +;------------------------------------------------------------------------------- +; >>C[N][J] [steps] +; >>C[N][J] W expression +; >>C[N][J] U expression +; trace over Calls [No list] [Jumps only] /.While./.Until. + + +;------------------------------------------------------------------------------- +; >>T[N][J] [steps] +; >>T[N][J] W expression +; >>T[N][J] U expression +; Trace [no List] [Jumps only] / .While. / .Until. + cmd_T: - xor a - ld hl,cmd_T -l2122h: ld (cmd_rpt),hl - ld (trace_call_flag),a - ld a,(de) - sub 'N' - jr nz,l212eh - inc de -l212eh: - ld (trace_N_flag),a - ld a,(de) - sub 'J' - jr nz,l2137h - inc de -l2137h: - ld (trace_J_flag),a - call sub_21a6h - jr z,l2145h - ld hl,1 + ld hl,1 ;default: 1 step call get_lastarg_def -l2145h: - ld (trace_count),hl + ld (trace_cnt_or_ptr),hl sub a - ld (l0941h),a -l214ch: - call sub_1ffeh - jr l21a3h + ld (bp_p_cpu_flag),a + call tc_set_bp + jr user_go1 l2151h: call bp_clr_temporary - ld a,(trace_J_flag) - and a - jr nz,l216bh - ld iy,(reg.pc) - call sub_21c8h - jr z,l216bh - ld hl,b_2048_start - call lookup_opc - jr nc,l214ch -l216bh: - ld a,(trace_UW_flag) - and a - jr z,l2188h - ld de,(trace_count) - call expr - ld a,h - or l - add a,0ffh - sbc a,a - ld hl,trace_UW_flag - xor (hl) - bit 1,a - jr z,l2193h -l2185h: - jp l0902h -l2188h: - ld hl,(trace_count) + ld hl,(trace_cnt_or_ptr) dec hl - ld (trace_count),hl + ld (trace_cnt_or_ptr),hl ld a,h or l - jr z,l2185h -l2193h: - call sub_1ffeh - jr nc,l2185h - ld a,(trace_N_flag) - ld b,a - ld a,(l0941h) - or b - ld (l0941h),a -l21a3h: - jp user_go + jp z,do_break -sub_21a6h: - call skipbl - xor a - ld (trace_UW_flag),a - ld a,(de) - cp 'U' - jr z,l21b5h - cp 'W' - ret nz -l21b5h: - inc de - push af - push de - call expr - jp c,ERROR - call assert_eol - pop hl - pop af - ld (trace_UW_flag),a - sub a - ret + call tc_set_bp + jp nc,do_break + sbc a,a + ld (bp_p_cpu_flag),a +user_go1: + jp user_go -sub_21c8h: - ld a,(iy+000h) - cp 0edh - jr z,l21dah - and 0dfh - cp 0ddh - ret nz - ld a,(iy+001h) - cp 0e9h - ret -l21dah: - ld a,(iy+001h) - and 0f7h - cp 045h - ret +;------------------------------------------------------------------------------- -b_21e2_start: +con_col: db 0 -trace_call_flag: - db 0 ;1=call, 0=trace -trace_UW_flag: - db 0 ;0 or 'U' or 'W' -trace_count: - dw 0 -trace_N_flag: - db 0 ;0 if 'N' -trace_J_flag: - db 0 ;0 if 'J' ;------------------------------------------------------------------------------- -con_col: +b_21e2_start: db 0 +trace_cnt_or_ptr: + dw 0 -l0941h: +bp_p_cpu_flag: db 0 bp_tab: @@ -5566,102 +4016,7 @@ bp_tab: endm endm -expr_p1: - dw expr_buf -expr_p2: - dw expr_buf - -expr_buf: -current_cseg defl $ - current_cseg - .phase current_phase + current_cseg - -start: - LD SP,ldr_end+(stack-ddtz_base) - LD DE,signon ;ldr_end+(expr_buf-ddtz_base) - LD C,BDOS_PSTR - CALL BDOS - - xor a - dec a - jp po,reloc - ld de,msgz80 - LD C,BDOS_PSTR - CALL BDOS - jp 0 - -reloc: - LD HL,ldr_end+ddtz_size ;start of reloc bitmap - ld bc,0108h ;init bit counter - - EXX - LD HL,(BDOS+1) - LD (ldr_end+(ddtz_bdos+1-ddtz_base)),HL - LD BC,ddtz_size-1 - LD D,B - LD E,0FFH - INC DE ;size rounded up to next page boundary - INC BC ;ddtz_size - OR A - SBC HL,DE ;BDOS - size - LD (BDOS+1),HL ;-> new BDOS entry - - push hl - PUSH BC - ld de,ldr_end - sbc hl,de - EX DE,HL ;-> DE - LD HL,ldr_size - add hl,bc - ld b,h - ld c,l - LD HL,TPA -reloc_lp: - EXX - djnz reloc_nl - ld b,c ;reload bit counter - LD e,(HL) ;get next 8 relocation bits - INC HL -reloc_nl: - sla e - EXX - JR NC,reloc_next - DEC HL - LD A,(HL) - ADD A,E - LD (HL),A - INC HL - LD A,(HL) - ADC A,D - LD (HL),A -reloc_next: - cpi - jp pe,reloc_lp - dec hl - - POP BC - pop de - EX DE,HL - ADD HL,BC - EX DE,HL - DEC DE - LDDR - LD HL,conbuf+2-ddtz_base - ADD HL,DE - JP (HL) - -current_phase defl $ - .dephase -current_cseg defl $ - - ds EXPR_BUF_SIZE - ($ - expr_buf) -expr_bufe: - -msg_Y: - dc 'Yn' -reg_Y: - rept YREG_CNT - dw 0 - endm +;------------------------------------------------------------------------------- last_S: dw TPA @@ -5674,45 +4029,68 @@ last_O_addr: last_O_val: db 0 -cmd_Q_jopt: - db -1 - last_D: dw TPA -cmdR_rindex: - db 0 - high_load: dw TPA max_load: dw TPA -l1262h: - dw 0 -last_A: - dw TPA -cmd_A_prev: - dw TPA - -prefix_ixiy: - db 0 - isprefix_ixiy: db 0 last_L: dw TPA -l1ffbh: - dw 0 -l1ffdh: - db 0 -cur_fcb: +pbl_loop_adr: + dw 0addeh + +bitmap_end: dw 0 -fcbsym: - ds 33 + +;------------------------------------------------------------------------------- + +conbuf: + ds CONBUF_SIZE+1 + +;------------------------------------------------------------------------------- + + rept (STACK_SIZE+3)/4 + db 0deh,0adh,0beh,0efh + endm +stack: +reg.l2: db 000h +reg.h2: db 000h +reg.e2: db 000h +reg.d2: db 000h +reg.c2: db 000h +reg.b2: db 000h +reg.f2: db 000h +reg.a2: db 000h + db 000h +reg.i: db 000h +reg.iy: dw 0000h +reg.ix: dw 0000h +reg.f: db 000h +reg.a: db 000h +reg.c: db 000h +reg.b: db 000h +reg.e: db 000h +reg.d: db 000h +reg.l: db 000h +reg.h: db 000h +reg_sp: dw TPA +reg.iff: + db 0f3h + db 0c3h +reg.pc: dw TPA + +cmd_rpt:dw mainloop + db 0ffh,0ffh,0ffh +;------------------------------------------------------------------------------- ddtz_size equ $-ddtz_base +prog_size equ $-start ddtz_end: ;-------------------------------------------------------------------------------