.PRINT  ; $MACRO call
.PRINT  ; 	jsr pc,#@1
.PRINT  ; $ENDM
.PRINT  ; /
.PRINT  ;         PROGRAM lpk
.ENABL LC
 ; library-created 3/5/80 - for WHT-SM c runtime
.PRINT  ;         .title  lpk     delete  spool queue
        .title  lpk     delete  spool queue
.PRINT  ;         .psect  lpk
        .psect  lpk
.PRINT  ;         .enabl  lc
        .enabl  lc
.PRINT  ;         .enabl ama
        .enabl ama
.PRINT  ;         .nlist sym
        .nlist sym
.PRINT  ;         .ident  /1/
        .ident  /1/
.PRINT  ; ;+
.PRINT  ; ; to assemble:
.PRINT  ; ; [x,x]lpk=[1,1]exemc/ml,[200,200]rsxmc/pa:1,[x,x]lpk
.PRINT  ; ;-
.PRINT  ;         .mcall  call,return,dir$,exit$s,gmcr$,altp$s,cnct$,abrt$
        .mcall  call,return,dir$,exit$s,gmcr$,altp$s,cnct$,abrt$
.PRINT  ;         .mcall  wtse$,rqst$,finit$,fsrsz$,qiow$
        .mcall  wtse$,rqst$,finit$,fsrsz$,qiow$
.PRINT  ;  
 
.PRINT  ; ;       tcbdf$                  ; define tcb offsets
.PRINT  ; use:    qiow$  io.wvb,1,5,,,,<m1,lm1,40>
use:    qiow$  io.wvb,1,5,,,,<m1,lm1,40>
.PRINT  ; nofile: qiow$  io.wvb,1,5,,,,<n1,ln1,40>
nofile: qiow$  io.wvb,1,5,,,,<n1,ln1,40>
.PRINT  ; notact: qiow$  io.wvb,1,5,,,,<o1,lo1,40>
notact: qiow$  io.wvb,1,5,,,,<o1,lo1,40>
.PRINT  ; m1:     .ascii /Usage: lpk file.nam (or lpkill)/
m1:     .ascii /Usage: lpk file.nam (or lpkill)/
.PRINT  ; lm1=.-m1
lm1=.-m1
.PRINT  ; n1:     .ascii /Cannot find file entry/
n1:     .ascii /Cannot find file entry/
.PRINT  ; ln1=.-n1
ln1=.-n1
.PRINT  ; o1:     .ascii /Prt... is not active/
o1:     .ascii /Prt... is not active/
.PRINT  ; lo1=.-o1
lo1=.-o1
.PRINT  ;         .even
        .even
.PRINT  ; aflag:  .word
aflag:  .word
.PRINT  ; addr:   .word
addr:   .word
.PRINT  ; len:    .word
len:    .word
.PRINT  ; mypri:	.word	0		; holds lpk's running priority
mypri:	.word	0		; holds lpk's running priority
.PRINT  ; name:   .rad50  /PRT.../        ; spooler taskname
name:   .rad50  /PRT.../        ; spooler taskname
.PRINT  ; gmcr:	gmcr$			; needed because installed as mcr task
gmcr:	gmcr$			; needed because installed as mcr task
.PRINT  ; buf=    gmcr+g.mcrb
buf=    gmcr+g.mcrb
.PRINT  ; connect: cnct$ PRT...,10
connect: cnct$ PRT...,10
.PRINT  ; wait:   wtse$ 10
wait:   wtse$ 10
.PRINT  ; abort:  abrt$ PRT...
abort:  abrt$ PRT...
.PRINT  ; reqest: rqst$ PRT...
reqest: rqst$ PRT...
.PRINT  ;         CSI
	.MCALL CSI$
	CSI$
	.EVEN
CSIBLK:: .BLKB C.SIZE
.PRINT  ; fdb:
fdb:
.PRINT  ;         FDB 5 B                 ;just so's we can get a file id
;FDB lun B/R,[block]
       .mcall fdop$a,fdat$a,fdbdf$,fdrc$a,fdbk$a
       fdbdf$
       fdop$a 5,csiblk+c.dsds
       fdat$a r.fix,,512.
       fdrc$a fd.rwm
.PRINT  ; 
.PRINT  ; 
.PRINT  ; 
.PRINT  ; 
.PRINT  ; start:
start:
.PRINT  ;         finit$
        finit$
.PRINT  ; 	dir$	#gmcr		; pick up command line
	dir$	#gmcr		; pick up command line
.PRINT  ;         IFB buf+3 = #'I  AND buf+3+1 = #'L  AND buf+3+2 = #'L
	CMPB buf+3,#'I		;IS buf+3 = #'I
	BNE lpk1	;Not if NE
	CMPB buf+3+1,#'L		;IS buf+3+1 = #'L
	BNE lpk4	;Not if NE
	CMPB buf+3+2,#'L		;IS buf+3+2 = #'L
	BNE lpk7	;Not if NE
	BR lpk10	;Here IFB buf+3+2 = #'L    
lpk7=.
	BR lpk4		;Here if not
lpk10=.
	BR lpk11	;Here IFB buf+3+1 = #'L AND buf+3+2 = #'L
lpk4=.
	BR lpk1		;Here if not
lpk11=.
.PRINT  ;            call kill
	jsr pc,kill
.PRINT  ;         ELSEIF $dsw GT #4
	JMP lpk3
lpk1=.
	CMP $dsw,#4		;IS $dsw GT #4
	BLE lpk12	;Not if LE
.PRINT  ;            call delete
	jsr pc,delete
.PRINT  ;         ELSE
	JMP lpk15
lpk12=.			; 
.PRINT  ;             dir$ #use
            dir$ #use
.PRINT  ;         FI
lpk15=.			; 
lpk3=.
.PRINT  ; 
.PRINT  ;         exit$s
        exit$s
.PRINT  ; ;+
.PRINT  ; ;  kill - kill the current print job without losing the queue
.PRINT  ; ;         Done by trick. Saves prt...'s receive queue listhead
.PRINT  ; ;         and makes it appear empty. Then we abort prt... and
.PRINT  ; ;         connect on its exit. After it exits, we restore the queue
.PRINT  ; ;         and request its execution.
.PRINT  ; ;-
.PRINT  ; 
.PRINT  ; kill:   call gettcb
kill:
	jsr pc,gettcb
.PRINT  ; 
.PRINT  ; s2:     mov     t.rcvl(r0),r1   ; get first entry (rec queue listhead)
s2:     mov     t.rcvl(r0),r1   ; get first entry (rec queue listhead)
.PRINT  ;         beq     4$              ; if eq queue empty
        beq     4$              ; if eq queue empty
.PRINT  ;         mov     t.rcvl+2(r0),r2 ; get first entry (rec queue listhead)
        mov     t.rcvl+2(r0),r2 ; get first entry (rec queue listhead)
.PRINT  ;         clr     t.rcvl(r0)      ;pretend queue is empty
        clr     t.rcvl(r0)      ;pretend queue is empty
.PRINT  ;         mov     r0,t.rcvl+2(r0) ;by putting 0,.-2 into listhead
        mov     r0,t.rcvl+2(r0) ;by putting 0,.-2 into listhead
.PRINT  ; 
.PRINT  ; 4$:
4$:
.PRINT  ;         clr aflag
        clr aflag
.PRINT  ;         dir$ #connect           ;connect to prt...
        dir$ #connect           ;connect to prt...
.PRINT  ;         bcs 5$                  ;assume not active is only error
        bcs 5$                  ;assume not active is only error
.PRINT  ;         inc aflag
        inc aflag
.PRINT  ;         dir$ #abort             ;abort prt...
        dir$ #abort             ;abort prt...
