MODULE KERFIL (IDENT = '3.1.053'
		) =
BEGIN
!<BLF/WIDTH:90>

!++
! 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-April-1983
!		Remove checks for <FF> in the input data stream.
!
! 1.0.002	By: Robert C. McQueen		On: 31-May-1983
!		Fix a bad check in wildcard processing.
!
! 1.0.003	By: Nick Bush			On: 13-June-1983
!		Add default file spec of .;0 so that wild-carded
!		file types don't cause all version of a file to
!		be transferred.
!
! 1.0.004	By: Robert C. McQueen		On: 20-July-1983
!		Strip off the parity bit on the compares for incoming ASCII
!		files.
!
! 1.2.005	By: Robert C. McQueen		On: 15-August-1983
!		Attempt to improve the GET%FILE and make it smaller.
!		Also start the implementation of the BLOCK file processing.
!
! 2.0.006	Release VAX/VMS Kermit-32 version 2.0
!
! 2.0.016	By: Nick Bush			On: 4-Dec-1983
!		Change how binary files are written to (hopefully) improve
!		the performance.  We will now use 510 records and only
!		write out the record when it is filled (instead of writing
!		one record per packet).  This should cut down on the overhead
!		substantially.
!
! 2.0.017	By: Nick Bush			On: 9-Dec-1983
!		Fix processing for VFC format files.  Also fix GET_ASCII
!		for PRN and FTN record types.  Change GET_ASCII so that
!		'normal' CR records get sent with trailing CRLF's instead
!		of <LF>record<CR>.  That was confusing too many people.
!
! 2.0.022	By: Nick Bush			On: 15-Dec-1983
!		Add Fixed record size (512 byte) format for writing files.
!		This can be used for .EXE files.  Also clean up writing
!		ASCII files so that we don't lose any characters.
!
! 2.0.024	By: Robert C. McQueen		On: 19-Dec-1983
!		Delete FILE_DUMP.
!
! 2.0.026	By: Nick Bush			On: 3-Jan-1983
!		Add options for format of file specification to be
!		sent in file header packets.  Also type out full file
!		specification being sent/received instead of just
!		the name we are telling the other end to use.
!
! 2.0.030	By: Nick Bush			On: 3-Feb-1983
!		Add the capability of receiving a file with a different
!		name than given by KERMSG.  The RECEIVE and GET commands
!		now really are different.
!
! 2.0.035	By: Nick Bush				On: 8-March-1984
!		Add LOG SESSION command to set a log file for CONNECT.
!		While we are doing so, clean up the command parsing a little
!		so that we don't have as many COPY_xxx routines.
!
! 2.0.036	By: Nick Bush				On: 15-March-1984
!		Fix PUT_FILE to correctly handle carriage returns which are
!		not followed by line feeds.  Count was being decremented
!		Instead of incremented.
!
! 2.0.040	By: Nick Bush				On: 22-March-1984
!		Fix processing of FORTRAN carriage control to handle lines
!		which do not contain the carriage control character (i.e., zero
!		length records).  Previously, this type of record was sending
!		infinite nulls.
!
! 3.0.045	Start of version 3.
!
! 3.0.046	By: Nick Bush				On: 29-March-1984
!		Fix debugging log file to correctly set/clear file open
!		flag.  Also make log files default to .LOG.
!
! 3.0.050	By: Nick Bush				On: 2-April-1984
!		Add SET SERVER_TIMER to determine period between idle naks.
!		Also allow for a routine to process file specs before
!		FILE_OPEN uses them.  This allows individual sites to
!		restrict the format of file specifications used by Kermit.
!
! 3.1.053	By: Robert C. McQueen			On: 9-July-1984
!		Fix FORTRAN carriage control processing to pass along
!		any character from the carriage control column that is
!		not really carriage control.
!--


%SBTTL 'Forward definitions'

FORWARD ROUTINE
    LOG_PUT,					! Write a buffer out
    DUMP_BUFFER,				! Worker routine for FILE_DUMP.
    GET_BUFFER,					! Routine to do $GET
    GET_ASCII,					! Get an ASCII character
    GET_BLOCK,					! Get a block character
    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

!
! Buffer size for log file
!

LITERAL
    LOG_BUFF_SIZE = 256;			! Number of bytes in log file buffer

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

OWN
    SEARCH_FLAG,				! Can/cannot do $SEARCH
    DEV_CLASS,					! Type of device we are reading
    EOF_FLAG,					! End of file reached.
    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_XABFHC : $XABFHC_DECL,			! XAB 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
    REC_SIZE : LONG,				! Record size
    REC_ADDRESS : LONG,				! Record address
    FIX_SIZE : LONG,				! Fixed control region size
    FIX_ADDRESS : LONG,			! Address of buffer for fixed control region
    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
    ALT_FILE_SIZE,				! Number of characters in FILE_NAME
    ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],	! Storage
    FILE_SIZE,					! Number of characters in FILE_NAME
    FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)],
    TY_FIL,				![026] Flag that file names are being typed
    CONNECT_FLAG,	![026] Indicator of whether we have a terminal to type on
    FIL_NORMAL_FORM;				![026] File specification type

![026]
![026]  Routines in KERTT
![026]

