Google
 

Trailing-Edge - PDP-10 Archives - BB-R595B-SM_11-9-85 - mcb/tkb36/tfio10.bli
There are 2 other files named tfio10.bli in the archive. Click here to see a list.
!<REL4A.TKB-VNP>FIO10.BLI.5,  3-Dec-79 14:28:00, Edit by SROBINSON
MODULE FIO10 (					! FILE I/O
		IDENT = 'X2.0'
		) =
BEGIN
!
!
!
!                    COPYRIGHT (c) 1980, 1981, 1982
!                    DIGITAL EQUIPMENT CORPORATION
!                        Maynard, Massachusetts
!
!     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: TKB-20 AND VNP-20
!
! ABSTRACT:
!
!
! THIS MODULE DOES FILE I/O FOR THE TASK BUILDER.
!
! THE CALLS ARE: OPEN, CLOSE, INPUT AND OUTPUT.
!  ALL TAKE A 'CHANNEL' ARGUMENT.  CHANNEL NUMBERS ARE BETWEEN
!   0 AND 15.  CHANNEL 0 IS ALWAYS OPEN TO THE TERMINAL.
!
!
! ENVIRONMENT: TOPS-10 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 14-DEC-77
!
! MODIFIED BY:
!
!	Scott G. Robinson, 15-NOV-78 : VERSION X0.1-2A
!	- Add %C' ' to the break set for file names
!
!	Scott G. Robinson, 28-NOV-78 : VERSION X0.2
!	- Make this module FIO10 because it is for a
!	  TOPS-10 I/O Scheme
!
!	Scott G. Robinson, 13-JUN-79 : VERSION X0.3
!	- Add routine STOP_PROGRAM
!-----------------------------------------------------------------------
!
!	Scott G. Robinson, 3-DEC-79 : Version X2.0
!	- Ensure DECnet-10 Compatibility
!
!	, : VERSION
! 01	-
!--

!<BLF/PAGE>
!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    RESET_ALL : NOVALUE,			!RESET ALL I/O
    SIXBIT,					!TRANSLATE ASCII TO SIXBIT
    OPEN,					!OPEN A FILE (GLOBAL)
    CLOSE : NOVALUE,				!CLOSE A FILE (GLOBAL)
    INPUT,					!READ FROM A FILE (GLOBAL)
    OUTPUT : NOVALUE,				!WRITE ON A FILE (GLOBAL)
    STOP_PROGRAM : NOVALUE;			!TERMINATE PROGRAM

!
! INCLUDE FILES:
!
!	NONE
!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!

LITERAL
    DEBUG = 0;

!
! OWN STORAGE:
!

OWN
    CHAN_STATUS : VECTOR [16],
    CHAN_HEADER : VECTOR [16],
    CHAN_BUFFER : VECTOR [16],
    CHAN_WORD : VECTOR [16],
    CHAN_CTR : VECTOR [16],
    CHAN_DIRECTION : VECTOR [16];

LITERAL
    FILE_NAME_LEN = CH$ALLOCATION (40);

OWN
    CHAN_FNAME : VECTOR [16*FILE_NAME_LEN];

!
! EXTERNAL REFERENCES:
!

EXTERNAL ROUTINE
    ERROR,					!PROGRAMMING ERROR
    ERRMSG,					!ERROR MESSAGE PRINTER
    GETSTG,					!GET STORAGE FROM FREE LIST
    FRESTG;					!RETURN STORAGE TO FREE LIST
GLOBAL ROUTINE RESET_ALL : NOVALUE = 		!RESET ALL I/O

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO RESET ALL I/O.  IT DOES THIS BY ISSUEING THE
!	 TOPS-10 "RESET" UUO.
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	RESETS ALL I/O
!
!--

    BEGIN

    BUILTIN
	UUO;

    UUO (0, %O'047', 0, 0);
    END;					!OF RESET_ALL
ROUTINE SIXBIT (ASCII_PTR) = 			!ASCII TO SIXBIT

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	ROUTINE TO CONVERT UP TO SIX CHARACTERS OF ASCII STRING TO
!	 SIXBIT.
!
!
! FORMAL PARAMETERS:
!
!	ASCII_PTR - POINTER TO ASCII STRING
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE VALUE OF THE STRING, IN SIXBIT.
!
! SIDE EFFECTS
!
!	NONE
!
!--

    BEGIN

    LOCAL
	OUTPTR,
	INPTR,
	CHAR,
	CHAR_CTR,
	RESULT;

