MODULE XRSTS (	IDENT = 'X00.04'		%TITLE 'RSTS-specific XPORT Routines'
		) =
BEGIN

!
!			  COPYRIGHT (c) 1980 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 contains all XPORT routines which are specific to RSTS/E.
!
! ENVIRONMENT:  User mode 
!
! AUTHOR:  Linda Duffell	CREATION DATE: 31 May 1980  
!
!--

!

!
! INCLUDE FILES:
!

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

    $XPO_SYS_TEST( $RSTS )

REQUIRE  'XRSTS';					! RSTS/E I/O interface macros

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    XRST$SPEC_SETUP,					! File-spec setup routine
    XRST$ASSIGN_CH,					! Channel assignment routine
    XRST$IN,						! Input processing
    XRST$OUT,						! Output processing
    XRST$GET_FILE,					! Disk file read routine
    XRST$CLOSE,						! Close processing
    XRST$ERROR :  NOVALUE,				! RSTS/E error handling routine
    XRST$FIXUP;						! Channel assignment cleanup routine 
!
! MACROS:
!

MACRO
    code_table[] =
	VECTOR[ (3 * %LENGTH) + 1 ]
	INITIAL( 3*%LENGTH, code_entry(%REMAINING) ) %,

    code_entry[ code_set ] =
	decode_entry( %REMOVE(code_set) ) %,

    decode_entry( rsts_code, xport_code, secondary ) =
	rsts_code, xport_code,
	%IF %NULL(secondary)
	%THEN 0
	%ELSE secondary
	%FI %;

!
! EQUATED SYMBOLS:
!

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

    maximum_chan = 14;					! Maximum channel number

!
! PSECT DECLARATIONS:
!

    $XPO_PSECTS						! Declare XPORT PSECT names and attributes


!
! OWN STORAGE:
!

OWN	

    channel_vector :  BITVECTOR[ maximum_chan + 1 ]	! I/O channel assignment vector
    			PRESET([ maximum_chan ] = 0),

    
    							! XPORT Functions ( Open,Close,Delete,Rename,Get,Put)

    rsts_to_xport :  code_table(			!	Meaning of RSTS/E completion codes:
	( RSTS$_BADDIR, XPO$_BAD_DIRECT ),		! O DR    bad directory for device
	( RSTS$_BADNAM, XPO$_BAD_NAME ),		! O DR    illegal file name
	( RSTS$_NOROOM, XPO$_NO_SPACE ),		! OC   P  no room for user on device
	( RSTS$_NOSUCH, XPO$_NO_FILE ),			! O DR    can't find file or account
	( RSTS$_NODEVC, XPO$_BAD_DEVICE ),		! O DR    not a valid device
	( RSTS$_NOTCLS, XPO$_NO_CHANNEL ),		! O DR    I/O channel already open
	( RSTS$_NOTAVL, XPO$_NOT_ONLINE ),		! O       device not available
	( RSTS$_NOTOPN, XPO$_NOT_OPEN ),		!  C  GP  I/O channel not open
	( RSTS$_PRVIOL, XPO$_PROTECTED ),		!   D GP  protection violation
        ( RSTS$_EOF,    XPO$_END_FILE ),		!     G   end of file on device
	( RSTS$_ABORT,  XPO$_IO_ERROR ),		!     GP  fatal system I/O failure
	( RSTS$_DATERR, XPO$_IO_ERROR ),		!     GP  user data error on device
	( RSTS$_HNGDEV, XPO$_BAD_DEVICE,XPO$_NO_ACCESS),!     GP  device hung or write locked
	( RSTS$_FIEXST, XPO$_EXISTS ),			!    R	  name or account now exists
	( RSTS$_DTOOOF, XPO$_NO_ACCESS,XPO$_NO_CHANNEL),! O       too many open files on unit
	( RSTS$_INTLCK, XPO$_FILE_LOCK ),		! OC      disk block is interlocked
	( RSTS$_NOTMNT, XPO$_NOT_ONLINE ),		! O       disk pack is not mounted
	( RSTS$_PAKLCK, XPO$_FILE_LOCK ),		! O DR    disk pack is locked out
	( RSTS$_BADCLU, XPO$_BAD_SPEC, XPO$_BAD_ATTR ),	! O DR    illegal cluster size
	( RSTS$_PRIVAT, XPO$_BAD_DEVICE,XPO$_PROTECTED),! O DR    disk pack is private
	( RSTS$_INTPAK, XPO$_BAD_MEDIA ),		! O DR    disk pack needs cleaning
	( RSTS$_SATTBD, XPO$_CORRUPTED ) );		! O DR    corrupted file structure
   