EXTERNAL ROUTINE
    TT_OUTPUT : NOVALUE,			! Force buffered output
    TT_TEXT : NOVALUE;				! Output an ASCIZ string

!
! System libraries
!

EXTERNAL ROUTINE
    LIB$GET_VM : ADDRESSING_MODE (GENERAL),
    LIB$FREE_VM : ADDRESSING_MODE (GENERAL),
    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.
!
! OUTPUT 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

    LOCAL
	STATUS;					! Random status values

    IF .EOF_FLAG THEN RETURN KER_EOF;

    SELECTONE .FILE_TYPE OF
	SET

	[FILE_ASC, FILE_BIN, FILE_FIX] :
	    STATUS = GET_ASCII (.CHARACTER);

	[FILE_BLK] :
	    STATUS = GET_BLOCK (.CHARACTER);
	TES;

    RETURN .STATUS;
    END;					! End of GET_FILE


%SBTTL 'GET_ASCII - Get a character from an ASCII file'
ROUTINE GET_ASCII (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
! CALLING SEQUENCE:
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! 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
	STATUS,					! For status values
	RAT;

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

    IF .DEV_CLASS EQL DC$_MAILBOX THEN RAT = FAB$M_CR;	! Mailbox needs CR's

    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_BUFFER ();

			IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS;

			SELECTONE .RAT OF
			    SET

			    [FAB$M_CR] :
				BEGIN
![017]				    .CHARACTER = CHR_LFD;
![017] Just switch state to data.  This means we won't get leading line feeds
![017] since nothing seems to like them anyway.
				FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
![017]				    RETURN KER_NORMAL;
				END;

			    [FAB$M_PRN] :
				BEGIN

				LOCAL
				    TEMP_POINTER;

				TEMP_POINTER = CH$PTR (.FILE_RAB [RAB$L_RHB]);
				CC_COUNT = CH$RCHAR_A (TEMP_POINTER);
				CC_TYPE = CH$RCHAR_A (TEMP_POINTER);

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

				    IF .CC_COUNT<0, 7> NEQ 0
				    THEN
					BEGIN
					.CHARACTER = CHR_LFD;
					CC_COUNT = .CC_COUNT - 1;

					IF .CC_COUNT GTR 0
					THEN
					    FILE_FAB [FAB$L_CTX] = F_STATE_PRE1
					ELSE
					    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

					RETURN KER_NORMAL;
					END
				    ELSE
					FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

				    END
				ELSE
				    BEGIN

				    SELECTONE .CC_COUNT<5, 2> OF
					SET

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

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

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

				    END;

				END;

			    [FAB$M_FTN] :
				BEGIN
				IF .FILE_REC_COUNT LEQ 0
				THEN
				    CC_TYPE = %C' '
				ELSE
				    BEGIN
				    CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER);
				    FILE_REC_COUNT = .FILE_REC_COUNT - 1;
				    END;

				SELECTONE .CC_TYPE OF
				    SET

				    [CHR_NUL] :
					BEGIN
					.CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
					FILE_REC_COUNT = .FILE_REC_COUNT - 1;
					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;
					FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
					RETURN 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;

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

				    [OTHERWISE] :
					BEGIN
					.CHARACTER = .CC_TYPE;
					FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
					END;
				    TES;

				RETURN 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 LEQ 0 THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

			    RETURN KER_NORMAL;
			    END
			ELSE
			    RETURN KER_ILLFILTYP;

		    [F_STATE_DATA] :
			BEGIN

			IF .FILE_REC_COUNT LEQ 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;
			    RETURN 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_POST1;
						![017] So we get a line feed
				RETURN 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;
				    RETURN KER_NORMAL;
				    END;

				END;

			    [FAB$M_PRN] :
				BEGIN

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

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

				    END
				ELSE
				    BEGIN

				    SELECTONE .CC_TYPE<5, 2> OF
					SET

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

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

					[OTHERWISE, %B'11'] :
					    RETURN 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 LEQ 0 AND .RAT EQL FAB$M_FTN
			    THEN
				FILE_FAB [FAB$L_CTX] = F_STATE_DATA;

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

			    RETURN KER_NORMAL;
			    END
			ELSE
![017]
![017] Generate line feed after CR for funny files
![017]

			    IF .RAT EQL FAB$M_CR
			    THEN
				BEGIN
				.CHARACTER = CHR_LFD;	![017] Return a line feed
				FILE_FAB [FAB$L_CTX] = F_STATE_PRE;
						![017] Next we get data
				RETURN KER_NORMAL;
				END
			    ELSE
				RETURN KER_ILLFILTYP;

		    TES;			! End of CASE .STATE

	    [OTHERWISE] :
		BEGIN

		WHILE .FILE_REC_COUNT LEQ 0 DO
		    BEGIN
		    STATUS = GET_BUFFER ();

		    IF NOT .STATUS OR .STATUS EQL KER_EOF THEN RETURN .STATUS;

		    END;

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

	END;					! End WHILE TRUE DO loop

    RETURN KER_ILLFILTYP;			! Shouldn't get here
    END;					! End of GET_ASCII

