Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP Path: utzoo!mnetor!uunet!husc6!bloom-beacon!gatech!rutgers!ucla-cs!zen!ucbvax!CITHEX.CALTECH.EDU!carl From: carl@CITHEX.CALTECH.EDU Newsgroups: comp.os.vms Subject: CONTROL-C AST's and CONDITION HANDLERS Message-ID: <870914052821.00r@CitHex.Caltech.Edu> Date: Mon, 14-Sep-87 08:28:21 EDT Article-I.D.: CitHex.870914052821.00r Posted: Mon Sep 14 08:28:21 1987 Date-Received: Tue, 15-Sep-87 06:29:35 EDT Sender: daemon@ucbvax.BERKELEY.EDU Organization: The ARPA Internet Lines: 199 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!