!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    XPO$BUILD_SPEC;					! File-spec resolution routine


%TITLE 'XRST$SPEC_SETUP - File-spec Setup'
GLOBAL ROUTINE XRST$SPEC_SETUP( iob ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine builds a resultant file specification and sets up the FIRQB with
!	this information.
!
! FORMAL PARAMETERS:
!
!	iob - address of an IOB
!
! IMPLICIT INPUTS:
!
!	Information contained in or pointed to by the caller's IOB
!
! IMPLICIT OUTPUTS:
!
!	The IOB resultant file-spec descriptor is setup.
!
! COMPLETION CODES:
!
!	XPO$_NORMAL - setup was successfully completed
!
!	XPO$_BAD_RSLT - invalid resultant file specification
!	failure completion codes from XPO$BUILD_SPEC
!	failure completion codes from XRST$ERROR
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
    	iob :  REF $XPO_IOB();

    BIND
    	resultant_string = iob[IOB$T_RESULTANT] :  $STR_DESCRIPTOR();	
!
! Build a resultant file specification from the specification passed by the caller.
!

    IF NOT XPO$BUILD_SPEC( .iob )			! Build a resultant file specification.
    THEN
    	RETURN .iob[IOB$G_COMP_CODE];

!
! Parse the resultant file-spec into its individual components and save it in the FIRQB.
!

    $XRSTS_INI_FIRQB;					! Initialize the FIRQB.
    $XRSTS_INI_XRB;					! Initialize the XRB.
    							! Setup the XRB:
    $XRSTS_XRB[XRLEN] = .resultant_string[STR$H_LENGTH];!    length of file-spec
    $XRSTS_XRB[XRBC] = .resultant_string[STR$H_LENGTH];	!    length of file-spec
    $XRSTS_XRB[XRLOC] = .resultant_string[STR$A_POINTER];!   starting address of the string

    $FSS;						! Parse the file specification
    IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0			! Report any file parsing errors.
    THEN
    	BEGIN
    	XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] );
    	RETURN .iob[IOB$G_COMP_CODE];
    	END;

    IF .$XRSTS_XRB[XRBC]				! If there are untranslated characters return an error.
    THEN
        RETURN XPO$_BAD_RSLT;

!
! Return to the caller.
!

    RETURN XPO$_NORMAL;

    END;

