Martin_Head wrote:The 'dc.w $FF00 ; WINDS'. If I remember rightly, the QLIB source reads it as a byte, rather than a word, and treats it as a true/false flag.
Code: Select all
ROM:00010456 ; =============== S U B R O U T I N E =======================================
ROM:00010456
ROM:00010456
ROM:00010456 open_con_channels: ; CODE XREF: print_init_error:loc_11F86↓p
ROM:00010456 cmpi.w #4,obj_some_filetype(a5)
ROM:0001045C blt.s check_mode
ROM:0001045E tst.w obj_winds(a5)
ROM:00010462 bmi.s open_con_channels_exit
ROM:00010464
ROM:00010464 check_mode: ; CODE XREF: open_con_channels+6↑j
ROM:00010464 moveq #-1,d1
ROM:00010466 moveq #-1,d2
ROM:00010468 moveq #sms.dmod,d0 ; set the Display MODe
ROM:0001046A trap #1
ROM:0001046C lea con_m4_ch0(pc),a3 ; "CON_512x050a00x206"
ROM:00010470 tst.b d1
ROM:00010472 beq.s ch_start
ROM:00010474 lea con_m8_ch0(pc),a3 ; "CON_448x040a32x216"
ROM:00010478
ROM:00010478 ch_start: ; CODE XREF: open_con_channels+1C↑j
ROM:00010478 moveq #0,d4 ; Channel 0
ROM:0001047A
ROM:0001047A ch_loop: ; CODE XREF: open_con_channels+46↓j
ROM:0001047A moveq #ch.len,d5
ROM:0001047C mulu.w d4,d5
ROM:0001047E add.l sb_chanb(a6),d5 ; long channel table base
ROM:00010482 move.w ch_chid(a6,d5.l),d0
ROM:00010486 bpl.s ch_exists
ROM:00010488 bsr.w open_con
ROM:0001048C move.l a0,ch_chid(a6,d5.l)
ROM:00010490 bra.s ch_next
ROM:00010492 ; ---------------------------------------------------------------------------
ROM:00010492
ROM:00010492 ch_exists: ; CODE XREF: open_con_channels+30↑j
ROM:00010492 adda.w (a3)+,a3 ; Skip CON string
ROM:00010494 addq.l #2,a3 ; Plus size bytes
ROM:00010496
ROM:00010496 ch_next: ; CODE XREF: open_con_channels+3A↑j
ROM:00010496 addq.b #1,d4 ; Next channel
ROM:00010498 cmpi.b #3,d4 ; 3 channels total
ROM:0001049C bne.s ch_loop
ROM:0001049E
ROM:0001049E open_con_channels_exit: ; CODE XREF: open_con_channels+C↑j
ROM:0001049E rts
ROM:0001049E ; End of function open_con_channels
Yes, not yet finished as some stuff is pretty difficult to figure out, but here's one completely finished example:You say you have done the private QLIB_obj extensions, Do you mean the embedded SuperBASIC extensions, with all the pointer interface and GENCODE type extensions?
Code: Select all
section code
include 'dev8_keys_sbasic'
include 'dev8_keys_qdos_sms'
include 'dev8_keys_qdos_ioa'
include 'dev8_keys_qdos_io'
include 'dev8_keys_qlv'
include 'dev8_keys_err'
; BASIC variables
sbq_qerr_old: equ $C2 ; WORD Error number as returned by old Q_ERR
sbq_qerr_wrappers: equ $DC
sbq_data: equ $E0
sbq_runtime: equ $EC ; Pointer to QLIB runtime
; GEN block
gb_chid: equ 4
gb_pos: equ 8
gb_align: equ $B
gb_line_table: equ $C ; Line table pointer
gen_start:
lea gen_procs(pc),a1
movea.w sb.inipr,a2 ; INITialise PRocedure table
jsr (a2)
moveq #0,d0
rts
; ---------------------------------------------------------------------------
gen_procs: dc.w 12
dc.w initgen-*
dc.b 7,'INITgen'
dc.w genop-*
dc.b 5,'GENop'
dc.w genb-*
dc.b 4,'GENB',0
dc.w genw-*
dc.b 4,'GENW',0
dc.w genl-*
dc.b 4,'GENL',0
dc.w genint-*
dc.b 6,'GENint',0
dc.w genfloat-*
dc.b 8,'GENfloat',0
dc.w gensfloat-*
dc.b 9,'GENsfloat'
dc.w genstring-*
dc.b 9,'GENstring'
dc.w gentext-*
dc.b 7,'GENtext'
dc.w genntd-*
dc.b 6,'GENntd',0
dc.w smem-*
dc.b 4,'SMEM',0
dc.w 0
dc.w 3
dc.w rp_addr-*
dc.b 7,'RP_ADDR'
dc.w odd-*
dc.b 3,'ODD'
dc.w shortf-*
dc.b 6,'SHORTF',0
dc.w 0
; =============== S U B R O U T I N E =======================================
; INITGEN #ch,pos
;
; pos = position, will be counted up
initgen:
bsr gen_get_chan_param ; Return channel ID in d7
bne.s initgen_rts
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne.s initgen_rts
movea.l sbq_data(a6),a2
move.l d7,gb_chid(a2) ; Set channel
move.l (a6,a1.l),gb_pos(a2)
initgen_rts:
rts
; =============== S U B R O U T I N E =======================================
; GENOP opcode
;
; Generate OPCODE byte with appropriate padding
genop:
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne genop_rts
move.b 3(a6,a1.l),d5 ; Get LSB = opcode
ext.w d5
move.b genop_table(pc,d5.w),d0
cmpi.b #1,d0
blt.s genop_write_op
bgt.s genop_align_odd
movea.l sbq_data(a6),a2
bsr gen_align
bra.s genop_write_op
; ---------------------------------------------------------------------------
genop_align_odd:
movea.l sbq_data(a6),a2
btst #0,gb_align(a2)
bne.s genop_write_op
bsr gen_byte_0 ; Write 0
genop_write_op:
rol.w #1,d5 ; Opcodes are multiple of 2 as they index word table
move.l d5,d1
bra gen_byte_d1
; ---------------------------------------------------------------------------
; 0 = don't align stream
; 1 = insert alignment byte if position is odd
; 2 = insert alignment byte if position is even
genop_table: dc.b 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
dc.b 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
dc.b 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
dc.b 0,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2
dc.b 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
dc.b 2,0,0,0,0,2,0,0,0,0,0,0,0,0,0,2,2
dc.b 2,2,2,2,2,2,2,2,0,0,2,2,2,2,2,2,2
dc.b 2,2,2,2,2,2,2,2,2,2,0
; =============== S U B R O U T I N E =======================================
; GENSTRING s
;
; Generate QDOS style string
genstring:
movea.w sb.gtstr,a2 ; GeT STRing
jsr (a2)
bne.s genop_rts
bsr gen_align
moveq #0,d4
move.w (a6,a1.l),d4 ; String size
addq.w #2,d4
moveq #0,d6
bra.s gen_smul_loop ; d4 = item size, d6 = item count - 1
; =============== S U B R O U T I N E =======================================
; GENTEXT s
;
; Generate text without size prefix
gentext:
movea.w sb.gtstr,a2 ; GeT STRing
jsr (a2)
bne.s genop_rts
moveq #0,d4
move.w (a6,a1.l),d4
addq.w #2,a1
moveq #0,d6
bra.s gen_smul_loop ; d4 = item size, d6 = item count - 1
; =============== S U B R O U T I N E =======================================
; GENB a,b,c,...
;
; Generate bytes
genb:
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne.s genop_rts
moveq #1,d4 ; Item size
gen_generic:
move.w d3,d6 ; Item count
subq.w #1,d6
addq.w #4,a1
suba.w d4,a1 ; Go to start of item
gen_smul_loop:
movea.l sbq_data(a6),a2 ; d4 = item size, d6 = item count - 1
movea.l gb_chid(a2),a0
add.l d4,gb_pos(a2)
move.l d4,d2
bsr gen_smul ; Write multiple bytes. Ptr in a1, count in d2
addq.l #4,a1
dbf d6,gen_smul_loop ; d4 = item size, d6 = item count - 1
genop_rts:
rts
; =============== S U B R O U T I N E =======================================
; GENW a,b,c,...
;
; Generate words (aligned)
genw:
bsr.s gen_align
; =============== S U B R O U T I N E =======================================
; GENINT a,b,c,...
;
; Generate ints (not aligned)
genint:
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne.s genop_rts
moveq #2,d4 ; Item size
bra.s gen_generic
; =============== S U B R O U T I N E =======================================
; GENL a,b,c,...
;
; Generate longs (aligned)
genl:
bsr.s gen_align
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne.s genop_rts
moveq #4,d4 ; Item size
bra.s gen_generic
; =============== S U B R O U T I N E =======================================
; GENNTD x
;
; Generate word x * 8
genntd:
bsr.s gen_align
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne.s genop_rts
rol 2(a6,a1.l)
rol 2(a6,a1.l)
rol 2(a6,a1.l)
addq.w #2,a1
moveq #2,d4 ; Item size
moveq #0,d6
bra.s gen_smul_loop ; d4 = item size, d6 = item count - 1
; =============== S U B R O U T I N E =======================================
gen_align:
movea.l sbq_data(a6),a2
btst #0,gb_align(a2)
beq.s gen_byte_rts
; =============== S U B R O U T I N E =======================================
; Write 0
gen_byte_0:
moveq #0,d1
; Write byte in d1
gen_byte_d1:
movea.l sbq_data(a6),a2
movea.l gb_chid(a2),a0
moveq #-1,d3
moveq #iob.sbyt,d0 ; Send BYTe to output
trap #3
addq.l #1,gb_pos(a2)
gen_byte_rts:
rts
; =============== S U B R O U T I N E =======================================
; GENFLOAT f
;
; Generate 6-byte float
genfloat:
moveq #6,d4
genxfloat:
movea.l nt_value(a6,a3.l),a1
adda.l sb_datab(a6),a1 ; long data area base (first block)
moveq #0,d6 ; Only one time 6 bytes
bra gen_smul_loop ; d4 = item size, d6 = item count - 1
; =============== S U B R O U T I N E =======================================
; GENSFLOAT
;
; Generate 4-byte float
gensfloat:
moveq #4,d4
bra.s genxfloat
; =============== S U B R O U T I N E =======================================
; SMEM addr,size
;
; Write memory contents
smem:
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne.s smem_rts
cmpi.b #2,d3
bne.s gen_err_ipar
move.l 4(a6,a1.l),d2
movea.l (a6,a1.l),a1
movea.l sbq_data(a6),a2
movea.l gb_chid(a2),a0
add.l d2,gb_pos(a2)
moveq #-1,d3
moveq #iob.smul,d0 ; Send MULtiple bytes
trap #3
tst.l d0
smem_rts:
rts
; =============== S U B R O U T I N E =======================================
; Return channel ID in d7
gen_get_chan_param:
cmpa.l a3,a5
ble.s gen_err_ipar
btst #nt..hash,1(a6,a3.l) ; preceded by hash
beq.s gen_err_ipar
movea.l sb_arthp(a6),a1 ; long arithmetic stack pointer
move.l a5,-(sp)
movea.l a3,a5
addq.l #8,a5
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
movea.l (sp)+,a5
bne.s gen_err_ipar
addq.l #8,a3
bsr.s gen_get_chan
move.l a0,d7
moveq #0,d0
tst.l d0
rts
; ---------------------------------------------------------------------------
gen_err_ipar:
moveq #err.ipar,d0 ; Invalid PARameter (c.f. err.orng)
tst.l d0
rts
; =============== S U B R O U T I N E =======================================
gen_get_chan:
move.l (a6,a1.l),d0
moveq #ch.len,d1
mulu.w d1,d0
movea.l sb_chanb(a6),a2 ; long channel table base
adda.l d0,a2
movea.l (a6,a2.l),a0
rts
; =============== S U B R O U T I N E =======================================
; Write multiple bytes. Ptr in a1, count in d2
gen_smul:
moveq #-1,d3
moveq #iob.smul,d0 ; Send MULtiple bytes
trap #4
trap #3
suba.w d1,a1
tst.l d0
rts
; =============== S U B R O U T I N E =======================================
; addr = RP_ADDR
;
; Return current position in stream
rp_addr:
movea.l sb_arthp(a6),a1 ; long arithmetic stack pointer
movea.l sbq_data(a6),a2
move.l gb_pos(a2),d0
move.w #$81F,d1
tst.l d0
beq.s rp_addr_0
rp_addr_normalize:
asl.l #1,d0
bvs.s rp_addr_backtrack
subq.w #1,d1
bra.s rp_addr_normalize
; ---------------------------------------------------------------------------
rp_addr_0:
clr.w d1
bra.s rp_addr_put
; ---------------------------------------------------------------------------
rp_addr_backtrack:
roxr.l #1,d0
rp_addr_put:
move.l d0,-4(a6,a1.l)
move.w d1,-6(a6,a1.l)
subq.l #6,a1
moveq #nt.fp,d4
move.l a1,sb_arthp(a6) ; long arithmetic stack pointer
moveq #0,d0
rts
; =============== S U B R O U T I N E =======================================
; is_odd = ODD(value)
;
; Return if the given value is odd (1) or not (0)
odd:
movea.w sb.gtlin,a2 ; GeT Long INteger
jsr (a2)
bne genop_rts
moveq #0,d1
btst #0,3(a6,a1.l)
beq.s loc_1A0D8
moveq #1,d1
loc_1A0D8:
addq.l #2,a1
gen_ret_int:
move.w d1,(a6,a1.l)
move.l a1,sb_arthp(a6) ; long arithmetic stack pointer
moveq #nt.in,d4
moveq #0,d0
rts
; =============== S U B R O U T I N E =======================================
; is_short = SHORTF(f)
;
; Check if float can be 32-bit
shortf:
movea.l sb_arthp(a6),a1 ; long arithmetic stack pointer
subq.l #2,a1
movea.l nt_value(a6,a3.l),a2
adda.l sb_datab(a6),a2 ; long data area base (first block)
moveq #1,d1
move.w 4(a6,a2.l),d0
beq.s gen_ret_int
moveq #0,d1
bra.s gen_ret_int
end
Well, I wrote to you that I intend to do all the assembler stuff. I use a state-of-the-art PC based commercial disassembler which makes this stuff possible at all, I'd probably have given up long ago with the QL based ones.As I was thinking about doing them. Because I thought you were just doing the stuff that came on the QLib disk.
Marcel