OpenVMS Source Code Demos
basic_timed_spawn
1000 %title "basic-timed-spawn_xxx.bas" !
%ident "version 100.2" ! <<<---+---
declare string constant k_version = "100.2" , ! <<<---+ &
k_program = "basic-timed-spawn" !
!=======================================================================
! title : basic-timed-spawn.bas
! author : Neil Rieck ( https://neilrieck.net/ )
! created: 2017-09-11
! purpose: We have batch jobs which spawn thousands of times a day. However, every ~200 days a
! spawned job will hang. This demo will show how to detect and correct that situation
! ver who when what
! --- --- -------- -----------------------------------------------------
! 100 NSR 20170911 1. original effort
! NSR 20170912 2. added code to delete a hung process
!=======================================================================
option type=explicit !
set no prompt !
declare string constant k_script = "basic-timed-spawn-junk.com", &
k_output = "basic-timed-spawn-junk.out", &
k_lines = "---------------------------------" !
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "$clidef" %from %library "sys$library:basic$starlet" ! cli$
!
external long function get_timer_bit_vector(long) ! required for used with SYS$WFLOR
!
declare long ef_timer ,&
long ef_spawn ,&
byte ef_byte ,&
long ef_timer_state ,&
long ef_spawn_state ,&
long spawn_flags ,&
long rc1 ,&
long rc2 ,&
long pid ,&
long mask ,&
long junk ,&
long time0, time1 ,&
long test ,&
basic$quadword DeltaQuad1 !
declare string delay$ ,&
string cmd$ ,&
string junk$ !
!=======================================================================
! main
!=======================================================================
2000 main:
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) !
!
input "-?-create a command file? (y/N) ";junk$ !
if edit$(junk$,32)="Y" then
print "-i-creating DCL script for test purposes"
when error in
open k_script for output as #99 &
,organization sequential &
,recordsize 99
print #99, '$! title: '; k_script
print #99, '$ say :== write sys$output'
print #99, '$ say "-i-start-script:", f$environment("procedure")'
print #99, '$ say "-i-starting 4 second delay at: ",f$cvtime()'
print #99, '$ say "-i-note: if you do not see an exit message,"'
print #99, '$ say " then the spawned process was killed before exit"'
print #99, '$ wait 0:0:04'
print #99, '$ say "-i-exiting at: ", f$cvtime()'
close #99
use
print #99, "-i-error:";err;"during script creation"
end when
else !
print "-i-did not create a DCL test script" !
end if !
print k_lines !
!
! demo-01
!
print "-i-will arm the timer for 6-seconds" !
delay$ = "0 00:00:06.0" ! ddd hh:mm:ss.t
test = 1 !
gosub demo !
print k_lines !
!
! demo-02
!
print "-i-will arm the timer for 2-seconds"
delay$ = "0 00:00:02.0" ! ddd hh:mm:ss.t
test = test + 1 !
gosub demo !
print k_lines !
!
! demo-03
!
print "-i-will arm the timer for 2-seconds"
delay$ = "0 00:00:02.0" ! ddd hh:mm:ss.t
test = test + 1 !
gosub demo !
print k_lines !
!
goto fini !
!=======================================================================
! attempt to place a time limit on spawn
! entry: delay$ = string holding desired delta time
!=======================================================================
3000 demo:
time0 = TIME(0) !
!
! we need two event flags for this demo
!
rc1 = lib$get_EF(ef_timer by ref) !
if rc1 <> ss$_normal then !
print "-e-oops, couldn't allocate a TIMER event flag" !
goto fini !
end if !
!
rc1 = lib$get_EF(ef_spawn by ref) !
if rc1 <> ss$_normal then !
print "-e-oops, couldn't allocate a SPAWN event flag" !
goto fini !
end if !
!
! this mask is used by sys$wflor (wait for logical or)
!
mask = 0 ! init
mask = get_timer_bit_vector(ef_spawn) ! insert vector 1 into mask
mask = mask or get_timer_bit_vector(ef_timer) ! insert vector 2 into mask
!
print "-i-ef_timer :";ef_timer ! debug for hack
print "-i-ef_spawn :";ef_spawn !
print "-i-mask bits:";mask !
!
! set a time delay
!
rc1 = sys$bintim(delay$, DeltaQuad1 ) ! convert delay to 64-bit binary
print "-e-sys$bintim rc1: "+ str$(rc1) if ((rc1 and 1%) <> 1%) !
!
! set a timer
!
rc1 = sys$setimr(ef_timer,DeltaQuad1 by ref,,,) ! now use it to schedule a wake up
print "-e-sys$setimr rc1: "+ str$(rc1) if ((rc1 and 1%) <> 1%) !
!
! LIB$SPAWN [command-string] [,input-file] [,output-file] [,flags]
! [,process-name] [,process-id] [,completion-status-address]
! [,byte-integer-event-flag-num] [,AST-address] [,varying-AST-argument]
! [,prompt-string] [,cli] [,table]
!
%let %hack=0 !
%if %hack=1 %then !
rc1 = sys$clref(ef_spawn) ! incase we want to preclear the EF
print "-e-sys$clref-rc1: "+ str$(rc1) if ((rc1 and 1%) <> 1%) !
%end %if !
!
ef_byte = ef_spawn ! convert long to byte for lib$spawn
rc2 = 0 ! init secondary rc
spawn_flags = cli$m_nowait ! init to an asychronous spawn
select test !
case 1 to 2 !
cmd$ = "@"+ k_script !
case else
cmd$ = "@"+ k_script +"-this-will-fail"
end select
print "-i-cmd: ";cmd$
print "-i-calling spawn (running a job containing a 4-second delay)" !
!
! note: parameter 7 (address by value) looks strange but agrees with documentation
! parameter 8 (byte by ref) looks strange but agrees with documentation
!
rc1 = lib$spawn(cmd$ by desc , ! [command-string] &
, ! [,input-file] &
k_output by desc , ! [,output-file] &
spawn_flags by ref , ! [,flags] &
, ! [,process-name] &
pid by ref , ! [,process-id] &
loc(rc2) by value, ! [,completion-status-address] &
ef_byte by ref, ! [,byte-integer-event-flag-num] &
,,,,,) ! remainder
print "-e-lib$spawn rc1: "+ str$(rc1) if ((rc1 and 1%) <> 1%) !
!
if ((spawn_flags and cli$m_nowait) = cli$m_nowait) then ! if asychronous
print "-i-pid:";pid ! then let's see the pid
else ! else synchronous
print "-i-rc1:";rc1 ! then let's see the final rc
!~~~ print "-i-rc2:";rc2 x not valid
end if !
!
! wait for one of the event flags to change state
! note: 'mask' is what we are testing but 'ef_timer' is used to indicate the correct cluster
!
rc1 = sys$wflor(ef_timer, mask ) ! wait for a response from either flag in mask
print "-e-sys$waitfr rc1: "+ str$(rc1) if ((rc1 and 1%) <> 1%) !
time1 = TIME(0) !
print "-i-measured sleep:";time1-time0;"seconds" !
!
! which event flag got us here? TIMER or SPAWN?
! note: 'ef_timer' is what we are testing (value goes into rc);
! 'junk' will receive all 32-bits of the associated ef cluster
!
rc1 = sys$readef(ef_timer, junk) ! test ef_timer
print "-i-view all flags:";junk ! see 32-bits just for this demo
select rc1 !
case SS$_WASCLR !
ef_timer_state = 0 !
case SS$_WASSET !
ef_timer_state = 1 ! timer expired (oops)
case else !
print "-e-sys$readef-rc:";rc1 !
ef_timer_state = 0 !
end select !
!
rc1 = sys$readef(ef_spawn, junk) ! test ef_spawn
select rc1 !
case SS$_WASCLR !
ef_spawn_state = 0 !
case SS$_WASSET !
ef_spawn_state = 1 ! spawn finished (good)
case else !
print "-e-sys$readef-rc:";rc1 !
ef_spawn_state = 0 !
end select !
print "-i-ef-states: ef_spawn_state=";str$(ef_spawn_state);" ef_timer_state=";str$(ef_timer_state)
!
if ef_spawn_state = 0 then ! spawn didn't finish so...
print "-i-stopping hung process:";pid !
junk = sys$delprc(pid,) !
print "-e-sys$cantim-rc: "+ str$(junk) if ((junk and 1%) <> 1%) !
else !
if ((spawn_flags and cli$m_nowait) = cli$m_nowait) then ! if asychronous
print "-i-rc2:";rc2 ! then let's see the rc
end if !
end if
!
! cancel timer requests (if any)
!
junk = sys$cantim(,) ! cancel all timer requests (probably not req'd)
print "-e-sys$cantim-rc: "+ str$(junk) if ((junk and 1%) <> 1%) !
!
! cleanup (optional)
!
junk = lib$free_EF(ef_timer by ref) !
print "-e-lib$free(1)-rc: "+ str$(junk) if ((junk and 1%) <> 1%) !
junk = lib$free_EF(ef_spawn by ref) !
print "-e-lib$free(2)-rc: "+ str$(junk) if ((junk and 1%) <> 1%) !
!
return
!=======================================================================
! that's all folks
!=======================================================================
32000 fini: !
print "-i-program exit"
end !
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
! external functions and subs
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
!=======================================================================
! get timer bit vector
! (see OpenVMS system services documentation for "sys$wflor")
!
! notes: cluster event flags notes
! 0 00- 31 local flags
! 1 32- 63
! 2 64- 95 common flags
! 3 96-127
!========================================================================
32010 function long get_timer_bit_vector(long event_flag) !
option type = explicit !
declare long temp !
!
select event_flag !
case <= 31 !
temp = event_flag !
case <= 63 !
temp = event_flag - 32 !
case <= 95 !
temp = event_flag - 64 !
case else !
temp = event_flag - 96 !
end select !
!
! remember that BASIC has no unsigned integers
!
select temp ! this code will avoid an integer overflow
case 31 ! need to set bit #31
! 33222222222211111111110000000000
! 10987654321098765432109876543210
get_timer_bit_vector = B"10000000000000000000000000000000"L ! so return this
case else ! 0->30
get_timer_bit_vector = (2% ^ temp) ! else return this
end select !
!
end function ! get_timer_bit_vector
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.