Unit AtariDbg; Interface Uses G320; Type PBankSwitch = ^TBankSwitch; TBankSwitch = Array[0..8192] Of Byte; Const HiRes : Boolean = False; Function Debug(Buf: Pointer; PC: Word; P,A,X,Y,S: Byte; Scan,Count,Bank: Integer; ScnAddr: LongInt; Var NewStart: Word;{ Var OldByte: Byte;} BS: PBankSwitch; ROMBackup,TIA_Regs,Input_Byte,ObjectLoc: Pointer; Use160By200: Boolean): Boolean; Function ToUpper(St: String): String; Function Exist(FileName: String): Boolean; Procedure Set160Cols; Implementation Uses Crt,Dos,HexWrite,ModeX,Vectors; Const VSYNC = 0; VBLANK = 1; WSYNC = 2; RSYNC = 3; NUSIZ0 = 4; NUSIZ1 = 5; COLUP0 = 6; COLUP1 = 7; COLUPF = 8; COLUBK = 9; CTRLPF = $0A; REFP0 = $0B; REFP1 = $0C; PF0 = $0D; PF1 = $0E; PF2 = $0F; RESP0 = $10; RESP1 = $11; RESM0 = $12; RESM1 = $13; RESBL = $14; AUDC0 = $15; AUDC1 = $16; AUDF0 = $17; AUDF1 = $18; AUDV0 = $19; AUDV1 = $1A; GRP0 = $1B; GRP1 = $1C; ENAM0 = $1D; ENAM1 = $1E; ENABL = $1F; HMP0 = $20; HMP1 = $21; HMM0 = $22; HMM1 = $23; HMBL = $24; VDELP0 = $25; VDELP1 = $26; VDELBL = $27; RESMP0 = $28; RESMP1 = $29; HMOVE = $2A; HMCLR = $2B; CXCLR = $2C; Player0Set = 2; Player1Set = 4; Missile0Set = 8; Missile1Set = 16; BallSet = 32; TIA_Name : Array[0..$2C] Of String[6] = ('VSYNC' ,'VBLANK','WSYNC' ,'RSYNC' ,'NUSIZ0','NUSIZ1','COLUP0','COLUP1', 'COLUPF','COLUBK','CTRLPF','REFP0' ,'REFP1' ,'PF0' ,'PF1' ,'PF2', 'RESP0' ,'RESP1' ,'RESM0' ,'RESM1' ,'RESBL' ,'AUDC0' ,'AUDC1' ,'AUDF0', 'AUDF1' ,'AUDV0' ,'AUDV1' ,'GRP0' ,'GRP1' ,'ENAM0' ,'ENAM1' ,'ENABL' , 'HMP0' ,'HMP1' ,'HMM0' ,'HMM1' ,'HMBL' ,'VDELP0','VDELP1','VDELBL', 'RESMP0','RESMP1','HMOVE' ,'HMCLR' ,'CXCLR'); PIA_Name : Array[$280..$297] Of String[8] = ('SWCHA','SWACNT','SWCHB','SWBCNT','INTTIM','INTTIM','','','','','','','','', '','','','','','','TIM1T','TIM8T','TIM64T','TIM1024T'); TIA_Read_Name : Array[0..$D] Of String[6] = ('CXM0P' ,'CXM1P', 'CXP0FB','CXP1FB','CXM0FB','CXM1FB','CXBLPF','CXPPMM', 'INPUT0','INPUT1','INPUT2','INPUT3','INPUT4','INPUT5'); Bytes : Array[0..255] Of Word = (1,2,1,2,2,2,2,2, 1,2,1,2,3,3,3,3, { 00-0F } 2,2,1,2,2,2,2,2, 1,3,1,3,3,3,3,3, { 10-1F } 3,2,1,2,2,2,2,2, 1,2,1,2,3,3,3,3, { 20-2F } 2,2,1,2,2,2,2,2, 1,3,1,3,3,3,3,3, { 30-3F } 1,2,1,2,2,2,2,2, 1,2,1,2,3,3,3,3, { 40-4F } 2,2,1,2,2,2,2,2, 1,3,1,3,3,3,3,3, { 50-5F } 1,2,1,1,2,2,2,1, 1,2,1,1,3,3,3,1, { 60-6F } 2,2,1,1,2,2,2,1, 1,3,1,1,3,3,3,1, { 70-7F } 2,2,2,2,2,2,2,2, 1,1,1,2,3,3,3,3, { 80-8F } 2,2,1,2,2,2,2,2, 1,3,1,3,3,3,3,3, { 90-9F } 2,2,2,2,2,2,2,1, 1,2,1,1,3,3,3,3, { A0-AF } 2,2,1,2,2,2,2,2, 1,3,1,3,3,3,3,3, { B0-BF } 2,2,2,1,2,2,2,2, 1,2,1,2,3,3,3,3, { C0-CF } 2,2,1,2,2,2,2,2, 1,3,1,3,3,3,3,3, { D0-DF } 2,2,2,1,2,2,2,1, 1,2,1,1,3,3,3,1, { E0-EF } 2,2,1,1,2,2,2,1, 1,3,1,1,3,3,3,1); { F0-FF } Mnem : Array[0..255] Of String[3] = ('BRK','ORA',' ','slo','skb','ORA','ASL','slo', { 00-07 } 'PHP','ORA','ASL','anc','skw','ORA','ASL','slo', { 08-0F } 'BPL','ORA',' ','slo','skb','ORA','ASL','slo', { 10-17 } 'CLC','ORA','NOP','slo','skw','ORA','ASL','slo', { 18-1F } 'JSR','AND',' ','rla','BIT','AND','ROL','rla', { 20-27 } 'PLP','AND','ROL','anc','BIT','AND','ROL','rla', { 28-2F } 'BMI','AND',' ','rla','skb','AND','ROL','rla', { 30-37 } 'SEC','AND','NOP','rla','skw','AND','ROL','rla', { 38-3F } 'RTI','EOR',' ','sre','skb','EOR','LSR','sre', { 40-47 } 'PHA','EOR','LSR','asr','JMP','EOR','LSR','sre', { 48-4F } 'BVC','EOR',' ','sre','skb','EOR','LSR','sre', { 50-57 } 'CLI','EOR','IMP','sre','skw','EOR','LSR','sre', { 58-5F } 'RTS','ADC',' ',' ','skb','ADC','ROR',' ', { 60-67 } 'PLA','ADC','ROR',' ','JMP','ADC','ROR',' ', { 68-6F } 'BVS','ADC',' ',' ','skb','ADC','ROR',' ', { 70-77 } 'SEI','ADC','NOP',' ','skw','ADC','ROR',' ', { 78-7F } 'IMP','STA','skb','sax','STY','STA','STX','sax', { 80-87 } 'DEY','NOP','TXA','ane','STY','STA','STX','sax', { 88-8F } 'BCC','STA',' ','sha','STY','STA','STX','sax', { 90-97 } 'TYA','STA','TXS','shs','shy','STA','shx','sha', { 98-9F } 'LDY','LDA','LDX','lax','LDY','LDA','LDX','lax', { A0-A7 } 'TAY','LDA','TAX','lxa','LDY','LDA','LDX','lax', { A8-AF } 'BCS','LDA',' ','lax','LDY','LDA','LDX','lax', { B0-B7 } 'CLV','LDA','TSX','las','LDY','LDA','LDX','lax', { B8-BF } 'CPY','CMP','skb','dcp','CPY','CMP','DEC','dcp', { C0-C7 } 'INY','CMP','DEX','sbx','CPY','CMP','DEC','dcp', { C8-CF } 'BNE','CMP',' ','dcp','skb','CMP','DEC','dcp', { D0-D7 } 'CLD','CMP','NOP','dcp','skw','CMP','DEC','dcp', { D8-DF } 'CPX','SBC','skb',' ','CPX','SBC','INC',' ', { E0-E7 } 'INX','SBC','NOP',' ','CPX','SBC','INC',' ', { E8-EF } 'BEQ','SBC',' ',' ','skb','SBC','INC',' ', { F0-F7 } 'SED','SBC','NOP',' ','skw','SBC','INC',' '); { F8-FF } ATyp : Array[0..255] Of String[3] = ('IMP','I.X',' ','I.X','IMP','Z.P','Z.P','Z.P', { 00-07 } 'IMP','IMM','ACC','IMM','IMP','ABS','ABS','ABS', { 08-0F } 'REL','I.Y',' ','I.Y','IMP','Z.X','Z.X','Z.X', { 10-17 } 'IMP','A.Y','IMP','A.Y','IMP','A.X','A.X','A.X', { 18-1F } 'ABS','I.X',' ','I.X','Z.P','Z.P','Z.P','Z.P', { 20-27 } 'IMP','IMM','ACC','IMM','ABS','ABS','ABS','ABS', { 28-2F } 'REL','I.Y',' ','I.Y','IMP','Z.X','Z.X','Z.X', { 30-37 } 'IMP','A.Y','IMP','A.Y','IMP','A.X','A.X','A.X', { 38-3F } 'IMP','I.X',' ','I.X','IMP','Z.P','Z.P','Z.P', { 40-47 } 'IMP','IMM','ACC','IMM','ABS','ABS','ABS','ABS', { 48-4F } 'REL','I.Y',' ','I.Y','IMP','Z.X','Z.X','Z.X', { 50-57 } 'IMP','A.Y','IMP','A.Y','IMP','A.X','A.X','A.X', { 58-5F } 'IMP','I.X',' ',' ','SKB','Z.P','Z.P',' ', { 60-67 } 'IMP','IMM','ACC',' ','IND','ABS','ABS',' ', { 68-6F } 'REL','I.Y',' ',' ','IMP','Z.X','Z.X',' ', { 70-77 } 'IMP','A.Y','IMP',' ','IMP','A.X','A.X',' ', { 78-7F } 'IMP','I.X','IMP','I.X','Z.P','Z.P','Z.P','Z.P', { 80-87 } 'IMP','IMP','IMP','IMM','ABS','ABS','ABS','ABS', { 88-8F } 'REL','I.Y',' ','I.Y','Z.X','Z.X','Z.Y','Z.Y', { 90-97 } 'IMP','A.Y','IMP','I.Y','A.X','A.X','A.Y','A.Y', { 98-9F } 'IMM','I.X','IMM','I.X','Z.P','Z.P','Z.P','Z.P', { A0-A7 } 'IMP','IMM','IMP','I+A','ABS','ABS','ABS','ABS', { A8-AF } 'REL','I.Y',' ','I.Y','Z.X','Z.X','Z.Y','Z.Y', { B0-B7 } 'IMP','A.Y','IMP','ASY','A.X','A.X','A.Y','A.Y', { B8-BF } 'IMM','I.X','IMP','I.X','Z.P','Z.P','Z.P','Z.P', { C0-C7 } 'IMP','IMM','IMP','IMM','ABS','ABS','ABS','ABS', { C8-CF } 'REL','I.Y',' ','I.Y','IMP','Z.X','Z.X','Z.X', { D0-D7 } 'IMP','A.Y','IMP','A.Y','IMP','A.X','A.X','A.X', { D8-DF } 'IMM','I.X','IMP',' ','Z.P','Z.P','Z.P',' ', { E0-E7 } 'IMP','IMM','IMP',' ','ABS','ABS','ABS',' ', { E8-EF } 'REL','I.Y',' ',' ','IMP','Z.X','Z.X',' ', { F0-F7 } 'IMP','A.Y','IMP',' ','IMP','A.X','A.Y',' '); { F8-FF } Const TextColor = 0; HiTextColor = 31; PCTextColor = 246; LineColor = 14; TextStart = 2; TextHeight = 8; BackColor = 4; DisasmColor = 174; FlagsColor = 254; RegsColor = 110; DataColor = 158; ScrDatColor = 90; TIA_Color = 155; DisasmLines = 16; HRDisasmLines = 32; DataLines = 8; SmFontSize = 1024; Var Win : _WindowPtr; HelpWin : _WindowPtr; FontSmPtr : Pointer; OldExitProc : Pointer; Function ToUpper(St: String): String; Var I: Byte; Begin If St = '' Then Begin ToUpper := ''; Exit; End; For I := 1 To Length(St) Do St[I] := UpCase(St[I]); ToUpper := St; End; { ToUpper } Function Exist(FileName: String): Boolean; Var Fil: File; Begin Assign(Fil,FileName); {$I-} Reset(Fil); {$I+} If (IOResult = 0) Then Begin Close(Fil); Exist := True; End Else Exist := False; End; { Exist } {$F+} Procedure NewExitProc; Begin FreeMem(FontSmPtr,SmFontSize); End; { NewExitProc } {$F-} Procedure LoadSmallFont; Var F: File; Begin Assign(F,'ATARIDBG.FNT'); Reset(F,1); BlockRead(F,FontSmPtr^,SmFontSize); Close(F); End; { LoadSmallFont } Const VGA_SEGMENT = $A000; SC_INDEX = $3C4; { Sequence Controller Index register } GC_INDEX = $3CE; { Graphics Controller Index register } CRTC_INDEX = $3D4; { CRT Controller Index register } MISCELLANEOUS = 6; { Moscellaneous register index in GC } MEMORY_MODE = 4; { Memory Mode register index in SC } GRAPHICS_MODE = 5; { Graphics Mode register index in GC } MAX_SCAN_LINE = 9; { Maximum Scan Line reg index in CRTC } UNDERLINE = $14; { Underline Location reg index in CRTC } MODE_CONTROL = $17; { Mode Control register index in CRTC } MAP_MASK = 2; { Map Mask register index in SC } HORZ_TOTAL = 0; HORZ_DISPLAY_END = 1; START_HORZ_BLANK = 2; END_HORZ_BLANK = 3; START_HORZ_RETRACE = 4; END_HORZ_RETRACE = 5; VERT_TOTAL = 6; OVERFLOW = 7; START_VERT_RETRACE = $10; END_VERT_RETRACE = $11; VERT_DISPLAY_END = $12; CRTC_OFFSET = $13; START_VERT_BLANK = $15; END_VERT_BLANK = $16; Procedure Set320By200Mode; Assembler; Asm MOV DX,SC_INDEX MOV AL,MEMORY_MODE OUT DX,AL INC DX IN AL,DX OR AL,08h { Turn on chain 4 } AND AL,NOT 04h { Turn on odd/even } OUT DX,AL MOV DX,GC_INDEX MOV AL,GRAPHICS_MODE OUT DX,AL INC DX IN AL,DX OR AL,10h { Turn on odd/even } OUT DX,AL DEC DX MOV AL,MISCELLANEOUS OUT DX,AL INC DX IN AL,DX OR AL,02h { Turn on chain } OUT DX,AL { Now clear the whole screen. Do this before we switch the CRTC out } { of mode 13h, so we don't see garbage on the screen when we make } { the switch. } MOV DX,SC_INDEX { Enable writes to all planes, so } MOV AX,0F00h + MAP_MASK { we can clear 4 pixels at a time } OUT DX,AX MOV AX,VGA_SEGMENT MOV ES,AX SUB DI,DI MOV AX,DI MOV CX,8000h { # of words in 64k } CLD REP STOSW MOV DX,CRTC_INDEX MOV AL,MAX_SCAN_LINE OUT DX,AL INC DX IN AL,DX OR AL,1 { Set maximum scan line = 1 } OUT DX,AL DEC DX MOV AL,UNDERLINE OUT DX,AL INC DX IN AL,DX OR AL,40h { Turn on doubleword } OUT DX,AL DEC DX MOV AL,MODE_CONTROL OUT DX,AL INC DX IN AL,DX AND AL,NOT 40h OUT DX,AL End; { Set320By200Mode } Procedure Set320By400Mode; Assembler; Asm { Change CPU addressing of video memory to linear (not odd/even, } { chain, or chain 4), to allow us to access all 256K of display } { memory. When this is done, VGA memory will look just like memory } { in modes 10h and 12h, except that each byte of display memory will } { control one 256-color pixel, with 4 adjacent pixels at any given } { address, one pixel per plane. } MOV DX,SC_INDEX MOV AL,MEMORY_MODE OUT DX,AL INC DX IN AL,DX AND AL,NOT 08h { Turn off chain 4 } OR AL,04h { Turn off odd/even } OUT DX,AL MOV DX,GC_INDEX MOV AL,GRAPHICS_MODE OUT DX,AL INC DX IN AL,DX AND AL,NOT 10h { Turn off odd/even } OUT DX,AL DEC DX MOV AL,MISCELLANEOUS OUT DX,AL INC DX IN AL,DX AND AL,NOT 02h { Turn off chain } OUT DX,AL { Now clear the whole screen. Do this before we switch the CRTC out } { of mode 13h, so we don't see garbage on the screen when we make } { the switch. } MOV DX,SC_INDEX { Enable writes to all planes, so } MOV AX,0F00h + MAP_MASK { we can clear 4 pixels at a time } OUT DX,AX MOV AX,VGA_SEGMENT MOV ES,AX SUB DI,DI MOV AX,DI MOV CX,8000h { # of words in 64k } CLD REP STOSW { Tweak the mode to 320x400 256-color mode by not scanning each line } { twice. } MOV DX,CRTC_INDEX MOV AL,MAX_SCAN_LINE OUT DX,AL INC DX IN AL,DX AND AL,NOT 1Fh { Set maximum scan line = 0 } OUT DX,AL DEC DX { Change CRTC scanning from doubleword mode to byte mode, allowing } { the CRTC to scan more than 64K of video data. } MOV AL,UNDERLINE OUT DX,AL INC DX IN AL,DX AND AL,NOT 40h { Turn off doubleword } OUT DX,AL DEC DX MOV AL,MODE_CONTROL OUT DX,AL INC DX IN AL,DX OR AL,40h { Turn on the byte mode bit, so memory } OUT DX,AL { is scanned for video data in a purely } { linear way, just as in modes 10h and } { 12h } End; { Set320By400Mode } Procedure UnprotectCRTC; Assembler; Asm { Un-protect the CRTC registers } MOV DX,CRTC_INDEX MOV AL,END_VERT_RETRACE OUT DX,AL INC DX IN AL,DX AND AL,7Fh OUT DX,AL DEC DX MOV AL,END_HORZ_BLANK OUT DX,AL IN AL,DX OR AL,80h OUT DX,AL End; { UnprotectCRTC } Procedure ProtectCRTC; Assembler; Asm { Re-protect the CRTC registers } MOV DX,CRTC_INDEX MOV AL,END_HORZ_BLANK OUT DX,AL INC DX IN AL,DX AND AL,7Fh OUT DX,AL DEC DX MOV AL,END_VERT_RETRACE OUT DX,AL IN AL,DX OR AL,80h OUT DX,AL End; { ProtectCRTC } Procedure Set160Cols; Begin UnprotectCRTC; Asm { Change to 160 columns by changing the horizontal registers } MOV DX,SC_INDEX MOV AL,1 OUT DX,AL INC DX IN AL,DX OR AL,8 OUT DX,AL MOV DX,CRTC_INDEX MOV AL,HORZ_TOTAL OUT DX,AL INC DX MOV AL,2Ah OUT DX,AL DEC DX MOV AL,HORZ_DISPLAY_END OUT DX,AL INC DX MOV AL,27h OUT DX,AL DEC DX MOV AL,START_HORZ_BLANK OUT DX,AL INC DX MOV AL,28h OUT DX,AL DEC DX MOV AL,END_HORZ_BLANK OUT DX,AL INC DX MOV AL,8Eh OUT DX,AL DEC DX MOV AL,START_HORZ_RETRACE OUT DX,AL INC DX MOV AL,2Ch OUT DX,AL DEC DX MOV AL,END_HORZ_RETRACE OUT DX,AL INC DX MOV AL,0Eh OUT DX,AL DEC DX MOV AL,CRTC_OFFSET OUT DX,AL INC DX MOV AL,14h OUT DX,AL DEC DX End; { Asm } ProtectCRTC; End; { Set160Cols } Procedure PutChar(X,Y: Word; C: Char; Color: Word); Assembler; Asm TEST BYTE PTR HiRes,0FFh JZ @Normal MOV AX,WORD PTR Y SHL AX,4 MOV DI,AX SHL DI,2 ADD DI,AX MOV AX,WORD PTR X SHR AX,2 ADD DI,AX MOV AH,11h MOV CX,WORD PTR X AND CX,3 ROL AH,CL MOV AL,MAP_MASK MOV DX,SC_INDEX PUSH DS LDS SI,DWORD PTR FontPtr MOV BL,BYTE PTR C SUB BH,BH SHL BX,3 ADD SI,BX MOV BX,0A000h MOV ES,BX MOV CX,8 MOV BX,WORD PTR Color @Loop1: OUT DX,AX TEST BYTE PTR [SI],80h JNZ @On0 MOV BYTE PTR [ES:DI],BH JMP @Do4 @On0: MOV BYTE PTR [ES:DI],BL @Do4: TEST BYTE PTR [SI],8 JNZ @On4 MOV BYTE PTR [ES:DI + 1],BH JMP @Do1 @On4: MOV BYTE PTR [ES:DI + 1],BL @Do1: ROL AH,1 ADC DI,0 OUT DX,AX TEST BYTE PTR [SI],40h JNZ @On1 MOV BYTE PTR [ES:DI],BH JMP @Do5 @On1: MOV BYTE PTR [ES:DI],BL @Do5: TEST BYTE PTR [SI],4 JNZ @On5 MOV BYTE PTR [ES:DI + 1],BH JMP @Do2 @On5: MOV BYTE PTR [ES:DI + 1],BL @Do2: ROL AH,1 ADC DI,0 OUT DX,AX TEST BYTE PTR [SI],20h JNZ @On2 MOV BYTE PTR [ES:DI],BH JMP @Do6 @On2: MOV BYTE PTR [ES:DI],BL @Do6: TEST BYTE PTR [SI],2 JNZ @On6 MOV BYTE PTR [ES:DI + 1],BH JMP @Do3 @On6: MOV BYTE PTR [ES:DI + 1],BL @Do3: ROL AH,1 ADC DI,0 OUT DX,AX TEST BYTE PTR [SI],10h JNZ @On3 MOV BYTE PTR [ES:DI],BH JMP @Do7 @On3: MOV BYTE PTR [ES:DI],BL @Do7: TEST BYTE PTR [SI],1 JNZ @On7 MOV BYTE PTR [ES:DI + 1],BH JMP @Done @On7: MOV BYTE PTR [ES:DI + 1],BL @Done: ROL AH,1 TEST BYTE PTR X,3 JZ @NoDec DEC DI @NoDec: ADD DI,80 INC SI DEC CX JNZ @Loop1 POP DS JMP @L3 @Normal: MOV AX,WORD PTR Y SUB BX,BX MOV BH,AL SHL AX,6 ADD BX,AX MOV DI,BX ADD DI,WORD PTR X PUSH DS LDS SI,DWORD PTR FontPtr MOV AL,BYTE PTR C SUB AH,AH SHL AX,3 ADD SI,AX MOV AX,0A000h MOV ES,AX MOV AL,8 ADD DI,7 MOV DX,WORD PTR Color @Loop: MOV BH,BYTE PTR [SI] MOV CX,8 MOV BL,1 @L1: TEST BH,BL JZ @L2 MOV BYTE PTR [ES:DI],DL DEC DI ADD BL,BL LOOP @L1 ADD DI,328 INC SI DEC AL JNZ @Loop POP DS JMP @L3 @L2: MOV BYTE PTR [ES:DI],DH DEC DI ADD BL,BL LOOP @L1 ADD DI,328 INC SI DEC AL JNZ @Loop POP DS @L3: End; { PutChar } Procedure WriteOut(X,Y: Word; St: String; Color: Word); Var I: Byte; Begin If St = '' Then Exit; For I := 0 To Length(St) - 1 Do PutChar(X + (I * 8),Y,St[I + 1],Color); End; { WriteOut } Procedure PutSmChar(X,Y: Word; C: Char; Color: Word); Assembler; Asm TEST BYTE PTR HiRes,0FFh JZ @Normal MOV AX,WORD PTR Y SHL AX,4 MOV DI,AX SHL DI,2 ADD DI,AX MOV AX,WORD PTR X SHR AX,2 ADD DI,AX MOV AH,11h MOV CX,WORD PTR X AND CX,3 ROL AH,CL MOV AL,MAP_MASK MOV DX,SC_INDEX PUSH DS LDS SI,DWORD PTR FontSmPtr MOV BL,BYTE PTR C SUB BH,BH SHL BX,3 ADD SI,BX MOV BX,0A000h MOV ES,BX MOV CX,8 MOV BX,WORD PTR Color @Loop1: OUT DX,AX TEST BYTE PTR [SI],80h JNZ @On0 MOV BYTE PTR [ES:DI],BH JMP @Do4 @On0: MOV BYTE PTR [ES:DI],BL @Do4: TEST BYTE PTR [SI],8 JNZ @On4 MOV BYTE PTR [ES:DI + 1],BH JMP @Do1 @On4: MOV BYTE PTR [ES:DI + 1],BL @Do1: ROL AH,1 ADC DI,0 OUT DX,AX TEST BYTE PTR [SI],40h JNZ @On1 MOV BYTE PTR [ES:DI],BH JMP @Do5 @On1: MOV BYTE PTR [ES:DI],BL @Do5: TEST BYTE PTR [SI],4 JNZ @On5 MOV BYTE PTR [ES:DI + 1],BH JMP @Do2 @On5: MOV BYTE PTR [ES:DI + 1],BL @Do2: ROL AH,1 ADC DI,0 OUT DX,AX TEST BYTE PTR [SI],20h JNZ @On2 MOV BYTE PTR [ES:DI],BH JMP @Do3 @On2: MOV BYTE PTR [ES:DI],BL @Do3: ROL AH,1 ADC DI,0 OUT DX,AX TEST BYTE PTR [SI],10h JNZ @On3 MOV BYTE PTR [ES:DI],BH JMP @Done @On3: MOV BYTE PTR [ES:DI],BL @Done: ROL AH,1 TEST BYTE PTR X,3 JZ @NoDec DEC DI @NoDec: ADD DI,80 INC SI DEC CX JNZ @Loop1 POP DS JMP @L3 @Normal: MOV AX,WORD PTR Y SUB BX,BX MOV BH,AL SHL AX,6 ADD BX,AX MOV DI,BX ADD DI,WORD PTR X PUSH DS LDS SI,DWORD PTR FontSmPtr MOV AL,BYTE PTR C SUB AH,AH SHL AX,3 ADD SI,AX MOV AX,0A000h MOV ES,AX MOV AL,8 ADD DI,7 MOV DX,WORD PTR Color @Loop: MOV BH,BYTE PTR [SI] MOV CX,6 MOV BL,4 @L1: TEST BH,BL JZ @L2 MOV BYTE PTR [ES:DI],DL DEC DI ADD BL,BL LOOP @L1 ADD DI,326 INC SI DEC AL JNZ @Loop POP DS @L2: MOV BYTE PTR [ES:DI],DH DEC DI ADD BL,BL LOOP @L1 ADD DI,326 INC SI DEC AL JNZ @Loop POP DS @L3: End; { PutSmChar } Procedure WriteSmOut(X,Y: Word; St: String; Color: Word); Var I: Byte; Begin If St = '' Then Exit; For I := 0 To Length(St) - 1 Do PutSmChar(X + (I * 6),Y,St[I + 1],Color); End; { WriteSmOut } Procedure Swap(Var A,B: Word); Var C: Word; Begin C := A; A := B; B := C; End; { Swap } Procedure SwapInt(Var A,B: Integer); Var C: Integer; Begin C := A; A := B; B := C; End; { SwapInt } Function __MakeWin(Var W: _WindowPtr; X1,Y1,X2,Y2: Word; Fill: Byte): Boolean; Begin If W = Nil Then New(W); If X2 < X1 Then Swap(X1,X2); If Y2 < Y1 Then Swap(Y1,Y2); W^._X1 := X1; W^._Y1 := Y1; W^._X2 := X2; W^._Y2 := Y2; W^._Size := (Y2 - Y1 + 1) * (X2 - X1 + 1); W^._Back := Nil; W^._Active := False; W^._FillColor := Fill; __MakeWin := True; End; { __MakeWin } Function __DispWin(Var W: _WindowPtr): Boolean; Var I,J : Word; M : Boolean; P : Pointer; X,Y : Word; Begin If W = Nil Then { __MakeWin has not been called } Begin __DispWin := False; Exit; End; If MaxAvail < W^._Size Then { Not enough heap space free } Begin __DispWin := False; Exit; End; GetMem(W^._Back,W^._Size); I := Seg(W^._Back^); J := Ofs(W^._Back^); If J > $F Then Begin Inc(I,J Shr 4); J := J And $F; End; P := Ptr(I,J); W^._Active := True; J := W^._X2 - W^._X1 + 1; { M := MouseVisible;} { If M Then ToggleMouseVisibility;} For I := 0 To W^._Y2 - W^._Y1 Do Begin Move(Mem[$A000:(I + W^._Y1) * 320 + W^._X1], Mem[Seg(P^):Ofs(P^) + I * J],J); FillChar(Mem[$A000:(I + W^._Y1) * 320 + W^._X1], J,W^._FillColor); End; { For I } { If M Then ToggleMouseVisibility;} If _WindowList = Nil Then Begin New(_WindowList); _WindowList^._Prev := Nil; _WindowList^._Next := Nil; _WindowList^._Window := W; End Else Begin _ListWork := _WindowList; While _ListWork^._Next <> Nil Do _ListWork := _ListWork^._Next; New(_ListWork^._Next); _ListWork^._Next^._Prev := _ListWork; _ListWork := _ListWork^._Next; _ListWork^._Next := Nil; _ListWork^._Window := W; End; __DispWin := True; End; { __DispWin } Function __RemWin: Boolean; Var I,J : Word; W : _WindowPtr; M : Boolean; Begin If _WindowList = Nil Then Begin __RemWin := False; Exit; End; _ListWork := _WindowList; While _ListWork^._Next <> Nil Do _ListWork := _ListWork^._Next; W := _ListWork^._Window; W^._Active := False; J := W^._X2 - W^._X1 + 1; { M := MouseVisible;} { If M Then ToggleMouseVisibility;} For I := 0 To W^._Y2 - W^._Y1 Do Begin Move(Mem[Seg(W^._Back^):Ofs(W^._Back^) + I * J], Mem[$A000:(I + W^._Y1) * 320 + W^._X1],J); End; { For I } { If M Then ToggleMouseVisibility;} FreeMem(W^._Back,W^._Size); If _ListWork^._Prev <> Nil Then Begin _ListWork := _ListWork^._Prev; Dispose(_ListWork^._Next); _ListWork^._Next := Nil; End Else Begin Dispose(_ListWork); _WindowList := Nil; End; __RemWin := True; End; { __RemWin } Procedure Box(X1,Y1,X2,Y2: Integer; Color: Byte); Begin If HiRes Then RectangleX(X1,Y1,X2,Y2,0,Color) Else Begin Line(X1,Y1,X2,Y1,Color); Line(X2,Y1,X2,Y2,Color); Line(X2,Y2,X1,Y2,Color); Line(X1,Y2,X1,Y1,Color); End; End; { Box } Procedure FBox(X1,Y1,X2,Y2: Integer; Color: Byte); Var Y,Addr,Len: Word; Begin If HiRes Then FillRectangleX(X1,Y1,X2 + 1,Y2 + 1,0,Color) Else Begin If X2 < X1 Then SwapInt(X1,X2); If Y2 < Y1 Then SwapInt(Y1,Y2); Asm MOV AX,WORD PTR Y1 SUB BX,BX MOV BH,AL SHL AX,6 ADD BX,AX MOV DI,BX ADD DI,WORD PTR X1 MOV WORD PTR Addr,DI End; { Asm } Len := X2 - X1 + 1; For Y := Y1 To Y2 Do Begin FillChar(Mem[$A000:Addr],Len,Color); Inc(Addr,320); End; { For Y } End; End; { FBox } Function Debug(Buf: Pointer; PC: Word; P,A,X,Y,S: Byte; Scan,Count,Bank: Integer; ScnAddr: LongInt; Var NewStart: Word;{ Var OldByte: Byte;} BS: PBankSwitch; ROMBackup,TIA_Regs,Input_Byte,ObjectLoc: Pointer; Use160By200: Boolean): Boolean; Var I,J : Word; B : Byte; DataTop : Word; Opcode : Byte; Addr : Word; OTyp : String[3]; Operand : String; Color : Word; TopAddr : Word; Ch : Char; Access : Word; AccSize : Word; Switch : Boolean; Temp : Boolean; _DLines : Word; Function TransWordWrite(Addr: Word): String; Begin If (Addr < $80) Or ((Addr >= $100) And (Addr < $180)) Then Addr := Addr And $3F; Case Addr Of 0..$2C: TransWordWrite := TIA_Name[Addr]; $280..$297: TransWordWrite := PIA_Name[Addr]; $380..$397: TransWordWrite := PIA_Name[Addr - $100]; Else TransWordWrite := HexWord(Addr); End; { Case } End; { TransWordWrite } Function TransWordRead(Addr: Word): String; Begin Case Addr Of 0..$7F,$100..$17F,$200..$27F,$300..$37F: TransWordRead := TIA_Read_Name[Addr And $F]; $280..$297: TransWordRead := PIA_Name[Addr]; $380..$397: TransWordRead := PIA_Name[Addr - $100]; Else TransWordRead := HexWord(Addr); End; { Case } End; { TransWordRead } Function TransByteRead(Addr: Word): String; Begin Case Addr Of 0..$7F,$100..$17F,$200..$27F,$300..$37F: TransByteRead := TIA_Read_Name[Addr And $F]; $280..$297: TransByteRead := PIA_Name[Addr]; $380..$397: TransByteRead := PIA_Name[Addr - $100]; Else TransByteRead := HexByte(Addr); End; { Case } End; { TransByteRead } Function TransByteWrite(Addr: Word): String; Begin If (Addr < $80) Or ((Addr >= $100) And (Addr < $180)) Then Addr := Addr And $3F; Case Addr Of 0..$2C: TransByteWrite := TIA_Name[Addr]; Else TransByteWrite := HexByte(Addr); End; { Case } End; { TransByteWrite } Function TransWord(Addr: Word): String; Var Instr: String[3]; Begin Instr := Mnem[Opcode]; If (Addr < $80) And (Copy(Instr,1,2) = 'RO') Then TransWord := TransWordRead(Addr) Else If (Instr = 'ADC') Or (Instr = 'DEC') Or (Instr = 'INC') Or (Instr = 'SBC') Or (Copy(Instr,1,2) = 'PH') Or (Copy(Instr,1,2) = 'RO') Or (Copy(Instr,1,2) = 'ST') Then TransWord := TransWordWrite(Addr) Else TransWord := TransWordRead(Addr); End; { TransWord } Function TransByte(Addr: Word): String; Var Instr: String[3]; Begin Instr := Mnem[Opcode]; If (Addr < $80) And (Copy(Instr,1,2) = 'RO') Then TransByte := TransByteRead(Addr) Else If (Instr = 'ADC') Or (Instr = 'DEC') Or (Instr = 'INC') Or (Instr = 'SBC') Or (Copy(Instr,1,2) = 'PH') Or (Copy(Instr,1,2) = 'RO') Or (Copy(Instr,1,2) = 'ST') Then TransByte := TransByteWrite(Addr) Else TransByte := TransByteRead(Addr); End; { TransByte } Function IntToStr(L: LongInt): String; Var St: String; Begin Str(L,St); IntToStr := St; End; {IntToStr } Procedure FlipWindow; Var ThisWin : Pointer; _ListWork : _ListPtr; W : _WindowPtr; I,J : Word; Pal : Array[0..767] Of Byte; Begin Temp := HiRes; If HiRes Then Set320By200Mode; HiRes := False; If _WindowList = Nil Then Exit; _ListWork := _WindowList; While _ListWork^._Next <> Nil Do _ListWork := _ListWork^._Next; W^ := _ListWork^._Window^; J := W^._X2 - W^._X1 + 1; For I := 0 To W^._Y2 - W^._Y1 Do Begin If Use160By200 Then Set160Cols; Move(Mem[Seg(W^._Back^):Ofs(W^._Back^) + I * J], Mem[$A000:(I + W^._Y1) * 320 + W^._X1],J); End; { For I } ReadKey; Port[$3C7] := 0; For I := 0 To 767 Do Pal[I] := Port[$3C9]; If Use160By200 Then Begin Asm MOV AX,13h INT 10h End; { Asm } Port[$3C8] := 0; For I := 0 To 767 Do Port[$3C9] := Pal[I]; End; HiRes := Temp; If HiRes Then Set320By400Mode; End; { FlipWindow } Procedure Display; Var I,J: Integer; Begin If HiRes Then Begin FBox(0,0,319,399,BackColor); Box(0,0,250,259,LineColor); Box(252,0,319,19,LineColor); Box(252,21,319,72,LineColor); Box(0,333,319,399,LineColor); Box(252,74,319,125,LineColor); Box(0,261,319,287,LineColor); Box(0,289,319,299,LineColor); Box(0,301,319,311,LineColor); FBox(1,1,249,258,DisasmColor); FBox(253,1,318,18,FlagsColor); FBox(253,22,318,71,RegsColor); FBox(1,334,318,398,DataColor); FBox(253,75,318,124,ScrDatColor); FBox(1,262,318,286,TIA_Color); FBox(1,290,318,298,TIA_Color); FBox(1,302,318,310,DataColor + 1); WriteOut(254,2,'NV BDIZC' ,TextColor + (FlagsColor Shl 8)); WriteOut(254,23,'PC= h',TextColor + (RegsColor Shl 8)); WriteOut(254,31,' P= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,39,' A= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,47,' X= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,55,' Y= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,63,' S= h ',TextColor + (RegsColor Shl 8)); WriteSmOut(254, 76,'Scan= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254, 84,'HPix= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254, 92,'Bank= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254,100,'Addr= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254,108,'GRP0= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254,116,'GRP1= ',TextColor + (ScrDatColor Shl 8)); WriteOut(254,127,'F1-Help',FlagsColor + (BackColor Shl 8)); { Display flag data } For I := 0 To 7 Do Begin If (P And (1 Shl I)) <> 0 Then WriteOut(310 - I * 8,10,'1',HiTextColor + (FlagsColor Shl 8)) Else WriteOut(310 - I * 8,10,'0',HiTextColor + (FlagsColor Shl 8)); End; { For I } { Display reg data } WriteOut(278,23,HexWord(PC),HiTextColor + (RegsColor Shl 8)); WriteOut(278,31,HexByte(P) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,39,HexByte(A) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,47,HexByte(X) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,55,HexByte(Y) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,63,HexByte(S) ,HiTextColor + (RegsColor Shl 8)); { Display screen info data } WriteOut(284, 76,IntToStr(Scan) ,HiTextColor + (ScrDatColor Shl 8)); WriteOut(284, 84,IntToStr(Count) ,HiTextColor + (ScrDatColor Shl 8)); WriteOut(284, 92,IntToStr(Bank) ,HiTextColor + (ScrDatColor Shl 8)); WriteOut(284,100,HexWord(ScnAddr),HiTextColor + (ScrDatColor Shl 8)); WriteOut(284,108,HexByte(Mem[Seg(TIA_Regs^):Ofs(TIA_Regs^) + GRP0]) + 'h',HiTextColor + (ScrDatColor Shl 8)); WriteOut(284,116,HexByte(Mem[Seg(TIA_Regs^):Ofs(TIA_Regs^) + GRP1]) + 'h',HiTextColor + (ScrDatColor Shl 8)); { Display data area } For I := 0 To DataLines - 1 Do Begin WriteOut(2,335 + I * 8,HexWord(DataTop + I * $10),TextColor + (DataColor Shl 8)); For J := 0 To $F Do Begin WriteSmOut(44 + J * 17,335 + I * 8, HexByte(Mem[Seg(Buf^):Ofs(Buf^) + DataTop + I * $10 + J]), TextColor + (DataColor Shl 8)); If (J And $F) = 7 Then DrawLineX(44 + J * 17 + 12,338 + I * 8,44 + J * 17 + 15,338 + I * 8, 0,TextColor + (DataColor Shl 8)); End; { For J } End; { For I } { Display TIA registers } For I := 0 To $2C Do Begin If (I And $F) = 0 Then WriteOut(2,263 + (I Shr 1),HexWord(I),TextColor + (TIA_Color Shl 8)); WriteSmOut(44 + (I And $F) * 17,263 + ((I Shr 1) And $FFF8), HexByte(Mem[Seg(TIA_Regs^):Ofs(TIA_Regs^) + I]), TextColor + (TIA_Color Shl 8)); If (I And $F) = 7 Then DrawLineX(44 + (I And $F) * 17 + 12,266 + ((I Shr 1) And $FFF8), 44 + (I And $F) * 17 + 15,266 + ((I Shr 1) And $FFF8), 0,TextColor + (DataColor Shl 8)); End; { For I } { Display input registers } For I := 0 To $F Do Begin If (I And $F) = 0 Then WriteOut(2,291 + (I Shr 1),HexWord(I),TextColor + (TIA_Color Shl 8)); WriteSmOut(44 + (I And $F) * 17,291 + ((I Shr 1) And $FFF8), HexByte(Mem[Seg(Input_Byte^):Ofs(Input_Byte^) + I]), TextColor + (TIA_Color Shl 8)); If (I And $F) = 7 Then DrawLineX(44 + (I And $F) * 17 + 12,294 + ((I Shr 1) And $FFF8), 44 + (I And $F) * 17 + 15,294 + ((I Shr 1) And $FFF8), 0,TextColor + (DataColor Shl 8)); End; { For I } { Display object locations } WriteOut(2,303,'P0',TextColor + (DataColor Shl 8)); WriteSmOut(20,303,IntToStr(Integer(Mem[Seg(ObjectLoc^):Ofs(ObjectLoc^) + Player0Set * 2])), TextColor + (DataColor Shl 8)); WriteOut(44,303,'P1',TextColor + (DataColor Shl 8)); WriteSmOut(62,303,IntToStr(Integer(Mem[Seg(ObjectLoc^):Ofs(ObjectLoc^) + Player1Set * 2])), TextColor + (DataColor Shl 8)); WriteOut(86,303,'M0',TextColor + (DataColor Shl 8)); WriteSmOut(104,303,IntToStr(Integer(Mem[Seg(ObjectLoc^):Ofs(ObjectLoc^) + Missile0Set * 2])), TextColor + (DataColor Shl 8)); WriteOut(128,303,'M1',TextColor + (DataColor Shl 8)); WriteSmOut(146,303,IntToStr(Integer(Mem[Seg(ObjectLoc^):Ofs(ObjectLoc^) + Missile1Set * 2])), TextColor + (DataColor Shl 8)); WriteOut(170,303,'BL',TextColor + (DataColor Shl 8)); WriteSmOut(188,303,IntToStr(Integer(Mem[Seg(ObjectLoc^):Ofs(ObjectLoc^) + BallSet * 2])), TextColor + (DataColor Shl 8)); End Else Begin FBox(0,0,319,199,BackColor); Box(0,0,250,131,LineColor); Box(252,0,319,19,LineColor); Box(252,21,319,72,LineColor); Box(0,133,319,199,LineColor); Box(252,74,319,124,LineColor); FBox(1,1,249,130,DisasmColor); FBox(253,1,318,18,FlagsColor); FBox(253,22,318,71,RegsColor); FBox(1,134,318,198,DataColor); FBox(253,75,318,123,ScrDatColor); WriteOut(254,2,'NV BDIZC' ,TextColor + (FlagsColor Shl 8)); WriteOut(254,23,'PC= h',TextColor + (RegsColor Shl 8)); WriteOut(254,31,' P= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,39,' A= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,47,' X= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,55,' Y= h ',TextColor + (RegsColor Shl 8)); WriteOut(254,63,' S= h ',TextColor + (RegsColor Shl 8)); WriteSmOut(254, 76,'Scan= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254, 84,'HPix= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254, 92,'Bank= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254,100,'Addr= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254,108,'GRP0= ',TextColor + (ScrDatColor Shl 8)); WriteSmOut(254,116,'GRP1= ',TextColor + (ScrDatColor Shl 8)); WriteOut(254,125,'F1-Help',FlagsColor + (BackColor Shl 8)); { Display flag data } For I := 0 To 7 Do Begin If (P And (1 Shl I)) <> 0 Then WriteOut(310 - I * 8,10,'1',HiTextColor + (FlagsColor Shl 8)) Else WriteOut(310 - I * 8,10,'0',HiTextColor + (FlagsColor Shl 8)); End; { For I } { Display reg data } WriteOut(278,23,HexWord(PC),HiTextColor + (RegsColor Shl 8)); WriteOut(278,31,HexByte(P) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,39,HexByte(A) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,47,HexByte(X) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,55,HexByte(Y) ,HiTextColor + (RegsColor Shl 8)); WriteOut(278,63,HexByte(S) ,HiTextColor + (RegsColor Shl 8)); { Display screen info data } WriteOut(284, 76,IntToStr(Scan) ,HiTextColor + (ScrDatColor Shl 8)); WriteOut(284, 84,IntToStr(Count) ,HiTextColor + (ScrDatColor Shl 8)); WriteOut(284, 92,IntToStr(Bank) ,HiTextColor + (ScrDatColor Shl 8)); WriteOut(284,100,HexWord(ScnAddr),HiTextColor + (ScrDatColor Shl 8)); WriteOut(284,108,HexByte(Mem[Seg(TIA_Regs^):Ofs(TIA_Regs^) + GRP0]) + 'h',HiTextColor + (ScrDatColor Shl 8)); WriteOut(284,116,HexByte(Mem[Seg(TIA_Regs^):Ofs(TIA_Regs^) + GRP1]) + 'h',HiTextColor + (ScrDatColor Shl 8)); { Display data area } For I := 0 To DataLines - 1 Do Begin WriteOut(2,135 + I * 8,HexWord(DataTop + I * $10),TextColor + (DataColor Shl 8)); For J := 0 To $F Do Begin WriteSmOut(44 + J * 17,135 + I * 8, HexByte(Mem[Seg(Buf^):Ofs(Buf^) + DataTop + I * $10 + J]), TextColor + (DataColor Shl 8)); If (J And $F) = 7 Then Line(44 + J * 17 + 14,138 + I * 8,44 + J * 17 + 17,138 + I * 8, TextColor + (DataColor Shl 8)); End; { For J } End; { For I } End; End; { Display } Begin { If MouseVisible Then ToggleMouseVisibility;} TopAddr := PC; DataTop := $80; __DispWin(Win); If HiRes Then Set320By400Mode; Display; Repeat { Display instructions } { If MouseVisible Then ToggleMouseVisibility;} Addr := TopAddr; If HiRes Then _DLines := HRDisasmLines Else _DLines := DisasmLines; For I := 0 To _DLines - 1 Do Begin If Addr = PC Then Begin Color := PCTextColor + (HiTextColor Shl 8); FBox(2,2 + I * 8,248,9 + I * 8,HiTextColor); End Else Begin Color := TextColor + (DisasmColor Shl 8); FBox(2,2 + I * 8,248,9 + I * 8,DisasmColor); End; Opcode := Mem[Seg(Buf^):Ofs(Buf^) + Addr]; If HiRes Then WriteSmOut(2,2 + I * 8,HexWord(Addr),Color) Else WriteOut(2,2 + I * 8,HexWord(Addr),Color); For J := 0 To Bytes[Opcode] - 1 Do Begin WriteSmOut(44 + J * 12,2 + I * 8, HexByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + J]),Color); End; { For J } If HiRes Then WriteSmOut(88,2 + I * 8,Mnem[Opcode],Color) Else WriteOut(88,2 + I * 8,Mnem[Opcode],Color); OTyp := ATyp[Opcode]; Operand := ''; If OTyp = 'ABS' Then Operand := TransWord(MemW[Seg(Buf^):Ofs(Buf^) + Addr + 1] And $1FFF); If OTyp = 'A.X' Then Operand := TransWord(MemW[Seg(Buf^):Ofs(Buf^) + Addr + 1] And $1FFF) + ',X'; If OTyp = 'A.Y' Then Operand := TransWord(MemW[Seg(Buf^):Ofs(Buf^) + Addr + 1] And $1FFF) + ',Y'; If OTyp = 'ASY' Then Operand := '(' + TransWord(MemW[Seg(Buf^):Ofs(Buf^) + Addr + 1] And $1FFF) + ',Y) & S'; If OTyp = 'IND' Then Operand := '(' + HexWord(MemW[Seg(Buf^):Ofs(Buf^) + Addr + 1] And $1FFF) + ')'; If OTyp = 'I.X' Then Operand := '(' + HexByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]) + ',X)'; If OTyp = 'I.Y' Then Operand := '(' + HexByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]) + '),Y'; If OTyp = 'ACC' Then Operand := 'A'; If OTyp = 'IMM' Then Operand := '#' + HexByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]); If OTyp = 'Z.P' Then Operand := TransByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]); If OTyp = 'Z.X' Then Operand := TransByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]) + ',X'; If OTyp = 'Z.Y' Then Operand := TransByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]) + ',Y'; If OTyp = 'I+A' Then Operand := '#' + HexByte(Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]) + ' + A'; If OTyp = 'REL' Then Begin B := Mem[Seg(Buf^):Ofs(Buf^) + Addr + 1]; Asm MOV BX,WORD PTR Addr ADD BX,2 MOV AL,BYTE PTR B CBW ADD BX,AX MOV WORD PTR J,BX End; { Asm } Operand := HexWord(J); End; If HiRes Then WriteSmOut(136,2 + I * 8,Operand,Color) Else WriteOut(136,2 + I * 8,Operand,Color); Inc(Addr,Bytes[Opcode]); End; { For I } { If Not MouseVisible Then ToggleMouseVisibility;} Ch := UpCase(ReadKey); If Ch = 'D' Then Begin HiRes := Not HiRes; If HiRes Then Set320By400Mode Else Set320By200Mode; Display; End; If Ch = 'S' Then Begin Opcode := Mem[Seg(Buf^):Ofs(Buf^) + PC]; NewStart := PC + Bytes[Opcode]; { OldByte := Mem[Seg(Buf^):Ofs(Buf^) + NewStart]; Mem[Seg(Buf^):Ofs(Buf^) + PC + Bytes[Opcode]] := $FF;} End; If Ch = 'H' Then Begin Opcode := Mem[Seg(Buf^):Ofs(Buf^) + TopAddr]; NewStart := TopAddr; { OldByte := Mem[Seg(Buf^):Ofs(Buf^) + NewStart]; Mem[Seg(Buf^):Ofs(Buf^) + TopAddr] := $FF;} End; If Ch = 'G' Then NewStart := 0; If Ch = 'T' Then Begin Opcode := Mem[Seg(Buf^):Ofs(Buf^) + PC]; OTyp := ATyp[Opcode]; If Mnem[Opcode] = 'JSR' Then Begin NewStart := MemW[Seg(Buf^):Ofs(Buf^) + PC + 1] And $1FFF; End Else If Mnem[Opcode] = 'JMP' Then Begin If OTyp = 'ABS' Then NewStart := MemW[Seg(Buf^):Ofs(Buf^) + PC + 1] And $1FFF Else NewStart := MemW[Seg(Buf^):Ofs(Buf^) + MemW[Seg(Buf^):Ofs(Buf^) + PC + 1] And $1FFF] And $1FFF; End Else If Mnem[Opcode] = 'BPL' Then Begin If (P And $80) = 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BMI' Then Begin If (P And $80) <> 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BVC' Then Begin If (P And $40) = 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BVS' Then Begin If (P And $40) <> 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BCC' Then Begin If (P And 1) = 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BCS' Then Begin If (P And 1) <> 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BNE' Then Begin If (P And 2) = 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'BEQ' Then Begin If (P And 2) <> 0 Then NewStart := PC + ShortInt(Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + 2) Else NewStart := PC + Bytes[Opcode]; End Else If Mnem[Opcode] = 'RTS' Then NewStart := (MemW[Seg(Buf^):Ofs(Buf^) + S + 1] + 1) And $1FFF Else If Mnem[Opcode] = 'BRK' Then NewStart := MemW[Seg(Buf^):Ofs(Buf^) + $1FFE] And $1FFF Else If Mnem[Opcode] = 'RTI' Then NewStart := MemW[Seg(Buf^):Ofs(Buf^) + S + 2] And $1FFF Else NewStart := PC + Bytes[Opcode]; (* { Check to see if the intervening instruction does any bank switching } AccSize := 1; Access := 0; If OTyp = 'ABS' Then Begin If Mnem[Opcode] <> 'JSR' Then Access := MemW[Seg(Buf^):Ofs(Buf^) + PC + 1] Else Begin Access := S + $100 - 1; AccSize := 2; End; End Else If OTyp = 'A.X' Then Access := MemW[Seg(Buf^):Ofs(Buf^) + PC + 1] + X Else If OTyp = 'A.Y' Then Access := MemW[Seg(Buf^):Ofs(Buf^) + PC + 1] + Y Else If OTyp = 'Z.P' Then Access := Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] Else If OTyp = 'Z.X' Then Access := Mem[Seg(Buf^):Ofs(Buf^) + PC + 1] + X Else If OTyp = 'IND' Then Access := MemW[Seg(Buf^):Ofs(Buf^) + MemW[Seg(Buf^):Ofs(Buf^) + PC + 1]] Else If OTyp = 'I.X' Then Access := MemW[Seg(Buf^):Ofs(Buf^) + MemW[Seg(Buf^):Ofs(Buf^) + PC + 1 + X]] Else If OTyp = 'I.Y' Then Access := MemW[Seg(Buf^):Ofs(Buf^) + MemW[Seg(Buf^):Ofs(Buf^) + PC + 1]] + Y Else Begin If Mnem[Opcode] = 'RTS' Then Begin Access := S + $101; AccSize := 2; End Else If Copy(Mnem[Opcode],1,2) = 'PH' Then Access := S + $100 Else If Copy(Mnem[Opcode],1,2) = 'PL' Then Access := S + $101 Else If Mnem[Opcode] = 'BRK' Then Begin Access := S + $100 - 2; AccSize := 3; End Else If Mnem[Opcode] = 'RTI' Then Begin Access := S + $100; AccSize := 3; End Else Begin Access := 0; AccSize := 0; End; End; Access := Access And $1FFF; Switch := False; While (AccSize > 0) And Not Switch Do Begin If Not (BS^[Access + AccSize - 1] In [0,$30]) Then Switch := True Else Dec(AccSize); End; { While } If Switch Then Begin I := BS^[Access + AccSize - 1]; Case I Of 1..16: Begin WriteSmOut(0,0,'NewStart=' + HexWord(NewStart) + 'h',TextColor + (ScrDatColor Shl 8)); WriteSmOut(0,8,'Dest=' + HexWord((I - 1) * 1024 + NewStart - $1000),TextColor + (ScrDatColor Shl 8)); ReadKey; OldByte := Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + (I - 1) * 1024 + NewStart - $1000]; Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + (I - 1) * 1024 + NewStart - $1000] := $FF; End; 17,21: Begin OldByte := Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + ((I Xor 4) - 17) * 1024 + NewStart - $1000]; Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + ((I Xor 4) - 17) * 1024 + NewStart - $1000] := $FF; End; 33..41: Begin OldByte := Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + (I - 33) * 1024 + NewStart - $1000]; Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + (I - 33) * 1024 + NewStart - $1000] := $FF; End; $D0..$D7: Begin If NewStart < $1800 Then Begin I := I And 7; If I = 7 Then Inc(I); OldByte := Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + I * 2048 + NewStart - $1000]; Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + I * 2048 + NewStart - $1000] := $FF; End; End; $E0..$F7: Begin If (((I And $18) Shl 15) + $1000) = (NewStart And $1C00) Then Begin OldByte := Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + (I And 7) * 1024 + NewStart - $1000]; Mem[Seg(ROMBackup^):Ofs(ROMBackup^) + (I And 7) * 1024 + NewStart - $1000] := $FF; End; End; End; { Case } End Else Begin OldByte := Mem[Seg(Buf^):Ofs(Buf^) + NewStart]; Mem[Seg(Buf^):Ofs(Buf^) + NewStart] := $FF; End; *) End; If Ch = ' ' Then Begin FlipWindow; Display; End; If Ch = #0 Then Begin Ch := ReadKey; Case Ch Of #59: Begin { F1 } Temp := HiRes; If HiRes Then Set320By200Mode; HiRes := False; __DispWin(HelpWin); Color := TextColor + (DataColor Shl 8); WriteOut(0,0, 'F1 - Help',Color); WriteOut(0,8, 'D - Toggle 320x400 mode',Color); WriteOut(0,16, 'G - Begin execution of code',Color); WriteOut(0,24, 'H - Execute to hilighted position',Color); WriteOut(0,32, 'S - Execute over next instruction',Color); WriteOut(0,40, 'T - Execute next instruction',Color); WriteOut(0,48, ' - Toggle game screen display',Color); WriteOut(0,152,' - Move up one byte',Color); WriteOut(0,160,' - Move down one instruction',Color); WriteOut(0,168,' - Move down one screen',Color); WriteOut(0,176,' - Move to 1000h',Color); WriteOut(0,184,' - Move to 1FFFh',Color); WriteOut(0,192,' - Move to current instruction',Color); ReadKey; __RemWin; HiRes := Temp; If HiRes Then Set320By400Mode; Display; End; #71: TopAddr := $1000; { Home } #72: Begin { Up } If TopAddr > 0 Then Dec(TopAddr); End; #79: TopAddr := $1FFF; { End } #80: Begin { Down } Opcode := Mem[Seg(Buf^):Ofs(Buf^) + TopAddr]; Inc(TopAddr,Bytes[Opcode]); End; #81: TopAddr := Addr; { PgDn } #82: TopAddr := PC; { Insert } End; { Case } Ch := #0; End; Until Ch In [#27,'S','T','H','G']; { For I := 0 To 127 Do Line(I,198,I,199,I * 2);} While Keypressed Do ReadKey; If HiRes Then Set320By200Mode; __RemWin; Debug := (Ch In ['S','T','H','G']); End; { Debug } Begin Win := Nil; HelpWin := Nil; _WindowList := Nil; _ListWork := Nil; OldExitProc := ExitProc; ExitProc := @NewExitProc; GetMem(FontSmPtr,SmFontSize); LoadSmallFont; __MakeWin(Win,0,0,319,199,BackColor); __MakeWin(HelpWin,0,0,319,199,DataColor); End.