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 / 12 < prev next >

Wrap

Internet Message Format | 1992-11-08 | 27.0 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: v001SRC072: coff (OMF Disassembler) 07/09 Message-ID: <Nov.8.19.12.26.1992.16623@yoko.rutgers.edu> Date: 9 Nov 92 00:12:27 GMT Organization: Rutgers Univ., New Brunswick, N.J. Lines: 1454 Approved: jac@paul.rutgers.edu 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