Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE CLOSER =

BEGIN

GLOBAL BIND	CLOSV = 1^24 + 0^18 + 13;	!EDIT DATE: 27-JAN-78
%([

FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $CLOSE MACRO IN RMS-20.

AUTHOR:	S. BLOUNT /EGM

THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION



FUNCTION:	THIS MODULE CONTAINS ALL ROUTINES WHICH PROCESS
		THE $CLOSE USER MACRO FOR RMS-20.

**********	TABLE OF CONTENTS	**************


	ROUTINE			FUNCTION
	=======			========

	$CLOSE			PROCESSOR FOR $CLOSE MACRO





REVISION HISTORY:

PRODUCT	LOCAL
EDIT	EDIT	DATE		WHO	PURPOSE
====	====	====		===	========

-	1	7-15		SB	PUT IN CODE TO FLUSH KDB CHAIN
-	2	8-5		JK	HANDLE EOF FOR NEW ASCII CHANGES.
-	3	20-SEP-76	SB	ADD IDX HEADER
-	4	5-OCT-76	SB	ADD CHECK FOR HYBYTE > EOFBYTE
-	5	7-OCT-76	SB	ADD FOPDRJ PROCESSING
-	6	7-JAN-77	SB	ADD CHECK FOR FLGREO
-	7	12-JAN-77	SB	REMOVE "ISON" IN DASD MACRO
-	8	15-FEB-77	SB	MAKE COMMON SOURCE CHANGES
-	9	5-APR-77	SB	NO MORE RSTEOF FIELD
-	10	7-APR-77	SB	MOVE EOF UPDATE CODE TO DISCONECT
-	11	3-MAY-77	SB	FETCH ADB ADDRESS FROM FST
7	12	27-JAN-78	EGM	GET NEXT RST LINK FROM FST
					DURING DEALLOCATION

*************************************************
*						*
*		NEW REVISION HISTORY		*
*						*
*************************************************

****************** Start RMS-10 V1.1 *********************
********************* TOPS-10 ONLY ***********************

PRODUCT	MODULE	 SPR
 EDIT	 EDIT	 QAR		DESCRIPTION
======	======	=====		===========

 100	  13	Dev		Make declarations for DCNTRAB, PMEM,
				and UNDOKDBS be EXTERNAL ROUTINE so RMS will
				compile under BLISS V4 (RMT, 10/22/86).



	***** END OF REVISION HISTORY *****




])%



	%([ EXTERNAL DECLARATIONS ])%

EXTERNAL
    CRASH,
    DUMP;

EXTERNAL ROUTINE
    DCNTRAB,
    PMEM;

%([ ERROR MESSAGES REFERENCED WITHIN THIS MODULE ])%





REQUIRE 'RMSREQ';
EXTDECLARATIONS;

! $CLOSE
! =====

! PROCESSOR FOR $CLOSE MACRO
!	THIS ROUTINE PERFORMS THE FOLLOWING FUNCTIONS:
!
!		1. CHECK THAT FILE IS OPEN
!		2. $DISCONNECT EACH RECORD STREAM
!		3. FLUSH FST

! FORMAT OF $CLOSE MACRO:
!
!		$CLOSE	<FAB-ADDRESS> [,<ERROR-ADDRESS>]
!
! FAB FIELDS USED AS INPUT TO $CLOSE:
!
!	FOP		FILE OPTIONS
!	IFI		INTERNAL FILE IDENTIFIER
!	XAB		ADDRESS OF XAB CHAIN (FUTURE)
!
! FAB FIELDS WHICH ARE RETURNED BY $CLOSE:
!
!	STS		COMPLETION STATUS CODE
!	STV		ADDITIONAL STATUS INFORMATION

! INPUT:
!	ADDRESS OF USER FILE BLOCK
!	ADDRESS OF USER ERROR-PROCESSING ROUTINE

! OUTPUT:
!	<NONE>

! GLOBALS USED:
!	DCNCTRAB
!	PMEM

GLOBAL ROUTINE %NAME('$CLOSE') ( BLOCK, ERRORRETURN ) =
BEGIN
	ARGUMENT	(BLOCK,BASEADD);
	ARGUMENT	(ERRORRETURN,BASEADD);

