carl@CITHEX.CALTECH.EDU (09/14/87)
I'm forwarding this question for mekenkam@hlerul5.BITnet who is apparently
having trouble getting mail to INFO-VAX@KL.SRI.COM.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
I am having a problem with FORTRAN and asynchronous interrupt.
I enable control-c trapping, and when a ctrl-C occurs, the AST-routine
signals (by means of LIB$STOP or LIB$SIGNAL) the condition SS$_CONTROLC
This condition is trapped by a condition-handler which looks if
(LIB$MATCH_COND(SA(2),SS$_CONTROLC) .EQ. 1)
and then does as $UNWIND(MA(3),), so there is a stack-unwind
to the establisher of the conditionhandler.
So far evrything works fine, save one thing.
When a control-C occurs during an outstanding PRINT *,'kjgsafhsfhskahfsd'
as i can make occur by pressing control-s so text is half written,
and then control-c, I get no further text written to the
terminal by next calls to PRINT *,'sdajykgsdqkjfdgfhj'
No error occurs, and the program continues,
but no output is generated to the terminal anymore.
Do you know what is the problem, and how I can overcome it?
I send you a small program for demonstration.
/Carlo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
PROGRAM TEST
EXTERNAL ASTCCH
* Establish condition handler
CALL LIB$ESTABLISH(ASTCCH)
* Set Control C AST
CALL ASTINT
10 CONTINUE
CALL REKEN
* Cancel Control C AST
CALL ASTXIT
* Revert condition handler
CALL LIB$REVERT
TYPE *,'INPUT'
READ (*,*,END=20) I
* Establish condition handler
CALL LIB$ESTABLISH(ASTCCH)
* Set Control C AST
CALL ASTINT
IF(I.EQ.1)THEN
CALL A1
ELSEIF(I.EQ.2)THEN
CALL A2
ELSEIF(I.EQ.3)THEN
CALL A3
ELSE
PRINT *,' Onbekende routine.'
ENDIF
GOTO 10
20 CONTINUE
PRINT *,' EINDE PROGRAMMA.'
END
SUBROUTINE A1
EXTERNAL ASTCCH
* Establish condition handler
CALL LIB$ESTABLISH(ASTCCH)
PRINT *,' In A1'
CALL REKEN
PRINT *,' Uit reken, weer in A1.'
END
SUBROUTINE A2
EXTERNAL ASTCCH
* Establish condition handler
CALL LIB$ESTABLISH(ASTCCH)
PRINT *,' In A2'
CALL REKEN
PRINT *,' Uit reken, weer in A2.'
END
SUBROUTINE A3
EXTERNAL ASTCCH
* Establish condition handler
CALL LIB$ESTABLISH(ASTCCH)
PRINT *,' In A3'
CALL REKEN
PRINT *,' Uit reken, weer in A3.'
END
SUBROUTINE REKEN
X=2.5
PRINT *,' In REKEN'
DO 10 I=1,100000
X=SIN(X*3.14159265)
10 CONTINUE
PRINT *,' x=',x
CALL REKEN2
END
SUBROUTINE REKEN2
X=2.5
PRINT *,' In REKEN2'
DO 10 I=1,100000
X=SIN(X*3.14159265)
10 CONTINUE
PRINT *,' x=',x
END
SUBROUTINE ASTINT
*-----------------------------------------------------------------------
* ASTINT - Initialisation Control C AST
* AUTHOR : Carlo Mekenkamp /Leiden
*-----------------------------------------------------------------------
IMPLICIT NONE
LOGICAL LDEBUG,LIDENT
PARAMETER(LDEBUG=.TRUE.,LIDENT=.TRUE.)
INTEGER*2 CHAN
COMMON /ASTCOM/ CHAN
EXTERNAL ASTCCH,ASTCCA
INCLUDE '($IODEF)'
*** Assign a channel to the terminal.
CALL SYS$ASSIGN('TT',CHAN,,)
*** Enable the Control-C AST.
CALL SYS$QIOW(,%VAL(CHAN),%VAL(IOR(IO$_SETMODE,IO$M_CTRLCAST)),
1 ,,,ASTCCA,ASTCCA,,,,)
*** Print some debugging output.
IF(LDEBUG)CALL LIB$PUT_OUTPUT(
1 ' ++++++ ASTINT DEBUG : The control C AST is active.')
END
INTEGER FUNCTION ASTCCH(SA,MA)
*-----------------------------------------------------------------------
* ASTCCH - This routine gets control if an exception occurs
* when established
* VARIABLES : SA : Signal Array
* SA(1) Number of arguments
* SA(2) Condition name
* SA(3) First signal-specific argument
* ...
* SA(SA(1)) PC at time exception
* SA(SA(1)+1) PSL at time exception
* MA : Mechanism Array
* MA(1) Number of mechanism arguments
* MA(2) Establisher frame address
* MA(3) Frame depth of establisher
* MA(4) Saved register R0
* MA(5) Saved register R1
*
* AUTHOR : Carlo Mekenkamp /Leiden
*-----------------------------------------------------------------------
IMPLICIT NONE
LOGICAL LDEBUG,LIDENT
PARAMETER(LDEBUG=.TRUE.,LIDENT=.TRUE.)
INTEGER*4 SA(*),MA(*)
EXTERNAL LIB$MATCH_COND
INTEGER*4 LIB$MATCH_COND
INCLUDE '($SSDEF)'
*** If the condition signalled is SS$_CONTROLC:
IF (LIB$MATCH_COND(SA(2),SS$_CONTROLC).EQ.1) THEN
IF(LDEBUG)CALL LIB$PUT_OUTPUT(
1 ' ++++++ ASTCCH DEBUG : Ctrl-C condition signalled.')
* Unwind to the establisher of this condition handler.
CALL SYS$UNWIND(MA(3),)
ASTCCH = SS$_CONTINUE
*** Otherwise the condition is resignalled.
ELSE
IF(LDEBUG)CALL LIB$PUT_OUTPUT(
1 ' ++++++ ASTCCH DEBUG : Other condition signalled.')
ASTCCH = SS$_RESIGNAL
END IF
END
INTEGER*4 FUNCTION ASTCCA(ASTARG)
*-----------------------------------------------------------------------
* ASTCCA - This routines receives control when a control_c is typed
* to the terminal.
* VARIABLES : ASTARG : Identical to the address of this routine.
*-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER*4 ASTARG
INTEGER*2 CHAN
INCLUDE '($IODEF)'
INCLUDE '($SSDEF)'
COMMON /ASTCOM/ CHAN
*** Reenable Control-C AST.
CALL SYS$QIOW(,%VAL(CHAN),%VAL(IOR(IO$_SETMODE,IO$M_CTRLCAST)),
1 ,,,ASTARG,ASTARG,,,,)
*** Signal the condition SS$_CONTROLC.
CALL LIB$STOP(%VAL(SS$_CONTROLC))
END
SUBROUTINE ASTXIT
*-----------------------------------------------------------------------
* ASTXIT - Cancels Control C AST
* AUTHOR : Carlo Mekenkamp /Leiden
*-----------------------------------------------------------------------
IMPLICIT NONE
LOGICAL LDEBUG,LIDENT
PARAMETER(LDEBUG=.TRUE.,LIDENT=.TRUE.)
INTEGER*2 CHAN
COMMON /ASTCOM/ CHAN
EXTERNAL ASTCCH,ASTCCA
INCLUDE '($IODEF)'
*** Print some debugging output.
IF(LDEBUG)CALL LIB$PUT_OUTPUT(
1 ' ++++++ ASTXIT DEBUG : The control C AST is cancelled.')
*** Cancel Control C AST.
CALL SYS$CANCEL(%VAL(CHAN))
*** Deassign the channel.
CALL SYS$DASSGN(%VAL(CHAN))
END
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!leichter@VENUS.YCC.YALE.EDU ("Jerry Leichter") (09/17/87)
I am having a problem with FORTRAN and asynchronous interrupt. I enable control-c trapping, and when a ctrl-C occurs, the AST-routine signals (by means of LIB$STOP or LIB$SIGNAL) the condition SS$_CONTROLC This condition is trapped by a condition-handler which looks if (LIB$MATCH_COND(SA(2),SS$_CONTROLC) .EQ. 1) and then does as $UNWIND(MA(3),), so there is a stack-unwind to the establisher of the conditionhandler. So far evrything works fine, save one thing. When a control-C occurs during an outstanding PRINT *,'kjgsafhsfhskahfsd' as i can make occur by pressing control-s so text is half written, and then control-c, I get no further text written to the terminal by next calls to PRINT *,'sdajykgsdqkjfdgfhj' No error occurs, and the program continues, but no output is generated to the terminal anymore. What's happening is that you are unwinding across a call to a FORTRAN I/O routine. The FORTRAN I/O routines are not able to deal with this; I'm not sure ANY of the language RTL's can deal with it gracefully. It's not just the I/O routines - unwinding asynchronously through a routine is giving it a rather massive kick in the shins. Recovering successfully may be difficult or just outright impossible. In any case, there are a lot of RTL routines that will not survive this process unscathed. The FORTRAN I/O routines will survive, but the particular channel being accessed at the time of the interrupt probably will not. As you've noted, you can no longer get to the terminal - since it was the terminal that the I/O system was working on at the time of the interruption. You may be able to recover by closing and re-opening the channel - if, as in this case, you can determine which one it is. (I'm not familiar enough with FORTRAN to know if there is a way to close and re-open the default channel that PRINT * writes to.) The general solution is for the CTRL/C AST routine to set a flag which is tested in the mainline code, and then simply dismiss the interrupt. That way, you have control over exactly where the interruption actually occurs - and you can make sure it happens within your code, which you can write to deal with such an event gracefully, and not within the RTL. -- Jerry ------