🚀 go-pugleaf

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