LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)O^[W.PEEK.POKE.TEXT (Ф Ϥ&PRT.OPS.CODE`Ф >,PRT.OPS.TEXTY Ф Ф$+SEARCH.TEXT)P READ.ME.FIRSTMJ*DISKNAME.DAT!J+J+ Ф Ϥ8,OPCODES.6502> MAKE.OPS.CODEI Ф >-MAKE.OPS.TEXT< Ф8Ф6OPCODE.LISTO Ф >OPCODES.6502Ф >PEEK.POKE.CODE Ф >III.REP.10S.09Bu' ,CREATE1.TEXT1`>H4+DISASM.TEXTc#D>ڤ*HELLO.TEXT >,CREATE2.TEXT8>H)+OPCODE.LIST >Ф,HEXUNIT.TEXT% >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L  !"#-./0123456789:HIJKLMNOPQRSTUVW_`a BEQ SPECIAL ; "true" 00 and 01 pages CMP #80 BMI SYSTEM ;80-8F=extended addressing CMP #90 ; els LDA ADDRESS+1601 ;save original x-byte value STA OLDXBT ;which bank is desired LDA XBYTE CMP #0FF ;FF = ROM #1, C0-CF = I/O, BEGIN POP RETURN PLA ;"dummy" bytes for function PLA PLA PLA POP XBYTE ;parameters come off in reverse order POP ADDRESS zeropage "pseudo" register BANKSW .EQU 0FFEF ZEROPG .EQU 0FFD0 ENVRMT .EQU 0FFDF .FUNC PEEK,2 JMP BEGIN RETURN .WORD 0 XBYTE .WORD 0 RESULT .WORD 0 OLDXBT .BYTE 0 OLDZPG .BYTE 0 ENV .BYTE 0 .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .MACRO PUSH LDA %1+1 PHA LDA %1 PHA .ENDM ADDRESS .EQU 0E8 ; O^եe system bank (ordinary 6502) BMI EXTEND ;handle system bank SYSTEM LDY #0 STY ADDRESS+1601 ;xbyte = 0 so get ordinary 6502 LDA @ADDRESS,Y ; indirect indexed addressing STA RESULT JMP DONE ;handle extended addressing to a bankpair or $8F EXTEND STA ADDRESS+1601 ;place extend byte LDY #0 LDA @ADDRESS,Y ;"extended" addressing to desired ; ZEROPG = FFD0 LDA ADDRESS CMP #0D0 ; in this program - suicide certain BEQ DONE ; in your program - suicide probable CMresses $1 LDA ADDRESS+1 ;POKE disallowed at (system bank): CMP #0FF ; BANKSW = FFEF BNE $2 ; ENVRMT = FFDF desired LDA XBYTE CMP #80 BMI $1 ;80-8F=extended addressing CMP #90 ; else system bank (ordinary 6502) BMI EXTEND ;disallow certain add STA OLDXBT LDA ENVRMT ;save ENVRMT STA OLDENV AND #0F7 ;for POKE, enable write C000 to FFFF STA ENVRMT ;which bank isENV .BYTE 0 BEGIN POP RETURN ;parameters come off in reverse order POP VALUE POP XBYTE POP ADDRESS LDA ADDRESS+1601 ;save original x-byte value PUSH RESULT PUSH RETURN RTS .PROC POKE,3 JMP BEGIN RETURN .WORD 0 XBYTE .WORD 0 VALUE .WORD 0 OLDXBT .BYTE 0 OLDZPG .BYTE 0 OLDENV .BYTE 0 ZPG ;restore ZEROPG (and stack page) STA ZEROPG PLP ;restore interrupts (status) DONE LDA OLDXBT ;restore Pascal's xbyte STA ADDRESS+1601 TYA ;is high byte 00 or 01 BEQ $1 LDA 0100,X ;indexed addressing (x = addr) JMP $2 $1 LDA 0000,X $2 STA RESULT LDA OLD LDY ADDRESS+1 LDA ZEROPG ;save old zpg STA OLDZPG LDA #0 ;changes zero-page to 0, stack to 1 STA ZEROPG ;(an "illegal" move) address on true 00 or 01 page TRUEPGS PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDX ADDRESS ;load BEFORE leaving old z-page @ADDRESS,Y STA RESULT LDA ENV ;restore ENVRMT STA ENVRMT PLP ;restore status (including interrupts) JMP DONE ;desired ent STA ENV LDA #73 ;#% 0111 0011 - new environment reg STA ENVRMT ;(an "illegal" move) LDY #0 STY ADDRESS+1601 ;system bank xbyte = 00 LDA ;ROM#1 --> F000-FFFF, C000-CFFF --> I/O PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDA ENVRMT ;save environm STA RESULT ; bank pair JMP DONE ;handle artifical bank 'FF' SPECIAL LDA ADDRESS+1 BEQ TRUEPGS ;true $00, $01 desired? CMP #1 BEQ TRUEPGS P #0DF BEQ DONE ;if you really want to crash, just start CMP #0EF ; POKing into SOS (RAM $B800 - FFFF) BEQ DONE ; soon he will get very sick ;detect artificial bank 'FF' $2 LDA XBYTE CMP #0FF ;FF = ROM #1, C0-CF = I/O BEQ SPECIAL ; "true" 00 and 01 pages {Program Create_Source: Part 1 of 2 10/08/85 File Length: 22,600 Written By ROB TURNER. This Program will take a disassembled ascii file created by Dr. John Jeppson's Disassembler and convert it into reassemblable format. The user should knowDDRESS+1601 LDA OLDENV ;restore C0-CF read/write status STA ENVRMT PUSH RETURN RTS .END $2 LDA OLDZPG ;restore ZEROPG (and stack page) STA ZEROPG PLP ;restore interrupts (status) DONE LDA OLDXBT ;restore Pascal's xbyte STA A CPY #0 ;is high byte 00 or 01 BEQ $1 STA 0100,X ;indexed addressing (x = addr) JMP $2 $1 STA 0000,X LDA ZEROPG ;save old zpg STA OLDZPG LDA #0 ;changes zero page to 0, stack to 1 STA ZEROPG ;(an "illegal" move) LDA VALUE or 01 page TRUEPGS PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDX ADDRESS ;load BEFORE leaving old z-page LDY ADDRESS+1 STA @ADDRESS,Y LDA ENV ;restore ENVRMT STA ENVRMT PLP ;restore status (including interrupts) JMP DONE ;desired address on true 00 V LDA #73 ;#% 0111 0011 - new environment reg STA ENVRMT ;(an "illegal" move) LDY #0 STY ADDRESS+1601 ;system bank xbyte = 00 LDA VALUE ;ROM#1 --> F000-FFFF, C000-CFFF --> I/O PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDA ENVRMT ;save environment STA EN ; bank pair JMP DONE ;handle artifical bank 'FF' SPECIAL LDA ADDRESS+1 BEQ TRUEPGS ;true zp or $01 desired? CMP #1 BEQ TRUEPGS ;handle extended addressing to a bankpair or $8F EXTEND STA ADDRESS+1601 ;place extend byte LDY #0 LDA VALUE STA @ADDRESS,Y ;"extended" addressing to desired ;handle system bank SYSTEM LDY #0 STY ADDRESS+1601 ;xbyte = 0 so get ordinary 6502 LDA VALUE ; indirect indexed addressing STA @ADDRESS,Y JMP DONE certain limitations, so they are listed below. Limitations: 1) The file should be less the 30K. This means a disassembly sould be broken up into smaller files. If the file is larger then 29K then Strange things happen. I'm sure that this is an oversite of mine. 2) The First line of code is not acted on!! 3) When writing to disk the remainder of the last block contains zeros users should delete with an editor. A unit hexstuff; intrinsic code 40;   interface  type $varindex = 1..5; $variant = record case varindex of /1 : (int : integer); /2 : (byte : packed array [0..1] of 0..255); /3 : (nybl : packed array [0..3] of 0..15); - 4 : (bit : packed arra$&'()*+,2 E W % O^has to be added with a text editor. (Note that the file has to be saved as a ASCII file not a TEXT file) 10) A Complete Listing of what is taking place will be generated to a user defined output file. (Normally .CON 8) Addresses that have not been referenced are removed from the file. 9) All lines of code that begin with a '/' will not be processed by the program. So the user can mask data off from the code. This marker e that this is a very very slow section of code, so he should not think the system is hung. If they want they can change this section of code. I didn't bother. n-numeric with a leading zero. e.g. 'LDA #FF' Will become 'LDA #0FF' and 'LDA @E0,Y' Will become 'LDA @0E0,Y' 7) All comments & asterics will be removed from the file. The user should be awar 5) If an address is outside of the User specified range then the user will be notified and asked to investigate. 6) All address or address modes that begin with a non-numeric will converted to a no 2A) SOS Address will also be converted to labels. Address like FFEF will become BankReg etc. 3) All Branch instructions will Converted to lables. 4) Al~R5P & JSR instructions will be converted to labels dvantages: 1) User does not have to manually remove addresses and comment statements from a disassembled file. 2) SOS JSR are converted to the correct labels, e.g. 'JSR 191F' will become 'JSR QueEvent' y [0..15] of boolean); /5 : (bool : boolean); -end;  procedure screen (a, b, c, d, e : integer); function ten (str : string) : integer; procedure hex4 (value : integer; var str : string); procedure hex2 (value : integer; var str : string); function hibyte (int : integer) : integer; function lobyte (int : integer) : integer;  function peek (bytenumber, bank : integer) : integer; procedure poke (bytenumber, bank, value : integer);  implementation $ procedure screen; (* (a, b, c, d, e : integer) *) ======================================================= } PROGRAM Create_Source; CONST Sysenvreg = '0FFDF'; Zeropage = '0FFD0'; Sysbankreg = '0FFEF'; Getsir = '1913'; Givesir = '1916'; Groves this program I sure would like to get the updated version. ;You can reach me at On Three (805) 644-3514 and if not there you can reach ;me at 3101 Peninsula Rd #208 Oxnard Ca. 93030 (805) 984-1246. ;THANKS Rob Turner (author) ;======================= generate labels. For example if the user enters an 'x' then the branch instruction 'BNE -> FEFF' Will become 'BNE xxxFFEF'. ;============================================================================== ;If ANYONE imp file name. 13) Documentation of two undocumented 1900 page SOS Calls Via a JSR. These are Enable Reset & Disable Reset. 14) User has the option to determine what character will be used to SOLE) 11) The User is given the option to list file before saving it to disk. (Find the BUG) 12) The user can save the file with the same name as the input file or can save the file to disk with a new* (bytenumber, bank, value : integer) *) $external; end. (* unit *)  ibyte := v.byte [1]; $end;   function lobyte; (* (int : integer) : integer *) $var (v : variant; $begin (v.int := int; (lobyte := v.byte [0]; $end;  function peek; (* (bytenumber, bank : integer) : integer *) $external;  procedure poke; ((h := '0123456789ABCDEF'; (v.int := value; (str := '00'; (for count := 0 to 1 do 0str [count + 1] := h [v.nybl [1 - count] + 1]; $end; (* hex2 *) $ function hibyte; (* (int : integer) : integer *) $var (v : variant; $begin (v.int := int; (halue; (str := '0000'; (for count := 0 to 3 do 0str [count + 1] := h [v.nybl [3 - count] + 1]; $end; (* hex4 *) $ procedure hex2; (* (value : integer; var str : string) *) $var (count : integer; (h : string; (v : variant; $begin unt + 1; ,end; (if valid then ten := v.int 1else ten := 0; $end; (* function ten *) 9  procedure hex4; (* (value : integer; var str : string) *) $var (count : integer; (h : string; (v : variant; $begin (h := '0123456789ABCDEF'; (v.int := vnd (count < 4)) do ,begin $ p := pos (copy (str, length (str), 1), h1); 0if p = 0 then p := pos (copy (str, length (str), 1), h2); 0if p = 0 then valid := false 9else v.nybl [count] := p - 1; 0delete (str, length (str), 1); 0count := cofunction ten; (* (str : string) : integer *) $const (h1 = '0123456789ABCDEF'; (h2 = '0123456789abcdef'; $var (p, count : integer; (v : variant; (valid : boolean; $begin (v.int := 0; (count := 0; (valid := true; (while ((length (str) > 0) a$var control : packed array [0..4] of char; $begin (control [0] := chr (a); (control [1] := chr (b); (control [2] := chr (c); (control [3] := chr (d); (control [4] := chr (e); (unitwrite (1, control, 5, , 12); $end; (* screen *)  etc800 = '1922'; Syserr = '1928'; Queevent = '191F'; Sysdefeatreset = '1919'; Sysenablereset = '191C'; Sysfailure = '1925'; VAR Buffer: PACKED ARRAY [1..30000] OF Char; Hold_Address: PACKED ARRAY [0..500] OF String[4]; Label_Char, Ch1, Ch: Char; Active_Entries, K, Number_Of_Blocks, X, Buf_Pointer: Integer; Firstnum, Secondnum, Thirdnum, Forthnum: 0..255; Full, Done, Special, Normal, Error: Bo PROCEDURE Replace(VAR Buf_Pointer: Integer; Result: String; Length: Integer; Add_String: String); VAR Count: Integer; BEGIN Writeln(Pr, 'Replacing -> ', Add_S THEN BEGIN REPEAT Buf_Pointer := Buf_Pointer + 1; Return := Buffer[Buf_Pointer] UNTIL Return = Chr(13); Skip_Line_Test(Buf_Pointer) END END; PROCEDURE Skip_Line_Test(VAR Buf_Pointer: Integer); VAR Return, Loc_Ch, Loc_Ch1: Char; BEGIN Loc_Ch := Buffer[Buf_Pointer]; Loc_Ch1 := Buffer[Buf_Pointer + 1]; IF (Loc_Ch = Chr(13)) AND (Loc_Ch1 = '/')Writeln(Pr); Writeln(Pr, 'Total Number of Items That Were In The Table = ', Active_Entries); Active_Entries := 0; FOR Count := 0 TO 500 DO Hold_Address[Count] := ' ' END; Writeln(Pr); Writeln(Pr, 'Resetting Look up table - Previous Table Contents'); Writeln(Pr); FOR Count := 1 TO Active_Entries DO Writeln(Pr, 'Label From Look up Table -> xxx', Hold_Address[Count]); BEGIN Fillchar(Buffer, 30000, Chr(32)); Active_Entries := 0; FOR Count := 0 TO 500 DO Hold_Address[Count] := ' ' END; PROCEDURE Reset_Table; VAR Count: Integer; BEGIN Readln(Label_Char); IF Error <> True THEN Number_Of_Blocks := Blockread(F, Buffer, 60, 0); X := Number_Of_Blocks * 512 END; {end of procedure} PROCEDURE Initilize; VAR Count: Integer; "0000" -> '); Readln(Start_Address); Write( 'Please enter the ending address. (UPPERCASE) Example "4FA0" -> '); Readln(End_Address); Write( 'Please Enter the Label character. e.g. "x" for xxx30F0 --------> '); Close(F, Lock) END; Writeln; Writeln; Write('send listing where -> '); Readln(St); Rewrite(Pr, St); Writeln; Write( 'Please enter the starting address.(UPPERCASE) Example IF Length(St) = 0 THEN Exit(PROGRAM); {$iocheck-} Reset(F, St); IF Ioresult <> 0 THEN BEGIN Error := True; Write('Error Openning file look at file and try again'); Writeln('for future references.'); Writeln; Writeln('Press ', Chr(18), 'Return', Chr(17), ' to exit'); Writeln; Write('Please enter the file name to open '); Readln(St); Hold_Name := St; le must be an Ascii file NOT a Pascal Text file. The file'); Writeln( 'that has been read-in will be written out to a user designated File'); Writeln( 'Furthermore, a listing will be generated to a user defined device.'); Writeln('Facts on the SOURCE: By Rob Turner'); Writeln; Writeln('The SOURCE will skip ALL lines that Begin with "/"'); Writeln( 'The "/" must be placed in the file by an text editor. Also note that'); Writeln( 'the fiolean; F: FILE; Hold_Name, Start_Address, End_Address, St: String; Pr: Text; Low_Range, High_Range: String[4]; Last_Count: Integer; PROCEDURE Read_File; BEGIN Error := False; Write(Chr(28)); tring, ' with -> ', Result); Length := Length - 1; FOR Count := Buf_Pointer TO Buf_Pointer + Length DO BEGIN Buffer[Count] := Result[Count - (Buf_Pointer - 1)] END; END; PROCEDURE Fix_Known_Sos; VAR X, Local_Buf_Ptr: Integer; Temp_String: String; BEGIN Local_Buf_Ptr := Buf_Pointer + 35; Temp_String := '0FFFF'; FOR X := 1 TO 5 DO Temp_String[X] := Bufend;  var $oplist : packed array [0..255] of instruction; $buf : packed array [0..1023] of 0..255; $count, opcode : integer; $infile, outfile : file; $ats, immediates, twobytes : set of 0..255; $threebytes, plusXs, plusYs : set of 0..255; procedurest'; $atsign = '@'; $numsign = '#'; $blks = 9;  space3 = ' ';  space2 = ' ';  space1 = ' ';  space0 = '';  type $instruction = packed record 4mnemonic : string [3]; 4numbytes : 1..4; 4operand : string [10]; 2 program generate; $(* makes and stores on disk an array of all 6502 instructions )arranged in numerical order by opcode number. )EXECUTION TIME > 30 seconds (but seems like forever) *)  const $source = 'opcodes.6502';  dest = 'opcode.li;=>?@ABCDEFG2 W V B M "O^ Temp_Ch := Buffer[Buf_Pointer + 36]; CASE Temp_Ch OF '@': BEGIN Counter := Counter + 1; Temp_X := Ord(Buffer[Buf_Pointer + Buf_Pointer := Buf_Pointer + Off_Set; Ch := Buffer[Buf_Pointer]; Skip_Line_Test(Buf_Pointer); IF Ch = Chr(13) THEN BEGIN Off_Set := 58; I, K, Temp_X: Integer; BEGIN Counter := 0; Writeln(Pr); Writeln(Pr, 'Fixing @F0 Condition'); Buf_Pointer := 1; Off_Set := 1; REPEAT BEGIN BankReg', 07, Temp_String) ELSE IF Temp_String = Zeropage THEN Replace(Local_Buf_Ptr, 'ZeroPage', 8, Temp_String) END; PROCEDURE Fix_Nonnumeric; VAR Off_Set, Counter: Integer; Temp_Ch: Char; fer[Local_Buf_Ptr + X]; Local_Buf_Ptr := Local_Buf_Ptr + 1; IF Temp_String = Sysenvreg THEN Replace(Local_Buf_Ptr, 'EnvReg', 06, Temp_String) ELSE IF Temp_String = Sysbankreg THEN Replace(Local_Buf_Ptr, ' sets; $var (i : integer; $begin (ats := [108]; (for i := 0 to 15 do ats := ats + [i * 16 + 1]; (immediates := [160, 162, 192, 224]; (for i := 0 to 7 do immediates := immediates + [i * 32 + 9]; (immediates := immediates - [137]; (* $89 invalid *) (twobytes := [36, 132, 148, 164, 180, 196, 228] + immediates; (for i := 0 to 15 do 0twobytes := twobytes + [i * 16 + 1, i * 16 + 5, i * 16 + 6]; (threebytes := [32, 188]; (for i := 0 to 15 do ce1); $rewrite (outfile, dest); $count := blockwrite (outfile, oplist, blks); $close (outfile, lock);  end.   $oplist [0] . numbytes := 4; $oplist [0] . operand := 'sos.call'; $oplist [137] . mnemonic := '---'; $for opcode := 0 to 255 do (while length (oplist [opcode] . operand) < 10 do ,oplist [opcode] . operand @:= concat (oplist [opcode] . operand, spacase *) 8end; (* with begin *) 0end; (* for i *) (end; (* transfer *)  begin (* main *)  fillchar (buf, 1024, 0); $reset (infile, source); $count := blockread (infile, buf, 2);  close (infile); $sets; $operands; $transfer; pcode + 8 * j] . mnemonic := mnem; >9 : oplist [44] . mnemonic := mnem; =10 : for j := 4 to 28 do Fif j in [4, 12, 20, 28] then Hoplist [opcode + j] . mnemonic := mnem; =11 : for j := 1 to 2 do Doplist [opcode + j * 8] . mnemonic := mnem; 6 : oplist [108] . mnemonic := mnem; >7 : begin Foplist [opcode + 4] . mnemonic := mnem; Foplist [opcode + 12] . mnemonic := mnem; Bend; >8 : for j := 1 to 3 do Doplist [oBend; >4 : begin Fop.int := opcode; H(* clear bits 2, 3, 4 *) Fop.bool := op.bool and odd (227); Ffor j := 0 to 7 do Joplist [op.int + j * 4] . mnemonic h:= mnem; Bend; >5 : begin Foperand := 'A '; (* note space1 *) Fopcode := opcode - 4; ]; 4typecode := buf [ i * 12 + 58 ]; 4mnem := space3; 4for j := 1 to 3 do @mnem [j] := chr (buf [48 + i * 12 + j - 1]); 4with oplist [opcode] do 8begin 3 : begin Foperand := '-> disp'; Fnumbytes := 2; ype ,variant = record case boolean of 8false : (int : integer); 9true : (bool : boolean); 6end; $ var ,op : variant; ( i, j, opcode, typecode : integer; ,mnem : string; (begin ,for i := 0 to 55 do 0begin 4opcode := buf [ i * 12 + 56 f opcode in plusXs  buf *) (t 64) AND (Temp_X < 91) THEN BEGIN FOR I := 42 DOWNTO 37 DO Buffer[Buf_Pointer + I] := Buffer[ UNTIL (Buf_Pointer - 58 > X); Writeln(Pr, Counter, ' Comments removed from File') END; PROCEDURE Search_For_Asteric; VAR Ch5: Char; Counter: Integer; BEGIN Counter := 0; Wr ' '; Ch := Buffer[Buf_Pointer + 56]; IF Ch <> Chr(13) THEN Buffer[Buf_Pointer + 56] := ' ' END END END IF Ch <> Chr(13) THEN Buffer[Buf_Pointer + 54] := ' '; Ch := Buffer[Buf_Pointer + 55]; IF Ch <> Chr(13) THEN Buffer[Buf_Pointer + 55] :=' '; Ch := Buffer[Buf_Pointer + 53]; IF Ch <> Chr(13) THEN Buffer[Buf_Pointer + 53] := ' '; Ch := Buffer[Buf_Pointer + 54]; BEGIN Off_Set := 58; IF Buffer[Buf_Pointer + 52] = ';' THEN BEGIN Counter := Counter + 1; Buffer[Buf_Pointer + 52] := ; Off_Set := 1; REPEAT BEGIN Buf_Pointer := Buf_Pointer + Off_Set; Ch := Buffer[Buf_Pointer]; Skip_Line_Test(Buf_Pointer); IF Ch = Chr(13) THEN have been examined') END; PROCEDURE Search_Comments; VAR Off_Set, Counter: Integer; BEGIN Counter := 0; Writeln(Pr); Writeln(Pr, 'Removing all comment statments'); Buf_Pointer := 1 END END END {Case} END END UNTIL (Buf_Pointer - 58 > X); Writeln(Pr, Counter, ' "@" or "#" of FFD3 conditions Buffer[Buf_Pointer + I] := Buffer[ Buf_Pointer + I - 1]; Buffer[Buf_Pointer + 36] := '0'; Fix_Known_Sos AND (Temp_X < 71) AND (Buffer[Buf_Pointer + 37] <> ' ') THEN BEGIN Counter := Counter + 1; FOR I := 42 DOWNTO 36 DO Pointer + 37] := '0' END END OTHERWISE BEGIN Temp_X := Ord(Temp_Ch); IF (Temp_X > 64) BEGIN FOR I := 42 DOWNTO 37 DO Buffer[Buf_Pointer + I] := Buffer[ Buf_Pointer + I - 1]; Buffer[Buf_ BEGIN Counter := Counter + 1; Temp_X := Ord(Buffer[Buf_Pointer + 37]); IF (Temp_X > 64) AND (Temp_X < 91) THEN Buf_Pointer + I - 1]; Buffer[Buf_Pointer + 37] := '0' END END; '#': iteln(Pr); Writeln(Pr, 'Removing Asterics'); FOR Buf_Pointer := 1 TO X DO BEGIN Ch := Buffer[Buf_Pointer]; Skip_Line_Test(Buf_Pointer); IF (Ch = ':') THEN BEGIN Counter := Counter + 1; K := Buf_Pointer; REPEAT Ch1 := Buffer[K]; IF Buffer[K] <> '*' THEN Buffer[K] := ' '; BEGIN Flag := True; Done := True; Buffer[K + 1] := Label_Char; Buffer[K + 2] := Label_Char; BuffeFactor := 58; IF (Buffer[K + 1] = Chr(Firstnum)) AND (Buffer[K + 2] = Chr(Secondnum)) AND (Buffer[K + 3] = Chr(Thirdnum)) AND (Buffer[K + 4] = Chr(Forthnum)) THEN m); Plus_Factor := 1; REPEAT BEGIN K := K + Plus_Factor; Skip_Line_Test(K); Ch := Buffer[K]; IF Ch = Chr(13) THEN BEGIN Plus_hirdnum, Forthnum); IF Test = True THEN BEGIN Writeln(Pr, 'Label Already Adjusted'); Exit(Adjust_Address) END ELSE Flag1 := Yes_Found(Firstnum, Secondnum, Thirdnum, Forthnu PROCEDURE Adjust_Address; VAR K, Z, Plus_Factor: Integer; Ch: Char; Flag, Test, Flag1: Boolean; BEGIN Flag := False; K := 0; Done := False; Test := Found(Firstnum, Secondnum, TFirstnum)) AND (Buffer[Buf_Po + 5] = Chr(Secondnum)) AND (Buffer[Buf_Po + 6] = Chr(Thirdnum)) AND (Buffer[Buf_Po + 7] = Chr(Forthnum)) THEN Varify := True ELSE Varify := False END; stall_String, ' Failed Because Table Full'); Full := True; Yes_Found := False END END; FUNCTION Varify(Buf_Po: Integer): Boolean; BEGIN IF (Buffer[Buf_Po + 4] = Chr(; IF Active_Entries <= 500 THEN BEGIN Hold_Address[Active_Entries] := Install_String; Yes_Found := True END ELSE BEGIN Writeln(Pr, 'Attempt to Install ', In Install_String := ' '; Full := False; Active_Entries := Active_Entries + 1; Install_String[1] := Chr(A); Install_String[2] := Chr(B); Install_String[3] := Chr(C); Install_String[4] := Chr(D)Found := False; Count := Count + 1 UNTIL (Found_Local = True) OR ((Count - 1) = Active_Entries) END; FUNCTION Yes_Found(A, B, C, D: Integer): Boolean; VAR Install_String: String[4]; BEGIN tive_Entries THEN REPEAT IF Check_String = Hold_Address[Count] THEN BEGIN Found := True; Found_Local := True END ELSE N Check_String := ' '; Check_String[1] := Chr(First_Num); Check_String[2] := Chr(Second_Num); Check_String[3] := Chr(Third_Num); Check_String[4] := Chr(Forth_Num); Count := 0; IF Count <= Ac Writeln(Pr, Counter, ' Asterics removed from file'); Writeln(Pr) END; FUNCTION Found(A, B, C, D: Integer): Boolean; VAR Check_String: String[4]; Count: Integer; Found_Local: Boolean; BEGI IF Buffer[K] = '*' THEN Buffer[K] := ' '; K := K + 1 UNTIL Ch1 = '*' END END; r[K + 3] := Label_Char; Buffer[K + 4] := Chr(Firstnum); Buffer[K + 5] := Chr(Secondnum); Buffer[K + 6] := Chr(Thirdnum); Buffer[K + 7] := Chr(Forthn2 W V B M (O^um); Buffer[K + 8] := ':'; Write(Pr, 'To the ladel --> '); FOR Z := K + 1 TO K + 7 DO Write(Pr, Buffer[Z]); >Writeln(Pr) $write ('Output file? '); $readln (dest); $fillchar (oplist, 4608, 0); $reset (infile, source); $count := blockread (infile, oplist, blks);  close (infile); $print;  end. e1, mnemonic, Ispace1, numbytes, space2, operand);  '.console') and (dest <> '.silentype') 4then writeln (prtfile); ,end; (* for i *) $end; (* print *)  begin (* main *)  writeln; t; $var (hexstr : string; (prtfile : text; (i, j : integer; $begin (rewrite (prtfile, dest); (for i := 0 to 63 do ,begin 0for j := 0 to 3 do 4begin 8with oplist [i + j * 64] do  set disk := false %to compile for diskfile disassembler --> set disk := true *) (*$setc disk := false *)  const &filename = 'opcode.list'; (bdefghijklmnopqrstuvwxyz{|}~W Q E I 1 V 2 07<7"<O^; BEGIN Buf_Pointer := Buf_Pointer + Off_Set; Ch := Buffer[Buf_Pointer]; Skip_Line_Test(Buf_Pointer); IF Ch = Chr(13) THEN BEGIN Off_Set := 58; VAR Counter, Off_Set: Integer; BEGIN Counter := 0; Writeln(Pr); Writeln(Pr, 'Looking for Branch instructions'); Writeln(Pr, ); Buf_Pointer := 1; Off_Set := 1; REPEAT END UNTIL (Done = True) OR (K + Plus_Factor > X); IF Flag = False THEN BEGIN Writeln(Pr, 'No address found to convert to a label') END END; PROCEDURE Search_Jump_Address; $begin (screen (1, 26, 0, 1, 30); (* clear top 2 screen lines *) (screen (11, 30, 0, 0, 0); )(*$ifc disk *) (hex4 (0 + offset, hexstr); (write ('Valid: ', hexstr, '..'); (hex4 (last + offset, hexstr); (write (hexstr, space3); )(*$elsec *) (hex2 (xbyte, hexstr); (write ('XBYTE = ', hexstr, space3); )(*$endc *) (write (command); (if print then write ('[', prtfile, ']') 1else write ('[.console]'); (screen (4, 0, 0, 0, 0); (* return to main window *) $end; (* prtheader *) function getb5end (* if in hexset *) 0else quit := true (* if NOT in hexset *) ,else quit := true; (* if NOT (length >= 2) *) (until quit; $end; (* poking *) "(*$endc *)  procedure list20; $var (i, j, inbyte : integer; (byte : packed array [0..3] of, 2); 9tempbytenumber := tempbytenumber + 1; *(* next string char will be a space if more poking follows *) 9if length (instr) > 1 Athen if instr[1] = space1 Ithen delete (instr, 1, 1) Ielse quit := true Aelse quit := true; e; (delete (instr, 1, 1); (* delete the ":" *) (repeat (if length (instr) >= 2 ,then if (instr[1] in hexset) and (instr[2] in hexset) 0then begin 9value := ten (copy (instr, 1, 2)); 9poke (tempbytenumber, xbyte, value); 1 delete (instr, 1or (xbyte > ten ('8F')) ,then if xbyte <> ten ('FF') 0then xbyte := 0; (prtheader; $end; (* setxbyte *) procedure poking (tempbytenumber: integer); $var (quit : boolean; (value : integer; $begin (quit := fals(writeln ('00 --> system bank (ordinary 6502 addressing)'); (writeln (' (all other entries are considered = 00)'); (writeln; (write ('Enter (hex) Xbyte: '); (readln (inhex); (writeln; (xbyte := ten (inhex); (if (xbyte < ten ('80')) teln (' ALL RAM!! access 00 to FF of bank 0'); (writeln (' and RAM beneath VIA''s (FFD0 to FFEF)'); (writeln ('FF (fake) --> C0-CF = I/O, ROM#1, true pages 00 and 01'); nhex := '00'; (writeln; (writeln ('Xbyte Options:'); (writeln; (writeln ('8n (80..8E) --> Bank pair: n and n+1'); (writeln ('8F --> system bank with bank 0 switched in'); (writeln (' bank 0 occupies $2000 to 9FFF'); (wrie of valid "addresses" in buffer *) (writeln; (hex4 (int + last, hexstr2); (writeln ('Valid addresses: $', hexstr, ' to $', hexstr2); (startnum := int; %end; (* startnum *) "(*$elsec *)  procedure setxbyte; $var (inhex : string[2]; $begin (i$var (int : integer; (hexstr2 : string; $begin $ writeln; (write ('Assign starting $address (default = $0000): '); (readln (hexstr); (int := ten (hexstr); (hex4 (int, hexstr); (* to be sure hexstr is in 4-hexdigit form *) ( (* compute rang *) )fillchar (buf, buflength + 1, 0); )count := blockread (infile, buf, maxblks, firstblk); )writeln; )writeln ('blocks transferred = ', count); )last := count * 512 - 1; $ close (infile); $end; (* loadbuf *)  function startnum : integer; e, ' (p.171)'); )until errorcode = 0; ) (* input block number at which to begin load *) )writeln; )writeln ('Loads (upto) ', maxblks, ' blocks.'); )write ('Specify blocknumber at which to begin load: '); )readln (firstblk); ) (* transfer data:= (buflength + 1) div 512; )repeat .write ('Specify source file: '); .readln (source); .(*$iocheck- *) .reset (infile, source); .(*$iocheck+ *) .errorcode := ioresult; .if errorcode <> 0 then 3writeln (chr(7), 'I/O error: code #', Perrorcod procedure loadbuf; (* loads specified disk file into memory buffer *) $var (maxblks, firstblk, errorcode, count : integer; (infile : file; (source : string; $begin )screen (28, 26, 0, 5, 0); (* clear lower screen, position cursor *) )maxblks yte (address, xbyte : integer) : integer; $begin ( (*$ifc disk *) (getbyte := ord (buf[address]) ( (*$elsec *) (getbyte := peek (address, xbyte); ( (*$endc *) $end; (* function getbyte *) "(*$ifc disk *) integer; (hexbyte : packed array [0..3] of string[2]; (prtoperand, asciistring : string; $procedure loadvalues; (var ,temp : integer; (begin  with oplist[inbyte] do 0begin 4prtoperand := operand; 4asciistring := space4; 4temp := bytenumber; 4for j := 0 to numbytes - 1 do 8begin = last + 1 then bytenumber := 0; 1(*$endc *) ,end; (* for num begin *) (write (space2); (* print asciistring characters *) (if pri getbyte (bytenumber, xbyte); 0store[num] := inbyte; (* save for asciistring printout *) 0hex2 (inbyte, hexstr); 0write (hexstr, space1); 0if print then write (printer, hexstr, space1); 0if num = 7 then 5begin 9write (space1); ] of integer; (firstnum, num, inbyte : integer; $begin (firstnum := lobyte (bytenumber) mod 16; (hex4 (bytenumber + offset, hexstr); (write (hexstr, ':'); (if print then write (printer, hexstr, ':'); (for num := firstnum to 15 do ,begin 0inbyte :=umber + 1; )(*$ifc disk *) (if bytenumber >= last + 1 then bytenumber := 0; )(*$endc *) $ writeln; (if print then writeln (printer); $end; (* dumpone *)  procedure linedump; (* activated by 2nd , etc. *) $var (store : array [0..15(if ord (inbyte) in [32..127] (* print asciistring characters *) ,then begin 5write (chr (inbyte)); 5if print then write (printer, chr (inbyte)); 0 end ,else begin 5write ('.'); 5if print then write (printer, '.'); 1end; (bytenumber := bytente (hexstr, ':'); (if print then write (printer, hexstr, ':'); (inbyte := getbyte (bytenumber, xbyte); (hex2 (inbyte, hexstr); (write (hexstr, space6); (if print then write (printer, hexstr, space6); enumber := 0; 5(*$endc *) 0end; (* with oplist begin *) (end; (* for i := 1 to 20 begin *) end; (* list 20 *)  procedure dumpone; (* activated by *) $var (inbyte : integer; $begin (writeln; (hex4 (bytenumber + offset, hexstr); (wri i := 1 to 20 do (begin ,inbyte := getbyte (bytenumber, xbyte); ,with oplist[inbyte] do 0begin 4loadvalues; 4inoperand; 4printlisting; 4for j := 1 to numbytes do 8bytenumber := bytenumber + 1; 5(*$ifc disk *) 4if bytenumber >= last + 1 then bytFprtoperand, space7, asciistring); 4writeln (str); 4if print then writeln (printer, str); 0end; (* with oplist do begin *) (end; (* printlisting *)  begin (* main of list20 *) $writeln; $writeln; $if print then writeln (printer, chr(10)); $forber + offset, hexstr); 4str := concat (hexstr, ': '); 4for i := 0 to numbytes - 1 do 8str := concat (str, hexbyte[i], space1); 4while length (str) < 24 do 8str := concat (str, space1); 4str := concat (str, mnemonic, space4, 0 then 8begin  127 @then Cjumploc := bytenumber + 2 + byte[1] - 256 @else Cjumploc := bytenumber + 2 + byte[1];  0 then 8begin  0 then 8begin nt then write (printer, space2); (for num := firstnum to 15 do ,begin 0if store[num] in [32..127] 4then begin =write (chr (store[num])); =if print then write (printer, chr (store[num])); 9end 4else begin =write ('.'); =if print then write (printer, '.'); 9end; 0if num = 7 then begin Dwrite (space2); Dif print then write (printer, space2); @end; ,end; (* for *) (writeln; (if print then writeln (printer); $end; (* linedump *)  procedure pagedump; $var (store : array [0..15] of integ 1 do 0beg,getchar; ,case inchar of 0'Q' : begin 6if prtfile <> space0 then close (printer, lock); 6exit (program); 2end; 0'<' : complete := true; 0'>' : begin :complete := true; :valid := true; 6end; ('O','S','U' : write (chr (7)) .otherwise begin rwise begin 8write (inchar); 8mono[1] := inchar; 8instr := concat (instr, mono); 8done := false; 4end; *end; (* case *) $end; (* getfirst *)  procedure getmore; $var (complete : boolean; $begin (complete := false; (valid := false; (repeat ite (chr (7)); "(*$elsec *) ,'S' : setxbyte; "(*$endc *) ,'O' : toggle; ,'Q' : begin 6if prtfile <> space0 then close (printer, lock); 6exit (program); 2end; ,'<' : ; ,'>' : linedump; ,'P' : pagedump; ,'U' : userdefined; ,'L' : list20 *othe6end (* case ord (inchar) of *) 0 0else if inchar in (hexset + otherset) 8then ok := true 0else write (chr (7)); (until ok; $end; (* getchar *)  procedure getfirst; $begin (done := true; (getchar; (case inchar of "(*$ifc disk *) ,'S' : wr8, 31, 0, 0, 0); Idelete (instr, length (instr), 1); Eend @else begin Iinchar := '<'; Iok := true; Eend; 713 : begin @inchar := '>'; @ok := true;  0 (* backspace *) @then begin Iscreen (int := not print; 1end; (prtheader; $end; (* toggle *)  procedure userdefined; $begin (* for search routines, graphics setup, etc. *) $end; procedure getchar; $var (ok : boolean; $begin (ok := false; (repeat ,fillchar (inchar, 2, 0); ,uniprocedure toggle; $begin $ write (chr(7)); (print := not print; (if print and (prtfile = space0) ,then begin 5writeln; 5writeln; 5write ('Specify outfile: '); 5readln (prtfile); 5if prtfile <> space0 then rewrite (printer, prtfile) Gelse prite ('.'); Eif print then write (printer, '.'); Aend; 8if j = 7 then begin Jwrite (space2); Jif print then write (printer, space2); Fend; 4end; (* for j *) 0writeln; 0if print then writeln (printer); ,end; (* i *) $end; (* pagedump *) ce2); (* print asciistring characters *) 0if print then write (printer, space2); 0for j := 0 to 15 do 4begin 8if store[j] in [32..127] = last + 1 then bytenumber := 0; 9(*$endc *) 4end; (* for j *) 0write (spa0if print then write (printer, hexstr, ':'); 0for j := 0 to 15 do 4begin 8inbyte := getbyte (bytenumber, xbyte); 8store[j] := inbyte; (* save for asciistring printout *) 8hex2 (inbyte, hexstr); 8write (hexstr, space1); 8if print then write (printeer; (i, j, inbyte : integer; $begin (bytenumber := 256 * hibyte (bytenumber); (writeln; (writeln; (if print then writeln (printer, chr(10), chr(10)); (for i := 0 to 15 do ,begin 0hex4 (bytenumber + offset, hexstr); 0write (hexstr, ':'); in 4write (space1); 4int := int - 1; 0end; ,writeln ('^', chr (7)); (end; (* error *) $procedure setbyte; (var ,quit : boolean; (begin ,quit := false; ,repeat 0if length (instr) > p 4then 8begin 8 if instr[p + 1] in hexset @then p := p + 1 @else quit := true;  0 then 0begin 4bytenumber := ten (copy (instr, 1, p)) - offset; 4delete (instr, 1, p); 5(*$ifc disk *) 4if ((bytenumber < 0) or (bytenumber >W Q E I 1 V 2  UCGEGO^;,getfirst; ,if not done then getmore; ,if valid then analyze; (end; (* while *) end.    (loadbuf; (offset := startnum; )(*$endc *) $end; (* initialize *)  begin (* main *) $initialize; $while 1 = 1 do (begin ,writeln; ,unitclear (1); (* dump typeahead *) ,done := false; ,valid := false; ,instr := space0; ,prtheader; FF'); (mono := space1; (hexstr := '00'; (prtfile := space0; (print := false; )(*$ifc disk *) -(* load specified disk file into memory buffer . then assign starting "address" to buffer 3(used as offset from bytenumber) *) , filename); (blkcount := blockread (infile, oplist, 9); (close (infile); (hexset := ['0'..'9', 'A'..'F']; (otherset := ['L', 'O', 'P', 'Q', 'S', 'U', ':', space1]; (xbyte := 0; (bytenumber := 0; (offset := 0; (last := ten ('FFr (p); 5end; (* case *) ,end; (* if *) $end; (* analyze *) procedure initialize; $var (blkcount : integer; (infile : file; $begin (screen (26, 0, 2, 2, 0); (* viewport 0,2 to 80,24 *) (fillchar (oplist, sizeof (oplist), 0); (reset (infile0p := 0; (* an index to screen display of instr *) 0setbyte; 0p := p + 1; 0if length (instr) = 0 then dumpone 0else case instr[1] of 5(*$ifc not disk *) 7':' : poking (bytenumber); 5(*$endc *) 7'L' : list20; 7'P' : pagedump 7otherwise erro= last + 1)) 8then begin Abytenumber := 0; Awrite (chr (7)); =end; 5(*$endc *) 0end; (* if p > 0 *) (end; (* setbyte *) $begin (* main of analyze *) (if length (instr) <> 0 then ,begin  program disassembler; uses hexstuff;   (* compiler options: %to compile for memory disassembler --> set disk := false %to compile for diskfile disassembler --> set disk := true *)  (*$setc disk := false *)   const &filename = 'opcode.rtnum *)  "(*$elsec *)   procedure setxbyte; $var (inhex : string[2]; $begin (inhex := '00'; (writeln; (writeln ('Xbyte Options:'); (writeln; (writeln ('8n (80..8E) --> Bank pair: n and n+1'); (writeln ('8F --> system bank withex4 (int, hexstr); (* to be sure hexstr is in 4-hexdigit form *) ( (* compute range of valid "addresses" in buffer *) (writeln; (hex4 (int + limit, hexstr2); (writeln ('Valid addresses: $', hexstr, ' to $', hexstr2); (startnum := int; %end; (* sta)limit := count * 512 - 1; $end; (* loadbuf *)   function startnum : integer; $var (int : integer; (hexstr2 : string; $begin $ writeln; (write ('Assign starting $address (default = $0000): '); (readln (hexstr); (int := ten (hexstr); (h (decimal) to start load: '); )readln (firstblk); ) (* transfer data *) )fillchar (buf, buflength, 0); )count := blockread (infile, buf, maxblks, firstblk); )writeln; )writeln ('blocks transferred = ', count); $ close (infile); rrorcode <> 0 then 3writeln (chr(7), 'I/O error: code #', Perrorcode, ' (p.171)'); )until errorcode = 0; ) (* input block number at which to begin load *) )writeln; )writeln ('Loads (upto) ', maxblks, ' blocks.'); )write ('Specify block number, 26, 0, 5, 0); (* clear lower screen, position cursor *) )maxblks := (buflength + 1) div 512; )repeat .write ('Specify source file: '); .readln (source); .(*$iocheck- *) .reset (infile, source); .(*$iocheck+ *) .errorcode := ioresult; .if e( (*$endc *) $end; (* function getbyte *) " "(*$ifc disk *)   procedure loadbuf; (* loads specified disk file into memory buffer *) $var (count, maxblks, firstblk, errorcode : integer; (infile : file; (source : string; $begin )screen (28; (screen (4, 0, 0, 0, 0); (* return to main window *) $end; (* prtheader *)  function getbyte (address, xbyte : integer) : integer; $begin ( (*$ifc disk *) (getbyte := ord (buf[address]) ( (*$elsec *) (getbyte := peek (address, xbyte); ', hexstr, '..'); (hex4 (last + offset, hexstr); (write (hexstr, space3); )(*$elsec *) (hex2 (xbyte, hexstr); (write ('XBYTE = ', hexstr, space3); )(*$endc *) (write (command); (if print then write ('[', prtfile, ']') 1else write ('[.console]') )(*$elsec *) (command = 'et xbyte ser ist20

age uit ut '; )(*$endc *) $begin (screen (1, 26, 0, 1, 30); (* clear top 2 screen lines *) (screen (11, 30, 0, 0, 0); )(*$ifc disk *) (hex4 (0 + offset, hexstr); (write ('Valid: &xbyte, bytenumber, offset, first, last, len, limit, prtbyte : integer; '(*$ifc disk *) &buf : packed array [0..buflength] of 0..255; '(*$endc *)   procedure prtheader; $const )(*$ifc disk *) (command = 'ser ist20

age uit ut ';y [0..255] of instruction; &mono : string[1]; &instr : string[255]; &inchar : char; &printer : text; &target : packed array [1..100] of 0..255; &prtfile, hexstr : string; &hexset, otherset : set of char; &valid, done, print : boolean; (*$ifc disk *) &buflength = 12287; (* = 24 blks. Max length = 60 blks (30719 bytes) *) '(*$endc *)  type &instruction = packed record 7mnemonic : string[3]; 7numbytes : 1..4; 7operand : string[10]; 4end;   var &oplist : packed arralist'; (* supply pathname of opcodes file Dpreviously made and stored on disk *) &space8 = ' '; &space7 = ' '; &space6 = ' '; &space5 = ' '; &space4 = ' '; &space3 = ' '; &space2 = ' '; &space1 = ' '; &space0 = ''; ' bank 0 switched in'); (writeln (' bank 0 occupies $2000 to 9FFF'); (writeln (' ALL RAM!! access 00 to FF of bank 0'); (writeln (' and RAM beneath VIA''s (FFD0 to FFEF)'); (writeln ('FF (fake) --> C0-CF = I/O, ROM#1, true pages 00 and 01'); (writeln ('00 --> system bank (ordinary 6502 addressing)'); (writeln (' (all other entries are considered = 00)'); (writeln; (write ('Enter (hex) Xbyte: '); (read] do 4begin 8loadvalues; 8inoperand; 8printlisting; 8for j := 1 to numbytes do = limit + 1 then bytenumber := 0; 9(*$endc *) 4end; (* with oplist begin *) ,end; (* for i := 1 to 2 str); 0end; (* with oplist do begin *) (end; (* printlisting *) $begin (* main of list20 *) (writeln; (writeln; (if print then writeln (printer, chr(10)); (for i := 1 to 20 do ,begin 0inbyte := getbyte (bytenumber, xbyte); 0with oplist[inbyte8str := concat (str, hexbyte[i], space1); 4while length (str) < 18 do 8str := concat (str, space1); 4str := concat (str, '*', space8, mnemonic, space5, @prtoperand, space6, ';', space1, asciistring); 4writeln (str); 4if print then writeln (printer, (end; (* inoperand *) procedure printlisting; (var ,str : string; ,i : integer; (begin  with oplist[inbyte] do 0begin 4hex4 (bytenumber + offset, hexstr); 4str := concat (hexstr, ':', space1); 4for i := 0 to numbytes - 1 do Cjumploc := bytenumber + 2 + byte[1] - 256 @else Cjumploc := bytenumber + 2 + byte[1];  0 then 8begin  0 then 8begin  127 @then$procedure inoperand; (var ,site, jumploc : integer; (begin ,with oplist[inbyte] do 0begin 4site := pos ('PP', prtoperand); 4if site > 0 then 8begin = 128 then prtbyte := prtbyte - 128; = 2) *) (until quit; $end; (* poking *)  "(*$endc *)   procedur, 1, 2)); 9poke (tempbytenumber, xbyte, value); 1 delete (instr, 1, 2); 9tempbytenumber := tempbytenumber + 1; *(* next string char will be a space if more poking follows *) 9if length (instr) > 1 Athen if instr[1] = space1 (quit : boolean; (value : integer; $begin (quit := false; (delete (instr, 1, 1); (* delete the ":" *) (repeat (if length (instr) >= 2 ,then if (instr[1] in hexset) and (instr[2] in hexset) 0then begin 9value := ten (copy (instln (inhex); (writeln; (xbyte := ten (inhex); (if (xbyte < ten ('80')) or (xbyte > ten ('8F')) ,then if xbyte <> ten ('FF') 0then xbyte := 0; (prtheader; $end; (* setxbyte *)  procedure poking (tempbytenumber: integer); $var 0 begin *) $end; (* list 20 *)   procedure dumpone; (* activated by *) $var (inbyte : integer; $begin (writeln; (hex4 (bytenumber + offset, hexstr); (write (hexstr, ':'); (if print then write (printer, hexstr, ':'); (inbyte := getbyte (bytenumber, xbyte); (hex2 (inbyte, hexstr); (write (hexstr, space6); (if print then write (printer, hexstr, space6); ( *(* print asciistring characters *) (prtbyte := ord (inbyte); (if prtbyte >= 128 then prtbyte := prtbyte - 1 then rewrite (printer, prtfile) Gelse print := not print; 1end; (prtheader; $end; (* toggle *)   procedure userdefined; $var $ instr, hextwo, hexfour : string; (result, i, x : integer; $ $function morethan (i1, i2 : integer) : boolean; $ ,end; (* i *) $end; (* pagedump *)  procedure toggle; $begin $ write (chr(7)); (print := not print; (if print and (prtfile = space0) ,then begin 5writeln; 5writeln; 5write ('Specify outfile: '); 5readln (prtfile); 5if prtfile <> space0>then prtbyte := ord ('.'); 8write (chr (prtbyte)); 8if print then write (printer, chr (prtbyte)); 8if j = 7 then begin Jwrite (space2); Jif print then write (printer, space2); Fend; 4end; (* for j *) 0writeln; 0if print then writeln (printer); print asciistring characters *) 0if print then write (printer, space2); 0for j := 0 to 15 do 4begin 8prtbyte := store[j]; 8if prtbyte >= 128 then prtbyte := prtbyte - 128; 8if prtbyte in [0..31, 92] (* no ctrls, no "\" *) space1); 8if j = 7 then =begin Awrite (space1); Aif print then write (printer, space1); =end; 8bytenumber := bytenumber + 1; 9(*$ifc disk *) 8if bytenumber >= limit + 1 then bytenumber := 0; 9(*$endc *) 4end; (* for j *) 0write (space2); (* then write (printer, hexstr, ':'); 0for j := 0 to 15 do 4begin 8inbyte := getbyte (bytenumber, xbyte); 8store[j] := inbyte; (* save for asciistring printout *) 8hex2 (inbyte, hexstr); 8write (hexstr, space1); 8if print then write (printer, hexstr, (i, j, inbyte : integer; $begin (bytenumber := 256 * hibyte (bytenumber); (writeln; (writeln; (if print then writeln (printer, chr(10), chr(10)); (for i := 0 to 15 do ,begin 0hex4 (bytenumber + offset, hexstr); 0write (hexstr, ':'); 0if print 0if num = 7 then begin Dwrite (space2); Dif print then write (printer, space2); @end; ,end; (* for *) (writeln; (if print then writeln (printer); $end; (* linedump *)   procedure pagedump; $var (store : array [0..15] of integer; rstnum to 15 do ,begin 0prtbyte := store[num]; 0if prtbyte >= 128 then prtbyte := prtbyte - 128; 0if prtbyte in [0..31, 92] (* no ctrls, no "\" *) 6then prtbyte := ord ('.'); 0write (chr (prtbyte)); 0if print then write (printer, chr (prtbyte)); 0bytenumber := bytenumber + 1; 1(*$ifc disk *) 0if bytenumber >= limit + 1 then bytenumber := 0; 1(*$endc *) ,end; (* for num begin *) (write (space2); (* print asciistring characters *) (if print then write (printer, space2); (for num := fi0store[num] := inbyte; (* save for asciistring printout *) 0hex2 (inbyte, hexstr); 0write (hexstr, space1); 0if print then write (printer, hexstr, space1); 0if num = 7 then 5begin 9write (space1); 9if print then write (printer, space1); 5end; = lobyte (bytenumber) mod 16; (hex4 (bytenumber + offset, hexstr); (write (hexstr, ':'); (if print then write (printer, hexstr, ':'); (for num := firstnum to 15 do ,begin 0inbyte := getbyte (bytenumber, xbyte); := 0; )(*$endc *) $ writeln; (if print then writeln (printer); $end; (* dumpone *)   procedure linedump; (* activated by 2nd , etc. *) $var (store : array [0..15] of integer; (firstnum, num, inbyte : integer; $begin (firstnum :28; (if prtbyte in [0..31, 92] (* no ctrls, no "\" *) .then prtbyte := ord ('.'); (write (chr (prtbyte)); (if print then write (printer, chr (prtbyte)); ( (bytenumber := bytenumber + 1; )(*$ifc disk *) (if bytenumber >= limit + 1 then bytenumber var ,str1, str2 : string; (begin ,hex4 (i1, str1); ,hex4 (i2, str2); ,if str1 > str2 then morethan := true ;else morethan := false; (end; (* morethan *) $ $function search : integer; (var ,i, j, k : integer; ,looking, working : boolean; (begin ,writeln ('searching...'); ,looking := true; ,i := first; ,k := last; & (* must avoid having first (0000) = last (FFFF) + 1 = 0000 Por search won't start *) ,if ((i = 0) and (k = -1)) then k := -2; , ,while looking and (i <> k + 1) do 0bse; (repeat ,getchar; ,case inchar of 0'Q' : begin 6if prtfile <> space0 then close (printer, lock); 6exit (program); 2end; 0'<' : complete := true; 0'>' : begin :complete := true; :valid := true; 6end; ('O','S','U' : write (chr (7)) .otherwit20 *otherwise begin 8write (inchar); 8mono[1] := inchar; 8instr := concat (instr, mono); 8done := false; 4end; *end; (* case *) $end; (* getfirst *)   procedure getmore; $var (complete : boolean; $begin (complete := false; (valid := fal,'S' : write (chr (7)); "(*$elsec *) ,'S' : setxbyte; "(*$endc *) ,'O' : toggle; ,'Q' : begin 6if prtfile <> space0 then close (printer, lock); 6exit (program); 2end; ,'<' : ; ,'>' : linedump; ,'P' : pagedump; ,'U' : userdefined; ,'L' : lisd (* case ord (inchar) of *) 0 0else if inchar in (hexset + otherset) 8then ok := true 0else write (chr (7)); (until ok; $end; (* getchar *)   procedure getfirst; $begin (done := true; (getchar; (case inchar of "(*$ifc disk *) n begin Iscreen (8, 31, 0, 0, 0); Idelete (instr, length (instr), 1); Eend @else begin Iinchar := '<'; Iok := true; Eend; 713 : begin @inchar := '>'; @ok := true;  0 (* backspace *) @the,then writeln ('not found') ,else begin 5hex4 (result + offset, hexfour); 5writeln ('found at ', hexfour); 5first := result + 1; 1end; $end; {userdefined} 1 $ procedure getchar; $var (ok : boolean; $begin (ok := false; (repeat ,fillchar (ingin =write (' #', i, ': '); =readln (hextwo); =if length (hextwo) <> 0 Athen if hextwo [length (hextwo)] = chr (27) Ethen exit (userdefined); =target [i] := ten (hextwo); 9end; 1end; (result := search; (write (chr (7)); (if result = 0 length (in hexadecimal): '); (readln (instr); (if length (instr) <> 0 ,then if instr [length (instr)] = chr (27) 0then exit (userdefined); (if instr <> '' ,then begin 5len := ten (instr); 5fillchar (target, 100, 0); 5for i := 1 to len do 9betr)] = chr (27) 0then exit (userdefined); (if instr <> '' then last := ten (instr) - offset; ( (write ('TARGET (default = '); (for i := 1 to len do ,begin 0hex2 (target [i], hextwo); 0write (hextwo,' '); ,end; (writeln (')'); ( (write (' 0then exit (userdefined); (if instr <> '' then first := ten (instr) - offset; ( (hex4 (last + offset, hexfour); (write ('Enter ending location (default = $', hexfour, '): '); (readln (instr); (if length (instr) <> 0 ,then if instr [length (insn; (writeln; (writeln; (writeln ('Search utility'); ( (hex4 (first + offset, hexfour); (write ('Enter starting location (default = $', hexfour, '): '); (readln (instr); (if length (instr) <> 0 ,then if instr [length (instr)] = chr (27) ;  target [j]  len then looking := false; 4 4if looking then 8begin  1 do 0begin 4write (space1); 4int := int - 1; 0end; ,writeln ('^', chr (7)); (end; (* error *) $procedure setbyte; (var ,quit : boolean; (begin ,quit := false; ,repeat 0if length (instr) > p 4then 8begin 8 if instr[p + O^,done := false; ,valid := false; ,instr := space0; ,prtheader; ,getfirst; ,if not done then getmore; ,if valid then analyze; (end; (* while *) end.  tartnum; )(*$endc *) ( (fillchar (target, 100, 0); (len := 1; (first := 0; (last := limit; $end; (* initialize *)   begin (* main *) $initialize; $while 1 = 1 do (begin ,writeln; ,unitclear (1); (* dump typeahead *) (prtfile := space0; (print := false; (limit := ten ('FFFF'); ( )(*$ifc disk *) -(* load specified disk file into memory buffer . then assign starting "address" to buffer 3(used as offset from bytenumber) *) (loadbuf; (offset := s := blockread (infile, oplist, 9); (close (infile); (hexset := ['0'..'9', 'A'..'F']; (otherset := ['L', 'O', 'P', 'Q', 'S', 'U', ':', space1]; (xbyte := 0; (bytenumber := 0; (offset := 0; (mono := space1; (hexstr := '00'; ,end; (* if *) $end; (* analyze *)  procedure initialize; $var (blkcount : integer; (infile : file; $begin (screen (26, 0, 2, 2, 0); (* viewport 0,2 to 80,24 *) (fillchar (oplist, sizeof (oplist), 0); (reset (infile, filename); (blkcountreen display of instr *) 0setbyte; 0p := p + 1; 0if length (instr) = 0 then dumpone 0else case instr[1] of 5(*$ifc not disk *) 7':' : poking (bytenumber); 5(*$endc *) 7'L' : list20; 7'P' : pagedump 7otherwise error (p); 5end; (* case *) er < 0) or (bytenumber >= limit + 1)) 8then begin Abytenumber := 0; Awrite (chr (7)); =end; 5(*$endc *) 0end; (* if p > 0 *) (end; (* setbyte *) $begin (* main of analyze *) (if length (instr) <> 0 then ,begin 0p := 0; (* an index to sc1] in hexset @then p := p + 1 @else quit := true;  0 then 0begin 4bytenumber := ten (copy (instr, 1, p)) - offset; 4delete (instr, 1, p); 5(*$ifc disk *) 4if ((bytenumb JEPPSON DISASSEMBLER DATA FILES This side of disk 3REP-10 contains the source code files for the Jeppson Disassembler. It's presented for those interested in wanting to examine or tinker with Dr. Jeppson's work. For more information, see "Peeking at th8else setchain ('d.search'); $end; (* option *)  begin (* main *) $loadbuf; $write (chr (28)); $quit := false; $while not quit do begin :menu; :option; 6end; $write (chr (28));  end. $ $ ( ( (28)); Jexit (program); Fend; ,if inchar in ['1'..'3'] 0then write (inchar) 0else write (chr (7)); (until inchar in ['1'..'3']; ( (if inchar = '1' then instructions 8else quit := true; (if inchar = '2' then setchain ('m.search') , 22); (write ('Distributed by Softalk Publishing Inc., Sept. 1982'); $end; (* menu *)  procedure option; $begin (setchain (''); (gotoxy (18, 9); (write (chr (31)); (repeat ,read (keyboard, inchar); ,if ord (inchar) = 27 then begin Jwrite (chr ('APPLE /// DISASSEMBLER':46); (writeln; (writeln ('by John Jeppson':62); (gotoxy (0, 9); (writeln ('Select Option:'); (writeln; (writeln ('1. Instructions'); (writeln ('2. Memory Disassembler'); (writeln ('3. Disk File Disassembler'); (gotoxy (00 if ord (inchar) = 27 then exit (instructions) 4else if ord (inchar) = 32 then done := true 4else write (chr (7)); 0until done; ,end; (* for i *) $end; (* instructions *) ,  procedure menu; $begin (write (chr (28)); (gotoxy (0, 2); (writeln, requestcode); $end; (* putscreen *) $ procedure instructions; $var (i : integer; (done : boolean; (inchar : char; $begin (gotoxy (62, 23); (for i := 1 to 5 do ,begin 0putscreen (i); 0done := false; 0repeat 4read (keyboard, inchar); .1; 0request_num : 0..255; 0reserved : 0..63; -end; $begin $ statuslist := b[p]; (with requestcode do ,begin 0channel := 0; 0reserved := 0; 0stat_or_ctrl := 1; 0request_num := 18; ,end; (unitnumber := 1; (unitstatus (unitnumber, statuslistin (reset (infile, source); (count := blockread (infile, b, 20); (close (infile); $end; (  procedure putscreen (p : integer); $var (unitnumber : integer; (statuslist : buf; (requestcode : packed record * channel : 0..1; 0stat_or_ctrl : 0.program hello; uses chainstuff; const $source = 'hello.data';  type $buf = packed array [0..2047] of 0..255;  var $inchar : char; $quit : boolean; $b : packed array [1..5] of buf; $ procedure loadbuf; $var (count : integer; (infile : file; $bege ///" in the August, 1982 "Softalk Magazine" (available in the WAP office). JEPPSON DISASSEMBLER DATA FILES Adjust_Address; IF Done = False THEN BEGIN Writeln(Pr, 'Address ', Add_String, ' not present in this, But is Valid'); END END 3]; Replace(Buf_Pointer, Result, 7, Add_String); Firstnum := Ord(Add_String[1]); Secondnum := Ord(Add_String[2]); Thirdnum := Ord(Add_String[3]); Forthnum := Ord(Add_String[4]); ring <= End_Address) THEN BEGIN Result[1] := Label_Char; Result[2] := Label_Char; Result[3] := Label_Char; FOR Count := 4 TO 7 DO Result[Count] := Add_String[Count - R Add_String: String; Buf_Pointer: Integer); VAR Result: String; Count: Integer; BEGIN Result := ' '; Normal := True; IF (Add_String >= Start_Address) AND (Add_St Replace(Buf_Pointer, 'SysEnableReset', 14, Add_String) ELSE IF Add_String = Sysfailure THEN Replace(Buf_Pointer, 'SysFailure', 10, Add_String) ELSE Special := False END; PROCEDURE Do_Normal(VAAdd_String = Queevent THEN Replace(Buf_Pointer, 'QueEvent', 8, Add_String) ELSE IF Add_String = Sysdefeatreset THEN Replace(Buf_Pointer, 'SysDefeatReset', 14, Add_String) ELSE IF Add_String = Sysenablereset THEN er, 'SysDeAllocSIR', 13, Add_String) ELSE IF Add_String = Getc800 THEN Replace(Buf_Pointer, 'SelC800', 7, Add_String) ELSE IF Add_String = Syserr THEN Replace(Buf_Pointer, 'SysErr', 6, Add_String) ELSE IF Buf_Pointer: Integer); BEGIN Special := True; IF Add_String = Getsir THEN Replace(Buf_Pointer, 'SysAllocSIR', 11, Add_String) ELSE IF Add_String = Givesir THEN Replace(Buf_Point END END END UNTIL (Buf_Pointer - 58 > X); Writeln(Pr, Counter, ' branches found have been adjusted'); Writeln END; PROCEDURE Do_Special(VAR Add_String: String; address from --> '); Writeln(Pr, Chr(Firstnum), Chr(Secondnum), Chr(Thirdnum), Chr(Forthnum)); Counter := Counter + 1; Adjust_Address Secondnum := Ord(Buffer[Buf_Pointer + 40]); Thirdnum := Ord(Buffer[Buf_Pointer + 41]); Forthnum := Ord(Buffer[Buf_Pointer + 42]); Write(Pr, 'Converting branch Buffer[Buf_Pointer + 36] := Label_Char; Buffer[Buf_Pointer + 37] := Label_Char; Buffer[Buf_Pointer + 38] := Label_Char; Firstnum := Ord(Buffer[Buf_Pointer + 39]); Ch := Buffer[Buf_Pointer + 36]; Ch1 := Buffer[Buf_Pointer + 37]; IF (Ch = '-') AND (Ch1 = '>') THEN BEGIN {replaces '-> 3f00' with 'xxx3F00'} ELSE Normal := False END; {$INCLUDE create2.text} + 36); IF Special = False THEN Do_Normal(Add_String, Buf_Pointer + 36); IF (Special = False) AND (Normal = False) THEN FOR Count := 1 TO 4 DO Add_String[Count] := Buffer[Buf_Pointer + 35 + Count]; Do_Special(Add_String, Buf_Pointer Op_Code[Count] := Buffer[Buf_Pointer + 27 + Count]; IF (Op_Code = 'JSR') OR (Op_Code = 'JMP') THEN BEGIN IF Buf_Pointer + 27 < X THEN BEGIN Op_Code := ' '; Add_String := ' '; FOR Count := 1 TO 3 DO BEGIN Buf_Pointer := Buf_Pointer + Off_Set; Ch := Buffer[Buf_Pointer]; Skip_Line_Test(Buf_Pointer); IF Ch = Chr(13) THEN BEGIN Off_Set := 58; ; Off_Set := 1; Writeln(Pr); Writeln(Pr, 'Beginning Routine to Adjust the JSR and JMP Instructions'); Writeln(Pr, 'Routine Replaces SOS Addresses with SOS Names'); Writeln(Pr); REPEAT {Program Create_Source: Part 2 of 2 10/08/85 File Length: 12,900} PROCEDURE Fix_Jmp_Jsr; VAR Op_Code: String[3]; Add_String: String; Xbuf_Pointer, Off_Set, Count: Integer; BEGIN Buf_Pointer := 1O^~1 BEGIN Write(Pr, 'Address ', Add_String, ' is an '); Writeln(Pr, 'invalid address ** INVESTIGATE **') END END END END END UNTIL (Buf_Pointer - 58 > X) END; PROCEDURE Clean_Up_And_Go_Home; VAR Buf_P END END; X := Blockwrite(K, Buffer, Number_Of_Blocks, 0); Close(K, Lock); Writeln('All Done Boss ', X, ' blocks written back out'); Exit(PROGRAM) BEGIN Write('Press return and lets try again'); Read(Ch); Write_File; Exit(Write_File) END Writeln('Rewrite caused error #', Result); Writeln( 'I could not create or use the file named -> ', New_Name); {$iocheck-} Close(K, Lock); Rewrite(K, New_Name); {try to create the file} Result := Ioresult; {$iocheck+} IF Result <> 0 THEN BEGIN en if create failed} Result := Ioresult; {$iocheck+} IF Result <> 0 THEN BEGIN Writeln('Reset caused error #', Result); {$iocheck-} RWRITE the old file'); Writeln; Write('Enter File name or press Return -> '); Readln(New_Name); IF Length(New_Name) <> 0 THEN BEGIN {$iocheck-} Reset(K, New_Name); {Try to reop 'You now have the option to save the file under a new name'); Writeln; Writeln('By doing this you will not OVERWRITE the file -> ', Hold_Name); Writeln; Writeln('Just press RETURN to OVE' Above addresses have been removed') END; PROCEDURE Write_File; VAR New_Name: String; Result: Integer; K: FILE; BEGIN New_Name := ''; Writeln(Chr(28), Buffer[Buf_Pointer + 3] := ' '; Buffer[Buf_Pointer + 4] := ' ' END END END UNTIL (Buf_Pointer - 58 >= X); Writeln(Pr); Writeln(Pr, Count2, Writeln(Pr); Count := 0 END; Buffer[Buf_Pointer + 1] := ' '; Buffer[Buf_Pointer + 2] := ' '; FOR Z := Buf_Pointer + 1 TO Buf_Pointer + 4 DO Write(Pr, Buffer[Z]); Write(Pr, ' '); IF Count = 16 THEN BEGIN Off_Set := 58; IF (Buffer[Buf_Pointer + 1] <> Label_Char) THEN BEGIN Count := Count + 1; Count2 := Count2 + 1; Off_Set := 1; REPEAT Buf_Pointer := Buf_Pointer + Off_Set; BEGIN Skip_Line_Test(Buf_Pointer); Ch := Buffer[Buf_Pointer]; IF Ch = Chr(13) THEN BEGIN ointer, Off_Set, Z, Count, Count2: Integer; Ch6: Char; BEGIN Count := 0; Count2 := 0; Writeln(Pr, 'Following addresses were not referenced so were removed'); Writeln(Pr); Buf_Pointer := 1; END; X := Blockwrite(F, Buffer, Number_Of_Blocks, 0); Close(F, Lock); Writeln('All Done Boss ', X, ' blocks written back out') END; PROCEDURE List_Option; VAR Count: Integer; BEGIN &Write('Do you wish to list the file before saving it Y)es or N)o -> '); Read(Ch); IF (Ch = 'Y') OR (Ch = 'y') THEN BEGIN Writeln; Write('send listing where -> '); Readln(St); JSR 2026 ; & 2013: A0 00 * LDY #00 ; . 2015: B1 E0 * LDA @E0,Y ; 1` 2017: 91 E2 * STA @E2,Y ; .b 2019: 8D EF FF * STA FFEF ; ; /2009: FF * --- ; /200A: FF * --- ; 200B: A9 FF * LDA #FF ; 200D: 8D DF FF * STA FFDF ; . 2010: 20 26 20 * 2000: 4C 0B 20 * JMP 200B ; L. 2003: 20 0B 20 * JSR 200B ; . /2006: FF * --- ; /2007: FF * --- ; /2008: FF * --- ==================== ;Disassembled File Using Dr. Jeppsons Disassmbler. Note the '/' characters that ;were added with the pascal text editor. ;============================================================================== RTS $01 LDA 0FFEF ;Load the Bacnk RTS Another_Local .EQU * JMP Local_JSR .END ;End of test Code ;==========================================================916 JSR 1922 JSR 1928 JSR 191F JSR 1919 JSR 191C JSR 1925 ;Thats alot of Do Nothing CLC ;Now Lets Try a Branch BCC $01 ROR A ;We are heving fun now STA 0FFD0 ;Zero Page Register JMP Another_Local ;Now Do a Bunch of JSR Local_JSR .EQU * JSR 1913 JSR 10 LDA @Zero1,Y ;Now test Zero Page Indexed STA @Zero2,Y ;Now test Zero Page Indexed STA 0FFEF ;This is the bank register LDA #Flag ROR A .EQU 0E2 Flag .EQU 0FF Data .Byte 0FF,0FF ;Data Byte .Byte 0FF,0FF,0FF Begin LDA #Flag STA 0FFDF ;This Code does Nothing JSR Local_JSR LDY #0========================== .ABSOLUTE .PROC Test .ORG 2000 ;User has to figure this out JMP Begin ;Not Bug Here is Source Program JSR Begin Zero1 .EQU 0E0 Zero2 END. { ===================== EXAMPLE PROGRAM BELOW ===================== ;============================================================================== SOURCE PROGRAM USED FOR THE EXAMPLE: ;====================================================d_File; Write(Chr(28)); Search_Jump_Address; Reset_Table; Fix_Jmp_Jsr; Search_Comments; Search_For_Asteric; Fix_Nonnumeric; Clean_Up_And_Go_Home; Reset_Table; List_Option; Write_File rite('Do you wish to save the File Y)es or N)o -> '); Read(Ch); IF (Ch = 'N') OR (Ch = 'n') THEN BEGIN Close(F, Lock); Exit(PROGRAM) END END; BEGIN Initilize; Rea {$iocheck-} Rewrite(Pr, St); {$iocheck+} Writeln(Pr); FOR Count := 1 TO X DO Write(Pr, Buffer[Count]) END; Writeln; Writeln; W. 201C: A9 FF * LDA #FF ; 201E: 6A * ROR A ; j 201F: 6A * ROR A ; j 2020: 8D D0 FF * STA FFD0 ; . 2023: 4C 46 20 * JMP 2046 ; LF 2026: 20 13 19 * JSR 1913 ; .. 2029: 20 16 19 * JSR 1916 ; .. 202C: 20 22 19 * JSR 1922 ; ". 202F: 20 28 19 * JS QQPP --- 2BPL -> disp 7ORA @PP,Y 2--- E--- T--- ORA PP,X 7ASL PP,X 3--- 7CLC IORA QQPP,Y --- --- --- BRK sos.call ORA @PP,X --- --- N--- ORA PP UASL PP O--- PHP ORA #PP FASL A 1--- I--- IORA QQPP /ASL CLC BCC xxx2042 RTS xxx2042 LDA BankReg RTS xxx2046 JMP xxx2026 } elC800 JSR SysErr JSR QueEvent JSR SysDefeatReset JSR SysEnableReset JSR SysFailure ROR A STA ZeroPage JMP xxx2046 xxx2026 JSR SysAllocSIR JSR SysDeAllocSIR JSR S LDY #00 LDA @0E0,Y STA @0E2,Y STA BankReg LDA #0FF ROR A ; /2009: FF * --- ; /200A: FF * --- ; xxx200B LDA #0FF STA EnvReg JSR xxx2026 ====== 2000 JMP 200B ; L. JSR xxx200B /2006: FF * --- ; /2007: FF * --- ; /2008: FF * --- ;not acted on. Also all lines that began with a '/' were not acted on. ;The user need only add the header info, equates and Change any line with ;a '/' to the correct .byte or .word ;======================================================================== ; ` 2046: 4C 26 20 * JMP 2026 ; L& ;============================================================================== ;Resulting code generated with 'SOURCE'. Again note that the first line was 203E: 18 * CLC ; . 203F: 90 01 * BCC -> 2042 ; .. 2041: 60 * RTS ; ` 2042: AD EF FF * LDA FFEF ; - 2045: 60 * RTS R 1928 ; (. 2032: 20 1F 19 * JSR 191F ; .. 2035: 20 19 19 * JSR 1919 ; .. 2038: 20 1C 19 * JSR 191C ; .. 203B: 20 25 19 * JSR 1925 ; %. ORA QQPP,X /ASL QQPP,X --- iJSR QQPP AND @PP,X --- --- /BIT PP AND PP LROL PP i--- PLP AAND #PP ROL A OCPX PP OSBC PP CINC PP --- INX SBC #PP iNOP --- OCPX QQPP /SBC QQPP INC QQPP --- BEQ -> disp SBC @PP,Y PP,X eDEC PP,X o--- vCLD ]CMP QQPP,Y I--- --- D--- OCMP QQPP,X DEC QQPP,X --- 4CPX #PP /SBC @PP,X --- C--- -- !INY CMP #PP DEX T--- SCPY QQPP /CMP QQPP DEC QQPP --- SBNE -> disp &CMP @PP,Y --- P--- --- rCMP LDA QQPP,Y TSX t--- LDY QQPP,X CLDA QQPP,X eLDX QQPP,Y --- CPY #PP CMP @PP,X --- ,--- PCPY PP _CMP PP /DEC PP O- O--- SLDY QQPP LDA QQPP LDX QQPP --- BCS -> disp LDA @PP,Y --- %--- 8LDY PP,X LDA PP,X iLDX PP,Y I--- CLV STA QQPP,X --- --- cLDY #PP SLDA @PP,X ALDX #PP %--- LDY PP LDA PP LDX PP --- TAY LDA #PP TAX  QQPP F--- LBCC -> disp PSTA @PP,Y E--- P--- ASTY PP,X bSTA PP,X KSTX PP,Y --- STYA LSTA QQPP,Y STXS P--- --- --- STA @PP,X --- --- STY PP SSTA PP RSTX PP 5--- FDEY O--- TXA R--- TSTY QQPP RSTA QQPP ESTX --- --- --- ADC PP,X ROR PP,X --- SEI SADC QQPP,Y --- --- --- .ADC QQPP,X ROR QQPP,X F--- R S--- IADC PP PROR PP --- PLA PADC #PP jROR A E--- JMP @QQPP ZADC QQPP ROR QQPP R--- FBVS -> disp .ADC @PP,Y PP PLSR PP --- 3CLI 7EOR QQPP,Y 3--- 7--- E--- OEOR QQPP,X 7LSR QQPP,X 6--- TRTS /ADC @PP,X S--- --- -- PHA LEOR #PP LSR A --- GJMP QQPP EOR QQPP LSR QQPP --- GBVC -> disp /EOR @PP,Y 7--- 2--- E--- TEOR AND QQPP,Y --- --- --- AND QQPP,X ROL QQPP,X c--- bRTI EOR @PP,X --- --- --- EOR PP LSR PP P- --- BIT QQPP AND QQPP mROL QQPP /--- BMI -> disp OAND @PP,Y --- --- --- AND PP,X ROL PP,X --- SEC D--- E--- --- SBC PP,X INC PP,X --- SED SBC QQPP,Y --- l--- --- SBC QQPP,X INC QQPP,X --- Y X A TXS TXA TSX TYA TAY TAX STY STX STA SEI xSED SEC 8SBC RTS `RTI @ROR jROL *PLP set, hexstr); write (hexstr, ':'); if print then write (printer, hexstr, ':'); for j := 0 to 15 do begin inbyte := getbyte (bytenumber, xbyte); inbyte : integer; begin bytenumber := 256 * hibyte (bytenumber); writeln; writeln; if print then writeln (printer, chr(10), chr(10)); for i := 0 to 15 do begin hex4 (bytenumber + offte (printer, space2); end; end; (* for *) writeln; if print then writeln (printer); end; (* linedump *) procedure pagedump; var store : array [0..15] of integer; i, j, write ('.'); if print then write (printer, '.'); end; if num = 7 then begin write (space2); if print then wri..127] then begin write (chr (store[num])); if print then write (printer, chr (store[num])); end else begin (*$endc *) end; (* for num begin *) write (space2); (* print asciistring characters *) if print then write (printer, space2); for num := firstnum to 15 do begin if store[num] in [32(space1); if print then write (printer, space1); end; bytenumber := bytenumber + 1; (*$ifc disk *) if bytenumber >= last + 1 then bytenumber := 0; sciistring printout *) hex2 (inbyte, hexstr); write (hexstr, space1); if print then write (printer, hexstr, space1); if num = 7 then begin write t, hexstr); write (hexstr, ':'); if print then write (printer, hexstr, ':'); for num := firstnum to 15 do begin inbyte := getbyte (bytenumber, xbyte); store[num] := inbyte; (* save for aCLV CLI XCLD CLC BVS pBVC PBRK BPL BNE BMI 0BIT $ BEQ BCS BCC ASL AND )ADC i (PLA hPHP PHA HORA NOP LSR JLDY LDX LDA JSR JMP LINY INX INC EOR IDEY DEX DEC CPY CPX CMP store[j] := inbyte; (* save for asciistring printout *) hex2 (inbyte, hexstr); write (hexstr, space1); if print then write (printer, hexstr, space1); if j = 7 then begin write (space1); if print then write (printer, space1); end; bytenumber := bytenumber + 1; until ok; end; (* getchar *) procedure getfirst; begin done := true; getchar; case inchar of (*$ifc disk *) 'S' : write (chr (7)); (*$elsec *) 'S' : setxbyte; (*$endc *) 'O' : tok := true; end; end (* case ord (inchar) of *) else if inchar in (hexset + otherset) then ok := true else write (chr (7)); nchar := '>'; ok := true; end; 27 : begin inchar := '<'; writeln ('xxxxx'); o else begin inchar := '<'; ok := true; end; 13 : begin i > 0 (* backspace *) then begin screen (8, 31, 0, 0, 0); delete (instr, length (instr), 1); end if (inchar in ['a'..'z']) then inchar := chr (ord (inchar) - 32); (* to upper case *) if ord (inchar) in [8, 13, 27] then case ord (inchar) of 8 : if length (instr) begin (* for search routines, graphics setup, etc. *) end; procedure getchar; var ok : boolean; begin ok := false; repeat fillchar (inchar, 2, 0); unitread (2, inchar, 1, , 12); readln (prtfile); if prtfile <> space0 then rewrite (printer, prtfile) else print := not print; end; prtheader; end; (* toggle *) procedure userdefined; toggle; begin write (chr(7)); print := not print; if print and (prtfile = space0) then begin writeln; writeln; write ('Specify outfile: '); if print then write (printer, space2); end; end; (* for j *) writeln; if print then writeln (printer); end; (* i *) end; (* pagedump *) procedure.'); if print then write (printer, '.'); end; if j = 7 then begin write (space2); re[j])); if print then write (printer, chr (store[j])); end else begin write (' if print then write (printer, space2); for j := 0 to 15 do begin if store[j] in [32..127] then begin write (chr (sto (*$ifc disk *) if bytenumber >= last + 1 then bytenumber := 0; (*$endc *) end; (* for j *) write (space2); (* print asciistring characters *) ggle; 'Q' : begin if prtfile <> space0 then close (printer, lock); exit (program); end; '<' : ; '>' : linedump; 'P' : pagedump; 'U' : userdefined; 'L' : list20 otherwise begin write (inchar); mono[1] := inchar; instr := concat (instr, mono); done := false; U', ':', space1]; xbyte := 0; bytenumber := 0; offset := 0; last := ten ('FFFF'); mono := space1; hexstr := '00'; prtfile := space0; print := false; (4 *) fillchar (oplist, sizeof (oplist), 0); reset (infile, filename); blkcount := blockread (infile, oplist, 9); close (infile); hexset := ['0'..'9', 'A'..'F']; otherset := ['L', 'O', 'P', 'Q', 'S', 'rwise error (p); end; (* case *) end; (* if *) end; (* analyze *) procedure initialize; var blkcount : integer; infile : file; begin screen (26, 0, 2, 2, 0); (* viewport 0,2 to 80,2 else case instr[1] of (*$ifc not disk *) ':' : poking (bytenumber); (*$endc *) 'L' : list20; 'P' : pagedump othemain of analyze *) if length (instr) <> 0 then begin p := 0; (* an index to screen display of instr *) setbyte; p := p + 1; if length (instr) = 0 then dumpone begin bytenumber := 0; write (chr (7)); end; (*$endc *) end; (* if p > 0 *) end; (* setbyte *) begin (* begin bytenumber := ten (copy (instr, 1, p)) - offset; delete (instr, 1, p); (*$ifc disk *) if ((bytenumber < 0) or (bytenumber >= last + 1)) then then p := p + 1 else quit := true; if p = 4 then quit := true; end else quit := true; until quit; if p > 0 then quit : boolean; begin quit := false; repeat if length (instr) > p then begin if instr[p + 1] in hexset ln; while int > 1 do begin write (space1); int := int - 1; end; writeln ('^', chr (7)); end; (* error *) procedure setbyte; var instr := concat (instr, mono); end; end; (* case *) until complete end; (* getmore *) procedure analyze; var p : integer; procedure error (int : integer); begin write; valid := true; end; 'O','S','U' : write (chr (7)) otherwise begin write (inchar); mono[1] := inchar; 'Q' : begin if prtfile <> space0 then close (printer, lock); exit (program); end; '<' : complete := true; '>' : begin complete := true end; end; (* case *) end; (* getfirst *) procedure getmore; var complete : boolean; begin complete := false; valid := false; repeat getchar; case inchar of *$ifc disk *) (* load specified disk file into memory buffer then assign starting "address" to buffer (used as offset from bytenumber) *) loadbuf; offset := startnum; (*$endc *) end; (* initialize *) begin (* main *) initialize; while 1 = 1 do begin writeln; unitclear (1); (* dump typeahead *) done := false; valid := false; instr := space0; LDA ENV ;restore ENVRMT STA ENVRMT PLP ;restore status (including interrupts) JMP DONE ;desired address on true 00 or 01 page TRUEPGS PHP 3 ;#% 0111 0011 - new environment reg STA ENVRMT ;(an "illegal" move) LDY #0 STY ADDRESS+1601 ;system bank xbyte = 00 LDA @ADDRESS,Y STA RESULT , C000-CFFF --> I/O PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDA ENVRMT ;save environment STA ENV LDA #7 ; bank pair JMP DONE ;handle artifical bank 'FF' SPECIAL LDA ADDRESS+1 BEQ TRUEPGS ;true $00, $01 desired? CMP #1 BEQ TRUEPGS ;ROM#1 --> F000-FFFFE ;handle extended addressing to a bankpair or $8F EXTEND STA ADDRESS+1601 ;place extend byte LDY #0 LDA @ADDRESS,Y ;"extended" addressing to desired STA RESULT BMI EXTEND ;handle system bank SYSTEM LDY #0 STY ADDRESS+1601 ;xbyte = 0 so get ordinary 6502 LDA @ADDRESS,Y ; indirect indexed addressing STA RESULT JMP DONC0-CF = I/O, BEQ SPECIAL ; "true" 00 and 01 pages CMP #80 BMI SYSTEM ;80-8F=extended addressing CMP #90 ; else system bank (ordinary 6502) reverse order POP ADDRESS LDA ADDRESS+1601 ;save original x-byte value STA OLDXBT ;which bank is desired LDA XBYTE CMP #0FF ;FF = ROM #1, .WORD 0 OLDXBT .BYTE 0 OLDZPG .BYTE 0 ENV .BYTE 0 BEGIN POP RETURN PLA ;"dummy" bytes for function PLA PLA PLA POP XBYTE ;parameters come off in   .ENDM ADDRESS .EQU 0E8 ;zeropage "pseudo" register BANKSW .EQU 0FFEF ZEROPG .EQU 0FFD0 ENVRMT .EQU 0FFDF .FUNC PEEK,2 JMP BEGIN RETURN .WORD 0 XBYTE .WORD 0 RESULT .cj PEEK and POKE (Published text - included here for completeness) .lj .MACRO POP PLA STA %1 PLA STA %1+1 .ENDM .MACRO PUSH LDA %1+1 PHA LDA %1 PHA prtheader; getfirst; if not done then getmore; if valid then analyze; end; (* while *) end. (* disassembler program *) .ff*) .ff ;save status, then disable interrupts SEI ;(an "illegal" move) LDX ADDRESS ;load BEFORE leaving old z-page LDY ADDRESS+1 LDA ZEROPG ;save old zpg STA OLDZPG LDA #0 ;changes zero-page to 0, stack to 1 STA ZEROPG ;(an "illegal" move) TYA ;is high byte 00 or 01 BEQ $1 ENVRMT ;save environment STA ENV LDA #73 ;#% 0111 0011 - new environment reg STA ENVRMT ;(an "illegal" move) LDY #0 STY ADDRESS+1601 CMP #1 BEQ TRUEPGS ;ROM#1 --> F000-FFFF, C000-CFFF --> I/O PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDA ;"extended" addressing to desired ; bank pair JMP DONE ;handle artifical bank 'FF' SPECIAL LDA ADDRESS+1 BEQ TRUEPGS ;true zp or $01 desired? xed addressing STA @ADDRESS,Y JMP DONE ;handle extended addressing to a bankpair or $8F EXTEND STA ADDRESS+1601 ;place extend byte LDY #0 LDA VALUE STA @ADDRESS,Y "true" 00 and 01 pages ;handle system bank SYSTEM LDY #0 STY ADDRESS+1601 ;xbyte = 0 so get ordinary 6502 LDA VALUE ; indirect inde BEQ DONE ; soon he will get very sick ;detect artificial bank 'FF' $2 LDA XBYTE CMP #0FF ;FF = ROM #1, C0-CF = I/O BEQ SPECIAL ; BEQ DONE ; in your program - suicide probable CMP #0DF BEQ DONE ;if you really want to crash, just start CMP #0EF ; POKing into SOS (RAM $B800 - FFFF) BANKSW = FFEF BNE $2 ; ENVRMT = FFDF ; ZEROPG = FFD0 LDA ADDRESS CMP #0D0 ; in this program - suicide certain ; else system bank (ordinary 6502) BMI EXTEND ;disallow certain addresses $1 LDA ADDRESS+1 ;POKE disallowed at (system bank): CMP #0FF ; ;for POKE, enable write C000 to FFFF STA ENVRMT ;which bank is desired LDA XBYTE CMP #80 BMI $1 ;80-8F=extended addressing CMP #90ALUE POP XBYTE POP ADDRESS LDA ADDRESS+1601 ;save original x-byte value STA OLDXBT LDA ENVRMT ;save ENVRMT STA OLDENV AND #0F7 BEGIN RETURN .WORD 0 XBYTE .WORD 0 VALUE .WORD 0 OLDXBT .BYTE 0 OLDZPG .BYTE 0 OLDENV .BYTE 0 ENV .BYTE 0 BEGIN POP RETURN ;parameters come off in reverse order POP V ;restore interrupts (status) DONE LDA OLDXBT ;restore Pascal's xbyte STA ADDRESS+1601 PUSH RESULT PUSH RETURN RTS .PROC POKE,3 JMP LDA 0100,X ;indexed addressing (x = addr) JMP $2 $1 LDA 0000,X $2 STA RESULT LDA OLDZPG ;restore ZEROPG (and stack page) STA ZEROPG PLP ;system bank xbyte = 00 LDA VALUE STA @ADDRESS,Y LDA ENV ;restore ENVRMT STA ENVRMT PLP ;restore status (including interrupts) JMP DONE ;desired address on true 00 or 01 page TRUEPGS PHP ;save status, then disable interrupts SEI ;(an "illegal" move) LDX ADDRESS ;load BEFORE leتPRš+R+PP4تPRšG+R+PGP4GRšزGRPزGPR0D~YSLIB:CHAINUNIT.CODE,if not done then getmore; ,if valid then analyze; (end; (* while *) end.    main *) $gotoxy (0, 6); $writeln ('memavail = ',memavail); $exit (program); $initialize; $while 1 = 1 do (begin ,writeln; ,unitclear (1); (* dump typeahead *) ,done := false; ,valid := false; ,instr := spc0; ,prtheader; ,getfirst; rint := false; )(*$ifc disk *) -(* load specified disk file into memory buffer . then assign starting "address" to buffer 3(used as offset from bytenumber) *) (loadbuf; (offset := startnum; )(*$endc *) $end; (* initialize *)  begin (*e, oplist, 9); (close (infile); (hexset := ['0'..'9', 'A'..'F']; (otherset := ['L', 'O', 'P', 'Q', 'S', 'U', ':', spc1]; (xbyte := 0; (bytenumber := 0; (offset := 0; (mono := spc1; (hexstr := '00'; (prtfile := spc0; (p$end; (* analyze *) procedure initialize; $var (blkcount : integer; (infile : file; $begin (screen (26, 0, 2, 2, 0); (* viewport 0,2 to 80,24 *) (fillchar (oplist, sizeof (oplist), 0); (reset (infile, filename); (blkcount := blockread (infilDA OLDENV ;restore C0-CF read/write status STA ENVRMT PUSH RETURN RTS .END .ff OLDZPG ;restore ZEROPG (and stack page) STA ZEROPG PLP ;restore interrupts (status) DONE LDA OLDXBT ;restore Pascal's xbyte STA ADDRESS+1601 L) LDA VALUE CPY #0 ;is high byte 00 or 01 BEQ $1 STA 0100,X ;indexed addressing (x = addr) JMP $2 $1 STA 0000,X $2 LDA aving old z-page LDY ADDRESS+1 LDA ZEROPG ;save old zpg STA OLDZPG LDA #0 ;changes zero page to 0, stack to 1 STA ZEROPG ;(an "illegal" moveCHAINUNIT.TEXTSYSLIByy6JJ>Bb^JJNR^^ bb"L^LtJ ^JECommand: E(dit, R(un, F(ile, C(omp, L(ink, X(ecute, A(ssem,