* QL WORLD DIY TOOLKIT - HEADER procedures
* Ver. 0.3, Copyright 1987,90 Simon N Goodwin.
*
start       lea.l    define,a1
            move.w   $110,a2     BP.INIT vector
            jmp      (a2)
*
define      dc.w     2           Two procedures
            dc.w     gethead-*
            dc.b     7,'GetHEAD' #channel%,address
            ds.w     0
            dc.w     sethead-*
            dc.b     7,'SetHEAD' #channel%,address
            ds.w     0
            dc.w     0,0,0       No functions                
*
sethead    moveq      #70,d4     FS.HEADS key
           bra.s      parse_ch
gethead    moveq      #71,d4     FS.HEADR key
parse_ch   cmpa.l     a3,a5      Any parameters?
           beq.s      bad_param
*
* Read the first parameter - the channel number
*
           move.l     a5,d5      Save end of table
           lea.l      8(a3),a5   Isolate parameter
           move.w     $112,a2    Vector to get integers
           jsr        (a2)
           bne.s      bad_exit
           move.w     0(a1,a6.l),d0
           addq.l     #2,$58(a6) Lose stacked integer
           move.l     a5,a3      Step past parameter
           move.l     d5,a5
*
* Convert channel number in D0 to channel ID in D5
*
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),d5
           bmi.s      what_chan  Closed if negative
*
* Read and check the address parameter in D0
*
           move.w     $118,a2    Vector gets addresses
           jsr        (a2)
           bne.s      bad_exit
           subq.w     #1,d3      Test No. of parameters
           bne.s      bad_param  Reject unless it's one
           move.l     0(a1,a6.l),d0
           btst       #0,d0      Is the parameter odd?
           bne.s      bad_param
*
* Set standard registers and exit via QDOS
*
           move.l   d5,a0        Set up channel ID
           move.l   d0,a1        ... buffer address
           moveq    #64,d2       ... buffer length
           moveq    #100,d3      ... allow two seconds
           move.l   d4,d0        ... set the trap key
           trap     #3           Call QDOS
           rts                   Return error code
*              
what_chan  moveq    #-6,d0       CHANNEL NOT OPEN error
           rts
bad_param  moveq    #-15,d0      BAD PARAMETER error
bad_exit   rts
           end