From:	MERC::"uunet!WKUVX1.BITNET!FILESERV-Mgr" 19-MAY-1992 05:10:34.42
To:	galaxy::gleeve
CC:	
Subj:	TQE.01_OF_01

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 15-MAY-1992 11:57:48.08   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. [.TQE]TQE.MAR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X`09.title`09tqe
X`09.ident`09'X01-002'
X;++
X;
X; Facility:`09timer que element list utility
X;
X; Abstract:
X;`09This is a program to display the items in the timer queue
X;
X; Author:
X;`09Lee K. Gleason
X;`09Control-G Consultants
X;`092416 Branard #D
X;`09Houston TX 77098
X;`09Phone 713/528-1859
X;
X; Modifications:
X;`09Hunter Goatley  Academic Computing, WKU
X;`09May 15, 1992`09Added fix by Jon Pinkley to prevent accvio's because
X;`09`09`09of IPCACP.  Jon's comments:
X;`09`09`09
X;`09`09`09I kept getting an access violation when the tqe's
X;`09`09`09were being decoded (in user mode, fortunately).`20
X;`09`09`09It appears that the IPCACP is using some bits in
X;`09`09`09the RMOD field in a undocumented way.  TQE assumed
X;`09`09`09that only the 40 bit (quota) should be cleared,
X;`09`09`09and then used the result as an index into a 4
X;`09`09`09longword array.
X;
X;`0910/8/86  Added process name to output for process TQEs
X;--
X
X`09.SBTTL`09tqe
X;++
X; Functional Description:
X;
X;`09This program enters kernel mode, raises ipl to block clock
X;`09events, and copies the timer queue elements to a work area.
X;`09It then goes back to user mode, and displays the entries in
X;`09a semi-readable form.
X;--
X
X`09.link`09`09"sys$system:sys.stb"/SELECTIVE_SEARCH
X`09.library`09"sys$library:lib.mlb"
X
X`09$JPIDEF`09`09; Get Job/Process Information symbols
X`09$tqedef`09`09;timer que element symbols
X`09$psldef`09`09;access mode definitions
X`09$ipldef`09`09;ipl definitions
X`09$acbdef`09`09;ast control block definitions
X`09$SYIDEF`09`09; Used to detect VMS V5
X
X`09.psect`09tqedat pic,long,usr,con,rel,gbl,noshr,noexe,rd,wrt,novec
X
Xmaxentry=256`09;allow report on 256 entries (this would be a BIG system...)
X`09`09;make this larger, if need be.
X
Xtqe_inrange:`09`09;range of data pages to lock down while at elevated ipl
X`09.address`09tqelst`09;address of tqe buffer`09`09
X`09.address`09count`09;address of count longword
X
Xtqe_outrange:
X`09.quad`090`09;actual range locked here (not used, this version)
X
X; *** do not rearrange following lines (or you'll be sorry...) ***
X
Xtqelst:`09.blkb`09tqe$c_length*maxentry`09;tqe buffer
X
Xgettqe_args:`09`09;argument list for call to gettqe routine
X`09.long`092`09;# of args
X`09.address tqelst`09;addr of tqe buffer
X`09.address count`09;addr of count longword
X
Xcount:`09.long`090`09;count of entries found
X
X; *** do not rearrange preceding lines (...I'm warning you) ***
X
Xcountstr:`09;fao string for count
X`09.ascid`09@!/!UL entries in the timer queue!/@
X
Xoutcountstr:`09;output buffer for count string
X`09.ascid`09/                                          /
X
X; Item list for $GETJPI call
XJPI_LIST:
X`09.WORD`0915`09`09; Length of process name buffer
X`09.WORD`09JPI$_PRCNAM`09; ...  Code indicating info to return
X`09.ADDRESS PRCNAM`09`09; ...  Address of buffer
X`09.LONG`09PRCNAM_L`09; ...  Don't care about return length
X`09.WORD`0912`09`09; Length of username buffer
X`09.WORD`09JPI$_USERNAME`09; ...  Code indicating info to return
X`09.ADDRESS USERNAME`09; ...  Address of buffer
X`09.LONG`09USERNAME_L`09; ...  Don't care about return length
X`09.LONG`090`09`09; Terminate the item list
XPRCNAM:`09.BLKB`0915
XPRCNAM_L:
X`09.LONG`090
XUSERNAME:
X`09.BLKB`0912
XUSERNAME_L:
X`09.LONG`090
X
X`09.psect`09tqecod pic,long,usr,con,rel,gbl,shr,exe,rd,nowrt,novec
X
X`09.entry`09tqe,`5Em<>
X
X;+
X;  well, let's get to work...first, lock down all pages that need to
X;  be accessed by routine gettqe, as it will be running at IPL$_TIMER,
X;  and a page fault would cause the system to stop (and the phones to
X;  start ringing.)
X;-
X`09$lkwset_s`09inadr=tqe_inrange,retadr=tqe_outrange,-
X`09`09`09`09acmode=#psl$c_user
X`09blbc`09`09r0,die`09;if bad, then you want out, in a big hurry
X
X;  call the get elements routine, in kernel mode
X
Xloked:`09$cmkrnl_s`09routin=gettqe,arglst=gettqe_args
X
X;  format the count string attractively ($fao, the heir to $edmsg)
X
X`09$fao_s`09ctrstr=countstr,-
X`09`09outbuf=outcountstr,-
X`09`09outlen=outcountstr,-
X`09`09p1=count
X
X`09pushal`09outcountstr
X`09calls`09#1,g`5Elib$put_output`09;output the count string
X
X`09movl`09count,r3`09`09;number of entries found->r3
X`09moval`09tqelst,r2`09`09;addr of list->r2
Xagain:`09pushl`09r2`09`09`09;load arg for format routine
X`09blbc`09tqe$b_rqtype(r2),proc`09;system or process?
X`09calls`09#1,forsystqe`09`09;do it system style
X`09blbc`09r0,die`09`09`09;how'd we do?
X`09brb`09incit`09`09`09;skip process style
Xproc:`09calls`09#1,forprotqe`09`09;call format routine
X`09blbc`09r0,die`09`09`09;everything ok?
Xincit:`09addl`09#tqe$c_length,r2`09;advance pointer one entry's worth
X`09sobgtr`09r3,again`09`09;loop til done
X
Xdie:`09$exit_s`09r0`09`09`09;exit
X`09
X
X`09.psect`09tqepur pic,long,usr,con,rel,gbl,shr,noexe,rd,nowrt,novec
X
X;+
X; here are the FAO format strings for the two types of requests.
X;-
X
Xfaopro:`09.ascid -`09;format string for process based requests
X;`09@Forward Link:  !XL Backward Link: !XL Size !XW Block type !XB !/@-
X`09@Request type !XB Request is !AS, !AS, !AS !/@-
X`09@Process !AD  Username !AD !/@-
X`09@EPID !XL  PID !XL   AST !XL  ASTPRM !XL !/@-
X`09@Due time !%D, Time(quad) !XL !XL !/@-
X`09@!AS!#%T, Delta(quad) !XL !XL !/@-
X`09@RMOD !XB !#AS !AS, EFN !XB Unknown !XW ERQPID !XL RQPID !XL !/@
X
Xndeltstr:
X`09.ascid`09/No delta time/
Xdeltstr:
X`09.ascid`09/Delta time /
X
Xfaosys:.ascid -`09`09;format string for system subroutine requests
X;`09@Forward Link: !XL Backward Link: !XL Size !XW Block type !XB !/@-
X`09@Request Type !XB Request is system subroutine, !AS, !AS !/@-
X`09@PC !XL  FR3 !XL  FR4 !XL !/@-
X`09@Due time !%D, Time(quad) !XL !XL !/@-
X`09@!AS!#%T, Delta(quad) !XL !XL !/@-
X`09@Penultimate longword !XL Ultimate longword !XL !/@
X`09`09
X
X; strings to indicate what type of request we are dealing with
X
Xrel:`09.ascid`09/relative/
Xabs:`09.ascid`09/absolute/
X
Xrep:`09.ascid`09/repeat/
Xone:`09.ascid`09/one-shot/
X
Xproca:`09.ascid`09/process timer/
Xprocb:`09.ascid`09/scheduled wake/
X
Xast:`09.ascid`09/AST/
Xnoast:`09.ascid`09/no AST/
X
X;  table of names for type of AST requested, if any
Xkernel:`09.ascid`09/Kernel/
Xexec:`09.ascid`09/Exec/
Xsuper:`09.ascid`09/Super/
Xuser:`09.ascid`09/User/
X
X;  table of addresses of AST types, for use with indexed addressing
Xmodtab:`09.address`09kernel
X`09.address`09exec
X`09.address`09super
X`09.address`09user
X
X`09.psect`09tqecod pic,long,usr,con,rel,gbl,shr,exe,rd,nowrt,novec
X
X`09.entry`09forprotqe,`5Em<r2,r3,r4,r5,r6,r7,r8>
X
X;+ `20
X; let's build the output string on the stack..it's the modular thing to do
X;-
X`09subl`09#1024,sp`09;a little elbow room for the output string
X`09pushl`09sp`09`09;push the address of the buffer onto the stack
X`09pushl`09#1024`09`09;push the length onto the stack
X`09movl`09sp,r6`09`09;put address of descriptor into r6
X`09movl`094(ap),r7`09;put the address of tqe to be formatted->r7
X
X`09pushl`09tqe$l_rqpid(r7)`09`09;push requesting internal pid
X
X; convert requesting pid to external form, then push it, too`09`09
X
X`09movl`09tqe$l_rqpid(r7),r0`09;internal pid loaded in r0
X`09jsb`09exe$ipid_to_epid`09;call the routine
X`09pushl`09r0`09`09`09;push result for output
X
X`09pushl`09tqe$b_efn+1(r7)`09`09;push the "unknown" word
X`09pushl`09tqe$b_efn(r7)`09`09;push the event flag
X
X`09moval`09ast,r8`09`09`09;assume it wants AST delivery
X`09bbs`09#acb$v_quota,tqe$b_rmod(r7),10$  ;then check
X`09moval`09noast,r8`09`09;yup
X10$:`09pushl`09r8`09`09`09;record the result
X`09bbc`09#acb$v_quota,tqe$b_rmod(r7),11$  ;test again
X
X;  construct an index to get AST type text (if any)  from a table
X`09clrl`09r0`09`09`09;place to work
X;`09bicb3`09#acb$m_quota,tqe$b_rmod(r7),r0`09;clear the 40 in high nibble
X`09BICB3`09#`5EXFC,TQE$B_RMOD(R7),R0`09;Extract the two mode bits for index
X`09movl`09modtab`5Br0`5D,-(sp)`09;load addr of type string
X`09movzwl`09@(sp),-(sp)`09`09;load it's length
X`09brb`0912$`09`09`09;then pass on
X11$:`09pushl`09modtab`09`09`09;push dummy address
X`09pushl`09#0`09`09`09;push 0 length
X`09`09
X12$:`09pushl`09tqe$b_rmod(r7)`09`09;push the rmod byte (used in ACB)
X`09pushl`09tqe$q_delta+4(r7)`09;second delta longword
X`09pushl`09tqe$q_delta(r7)`09`09;first delta longword
X`09pushaq`09tqe$q_delta(r7)`09`09;delta time, as a time
X`09bbc`09#tqe$v_repeat,tqe$b_rqtype(r7),1$  ;is it a repeat request?
X`09pushl`09#11`09`09`09;yes, then it's length is 11
X`09pushal`09deltstr`09`09`09;describe it as time
X`09brb`092$`09`09`09;skip this
X1$:`09clrl`09-(sp)`09`09`09;it's not time, so it's 0 length
X`09pushal`09ndeltstr`09`09;explain that it's not a delta time
X2$:`09pushl`09tqe$q_time+4(r7)`09;second due time longword
X`09pushl`09tqe$q_time(r7)`09`09;first due time longword
X`09pushaq`09tqe$q_time(r7)`09`09;due time, as date/time
X`09pushl`09tqe$l_astprm(r7)`09;ast parameter
X`09pushl`09tqe$l_ast(r7)`09`09;ast address
X`09pushl`09tqe$l_pid(r7)`09`09;target internal PID
X`09movl`09tqe$l_pid(r7),r0`09;convert internal to external
X`09jsb`09exe$ipid_to_epid`09;call the routine
X`09pushl`09r0`09`09`09;push it too
X
X;*****  Added 10/8/86 by Hunter Goatley -- print the process name
X;*****`09      10/13/86`09`09`09   and the username
X`09MOVL`09SP,R0
X`09$GETJPIW_S -`09`09`09; Get the process name
X`09`09ITMLST=JPI_LIST, -`09; ...
X`09`09PIDADR=(R0)`09`09; ...
X`09PUSHAB`09USERNAME`09`09; Push the address of the username
X`09PUSHL`09USERNAME_L`09`09; Push its length
X`09PUSHAB`09PRCNAM`09`09`09; Push the address of the process name
X`09PUSHL`09PRCNAM_L`09`09; Push its length
X;*****
X
X`09moval`09abs,r8`09`09`09;assume it's absolute
X`09bbs`09#tqe$v_absolute,tqe$b_rqtype(r7),3$  ;then check
X`09moval`09rel,r8`09`09`09;no, it wasn't
X3$:`09pushl`09r8`09`09`09;push it
X
X`09moval`09rep,r8`09`09`09;assume it's repeat
X`09bbs`09#tqe$v_repeat,tqe$b_rqtype(r7),4$  ;then check
X`09moval`09one,r8`09`09`09;no, not really
X4$:`09pushl`09r8`09`09`09;push the result
X
X`09moval`09procb,r8`09`09;assume scheduled wake
X`09bbs`09#1,tqe$b_rqtype(r7),5$  ;make sure
X`09moval`09proca,r8`09`09;no, not at all
X5$:`09pushl`09r8`09`09`09;push result
X
X`09pushl`09tqe$b_rqtype(r7)`09;request type byte
X;`09pushl`09tqe$b_type(r7)`09`09;block type byte
X;`09pushl`09tqe$w_size(r7)`09`09;block size byte
X
X;`09pushl`09tqe$l_tqbl(r7)`09`09;backward link
X;`09pushl`09tqe$l_tqfl(r7)`09`09;forward link
X`09
X`09$faol_s`09ctrstr=faopro,-`09`09;format it attractively
X`09`09outlen=(r6),-
X`09`09outbuf=(r6),-
X`09`09prmlst=(sp)
X`09blbc`09r0,6$`09`09`09;better be ok
X
X`09pushl`09r6`09`09`09;push outstr pointer
X`09calls`09#1,g`5Elib$put_output`09;then get to writing
X6$:`09ret`09`09`09`09;get back
X
X`09.entry`09forsystqe,`5Em<r2,r3,r4,r5,r6,r7,r8>
X
X`09subl`09#1024,sp`09;allocate some space
X`09pushl`09sp`09`09;push it's address
X`09pushl`09#1024`09`09;push it's length
X`09movl`09sp,r6`09`09;put descriptors address to r6
X`09movl`094(ap),r7`09;move addr of current tqe to r7
X
X`09pushl`09tqe$l_rqpid(r7)`09`09;push last longword
X`09pushl`09tqe$b_rmod(r7)`09`09;push next to last longword
X`09pushl`09tqe$q_delta+4(r7)`09;push second delta longword
X`09pushl`09tqe$q_delta(r7)`09`09;push first delta longword
X`09pushaq`09tqe$q_delta(r7)`09`09;push delta as time
X`09bbc`09#tqe$v_repeat,tqe$b_rqtype(r7),1$  ;repeat request?
X`09pushl`09#11`09`09`09;yes, then it's length is 11
X`09pushal`09deltstr`09`09`09;describe it as time
X`09brb`092$`09`09`09;skip this
X1$:`09clrl`09-(sp)`09`09`09;it's not time, so it's 0 length
X`09pushal`09ndeltstr`09`09;explain that it's not a delta time
X2$:`09pushl`09tqe$q_time+4(r7)`09;second due time longword
X`09pushl`09tqe$q_time(r7)`09`09;first due time longword
X`09pushaq`09tqe$q_time(r7)`09`09;due time, as time
X
X`09pushl`09tqe$l_astprm(r7)`09;push fork block r4
X`09pushl`09tqe$l_ast(r7)`09`09;push fork block r3
X`09pushl`09tqe$l_pid(r7)`09`09;push fork pc
X`09
X`09moval`09abs,r8`09`09`09;assume it's absolute request
X`09bbs`09#tqe$v_absolute,tqe$b_rqtype(r7),3$  ;test it
X`09moval`09rel,r8`09`09`09;it's not
X3$:`09pushl`09r8`09`09`09;push it, either way
X
X`09moval`09rep,r8`09`09`09;assume it's a repeat request
X`09bbs`09#tqe$v_repeat,tqe$b_rqtype(r7),4$  ;but is it really?
X`09moval`09one,r8`09`09`09;not even close
X4$:`09pushl`09r8`09`09`09;push whatever it is
X
X`09pushl`09tqe$b_rqtype(r7)`09;push request type
X;`09pushl`09tqe$b_type(r7)`09`09;push block type
X;`09pushl`09tqe$w_size(r7)`09`09;push block size
X;`09
X;`09pushl`09tqe$l_tqbl(r7)`09`09;push backward link
X;`09pushl`09tqe$l_tqfl(r7)`09`09;push forward link
X`09
X`09$faol_s`09ctrstr=faosys,-`09`09;format the string
X`09`09outlen=(r6),-
X`09`09outbuf=(r6),-
X`09`09prmlst=(sp)
X
X`09blbc`09r0,5$`09`09`09;how'd it go?
X`09pushl`09r6`09`09`09;push addr of output string
X
X`09calls`09#1,g`5Elib$put_output`09;write it out
X5$:`09ret`09`09`09`09;get on home
X
X`09.psect`09tqecod pic,long,usr,con,rel,gbl,shr,exe,rd,nowrt,novec
X
X`09.entry`09gettqe,`5Em<r2,r3,r4,r5,r6,r7>
X;+
X;  this subroutine executes in kernel mode, and at IPL$_TIMER.
X;  If the thunder don't get you, then the lightning will...
X;-
X`09MOVAL`09PFM_FULL_HANDLER,(FP)`09`09; So we don't CRASH!!!
X.if defined SYI$_SMP_CPUS`09`09`09; *** VMS V5.x code
X`09tstb`09endpri`09`09`09`09; Lock down this section of code
X`09lock`09lockname=timer,-`09`09; Grab the TIMER spinlock and
X`09`09savipl=-(sp)`09`09`09; ... raise IPL
X.iff`09`09`09`09`09`09; *** VMS v4.x code
X`09setipl`09endpri`09`09`09;lock this code, and raise ipl
X.endc`09`09`09`09`09`09; *** End of VMS version check
X`09clrl`09r7`09`09`09;start with zero entries
X`09movl`09exe$gl_tqfl,r6`09`09;listhead to r6
X`09movl`094(ap),r3`09`09;pointer to place to copy entries to r3
X
Xn:`09cmpl`09G`5Eexe$ar_tqenorept,r6`09;reached the end?
X`09beql`09unexec`09`09`09;then get out
X`09movc3`09#tqe$c_length,(r6),(r3)`09;else copy one
X`09movl`09(r6),r6`09`09`09;next link, please
X`09aoblss`09#maxentry,r7,n`09`09;count it, and do it again, if room
X
Xunexec:
X.if defined SYI$_SMP_CPUS`09`09`09; *** VMS V5.x code
X`09unlock`09lockname=timer,-`09`09; Release the TIMER spinlock and
X`09`09newipl=(sp)+,-`09`09`09; ... raise IPL
X`09`09condition=RESTORE`09`09; ...
X.iff`09`09`09`09`09`09; *** VMS v4.x code
X`09setipl`09#0`09`09`09`09; Lower IPL now
X.endc`09`09`09`09`09`09; *** End of VMS version check
X`09movl`09r7,@8(ap)`09`09;return the count to the caller
X`09ret`09`09`09`09;gotta get back to where you belong
X`09`09`09`09`09;ret restores ipl for us
X
Xendpri:`09.long`09ipl$_timer`09`09;ipl to raise to (block timer events)
X`09assume<endpri-gettqe> le 512`09;make sure this code will lock
X
X;
X;  Condition handler to handle kernel mode exceptions
X;
X`09.ENTRY`09PFM_FULL_HANDLER,`5EM<R6>
X`09$EXIT_S`09`09`09`09; Delete this process (instead of
X`09`09`09`09`09; ...  crashing the system!)
X`09.end`09tqe
X
$ CALL UNPACK [.TQE]TQE.MAR;1 1258677003
$ v=f$verify(v)
$ EXIT
