; Disassembled ddtz.com, version "DDT/Z [8101]" ; with modified relocater. ; ; Build steps: ; - Assemble to a .REL file with M80 or a compatible assembler. ; - 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. ; Some greneral definitions 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 TPA equ 0100h ; ddtz specific definitions STACK_SIZE equ 80 ;ddtz internal stack CONBUF_SIZE equ 80 ;Size of console input buffer BP_CNT equ 12 ;Number of breakpoints BP_SIZE equ 4 ;Size of a breakpoint record bitmap_size equ (prog_size+7)/8 ;------------------------------------------------------------------------------- cseg start:: ddtz_base:: jr reloc nop l0003h: rst 30h ;rst used by ddtz di_or_ei: ;ints enabled/disabled while ddtz is running nop ret convec: const: jp cist ; return console input status conin: jp ci ; return console input character conout: jp co ; send console output character ;------------------------------------------------------------------------------- signon: db 'DDTZ/180' db ' - Version ' maclib version.inc defvers dc ' (' ;------------------------------------------------------------------------------- ; Clear old position cmde_clr: ld (hl),0 inc hl dec bc ld a,b or c jr nz,cmde_clr ; Determine current position 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 pop hl ld bc,0108h ;init bit counter b (c==reload val) exx LD HL,ddtz_base add hl,de ;--> ddtz_base ld bc,prog_size 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: inc hl dec bc ld a,b or c jr nz,reloc_lp ;------------------------------------------------------------------------------- init:: LD SP,stack 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 ld hl,signon call pstr ld hl,ddtz_base call out_hl call pstr_inl dc ' - ' ld de,prog_size+bitmap_size-1 add hl,de 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 di_or_ei ld hl,ddtz_base ld l,000h ld (reg_sp),hl jp mainloop ;------------------------------------------------------------------------------- cist: ci: co: ret ;------------------------------------------------------------------------------- CMDTAB:: ; dw ERROR ;cmd_@ ;examine/substitute the displacement register @ ; dw ERROR ;cmd_A ;Assemble dw cmd_B ;Breakpoints display/set/clear dw ERROR ;cmd_C ;trace over Calls dw cmd_D ;Display memory in hex and ascii 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 dw ERROR ; dw ERROR ; dw cmd_L ;List disassembled code dw cmd_M ;Move memory [and verify] dw ERROR ; 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 dw cmd_S ;Substitute memory dw cmd_T ;Trace dw ERROR ; dw cmd_V ;Verify (compare) two memory areas dw ERROR ;cmd_W ;Write a file to disk dw cmd_X ;eXamine [and substitute] registers 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,(reg.pc) call bp_clr_temporary ld hl,(cmd_rpt) ld de,mainloop push de call cp_hl_de ld a,'>' call outchar call nz,outchar call z,outbl call get_line call skipbl jr z,exe_hl pop hl push hl ld (cmd_rpt),hl inc de sub 'B' jr c,ERROR cp 'Z'+1-'@' jr nc,ERROR ld hl,CMDTAB call add_hl_a2 ld a,(hl) inc hl ld h,(hl) ld l,a exe_hl: CALL_HL: jp (hl) ;------------------------------------------------------------------------------- crlf: call pstr_inl dc CR,LF xor a ld (con_col),a call inchar jr c,mainloop ret sub_01d9h: call pstr_inl dc '-' jp neg.hl out_hl_dec_neg: push hl 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 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_hex: push af rra rra rra rra call out_dgt pop af out_dgt: or 0f0h daa add a,0a0h adc a,040h jr outchar 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: 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 cp '''' call z,outchar call pstr_inl dc '''' sla c pop bc ret nc ld a,'.' jr outchar 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 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 call const and a jr z,inch1 call conin scf inch1: pop bc pop de pop hl pop ix ret ;------------------------------------------------------------------------------- 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 DELL: ld a,b ; or a ; ret z ; call DELC ; jr DELL ; ;------------------------------------------------------------------------------- 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: call get_char_upper cp ' ' jr z,skipbl0 or a ret ;------------------------------------------------------------------------------- next_arg: call skipbl cp ',' ret nz call skipbl0 cp a ret assert_eol: call skipbl ret z to_error: jp ERROR ;------------------------------------------------------------------------------- chk_stack: push hl push de ld hl,0 add hl,sp 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 call get_char_upper cp (hl) jr z,l0300h inc hl inc b jr l02f5h l0300h: scf inc de ret sub_0303h: ld hl,t_reg_names ld b,07fh l030ch: inc b ld a,(hl) and a ret z call sub_031ch jr nc,l030ch res 7,b ret sub_031ch: push bc push de l031eh: call get_char_upper xor (hl) and 07fh jr nz,l0336h bit 7,(hl) inc hl inc de jr z,l031eh scf bit 7,b call z,sub_060ch jr nc,l0339h pop af scf pop bc ret l0336h: call str_sel_next l0339h: pop de and a pop bc ret str_sel: inc b jr str_sel2 str_sel1: call str_sel_next str_sel2: djnz str_sel1 ret str_sel_next: ld a,(hl) and a ret z l0348h: ld a,(hl) inc hl and a ret m jr l0348h get_arg_range_target: call get_arg_range push hl push bc call next_arg call get_arg_final ex de,hl pop bc pop hl ret sub_035dh: call expr jr c,error0 ret get_arg_final: call sub_035dh l0366h: jp assert_eol get_lastarg_def: call get_arg_def jr l0366h get_arg_def: push hl call expr jr c,l0375h ex (sp),hl l0375h: pop hl ret sub_0377h: call b_037c_start jr l0366h b_037c_start: defb 0e6h ;and a,.. clear carry get_arg_range: scf ex af,af' push bc push hl call expr jr nc,l038ch ex af,af' jr c,error0 ex af,af' pop hl defb 03eh ;ld a,.. swallow pop af l038ch: pop af call get_range jr nc,l0398h ex af,af' pop bc ret nc error0: jp ERROR l0398h: pop af ret get_range: call next_arg cp 'S' jr nz,l03a2h inc de l03a2h: push hl push af ;'S' flag call expr jr c,l03b8h ld b,h ld c,l pop af pop hl jr z,l03b6h ;'S'? ld a,c sub l ld c,a ld a,b sbc a,h ld b,a inc bc l03b6h: and a ret l03b8h: pop af pop hl jr z,error0 ;'S', but no expression following scf ret ;------------------------------------------------------------------------------- expr: call skipbl expr1: call do_factor ret c l0433h: call do_binary_op push hl push bc call do_factor pop bc ex de,hl ex (sp),hl jr nc,l0447h pop de ld a,b or c ret z jp ERROR l0447h: ld a,b or c push bc ret nz pop bc doop_add: add hl,de l044dh: pop de jr l0433h doop_sub: and a sbc hl,de jr l044dh doop_mlt: push bc ld b,h ld c,l ld hl,0 ld a,010h l045dh: add hl,hl ex de,hl add hl,hl ex de,hl jr nc,l0464h add hl,bc l0464h: dec a jr nz,l045dh pop bc jr l044dh doop_div: call div_hl_de jr l044dh doop_mod: call div_hl_de ex de,hl jr l044dh ; divide x/y ; hl: x ; de: y ; return: ; hl: q (x/y) ; de: r (x%y) div_hl_de: 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) 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: ld a,h and d ld h,a ld a,l and e ld l,a jr l044dh doop_or: ld a,h or d ld h,a ld a,l or e ld l,a jr l044dh doop_xor: ld a,h xor d ld h,a ld a,l xor e ld l,a jr l044dh do_binary_op: push hl ld hl,tab_op_a call lookupch ld a,b ld hl,tblf_opa call add_hl_a2 ld c,(hl) inc hl ld b,(hl) pop hl ret tab_op_a: DB '+-*/%&!#',0 tblf_opa: dw doop_add dw doop_sub dw doop_mlt dw doop_div dw doop_mod dw doop_and dw doop_or dw doop_xor dw 0 ;------------------------------------------------------------------------------- fact_factor: call do_factor ret nc jp ERROR do_factor: call chk_stack call get.number ret nc inc de ld hl,ddtz_base-1 cp 'T' ret z ld hl,(high_load) cp 'H' ret z ld hl,(max_load) cp 'M' ret z ld hl,TPA cp 'L' ret z ld hl,(reg.pc) cp '$' ret z cp '-' jr z,fact_factneg cp '~' jr z,fact_factinv cp '+' jr z,fact_factor cp '^' jr z,fact_reg.CPU cp '(' jr z,fact_mem cp '[' jr z,expr_brckt cp '''' jr z,fact_factstring dec de scf ret ;------------------------------------------------------------------------------- fact_factstring: ld hl,0 l054bh: ld a,(de) cp '''' jr z,l0557h and a ret z l0552h: ld h,l ld l,a inc de jr l054bh l0557h: inc de ld a,(de) cp '''' jr z,l0552h sub '.' or a ret nz inc de set 7,l ret fact_reg.CPU: call sub_0caeh jr nc,error1 ld a,(hl) inc hl ld h,(hl) ld l,a and a bit 0,c ret nz 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 cpl ld h,a ld a,l cpl ld l,a ret fact_mem: call expr1 jr c,error1 ld a,(de) cp ')' jr nz,error1 inc de ld a,(hl) inc hl ld h,(hl) ld l,a ld a,(de) inc de cp '.' ret z dec de xor a ld h,a ret expr_brckt: call expr1 jr c,error1 ld a,(de) cp ']' inc de ret z error1: jp ERROR ;------------------------------------------------------------------------------- get.number: call get.hexdigit ret c push de test_number: inc de call get.hexdigit jr nc,test_number pop de cp '.' jr z,get_dec_number cp '"' jr z,get_bin_number ld hl,0 next_hexdigit: call get.hexdigit jr c,hexnum_done add hl,hl add hl,hl add hl,hl add hl,hl call add_hl_a inc de jr next_hexdigit hexnum_done: xor 'H' ret nz inc de ret get_bin_number: ld hl,0 next_bindigit: call get.bindigit l05dbh: inc de jr c,l05e4h add hl,hl call add_hl_a jr next_bindigit l05e4h: cp '"' jr nz,error11 call get.bindigit jr nc,l05dbh or a ret get_dec_number: ld hl,0 next_decdigit: call get.decdigit inc de jr c,decnum_done push bc add hl,hl ld b,h ld c,l add hl,hl add hl,hl add hl,bc pop bc call add_hl_a jr next_decdigit decnum_done: cp '.' ret z error11: jp ERROR sub_060ch: call get_char_upper cp 'Z'+1 jr l0614h get.hexdigit: ld a,(de) hex_digit: call toupper cp 'F'+1 l0614h: ccf ret c cp 'A' jr c,l061eh sub 'A'-10 ret get.decdigit: call get_char_upper l061eh: cp '9'+1 jr l0625h get.bindigit: call get_char_upper cp '1'+1 l0625h: ccf ret c cp '0' ret c sub '0' ret ;------------------------------------------------------------------------------- p_cpustat0: call assert_eol p_cpustat: call p_f call outbl2 ld hl,b_06e9_start ld de,b_0709_start ld b,6 l063eh: call p_regs djnz l063eh call outbl6 push hl push de ld iy,(reg.pc) call p_disas_instr pop de pop hl call crlf call p_f2 call outbl2 ld b,7 l065bh: call p_regs djnz l065bh jp crlf p_f: ld a,(reg.f) call p_flags ld a,(reg.iff) cp 0f3h jr z,outbl_1 ld a,'E' jp outchar p_f2: ld a,(reg.f2) call p_flags jr outbl_1 p_flags: 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 de call pstr call pstr_inl dc '=' ex (sp),hl ld e,(hl) inc hl ld d,(hl) inc hl ld a,(hl) inc hl push hl and a jr z,l06deh 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: pop de pop hl outbl_1: jp outbl b_06e9_start: DC 'A ' DC 'BC ' DC 'DE ' DC 'HL ' DC 'SP' DC 'PC' DC 'a''' DC 'bc''' DC 'de''' DC 'hl''' DC 'IX' DC 'IY' DC 'I' DB 0 b_0709_start: dw reg.a db 000h dw reg.c db 001h dw reg.e db 001h dw reg.l db 001h dw reg_sp db 001h dw reg.pc db 002h dw reg.a2 db 000h dw reg.c2 db 001h dw reg.e2 db 001h dw reg.l2 db 001h dw reg.ix db 001h dw reg.iy db 001h dw reg.i 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 ld bc,prog_size+bitmap_size 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 (bp_p_cpu_flag),a call expr jr c,l0740h ld (reg.pc),hl l0740h: call skipbl 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: call bpl_init ld a,(ix+000h) and 0f1h ld (ix+000h),a 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,bp_print inc de cp 'X' jr z,bp_clr0 dec de ld a,001h jp bp_enter bp_clr0: call skipbl jr z,bp_clr_all bp_clr_next: call expr jp c,assert_eol push de call bp_clr pop de call next_arg jr bp_clr_next bp_clr_all: scf bp_clr: call bpl_init push af jr c,l07a7h ld e,(ix+002h) ld d,(ix+003h) call cp_hl_de jr nz,l07aeh l07a7h: ld (ix+000h),000h l07aeh: pop af call bpl_next ret bp_print: ld c,0 call bpl_init bit 0,(ix+000h) jr z,bp_pr_cont ld l,(ix+002h) ld h,(ix+003h) call out_hl call outbl2 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) bp_enter: ld b,a call skipbl ret z push bc call expr jr c,error12 pop bc bit 0,b push bc push de push hl call nz,bp_clr pop hl call bp_get_freeslot pop de ld (ix+002h),l ld (ix+003h),h call next_arg pop af ld (ix+000h),a and 00fh jr bp_enter bp_get_freeslot: call bpl_init ld a,(ix+000h) and 00fh ret z call bpl_next error12 jp ERROR ;------------------------------------------------------------------------------- ; Breakpoint handling routine. bpddtz: ld (reg.l),hl pop hl dec hl ld (reg.pc),hl ld (reg_sp),sp ld sp,reg.l push de push bc push af push ix push iy ld a,i call di_or_ei ld h,a ld l,000h push hl ld a,0f3h ; EI jp po,l08dfh ld a,0fbh ; DI l08dfh: ld (reg.iff),a ex af,af' push af exx push bc push de push hl call bp_restore_mem ld a,(b_21e2_start) dec a jr z,l090bh call inchar ;Keyboard hit? jr c,do_break ;yes call sub_0913h and a jp z,user_go and 083h jp z,l2151h do_break: call bp_clr_temporary call p_cpustat jp mainloop l090bh: ld (b_21e2_start),a ld c,007h jp l0a41h sub_0913h: ld a,080h ex af,af' sub a ld (bp_p_cpu_flag),a call bpl_init ld a,(ix+000h) and 007h jr z,l0938h ld e,(ix+002h) ld d,(ix+003h) ld hl,(reg.pc) call cp_hl_de jr nz,l0938h ex af,af' res 7,a or (ix+000h) ex af,af' l0938h: call bpl_next ex af,af' ret bp_restore_mem: call bpl_init bit 5,(ix+000h) res 5,(ix+000h) jr z,l099ah ld l,(ix+002h) ld h,(ix+003h) ld a,(l0003h) cp (hl) jr nz,l099ah ld a,(ix+001h) ld (hl),a l099ah: res 3,(ix+000h) call bpl_next ret bp_tst_@pc: call bpl_init ld a,(ix+000h) and 003h jr z,bp_tst_e ld e,(ix+002h) ld d,(ix+003h) ld hl,(reg.pc) call cp_hl_de ret z bp_tst_e: call bpl_next sub a inc a ret bp_trace_enter: call bp_get_freeslot ld (ix+002h),l ld (ix+003h),h ld a,(b_21e2_start) and a ld a,008h jr nz,bp_t_e rra bp_t_e: ld (ix+000h),a ret bp_set_to_mem: call bpl_init ld a,(ix+000h) and c jr z,l0a1dh set 5,(ix+000h) ld l,(ix+002h) ld h,(ix+003h) ld a,(hl) ld (ix+001h),a ld a,(l0003h) ld (hl),a and 038h ld h,000h ld l,a ld (hl),0c3h inc hl ld de,bpddtz ld (hl),e inc hl ld (hl),d l0a1dh: call bpl_next ret ;------------------------------------------------------------------------------- user_go: sub a ld (b_21e2_start),a ld a,(bp_p_cpu_flag) and a call nz,p_cpustat call bp_tst_@pc ld c,007h jr nz,l0a41h ld a,001h ld (b_21e2_start),a call tc_set_bp ld c,008h l0a41h: call bp_set_to_mem ld sp,reg.l2 pop hl pop de pop bc pop af exx ex af,af' pop af ld i,a pop iy pop ix pop af pop bc pop de pop hl ld sp,(reg_sp) jp reg.iff ;------------------------------------------------------------------------------- ; > Y ; examine all Y variables ; > Y[0..9] ; examine (and substitute) an Y variable ;------------------------------------------------------------------------------- ; > X ; eXamine (display) all cpu registers and ; the instruction at the current program counter ; > X register ; eXamine (and substitute) a register cmd_X: call skipbl call sub_0caeh jp nc,p_cpustat0 call assert_eol ld a,b cp 25 jr z,l0c5fh cp 26 jr z,l0c4fh ex de,hl ld hl,t_reg_names call pstr_sel call l0c33h call outbl push de push bc call get_line call skipbl jr z,l0c30h call get_arg_final ex de,hl pop bc pop hl ld (hl),e bit 0,c ret z inc hl ld (hl),d ret l0c30h: pop af pop hl ret l0c33h: call pstr_inl dc '=' ld a,(de) bit 0,c jp z,out_hex ld l,a inc de ld a,(de) dec de ld h,a jp out_hl l0c4fh: call p_f ld a,0f3h ld (reg.iff),a scf call sub_0c6ah ld (reg.f),a ret l0c5fh: call p_f2 and a call sub_0c6ah ld (reg.f2),a ret sub_0c6ah: 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,t_flag_names call lookupch jp nc,ERROR 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 jr l0c76h t_flag_names: db 'CNV H ZSE',0 sub_0caeh: call sub_0303h ret nc ld a,b add a,b add a,b ld hl,b_0cfa_start call add_hl_a ld c,(hl) inc hl ld a,(hl) inc hl ld h,(hl) ld l,a scf ret 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: db 003h dw reg.c2 db 003h dw reg.e2 db 003h dw reg.l2 db 003h dw reg.c db 003h dw reg.e db 003h dw reg.l db 000h dw reg.a2 db 000h dw reg.b2 db 000h dw reg.c2 db 000h dw reg.d2 db 000h dw reg.e2 db 000h dw reg.h2 db 000h dw reg.l2 db 000h dw reg.a db 000h dw reg.b db 000h dw reg.c db 000h dw reg.d db 000h dw reg.e db 000h dw reg.h db 000h dw reg.l 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 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 outbl ld a,(hl) call out_hex call outbl2 call get_line call skipbl inc hl jr z,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 call get_char_upper or a dec hl jr z,l0d60h inc hl l0d8ah: dec de call sub_0ef8h jr l0d60h ;------------------------------------------------------------------------------- ; > @ ; examine (substitute) displacement register @ ;cmd_@: ;------------------------------------------------------------------------------- ; >>I [port] ; Input a byte from port cmd_I: ld (cmd_rpt),hl ld hl,(last_I) call get_lastarg_def ld (last_I),hl ld b,h ld c,l in a,(c) push af call out_hex call outbl4 pop af call out.bin.b jp crlf ;------------------------------------------------------------------------------- ; >>O [byte] [port] ; Output a byte to a port cmd_O: ld (cmd_rpt),hl ld hl,(last_O_val) call get_arg_def ld a,l ld (last_O_val),a push af call next_arg ld hl,(last_O_addr) call get_lastarg_def ld (last_O_addr),hl ld b,h ld c,l pop af out (c),a ret ;------------------------------------------------------------------------------- ; > V startaddr endaddr targetaddr ; Verify (compare) two memory areas cmd_V: call get_arg_range_target l0dedh: push bc ld a,(de) ld b,(hl) cp b jr z,l0e10h ld c,a call out_hl call outbl ld a,b call out_hex call outbl2 ld a,c call out_hex call outbl ex de,hl call out_hl ex de,hl call crlf l0e10h: pop bc inc de cpi jp pe,l0dedh ret ;------------------------------------------------------------------------------- ; > M startaddr endaddr destaddr ; Move memory cmd_M: call get_arg_range_target call cp_hl_de jr nc,cmdm_up add hl,bc ex de,hl add hl,bc ex de,hl dec hl dec de lddr 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 assert_eol call out_hl call outbl2 call out_hl_neg call outbl4 call out.hl.dec call outbl2 call out_hl_dec_neg call outbl4 call out.bin.w call outbl2 ld a,l call out.ascii jp crlf ;------------------------------------------------------------------------------- ; > Q[J] startaddr endaddr bytes ; Query memory for a byte string [Justified] cmd_Q: call get_arg_range push bc push hl call sub_0ee6h pop hl l0e96h: 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 ld bc,16 and a ;clear carry call sub_0f58h pop bc l0eb0h: inc hl ex (sp),hl dec hl ld a,h or l ex (sp),hl jr nz,l0e96h pop bc ret ;------------------------------------------------------------------------------- ; > Z startaddr endaddr bytes ; Zap (fill) memory with a byte string cmd_Z: call get_arg_range push bc push hl call sub_0ee6h ld a,b pop hl pop bc push hl ex de,hl l0ec7h: ldi jp po,l0ed3h dec a jr nz,l0ec7h pop hl ldir ret l0ed3h: pop hl ret sub_0ee6h: ld hl,conbuf call sub_0ef7h ld de,conbuf and a sbc hl,de ld b,l ret nz jp ERROR 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 '''' jr z,l0f1eh push hl call expr ld a,l pop hl jr c,l0f42h ld (hl),a inc hl jr l0f3ah l0f1eh: inc de ld a,(de) cp '''' jr z,l0f2bh or a jr z,l0f42h l0f27h: ld (hl),a inc hl jr l0f1eh l0f2bh: inc de ld a,(de) cp '''' jr z,l0f27h cp '.' jr nz,l0f3ah inc de dec hl set 7,(hl) inc hl l0f3ah: pop af jr nc,l0ef9h ld (last_S),hl jr l0ef9h l0f42h: pop af ret nc ld (last_S),hl ret ;------------------------------------------------------------------------------- ; >>D [startaddr] [endaddr] ; Display memory in hex and ASCII cmd_D: ld (cmd_rpt),hl ld hl,(last_D) ld bc,128 call sub_0377h scf sub_0f58h: push bc push de push hl push af l0f5ch: call out_hl call outbl2 ld de,0 l0f68h: ld a,(hl) inc hl call out_hex call outbl dec bc inc e ld a,e cp 010h jr z,l0f80h and 003h call z,outbl ld a,b or c jr nz,l0f68h l0f80h: call outbl and a sbc hl,de l0f86h: ld a,(hl) call sub_0fa3h call outchar inc hl dec e jr nz,l0f86h pop af push af jr nc,l0f97h ld (last_D),hl l0f97h: call crlf ld a,b or c jr nz,l0f5ch pop af pop hl pop de pop bc ret sub_0fa3h: and 07fh cp 07fh jr z,l0fach cp ' ' ret nc l0fach: ld a,'.' ret ;------------------------------------------------------------------------------- ; > Fcommandline ; specifiy filenames and command line ;cmd_F: ;------------------------------------------------------------------------------- ; > 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,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 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 djnz l16c6h ;repeat for record len call i.gethexbyte ;checksum ld a,c and a jr nz,error2 ;exit if checksum error jr w_recstart ;next record rdhex_done: pop hl call i.gethexbyte jp p_max_high 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 sub_16f6h: call i.getchar jr z,error2 call hex_digit ret nc error2: jp ERROR i.getchar: call incharw cp 01ah ret i.storebyte: push af push de ld de,TPA ;lowest allowed load address call cp_hl_de jr c,error2 ld de,(BDOS+1) ;highest allowed load address call cp_hl_de jr nc,error2 ld de,(high_load) call cp_hl_de jr c,l1157h ld (high_load),hl l1157h: ld de,(max_load) call cp_hl_de jr c,l1163h ld (max_load),hl l1163h: pop de pop af ld (hl),a ;store byte ret ;------------------------------------------------------------------------------- p_max_high0: call assert_eol p_max_high: call pstr_inl DC 'High = ' ld hl,(high_load) call out_hl call pstr_inl DC ' Max = ' ld hl,(max_load) call out_hl call pstr_inl DC ' Top = ' ld hl,ddtz_base-1 call out_hl jp crlf ;------------------------------------------------------------------------------- ; > Wstartaddr endaddr ; Write a file to disk ;cmd_W: ;------------------------------------------------------------------------------- ; > A [startaddr] ; Assemble Zilog Z180 mnemonics ;cmd_A: ;------------------------------------------------------------------------------- ; >>L [startaddr] [endaddr] ; List disassembled code cmd_L: ld (cmd_rpt),hl call expr jr nc,l18dbh ld hl,(last_L) l18dbh: call next_arg call get_range jr nc,l1905h call assert_eol ld b,16 l18ebh: push bc call cmdl_p_line pop bc djnz l18ebh ret l1905h: call assert_eol ld d,h ld e,l add hl,bc ex de,hl l190fh: push de call cmdl_p_line pop de call cp_hl_de jr c,l190fh ret ;------------------------------------------------------------------------------- cmdl_p_line: push hl call out_hl call outbl2 sub a ld (con_col),a push hl pop iy call p_disas_instr call crlf pop hl ld c,b ld b,0 add hl,bc ld (last_L),hl ret ;------------------------------------------------------------------------------- p_disas_instr: call disas_get_instrlen jr nc,l197fh 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 scf ret l197fh: call pstr_inl DC '???' ld b,1 sub a ret disas_get_instrlen: sub a ld (isprefix_ixiy),a ld a,(iy+000h) cp 0edh jr z,disas_pfx.ED cp 0ddh jr z,l19abh cp 0fdh jr z,l19afh sub_19a0h: ld a,(iy+000h) cp 0cbh jr z,disas_pfx.CB jr disas_nopfx l19abh: ld a,1 jr l19b1h l19afh: ld a,2 l19b1h: ld (isprefix_ixiy),a call disas_pfx.DDFD ret nc push bc call sub_19a0h pop af add a,b ld b,a 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 call test_DDFD ld b,002h ret c ld hl,l1a0ah call test_DDFD ld b,001h ret c ld a,(iy+000h) cp 0cbh jr nz,l19edh ld a,(iy+002h) cp 036h ret z and 007h cp 006h jr nz,l19edh ld b,002h scf ret l19edh: and a ret ;------------------------------------------------------------------------------- ; DD/FD 3 byte (ix+d)/(iy+d) b_19ef_start: db 034h db 035h db 036h db 046h db 04eh db 056h db 05eh db 066h db 06eh db 070h db 071h db 072h db 073h db 074h db 075h db 077h db 07eh db 086h db 08eh db 096h db 09eh db 0a6h db 0aeh db 0b6h db 0beh db 0 ; DD/FD 2 byte l1a0ah: db 009h db 019h db 021h db 022h db 023h db 029h db 02ah db 02bh db 039h db 0e1h db 0e3h db 0e5h db 0e9h db 0f9h db 0 ;------------------------------------------------------------------------------- test_DDFD: ld a,(hl) and a ret z inc hl cp (iy+000h) jr nz,test_DDFD scf ret lookup_op: ld a,(hl) inc hl cp 0ffh ret z cp (iy+000h) jr z,l1a7fh inc hl jr lookup_op l1a7fh: 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 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 lookup_branch_op ;TODO ld a,(hl) and a ret z inc hl and (iy+000h) cp (hl) inc hl jr z,l1aa8_br inc hl inc hl jr lookup_branch_op l1aa8_br: ld e,(hl) inc hl ld d,(hl) scf ret ;------------------------------------------------------------------------------- ; 1 byte opcodes (no parameters) ; Format: db opcode, t_MNEMONICS-index b_1ab6_start: 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 ; Format: db mask, match, t_MNEMONICS-index ; dw argument formating function b_1ad1_start: 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 opcodes b_1b54_start: 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 b_1b9b_start: 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,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 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 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 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 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 ;------------------------------------------------------------------------------- ;------------------------------------------------------------------------------- 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 ; ; 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 ;------------------------------------------------------------------------------- argpf_index defl 0 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+001h) jr z,out_hex_0 ld a,(iy+002h) jr out_hex_0 p_rst: and 038h out_hex_0: jp out_hex p_j: ld c,(iy+001h) ld a,c rla sbc a,a ld b,a push iy pop hl add hl,bc inc hl inc hl jr out_hl_0 p_nn: ld l,(iy+001h) ld h,(iy+002h) out_hl_0: jp out_hl p_ir: rra rra rra and 03 ld hl,t_arg_IR jr p_arg get_cb_opc: ld a,(isprefix_ixiy) and a ld a,(iy+001h) ret z ld a,(iy+002h) ret p_y: call get_cb_opc rra rra rra and 007h jp out_dgt p_rz_cb: call get_cb_opc jr p_rz p_ry: rra rra rra p_rz: and 007h cp 006h ld b,a ld hl,t_arg_r jr nz,p_arg0 ld a,(isprefix_ixiy) and a jr z,p_arg0 ld hl,t_lp_IXIY dec a call p_arg ld a,(iy+001h) push af rlca ld a,'+' jr nc,l1e61h pop af neg push af ld a,'-' l1e61h: call outchar pop af call out_hex ld a,')' jp outchar 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 nz,p_arg p_hlixiy: ld a,(isprefix_ixiy) ld hl,t_HL.IX.IY jr p_arg p_ccy2: and 018h p_ccy: rra rra rra and 007h ld hl,t_arg_cc p_arg: ld b,a p_arg0: ;fall thru 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: ;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_arg_r: DC 'B' DC 'C' DC 'D' DC 'E' DC 'H' DC 'L' DC '(HL)' DC 'A' DB 0 t_arg_rp: DC 'BC' DC 'DE' DC 'HL' DC 'SP' DB 0 t_arg_rp2: DC 'BC' DC 'DE' DC 'HL' DC 'AF' DB 0 t_HL.IX.IY: DC 'HL' DC 'IX' DC 'IY' DB 0 t_arg_cc: DC 'NZ' DC 'Z' DC 'NC' DC 'C' DC 'PO' DC 'PE' DC 'P' DC 'M' DB 0 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 jr z,l2037h ld de,BDOS and a sbc hl,de 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,0 ld hl,(reg.pc) add hl,bc call bp_trace_enter ld iy,(reg.pc) ld hl,t_op_branch call lookup_branch_op ccf ret c ex de,hl l2031h: call CALL_HL call c,bp_trace_enter l2037h: scf ret ;------------------------------------------------------------------------------- t_op_branch: db 0ffh,0ddh ;Prefix DD dw l20a7h db 0ffh,0fdh ;Prefix FD dw l20ach db 0ffh,0edh ;Prefix ED dw l20b8h db 0ffh,0cdh ;call mn dw l2080h db 0ffh,0c3h ;jp mn dw l208bh db 0ffh,0e9h ;jp () dw l20a2h db 0ffh,0c9h ;ret dw l20dch db 0ffh,0cfh ;rst 8 dw l2115h db 0c7h,0c7h ;rst n dw l20f9h db 0c7h,0c4h ;call cc,mn dw l2080h db 0f7h,010h ;djnz d; jr d dw l2093h db 0e7h,020h ;jr cc,d dw l2093h db 0c7h,0c2h ;jp cc,mn dw l208bh db 0c7h,0c0h ;ret cc dw l20c5h db 0 ;------------------------------------------------------------------------------- ; call mn call cc,mn l2080h: ; jp mn jp cc,mn l208bh: ld l,(iy+001h) ld h,(iy+002h) scf ret l2093h: ld c,(iy+001h) ld a,c rla sbc a,a ld b,a ld hl,(reg.pc) add hl,bc inc hl 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 ; jp (ix); jp (iy) scf ret z and a ret ; Prefix ED l20b8h: ld a,(iy+001h) cp 04dh ; reti jr z,l20dch cp 045h ; retn jr z,l20dch and a ret l20c5h: ld a,(iy+000h) ld (l20d7h),a ld hl,(reg.f) push hl pop af call l20d7h scf jr c,l20dch ret l20d7h: nop and a pop hl inc hl jp (hl) l20dch: l20edh: ld hl,(reg_sp) ;break on return address ld e,(hl) inc hl ld d,(hl) ex de,hl call bp_trace_enter l2115h: and a ret l20f9h: ld a,(l0003h) cp (iy+000h) ret z ld a,(iy+000h) and 038h ld l,a ld h,000h ld a,(b_21e2_start) and a ret z scf ret ;------------------------------------------------------------------------------- ; >>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: ld (cmd_rpt),hl ld hl,1 ;default: 1 step call get_lastarg_def ld (trace_cnt_or_ptr),hl sub a ld (bp_p_cpu_flag),a call tc_set_bp jr user_go1 l2151h: call bp_clr_temporary ld hl,(trace_cnt_or_ptr) dec hl ld (trace_cnt_or_ptr),hl ld a,h or l jp z,do_break call tc_set_bp jp nc,do_break sbc a,a ld (bp_p_cpu_flag),a user_go1: jp user_go ;------------------------------------------------------------------------------- con_col: db 0 ;------------------------------------------------------------------------------- b_21e2_start: db 0 trace_cnt_or_ptr: dw 0 bp_p_cpu_flag: db 0 bp_tab: rept BP_CNT rept BP_SIZE db 0 endm endm ;------------------------------------------------------------------------------- last_S: dw TPA last_I: dw 0 last_O_addr: dw 0 last_O_val: db 0 last_D: dw TPA high_load: dw TPA max_load: dw TPA isprefix_ixiy: db 0 last_L: dw TPA pbl_loop_adr: dw 0addeh ;------------------------------------------------------------------------------- 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 ;------------------------------------------------------------------------------- ddtz_size equ $-ddtz_base prog_size equ $-start ddtz_end:: ;------------------------------------------------------------------------------- end