%SBTTL 'GET_BLOCK - Get a character from a BLOCKed file'
ROUTINE GET_BLOCK (CHARACTER) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will return the next byte from a blocked file.  This
!	routine will use the $READ RMS call to get the next byte from the
!	file.  This way all RMS header information can be passed to the
!	other file system.
!
! CALLING SEQUENCE:
!
!	STATUS = GET_BLOCK(CHARACTER);
!
! INPUT PARAMETERS:
!
!	CHARACTER - Address to store the character in.
!
! IMPLICIT INPUTS:
!
!	REC_POINTER - Pointer into the record.
!	REC_ADDRESS - Address of the record.
!	REC_COUNT - Count of the number of bytes left in the record.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	KER_NORMAL - Got a byte
!	KER_EOF - End of file gotten.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	STATUS;					! Random status values

    WHILE .FILE_REC_COUNT LEQ 0 DO
	BEGIN
	STATUS = $READ (RAB = FILE_RAB);

	IF NOT .STATUS
	THEN

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

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

    FILE_REC_COUNT = .FILE_REC_COUNT - 1;
    .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER);
    RETURN KER_NORMAL;
    END;					! End of GET_BLOCK

%SBTTL 'GET_BUFFER - Routine to read a buffer.'
ROUTINE GET_BUFFER =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine will read a buffer from the disk file.  It will
!	return various status depending if there was an error reading
!	the disk file or if the end of file is reached.
!
! CALLING SEQUENCE:
!
!	STATUS = GET_BUFFER ();
!
! INPUT PARAMETERS:
!
!	None.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	FILE_REC_POINTER - Pointer into the record.
!	FILE_REC_COUNT - Count of the number of bytes in the record.
!
! COMPLETION CODES:
!
!	KER_NORMAL - Got a buffer
!	KER_EOF - End of file reached.
!	KER_RMS32 - RMS error
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	STATUS;					! Random status values

    STATUS = $GET (RAB = FILE_RAB);

    IF NOT .STATUS
    THEN

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

    FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
    FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ];
    RETURN KER_NORMAL;
    END;

%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

    LOCAL
	STATUS;					! Random status values

    SELECTONE .FILE_TYPE OF
	SET

	[FILE_ASC] :
	    BEGIN
![022]
![022] If the last character was a carriage return and this is a line feed,
![022] we will just dump the record.  Otherwise, if the last character was
![022] a carriage return, output both it and the current one.
![022]

	    IF .FILE_FAB [FAB$L_CTX] NEQ F_STATE_DATA
	    THEN
		BEGIN

		IF (.CHARACTER AND %O'177') EQL CHR_LFD
		THEN
		    BEGIN
		    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
		    RETURN DUMP_BUFFER ();
		    END
		ELSE
		    BEGIN

		    IF .FILE_REC_COUNT GEQ .REC_SIZE
		    THEN
			BEGIN
			LIB$SIGNAL (KER_REC_TOO_BIG);
			RETURN KER_REC_TOO_BIG;
			END;

		    CH$WCHAR_A (CHR_CRT, FILE_REC_POINTER);
						! Store the carriage return we deferred
		    FILE_REC_COUNT = .FILE_REC_COUNT + 1;
		    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;	! Back to normal data
		    END;

		END;

![022]
![022] Here when last character was written to the file normally.  Check if
![022] this character might be the end of a record (or at least the start of
![022] end.
![022]

	    IF (.CHARACTER AND %O'177') EQL CHR_CRT
	    THEN
		BEGIN
		FILE_FAB [FAB$L_CTX] = F_STATE_POST;	! Remember we saw this
		RETURN KER_NORMAL;		! And delay until next character
		END;

	    IF .FILE_REC_COUNT GEQ .REC_SIZE
	    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, FILE_FIX] :
	    BEGIN

	    IF .FILE_REC_COUNT GEQ .REC_SIZE
	    THEN
		BEGIN
![016]		LIB$SIGNAL (KER_REC_TOO_BIG);
![016]		RETURN KER_REC_TOO_BIG;
		STATUS = DUMP_BUFFER ();

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

		END;

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

	[FILE_BLK] :
	    BEGIN

	    IF .FILE_REC_COUNT GEQ .REC_SIZE
	    THEN
		BEGIN
		FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
		STATUS = $WRITE (RAB = FILE_RAB);
		FILE_REC_COUNT = 0;
		FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
		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 '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.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	KER_NORMAL - Output went ok.
!	KER_RMS32 - RMS-32 error.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	STATUS;					! Random status values

!
! 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 (.REC_ADDRESS);
!
! Now determine if we failed attempting to write the record
!

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR (.STATUS);
	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

    LOCAL
	STATUS;					! Random status values

!
! We now have an expanded file specification that we can use to process
! the file.
!

    IF .FILE_TYPE NEQ FILE_BLK
    THEN
	BEGIN
	$FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM,
	    XAB = FILE_XABFHC);
	END
    ELSE
	BEGIN
	$FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM,
	    NAM = FILE_NAM, XAB = FILE_XABFHC);
	END;

    $XABFHC_INIT (XAB = FILE_XABFHC);
    STATUS = $OPEN (FAB = FILE_FAB);

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

