;<TENDERIN>OCIN.MAC.4, 17-Jan-77 02:06:20, Edit by ENDERIN
;<ENDERIN>OCIN.MAC.72,  5-Jan-77 16:43:28, Edit by ENDERIN
	SEARCH	SIMMAC,SIMMCR,SIMRPA
	SALL
	RTITLE	OCIN
;	Edits:	[1C,3,24,32,41,61,67,144,177,224,225,244,261]
	SUBTTL Written by Olof Bjorner and Lars Enderin Nov 1973

	ERRMAC	OC
	MACINIT

	EXTERN	.JB41,.JBAPR,.JBFF,.JBHRL,.JBREL,.PDERR
	EXTERN	.SAAB,.SAAR,.SAGC,.SAGI,.TXBL
	INTERN	.OCIN


	LOC	.JBOPS
	Z	;TELLS OCSP THAT SIMRTS WAS LOADED

	TWOSEG
	RELOC	400K

	edit(225)
IF1,<;[225]
QDIRTR==1	;Determines translation of <directory> - [p,pn]
IFN QDEC20,<IFDEF PPNST,<QDIRTR==1>>
>
	SUBTTL	OCIN, SIMRTS high segment initialisation routine

Comment;

.OCIN


Purpose
-------
To initialise for a SIMULA program execution (finish the job  started
by .OCSP).

Input
-----
XFP still  points  to  the  inline  parameter  given  to  .OCSP.  The
accumulators  have  been  saved in YACSAV.  X2 points to .YXAC (first
pseudo ac).  XCB points to the low segment static  area.   .JBFF  has
the first free address in low core.

Function
--------
Initialize  the  pushdown  stack  and set up a stack pointer in XPDP.
Initialize YIOLP to QIOLP, YTXLT to "E". Put a few error  entries  at
YPDL(XLOW)  to  catch  stack  underflow.  YXACAD(XLOW)  is set to the
address of .YXAC, which is transmitted in X2 on entry to  .OCIN  from
.OCSP.   Open  the  user's  tty  as  SYSIN and SYSOUT.  Enable traps,
initialize UUO handler by calling .OCIT.   If the  parameter  pointed
to  by  XFP  had  a  non-zero  address part, decode the "runswitches"
information and read in the file specified.    Form  IOSPEC  for  any
file specifications encountered in that file.   Next, if SYSIN and/or
SYSOUT have been redefined, reallocate those files.  Allocate  buffer
space according to switches provided and set YSABOT to the end of the
buffer space. SAGI is called to initialize the dynamic storage pool.
;
	SUBTTL	OCIN DESCRIPTION

COMMENT ;

OCIN  contains  a  subroutine  package as well as a main routine. The
subroutines are called with special operators defined in  SIMRPA.MAC.
These  operators are made available through the PROCINIT macro, which
also contains necessary INTERN and EXTERN declarations.

The main routine in OCIN performs the following tasks:

-  sets up pointers to certain areas in low segment
-  sets up job number
-  sets up run-time stack
-  enables certain traps
-  sets up buffers for TTY input and output
-  processes file definitions in any specification file
-  sets up file objects for SYSIN and SYSOUT
-  performs SYSIN.OPEN(...) and prepares for SYSOUT.OPEN(...)

;
	SUBTTL	Local macros

	edit(225)
TOPS10,<;[225]
Comment ;
The  macro  YOCTAB  creates  two  tables,  YOCSWT  and YOCSWA. YOCSWT
contains the long forms (except the first  letter)  of  all  compiler
switches  packed  together  in consecutive words. YOCSWA is an access
table for YOCSWT. Each entry  is  a  word  where  the  left  halfword
contains  the  short  one-letter  form  of  the  switch and the right
halfword contains the byte index to the start of  the  long  form  in
YOCSWT.  YOCTAB  also  defines the constant YOCSWL which contains the
length of YOCSWA.
;

DEFINE YOCTAB=<
 DEFINE X(A)=<
		$$SWL=0		;;No of letters in switch name
  IRPC A,<
	$$SWL=$$SWL+1
   IFE <$$SWL-1>,<
	TINQ	("A")		;;IF FIRST CHARACTER SAVE IT IN QUEUE
   >
   IFN <$$SWL-1>,<
	$$ENTR=$$ENTR+"A"B<$$BIT>
	$$BIT=$$BIT+7
    IFG <$$BIT-^D34>,<
	JINQ	$$ENTR		;;IF FULL WORD ENTER IT INTO QUEUE J
	$$JNO=$$JNO+1		;;COUNT ENTRY
	$$BIT=6
    	$$ENTR=0
    >
   >
  >;; END OF IRPC
	TINQ	($$IND)		;;SAVE BYTE INDEX
	$$IND=$$IND+$$SWL-1
	$$SWNO=$$SWNO+1
 >;;END OF X

	GETQUE	(T)		;;GET A QUEUE FOR YOCSWA
	GETQUE	(J)		;;GET A QUEUE FOR YOCSWT
	$$SWNO=0		;;NO OF SWITCH NAMES
	$$IND=0			;;BYTE INDEX TO YOCSWT
	$$ENTR=0		;;ENTRY IN YOCSWT
	$$BIT=6			;;BIT POSITION
	$$JNO=0			;;NO OF ENTRIES IN QUEUE J

 ;; NOW USE X

	X	ACCESS
	X	BUFFERS
	X	FILES
	X	HELP
	X	IMAGESIZE
	X	LIMIT
				edit(24)
	X	NUMBERED	;[24]
	X	SIZE
	X	WORDALIGNED	;[24]
	JINQ	$$ENTR
	$$JNO=$$JNO+1

 ;; SET UP ACCESS TABLE
	$$TMP1=<$$TMP2=0>
YOCSWA:				;;ACCESS TABLE

 REPEAT $$SWNO,<
	TOUTQ	($$TMP1)	;;GET SHORT FORM
	TOUTQ	($$TMP2)	;;GET BYTE INDEX
	XWD	$$TMP1,$$TMP2
 >

YOCSWT:				;;CHARACTER TABLE
 REPEAT $$JNO,<
	JOUTQ	($$TMP1)	;;GET ENTRY IN YOCSWT
	EXP	$$TMP1
 >
YOCSWL::	EXP	-$$SWNO
	PURGE	$$IND,$$TMP1,$$TMP2,$$SWL,$$SWNO,$$JNO,$$ENTR,$$BIT
>;END OF MACRO YOCTAB
>;[225]

IFN QDEBUG,<
OCINST:	;LABEL FOR DEBUGGING ONLY
>
	edit(225)
	IFE QDEC20,<;[225]
	YOCTAB		;CREATE SWITCH TABLES
	>
	SUBTTL	MESSAGES

	NOP==NOP

DEFINE OUTIMAGE(A)=<
	EXEC	OCINTS
	EXP	NOP+<QIND'A>B26+QM'A
>

	edit(224)
DEFINE SWERROR(A)=<;;[224]
	EXEC	OCINSE
	EXP	NOP+<QIND'A>B26+QM'A
>
DEFINE BREAKOUTIMAGE(A)=<
	EXEC	OCINTL
	EXP	NOP+<QIND'A>B26+QM'A
>

;MESSAGES  IS A MACRO THAT PACKS ALL MESSAGES
;IN FIVEBIT FORMAT

DEFINE MESSAGES=<
	.XCREF
 DEFINE X(ARG)=<
	QCOUNT=QCOUNT+1		;;MESSAGE NUMBER UPDATED
 IFNB <ARG>,<
	.CREF
	$$C(QM,\QCOUNT)==<44-CC.*5>	;;SET UP BYTE POINTER
	$$C(QIND,\QCOUNT)==QINDEX;;SET INDEX REGISTER
	.XCREF
  IRPC ARG,<
	ZZ.==-1			;;HELP VARIABLE
   IFE <"ARG"-" ">,<ZZ.=0>
   IFE <"ARG"-".">,<ZZ.=33>
   IFE <"ARG"-"?">,<ZZ.=34>
   IFE <"ARG"-":">,<ZZ.=35>
   IFE <"ARG"-"^">,<ZZ.=36>;;[224]
   IFGE <"ARG"-"A">,<
    IFLE <"ARG"-"Z">,<ZZ.="ARG"&37>
   >
   IFE <ZZ.+1>,<PRINTX NOT VALID FIVEBIT CHARACTER: ARG>
   IFN <ZZ.+1>,<
	WORD=WORD_5+ZZ.		;;UPDATE ELEMENT ENTRY
	CC.=CC.+1		;;COUNT THIS CHARACTER
    IFE <CC.-7>,<		;;IF ENTRY IS FULL
	WORD=WORD_1
	EXP 	WORD		;;THEN ENTER THIS ELEMENT IN YOCMES
	QINDEX=QINDEX+1		;;UPDATE INDEX TO YOCMES
	CC.=0
	WORD=0
    >
   >
  >;;END OF IRPC
	ZZ.=37			;;SET END OF MESSAGE
	WORD=WORD_5+ZZ.
	CC.=CC.+1
  IFE <CC.-7>,<			;;IF ENTRY IS FULL
	WORD=WORD_1
	EXP	WORD		;;THEN ENTER THIS ELEMENT IN YOCMES
	QINDEX=QINDEX+1		;;UPDATE INDEX
	CC.=0
	WORD=0
  >
 >>;;END OF MACRO X

;;INITIATE ASSEMBLY CONSTANTS:
	WORD==0			;;YOCMES ENTRY
	QINDEX==0		;;VALUE OF INDEX REGISTER
	QCOUNT==0		;;MESSAGE NUMBER
	CC.==0			;;CHARACTER COUNT

;;QMn IS BYTE POINTER TO YOCMES FOR MESSAGE n
;;QINDn IS VALUE OF INDEX REGISTER FOR MESSAGE n
;;[224] Each message starts in upper case, ^ switches case.
;;NOW SET UP THE MESSAGES:

X(<?D^EVICE >)				;;1
X(< ^ILLEGAL>)				;;2
X(<P^LEASE SPECIFY NEW DEVICE>)		;;3
X(<P^LEASE ENTER FILE DEFINITION>)	;;4
X(<^ILL DEL AFTER LAST SWITCH>)		;;5
X(<?APPEND ^OR ^RONLY^ EXPECTED AFTER ^ACCESS>);;6
X(<WARNING: FILES ^MUST BE A GLOBAL SWITCH. ^FILES ^IGNORED>)	;;7
X(<HELP ^SWITCH MISPLACED. ^I^GNORED>)	;;10
X(<?C^ANNOT OPEN DISK>)			;;11
	edit(225)
IFE QDEC20,<;;[225]
X(< >)					;;12 *** FREE ***
>
IFN QDEC20,<;;[225]
X(<?D^IRECTORY NOT FOUND>)		;;12
>
X(<?D^IRECTORY ALREADY SPECIFIED>)	;;13
X(<B^AD FILE SPECIFICATION>)		;;14
X(<L^OCAL SWITCH: >)			;;15
X(<^USED AS GLOBAL. ^I^GNORED>)		;;16
X(<?N^ULL ARG AFTER SWITCH: >)		;;17
X(<?I^LLEGAL DELIMITER: >)	;;20
X(<WARNING: P^ROJ OR PROG NO TRUNCATED>);;21
X(<?P^ROJ NO NOT FOLLOWED BY COMMA>)	;;22
X(<?I^LLEGAL PPN>)			;;23
X(<?P^ROT CODE: ^TOO MANY DIGITS>)	;;24
X(<?I^LLEGAL PROTECTION CODE>)		;;25
X(<S^WITCH: >)				;;26
X(<^NOT RECOGNIZED.>)			;;27
X(<^NOT FOLLOWED BY COLON>)		;;30
X(<^NOT FOLLOWED BY DECIMAL NUMBER>)	;;31
X(<?R^EAD ERROR ON: >)			;;32
X(<?C^LOSE ERROR ON: >)			;;33
X(<?T^TY END OF FILE OR TTY INPUT ERROR>);;34
X(<>)					;;35
X(<E^NTER FILE DEFINITIONS:>)		;;36
X(<?F^ILE: >)				;;37
X(< ^NOT FOUND>)			;;40
X(< E^NTER NEW FILE DESCRIPTOR:>)	;;41
X(<WARNING: SFD^ IGNORED>)		;;42
X(<WARNING: S^WITCHES IGNORED>)		;;43
X(<O^NLY ^DSK^ ALLOWED>)		;;44
X(<N^ESTED IND FILES NOT ALLOWED.^ I^GNORED>);;45
X(<S^PEC FILE STILL OPEN AS ^SYSIN. L^INE IGNORED>);;46
X(<WARNING: D^EVICE NOT ^DSK^ FOR SPEC FILE.^DSK^ ASSUMED>);;47
X(<?>)					;;50
X(<SYSIN^ ALREADY READ.^ L^INE IGNORED>);;51
X(<?I^LL DEL AFTER LOGICAL NAME>)	;;52
X(< ^IN FILE DESCRIPTOR>)		;;53
X(<W^ARNING: NO SWITCH NAME FOUND. ^I^GNORED.>)	;;54
X(<?C^ORE NOT AVAILABLE>)		;;55
X(<?C^ANNOT OPEN>)			;;56
X(<P^LEASE ENTER NEW DEVICE:>)		;;57
X(<?T^OO DEEP ^SFD^ NESTING>)		;;60
X(<?>)					;;61
IFN QDEBUG,<
X(<S^W INDEX OUT OF RANGE>)>		;;62
IFE QDEBUG,<
X(<>)>
X(<L^OGICAL NAME: >)			;;63
X(< ^ALREADY DEFINED. ^I^GNORED.>)	;;64
X(< >)					;;65 *** FREE ***
X(<EXECUTION STARTED>)			;;66
X(<I^ND SPEC FILE NOT FOUND. >)		;;67
X(<?>)					;;70
X(<I^ SWITCH IGNORED. ^F^ILE: >)	;;71
X(< ^IS NOT A DIRECTFILE>)		;;72
X(<L ^SWITCH IGNORED. ^F^ILE: >)	;;73
X(< ^IS NOT AN ^OUTFILE^ OR ^PRINTFILE>);;74

	REPEAT	<7-CC.>,<
	WORD=WORD_5
	>
	WORD=WORD_1
	EXP	WORD

	PURGE QINDEX,ZZ.,CC.,QCOUNT,WORD
	.CREF

> ;END OF MACRO MESSAGES


YOCMES:
	MESSAGES

	SUBTTL	OPDEF DECLARATIONS

OPDEF	COMPSIZ		[XEC	OCINCS]
OPDEF	ERROR		[GOTO	OCINER]
OPDEF	FINDFILE	[XEC	OCINFF]
OPDEF	GETPPN		[XEC	.OCIN3]
OPDEF	GETSWITCH	[XEC	OCINSW]
OPDEF	GETSYSBUFF	[XEC	OCINGS]
OPDEF	MOVESPEC	[XEC	.OCIN5]
OPDEF	NAMECOPY	[XEC	.OCINX]
OPDEF	NEXTBUFF	[GOTO	OCIN3]
OPDEF	NEXTLINE	[GOTO	OCIN4]
OPDEF	NEXTSPEC	[GOTO	OCIN2]
OPDEF	READSPEC	[XEC	OCINRE]
OPDEF	READTTY		[XEC	.OCIN4]
OPDEF	SETWIDTH	[XEC	OCINWI]
OPDEF	TYPESWITCH	[XEC	OCINTW]

	PROCINIT	OCIN
	SUBTTL COMPSIZ

COMMENT ;

Purpose:	To compute the default buffer size and default
		buffer number with a DEVSIZ UUO.
		If DEVSIZ fails a DEVNAM is tried. If this
		also fails the user is asked to supply the
		physical device name.
ENTRY:		OCINCS
INPUT ARGUMENTS:
		X1 points to the actual ZFS record
OUTPUT ARGUMENTS:
		LH of X3 contains default no of buffers
		RH of X3 contains default buffer size
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	COMPSIZ
USED REGISTERS:
		X0,X3,X4,X5,XNAME
USED ROUTINES:	TYPENAME, TTYSPEC, GETNAME [225]
ERROR MESSAGE:	Device: <DEVICE> illegal
;

OCINCS:	PROC
	LF	X5,ZFSDEV(X1)
	HLRZ	X0,X5
	CAIN	X0,'*'B23
	 MOVSI	X5,'DSK'	;Use DSK instead of *
	LI	X4,1		;File status
	LI	X3,X4		;DEVCHR argument in X4-X5
	DEVSIZ	X3,
	 NOP
	IF	;RETURN ARG POSITIVE
		JUMPLE	X3,FALSE
	THEN	;ARG OK
		RETURN
	FI

	;NOW TRY DEVNAM
	IF	;DEVICE EXISTED
		DEVNAM	X5,
		GOTO FALSE
	THEN	;USE PHYSICAL NAME
		SF	X5,ZFSDEV(X1)
		GOTO	OCINCS
	FI
			edit(41)
L1():!			;[41]
	;ERROR
	BREAKOUTIMAGE 1	;?DEVICE
	LF	X0,ZFSDEV(X1)
	TYPENAME
	OUTIMAGE 2	;ILLEGAL
	OUTIMAGE 3	;PLEASE ENTER PHYSICAL DEVICE
		edit(225)
	TTYSPEC		;[225]
	 GOTO	L1	;[225] on altmode
	SF	XNAME,ZFSDEV(X1);STORE NEW DEVICE NAME
	GOTO	OCINCS		;AND TRY AGAIN
	EPROC
	SUBTTL	COPYSPEC