.PRINT  ;         dir$ #wait              ;and wait for it to be done
        dir$ #wait              ;and wait for it to be done
.PRINT  ; 
.PRINT  ; 5$:     tst r1
5$:     tst r1
.PRINT  ;         beq 6$                  ;nothing to restore
        beq 6$                  ;nothing to restore
.PRINT  ;         mov r1,t.rcvl(r0)
        mov r1,t.rcvl(r0)
.PRINT  ;         mov r2,t.rcvl+2(r0)     ;restore the queue
        mov r2,t.rcvl+2(r0)     ;restore the queue
.PRINT  ;         dir$ #reqest            ;and activate it
        dir$ #reqest            ;and activate it
.PRINT  ; 6$:
6$:
.PRINT  ;         IF aflag =  #0
	TST aflag		;IS aflag = #0
	BNE lpk16	;Not if NE
.PRINT  ;            dir$ #notact
           dir$ #notact
.PRINT  ;         FI
lpk16=.			; 
lpk18=.
.PRINT  ;         br err1
        br err1
.PRINT  ; err2:
err2:
.PRINT  ;         dir$ #nofile
        dir$ #nofile
.PRINT  ;         dir$ #use
        dir$ #use
.PRINT  ; err1:   exit$s                  ; so long!
err1:   exit$s                  ; so long!
.PRINT  ; 
.PRINT  ; ;+
.PRINT  ; ; delete - delete file from prt... queue.
.PRINT  ; ;+
.PRINT  ; delete:
delete:
.PRINT  ; 
.PRINT  ;         LET r0 = #buf   + $dsw
	MOV #buf,r0
	ADD $dsw,r0
.PRINT  ;         mov #buf+4,r1           ;point to start of string
        mov #buf+4,r1           ;point to start of string
.PRINT  ;         sub r1,r0               ;get length
        sub r1,r0               ;get length
.PRINT  ;         mov r1,addr
        mov r1,addr
.PRINT  ;         mov r0,len
        mov r0,len
.PRINT  ;         FILE addr len           ;parse string
;FILE addr-of-string len-str
	.MCALL CSI$1,CSI$2
	CSI$1 #CSIBLK,addr,len
	BCS lpk19
        CSI$2   ,OUTPUT
lpk19=.
.PRINT  ;         IF CS
	BCC lpk20	;Not if CC
.PRINT  ;            jmp err2
           jmp err2
.PRINT  ;         FI
lpk20=.			; 
lpk22=.
.PRINT  ; 
.PRINT  ;          mov #fdb,r0            ;fdb address
         mov #fdb,r0            ;fdb address
.PRINT  ;          mov r0,r1              ;copy
         mov r0,r1              ;copy
.PRINT  ;          add #f.fnb,r1          ;file name block address
         add #f.fnb,r1          ;file name block address
.PRINT  ; 	 mov f.dspt(r0),r2	;the data set pointer -> r2
	 mov f.dspt(r0),r2	;the data set pointer -> r2
.PRINT  ; 	 mov f.dfnb(r0),r3	;the def file name pointer ->r3
	 mov f.dfnb(r0),r3	;the def file name pointer ->r3
.PRINT  ; 	 call .parse
	jsr pc,.parse
.PRINT  ; 	 bcs err2
	 bcs err2
.PRINT  ; 	 call .find
	jsr pc,.find
.PRINT  ; 	 bcs err2
	 bcs err2
.PRINT  ; 
.PRINT  ; 
.PRINT  ; 
.PRINT  ;         call gettcb               ;get tcb in r0 of prt...
	jsr pc,gettcb
.PRINT  ;         mov fdb+f.fnb+n.fid,r3
        mov fdb+f.fnb+n.fid,r3
.PRINT  ;         mov fdb+f.fnb+n.fid+2,r4  ;get 2 words of file id into r3,r4
        mov fdb+f.fnb+n.fid+2,r4  ;get 2 words of file id into r3,r4
