page 255 .z80 extrn ?const,?conin,?cono extrn getiff extrn selbnk,@cbnk global ddtz,bpent global $stack include config.inc if CPU_Z180 include z180reg.inc include z180.lib endif BS equ 08h TAB equ 09h CR equ 0dh LF equ 0ah DEL equ 7fh CNTRX equ 'X'-'@' TPA equ 100h TOPRAM equ 0f000h MEMDUMP_CNT equ 16 ;mem dump bytes per line BP_CNT equ 12 ;number of breakbpoints ;-------------------------------------------------- ; ; copy code to common memory and execute it there comst macro call ?excom ds 1 ?lcs defl $ endm ; mark end of common code snippet comend macro ?lce defl $ ?lclen defl ?lce-?lcs org ?lcs-1 db ?lclen org ?lce ifndef ?lcmax ?lcmax defl 0 endif if ?lclen gt ?lcmax ?lcmax defl ?lclen endif endm cseg ;---------------------------------------------------------- MSG: DB 'DDT/Z - HD64180 (ROM)' DB CR,LF,0 HLPMSG: DB 'DDT/Z180 (ROM) Commands:',CR,LF DB '> @ examine/substitute the displacement register @',CR,LF DB '> A [address] Assemble',CR,LF DB '> B[X] display [or clear] all Breakpoints',CR,LF DB ' B breakp [:count] [breakp..] set Breakpoints',CR,LF DB ' BX address [address..] clear Breakpoints',CR,LF DB '>>C[N][J] [count] trace over Calls [No list] [Jumps only]',CR,LF DB ' C[N][J] W|U expression trace over Calls While|Until ...',CR,LF DB '>>D [startadr] [endadr] Display memory in hex and ascii',CR,LF DB '> G [startadr] [;breakp..] Go [to start] [temporary breakpoints]',CR,LF DB '> H [expression [expression]] compute expressions / show High/max load adr.',CR,LF DB '>>I [port] Input a byte from port',CR,LF DB '>>L [startadr] [endadr] List disassembled code',CR,LF DB '> M[V] startadr endadr destadr Move memory [and verify]',CR,LF DB '>>O [byte] [port] Output a byte to port',CR,LF DB '> Q[J] startadr endadr bytes Qery memory for byte string [Justified]',CR,LF DB '> R [displacement] Read intel hex from console [add displacemt]',CR,LF DB '> S address Substitute memory',CR,LF DB '>>T[N][J] [count] Trace [No list] [Jumps only] [count steps]',CR,LF DB ' T[N][J] W|U expression Trace While|Until expression',CR,LF DB '> V startadr endadr destadr Verify (compare) two memory areas',CR,LF DB '> X[register] eXamine [and substitute] registers',CR,LF DB '> Y[0..9] eXamine [and substitute] Y variables',CR,LF DB '> Z startadr endadr bytes Zap (fill) memory with a byte string',CR,LF DB 0 ddtz: ld sp,$stack ld a,(wstrtflg) ;check warm start flag or a ;;; jr nz,ddtz_w exx ld hl,sysramc ld de,topcodbeg ld bc,topcodend-topcodbeg ldir exx if CPU_Z180 ld a,e ld (ubbr),a endif ddtz_w: ld hl,MSG ;073c call PSTR ;073f call ddtei ;0742 ; DDTZ main loop DDTZML: ld sp,$stack ;0761 ld hl,l07eah ;0764 ld (CMD_ERR),hl ;0767 ld hl,(REG.PC) ;076a ld (OFFS.pc),hl ;076d call sub_0e68h ;0770 ld hl,(CMD_RPT) ;0773 ld de,DDTZML ;0776 call CP.HL.DE ;0779 ld a,'>' ;077c call OUTCHAR ;077e call nz,OUTCHAR ;0781 call z,OUTBL ;0784 call INLINE ;0787 call SKIPBL ;078a jr z,exe_hl ;078d ld hl,DDTZML ;078f ld (CMD_RPT),hl ;0792 inc de ;0795 sub '?' ;0796 jr c,ERROR ;0798 cp 'Z'+1-'?' ;079a jr nc,ERROR ;079c add a,a ;079e ld hl,CMDTAB ;079f call ADD_HL_A ;07a2 ld a,(hl) ;07a5 inc hl ;07a6 ld h,(hl) ;07a7 ld l,a ;07a8 jr exe_hl ;07a9 ERROR: ld hl,(CMD_ERR) ;07ab exe_hl: call CALL.HL ;07ae jr DDTZML ;07b1 CALL.HL: jp (hl) ;07b3 CMDTAB: defw CMD.? defw CMD.@ ;07b4 defw CMD.A ;07b6 defw CMD.B ;07b8 defw CMD.C ;07ba defw CMD.D ;07bc defw ERROR ;07be defw ERROR ;07c0 defw CMD.G ;07c2 defw CMD.H ;07c4 defw CMD.I ;07c6 defw ERROR ;07c8 defw ERROR ;07ca defw CMD.L ;07cc defw CMD.M ;07ce defw ERROR ;07d0 defw CMD.O ;07d2 defw ERROR ;07d4 defw CMD.Q ;07d6 defw CMD.R ;07d8 defw CMD.S ;07da defw CMD.T ;07dc defw ERROR ;07de defw CMD.V ;07e0 defw ERROR ;07e2 defw CMD.X ;07e4 defw CMD.Y ;07e6 defw CMD.Z ;07e8 l07eah: ld a,'?' ;07ea call OUTCHAR ;07ec jp CRLF ;07ef CMD.?: call assert_eol ld hl,HLPMSG call PSTR ret $ci: push hl push de push bc call ?conin pop bc pop de pop hl ret $co: push hl push de push bc ld c,a call ?cono pop bc pop de pop hl ret DELC: ld a,b or a ret z call DELC1 dec hl dec b inc c ld a,(hl) cp ' ' ret nc DELC1: push de push hl push bc ld c,BS call ?cono ld c,' ' call ?cono ld c,BS call ?cono pop bc pop hl pop de ret DELL: ld a,b ; or a ; ret z ; call DELC ; jr DELL ; INLINE: push hl ; ld hl,CI.BUF ; ld c,(hl) ; inc hl ; ld b,000h ; inc hl ; inlnxtch: ld a,c ; or a ; jr z,inl_e ; call $ci ; cp CR ; jr z,inl_e ;Accept line cp LF ; jr z,inl_e ;Accept line cp BS ; jr nz,l0844h ; call DELC ;Delete Char jr inlnxtch ; l0844h: cp DEL ; jr nz,l084dh ; call DELC ;Delete Char jr inlnxtch ; l084dh: cp CNTRX ; jr nz,l0856h ; call DELL ;Delete Line jr inlnxtch ; l0856h: cp TAB ; jr nz,l085ch ; ld a,' ' ; l085ch: ld (hl),a ; cp ' ' ; jr nc,l0869h ; ld a,'^' ;Controll characters call $co ; ld a,(hl) ; add a,'@' ; l0869h: call $co ; inc hl ; inc b ; dec c ; jr inlnxtch ; inl_e: ld hl,ci.buf+1 ; ld (hl),b ; call CRLF ; ld de,ci.buf+1 ; ld a,(de) ; ld b,a ; ld c,000h ; inc b ; l0880h: inc de ; dec b ; jr z,l08b2h ; ld a,(de) ; bit 0,c ; call z,UPCASE ; ld (de),a ; cp '''' ; jr nz,l0880h ; push de ; dec de ; ld a,(de) ; cp '''' ; jr z,l08aeh ; dec de ; ld a,(de) ; cp '^' ; jr z,l08a2h ; dec de ; ld a,(de) ; cp '^' ; jr nz,l08aeh ; l08a2h: inc de ; push bc ; call sub_0a0eh ; pop bc ; dec de ; ld a,(de) ; cp '''' ; jr z,l08afh ; l08aeh: inc c ; l08afh: pop de ; jr l0880h ; l08b2h: xor a ; ld (de),a ; ld de,ci.buf+2 ; pop hl ; ret ; UPCASE: cp 'a' ; ret c ; cp 'z'+1 ; ret nc ; and 05fh ; ret ; out.hl.@: call out.hl ; push de ; push hl ; ld de,(offs.@) ; ld a,d ; or e ; jr z,l08ddh ; call OUTBL ; ld a,'@' ; call OUTCHAR ; and a ; sbc hl,de ; call out.hl ; l08ddh: pop hl ; pop de ; ret ; out.bin.w: ld a,h ; call out.bin.b ; ld a,l ; out.bin.b: ld b,008h ; l08e7h: add a,a ; push af ; ld a,0 ; adc a,a ; call out.digit ; pop af ; djnz l08e7h ; ld a,'"' ; jp OUTCHAR ; sub_08f7h: ld a,'-' ; call OUTCHAR ; dec hl ; jp cpl.hl ; out.hl.decm: push hl ; call sub_08f7h ; db 3eh ; ld a,0E5h out.hl.dec: push hl ld b,6 ; call sub_0917h ; pop hl ; ld a,'.' ; call OUTCHAR ; l0911h: call OUTBL ; djnz l0911h ; ret ; sub_0917h: dec b ;0917 push de ;0918 ld de,10 ;0919 call DIV_HL_DE ;091c ld a,h ;091f or l ;0920 call nz,sub_0917h ;0921 ld a,e ;0924 pop de ;0925 jr out.digit ;0926 sub_0928h: push hl ;0928 call sub_08f7h ;0929 call out.hl ;092c pop hl ;092f ret ;0930 out.hl: ld a,h ;0931 call out.hex ;0932 ld a,l ;0935 out.hex: push af ;0936 rra ;0937 rra ;0938 rra ;0939 rra ;093a call out.digit ;093b pop af ;093e out.digit: and 00fh ;093f cp 10 ;0941 jr c,l0947h ;0943 add a,007h ;0945 l0947h: add a,'0' ;0947 jr OUTCHAR ;0949 l094bh: ld a,'-' ;094b call OUTCHAR ;094d ld a,040h ;0950 out.ascii: ex af,af' ;0952 call outquote ;0953 ex af,af' ;0956 push af ;0957 res 7,a ;0958 cp ' ' ;095a jr nc,l0960h ;095c sub 0c0h ;095e l0960h: call OUTCHAR ;0960 push af ;0963 cp '''' ;0964 call z,OUTCHAR ;0966 pop af ;0969 ex af,af' ;096a call outquote ;096b pop af ;096e or a ;096f ld a,'.' ;0970 call m,OUTCHAR ;0972 ex af,af' ;0975 jr c,l094bh ;0976 ret ;0978 outquote: ld a,'''' ;0979 OUTCHAR: push hl push de push bc push af and 07fh ld c,a call ?cono ld hl,CON.COL inc (hl) pop af pop bc pop de pop hl ret ;0988 inchar: push hl push de push bc call ?const and a jr z,inch1 call ?conin scf ;0991 inch1: pop bc pop de pop hl ret ;0992 PSTR: ld c,000h ;0993 l0995h: ld a,(hl) ;0995 and a ;0996 ret z ;0997 call OUTCHAR ;0998 inc c ;099b inc hl ;099c and a ;099d ret m ;099e jr l0995h ;099f outbl6: call outbl2 ;09a1 outbl4: call outbl2 ;09a4 outbl2: call OUTBL ;09a7 OUTBL: ld a,' ' ;09aa jr OUTCHAR ;09ac CRLF: call inchar ;09ae ld a,CR ;09b1 call OUTCHAR ;09b3 ld a,LF ;09b6 call OUTCHAR ;09b8 ld a,000h ;09bb ld (CON.COL),a ;09bd jp c,DDTZML ;09c0 ret ;09c3 ADD_HL_A: add a,l ;09c4 ld l,a ;09c5 ret nc ;09c6 inc h ;09c7 ret ;09c8 SKIPBL0: inc de ;09c9 SKIPBL: ld a,(de) ;09ca cp ' ' ;09cb jr z,SKIPBL0 ;09cd cp 009h ;09cf jr z,SKIPBL0 ;09d1 or a ;09d3 ret ;09d4 skip_to_nextarg: call SKIPBL ;09d5 cp ',' ;09d8 ret nz ;09da inc de ;09db call SKIPBL ;09dc cp a ;09df ret ;09e0 assert_eol: call SKIPBL ;09e1 ret z ;09e4 l09e5h: jp ERROR ;09e5 chk.sp: push hl ;09e8 push de ;09e9 ld hl,0 ;09ea add hl,sp ;09ed ld de,$stack-50 ;09ee call CP.HL.DE ;09f1 pop de ;09f4 pop hl ;09f5 jr c,l09e5h ;09f6 ret ;09f8 CP.HL.DE: and a ;09f9 sbc hl,de ;09fa add hl,de ;09fc ret ;09fd lookupch: ld b,000h ;09fe l0a00h: ld a,(hl) ;0a00 and a ;0a01 ret z ;0a02 ld a,(de) ;0a03 cp (hl) ;0a04 jr z,l0a0bh ;0a05 inc hl ;0a07 inc b ;0a08 jr l0a00h ;0a09 l0a0bh: scf ;0a0b inc de ;0a0c ret ;0a0d sub_0a0eh: ld hl,b_0x132A_start ;0a0e ld b,07fh ;0a11 jr l0a17h ;0a13 sub_0a15h: ld b,0ffh ;0a15 l0a17h: inc b ;0a17 ld a,(hl) ;0a18 and a ;0a19 ret z ;0a1a call l0a27 ;0a1b jr nc,l0a17h ;0a1e res 7,b ;0a20 ret ;0a22 sub_0a23h: push bc ;0a23 res 7,b ;0a24 db 3eh ;0a26 ld a,0c5h l0a27: push bc ;0a27 push de ;0a28 l0a29h: ld a,(de) ;0a29 xor (hl) ;0a2a and 07fh ;0a2b jr nz,l0a41h ;0a2d bit 7,(hl) ;0a2f inc hl ;0a31 inc de ;0a32 jr z,l0a29h ;0a33 scf ;0a35 bit 7,b ;0a36 call z,sub_0d20h ;0a38 jr nc,l0a44h ;0a3b pop af ;0a3d scf ;0a3e pop bc ;0a3f ret ;0a40 l0a41h: call sub_0a50h ;0a41 l0a44h: pop de ;0a44 and a ;0a45 pop bc ;0a46 ret ;0a47 sub_0a48h: inc b ;0a48 l0a49h: dec b ;0a49 ret z ;0a4a call sub_0a50h ;0a4b jr l0a49h ;0a4e sub_0a50h: ld a,(hl) ;0a50 and a ;0a51 ret z ;0a52 l0a53h: ld a,(hl) ;0a53 inc hl ;0a54 and a ;0a55 ret m ;0a56 jr l0a53h ;0a57 get_arg3: call get_arg_range ;0a59 push hl ;0a5c push bc ;0a5d call skip_to_nextarg ;0a5e call get_arg ;0a61 ex de,hl ;0a64 pop bc ;0a65 pop hl ;0a66 ret ;0a67 sub_0a68h: call EXPR ;0a68 jr c,error0 ;0a6b ret ;0a6d get_arg: call sub_0a68h ;0a6e l0a71h: jp assert_eol ;0a71 get_lastarg_def: call get_arg_def ;0a74 jr l0a71h ;0a77 get_arg_def: push hl ;0a79 call EXPR ;0a7a jr c,l0a80h ;0a7d ex (sp),hl ;0a7f l0a80h: pop hl ;0a80 ret ;0a81 sub_0a82h: call sub_0a87h ;0a82 jr l0a71h ;0a85 sub_0a87h: db 0e6h ;0a87 and 037h (clear carry) get_arg_range: scf ex af,af' ;0a89 push bc ;0a8a push hl ;0a8b call EXPR ;0a8c jr nc,l0a97h ;0a8f ex af,af' ;0a91 jr c,error0 ;0a92 ex af,af' ;0a94 pop hl ;0a95 defb 03eh ;0a96 l0a97h: pop af ;0a97 call sub_0aa5h ;0a98 jr nc,l0aa3h ;0a9b ex af,af' ;0a9d pop bc ;0a9e ret nc ;0a9f error0: jp ERROR ;0aa0 l0aa3h: pop af ;0aa3 ret ;0aa4 sub_0aa5h: call skip_to_nextarg ;0aa5 cp 'S' ;0aa8 jr nz,l0aadh ;0aaa inc de ;0aac l0aadh: push hl ;0aad push af ;0aae call EXPR ;0aaf jr c,l0ac3h ;0ab2 ld b,h ;0ab4 ld c,l ;0ab5 pop af ;0ab6 pop hl ;0ab7 jr z,l0ac1h ;0ab8 ld a,c ;0aba sub l ;0abb ld c,a ;0abc ld a,b ;0abd sbc a,h ;0abe ld b,a ;0abf inc bc ;0ac0 l0ac1h: and a ;0ac1 ret ;0ac2 l0ac3h: pop af ;0ac3 pop hl ;0ac4 jr z,error0 ;0ac5 scf ;0ac7 ret ;0ac8 EXPR: call SKIPBL ;0ac9 EXPR1: call do_subexpr ;0acc ret c ;0acf call do_rel_op ;0ad0 ret nc ;0ad3 push bc ;0ad4 push hl ;0ad5 call do_subexpr ;0ad6 jr c,error0 ;0ad9 ex de,hl ;0adb ex (sp),hl ;0adc and a ;0add sbc hl,de ;0ade ld hl,0ffffh ;0ae0 pop de ;0ae3 ret ;0ae4 do_op_eq: jr z,l0af8h ;0ae5 jr l0af7h ;0ae7 do_op_ne: jr nz,l0af8h ;0ae9 jr l0af7h ;0aeb do_op_le: jr z,l0af8h ;0aed do_op_lt: jr c,l0af8h ;0aef jr l0af7h ;0af1 do_op_gt: jr z,l0af7h ;0af3 do_op_ge: jr nc,l0af8h ;0af5 l0af7h: inc hl ;0af7 l0af8h: and a ;0af8 ret ;0af9 do_rel_op: push hl ;0afa ld hl,tab_eq_le_ge ;0afb call lookupch ;0afe jr nc,l0b28h ;0b01 ld a,b ;0b03 or a ;0b04 jr z,l0b1ch ;0b05 ld a,(de) ;0b07 cp '=' ;0b08 jr nz,l0b11h ;0b0a inc de ;0b0c inc b ;0b0d inc b ;0b0e jr l0b1ch ;0b0f l0b11h: bit 0,b ;0b11 jr z,l0b1ch ;0b13 cp '>' ;0b15 jr nz,l0b1ch ;0b17 inc de ;0b19 ld b,005h ;0b1a l0b1ch: ld hl,tab_func_eqlege ;0b1c ld a,b ;0b1f add a,a ;0b20 call ADD_HL_A ;0b21 ld c,(hl) ;0b24 inc hl ;0b25 ld b,(hl) ;0b26 scf ;0b27 l0b28h: pop hl ;0b28 ret ;0b29 tab_eq_le_ge: db '=<>',0 tab_func_eqlege: defw do_op_eq ;0b2e defw do_op_lt ;0b30 defw do_op_gt ;0b32 defw do_op_le ;0b34 defw do_op_ge ;0b36 defw do_op_ne ;0b38 do_subexpr: call do_factor ;0b3a ret c ;0b3d l0b3eh: call do_binary_op ;0b3e push hl ;0b41 push bc ;0b42 call do_factor ;0b43 pop bc ;0b46 ex de,hl ;0b47 ex (sp),hl ;0b48 jr nc,l0b52h ;0b49 pop de ;0b4b ld a,b ;0b4c or c ;0b4d ret z ;0b4e jp ERROR ;0b4f l0b52h: ld a,b ;0b52 or c ;0b53 push bc ;0b54 ret nz ;0b55 pop bc ;0b56 do_op_add: add hl,de ;0b57 l0b58h: pop de ;0b58 jr l0b3eh ;0b59 do_op_sub: and a ;0b5b sbc hl,de ;0b5c jr l0b58h ;0b5e do_op_mlt: push bc if CPU_Z180 ld b,h ld c,e ld h,e ld e,l mlt bc mlt de mlt hl ld a,h add a,c add a,e ld h,a else ld b,h ld c,l ld hl,0 ld a,16 mlt_1: add hl,hl ex de,hl add hl,hl ex de,hl jr nc,mlt_2 add hl,bc mlt_2: dec a jr nz,mlt_1 endif pop bc jr l0b58h do_op_div: call DIV_HL_DE ;0b75 jr l0b58h ;0b78 do_op_mod: call DIV_HL_DE ;0b7a ex de,hl ;0b7d jr l0b58h ;0b7e DIV_HL_DE: push bc ;0b80 ex de,hl ;0b81 ld b,h ;0b82 ld c,l ;0b83 ld hl,0 ;0b84 ld a,16 ;0b87 l0b89h: push af ;0b89 add hl,hl ;0b8a ex de,hl ;0b8b xor a ;0b8c add hl,hl ;0b8d ex de,hl ;0b8e adc a,l ;0b8f sub c ;0b90 ld l,a ;0b91 ld a,h ;0b92 sbc a,b ;0b93 ld h,a ;0b94 inc de ;0b95 jr nc,l0b9ah ;0b96 add hl,bc ;0b98 dec de ;0b99 l0b9ah: pop af ;0b9a dec a ;0b9b jr nz,l0b89h ;0b9c ex de,hl ;0b9e pop bc ;0b9f ret ;0ba0 do_op_and: ld a,h ;0ba1 and d ;0ba2 ld h,a ;0ba3 ld a,l ;0ba4 and e ;0ba5 ld l,a ;0ba6 jr l0b58h ;0ba7 do_op_or: ld a,h ;0ba9 or d ;0baa ld h,a ;0bab ld a,l ;0bac or e ;0bad ld l,a ;0bae jr l0b58h ;0baf do_op_xor: ld a,h ;0bb1 xor d ;0bb2 ld h,a ;0bb3 ld a,l ;0bb4 xor e ;0bb5 ld l,a ;0bb6 jr l0b58h ;0bb7 do_binary_op: push hl ;0bb9 ld hl,tab_op_a ;0bba call lookupch ;0bbd ld a,b ;0bc0 ld hl,tab_func_opa ;0bc1 add a,a ;0bc4 call ADD_HL_A ;0bc5 ld c,(hl) ;0bc8 inc hl ;0bc9 ld b,(hl) ;0bca pop hl ;0bcb ret ;0bcc tab_op_a: DB '+-*/%&!#',0 tab_func_opa: defw do_op_add ;0bd6 defw do_op_sub ;0bd8 defw do_op_mlt ;0bda defw do_op_div ;0bdc defw do_op_mod ;0bde defw do_op_and ;0be0 defw do_op_or ;0be2 defw do_op_xor ;0be4 defw 0 ;0be6 fact_factor: call do_factor ;0be8 ret nc ;0beb jp ERROR ;0bec do_factor: call chk.sp ;0bef call get.number ;0bf2 ret nc ;0bf5 inc de ;0bf6 ld hl,TOPRAM ;0bf7 cp 'T' ;0bfa ret z ;0bfc ld hl,(HILOD) ;0bfd cp 'H' ;0c00 ret z ;0c02 ld hl,(MAXLOD) ;0c03 cp 'M' ;0c06 ret z ;0c08 ld hl,TPA ;0c09 cp 'L' ;0c0c ret z ;0c0e ld hl,(offs.@) ;0c0f cp '@' ;0c12 ret z ;0c14 ld hl,(OFFS.pc) ;0c15 cp '$' ;0c18 ret z ;0c1a cp '-' ;0c1b jr z,fact_factneg ;0c1d cp '~' ;0c1f jr z,fact_factinv ;0c21 cp '+' ;0c23 jr z,fact_factor ;0c25 cp '^' ;0c27 jr z,fact_reg.CPU ;0c29 cp 'Y' ;0c2b jr z,fact_reg.Y ;0c2d cp '(' ;0c2f jr z,fact_mem ;0c31 cp '[' ;0c33 jp z,EXPR_BRCKT ;0c35 [ expression ] cp '''' ;0c38 jr z,fact_factstring ;0c3a dec de ;0c3c scf ;0c3d ret ;0c3e fact_reg.Y: call get.decdigit ;0c3f jp c,ERROR ;0c42 inc de ;0c45 add a,a ;0c46 ld hl,reg.Y ;0c47 call ADD_HL_A ;0c4a ld a,(hl) ;0c4d inc hl ;0c4e ld h,(hl) ;0c4f ld l,a ;0c50 and a ;0c51 ret ;0c52 fact_factstring: ld hl,0 ;0c53 l0c56h: ld a,(de) ;0c56 cp '''' ;0c57 jr z,l0c62h ;0c59 and a ;0c5b ret z ;0c5c l0c5dh: ld h,l ;0c5d ld l,a ;0c5e inc de ;0c5f jr l0c56h ;0c60 l0c62h: inc de ;0c62 ld a,(de) ;0c63 cp '''' ;0c64 jr z,l0c5dh ;0c66 sub '.' ;0c68 or a ;0c6a ret nz ;0c6b inc de ;0c6c set 7,l ;0c6d ret ;0c6f fact_reg.CPU: call sub_1315h ;0c70 jr nc,l0cbbh ;0c73 ld a,(hl) ;0c75 inc hl ;0c76 ld h,(hl) ;0c77 ld l,a ;0c78 and a ;0c79 bit 0,c ;0c7a ret nz ;0c7c ld h,000h ;0c7d ret ;0c7f fact_factneg: call fact_factor ;0c80 dec hl ;0c83 cpl.hl: ld a,h ;0c84 cpl ;0c85 ld h,a ;0c86 ld a,l ;0c87 cpl ;0c88 ld l,a ;0c89 ret ;0c8a fact_factinv: call fact_factor ;0c8b jr cpl.hl ;0c8e fact_mem: call EXPR1 ;0c90 jr c,l0cbbh ;0c93 ld a,(de) ;0c95 cp ')' ;0c96 jr nz,l0cbbh ;0c98 inc de ;0c9a comst ld a,(hl) ;0c9f inc hl ; ld h,(hl) ; comend ld l,a ;0ca7 ld a,(de) ;0ca8 inc de ;0ca9 cp '.' ;0caa ret z ;0cac dec de ;0cad xor a ;0cae ld h,a ;0caf ret ;0cb0 EXPR_BRCKT: call EXPR1 ;0cb1 jr c,l0cbbh ;0cb4 ld a,(de) ;0cb6 cp ']' ;0cb7 inc de ;0cb9 ret z ;0cba l0cbbh: jp ERROR ;0cbb get.number: call get.hexdigit ;0cbe ret c ;0cc1 push de ;0cc2 l0cc3h: inc de ;0cc3 call get.hexdigit ;0cc4 jr nc,l0cc3h ;0cc7 pop de ;0cc9 cp '.' ;0cca jr z,l0d04h ;0ccc cp '"' ;0cce jr z,l0ce9h ;0cd0 ld hl,0 ;0cd2 l0cd5h: call get.hexdigit ;0cd5 jr c,l0ce4h ;0cd8 add hl,hl ;0cda add hl,hl ;0cdb add hl,hl ;0cdc add hl,hl ;0cdd call ADD_HL_A ;0cde inc de ;0ce1 jr l0cd5h ;0ce2 l0ce4h: xor 'H' ;0ce4 ret nz ;0ce6 inc de ;0ce7 ret ;0ce8 l0ce9h: ld hl,0 ;0ce9 l0cech: call get.decdigit ;0cec l0cefh: inc de ;0cef jr c,l0cf8h ;0cf0 add hl,hl ;0cf2 call ADD_HL_A ;0cf3 jr l0cech ;0cf6 l0cf8h: cp '"' ;0cf8 jp nz,ERROR ;0cfa call get.decdigit ;0cfd jr nc,l0cefh ;0d00 or a ;0d02 ret ;0d03 l0d04h: ld hl,0 ;0d04 l0d07h: call get.decdigit ;0d07 inc de ;0d0a jr c,l0d1ah ;0d0b push bc ;0d0d add hl,hl ;0d0e hl *= 10 ld b,h ;0d0f ld c,l ;0d10 add hl,hl ;0d11 add hl,hl ;0d12 add hl,bc ;0d13 pop bc ;0d14 call ADD_HL_A ;0d15 jr l0d07h ;0d18 l0d1ah: cp '.' ;0d1a ret z ;0d1c jp ERROR ;0d1d sub_0d20h: ld a,(de) ;0d20 cp 05bh ;0d21 jr l0d28h ;0d23 get.hexdigit: ld a,(de) ;0d25 sub_0d26h: cp 'F'+1 ;0d26 l0d28h: ccf ;0d28 ret c ;0d29 cp 'A' ;0d2a jr c,l0d32h ;0d2c sub 'A'-10 ;0d2e ret ;0d30 get.decdigit: ld a,(de) ;0d31 l0d32h: cp '9'+1 ;0d32 jr l0d39h ;0d34 get.bindigit: ld a,(de) ;0d36 cp '1'+1 ;0d37 l0d39h: ccf ;0d39 ret c ;0d3a cp '0' ;0d3b ret c ;0d3d sub '0' ;0d3e ret ;0d40 l0d41h: call assert_eol ;0d41 prnt_cpustat: call prnt_f ;0d44 call outbl2 ;0d47 ld hl,b_0x0DFD_start ;0d4a ld de,b_0x0E1D_start ;0d4d ld b,006h ;0d50 l0d52h: call prnt_regs ;0d52 djnz l0d52h ;0d55 push hl ;0d57 push de ;0d58 ld iy,(REG.PC) ;0d59 call sub_1f77h ;0d5d exx ;0d60 ex af,af' ;0d61 call CRLF ;0d62 call prnt_f2 ;0d65 call outbl2 ;0d68 pop de ;0d6b pop hl ;0d6c ld b,007h ;0d6d l0d6fh: call prnt_regs ;0d6f djnz l0d6fh ;0d72 exx ;0d74 ex af,af' ;0d75 and a ;0d76 jr z,l0d7fh ;0d77 call outbl6 ;0d79 call sub_1f5bh ;0d7c l0d7fh: jp crlf ;0d7f prnt_f: ld a,(reg.f) ;0d82 call prnt_flags ;0d85 ld a,(reg.iff) ;0d88 cp 0f3h ;0d8b jp z,outbl ;0d8d ld a,'E' ;0d90 jp outchar ;0d92 prnt_f2: ld a,(reg.f2) ;0d95 call prnt_flags ;0d98 jp outbl ;0d9b prnt_flags: ld b,a ;0d9e ld a,'S' ;0d9f call sub_0dbeh ;0da1 ld a,'Z' ;0da4 call sub_0dbeh ;0da6 rl b ;0da9 ld a,'H' ;0dab call sub_0dbeh ;0dad rl b ;0db0 ld a,'V' ;0db2 call sub_0dbeh ;0db4 ld a,'N' ;0db7 call sub_0dbeh ;0db9 ld a,'C' ;0dbc sub_0dbeh: rl b ;0dbe jp c,OUTCHAR ;0dc0 jp OUTBL ;0dc3 prnt_regs: push bc ;0dc6 push de ;0dc7 call PSTR ;0dc8 ld a,'=' ;0dcb call OUTCHAR ;0dcd ex (sp),hl ;0dd0 ld e,(hl) ;0dd1 inc hl ;0dd2 ld d,(hl) ;0dd3 inc hl ;0dd4 ld a,(hl) ;0dd5 inc hl ;0dd6 push hl ;0dd7 and a ;0dd8 jr z,l0df2h ;0dd9 push af ;0ddb ld a,(de) ;0ddc ld l,a ;0ddd inc de ;0dde ld a,(de) ;0ddf ld h,a ;0de0 pop af ;0de1 dec a ;0de2 jr z,l0dedh ;0de3 call out.hl.@ ;0de5 call z,outbl6 ;0de8 jr l0df6h ;0deb l0dedh: call out.hl ;0ded jr l0df6h ;0df0 l0df2h: ld a,(de) ;0df2 call out.hex ;0df3 l0df6h: call OUTBL ;0df6 pop de ;0df9 pop hl ;0dfa pop bc ;0dfb ret ;0dfc b_0x0DFD_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_0x0E1D_start: defw reg.a ;0e1d defb 000h ;0e1f defw reg.c ;0e20 defb 001h ;0e22 defw reg.e ;0e23 defb 001h ;0e25 defw reg.l ;0e26 defb 001h ;0e28 defw reg.sp ;0e29 defb 001h ;0e2b defw reg.pc ;0e2c defb 002h ;0e2e defw reg.a2 ;0e2f defb 000h ;0e31 defw reg.c2 ;0e32 defb 001h ;0e34 defw reg.e2 ;0e35 defb 001h ;0e37 defw reg.l2 ;0e38 defb 001h ;0e3a defw reg.ix ;0e3b defb 001h ;0e3d defw reg.iy ;0e3e defb 001h ;0e40 defw reg.i ;0e41 dw 0 ;0e43 CMD.G: sub a ;0e45 ld (TCFLG),a ;0e46 ld (XA747),a ;0e49 call EXPR ;0e4c jr c,l0e54h ;0e4f ld (REG.PC),hl ;0e51 l0e54h: call SKIPBL ;0e54 jp z,l1183h ;0e57 cp ';' ;0e5a jp nz,ERROR ;0e5c inc de ;0e5f ld a,002h ;0e60 call sub_0f24h ;0e62 jp l1183h ;0e65 sub_0e68h: ld b,BP_CNT ;0e68 ld ix,bp_tab ;0e6a l0e6eh: ld a,(ix+000h) ;0e6e and 0f1h ;0e71 ld (ix+000h),a ;0e73 call sub_11c5h ;0e76 ld de,BP_SIZE ;0e79 add ix,de ;0e7c djnz l0e6eh ;0e7e ret ;0e80 CMD.B: call SKIPBL ;0e81 jr z,l0ecbh ;0e84 inc de ;0e86 cp 'X' ;0e87 jr z,l0e91h ;0e89 dec de ;0e8b ld a,001h ;0e8c jp sub_0f24h ;0e8e l0e91h: call SKIPBL ;0e91 jr z,l0ea6h ;0e94 l0e96h: call EXPR ;0e96 jp c,assert_eol ;0e99 push de ;0e9c call sub_0ea7h ;0e9d pop de ;0ea0 call skip_to_nextarg ;0ea1 jr l0e96h ;0ea4 l0ea6h: scf ;0ea6 sub_0ea7h: ld b,BP_CNT ;0ea7 ld ix,bp_tab ;0ea9 l0eadh: push af ;0ead jr c,l0ebbh ;0eae ld e,(ix+002h) ;0eb0 ld d,(ix+003h) ;0eb3 call CP.HL.DE ;0eb6 jr nz,l0ec2h ;0eb9 l0ebbh: ld (ix+000h),000h ;0ebb call sub_11c5h ;0ebf l0ec2h: ld de,BP_SIZE ;0ec2 add ix,de ;0ec5 pop af ;0ec7 djnz l0eadh ;0ec8 ret ;0eca l0ecbh: ld b,BP_CNT ;0ecb ld ix,bp_tab ;0ecd l0ed1h: bit 0,(ix+000h) ;0ed1 jr z,l0f1ch ;0ed5 ld a,'R' ;0ed7 bit 4,(ix+000h) ;0ed9 jr nz,l0ee1h ;0edd ld a,' ' ;0edf l0ee1h: call OUTCHAR ;0ee1 call OUTBL ;0ee4 ld l,(ix+002h) ;0ee7 ld h,(ix+003h) ;0eea call out.hl.@ ;0eed call outbl2 ;0ef0 ld a,':' ;0ef3 call OUTCHAR ;0ef5 ld l,(ix+004h) ;0ef8 ld h,(ix+005h) ;0efb call out.hl ;0efe ld l,(ix+006h) ;0f01 ld h,(ix+007h) ;0f04 ld a,h ;0f07 or l ;0f08 jr z,l0f19h ;0f09 call outbl4 ;0f0b ld a,'I' ;0f0e call OUTCHAR ;0f10 call outbl2 ;0f13 call PSTR ;0f16 l0f19h: call CRLF ;0f19 l0f1ch: ld de,BP_SIZE ;0f1c add ix,de ;0f1f djnz l0ed1h ;0f21 ret ;0f23 sub_0f24h: ld b,a ;0f24 call SKIPBL ;0f25 ret z ;0f28 cp 'R' ;0f29 jr nz,l0f30h ;0f2b inc de ;0f2d set 4,b ;0f2e l0f30h: push bc ;0f30 call EXPR ;0f31 jp c,ERROR ;0f34 pop bc ;0f37 bit 0,b ;0f38 push bc ;0f3a push de ;0f3b push hl ;0f3c call nz,sub_0ea7h ;0f3d pop hl ;0f40 call sub_0f68h ;0f41 pop de ;0f44 ld (ix+002h),l ;0f45 ld (ix+003h),h ;0f48 call sub_0f80h ;0f4b ld (ix+004h),l ;0f4e ld (ix+005h),h ;0f51 call sub_0f91h ;0f54 ld (ix+006h),l ;0f57 ld (ix+007h),h ;0f5a call skip_to_nextarg ;0f5d pop af ;0f60 ld (ix+000h),a ;0f61 and 00fh ;0f64 jr sub_0f24h ;0f66 sub_0f68h: ld b,BP_CNT ;0f68 ld ix,bp_tab ;0f6a l0f6eh: ld a,(ix+000h) ;0f6e and 00fh ;0f71 ret z ;0f73 push bc ;0f74 ld bc,BP_SIZE ;0f75 add ix,bc ;0f78 pop bc ;0f7a djnz l0f6eh ;0f7b jp ERROR ;0f7d sub_0f80h: call SKIPBL ;0f80 ld hl,1 ;0f83 cp 03ah ;0f86 ret nz ;0f88 inc de ;0f89 call EXPR ;0f8a jp c,ERROR ;0f8d ret ;0f90 sub_0f91h: call SKIPBL ;0f91 cp 049h ;0f94 ld hl,0 ;0f96 ret nz ;0f99 inc de ;0f9a call SKIPBL ;0f9b push de ;0f9e call EXPR ;0f9f jp c,ERROR ;0fa2 ex de,hl ;0fa5 pop de ;0fa6 push de ;0fa7 sbc hl,de ;0fa8 ld b,h ;0faa ld c,l ;0fab ld hl,(sexp1) ;0fac push hl ;0faf add hl,bc ;0fb0 ld de,sexpbufe ;0fb1 call CP.HL.DE ;0fb4 jp nc,ERROR ;0fb7 pop hl ;0fba ld (sexp2),hl ;0fbb pop de ;0fbe ex de,hl ;0fbf ldir ;0fc0 xor a ;0fc2 ld (de),a ;0fc3 inc de ;0fc4 ex de,hl ;0fc5 ld (sexp1),hl ;0fc6 ld hl,(sexp2) ;0fc9 ret ;0fcc bpddtz: if ROMSYS ld h,ROMEN jr z,l0fd2h inc h l0fd2h: push hl ;save rom enable stat endif push bc push de push ix push iy ld a,i ld h,a ld l,000h push hl ;save I register if CPU_Z180 ld a,0f3h ;DI jp po,l0fe6h ld a,0fbh ;EI else ;NMOS Z80 design flaw call getiff ;return Carry set, if INTs are disabled. ld a,0f3h ;DI jr c,l0fe6h ld a,0fbh ;EI endif l0fe6h: ld (reg.iff),a ld hl,ivtab ld a,h ld i,a call ddtei ex af,af' push af exx push bc push de push hl call bp.unset if CPU_Z180 in0 a,(itc) jp p,l1017h res TRAP,a out0 (itc),a bit UFO,a jr z,l1011h ld hl,(REG.PC) dec hl ld (REG.PC),hl l1011h: ld hl,MSG_trap call PSTR l1017h: endif ld a,(XBFE8) dec a jr z,l1051h call inchar jr c,l102eh call sub_1059h and a jp z,l1183h and 083h jp z,l284ah l102eh: call sub_0e68h call prnt_cpustat ;1031 jp DDTZML if CPU_Z180 MSG_trap: DB CR,LF,'Undefined opcode trap' DB CR,LF,0 endif l1051h: ld (XBFE8),a ;1051 ld c,007h ;1054 jp l119fh ;1056 sub_1059h: ld a,080h ;1059 ex af,af' ;105b sub a ;105c ld (XA747),a ;105d ld b,BP_CNT ;1060 ld ix,bp_tab ;1062 l1066h: ld a,(ix+000h) ;1066 and 007h ;1069 jr z,l107eh ;106b ld e,(ix+002h) ;106d ld d,(ix+003h) ;1070 ld hl,(REG.PC) ;1073 call CP.HL.DE ;1076 push bc ;1079 call z,sub_1087h ;107a pop bc ;107d l107eh: ld de,BP_SIZE ;107e add ix,de ;1081 djnz l1066h ;1083 ex af,af' ;1085 ret ;1086 sub_1087h: ex af,af' ;1087 res 7,a ;1088 ex af,af' ;108a ld e,(ix+006h) ;108b ld d,(ix+007h) ;108e ld a,d ;1091 or e ;1092 ld hl,0ffffh ;1093 call nz,EXPR ;1096 ld a,h ;1099 or l ;109a jr z,l10aeh ;109b ld e,(ix+004h) ;109d ld d,(ix+005h) ;10a0 dec de ;10a3 ld a,d ;10a4 or e ;10a5 jr z,l10b9h ;10a6 ld (ix+004h),e ;10a8 ld (ix+005h),d ;10ab l10aeh: bit 4,(ix+000h) ;10ae ret z ;10b2 ld a,001h ;10b3 ld (XA747),a ;10b5 ret ;10b8 l10b9h: ex af,af' ;10b9 or (ix+000h) ;10ba ex af,af' ;10bd ret bp.unset: ld b,BP_CNT ;10bf ld ix,bp_tab ;10c1 l10c5h: bit 5,(ix+000h) ;10c5 res 5,(ix+000h) ;10c9 jr z,l10e7h ;10cd ld l,(ix+002h) ;10cf ld h,(ix+003h) ;10d2 ld a,(ddtrst) ;10d5 comst ;10e2 cp (hl) ;10dc comend jr nz,l10e7h ;10dd ld a,(ix+001h) ;10df comst ;10e2 ld (hl),a ;10e6 comend l10e7h: res 3,(ix+000h) ;10e7 ld de,BP_SIZE ;10eb add ix,de ;10ee djnz l10c5h ;10f0 ret ;10f2 sub_10f3h: ld b,BP_CNT ;10f3 ld ix,bp_tab ;10f5 l10f9h: ld a,(ix+000h) ;10f9 and 003h ;10fc jr z,l110dh ;10fe ld e,(ix+002h) ;1100 ld d,(ix+003h) ;1103 ld hl,(REG.PC) ;1106 call CP.HL.DE ;1109 ret z ;110c l110dh: ld de,BP_SIZE ;110d add ix,de ;1110 djnz l10f9h ;1112 sub a ;1114 inc a ;1115 ret ;1116 sub_1117h: call sub_0f68h ;1117 ld (ix+004h),001h ;111a ld (ix+005h),000h ;111e ld (ix+002h),l ;1122 ld (ix+003h),h ;1125 ld (ix+006h),000h ;1128 ld (ix+007h),000h ;112c ld a,(XBFE8) ;1130 and a ;1133 ld a,008h ;1134 jr nz,l113ah ;1136 ld a,004h ;1138 l113ah: ld (ix+000h),a ;113a ret ;113d bp.set: ld b,BP_CNT ;113e ld ix,bp_tab ;1140 l1144h: ld a,(ix+000h) ;1144 and c ;1147 jr z,l117bh ;1148 set 5,(ix+000h) ;114a ld l,(ix+002h) ;114e ld h,(ix+003h) ;1151 ld a,(ddtrst) ;115c comst ;115f ld e,(hl) ;1158 ld (hl),a ;1163 comend ld (ix+001h),e ;1159 and 038h ;1164 ld h,0 ;1166 ld l,a ;1168 ld de,bpent ;116f comst ; ld (hl),0c3h ;1169 inc hl ;116e ld (hl),e ;1172 inc hl ;1176 ld (hl),d ;1177 comend l117bh: ld de,BP_SIZE ;117b add ix,de ;117e djnz l1144h ;1180 ret ;1182 l1183h: sub a ;1183 ld (XBFE8),a ;1184 ld a,(XA747) ;1187 and a ;118a call nz,prnt_cpustat ;118b call sub_10f3h ;118e ld c,007h ;1191 jr nz,l119fh ;1193 ld a,001h ;1195 ld (XBFE8),a ;1197 call sub_26e7h ;119a ld c,008h ;119d l119fh: call bp.set ;119f ld sp,$stack ;11a2 set/restore user cpu state pop hl ;11a5 pop de ;11a6 pop bc ;11a7 pop af ;11a8 exx ;11a9 ex af,af' ;11aa pop af ;11ab ld i,a ;11ac pop iy ;11ae pop ix ;11b0 pop de ;11b2 pop bc ;11b3 if ROMSYS pop hl ;11b4 ld a,l ;11b5 and M_MWI ;11b6 ld l,a ;11b8 di ;11b9 in0 a,(dcntl) ;11ba and ~M_MWI ;11bd or l ;11bf ld l,a ;11c0 ld a,h ;11c1 else pop hl di endif jp $go ;11c2 common ram, switch banks and go to user prog sub_11c5h: ld a,(ix+000h) ;11c5 and 003h ;11c8 ret nz ;11ca ld e,(ix+006h) ;11cb ld d,(ix+007h) ;11ce ld a,d ;11d1 or e ;11d2 ret z ;11d3 push bc ;11d4 ld h,d ;11d5 ld l,e ;11d6 sub a ;11d7 ld (ix+006h),a ;11d8 ld (ix+007h),a ;11db ld bc,0ffffh ;11de cpir ;11e1 l11e3h: push de ;11e3 ld de,(sexp1) ;11e4 call CP.HL.DE ;11e8 pop de ;11eb jr nc,l11f9h ;11ec call sub_11ffh ;11ee l11f1h: ld a,(hl) ;11f1 ldi ;11f2 and a ;11f4 jr nz,l11f1h ;11f5 jr l11e3h ;11f7 l11f9h: ld (sexp1),de ;11f9 pop bc ;11fd ret ;11fe sub_11ffh: ld iy,bp_tab ;11ff push de ;1203 l1204h: ld e,(iy+006h) ;1204 ld d,(iy+007h) ;1207 call CP.HL.DE ;120a jr z,l1216h ;120d ld de,BP_SIZE ;120f add iy,de ;1212 jr l1204h ;1214 l1216h: pop de ;1216 ld (iy+006h),e ;1217 ld (iy+007h),d ;121a ret ;121d CMD.Y: call get.decdigit ;121e jr c,l122fh ;1221 inc de ;1223 push af ;1224 call assert_eol ;1225 pop af ;1228 call sub_1248h ;1229 jp l127ch ;122c l122fh: call assert_eol ;122f xor a ;1232 l1233h: push af ;1233 call sub_1248h ;1234 call outbl4 ;1237 pop af ;123a inc a ;123b bit 0,a ;123c push af ;123e call z,CRLF ;123f pop af ;1242 cp LF ;1243 jr c,l1233h ;1245 ret ;1247 sub_1248h: ld c,a ;1248 ld b,0 ;1249 add a,'0'+080h ;124b ld de,msg.Y+1 ;124d ld (de),a ;1250 dec de ;1251 ld hl,reg.Y ;1252 add hl,bc ;1255 add hl,bc ;1256 ex de,hl ;1257 ld c,003h ;1258 jp l129ah ;125a CMD.X: call SKIPBL ;125d call sub_1315h ;1260 jp nc,l0d41h ;1263 call assert_eol ;1266 ld a,b ;1269 cp 01fh ;126a jr z,l12c6h ;126c cp 020h ;126e jr z,l12b6h ;1270 ex de,hl ;1272 ld hl,b_0x132A_start ;1273 call sub_0a48h ;1276 l1279h: call l129ah ;1279 l127ch: call OUTBL ;127c push de ;127f push bc ;1280 call INLINE ;1281 call SKIPBL ;1284 jr z,l1297h ;1287 call get_arg ;1289 ld b,h ;128c ld c,l ;128d pop af ;128e pop hl ;128f ld (hl),c ;1290 bit 0,a ;1291 ret z ;1293 inc hl ;1294 ld (hl),b ;1295 ret ;1296 l1297h: pop af ;1297 pop hl ;1298 ret ;1299 l129ah: ld b,c ;129a call PSTR ;129b ld a,'=' ;129e call OUTCHAR ;12a0 ld a,(de) ;12a3 bit 0,b ;12a4 jp z,out.hex ;12a6 ld l,a ;12a9 inc de ;12aa ld a,(de) ;12ab dec de ;12ac ld h,a ;12ad bit 1,b ;12ae jp z,out.hl ;12b0 jp out.hl.@ ;12b3 l12b6h: call prnt_f ;12b6 ld a,0f3h ;12b9 ld (reg.iff),a ;12bb scf ;12be call sub_12d1h ;12bf ld (reg.f),a ;12c2 ret ;12c5 l12c6h: call prnt_f2 ;12c6 and a ;12c9 call sub_12d1h ;12ca ld (reg.f2),a ;12cd ret ;12d0 sub_12d1h: ex af,af' ;12d1 ld b,000h ;12d2 call outbl ;12d4 call assert_eol ;12d7 call inline ;12da l12ddh: call skipbl ;12dd ld a,b ;12e0 ret z ;12e1 push bc ;12e2 ld hl,tab_pr_flags ;12e3 call lookupch ;12e6 jp nc,error ;12e9 ld a,b ;12ec cp 008h ;12ed jr z,l12feh ;12ef inc b ;12f1 ld a,001h ;12f2 jr l12f7h ;12f4 l12f6h: rlca ;12f6 l12f7h: djnz l12f6h ;12f7 pop bc ;12f9 or b ;12fa ld b,a ;12fb jr l12ddh ;12fc l12feh: ex af,af' ;12fe jp nc,ERROR ;12ff ex af,af' ;1302 ld a,0FBh ;1303 ld (reg.iff),a ;1305 pop bc ;1308 jr l12ddh ;1309 tab_pr_flags: db 'CNV H ZSE' db 0 sub_1315h: call sub_0a0eh ;1315 ret nc ;1318 ld a,b ;1319 add a,b ;131a add a,b ;131b ld hl,b_0x136C_start ;131c call ADD_HL_A ;131f ld c,(hl) ;1322 inc hl ;1323 ld a,(hl) ;1324 inc hl ;1325 ld h,(hl) ;1326 ld l,a ;1327 scf ;1328 ret ;1329 b_0x132A_start: if ROMSYS DC 'ROMSEL' endif if CPU_Z180 DC 'CBAR' DC 'BBR' else DC 'BNK' endif DC 'BC''' DC 'DE''' DC 'HL''' DC 'BC' DC 'DE' DC 'HL' DC 'A''' DC 'B''' DC 'C''' DC 'D''' DC 'E''' DC 'H''' DC 'L''' DC 'A' DC 'B' DC 'C' DC 'D' DC 'E' DC 'H' DC 'L' DC 'IX' DC 'IY' DC 'SP' DC 'PC' DC 'X' DC 'Y' DC 'S' DC 'P' DC 'I' DC 'F''' DC 'F' DB 0 b_0x136C_start: if ROMSYS defb 000h ;13cf defw uromen ;13d0 endif if CPU_Z180 defb 000h ;136c defw ucbar ;136d defb 000h ;136f defw ubbr ;1370 else defb 000h ;136f defw ubnk ;1370 endif defb 003h ;1372 defw reg.c2 ;1373 defb 003h ;1375 defw reg.e2 ;1376 defb 003h ;1378 defw reg.l2 ;1379 defb 003h ;137b defw reg.c ;137c defb 003h ;137e defw reg.e ;137f defb 003h ;1381 defw reg.l ;1382 defb 000h ;1384 defw reg.a2 ;1385 defb 000h ;1387 defw reg.b2 ;1388 defb 000h ;138a defw reg.c2 ;138b defb 000h ;138d defw reg.d2 ;138e defb 000h ;1390 defw reg.e2 ;1391 defb 000h ;1393 defw reg.h2 ;1394 defb 000h ;1396 defw reg.l2 ;1397 defb 000h ;1399 defw reg.a ;139a defb 000h ;139c defw reg.b ;139d defb 000h ;139f defw reg.c ;13a0 defb 000h ;13a2 defw reg.d ;13a3 defb 000h ;13a5 defw reg.e ;13a6 defb 000h ;13a8 defw reg.h ;13a9 defb 000h ;13ab defw reg.l ;13ac defb 003h ;13ae defw reg.ix ;13af defb 003h ;13b1 defw reg.iy ;13b2 defb 003h ;13b4 defw reg.sp ;13b5 defb 003h ;13b7 defw reg.pc ;13b8 defb 003h ;13ba defw reg.ix ;13bb defb 003h ;13bd defw reg.iy ;13be defb 003h ;13c0 defw reg.sp ;13c1 defb 003h ;13c3 defw reg.pc ;13c4 defb 000h ;13c6 defw reg.i ;13c7 defb 000h ;13c9 defw reg.f2 ;13ca defb 000h ;13cc defw reg.f ;13cd CMD.S: ld hl,(lst.S) ;13d2 call get_lastarg_def ;13d5 l13d8h: ld (lst.S),hl ;13d8 call out.hl.@ ;13db call OUTBL ;13de comst ;13e1 ld a,(hl) ;13e5 comend call out.hex ;13e6 call outbl2 ;13e9 call INLINE ;13ec call SKIPBL ;13ef inc hl ;13f2 jr z,l13d8h ;13f3 dec hl ;13f5 inc de ;13f6 cp '.' ;13f7 jp z,assert_eol ;13f9 cp '-' ;13fc jr nz,l1406h ;13fe ld a,(de) ;1400 or a ;1401 dec hl ;1402 jr z,l13d8h ;1403 inc hl ;1405 l1406h: dec de ;1406 call get_bytes_m ;1407 jr l13d8h ;140a CMD.@: call assert_eol ;140c ld hl,MSG_at ;140f ld de,offs.@ ;1412 ld c,001h ;1415 jp l1279h ;1417 MSG_at: dc '@' CMD.I: ld hl,CMD.I ;141b ld (CMD_RPT),hl ;141e ld hl,(lst.IP) ;1421 call get_lastarg_def ;1424 ld (lst.IP),hl ;1427 ld b,h ;142a ld c,l ;142b if CPU_Z180 ld a,b ;142c or a ;142d jr nz,l1442h ;142e ld a,c ;1430 ld hl,ucbar ;1431 cp cbar ;1434 jr z,l143fh ;1436 ld hl,ubbr ;1438 cp bbr ;143b jr nz,l1442h ;143d l143fh: ld a,(hl) ;143f jr l1444h ;1440 l1442h: endif in a,(c) ;1442 l1444h: push af ;1444 call out.hex ;1445 call outbl4 ;1448 pop af ;144b call out.bin.b ;144c jp CRLF ;144f CMD.O: ld hl,CMD.O ;1452 ld (CMD_RPT),hl ;1455 ld hl,(lst.OD) ;1458 call get_arg_def ;145b ld a,l ;145e ld (lst.OD),a ;145f push af ;1462 call skip_to_nextarg ;1463 ld hl,(lst.OP) ;1466 call get_lastarg_def ;1469 ld (lst.OP),hl ;146c ld b,h ;146f ld c,l ;1470 if CPU_Z180 ld a,b ;1471 or a ;1472 jr nz,l1489h ;1473 ld a,c ;1475 ld hl,ucbar ;1476 cp cbar ;1479 jr z,l148dh ;147b ld hl,ubbr ;147d cp bbr ;1480 jr z,l148dh ;1482 cp cbr ;1484 jp z,ERROR ;1486 l1489h: endif pop af ;1489 out (c),a ;148a ret ;148c if CPU_Z180 l148dh: pop af ;148d ld (hl),a ;148e ret ;148f endif CMD.V: call get_arg3 ;1490 get from, size, to cmp_mem: push bc ;1493 comst ;1494 ld a,(de) ;1498 ld b,(hl) ;1499 comend cp b ;149a jr z,l14bah ;149b ld c,a ;149d call out.hl.@ ;149e call OUTBL ;14a1 ld a,b ;14a4 call out.hex ;14a5 call outbl2 ;14a8 ld a,c ;14ab call out.hex ;14ac call OUTBL ;14af ex de,hl ;14b2 call out.hl.@ ;14b3 ex de,hl ;14b6 call CRLF ;14b7 l14bah: pop bc ;14ba inc hl ;14bb inc de ;14bc dec bc ;14bd ld a,b ;14be or c ;14bf jr nz,cmp_mem ;14c0 ret ;14c2 CMD.M: ld a,(de) ;14c3 cp 'V' ;14c4 jr nz,bm_nv ;14c6 inc de ;14c8 bm_nv: push af ;14c9 save 'V' flag call get_arg3 ;14ca push hl ;14cd push de ;14ce push bc ;14cf call CP.HL.DE ;14d0 jr nc,bm_mvdown ;14d3 add hl,bc ;14d5 ex de,hl ;14d6 add hl,bc ;14d7 ex de,hl ;14d8 dec hl ;14d9 dec de ;14da comst ;14db lddr ;14df comend jr bm_done ;14e1 bm_mvdown: comst ;14e3 ldir ;14e7 comend bm_done: pop bc ;14e9 pop de ;14ea pop hl ;14eb pop af ;14ec jr z,cmp_mem ;14ed validate? ret ;14ef CMD.H: call EXPR ;14f0 jp c,l173ch ;14f3 call skip_to_nextarg ;14f6 push hl ;14f9 call EXPR ;14fa push af ;14fd call assert_eol ;14fe pop af ;1501 ex de,hl ;1502 pop hl ;1503 jr c,l1511h ;1504 push hl ;1506 push de ;1507 add hl,de ;1508 call l1511h ;1509 pop de ;150c pop hl ;150d and a ;150e sbc hl,de ;150f l1511h: call out.hl ;1511 val call outbl2 ;1514 call sub_0928h ;1517 -val call outbl4 ;151a call out.hl.dec ;151d dec call outbl2 ;1520 call out.hl.decm ;1523 -dec call outbl4 ;1526 call out.bin.w ;1529 bin call outbl2 ;152c ld a,l ;152f call out.ascii ;1530 jp CRLF ;1533 CMD.Q: ld a,(de) ;1536 sub 'J' ;1537 ld (lst.Qj),a ;1539 jr nz,l153fh ;153c inc de ;153e l153fh: call get_arg_range ;153f push bc ;1542 push hl ;1543 call sub_15a7h ;1544 pop hl ;1547 l1548h: call sub_1594h ;1548 jr nz,l1562h ;154b push bc ;154d push hl ;154e ld a,(lst.Qj) ;154f or a ;1552 jr nz,l1559h ;1553 ld bc,-8 ;1555 add hl,bc ;1558 l1559h: ld bc,MEMDUMP_CNT ;1559 and a ;155c call memdump ;155d pop hl ;1560 pop bc ;1561 l1562h: inc hl ;1562 ex (sp),hl ;1563 dec hl ;1564 ld a,h ;1565 or l ;1566 ex (sp),hl ;1567 jr nz,l1548h ;1568 pop bc ;156a ret ;156b CMD.Z: call get_arg_range ;156c push bc ;156f push hl ;1570 call sub_15a7h ;1571 ld a,b ;1574 pop hl ;1575 pop bc ;1576 push hl ;1577 ex de,hl ;1578 l1579h: push af ;1579 ld a,(hl) ;157a comst ;157b ld (de),a ;157f comend pop af ;1580 inc de ;1581 cpi ;1582 jp po,l1592h ;1584 dec a ;1587 jr nz,l1579h ;1588 pop hl ;158a comst ;158b ldir ;158f comend ret ;1591 l1592h: pop hl ;1592 ret ;1593 sub_1594h: push hl ;1594 push de ;1595 push bc ;1596 l1597h: ld a,(de) ;1597 comst ;1598 cp (hl) ;159c comend jr nz,l15a3h ;159d inc de ;159f inc hl ;15a0 djnz l1597h ;15a1 l15a3h: pop bc ;15a3 pop de ;15a4 pop hl ;15a5 ret ;15a6 sub_15a7h: ld hl,ci.buf+1 ;15a7 call get_bytes ;15aa ld de,ci.buf+1 ;15ad and a ;15b0 sbc hl,de ;15b1 ld b,l ;15b3 ret nz ;15b4 jp ERROR ;15b5 get_bytes: db 0e6h ;15b8 and 037h (clear carry, skip next opc) get_bytes_m: scf l15bah: push af ;15ba call skip_to_nextarg ;15bb cp 'W' ;15be jr nz,l15d9h ;15c0 inc de ;15c2 push hl ;15c3 call sub_0a68h ;15c4 ex de,hl ;15c7 pop bc ;15c8 pop af ;15c9 push af ;15ca push bc ;15cb ex (sp),hl ;15cc jr nc,l15d3h ;15cd comst ;15cf l15d3h: ld (hl),e ;15d3 comend inc hl ;15d4 ld c,d ;15d5 pop de ;15d6 jr l15e5h ;15d7 l15d9h: cp '''' ;15d9 jr z,l15f1h ;15db push hl ;15dd call EXPR ;15de ld c,l ;15e1 pop hl ;15e2 jr c,l1626h ;15e3 l15e5h: pop af ;15e5 push af ;15e6 jr nc,l15edh ;15e7 comst ;15e9 l15edh: ld (hl),c ;15ed comend inc hl ;15ee jr l161eh ;15ef l15f1h: inc de ;15f1 ld a,(de) ;15f2 cp '''' ;15f3 jr z,l1607h ;15f5 or a ;15f7 jr z,l1626h ;15f8 l15fah: ld c,a ;15fa pop af ;15fb push af ;15fc jr nc,l1603h ;15fd comst ;15ff l1603h: ld (hl),c ;1603 comend inc hl ;1604 jr l15f1h ;1605 l1607h: inc de ;1607 ld a,(de) ;1608 cp '''' ;1609 jr z,l15fah ;160b cp '.' ;160d jr nz,l161eh ;160f inc de ;1611 dec hl ;1612 pop af ;1613 push af ;1614 jr nc,l161bh ;1615 comst ;1617 l161bh: set 7,(hl) ;161b comend inc hl ;161d l161eh: pop af ;161e jr nc,l15bah ;161f ld (lst.S),hl ;1621 jr l15bah ;1624 l1626h: pop af ;1626 ret nc ;1627 ld (lst.S),hl ;1628 ret ;162b CMD.D: ld hl,CMD.D ;162c ld (CMD_RPT),hl ;162f ld hl,(lst.D) ;1632 ld bc,00080h ;1635 call sub_0a82h ;1638 scf ;163b memdump: push bc ;163c push de ;163d push hl ;163e ex af,af' ;163f l1640h: call out.hl.@ ;1640 call z,outbl2 ;1643 call OUTBL ;1646 ld de,0 ;1649 l164ch: comst ;164c ld a,(hl) ;1650 comend inc hl ;1651 call out.hex ;1652 call OUTBL ;1655 dec bc ;1658 inc e ;1659 ld a,e ;165a cp 010h ;165b jr z,l1668h ;165d and 003h ;165f call z,OUTBL ;1661 ld a,b ;1664 or c ;1665 jr nz,l164ch ;1666 l1668h: call OUTBL ;1668 and a ;166b sbc hl,de ;166c l166eh: comst ;166e ld a,(hl) ;1672 comend call sub_168fh ;1673 call OUTCHAR ;1676 inc hl ;1679 dec e ;167a jr nz,l166eh ;167b ex af,af' ;167d jr nc,l1683h ;167e ld (lst.D),hl ;1680 l1683h: ex af,af' ;1683 call CRLF ;1684 ld a,b ;1687 or c ;1688 jr nz,l1640h ;1689 pop hl ;168b pop de ;168c pop bc ;168d ret ;168e sub_168fh: and 07fh ;168f cp 07fh ;1691 jr z,l1698h ;1693 cp 020h ;1695 ret nc ;1697 l1698h: ld a,02eh ;1698 ret ;169a ; Read Intel Hex File from console. CMD.R: ld hl,0 ;169b call get_lastarg_def ;169e get offset from command line push hl ;16a1 ld hl,0 ;16a2 ld (HILOD),hl ;16a5 w_recstart: call i.getchar ;16a8 jr z,l16deh ;16ab cp ':' ;16ad jr nz,w_recstart ;16af ld c,0 ;16b1 init checksum call i.gethexbyte ;16b3 record len ld b,a ;16b6 call i.gethexbyte ;16b7 address high ld h,a ;16ba call i.gethexbyte ;16bb address low ld l,a ;16be call i.gethexbyte ;16bf record type (ignored) ld a,b ;16c2 and a ;16c3 record len == 0? jr z,l16deh ;16c4 l16c6h: call i.gethexbyte ;16c6 pop de ;16c9 offset push de ;16ca push hl ;16cb add hl,de ;16cc call i.storebyte ;16cd pop hl ;16d0 inc hl ;16d1 djnz l16c6h ;16d2 repeat for record len call i.gethexbyte ;16d4 checksum ld a,c ;16d7 and a ;16d8 jp nz,ERROR ;16d9 exit if checksum error jr w_recstart ;16dc next record l16deh: pop hl ;16de call i.gethexbyte ;16df jp l173fh ;16e2 i.gethexbyte: call sub_16f6h ;16e5 rlca ;16e8 rlca ;16e9 rlca ;16ea rlca ;16eb ld d,a ;16ec call sub_16f6h ;16ed add a,d ;16f0 ld d,a ;16f1 add a,c ;16f2 ld c,a ;16f3 ld a,d ;16f4 ret ;16f5 sub_16f6h: call i.getchar ;16f6 jr z,l16ffh ;16f9 call sub_0d26h ;16fb ret nc ;16fe l16ffh: jp ERROR ;16ff i.getchar: call $ci ;1702 cp 01ah ;1705 ret ;1707 i.storebyte: push af ;1708 push de ;1709 ld de,TPA ;170a lowest allowed load address call CP.HL.DE ;170d jp c,ERROR ;1710 ld de,$stcka ;1713 highest allowed load address call CP.HL.DE ;1716 jp nc,ERROR ;1719 ld de,(HILOD) ;171c call CP.HL.DE ;1720 jr c,l1728h ;1723 ld (HILOD),hl ;1725 l1728h: ld de,(MAXLOD) ;1728 call CP.HL.DE ;172c jr c,l1734h ;172f ld (MAXLOD),hl ;1731 l1734h: pop de ;1734 pop af ;1735 comst ;1736 ld (hl),a ;173a store byte comend ret ;173b l173ch: call assert_eol ;173c l173fh: ld hl,MSG_high ;173f call PSTR ;1742 ld hl,(HILOD) ;1745 call out.hl ;1748 ld hl,MSG_max ;174b call PSTR ;174e ld hl,(MAXLOD) ;1751 call out.hl ;1754 jp CRLF ;1757 MSG_high: DC 'High = ' MSG_max: DC ' Max = ' CMD.A: ld hl,(lst.A) ;1769 call get_lastarg_def ;176c push hl ;176f pop iy ;1770 ld hl,l17c4h ;1772 ld (CMD_ERR),hl ;1775 ld (XB068),sp ;1778 l177ch: push iy ;177c pop hl ;177e ld (lst.A),hl ;177f ld (OFFS.pc),hl ;1782 push hl ;1785 call sub_1f3fh ;1786 pop iy ;1789 ld c,b ;178b ld de,(offs.@) ;178c ld a,d ;1790 or e ;1791 ld b,011h ;1792 jr z,l1798h ;1794 ld b,019h ;1796 l1798h: call OUTBL ;1798 ld a,(CON.COL) ;179b cp b ;179e jr c,l1798h ;179f push bc ;17a1 call INLINE ;17a2 pop bc ;17a5 call SKIPBL ;17a6 cp '.' ;17a9 ret z ;17ab cp '-' ;17ac jr nz,l17b6h ;17ae ld iy,(XB06C) ;17b0 jr l177ch ;17b4 l17b6h: and a ;17b6 call nz,sub_17cdh ;17b7 ld (XB06C),iy ;17ba ld b,0 ;17be add iy,bc ;17c0 jr l177ch ;17c2 l17c4h: call l07eah ;17c4 ld sp,(XB068) ;17c7 jr l177ch ;17cb sub_17cdh: call SKIPBL ;17cd ld hl,t_MNEMONICS ;17d0 call sub_0a15h ;17d3 jp nc,ERROR ;17d6 call SKIPBL ;17d9 push de ;17dc ld a,b ;17dd add a,b ;17de add a,b ;17df ld hl,b_0x17EE_start ;17e0 call ADD_HL_A ;17e3 ld e,(hl) ;17e6 inc hl ;17e7 ld d,(hl) ;17e8 inc hl ;17e9 ld b,(hl) ;17ea ex de,hl ;17eb pop de ;17ec jp (hl) ;17ed b_0x17EE_start: defw l1b54h ;17ee b_0x17F0_start: defb 088h ;17f0 b_0x17F1_start: defw l1b74h ;17f1 b_0x17F3_start: defb 080h ;17f3 b_0x17F4_start: defw l1babh ;17f4 b_0x17F6_start: defb 0a0h ;17f6 b_0x17F7_start: defw l1c14h ;17f7 b_0x17F9_start: defb 040h ;17f9 b_0x17FA_start: defw l1c38h ;17fa b_0x17FC_start: defb 0c4h ;17fc b_0x17FD_start: defw l1b36h ;17fd b_0x17FF_start: defb 03fh ;17ff b_0x1800_start: defw l1babh ;1800 b_0x1802_start: defb 0b8h ;1802 b_0x1803_start: defw gen.opc.ED2 ;1803 b_0x1805_start: defb 0a9h ;1805 b_0x1806_start: defw gen.opc.ED2 ;1806 b_0x1808_start: defb 0b9h ;1808 b_0x1809_start: defw gen.opc.ED2 ;1809 b_0x180B_start: defb 0a1h ;180b b_0x180C_start: defw gen.opc.ED2 ;180c b_0x180E_start: defb 0b1h ;180e b_0x180F_start: defw l1b36h ;180f b_0x1811_start: defb 02fh ;1811 b_0x1812_start: defw l1b36h ;1812 b_0x1814_start: defb 027h ;1814 b_0x1815_start: defw l1dabh ;1815 b_0x1817_start: defb 005h ;1817 b_0x1818_start: defw l1b36h ;1818 b_0x181A_start: defb 0f3h ;181a b_0x181B_start: defw l1ca4h ;181b b_0x181D_start: defb 010h ;181d b_0x181E_start: defw l1b36h ;181e b_0x1820_start: defb 0fbh ;1820 b_0x1821_start: defw l1d54h ;1821 b_0x1823_start: defb 0e3h ;1823 b_0x1824_start: defw l1b36h ;1824 b_0x1826_start: defb 0d9h ;1826 b_0x1827_start: defw l1b36h ;1827 b_0x1829_start: defb 076h ;1829 b_0x182A_start: defw l1cbfh ;182a b_0x182C_start: defb 046h ;182c b_0x182D_start: defw l1cf8h ;182d b_0x182F_start: defb 040h ;182f b_0x1830_start: defw l1dabh ;1830 b_0x1832_start: defb 004h ;1832 b_0x1833_start: defw gen.opc.ED2 ;1833 b_0x1835_start: defb 0aah ;1835 b_0x1836_start: defw gen.opc.ED2 ;1836 b_0x1838_start: defb 0bah ;1838 b_0x1839_start: defw gen.opc.ED2 ;1839 b_0x183B_start: defb 0a2h ;183b b_0x183C_start: defw gen.opc.ED2 ;183c b_0x183E_start: defb 0b2h ;183e b_0x183F_start: defw l1c5eh ;183f b_0x1841_start: defb 0c2h ;1841 b_0x1842_start: defw l1cabh ;1842 b_0x1844_start: defb 020h ;1844 b_0x1845_start: defw l1934h ;1845 b_0x1847_start: defb 040h ;1847 b_0x1848_start: defw gen.opc.ED2 ;1848 b_0x184A_start: defb 0a8h ;184a b_0x184B_start: defw gen.opc.ED2 ;184b b_0x184D_start: defb 0b8h ;184d b_0x184E_start: defw gen.opc.ED2 ;184e b_0x1850_start: defb 0a0h ;1850 b_0x1851_start: defw gen.opc.ED2 ;1851 b_0x1853_start: defb 0b0h ;1853 b_0x1854_start: defw gen.opc.ED2 ;1854 b_0x1856_start: defb 044h ;1856 b_0x1857_start: defw l1b36h ;1857 b_0x1859_start: defb 000h ;1859 b_0x185A_start: defw l1babh ;185a b_0x185C_start: defb 0b0h ;185c b_0x185D_start: defw gen.opc.ED2 ;185d b_0x185F_start: defb 0bbh ;185f b_0x1860_start: defw gen.opc.ED2 ;1860 b_0x1862_start: defb 0b3h ;1862 b_0x1863_start: defw l1d2ch ;1863 b_0x1865_start: defb 041h ;1865 b_0x1866_start: defw gen.opc.ED2 ;1866 b_0x1868_start: defb 0abh ;1868 b_0x1869_start: defw gen.opc.ED2 ;1869 b_0x186B_start: defb 0a3h ;186b b_0x186C_start: defw l1ce4h ;186c b_0x186E_start: defb 0c1h ;186e b_0x186F_start: defw l1ce4h ;186f b_0x1871_start: defb 0c5h ;1871 b_0x1872_start: defw l1c14h ;1872 b_0x1874_start: defb 080h ;1874 b_0x1875_start: defw l1c50h ;1875 b_0x1877_start: defb 0c0h ;1877 b_0x1878_start: defw gen.opc.ED2 ;1878 b_0x187A_start: defb 04dh ;187a b_0x187B_start: defw gen.opc.ED2 ;187b b_0x187D_start: defb 045h ;187d b_0x187E_start: defw l1bd8h ;187e b_0x1880_start: defb 010h ;1880 b_0x1881_start: defw l1b36h ;1881 b_0x1883_start: defb 017h ;1883 b_0x1884_start: defw l1bd8h ;1884 b_0x1886_start: defb 000h ;1886 b_0x1887_start: defw l1b36h ;1887 b_0x1889_start: defb 007h ;1889 b_0x188A_start: defw gen.opc.ED2 ;188a b_0x188C_start: defb 06fh ;188c b_0x188D_start: defw l1bd8h ;188d b_0x188F_start: defb 018h ;188f b_0x1890_start: defw l1b36h ;1890 b_0x1892_start: defb 01fh ;1892 b_0x1893_start: defw l1bd8h ;1893 b_0x1895_start: defb 008h ;1895 b_0x1896_start: defw l1b36h ;1896 b_0x1898_start: defb 00fh ;1898 b_0x1899_start: defw gen.opc.ED2 ;1899 b_0x189B_start: defb 067h ;189b b_0x189C_start: defw l1cd5h ;189c b_0x189E_start: defb 0c7h ;189e b_0x189F_start: defw l1b54h ;189f b_0x18A1_start: defb 098h ;18a1 b_0x18A2_start: defw l1b36h ;18a2 b_0x18A4_start: defb 037h ;18a4 b_0x18A5_start: defw l1c14h ;18a5 b_0x18A7_start: defb 0c0h ;18a7 b_0x18A8_start: defw l1bd8h ;18a8 b_0x18AA_start: defb 020h ;18aa b_0x18AB_start: defw l1bd8h ;18ab b_0x18AD_start: defb 028h ;18ad b_0x18AE_start: defw l1bd8h ;18ae b_0x18B0_start: defb 038h ;18b0 b_0x18B1_start: defw l1babh ;18b1 b_0x18B3_start: defb 090h ;18b3 b_0x18B4_start: defw l1babh ;18b4 b_0x18B6_start: defb 0a8h ;18b6 b_0x18B7_start: defw A.IN0 ;18b7 b_0x18B9_start: defb 000h ;18b9 b_0x18BA_start: defw A.MLT ;18ba b_0x18BC_start: defb 04ch ;18bc ld b,e ;18bd dec de ;18be b_0x18BF_start: defb 08bh ;18bf b_0x18C0_start: defw gen.opc.ED2 ;18c0 b_0x18C2_start: defb 09bh ;18c2 b_0x18C3_start: defw gen.opc.ED2 ;18c3 b_0x18C5_start: defb 083h ;18c5 b_0x18C6_start: defw gen.opc.ED2 ;18c6 b_0x18C8_start: defb 093h ;18c8 b_0x18C9_start: defw l18fdh ;18c9 b_0x18CB_start: defb 001h ;18cb b_0x18CC_start: defw gen.opc.ED2 ;18cc b_0x18CE_start: defb 076h ;18ce b_0x18CF_start: defw l191dh ;18cf b_0x18D1_start: defb 004h ;18d1 b_0x18D2_start: defw l192ch ;18d2 b_0x18D4_start: defb 074h ;18d4 A.IN0: call sub_1e41h ;18d5 jr nc,l1931h ;18d8 cp 006h ;18da jr z,l1931h ;18dc rlca ;18de rlca ;18df rlca ;18e0 add a,b ;18e1 ld b,a ;18e2 call sub_1ed1h ;18e3 call sub_1e06h ;18e6 l18e9h: call assert_eol ;18e9 comst ;18ec ld (iy+000h),0edh ;18f0 ld (iy+001h),b ;18f4 ld (iy+002h),l ;18f7 comend ld c,003h ;18fa ret ;18fc l18fdh: call sub_1e06h ;18fd call sub_1ed1h ;1900 call sub_1e41h ;1903 jr nc,l1931h ;1906 cp 006h ;1908 jr z,l1931h ;190a rlca ;190c rlca ;190d rlca ;190e add a,b ;190f ld b,a ;1910 jr l18e9h ;1911 A.MLT: call sub_1e2eh ;1913 jr nc,l1931h ;1916 add a,b ;1918 ld b,a ;1919 jp gen.opc.ED2 ;191a l191dh: call sub_1e41h ;191d jr nc,l192ah ;1920 rlca ;1922 rlca ;1923 rlca ;1924 add a,b ;1925 ld b,a ;1926 jp gen.opc.ED2 ;1927 l192ah: ld b,064h ;192a l192ch: call sub_1e12h ;192c jr l18e9h ;192f l1931h: jp ERROR ;1931 l1934h: call sub_1e41h ;1934 jp c,l19bfh ;1937 call sub_1e68h ;193a jp c,l1a64h ;193d call sub_1e2eh ;1940 jp c,l1a93h ;1943 call sub_1e50h ;1946 jp c,l1af0h ;1949 ld a,(de) ;194c cp 049h ;194d jp z,l1b0ch ;194f cp 052h ;1952 jp z,l1b14h ;1954 cp 028h ;1957 jp nz,ERROR ;1959 inc de ;195c call sub_1e2eh ;195d jp c,l1b23h ;1960 call tst_EXPR ;1963 call sub_1ed8h ;1966 call sub_1ed1h ;1969 call sub_1e2eh ;196c jr c,l19adh ;196f call sub_1e50h ;1971 jr nc,l1991h ;1974 ld b,022h ;1976 l1978h: call assert_eol ;1978 ld a,(pfx.IXY) ;197b l197eh: comst ;197e ld (iy+000h),a ;1982 ld (iy+001h),b ;1985 ld (iy+002h),l ;1988 ld (iy+003h),h ;198b comend ld c,004h ;198e ret ;1990 l1991h: ld a,(de) ;1991 cp 041h ;1992 jp nz,ERROR ;1994 inc de ;1997 ld b,032h ;1998 l199ah: call assert_eol ;199a comst ;199d ld (iy+000h),b ;19a1 ld (iy+001h),l ;19a4 ld (iy+002h),h ;19a7 comend ld c,003h ;19aa ret ;19ac l19adh: cp 020h ;19ad jr z,l19bbh ;19af add a,043h ;19b1 ld b,a ;19b3 l19b4h: call assert_eol ;19b4 ld a,0edh ;19b7 jr l197eh ;19b9 l19bbh: ld b,022h ;19bb jr l199ah ;19bd l19bfh: ld b,a ;19bf call sub_1ed1h ;19c0 call sub_1e41h ;19c3 jr nc,l19dbh ;19c6 push af ;19c8 ld a,b ;19c9 rlca ;19ca rlca ;19cb rlca ;19cc ld b,a ;19cd pop af ;19ce add a,b ;19cf add a,040h ;19d0 cp 076h ;19d2 jp z,ERROR ;19d4 l19d7h: ld b,a ;19d7 jp l1b36h ;19d8 l19dbh: call sub_1e68h ;19db jr nc,l1a02h ;19de ld a,b ;19e0 rlca ;19e1 rlca ;19e2 rlca ;19e3 add a,046h ;19e4 cp 076h ;19e6 jp z,ERROR ;19e8 l19ebh: ld b,a ;19eb call assert_eol ;19ec ld a,(pfx.IXY) ;19ef comst ;19f2 ld (iy+000h),a ;19f6 ld (iy+001h),b ;19f9 ld (iy+002h),c ;19fc comend ld c,003h ;19ff ret ;1a01 l1a02h: ld a,(de) ;1a02 cp 'I' ;1a03 jr z,l1a15h ;1a05 cp 'R' ;1a07 jr nz,l1a21h ;1a09 ld a,b ;1a0b cp 007h ;1a0c jp nz,ERROR ;1a0e ld b,05fh ;1a11 jr l1a1dh ;1a13 l1a15h: ld a,b ;1a15 cp 007h ;1a16 jp nz,ERROR ;1a18 ld b,057h ;1a1b l1a1dh: inc de ;1a1d jp gen.opc.ED2 ;1a1e l1a21h: cp '(' ;1a21 jr z,l1a3fh ;1a23 call sub_1e12h ;1a25 ld a,b ;1a28 ld r,nn rlca ;1a29 rlca ;1a2a rlca ;1a2b add a,006h ;1a2c l1a2eh: ld b,a ;1a2e l1a2fh: call assert_eol ;1a2f comst ;1a32 ld (iy+000h),b ;1a36 ld (iy+001h),l ;1a39 comend ld c,002h ;1a3c ret ;1a3e l1a3fh: inc de ;1a3f ld a,b ;1a40 cp 007h ;1a41 jp nz,ERROR ;1a43 call sub_1e2eh ;1a46 jr nc,l1a59h ;1a49 cp 030h ;1a4b jp nc,ERROR ;1a4d add a,00ah ;1a50 ld b,a ;1a52 call sub_1ed8h ;1a53 jp l1b36h ;1a56 l1a59h: call tst_EXPR ;1a59 call sub_1ed8h ;1a5c ld b,03ah ;1a5f jp l199ah ;1a61 l1a64h: call sub_1ed1h ;1a64 call sub_1e41h ;1a67 jr nc,l1a76h ;1a6a cp 006h ;1a6c jp z,ERROR ;1a6e add a,070h ;1a71 jp l19ebh ;1a73 l1a76h: call sub_1e12h ;1a76 call assert_eol ;1a79 ld a,(pfx.IXY) ;1a7c comst ;1a7f ld (iy+000h),a ;1a83 dd/fd ld (iy+001h),036h ;1a86 ld (iy+002h),c ;1a8a displacement ld (iy+003h),l ;1a8d nn comend ld c,4 ;1a90 ret ;1a92 l1a93h: ld b,a ;1a93 call sub_1ed1h ;1a94 ld hl,t_HL.AF ;1a97 call sub_0a23h ;1a9a jr c,l1abeh ;1a9d call sub_1e50h ;1a9f jr nc,l1ac7h ;1aa2 ld a,b ;1aa4 cp 030h ;1aa5 jr nz,l1b20h ;1aa7 ld b,0f9h ;1aa9 l1aabh: call assert_eol ;1aab ld a,(pfx.IXY) ;1aae comst ;1ab1 ld (iy+000h),a ;1ab5 ld (iy+001h),b ;1ab8 comend ld c,002h ;1abb ret ;1abd l1abeh: ld a,b ;1abe cp 030h ;1abf jr nz,l1b20h ;1ac1 ld b,0f9h ;1ac3 jr l1b36h ;1ac5 l1ac7h: ld a,(de) ;1ac7 cp 028h ;1ac8 jr nz,l1ae3h ;1aca inc de ;1acc call tst_EXPR ;1acd call sub_1ed8h ;1ad0 ld a,b ;1ad3 cp 020h ;1ad4 jr z,l1adeh ;1ad6 add a,04bh ;1ad8 ld b,a ;1ada jp l19b4h ;1adb l1adeh: ld b,02ah ;1ade jp l199ah ;1ae0 l1ae3h: call tst_EXPR ;1ae3 call assert_eol ;1ae6 ld a,001h ;1ae9 add a,b ;1aeb ld b,a ;1aec jp l199ah ;1aed l1af0h: call sub_1ed1h ;1af0 ld a,(de) ;1af3 cp 028h ;1af4 jr nz,l1b04h ;1af6 inc de ;1af8 call tst_EXPR ;1af9 call sub_1ed8h ;1afc ld b,02ah ;1aff jp l1978h ;1b01 l1b04h: call tst_EXPR ;1b04 ld b,021h ;1b07 jp l1978h ;1b09 l1b0ch: inc de ;1b0c call sub_1ed1h ;1b0d ld b,047h ;1b10 jr l1b1ah ;1b12 l1b14h: inc de ;1b14 call sub_1ed1h ;1b15 ld b,04fh ;1b18 l1b1ah: ld a,(de) ;1b1a inc de ;1b1b cp 041h ;1b1c jr z,gen.opc.ED2 ;1b1e l1b20h: jp ERROR ;1b20 l1b23h: cp 020h ;1b23 jr nc,l1b20h ;1b25 add a,002h ;1b27 ld b,a ;1b29 call sub_1ed8h ;1b2a call sub_1ed1h ;1b2d ld a,(de) ;1b30 cp 041h ;1b31 jr nz,l1b20h ;1b33 inc de ;1b35 l1b36h: call assert_eol ;1b36 comst ;1b39 ld (iy+000h),b ;1b3d comend ld c,001h ;1b40 ret ;1b42 gen.opc.ED2: call assert_eol ;1b43 comst ;1b46 ld (iy+000h),0edh ;1b4a ld (iy+001h),b ;1b4e comend ld c,002h ;1b51 ret ;1b53 l1b54h: ld hl,t_HL.AF ;1b54 call sub_0a23h ;1b57 jr nc,l1babh ;1b5a call sub_1ed1h ;1b5c call sub_1e2eh ;1b5f jp nc,ERROR ;1b62 push af ;1b65 ld a,b ;1b66 cp 088h ;1b67 ld b,04ah ;1b69 jr z,l1b6fh ;1b6b ld b,042h ;1b6d l1b6fh: pop af ;1b6f add a,b ;1b70 l1b71h: ld b,a ;1b71 jr gen.opc.ED2 ;1b72 l1b74h: ld hl,t_HL.AF ;1b74 call sub_0a23h ;1b77 jr c,l1b9dh ;1b7a call sub_1e50h ;1b7c jr nc,l1babh ;1b7f call sub_1ed1h ;1b81 ld hl,t_BC.DE.IX.SP ;1b84 ld a,(pfx.IXY) ;1b87 cp 0fdh ;1b8a jr nz,l1b91h ;1b8c ld hl,t_BC.DE.IY.SP ;1b8e l1b91h: call sub_1e2bh ;1b91 jp nc,ERROR ;1b94 add a,009h ;1b97 l1b99h: ld b,a ;1b99 jp l1aabh ;1b9a l1b9dh: call sub_1ed1h ;1b9d call sub_1e2eh ;1ba0 jp nc,ERROR ;1ba3 add a,009h ;1ba6 jp l19d7h ;1ba8 l1babh: ld a,(de) ;1bab cp 041h ;1bac jr nz,l1bbbh ;1bae push de ;1bb0 inc de ;1bb1 call skip_to_nextarg ;1bb2 jr z,l1bbah ;1bb5 pop de ;1bb7 jr l1bbbh ;1bb8 l1bbah: pop af ;1bba l1bbbh: call sub_1e41h ;1bbb jr c,l1bceh ;1bbe call sub_1e68h ;1bc0 jr c,l1bd2h ;1bc3 call sub_1e12h ;1bc5 ld a,b ;1bc8 add a,046h ;1bc9 jp l1a2eh ;1bcb l1bceh: add a,b ;1bce jp l19d7h ;1bcf l1bd2h: ld a,b ;1bd2 add a,006h ;1bd3 jp l19ebh ;1bd5 l1bd8h: call sub_1e41h ;1bd8 jr c,l1c01h ;1bdb call sub_1e68h ;1bdd jp nc,ERROR ;1be0 ld a,b ;1be3 add a,006h ;1be4 ld b,a ;1be6 l1be7h: call assert_eol ;1be7 ld a,(pfx.IXY) ;1bea comst ;1bed ld (iy+000h),a ;1bf1 ld (iy+001h),0cbh ;1bf4 ld (iy+002h),c ;1bf8 ld (iy+003h),b ;1bfb comend ld c,004h ;1bfe ret ;1c00 l1c01h: add a,b ;1c01 l1c02h: ld b,a ;1c02 call assert_eol ;1c03 comst ;1c06 ld (iy+000h),0cbh ;1c0a ld (iy+001h),b ;1c0e comend ld c,002h ;1c11 ret ;1c13 l1c14h: call sub_1de6h ;1c14 call sub_1ed1h ;1c17 call sub_1e41h ;1c1a jr c,l1c2fh ;1c1d call sub_1e68h ;1c1f jp nc,ERROR ;1c22 ld a,l ;1c25 rlca ;1c26 rlca ;1c27 rlca ;1c28 add a,006h ;1c29 add a,b ;1c2b ld b,a ;1c2c jr l1be7h ;1c2d l1c2fh: add a,b ;1c2f ld b,a ;1c30 ld a,l ;1c31 rlca ;1c32 rlca ;1c33 rlca ;1c34 add a,b ;1c35 jr l1c02h ;1c36 l1c38h: push de ;1c38 call sub_1eb8h ;1c39 jr nc,l1c47h ;1c3c add a,b ;1c3e ld b,a ;1c3f call skip_to_nextarg ;1c40 jr z,l1c49h ;1c43 pop de ;1c45 push de ;1c46 l1c47h: ld b,0cdh ;1c47 l1c49h: pop af ;1c49 call tst_EXPR ;1c4a jp l199ah ;1c4d l1c50h: call sub_1eb8h ;1c50 jr nc,l1c59h ;1c53 add a,b ;1c55 ld b,a ;1c56 jr l1c5bh ;1c57 l1c59h: ld b,0c9h ;1c59 l1c5bh: jp l1b36h ;1c5b l1c5eh: push de ;1c5e call sub_1eb8h ;1c5f jr c,l1c71h ;1c62 l1c64h: pop de ;1c64 ld hl,b_0x1C97_start ;1c65 call sub_0a15h ;1c68 jr c,l1c7fh ;1c6b ld b,0c3h ;1c6d jr l1c79h ;1c6f l1c71h: add a,b ;1c71 ld b,a ;1c72 call skip_to_nextarg ;1c73 jr nz,l1c64h ;1c76 pop af ;1c78 l1c79h: call tst_EXPR ;1c79 jp l199ah ;1c7c l1c7fh: call assert_eol ;1c7f ld a,b ;1c82 and a ;1c83 jr nz,l1c8bh ;1c84 ld b,0e9h ;1c86 jp l1b36h ;1c88 l1c8bh: ld b,0ddh ;1c8b dec a ;1c8d jr z,l1c92h ;1c8e ld b,0fdh ;1c90 l1c92h: ld l,0e9h ;1c92 jp l1a2fh ;1c94 b_0x1C97_start: DC '(HL)' DC '(IX)' DC '(IY)' DB 0 l1ca4h: call skip_to_nextarg ;1ca4 ld b,010h ;1ca7 jr l1cb9h ;1ca9 l1cabh: call sub_1ebfh ;1cab jr c,l1cb4h ;1cae ld b,018h ;1cb0 jr l1cb9h ;1cb2 l1cb4h: add a,b ;1cb4 ld b,a ;1cb5 call sub_1ed1h ;1cb6 l1cb9h: call sub_1defh ;1cb9 jp l1a2fh ;1cbc l1cbfh: call sub_1e12h ;1cbf ld a,l ;1cc2 cp 003h ;1cc3 jr nc,l1d23h ;1cc5 and a ;1cc7 jr z,l1cd2h ;1cc8 ld b,056h ;1cca cp 001h ;1ccc jr z,l1cd2h ;1cce ld b,05eh ;1cd0 l1cd2h: jp gen.opc.ED2 ;1cd2 l1cd5h: call sub_1e12h ;1cd5 ld a,l ;1cd8 push af ;1cd9 add a,b ;1cda ld b,a ;1cdb pop af ;1cdc and 0c7h ;1cdd jr nz,l1d23h ;1cdf jp l1b36h ;1ce1 l1ce4h: call sub_1e50h ;1ce4 jr c,l1cf2h ;1ce7 call sub_1e25h ;1ce9 jr nc,l1d23h ;1cec add a,b ;1cee jp l19d7h ;1cef l1cf2h: ld a,b ;1cf2 add a,020h ;1cf3 jp l1b99h ;1cf5 l1cf8h: call sub_1e41h ;1cf8 jr nc,l1d23h ;1cfb cp 006h ;1cfd jr z,l1d23h ;1cff rlca ;1d01 rlca ;1d02 rlca ;1d03 add a,b ;1d04 ld b,a ;1d05 cp 078h ;1d06 jr nz,l1d1ah ;1d08 call sub_1ed1h ;1d0a call sub_1d26h ;1d0d jr c,l1d20h ;1d10 call sub_1e06h ;1d12 ld b,0dbh ;1d15 jp l1a2fh ;1d17 l1d1ah: call sub_1ed1h ;1d1a call sub_1d26h ;1d1d l1d20h: jp c,gen.opc.ED2 ;1d20 l1d23h: jp ERROR ;1d23 sub_1d26h: ld hl,t__C_ ;1d26 jp sub_0a23h ;1d29 l1d2ch: call sub_1d26h ;1d2c jr nc,l1d44h ;1d2f call sub_1ed1h ;1d31 call sub_1e41h ;1d34 jr nc,l1d23h ;1d37 cp 006h ;1d39 jr z,l1d23h ;1d3b rlca ;1d3d rlca ;1d3e rlca ;1d3f add a,b ;1d40 jp l1b71h ;1d41 l1d44h: call sub_1e06h ;1d44 call sub_1ed1h ;1d47 cp 041h ;1d4a jr nz,l1d23h ;1d4c inc de ;1d4e ld b,0d3h ;1d4f jp l1a2fh ;1d51 l1d54h: ld hl,b_0x1D80_start ;1d54 call sub_0a15h ;1d57 jp nc,ERROR ;1d5a ld c,b ;1d5d call assert_eol ;1d5e ld b,000h ;1d61 ld hl,b_0x1DA1_start ;1d63 add hl,bc ;1d66 add hl,bc ;1d67 ld a,(hl) ;1d68 comst ;1d69 ld (iy+000h),a ;1d6d comend ld c,001h ;1d70 inc hl ;1d72 ld a,(hl) ;1d73 and a ;1d74 ret z ;1d75 comst ;1d76 ld (iy+001h),a ;1d7a comend ld c,002h ;1d7d ret ;1d7f b_0x1D80_start: DC 'AF,AF''' l1d86h: DC 'DE,HL' DC '(SP),HL' DC '(SP),IX' DC '(SP),IY' db 000h ;1da0 b_0x1DA1_start: db 008h ;1da1 db 000h ;1da2 db 0ebh ;1da3 db 000h ;1da4 db 0e3h ;1da5 db 000h ;1da6 db 0ddh ;1da7 db 0e3h ;1da8 db 0fdh ;1da9 db 0e3h ;1daa l1dabh: call sub_1e50h ;1dab jr c,l1dc6h ;1dae call sub_1e2eh ;1db0 jr c,l1dd2h ;1db3 call sub_1e41h ;1db5 jr c,l1ddfh ;1db8 call sub_1e68h ;1dba jp nc,ERROR ;1dbd ld a,b ;1dc0 add a,030h ;1dc1 jp l19ebh ;1dc3 l1dc6h: ld a,b ;1dc6 ld b,023h ;1dc7 cp 004h ;1dc9 jr z,l1dcfh ;1dcb ld b,02bh ;1dcd l1dcfh: jp l1aabh ;1dcf l1dd2h: push af ;1dd2 ld a,b ;1dd3 ld b,003h ;1dd4 cp 004h ;1dd6 jr z,l1ddch ;1dd8 ld b,00bh ;1dda l1ddch: pop af ;1ddc jr l1de2h ;1ddd l1ddfh: rlca ;1ddf rlca ;1de0 rlca ;1de1 l1de2h: add a,b ;1de2 jp l19d7h ;1de3 sub_1de6h: call sub_1e12h ;1de6 ld a,l ;1de9 cp 008h ;1dea jr nc,error1 ;1dec ret ;1dee sub_1defh: call tst_EXPR ;1def push bc ;1df2 push iy ;1df3 pop bc ;1df5 and a ;1df6 sbc hl,bc ;1df7 dec hl ;1df9 dec hl ;1dfa pop bc ;1dfb call sub_1e15h ;1dfc ld a,h ;1dff xor l ;1e00 bit 7,a ;1e01 jr nz,error1 ;1e03 ret ;1e05 sub_1e06h: ld a,(de) ;1e06 cp 028h ;1e07 jr nz,sub_1e12h ;1e09 inc de ;1e0b call sub_1e12h ;1e0c jp sub_1ed8h ;1e0f sub_1e12h: call tst_EXPR ;1e12 sub_1e15h: ld a,h ;1e15 and a ;1e16 ret z ;1e17 inc a ;1e18 ret z ;1e19 jr error1 ;1e1a tst_EXPR: push bc ;1e1c call EXPR ;1e1d pop bc ;1e20 ret nc ;1e21 error1: jp ERROR ;1e22 sub_1e25h: push hl ;1e25 ld hl,t_BC.DE.HL.AF ;1e26 jr l1e32h ;1e29 sub_1e2bh: push hl ;1e2b jr l1e32h ;1e2c sub_1e2eh: push hl ;1e2e ld hl,t_BC.DE.HL.SP ;1e2f l1e32h: push bc ;1e32 call sub_0a15h ;1e33 jr nc,l1e3eh ;1e36 ld a,b ;1e38 rlca ;1e39 rlca ;1e3a rlca ;1e3b rlca ;1e3c scf ;1e3d l1e3eh: pop bc ;1e3e pop hl ;1e3f ret ;1e40 sub_1e41h: call SKIPBL ;1e41 push bc ;1e44 push hl ;1e45 ld hl,t_BCDEHL_HL_A ;1e46 call sub_0a15h ;1e49 ld a,b ;1e4c pop hl ;1e4d pop bc ;1e4e ret ;1e4f sub_1e50h: push hl ;1e50 push bc ;1e51 ld hl,t_IX.IY ;1e52 call sub_0a15h ;1e55 jr nc,l1e65h ;1e58 ld a,0ddh ;1e5a dec b ;1e5c jr nz,l1e61h ;1e5d ld a,0fdh ;1e5f l1e61h: ld (pfx.IXY),a ;1e61 scf ;1e64 l1e65h: pop bc ;1e65 pop hl ;1e66 ret ;1e67 sub_1e68h: push hl ;1e68 push bc ;1e69 ld a,(de) ;1e6a cp '(' ;1e6b jr nz,l1eb4h ;1e6d push de ;1e6f inc de ;1e70 ld hl,t_IX.IY ;1e71 call sub_0a15h ;1e74 jr nc,l1eb3h ;1e77 pop af ;1e79 ld a,0ddh ;1e7a dec b ;1e7c jr nz,l1e81h ;1e7d ld a,0fdh ;1e7f l1e81h: ld (pfx.IXY),a ;1e81 ld a,(de) ;1e84 cp '+' ;1e85 jr z,l1e95h ;1e87 cp ')' ;1e89 ld hl,0 ;1e8b jr z,l1eadh ;1e8e cp '-' ;1e90 jp nz,ERROR ;1e92 l1e95h: push af ;1e95 inc de ;1e96 call sub_1e12h ;1e97 get displacement pop af ;1e9a cp '+' ;1e9b jr z,l1ea7h ;1e9d ld b,h ;1e9f ld c,l ;1ea0 ld hl,0 ;1ea1 and a ;1ea4 sbc hl,bc ;1ea5 l1ea7h: ld a,(de) ;1ea7 cp ')' ;1ea8 jp nz,ERROR ;1eaa l1eadh: inc de ;1ead pop bc ;1eae ld c,l ;1eaf pop hl ;1eb0 scf ;1eb1 ret ;1eb2 l1eb3h: pop de ;1eb3 l1eb4h: pop bc ;1eb4 pop hl ;1eb5 and a ;1eb6 ret ;1eb7 sub_1eb8h: ld hl,t_tstfl_ZCPS ;1eb8 ld c,007h ;1ebb jr l1ec4h ;1ebd sub_1ebfh: ld hl,t_tstfl_ZC ;1ebf ld c,003h ;1ec2 l1ec4h: push bc ;1ec4 call sub_0a15h ;1ec5 ld a,b ;1ec8 pop bc ;1ec9 ret nc ;1eca and c ;1ecb rlca ;1ecc rlca ;1ecd rlca ;1ece scf ;1ecf ret ;1ed0 sub_1ed1h: call skip_to_nextarg ;1ed1 ret z ;1ed4 l1ed5h: jp ERROR ;1ed5 sub_1ed8h: ld a,(de) ;1ed8 cp 029h ;1ed9 jr nz,l1ed5h ;1edb inc de ;1edd ret ;1ede CMD.L: ld hl,CMD.L ;1edf ld (CMD_RPT),hl ;1ee2 call EXPR ;1ee5 jr nc,l1eedh ;1ee8 ld hl,(lst.L) ;1eea l1eedh: push hl ;1eed pop iy ;1eee call skip_to_nextarg ;1ef0 call sub_0aa5h ;1ef3 jr nc,l1f17h ;1ef6 call assert_eol ;1ef8 ld b,010h ;1efb l1efdh: push bc ;1efd push iy ;1efe pop hl ;1f00 push hl ;1f01 call sub_1f3fh ;1f02 call CRLF ;1f05 pop iy ;1f08 ld c,b ;1f0a ld b,000h ;1f0b add iy,bc ;1f0d ld (lst.L),iy ;1f0f pop bc ;1f13 djnz l1efdh ;1f14 ret ;1f16 l1f17h: call assert_eol ;1f17 ld h,b ;1f1a ld l,c ;1f1b ld a,b ;1f1c or c ;1f1d jr nz,l1f21h ;1f1e dec hl ;1f20 l1f21h: push hl ;1f21 push iy ;1f22 pop hl ;1f24 push hl ;1f25 call sub_1f3fh ;1f26 call CRLF ;1f29 pop iy ;1f2c ld e,b ;1f2e ld d,000h ;1f2f add iy,de ;1f31 ld (lst.L),iy ;1f33 pop hl ;1f37 and a ;1f38 sbc hl,de ;1f39 ret z ;1f3b ret c ;1f3c jr l1f21h ;1f3d sub_1f3fh: call out.hl.@ ;1f3f call z,OUTBL ;1f42 call OUTBL ;1f45 sub a ;1f48 ld (CON.COL),a ;1f49 call sub_1f77h ;1f4c and a ;1f4f ret z ;1f50 l1f51h: call OUTBL ;1f51 ld a,(CON.COL) ;1f54 cp 010h ;1f57 jr c,l1f51h ;1f59 sub_1f5bh: ld de,(offs.@) ;1f5b ld a,d ;1f5f or e ;1f60 ret z ;1f61 ld a,'(' ;1f62 call OUTCHAR ;1f64 ld a,'@' ;1f67 call OUTCHAR ;1f69 and a ;1f6c sbc hl,de ;1f6d call out.hl ;1f6f ld a,')' ;1f72 jp OUTCHAR ;1f74 sub_1f77h: sub a ;1f77 ld (XBE03),a ;1f78 call sub_1f9eh ;1f7b jr nc,l1f91h ;1f7e push bc ;1f80 call sub_2581h ;1f81 ex de,hl ;1f84 call sub_1fdbh ;1f85 pop bc ;1f88 ld a,(XBE03) ;1f89 ld hl,(XBE01) ;1f8c scf ;1f8f ret ;1f90 l1f91h: ld hl,b_0x1F9B_start ;1f91 call PSTR ;1f94 ld b,001h ;1f97 sub a ;1f99 ret ;1f9a b_0x1F9B_start: DC '???' sub_1f9eh: sub a ;1f9e ld (is.pfx.IXY),a ;1f9f comst ;1fa2 ld a,(iy+000h) ;1fa6 comend cp 0edh ;1fa9 jp z,disas_pfx.ED ;1fab cp 0ddh ;1fae jr z,l1fc5h ;1fb0 cp 0fdh ;1fb2 jr z,l1fc9h ;1fb4 sub_1fb6h: comst ;1fb6 ld a,(iy+000h) ;1fba comend cp 0cbh ;1fbd jp z,l2061h ;1fbf jp l2078h ;1fc2 l1fc5h: ld a,001h ;1fc5 jr l1fcbh ;1fc7 l1fc9h: ld a,002h ;1fc9 l1fcbh: ld (is.pfx.IXY),a ;1fcb call sub_1fdch ;1fce ret nc ;1fd1 push bc ;1fd2 call sub_1fb6h ;1fd3 pop af ;1fd6 add a,b ;1fd7 ld b,a ;1fd8 scf ;1fd9 ret ;1fda sub_1fdbh: jp (hl) ;1fdb sub_1fdch: inc iy ;1fdc ld hl,b_0x2011_start ;1fde call sub_20bbh ;1fe1 ld b,002h ;1fe4 ret c ;1fe6 ld hl,l202ch ;1fe7 call sub_20bbh ;1fea ld b,001h ;1fed ret c ;1fef comst ;1ff0 ld a,(iy+000h) ;1ff4 comend cp 0cbh ;1ff7 jr nz,l200fh ;1ff9 comst ;1ffb ld a,(iy+002h) ;1fff comend cp 036h ;2002 ret z ;2004 and 007h ;2005 cp 006h ;2007 jr nz,l200fh ;2009 ld b,002h ;200b scf ;200d ret ;200e l200fh: and a ;200f ret ;2010 b_0x2011_start: db 034h ;2011 db 035h ;2012 db 036h ;2013 db 046h ;2014 db 04eh ;2015 db 056h ;2016 db 05eh ;2017 db 066h ;2018 db 06eh ;2019 db 070h ;201a db 071h ;201b db 072h ;201c db 073h ;201d db 074h ;201e db 075h ;201f db 076h ;2020 db 077h ;2021 db 07eh ;2022 db 086h ;2023 db 08eh ;2024 db 096h ;2025 db 09eh ;2026 db 0a6h ;2027 db 0aeh ;2028 db 0b6h ;2029 db 0beh ;202a db 000h ;202b l202ch: db 009h ;202c db 019h ;202d db 021h ;202e db 022h ;202f db 023h ;2030 db 029h ;2031 db 02ah ;2032 db 02bh ;2033 db 039h ;2034 db 0e1h ;2035 db 0e3h ;2036 db 0e5h ;2037 db 0e9h ;2038 db 0f9h ;2039 db 000h ;203a disas_pfx.ED: inc iy ;203b ld hl,b_0x2200_start ;203d call sub_209dh ;2040 ld b,002h ;2043 ret c ;2045 ld hl,l2235h ;2046 call lookup_opc ;2049 ld b,002h ;204c ret c ;204e ld hl,l228bh ;204f call lookup_opc ;2052 ld b,003h ;2055 ret c ;2057 ld hl,l22b4h ;2058 call lookup_opc ;205b ld b,004h ;205e ret ;2060 l2061h: push iy ;2061 inc iy ;2063 ld a,(is.pfx.IXY) ;2065 and a ;2068 jr z,l206dh ;2069 inc iy ;206b l206dh: ld hl,l22c9h ;206d call lookup_opc ;2070 pop iy ;2073 ld b,002h ;2075 ret ;2077 l2078h: ld hl,b_0x218B_start ;2078 call lookup_opc ;207b ld b,002h ;207e ret c ;2080 ld hl,b_0x20ED_start ;2081 call sub_209dh ;2084 ld b,001h ;2087 ret c ;2089 ld hl,b_0x2108_start ;208a call lookup_opc ;208d ld b,001h ;2090 ret c ;2092 ld hl,b_0x21D2_start ;2093 call lookup_opc ;2096 ret nc ;2099 ld b,003h ;209a ret ;209c sub_209dh: ld a,(hl) ;209d cp 0ffh ;209e ret z ;20a0 comst ;20a1 cp (iy+000h) ;20a5 comend jr z,l20aeh ;20a8 inc hl ;20aa inc hl ;20ab jr sub_209dh ;20ac l20aeh: inc hl ;20ae ld c,(hl) ;20af ld hl,t_MNEMONICS ;20b0 ld b,000h ;20b3 add hl,bc ;20b5 ld de,l230bh ;20b6 scf ;20b9 ret ;20ba sub_20bbh: ld a,(hl) ;20bb and a ;20bc ret z ;20bd inc hl ;20be comst ;20bf cp (iy+000h) ;20c3 comend jr nz,sub_20bbh ;20c6 scf ;20c8 ret ;20c9 lookup_opc: comst ;20ca ld a,(iy+000h) ;20ce comend and (hl) ;20d1 inc hl ;20d2 cp (hl) ;20d3 jr z,l20dfh ;20d4 inc hl ;20d6 inc hl ;20d7 inc hl ;20d8 inc hl ;20d9 ld a,(hl) ;20da and a ;20db jr nz,lookup_opc ;20dc ret ;20de l20dfh: inc hl ;20df ld c,(hl) ;20e0 inc hl ;20e1 ld e,(hl) ;20e2 inc hl ;20e3 ld d,(hl) ;20e4 ld hl,t_MNEMONICS ;20e5 ld b,000h ;20e8 add hl,bc ;20ea scf ;20eb ret ;20ec b_0x20ED_start: ; 1 byte opcodes (no parameters) db 076h ;20ed halt db 039h ;20ee db 0d9h ;20ef exx db 036h ;20f0 db 0f3h ;20f1 di db 02ch ;20f2 db 0fbh ;20f3 ei db 032h ;20f4 db 000h ;20f5 nop db 069h ;20f6 db 007h ;20f7 rlca db 09eh ;20f8 db 00fh ;20f9 rrca db 0adh ;20fa db 017h ;20fb rla db 098h ;20fc db 01fh ;20fd rra db 0a7h ;20fe db 027h ;20ff daa db 026h ;2100 db 02fh ;2101 cpl db 023h ;2102 db 037h ;2103 scf db 0bah ;2104 db 03fh ;2105 ccf db 010h ;2106 db 0ffh ;2107 EOT b_0x2108_start: ; 1 byte opcodes defb 0c0h ;2108 ld r,r defb 040h ;2109 defb 056h ;210a defw l22fch ;210b defb 0f8h ;210d add a,r defb 080h ;210e defb 003h ;210f defw l2305h ;2110 defb 0f8h ;2112 adc a,r defb 088h ;2113 defb 000h ;2114 defw l2305h ;2115 defb 0f8h ;2117 defb 090h ;2118 defb 0c9h ;2119 defw l24ebh ;211a defb 0f8h ;211c defb 098h ;211d defb 0b7h ;211e defw l2305h ;211f defb 0f8h ;2121 defb 0a0h ;2122 defb 006h ;2123 defw l24ebh ;2124 defb 0f8h ;2126 defb 0a8h ;2127 defb 0cch ;2128 defw l24ebh ;2129 defb 0f8h ;212b defb 0b0h ;212c defb 06ch ;212d defw l24ebh ;212e defb 0f8h ;2130 defb 0b8h ;2131 defb 013h ;2132 defw l24ebh ;2133 defb 0c7h ;2135 defb 0c0h ;2136 ret cc defb 08bh ;2137 defw l2561h ;2138 defb 0c7h ;213a rst defb 0c7h ;213b defb 0b4h ;213c defw l231eh ;213d defb 0ffh ;213f ret defb 0c9h ;2140 defb 08bh ;2141 defw l230bh ;2142 defb 0cfh ;2144 pop rr defb 0c1h ;2145 defb 081h ;2146 defw l2546h ;2147 defb 0cfh ;2149 push rr defb 0c5h ;214a defb 084h ;214b defw l2546h ;214c defb 0ffh ;214e ex (sp),hl defb 0e3h ;214f defb 034h ;2150 defw l232ah ;2151 defb 0ffh ;2153 jp (hl) defb 0e9h ;2154 defb 052h ;2155 defw l2338h ;2156 defb 0ffh ;2158 ex de,hl defb 0ebh ;2159 defb 034h ;215a defw l2345h ;215b defb 0ffh ;215d ld sp,hl defb 0f9h ;215e defb 056h ;215f defw l234bh ;2160 defb 0cfh ;2162 inc rr defb 003h ;2163 defb 041h ;2164 defw l254bh ;2165 defb 0cfh ;2167 dec rr defb 00bh ;2168 defb 029h ;2169 defw l254bh ;216a defb 0c7h ;216c inc r defb 004h ;216d defb 041h ;216e defw l24dfh ;216f defb 0c7h ;2171 dec r defb 005h ;2172 defb 029h ;2173 defw l24dfh ;2174 defb 0ffh ;2176 ex af,af' defb 008h ;2177 defb 034h ;2178 defw l2357h ;2179 defb 0cfh ;217b add hl,rr defb 009h ;217c defb 003h ;217d defw l235dh ;217e defb 0efh ;2180 ld (rr),a ;rr=bc,de defb 002h ;2181 defb 056h ;2182 defw l2366h ;2183 defb 0efh ;2185 ld a,(rr) ;rr=bc,de defb 00ah ;2186 defb 056h ;2187 defw l236fh ;2188 defb 000h ;218a EOT b_0x218B_start: ; 2 byte opdodes defb 0c7h ;218b ld r,nn defb 006h ;218c defb 056h ;218d defw l2384h ;218e defb 0ffh ;2190 add a,nn defb 0c6h ;2191 defb 003h ;2192 defw l237fh ;2193 defb 0ffh ;2195 adc a,nn defb 0ceh ;2196 defb 000h ;2197 defw l237fh ;2198 defb 0ffh ;219a sub a,nn defb 0d6h ;219b defb 0c9h ;219c defw l2397h ;219d defb 0ffh ;219f defb 0deh ;21a0 defb 0b7h ;21a1 defw l237fh ;21a2 defb 0ffh ;21a4 and a,nn defb 0e6h ;21a5 defb 006h ;21a6 defw l2397h ;21a7 defb 0ffh ;21a9 defb 0eeh ;21aa defb 0cch ;21ab defw l2397h ;21ac defb 0ffh ;21ae defb 0f6h ;21af defb 06ch ;21b0 defw l2397h ;21b1 defb 0ffh ;21b3 cp a,nn defb 0feh ;21b4 defb 013h ;21b5 defw l2397h ;21b6 defb 0ffh ;21b8 djnz defb 010h ;21b9 defb 02eh ;21ba defw l23b0h ;21bb defb 0ffh ;21bd jr defb 018h ;21be defb 054h ;21bf defw l23b0h ;21c0 defb 0e7h ;21c2 jr,cc defb 020h ;21c3 defb 054h ;21c4 defw l23a1h ;21c5 defb 0ffh ;21c7 defb 0d3h ;21c8 out (nn),a defb 076h ;21c9 defw l23d5h ;21ca defb 0ffh ;21cc in a,(nn) defb 0dbh ;21cd defb 03fh ;21ce defw l23c3h ;21cf defb 000h ;21d1 EOT b_0x21D2_start: ; 3 byte opcodes defb 0c7h ;21d2 defb 0c2h ;21d3 defb 052h ;21d4 defw l23e0h ;21d5 defb 0c7h ;21d7 defb 0c4h ;21d8 defb 00ch ;21d9 defw l23e0h ;21da defb 0cfh ;21dc defb 001h ;21dd defb 056h ;21de defw l23fch ;21df defb 0ffh ;21e1 defb 0c3h ;21e2 defb 052h ;21e3 defw l23e6h ;21e4 defb 0ffh ;21e6 defb 0cdh ;21e7 defb 00ch ;21e8 defw l23e6h ;21e9 defb 0ffh ;21eb defb 022h ;21ec defb 056h ;21ed defw l2404h ;21ee defb 0ffh ;21f0 defb 02ah ;21f1 defb 056h ;21f2 defw l240dh ;21f3 defb 0ffh ;21f5 defb 032h ;21f6 defb 056h ;21f7 defw l2416h ;21f8 defb 0ffh ;21fa defb 03ah ;21fb defb 056h ;21fc defw l2421h ;21fd defb 000h ;21ff b_0x2200_start: ; prefix ED + 1 byte opcode defb 044h ;2200 neg defb 066h ;2201 defb 045h ;2202 retn defb 092h ;2203 defb 04dh ;2204 reti defb 08eh ;2205 defb 067h ;2206 rrd defb 0b1h ;2207 defb 06fh ;2208 rld defb 0a2h ;2209 defb 0a0h ;220a ldi defb 05fh ;220b defb 0a1h ;220c defb 01ch ;220d defb 0a2h ;220e defb 04bh ;220f defb 0a3h ;2210 defb 07dh ;2211 defb 0a8h ;2212 ldd defb 058h ;2213 defb 0a9h ;2214 defb 015h ;2215 defb 0aah ;2216 defb 044h ;2217 defb 0abh ;2218 defb 079h ;2219 defb 0b0h ;221a ldir defb 062h ;221b defb 0b1h ;221c defb 01fh ;221d defb 0b2h ;221e defb 04eh ;221f defb 0b3h ;2220 defb 072h ;2221 defb 0b8h ;2222 lddr defb 05bh ;2223 defb 0b9h ;2224 defb 018h ;2225 defb 0bah ;2226 defb 047h ;2227 defb 0bbh ;2228 defb 06eh ;2229 defb 08bh ;222a otdm defb 0d5h ;222b defb 09bh ;222c otdmr defb 0d9h ;222d defb 083h ;222e otim defb 0deh ;222f defb 093h ;2230 otimr defb 0e2h ;2231 defb 076h ;2232 slp defb 0ebh ;2233 defb 0ffh ;2234 EOT l2235h: defb 0e7h ;2235 in r,(c) ;r=bcde defb 040h ;2236 defb 03fh ;2237 defw l2455h ;2238 defb 0f7h ;223a in r,(c) ;r=hl defb 060h ;223b defb 03fh ;223c defw l2455h ;223d defb 0ffh ;223f in r,(c) ;r=a defb 078h ;2240 defb 03fh ;2241 defw l2455h ;2242 defb 0e7h ;2244 defb 041h ;2245 defb 076h ;2246 defw l2461h ;2247 defb 0f7h ;2249 defb 061h ;224a defb 076h ;224b defw l2461h ;224c defb 0ffh ;224e out (c),r ;r=a defb 079h ;224f defb 076h ;2250 defw l2461h ;2251 defb 0cfh ;2253 sbc hl,rr defb 042h ;2254 defb 0b7h ;2255 defw l246dh ;2256 defb 0cfh ;2258 adc hl,rr defb 04ah ;2259 defb 000h ;225a defw l246dh ;225b defb 0ffh ;225d im 0 defb 046h ;225e defb 03dh ;225f defw l2427h ;2260 defb 0ffh ;2262 im 1 defb 056h ;2263 defb 03dh ;2264 defw l242bh ;2265 defb 0ffh ;2267 im 2 defb 05eh ;2268 defb 03dh ;2269 defw l242fh ;226a defb 0ffh ;226c ld i,a defb 047h ;226d defb 056h ;226e defw l2434h ;226f defb 0ffh ;2271 defb 057h ;2272 defb 056h ;2273 defw l2439h ;2274 defb 0ffh ;2276 defb 04fh ;2277 defb 056h ;2278 defw l243eh ;2279 defb 0ffh ;227b defb 05fh ;227c defb 056h ;227d defw l2443h ;227e defb 0cfh ;2280 mlt rr defb 04ch ;2281 defb 0d2h ;2282 defw l254bh ;2283 defb 0c7h ;2285 tst r defb 004h ;2286 defb 0eeh ;2287 defw l24dfh ;2288 defb 000h ;228a l228bh: defb 0e7h ;228b defb 000h ;228c defb 0cfh ;228d b_0x228E_start: defw l230ch ;228e b_0x2290_start: defb 0f7h ;2290 defb 020h ;2291 defb 0cfh ;2292 b_0x2293_start: defw l230ch ;2293 b_0x2295_start: defb 0ffh ;2295 defb 038h ;2296 defb 0cfh ;2297 b_0x2298_start: defw l230ch ;2298 b_0x229A_start: defb 0e7h ;229a defb 001h ;229b defb 0e7h ;229c b_0x229D_start: defw l2315h ;229d b_0x229F_start: defb 0f7h ;229f defb 021h ;22a0 defb 0e7h ;22a1 b_0x22A2_start: defw l2315h ;22a2 b_0x22A4_start: defb 0ffh ;22a4 defb 039h ;22a5 defb 0e7h ;22a6 b_0x22A7_start: defw l2315h ;22a7 b_0x22A9_start: defb 0ffh ;22a9 defb 064h ;22aa defb 0eeh ;22ab b_0x22AC_start: defw l2397h ;22ac b_0x22AE_start: defb 0ffh ;22ae defb 074h ;22af defb 0f1h ;22b0 b_0x22B1_start: defw l2397h ;22b1 b_0x22B3_start: defb 000h ;22b3 l22b4h: defb 0efh ;22b4 defb 043h ;22b5 defb 056h ;22b6 b_0x22B7_start: defw l2476h ;22b7 b_0x22B9_start: defb 0ffh ;22b9 defb 073h ;22ba defb 056h ;22bb b_0x22BC_start: defw l2476h ;22bc b_0x22BE_start: defb 0efh ;22be defb 04bh ;22bf defb 056h ;22c0 b_0x22C1_start: defw l247fh ;22c1 b_0x22C3_start: defb 0ffh ;22c3 defb 07bh ;22c4 defb 056h ;22c5 b_0x22C6_start: defw l247fh ;22c6 b_0x22C8_start: defb 000h ;22c8 l22c9h: defb 0f8h ;22c9 defb 000h ;22ca defb 09bh ;22cb b_0x22CC_start: defw l24aeh ;22cc b_0x22CE_start: defb 0f8h ;22ce defb 008h ;22cf defb 0aah ;22d0 b_0x22D1_start: defw l24aeh ;22d1 b_0x22D3_start: defb 0f8h ;22d3 defb 010h ;22d4 defb 096h ;22d5 b_0x22D6_start: defw l24aeh ;22d6 b_0x22D8_start: defb 0f8h ;22d8 defb 018h ;22d9 defb 0a5h ;22da b_0x22DB_start: defw l24aeh ;22db b_0x22DD_start: defb 0f8h ;22dd defb 020h ;22de defb 0c0h ;22df b_0x22E0_start: defw l24aeh ;22e0 b_0x22E2_start: defb 0f8h ;22e2 defb 028h ;22e3 defb 0c3h ;22e4 b_0x22E5_start: defw l24aeh ;22e5 b_0x22E7_start: defb 0f8h ;22e7 defb 038h ;22e8 defb 0c6h ;22e9 b_0x22EA_start: defw l24aeh ;22ea b_0x22EC_start: defb 0c0h ;22ec defb 040h ;22ed defb 009h ;22ee b_0x22EF_start: defw l2487h ;22ef b_0x22F1_start: defb 0c0h ;22f1 defb 080h ;22f2 defb 088h ;22f3 b_0x22F4_start: defw l2487h ;22f4 b_0x22F6_start: defb 0c0h ;22f6 defb 0c0h ;22f7 defb 0bdh ;22f8 b_0x22F9_start: defw l2487h ;22f9 b_0x22FB_start: defb 000h ;22fb l22fch: call l24dfh ;22fc call sub_257ch ;22ff jp l24ebh ;2302 l2305h: call sub_2579h ;2305 jp l24ebh ;2308 l230bh: ret ;230b l230ch: call l24dfh ;230c call sub_257ch ;230f jp l23c6h ;2312 l2315h: call l23c6h ;2315 call sub_257ch ;2318 jp l24dfh ;231b l231eh: comst ;231e ld a,(iy+000h) ;2322 comend and 038h ;2325 jp out.hex ;2327 l232ah: ld hl,b_0x2333_start ;232a call PSTR ;232d jp l253eh ;2330 b_0x2333_start: DC '(SP),' l2338h: ld a,'(' ;2338 call OUTCHAR ;233a call l253eh ;233d ld a,')' ;2340 jp OUTCHAR ;2342 l2345h: ld hl,l1d86h ;2345 jp PSTR ;2348 l234bh: ld hl,b_0x2354_start ;234b call PSTR ;234e jp l253eh ;2351 b_0x2354_start: DC 'SP,' l2357h: ld hl,b_0x1D80_start ;2357 jp PSTR ;235a l235dh: call l253eh ;235d call sub_257ch ;2360 jp l254bh ;2363 l2366h: call sub_2372h ;2366 call sub_257ch ;2369 jp l23dbh ;236c l236fh: call sub_2579h ;236f sub_2372h: ld a,'(' ;2372 call OUTCHAR ;2374 call l254bh ;2377 ld a,')' ;237a jp OUTCHAR ;237c l237fh: call sub_2579h ;237f jr l2397h ;2382 l2384h: call l24dfh ;2384 call sub_257ch ;2387 ld a,(is.pfx.IXY) ;238a and a ;238d comst ;238e ld a,(iy+002h) ;2392 comend jr nz,l239eh ;2395 l2397h: comst ;2397 ld a,(iy+001h) ;239b comend l239eh: jp out.hex ;239e l23a1h: comst ;23a1 ld a,(iy+000h) ;23a5 comend and 018h ;23a8 call sub_2568h ;23aa call sub_257ch ;23ad l23b0h: comst ;23b0 ld c,(iy+001h) ;23b4 comend ld a,c ;23b7 rla ;23b8 sbc a,a ;23b9 ld b,a ;23ba push iy ;23bb pop hl ;23bd add hl,bc ;23be inc hl ;23bf inc hl ;23c0 jr l23f0h ;23c1 l23c3h: call sub_2579h ;23c3 l23c6h: ld a,028h ;23c6 call OUTCHAR ;23c8 comst ;23cb ld a,(iy+001h) ;23cf comend jp l252bh ;23d2 l23d5h: call l23c6h ;23d5 call sub_257ch ;23d8 l23dbh: ld a,041h ;23db jp OUTCHAR ;23dd l23e0h: call l2561h ;23e0 call sub_257ch ;23e3 l23e6h: comst ;23e6 ld l,(iy+001h) ;23ea ld h,(iy+002h) ;23ed comend l23f0h: ld a,002h ;23f0 sub_23f2h: ld (XBE03),a ;23f2 ld (XBE01),hl ;23f5 call out.hl ;23f8 ret ;23fb l23fch: call l254bh ;23fc call sub_257ch ;23ff jr l23e6h ;2402 l2404h: call sub_24c6h ;2404 call sub_257ch ;2407 jp l253eh ;240a l240dh: call l253eh ;240d call sub_257ch ;2410 jp sub_24c6h ;2413 l2416h: call sub_24c6h ;2416 call sub_257ch ;2419 ld a,041h ;241c jp OUTCHAR ;241e l2421h: call sub_2579h ;2421 jp sub_24c6h ;2424 l2427h: ld a,030h ;2427 jr l2431h ;2429 l242bh: ld a,031h ;242b jr l2431h ;242d l242fh: ld a,032h ;242f l2431h: jp OUTCHAR ;2431 l2434h: ld hl,b_0x2449_start ;2434 jr l2446h ;2437 l2439h: ld hl,l244ch ;2439 jr l2446h ;243c l243eh: ld hl,l244fh ;243e jr l2446h ;2441 l2443h: ld hl,l2452h ;2443 l2446h: jp PSTR ;2446 b_0x2449_start: DC 'I,A' l244ch: DC 'A,I' l244fh: DC 'R,A' l2452h: DC 'A,R' l2455h: call l24dfh ;2455 call sub_257ch ;2458 ld hl,t__C_ ;245b jp PSTR ;245e l2461h: ld hl,t__C_ ;2461 call PSTR ;2464 call sub_257ch ;2467 jp l24dfh ;246a l246dh: call l253eh ;246d call sub_257ch ;2470 jp l254bh ;2473 l2476h: call sub_24c6h ;2476 call sub_257ch ;2479 jp l254bh ;247c l247fh: call l254bh ;247f call sub_257ch ;2482 jr sub_24c6h ;2485 l2487h: ld a,(is.pfx.IXY) ;2487 and a ;248a jr nz,l2496h ;248b comst ;248d ld a,(iy+001h) ;2491 comend jr l249dh ;2494 l2496h: comst ;2496 ld a,(iy+002h) ;249a comend l249dh: push af ;249d rra ;249e rra ;249f rra ;24a0 and 007h ;24a1 add a,'0' ;24a3 call OUTCHAR ;24a5 call sub_257ch ;24a8 pop af ;24ab jr l24f2h ;24ac l24aeh: ld a,(is.pfx.IXY) ;24ae and a ;24b1 jr nz,l24bdh ;24b2 comst ;24b4 ld a,(iy+001h) ;24b8 comend jr l24c4h ;24bb l24bdh: comst ;24bd ld a,(iy+002h) ;24c1 comend l24c4h: jr l24f2h ;24c4 sub_24c6h: ld a,'(' ;24c6 call OUTCHAR ;24c8 comst ;24cb ld l,(iy+001h) ;24cf ld h,(iy+002h) ;24d2 comend ld a,001h ;24d5 call sub_23f2h ;24d7 ld a,')' ;24da jp OUTCHAR ;24dc l24dfh: comst ;24df ld a,(iy+000h) ;24e3 comend rra ;24e6 rra ;24e7 rra ;24e8 jr l24f2h ;24e9 l24ebh: comst ;24eb ld a,(iy+000h) ;24ef comend l24f2h: and 007h ;24f2 cp 006h ;24f4 jr nz,l2533h ;24f6 ld a,(is.pfx.IXY) ;24f8 and a ;24fb ld a,006h ;24fc jr z,l2533h ;24fe ld hl,b_0x2538_start ;2500 ld a,(is.pfx.IXY) ;2503 dec a ;2506 jr z,l250ch ;2507 ld hl,b_0x253B_start ;2509 l250ch: call PSTR ;250c comst ;250f ld a,(iy+001h) ;2513 comend and a ;2516 push af ;2517 jp m,l2523h ;2518 ld a,'+' ;251b call OUTCHAR ;251d pop af ;2520 jr l252bh ;2521 l2523h: ld a,'-' ;2523 call OUTCHAR ;2525 pop af ;2528 neg ;2529 l252bh: call out.hex ;252b ld a,')' ;252e jp OUTCHAR ;2530 l2533h: ld hl,t_BCDEHL_HL_A ;2533 jr l2572h ;2536 b_0x2538_start: DC '(IX' b_0x253B_start: DC '(IY' l253eh: ld a,(is.pfx.IXY) ;253e ld hl,t_HL.IX.IY ;2541 jr l2572h ;2544 l2546h: ld hl,t_BC.DE.HL.AF ;2546 jr l254eh ;2549 l254bh: ld hl,t_BC.DE.HL.SP ;254b l254eh: comst ;254e ld a,(iy+000h) ;2552 comend rra ;2555 rra ;2556 rra ;2557 rra ;2558 and 003h ;2559 cp 002h ;255b jr z,l253eh ;255d jr l2572h ;255f l2561h: comst ;2561 ld a,(iy+000h) ;2565 comend sub_2568h: rra ;2568 rra ;2569 rra ;256a and 007h ;256b ld hl,t_tstfl_ZCPS ;256d jr l2572h ;2570 l2572h: ld b,a ;2572 call sub_0a48h ;2573 jp PSTR ;2576 sub_2579h: call l23dbh ;2579 sub_257ch: ld a,',' ;257c jp OUTCHAR ;257e sub_2581h: call PSTR ;2581 l2584h: call OUTBL ;2584 inc c ;2587 ld a,c ;2588 cp 006h ;2589 jr nz,l2584h ;258b ret ;258d 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_BCDEHL_HL_A: DC 'B' DC 'C' DC 'D' DC 'E' DC 'H' DC 'L' DC '(HL)' DC 'A' DB 0 t_BC.DE.HL.SP: DC 'BC' DC 'DE' DC 'HL' DC 'SP' DB 0 t_BC.DE.HL.AF: DC 'BC' DC 'DE' t_HL.AF: DC 'HL' DC 'AF' DB 0 t_BC.DE.IY.SP: DC 'BC' DC 'DE' DC 'IY' DC 'SP' DB 0 t_BC.DE.IX.SP: DC 'BC' DC 'DE' DC 'IX' DC 'SP' DB 0 t_HL.IX.IY: DC 'HL' t_IX.IY: DC 'IX' DC 'IY' DB 0 t_tstfl_ZC: DC 'NZ' DC 'Z' DC 'NC' DC 'C' DC 'NE' DC 'EQ' DC 'GE' DC 'LT' DB 0 t_tstfl_ZCPS: 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 sub_26e7h: ld hl,(REG.PC) ;26e7 ld a,h ;26ea or l ;26eb jr z,l2715h ;26ec ld iy,(REG.PC) ;26ee call sub_1f9eh ;26f2 jp nc,ERROR ;26f5 ld c,b ;26f8 ld b,000h ;26f9 ld hl,(REG.PC) ;26fb add hl,bc ;26fe call sub_1117h ;26ff ld iy,(REG.PC) ;2702 ld hl,b_0x2717_start ;2706 call lookup_opc ;2709 ccf ;270c ret c ;270d ex de,hl ;270e call CALL.HL ;270f call c,sub_1117h ;2712 l2715h: scf ;2715 ret ;2716 b_0x2717_start: db 0ffh ;2717 db 0ddh ;2718 db 000h ;2719 dw x278d db 0ffh ;271c db 0fdh ;271d db 000h ;271e dw x2792 db 0ffh ;2721 db 0edh ;2722 db 000h ;2723 dw x27a2 l2726h: db 0ffh ;2726 db 0cdh ;2727 db 000h ;2728 dw x275e db 0ffh ;272b db 0c3h ;272c db 000h ;272d dw x2769 db 0ffh ;2730 db 0e9h ;2731 db 000h ;2732 dw x2788 db 0ffh ;2735 db 0c9h ;2736 db 000h ;2737 dw x27c9 db 0ffh ;273a db 0cfh ;273b db 000h ;273c dw x280e db 0c7h ;273f db 0c7h ;2740 db 000h ;2741 dw x27ea db 0c7h ;2744 db 0c4h ;2745 db 000h ;2746 dw x275e db 0f7h ;2749 db 010h ;274a db 000h ;274b dw x2775 db 0e7h ;274e db 020h ;274f db 000h ;2750 dw x2775 db 0c7h ;2753 db 0c2h ;2754 db 000h ;2755 dw x2769 db 0c7h ;2758 db 0c0h ;2759 db 000h ;275a dw x27b3 db 000h ;275d x275e: ld a,(XBFE8) ;275e and a ;2761 jr nz,x2769 ;2762 ld a,(TCFLG) ;2764 and a ;2767 ret nz ;2768 x2769: comst ;2769 ld l,(iy+001h) ;276d ld h,(iy+002h) ;2770 comend scf ;2773 ret ;2774 x2775: comst ;2775 ld c,(iy+001h) ;2779 comend ld a,c ;277c rla ;277d sbc a,a ;277e ld b,a ;277f ld hl,(REG.PC) ;2780 add hl,bc ;2783 inc hl ;2784 inc hl ;2785 scf ;2786 ret ;2787 x2788: ld hl,(REG.L) ;2788 scf ;278b ret ;278c x278d: ld hl,(reg.ix) ;278d jr l2795h ;2790 x2792: ld hl,(reg.iy) ;2792 l2795h: comst ;2795 ld a,(iy+001h) ;2799 comend cp 0e9h ;279c scf ;279e ret z ;279f and a ;27a0 ret ;27a1 x27a2: comst ;27a2 ld a,(iy+001h) ;27a6 comend cp 04dh ;27a9 jr z,x27c9 ;27ab cp 045h ;27ad jr z,x27c9 ;27af and a ;27b1 ret ;27b2 x27b3: comst ;27b3 ld a,(iy+000h) ;27b7 comend ld (XBEDD),a ;27ba ld hl,(REG.F) ;27bd push hl ;27c0 pop af ;27c1 call XBEDD ;27c2 scf ;27c5 jr c,x27c9 ;27c6 ret ;27c8 x27c9: ld a,(XBFE8) ;27c9 and a ;27cc jr nz,l27dah ;27cd ld a,(TCFLG) ;27cf and a ;27d2 jr z,l27dah ;27d3 call l27dah ;27d5 pop hl ;27d8 ret ;27d9 l27dah: ld hl,(REG.SP) ;27da comst ;27dd ld e,(hl) ;27e1 inc hl ;27e2 ld d,(hl) ;27e3 comend ex de,hl ;27e4 call sub_1117h ;27e5 and a ;27e8 ret ;27e9 x27ea: ld a,(ddtrst) ;27ea comst ;27ed cp (iy+000h) ;27f1 comend ret z ;27f4 comst ;27f5 ld a,(iy+000h) ;27f9 comend and 038h ;27fc ld l,a ;27fe ld h,000h ;27ff ld a,(XBFE8) ;2801 and a ;2804 jr nz,l280ch ;2805 ld a,(TCFLG) ;2807 and a ;280a ret nz ;280b l280ch: scf ;280c ret ;280d x280e: and a ;280e ret ;280f CMD.C: ld hl,CMD.C ;2810 ld a,001h ;2813 jr l281bh ;2815 CMD.T: xor a ;2817 ld hl,CMD.T ;2818 l281bh: ld (CMD_RPT),hl ;281b ld (TCFLG),a ;281e ld a,(de) ;2821 sub 'N' ;2822 jr nz,l2827h ;2824 inc de ;2826 l2827h: ld (TCNFLG),a ;2827 ld a,(de) ;282a sub 'J' ;282b jr nz,l2830h ;282d inc de ;282f l2830h: ld (TRJFLG),a ;2830 call sub_289fh ;2833 jr z,l283eh ;2836 ld hl,1 ;2838 call get_lastarg_def ;283b l283eh: ld (TCCSTR),hl ;283e sub a ;2841 ld (XA747),a ;2842 l2845h: call sub_26e7h ;2845 jr l289ch ;2848 l284ah: call sub_0e68h ;284a ld a,(TRJFLG) ;284d and a ;2850 jr nz,l2864h ;2851 ld iy,(REG.PC) ;2853 call sub_28c1h ;2857 jr z,l2864h ;285a ld hl,l2726h ;285c call lookup_opc ;285f jr nc,l2845h ;2862 l2864h: ld a,(XBFEA) ;2864 and a ;2867 jr z,l2881h ;2868 ld de,(TCCSTR) ;286a call EXPR ;286e ld a,h ;2871 or l ;2872 add a,0ffh ;2873 sbc a,a ;2875 ld hl,XBFEA ;2876 xor (hl) ;2879 bit 1,a ;287a jr z,l288ch ;287c l287eh: jp l102eh ;287e l2881h: ld hl,(TCCSTR) ;2881 dec hl ;2884 ld (TCCSTR),hl ;2885 ld a,h ;2888 or l ;2889 jr z,l287eh ;288a l288ch: call sub_26e7h ;288c jr nc,l287eh ;288f ld a,(TCNFLG) ;2891 ld b,a ;2894 ld a,(XA747) ;2895 or b ;2898 ld (XA747),a ;2899 l289ch: jp l1183h ;289c sub_289fh: call SKIPBL ;289f xor a ;28a2 ld (XBFEA),a ;28a3 ld a,(de) ;28a6 cp 'U' ;28a7 jr z,l28aeh ;28a9 cp 'W' ;28ab ret nz ;28ad l28aeh: inc de ;28ae push af ;28af push de ;28b0 call EXPR ;28b1 jp c,ERROR ;28b4 call assert_eol ;28b7 pop hl ;28ba pop af ;28bb ld (XBFEA),a ;28bc sub a ;28bf ret ;28c0 sub_28c1h: comst ld a,(iy+000h) ld b,(iy+0001) comend cp 0edh jr z,l28dbh and 0dfh cp 0ddh ret nz ld a,b cp 0e9h ret l28dbh: ld a,b and 0f7h cp 045h ret ?excom: ex (sp),hl ;28e7 push af ;28e8 push bc ;28e9 push de ;28ea ld c,(hl) ;28eb ld b,000h ;28ec inc hl ;28ee ld a,?lcmax sub c ld de,?exeit ;28ef ldir ex de,hl ld (hl),018h inc hl ld (hl),a ex de,hl pop de ;28f7 pop bc ;28f8 pop af ;28f9 ex (sp),hl ;28fa if CPU_Z180 push hl ;28fb ld hl,(ubbr) ;2900 else push af ;28fb ld a,(ubnk) ;2900 endif if ROMSYS push af ;28fc ld a,(uromen) ;28fd endif jp ?comcod ;2903 ;------------------------------------------ ; ddtram ;------------------------------------------ vartab: dseg ddtram: ;todo: ; The following 2 params are changeable by user. ; Should these moved to top ram? ; ddtrst: rst DRSTNUM ;rst used by ddtz ddtei: ei ;ints enabled/disabled while ddtz is running ret ; offs.pc: dw TPA offs.@: dw 0 CMD_ERR: dw 0 CMD_RPT: dw DDTZML ci.buf: db 80 rept 83 db 0 endm CON.COL: db 0 XA747: db 0 bp_tab: rept BP_CNT db 0,0 dw 0,0,0 endm BP_SIZE equ 8 sexp1: dw sexpbuf sexp2: dw sexpbuf sexpbuf: rept 128 db 0 endm sexpbufe: msg.Y: dc 'Y0' reg.Y: rept 10 dw 0 endm lst.S: dw 0 lst.IP: dw 0 lst.OP: dw 0 lst.OD: db 0 lst.Qj: db 0 lst.D: dw 0 HILOD: dw 0 MAXLOD: dw 0 XB068: dw 0 lst.A: dw 0 XB06C: dw 0 pfx.IXY: db 000h is.pfx.IXY: db 000h lst.L: dw 0 XBE01: dw 0 XBE03: db 000h XBEDD: ret ;ret cc and a pop hl inc hl jp (hl) XBFE8: db 0 TCFLG: db 0 XBFEA: db 0 TCCSTR: dw 0 TCNFLG: db 0 TRJFLG: db 0 wstrtflg: db 1 cseg vartabe: ;------------------------------------------ .phase sysram_start+stacksize $stack: $stcka equ $ - stacksize curphse defl $ .dephase sysramc: .phase curphse topcodbeg: reg.l2: db 0 ; 0fe50h reg.h2: db 0 ; 0fe51h reg.e2: db 0 ; 0fe52h reg.d2: db 0 ; 0fe53h reg.c2: db 0 ; 0fe54h reg.b2: db 0 ; 0fe55h reg.f2: db 0 ; 0fe56h reg.a2: db 0 ; 0fe57h db 0 reg.i: db high ivtab reg.iy: dw 0 ; 0fe5ah reg.ix: dw 0 ; 0fe5ch reg.e: db 0 ; 0fe5eh reg.d: db 0 ; 0fe5fh reg.c: db 0 ; 0fe60h reg.b: db 0 ; 0fe61h if ROMSYS udcntl: db CWAITIO ; 0fe62h (mem-, io- wait) uromen: db ROM_DIS ; 0fe63h endif if CPU_Z180 ubbr: db 0 ; 0fe64h ucbar: db USR$CBAR ; 0fe65h else db 0 ; 0fe64h ubnk: db 0 ; 0fe65h endif reg.f: db 0 ; 0fe66h reg.a: db 0 ; 0fe67h reg.l: db 0 ; 0fe68h reg.h: db 0 ; 0fe69h reg.sp: dw TOPRAM ; 0fe6ah $go: if ROMSYS out (000h),a ;064c fe6c out0 (dcntl),l ;064e pop hl endif if CPU_Z180 out0 (cbar),h ;0652 out0 (bbr),l ;0655 else ld a,h call selbnk endif pop af ;0658 pop hl ;0659 ld sp,(reg.sp) ;065a reg.iff: ei ;065e db 0C3h ;jp TPA ;065f feff ($+1): reg.pc reg.pc: dw TPA bpent: ld (reg.l),hl ;0662 fe82: bpent: pop hl ;0665 dec hl ;0666 ld (reg.pc),hl ;0667 ld (reg.sp),sp ;066a ld sp,reg.l ;066e push af ;0671 if CPU_Z180 in0 h,(cbar) ;0672 in0 l,(bbr) ;0675 ld a,SYS$CBAR ;0679 out0 (cbar),a ;067b ;;; TODO: bbr? else ld a,(@cbnk) ld h,a xor a ld l,a call selbnk endif push hl ;0678 if ROMSYS in0 l,(dcntl) ;067e ld a,CWAITROM+CWAITIO ;0681 out0 (dcntl),a ;0683 ld a,($crom) ;0686 cp c$rom ;0689 ld a,ROM_EN ;068b out (000h),a ;068d endif jp bpddtz ;068f ?comcod: if ROMSYS out (000h),a ;0692 feb2 pop af ;069a endif if CPU_Z180 out0 (cbar),h ;0694 out0 (bbr),l ;0697 pop hl ;069b else call selbnk pop af endif ?exeit: ds ?lcmax+2 push af ;069f if CPU_Z180 ld a,SYS$CBAR ;06a0 out0 (cbar),a ;06a2 ;;; TODO: bbr? else xor a call selbnk endif if ROMSYS ld a,ROM_EN ;06a5 out (000h),a ;06a7 endif pop af ;06a9 ret ;06aa topcodend: curph defl $ .dephase sysrame: end