!
! Now allocate a buffer for the records
!
    REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]);

    IF .REC_SIZE EQL 0 THEN REC_SIZE = MAX_REC_LENGTH;

    STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
!
![107] Determine if we need a buffer for the fixed control area
!
    FIX_SIZE = .FILE_FAB [FAB$B_FSZ];

    IF .FIX_SIZE NEQ 0
    THEN
	BEGIN
	STATUS = LIB$GET_VM (FIX_SIZE, FIX_ADDRESS);
	END;

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

    IF .FIX_SIZE NEQ 0 THEN FILE_RAB [RAB$L_RHB] = .FIX_ADDRESS;

						![017] Store header address
    STATUS = $CONNECT (RAB = FILE_RAB);

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR (.STATUS);
	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

    EXTERNAL ROUTINE
!
! This external routine is called to perform any checks on the file
! specification that the user wishes.  It must return a true value
! if the access is to be allowed, and a false value (error code) if
! access is to be denied.  The error code may be any valid system wide
! error code, any Kermit-32 error code (KER_xxx) or a user specific code,
! provided a message file defining the error code is loaded with Kermit-32.
!
! The routine is called as:
!
!	STATUS = USER_FILE_CHECK ( FILE NAME DESCRIPTOR, READ/WRITE FLAG)
!
! The file name descriptor points to the file specification supplied by
! the user.  The read/write flag is TRUE if the file is being read, and
! false if it is being written.
!
	USER_FILE_CHECK : ADDRESSING_MODE(GENERAL) WEAK;

    LOCAL
	STATUS,					! Random status values
	ITMLST : VECTOR [4, LONG],		! For GETDVI call
	SIZE : WORD;				! Size of resulting file name

!
! Assume we can do searches
!
    SEARCH_FLAG = TRUE;
    DEV_CLASS = DC$_DISK;			! Assume disk file
!
! Now do the function dependent processing
!
    FILE_MODE = .FUNCTION;
    FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE;	! Length of file name
!
! Call user routine (if any)
!
    IF USER_FILE_CHECK NEQ 0
    THEN
	BEGIN
	STATUS = USER_FILE_CHECK (FILE_DESC, %REF (.FILE_MODE EQL FNC_READ));
	IF NOT .STATUS
	THEN
	    BEGIN
	    LIB$SIGNAL (.STATUS);
	    RETURN .STATUS;
	    END;
	END;
!
! Select the correct routine depending on if we are reading or writing.
!

    SELECTONE .FUNCTION OF
	SET

	[FNC_READ] :
	    BEGIN
!
! Determine device type
!
	    ITMLST [0] = DVI$_DEVCLASS^16 + 4;	! Want device class
	    ITMLST [1] = DEV_CLASS;		! Put it there
	    ITMLST [2] = ITMLST [2];		! Put the size here
	    ITMLST [3] = 0;			! End the list
	    STATUS = $GETDVI (DEVNAM = FILE_DESC, ITMLST = ITMLST);
! If not a disk, can't do search

	    IF .STATUS AND .DEV_CLASS NEQ DC$_DISK THEN SEARCH_FLAG = FALSE;

!
! 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, DNA = UPLIT (%ASCII'.;0'), DNS = 3);
!
! 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 (.STATUS);
		RETURN KER_RMS32;
		END;

	    IF .SEARCH_FLAG
	    THEN
		BEGIN
		STATUS = $SEARCH (FAB = FILE_FAB);

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

		END;

!
! We now have an expanded file specification that we can use to process
! the file.
!
	    STATUS = OPEN_READING ();		![017] Open the file

	    IF NOT .STATUS THEN RETURN .STATUS;	![017] If we couldn't, pass error back

![026]
![026] Tell user what name we ended up with for storing the file
![026]

	    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
	    THEN
		BEGIN

		IF .FILE_NAM [NAM$B_RSS] GTR 0
		THEN
		    BEGIN
		    CH$WCHAR (CHR_NUL,
			CH$PTR (.FILE_NAM [NAM$L_RSA],
			    .FILE_NAM [NAM$B_RSL]));
		    TT_TEXT (.FILE_NAM [NAM$L_RSA]);
		    END
		ELSE
		    BEGIN
		    CH$WCHAR (CHR_NUL,
			CH$PTR (.FILE_NAM [NAM$L_ESA],
			    .FILE_NAM [NAM$B_ESL]));
		    TT_TEXT (.FILE_NAM [NAM$L_ESA]);
		    END;

		TT_TEXT (UPLIT (%ASCIZ' as '));
		END;

	    END;				! End of [FNC_READ]

	[FNC_WRITE] :
	    BEGIN

	    SELECTONE .FILE_TYPE OF
		SET

		[FILE_ASC] :
		    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;

		[FILE_BIN] :
		    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;

		[FILE_FIX] :
		    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 = FIX, MRS = 512);
		    END;

		[FILE_BLK] :
		    BEGIN
		    $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME,
			FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM);
		    END;
		TES;

![030]
![030] If we had an alternate file name from the receive command, use it
![030] instead of what KERMSG has told us.
![030]

	    IF .ALT_FILE_SIZE GTR 0
	    THEN
		BEGIN
		LOCAL
		    ALT_FILE_DESC : BLOCK [8, BYTE];

		ALT_FILE_DESC = .FILE_DESC;
		ALT_FILE_DESC [DSC$W_LENGTH] = .ALT_FILE_SIZE;
		ALT_FILE_DESC [DSC$A_POINTER] = ALT_FILE_NAME;
		IF USER_FILE_CHECK NEQ 0
		THEN
		    BEGIN
		    STATUS = USER_FILE_CHECK (ALT_FILE_DESC, %REF (.FILE_MODE EQL FNC_READ));
		    IF NOT .STATUS
		    THEN
			BEGIN
			LIB$SIGNAL (.STATUS);
			RETURN .STATUS;
			END;
		    END;
		FILE_FAB [FAB$L_FNA] = ALT_FILE_NAME;
		FILE_FAB [FAB$B_FNS] = .ALT_FILE_SIZE;
		END;

	    $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR,
		RSS = NAM$C_MAXRSS);
!
! Now allocate a buffer for the records
!
![016] Determine correct buffer size

	    SELECTONE .FILE_TYPE OF
		SET

		[FILE_ASC] :
		    REC_SIZE = MAX_REC_LENGTH;

		[FILE_BIN] :
		    REC_SIZE = 510;

		[FILE_BLK, FILE_FIX] :
		    REC_SIZE = 512;
		TES;

	    STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);
!
! Now create the file
!
	    STATUS = $CREATE (FAB = FILE_FAB);

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

	    $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS,
		ROP = <NLK, WAT>);
	    STATUS = $CONNECT (RAB = FILE_RAB);

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

![022]
![022] Set the initial state into the FAB field.  This is used to remember
![022] whether we need to ignore the line feed which follows a carriage return.
![022]
	    FILE_FAB [FAB$L_CTX] = F_STATE_DATA;
	    FILE_REC_COUNT = 0;
	    FILE_REC_POINTER = CH$PTR (.REC_ADDRESS);
![026]
![026] Tell user what name we ended up with for storing the file
![026]

	    IF ( NOT .CONNECT_FLAG) AND .TY_FIL
	    THEN
		BEGIN
		TT_TEXT (UPLIT (%ASCIZ' as '));

		IF .FILE_NAM [NAM$B_RSL] GTR 0
		THEN
		    BEGIN
		    CH$WCHAR (CHR_NUL,
			CH$PTR (.FILE_NAM [NAM$L_RSA],
			    .FILE_NAM [NAM$B_RSL]));
		    TT_TEXT (.FILE_NAM [NAM$L_RSA]);
		    END
		ELSE
		    BEGIN
		    CH$WCHAR (CHR_NUL,
			CH$PTR (.FILE_NAM [NAM$L_ESA],
			    .FILE_NAM [NAM$B_ESL]));
		    TT_TEXT (.FILE_NAM [NAM$L_ESA]);
		    END;

		TT_OUTPUT ();
		END;

	    END;

	[OTHERWISE] :
	    RETURN KER_INTERNALERR;
	TES;

![026]
![026] Copy the file name based on the type of file name we are to use.
![026] The possibilities are:
![026]		Normal - Just copy name and type
![026]		Full - Copy entire name string (either resultant or expanded)
![026]		Untranslated - Copy string from name on (includes version, etc.)

    IF .DEV_CLASS EQL DC$_MAILBOX
    THEN
	BEGIN
	SIZE = 0;
	FILE_NAME = 0;
	END
    ELSE

	SELECTONE .FIL_NORMAL_FORM OF
	    SET

	    [FNM_FULL] :
		BEGIN

		IF .FILE_NAM [NAM$B_RSL] GTR 0
		THEN
		    BEGIN
		    CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]),
			CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
		    SIZE = .FILE_NAM [NAM$B_RSL];
		    END
		ELSE
		    BEGIN
		    CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]),
			CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME));
		    SIZE = .FILE_NAM [NAM$B_ESL];
		    END

		END;

	    [FNM_NORMAL, FNM_UNTRAN] :
		BEGIN
		CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]),
		    .FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL,
		    MAX_FILE_NAME, CH$PTR (FILE_NAME));
		SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE];
		END;
	    TES;

    IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE;

    RETURN KER_NORMAL;
    END;					! End of FILE_OPEN


%SBTTL 'FILE_CLOSE'

GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) =

!++
! 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:
!
!	ABORT_FLAG - True if file should not be saved.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUTPUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	None.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    LOCAL
	STATUS;					! Random status values

![022]
![022] If there might be something left to write
![022]

    IF .FILE_MODE EQL FNC_WRITE AND (.FILE_REC_COUNT GTR 0 OR .FILE_FAB [FAB$L_CTX] NEQ
	F_STATE_DATA)
    THEN
	BEGIN

	SELECTONE .FILE_TYPE OF
	    SET

	    [FILE_FIX] :
		BEGIN

		INCR I FROM .FILE_REC_COUNT TO .REC_SIZE - 1 DO
		    CH$WCHAR_A (CHR_NUL, FILE_REC_POINTER);

		STATUS = DUMP_BUFFER ();
		END;

	    [FILE_ASC, FILE_BIN] :
		STATUS = DUMP_BUFFER ();

	    [FILE_BLK] :
		BEGIN
		FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT;
		STATUS = $WRITE (RAB = FILE_RAB);

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

		END;
	    TES;

	IF NOT .STATUS THEN RETURN .STATUS;

	END;