COMMENT ;

PURPOSE:	To  copy  information from an IOSPEC entry (ZFS) to a
		file object (ZFI) and possibly to a SFD record (ZYS).
		If the ZFS entry contains sub-file directories then a
		ZYS record is allocated with the .SAAR routine.  Note
		that  both a ZYS block and a ZXB block may exist when
		COPYSPEC is called. Only fields that are  defined  in
		IOSPEC are copied.  COPYSPEC is called from OCIN main
		routine when the file objects for  SYSIN  and  SYSOUT
		are  created and from the SETUPFILE subroutine in the
		IONF module when a new file is generated.

ENTRY:		.OCIN6
INPUT ARGUMENTS:
		X1 points to ZFS
		XRAC points to ZFI.
OUTPUT ARGUMENT:
		Updated ZFI record
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	COPYSPEC
USED REGISTERS:
		X0,X5,X4,XTAC
USED ROUTINE:
		SAAR to allocate ZYS.
ERROR MESSAGES:	-
;

.OCIN6:
	PROC
	SAVE	<X6,X5,X4,XTAC>
	LI	X6,0		;X6=0 means no extended block
	IFON	ZFIDE(XRAC)
	 LF	X6,ZFIFIL(XRAC)	;ELSE X6=ref to extended block
	IF	;ppn is specified in ZFS
		SKIPN	X0,OFFSET(ZFSPRJ)(X1)
		GOTO	FALSE
	THEN
		IF	;Sub-file directories in ZFS
			LF	X0,ZFSPRJ(X1)
			JUMPN	X0,FALSE
		THEN	;Compute size of SFD block in ZFS
	edit(225)
			IFE QDEC20,<;[225]
			LF	XTAC,ZFSLNK(X1)
			SUB	XTAC,X1		;Length of ZFS
			SUBI	XTAC,11		;Length of SFD
			L	X4,XTAC
			IF	;SFD IN ZFI
				IFOFF	ZFISFD(XRAC)
				GOTO	FALSE
			THEN	;CHECK IF SIZE IS ADEQUATE
				LF	X5,ZFIARG(XRAC)	;LINK TO ZYS
				SKIPE	X6
				 LF	X5,ZXBP2(X6)	;Link to ZYS if extended block
				L	X0,1(X5)	;LENGTH OF OLD ZYS
				SUBI	X0,2		;SUBTRACT ZYS HEADER LENGTH
				CAML	X0,X4
			ELSE
				;HERE IF NEW ZYS RECORD MUST
				;BE ALLOCATED!
				HRLI	XTAC,QZYS	;RECORD TYPE
				ADDI	XTAC,2		;LENGTH INCL. HEADER
				SETOM	YSANIN(XLOW)
				EXEC	.SAAR		;GET RECORD
				SF	XTAC,ZFIARG(XRAC);LINK TO ZYS IN FILE OBJECT
				SKIPE	X0,X6
				 SF	XTAC,ZXBP2(X6)	;Link to ZYS in extended block
				SETON	ZFISFD(XRAC)	;FLAG SFD:S FOR THIS FILE

			IFN QSADEA,<	;UPDATE YSADEA IN DEALLOCATE VER.
				L	X0,YSATOP(XLOW)
				ST	X0,YSADEA(XLOW)>

			FI
			HRLI	X0,OFFSET(ZFSARG)(X1)
			HRRI	X0,2(XTAC)
			ADDI	X4,2(XTAC)
			BLT	X0,(X4)		;MOVE SFD BLOCK
			LF	X0,ZYSP1(XTAC)
			SF	X0,ZFIPPN(XRAC)	>;[225]
		ELSE	;MOVE PPN TO ZFI OR ZXB
			WLF	X5,ZFSPRJ(X1)	;PPN TO BE MOVED
			IF	;SFD IN ZFI
				IFOFF	ZFISFD(XRAC)
				GOTO	FALSE
			THEN	;STORE PPN IN ZYS
				WLF	XTAC,ZFIPRJ(XRAC)
				SKIPE	X0,X6
				 LF	XTAC,ZXBP2(X6)
				SF	X5,ZYSP1(XTAC)
			ELSE
				WSF	X5,ZFIPRJ(XRAC)
			FI
			SF	X5,ZFIPPN(XRAC)
		FI	FI
	;NOW MOVE FILE NAME, EXTENSION AND PROTECTION
	SKIPE	X4,OFFSET(ZFSDEV)(X1)
	 SF	X4,ZFIDVN(XRAC)	;MOVE DEVICE
	SKIPE	X4,OFFSET(ZFSFIL)(X1)
	 SF	X4,ZFIFIL(XRAC)	;MOVE FILE NAME
	SKIPE	X4,OFFSET(ZFSEXT)(X1)
	 WSF	X4,ZFIEXT(XRAC)	;MOVE EXTENSION
	SKIPE	X4,OFFSET(ZFSPT)(X1)
	 WSF	X4,ZFIPT(XRAC)	;MOVE PROTECTION ETC.
	LF	X4,ZFSBUF(X1)
	SF	X4,ZFIBUF(XRAC)	;MOVE BUFFER
		edit(24)
	IF	;[24] not INFILE
		IFON	ZFIIF(XRAC)
		GOTO	FALSE
	THEN	;Copy ZFSWDB,-NUM,-RON
		LF	,ZFSWLR(X1)
		SF	,ZFIWLR(XRAC)
	FI	;[24]
	IF	;OUTPUT FILE
		IFOFF	ZFIOF(XRAC)
		GOTO	FALSE
	THEN	;SET MODE APPEND IF DEFINED
		IFOFF	ZFSAPP(X1)
		GOTO	FALSE
		SETON	ZFIAPP(XRAC)
	FI
	IF	;DIRECT FILE
		IFOFF	ZFIDF(XRAC)
		GOTO	FALSE
	THEN	LF	X0,ZFSIML(X1)
		SF	X0,ZDFIML(XRAC)
	FI
	RETURN
	EPROC
	SUBTTL ERROR

Comment ;

Purpose:	To print the file specification on the user TTY
		and prepare for reading of correction. ERROR is
		entered by a GOTO.
Entry:		OCINER
Input argument:	-
Output argument:-
Normal exit:	IF TTY THEN NEXTSPEC ELSE NEXTBUFF
Error exit:	-
Call format:	ERROR
Used routines:	OUTIMAGE, PRINTSPEC
Used register:	XBUF
Error message:	-
;

OCINER:
	PRINTSPEC
	OUTIMAGE 4			;Please enter file spec
	IFON	SWTTY
	 NEXTSPEC
	SETON	SWERR
	ST	XBUF,YOCBF2(XLOW)	;Save current pointer
	LI	XBUF,YLOW+2(XLOW)	;XBUF now points to TTY buffer
	NEXTBUFF
	SUBTTL	FINDFILE

COMMENT ;

PURPOSE:	TO CHECK FOR DOUBLY DEFINED LOGICAL NAME IN IOSPEC
ENTRY:		OCINFF
INPUT ARGUMENT:
		LOGICAL NAME IN XNAME
OUTPUT ARGUMENTS:
		-
NORMAL EXIT:	RETURN
ERROR EXIT:	NEXTSPEC IF LOGICAL NAME WAS ALREADY DEFINED
CALL FORMAT:	FINDFILE
USED ROUTINES:	BREAKOUTIMAGE
		OUTIMAGE
		TYPENAME
USED REGISTERS:	X1 POINTER TO IOSPEC
ERROR MESSAGE:	?LOGICAL NAME <...> ALREADY DEFINED. IGNORED
;

OCINFF:
	L	X1,YIOSPC(XLOW)	;START OF IOSPEC
	WHILE	;MORE SPECIFICATIONS
		JUMPL	X1,FALSE
	DO	;MATCH NAME
		IF	CAME	XNAME,OFFSET(ZFSNAM)(X1)
			GOTO	FALSE
		THEN	BREAKOUTIMAGE 63	;LOGICAL NAME
			L	X0,XNAME
			TYPENAME
			OUTIMAGE 64		;ALREADY DEFINED. IGNORED
			UNSTK			;REMOVE RETURN ADDRESS
			NEXTSPEC
		FI
		LFE	X1,ZFSLNK(X1)	;NEXT ELEMENT
	OD
	RETURN
	SUBTTL FIXSWITCH

COMMENT ;

Purpose:	To scan and process a number of file switches.
		GETSWITCH is used to retrieve next switch.
		The switch list is considered ended when 
		delimiter space or carriage return is found.
		Any other delimiter is considered illegal.
Entry:		.OCINF
Input argument:	-
Output arguments:
		Switch SWSWERR is TRUE if error(s) were
		detected during switch processing.
		SWHLP is true if help message printed
		successfully.
Normal exit:	RETURN
Error exit:	-
Call format:	FIXSWITCH
Used routines:	GETSWITCH to check validity and spelling of switch.
Used registers:	X0,X2,X3
Error messages:	?Ill delimiter after last switch
		?APPEND or RONLY expected after ACCESS
		FILES must not be a global switch
		I switch ignored
		HELP switch misplaced. ignored
		?Cannot open DISK
		L switch ignored
		Local switch used as global. Ignored
		?Null arg after switch <...>
;

.OCINF:
	LOOP	;until CR is found
		IF	GETSWITCH
			GOTO	FALSE		;ERROR RETURN, IGNORE SWITCH
		THEN	;OK RETURN
			JUMPE	X2,FALSE	;NO SWITCH!
			ASSERT < ;THAT INDEX FROM GETSWITCH IS OK
				IF	CAIGE	X2,YOCSRE
					GOTO	FALSE
				THEN	OUTIMAGE 62	;SW INDEX OUT OF RANGE
					EXIT
				FI
				>
	edit(225)
			L	X2,(X2)	;[225] TABLE ENTRY
			XEC	(X2)	;[225] PERFORM APPROPRIATE SWITCH ROUTINE
		FI
	AS	;MORE SWITCHES
		CAIN	XBYTE,"/"
		GOTO	TRUE
		IF	CAIE	XBYTE," "
			CAIN	XBYTE,QCR
			GOTO	FALSE
		THEN	OUTIMAGE 5	;ILL DEL AFTER LAST SWITCH
		FI
	SA
	RETURN

;SWITCH ROUTINE DISPATCH TABLE:
	edit(225)
DEFINE	X(A,B)<;;[225]
IRP B,<
IFN QDEC20,<
XWD [ASCIZ"B"],A'B
>
IFE QDEC20,<
XWD ..N,A'B
..N==..N+1
>
>>
;;[225] NOTE THE ALPHABETIC ORDER!
	edit(225)
	..N==YOCSRE-YOCSRT	;[225]
	IFN QDEC20,<XWD	..N,..N>;[225]
	..N==0	;[225]
YOCSRT:	X(OCIN,<ACCESS,BUFFERS,FILES,HELP,IMAGESIZE>)
	X(OCIN,<LIMIT,NUMBERED,SIZE,WORDALIGNED>)
	edit(225)
YOCSRE:	;[225]
;ROUTINE FOR SWITCH "ACCESS":
OCINACCESS:
	IFON	SWGSW
	GOTO	OCINE1		;LOCAL SWITCH USED AS GLOBAL
	IF	;APPEND AFTER COLON
		CAME	X3,[SIXBIT/APPEND/]
		GOTO	FALSE
	THEN	IF	;SWITCH IN NEW
			IFOFF	SWTR
			GOTO	FALSE
		THEN	SETON	ZFIAPP(XCB)
		ELSE
			SETON	ZFSAPP(XBASE)
		FI
		RETURN
	FI
		edit(24)
	IF	;[24] RONLY AFTER COLON
		CAME	X3,[SIXBIT/RONLY/]
		GOTO	FALSE
	THEN	IF	;SWITCH IN NEW
			IFOFF	SWTR
			GOTO	FALSE
		THEN	SETON	ZFIRON(XCB)
		ELSE
			SETON	ZFSRON(XBASE)
		FI
		RETURN
	FI
	;ELSE ERROR:
	OUTIMAGE 6	;[24] APPEND OR RONLY EXPECTED AFTER ACCESS
	SETON	SWSWERR
	RETURN

;ROUTINE FOR SWITCH "BUFFERS"
OCINBUFFERS:
	JUMPE	X3,OCINE2		;NULL ARGUMENT
	IF	;GLOBAL SWITCH
		IFOFF	SWGSW
		GOTO	FALSE
	THEN	IF	;ARGUMENT LESS 32
			CAILE	X3,^D32
			GOTO	FALSE
		THEN	ST	X3,YOCBFN(XLOW)
			RETURN
		FI
		ST	X3,YOCBFS(XLOW)
		RETURN
	FI
	;LOCAL SWITCH:
	IF	;SWITCH IN NEW
		IFOFF 	SWTR
		GOTO	FALSE
	THEN	SF	X3,ZFIBUF(XCB)
	ELSE
		SF	X3,ZFSBUF(XBASE)
	FI
	RETURN

;ROUTINE FOR SWITCH "FILES"
OCINFILES:
	IF	;NOT GLOBAL SWITCH
		IFON	SWGSW
		GOTO	FALSE
	THEN	;ERROR
		OUTIMAGE 7	;FILES MUST BE A GLOBAL SWITCH
		RETURN
	FI
	JUMPE	X3,OCINE2		;NULL ARGUMENT
	ST	X3,YOCFIL(XLOW)
	RETURN

;ROUTINE FOR SWITCH "IMAGESIZE":
OCINIMAGESIZE:
	IFON	SWGSW
	GOTO	OCINE1		;ERROR IF USED AS GLOBAL
	JUMPE	X3,OCINE2		;NULL ARG
	ADDI	X3,2		;ADJUST IMAGESIZE FOR CR-LF
	IF	;SWITCH IN NEW
		IFOFF	SWTR
		GOTO	FALSE
	THEN	IF	;NOT DIRECTFILE
			IFON	ZFIDF(XCB)
			GOTO	FALSE
		THEN	BREAKOUTIMAGE 71	;I SWITCH IGNORED
			LF	X0,ZFINAM(XCB)
			TYPENAME
			OUTIMAGE 72
		ELSE
			SF	X3,ZDFIML(XCB)
		FI
	ELSE
		SF	X3,ZFSIML(XBASE)
	FI
	RETURN

;ROUTINE FOR SWITCH "HELP"
OCINHELP:
	BEGIN
	IF	;HELP MISPLACED
		edit(67)
		repeat 0,<;[67] Help possible also in NEW
		IFON	SWTR
		GOTO	TRUE
		>	;[67]
		IFON	SWTTY
		GOTO	FALSE
		IFON	SWERR
		GOTO	FALSE
	THEN	OUTIMAGE 10	;HELP SWITCH MISPLACED IGNORED
		RETURN
	FI
	;*** [67] Use HELPER
	EXTERN	.HELPR
	SETZ	X2,
	IF	;Channel 0 active now
		DEVCHR	X2,
		JUMPE	X2,FALSE
	THEN	;Save status, call HELPER, restore channel
		GETSTS	X2
		L	X1,[SIXBIT/SIMRTS/]
		EXEC	.HELPR
		L	X4,YOCBST(XLOW)
		IF	;Properly active
			JUMPE	X4,FALSE
		THEN	;Restore
			LI	X1,(X2)
			MOVSI	X2,'TTY'
			HRRI	X3,1(X4)
			HRLI	X3,52+1(X4)
			OPEN	0,X1
			HALT
			LI	X6,23
			LI	X7,2
			HRRI	X1,-1(X3)
			LINKBUFF
			HLRZ	X1,X3
			HRRI	X1,-1(X1)
			LINKBUFF
		FI
	ELSE
		L	X1,[SIXBIT/SIMRTS/]
		EXEC	.HELPR
	FI
	RETURN
	;*** End [67]
	ENDD

;ROUTINE FOR SWITCH "LIMIT":
OCINLIMIT:
	IFON	SWGSW
	GOTO	OCINE1		;LIMIT USED GLOBALLY
	JUMPE	X3,OCINE2		;NULL ARGUMENT
	IF	;SWITCH IN NEW
		IFOFF	SWTR
		GOTO	FALSE
	THEN	IF	;NOT AN OUTFILE OR PRINTFILE
			IFON	ZFIOF(XCB)
			GOTO	FALSE
		THEN	BREAKOUTIMAGE 73	;L SWITCH IGNORED
			LF	X0,ZFINAM(XCB)
			TYPENAME
			OUTIMAGE 74
		ELSE
			SF	X3,ZOFLIM(XCB)
		FI
	ELSE
		SF	X3,ZFSLIM(XBASE)
	FI
	RETURN

	edit(24)
;[24] ROUTINE FOR SWITCH "NUMBERED":
OCINNUMBERED:
	IFON	SWGSW
	GOTO	OCINE1
	IF	;Given in NEW
		IFOFF	SWTR
		GOTO	FALSE
	THEN	SETON	ZFINUM(XCB)
	ELSE
		SETON	ZFSNUM(XBASE)
	FI
	GOTO	OCINW1	;Also implies WORDALIGNED switch

;ROUTINE FOR SWITCH "SIZE":
OCINSIZE:
	IFON	SWGSW
	GOTO	OCINE1		;GLOBAL SWITCH
	JUMPE	X3,OCINE2		;NULL ARG
	
	IF	;SIZE IN NEW
		IFOFF	SWTR
		GOTO	FALSE
	THEN	ST	X3,YIOSIZ(XLOW)
	ELSE
		SF	X3,ZFSSIZ(XBASE)
	FI
	RETURN

