!***COPYRIGHT (C) 1974, 1975, 1976, 1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
%%
%
	THIS MODULE CONTAINS ALL THE FILE I/O ROUTINES.

	GETFIL - GIVEN FILE SPEC, DOES OPEN, LOOKUP/ENTER, INBUF/OUTBUF, RETURNS CHANNEL
	INBYT  - READS FROM SPECIFIED INPUT FILE
	OTBYT  - WRITES TO SPECIFIED OUTPUT FILE
	CLOFIL - CLOSES A FILE
	RESET  - DOES RESET UUO
	BUFSIZ - GETS BUFFER SIZE FOR GIVEN DEVICE
	GETBUF - GETS SPECIFIED NUMBER OF BUFFERS

%
%%

MODULE FILEIO (MLIST,FSAVE,TIMER=EXTERNAL(SIX12)) =
BEGIN
	! BINDS FOR CREATING I/O UUO'S
	BIND	OPEN = #50,	IN = #56,	OUT = #57,
		STATZ = #63,	CLOSE = #70,	RELEASE = #71,
		LOOKUP = #76,	ENTER = #77,	INBUF=#64,
		OUTBUF=#65;


	! USEFUL MACROS FOR DOING I/O
	MACRO
		SKIP(OP) = IFSKIP(OP) THEN TRUE ELSE FALSE$,
		MAKEOP(OP,REG,ADDR) = (OP)<0,0>^27 + (REG)<0,0>^23 + (ADDR)<0,0>$,
		EXECUTE(X) = (REGISTER INST; INST _ X; SKIP(XCT(0,INST)))$;

	MACHOP	XCT = #256;			! THIS INSTRUCTION DOES ALL THE WORK
REQUIRE COMMON.BLI;
REQUIRE ENTRY.BLI;
COMMENT(GETFIL);

! SUBROUTINE GETFIL
! ========== ======

! THIS ROUTINE TAKES A FILE SPEC AND OPENS THE DEVICE,
! DOES A LOOKUP/INBUF OR ENTER/OUTBUF AS APPROPRIATE,
! AND RETURNS THE CHANNEL ASSIGNED. THE SPECIAL CASING OF OLDCHNL
! IS TO ALLOW THE REUSE OF THE DEVICE-CHANNEL SETUP
! AND THE BUFFERS FOR SORT SCRATCH FILES.

! LAST MODIFIED ON 14 AUG  74 BY JG.