!
! If reading from a mailbox, read until EOF to allow the process on the other
! end to terminal gracefully.
!

    IF .FILE_MODE EQL FNC_READ AND .DEV_CLASS EQL DC$_MAILBOX AND NOT .EOF_FLAG
    THEN

	DO
	    STATUS = GET_BUFFER ()
	UNTIL ( NOT .STATUS) OR .EOF_FLAG;

    STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS);

    IF .FIX_SIZE NEQ 0 THEN STATUS = LIB$FREE_VM (FIX_SIZE, FIX_ADDRESS);

    IF .ABORT_FLAG AND .FILE_MODE EQL FNC_WRITE
    THEN
	FILE_FAB [FAB$V_DLT] = TRUE
    ELSE
	FILE_FAB [FAB$V_DLT] = FALSE;

    STATUS = $CLOSE (FAB = FILE_FAB);
    EOF_FLAG = FALSE;

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR (.STATUS);
	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
	SIZE : WORD,				! Size of the $FAO string
	STATUS;					! Random status values

!
! If we can't do a search, just return no more files
!

    IF NOT .SEARCH_FLAG THEN RETURN KER_NOMORFILES;

!
! 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 (.STATUS);
	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 NOT .STATUS THEN RETURN .STATUS;

![026]
![026] Copy the file name based on the type of file name we are to use.
![026] The possibilities are:
![026]		Normal - Just copy name and type
![026]		Full - Copy entire name string (either resultant or expanded)
![026]		Untranslated - Copy string from name on (includes version, etc.)

    SELECTONE .FIL_NORMAL_FORM OF
	SET

	[FNM_FULL] :
	    BEGIN

	    IF .FILE_NAM [NAM$B_RSL] GTR 0
	    THEN
		BEGIN
		CH$COPY (.FILE_NAM [NAM$B_RSL], CH$PTR (.FILE_NAM [NAM$L_RSA]), CHR_NUL,
		    MAX_FILE_NAME, CH$PTR (FILE_NAME));
		SIZE = .FILE_NAM [NAM$B_RSL];
		END
	    ELSE
		BEGIN
		CH$COPY (.FILE_NAM [NAM$B_ESL], CH$PTR (.FILE_NAM [NAM$L_ESA]), CHR_NUL,
		    MAX_FILE_NAME, CH$PTR (FILE_NAME));
		SIZE = .FILE_NAM [NAM$B_ESL];
		END

	    END;

	[FNM_NORMAL, FNM_UNTRAN] :
	    BEGIN
	    CH$COPY (.FILE_NAM [NAM$B_NAME], CH$PTR (.FILE_NAM [NAM$L_NAME]),
		.FILE_NAM [NAM$B_TYPE], CH$PTR (.FILE_NAM [NAM$L_TYPE]), CHR_NUL,
		MAX_FILE_NAME, CH$PTR (FILE_NAME));
	    SIZE = .FILE_NAM [NAM$B_NAME] + .FILE_NAM [NAM$B_TYPE];
	    END;
	TES;

    IF .SIZE GTR MAX_FILE_NAME THEN FILE_SIZE = MAX_FILE_NAME ELSE FILE_SIZE = .SIZE;

    RETURN KER_NORMAL;
    END;					! End of NEXT_FILE


%SBTTL 'LOG_OPEN - Open a log file'

GLOBAL ROUTINE LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! CALLING SEQUENCE:
!
!	STATUS = LOG_OPEN (LOG_DESC, LOG_FAB, LOG_RAB)
!
! INPUT PARAMETERS:
!
!	LOG_DESC - Address of descriptor for file name to be opened
!
!	LOG_FAB - Address of FAB for file
!
!	LOG_RAB - Address of RAB for file
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	LOG_FAB and LOG_RAB updated.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	Error code or true.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	LOG_DESC : REF BLOCK [8, BYTE],		! Name descriptor
	LOG_FAB : REF $FAB_DECL,		! FAB for file
	LOG_RAB : REF $RAB_DECL;		! RAB for file

    LOCAL
	STATUS,					! Random status values
	REC_ADDRESS,				! Address of record buffer
	REC_SIZE;				! Size of record buffer

!
! Get memory for records
!
    REC_SIZE = LOG_BUFF_SIZE;
    STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS);

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

!
! Initialize the FAB and RAB
!
    $FAB_INIT (FAB = .LOG_FAB, FAC = PUT, FNA = .LOG_DESC [DSC$A_POINTER],
	FNS = .LOG_DESC [DSC$W_LENGTH], FOP = (MXV, CBT, SQO, TEF), ORG = SEQ, RFM = VAR,
	RAT = CR, CTX = 0, DNA = UPLIT (%ASCII'.LOG'), DNS = 4);
    STATUS = $CREATE (FAB = .LOG_FAB);

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR (.STATUS);
	LIB$FREE_VM (REC_SIZE, REC_ADDRESS);	! Dump record buffer
	RETURN KER_RMS32;
	END;

    $RAB_INIT (RAB = .LOG_RAB, FAB = .LOG_FAB, RAC = SEQ, RBF = .REC_ADDRESS,
	RSZ = .REC_SIZE, UBF = .REC_ADDRESS, USZ = .REC_SIZE, ROP = <NLK, WAT>, CTX = 0);
    STATUS = $CONNECT (RAB = .LOG_RAB);

    IF NOT .STATUS
    THEN
	BEGIN
	FILE_ERROR (.STATUS);
	LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
	$CLOSE (FAB = .LOG_FAB);
	RETURN KER_RMS32;
	END
    ELSE
	RETURN .STATUS;

    END;					! End of LOG_OPEN


