Google
 

Trailing-Edge - PDP-10 Archives - BB-X117B-SB_1986 - 10,7/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) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1986. ALL RIGHTS RESERVED.
!
!
!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: