NetNews Usenet Archive 1992 #26

home *** CD-ROM | disk | FTP | other *** search

/ NetNews Usenet Archive 1992 #26 / NN_1992_26.iso / spool / comp / sources / apple2 / 13 < prev next >

Wrap

Internet Message Format | 1992-11-08 | 62.3 KB

Path: sparky!uunet!zaphod.mps.ohio-state.edu!cis.ohio-state.edu!rutgers!igor.rutgers.edu!yoko.rutgers.edu!jac From: jac@yoko.rutgers.edu (Jonathan A. Chandross) Newsgroups: comp.sources.apple2 Subject: v001SRC071: coff (OMF Disassembler) 06/09 Message-ID: <Nov.8.19.12.14.1992.16620@yoko.rutgers.edu> Date: 9 Nov 92 00:12:15 GMT Organization: Rutgers Univ., New Brunswick, N.J. Lines: 3226 Approved: jac@paul.rutgers.edu Submitted-by: Albert Chin-A-Young (26285659t@servax.fiu.edu) Posting-number: Volume 1, Source:71 Archive-name: utility/gs/disassem/coff/part06 Architecture: ONLY_2gs Version-number: 1.1 =omf.s - lst off - -* UNIX coff utility -* OMF parser -* -* 1990-1992, tao Developer Project - - rel - xc - xc - mx %00 - - put coff.h ;global defines - put x.data ;data externals - put x.general ;general externals - put x.gsos ;GS/OS i/o externals - put x.output ;output externals - put x.structure ;data structure externals - put x.asm ;65816 OMF disassembler externals - - put 4/gsos.h ;GS/OS defines - put 4/memory.h ;memory manager defines - put 4/resource.h ;resouce manager defines - put 4/texttool.h ;text tool defines - put 4/env.h ;run-time environment settings - - use coff.mac ;macro definitions - use 4/datatype.mac ;HLL data types - use 4/env.mac ;run-time environment macros - - -* dp $40-$80 taken - -************************************************** -* read header of OMF file into @omf structure. * -* ---------------------------------------------- * -* (input) * -* x - LOW of length of file. * -* y - HOW of length of file. * -************************************************** -read_header ent -]segname_handle = $80 ;handle to segment name -]segname_ptr = $84 -]file_len = $88 ;length of OMF file - - stx ]file_len - sty ]file_len+2 - jsr GSOSget_mark - clc - tya - adc #HEADER_LEN - tay - txa - adc #0 - cmp ]file_len+2 - blt :read_header - cpy ]file_len - blt :read_header - lda #MORE_DATA - ldx #0 - txy - jmp error - -:read_header read_long @omf+`bytecnt - read_long @omf+`resspc - read_long @omf+`length - lda @omf+`length+2 ;OMF length of segment must be - beq :read_kind ;<= $10000 - cmp #2 - bge :length_error - lda @omf+`length - beq :read_kind -:length_error lda #INVALID_LENGTH - ldx @omf+`length - ldy @omf+`length+2 - jmp error -:read_kind read_char @omf+`kind - read_char @omf+`lablen - read_char @omf+`numlen - read_char @omf+`version - lda @omf+`version - cmp #3 - blt :read_bank - lda #OMF_VERSION - ldx @omf+`version - ldy #0 - jmp error -:read_bank stz @omf+`revision ;default value of revision - read_long @omf+`banksize - - lda @omf+`version - cmp #1 - beq :0 - read_short @omf+`kind - read_short :tmp - bra :1 -:0 read_long :tmp -:1 read_long @omf+`org - read_long @omf+`align - read_char @omf+`numsex - read_char @omf+`lcbank - read_short @omf+`segnum - read_long @omf+`entry - read_short @omf+`dispname - read_short @omf+`dispdata - - lda @omf+`version - cmp #1 - beq :2 - read_long @omf+`temporg -:2 clc - lda @omf+`offset - adc @omf+`dispname - tay - lda @omf+`offset+2 - adc #0 - tax - jsr GSOSset_mark - lda #LOADNAME_LEN - ldx #@omf+`loadname - ldy #^@omf+`loadname - jsr GSOSread - lda @omf+`lablen - beq :3 - sta :lablen - bra :4 -:3 read_char :lablen -:4 lda @omf+`segname ;if handle already created, just - ora @omf+`segname+2 ;resize it - beq :5 - ldx @omf+`segname - ldy @omf+`segname+2 - stx ]segname_handle - sty ]segname_handle+2 - lda :lablen ;long - new size of handle - inc - inc - pea #0 - pha - pei ]segname_handle+2 ;long - handle to resize - pei ]segname_handle - _SetHandleSize - bra :6 -:5 pha ;long - result - pha - lda :lablen ;long - size of block - inc - inc - pea #0 - pha - lda userID ;word - user ID associated with block - pha - pea #attrNoCross ;word - attributes of block - pha ;long - where block is to begin - pha - _NewHandle - plx - ply - stx @omf+`segname - sty @omf+`segname+2 - stx ]segname_handle - sty ]segname_handle+2 -:6 lda []segname_handle] - sta ]segname_ptr - ldy #2 - lda []segname_handle],y - sta ]segname_ptr+2 - - clc - lda ]segname_ptr - adc #2 - tax - lda ]segname_ptr+2 - adc #0 - tay - lda :lablen - jsr GSOSread - lda :lablen ;length of segment name - sta []segname_ptr] - rts - -:tmp ds 4 ;temp location -:lablen ds 2 ;length of name or record in segment - - -************************************************** -* parse segment for +hex option. * -************************************************** -parse_segment_hex ent -]end_offset = $20 ;offset to end hex disassembly -]num_read = $24 ;number of bytes read - - ldx @omf+`offset ;make duplicate of offset - ldy @omf+`offset+2 - stx ]end_offset - sty ]end_offset+2 - - lda @omf+`version - cmp #1 - bne :0 - lda @omf+`library - bne :0 - lda @omf+`bytecnt - asl ;each block is 512 bytes - asl - asl - asl - asl - asl - asl - asl - asl - clc - adc ]end_offset - sta ]end_offset - tya - adc #0 - sta ]end_offset+2 - bra :loop -:0 clc - txa - adc @omf+`bytecnt - sta ]end_offset - tya - adc @omf+`bytecnt+2 - sta ]end_offset+2 - -:loop lda @omf+`displacement+2 - cmp ]end_offset+2 - blt :1 - lda @omf+`displacement - cmp ]end_offset - blt :1 - beq :1 - brl :end -:1 lda #15 - ldx #:hex - ldy #^:hex - jsr GSOSread - stx ]num_read - bcc :2 - brl :end -:2 bne :3 - brl :end -:3 lda #6 - ldx @omf+`displacement - ldy @omf+`displacement+2 - jsr print_fix_long_hex - pea #^vert_separator+1 - pea #vert_separator+1 - _WriteCString - incr ]num_read;@omf+`displacement - - ldx #0 ;output bytes just read -:print_byte phx - lda :hex,x ;word - char to convert - and #$ff - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - plx - inx - cpx ]num_read - blt :print_byte - - pea #^blank_str ;long - pointer to string - pea #blank_str - pea #0 ;word - offset into text - sec ;word - number of characters to print - lda #15 ;3 * (15 - ]num_read) - sbc ]num_read - tax - asl - pha - clc - txa - adc 1,s - sta 1,s - _TextWriteBlock - pea #^:dash_separator - pea #:dash_separator - _WriteCString - - ldx #0 -:print_char phx - lda :hex,x - and #$ff - jsr isprint - bcs :print_period - pha - _WriteChar - bra :end_loop -:print_period pea #'.' - _WriteChar -:end_loop plx - inx - cpx ]num_read - blt :print_char - put_cr - brl :loop - -:end put_cr - rts - -:hex ds 16 ;read 15 bytes at a time -:dash_separator cStr '- ' ;separate bytes/ascii - - -************************************************** -* parse current OMF segment. * -************************************************** -parse_segment ent -]record = $20 ;record to parse -]offset = $22 - - ldx #TRUE_OFFSET - stx ]offset - stz ]record - lda }assembly ;display header for assembly parsing - beq :0 - jsr display_header_asm -:0 ldx @omf+`displacement+2 - ldy @omf+`displacement - jsr GSOSset_mark - -:loop read_char ]record - lda ]record - cmp #END - beq :4 - cmp #cRELOC - beq :1 - cmp #RELOC - beq :1 - cmp #SUPER - bne :2 -:1 lda }assembly - bne :3 - -:2 lda }nooffset - bne :3 - ldx ]offset - cpx #TRUE_OFFSET - bne :3 - jsr print_offset - -:3 incr @omf+`displacement - lda ]record - ldx #0 - ldy #TRUE - jsr parse_record - stx ]offset - cpx #FALSE_OFFSET - beq :loop - ldx #TRUE_OFFSET - stx ]offset - bra :loop - -:4 lda }assembly - beq :6 - lda @omf+`resspc ;append DS to end of assembly listing - ora @omf+`resspc+2 ;if resspc not zero - beq :5 - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - pea #^DS_asm - pea #DS_asm - _WriteCString - ldx @omf+`resspc - ldy @omf+`resspc+2 - jsr print_long_dec - put_cr -:5 lda ~assembler - cmp #MERLIN - beq :end - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - pea #^:end_str - pea #:end_str - _WriteCString - bra :cr -:6 jsr print_offset - pea #^:END_str - pea #:END_str - _WriteCString - -:cr put_cr -:end put_cr - lda #LOCAL ;remove local labels - jsr delete_labels - rts - -:END_str cStr 'END (00)' ;END record name -:end_str cStr 'end' - - -************************************************** -* parse current OMF record. * -* ---------------------------------------------- * -* (input) * -* a - record to parse. * -* x - offset into current line. * -* y - prepend spaces to output? * -* (output) * -* x - offset into current line. * -************************************************** -parse_record ent -]record = $40 ;record to parse -]space = $42 ;prepend spaces to output? -]offset = $44 -]truncate_size = $46 ;truncate expression to x bytes - - sta ]record - stx ]offset - sty ]space - stz ]truncate_size - - cmp #END - bne :align - brl :end - -:align cmp #ALIGN - bne :org - ldx ]record - jsr parse_ALIGN - brl :end - -:org cmp #ORG - bne :entry - ldx ]record - jsr parse_ORG - brl :end - -:entry cmp #ENTRY - bne :general - ldx ]record - jsr parse_ENTRY - brl :end - -:general cmp #GENERAL - bne :using - ldx ]record - jsr parse_GENERAL - brl :end - -:using cmp #USING - bne :strong - jsr parse_USING - brl :end - -:strong cmp #STRONG - bne :global - lda }assembly - beq :parse - lda ]space - beq :parse - pea #^space_12 - pea #space_12 - _WriteCString -:parse jsr parse_STRONG - brl :end - -:global cmp #GLOBAL - bne :local - jsr parse_GLOBAL_LOCAL - brl :end - -:local cmp #LOCAL - bne :gequ - jsr parse_GLOBAL_LOCAL - brl :end - -:gequ cmp #GEQU - bne :equ - ldx ]offset - jsr parse_GEQU_EQU - stx ]offset - brl :end - -:equ cmp #EQU - bne :mem - ldx ]offset - jsr parse_GEQU_EQU - stx ]offset - brl :end - -:mem cmp #MEM - bne :expr - ldx ]offset - jsr parse_MEM - stx ]offset - brl :end - -:expr cmp #EXPR - beq :parse_expr -:bexpr cmp #BEXPR - beq :parse_expr -:lexpr cmp #LEXPR - beq :parse_expr -:relexpr cmp #RELEXPR - bne :ds -:parse_expr ldy ]space - ldx ]offset - jsr parse_expression - stx ]offset - brl :end - -:ds cmp #DS - bne :lconst - lda }assembly - beq :ds_0 - pea #^space_12 - pea #space_12 - _WriteCString -:ds_0 lda ]record - jsr parse_DS - bra :end -:lconst cmp #LCONST - bne :creloc - ldx }assembly - beq :lconst_0 - jsr parse_CONST_asm - bra :end -:lconst_0 jsr parse_CONST - bra :end -:creloc cmp #cRELOC - bne :reloc - jsr parse_cRELOC - stx ]offset - bra :end -:reloc cmp #RELOC - bne :interseg - jsr parse_RELOC - stx ]offset - bra :end -:interseg cmp #INTERSEG - bne :cinterseg - jsr parse_INTERSEG - stx ]offset - bra :end -:cinterseg cmp #cINTERSEG - bne :super - jsr parse_cINTERSEG - stx ]offset - bra :end -:super cmp #SUPER - bne :default - jsr parse_SUPER - stx ]offset - bra :end -:default lda }assembly - beq :10 - lda ]record - jsr parse_CONST_asm - bra :end -:10 lda ]record - jsr parse_CONST - -:end ldx ]offset - rts - - -************************************************** -* parse CONST record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -************************************************** -parse_CONST equ * -]count = $50 ;number of bytes to read -]edge = $54 ;right margin for output -]record = $56 ;record number -]num_read = $58 ;number of bytes read - - sta ]record - sta ]count - stz ]count+2 - cmp #LCONST - bne :const - - pea #^:LCONST_str - pea #:LCONST_str - _WriteCString - read_long ]count - clc - lda @omf+`displacement - adc #4 - sta @omf+`displacement - bcc :0 - inc @omf+`displacement+2 - bra :0 -:const pea #^:CONST_str - pea #:CONST_str - _WriteCString - lda ]record - sta ]count - stz ]count+2 - -:0 ldx ]record - jsr print_fix_char_hex - pea #^vert_separator - pea #vert_separator - _WriteCString - - pea #^:length_str - pea #:length_str - _WriteCString - ldx ]count - ldy ]count+2 - jsr print_long_dec - pea #^:hex_length_str - pea #:hex_length_str - _WriteCString - ldx ]count - ldy ]count+2 - jsr print_long_hex - pea #')' - _WriteChar - pea #^:byte_str - pea #:byte_str - _WriteCString - lda ]count - ora ]count+2 - cmp #1 - beq :1 - pea #'s' - _WriteChar -:1 put_cr - lda }compress - beq :parse_CONST - clc - lda @omf+`counter - adc ]count - sta @omf+`counter - lda @omf+`counter+2 - adc ]count+2 - sta @omf+`counter+2 - clc - lda @omf+`displacement - adc ]count - sta @omf+`displacement - lda @omf+`displacement+2 - adc ]count+2 - sta @omf+`displacement+2 - ldx ]count - ldy ]count+2 - jsr GSOSset_mark_plus - rts - -:parse_CONST jsr print_offset - pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - - lda #0 - ldx }nooffset - beq :2 - lda #5 -:2 clc - adc #CONST_EDGE - sta ]edge - -:loop lda ]count+2 ;if number of bytes to read is less - bne :3 ;than the default, output only - lda ]count ;default many bytes - cmp ]edge - blt :4 -:3 lda ]edge ;read in default number of characters -:4 ldx #:hex - ldy #^:hex - jsr GSOSread - stx ]num_read - - ldx #0 ;output bytes just read -:print_byte phx - lda :hex,x - and #$ff - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - plx - inx - cpx ]num_read - blt :print_byte - - pea #^blank_str ;long - pointer to string - pea #blank_str - pea #0 ;word - offset into text - sec ;word - number of characters to print - lda ]edge ;3 * (]edge - ]num_read) - sbc ]num_read - tax - asl - pha - clc - txa - adc 1,s - sta 1,s - _TextWriteBlock - pea #^:dash_separator - pea #:dash_separator - _WriteCString - - ldx #0 -:print_char phx - lda :hex,x - and #$ff - jsr isprint - bcs :print_period - pha - _WriteChar - bra :end_loop -:print_period pea #'.' - _WriteChar -:end_loop plx - inx - cpx ]num_read - blt :print_char - put_cr - - decr ]num_read;]count - incr ]num_read;@omf+`counter ;update counter - incr ]num_read;@omf+`displacement ;update offse into OMF file - - lda ]count - ora ]count+2 - beq :end - lda }nooffset - bne :5 - jsr print_offset -:5 pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - brl :loop -:end rts - -:hex ds CONST_EDGE+6 ;space for input string -:CONST_str cStr 'CONST (' ;CONST record name -:LCONST_str cStr 'LCONST (' ;LCONST record name -:dash_separator cStr '- ' ;separate bytes/ascii -:length_str cStr 'Length: ' ;length of LCONST record -:hex_length_str cStr ' ($' -:byte_str cStr ' byte' - - -************************************************** -* parse ALIGN record. * -* ---------------------------------------------- * -* (input) * -* x - record number. * -************************************************** -parse_ALIGN equ * - - ldy #0 - jsr cannot_parse_msg - rts - - -************************************************** -* parse ORG record. * -* ---------------------------------------------- * -* (input) * -* x - record number. * -************************************************** -parse_ORG equ * - - ldy #0 - jsr cannot_parse_msg - rts - - -************************************************** -* parse ENTRY record. * -* ---------------------------------------------- * -* (input) * -* x - record number. * -************************************************** -parse_ENTRY equ * - - ldy #0 - jsr cannot_parse_msg - rts - - -************************************************** -* parse GENERAL record. * -* ---------------------------------------------- * -* (input) * -* x - record number. * -************************************************** -parse_GENERAL equ * - - ldy #0 - jsr cannot_parse_msg - rts - - -************************************************** -* parse USING record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -************************************************** -parse_USING equ * -]record = $50 ;record number -]length = $52 ;label length -]label_handle = $54 ;handle to label -]label_ptr = $58 - - sta ]record - stz ]length - read_char ]length - - pha ;long - result - pha - pea #0 ;long - size of block - pei ]length - lda userID ;word - userID associated with block - pha - pea #attrNoCross+attrLocked ;word - attributes of block - pha ;long - where block is to begin - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - lda ]length ;read in label name - ldx ]label_ptr - ldy ]label_ptr+2 - jsr GSOSread - - lda }assembly - bne :0 - pea #^:USING_str - pea #:USING_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^vert_separator - pea #vert_separator - _WriteCString - bra :end -:0 pea #^:USING_asm - pea #:USING_asm - _WriteCString - -:end pei ]label_ptr+2 - pei ]label_ptr - pea #0 - pei ]length - _TextWriteBlock - put_cr - _DisposeHandle - sec ;add ]lenth + 1 - lda @omf+`displacement ;update offset into file - adc ]length - sta @omf+`displacement - bcc :rts - inc @omf+`displacement+2 -:rts rts - -:USING_str cStr 'USING (' ;USING record name (OMF) -:USING_asm cStr ' using ' ;USING record name (assembly) - - -************************************************** -* this record contains the name of a segment * -* that must be included during linking, even if * -* no external reference is made to it. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -************************************************** -parse_STRONG ent -]record = $50 ;record number -]length = $52 ;length of segment name -]segname_handle = $54 ;handle to referenced segment name -]segname_ptr = $58 - - sta ]record - - read_char ]length - pha ;long - result - pha - pea #0 ;long - size of block - pei ]length - lda userID ;word - user ID associated with block - pha - pea #attrNoCross+attrLocked ;word - attributes of block - pha ;long - where block is to begin - pha - _NewHandle - lda 1,s - sta ]segname_handle - lda 3,s - sta ]segname_handle+2 - lda []segname_handle] - sta ]segname_ptr - tax - ldy #2 - lda []segname_handle],y - sta ]segname_ptr+2 - tay - lda ]length - jsr GSOSread - - lda }assembly - bne :asm - pea #^:STRONG_str - pea #:STRONG_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^vert_separator - pea #vert_separator - _WriteCString - pei ]segname_ptr+2 - pei ]segname_ptr - pea #0 - pei ]length - _TextWriteBlock - bra :update -:asm pea #^:STRONG_asm - pea #:STRONG_asm - _WriteCString - pei ]segname_ptr+2 - pei ]segname_ptr - pea #0 - pei ]length - _TextWriteBlock - pea #''' - _WriteChar - -:update _DisposeHandle - put_cr - incr ]length;@omf+`displacement - rts - -:STRONG_str cStr 'STRONG (' ;STRONG record name (OMF) -:STRONG_asm asc !dc r'!,00 ;STRONG directive - - -************************************************** -* parse GLOBAL and LOCAL labels. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -************************************************** -parse_GLOBAL_LOCAL equ * -]length = $50 ;length of label -]private = $52 ;if label is private -]label_ptr = $54 -]segname_handle = $58 ;handle to current segment name -]segname_ptr = $5c -]segname_len = $60 ;length of segment name -]expr_ptr = $62 -]record = $66 ;record number -]type = $68 ;type of label -]label_handle = $6a ;handle to label name -]expr_handle = $6e ;expression label evaluates to - - sta ]record - stz ]length - stz ]type - stz ]private - - read_char ]length - pha ;long - result - pha - lda ]length ;long - size of block - inc - inc - pea #0 - pha - lda userID ;word - user ID associated with block - pha - pea #attrNoCross+attrLocked ;word - attributes of block - pha ;long - where block is to begin - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - tax - inx - inx - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - tay - lda ]length ;read label name - jsr GSOSread - lda ]length - sta []label_ptr] - incr ]length;@omf+`displacement - - lda }label - bne :add_label - brl :read -:add_label ldx @omf+`segname - ldy @omf+`segname+2 - stx ]segname_handle - sty ]segname_handle+2 - phy - phx - phy - phx - _HLock - lda []segname_handle] - sta ]segname_ptr - ldy #2 - lda []segname_handle],y - sta ]segname_ptr+2 - lda []segname_ptr] - sta ]segname_len - - pha ;long - result - pha - clc ;long - block size - lda ]segname_len - adc #14 - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]expr_handle - lda 3,s - sta ]expr_handle+2 - lda []expr_handle] - sta ]expr_ptr - ldy #2 - lda []expr_handle],y - sta ]expr_ptr+2 - - ldy #2 - lda #'(' - sta []expr_ptr],y - - ldy #2 - ldx #3 - shorta -:copy_segname lda []segname_ptr],y - phy - txy - sta []expr_ptr],y - ply - inx - iny - dec ]segname_len - bne :copy_segname - txy - lda #'+' - sta []expr_ptr],y - iny - lda #'$' - sta []expr_ptr],y - iny - longa - phy - - ldx @omf+`counter ;long - longint to convert - ldy @omf+`counter+2 - phy - phx - pea #^long_hex_str ;long - pointer to output string - pea #long_hex_str - pea #8 ;word - length of string - _Long2Hex - ldx #7 - lda @omf+`counter ;special case value of 0 - ora @omf+`counter+2 - beq :1 - lda #8 - ldx #long_hex_str ;make hex alpha lowercase - ldy #^long_hex_str - jsr lowercase_hex - ldx #$ffff -:0 inx - lda long_hex_str,x - and #$ff - cmp #'0' - beq :0 -:1 ply - shorta -:copy_value lda long_hex_str,x - sta []expr_ptr],y - inx - iny - cpx #8 - blt :copy_value - lda #')' - sta []expr_ptr],y - longa - tya ;y holds length of label string - 1 - dec - sta []expr_ptr] - _HUnlock - _HUnlock - - pei ]label_handle+2 - pei ]label_handle - pei ]expr_handle+2 - pei ]expr_handle - pei ]type - jsr add_label - -:read read_char ]length - read_char ]type - read_char ]private - - lda }assembly - beq :2 - brl :asm -:2 lda ]record - cmp #GLOBAL - bne :local - pea #^:GLOBAL_str - pea #:GLOBAL_str - bra :print -:local pea #^:LOCAL_str - pea #:LOCAL_str -:print _WriteCString - lda #2 - ldx ]record - jsr print_fix_char_dec - pea #^vert_separator - pea #vert_separator - _WriteCString - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - pha - _TextWriteBlock - put_cr - jsr print_offset - pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - pea #^:len_str - pea #:len_str - _WriteCString - ldx ]length - jsr print_fix_char_hex - pea #^:type_str - pea #:type_str - _WriteCString - pei ]type - _WriteChar - lda ]type - jsr label_type_str - lda ]private - beq :return - pea #^:private_str - pea #:private_str - _WriteCString -:return put_cr - bra :end -:asm lda ]type - xba - ora ]length - ldx ]label_handle - ldy ]label_handle+2 - jsr parse_type_attribute - -:end _HUnlock - lda }label - bne :update - pei ]label_handle+2 - pei ]label_handle - _DisposeHandle -:update incr #4;@omf+`displacement - rts - -:GLOBAL_str cStr 'GLOBAL (' ;GLOBAL record name -:LOCAL_str cStr 'LOCAL (' ;LOCAL record name -:len_str cStr 'len: ' -:type_str cStr ', type: ' -:private_str cStr ' private' - - -************************************************** -* output string representation of label type. * -* ---------------------------------------------- * -* (input) * -* a - label type. * -************************************************** -label_type_str equ * - - pha - pea #' ' - _WriteChar - pla - cmp #'A' ;type 'A' - bne :boolean - pea #^:address_str - pea #:address_str - brl :print -:boolean cmp #'B' ;type 'B' - bne :character - pea #^:boolean_str - pea #:boolean_str - brl :print -:character cmp #'C' ;type 'C' - bne :double - pea #^:character_str - pea #:character_str - brl :print -:double cmp #'D' ;type 'D' - bne :float - pea #^:double_str - pea #:double_str - brl :print -:float cmp #'F' ;type 'F' - bne :G - pea #^:float_str - pea #:float_str - brl :print -:G cmp #'G' - bne :hex - pea #^:G_str - pea #:G_str - brl :print -:hex cmp #'H' - bne :int - pea #^:hex_str - pea #:hex_str - brl :print -:int cmp #'I' - bne :K - pea #^:integer_str - pea #:integer_str - brl :print -:K cmp #'K' - bne :L - pea #^:K_str - pea #:K_str - brl :print -:L cmp #'L' - bne :M - pea #^:L_str - pea #:L_str - brl :print -:M cmp #'M' - bne :N - pea #^:M_str - pea #:M_str - brl :print -:N cmp #'N' - bne :org - pea #^:N_str - pea #:N_str - brl :print -:org cmp #'O' - bne :align - pea #^:org_str - pea #:org_str - brl :print -:align cmp #'P' - bne :ds - pea #^:align_str - pea #:align_str - brl :print -:ds cmp #'S' - bne :X - pea #^:ds_str - pea #:ds_str - brl :print -:X cmp #'X' - bne :Y - pea #^:X_str - pea #:X_str - brl :print -:Y cmp #'Y' - bne :Z - pea #^:Y_str - pea #:Y_str - brl :print -:Z cmp #'Z' - bne :rts - pea #^:Z_str - pea #:Z_str -:print _WriteCString -:rts rts - -:address_str cStr '"address"' -:boolean_str cStr '"boolean"' -:character_str cStr '"character"' -:double_str cStr '"double-precision"' -:float_str cStr '"floating-point"' -:G_str cStr '"EQU or GEQU"' -:hex_str cStr '"hexadecimal"' -:integer_str cStr '"integer"' -:K_str cStr '"reference-address"' -:L_str cStr '"soft-reference"' -:M_str cStr '"instruction"' -:N_str cStr '"assembler directive"' -:org_str cStr '"ORG"' -:align_str cStr '"ALIGN"' -:ds_str cStr '"DS"' -:X_str cStr '"arithmetic symbol"' -:Y_str cStr '"boolean symbolic"' -:Z_str cStr '"character symbolic"' - - -************************************************** -* parse global and local equates. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* x - current offset into line. * -* (output) * -* x - current offset into line. * -************************************************** -parse_GEQU_EQU equ * -]record = $50 ;record number -]offset = $52 ;current offset into line -]length = $54 ;length of label -]type = $56 ;label type -]private = $58 ;if label is private -]tmp_asm = $5a ;copy of assembler -]label_handle = $5a ;handle to label name -]label_ptr = $5e - - sta ]record - stx ]offset - stz ]length - stz ]type - stz ]private - - read_char ]length - pha ;long - result - pha - lda ]length ;long - size of block - inc - inc - pea #0 - pha - lda userID ;word - user ID associated with block - pha - pea #attrNoCross+attrLocked ;word - attributes of block - pha ;long - where block is to begin - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - tax - inx - inx - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - tay - lda ]length ;read label name - jsr GSOSread - lda ]length - sta []label_ptr] - - read_char ]length - read_char ]type - read_char ]private - - lda }assembly - beq :0 - brl :asm -:0 lda ]record - cmp #GEQU - bne :equ - pea #^:GEQU_str - pea #:GEQU_str - bra :print -:equ pea #^:EQU_str - pea #:EQU_str -:print _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^vert_separator - pea #vert_separator - _WriteCString - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - pha - _TextWriteBlock - put_cr - jsr print_offset - pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - pea #^:len_str - pea #:len_str - _WriteCString - lda #2 - ldx ]length - jsr print_fix_char_dec - pea #^:type_str - pea #:type_str - _WriteCString - pei ]type - _WriteChar - lda ]type - jsr label_type_str - lda ]private - beq :return - pea #^:private_str - pea #:private_str - _WriteCString -:return put_cr - lda ]record - ldx ]offset - jsr parse_expr - stx ]offset - brl :end - -:asm pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - pha - _TextWriteBlock - lda []label_ptr] - cmp #12 - blt :1 - pea #' ' - _WriteChar - bra :2 -:1 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc []label_ptr] - pha - _TextWriteBlock -:2 ldx #^GEQU_asm - ldy #GEQU_asm - lda ]record - cmp #GLOBAL - beq :print_asm - ldx #^EQU_asm - ldy #EQU_asm -:print_asm phx - phy - _WriteCString - incr @omf+`displacement - lda ~assembler - sta ]tmp_asm - lda ]record - ldx ]offset - jsr parse_expr - stx ]offset - cpx #0 - beq :3 - put_cr -:3 lda ]tmp_asm - sta ~assembler - -:end clc - lda @omf+`displacement - adc ]length - bcc :4 - inc @omf+`displacement+2 -:4 clc - adc #4 - sta @omf+`displacement - bcc :rts - inc @omf+`displacement+2 -:rts _DisposeHandle - ldx ]offset - rts - - -:EQU_str cStr 'EQU (' ;EQU record name -:GEQU_str cStr 'GEQU (' ;GEQU record name -:len_str cStr 'len: ' -:type_str cStr ', type: ' -:private_str cStr ', private' -:tmp_asm UnsignedShort - - -************************************************** -* reserve memory area. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* x - offset into line. * -* (output) * -* x - offset into line. * -************************************************** -parse_MEM equ * -]record = $50 ;record number -]offset = $52 ;offset into line -]adr_begin = $54 ;address to begin reserving -]adr_end = $58 ;address to end reserving - - sta ]record - stx ]offset - - read_long ]adr_begin - read_long ]adr_end - - lda }assembly - bne :0 - pea #^:MEM_str - pea #:MEM_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:reserve_str - pea #:reserve_str - _WriteCString - lda ]adr_begin+2 - and #$ff - tax - jsr print_fix_char_hex - pea #'/' - _WriteChar - lda #4 - ldx ]adr_begin - jsr print_fix_short_hex - pea #^:dash_str - pea #:dash_str - _WriteCString - lda ]adr_end+2 - and #$ff - tax - jsr print_fix_char_hex - pea #'/' - _WriteChar - lda #4 - ldx ]adr_end - jsr print_fix_short_hex - put_cr - bra :1 - -:0 pea #^:MEM_asm - pea #:MEM_asm - _WriteCString - pea #^:blank_str - pea #:blank_str - _WriteCString - ldx ]adr_begin - ldy ]adr_begin+2 - jsr print_long_hex - pea #',' - _WriteChar - pea #'$' - _WriteChar - ldx ]adr_end - ldy ]adr_end+2 - jsr print_long_hex - put_cr - -:1 incr #8;@omf+`displacement - ldx ]offset - rts - -:MEM_str cStr 'MEM (' ;MEM record name -:MEM_asm cStr ' mem' ;MEM directive -:reserve_str cStr ') | reserve: $' -:dash_str cStr ' - $' -:blank_str cStr ' $' - - -************************************************** -* parse expressions. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* a - how many bytes to truncate expression to. * -************************************************** -parse_EXPR_BEXPR_LEXPR equ * -]record = $60 ;record number -]truncate_size = $62 ;number of bytes to truncate expression to - - sta ]record - stz ]truncate_size - - read_char ]truncate_size - lda }assembly - bne :end - lda ]record - cmp #EXPR - bne :bexpr_str - pea #^:EXPR_str - pea #:EXPR_str - bra :print -:bexpr_str cmp #BEXPR - bne :lexpr_str - pea #^:BEXPR_str - pea #:BEXPR_str - bra :print -:lexpr_str pea #^:LEXPR_str - pea #:LEXPR_str -:print _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:truncate_str - pea #:truncate_str - _WriteCString - ldx ]truncate_size - jsr print_char_dec - pea #^:byte_str - pea #:byte_str - _WriteCString - lda ]truncate_size - cmp #1 - beq :1 - pea #'s' - _WriteChar -:1 put_cr -:end incr @omf+`displacement - lda ]truncate_size - rts - -:EXPR_str cStr 'EXPR (' ;EXPR record name -:LEXPR_str cStr 'LEXPR (' ;LEXPR record name -:BEXPR_str cStr 'BEXPR (' ;BEXPR record name -:truncate_str cStr ') | truncate result to ' -:byte_str cStr ' byte' - - -************************************************** -* parse relative branches. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* a - how many bytes to truncate expression to. * -************************************************** -parse_RELEXPR equ * -]record = $60 ;record number -]truncate_size = $62 ;number of bytes to truncate expression to -]offset = $64 - - sta ]record - stz ]truncate_size - - read_char ]truncate_size - lda }assembly - bne :1 - pea #^:RELEXPR_str - pea #:RELEXPR_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:truncate_str - pea #:truncate_str - _WriteCString - ldx ]truncate_size - jsr print_char_dec - pea #^:byte_str - pea #:byte_str - _WriteCString - lda ]truncate_size - dec - beq :0 - pea #'s' - _WriteChar -:0 put_cr - -:1 read_long ]offset - incr #5;@omf+`displacement - - lda }assembly - bne :end - jsr print_offset - pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - pea #^:offset_str - pea #:offset_str - _WriteCString - lda #8 - ldx ]offset - ldy ]offset+2 - jsr print_fix_long_hex - put_cr - -:end lda ]truncate_size - rts - -:RELEXPR_str cStr 'RELEXPR (' ;RELEXPR record name -:truncate_str cStr ') | truncate result to ' -:byte_str cStr ' byte' -:offset_str cStr 'offset: $' - - -************************************************** -* parse recording indicating number of zeros to * -* insert at current location. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -************************************************** -parse_DS ent -]record = $50 ;DS record number -]num_zeros = $52 ;number of zeros to insert - - sta ]record - - read_long ]num_zeros - - lda }assembly - bne :1 - pea #^:DS_str - pea #:DS_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:insert - pea #:insert - _WriteCString - ldx ]num_zeros - ldy ]num_zeros+2 - jsr print_long_dec - pea #^:zero - pea #:zero - _WriteCString - lda ]num_zeros+2 - bne :0 - lda ]num_zeros - cmp #2 - blt :update -:0 pea #'s' - _WriteChar - bra :update - -:1 pea #^DS_asm - pea #DS_asm - _WriteCString - ldx ]num_zeros - ldy ]num_zeros+2 - jsr print_long_dec - -:update put_cr - incr #5;@omf+`displacement - clc - lda @omf+`counter - adc ]num_zeros - sta @omf+`counter - lda @omf+`counter+2 - adc ]num_zeros+2 - sta @omf+`counter+2 - rts - -:DS_str cStr 'DS (' ;DS record name -:insert cStr ') | insert ' -:zero cStr ' zero' - - -************************************************** -* parse relocation record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* x - if displacement, counter offset printed. * -************************************************** -parse_RELOC equ * -]record = $50 ;record number -]num_bytes = $52 ;number of bytes to be relocated -]bit_shift = $54 ;bit-shift bytes left or right? -]offset = $56 ;location of first byte to relocate -]value = $5a ;location of reference relative to start of segment - - sta ]record - stz ]num_bytes - stz ]bit_shift - - read_char ]num_bytes - read_char ]bit_shift - read_long ]offset - read_long ]value - - lda }assembly - beq :parse_RELOC - incr #10;@omf+`displacement ;move past RELOC record - ldx #FALSE_OFFSET ;for asm disassembly - rts - -:parse_RELOC pea #^:RELOC_str - pea #:RELOC_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:bytes_str - pea #:bytes_str - _WriteCString - ldx ]num_bytes - jsr print_char_dec - pea #^:shift_str - pea #:shift_str - _WriteCString - lda ]bit_shift - cmp #$80 - bge :right - pea #^left_str - pea #left_str - - bra :0 -:right pea #^right_str - pea #right_str -:0 _WriteCString - lda ]bit_shift - cmp #$80 - blt :1 - sec - lda #$100 - sbc ]bit_shift - sta ]bit_shift -:1 tax - jsr print_char_dec - put_cr - jsr print_offset - pea #^offset_str - pea #offset_str - _WriteCString - lda #6 - ldx ]offset - ldy ]offset+2 - jsr print_fix_long_hex - pea #^:value_str - pea #:value_str - _WriteCString - lda #6 - ldx ]value - ldy ]value+2 - jsr print_fix_long_hex - put_cr - incr #10;@omf+`displacement - ldx #TRUE_OFFSET - rts - -:RELOC_str cStr 'RELOC (' ;RELOC record name -:bytes_str cStr ') | bytes: ' -:shift_str cStr ', shift ' -:value_str cStr ', value: $' - - -************************************************** -* parse compressed relocation record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* x - if displacement, counter offset printed. * -************************************************** -parse_cRELOC equ * -]record = $50 ;record number -]num_bytes = $52 ;number of bytes to be relocated -]bit_shift = $54 ;bit-shift bytes left or right? -]offset = $56 ;location of first byte to relocate -]value = $58 ;location of reference relative to start of segment - - sta ]record - stz ]num_bytes - stz ]bit_shift - - read_char ]num_bytes - read_char ]bit_shift - read_short ]offset - read_short ]value - - lda }assembly - beq :parse_cRELOC - incr #6;@omf+`displacement ;move past cRELOC record for - ldx #FALSE_OFFSET ;asm disassembly - rts - -:parse_cRELOC pea #^:cRELOC_str - pea #:cRELOC_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:bytes_str - pea #:bytes_str - _WriteCString - ldx ]num_bytes - jsr print_char_dec - pea #^:shift_str - pea #:shift_str - _WriteCString - lda ]bit_shift - cmp #$80 - bge :right - pea #^left_str - pea #left_str - bra :0 -:right pea #^right_str - pea #right_str -:0 _WriteCString - lda ]bit_shift - cmp #$80 - blt :1 - sec - lda #$100 - sbc ]bit_shift - sta ]bit_shift -:1 tax - jsr print_char_dec - put_cr - jsr print_offset - pea #^offset_str - pea #offset_str - _WriteCString - lda #4 - ldx ]offset - jsr print_fix_short_hex - pea #^:value_str - pea #:value_str - _WriteCString - lda #4 - ldx ]value - jsr print_fix_short_hex - put_cr - incr #6;@omf+`displacement - ldx #TRUE_OFFSET - rts - -:cRELOC_str cStr 'cRELOC (' ;cRELOC record name -:bytes_str cStr ') | bytes: ' -:shift_str cStr ', shift ' -:value_str cStr ', value: $' - - -************************************************** -* parse INTERSEG record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* x - if displacement, counter offset printed. * -************************************************** -parse_INTERSEG equ * -]record = $50 ;record number -]num_bytes = $52 ;number of bytes to be relocated -]bit_shift = $54 ;bit-shift bytes left or right? -]offset = $56 ;location of first byte to relocate -]segnum = $5a ;segment number to relocate -]filenum = $5c ;file number -]sub_offset = $5e ;offset of subroutine referenced - - sta ]record - stz ]num_bytes - stz ]bit_shift - - read_char ]num_bytes - read_char ]bit_shift - read_long ]offset - read_short ]filenum - read_short ]segnum - read_long ]sub_offset - - lda }assembly - beq :parse_INTERSEG - incr #7;@omf+`displacement ;move past cRELOC record for - ldx #FALSE_OFFSET ;asm disassembly - rts - -:parse_INTERSEG pea #^:INTERSEG_str - pea #:INTERSEG_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:bytes_str - pea #:bytes_str - _WriteCString - ldx ]num_bytes - jsr print_char_dec - pea #^:shift_str - pea #:shift_str - _WriteCString - lda ]bit_shift - cmp #$80 - bge :right - pea #^left_str - pea #left_str - bra :0 -:right pea #^right_str - pea #right_str -:0 _WriteCString - lda ]bit_shift - cmp #$80 - blt :1 - sec - lda #$100 - sbc ]bit_shift - sta ]bit_shift -:1 tax - jsr print_char_dec - put_cr - jsr print_offset - pea #^offset_str - pea #offset_str - _WriteCString - lda #8 - ldx ]offset - ldy ]offset+2 - jsr print_fix_long_hex - pea #^:filenum_str - pea #:filenum_str - _WriteCString - lda #4 - ldx ]filenum - jsr print_fix_short_hex - put_cr - jsr print_offset - pea #^:segnum_str - pea #:segnum_str - _WriteCString - lda #4 - ldx ]segnum - jsr print_fix_short_hex - put_cr - jsr print_offset - pea #^:sub_offset_str - pea #:sub_offset_str - _WriteCString - lda #8 - ldx ]sub_offset - ldy ]sub_offset+2 - jsr print_fix_long_hex - put_cr - incr #7;@omf+`displacement - ldx #TRUE_OFFSET - rts - -:INTERSEG_str cStr 'INTERSEG (' ;INTERSEG record name -:bytes_str cStr ') | bytes: ' -:shift_str cStr ', shift ' -:filenum_str cStr ', file number: $' -:segnum_str cStr ' | segment number: $' -:sub_offset_str cStr ' | offset of subroutine referenced: $' - - -************************************************** -* parse cINTERSEG record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* x - if displacement, counter offset printed. * -************************************************** -parse_cINTERSEG equ * -]record = $50 ;record number -]num_bytes = $52 ;number of bytes to be relocated -]bit_shift = $54 ;bit-shift bytes left or right? -]offset = $56 ;location of first byte to relocate -]segnum = $58 ;segment number to relocate -]sub_offset = $5a ;offset of subroutine referenced - - sta ]record - stz ]num_bytes - stz ]bit_shift - stz ]segnum - - read_char ]num_bytes - read_char ]bit_shift - read_short ]offset - read_char ]segnum - read_short ]sub_offset - - lda }assembly - beq :parse_cINTERSEG - incr #7;@omf+`displacement ;move past cRELOC record for - ldx #FALSE_OFFSET ;asm disassembly - rts - -:parse_cINTERSEG pea #^:cINTERSEG_str - pea #:cINTERSEG_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:bytes_str - pea #:bytes_str - _WriteCString - ldx ]num_bytes - jsr print_char_dec - pea #^:shift_str - pea #:shift_str - _WriteCString - lda ]bit_shift - cmp #$80 - bge :right - pea #^left_str - pea #left_str - bra :0 -:right pea #^right_str - pea #right_str -:0 _WriteCString - lda ]bit_shift - cmp #$80 - blt :1 - sec - lda #$100 - sbc ]bit_shift - sta ]bit_shift -:1 tax - jsr print_char_dec - put_cr - jsr print_offset - pea #^offset_str - pea #offset_str - _WriteCString - lda #4 - ldx ]offset - jsr print_fix_short_hex - pea #^:segnum_str - pea #:segnum_str - _WriteCString - lda #2 - ldx ]segnum - jsr print_fix_char_hex - put_cr - jsr print_offset - pea #^:sub_offset_str - pea #:sub_offset_str - _WriteCString - lda #4 - ldx ]sub_offset - jsr print_fix_short_hex - put_cr - incr #7;@omf+`displacement - ldx #TRUE_OFFSET - rts - -:cINTERSEG_str cStr 'cINTERSEG (' ;cINTERSEG record name -:bytes_str cStr ') | bytes: ' -:shift_str cStr ', shift ' -:segnum_str cStr ', segment number: $' -:sub_offset_str cStr ' | offset of subroutine referenced: $' - - -************************************************** -* parse supercompressed relocation-dictionary * -* record. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* x - if displacement, counter offset printed. * -************************************************** -parse_SUPER equ * -]record = $50 ;record number -]length = $52 ;number of bytes left in record -]type = $56 ;record type -]count = $58 ;subrecord count -]file_mark = $5a ;current position in file -]num_read = $5e ;number of bytes read -]edge = $60 -]length_count = $62 ;count of ]length - - sta ]record - stz ]count ;zero hi-byte - stz ]type - stz ]length_count - - read_long ]length - read_char ]type - lda }assembly - beq :parse_super - jsr GSOSget_mark ;skip SUPER record if disassembling - decr ]length - clc - tya - adc ]length - tay - txa - adc ]length+2 - tax - jsr GSOSset_mark - clc - lda @omf+`displacement - adc ]length - tax - lda @omf+`displacement+2 - adc ]length+2 - tay - clc - txa - adc #5 - sta @omf+`displacement - tya - adc #0 - sta @omf+`displacement+2 - ldx #FALSE_OFFSET - rts - -:parse_super pea #^:SUPER_str ;output SUPER header - pea #:SUPER_str - _WriteCString - ldx ]record - jsr print_fix_char_hex - pea #^:length_str - pea #:length_str - _WriteCString - ldx ]length - ldy ]length+2 - jsr print_long_dec - pea #^:hex_str - pea #:hex_str - _WriteCString - ldx ]length - ldy ]length+2 - jsr print_long_hex - pea #')' - _WriteChar - pea #^:type_str - pea #:type_str - _WriteCString - ldx ]type - jsr print_char_dec - lda ]type ;output type of super record - cmp #SUPER_RELOC2 - bne :reloc3 - pea #^:super_reloc2 - pea #:super_reloc2 - _WriteCString - bra :print_data -:reloc3 cmp #SUPER_RELOC3 - bne :interseg - pea #^:super_reloc3 - pea #:super_reloc3 - _WriteCString - bra :print_data -:interseg pea #^:super_interseg - pea #:super_interseg - _WriteCString - ldx ]type - jsr print_char_dec - pea #'"' - _WriteChar -:print_data put_cr - - decr ]length - incr #5;@omf+`displacement - lda #0 - ldx }nooffset - beq :0 - lda #5 -:0 clc - adc #SUPER_EDGE - sta ]edge - -:loop lda ]length ;continue parsing SUPER until no more - ora ]length+2 ;data to parse - bne :1 - ldx #TRUE_OFFSET - rts -:1 read_char ]count - jsr print_offset - pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - incr @omf+`displacement - decr ]length - lda #4 - ldx ]length_count - jsr print_fix_short_hex - pea #':' - _WriteChar - pea #' ' - _WriteChar - inc ]length_count - lda ]count - cmp #$81 - blt :2 - sec - sbc #$81 -:2 inc - tax - lda #3 - jsr print_fix_char_dec - pea #^:dash_separator - pea #:dash_separator - _WriteCString - lda ]count - cmp #$81 - blt :4 - pea #^:skip_next_str - pea #:skip_next_str - _WriteCString - sec - lda ]count - sbc #$80 - tax - jsr print_short_dec - pea #^:256_byte_str - pea #:256_byte_str - _WriteCString - lda ]count - cmp #$81 - beq :3 - pea #'s' - _WriteChar -:3 put_cr - brl :loop - -:4 inc ]count - decr ]count;]length - clc - lda ]length_count - adc ]count - sta ]length_count -:read_data lda ]count ;if number of bytes to read is less - cmp ]edge ;than the default, output only - blt :read_hex ;default many bytes - lda ]edge ;read in default number of characters -:read_hex ldx #:hex - ldy #^:hex - jsr GSOSread - stx ]num_read - - ldx #0 ;output bytes just read -:print_byte phx - lda :hex,x - and #$ff - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - plx - inx - cpx ]num_read - blt :print_byte - put_cr - - incr ]num_read;@omf+`displacement - sec - lda ]count - sbc ]num_read - sta ]count - bne :5 - brl :loop -:5 jsr print_offset - pea #^space_vert_bar - pea #space_vert_bar - _WriteCString - pea #^blank_str - pea #blank_str - pea #0 - pea #12 - _TextWriteBlock - brl :read_data - -:hex ds 17 -:SUPER_str cStr 'SUPER (' ;SUPER record name -:length_str cStr ') | length: ' -:hex_str cStr ' ($' -:type_str cStr ', type: ' -:super_reloc2 cStr ' "super reloc2"' -:super_reloc3 cStr ' "super reloc3"' -:super_interseg cStr ' "super interseg' -:skip_next_str cStr 'skip next ' -:256_byte_str cStr ' 256-byte page' -:dash_separator cStr ' - ' - - -************************************************** -* parse expressions EXPR, BEXPR, LEXPR, RELEXPR. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* x - offset into current line. * -* y - prepend spaces to output? * -* (output) * -* x - offset into current line. * -************************************************** -parse_expression equ * -]truncate_size = $50 ;number of bytes to truncate expression to -]space = $52 ;prepend spaces to output? -]offset = $54 ;offset into current line - - sta ]record - stx ]offset - sty ]space - - cmp #RELEXPR - beq :parse_relexpr - jsr parse_EXPR_BEXPR_LEXPR - bra :0 -:parse_relexpr jsr parse_RELEXPR -:0 sta ]truncate_size - lda @parse_data+`on ;if parsing data, dec number of bytes - beq :1 ;to parse by number of bytes to - sec ;truncate expression to - lda @parse_data+`count - sbc ]truncate_size - sta @parse_data+`count - ldx ]truncate_size - jsr print_data_type - bra :2 -:1 lda }assembly - beq :2 - lda ]space - beq :2 - pea #^space_12 - pea #space_12 - _WriteCString - lda #'I' - sta @parse_data+`data_type - ldx ]truncate_size - jsr print_data_type -:2 lda ]record - ldx ]offset - jsr parse_expr - stx ]offset - beq :4 - lda @parse_data+`on - bne :4 - lda ]space - beq :4 - lda }assembly - beq :4 - ldx #''' - lda ~assembler - cmp #MERLIN - beq :3 - phx - _WriteChar -:3 put_cr -:4 incr ]truncate_size;@omf+`counter - ldx ]offset - rts - - -************************************************** -* output prefix of assembler statement. * -* ---------------------------------------------- * -* (input) * -* x - number of bytes expression evalutes to. * -************************************************** -print_data_type equ * - - lda ~assembler - cmp #ORCA - beq :orca - cpx #1 - bne :dw - pea #^db_asm - pea #db_asm - _WriteCString - rts -:dw cpx #2 - bne :adr - pea #^dw_asm - pea #dw_asm - _WriteCString - rts -:adr cpx #3 - bne :adrl - pea #^adr_asm - pea #adr_asm - _WriteCString - rts -:adrl cpx #4 - bne :orca - pea #^adrl_asm - pea #adrl_asm - _WriteCString - rts - -:orca lda @parse_data+`data_type - cmp #'I' - bne :address - phx - pea #^dc_i_asm - pea #dc_i_asm - _WriteCString - plx - jsr print_char_dec - pea #''' - _WriteChar - rts -:address cmp #'A' - bne :soft - phx - pea #^dc_a_asm - pea #dc_a_asm - _WriteCString - plx - jsr print_char_dec - pea #''' - _WriteChar - rts -:soft cmp #'L' - bne :end - pea #^:REFERENCE_asm - pea #:REFERENCE_asm - _WriteCString - pea #''' - _WriteChar -:end rts - -:REFERENCE_asm cStr 'dc s' ;reference-address-type DC directive - - -************************************************** -* parse text of EXPR, BEXPR, LEXPR, RELEXPR. * -* ---------------------------------------------- * -* (input) * -* a - record being parsed. * -* x - current offset into line. * -* (output) * -* x - current offset into line. * -************************************************** -parse_expr equ * -]offset = $60 ;offset into line -]expr = $62 ;expression - - stx ]offset - stz ]expr - -;init expression list stack - pha ;long - result - pha - pea #0 ;long - size of block - pea #0 - lda userID ;word - user ID of block - pha - pea #attrNoSpec ;word - block attributes - pha ;long - start of block - pha - _NewHandle - plx - ply - stx @expr_list+`lo - sty @expr_list+`lo+2 - pha ;long - result - pha - pea #0 ;long - size of block - pea #0 - lda userID ;word - user ID of block - pha - pea #attrNoSpec ;word - block attributes - pha ;long - start of block - pha - _NewHandle - plx - ply - stx @expr_list+`hi - sty @expr_list+`hi+2 - stz @expr_list+`size - -:loop read_char ]expr - inc @omf+`displacement - bne :0 - inc @omf+`displacement+2 -:0 lda ]expr - cmp #LABEL_WEAK - bne :label_value - jsr parse_weak_reference - brl :end_loop -:label_value cmp #LABEL_VALUE - bne :label_length - jsr parse_label_value - brl :end_loop -:label_length cmp #LABEL_LENGTH - bne :label_type - jsr parse_label_length - brl :end_loop -:label_type cmp #LABEL_TYPE - bne :label_count - ldx ]record - jsr parse_label_type - brl :end_loop -:label_count cmp #LABEL_COUNT - bne :relative_offset - ldx ]record - jsr parse_label_count - brl :end_loop -:relative_offset cmp #RELATIVE_OFFSET - bne :constant_operand - jsr parse_relative_offset - bra :end_loop -:constant_operand cmp #CONSTANT_OPERAND - bne :add - jsr parse_constant_operand - bra :end_loop -:add cmp #ADD ;push arithmetic operators on stack - beq :push -:sub cmp #SUB - beq :push -:mul cmp #MUL - beq :push -:div cmp #DIV - beq :push -:mod cmp #MOD - beq :push -:negation cmp #NEGATION - beq :push -:bit_shift cmp #BIT_SHIFT - beq :push -:and cmp #AND - beq :push -:or cmp #OR - beq :push -:eor cmp #EOR - beq :push -:not cmp #NOT - beq :push -:less_equal cmp #LESS_EQUAL - beq :push -:greater_equal cmp #GREATER_EQUAL - beq :push -:not_equal cmp #NOT_EQUAL - beq :push -:less cmp #LESS - beq :push -:greater cmp #GREATER - beq :push -:equal cmp #EQUAL - beq :push -:logical_and cmp #LOGICAL_AND - beq :push -:inclusive_or cmp #INCLUSIVE_OR - beq :push -:exclusive_or cmp #EXCLUSIVE_OR - beq :push -:complement cmp #COMPLEMENT - bne :end_loop -:push lda ]expr - ldx #0 - ldy #0 - jsr push_expr_list -:end_loop lda ]expr - cmp #END - beq :print_expr - brl :loop -:print_expr lda }infix - beq :postfix - ldx ]offset - jsr print_stack_infix - stx ]offset - bra :end -:postfix ldx ]offset - jsr print_stack_postfix - stx ]offset - -:end jsr delete_expr_list - ldx ]offset - rts - - -************************************************** -* parse weak-reference label-reference operand. * -************************************************** -parse_weak_reference equ * -]label_value = $70 ;value of label -]label_handle = $72 ;label name -]label_ptr = $76 -]weak_handle = $7a ;weak-reference label name -]weak_ptr = $7e - - stz ]label_value - - read_char ]label_value - incr ]label_value;@omf+`displacement - pha ;long - result - pha - lda ]label_value ;long - block length - inc - inc - inc - inc - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoCross+attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - tax - inx - inx - inx - inx - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - tay - - lda ]label_value ;read in label name - jsr GSOSread - lda ]label_value ;make label name word-length GS/OS string - ldy #2 - sta []label_ptr],y - - lda }assembly - beq :0 - _HUnlock - lda #0 ;add label name to stack - ldx ]label_handle - ldy ]label_handle+2 - jsr push_expr_list - rts -:0 pha ;long - result - pha - clc ;long - block length - lda ]label_value - adc #$0b - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoCross+attrNoSpec ;word - block attributes - pha ;long - start of block - pha - _NewHandle - plx - ply - stx ]weak_handle - sty ]weak_handle+2 - lda []weak_handle] - sta ]weak_ptr - ldy #2 - lda []weak_handle],y - sta ]weak_ptr+2 - - ldy #4 ;copy 'weak (' string to weak label - lda :weak ;reference - sta []weak_ptr],y - ldy #6 - lda :weak+2 - sta []weak_ptr],y - ldy #8 - lda :weak+4 - sta []weak_ptr],y - - ldx #$0a ;copy label name to weak label - ldy #4 ;reference - inc ]label_value - inc ]label_value - inc ]label_value - inc ]label_value - shorta -:copy_label lda []label_ptr],y - phy - txy - sta []weak_ptr],y - ply - inx - iny - cpy ]label_value - bne :copy_label -:end_copy txy - lda #')' - sta []weak_ptr],y - longa - inx - txa - dec - dec - dec - dec - ldy #2 - sta []weak_ptr],y - _HUnlock - - lda #0 - ldx ]weak_handle - ldy ]weak_handle+2 - jsr push_expr_list - pei ]label_ptr+2 - pei ]label_ptr - _DisposeHandle - rts - -:weak cStr 'weak (' - - -************************************************** -* push value assigned to label on stack. * -************************************************** -parse_label_value equ * -]label_value = $70 ;value of label -]label_handle = $72 ;label name -]label_ptr = $76 - - stz ]label_value - - read_char ]label_value - sec ;add length of label + 1 (pStr) - lda @omf+`displacement - adc ]label_value - sta @omf+`displacement - bcc :0 - inc @omf+`displacement+2 - -:0 pha ;long - result - pha - clc ;long - block size - lda ]label_value - adc #4 - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoCross+attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - tay - - lda ]label_value ;read label name - inx - inx - inx - inx - jsr GSOSread - _HUnlock - - lda ]label_value - ldy #2 - sta []label_ptr],y - lda #0 - ldx ]label_handle - ldy ]label_handle+2 - jsr push_expr_list - rts - - -************************************************** -* push length attribute of label on stack. * -************************************************** -parse_label_length equ * -]label_length = $70 ;length of label -]label_handle = $72 ;label name -]label_ptr = $76 - - stz ]label_length - - read_char ]label_length - sec ;add length of label + 1 (pStr) - lda @omf+`displacement - adc ]label_value - sta @omf+`displacement - bcc :0 - inc @omf+`displacement+2 - -:0 pha ;long - result - pha - clc ;long - block size - lda ]label_length - adc #4 - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoCross+attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - tay - - lda ]label_length ;read label name - inx - inx - inx - inx - jsr GSOSread - _HUnlock - - lda ]label_value - ldy #2 - sta []label_ptr],y - lda #LABEL_LENGTH - ldx ]label_handle - ldy ]label_handle+2 - jsr push_expr_list - rts - - -************************************************** -* push type attribute of label on stack. * -* ---------------------------------------------- * -* (input) * -* x - record being parsed. * -************************************************** -parse_label_type equ * - - ldy #LABEL_TYPE - jmp cannot_parse_msg - - -************************************************** -* push count attribute on stack. * -* ---------------------------------------------- * -* (input) * -* x - record being parsed. * -************************************************** -parse_label_count equ * - - ldy #LABEL_COUNT - jmp cannot_parse_msg - - -************************************************** -* push length attribute of label on stack. * -************************************************** -parse_relative_offset equ * -]label_value = $70 ;value of label -]label_handle = $74 ;label name -]label_ptr = $78 -]segname_handle = $7c ;handle to segment name -]segname_ptr = $80 -]segname_len = $84 - - read_long ]label_value - ldx @omf+`segname - ldy @omf+`segname+2 - stx ]segname_handle - sty ]segname_handle+2 - phy - phx - phy - phx - _HLock - lda []segname_handle] - sta ]segname_ptr - ldy #2 - lda []segname_handle],y - sta ]segname_ptr+2 - lda []segname_ptr] - sta ]segname_len - - pha ;long - result - pha - clc ;long - block size - lda ]segname_len - adc #16 - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoCross+attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - ldy #4 - lda #'(' - sta []label_ptr],y - - ldy #2 - ldx #5 - shorta -:copy_segname lda []segname_ptr],y - phy - txy - sta []label_ptr],y - ply - inx - iny - dec ]segname_len - bne :copy_segname - txy - lda #'+' - sta []label_ptr],y - iny - lda #'$' - sta []label_ptr],y - iny - longa - phy - - pei ]label_value+2 ;long - longint to convert - pei ]label_value - pea #^long_hex_str ;long - pointer to output string - pea #long_hex_str - pea #8 ;word - length of string - _Long2Hex - ldx #7 - lda ]label_value - ora ]label_value+2 - beq :1 - lda #8 - ldx #long_hex_str ;make hex alpha lowercase - ldy #^long_hex_str - jsr lowercase_hex - ldx #$ffff -:0 inx - lda long_hex_str,x - and #$ff - cmp #'0' - beq :0 -:1 ply - shorta -:copy_value lda long_hex_str,x - sta []label_ptr],y - inx - iny - cpx #8 - blt :copy_value - lda #')' - sta []label_ptr],y - longa - tya ;y holds length of label string - dec - dec - dec - ldy #2 - sta []label_ptr],y - _HUnlock - _HUnlock - - lda #0 - ldx ]label_handle - ldy ]label_handle+2 - jsr push_expr_list - - incr @omf+`numlen;@omf+`displacement - rts - - -************************************************** -* push constant onto stack. * -************************************************** -parse_constant_operand equ * -]label_value = $70 ;value of label -]label_handle = $74 ;label name -]label_ptr = $78 - - read_long ]label_value - pha ;long - result - pha - pea #0 ;long - block size - pea #13 - lda userID ;word - user ID of block - pha - pea #attrNoCross+attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]label_handle - lda 3,s - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - ldy #4 - lda #'$' - sta []label_ptr],y - - pei ]label_value+2 ;long - longint to convert - pei ]label_value - pea #^long_hex_str ;long - pointer to output string - pea #long_hex_str - pea #8 ;word - length of string - _Long2Hex - ldx #7 - lda ]label_value - ora ]label_value+2 - beq :1 - lda #8 - ldx #long_hex_str ;make hex alpha lowercase - ldy #^long_hex_str - jsr lowercase_hex - ldx #$ffff -:0 inx - lda long_hex_str,x - and #$ff - cmp #'0' - beq :0 - -:1 ldy #5 - shorta -:copy_value lda long_hex_str,x - sta []label_ptr],y - inx - iny - cpx #8 - blt :copy_value - longa - tya ;y holds length of label string - 3 - dec - dec - dec - dec - ldy #2 - sta []label_ptr],y - _HUnlock - - lda #0 - ldx ]label_handle - ldy ]label_handle+2 - jsr push_expr_list - - incr @omf+`numlen;@omf+`displacement - rts - - -************************************************** -* display message that coff cannot parse current * -* OMF record. * -* ---------------------------------------------- * -* (input) * -* x - record that cannot be parsed. * -* y - subrecord that cannot be parsed. * -************************************************** -cannot_parse_msg equ * -]record = $e0 ;record that cannot be parsed -]subrecord = $e2 ;subrecord that cannot be parsed - - stx ]record - sty ]subrecord - - put_cr - jsr get_progname - phy - phx - phy - phx - _WriteCString - pea #^:cannot_parse - pea #:cannot_parse - _WriteCString - ldx ]record - jsr print_fix_char_hex - lda ]subrecord - beq :0 - pea #'.' - _WriteChar - ldx ]subrecord - jsr print_fix_char_hex -:0 put_cr - _WriteCString - pea #^:contact_author - pea #:contact_author - _WriteCString - put_cr - -:1 pla - bne :1 - rts - -:cannot_parse cStr ': cannot parse OMF record $' -:contact_author cStr ': please inform the author' - - -************************************************** -bit cStr 'bit' -left_str cStr 'left ' -right_str cStr 'right ' -offset_str cStr ' | offset: $' - - -************************************************** - sav omf.l + END OF ARCHIVE