$ $ fort simple $ link simple $ $ fort get_down $ link get_down $ $ $ typ simple.for C********************************************************* C* Program which displays cpu time since process creation C* Author: Bruce Ellis C********************************************************* program simple integer value C Get and display CPU time call show_times() value=1 end C******************************************************** C* Subroutine which displays CPU time C******************************************************** subroutine show_times() include '($syssrvnam)' include '($jpidef)' integer cpu,stat C Get CPU time stat=lib$getjpi(jpi$_cputim,,,cpu) C Blast it out type *,'Subprocess cpu time = ',cpu end $ $ $ $ type get_down.for C********************************************************************** C* Program which illustrates the use of a termination mailbox C* used to detect the deletion of a process which we have created C* Author: Bruce Ellis C********************************************************************** program spawn implicit none include '($syssrvnam)' include '($iodef)' include '($pqldef)' include '($dvidef)' include '($accdef)' C Declare AST function which will handle process termination external death_ast integer stat,len,chan,mbx_unit,death_flag,iosb(2) character term*8,mbx*5 C Storage for the termination accounting message structure /acc/ integer msg_type,status byte junk(78) end structure record /acc/ exit_msg C Process quota list for SYS$CREPRC structure /pql/ byte quota integer value end structure C SYS$GETDVI argument list structure /dvi/ integer*2 size,item integer value integer ret_len end structure record /pql/ list(4) record /dvi/ dvi_list(2) C********************** C Create the mailbox C********************** mbx='ellis' stat=sys$crembx(,chan,,,,,mbx) if (.not.stat) call lib$stop(%val(stat)) dvi_list(1).size=4 dvi_list(1).item=dvi$_unit dvi_list(1).value=%loc(mbx_unit) dvi_list(2).item=0 C********************** C Determine the mailbox's unit number C********************** stat=sys$getdviw(,%val(chan),,dvi_list,,,,) if (.not.stat) call lib$stop(%val(stat)) C********************** C Get the terminal name for the SYS$CREPRC call definition of C********************** call get_term(term,len) term=term(1:len) list(1).quota=pql$_wsdefault list(1).value=2048 list(2).quota=pql$_wsquota list(2).value=2048 list(3).quota=pql$_wsextent list(3).value=2048 list(4).value=pql$_listend death_flag=0 C********************** C Create the process with a termination mailbox associated C********************** stat=sys$creprc(,'simple',term,term,term,,,,%val(4),,%val(mbx_unit),) if (.not.stat) call lib$stop(%val(stat)) stat=sys$qio(%val(33),%val(chan),%val(io$_readvblk),iosb,death_ast,, 1 exit_msg,%val(acc$k_termlen),,,,) if (.not.stat) call lib$stop(%val(stat)) C###################### do work here ########################### if(death_flag.eq.1) then type *,'subprocess terminated reason:',exit_msg.status endif C********************** C Wait for the process to die C********************** call sys$waitfr(%val(33),iosb) if(death_flag.eq.1) then type *,'subprocess terminated reason:',exit_msg.status endif end C************************* C* Subroutine to handle process termination C************************* subroutine death_ast() integer death_flag C************************* C* Identify that the process is dead. C************************* death_flag=1 end C************************* C* Subroutine to get terminal name. C************************* subroutine get_term(t,l) include '($jpidef)' integer l character*8 t C************************* C* Get our terminal name. C************************* call lib$getjpi(jpi$_terminal,,,,t,l) end $ $ $ $ run get_down Subprocess cpu time = 21 $ $ $ $ $ type death_notice.for C*************************************************************** C* Program which illustrates tracking the process deletion of C* a process which we have not created. C* Author: Bruce Ellis C*************************************************************** program death_notice implicit none include '($syssrvnam)' include '($iodef)' include '($dvidef)' include '($accdef)' external death_ast,set_term_mbx integer stat,len,chan,mbx_unit,death_flag,iosb(2),pid integer kernel_args(4) character mbx*5 structure /acc/ integer msg_type,status byte junk(78) end structure record /acc/ exit_msg structure /pql/ byte quota integer value end structure structure /dvi/ integer*2 size,item integer value integer ret_len end structure record /pql/ list(4) record /dvi/ dvi_list(2) C*************************************************************** C* Create the termination mailbox C*************************************************************** mbx='ellis' stat=sys$crembx(,chan,,,,,mbx) if (.not.stat) call lib$stop(%val(stat)) dvi_list(1).size=4 dvi_list(1).item=dvi$_unit dvi_list(1).value=%loc(mbx_unit) dvi_list(2).item=0 C*************************************************************** C* Get the mailbox's unit number C*************************************************************** stat=sys$getdviw(,%val(chan),,dvi_list,,,,) if (.not.stat) call lib$stop(%val(stat)) C*************************************************************** C* Get the target process id C*************************************************************** type *,'Enter the target pid' read(*,100) pid 100 format(Z) death_flag=0 C*************************************************************** C* Blast the termination mailbox unit field of the target C* process' PCB. C*************************************************************** kernel_args(1)=3 !3 arguments kernel_args(2)=%loc(pid) !process id address kernel_args(3)=0 !null argument kernel_args(4)=mbx_unit stat=sys$cmkrnl(set_term_mbx,kernel_args) if (.not.stat) call lib$stop(%val(stat)) C*************************************************************** C* Post a read to the termination mailbox. C*************************************************************** stat=sys$qio(%val(33),%val(chan),%val(io$_readvblk),iosb,death_ast, 1 death_flag,exit_msg,%val(acc$k_termlen),,,,) if (.not.stat) call lib$stop(%val(stat)) C###################### do work here ########################### if(death_flag.eq.1) then type *,'subprocess terminated reason:',exit_msg.status endif C*************************************************************** C* Wait till she/he dies C*************************************************************** call sys$waitfr(%val(33),iosb) if(death_flag.eq.1) then type *,'subprocess terminated reason:',exit_msg.status endif end C*************************************************************** C* Subroutine to handle termination AST C*************************************************************** subroutine death_ast(death_flag) integer death_flag death_flag=1 end $ $ type set_term_mbx.mar ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ; Routine: set_term_mbx ; Author: Bruce Ellis ; Function: sets terminitation mailbox unit number ; to specified value. ; Inputs: 4(ap)->pid, 8(ap)-> prcnam, 12(ap) contains ; mailbox unit number. ; Outputs: R0 contains status, including any from $LKWSET ; or exe$nampid. SS$_WASSET if termination mailbox ; unit was set. ;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .library /sys$library:lib.mlb/ .link /sys$system:sys.stb/ $pcbdef mbx_unit=12 lock_locs: .address lock_start .address lock_end .entry set_term_mbx,^m movw mbx_unit(ap),r6 ;save the termination mbx unit $lkwset_s inadr=lock_locs ;lock down pages accessed ; at high ipl blbc r0,exit lock_start: jsb g^exe$nampid ;convert pid to pcb address blbc r0,exit tstw pcb$w_tmbu(r4) ;was it alreadt set? bneq err_out ; if so scram movw r6,pcb$w_tmbu(r4) ;blast the termination mbx unit unlock lockname=SCHED,newipl=#0 ;release spinlock acquired ; by exe$nampid lock_end: movl #ss$_normal,r0 exit: ret ;scram err_out: unlock lockname=SCHED,newipl=#0 ;release spinlock acquired movl #ss$_wasset,r0 ret .end $ $ $ $ fort death_notice $ $ macro set_term_mbx $ $ $ link death_notice,set_term_mbx $ $ $ run/detach/proc="looper" looper %RUN-S-PROC_ID, identification of created process is 00000075 $ $ show sys VAX/VMS V5.4-2 on node LABDOG 3-JUL-1992 21:24:31.34 Uptime 2 01:17:53 Pid Process Name State Pri I/O CPU Page flts Ph.Mem 00000021 SWAPPER HIB 16 0 0 00:00:01.70 0 0 00000025 CONFIGURE HIB 8 6 0 00:00:00.32 92 154 00000027 ERRFMT HIB 8 1539 0 00:00:23.18 84 132 00000028 OPCOM HIB 7 576 0 00:00:06.66 283 159 00000029 AUDIT_SERVER HIB 10 150 0 00:00:03.56 1346 417 0000002A JOB_CONTROL HIB 10 202 0 00:00:01.55 170 344 0000002B IPCACP HIB 10 13 0 00:00:00.25 69 137 0000002C TP_SERVER HIB 10 11832 0 00:07:50.48 160 251 0000002D NETACP HIB 10 2296 0 00:02:07.41 231 417 0000002E EVL HIB 6 518 0 00:00:22.21 49017 62 N 0000002F REMACP HIB 9 32 0 00:00:00.25 78 59 00000030 SYMBIONT_0001 HIB 4 24 0 00:00:01.02 239 120 00000031 MULTINET_SERVER HIB 6 296 0 00:00:07.03 643 220 00000032 CTM_SERVER HIB 12 21 0 00:00:00.98 190 407 00000073 SERVER_0009 LEF 6 241 0 00:00:04.91 560 299 N 00000074 ELLISB CUR 4 485 0 00:00:26.75 2557 287 00000075 looper COM 4 5 0 00:00:09.21 60 93 $ $ $ $ set proc/priv=all $ $ spawn/nowait run death_notice %DCL-S-SPAWNED, process ELLISB_1 spawned $ Enter the target pid $ 75 $ $ stop/id=75 subprocess terminated reason: 0 $ $ $ show sys VAX/VMS V5.4-2 on node LABDOG 3-JUL-1992 21:25:48.35 Uptime 2 01:19:10 Pid Process Name State Pri I/O CPU Page flts Ph.Mem 00000021 SWAPPER HIB 16 0 0 00:00:01.76 0 0 00000025 CONFIGURE HIB 8 6 0 00:00:00.32 92 154 00000027 ERRFMT HIB 8 1539 0 00:00:23.18 84 132 00000028 OPCOM HIB 7 576 0 00:00:06.66 283 159 00000029 AUDIT_SERVER HIB 10 150 0 00:00:03.56 1346 417 0000002A JOB_CONTROL HIB 9 205 0 00:00:01.55 170 344 0000002B IPCACP HIB 10 13 0 00:00:00.25 69 137 0000002C TP_SERVER HIB 9 11837 0 00:07:50.68 160 251 0000002D NETACP HIB 10 2296 0 00:02:07.41 231 417 0000002E EVL HIB 6 518 0 00:00:22.21 49017 62 N 0000002F REMACP HIB 9 32 0 00:00:00.25 78 59 00000030 SYMBIONT_0001 HIB 4 24 0 00:00:01.02 239 120 00000031 MULTINET_SERVER HIB 6 296 0 00:00:07.03 643 220 00000032 CTM_SERVER HIB 12 21 0 00:00:00.98 190 407 00000073 SERVER_0009 LEF 6 241 0 00:00:04.91 560 299 N 00000074 ELLISB CUR 4 583 0 00:00:27.78 2667 337 $