%TITLE 'XRST$ASSIGN_CH - Channel assignment routine'
GLOBAL ROUTINE XRST$ASSIGN_CH( iob ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine assigns a channel number.
!
! FORMAL PARAMETERS:
!
!	iob - address of an IOB
!
! IMPLICIT INPUTS:
!
!	Information contained in or pointed to by the caller's IOB
!
! IMPLICIT OUTPUTS:
!
!	The IOB channel field is setup.
!
! COMPLETION CODES:
!
!	XPO$_NORMAL - setup was successfully completed
!
!	XPO$_NO_CHANNEL - no I/O channel is available
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
    	iob :  REF $XPO_IOB();

!
! Assign an I/O channel.
!

    INCR channel FROM 1 TO maximum_chan+1 DO		! Search for an unused I/O channel.
    	BEGIN						
    	IF .channel GTR maximum_chan			! If all channels have been assigned,
    	THEN						!
    	    RETURN XPO$_NO_CHANNEL;			! return an error code to the caller.

    	IF NOT .channel_vector[.channel]		! If this channel is not assigned,
    	THEN						!
    	    BEGIN					!
    	    channel_vector[.channel] = yes;		! indicate that this channel is in use,
    	    iob[IOB$H_CHANNEL] = .channel;		! save the number in the IOB,
    	    EXITLOOP;					! and exit the search loop.
    	    END;
    	END;

!
! Return to the caller.
!

    RETURN XPO$_NORMAL;

    END;

%TITLE 'XRST$IN - File Input Processing'
GLOBAL ROUTINE XRST$IN( iob ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine allocates an input buffer ( if 1st time through ) and fills the
!	input buffer.
!
! FORMAL PARAMETERS:
!
!	iob - address of XPORT IOB
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	For error conditions, other than XPO$_END_FILE, the following IOB field is set: 
!	    iob[IOB$G_COMP_CODE] 
!
! COMPLETION CODES:
!
!	XPO$_NORMAL - input buffer has been filled sucessfully
!	XPO$_END_FILE - end-of-file reached and no input in buffer
!	XPO$_GET_MEM - buffer allocation error
!		(IOB$G_2ND_CODE = completion code from $XPO_GET_MEM )
!	failure completion codes from XRST$ERROR
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

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

    BIND
	buffer_cb = .iob[IOB$A_RSTS_CB] :  $XRSTS_CB,	! Buffer control block
	channel  = .iob[IOB$H_CHANNEL];

!
! Allocate an input buffer if first input.
!

    IF .buffer_cb[XRSTS$A_BFADR] EQL 0			! If this is the first input
	THEN						!
	    $XPO_IF_NOT( $XPO_GET_MEM(			! allocate an input buffer.
			 FULLWORDS = XRSTS$K_BUFF_SZ,
			 RESULT = buffer_cb[XRSTS$A_BFADR],
			 FAILURE = 0) )
	    THEN
		$XPO_RETURN( GET_MEM, (.$XPO_STATUS) );
    	    
    
!
! Fill the input buffer.
!

    $XRSTS_INI_FIRQB;					! Initialize the FIRQB.
    $XRSTS_INI_XRB;					! Initialize the XRB.

    							! Set up the XRB:
    $XRSTS_XRB[XRLEN] = XRSTS$K_BUFF_SZ * %UPVAL;	!    size of buffer in bytes
    $XRSTS_XRB[XRLOC] = .buffer_cb[XRSTS$A_BFADR];	!    starting address of buffer
    $XRSTS_XRB[XRCI] = channel * 2;			!    channel number times two

    $READ;						! Fill the input buffer.

    IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0			! Report any error conditions.
    THEN
    	BEGIN
    	IF .$XRSTS_FIRQB[FQIOSTS] NEQ RSTS$_EOF
    	THEN
    	    BEGIN
    	    XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] );
    	    RETURN .iob[IOB$G_COMP_CODE];
    	    END
    	ELSE
    	    IF .$XRSTS_XRB[XRBC] EQL 0			! Only report the end-of-file condition
    	    THEN					! if there isn't any data.
    		RETURN XPO$_END_FILE;
    	END;
    
    IF .iob[IOB$V_RECORD] AND				! Update the byte count if we have a record format file
    	( .buffer_cb[XRSTS$V_RECF] EQL RSTS$K_FIXED OR
    	  .buffer_cb[XRSTS$V_RECF] EQL RSTS$K_VARIABLE OR
    	  .buffer_cb[XRSTS$V_RECF] EQL RSTS$K_VFC )
    THEN						! and we're looking at the last block.
    	IF ( .$XRSTS_XRB[XRBLKM] EQL .buffer_cb[XRSTS$G_AT5] ) AND
    	   ( .$XRSTS_XRB[XRBLK] EQL .buffer_cb[XRSTS$G_AT6] )
    	THEN
    	    $XRSTS_XRB[XRBC] = .buffer_cb[XRSTS$G_AT7];

!
! Update the input buffer control_block
!

    buffer_cb[XRSTS$G_BFCTR] = .$XRSTS_XRB[XRBC];	! Save the number of characters read.
    buffer_cb[XRSTS$A_BFPTR] =
    		 CH$PTR(.buffer_cb[XRSTS$A_BFADR]);	! Save a character pointer to the buffer.

    RETURN XPO$_NORMAL
    END;


