MODULE XCLOSE (	IDENT = 'X1.2-19'		%TITLE 'XPO$CLOSE - XPORT File Close'
		%BLISS32( ,ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) )
		%BLISS36( ,ENTRY( XPO$CLOSE ),OTS='' )
		) =
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:  BLISS Library
!
! ABSTRACT:
!
!	This module is the XPORT file close module.
!
! ENVIRONMENT:  User mode - multiple host operating/file systems
!
! AUTHORS:  Ward Clark,			CREATION DATE:  26 June 1978
!	    Linda Duffell
!
! MODIFIED BY: Edward G. Freedman	See CMS history for details
!
!--

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    XPO$CLOSE;						! XPORT File Close Routine

!
! INCLUDE FILES:
!

LIBRARY  'XPORT' ;					! Public XPORT control block and macro definitions
LIBRARY  'XPOSYS' ;					! Internal XPORT macro definitions

     $XPO_SYS_TEST( $TOPS10, $TOPS20, $VMS, $11M, $RSTS, $RT11 )

%IF $TOPS10 %THEN
REQUIRE  'XT10' ;					! TOPS-10 I/O interface macros
%FI

%IF $TOPS20 %THEN
REQUIRE  'XT20';					! TOPS-20 I/O interface macros
%FI

%IF $VMS %THEN
REQUIRE  'XVMS';					! XPORT-specific VAX/VMS interface definitions
%FI

%IF $11M %THEN
REQUIRE  'XRSX' ;					! XPORT-specific RSX-11 and FCS-11 interface definitions
%FI

%IF $RSTS %THEN
REQUIRE  'XRSTS' ;					! RSTS/E system interface definitions
%FI

%IF $RT11 %THEN
REQUIRE  'XRT11' ;					! RT-11 I/O system interface definitions
%FI

!
! MACROS:
!

!
! EQUATED SYMBOLS:
!

LITERAL
    yes = 1,						! Used to turn an indicator on
    no = 0;						! Used to turn an indicator off

!
! PSECT DECLARATIONS:
!

    $XPO_PSECTS						! Declare XPORT PSECT names and attributes

!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    XPO$ZERO_IOB :  NOVALUE;				! IOB field reset routine

%IF $TOPS10 %THEN
EXTERNAL ROUTINE
    X10$CLEANUP;					! TOPS-10 control block cleanup routine
%FI

%IF $TOPS20 %THEN
EXTERNAL ROUTINE
    X20$CLOSE;						! TOPS-20 close routine.
%FI

%IF $VMS %THEN
EXTERNAL ROUTINE
    XPO$RMS_ERROR :  NOVALUE,				! RMS-to-XPORT completion code conversion routine
    XPO$RMS_CLEANUP;					! RMS control block cleanup routine
%FI

%IF $11M %THEN
EXTERNAL ROUTINE
    XRSX$IO_ERROR :  NOVALUE,				! FCS-to-XPORT completion code conversion routine
    XRSX$CLEANUP;					! QIO/FCS cleanup routine
%FI

%IF $RSTS %THEN
EXTERNAL ROUTINE
    XRST$CLOSE ,					! RSTS/E close routine
    XRST$FIXUP;						! Cleanup channel IOB fields
%FI

%IF $RT11 %THEN
EXTERNAL
    XPO$CHANNELS :  BITVECTOR;				! EZIO channel assignment vector
EXTERNAL ROUTINE
    XRT$CLOSE ;						! RT-11 close routine
 %FI

