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

Wrap

Internet Message Format | 1992-11-08 | 42.2 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: v001SRC073: coff (OMF Disassembler) 08/09 Message-ID: <Nov.8.19.12.41.1992.16626@yoko.rutgers.edu> Date: 9 Nov 92 00:12:42 GMT Organization: Rutgers Univ., New Brunswick, N.J. Lines: 1929 Approved: jac@paul.rutgers.edu Submitted-by: Albert Chin-A-Young (26285659t@servax.fiu.edu) Posting-number: Volume 1, Source:73 Archive-name: utility/gs/disassem/coff/part08 Architecture: ONLY_2gs Version-number: 1.1 =structure.s - lst off - -* UNIX coff utility -* data structure 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.output ;external output 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 - - use coff.mac ;macro definitions - use 4/datatype.mac ;HLL data types - - -************************************************** -* add label name and expression evaluation to * -* label stack. * -* ---------------------------------------------- * -* (input) * -* long - handle to replacement label name. * -* long - handle to label expression. * -* word - label type. * -************************************************** -add_label ent -]type = $e0 ;type of label -]name_handle = $e2 ;handle to label name -]expr_handle = $e6 ;expression label evaluates to -]node_handle = $ea ;label node -]node_ptr = $ee -]label_last_handle = $f2 ;handle to first element in linked list -]label_last_ptr = $f6 - - pla ;return address - plx - stx ]type - plx - ply - stx ]expr_handle - sty ]expr_handle+2 - plx - ply - stx ]name_handle - sty ]name_handle+2 - pha ;push return address back on stack - - pha ;long - result - pha - pea #0 ;long - block size - pea #18 - lda userID ;word - user ID of block - pha - pea #attrNoSpec ;word - block attributes - pha ;long - start of block - pha - _NewHandle - plx - ply - stx ]node_handle - sty ]node_handle+2 - lda []node_handle] - sta ]node_ptr - ldy #2 - lda []node_handle],y - sta ]node_ptr+2 - - lda @label+`last - ora @label+`last+2 - bne :0 - ldx ]node_handle - ldy ]node_handle+2 - stx @label+`next - sty @label+`next+2 - ldy #`prev ;make first previous node NULL - lda #NULL - sta []node_ptr],y - ldy #`prev+2 - sta []node_ptr],y - bra :1 - -:0 ldx @label+`last - ldy @label+`last+2 - stx ]label_last_handle - sty ]label_last_handle+2 - lda []label_last_handle] - sta ]label_last_ptr - ldy #2 - lda []label_last_handle],y - sta ]label_last_ptr+2 - ldy #`next ;make next label after last current node - lda ]node_handle - sta []label_last_ptr],y - ldy #`next+2 - lda ]node_handle+2 - sta []label_last_ptr],y - ldy #`prev ;make previous node last node - lda ]label_last_handle - sta []node_ptr],y - ldy #`prev+2 - lda ]label_last_handle+2 - sta []node_ptr],y - -:1 ldy #`label_name ;store label name - lda ]name_handle - sta []node_ptr],y - ldy #`label_name+2 - lda ]name_handle+2 - sta []node_ptr],y - ldy #`expr_name ;store expression evaluation string - lda ]expr_handle - sta []node_ptr],y - ldy #`expr_name+2 - lda ]expr_handle+2 - sta []node_ptr],y - ldy #`type ;store label type - lda ]type - sta []node_ptr],y - ldy #`next ;make next node NULL - lda #NULL - sta []node_ptr],y - ldy #`next+2 - sta []node_ptr],y - - ldx ]node_handle ;make new last node - ldy ]node_handle+2 - stx @label+`last - sty @label+`last+2 - rts - - -************************************************** -* delete labels from label array. * -* ---------------------------------------------- * -* (input) * -* a - delete LOCAL or GLOBAL labels. * -************************************************** -delete_labels ent -]label_type = $e0 ;type of label to delete -]label_handle = $e2 ;handle to current label -]label_ptr = $e6 -]prev_label_handle = $ea ;handle to previous label -]prev_label_ptr = $ee - - sta ]label_type - - ldx #^@label ;make first label previous label. first - ldy #@label ;label structure is header node. - stx ]prev_label_ptr+2 - sty ]prev_label_ptr - - stz @label+`last ;re-initialize last node - stz @label+`last+2 - ldx @label+`next - ldy @label+`next+2 - stx ]label_handle - sty ]label_handle+2 - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - lda ]label_handle - ora ]label_handle+2 - bne :delete_label - rts - -:delete_label ldy #`type - lda []label_ptr],y - cmp ]label_type - bne :0 - ldy #`next - lda []label_ptr],y - sta []prev_label_ptr],y - ldy #`next+2 - lda []label_ptr],y - sta []prev_label_ptr],y - pei ]label_handle+2 - pei ]label_handle - _DisposeHandle - bra :next_label - -:0 ldx ]label_handle - ldy ]label_handle+2 - stx @label+`last - sty @label+`last+2 - stx ]prev_label_handle - sty ]prev_label_handle+2 - lda []prev_label_handle] - sta ]prev_label_ptr - ldy #2 - lda []prev_label_handle],y - sta ]prev_label_ptr+2 - -:next_label ldy #`next ;prepare to examine next label in - lda []label_ptr],y ;linked list - sta ]label_handle - ldy #`next+2 - lda []label_ptr],y - sta ]label_handle+2 - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - lda ]label_handle ;end if at end of linked list - ora ]label_handle+2 - bne :delete_label - rts - - -************************************************** -* delete @expr_list stack. * -************************************************** -delete_expr_list ent -]list_lo_handle = $f0 -]list_hi_handle = $f4 -]list_lo_ptr = $f8 -]list_hi_ptr = $fc - - ldx @expr_list+`lo - ldy @expr_list+`lo+2 - stx ]list_lo_handle - sty ]list_lo_handle+2 - ldx @expr_list+`hi - ldy @expr_list+`hi+2 - stx ]list_hi_handle - sty ]list_hi_handle+2 - lda []list_lo_handle] - sta ]list_lo_ptr - ldy #2 - lda []list_lo_handle],y - sta ]list_lo_ptr+2 - lda []list_hi_handle],y - sta ]list_hi_ptr - ldy #2 - lda []list_hi_handle],y - sta ]list_hi_ptr+2 - - ldy @expr_list+`size -:delete_list phy - lda []list_hi_ptr],y - pha - lda []list_lo_ptr],y - pha - _DisposeHandle - ply - dey - bne :delete_list - - pei ]list_lo_handle+2 - pei ]list_lo_handle - _DisposeHandle - pei ]list_hi_handle+2 - pei ]list_hi_handle - _DisposeHandle - rts - - -************************************************** -* match operator value with its string * -* representation. * -* ---------------------------------------------- * -* (input) * -* a - operator value. * -* (output) * -* x - HOW of string representing operator. * -* y - LOW of string representing operator. * -************************************************** -find_operator ent - - ldx #0 ;default is NULL string - ldy #0 - - cmp #ADD - bne :sub - ldx #^:add_str - ldy #:add_str - rts -:sub cmp #SUB - bne :mul - ldx #^:sub_str - ldy #:sub_str - rts -:mul cmp #MUL - bne :div - ldx #^:mul_str - ldy #:mul_str - rts -:div cmp #DIV - bne :mod - ldx #^:div_str - ldy #:div_str - rts -:mod cmp #MOD - bne :negation - ldx #^:mod_str - ldy #:mod_str - rts -:negation cmp #NEGATION - bne :bit_shift - ldx #^:negation_str - ldy #:negation_str - rts -:bit_shift cmp #BIT_SHIFT - bne :and - ldx #^:bit_shift_str - ldy #:bit_shift_str - rts -:and cmp #AND - bne :or - ldx #^:and_str - ldy #:and_str - rts -:or cmp #OR - bne :eor - ldx #^:or_str - ldy #:or_str - rts -:eor cmp #EOR - bne :not - ldx #^:eor_str - ldy #:eor_str - rts -:not cmp #NOT - bne :less_equal - ldx #^:not_str - ldy #:not_str - rts -:less_equal cmp #LESS_EQUAL - bne :greater_equal - ldx #^:less_equal_str - ldy #:less_equal_str - rts -:greater_equal cmp #GREATER_EQUAL - bne :not_equal - ldx #^:greater_equal_str - ldy #:greater_equal_str - rts -:not_equal cmp #NOT_EQUAL - bne :less - ldx #^:not_equal_str - ldy #:not_equal_str - rts -:less cmp #LESS - bne :greater - ldx #^:less_str - ldy #:less_str - rts -:greater cmp #GREATER - bne :equal - ldx #^:greater_str - ldy #:greater_str - rts -:equal cmp #EQUAL - bne :logical_and - ldx #^:equal_str - ldy #:equal_str - rts -:logical_and cmp #LOGICAL_AND - bne :inclusive_or - ldx #^:logical_and_str - ldy #:logical_and_str - rts -:inclusive_or cmp #INCLUSIVE_OR - bne :exclusive_or - ldx #^:inclusive_or_str - ldy #:inclusive_or_str - rts -:exclusive_or cmp #EXCLUSIVE_OR - bne :complement - ldx #^:exclusive_or_str - ldy #:exclusive_or_str - rts -:complement cmp #COMPLEMENT - bne :label_length - ldx #^:complement_str - ldy #:complement_str - rts -:label_length cmp #LABEL_LENGTH - bne :end - ldx #^:label_length_str - ldy #:label_length_str -:end rts - -:add_str strl '+' -:sub_str strl '-' -:mul_str strl '*' -:div_str strl '/' -:mod_str strl '%%' -:negation_str strl '~' -:bit_shift_str strl '|' -:and_str strl '&&' -:or_str strl '||' -:eor_str strl '.eor.' -:not_str strl '!' -:less_equal_str strl '<=' -:greater_equal_str strl '>=' -:not_equal_str strl '<>' -:less_str strl '<' -:greater_str strl '>' -:equal_str strl '=' -:logical_and_str strl '&' -:inclusive_or_str strl '.ior.' -:exclusive_or_str strl '.beor.' -:complement_str strl '.bnot.' -:label_length_str strl 'length (' - - -************************************************** -* match label name with expression name. * -* ---------------------------------------------- * -* (input) * -* x - LOW of expression name. * -* y - HOW of expression name. * -* (output) * -* x - HOW of label name (NULL if not found). * -* y - LOW of label name (NULL if not found). * -************************************************** -match_label ent -]expr_ptr = $f0 ;expression name string -]label_handle = $f4 ;linked list of labels -]label_ptr = $f8 -]expr_name_handle = $fc ;expression evaluation -]expr_name_ptr = $fc -]label_name_handle = $fc ;label name - - stx ]expr_ptr - sty ]expr_ptr+2 - - lda @label+`next ;fail if no labels in list - ora @label+`next+2 - beq :fail - ldx @label+`next - ldy @label+`next+2 - stx ]label_handle - sty ]label_handle+2 -:loop lda []expr_ptr] - sta :expr_len - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - ldy #`expr_name - lda []label_ptr],y - sta ]expr_name_handle - ldy #`expr_name+2 - lda []label_ptr],y - sta ]expr_name_handle+2 - ldy #2 - lda []expr_name_handle],y - tay - lda []expr_name_handle] - sta ]expr_name_ptr - sty ]expr_name_ptr+2 - - lda []expr_name_ptr] ;no comparison if lengths different - cmp :expr_len - bne :end_loop - - ldy #2 ;compare strings - shorta -:0 lda []expr_name_ptr],y - cmp []expr_ptr],y - bne :end_loop - iny - dec :expr_len - bne :0 - longa - - ldy #`label_name - lda []label_ptr],y - sta ]label_name_handle - ldy #`label_name+2 - lda []label_ptr],y - sta ]label_name_handle+2 - lda []label_name_handle] - tax - ldy #2 - lda []label_name_handle],y - tay - rts - -:end_loop longa - ldy #`next - lda []label_ptr],y - sta ]label_handle - ldy #`next+2 - lda []label_ptr],y - sta ]label_handle+2 - ora ]label_handle - bne :loop - -:fail ldx #NULL - ldy #NULL - rts - -:expr_len dw 0 ;length of expression string - - -************************************************** -* push value onto @expr_list stack. * -* ---------------------------------------------- * -* (input) * -* a - expression value. * -* x - LOW of expression label. * -* y - HOW of expression label. * -************************************************** -push_expr_list ent -]list_lo_handle = $e0 -]list_hi_handle = $e4 -]list_lo_ptr = $e8 -]list_hi_ptr = $ec -]expr_value = $f0 ;expression value -]expr_handle = $f2 ;handle to expression name -]expr_ptr = $f6 - - sta ]expr_value - stx ]expr_handle - sty ]expr_handle+2 - - txa ;alloc handle if operator is being - ora ]expr_handle+2 ;pushed on stack - bne :0 - - pha ;long - result - pha - pea #0 ;long - block size - pea #2 - lda userID ;word - user ID of block - pha - pea #attrNoCross ;word - block attributes - pha ;long - start of block - pha - _NewHandle - plx - ply - stx ]expr_handle - sty ]expr_handle+2 - -:0 lda []expr_handle] - sta ]expr_ptr - ldy #2 - lda []expr_handle],y - sta ]expr_ptr+2 - lda ]expr_value - sta []expr_ptr] - - lda @expr_list+`size - inc - asl - pea #0 - pha - pea #0 - pha - ldx @expr_list+`lo - ldy @expr_list+`lo+2 - phy - phx - _SetHandleSize - ldx @expr_list+`hi - ldy @expr_list+`hi+2 - phy - phx - _SetHandleSize - - ldx @expr_list+`lo - ldy @expr_list+`lo+2 - stx ]list_lo_handle - sty ]list_lo_handle+2 - ldx @expr_list+`hi - ldy @expr_list+`hi+2 - stx ]list_hi_handle - sty ]list_hi_handle+2 - 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 @expr_list+`size - asl - tay - lda ]expr_handle - sta []list_lo_ptr],y - lda ]expr_handle+2 - sta []list_hi_ptr],y - inc @expr_list+`size - rts - - -************************************************** - sav structure.l =general.s - lst off - -* UNIX coff utility -* general routines -* -* 1990-1992, tao Developer Project - - rel - xc - xc - mx %00 - - put coff.h ;global defines - put x.data ;data externals - put x.gsos ;GS/OS i/o externals - put x.tool ;ToolBox, GS/OS, ROM 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/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 - - -FloatDecimal equ $00 ;input to @dec_form is float -FixedDecimal equ $01 ;input to @dec_form is fixed - -;@dec_form data structure offsets -`style equ $00 ;output style (FloatDecimal, FixedDecimal) -`digits equ `style+2 ;number of significant digits - -;@decimal data structure offsets -`sgn equ $00 ;sign of number -`exp equ `sgn+2 ;exponent value -`sig equ `exp+2 - - -************************************************** -* store global command-line pointer to local * -* dp variables. * -* ---------------------------------------------- * -* (input) * -* a - offset into dp for where to store `lo, * -* `hi pointers. * -************************************************** -dp_argv ent -]argv_lo = $00 ;pointer to argv+`lo data -]argv_hi = $04 ;pointer to argv+`hi data - - sta $fe ;offset into dp - clc - tdc - tax ;save dp register - adc $fe - tcd - lda argv+`lo - sta ]argv_lo - lda argv+`lo+2 - sta ]argv_lo+2 - - lda argv+`hi - sta ]argv_hi - lda argv+`hi+2 - sta ]argv_hi+2 - txa ;restore dp register - tcd - rts - - -************************************************** -* display error messages. * -* ---------------------------------------------- * -* (input) * -* a - error number. * -* x - possible parameter (depending on error). * -* y - possible parameter (depending on error). * -************************************************** -error ent -]argv_lo = $f0 -]argv_hi = $f4 -]parm_ptr = $f8 ;pointer to parameter - - stx ]parm_ptr - sty ]parm_ptr+2 - tax - and #%11111111_00000000 ;get error type - sta :parm_type - txa - and #%00000000_11111111 ;get error number - - pea #^error ;offset into ~error_msg for error string - tax ;bank address is program bank address - lda ~error_msg,x ;for error message - pha - lda #]argv_lo - jsr dp_argv - jsr get_progname - - phy ;long - pointer to C-string - phx - _WriteCString - pea #':' - _WriteChar - pea #' ' - _WriteChar - _WriteCString - lda :parm_type - cmp #ERROR_STRING ;special case string parameter - bne :error_value - lda ]parm_ptr ;output usage information if no - ora ]parm_ptr+2 ;added parameter - beq :end - pei ]parm_ptr+2 - pei ]parm_ptr - _WriteCString -:end bra :usage - -:error_value cmp #ERROR_LHEX_VALUE - beq :lhex_value - ldx ]parm_ptr - ldy ]parm_ptr+2 - jsr print_long_dec - bra :usage - -:lhex_value ldx ]parm_ptr - ldy ]parm_ptr+2 - lda #8 - jsr print_fix_long_hex - -:usage put_cr - lda []argv_lo] ;first argument on command-line is - tax ;program name - lda []argv_hi] - tay - jmp usage - -:parm_type UnsignedShort ;parmater type - - -************************************************** -* return pointer to program name string minus * -* path. * -* ---------------------------------------------- * -* (output) * -* x - LOW of pointer to program name. * -* y - HOW of pointer to program name. * -************************************************** -get_progname ent -]argv_lo = $f0 -]argv_hi = $f4 -]progname = $fc - - lda #]argv_lo - jsr dp_argv - lda []argv_lo] ;first argument on command-line is - sta ]progname ;program name - lda []argv_hi] - sta ]progname+2 - - shorta -:start_loop ldy #0 -:loop lda []progname],y - beq :end - cmp #'/' - beq :separator - cmp #':' - beq :separator - iny - bra :loop -:separator clc - tya - inc - adc ]progname - sta ]progname - bcc :start_loop - inc ]progname+2 - bra :start_loop - -:end longa - ldx ]progname - ldy ]progname+2 - rts - - -************************************************** -* check if character is a printing character. * -* ---------------------------------------------- * -* (input) * -* a - character to test. * -* (output) * -* c - set if non-printing character. * -************************************************** -isprint ent - - cmp #' ' ;' ' to '~' is a printing character - blt :non_printing - cmp #'~'+1 - bge :non_printing -:printing clc - rts -:non_printing sec - rts - - -************************************************** -* make alpha characters in hex string lowercase. * -* ---------------------------------------------- * -* (input) * -* a - number of characters in string. * -* x - address of hex string in current bank. * -************************************************** -lowercase_hex ent -]str = $fe - - stx ]str - dec - tay - shorta -:loop lda (]str),y - ora #%00100000 ;make lowercase - sta (]str),y - dey - bpl :loop - longa - rts - - -************************************************** -* convert GSOS call number to equivalent name. * -* ---------------------------------------------- * -* (input) * -* a - call number. * -* (output) * -* x - LOW pointer to equivalent name. * -* y - HOW pointer to equivalent name. * -* c - set if call number not found. * -************************************************** -name_GSOS ent -]callnum = $f0 ;GSOS call number -]offset = $f2 ;offset into ~gsos for call name - - sta ]callnum - lsr - lsr - lsr - lsr - lsr - lsr - lsr - lsr - asl - tax - lda ~gsos,x - beq :end ;call number undefined - sta ]offset - tay - - lda (]offset) ;get number of name equivalents - tax - iny - iny - sty ]offset - ldy #2 - -:loop lda (]offset) - cmp ]callnum - bne :next_name - ldx ]offset - inx - inx - ldy #^~gsos - clc - rts - -:next_name lda (]offset),y - and #$ff ;get length of pStr-defined name - clc - adc #3 - adc ]offset - sta ]offset - dex - bne :loop - -:end sec - rts - - -************************************************** -* convert ROM address to equivalent name. * -* ---------------------------------------------- * -* (input) * -* x - LOW of ROM address. * -* y - HOW of ROM address. * -* (output) * -* x - LOW pointer to equivalent name. * -* y - HOW pointer to equivalent name. * -* c - set if call number not found. * -************************************************** -name_ROM ent -]rom_adr = $f0 ;ROM address -]offset = $f4 ;offset into ~gsos for call name - - stx ]rom_adr - sty ]rom_adr+2 - tya - asl - tay - lda ~rom,y - beq :end ;call number undefined - sta ]offset - lda ]rom_adr - lsr - lsr - lsr - lsr - lsr - lsr - lsr - lsr - asl - tay - lda (]offset),y - beq :end - sta ]offset - tay - - lda (]offset) ;get number of name equivalents - tax - iny - iny - sty ]offset - ldy #2 - -:loop lda (]offset) - cmp ]rom_adr - bne :next_name - ldx ]offset - inx - inx - ldy #^~rom - clc - rts - -:next_name lda (]offset),y - and #$ff ;get length of pStr-defined name - clc - adc #3 - adc ]offset - sta ]offset - dex - bne :loop - -:end sec - rts - - -************************************************** -* convert ToolBox call number to equivalent * -* name. * -* ---------------------------------------------- * -* (input) * -* a - call number. * -* (output) * -* x - LOW pointer to equivalent name. * -* y - HOW pointer to equivalent name. * -* c - set if call number not found. * -************************************************** -name_TOOL ent -]toolnum = $f0 ;Toolbox call number -]offset = $f2 ;offset into ~gsos for call name - - sta ]toolnum - and #$ff - asl - tax - lda #^~tool - lda ~tool,x - beq :end ;call number undefined - sta ]offset - tay - - lda (]offset) ;get number of name equivalents - tax - iny - iny - sty ]offset - ldy #2 - -:loop lda (]offset) - cmp ]toolnum - bne :next_name - ldx ]offset - inx - inx - ldy #^~tool - clc - rts - -:next_name lda (]offset),y - and #$ff ;get length of pStr-defined name - clc - adc #3 - adc ]offset - sta ]offset - dex - bne :loop - -:end sec - rts - - -************************************************** -* output number as char decimal string. * -* ---------------------------------------------- * -* (input) * -* x - value to output. * -* (output) * -* a - number of characters output. * -************************************************** -print_char_dec ent - - phx - phx ;word - longint to convert - pea #^char_dec_str ;long - pointer to output string - pea #char_dec_str - pea #3 ;word - length of string - pea #FALSE ;word - unsigned number - _Int2Dec - plx - bne :0 - ldx #2 - bra :2 -:0 ldx #$ffff -:1 inx - lda char_dec_str,x - and #$ff - cmp #' ' - beq :1 -:2 pea #^char_dec_str ;long - pointer to string - pea #char_dec_str - phx ;word - offset into text - sec ;word - number of characters to print - lda #3 - sbc 1,s - sta :strlen - pha - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - - lda :strlen - rts - -:strlen ds 2 ;number of characters output - - -************************************************** -* output number as short decimal string. * -* ---------------------------------------------- * -* (input) * -* x - value to output. * -************************************************** -print_short_dec ent - - phx - phx ;word - longint to convert - pea #^short_dec_str ;long - pointer to output string - pea #short_dec_str - pea #5 ;word - length of string - pea #FALSE ;word - unsigned number - _Int2Dec - plx - bne :0 - ldx #4 - bra :2 -:0 ldx #$ffff -:1 inx - lda short_dec_str,x - and #$ff - cmp #' ' - beq :1 -:2 pea #^short_dec_str ;long - pointer to string - pea #short_dec_str - phx ;word - offset into text - sec ;word - number of characters to print - lda #5 - sbc 1,s - pha - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as long decimal string. * -* ---------------------------------------------- * -* (input) * -* x - LOW of value to output. * -* y - HOW of value to output. * -************************************************** -print_long_dec ent - - phy - phx - phy ;long - longint to convert - phx - pea #^long_dec_str ;long - pointer to output string - pea #long_dec_str - pea #10 ;word - length of string - pea #FALSE ;word - unsigned number - _Long2Dec - pla - ora 1,s - plx - cmp #0 - bne :0 - ldx #9 - bra :2 -:0 ldx #$ffff -:1 inx - lda long_dec_str,x - and #$ff - cmp #' ' - beq :1 -:2 pea #^long_dec_str ;long - pointer to string - pea #long_dec_str - phx ;word - offset into text - sec ;word - number of characters to print - lda #10 - sbc 1,s - pha - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output signed number as char decimal string. * -* ---------------------------------------------- * -* (input) * -* x - value to output. * -* (output) * -* a - number of characters output. * -************************************************** -print_char_sdec ent - - phx - phx ;word - longint to convert - pea #^char_dec_str ;long - pointer to output string - pea #char_dec_str - pea #4 ;word - length of string - pea #TRUE ;word - signed number - _Int2Dec - plx - bne :0 - ldx #3 - bra :2 -:0 ldx #$ffff -:1 inx - lda char_dec_str,x - and #$ff - cmp #' ' - beq :1 -:2 pea #^char_dec_str ;long - pointer to string - pea #char_dec_str - phx ;word - offset into text - sec ;word - number of characters to print - lda #4 - sbc 1,s - sta :strlen - pha - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - - lda :strlen - rts - -:strlen ds 2 ;number of characters output - - -************************************************** -* output number as fixed char decimal string. * -* ---------------------------------------------- * -* (input) * -* a - number of bytes to output. * -* x - value to output. * -************************************************** -print_fix_char_dec ent -]num_bytes = $f0 ;number of bytes to output - - sta ]num_bytes - - phx ;word - char to convert - pea #^char_dec_str ;long - pointer to output string - pea #char_dec_str - pha ;word - length of string - pea #FALSE ;word - unsigned number - _Int2Dec - pea #^char_dec_str ;long - pointer to string - pea #char_dec_str - pea #0 ;word - offset into text - pei ]num_bytes ;word - number of characters to print - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as fixed short decimal string. * -* ---------------------------------------------- * -* (input) * -* a - number of bytes to output. * -* x - value to output. * -************************************************** -print_fix_short_dec ent -]num_bytes = $f0 ;number of bytes to output - - sta ]num_bytes - - phx ;word - short to convert - pea #^short_dec_str ;long - pointer to output string - pea #short_dec_str - pha ;word - length of string - pea #FALSE ;word - unsigned number - _Int2Dec - pea #^short_dec_str ;long - pointer to string - pea #short_dec_str - pea #0 ;word - offset into text - pei ]num_bytes ;word - number of characters to print - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as fixed long decimal string. * -* ---------------------------------------------- * -* (input) * -* a - number of bytes to output. * -* x - LOW of value to output. * -* y - HOW of value to output. * -************************************************** -print_fix_long_dec ent -]num_bytes = $f0 ;number of bytes to output - - sta ]num_bytes - - phy ;long - longint to convert - phx - pea #^long_dec_str ;long - pointer to output string - pea #long_dec_str - pha ;word - length of string - pea #FALSE ;word - unsigned number - _Long2Dec - pea #^long_dec_str ;long - pointer to string - pea #long_dec_str - pea #0 ;word - offset into text - pei ]num_bytes ;word - number of characters to print - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as long hex string. * -* ---------------------------------------------- * -* (input) * -* x - LOW of value to output. * -* y - HOW of value to output. * -************************************************** -print_long_hex ent - - phy - phx - phy ;long - longint to convert - phx - pea #^long_hex_str ;long - pointer to output string - pea #long_hex_str - pea #8 ;word - length of string - _Long2Hex - pla - ora 1,s - plx - cmp #0 - bne :0 - ldx #7 - bra :2 -:0 ldx #long_hex_str ;make hex alpha lowercase - ldy #^long_hex_str - lda #8 - jsr lowercase_hex - ldx #$ffff -:1 inx - lda long_dec_str,x - and #$ff - cmp #'0' - beq :1 -:2 pea #^long_hex_str ;long - pointer to string - pea #long_hex_str - phx ;word - offset into text - sec ;word - number of characters to print - lda #8 - sbc 1,s - pha - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as fixed char hex string. * -* ---------------------------------------------- * -* (input) * -* x - value to output. * -************************************************** -print_fix_char_hex ent - - phx ;word - char to convert - pea #^char_hex_str ;long - pointer to output string - pea #char_hex_str - pea #2 ;word - length of string - _Int2Hex - ldx #char_hex_str ;make hex alpha lowercase - ldy #^char_hex_str - lda #2 - jsr lowercase_hex - pea #^char_hex_str ;long - pointer to string - pea #char_hex_str - pea #0 ;word - offset into text - pea #2 ;word - number of characters to print - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as fixed short hex string. * -* ---------------------------------------------- * -* (input) * -* a - number of bytes to output. * -* x - value to output. * -************************************************** -print_fix_short_hex ent - - pha - phx ;word - short to convert - pea #^short_hex_str ;long - pointer to output string - pea #short_hex_str - pha ;word - length of string - _Int2Hex - ldx #short_hex_str ;make hex alpha lowercase - ldy #^short_hex_str - lda 1,s - jsr lowercase_hex - pla - pea #^short_hex_str ;long - pointer to string - pea #short_hex_str - pea #0 ;word - offset into text - pha ;word - number of characters to print - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as fixed long hex string. * -* ---------------------------------------------- * -* (input) * -* a - number of bytes to output. * -* x - LOW of value to output. * -* y - HOW of value to output. * -************************************************** -print_fix_long_hex ent - - pha - phy ;long - longint to convert - phx - pea #^long_hex_str ;long - pointer to output string - pea #long_hex_str - pha ;word - length of string - _Long2Hex - ldx #long_hex_str ;make hex alpha lowercase - ldy #^long_hex_str - lda 1,s - jsr lowercase_hex - pla - pea #^long_hex_str ;long - pointer to string - pea #long_hex_str - pea #0 ;word - offset into text - pha ;word - number of characters to print - _TextWriteBlock - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* format and print @decimal record. * -* ---------------------------------------------- * -* (output) * -* a - number of characters output. * -************************************************** -print_@decimal equ * -]str_len = $f0 ;length of output string - - pea #^@dec_form - pea #@dec_form - pea #^@decimal - pea #@decimal - pea #^:dec_str - pea #:dec_str - _Dec2Str - - lda :dec_str - and #$ff - tax -:0 lda :dec_str,x - and #$ff - cpx #1 - beq :1 - cmp #'0' - bne :1 - dex - bra :0 - -:1 cmp #'.' - bne :2 - dex -:2 shorti - stx :dec_str - longi - pea #^:dec_str - pea #:dec_str - _WriteString - lda :dec_str - and #$ff - rts - -:dec_str ds $50 - - -************************************************** -* output number as double floating-point string. * -* ---------------------------------------------- * -* (input) * -* a - dp address of double float value. * -* (output) * -* a - number of characters output. * -************************************************** -print_double ent - - pea #^@dec_form ;long - address of decform record - pea #@dec_form - pea #0 ;long - address of float value - pha - clc - tdc - adc 1,s - sta 1,s - pea #^@decimal ;long - address of decimal record - pea #@decimal - lda #FixedDecimal - sta @dec_form+`style - lda #5 ;5 digits to right of decimal - sta @dec_form+`digits - _Double2Decimal - jsr print_@decimal - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as extended float string. * -* ---------------------------------------------- * -* (input) * -* a - dp address of extended value. * -* (output) * -* a - number of characters output. * -************************************************** -print_extended ent - - pea #^@dec_form ;long - address of decform record - pea #@dec_form - pea #0 ;long - address of float value - pha - clc - tdc - adc 1,s - sta 1,s - pea #^@decimal ;long - address of decimal record - pea #@decimal - lda #FixedDecimal - sta @dec_form+`style - lda #10 ;10 digits to right of decimal - sta @dec_form+`digits - _Extended2Decimal - jsr print_@decimal - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* output number as floating-point string. * -* ---------------------------------------------- * -* (input) * -* a - dp address of float value. * -* (output) * -* a - number of characters output. * -************************************************** -print_float ent - - pea #^@dec_form ;long - address of decform record - pea #@dec_form - pea #0 ;long - address of float value - pha - clc - tdc - adc 1,s - sta 1,s - pea #^@decimal ;long - address of decimal record - pea #@decimal - lda #FixedDecimal - sta @dec_form+`style - lda #5 ;5 digits to right of decimal - sta @dec_form+`digits - _Float2Decimal - jsr print_@decimal - - do ENV&{MERLIN_ENV.ORCA_ENV} - jsr test_key - fin - rts - - -************************************************** -* print displacement, counter offset. * -************************************************** -print_offset ent - - lda }nooffset - bne :end - lda #6 - ldx @omf+`displacement - ldy @omf+`displacement+2 - jsr print_fix_long_hex - pea #' ' - _WriteChar - lda #6 - ldx @omf+`counter - ldy @omf+`counter+2 - jsr print_fix_long_hex - pea #^vert_separator+1 - pea #vert_separator+1 - _WriteCString -:end rts - - -************************************************** -* format printed output. * -* ---------------------------------------------- * -* (input) * -* a - address of string to parse. * -* x - HOW of argument. * -* y - LOW of argument. * -* (output) * -* x - number of characters output. * -************************************************** -printf ent -]arg_str = $e0 ;address of string to parse -]arg = $e2 ;argument -]print_begin = $e6 ;location of first character to print -]print_end = $e8 ;location of last character to print -]count = $ea ;number of characters output - - sta ]arg_str - stx ]arg+2 - sty ]arg - stz ]count - - ldy #0 - sty ]print_begin - sty ]print_end -:parse_arg_str lda #0 - shorta - lda (]arg_str),y - longa - beq :end - cmp #'%' - beq :parse_format - iny - inc ]count - bra :parse_arg_str - -:end sty ]print_end - cpy ]print_begin ;end if nothing left to print - beq :rts - pea #^printf - pei ]arg_str - pei ]print_begin - sec - lda ]print_end - sbc ]print_begin - pha - _TextWriteBlock -:rts ldx ]count - rts - -:parse_format phy - sty ]print_end - pea #^printf - pei ]arg_str - pei ]print_begin - sec - lda ]print_end - sbc ]print_begin - pha - _TextWriteBlock - lda 1,s - tay - iny - lda #0 - shorta - lda (]arg_str),y - longa - cmp #'2' - bne :hex_4 - lda #2 - ldx ]arg - jsr print_fix_char_hex - inc ]count - inc ]count - bra :end_parse -:hex_4 cmp #'4' - bne :hex_6 - lda #4 - ldx ]arg - jsr print_fix_short_hex - inc ]count - inc ]count - inc ]count - inc ]count - bra :end_parse -:hex_6 cmp #'6' - bne :char - lda #6 - ldx ]arg - ldy ]arg+2 - jsr print_fix_long_hex - inc ]count - inc ]count - inc ]count - inc ]count - inc ]count - inc ]count - bra :end_parse -:char pea #'>' - lda ~assembler - cmp #MERLIN - beq :0 - lda #'|' - sta 1,s -:0 _WriteChar - inc ]count -:end_parse ply - iny - iny - sty ]print_begin - sty ]print_end - brl :parse_arg_str - - -************************************************** -* find first occurrence of a character in a * -* string in current bank. * -* ---------------------------------------------- * -* (input) * -* a - character to find. * -* x - address of search string in current bank. * -* (output) * -* x - address of where character is located. * -* 0 if character not found. * -************************************************** -strchr ent -]char = $f0 ;character to find -]string = $f2 ;string to search - - sta ]char - stx ]string - - ldy #0 - shorta -:loop lda (]string),y - cmp ]char - beq :end - cmp #0 - beq :error - iny - bra :loop -:end longa - clc - tya - adc ]string - tax - rts -:error longa - ldx #0 - rts - - - do ENV&{MERLIN_ENV.ORCA_ENV} -************************************************** -* test for special keypresses: * -* ctrl-s: pause output * -* ctrl-c: terminate program * -************************************************** -test_key ent - - lda #0 - shorta - ldal KBD - longa - bpl :print - cmp #CTRL_C.$80 - beq :exit - - shorta - stal KBDSTRB -:pause ldal KBD - bpl :pause - bra :clear_kbd - -:exit pla - bne :exit - do ENV&MERLIN_ENV - put_cr - fin -:clear_kbd shorta - stal KBDSTRB - longa -:print rts - fin - - -************************************************** -* get length of C-string. * -* ---------------------------------------------- * -* (input) * -* x - LOW of pointer to C-string. * -* y - HOW of pointer to C-string. * -* (output) * -* y - length of C-string. * -************************************************** -strlen ent -]cstr = $f0 - - stx ]cstr - sty ]cstr+2 - - ldy #0 - shorta -:0 lda []cstr],y - beq :end - iny - bra :0 - -:end longa - rts - - -************************************************** -* display options strings of all coff options * -* and exit coff. * -* ---------------------------------------------- * -* (input) * -* x - LOW of program name. * -* y - HOW of program name. * -************************************************** -usage ent -]usage_handle = $f0 ;handle to verbose usage string -]usage_ptr = $f4 -]progname = $f8 ;name of program - - stx ]progname - sty ]progname+2 - - pha ;long - result - pha - pea #rText ;word - type of resource - pea #^USAGE ;long - ID Of resource - pea #USAGE - _LoadResource - plx - ply - stx ]usage_handle - sty ]usage_handle+2 - pea #^usage_str - pea #usage_str - _WriteCString - pei ]progname+2 - pei ]progname - _WriteCString - ldy #2 - lda []usage_handle],y - pha - lda []usage_handle] - pha - _WriteCString -:0 pla - bne :0 - rts - - -************************************************** -* display options strings and descriptions of * -* all coff options and exit coff. * -* ---------------------------------------------- * -* (input) * -* x - LOW of program name. * -* y - HOW of program name. * -************************************************** -usage_verbose ent -]usage_handle = $f0 ;handle to verbose usage string -]usage_ptr = $f4 -]progname = $f8 ;name of program - - stx ]progname - sty ]progname+2 - - pha ;long - result - pha - pea #rText ;word - type of resource - pea #^USAGE_VERBOSE ;long - ID Of resource - pea #USAGE_VERBOSE - _LoadResource - plx - ply - stx ]usage_handle - sty ]usage_handle+2 - pei ]progname+2 - pei ]progname - _WriteCString - ldy #2 - lda []usage_handle],y - pha - lda []usage_handle] - pha - _WriteCString -:0 pla - bne :0 - rts - - -************************************************** -usage_str cStr 'usage: ' - -@dec_form equ * ;SANE Decform record -:style UnsignedShort ;output style (FloatDecimal, FixedDecimal) -:digits UnsignedShort ;number of significant digits - -@decimal equ * ;SANE Decimal record -:sgn UnsignedShort ;sign of number -:exp UnsignedShort ;exponent value -:sig ds 20 - -************************************************** - sav general.l + END OF ARCHIVE