;[24] ROUTINE for switch "WORDALIGNED"
OCINWORDALIGNED:
	IFON	SWGSW
	GOTO	OCINE1
OCINW1:	IF	;Given via NEW
		IFOFF	SWTR
		GOTO	FALSE
	THEN	SETON	ZFIWDB(XCB)
	ELSE
		SETON	ZFSWDB(XBASE)
	FI
	RETURN

;LOCAL SWITCH USED AS GLOBAL:
OCINE1:
	BREAKOUTIMAGE 15	;LOCAL SWITCH:
	TYPESWITCH
	OUTIMAGE 16	;USED AS GLOBAL. IGNORED
	RETURN

;NULL ARGUMENT:
OCINE2:
	BREAKOUTIMAGE 17	;NULL ARG AFTER SWITCH:
	TYPESWITCH
	SETON	SWSWERR
	RETURN
	SUBTTL	GETBUFF

COMMENT ;
Purpose:	To find the smallest free buffer in IOBUFS.
		Garbage collection (SAGC) is called when
		there is no free buffer of sufficient size.
		The selected buffer is  NOT flagged as used.
Entry:		.OCIN7
Input arguments:
		X6 contains buffer size not including buffer header and link
		X7 contains number of buffers
		YOCBFS (LH) contains address to first buffer
Output arguments:
		X1 contains buffer area base address
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	GETBUFF
USED ROUTINES:	.SAGC
USED REGISTERS:
		X0 - X7
		X2 - X7 are saved
ERROR MESSAGE:	-
;

.OCIN7:	PROC
	SAVE	<X2,X3,X4,X5,X6,X7>
	SETZB	X2,X3		;X2 = ADDRESS TO BUFFER CANDIDATE
				;X3 = LENGTH OF	"	"
	L	X5,X6		;SAVE BUFFER SIZE
	IMUL	X6,X7		;BUFFER LENGTH * NO OF BUFFERS
	ADDI	X6,4		;BUFFER RING HEADER + LENGTH
	L	X1,YOCBST(XLOW)	;LOAD START ADDRESS
L1():!
	IF	;THIS BUFFER IS FREE
		FREE	(X1)
		GOTO	FALSE
	THEN	;CHECK IF IT IS BIG ENOUGH
		LFE	X0,ZBHLEN(X1)
		MOVN	X0,X0
		CAMN	X0,X6
		 GOTO	L5		;Equal, take this buffer
		CAMG	X0,X6
		 GOTO	FALSE		;Less, try next free
		IF	;This is a possible candidate
			JUMPE	X2,TRUE		;Any previous candidates
			CAIG	X3,X0		;Yes, is previous smaller?
			GOTO	FALSE		;Yes
		THEN	;Nominate this buffer as candidate
			L	X3,X0
			L	X2,X1
		FI
	FI
	LF	X0,ZBHLNK(X1)	;NEXT LINK
	IF	;NOT LAST LINK
		CAIN	X0,377777
		GOTO	FALSE
	THEN	;LOAD NEXT LINK AND KEEP SEARCHING
		L	X1,X0
		GOTO	L1
	FI
	IF	;BUFFER FOUND
		JUMPE	X2,FALSE
	THEN	;MAKE A NEW BUFFER AREA OF THE
		;REMAINING SIZE
		L	X4,X2		;COMPUTE LINK TO NEW BUFFER
		ADD	X4,X6
		LF	X0,ZBHLNK(X2)
		SF	X0,ZBHLNK(X4)	;MOVE OLD LINK
		SF	X4,ZBHLNK(X2)	;AND SET UP NEW
		MOVN	X0,X6
		SF	X0,ZBHLEN(X2)	;STORE NEW LENGTH
		SUB	X3,X6
		MOVN	X3,X3
		SF	X3,ZBHLEN(X4)	;STORE LENGTH OF NEW BUFFER
		SETON	ZBHCON(X4)	;FLAG NEW BUFFER AS CONSECUTIVE
		L	X1,X2
		GOTO	L5		;TAKE THIS BUFFER
	FI
	;HERE IF NO BUFFER FOUND
	L	X0,X6
	ST	X0,YSAREL(XLOW)
	STACK	X0		;SAVE LENGTH
	LI	X0,0
	EXEC	.SAGC		;CALL GARBAGE COLLECTOR
	;NOW SET UP A NEW BUFFER WITH THE
	;REQUIRED LENGTH OBTAINED WITH .SAGC
	LFE	X0,ZBHLEN(X1)	;COMPUTE LINK TO NEW BUFFER
	SKIPG	X0
	 MOVN	X0,X0
	ADDI	X0,(X1)
	SF	X0,ZBHLNK(X1)	;STORE LINK
	L	X1,X0		;X1 NOW POINTS TO NEW BUFFER
	SETOM	OFFSET(ZBHLNK)(X1);FLAG LAST BUFFER AS CONSECUTIVE
	UNSTK	X0		;GET LENGTH OF NEW BUFFER
	MOVN	X0,X0
	SF	X0,ZBHLEN(X1)	;AND STORE IT
	GOTO	L1		;TRY THIS NEW BUFFER NOW

L5():!	;HERE WHEN BUFFER FOUND
	RETURN
	EPROC
	SUBTTL	GETPPN

COMMENT ;

PURPOSE:	TO CONVERT A PROJECT OR PROGRAMMER NUMBER.
		FIRST NON-OCTAL CHARACTER IS TAKEN AS DELIMITER.
		IF THE NUMBER CONTAINS MORE  THAN 6 DIGITS
		A  WARNING IS PRINTED. IF FOUND DELIMITER IS
		ASTERISK THEN NEXT CHARACTER IS RETURNED
		AS DELIMITER AND XNAME CONTAINS AN ASTERISK
		IN SIXBIT LEFT JUSTIFIED AT RETURN.
ENTRY:		.OCIN3
INPUT ARGUMENT:	-
OUTPUT ARGUMENTS:
		BINARY CODED OCTAL PRJ OR PRG NO IN XNAME
		DELIMITER IN XBYTE.
NORMAL EXIT:	SKIP RETURN
ERROR EXIT:	IMMEDIATE RETURN WHEN TRUNCATION OCCURRED
USED ROUTINES:	GETBYTE, OUTIMAGE
USED REGISTERS:	XBYTE, XNAME
ERROR MESSAGE:	PROJ OR PROG NO TRUNCATED
;

.OCIN3:
	LI	XNAME,0
	WHILE	;OCTAL DIGIT
		GETBYTE
		CAIL	XBYTE,"0"
		CAILE	XBYTE,"7"
		GOTO	FALSE
	DO	;PACK IT IN XNAME
		IF	;MORE THAN 6 DIGITS
			TRNN	XBYTE,700000
			GOTO	FALSE
		THEN	TLO	XNAME,-1	;FLAG TRUNCATION
		ELSE	;CONVERT AND PACK
			LSH	XNAME,3
			ADDI	XNAME,-60(XBYTE);ASCII -60 = BINARY DIGIT
		FI
	OD
	IF	TLZN	XNAME,-1
		GOTO	FALSE
	THEN	OUTIMAGE 21	;WARNING: PROJ OR PROG NO TRUNCATED
		RET
	FI
	AOS	(XPDP)
	CAIE	XBYTE,"*"
	 RET
	LI	XNAME,'*'B23
	GETBYTE
	RET
	SUBTTL	GETSPEC

COMMENT ;

PURPOSE:	TO PARSE A FILE SPECIFICATION AND STORE
		IT IN THE ZFD RECORD
		GETSPEC ACCEPTS SPACES BETWEEN PARTS OF THE
		FILE SPECIFICATION AND AFTER THE FILE
		SPECIFICATION. IF THERE ARE SPACE(S) AFTER
		THE LAST PART GETSPEC SCANS UNTIL A NON
		SPACE CHARACTER IS FOUND. THIS SHOULD BE
		EITHER OF SLASH OR CARRIAGE RETURN.
ENTRY:		.OCINB
INPUT ARGUMENTS:
		GETNAME CAN BE USED TO GET NEXT NAME
		OF THE SPECIFICATION
OUTPUT ARGUMENT:
		ZFD IS UPDATED AND CONTAINS THE FILE SPEC
		XBYTE CONTAINS THE DELIMITER (NORMALLY SLASH OR CR).
NORMAL EXIT:	SKIP RETURN
ERROR EXIT:	IMMEDIATE RETURN
CALL FORMAT:	GETSPEC
USED ROUTINES:
		GETNAME, GETPPN
USED REGISTERS:
		X0, XBYTE, XNAME
ERROR MESSAGES:	?PROJ NO NOT FOLLOWED BY COMMA
		?TOO DEEP SFD NESTING
		?RIGHT SQUARE BRACKET MISSING
		?PROTECTION CODE EXCEEDS THREE DIGITS
		?RIGHT ANGLE BRACKET MISSING
		?ILL DELIMITER <(XBYTE)> IN FILE SPEC
		?Directory already specified
;

.OCINB:	PROC
	SETZM	OFFSET(ZFDDEV)(XLOW)	;ZERO  ZFD RECORD
	HRLI	OFFSET(ZFDDEV)(XLOW)
	HRRI	OFFSET(ZFDFIL)(XLOW)
	BLT	OFFSET(ZFDSFD)(XLOW)
	GETNAME
	IF	;DELIMITER IS COLON
		CAIE	XBYTE,":"
		GOTO	FALSE
	THEN	SF	XNAME,ZFDDEV(XLOW);STORE DEVICE
		GETNAME			;AND GET NEXT PART
	FI
	edit(225)
	IFN QDIRTR,<;[225] CHECK FOR <DIRECTORY>
	IF	;LEFT BROKET
		CAIE	XBYTE,74
		GOTO	FALSE
	THEN	XEC	OCINGD	;TRANSLATE TO [p,pn]
		GOTO	L9	;ON ERROR
	FI>
	SF	XNAME,ZFDFIL(XLOW);STORE FILE NAME
	IF	;DELIMITER IS DOT
		CAIE	XBYTE,"."
		GOTO	FALSE
L1():!	THEN	;EXTENSION
		GETNAME			;GET EXTENSION

		edit(3)
		;[3] SET FUTURE DATE TO 77777 IN DATE1 FIELD IN EXTENSION
		; WORD TO INDICATE THAT OLD EXTENSION SHOULD BE ZEROED IF
		; THE FILE SPEC CONTAINS A . BUT NO EXTENSION

		SKIPN	XNAME
		LI	XNAME,77777

		WSF	XNAME,ZFDEXT(XLOW);AND STORE IT
	FI
	IF	;DELIMITER IS LEFT SQUARE BRACKET
		CAIE	XBYTE,"["
		GOTO	FALSE
			edit(225)
L2():!	THEN	IF	;[225] PATH (DIRECTORY) NOT ALREADY DEFINED
			SKIPN	OFFSET(ZFDPRJ)(XLOW)
			GOTO	FALSE
		THEN	;ERROR
			OUTIMAGE 13
			GOTO	L9
		FI
		GETPPN			;GET PROJECT NO
		 RET			;IF ERROR
		SF	XNAME,ZFDPRJ(XLOW);STORE PROJECT NUMBER
			edit(144)
		IF	;[144] Delimiter is "-"
			CAIE	XBYTE,"-"
			GOTO	FALSE
			JUMPN	XNAME,FALSE	;AND no proj no given
		THEN	;Default path if "]" follows
			STACK	YOCPNT(XLOW)
			edit(244)
			SETOM	OFFSET(ZFDPRG)(XLOW)	;[244] Save explicit
							;   default path as -1
			GETNAME
			NOP	-1	;[263] No funny name
					edit(263)
			UNSTK
			JUMPE	XNAME,L4	;Go check for "]"
			ST	YOCPNT(XLOW)	;Back up pointer
			LI	XBYTE,"-"
		FI	;[144]
		IF	;DELIMITER IS NOT COMMA
			CAIN	XBYTE,","
			GOTO	FALSE
		THEN	;ERROR
			OUTIMAGE 22	;PROJ NO NOT FOLLOWED BY COMMA
			RETURN
		FI
		GETPPN			;GET PROGRAMMER NO
		 RET			;IF ERROR
		SF	XNAME,ZFDPRG(XLOW);STORE PROGRAMMER NO
			edit(144)
		IF	;[144] proj or prog is zero
			JUMPE	XNAME,TRUE
			LF	,ZFDPRJ(XLOW)
			JUMPN	FALSE
		THEN	;Fill from device ppn
								edit(244)
			SKIPE	XNAME,OFFSET(ZFDDEV)(XLOW)	;[244]
			 DEVPPN	XNAME,				;[244]
			CALLI	XNAME,24 ;GETPPN UUO, was redefined here
			 NOP		;Just in case of JACCT
			WLF	,ZFDPRJ(XLOW)
			TLNN	-1
			 HLLM	XNAME,OFFSET(ZFDPRJ)(XLOW)
			TRNN	-1
			 HRRM	XNAME,OFFSET(ZFDPRG)(XLOW)
		FI	;[144]
	edit(225)
IFE QDEC20,<;[225]
		IF	;DELIMITER IS COMMA
			CAIE	XBYTE,","
			GOTO	FALSE
		THEN	;WE HAVE FOUND SFD!
			L	X0,YOCPNT(XLOW)	;SAVE POINTER TO FIRST SFD
			SF	X0,ZFDPNT(XLOW)	;IN ZFD
			LOOP	;UNTIL NO MORE SFD
				GETNAME
				NOP	-1	;[263] No funny SFD name!
						edit(263)
				AOS	OFFSET(ZFDSFD)(XLOW)	;COUNT NO OF SFD:S
			AS	CAIN	XBYTE,","
				GOTO	TRUE
			SA
			;NOW DO A GETTAB FROM TABLE .GTLVD (TABLE 16)
			;ELEMENT %LDSFD (ENTRY 17) TO DETERMINE
			;MAX NESTING LEVEL
			L	X0,[XWD 17,16]
			GETTAB	X0,
			 LI	X0,0		;NO SFD:S ON ERROR RETURN!
			IF	;TOO DEEP NESTING
				CAML	X0,OFFSET(ZFDSFD)(XLOW)
				GOTO	FALSE
			THEN	;ERROR!
				OUTIMAGE 60	;?TOO DEEP SFD NESTING
				RET
			FI
		FI
>;[225]
L4():!		IF	;NOT RIGHT SQUARE BRACKET
			CAIN	XBYTE,"]"
			GOTO	FALSE
		THEN	;ERROR
			OUTIMAGE 23	;RIGHT SQUARE BRACKET MISSING
			RET
		FI
		GETBYTE			;GET NEXT DELIMITER
	FI
IFN QDEC20,<;[225]
	IF	;Delimiter is ";"
		CAIE	XBYTE,";"
		GOTO	FALSE
	THEN	;May be DEC-20 style protection
		GETBYTE
		IF	;P
			CAIN	XBYTE,"P"
			GOTO	TRUE
			CAIE	XBYTE,"p"
			GOTO	FALSE
		THEN	;Should be protection
			GETPPN
			 GOTO	L9
			IF	;Too many digits
				TLNN	XNAME,-1
				GOTO	FALSE
			THEN	;Error message
				OUTIMAGE 24
				RET
			FI
			;Translate to TOPS-10 format
			HRRZ	X1,XNAME
			LSH	XNAME,6		;Propagate privileges
			TRO	X1,(XNAME)
			LSH	XNAME,6
			TRO	X1,(XNAME)
			MOVSI	XNAME,(1B9)	;Stop bit for loop
			LOOP
				LI	7
				TRNE	X1,<FP%EX>B23
				 LI	6		;EXECUTE
				TRNE	X1,<FP%RD>B23
				 LI	5		;READ
				TRNE	X1,<FP%APP>B23
				 LI	4		;APPEND
				TRNE	X1,<FP%WR>B23
				 LI	2		;WRITE
				TRC	X1,77B23
				TRCE	X1,77B23
				 ORM	XNAME
				LSH	XNAME,3
			AS
				JUMPG	XNAME,TRUE	;3 times through loop
			SA
			LSH	XNAME,-3
				edit(305)
			GOTO	L5	;[305]
		FI
		GOTO	L9		;Give up
	FI
	>
	IF	;DELIMITER IS LEFT ANGLE BRACKET
		CAIE	XBYTE,74
		GOTO	FALSE
L3():!	THEN	;PROTECTION CODE
		GETPPN
		 RET		;IF ERROR
		IF	;MORE THAN 3 DIGITS
			TRZN	XNAME,777000
			GOTO	FALSE
		THEN	;PRINT ERROR
			OUTIMAGE 24	;PROT CODE EXCEEDS THREE DIGITS
			RET
		FI
		IF	;DELIMITER IS NOT RIGHT ANGLE BRACKET
			CAIN	XBYTE,76
			GOTO	FALSE
		THEN	;ERROR
			OUTIMAGE 25	;RIGHT ANGLE BRACKET MISSING
			RET
		FI
L5():!		SF	XNAME,ZFDPT(XLOW)	;[305]
		GETBYTE			;GET NEXT DELIMITER
	FI
	CAIN	XBYTE," "	;ELIMINATE POSSIBLE SPACE HERE
				edit(225)
	 GETBYTE		;[225] Only one possible
	IF	;Delimiter is not CR or /
		CAIE	XBYTE,QCR
		CAIN	XBYTE,"/"
		GOTO	FALSE
	THEN	;See if it is a usable delimiter
		CAIN	XBYTE,"."
		 GOTO	L1		;Try extension
		CAIN	XBYTE,"["
		 GOTO	L2		;Try ppn
		CAIN	XBYTE,74
		 GOTO	L3		;Try protection
		;ELSE illegal delimiter!
		BREAKOUTIMAGE 20	;?Ill delimiter
		LI	X1,""""
		PBOUT		;[225]
		L	X1,XBYTE
		PBOUT		;[225]
		LI	X1,""""
		PBOUT		;[225]
		OUTIMAGE 53		;in file spec
	ELSE
		AOS	(XPDP)
	FI
L9():!	RETURN
	EPROC
	SUBTTL	NAMECOPY	[225]

COMMENT;

Purpose:	Copies a string valid as a directory or (long)
		file name.

Entry:		.OCINX

Input:		X2 points to next byte in target string
		or is zero (at least left half) when no
		copy is wanted.
		The coroutine "byte-producer" (see below)
		delivers one byte in XBYTE on each call.

Call:		NAMECOPY
		  GOTO	byte-producer

Output:		X2 is updated target pointer.
		The delimiter following the name is also copied.
;

.OCINX:	PROC
	N==0	;SHOULD BE ZERO
	LOOP
		XEC	@-N(XPDP)	;NEXT BYTE
		TLNE	X2,-1
		IDPB	XBYTE,X2
	AS
		IFN QDEC20,<
		CAIE	XBYTE,"_"
		CAIN	XBYTE,"-"
		GOTO	TRUE
		>
		IFE QDEC20,<CAIE XBYTE,"%">
		CAIN	XBYTE,"$"
		GOTO	TRUE
		CAIL	XBYTE,"0"
		CAILE	XBYTE,"z"
		GOTO	FALSE
		CAIGE	XBYTE,"a"
		CAIG	XBYTE,"9"
		GOTO	TRUE
		CAIG	XBYTE,"Z"
		CAIGE	XBYTE,"A"
		GOTO	FALSE
		GOTO	TRUE
	SA
	AOS	-N(XPDP)	;SKIP RETURN
	RETURN
	EPROC
	SUBTTL	OCINGD	[225] Translate directory to ppn

	IFN QDIRTR,<
Comment;

Input:	YOCPNT points to first char after left broket.
Output:	On success, ZFDPPN is [p,,pn]
	or SIXBIT"*     ", and
	YOCPNT points to first character after first "name"
	Following right broket, XNAME is that "name" in SIXBIT.
Normal return: skip.
Error return: non-skip.
;

OCINGD:	PROC
	SAVE	<X1,X2,X3>
	N==3
	L	X2,YOCPNT(XLOW)
	ILDB	XBYTE,X2
	IF	;*
		CAIE	XBYTE,"*"
		GOTO	FALSE
	THEN	;Put SIXBIT"*     " in PPN field
		ST	X2,YOCPNT(XLOW)
		MOVSI	X1,(<'*'>B5)
		ILDB	XBYTE,YOCPNT(XLOW)
		CAIE	XBYTE,76
		 GOTO	L9
	ELSE
		L	X2,[POINT 7,YOCTXT(XLOW)]
		WLF	X1,ZFDDEV(XLOW)
		IF	;Device was scanned
			JUMPE	X1,FALSE
		THEN	;Put DEV: in string
			NAMECOPY
			 GOTO	[SETZ
				LSHC	6
				ADDI	40
				ST	XBYTE
				RET]
			LI	":"
			DPB	X2	;Overwrite blank
		FI
		LI	74
		IDPB	X2	;Left broket
		NAMECOPY
		 GOTO	[ILDB	XBYTE,YOCPNT(XLOW)
			RET]
		CAIE	XBYTE,76;Right broket?
		 GOTO	L9
		SETZ
		DPB	X2	;CLOSE ASCIZ STRING
		L	X2,[POINT 7,YOCTXT(XLOW)]
		SETZ	X1,	;TRY RECOGNITION
		RCDIR
		ERJMP	.+2
		 TLNE	X1,(RC%NOM+RC%AMB)
		  SETZB	X2,X3
		IF	;OK
			JUMPE	X3,FALSE
		THEN	;Find PPN
			L	X1,X3
			STPPN%
			ERJMP	[SETZ	X2,
				GOTO	.+1]
		FI
	FI
	IF	;Zero ppn
		JUMPN	X2,FALSE
	THEN	;ERROR
		OUTIMAGE 12	;DIRECTORY NOT FOUND
	ELSE
		WSF	X2,ZFDPRG(XLOW)
		GETNAME
		 AOS	-N(XPDP)	;Success, skip
	FI
L9():!	RETURN
	EPROC
>
	SUBTTL 	GETSWITCH

COMMENT ;
Purpose:	To look up a switch and get its value.
		MOST SWITCHES SHOULD BE
		FOLLOWED BY COLON AND AN ARGUMENT. THIS ARGUMENT
		SHOULD BE A DECIMAL INTEGER OPTIONALLY FOLLOWED
		BY THE LETTER P OR K. THE ACCESS SWITCH SHOULD
		HOWEVER BE FOLLOWED BY A KEYWORD.
		IF THE SWITCH IS NOT FOUND AN ERROR MESSAGE IS
		ISSUED.

ENTRY:		OCINSW
INPUT ARGUMENTS:
		GETBYTE WILL RETURN FIRST BYTE OF THE SWITCH AFTER THE SLASH
OUTPUT ARGUMENTS:
		X0-X1 CONTAIN THE SWITCH IN SIXBIT (DEC10 ONLY)
		X2 POINTS TO ENTRY IN YOCSRT, OR IS ZERO
		X3 CONTAINS THE NUMBER AFTER : IN BINARY,
		OR THE KEYWORD IN SIXBIT.
NORMAL EXIT:	SKIP RETURN
ERROR EXIT:	IMMEDIATE RETURN
CALL FORMAT:	GETSWITCH
USED ROUTINES:
		GETBYTE, OUTIMAGE
USED REGISTERS:
		X0-X10, XBYTE
ERROR MESSAGES:	WARNING: NO SWITCH
		SWITCH: <...> NOT RECOGNIZED. IGNORED
		SWITCH: <...> NOT FOLLOWED BY DECIMAL DIGIT
;
OCINSW:	PROC
	SAVE	<X4,X6>
	edit(225)
	IFE QDEC20,<;[225]
	LI	X0,0
	MOVSI	X4,440700	;BYTE POINTER TO X0
	>
	L	X2,YOCPNT(XLOW)	;[225]
	GETBYTE			;GET FIRST CHARACTER OF SWITCH
	
	IF	;SLASH, CR OR SPACE
		CAIE	XBYTE,QCR
		CAIN	XBYTE,"/"
		GOTO	TRUE
		CAIE	XBYTE," "
		GOTO	FALSE
	THEN	;NO SWITCH!
		SETZ	X2,	;[225]
		OUTIMAGE 54	;WARNING: NO SWITCH
		GOTO	L8
	FI
	IFN QDEC20,<;[225]
	ST	X2,YOCPNT(XLOW)
	L	X2,[POINT 7,YOCTXT(XLOW)]
	ST	XBYTE,X6	;REMEMBER 1ST LTR
	NAMECOPY
	  GOTO	[ILDB	XBYTE,YOCPNT(XLOW)
		RET]
	SETZ
	DPB	X2	;END OF ASCIZ STRING
	L	X2,[POINT 7,YOCTXT(XLOW)]
	LI	X1,YOCSRT-1
	TBLUK
	IF	;NO MATCH OR AMBIGUOUS
		TLNN	X2,(TL%NOM+TL%AMB)
		GOTO	FALSE
	THEN	;NO FIND
		SWERROR	27
		GOTO	L9
	FI
	LI	X2,(X1)
	IF	;":" FOUND
		CAIE	XBYTE,":"
		GOTO	FALSE
	THEN	;FIND VALUE
		IF	;ACCESS
			CAIE	X6,"A"
			GOTO	FALSE
		THEN	GETNAME
			L	X3,XNAME
			GOTO	L8
		FI
		STACK	X2
		L	X1,YOCPNT(XLOW)
		LI	X3,^D10
		NIN
		IF	;OK
			GOTO	FALSE
		THEN
			L	X3,X2
			UNSTK	X2
			ST	X1,YOCPNT(XLOW)
			LDB	XBYTE,X1
			CAIN	XBYTE,QLF
			 LI	XBYTE,QCR
			CAIN	XBYTE,QCR
			 GOTO	L8
			CAILE	XBYTE,"Z"
			 SUBI	XBYTE,40
			IF	;"P"
				CAIE	XBYTE,"P"
				GOTO	FALSE
			THEN	;MULTIPLY BY 512
				LSH	X3,9
				GETBYTE
			ELSE
			IF	;"K"
				CAIE	XBYTE,"K"
				GOTO	FALSE
			THEN	;MULT BY 1024
				LSH	X3,^D10
				GETBYTE
			FI	FI
			GOTO	L8
		FI
		UNSTK	X2	;ERROR
		SWERROR	31
		GOTO	L9
	ELSE	;FIND OUT IF A COLON SHOULD HAVE BEEN SUPPLIED
		CAIN	X6,"W"
		 GOTO	L8
		CAIE	X6,"H"
		 CAIN	X6,"N"
		  GOTO	L8
		SWERROR	30
		GOTO	L9
	FI>

	IFE QDEC20,<;[225]
	IDPB	XBYTE,X4
	HRLZ	X2,YOCSWL	;LENGTH OF YOCSWA
	LOOP	;UNTIL SHORT FORM FOUND
		;OR TABLE EXHAUSTED
		HLRZ	X1,YOCSWA(X2)
		CAMN	X1,XBYTE
		GOTO	FALSE		;FOUND!
	AS	INCR	X2,TRUE
		;NOT FOUND!
				edit(32)
		GETBYTE		;[32]
		WHILE	;NOT CR OR SLASH
			CAIE	XBYTE,QCR
			CAIN	XBYTE,"/"
			GOTO	FALSE
		DO	;STORE IT
			TRNN	X0,(177B16)	;[32]
			 IDPB	XBYTE,X4
			GETBYTE
		OD
		SWERROR	27
		GOTO	L9
	SA
	;NOW COMPUTE BYTE POINTER TO LONG FORM IN YOCSWT:
	HRLI	X2,0		;REMOVE NEG LENGTH IN LH OF X2
	HRRZ	X7,YOCSWA(X2)	;X7:=START INDEX TO REST OF SWITCH IN YOCSWT
	IDIVI	X7,5		;X7:=WORD ADDRESS
	L	X6,X10		;X6:=BYTE ADDRESS WITHIN THIS WORD
	IMULI	X6,7		;COMPUTE P OF BYTE POINTER
	SUBI	X6,44
	IMULI	X6,-^D4096	;SHIFT P TO ITS PLACE
	IORI	X6,7B29+X7	;INSERT SIZE AND INDEX REGISTER
	LSH	X6,^D18		;MOVE TO LH OF POINTER
	HRRI	X6,YOCSWT	;SET UP START ADDRESS

	;COMPUTE LENGTH OF LONG FORM:
	HRRZ	X5,YOCSWA+1(X2)	;START OF NEXT SWITCH MINUS
	HRRZ	X1,YOCSWA(X2)	;START OF THIS SWITCH =
	SUB	X5,X1		;LENGTH OF THIS SWITCH

	;SCAN LONG FORM AND COMPARE:
	WHILE	SOJL	X5,L3
	DO	ILDB	X3,X6		;GET BYTE FROM YOCSWT
		GETBYTE			;GET BYTE FROM SWITCH
		CAIN	XBYTE,":"
		 GOTO	L2		;Match is over, switch shorter than long form
		CAIE	XBYTE,"/"
		 CAIN	XBYTE,QCR
		  GOTO	L1		;Match is over, switch shorter than long form,
					;no colon
		CAIN	XBYTE," "	;[32] Space finishes the switch
		 GOTO	L3		;[32] Scan past spaces and other stuff
		TRNN	X0,(177B16)	;[32]
		 IDPB	XBYTE,X4	;Store byte in X0 if not overflow
		CAMN	XBYTE,X3	;Continue if match
	OD
	;Here if the switch did not match
	edit(225)
	SWERROR	27		;[225]
	;Here if long form in YOCSWT exhausted
	;Scan until switch exhausted
L3():!	LOOP	;Until colon, null, slash or CR
		GETBYTE
	AS	CAIN	XBYTE,":"
		 GOTO	L2
		CAIN	XBYTE,"/"
		 GOTO	FALSE
		JUMPE	XBYTE,TRUE	;[225]
		CAIE	XBYTE,QCR
		 GOTO	TRUE
	SA

L1():!	SETO	X3,	;[225] Return -1 as value if no colon found
	GOTO	L8
	;Here if colon found
L2():!	IF	;ACCESS
		CAIE	X2,0
		GOTO	FALSE
	THEN	GETNAME
		L	X3,XNAME
		GOTO	L8
	FI
	LI	X3,0
	WHILE	;DECIMAL DIGIT, "P" OR "K"
		GETBYTE
		CAIN	XBYTE," "
		 GOTO	L8
		CAIE	XBYTE,"/"
		 CAIN	XBYTE,QCR
		  GOTO	L8
		IF	;P
			CAIE	XBYTE,"P"
			GOTO	FALSE
		THEN	LSH	X3,^D9
			GOTO	L8
		FI
		IF	;K
			CAIE	XBYTE,"K"
			GOTO	FALSE
		THEN	LSH	X3,^D10
			GOTO	L8
		FI
		IF	;Not decimal digit
			CAIGE	XBYTE,"0"
			GOTO	TRUE
			CAIG	XBYTE,"9"
			GOTO	FALSE
		THEN	;ERROR
				edit(225)
			SWERROR	31	;[225]
			GOTO	L9
		FI
	DO	;CONVERT TO BINARY
		IMULI	X3,^D10
		ADDI	X3,-60(XBYTE)
	OD	>;[225]
	edit(225)
L8():!	IFE QDEC20,<LI	X2,YOCSRT(X2)>	;[225]
	AOS	-2(XPDP)	;OK RETURN
L9():!	LDB	XBYTE,YOCPNT(XLOW)	;[225]
	CAIN	XBYTE,QLF	;[225]
	 LI	XBYTE,QCR	;[225]
	WHILE	;NOT CR, NULL, SLASH OR SPACE
		JUMPE	XBYTE,FALSE
		CAIN	XBYTE," "
		GOTO	FALSE
		CAIE	XBYTE,"/"
		CAIN	XBYTE,QCR
		GOTO	FALSE
	DO	GETBYTE
	OD
	RETURN
	EPROC


	edit(225)
OCINSE:	PROC	;[225] SWITCH ERROR
	BREAKOUTIMAGE 26	;SWITCH:
	OUTSTR	YOCTXT(XLOW)
	OUTCHR	[" "]
	SETZ	X2,
	SETON	SWSWERR
	BRANCH	OCINTS		;USE INLINE PARAM FROM OCINSE CALL
	EPROC
	SUBTTL	GETSYSBUFF

COMMENT ;

PURPOSE:	TO ALLOCATE A BUFFER AREA FOR SYSIN AND SYSOUT.
		NUMBER OF BUFFERS AND BUFFER SIZE IS TAKEN
		FIRST FROM THE LOCAL B-SWITCH, OR, IF NOT
		DEFINED, FROM THE GLOBAL B-SWITCH, OR, IF STILL
		NOT DEFINED, FROM DEFAULT OBTAINED WITH THE
		DEVSIZ UUO.
ENTRY:		OCINGS
INPUT ARGUMENT:	XRAC POINTS TO FILE OBJECT
		X0 POINTS TO BUFFER RING HEADER
OUTPUT ARGUMENTS:
		X1 POINTS TO BUFFER AREA
		X0 POINTS TO BUFFER RING HEADER
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	GETSYSBUFF
USED ROUTINES:	GETBUFF
USED REGISTERS:	X0,X6,X7
ERROR MESSAGES:	-
;

OCINGS:
	LF	X7,ZFIDVN(XRAC)	;GET DEVICE
	LI	X6,1
	LI	X0,X6
	DEVSIZ	X0,		;FIND DEFAULT NO OF BUFFERS
				;AND DEFAULT BUFFER SIZE
	 NOP			;Ignore error return
	LF	X7,ZFIBUF(XRAC)	;LOCALLY DEFINED NO OF BUFFERS
	HRRZ	X6,X0		;X6:=DEFAULT BUFFER SIZE
	IF	;BUFFERS NOT DECLARED IN IOSPEC
		CAIN	X7,0
		SKIPE	X7,YOCBFN(XLOW)
		GOTO	FALSE
	THEN	HLRZ	X7,X0		;X7:=DEFAULT NO OF BUFFERS
	ELSE
		IF	;BUFFER SIZE IN IOSPEC
			CAIG	X7,^D32
			GOTO	FALSE
		THEN	L	X6,X7	;X6:=DEFINED BUFFER SIZE
			HLRZ	X7,X0	;AND X7:=DEFAULT NO OF BUFFERS
		FI
	FI
	SF	X7,ZFIBUF(XRAC)
	SF	X6,ZFIBFS(XRAC)	;SAVE VALUES IN FILE OBJECT
	EXCH	XCB,XRAC
	GETBUFF			;NOW GET A BUFFER
	EXCH	XCB,XRAC
	LI	X0,1(X1)	;X0:=POINTER TO BUFFER RING HEADER
	RET
	SUBTTL	FINDLOGICAL

COMMENT ;

PURPOSE:	TO DEFINE THE LOGICAL NAME IN A FILE SPEC
		THE FOLLOWING RULES ARE APPLIED:

		SPECIFICATION:		LOGICAL NAME WILL BE:
		LOG [<DIR>]FIL.EXT	LOG
		[DEV:][<DIR>]FIL.EXT	FIL
		DEV:			DEV

		AT LEAST DEVICE OR FILE NAME MUST THUS BE
		PRESENT WHEN LOGICAL NAME IS OMITTED.
ENTRY:		.OCINJ
INPUT ARGUMENT:
		X6 POINTS TO THE BEGINNING OF FILE SPEC
		FILE SPEC IN YOCBUF.
OUTPUT ARGUMENT:
		YOCPNT POINTS TO BEGINNING OF PART FOLLOWING
		LOGICAL NAME
		XNAME CONTAINS LOGICAL NAME
		XBYTE CONTAINS FOUND DELIMITER
		X0 = -1 IF ERROR FOUND
		X0 =  1 IF DELIMITER IS CARRIAGE RETURN
		X0 =  0 OTHERWISE
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	FINDLOGICAL
USED ROUTINES:	GETREST, GETNAME
USED REGISTERS:	X0,X1,XBYTE
ERROR MESSAGES:	-
;


.OCINJ:	PROC
	GETREST
	edit(225)
	IF	;[225] NO NAME YET FOUND
		JUMPN	XNAME,FALSE
	THEN	;POSSIBLE ERROR
		IFN QDEC20,<
		IF	;THERE IS A DIRECTORY NAME
			CAIE	XBYTE,74
			GOTO	FALSE
		THEN	;SCAN PAST IT
L1():!
			STACK	X2
			SETZ	X2,	;Want no copy, just scan
			NAMECOPY
			  GOTO	[ILDB	XBYTE,YOCPNT(XLOW)
				RET]
			UNSTK	X2
			IF	;WE NOW HAVE RIGHT BROKET
				CAIE	XBYTE,76
				GOTO	FALSE
			THEN	;DIRECTORY NAME WAS SCANNED ALLRIGHT
				GETNAME	;THIS SHOULD BE IT
				JUMPN	XNAME,L2
		FI	FI
		>
		SETO
		RETURN
	FI
L2():!	IF	;DELIMITER IS NOT SPACE
		CAIN	XBYTE," "
		GOTO	FALSE
	THEN	;CHECK FOR POSSIBLE DELIMITERS
		IF	;COLON
			CAIE	XBYTE,":"
			GOTO	FALSE
		THEN	;DEVICE, TRY NEXT
			L	X1,XNAME
			GETNAME
			IF	;NO NAME FOUND
				JUMPN	XNAME,FALSE
			THEN
				IFN QDEC20,<;CHECK FOR DIRECTORY
				CAIN	XBYTE,74
				 GOTO	L1	>
				L	XNAME,X1
		FI	FI
		SETZ	XBYTE,
		ST	X6,YOCPNT(XLOW)
	FI
	SETZ	;OK RETURN
	RETURN
	EPROC
	SUBTTL	MOVESPEC

	edit(225)
COMMENT ;	[225] SEVERAL CHANGES: SQUEEZE BLANKS ETC

PURPOSE:	TO MOVE A LINE FROM THE INPUT BUFFER TO THE INTERNAL BUFFER
ENTRY:		.OCIN5
INPUT ARGUMENTS:
		XBUF POINTS TO THE CURRENT BUFFER POINTER
OUTPUT ARGUMENTS:
		YOCPNT POINTS TO THE FIRST BYTE IN YOCBUF.
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	MOVESPEC
USED ROUTINES:	READSPEC, SPECCOPY
USED REGISTERS:
		XBYTE,XBUF
ERROR MESSAGES:	-
;

.OCIN5:	PROC
	SETON	SWGC
	SPECCOPY
	  GOTO	[SOSGE	1(XBUF)
		READSPEC
		ILDB	XBYTE,(XBUF)
		RET	]	;COROUTINE TO GET ONE CHARACTER
	RETURN
	EPROC
	SUBTTL	SPECCOPY	[225]

COMMENT;

PURPOSE:	COPIES A SPECIFICATION CHARACTER BY CHARACTER,
		EDITING OUT MULTIPLE SPACES, WHICH ARE 
		REPLACED BY ONE SPACE (NONE AT THE END).

INPUT:		A CHARACTER AT A TIME IS DELIVERED BY THE
		COROUTINE WHOSE ADDRESS FOLLOWS THE PUSHJ.

CALL:		SPECCOPY
		  GOTO	COROUTINE

ENTRY:		.OCINZ

RETURN:		SKIP PAST COROUTINE ADDRESS

OUTPUT:		A FILE SPECIFICATION LINE (PRESUMABLY), FINISHED
		BY CR-LF-NULL, SUITABLE AS ASCIZ STRING, AND
		CONTAINING NO MULTIPLE SPACES.
		THE LINE IS PLACED IN YOCBUF(XLOW).

;

QCOMCHAR=="!"	;START OF COMMENT - IGNORE REST OF LINE
IFE QDEC20,<QCOMCHAR==";">	;HAVE TO KEEP SEMICOLON?

.OCINZ:	PROC
	SAVE	<X1,X7>
	N==2	;NUMBER OF WORDS ON STACK
	L	X7,[POINT 7,YOCBUF(XLOW)]
	ST	X7,YOCPNT(XLOW)

	;NOW GET NEXT LINE FROM INPUT BUFFER:
	LI	X1,5*<YOCBUE-YOCBUF>	;BUFFER LENGTH: 5 SPARE CHARS
	LOOP	;UNTIL END OF LINE
		XEC	@-N(XPDP)	;GET A CHARACTER
		IF	;SPACE OR TAB
			CAIE	XBYTE," "
			CAIN	XBYTE,QHT
			GOTO	TRUE
			GOTO	FALSE
		THEN	;SUBSTITUTE JUST ONE SPACE FOR ANY STRING
			LOOP	; OF SPACES AND TABS
				XEC	@-N(XPDP)	;GET NEXT CHAR 
			AS	CAIE	XBYTE," "
				CAIN	XBYTE,QHT
				GOTO	TRUE
			SA
			STACK	XBYTE
			LI	XBYTE," "
			SOS	X1
			IDPB	XBYTE,X7
			UNSTK	XBYTE
		FI
		IF	;COMMENT
			CAIE	XBYTE,QCOMCHAR
			GOTO	FALSE
		THEN	;FLUSH REST OF LINE
			LOOP
				XEC	@-N(XPDP)
				CAIE	XBYTE,QLF
				CAIN	XBYTE,QALTMODE
				 GOTO	L9
			AS
				GOTO	TRUE
			SA
			GOTO	L9
		FI
		CAIE	XBYTE,QLF
		CAIN	XBYTE,QALTMODE
		 GOTO	L9
		JUMPE	XBYTE,L9
	AS
		CAIN	XBYTE,QCR
		GOTO	TRUE
		IDPB	XBYTE,X7
		SOJG	X1,TRUE
	SA
L9():!	LDB	XBYTE,X7	;LAST BYTE COPIED
	IF	;SPACE WAS THE LAST CHAR
		CAIN	XBYTE," "
		 CAMN	X7,YOCPNT(XLOW)	;AND ANYTHING COPIED
		  GOTO	FALSE
	THEN	;REPLACE SPACE WITH CR
		LI	XBYTE,QCR
		DPB	XBYTE,X7
	ELSE	;ADD CR
		LI	XBYTE,QCR
		IDPB	XBYTE,X7
	FI
	LI	XBYTE,QLF
	IDPB	XBYTE,X7
	LI	XBYTE,0
	IDPB	XBYTE,X7
	AOS	-N(XPDP)	;SKIP RETURN
	RETURN
	EPROC
	SUBTTL	.OCTI	(initialize traps etc)
; Purpose
; -------
; To enable and prepare for handling of traps and UUO's.

; Function
; --------
; Set up location .JBAPR with the address of OCTR,  then issue  an
; APRENB  UUO  specifying  the  following  conditions (see MONITOR
; CALLS 3.1.3):

;	AP.REN	;Repetitive enable
;	AP.ILM	;Illegal memory reference
;	AP.NXM	;Non-existent memory (detects NONE)
;	AP.FOV	;Floating-point overflow
;	AP.AOV	;Arithmetic overflow

; Other traps may be  treated  in  later  versions.   At  present,
; .JBINT  will  not  be initialized to catch interrupts, since the
; monitor messages should be sufficient and REENTER can be used to
; start  SIMDDT.   Set  up  .JB41 to contain  a  "PUSHJ XPDP,OCUU"
; instruction.   OCUU will take care of user UUO's used  e  g  for
; error messages.

.OCTI:	PROC
	LI	X1,OCTR
	ST	X1,.JBAPR
	LI	X1,AP.ILM!AP.NXM!AP.FOV!AP.AOV!AP.REN
	JRSTF	@[004000,,.+1]	;Clear user flags (retain user in-out if enabled)
	APRENB	X1,

	;Set up for UUO handling

	L	[PUSHJ	XPDP,OCUU]
	ST	.JB41
	RETURN
	EPROC
	SUBTTL	OUTENTER

COMMENT ;

PURPOSE:	THIS SUBROUTINE ENTERS AN OUTFILE OR A PRINTFILE.
		IN APPEND MODE LOOKUP IS TRIED FIRST.
		SHOULD LOOKUP FAIL,  THE FILE IS ENTERED AND CLOSED,
		AND	 LOOKUP IS TRIED AGAIN. WHEN LOOKUP
		SUCCEEDS THE FILE IS ENTERED AND USETI -1 IS PERFORMED.
ENTRY:		.OCINI
INPUT ARGUMENT:
		XCB POINTS TO THE FILE OBJECT.
OUTPUT ARGUMENT:	-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	OUTENTER
USED REGISTER:	X0
USED SUBROUTINES:
		FILELOOKUP AND FILEENTER
ERROR MESSAGE:	-
;

.OCINI:	PROC
	IF	;APPEND MODE
		IFOFF	ZFIAPP(XCB)
		GOTO	FALSE
L1():!	THEN	IF	FILELOOKUP
			GOTO	FALSE
		THEN	;ERROR RETURN!
			FILEENTER	;ENTER THE FILE
			 NOP		;IGNORE  ERROR RETURN
					edit(67)
			JUMPN	L7	;[61] If normal case,
					;THE FILE IS ALWAYS CLOSED
					;AND LOOKUP TRIED AGAIN
			HLLZ	X0,OFFSET(ZFICHN)(XCB)
			TLO	X0,(CLOSE)
			XCT	X0	;IMMEDIATE CLOSE
			GOTO	L1	
		FI
		;HERE WHEN LOOKUP OK!
		FILEENTER
		 SKIPA			;OK RETURN
		  GOTO	L1		;ERROR RETURN, DON'T GIVE UP, TRY LOOKUP AGAIN
		JUMPN	L7		;[61]
		HLLO	X0,OFFSET(ZFICHN)(XCB)
		TLO	X0,(USETI)
		XCT	X0		;USETI -1
		SETZ			;[61] Ok return
	ELSE
		FILEENTER
	FI
L7():!	RETURN
	EPROC
	SUBTTL	OUTIMAGE/BREAKOUTIMAGE

COMMENT ;

PURPOSE:	TO PRINT A STRING STORED IN FIVEBIT ON TTY
		THE FIVE BIT CODE IS ASCII CODE - 100 (OCTAL)
		FOR UPPER CASE LETTERS
		AND	0  FOR SPACE
			33 FOR DOT
			34 FOR QUESTION MARK
			35 FOR COLON
			36 FOR CASE SHIFT [224]
			37 DENOTES END OF MESSAGE.
ENTRIES:	OCINTS (OUTIMAGE) PRINTS THE STRING AND
		APPENDS CR-LF AT THE END
		OCINTL (BREAKOUTIMAGE) PRINTS THE STRING
		WITHOUT TRAILING CR-LF
INPUT ARGUMENT:
		THE WORD AFTER THE CALL CONTAINS:
		- A NOP IN BITS 0-9
		- THE INDEX REGISTER VALUE IN BITS 11-17
		- THE BYTE POINTER TO THE MESSAGE IN YOCMES IN BITS 18-35
OUTPUT ARGUMENT:	-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	OUTIMAGE <ERROR NO>
		WHICH EXPANDS TO:	EXEC	.OCINTS
					EXP	NOP+<QIND'<ERR NO>>B26+<QM'<ERR NO>>
		OR
		BREAKOUTIMAGE <ERROR NO>
		WHICH EXPANDS TO:	EXEC	.OCINTL
					EXP	NOP+<QIND'<ERR NO>>B26+<QM'<ERR NO>>
USED ROUTINES:	-
USED REGISTERS:	X0, X1, X2, X3, X4 [224]
ERROR MESSAGES:	-
;

OCINTL:	PROC
	SETOFF	SWCRLF		;FLAG NO CR-LF
	GOTO	OCINT1
OCINTS:
	SETON	SWCRLF		;FLAG CR-LF
OCINT1:
	edit(224)
	SAVE	<X0,X1,X2,X3,X4>;[224]
	N==5	;[224] QUANTITIES ON THE STACK
	SETZ	X3,	;[224] NO INITIAL CASE SHIFT
	LI	X0,-N(XPDP)
	L	X0,@X0
	CLEARO		;CLEAR CONTROL-O
	HRRZ	X4,@X0		;PICK UP INDEX VALUE
	LSH	X4,-^D9		;REMOVE BYTE POINTER
	HRRZ	X2,@X0		;CREATE BYTE POINTER
	LSH	X2,^D30
	TLO	X2,0500+X4	;[224] LENGTH AND INDEX
	HRRI	X2,YOCMES

	LOOP	;[224] TO END OF MESSAGE
		ILDB	X0,X2
		IF	;[224] CASE SHIFT
			CAIE	X0,36
			GOTO	FALSE
		THEN	;CHANGE X3: 40 TO 0 OR VICE VERSA
			TRC	X3,40
			ILDB	X0,X2
		FI
		CAIN	X0,37
		GOTO	FALSE
		;CONVERT TO ASCII AND PRINT
		IF	;LETTER
			CAIL	X0,1
			CAILE	X0,32
			GOTO	FALSE
		THEN	ADDI	X0,100(X3);[224]
		ELSE	;SPECIAL CHARACTER
			CAIN	X0,0
			LI	X0," "
			CAIN	X0,33
			LI	X0,"."
			CAIN	X0,34
			LI	X0,"?"
			CAIN	X0,35
			LI	X0,":"
		FI
		CAIN	X0,"?"
		OUTSTR	[ASCIZ/
/]
		OUTCHR	X0	;OUTPUT CONVERTED BYTE
	AS
		GOTO	TRUE
	SA

	IFON	SWCRLF		;PRINT CR-LF IF WANTED
	 OUTSTR	[ASCIZ/
/]
	RETURN
	EPROC
	SUBTTL	READSPEC

COMMENT ;

PURPOSE:	TO READ THE NEXT BUFFER FROM THE CURRENT SPECIFICATION FILE.
		IF END OF FILE OCCURS READSPEC INVESTIGATES WHICH FILE IS
		EXHAUSTED AND WHEN.
		IF IT IS EXHAUSTED IN THE MIDDLE OF THE CREATION
		OF AN IOSPEC ENTRY THEN A WARNING IS WRITTEN ON TTY.
		THIS WILL HAPPEN IF THE LAST FILE SPECIFICATION
		IS NOT ENDED WITH CARRIAGE RETURN.
		IF END OF FILE OCCURS ON AN INDIRECT FILE
		A SWITCH IS MADE BACK TO THE OLD SPECIFICATION FILE.
ENTRY:		OCINRE
INPUT ARGUMENTS:
		SWTTY, SWERR, SWIND AND SWSYSR.
		SWGC IS TRUE IF READSPEC WAS CALLED FROM MOVESPEC
OUTPUT ARGUMENTS:
		-
NORMAL EXITS:	BRANCH TO READTTY IF SPECIFICATION FILE COMES FROM TTY.
		RETURN IF NOT END OF FILE.
		BRANCH TO OCIN5 IF END OF FILE ON INDIRECT
		SPECIFICATION FILE.
		BRANCH TO OCINEN IF END OF FILE ON SPECIFICATION FILE.
ERROR EXIT:	TO MONITOR WITH EXIT IF TRANSFER FAILURE OCCURS
		DURING THE READING OF THE SPECIFICATION FILE FROM DISK.
CALL FORMAT:	READSPEC
USED ROUTINES:
		PRINTFILE, OUTIMAGE, FREEBUFF, PRINTSPEC
USED REGISTERS:	X0, X1, X2
ERROR MESSAGES:	?READ ERROR ON: <...>
		?CLOSE ERROR ON: <...>
;

