🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Thread View: comp.sources.apple2
1 messages
1 total messages Started by Jonathan A. Chandross Mon, 09 Nov 1992 00:11
v001SRC067: coff (OMF Disassembler) 02/09
#83
Author: Jonathan A. Chandross
Date: Mon, 09 Nov 1992 00:11
3531 lines
67883 bytes
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
Thread Navigation

This is a paginated view of messages in the thread with full content displayed inline.

Messages are displayed in chronological order, with the original post highlighted in green.

Use pagination controls to navigate through all messages in large threads.

Back to All Threads