GLOBAL ROUTINE XPO$CLOSE ( iob, success_action, failure_action ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine closes an open file.
!
! FORMAL PARAMETERS:
!
!	iob - address of IOB
!	success_action - address of success action routine
!	failure_action - address of failure action routine
!
! IMPLICIT INPUTS:
!
!	Information contained in or pointed to by the caller's IOB
!
! IMPLICIT OUTPUTS:
!
!	Various fields in the caller's IOB are updated to reflect
!	the results of the requested I/O function
!
! COMPLETION CODES:  (also returned in IOB$G_COMP_CODE)
!
!	XPO$_NORMAL - the file was successfully closed
!
!	XPO$_BAD_IOB - invalid IOB
!		(IOB$G_2ND_CODE = XPO$_BAD_LENGTH - invalid length)
!	XPO$_CLOSED - the file has already been closed
!	XPO$_CONFLICT - confliciting IOB information
!		(IOB$G_2ND_CODE = XPO$_NO_CONCAT - concatenated file-spec cannot be REMEMBERed)
!	XPO$_FREE_MEM - error deallocating IOB-related memory
!		(IOB$G_2ND_CODE = $XPO_FREE_MEM completion code
!                          or failure completion codes from XRSX$CLEANUP (RSX)
!                          or failure completion codes from XPO$RMS_CLEANUP (VMS))
!	XPO$_NOT_OPEN - the file was not opened
!	failure completion codes from X20$CLOSE (TOPS-20)
!	failure completion codes from XPO$RMS_ERROR (VMS)
!	failure completion codes from XRST$CLOSE (RSTS)
!       failure completion codes from XRSX$IO_ERROR (11M)
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	iob :  REF $XPO_IOB();				! Redefine the IOB parameter

!
! XPORT routine initialization.
!

    $XPO_MAIN_BEGIN( IO )				! Define the MAIN_BLOCK code block
							! and validate the caller's IOB.

!
! Check for IOB-related errors.
!

							! Check for the following errors:
    IF .iob[IOB$V_CLOSED]				!     the file has already been closed
    THEN
	$XPO_QUIT( CLOSED );

    IF NOT .iob[IOB$V_OPEN]				!     the file is not open
    THEN
	$XPO_QUIT( NOT_OPEN );

    IF .iob[IOB$V_REMEMBER] and .iob[IOB$V_CONC_SPEC]	!    remember a concatenated file-spec
    THEN
	$XPO_QUIT( CONFLICT, NO_CONCAT );

!
! Setup default options.
!

    IF .iob[IOB$V_TEMPORARY]				! If this is a temporary work file,
    THEN						!
	iob[IOB$V_REMEMBER] = yes;			! assume that it will be reprocessed.

!+
!
!	System-dependent file close processing follows.
!
!-

%TITLE 'TOPS-10 CLOSE'
%IF $TOPS10 %THEN

!+
!
!	TOPS-10 CLOSE Processing
!
!_

!
! Close the file and release the channel.
!

    IF NOT .iob[IOB$V_TERMINAL]				! If this is not a terminal file,
    THEN						!
    	BEGIN						!
	$T10_CLOSE( .iob[IOB$H_CHANNEL] );		! close a TOPS-10 file
							! (flushes partially filled output buffer)
    	$T10_RELEASE( .iob[IOB$H_CHANNEL] );		! and release the channel.
    	END;

!
! Release the channel assignment and free the I/O buffers and control block.
!

    $XPO_IF_NOT( X10$CLEANUP( .iob ) )
    THEN
    	$XPO_QUIT( FREE_MEM, ( .$XPO_STATUS ) );

!+
!
!	End of TOPS-10 CLOSE Processing
!
!-

%FI

%TITLE 'TOPS-20 CLOSE'
%IF $TOPS20 %THEN

!+
!
!	TOPS-20 CLOSE Processing
!
!_

!
! Close the file.
!

    IF NOT .iob[IOB$V_TERMINAL]				! If this is not a terminal file,
    THEN						!
	BEGIN						!
	IF NOT X20$CLOSE( .iob )			! Close the file
							! (flushes partially filled output buffer)
	THEN						! If an error occurs,
	    $XPO_QUIT();				! return to the caller with the completion codes.

	iob[IOB$H_CHANNEL] = 0;				! Zero the JFN number in the IOB.
	END;

!+
!
!	End of TOPS-20 CLOSE Processing
!
!-

%FI

%TITLE 'VAX/VMS File Close'
%IF $VMS %THEN

!+
!	VAX/VMS File Close Processing
!
! Implicit inputs:
!	amt_buff_used (rab[RAB$L_CTX]) - indicates data in the XPORT internal output buffer
!		set by XPO$PUT, cleared by XPO$GET and XPO$CLOSE
!
! Implicit outputs:
!	amt_buff_used (rab[RAB$L_CTX]) - indicates data in the XPORT internal output buffer
!		tested by XPO$PUT, XPO$GET and XPO$CLOSE
!-

    BEGIN

    BIND
	fab = .iob[IOB$A_RMS_FAB] :  $FAB_DECL,		! Define the IOB's FAB
	rab = .iob[IOB$A_RMS_RAB] :  $RAB_DECL;		! and RAB.

    MACRO
	amt_buff_used = rab[RAB$L_CTX] %;		! Amount of data in the XPORT internal output buffer

!
! Flush out a partial binary or random output block.
!

    IF (.iob[IOB$V_BINARY] OR .iob[IOB$V_RANDOM]) AND	! If this is a binary or random output file,
	.iob[IOB$V_OUTPUT] AND				!
	.amt_buff_used NEQ 0				! and the XPORT internal output buffer contains data,
    THEN
	BEGIN						!
	rab[RAB$W_RSZ] = .amt_buff_used;		! Setup the output block length (always 512 for random)
	rab[RAB$L_RBF] = .rab[RAB$L_UBF];		! and address of the data buffer.

	IF $RMS_WRITE( RAB = rab )			! If the write operation is successful,
	THEN						!
	    amt_buff_used = 0				! indicate that the output buffer is empty.
	ELSE
	    BEGIN
	    XPO$RMS_ERROR( .iob,			! Otherwise, convert the RMS completion codes
			    .rab[RAB$L_STS],		! into appropriate XPORT completion codes
			    .rab[RAB$L_STV] );		!
	    $XPO_QUIT();				! and then jump to return an error to the caller.
	    END;
	END;

!
! If this is a terminal file, simply deassign the terminal I/O channel.
!

    IF .fab[FAB$V_UFO]
    THEN
	BEGIN
	$XPO_IF_NOT( $DASSGN( CHAN = .iob[IOB$H_CHANNEL] ) )
	THEN
	    $XPO_QUIT( SYS_ERROR, (.$XPO_STATUS) );
	iob[IOB$H_CHANNEL] = 0;
	END

!
! Otherwise, perform an RMS file close.
!

    ELSE
	IF NOT $RMS_CLOSE( FAB = fab )
	THEN
	    BEGIN
	    XPO$RMS_ERROR( .iob, .fab[FAB$L_STS], .fab[FAB$L_STV] );
	    $XPO_QUIT();
	    END;

!
! Free the IOB's RMS control blocks.
!

    $XPO_IF_NOT( XPO$RMS_CLEANUP( .iob ) )
    THEN
	$XPO_QUIT( FREE_MEM, (.$XPO_STATUS) );

    END;

!+
!
!	End of VAX/VMS File Close Processing
!
!-

%FI

 %TITLE 'RSX-11M File Close'
 %IF $11M %THEN

!+
!
!	RSX-11M File Close Processing
!
!-

     BEGIN

     BIND
	fcs_blocks = .iob[IOB$A_FCS_FDB] :  $FCS_BLOCKS,
	fdb = fcs_blocks[FCS$Z_FDB] :  FDB$;

     LOCAL
	out_buffer_size;

!
! Flush out a partial binary output block.
!

     IF .iob[IOB$V_BINARY] AND .iob[IOB$V_OUTPUT] AND	! If the XPORT internal output buffer contains data,
	.fcs_blocks[FCS$G_BUFF_USED] GTR 0		!
     THEN						!
	BEGIN						!
	out_buffer_size = .fdb[F$BKDS$S];		! save the current output buffer size
	fdb[F$BKDS$S] = .fcs_blocks[FCS$G_BUFF_USED];	! and replace it with the size of the buffered output data.

	WRITE$( fdb );					! Write out the partial buffer.

	IF .fdb[F$ERR] EQL IS$SUC
	THEN
	    WAIT$( fdb );

	IF .fdb[F$ERR] NEQ IS$SUC
	THEN
	    BEGIN
	    XRSX$IO_ERROR( .iob, .fdb[F$ERR] );
	    $XPO_QUIT();
	    END;

	fdb[F$BKDS$S] = .out_buffer_size;		! Restore the output buffer size
	fcs_blocks[FCS$G_BUFF_USED] = 0;		! and indicate no buffered output data remains.
	END;

!
! Close the file.
!

     IF NOT .iob[IOB$V_TERMINAL]			! Don't try to close a terminal file.
     THEN
	IF NOT CLOSE$( fdb )				! If file closing fails,
	THEN						!
	    BEGIN					!
	    XRSX$IO_ERROR( .iob,			! convert the FCS-11 completion code into
			    .fdb[F$ERR] );		! equivalent XPORT completion codes
	    $XPO_QUIT();				! and then jump to return to the caller.
	    END;

!
! Release the assigned LUN and free any FCS-11 control blocks.
!

     $XPO_IF_NOT( XRSX$CLEANUP( .iob ) )		! Perform QIO/FCS cleanup.
     THEN
	$XPO_QUIT( FREE_MEM, (.$XPO_STATUS) );		! Return error codes if the control block deallocation fails.

     END;

!+
!
!	End of RSX-11M File Close Processing
!
!-

 %FI

%TITLE 'RSTS File Close'

%IF $RSTS %THEN

!+
!
!	RSTS/E CLOSE Processing
!
!_

!
! Close the file.
!

     IF NOT .iob[IOB$V_TERMINAL]			! If this is not a terminal file,
     THEN						!
	BEGIN						!
	IF NOT XRST$CLOSE( .iob )			! close the file,
	THEN						! (flushes partially filled output buffer)
	    $XPO_QUIT();				!
    							!
    	$XPO_IF_NOT( XRST$FIXUP( .iob) )		! Cleanup the channel IOB information.
    	THEN
    	    $XPO_QUIT( FREE_MEM, (.$XPO_STATUS) );
	END;

!+
!
!	End of RSTS/E CLOSE Processing
!
!-

 %FI
 %TITLE 'RT-11 File Close'

 %IF $RT11 %THEN

!+
!
!	RT-11 CLOSE Processing
!
!_

!
! Close the file.
!

     IF NOT .iob[IOB$V_TERMINAL]			! If this is not a terminal file,
     THEN						!
	BEGIN						!
	XRT$CLOSE( .iob );				! close the file,
							! (flushes partially filled output buffer)
	XPO$CHANNELS[.iob[IOB$H_CHANNEL]] = no;		! release the XPORT I/O channel,

	iob[IOB$H_CHANNEL] = 0;				! and zero the channel number in the IOB.
	END;

!+
!
!	End of RT-11 CLOSE Processing
!
!-

 %FI

%TITLE 'XPO$CLOSE - XPORT File Close Termination'

!+
!
!	Continuation of system-independent file close processing
!
!-

!
! Reset the IOB to an "unopened" state.
!

							! Update the IOB:
    iob[IOB$V_OPEN] = no;				!    turn off the opened indicator
    iob[IOB$V_EOF] = no;				!    turn off the end-of-file indicator

    IF .iob[IOB$V_AUTO_CONC]				! Automatic (internal) close processing:
    THEN
	BEGIN
	$XPO_FREE_QUIT( STRING = iob[IOB$T_RESULTANT] );!    Free the current resultant file-spec.

	XPO$ZERO_IOB( .iob );				!    Reset file attributes, sequence info, etc.
	END
    ELSE
	IF .iob[IOB$V_REMEMBER]				! REMEMBER processing:
	THEN
	    BEGIN
	    $XPO_LEAVE_IOB( .iob );			!    Cleanup the IOB.

	    iob[IOB$A_FILE_SPEC] =			!    Reset the primary file-spec.
			iob[IOB$T_RESULTANT];
	    END
	ELSE						! Non-REMEMBER processing:
	    $XPO_ZAP_IOB( .iob );			!    Reinitialize the IOB.

							! Cleanup the IOB:
    iob[IOB$V_CLOSED] = yes;				!    file has been successfully closed
    iob[IOB$V_INPUT] = no;				!    turn off "open for input"
    iob[IOB$V_OUTPUT] = no;				!		"open for output"
    iob[IOB$V_OVERWRITE] = no;				!		"open for overwrite"
    iob[IOB$V_APPEND] = no;				!		"open for append"

    $XPO_QUIT( NORMAL );				! Return a success code to the caller.

!
! XPORT routine termination.
!

    $XPO_MAIN_END;					! Terminate MAIN_BLOCK.

    $XPO_ACTION_RTN( .iob );				! Call a success or failure action routine.

!
! Reinitialize the IOB after a file close failure.
!

    IF NOT .iob[IOB$G_COMP_CODE] AND NOT .iob[IOB$V_AUTO_CONC]
    THEN
	$XPO_ZAP_IOB( .iob );

!
! Return to the caller.
!

    RETURN .iob[IOB$G_COMP_CODE]			! Return the IOB completion code to the caller.

    END;
END
ELUDOM