GLOBAL ROUTINE GETFILE(TYPE,IOMODE,DEV,FILE,EXT,PPN,OLDCHN) =
BEGIN
	LOCAL	CHANNEL,CODE[5],FILEPTR;
	LABEL	GETCHN;
	MAP	FILBLK FILEPTR;

	CHANNEL _ -1;					! SO WE KNOW IF WE LOSE OUT
	IF .OLDCHN GEQ 0
	THEN CHANNEL _ .OLDCHN				! USE SPECIFIED CHANNEL
	ELSE GETCHN: INCR I FROM 0 TO 15		! OR SEARCH FOR A FREE ONE
	DO BEGIN
		IF .CHANLS[.I] EQL NULL			! DOES NOT POINT TO EXISTING FILE BLOCK
		THEN BEGIN
			CHANNEL _ .I;			! USE IT
			LEAVE GETCHN
		END
	END;
	IF .CHANNEL EQL -1
	THEN BEGIN					! WE LOST
		ERTEXT(17);				! NO CHANNELS AVAILIBLE
		RETURN -1
	END;

	IF .OLDCHN GEQ 0
	THEN BEGIN
		FILEPTR _ .CHANLS[.CHANNEL];		! USING OLD FILE BLOCK
		FILEPTR[BYTCNT] _ 0			! FORCE A UUO CALL DURING INBYT OR OTBYT CALL
	END
	ELSE BEGIN
		IF (FILEPTR _ ALLOC(FILEBLKSIZ)) EQL NULL		
			THEN RETURN -1;			! COULDN'T GET FILE BLOCK
		CHANLS[.CHANNEL] _ .FILEPTR;		! REMEMBER CHANNEL ASSIGNMENT
		FILEPTR[STATUS] _ .IOMODE;		! NOW COPY ALL THE GOODIES INTO THE FILE BLOCK
		FILEPTR[DEVICE] _ .DEV;
		FILEPTR[FILENAME] _ .FILE;
		FILEPTR[EXTENSION] _ .EXT<LH>;
		FILEPTR[PPNUM] _ .PPN;
		FILEPTR[OTBUFPTR] _ FILEPTR[BUFHDR];
		FILEPTR[INBUFPTR] _ FILEPTR[BUFHDR];
	END;
	
	% WE START OFF BY DOING AN OPEN UUO IF THIS IS A NEW CHANNEL %

	IF (IF .OLDCHN GEQ 0 THEN TRUE ELSE EXECUTE(MAKEOP(OPEN,.CHANNEL,FILEPTR[STATUS])))
	THEN IF .TYPE EQL INFILE
		THEN IF EXECUTE(MAKEOP(LOOKUP,.CHANNEL,FILEPTR[FILENAME])) ! DO LOOKUP FOR INPUT FILES
			THEN BEGIN
				IF .OLDCHN LSS 0	! GET BUFFERS FOR NEW CHANNELS
				THEN IF GETBUF(.CHANNEL,5) IS FALSE
				THEN BEGIN		! ERROR DURING BUFFER SETUP
					CHANLS[.CHANNEL] _ NULL;
					EXECUTE(MAKEOP(RELEASE,.CHANNEL,0));! BE NEAT ABOUT THINGS
					RETURN -1
				END
			END
			ELSE BEGIN			! LOOKUP FAILED
				CNVCHR(.FILEPTR[LOKENTERR],CODE,8);! GET REASON WHY
				ERTEXT(18);TTYOTS(.CODE[LANGTH],CODE[STRING]);
				PRTSPC(.CHANNEL);
				CHANLS[.CHANNEL] _ NULL;
				EXECUTE(MAKEOP(RELEASE,.CHANNEL,0));! BE NEAT
				RETURN -1
			END
		ELSE IF EXECUTE(MAKEOP(ENTER,.CHANNEL,FILEPTR[FILENAME])) ! DO ENTER FOR OUTPUT FILES
			THEN BEGIN
				IF .OLDCHN LSS 0	! GET BUFFERS FOR NEW CHANNELS
				THEN IF GETBUF(.CHANNEL,5) IS FALSE
				THEN BEGIN		! ERROR DURING BUFFER SETUP
					CHANLS[.CHANNEL] _ NULL;
					EXECUTE(MAKEOP(RELEASE,.CHANNEL,0));! BE NEAT
					RETURN -1
				END;
				OTBYT(.CHANNEL,-1,0)	! DUMMY OUT UUO TO INITIALIZE BUFFER RING
			END
			ELSE BEGIN			! ENTER LOST
				CNVCHR(.FILEPTR[LOKENTERR],CODE,8);! GET REASON WHY
				ERTEXT(19); TTYOTS(.CODE[LANGTH],CODE[STRING]);
				PRTSPC(.CHANNEL);
				CHANLS[.CHANNEL] _ NULL;
				EXECUTE(MAKEOP(RELEASE,.CHANNEL,0));! BE NEAT
				RETURN -1
			END
	ELSE BEGIN					! BIG PROBLEMS - THE OPEN FAILED !
		TTYOSX(.DEV); ERTEXT(20);
		IF .TYPE EQL INFILE
			THEN TTYOTN(0,PLIT ASCIZ 'INPUT.')
			ELSE TTYOTN(0,PLIT ASCIZ 'OUTPUT.');
		CHANLS[.CHANNEL] _ NULL;
		RETURN -1
	END;
	RETURN .CHANNEL					! IF WE GET HERE, WE HAVE A CHARMED LIFE
END;
COMMENT(INBYT);

! SUBROUTINE INBYT
! ========== =====

! THIS ROUTINE READS DATA FROM AN INPUT FILE
! USING THE SPECIFIED CHANNEL. IF COUNT IS ZERO,
! ONE BYTE (7 OR 36 BIT, DEPENDING ON THE DATA MODE)
! IS PLACED IN THE LOCATION POINTED TO BY DATAPTR.
! IF COUNT IS GREATER THAN ZERO, COUNT BYTES
! ARE READ IN AND PLACED STARTING AT DATAPTR; IN
! THIS CASE, DATAPTR SHOULD BE AN INCREMENT TYPE
! BYTE POINTER.
! LAST MODIFIED ON 1 AUG 74 BY JG.

