Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/16/ionf.mac
There are 2 other files named ionf.mac in the archive. Click here to see a list.
;<ENDERIN>IONF.MAC.18,  3-Jan-77 19:36:34, Edit by ENDERIN
	SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL
	RTITLE	IONF
	SUBTTL	Written by Olof Bjorner Dec 1973

	ERRMAC(IO)
	MACINIT

Comment ;

This module contains actions necessary to create and initialize
a file object.

It contains the following subroutines:

CHECKAST		checks a field in a file specification
			for presence of asterisk
CREATEFILE		allocates buffers for a new file
FILELOOKUP/FILEENTER	performs LOOKUP or ENTER on a new file
OPENFILE		performs OPEN for a new file
PRINTSPEC		types a file specification on TTY
PROCSPEC		creates the ZFI record from the ZFD record
REOPEN			reopens a file that has been closed previously
SETUPFILE		performs all common initial actions for a new file

When a new file object is generated SETUPFILE is called from the file
object  generation code in the IO module (IOCA entry). See the source
code of the IO module.  SETUPFILE uses all the other  subroutines  in
this module.
;

OPDEF	CHECKAST	[XEC	IOAST]
OPDEF	OPENFILE	[XEC	.IOOPN]
OPDEF	PROCSPEC	[XEC	.OCINA]

edit(305)
IFNDEF .RBDEV,<.RBDEV==16>	;[305]
IFNDEF .RBPPN,<.RBPPN==1>	;[305]
	EXTERN	.SAAR

	PROCINIT	IONF
	INTERN	.IOCOM,.OCINK

	TWOSEG
	RELOC	400K

IFN QDEBUG,<
IONFST:		;Label for debugging
>

DEFINE BREAKOUTIMAGE(A)=<
	SKPINC	;;Clear Control-O
	NOP
	OUTSTR	[ASCIZ/A/]>

DEFINE	OUTIMAGE(A)=<
	SKPINC
	NOP
	OUTSTR	[ASCIZ/A
/]>


Comment ;

Error messages in this module:
=============================

No	Message
--	-------

 1	OPEN FAILURE
 2	FILE ALREADY ASSIGNED TO TTY

;
	SUBTTL	Local subroutine: CHECKAST

Comment ;

Purpose:	To see if a field in the file specification
		contains an asterisk and to ask the user
		for information.
Entry:		IOAST
Input arguments:
		X1 points to the field
Output arguments:
		Immediate return if an asterisk is found, else skip return.
		The users answer in YOCBUF ready for GETNAME or GETPPN.
Normal exit:	See output arguments
Call format:	CHECKAST
Used routines:	BREAKOUTIMAGE,TYPENAME,TTYSPEC	[225],GETSPEC,PROCSPEC
Used registers:	X0, X1, XBYTE
;

IOAST:	PROC
	HRLI	X1,(POINT 6,0)	;Make X1 a byte pointer
	ILDB	XBYTE,X1	;Load possible asterisk, which should be left justified
	IF	;Not asterisk
		CAIN	XBYTE,'*'
		GOTO	FALSE
	THEN	AOS	(XPDP)		;No asterisk, skip return
			edit(61)
		SETZ	;[61] Ok signal
		RET
	FI

L1():!	IFON	ZFIFND(XCB)	;[61]
	 GOTO	L7
	BREAKOUTIMAGE <%Please specify additional information for logical file: >
	LF	X0,ZFINAM(XCB)
	TYPENAME
			edit(225)
			edit(41)
	TTYSPEC		;[225,41]
	 GOTO	L1	;[225,41]
	GETSPEC
	 GOTO	L1		;ERROR!
	PROCSPEC
	 GOTO	L1		;ERROR!
	RET
L7():!	AOS	(XPDP)	;[61]
	SETO
	RET
	EPROC
	SUBTTL	LOCAL SUBROUTINE: CREATEFILE

COMMENT ;

PURPOSE:	TO ALLOCATE BUFFERS FOR A NEW FILE,
		TELL THE MONITOR, LINK THE BUFFERS
		AND FINALLY CLAIM THEM.
		A ZXB BLOCK IS CREATED IF THE FILE
		IS A DIRECTFILE OR AN OUTFILE.
ENTRY:		.IOCF
INPUT ARGUMENTS:
		XCB POINTS TO FILE OBJECT.
		X6-X7 SHOULD CONTAIN ARGUMENTS TO GETBUFF
OUTPUT ARGUMENTS:
		X0=0 if ok, -1 if not ok [61]
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	CREATEFILE
USED ROUTINES:
		GETBUFF
		OPENFILE
		LINKBUFF
		FILELOOKUP
		OUTENTER
		.SAAR
		FILEENTER
USED REGISTERS:	X0, X1, XTAC
ERROR MESSAGES:	-
;

