🚀 go-pugleaf

Submitted-by: Albert Chin-A-Young (26285659t@servax.fiu.edu)
Posting-number: Volume 1, Source:72
Archive-name: utility/gs/disassem/coff/part07
Architecture: ONLY_2gs
Version-number: 1.1


=output.s
- lst off
-
-* UNIX coff utility
-* output routines
-*
-* 1990-1992, tao Developer Project
-
- rel
- xc
- xc
- mx %00
-
- put coff.h ;global defines
- put x.data ;external data definitions
- put x.general ;external general definitions
- put x.gsos ;external GS/OS i/o definitions
- put x.structure ;external data structure definitions
-
- 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/getopt.h ;getopt command-line option 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
-
-
-long_header mac
- pea #^]1
- pea #]1
- _WriteCString
- lda #8
- ldx @omf+`]2
- ldy @omf+`]2+2
- jsr print_fix_long_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- pea #25 ;word - number of characters to print
- _TextWriteBlock
- lda #10
- ldx @omf+`]2
- ldy @omf+`]2+2
- jsr print_fix_long_dec
- put_cr
- eom
-short_header mac
- pea #^]1
- pea #]1
- _WriteCString
- lda #4
- ldx @omf+`]2
- jsr print_fix_short_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- pea #34 ;word - number of characters to print
- _TextWriteBlock
- lda #5
- ldx @omf+`]2
- jsr print_fix_short_dec
- put_cr
- eom
-char_header mac
- pea #^]1
- pea #]1
- _WriteCString
- ldx @omf+`]2
- jsr print_fix_char_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- pea #38 ;word - number of characters to print
- _TextWriteBlock
- lda #3
- ldx @omf+`]2
- jsr print_fix_char_dec
- put_cr
- eom
-
-
-**************************************************
-* print OMF header.                              *
-**************************************************
-print_header ent
-]segname_handle = $20 ;handle of @omf+`segname
-]segname_ptr = $24
-]count = $28 ;number of bytes in header
-]edge = $2c ;rightmost edge
-]num_read = $2e ;number of characters read
-]offset = $30 ;current offset into file
-
- lda }hex ;print hex of header?
- bne :test_header
- brl :print_header
-:test_header lda }header
- bne :hex_header
- brl :print_header
-
-:hex_header jsr GSOSget_mark
- phx
- phy
- sec
- tya
- sbc @omf+`offset
- sta ]count
- txa
- sbc @omf+`offset+2
- sta ]count+2
-
- ldx @omf+`offset
- ldy @omf+`offset+2
- stx ]offset
- sty ]offset+2
- tya
- ora ]offset
- beq :set_mark
- put_cr
-
-:set_mark ldy @omf+`offset ;reset file pointer to beginning
- ldx @omf+`offset+2 ;of header
- jsr GSOSset_mark
-
- lda #HEADER_EDGE
- sta ]edge
-
-:loop lda #6
- ldx ]offset
- ldy ]offset+2
- jsr print_fix_long_hex
- pea #^vert_separator+1
- pea #vert_separator+1
- _WriteCString
-
- lda ]count+2 ;if number of bytes to read is less
- bne :0 ;than the default, output only
- lda ]count ;default many bytes
- cmp ]edge
- blt :1
-:0 lda ]edge ;read in default number of characters
-:1 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 #^:horz_separator
- pea #:horz_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;]offset
-
- lda ]count
- ora ]count+2
- beq :end
- brl :loop
-
-:end ply
- plx
- jsr GSOSset_mark
- rts
-
-:print_header lda @omf+`version
- cmp #1
- bne :omf_2
- pea #^:block_count
- pea #:block_count
- _WriteCString
- bra :2
-:omf_2 pea #^:byte_count
- pea #:byte_count
- _WriteCString
-:2 lda #8
- ldx @omf+`bytecnt
- ldy @omf+`bytecnt+2
- jsr print_fix_long_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- pea #25 ;word - number of characters to print
- _TextWriteBlock
- lda #10
- ldx @omf+`bytecnt
- ldy @omf+`bytecnt+2
- jsr print_fix_long_dec
- put_cr
-
- long_header :reserved_space;resspc
- long_header :length;length
- char_header :label_length;lablen
- char_header :number_length;numlen
- char_header :version;version
-
- lda @omf+`revision
- bne :print_revision
- brl :print_bank_size
-:print_revision char_header :revision;revision
-:print_bank_size long_header :bank_size;banksize
-
- lda @omf+`version
- cmp #1
- bne :print_kind_2
- jsr print_kind_1
- bra :3
-:print_kind_2 jsr print_kind_2
-
-:3 long_header :org;org
- long_header :alignment;align
- char_header :number_sex;numsex
- short_header :segment_number;segnum
- long_header :entry;entry
- short_header :disp_to_names;dispname
- short_header :disp_to_data;dispdata
-
- pea #^:load_name
- pea #:load_name
- _WriteCString
- pea #^@omf+`loadname ;long - pointer to string
- pea #@omf+`loadname
- pea #0 ;word - offset into text
- pea #LOADNAME_LEN ;word - number of characters to print
- _TextWriteBlock
- put_cr
-
- 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
- pea #^:segment_name
- pea #:segment_name
- _WriteCString
- pei ]segname_ptr+2 ;long - pointer to string
- pei ]segname_ptr
- pea #2 ;word - offset into text
- lda []segname_ptr] ;word - number of characters to print
- pha
- _TextWriteBlock
- put_cr
- _HUnlock
-
- put_cr
- rts
-
-:byte_count cStr 'byte count    : $'
-:block_count cStr 'block count   : $'
-:reserved_space cStr 'reserved space: $'
-:length cStr 'length        : $'
-:label_length cStr 'label length  : $'
-:number_length cStr 'number length : $'
-:version cStr 'version       : $'
-:revision cStr 'revision      : $'
-:bank_size cStr 'bank size     : $'
-:org cStr 'org           : $'
-:alignment cStr 'alignment     : $'
-:number_sex cStr 'number sex    : $'
-:segment_number cStr 'segment number: $'
-:entry cStr 'entry         : $'
-:disp_to_names cStr 'disp to names : $'
-:disp_to_data cStr 'disp to data  : $'
-:load_name cStr 'load name     : '
-:segment_name cStr 'segment name  : '
-:horz_separator cStr '- '
-:hex ds HEADER_EDGE+6
-
-
-**************************************************
-* print kind string for OMF 1.0.                 *
-**************************************************
-print_kind_1 equ *
-]space = $80
-]kind_str = $82
-
- jsr parse_kind_1
- lda kind_str
- cmp #32
- bge :0
- pea #^:kind
- pea #:kind
- _WriteCString
- ldx @omf+`kind
- jsr print_fix_char_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- sec ;word - number of characters to print
- lda #41
- sbc kind_str
- pha
- _TextWriteBlock
- pea #^kind_str ;long - pointer to string
- pea #kind_str
- pea #2 ;word - offset into text
- lda kind_str ;word - number of characters to print
- pha
- _TextWriteBlock
- put_cr
- rts
-
-:0 lda #kind_str+2
- sta ]kind_str
-:loop lda #' ' ;find next occurrence of space
- ldx ]kind_str ;character
- jsr strchr
- stx ]space
- bne :1
- clc
- lda #kind_str
- adc kind_str
- sta ]space
-:1 sec
- lda ]space
- sbc #kind_str+2
- cmp #32
- bge :2
- brl :3
-:2 pea #^:kind
- pea #:kind
- _WriteCString
- ldx @omf+`kind
- jsr print_fix_char_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- sec ;word - number of characters to print
- lda ]kind_str
- sbc #kind_str+2
- dec
- pha
- sec
- lda #41
- sbc 1,s
- sta 1,s
- _TextWriteBlock
- pea #^kind_str ;long - pointer to string
- pea #kind_str
- pea #2 ;word - offset into text
- sec ;word - number of characters to print
- lda ]kind_str
- sbc #kind_str+2
- dec
- pha
- _TextWriteBlock
- put_cr
- bra :4
-:3 lda ]space
- inc
- sta ]kind_str
- brl :loop
-
-:4 pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- clc ;word - number of characters to print
- lda #kind_str+2
- adc kind_str
- sec
- sbc ]kind_str
- pha
- sec
- lda #60
- sbc 1,s
- sta 1,s
- _TextWriteBlock
- phb ;long - pointer to string
- phb
- pla
- and #$ff
- pha
- pei ]kind_str
- _WriteCString
- put_cr
- rts
-
-:kind cStr 'kind          : $'
-
-
-**************************************************
-* print kind string for OMF 2.0.                 *
-**************************************************
-print_kind_2 equ *
-]space = $80
-]kind_str = $82
-
- jsr parse_kind_2
- lda kind_str
- cmp #30
- bge :0
- pea #^:kind
- pea #:kind
- _WriteCString
- lda #4
- ldx @omf+`kind
- jsr print_fix_short_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- sec ;word - number of characters to print
- lda #39
- sbc kind_str
- pha
- _TextWriteBlock
- pea #^kind_str ;long - pointer to string
- pea #kind_str
- pea #2 ;word - offset into text
- lda kind_str ;word - number of characters to print
- pha
- _TextWriteBlock
- put_cr
- rts
-
-:0 lda #kind_str+2
- sta ]kind_str
-:loop lda #' ' ;find next occurrence of space
- ldx ]kind_str ;character
- jsr strchr
- stx ]space
- bne :1
- clc
- lda #kind_str+2
- adc kind_str
- sta ]space
-:1 sec
- lda ]space
- sbc #kind_str+2
- cmp #30
- bge :2
- brl :3
-:2 pea #^:kind
- pea #:kind
- _WriteCString
- lda #4
- ldx @omf+`kind
- jsr print_fix_short_hex
- pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- sec ;word - number of characters to print
- lda ]kind_str
- sbc #kind_str+2
- dec
- pha
- sec
- lda #39
- sbc 1,s
- sta 1,s
- _TextWriteBlock
- pea #^kind_str ;long - pointer to string
- pea #kind_str
- pea #2 ;word - offset into text
- sec ;word - number of characters to print
- lda ]kind_str
- sbc #kind_str+2
- dec
- pha
- _TextWriteBlock
- put_cr
- bra :4
-:3 lda ]space
- inc
- sta ]kind_str
- brl :loop
-
-:4 pea #^blank_str ;long - pointer to string
- pea #blank_str
- pea #0 ;word - offset into text
- clc ;word - number of characters to print
- lda #kind_str+2
- adc kind_str
- sec
- sbc ]kind_str
- pha
- sec
- lda #60
- sbc 1,s
- sta 1,s
- _TextWriteBlock
- phb ;long - pointer to string
- phb
- pla
- and #$ff
- pha
- pei ]kind_str
- _WriteCString
- put_cr
- rts
-
-:kind cStr 'kind          : $'
-
-
-**************************************************
-* convert kind value to string equivalents for   *
-* OMF 1.0.                                       *
-**************************************************
-parse_kind_1 equ *
-
- stz kind_str ;0 length of string
- lda @omf+`kind
- and #DYNAMIC
- beq :static
- ldx #dynamic
- jsr append_kind_str
- bra :0
-:static ldx #static
- jsr append_kind_str
-
-:0 ldx #0
-:loop lda @omf+`kind
- asl
- asl
- asl
- asl
- asl
- asl
- asl
- asl
- phx
- and :type,x
- cmp #POSITION_INDEPENDENT
- bne :private
- ldx #position_independent
- jsr append_kind_str
- bra :end_loop
-:private cmp #PRIVATE
- bne :end_loop
- ldx #private
- jsr append_kind_str
-:end_loop plx
- inx
- inx
- cpx #4
- blt :loop
-
- lda @omf+`kind
- and #$1f
-:check_code cmp #CODE
- bne :data
- ldx #code
- jsr append_kind_str
- rts
-:data cmp #DATA
- bne :jump_table
- ldx #data
- jsr append_kind_str
- rts
-:jump_table cmp #JUMP_TABLE
- bne :pathname
- ldx #jump_table
- jsr append_kind_str
- rts
-:pathname cmp #PATHNAME
- bne :library_dictionary
- ldx #pathname
- jsr append_kind_str
- rts
-:library_dictionary cmp #LIBRARY_DICTIONARY
- bne :initialization
- ldx #library_dictionary
- jsr append_kind_str
- rts
-:initialization cmp #INITIALIZATION
- bne :absolute_bank_seg
- ldx #initialization
- jsr append_kind_str
- rts
-:absolute_bank_seg cmp #ABSOLUTE_BANK_SEG
- bne :direct_page
- ldx #absolute_bank
- jsr append_kind_str
- rts
-:direct_page cmp #DIRECT_PAGE
- bne :end
- ldx #dp_stack
- jsr append_kind_str
-:end rts
-
-:type dw POSITION_INDEPENDENT
- dw PRIVATE
-
-
-**************************************************
-* convert kind value to string equivalents for   *
-* OMF 2.0.                                       *
-**************************************************
-parse_kind_2 equ *
-
- stz kind_str ;0 length of string
- lda @omf+`kind
- and #DYNAMIC
- beq :static
- ldx #dynamic
- jsr append_kind_str
- bra :0
-:static ldx #static
- jsr append_kind_str
-
-:0 ldx #0
-:loop lda @omf+`kind
- phx
- and :type,x
- cmp #BANK_RELATIVE
- bne :skip
- ldx #bank_relative
- jsr append_kind_str
- bra :end_loop
-:skip cmp #SKIP
- bne :reload
- ldx #skip
- jsr append_kind_str
- bra :end_loop
-:reload cmp #RELOAD
- bne :absolute_bank
- ldx #reload
- jsr append_kind_str
- bra :end_loop
-:absolute_bank cmp #ABSOLUTE_BANK
- bne :position_independent
- ldx #absolute_bank
- jsr append_kind_str
- bra :end_loop
-:position_independent cmp #POSITION_INDEPENDENT
- bne :private
- ldx #position_independent
- jsr append_kind_str
- bra :end_loop
-:private cmp #PRIVATE
- bne :end_loop
- ldx #private
- jsr append_kind_str
-:end_loop plx
- inx
- inx
- cpx #12
- blt :loop
-
- lda @omf+`kind
- and #$1f
-:check_code cmp #CODE
- bne :data
- ldx #code
- jsr append_kind_str
- rts
-:data cmp #DATA
- bne :jump_table
- ldx #data
- jsr append_kind_str
- rts
-:jump_table cmp #JUMP_TABLE
- bne :pathname
- ldx #jump_table
- jsr append_kind_str
- rts
-:pathname cmp #PATHNAME
- bne :library_dictionary
- ldx #pathname
- jsr append_kind_str
- rts
-:library_dictionary cmp #LIBRARY_DICTIONARY
- bne :initialization
- ldx #library_dictionary
- jsr append_kind_str
- rts
-:initialization cmp #INITIALIZATION
- bne :absolute_bank_seg
- ldx #initialization
- jsr append_kind_str
- rts
-:absolute_bank_seg cmp #ABSOLUTE_BANK_SEG
- bne :direct_page
- ldx #absolute_bank
- jsr append_kind_str
- rts
-:direct_page cmp #DIRECT_PAGE
- bne :end
- ldx #dp_stack
- jsr append_kind_str
-:end rts
-
-:type dw PRIVATE
- dw POSITION_INDEPENDENT
- dw ABSOLUTE_BANK
- dw RELOAD
- dw SKIP
- dw BANK_RELATIVE
-
-
-**************************************************
-* output expression list stack as infix          *
-* expression.                                    *
-* ---------------------------------------------- *
-* (input)                                        *
-*  x - offset into current line.                 *
-* (output)                                       *
-*  x - offset into current line.                 *
-**************************************************
-print_stack_infix ent
-]offset = $d0 ;offset into line
-]btree_ptr = $d2 ;pointer to binary tree
-]size = $d4 ;size of stack
-]list_lo_handle = $d6 ;handle to @expr_list stack
-]list_lo_ptr = $da
-]list_hi_handle = $de
-]list_hi_ptr = $e2
-]list_offset = $e6 ;offset into @expr_list for current expression
-]element_handle = $e8 ;current list element
-]element_ptr = $ec
-]count = $f0
-
- stx ]offset
-
- ldx @expr_list+`lo
- ldy @expr_list+`lo+2
- stx ]list_lo_handle
- sty ]list_lo_handle+2
- phy
- phx
- phy
- phx
- _HLock
- ldx @expr_list+`hi
- ldy @expr_list+`hi+2
- stx ]list_hi_handle
- sty ]list_hi_handle+2
- phy
- phx
- phy
- phx
- _HLock
- lda []list_lo_handle]
- sta ]list_lo_ptr
- ldy #2
- lda []list_lo_handle],y
- sta ]list_lo_ptr+2
- lda []list_hi_handle]
- sta ]list_hi_ptr
- ldy #2
- lda []list_hi_handle],y
- sta ]list_hi_ptr+2
- stz ]list_offset
- stz ]size
- stz ]count
-
-:loop lda ]list_offset
- asl
- tay
- lda []list_lo_ptr],y
- sta ]element_handle
- lda []list_hi_ptr],y
- sta ]element_handle+2
- lda []element_handle]
- sta ]element_ptr
- ldy #2
- lda []element_handle],y
- sta ]element_ptr+2
-
- lda ]size
- asl
- tay
- lda ]count
- asl
- tax
- lda @btree+`ptr,x
- sta ]btree_ptr
- sta :order,y
-
- ldy #`str ;store handle to expression string
- lda ]element_handle
- sta (]btree_ptr),y
- ldy #`str+2
- lda ]element_handle+2
- sta (]btree_ptr),y
- ldy #`left
- lda #NULL
- sta (]btree_ptr),y
- ldy #`oper ;store operation code
- lda []element_ptr]
- sta (]btree_ptr),y
- beq :string
- cmp #LABEL_LENGTH
- beq :string
- tax
- lda #NULL ;zero out string (won't be used)
- ldy #`str
- sta (]btree_ptr),y
- ldy #`str+2
- sta (]btree_ptr),y
- dec ]size ;make right node last known expression
- lda ]size
- asl
- tay
- lda :order,y
- ldy #`right
- sta (]btree_ptr),y
- cpx #NEGATION ;special case unary operators
- beq :update_order
- cpx #NOT
- beq :update_order
- cpx #COMPLEMENT
- beq :update_order
- cpx #LABEL_LENGTH
- beq :update_order
- dec ]size ;make left node second last known
- lda ]size ;expression
- asl
- tay
- lda :order,y
- ldy #`left
- sta (]btree_ptr),y
- bra :update_order
-:string lda #NULL
- ldy #`right
- sta (]btree_ptr),y
- ldy #`left
- sta (]btree_ptr),y
-
-:update_order lda ]size
- asl
- tax
- lda ]btree_ptr
- sta :order,x
- inc ]size
- inc ]count
- inc ]list_offset
- lda ]list_offset
- cmp @expr_list+`size
- beq :print_offset
- brl :loop
-
-:print_offset _HUnlock
- _HUnlock
- lda }assembly
- bne :print_inorder
- jsr print_offset
- pea #^space_vert_bar
- pea #space_vert_bar
- _WriteCString
-
-:print_inorder pei ]btree_ptr
- pei ]offset
- ldy #`oper
- lda (]btree_ptr),y
- beq :0
- cmp #LABEL_LENGTH
- beq :0
- asl
- asl
- tax
- lda ~operator+`prec,x
- inc
-:0 pha
- jsr print_inorder
- stx ]offset
- cpx #0
- beq :end
- lda }assembly
- bne :end
- put_cr
-
-:end ldx ]offset
- rts
-
-:order ds 50*2 ;order in which trees are allocated
-
-
-**************************************************
-* print binary tree 'inorder'.                   *
-* ---------------------------------------------- *
-* (input)                                        *
-*  word - pointer to binary tree.                *
-*  word - offset into line.                      *
-*  word - operator precedence.                   *
-* (output)                                       *
-*  x - current offset into line.                 *
-**************************************************
-print_inorder equ *
-]oper = $01 ;operator
-]oper_str = ]oper+2 ;string representation of operator
-]expr_str = ]oper_str+4 ;expression string
-]db = ]expr_str+4
-]dp = ]db+1
-]rts = ]dp+1
-]precedence = ]rts+2 ;operator precedence
-]offset = ]precedence+2 ;current offset into line
-]btree_ptr = ]offset+2 ;pointer to binary tree
-
- phd ;save direct page
- tdc ;save copy of dp for calls that access
- sta :dp ;dp space in coff
-
- sec
- tsc
- sbc #]dp-2 ;make local dp space
- tcs
- tcd
-
- lda ]btree_ptr
- bne :print
- ldx ]offset
-
-:end lda ]rts,s ;move return address to position
- sta ]btree_ptr,s ;of last parameter
-
- clc
- tsc
- adc #]dp-2
- tcs
-
- pld
-
- clc
- tsc
- adc #]btree_ptr-]rts
- tcs
- rts
-
-
-:print ldy #`str ;if no string for expression,
- lda (]btree_ptr),y ;parse operator token
- sta ]oper_str
- ldy #`str+2
- lda (]btree_ptr),y
- sta ]oper_str+2
- ora ]oper_str
- bne :print_str
- brl :operator
-
-:print_str pei ]oper_str+2 ;output string representation of
- pei ]oper_str ;expression
- pei ]oper_str+2
- pei ]oper_str
- _HLock
- ldy #2
- lda []oper_str],y
- tay
- lda []oper_str]
- sta ]oper_str
- tax
- inx
- inx
- sty ]oper_str+2
-
- phd
- lda :dp
- tcd
- jsr match_label
- pld
- stx ]expr_str
- sty ]expr_str+2
- txa
- ora ]expr_str+2
- beq :0
- lda }label
- bne :1
-:0 ldx ]oper_str
- inx
- inx
- ldy ]oper_str+2
- stx ]expr_str
- sty ]expr_str+2
-:1 ldx #0
- lda []oper_str]  ;update offset into line by length
- pha
- cmp #LABEL_LENGTH
- bne :2
- ldx #9
-:2 clc
- txa
- adc []expr_str] ;of string to print
- adc ]offset
- sta ]offset
- tax
- phd
- lda :dp
- tcd
- jsr newline
- pld
- stx ]offset
- pla
- cmp #LABEL_LENGTH
- bne :3
- pea #^:length
- pea #:length
- _WriteCString
- pei ]expr_str+2 ;output expression string
- pei ]expr_str
- pea #2
- lda []expr_str]
- pha
- _TextWriteBlock
- pea #')'
- _WriteChar
- bra :4
-:3 pei ]expr_str+2 ;output expression string
- pei ]expr_str
- pea #2
- lda []expr_str]
- pha
- _TextWriteBlock
-:4 lda ]offset
- bne :unlock
- lda []expr_str]
- sta ]offset
-
-:unlock _HUnlock
- ldx ]offset
- brl :end
-
-:operator ldy #`oper ;minimize output of parentheses
- lda (]btree_ptr),y ;in expressions by considering
- sta ]oper ;precedence of operators
- asl
- asl
- tax
- lda ]precedence
- cmp ~operator+`prec,x
- blt :5
- bne :6
- lda #LEFT
- cmp ~operator+`assoc,x
- bne :6
-:5 pea #'('
- _WriteChar
- inc ]offset
-:6 ldy #`left
- lda (]btree_ptr),y
- pha
- pei ]offset
- lda ]oper
- asl
- asl
- tax
- lda ~operator+`prec,x
- pha
- jsr print_inorder
- stx ]offset
-
- lda ]oper
- jsr find_operator ;uses no dp space
- stx ]oper_str+2
- sty ]oper_str
-
- clc ;test if at right margin
- lda []oper_str]
- adc ]offset
- adc #2
- sta ]offset
- tax
- phd
- lda :dp
- tcd
- jsr newline
- pld
- stx ]offset
- cpx #0 ;if at left margin, don't prepend space
- beq :7 ;to separate operator from expression
- cpx #3
- beq :7
- pea #' '
- _WriteChar
-:7 pei ]oper_str+2
- pei ]oper_str
- pea #2
- lda []oper_str]
- pha
- _TextWriteBlock
- ldx ]oper ;don't append space to unary operators
- cpx #NEGATION ;special case unary operators
- beq :8
- cpx #NOT
- beq :8
- cpx #COMPLEMENT
- beq :8
- pea #' '
- _WriteChar
-:8 lda ]offset
- bne :9
- lda []oper_str]
- sta ]offset
-
-:9 ldy #`right
- lda (]btree_ptr),y
- pha
- pei ]offset
- lda ]oper
- asl
- asl
- tax
- lda ~operator+`prec,x
- pha
- jsr print_inorder
- stx ]offset
-
- lda ]oper
- asl
- asl
- tax
- lda ]precedence
- cmp ~operator+`prec,x
- blt :10
- bne :11
- lda #LEFT
- cmp ~operator+`assoc,x
- bne :11
-:10 pea #')'
- _WriteChar
- inc ]offset
-
-:11 ldx ]offset
- brl :end
-
-:dp dw 0 ;direct page register
-:length cStr 'length ('
-
-
-**************************************************
-* check to output newline in current expression  *
-* output.                                        *
-* ---------------------------------------------- *
-* (input)                                        *
-*  x - offset into line.                         *
-* (output)                                       *
-*  x - offset into line.                         *
-**************************************************
-newline equ *
-]offset = $f0
-]edge = $f2
-
- stx ]offset
-
- lda #0
- ldx }nooffset
- beq :0
- lda #16
-:0 clc
- adc #INFIX_EDGE
- sta ]edge
-
- lda ]edge ;if past right boundary for
- cmp ]offset ;INFIX expressions, move to next
- bge :end ;line and output rest of
- put_cr ;expression
- jsr print_offset
- stz ]offset
- lda }assembly
- beq :1
- pea #^blank_str ;19 blank spaces indents assembly
- pea #blank_str ;output
- pea #0
- pea #19
- _TextWriteBlock
- bra :end
-:1 pea #^space_vert_bar
- pea #space_vert_bar
- _WriteCString
-
-:end ldx ]offset
- rts
-
-
-**************************************************
-* output expression list stack as postfix        *
-* expression.                                    *
-* ---------------------------------------------- *
-* (input)                                        *
-*  x - offset into line.                         *
-* (output)                                       *
-*  x - offset into line.                         *
-**************************************************
-print_stack_postfix ent
-]offset = $d0 ;offset into line
-]edge = $d2
-]list_lo_handle = $d4
-]list_hi_handle = $d8
-]list_lo_ptr = $dc
-]list_hi_ptr = $e0
-]list_offset = $e4 ;offset into @expr_list for current expression
-]list = $e6 ;current list element
-]expr_str = $ea ;expression string
-
- stx ]offset
- stz ]list_offset
-
- ldx @expr_list+`lo
- ldy @expr_list+`lo+2
- stx ]list_lo_handle
- sty ]list_lo_handle+2
- phy
- phx
- phy
- phx
- _HLock
- ldx @expr_list+`hi
- ldy @expr_list+`hi+2
- stx ]list_hi_handle
- sty ]list_hi_handle+2
- phy
- phx
- phy
- phx
- _HLock
- lda []list_lo_handle]
- sta ]list_lo_ptr
- ldy #2
- lda []list_lo_handle],y
- sta ]list_lo_ptr+2
- lda []list_hi_handle]
- sta ]list_hi_ptr
- ldy #2
- lda []list_hi_handle],y
- sta ]list_hi_ptr+2
-
- lda #0
- ldx }nooffset
- beq :0
- lda #16
-:0 clc
- adc #POSTFIX_EDGE
- sta ]edge
-
- lda }assembly
- bne :loop
- jsr print_offset
- pea #^space_vert_bar
- pea #space_vert_bar
- _WriteCString
-
-:loop lda ]list_offset
- cmp @expr_list+`size
- bne :print_postfix
- brl :end
-:print_postfix lda ]list_offset
- asl
- tay
- lda []list_lo_ptr],y
- sta ]list
- lda []list_hi_ptr],y
- sta ]list+2
- ldy #2
- lda []list],y
- tay
- lda []list]
- sta ]list
- tax
- sty ]list+2
-
- lda []list]
- bne :find_operator
- inx
- inx
- jsr match_label
- stx ]expr_str
- sty ]expr_str+2
- txa
- ora ]expr_str+2
- beq :1
- lda }label
- bne :print_expr
-:1 ldx ]list
- inx
- inx
- ldy ]list+2
- stx ]expr_str
- sty ]expr_str+2
- bra :print_expr
-:find_operator jsr find_operator
- stx ]expr_str+2
- sty ]expr_str
-
-:print_expr clc
- lda ]offset
- adc []expr_str]
- sta ]offset
- pei ]expr_str+2
- pei ]expr_str
- pea #2
- lda []expr_str]
- pha
- _TextWriteBlock
- lda []list] ;special case EXPR sub-type $84 (label length)
- cmp #LABEL_LENGTH
- bne :2
- pei ]list+2
- pei ]list
- pea #4
- clc
- ldy #2
- lda []list],y
- pha
- adc ]offset
- inc
- sta ]offset
- _TextWriteBlock
- pea #')'
- _WriteChar
-
-:2 inc ]list_offset
- lda ]list_offset
- cmp @expr_list+`size
- beq :end
- lda ]offset
- cmp ]edge
- bge :end_print
- pea #' '
- _WriteChar
- inc ]offset
-:end_print lda ]offset
- dec
- cmp ]edge
- bge :3
- brl :print_postfix
-
-:3 put_cr
- lda }nooffset
- bne :4
- jsr print_offset
-:4 lda }assembly
- beq :5
- pea #^:vert_separator
- pea #:vert_separator
- _WriteCString
- bra :6
-:5 pea #^space_vert_bar
- pea #space_vert_bar
- _WriteCString
-:6 stz ]offset
- brl :loop
-
-:end _HUnlock
- _HUnlock
- lda }assembly
- bne :return
- put_cr
-:return ldx ]offset
- rts
-
-:vert_separator cStr '                   |'
-
-
-**************************************************
-* append string to kind_str.                     *
-* ---------------------------------------------- *
-* (input)                                        *
-*  x - LOW of string in current bank.            *
-**************************************************
-append_kind_str equ *
-]append_str = $f0 ;address of C-string to append
-
- stx ]append_str
-
- ldy #0
- ldx kind_str
- shorta
-:loop lda (]append_str),y
- sta kind_str+2,x
- iny
- inx
- cmp #0
- bne :loop
-:end longa
- dex
- stx kind_str ;update length of kind string
- rts
-
-
-**************************************************
-kind_str ds KIND_LEN+2
-
-code cStr ' code'
-data cStr ' data'
-jump_table cStr ' jump-table'
-pathname cStr ' pathname'
-library_dictionary cStr ' library-dictionary'
-initialization cStr ' initialization'
-absolute_bank cStr ' absolute-bank'
-dp_stack cStr ' direct-page/stack'
-
-bank_relative cStr ' bank-relative'
-skip cStr ' skip'
-reload cStr ' reload'
-position_independent cStr ' position-independent'
-private cStr ' private'
-
-dynamic cStr 'dynamic'
-static cStr 'static'
-
-
-**************************************************
- sav output.l
+ END OF ARCHIVE