$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 12-JUN-1992 18:00:15.36   By user UDAA055 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! 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. [.STATE]GET_STATE_ADDRESS.MAR;1
$!       2. [.STATE]STATE.FOR;1
$!       3. [.STATE]STATE.README;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`09GET_STATE_ADDRESS routine`09`09; title
X`09.ident`09"V1.00"`09`09`09`09`09; version information
X;+
X;`09GET_STATE_ADDRESS.MAR - given an extended process identification
X;`09`09`09`09longword, this routine returns the address of
X;`09`09`09`09the state word in the process control block.
X;
X;`0921 February 1992`09James Wilkinson
X;-
X`09.link`09 "SYS$SYSTEM:SYS.STB" /selective_search
X`09.library "SYS$LIBRARY:LIB.MLB"
X
X`09$pcbdef`09`09`09`09`09`09; process control block
X`09$ssdef`09`09`09`09`09`09; system services def
X
X`09.psect`09$LOCAL`09pic,noshr,rd,wrt,noexe,byte`09; local data
X
Xargs:`09.long`091`09`09`09`09`09; one argument
Xvar:`09.blkl`091`09`09`09`09`09; epid -> pcb+state
X
X`09.psect`09$CODE`09pic,shr,rd,nowrt,exe`09`09; code follows
X
X`09.entry`09GET_STATE_ADDRESS, `5Em<>`09`09`09; entry point
X
X`09movl`09@4(ap), var
X`09$CMEXEC_S`09routin=10$, -`09`09`09; executive mode code
X`09`09`09arglst=args`09`09`09; with epid input
X`09addl3`09var,#PCB$W_STATE,@4(ap)`09`09`09; return pcb+state
X`09ret
X
X10$:`09.word`09`5Em<>
X`09movl`094(ap), r0`09`09`09`09; EPID in r0
X`09jsb`09g`5EEXE$EPID_TO_PCB`09`09`09; convert to PCB addr
X`09bneq`0920$`09`09`09`09`09; we are happening
X`09movzwl`09#SS$_NONEXPR, r0`09`09`09; no such luck
X`09brb`0930$`09`09`09`09`09; get out
X20$:`09movl`09r0, 4(ap)`09`09`09`09; save address
X`09movzwl`09#SS$_NORMAL, r0`09`09`09`09; it worked out
X30$:`09ret`09`09`09`09`09`09; back to user mode
X
X`09.end`09`09`09`09`09`09; end GET_STATE_ADDRESS
$ CALL UNPACK [.STATE]GET_STATE_ADDRESS.MAR;1 1296911050
$ create 'f'
X****************************************************************************
V****
X*                                                                        `20
V     *
X*  STATE - program to list state changes using WPDRIVER.  To setup your syst
Vem *
X*`09   for this program, you need to install WPDRIVER:                     *
X*              $ MCR SYSGEN
V                                                    *
X*`09       SYSGEN> CONNECT WPA /NOADAPTER /DRIVER=WPDRIVER                 *
X*`09   Determine the pid of the process you wish to watch, then run this   *
X*`09   program.  A watchpoint is set on the appropriate word for the       *
X*`09   process, and changes of state are listed, as well as the time of    *
X*`09   the change, until you hit a Crtl-Y.  Note that these states don't   *
X*`09   always seem to be in order - changes which are very close together  *
X*`09   time-wise may be out of order.  Note that SYS$SYSTEM:WP.EXE will    *
X*          also list aspects relating to a watchpoint - this program is
V        *
X*          intended to provide an example of such functionality from within
V    *
X*          one's own code.
V                                                     *
X*                                                                        `20
V     *
X*                              *** CAUTION ***
V                                 *
X*          This program relies on an unsupported driver, which may affect yo
Vur *
X*`09   system in some adverse way when used by this program.  Use at your  *
X*`09   own risk.                                                           *
X*                                                                        `20
V     *
X*          21 February 1992  James Wilkinson (jwilkinson@hmcvax.claremont.ed
Vu) *
X*                                                                        `20
V     *
X*          Reference: Hunter Goatley, VAX Professional, Dec '90, p. 25
V         *
X*                                                                        `20
V     *
X****************************************************************************
V****
X
X`09program state
X
X`09implicit none
X
X`09include '($SYSSRVNAM)/nolist'`09`09`09! system service names
X`09include '($IODEF)/nolist'`09`09`09! I/O definitions
X
X`09structure /control_block/`09`09`09! watchpoint control
X`09`09`09`09`09`09`09! block
X`09  integer*4
X`091`09WPCB$Q_INITCNTNTS(2)
X`09  integer*2
X`091`09WPCB$W_SIZE
X`09  byte
X`091`09WPCB$B_TYPE,
X`091`09WPCB$B_RESERVED01,
X`091`09WPCB$B_FLD_LEN,
X`091`09WPCB$B_STATE
X`09  integer*2
X`091`09WPCB$W_RESERVED02
X`09  integer*4
X`091`09WPCB$L_LINK,
X`091`09WPCB$L_WPRE,
X`091`09WPCB$L_FLD_ADR,
X`091`09WPCB$L_FLD_ADR1,
X`091`09WPCB$L_FLD_ADR2,
X`091`09WPCB$L_FLD_ADR3,
X`091`09WPCB$L_FLD_ADR4,
X`091`09WPCB$L_FLD_ADR5,
X`091`09WPCB$L_FLD_ADR6,
X`091`09WPCB$L_FLD_ADR7,
X`091`09WPCB$L_TOUCHED,
X`091`09WPCB$L_COUNT,
X`091`09WPCB$L_TTE,
X`091`09WPCB$L_PC,
X`091`09WPCB$L_PSL,
X`091`09WPCB$Q_TIME(2),
X`091`09WPCB$L_R0,
X`091`09WPCB$L_R1,
X`091`09WPCB$L_R2,
X`091`09WPCB$L_R3,
X`091`09WPCB$L_R4,
X`091`09WPCB$L_R5,
X`091`09WPCB$L_R6,
X`091`09WPCB$L_R7,
X`091`09WPCB$L_R8,
X`091`09WPCB$L_R9,
X`091`09WPCB$L_R10,
X`091`09WPCB$L_R11,
X`091`09WPCB$L_AP,
X`091`09WPCB$L_FP,
X`091`09WPCB$L_SP
X`09  byte
X`091`09WPCB$B_BCNT
X`09  character*15
X`091`09WPCB$T_ISTREAM
X`09  integer*4
X`091`09WPCB$Q_PREVCNTNTS(2),
X`091`09WPCB$Q_POSTCNTNTS(2)
X
X`09end structure
X
X`09structure /tte_block/`09`09`09`09! watchpoint TTE block
X
X`09  integer*4
X`091`09WPTTE$L_FIELD
X`09  byte
X`091`09WPTTE$B_TOUCHED,
X`091`09WPTTE$B_OPCODE
X`09  integer*2
X`091`09WPTTE$W_RELBCKPTR
X`09  integer*4
X`091`09WPTTE$L_PC,
X`091`09WPTTE$L_PSL,
X`091`09WPTTE$Q_TIME(2)
X`09  union
X`09    map
X`09      integer*4
X`091`09WPTTE$Q_PREVCNTNTS(2)
X`09    end map
X`09    map
X`09      integer*2
X`091`09state
X`09    end map
X`09  end union
X
X`09end structure
X
X`09structure /statistics_block/`09`09`09! watchpoint stat block
X
X`09  integer*4
X`091`09WPSTAT$L_BCNT,
X`091`09WPSTAT$L_TOTAL_TTE,
X`091`09WPSTAT$L_TTE_COPIED
X`09  record /control_block/
X`091`09cb
X`09  record /tte_block/
X`091`09tte(1000)`09`09`09`09! allow for 1K TTEs
X
X`09end structure
X
X`09structure /handle/`09`09`09`09! exit handler block
X`09  integer*4
X`091`09forward_link,
X`091`09exit_handler,
X`091`09argument_count,
X`091`09condition_value,
X`091`09p1,
X`091`09p2
X`09end structure
X
X`09real*4
X`091`09wait_interval
X`09parameter
X`091`09(wait_interval = 3.)`09`09`09! scan interval (secs)
X
X`09character*(*)
X`091`09control_string
X`09parameter
X`091`09(control_string = '!5AS !%D')`09`09! output format
X
X`09character*80
X`091`09message`09`09`09`09`09! output message
X
X`09integer*2
X`091`09io_status_block(4)`09`09`09! I/O status block
X
X`09integer*4
X`091`09io_status,`09`09`09`09! FORTRAN I/O status
X`091`09state_address,`09`09`09`09! address of state word
X`091`09channel,`09`09`09`09! I/O channel
X`091`09statistics_size,`09`09`09! size of stat block
X`091`09tte_listed,`09`09`09`09! # of entries listed
X`091`09tte_delta,`09`09`09`09! # of TTE no yet listed
X`091`09tte_index,`09`09`09`09! index into TTE array
X`091`09message_length,`09`09`09`09! output length
X`091`09status,`09`09`09`09`09! completion status
X`091`09get_state_address`09`09`09! obtain pcb+state addr
X
X`09record /handle/
X`091`09exit_block`09`09`09`09! exit handler block
X
X`09record /statistics_block/
X`091`09statistics`09`09`09`09! WP information
X
X`09character*5
X`091`09process_state(0:15)`09`09`09! ascii state reps
X`091`09/'?????','COLPG','MWAIT','  CEF','  PFW','  LEF',' LEFO',
X`091`09 '  HIB',' HIBO',' SUSP','SUSPO','  FPG','  COM',' COMO',
X`091`09 '  CUR','?????'/
X
X`09external
X`091`09exit_handler
X
X`09! begin code
X`09!
X`09io_status = 1
X
X`09do while (io_status .ne. 0)`09`09`09! get process id
X`09  write (6, '(x,''Pid: '',$)')
X`09  read (5, '(z8.8)', iostat=io_status)
X`091`09state_address`09`09`09`09! will become address
X`09end do
X
X`09status = get_state_address (state_address)`09! convert pid to addr
X`09call check (status)
X
X`09status = SYS$ASSIGN (`09`09`09`09! contact WPDRIVER
X`091`09`09'WPA0:',
X`091`09`09channel,,,
X`091`09`09)
X`09call check (status)
X
X`09status = SYS$QIOW (,`09`09`09`09! initiate a watchpoint
X`091`09`09%val(channel),
X`091`09`09%val(IO$_ACCESS),
X`091`09`09io_status_block,,,,
X`091`09`09%val(2),`09`09`09! watch two bytes
X`091`09`09%val(state_address),,,`09`09! at this address
X`091`09`09)
X`09if (status) status = zext(io_status_block(1))
X`09call check (status)
X
X`09! prepare information for exit handler
X`09!
X`09exit_block.exit_handler = %loc(exit_handler)
X`09exit_block.argument_count = 3
X`09exit_block.condition_value = %loc(status)
X`09exit_block.p1 = %loc(channel)
X`09exit_block.p2 = %loc(state_address)
X
X`09status = SYS$DCLEXH (`09`09`09`09! declare exit handler
X`091`09`09exit_block
X`091`09`09)
X`09call check (status)
X
X`09statistics_size = sizeof(statistics)`09`09! info we can handle
X
X`09do while (.true.)`09`09`09`09! loop forever
X
X`09  status = SYS$QIOW (,`09`09`09`09! get statistics
X`091`09`09%val(channel),
X`091`09`09%val(IO$_RDSTATS),
X`091`09`09io_status_block,,,
X`091`09`09statistics,`09`09`09! buffer address
X`091`09`09%val(statistics_size),`09`09! size of buffer
X`091`09`09%val(state_address),,,`09`09! watchpoint address
X`091`09`09)
X`09  if (status) status = zext(io_status_block(1))
X`09  call check (status)
X
X`09  ! check for any now TTEs
X`09  !
X`09  tte_delta = statistics.WPSTAT$L_TOTAL_TTE - tte_listed
X
X`09  if (tte_delta .gt. 0) then
X
X`09    ! scan new entries in inverse order to print out latest last
X`09    !
X`09    do tte_index=tte_delta,1,-1
X
X`09      status = SYS$FAO (`09`09`09! format the output
X`091`09`09control_string,`09`09`09! format control string
X`091`09`09message_length,`09`09`09! size of output
X`091`09`09message,`09`09`09! output buffer
X`091`09`09process_state(statistics.tte(tte_index).state),! state
X`091`09`09statistics.tte(tte_index).WPTTE$Q_TIME ! time of change
X`091`09`09)
X`09      call check (status)
X
X`09      type *, message(:message_length)`09`09! emit message
X
X`09    end do
X
X`09    tte_listed = statistics.WPSTAT$L_TOTAL_TTE`09! update TTE pointer
X
X`09  end if
X
X`09  call LIB$WAIT (wait_interval)`09`09`09! wait a spell
X
X`09end do
X
X`09end
X
X****************************************************************************
V****
X
X`09subroutine exit_handler (status, channel, state_address) ! clean up
X
X`09implicit none
X
X`09include '($IODEF)/nolist'`09`09`09! I/O definitions
X
X`09integer*4
X`091`09status,`09`09`09`09`09! final status
X`091`09channel,`09`09`09`09! channel to WPA0:
X`091`09state_address`09`09`09`09! watchpoint address
X
X `09call SYS$QIOW (,`09`09`09`09! cancel watchpoint
X`091`09`09%val(channel),
X`091`09`09%val(IO$_DEACCESS),,,,,,
X`091`09`09%val(state_address),,,`09`09! watchpoint address
X`091`09`09)
X
X`09call SYS$DASSGN (`09`09`09`09! deassign channel
X`091`09`09%val(channel)
X`091`09`09)
X
X`09end
X
X****************************************************************************
V****
X
X`09subroutine check (status)`09`09`09! check status longword
X
X`09implicit none
X
X`09integer*4
X`091`09status
X
X`09if (.not. status) call LIB$STOP (%val(status))`09! whine and die if bad
X
X`09return
X`09end
$ CALL UNPACK [.STATE]STATE.FOR;1 643116076
$ create 'f'
XFrom:`09CBS%UK.AC.ULCC.NCDLAB::EDU.BERKELEY.UCBVAX::VAN-BC!RSOFT!AGATE!SPOOL
V.MU.EDU!SDD.HP.COM!ELROY.JPL.NASA.GOV!NEWS.CLAREMONT.EDU!LUCY.CLAREMONT.EDU!
VJWILKINSON  2-MAR-1992 02:47:43.36
XTo:`09A.Harper
XCC:`09
XSubj:`09Re: Process State Detection as an Event
X
XVia: UK.AC.ULCC.NCDLAB; Mon, 2 Mar 92   2:47 GMT
XDate:`09`09Mon,  2 MAR 92 02:47:56 GMT
XFrom:`09`09INFOVAX@UK.AC.ULCC.NCDLAB
XTo:`09`09A.Harper@UK.AC.KCL.CC.OAK
XDate-Sent: 22 Feb 92 09:15:27 GMT
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-