.PRINT  ;         mov t.rcvl(r0),r0         ;addr of receive queue
        mov t.rcvl(r0),r0         ;addr of receive queue
.PRINT  ; 
.PRINT  ;         IF NE                     ;if ne, then not empty
	BEQ lpk23	;Not if EQ
.PRINT  ;            emt 376                ;switch stacks (switch to system state)
           emt 376                ;switch stacks (switch to system state)
.PRINT  ;            .word 69$              ;return address
           .word 69$              ;return address
.PRINT  ;  
 
.PRINT  ;            DO FOREVER
lpk26=.
.PRINT  ;               IF r0 = #0
	TST r0		;IS r0 = #0
	BNE lpk28	;Not if NE
.PRINT  ;                  BREAK
	JMP lpk27		;break 
.PRINT  ;               FI
lpk28=.			; 
lpk30=.
.PRINT  ;    
   
.PRINT  ;               IF 24(r0) = r3   AND   26(r0) = r4
	CMP 24(r0),r3		;IS 24(r0) = r3
	BNE lpk31	;Not if NE
	CMP 26(r0),r4		;IS 26(r0) = r4
	BNE lpk34	;Not if NE
	BR lpk37	;Here IF 26(r0) = r4    
lpk34=.
	BR lpk31		;Here if not
lpk37=.
.PRINT  ;                  clr 2(r0)
                 clr 2(r0)
.PRINT  ;                  clr 4(r0)                       ;blank out sender
                 clr 4(r0)                       ;blank out sender
.PRINT  ;                  clr 24(r0)
                 clr 24(r0)
.PRINT  ;                  clr 26(r0)
                 clr 26(r0)
.PRINT  ;                  BREAK
	JMP lpk27		;break 
.PRINT  ;               FI
lpk31=.			; 
lpk33=.
.PRINT  ;               mov (r0),r0
              mov (r0),r0
.PRINT  ;            OD
	JMP lpk26		;Repeat loop
lpk27=.
.PRINT  ;         rts pc
        rts pc
.PRINT  ; 69$:
69$:
.PRINT  ;         FI
lpk23=.			; 
lpk25=.
.PRINT  ;         exit$s
        exit$s
.PRINT  ; 
.PRINT  ; 
.PRINT  ; 
.PRINT  ; ;+
.PRINT  ; ; gettcb - finds address of tcb for prt... or jmps directly to err1
.PRINT  ; ;-
.PRINT  ; 
.PRINT  ; gettcb: mov     #name,r3        ; point to spooler name
gettcb: mov     #name,r3        ; point to spooler name
.PRINT  ;         call    $srstd          ; find tcb (exec routine)
	jsr pc,$srstd
.PRINT  ; 	bcc	2$		; if c cleared, prt is installed
	bcc	2$		; if c cleared, prt is installed
.PRINT  ; 	jmp	err1		; other wise not installed rlm.
	jmp	err1		; other wise not installed rlm.
.PRINT  ; 2$:	clr	mypri
2$:	clr	mypri
.PRINT  ; 	bisb	$tktcb+t.pri,mypri	; get my priority -dm.
	bisb	$tktcb+t.pri,mypri	; get my priority -dm.
.PRINT  ; 	clr	r5			;
	clr	r5			;
.PRINT  ; 	bisb	t.pri(r0),r5		; get prt's priority -dm.
	bisb	t.pri(r0),r5		; get prt's priority -dm.
.PRINT  ; 	inc	r5			; increase by one -dm.
	inc	r5			; increase by one -dm.
.PRINT  ; 	altp$s	,r5			; now we are higher that prt... -dm.
	altp$s	,r5			; now we are higher that prt... -dm.
.PRINT  ;         rts pc
        rts pc
.PRINT  ;         fsrsz$ 0
        fsrsz$ 0
.PRINT  ; 	.end	start
	.end	start
