Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/rmscls.b36
There are 6 other files named rmscls.b36 in the archive. Click here to see a list.
%TITLE 'C L O S E R   -- process $CLOSE macro'
!<BLF/REQUIRE 'RMSBLF.REQ'>
MODULE closer (IDENT = '3.0'
		) =
BEGIN
!
!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1984, 1986.
!	ALL RIGHTS RESERVED.
!
!	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 THAT IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	RMS
!
! ABSTRACT:
!
!	CLOSER contains all routines which process
!	the $CLOSE macro in RMS-20.
!
! ENVIRONMENT:	User mode, interrupts deferred until JSYS return
!
! AUTHOR: Ron Lusk , CREATION DATE: 15-Mar-83
!
! MODIFIED BY: Ron Lusk, 5-Apr-85 : Version 3
!
! 646	- Clear RAB pointer after $Close
! 501	- Implement remote file $Close
! 502   - Change over to new standard names
! 507   - Implement wildcard remote $Close
! 565	- Return STV from FFF call
!--

!
! TABLE OF CONTENTS
!
!	$CLOSE	--  the $CLOSE macro processor
!
!
! INCLUDE FILES:
!

REQUIRE 'rmsreq';
REQUIRE 'rmsosd';

!
! MACROS:
!
!   None.
!
! EQUATED SYMBOLS:
!

GLOBAL BIND
    closv = 3^24 + 0^18 + 565;			! Version number

!
! OWN STORAGE:
!
!   None.
!
! EXTERNAL REFERENCES:
!
!   Dap$Close, F$Close
!
EXTERNAL ROUTINE
    DisposeFile: NOVALUE,
    F$Close;
