Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/recog3/hlpcond.b32
There are 2 other files named hlpcond.b32 in the archive. Click here to see a list.
MODULE HLP$COND (
		IDENT='V00A23'
	       ) =
BEGIN

!
!			  COPYRIGHT (C) 1982 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
! ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
! COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
! AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
!
! FACILITY:	HELP
!
! ABSTRACT:
!
!
!
! ENVIRONMENT:
!
! AUTHOR: Stanley Rabinowitz, CREATION DATE: 4-Dec-79
!
! MODIFIED BY:
!
! 	, : VERSION
! 01	- 
!
!--
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE

	HLP$FAB_CLOSE_HANDLER;		! Condition hanlder to close FABs

!
! INCLUDE FILES:
!

REQUIRE 'HLP.R32';

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
GLOBAL ROUTINE HLP$FAB_CLOSE_HANDLER(P_SIG,P_MECH,P_ENBL) =
BEGIN

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	Condition handler used by many SCP routines
!	to ensure that open files gets closed
!	after a fatal error or if a CTRL/C unwind occurs.
!
! FORMAL PARAMETERS:
!
!	P_SIG		Address of signal vector.
!
!	P_MECH		Address of mechanism vector.
!
!	P_ENBL		Address of enable vector.
!			Contains list of FABs (and RABs)to be cleaned up.
!			Sequence of pairs of addresses:
!			Address of FAB followed by address of RAB.
!			Address of RAB may be 0 to mean no RAB is in use.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	IFI values in FABs gets set to 0.
!
! ROUTINE VALUE:
!
!	SS$_RESIGNAL	propogate the signal up the line.
!
! COMPLETION CODES:
!
!	NONE
!
! SIDE EFFECTS:
!
!	Open files, if any, get closed.
!
!--
BIND

	SIG	= .P_SIG		: BLOCK[,BYTE],	! Signal vector
	ENBL	= .P_ENBL		: VECTOR,	! Enable vector
	COND	=  SIG[CHF$L_SIG_NAME]	: BLOCK[,BYTE];	! Severity of message

EXTERNAL LITERAL

	HLP$_DEBUG_FAB;

!+
! On severe errors, or if we are unwinding,
! then we must "clean up".  If we have a file open,
! we must close it.
!-

!+
! Make sure that the FAB is really a FAB, by confirming that the
! block type is FAB$C_BID.  If not, do not touch this block.
! Check the IFI value in the FAB.
! If this is non-0, then that means that we still
! have a file open.
! Just in case there is an operation pending, we must first
! issue a $WAIT.  To do this we need a RAB.  We use the RAB
! specified by the user.  We skip this step if the RAB address is 0
! or if the address specifies a block that is not of RAB type.
! Issue a CLOSE command to RMS and ignore any errors.
! (We could if we want, set the delete bit and delete it.)
!-

IF .SIG[CHF$L_SIG_NAME]  EQL SS$_UNWIND
  THEN	INCR I FROM 1 TO .ENBL[0]/2 DO
		BEGIN
		LOCAL FAB_STATUS,RAB_STATUS;
		BIND COND_FAB = .ENBL[2*.I-1]	: $FAB_DECL;
		BIND COND_RAB = .ENBL[2*.I]	: $RAB_DECL;
		IF .COND_FAB[FAB$B_BID] EQL FAB$C_BID AND
		   .COND_FAB[FAB$W_IFI] NEQ 0
		  THEN	BEGIN
			IF  COND_RAB NEQ 0 AND
			   .COND_RAB[RAB$B_BID] EQL RAB$C_BID AND
			   .COND_RAB[RAB$L_FAB] EQL COND_FAB
			  THEN	RAB_STATUS=$WAIT(RAB=COND_RAB)
			  ELSE	RAB_STATUS=1;
			FAB_STATUS=$CLOSE(FAB=COND_FAB);
!			IF .USER[USER$V_DEBUG] AND NOT .FAB_STATUS
			IF NOT .FAB_STATUS
			  THEN	IF .RAB_STATUS
				  THEN	SIGNAL(HLP$_DEBUG_FAB,1,.COND_FAB[FAB$L_CTX],
						.COND_FAB[FAB$L_STS],
						.COND_FAB[FAB$L_STV],
						.COND_RAB[RAB$L_STS],
						.COND_RAB[RAB$L_STV])
				  ELSE	SIGNAL(HLP$_DEBUG_FAB,1,.COND_FAB[FAB$L_CTX],
						.COND_FAB[FAB$L_STS],
						.COND_FAB[FAB$L_STV])
			END;
		END;

RETURN SS$_RESIGNAL

END;
END
ELUDOM