; 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 TAB equ 09h CR equ 0dh LF equ 0ah ; 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 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) SYMCASE_SENS equ 0 ;Symbols are case sensitive SYMCASE_CONV equ 1 ;Convert case when symbols are loaded SYMCASE_LOWER equ 2 ;Convert to lower case if set, else to upper case ;------------------------------------------------------------------------------- ; Relocation loader ; TPA equ 0100h cseg .phase TPA jp start ds 3 ldr_end: ldr_size equ $ - TPA current_phase defl $ .dephase current_cseg defl $ ;------------------------------------------------------------------------------- ; DDT/Z core ; ddtz_base: jp ddtz_bdos l0003h: rst 30h ;rst used by ddtz di_or_ei: ;ints enabled/disabled while ddtz is running nop ret ddtz_bdos: jp 0 screen_width: db 80 symlen_max: db 16 symattrib: db 0 current_cseg defl $ - current_cseg .phase current_phase + current_cseg signon: db 'Symbolic DDTZ/180' db ' - Version ' maclib version.inc defvers db CR,LF,'$' msgz80: db 'Z80 or better required!',cr,lf,'$' current_phase defl $ .dephase current_cseg defl $ ds STACK_SIZE - (current_phase - signon) 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 error_func:dw p_msg_error cmd_rpt:dw mainloop ;------------------------------------------------------------------------------- conbuf: db CONBUF_SIZE ld sp,stack exx ld de,ddtz_base call cp_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 l0093h: ld (reg.iff),a call di_or_ei 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 ds CONBUF_SIZE + 3 - ($ - conbuf) ;------------------------------------------------------------------------------- CMDTAB: dw cmd_@ ;examine/substitute the displacement register @ dw cmd_A ;Assemble dw cmd_B ;Breakpoints display/set/clear dw 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_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 and/or symbol 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 cmd_X ;eXamine [and substitute] registers dw cmd_Y ;examine [and substitute] Y variables dw cmd_Z ;Zap (fill) memory with a byte string ERROR: ld hl,(error_func) exe_hl: call CALL_HL ;fall thru mainloop: ld sp,stack ld hl,p_msg_error ld (error_func),hl ld hl,(reg.pc) ld (var.$),hl call bp_clr_temporary ld hl,(cmd_rpt) ld de,mainloop ld (cmd_rpt),de call cp_hl_de ld a,'>' call outchar call nz,outchar call z,outbl call get_line call skipbl jr z,exe_hl inc de sub '@' 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 jr exe_hl ;------------------------------------------------------------------------------- p_msg_error: call pstr_inl dc '?' ;fall thru crlf: call pstr_inl dc CR,LF xor a ld (con_col),a call inchar jr c,mainloop ret out.hl.@: call out_hl push de push hl ld de,(var.@) ld a,d or e jr z,l01bfh call outbl call pstr_inl dc '@' and a sbc hl,de call out_hl l01bfh: pop hl pop de 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 e,a ld c,BDOS_COUT call ddtz_bdos ld hl,con_col inc (hl) pop af pop bc pop de pop hl pop iy pop ix ret p_align_@_sym: push de ld de,(var.@) ld a,d or e pop de ld a,(symlen_cur) jr z,$+4 add a,6 add a,c ld c,a p_goto_col: ld a,(con_col) cp c ret nc ret z call outbl jr p_goto_col ;------------------------------------------------------------------------------- inchar: push ix push hl push de push bc ld c,BDOS_CSTAT call ddtz_bdos and a jr z,inch1 ld c,BDOS_CIN call ddtz_bdos scf inch1: pop bc pop de pop hl pop ix ret get_line: push hl ld de,conbuf ld c,BDOS_CBUF call ddtz_bdos call crlf ld hl,conbuf+1 ld e,(hl) xor a ld d,a inc hl ex de,hl add hl,de ld (hl),a pop hl ret ;------------------------------------------------------------------------------- get_char_upper: ld a,(de) toupper: cp 'a' ret c cp 'z'+1 ccf ret c and 05fh ret tolower: cp 'A' ret c cp 'Z'+1 ccf ret c or 020h ret ;------------------------------------------------------------------------------- skipbl0: inc de skipbl: call get_char_upper call test_whitespace 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 sub_hl_a1: dec hl sub_hl_a: push bc ld c,a xor a ld b,a sbc hl,bc pop bc ret ;------------------------------------------------------------------------------- sym_getname: push de push hl ld hl,ddtz_base+2 sgn_l: ld d,(hl) dec hl ld e,(hl) dec hl ld a,(hl) cp 0c3h jr z,sgn_e ex (sp),hl call cp_hl_de jr z,sgn_e ex (sp),hl call sub_hl_a1 jr sgn_l sgn_e: sub 0c3h pop hl pop de ret p_symstr: push bc ld b,(hl) pss_l: dec hl ld a,(hl) call outchar djnz pss_l dec hl pop bc ret p_symbol: if 0 ld a,(dash_flag) or a ret nz endif push hl call sym_getname call nz,p_symstr pop hl ret p_label: if 0 ld a,(dash_flag) or a ret nz endif push hl call sym_getname jr z,pl_e call p_symstr call pstr_inl dc ':' call crlf pl_e: pop hl 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 jr l030ch sub_030ah: ld b,0ffh l030ch: inc b ld a,(hl) and a ret z call sub_031ch jr nc,l030ch res 7,b ret sub_0318h: push bc res 7,b defb 03eh ;ld a,nn: swallow push bc 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_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 call add_hl_a2 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: 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,(BDOS+1) dec hl 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,(var.@) cp '@' ret z ld hl,(var.$) cp '$' ret z ld hl,ddtz_base cp 'Z' ret z cp '-' jr z,fact_factneg cp '~' jr z,fact_factinv cp '+' jr z,fact_factor cp '^' jr z,fact_reg.CPU cp 'Y' jr z,fact_reg.Y cp '(' jr z,fact_mem cp '[' jr z,expr_brckt cp '''' jr z,fact_factstring cp '.' jr z,fact_symbol dec de scf ret ;------------------------------------------------------------------------------- fact_reg.Y: call get.decdigit jr c,error1 inc de get_y_val: ld hl,reg_Y call add_hl_a2 ld a,(hl) inc hl ld h,(hl) ld l,a and a 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 xor a ;clr cy, a=0 bit 0,c ret nz ld h,a 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 fact_symbol: push bc ld hl,ddtz_base ;symtbl start ld a,(symattrib) ld c,07fh rra jr c,fs_nxtsym res 5,c fs_nxtsym: ld a,(hl) ;symlen cp 0c3h jr z,error1 ld b,a ;symlen inc b push hl ;symtbl ptr push de ;inpsym ptr fs_nxtchar: ld a,(de) djnz fs_3 call test_sym_char jr z,fs_cont pop hl ;inpsym ptr (discard) inc de cp a,':' jr z,fs_cont_1 dec de pop hl ;symtbl ptr inc hl ld a,(hl) ;symval h inc hl ld h,(hl) ;symval l ld l,a or a ;clear carry pop bc ret fs_3: inc de dec hl xor (hl) and c jr z,fs_nxtchar fs_cont: ;start over pop de ;inpsym ptr fs_cont_1: pop hl ;symtbl ptr ld a,(hl) add a,3 call sub_hl_a jr fs_nxtsym ;------------------------------------------------------------------------------- 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 push hl push de ld iy,(reg.pc) call p_disas_instr pop de ex (sp),hl push af call crlf call p_f2 call outbl2 ld b,7 l065bh: call p_regs djnz l065bh pop af pop hl call nz,outbl6 call nz,p_offset 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 dec a jr z,l06d9h call out.hl.@ call z,outbl6 jr l06e2h l06d9h: 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 ;------------------------------------------------------------------------------- ; > G [startaddr] [;breakp..] ; Go [to start] [with temporary breakpoints] cmd_G: sub a ld (trace_call_flag),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 bp_clr_condition call bpl_next ret ;------------------------------------------------------------------------------- ; > B ; display all breakpoints ; > B breakp [breakp..] ; set breakpoints ; > BX ; clear all breakpoints ; > BX address [address..] ; clear breakpoints ; ; where breakp is: ; [R] expression [I condition] 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 call bp_clr_condition l07aeh: pop af call bpl_next ret bp_print: call bpl_init bit 0,(ix+000h) jr z,bp_pr_cont ld a,'R' bit 4,(ix+000h) jr nz,l07cdh ld a,' ' l07cdh: call outchar call outbl ld l,(ix+002h) ld h,(ix+003h) call out.hl.@ call outbl call p_symbol ld c,9 call p_align_@_sym call pstr_inl dc ':' 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 call pstr_inl dc 'I ' call pstr l0805h: call crlf bp_pr_cont: call bpl_next 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 cp 'R' jr nz,bp_e_1 inc de set 4,b bp_e_1: 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 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 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 bp_get_count: call skipbl ld hl,1 cp ':' ret nz inc de call expr jr c,error12 ret bp_get_condition: call skipbl cp 'I' ld hl,0 ret nz inc de call skipbl push de call expr jr c,error12 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 jr nc,error12 pop de pop hl push de ldir ex de,hl ld (hl),c ; trailing 0 inc hl ld (expr_p1),hl pop hl ret ;------------------------------------------------------------------------------- ; 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 push bc call z,sub_0942h pop bc l0938h: call bpl_next ex af,af' ret sub_0942h: 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 (bp_p_cpu_flag),a ret l0974h: ex af,af' or (ix+000h) 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 ;User bp (temporary or permanent)? jr z,bp_tst_e ;No, check next ld e,(ix+002h) ld d,(ix+003h) ld hl,(reg.pc) call cp_hl_de ;Current PC is on a User bp ret z ;Return zero bp_tst_e: call bpl_next sub a inc a ;Not on a user bp ret ;Return not zero 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,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 ;------------------------------------------------------------------------------- bp_clr_condition: ld a,(ix+000h) and 003h ret nz ; No (user) bp set ld e,(ix+006h) ld d,(ix+007h) ld a,d or e ret z ; No conditional expression 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 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 ;------------------------------------------------------------------------------- ; > Y ; examine all Y variables ; > Y[0..9] ; examine (and substitute) an Y variable 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 outbl pop af push af call get_y_val call p_symbol pop af inc a push af rra push af ld c,11 call c,p_align_@_sym pop af call nc,crlf pop af cp YREG_CNT jr c,l0bc7h ret 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 jr l0c33h ;------------------------------------------------------------------------------- ; > 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 30 jr z,l0c5fh cp 31 jr z,l0c4fh cp 29 jp z,ERROR ex de,hl ld hl,t_reg_names call str_sel l0c12h: call l0c33h l0c15h: 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 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 bit 1,c jp z,out_hl 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 'X' ;24 DC 'Y' ;25 DC 'S' ;26 DC 'P' ;27 DC 'I' ;28 DC 'IP' ;29 DC 'F''' ;30 DC 'F' ;31 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 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 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_@: call assert_eol ld hl,msg_@ ld de,var.@ ld c,001h jp l0c12h msg_@: dc '@' ;------------------------------------------------------------------------------- ; >>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 ;------------------------------------------------------------------------------- ; > Vstartaddr 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[V] startaddr endaddr destaddr ; Move memory [and verify] cmd_M: call get_char_upper cp 'V' jr nz,l0e1fh inc de l0e1fh: push af call get_arg_range_target push hl push de push bc 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 db 01h ;swallow ldir instruction (ld bc,...) cmdm_up: ldir pop bc pop de pop hl pop af jr z,l0dedh ret ;------------------------------------------------------------------------------- ; > H ; display Highest load address of last filed loaded, Maximum "High" ; off all loaded files, and Top address of available memory ; > HS ; display symbol list ; > H expression ; evaluate expression and display result in hex, decimal and other formats ; > H expression expression ; display sum und difference of expressions cmd_H: call get_char_upper cp 'S' jr z,p_sym_list 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 call outbl4 call out.hl.dec call outbl2 call out_hl_dec_neg call outbl4 call out.bin.w call outbl ld a,l call out.ascii call outbl2 call p_symbol jp crlf p_sym_list: inc de call assert_eol ld a,(symlen_cur) add a,7 ld b,a ld c,0 ld hl,ddtz_base+2 psym_nxtsym: ld d,(hl) dec hl ld e,(hl) dec hl ld a,(hl) cp 0c3h jr z,psym_e call p_goto_col ex de,hl call out_hl call outbl ex de,hl call p_symstr ld a,c add b ld c,a ld a,(screen_width) sub b cp c jr nc,psym_nxtsym call crlf ld c,0 jr psym_nxtsym psym_e: ld a,c or a ret z jp crlf ;------------------------------------------------------------------------------- ; > Q[J] startaddr endaddr bytes ; Query memory for a byte string [Justified] cmd_Q: call get_char_upper 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 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 ;clear carry call sub_0f58h pop hl 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_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 call sub_0ef7h ld de,conbuf+1 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 '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 call expr ld a,l pop hl jr c,l0f42h l0f1ah: 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 z,outbl2 call outbl 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: push de ld hl,DMA_BUF+1 ld (hl),' ' inc hl l0fb6h: call get_char_upper 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 cpy_fcb2: ld hl,dfcb2 ld de,fcbsym ld bc,16 ldir ret parse_filename: call sub_102ch push de push bc ld b,(hl) inc hl ld a,(hl) cp ':' jr nz,l0fe1h inc hl 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 inc hl ld (de),a inc de djnz sub_0ff2h jr l1003h l0ffeh: 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 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,'?' call toupper cp '*' ret l102bh: inc hl sub_102ch: ld a,(hl) cp '/' jr z,l103bh call sub_1043h jr z,l102bh l1036h: cp ' ' jr z,l102bh ret l103bh: ld a,(hl) cp ' '+1 jr c,l1036h inc hl jr l103bh sub_1043h: cp '=' ret z cp '_' ret z cp ',' ret ;------------------------------------------------------------------------------- setup_fcb: 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 ;------------------------------------------------------------------------------- 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 ld a,01ah 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 sub a,1 jr z,l1132h jr nc,error2 l1132h: pop bc pop de pop hl ret cmdR_storebyte: push af push de ld de,TPA call cp_hl_de jr c,error2 ld de,(BDOS+1) 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 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,error2 hex_digit_v: call hex_digit ret nc error2: 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 ret ;------------------------------------------------------------------------------- ; > R [displacement] ; Read a binary or hex file and or symbol file [add displacement] 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 push hl add hl,de l108eh: call read_sector jr nz,read_file_nxt pop hl jr read_symfile read_file_nxt: ld de,DMA_BUF ld b,080h l109ah: ld a,(de) call cmdR_storebyte inc de inc hl djnz l109ah jr l108eh read_hexfile: push hl l10aeh: call read_byte ; RECORD MARK jr z,rdhex_done cp ':' jr nz,l10aeh ld c,0 call read_hexchar ; RECLEN ld b,a call read_hexchar ; LOAD ADDR H ld h,a call read_hexchar ; LOAD ADDR L ld l,a ld a,b and a jr z,rdhex_done call read_hexchar ; RECTYP l10cch: call read_hexchar ; DATA pop de push de push hl add hl,de call cmdR_storebyte pop hl inc hl djnz l10cch call read_hexchar ; CHKSUM ld a,c and a jr nz,error3 jr l10aeh rdhex_done: pop hl jr read_symfile read_symfile: ld de,fcbsym+1 ld a,(de) cp ' ' jp z,p_max_high push hl ; offset call pstr_inl db 'SYMBOLS',CR,LF+80h dec de call file_open ld a,(symattrib) ld c,a rs_1: call read_byte rs_2: pop de ; offset cp 1ah jp z,p_max_high push de ; offset cp '!' jr c,rs_1 call read_hexbyte0 ; symval H ld h,a call read_hexbyte ; symval L ld l,a add hl,de call read_byte cp ' ' jr z,rs_4 rs_3: call read_byte cp ' ' jr nc,rs_3 jr rs_2 rs_4: push hl ; symval ld hl,(BDOS+1) ; ld b,0 ; setup symlen rs_5: dec hl ; call read_byte ; next char of symbol name call test_sym_char ; valid char? jr nz,rs_6 bit SYMCASE_CONV,c jr z,rs_51 call toupper bit SYMCASE_LOWER,c call nz,tolower rs_51: ld (hl),a ; inc b ; symlen++ ld a,(symlen_max) ; cp b ; jr nc,rs_5 ; error3: jp ERROR ; rs_6: call test_symterm_ch jr nz,error3 push bc ; symlen ex de,hl ; ld hl,(BDOS+1) ; inc hl ; ld c,(hl) ; inc hl ; ld b,(hl) ; ex de,hl ld (hl),b ; dec hl ; ld (hl),c ; dec hl ; ld (hl),0c3h ; ld de,(max_load) ; call cp_hl_de ; jr c,error3 ; 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 bc ; symlen ld (hl),b ; inc hl ; pop de ; symval ld (hl),e ; inc hl ; ld (hl),d ; ld a,b ; ld hl,symlen_cur ; cp (hl) ; new max? jr c,$+3 ; ld (hl),a ; jp rs_1 ; ; test for valid character for symbols ; return z if valid test_sym_char: cp '$' ret z cp '%' ret z cp '.' ret z cp '_' ret z call test_alphanum ret c ; cy == 1 --> z == 0 cp a ; return z ret ; check if char is in [0..9,?,@,A..Z,a..z] ; return cy if invalid ; return nc if valid alfanumeric char test_alphanum: cp 'z' ret z ccf ret c cp 'a' ret nc cp 'Z' ret z ccf ret c cp '?' ret nc test_numeral: cp '9' ret z ccf ret c cp '0' ret test_symterm_ch: cp CR ret z cp LF ret z test_whitespace: cp ' ' ret z cp TAB 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,(BDOS+1) dec hl call out_hl jp crlf ;------------------------------------------------------------------------------- ; > Wstartaddr endaddr ; Write a file to disk 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,error4 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,error4 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 error4: jp ERROR close_file: ld de,dfcb1 ld c,BDOS_CLOSE jp ddtz_bdos ;------------------------------------------------------------------------------- ; > A [startaddr] ; Assemble Zilog Z180 mnemonics cmd_A: ld hl,(last_A) call get_lastarg_def ld (last_A),hl ld (cmd_A_prev),hl ld hl,cmda_restart ld (error_func),hl ld (l1262h),sp cmda_loop: ld hl,(last_A) ld (var.$),hl push hl call p_disas_line ld c,19 call p_align_@_sym ld c,b push bc call get_line pop bc pop hl call skipbl cp '.' ret z cp '-' jr nz,l124bh ld hl,(cmd_A_prev) jr cmda_lpend l124bh: push hl pop iy push hl and a call nz,asemble_line ld b,0 pop hl ld (cmd_A_prev),hl add hl,bc cmda_lpend: ld (last_A),hl jr cmda_loop cmda_restart: call p_msg_error ld sp,(l1262h) jr cmda_loop asemble_line: call skipbl ld hl,t_MNEMONICS call sub_030ah jr nc,error4 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,error5 cp 006h jr z,error5 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,error5 cp 006h jr z,error5 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,error5 add a,b ld b,a jp gen.opc.ED2 error5: 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 call get_char_upper cp 'I' jp z,l1511h cp 'R' jp z,l1519h cp '(' jr nz,error5 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) as_store_4: ld (iy+000h),a ld (iy+001h),b ld (iy+002h),l ld (iy+003h),h ld c,004h ret l13aah: call get_char_upper cp 'A' jr nz,error5 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 as_store_4 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 jr z,error60 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 jr z,error60 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: call get_char_upper cp 'I' jr z,l1426h cp 'R' jr nz,l1432h ld a,b cp 007h jr nz,error60 ld b,05fh jr l142eh l1426h: ld a,b cp 007h jr nz,error60 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 jr nz,error60 call arg.ww jr nc,l1466h cp 030h jr nc,error60 add a,00ah ld b,a call test_paren_close jp as.opc.noarg error60: jp error 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 jr z,error60 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: call get_char_upper 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 call get_char_upper 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: call get_char_upper 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 call get_char_upper 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 jr nc,error6 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 jr nc,error6 add a,009h l1596h: ld b,a jp l14b4h l159ah: call assert_comma call arg.ww error61nc: jr nc,error6 add a,009h jp l13ech as.AND_CP_OR_SUB_XOR: call get_char_upper 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 jr nc,error61nc 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 jr nc,error61nc 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,error7 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,error7 jp as.opc.noarg as.POP_PUSH: call arg.IX_IY jr c,l16e7h call arg.zz jr nc,error7 add a,b jp l13ech l16e7h: ld a,b add a,020h jp l1596h as.IN: call arg.r_HL_A jr nc,error7 cp 006h jr z,error7 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 error7: 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,error7 cp 006h jr z,error7 rlca rlca rlca add a,b jp l156eh l1739h: call arg.addr_8bit call assert_comma cp 'A' jr nz,error7 inc de ld b,0d3h jp as_store_2 as.EX: ld hl,b_176d_start call sub_030ah jr nc,error7 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 jr nc,error8 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,error8 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,error8 ret arg.addr_8bit: call get_char_upper 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 error8 test_expr: push bc call expr pop bc ret nc error8: jp ERROR arg.zz: push hl ld hl,t_arg_rp2 jr l181fh arg.reg_16bit: push hl jr l181fh arg.ww: push hl ld hl,t_arg_rp 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_arg_r 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 call get_char_upper 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 call get_char_upper cp '+' jr z,l1882h cp ')' ld hl,0 jr z,l189ah cp '-' jr nz,error9 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: call get_char_upper cp ')' jr nz,error9 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_arg_cc ld c,003h l18b1h: push bc call sub_030ah ld a,b pop bc ret nc and c rlca rlca rlca scf ret assert_comma: call next_arg ret z error9: jp ERROR test_paren_close: call get_char_upper cp ')' jr nz,error9 inc de ret ;------------------------------------------------------------------------------- ; >>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 p_disas_line call crlf pop hl ld c,b ld b,0 add hl,bc ld (last_L),hl ret p_disas_line: call p_label call outbl2 call out.hl.@ call z,outbl call outbl sub a ld (con_col),a push hl pop iy call p_disas_instr ret z ld c,15 call p_goto_col call p_offset call outbl jp p_symbol ;------------------------------------------------------------------------------- p_offset: ld de,(var.@) ld a,d or e ret z call pstr_inl dc '(@' and a sbc hl,de call out_hl add hl,de jp out_rparen ;------------------------------------------------------------------------------- p_disas_instr: sub a ld (disas_argtype),a 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 ex de,hl call call_hl ;print arguments pop bc ld a,(disas_argtype) ld hl,(disas_arg_16) or a 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 jp z,disas_pfx.ED cp 0ddh jr z,l19abh cp 0fdh jr z,l19afh sub_19a0h: ld a,(iy+000h) cp 0cbh jp z,disas_pfx.CB jp 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 ld b,2 ret c ld hl,b_1ab6_start ;1 byte opcodes (no parameters) call sub_1a72h ld b,1 ret c ld hl,b_1ad1_start ;1 byte opcodes call lookup_op ld b,1 ret c ld hl,b_1b9b_start ;3 byte opcodes call lookup_op ret nc ld b,3 ret ;------------------------------------------------------------------------------- disas_pfx.ED: inc iy ld hl,b_1bc9_start ;1 byte opcode, no arguments call sub_1a72h ld b,2 ret c ld hl,b_1bf4_start call lookup_op ld b,2 ret c ld hl,l228bh call lookup_op ld b,3 ret c ld hl,b_1c40_start call lookup_op ld b,4 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 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 ;------------------------------------------------------------------------------- sub_1a72h: ld a,(hl) cp 0ffh ret z cp (iy+000h) jr z,l1a7fh inc hl inc hl jr sub_1a72h l1a7fh: ld de,l1c97h inc hl ld c,(hl) jr get_mnemonic test_DDFD: ld a,(hl) and a ret z inc hl cp (iy+000h) jr nz,test_DDFD scf ret lookup_op: ld a,(iy+000h) and (hl) inc hl cp (hl) jr z,l1aa8h inc hl inc hl inc hl inc hl ld a,(hl) and a jr nz,lookup_op ret l1aa8h: inc hl ld c,(hl) inc hl ld e,(hl) inc hl ld d,(hl) get_mnemonic: ld hl,t_MNEMONICS ld b,0 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 0ffh ; 1 byte opcodes ; Format: db mask, match, t_MNEMONICS-index ; dw argument formating fuction 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 0 ; 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 p_arg_jrel db 0ffh,018h,054h ;jr dw p_arg_jrel db 0e7h,020h,054h ;jr cc, dw p_arg_cc_jrel db 0ffh,0d3h,076h ;out (nn),a dw l1d37h db 0ffh,0dbh,03fh ;in a,(nn) dw l1d29h db 0 ; 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 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 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 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 0 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 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 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 l1c98h: ld a,(iy+000h) and 038h jp out_hex 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 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 jr out_rparen l1cf5h: call p_A_comma jr l1d09h l1cfah: call p_arg_r call p_char_comma ld a,(isprefix_ixiy) and a ld a,(iy+002h) jr nz,l1d0ch l1d09h: ld a,(iy+001h) l1d0ch: jp out_hex p_arg_cc_jrel: ld a,(iy+000h) and 018h call p_arg_cc0 call p_char_comma p_arg_jrel: 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 l1d4eh l1d29h: call p_A_comma sub_1d2ch: call p_char_lparen ld a,(iy+001h) p_arg_nn_rp: call out_hex out_rparen: jr p_char_rparen l1d37h: call sub_1d2ch jr p_char_comma_A p_arg_cc_mn: call p_arg_cc call p_char_comma p_arg_mn: ld l,(iy+001h) ld h,(iy+002h) l1d4eh: ld a,002h sub_1d50h: ld (disas_argtype),a ld (disas_arg_16),hl jp out_hl p_arg_ww_mn: call p_arg_ww call p_char_comma jr p_arg_mn p_arg_addr_hl: call p_arg_addr call p_char_comma jp p_arg_hlixiy p_arg_hl_addr: call p_arg_hlixiy call p_char_comma jp p_arg_addr p_arg_addr_a: call p_arg_addr p_char_comma_A: call p_char_comma jr p_char_A p_A_comma: call p_char_A p_char_comma: ld a,',' db 021h p_char_A: ld a,'A' db 021h l1d85h: ld a,'0' db 021h l1d89h: ld a,'1' db 021h l1d8dh: ld a,'2' db 021h p_char_rparen: ld a,')' db 021h p_char_lparen: ld a,'(' 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' 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 p_arg_addr call p_char_comma jp p_arg_ww p_arg_ww_addr: call p_arg_ww call p_char_comma jr p_arg_addr p_arg_a_addr: call p_A_comma p_arg_addr: call p_char_lparen ld l,(iy+001h) ld h,(iy+002h) ld a,001h call sub_1d50h jr p_char_rparen 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 rra rra and 007h add a,'0' call outchar call p_char_comma pop af jr p_arg_r0 l1e03h: ld a,(isprefix_ixiy) and a jr nz,l1e0eh ld a,(iy+001h) jr l1e11h l1e0eh: ld a,(iy+002h) l1e11h: jr p_arg_r0 p_arg_r: ld a,(iy+000h) rra rra rra jr p_arg_r0 p_arg_rs: ld a,(iy+000h) p_arg_r0: and 007h cp 006h jr nz,p_arg_r1 ld a,(isprefix_ixiy) and a ld a,006h jr z,p_arg_r1 ld hl,b_1e78_start ld a,(isprefix_ixiy) dec a jr z,l1e4dh ld hl,l1e7bh l1e4dh: call pstr ld a,(iy+001h) push af rlca ld a,'+' jr nc,l1e61h pop af neg push af ld a,'-' l1e61h: call outchar pop af jp p_arg_nn_rp p_arg_r1: ld hl,t_arg_r jr p_arg b_1e78_start: DC '(IX' l1e7bh: DC '(IY' p_arg_hlixiy: ld a,(isprefix_ixiy) ld hl,t_HL.IX.IY jr p_arg p_arg_zz: ld hl,t_arg_rp2 jr l1e8eh p_arg_ww: ld hl,t_arg_rp l1e8eh: ld a,(iy+000h) rra rra rra rra and 003h cp 002h jr z,p_arg_hlixiy jr p_arg p_arg_cc: ld a,(iy+000h) p_arg_cc0: rra rra rra and 007h ld hl,t_tstfl_ZCPS p_arg: ld b,a ;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 ;------------------------------------------------------------------------------- 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' 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' 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_arg_cc: DC 'NZ' DC 'Z' DC 'NC' DC 'C' DC 'NE' DC 'EQ' DC 'GE' DC 'LT' DB 0 t_tstfl_ZCPS: DC 'NZ' DC 'Z' DC 'NC' DC 'C' DC 'PO' 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 ;------------------------------------------------------------------------------- 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,b_2039_start call lookup_op ccf ret c ex de,hl l2031h: call CALL_HL call c,bp_trace_enter l2037h: scf ret ;------------------------------------------------------------------------------- b_2039_start: db 0ffh,0ddh,000h ;Prefix DD dw l20a7h db 0ffh,0fdh,000h ;Prefix FD dw l20ach db 0ffh,0edh,000h ;Prefix ED dw l20b8h b_2048_start: db 0ffh,0cdh,000h ;call mn dw l2080h db 0ffh,0c3h,000h ;jp mn dw l208bh db 0ffh,0e9h,000h ;jp () dw l20a2h db 0ffh,0c9h,000h ;ret dw l20dch db 0ffh,0cfh,000h ;rst 8 dw l2115h db 0c7h,0c7h,000h ;rst n dw l20f9h db 0c7h,0c4h,000h ;call cc,mn dw l2080h db 0f7h,010h,000h ;djnz d; jr d dw l2093h db 0e7h,020h,000h ;jr cc,d dw l2093h db 0c7h,0c2h,000h ;jp cc,mn dw l208bh db 0c7h,0c0h,000h ;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 ;jr, djnz 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 ;ret cc 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) ;ret 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) ;break on return address ld e,(hl) inc hl ld d,(hl) ex de,hl call bp_trace_enter ;rst 8 l2115h: and a ret ;rst n 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 jr nz,l2113h ld a,(trace_call_flag) and a ret nz l2113h: 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. cmd_C: ld a,1 jr cmd_tc ;------------------------------------------------------------------------------- ; >>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 cmd_tc: ld (cmd_rpt),hl ld (trace_call_flag),a call get_char_upper sub 'N' jr nz,tc_non inc de tc_non: ld (trace_N_flag),a call get_char_upper sub 'J' jr nz,tc_noj inc de tc_noj: ld (trace_J_flag),a call tc_chk_u_or_w jr z,tc_save_uw_expr_ptr ld hl,1 ;default: 1 step call get_lastarg_def tc_save_uw_expr_ptr: ld (trace_cnt_or_ptr),hl sub a ld (bp_p_cpu_flag),a l214ch: 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_op jr nc,l214ch l216bh: ld a,(trace_UW_flag) ;0 or 'U' or 'W' and a jr z,tc_cnt ;flag is 0, check for step count. ld de,(trace_cnt_or_ptr) call expr ld a,h or l add a,0ffh sbc a,a ld hl,trace_UW_flag ;'U' or 'W' xor (hl) bit 1,a ;'U' = 55H, 'W' = 57H jr z,l2193h do_break0: ;print registers and go to main loop jp do_break tc_cnt: ld hl,(trace_cnt_or_ptr) dec hl ld (trace_cnt_or_ptr),hl ld a,h or l jr z,do_break0 l2193h: call tc_set_bp jr nc,do_break0 ld a,(trace_N_flag) ld b,a ld a,(bp_p_cpu_flag) or b ld (bp_p_cpu_flag),a user_go1: jp user_go tc_chk_u_or_w: call skipbl xor a ld (trace_UW_flag),a call get_char_upper 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 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 ;------------------------------------------------------------------------------- con_col: db 0 ;------------------------------------------------------------------------------- b_21e2_start: db 0 trace_call_flag: db 0 ;1=call, 0=trace trace_UW_flag: db 0 ;0 or 'U' or 'W' trace_cnt_or_ptr: dw 0 trace_N_flag: db 0 ;0 if 'N' trace_J_flag: db 0 ;0 if 'J' bp_p_cpu_flag: db 0 bp_tab: rept BP_CNT rept BP_SIZE db 0 endm endm expr_p1: 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 last_I: dw 0 last_O_addr: dw 0 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 disas_arg_16: dw 0 disas_argtype: db 0 pbl_loop_adr: dw 0 symlen_cur: ;max length of symbols read so far db 0 cur_fcb: dw 0 fcbsym: ds 33 ddtz_size equ $-ddtz_base ddtz_end: ;------------------------------------------------------------------------------- end