%SBTTL '$CLOSE -- process $CLOSE macro'
GLOBAL ROUTINE $close (FABLOCK, errorreturn) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	$CLOSE performs the following functions:
!
!	    1)	Check that the file is open;
!	    2)	$DISCONNECT each record stream;
!	    3)	Flush File Status Table.
!
! FORMAL PARAMETERS
!
!	FABLOCK	    -   File Access Block
!	    FOP	    -   File options
!	    IFI	    -   Internal File Identifier (points to FST)
!	    XAB	    -   Pointer to XAB chain (for future use, as
!			of March '83)
!	    STS	    -   Completion status returned to user
!	    STV	    -   Additional status information
!
!	ERRORRETURN -	User error-processing routine (not used)
!
! IMPLICIT INPUTS
!
!	FST	    -	File Status Table
!
! ROUTINE VALUE:
!
!	None, apparently, yet not NOVALUE.
!
! SIDE EFFECTS:
!
!	All RSTs for this file are flushed.
!	File is closed (by CLOSEFILE).
!	ADBs and KDBs are flushed.
!	FST is flushed.
!	User's FAB$H_IFI field is zeroed.
!
!--

    BEGIN

    LOCAL
	lengthfield,
	nextkdb,                        ! Used to point to next KDB in chain
	temp;

    rmsentry ($close);

!+
!   Fetch the user's FAB and error address.
!-

    fab = .FABLOCK;				! Set up FAB address
    erradr = .errorreturn;			! And user error address
    errorblock (fab);				! Errors go to FAB
    fst = .fab [fabifi, 0];			! Get FST address
    adb = .fst [fstadb];			! Get area desc address

!+
!   First, check that this is a valid, open file.
!-

    IF .fab [blocktype] neq fabcode		! Check that this is a FAB
    THEN
	usererror (er$fab);			! Bad block-type

    fst = .fab [fabifi, 0];

    IF (.fst [blocktype] neq fstcode)		! Check for a valid FST
    THEN
	usererror (er$ifi);			! Illegal file-ID

    Fst[Fst$h_Fop] = .Fab[Fab$h_Fop];           ! Save the FOP in the FST !m507

    IF .fst [ fst$v_remote ]
    THEN
        BEGIN
        Dap$Close ( .fab, .erradr );

        rst = .fst [flink];				! Get 1st RST on chain

        !+
        !   Perform this loop once for each "connected" record stream.
        !-

        WHILE (.rst neq .fst) DO        ! Until we complete chain
            BEGIN                       ! To disconnect an RST
            LOCAL rstlen;

            !+
            !   Remove RST from FST chain.
            !-
            delink (rst);               ! Unlink RST

            !+
            !   Release core used by RST
            !-
            lengthfield = .rst [blocklength];
            pmem (.lengthfield,              ! Block size
                   rst);                ! Block pointer

            rst = .fst [flink]          ! Get next RAB on chain
            END;

        ! Flush the FST unless the link is being held open
        IF ( .fst [fst$v_drj] EQL 0 )
        AND ( .fst [fst$v_access_active] EQL 0 )
        THEN
            BEGIN
            lengthfield = .fst [blocklength];   ! Get its size
            pmem (.lengthfield, fst);           ! Release core

            !
            !   Finally, clear the user's file-ID field.
            !
            fab [Fab$a_Ifi] = 0;        ! Show no file is open         !m507

            IF .fab [fab$h_jfn] NEQ 0
            THEN
                BEGIN
		%IF %SWITCHES(TOPS20)
		%THEN
                     RlJfn( .fab [fab$h_jfn] );                           !m572
		%FI
                fab [fab$h_jfn]=0;
                END;
            END;
        END                              ! End of Remote file $Close
    ELSE
        BEGIN
        !+
        !   Local File Close
        !-

        !+
        !   Loop over all connected RSTs and disconnect each one.
        !-

        rst = .fst [flink];             ! Get 1st RST on chain

        !+
        !   Perform this loop once for each "connected" record stream.
        !-

        WHILE (.rst neq .fst) DO        ! Until we complete chain
            BEGIN                       ! To disconnect an RST
            dcntrab ();                 ! Flush this stream
            rst = .fst [flink]          ! Get next RAB on chain
            END;

        userjfn = .fst [fstjfn];        ! Set current file's JFN

        IF (filelocked)                 ! Unlock file if necessary
        THEN
            $callos (er$ccf, (loffall (.userjfn)));

        IF chkflag (fab [fabfop, 0], fopdrj) eql 0	! Release JFN or not?
        THEN
            BEGIN
            fab [fabjfn, 0] = 0;			! Clear the JFN too
            END;


        IF .Fst[Fst$h_File_Class] LSS 0                                 !a524vv
        THEN
            BEGIN
            F$Close( .Fab );

	    usrstv = .fab [fab$h_stv];		! Return STV		!A565
            IF NOT $Rms_Status_Ok( .Fab )
            THEN Usererror( .Fab[Fab$h_Sts] );
            END;                                                        !a524^^

        DisposeFile();                  ! Spool, Batch, delete on close?  !a546

        $callos (er$ccf, (closefile (.userjfn, .fab); ));	! Close file

        !+
        !   For indexed files, we must now flush the chain of
        !   key descriptor blocks and the area descriptor block.
        !-

        IF idxfile
        THEN
            BEGIN

            !+
            !   If the file should be re-organized, tell him.
            !-

            IF chkflag (fst [fstflags], flgreo) neq 0 	!
            THEN
                usrsts = su$reo;			! Reorganize file

            lengthfield = .adb [adb$h_bln];	! Get size of ADB         !m502
            pmem (.lengthfield, adb);		! Flush it
            undokdbs ()				! Flush the KDB chain
            END;

        !+
        !   We must now flush the FST.
        !-

        lengthfield = .fst [blocklength];		! Get its size
        pmem (.lengthfield, fst);			! Release core

        !
        !   Finally, clear the user's file-ID field.
        !
        fab [Fab$a_Ifi] = 0;    		! Show no file is open    !m507
        END;					! End of Local file $Close

    Rab = 0;                                    ! 646
    usrret ()					! Return to user
    END;                                        ! End of $CLOSE
END						! End of Module CLOSER

ELUDOM