!
    RESULT = 0;
    OUTPTR = CH$PTR (RESULT, -1, 6);
    INPTR = CH$PTR (.ASCII_PTR, -1, 7);
    CHAR = 0;
    CHAR_CTR = 0;
!

    DO
	BEGIN
	CHAR = CH$A_RCHAR (INPTR);

	IF ((.CHAR GEQ %C' ') AND (.CHAR LEQ %C'_')) THEN CH$A_WCHAR (.CHAR - %O'40', OUTPTR);

	CHAR_CTR = .CHAR_CTR + 1;
	END
    UNTIL ((.CHAR EQL 0) OR (.CHAR_CTR GEQ 6));

    .RESULT
    END;
GLOBAL ROUTINE OPEN (CHANX, FNAME, MODE, IO, DEFEXT) : = 	!OPEN A FILE

!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!	OPEN A FILE.
!
!
! FORMAL PARAMETERS:
!
!	CHANX - THE CHANNEL NUMBER TO OPEN.
!	FNAME - POINTER TO FILE NAME STRING.
!	MODE - I/O MODE: 1 = CHARACTER, 2 = WORD.
!	IO - 0 = INPUT, 1 = OUTPUT.
!	DEFEXT - POINTER TO DEFAULT EXTENSION (3 CHARS)
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	1 IF OPEN SUCCESSFUL, 0 IF NOT.
!
! SIDE EFFECTS
!
!	ASSOCIATES CHANNEL NUMBER WITH DEVICE BY DOING UUOS
!	AND MODIFYING OWN STORAGE.
!
!--

    BEGIN

    BIND
	ROUTINE_NAME = UPLIT (%ASCIZ'OPEN');

    LOCAL
	ACCUM,
	ACCUM_CTR,
	ACCUM_PTR,
	BUF_PTR,
	CHAN,
	CHAR,
	DEV_NAME,
	END_SCAN,
	FILE_NAME,
	FILE_EXT,
	FILN_PTR,
	FIL_PTR,
	HEADER_PTR,
	LOOKUP_BLOCK : VECTOR [4],
	OPEN_BLOCK : VECTOR [3],
	RESULT,
	SAVEJOBFF,
	SUCCESS;

    EXTERNAL LITERAL
	%NAME ('.JBFF');

    BUILTIN
	UUO;

    CHAN = .CHANX;
    RESULT = 0;

    IF (.CHAN EQL 0)
    THEN
	ERROR (UPLIT (%ASCIZ'MAY NOT OPEN CHANNEL 0 - OPEN'))
    ELSE

	IF ((.CHAN GTR 15) OR (.CHAN LSS 0))
	THEN
	    ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - OPEN'))
	ELSE

	    IF (.CHAN_STATUS [.CHAN] NEQ 0)
	    THEN
		ERROR (UPLIT (%ASCIZ'CHANNEL ALREADY OPEN - OPEN'))
	    ELSE

		IF ((.MODE NEQ 1) AND (.MODE NEQ 2))
		THEN
		    ERROR (UPLIT (%ASCIZ'ILLEGAL MODE - OPEN'))
		ELSE
		    BEGIN			!THINGS SEEM OK.
		    DEV_NAME = 0;
		    FILE_NAME = 0;
		    FILE_EXT = 0;
		    ACCUM = 0;
		    END_SCAN = 0;
!
		    FIL_PTR = CH$PTR (.FNAME, -1, 7);
		    FILN_PTR = CH$PTR (CHAN_FNAME [.CHAN*FILE_NAME_LEN], -1, 7);
		    ACCUM_PTR = CH$PTR (ACCUM, -1, 6);
		    ACCUM_CTR = 0;