OCINRE:
	IFON	SWTTY
	 BRANCH	.OCIN4		;ENTER READTTY IF INPUT FROM TTY
	IFON	SWERR
	 BRANCH	.OCIN4		;OR IF CORRECTION IS TO BE READ
	IF	;INDIRECT FILE
		IFOFF	SWIND
		GOTO	FALSE
	THEN	OPZ	X0,(IN 2,)
		OPZ	X1,(STATZ 2,)
		LI	X2,YOCINF(XLOW)
	ELSE
		OPZ	X0,(IN 1,)
		OP	X1,(STATZ 1,)
		LI	X2,OFFSET(ZSWFIL)(XSPEC)
	FI
	HRRI	X1,740000
	XCT	X0		;READ NEXT BUFFER
	RETURN			;IF OK

	;NOW INVESTIGATE WHY IN SKIPPED
	IF	XCT	X1
		 GOTO	TRUE
		GOTO	FALSE		;END OF FILE HERE!!
	THEN	;READ ERROR
		BREAKOUTIMAGE 32	;READ ERROR ON:
		LI	X2,OFFSET(ZSWFIL)(XSPEC)
		PRINTFILE
		EXIT
	FI
	edit(261)	;[261] Restore stack for return to program
	HRRZ	XPDP
	SUBI	YOBJRT(XLOW)
	HRL
	SUB	XPDP,
	IF	;INDIRECT FILE
		IFOFF	SWIND
		GOTO	FALSE
	THEN	;CLOSE INDIRECT FILE
		IFON	SWSYSI
		SETON	SWSYSE
		GOTO	OCIN5
	FI
	IF	;END OF FILE ON SYSIN
		IFOFF 	SWSYSR
		GOTO	FALSE
	THEN	SETON	SWSYSE
		BRANCH	OCINEN
	FI
	IFON	SWTTY
	 BRANCH	OCINEN
	CLOSE	1,
	IF	STATZ	1,740000
		GOTO	TRUE
		GOTO	FALSE
	THEN	;ERROR
		BREAKOUTIMAGE 33	;CLOSE ERROR ON:
		PRINTSPEC
		EXIT
	FI
	RELEAS	1,0
	LI	X1,-2(XBUF)	;ADDRESS TO BUFFER AREA
	FREEBUFF		;RELEASE BUFFER
	BRANCH	OCINEN
	SUBTTL	READTTY

COMMENT ;

PURPOSE:	TO READ AN INPUT BUFFER FROM TTY
ENTRY:		.OCIN4
INPUT ARGUMENTS:	-
OUTPUT ARGUMENTS:	-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	READTTY
		THIS ROUTINE IS CALLED WITH GOTO .OCIN4
		FROM READSPEC, WHICH MEANS THAT READTTY
		WILL RETURN TO THE INSTRUCTION FOLLOWING
		THE READSPEC CALL.
USED REGISTERS:	-
USED ROUTINE:	OUTIMAGE
ERROR MESSAGE:	?INPUT ERROR. TRY AGAIN
;

