MODULE KERFIL (IDENT = '1.0.001'
		) =
BEGIN

!++
! FACILITY:
!	KERMIT-32 Microcomputer to mainframe file transfer utility.
!
! ABSTRACT:
!	KERFIL contains all of the file processing for KERMIT-32.  This
!	module contains the routines to input/output characters to files
!	and to open and close the files.
!
! ENVIRONMENT:
!	VAX/VMS user mode.
!
! AUTHOR: Robert C. McQueen, CREATION DATE: 28-March-1983
!
!--

%SBTTL 'Table of Contents'
%SBTTL 'Revision History'

!++
!
! 1.0.000	By: Robert C. McQueen		On: 28-March-1983
!		Create this module.
! 1.0.001	By: Robert C. McQueen		On:  4-May-1983
!		Remove <FF> checks on the PUT_FILE routine.
!
!--

%SBTTL 'Forward definitions'

FORWARD ROUTINE
    FILE_DUMP,				! Dump the contents of the record
    DUMP_BUFFER,			! Worker routine for FILE_DUMP.
    FILE_ERROR : NOVALUE;		! Error processing routine

%SBTTL 'Require/Library files'
!
! INCLUDE FILES:
!

LIBRARY 'SYS$LIBRARY:STARLET';

REQUIRE 'KERCOM.REQ';

REQUIRE 'KERERR.REQ';

%SBTTL 'Macro definitions'
!
! MACROS:
!
	%SBTTL	'Literal symbol definitions'

!
! EQUATED SYMBOLS:
!
!
! Various states for reading the data from the file
!

LITERAL
    F_STATE_PRE = 0,				! Prefix state
    F_STATE_PRE1 = 1,				! Other prefix state
    F_STATE_DATA = 2,				! Data processing state
    F_STATE_POST = 3,				! Postfix processing state
    F_STATE_POST1 = 4,				! Secondary postfix processing state
    F_STATE_MIN = 0,				! Min state number
    F_STATE_MAX = 4;				! Max state number

%SBTTL 'Local storage'
!
! OWN STORAGE:
!

OWN
    EOF_FLAG,				! End of file reached.
    STATUS,				! Status returned by RMS calls
    					!  used in the FIL_ERROR routine
    FILE_FAB : $FAB_DECL,		! FAB for file processing
    FILE_NAM : $NAM_DECL,		! NAM for file processing
    FILE_RAB : $RAB_DECL,		! RAB for file processing

    FILE_MODE,				! Mode of file (reading/writing)
    FILE_REC_POINTER,			! Pointer to the record information
    FILE_REC_COUNT,			! Count of the number of bytes
    FILE_RECORD : VECTOR [CH$ALLOCATION (MAX_REC_LENGTH)],

    EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)],
    RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)],
    RES_STR_D : BLOCK [8, BYTE];	! Descriptor for the string

%SBTTL 'Global storage'
!
! Global storage:
!

GLOBAL
    FILE_TYPE,					! Type of file being xfered
    FILE_DESC : BLOCK [8, BYTE];		! File name descriptor

%SBTTL 'External routines and storage'
!
! EXTERNAL REFERENCES:
!
!
! Storage in KERMSG
!

EXTERNAL
    FILE_SIZE,					! Number of characters in FILE_NAME
    FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)];

!
! System libraries
!

EXTERNAL ROUTINE
    LIB$SIGNAL			: ADDRESSING_MODE(GENERAL) NOVALUE;

%SBTTL 'File processing -- FILE_INIT - Initialization'

GLOBAL ROUTINE FILE_INIT : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will initialize some of the storage in the file processing
!	module.
!
! CALLING SEQUENCE:
!
!	FILE_INIT();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN
    FILE_TYPE = FILE_ASC;
! Now set up the file specification descriptor
    FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    FILE_DESC [DSC$A_POINTER] = FILE_NAME;
    FILE_DESC [DSC$W_LENGTH] = 0;
    EOF_FLAG = FALSE;
    END;					! End of FILE_INIT

%SBTTL 'GET_FILE'

