INCLUDE flp1_pipe_definitions SECTION text XREF first.pipe XREF dev.name XDEF dopipes dopipes lea.l proclist,a1 vector bp.init a2 rts proclist dc.w 2 dc.w pipe.use-* dc.b 8,'PIPE_USE' dc.w pipes-* dc.b 5,'PIPES' dc.w 0,0,0 ************************ the procedure pipe_use ********************** pipe.use vector ca.gtstr a1 ; get string parameter tst.l d0 ; or was it something else? bne.l badparm cmp.w #1,d3 ; must be exactly one bne.l badparm move.w 0(a6,a1.l),d4 ; length in d4 cmp.w #8,d4 ; more than 8? bgt.l badparm ; not allowed lea.l dev.name,a3 ; this must be changed move.w d4,(a3)+ ; first update length bra.s pu.start pu.next move.b 2(a6,a1.l),(a3)+ addq.l #1,a1 pu.start dbra d4,pu.next moveq #0,d0 ; O.K! rts ***** the procedure pipes ************************** pipes cmpa.l a3,a5 beq.s default ; if no parameters, take default tst.b 1(a3,a6.l) ; check # before parameter bge.l badparm vector ca.gtint a1 ; get parameter tst.l d0 bne.l error.return cmp.w #1,d3 bgt.l badparm ; no more than one move.w 0(a6,a1.l),d0 bra.s dp.verder default move.w #1,d0 ; #1 is default dp.verder jsr find.id tst.l d0 bne.l error.return moveq #mt.inf,d0 ; get system variable base ... trap #1 move.l a0,a5 ; into a5 move.l a4,a0 ; get channel id in a0 * now we have the correct channel ID in a0, and the sysvars base in a5 * find the start of the npipe linked list (we keep the current pipe in d7): dp.start trap #0 ; enter supervisor mode lea.l first.pipe,a2 move.l (a2),d7 ; get pointer to first pipe dp.again tst.l d7 beq.l dp.ready move.l d7,a2 bsr.l pipe.info ; get info cmp.l #err.ic,d0 ; married input pipe? beq.l dp.next ; ignore it. move.l a4,-(a7) ; save receiver move.l a3,-(a7) ; sender move.l d0,-(a7) ; status move.l d2,-(a7) ; length move.l a1,-(a7) ; name bsr.l spaces ; clean template lea.l firstchar,a2 move.l a2,a3 lea.l dev.name,a4 ; print device name moveq #8,d4 bsr.l print.str move.b #'_',(a3)+ ; print single underscore moveq #15,d4 move.l (a7)+,a4 ; pop name bsr.l print.str ; print it dp.noname move.l (a7)+,d4 ; pop length lea.l 30(a2),a3 bsr.l print.num ; print it dp.zero lea.l 36(a2),a3 ; right tab 36 move.l (a7)+,d4 ; pop status/content ble.s dp.special ; is it special (i.e. <= 0)? bsr.l print.num ; no, print content bra.s dp.newline dp.special tst.l d4 bne.s dp.notemp lea.l 31(a2),a3 lea.l isempty,a4 moveq #5,d4 bsr.l print.str bra.s dp.newline dp.notemp cmp.l #err.nc,d4 ; waiting? bne.s dp.eof ; no, then EOF lea.l waiting,a4 ; print 'waiting' lea.l 28(a2),a3 ; tab 28 moveq #7,d4 bsr.l print.str bra.s dp.newline bra.s dp.next dp.eof lea.l eof,a4 lea.l 32(a2),a3 moveq #3,d4 bsr.l print.str dp.newline move.b #10,36(a2) ; newline at pos 36 lea.l 41(a2),a3 ; tab 41 moveq #14,d4 move.l (a7)+,a4 bsr.l print.str move.w #'>>',56(a2) lea.l 60(a2),a3 moveq #14,d4 move.l (a7)+,a4 bsr.l print.str move.b #10,(a3)+ bsr.l print.it tst.l d0 beq.s dp.next andi.w #$dfff,sr rts dp.next move.l d7,a2 move.l pi.next(a2),d7 bra.l dp.again dp.ready andi.w #$dfff,sr ; back to user mode moveq #0,d0 error.return rts badparm moveq #err.bp,d0 rts ****** find.id in: basic channel # in d0, out: QDOS channel ID in a4 ********** find.id move.l bv.chbas(a6),a4 ; start of table mulu #$28,d0 add.l d0,a4 ; relevant entry cmp.l bv.chp(a6),a4 bge.s no.id ; it's not there move.l 0(a6,a4.l),d0 ; channel id blt.s no.id move.l d0,a4 clr.l d0 rts no.id moveq #err.ic,d0 ; invalid channel rts ********************** pipe.info ******************************* * in: * a2 -> channel definition block * a5 -> system variables * * out: * a1-> pipename * d2 = length ( 0 for input pipe) * a3 -> name of sending job * a4 -> name of receiving job * d0 status : >= 0 : bytes remaining, err.ic ignore (married input pipe) * err.eof EOF err.nc waiting * a2 corrupted , a5 preserved ***************************************************************** pipe.info move.l ch.owner(a2),d0 jsr jobname ; find jobname of this side (in a1) tst.l ch.qout(a2) bne.s if.blowpipe * input pipe: move.l a1,a4 ; put name in a4 move.l pi.partner(a2),d1 bne.s if.partner lea.l empty,a3 ; a3 -> "" clr.l d2 ; length = 0 tst.b pi.ready(a2) bne.s if.ready moveq #err.nc,d0 bra.s if.done if.ready tst.b pi.eof(a2) beq.s if.strange moveq #err.eof,d0 bra.s if.done if.partner ; input pipe with partner move.l pi.partner(a2),a2 ; make the other side the current one tst.l pi.qstart(a2) ; is it still open? blt.s if.closed if.strange moveq #err.ic,d0 ; if so, ignore rts if.closed lea.l empty,a3 ; no blowing side anymore bra.s if.statistics ; jobnames have been set now if.blowpipe move.l a1,a3 ; jobname of sending side move.l pi.partner(a2),d0 beq.s if.lonely ; no partner? move.l d0,a1 move.l ch.owner(a1),d0 jsr jobname move.l a1,a4 ; jobname of receiving end bra.s if.statistics if.lonely lea.l empty,a4 ; no receiver * now a2 points to the channel def block of the sender and all * job names have been set if.statistics bra.s daar dc.l 'HIER' daar lea.l pi.qstart(a2),a1 move.l q.end(a1),d2 sub.l a1,d2 sub.l #q.queue,d2 ; d2 contains length andi.l #$0000FFFF,d2 ; due to a QDOS bug, d2 may be <0 move.l q.nextin(a1),d0 sub.l q.nxtout(a1),d0 ; calculate difference bge.s if.done ; if negative ... add.l d2,d0 ; ........ add length if.done lea.l pi.name(a2),a1 ; get name in a1 rts * jobname finds job name : * in: * d0 = job id * a5 = system variables (e.g.$28000) * out: * a1 -> job name * a5,a0 preserved * only d0,d1 corrupted jobname move.l sv.jbbas(a5),a1 clr.l d1 move.w d0,d1 beq.s job.basic ; it is job 0 asl.w #2,d1 add.l d1,a1 move.l (a1),a1 cmp.w #$4AFB,$6E(a1) bne.s job.anon ; anonymous job lea.l $70(a1),a1 rts job.basic lea.l basic,a1 rts job.anon lea.l anonymous,a1 rts **************** PRINT ( i.e. substitute) SUBROUTINES ******************* * Before: * a3 -> somewhere in memory * print.str: * a4 -> QDOS string to 'print' (e.g. 5,'hello') * d4.w = max number of chars to 'print' (e.g. 3) * print.num: * d4.w = (unsigned) number to 'print' * After: * a3 -> 1 past last char 'printed' * d4 a4 d5 and d6 corrupted * *************************************************************************** print.str move.w (a4)+,d5 cmp.w d5,d4 bge.s pr.start move.w d4,d5 bra.s pr.start pr.again move.b (a4)+,(a3)+ pr.start dbra d5,pr.again pr.ready rts print.num divu #10,d4 swap d4 ; remainder in lower word add.w #'0',d4 move.b d4,-(a3) ; printing backwards clr.w d4 swap d4 beq.s pr.ready bra.s print.num spaces lea.l template,a3 move.w (a3)+,d4 bra.s sp.start sp.next move.b #' ',(a3)+ sp.start dbra d4,sp.next lea.l firstchar,a3 rts print.it lea.l firstchar,a1 move.l a3,d2 sub.l a1,d2 blt.s no.print cmp.w template,d2 bgt.s no.print moveq #0,d3 moveq #10,d4 retry moveq #io.sstrg,d0 trap #3 cmp.l #err.nc,d0 dbne d4,retry no.print rts section DATA template dc.w 76 * 0/15 36 41/15 52 55/15 (/n) firstchar dc.b '01234567890123456789012345678901234567890123456789012345678901234567890123456' * PIPE_pipename_nnnnn status\n Job1 >> Job2 arrow dc.w 2,'>>' basic dc.w 10,'SuperBasic' anonymous dc.w 15,'** anonymous **' eof dc.w 3,'EOF' waiting dc.w 7,'waiting' isempty dc.w 5,'empty' empty dc.w 0 ; empty string ds.l 1 END