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 ( http://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 OpenVMS
Back to OpenVMS Demo Index
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.