GLOBAL ROUTINE GET_FILE (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will return a character from the input file.
!	The character will be stored into the location specified by
!	CHARACTER.
!
! CALLING SEQUENCE:
!
!	GET_FILE (LOCATION_TO_STORE_CHAR);
!
! INPUT PARAMETERS:
!
!	LOCATION_TO_STORE_CHAR - This is the address to store the character
!		into.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUTPUT PARAMETERS:
!
!	Character stored into the location specified.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	True - Character stored into the location specified.
!	False - End of file reached.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    OWN
	CC_COUNT,				! Count of the number of CC things to output
	CC_TYPE;				! Type of carriage control being processed.

    LOCAL
	RAT;

    IF .EOF_FLAG THEN RETURN KER_EOF;

    RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK);
    RETURN

	WHILE TRUE DO
	    BEGIN

	    SELECTONE .RAT OF
		SET

		[FAB$M_PRN, FAB$M_FTN, FAB$M_CR] :

		    CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF
			SET

			[F_STATE_PRE] :
			    BEGIN
			    STATUS = $GET (RAB = FILE_RAB);

			    IF NOT .STATUS
			    THEN

				IF .STATUS EQL RMS$_EOF
				THEN
				    BEGIN
				    EOF_FLAG = TRUE;
				    EXITLOOP KER_EOF;
				    END
				ELSE
				    BEGIN
				    FILE_ERROR ();
				    EOF_FLAG = TRUE;
				    EXITLOOP KER_RMS32;
				    END;

			    FILE_REC_POINTER = CH$PTR (FILE_RECORD);
			    FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];

			    SELECTONE .RAT OF
				SET

				[FAB$M_CR] :
				    BEGIN
				    .CHARACTER = CHR_LFD;
				    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
				    EXITLOOP KER_NORMAL;
				    END;

				[FAB$M_PRN] :
				    BEGIN
				    CC_COUNT = CH$RCHAR_A (FILE_REC_POINTER);
				    CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER);
				    FILE_REC_COUNT = .FILE_REC_COUNT - 2;

				    IF .CC_COUNT<6, 1> EQL 0
				    THEN
					BEGIN

					IF .CC_COUNT<0, 6> NEQ 0
					THEN
					    BEGIN
					    .CHARACTER = CHR_LFD;
					    FILE_FAB [FAB$L_CTX] = F_STATE_PRE1;
					    EXITLOOP KER_NORMAL;
					    END
					ELSE
					    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

					END
				    ELSE
					BEGIN

					SELECTONE .CC_COUNT<4, 2> OF
					    SET

					    [%B'00'] :
						BEGIN
						.CHARACTER = .CC_COUNT<0, 4>;
						FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
						EXITLOOP KER_NORMAL;
						END;

					    [%B'10'] :
						BEGIN
						.CHARACTER = .CC_COUNT<0, 4> + 128;
						FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
						EXITLOOP KER_NORMAL;
						END;

					    [OTHERWISE, %B'11'] :
						EXITLOOP KER_ILLFILTYP;
					    TES;

					END;

				    END;

				[FAB$M_FTN] :
				    BEGIN
				    CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER);
				    FILE_REC_COUNT = .FILE_REC_COUNT - 1;

				    SELECTONE .CC_TYPE OF
					SET

					[CHR_NUL] :
					    BEGIN
					    .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
					    FILE_REC_COUNT = .FILE_REC_COUNT - 1;
					    END;

					[%C'$', %C' ', OTHERWISE] :
					    BEGIN
					    .CHARACTER = CHR_LFD;
					    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
					    END;

					[%C'0'] :
					    BEGIN
					    .CHARACTER = CHR_LFD;
					    FILE_FAB [FAB$L_CTX] = F_STATE_PRE1;
					    CC_COUNT = 1;
					    END;

					[%C'1'] :
					    BEGIN
					    .CHARACTER = CHR_FFD;
					    EXITLOOP KER_NORMAL;
					    END;

					[%C'+'] :
					    BEGIN
					    .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
					    FILE_REC_COUNT = .FILE_REC_COUNT - 1;
					    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
					    END;
					TES;

				    EXITLOOP KER_NORMAL;
				    END;
				TES;

			    END;

			[F_STATE_PRE1] :

			    IF .RAT EQL FAB$M_FTN OR .RAT EQL FAB$M_PRN
			    THEN
				BEGIN
				.CHARACTER = CHR_LFD;
				CC_COUNT = .CC_COUNT - 1;

				IF .CC_COUNT EQL 0 AND .RAT EQL FAB$M_FTN
				THEN
				    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

				EXITLOOP KER_NORMAL;
				END
			    ELSE
				EXITLOOP KER_ILLFILTYP;

			[F_STATE_DATA] :
			    BEGIN
			    IF .FILE_REC_COUNT EQL 0 THEN
				FILE_FAB[FAB$L_CTX] = F_STATE_POST
			    ELSE
				BEGIN
				.CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
				FILE_REC_COUNT = .FILE_REC_COUNT - 1;
				EXITLOOP KER_NORMAL;
				END;
			    END;

			[F_STATE_POST] :
			    BEGIN

			    SELECTONE .RAT OF
				SET

				[FAB$M_CR] :
				    BEGIN
				    .CHARACTER = CHR_CRT;
				    FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
				    EXITLOOP KER_NORMAL;
				    END;

				[FAB$M_FTN] :
				    BEGIN
				    FILE_FAB [FAB$L_CTX] = F_STATE_PRE;

				    IF .CC_TYPE NEQ CHR_NUL AND .CC_TYPE NEQ %C'$'
				    THEN
					BEGIN
					.CHARACTER = CHR_CRT;
					EXITLOOP KER_NORMAL;
					END;

				    END;

				[FAB$M_PRN] :
				    BEGIN

				    IF .CC_TYPE<6, 1> EQL 0
				    THEN
					BEGIN

					IF .CC_COUNT<0, 6> NEQ 0
					THEN
					    BEGIN
					    .CHARACTER = CHR_LFD;
					    FILE_FAB [FAB$L_CTX] = F_STATE_POST1;
					    EXITLOOP KER_NORMAL;
					    END
					ELSE
					    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

					END
				    ELSE
					BEGIN

					SELECTONE .CC_TYPE<4, 2> OF
					    SET

					    [%B'00'] :
						BEGIN
						.CHARACTER = .CC_TYPE<0, 4>;
						FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
						EXITLOOP KER_NORMAL;
						END;

					    [%B'10'] :
						BEGIN
						.CHARACTER = .CC_TYPE<0, 4> + 128;
						FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
						EXITLOOP KER_NORMAL;
						END;

					    [OTHERWISE, %B'11'] :
						EXITLOOP KER_ILLFILTYP;
					    TES;

					END;

				    END;
				TES;		! End SELECTONE .RAT

			    END;

			[F_STATE_POST1] :

			    IF .RAT EQL FAB$M_PRN
			    THEN
				BEGIN
				.CHARACTER = CHR_LFD;
				CC_COUNT = .CC_COUNT - 1;

				IF .CC_COUNT EQL 0 AND .RAT EQL FAB$M_FTN
				THEN
				    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

				IF .CC_COUNT EQL -1 AND .RAT EQL FAB$M_PRN
				THEN
				    BEGIN
				    .CHARACTER = CHR_CRT;
				    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
				    END;

				EXITLOOP KER_NORMAL;
				END
			    ELSE
				EXITLOOP KER_ILLFILTYP;

			TES;			! End of CASE .STATE

		[OTHERWISE] :
		    BEGIN

		    WHILE .FILE_REC_COUNT LEQ 0 DO
			BEGIN
			FILE_REC_POINTER = CH$PTR (FILE_RECORD);
			STATUS = $GET (RAB = FILE_RAB);

			IF NOT .STATUS
			THEN

			    IF .STATUS EQL RMS$_EOF
			    THEN
				BEGIN
				EOF_FLAG = TRUE;
				EXITLOOP KER_EOF;
				END
			    ELSE
				BEGIN
				FILE_ERROR ();
				EOF_FLAG = TRUE;
				EXITLOOP KER_RMS32;
				END;

			FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];
			END;

		    FILE_REC_COUNT = .FILE_REC_COUNT - 1;
		    .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
		    EXITLOOP KER_NORMAL;
		    END;
		TES;				! End of SELECTONE .RAT

	    END;				! End WHILE TRUE DO loop

    END;					! End of GET_FILE