.IOCF:	PROC
		edit(105)
	IF	;[105] Buffers are wanted
		IFON	ZFIBNW(XCB)
		GOTO	FALSE
	THEN	;[105] Set them up
		GETBUFF
		ADDI	X1,1		;ADDRESS TO BUFFER RING HEADER
		;SET UP BUFFER HEADER ADDRESS
						edit(61)
		L	OFFSET(ZFIIN)(XCB)	;[61]
		IFONA	ZFIIN
		 SF	X1,ZFIIBH(XCB)
		IFONA	ZFIOUT
		 SF	X1,ZFIOBH(XCB)
		;Now perform real OPEN and link the buffers
		OPENFILE
		SUBI	X1,1
		LINKBUFF
			edit(114)
		IF	;[114] TTY
			LF	,ZFIKAR(XCB)
			TLNN	DV.TTU
			GOTO	FALSE
		THEN	;Check if another buffer header already exists
			WLF	X1,ZFIIBH(XCB)
			IFOFF	ZFIOUT(XCB)
			 MOVSS	X1	;Put the other pointer in right half
			IF	;There was a header for the other side
				TRNN	X1,-1
				GOTO	FALSE
			THEN	;Restore current buffer pointer, destroyed by OPEN
				LI	4(X1)	;First buffer address
				SETONA	ZBHUSE
				WSF	,ZBHZBU(X1,-1)
				ZF	ZBHCNT(X1,-1)	;Reset count
		FI	FI	;[114]
		edit(242)
	ELSE	;[242] May have buffers already
		SKIPE	OFFSET(ZFIIBH)(XCB)
		 OPENFILE
	FI	;[105]
		edit(244)
	IF	;[244] DSK file
		LF	,ZFIKAR(XCB)
		TLNN	DV.DSK
		GOTO	FALSE
	THEN	;Always extended lookup/enter block
		IF	;Not already allocated
			IFON	ZFIDE(XCB)
			GOTO	FALSE
		THEN	;Must create an extended enter block
			LI	XTAC,2+1+.RBDEV		;LENGTH OF THIS BLOCK
			HRLI	XTAC,QZXB	;BLOCK TYPE
			SETZM	YSANIN(XLOW)
			EXEC	.SAAR		;GET RECORD

			IFN QSADEA,<	;Update YSADEA in deallocate ver.
				L	X0,YSATOP(XLOW)
				ST	X0,YSADEA(XLOW)
			>
			;Now move information from ZFI to ZXB
			LI	X0,.RBDEV		;Number of arguments
			SF	X0,ZYSARG(XTAC)
			HRLI	X0,OFFSET(ZFIFIL)(XCB)
			HRRI	X0,OFFSET(ZXBFIL)(XTAC)
			BLT	X0,OFFSET(ZXBPRT)(XTAC);Move LOOKUP/ENTER info
			LF	X1,ZFIPPN(XCB)
			IFON	ZFISFD(XCB)
			 WLF	X1,ZFIPRJ(XCB)	;Get SFD-block ref
			SF	X1,ZXBP2(XTAC)
			SKIPE	X1,YIOZFS(XLOW)
			 LF	X1,ZFSSIZ(X1)
			IF	;Size defined in IOSPEC
				JUMPN	X1,FALSE	;Take estimated size from
							;ZFS if defined there
			THEN	SKIPN	X1,YIOSIZ(XLOW)	;Take from new if defined
				 LI	X1,5		;ELSE default
			FI
			SF	X1,ZXBLEN(XTAC)
			SF	XTAC,ZFIFIL(XCB)	;POINTER TO EXTENDED BLOCK
			SETON	ZFIDE(XCB)
		ELSE
			LF	XTAC,ZFIFIL(XCB)
			ZF	ZXBALC(XTAC)
		FI
	FI
				edit(105)
	IFON	ZFINLE(XCB)	;[105] No lookup/enter?
	 GOTO	L6		;[105] If not
	;THEN INITIALIZE THE FILE THRU LOOKUP OR ENTER
	IF	;INFILE
		IFOFF	ZFIIF(XCB)
		GOTO	FALSE
	THEN	FILELOOKUP
				edit(61)
		JUMPN	L7	;[61] failure
	ELSE
		IF	;Not Directfile
			IFON	ZFIDF(XCB)
			GOTO	FALSE
		THEN	OUTENTER
			JUMPN	L7	;[61] failed
		ELSE	;Directfile
		L8():!	IF	FILELOOKUP
				GOTO	FALSE
			THEN	;FAILURE RETURN
				FILEENTER		;ENTER this file
				 NOP			;Ignore error return
				JUMPN	L7	;[61]
				;Now close the file
				HLLZ	X0,OFFSET(ZFICHN)(XCB)
				TLO	X0,(CLOSE)
				XCT	X0
				GOTO	L8		;And try LOOKUP AGAIN	
			FI
			JUMPN	L7	;[61]
			;Here if LOOKUP ok
			L	X1,OFFSET(ZFIRON)(XCB)	;[61]
						edit(24)
			IFOFFA	ZFIRON(X1)	;[24] [61] No enter if read only
			 FILEENTER
			  SKIPA			;Ok return
			   GOTO	L8		;Error return, try LOOKUP again
			JUMPN	L7	;[61]
			ZF	ZDFLOC(XCB)	;LOCATE(0)
			;[24] Code for ZDFIML, ZDFLIM moved to .IOOP
	FI	FI
	;LOOKUP/ENTER has now succeeded
	;Claim the allocated buffer
				edit(105)
L6():!	WLF	X1,ZFIIBH(XCB)	;[105] IBH in rh, word is zero if no buffer
	IF	;[105] There are buffers
		JUMPE	X1,FALSE
	THEN	;Link them up, claim them
		IFOFF	ZFIIN(XCB)
		LF	X1,ZFIOBH(XCB)
		LF	X0,ZBHLEN(X1,-1)	;Claim buffer
		MOVN	X0,X0
		SF	X0,ZBHLEN(X1,-1)
	FI
L9():!
		edit(61)
	SETZ	;[61] Ok return
L7():!	RETURN	;[61] X0 already set here
	EPROC
	SUBTTL	Local subroutine: FILELOOKUP/FILEENTER

Comment ;

Purpose
-------
To LOOKUP or ENTER a file. If ENTER failure occurs the user is  asked
to supply a new file specification and ENTER is tried again unless it
is a DIRECTFILE or APPEND mode ENTER. If LOOKUP failure  occurs  then
the  user  is  also  consulted and LOOKUP is tried again unless it is
DIRECTFILE or APPEND mode LOOKUP.

Entries
-------
.IOLOK for LOOKUP
.IOENT for ENTER

Input arguments
---------------
XCB points to the file object

Exits
-----
INFILE:		immediate return when LOOKUP succeeds
OUTFILE:	immediate return when ENTER succeeds
PRINTFILE:	same as OUTFILE
APPEND mode: 	IF lookup failure THEN immediate return
		IF enter failure THEN skip return after dialogue
DIRECTFILE:	IF lookup/enter succeeds THEN immediate return
		IF lookup failure THEN  immediate return
		IF enter failure THEN skip return after dialogue

Call formats
------------
FILELOOKUP or FILEENTER

Used routines
-------------
BREAKOUTIMAGE
OUTIMAGE
TYPENAME
TTYSPEC	[225]
GETSPEC
PROCSPEC
OPENFILE

Used registers
--------------
X0,X1,X2,X3,XBUF,XFL [61]

Error messages
--------------
?LOOKUP or ENTER failure ...
?Device <...> illegal
Can't switch device at this stage
?Ill file desc.
;

		edit(61)
	XFL==X7	;[61] Flag register

.IOLOK:	PROC
	OPZ	(LOOKUP)	;X0:=DESIRED UUO
	SETON	SWLOK
	GOTO	L1	;[61]
.IOENT:
	OPZ	(ENTER)	;X0:=DESIRED UUO
	SETOFF	SWLOK
L1():!	SAVE	<X1,X2,X3,XBUF,XFL>	;[61]
	N==5	;[61] Number of words on stack
	L	X3,X0			;[61] Opcode (LOOKUP or ENTER)
L2():!
	L	XFL,OFFSET(ZFIDE)(XCB)	;[61]	Most flags easily accessible
	IOR	X3,OFFSET(ZFICHN)(XCB)	;Insert channel
	;Fetch address to LOOKUP/ENTER info
	HRRI	X3,OFFSET(ZFIFIL)(XCB)
	IF	;Extended block exists
		IFOFFA	ZFIDE(XFL)	;[61]
		GOTO	FALSE
	THEN	;Use it
		LF	X2,ZFIFIL(XCB)
		HRRI	X3,OFFSET(ZYSARG)(X2)
	FI
	LF	X2,ZFIPPN(XCB)
				edit(244)
	CAMN	X2,[-1]		;[244] handle -1 like 0, i.e.
	 SETZ	X2,		;[244] default path
	IF	;SFD:S
		IFOFFA	ZFISFD(XFL)
		GOTO	FALSE
	THEN		edit(225)
		IFE QDEC20,<;[225]
		IF	;Extended block
			IFOFFA	ZFIDE(XFL)
			GOTO	FALSE
		THEN	;Move PPN to ZXB indicated by extended block
			LF	X1,ZFIFIL(XCB)	;Pointer to ext block
			LF	XBUF,ZXBP2(X1)	;Pointer to SFD block
			SF	X2,ZYSP1(XBUF)	;Store PPN
			LI	X1,OFFSET(ZXBP2)(X1);X1 = ref to SFD adr
		ELSE	;Move PPN to ZYS pointed at
			;from file object
			LF	X1,ZFIARG(XCB)	;Pointer to SFD block
			SF	X2,ZYSP1(X1)
			LI	X1,OFFSET(ZFIARG)(XCB);X1 = ref to SFD adr
		FI
					edit(144)
		STACK	(X1)		;[144] Save ppn field
		AOS	(X1)		;Update SFD pointer for
		AOS	(X1)		;LOOKUP/ENTER UUO
		>
	ELSE	;Store PPN in file object or extended block
		LI	X1,OFFSET(ZFIPRJ)(XCB)	;[144] Address of ppn field
					edit(244)
		IFONA	ZFIDE(XFL)	;[244]
		 LI	X1,.RBPPN(X3)	;[244]
		ST	X2,(X1)
					edit(144)
		STACK	X2		;[144] Save ppn
	FI
	IF	XCT	X3		;Execute desired UUO
		GOTO	FALSE		;LOOKUP/ENTER failure
	THEN	;LOOKUP/ENTER OK!
		UNSTK	(X1)		;[144] Restore ppn or SFD pointer
		GOTO	L8		;[61] Ok return
					edit(61)
	FI
	UNSTK	(X1)		;[144] Restore ppn or SFD pointer
	LI	X2,OFFSET(ZFIEXT)(XCB)	;Address to error code
	LF	X1,ZFIFIL(XCB)
	IFONA	ZFIDE(XFL)
	 LI	X2,OFFSET(ZXBEXT)(X1)
	HRRZ	X0,(X2)	;LOAD ERROR CODE
	IF	;[61] This does not count as an error
		JUMPN	FALSE
		IFOFF	SWLOK
		GOTO	FALSE
		IFONA	ZFIAPP(XFL)
		GOTO	TRUE
		IFONA	ZFIDF(XFL)
					edit(24)
		IFONA	ZFIRON(XFL)	;[24]
		GOTO	FALSE
	THEN	;Skip return
					edit(61)
		AOS	-N(XPDP)	;[61]
		GOTO	L8		;[61]
	FI
L3():!
	IF	;[61] failure should not cause dialogue
		IFOFFA	ZFIFND(XFL)
		GOTO	FALSE
	THEN	;Return with -1 in X0
		SETO
		GOTO	L9
	FI
	BREAKOUTIMAGE <?LOOKUP or ENTER error (>
	;Convert and print error code:
	OUTOCT	;[61]
	BREAKOUTIMAGE <) on >
	L	XCB	;[61]
	TYPESPEC	;[61]
L4():!
	SETOFF	SWSWERR
	OUTIMAGE <Enter new file desc>
	;Get and process answer
			edit(225)
	TTYSPEC		;[225]
	 GOTO	L4	;[225]
	GETSPEC
	 GOTO	L5
	PROCSPEC
	 GOTO	L5
					edit(61)
	L	XFL,OFFSET(ZFIDE)(XCB)	;[61] Fetch flag word
	IF	;New device defined
		SKIPN	X1,YOCFD(XLOW)
		GOTO	FALSE
	THEN	;Check if device switched!
		DEVCHR	X1,
		IF	;Illegal device
			JUMPN	X1,FALSE
	L6():!	THEN	;ERROR
			BREAKOUTIMAGE <?Device >
			L	X0,YOCFD(XLOW)
			TYPENAME
			BREAKOUTIMAGE < illegal. >
			GOTO	L4
		FI
		IF	;Old device is disk
			IFOFF	ZFIDSK(XCB)
			GOTO	FALSE
		THEN	IF	;New device is not dsk
				TLNE	X1,DV.DSK
				GOTO	FALSE
		L7():!	THEN	;ERROR
				OUTIMAGE<Cannot switch device at this stage!>
				GOTO	L6
			FI
		ELSE	;Must be dectape!
			TLNN	X1,DV.DTA
			GOTO	L7		;If new device is not dectape
		FI
		LF	X2,ZFIIBH(XCB)
		IFONA	ZFIOUT(XFL)	;[61]
		 LF	X2,ZFIOBH(XCB)
		STACK	(X2)	;Save first word of buffer
				;ring header
		OPENFILE
		UNSTK	(X2)	;and restore it after OPEN
	FI

			edit(10)
	EXEC	IONFCA	;[10] Check ACCESS:APPEND

	IF	IFONA	ZFIAPP(XFL)
		GOTO	TRUE
					edit(61)
		IFOFFA	ZFIRON(XFL)	;[61]
		 IFOFFA	ZFIDF(XFL)
		  GOTO	L2
	THEN	;DIRECTFILE or APPEND mode
		;Return and try again
		AOS	-N(XPDP)
	FI
		edit(61)
L8():!	SETZ	;[61]
L9():!	RETURN
L5():!
	BREAKOUTIMAGE <?Ill. file desc. >
	GOTO	L4
	EPROC
	SUBTTL	Local subroutine: OPENFILE

COMMENT ;

PURPOSE:	This subroutine opens a file on the channel
		specified in the file object
ENTRY:		.IOOPN
INPUT ARGUMENTS:XCB points to the file object
OUTPUT ARGUMENTS:
		X0=0 if OK, -1 otherwise
NORMAL EXIT:	RETURN
ERROR EXIT:	IOERR
CALL FORMAT:	OPENFILE
USED ROUTINES:	FILEERROR
USED REGISTERS:	X0
ERROR MESSAGE:	OPEN failure
		(Note that this should not occur since
		 this channel was opened earlier to
		 facilitate other UUO:s, see SETUPFILE)
;

.IOOPN:	PROC
	HLLZ	X0,OFFSET(ZFICHN)(XCB);Get channel
	TLO	X0,(OPEN)
	HRRI	X0,OFFSET(ZFISTI)(XCB);and status
		edit(61)
	IF	;[61] OPEN works
		XCT	X0
		GOTO	FALSE
	THEN	;Ok
		GOTO	L8
	FI
	IF	;[61] Error can be accepted
		IFOFF	ZFIFND(XCB)
		GOTO	FALSE
	THEN	;Signal the error in X0
		SETO
		GOTO	L9
	FI
	FILEERROR
	IOERR	1,OPEN failure
L8():!	SETZ	;[61] Ok return
L9():!	RETURN	;[61]
	EPROC
	SUBTTL	PRINTSPEC

COMMENT ;

PURPOSE:	TO PRINT THE CURRENT SPECIFICATION ON TTY
ENTRY:		.OCINE
INPUT ARGUMENT:	-
OUTPUT ARGUMENT:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	PRINTSPEC
USED ROUTINES:	-
USED REGISTERS:	X0, X1
ERROR MESSAGE:	-
;

.OCINE:	PROC
	SAVE	<X1>
	IFON	SWTTY
	 GOTO	L9			;Don't type if input from tty!
	L	X0,[POINT 7,YOCBUF(XLOW)];Pointer to internal buffer
	LOOP	;Until CR
		ILDB	X1,X0
				edit(225)
		PBOUT		;[225]
	AS	CAIE	X1,QCR
		GOTO	TRUE
	SA
	LI	X1,QLF
	PBOUT		;Type line feed
L9():!
	RETURN
	EPROC
	SUBTTL	PROCSPEC

COMMENT ;

PURPOSE:	TO PROCESS A ZFD RECORD AND UPDATE ZFI.
		A ZYS RECORD IS CREATED IF THERE ARE SFD:S.
		ONLY NON-EMPTY FIELDS IN ZFD ARE MOVED TO ZFI. 
		POSSIBLE SWITCHES ARE PROCESSED.
ENTRY:		.OCINA
INPUT ARGUMENTS:
		XLOW POINTS TO ZFD
		XCB POINTS TO ZFI.
OUTPUT ARGUMENTS:-
NORMAL EXIT:	SKIP RETURN
ERROR EXIT:	IMMEDIATE RETURN, IF ERROR IN SWITCHES
CALL FORMAT:	PROCSPEC
USED ROUTINES:	FIXSWITCH
		.SAAR
		GETNAME
USED REGISTERS:	X0, XTAC, X3
ERROR MESSAGES:	-
;

.OCINA:	PROC
	SAVE	<XTAC,X3>
	N==2	;Number of quantities on stack above return address
	IF	;DEVICE IN ZFD
		SKIPN	XTAC,OFFSET(ZFDDEV)(XLOW)
		GOTO	FALSE
	THEN	SF	XTAC,ZFIDVN(XCB)
	ELSE
		IF	;NO DEVICE IN ZFI
			SKIPE	X0,OFFSET(ZFIDVN)(XCB)
			GOTO	FALSE
		THEN	MOVSI	XTAC,'DSK'	;DEFAULT DEVICE
			SF	XTAC,ZFIDVN(XCB)
		FI
	FI
	IF	;EXTENDED BLOCK EXISTS
		IFOFF	ZFIDE(XCB)
		GOTO	FALSE
	THEN	;MOVE INFO TO THIS BLOCK
		LF	X3,ZFIFIL(XCB)	;X3:=POINTER TO EXTENDED BLOCK
		SKIPE	XTAC,OFFSET(ZFDFIL)(XLOW)
		 SF	XTAC,ZXBFIL(X3)
		SKIPE	XTAC,OFFSET(ZFDEXT)(XLOW)
						edit(3)
		 WSF	XTAC,ZXBEXT(X3)		;[3]

	ELSE	;Move info to file object
		SKIPE	XTAC,OFFSET(ZFDFIL)(XLOW)
		 SF	XTAC,ZFIFIL(XCB)
		SKIPE	XTAC,OFFSET(ZFDEXT)(XLOW)
		 WSF	XTAC,ZFIEXT(XCB)
	FI
	IF	;PPN defined
		SKIPN	XTAC,OFFSET(ZFDPRJ)(XLOW)
		GOTO	FALSE
	THEN	SF	XTAC,ZFIPPN(XCB)
		IF	;SFD BLOCK EXISTS
			IFOFF	ZFISFD(XCB)
			GOTO	FALSE
		THEN	IF	;No SFD in new file spec
				SKIPE	X0,OFFSET(ZFDSFD)(XLOW)
				GOTO	FALSE
			THEN	;Store ppn in file object and
				;delete old SFD block
				WSF	XTAC,ZFIPRJ(XCB)
			ELSE	;Store ppn in old SFD block
				LF	X1,ZFIARG(XCB)
				SF	XTAC,ZYSP1(X1)
			FI
		ELSE
		IF	;Extended block exists
			IFOFF	ZFIDE(XCB)
			GOTO	FALSE
		THEN	;Store ppn in extended block
			;Address should still be in X3!
			SF	XTAC,ZXBP2(X3)
		ELSE	;Store ppn in file object
			WSF	XTAC,ZFIPRJ(XCB)
		FI
		FI
	FI
	CAIN	XBYTE,"/"
	 FIXSWITCH
			edit(225)
	IFE QDEC20,<;[225]
	IF	;Sub-file directories
		SKIPN	X3,OFFSET(ZFDSFD)(XLOW)
		GOTO	FALSE
	THEN	;Create ZYS record
		LI	XTAC,4(X3)	;Length of record = no of SFD:s + 4
		IF	;SFD in ZFI
			IFOFF	ZFISFD(XCB)
			GOTO	FALSE
		THEN	;Check if existing ZYS is big enough
			LF	X1,ZFIARG(XCB)
			IF	;Extended block
				IFOFF	ZFIDE(XCB)
				GOTO	FALSE
			THEN	LF	X1,ZFIFIL(XCB)
				LF	X1,ZXBP2(X1)
			FI
			L	X0,1(X1)	;Length of old ZYS
			SUBI	X0,2
			CAMGE	X0,XTAC
			 GOTO	FALSE
			LI	XTAC,(X1)	;Old record will do!
		ELSE	;Allocate a new record
			HRLI	XTAC,QZYS	;Record type
			ADDI	XTAC,2
			SETOM	YSANIN(XLOW)	;No initialization
			ST	XCB,YOBJAD+3(XLOW)
			LF	XCB,ZDRZBI(XCB)
			EXEC	.SAAR

			IFN QSADEA,<	;Update YSADEA in deallocate ver.
				L	X0,YSATOP(XLOW)
				ST	X0,YSADEA(XLOW)
			>

			L	XCB,YOBJAD+3(XLOW)
			SETZM	YOBJAD+3(XLOW)
			IF	;Extended block defined
				IFOFF	ZFIDE(XCB)
				GOTO	FALSE
			THEN	;Store SFD ref in extended block
				LF	X3,ZFIFIL(XCB)	;Ref to ext block
				SF	XTAC,ZXBP2(X3)
			ELSE	;Store ref to SFD in file object's ppn
				SF	XTAC,ZFIARG(XCB);Address to ZYS
			FI
			SETON	ZFISFD(XCB)
		FI
		LF	X0,ZFDPNT(XLOW)
		ST	X0,YOCPNT(XLOW)
		LF	X0,ZFIPPN(XCB)	;Move PPN
		SF	X0,ZYSP1(XTAC)
					edit(262)
		LF	X3,ZFDSFD(XLOW)	;[262] Number of SFD's again
		LOOP	;Storing SFD:S
			GETNAME
			NOP	-1	;[263] Disallow funny name
					edit(263)
			SF	XNAME,ZYSSFD(XTAC)
		AS	ADDI	XTAC,1
			SOJG	X3,TRUE
		SA
		ZF	ZYSSFD(XTAC)	;Reset last SFD name
	FI	>;[225]
	IF	;New protection
		SKIPN	XTAC,OFFSET(ZFDPT)(XLOW)
		GOTO	FALSE
	THEN	IF	;Extended block exists
			IFOFF	ZFIDE(XCB)
			GOTO	FALSE
		THEN	;Store protection in ZXB
			LF	X1,ZFIFIL(XCB)
			SF	XTAC,ZXBPRT(X1)
		ELSE	;Store protection in file object
			WSF	XTAC,ZFIPT(XCB)
	FI	FI
	IFOFF	SWSWERR
	 AOS	-N(XPDP)	;Immediate return if error in switches
	RETURN
	EPROC
	SUBTTL	REOPEN

COMMENT ;

PURPOSE:	TO REOPEN AN ALREADY USED FILE
ENTRY:		.OCINK
INPUT ARGUMENT:	XWAC1 POINTS TO FILE OBJECT
OUTPUT ARGUMENT:-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	REOPEN
USED ROUTINES:	GETCHANNEL
		CREATEFILE
USED REGISTERS:	XWAC1, XCB, X1, X6, X7
ERROR MESSAGES:	-
;

.OCINK:
	EXCH	XCB,XWAC1
	ST	XWAC1,YOBJAD(XLOW)	;SAVE XWAC1 IN CASE OF
					;GARBAGE COLLECTION
	GETCHANNEL
	HRRZS	OFFSET(ZFICHN)(XCB)	;RESET HALFWORD WITH CHANNEL
	SF	X1,ZFICHN(XCB)		;STORE NEW CHANNEL
	LF	X6,ZFIBFS(XCB)		;BUFFER SIZE
	LF	X7,ZFIBUF(XCB)		;NUMBER OF BUFFERS
	CREATEFILE
	L	XWAC1,YOBJAD(XLOW)
				edit(274)
	SETZM	YOBJAD(XLOW)	;[274] Must not leave address for GC
	EXCH	XCB,XWAC1
	RETURN
	SUBTTL	Subroutine: SETUPFILE

Comment ;

Purpose
-------
This procedure performs all common initial file actions:
1. The  logical  name  is fetched from the parameter YYNAME.     The
   file specification is fetched and stored in ZFI.
2. IOSPEC  is  searched  for  the  logical  name.     If it is found,
   relevant information is copied to the file object, thus overriding
   the specification in YYNAME.
3. An i/o channel is established.
4. If  the  file  specification  contains  asterisks  a  dialogue  is
   initiated to complete the specification.
5. A dummy open is performed to facilitate later use of DEVCHR.
6. If  the file is of type DIRECT,  the device is checked with DEVCHR
   to assert that it is DSK. If not a warning message is printed  and
   DSK is assumed.
7. If the device is  TTY  then  the  dedicated  channel  0  is  used.
   Should  this  channel be occupied by another file a run time error
   occurs.
8. The  buffer  size  and  the number of buffers are determined and a
   buffer area is allocated. If it is a DIRECTFILE only one buffer is
   used regardless of the user specification.
9. A real OPEN is performed with the actual buffer address.
10. The monitor is informed through the CREATEFILE subroutine.

Entry
-----
.IOCOM

Input arguments
---------------
XCB  points to the file object. ZFISPC contains text reference to the
file object argument.

Normal exit
-----------
RETURN

Call format
-----------
SETUPFILE

Used routines
-------------
GETBYTE
FIXSWITCH
FINDLOGICAL
GETSPEC
OUTIMAGE
BREAKOUTIMAGE
PRINTSPEC
TTYSPEC		[225]
PROCSPEC
COPYSPEC
GETCHANNEL
CHECKAST
TYPENAME
GETNAME
FILEERROR
CREATEFILE

Used registers
--------------
X0 - X7, XCB, XBUF

Error messages
--------------
?Ill file descriptor in file object argument
?Device illegal
Can't do output to device
Can't do input from device
APPEND mode ignored for non disk devices
APPEND mode ignored for infile
APPEND mode ignored for directfile
Device not DSK for DIRECTFILE
File already assigned to TTY (IOERR 2)
Too many buffers for file
;

.IOCOM:	PROC
	LOWADR			;Set base register to static area
	CDEFER			;Defer call on SIMDDT to user return if ^c-reenter
	LF	X3,ZFISPC(XCB)	;Create pointer to text record
	ADDI	X3,2
	HRLI	X3,(POINT 7,0)
	SETON	SWTR
	SETON	SWTTY		;In case dialogue is required
	SETZM	YIOSIZ(XLOW)	;Reset size switch arg area
	;Now move text record to YOCBUF
	HLRZ	X6,OFFSET(ZFISPC)+1(XCB);Get length
				edit(225)
	Q==5*<YOCBUE-YOCBUF>	;[225] Buffer length
	CAILE	X6,Q	;IF Image length > YOCBUF length
	LI	X6,Q	;THEN set length to YOCBUF length
			edit(225)
	SPECCOPY	;[225] Use general copy routine
	  GOTO	[	;[225] with this character-producer
		ILDB	XBYTE,X3;Next text byte
		SOSGE	X6	;End of line if no more
		 LI	XBYTE,QLF
		RET	]
L1():!
	L	X6,YOCPNT(XLOW)
	GETBYTE
	CAIN	XBYTE,"@"
	 GOTO	L5		;Illegal in indirect spec
	IF	;SLASH
		CAIE	XBYTE,"/"
		GOTO	FALSE
	THEN	;Global switch
		SETON	SWGSW
		FIXSWITCH
		IFON 	SWSWERR
		 GOTO	L5		;IF ERROR
		L	X6,YOCPNT(XLOW)
	FI
	SETOFF	SWGSW
	FINDLOGICAL
	JUMPL	X0,L5		;Ill logical name!
	SF	XNAME,ZFINAM(XCB)
	IF	;Delimiter is CR
		JUMPE	X0,FALSE
	THEN	MOVSI	X0,'DSK'
		SF	X0,ZFIDVN(XCB)
		GOTO	L6
	FI
	IF	GETSPEC
		GOTO	TRUE
		GOTO FALSE
L5():!	THEN	;ERROR!!
					edit(61)
		IFON	ZFIFND(XCB)	;[61]
		 GOTO	IOCOME
		OUTIMAGE <?Illegal file descriptor in file class argument.>
		PRINTSPEC
		OUTIMAGE <Please enter new file definition>
				edit(225)
		TTYSPEC		;[225]
		 GOTO	L5	;[225]
		SETOFF	SWSWERR
		GOTO	L1	;and try again
	FI
	PROCSPEC
	 GOTO	L5		;ERROR!
L6():!
	LF	XNAME,ZFINAM(XCB)
	SKIPN	X0,OFFSET(ZFIFIL)(XCB)
	 SF	XNAME,ZFIFIL(XCB)	;Set file name to logical name as default
	;Now search IOSPEC to see if this file is defined there
	SETZM	YIOZFS(XLOW)	;No IOSPEC entry for this file yet
	L	X1,YIOSPC(XLOW)	;Address to first element in IOSPEC
	WHILE	;More elements
		JUMPL	X1,FALSE
	DO	;Check	logical name
		IF	;Same name
			CAME	XNAME,OFFSET(ZFSNAM)(X1)
			GOTO	FALSE
		THEN	ST	X1,YIOZFS(XLOW)	;Save address to IOSPEC
						;entry for later use
			L	XRAC,XCB
			ST	XCB,YOBJAD+3(XLOW)
			LF	XCB,ZDRZBI(XCB)
			COPYSPEC
			L	XCB,YOBJAD+3(XLOW)
			SETZM	YOBJAD+3(XLOW)
			HRROI	X1,-1
		ELSE
			LFE	X1,ZFSLNK(X1)
			SKIPL	X0,OFFSET(ZFSLNK)(X1)
		FI
	OD

	;Now get a channel number
	GETCHANNEL
				edit(201)
	JUMPL	X1,IOCOME	;[201]
	SF	X1,ZFICHN(XCB)	;and save it

	;Now the device field is checked for asterisks
	LI	XBUF,YLOW+2(XLOW)
L2():!
	LI	X1,OFFSET(ZFIDVN)(XCB)
	CHECKAST		;Device field
	 GOTO	L2
			edit(61)
	JUMPN	IOCOME	;[61]

	edit(15)
	;[15] Code to check for asterisks in name, ext and ppn field
	;     removed from here to after device check is completed.
	;Now perform a dummy OPEN to establish a channel
	;X3-X5 contain the OPEN block
	;X6 contains the OPEN UUO

	BEGIN
			edit(225)
	DEFINE OUST(X)<;;[225]
	IFN <X-X1>,<PRINTX *** OUST parameter error ***>
	IFN QDEC20,<PSOUT>
	IFE QDEC20,<OUTSTR	X1>>
L1():!
	HLLZ	X6,OFFSET(ZFICHN)(XCB)
	TLO	X6,(OPEN)
	HRRI	X6,3
				edit(61)
	LF	X3,ZFISTI(XCB)	;[61]
	LF	X4,ZFIDVN(XCB)
				edit(15)
	SETZ	X5,		;[15] Zero both in and out buffer header address
	XCT	X6
	 GOTO	L2
	;Now that a channel is established, check device
	SF	X4,ZFIDVN(XCB)
	DEVCHR	X4,		;Device should still be in X4 now
	IF	;Device does not exist
		JUMPN	X4,FALSE
L2():!	THEN	;ERROR
					edit(61)
		IFON	ZFIFND(XCB)	;[61]
		 GOTO	IOCOME
		BREAKOUTIMAGE <?Device >
		LF	X0,ZFIDVN(XCB)
		TYPENAME
		OUTIMAGE < Illegal.>
		OUTIMAGE <Please specify new device:>
				edit(225)
		TTYSPEC		;[225]
		 GOTO	L2	;[225]
		GETNAME
		SF	XNAME,ZFIDVN(XCB)
		GOTO	L1
	FI
	SF	X4,ZFIKAR(XCB)
	;Now check correspondence file type vs. device type
	IF	;File can do input
		IFOFF	ZFIIN(XCB)
		GOTO	FALSE
	THEN	IF	;Device cannot do input
			IFON	ZFIDIN(XCB)
			GOTO	FALSE
		THEN	;ERROR
			HRROI	X1,[ASCIZ/Cannot do input from device: /]
	L7():!
						edit(61)
			IFON	ZFIFND(XCB)	;[61]
			 GOTO	IOCOME
			CLEARO
					edit(225)
			OUST	(X1)	;[225]
			LF	X0,ZFIDVN(XCB)
			TYPENAME
			OUTIMAGE <!>
			GOTO	L2
		FI
	ELSE
		IF	;Device cannot do output
			IFON	ZFIDOU(XCB)
			GOTO	FALSE
		THEN	;ERROR!
			HRROI	X1,[ASCIZ/Cannot do output to device: /]
			GOTO	L7
		FI
	FI
	ENDD

			edit(10)
	EXEC	IONFCA	;[10] Check ACCESS:APPEND

	IF	;Device is not DSK
		TLNE	X4,DV.DSK
		GOTO	FALSE
	THEN	;Check for DIRECTFILE
		IF ;Not DIRECTFILE
		  IFOFF	ZFIDF(XCB)
		  GOTO	FALSE
		THEN
		  BREAKOUTIMAGE <Warning: Device not DSK for DIRECTFILE: >
		  LF	X0,ZFINAM(XCB)
		  TYPENAME
		  OUTIMAGE <.   DSK assumed.>
		  MOVSI	X4,'DSK'
		  SF X4,ZFIDVN(XCB)
		  DEVCHR X4,
		  SF X4,ZFIKAR(XCB)
	FI	FI
	IF	;Device is TTY
		TLNN	X4,DV.TTA
		GOTO	FALSE
	THEN
		IF	;Channel for TTY already occupied
			SKIPG	X0,YIOCHTB(XLOW)
			GOTO	FALSE
		THEN	IF	;INFILE
				IFOFF	ZFIIF(XCB)
				GOTO	FALSE
			THEN	HRRZ	X0,YIOCHTB(XLOW)
			ELSE
				HLRZ	X0,YIOCHTB(XLOW)
			FI
			JUMPE	X0,FALSE