GLOBAL ROUTINE INBYT(CHANNEL,COUNT,DATAPTR) =
BEGIN
	LOCAL FILEPTR,CODE;
	MAP   FILBLK FILEPTR;

	FUNCTION NEWBUF = IF EXECUTE(MAKEOP(IN,.CHANNEL,0)) ! GETS NEW BUFFER, MUST BE FUNCTION
			   THEN IF EXECUTE(MAKEOP(STATZ,.CHANNEL,740000))
				THEN 0			! EOF
				ELSE -1			! ERROR
			   ELSE 1;			! OK

	FILEPTR _ .CHANLS[.CHANNEL];			! GET FILEBLK POINTER
	IF .FILEPTR[BYTCNT] EQL 0			! NEED A NEW BIFFER?
	THEN IF (CODE _ NEWBUF()) NEQ TRUE
		THEN RETURN .CODE;			! EOF OR ERROR
	IF .COUNT EQL 0
	THEN BEGIN					! ONLY ONE "BYTE", DATAPTR POINTS RIGHT AT IT
		COPYIN(FILEPTR[BYTPTR],DATAPTR);
		FILEPTR[BYTCNT] _ .FILEPTR[BYTCNT]-1;	! DECREMENT REMAINING CHAR CNT
		RETURN TRUE				! ALL OK
	END
	ELSE DECR I FROM .COUNT-1 TO 0			! READ NUMBER OF "BYTES", DATAPTR IS INCREMENT TYPE
	DO BEGIN
		IF .FILEPTR[BYTCNT] EQL 0		! NEED NEW BUFFER?
		THEN IF (CODE _ NEWBUF()) NEQ TRUE
			THEN RETURN .CODE;		! EOF OR ERROR
		COPYII(FILEPTR[BYTPTR],DATAPTR);
		FILEPTR[BYTCNT] _ .FILEPTR[BYTCNT]-1;	! DECREMENT REMAINING CHAR CNT
	END;
	TRUE						! ALL OK
END;
COMMENT(OTBYT);

! SUBROUTINE OTBYT
! ========== =====

! THIS ROUTINE IS ESSENTIALLY THE SAME AS INBYT,
! EXECPT THAT IT DOES OUTPUT.
! LAST MODIFIED ON 1 AUG 74 BY JG.

GLOBAL ROUTINE OTBYT (CHANNEL,COUNT,DATAPTR) =
BEGIN
	LOCAL CODE,FILEPTR;
	MAP   FILBLK FILEPTR;

	FUNCTION NEWBUF = IF EXECUTE(MAKEOP(OUT,.CHANNEL,0)) ! GETS NEW BUFFERS, MUST BE FUNCTION
			 THEN -1			! ERROR
			 ELSE 1;			! OK

	FILEPTR _ .CHANLS[.CHANNEL];			! GET POINTER TO FILE BLOCK
	IF .FILEPTR[BYTCNT] EQL 0			! NEED NEW BUFFER?
	THEN IF (CODE _ NEWBUF()) NEQ TRUE
		THEN RETURN .CODE;			! ERROR
	IF .COUNT EQL 0					! ONE "BYTE"
	THEN BEGIN
		COPYNI(DATAPTR,FILEPTR[BYTPTR]);
		FILEPTR[BYTCNT] _ .FILEPTR[BYTCNT]-1;	! DECREMENT SPACE LEFT
		RETURN TRUE
	END
	ELSE DECR I FROM .COUNT-1 TO 0			! MUTIPLE "BYTES"
	DO BEGIN
		IF .FILEPTR[BYTCNT] EQL 0		! NEED NEW BUFFER?
		THEN IF (CODE _ NEWBUF()) NEQ TRUE
			THEN RETURN .CODE;		! ERROR
		COPYII(DATAPTR,FILEPTR[BYTPTR]);
		FILEPTR[BYTCNT] _ .FILEPTR[BYTCNT]-1	! DECREMENT SPACE LEFT
	END;
	TRUE
END;
COMMENT(CLOFIL);

! SUBROUTINE CLOFIL
! ========== ======

! THIS ROUTINE CLOSES THE FILE ON THE SPECIFIED
! CHANNEL AND RELEASES THE DEVICE IF SAVEFLAG IS FALSE.
! LAST MODIFIED ON 28 AUG 74 BY JG.