%SBTTL 'PUT_FILE'

GLOBAL ROUTINE PUT_FILE (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will store a character into the record buffer
!	that we are building.  It will output the buffer to disk
!	when the end of line characters are found.
!
! CALLING SEQUENCE:
!
!	STATUS = PUT_FILE(Character);
!
! INPUT PARAMETERS:
!
!	Character - Address of the character to output in the file.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUTPUT PARAMETERS:
!
!	Status - True if no problems writing the character
!		 False if there were problems writing the character.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    SELECTONE .FILE_TYPE OF
    SET
    [FILE_ASC] :
	BEGIN
	IF .CHARACTER EQL CHR_LFD OR .CHARACTER EQL CHR_NUL THEN
	    RETURN KER_NORMAL;

	IF .CHARACTER EQL CHR_CRT THEN RETURN DUMP_BUFFER();

	IF .FILE_REC_COUNT EQL MAX_REC_LENGTH THEN
	    BEGIN
	    LIB$SIGNAL (KER_REC_TOO_BIG);
	    RETURN KER_REC_TOO_BIG;
	    END;

	FILE_REC_COUNT = .FILE_REC_COUNT + 1;
	CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);

	END;

    [FILE_BIN] :
	BEGIN

	IF .FILE_REC_COUNT EQL MAX_REC_LENGTH THEN
	    BEGIN
	    LIB$SIGNAL (KER_REC_TOO_BIG);
	    RETURN KER_REC_TOO_BIG;
	    END;

	FILE_REC_COUNT = .FILE_REC_COUNT + 1;
	CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER);
	END;
    TES;
    RETURN KER_NORMAL;
    END;		! End of PUT_FILE
	%SBTTL	'FILE_DUMP - Output a record to the disk.'

GLOBAL ROUTINE FILE_DUMP =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will dump the contents of the current record into the
!	user's file.  It will return the status of the operation.
!
! CALLING SEQUENCE:
!
!	FILE_DUMP ();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	FILE_REC_COUNT - Count of the number of characters in the record
!	FILE_RECORD - Record to output.
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	KER_NORMAL - Did ok.
!	KER_RMS32 - RMS-32 error.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN
    IF .FILE_TYPE EQL FILE_BIN THEN 
	RETURN DUMP_BUFFER()
    ELSE
	RETURN KER_NORMAL;
    END;					! End of FILE_DUMP

	%SBTTL	'DUMP_BUFFER - Dump the current record to disk'

ROUTINE DUMP_BUFFER =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will dump the current record to disk.  It doesn't
!	care what type of file you are writing, unlike FILE_DUMP.
!
! CALLING SEQUENCE:
!
!	STATUS = DUMP_BUFFER();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	KER_NORMAL - Output went ok.
!	KER_RMS32 - RMS-32 error.
!
! SIDE EFFECTS:
!
!	None.
!
!--

BEGIN
!
! First update the record length
!
    FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
!
! Now output the record to the file
!
    STATUS = $PUT (RAB = FILE_RAB);
!
! Update the pointers first
!
    FILE_REC_COUNT = 0;
    FILE_REC_POINTER = CH$PTR (FILE_RECORD);
!
! Now determine if we failed attempting to write the record
!
    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR ();
	RETURN KER_RMS32
	END;
    RETURN KER_NORMAL
END;				! End of DUMP_BUFFER
%SBTTL 'OPEN_READING'
ROUTINE OPEN_READING =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will open a file for reading.  It will return either
!	true or false to the called depending on the success of the
!	operation.
!
! CALLING SEQUENCE:
!
!	status = OPEN_READING();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN
!
! We now have an expanded file specification that we can use to process
! the file.
!
    $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM);
    STATUS = $OPEN (FAB = FILE_FAB);

    IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF)
    THEN
	BEGIN
	FILE_ERROR ();
	RETURN KER_RMS32;
	END;

!
! Initialize the RAB for the $CONNECT RMS call
!
    $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = FILE_RECORD, USZ = MAX_REC_LENGTH);
    STATUS = $CONNECT (RAB = FILE_RAB);

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR ();
	RETURN KER_RMS32;
	END;

    FILE_REC_COUNT = -1;
    FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
    RETURN KER_NORMAL;
    END;					! End of OPEN_READING
%SBTTL 'FILE_OPEN'

