From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 24-AUG-1989 12:03
To:	MRGATE::"ARISIA::EVERHART"
Subj:	re: IFBRK for VAX FORTRAN

Message-Id:  <8908241553.AA05228@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 24 AUG 89 07:50:14 PDT
Received: from fccc.edu (turing.rm.fccc.edu) by KL.SRI.COM with TCP; Thu, 24 Aug 89 07:38:51 PDT
Date: Thu, 24 Aug 89 10:37 EDT
From: Frank Manion <MANION@fccc.edu>
Subject: re: IFBRK for VAX FORTRAN
To: INFO-VAX@KL.SRI.COM, elkins@chvax.sncc.lsu.EDU
X-Vms-To: IN-INFO-VAX,IN%"elkins@chvax.sncc.lsu.edu"

Brian Elkins writes:

>I am working with an analysis program in VAX FORTRAN under VMS 5.1-1.  When an
>analysis is running, often it becomes obvious to the user (but not necessarily
>to the computer) that the optimum results have already been obtained, but it
>is still necessary to wait for the computer to decide for itself that the
>analysis is complete.  This sometimes doubles or triples the computer time
>necessary for the analysis.
>
>My question is this:  Is there any way in VAX FORTRAN to divert program flow
>upon some condition, e.g. when CTRL-Y is pressed?  I'm looking to something
>similar to the HP function IFBRK or the DCL command ON CONTROL_Y THEN ___.

The following should do what he wants. Instructions for use are in the
comments. To enable the routine, call it with:

	status = enable_control_c_asts('sys$command')

		or

	status = enable_control_c_asts('tt')


-- Frank

c****************************************************************************
c Control_c.for -- FJM -- 11/14/85
c****************************************************************************
c
c Modified History:
c
c	11/11/88 -- FJM -- Insure that multiple calls to enable_control_C_asts,
c			   with or without intervening call to
c			   disable_control_C_asts, leave routine
c			   Control_c_was_seen in the .FALSE. state.
c
c****************************************************************************
c
c These routines allow a user to enable a device to respond to control-c
c asts. To do this the user calls:
c
c		status = enable_control_c_asts(device)
c
c where "device" is the device the control_c interrupt dectection is to be
c enabled for. If the device string is blank, or the device is not a terminal
c device (ie. a CRT, Hardcopy terminal, etc.) then the routine assumes that
c the call was made in batch or detached mode, and does not establish an
c ast handler. In this case the status returned is SS$_NORMAL. In all other
c cases, control_c ast's are enabled, and the status returned is that of
c the system calls to establish the ast.
c
c To detect the presence of a typed Control_c, the user calls the function
c
c	control_c_was_seen()
c
c This function returns .true. if a control_c was typed since the last time
c control_c_was_seen was called.
c
c Example:
c
c		if( control_c_was_seen() ) then
c				.
c				.
c				.
c		  	     end if
c
c Calling Enable_Control_c_Asts also has the effect of clearing the
c Control_c_Was_Seen Flag. Thus a control_c_Was_Seen call is guaranteed to
c return .TRUE. only if the control_c occurs between after the last time
c the Enable_Control_c_Asts routine is called. Note that in general, through,
c the intent is to call the Enable_Control_c_Ast routine only once, at the
c beginning of the program.
c
c To stop the effect of the control_c interrupt, and remove the ast handler,
c the user may call the routine:
c
c		status = disable_control_c_asts()
c
c Note that these routines are non-deterministic in that if more than one
c control_c is typed before "control_c_was_seen" is called, the "extra"
c control_c's are thrown out, not queued for delivery. Also note that the
c routines only support one device at a time, thus the routine
c "enable_control_c_asts" may only be called once within a program
c (unless the user calls disable_control_c_asts). If called more than
c once without calling disable_control_c_asts, no action is taken,
c other then the above mentioned clearing of the control_c_was_Seen flag,
c and the status code of ss$_normal is returned (as control_c ast's are
c still enabled).
c
c****************************************************************************

	integer*4 function  Enable_control_c_asts(device)
