* QL WORLD DIY TOOLKIT - CHAN functions
* Ver. 0.4, Copyright 1988 Simon N Goodwin.
*
start      lea.l   define,a1
           move.w  $110,a2        BP.INIT vector
           jmp     (a2)
*
define     dc.w  0,0              No procedures
           dc.w  3                Three functions
           dc.w  ch_byte-*
           dc.b  7,'CHAN_B%'
           ds.w  0
           dc.w  ch_word-*
           dc.b  7,'CHAN_W%'
           ds.w  0
           dc.w  ch_long-*
           dc.b  6,'CHAN_L'
           ds.w  0
           dc.w  0                End of functions
*
ch_long    moveq    #-1,d5
           bra.s    get_params
ch_word    moveq    #1,d5
           bra.s    get_params
ch_byte    moveq    #0,d5
*
get_params lea.l    2*8(a3),a0
           cmpa.l   a0,a5         Two parameters?
           beq.s    two_params
bad_param  moveq    #-15,d0
bad_exit   rts
*
two_params move.w   $112,a2       Vector to get integers
           jsr      (a2)          CA.GTINT
           bne.s    bad_exit
           move.w   0(a1,a6.l),d0 Get BASIC channel number
           addq.l   #2,a1         Leave room for one INT
           move.l   a1,$58(a6)    Store maths stack pointer
           move.w   0(a1,a6.l),d1 Get offset
*
* Check and convert channel number in D0 to ID in A0
*
chan_sel   mulu     #40,d0        Channel table size
           add.l    $30(a6),d0    Add base offset
           cmp.l    $34(a6),d0 
           bge.s    what_chan     Past end of table?
           move.l   0(a6,d0.l),d0
           bpl.s    chan_open     Negative if closed
what_chan  moveq    #-6,d0        CHANNEL NOT OPEN error
           rts
chan_open  move.l   d0,a0         A0 is channel ID
*
* Check offset for word values
*
           move.w   d5,d2         Copy flag for EXTOP
           beq.s    offset_ok
           btst     #0,d1         Test odd/even bit
           bne.s    bad_param     Reject odd values
*           
offset_ok  lea.l    ch_extop,a2   Address of routine
           moveq    #-1,d3        Allow infinite time
           moveq    #9,d0         SD.EXTOP key
           trap     #3
           tst.l    d0
           bne.s    bad_exit
           move.l   $58(a6),a1    Retrieve maths stack
           tst.w    d5            Check result size
           bmi.s    return_fp
*
return_int move.w   d1,0(a1,a6.l) Put result in space
           moveq    #3,d4         Indicate type is INT
           rts                    Return EXTOP error code
*
* Convert long integer in D1 into a floating point value
*
return_fp  move.w   d1,d4         D4 will be exponent
           move.l   d1,d5         D5 will be mantissa
           beq.s    normalised    Zero is a trivial case
           move.w   #2079,d4      First guess at exponent
           add.l    d1,d1         Already normalised?
           bvs.s    normalised
           subq.w   #1,d4         No, halve exponent weight
           move.l   d1,d5         Double mantissa to match
           moveq    #16,d0        Try a 16 bit shift
*
normalise  move.l   d5,d1         Take copy of mantissa
           asl.l    d0,d1         Shift mantissa D0 places
           bvs.s    too_far       Overflow; must shift less
           sub.w    d0,d4         Correct exponent for shift
           move.l   d1,d5         New mantissa is more normal
too_far    asr.w    #1,d0         Halve shift distance
           bne.s    normalise     Try shift of 8, 4, 2 and 1
*
* Check there's enough space for the result: (6-2) bytes
*
normalised move.l   a1,$58(a6)    Record current A1 limit
           moveq    #4,d1         No. of extra bytes needed
           move.w   $11A,a0       BV.CHRIX vector
           jsr      (a0)
           move.l   $58(a6),a1    Get safe A1 value
           subq.w   #4,a1
           move.l   a1,$58(a6)    Grab 4 more bytes safely
*
           move.l   d5,2(a1,a6.l) Stack mantissa
           move.w   d4,0(a1,a6.l) Stack exponent
           moveq    #2,d4         Floating point result
           bra.s    got_value
*
* CHANnel EXtended OPeration routine: reads channel data.
* D1.W is offset, D2 is a flag: 0=Byte, -ve=Long, +ve=Word
* The result is returned in D1; no errors are detected. 
*
ch_extop   tst.w    d2
           beq.s    read_byte
           bmi.s    read_long
read_word  move.w   0(a0,d1.w),d1
           bra.s    got_value
read_long  move.l   0(a0,d1.w),d1
           bra.s    got_value
read_byte  moveq    #0,d2         Clear high byte
           move.b   0(a0,d1.w),d2
           move.w   d2,d1
got_value  moveq    #0,d0
           rts
*
           end