%SBTTL 'LOG_CLOSE - Close a log file'

GLOBAL ROUTINE LOG_CLOSE (LOG_FAB, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will close an open log file.  It will also ensure that
!the last buffer gets dumped.
!
! CALLING SEQUENCE:
!
!	STATUS = LOG_CLOSE (LOG_FAB, LOG_RAB);
!
! INPUT PARAMETERS:
!
!	LOG_FAB - Address of log file FAB
!
!	LOG_RAB - Address of log file RAB
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	Resulting status.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	LOG_FAB : REF $FAB_DECL,		! FAB for log file
	LOG_RAB : REF $RAB_DECL;		! RAB for log file

    LOCAL
	STATUS,					! Random status values
	REC_ADDRESS,				! Address of record buffer
	REC_SIZE;				! Size of record buffer

!
! First write out any outstanding data
!

    IF .LOG_RAB [RAB$L_CTX] GTR 0 THEN LOG_PUT (.LOG_RAB);	! Dump current buffer

!
! Return the buffer
!
    REC_SIZE = LOG_BUFF_SIZE;			! Get size of buffer
    REC_ADDRESS = .LOG_RAB [RAB$L_RBF];		! And address
    LIB$FREE_VM (REC_SIZE, REC_ADDRESS);
!
! Now disconnect the RAB
!
    STATUS = $DISCONNECT (RAB = .LOG_RAB);

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

!
! Now we can close the file
!
    STATUS = $CLOSE (FAB = .LOG_FAB);

    IF NOT .STATUS THEN FILE_ERROR (.STATUS);

!
! And return the result
!
    RETURN .STATUS;
    END;					! End of LOG_CLOSE


%SBTTL 'LOG_CHAR - Log a character to a file'

GLOBAL ROUTINE LOG_CHAR (CH, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will write one character to an open log file.
!If the buffer becomes filled, it will dump it.  It will also
!dump the buffer if a carriage return line feed is seen.
!
! CALLING SEQUENCE:
!
!	STATUS = LOG_CHAR (.CH, LOG_RAB);
!
! INPUT PARAMETERS:
!
!	CH - The character to write to the file.
!
!	LOG_RAB - The address of the log file RAB.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	Any error returned by LOG_PUT, else TRUE.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	LOG_RAB : REF $RAB_DECL;		! Log file RAB

    LOCAL
	STATUS;					! Random status value

!
! If this character is a line feed, and previous was a carriage return, then
! dump the buffer and return.
!

    IF .CH EQL CHR_LFD
    THEN
	BEGIN
!
! If we seem to have overfilled the buffer, that is because we saw a CR
! last, and had no place to put it.  Just reset the size and dump the buffer.
!

	IF .LOG_RAB [RAB$L_CTX] GTR LOG_BUFF_SIZE
	THEN
	    BEGIN
	    LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE;
	    RETURN LOG_PUT (.LOG_RAB);
	    END;

!
! If last character in buffer is a CR, then dump buffer without the CR
!

	IF CH$RCHAR (CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX] - 1)) EQL CHR_CRT
	THEN
	    BEGIN
	    LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] - 1;
	    RETURN LOG_PUT (.LOG_RAB);
	    END;

	END;

!
! Don't need to dump buffer because of end of line problems.  Check if
! the buffer is full.
!

    IF .LOG_RAB [RAB$L_CTX] GEQ LOG_BUFF_SIZE
    THEN
	BEGIN
!
! If character we want to store is a carriage return, then just count it and
! don't dump the buffer yet.
!

	IF .CH EQL CHR_CRT
	THEN
	    BEGIN
	    LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1;
	    RETURN KER_NORMAL;
	    END;

!
! We must dump the buffer to make room for more characters
!
	STATUS = LOG_PUT (.LOG_RAB);

	IF NOT .STATUS THEN RETURN .STATUS;

	END;

!
! Here when we have some room to store the character
!
    CH$WCHAR (.CH, CH$PTR (.LOG_RAB [RAB$L_RBF], .LOG_RAB [RAB$L_CTX]));
    LOG_RAB [RAB$L_CTX] = .LOG_RAB [RAB$L_CTX] + 1;
    RETURN KER_NORMAL;
    END;					! End of LOG_CHAR


%SBTTL 'LOG_LINE - Log a line to a log file'