!

		    DO
			BEGIN			!SCAN THE FILE NAME STRING
			CHAR = CH$A_RCHAR (FIL_PTR);
			CH$A_WCHAR (.CHAR, FILN_PTR);

			SELECTONE .CHAR OF
			    SET

			    [0,%C' '] :
				END_SCAN = 1;

			    [%C'A' TO %C'Z', %C'0' TO %C'9', %C'A' + %O'40' TO %C'Z' + %O'40'] :
				BEGIN		!ALPHANUMERIC

				IF ((ACCUM_CTR = .ACCUM_CTR + 1) GTR 6)
				THEN
				    ERRMSG (0, 2, ROUTINE_NAME,
					.FNAME, 0, 0, 0)
				ELSE
				    CH$A_WCHAR (.CHAR - %O'40', ACCUM_PTR);

				END;

			    [%C':'] :
				BEGIN		! WE HAVE SCANNED A DEVICE NAME
				DEV_NAME = .ACCUM;
				ACCUM = 0;
				ACCUM_CTR = 0;
				ACCUM_PTR = CH$PTR (ACCUM, -1, 6);
				END;

			    [%C'.'] :
				BEGIN		! WE HAVE SCANNED A FILE NAME
				FILE_NAME = .ACCUM;
				ACCUM = 0;
				ACCUM_CTR = 0;
				ACCUM_PTR = CH$PTR (ACCUM, -1, 6);
				END;

			    [OTHERWISE] :
				ERRMSG (0, 2, ROUTINE_NAME, .FNAME, 0, 0, 0);
			    TES;

			END
		    WHILE (.END_SCAN EQL 0);

!
! SUBSTITUTE THE DEFAULTS
!

		    IF (.FILE_NAME EQL 0)
		    THEN
			BEGIN			!NAME IS ZERO, CHECK FOR UNDELIMITED NAME
			FILE_NAME = .ACCUM;
			ACCUM = 0;
			ACCUM_CTR = 0;
			END;

		    IF (.FILE_EXT EQL 0)
		    THEN
			BEGIN			!EXTENSION IS ZERO, USE LAST NAME PROVIDED.
			FILE_EXT = .ACCUM;

			IF (.ACCUM_CTR GTR 3) THEN ERRMSG (0, 2, ROUTINE_NAME, .FNAME, 0, 0, 0);

			ACCUM = 0;
			ACCUM_CTR = 0;
			END;

		    IF (.DEV_NAME EQL 0) THEN DEV_NAME = SIXBIT (UPLIT (%ASCIZ'DSK'));

		    IF (.FILE_EXT EQL 0) THEN FILE_EXT = SIXBIT (.DEFEXT);

		    IF (.FILE_NAME EQL 0)
		    THEN
			ERRMSG (0, 2, ROUTINE_NAME, .FNAME, 0, 0, 0)
		    ELSE
			BEGIN
			OPEN_BLOCK [0] = (.MODE - 1)*%O'14';	!CHAR = 0, WORD = 14 OCTAL.
			OPEN_BLOCK [1] = .DEV_NAME;

			IF ((HEADER_PTR = GETSTG (3)) EQL 0)
			THEN
			    ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
			ELSE
			    BEGIN

			    IF (.IO NEQ 0)
			    THEN
				OPEN_BLOCK [2] = (.HEADER_PTR)^18
			    ELSE
				OPEN_BLOCK [2] = (.HEADER_PTR);

			    CHAN_HEADER [.CHAN] = .HEADER_PTR;

			    IF (UUO (1, %O'050', .CHAN, OPEN_BLOCK) EQL 0) THEN 	! ISSUE OPEN UUO
				ERRMSG (0, 3, ROUTINE_NAME, .FNAME, 0, 0, 0)
			    ELSE
				BEGIN		!OPEN UUO SUCCEEDED.

				IF ((BUF_PTR = GETSTG (%O'203')) EQL 0)
				THEN
				    ERRMSG (0, 1, ROUTINE_NAME, 0,
					0, 0, 0)
				ELSE
				    BEGIN
				    SAVEJOBFF = .(%NAME ('.JBFF'));
				    %NAME ('.JBFF') = .BUF_PTR;
				    CHAN_BUFFER [.CHAN] = .BUF_PTR;
				    LOOKUP_BLOCK [0] = .FILE_NAME;
				    LOOKUP_BLOCK [1] = .FILE_EXT;
				    LOOKUP_BLOCK [2] = LOOKUP_BLOCK [3] = 0;

				    IF (.IO NEQ 0)
				    THEN
					UUO (0, %O'065', .CHAN, 1)	!OUTBUF
				    ELSE
					UUO (0, %O'064', .CHAN, 1);	!INBUF

				    %NAME ('.JBFF') = .SAVEJOBFF;

				    IF (.IO NEQ 0)
				    THEN
					SUCCESS = UUO (1, %O'077', .CHAN, LOOKUP_BLOCK)	!ENTER
				    ELSE
					SUCCESS = UUO (1, %O'076', .CHAN, LOOKUP_BLOCK);	!LOOKUP

				    IF (.SUCCESS EQL 0)
				    THEN
					ERRMSG (0, 4, ROUTINE_NAME, .FNAME,
					    .LOOKUP_BLOCK [3], 0, 0)
				    ELSE
					BEGIN
					CHAN_STATUS [.CHAN] = .MODE;
					CHAN_DIRECTION [.CHAN] = .IO;
					CHAN_CTR [.CHAN] = 0;
					RESULT = 1;	!FLAG SUCCESSFUL OPEN
					END;	!OF LOOKUP/ENTER SUCCEEDED

				    END;	!OF BUFFER STORAGE OBTAINED

				END;		!OF OPEN UUO SUCCEEDED

			    END;		!OF HEADER STORAGE OBTAINED

			END;			!OF FILE NAME PROVIDED

		    END;			!OF PARMS SEEM OK

    .RESULT
    END;					!OF ROUTINE OPEN