.OCIN4:
	edit(225)
	OUTSTR	[ASCIZ/*/]	;[225]
	IN	0,		;READ A LINE
	 RET
	OUTIMAGE 34		;TTY END OF FILE OR TTY INPUT ERROR [1C]
				edit(61)
	EXIT	1,		;[1C],[61] Temporary exit
	EXIT			;[61] Exit finally if continued
	SUBTTL	SETWIDTH

COMMENT ;
	PURPOSE:	TO DETERMINE THE LINE WIDTH FOR A TERMINAL
		USED FOR SYSIN OR SYSOUT AND GET THE IMAGE.
INPUT ARGUMENT:	XCB POINTS TO FILE OBJECT
OUTPUT ARGUMENT:
		XWAC1-XWAC2 CONTAINS TEXT REF TO IMAGE
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	SETWIDTH
USED ROUTINE:	.TXBL
USED REGISTERS:	X0,X1,X2,XWAC1
ERROR MESSAGE:	-
;

OCINWI:
	IF	;DEVICE IS A TTY
		IFOFF	ZFITTY(XCB)
		GOTO	FALSE
	THEN	;GET CARRIAGE WIDTH WITH TRMOP
		L	X2,YJOBNO(XLOW)	;LOAD JOB NUMBER
		TRMNO.	X2,		;GET UNIVERSAL I/O INDEX
		 GOTO	FALSE		;USE DEFAULT ON FAILURE!
		L	X0,[XWD	2,1]	;ARGUMENTS IN X1-X2
		LI	X1,1012		;READ CODE FOR CARRIAGE WIDTH
		TRMOP.	X0,
		 SETZ	X0,		;Failed
					edit(305)
		JUMPE	X0,FALSE	;[305] Default value on failure
		L	XWAC1,X0
	FI
	EXEC	.TXBL
	 Z
	RETURN
	SUBTTL	TTYSPEC	[225]

	edit(225)
COMMENT; THIS CAN BE STREAMLINED
;

.OCINY:	PROC
	READTTY
	LI	XBUF,YLOW+2(XLOW)	;BUFFER BYTE PTR ADDR
	L	XBYTE,(XBUF)		;CHECK FIRST BYTE
	ILDB	XBYTE,XBYTE
	IF	;FIRST CHARACTER WAS ALTMODE
		CAIE	XBYTE,QALTMODE
		GOTO	FALSE
	THEN	;ENTER SIMDDT, ALLOW CONTINUATION
		edit(261)
		SKIPE	YDSLOAD(XLOW)	;[261] Must not call SIMDDT too early
		 OCERC	QDSCON,2,SIMDDT entered after file specification error
		RET	;IF CONTINUED, NON-SKIP RETURN
	FI
	SPECCOPY
	  GOTO	[SOSGE	YLOW+3(XLOW)
		READTTY
		ILDB	XBYTE,YLOW+2(XLOW)
		RET	]	;GETS NEXT BYTE
	AOS	(XPDP)
	RETURN
	EPROC
	SUBTTL	TYPESWITCH
	edit(225)
TOPS10,<;[225]

COMMENT ;

PURPOSE:	TO TYPE THE CHARACTERS IN X0 
		FOLLOWED BY A SPACE.
ENTRY:		OCINTW
INPUT ARGUMENT:	NAME IN X0
OUTPUT ARGUMENT:	-
NORMAL EXIT:	RETURN
ERROR EXIT:	-
CALL FORMAT:	TYPESWITCH
USED ROUTINES:	-
USED REGISTERS:	X0-X1
ERROR MESSAGES:	-
;

OCINTW:	PROC
	SAVE	<X0,X1>
	LOOP
		SETZ	X1,
		ROTC	X0,7
		OUTCHR	X1
	AS
		JUMPN	X0,TRUE
	SA
	OUTCHR	[" "]
	RETURN
	EPROC
>

TOPS20,<;[225]

OCINTW:	PROC	;Types the string pointed to
	; by X2 (TBLUK format), followed by space
	HLRO	X1,X2
	PSOUT
	LI	X1," "
	PBOUT
	RETURN
	EPROC
>
	SUBTTL	OCIN MAIN PROGRAM

	SETLOW		;LOW SEGMENT POINTER IN STANDARD XLOW REGISTER (XIAC) ON ENTRY
.OCIN:	BEGIN
	ST	X2,YXACAD(XLOW)
	ST	X3,YDSZLA(XLOW)	;LINE NO TABLE ADDRESS
	ST	X4,YOCGS(XLOW)	;Address of GETSEG routine ;[1C]
	HRRZ	X1,.JBHRL	;FIND OUT HIGH SEGM SIZE
	SUBI	X1,377776
	ST	X1,YSAHSZ(XLOW)
	LI	X1,YLOW(XLOW)	;ADDRESS OF DYNAMIC AREA
	AOS	X3,.JBREL
	HRRM	X3,.JBFF
	ST	X1,YSABOT(XLOW)
	ST	X1,YSATOP(XLOW)
	SUBI	X3,QSALIM
	ST	X3,YSALIM(XLOW)
	LI	QIOLP
	ST	YIOLP(XLOW)
	LI	"E"
	ST	YTXLT(XLOW)
	;;; ALSO GET JOB NUMBER, TIME, ETC ;;;
	edit(225)
	TOPS20,<GJINF>		;[225]
	TOPS10,<PJOB X3,>	;[225] JOB NUMBER
	ST	X3,YJOBNO(XLOW)
	MSTIME	X1,		;GET CURRENT TIME OF DAY
	ST	X1,YDAYTM(XLOW)	;SAVE IT
	SETZ X1,	;GET RUNTIME SINCE LOGIN
	RUNTIM	X1,
	ST	X1,YRUNTM(XLOW)	;SAVE IT
	; SET UP RUN TIME STACK ;
	HRRI	XPDP,YOBJRT-1(XLOW)
	HRLI	XPDP,-QPDLEN
	Q==YOBJRT-YPDL
	IFG Q,<
	LI	X3,(XLOW)
	HRLI	X3,-Q
	LI	.PDERR
	LOOP
		ST	YPDL(X3)
	AS
		INCR	X3,TRUE
	SA	>
	;Fake PUSHJ from main program to .OCIN
				edit(242)
	LI	1(XSPEC)	;[242] ;Account for inline parameter
	HRRZ	XSPEC,(XSPEC)	;Retrieve inline parameter (runswitches address)
	STACK
	edit(225)
	TOPS20,<XEC V1BINI##>	;[225] Make STPPN% etc work
	EXEC	.OCTI		;SET UP TRAP AND UUO HANDLER

	;NOW ALLOCATE BUFFERS FOR TTY AND OPEN TTY
	;XBASE NOW POINTS TO AVAILABLE BUFFER SPACE

	ZEROSW			;RESET ALL SWITCHES
	LI	XBASE,YLOW(XLOW);ADDRESS TO FIRST FREE LOCATION
	ST	XBASE,YOCBST(XLOW)
	SETOM	YIOSPC(XLOW)	;IOSPEC IS EMPTY INITIALLY
	HRROI	X0,-124
	MOVSM	X0,(XBASE)	;INITIAL LINK AND NEG LENGTH
	HRRI	X3,1(XBASE)	;SAVE ADDRESS TO INPUT BUFFER HEADER
				;FOR LATER USE BY OPEN
	LI	X7,2		;NUMBER OF BUFFERS
	LI	X6,23		;STANDARD BUFFER SIZE FOR TTY
	GETBUFF			;THE INPUT BUFFER
	LFE	X0,ZBHLEN(X1)	;FLAG OCCUPIED
	MOVN	X0,X0
	SF	X0,ZBHLEN(X1)
	LI	X2,(X1)		;SAVE BUFFER AREA ADDRESS
	ADDI	XBASE,52
	HRLI	X3,1(XBASE)	;SAVE ADDRESS TO OUTPUT BUFFER HEADER
				;FOR LATER USE BY OPEN
	GETBUFF			;THE OUTPUT BUFFER
	LFE	X0,ZBHLEN(X1)
	MOVN	X0,X0
	SF	X0,ZBHLEN(X1)	;FLAG BUFFER OCCUPIED
	ADDI	XBASE,52
	LI	X5,1		;SET UP OPEN ARGUMENTS
	MOVSI	X6,'TTY'	;NOTE THAT X7 NOW CONTAINS XWD OBUF,IBUF
	L	X7,X3
	OPEN	0,X5
	HALT			;DEAD END ON OPEN FAILURE
	LI	X7,2
	LI	X6,23
	LINKBUFF
	LI	X1,(X2)
	LINKBUFF
	ST	XBASE,YIOBUF(XLOW)
	JUMPE	XSPEC,OCINNS
	SUBTTL	OCIN MAIN PROGRAM: SPECIFICATION FILE PROCESSING

COMMENT /

The following algorithm is used to process specification files:

BEGIN
	expand buffer area;
	IF device is TTY THEN
	BEGIN	flag TTY; print text on TTY END
	ELSE
	BEGIN	open channel 1 for specification file; 
		set up buffers for specification file;
		lookup specification file
	END;
loop:	read next line from spec file;
	IF first char = carriage return THEN
	BEGIN	IF indirect spec file THEN
		BEGIN	IF not SYSIN THEN
			BEGIN	close spec file on channel 2;
				release buffers
			END;
			switch to direct spec file; GOTO loop
		END;
		IF TTY or SYSIN THEN GOTO over;
		close spec file on channel 1;
		release buffers; GOTO over
	END carriage return case;
	IF first char = slash THEN
	BEGIN	FIXSWITCH;
		IF error or delimiter is not space THEN GOTO loop
	END;
	IF next char is "@" THEN
	BEGIN	COMMENT indirect file spec;
		IF current is indirect THEN BEGIN error; GOTO loop END;
		IF previous ind spec file from SYSIN THEN BEGIN error; GOTO loop END;
		get buffers for indirect spec file;
		open channel 2 for indirect spec file;
		lookup indirect spec file;
		flag indirect spec file being read; GOTO loop
	END of indirect case;
	COMMENT file definition found;
	get logical name;
	FINDLOGICAL; FINDFILE;
	IF already defined logical name THEN BEGIN error; GOTO loop END;
	process file definition;
	set up IOSPEC entry; GOTO loop;
over:	scan IOSPEC and save references to SYSIN and SYSOUT
END of spec file processing;

/
	;EXPAND BUFFER AREA FOR SPECIFICATION FILES
	QBFLEN==2*<2*<QBUFS>+4>
	HRROI	X0,-QBFLEN
	MOVSM	X0,(XBASE)	;NEW LENGTH AND LINK -1
	LI	X1,-52(XBASE)	;ADDRESS TO LAST BUFFER
	SF	XBASE,ZBHLNK(X1);UPDATE OLD LINK
	ADDI	XBASE,QBFLEN
	;INVESTIGATE THE RUNSWITCH BLOCK ZSW:
	LF	X0,ZSWDEV(XSPEC)
	IF	;DEVICE IS TTY
		CAME	X0,[SIXBIT/TTY/]
		GOTO	FALSE
	THEN
L1():!		SETON	SWTTY		;FLAG INPUT FROM TTY
		OUTIMAGE 36		;ENTER FILE DEFINITIONS
		LI	XBUF,YLOW+2(XLOW);SET UP ADDRESS TO BUFFER POINTER
		NEXTBUFF
	FI

	;MUST BE DEVICE DSK
	LF	X0,ZSWFIL(XSPEC)
	IF	;IT IS SYSIN
		CAME	X0,[SIXBIT/SYSIN/]
		GOTO	FALSE
	THEN	;CHECK IF SYSIN WAS ASSIGNED TO TTY
		SETON	SWSYSR		;FLAG SYSIN READ
		DEVCHR	X0,
		IF	;TTY
			TLNN	X0,DV.TTY
			GOTO	FALSE
		THEN	SETON	SWSYST		;FLAG SYSIN READ FROM TTY
			GOTO	L1
		FI
	FI

	;MUST OPEN CHANNEL 1
	LI	X7,2
	LI	X6,QBUFS
	GETBUFF			;GET A BUFFER AREA FOR THE SPECIFICATION FILE
	LI	X2,1		;SET UP OPEN ARGUMENTS
	LF	X3,ZSWDEV(XSPEC)
	HLRZ	X0,X3
	IF	;NOT DSK
		CAIN	X0,'DSK'
		GOTO	FALSE
	THEN	DEVCHR	X3,
		IF	;Not disk device
			TLNE	X3,DV.DSK
			GOTO	FALSE
		THEN	;Make it
			OUTIMAGE 47	;ONLY DSK ALLOWED FOR SPEC FILE
			MOVSI	X3,'DSK'
		ELSE
			LF	X3,ZSWDEV(XSPEC)
		FI
	FI
	LI	X4,1(X1)	;ADDRESS TO BUFFER HEADER
	OPEN	1,X2
	 GOTO	[OUTIMAGE 11	;CANNOT OPEN DISK
		 EXIT]
	LINKBUFF

	;NOW LOOKUP THE SPECIFICATION FILE
L2():!
					edit(177)
	HRLI	OFFSET(ZSWFIL)(XSPEC)	;[177] Copy lookup block by BLT
	q==OFFSET(ZBUDAT)+1
	HRRI	q(X1)	;[177] Use buffer for lookup block
	BLT	q+3(X1)	;[177] Four words copied
	edit(225)
	IFN QDEC20,<;[225] MAY HAVE DIRECTORY STRING PTR
	L	X2,Q+3(X1)	;PPN OR STRING PTR
	IF	;String ptr
		JUMPE	X2,FALSE
		HLRZ	X2
		GOTO	FALSE
	THEN	;Translate str:<directory> to PPN
		EXCH	X1
		MOVSI	X1,(RC%EMO)	;Exact match only
		RCDIR
		TLNE	X1,(RC%NOM)
		 GOTO	 [EXCH X1
			 GOTO L4()]	;[261] Error
		L	X1,X3		;Directory
		STPPN%
		 ERJMP	[EXCH X1
			GOTO L4()]	;[261]
		EXCH	X1
		ST	X2,Q+3(X1)
	FI
	>
	IF	LOOKUP	1,Q(X1)	;[177] Succeeds
		GOTO	FALSE
	THEN	LFE	X0,ZBHLEN(X1)	;FLAG THIS BUFFER OCCUPIED
		MOVN	X0,X0
		SF	X0,ZBHLEN(X1)
		LI	XBUF,2(X1)	;COMPUTE ADDRESS TO BUFFER POINTER
		IFOFF	SWSYSR
		NEXTBUFF
		HRLZM	XBUF,YSYSIN(XLOW);SAVE ADDRESS TO SYSIN BUFFER
		AOS	YSYSIN(XLOW)	;AND THE CHANNEL
		NEXTBUFF
	FI

	;LOOKUP FAILED!
L4():!	BREAKOUTIMAGE 37	;FILE:
	LI	X2,OFFSET(ZSWFIL)(XSPEC)
	PRINTFILE
	OUTIMAGE 40		;NOT FOUND
L3():!
	OUTIMAGE 41		;ENTER NEW FILE SPEC
	TTYSPEC		;[225]
	 GOTO	L3	;[225]
	L	X0,YOCPNT(XLOW)
	GETBYTE
	CAIE	XBYTE,"/"	;IGNORE LEADING SLASH IF ANY
	 ST	X0,YOCPNT(XLOW)
	GETSPEC			;DECODE NEW FILE SPEC
	 GOTO	L3		;IF ERROR!
	SKIPE	OFFSET(ZFDSFD)(XLOW)
	 OUTIMAGE 42		;WARNING: SFD IGNORED
	CAIN	XBYTE,"/"
	 OUTIMAGE 43		;WARNING: SWITCHES IGNORED
	IF	;NOT DSK
		SKIPE	X2,OFFSET(ZFDDEV)(XLOW)
		 CAMN	X2,[SIXBIT/DSK/]
		  GOTO	FALSE
		L	X2	;[177]
		DEVCHR
		 edit(302) ;[302] There is no error ret from DEVCHR
		TLNE	DV.DSK
		 GOTO	FALSE
	THEN	;ERROR
		OUTIMAGE 44		;ONLY DSK ALLOWED
		GOTO	L3
	FI
	HRLI	X0,OFFSET(ZFDFIL)(XLOW)
				edit(261)
	GOTO	1+L2		;[261] Try again

OCIN2:		;ENTRY NEXTSPEC
	IFON	SWTTY
	 NEXTBUFF
	IF	;CORRECTION WAS READ BEFORE
		IFOFF	SWERR
		GOTO	FALSE
	THEN	IF	;HELP BEFORE
			IFOFF	SWHLP
			GOTO	FALSE
		THEN	SETOFF	SWHLP
			NEXTLINE
		FI
		SETOFF	SWERR
		L	XBUF,YOCBF2(XLOW)	;LOAD OLD BUFFER POINTER
	FI
	NEXTLINE

OCIN3:		;ENTRY NEXTBUFF
	SETOFF	SWGC		;FLAG CALL FROM NEXTBUFF TO READSPEC
	edit(41)	;[41]:
	IF	;TTY input or error recovery
		IFON	SWTTY
		GOTO	TRUE
		IFOFF	SWERR
		GOTO	FALSE
		edit(225)
	THEN	;[225] USE TTYSPEC
		TTYSPEC
		 ERROR		;repeat error procedure
				;if return from SIMDDT after escape
		GOTO	OCIN4A	;MOVESPEC DONE BY TTYSPEC
	ELSE
		READSPEC
	FI
	;End of [41]

OCIN4:		;ENTRY NEXTLINE
	MOVESPEC
OCIN4A:	L	X6,YOCPNT(XLOW)
	GETBYTE			;GET FIRST BYTE OF THE LINE
	IF	;CR IN FIRST POSITION
		CAIE	XBYTE,QCR
		GOTO	FALSE
	THEN	;END OF SPECIFICATION FILE
		IF	;INDIRECT FILE
			IFOFF 	SWIND
			GOTO 	FALSE
OCIN5:		THEN	IF	;NOT SYSIN
				IFON	SWSYSI
				GOTO	FALSE
			THEN	;CLOSE INDIRECT FILE
				CLOSE	2,
				IF	STATZ	2,740000
					GOTO	TRUE
					GOTO	FALSE
				THEN	BREAKOUTIMAGE 33	;CLOSE ERROR ON
					LI	X2,YOCINF(XLOW)
					PRINTFILE
					EXIT
				FI
				RELEAS	2,0
				LI	X1,-2(XBUF)
				FREEBUFF
			FI
			L	XBUF,YOCBF1(XLOW)
			SETOFF	SWIND
			UNSTK	YOCSW+1(XLOW)
			NEXTSPEC
		FI
		;HERE IF NOT INDIRECT FILE
		IFON	SWTTY
		 BRANCH OCINEN
		IFON	SWSYSR
		 BRANCH	OCINEN

		;Close and release buffer and channel
		;if dsk file is not Sysin
		CLOSE	1,
		IF	STATZ	1,740000
			GOTO	TRUE
			GOTO	FALSE
		THEN	BREAKOUTIMAGE 33		;CLOSE ERROR ON
			LI	X2,OFFSET(ZSWFIL)(XSPEC)
			PRINTFILE
			EXIT
		FI
		RELEASE	1,
		IFON	SWERR
		 L	XBUF,YOCBF2(XLOW)
		LI	X1,-2(XBUF)
		FREEBUFF		;RELEASE BUFFER
		BRANCH OCINEN
	FI

	IF	;SLASH
		CAIE	XBYTE,"/"
		GOTO	FALSE
	THEN	;GLOBAL SWITCH
		SETON	SWGSW
		FIXSWITCH
		IF	;ERROR IN SWITCH HANDLING
			IFOFF	SWSWERR
			GOTO	FALSE
		THEN	SETOFF	SWSWERR
			ERROR
		FI	
		CAIE	XBYTE," "
		 NEXTSPEC		;IF CR
		L	X6,YOCPNT(XLOW)
	FI
	SETOFF	SWGSW

	IF	;INDIRECT FILE SPECIFICATION
		CAIE	XBYTE,"@"
		GOTO	FALSE
	THEN	;SEE IF IT IS ALLOWED
		IF	;CURRENT FILE IS INDIRECT
			IFOFF	SWIND
			GOTO	FALSE
		THEN	OUTIMAGE 45	 ;NESTED IND FILES NOT ALLOWED
			PRINTSPEC
			NEXTSPEC
		FI
		IF	;EARLIER INDIRECT FILE STILL OPEN AS SYSIN
			IFON	SWSYSR
			GOTO	TRUE
			IFOFF	SWSYSI
			GOTO	FALSE
		THEN	OUTIMAGE 46 ;IND SPEC FILE STILL OPEN AS SYSIN. SPEC IGNORED
			PRINTSPEC
			NEXTSPEC
		FI
		GETSPEC
		ERROR
		SKIPE	X0,OFFSET(ZFDSFD)(XLOW)
		OUTIMAGE 42		;WARNING: SFD IGNORED
		CAIN	XBYTE,"/"
		OUTIMAGE 43		;WARNING: SWITCHES IGNORED
		LI	X7,2
		LI	X6,QBUFS
		GETBUFF		;GET BUFFER AREA FOR INDIRECT SPECIFICATION FILE
		LI	X2,YOCINF(XLOW)
		HRLI	X2,OFFSET(ZFDFIL)(XLOW)
		BLT	X2,YOCINF+3(XLOW);MOVE FILE SPEC
		LI	X2,1		;SET UP OPEN ARGUMENTS
		IF	;DEVICE NOT DSK
			LF	X3,ZFDDEV(XLOW)
			SKIPN	X0,X3
			MOVSI	X3,'DSK'
			HLRZ	X0,X3
			CAIN	X0,'DSK'
			GOTO	FALSE
		THEN	;CHECK IF ASSIGN IS DONE
			DEVCHR	X3,
			IF	;Not DSK device
				TLNE	X3,DV.DSK
				GOTO	FALSE
			THEN	;Make it
				OUTIMAGE 47		;WARNING ONLY DSK ALLOWED
				MOVSI	X3,'DSK'
			ELSE
				LF	X3,ZFDDEV(XLOW)
			FI
		FI
		LI	X4,1(X1)
		OPEN	2,X2
		 GOTO	[OUTIMAGE 11	;CANNOT OPEN DSK
			 EXIT]
		LINKBUFF
		IF	LOOKUP	2,YOCINF(XLOW)
			GOTO	TRUE
			GOTO	FALSE
		THEN	;ERROR
			BREAKOUTIMAGE 67	;IND SPEC FILE NOT FOUND
			ERROR
		FI

		L	X0,[SIXBIT/SYSIN/]
		IF	;SYSIN
			CAME	X0,YOCINF(XLOW)
			GOTO	FALSE
		THEN	IF	;DIRECT FILE IS SYSIN
				IFOFF	SWSYSR
				GOTO	FALSE
			THEN	;ERROR
				OUTIMAGE 51	;SYSIN ALREADY READ. SPEC IGNORED
				PRINTSPEC
				NEXTSPEC
			FI
			SETON	SWSYSI
		FI
		ST	XBUF,YOCBF1(XLOW)
		LI	XBUF,2(X1)	;NEW BUFFER POINTER ADDRESS
		LF	X0,ZBHLEN(X1)
		MOVN	X0,X0
		SF	X0,ZBHLEN(X1)	;FLAG FOUND BUFFER AS OCCUPIED
		SETON 	SWIND
		SETOFF	SWERR
		STACK	YOCSW+1(XLOW)
		SETOFF	SWTTY
		IF	IFON	SWSYSR
			GOTO	FALSE
			IFOFF	SWSYSI
			NEXTSPEC
		THEN	HRLZM	XBUF,YSYSIN(XLOW);SAVE BUFFER ADDRESS
			LI	X0,2
			HRRM	X0,YSYSIN(XLOW)
			NEXTSPEC
		FI
	FI
	;HERE IF THE LINE DID NOT START WITH / OR @
	;NOW INITIALIZE THE NEW IOSPEC ENTRY
	;XBASE POINTS TO THE START OF THE NEW ENTRY

	SKIPG	YIOSPC(XLOW)
	 ADDI	XBASE,1		;Allow for ZFSLNK word 741120 /LE/
	MOVSI	X0,'DSK'
	SF	X0,ZFSDEV(XBASE)
	SETZM	OFFSET(ZFSSIZ)(XBASE)
	HRLI	OFFSET(ZFSSIZ)(XBASE)
	HRRI	OFFSET(ZFSIML)(XBASE)
	BLT	OFFSET(ZFSPRJ)(XBASE)
	
	IF	FINDLOGICAL
		JUMPGE	X0,FALSE
	THEN	;ERROR IF X0 < 0
		OUTIMAGE 52		;ILL DEL AFTER LOGICAL NAME
		ERROR
	FI
	FINDFILE
	edit(225)
	REPEAT	0,<;[225] NOT NECESSARY?
	IF	;DELIMITER WAS CR
		CAIE	XBYTE,QCR
		GOTO	FALSE
	THEN	SF	XNAME,ZFSNAM(XBASE);SET FILE = LOGICAL NAME
		SF	XNAME,ZFSFIL(XBASE)
		;LINK THIS ELEMENT
		LI	X0,QFSLNG(XBASE)
		SF	X0,ZFSLNK(XBASE)
		SKIPG	X0,YIOSPC(XLOW)	;IF FIRST ELEMENT
		 ST	XBASE,YIOSPC(XLOW)
		ADDI	XBASE,QFSLNG
		LI	X0,-1
		SF	X0,ZFSLNK(XBASE);FLAG THIS ELEMENT AS LAST
		NEXTSPEC
	FI
	>;[225]
	STACK	XNAME
	;NOW GET REST OF FILE SPECIFICATION
	GETSPEC
	 GOTO	[UNSTK
		 ERROR]
	IF	;SWITCHES
		CAIE	XBYTE,"/"
		GOTO	FALSE
	THEN	FIXSWITCH
		IF	;SWITCH ERROR
			IFOFF	SWSWERR
			GOTO	FALSE
		THEN	UNSTK
			SETOFF	SWSWERR
			ERROR
		FI
	FI

	;NOW MOVE THE FILE SPEC AND COMPLETE THIS IOSPEC ENTRY
	UNSTK	OFFSET(ZFSNAM)(XBASE)
	LF	X0,ZFDFIL(XLOW)
	SF	X0,ZFSFIL(XBASE)
	LF	X0,ZFDEXT(XLOW)
	SF	X0,ZFSEXT(XBASE)
	SKIPE	X1,OFFSET(ZFDDEV)(XLOW)
	ST	X1,OFFSET(ZFSDEV)(XBASE)
	L	X0,OFFSET(ZFDPRG)(XLOW)
	ST	X0,OFFSET(ZFSPRG)(XBASE)
	LF	X0,ZFDPT(XLOW)
	SF	X0,ZFSPT(XBASE)
	edit(225)
IFE QDEC20,<;[225]
	IF	;SUB FILE DIRECTORIES
		SKIPN	X6,OFFSET(ZFDSFD)(XLOW)
		GOTO	FALSE
	THEN	;READ THESE AND EXTEND IOSPEC ENTRY
		SETON	ZFSSUB(XBASE)
		LF	X0,ZFDPNT(XLOW)
		ST	X0,YOCPNT(XLOW)	;POINTER TO FIRST SFD
		LF	X0,ZFSADR(XBASE);MOVE PPN
		SF	X0,ZFSPPN(XBASE)
		LI	X0,OFFSET(ZFSARG)(XBASE)
		SF	X0,ZFSADR(XBASE);ADDRESS TO EXT ARG
		LOOP	;UNTIL NO MORE SFD:S
			GETNAME
			NOP	-1	;[263] No funny name here
					edit(263)
			SF	XNAME,ZFSSFD(XBASE)
			ADDI	XBASE,1
		AS	SOJG	X6,TRUE
		SA
		ZF	ZFSSFD(XBASE)	;RESET LAST SFD
		SUB	XBASE,OFFSET(ZFDSFD)(XLOW)
		LI	X0,4
		ADDM	X0,OFFSET(ZFDSFD)(XLOW)
	FI
>;[225]
	SKIPGE	X0,YIOSPC(XLOW)		;IF FIRST ELEMENT
	ST	XBASE,YIOSPC(XLOW)	;THEN UPDATE YIOSPC POINTER
	LI	X0,QFSLNG(XBASE)	;ADDRESS TO NEXT ENTRY
	ADD	X0,OFFSET(ZFDSFD)(XLOW)	;COMPENSATE FOR SFD:S
	SF	X0,ZFSLNK(XBASE)	;UPDATE XBASE
	L	XBASE,X0
	HRROI	X0,-1
	SF	X0,ZFSLNK(XBASE)	;FLAG THIS ELEMENT AS LAST
	NEXTSPEC
	SUBTTL	OCIN: SEARCH IOSPEC FOR SYSIN AND SYSOUT

	;HERE WHEN END OF SPECIFICATION FILE OCCURRED
OCINEN:
	;NOW SEARCH IOSPEC TABLE TO SEE IF THERE
	;IS ANY FILE CALLED SYSIN OR SYSOUT ON DSK
	L	X6,YIOSPC(XLOW)
	IF	;MORE ENTRIES IN IOSPC
		JUMPL	X6,FALSE
	THEN	;CHECK IF SYSIN OR SYSOUT
		LOOP	LF	X2,ZFSNAM(X6)
			LF	X0,ZFSFIL(X6)
			CAME	X2,[SIXBIT/SYSIN/]
			CAMN	X0,[SIXBIT/SYSIN/]
			ST	X6,YOCSIN(XLOW)
			CAME	X2,[SIXBIT/SYSOUT/]
			CAMN	X0,[SIXBIT/SYSOUT/]
			ST	X6,YOCSOU(XLOW)
		AS	LF	X6,ZFSLNK(X6)
			SKIPL	X0,OFFSET(ZFSLNK)(X6)
			GOTO	TRUE
		SA
	FI
	IFON	SWTTY
	 OUTIMAGE 66		;EXECUTION STARTED
	ENDD
	SUBTTL	OCIN: ALLOCATE IOBUFS

	BEGIN
	ST	XBASE,YIOBUF(XLOW)
	SKIPGE	X1,YIOSPC(XLOW)
	 BRANCH	OCINNS		;IF IOSPEC EMPTY!
	LI	X7,0
	;NOW SCAN IOSPEC AND COMPUTED REQUESTED SIZE
L1():!
	IF	;LOCAL SIZE IS GIVEN
		LF	X2,ZFSBUF(X1)
		CAIN	X2,0
		GOTO	FALSE
	THEN	;SEE IF IT IS BUFFERS OR TOTAL SIZE
		CAILE	X2,^D32
		 GOTO	L3		;IT WAS TOTAL SIZE
	ELSE
		L	X2,YOCBFN(XLOW)	;LOAD GLOBAL NO OF BUFFERS
	FI
	COMPSIZE
	CAIN	X2,0
	 HLR	X2,X3		;USE DEFAULT OBTAINED BY DEVSIZ
	TLZ	X3,-1		;RESET LEFT PART
	IMULI	X3,(X2)
	ADDI	X7,4(X3)	;UPDATE TOTAL SIZE, 4 IS TO 
				;COMPENSATE FOR THE BUFFER HEADER AND LINK
	GOTO	L8
L3():!			;ENTRY WHEN WE HAVE TOTAL SIZE
	COMPSIZE
	HRRZ	X4,X3
	IF	;REQUESTED SIZE IS LESS THAN STANDARD BUFFER SIZE
		CAML	X2,X4
		GOTO	FALSE
	THEN	;TAKE STANDARD SIZE INSTEAD
		HLRZ	X2,X3
		TLZ	X3,-1
		IMUL	X2,X3
		ADDI	X3,4		;COMPENSATE AS BEFORE
	FI
	ADD	X7,X2
L8():!	SOS	YOCFIL(XLOW)
	LF	X1,ZFSLNK(X1)	;LINK TO NEXT BUFFER
	SKIPL	X0,OFFSET(ZFSLNK)(X1)
	 GOTO	L1		;IF NOT LAST IOSPEC ENTRY

	;NOW SEE IF YOCFIL STILL IS POSITIVE
	IF	SKIPG	X1,YOCFIL(XLOW)
		GOTO	FALSE
	THEN	;COMPUTE REQUESTED ADDITIONAL SIZE
		SKIPN	X2,YOCBFN(XLOW)
		 LI	X2,2		;DEFAULT NO OF BUFFERS
		LI	X3,QBUFS	;DEFAULT BUFFER SIZE
		IMUL	X2,X3
		ADDI	X2,4		;BUFFER AREA HEADER
		IMUL	X2,X1		;NUMBER OF FILES
		ADD	X7,X2
	FI
	;FINALLY CHECK IF GLOBAL BUFFER SIZE IS
	;DEFINED AS LARGER THAN THE COMPUTED SIZE
	L	X0,YOCBFS(XLOW)
	CAMLE	X0,X7
	 L	X7,X0		;YES, TAKE GLOBAL BUFFER SIZE
	;SIZE OF IOBUFS IS NOW COMPUTED IN X7
	MOVN	X0,X7
	SF	X0,ZBHLEN(XBASE)	;LENGTH OF THIS IOBUFS ELEMENT
	;NOW LOOK UP LAST LINK
	L	X1,YOCBST(XLOW)
	WHILE	;NOT LAST LINK
		LF	X2,ZBHLNK(X1)
		CAIN	X2,377777
		GOTO	FALSE
	DO	L	X1,X2
	OD
	;X1 NOW POINTS TO LAST BUFFER BEFORE IOSPEC
	SF	XBASE,ZBHLNK(X1)
	SETOFF	ZBHCON(X1)	;FLAG THIS BUFFER AS  N O T  CONSECUTIVE
	HRROI	X0,-1
	SF	X0,ZBHLNK(XBASE)
	ADD	XBASE,X7	;ADDRESS TO LAST LOCATION IN IOBUFS
	IF	;NOT WITHIN CURRENT LOW SEGMENT
		L	X3,.JBREL
		SUBI	X3,QPOLMI(XBASE)
		JUMPGE	X3,FALSE
	THEN	;GRAB CORE
		LI	X1,QPOLMI(XBASE)
		CORE	X1,
		GOTO	[OUTIMAGE 55	;CORE NOT AVAILABLE
			 EXIT]
		L	X0,.JBREL
		HRRM	X0,.JBFF
		SUBI	X0,QSALIM
		ST	X0,YSALIM(XLOW)
	FI
OCINNS:			;ENTRY HERE WHEN NO SPEC FILE
	ST	XBASE,YSABOT(XLOW)
	ST	XBASE,YSATOP(XLOW)
	EXEC	.SAGI

	;NOW SAVE BUFFER ADDRESS TO TTY BUFFERS
	L	X0,YOCBST(XLOW)
	ADDI	X0,1
	ST	X0,YTTIB(XLOW)
	ADDI	X0,52
	ST	X0,YTTOB(XLOW)
	ENDD
	SUBTTL	SET UP FILE OBJECT FOR SYSIN

COMMENT ;


	FIVE CASES CAN BE DISTINGUISHED HERE:
	1. SYSIN HAS BEEN READ AS A SPECIFICATION FILE FROM TTY.
	   (SWITCH /R:"SYSIN" AND SYSIN ASSIGNED TO TTY)
	   - SET DEVICE TTY
	   - SET LOGICAL FILE NAME SYSIN
	   - UPDATE BUFFER ADDRESS
	   - SET CHANNEL 0
	
	2. SYSIN IS DECLARED IN IOSPEC, I.E. THE SPECIFICATION FILE
	   CONTAINED SYSIN AS A LOGICAL NAME.
	   THE FOLLOWING SEQUENCE IS NEEDED:
	   - DUMMY OPEN
	   - GET A BUFFER
	   - OPEN
	   - LINK THE BUFFERS
	   - COPY INFORMATION FROM IOSPEC TO FILE OBJECT
	   - LOOKUP
	   - CLAIM THE BUFFERS
	
	3. SYSIN HAS BEEN READ AS A SPECIFICATION FILE FROM DSK.
	   (SWITCH /R:"SYSIN" AND SYSIN ASSIGNED TO DSK)
	   COPY IOSPEC ENTRY TO FILE OBJECT
	
	4. SYSIN HAS BEEN READ AS AN INDIRECT SPECIFICATION FILE.
	   COPY INFORMATION FROM YOCINF-RECORD TO FILE OBJECT
	
	5. SYSIN NOT DECLARED
	   (SWITCH /-R)
	   THE FOLLOWING SEQUENCE IS NEEDED:
	   - DUMMY OPEN
	   - CHECK ASSIGN, IF TTY OR UNASSIGNED PERFORM CASE 1
	   - DEVSIZ
	   - GET A BUFFER
	   - DEVNAM
	   - OPEN
	   - LINK THE BUFFERS
	   - LOOKUP
	   - CLAIM THE BUFFERS
;

	;CREATE FILE OBJECT FOR SYSIN
	BEGIN
	LI	XSAC,IOIN
	EXEC	.SAAB		;GET FILE OBJECT FOR SYSIN
	MOVSI	X0,(<QZCL>B<%ZDNTYP>+1B<%ZDNTER>)
	WSF	X0,ZDNTYP(XRAC)
	L	X0,[SIXBIT/SYSIN/]
	SF	X0,ZFINAM(XRAC)	;LOGICAL NAME IS SYSIN
	IF	;CASE 1
		IFOFF	SWSYST
		GOTO	FALSE
L4():!	THEN	HRRM	XRAC,YIOCHTB(XLOW);CHANNEL 0
		SETZM	YIOCHTB+1(XLOW)	;RELEASE CHANNEL 1 IN CHANNEL TABLE
		MOVSI	X0,'TTY'
		SF	X0,ZFIDVN(XRAC)	;DEVICE IS TTY
		LI	X0,2
		WSF	X0,ZFIBUF(XRAC)	;2 BUFFERS
		HRL	X0,YTTOB(XLOW)
		HRR	X0,YTTIB(XLOW)
		WSF	X0,ZFIIBH(XRAC)	;SET UP BUFFER POINTER
		L	X0,[SIXBIT/SYSIN/]
		SF	X0,ZFIFIL(XRAC)	;FILE NAME IS ALSO SYSIN
	ELSE
	IF	;SYSIN IN IOSPEC, CASE 2
		SKIPN	X1,YOCSIN(XLOW)
		GOTO	FALSE
	THEN	COPYSPEC
		LF	X5,ZFIDVN(XRAC)
		CAMN	X5,[SIXBIT/TTY/]
		 GOTO	L4		;IF TTY
		GOTO	L5
	FI
	IF	;CASE 3
		;SYSIN HAS BEEN READ AS A SPEC FILE
		IFOFF	SWSYSI
		IFOFF	SWSYSR
		GOTO	FALSE
	THEN	;COPY INFORMATION FROM ZSW TO ZFI
		HRRM	XRAC,YIOCHTB+1(XLOW);CHANNEL 1
		HLRZ	X0,YSYSIN(XLOW)
		SUBI	X0,1
		SF	X0,ZFIIBH(XRAC)	;SET INPUT BUFFER POINTER
		LI	X0,1
		SF	X0,ZFICHN(XRAC)	;SET CHANNEL NO
		LI	X0,2
		SF	X0,ZFIBUF(XRAC)	;AND TWO BUFFERS
		LF	X0,ZSWDEV(XSPEC);MOVE DEVICE
		SF	X0,ZFIDVN(XRAC)
		LI	X0,OFFSET(ZFIFIL)(XRAC)	;MOVE LOOKUP INFORMATION
		HRLI	X0,OFFSET(ZSWFIL)(XSPEC)
		BLT	X0,OFFSET(ZFIARG)(XRAC)
	ELSE
	IF	;CASE 4
		;SYSIN HAS BEEN READ AS AN INDIRECT SPEC FILE
		IFOFF	SWSYSI
		GOTO	FALSE
	THEN	;COPY INFORMATION FROM YOCINF TO ZFI
		HLRZ	X0,YSYSIN(XLOW)
		SUBI	X0,1
		SF	X0,ZFIIBH(XRAC)	;SET UP INPUT BUFFER POINTER
		LI	X0,2
		SF	X0,ZFICHN(XRAC)	;SET CHANNEL 2
		SF	X0,ZFIBUF(XRAC)	;AND TWO BUFFERS
		HRRM	XRAC,YIOCHTB+2(XLOW)
		MOVSI	X0,'DSK'
		SF	X0,ZFIDVN(XRAC)	;AND DEVICE
		LI	X0,OFFSET(ZFIFIL)(XRAC)	;MOVE LOOKUP INFORMATION
		HRLI	X0,YOCINF(XLOW)
		BLT	X0,OFFSET(ZFIARG)(XRAC)
	ELSE	;CASE 5!
		MOVSI	X5,'DSK'
L5():!
		LI	X4,1
		SF	X4,ZFICHN(XRAC)	;SET CHANNEL 1
		HRRM	XRAC,YIOCHTB+1(XLOW);UPDATE CHANNEL TABLE
		LI	X6,OFFSET(ZFISTI)(XRAC);USE FILEOBJECT FOR DUMMY OPEN
		OPEN	1,X4
		 GOTO	[ERRFILE
			OCERR	3,OPEN failure
			]
		SF	X5,ZFIDVN(XRAC)
		IF	;NOT IN IOSPEC
			SKIPE	X0,YOCSIN(XLOW)
			GOTO	FALSE
		THEN	L	X4,[SIXBIT/SYSIN/]
			DEVCHR	X4,
			JUMPE	X4,L4		;If SYSIN unassigned
						edit(302)
			TLNE	X4,DV.TTA	;[302]
			 GOTO	L4		;If SYSIN assigned to TTY
			L	X0,[SIXBIT/SYSIN/]
			SF	X0,ZFIFIL(XRAC)
			DEVNAM	X0,
			 NOP
			SF	X0,ZFIDVN(XRAC)
		FI
		GETSYSBUFF	;SET UP BUFFER AREA FOR SYSIN
		SF	X0,ZFIIBH(XRAC)
		LI	X0,1
		SF	X0,ZFISTI(XRAC)
		WHILE	OPEN	1,OFFSET(ZFISTI)(XRAC)
			 GOTO	TRUE
			GOTO	FALSE
		DO	;CAN'T OPEN SPECIFIED DEVICE!!
			BREAKOUTIMAGE 56	;CANNOT OPEN
			LF	X0,ZFIDVN(XRAC)
			TYPENAME
			OUTIMAGE 57	;PLEASE ENTER NEW DEVICE:
				edit(225)
			TTYSPEC	;[225]
			 GOTO	TRUE
			GETNAME
			SF	XNAME,ZFIDVN(XRAC)
		OD
		LINKBUFF
		L	XCB,XRAC
		FILELOOKUP
		LFE	X0,ZBHLEN(X1)
		MOVN	X0,X0
		SF	X0,ZBHLEN(X1)	;FLAG THIS BUFFER OCCUPIED
	FI
	FI
	FI


	;COMMON ACTIONS FOR SYSIN:
	LF	X0,ZFIDVN(XRAC)
	DEVCHR	X0,
	SF	X0,ZFIKAR(XRAC)	;FILE CHARACTERISTICS FOR SYSIN
	ST	XRAC,YSYSIN(XLOW)
	SETON	ZFIOPN(XRAC)	;FLAG SYSIN OPEN
	SETON	ZFIIN(XRAC)	;AS A FILE THAT CAN DO INPUT
	SETON	ZFIIF(XRAC)	;AND AS AN INFILE
	IF	;END OF FILE on Sysin when reading specifications
		IFOFF	SWSYSE
		GOTO	FALSE
	THEN	;Flag end of file on Sysin
		SETON	ZFIEND(XRAC)
	FI
	L	XCB,XRAC
	LI	XWAC1,^D80	;DEFAULT IMAGE SIZE FOR SYSIN
	SETWIDTH
	HLRS	XWAC2				;MAKE POS=LENGTH+1
	STD	XWAC1,OFFSET(ZFIIMG)(XCB)	;SAVE IMAGE REFERENCE
	ENDD
	SUBTTL	SET UP FILE OBJECT FOR SYSOUT


		;NOW SYSOUT MUST BE OPENED AND INITIALIZED
	BEGIN
	LI	XSAC,IOPF
	EXEC	.SAAB		;GET FILE OBJECT FOR SYSOUT
	MOVSI	X0,(<QZCL>B<%ZDNTYP>+1B<%ZDNTER>)
	WSF	X0,ZDNTYP(XRAC)
	L	X0,[SIXBIT/SYSOUT/]
	SF	X0,ZFINAM(XRAC)	;LOGICAL NAME IS SYSOUT
	ST	XRAC,YSYSOU(XLOW)
	SETON	ZFIOF(XRAC)	;FLAG SYSOUT AS OUTFILE
	L	XCB,XRAC
	IF	;SYSOUT IS SPECIFIED
		SKIPN	X1,YOCSOU(XLOW)
		GOTO	FALSE
	THEN	;COPY IOSPEC ENTRY
		COPYSPEC
		LF	X5,ZFIDVN(XRAC)
		CAMN	X5,[SIXBIT/TTY/]
		 GOTO	L1
	ELSE	;TRY ASSIGN
		MOVSI	X5,'DSK'
	FI
			edit(177)
	L	X5	;[177]
	L	X4,YSYSIN(XLOW)	;[177]
	IF	;[177] Proper device, same as SYSIN device
		DEVNAM
		GOTO	FALSE
		CAME	OFFSET(ZFIDVN)(X4)
		GOTO	FALSE
	THEN	;May be placed on the same channel
		LF	,ZFIKAR(X4)	;Characteristics from SYSIN file
		IF	;A terminal, but not the controlling one
			TLNN	DV.TTA
			TLNN	DV.TTY
			GOTO	FALSE
		THEN	;Use channel and buffer header from SYSIN
			LF	X1,ZFICHN(X4)
			SF	X1,ZFICHN(XRAC)
			SF	X5,ZFIDVN(XRAC)
			LF	X0,ZFIIBH(X4)
			SF	X0,ZFIIBH(XRAC)
			ADDI	X1,(XLOW)
			HRLM	XRAC,YIOCHT(X1)
			GETSYSBUFF
			SF	X0,ZFIOBH(X4)
			GOTO	L7
	FI	FI	;[177]
	GETCHANNEL
	SF	X1,ZFICHN(XRAC)
	LI	X4,1
	LI	X6,OFFSET(ZFISTI)(XRAC);USE FILEOBJECT FOR DUMMY OPEN
	HLLZ	X0,OFFSET(ZFICHN)(XRAC)
	TLO	X0,(OPEN)
	HRRI	X0,X4
	XCT	X0
	 GOTO	[ERRFILE
		 OCERR	3,OPEN failure
		]
	SF	X5,ZFIDVN(XRAC)
	IF	;NOT IN IOSPEC
		SKIPE	X0,YOCSOU(XLOW)
		GOTO	FALSE
	THEN	L	X0,[SIXBIT/SYSOUT/]
		SF	X0,ZFIFIL(XRAC)	;FILE NAME IS ALSO SYSOUT IF NOT IN IOSPEC
		DEVCHR	X0,
		IF	;TTY
			JUMPE	X0,TRUE
			TLNN	X0,DV.TTA
			GOTO	FALSE
		THEN
			LF	X1,ZFICHN(XRAC)
			ADDI	X1,(XLOW)
			SETZM	YIOCHTB(X1)	;RELEASE CHANNEL IN CHANNEL TABLE
			MOVSI	X0,'TTY'
			SF	X0,ZFIDVN(XRAC)
L1():!
			HRLM	XRAC,YIOCHTB(XLOW)
			LI	X0,2
			WSF	X0,ZFICHN(XRAC)	;SET CHANNEL 0 AND TWO BUFFERS
			HRL	X0,YTTOB(XLOW)
			HRR	X0,YTTIB(XLOW)
			WSF	X0,ZFIIBH(XRAC)	;SET UP BUFFER AREA POINTERS
			GOTO	L9
		FI
		L	X0,[SIXBIT/SYSOUT/]
		DEVNAM	X0,
		  NOP
		SF	X0,ZFIDVN(XRAC)	;SET PHYSICAL DEVICE NAME
	FI
	GETSYSBUFF
L7():!	SF	X0,ZFIOBH(XRAC)
	WHILE
		OP	X0,(OPEN)
		IOR	X0,OFFSET(ZFICHN)(XRAC)
		HRRI	X0,OFFSET(ZFISTI)(XRAC)
		XCT	X0		;OPEN THIS CHANNEL
		 GOTO 	TRUE
		GOTO	FALSE
	DO	;OPEN FAILURE
		OUTIMAGE 56		;CANNOT OPEN
		LF	X0,ZFIDVN(XRAC)
		TYPENAME
		OUTIMAGE 57		;PLEASE ENTER NEW DEVICE
			edit(225)
		TTYSPEC	;[225]
		 GOTO	TRUE
		GETNAME
		SF	XNAME,ZFIDVN(XRAC);STORE NEW DEVICE AND TRY AGAIN
	OD
	LINKBUFF
	L	XCB,XRAC
	OUTENTER
	LFE	X0,ZBHLEN(X1)
	MOVN	X0,X0
	SF	X0,ZBHLEN(X1)

;HERE WHEN SYSOUT OPENED AND ENTERED
L9():!
	SETON	ZFIPF(XCB)	;FLAG SYSOUT AS PRINTFILE
	SETON	ZFIOUT(XCB)	;WHICH CAN DO OUTPUT
	LF	X0,ZFIDVN(XCB)
	DEVCHR	X0,
	SF	X0,ZFIKAR(XCB)	;FILE CHARACTERISTICS FOR SYSOUT
	LI	XWAC1,^D132	;DEFAULT IMAGE SIZE FOR SYSOUT
	SETWIDTH
	BRANCH	OCEI
	ENDD
IFN QDEBUG,<
OCINPA:	BLOCK	100		;PATCH AREA
>
	SUBTTL	LITERALS

	LIT
	END