GLOBAL ROUTINE LOG_LINE (LINE_DESC, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will write an entire line to a log file.  And previously
! written characters will be dumped first.
!
! CALLING SEQUENCE:
!
!	STATUS = LOG_LINE (LINE_DESC, LOG_RAB);
!
! INPUT PARAMETERS:
!
!	LINE_DESC - Address of descriptor for string to be written
!
!	LOG_RAB - RAB for log file
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	KER_NORMAL or LOG_PUT error code.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	LINE_DESC : REF BLOCK [8, BYTE],	! Descriptor for string
	LOG_RAB : REF $RAB_DECL;		! RAB for file

    LOCAL
	STATUS;					! Random status value

!
! First check if anything is already in the buffer
!

    IF .LOG_RAB [RAB$L_CTX] GTR 0
    THEN
	BEGIN
	STATUS = LOG_PUT (.LOG_RAB);		! Yes, write it out

	IF NOT .STATUS THEN RETURN .STATUS;	! Pass back any errors

	END;

!
! Copy the data to the buffer
!
    CH$COPY (.LINE_DESC [DSC$W_LENGTH], CH$PTR (.LINE_DESC [DSC$A_POINTER]), CHR_NUL,
	LOG_BUFF_SIZE, CH$PTR (.LOG_RAB [RAB$L_RBF]));

    IF .LINE_DESC [DSC$W_LENGTH] GTR LOG_BUFF_SIZE
    THEN
	LOG_RAB [RAB$L_CTX] = LOG_BUFF_SIZE
    ELSE
	LOG_RAB [RAB$L_CTX] = .LINE_DESC [DSC$W_LENGTH];

!
! Now just dump the buffer
!
    RETURN LOG_PUT (.LOG_RAB);
    END;					! End of LOG_LINE

%SBTTL 'LOG_FAOL - Log an FAO string to the log file'

GLOBAL ROUTINE LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will write an FAOL string to the output file.
!
! CALLING SEQUENCE:
!
!	STATUS = LOG_FAOL (FAOL_DESC, FAOL_PARAMS, LOG_RAB);
!
! INPUT PARAMETERS:
!
!	FAOL_DESC - Address of descriptor for string to be written
!
!	FAOL_PARAMS - Parameter list for FAOL call
!
!	LOG_RAB - RAB for log file
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	KER_NORMAL or $FAOL or LOG_PUT error code.
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	FAOL_DESC : REF BLOCK [8, BYTE],	! Descriptor for string
	LOG_RAB : REF $RAB_DECL;		! RAB for file

    LITERAL
	FAOL_BUFSIZ = 256;			! Length of buffer

    LOCAL
	FAOL_BUFFER : VECTOR [FAOL_BUFSIZ, BYTE], ! Buffer for FAOL output
	FAOL_BUF_DESC : BLOCK [8, BYTE],	! Descriptor for buffer
	STATUS;					! Random status value

!
! Initialize descriptor for buffer
!
    FAOL_BUF_DESC [DSC$B_CLASS] = DSC$K_CLASS_S;
    FAOL_BUF_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T;
    FAOL_BUF_DESC [DSC$A_POINTER] = FAOL_BUFFER;
    FAOL_BUF_DESC [DSC$W_LENGTH] = FAOL_BUFSIZ;
!
! Now do the FAOL to generate the full text
!
    STATUS = $FAOL (CTRSTR = .FAOL_DESC, OUTBUF = FAOL_BUF_DESC,
	OUTLEN = FAOL_BUF_DESC [DSC$W_LENGTH], PRMLST = .FAOL_PARAMS);
    IF NOT .STATUS THEN RETURN .STATUS;
!
! Dump the text into the file
!
    INCR I FROM 1 TO .FAOL_BUF_DESC [DSC$W_LENGTH] DO
	BEGIN
	STATUS = LOG_CHAR ( .FAOL_BUFFER [.I - 1], .LOG_RAB);
	IF NOT .STATUS THEN RETURN .STATUS;
	END;

    RETURN KER_NORMAL;

    END;					! End of LOG_FAOL


%SBTTL 'LOG_PUT - Write a record buffer for a log file'
ROUTINE LOG_PUT (LOG_RAB) =

!++
! FUNCTIONAL DESCRIPTION:
!
! This routine will output one buffer for a log file.
!
! CALLING SEQUENCE:
!
!	STATUS = LOG_PUT (LOG_RAB);
!
! INPUT PARAMETERS:
!
!	LOG_RAB - RAB for log file.
!
! IMPLICIT INPUTS:
!
!	None.
!
! OUPTUT PARAMETERS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION CODES:
!
!	Status value from RMS
!
! SIDE EFFECTS:
!
!	None.
!
!--

    BEGIN

    MAP
	LOG_RAB : REF $RAB_DECL;		! RAB for file

!
! Calculate record size
!
    LOG_RAB [RAB$W_RSZ] = .LOG_RAB [RAB$L_CTX];
    LOG_RAB [RAB$W_USZ] = .LOG_RAB [RAB$W_RSZ];
!
! Buffer will be empty when we finish
!
    LOG_RAB [RAB$L_CTX] = 0;
!
! And call RMS to write the buffer
!
    RETURN $PUT (RAB = .LOG_RAB);
    END;					! End of LOG_PUT

%SBTTL 'FILE_ERROR - Error processing for all RMS errors'
ROUTINE FILE_ERROR (STATUS) : 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.
!
! OUTPUT 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