GLOBAL ROUTINE CLOSE (CHANX) : NOVALUE = 	! CLOSE A CHANNEL

!++
! FUNCTIONAL DESCRIPTION:
!
!	THE CLOSE ROUTINE CLOSES A CHANNEL.
!
! FORMAL PARAMETERS:
!
!	CHANX - THE CHANNEL TO CLOSE.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	CLOSES THE CHANNEL BY DOING UUOS AND MODIFYING OWN STORAGE
!
!--

    BEGIN

    LOCAL
	CHAN;

    BUILTIN
	UUO;

    CHAN = .CHANX;

    IF (.CHAN EQL 0)
    THEN
	ERROR (UPLIT (%ASCIZ'YOU MAY NOT CLOSE CHANNEL 0 - CLOSE'))
    ELSE

	IF ((.CHAN LSS 0) OR (.CHAN GTR 15))
	THEN
	    ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - CLOSE'))
	ELSE

	    IF (.CHAN_STATUS [.CHAN] EQL 0)
	    THEN
		ERROR (UPLIT (%ASCIZ'CHANNEL IS NOT OPEN - CLOSE'))
	    ELSE
		BEGIN				!CHANNEL NUMBER SEEMS OK

		IF (.CHAN_DIRECTION [.CHAN] EQL 1)
		THEN
		    BEGIN			!ADJUST BYTE POINTER TO LAST BYTE

		    INCR COUNTER FROM 1 TO 8 DO
			OUTPUT (.CHAN, 0);

		    END;

		UUO (0, %O'070', .CHAN, 0);	!CLOSE
		FRESTG (.CHAN_BUFFER [.CHAN], %O'203');
		FRESTG (.CHAN_HEADER [.CHAN], 3);
		CHAN_STATUS [.CHAN] = 0;
		END;				!CHANNEL NUMBER OK

    END;					!OF ROUTINE CLOSE
GLOBAL ROUTINE INPUT (CHANX) = 			! READ FROM AN I/O DEVICE

!++
! FUNCTIONAL DESCRIPTION:
!
!	READ A BYTE OR WORD FROM THE SPECIFIED CHANNEL
!	 EOF OR ERROR RETURNS A -1
!
! FORMAL PARAMETERS:
!
!	CHANX - THE CHANNEL OVER WHICH TO READ THE BYTE OR WORD
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	THE BYTE OR WORD READ
!
! SIDE EFFECTS
!
!	REMOVES ONE BYTE OR WORD FROM THE INPUT STRING
!
!--

    BEGIN

    LOCAL
	CHAN,
	CHAN_WORD_TMP,
	CHARACTER,
	FILI : REF VECTOR [3],
	STATUS;

    BUILTIN
	UUO;

    CHAN = .CHANX;
    CHARACTER = 0;

    IF ((.CHAN LSS 0) OR (.CHAN GTR 15))
    THEN
	ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - INPUT'))
    ELSE

	IF (.CHAN EQL 0)
	THEN
	    BEGIN				!CHANNEL 0 IS THE TERMINAL
	    UUO (0, %O'051', 4, CHARACTER);	!INCHWL
	    END
	ELSE
	    BEGIN				!NOT CHANNEL 0

	    IF (.CHAN_STATUS [.CHAN] EQL 0)
	    THEN
		ERROR (UPLIT (%ASCIZ'CHANNEL NOT OPEN - INPUT'))
	    ELSE

		IF (.CHAN_DIRECTION [.CHAN] NEQ 0)
		THEN
		    ERROR (UPLIT (%ASCIZ'CHANNEL NOT OPEN FOR INPUT - INPUT'))
		ELSE
		    BEGIN			!LOOKS OK
		    CHAN_WORD_TMP = .CHAN_WORD [.CHAN];

		    IF (.CHAN_CTR [.CHAN] NEQ 0)
		    THEN
			BEGIN			!TAKE A BYTE FROM CURRENT WORD
			CHARACTER = .CHAN_WORD_TMP<(CASE .CHAN_CTR [.CHAN] FROM 1 TO 3 OF
				SET
				[1] : 26;
				[2] : 0;
				[3] : 8;
				TES), 8>;
			CHAN_CTR [.CHAN] = .CHAN_CTR [.CHAN] + 1;

			IF (.CHAN_CTR [.CHAN] EQL 4) THEN CHAN_CTR [.CHAN] = 0;

			END
		    ELSE
			BEGIN			!NEED A NEW WORD
			FILI = .CHAN_HEADER [.CHAN];

			IF ((FILI [2] = .FILI [2] - 1) LEQ 0)
			THEN
			    BEGIN		!NEED A NEW BUFFER

			    IF (UUO (1, %O'056', .CHAN, 0) NEQ 0)	!IN UUO
			    THEN
				BEGIN
				BEGIN

				IF (UUO (1, %O'063', .CHAN, %O'20000') NEQ 0)	!STATZ UUO
				THEN
				    BEGIN
				    UUO (0, %O'062', .CHAN, STATUS);	! GETSTS
				    ERRMSG (0, 5, UPLIT (%ASCIZ'INPUT'), CHAN_FNAME [.CHAN*FILE_NAME_LEN],
					.STATUS, 0, 0);
				    END;

				END;
				CHARACTER = -1;	!THIS VALUE RETURNED ON EOF OR ERROR
				END
			    ELSE
				BEGIN
				FILI [1] = CH$PLUS (.FILI [1], -1);
				CHARACTER = CH$A_RCHAR (FILI [1]);
				END

			    END
			ELSE
			    CHARACTER = CH$A_RCHAR (FILI [1]);

			IF ((.CHAN_STATUS [.CHAN] EQL 2) AND (.CHARACTER GEQ 0))
			THEN
			    BEGIN		!WORD INPUT MODE, NOT EOF
			    CHAN_WORD [.CHAN] = .CHARACTER;
			    CHAN_WORD_TMP = .CHARACTER;
			    CHAN_CTR [.CHAN] = 1;
			    CHARACTER = .CHAN_WORD_TMP<18, 8>;
			    END;

			END;			!OF NEED NEW LONG WORD

		    END;			!OF "LOOKS OK"

	    END;				!OF NOT CHANNEL 0

    .CHARACTER
    END;					!OF INPUT ROUTINE
GLOBAL ROUTINE OUTPUT (CHANX, OUTWRD) : NOVALUE = 	! WRITE ON AN I/O DEVICE