GLOBAL ROUTINE CLOFIL (CHANNEL,KILLFLAG) =
BEGIN
	EXECUTE(MAKEOP(CLOSE,.CHANNEL,0));		! CLOSE UUO
	IF EXECUTE(MAKEOP(STATZ,.CHANNEL,#740000))	! ERROR?
	THEN BEGIN					! NO
		IF  .KILLFLAG				! DO RELEASE?
		THEN BEGIN				! YES
			EXECUTE(MAKEOP(RELEASE,.CHANNEL,0));! RELEASE CHANNEL
			CHANLS[.CHANNEL] _ NULL		! FORGET CHANNEL ASSIGNMENT
		END;
		RETURN TRUE
	END
	ELSE BEGIN					! ERROR
		ERTEXT(23);
		PRTSPC(.CHANNEL);
		RETURN FALSE
	END
END;
COMMENT(RESET);

! SUBROUTINE RESET
! ========== =====

! THIS ROUTINE RESETS THE UNIVERSE (THAT IS,
! EVERYTHING BUT BLISS GLOBALS) VIA THE
! SUPER WONDERFUL RESET UUO.
! LAST MODIFIED ON 29 JUL 74 BY JG.

GLOBAL ROUTINE RESET =
BEGIN
	MACHOP CALLI=#47;
	CALLI(0,0);			! THAT'S IT, RIGHT THERE!!
	ZERO(CHANLS,16)			! ALL CHANNEL ASSIGNMENTS CEASE TO EXIST
END;
COMMENT(BUFSIZ);

! SUBROUTINE BUFSIZ
! ========== ======

! THIS ROUTINE RETURNS THE BUFFER SIZE AND DEFAULT
! NUMBER OF BUFFERS FOR THE GIVEN CHANNEL.
! LAST MODIFIED ON 14 AUG 74 BY JG.

GLOBAL ROUTINE BUFSIZ (CHANNEL) =
BEGIN
	REGISTER AC;
	MACHOP CALLI = #47;

	AC _ (.CHANLS[.CHANNEL])<ADDR>;			! GET CHANNEL
	IFSKIP CALLI(AC,#101)				! DO DEVSIZ UUO
	THEN IF .AC GTR 0
		THEN RETURN .AC;			! RETURN TASTY TIDBIT OF INFO
	FALSE						! BAD THINGS HAPPENED
END;
COMMENT(GETBUF);

! SUBROUTINE GETBUF
! ========== ======

! THIS ROUTINE ALLOCATES THE SPECIFIED NUMBER OF
! BUFFERS FOR A CHANNEL.
! LAST MODIFIED ON 14 AUG 74 BY JG.

GLOBAL ROUTINE GETBUF(CHANNEL,BUFNO) =
BEGIN
	LOCAL	FILEPTR,BUFFERSIZE,THISBUF,TEMP;
	MAP	FILBLK FILEPTR;

	IF .BUFNO LSS 1 THEN BUFNO _ 1;			! CAN'T HAVE LESS THAN ONE
	IF (BUFFERSIZE _ BUFSIZ(.CHANNEL)) IS FALSE	! GET BUFFER SIZE
	THEN BEGIN
		ERTEXT(40);
		RETURN FALSE
	END;
	IF (THISBUF _ ALLOC(.BUFFERSIZE<RH>)) IS NULL	! ALLOCATE FIRST BUFFER
		THEN RETURN FALSE;
	FILEPTR _ .CHANLS[.CHANNEL];			! GET FILE BLOCK PTR
	FILEPTR[BUFHDR]<LH> _ #400000;			! INITIALIZE RING HEADER
	FILEPTR[BUFHDR]<RH> _ .THISBUF+1;
	DECR I FROM .BUFNO-2 TO 0			! ADD REMAINING BUFFERS TO THE RING
	DO BEGIN
		IF (TEMP _ ALLOC(.BUFFERSIZE<RH>)) IS NULL ! GET BUFFER
			THEN RETURN FALSE;
		(.THISBUF+1)<RH> _ .TEMP+1;		! CHAIN FOWARD
		(.THISBUF+1)<LH> _ .BUFFERSIZE<RH>-2;	! SIZE-1
		THISBUF _ .TEMP				! CONTINUE
	END;
	(.THISBUF+1)<RH> _ .FILEPTR[BUFHDR]<RH>;	! LAST ONE ON CHAIN MUST
	(.THISBUF+1)<LH> _ .BUFFERSIZE<RH>-2;		! BE TAKEN CARE OF
	TRUE
END;

END ELUDOM;  ! END OF FILE I/O MODULE ...