LnSOS BOOT 1.1 SOS.KERNEL SOS KRNLI/O ERRORFILE 'SOS.KERNEL' NOT FOUND%INVALID KERNEL FILE: xةw,@  ȱlmi8#)!)O^$/\!III.PCL.15u' /ASMFORMAT0.TEXT8! /ASMFORMAT1.TEXT%'L; /ASMFORMAT2.TEXTL4!/ASMFORMAT3.TEXTg3d!/ASMFORMAT4.TEXT?|!/ASMFORMAT5.TEXT >dLԡm#i㰼m#iЕOLԡȱfg hi !dLԡ憦  Ljmkm l y`2 Lԡ8(Je稽)ʈ@L  !"#NER AS OTHERS SEE FIT. [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } {^FF} { [][][][][][][][][][][][][][][][][][][][][][][][]------------------------ [] [] [] [] THIS PROGRAM HAS BEEN PLACED INTO THE PUBLIC DOMAIN BY THE [] [] AUTHOR, DAVID T. CRAIG, AND AS SUCH IT MAY BE USED OR ABUSED [] [] IN ANY MAN [] has multiple routines then this program can output [] [] invalid data. [] [] [] [] -------------------------------------- [] [] [] [] This program should only be used on listings which [] [] contain one procedure or function. If a listing [] header lines (those with the page number and [] [] miscellaneous memory sizes), uppercasing of opcodes [] [] and directives (or lowercasing if desired), and a [] [] listing of the static opcode frequencies. of a professional [] [] listing. [] [] [] [] Features include the removal of blank lines and [] [] [] so that all back-patches are filled with the [] [] correct values. Once patched, the listing file can [] [] be printed by a pretty printer program, thus [] [] resulting in the production [] [] -------------------------------------------------------------- [] [] [] [] Purpose : This program formats an Apple /// Assembler listing [] : 1986 [] [] Language : Apple Pascal 1.1 [] [] Computer : Apple /// [] [] PRETTY FORMATTER [] [] ---------------------------------------------- [] [] [] [] Author : David Craig (736 Edgewater, Wichita, KS 67230) [] [] Date { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] ---------------------------------------------- [] [] APPLE /// ASSEMBLER LISTING [][][][][][][][][][] [] [] [] N O T E S [] [] [] [] Note : Assembler Back-Patch Information [] [] [] [] In listing files produced by the /// Assembler [] [] foreward references are und Apple_3_Asm_Pretty_Formatter; { And here's ... } { ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ "+ + "+ COMPILATION DIRECTIVES [] [] 4. Symbol table sorted by address [] [] [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } {^FF} PROGRAM [] [] [] 1. Multiple listing routine support [] [] 2. Identifier cross-reference listing [] [] 3. Identifier case control the [] [] phrase [///]. [] [] [] [] Note : Future Enhancements (left to others) [] [] [] Note : Machine Compatability [] [] [] [] All Apple /// specific code is marked with Listings with more than [] [] 64 back-patches are handled, but disk accesses [] [] increase due to the additional block storage [] [] requirements. [] [] [] is only one block in size (512 bytes), but this [] [] size is very good since one disk block can hold 64 [] [] back-patch records and most assembly listings have [] [] less than 64 back-patches. ually. [] [] Access to the back-patch file is thru two routines [] [] which read and write a single record. A file cache [] [] is used to speed up file I/O. Currently the cache [] [] [] This program stores the listing back-patches in a [] [] disk file. Each back-patch represents one record [] [] in the file and records are stored sequent.PATCHLIST and the [] [] .MACROLIST directives must be used. [] [] [] [] Note : Back-Patch List Structure [] [] [] Example : 0165| **** [] [] [] [] To specify the inclusion of back-patch data in a [] [] listing file the Assembler [] [] (II ) Absolute branch references (2 bytes) [] [] Example : 0022| 4C **** [] [] (III) Storage or equate reference (2 bytes) [] come in three flavors: [] [] [] [] (I ) Relative branch references (1 byte) [] [] Example : 0038| D0** efined and the actual [] [] reference values are unspecified. Back-patches are [] [] special listing lines which contain the values for [] [] the undefined foreward references. Back-patches [] [] + "+ + "++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } " "{$IOCHECK-} { [///] } "{$GOTO+} "{$VARSTRING-} "{$RANGECHECK-} " "{$COMMENT AsmFormatter : Not (c) 1986 by David Craig} " { ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + + CONDITIONAL COMPILATION VARIABLES { disk cache structure } gt_DiskCache = RECORD owner : INTEGER; { block owner } buffer : gt_DiskBlock; { block buffer } END; VAR gv_UserIsDone : BOOLEAN; { user t= RECORD { 8 bytes } address : gt_BPEntry; { 4 bytes } patch : gt_BPEntry; { 4 bytes } END; { disk block buffer } gt_DiskBlock = PACKED ARRAY [0..gc_BlkSizeM1 {511} ] OF CHAR; { back-patch file record index (should handle any listing) } gt_BPIndex = 0..32000; { back-patch file record sub-element entry } gt_BPEntry = PACKED ARRAY [0..3] OF CHAR; { back-patch file record } gt_BackPatch c_E_WriteCache = -6670; { writing BP cache byte failed } TYPE { generic phrase used for many items (e.g.: file names, ...) } gt_Phrase = STRING[255]; { error result } gt_Error = INTEGER; 66; { back-patch absolute address not found } gc_E_RelAddr = -6667; { back-patch relative address not found } gc_E_TooManyBPs = -6668; { too many back-patches found in listing } gc_E_ReadCache = -6669; { reading BP cache byte failed } g} gc_BlockSize = 512; { no. bytes in a disk block [///] } gc_BlkSizeM1 = 511; gc_CacheFile = 'BP.CACHE'; { cache file name [///] } { special formatter error codes (should not conflict with OS errors) } gc_E_AbsAddr = -66 gc_PgmAuthor = 'David Craig'; { program author(s) } gc_PgmDate = '1986'; { program compilation date } gc_PgmVersion = '1.00'; { program version (x.yz) } gc_NoError = 0; { code value for no error result [///] NSTANTS, TYPES, AND VARIABLES + + + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } CONST Debug} USES {$USING UDEBUG.CODE} U_PDebugger; { runtime debugger [///] } {$ENDC} { ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + + GLOBAL CO + + EXTERNAL MODULES + + + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } {$IFC f { recommend that fDebugAll be set to FALSE unless the program } { has a problem with the low-level routines. (DTC) } { ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + } { Setting fDebugAll to TRUE generates an ENORMOUS amount of } { debugging data which can be overwhelming at times. I } want debugging data sent to the } { output file specified in the U_PDebugger Unit. This } { will generate some useful program runtime data which can be } { used to fix any anomalies in the program. } { + + + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } {$SETC fDebug := FALSE} {$SETC fDebugAll := FALSE} { Note: Set fDebug to TRUE if you ermination flag } gv_AsmInFile : gt_Phrase; { assembler listing file name } gv_AsmOutFile : gt_Phrase; { formatted listing file name } $gv_CacheFile : FILE; { back-patch cache file } {$INCLUDE .D3/ASMFORMAT1 } { minor routines } {$INCLUDE .D3/ASMFORMAT2 } { major routines (I ) } {$INCLUDE .D3/ASMFORMAT3 } { major routines (II ) } {$INCLUDE .D3/ASMFORMAT4 } { major routines (III) } {$INCLUDE .D3/ASMFORMAT5 } { major rou { ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + + MINOR ROUTINES + + $&'()*+,-./0123456789:;<=>?@ABCDEFGHIJO^ [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] F I N I S [] [] IF NOT(gv_UserIsDone) THEN pretty_format_user_file (gv_AsmInFile,gv_AsmOutFile); END; UNTIL gv_UserIsDone; { say some parting words to the user } farewell; END. { ---------- Apple_3_Asm_Pretty_Formatter ---------- the user for files to format until the user quits } REPEAT BEGIN { prompt the user for an input and output file } fetch_user_files (gv_AsmInFile,gv_AsmOutFile,gv_UserIsDone); { format the input file } [] [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] } BEGIN { ---------- Apple_3_Asm_Pretty_Formatter ---------- } { introduce the program to the user } introduction; { prompt tines (IV ) } { [][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][][] [] [] [] T H E M A I N E V E N T [] [] + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } { #################################################################### # ROUTINE : file_exists # PURPOSE : test if a file exists # INPUT : the_file_name - name of file to test # OUTPUT : file_exists - TRUE --> file exists # NOTES : (none) #################################################################### } FUNCTION file_exists (the_file_name : gt_Phrase) : BOOLEAN; VAR fi # INPUT : the_phrase - phrase to trim # OUTPUT : the_phrase - trimmed phrase # NOTES : (none) #################################################################### } PROCEDURE trim_leading_blanks (VAR the_phrase : gt_Phrase); CONST ase'); {$ENDC} END; { ---------- lowercase_phrase ---------- } { #################################################################### # ROUTINE : trim_leading_blanks # PURPOSE : trim leading blanks from a phrase Z') THEN BEGIN the_phrase[ch_index] := CHR( ORD(the_phrase[ch_index]) - ORD('A') + ORD('a') ); END; ch_index := ch_index - 1; END; {$IFC fDebug AND fDebugAll} EP('lowercase_phrthe phrase's end } ch_index := LENGTH(the_phrase); { scan each phrase character looking for chars to uppercase } WHILE ch_index > 0 DO BEGIN IF (the_phrase[ch_index] >= 'A') AND (the_phrase[ch_index] <= ' PROCEDURE lowercase_phrase (VAR the_phrase : gt_Phrase); VAR ch_index : INTEGER; { phrase char. index } BEGIN { ---------- lowercase_phrase ---------- } {$IFC fDebug AND fDebugAll} BP('lowercase_phrase'); {$ENDC} { start at # PURPOSE : lowercase a phrase # INPUT : the_phrase - phrase to lowercase # OUTPUT : the_phrase - lowercased phrase # NOTES : (none) #################################################################### } x := ch_index - 1; END; {$IFC fDebug AND fDebugAll} EP('uppercase_phrase'); {$ENDC} END; { ---------- uppercase_phrase ---------- } { #################################################################### # ROUTINE : lowercase_phrase IF (the_phrase[ch_index] >= 'a') AND (the_phrase[ch_index] <= 'z') THEN BEGIN the_phrase[ch_index] := CHR( ORD(the_phrase[ch_index]) - ORD('a') + ORD('A') ); END; ch_inde {$IFC fDebug AND fDebugAll} BP('uppercase_phrase'); {$ENDC} { start at the phrase's end } ch_index := LENGTH(the_phrase); { scan each phrase character looking for chars to uppercase } WHILE ch_index > 0 DO BEGIN ne) #################################################################### } PROCEDURE uppercase_phrase (VAR the_phrase : gt_Phrase); VAR ch_index : INTEGER; { phrase char. index } BEGIN { ---------- uppercase_phrase ---------- } -------- } { #################################################################### # ROUTINE : uppercase_phrase # PURPOSE : uppercase a phrase # INPUT : the_phrase - phrase to uppercase # OUTPUT : the_phrase - uppercased phrase # NOTES : (noe exists } END ELSE file_found := FALSE; { file not found } { return file state to caller } file_exists := file_found; {$IFC fDebug AND fDebugAll} EP('file_exists'); {$ENDC} END; { ---------- file_exists -- { attempt to open the file } RESET(f_ref,the_file_name); io_error := IORESULT; { test if the open failed } IF io_error = gc_NoError THEN BEGIN CLOSE(f_ref); file_found := TRUE; { open went well, so fille_found : BOOLEAN; { file found flag } f_ref : FILE; { file reference } io_error : gt_Error; { error result } BEGIN { ---------- file_exists ---------- } {$IFC fDebug AND fDebugAll} BP('file_exists'); {$ENDC} k_Blank = ' '; { ASCII space ($20) } &k_FF = 12; { ASCII form feed } BEGIN { ---------- trim_leading_blanks ---------- } {$IFC fDebug AND fDebugAll} BP('trim_leading_blanks'); {$ENDC} WHILE (LENGTH(the_phrase) > 0) AND ((the_phrase[1] = k_Blank ) OR J(the_phrase[1] = CHR(k_FF))) DO BEGIN DELETE(the_phrase,1,1); END; {$IFC fDebug AND fDebugAll} EP('trim_leading_blanks'); {$ENDC} END; { ---------- trim_leading_blanks ---------- } { #########{ #################################################################### # ROUTINE : read_raw_block # PURPOSE : read a block from either a file or the cache # INPUT : disk_cache - file cache information # blk_index - index of block to rele and remove it from the disk directory } CLOSE(gv_CacheFile,PURGE); END; {$IFC fDebug AND fDebugAll} EP('flush_block_cache'); {$ENDC} END; { ---------- flush_block_cache ---------- } BEGIN { write cache block data back to its disk file } WITH disk_cache DO blks_written := BLOCKWRITE(gv_CacheFile,buffer,1,owner); fbc_error := IORESULT; { test for an I/O error } { close the disk fi{$IFC fDebug AND fDebugAll} BP('flush_block_cache'); {$ENDC} fbc_error := gc_NoError; { assume all will go well } { test if any file block data exists in the cache } IF disk_cache.owner > -1 THEN { data exists, so write it out } PROCEDURE flush_block_cache (VAR disk_cache : gt_DiskCache; VAR fbc_error : gt_Error); VAR blks_written : INTEGER; { no. of blocks written to file } BEGIN { ---------- flush_block_cache ---------- } he back to cache file # INPUT : disk_cache - cache information # OUTPUT : disk_cache - modified cache information # fbc_error - flush error # NOTES : (none) #################################################################### } g AND fDebugAll} EP('init_block_cache'); {$ENDC} END; { ---------- init_block_cache ---------- } { #################################################################### # ROUTINE : flush_block_cache # PURPOSE : write any active data blocks in cacIFC fDebug AND fDebugAll} BP('init_block_cache'); {$ENDC} { create the cache file } REWRITE(gv_CacheFile,gc_CacheFile); ibc_error := IORESULT; { mark cache block owner as non-existant } disk_cache.owner := -1; {$IFC fDebu #################################################################### } PROCEDURE init_block_cache (VAR disk_cache : gt_DiskCache; VAR ibc_error : gt_Error); BEGIN { ---------- init_block_cache ---------- } {$# INPUT : disk_cache - cache information # OUTPUT : disk_cache - modified cache information # ibc_error - initialization error # NOTES : Must be called before any other cache routines are used Debug AND fDebugAll} EP('trim_trailing_blanks'); {$ENDC} END; { ---------- trim_trailing_blanks ---------- } { #################################################################### # ROUTINE : init_block_cache # PURPOSE : initialize file cache {$IFC fDebug AND fDebugAll} BP('trim_trailing_blanks'); {$ENDC} WHILE (LENGTH(the_phrase) > 0) AND (the_phrase[LENGTH(the_phrase)] = k_Blank) DO BEGIN DELETE(the_phrase,LENGTH(the_phrase),1); END; {$IFC f #################################################################### } PROCEDURE trim_trailing_blanks (VAR the_phrase : gt_Phrase); CONST k_Blank = ' '; { ASCII space ($20) } BEGIN { ---------- trim_trailing_blanks ---------- } ########################################################### # ROUTINE : trim_trailing_blanks # PURPOSE : trim trailing blanks from a phrase # INPUT : the_phrase - phrase to trim # OUTPUT : the_phrase - trimmed phrase # NOTES : (none) ad # OUTPUT : disk_cache - modified cache information w/ block data # rrb_error - read error # NOTES : (none) #################################################################### } PROCEDURE read_raw_block (VAR disk_cache : gt_DiskCache; blk_index : INTEGER; VAR rrb_error : gt_Error); VAR blks_read : INTEGER; { no. of blocks read from file } BEGIN { ---------- read_raw_block ---------- } {$IFC fDebu END; END; {$IFC fDebug AND fDebugAll} EP('read_cache_byte'); {$ENDC} END; { ---------- read_cache_byte ---------- } { #################################################################### # ROUTINE : write_cache_byte # lock data } read_raw_block(disk_cache,block_offset,rcb_error); { extract the desired byte from the cache block } IF rcb_error = gc_NoError THEN BEGIN byte_data := disk_cache.buffer[byte_offset]; OD gc_BlockSize; { read the block from the file (or from the cache buffer) } IF (block_offset < 0) OR (byte_offset < 0) THEN rcb_error := gc_E_ReadCache { handle overflow errors } ELSE BEGIN { read the actual b ---------- read_cache_byte ---------- } {$IFC fDebug AND fDebugAll} BP('read_cache_byte'); {$ENDC} { compute the block and byte offsets within the cache } block_offset := byte_index DIV gc_BlockSize; byte_offset := byte_index M VAR byte_data : CHAR; VAR rcb_error : gt_Error); VAR block_offset : INTEGER; { cache file block offset } byte_offset : INTEGER; { cache file block byte offset } BEGIN { access the back-patch cache #################################################################### } PROCEDURE read_cache_byte (VAR disk_cache : gt_DiskCache; byte_index : INTEGER; ache - cache to read from # byte_index - index of byte in cache # OUTPUT : byte_data - the read cache byte # rcb_error - cache access error result # NOTES : this routine (and write_cache_byte) is the only way to # EP('read_raw_block'); {$ENDC} END; { ---------- read_raw_block ---------- } { #################################################################### # ROUTINE : read_cache_byte # PURPOSE : read a byte from the back-patch cache # INPUT : disk_c disk_cache.buffer[blks_read] := CHR(0); { mark the file cache as appropriate } disk_cache.owner := blk_index; END; END; END; {$IFC fDebug AND fDebugAll} ror = gc_NoError THEN BEGIN IF blks_read = 0 THEN { fill the block with zeros } FOR blks_read := 0 TO (gc_BlockSize -1) DO orm the actual block read } WITH disk_cache DO blks_read := BLOCKREAD(gv_CacheFile,buffer,1,blk_index); rrb_error := IORESULT; { if block is a virgin fill it with zeros } IF rrb_erlks_read := BLOCKWRITE(gv_CacheFile,buffer,1,owner); rrb_error := IORESULT; END; { read desired file block from the file into the cache } IF rrb_error = gc_NoError THEN BEGIN { perf { desired block not in cache, so test if cache is empty } IF (disk_cache.owner > -1) THEN BEGIN { cache is not empty, so read write cache data back to file } WITH disk_cache DO bg AND fDebugAll} BP('read_raw_block'); {$ENDC} rrb_error := gc_NoError; { assume all is well } { test if block to read already exists in cache } IF (disk_cache.owner <> blk_index) THEN BEGIN PURPOSE : write a byte to the back-patch cache # INPUT : disk_cache - cache to write to # byte_index - index of byte in cache # byte_data - the byte to write # OUTPUT : wcb_error - cache access error result # NOTES : this routine (and read) is the only way to access # the back-patch cache #################################################################### } PROCEDURE write_cache_byte (VAR disk_cache : gt_DiskCache; byte #################################################################### } PROCEDURE write_back_patch (VAR disk_cache : gt_DiskCache; bp_index : gt_BPIndex; bp_data : gt_BackPatch; record to the back-patch file # INPUT : disk_cache - back-patch file cache # bp_index - back-patch index # bp_data - back-patch record # OUTPUT : wbp_error - the write error result # NOTES : (none) {$IFC fDebug AND fDebugAll} EP('read_back_patch'); {$ENDC} END; { ---------- read_back_patch ---------- } { #################################################################### # ROUTINE : write_back_patch # PURPOSE : write a back-patch IF offset < 4 THEN bp_data.address[offset ] := byte_data ELSE bp_data.patch [offset-4] := byte_data; offset := offset + 1; END; UNTIL (offset = SIZEOF(gt_BackPatch)) OR (rbp_error <> gc_NoError); { initialize record byte offset value } offset := 0; { read raw bytes from the bp file until one whole record is read } REPEAT BEGIN read_cache_byte(disk_cache,byte_index+offset,byte_data,rbp_error); ----- read_back_patch ---------- } {$IFC fDebug AND fDebugAll} BP('read_back_patch'); {$ENDC} { determine position of 1st byte in bp record } byte_index := bp_index * SIZEOF(gt_BackPatch) {8}; _BackPatch; VAR rbp_error : gt_Error); VAR byte_index : INTEGER; { file record byte offset } byte_data : CHAR; { raw file byte } offset : INTEGER; { byte offset within record } BEGIN { -----OTES : (none) #################################################################### } PROCEDURE read_back_patch (VAR disk_cache : gt_DiskCache; bp_index : gt_BPIndex; VAR bp_data : gt # PURPOSE : read a back-patch record from the back-patch file # INPUT : disk_cache - back-patch file cache # bp_index - back-patch index # OUTPUT : bp_data - back-patch record # rbp_error - the read error result # N {$IFC fDebug AND fDebugAll} EP('write_cache_byte'); {$ENDC} END; { ---------- write_cache_byte ---------- } { #################################################################### # ROUTINE : read_back_patch le overflow errors } ELSE BEGIN read_raw_block(disk_cache,block_offset,wcb_error); IF wcb_error = gc_NoError THEN BEGIN disk_cache.buffer[byte_offset] := byte_data; END; END; ock_offset := byte_index DIV gc_BlockSize; byte_offset := byte_index MOD gc_BlockSize; { write the block to the file (or to the cache buffer) } IF (block_offset < 0) OR (byte_offset < 0) THEN wcb_error := gc_E_WriteCache { hand byte_offset : INTEGER; { cache file block byte offset } BEGIN { ---------- write_cache_byte ---------- } {$IFC fDebug AND fDebugAll} BP('write_cache_byte'); {$ENDC} { compute the block and byte offsets within the cache } bl_index : INTEGER; byte_data : CHAR; VAR wcb_error : gt_Error); VAR block_offset : INTEGER; { cache file block offset } VAR wbp_error : gt_Error); VAR byte_index : INTEGER; { file record byte offset } byte_data : CHAR; { raw file byte } offset : INTEGER; { byte offset within record } BEGIN { ---------- write_back_patch ---------- } {$IFC fDebug AND fDebugAll} BP('write_back_patch'); {$ENDC} { determine position of 1st byte in bp record } byte_index := bp_index * SIZEOF(gt_BackPatch) {8}; { initialize record byte offset value } : (none) | OUTPUT : (none) | NOTES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } #PROCEDURE introduction; PROCEDURE w (intro_phrase : gt_Phrase); BEGIN { ---------- w ---------- } WRITEL + ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ } { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : introduction | PURPOSE : introduce program to the user | INPUT { ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + + + MAJOR ROUTINES + + KMNOPQRSTUVWXYZ[\]^_`abcdeO^ {$IFC fDebug AND fDebugAll} EP('write_back_patch'); {$ENDC} END; { ---------- write_back_patch ---------- } { END OF : ASM.FORMAT.1 } byte_data := bp_data.patch [offset-4]; write_cache_byte(disk_cache,byte_index+offset,byte_data,wbp_error); offset := offset + 1; END; UNTIL (offset = SIZEOF(gt_BackPatch)) OR (wbp_error <> gc_NoError); offset := 0; { write raw bytes from the bp file until one whole record is written } REPEAT BEGIN IF offset < 4 THEN byte_data := bp_data.address[offset ] ELSE N(intro_phrase); END; { ---------- w ---------- } BEGIN { ---------- introduction ---------- } { initialize the runtime debugger (if installed) } {$IFC fDebug} PD_InitDebugger; PD_WRITELN('Debugging program : Apple_3_Asm_Pretty_Formatter'); PD_WRITELN(''); {$ENDC} {$IFC fDebug} BP('introduction'); {$ENDC} { say some words of wisdom to the user concerning this bucket of bits } w(CONCAT('Apple trim_leading_blanks (asmInFile); trim_trailing_blanks(asmInFile); {$IFC fDebug} PD_WRITELN(CONCAT('asmInFile (trimmed) = "',asmInFile,'"')); {$ENDC} { test for user termination } userIsDter Assembler listing file [',k_TextSuffix,'] ? '); READLN(asmInFile); {$IFC fDebug} PD_WRITELN(CONCAT('asmInFile (raw) = "',asmInFile,'"')); {$ENDC} { make certain all extra characters are removed } { note: the standard text file suffix will be automatically } { added to the input file name unless indicated. } REPEAT BEGIN { prompt for the input file name } WRITELN; WRITE('En{$IFC fDebug} BP('fetch_user_files'); {$ENDC} { prompt user for the input file name until either a valid name } { is entered or the user desires to quit the program. } k_FormatSuffix = '.FORM'; { format file suffix [///] } VAR default_outFile : gt_Phrase; { default output file name } answer : gt_Phrase; { overwrite prompt answer } BEGIN { ---------- fetch_user_files ---------- } |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE fetch_user_files (VAR asmInFile : gt_Phrase; = VAR asmOutFile : gt_Phrase; >VAR userIsDone : BOOLEAN); CONST k_TextSuffix = '.TEXT'; { text file suffix [///] } | asmOutFile - output file name (with any needed suffix) | userIsDone - user termination flag | NOTES : if the user does not enter a file name for the input | file, then the termination flag is set to TRUE |||||||||||||||||||||||||||| | ROUTINE : fetch_user_files | PURPOSE : fetch the inpout & output file names from the user | INPUT : (none) | OUTPUT : asmInFile - input file name (with any needed suffix) 's all, Folks ...'); {$IFC fDebug} EP('farewell'); {$ENDC} { terminate the runtime debugger } {$IFC fDebug} PD_KillDebugger; {$ENDC} END; { ---------- farewell ---------- } {^FF} { ||||||||||||||||||||||||||||||||||||||||||||||||ES : (none) |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE farewell; BEGIN { ---------- farewell ---------- } {$IFC fDebug} BP('farewell'); {$ENDC} { say bye } WRITELN; WRITELN('That' END; { ---------- introduction ---------- } {^FF} { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : farewell | PURPOSE : inform the user that this program is ending | INPUT : (none) | OUTPUT : (none) | NOTistings which contain'); w(' only one procedure or function. If a listing has multiple'); w(' routines then this program can output invalid data.'); {$IFC fDebug} EP('introduction'); {$ENDC} tches are filled with the correct values. Once patched,'); w('the listing file can be printed by a pretty printer program,'); w('thus resulting in a professional listing.'); WRITELN; w('Note: This program should only be used on l /// 6502 Assembler Listing Pretty Formatter ', gc_PgmVersion)); w(CONCAT('Not Copyright ',gc_PgmDate,' by ',gc_PgmAuthor)); WRITELN; w('This program formats an Apple /// Assembler listing so that all'); w('back-paone := (LENGTH(asmInFile) = 0); IF NOT(userIsDone) THEN BEGIN { setup file name for suffix inclusion determination } uppercase_phrase(asmInFile); { attempt to add suffix to file name } IF asmInFile[LENGTH(asmInFile)] = '.' THEN { user does not want a suffix } DELETE(asmInFile,LENGTH(asmInFile),1) ELSE BEGIN IF POS(k_TextSuffix,asmInFile) = 0 THE IF LENGTH(asmOutFile) = 0 THEN { use the default name } asmOutFile := CONCAT(default_outFile,k_FormatSuffix) ELSE { user entered another output name } BEGIN { attempt toutFile); uppercase_phrase(asmOutFile); {$IFC fDebug} PD_WRITELN(CONCAT('asmOutFile (trimmed) = "',asmOutFile,'"')); {$ENDC} { test if the user wants to use the default name } PD_WRITELN(CONCAT('asmOutFile (raw) = "',asmOutFile,'"')); {$ENDC} { remove any extra characters from the user's file name } trim_leading_blanks (asmOutFile); trim_trailing_blanks(asmO prompt user for the output file name } WRITE('Enter output file [',default_outFile,']/', '[',k_FormatSuffix,'] ? '); READLN(asmOutFile); {$IFC fDebug} le, POS(k_TextSuffix,default_outFile), LENGTH(k_TextSuffix)); {$IFC fDebug} PD_WRITELN(CONCAT('default_outFile = "',default_outFile,'"')); {$ENDC} {tput file name suffix } IF POS(k_TextSuffix,default_outFile) > 0 THEN IF POS(k_TextSuffix,default_outFile) = LENGTH(default_outFile) - LENGTH(k_TextSuffix) + 1 THEN DELETE(default_outFi { input file name less the text suffix } default_outFile := asmInFile; { modify default name for comparison reasons } uppercase_phrase(default_outFile); { test for the ouF NOT(userIsDone) THEN BEGIN { prompt the user for the output file name } REPEAT BEGIN { setup the default output file name to the user's } asmInFile := ''; END; END; END; UNTIL userIsDone OR (LENGTH(asmInFile) > 0); { input file name is now available and exists } { Get the output file name (iff user has not quit) } I { file not found so inform the user } {$IFC fDebug} PD_WRITELN(CONCAT('"',asmInFile,'" not found')); {$ENDC} WRITELN('*** NOTE: File "',asmInFile,'" was not found'); {$IFC fDebug} PD_WRITELN(CONCAT('asmInFile (final) = "',asmInFile,'"')); {$ENDC} { make certain that the file exists } IF NOT(file_exists(asmInFile)) THEN BEGIN ince name does not have one } asmInFile := CONCAT(asmInFile,k_TextSuffix); END; END; END; { file name with the desired suffix is now available } { make certain suffix is at the name's end } IF POS(k_TextSuffix,asmInFile) <> LENGTH(asmInFile) - LENGTH(k_TextSuffix) + 1 THEN BEGIN { add the suffix sN BEGIN { add the suffix since name does not have one } asmInFile := CONCAT(asmInFile,k_TextSuffix); END ELSE BEGIN add the output suffix to the name } IF asmOutFile[LENGTH(asmOutFile)] = '.' THEN { leave output file name alone (almost) } DELETE(asmOutFile,LENGTH(asmOutFile),1) ELSE BEGIN { test for the output suffix } IF POS(k_FormatSuffix,asmOutFile) = 0 THEN { suffix not found, so add it } asmOutFile := CONCAT(asmOutFilefhijklmnopqrstuvwxyz{|}~O^2 } UNTIL LENGTH(asmOutFile) > 0; { stop when a valid output file exists } END; {$IFC fDebug} EP('fetch_user_files'); {$ENDC} END; { ---------- fetch_user_files ---------- } { END OF : ASM.FORMAT. ELSE BEGIN IF (answer[1] <> 'Y') AND (answer[1] <> 'y') THEN asmOutFile := ''; { do not overwrite the file } END; END; END; file } READLN(answer); trim_leading_blanks (answer); trim_trailing_blanks(answer); IF LENGTH(answer) = 0 THEN asmOutFile := '' { do not overwrite the file } WRITELN; WRITE ('*** WARNING: '); WRITELN('File "',asmOutFile,'" already exists.'); WRITE (' Overwrite it (Y/N) [N] ? '); { test if the user wishes to overwrite the { file already exists } {$IFC fDebug} PD_WRITELN(CONCAT('"',asmOutFile,'" already exists')); {$ENDC} { warn the user of a possible file destruction } {$IFC fDebug} PD_WRITELN(CONCAT('asmOutFile (final) = "',asmOutFile,'"')); {$ENDC} { test if the output file already exists } IF file_exists(asmOutFile) THEN BEGIN ENGTH(k_FormatSuffix)+1 THEN asmOutFile := CONCAT(asmOutFile,k_FormatSuffix); END; END; END; { output file name is now available for use } ,k_FormatSuffix) ELSE BEGIN { make certain suffix is at the name's end } IF POS(k_FormatSuffix,asmOutFile) <> LENGTH(asmOutFile)-L IF (LENGTH(answer) > 0) AND (answer[1] = 'N') THEN format_options.kill_page_headers := FALSE; WRITE (' Uppercase opcodes (Y/N) [Y] ? '); READLN(answer); trim_leading_blanks (answer); trim_trailinglines := FALSE; WRITE (' Remove page headers (Y/N) [Y] ? '); READLN(answer); trim_leading_blanks (answer); trim_trailing_blanks(answer); uppercase_phrase (answer); (Y/N) [Y] ? '); READLN(answer); trim_leading_blanks (answer); trim_trailing_blanks(answer); uppercase_phrase (answer); IF (LENGTH(answer) > 0) AND (answer[1] = 'N') THEN format_options.kill_blank_UE; format_options.opcode_frequencies := TRUE; { show user a title } WRITELN; WRITELN('Formatting Options:'); WRITELN; { prompt user for the various option settings } WRITE (' Remove blank lines {$IFC fDebug} BP('setup_options'); {$ENDC} { setup the options to their default states } format_options.kill_blank_lines := TRUE; format_options.kill_page_headers := TRUE; format_options.opcode_uppercased := TRormat_options modified #################################################################### } PROCEDURE setup_options; VAR answer : gt_Phrase; { answer to a question } BEGIN { ---------- setup_options ---------- } { output line # on failure } { #################################################################### # ROUTINE : setup_options # PURPOSE : setup the output format options # INPUT : (none) # OUTPUT : (none) # NOTES : global variable f { input file reference } outAsmFile : TEXT; { output file reference } disk_cache : gt_DiskCache; { back-patch file cache } bp_count : gt_BPIndex; { back-patch counter } line_out_count : INTEGER; opcode_frequencies : BOOLEAN; END; VAR io_error : gt_Error; { I/O error result } format_options : t_FormatOptions; { user format options } inAsmFile : TEXT; options modifiable by the user } t_FormatOptions = RECORD kill_blank_lines : BOOLEAN; kill_page_headers : BOOLEAN; opcode_uppercased : BOOLEAN; |||||||||||||||||||||||||||||||||||||||||||||||| } PROCEDURE pretty_format_user_file (asmInFile : gt_Phrase; asmOutFile : gt_Phrase); LABEL 666,777; { error branches } TYPE { format control - output patched listing file name | OUTPUT : (none) | NOTES : this routine scans the listing file twice, first looking | for back-patch control lines, and second, performing the | actual back-patching |||||||||||||||||||| { |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| | ROUTINE : pretty_format_user_file | PURPOSE : format listing file so that all back-patches are patched | INPUT : asmInFile - input listing file name | asmOutFile_blanks(answer); uppercase_phrase (answer); IF (LENGTH(answer) > 0) AND (answer[1] = 'N') THEN format_options.opcode_uppercased := FALSE; WRITE (' Count opcode frequencies (Y/N) [Y] ? '); READLN(answer); trim_leading_blanks (answer); trim_trailing_blanks(answer); uppercase_phrase (answer); IF (LENGTH(answer) > 0) AND (answer[1] = 'N') THEN format_options.opcode_frequencies := FALSE; { inform the programmer BEGIN { back-patch control line found, so extract } { the address and patch value } bp_address := COPY(scan_line,1,4); bp_pck-patch control lines have an "*" at } { location 5 } IF LENGTH(scan_line) > 5 { "wxyz*" } THEN BEGIN IF scan_line[5] = '*' THEN := IORESULT; { look for a back-patch control line } IF scan_error = gc_NoError THEN BEGIN trim_leading_blanks (scan_line); trim_trailing_blanks(scan_line); { note: ba WRITE(' [',line_count:5,'] '); END; IF line_count MOD 5 = 0 THEN WRITE('.'); line_count := line_count + 1; { get a data line from the file } READLN(inAsmFile,scan_line); scan_error { or an I/O error occurs } REPEAT BEGIN { inform user of the scanning activities } IF line_count MOD (5*50) = 0 THEN BEGIN WRITELN; ; IF scan_error <> gc_NoError THEN GOTO 111; { initialize the input file line counter & BP counter } line_count := 0; bp_kount := 0; { read lines from the input file until all the lines are read } : gt_BackPatch; { back-patch file record } BEGIN { ---------- scan_back_patches ---------- } {$IFC fDebug} BP('scan_back_patches'); {$ENDC} { open the input listing file } RESET(inAsmFile,asmInFile); scan_error := IORESULTcount : INTEGER; { listing file counter } scan_line : gt_Phrase; { a listing file data line } bp_address : STRING[4]; { address of a back-patch } bp_patch : STRING[4]; { value of a back-patch } back_patch #################################################################### } PROCEDURE scan_back_patches (VAR bp_kount : gt_BPIndex; VAR scan_error : gt_Error); LABEL 111; { error branch } VAR line_ing for back-patch control lines # INPUT : (none) # OUTPUT : bp_kount - number of back-patches found in listing # scan_error - scanning error result # NOTES : (none) {$ENDC} {$IFC fDebug} EP('setup_options'); {$ENDC} END; { ---------- setup_options ---------- } { #################################################################### # ROUTINE : scan_back_patches # PURPOSE : scan listing for lookased = TRUE') ELSE PD_WRITELN(' opcode_uppercased = FALSE'); IF format_options.opcode_frequencies THEN PD_WRITELN(' opcode_frequencies = TRUE') ELSE PD_WRITELN(' opcode_frequencies = FALSE'); IF format_options.kill_page_headers THEN PD_WRITELN(' kill_page_headers = TRUE') ELSE PD_WRITELN(' kill_page_headers = FALSE'); IF format_options.opcode_uppercased THEN PD_WRITELN(' opcode_uppercof the option states } {$IFC fDebug} PD_WRITELN('Option selection:'); IF format_options.kill_blank_lines THEN PD_WRITELN(' kill_blank_lines = TRUE') ELSE PD_WRITELN(' kill_blank_lines = FALSE'); atch := COPY(scan_line,7,LENGTH(scan_line)-6); { normalize the address and patch value } WHILE LENGTH(bp_address) < 4 DO bp_address := CONCAT('#',bp_address); WHILE LENGTH(bp_patch) < 4 DO bp_patch := CONCAT('#',bp_patch); { store the file back-patch data in a } { BP cache file record } back_p bp_1_address : STRING[4]; { string form of BP record address } bp_2_address : STRING[4]; { string form of BP record address } BEGIN { ---------- less_than ---------- } {$IFC fDebug AND fDebugAll} BP('less_than'); {$Eress fields of the BP records are compared #################################################################### } FUNCTION less_than (bp_1_data : gt_BackPatch; bp_2_data : gt_BackPatch) : BOOLEAN; VAR ############## # ROUTINE : less_than # PURPOSE : test if a BP record is less than another record # INPUT : bp_1_data - first BP record # bp_2_data - second BP record # OUTPUT : TRUE --> record 1 < record 2 # NOTES : only the addLEAN; { file sorted flag } swap_counter : INTEGER; { BP record swap counter } {$IFC fDebug} bug_error : gt_Error; { debugger I/O error } {$ENDC} { ###################################################### LABEL 666; { error branch } VAR bp_index : gt_BPIndex; { BP file record index } bp_A : gt_BackPatch; { a BP record } bp_B : gt_BackPatch; { a BP record neighbor } bp_file_sorted : BOOES : simple Bubble Sort used #################################################################### } PROCEDURE sort_back_patches ( bp_kount : gt_BPIndex; VAR sort_error : gt_Error); ---- } { #################################################################### # ROUTINE : sort_back_patches # PURPOSE : sort the BP cache file records # INPUT : bp_kount - BP record counter # OUTPUT : sort_error - sorting error result # NOT WRITELN(' (1 back-patch was found)') ELSE WRITELN(' (',bp_kount,' back-patches were found)'); END; {$IFC fDebug} EP('scan_back_patches'); {$ENDC} END; { ---------- scan_back_patches ------ CLOSE(inAsmFile); 111 : { branch here if an error occurs } { inform the user of the number of BPs found in listing } IF scan_error = gc_NoError THEN BEGIN WRITELN; IF bp_kount = 1 THEN END; END; END; END; UNTIL EOF(inAsmFile) OR (scan_error <> gc_NoError); { make certain screen output is on the next screen line } WRITELN; { close up shop } ecord to the BP cache file } write_back_patch (disk_cache,bp_kount,back_patch,scan_error); { bump the BP counter } bp_kount := bp_kount + 1; {$IFC fDebug} PD_WRITELN(CONCAT('bp_address = ',bp_address,' ', 'bp_patch = ',bp_patch)); {$ENDC} { write the BP r back_patch.patch [0] := bp_patch [1]; back_patch.patch [1] := bp_patch [2]; back_patch.patch [2] := bp_patch [3]; back_patch.patch [3] := bp_patch [4]; atch.address[0] := bp_address[1]; back_patch.address[1] := bp_address[2]; back_patch.address[2] := bp_address[3]; back_patch.address[3] := bp_address[4]; NDC} bp_1_address := '????'; { make strings have length of 4 } bp_2_address := '????'; bp_1_address[1] := bp_1_data.address[0]; bp_1_address[2] := bp_1_data.address[1]; bp_1_address[3] := bp_1_data.address[2]; bp_1_address[4] := bp_1_data.address[3]; bp_2_address[1] := bp_2_data.address[0]; bp_2_address[2] := bp_2_data.address[1]; bp_2_address[3] := bp_2_data.address[2]; bp_2_address[4] := bp_2_data.addres PD1String[6] := bp_A.patch [0]; PD1String[7] := bp_A.patch [1]; PD1String[8] := bp_A.patch [2]; PD1String[9] := bp_A.patch [3]; PD2/efgh'; PD1String[1] := bp_A.address[0]; PD1String[2] := bp_A.address[1]; PD1String[3] := bp_A.address[2]; PD1String[4] := bp_A.address[3]; d } IF less_than(bp_B,bp_A) THEN { swap away ... } BEGIN { inform the programmer of what is being swapped } {$IFC fDebug} PD1String := 'abcd1; { read the next element neighbor } read_back_patch(disk_cache,bp_index,bp_B,sort_error); IF sort_error <> gc_NoError THEN GOTO 666; { test if a swap needs to be performe read_back_patch(disk_cache,bp_index,bp_A,sort_error); IF sort_error <> gc_NoError THEN GOTO 666; { prepare to read the last read element's neighbor } bp_index := bp_index + ted } bp_index := 0; { Start at beginning of BP file } { scan the BP list file once checking for any swaps } REPEAT BEGIN { read a BP element } period of time. } REPEAT BEGIN {$IFC fDebug} PD_WRITELN(''); { show each individual swap session } {$ENDC} bp_file_sorted := TRUE; { Assume file elements are soraster sort I recommend the use of another sort } { algorithm, such as the Quick Sort or Shell Sort. } { but for most files the Bubble Sort is very good and } { gets the job done in a fairly short { otherwise, if a swap is performed, the list is not sorted, } { and it needs to be scanned again until all the elements are } { sorted. } { NOTE: for a fthe BP list searching for elements that need swapping. } { if an entire scan fails to produce a swap, then the list is } { sorted and the sort routine can stop. } WRITELN(' Back-patches are already sorted !'); END ELSE { non-minimal list found so sort list using slow Bubble Sort } BEGIN swap_counter := 0; { initialize the element swap counter } { scan IFC fDebug} BP('sort_back_patches'); {$ENDC} sort_error := gc_NoError; { assume all will be well } { sort the BP list iff a non-minimal list exists } IF bp_kount < 2 THEN { minimal list found, so don't sort it } BEGIN {$IFC fDebug AND fDebugAll} EP('less_than'); {$ENDC} END; { ---------- less_than ---------- } { #################################################################### } BEGIN { ---------- sort_back_patches ---------- } {$s[3]; { test BP records and return test result to caller } IF bp_1_address < bp_2_address THEN less_than := TRUE ELSE less_than := FALSE; String := 'abcd/efgh'; PD2String[1] := bp_B.address[0]; PD2String[2] := bp_B.address[1]; PD2String[3] := bp_B.address[2]; PD2String[4] := bp_B.address[3]; PD2String[6] := bp_B.patch [0]; PD2String[7] := bp_B.patch [1]; PD2String[8] := bp_B.patch [2]; PD2String[9] := bp_B.patch [3]; PD_WRI{ #################################################################### # ROUTINE : write_formatted_file # PURPOSE : write the formatted listing file to the output file # INPUT : bp_kount - number of BPs in listing file # OUTPUT : line_count _WRITELN(''); { leave some space before the next message } END; {$ENDC} {$IFC fDebug} EP('sort_back_patches'); {$ENDC} END; { ---------- sort_back_patches ---------- } PD_WRITELN(CONCAT(' Back-Patch : ',PD1String)); END; bp_index := bp_index + 1; { bump for next element } END; UNTIL (bp_index = bp_kount) OR (bug_error <> gc_NoError); PD.address[3]; PD1String[6] := bp_A.patch [0]; PD1String[7] := bp_A.patch [1]; PD1String[8] := bp_A.patch [2]; PD1String[9] := bp_A.patch [3]; PD1String := 'abcd/efgh'; PD1String[1] := bp_A.address[0]; PD1String[2] := bp_A.address[1]; PD1String[3] := bp_A.address[2]; PD1String[4] := bp_A { read BP element records until all are read } REPEAT BEGIN read_back_patch(disk_cache,bp_index,bp_A,bug_error); IF bug_error = gc_NoError THEN BEGIN IF sort_error = gc_NoError THEN IF bp_kount > 0 THEN BEGIN PD_WRITELN(''); PD_WRITELN('Sorted BP list:'); { a nice title } bp_index := 0; { start at the first BP element record } _NoError); { stop sorting when the file is sorted or for an error } END; WRITELN; { start printing on the next screen line } { send the final sorted BP list to the debugger for verification } {$IFC fDebug} UNTIL (bp_index = bp_kount - 1) OR (sort_error <> gc_NoError ); { stop sorting when every element is read or for an error } END; UNTIL bp_file_sorted OR (sort_error <> gc <> gc_NoError THEN GOTO 666; write_back_patch (disk_cache,bp_index,bp_A,sort_error); END; 666 : { Branch here if an error occurs } END; y writing each to the other's } { BP file position } write_back_patch (disk_cache,bp_index-1,bp_B,sort_error); IF sort_errorunter MOD 5 = 0 THEN WRITE('.'); swap_counter := swap_counter + 1; { mark list as NOT SORTED due to the swap } bp_file_sorted := FALSE; { swap the elements b IF swap_counter MOD (5*50) = 0 THEN BEGIN WRITELN; WRITE(' [',swap_counter:5,'] '); END; IF swap_coTELN(CONCAT('Swapping back-patches: ', PD1String,' <--> ',PD2String)); {$ENDC} { inform the user of the number of swaps } - input file line counter # write_error - write error result # NOTES : (none) #################################################################### } PROCEDURE write_formatted_file ( bp_kount : gt_BPIndex; VAR line_count : INTEGER; VAR write_error : gt_Error); LABEL 111,222; { error branches } CONST k_OCMax = 56; { number of 6502 opcodes } { special /// Assembler phrases opKodeList.list[47] := 'SEI'; opKodeList.list[48] := 'STA'; opKodeList.list[49] := 'STX'; opKodeList.list[50] := 'STY'; opKodeList.list[51] := 'TAX'; opKodeList.list[52] := 'TAY'; opKodeList.list[53] := 'TSX; opKodeList.list[40] := 'ROL'; opKodeList.list[41] := 'ROR'; opKodeList.list[42] := 'RTI'; opKodeList.list[43] := 'RTS'; opKodeList.list[44] := 'SBC'; opKodeList.list[45] := 'SEC'; opKodeList.list[46] := 'SED'; opKodeList.list[33] := 'LSR'; opKodeList.list[34] := 'NOP'; opKodeList.list[35] := 'ORA'; opKodeList.list[36] := 'PHA'; opKodeList.list[37] := 'PHP'; opKodeList.list[38] := 'PLA'; opKodeList.list[39] := 'PLP''; opKodeList.list[26] := 'INX'; opKodeList.list[27] := 'INY'; opKodeList.list[28] := 'JMP'; opKodeList.list[29] := 'JSR'; opKodeList.list[30] := 'LDA'; opKodeList.list[31] := 'LDX'; opKodeList.list[32] := 'LDY'; opKodeList.list[19] := 'CPX'; opKodeList.list[20] := 'CPY'; opKodeList.list[21] := 'DEC'; opKodeList.list[22] := 'DEX'; opKodeList.list[23] := 'DEY'; opKodeList.list[24] := 'EOR'; opKodeList.list[25] := 'INCodeList.list[12] := 'BVC'; opKodeList.list[13] := 'BVS'; opKodeList.list[14] := 'CLC'; opKodeList.list[15] := 'CLD'; opKodeList.list[16] := 'CLI'; opKodeList.list[17] := 'CLV'; opKodeList.list[18] := 'CMP'; opKodeList.list[ 5] := 'BCS'; opKodeList.list[ 6] := 'BEQ'; opKodeList.list[ 7] := 'BIT'; opKodeList.list[ 8] := 'BMI'; opKodeList.list[ 9] := 'BNE'; opKodeList.list[10] := 'BPL'; opKodeList.list[11] := 'BRK'; opKBEGIN { ---------- init_opcode_list ---------- } { setup the 6502 opcode mnemonic list } opKodeList.list[ 1] := 'ADC'; opKodeList.list[ 2] := 'AND'; opKodeList.list[ 3] := 'ASL'; opKodeList.list[ 4] := 'BCC'; # INPUT : (none) # OUTPUT : (none) # NOTES : (none) #################################################################### } PROCEDURE init_opcode_list; VAR oc_index : 1..k_OCMax; { opcode list element index } gt_BackPatch; { BP data } asm_line : gt_Phrase; { listing data line } { #################################################################### # ROUTINE : init_opcode_list # PURPOSE : initialize the opcode mnemonic & frequency list [1..k_OCMax] OF t_OCMnemonic; freq : ARRAY [1..k_OCMax] OF INTEGER; END; VAR opKodeList : t_OpKodeList; { opcode list } bp_index : gt_BPIndex; { BP index } bp_data : eger (> 32767) } t_BIG_Integer = INTEGER[10]; { [///] } { 6502 opcode mnemonic } t_OCMnemonic = STRING[3]; { 6502 opcode mnemonic & frequency list } t_OpKodeList = RECORD list : ARRAY k_Phr_MinSpace = 'Current minimum space is'; k_Phr_AsmEnd = 'Assembly complete:'; { formatted listing file summary message (nice to have) } k_Phr_Finis = 'That''s all, Folks ...'; TYPE { very large int used for parsing purposes } k_Phr_PAGE = 'PAGE -'; k_Phr_MemAvail = 'Current memory available:'; k_Phr_Blocks = 'blocks for procedure code'; k_Phr_ABSymbol = 'AB - Absolute'; k_Phr_PBSymbol = 'PB - Public'; '; opKodeList.list[54] := 'TXA'; opKodeList.list[55] := 'TXS'; opKodeList.list[56] := 'TYA'; { initialize the opcode frequency list } FOR oc_index := 1 TO k_OCMax DO opKodeList.freq[oc_index] := 0; END; { ---------- init_opcode_list ---------- } { END OF : ASM.FORMAT.2 } : t_BIG_Integer; { average opcode frequency } BEGIN { ---------- show_opcode_frequencies ---------- } { output the title of this extra table } WRITELN(outAsmFile); WRITELN(outAsmFile,k_Title); WRITELN(histogram loop end value } one_oc_found : BOOLEAN; { at least 1 non-0 freq found } min_freq : INTEGER; { minimum opcode frequency } max_freq : INTEGER; { maximum opcode frequency } avg_freq oc_unused : INTEGER; { count of # of unused opcodes } histo_count : INTEGER; { histogram output index } histo_factor : t_BIG_Integer; { histogram output scale factor } histo_loop : t_BIG_Integer; { _MaxHistoChars = 75; { maximum no. of histogram chars } VAR oc_index : 0..k_OCMax; { opcode list index } oc_counter : INTEGER; { count of # of opcodes used } ######### } PROCEDURE show_opcode_frequencies (VAR sof_error : gt_Error); LABEL 666; { error handler location } CONST k_Title = '6502 OPCODE STATIC FREQUENCIES'; k_Indent = ' '; { indentation } k : opcode frequencies outputted as a two lists; the first # lists the used opcodes with their frequency values and # histograms, and the second lists the unused opcodes ########################################################### { #################################################################### # ROUTINE : show_opcode_frequencies # PURPOSE : output to the output listing file the opcode freq. list # INPUT : (none) # OUTPUT : sof_error - output error result # NOTESO^outAsmFile); sof_error := IORESULT; IF sof_error <> gc_NoError THEN GOTO 666; { determine the minimim and maximum opcode frequency values } min_freq := MAXINT; { init minimum frequency value } max_freq := 0; { init maximum frequency value } oc_index := 0; { start at the list beginning less 1 } REPEAT BEGIN oc_index := oc_index + 1; IF (opKodeList.freq[oc_index] > WRITE(outAsmFile,'*'); WRITELN(outAsmFile); { test for any output errors } sof_error := IORESULT; END; END; END; END ELSE histo_loop := opKodeList.freq[oc_index]; { output the appropriate number of asterix ... } FOR histo_count := 1 TO TRUNC(histo_loop) DO BEGIN { avoid integer overflow } histo_loop := opKodeList.freq[oc_index]; histo_loop := histo_loop * 100; histo_loop := histo_loop DIV histo_factor; sof_error := IORESULT; { output the opcode frequency histogram } IF sof_error = gc_NoError THEN BEGIN IF max_freq > k_MaxHistoChars THEN E BEGIN IF opKodeList.freq[oc_index] = max_freq THEN WRITE(outAsmFile,' M ') ELSE WRITE(outAsmFile,' | '); END; opKodeList.freq[oc_index]:4); { indicate the min and max frequency value(s) } IF opKodeList.freq[oc_index] = min_freq THEN WRITE(outAsmFile,' m ') ELS oc_counter := oc_counter + 1; { output the opcode mnemonic and frequency value } WRITE(outAsmFile,k_Indent); { indentation } WRITE(outAsmFile,opKodeList.list[oc_index],' : ', he listing } one_oc_found := TRUE; { compute part of average opcode statistic } avg_freq := avg_freq + opKodeList.freq[oc_index]; { tally the number of opcodes processed } code record } oc_index := oc_index + 1; { output the histogram for a non-zero frequency } IF opKodeList.freq[oc_index] > 0 THEN BEGIN { assume not a single opcode was found in tcounter := 0; { init the opcode tally } avg_freq := 0; { init opcode average frequency value } oc_index := 0; { start at the list beginning less 1 } REPEAT BEGIN { prepare for the next op histo_factor := 1; { loop thru each opcode and output the opcode mnemonic and } { its frequency count followed by a simple histogram } one_oc_found := FALSE; { assume no opcodes are in file } oc_ certain integer oveflow does not happen } histo_factor := max_freq; histo_factor := histo_factor * 100; { <--- important } histo_factor := histo_factor DIV k_MaxHistoChars; END ELSE max_freq := opKodeList.freq[oc_index]; END; END; UNTIL (oc_index = k_OCMax); { compute the histogram output width factor } IF max_freq > k_MaxHistoChars THEN BEGIN { make 0) AND (opKodeList.freq[oc_index] < min_freq) THEN BEGIN min_freq := opKodeList.freq[oc_index]; END; IF opKodeList.freq[oc_index] > max_freq THEN BEGIN UNTIL (oc_index = k_OCMax) OR (sof_error <> gc_NoError); { output the min and max frequency values } IF sof_error = gc_NoError THEN BEGIN IF min_freq = MAXINT THEN min_freq := 0; WRITELN(outAsmFile); WRITELN(outAsmFile,k_Indent, 'Minimum frequency = ',min_freq:4); WRITELN(outAsmFile,k_Indent, 'Maximum frequency = ',max_freq:4);none) # NOTES : opcode frequency list is modified for each opcode #################################################################### } PROCEDURE handle_opcode_line; VAR ch_index : INTEGER; { char. index of line } FALSE; END; { ---------- alpha ---------- } { #################################################################### # ROUTINE : handle_opcode_line # PURPOSE : handle a listing line that contains an opcode # INPUT : (none) # OUTPUT : ( FUNCTION alpha (ch : CHAR) : BOOLEAN; BEGIN { ---------- alpha ---------- } IF ((ch >= 'A') AND (ch <= 'Z')) OR ((ch >= 'a') AND (ch <= 'z')) THEN alpha := TRUE ELSE alpha := is alphabetic (a..z , A..Z) # INPUT : ch - character to test # OUTPUT : alpha - TRUE --> character is alphabetic # NOTES : (none) #################################################################### } tAsmFile); sof_error := IORESULT; END; END; { ---------- show_opcode_frequencies ---------- } { #################################################################### # ROUTINE : alpha # PURPOSE : test if a characterund in the file )') ELSE BEGIN WRITELN(outAsmFile,k_Indent,'Program opcode usage: ', (oc_counter * 100 DIV k_OCMax):3,' %'); END; WRITELN(ou { output some statistical data for the user } IF sof_error = gc_NoError THEN BEGIN IF NOT(one_oc_found) THEN WRITELN(outAsmFile,k_Indent, '( no opcodes were fof_error = gc_NoError THEN BEGIN WRITELN(outAsmFile); WRITELN(outAsmFile); sof_error := IORESULT; END; END; 666 : { branch here if an error occurs } ],' '); sof_error := IORESULT; END; END; UNTIL (oc_index = k_OCMax) OR (sof_error <> gc_NoError); { skip some lines before outputting the summary } IF so WRITELN(outAsmFile); WRITE (outAsmFile,' '); { indentation } END; oc_unused := oc_unused + 1; WRITE(outAsmFile,opKodeList.list[oc_index REPEAT BEGIN oc_index := oc_index + 1; IF opKodeList.freq[oc_index] = 0 THEN BEGIN IF oc_unused MOD 16 = 0 THEN BEGIN ndent,'Unused opcodes:'); sof_error := IORESULT; IF sof_error <> gc_NoError THEN GOTO 666; oc_unused := 0; { init unused opcode counter } oc_index := 0; { start at the list beginning less 1 } y = ',avg_freq:4); END; END; { list all the unused opcodes in a nice tabular format } IF sof_error = gc_NoError THEN BEGIN WRITELN(outAsmFile); WRITELN(outAsmFile,k_I IF oc_counter > 0 THEN BEGIN avg_freq := avg_freq DIV oc_counter; WRITELN(outAsmFile); WRITELN(outAsmFile,k_Indent, 'Average frequenc label_char_found : BOOLEAN; { assembler label found flag } opcode_x_posn : INTEGER; { opcode line starting position } the_opcode : gt_Phrase; { opcode line name } index : INTEGER; { opcode list index } opcode_found : BOOLEAN; { opcode found in list flag } { #################################################################### # ROUTINE : comment_line # PURPOSE : test if an h_index < LENGTH(asm_line) THEN BEGIN IF asm_line[ch_index] = '.' THEN BEGIN { assembler directive found (ignore it) } { remember the sta IF NOT(label_char_found) THEN ch_index := ch_index + 1; END; UNTIL label_char_found OR (ch_index = LENGTH(asm_line)); { opcode should now be found } IF c BEGIN label_char_found := FALSE; IF alpha(asm_line[ch_index]) OR (asm_line[ch_index] = '.') THEN label_char_found := TRUE; ex = LENGTH(asm_line)); END; { extract opcode from line } IF ch_index < LENGTH(asm_line) THEN BEGIN { scan line looking for the opcode } REPEAT h_index] = '_') OR (asm_line[ch_index] = ':') OR (asm_line[ch_index] = '$') THEN label_char_found := TRUE; UNTIL NOT(label_char_found) OR (ch_indN BEGIN { skip over line label } REPEAT ch_index := ch_index + 1; label_char_found := FALSE; IF alpha(asm_line[ch_index]) OR (asm_line[c { start at the beginning of the user's assembly text } ch_index := 29; { test if line begins with an assembler label } IF alpha(asm_line[ch_index]) OR (asm_line[ch_index] = '$') THE { parse line iff line exists and is not a comment line } IF (LENGTH(asm_line) >= 29) AND NOT(comment_line) THEN BEGIN { non-empty (and non-comment) code line found } END; { ---------- comment_line ---------- } { #################################################################### } BEGIN { ---------- handle_opcode_line ---------- } {$IFC fDebug} BP('handle_opcode_line'); {$ENDC} UNTIL semi_colon_found OR (asm_line[c_index] <> ' ') OR (c_index = LENGTH(asm_line)); END; { return line kind to caller } comment_line := semi_colon_found; REPEAT BEGIN IF asm_line[c_index] = ';' THEN semi_colon_found := TRUE ELSE c_index := c_index + 1; END; semi_colon_found := FALSE; { note: comment lines have at least 29 characters } IF LENGTH(asm_line) >= 29 THEN BEGIN { scan line looking for a ";" character } c_index := 29; VAR semi_colon_found : BOOLEAN; { ";" found flag } c_index : INTEGER; { line character index } BEGIN { ---------- comment_line ---------- } { assume line is not a comment line } assembler listing line is a comment line # INPUT : (none) # OUTPUT : comment_line - TRUE --> comment line found # NOTES : (none) #################################################################### } FUNCTION comment_line : BOOLEAN; rting position of directive } opcode_x_posn := ch_index; { extract the 1st directive character ('.') } the_opcode := '?'; the_opcode[1] := asm_line[ch_index]; { extract directive characters from line } REPEAT ch_index := ch_index + 1; IF ch_ the_opcode[index]; { find opcode index in opcode mnemonic list } IF format_options.opcode_frequencies THEN BEGIN { uppercase_phrase(the_opcode) ELSE lowercase_phrase(the_opcode); FOR index := 1 TO LENGTH(the_opcode) DO asm_line[opcode_x_posn+index-1] := (CONCAT('the_opcode = "',the_opcode,'"')); {$ENDC} { uppercase/lowercase the opcode } IF format_options.opcode_uppercased THEN OR (ch_index = LENGTH(asm_line)); { opcode is now extracted into 'the_opcode' } {$IFC fDebug} PD_WRITELN the_opcode[LENGTH(the_opcode)] := asm_line[ch_index]; END; END; UNTIL NOT(alpha(asm_line[ch_index])) IF alpha(asm_line[ch_index]) THEN BEGIN { get next opcode character } the_opcode := CONCAT(the_opcode,'?'); { extract opcode characters from line } REPEAT ch_index := ch_index + 1; IF ch_index <= LENGTH(asm_line) THEN BEGIN opcode_x_posn := ch_index; { extract the 1st opcode character } the_opcode := '?'; the_opcode[1] := asm_line[ch_index]; asm_line[opcode_x_posn+index-1] := the_opcode[index]; END ELSE BEGIN { remember the starting position of opcode } pcode_uppercased THEN uppercase_phrase(the_opcode) ELSE lowercase_phrase(the_opcode); FOR index := 1 TO LENGTH(the_opcode) DO PD_WRITELN (CONCAT('asm directive = "',the_opcode,'"')); {$ENDC} { uppercase/lowercase the directive } IF format_options.o END; UNTIL NOT(alpha(asm_line[ch_index])) OR (ch_index = LENGTH(asm_line)); { directive is now extracted into 'the_opcode' } {$IFC fDebug} the_opcode := CONCAT(the_opcode,'?'); the_opcode[LENGTH(the_opcode)] := asm_line[ch_index]; END; index <= LENGTH(asm_line) THEN BEGIN IF alpha(asm_line[ch_index]) THEN BEGIN { get next directive character } opcode MUST be uppercased for search } uppercase_phrase(the_opcode); {$IFC fDebug} PD_WRITELN (CONCAT('Searching for "',the_opcode,'"')); {$ENDC} index := 0; REPEAT BEGIN his routine decrements all case II BPs } PROCEDURE decrement_BP_address(VAR the_bp_data : gt_BackPatch); VAR carry : INTEGER;{ carry value from the decrement } BEGIN { ---------- decrement_BP_addres } { e.g.: 0042| 4C **** <--- line to patch } { 0043* 4500 <--- BP control line } { } { t { the /// assembler for case II back-patches stores the } { patch address with a value that is greater by one than } { the actual address of the patch. } { ]; { listing line address data } patch_case : 1..3; { patch case (I,II,III) } bp_posn : INTEGER; { postion of BP "*" field in line } patch_made : BOOLEAN; { patch made flag } patched #################################################################### } PROCEDURE test_and_handle_BP_line (VAR thbl_error : gt_Error); VAR test_bp_data : gt_BackPatch; { bp data to test } addr_data : STRING[4 address and if a match occurs patch the # output line # INPUT : (none) # OUTPUT : thbl_error - error result # NOTES : this routine is the heart of the entire program since # it handles all listing lines which need to be END; { ---------- handle_opcode_line ---------- } { #################################################################### # ROUTINE : test_and_handle_BP_line # PURPOSE : test the current line address against the current BP # record END; END ELSE { empty code line, so return to caller } BEGIN { bye ... } END; {$IFC fDebug} EP('handle_opcode_line'); {$ENDC} opKodeList.freq[index] + 1; END; END; { asm_line now contains the modified line } END; END; {$IFC fDebug} PD_WRITELN (CONCAT('"',the_opcode,'" found')); {$ENDC} opKodeList.freq[index] := (CONCAT('"',the_opcode,'" NOT found')); {$ENDC} END ELSE BEGIN ot found - most likely due } { to opcode being a macro name } {$IFC fDebug} PD_WRITELN = FALSE; END; UNTIL (index = k_OCMax) OR opcode_found; IF NOT(opcode_found) THEN BEGIN { opcode n index := index + 1; IF the_opcode = opKodeList.list[index] THEN opcode_found := TRUE ELSE opcode_found :s ---------- } {$IFC fDebug} BP('decrement_BP_address'); {$ENDC} WITH the_bp_data DO BEGIN address[3] := CHR( ORD(address[3]) - 1 ); carry := 0; IF NOT(address[3] IN ['0'..'9','A'..'F']) THEN BEGIN IF ORD(address[3]) < ORD('0') THEN BEGIN address[3] := 'F'; carry := 1; END (addr_data[2] = test_bp_data.address[1]) AND (addr_data[3] = test_bp_data.address[2]) AND (addr_data[4] = test_bp_data.address[3]) THEN BEGIN { addresses match } {$IFC fDebug} ent BP address for case I back-patches } IF (patch_case = 1) THEN decrement_BP_address(test_bp_data); { test for BP & line address match } IF (addr_data[1] = test_bp_data.address[0]) AND 3 : PD_WRITELN('Patch case III found in asm line'); OTHERWISE PD_WRITELN('Invalid patch case found in asm line'); END; {$ENDC} test_bp_data := bp_data; { decrem patch_case := 3; {$IFC fDebug} CASE patch_case OF 1 : PD_WRITELN('Patch case I found in asm line'); 2 : PD_WRITELN('Patch case II found in asm line'); IF (asm_line[7] IN ['0'..'9','A'..'F']) THEN BEGIN IF asm_line[9] = ' ' THEN patch_case := 1 ELSE patch_case := 2; END ELSE (asm_line[10] = '*' ) THEN BEGIN { extract line address from assembly listing file line } addr_data := COPY(asm_line,1,4); { determine assembly line patch case kind } { Case II : 0038| D0** } { Case III : 0165| **** } IF (LENGTH(asm_line) >= 7 ) AND (asm_line[ 7] IN ['0'..'9','A'..'F','*']) AND } { 1234567890123 } { ------------- } { Case I : 0022| 4C **** } _NoError; { assume all will go well } { test for line address and current BP address match. } { } { Note: Three cases exist with examples following; } { EP('decrement_BP_address'); {$ENDC} END; { ---------- decrement_BP_address ---------- } BEGIN { ---------- test_and_handle_BP_line ---------- } {$IFC fDebug} BP('test_and_handle_BP_line'); {$ENDC} thbl_error := gc address[1] := 'F'; carry := 1; END ELSE address[1] := '9'; END; address[0] := CHR( ORD(address[0]) - carry); END; {$IFC fDebug} ORD(address[1]) - carry); carry := 0; IF NOT(address[1] IN ['0'..'9','A'..'F']) THEN BEGIN IF ORD(address[1]) < ORD('0') THEN BEGIN IF ORD(address[2]) < ORD('0') THEN BEGIN address[2] := 'F'; carry := 1; END ELSE address[2] := '9'; END; address[1] := CHR( ELSE address[3] := '9'; END; address[2] := CHR( ORD(address[2]) - carry); carry := 0; IF NOT(address[2] IN ['0'..'9','A'..'F']) THEN BEGIN PD1String := '????'; PD1String[1] := test_bp_data.address[0]; PD1String[2] := test_bp_data.address[1]; PD1String[3] := test_bp_data.address[2]; PD1String[4] := test_bp_data.address[3]; PD_WRITELN(CONCAT('Match found: Asm addr = ',addr_data)); PD_WRITELN(CONCAT(' BP addr = ',PD1String)); {$ENDC} bp_index, bp_data, thbl_error); END; END; END; END; { on exit, 'asm_line' is modifi thbl_error := gc_E_TooManyBPs; END ELSE { read the next BP list record } BEGIN read_back_patch(disk_cache, IF (thbl_error = gc_NoError) AND patch_made THEN BEGIN bp_index := bp_index + 1; IF bp_index > bp_kount THEN BEGIN { ??? FATAL ERROR ??? } .patch[2]; asm_line[bp_posn + 1] := test_bp_data.patch[3]; END; END; END; { fetch next BP record from BP file } _E_RelAddr; END ELSE BEGIN { place BP patch into line } patch_made := TRUE; asm_line[bp_posn + 0] := test_bp_data BEGIN { ??? FATAL ERROR ??? } {$IFC fDebug} PD_WRITELN('>>> FATAL ERROR : "**" not found'); {$ENDC} thbl_error := gc {$IFC fDebug} PD_WRITELN('Case II : eg - 0038| D0**'); {$ENDC} bp_posn := POS('**',asm_line); IF bp_posn = 0 THEN END; END; END ELSE BEGIN { check for BP case II } IF asm_line[9] = '*' THEN BEGIN { BP case II } asm_line[bp_posn + 1] := test_bp_data.patch[1]; asm_line[bp_posn + 2] := test_bp_data.patch[2]; asm_line[bp_posn + 3] := test_bp_data.patch[3]; END ELSE BEGIN { place BP patch into line } patch_made := TRUE; asm_line[bp_posn + 0] := test_bp_data.patch[0]; {$IFC fDebug} PD_WRITELN ('>>> FATAL ERROR : "****" not found'); {$ENDC} thbl_error := gc_E_AbsAddr; PD_WRITELN('Case III : eg - 0165| ****'); {$ENDC} bp_posn := POS('****',asm_line); IF bp_posn = 0 THEN BEGIN { ??? FATAL ERROR ??? } BEGIN { BP case I or III } {$IFC fDebug} IF patch_case = 1 THEN PD_WRITELN('Case I : eg - 0022| 4C ****') ELSE { assume patch will not be made } patch_made := FALSE; IF test_bp_data.patch[0] <> '#' THEN BEGIN { check for BP case I or III } IF (patch_case = 1) OR (patch_case = 3) THEN ed with a back-patch or unaltered } {$IFC fDebug} EP('test_and_handle_BP_line'); {$ENDC} END; { ---------- test_and_handle_BP_line ---------- } { END OF : ASM.FORMAT.4 } O^ # lines which the user, thru the format options, can # include or remove from the output listing file #################################################################### } PROCEDURE handle_special_line; CONST ################################## # ROUTINE : handle_special_line # PURPOSE : handle output of any special assembler listing lines # INPUT : (none) # OUTPUT : (none) # NOTES : special lines include the header page line and other _line,1,50),' ...'); END ELSE PD1String := asm_line; PD_WRITELN(CONCAT('asm_line = "',PD1String,'"')); END; { ---------- debug_asm_line ---------- } {$ENDC} { ############################################################################ } {$IFC fDebug} PROCEDURE debug_asm_line; BEGIN { ---------- debug_asm_line ---------- } IF LENGTH(asm_line) > 50 THEN BEGIN PD1String := CONCAT(COPY(asm{ #################################################################### # ROUTINE : debug_asm_line # PURPOSE : display a listing line to the debugger output file # INPUT : (none) # OUTPUT : (none) # NOTES : (none) ########################## { read an input line and test for an I/O error } READLN(inAsmFile,asm_line); write_error := IORESULT; END; { ---------- read_input_file_text_line ---------- } appropriate } IF line_count MOD (10*50) = 0 THEN BEGIN WRITELN; WRITE(' [',line_count:5,'] '); END; IF line_count MOD 10 = 0 THEN WRITE('.'); line_count := line_count + 1;us is displayed #################################################################### } PROCEDURE read_input_file_text_line; BEGIN { ---------- read_input_file_text_line ---------- } { output the input file line counter tally if { #################################################################### # ROUTINE : read_input_file_text_line # PURPOSE : read a line from the input listing file # INPUT : (none) # OUTPUT : (none) # NOTES : while reading lines a dynamic stat k_SymTableTitle = 'SYMBOL TABLE DUMP'; VAR min_space_msg_found : BOOLEAN; { min. mem. space message found } sym_obj_count : INTEGER; { symbol table object counter } { #################################################################### # ROUTINE : shorten_symbol_line # PURPOSE : output assembler symbol table line in a shorter format # INPUT : (none) # OUTPUT : (none) # NOTES : the /// assembler lists the symbol table lines with a # very lo WRITELN(outAsmFile); WRITELN(outAsmFile); WRITELN(outAsmFile,k_SymTableTitle); WRITELN(outAsmFile); WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} IF ((POS(k_Phr_ABSymbol,asm_line) > 0) AND (POS(k_Phr_ABSymbol,asm_line) < 29)) THEN BEGIN {$IFC fDebug} PD_WRITELN('Symbol table prelude start found'); {$ENDC} } { #################################################################### } BEGIN { ---------- handle_special_line ---------- } {$IFC fDebug} BP('handle_special_line'); {$ENDC} { test for symbol table prelude line } AsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} write_error := IORESULT; END; {$IFC fDebug} EP('shorten_symbol_line'); {$ENDC} END; { ---------- shorten_symbol_line ---------- END; UNTIL (LENGTH(asm_line) = 0) OR (write_error <> gc_NoError); END ELSE { (strange) non-symbol line found (so output it) } BEGIN WRITELN(out WRITE(outAsmFile,the_symbol,' '); write_error := IORESULT; END ELSE asm_line := ''; { make an empty string } END; railing_blanks(the_symbol); IF LENGTH(the_symbol) = 17 THEN BEGIN the_symbol := CONCAT(the_symbol,'|'); the_symbol[17] := ' '; term_posn > 0 THEN BEGIN the_symbol := COPY(asm_line,1,term_posn); DELETE(asm_line,1,term_posn); trim_leading_blanks (the_symbol); trim_t sym_obj_count := sym_obj_count + 1; { determine where next symbol field ends } term_posn := POS('|',asm_line); { output the extracted symbol field } IF 123456789-1234567 } REPEAT BEGIN { test for start of new line } IF sym_obj_count MOD k_SymbolsPerLine = 0 THEN WRITELN(outAsmFile); parsing easier } asm_line := CONCAT(asm_line,'|'); { extract one symbol field from the line and output it } { sample symbol table entry: "XBASIC LB FEB0|" } { ---------- } {$IFC fDebug} BP('shorten_symbol_line'); {$ENDC} { extract symbol fields from the symbol table line } IF (asm_line[17] = '|') THEN BEGIN { add "|" to symbol line end to make k_SymbolsPerLine = 5; { no. symbols per output line } VAR the_symbol : gt_Phrase; { symbol table line } term_posn : INTEGER; { symbol termination position } BEGIN { ---------- shorten_symbol_lineng format which for most printers is too much # so this routine reformats these lines in a shorter format #################################################################### } PROCEDURE shorten_symbol_line; CONST write_error := IORESULT; END ELSE { test for end of symbol table prelude } IF ((POS(k_Phr_PBSymbol,asm_line) > 0) AND (POS(k_Phr_PBSymbol,asm_line) < 29)) THEN BEGIN {$IFC fDebug} PD_WRITELN('Symbol table prelude end found'); {$ENDC} WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} write_error := IORESULT; END ELSE { test for assembly complete line } IF ((POS(k_Phr_AsmEnd,asm_line) > 0) AND (POS(k_Phr_AsmEnd,asm_line) < 29)) THEN BEGIN {$IFC fDebug} PD_WRITEL{ start a new output line } IF write_error = gc_NoError THEN BEGIN WRITELN(outAsmFile); write_error := IORESULT; END; END; D; END; END; END; UNTIL EOF(inAsmFile) OR min_space_msg_found OR (write_error <> gc_NoError); {$IFC fDebug} debug_asm_line; {$ENDC} END; END; EN ELSE BEGIN WRITELN(outAsmFile,asm_line); write_error := IORESULT; IF LENGTH(asm_line) >= 17 THEN BEGIN shorten_symbol_line; END debug_asm_line; {$ENDC} END; END ELSE BEGIN BEGIN WRITELN(outAsmFile,asm_line); write_error := IORESULT; {$IFC fDebug} BEGIN { special page header found } IF NOT (format_options.kill_page_headers) THEN BEGIN IF ((POS(k_Phr_PAGE,asm_line) > 0) AND (POS(k_Phr_PAGE,asm_line) < 29)) THEN AND (POS(k_Phr_MinSpace,asm_line) < 29)) THEN BEGIN min_space_msg_found := TRUE; END ELSE trim_leading_blanks (asm_line); trim_trailing_blanks(asm_line); IF LENGTH(asm_line) > 0 THEN BEGIN IF ((POS(k_Phr_MinSpace,asm_line) > 0) min_space_msg_found := FALSE; REPEAT BEGIN read_input_file_text_line; IF write_error = gc_NoError THEN BEGIN { scan symbol table and restructure it so that it is } { not so damn wide. } IF write_error = gc_NoError THEN BEGIN sym_obj_count := 0; N('Assembly complete message found'); {$ENDC} WRITELN(outAsmFile); WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} write_error := IORESULT; { output all the lines below "Assembly complete" } IF write_error = gc_NoError THEN REPEAT BEGIN read_input_file_text_line; IF write_error = gc_NoError THEN ELSE { non-empty line found } BEGIN { test if a special header line exists } IF ((POS(k_Phr_PAGE ,asm_line) > 0) AND (POS(k_Phr_PAGE ,asm_line) < 29)} IF NOT(format_options.kill_blank_lines) THEN BEGIN WRITELN(outAsmFile); {$IFC fDebug} debug_asm_line; {$ENDC} END; END ix } IF write_error = gc_NoError THEN BEGIN trim_leading_blanks (asm_line); trim_trailing_blanks(asm_line); IF LENGTH(asm_line) = 0 THEN BEGIN { blank line found Error THEN GOTO 111; END; { perform the major BP fix loop } REPEAT { inAsmFile ---> outAsmFile } BEGIN read_input_file_text_line; { get input listing line } { look for a BP line to f { and replacing these locations with the current BP record } { until all the BP locations are fixed. } read_back_patch(disk_cache,bp_index,bp_data,write_error); IF write_error <> gc_No 0; { start at the beginning of the BP list } { read the first BP record in preparation for the major } { loop which reads the input file searching for BP locations } ; { initialize opcode frequency statistics } IF format_options.opcode_frequencies THEN init_opcode_list; line_count := 0; { setup the input file line counter } IF bp_kount > 0 THEN BEGIN bp_index :=put formatted files } RESET(inAsmFile,asmInFile); write_error := IORESULT; IF write_error <> gc_NoError THEN GOTO 222; REWRITE(outAsmFile,asmOutFile); write_error := IORESULT; IF write_error <> gc_NoError THEN GOTO 222 BEGIN { ---------- write_formatted_file ---------- } {$IFC fDebug} BP('write_formatted_file'); {$ENDC} {$IFC fDebug} PD_WRITELN('Opening the input and output files'); {$ENDC} { open the input listing and out END; END; {$IFC fDebug} EP('handle_special_line'); {$ENDC} END; { ---------- handle_special_line ---------- } { #################################################################### } put } IF (LENGTH(asm_line) > 5) AND (asm_line[5] <> '*') THEN BEGIN WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} write_error := IORESULT; D; UNTIL EOF(inAsmFile) OR (write_error <> gc_NoError); END ELSE { line found which does not match any of the others } BEGIN { make certain no back-patch definition lines are out WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} write_error := IORESULT; END; END; EN BEGIN trim_leading_blanks (asm_line); trim_trailing_blanks(asm_line); IF LENGTH(asm_line) > 0 THEN BEGIN ) OR ((POS(k_Phr_MemAvail,asm_line) > 0) AND (POS(k_Phr_MemAvail,asm_line) < 29)) OR ((POS(k_Phr_Blocks ,asm_line) > 0) AND (POS(k_Phr_Blocks ,asm_line) < 29)) THEN BEGIN { special page header found } IF NOT(format_options.kill_page_headers) THEN BEGIN WRITELN(outAsmFile,asm_line); { 111 : { branch here if an I/O error occurs } {$IFC fDebug} PD_WRITELN('Closing the input and output files'); {$ENDC} { close up shop } IF write_error <> gc_NoError THEN CLOSE(outAsmFile,PURGE) IF write_error = gc_NoError THEN BEGIN WRITELN(outAsmFile); WRITELN(outAsmFile,'(',gc_PgmVersion,') ',k_Phr_Finis); WRITELN(outAsmFile); END; END; { output the opcode frequencies } show_opcode_frequencies(write_error); { add a proper farewell message to the listing along with } { this program's version number for archival purposes } t_options.opcode_frequencies THEN BEGIN {$IFC fDebug} PD_WRITELN('Outputting opcode frequency list'); {$ENDC} WRITELN; WRITELN(' writing opcode frequency statistics ...'); UNTIL EOF(inAsmFile) OR (write_error <> gc_NoError); WRITELN; { skip a screen line after the formatting tallies } { output the opcode frequency statistics (if desired) } IF write_error = gc_NoError THEN IF forma END; END; END; IF write_error = gc_NoError THEN write_error := IORESULT; { test for any I/O errors } END; END; END ELSE { generic (non-opcode) line found } BEGIN WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} END ELSE { special line found } BEGIN handle_special_line; END; END; { back-patch line found - ignore it } {$IFC fDebug} PD_WRITELN('Back-patch line found'); {$ENDC} END ELSE { non-code line found } BEGIN IF asm_line[5] = '*' THEN BEGIN e_error = gc_NoError THEN BEGIN WRITELN(outAsmFile,asm_line); {$IFC fDebug} debug_asm_line; {$ENDC} END; ndle_opcode_line; { test and handle BP line (if found) } IF bp_kount > 0 THEN test_and_handle_BP_line(write_error); IF writ BEGIN { possible code line found } IF asm_line[5] = '|' THEN BEGIN { modify opcode line as appropriate } ha$IFC fDebug} debug_asm_line; {$ENDC} END; END ELSE { header line not found } BEGIN IF LENGTH(asm_line) >= 5 THEN ELSE CLOSE(outAsmFile,LOCK); CLOSE(inAsmFile); 222 : { branch here if an Open error occurs } {$IFC fDebug} EP('write_formatted_file'); {$ENDC} END; { ---------- write_formatted_file ---------- } { #################################################################### } BEGIN { ---------- pretty_format_user_file ---------- } {$IFC fDebug} BP('pretty_format_user_file'); {$ENDC} {$IFC fDebug} PD_WRITELN(CONCAT('asmInFile = "',asmInFilty_format_user_file'); {$ENDC} END; { ---------- pretty_format_user_file ---------- } { END OF : ASM.FORMAT.5 } flush_block_cache(disk_cache,io_error); {$IFC fDebug} IF io_error <> gc_NoError THEN PD_WRITELN('Calling flush_block_cache failed'); {$ENDC} 777 : { branch here if cache error occured } {$IFC fDebug} EP('pret WRITELN('*** NOTE: Pretty formatting failed at line # ', line_out_count,' [',io_error,']') ELSE WRITELN('*** NOTE: Pretty formatting failed [',io_error,']'); { Close up shop } {$IFC fDebug} IF io_error <> gc_NoError THEN PD_WRITELN('Calling write_formatted_file failed'); {$ENDC} { Handle any formatting errors } 666: IF io_error <> gc_NoError THEN IF line_out_count > 0 THEN PD_WRITELN('Calling sort_back_patches failed'); {$ENDC} { perform the actual formatted file writing } WRITELN; WRITELN(' writing formatted output file ...'); write_formatted_file(bp_count,line_out_count,io_error); { sort the BP file } WRITELN; WRITELN(' sorting assembly file back-patches ...'); sort_back_patches(bp_count,io_error); IF io_error <> gc_NoError THEN GOTO 666; {$IFC fDebug} IF io_error <> gc_NoError THEN tches ...'); scan_back_patches(bp_count,io_error); IF io_error <> gc_NoError THEN GOTO 666; {$IFC fDebug} IF io_error <> gc_NoError THEN PD_WRITELN('Calling scan_back_patches failed'); {$ENDC} {$ENDC} WRITELN('*** NOTE: Initializing BP cache failed [',io_error,']'); GOTO 777; END; { scan the listing file looking for back-patch control lines } WRITELN; WRITELN(' scanning assembly file for back-pa line_out_count := 0; { initialize the BP file cache } init_block_cache(disk_cache,io_error); IF io_error <> gc_NoError THEN BEGIN {$IFC fDebug} PD_WRITELN('Calling init_block_cache failed'); { any of the user's special options } WRITELN; WRITELN('Formatting assembly file "',asmInFile ,'"'); WRITELN(' to file "',asmOutFile,'":'); { initialize the output line failure counter } e ,'"')); PD_WRITELN(CONCAT('asmOutFile = "',asmOutFile,'"')); {$ENDC} { setup the user-modifiable output options } setup_options; { output the listing file with back-patch fixes and with }