GLOBAL ROUTINE FILE_OPEN (FUNCTION) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will open a file for reading or writing depending on
!	the function that is passed this routine.  It will handle wildcards
!	on the read function.
!
! CALLING SEQUENCE:
!
!	status = FILE_OPEN(FUNCTION);
!
! INPUT PARAMETERS:
!
!	FUNCTION - Function to do.  Either FNC_READ or FNC_WRITE.
!
! IMPLICIT INPUTS:
!
!	FILE_NAME and FILE_SIZE set up with the file name and the length
!	of the name.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	FILE_NAME and FILE_SIZE set up with the file name and the length
!	of the name.
!
! COMPLETION CODES:
!
!	KER_NORMAL - File opened correctly.
!	KER_RMS32 - Problem processing the file.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	SIZE : WORD,				! Length returned by $FAO
	TEMP1_DESC : BLOCK [8, BYTE],		! I/O descriptor
	TEMP2_DESC : BLOCK [8, BYTE];		! I/O descriptor

!
! Now do the function dependent processing
!
    FILE_MODE = .FUNCTION;
    SELECTONE .FUNCTION OF
	SET

	[FNC_READ] :
	    BEGIN
!
! Now set up the FAB with the information it needs.
!
	    $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE, NAM = FILE_NAM);
!
! Now initialize the NAM block
!
	    $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR, ESS = NAM$C_MAXRSS);
!
! First parse the file specification.
!
	    STATUS = $PARSE (FAB = FILE_FAB);

	    IF NOT .STATUS
	    THEN
		BEGIN
		FILE_ERROR ();
		RETURN KER_RMS32;
		END;

	    STATUS = $SEARCH (FAB = FILE_FAB);

	    IF NOT .STATUS
	    THEN
		BEGIN
		FILE_ERROR ();
		RETURN KER_RMS32;
		END;

!
! We now have an expanded file specification that we can use to process
! the file.
!
	    $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM);
	    STATUS = $OPEN (FAB = FILE_FAB);

	    IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF)
	    THEN
		BEGIN
		FILE_ERROR ();
		RETURN KER_RMS32;
		END;

!
! Initialize the RAB for the $CONNECT RMS call
!
	    $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = FILE_RECORD,
		USZ = MAX_REC_LENGTH);
	    STATUS = $CONNECT (RAB = FILE_RAB);

	    IF NOT .STATUS
	    THEN
		BEGIN
		FILE_ERROR ();
		RETURN KER_RMS32;
		END;

	    FILE_REC_COUNT = -1;
	    END;				! End of [FNC_READ]

	[FNC_WRITE] :
	    BEGIN
	    IF .FILE_TYPE EQL FILE_ASC THEN
		BEGIN
		$FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, FNS = .FILE_SIZE,
		FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ORG = SEQ, RFM = VAR,
		RAT = CR);
		END;
	    IF .FILE_TYPE EQL FILE_BIN THEN
		BEGIN
		$FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME,
		FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM,
		ORG = SEQ, RFM = VAR);
		END;
	    $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR, RSS = NAM$C_MAXRSS);
	    STATUS = $CREATE (FAB = FILE_FAB);

	    IF NOT .STATUS
	    THEN
		BEGIN
		FILE_ERROR ();
		RETURN KER_RMS32;
		END;

	    $RAB_INIT(RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = FILE_RECORD,
	    ROP = <NLK, WAT>);
	    STATUS = $CONNECT (RAB = FILE_RAB);
	    IF NOT .STATUS THEN
		BEGIN
		FILE_ERROR ();
		RETURN KER_RMS32;
		END;

	    FILE_REC_COUNT = 0;
	    FILE_REC_POINTER = CH$PTR (FILE_RECORD);
	    END;

	[OTHERWISE] :
	    RETURN KER_INTERNALERR;
	TES;

!
! Initialize the output descriptors.
!
    TEMP1_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    TEMP1_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    TEMP1_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_NAME];
    TEMP1_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_NAME];
    TEMP2_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    TEMP2_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    TEMP2_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_TYPE];
    TEMP2_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_TYPE];
    FILE_DESC [DSC$W_LENGTH] = MAX_FILE_NAME;

    STATUS = $FAO (%ASCID'!AS!AS', SIZE, FILE_DESC, TEMP1_DESC, TEMP2_DESC);
    IF NOT .STATUS THEN
	BEGIN
	LIB$SIGNAL(.STATUS);
	RETURN .STATUS;
	END;

    FILE_SIZE = .SIZE;
    RETURN KER_NORMAL;
    END;					! End of FILE_OPEN

%SBTTL 'FILE_CLOSE'

GLOBAL ROUTINE FILE_CLOSE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will close a file that was opened by FILE_OPEN.
!	It assumes any data associated with the file is stored in this
!	module, since this routine is called by KERMSG.
!
! CALLING SEQUENCE:
!
!	FILE_CLOSE();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    IF .FILE_MODE EQL FNC_WRITE AND .FILE_REC_COUNT NEQ 0 THEN
	BEGIN
	STATUS = DUMP_BUFFER();
	IF NOT .STATUS THEN RETURN .STATUS;
	END;

    STATUS = $CLOSE (FAB = FILE_FAB);

    EOF_FLAG = FALSE;

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR ();
	RETURN KER_RMS32;
	END
    ELSE
	RETURN KER_NORMAL;

    END;					! End of FILE_CLOSE

%SBTTL 'NEXT_FILE'

GLOBAL ROUTINE NEXT_FILE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will cause the next file to be opened.  It will
!	call the RMS-32 routine $SEARCH and $OPEN for the file.
!
! CALLING SEQUENCE:
!
!	STATUS = NEXT_FILE;
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	FAB/NAM blocks set up from previous processing.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	FAB/NAM blocks set up for the next file.
!
! COMPLETION CODES:
!
!	TRUE - There is a next file.
!	KER_RMS32 - No next file.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	TEMP1_DESC : BLOCK [8, BYTE],		! I/O descriptor
	TEMP2_DESC : BLOCK [8, BYTE],		! I/O descriptor
	SIZE : WORD;				! Size of the $FAO string

!
! Now search for the next file that we want to process.
!
    STATUS = $SEARCH (FAB = FILE_FAB);

    IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES;

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR ();
	RETURN KER_RMS32;
	END;

!
! Now we have the new file name.  All that we have to do is open the file
! for reading now.
!
    STATUS = OPEN_READING ();

    IF .STATUS THEN RETURN .STATUS;

!
! Initialize the output descriptors.
!
    TEMP1_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    TEMP1_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    TEMP1_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_NAME];
    TEMP1_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_NAME];
    TEMP2_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    TEMP2_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    TEMP2_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_TYPE];
    TEMP2_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_TYPE];
    FILE_DESC [DSC$W_LENGTH] = MAX_FILE_NAME;
    STATUS = $FAO (%ASCID'!AS!AS', SIZE, FILE_DESC, TEMP1_DESC, TEMP2_DESC);

    IF NOT .STATUS
    THEN
	BEGIN
	LIB$SIGNAL(.STATUS);
	RETURN .STATUS;
	END;

    FILE_SIZE = .SIZE;
    RETURN KER_NORMAL;
    END;					! End of NEXT_FILE

%SBTTL 'FILE_ERROR - Error processing for all RMS errors'
ROUTINE FILE_ERROR : NOVALUE =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will process all of the RMS-32 error returns.  It will
!	get the text for the error and then it will issue a KER_ERROR for
!	the RMS failure.
!
! CALLING SEQUENCE:
!
!	FILE_ERROR();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	STATUS - RMS error status.
!	FILE_NAME - File name and extension.
!	FILE_SIZE - Size of the thing in FILE_NAME.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

BEGIN

LOCAL
    ERR_LENGTH : WORD,			! Length of the text
    ERR_DESC : BLOCK [8, BYTE],
    ERR_BUFFER : VECTOR [CH$ALLOCATION(MAX_MSG)];

    ERR_DESC [DSC$A_POINTER] = ERR_BUFFER;
    ERR_DESC [DSC$W_LENGTH] = MAX_MSG;
    ERR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    ERR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;

    $GETMSG( MSGID = .STATUS, MSGLEN = ERR_LENGTH, BUFADR = ERR_DESC,
	FLAGS = 0);

    ERR_DESC [DSC$W_LENGTH] = .ERR_LENGTH;

    LIB$SIGNAL(KER_RMS32, ERR_DESC, FILE_DESC);
END;					! End of FILE_ERROR
%SBTTL 'End of KERFIL'

END						! End of module

ELUDOM