!++
! FUNCTIONAL DESCRIPTION:
!
!	WRITE THE SPECIFIED BYTE OR WORD OUT THROUGH THE CHANNEL.
!
! FORMAL PARAMETERS:
!
!	CHANX - THE CHANNEL TO SEND DATA THROUGH
!	OUTWRD - THE BYTE OR WORD TO SEND
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	PLACES ONE MORE WORD OR BYTE ON THE I/O DEVICE
!
!--

    BEGIN

    LOCAL
	CHAN,
	CHAN_WORD_TMP,
	CHARACTER,
	FILI : REF VECTOR [3],
	STATUS;

    BUILTIN
	UUO;

    CHAN = .CHANX;

    IF ((.CHAN LSS 0) OR (.CHAN GTR 15))
    THEN
	ERROR (UPLIT (%ASCIZ'INVALID CHANNEL NUMBER - OUTPUT'))
    ELSE

	IF (.CHAN EQL 0)
	THEN
	    BEGIN				!CHANNEL 0 IS THE TERMINAL
	    UUO (0, %O'051', 1, OUTWRD);	!OUTCHR
	    END
	ELSE
	    BEGIN				!NOT CHANNEL 0

	    IF (.CHAN_STATUS [.CHAN] EQL 0)
	    THEN
		ERROR (UPLIT (%ASCIZ'CHANNEL NOT OPEN - OUTPUT'))
	    ELSE

		IF (.CHAN_DIRECTION [.CHAN] NEQ 1)
		THEN
		    ERROR (UPLIT (%ASCIZ'CHANNEL NOT OPEN FOR OUTPUT - OUTPUT'))
		ELSE
		    BEGIN			!LOOKS OK
		    CHAN_WORD_TMP = .CHAN_WORD [.CHAN];

		    IF (.CHAN_STATUS [.CHAN] EQL 2)
		    THEN
			BEGIN			!BINARY MODE, PACK BYTES
			CHAN_WORD_TMP<(CASE .CHAN_CTR [.CHAN] FROM 0 TO 3 OF
				SET
				[0] : 18;
				[1] : 26;
				[2] : 0;
				[3] : 8;
				TES), 8> = .OUTWRD;
			CHAN_CTR [.CHAN] = .CHAN_CTR [.CHAN] + 1;

			IF (.CHAN_CTR [.CHAN] EQL 4) THEN CHAN_CTR [.CHAN] = 0;

			END			!BINARY MODE PACKING
		    ELSE
			CHAN_WORD_TMP = .OUTWRD<0, 7>;

		    IF (.CHAN_CTR [.CHAN] EQL 0)
		    THEN
			BEGIN			!NEED TO WRITE LONG WORD
			FILI = .CHAN_HEADER [.CHAN];

			IF ((FILI [2] = .FILI [2] - 1) LEQ 0)
			THEN
			    BEGIN		!DUMP BUFFER

			    IF (UUO (1, %O'057', .CHAN, 0) NEQ 0)	!OUT UUO
			    THEN
				BEGIN
				UUO (0, %O'062', .CHAN, STATUS);	! GETSTS
				ERRMSG (0, 5, UPLIT (%ASCIZ'OUTPUT'), CHAN_FNAME [.CHAN*FILE_NAME_LEN],
				    .STATUS, 0, 0);
				END
			    ELSE
				FILI [1] = CH$PLUS (.FILI [1], -1);

			    END;

			CH$A_WCHAR (.CHAN_WORD_TMP, FILI [1]);
			END;			!OF NEED TO WRITE LONG WORD

		    CHAN_WORD [.CHAN] = .CHAN_WORD_TMP;
		    END;			!OF "LOOKS OK"

	    END;				!OF NOT CHANNEL 0

    END;					!OF OUTPUT ROUTINE
GLOBAL ROUTINE STOP_PROGRAM : NOVALUE = 		!TERMINATE PROGRAM

!++
! FUNCTIONAL DESCRIPTION:
!
!
!	TERMINATE PROGRAM EXECUTION PROBABLY DUE TO SOME FATAL
!	 ERROR. USES "EXIT" UUO.
!
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	NONE
!
! SIDE EFFECTS
!
!	HALTS THE PROGRAM
!
!--

    BEGIN

    BUILTIN
	UUO;

    UUO (0, %O'047', 1, %O'12');
    END;					!OF STOP_PROGRAM

!
END

ELUDOM
! Local Modes:
! Comment Start:!
! Comment Column:36
! Auto Save Mode:2
! Mode:Fundamental
! End: