     	INTEGER*4 FUNCTION CALC_HANDLER(SIGARGS,MECHARGS)
*******************************************************************************
* 
*    UNIT NAME:  CALC_HANDLER
* 
*    PURPOSE:  CONDITION HANDLER FOR EXPRESS
* 
*    INVOCATION METHOD:
* 	CALL CALC_HANDLER(SIGARGS,MECHARGS)  --  CALLED BY VMS CHF ONLY
* 
*    ARGUMENT LIST:
*      NAME               TYPE  USE    FULL NAME:DESCRIPTION
*    -------------------- ----  ---    ---------------------
*    SIGARGS               *     I     SIGNAL ARGUMENTS
*    MECHARGS              *     I     MECHANISM ARGUMENTS
* 
*    LOCAL VARIABLES:
*      NAME      	  TYPE         FULL NAME:DESCRIPTION
*    -------------------- ----         ---------------------
*    NARGS                 I*4         NUMBER OF SIGNAL ARGUMENTS
*    N                     I*4         INDEX OF CONDITION IN LIST
*    NEWARGS(10)           I*4         NEW SIGNAL ARGUMENT LIST
*    MFLAGS                I*4         ERROR FLAGS
* 
*    MODULES CALLED:
*      NAME           PURPOSE
*    -------------    --------------------------------------
*    LIB$MATCH_COND   IDENTIFY CONDITION
*    LIB$SIGNAL       SIGNAL NEW CONDITION
*    LIB$INSV         CONVERT CONDITION LEVEL TO INFORMATIONAL
*    EXPR_CLEANUP     CLEAN UP EXPRESS LOCAL VARIABLES / SYMBOL TABLE
*    SYS$UNWIND       UNWIND STACK TO CALLER
* 
*    DEVELOPMENT HISTORY:
*      AUTHOR	            DATE  	COMMENTS
*    D. FITZGERALD         4/14/83        
* 
*******************************************************************************
*
*		SPECIFICATIONS
*
	INTEGER*4 SIGARGS(*),MECHARGS(*)
	EXTERNAL CALC_NOFILE,CALC_MISMATCH,CALC_NONINIT
	EXTERNAL CALC_RESERVED,CALC_ZERODIV,CALC_OVERFLOW
	EXTERNAL CALC_UNDERFLOW,CALC_SYNTAXERR,CALC_INVEXP
	EXTERNAL CALC_SIGLOST,CALC_NEGROOT,CALC_LOGZERNEG
	EXTERNAL EXPR_FRAME_LEN, CALC_TRUNC, CALC_NOVAR
	EXTERNAL CALC_BADNUMBER,CALC_INVARG
*
	INCLUDE '($SSDEF)'
	INCLUDE '($MTHDEF)'
	INCLUDE '($LIBDEF)'
	INTEGER*4 NEWARGS(10)
*
	INTEGER*4 MFLAGS /'10000'X/
*
*		CODE SECTION
*
*
*		FIND OUT IF CONDITION IS ONE WHICH WE ARE WORRIED ABOUT
*		  IF SO, N WILL BE INDEX OF CONDITION ELSE 0
*
	N = LIB$MATCH_COND(SIGARGS(2),
     +     SS$_ROPRAND,SS$_INTDIV,SS$_INTOVF,
     +     SS$_FLTDIV,SS$_FLTDIV_F,
     +     SS$_FLTUND,SS$_FLTUND_F,
     +     SS$_FLTOVF,SS$_FLTOVF_F,
     +     %LOC(CALC_BADNUMBER),
     +     %LOC(CALC_NOFILE),
     +     %LOC(CALC_MISMATCH),
     +     %LOC(CALC_NONINIT),
     +     %LOC(CALC_TRUNC),
     +     %LOC(CALC_NOVAR),
     +     LIB$_SYNTAXERR,
     +     LIB$_USEFLORES,
     +     MTH$_UNDEXP,MTH$_FLOOVEMAT,MTH$_FLOUNDMAT,
     +     MTH$_LOGZERNEG,MTH$_SIGLOSMAT,MTH$_SQUROONEG,
     +     MTH$_INVARGMAT,SS$_UNWIND)
*
D	PRINT 1000, N, (SIGARGS(I),I=1,SIGARGS(1)+1)
D	PRINT 1001, (MECHARGS(I),I=1,MECHARGS(1)+1)
*
*		COPY SIGNAL ARGUMENTS FOR RESIGNALLING
*
	IF (N .NE. 0) THEN
	    NARGS = SIGARGS(1) - 2
	    DO I = 1,10
	        IF ( I.GT. NARGS ) THEN
		    NEWARGS(I) = 0
		ELSE
		    NEWARGS(I) = SIGARGS(I+1)
		ENDIF
	    ENDDO
*
*		SELECT APPROPRIATE ACTION
*
	    GOTO (101,102,103,102,102,104,104,103,103,105,
     +		105,105,105,112,105,
     +          106,101,107,103,104,108,109,110,
     +          111,150) N
*
101		CONTINUE		!RESERVED OPERAND
		CALL LIB$SIGNAL(CALC_RESERVED,%VAL(MFLAGS))
		GOTO 200		
*
102		CONTINUE		!DIVIDE BY ZERO
		CALL LIB$SIGNAL(CALC_ZERODIV,%VAL(MFLAGS))
		GOTO 200		
*
103		CONTINUE		!OVERFLOW
		CALL LIB$SIGNAL(CALC_OVERFLOW,%VAL(MFLAGS))
		GOTO 200		
*
104		CONTINUE		!UNDERFLOW
		CALL LIB$SIGNAL(CALC_UNDERFLOW,%VAL(MFLAGS))
		GOTO 200		
*
105		CONTINUE		!USE EXISTING CODE
		CALL LIB$INSV(3,0,3,NEWARGS(1))	!MAKE LEVEL INFORMATIONAL
*
*			RESIGNAL USING NEW LEVEL
*
	        CALL LIB$SIGNAL(
     +           %VAL(NEWARGS(1)),	    
     +           %VAL(NEWARGS(2)),	    
     +           %VAL(NEWARGS(3)),	    
     +           %VAL(NEWARGS(4)),	    
     +           %VAL(NEWARGS(5)),	    
     +           %VAL(NEWARGS(6)),	    
     +           %VAL(NEWARGS(7)),	    
     +           %VAL(NEWARGS(8)),	    
     +           %VAL(NEWARGS(9)),	    
     +           %VAL(NEWARGS(10)))
		GOTO 200		
*
106		CONTINUE		!SYNTAX ERROR
		CALL LIB$SIGNAL(CALC_SYNTAXERR,%VAL(MFLAGS))
		GOTO 200		
*
107		CONTINUE		!INVALID EXPONENT
		CALL LIB$SIGNAL(CALC_INVEXP,%VAL(MFLAGS))
		GOTO 200		
*
108		CONTINUE		!LOG OF ZERO OR NEGATIVE NUMBER
		CALL LIB$SIGNAL(CALC_LOGZERNEG,%VAL(MFLAGS))
		GOTO 200		
*
109		CONTINUE		!SIGNIFICANCE LOST
		CALL LIB$SIGNAL(CALC_SIGLOST,%VAL(MFLAGS))
		GOTO 200		
*
110		CONTINUE		!SQUARE ROOT OF NEGATIVE NUMBER
		CALL LIB$SIGNAL(CALC_NEGROOT,%VAL(MFLAGS))
		GOTO 200		
*
111		CONTINUE		!SQUARE ROOT OF NEGATIVE NUMBER
		CALL LIB$SIGNAL(CALC_INVARG,%VAL(MFLAGS))
		GOTO 200		
*
112		CONTINUE		!SYMBOL TRUNCATION
		CALC_HANDLER = ss$_resignal  !RESIGNAL, BUT DON'T UNWIND
		return
*
150		CONTINUE		!UNWINDING
*
*			CLEAN UP SYMBOL TABLE
*
		CALL EXPR_CLEANUP(%VAL(MECHARGS(2) -
     +           %LOC(EXPR_FRAME_LEN)))
		RETURN
C
200	    CONTINUE			!END CASE
	    CALL SYS$UNWIND(,)
	ENDIF	    
C
	CALC_HANDLER = SS$_RESIGNAL
	RETURN
*
*		FORMAT STATEMENTS
*
D1000	FORMAT(' **CALC_HANDLER** CALLED.  N = ',I3,/,
D    +         '     SIGNAL ARGUMENTS    = ',Z10.8,/,
D    +        ('                           ',Z10.8))
D1001   FORMAT('     MECHANISM ARGUMENTS = ',Z10.8,/,
D    +        ('                           ',Z10.8))
	END
