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

Wrap

Internet Message Format | 1992-11-08 | 62.8 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: v001SRC067: coff (OMF Disassembler) 02/09 Message-ID: <Nov.8.19.11.28.1992.16608@yoko.rutgers.edu> Date: 9 Nov 92 00:11:29 GMT Organization: Rutgers Univ., New Brunswick, N.J. Lines: 3531 Approved: jac@paul.rutgers.edu Submitted-by: Albert Chin-A-Young (26285659t@servax.fiu.edu) Posting-number: Volume 1, Source:67 Archive-name: utility/gs/disassem/coff/part02 Architecture: ONLY_2gs Version-number: 1.1 =asm.s - lst off - -* UNIX coff utility -* 65816 OMF disassembler -* -* 1990-1992, tao Developer Project - - rel - xc - xc - mx %00 - - put coff.h ;global defines - put x.data ;data externals - put x.general ;general externals - put x.gsos ;GS/OS i/o externals - put x.omf ;OMF parser externals - put x.output ;output externals - put x.structure ;data structure externals - - put 4/gsos.h ;GS/OS defines - put 4/memory.h ;memory manager defines - put 4/resource.h ;resouce manager defines - put 4/texttool.h ;text tool defines - put 4/env.h ;run-time environment settings - - use coff.mac ;macro definitions - use 4/datatype.mac ;HLL data types - use 4/env.mac ;run-time environment macros - - -* dp $9x-$cx taken - -************************************************** -* display header for asm disassembly. * -************************************************** -display_header_asm ent -]segname_handle = $f0 ;handle to segment name -]segname_ptr = $f4 -]segname_len = $f8 ;length of segment name - - ldx @omf+`segname+2 - ldy @omf+`segname - stx ]segname_handle+2 - sty ]segname_handle - ldy #2 - lda []segname_handle],y - sta ]segname_ptr+2 - lda []segname_handle] - sta ]segname_ptr - lda []segname_ptr] - sta ]segname_len - - lda ~assembler - cmp #MERLIN - bne :orca - lda #LONGA - jsr asm_status_bit - jsr print_offset - pei ]segname_ptr+2 - pei ]segname_ptr - pea #2 - pei ]segname_len - _TextWriteBlock - lda ]segname_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]segname_len - pha - _TextWriteBlock -:1 pea #^EQU_asm - pea #EQU_asm - _WriteCString - pea #'*' - _WriteChar - bra :end - -:orca lda #LONGA - jsr asm_status_bit - lda #LONGI - jsr asm_status_bit - jsr print_offset - pei ]segname_ptr+2 - pei ]segname_ptr - pea #2 - pei ]segname_len - _TextWriteBlock - lda ]segname_len - cmp #12 - blt :2 - pea #' ' - _WriteChar - bra :3 -:2 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]segname_len - pha - _TextWriteBlock -:3 lda @omf+`kind - and #DATA - cmp #DATA - bne :start - pea #^:data_str - pea #:data_str - _WriteCString - bra :end -:start pea #^:start_str - pea #:start_str - _WriteCString -:end put_cr - rts - -:data_str cStr 'data' -:start_str cStr 'start' - - -************************************************** -* display status of accumulator and index * -* registers (short/long). * -* ---------------------------------------------- * -* (input) * -* a - display accumulator or index status. * -************************************************** -asm_status_bit equ * -]status_bit = $e0 - - sta ]status_bit - - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - lda ~assembler - cmp #MERLIN - bne :orca - -:merlin pea #^:mx_str - pea #:mx_str - _WriteCString - ldx #'0' - lda }shorti - bne :test_shorta - ldx #'1' -:test_shorta phx - ldx #'0' - lda }shorta - bne :merlin_end - ldx #'1' -:merlin_end phx - _WriteChar - _WriteChar - put_cr - rts - -:orca lda ]status_bit - cmp #LONGA - bne :longi - pea #^:longa_str - pea #:longa_str - _WriteCString - lda }shorta - beq :longa_off - pea #^:off_str - pea #:off_str - bra :end -:longa_off pea #^:on_str - pea #:on_str - bra :end - -:longi pea #^:longi_str - pea #:longi_str - _WriteCString - lda }shorti - beq :longi_off - pea #^:off_str - pea #:off_str - bra :end -:longi_off pea #^:on_str - pea #:on_str - -:end _WriteCString - put_cr - rts - -:mx_str cStr 'mx %' -:longa_str cStr 'longa ' -:longi_str cStr 'longi ' -:on_str cStr 'on' -:off_str cStr 'off' - - -************************************************** -* parse CONST record for disassembling. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -************************************************** -parse_CONST_asm ent -]count = $90 ;number of bytes to read -]edge = $94 ;right margin for output -]record = $96 ;record number -]opcode = $98 ;opcode to parse -]opcode_adr = $9a ;address of opcode data - - sta ]record - stz ]opcode - stz ]count+2 - stz ]count - - cmp #LCONST - bne :const - read_long ]count - clc - lda @omf+`displacement - adc #4 - sta @omf+`displacement - bcc :loop - inc @omf+`displacement+2 - bra :loop -:const sta ]count - -:loop lda ]count - ora ]count+2 - bne :print_opcode - rts -:print_opcode read_char ]opcode - pea #^space_12 ;indent to print opcode and operand - pea #space_12 - _WriteCString - lda ]opcode - asl - tax - lda ~opcodes,x - sta ]opcode_adr - ldy #`num_bytes ;parse opcode depending on number - lda (]opcode_adr),y ;of bytes it takes - cmp #1 - bne :2_bytes - lda ]opcode - jsr parse_opcode_1 - lda ]count - bne :0 - dec ]count+2 -:0 dec ]count - bra :end_loop -:2_bytes cmp #2 - bne :3_bytes - lda ]opcode - ldx ]count+2 - ldy ]count - jsr parse_opcode_2 - stx ]count+2 - sty ]count - bra :end_loop -:3_bytes cmp #3 - bne :4_bytes - lda ]opcode - ldx ]count+2 - ldy ]count - jsr parse_opcode_3 - stx ]count+2 - sty ]count - bra :end_loop -:4_bytes lda ]opcode - ldx ]count+2 - ldy ]count - jsr parse_opcode_4 - stx ]count+2 - sty ]count - -:end_loop lda }nooffset - beq :1 - brl :loop -:1 lda ]count+2 - ora ]count - beq :end - jsr print_offset - brl :loop -:end rts - - -************************************************** -* parse opcodes that accept 1-byte operands. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -************************************************** -parse_opcode_1 equ * -]opcode = $a0 ;opcode -]opcode_adr = $a2 ;pointer to information about opcode -]opcode_syntax = $a4 ;string syntax of opcode - - sta ]opcode - asl - tax - lda ~opcodes,x - sta ]opcode_adr - - pea #^parse_opcode_1 - clc - lda ]opcode_adr - adc #`syntax - pha - _WriteCString - - ldy #`mode - lda (]opcode_adr),y - cmp #ACCUMULATOR - bne :0 - lda ~assembler - cmp #ORCA - bne :0 - pea #'a' - bra :1 -:0 pea #' ' -:1 _WriteChar - - lda }hex - beq :2 - pea #^blank_str ;separate asm/hex-ascii output - pea #blank_str - pea #0 - pea #24 - _TextWriteBlock -:2 lda ]opcode - ora #$0100 - ldx #0 - txy - jsr print_hex_ascii - incr @omf+`displacement - incr @omf+`counter -:end rts - - -************************************************** -* parse opcodes that accept 2-byte operands. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -* (output) * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -************************************************** -parse_opcode_2 equ * -]opcode = $a0 ;opcode -]count = $a2 ;number of bytes to disassemble -]operand = $a6 ;operand of opcode -]opcode_adr = $a8 ;pointer to information about opcode - - sta ]opcode - stx ]count+2 - sty ]count - stz ]operand - asl - tax - lda ~opcodes,x - sta ]opcode_adr - - ldy #`m ;test if operand affected by short - lda (]opcode_adr),y ;accumulator - beq :test_i - lda }shorta - beq :short -:test_i ldy #`i ;test if operand affected by short - lda (]opcode_adr),y ;indexes - bne :test_short - brl :print_opcode -:test_short lda }shorti - beq :short - brl :print_opcode -:short lda ]count+2 - bne :0 - lda ]count - cmp #3 - blt :3 -:0 incr #3;@omf+`displacement - incr #3;@omf+`counter - read_short ]operand ;because shorta or shorti is not - lda }tool ;active, read in two byte operand - beq :1 - lda ]opcode - cmp #LDX - bne :1 - pei ]count+2 - pei ]count - pei ]operand - pei ]opcode - jsr parse_stack - stx ]count+2 - sty ]count - bra :2 -:1 lda ]opcode - ldx ]operand - jsr print_opcode_3 -:2 sec - lda ]count - sbc #3 - tay - lda ]count+2 - sbc #0 - tax - rts - -:3 cmp #2 - beq :5 - clc - lda @omf+`counter - adc #3 - tax - lda @omf+`counter+2 - adc #0 - cmp @omf+`length+2 - blt :4 - cpx @omf+`length - beq :4 - blt :5 -:4 lda ]opcode - jsr parse_expr_asm - bra :6 -:5 lda ]opcode - ldx ]count - jsr print_byte -:6 ldx #0 - txy - rts - -:print_opcode lda ]count+2 - bne :8 - lda ]count - cmp #2 - blt :9 -:8 lda ]opcode - jsr print_opcode_2 - sec - lda ]count - sbc #2 - tay - lda ]count+2 - sbc #0 - tax - rts -:9 clc - lda @omf+`counter - adc #2 - tax - lda @omf+`counter+2 - adc #0 - cmp @omf+`length+2 - blt :10 - cpx @omf+`length - beq :10 - bge :11 -:10 lda ]opcode - jsr parse_expr_asm - bra :12 -:11 lda ]opcode - ldx ]count - jsr print_byte -:12 ldx #0 - txy - rts - - -************************************************** -* print opcodes that generate two bytes. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -************************************************** -print_opcode_2 equ * -]opcode = $b0 ;opcode -]operand = $b2 ;operand of opcode -]opcode_adr = $b4 ;pointer to information about opcode -]opcode_syntax = $b6 ;string syntax of opcode -]offset = $b8 ;offset into line - - sta ]opcode - stz ]operand - asl - tax - lda ~opcodes,x - sta ]opcode_adr - - read_char ]operand - ldy #`mode - lda (]opcode_adr),y - cmp #PC_RELATIVE - bne :2 - lda ]operand - cmp #$80 - bge :sub_operand -:add_operand clc - lda @omf+`counter - adc ]operand - bra :printf -:sub_operand sec ;@omf+`counter+($ff-]operand) - lda @omf+`counter - sbc #$100 - clc - adc ]operand -:printf inc - inc - tay - ldx #0 - clc - lda ]opcode_adr - adc #`syntax - jsr printf - stx ]offset - pea #^:space - pea #:space - _WriteCString - clc - lda #4 - adc ]offset - sta ]offset - ldx #'+' - lda ]operand - cmp #$80 - blt :print_char - ldx #'-' -:print_char phx - _WriteChar - inc ]offset - ldx ]operand - cpx #$80 - blt :print_operand - sec - lda #$100 - sbc ]operand - tax -:print_operand jsr print_fix_char_hex - inc ]offset - inc ]offset - pea #'}' - _WriteChar - inc ]offset - bra :print_hex - -:2 clc - lda ]opcode_adr - adc #`syntax - ldx ]operand+2 - ldy ]operand - jsr printf - stx ]offset - -:print_hex lda }hex - beq :3 - pea #^blank_str ;separate asm/hex-ascii output - pea #blank_str - pea #0 - sec - lda #32 - sbc ]offset - pha - _TextWriteBlock -:3 lda ]opcode - ora #$0200 - ldx #0 - ldy ]operand - jsr print_hex_ascii - lda ]opcode - cmp #REP - beq :parse_rep_sep - cmp #SEP - bne :4 - -:parse_rep_sep lda ]opcode - ldx ]operand - jsr parse_rep_sep - -:4 incr #2;@omf+`displacement - incr #2;@omf+`counter - rts - -:space cStr ' {' - - -************************************************** -* parse opcodes that accept 3-byte operands. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -* (output) * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -************************************************** -parse_opcode_3 equ * -]opcode = $a0 ;opcode -]count = $a2 ;number of bytes to disassemble -]tmp_count = $a6 -]operand = $aa ;operand of opcode - - sta ]opcode - stx ]count+2 - sty ]count - - cpx #1 ;expand opcode only if 3 bytes - bge :print_opcode ;available - cpy #3 - bge :print_opcode - cpy #2 ;test if two bytes left in three-byte - beq :1 ;opcode/operand. if so, print bytes. - clc ;test if at end of OMF segment - lda @omf+`counter - adc #3 - tax - lda @omf+`counter+2 - adc #0 - cmp @omf+`length+2 - blt :0 - cpx @omf+`length - beq :0 - bge :1 -:0 lda ]opcode - jsr parse_expr_asm - bra :2 -:1 lda ]opcode - ldx ]count - jsr print_byte -:2 ldx #0 - txy - rts - -:print_opcode incr #3;@omf+`displacement - incr #3;@omf+`counter - read_short ]operand - lda }tool - beq :5 - lda ]opcode - cmp #JSR - bne :4 - lda ]operand - ldx ]count+2 - ldy ]count - jsr parse_inline_3 - stx ]tmp_count+2 - sty ]tmp_count - cpx ]count+2 - bne :3 - cpy ]count - bne :3 - lda ]opcode - ldx ]operand - jsr print_opcode_3 - bra :end -:3 ldx ]tmp_count+2 - ldy ]tmp_count - stx ]count+2 - sty ]count - bra :end -:4 lda ]opcode - cmp #PEA - bne :5 - pei ]count+2 - pei ]count - pei ]operand - pei ]opcode - jsr parse_stack - stx ]count+2 - sty ]count - bra :end -:5 lda ]opcode - ldx ]operand - jsr print_opcode_3 - -:end sec - lda ]count - sbc #3 - tay - lda ]count+2 - sbc #0 - tax - rts - - -************************************************** -* print opcodes that generate three bytes. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - operand. * -************************************************** -print_opcode_3 equ * -]opcode = $b0 ;opcode -]operand = $b2 ;operand of opcode -]opcode_adr = $b4 ;pointer to information about opcode -]offset = $b6 ;offset into line -]ROM_ptr = $b8 ;pointer to ROM name - - sta ]opcode - stx ]operand - asl - tax - lda ~opcodes,x - sta ]opcode_adr - stz ]offset - - ldy #`mode - lda (]opcode_adr),y - cmp #ABSOLUTE - bne :pc_relative_long - lda }tool - bne :ROM_tool - brl :default -:ROM_tool ldx ]operand - ldy #0 - jsr name_ROM - stx ]ROM_ptr - sty ]ROM_ptr+2 - bcc :print_ROM - brl :default -:print_ROM phy - phx - pea #^print_opcode_3 - clc - lda ]opcode_adr - adc #`syntax - pha - pea #0 - pea #7 - _TextWriteBlock - _WriteString - lda []ROM_ptr] - and #$ff - clc - adc #7 - sta ]offset - brl :end - -:pc_relative_long cmp #PC_RELATIVE_LONG - bne :block_move - lda ]operand - bmi :sub_operand -:add_operand clc - lda @omf+`counter - adc ]operand - bra :printf -:sub_operand sec - lda @omf+`counter - sbc ]operand -:printf inc - inc - tay - ldx #0 - clc - lda ]opcode_adr - adc #`syntax - jsr printf - stx ]offset - pea #^:space - pea #:space - _WriteCString - ldx #'+' - lda ]operand - bpl :print_char - ldx #'-' -:print_char phx - _WriteChar - ldx ]operand - bpl :print_operand - sec - lda #$ffff - sbc ]operand - inc - tax -:print_operand lda #4 - jsr print_fix_short_hex - clc - lda ]offset - adc #10 - sta ]offset - pea #'}' - _WriteChar - brl :end - -:block_move cmp #BLOCK_MOVE - bne :immediate - pea #^print_opcode_3 - clc - lda ]opcode_adr - adc #`syntax - pha - _WriteCString - lda ]operand - xba - and #$ff - tax - jsr print_fix_char_hex - pea #',' - _WriteChar - pea #'$' - _WriteChar - lda ]operand - and #$ff - tax - jsr print_fix_char_hex - lda #14 - sta ]offset - bra :end - -:immediate cmp #IMMEDIATE - bne :default - ldy #`syntax+10 - shorta - lda (]opcode_adr),y - pha - lda #'4' - sta (]opcode_adr),y - longa - clc - lda ]opcode_adr - adc #`syntax - ldx #0 - ldy ]operand - jsr printf - stx ]offset - ldy #`syntax+10 - shorta - pla - sta (]opcode_adr),y - longa - bra :end - -:default clc - lda ]opcode_adr - adc #`syntax - ldx #0 - ldy ]operand - jsr printf - stx ]offset - -:end lda }hex - beq :9 - pea #^blank_str ;separate asm/hex-ascii output - pea #blank_str - pea #0 - sec - lda #32 - sbc ]offset - pha - _TextWriteBlock -:9 lda ]opcode - ora #$0300 - ldx #0 - ldy ]operand - jsr print_hex_ascii - rts - -:space cStr ' {' - - -************************************************** -* parse GS/OS inline calls for opcodes * -* generating three bytes. * -* ---------------------------------------------- * -* (input) * -* a - operand (GS/OS entry point). * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -* (output) * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -************************************************** -parse_inline_3 equ * -]callnum = $b0 ;GS/OS call number -]assembler = $b2 ;temp copy of ~assembler -]count = $b2 ;number of bytes left to disassemble -]mark = $b6 ;current offset into OMF file -]parmblock = $ba ;parameter block number for call - - sta ]callnum - stx ]count+2 - sty ]count - - cmp #PRODOS_MLI - beq :parse_inline - ldx ]count+2 - ldy ]count - rts - -:parse_inline jsr GSOSget_mark - stx ]mark+2 - sty ]mark - - ldx ]count+2 - bne :4_bytes - lda ]count - cmp #3 - bne :4_bytes - brl :end - -:4_bytes cpx #0 - bne :default - cmp #4 - beq :0 - bra :default -:0 stz ]callnum - read_char ]callnum - lda ]callnum - jsr name_GSOS - bcc :1 - ldx ]mark+2 - ldy ]mark - jsr GSOSset_mark - brl :end -:1 phy - phx - incr @omf+`displacement - incr @omf+`counter - pea #'_' - _WriteChar - _WriteString - pea #' ' - _WriteChar - lda ~assembler - sta ]assembler - lda #MERLIN - sta ~assembler - lda #DC - jsr parse_expr_asm - lda ]assembler - sta ~assembler - ldx #0 - ldy #3 - rts - -:default stz ]callnum - read_char ]callnum - read_short ]parmblock - lda ]callnum - jsr name_GSOS - bcc :2 - ldx ]mark+2 - ldy ]mark - jsr GSOSset_mark - brl :end -:2 phy - phx - pea #'_' - _WriteChar - _WriteString - pea #' ' - _WriteChar - pea #'$' - _WriteChar - lda #4 - ldx ]parmblock - jsr print_fix_short_hex - put_cr - incr #3;@omf+`displacement - incr #3;@omf+`counter - decr #3;]count - -:end ldx ]count+2 - ldy ]count - rts - - -************************************************** -* parse stack-based GS/OS call. * -* ---------------------------------------------- * -* (input) * -* long - number of bytes to disassemble. * -* word - operand. * -* word - opcode. * -* (output) * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -************************************************** -parse_stack equ * -]opcode = $c0 ;opcode -]operand = $c2 ;opcode operand -]count = $c4 ;number of bytes left to disassemble -]mark = $c8 ;offset into OMF file -]jsl = $cc ;next operand -]callnum = $ce ;operand call address - - pla ;return address - plx - ply - stx ]opcode - sty ]operand - plx ;number of bytes to disassemble - ply - stx ]count - sty ]count+2 - pha ;push return back on stack - - bne :parse_stack - cpx #7 - bge :parse_stack - brl :2 - -:parse_stack jsr GSOSget_mark - stx ]mark+2 - sty ]mark - stz ]jsl - stz ]callnum+2 - read_char ]jsl ;test if next opcode is JSL - clc - tdc - adc #]callnum - tax - ldy #0 - lda #3 - jsr GSOSread - - ldx ]jsl - lda }tool - beq :1 - cpx #JSL - bne :1 - lda ]callnum+2 - cmp #^GSOS_STACK ;and TOOL_STACK and TOOL_STACK_ALT - bne :1 - lda ]callnum - cmp #TOOL_STACK - beq :name_tool - cmp #TOOL_STACK_ALT - beq :name_tool - cmp #GSOS_STACK - bne :1 - -:name_gsos lda ]operand - jsr name_GSOS - bra :0 -:name_tool lda ]operand - jsr name_TOOL -:0 bcs :1 - phy - phx - incr #4;@omf+`displacement - incr #4;@omf+`counter - pea #'_' - _WriteChar - _WriteString - put_cr - decr #4;]count - bra :end - -:1 ldx ]mark+2 - ldy ]mark - jsr GSOSset_mark -:2 lda ]opcode - ldx ]operand - jsr print_opcode_3 - -:end ldx ]count+2 - ldy ]count - rts - - -************************************************** -* parse opcodes that accept 4-byte operands. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -* (output) * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -************************************************** -parse_opcode_4 equ * -]opcode = $a0 ;opcode -]count = $a2 ;number of bytes to disassemble -]tmp_count = $a6 -]operand = $aa ;operand of opcode - - sta ]opcode - stx ]count+2 - sty ]count - stz ]operand+2 - - cpx #0 - bne :print_opcode - cpy #4 - bge :print_opcode - cpy #3 - beq :1 - cpy #2 - beq :1 - clc - lda @omf+`counter - adc #4 - tax - lda @omf+`counter+2 - adc #0 - cmp @omf+`length+2 - blt :0 - cpx @omf+`length - beq :0 - bge :1 -:0 lda ]opcode - jsr parse_expr_asm - bra :2 -:1 lda ]opcode - ldx ]count - jsr print_byte -:2 ldx #0 - txy - pla - rts - -:print_opcode incr #4;@omf+`displacement - incr #4;@omf+`counter - clc - tdc - adc #]operand - tax - ldy #0 - lda #3 - jsr GSOSread - lda }tool - beq :4 - lda ]opcode - cmp #JSL - bne :4 - pei ]count+2 - pei ]count - pei ]operand+2 - pei ]operand - jsr parse_inline_4 - stx ]tmp_count+2 - sty ]tmp_count - cpx ]count+2 - bne :3 - cpy ]count - bne :3 - lda ]opcode - ldx ]operand+2 - ldy ]operand - jsr print_opcode_4 - bra :end -:3 ldx ]tmp_count+2 - ldy ]tmp_count - stx ]count+2 - sty ]count - bra :end -:4 lda ]opcode - ldx ]operand+2 - ldy ]operand - jsr print_opcode_4 - -:end sec - lda ]count - sbc #4 - tay - lda ]count+2 - sbc #0 - tax - rts - - -************************************************** -* print opcodes that generate four bytes. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - HOW of operand. * -* y - LOW of operand. * -************************************************** -print_opcode_4 equ * -]opcode = $b0 ;opcode -]operand = $b2 ;operand of opcode -]opcode_adr = $b6 ;pointer to information about opcode -]ROM_handle = $b8 ;handle to ROM equivalent call -]ROM_ptr = $b8 -]offset = $bc - - sta ]opcode - stx ]operand+2 - sty ]operand - asl - tax - lda ~opcodes,x - sta ]opcode_adr - - lda }tool - bne :test_mode - brl :print_opcode -:test_mode ldy #`mode - lda (]opcode_adr),y - cmp #ABSOLUTE_LONG - beq :print_ROM - brl :print_opcode -:print_ROM lda ]operand+2 - cmp #$e0 - bne :0 - ldx ]operand - ldy #0 - jsr name_ROM - stx ]ROM_ptr - sty ]ROM_ptr+2 - bra :1 -:0 ldx ]operand - ldy ]operand+2 - jsr name_ROM - stx ]ROM_ptr - sty ]ROM_ptr+2 -:1 bcs :print_opcode ;if ROM call not found - phy - phx - pea #^print_opcode_4 - clc - lda ]opcode_adr - adc #`syntax - pha - pea #0 - pea #7 - _TextWriteBlock - lda #7 - sta ]offset - lda ]operand+2 - cmp #$e0 - bne :2 - pea #^:e0_str - pea #:e0_str - _WriteCString - inc ]offset - inc ]offset - inc ]offset -:2 _WriteString - lda []ROM_ptr] - and #$ff - adc ]offset - sta ]offset - bra :end - -:print_opcode clc - lda ]opcode_adr - adc #`syntax - ldx ]operand+2 - ldy ]operand - jsr printf - stx ]offset - -:end lda }hex - beq :3 - pea #^blank_str ;separate asm/hex-ascii output - pea #blank_str - pea #0 - sec - lda #32 - sbc ]offset - pha - _TextWriteBlock -:3 lda ]opcode - ora #$0400 - ldx ]operand+2 - ldy ]operand - jsr print_hex_ascii - rts - -:e0_str cStr 'e0_' - - -************************************************** -* parse GS/OS inline calls for opcodes * -* generating four bytes. * -* ---------------------------------------------- * -* (input) * -* long - number of bytes left to disassemble. * -* long - value of operand. * -* (output) * -* x - HOW of number of bytes to disassemble. * -* y - LOW of number of bytes to disassemble. * -************************************************** -parse_inline_4 equ * -]callnum = $b0 ;GS/OS call number -]assembler = $b4 ;temp copy of ~assembler -]count = $b4 ;number of bytes left to disassemble -]mark = $b8 ;current offset into OMF file -]parmblock = $bc ;parameter block number for call - - pla ;return address - plx - ply - stx ]callnum - sty ]callnum+2 - plx - ply - stx ]count - sty ]count+2 - pha ;push return address back on stack - - ldx ]callnum - cpx #GSOS_INLINE - bne :false - ldx ]callnum+2 - cpx #^GSOS_INLINE - beq :parse_inline -:false ldx ]count+2 - ldy ]count - rts - -:parse_inline jsr GSOSget_mark - stx ]mark+2 - sty ]mark - - ldx ]count+2 - bne :6_bytes - lda ]count - cmp #4 - bne :6_bytes - brl :end - -:6_bytes cpx #0 - bne :default - cmp #6 - beq :0 - bra :default -:0 read_short ]callnum - lda ]callnum - jsr name_GSOS - bcc :1 - ldx ]mark+2 - ldy ]mark - jsr GSOSset_mark - brl :end -:1 phy - phx - incr #2;@omf+`displacement - incr #2;@omf+`counter - pea #'_' - _WriteChar - _WriteString - pea #' ' - _WriteChar - lda ~assembler - sta ]assembler - lda #MERLIN - sta ~assembler - lda #DC - jsr parse_expr_asm - lda ]assembler - sta ~assembler - ldx #0 - ldy #4 - rts - -:default read_short ]callnum - read_long ]parmblock - lda ]callnum - jsr name_GSOS - bcc :2 - ldx ]mark+2 - ldy ]mark - jsr GSOSset_mark - brl :end -:2 phy - phx - pea #'_' - _WriteChar - _WriteString - pea #' ' - _WriteChar - pea #'$' - _WriteChar - lda #6 - ldx ]parmblock - ldy ]parmblock+2 - jsr print_fix_long_hex - put_cr - incr #6;@omf+`displacement - incr #6;@omf+`counter - decr #6;]count - -:end ldx ]count+2 - ldy ]count - rts - - -************************************************** -* output hex and ascii equivalent of operand * -* bytes. * -* ---------------------------------------------- * -* (input) * -* a - LOB opcode. * -* - HOB number of bytes generated by opcode. * -* x - HOW of operand. * -* y - LOW of operand. * -************************************************** -print_hex_ascii equ * -]opcode = $b0 ;opcode -]operand = $b2 ;operand -]opcode_adr = $b6 ;pointer to information about opcode -]num_bytes = $b8 ;number of bytes generated by opcode - - stx ]operand+2 - sty ]operand - tax - xba - and #$ff - sta ]num_bytes - txa - and #$ff - sta ]opcode - asl - tax - lda ~opcodes,x - sta ]opcode_adr - - lda }hex - bne :print_hex - put_cr - rts - -:print_hex pea #' ' - _WriteChar - lda ]num_bytes ;parse opcode depending on number of - cmp #1 ;bytes generated - bne :2_bytes - ldx ]opcode - jsr print_fix_char_hex - pea #^:space_1 - pea #:space_1 - _WriteCString - lda ]opcode - jsr print_ascii - brl :end -:2_bytes cmp #2 - bne :3_bytes - ldx ]opcode - jsr print_fix_char_hex - pea #' ' - _WriteChar - ldx ]operand - jsr print_fix_char_hex - pea #^:space_2 - pea #:space_2 - _WriteCString - lda ]opcode - jsr print_ascii - lda ]operand - jsr print_ascii - brl :end -:3_bytes cmp #3 - bne :4_bytes - ldx ]opcode - jsr print_fix_char_hex - pea #' ' - _WriteChar - lda ]operand - and #$ff - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - lda ]operand - xba - and #$ff - pha - tax - jsr print_fix_char_hex - pea #^:space_3 - pea #:space_3 - _WriteCString - lda ]opcode - jsr print_ascii - lda ]operand - and #$ff - jsr print_ascii - pla - jsr print_ascii - bra :end -:4_bytes ldx ]opcode - jsr print_fix_char_hex - pea #' ' - _WriteChar - lda ]operand - and #$ff - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - lda ]operand - xba - and #$ff - pha - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - ldx ]operand+2 - jsr print_fix_char_hex - pea #^:space_4 - pea #:space_4 - _WriteCString - lda ]opcode - jsr print_ascii - lda ]operand - and #$ff - jsr print_ascii - pla - jsr print_ascii - lda ]operand+2 - jsr print_ascii - -:end put_cr - rts - -:space_1 cStr ' - ' -:space_2 cStr ' - ' -:space_3 cStr ' - ' -:space_4 cStr ' - ' - - -************************************************** -* print ascii equivalent of hex byte, or '.' if * -* hex is non-printing character. * -* ---------------------------------------------- * -* (input) * -* a - hex byte. * -************************************************** -print_ascii equ * - - jsr isprint - bcc :0 - lda #'.' -:0 pha - _WriteChar - rts - - -************************************************** -* parse opcode with expression as its operand. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -************************************************** -parse_expr_asm equ * -]opcode = $c0 ;opcode -]record = $c2 ;OMF record number -]assembler = $c4 ;tmp copy of ~assembler -]opcode_adr = $c6 ;address of opcode data -]syntax_str = $c8 ;address of opcode syntax -]opcode_str = $ca - - sta ]opcode - stz ]record - - read_char ]record - lda ]record - jsr recognize_record - bcc :parse_expr - lda ]opcode - cmp #DC - bne :parse_mode - lda ]record - ldx #0 - ldy #FALSE - jsr parse_record - cpx #0 - beq :0 - put_cr -:0 brl :end - -:parse_expr lda ]opcode - ldx #1 - jsr print_byte - lda ]record - cmp #END - beq :2 - jsr print_offset - lda ]record - ldx #0 - ldy #FALSE - jsr parse_record - beq :2 - lda ~assembler - cmp #MERLIN - beq :1 - pea #''' - _WriteChar -:1 put_cr -:2 brl :end - -:parse_mode lda ]opcode - asl - tax - lda ~opcodes,x - sta ]opcode_adr - - lda ~assembler ;make copy of ~assembler to restore - sta ]assembler ;after change below - clc - lda ]opcode_adr - adc #`syntax - sta ]syntax_str - ldy #`mode - lda (]opcode_adr),y - cmp #BLOCK_MOVE - beq :test_mode - lda #'%' - ldx ]syntax_str - jsr strchr - stx ]opcode_str - -:test_mode ldy #`mode - lda (]opcode_adr),y - cmp #ABSOLUTE_LONG - beq :absolute_long - cmp #ABSOLUTE_LONG_INDEX_X - bne :block_move -:absolute_long pea #^parse_expr_asm - pei ]syntax_str - pea #0 - sec - lda ]opcode_str - sbc ]syntax_str - dec - pha - _TextWriteBlock - pea #' ' - _WriteChar - ldx #'>' - lda ~assembler - cmp #MERLIN - beq :3 - ldx #'|' -:3 phx - _WriteChar - lda #MERLIN - sta ~assembler - lda ]record - ldx #0 - ldy #FALSE - jsr parse_record - clc ;move past '%c$%6' - lda ]opcode_str - adc #5 - sta ]opcode_str - pea #^parse_expr_asm - pei ]opcode_str - _WriteCString - brl :end_parse - -:block_move cmp #BLOCK_MOVE - bne :default - lda #'$' - ldx ]syntax_str - jsr strchr - stx ]opcode_str - pea #^parse_expr_asm - pei ]syntax_str - pea #0 - sec - lda ]opcode_str - sbc ]syntax_str - dec - pha - _TextWriteBlock - pea #' ' - _WriteChar - lda ]record - ldx #0 - ldy #FALSE - jsr parse_record - stx ]offset - pea #',' - _WriteChar - pea #' ' - _WriteChar - read_char ]record - lda ]record - ldx ]offset - inx - inx - ldy #FALSE - jsr parse_record - bra :end_parse - -:default lda #MERLIN - sta ~assembler - pea #^parse_expr_asm - pei ]syntax_str - pea #0 - sec - lda ]opcode_str - sbc ]syntax_str - dec - pha - _TextWriteBlock - lda ]record - ldx #0 - ldy #FALSE - jsr parse_record - inc ]opcode_str - inc ]opcode_str - pea #^parse_expr_asm - pei ]opcode_str - _WriteCString -:end_parse put_cr - lda ]assembler - sta ~assembler - incr @omf+`counter - -:end incr @omf+`displacement - rts - - -************************************************** -* print byte as hex and ascii equivalent. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - number of bytes to print. * -************************************************** -print_byte equ * -]opcode = $e0 ;opcode value -]count = $e2 ;number of bytes to print -]byte = $e4 ;data value -]offset = $e6 - - sta ]opcode - stx ]count - stz ]byte - - lda #2 - sta ]offset - incr ]count;@omf+`displacement - incr ]count;@omf+`counter - lda ~assembler - cmp #MERLIN - bne :orca - pea #^hex_asm - pea #hex_asm - bra :2 -:orca pea #^dc_h_asm - pea #dc_h_asm - inc ]offset - inc ]offset -:2 _WriteCString - ldx ]opcode - jsr print_fix_char_hex - - lda ]opcode - ldx ]count - sta :hex,x -:read_loop dex - beq :3 - phx - read_char ]byte - ldx ]byte - jsr print_fix_char_hex - plx - shorta - lda ]byte - sta :hex,x - longa - inc ]offset - inc ]offset - bra :read_loop - -:3 lda ~assembler - cmp #ORCA - bne :4 - pea #''' - _WriteChar - inc ]offset -:4 lda }hex - bne :hex_ascii - brl :end -:hex_ascii pea #^blank_str - pea #blank_str - pea #0 - sec - lda #26 - sbc ]offset - pha - _TextWriteBlock - - ldy ]count -:hex_loop phy - lda :hex,y - and #$ff - tax - jsr print_fix_char_hex - pea #' ' - _WriteChar - ply - dey - bne :hex_loop - - pea #^blank_str ;separate hex and ascii values - pea #blank_str - pea #0 - lda ]count ;12 - (3 * ]count) is number of - asl ;blanks separating hex and ascii - clc ;output - adc ]count - pha - sec - lda #12 - sbc 1,s - sta 1,s - _TextWriteBlock - - pea #'-' - _WriteChar - pea #' ' - _WriteChar - ldy ]count -:print_loop phy - pea #'.' ;character for non-printing ascii code - lda :hex,y - and #$ff - jsr isprint - bcs :print_char ;use default if non-printing character - lda :hex,y ;else output character - and #$ff - sta 1,s -:print_char _WriteChar - ply - dey - bne :print_loop - -:end put_cr - rts - -:hex ds 6 ;bytes read in - - -************************************************** -* modify flags in coff depending on REP and SEP * -* opcodes. * -* ---------------------------------------------- * -* (input) * -* a - opcode. * -* x - operand. * -************************************************** -parse_rep_sep equ * -]opcode = $c0 ;opcode -]operand = $c2 ;opcode operand - - sta ]opcode - stx ]operand - - cmp #REP - bne :sep - txa - and #LONGA - beq :test_rep_longi - stz }shorta - lda ~assembler - cmp #ORCA - bne :test_rep_longi - lda #LONGA - jsr asm_status_bit -:test_rep_longi lda ]operand - and #LONGI - beq :0 - stz }shorti - lda ~assembler - cmp #ORCA - bne :0 - jsr asm_status_bit -:0 lda ~assembler - cmp #MERLIN - bne :end - lda #LONGI - jmp asm_status_bit - -:sep lda ]operand - and #LONGA - beq :test_sep_longi - lda #TRUE - sta }shorta - lda ~assembler - cmp #ORCA - bne :test_sep_longi - lda #LONGA - jsr asm_status_bit -:test_sep_longi lda ]operand - and #LONGI - beq :1 - lda #TRUE - sta }shorti - lda ~assembler - cmp #ORCA - bne :1 - jsr asm_status_bit -:1 lda ~assembler - cmp #MERLIN - bne :end - lda #LONGA - jmp asm_status_bit -:end rts - - -************************************************** -* test OMF record to parse. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* c - set if record not recognized. * -************************************************** -recognize_record equ * - - cmp #USING - beq :true - cmp #STRONG - beq :true - cmp #GLOBAL - beq :true - cmp #GEQU - beq :true - cmp #MEM - beq :true - cmp #LOCAL - beq :true - cmp #EQU - beq :true - cmp #DS - beq :true - cmp #LCONST - beq :true - cmp #$01 - blt :true - cmp #$e0 - bge :false - -:true clc - rts -:false sec - rts - - -************************************************** -* parse type of label. * -* ---------------------------------------------- * -* (input) * -* a - LOB label length. * -* HOB label type. * -* x - LOW handle of label name. * -* y - HOW handle of label name. * -************************************************** -parse_type_attribute ent -]type = $a0 ;label type -]length = $a2 ;label length -]length_type = $a4 ;length and type -]label_handle = $a6 ;handle to label name - - sta ]length_type - stx ]label_handle - sty ]label_handle+2 - tax - and #$ff - sta ]length - txa - xba - and #$ff - sta ]type - - sta @parse_data+`data_type - cmp #'A' ;address-type - bne :character - lda ]length - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_A - rts -:character cmp #'C' ;character-type - bne :double_precision - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_C - rts -:double_precision cmp #'D' ;double-precision floating-point - bne :floating_point - lda ]length - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_D - rts -:floating_point cmp #'F' ;floating-point - bne :hexadecimal - lda ]length - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_F - rts -:hexadecimal cmp #'H' ;hexadecimal-type - bne :integer - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_H - rts -:integer cmp #'I' ;integer - bne :reference_adr - lda ]length - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_I - rts -:reference_adr cmp #'K' ;reference-address - bne :soft_reference - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_K - rts -:soft_reference cmp #'L' ;soft-reference - bne :assembler - lda ]length - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_L - rts -:assembler cmp #'N' ;assembler - bne :ds - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_N - rts -:ds cmp #'S' ;DS - bne :end - ldx ]label_handle+2 - ldy ]label_handle - jsr parse_GLOBAL_type_S -:end rts - - -************************************************** -* parse address-type DC statement. * -* ---------------------------------------------- * -* (input) * -* a - label length. * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_A equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 -]record = $b0 ;record number -]const_count = $b0 ;counter for CONST -]edge = $b2 ;right margin -]num_char = $b4 ;length of output -]adr_value = $b6 ;address value read in -]count = $b8 ;number of address values to display - - sta ]count - sta @parse_data+`count - sta @parse_data+`on ;enable flag to parse data - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - lda #0 - ldx }nooffset - beq :0 - lda #16 -:0 clc - adc #ADDRESS_EDGE - sta ]edge - - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :1 - pea #' ' - _WriteChar - bra :2 -:1 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:2 ldx ]edge - lda ~assembler - cmp #MERLIN - beq :3 - dex - dex - dex - dex -:3 stx @parse_data+`edge - stx ]edge - stz ]adr_value - stz ]record - stz ]num_char - -:read_record read_char ]record ;read record to parse - lda ]record - ldx ]num_char - jsr parse_GLOBAL_type - beq :print_const - lda @parse_data+`count - sta ]count - beq :end_read -:4 jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - bra :read_record -:end_read brl :rts - -:print_const stz ]num_char - ldx #^db_asm - ldy #db_asm - lda ~assembler - cmp #MERLIN - beq :5 - ldx #^dc_a_asm - ldy #dc_a_asm -:5 phx - phy - _WriteCString - - lda ~assembler - cmp #MERLIN - beq :loop - pea #'1' - _WriteChar - pea #''' - _WriteChar -:loop read_char ]adr_value - ldx ]adr_value - jsr print_char_dec - inc ;add comma character - clc - adc ]num_char - sta ]num_char - dec ]const_count - dec @parse_data+`count - - incr @omf+`displacement - incr @omf+`counter - - lda ]num_char - cmp ]edge - blt :9 - beq :9 - lda ~assembler - cmp #MERLIN - beq :6 - pea #''' - _WriteChar -:6 put_cr - lda @parse_data+`count ;end if no more records to display - beq :rts - lda ]const_count ;if at end of CONST record, read next - bne :7 ;record - stz ]num_char - brl :4 -:7 stz ]num_char - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - ldx #^db_asm - ldy #db_asm - lda ~assembler - cmp #MERLIN - beq :8 - ldx #^:dc_a_asm - ldy #:dc_a_asm -:8 phx - phy - _WriteCString - brl :loop -:9 lda ]const_count - beq :end - pea #',' - _WriteChar - brl :loop - -:end lda ]num_char - beq :rts - lda ~assembler - cmp #MERLIN - beq :10 - pea #''' - _WriteChar -:10 put_cr - lda @parse_data+`count - beq :rts - brl :4 -:rts stz @parse_data+`on ;turn off parsing of data - rts - -:dc_a_asm asc !dc a1'!,00 - - -************************************************** -* parse character-type DC statement. * -* ---------------------------------------------- * -* (input) * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_C equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]record = $b8 ;record number -]count = $b8 ;number of characters to display -]edge = $ba ;right margin -]num_read = $bc ;number of bytes read - - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - pha - phx - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:1 stz ]record - read_char ]record - - lda ]record - cmp #DS - beq :3 - ldx #^:asc - ldy #:asc - lda ~assembler - cmp #MERLIN - beq :2 - ldx #^:dc_c - ldy #:dc_c -:2 phx - phy - _WriteCString - -:3 lda ]record - ldx #0 - jsr parse_GLOBAL_type - beq :display_char - rts - -:display_char lda #0 - ldx }nooffset - beq :4 - lda #16 -:4 clc - adc #CHAR_EDGE - sta ]edge - -:loop lda ]count ;if number of bytes to read is less - cmp ]edge ;than the default, output only - blt :5 ;default many bytes - lda ]edge ;read in default number of characters -:5 ldx #:hex - ldy #^:hex - jsr GSOSread - stx ]num_read - - ldx #0 ;output characters just read -:print_char phx - lda :hex,x - and #$ff - pha - _WriteChar - plx - inx - cpx ]num_read - blt :print_char - - pea #''' - _WriteChar - put_cr - - sec - lda ]count - sbc ]num_read - sta ]count - incr ]num_read;@omf+`counter ;update counter - incr ]num_read;@omf+`displacement ;update offset into OMF file - - lda ]count - beq :end - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - ldx #^:asc - ldy #:asc - lda ~assembler - cmp #MERLIN - beq :6 - ldx #^:dc_c - ldy #:dc_c -:6 phx - phy - _WriteCString - brl :loop -:end rts - -:asc asc !asc '!,00 -:dc_c asc !dc c'!,00 -:hex ds CHAR_EDGE+17 ;space for input string - - -************************************************** -* parse double-precision floating-point DC * -* statement. * -* ---------------------------------------------- * -* (input) * -* a - number of double floats to display. * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_D equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 -]const_count = $b0 ;counter for CONST -]edge = $b2 ;right margin -]num_char = $b4 ;length of output -]double_value = $b6 ;double value read in -]count = $be ;number of double values to display - - sta ]count - lsr - lsr - bcs :extended - lsr - bcc :0 -:extended jmp parse_GLOBAL_type_E -:0 stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - lda #0 - ldx }nooffset - beq :1 - lda #16 -:1 clc - adc #DOUBLE_EDGE-3 - sta ]edge - - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :2 - pea #' ' - _WriteChar - bra :3 -:2 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:3 pea #^dc_d_asm - pea #dc_d_asm - _WriteCString - - stz ]const_count - stz ]num_char - - read_char ]const_count ;read record to parse - lsr ]const_count ;since we read in 8 bytes - lsr ]const_count - lsr ]const_count -:loop read_double ]double_value - lda #]double_value - jsr print_double - inc ;add comma character - clc - adc ]num_char - sta ]num_char - dec ]const_count - - incr #8;@omf+`displacement - incr #8;@omf+`counter - - lda ]num_char - cmp ]edge - blt :4 - beq :4 - pea #''' - _WriteChar - put_cr - lda ]const_count ;if not at end of CONST record, read - beq :rts ;next record - stz ]num_char - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - pea #^dc_d_asm - pea #dc_d_asm - _WriteCString - brl :loop -:4 lda ]const_count - beq :end - pea #',' - _WriteChar - brl :loop - -:end lda ]num_char - beq :rts - pea #''' - _WriteChar - put_cr -:rts rts - - -************************************************** -* parse extended floating-point DC statement. * -* ---------------------------------------------- * -* (input) * -* a - number of extended floats to display. * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_E equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 -]const_count = $b0 ;counter for CONST -]edge = $b2 ;right margin -]num_char = $b4 ;length of output -]extended_value = $b6 ;extended value read in -]count = $be ;number of extended values to display - - sta ]count - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - lda #0 - ldx }nooffset - beq :0 - lda #16 -:0 clc - adc #EXTENDED_EDGE-3 - sta ]edge - - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :1 - pea #' ' - _WriteChar - bra :2 -:1 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:2 ldx #^flo_asm - ldy #flo_asm - lda ~assembler - cmp #MERLIN - beq :3 - ldx #^dc_e_asm - ldy #dc_e_asm -:3 phx - phy - _WriteCString - - stz ]const_count - stz ]num_char - - read_char ]const_count ;read record to parse -:loop read_extended ]extended_value - lda #]extended_value - jsr print_extended - inc ;add comma character - clc - adc ]num_char - sta ]num_char - sec - lda ]const_count - sbc #10 - sta ]const_count - - incr #10;@omf+`displacement - incr #10;@omf+`counter - - lda ]num_char - cmp ]edge - blt :5 - beq :5 - pea #''' - _WriteChar - put_cr - lda ]const_count ;if not at end of CONST record, read - beq :rts ;next record - stz ]num_char - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - ldx #^flo_asm - ldy #flo_asm - lda ~assembler - cmp #MERLIN - beq :4 - ldx #^dc_e_asm - ldy #dc_e_asm -:4 phx - phy - _WriteCString - brl :loop -:5 lda ]const_count - beq :end - pea #',' - _WriteChar - brl :loop - -:end lda ]num_char - beq :rts - pea #''' - _WriteChar - put_cr -:rts rts - - -************************************************** -* parse floating-point-type DC statement. * -* ---------------------------------------------- * -* (input) * -* a - number of floats to display. * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_F equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 -]const_count = $b0 ;counter for CONST -]edge = $b2 ;right margin -]num_char = $b4 ;length of output -]float_value = $b6 ;float value read in -]count = $ba ;number of integer values to display - - sta ]count - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - lda #0 - ldx }nooffset - beq :0 - lda #16 -:0 clc - adc #FLOAT_EDGE-3 - sta ]edge - - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :1 - pea #' ' - _WriteChar - bra :2 -:1 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:2 pea #^dc_f_asm - pea #dc_f_asm - _WriteCString - - stz ]num_char - stz ]const_count - - read_char ]const_count ;number of bytes - lsr ]const_count ;since we read in 4 bytes - lsr ]const_count -:loop read_float ]float_value - lda #]float_value - jsr print_float - inc ;add comma character - clc - adc ]num_char - sta ]num_char - dec ]const_count - - incr #4;@omf+`displacement - incr #4;@omf+`counter - - lda ]num_char - cmp ]edge - blt :3 - beq :3 - pea #''' - _WriteChar - put_cr - lda ]const_count ;if at end of CONST record, read next - beq :rts ;record - stz ]num_char - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - pea #^dc_f_asm - pea #dc_f_asm - _WriteCString - brl :loop -:3 lda ]const_count - beq :end - pea #',' - _WriteChar - brl :loop - -:end lda ]num_char - beq :rts - pea #''' - _WriteChar - put_cr -:rts rts - - -************************************************** -* parse hexadecimal-type DC statement. * -* ---------------------------------------------- * -* (input) * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_H equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]record = $b8 ;record number -]count = $b8 ;number of characters to display -]edge = $ba ;right margin -]num_read = $bc ;number of bytes read - - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - pha - phx - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:1 stz ]record - read_char ]record - - lda ]record - cmp #DS - beq :3 - ldx #^hex_asm - ldy #hex_asm - lda ~assembler - cmp #MERLIN - beq :2 - ldx #^dc_h_asm - ldy #dc_h_asm -:2 phx - phy - _WriteCString - -:3 lda ]record - ldx #0 - jsr parse_GLOBAL_type - beq :display_char - rts - -:display_char lda #0 - ldx }nooffset - beq :4 - lda #16 -:4 clc - adc #HEX_EDGE - sta ]edge - -:loop lda ]count ;if number of bytes to read is less - cmp ]edge ;than the default, output only - blt :5 ;default many bytes - lda ]edge ;read in default number of characters -:5 ldx #:hex - ldy #^:hex - jsr GSOSread - stx ]num_read - - ldx #0 ;output characters just read -:print_char phx - lda :hex,x - and #$ff - tax - jsr print_fix_char_hex - plx - inx - cpx ]num_read - blt :print_char - - lda ~assembler - cmp #MERLIN - beq :cr - pea #''' - _WriteChar -:cr put_cr - - sec - lda ]count - sbc ]num_read - sta ]count - incr ]num_read;@omf+`counter ;update counter - incr ]num_read;@omf+`displacement ;update offset into OMF file - - lda ]count - beq :end - jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - ldx #^hex_asm - ldy #hex_asm - lda ~assembler - cmp #MERLIN - beq :6 - ldx #^dc_h_asm - ldy #dc_h_asm -:6 phx - phy - _WriteCString - brl :loop -:end rts - -:hex ds HEX_EDGE+17 ;space for input string - - -************************************************** -* parse integer-type DC statement. * -* ---------------------------------------------- * -* (input) * -* a - number of integers to display. * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_I equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 -]record = $b0 ;record number -]const_count = $b0 ;counter for CONST -]edge = $b2 ;right margin -]num_char = $b4 ;length of output -]int_value = $b6 ;integer value read in -]count = $b8 ;number of integer values to display - - sta ]count - sta @parse_data+`count - sta @parse_data+`on ;enable flag to parse data - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - lda #0 - ldx }nooffset - beq :0 - lda #16 -:0 clc - adc #INT_EDGE - sta ]edge - - pei ]label_ptr+2 - pei ]label_ptr - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :1 - pea #' ' - _WriteChar - bra :2 -:1 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:2 ldx ]edge - lda ~assembler - cmp #MERLIN - beq :3 - dex - dex - dex - dex -:3 stx @parse_data+`edge - stx ]edge - stz ]int_value - stz ]record - stz ]num_char - -:read_record read_char ]record ;read record to parse - lda ]record - ldx ]num_char - jsr parse_GLOBAL_type - beq :print_const - lda @parse_data+`count - sta ]count - beq :end_read -:4 jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - bra :read_record -:end_read brl :rts - -:print_const stz ]num_char - ldx #^db_asm - ldy #db_asm - lda ~assembler - cmp #MERLIN - beq :5 - ldx #^dc_i_asm - ldy #dc_i_asm -:5 phx - phy - _WriteCString - - lda ~assembler - cmp #MERLIN - beq :loop - pea #'1' - _WriteChar - pea #''' - _WriteChar -:loop read_char ]int_value - ldx ]int_value - jsr print_char_dec - inc ;add comma character - clc - adc ]num_char - sta ]num_char - dec ]const_count - dec @parse_data+`count - - incr @omf+`displacement - incr @omf+`counter - - lda ]num_char - cmp ]edge - blt :9 - beq :9 - lda ~assembler - cmp #MERLIN - beq :6 - pea #''' - _WriteChar -:6 put_cr - lda @parse_data+`count ;end if no more records to display - beq :rts - stz ]num_char - lda ]const_count ;if at end of CONST record, read next - bne :7 ;record - brl :4 -:7 jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - ldx #^db_asm - ldy #db_asm - lda ~assembler - cmp #MERLIN - beq :8 - ldx #^:dc_i_asm - ldy #:dc_i_asm -:8 phx - phy - _WriteCString - brl :loop -:9 lda ]const_count - beq :end - pea #',' - _WriteChar - brl :loop - -:end lda ]num_char - beq :rts - lda ~assembler - cmp #MERLIN - beq :10 - pea #''' - _WriteChar -:10 put_cr - lda @parse_data+`count - beq :rts - brl :4 -:rts stz @parse_data+`on ;turn off parsing of data - rts - -:dc_i_asm asc !dc i1'!,00 - - -************************************************** -* parse reference-address-type DC statement. * -* ---------------------------------------------- * -* (input) * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_K equ * -]label_handle = $b0 ;handle to name of label -]label_ptr = $b4 -]label_len = $b8 ;length of label -]record = $b8 ;record number - - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - pha - phx - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:1 stz ]record - read_char ]record - - lda ]record - jmp parse_STRONG - - -************************************************** -* parse soft-reference-type DC statement. * -* ---------------------------------------------- * -* (input) * -* a - length. * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_L equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 -]record = $b0 ;record number -]const_count = $b0 ;counter for CONST -]edge = $b2 ;right margin -]num_char = $b4 ;length of output -]soft_value = $b6 ;reference value read in -]count = $b8 ;number of soft-reference values to display -]tmp_asm = $ba ;copy of ~assembler - - sta ]count - sta @parse_data+`count - sta @parse_data+`on ;enable flag to parse data - stx ]label_handle+2 - sty ]label_handle - - lda ~assembler ;short-reference type DC statement - sta ]tmp_asm ;only available for Orca assembler - lda #ORCA - sta ~assembler - - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - pha - phx - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:1 lda #0 - ldx }nooffset - beq :2 - lda #16 -:2 clc - adc #SOFT_REFERENCE_EDGE - sta ]edge - sta @parse_data+`edge - stz ]soft_value - stz ]record - stz ]num_char - -:read_record read_char ]record ;read record to parse - lda ]record - ldx ]num_char - jsr parse_GLOBAL_type - beq :print_const - lda @parse_data+`count - sta ]count - beq :end_read -:3 jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - bra :read_record -:end_read brl :rts - -:print_const stz ]num_char - pea #^:REFERENCE_asm - pea #:REFERENCE_asm - _WriteCString -:loop read_char ]soft_value - ldx ]soft_value - jsr print_char_dec - inc ;add comma character - clc - adc ]num_char - sta ]num_char - dec ]const_count - dec @parse_data+`count - - incr @omf+`displacement - incr @omf+`counter - - lda ]num_char - cmp ]edge - blt :5 - beq :5 - pea #''' - _WriteChar - put_cr - lda @parse_data+`count ;end if no more records to display - beq :rts - stz ]num_char - lda ]const_count ;if at end of CONST record, read next - bne :4 ;record - brl :3 -:4 jsr print_offset - pea #^space_12 - pea #space_12 - _WriteCString - pea #^:REFERENCE_asm - pea #:REFERENCE_asm - _WriteCString - brl :loop -:5 lda ]const_count - beq :end - pea #',' - _WriteChar - brl :loop - -:end lda ]num_char - beq :rts - pea #''' - _WriteChar - put_cr - lda @parse_data+`count - beq :rts - brl :3 -:rts stz @parse_data+`on ;turn off parsing of data - lda ]tmp_asm - sta ~assembler - rts - -:REFERENCE_asm asc !dc s1'!,00 - - -************************************************** -* parse assembler entry directive. * -* ---------------------------------------------- * -* (input) * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_N equ * -]label_handle = $b0 ;handle to label name -]label_ptr = $b4 -]label_len = $b8 ;length of label -]segname_handle = $ba ;handle to segment name -]segname_ptr = $ba -]segname_len = $be ;length of segment name -]expr_handle = $b0 ;handle to resulting expression -]expr_ptr = $b4 - - stx ]label_handle+2 - sty ]label_handle - phx - phy - phx - phy - _HLock - - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - pha - phx - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:1 ldx #^:equ - ldy #:equ - lda ~assembler - cmp #MERLIN - beq :2 - ldx #^:entry - ldy #:entry -:2 phx - phy - _WriteCString - put_cr - - lda }label - bne :add_label - _HUnlock - rts -:add_label ldx @omf+`segname - ldy @omf+`segname+2 - stx ]segname_handle - sty ]segname_handle+2 - phy - phx - phy - phx - _HLock - ldy #2 - lda []segname_handle],y - tax - lda []segname_handle] - sta ]segname_ptr - stx ]segname_ptr+2 - lda []segname_ptr] - sta ]segname_len - - pha ;long - result - pha - clc ;long - block size - lda ]segname_len - adc #14 - pea #0 - pha - lda userID ;word - user ID of block - pha - pea #attrNoSpec+attrLocked ;word - block attributes - pha ;long - start of block - pha - _NewHandle - lda 1,s - sta ]expr_handle - lda 3,s - sta ]expr_handle+2 - lda []expr_handle] - sta ]expr_ptr - ldy #2 - lda []expr_handle],y - sta ]expr_ptr+2 - - ldy #2 - lda #'(' - sta []expr_ptr],y - - ldy #2 - ldx #3 - shorta -:copy_segname lda []segname_ptr],y - phy - txy - sta []expr_ptr],y - ply - inx - iny - dec ]segname_len - bne :copy_segname - txy - lda #'+' - sta []expr_ptr],y - iny - lda #'$' - sta []expr_ptr],y - iny - longa - phy - - ldx @omf+`counter ;long - longint to convert - ldy @omf+`counter+2 - phy - phx - pea #^long_hex_str ;long - pointer to output string - pea #long_hex_str - pea #8 ;word - length of string - _Long2Hex - ldx #7 - lda @omf+`counter ;special case value of 0 - ora @omf+`counter+2 - beq :4 - lda #8 - ldx #long_hex_str ;make hex alpha lowercase - ldy #^long_hex_str - jsr lowercase_hex - ldx #$ffff -:3 inx - lda long_hex_str,x - and #$ff - cmp #'0' - beq :3 -:4 ply - shorta -:copy_value lda long_hex_str,x - sta []expr_ptr],y - inx - iny - cpx #8 - blt :copy_value - lda #')' - sta []expr_ptr],y - longa - tya ;y holds length of label string - 1 - dec - sta []expr_ptr] - _HUnlock - _HUnlock - _HUnlock - - pei ]label_handle+2 - pei ]label_handle - pei ]expr_handle+2 - pei ]expr_handle - pea #GLOBAL - jsr add_label - rts - -:equ cStr 'equ *' -:entry cStr 'entry' - - -************************************************** -* parse DS statement. * -* ---------------------------------------------- * -* (input) * -* x - HOW handle of label name. * -* y - LOW handle of label name. * -************************************************** -parse_GLOBAL_type_S equ * -]label_handle = $b0 ;handle to name of label -]label_ptr = $b4 -]label_len = $b8 -]record = $b8 - - stx ]label_handle+2 - sty ]label_handle - - lda []label_handle] - sta ]label_ptr - tax - ldy #2 - lda []label_handle],y - sta ]label_ptr+2 - - pha - phx - pea #2 - lda []label_ptr] - sta ]label_len - pha - _TextWriteBlock - lda ]label_len - cmp #12 - blt :0 - pea #' ' - _WriteChar - bra :1 -:0 pea #^blank_str - pea #blank_str - pea #0 - sec - lda #12 - sbc ]label_len - pha - _TextWriteBlock - -:1 stz ]record - read_char ]record - - lda ]record - jmp parse_GLOBAL_type - - -************************************************** -* parse arguments to LOCAL/GLOBAL labels. * -* ---------------------------------------------- * -* (input) * -* a - record number. * -* (output) * -* a - if expression parsed by this routine. * -************************************************** -parse_GLOBAL_type equ * - - cmp #EXPR - beq :expr - cmp #BEXPR - beq :expr - cmp #RELEXPR - beq :expr - cmp #LEXPR - bne :ds -:expr ldx #0 - ldy #TRUE - jsr parse_record - phx - lda ~assembler - cmp #ORCA - bne :0 - pea #''' - _WriteChar -:0 pla - beq :true - lda }assembly - beq :true - put_cr - bra :true - -:ds cmp #DS - bne :end - jsr parse_DS - bra :true - -:end cmp #END - bne :default - put_cr - put_cr - lda #PREMATURE_END ;if at EOF of OMF file, premature end - ldx #0 ;of file reached - txy - jsr error - -:default lda #FALSE - rts - -:true lda #TRUE - rts - - -************************************************** -flo_asm asc !flo '!,00 ;merlin extended directive - - -************************************************** - sav asm.l + END OF ARCHIVE