$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,,,, nofile: qiow$ io.wvb,1,5,,,, notact: qiow$ io.wvb,1,5,,,, 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