1000 %title "two_timer_demo_xxx" ! %ident "version_101.1" ! <<<---+ declare string constant k_version = "101.1" , ! <<<---+ & k_program = "two_timer_demo" ! !======================================================================= ! title : timer_demo_xxx.bas ! author : Neil Rieck ( http://neilrieck.net/ ) ! created: 2004.01.01 !======================================================================= option type = explicit ! no kid stuff... set no prompt ! ! ! system declarations ! %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$ ! ! home brewed functions ! external long function get_timer_bit_vector(long) ! required for used with SYS$WFLOR ! declare long rc% , ! return code & timer_event_flag% , ! timer event flag & timer_ef_state% , ! timer event flag state & tcp_event_flag% , ! tcp event flag & tcp_ef_state% , ! tcp event flag state & mask% , ! required for sys$wflor & junk% , ! & basic$QuadWord DeltaQuad ! for sys$bintim etc. ! !======================================================================= ! main !======================================================================= main: margin #0, 132 ! width for the log file print k_program +"_"+ k_version ! print string$(len(k_program +"_"+ k_version), asc("=")) ! underline (how will this optimize?) ! ! <<< get some event flags for later >>> ! if tcp_event_flag% = 0 then ! if not yet allocated rc% = lib$get_EF( tcp_event_flag% ) ! get an event flag if ((rc% and 7%) <> 1) then ! print "lib$get_EF-1 rc: ";str$(rc%) ! goto rc_exit ! end if ! end if ! ! if timer_event_flag% = 0 then ! if not yet allocated rc% = lib$get_EF( timer_event_flag% ) ! get another event flag if ((rc% and 7%) <> 1) then ! print "lib$get_EF-2 rc: ";str$(rc%) ! goto rc_exit ! end if ! end if ! ! ! <<< arm a timer to expire 'x' time from now >>> ! print "-i- arming timer-1 (timer) for 10 seconds from now" ! declare string constant k_delay010 = "0 00:00:10" ! set delay time 10 seconds from now rc% = sys$bintim(k_delay010, DeltaQuad ) ! init delta time ('x' time from now) print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) ! rc% = sys$setimr(timer_event_flag%,DeltaQuad by ref,,,) ! now use it to schedule a wake up print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) ! ! ! <<< use a second timer to simulate some sort of TCP timeout > ! print "-i- arming timer-2 (fake tcp) for 20 seconds from now" ! declare string constant k_delay020 = "0 00:00:20" ! set delay time 20 seconds from now rc% = sys$bintim(k_delay020, DeltaQuad ) ! init delta time ('x' time from now) print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) ! rc% = sys$setimr(tcp_event_flag%,DeltaQuad by ref,,,) ! now use it to schedule a wake up print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) ! ! ! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster. ! The first parameter is only used to determine which event flag cluster to test. ! The second parameter (mask) contains bits representing event flags within that cluster ! mask% = get_timer_bit_vector( tcp_event_flag%) ! insert vector 1 into mask mask% = mask% or get_timer_bit_vector(timer_event_flag%) ! insert vector 2 into mask ! ! <<< wait for either the 'TCP event flag' or the 'TIMER event flag' to change state >>> ! print "-i- waiting for event flag "+ str$(tcp_event_flag%) +" or event flag "+ str$(timer_event_flag%) ! rc% = sys$wflor( tcp_event_flag%, mask%) ! wait for a response from one of two flags print "-e- sys$waitfr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) ! ! ! <<< cancel all timer requests (if any) >>> ! print "-i- Calling $CanTim" ! rc% = sys$cantim(,) ! cancel all timer requests print "-e- sys$cantim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) ! ! ! which event flag is set? TCP or TIMER? ! rc% = sys$readEF(tcp_event_flag%, junk%) ! test TCP event flag select rc% ! case SS$_WASCLR ! tcp_ef_state% = 0 ! case SS$_WASSET ! tcp_ef_state% = 1 ! case else ! print "-e- sys$readef-tcp rc: "+ str$(rc%) ! tcp_ef_state% = 0 ! end select ! print "-i- TCP EF State : ";str$(tcp_ef_state%) ! ! rc% = sys$readEF(timer_event_flag%, junk%) ! test TIMER event flag select rc% ! case SS$_WASCLR ! timer_ef_state% = 0 ! case SS$_WASSET ! timer_ef_state% = 1 ! case else ! print "-e- sys$readef-timer rc: "+ str$(rc%) ! timer_ef_state% = 0 ! end select ! print "-i- Timer EF State: ";str$(timer_ef_state%) ! ! ! at this point either the TCP-EF or the TIMER-EF should be set ! if (timer_ef_state% = 1) and ! if the TIMER-EF is set & ( tcp_ef_state% = 0) ! and the TCP-EF is clear then ! then something timed out print "-i-the tcp event timed out (so do something)" ! end if ! ! ! here is an alternate way to test all bits quickly ! junk% = (timer_ef_state% * 2) + tcp_ef_state% ! produce a weighted number select junk% ! case 0 ! print "no event flags (something went wrong)" ! case 1 ! print "tcp event only (timer event cancelled)" ! case 2 ! print "timer event only (tcp timed out)" ! case 3 ! print "both timer + tcp events (this is possible)" ! end select ! !==================================================================================================== ! <<< adios... >>> !==================================================================================================== fini: rc% = 1 ! vms -s- ! ! rc% must be set up b4 this point (and must not be changed) ! rc_exit: 30000 end program rc% ! !####################################################################### ! ! <<< external functions >>> ! !====================================================================== ! get timer bit vector ! (see OpenVMS system systevices documentation for "sys$wflor") ! ! notes: cluster event flags ! 0 00- 31 ! 1 32- 63 ! 2 64- 95 ! 3 96-127 !====================================================================== 31040 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 ! 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 ! 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.