L3():!	edit(15)				;[15]
						edit(61)
			IFON	ZFIFND(XCB)	;[61]
			 GOTO	IOCOME
			FILEERROR
			IOERR	2,File already assigned to TTY
		FI
		;Now assign TTY
		HLLZ	X0,OFFSET(ZFICHN)(XCB)
		TLO	X0,(RELEASE)	;Release previously opened channel
		XCT	X0
		LF	X1,ZFICHN(XCB)
		ADD	X1,XLOW
		SETZB	X0,YIOCHTB(X1)	;Clear channel entry
		SF	X0,ZFICHN(XCB)	;Channel 0
		IF	;INFILE
			IFOFF	ZFIIF(XCB)
			GOTO	FALSE
							edit(15)
		THEN	HRRM	XCB,YIOCHTB(XLOW)	;[15] RH INPUT
			L	X1,YTTIB(XLOW)
			SF	X1,ZFIIBH(XCB)
		ELSE
			HRLM	XCB,YIOCHTB(XLOW)	;[15] LH OUTPUT
			L	X1,YTTOB(XLOW)
			SF	X1,ZFIOBH(XCB)
		FI
		;[15] Initialize the buffer header
		SUBI	X1,1	;X1=ZBH start
		LF	X0,ZBHZBU(X1)	;Current buffer
		ADDI	X0,1
		HRLI	X0,(POINT  7,0,0)	;700,,ZBUDAT-1
		SF	X0,ZBHBUP(X1)
		ZF	ZBHCNT(X1)
		GOTO	L9
	FI
	IF	;This device is another terminal
		TLNN	X4,DV.TTU
		GOTO	FALSE
	THEN	;See if this terminal was used before
		TLNE	X4,DV.DSK
		 GOTO	L8		;[15]	Device NUL: if DSK
					; and TTU at the same time
		LF	X4,ZFIDVN(XCB)
		LI	X1,YIOCHTB(XLOW);Address to channel table
		HRLI	X1,-^D15	;Max no of files
		LOOP	;and search channel table
			IF	;channel occupied
				SKIPN	X6,(X1)	;[15] NOT SKIPG
				GOTO	FALSE
			THEN	;Check file objects
				HLRZ	X7,X6
				IF	;Output side is occupied
					JUMPE	X7,FALSE
				THEN	;Check device name
					LF	X0,ZFIDVN(X7)
					CAMN	X0,X4
					 GOTO	L7	;Found it!!
				FI
				HRRZ	X7,X6
				IF	;Input side occupied
					JUMPE	X7,FALSE
				THEN	;Check device name
					LF	X0,ZFIDVN(X7)
					CAMN	X0,X4
					 GOTO	L7	;Found it!!
				FI
			FI
		AS	INCR	X1,TRUE
		SA
		GOTO	L8		;Not found
	L7():!
		;Device found via channel table
		;X1 contains address to channel table
		;X7 points to old file object or this object
		CAIN	X7,(XCB)
				edit(114)
		 GOTO	L8	;[114] The new channel should be used
		edit(15)
		;[15] Proper RELEASE of the new channel
		HLLZ	X0,OFFSET(ZFICHN)(XCB)
		TLO	X0,(RELEASE)	;Release previously opened channel
		XCT	X0
		LI	X2,YIOCHTB(XLOW)
		LF	X0,ZFICHN(XCB)
		ADD	X2,X0
		SETZM	(X2)		;Release new channel
		L	X2,(X1)		;[15]
		LF	X0,ZFICHN(X7)
		SF	X0,ZFICHN(XCB)	;and take old instead
		IF	;INFILE
			IFOFF	ZFIIF(XCB)
			GOTO	FALSE
		THEN	;Get old output buffer into open block
			TRNE	X2,-1	;[15]
			 GOTO	L3	;[15] TTY already assigned
			LF	X0,ZFIOBH(X7)
			SF	X0,ZFIOBH(XCB)
			HRRM	XCB,(X1)	;UPDATE CHANNEL TABLE
		ELSE	;Get old input buffer into open block
			TLNE	X2,-1	;[15]
			 GOTO	L3	;[15] TTY already assigned
			LF	X0,ZFIIBH(X7)
			SF	X0,ZFIIBH(XCB)
			HRLM	XCB,(X1)	;Update channel table
		FI
	L8():!
	FI


	;[15] Code to check for non directory devices included

	IF	;Non-directory device
		TLNE	X4,DV.DIR
		GOTO	FALSE
	THEN
		edit(201)
		;[201] Do not clear file name - can be useful e g for LPT:
		SETZM	OFFSET(ZFIEXT)(XCB)
		IF	;SFD path exists
			IFOFF	ZFISFD(XCB)
			GOTO	FALSE
		THEN
			LF	X1,ZFIARG(XCB)
			SETZM	OFFSET(ZYSP1)(X1)
		ELSE
			SETZM	OFFSET(ZFIPRJ)(XCB)
		FI
	ELSE
		edit(15)
		;[15] Code to check for asterisks in name, ext and ppn
		; fields is placed here and will be executed only for
		; directory devices.

		edit(167)	;[167]:
		LF	X1,ZFIDVN(XCB)
		IF	;not NUL:
			CAMN	X1,[SIXBIT/NUL/]
			GOTO	FALSE
		THEN	;[167] ends here
		LI	X1,OFFSET(ZFIFIL)(XCB)
		CHECKAST		;FILE NAME FIELD
		 GOTO	L2
				edit(61)
		JUMPN	IOCOME	;[61]
		LI	X1,OFFSET(ZFIEXT)(XCB)
		CHECKAST		;EXTENSION FIELD
		 GOTO	L2
		JUMPN	IOCOME	;[61]
		IF	;Subfile directories
			IFOFF	ZFISFD(XCB)
			GOTO	FALSE
		THEN
			LF	X1,ZFIARG(XCB)
			LI	X1,OFFSET(ZYSP1)(X1)
		ELSE
			LI	X1,OFFSET(ZFIPRJ)(XCB)
		FI
		CHECKAST		;PPN field
		 GOTO	L2
		JUMPN	IOCOME	;[61]
	FI	;[167]
	FI

	edit(105)
	BEGIN	;[105]

	IFON	ZFIBNW(XCB)	;[105] Buffers wanted?
	 GOTO	L8		;[105] No!

	;Now compute arguments to GETBUFF:
	;X6 = Buffer size
	;X7 = No of buffers
	;OPEN arguments should still be in X3,X5

	LF	X4,ZFIDVN(XCB)
	LI	X2,3
	DEVSIZ	X2,
	 NOP			;Ignore error return
	IF	;"BUFFERS"
		LF	X6,ZFIBUF(XCB)
		JUMPE	X6,FALSE
	THEN	;Check if it is size or number of buffers
		IF	;No of buffers
			CAILE	X6,^D32
			GOTO	FALSE
		THEN	L	X7,X6		;X7:=No of buffers
			HRR	X6,X2		;X6:=Default size
		ELSE
			IF	;Not magtape
				IFON	ZFIMTA(XCB)
				GOTO	FALSE
			THEN	BREAKOUTIMAGE <WARNING: Too many buffers for file: >
				LF	X0,ZFINAM(XCB)
				TYPENAME
				OUTIMAGE < . 2 standard buffers assumed>
				LI	X6,QBUFS
			FI
			HLR	X7,X2		;X7:=Default number
		FI
	ELSE
		;Here if "BUFFERS" is not defined or if this file
		;is not in IOSPEC
		HRRZ	X6,X2		;Default
		SKIPN	X7,YOCBFN(XLOW)	;Use global number of buffers
		 HLRZ	X7,X2		;ELSE default
	FI
	;Finally check if this file is a DIRECTFILE
	IF	IFOFF	ZFIDF(XCB)
		GOTO	FALSE
	THEN	LI	X6,QBUFS	;Standard buffer size for DSK
		LI	X7,1		;Use one buffer only for DIRECTFILE
	FI
	SF	X7,ZFIBUF(XCB)
	SF	X6,ZFIBFS(XCB)
	edit(105)
L8():!	;[105]
	ENDD	;[105]
	CREATEFILE
			edit(61)
	JUMPE	L9	;[61]
;[105]
IOCOME:	SKIPA	;[61] Flag file not found by not setting ENDFILE! 
L9():!
	 SETON	ZIFEND(XCB)	;Flag end-of-file for this file
	CENABLE			;Enable SIMDDT call at ^C-REENTER
	RETURN
	EPROC
	SUBTTL	IONFCA	(Check APPEND mode) [10]

	Comment;

	Purpose:	To check the use of /ACCESS:APPEND

	Entry:		IONFCA

	Input:		XCB points to the file object

	Normal exit:	RET

	Call format:	EXEC	IONFCA
	;


	edit(10)
	;[10]	New routine
	;	The code was previously found in SETUPFILE (.IOCOM).
	;	The routine is now also called in FILELOOKUP/FILEENTER
	;	The switch ZFIAPP is set off if append mode was misused.

IONFCA:
	;Now check if ACCESS:APPEND is used for other device than DSK
	;or for other file type than OUTFILE or PRINTFILE
	IFOFF	ZFIAPP(XCB)
	 RET

	IF	;Device not DSK
		IFON	ZFIDSK(XCB)
		GOTO	FALSE
	THEN	;WARNING!
		OUTIMAGE <Warning: Append mode ignored for non-disk devices!>
		edit(61)
	ELSE	;[61]
		IFON	ZFIOF(XCB)
		 RET
		BREAKOUTIMAGE <Warning: Append mode ignored for >
	FI
	SETOFF	ZFIAPP(XCB)
	L	XCB	;[61]
	TYPESPEC	;[61]
	RET
	SUBTTL	LITERALS
	LIT
	END