%TITLE 'XRST$OUT - File Output Processing'
GLOBAL ROUTINE XRST$OUT( iob ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine allocates an output buffer the first time it is called.
!	From then on it outputs the output buffer to the file associated with the channel.
!
! FORMAL PARAMETERS:
!
!	iob - address of XPORT IOB
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	The output buffer control_block (IOB$A_BUFFER_CB) is updated.
!
!	For certain error conditions the following IOB fields are set: 
!	    iob[IOB$G_COMP_CODE] 
!	    iob[IOB$G_2ND_CODE] 
!
! COMPLETION CODES:
!
!	XPO$_NORMAL - empty buffer or
!		      output buffer has been allocated or
!		      output buffer has been output sucessfully
!	XPO$_GET_MEM - buffer allocation error
!		( IOB$G_2ND_CODE = completion code from $XPO_GET_MEM )
!	failure completion codes from XRST$ERROR
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
	iob :  REF $XPO_IOB();

    BIND
	buffer_cb = .iob[IOB$A_RSTS_CB] :  $XRSTS_CB,	! Redefine the IOB
	channel  = .iob[IOB$H_CHANNEL];

!
! Just allocate an output buffer the first time through.
!

    IF .buffer_cb[XRSTS$A_BFADR] EQL 0
    THEN
	BEGIN
	$XPO_IF_NOT( $XPO_GET_MEM(
			FULLWORDS = XRSTS$K_BUFF_SZ,
			RESULT = buffer_cb[XRSTS$A_BFADR],
			FAILURE = 0) )
	THEN
	    $XPO_RETURN( GET_MEM, (.$XPO_STATUS) );

       	END
    ELSE

!
! Otherwise, output the buffer.
!

	BEGIN

        IF .buffer_cb[XRSTS$G_BFCTR] EQL 		! If there isn't any data in the buffer,
    			(XRSTS$K_BUFF_SZ * %UPVAL)	!
    	THEN						!
    	    RETURN XPO$_NORMAL;				! return a success code to the caller.  
    
        $XRSTS_INI_FIRQB;				! Initialize the FIRQB.
        $XRSTS_INI_XRB;					! Initialize the XRB.

    							! Set up the XRB:
        $XRSTS_XRB[XRLEN] = XRSTS$K_BUFF_SZ * %UPVAL;	!    size of buffer in bytes
        $XRSTS_XRB[XRBC] = XRSTS$K_BUFF_SZ * %UPVAL;	!    number of bytes to be written ( For disk must be multiple of 512 )
        $XRSTS_XRB[XRLOC] = .buffer_cb[XRSTS$A_BFADR];	!    starting address of buffer
        $XRSTS_XRB[XRCI] = channel * 2;			!    channel number times two

        $WRITE;						! Output the buffer

        IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0			! Report any error conditions.
        THEN
            BEGIN
       	    XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] );
    	    RETURN .iob[IOB$G_COMP_CODE];
    	    END;
	END;

!
! Clear out the output buffer.
!

    INCR index FROM 0 TO (XRSTS$K_BUFF_SZ ^ 1) -1 BY 2 DO! Make sure to start off with an empty output buffer.
	( .buffer_cb[XRSTS$A_BFADR] + .index ) = 0;

!
! Update the  output buffer control_block.
!

    buffer_cb[XRSTS$G_BFCTR] = XRSTS$K_BUFF_SZ * %UPVAL;
    buffer_cb[XRSTS$A_BFPTR] = CH$PTR(.buffer_cb[XRSTS$A_BFADR]);

    RETURN XPO$_NORMAL
    END;

%TITLE 'XRST$GET_FILE - Disk File Read'
GLOBAL ROUTINE XRST$GET_FILE( iob, value_pointer ) =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine reads a single character from a disk
!	file and returns this character to the caller.
!
! FORMAL PARAMETERS:
!
!	iob - address of XPORT IOB
!	value_pointer - address of character deposit area
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	For certain error conditions, other than XPO$_END_FILE, the following IOB fields are set:
!		iob[IOB$G_COMP_CODE]
!		iob[IOB$G_2ND_CODE]
!
! COMPLETION CODES:
!
!	XPO$_NORMAL - character successfully read
!	XPO$_END_FILE - end-of-file reached
!	failure completion codes from XRST$IN
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

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

    BIND
	buffer_cb = .iob[IOB$A_RSTS_CB] :  $XRSTS_CB;	! TOPS-10/TOPS-20 buffer control block

!
! Fill the system input buffer if necessary.
!

    buffer_cb[XRSTS$G_BFCTR]=.buffer_cb[XRSTS$G_BFCTR]-1;! Decrement the input buffer count.

    IF .buffer_cb[XRSTS$G_BFCTR] LSS 0			! If the buffer was empty,
    THEN						!
	SELECTONE XRST$IN( .iob ) OF			! fill the next input buffer.
	    SET						

	    [ XPO$_NORMAL ] :				! Successful input:
		buffer_cb[XRSTS$G_BFCTR] =		!    Decrement the new byte count.
			 .buffer_cb[XRSTS$G_BFCTR] -1;

	    [ XPO$_END_FILE ]:				! End-of-file:
		RETURN XPO$_END_FILE;			!    Return error to caller.

	    [ OTHERWISE ]:				! All other error conditions:
		RETURN .iob[IOB$G_COMP_CODE];		!    Return the final completion code to the caller.

	    TES;

!
! Pass a single character or value back to the caller.
!

    .value_pointer =
    		 CH$RCHAR_A( buffer_cb[XRSTS$A_BFPTR] );! Pass back a character.

!
! Return to the caller
!

    RETURN XPO$_NORMAL					! Return a success code to the caller.

    END;

%TITLE  'XRST$CLOSE - Close Processing'
GLOBAL ROUTINE XRST$CLOSE( iob ) = 

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine checks to see if output is being done and if so,
!	all data in the buffers that has not been transmitted to the
!	device is written to the device.
!
!	It gives back any dynamic memory allocated for the I/O buffers
!	and it closes the file and releases the channel.
!
! FORMAL PARAMETERS:
!
!	iob - address of XPORT IOB
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	The buffer control_block (IOB$A_BUFFER_CB) is zeroed out.
!
!	For certain error conditions the following IOB fields are set: 
!	    iob[IOB$G_COMP_CODE] 
!	    iob[IOB$G_2ND_CODE] 
!
! COMPLETION CODES:
!
!	XPO$_NORMAL - file has been closed successfully
!	XPO$_FREE_MEM - error deallocating IOB-related memory
!		( IOB$G_2ND_CODE = completion code from $XPO_FREE_MEM )
!	failure completion codes from XRST$OUT
!	failure completion codes from XRST$ERROR
!	
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

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

    BIND
	buffer_cb = .iob[IOB$A_RSTS_CB] :  $XRSTS_CB,
	channel = .iob[IOB$H_CHANNEL];

!
! Transmit any leftover data if doing output.
!

    IF .buffer_cb[XRSTS$A_BFADR] NEQ 0			! Make sure we've allocated a buffer.
    THEN
	BEGIN
	IF .iob[IOB$V_OUTPUT]				! If we're doing output,
	THEN						!
	    IF NOT XRST$OUT( .iob )			! clear out all data from the buffer.
	    THEN
	        RETURN .iob[IOB$G_COMP_CODE];		! Report any error to the caller.

!
! Free the internal XPORT I/O buffer.
!

    $XPO_IF_NOT( $XPO_FREE_MEM(
		 BINARY_DATA = (XRSTS$K_BUFF_SZ, .buffer_cb[XRSTS$A_BFADR]),
		 FAILURE = 0) )
    THEN
	$XPO_RETURN( FREE_MEM, (.$XPO_STATUS) );

    END;						

!
! Close the file and release the channel.
!

    $XRSTS_INI_FIRQB;					! Initialize the FIRQB.

    							! Set up the FIRQB:
    $XRSTS_FIRQB[FQFUN] = CLSFQ;			!    function code
    $XRSTS_FIRQB[FQFIL] = channel * 2;			!    channel number times 2

    $CALFIP;						! Close the file and release the channel.

    IF .$XRSTS_FIRQB[FQIOSTS] NEQ 0			! If an error occurred:
    THEN						!
        BEGIN						!    
	XRST$ERROR( .iob, .$XRSTS_FIRQB[FQIOSTS] );	!    convert the RSTS error to an XPORT error code
    							!    set up the FIRQB:
        $XRSTS_INI_FIRQB;				!        initialize it
    	$XRSTS_FIRQB[FQFUN] = RSTFQ;			!	 function code
    	$XRSTS_FIRQB[FQFIL] = channel * 2;		!	 channel number times two
    							!
    	$CALFIP;					!    force a close on the channel
	RETURN .iob[IOB$G_COMP_CODE];			!    return the error code to the caller
    	END;

    RETURN XPO$_NORMAL

    END;

%TITLE 'XRST$ERROR - RSTS-to-XPORT Code Conversion'

GLOBAL ROUTINE XRST$ERROR( iob, rsts_sts ) :  NOVALUE =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine converts a RSTS/E failure completion code into
!	an equivalent XPORT completion code.
!
! FORMAL PARAMETERS:
!
!	iob - address of an IOB
!	rsts_sts - RSTS/E error code

!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	iob[IOB$G_COMP_CODE] = XPORT completion code
!	iob[IOB$G_2ND_CODE] = XPORT completion code (in some cases)
!
! COMPLETION CODES:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

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

!
! Convert the RSTS/E error code into an equivalent XPORT completion code.
!

    INCR index FROM 1 TO rsts_to_xport[0] BY 3 DO	! Loop through the conversion table.

	IF .rsts_sts EQL .rsts_to_xport[.index]		! If the RSTS/E code is found
	THEN						!
	    BEGIN					!
	    iob[IOB$G_COMP_CODE] =			! use the equivalent XPORT completion code
			.rsts_to_xport[.index+1];	! as the primary IOB completion code
	    iob[IOB$G_2ND_CODE] =			! and set the IOB secondary code to be
			.rsts_to_xport[.index+2];	! an XPORT completion code.
	    RETURN					! Return to the caller after code translation.
	    END;

!
! Return a system error completion code if an unexpected RSTS/E error occurs.
!

	iob[IOB$G_COMP_CODE] = XPO$_SYS_ERROR;		! Indicate an XPORT system error
	iob[IOB$G_2ND_CODE] = .rsts_sts;		! and save the primary RSTS/E completion code.

	RETURN						! Return to the caller.

	END;

%TITLE 'XRST$FIXUP - RSTS Channel Cleanup'
GLOBAL ROUTINE XRST$FIXUP( iob ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine releases the channel number and frees the buffer control block.
!
! FORMAL PARAMETERS:
!
!	iob - address of an IOB
!
! IMPLICIT INPUTS:
!
!	iob[IOB$H_CHANNEL] - channel number
!
! IMPLICIT OUTPUTS:
!
!	iob[IOB$H_CHANNEL] - zeroed out
!	iob[IOB$A_RSTS_CB] -zeroed out
!
! COMPLETION CODES:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

    BEGIN

    MAP
    	iob :  REF $XPO_IOB();

!
! Initialize the channel information.
!

    channel_vector[.iob[IOB$H_CHANNEL]] = no;			! Release the assigned channel.
    iob[IOB$H_CHANNEL] = 0;					! Reset the channel in the IOB.

!
! Free the RSTS/E control block.
!

    IF .iob[IOB$A_RSTS_CB] NEQ 0
    THEN
    	BEGIN
        $XPO_IF_NOT( $XPO_FREE_MEM(
    		  BINARY_DATA = (XRSTS$K_CB_LEN, .iob[IOB$A_RSTS_CB], UNITS),
    		  FAILURE = 0 ) )
    	THEN
    	    RETURN .$XPO_STATUS;
    	
        iob[IOB$A_RSTS_CB] = 0;					! Indicate that the control block no longer exists.
    	END;

!
! Return to the caller.
!

    RETURN XPO$_NORMAL

    END;

END
ELUDOM