.title GET_QUEUE_NAME ; This code is ONLY expected to work for VAX/VMS V4.0 ; It is bound to break, as it uses unsupported things... ; ; Routine to get the queue name that a batch job is in, given its PID. ; ; RC=GET_QUEUE_NAME(PID.rlu.r, QUEUE.wt.dx, QUEUE_L.wwu.r) ; ; Inputs: ; ; PID Process Identification for which to search ; ; Outputs: ; ; QUEUE Buffer to receive queue name ; QUEUE_L Longword to receive queue name length ; ; Author: ; ; Jim Osborne (PJO@PSUVMS1.BITNET) ; Engineering Computer Lab ; Pennsylvania State University ; ; Revision History: ; ; V1.0 14-JAN-1984 Original Version ; ; Description: ; ; This routine maps SYS$SYSTEM:JBCSYSQUE.DAT and scans it for batch jobs ; matching a given PID and returns the queue name the batch job is running ; under. In order to save time, the current system time is compared to ; the system time at which JBCSYSQUE.DAT was last mapped. If this time ; is less than a specified time, the file is NOT re-scanned. Not only is ; the file re-mapped, but the channel is deassigned and then re-assigned, ; in order to insure that we don't miss the boat if JOB_CONTROL extends ; the file. When the file is mapped, it is scanned for executing batch ; jobs, and their PIDs and queue names are stored in internal arrays for ; reference (until we re-map and re-scan). If the arrays contain information ; which is sufficiently recent, the file is not re-mapped and re-scanned. ; This significantly cuts down the amount of processing (and page-faulting). PID=04 ; define argument list QUEUE=08 QUEUE_L=12 $SECDEF ; define flags for SYS$CRMPSC BLK$B_TYPE=4 ; define offsets by hand, since BLK$C_SMQ=6 ; they aren't in SYS$LIBRARY:LIB BLK$C_SJH=7 ; anymore... SJH$L_EXECUTOR_PID=360 SJH$L_QUEUE_LINK=308 SMQ$T_NAME=176 SMQ$S_NAME=32 MAX_JOBS=30 ; # of batch jobs to remember ; in internal arrays MAX_BLOCKS=200 ; maximum # of blocks of ; JBCSYSQUE.DAT to map STALE_DELAY=60 ; # of seconds to wait before we ; update our internal arrays .macro .die,?skip blbs R0,skip brw NOTFND skip: .endm .die .macro bit,fac,name,val fac'$V_'name=val fac'$M_'name=1@val .endm bit .psect data,page .align page JBCSYSQUE: .blkb 512*MAX_BLOCKS ; JBCSYSQUE.DAT is mapped here .align long FAB: $fab fnm=,- fop=,- fac=,- shr=,- lnm_mode=1 INADR: .address JBCSYSQUE ; range to map JBSYSQUE.DAT .address - JBCSYSQUE+<512*MAX_BLOCKS>-1 RETADR: .blkq ; range actually mapped PIDS: .blkl MAX_JOBS ; batch PID array QUEUES: .blkb MAX_JOBS* ; batch queue name array QUEUE_LS: .blkl MAX_JOBS ; batch queue-name length array COUNT: .blkl ; # of entries in array FREE: .blkl ; free space in array DELAY: .long STALE_DELAY*1000*1000*10,0 ; delay LASTCALL: .quad 0 ; last time we re-mapped THISCALL: .blkq ; current system time DIFF: .blkq ; time since last re-map SUBX_AL: .long 3 ; arglist to LIB$SUBX .address THISCALL .address LASTCALL .address DIFF SOFAR: .blkb ; flags bit SOFAR,OPEN,0 ; set if file is open bit SOFAR,MAP,1 ; set if file is mapped QNM_D: .blkq ; descr for STR$COPY_DX NUL_D: .ascid " " ; nul descr for STR$COPY_DX .entry GET_QUEUE_NAME,^M bbs #SOFAR$V_OPEN,SOFAR,MAPIT ; opened yet? OPENIT: $open fab=FAB ; open JBCSYSQUE.DAT .die OPENOK: bisb2 #SOFAR$M_OPEN,SOFAR ; mark file is open MAPIT: bbs #SOFAR$V_MAP,SOFAR,MAPPED ; mapped yet? $crmpsc_s chan=FAB+FAB$L_STV,- ; map it inadr=INADR,- retadr=RETADR .die bisb2 #SOFAR$M_MAP,SOFAR ; mark file is mapped $gettim_s timadr=LASTCALL ; store re-map time .die brw SCAN MAPPED: $gettim_s timadr=THISCALL ; get system time .die callg SUBX_AL,G^LIB$SUBX ; subtract .die cmpl DIFF+4,DELAY+4 ; too long a delay? bgtru STALE blssu NOUPDA cmpl DIFF,DELAY bgtru STALE ; yes, update info NOUPDA: brw LOOKUP ; no, use old data STALE: $deltva_s inadr=RETADR ; delete section .die bicb2 #SOFAR$M_MAP,SOFAR ; mark not mapped anymore $dassgn_s chan=FAB+FAB$L_STV ; close section .die bicb2 #SOFAR$M_OPEN,SOFAR ; mark not opened anymore brw OPENIT SCAN: clrl COUNT ; init job count movl #MAX_JOBS,FREE ; init free size movl RETADR,R6 ; point to base CHKBLK: cmpb BLK$B_TYPE(R6),#BLK$C_SJH ; a JOB block? bneq NXTBLK GOTSJH: tstl SJH$L_EXECUTOR_PID(R6) ; is EXECUTOR PID valid? beql NXTBLK ; if not, ignore subl3 #1,SJH$L_QUEUE_LINK(R6),R5 ; R1 = QUEUE record # blss NXTBLK ; if invalid, ignore mull2 #512,R5 ; find QUEUE block addr addl2 RETADR,R5 cmpb BLK$B_TYPE(R5),#BLK$C_SMQ ; a QUEUE block? bneq NXTBLK ; if not, ignore movl COUNT,R0 ; get index movl SJH$L_EXECUTOR_PID(R6),PIDS[R0] ; move PID movzbl SMQ$T_NAME(R5),R1 ; get QNL movl R1,QUEUE_LS[R0] ; move QNL mull2 #SMQ$S_NAME-1,R0 ; find offset into char array movc5 R1,SMQ$T_NAME+1(R5),#^X20,- ; copy string #SMQ$S_NAME-1,QUEUES[R0] incl COUNT ; update this! decl FREE ; update free beql LOOKUP ; if full, stop looking NXTBLK: addl2 #512,R6 ; point to next block cmpl R6,RETADR+4 ; past end? blssu CHKBLK ; no, loop LOOKUP: movl COUNT,R0 ; get count CMPNXT: decl R0 ; create index to next blss NOTFND ; if exhausted, done cmpl PIDS[R0],@PID(AP) ; match? bneq CMPNXT ; no, keep trying movl QUEUE_LS[R0],QNM_D ; get length movl QNM_D,@QUEUE_L(AP) ; copy it to dest mull2 #SMQ$S_NAME-1,R0 ; point to text movab QUEUES[R0],QNM_D+4 pushaq QNM_D pushaq @QUEUE(AP) calls #2,G^STR$COPY_DX ; copy it ret NOTFND: pushaq NUL_D pushaq @QUEUE(AP) calls #2,G^STR$COPY_DX ; blank it clrl @QUEUE_L(AP) ; zero length clrl R0 ; failure ret .end