$MACRO call
	jsr pc,#@1
$ENDM
/
        PROGRAM lpk
        .title  lpk     delete  spool queue
        .psect  lpk
        .enabl  lc
        .enabl ama
        .nlist sym
        .ident  /1/
;+
; to assemble:
; [x,x]lpk=[1,1]exemc/ml,[200,200]rsxmc/pa:1,[x,x]lpk
;-
        .mcall  call,return,dir$,exit$s,gmcr$,altp$s,cnct$,abrt$
        .mcall  wtse$,rqst$,finit$,fsrsz$,qiow$
 
;       tcbdf$                  ; define tcb offsets
use:    qiow$  io.wvb,1,5,,,,<m1,lm1,40>
nofile: qiow$  io.wvb,1,5,,,,<n1,ln1,40>
notact: qiow$  io.wvb,1,5,,,,<o1,lo1,40>
m1:     .ascii /Usage: lpk file.nam (or lpkill)/
lm1=.-m1
n1:     .ascii /Cannot find file entry/
ln1=.-n1
o1:     .ascii /Prt... is not active/
lo1=.-o1
        .even
aflag:  .word
addr:   .word
len:    .word
mypri:	.word	0		; holds lpk's running priority
name:   .rad50  /PRT.../        ; spooler taskname
gmcr:	gmcr$			; needed because installed as mcr task
buf=    gmcr+g.mcrb
connect: cnct$ PRT...,10
wait:   wtse$ 10
abort:  abrt$ PRT...
reqest: rqst$ PRT...
        CSI
fdb:
        FDB 5 B                 ;just so's we can get a file id




start:
        finit$
	dir$	#gmcr		; pick up command line
        IFB buf+3 = #'I  AND buf+3+1 = #'L  AND buf+3+2 = #'L
           call kill
        ELSEIF $dsw GT #4
           call delete
        ELSE
            dir$ #use
        FI

        exit$s
;+
;  kill - kill the current print job without losing the queue
;         Done by trick. Saves prt...'s receive queue listhead
;         and makes it appear empty. Then we abort prt... and
;         connect on its exit. After it exits, we restore the queue
;         and request its execution.
;-

kill:   call gettcb

s2:     mov     t.rcvl(r0),r1   ; get first entry (rec queue listhead)
        beq     4$              ; if eq queue empty
        mov     t.rcvl+2(r0),r2 ; get first entry (rec queue listhead)
        clr     t.rcvl(r0)      ;pretend queue is empty
        mov     r0,t.rcvl+2(r0) ;by putting 0,.-2 into listhead

4$:
        clr aflag
        dir$ #connect           ;connect to prt...
        bcs 5$                  ;assume not active is only error
        inc aflag
        dir$ #abort             ;abort prt...
        dir$ #wait              ;and wait for it to be done

5$:     tst r1
        beq 6$                  ;nothing to restore
        mov r1,t.rcvl(r0)
        mov r2,t.rcvl+2(r0)     ;restore the queue
        dir$ #reqest            ;and activate it
6$:
        IF aflag =  #0
           dir$ #notact
        FI
        br err1
err2:
        dir$ #nofile
        dir$ #use
err1:   exit$s                  ; so long!

;+
; delete - delete file from prt... queue.
;+
delete:

        LET r0 = #buf   + $dsw
        mov #buf+4,r1           ;point to start of string
        sub r1,r0               ;get length
        mov r1,addr
        mov r0,len
        FILE addr len           ;parse string
        IF CS
           jmp err2
        FI

         mov #fdb,r0            ;fdb address
         mov r0,r1              ;copy
         add #f.fnb,r1          ;file name block address
	 mov f.dspt(r0),r2	;the data set pointer -> r2
	 mov f.dfnb(r0),r3	;the def file name pointer ->r3
	 call .parse
	 bcs err2
	 call .find
	 bcs err2



        call gettcb               ;get tcb in r0 of prt...
        mov fdb+f.fnb+n.fid,r3
        mov fdb+f.fnb+n.fid+2,r4  ;get 2 words of file id into r3,r4
        mov t.rcvl(r0),r0         ;addr of receive queue

        IF NE                     ;if ne, then not empty
           emt 376                ;switch stacks (switch to system state)
           .word 69$              ;return address
 
           DO FOREVER
              IF r0 = #0
                 BREAK
              FI
   
              IF 24(r0) = r3   AND   26(r0) = r4
                 clr 2(r0)
                 clr 4(r0)                       ;blank out sender
                 clr 24(r0)
                 clr 26(r0)
                 BREAK
              FI
              mov (r0),r0
           OD
        rts pc
69$:
        FI
        exit$s



;+
; gettcb - finds address of tcb for prt... or jmps directly to err1
;-

gettcb: mov     #name,r3        ; point to spooler name
        call    $srstd          ; find tcb (exec routine)
	bcc	2$		; if c cleared, prt is installed
	jmp	err1		; other wise not installed rlm.
2$:	clr	mypri
	bisb	$tktcb+t.pri,mypri	; get my priority -dm.
	clr	r5			;
	bisb	t.pri(r0),r5		; get prt's priority -dm.
	inc	r5			; increase by one -dm.
	altp$s	,r5			; now we are higher that prt... -dm.
        rts pc
        fsrsz$ 0
	.end	start
