Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

MODULE IO=
!TOPS-10 Dependent I/O routines and filespec parsing routines
!Compilation instructions:
!	IO,IO=IO/VARIANT:nnn
!nnn is decoded into bits as follows:
!1:	FTSIGNAL (FTSIG)	use signalling mechanism
!2:	FTNETSPL		special stuff for NETSPL
!4:	FTIPC			special stuff for IPC
!2000:	FTWILD			wildcard stuff
!4000:	FTALLOC			use ALLOC & FREE for core mgt.
BEGIN
!
! Conditional Compilation
!
COMPILETIME FTPSI=0;			!On to rely on software interrupts
COMPILETIME FTSIGNAL=(%VARIANT AND 1);	!Conditional for signal package
	!Conditional for signal package (on if /VAR:1)
COMPILETIME FTNETSPL=((%VARIANT AND 2) NEQ 0);
	!Conditional for NETSPL-only code
COMPILETIME FTWILD=((%VARIANT AND %O'2000') NEQ 0);
	!Conditional for wildcarding (on if /VAR:#2000)
COMPILETIME FTALLOC=((%VARIANT AND %O'4000') NEQ 0);
	!Conditional for core allocation stuff (on if /VAR:#4000)
%IF FTNETSPL %THEN !Force FTSIGNAL,FTWILD, & FTALLOC on
	%ASSIGN(FTSIGNAL,1) %ASSIGN(FTWILD,1) %ASSIGN(FTALLOC,1)
	%FI
!
! REQUIRE & LIBRARY declarations
!

%IF FTSIGNAL
	%THEN REQUIRE 'INTR.REQ';
	%ELSE LIBRARY 'IPCF';
%FI

!
! Forward declarations
!
UNDECLARE ZERO;
FORWARD ROUTINE
	FILOP,	!Open/close file
	FBINI,	!Initialize file block
	FBINIS,	!Set up file block, but not defaults
	INPUT,	!Read in a buffer
	OUTPUT,	!Write out " "
	READ,	!Read in a line
	WRITE,	!Write out a line
	BIN,	!Read in a character & return it
	BINA,	!Read a character & advance pointer
	BOUT,	!Write out a character
	BOUTA,	!write a character & advance pointer
	RDDIR,	!Parse a directory specifcation
	RDNUMA,
	RDSIXA,
	SWAP,
	PATH,
	ZERO,
	FUNPARSE,
	WRSIXA,
	WRSIX,	!Sixbit to ASCII
	FFIOCH,	!Find a free I/O channel
	RELEASE,	!Free up channel & release device
	RESETF,	!Reset a channel (RESDV.)
	OPENFILE;	!Open a file
!	SETSTS;
%IF FTALLOC %THEN
FORWARD ROUTINE
	FREEFB,	!Free a fileblock & all decendants
	BUFFALO,	!Allocate space for buffers
	BUFFREE:NOVALUE;!Free a buffer ring
%FI

THIS_IS [IO]

VERSION [4]	%IF FTSIG %THEN VMINOR [S]%FI	EDIT [34] DATE [18,MAY,79]
!++
!	Facility:	NETSPL,RMCOPY,NODTBL
!
!Abstract:
!	Subroutines to do filespec parsing, file selection,
!	and sequential I/O.  The entire module is TOPS-10 dependant.
!Author: Andrew Nourse

!	These routines can use the signalling mechanism, or just
!	return an error code.  To use signalling, compile as follows:
!	IO,IO=IO/VARIANT:1


%(***	R E V I S I O N   H I S T O R Y

[34]	Don't zero .JBFF on recursive OPENFI (like in error handler)
[33]	Fix so it will compile under BLISS-36 version 1A(114)
	(which does not like BLOCKs in registers)
[32]	ALWAYS restore JBFF after attempting to open something
[31]	Call RELEASE before INTFREE in FREEFB to avoid ill addr in UUO
[27]	Add BUFFALO routine to allocate buffer space, and OPENF to open files
[26]	Make FPARSE not force default to current path if defaulted
[25]	Make FUNPARSE return value of updated byte pointer instead of nothing
	Undeclare ZERO so no multiple definition
[24]	Recognize % as wildcard character, make definitions of chars a macro
[23]	Put in FILE$PF_NOSIG bit for FPARSE
[22]	Change default bit setting.  Sign bit off means reset before scanning
[21]	Put in changes to RDSIX,FPARSE,& RDDIR to allow wildcards sometimes
[20]	Put in FREEFB routine, put in FBTBL to remember where file blks are
[17]	Turn off interrupts while doing I/O (WAIT will turn back on)
[15]	Fix multiple shift of error code in BINA,BOUTA,READ,WRITE
	and 0-length buffer doesn't get bad data, Fix SFD's in FUNPARSE (..S)
	Make WRSIX not dependant on layout of stack in BLS36C
[14]	Put in REF (FILE_BLOCK) in PATH routine, don't assign chn 20
	put in RELEASE routine
[13]	Fix non-blocking INPUT & OUTPUT
[12]	Fix RDSIX some more (a loop got put back)
	Add routines to unparse a filespec
[11]	Fix bug in FPARSE which lost short filenames when no extension given
[10]	Change to use VAX/11 standard format error codes
	and use VARIANT to specify signalling version
[9]	Fix FBINI to put PATH. block addr in LOOKUP block
[8]	Replace recursive RDSIX with ordinary type
[7]	Fix bug in DECR loops in READ & WRITE.
[6]	Change some obsolete comments, put in SIGNAL stuff,
	Change BIN to BINA and BOUT to BOUTA
[0-5]	The distant past.....

	E N D	R E V I S I O N   H I S T O R Y	)%
!
! Global Data Areas
!
GLOBAL FBTBL: VECTOR[16];
!
! External References
!
%IF FTALLOC	!Core management stuff
	%THEN EXTERNAL ROUTINE
			ALLOC,	!Get some core
			FREE;	!Release core
EXTERNAL SAVJBFF;		!Save value of JBFF while making buffers
		!This should always contain either the first free location or 0
	%FI
EXTERNAL ROUTINE
	WRNUMA;		!Convert a number to ASCII
%IF FTWILD	!Wildcard conditional compilation
	%THEN EXTERNAL ROUTINE MSKW6; !Return mask for wildcard (sixbit) chars
	%FI
!
! Builtin, Literals, and Bound declarations
!

LITERAL DEFAULT_IORETI=1;	!Try every 2/3 second
BUILTIN MACHSKIP,MACHOP;
%IF NOT %DECLARED(PATMIN)
	%THEN LITERAL PATMIN=4; %FI	!# of words in path block w/o SFD's
LITERAL EQMSGSIZE=%O'1000';	!These are always sent as pages
BIND JBFF=%O'121';	!in JOB DATA AREA

!
! Macros
!
MACRO	FILENAME_CHARS=%C'A' TO %C'Z',%C'0' TO %C'9'%,
	WILD_1=%C'%',%C'?'%,
	WILD_N=%C'*'%,
	LOWER_CASE=%C'A'+%O'40' TO %C'Z'+%O'40'%;
MACRO XCT(AA)=MACHOP(%O'256',0,AA)%;
MACRO DEVSIZ(R)=CALLI(R,%O'101') %;	!DEVSIZ UUO
MACRO	IOERRCODE(X)=
			BEGIN
			IF (.X XOR ENDFILE) EQL 0
				THEN WARNING(ENDFILE,.FILBLK)
				ELSE ERROR(IOERROR,.FILBLK,.X)
			END%;
MACRO ERR_INTERPRET=
	BEGIN
	%IF FTSIG
		%THEN
		IF .FF EQL 0
		THEN	BEGIN
			LOCAL IB: REF INT_BLOCK;
			%IF NOT FTPSI %THEN
			EXTERNAL ROUTINE
				UDT,
				TSIGNL,
				TSICAN;
			LOCAL RETRYIT: INT_BLOCK;
			LOCAL RTR;	!Handle for timer
			CLEARV(RETRYIT);!Empty block for wakeup only
			RTR=TSIGNL(RETRYIT,UDT()+.IORETINTERVAL);
			%FI
			IF (IB=.FILBLK[FILE$IB]) EQL 0
				THEN CRASH('Interrupt block missing');
			WAIT(.IB);	!Wait for 'done' interrupt
			%IF NOT FTPSI %THEN TSICAN(.RTR); %FI
			END
		ELSE IOERRCODE(FF)
	%ELSE IOERRCODE(FF)
	%FI
	END%;
%IF NOT FTSIG
	%THEN			!Bypass signalling stuff if not using it
	MACRO	NOSIGNAL[]=%REMAINING%;
	MACRO	INTERRUPTS[]=%,
		NOINTS[]=%REMAINING%,
		WAIT[]=%;		!Make No-op of calls to these
	%FI

MACRO	INSTR_ADDRESS=0,18 %,
	INSTR_OPCODE=27,9  %,
	INSTR_AC=23,4      %;

!
! Tell about conditionals
!

%IF FTNETSPL %THEN
%INFORM('IO for NETSPL')
%ELSE
	%IF (FTSIGNAL) %THEN
		%INFORM('IO being built with PSI support')
	%FI
	%IF (FTWILD) %THEN
		%INFORM('IO being built with wildcard support')
	%FI
	%IF (FTALLOC) %THEN
		%INFORM('IO being built with core management support')
	%FI
%FI
!
! Global data
!
GLOBAL	IORETINTERVAL: INITIAL(DEFAULT_IORETI); !How often check I/O done

GLOBAL ROUTINE FILOP(FILBLK)=
!Bottom-level file selection routine
!FILBLK is a file block which should be already set up,
!including the FILOP. function code.
!Returns -1 if successful
BEGIN
REGISTER F;
F=XWD(8,.FILBLK);	!Point to File block 
			!(which curiously enough, is a FILOP. block)
IF CALLI(F,%O'155')	!FILOP. UUO
	THEN WIN	!RETURN WIN IF SUCCESSFUL
	ELSE	BEGIN
		IF .F GTR %O'77' THEN ERROR(FILOPN,.FILBLK); !Open Failure
		ERROR(FILERR+.F,.FILBLK) !Else include lookup error code
		END
END;

GLOBAL ROUTINE FBINI(FILBLK)=
!This sets up a file block for the first time it gets used
!It only sets up pointers, not filespecs.

BEGIN
MAP FILBLK: REF FILE_BLOCK;

!First Zero out everything

ZERO(.FILBLK,.FILBLK+FB_LEN-1);

!Now fill in the required pointers in the FILOP. block

FILBLK[FILE$COUNT]=%FIELDEXPAND(FILE$ALLOC,0)-%FIELDEXPAND(FILE$COUNT,0);
					!# OF WORDS IN LOOKUP/ENTER BLOCK
FBINIS(FILBLK[FILE$START]);		!Set up the pointers
FFIOCH(.FILBLK)				!Find a free channel for I/O
END;	!FBINI


GLOBAL ROUTINE FBINIS(FILBLK)=
BEGIN
!Set up the pointers inside a file block
!This does not initialize any of the other fields, or get a channel #

!
! Formal Parameters
!
MAP FILBLK: REF FILE_BLOCK;	!Address of the file block

!
! Returned value
!

!	none
FILBLK[FILE$LOOKUP]=FILBLK[FILE$COUNT];	!Set up pointer to lookup block
FILBLK[FILE$LPATH]=FILBLK[FILE$PATH_FUN];	!PATH block pointer in LOOKUP block
FILBLK[FILE$PATH_LEN]=SFDMAX+PATMIN;
FILBLK[FILE$PATH_BLOCK]=FILBLK[FILE$PATH_FUN];
FILBLK[FILE$I_BRH]=FILBLK[FILE$I_CBUFF];	!Input buffer ring header pointer
FILBLK[FILE$O_BRH]=FILBLK[FILE$O_CBUFF];	!Output ...
FILBLK[FILE$I_NBUFF]=-1;			!Use default # of buffers
FILBLK[FILE$O_NBUFF]=-1;			! "    "
FILBLK[FILE$DEVICE]=%SIXBIT 'DSK   ';
END;	!FBINIS

GLOBAL ROUTINE INPUT(FILBLK)=
!ROUTINE TO INPUT A BUFFER.
!TAKES FILE BLOCK AS ARGUMENT
!RETURN WIN IF SUCCESSFUL

BEGIN
REGISTER FF; MAP FF: INSTRUCTION;	!WE WILL BUILD THE INSTRUCTION HERE
MAP FILBLK: REF FILE_BLOCK;
BUILTIN LSH;
%IF FTNETSPL %THEN LITERAL IOERROR=INERROR;
%FI	!NETSPL should be able to tell input errors from output errors

DO	BEGIN	!While 1
	LOCAL GG;			!Status goes here
	FF=0;				!Initialize the AC
	IF .FILBLK[FILE$I_NBUFF] EQL 0 THEN	!Must be dump mode
		FF<INSTR_ADDRESS>=.FILBLK[FILE$I_IOLIST]; !Address of I/O list
	FF<INSTR_AC>=.FILBLK[FILE$CHANNEL];	!Channel # for instruction
	FF<INSTR_OPCODE>=%O'056';	!OR IN THE OPCODE
	IF MACHSKIP(%O'256',0,FF)	!ERROR OR NOT FINISHED YET
	THEN	BEGIN
		FF<INSTR_OPCODE>=%O'062';	!OR IN GETSTS OPCODE
		FF<INSTR_ADDRESS>=GG;	!Return status to register
		MACHOP(%O'256',0,FF);		!GETSTS UUO
		FF=(.GG AND %O'760000');	!Only error bits
		ERR_INTERPRET;		!Figure out what went wrong
		END

	ELSE	BEGIN
		FILBLK[FILE$READS]=.FILBLK[FILE$READS]+1;
		!Bump count of blocks read
		RETURN WIN		!RETURN WIN IF SUCCESSFUL
		END
	END WHILE 1
END;

GLOBAL ROUTINE OUTPUT(FILBLK)=
!ROUTINE TO OUTPUT A BUFFER.
!TAKES FILE BLOCK AS ARGUMENT
!RETURN WIN IF SUCCESSFUL

BEGIN
REGISTER FF;	!WE WILL BUILD THE INSTRUCTION HERE
MAP FILBLK: REF FILE_BLOCK;
BUILTIN LSH;
MAP FF:INSTRUCTION;
%IF FTNETSPL %THEN LITERAL IOERROR=OUTERROR;
%FI	!Netspl needs to know the difference between input & output errors

DO	BEGIN	!While 1
	LOCAL GG;			!Status goes here
	FF=0;				!Initialize the AC
	IF .FILBLK[FILE$O_NBUFF] EQL 0 THEN	!Must be dump mode
		FF<INSTR_ADDRESS>=.FILBLK[FILE$O_IOLIST]; !Address of I/O list
	FF<INSTR_AC>=.FILBLK[FILE$CHANNEL];	!Channel # for instruction
	FF<INSTR_OPCODE>=%O'057';	!OR IN THE OPCODE
	IF MACHSKIP(%O'256',0,FF)	!ERROR OR NOT FINISHED YET
	THEN	BEGIN
		FF<INSTR_OPCODE>=%O'062';	!OR IN GETSTS OPCODE
		FF<INSTR_ADDRESS>=GG;	!Return status to register
		MACHOP(%O'256',0,FF);		!GETSTS UUO
		FF=(.GG AND %O'760000');	!Only error bits
		ERR_INTERPRET;		!Figure out what went wrong
		END

	ELSE	BEGIN
		FILBLK[FILE$WRITES]=.FILBLK[FILE$WRITES]+1;
		!Bump count of blocks written
		RETURN WIN		!RETURN WIN IF SUCCESSFUL
		END
	END WHILE 1
END;

GLOBAL ROUTINE READ(FILBLK,DEST,MAXCHARS,TERMINATOR)=
!ROUTINE TO READ A STRING FROM A FILE
!PARAMETERS:
!FILBLK: FILE BLOCK (SOURCE)
!DEST:	ADDR OF DESTINATION BYTE POINTER
!MAXCHARS: MAXIMUM # OF CHARACTERS TO INPUT;
!TERMINATOR: TERMINATE INPUT IF THIS CHARACTER IS FOUND
!RETURNS WIN if count exhausted, TERMINATOR otherwise
BEGIN
REGISTER ODEST,C;
	DECR MAXC FROM .MAXCHARS TO 0 DO BEGIN
	ODEST=..DEST;	!Save pointer to character we are about to read
	C=BINA(.FILBLK,.DEST);
	NOSIGNAL< IF .C NEQ WIN THEN RETURN .C;>	!Check for errors
	IF CH$RCHAR(.ODEST) EQL .TERMINATOR THEN RETURN .TERMINATOR;
	END;
RETURN WIN;
END;

GLOBAL ROUTINE WRITE(FILBLK,ADDR,MAXCHARS,TERMINATOR)=
!ROUTINE TO WRITE A STRING TO A FILE
!Parameters:
!FILBLK: FILE BLOCK (Destination)
!ADDR: ADDR OF SOURCE BYTE POINTER
!MAXCHARS: MAXIMUM # OF CHARACTERS TO OUTPUT;
!TERMINATOR: TERMINATE OUTPUT AFTER THIS CHARACTER IS FOUND
!Returns WIN if count exhausted, TERMINATOR otherwise
BEGIN
LOCAL C;
	DECR MAXC FROM .MAXCHARS TO 0 DO BEGIN
	C=BOUTA(.FILBLK,.ADDR);
	NOSIGNAL<IF .C NEQ WIN THEN RETURN .C;>	!Check for errors
	IF CH$RCHAR(..ADDR) EQL .TERMINATOR THEN
		(BOUTA(.FILBLK,.ADDR);RETURN .TERMINATOR);
	END;

END;

GLOBAL ROUTINE BIN(FILBLK)=
!READ ONE BYTE FROM A FILE
!FILBLK: FILE BLOCK
!Returns: byte read
BEGIN
MAP FILBLK: REF FILE_BLOCK;
UNTIL (FILBLK[FILE$I_COUNT]=.FILBLK[FILE$I_COUNT]-1) GEQ 0 DO
	BEGIN
	LOCAL R;
	R=INPUT(.FILBLK);
	NOSIGNAL <IF .R NEQ WIN THEN RETURN .R> !Check for errors
	END;
CH$RCHAR_A(FILBLK[FILE$I_PTR])	!Return character
END;	!BIN

GLOBAL ROUTINE BINA(FILBLK,DEST)=
!READ ONE BYTE FROM A FILE
!FILBLK: FILE BLOCK
!DEST:  Addr of DESTINATION BYTE POINTER
!RETURNS WIN
BEGIN
LOCAL R;
MAP FILBLK: REF FILE_BLOCK;
UNTIL (FILBLK[FILE$I_COUNT]=.FILBLK[FILE$I_COUNT]-1) GEQ 0 DO
	BEGIN
	R=INPUT(.FILBLK);
	NOSIGNAL <IF .R NEQ WIN THEN RETURN .R>	!Check for errors
	END;
CH$WCHAR_A(CH$RCHAR_A(FILBLK[FILE$I_PTR]),.DEST);
WIN	!SUCCESSFUL RETURN VALUE
END;

GLOBAL ROUTINE BOUT(FILBLK,B)=
!WRITE ONE Byte TO A FILE
!FILBLK: FILE BLOCK
!B: byte to write
!Returns WIN
BEGIN
MAP FILBLK: REF FILE_BLOCK;
UNTIL (FILBLK[FILE$O_COUNT]=.FILBLK[FILE$O_COUNT]-1) GEQ 0 DO
	BEGIN
	LOCAL R;
	R=OUTPUT(.FILBLK);
	NOSIGNAL <IF .R NEQ WIN THEN RETURN .R>	!Check for IO errors
	END;
CH$WCHAR_A(.B,FILBLK[FILE$O_PTR]);
WIN	!SUCCESSFUL RETURN VALUE
END;	!BOUT

GLOBAL ROUTINE BOUTA(FILBLK,SOURCE)=
!WRITE ONE BYTE TO A FILE
!FILBLK: FILE BLOCK
!SOURCE:  Addr of SOURCE BYTE POINTER
!Returns WIN
BEGIN
LOCAL R;
MAP FILBLK: REF FILE_BLOCK;
UNTIL (FILBLK[FILE$O_COUNT]=.FILBLK[FILE$O_COUNT]-1) GEQ 0 DO
	BEGIN
	R=OUTPUT(.FILBLK);
	NOSIGNAL <IF .R NEQ WIN THEN RETURN .R>	!Check for IO errors
	END;
CH$WCHAR_A(CH$RCHAR_A(.SOURCE),FILBLK[FILE$O_PTR]);
WIN	!SUCCESSFUL RETURN VALUE
END;

!Sixbit, number, & filespec parsing routines follow


%IF NOT %DECLARED(FTNETWORK) %THEN LITERAL FTNETWORK=1; %FI


GLOBAL ROUTINE FPARSE(FILBLK,SOURCE)=
!Routine to parse a filespec.
!FILBLK = file block	SOURCE = addr of byte pointer
BEGIN
MACRO FPERROR(CODE)=	!Signal error or return code depending on bit
%IF FTSIG
%THEN
	IF .FILBLK[FILE$PF_NOSIG]
		THEN RETURN CODE
		ELSE ERROR(CODE,FILBLK,SOURCE)
	%ELSE RETURN CODE
%FI%;
LOCAL C;
LOCAL NO_DIR_DEFAULT;	!Remember if caller supplied a default directory
MAP FILBLK: REF NDB;
LOCAL N;

IF .FILBLK[FILE$PF_NORESET] EQL 0 THEN	!Sign bit means freeze default bits
	FILBLK[FILE$PF_ALL_D]=-1;	!Nothing has been specified yet

IF .FILBLK[FILE$PPN] EQL 0
 THEN	BEGIN				!Set a default if none given yet
	FILBLK[FILE$PATH_FUN]=_PTFRD;	!Read default path code
	PATH(.FILBLK);			!Put it in the file block
	NO_DIR_DEFAULT=1;	!Remember we did this
	END
 ELSE	NO_DIR_DEFAULT=0;

SOURCE<35,1>=.FILBLK[FILE$PF_WILD_A];
		!Set the sign bit if wildcarding is allowed
		!Note that this will allow it everywhere in this fileblock
		!Including nodeid & device fields, so we may have to check
		!for it there later
WHILE 1 DO
	BEGIN
	N=RDSIXA(.SOURCE);	!Try to get a sixbit word
	SELECTONE CH$RCHAR(..SOURCE) OF SET
	[%C':']:	BEGIN
		IF CH$A_RCHAR(.SOURCE) EQL %C':'
			THEN %IF FTNETWORK %THEN BEGIN
				CH$RCHAR_A(.SOURCE);
				IF .FILBLK[FILE$PF_NODE_A] EQL 0
					THEN FPERROR(NODNAL);
					!Nodeid specified where none wanted
%IF FTWILD
	%THEN
				IF .FILBLK[FILE$PF_WILDN_A] EQL 0 THEN
				 (IF MSKW6(.N) NEQ -1 THEN FPERROR(WLNNAL));
				!Check for wildcarded nodeid if neccessary
	%FI
				IF .FILBLK[FILE$PF_NODE_D]
					!If none given so far, store it
					THEN BEGIN
						FILBLK[NDB$NODEID]=.N;
						FILBLK[FILE$PF_NODE_D]=0;
						!Remember we did so.
						END
					ELSE FPERROR(DUPNOD)
				END
				%ELSE FPERROR(NODNAL)
				%FI
				ELSE
				BEGIN
%IF FTWILD
	%THEN
				IF MSKW6(.N) NEQ -1 THEN FPERROR(ILLFSP);
	%FI
				IF .FILBLK[FILE$PF_DEV_D]
				!Store it if none given before
					THEN BEGIN
					FILBLK[FILE$DEVICE]=.N;
					FILBLK[FILE$PF_DEV_D]=0
					END

					ELSE FPERROR(DUPDEV)
				END;
			END;
	[%C'_']:	!Old form for NODEID
				%IF FTNETWORK %THEN BEGIN
					IF .FILBLK[FILE$PF_NODE_A] EQL 0
					THEN FPERROR(NODNAL);
					!Nodeid specified where none wanted
%IF FTWILD
	%THEN
					IF .FILBLK[FILE$PF_WILDN_A] EQL 0 THEN
					(IF MSKW6(.N) NEQ -1
						THEN FPERROR(WLNNAL));
					!Check for wildcarded nodeid if neccessary
	%FI
					IF .FILBLK[FILE$PF_NODE_D]
					!If none given so far, store it
					THEN BEGIN
						FILBLK[NDB$NODEID]=.N;
						FILBLK[FILE$PF_NODE_D]=0;
						!Remember we did so.
						CH$RCHAR_A(.SOURCE);
						!Go to next character
						END
					ELSE FPERROR(DUPNOD)
					END
				%ELSE FPERROR(NODNAL)
				%FI;
	[%C'.']:	BEGIN
			IF .FILBLK[FILE$PF_EXT_D] EQL 0 THEN FPERROR(DUPEXT);
			IF .N NEQ 0 THEN BEGIN
				IF .FILBLK[FILE$PF_NAME_D] EQL 0
					THEN FPERROR(DUPNAM);
				FILBLK[FILE$PF_NAME_D]=0;
				FILBLK[FILE$NAME]=.N
				END;
			FILBLK[FILE$PF_EXT_D]=0;
			CH$RCHAR_A(.SOURCE);	!SKIP OVER '.'
			FILBLK[FILE$EXTENSION]=SWAP(RDSIXA(.SOURCE))
			END;
	[%C'[',%C'(']:	BEGIN
			IF .N NEQ 0 THEN BEGIN
				IF .FILBLK[FILE$PF_NAME_D] EQL 0
					THEN FPERROR(DUPNAM);
				FILBLK[FILE$PF_NAME_D]=0;
				FILBLK[FILE$NAME]=.N
				END;
			IF .FILBLK[FILE$PF_DIR_D] EQL 0 THEN FPERROR(DUPDIR);
			N=RDDIR(.FILBLK,.SOURCE); IF .N NEQ WIN
				THEN FPERROR(.N);
			FILBLK[FILE$PF_DIR_D]=0
			END;
	[%C'/',%C'=',%C',',%O'15',%O'33',%O'12',0]:
			BEGIN
			IF (.N NEQ 0) THEN BEGIN	![11] Test whole word
				IF .FILBLK[FILE$PF_NAME_D] EQL 0
					THEN FPERROR(DUPNAM);
				FILBLK[FILE$PF_NAME_D]=0;
				FILBLK[FILE$NAME]=.N
				END;
			IF .FILBLK[FILE$PF_DIR_D] AND .NO_DIR_DEFAULT
			 THEN	FILBLK[FILE$LPPN]=0;
			 !Let the monitor do the defaulting
			RETURN WIN
			END;
	[OTHERWISE]:	FPERROR(ILCFSP);!Illegal filespec charcter
		TES;
	END;
END;	!FPARSE

GLOBAL ROUTINE RDDIR(FILBLK,SOURCE)=
!Routine to fill in a PPN and SFD's
!uses .SOURCE as a byte pointer, returns it updated past directory
!FILBLK is a file block to fill in
BEGIN
	LOCAL C;	!TEMP
	LOCAL SFDPTR;	!KEEP TRACK OF WHAT SFD LEVEL WE GOT TO
	LOCAL N;	!TEMP

	MAP FILBLK: REF NDB;
	C=CH$RCHAR(..SOURCE);
	IF ((.C EQL %C'[') OR (.C EQL %C'(')) THEN CH$RCHAR_A(.SOURCE);
	IF (C=CH$RCHAR(..SOURCE)) EQL %C'-'	!Default directory
		THEN BEGIN
		C=CH$A_RCHAR(.SOURCE);
		IF (.C EQL %O'15') OR (.C EQL %O'12') OR (.C EQL %C'=')
		 OR (.C EQL %C'/') OR (.C EQL 0) THEN RETURN WIN;

		IF (.C EQL %C']') OR (.C EQL %C')')
			THEN BEGIN
			CH$RCHAR_A(.SOURCE);	!Skip past it
			RETURN WIN		!it was good
			END;
		ERROR(ILLDIR)			!"[-" followed by garbage
		END;
	IF (.C EQL %C'*') AND .FILBLK[FILE$PF_WILD_A] 	!Wildcard project
		THEN (IF .FILBLK[FILE$PF_WILD_A] THEN N=%O'777777'
						 ELSE ERROR(WLDNAL))
		ELSE N=RDNUMA(.SOURCE,8);	!PDP-10 PPNS ARE OCTAL
	IF .N NEQ 0 THEN FILBLK[FILE$PROJECT]=.N;
	IF CH$RCHAR(..SOURCE) NEQ %C',' THEN ERROR(ILLDIR);
	CH$RCHAR_A(.SOURCE);
	IF (CH$RCHAR(..SOURCE) EQL %C'*')	!Wildcard programmer number
		THEN (IF .FILBLK[FILE$PF_WILD_A] THEN N=%O'777777'
						 ELSE ERROR(WLDNAL))
		ELSE N=RDNUMA(.SOURCE,8);	!PDP-10 PPNS ARE OCTAL
	IF .N NEQ 0 THEN FILBLK[FILE$PROGRAMMER]=.N;
	INCR SFDPTR FROM FILBLK[FILE$SFD] TO FILBLK[FILE$SFD]+SFDMAX DO BEGIN
		SELECTONE CH$RCHAR(..SOURCE) OF SET
		[%C']',%C')']:	(CH$RCHAR_A(.SOURCE);.SFDPTR=0; RETURN WIN);
		[%O'15',%O'33',%O'12',0,%C'=',%C'/']:(.SFDPTR=0; RETURN WIN);
		[%C',']:(CH$RCHAR_A(.SOURCE);	.SFDPTR=RDSIXA(.SOURCE));
						!GOT AN SFD
		[OTHERWISE]:	ERROR(ILLDIR);
		TES;
		END;
	ERROR(ILLDIR);	!TOO MANY SFD'S IF WE GOT HERE
	END;

GLOBAL ROUTINE RDNUMA(SOURCE,RADIX)=
!Using ..SOURCE as a byte pointer, get an octal number and return it
!and update the byte pointer past it. RADIX is the radix.
BEGIN
LOCAL C;	!LAST CHARACTER READ
LOCAL N;	!THE NUMBER SO FAR
N=0;
WHILE 1 DO BEGIN
  C=CH$RCHAR(..SOURCE);
  SELECTONE .C OF SET
    [%C'0' TO %C'0'+(.RADIX)-1]: (N=(.N*.RADIX)+(.C-%C'0');CH$RCHAR_A(.SOURCE));
    [OTHERWISE]:	RETURN .N;
    TES;
  END;
END;!RDNUMA

GLOBAL ROUTINE RDSIXA(SOURCE)=
!Routine to read a sixbit word from an ascii string.
!SOURCE is:[RH] the ADDRESS of a byte pointer, (returned updated)
!	   [LH] The sign bit is set if wildcarding is allowed
!Value returned is the sixbit word.
BEGIN
LOCAL N;	!VALUE SO FAR
REGISTER C;	!Current character
LOCAL PTR;	!Pointer into N (sixbit)

PTR=CH$PTR(N,0,6);	!Initialize 6bit pointer
N=0;		!Start out with nothing

WHILE 1 DO BEGIN
	C=CH$RCHAR(..SOURCE);	!NEXT CHARACTER
	SELECT .C OF SET
	[LOWER_CASE]:	C=.C-%O'40';	!MAKE UPPER CASE
%IF FTWILD
	%THEN
	[WILD_1,WILD_N]:	IF (.SOURCE GTR 0) THEN RETURN .N;
			!Wildcard characters were not expected
	%FI
	[FILENAME_CHARS,WILD_N,WILD_1,LOWER_CASE]:
				BEGIN
				IF (.N AND %O'77') EQL 0 THEN
					CH$WCHAR_A(.C-%O'40',PTR);
				CH$RCHAR_A(.SOURCE)
				END;
				!Write & advance
	[OTHERWISE]:	RETURN .N;	!NO MORE FILENAME CONSTITUANTS.
	TES
	END;
END;	!RDSIXA

!Miscellaneous routines

GLOBAL ROUTINE SWAP(N)=(MACHOP(%O'207',0,N);.N);

GLOBAL ROUTINE PATH(FILBLK)=
!Routine to do a PATH. uuo on a FILE BLOCK
!FILBLK is a FILE BLOCK
BEGIN
REGISTER F;
MAP FILBLK: REF FILE_BLOCK;

F=XWD(SFDMAX+PATMIN,0)+FILBLK[FILE$PATH_FUN];
IF CALLI(F,%O'110') THEN %(Skip return)% RETURN WIN
	ELSE ERROR(PATDND+(.F AND %O'77'))
	!Error codes from uuo are 0 (DND) & -1 (NSF)

END;

MACRO BLT(F,Y,X,I)=MACHOP(%O'251',F,Y,X,I) %;

GLOBAL ROUTINE ZERO(LO,HI)=
!Routine to zero out some core via BLT
!LO & HI are the limits (inclusive)
BEGIN
REGISTER F;

F<LH>=.LO;
F<RH>=(.LO)+1;
.LO=0;
BLT(F,.HI);
END;

GLOBAL ROUTINE COPY(SOURCE,DEST,LEN)=
!Routine to copy a block of data
!Arguments:
!SOURCE:	source address
!DEST:	destination address
!LEN:	# of WORDS
BEGIN
REGISTER F;
IF .LEN NEQ 0 THEN BEGIN	!BLT will move 1 word always so check first
	F<LH>=.SOURCE;
	F<RH>=.DEST;
	BLT(F,.DEST+.LEN-1)
	END
END;

GLOBAL ROUTINE FUNPARSE(FILBLK,PTR)=
!Routine to generate an ASCIZ filespec string from a file block
!Arguments:
!FILBLK:	the file block
!PTR:		a byte pointer through which we store the result
!Returns:	value of above pointer, updated past filespec
BEGIN
MAP FILBLK: REF FILE_BLOCK;

WRSIXA(.FILBLK[FILE$DEVICE],PTR);
CH$WCHAR_A(%C':',PTR);		!DEV:
WRSIXA(.FILBLK[FILE$NAME],PTR);	!Filename
CH$WCHAR_A(%C'.',PTR);		!.
WRSIXA(SWAP(.FILBLK[FILE$EXTENSION]),PTR);	!Extension
IF .FILBLK[FILE$PPN] NEQ 0 THEN BEGIN
	CH$WCHAR_A(%C'[',PTR);
	WRNUMA(.FILBLK[FILE$PROJECT],8,PTR);
	CH$WCHAR_A(%C',',PTR);
	WRNUMA(.FILBLK[FILE$PROGRAMMER],8,PTR);
	INCR S FROM FILBLK[FILE$SFD] TO (FILBLK[FILE$SFD])+SFDMAX DO
		BEGIN
		IF ..S EQL 0 THEN EXITLOOP;
		CH$WCHAR_A(%C',',PTR);
		WRSIXA(..S,PTR);		!Write out the SFD's
		END;
	CH$WCHAR_A(%C']',PTR);
	END;
CH$WCHAR(0,.PTR);			!Make ASCIZ string
.PTR					!Return value of pointer
END;

GLOBAL ROUTINE WRSIXA(N,PTR)=
!Routine to convert SIXBIT to ASCII
!Arguments:
!N:	Sixbit word
!PTR:	ADDRESS of byte pointer. Pointer is incremented past data written
BEGIN
LOCAL T;	!Most recent character
LOCAL SIXPTR;	!Pointer within SIXBIT word
LOCAL NN: VECTOR[2];

NN[1]=0;	!Force zero terminator
NN[0]=.N;
SIXPTR=CH$PTR(NN,0,6);
UNTIL ((T=CH$RCHAR_A(SIXPTR)) EQL 0) DO
	BEGIN
	CH$WCHAR_A(.T+32,.PTR)
	END
END;

GLOBAL ROUTINE WRSIX(N,PTR)=
!Routine to convert SIXBIT to ASCII
!Arguments:
!N:	Sixbit word
!PTR:	byte pointer.
BEGIN
LOCAL T;	!Most recent character
LOCAL SIXPTR;	!Pointer within SIXBIT word
LOCAL NN: VECTOR[2];

NN[1]=0;	!Force zero terminator
NN[0]=.N;
SIXPTR=CH$PTR(NN,0,6);
UNTIL ((T=CH$RCHAR_A(SIXPTR)) EQL 0) DO
	BEGIN
	CH$WCHAR_A(.T+32,PTR)
	END
END;

GLOBAL ROUTINE FFIOCH(FB)=
!Find a free I/O channel and return it
BEGIN
MAP FB: REF FILE_BLOCK;
EXTERNAL FBTBL: VECTOR[16];
	!map for free channels and table of file blocks in use
	!Channel 0 is never returned  (reserved for TTY & GETSEG)
LABEL LP;

NOINTS((
LP:	BEGIN
	INCR I FROM 1 TO 15 DO
	IF .FBTBL[.I] EQL 0 THEN BEGIN
		FBTBL[.I]=.FB;	!Mark the channel in use
		LEAVE LP WITH (FB[FILE$CHANNEL]=.I)	!Return channel number
		END;
	ERROR(NOIOCH)	!No free I/O channels left
	END	!LP
))!NOINTS
END;	!FFIOCH

GLOBAL ROUTINE RELEASE(FB)=
!Reset & release device & free channel
!Discards any open file & resets device
!FB:	 Address of FILE_BLOCK
BEGIN
MAP FB: REF FILE_BLOCK;
REGISTER FF;
MAP FF:INSTRUCTION;
EXTERNAL FBTBL: VECTOR[16];

FF=.FB[FILE$CHANNEL];
IF (.FF LEQ 0) OR (.FF GTR %O'20') THEN RETURN;
%IF FTSIG %THEN
	IF .FB[FILE$IB] NEQ 0 THEN INTERRUPTS(REMOVEC,.FB[FILE$IB]);
%FI
CALLI(FF,%O'117');	!RESDV. UUO
FF=0;			!Start with nothing
FF<INSTR_OPCODE>=%O'71';	!Opcode for RELEASE UUO
FF<INSTR_AC>=.FB[FILE$CHANNEL];	!Channel # in AC field
XCT(FF);	!Execute instruction in AC
FBTBL[.FB[FILE$CHANNEL]]=0;	!Mark this channel free
FB[FILE$CHANNEL]=-1;	!Wipe out channel # so we don't try to use it
%IF FTALLOC %THEN
BUFFREE(.FB[FILE$I_BRH]);	!Free the input buffer
BUFFREE(.FB[FILE$O_BRH]);	!and the output buffer
%FI
WIN
END;

GLOBAL ROUTINE RESETF(FB)=
!Reset a channel.  Does a RESDV. UUO on the channel specified in a file block

!
! Formal Parameters
!

!FB: Address of file block

!
! Returned Value
!

!none

BEGIN
MAP FB: REF FILE_BLOCK;
REGISTER R;

R=.FB[FILE$CHANNEL];
CALLI(R,%O'117');	!RESDV. UUO
END; !RESETF

GLOBAL ROUTINE OPENFILE(FB)=
!Routine to allocate buffer space and open a file
!This is called by the OPEN_? macros.

!
! Formal Parameters
!

!FB: address of file block

!
! Returned value
!

!SS$_SUCCESS if successful, error code if not.
!if FTSIG is on, an error condition will be signalled if unsuccessful

BEGIN
MAP	FB: REF FILE_BLOCK;

LOCAL	LEN,		!Length of block required for buffers
	ADDR,		!Address of prospective buffer space
	SAVEJBFF,	!Place to save this while we're fiddling
	FILOPVALUE;	!Save value returned by FILOP

%IF FTSIG %THEN
ROUTINE OPENFHANDLE(SIGNAL_ARGS,MECH_ARGS,ENABLE_ARGS)=
	!Condition handler for OPENFILE
	!Standard condition-handler arguments.
	!ENABLE_ARGS[1] is addr of addr of block of memory for buffers
	!	    [2] is addr of length of block of memory for buffers
	!	    [3] is the addr of the FILE BLOCK for the file being opened
	BEGIN
	MAP ENABLE_ARGS: REF VECTOR;
	BIND FB=.ENABLE_ARGS[3]: FILE_BLOCK;

	IF .SAVJBFF NEQ 0	!Don't leave bogus value in .JBFF
	THEN	BEGIN
		JBFF=.SAVJBFF;	!Restore .JBFF
		SAVJBFF=0;	!Clear so we don't use this by mistake
		END;

	IF (.FB[FILE$I_CBUFF] EQL 0) AND (.FB[FILE$O_CBUFF] EQL 0)
	 THEN	BEGIN	!The buffers were never built.
		FREE(..ENABLE_ARGS[1],..ENABLE_ARGS[2]);
		!Give back the space that would have become buffers
		END;
	SS$_RESIGNAL		!Pass the condition down
	END;	!OPENFHANDLE

ESTABLISH(OPENFHANDLE,ADDR,LEN,FB[FILE$START]);
			!Condition handler to restore .JBFF in case of trouble
%FI

%IF FTALLOC %THEN
LEN=BUFFALO(FB[FILE$START]);	!Find out how much we need
ADDR=ALLOC(.LEN);		!Allocate it
IF .SAVJBFF EQL 0 THEN SAVJBFF=.JBFF; !Save .JBFF [34] only if necessary
JBFF=.ADDR;			!Point it towards our block
%FI

FILOPVALUE=FILOP(FB[FILE$START]); !Open the file
%IF FTALLOC %THEN
IF .SAVJBFF NEQ 0		![34] Only restore if valid
THEN	BEGIN
	JBFF=.SAVJBFF;		!Restore .JBFF
	SAVJBFF=0;		!Clear so we don't use this by mistake
	END;
%FI
.FILOPVALUE			!Return whatever FILOP returned
END;	!OPENFILE

%( This routine is no longer needed (I hope)
GLOBAL ROUTINE SETSTS(FILBLK,STATUS)=
!Do SETSTS UUO on channel in FILBLK
BEGIN
MAP FILBLK: REF FILE_BLOCK;
REGISTER FF;
MAP FF: INSTRUCTION;

CASE .STATUS<0,4> FROM _IOASC TO _IOIMG OF SET
[_IOASC]:	FF=7;
[_IOBYT]:	FF=8;
[_IOIMG]:	FF=36;
[INRANGE,OUTRANGE]:	CRASH('?Illegal mode requested');
TES;
(FILBLK[FILE$I_PTR])<24,6>=((FILBLK[FILE$O_PTR])<24,6>=.FF);
	!We have to change the byte size ourselves
FF=0;
FF<INSTR_AC>=.FILBLK[FILE$CHANNEL];
FF<INSTR_OPCODE>=%O'60';	!SETSTS UUO
FF<INSTR_ADDRESS>=.STATUS;
XCT(FF);
WIN
END; !SETSTS
! The above routine is no longer needed
)%

%IF (FTALLOC) %THEN
GLOBAL ROUTINE FREEFB(NB)=
!Routine to RELEASE the file block, free the core & that of any associated blks
BEGIN
MAP NB: REF NDB;

RELEASE(.NB);	![31] Moved before INTFREE stuff since
		! RELEASE references the interrupt block

%IF FTSIG %THEN
	BEGIN
	LOCAL X: REF INT_BLOCK;
	IF (X=.NB[FILE$IB]) NEQ 0 THEN 
		BEGIN
		EXTERNAL ROUTINE INTFREE;
		BIND PB=.X[INT$PROCESS]: PROCESS_BLOCK;	!Find the owner
		IF .PB[P$NDB] EQL .NB THEN PB[P$NDB]=0;	!Get rid of pointer
		INTFREE(.X);FREE(.X,INT_LEN);	!Interrupt block
		END
	END;
%FI
IF .NB[FILE$PF_NODE_A] THEN
	BEGIN
	LOCAL X;
	IF (X=.NB[NDB$FB]) NEQ 0 THEN FREEFB(.X); !Do same to associated filblk
	IF (X=.NB[NDB$RENAME_FB]) NEQ 0 THEN FREEFB(.X); !& rename filblk
	IF (X=.NB[NDB$EQ]) NEQ 0 THEN FREE(.X,EQMSGSIZE);
			!Get rid of message that created us if it's there
	FREE(.NB,NDB_LEN);	!release the core
	END
ELSE	FREE(.NB,FB_LEN);
END;	!FREEFB

GLOBAL ROUTINE BUFFALO(FB)=
!Determine how much space to allocate for I/O buffers

!
! Formal Parameters
!

!FB: address of FILE BLOCK (should be set up, ready for OPEN)

!
! Returned value
!

!Required amount of space for buffers.
!Caller may allocate this much space,
! set .JBFF to this, open the file, then restore .JBFF

BEGIN
MAP FB: REF FILE_BLOCK;

REGISTER
	R;	!For DEVSIZ UUO

R=FB[FILE$MODE];	!Mode & device happen to be in just the right place
DEVSIZ(R);		!this gets default # of buffs,,size of buffs

((IF .FB[FILE$I_NBUFF] EQL -1 THEN .R<LH> ELSE .FB[FILE$I_NBUFF])
	+(IF .FB[FILE$O_NBUFF] EQL -1 THEN .R<LH> ELSE .FB[FILE$O_NBUFF]))
	*.R<RH>
	!Find out how many buffers we need
	!multiply by size, and return that value
END;	!BUFFALO

GLOBAL ROUTINE BUFFREE(HDR):NOVALUE=
!Free storage occupied by I/O buffers
!HDR: address of buffer ring header (a.k.a. buffer control block)
!Returns: none
BEGIN
FIELD BUFF_FIELDS=SET			!Fields within a buffer ring
	BUFF$STS=[-1,0,36,0],		!Status word for buffer
	BUFF$USE=[0,35,1,0],		!USE bit
	BUFF$NOEOR=[0,34,1,0],		!No-end-of-record bit
	BUFF$LEN=[0,18,9,0],		!Length of buffer - 2
	BUFF$NEXT=[0,0,18,0],		!Next buffer
	BUFF$COUNT=[1,0,18,0],		!Data count within buffer
	BUFF$DATA=[2,0,36,0]		!Data area
	TES;
LOCAL	B: REF BLOCK FIELD(BUFF_FIELDS); !Current position therein

IF (B=.(.HDR)<RH>) EQL 0 THEN RETURN;	!First buffer in ring (not set up if 0)
DO	BEGIN
	LOCAL BNEXT;
	BNEXT=.B[BUFF$NEXT];			!Save pointer to next buffer
	FREE(B[BUFF$STS],.B[BUFF$LEN]+2);	!Release the buffer
	B=.BNEXT;				!Walk down the list
	END UNTIL .B EQL .(.HDR)<RH>;		!Until we get back to the top
(.HDR)<RH>=0;			!Get rid of pointer to nonexistant buffers
END;	!BUFFREE
%FI	!End %IF FTALLOC

GLOBAL BIND ROUTINE
	BINIP=BINA,	!Keep the old names alive incase anyone cares
	BOUTIP=BOUTA,
	RDNUM=RDNUMA,
	RDSIX=RDSIXA;
END ELUDOM