%IF INDX %THEN
 EXTERNAL ROUTINE
	UNDOKDBS;	! FLUSH KDB CHAIN
%FI
LOCAL
    LENGTHFIELD,
    NEXTKDB,		! USED TO POINT TO NEXT KDB IN CHAIN
    TEMP;

	RMSENTRY ( $CLOSE );

	%([ FETCH THE USER'S FAB AND ERROR ADDRESS ])%

	FAB = .BLOCK;					! SET UP FAB ADDR
	ERRADR = .ERRORRETURN;		! AND USER ERROR ADDRESS
	ERRORBLOCK ( FAB );				! ERRORS GO TO FAB

	FST = .FAB [ FABIFI ];				! GET FST ADDRESS
	ADB = .FST [ FSTADB ];				! GET AREA DESC ADDRESS


	%( [ FIRST, CHECK THAT THIS IS A VALID, OPEN FILE ] )%

	IF .FAB [ BLOCKTYPE ] ISNT FABCODE THEN		! CHECK THAT THIS IS AN FAB
		USERERROR ( ER$FAB );			! BAD BLOCK-TYPE
	FST = .FAB [ FABIFI ];
	IF	( .FST [ BLOCKTYPE ] ISNT FSTCODE )	! CHECK THAT THIS IS A VALID FST
		THEN USERERROR ( ER$IFI );		! ILLEGAL FILE-ID

	%( [ LOOP OVER ALL CONNECTED RST'S AND DISCONNECT EACH ONE ] )%

	RST = .FST [ FLINK ];				! GET 1ST RST ON CHAIN

	%([ PERFORM THIS LOOP ONCE FOR EACH "CONNECTED" RECORD
	   STREAM. ])%

	WHILE ( .RST ISNT .FST )
	DO						! UNTIL WE COMPLETE CHAIN

		BEGIN	%( TO DISCONNECT AN RST )%
		CALLDCNTRAB;				! FLUSH THIS STREAM
%([7])%		RST = .FST [ FLINK ]			! GET NEXT RAB ON CHAIN
		END;	%( OF DISCONNECT LOOP )%


	USERJFN = .FST [ FSTJFN ];			!SET CURRENT FILE'S JFN

	IF ( FILELOCKED )				!UNLK FILE IF NECES
	THEN $CALLOS ( ER$CCF, ( $CALL ( LOFFALL, .USERJFN ) ) );


	IF CHKFLAG ( FAB [ FABFOP ], FOPDRJ ) IS OFF
	THEN BEGIN
		FAB [ FABJFN ] = ZERO;				! CLEAR THE JFN TOO
	END; %(OF HE DIDNT WANT TO SAVE THE JFN)%

	$CALLOS ( ER$CCF,( $CALL (CLOSEFILE, .USERJFN, .FAB);	));

	%([ FOR INDEXED FILES, WE MUST NOW FLUSH THE
	   CHAIN OF KEY DESCRIPTOR BLOCKS AND THE AREA
	   DESCRIPTOR BLOCK. ])%

	%IF INDX %THEN
	IF IDXFILE
	THEN
		BEGIN
		%([ IF THE FILE SHOULD BE RE-ORGANIZED, TELL HIM ])%

		IF CHKFLAG ( FST [ FSTFLAGS ], FLGREO ) ISON THEN USRSTS = SU$REO;

		LENGTHFIELD = .ADB [ BLOCKLENGTH ];	! GET SIZE OF ADB
		CALLPMEM ( LCI ( LENGTHFIELD ), RGCI ( ADB ) );	! FLUSH IT
		CALLUNDOKDBS				! FLUSH THE KDB CHAIN
		END; %(OF IF IDXFILE)%
	%FI


	%( [ WE MUST NOW FLUSH THE FST ] )%

	LENGTHFIELD = .FST [ BLOCKLENGTH ];		! GET ITS SIZE
	CALLPMEM ( LCI ( LENGTHFIELD ), RGCI ( FST ));  	! RELEASE CORE

	%( [ FINALLY, CLEAR THE USER'S FILE-ID FIELD ] )%
	FAB [ FABIFI ] = ZERO;				! SHOW THAT NO FILE IS OPEN

	USEREXIT					! RETURN TO USER

END;	%( OF $CLOSE PROCESSOR )%
END
ELUDOM