c
	implicit	none

	character*(*)	device
	integer*4	i, length, status, devtype
	integer*4	channel		/0/
	integer*4 	sys$qiow, sys$assign, sys$dassgn
	integer*4 	lib$getdvi
	integer*4 	reenable_control_c_ast
	integer*4 	disable_control_c_asts
	integer*4 	control_c_was_seen

	external	dc$_term
	external	ss$_normal, ss$_abort
	external	dvi$_devclass
	external	io$_setmode
	external	io$m_ctrlcast
	external	control_c_ast_handler

	save		channel

c Insure the routine Control_c_Was_Seen is in a known state (.false.)
c by eating any value it currently has.

	status = Control_c_Was_Seen()

c If we have already established a control_c handler, channel will be
c non-zero, so do nothing more than return.

	enable_control_c_asts = %loc(ss$_normal)
	if( channel .ne. 0) then
	  return
	  end if

c return with no action if the device string is blank, or if the
c device is not a terminal. This allows programs to run okay from
c batch mode and detached mode.

	do i = len(device),1,-1
	  if(device(i:i).gt.' ')go to 10
	  end do
	return
10	length = i

	status = lib$getdvi(%loc(dvi$_devclass),,device(1:length),devtype)
	if( .not. status ) then
	  enable_control_c_asts = status
	  return
	  end if

	if( devtype .ne. %loc(dc$_term)) return

c if we got here, we have a terminal device. Assign the channel

	status = sys$assign(device(1:length),channel,,)
	if (.not.status) then
	  enable_control_c_asts = status
	  return
	  end if

c and establish the interrupt handler.

	status = sys$qiow(%val(0),%val(channel),
	1	  %val(%loc(io$_setmode) .or. %loc(io$m_ctrlcast)),
	2	  ,,,control_c_ast_handler,,,,,)
	enable_control_c_asts = status
	return

c This is the entry point for removing the control_c asts

	entry	disable_control_c_asts

	disable_control_c_asts = sys$dassgn(%val(channel))
	channel = 0

c     call the detection routine. This insures that control_c_was_seen
c     is left in the .false. state, if the user calls it again after this.

	status = control_c_was_seen()
	return

c this is the entry point which re_enables the control_c asts
c when it is read out. It is needed here since FORTRAN requires that
c no external reference can be made to "control_c_ast_handler"
c from within that subroutine. (ie. the compiler thinks it is detecting
c recursion). Thus we trick it by indirection. (It also saves having
c to pass "channel" around anyway.

	entry reenable_control_c_ast
	status = sys$qiow(%val(0),%val(channel),
	1	  %val(%loc(io$_setmode) .or. %loc(io$m_ctrlcast)),
	2	  ,,,control_c_ast_handler,,,,,)
	if( .not. status) call lib$signal(%val(status))
	reenable_control_c_ast = status
	return

	end

c function control_c_was_seen()
c
c This function is called by the user to test if a control_c asts
c has occured since the last call to control_c_was_seen. The routine
c returns .true. or .false. as appropriate, and then re-enables the control-y
c asts.

	logical*4 function control_c_was_seen

	logical*4	was_seen	/.false./
	volatile	was_seen
	save		was_seen

	control_c_was_seen = was_seen
	if( was_seen ) then
	  was_seen = .false.
	  end if
	return

c This entry point is the control_c asts handler

	entry control_c_ast_handler

	call reenable_control_c_ast
	was_seen = .true.
	return
	end

:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:
Reply to:

  MANION@FCCC.EDU                       Frank J. Manion
        or:                             Sr. System Programmer
  MANION@CURIE.RM.FCCC.EDU              The Fox Chase Cancer Center
                                        7701 Burholme Avenue
  Phone: (215) 728-3660                 Philadelphia, PA  19111
                                        USA
:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:

