;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** NEW MULTIPLE FILE I/O FUNCTIONS *********
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


	PGBOT [QIO]

SUBTTL	I/O CHANNEL ALLOCATOR

;;; ALCHAN ALLOCATES AN I/O CHANNEL FOR USE.
;;; THE "CHANNEL NUMBER" IS AN INDEX INTO THE CHANNEL TABLE.
.SEE CHNTB
;;; FOR ITS AND DEC10, THIS IS ALSO THE CHANNEL NUMBER USED TO
;;; COMMUNICATE WITH THE TIMESHARING SYSTEM.  (FOR DEC20, A
;;; SEPARATE JFN MUST BE ALLOCATED WITH THE GTJFN JSYS.)
;;; ALCHAN EXPECTS THE SAR FOR THE FILE ARRAY TO BE IN A,
;;; AND RETURNS THE CHANNEL NUMBER IN F, SKIPPING IF SUCCESSFUL.
;;; THE FILE ARRAY MUST HAVE ITS TTS.CL BIT SET.
;;; THE CHANNEL NUMBER IS INSTALLED IN THE FILE'S F.CHAN SLOT.
;;; USER INTERRUPTS TURNED OFF, PLEASE. CLOBBERS R.
;;; MAY INVOKE A GARBAGE COLLECTION TO FREE UP CHANNELS.

ALCHAN:	HRRZS (P)
ALCHN0:	MOVNI F,LCHNTB-2	;SCAN CHANNEL TABLE
ALCHN1:	SKIPN R,CHNTB+LCHNTB-1(F)
	 JRST ALCHN3		;FOUND A FREE CHANNEL
	JUMPL R,ALCH1A		;NEGATIVE, RESERVED
	MOVE R,TTSAR(R)
	TLNE R,TTS<CL>
	 JRST ALCHN2		;SEMI-FREE
ALCH1A:	AOJLE F,ALCHN1		;DON'T CHECK CHANNEL 0 (NEVER FREE)
	SKIPGE (P)		;SKIP IF FIRST TIME
	 POPJ P,		;LOSEY LOSEY
	HRROS (P)		;SET SWITCH
	PUSH P,[555555,,ALCHN0]
	JRST AGC		;HOPE GC WILL RECLAIM A FILE ARRAY

ALCHN2:	MOVEI F,LCHNTB-1(F)
IT$	.CALL ALCHN9		;CLOSE CHANNEL TO BE SURE
IT$	 .LOSE 1400
IFN D10,[
	MOVEI R,(F)
	LSH R,27
	IOR R,[RELEASE 0,0]	;RELEASE CHANNEL TO BE SURE
	XCT R
]		;END OF IFN D10
	SKIPA
ALCHN3:	MOVEI F,LCHNTB-1(F)
	MOVE R,TTSAR(A)		;INSTALL CHANNEL NUMBER
	MOVEM F,F.CHAN(R)
	MOVEM A,CHNTB(F)	;RESERVE CHANNEL
	JRST POPJ1		;WIN WIN - SKIP RETURN

IFN ITS,[
ALCHN9:	SETZ
	SIXBIT \CLOSE\		;CLOSE I/O CHANNEL
	400000,,F		;CHANNEL #
]		;END OF IFN ITS

;;; ALFILE CREATES A MINIMAL FILE ARRAY (OF LENGTH LOPOFA),
;;; AND ALLOCATES A CHANNEL FOR IT.  IT EXPECTS A DEVICE NAME
;;; IN TT (FOR DEC20, TT AND D) WHICH IS INSTALLED IN THE
;;; F.DEV AND F.RDEV SLOTS OF THE FILE ARRAY.
;;; THIS IS USEFUL FOR ROUTINES WHICH WANT TO HACK ON A
;;; RANDOM CHANNEL BUT DON'T NEED A FULL-BLOWN FILE ARRAY.
;;; A FILE ARRAY IS NEEDED FOR THE SAKE OF THE CHANNEL TABLE
.SEE CHNTB
;;; AND FOR THE GARBAGE COLLECTOR; IF THE FILE ARRAY IS
;;; GARBAGE COLLECTED, SO IS THE ASSOCIATED CHANNEL.
;;; THE FILE ARRAY ALSO MUST CONTAIN AT LEAST A DEVICE
;;; NAME SO PRIN1 CAN WIN.
.SEE PRNFL
;;; CLOBBERS PRACTICALLY ALL ACS.
;;; THE ARRAY GC POINTER IS SET TO PROTECT THE FIRST SLOT ONLY.
;;; RETURNS FILE ARRAY IN A, CHANNEL NUMBER IN F.
;;; SKIPS ON SUCCESS; FAILS IF ALCHAN CAN'T GET A CHANNEL.

ALFILE:	LOCKI
	PUSH FXP,TT
	MOVEI TT,LOPOFA		;LENGTH OF PLAIN OLD FILE ARRAY
	MOVSI A,-1		;GET ONLY A SAR
	PUSHJ P,MKLSAR
	MOVSI TT,TTS<CL>	;SET CLOSED BIT
	IORB TT,TTSAR(A)
	MOVSI T,AS<FIL>		;SET FILE ARRAY BIT (MUST DO
	IORB T,ASAR(A)		; IN THIS ORDER!)
	HRROS -1(T)		;GC SHOULD PROTECT ONLY ONE SLOT
	POP FXP,T
	MOVEM T,F.DEV(TT)	;INSTALL DEVICE NAME
20%	MOVEM T,F.RDEV(TT)
	MOVSI T,FBT.CM		;PREVENT GC FROM TRYING TO
	MOVEM T,F.MODE(TT)	; UPDATE NONEXISTENT POINTERS
	PUSHJ P,ALCHAN
	 JRST UNLKPJ
	AOS (P)			;WE SKIP IFF ALCHAN DOES
	MOVSI TT,TTS<CL>
	ANDCAM TT,TTSAR(A)
UNLKPJ:	UNLKPOPJ

SUBTTL	FILE OBJECT CHECKING ROUTINES

;;;	JSP TT,XFILEP
;;; SKIPS IFF THE OBJECT IN AR1 IS A FILE ARRAY. CLOBBERS R.
;;;  MUST SAVE T .SEE FLFROB
SFA% AFOSP:
AFILEP:	MOVEI AR1,(A)
SFA% XFOSP:
XFILEP:	MOVEI R,(AR1)
	LSH R,-SEGLOG
	MOVE R,ST(R)
	TLNN R,SA
	 JRST (TT)
	MOVE R,ASAR(AR1)	;MUST ALSO HAVE FILE BIT SET
	TLNN R,AS<FIL>
	 JRST (TT)
	JRST 1(TT)

FILEP:	JSP TT,AFILEP		;SUBR 1
	 JRST FALSE
	JRST TRUE

IFN SFA,[
; PARALLEL TOO AFILEP/XFILEP BUT SKIPS ONCE FOR FILE-OBJECT, AND TWICE
; FOR SFA-OBJECT

AFOSP:	MOVEI AR1,(A)
XFOSP:	MOVEI R,(AR1)
	LSH R,-SEGLOG
	MOVE R,ST(R)
	TLNN R,SA		;MUST BE A SAR
	 JRST (TT)
	MOVE R,ASAR(AR1)	;DOES IT HAVE FILE BIT SET?
	TLNE R,AS<FIL>
	 JRST 1(TT)		;YES, SINGLE SKIP
	TLNE R,AS.SFA		;AN SFA?
	 JRST 2(TT)		;YES, DOUBLE SKIP
	JRST (TT)		;ELSE ERROR RETURN
]		;END IFN SFA


;;; THESE ROUTINES ACCEPT A FILE ARRAY IN AR1 AND CHECK WHETHER
;;; IT IS OF THE DESIRED TYPE. IF NOT, A WTA ERROR OCCURS.
;;; LEAVES TTSAR IN TT AND USER INTS LOCKED IF SUCCESSFUL.
;;; CLOBBERS T, TT, AND R. SAVES D (SEE FILEPOS) AND F.

OFILOK:	JSP T,FILOK0			;TYPICAL INVOCATION:
	TTS<IO>,,TTS<IO>		;  DESIRED BITS,,MASK
	SIXBIT \NOT OUTPUT FILE!\	;  ERROR MSG IF FAIL

IFILOK:	JSP T,FILOK0
	0,,TTS<IO>
	SIXBIT \NOT INPUT FILE!\

ATFLOK:	JSP T,FILOK0
	0,,TTS<BN>
	SIXBIT \NOT ASCII FILE!\

ATOFOK:	JSP T,FILOK0
	TTS<IO>,,TTS<BN+IO>
	SIXBIT \NOT ASCII OUTPUT FILE!\

ATIFOK:	JSP T,FILOK0
	0,,TTS<BN+IO>
	SIXBIT \NOT ASCII INPUT FILE!\

TFILOK:	JSP T,FILOK0
	TTS<TY>,,TTS<TY>
	SIXBIT \NOT TTY FILE!\

TIFLOK:	JSP T,FILOK0
	TTS<TY>,,TTS<TY+IO>
	SIXBIT \NOT TTY INPUT FILE!\

TOFLOK:	JSP T,FILOK0
	TTS<TY+IO>,,TTS<TY+IO>
	SIXBIT \NOT TTY OUTPUT FILE!\

XIFLOK:	JSP T,FILOK0
	TTS<BN>,,TTS<IM+BN+IO>
	SIXBIT \NOT BINARY INPUT FILE!\

XOFLOK:	JSP T,FILOK0
	TTS<BN+IO>,,TTS<IM+BN+IO>
	SIXBIT \NOT BINARY OUTPUT FILE!\

FILOK:	JSP T,FILOK0
	0,,0
NFILE:	SIXBIT \NOT FILE!\

FILOK0:	LOCKI
	CAIE AR1,TRUTH		;T => TTY FILE ARRAY
	 JRST FILOK1
	MOVSI TT,TTS<IO>
	TSNE TT,(T)		;IF DON'T CARE ABOUT I/O
	 TDNE TT,(T)		; OR SPECIFICALLY WANT OUTPUT
	  SKIPA AR1,V%TYO	; THEN USE TTY OUTPUT
	   HRRZ AR1,V%TYI	;USE TTY INPUT ONLY IF NECESSARY
FILOK1:	JSP TT,XFILEP		;SO IS IT A FILE ARRAY?
	 JRST FILNOK		;NOPE - LOSE
	MOVE TT,TTSAR(AR1)
	XOR TT,(T)
	HLL T,TT
	MOVE TT,TTSAR(AR1)	;WANT TO RETURN TTSAR IN TT
	TLNE T,@(T)
	 JRST FILNOK
	TLNN TT,TTS<CL>
	 POPJ P,			;YEP - WIN
	SKIPA TT,[[SIXBIT \FILE HAS BEEN CLOSED!\]]
FILNOK:	 MOVEI TT,1(T)
	EXCH A,AR1
	UNLOCKI
	%WTA (TT)
	EXCH A,AR1
	JRST FILOK0

SUBTTL	CONVERSION: NAMELIST => SIXBIT

;;; A NAMELIST IN A IS CONVERTED TO "SIXBIT" FORMAT ON THE FIXNUM PDL.
;;; "SIXBIT" FORMAT IS ACTUALLY SIXBIT FOR SOME OPERATING SYSTEMS,
;;; BUT MAY BE ANY ANY FORM WHATSOEVER AS LONG AS ALL ROUTINES WHICH
;;; CLAIM TO UNDERSTAND "SIXBIT" FORM AGREE ON WHAT THAT FORM IS.
;;; (SOME ROUTINES WHICH DO I/O DEPEND ON THIS FORMAT, FOR EXAMPLE
;;; ITS ROUTINES WHICH USE THE OPEN SYMBOLIC SYSTEM CALL.)
;;; "SIXBIT" FORMAT IS DEFINED AS FOLLOWS:
;;;
;;; FOR ITS:	<SIXBIT DEVICE NAME>
;;;		<SIXBIT SNAME>
;;;		<SIXBIT FILE NAME 1>
;;;		<SIXBIT FILE NAME 2>	;TOP OF STACK
;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE).
;;;
;;; FOR DEC10:	<SIXBIT DEVICE NAME>
;;;		<PROJ-PROG NUMBER>
;;;		<SIXBIT FILE NAME>
;;;		<SIXBIT EXTENSION>	;TOP OF STACK
;;; AN OMITTED COMPONENT CAN BE REPRESENTED BY EITHER A ZERO
;;; WORD OR SIXBIT \*\ (THE LATTER BEING THE CANONICAL CHOICE),
;;; EXCEPT FOR THE PPN, FOR WHICH 777777 INDICATES AN OMITTED HALFWORD.
;;;
;;; FOR DEC20:	<ASCIZ DEVICE OR LOGICAL NAME>
;;;		<ASCIZ DIRECTORY NAME>
;;;		<ASCIZ FILE NAME>
;;;		<ASCIZ EXTENSION/TYPE NAME>
;;;		<ASCIZ VERSION/GENERATION>	;TOP OF STACK
;;; THE ENTRIES HERE ARE NOT SINGLE WORDS, BUT ARE OF
;;; RESPECTIVE LENGTHS (IN WORDS) L.6DEV, L.6DIR, L.6FNM,
;;; L.6EXT, L.6VRS.
;;;
;;; NOTE THAT FOR ALL SIXBIT FORMATS THE TOTAL LENGTH OF THE
;;; SIXBIT FORMAT IS L.F6BT.  THIS DIVIDES INTO TWO PARTS:
;;; THE DEVICE/DIRECTORY, OF LENGTH L.D6BT, AND THE FILE NAME
;;; PROPER, OF LENGTH L.N6BT.
;;;
;;; THERE ARE FOUR KINDS OF FILE NAME SPECIFICATIONS.
;;; ONE IS A FILE OBJECT, WHICH IMPLIES THE NAME USED TO OPEN IT.
;;; ONE IS AN ATOMIC SYMBOL, WHICH IS TREATED AS A NAMESTRING.
;;; THE OTHER TWO ARE NAMELISTS, UREAD-STYLE AND NEWIO-STYLE.
;;; NEWIO-STYLE NAMELISTS HAVE NON-ATOMIC CARS, WHILE UREAD-STYLE
;;; NAMELISTS HAVE ATOMIC CARS.  UREAD-STYLE NAMELISTS ARE MOSTLY
;;; FOR COMPATIBILITY WITH OLDIO, AND FOR USER CONVENIENCE.
;;; AS OF 4/14/80, USER HUNKS, THAT IS  "EXTENDS" ARE PERMITTED TO
;;; APPEAR AS "NAMELISTS", IN WHICH CASE THEY ARE SENT THE  MESSAGE
;;; "NAMESTRING";  THEY ARE EXPECTED TO RETURN A SYMBOL, WHICH IS
;;; THEN TREATED AS IF IT WERE HANDED IN DIRECTLY.

;;;
;;; IN A NEWIO-STYLE NAMELIST, THE CAR IS A DEVICE/DIRECTORY
;;; SPECIFICATION, AND THE CDR A FILE NAME SPECIFICATION.
;;; IN PRINCIPLE EACH IS A LIST OF ARBITRARY LENGTH.
;;; IN PRACTICE, THERE IS A LIMIT FOR EACH OF THE PDP-10
;;; IMPLEMENTATIONS.  THE CANONICAL NAMELIST FORMAT FOR
;;; EACH SYSTEM IS AS FOLLOWS:
;;;	ITS:	((<DEVICE> <SNAME>) <FILE NAME 1> <FILE NAME 2>)
;;;	TOPS10:	((<DEVICE> (<PROJ#> <PROG#>)) <FILE NAME> <EXTENSION>)
;;;	SAIL:	((<DEVICE> (<PROJ> <PROG>)) <FILE NAME> <EXTENSION>)
;;;	CMU:	((<DEVICE> <PPN>) <FILE NAME> <EXTENSION>)
;;;			CMU ALSO ALLOWS TOPS10-STYLE NAMELISTS.
;;;	TENEX:	((<DEVICE> <DIRECTORY>) <FILE NAME> <EXTENSION> <VERSION>)
;;;	TOPS20:	((<DEVICE> <DIRECTORY>) <FILE NAME> <TYPE> <GENERATION>)
;;;
;;; ALL COMPONENTS ARE NOMINALLY ATOMIC SYMBOLS, EXCEPT <PROJ#> AND <PROG#>,
;;; WHICH ARE FIXNUMS.  IF THE USER SUPPLIES A COMPONENT WHICH IS NOT
;;; A SYMBOL (AND IT CAN EVEN BE NON-ATOMIC IF THERE IS NO AMBIGUITY
;;; AS TO FORMAT), THEN IT IS EXPLODEC'D WITH BASE=10., PRINLEVEL=PRINLENGTH=NIL,
;;; AND *NOPOINT=T.  A COMPONENT MAY BE "OMITTED" BY USING THE ATOMIC
;;; SYMBOL *.  THIS DOES NOT MEAN A WILDCARD, BUT ONLY AN OMITTED COMPONENT.
;;;
;;; IF THE USER SUPPLIES A NAMELIST NOT IN CANONICAL FORM, THE CAR AND CDR
;;; ARE INDEPENDENTLY CANONICALIZED.  THE CAR CAN BE ACANONICAL ONLY BY
;;; BEING A SINGLETON LIST; IN THIS CASE AN ATTEMPT IS MADE TO DECIDE
;;; WHETHER IT IS A DEVICE OR DIRECTORY SPECIFICATION.  THIS IS DONE IN
;;; DIFFERENT WAYS ON DIFFERENT SYSTEMS.  ON TOPS10, FOR EXAMPLE, AN ATOMIC
;;; SPECIFICATION IS NECESSARY A DEVICE AND NOT A PPN.  ON THE OTHER HAND,
;;; ON ITS A LIST OF STANDARD DEVICE NAMES IS CHECKED.
;;; THE CDR CAN BE ACANONICAL BY BEING TOO SHORT, OR BY BEING A DOTTED LIST,
;;; OR BOTH.  COMPONENTS ARE TAKEN IN ORDER UNTIL AN ATOMIC CDR IS REACHED.
;;; IF THIS CDR IS NIL, ALL REMAINING COMPONENTS ARE TAKEN TO BE *.
;;; OTHERWISE, ALL REMAINING COMPONENTS ARE * EXCEPT THE LAST, WHICH IS
;;; THAT ATOM IN THE CDR.
;;;
;;; A UREAD-STYLE NAMELIST IS NOMINALLY IN THE FORM (A B C D), WHERE
;;; A, AT LEAST, MUST BE ATOMIC.  IT IS INTERPRETED AS IF IT WERE CONVERTED
;;; TO THE FORM ((C D) A B) [DEC20: ((C D) A * B)], AND THEN TREATING IT AS
;;; AN ORDINARY NAMELIST. (IF C AND D ARE MISSING, THEN (*) IS USED INSTEAD
;;; OF NIL AS THE CAR OF THE CONSTRUCTED NAMELIST.



NML6BT:	JSP T,QIOSAV		;SAVE REGISTERS
NML6B5:	PUSH P,A
	HLRZ A,(A)		;CHECK CAR OF NAMELIST
	JSP T,STENT
	JUMPGE TT,NML6B2	;JUMP IF UREAD-STYLE NAMELIST
	PUSHJ P,NML6DV		;CONVERT DEVICE/DIRECTORY SPECIFICATION
NML6B4:	 JRST NML6B0		;SKIPS UNLESS CONVERSION FAILED
	HRRZ A,@(P)
	PUSHJ P,NML6FN		;CONVERT FILE NAMES (LEAVES TAIL IN A)
	JUMPE A,POP1J		;SUCCEED UNLESS TOO MANY FILE NAMES
NML6BZ:	POPI FXP,L.N6BT		;POP FILE NAME CRUD
NML6B0:	POPI FXP,L.D6BT		;POP DEVICE/DIRECTORY CRUD
	POP P,A			;POP ORIGINAL ARGUMENT
	WTA [INCORRECTLY FORMED NAMELIST!]
	JRST NML6B5

NML6B2:	HRRZ A,(P)		;HERE FOR UREAD-STYLE NAMELIST
	PUSHJ P,NML6UF		;CONVERT FILE NAMES, BUT AT MOST TWO OF THEM
	PUSHJ P,NML6DV		;NOW CONVERT THE DEVICE/DIRECTORY
	 JRST NML6BZ		;NOTE THAT POPI'S COMMUTE AT NML6BZ!
;AT THIS POINT THE WORDS ON FXP ARE IN THE WRONG ORDER, SO WE SHUFFLE THE STACK.
IFN ITS+D10,[
	POP FXP,TT		;DIRECTORY
	POP FXP,T		;DEVICE
	EXCH T,-1(FXP)		;EXCH DEVICE WITH FN1
	EXCH TT,(FXP)		;EXCH DIR WITH FN2
	PUSH FXP,T		;PUSH FN1
	PUSH FXP,TT		;PUSH FN2
]		;END OF IFN ITS+D10
IFN D20,[
	MOVEI T,-L.F6BT+1(FXP)
	HRLI T,-L.N6BT
	PUSH FXP,(T)		;COPY THE FILE NAMES TO THE TOP
	AOBJN T,.-1		; OF THE STACK
	MOVEI T,-L.F6BT-L.N6BT+1(FXP)
	HRLI T,-L.F6BT+1(FXP)
	BLT T,-L.N6BT(FXP)	;COPY ENTIRE "SIXBIT" SET DOWNWARD
	POPI FXP,L.N6BT		;POP OFF EXTRANEOUS CRUD
]		;END OF IFN D20
	JRST POP1J

;;; CONVERT FILE NAME LIST IN A TO "SIXBIT" FORM ON FXP.
;;; RETURNS THE UNUSED TAIL OF THE LIST IN A.
;;; NML6UF IS LIKE NML6FN, BUT NEVER GOBBLES MORE THAN TWO NAMES.

IFN D20,[
DFNWD:	ASCII \*\		;DEFAULT FILE-NAME WORD
DFFNWD:	ASCII \FASL\
NML6FN:	TDZA T,T
NML6UF:  SETO T,		;UREAD-STYLE DISTINCTION ONLY MATTERS TO DEC20
	HRLM T,(P)
	PUSHN FXP,L.6FNM+L.6EXT+L.6VRS	;PUSH APPROPRIATE NUMBER OF WORDS 
	MOVE T,DFNWD		;INITIALIZE FIELDS TO '*' IF NOT SUPPLIED
	MOVEM T,-L.6VRS+1(FXP)  		;VERSION NUMBER?
	MOVEM T,-L.6EXT-L.6VRS+1(FXP) 		;EXTENSION
	MOVEM T,-L.6FNM-L.6EXT-L.6VRS+1(FXP) 	;FILE NAME
]	;END OF IFN D20
IFE D20,[
DFNWD:	SIXBIT \*\		;DEFAULT FILE-NAME WORD
DFFNWD:				;DEFAULT FASL-FILE-NAME WORD
10% 	SIXBIT \FASL\
10$ 	SIXBIT \FAS\
NML6FN:
NML6UF:	REPEAT L.N6BT, PUSH FXP,DFNWD 	;PUSH ROOM FOR THE FILE NAMES
]	;END OF IFE D20
	JUMPE A,CPOPJ		;NULL LIST => ALL NAMES OMITTED
	PUSH P,A
	JSP T,STENT
	JUMPGE TT,NML6F3	;ATOM MEANS LAST COMPONENT
	HLRZ A,(A)
20%	PUSHJ P,SIXMAK		;CONVERT FIRST COMPONENT TO SIXBIT,
20%	MOVEM TT,-1(FXP)	; AND CALL IT FILE NAME 1
IFN D20,[
	PUSHJ P,PNBFMK		;CONVERT FIRST COMPONENT TO ASCIZ,
	MOVEI T,-L.6FNM-L.6EXT-L.6VRS+1(FXP)	; AND CALL IT THE FILE NAME
	HRLI T,PNBUF
	BLT T,-L.6EXT-L.6VRS(FXP)
	MOVEI T,177_1			;MASK FOR LAST BYTE IN AN ASCII WORD
	ANDCAM T,-L.6EXT-L.6VRS(FXP)	;MAKE SURE LAST BYTE IS NULL
]		;END OF IFN D20
	HRRZ A,@(P)
	JUMPE A,POP1J		;EXIT IF ALL DONE
	MOVEM A,(P)
IFN D20,[
	JSP T,STENT
	JUMPGE TT,NML6F3	;ATOM MEANS LAST COMPONENT
	HLRZ A,(A)
	PUSHJ P,PNBFMK		;CONVERT NEXT COMPONENT TO ASCIZ,
	MOVEI T,-L.6EXT-L.6VRS+1(FXP)	; AND CALL IT THE EXTENSION
	HRLI T,PNBUF
	BLT T,-L.6VRS(FXP)
	MOVEI T,177_1			;MASK FOR LAST BYTE IN AN ASCII WORD
	ANDCAM T,-L.6VRS(FXP)		;MAKE SURE LAST BYTE IS NULL
	HRRZ A,@(P)
	JUMPE A,POP1J		;EXIT IF ALL DONE
	HRRZ T,(A)		;IF 3 COMPONENTS REMAIN, THEN VERSION EXISTS
	HRRZ T,(T)
	SKIPN T
	 SKIPL -1(P)		;FOR UREAD-STYLE NAMELISTS, READ AT MOST
	  SKIPA			; TWO COMPONENTS
	   JRST NML6F4
	MOVEM A,(P)
NML6F5:
]		;END OF IFN D20
	JSP T,STENT
	JUMPGE TT,NML6F3	;ATOM MEANS LAST COMPONENT
	HLRZ A,(A)
NML6F2:
IFE D20,[
	PUSHJ P,SIXMAK		;CONVERT LAST COMPONENT TO SIXBIT,
10$	TRZ TT,-1		; TRUNCATING TO 3 CHARS FOR DEC10,
	MOVEM TT,(FXP)		; AND CALL IT FILE NAME 2
]		;END OF IFN D20
IFN D20,[
	PUSHJ P,PNBFMK		;CONVERT LAST COMPONENT TO ASCIZ,
	MOVEI T,-L.6VRS+1(FXP)	; AND CALL IT THE VERSION
	HRLI T,PNBUF
	BLT T,(FXP)
	MOVEI T,177_1			;MASK FOR LAST BYTE IN AN ASCII WORD
	ANDCAM T,(FXP)			;MAKE SURE LAST BYTE IS NULL
]		;END OF IFN D20
NML6F4:	HRRZ A,@(P)
	JRST POP1J

NML6F3:	SETZM (P)
20%	JRST NML6F2
20$	JRST NML6F4

;;; CONVERTS A DEVICE/DIRECTORY SPECIFICATION IN A TO "SIXBIT" FORM ON FXP.
;;; PERFORMS DEVICE/DIRECTORY DISAMBIGUATION.  SKIPS ON SUCCESS.

NML6DV:
 	PUSH FXP,DFNWD		;PUSH ROOM FOR DEV NAME
20$	PUSHN FXP,L.6DEV-1	;PUSH ROOM FOR THE DEVICE NAME
10$	PUSH FXP,[-1]		;FOR DIR NAME
10% 	PUSH FXP,DFNWD		;FOR DIR NAME
20$	PUSHN FXP,L.6DIR-1	;PUSH ROOM FOR THE DIRECTORY NAME
NML6D0:	JUMPE A,POPJ1		;NULL SPEC => DEFAULTS
	HRRZ B,(A)
	HLRZ A,(A)
	PUSH P,B
NML6PP:
10$	JSP T,SPATOM		;FOR DEC-10, A NON-ATOMIC ITEM MUST BE A PPN
10$	 JRST NML6D7
20$	PUSHJ P,PNBFMK		;GET THE "SIXBIT" FORM OF DEVICE
IFE D20,[
	PUSH P,A
	PUSH P,B
 	PUSHJ P,SIXMAK
	POP P,B
	POP P,A
]	 	;END IFE D20
	SKIPE (P)		;FOR MORE THAN ONE ITEM IN LIST, THEN THE
	 JRST NML6D1		; FIRST MUST BE A DEVICE
	PUSHJ P,IDND		;DISAMBIGUATE THIS MESS - SKIP IF DEVICE
	 JRST NML6D8		;NO SKIP MEANS NO INFO - MAYBE DIRECTORY NAME?
	 JRST NML6D1		;SKIP ONE MEANS DEFINITELY A DEVICE NAME
	POP P,B
	JRST NML6D0		;SKIP TWO MEANS PPN/DIRECTORY TRANSLATION

NML6D1:				;IT'S DEFINITELY A DEVICE NAME
20%	MOVEM TT,-L.D6BT+1(FXP)
IFN D20,[
NML6D3:	MOVEI T,-L.6DEV-L.6DIR+1(FXP)
	HRLI T,PNBUF
	BLT T,-L.6DIR+1(FXP)
	MOVEI T,177_1			;MASK FOR LAST BYTE IN AN ASCII WORD
	ANDCAM T,-L.6DIR(FXP)		;MAKE SURE LAST BYTE IS NULL
]		;END OF IFN D20
	SKIPN (P)
	 JRST POP1J1			;SUCCESS IF NO DIRECTORY SPEC
	HLRZ A,@(P)
IFN D10,[
	PUSHJ P,PPNGET		;TRY PPN PROPERTY
	SKIPN A			;USE IT IF IT EXISTS
	 HLRZ A,@(P)		;ELSE USE THE USER SPECIFIED FROB
]	;END IFN D10
	HRRZ B,@(P)
	MOVEM B,(P)
;HERE IS WHERE IT HITS THE FAN - NO TWO SYSTEMS HAVE THE SAME DIRECTORY SPEC FORMAT!
IFN ITS,	PUSHJ P,SIXMAK	;FOR ITS IT IS A PLAIN SIXBIT NAME
IFN D20,	PUSHJ P,PNBFMK	;FOR D20 IT IS ASCII
IFN D10,[
NML6D8:	SETO TT,
	CAIN A,Q.		;* AS A PPN STRING IS TAKEN TO MEAN (* *)
	 JRST NML6D4
	JSP T,SPATOM
	 JRST NML6D7		;NON-ATOMIC => TOPS10-STYLE
SA%	SKIPN CMUP
	 JRST POP1J		;AN ATOMIC DIRECTORY IS ILLEGAL FOR TOPS10/SAIL
IFE SAIL,[
	PUSHJ P,PNBFMK
	MOVEI TT,PNBUF		;0,,ADDRESS OF CMU PPN STRING
	CMUDEC TT,		;CMUDEC WILL CONVERT A STRING TO A PPN WORD
	 JRST POP1J		;FAIL IF NOT A VALID CMU PPN
	JRST NML6D4
]	;END OF IFE SAIL
NML6D7:	HLRZ B,(A)		;B GETS PROJECT
	HRRZ C,(A)
	HLRZ A,(C)		;A GETS PROGRAMMER
	HRRZ C,(C)
	JUMPN C,POP1J		;FAIL IF THREE ITEMS IN THE PPN SPEC
IFE SAIL,[
	CAIN B,Q.		;* MEANS AN OMITTED COMPONENT
	 SKIPA D,[,,-1]
	  JSP T,FXNV2		;OTHERWISE EXPECT A FIXNUM
	CAIN A,Q.
	 SKIPA TT,[,,-1]
	  JSP T,FXNV1
	TLNN TT,-1
	 TLNE D,-1
	  JRST POP1J		;NUMBERS MUST FIT INTO HALFWORDS
	HRLI TT,(D)
]		;END OF IFE SAIL
IFN SAIL,[
	PUSH P,B
	CAIN A,Q.		;* MEANS AN OMITTED COMPONENT
	 SKIPA TT,[0,,-1]
	  PUSHJ P,SIXMAK	;OTHERWISE GET SIXBIT
	PUSHJ P,SARGHT		;RIGHT JUSTIFY IT
	PUSH FXP,TT
	POP P,A
	CAIN A,Q.		;* MEANS AN OMITTED COMPONENT
	 SKIPA TT,[0,,-1]
	  PUSHJ P,SIXMAK	;OTHERWISE GET SIXBIT
	PUSHJ P,SARGHT		;RIGHT JUSTIFY IT
	POP FXP,D
	TLNN TT,-1
	 TLNE D,-1
	  JRST POP1J		;NO MORE THAN 3 CHARS APIECE
	MOVSS TT
	HRRI TT,(D)
]		;END OF IFN SAIL
]		;END OF IFN D10
;NOW WE HAVE THE SNAME/PPN IN TT FOR ITS/D10, OR DIRECTORY IN PNBUF FOR D20
10% NML6D8:
NML6D4:
20%	MOVEM TT,(FXP)
IFN D20,[
	MOVEI T,-L.6DIR+1(FXP)
	HRLI T,PNBUF
	BLT T,(FXP)
	MOVEI T,177_1		;MASK FOR LAST BYTE IN AN ASCII WORD
	ANDCAM T,(FXP)
]		;END OF IFN D20
	SKIPN (P)		;WE WIN IFF THERE ARE NO MORE ITEMS TO PARSE
	 AOS -1(P)
	JRST POP1J


IFN SAIL,[
;RIGHT JUSTIFY SIXBIT WORD IN TT
SARGHT:	SKIPE TT		;IF NOTHING THERE WE DON'T WANT TO LOOP
	 TRNE TT,77		;ANYTHING IN HIGH SIXBIT BYTE?
	  POPJ P,		;YUP, IT IS THEREFORE LEFT-JUSTIFIED
	LSH TT,-6		;ELSE GET RID OF THE LEADING BLANK
	JRST SARGHT		;AND PROCEED WITH TEST
]	;END IFN SAIL




;;; INSUFFERABLE DEVICE NAME DISTINGUISHER  -  SKIP.RETURN IF ARG IS DEVICE
;;; A NAME IS IN TT IN SIXBIT (ITS/CMU) OR IN PNBUF IN ASCII (D20).
;;; ACC A HOLDS POINTER TO THE SYMBOL FROM WHICH "NAME" WAS TRANSLATED.
;;; TRIES TO DECIDE WHETHER A NAME IS A DEVICE NAME OR A DIRECTORY NAME.
;;; FOR ITS, IT IS A DEVICE NAME IFF, AFTER STRIPPING OFF TRAILING DIGITS,
;;; IT IS IN THE TABLE OF KNOWN DEVICE NAMES.
;;; FOR CMU, WE USE THE DEVCHR UUO TO TEST EXISTENCE.
;;; FOR D20, WE USE THE STDEV JSYS TO TEST EXISTENCE.
;;; SKIPS IF A DEVICE NAME.  MUST PRESERVE A AND TT.


IFN ITS,[
;;; BEWARE! THIS TABLE IS SORTED ALPHABETICALLY, AND THAT IS REQUIRED BY
;;;  THE SUPER-HAIRY BINARY SORT HACK ABOVE.  TABLE MUST BE AN EXACT POWER OF 
;;;  TWO IN LENGTH SO WE CAN USE SUPER-WINNING BINARY SEARCH METHOD.

IDNTB:	; There are currently 62. entries in this table.
IRP X,,[AI,AIAR,AIARC,AIDIR,AR,ARC,BOJ,CLA,CLI,CLO,CLU,COM,COR
DIR,DIRHNG,DK,DM,DMAR,DMARC,DMDIR,DNR,DNRF,DSK,ERR,JOB,LP,LPT,LR
MC,MCAR,MCARC,MCDIR,MD,MDAR,MDARC,MDDIR
ML,MLAR,MLARC,MLDIR,MX,MXAR,MXARC,MXDIR
MT,NUL,OJB,P,PK,PTP,PTR,S,SPY,ST,STY,SYS,T,TPL,TTY,TY,USR,UT]
	SIXBIT \X\
TERMIN
LIDNTB==:.-IDNTB

HAOLNG LOG2IDNTB,<.-IDNTB-1>
    REPEAT <1_LOG2IDNTB>-LIDNTB,[-1
	]				;END OF REPEAT <1_LOG2IDNTB>-LIDNTB,

IDNDLS:
    REPEAT 6,[ROTC TT-1,<.RPCNT+1>*6
	]				;END OF REPEAT 6,
	POPJ P,				;STANDARD EXIT IF TOO MANY SHIFTS

]	;END OF IFN ITS

PPNGET:	PUSH P,B	;Don't go around clobbering stuff
	PUSH FXP,TT	;CHECK TO SEE IF SYMBOL HAS PPN PROPERTY
	JSP T,SPATOM	; AND USE `(DSK ,(proj prog)) IF FOUND
	 MOVE A,CIN0	;A LISP "0", IN ORDER TO CONFUSE "GET"
	MOVEI B,QPPN
	PUSHJ P,$GET
	POP P,B		;B may still contain the directory name.
	JRST RSTX1


IDND:	PUSH P,A
	PUSHJ P,PPNGET
	JUMPE A,IDNDA
	HRRZM A,(P) 		;AHA! A PPN TRANSLATION!
	AOS -1(P) 		;SKIP 2 FOR PPN TRANSLATION
	AOS -1(P) 
	JRST POPAJ
IDNDA: 
IFN D20,[
	LOCKI			;LOCK OUT INTERRUPTS AROUND THE JSYS
	HRROI A,PNBUF
	STDEV			;CONVERT DEVICE STRING TO DEVICE DESIGNATOR
	 SKIPA 			;ERROR - NO SUCH DEVICE - NO SKIP ON FAILURE
]		;END OF IFN D20
IFN D10,[
	MOVE F,TT
	DEVCHR F,		;GET CHARACTERISTICS OF DEVICE
	 SKIPE F		; ZERO WORD MEANS DEVICE DOESN'T EXIST
]	;END OF IFN D10
IFN ITS,[
IDNDA:	MOVE F,TT		;SAVE TT IN F
	MOVNI R,6
IDND1:	SETZ TT-1,		;WE WILL STRIP DIGITS AND NULLS FROM END
	ROTC TT-1,-6		; BY ROTATING THEM INTO THE PREVIOUS AC
	ROT TT-1,6
	JUMPE TT-1,IDND2
	CAIL TT-1,'0
	 CAILE TT-1,'9
	  JRST IDND3		;EXIT IF NEITHER DIGIT NOR NULL
IDND2:	AOJL R,IDND1
	POPJ P,			;SHIFTED OUT ALL CHARACTERS?
IDND3:	ROT TT-1,-6
	XCT IDNDLS+6(R)		;SHIFT BACK
	SETZB R,T
    REPEAT LOG2IDNTB,[
	CAML TT,IDNTB+<1_<LOG2IDNTB-.RPCNT-1>>(R)
	ADDI R,1_<LOG2IDNTB-.RPCNT-1>
	]			;END OF REPEAT LOG2IDNTB
	EXCH TT,F		;RESTORE TT
	CAMN F,IDNTB(R)		;FALL THRU IF RECOGNIZED DEVICE
]		;END OF IFN ITS
;;; FALL THRU TO HERE IF IT IS A DEVICE
IDNDS:	AOS -1(P)		;AND IF DEVICE, THEN SKIP ONE ON RETURN
IDNDX:				; BUT IF NOT, THEN NO SKIP
20%	JRST POPAJ		
20$	POP P,A
20$	UNLKPOPJ



SUBTTL	CONVERSION: SIXBIT => NAMELIST

;;; THIS ROUTINE TAKES "SIXBIT" FORMAT ON FXP AND,
;;; POPPING THEM, RETURNS THE EQUIVALENT CANONICAL NAMELIST.
;;; OMITTED COMPONENTS BECOME *'S.
;;; THE NAMELIST FUNCTION MERELY CONVERTS ARG TO SIXBIT,
;;; THEN BACK TO (CANONICAL) NAMELIST FORM.

NAMELIST:
	PUSHJ P,FIL6BT		;SUBR 1
6BTNML:	JSP T,QIOSAV		;MUST ALSO PRESERVE F
	PUSHN P,1
;FOR D20, POP THE VERSION (TENEX)/GENERATION (TOPS20) AND CONS IT UP
IFN D20,[
REPEAT L.6VRS,	POP FXP,PNBUF+L.6VRS-.RPCNT-1
	PUSHJ P,6BTNL3
]		;END OF IFN D20
;POP THE FILE NAME 2 (ITS)/EXTENSION (D10, TENEX)/TYPE (TOPS20) AND CONS UP
IFN ITS+D10,	POP FXP,TT
IFN D10,	TRZ TT,-1	;D10 EXTENSION IS AT MOST 3 CHARACTERS
IFN D20,[
	MOVEI T,PNBUF
	HRLI T,-L.6EXT+1(FXP)
	BLT T,PNBUF+L.6EXT-1
	POPI FXP,L.6EXT
]		;END OF IFN D20
	PUSHJ P,6BTNL3
;POP THE FILE NAME 1 (ITS)/FILE NAME (D10, D20) AND CONS UP
IFN ITS+D10,	POP FXP,TT
IFN D20,[
	MOVEI T,PNBUF
	HRLI T,-L.6FNM+1(FXP)
	BLT T,PNBUF+L.6FNM-1
	POPI FXP,L.6FNM
]		;END OF IFN D20
	PUSHJ P,6BTNL3
;NOW FOR THE DEVICE/DIRECTORY PORTION
	PUSHN P,1
;FIRST THE DIRECTORY (WHAT A MESS!)
IFN ITS,[
	POP FXP,TT
	PUSHJ P,6BTNL3
]		;END OF IFN ITS
IFN D10,[
	POP FXP,TT
	PUSHJ P,PPNATM
	PUSHJ P,6BTNL4
]		;END OF IFN D10
IFN D20,[
	MOVEI T,PNBUF
	HRLI T,-L.6DIR+1(FXP)
	BLT T,PNBUF+L.6DIR-1
	POPI FXP,L.6DIR
	PUSHJ P,6BTNL3
]		;END OF IFN D20
;FINALLY, THE DEVICE NAME
20%	POP FXP,TT
IFN D20,[
	MOVEI T,PNBUF
	HRLI T,-L.6DEV+1(FXP)
	BLT T,PNBUF+L.6DEV-1
	POPI FXP,L.6DEV
]		;END OF IFN D20
	PUSHJ P,6BTNL3
	POP P,A
	POP P,B
	JRST CONS

SA$ 6BTNL9:	SKIPA A,[Q.]
6BTNL3:
20%	PUSHJ P,SIXATM
20$	PUSHJ P,PNBFAT
6BTNL4:	MOVE B,-1(P)
	PUSHJ P,CONS
	MOVEM A,-1(P)
	POPJ P,

SUBTTL	CONVERSION: SIXBIT => NAMESTRING

;;; THIS ROUTINE TAKES A "SIXBIT" FORMAT FILE SPEC ON FXP
;;; AND GENERATES AN UNINTERNED ATOMIC SYMBOL WHOSE
;;; PRINT NAME IS THE EXTERNAL FORM OF FILE SPECIFICATION.
;;; OMITTED NAMES ARE EITHER NOT INCLUDED IN THE NAMESTRING
;;; OR REPRESENTED AS "*".
;;; THE NAMESTRING AND SHORTNAMESTRING MERELY CONVERT THEIR
;;; ARGUMENTS TO SIXBIT AND THEN INTO NAMESTRING FORM.


SHORTNAMESTRING:		;SUBR 1
	TDZA TT,TT
NAMESTRING:			;SUBR 1
	 SETO TT,
	HRLM TT,(P)
	PUSHJ P,FIL6BT
6BTNMS:	MOVEI TT,PNGNK2
	HLL TT,(P)		;TO MAKE A NAMESTRING, GET IT INTO PNBUF
	PUSH P,TT
	JRST 6BTNS		; AND THEN PNGNK2 WILL MAKE A SYMBOL


IFN D20,[
6BTTLS:	PUSHJ P,6BTTLN
	JRST 6BTNSL
X6BTNSL:	MOVEI T,L.F6BT		;MAKES STRING IN PNBUF, BUT NO POPPING
	PUSH FXP,-L.F6BT+1(FXP)		; THE FILE NAMES (WE COPY THEM FIRST)
	SOJG T,.-1
]		;END OF IFN D20

6BTNSL:	 SETO TT,		;IF RETURN ADDRESS SLOT ON THE PDL IS 
	HRLM TT,(P)		; POSITIVE, THEN DO "SHORTNAMESTRING"
6BTNS:	JSP T,QIOSAV		;CONVERT "SIXBIT" TO A STRING IN PNBUF
				; (BETTER BE BIG ENOUGH!)
	SETOM LPNF		;SET FLAG SAYING IT FITS IN PNBUF
20%	MOVEI R,^Q		;R CONTAINS THE CHARACTER FOR QUOTING
20$	MOVEI R,^V		; PECULIAR CHARACTERS IN COMPONENTS
	MOVE C,PNBP
	SKIPL -LQIOSV(P)	;SKIP UNLESS SHORTNAMESTRING
	 JRST 6BTNS0
;DEVICE NAME (NOT FOR SHORTNAMESTRING, THOUGH)
 	MOVEI TT,-L.D6BT-L.N6BT+1(FXP)
	SKIPE T,(TT)
	 CAMN T,DFNWD
	  JRST 6BNS0A		;JUMP IF DEVICE NAME OMITTED
	PUSHJ P,6BTNS1
	MOVEI T,":		;9 OUT OF 10 OPERATING SYSTEMS AGREE:
	IDPB T,C		; ":" MEANS A DEVICE NAME.
6BNS0A:
;FOR ITS AND D20, DIRECTORY NAME COMES NEXT
IFN ITS+D20,[
	MOVEI TT,-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
	SKIPE T,-L.6DIR-L.N6BT+1(FXP)
	 CAMN T,DFNWD
	  JRST 6BTNS0		;DIRECTORY NAME OMITTED
20$	MOVEI T,"<		;D20 DIRECTORY NAME APPEARS IN <>
20$	IDPB T,C
	PUSHJ P,6BTNS1
20$	MOVEI T,">
20%	MOVEI T,";		;";" MEANS DIRECTORY NAME TO ITS
	IDPB T,C
]		;END OF IFN ITS+D20
6BTNS0:	MOVEI TT,-L.N6BT+1(FXP)	;NOW WE ATTACK THE FILE NAME
	PUSHJ P,6BTNS1
;NOW THE FILE NAME 2/EXTENSION/TYPE
IFN ITS,	MOVEI T,40
IFN D10+D20,	MOVEI T,".
10$	PUSH FXP,(FXP)				;EXTRA SLOT FOR D10, IN ORDER
10$	HLLZS (FXP)				; ZERO OUT HALF A WORD
	MOVEI TT,-L.N6BT+L.6FNM+1(FXP)
10$	SKIPE (TT)
	 IDPB T,C
IT%	SKIPE (TT)
	 PUSHJ P,6BTNS1
10$ 	POPI FXP,1				;FLUSH THE "EXTRA" SLOT
IFN D20,[
;FOR D20, THE VERSION/GENERATION COMES LAST
	MOVEI TT,-L.6VRS+1(FXP)
	SKIPE T,(TT)
	 CAMN T,DFNWD
	  JRST 6BTNS8
	MOVEI T,".
	SKIPE TENEXP
	 MOVEI T,";
	IDPB T,C
	PUSHJ P,6BTNS1
]		;END OF IFN D20
IFN D10,[
;FOR D10, THE DIRECTORY COMES LAST
	MOVEI TT,-L.F6BT+L.6DEV+1(FXP)
	MOVE T,(TT)
	CAME T,XC-1			;FORGET IT IF BOTH HALVES OMITTED
	 SKIPL -LQIOSV(P)		;NO DIRECTORY FOR SHORTNAMESTRING
	  JRST 6BTNS8
	MOVEI T,91.			;A LEFT BRACKET
	IDPB T,C
IFE SAIL,[
	SKIPN CMUP
	 JRST 6BTNS4
	HLRZ T,(TT)
	CAIG T,10		;ONLY PROJECTS ABOVE 10 ARE IN CMU FORMAT
	 JRST 6BTNS4
	PUSHN FXP,2		;THERE IS A BUG IN DECCMU, BUT PUSHING ZERO WORDS
	MOVEI T,-1(FXP)		; GETS US AROUND IT
	HRL T,TT
	DECCMU T,
	 JRST 6BTNS4		;ON FAILURE, JUST USE DEC FORMAT
	MOVEI TT,-1(FXP)
	TLOA TT,440700
	 IDPB T,C		;COPY CHARACTERS INTO PNBUF
	ILDB T,TT
	JUMPN T,.-2
	POPI FXP,2
	JRST 6BTNS5
]	;END OF IFE SAIL
6BTNS4:	HLLZ TT,-L.F6BT+L.6DEV+1(FXP)
	PUSHJ P,6BTNS6		;OUTPUT PROJECT
	MOVEI T,",		;COMMA SEPARATES HALVES
	IDPB T,C
	HRLZ TT,-L.F6BT+L.6DEV+1(FXP)
	PUSHJ P,6BTNS6		;OUTPUT PROGRAMMER
6BTNS5:	MOVEI T,93.		;A RIGHT BRACKET
	IDPB T,C
]		;END OF IFN D10
6BTNS8:	PUSHJ FXP,RDAEND	;FINISH OFF THE LAST WORD OF THE STRING
	SETZM 1(C)
	POPI FXP,L.F6BT		;POP CRUD OFF STACK
	MOVEM C,-LQIOSV+2(P)	;CROCK DUE TO SAVED AC C
	POPJ P,

;;; COME HERE TO ADD A COMPONENT TO THE GROWING NAMESTRING IN PNBUF.
;;; FOR ITS AND D10, THE SIXBIT IS IN TT, AND MUST BE CONVERTED.
;;; FOR DEC20, TT HAS A POINTER TO THE ASCIZ STRING TO ADD.

6BTNS1:
IFN ITS+D10,[
	SKIPN TT,(TT)		;A ZERO WORD GETS OUTPUT AS "*"
	 MOVE TT,DFNWD
6BTNS2:	SETZ T,
	LSHC T,6
	JUMPE T,6BTNS3
10$	CAIE T,133-40		;FOR DEC-10, BRACKETS MUST
10$	 CAIN T,135-40		; BE QUOTED
10$	  JRST 6BTNS3
	CAIE T,':
10%	 CAIN T,';
10$	 CAIN T,'.
6BTNS3:	  IDPB R,C		;^Q TO QUOTE FUNNY CHARS
	ADDI T,40
	IDPB T,C
	JUMPN TT,6BTNS2
	POPJ P,
]		;END OF IFN ITS+D10
IFN D20,[
	SKIPN (TT)
	 MOVEI TT,DFNWD
	SETZ D,
	HRLI TT,440700
6BTNS2:	ILDB T,TT
	JUMPE T,CPOPJ
	TRZE D,1		;D IS THE PRECEDING-CHAR-WAS-^V FLAG
	 JRST 6BTNS3
IRPC X,,[:;<>=_*@ ,]		;EVEN NUMBER OF GOODIES!
IFE .IRPCNT&1,	CAIE T,"X
.ELSE,[
	CAIN T,"X
	 IDPB R,C		;QUOTE FUNNY CHARACTER
]		;END OF .ELSE
TERMIN
	SKIPE TENEXP
	 JRST 6BNS3A
				;TOPS-20 Requires more characters to be quoted
IRPC X,,[(){}/!"#%&'\|`^~]
IFE .IRPCNT&1,	CAIE T,"X
.ELSE,[
	CAIN T,"X
	 IDPB R,C		;QUOTE FUNNY CHARACTER
]		;END OF .ELSE
TERMIN
	CAIE T,91.		;LEFT-SQUARE-BRACKET
	 CAIN T,93.		;RIGHT-SQUARE-BRACKET
	  IDPB R,C
6BNS3A:	CAIN T,(R)		;REMEMBER A ^V
	 TRO D,1
6BTNS3:	IDPB T,C
	JRST 6BTNS2
]		;END OF IFN D20

IFN D10,[
;;; CONVERT ONE HALF OF A PPN, PUTTING ASCII CHARS IN PNBUF

6BTNS6:	JUMPE TT,6BNS6A
	CAME TT,[-1,,]
	 AOJA TT,6BTNS7		;ADDING ONE PRODUCES A FLAG BIT
6BNS6A:	MOVEI TT,"*		;AN OMITTED HALF IS OUTPUT AS "*"
	IDPB TT,C
	POPJ P,

6BNS7A:	LSH TT,3+3*SAIL		;ZERO-SUPPRESS OCTAL (TOPS10/CMU), LEFT-JUSTIFY CHARS (SAIL)
6BTNS7:	TLNN TT,770000_<3*<1-SAIL>>
	 JRST 6BNS7A		;NOTE THAT THE FLAG BIT GETS SHIFTED TOO
6BNS7B:	SETZ T,
	LSHC T,3+3*SAIL
SA%	ADDI T,"0
SA$	ADDI T,40
	IDPB T,C
	TRNE TT,-1		;WE'RE DONE WHEN THE FLAG BIT LEAVES THE RIGHT HALF
	 JRST 6BNS7B
	POPJ P,

]		;END OF IFN D10

SUBTTL	CONVERSION: NAMESTRING => SIXBIT

;;; THIS ONE IS PRETTY HAIRY.  IT CONVERTS AN ATOMIC
;;; SYMBOL IN A, REPRESENTING A FILE SPECIFICATION,
;;; INTO "SIXBIT" FORMAT ON FXP.  THIS INVOLVES
;;; PARSING A FILE NAME IN STANDARD ASCII STRING FORMAT
;;; AS DEFINED BY THE HOST OPERATING SYSTEM.
;;; FOR D20, THE OPERATING SYSTEM GIVES US SOME HELP.
;;; FOR ITS AND D10, WE ARE ON OUR OWN.

IFN ITS+D10,[

;;; THE GENERAL STRATEGY HERE IS TO CALL PRINTA TO EXPLODEC THE NAMESTRING.
;;; A PARSING COROUTINE TAKES THE SUCCESSIVE CHARACTERS AND INTERPRETS THEM.
;;; EACH COMPONENT IS ASSEMBLED IN SIXBIT FORM, AND WHEN IT IS TERMINATED
;;; BY A BREAK CHARACTER, IT IS PUT INTO ONE OF FOUR SLOTS RESERVED ON FXP.
;;; FOR CMU, WE ALSO ASSEMBLE THE CHARACTERS INTO PNBUF IN ASCII FORM,
;;; SO THAT WE CAN USE THE CMUDEC UUO TO CONVERT A CMU-STYLE PPN.
;;; AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME.
;;; AR2A HOLDS MANY FLAGS DESCRIBING THE STATE OF THE PARSE:
NMS==:1,,525252			;FOR BIT-TYPEOUT MODE
	NMS.CQ==:1	;CONTROL-Q SEEN
	NMS.CA==:2	;CONTROL-A SEEN
IFN D10,[
	NMS.DV==:10	;DEVICE SEEN (AND TERMINATING :)
	NMS.FN==:20	;FILE NAME SEEN
	NMS.DT==:40	;. SEEN
	NMS.XT==:100	;EXTENSION SEEN
	NMS.LB==:200	;LEFT BRACKET SEEN
	NMS.CM==:400	;COMMA SEEN
	NMS.RB==:1000	;RIGHT BRACKET SEEN
	NMS.ND==:10000	;NON-OCTAL-DIGIT SEEN
	NMS.ST==:20000	;* SEEN
]		;END OF IFN D10
;;; CONTROL-A IS THE SAIL CONVENTION FOR QUOTING MANY CHARACTERS, BUT WE
;;; ADOPT IT FOR ALL ITS AND D10 SYSTEMS.


NMS6BF:	POP P,A
	POPI FXP,L.F6BT+1+1
NMS6B0:	WTA [BAD NAMESTRING!]
NMS6BT:	MOVEI TT,(A)		;DON'T ALLOW FIXNUMS AS NAMESTRINGS
	LSH TT,-SEGLOG
	MOVSI R,FX
	TDNE R,ST(TT)		;A FIXNUM?
	 JRST NMS6B0		;YES, ILLEGAL AS A NAMESTRING
	PUSH P,A
	PUSHN FXP,L.F6BT+1	;FOUR WORDS FOR FINISHED NAMES, ONE FOR ACCUMULATION
	MOVEI AR1,(FXP)		;AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME
	HRLI AR1,440600
	PUSH FXP,PNBP		;PARSE THE PPN INTO PNBUF
	SETZM PNBUF+LPNBUF-1
	SETZ AR2A,		;ALL FLAGS INITIALLY OFF
	HRROI R,NMS6B1		.SEE PR.PRC
	PUSHJ P,PRINTA		;PRINTA WILL CALL NMS6B1 WITH SUCCESSIVE CHARS IN A
	TLNE AR2A,NMS.CA+NMS.CQ
	 JRST NMS6BF		;ILLEGAL FOR A QUOTE TO BE HANGING
	MOVEI A,40
	PUSHJ P,(R)		;FORCE A SPACE THROUGH TO TERMINATE LAST COMPONENT
IFN D10,[
	TLNE AR2A,NMS.LB
	 TLNE AR2A,NMS.RB
	  CAIA
	   JRST NMS6BF		;LOSE IF LEFT BRACKET SEEN BUT NO RIGHT BRACKET
]		;END OF IFN D10
	JUMPE AR1,NMS6BF	;AR1 IS ZEROED IF THE PARSING CORUTINE DETECTS AN ERROR
	POP P,A
	POPI FXP,2
	MOVE T,DFNWD		;CHANGE ANY ZERO COMPONENTS TO "*"
	SKIPN -3(FXP)
	 MOVEM T,-3(FXP)	;DEVICE NAME
IT$	SKIPN -2(FXP)
IT$	 MOVEM T,-2(FXP)	;SNAME
IFN D10,[
	MOVE TT,-2(FXP)		;TREAT HALVES OF PPN SEPARATELY
	TLNN TT,-1		;A ZERO HALF BECOMES -1
	 TLO TT,-1
	TRNN TT,-1
	 TRO TT,-1
	MOVEM TT,-2(FXP)
]		;END OF IFN D10
	SKIPN -1(FXP)
	 MOVEM T,-1(FXP)	;FILE NAME 1
SA$	MOVSI T,(SIXBIT \___\)
	SKIPN (FXP)
	 MOVEM T,(FXP)		;FILE NAME 2/EXTENSION
	POPJ P,

;;; THIS IS THE NAMESTRING PARSING COROUTINE

NMS6B1:	JUMPE AR1,CPOPJ		;ERROR HAS BEEN DETECTED, FORGET THIS CHARACTER
	CAIN A,^A
	 JRST NMS6BQ
	CAIN A,^Q
	 TLCE AR2A,NMS.CQ	;FOR A CONTROL-Q, SET THE CONTROL-Q BIT
	  CAIA			;IF IT WAS ALREADY SET, IT'S A QUOTED ^Q
	   POPJ P,		;OTHERWISE EXIT
	CAIN A,40		;SPACE?
	 TLZN AR2A,NMS.CQ	;YES, QUOTED?
	  SKIPA			;NO TO EITHER TEST
	   JRST NMS6B9		;YES TO BOTH, IS QUOTED SPACE
	CAILE A,40		;SKIP OF CONTROL CHARACTER OR SPACE
	 JRST NMS6B7
;WE HAVE ENCOUNTERED A BREAK CHARACTER - DECIDE WHAT TO DO WITH COMPONENT
NMS6B8:	SKIPN D,(AR1)
	 POPJ P,		;NO CHARACTERS ASSEMBLED YET
IT$	SKIPN -2(AR1)		;IF WE HAVE A FILE NAME 1, THIS MUST BE FN2
10$	TLNN AR2A,NMS.DT	;WE HAVE SEEN A DOT, THIS MUST BE THE EXTENSION
	 JRST NMS6B5		;OTHERWISE THIS IS FILE NAME 1
IT$	SKIPE -1(AR1)		;LOSE IF WE ALREADY HAVE A FILE NAME 2
10$	TLNE AR2A,NMS.XT+NMS.LB+NMS.CM+NMS.RB
	 JRST NMS6BL		;LOSE IF EXTENSION AFTER BRACKETS OR OTHER ONE
IT$	MOVEM D,-1(AR1)
10$	HLLZM D,-1(AR1)
10$	TLO AR2A,NMS.XT		;SET FLAG: WE'VE SEEN THE EXTENSION
;COME HERE TO RESTORE THE BYTE POINTER FOR THE NEXT COMPONENT
NMS6B6:	JUMPE AR1,CPOPJ		;IF AN ERROR HAS BEEN DETECTED, EXIT
	HRLI AR1,440600
	MOVE D,PNBP		;RESET THE PNBUF BYTE POINTER ALSO
	MOVEM D,1(AR1)
10$	TLZ AR2A,NMS.ND+NMS.ST	;RESET NON-OCTAL-DIGIT AND STAR SEEN FLAGS
	SETZM (AR1)		;CLEAR ACCUMULATION WORD
	POPJ P,

;COME HERE FOR FILE NAME 1
NMS6B5:
10$	TLNE AR2A,NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
10$	 JRST NMS6BL		;LOSE IF TOO LATE FOR A FILE NAME
	MOVEM D,-2(AR1)		;SAVE FILE NAME 1
	JRST NMS6B6

;HERE WITH A NON-CONTROL NON-SPACE CHARACTER
NMS6B7:	TLZN AR2A,NMS.CQ
	 TLNE AR1,NMS.CA
	  JRST NMS6B9		;IF CHARACTER QUOTED (FOR ^Q, FLAG IS RESET)
	CAIN A,":
	 JRST NMS6DV		;: SIGNALS A DEVICE NAME
IT$	CAIN A,";
IT$	 JRST NMS6SN		;; MEANS AN SNAME
IFN D10,[
	CAIN A,".
	 JRST NMS6PD		;PERIOD MEANS TERMINATION OF FILE NAME
	CAIN A,133
	 JRST NMS6LB		;LEFT BRACKET
	CAIN A,",
	 JRST NMS6CM		;COMMA
	CAIN A,135
	 JRST NMS6RB		;RIGHT BRACKET
	CAIN A,"*
	 JRST NMS6ST		;STAR
]		;END OF IFN D10
;HERE TO DUMP A CHARACTER INTO THE ACCUMULATING COMPONENT
NMS6B9:
IFN D10,[
IFE SAIL,[
	SKIPN CMUP
	 JRST .+4
	  SKIPE PNBUF+LPNBUF-1
	   TDZA AR1,AR1		;ASSUME A COMPONENT THAT FILLS PNBUF IS A LOSER
	    IDPB A,1(AR1)	;STICK ASCII CHARACTER IN PNBUF
]	;END OF IFE SAIIL
	CAIL A,"0
	 CAILE A,"7
	  TLO AR2A,NMS.ND	;SET FLAG IF NON-OCTAL-DIGIT
NMS6B4:
]		;END OF IFN D10
	CAIGE A,140		;CONVERT LOWER CASE TO UPPER,
	 SUBI A,40		; AND ASCII TO SIXBIT
	TLNE AR1,770000
	 IDPB A,AR1		;DUMP CHARACTER INTO ACCUMULATING NAME
	POPJ P,

NMS6BQ:	TLCA AR2A,NMS.CA	;COMPLEMENT CONTROL-A FLAG
NMS6BL:	 SETZ AR1,		;ZEROING AR1 INDICATES A PARSE ERROR
	POPJ P,

NMS6DV:	SKIPE D,(AR1)		;ERROR IF : SEEN WITH NO PRECEDING COMPONENT
10$				;ERROR AFTER OTHER CRUD
10$	 TLNE AR2A,NMS.DV+NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
10%	 SKIPE -4(AR1)		;ERROR IF DEVICE NAME ALREADY SEEN
	  JRST NMS6BL
	MOVEM D,-4(AR1)
10$	TLO AR2A,NMS.DV
	JRST NMS6B6		;RESET BYTE POINTER

IFN ITS,[
NMS6SN:	SKIPE D,(AR1)		;ERROR IF ; SEEN WITHOUT PRECEDING COMPONENT
	 SKIPE -3(AR1)		;ERROR IF WE ALREADY HAVE AN SNAME
	  JRST NMS6BL
	MOVEM D,-3(AR1)
	JRST NMS6B6		;RESET BYTE POINTER
]		;END OF IFN ITS

IFN D10,[
NMS6PD:	TLNE AR2A,NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
	 JRST NMS6BL
	PUSHJ P,NMS6B8		;DOT SEEN - SEE IF IT TERMINATED THE FILE NAME
	TLO AR2A,NMS.DT		;SET PERIOD (DOT) FLAG
	POPJ P,

NMS6LB:	TLNE AR2A,NMS.LB+NMS.CM+NMS.RB
	 JRST NMS6BL		;LEFT BRACKET ERROR IF ALREADY  A BRACKET 
	PUSHJ P,NMS6B8		;DID WE TERMINATE THE FILE NAME OR EXTENSION?
	TLO AR2A,NMS.LB		;SET LEFT BRACKET FLAG
NMS6L1:
SA%	HRLI AR1,440300
SA$	HRLI AR1,440600
	POPJ P,

NMS6CM:	LDB D,[360600,,AR1]
	CAIE D,44		;ERROR IF NO CHARACTERS AFTER LEFT BRACKET
	 TLNN AR2A,NMS.LB	;ERROR IF NO LEFT BRACKET!
	  JRST NMS6BL
SA%	TLNE AR2A,NMS.ND+NMS.CM+NMS.RB
SA$	TLNE AR2A,NMS.CM+NMS.RB
	 JRST NMS6BL		;ERROR IF NON-OCTAL-DIG, COMMA, OR RGT BRACKET
	PUSHJ P,NMS6PP		;HACK HALF A PPN
	JUMPE AR1,CPOPJ
	HRLM D,-3(AR1)
	TLO AR2A,NMS.CM		;SET COMMA FLAG
	SETZM (AR1)		;CLEAR COLLECTING WORD
	JRST NMS6L1		;RESET BYTE POINTER

NMS6RB:
	LDB D,[360600,,AR1]
SA%	SKIPN CMUP
	 TLNE AR2A,NMS.CM	;MUST HAVE COMMA BEFORE RB IN NON-CMU
	  CAIN D,44		;ERROR IF NO CHARS SINCE COMMA/LEFT BRACKET
	   JRST NMS6BL
	TLNE AR2A,NMS.LB	;ERROR IF NO LEFT BRACKET
	 TLNE AR2A,NMS.RB	;ERROR IF RIGHT BRACKET ALREADY SEEN
	  JRST NMS6BL
IFE SAIL,[
	SKIPN CMUP
	 JRST .+3
	  TLNN AR2A,NMS.CM	;FOR CMU, NO COMMA MEANS A CMU-STYLE PPN
	   JRST NMS6R1
]	;END OF IFE SAIL
	PUSHJ P,NMS6PP		;FIGURE OUT HALF A PPN
	JUMPE AR1,CPOPJ
	HRRM D,-3(AR1)
NMS6R2:	TLO AR2A,NMS.RB		;SET RIGHT BRACKET FLAG
	JRST NMS6B6		;RESET THE WORLD
IFE SAIL,[
NMS6R1:	MOVEI D,PNBUF
	CMUDEC D,		;CONVERT CMU-STYLE PPN TO A WORD
	 JRST NMS6BL		;LOSE LOSE
	MOVEM D,-3(AR1)		;WIN - SAVE IT AWAY
	JRST NMS6R2
]	;END OF IFE SAIL

NMS6ST:	TLOE AR2A,NMS.ST	;SET STAR FLAG, SKIP IF NOT ALREADY SET
	 TLO AR2A,NMS.ND	;TWO STARS = A NON-DIGIT FOR PPN PURPOSES
	JRST NMS6B4

NMS6PP:
SA%	TLNE AR2A,NMS.ND
SA%	 SETZ AR1,		;NON-DIGIT IN PPN IS AN ERROR
	HRRZI D,-1
	TLNE AR2A,NMS.ST	;STAR => 777777
	 POPJ P,
	LDB TT,[360600,,AR1]
	CAIGE TT,22
	 SETZ AR1,		;MORE THAN SIX DIGITS LOSES
	MOVNS TT
	MOVE D,(AR1)
	LSH D,(TT)		;RIGHT-JUSTIFY THE DIGITS
	POPJ P,
]		;END OF IFN D10

]		;END OF IFN ITS+D10

IFN D20,[

;; Formerly, NMS6BT used to call JFN6BT
;NMS6BA:	MOVE A,AR1
NMS6B0:	%WTA (T)
NMS6BT:	MOVEI T,NMSERR
	MOVEI TT,(A)		;DON'T ALLOW FIXNUMS AS NAMESTRINGS
	LSH TT,-SEGLOG
	MOVSI R,FX
	TDNE R,ST(TT)		;A FIXNUM?
	 JRST NMS6B0		;YES, ILLEGAL AS A NAMESTRING
	PUSHJ P,PNBFMK		;STRING OUT CHARACTERS INTO PNBUF
	MOVEI T,[SIXBIT \NAMESTRING TOO LONG!\]
	JUMPE AR2A,NMS6B0	;LOSE IF DIDN'T FIT IN PNBUF
	SETZ B,
	IDPB B,AR1		;TERMINATE STRING WITH A NULL (ZERO) BYTE
	MOVE AR1,A		;SAVE ORIGINAL ARG IN CASE OF ERROR

;;; THE STRATEGY FOR TENEX IS TO JUST PARSE THE STRING BY HAND, SINCE
;;; PARSE-ONLY GTJFN DOESN'T WORK

NMSTNX:	PUSHN FXP,L.F6BT	;PUSH APPROPRIATE NUMBER OF WORDS FOR ASCIZ
	MOVE T,DFNWD		;INITIALIZE FIELDS TO '*' IF NOT SUPPLIED
	MOVEM T,-L.F6BT+1(FXP)				    ;DEVICE
	MOVEM T,-L.F6BT+L.6DEV+1(FXP)    		    ;DIRECTORY
	MOVEM T,-L.F6BT+L.6DEV+L.6DIR+1(FXP)		    ;FILE NAME
	MOVEM T,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+1(FXP)	    ;EXTENSION
	MOVEM T,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+L.6EXT+1(FXP)  ;VERSION NUMBER?
	MOVE TT,PNBP		;BYTE POINTER INTO STRING TO BE PARSED
	LDB A,[350700,,PNBUF]	;GET FIRST BYTE
	SKIPE TENEXP
	 CAIE A,";		;CHECK FOR ILLEGAL START OF NAMESTRING
	  CAIN A,".
	   JRST NMSTX2
	CAIN A,":
	 JRST NMSTX2
	CAIN A,"<		;START OF DIRECTORY FIELD?
	 JRST NMSTX1		;YES, DEFAULT DEVICE AND GO ON
	MOVE T,TT		;LOOK FOR FIRST DELIMETER
NMSTX6:	ILDB A,T		;GET NEXT CHARACTER
	CAIE A,^V		;QUOTING CHARACTER
	 JRST NMSTX5
	IBP T			;NEXT CHARACTER IS NOT DELIMITER
	JRST NMSTX6

NMSTX5:	JUMPE A,NMSTX4		;TREAT UNDELIMITED STRING AS A NAME ONLY
	SKIPE TENEXP
	 CAIE A,";		;
	  CAIN A,".		;FILENAME?
	   JRST NMSTX4		;YES, COPY FILENAME
	CAIE A,":		;DEVICE?
	 JRST NMSTX6		;NOPE, NOT A DELIMITER, TRY NEXT CHARACTER
	MOVEI R,-L.F6BT+1(FXP)	;POINTER TO DEVICE NAME
	HRLI R,440700
NMSTX8:	ILDB A,TT		;GET NEXT BYTE
	CAMN T,TT		;DEVICE COPY DONE WHEN WE PICKED UP DELIMETER
	 JRST NMSTX7		;TRY FOR NEXT FIELD
	IDPB A,R
	JRST NMSTX8

NMSTX1:	IBP TT			;SKIP OVER DIRECTORY START
	MOVEI R,-L.F6BT+L.6DEV+1(FXP)
	HRLI R,440700		;BYTE POINTER TO DIRECTORY
NMSTXE:	ILDB A,TT		;GET NEXT BYTE
	JUMPE A,NMSTX2
	CAIN A,">		;END OF DIRECTORY?
	 JRST NMSTX4		;YES, MUST HAVE FILENAME THEN
	IDPB A,R
	CAIE A,^V		;QUOTING NEXT CHAR?
	 JRST NMSTXE		;NOPE
	ILDB A,TT
	IDPB A,R
	JRST NMSTXE

NMSTX7:	MOVE A,TT		;COPY BYTE POINTER
	ILDB A,A		;GET NEXT BYTE OF PATHNAME
	CAIN A,"<		;DIRECTORY?
	 JRST NMSTX1		;YES, COPY IT
	SKIPE TENEXP
	 CAIE A,";		;AN ILLEGAL DELIMETER?
	  CAIN A,".
	   JRST NMSTX2
;;; HERE FOR A FILENAME
NMSTX4:	MOVEI R,-L.F6BT+L.6DEV+L.6DIR+1(FXP)
	HRLI R,440700		;BYTE POINTER TO FILENAME FIELD
NMSTXC:	ILDB A,TT		;GET NEXT SOURCE BYTE
	JUMPE A,NMSTX9		;DONE WITH STRING, DEFAULT AND RETURN
	CAIN A,".
	 JRST NMSTXA		;START ON EXTENSION
	SKIPN TENEXP
	 JRST .+3
	  CAIN A,";
	   JRST NMSTXB		;START ON VERSION
	IDPB A,R		;ELSE STORE CHARACTER
	CAIE A,^V		;QUOTING CHARACTER?
	 JRST NMSTXC		;NOPE, LOOP FOR MORE
	ILDB A,TT		;UNCONDITIONALLY SNARF NEXT CHARACTER
	IDPB A,R
	JRST NMSTXC

NMSTXA:	MOVEI R,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+1(FXP)
	HRLI R,440700		;BYTE POINTER TO EXTENSION
NMSTXD:	ILDB A,TT
	JUMPE A,NMSTX9		;DONE, DEFAULT AND RETURN
	CAIE A,".		;VERSION NUMBER LEADIN?
	 CAIN A,";
	  JRST NMSTXB		;YES, HACK THE VERSION
	IDPB A,R		;ELSE STORE THE CHARACTER OF THE EXTENSION
	CAIE A,^V
	 JRST NMSTXD
	ILDB A,TT
	IDPB A,R
	JRST NMSTXD

NMSTXB:	MOVEI R,-L.F6BT+L.6DEV+L.6DIR+L.6FNM+L.6EXT+1(FXP)
	HRLI R,440700		;BYTE POINTER TO VERSION NUMBER
	SETZM (R)
NMSTXF:	ILDB A,TT		;GET NEXT BYTE
	CAIG A,"9		;IF NOT A LEGAL NUMBER, THEN FINISH UP
	 CAIGE A,"0
	  JRST NMSTX9
	IDPB A,R
	JRST NMSTXF

NMSTX9:	POPJ P,

NMSERR:	SIXBIT \CAN'T PARSE AS FILE NAMESTRING!\

NMSTX2:	POPI FXP,L.F6BT		;Invalid string for TENEX namestring parsing
	MOVEI T,NMSERR		; so pop off filename and merge into error
	JRST NMS6B0


;; 6BT Translate Logical Name
;;  if "sixbit" format is on FXP, then translate it for logical names
;; Should preserve AR1 -- see DELETEF
6BTTLN:	SKIPE TENEXP
	 POPJ P,
	HRROI 2,-L.F6BT+1(FXP)
	MOVSI 3,(ASCII /PS/)
	CAMN 3,(2)
	 POPJ P,
	LOCKI			;LOCK OUT INTERRUPTS (BECAUSE OF JSYS'S)
	MOVEI 1,.LNSJB		;WHAT IF "DEVICE" IS REALLY A LOGICAL NAME?
BG$	HRROI 3,VETBL0		;We need a "waste basket", so why not use
BG%	MOVEI 3,.NULIO		; the bignum temporaries?
	LNMST
	 JRST .+2
	  JRST 6BTLN1
	MOVEI 1,.LNSSY
	HRROI 2,-L.F6BT+1-1(FXP)
BG$	HRROI 3,VETBL0		;We need a "waste basket", so why not use
BG%	MOVEI 3,.NULIO		; the bignum temporaries?
	LNMST
	 JRST NMS6XUNLK		; WELL, IT ISN'T A LOGICAL NAME!
6BTLN1:	SETZM -L.F6BT+1-1+L.6DEV(FXP)
;; but if it is a logical name, we flush the directory-name component!	
NMS6XUNLK:		;A "WRAP UP", WHICH MIGHT NEED TO CLEAR OUT JSYS STUFF
	SETZB 1,2	; FROM ACC 1 AND 2.
	JRST UNLKPJ

;; This used to be the entry to JFN6BT from NMS6BT
;	MOVEI T,[SIXBIT \GTJFN FAILED IN NAMESTRING!\]
;	MOVSI A,(GJ%ACC+GJ%FLG+GJ%OLD+GJ%SHT)
;	MOVE 2,PNBP
;	GTJFN			;GET A JFN FOR PARSED NAMESTRING
;	 JRST NMS6XUNLK		; PRESUMABLY, THE COMPONENTS CANT BE "TOO LONG"
;	POP FXP,F
;	POPI FXP,L.F6BT		;THROW AWAY STUFF CALCULATED BY NMSTNX.
;	TDZA R,R		;CONVERT JFN IN 1 TO "SIXBIT" ON FXP
;	PUSH FXP,F

JFN6BT:
;COME IN LOCKED, EXIT UNLOCKED.  ON SUCCESS, HAS STACKED UP ON FXP THE GOODIES
;Formerly, NMS6BT used to call JFN6BT, and R=0 => NMS6BT
;	 MOVEI R,1		; SKIP ON FAILURE
	POP FXP,F		;LOCKI WORD IS NOW IN F
	MOVE D,FXP		.SEE TRUENAME	
	MOVE 2,1		;"INDEXABLE FILE HANDLE" RETURNED BY GTJFN
	SETZM PNBUF
	MOVE T,[PNBUF,,PNBUF+1]
	BLT T,PNBUF+LPNBUF-1
	PUSHJ P,JFN6BB		;INITIALIZE PNBUF AN AC 1
	.SEE JS%DEV JS%DIR JS%NAM JS%TYP JS%GEN
JS%OUT==:<.JSAOF*111111111111>
	MOVSI 3,(JS%DEV&JS%OUT)
	JFNS
	 ERJMP JFN6BY		;IF ERROR THEN TRY DEVST
	MOVNI T,L.6DEV		;STACK UP DEVICE FIELD ON FXP, AND
	PUSHJ P,JFN6BA		;ZERO PNBUF, SETUP 1
IRP LEN,,[L.6DIR,L.6FNM,L.6EXT]FLD,,[DIR,NAM,TYP]
	MOVSI 3,(JS%!FLD&JS%OUT)
	JFNS				;GET ASCIZ STRING FOR NEXT COMPONENT 
	MOVNI T,LEN		;STACK UP ONE FIELD ON FXP, AND
	PUSHJ P,JFN6BA		;ZERO PNBUF, SETUP 1
TERMIN
	MOVSI 3,(JS%GEN&JS%OUT)
	JFNS				;GET ASCIZ STRING FOR VERSION NUMBER
	SKIPN T,PNBUF
	 JRST JFN6BC
	CAME 1,[010700,,PNBUF]
	 JRST .+2
	  SETZ T,
JFN6BC:	SKIPN T
	 MOVE T,DFNWD
	PUSH FXP,T			;STACK UP THE FEW WORDS OF "VERSION"
	REPEAT L.6VRS-1, PUSH FXP,PNBUF+1+.RPCNT
JFN6BX:	PUSH FXP,F			;PUSH LOCKI WORD BACK
	JRST UNLKPJ			; and exit without skip, to signal WIN

;;This used to be the exiting for NMS6BT
;JFN6BX:	PUSH FXP,F			;PUSH LOCKI WORD BACKn
;	JUMPN R,JFN6BU			;NON-ZERO ==> ENTRY FROM TRUENAME ETC
;	 MOVEI 1,(2)
;	 RLJFN				;RELEASE THE JFN FOR NMS6BT
;	 JSP T,RLJLUZ
;JFN6BU:	UNLKPOPJ



JFN6BY:	MOVEI T,[SIXBIT \DEVICE FAILURE IN NAMESTRING!\]
	CAIE 2,.PRIIN		;PRIMARY INPUT?
	 CAIN 2,.PRIOU		;OR PRIMARY OUTPUT
	  SKIPA			;YES
	   JRST [ MOVE FXP,D		;NOPE, FAIL;  SO FLUSH FXPDL CRUD
		  PUSH FXP,F		; AND PUSH LOCKI WORD BACK
;;FOR NMS6BT, GO GIVE WTA ERROR
;		  JUMPE R,[ SETZB 1,2	;ERROR ENCOUNTERED WHILE JSYS'S ARE 
;			    UNLOCKI	; TRYING TO PARSE TOPS-20 NAMESTRING
;			    JRST NMS6BA ]
		  AOS (P)		;FOR JFN6BT, SKIP ON FAILURE
		  UNLKPOPJ ]
	PUSH FXP,[ASCII/PRIMA/]
	PUSH FXP,[ASCIZ/RY/]
	PUSHN FXP,L.F6BT-2
		;\<<L.6DEV-2>+L.6DIR+L.6FNM+L.6EXT+L.6VRS>
	JRST JFN6BX

RLJLUZ:	LERR [SIXBIT \A "RLJFN" HAS LOST SOMEWHERE!\]


;;; SUBROUTINE TO "ADD" ONE ITEM OF INFORMATION TO THE FORMING SIXBIT
JFN6BA:	HRLS T
	HRRI T,PNBUF
	PUSH FXP,(T)		;STACK UP PNBUF, TO LIMIT GIVEN IN T
	AOBJN T,.-1
JFN6BB:	MOVE 1,PNBP		;STRING PTR FOR NEXT CALL TO JNFS
	MOVNI T,LPNBUF
	SKIPN PNBUF+LPNBUF(T)
	 POPJ P,
	SETZM PNBUF+LPNBUF(T)	;CLEAR OUT PNBUF
	AOJL T,.-3
	POPJ P,



]		;END OF IFN D20

SUBTTL	CONVERSION: ANY FILE SPEC => SIXBIT

;;; TAKE ARGUMENT IN A (MAY BE FILE ARRAY, NAMELIST,
;;; OR NAMESTRING), FIGURE IT OUT AND SOMEHOW RETURN
;;; "SIXBIT" FORMAT ON FXP.
;;; IFL6BT SAYS THAT T MEANS TTY INPUT, NOT TTY OUTPUT.

;;; SAVES C AR1 AR2A

IFL6BT:	CAIN A,TRUTH
	 HRRZ A,V%TYI
	JRST FIL6B0
IFN SFA,[
FILSFA:	MOVEI B,QNAMELIST	;EXTRACT THE "FILENAME" FROM THE SFA
	SETZ C,			;NO ARGS
	PUSHJ P,ISTCSH		;SHORT CALL, THEN USE RESULT AS NEW NAME
]		;END IFN SFA

FIL6BT:	CAIN A,TRUTH		;SHOULD PRESERVE AR1 -- SEE DELETEF
	 HRRZ A,V%TYO
FIL6B0:	SKIPN A			;NIL => USE "DEFAULTF"
FIL6DF:	 HRRZ A,VDEFAULTF	;USE "DEFAULTF"
FIL6B1:	MOVEI T,[SIXBIT \INCOMPREHENSIBLE FILE NAME!\]
	MOVEI R,(A)
	LSH R,-SEGLOG
	SKIPGE R,ST(R)		;LIST => NAMELIST
	 JRST NMH6BT		; OR POSSIBLY "NAMESTRING" AS A USER HUNK
	TLNN R,SA
	 JRST FIL6B2		;NOT ARRAY => NAMESTRING
	MOVE R,ASAR(A)
SFA$	TLNE R,AS.SFA		;AN SFA?
SFA$	 JRST FILSFA		;YES, EXTRACT NAME FROM IT AND TRY AGAIN
	TLNN R,AS<JOB+FIL>
	 JRST NMS6B0		;INCOMPREHENSIBLE NAMESTRING
	LOCKI			;FOR FILE, GOBBLE NAMES OUT OF FILE OBJECT
	POP FXP,D		;POP LOCKI WORD
	MOVE TT,TTSAR(A)
	ADDI TT,F.DEV
	HRLI TT,-L.F6BT
	PUSH FXP,(TT)		;PUSH ALL WORDS OF FILE SPEC
	AOBJN TT,.-1
	PUSH FXP,D		;PUSH BACK LOCKI WORD
	UNLKPOPJ		;UNLOCK AND EXIT

FIL6B2:	JUMPE A,NML6BT		;FOO () IS ALWAYS A SPECIAL CASE!
	TLNN R,SY
	 JRST NMS6B0
	JSP T,QIOSAV		;A SYMBOL IS A NAMESTRING.
	JRST NMS6BT

NMH6BT:	TLNN R,ST.HNK
	 JRST NML6BT
	JSP T,QIOSAV
	PUSHJ P,USRHNP		;find out if this is a user's hunk
	JUMPE T,NMS6B0		;LOSE IF HUNK, BUT NOT "EXTEND"
	PUSH P,[NMS6BT]
	PUSH P,A
	PUSH P,[QNAMESTRING]
	MOVNI T,2
	XCT SENDI

QIOSAV:	SOVE B C AR1 AR2A
	PUSHJ P,(T)
	RSTR AR2A AR1 C B
	POPJ P,
LQIOSV==5			; 5 THINGS - 4 AC'S AND ONE RET ADDR
.SEE 6BTNS8			;RELIES ON AC C BEING SAVED IN CERTAIN SPOT


SUBTTL	MERGEF, TRUENAME, PROBEF AND MERGING ROUTINES

;;; MERGEF TAKES TWO FILE SPECS OF ANY KIND, MERGES THEM,
;;; AND RETURNS A NAMELIST OF THE RESULTING SPECS.
;;; AS A CROCK, (MERGEF X '*) SIMPLY MAKES THE SECOND FILE NAME BE *.
;;;   (FOR D20, THE VERSION BECOMES NULL)

MERGEF:	PUSH P,B
	PUSHJ P,FIL6BT
	POP P,A
	CAIE A,Q.
	 JRST MRGF1
20%	MOVE T,DFNWD
20%	MOVEM T,(FXP)
20$ REPEAT L.6VRS,	SETZM -.RPCNT(FXP)
	JRST 6BTNML

MRGF1:	PUSHJ P,FIL6BT
	PUSHJ P,IMRGF
	JRST 6BTNML

;;; IMRGF MERGES TWO SETS OF SPECS ON THE FIXNUM PDL.
;;; DMRGF MERGES A SET WITH THE DEFAULT FILE NAMES.
;;; DEC-10 PPN'S MERGE HALVES OF THE PPN SEPARATELY;
;;; AN UNSPECIFIED HALF IS -1 OR 0, *NOT* (SIXBIT \*\)!!
;;; SAVES F (SEE LOAD).

DMRGF:
;SHOULD PRESERVE AR1 -- SEE DELETEF
;FIRST SEE WHETHER WE REALLY NEED TO CONVERT THE DEFAULTS TO "SIXBIT"
IFN ITS+D10,[
	MOVE TT,DFNWD
REPEAT L.F6BT,[
IFN ITS\<.RPCNT-1>,[
	CAME TT,.RPCNT-3(FXP)	;MUST MERGE IF FILE NAME IS ZERO OR *
	 SKIPN .RPCNT-3(FXP)
	  JRST DMRGF5
]		;END OF IFN ITS\<.RPCNT-1>
.ELSE,[
	MOVE T,.RPCNT-3(FXP)
	AOJE T,DMRGF7
	SOJE T,DMRGF7
	TRNE T,-1
	 TRNN T,-1
	  JRST DMRGF5
	 SKIPA
DMRGF7:	SETZM .RPCNT-3(FXP)	
]		;END OF .ELSE
]		;END OF REPEAT L.F6BT
]		;END OF IFN ITS+D10
IFN D20,[
	MOVE TT,DFNWD
ZZZ==0
IRP FOO,,[L.6VRS,L.6EXT,L.6FNM,L.6DIR,L.6DEV]
ZZZ==ZZZ+FOO
	CAME TT,-ZZZ+1(FXP)
	 SKIPN -ZZZ+1(FXP)
	   JRST DMRGF5
TERMIN
EXPUNGE ZZZ
]		;END OF IFN D20
	POPJ P,			;MERGE WOULDN'T DO ANYTHING - FORGET IT

DMRGF5:	PUSH FLP,F		;MERGE WITH DEFAULT FILE NAMES
	HRRZ A,VDEFAULTF
	PUSHJ P,FIL6BT
	POP FLP,F
20% 	;JRST IMRGF
IFN D20,[
	PUSHJ P,IMRGF
	SKIPE TT,-L.F6BT+L.6DEV+1(FXP)
	 CAMN TT,DFNWD
	  JRST .+2
	   POPJ P,
	PUSH P,A
	JSP T,TNXUDI
	MOVEI D,-L.F6BT+L.6DEV+1(FXP)
	HRLI D,-L.6DIR
	MOVNI T,1		;Initialize pointer into PNBUF
DMRGF6:	AOJ T,			;Loop copying default directory onto FXP
	MOVE R,PNBUF(T)
	MOVEM R,(D)
	JUMPE R,POPAJ		;Terminate loop when no end of string
	AOBJN D,DMRGF6		; or when no more room
	JRST POPAJ

;;; CODE TO GET THE CONNECTED DIRECTORY NAME INTO THE PNBUF
TNXUDI:	MOVE TT,[PNBUF,,PNBUF+1]
	SETZM PNBUF		;CLEAR PNBUF
	BLT TT,PNBUF+LPNBUF-1
	LOCKI
	GJINF			;GET JOB INFORMATION
	MOVE 1,PNBP		;POINTER INTO PNBUF
	DIRST			;GET EQUIVALENT ASCII STRING
	 JRST TNXU9D		;HMM...
	MOVE 1,PNBP
TNXUD0:	 ILDB D,1		;SCAN DEVICE-NAME PART
	 CAIN D,0
	  JRST TNXUD2		;WIN! NOT PUNCTUATION ANYWAY!
	 CAIE D,^V
	 CAIE D,":
	  JRST TNXUD0
	ILDB D,1
	CAIE D,"<
	  JRST TNXU9P
	MOVE 2,PNBP
TNXUD3:	 ILDB D,1		;TRANSFER DIRECTORY-NAME PART
	 CAIN D,0
	  JRST TNXU9P
	 CAIE D,^V
	  JRST TNXUD5
	 IDPB D,2
	 ILDB D,1
TNXUD6:	 IDPB D,2
	 JRST TNXUD3
TNXUD5:	 CAIE D,">
	  JRST TNXUD6
	MOVEI D,0
	MOVEI A,9
	IDPB D,2		;PAD LIKE ASCIZ WITH AN EXTRA WORD OF 0'S
	SOJG A,.-1
TNXUD2:	SETZB 1,2
	UNLOCKI
	JRST (T)


TNXU9P: MOVE 1,[440700,,[ASCIZ \Punctuated string in PNBUF loses in TNXUDI\]]
	JRST TNXDIE
TNXU9D: SKIPA 1,[440700,,[ASCIZ \DIRST loses in TNXUDI\]]
TNXST9:	MOVE 1,[440700,,[ASCIZ \GETTAB loses in TNXSET\]]
TNXDIE:	PSOUT
	HALTF

]	;END OF IFN D20


IMRGF:  MOVE TT,DFNWD		;MERGE TWO SETS OF NAMES ON FXP,
				;  "POPPING" THE TOP ONE OFF
IFN ITS+D10,[
	MOVEI T,L.F6BT
MRGF2:
10$	MOVE R,D
	POP FXP,D
10$	CAIE T,2		;PPN IS PENULTIMATE FROB - DON'T COMPARE TO *
	 CAME TT,-3(FXP)
	  SKIPN -3(FXP)
	   MOVEM D,-3(FXP)
	SOJG T,MRGF2
IFN D10,[
	MOVE D,-2(FXP)		;R HAS PPN 2 - GET PPN 1 IN D
	AOJE D,MRGF3
	SOJE D,MRGF3
	TLNN D,-1
	 HLLM R,-2(FXP)
	TRNN D,-1
	 HRRM R,-2(FXP)
	SKIPA
MRGF3:	MOVEM R, -2(FXP)	;USED TO SETZM, BUT SEEMS WRONG - RPG
]		;END OF IFN D10
]		;END OF IFN ITS+D10
IFN D20,[
IRP FOO,,[VRS,EXT,FNM,DIR,DEV]
	CAME TT,-L.6!FOO-L.F6BT+1(FXP)
	 SKIPN -L.6!FOO-L.F6BT+1(FXP)
	   JRST IM!FOO!1
	POPI FXP,L.6!FOO
	JRST IM!FOO!2
IM!FOO!1:
IFLE L.6!FOO-3,	REPEAT L.6!FOO,	POP FXP,-L.F6BT(FXP)
.ELSE,[
	MOVEI T,L.6!FOO
	POP FXP,-L.F6BT(FXP)
	SOJG T,.-1
]		;END OF .ELSE
IM!FOO!2:
TERMIN
]		;END OF IFN D20
C6BTNML:	POPJ P,6BTNML
 
;;; (TRUENAME <FILE>) RETURNS THE RESULT OF .RCHST ON ITS,
;;; I.E. THE REAL FILE NAMES AFTER TRANSLATIONS, LINKS, ETC.
;;; THE RESULT IS A NAMELIST.

TRUNM9:	EXCH A,AR1
	%WTA NFILE
				   ;SUBR 1
TRUENAME:			   ;MUST SAVE AR1 - SEE PRNF6-PRNJ2
IFN SFA,[
	CAIN A,TRUTH		   ;T?
	  HRRZ A,V%TYO		   ;  Use TYO
	EXCH AR1,A
	JSP TT,XFOSP		;FILE OR SFA OR NOT?
	 JRST TRUNM9		;NOT
	 JRST TRUNMZ		;FILE
	EXCH A,AR1
	JSP T,QIOSAV
	MOVEI B,QTRUENAME
	SETZ C,			;NO THIRD ARG
	JRST ISTCSH		;SHORTY INTERNAL STREAM CALL
TRUNMZ:	EXCH A,AR1
]		;END IFN SFA
	PUSH P,C6BTNML

TRU6BT:	CAIN A,TRUTH
	 HRRZ A,V%TYO
TRUNM2:	EXCH AR1,A
	LOCKI
	JSP TT,XFILEP
	 JRST TRUNM8
	EXCH A,AR1
	HRRZ TT,TTSAR(A)
IFN ITS+D10,[
	POP FXP,T		;POP THE LOCKI WORD
	HRLI TT,-L.F6BT
	PUSH FXP,F.RDEV(TT)
	AOBJN TT,.-1
	PUSH FXP,T		;PUSH LOCKI WORD BACK
	UNLKPOPJ

]		;END OF ITS+D10
IFN D20,[			
	PUSH P,1
	MOVE 1,F.JFN(TT)
	PUSHJ P,JFN6BT		;GET "SIXBIT" ON FXP, AND UNLOCKI
	 JRST POPAJ		;  ON SUCCESS, LEAVES "SIXBIT" FORMS ON FXPDL
	POP P,1
	JRST TRUNM0
]		;END OF IFN D20

TRUNM8:	UNLOCKI
	EXCH AR1,A
TRUNM0:	%WTA NFILE		;NOT FILE
SFA$	MOVE T,C6BTNML		;IF NOT CALLED AS A SUBR, ONLY ACCEPT A FILE
SFA$	CAME T,(P)
	 JRST TRUNM2
SFA$	POPI P,1
SFA$	JRST TRUENAME

;;; (STATUS UREAD)

SUREAD:	SKIPN A,VUREAD
	 POPJ P,
	PUSHJ P,TRUENAME
	HLRZ B,(A)
	HRRZ A,(A)
	HRRZ C,(A)
20$	HRRZ C,(C)
20$	HRRM C,(A)
	HRRM B,(C)
	POPJ P,

;;; (STATUS UWRITE)

SUWRITE:	SKIPE A,VUWRITE
	PUSHJ P,TRUENAME
	JRST $CAR		;(CAR NIL) => NIL

;;; ROUTINE TO SET UP ARGS FOR TWO-ARGUMENT FILE FUNCTION.
;;; PUT TWO SETS OF FILE NAMES ON FXP.  IF THE ARGS ARE
;;; X AND Y, THEN THE NAMES ON FXP ARE (MERGEF X NIL) AND
;;; (MERGEF Y (MERGEF X NIL)).  THE FIRST ARG IS LEFT IN AR1.

2MERGE:	PUSH P,A
	PUSH P,B
	PUSHJ P,FIL6BT
	PUSHJ P,DMRGF
	POP P,A
	PUSHJ P,FIL6BT
	MOVEI T,L.F6BT
	PUSH FXP,-2*L.F6BT+1(FXP)
	SOJG T,.-1
	PUSHJ P,IMRGF		;NOW WE HAVE THE MERGED FILE SPECS
	POP P,AR1			;FIRST ARG
	POPJ P,


;;; (PROBEF X) TRIES TO DECIDE WHETHER FILE X EXISTS.
;;; ON ITS AND D10 THIS IS DONE BY TRYING TO OPEN THE FILE.
;;; ON D20 WE USE THE GTJFN JSYS.
;;; RETURNS REAL FILE NAMES ON SUCCESS, NIL ON FAILURE.

PROBEF:				;SUBR 1
	JSP T,QIOSAV
IFN SFA,[
	JSP TT,AFOSP		;DO WE HAVE AN SFA?
	 JRST PROBEZ		;NOPE
	 JRST PROBEZ		;NOPE
	MOVEI B,QPROBEF		;PROBEF OPERATION
	SETZ C,			;NO ARGS
	JRST ISTCSH		;SHORT CALL, RETURN RESULTS
PROBEZ:	]	;END IFN SFA
	PUSHJ P,FIL6BT
PROBF0:	PUSHJ P,DMRGF
IFN ITS,[
	LOCKI
	SETZ TT,		;ASSUME NO CONTROL ARG
	MOVSI T,'USR		;CHECK FOR USR DEVICE
	CAMN T,-3-1(FXP)	;MATCH?
	 TRO TT,10		;SET BIT 1.4 (INSIST ON EXISTING JOB)
	.CALL PROBF8
	 JRST PROBF6
	.CALL PROBF9
	 .LOSE 1400
	.CLOSE TMPC,
	UNLOCKI
]		;END OF IFN ITS
IFN D10,[
	LOCKI
	MOVEI T,.IODMP		;I/O MODE (DUMP MODE)
	MOVE TT,-3-1(FXP)	;DEVICE NAME
	SETZ D,
	OPEN TMPC,T
	 JRST PROBF6		;NO SUCH FILE IF NO SUCH DEVICE!
IFE SAIL,[
	MOVEI T,3		;ONLY NEED 3 ARGS OF EXTENDED LOOKUP
	MOVE D,-1-1(FXP)	;FILE NAME
	HLLZ R,0-1(FXP)		;EXTENSION
	MOVE TT,-2-1(FXP)	;PPN
]		;END IFE SAIL
IFN SAIL,[
	MOVE T,-1-1(FXP)	;FILE NAME
	HLLZ TT,0-1(FXP)	;EXTENSION
	CAMN TT,[SIXBIT \___\]
	 SETZ TT,
	SETZ D,			;UNUSED
	MOVE R,-2-1(FXP)	;PPN
]		;END IFN SAIL
	LOOKUP TMPC,T
	 JRST PROBF5		;FILE DOESN'T EXIST
	PUSHJ P,D10RFN		;READ BACK FILE NAMES
	RELEASE TMPC,		;RELEASE TEMP CHANNEL
	UNLOCKI
	JRST 6BTNML		;FORM NAMELIST ON SUCCESS

D10RFN:	MOVEI F,TMPC		;WE WILL GET DEVICE NAME FROM MONITOR
SA%	DEVNAM F,
SA$	PNAME F,
	 SKIPA			;NONE SO RETAIN OLD NAME
	  MOVEM F,-3-1(FXP)	;ELSE STORE NEW DEVICE NAME
IFE SAIL,[
	MOVEM TT,-2-1(FXP)	;STORE DATA AS RETURNED FROM EXTENDED LOOKUP
	MOVEM D,-1-1(FXP)
	HLLZM R,0-1(FXP)
]		;END IFE SAIL
IFN SAIL,[
	MOVEM T,-1-1(FXP)	;SAIL HAS NO EXTENDED LOOKUP!!!!!
	HLLZM TT,0-1(FXP)	; SO, WE CAN'T STORE PPN; JUST ASSUME IT IS
				; WHAT WE GAVE IT
]		;END IFN SAIL
	POPJ P,
]		;END OF IFN D10
IFN D20,[
	PUSHJ P,6BTTLS		;TRANSLATE LOGICAL NAME, AND STRING INTO PNBUF
	LOCKI
	MOVSI 1,(GJ%OLD+GJ%SHT)	.SEE .GJDEF
	MOVE 2,PNBP
	GTJFN			;GET A JFN (INSIST ON EXISTING FILE)
	 JRST UNLKFALSE
	PUSH FLP,1		;SAVE JFN OVER JFN6BT
	PUSHJ P,JFN6BT		;CONVERT JFN TO "SIXBIT" FORMAT ON FXP
	 TDZA B,B
	  MOVEI B,TRUTH		;JFN6BT SKIPS ON FAILURE
	POP FLP,1
	RLJFN			;RELEASE THE JFN
	 JSP T,RLJLUZ
	JUMPN B,FALSE
]		;END OF IFN D20

10%	JRST 6BTNML
				
IFN ITS+D10,[
10$ PROBF5:	RELEASE TMPC,
PROBF6:	UNLOCKI
	POPI FXP,L.F6BT		;POP "SIXBIT" CRUD FROM FXP
	JRST FALSE		;RETURN FALSE ON FAILURE
]		;END OF IFN ITS+D10

IFN ITS,[
PROBF8:	SETZ
	SIXBIT \OPEN\		;OPEN FILE (ASCII UNIT INPUT)
	  4000,,TT		;CONTROL ARG (DON'T CREATE BIT SET FOR USR)
	  1000,,TMPC		;CHANNEL #
	      ,,-3-1(FXP)	;DEVICE NAME
	      ,,-1-1(FXP)	;FILE NAME 1
	      ,,0-1(FXP)	;FILE NAME 2
	400000,,-2-1(FXP)	;SNAME

PROBF9:	SETZ
	SIXBIT \RFNAME\		;READ REAL FILE NAMES
	  1000,,TMPC		;CHANNEL #
	  2000,,-3-1(FXP)	;DEVICE NAME
	  2000,,-1-1(FXP)	;FILE NAME 1
	  2000,,0-1(FXP)	;FILE NAME 2
	402000,,-2-1(FXP)	;SNAME
]		;END OF IFN ITS

SUBTTL	RENAMEF FUNCTION, CNAMEF FUNCTION

;;; (RENAMEF X Y) RENAMES (MERGEF X (NAMELIST NIL)) TO BE
;;; (MERGEF Y (MERGEF X (NAMELIST NIL))).
;;; IF X IS AN OUTPUT FILE ARRAY, IT IS RENAMED AND CLOSED.

$RENAMEF:
IFN SFA,[
	JSP TT,AFOSP		;SKIP IF FILE OR SFA
	  JRST $RENM0
	  JRST $RENM0		;A FILE, NOT AN SFA
	MOVEI C,(B)		;FILENAME TO RENAME TO
	MOVEI B,Q$RENAME	;A RENAME OPERATION
	JRST ISTCSH		;FAST INTERNAL SFA-CALL
$RENM0:
] ; END OF IFN SFA,

	PUSHJ P,2MERGE		;2MERGE LEAVES ARG 1 IN AR1
	HLLOS NOQUIT
20$	PUSHJ P,6BTTLN		;TRANSLATE LOGICAL NAME in "new" name.
	MOVEI A,(AR1)
	JSP TT,XFILEP		;SKIP IF FILE ARRAY
	 JRST RENAM2
	MOVE TT,TTSAR(A)
	HLL AR1,TT
	TLNE TT,TTS.CL
	 JRST RENM2A
	JRST RENAM3

RENAM2:	MOVEI AR1,NIL		;FILE TO BE RENAMED IS SPECIFIED BY NAMELIST 
RENM2A:				; OR NAMESTRING, OR BY A CLOSED FILE ARRAY
IFN ITS,[
	.CALL RENAM8		;ORDINARY RENAME
	 IOJRST 0,RENAM6
	JRST RENM1A
]		;END OF IFN ITS
IFN D10,[
	MOVEI T,.IODMP		;TO RENAME A FILE, WE OPEN A DUMP MODE CHANNEL
	MOVE TT,-7(FXP)		;GET DEVICE NAME
	SETZ D,
	OPEN TMPC,T		;OPEN CHANNEL
	 JRST RENAM4
	MOVE T,-5(FXP)		;FILE NAME
	HLLZ TT,-4(FXP)		;EXTENSION
SA$	CAMN TT,[SIXBIT \___\]
SA$	 SETZ TT,
	SETZ D,
	MOVE R,-6(FXP)		;PPN
	LOOKUP TMPC,T		;LOOK UP FILE
	 IOJRST 0,RENAM5
	MOVE T,-1(FXP)		;NEW FILE NAME
	HLLZ TT,(FXP)		;NEW EXTENSION
	SETZ D,
	MOVE R,-2(FXP)		;NEW PPN
	RENAME TMPC,T		;RENAME FILE
	 IOJRST 0,RENAM5
	RELEASE TMPC,
	JUMPE AR1,RENM1A
	JRST RENAM1
]		;END OF IFN D10
IFN D20,[
	MOVEI T,L.F6BT
	PUSH FXP,-2*L.F6BT+1(FXP)	;COPY OLD FILE NAMES TO TOP OF FXP
	SOJG T,.-1
	PUSHJ P,6BTTLS		;TRANSLATE LOGICAL NAME OF FILE TO BE RENAMED,
	PUSH P,A		;  AND STRING INTO PNBUF
	MOVSI 1,(GJ%OLD+GJ%SHT)
	MOVE 2,PNBP
	GTJFN				;GET A JFN FOR OLD FILE NAMES
	 IOJRST 0,RENAM6
	EXCH 1,(P)			;PUSH JFN, AND RESTORE ACC A
	JRST RENAM0			; AND JOIN GENERAL RENAME
]		;END OF IFN D20


RENAM3: 			;First, de-allocate the channel number, and
IFN D10+ITS,[			; close out bits in the file array
	PUSHJ P,JCLOSE
IFN ITS,[
	.CALL RENAM7		;ITS RENAME!  -  MUST RENAME WHILE OPEN
	 IOJRST 0,RENAM6
]	;END OF IFN ITS
IFN D10,[
	MOVE F,F.CHAN(TT)	;ttsar left in TT by JCLOSE
	MOVE T,-1(FXP)		;D10 RENAME!  - will construct instruction
	HLLZ TT,(FXP)
SA$	CAMN TT,[SIXBIT \___\]
SA$	 SETZ TT,
	SETZ D,
	MOVE R,-2(FXP)
	LSH F,27
	IOR F,[RENAME 0,T]
	XCT F
	 IOJRST 0,RENAM6
]	;END OF IFN D10
RENAM1:	MOVE TT,TTSAR(A)
	MOVE D,-1(FXP)		;UPDATE THE FILE NAMES OF ARRAY
	MOVEM D,F.FN1(TT)
10%	MOVE R,(FXP)
10$	HLLZ R,(FXP)
	MOVEM R,F.FN2(TT)
IFN D10,[
	MOVEM D,F.RFN1(TT)	;TRUENAMES for D10, and CLOSE/RELEASE
	MOVEM F,F.RFN2(TT)
	MOVE R,-2(FXP)
	MOVEM R,F.PPN(TT)
	MOVEM R,F.RPPN(TT)
SA$	XOR F,[<CLOSE 0,0>#<RENAME 0,T>]
SA$	XCT F
SA$	XOR F,[<RELEASE 0,0>#<CLOSE 0,0>]
SA%	XOR F,[<RELEASE 0,0>#<RENAME 0,T>]
	XCT F
]		;END OF IFN D10
IFN ITS,[
	.CALL RFNAME		;TRUENAMES for ITS and CLOSE file
	 .LOSE 1400
	.CALL CLOSE9
	 .LOSE 1400
]	;END OF IFN ITS
]	;END OF IFN D10+ITS
IFN D20,[
	PUSH P,F.JFN(TT)
	PUSHJ P,JCLOSE
RENAM0:	PUSHJ P,X6BTNSL
	POP P,T
	MOVSI 1,(GJ%FOU+GJ%NEW+GJ%SHT)
	MOVE 2,PNBP
	GTJFN
	 IOJRST 0,RENAM5
	MOVEI 2,(1)
	JUMPE AR1,RENM0A
	TLNE AR1,TTS.CL		;THE "CLOSED" BIT WAS TRANSFERRED
	 JRST RENM0A
	MOVEI 1,(T)
	HRLI 1,(CO%NRJ)
	CLOSF
	 IOJRST 0,RENAM4
RENM0A:	MOVEI 1,(T)
	RNAMF
	 IOJRST 0,RENAM4
	MOVE 1,2
	RLJFN			;? SHOULD GC DO THE RELEASE?
	 JSP T,RLJLUZ
	JUMPE AR1,RENM0B
	MOVE TT,TTSAR(AR1)
	MOVEI T,F.DEV(TT)
	HRLI T,-L.F6BT+1(FXP)
	BLT T,F.DEV+L.F6BT-1(TT)
RENM0B:	JUMPE AR1,RENM1A
]		;END OF IFN D20
	POPI FXP,L.F6BT		;WHEN 1ST ARG IS FILE ARRAY, THEN RETURN THAT
	SKIPA A,AR1
RENM1A:	PUSHJ P,6BTNML		;OTHERWISE, RET VAL IS THE (NEW) NAMELIST
	POPI FXP,L.F6BT
	JRST CZECHI


IFN ITS,[
RENAM7:	SETZ
	SIXBIT \RENMWO\		;RENAME WHILE OPEN
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,-1(FXP)		;NEW FILE NAME 1
	400000,,(FXP)		;NEW FILE NAME 2

RENAM8:	SETZ
	SIXBIT \RENAME\		;RENAME
	      ,,-7(FXP)		;DEVICE NAME
	      ,,-5(FXP)		;OLD FILE NAME 1
	      ,,-4(FXP)		;OLD FILE NAME 2
	      ,,-6(FXP)		;SNAME
	      ,,-1(FXP)		;NEW FILE NAME 1
	400000,,(FXP)		;NEW FILE NAME 2
]		;END OF IFN ITS

IFN D20,[
RENAM4:	MOVE 1,2
	RLJFN
	 JSP T,RLJLUZ
RENAM5:	JUMPE AR1,RNAM5A
	TLNE AR1,TTS.CL		;THE "CLOSED" BIT WAS TRANSFERRED
	 JRST RNAM5A
	MOVEI 1,(T)
	HRLI 1,(CO%NRJ)
	CLOSF		;Close the file.  But DON'T barf, it may have been
	 JFCL		; closed already (get here by RNAMF at RENM0A+2).
RNAM5A:	MOVE 1,T
	RLJFN
	 JSP T,RLJLUZ
]		;END OF IFN D20
IFN D10,[
RENAM4:	SKIPA C,[NSDERR]
RENAM5:	 RELEASE TMPC,
]		;END OF IFN D10
RENAM6:	PUSHJ P,CZECHI
RENAM9:	PUSHJ P,6BTNML		;ERROR MESSAGE IS IN C
	PUSHJ P,NCONS
	PUSH P,A
	PUSHJ P,6BTNML
	POP P,B
	PUSHJ P,CONS
	MOVEI B,Q$RENAMEF
XCIOL:	PUSHJ P,XCONS		;XCONS, THEN IOL
	%IOL (C)

10$ NSDERR:	SIXBIT \NO SUCH DEVICE!\

IFN ITS,[
RFNAME:	SETZ
	SIXBIT \RFNAME\		;READ FILE NAMES
	      ,,F.CHAN(TT)		;CHANNEL #
	  2000,,F.RDEV(TT)		;DEVICE NAME
	  2000,,F.RFN1(TT)		;FILE NAME 1
	  2000,,F.RFN2(TT)		;FILE NAME 2
	402000,,F.RSNM(TT)		;SNAME
]		;END OF IFN ITS

CNAMEF:	PUSHJ P,2MERGE		;LEAVES FIRST ARG IN AR1
	JSP TT,XFILEP
	 JRST CNAME1
	MOVE TT,TTSAR(AR1)
	TLNN TT,TTS.CL		;FILE-ARRAY MUST BE CLOSED
	 JRST CNAME2
	ADDI TT,L.F6BT
	MOVEI F,L.F6BT		;COUNTER TO TRANSFER WORDS
CNAME3:	MOVE T,(FXP)
	MOVEM T,F.DEV-1(TT)
20$	POPI FXP,1
20%	POP FXP,F.RDEV-1(TT)
	SUBI TT,1
	SOJG F,CNAME3
	POPI FXP,L.F6BT
	MOVEI A,(AR1)
	POPJ P,

CNAME2:	SKIPA C,[CNAER2]
CNAME1:	 MOVEI C,CNAER1
CNAMER:	PUSHJ P,6BTNML		;ERROR MESSAGE IS IN C
	PUSHJ P,NCONS
	PUSH P,A
	PUSHJ P,6BTNML
	POP P,B
	PUSHJ P,CONS
	MOVEI B,QCNAMEF
	PUSHJ P,XCONS		;XCONS, THEN IOL
	%IOL (C)

CNAER1:	SIXBIT/NOT FILE ARRAY!/
CNAER2:	SIXBIT/FILE ARRAY NOT CLOSED!/

SUBTTL	DELETEF FUNCTION

;;; (DELETEF X) DELETES THE FILE X. (THAT SOUNDS LOGICAL...)

$DELETEF:			;SUBR 1
	JSP TT,AFOSP		;SKIP IF FILE OR SFA.  LEAVES ARG IN AR1
	 JRST $DEL3
IFN SFA,[
	 JRST $DELNS		;A FILE, NOT AN SFA
	MOVEI B,Q$DELETE	;DELETE OPERATION
	SETZ C,			;NO OP SPECIFIC ARG
	JRST ISTCSH		;FAST INTERNAL SFA CALL
$DELNS:	]	;END IFN SFA
	MOVE TT,TTSAR(A)
	TLNE TT,TTS.CL		;SKIP IF OPEN
	 JRST $DEL3
	HLLOS NOQUIT
IFN ITS,[
	.CALL $DEL6		;USE DELEWO FOR AN OPEN FILE
	 IOJRST 0,$DEL9A
	PUSHJ P,JCLOSE
	MOVE T,F.CHAN(TT)	;CHANNEL INTO T FOR CLOSE9
	.CALL CLOSE9		;ACTUALLY PERFORM THE CLOSE
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	MOVE F,F.CHAN(TT)
	MOVE R,F.RPPN(TT)
	LSH F,27
	IOR F,[RENAME 0,T]
	SETZB T,TT
	XCT F
	 IOJRST 0,$DEL9A
	PUSHJ P,JCLOSE
	XOR F,[<CLOSE 0,40>#<RENAME 0,T>]
	XCT F			;40 BIT MEANS AVOID SUPERSEDING A FILE
	XOR F,[<RELEASE 0,0>#<CLOSE 0,40>]
	XCT F
]		;END OF IFN D10
IFN D20,[
	PUSHJ P,JCLOSE
	HRRZ 1,F.JFN(TT)
	HRLI 1,(CZ%ABT+CO%NRJ)		;ABORTING, BUT DON'T RELEASE JFN
	CLOSF
	 IOJRST 0,$DEL9A
	TLZ 1,-1
	DELF
	 IOJRST 0,$DEL9A
	MOVE A,AR1		;ORIGINAL ARG
]		;END OF IFN D20
	JRST CZECHI

IFN ITS,[
$DEL6:	SETZ
	SIXBIT \DELEWO\		;DELETE WHILE OPEN
	400000,,F.CHAN(TT)	;CHANNEL #
]		;END OF IFN ITS

$DEL3:	PUSHJ P,FIL6BT		;REMEMBER, ORIGINAL ARG IS SAVED IN AR1
	PUSHJ P,DMRGF		;MERGE ARG WITH DEFAULTS
	HLLOS NOQUIT
IFN ITS,[
	.CALL $DEL7
	 IOJRST 0,$DEL9
]		;END OF IFN ITS
IFN D10,[
	MOVEI T,.IODMP
	MOVE TT,-3(FXP)		;GET DEVICE NAME
	SETZ D,
	OPEN TMPC,T		;OPEN TEMP DUMP MODE CHANNEL
	 JRST [ MOVEI C,NSDERR
		JRST $DEL9 ]
	MOVE T,-1(FXP)		;FILE NAME
	HLLZ TT,(FXP)		;EXTENSION
SA$	CAMN TT,[SIXBIT \___\]
SA$	 SETZ TT,
	SETZ D,
	MOVE R,-2(FXP)		;PPN
	LOOKUP TMPC,T
	 IOJRST 0,$DEL5
	SETZB T,TT		;ZERO FILE NAMES MEANS DELETE
	MOVE R,-2(FXP)		;MUST SPECIFY CORRECT PPN
	RENAME TMPC,T		;DELETE THE FILE
	 IOJRST 0,$DEL5
	RELEASE TMPC,		;RELEASE TEMP CHANNEL
]		;END OF IFN D10
IFN D20,[
	PUSHJ P,6BTTLS		;TRANSLATE LOGICAL NAME OF NEW FILE NAME, AND
				;  STRING INTO PNBUF
	MOVE 1,[GJ%OLD+GJ%SHT+.GJLEG]
	MOVE 2,PNBP
	GTJFN			;GET A JFN FOR THE FILE
	 IOJRST 0,$DEL9
	TLZ 1,-1
	PUSH FLP,1
	LOCKI
	PUSHJ P,JFN6BT		;CONVERT JFN TO "SIXBIT" FORMAT ON FXP
	 JRST .+3		; SKIP ON FAILURE
	  MOVEI C,EMS26		;"FILE NOT FOUND" ERROR WHAT ELSE TO DO?????
	  JRST $DEL5		
	MOVE 1,(FLP)
	DELF			;DELETE FILE, and release JFN
	 IOJRST 0,$DEL5		;
	POPI FLP,1
]		;END OF IFN D20
	PUSHJ P,CZECHI
	JRST 6BTNML

IFN ITS,[
$DEL7:	SETZ
	SIXBIT \DELETE\		;DELETE FILE
	      ,,-3(FXP)		;DEVICE NAME
	      ,,-1(FXP)		;FILE NAME 1
	      ,,0(FXP)		;FILE NAME 2
	400000,,-2(FXP)		;SNAME
]		;END OF IFN ITS

IFN D20,[
$DEL5:	POP FLP,1		;RESTORE JFN TO 1
	RLJFN			;RELEASE THE TEMP JFN
	 JSP T,RLJLUZ
]	;END OF IFN D20
IFN D10,[
$DEL5:	 RELEASE TMPC,		;RELEASE THE TEMP CHANNEL
]	;END OF IFN D10

$DEL9:	MOVE A,AR1		;ORIGINAL ARG
20%	POPI FXP,L.F6BT
$DEL9A:	PUSHJ P,CZECHI
	PUSHJ P,ACONS
	MOVEI B,Q$DELETEF
	JRST XCIOL

SUBTTL	CLOSE FUNCTION

;;; (CLOSE X) CLOSES THE FILE ARRAY X.  THE ARRAY ITSELF
;;; IS *NOT* FLUSHED - MAY WANT TO RE-OPEN IT.

CLOSE0:	%WTA NAFOS
$CLOSE:	JSP TT,AFOSP		;LEAVES OBJECT IN A
	 JRST CLOSE0		;NOT A FILE
IFN SFA,[
	 JRST ICLOSE		;A FILE-ARRAY, DO INTERNAL STUFF
	MOVEI B,Q$CLOSE		;CLOSE OPERATION
	SETZ C,			;NO THIRD ARG
	JRST ISTCSH		;SHORT INTERNAL SFA CALL
]		;END IFN SFA
ICLOSE:	HLLOS NOQUIT
	MOVE TT,TTSAR(A)
	TLNE TT,TTS.CL
	 JRST ICLOS6
	PUSHJ P,JCLOSE
IFN ITS,[
	.CALL CLOSE9		;CLOSE FILE
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	LSH T,27
SA$	IOR T,[CLOSE 0,0]
SA$	XCT T
SA$	XOR T,[<RELEASE 0,0>#<CLOSE 0,0>]
SA%	IOR T,[RELEASE 0,0]
	XCT T
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)
	CLOSF			;DOES AN IMPLICIT RLJFN
	 JFCL
]		;END OF IFN D20

	SKIPA A,[TRUTH]		;RETURN T IF DID SOMETHING, ELSE NIL
ICLOS6:	 MOVEI A,NIL
	JRST CZECHI

CLOSE9:	SETZ
	SIXBIT \CLOSE\		;CLOSE CHANNEL
	400000,,F.CHAN(TT)	;CHANNEL #

;;; FILE PRE-CLOSE CLEANUP - de-allocates channel and returns it in T, 
;;; 			     also returns TTSAR in TT

JCLOSE:	MOVE TT,TTSAR(A)	;SHOULD PRESERVE AR1 -- SEE DELETEF
	TLNE TT,TTS.CL		;SKIP UNLESS ALREADY CLOSED
	 .LOSE
	TLNE TT,TTS.IO		;SKIP UNLESS OUTPUT FILE ARRAY
	 PUSHJ P,IFORCE		;FORCE OUTPUT BUFFER
	MOVE TT,TTSAR(A)
	TLNE TT,TTS.TY
	 SKIPN T,FT.CNS(TT)
	  JRST CLOSE4
	SETZM FT.CNS(TT)	;UNLINK TWO TTY'S WHICH
	MOVE T,TTSAR(T)		; WERE TTYCONS'D TOGETHER
	SETZM FT.CNS(T)		; IF ONE IS CLOSED
CLOSE4:	HRRZ T,F.CHAN(TT)
	MOVSI D,TTS.CL		;TURN ON "FILE CLOSED"
	IORM D,TTSAR(A)		; BIT IN ARRAY SAR
	SETZM CHNTB(T)		;CLEAR CHANNEL TABLE ENTRY
	POPJ P,

SUBTTL	FORCE-OUTPUT

;;; (FORCE-OUTPUT X) FORCES THE OUTPUT BUFFER OF OUTPUT FILE ARRAY X.

FORCE:
IFN SFA,[
	EXCH AR1,A
	JSP TT,XFOSP		;AN SFA?
	 JRST FORSF1
	 JRST FORSF1
	EXCH AR1,A
	JSP T,QIOSAV
	MOVEI B,QFORCE
	SETZ C,
	JRST ISTCSH
FORSF1:	EXCH AR1,A
]		;END IFN SFA
	PUSH P,AR1
	MOVEI AR1,(A)
	PUSHJ P,FORCE1
	POP P,AR1
	POPJ P,

FORCE1:	PUSHJ P,OFILOK		;DOES A LOCKI
	PUSHJ P,IFORCE
IFN ITS,[
	.CALL FORCE9
	 CAIN D,%EBDDV		;"WRONG TYPE DEVICE" ERROR IS OKAY
	  CAIA
	   .VALUE		;ANY OTHER ERROR LOSES
]		;END OF IFN ITS
	JRST UNLKTRUE

IFN ITS,[
FORCE9:	SETZ
	SIXBIT \FORCE\		;FORCE OUTPUT BUFFER TO DEVICE
	      ,,F.CHAN(TT)	;CHANNEL #
	403000,,D		;ERROR #
]		;END OF IFN ITS

;;; INTERNAL OUTPUT BUFFER FORCE ROUTINE. EXPECTS USER
;;; INTERRUPTS OFF, AND FILE ARRAY TTSAR IN TT.
;;; CLOBBERS T, TT, D, AND F.

IFORCE:	TLNE TT,TTS.CL
	 LERR [SIXBIT \CAN'T FORCE OUTPUT ON CLOSED FILE!\]
	SKIPGE F,F.MODE(TT)	.SEE FBT.CM	;CAN'T FORCE A CHARMODE FILE
	 POPJ P,
	MOVE F,FB.BFL(TT)
IFN ITS,[
	SUB F,FB.CNT(TT)
	JUMPE F,IFORC1
	MOVE D,F		;NUMBER OF BYTES TO TRANSFER
	MOVE T,FB.IBP(TT)	;INITIAL BYTE POINTER
	.CALL SIOT		;OUTPUT THE (PARTIAL) BUFFER
	 .LOSE 1400
IFORC1:
]		;END OF IFN ITS
IFN D10,[
	MOVE T,F.CHAN(TT)
	LSH T,27
	IOR T,[OUT 0,0]
	XCT T			;OUTPUT THE CURRENT BUFFER
	 CAIA
	  HALT			;? OUTPUT ERROR
]		;END OF IFN D10
IFN D20,[
	SUB F,FB.CNT(TT)
	JUMPE F,FORCE5
	PUSHJ FXP,SAV3		;PRESERVE ACS 1-3
	MOVE 1,F.JFN(TT)
	MOVE 2,FB.IBP(TT)	;INITIAL BYTE POINTER
	MOVN 3,F		;NEGATIVE OF BYTE COUNT
	SOUT			;OUTPUT (PARTIAL) BUFFER
	 ERJMP OIOERR
	PUSHJ FXP,RST3
]		;END OF IFN D20
	ADDM F,F.FPOS(TT)		;UPDATE FILE POSITION
IFN ITS+D20, FORCE5: 	JSP D,FORCE6	;INITIALIZE POINTER AND COUNT
	POPJ P,

IFN ITS+D20,[
FORCE6:	MOVE T,FB.BFL(TT)	;ROUTINE TO INITIALIZE BYTE POINTER AND COUNT
	MOVEM T,FB.CNT(TT)
	MOVE T,FB.IBP(TT)
	MOVEM T,FB.BP(TT)
	JRST (D)
];END IFN ITS+D20

IFN ITS,[
IOTTTT:	SETZ
	SIXBIT \IOT\		;I/O TRANSFER
	      ,,F.CHAN(TT)	;CHANNEL #
	400000,,T		;DATA POINTER (DATA?)

SIOT:	SETZ
	SIXBIT \SIOT\		;STRING I/O TRANSFER
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,T		;BYTE POINTER
	400000,,D		;BYTE COUNT
]		;END OF IFN ITS

SUBTTL	STATUS FILEMODE

;;; (STATUS FILEMODE <FILE> ) RETURNS A LIST DESCRIBING
;;; THE FILE:  NIL ==> FILE HAS BEEN CLOSED; OTHERWISE
;;; THE CAR OF THIS LIST IS A VALID OPTIONS
;;; LIST FOR THE OPEN FUNCTION.  THE CDR OF THIS LIST
;;; CONTAINS INFORMATIVE ITEMS WHICH ARE NOT NECESSARILY
;;; USER-SETTABLE FEATURES ABOUT THE FILE.
;;; PRESENTLY SUCH GOODIES INCLUDE:
;;;	RUBOUT		AN OUTPUT TTY THAT CAN SELECTIVELY ERASE
;;;	CURSORPOS	AN OUTPUT TTY THAT CAN CURSORPOS WELL
;;;	SAIL		FOR AN OUTPUT TTY, HAS SAIL CHARACTER SET
;;;	FILEPOS		CAN FILEPOS CORRECTLY (RANDOM ACCESS)
;;; NON-FILE ARGUMENT CAUSES AN ERROR.

SFMD0:	%WTA NFILE
SFILEMODE:
	JSP TT,AFOSP		;MUST BE A FILE OR SFA
	 JRST SFMD0
IFN SFA,[
	 JRST SFMD0A		;IF FILE THEN HANDLE NORMALLY
	SETZ C,			;IF WE GO TO THE SFA, NO THIRD ARG
	MOVEI T,SO.MOD		;CAN THE SFA DO (STATUS FILEMODE)?
	MOVEI TT,SR.WOM
	TDNE T,@TTSAR(A)	;CAN IT DO THE OPERATION?
	 JRST ISTCAL		;YES, CALL THE SFA AND RETURN
	MOVEI B,QWOP		;OTHERWISE, DO A WHICH-OPERATIONS
	PUSHJ P,ISTCSH
	PUSH P,A		;SAVE THE RESULTS
	MOVEI A,QSFA
	JSP T,%NCONS		;MAKE A LIST
	POP P,B
	JRST CONS		;RETURN ((SFA) {WHICH-OPERATIONS})
SFMD0A:	]	;END IFN SFA
	LOCKI
	MOVE TT,TTSAR(A)	;GET TTSAR BITS
	TLNE TT,TTS.CL		;RETURN NIL IF THE FILE IS CLOSED
	 JRST UNLKFALSE
	MOVE R,F.FLEN(TT)	;IF LENGTH > 0 THEN BLOCK MODE, ELSE SINGLE
	MOVEI A,QBLOCK
	SKIPGE F,F.MODE(TT)	.SEE FBT.CM
	 MOVEI A,QSINGLE
	UNLOCKI
	PUSHJ P,NCONS
	MOVEI B,QDSK		;TWO MAJOR TYPES - TTY OR DSK
	TLNE TT,TTS.TY
	 MOVEI B,QTTY
	PUSHJ P,XCONS
	MOVEI B,Q$ASCII		;ASCII, IMAGE, OR FIXNUM
	TLNE TT,TTS.IM
	 MOVEI B,QIMAGE
	TLNN TT,TTS.IO
	 TLNN TT,TTS.TY
	  JRST SFMD1
	TLNN F,FBT.FU		;INPUT TTY: FULL CHAR SET MEANS FIXNUM FILE
SFMD1:	 TLNE TT,TTS<BN>
	  MOVEI B,QFIXNUM
	PUSHJ P,XCONS
	MOVEI B,Q$IN		;INPUT, OUTPUT, OR APPEND MODE
	TLNE TT,TTS<IO>
	 MOVEI B,Q$OUT
	TLNE F,FBT<AP>
	 MOVEI B,QAPPEND
	PUSHJ P,XCONS
	MOVEI B,QECHO		;OTHER RANDOM MODE BITS - ECHO
	TLNE F,FBT.EC
	 PUSHJ P,XCONS
	MOVEI B,QSCROLL		;SCROLL
	TLNE F,FBT.SC
	 PUSHJ P,XCONS
	MOVEI C,(A)
	SETZ A,
	MOVEI B,QSAIL
	TLNE F,FBT.SA		;SAIL MODE
	 PUSHJ P,XCONS
	MOVEI B,QRUBOUT
	TLNE F,FBT.SE		;RUBOUT-ABLE
	 PUSHJ P,XCONS
IFN USELESS*<ITS\D20>,[
	MOVEI B,QCURSORPOS	;CURSORPOS-ABLE
	TLNE F,FBT.CP
	 PUSHJ P,XCONS
]	;END OF IFN USELESS*<ITS\D20>
	MOVEI B,QFILEPOS	;FILEPOS-ABLE
	SKIPL R			.SEE F.FLEN	;NEGATIVE => CAN'T FILEPOS
	 PUSHJ P,XCONS
	MOVEI B,(C)
	JRST XCONS

SUBTTL	LOAD FUNCTION
;;; (LOAD FOO) LOADS THE FILE FOO.  IT FIRST PROBEF'S TO
;;; ASCERTAIN THE EXISTENCE OF THE FILE, AND CHECKS THE FIRST
;;; WORD TO SEE WHETHER IT IS AN ASCII OR FASL FILE.
;;; IF NO SECOND FILE NAME IS GIVEN, "FASL" IS TRIED FIRST,
;;; AND THEN ">" IF NO FASL FILE EXISTS.
;;; IF A FASL FILE, IT GIVES THE FILE NAMES TO FASLOAD.
;;; IF AN ASCII FILE, IT IS OPENED, (INFILE ^Q, *, +, -, INSTACK)
;;; BOUND TO (<THE FILE>, T, *, +, -, NIL), AND A READ-EVAL
;;; LOOP PERFORMED UNTIL END OF FILE OCCURS LEAVING INSTACK=NIL
;;; AND INFILE=T.

LOAD:	JUMPE A,CPOPJ		;IF GIVEN NIL AS ARG, RETURN NIL
	PUSHJ P,FIL6BT		;SUBR 1
	MOVE F,-L.6EXT-L.6VRS+1(FXP)
	PUSHJ P,DMRGF		;DMRGF SAVES F
20$	PUSHJ P,6BTTLN
	LOCKI
	CAME F,DFNWD		;DEFAULT 2ND FILE NAME (OR EXTENSION)
	 JUMPN F,LOAD3		; TO "FASL" WHEN NOT SUPPLIED
	MOVE TT,DFFNWD
	MOVEM TT,<-L.6EXT-L.6VRS+1>-1(FXP)	;-1 for LOCKI word
IFN D20,[
	MOVE TT,[ASCII \0\]
	SKIPE <-L.6VRS+1>-1(FXP) 	    ;VERSION NUMBER NULL?
	 CAMN T,<-L.6VRS+1>-1(FXP) 	    ;  OR EQUAL TO *?  IF EITHER CASE,
	  MOVEM TT,<-L.6VRS+1>-1(FXP)	    ;  THEN USE  "0"
]		;END OF IFN D20
	JSP T,FASLP1
	 JRST LOAD1		;FILE NOT FOUND
	 JRST LOAD2		;FASL FILE
LOAD5:	UNLOCKI			;EXPR FILE FOUND
	HRRZ B,VIPLUS		;WE WANT +, -, * TO WORK AS FOR TOP LEVEL,
	HRRZ C,V.		; BUT NOT SCREW THE OUTSIDE WORLD
	HRRZ AR1,VIDIFFERENCE
	MOVEI AR2A,TRUTH
	JSP T,SPECBIND
	   0 A,VINFILE
	   0 B,VIPLUS
	   0 C,V.
	   0 AR1,VIDIFFERENCE
	   0 AR2A,TAPRED
	   VINSTACK		   ;INSTACK temporarily gets NIL
	   VFEXITFUNCTIONS
	MOVE AR2A,VFEXDEFAULT	   ;Default VFEXITFUNCTIONS
	MOVEM AR2A,VFEXITFUNCTIONS
	PUSHJ P,6BTNML
	PUSHJ P,[PUSH P,A
		 MOVNI T,1
		 JRST $EOPEN		   ;Open as a file object
		 ]
LOAD6:	MOVEM A,VINFILE		   ;Store this away
	PUSH P,A		   ;Save file that we haven't finished for
				   ;exit handlers
	JSP TT,UNWINC		   ;Set up an unwind-protect form
	  JRST LOAD7A		   ;  Code to be protected

EOFEV:				   ;(Get here with 7 PUSHs (5 AC's and 2 addrs)
	SKIPA A,VFEXITFUNCTIONS
EOFEV1:	HRRZ A,@VFEXITFUNCTIONS	   ;Next form
	MOVEM A,VFEXITFUNCTIONS
	JUMPE A,EOFEV2		   ;until end of list
	HLRZ B,(A)
	MOVE A,-7(P)		   ;Get our call argument
	CALLF 1,(B)		   ;Call the user's function
	JRST EOFEV1

EOFEV2:	MOVE A,-7(P)		   ;Get the file array we're hacking
	JSP TT,AFOSP		   ;Be sure it's still a file
	  POPJ P,		   ;  Not a file
	  JRST $CLOSE		   ;  SFA
	JRST $CLOSE		   ;Close it

LOAD7:	PUSHJ P,TLEVAL		;USE THE EVAL PART OF THE TOP LEVEL
	HRRZM A,V.
LOAD7A:	PUSHJ P,TLREAD		;USE THE READ PART OF THE TOP LEVEL
	 JRST LOAD7
LOAD8:	HRRZ B,VINFILE		;EOF TESTING
	SKIPN VINSTACK
	 CAIE B,TRUTH
	  JRST LOAD7A
	SETZM -LERSTP-1(P)	;Tell the cleanup that we finished the file
	JSP TT,UNWINE		;Perform our exit forms
	PUSHJ P,UNBIND
	POP P,A			;Our 'Did we finish?' flag should be on top
	JRST TRUE		;Return TRUTH

LOAD1:
IFN ITS+D10,[
IT$	MOVSI TT,(SIXBIT \>\)		;OTHERWISE TRY ">"
SA$	MOVSI TT,(SIXBIT \___\)
SA% 10$	MOVSI TT,(SIXBIT \LSP\)		;FOR D10, "LSP"
	MOVEM TT,-1(FXP) 		;REMEMBER ADJUSTMENT FOR LOCKI WORD
]	;END OF IFN ITS+D10
IFN D20,[
	MOVE TT,[ASCIZ \LSP\]
ZZ==<-L.6EXT-L.6VRS+1>-1		;REMEMBER: ADJUSTMENT FOR LOCKI WORD
	MOVEM TT,ZZ(FXP)
	SETZM ZZ+1(FXP)
	MOVEI T,ZZ+2(FXP)
	HRLI T,-1(T)
	BLT T,ZZ+L.6EXT-1(FXP)		;ZERO OUT REMAINING WORDS
]	;END OF IFN D20
LOAD3:	MOVEI A,QLOAD
	JSP T,FASLP1
	 JRST LOAD4		;LOSE COMPLETELY
	 JRST LOAD2		;FASL FILE
	JRST LOAD5		;EXPR CODE

LOAD2:	UNLOCKI			;FASL FILE - GO FASLOAD IT
	PUSHJ P,6BTNML
	HRRZ B,VDEFAULTF
	JSP T,SPECBIND
	   0 B,VDEFAULTF	;DON'T LET FASLOAD CLOBBER DEFAULTF
	PUSHJ P,FASLOAD
	JRST UNBIND

LOAD4:	IOJRST 0,.+1
	PUSH P,A
	UNLOCKI
	PUSHJ P,6BTNML		;LOSEY LOSEY
	PUSHJ P,NCONS
	POP P,B
	JRST XCIOL


;;; (FASLP <FILE>) TELLS WHETHER THE FILE IS A FASL FILE.
;;; ERROR IF FILE DOES NOT EXIST.

$FASLP:	PUSHJ P,FIL6BT
	PUSHJ P,DMRGF
20$	PUSHJ P,6BTTLN
	MOVEI A,Q$FASLP
	LOCKI
	JSP T,FASLP1
	 JRST LOAD4
	 SKIPA A,[TRUTH]
	  MOVEI A,NIL
	UNLOCKI
	POPI FXP,L.F6BT		;POP CRUD OFF STACK
	POPJ P,

;;; ROUTINE TO TEST A FILE FOR FASL-NESS.
;;;   WARNING! MUST SAVE "A"  -  SEE "LOAD:", "LOAD3:" AND "$FASLP:"
;;;	JSP T,FASLP1
;;;	 JRST NOTFOUND	;FILE NOT FOUND, OR OTHER ERROR
;;;	 JRST FASL	;FILE IS A FASL FILE
;;;	 ...		;FILE IS NOT A FASL FILE
;;; FXP MUST HOLD THE "SIXBIT" FILE NAMES, WITH A LOCKI WORD ABOVE THEM.
;;; USER INTERRUPTS MUST BE LOCKED OUT.

FASLP1:
IFN ITS,[
	.CALL FASLP9		;OPEN FILE ON TEMP CHANNEL
	 JRST (T)
	.CALL FASLP8		;RESTORE REFERENCE DATE
	 JFCL			; (ONLY WORKS FOR DISK CHANNELS - IGNORE FAILURE)
	HRROI D,TT
	.IOT TMPC,D		;READ FIRST WORD
	.CLOSE TMPC,
	JUMPL D,2(T)		;NOT A FASL FILE IF ZERO-LENGTH
	TRZ TT,1
	CAMN TT,[SIXBIT \*FASL*\]
	 JRST 1(T)		;FASL FILE IF FIRST WORD CHECKS
	JRST 2(T)

FASLP8:	SETZ
	SIXBIT \RESRDT\		;RESTORE REFERENCE DATE
	401000,,TMPC		;CHANNEL #

FASLP9:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	  5000,,6		;IMAGE BLOCK INPUT
	  1000,,TMPC		;CHANNEL NUMBER
	      ,,-4(FXP)		;DEVICE NAME
	      ,,-2(FXP)		;FILE NAME 1
	      ,,-1(FXP)		;FILE NAME 2
	400000,,-3(FXP)		;SNAME
]		;END OF IFN ITS

IFN D10,[
	PUSH P,T
	MOVEI T,.IODMP
	MOVE TT,-4(FXP)
	SETZ D,
	OPEN TMPC,T		;OPEN TEMP CHANNEL TO FILE
	 POPJ P,
	MOVE T,-2(FXP)		;FILE NAME
	HLLZ TT,-1(FXP)		;EXTENSION
SA$	CAMN TT,[SIXBIT \___\]
SA$	 SETZ TT,
	SETZ D,
	MOVE R,-3(FXP)		;PPN
	LOOKUP TMPC,T		;LOOK UP FILE NAMES
	 JRST FASLP2
	SETZB TT,R
	PUSH FXP,NIL		;USE A WORD ON FXP AS D10 CAN'T DO I/O TO AC'S
	HRROI D,-1(FXP)		;D AND R ARE THE DUMP MODE COMMAND LIST
	INPUT TMPC,D		;GET FIRST WORD OF FILE
SA%	CLOSE TMPC,CL.ACS	;DON'T UPDATE ACCESS DATE
	RELEASE TMPC,
	POP FXP,TT		;GET THE WORD READ FROM THE FILE
	POP P,R
SA$	WARN [RESTORE REF DATE FOR SAIL PROBEF?]
;FALLS THROUGH
]		;END OF IFN D10
IFN D20,[
	PUSH FLP,(FXP)		;SAVE THE LOCKI WORD, BUT OFF FXP
	POPI FXP,1
	PUSH P,T
	PUSHJ P,X6BTNS		;GET NAMESTRING IN PNBUF
	PUSH FXP,(FLP)		;PUT LOCKI WORD BACK IN ITS PLACE
	POPI FLP,1
	POP P,R
	PUSH P,A
	PUSH P,B
	MOVSI 1,(GJ%OLD+GJ%SHT)	.SEE .GJDEF
	MOVE 2,PNBP
	GTJFN			;GET A JFN FOR THE FILE NAME
	 JRST RSTR2		;JUST EXITS THRU R, RESTORING A AND B
	MOVE 2,[440000,,OF%RD+OF%PDT]	.SEE OF%BSZ OF%MOD
	SETZ TT,
	OPENF			;OPEN FILE, PRESERVING ACCESS DATE
	 JRST FASLP2
	BIN			;GET ONE 36.-BIT BYTE
	MOVE TT,2
	CLOSF			;CLOSE THE FILE
	 JFCL			;IGNORE ERROR RETURN
	SKIPA			;JFN HAS BEEN RELEASED BY THE CLOSE
FASLP2:	 RLJFN			;RELEASE THE JFN
	  JFCL
	POP P,B
	POP P,A
]		;END OF IFN D20
IFN D10+D20,[
	TRZ TT,1
	CAMN TT,[SIXBIT \*FASL*\]
	 JRST 1(R)		;FASL FILE IF FIRST WORD CHECKS
	JRST 2(R)
]		;END OF IFN D10+D20
IFN D10,[
FASLP2:	RELEASE TMPC,
	POPJ P,
]

;;; (DEFUN INCLUDE FEXPR (X)
;;;	   ((LAMBDA (F)
;;;		    (EOFFN F '+INTERNAL-INCLUDE-EOFFN)
;;;		    (INPUSH F))
;;;	    (OPEN (CAR X))))

INCLUDE:
	HLRZ A,(A)	;FSUBR
.INCLUD:		;SUBR
	JUMPE A,CPOPJ
	PUSHJ P,[PUSH P,A
		 MOVNI T,1
		 JRST $EOPEN]
INCLU1:	MOVEI TT,FI.EOF
	MOVEI B,QINCEOF
	MOVEM B,@TTSAR(A)
	JRST INPUSH

INCEOF==:FALSE		;INCLUDE'S EOF FUNCTION - SUBR 2

SUBTTL	OPEN FUNCTION (INCLUDING SAIL EOPEN)

;;; (OPEN <FILE> <MODELIST>) OPENS A FILE AND RETURNS A
;;; CORRESPONDING FILE OBJECT.  IT IS ACTUALLY AN LSUBR
;;; OF ZERO TO TWO ARGUMENTS.  THE <FILE> DEFAULTS TO THE
;;; CURRENT DEFAULT FILE NAMES.  THE <MODELIST> DEFAULTS
;;; TO NIL.
;;; IF <FILE> IS A NAMELIST OR NAMESTRING, A NEW FILE ARRAY
;;; IS CREATED.  IF <FILE> IS A FILE ARRAY ALREADY, IT IS
;;; CLOSED AND RE-OPENED IN THE SPECIFIED MODE; ITS FORMER
;;; MODES SERVE AS THE DEFAULTS FOR THE <MODELIST>.
;;; THE <MODELIST> DETERMINES A LARGE NUMBER OF ATTRIBUTES
;;; FOR OPENING THE FILE.  FOR EACH ATTRIBUTE THERE ARE
;;; TWO OR MORE MUTUALLY EXCLUSIVE VALUES WHICH MAY BE
;;; SPECIFIED AS FOLLOWS.  VALUES MARKED BY A * ARE THOSE
;;; USED AS DEFAULTS WHEN THE <FILE> IS A NAMELIST OR
;;; NAMESTRING.  IF THE <MODELIST> IS AN ATOM, IT IS THE
;;; SAME AS SPECIFYING THE LIST OF THAT ONE ATOM.
;;;	DIRECTION:
;;;	*  IN		INPUT FILE
;;;	*  READ		SAME AS "IN"
;;;	   OUT		OUTPUT FILE
;;;	   PRINT	SAME AS "OUT"
;;;	   APPEND	OUTPUT, APPENDED TO EXISTING FILE
;;;	DATA MODE:
;;;	*  ASCII	FILE IS A STREAM OF ASCII CHARACTERS.
;;;			SYSTEM-DEPENDENT TRANSFORMATIONS MAY
;;;			OCCUR, SUCH AS SUPPLYING LF AFTER CR,
;;;			OR BEING CAREFUL WITH OUTPUT OF ^P,
;;;			OR MULTICS ESCAPE CONVENTIONS.
;;;	   FIXNUM	FILE IS A STREAM OF FIXNUMS.  THIS
;;;			IS FOR DEALING WITH FILES THOUGHT OF
;;;			AS "BINARY" RATHER THAN "CHARACTER".
;;;			FOR TTY'S, THIS IS INTERPRETED AS
;;;			"MORE-THAN-ASCII" OR "FULL CHARACTER
;;;			SET" MODE, WHICH READS 9 BITS AT SAIL
;;;			AND 12. ON ITS.
;;;	   IMAGE	FILE IS A STREAM OF ASCII CHARACTERS.
;;;			ABSOLUTELY NO TRANSFORMATIONS ARE MADE.
;;;	DEVICE TYPE:
;;;	*  DSK		STANDARD KIND OF FILE.
;;;	   CLA		(ITS ONLY) LIKE DSK, BUT REQUIRES BLOCK MODE,
;;;			AND GOBBLES THE FIRST TWO WORDS, INSTALLING
;;;			THEM IN THE TRUENAME.  USEFUL PRIMARILY FOR
;;;			A CLI-MESSAGE INTERRUPT FUNCTION.
;;;	   TTY		CONSOLE.  IN PARTICULAR, ONLY TTY INPUT
;;;			FILES HAVE INTERRUPT CHARACTER FUNCTIONS
;;;			ASSOCIATED WITH THEM.
;;;	BUFFERING MODE:
;;;	*  BLOCK	DATA IS BUFFERED.
;;;	   SINGLE	DATA IS UNBUFFERED.
;;;	PRINTING AREA:
;;;	   ECHO		(ITS ONLY) OPEN TTY IN ECHO AREA
;;; SOME OF THESE VALUES ARE OF COURSE SYSTEM-DEPENDENT.
;;; YOUR LOCAL LISP SYSTEM WILL ATTEMPT TO DO THE RIGHT THING,
;;; HOWEVER, IN ANY CASE.
;;; IF THE OPTIONS LIST IS INVALID IN ANY WAY, OPEN MAY EITHER
;;; GIVE A WRNG-TYPE-ARGS ERROR, OR BLITHELY ASSUME A CORRECTED
;;; VALUE FOR AN ATTRIBUTE.  IN GENERAL, ERRORS SHOULD OCCUR
;;; ONLY FOR TRULY CONFLICTING SPECIFICATIONS.  ON THE OTHER
;;; HAND, SPECIFYING BLOCK MODE FOR A DEVICE THAT THE SYSTEM
;;; WANTS TO HANDLE ONLY IN CHARACTER MODE WILL JUST GO AHEAD
;;; AND USE CHARACTER MODE.  IN GENERAL, ONE SHOULD USE
;;; (STATUS FILEMODE) TO SEE HOW THE FILE WAS ACTUALLY OPENED.

SA% $EOPEN:
$OPEN:	MOVEI D,Q$OPEN		;LSUBR (0 . 2)
	CAMGE T,XC-2
	 JRST WNALOSE
	SETZB A,B		;BOTH ARGUMENTS DEFAULT TO NIL
	CAMN T,XC-2
	 POP P,B
	SKIPE T
	 POP P,A
IFN SFA,[
	JSP TT,AFOSP		;WERE WE HANDED AN SFA AS FIRST ARG?
	 JFCL
	 JRST $OPNNS		;NOPE, CONTINUE AS USUAL
	MOVEI C,(B)		;ARG TO SFA IS THE LIST GIVEN TO OPEN
	MOVEI B,Q$OPEN		;OPERATION
	JRST ISTCSH		;SHORT INTERNAL CALL
$OPNNS:	]	;END IFN SFA
;THE TWO ARGUMENTS ARE NOW IN A AND B.
;WE NOW PARSE THE OPTIONS LIST.  F WILL HOLD OPTION VALUES,
; AND D WILL INDICATE WHICH WERE SPECIFIED EXPLICITLY BY THE USER.
OPEN0J:	PUSH P,T		;SAVE NUMBER OF ARGS ON P (NOT FXP!)
	SETZB D,F
	JSP TT,AFILEP		;IS THE FIRST ARGUMENT A FILE OBJECT?
	 JRST OPEN1A
	MOVEI TT,F.MODE
	MOVE F,@TTSAR(A)	;IF SO, USE ITS MODE AS THE DEFAULTS
IFN ITS\D20,[
	SKIPE B			;MAKE CHUCK RICH HAPPY - DON'T LET "ECHO" CARRY
	 TLZ F,FBT.EC+FBT.CP+FBT.SC ; OVER IF A NON-NULL OPTIONS LIST WAS GIVEN
]	;END OF ITS\D20
OPEN1A:	JUMPE B,OPEN1Y		;JUMP OUT IF NO OPTIONS SUPPLIED
	MOVEI C,(B)
	SKOTTN B,LS
	 JRST OPEN1C
	MOVSI AR2A,(B)		;IF A SINGLE, ATOMIC OPTION WAS GIVEN, AR2A
	MOVEI C,AR2A		; IS A FAKE CONS CELL SO IT LOOKS LIKE A LIST
OPEN1C:	JUMPE C,OPEN1L		;JUMP OUT IF LAST OPTION PROCESSED
	HLRZ AR1,(C)
OPN1F1:	JUMPE AR1,OPEN1G	;IGNORE NIL AS A KEYWORD
	MOVSI TT,-LOPMDS
OPEN1F:	HRRZ R,OPMDS(TT)	;COMPARE GIVEN OPTION AGAINST VALID ONES
	CAIN AR1,(R)
	 JRST OPEN1K		;JUMP ON MATCH
	AOBJN TT,OPEN1F
	EXCH A,AR1		;ERRONEOUS KEYWORD INTO AR1
	WTA [IS ILLEGAL KEYWORD - OPEN!]
	EXCH A,AR1
OPEN1G:	HRRZ C,(C)		;CDR DOWN LIST UNTIL ALL DONE
	JRST OPEN1C

OPEN1K:	TDNN D,OPMDS(TT)	;SEE IF THERE IS A CONFLICT
	 JRST OPEN1Z
OPEN1H:	EXCH A,B
	WTA [ILLEGAL OPTIONS LIST - OPEN!]
	EXCH A,B
	JRST OPEN0J

OPEN1Z:	HLRZ R,OPMDS(TT)
	TLO D,(R)
	TLZ F,(R)
	TRZ F,(R)
	IOR F,OPBITS(TT)
	JRST OPEN1G

;;; LEFT HALF IS SET OF MODE BITS WHICH THE OPTION IN THE RIGHT
;;; HALF WILL CONFLICT WITH IF ANY ONE ELSE SELECTS THEM.

OPMDS:	FBT.AP+1,,Q$IN
	FBT.AP+1,,QOREAD
	FBT.AP+1,,Q$OUT
	FBT.AP+1,,Q%PRINT
	FBT.AP+1,,QAPPEND
	000014,,Q$ASCII
	000014,,QFIXNUM
	000014,,QIMAGE
	000002,,QDSK
IT$	FBT.CA+2,,QCLA
	000002,,QTTY
	FBT.CM,,QBLOCK
	FBT.CM,,QSINGLE
	0,,QNODEFAULT
IT$	FBT.EC,,QECHO
IT$	FBT.SC,,QSCROLL
LOPMDS==.-OPMDS

;;; MODE BITS ACTUALLY TO BE SET FOR AN OPTION IN THE OPMDS TABLE.

OPBITS:	0			;IN
	0			;READ
	1			;OUT
	1			;PRINT
	FBT.AP,,1		;APPEND
	0			;ASCII
	4			;FIXNUM
	10			;IMAGE
	0			;DSK
IT$	FBT.CA,,0		;CLA
	2			;TTY
	0			;BLOCK
	FBT.CM,,		;SINGLE
	FBT.ND,,		;NODEFAULT
IT$	FBT.EC,,		;ECHO
IT$	FBT.SC,,		;SCROLL
TBLCHK OPBITS,LOPMDS

;STATE OF THE WORLD:
;	FIRST ARG TO OPEN IN A
;	SECOND ARG IN B
;	D CONTAINS BITS FOR ACTUALLY SPECIFIED OPTIONS IN LEFT HALF
;	F CONTAINS BITS FOR OPTIONS
		.SEE FBT.CM	;AND FRIENDS
;		1.4-1.3	0 => ASCII, 1 => FIXNUM, 2 => IMAGE
;		1.2	0 => DSK, 1 => TTY
;		1.1	0 => IN, 1 => OUT
;		BITS 1.4-1.1 ARE USED TO INDEX VARIOUS TABLES LATER
;	ACTUAL NUMBER OF ARGS ON P
;WE NOW EMBARK ON DEFAULTING AND MAKING CONSISTENT THE VARIOUS MODES
OPEN1L:	TLNE D,FBT.CM		;SKIP IF SINGLE VS. BLOCK WAS UNSPECIFIED
	 JRST OPEN1Y
	TRNE F,2		;SKIP UNLESS TTY
	 TLO F,FBT.CM		;FOR TTY, DEFAULT TO SINGLE, NOT BLOCK, MODE
OPEN1Y:
IFN ITS\D20,[
	TRC F,3
	TRCE F,3
	 TLZ F,FBT.EC+FBT.SC	;ECHO AND SCROLL MEANINGFUL ONLY FOR TTY OUTPUT
]	;END OF ITS\D20
	TRNN F,2		;SKIP IF TTY
	 JRST OPEN1S
	TLZ F,FBT.AP		;CAN'T APPEND TO A TTY
	TRNN F,1
	 TLO F,FBT.CM		;CAN'T DO BLOCK TTY INPUT
	TRNE F,4		;FIXNUM TTY I/O USES FULL CHAR SET
	 TLO F,FBT.FU
;NOW WORRY ABOUT FILE NAMES AND ALLOCATING A FILE OBJECT
OPEN1S:	PUSH P,A
	PUSH P,B
	PUSH FXP,F
	CAIE A,TRUTH		;T MEANS TTY FILE ARRAY...
	 JRST OPEN1M
	TRNN F,1
	 SKIPA A,V%TYI		;TTY INPUT IF MODE BITS SAY INPUT
	  HRRZ A,V%TYO		; AND OUTPUT OTHERWISE
OPEN1M:	PUSH P,A
	PUSHJ P,FIL6BT		;GET FILE NAME SPECS
	MOVE F,-L.F6BT(FXP)	;GET MODE BITS
	TLZN F,FBT.ND		;MERGE WITH DEFAULT NAMES?
	 PUSHJ P,DMRGF		;MERGE IN DEFAULT NAMES (SAVES F)
20$	PUSHJ P,6BTTLN
	HRLZI F,FBT.ND
	ANDCAM F,-L.F6BT(FXP)	;TURN OFF FBT.ND BIT IN SAVED FLAGS
	MOVE A,(P)		;GET (POSSIBLY MUNGED FOR T) FIRST ARG
	JSP TT,AFILEP		;SKIP IF WE GOT A REAL LIVE SAR
	 JRST OPEN1N
	PUSHJ P,ICLOSE		;CLOSE IT IF NECESSARY
;;; WARN [SHOULD WE RELEASE THE JFN AT THIS POINT?]
	MOVE A,(P)
	MOVE D,-3(P)		;IF ONLY ONE ARG TO OPEN, AND
	AOJE D,OPEN1Q		; THAT A SAR, RE-USE THE ARRAY
	MOVE F,-L.F6BT(FXP)
	MOVEI TT,F.MODE
	XOR F,@TTSAR(A)
	TDNE F,[FBT.CM,,17]
	 JRST OPEN1P
	PUSHJ P,OPNCLR		;IF TWO ARGS, BUT SAME MODE,
	JRST OPEN1Q		; CLEAR ARRAY, THAN RE-USE
;WE MUST ALLOCATE A FRESH ARRAY
OPEN1N:	MOVSI A,-1		;ARRANGE TO GET A FRESH SAR
;WE HAVE A SAR, BUT MUST ALLOCATE A NEW ARRAY BODY
OPEN1P:	MOVE F,-L.F6BT(FXP)	;GET MODE BITS AGAIN
;DETERMINE SIZE OF NEW ARRAY
IFN ITS+D20,[
	HLRZ TT,OPEN9A(F)	;FOR ITS AND D20, DESIRABLE SIZES ARE IN A TABLE
	SKIPGE F		.SEE FBT.CM
	 HRRZ TT,OPEN9A(F)
]		;END OF IFN ITS+D20
IFN D10,[
;FOR D10, WE MUST ASK THE OPERATING SYSTEM FOR THE PROPER BUFFER SIZE
	MOVE TT,-3(FXP)		;GET DEVICE NAME
	CAMN TT,[SIXBIT \PTY\]
	 JRST .+3
	  CAME TT,[SIXBIT \TTY\]
	   TRZ F,2		;? NOT A TTY UNLESS IT IS *THE* TTY
	TRNN F,2
	 TLZA F,FBT.CM		;ONLY THE TTY CAN BE SINGLE MODE,
	  TLO F,FBT.CM		; AND THE TTY MUST BE SINGLE MODE!
SA$	TRNE F,2		;FOR SAIL, *THE* TTY SHOULD DEFAULT TO LINEMODE
SA$	 TLO F,FBT.LN
	MOVEM F,-4(FXP)		;SAVE BACK MODE BITS
	PUSHN FXP,1		;PUSH A SLOT FOR BUFFER SIZE DATA
	JUMPL F,OPEN1R		.SEE FBT.CM
IFE SAIL,[
	HLRZ T,OPEN9C(F)	;GET DESIRED I/O MODE
	MOVEI D,T
	DEVSIZ D,		;ON SUCCESS, GET <NUMBER OF BUFFERS,,BUFFER SIZE>
	 SETO D,
	SKIPG D
	 MOVE D,[2,,3+LIOBUF]	;ON FAILURE, USE 2 BUFFERS AT LIOBFS WORDS APIECE
	HLRZ TT,D
	CAIGE TT,NIOBFS
]	;END IFE SAIL
IFN SAIL,[
	MOVE D,TT		;DEVICE NAME IN D
	BUFLEN D,		;GET BUFFER SIZE
	SKIPN D			;NO WAY!! (BUT BETTER CHECK ANYWAY)
	 MOVEI D,LIOBUF+1	;DEFAULT
	ADDI D,2		;WE NEED ACTUAL SIZE OF BUFFER, NOT SIZE-2
]	;END IFN SAIL
	 HRLI D,NIOBFS		;HOWEVER, WE MUST USE AT LEAST NIOBFS BUFFERS
	MOVEM D,(FXP)		;SAVE THIS DATA
	HLRZ TT,D
	IMULI D,(TT)		;GET TOTAL SPACE OCCUPIED BY BUFFERS
	HLRZ TT,OPEN9A(F)
	ADDI TT,(D)		;ADD TO SIZE OF REST OF FILE ARRAY
	CAIA
OPEN1R:	 HRRZ TT,OPEN9A(F)	;FOR CHARACTER MODE, TABLE HAS TOTAL ARRAY SIZE
]		;END OF IFN D10
	PUSHJ P,MKLSAR		;MAKE AN ARRAY - SIZE IN TT, SAR (IF ANY) IN A
10$	POP FXP,D
OPEN1Q:	LOCKI			;LOCK OUT USER INTERRUPTS

;FALLS THROUGH

;FALLS IN

;STATE OF THE WORLD:
;	USER INTERRUPTS LOCKED OUT
;	SAR FOR FILE ARRAY IN A
;	FOR D10, BUFFER SIZE INFORMATION IN D
;	P:	FIRST ARGUMENT, OR TTY SAR IF ARGUMENT WAS T
;		SECOND ARGUMENT
;		FIRST ARGUMENT
;		(NEGATIVE OF) ACTUAL NUMBER OF ARGS
;	FXP:	LOCKI WORD
;		FILE NAMES IN "SIXBIT" FORMAT (L.F6BT WORDS)
;		MODE BITS
	MOVSI TT,TTS.IM+TTS.BN+TTS.TY+TTS.IO
	ANDCAM TT,TTSAR(A)
	MOVE F,-1-L.F6BT(FXP)	;GET MODE BITS
	HLLZ TT,OPEN9B(F)
	IORB TT,TTSAR(A)	;SET CLOSED BIT AND FILE TYPE BITS
IFN D10,[
	JUMPL F,OPEN1T		.SEE FBT.CM
	HLRZM D,FB.NBF(TT)	;STORE NUMBER OF BUFFERS
	SUBI D,3
	HRRZM D,FB.BWS(TT)	;STORE BUFFER DATA SIZE IN WORDS
OPEN1T:
]		;END OF IFN D10
	MOVSI TT,AS.FIL
	IORB TT,ASAR(A)		;NOW CAN TURN ON FILE ARRAY BIT
	MOVEI T,-F.GC
	HRLM T,-1(TT)		;SET UP GC AOBJN POINTER
	MOVEM A,(P)		;SAVE THE FILE ARRAY SAR
	PUSHJ P,ALCHAN		;ALLOCATE A CHANNEL
	 JRST OPNALZ		;LOSE IF NO FREE CHANNELS
	MOVE TT,TTSAR(A)
	HRRZM F,F.CHAN(TT)	;SAVE THE CHANNEL NUMBER IN THE FILE OBJECT
	POP FXP,T		;BEWARE THE LOCKI WORD!
	MOVEI D,F.DEV(TT)
	HRLI D,-L.F6BT+1(FXP)
	BLT D,F.DEV+L.F6BT-1(TT)	;COPY FILE NAMES INTO FILE OBJECT
	POPI FXP,L.F6BT		;FLUSH THEM FROM THE STACK
	EXCH T,(FXP)		;PUT LOCKI WORD ON STACK,
	PUSH FXP,T		;WITH MODE BITS ABOVE IT

;FALLS THROUGH

;FALLS IN

;STATE OF THE WORLD:
;	USER INTERRUPTS LOCKED OUT
;	TTSAR OF FILE ARRAY IN TT
;	P:	SAR FOR FILE ARRAY
;		SECOND ARGUMENT TO OPEN
;		FIRST ARGUMENT
;		-<# OF ACTUAL ARGS>
;	FXP:	MODE BITS	(THEY OFFICIALLY LIVE HERE, NOT IN T)
;		LOCKI WORD
;PDLS MUST STAY THIS WAY FROM NOW ON FOR THE SAKE OF IOJRST'S.
.SEE OPENLZ
OPEN3:	MOVE T,(FXP)		;GET MODE BITS
;NOW WE ACTUALLY TRY TO OPEN THE FILE
IFN ITS,[
	MOVE D,OPEN9C(T)
	TLNE T,FBT.AP		;APPEND MODE =>
	 TRO D,100000		; ITS WRITE-OVER MODE
	TLNE T,FBT.EC		;MAYBE OPEN AN OUTPUT TTY
	 TRO D,%TJPP2		; IN THE ECHO AREA (PIECE OF PAPER #2)
	.CALL OPENUP
	 IOJRST 4,OPNLZ0
	.CALL RCHST		;READ BACK THE REAL AND TRUE NAMES
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	JUMPL T,OPEN3M	.SEE FBT.CM	;NEED NOT ALLOCATE A CHANNEL FOR *THE* TTY
	MOVE F,F.CHAN(TT)
SA$	MOVEI R,(F)
	MOVEI D,(F)
	IMULI D,3
	ADDI D,BFHD0		;COMPUTE ADDRESS OF BUFFER HEADER
	MOVEM D,FB.HED(TT)	;REMEMBER BUFFER HEADER ADR
	SETZM (D)		;CLEAR BUFFER POINTER (TO FORCE NEW BUFFERS)
	SETZM 1(D)		;CLEAR OLD BYTE POINTER
	SETZM 2(D)		;CLEAR BYTE COUNT
	TRNE T,1
	 MOVSS D		;IF OUTPUT BUFFER, PUT ADDRESS IN LEFT HALF
	PUSH FXP,TT		;SAVE THE TTSAR
	MOVE T,OPEN9C(T)	;GET THE I/O MODE FROM THE TABLE
	MOVE TT,F.DEV(TT)
	LSH F,27
	IOR F,[OPEN 0,T]
	XCT F			;OPEN THE FILE
	 JRST OPNAND
SA$	SHOWIT R,
	MOVE R,-1(FXP)		;GET MODE BITS
	XOR F,[<INBUF>#<OPEN>]
	TRNE R,1
	 XOR F,[<OUTBUF>#<INBUF>]
	MOVE TT,(FXP)		;GET BACK TTSAR
	HRR F,FB.NBF(TT)	;GET NUMBER OF BUFFERS IN RH OF UUO
	MOVEI TT,FB.BUF(TT)
	EXCH TT,.JBFF		;.JBFF IS THE ORIGIN FOR ALLOCATING BUFFERS
	XCT F			;TELL THE MONITOR TO ALLOCATE BUFFERS
	MOVEM TT,.JBFF		;RESTORE OLD VALUE OF .JBFF
	AND F,[0 17,]		;ISOLATE CHANNEL NUMBER AGAIN
	IOR F,[LOOKUP 0,T]
	MOVE TT,(FXP)		;GET TTSAR BACK IN TT
	TRNE R,1		;WE NEED TO PERFORM A LOOKUP FOR
SA$	 TLNE R,FBT.AP		; EITHER "IN" OR "APPEND" MODE
SA$	  CAIA
	   JRST OPEN3C
	MOVE T,F.FN1(TT)
	MOVE R,F.PPN(TT)
	HLLZ TT,F.FN2(TT)
SA$	CAMN TT,[SIXBIT \___\]
SA$	 SETZ TT,
	SETZ D,
	XCT F			;PERFORM THE LOOKUP
	 IOJRST 4,OPNLZ1	;LOSEY LOSEY
OPEN3C:	MOVE D,-1(FXP)		;GET MODE BITS
	TRNN D,1		;NEED TO PERFORM AN ENTER FOR
	 JRST OPEN3D		; EITHER "OUT" OR "APPEND" MODE
SA$	TLNN D,FBT.AP		;APPEND MODE MEANS READ-ALTER, DO LOOKUP FIRST
	 XOR F,[<ENTER 0,T>#<LOOKUP 0,T>]
	MOVE TT,(FXP)		;GET TTSAR
	MOVE T,F.FN1(TT)
	MOVE R,F.PPN(TT)
	HLLZ TT,F.FN2(TT)
SA$	CAMN TT,[SIXBIT \___\]
SA$	 SETZ TT,
	SETZ D,
	XCT F			;DO THE ENTER (OR POSSIBLY LOOKUP FOR SAIL)
	 IOJRST 4,OPNLZ1	;LOSEY LOSEY
IFN SAIL,[
	MOVE D,-1(FXP)		;GET THOSE MODE BITS ONCE MORE
	TLNN D,FBT.AP		;APPEND MODE MEANS READ-ALTER
	 JRST SOPEN3C		;NORMAL CASE SO JUMP AHEAD
	XOR F,[<ENTER 0,T>#<LOOKUP 0,T>]	;MUMBLE
	MOVE TT,(FXP)		;GET TTSAR
	MOVE T,F.FN1(TT)
	PUSH FXP,R		;SAVE SIZE INFO
	MOVE R,F.PPN(TT)
	HLLZ TT,F.FN2(TT)
	CAMN TT,[SIXBIT \___\]
	 SETZ TT,
	SETZ D,
	XCT F			;PERFORM THE ENTER
	 IOJRST 4,OPNLZS	;LOSEY LOSEY
	XOR F,[<OUTPUT 0,>#<ENTER 0,T>]
	XCT F			;SET UP BUFFER HEADER BYTE POINTER AND COUNT
	XOR F,[<UGETF 0,T>#<OUTPUT 0,>]	;NOW THE UGETF, HEH, HEH
	XCT F
	POP FXP,R		;RESTORE SIZE INFO
	JRST OPEN3D		;GO, GO, GO
SOPEN3C:
]	;END IFN SAIL
	XOR F,[<OUT 0,>#<ENTER 0,T>]
	XCT F			;SET UP BUFFER HEADER BYTE POINTER AND COUNT
;AS A RESULT OF THE LOOKUP OR ENTER, THE SIZE INFORMATION IS IN R
OPEN3D:	MOVE D,TT
	POP FXP,TT
	HLLZM D,F.RFN2(TT)	;SAVE AWAY THE REAL, TRUE FILE NAMES
	MOVEM T,F.RFN1(TT)
	MOVE D,F.CHAN(TT)	;GET CHANNEL FOR DEVCHR
	DEVCHR D,		;DEVICE CHRACTERISTICS
	TLNE D,(DV.DIR)		;IF NON-DIRECTORY ZERO TRUENAMES
	 JRST OPN3D1
	SETZM F.RFN2(TT)
	SETZM F.RFN1(TT)
OPN3D1:	MOVE D,F.CHAN(TT)
SA%	DEVNAM D,		;GET REAL NAME OF DEVICE
SA$	PNAME D,
	 MOVE D,F.DEV(TT)	;USE GIVEN DEVICE NAME ON FAILURE
	MOVEM D,F.RDEV(TT)
	MOVE F,F.CHAN(TT)	;TRY TO DETERMINE REAL PPN
SA%	DEVPPN F,
SA%	 CAIA
SA%	  JRST OPEN3F
SA%	TRZ D,770000
	CAMN D,[SIXBIT \SYS\]
	 JRST OPEN3E
SA%	GETPPN F,		;IF ALL ELSE FAILS, ASSUME YOUR OWN PPN
SA%	 JFCL			;CAN'T REALLY FAIL - THIS JFCL IS FOR ULTRA SAFETY
SA$	SKIPE F,F.PPN(TT)	;IF PPN WAS SPECIFIED
SA$	 JRST OPEN3F		;USE IT AS TRUE PPN
SA$	SETZ F,
SA$	DSKPPN F,		;FOR SAIL, USE THE DSKPPN (ALIAS)
	JRST OPEN3F

OPEN3E:
SA%	MOVE F,[%LDSYS]
SA%	GETTAB R,
SA%	 MOVE F,R70+1		;ASSUME SYS: IS 1,,1 IF GETTAB FAILS
SA$	MOVE F,[SIXBIT \  1  3\]	;IT'S [1,3] ON SAIL
OPEN3F:	MOVEM F,F.RPPN(TT)
	JRST OPEN3N

OPEN3M:	MOVE D,F.DEV(TT)	;FOR THE TTY, JUST COPY THE DEVICE NAME
	MOVEM D,F.RDEV(TT)
OPEN3N:
]		;END OF IFN D10
IFN D20,[
 	TLNE T,FBT.EC+FBT.SC
	 LERR [SIXBIT \ECHO AREAS AND SCROLL MODE NOT YET IMPLEMENTED FOR TWENEX!\]
;; HERE WITH MODE BITS IN T
	HRRZS T			;GET ONLY OPEN9C TABLE INDEX (OPEN MODE)
	CAILE T,3		;ONLY CHECK FOR TTY IF STANDARD MODE
	 JRST OPEN3D
	MOVE T,F.DEV(TT)
	CAME T,[ASCII \TTY\]	;SKIP IF OPENING *THE* TTY
	 JRST OPEN3D
	MOVEI 1,.PRIIN		;CONSIDER USING THE PRIMARY JFN
	TLNE TT,TTS.IO		; OF THE APPROPRIATE DIRECTION
	 MOVEI 1,.PRIOU
	MOVEI 3,0		;NO JFN FOR TTY
;	GTSTS			;MAKE SURE IT IS OPEN
;	JUMPGE 2,OPEN3D		.SEE GS%OPN
;	MOVSI D,(GS%RDF+GS%NAM)	;MAKE SURE IT CAN DO THE KIND OF I/O WE WANT
;	TLNE TT,TTS.IO
;	 MOVSI D,(GS%WRF+GS%NAM)
;	TDC 2,D
;	TDCN 2,D
	MOVE T,(FXP)		;RESTORE FLAG BITS
	 JRST OPEN3E
;HERE TO ALLOCATE A FRESH JFN AND OPEN THE FILE
OPEN3D:	PUSH FXP,TT		;SAVE THE TTSAR
	MOVEI T,F.DEV(TT)
	HRLI T,-L.F6BT
	PUSH FXP,(T)		;COPY THE GIVEN DEVICE NAMES ONTO THE STACK
	AOBJN T,.-1
	PUSHJ P,6BTTLS		;CONVERT TO A NAMESTRING IN PNBUF
	POP FXP,TT		;GET TTSAR
	MOVE T,(FXP)		;RESTORE MODE BITS IN T
	MOVSI 1,GJ%SHT		.SEE .GJDEF
	TRNE T,1
	 TLNE T,FBT.AP
	  TLOA 1,(GJ%OLD)	;FOR INPUT OR APPEND, WE WANT AN EXISTING FILE
	   TLO 1,(GJ%FOU+GJ%NEW) ;FOR OUTPUT, A NON-EXISTENT FILE
	MOVE 2,PNBP
	GTJFN			;GET A JFN
	 IOJRST 4,OPNLZ0
	MOVE 3,1		;SAVE JFN
OPEN3E:	MOVE 2,OPEN9C(T)	;GET OPEN MODE
	TLNE T,FBT.AP		;APPEND MODE, SET APPEND, READ BITS, CLR WRITE
	 TRC 2,OF%RD		;  WANT UPDATE (WAS OF%APP+OF%WR+OF%RD)
	OPENF			;OPEN THE FILE
	 JRST OPNLZR
	HRRZM 1,F.JFN(TT)	;SAVE THE JFN IN THE FILE OBJECT
]		;END OF IFN D20

;FALLS THROUGH

;FALLS IN

10$	MOVE T,(FXP)		;FOR D10, FLAGS IN T MIGHT HAVE BEEN DESTROYED
	JUMPL T,OPEN3G		.SEE FBT.CM
	MOVE D,OPEN9D(T)	;SOME INITIALIZATION FOR BLOCK MODE FILES
	HRRZM D,FB.BYT(TT)	;SET UP BYTE SIZE
IFN ITS+D20,[
	HRRI D,FB.BUF-1(TT)
	MOVEM D,FB.IBP(TT)	;SET UP INITIAL BUFFER POINTER
	HRRZ D,OPEN9B(T)
]		;END OF IFN ITS+D20
10$	MOVE D,FB.BWS(TT)
	IMUL D,FB.BYT(TT)	;SET UP BUFFER LENGTH (IN BYTES)
	MOVEM D,FB.BFL(TT)
OPEN3G:	SETZM F.FPOS(TT)	;FILEPOS=0 (UNTIL FURTHER NOTICE)

;NOW DETERMINE THE SIZE OF THE FILE, AND SET THE ACCESS POINTER (IF APPLICABLE)
;MODE BITS ARE IN T, TTSAR IS IN TT; FOR D10, FILE SIZE INFO IN R;
;FOR D20, JFN IS IN 1

IFN ITS,[
	SKIPL F.FLEN(TT)	;THIS WAS SET BY RCHST BEFORE; -1 = NOT RANDOM
	 JRST OPEN3P		; ACCESS
	TLZ T,FBT.AP		;CAN'T APPEND IF NOT RANDOMLY ACCESSIBLE
	JRST OPEN3Q

OPEN3P:	HRLZI D,1		;ASSUME 1000000 FOR FAILING FILLEN (USR DEVICE)
	.CALL FILLEN		;DETERMINE LENGTH OF FILE
	 MOVEM D,F.FLEN(TT)
	TLNN T,FBT.AP
	 JRST OPEN3Q
	MOVE D,F.FLEN(TT)	;FOR APPEND MODE, SET THE ACCESS
	MOVEM D,F.FPOS(TT)	; POINTER TO THE END OF THE FILE
	.CALL ACCESS
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	JUMPL T,OPEN3Q		;DON'T DO ANY OF THIS FOR TTY
	MOVE D,F.CHAN(TT)
	DEVCHR D,
	TLNE D,(DV.DIR)
	 JRST OPEN3K
SA$	TLZ T,FBT.AP		;ASSUME A NON-DIRECTORY DEVICE CAN'T APPEND
	SETOM F.FLEN(TT)	; OR PERFORM RANDOM ACCESS
	JRST OPEN3Q

;FILE SIZE INFORMATION IS IN R
OPEN3K:
SA%	HLRE R,R		;FOR TOPS-10/CMU, THE LEFT HALF OF R
SA%	SKIPL R			; IS A WORD COUNT IF NEGATIVE AND A BLOCK COUNT
SA%	 IMULI R,200		; IF POSITIVE
SA$	MOVSS R			;SAIL JUST HAS SWAPPED NEGATIVE WORD COUNT
	MOVMS R
	IMUL R,FB.BYT(TT)
	MOVEM R,F.FLEN(TT)	;STORE FILE LENGTH
SA%	;SHOULD FALL THRU TO OPEN3Q
IFN SAIL,[
	TLNN T,FBT.AP
	 JRST OPEN3Q
	MOVEM R,F.FPOS(TT)	;FOR APPEND MODE, SET POINTER TO EOF
	MOVE F,F.CHAN(TT)
	LSH F,27
	IOR F,[UGETF 0,R]	;THIS UUO WILL CLOBBER R
;SA%	IOR F,[USETI 0,-1]
	XCT F			;SET MONITOR'S POINTER TO EOF
;HACK UP ON SAIL'S RECORD OFFSET FEATURE
	SETZM FB.ROF(TT)	;ASSUME NO RECORD OFFSET
	TLNN D,200000		;SKIP IF DSK/UDP (DEVCHR RESULT IS STILL IN D)
	 JRST OPEN3Q
	MOVEM T,(FXP)
	PUSH FXP,TT
	XOR F,[<MTAPE 0,T>#<UGETF 0,R>]
	MOVE T,[SIXBIT \GODMOD\]
	MOVEI TT,20		;SIXBIT \GODMOD\ ? 20 => GET RECORD OFFSET IN D
	XCT F
	POP FXP,TT
	MOVE T,(FXP)		;CONVERT RECORD OFFSET TO A BYTE OFFSET
	SUBI D,1		; FROM THE LOGICAL ORIGIN OF THE FILE
	IMUL D,FB.BFL(TT)
	MOVNM D,FB.ROF(TT)	;STORE AS A NEGATIVE OFFSET IN BYTES
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN D20,[
	SIZEF			;GET SIZE OF FILE
	 JRST OPN3JA		;  NOT A SIZEABLE FILE?
	MOVE 2,[2,,.FBBYV]
	MOVEI 3,D
	GTFDB			;R GETS LENGTH IN "FILE-BYTES"
	LDB C,[300600,,D]	; C GETS "FILE-BYTE" SIZE (IN BITS)
	MOVEI 2,36.
	IDIVI 2,(C)
	MOVE D,2		;D HAS # OF "FILE-BYTES" PER WORD
	TLNN T,FBT.AP
	 JRST OPEN3L
	SETO 2,
	SFPTR			;SET FILE POSITION TO END FOR APPENDING
	 JRST OPEN3J
	RFPTR			;READ BACK THE ACTUAL POSITION
	 IOJRST 4,OPENLZ
	MOVE R,2
;R HAS FILEN IN "FILE-BYTES", D HAS # OF "FILE-BYTES" PER WORD
OPEN3L:	TRNE T,4
	 JRST OPN3LB		;FIXNUM MODE -  7-BIT-BYTE FILEN TO WORD COUNT
OPN3LA:	CAIN D,5		;ASCII MODE FILE ARRAY  -  CHECK IF
	 JRST OPN3LC		; "FILE-BYTE" SIZE IS ALREAD 7 BITS
	IMULI R,5		; IF NOT, CONVERT COUNT TO 7-BIT-BYTE COUNT
OPN3LB:	CAIN D,1
	 JRST OPN3LC
	ADDI R,-1(D)
	IDIVI R,(D)
OPN3LC:	MOVEM R,F.FLEN(TT)	;STORE THE CALCULATED LENGTH-OF-FILE
	TLNE T,FBT.AP
	 MOVEM R,F.FPOS(TT)	;SET FILE POSITION TO END (FOR APPEND MODE)
	JRST OPEN3Q

OPEN3J:	CAIE 1,SFPTX2		;ILLEGAL TO RESET POINTER FOR THIS FILE?
	 IOJRST 4,OPENLZ
OPN3JA:	TLZ T,FBT.AP		;IF SO, JUST SAY WE CAN'T APPEND
	SETOM F.FLEN(TT)
]		;END OF IFN D20

OPEN3Q:	MOVEM T,(FXP)		;SAVE BACK POSSIBLY ALTERED MODE BITS
IFN ITS,[
	TLNN T,FBT.CA		;FOR THE CLA DEVICE,
	 JRST OPEN3H		; GOBBLE DOWN THE FIRST TWO WORDS,
	MOVEI T,F.RFN1(TT)	; WHICH ARE THE SIXBIT FOR THE
	HRLI T,444400		; UNAME-JNAME OF THE SENDER, AND
	MOVEI D,2		; USE THEM FOR THE TRUENAMES
	.CALL SIOT		; OF THE FILE ARRAY
	 IOJRST 4,OPENLZ
	MOVE T,(FXP)		;RESTORE MODE BITS
OPEN3H:
]		;END OF IFN ITS
	TRNE T,1
	 JRST OPEN3V
	HRRZ D,DEOFFN		;FOR INPUT, GET THE DEFAULT EOFFN
	MOVEM D,FI.EOF(TT)
	SETZM FI.BBC(TT)
;	SETZM FI.BBF(TT)	;NOT IMPLEMENTED YET
	JRST @OPEN3Z(T)		;DISPATCH TO APPROPRIATE PLACE

OPEN3V: HRRZ D,DENDPAGEFN	;FOR OUTPUT, GET THE DEFAULT ENDPAGEFN
	MOVEM D,FO.EOP(TT)
	MOVE D,DPAGEL		;DEFAULT PAGEL
	MOVEM D,FO.PGL(TT)
	MOVE D,DLINEL		;DEFAULT LINEL
	MOVEM D,FO.LNL(TT)
	SETZM FB.BVC(TT)
	JRST @OPEN3Z(T)		;DISPATCH TO APPROPRIATE PLACE

OPEN3Z:	OPNAI1	;ASCII DSK INPUT
	OPNAO1	;ASCII DSK OUTPUT
	OPNTI1	;ASCII TTY INPUT
	OPNTO1	;ASCII TTY OUTPUT
	OPNBI1	;FIXNUM DSK INPUT
	OPNBO1	;FIXNUM DSK OUTPUT
	OPNTI1	;FIXNUM TTY INPUT
	OPNTO1	;FIXNUM TTY OUTPUT
	OPNAI1	;IMAGE DSK INPUT
	OPNAO1	;IMAGE DSK OUTPUT
	OPNTI1	;IMAGE TTY INPUT
	OPNTO1	;IMAGE TTY OUTPUT

OPNBO1:
OPNAO1:	JUMPL T,OPNAT3		.SEE FBT.CM
	MOVE D,FB.BFL(TT)
	MOVEM D,FB.BVC(TT)
	JRST OPNA6
OPNBI1:
OPNAI1:	SETZM FB.BVC(TT)
OPNA6:
IFN ITS+D20,[
	JUMPL T,OPNAT3		.SEE FBT.CM
	MOVE D,FB.IBP(TT)	;INITIALIZE BUFFER BYTE POINTER
	HRRZ R,OPEN9B(T)
	TRNN T,1
	 ADDI D,(R)		;FOR AN INPUT BUFFER, FB.BP MUST BE ADJUSTED;
	MOVEM D,FB.BP(TT)	; THE FIRST "EMPTY" BUFFER ISN'T A REAL ONE
	MOVE D,FB.BFL(TT)
	TRNN T,1
	 SETZ D,
	MOVEM D,FB.CNT(TT)
]		;END OF IFN ITS+D20
	JRST OPNAT3

OPNTI1:
10$	JUMPGE T,OPNAI1		.SEE FBT.CM	;ONLY *THE* TTY HAS THESE HACKS
	SETZM TI.BFN(TT)
	SETZM FT.CNS(TT)
IFN ITS,[
	MOVE D,[STTYW1]
	MOVEM D,TI.ST1(TT)
	MOVE D,[STTYW2]
	MOVEM D,TI.ST2(TT)
	.CALL TTYGET
	 IOJRST 4,OPENLZ
;TURN OFF AUTO-INT, SUPER-IMAGE
	TLZ F,%TSINT+%TSSII
	TRNE T,10		;TTY IMAGE INPUT =>
	 TLO F,%TSSII		; ITS SUPER-IMAGE INPUT
	.CALL TTYSET
	 IOJRST 4,OPENLZ
]		;END OF IFN ITS
IFN SAIL,[
	MOVEI D,[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4]
	HRLI D,TI.ST1(T)
	SETACT D
	MOVSS D
	BLT D,TI.ST4(T)
	SETO D,
	GETLIN D
	AOSN D			;IF NOT -1 THEN OK TO USE CHARACTERISTICS
	 SETZ D,		; ELSE CAN MAKE NO ASSUMPTIONS ABOUT TTY
	TLNE D,460000		;CHECK DISLIN, DMLIN, DDDLIN
	 TLOA T,FBT.FU
	  TLZ T,FBT.FU
	MOVEM T,(FXP)
]		;END OF IFN SAIL
IFN D20,[
	MOVE 2,CCOCW1		;"REMODELED" CCOC WORDS
	MOVE 3,CCOCW2
	MOVEM 2,TI.ST1(TT)
	MOVEM 3,TI.ST2(TT)
	MOVE 1,F.JFN(TT)
	SFCOC			;SET CCOC WORDS
	MOVE 2,[STDJMW]
	TRNE T,10
	 XORI 2,<.TTBIN#.TTASC>_6	.SEE TT%DAM
	MOVEM 2,TI.ST3(TT)
	SFMOD
]		;END OF IFN D20
	JRST OPNAT3


;; ENTER WITH TTSAR IN TT
OPNTO1:
10$	JUMPGE T,OPNAO1		.SEE FBT.CM ;ONLY *THE* TTY HAS THESE HACKS!
	SETZM FT.CNS(TT)
IFN ITS,[
	.CALL CNSGET		;SET FO.RPL, FO.LNL, AND GET TTYOPT IN D
	 IOJRST 4,OPENLZ
	MOVEM D,TI.ST5(TT)	;STORE TTY OPTIONS WORD
	MOVSI R,200000		;INFINITE PAGEL INITIALLY
	MOVEM R,FO.PGL(TT)
	SOS FO.LNL(TT)
	TLNN T,FBT.EC
	 JRST OPNTO5
	.CALL SCML		;FOR ECHO AREA, SET NUMBER OF ECHO LINES TO 5
	 .LOSE 1400
OPNTO5:	.CALL TTYGET
	 .LOSE 1400
	TLNE F,%TSROL		;TURN ON SCROLL MODE IF TTY DEFAULTLY SCROLLS
	 TLO T,FBT.SC
	TLZ F,%TSFCO
	TLNE T,FBT.FU
	 TLO F,%TSFCO
	TLNE T,FBT.SC		;IF SCROLL MODE SET SCROLLING
	 TLO F,%TSROL
	.CALL TTYSAC
	 .LOSE 1400
	MOVE D,TI.ST5(TT)	;GET TTY OPTIONS WORD
]		;END OF IFN ITS
IFN D20,[
	MOVE 1,F.JFN(TT)
	MOVEI 2,.MORLW
	MTOPR%			;GET TERMINAL PAGE WIDTH
	SUBI 3,1
	MOVEM 3,FO.LNL(TT)	;SET LINEL
	MOVEI 2,.MORLL
	MTOPR%			;GET TERMINAL PAGE LENGTH
	MOVEM 3,FO.RPL(TT)
	RFMOD%
	TRNN 2,TT%PGM
	 MOVSI 3,200000		;FOR NON-PAGED MODE, USE INFINITY
	MOVEM 3,FO.PGL(TT)
	JSP R,OPNTO7		;capabilities word in D, in ITS format
]		;END OF IFN D20
IFN ITS\D20,[
;; ENTER HERE WITH TTYOPT WORD IN D
20$	TLZ T,FBT.CP+FBT.SE
20%	TLZ T,FBT.SA+FBT.CP+FBT.SE
20%	TLNE D,%TOSA1		;SKIP UNLESS WE HAVE SAIL CHARS
20%	 TLO T,FBT.SA		;SET SAIL BIT
	TLNE D,%TOMVU		;IF WE CAN MOVE BACK, ASSUME WE
	 TLO T,FBT.CP		; ARE A DISPLAY TERMINAL (THIS IS OK ACCORDING
				; TO ITSTTY)
	TLNE D,%TOERS		;REMEMBER THE SELECTIVE ERASE BIT
	 TLO T,FBT.SE		.SEE RUB1CH
	MOVEM T,(FXP)
	PUSHJ FXP,CLRO4		;INITIALIZE LINENUM AND CHARPOS
	JRST OPNA6
]	;END OF IFN ITS\D20


IFN D10,[
	MOVSI D,200000		;INFINITY (???)
	EXCH D,FO.PGL(TT)
	MOVEM D,FO.RPL(TT)
	SETZM AT.CHS(TT)	;SIGH
	SETZM AT.LNN(TT)
IFE SAIL,[
	SETO R,
	TRMNO. R,		;GET UNIVERSAL I/O INDEX FOR TERMINAL
	 JRST OPNTO6
	MOVEI D,.TOWID
	MOVE F,[2,,D]		;2-WD BLOCK: <.TOWID> ? <TERMINAL INDEX>
	TRMOP. F,		;TRY DETERMINING WIDTH OF TERMINAL	
OPNTO6:	 MOVEI F,111		;DEFAULT WIDTH IS 73.
	SUBI F,1		;REDUCE BY 1 SO NO WRAP-AROUND HAPPENS	
	MOVEM F,FO.LNL(TT)
	JRST OPNA6
]		;END OF IFE SAIL
;IFN SAIL, FALLS THROUGH TO OPNAT3
]		;END OF IFN D10
OPNAT3:	TRNE T,2
	 JRST OPNAT5
	SETZM AT.CHS(TT)
	SETZM AT.LNN(TT)
OPNAT5:	MOVEI D,1
	MOVEM D,AT.PGN(TT)
OPEN4:	POP FXP,F.MODE(TT)
	POP P,A			;SAR FOR FILE ARRAY - RETURNED
	MOVEI TT,-1
	SETZM @TTSAR(A)		;ILLEGAL FOR LOSER TO ACCESS AS ARRAY
	MOVSI TT,TTS<CL>
	ANDCAM TT,TTSAR(A)	;UNCLOSE IT
	POPI P,3		;FLUSH 2 ARGS AND # OF ARGS
20$	SETZB 2,3		;MAKE SURE AC'S CONTAIN NO JUNK
	UNLKPOPJ		;WE HAVE WON!

IFN ITS,[
TTYGET:	SETZ
	SIXBIT \TTYGET\		;GET TTYST1, TTYST2, TTYSTS
	      ,,F.CHAN(TT)	;TTY CHANNEL #
	  2000,,D		;TTYST1
	  2000,,R		;TTYST2
	402000,,F		;TTYSTS

TTYSET:	SETZ
	SIXBIT \TTYSET\		;SET TTYST1, TTYST2, TTYSTS
	      ,,F.CHAN(TT)	;TTY CHANNEL #
	      ,,TI.ST1(TT)	;TTYST1
	      ,,TI.ST2(TT)	;TTYST2
	400000,,F		;TTYSTS

SCML:	SETZ
	SIXBIT \SCML\		;SET NUMBER OF COMMAND LINES
	      ,,F.CHAN(TT)	;TTY CHANNEL #
	401000,,5		;NUMBER OF LINES

TTYSAC:	SETZ
	SIXBIT \TTYSET\		;SET TTY VARIABLES
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,D		;TTYST1
	      ,,R		;TTYST2
	400000,,F		;TTYSTS

CNSGET:	SETZ
	SIXBIT \CNSGET\		;GET CONSOLE PARAMETERS
	      ,,F.CHAN(TT)	;TTY CHANNEL #
	  2000,,FO.RPL(TT)	;VERTICAL SCREEN SIZE
	  2000,,FO.LNL(TT)	;HORIZONTAL SCREEN SIZE
	  2000,,D		;TCTYP (THROW AWAY)
	  2000,,D		;TTYCOM (THROW AWAY)
	402000,,D		;TTYOPT
				;TTYTYP NOT GOTTEN
]		;END OF IFN ITS

IFN D20,[
OPNTO7:	SETZB D,TI.ST5		;WILL CALCULATE TERMINAL-CAPABILITIES-WORD
	HRRZ 1,F.JFN(TT)	;  WORD INTO D
	TRNN T,14		;FIXNUM OR IMAGE?
	 SKIPN VTS20P
	  JRST (R)
	RTCHR			;GET TERMINAL-CAPABILITIES-WORD INTO D
	MOVEM 2,TI.ST5(TT)	;STORE TERMINAL-CAPABILITIES-WORD
	HLRZ D,2

;; RH OF D HAS D20 TC% CODES -- WANT ITS %TO CODES IN LH
OPNT7A:	TRNE D,(TC%BS)	
	 TLO D,%TOMVB
	TRNE D,(TC%MOV)
	 TLO D,%TOMVU+%TOMVB
	TRNE D,(TC%SCL)
	 TLO D,%TOERS
	TRNE D,(TC%LID)
	 TLO D,%TOLID
	TRNE D,(TC%CID)
	 TLO D,%TOCID
	JRST (R)

]	;END OF IFN D20



;;; VARIOUS ERROR HANDLERS - ARRIVE WITH A MESSAGE IN C.

;; BASIC LOSER IS AT   "OPNLZ0:"

IFN D20,[
OPNLZR:	MOVE 1,3
	RLJFN
	 JFCL
	IOJRST 4,OPNLZ0
]		;END OF IFN D20
IFN D10,[
SA$ OPNLZS:	POPI FXP,1
SA$		JRST OPNLZ1
OPNAND:	MOVEI C,NSDERR		;NO SUCH DEVICE
OPNLZ1:	POP FXP,TT
	JRST OPNLZ0
]		;END OF IFN D10


OPNALZ:	MOVEI C,[SIXBIT \ALL I/O CHANNELS ALREADY IN USE!\]
	POP FXP,-L.F6BT-1(FXP)		;FAKE OUT CORRECT PDL CONDITIONS
	POPI FXP,L.F6BT-1
	JRST OPNLZ4

OPENLZ:				;CLOSE THE LOSING CHANNEL FIRST
IFN ITS,[
	.CALL CLOSE9		;REMEMBER, TT HAS TTSAR
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	MOVE F,F.CHAN(TT)	
	LSH F,27
	IOR F,[RELEASE 0,0]
	XCT F
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)
	CLOSF
	 HALT
]		;END OF IFN D20
OPNLZ0:	MOVE F,F.CHAN(TT)	;THEN DEALLOCATE CHANNEL
	SETZM CHNTB(F)
OPNLZ4:	POP P,AR1		;FILE OBJECT SAR
	POP P,A			;SECOND ARG
	POP P,B			;FIRST ARG
	POP P,T			;ARG COUNT
	JUMPN T,OPNLZ3
	MOVEI A,(AR1)
	PUSHJ P,NAMELIST
	JRST OPNLZ2
OPNLZ3:	PUSHJ P,ACONS
	EXCH A,B
	PUSHJ P,ACONS
	CAMN T,XC-2
	HRRM B,(A)
OPNLZ2:	MOVEI B,Q$OPEN
	POPI FXP,1
	UNLOCKI
	JRST XCIOL




IFN ITS,[

OPENUP:	SETZ
	SIXBIT \OPEN\		;OPEN FILE
	  5000,,(D)		;I/O MODE BITS
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,F.DEV(TT)	;DEVICE NAME
	      ,,F.FN1(TT)	;FILE NAME 1
	      ,,F.FN2(TT)	;FILE NAME 2
	400000,,F.SNM(TT)	;SNAME

FILLEN:	SETZ
	SIXBIT \FILLEN\		;GET FILE LENGTH (IN WORDS)
	      ,,F.CHAN(TT)	;CHANNEL #
	402000,,F.FLEN(TT)	;PUT RESULT IN F.FLEN OF THE FILE OBJECT

ACCESS:	SETZ
	SIXBIT \ACCESS\		;SET FILE ACCESS POINTER
	      ,,F.CHAN(TT)	;CHANNEL #
	400000,,F.FPOS(TT)	;POSITION

RCHST:	SETZ
	SIXBIT \RCHST\		;READ CHANNEL STATUS
	      ,,F.CHAN(TT)	;CHANNEL #
	  2000,,F.RDEV(TT)	;DEVICE NAME
	  2000,,F.RFN1(TT)	;FILE NAME 1
	  2000,,F.RFN2(TT)	;FILE NAME 2
	  2000,,F.RSNM(TT)	;SNAME
	402000,,F.FLEN(TT)	;ACCESS POINTER
]		;END OF IFN ITS

;;; TABLES FOR OPEN FUNCTION

;;; ALL TABLES ARE INDEXED BY THE RIGHT HALF OF THE MODE WORD.

IT$	RBFSIZ==:200		;RANDOM BUFFER SIZE
20$	RBFSIZ==:200
10$	RBFSIZ==:0

;;; SIZES FOR FILE ARRAYS: <BLOCKMODE SIZE>,,<CHARMODE SIZE>
;;; FOR D10, THIS IS THE SIZE EXCLUSIVE OF THE BUFFER; FOR ITS AND D20, INCLUSIVE.
;;; SIZES ARE IN WORDS.

OPEN9A:	FB.BUF+RBFSIZ,,FB.BUF		;ASCII DSK INPUT
	FB.BUF+RBFSIZ,,FB.BUF		;ASCII DSK OUTPUT
		    ,,FB.BUF+NASCII/2	;ASCII TTY INPUT
	FB.BUF+RBFSIZ,,FB.BUF		;ASCII TTY OUTPUT
	FB.BUF+RBFSIZ,,FB.BUF		;FIXNUM DSK INPUT
	FB.BUF+RBFSIZ,,FB.BUF		;FIXNUM DSK OUTPUT
		    ,,FB.BUF+NASCII/2	;FIXNUM TTY INPUT
	FB.BUF+RBFSIZ,,FB.BUF		;FIXNUM TTY OUTPUT
	FB.BUF+RBFSIZ,,FB.BUF		;IMAGE DSK INPUT
	FB.BUF+RBFSIZ,,FB.BUF		;IMAGE DSK OUTPUT
		    ,,FB.BUF+NASCII/2	;IMAGE TTY INPUT
	FB.BUF+RBFSIZ,,FB.BUF		;IMAGE TTY OUTPUT

;;; <BITS FOR LEFT HALF OF TTSAR>,,<BLOCK MODE BUFFER SIZE>
;;; THE RIGHT HALF IS NOT REALLY USED FOR D10.

OPEN9B:
IRP X,,[A,X,I]J,,[,+BN,+IM]		;ASCII/FIXNUM/IMAGE
IRP Y,,[D,T]K,,[,+TY]			;DSK/TTY
IRP Z,,[I,O]L,,[,+IO]			;IN/OUT
IFSE X!!Y!!Z,IDI, LDGTW5:	.SEE LDGTWD	;CROCK
	TTS<CL!J!!K!!L>,,RBFSIZ
TERMIN
TERMIN
TERMIN

;;; <LEFT HALF FOR FB.IBP>,,<BYTES PER WORD>
;;; RELEVANT ONLY FOR BLOCK MODE FILES.  ONLY THE RIGHT HALF IS USED FOR D10.

OPEN9D:	010700,,5		;ASCII DSK INPUT
	010700,,5		;ASCII DSK OUTPUT
	0			;ASCII TTY INPUT (IRRELEVANT)
	010700,,5		;ASCII TTY OUTPUT
	004400,,1		;FIXNUM DSK INPUT
	004400,,1		;FIXNUM DSK OUTPUT
	0			;FIXNUM TTY INPUT (IRRELEVANT)
IT$	001400,,3		;FIXNUM TTY OUTPUT
10$ SA%	010700,,5
10$ SA$	001100,,4
20$	010700,,5
	010700,,5		;IMAGE DSK INPUT
	010700,,5		;IMAGE DSK OUTPUT
	0			;IMAGE TTY INPUT (IRRELEVANT)
10%	041000,,4		;IMAGE TTY OUTPUT
10$ SA%	010700,,5
10$ SA$	001100,,4	? WARN [IMAGE TTY OUTPUT?]

;;; OPEN9C CONTAINS THE OPEN MODE WORD.  FOR D10, THE MODE IS ALWAYS
;;; BLOCK MODE IF THIS TABLE IS USED.  FOR D20, THERE IS NO DIFFERENCE
;;; IN THIS TABLE FOR BLOCK VERSUS SINGLE MODE.

OPEN9C:
IFN ITS,[
;;; RECALL THE MEANINGS OF THE FOLLOWING BITS IN ITS:
;;;	1.3	0 => ASCII, 1 => IMAGE
;;;	1.2	0 => UNIT (CHARACTER) MODE, 1 => BLOCK MODE
;;;	1.1	0 => INPUT, 1 => OUTPUT
;;; ITS BLOCK MODE IS NOT USED FOR BUFFERED FILES; RATHER, SIOT IS USED.
	0		;ASCII DSK INPUT
	1		;ASCII DSK OUTPUT
	0		;ASCII TTY INPUT
	%TJDIS+1	;ASCII TTY OUTPUT (DISPLAY IF POSSIBLE)
	4		;FIXNUM DSK INPUT
	5		;FIXNUM DSK OUTPUT
	%TIFUL+0	;FIXNUM TTY INPUT (>7 BITS ON IMLACS AND TVS)
	%TJDIS+1	;FIXNUM TTY OUTPUT
	0		;IMAGE DSK INPUT
	1		;IMAGE DSK OUTPUT
	0		;IMAGE TTY INPUT (SUPER-IMAGE INPUT)
	%TJSIO+1	;IMAGE TTY OUTPUT (SUPER-IMAGE OUTPUT)
]		;END OF IFN ITS
IFN D10,[
	.IOASC		;ASCII DSK INPUT
	.IOASC		;ASCII DSK OUTPUT
	.IOASC		;ASCII TTY INPUT
	.IOASC		;ASCII TTY OUTPUT
	.IOBIN		;FIXNUM DSK INPUT
	.IOBIN		;FIXNUM DSK OUTPUT
	.IOASC		;FIXNUM TTY INPUT
	.IOASC		;FIXNUM TTY OUTPUT
	.IOASC		;IMAGE DSK INPUT
	.IOASC		;IMAGE DSK OUTPUT
	.IOIMG		;IMAGE TTY INPUT
	.IOIMG		;IMAGE TTY OUTPUT
]		;END OF IFN D10
IFN D20,[
.SEE OF%BSZ OF%MOD
	070000,,OF%RD		;ASCII DSK INPUT
	070000,,OF%WR		;ASCII DSK OUTPUT
	070000,,OF%RD		;ASCII TTY INPUT
	070000,,OF%WR		;ASCII TTY OUTPUT
	440000,,OF%RD		;FIXNUM DSK INPUT
	440000,,OF%WR		;FIXNUM DSK OUTPUT
	440000,,OF%RD		;FIXNUM TTY INPUT
	440000,,OF%WR		;FIXNUM TTY OUTPUT
	074000,,OF%RD		;IMAGE DSK INPUT
	074000,,OF%WR		;IMAGE DSK OUTPUT
	104000,,OF%RD		;IMAGE TTY INPUT
	104000,,OF%WR		;IMAGE TTY OUTPUT
]		;END OF IFN D20

IFN SAIL,[
;EOPEN FOR SAIL -- HANDLE 'E' FILES

;;; DO AN OPEN, THEN, IF THE FILE IS OPEN IN NON-IMAGE NON-TTY ASCII MODE SKIP
;;; OVER E'S COMMENT BY DOING SUCCESIVE IN'S
$EOPEN:	MOVEI TT,(P)		;MUST CALCULATE WHERE RETURN ADR IS
	ADD TT,T		;SUBTRACT NUMBER OF ARGS GIVEN
	PUSH FXP,(TT)		;REMEMBER USER'S RETURN ADR
	MOVEI R,$EOPN1		;NEW RETURN ADR
	MOVEM R,(TT)
	JRST $OPEN		;NOW OPEN THE FILE
$EOPN1:	MOVEI TT,F.MODE		;GET MODE OF FILE
	HRRZ TT,@TTSAR(A)
	SKIPE TT		;ASCII, DSK, INPUT?
	 POPJ FXP,		;NOPE, JUST RETURN
	PUSH P,A		;REMEMBER FILE ARRAY
	PUSH FXP,[440700,,[ASCIZ \COMMENT \]]
$EOPN2:	ILDB T,(FXP)		;GET NEXT CHARACTER TO LOOK FOR
	JUMPE T,$EOPN5		;LOOKS LIKE WE FOUND AN 'E' FILE, SKIP INDEX
	PUSH P,[$EOPN3]		;RETURN ADR
	PUSH P,-1(P)		;THE FILE ARRAY TO READ FROM
	MOVNI T,1		;ONE ARG
	JRST %TYI+1		;TYI ONE CHARACTER FROM THE FILE (NCALL)
$EOPN3:	JUMPL TT,$EOPN4		;EOF -- ERROR!
	LDB T,(FXP)		;GET THE CURRENT CHARACTER
	CAIN T,(TT)		;MATCH?
	 JRST $EOPN2		;YES, KEEP SCANNING THE FILE
	PUSH P,[$EOPN6]		;NOPE, FILEPOS TO BOF
	PUSH P,-1(P)		;FILE ARRAY
	PUSH P,CIN0		;ZERO - LOGICAL BOF
	MOVNI T,2		;TWO ARGS -- SET FILEPOS
	JRST FILEPOS
$EOPN6:	POPI FXP,1		;BYTE POINTER
	POP P,A			;FILE ARRAY RETURNED IN A
	POPJ FXP,		;RETURN TO USER

;HERE WHEN FOUND AN 'E' FILE, SKIP TO AFTER ^L AFTER NEXT ^V
$EOPN5:	PUSH P,[$EOPN7]		;RETURN ADR
	PUSH P,-1(P)		;THE FILE ARRAY TO READ FROM
	MOVNI T,1		;ONE ARG
	JRST %TYI+1		;TYI ONE CHARACTER FROM THE FILE (NCALL)
$EOPN7:	JUMPL TT,$EOPN4		;EOF -- ERROR!
	CAIE TT,^V		;FOUND ^V?
	 JRST $EOPN5		;NOPE, KEEP ON LOOPING
$EOPN8:	PUSH P,[$EOPN9]		;RETURN ADR
	PUSH P,-1(P)		;THE FILE ARRAY TO READ FROM
	MOVNI T,1		;ONE ARG
	JRST %TYI+1		;TYI ONE CHARACTER FROM THE FILE (NCALL)
$EOPN9:	JUMPL TT,$EOPN4		;EOF -- ERROR!
	CAIE TT,^L		;FOUND ^L?
	 JRST $EOPN8		;NOPE, KEEP ON LOOPING
	POPI FXP,1		;GET RID OF BYTE POINTER
	POP P,A			;RETURN FILE ARRAY
	POPJ FXP,		;TO USER

$EOPN4:	POP P,A			;FILE ARRAY -- EOF, WE LOST
	FAC [EOF READING A FILE WHICH LOOKED LIKE AN 'E' FILE - EOPEN!]
]		;END IFN SAIL

SUBTTL	DEFAULTF, ENDPAGEFN, EOFFN

;;; (DEFAULTF X) SETS THE DEFAULT NAMELIST TO X.
;;; X IS MERGEF'D WITH THE OLD NAMELIST FIRST.
;;; IT FOLLOWS THAT (DEFAULTF NIL) = (NAMELIST NIL).

DEFAULTF:
	PUSHJ P,FIL6BT
	PUSHJ P,DMRGF
	PUSHJ P,6BTNML
	MOVEM A,VDEFAULTF
	POPJ P,

SSCRFILE==DEFAULTF

;;; (EOFFN F) GETS INPUT FILE F'S END-OF-FILE FUNCTION.
;;; (EOFFN F X) SETS THE FUNCTION TO BE X.
;;; (ENDPAGEFN F) GETS OUTPUT FILE F'S END-OF-PAGE FUNCTION.
;;; (ENDPAGEFN F X) SETS IT TO BE X.

ENDPAGEFN:
	JSP TT,LWNACK	;LSUBR (1 . 2)
	LA12,,QENDPAGEFN
	MOVEI TT,ATOFOK
	MOVEI B,DENDPAGEFN
	MOVEI C,QENDPAGEFN
	JRST EOFFN0

EOFFN:	JSP TT,LWNACK		;LSUBR (1 . 2)
	LA12,,QEOFFN
	MOVEI TT,IFILOK
	MOVEI B,DEOFFN
	MOVEI C,QEOFFN
EOFFN0:	AOJN T,EOFFN5
	POP P,AR1
	JUMPE AR1,EOFFN2
IFN SFA,[
	PUSH FXP,TT
	JSP TT,XFOSP		;SFA?
	 JRST EOFFNZ
	 JRST EOFFNZ		;NOPE
	POPI FXP,1
	MOVEI A,(AR1)		;CALL THE SFA, AND RETURN ITS ANSWER
	HRRZI B,(C)		;THE OPERATION -- EOFFN OR ENDPAGEFUN
	SETZ C,			;WE WANT THE SFA TO RETURN A VALUE
	JRST ISTCSH		;SHORT INTERNAL CALL
EOFFNZ:	POP FXP,TT
]		;END IFN SFA
	PUSHJ P,(TT)
	MOVEI TT,FI.EOF		.SEE FO.EOP
	HRRZ A,@TTSAR(AR1)
	UNLKPOPJ

EOFFN2:	HRRZ A,(B)
	POPJ P,

EOFFN5:	POP P,A
	POP P,AR1
	JUMPE AR1,EOFFN7
IFN SFA,[
	PUSH FXP,TT
	JSP TT,XFOSP		;CHECK IF WE HAVE AN SFA
	 JRST EOFFNY
	 JRST EOFFNY		;NOPE
	POPI FXP,1
	JSP T,%NCONS		;LISTIFY IT SO IT IS IDENTIFIABLE AS AN ARG
	MOVEI B,(C)		;THE OPERATION
	MOVEI C,(A)		;AS THE ARG TO THE SFA
	MOVEI A,(AR1)		;THE SFA ITSELF
	JRST ISTCSH		;DO THE SHORT INTERNAL CALL
EOFFNY:	POP FXP,TT		;UNDO PUSHES
]		;END IFN SFA
	PUSHJ P,(TT)
	MOVE TT,TTSAR(AR1)
	HRRZM A,FI.EOF(TT)		.SEE FO.EOP
	UNLKPOPJ

EOFFN7:	HRRZM A,(B)
	POPJ P,

SUBTTL	LISTEN FUNCTION

;;; (LISTEN X) LISTENS TO THE SPECIFIED TTY X.

$LISTEN:
	SKIPA F,CFIX1	;LSUBR (0 . 1) NCALLABLE
	 MOVEI F,CPOPJ
	HRRZ AR1,V%TYI
	JUMPE T,$LSTN3
	MOVEI D,Q$LISTEN
	AOJN T,S1WNAL
	POP P,AR1		;FILE ARRAY SPECIFIED
$LSTN3:
IFN SFA,[
	JSP TT,XFOSP		;FILE OR SFA?
	 JRST $LSTNS
	 JRST $LSTNS		;NOT AN SFA
	JSP T,QIOSAV
	MOVEI A,(AR1)		;SFA IN A
	MOVEI B,Q$LISTEN	;OPERATION
	SETZ C,			;NO THIRD ARG
	PUSHJ P,ISTCSH		;SHORT INTERNAL SFA INVOCATION
	MOVE TT,(A)		;BE PREPARED IF NCALL'ED
	POPJ P,
$LSTNS:	]	;END IFN SFA
	PUSHJ P,TIFLOK		;IT BETTER BE TTY INPUT
IFN ITS,[
	.CALL LISTEN		;SO LISTEN ALREADY
	 SETZ R,		;ON FAILURE, JUST ASSUME 0
]		;END OF IFN ITS
IFN D10,[
	SKIPL T,F.MODE(TT)	.SEE FBT.CM
SA$	 JRST $LSTN4		? WARN [REALLY OUGHT TO BE SMARTER]
SA%	 JRST $LSTN5
IFE SAIL,[
	TLNE T,FBT.LN
	 SKIPA D,[SKPINL]
	  MOVSI D,(SKPINC)
]		;END OF IFE SAIL
IFN SAIL,[
	MOVE D,[SNEAKS R,]
	JRST $LSTN6

$LSTN4:	MOVE D,F.CHAN(TT)
	LSH D,27
	IOR D,[TTYSKP 0,]
]		;END OF IFN SAIL
$LSTN6:	XCT D
$LSTN5:	 TDZA R,R
	  MOVEI R,1
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)
	SIBE			;SKIP IF INPUT BUFFER EMPTY
	 SKIPA R,2		;NUMBER OF WAITING CHARS IN 2
	  SETZ R,
]		;END OF IFN D20
	MOVEI TT,FI.BBC
	MOVE A,@TTSAR(AR1)	;ALSO COUNT IN ANY BUFFERED
	TLZE A,-1		; UP CHARACTERS PENDING
	 AOS R
	JSP T,LNG1A
	ADD TT,R
	UNLOCKI
	JRST (F)

IFN ITS,[
LISTEN:	SETZ
	SIXBIT \LISTEN\		;LISTEN AT A TTY, ALREADY
	      ,,F.CHAN(TT)	;TTY CHANNEL #
	402000,,R		;NUMBER OF TYPED-AHEAD CHARS
]		;END OF IFN ITS

SUBTTL	LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM

;;; VARIOUS FUNCTIONS TO GET AND SET A FILE'S LINEL, PAGEL,
;;; CHARPOS, LINENUM, AND PAGENUM.

LINEL:	SKIPA D,CFIX1
	 MOVEI D,CPOPJ
	JSP F,FLFROB		;LSUBR (1 . 2)
	FO.LNL,,QLINEL
	DLINEL,,ATOFOK

PAGEL:	SKIPA D,CFIX1
	 MOVEI D,CPOPJ
	JSP F,FLFROB		;LSUBR (1 . 2)
	FO.PGL,,QPAGEL
	DPAGEL,,ATOFOK

CHARPOS:
	SKIPA D,CFIX1
	 MOVEI D,CPOPJ
	JSP F,FLFROB		;LSUBR (1 . 2)
	AT.CHS,,QCHARPOS
	0,,ATOFOK

LINENUM:
	SKIPA D,CFIX1
	 MOVEI D,CPOPJ
	JSP F,FLFROB		;LSUBR (1 . 2)
	AT.LNN,,QLINEN
	0,,ATFLOK

PAGENUM:
	SKIPA D,CFIX1
	 MOVEI D,CPOPJ
	JSP F,FLFROB		;LSUBR (1 . 2)
	AT.PGN,,QPAGENUM
	0,,ATFLOK

IFN SFA,[
FLFWNA:	HRRZ D,(F)		;FUNCTION NAME
	JRST WNALOSE		;WNA ERROR

FLNSFL: EXCH AR1,A
	WTA [NOT SFA OR FILE!]
]		;END IFN SFA
FLFROB:
IFN SFA,[
	CAME T,XC-1		;WRONG NUMBER OF ARGS?
	 CAMN T,XC-2
	  SKIPA
	   JRST FLFWNA
	MOVEI TT,(P)		;TOP OF STACK CONTAINS FILE ARG?
	CAMN T,XC-2		;UNLESS TWO ARGS
	 MOVEI TT,-1(P)
	MOVE A,(TT)		;GET THE ARG
	CAIN A,TRUTH
	 MOVE A,V%TYO
	MOVEM A,(TT)		;RE-STORE IT INCASE IT HAS BEEN ALTERED
	JUMPE A,FLFRF1		;IF NIL THEN HANDLE SPECIALLY
	EXCH A,AR1
	JSP TT,XFOSP
	 JRST FLNSFL		;NOT AN SFA OR FILE
	 JRST FLFRFL
	MOVEI AR1,NIL
	AOSE T			;HAVE TWO ARGS?
	 POP P,AR1		;YES, IT WILL BECOME SECOND ARG TO SFA
	EXCH AR2A,(P)		;SAVE AR2A ON STACK, GET SFA
	PUSH P,A		;SAVE OLD AR1
	PUSH P,C		;SIGH! THE PAIN WE GO THRU TO SAVE THE ACS!
	PUSH P,B

	MOVEI C,(AR1)		;THIRD ARG TO SFA IS NULL, IF THERE WAS ONLY 
	JUMPE T,.+4		; ONE ARG TO THE CALLING FUNCTION.  BUT 
	 MOVE A,AR1		; LISTIFY SECOND ARG IF THERE WERE TWO.
	 PUSHJ P,NCONS
	 MOVEI C,(A)
	MOVEI A,(AR2A)		;SFA INTO A
	HRRZ B,(F)		;OPERATION NAME INTO B
	PUSHJ P,ISTCSH
	POP P,B
	POP P,C
	POP P,AR1
	POP P,AR2A
	JSP T,FXNV1		;MAKE SURE RESULT IS A FIXNUM
	POPJ P,
FLFRFL:	EXCH A,AR1
FLFRF1:	]	;END IFN SFA
	AOJN T,FLFRB5
	PUSH P,AR1
	MOVE AR1,-1(P)
	MOVEM D,-1(P)
	JUMPE AR1,FLFRB3
FLFRB1:	HRRZ TT,1(F)
	PUSHJ P,(TT)
	HLRZ TT,(F)
	MOVM TT,@TTSAR(AR1)	.SEE STERPRI	;LINEL MAY BE NEGATIVE
	UNLOCKI
FLFB1A:	POP P,AR1
	POPJ P,

FLFRB3:	HLRZ TT,1(F)
	JUMPE TT,FLFRB1
	MOVE TT,(TT)
	JRST FLFB1A

FLFRB5:	POP P,A
	JSP T,FXNV1
	PUSH P,AR1
	MOVE AR1,-1(P)
	MOVEM D,-1(P)
	MOVE D,TT
	JUMPE AR1,FLFRB7
FLFRB6:	HRRZ TT,1(F)
	PUSHJ P,(TT)
	HLRZ TT,(F)
	MOVMS D
	EXCH D,@TTSAR(AR1)
	SKIPGE D
	 MOVNS @TTSAR(AR1)
	UNLOCKI
FLFRB8:	MOVE TT,D
	JRST FLFB1A

FLFRB7:	HLRZ TT,1(F)
	JUMPE TT,FLFRB6
	MOVMM D,(TT)
	JRST FLFRB8

SUBTTL	IN

;;; (IN X) INPUTS ONE FIXNUM FROM THE BINARY FILE X AND
;;; RETURNS IT.

$IN:	PUSH P,CFIX1		;SUBR 1 - NCALLABLE - ACS 1
	PUSH P,AR1
IFN SFA,[
	JSP TT,AFOSP		;FILE OR SFA OR NOT?
	 JFCL			;NOT, LET OTHER CODE GIVE ERROR
	 JRST $INNOS		;NOT SFA, PROCEED
	POP P,AR1
	PUSHJ FXP,SAV5M1	;SAVE ALL BUT A
	MOVEI B,Q$IN		;IN OPERATION
	SETZ C,			;NO THIRD ARG
	PUSHJ P,ISTCSH		;SHORT +INTERNAL-SFA-CALL
	PUSHJ FXP,RST5M1
	MOVE T,CFIX1
	CAMN T,(P)		;NCALL'ED?
	 POPI P,1		;YUP, WILL RETURN ARGS IN BOTH A AND TT
	JSP T,FXNV1		;INSURE A FIXNUM
	POPJ P,			;RETURN
$INNOS: ]	;END IFN SFA
	MOVEI AR1,(A)
	PUSHJ P,XIFLOK		;LOCKI, and put TTSAR in TT
IFN ITS+D20,[
	MOVEI R,(TT)		;SAVE A COPY OF TTSAR
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 JRST $IN2
;FOR ITS AND D20, HANDLE SINGLE MODE FILES
IFN ITS,[
	PUSH FXP,[%TIACT]	;ASSUME A TTY
	TLNN TT,TTS.TY		;A TTY?
	 SETZM (FXP)		;NO, SO NO FLAG BITS
	MOVE T,[444400,,TT]	;READ ONE 36.-BIT BYTE INTO TT
	MOVEI D,1
	.CALL INSIOT
	 .LOSE 1400
	POPI FXP,1
	JUMPN D,$IN7		;IF WE GOT NO WORD, ASSUME EOF
]		;END OF IFN ITS
IFN D20,[
	PUSH P,2		;PRESERVE AC'S
	HRRZ 1,F.JFN(TT)
	BIN			 ;READ ONE 36.-BIT BYTE INTO TT
	 ERJMP $INTST
	MOVE TT,2
	POP P,2
]		;END OF IFN D20
	AOS F.FPOS(R)
	JRST $IN1
IFN D20,[
$INTST:	PUSH FXP,2
	GTSTS
	TLNN 2,(GS%EOF)
	 JRST IIOERR
	POP FXP,TT
	POP P,2
	JRST $IN7
]	;END OF IFN D20
]		;END OF IFN ITS+D20
IFN D10,[
	SKIPGE F.MODE(TT)	.SEE FBT.CM
	 LERR [SIXBIT \SINGLE MODE BINARY NOT AVAILABLE - IN!\]
]		;END OF IFN D10
$IN2:
10$	HRRZ D,FB.HED(TT)
10%	SOSGE FB.CNT(TT)	;ARE THERE ANY BYTES LEFT?
10$	SOSGE 2(D)
	 JRST $IN3		;NO, GO GET ANOTHER BUFFER FULL
10%	ILDB TT,FB.BP(TT)	;YES, GOBBLE DOWN THE NEXT BYTE
10$	ILDB TT,1(D)
$IN1:	POP P,AR1
	UNLKPOPJ

;GET THE NEXT INPUT BUFFER
$IN3:
	MOVE F,FB.BVC(TT)
	ADDM F,F.FPOS(TT)	;UPDATE FILE POSITION
IFN D20\ITS,[
	MOVE T,FB.IBP(TT)
	MOVEM T,FB.BP(TT)	;REINITIALIZE BYTE POINTER
	MOVE D,FB.BFL(TT)	;GET BUFFER LENGTH INTO D
]	;END OF IFN D10\ITS
IFN ITS,[
	MOVE R,D		;GET NEXT BUFFER-LOAD
	.CALL SIOT
	 .LOSE 1400
	SUBB R,D		;GET COUNT OF BYTES OBTAINED
]		;END OF IFN ITS
IFN D20,[
	PUSH P,B
	PUSH P,C
	HRRZ 1,F.JFN(TT)
	MOVE 2,T
	MOVN 3,D
	SIN			;GET NEXT BUFFER-LOAD
	ADD D,3			;GET COUNT OF BYTES OBTAINED
	POP P,C
	POP P,B
]
IFN D10,[
	HRRZ F,F.CHAN(TT)
	LSH F,27
IFE SAIL,[
	TLNN TT,TTS.BM
	 JRST INB6		;$DEV5R
	HRRZ D,FB.HED(TT)	;MAYBE BUFFER HAS BEEN RELOCATED? THEN FOR
	MOVSI R,(BF.IOU) 
	ANDCAB R,@(D)		;TURNS OFF BUFFER-IN-USE BIT AND ADVANCES BUFFER
	SKIPGE (R)		;BF.IOU MUST BE BIT 4.9 FOR THIS TO WORK
	 JRST INB4 		;$DEV5S 
	MOVSI F,TTS.BM
	ANDCAM F,TTSAR(AR1)	;TURN OFF "BUFFER-MOVED" BIT, BUT LEAVE BUF ADDR IN F
	MOVE F,F.CHAN(TT)	;$DEV5Q:
	LSH F,27
	HRR F,R
]	;END OF IFE SAIL
INB6:	TLO F,(IN 0,)		;$DEV5R:
	XCT F			;GET NEXT INPUT BUFFER
	 JRST $IN4		;SUCCESS
	XOR F,[<STATO 0,IO.EOF>#<IN 0,>]
	XCT F			;SKIP IF EOF
	 JRST IIOERR 		;HALT FOR OTHER LOSS
$IN4:	MOVE D,FB.HED(TT)
	MOVE D,2(D)		;GET, FROM HEADER, NUMBER OF BYTES READ
]		;END OF IFN D10
$IN5M:	MOVEM D,FB.BVC(TT)	;STORE "VALID COUNT" - # OF OF BYTES OBTAINED
IFN D20\ITS,	MOVEM D,FB.CNT(TT)
	JUMPN D,$IN2		;EXIT IF WE GOT ANY (ELSE EOF?)
IFN D20,[
	PUSH P,B
	GTSTS			;GET FILE STATUS
	TLNN 2,(GS%EOF)		;SKIP ON EOF
	 JRST IIOERR 		;HALT FOR OTHER LOSS
	POP P,B
]		;END OF IFN D20
$IN7:	MOVEI A,(AR1)		;NO DATA WORDS - EOF
	HRRZ T,FI.EOF(TT)
	UNLOCKI
	POP P,AR1
	JUMPE T,$IN8
	JCALLF 1,(T)		;CALL USER EOF FUNCTION

IFN D10*<1-SAIL>,[
INB4:	HRRZ F,FB.HED(TT)
	HRRZM R,(F)		;STORE CURRENT BUFFER ADDR IN CONTROL BLOCK
	TLZ R,-1
	ADD R,[4400,,1]
	MOVEM R,1(F)		;CONSTRUCT NEW BP FOR BUFFER
	MOVE D,(R)
	MOVEM D,2(F)		;STORE NEW BYTE COUNT INITO BUFFERCONTROL-BLOCK
	JRST $IN5M
]	;END OF D10*<1-SAIL>

$IN8:	PUSH P,B		;NO USER EOF FUNCTION
	PUSHJ P,NCONS
	MOVEI B,Q$IN
	PUSHJ P,XCONS
	POP P,B
	IOL [EOF - IN!]		;SIGNAL ERROR

IFN ITS,[
INSIOT:	SETZ
	SIXBIT \SIOT\		;STRING I/O TRANSFER
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,T		;BYTE POINTER
	      ,,D		;BYTE COUNT
	404000,,(FXP)
]		;END IFN ITS

IFN D10*<1-SAIL>,[
IB4:	HRRZ D,FB.HED(TT)
	HRRZM R,(D)		;STORE CURRENT BUFFER ADDR IN CONTROL BLOCK
	TLZ R,-1
	ADD R,[4400,,1]
	MOVEM R,1(D)		;CONSTRUCT NEW BP FOR BUFFER
	MOVE R,(R)
	MOVEM R,2(D)		;STORE NEW BYTE COUNT INITO BUFFERCONTROL-BLOCK
	MOVEM R,FB.BVC(F)	;STORE "VALID COUNT" - # OF OF BYTES OBTAINED
	JRST $IN2
]	;END OF IFE D10*<1-SAIL>



SUBTTL	OUT

;;; (OUT X N) OUTPUTS THE FIXNUM N TO THE FILE X. RETURNS T.

$OUT:	PUSH P,AR1		;SUBR 2 - ACS 1
IFN SFA,[
	JSP TT,AFOSP		;FILE OR SFA OR NOT?
	 JFCL			;NOT, LET OTHER CODE GIVE ERROR
	 JRST $OUTNS		;NOT SFA, PROCEED
	POP P,AR1
	JSP T,QIOSAV
	MOVEI C,(B)		;ARG IS FIXNUM TO OUTPUT
	MOVEI B,Q$OUT		;OUT OPERATION
	JRST ISTCSH		;SHORT +INTERNAL-SFA-CALL
$OUTNS: ]	;END IFN SFA
	JSP T,FXNV2
	MOVEI AR1,(A)
	PUSHJ P,XOFLOK
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 JRST $OUT2
;OUTPUT ONE BYTE TO A SINGLE MODE BINARY FILE
10$	LERR [SIXBIT \SINGLE MODE BINARY NOT AVAILABLE - OUT!\]
IFN ITS,[
	MOVE R,D
	MOVEI D,1
	MOVE T,[444400,,R]
	.CALL SIOT
	 .LOSE 1400
]		;END OF IFN ITS
IFN D20,[
	PUSH P,B
	HRRZ 1,F.JFN(TT)
	MOVE 2,D
	BOUT
	 ERJMP OIOERR
	POP P,B
]		;END OF IFN D20
IFN ITS+D20,[
	AOS F.FPOS(TT)
	JRST $OUT1
]		;END OF IFN ITS+D20

$OUT3:	PUSH FXP,D
10%	SETZM FB.CNT(TT)	;DOING OWN BUFFERED I/O, -1 IN FB.CNT IS N.G.
	PUSHJ P,IFORCE		;FORCE OUT CURRENT OUTPUT BUFFER
	POP FXP,D
$OUT2:
10$	HRRZ R,FB.HED(TT)
10%	SOSGE FB.CNT(TT)	;SEE IF THERE IS ROOM FOR ANOTHER BYTE
10$	SOSGE 2(R)
	 JRST $OUT3		;NO, GO OUTPUT THIS BUFFER FIRST
10%	IDPB D,FB.BP(TT)	;STICK BYTE IN BUFFER
10$	IDPB D,1(R)
$OUT1:	POP P,AR1
	JRST UNLKTRUE


SUBTTL	FILEPOS, LENGTHF

;;; FILEPOS FUNCTION
;;;	(FILEPOS F) RETURNS CURRENT FILE POSITION
;;;	(FILEPOS F N) SETQ FILEPOS TO X
;;; FOR ASCII FILES, THE POSITION IS MEASURED IN CHARACTERS;
;;; FOR FIXNUM FILES, IN FIXNUMS (WORDS).  ZERO IS THE
;;; BEGINNING OF THE FILE.  ERROR IF FILE IS NOT RANDOMLY
;;; ACCESSIBLE.

FILEPOS:
	AOJE T,FPOS1		;ONE ARG => GET
	AOJE T,FPOS5		;TWO ARGS => SET
	MOVEI D,QFILEPOS	;ARGH! ARGH! ARGH! ...
	JRST S2WNALOSE

IFN D20,[
FPOS0E:	POP P,B
	JRST FPOS0D
]		;END OF IFN D20

FPOS0B:	SKIPA C,FPOS0
FPOS0C:	 MOVEI C,[SIXBIT \ILLEGAL ACCESS POINTER!\]
FPOS0D:	MOVEI A,(B)		;COME HERE FOR TWO-ARG CASE,
	PUSHJ P,NCONS		; MESSAGE IN C
	JRST FPOS0A

FPOS0:	MOVEI C,[SIXBIT \FILE NOT RANDOMLY ACCESSIBLE!\]
	SETZ A,			;HERE FOR ONE-ARG ERROR, MESSAGE IN C
FPOS0A:	MOVEI B,(AR1)
	PUSHJ P,XCONS
	MOVEI B,QFILEPOS
	UNLOCKI
	JRST XCIOL

;ONE-ARGUMENT CASE: GET FILE POSITION
FPOS1:	POP P,AR1		;ARG IS FILE
IFN SFA,[
	JSP TT,XFOSP		;DO WE HAVE AN SFA?
	 JRST FP1SF1		;NOPE
	 JRST FP1SF1		;NOPE
	MOVEI A,(AR1)		;YES, CALL THE STREAM
	MOVEI B,QFILEPOS
	SETZ C,			;NO ARGS
	JRST ISTCSH
FP1SF1:	]	;END IFN SFA
	PUSHJ P,FILOK		;DOES LOCKI
	SKIPGE F.FLEN(TT)
	 JRST FPOS0		;ERROR IF NOT RANDOMLY ACCESSIBLE
	SKIPGE D,F.FPOS(TT)
	 JRST FPOS1A
10$	MOVE R,FB.HED(TT)
	ADD D,FB.BVC(TT)
10%	SUB D,FB.CNT(TT)	;FOR BUFFERED FILES, ADJUST FOR COUNT
10$	SUB D,2(R)
FPOS1A:	TLNN TT,TTS<IO>
	 SKIPN B,FI.BBC(TT)
	  JRST FPOS2
	TLZE B,-1		;ALLOW FOR ANY BUFFERED BACK CHARS
	 SUBI D,1
FPOS1C:	JUMPE B,FPOS2
	HRRZ B,(B)
SA%	SKIPLE D
SA$	CAMLE D,FB.ROF(TT)	;FOR SAIL, MAY BE AS LOW AS RECORD OFFSET
	 SOJA D,FPOS1C
FPOS2:	MOVE TT,D		;RETURN POSITION AS FIXNUM
	UNLOCKI
	JRST FIX1

;TWO-ARGUMENT CASE: SET FILE POSITION
FPOS5:	POP P,B			;SECOND ARG IS T, NIL, OR FIXNUM
	POP P,AR1		;FIRST IS FILE
IFN SFA,[
	JSP TT,XFOSP		;DO WE HAVE AN SFA?
	 JRST FP5SF1		;NOPE, CONTINUE
	 JRST FP5SF1		;NOPE
	MOVEI A,(B)		;LISTIFY THE ARG
	JSP T,%NCONS
	MOVEI C,(A)		;PASS IT AS THE ARG TO THE SFA
	MOVEI A,(AR1)		;THE SFA
	MOVEI B,QFILEPOS	;FILEPOS OPERATION
	JRST ISTCSH
FP5SF1:	]	;END IFN SFA
	SETZ D,
	JUMPE B,FPOS5A		;NIL MEANS ABSOLUTE BEGINNING OF FILE
	CAIE B,TRUTH		;T MEANS END OF FILE
	 JSP T,FXNV2		;OTHERWISE A FIXNUM POSITION
FPOS5A:	PUSHJ P,FILOK		;DOES LOCKI, SAVES D
10$	TLNN TT,TTS.IO		;OUTPUT LOSES FOR D10
	 SKIPGE F.FLEN(TT)	;NOT RANDOMLY ACCESSIBLE?
	  JRST FPOS0C
SA%	JUMPL D,FPOS0C		;FOR NON-SAIL, NEGATIVE POSITION ILLEGAL
SA$	CAMGE D,FB.ROF(TT)	;FOR SAIL, MAY BE DOWN TO RECORD OFFSET
SA$	 JRST FPOS0C
IFN ITS+D20,[
	TLNN TT,TTS.IO
	 JRST FPOS6
	PUSH FXP,D
	PUSHJ P,IFORCE		;FORCE OUTPUT BUFFER
	POP FXP,D
	MOVE R,F.FPOS(TT)	;CALCULATE PRESENT FILE POSITION
	SKIPL F.MODE(TT)
	 ADD R,FB.BVC(TT)
	SKIPL F.MODE(TT)
	 SUB R,FB.CNT(TT)
	CAMLE R,F.FLEN(TT)	;ADJUST LENGTH UPWARD IF NECESSARY
	 MOVEM R,F.FLEN(TT)
FPOS6:
]		;END OF IFN ITS+D20
	CAMLE D,F.FLEN(TT)
	 JRST FPOS0C		;LOSE IF SPECIFIED POSITION GREATER THAN LENGTH
SA$	CAIN B,NIL		;R IS BY DEFAULT 0, BUT FOR SAIL
SA$	 MOVE D,FB.ROF(TT)	; NIL MEANS USE THE RECORD OFFSET
	CAIN B,TRUTH
	 MOVE D,F.FLEN(TT)
IFE D10,[
	TLNE TT,TTS.IO		;DETERMINE IF BYTE WE DESIRE IS IN THE BUFFER
	 JRST FPOSZ		; IF AN INPUT FILE
	MOVE R,F.FPOS(TT)	;POSITION OF FIRST BYTE IN BUFFER
	CAMGE D,R		;IF TARGET TOO SMALL THEN MUST DO I/O
	 JRST FPOSZ
	ADD R,FB.BVC(TT)	;ADD IN NUMBER OF BYTES IN THE BUFFER
	CAML D,R		;IF TARGET TOO LARGE THEN ALSO MUST DO I/O
	 JRST FPOSZ
	MOVE R,F.FPOS(TT)	;IN RANGE, GET POS OF FIRST BYTE IN BUFFER
	SUBM D,R		;MAKE R INTO BYTE OFFSET INTO BUFFER
	MOVE D,FB.IBP(TT)	;RESTORE BYTE POINTER
	MOVEM D,FB.BP(TT)
	MOVE D,FB.BVC(TT)	;GET VALID NUMBER OF BYTES IN BUFFER
	SUBI D,(R)		;NUMBER OF BYTES REMAINING
	MOVEM D,FB.CNT(TT)	; IS THE NEW COUNT
	SKIPE R
	 IBP FB.BP(TT)		;SKIP APPROPRIATE NUMBER OF BYTES
	SOJG R,.-1
	SETZM FI.BBC(TT)	;CLEAR BUFFERED BACK CHARACTER
	JRST UNLKTRUE
FPOSZ:
]		;END IFE D10

	MOVEM D,F.FPOS(TT)
IFN ITS,[
	.CALL ACCESS		;SET FILE POSITION
	 IOJRST 0,FPOS0D	;JUMP ON FAILURE
]		;END OF IFN ITS
IFN D20,[
	PUSH P,B
	CAME D,F.FLEN(TT)	;BE ULTRA CAUTIOUS
	 SKIPA 2,D
	  SETO 2,
	HRRZ 1,F.JFN(TT)
	SFPTR			;SET FILE POINTER
	 IOJRST 0,FPOS0E
	POP P,B
]		;END OF IFN D20
IFN D10,[
	IDIV D,FB.BFL(TT)	;DIVIDE FILE POSITION BY BUFFER LENGTH
	MOVE T,F.CHAN(TT)
	LSH T,27
	TLO T,(USETI 0,0)
	HRRI T,1(D)		;BLOCKS ARE NUMBERED 1-ORIGIN
	XCT T			;POSITION FILE TO CORRECT BLOCK
	IMUL D,FB.BFL(TT)	;CALCUALTE F.FPOS
	MOVEM D,F.FPOS(TT)
	MOVE T,FB.HED(TT)
	SETZM 2(T)		;ZERO THE REMAINING BYTE COUNT
	HRLZI D,400000		;NOW WE HAVE TO ZERO ALL USE BITS
FPOS6C:	HRRZ T,(T)		;GET POINTER TO NEXT BUFFER
	SKIPL (T)		;THIS ONE IN USE?
	 JRST FPOS6B		;NOPE, SO WE ARE DONE
	XORM D,(T)		;CLEAR THE USE BIT
	JRST FPOS6C		;AND LOOP OVER ALL BUFFERS
FPOS6B:
]		;END OF IFN D10
10%	TLNE TT,TTS.IO
10%	 JRST FPOS6A
	SETZM FB.BVC(TT)
	SETZM FI.BBC(TT)
;	SETZM FI.BBF(TT)	;NOT IMPLEMENTED YET
FPOS6A:
IFN ITS+D20,[
	SKIPGE F.MODE(TT)
	 JRST UNLKTRUE		;THAT'S ALL FOR SINGLE MODE FILES
	TLNE TT,TTS.IO
	 JRST FPOS7		;JUMP FOR OUTPUT FILES
]		;END OF IFN ITS+D20
	MOVE T,TT
10$	PUSH FXP,R		;R HAS DESIRED BYTE WITHIN BLOCK
	PUSHJ P,$DEVBUF		;GET NEW INPUT BUFFER
	 JFCL			;IGNORE EOF
10%	JRST UNLKTRUE
IFN D10,[
	POP FXP,R
	MOVE TT,FB.HED(T)
	MOVN D,R
	ADDM D,2(TT)		;DECREASE COUNT BY NUMBER OF SKIPPED BYTES
	SKIPE R
	 IBP 1(TT)		;SKIP APPROPRIATE NUMBER OF BYTES
	SOJG R,.-1
]		;END OF IFN D10
	JRST UNLKTRUE

IFN ITS+D20,[
FPOS7:	JSP D,FORCE6		;INITIALIZE OUTPUT POINTERS
	JRST UNLKTRUE
]		;END OF IFN ITS+D20


;;; LENGTHF -- SUBR, 1 ARG, NCALLABLE
;;;  RETURNS THE LENGTH OF AN OPEN FILE
$LENWT:	EXCH A,AR1
	%WTA NAFOS
$LENGTHF:
	PUSH P,CFIX1		;STANDARD ENTRY, RETURN FIXNUM
				;ALTERNATE ENTRY, RETURN NUMBER IN TT
	EXCH A,AR1		;FILE/SFA INTO AR1
	JSP TT,XFOSP		;MUST BE EITHER
	 JRST $LENWT
IFN SFA,[
	 JRST $LENFL
	EXCH AR1,A
	JSP T,QIOSAV
	MOVEI B,Q$LENGTHF
	SETZ C,
	PUSHJ P,ISTCSH		;SHORT INTERNAL SFA CALL
	MOVE T,CFIX1
	CAMN T,(P)		;WE WILL RETURN RESULTS IN A AND TT, SO NO NEED TO RECONS
	 POPI P,1
	JSP T,FXNV1
	POPJ P,
$LENFL:	]	;END IFN SFA
	EXCH A,AR1
	MOVEI TT,F.FLEN		;GET FILE LENGTH
	MOVE TT,@TTSAR(A)
	POPJ P,			;RETURNS TO CFIX1 OR CPOPJ

SUBTTL	CONTROL-P CODES AND TTY INITIALIZATION

;;; CNPCHK DOES A .5LOCKI. THEN SKIPS IF CAPABILITY EXITS.
;;; Leaves file-array ttsar in T, if successful
;;; CLOBBERS T, TT, D, AND F.  SAVES R (SEE RUB1C3).
;;; SEE COMMENTS ON CNPCOD BELOW

CNPCHK:	.5LKTOPOPJ		.SEE INTTYR
				.SEE CRSRP7
	HLLOS NOQUIT
IFE ITS\D20, 	POPJ FLP,

IFN ITS\D20,[

20$ 	SKIPN VTS20P
20$ 	 POPJ FLP,

;IFN ITS,[
;	.CALL [ SETZ
;		SIXBIT \TTYVAR\
;		      ,,F.CHAN(T)		;CHANNEL
;			[SIXBIT \TTYOPT\] 	;READ THE TTYOPT VARIABLE
;		402000,,TT			;RETURN RESULT INTO TT
;		]
;	 POPJ FLP,		;OH WELL, ASSUME NOTHING IS LEGAL
;]	;END OF IFN ITS

	MOVE T,TTSAR(AR1)
	MOVE TT,TI.ST5(T)	;GET TERMINAL-CAPABILITIES-WORD
IFN D20,[
	HLRZS TT
	EXCH TT,D
	JSP R,OPNT7A		;CONVERT TO ITS-STYLE %TO BITS
	EXCH TT,D
]	;END OF IFN D20
	XCT CNPOK-"A(D)		;IS THIS FUNCTION DOABLE?
	 POPJ FLP,		;WOULD HAVE NO AFFECT ANYWAY SO JUST RETURN
	AOS (FLP)
	POPJ FLP,

;; TABLE OF INSTRUCTIONS TO DETERMINE IF A ^P CODE IS DOABLE ON THE TERMINAL
;; AND RCPOS: AND RSTCUR:

CNPOK:	SKIPA		;A	OK ON ALL TTY'S
	TLNN TT,%TOMVB	;B	ON TTY'S THAT CAN DO IT DIRECTLY
	SKIPA		;C	THIS HAS SOME AFFECT ON ALL TTY'S
	SKIPA		;D
	TLNN TT,%TOERS	;E	REQUIRES %TOERS
	SKIPA		;F
	JFCL
	SKIPA		;H
	TLNN TT,%TOMVU	;I
	JFCL
	TLNN TT,%TOMVU	;K	ASSUME ONLY ON DISPLAY TERMINALS
	TLNN TT,%TOERS	;L
	SKIPA		;M
	SKIPA		;N
	JFCL
	SKIPA		;P
	SKIPA		;Q
	TLNN TT,%TOMVU	;R	MAKE SAME ASSUMPTION AS K AND S
	TLNN TT,%TOMVU	;S
	TLNN TT,%TOMVU	;T	WHEREAS C IS MEANINGFUL FOR NON-DISPLAYS, I
			;	DO NOT FEEL THIS IS
	TLNN TT,%TOMVU	;U
	TLNN TT,%TOMVU	;V
	JFCL
			;X	TTY'S THAT CAN BACKSPACE AND DON'T OVERSTRIKE
			;	OR THAT CAN ERASE
	PUSHJ P,[TLNN TT,%TOMVB	;MUST BE ABLE TO BACK-UP
		  POPJ P,
		 TLNN TT,%TOERS	;IF CAN ERASE IS OK
		  TLNN TT,%TOOVR ;OR IF DOESN'T OVERSTRIKE
		   AOS (P)
		 POPJ P,]
	JFCL
	TLNN TT,%TOMVU	;Z	SAME CRITERIA AS ^PT
	TLNN TT,%TOLID	;[
	TLNN TT,%TOLID	;\
	TLNN TT,%TOERS	;]	SAME AS ^PL
	TLNN TT,%TOCID	;^
	TLNN TT,%TOCID	;_
;; WARN [CURSORPOS S AND R SHOULD SAVE AND RESTORE POSITION INFO FOR TTY]

] 	;END OF IFN ITS\D20


;;; PUSH A ^P CODE INTO A TTY FILE ARRAY IN AR1.
;;; THE CHARACTER TO FOLLOW THE ^P IS IN D.
;;; IF THE CHARACTER IS "H, "I, OR "V, THEN THE SECOND
;;; CHARACTER IS IN THE LEFT HALF OF D.
;;; CHARPOS, LINENUM, AND PAGEL ARE CORRECTLY UPDATED.
;;; I/O LOSSES DUE TO INTERRUPTS BETWEEN ^P AND THE
;;; NEXT CHARACTER ARE SCRUPULOUSLY AVOIDED.
;;; CLOBBERS T, TT, D, AND F.  SAVES R (SEE RUB1C3).


CNPCOD:	PUSHJ FLP,CNPCHK	;DOES A .5LOCKI. THEN SKIPS IF CAPABILITY EXITS
	 JRST CZECHI		; BUT IF NOT EXISTS, THEN JUST FAILS TO SKIP
CNPCUR:	MOVE TT,F.MODE(T)
	PUSH FXP,D
	JUMPL TT,CNPCD1		.SEE FBT.CM
IFE ITS\D20,	LERR [SIXBIT \LOSE ON BUFFERED FILES - CNPCOD!\]
IFN ITS\D20,[
	MOVE TT,FB.CNT(T)
	SUBI TT,3
	JUMPGE TT,CNPCD1
	MOVE TT,T		;IF THERE ISN'T ROOM IN THE CURRENT BUFFER
	PUSHJ P,IFORCE		; FOR THE WHOLE ^P CODE SEQUENCE, FORCE
	MOVE T,TTSAR(AR1)	; OUT THE BUFFER TO AVOID TIMING ERRORS
]	;END OF IFN ITS\D20
CNPCD1:
IFE ITS\D20,	JRST CZECHI
IFN ITS\D20,[
	SETZM ATO.LC(T)		;IF USING ^P CODES, THEN FORGET WE DID LF
	MOVEI TT,^P		;OUTPUT A ^P
	PUSHJ P,TYOF6
	HRRZ TT,(FXP)		;OUTPUT THE CHARACTER
	PUSHJ P,TYOF6
	HLRZ TT,(FXP)
	JUMPE TT,CNPCD2
	TRZ TT,400000		;OUTPUT ANY ADDITIONAL MAGIC ARGUMENT
	PUSHJ P,TYOF6
CNPCD2:	POP FXP,TT
	XCT CNPC9-"A(TT)	;ACCOUNT FOR THE EFFECTS OF THE ^P CODE
IT$	 .LOSE
20$ 	 HALTF 

CNPC9:	JRST CNP.A	;A	ADVANCE TO FRESH LINE
	JRST CNP.B	;B	MOVE BACK 1, WRAPAROUND
	JRST CNP.C	;C	CLEAR SCREEN
	JRST CNP.D	;D	MOVE DOWN, WRAPAROUND
	JRST CZECHI	;E	CLEAR TO EOF
	JRST CNP.F	;F	MOVE FORWARD 1, WRAPAROUND
	JFCL
	JRST CNP.H	;H	SET HORIZONTAL POSITION
	JRST CNP.I	;I	NEXT CHARACTER IS ONE-POSITION PRINTING CHAR
	JFCL
	JRST CZECHI	;K	KILL CHARACTER UNDER CURSOR
	JRST CZECHI	;L	CLEAR TO END OF LINE
	JRST CNP.M	;M	GO INTO **MORE** STATE, THEN HOME UP
	JRST CZECHI	;N	GO INTO **MORE** STATE
	JFCL
	JRST CZECHI	;P	OUTPUT A ^P
	JRST CZECHI	;Q	OUTPUT A ^C
	JRST CZECHI	;R	RESTORE CURSOR POSITION
	JRST CZECHI	;S	SAVE CURSOR POSITION
	JRST CNP.T	;T	TOP OF SCREEN (HOME UP)
	JRST CNP.U	;U	MOVE UP, WRAPPING AROUND
	JRST CNP.V	;V	SET VERTICAL POSITION
	JFCL
	JRST CNP.X	;X	BACKSPACE AND ERASE ONE CHAR
	JFCL
	JRST CNP.Z	;Z	HOME DOWN
	JRST CNP.IL	;[	INSERT LINE	;BEWARE THE BRACKETS!
	JRST CNP.DL	;\	DELETE LINE
	JRST CZECHI	;]	SAME AS L (OBSOLETE)
	JRST CZECHI	;^	INSERT CHARACTER
	JRST CZECHI	;_	DELETE CHARACTER


;;; STILL WITHIN AN IFN ITS\D20

CNP.X:				;SAME AS ^P K ^P B
CNP.B:	MOVE D,FO.LNL(T)	;MOVE BACKWARDS
	SUBI D,1
	SOSGE AT.CHS(T)		;WRAP AROUND IF AT LEFT MARGIN
	 MOVEM D,AT.CHS(T)
	JRST CZECHI

CNP.M:				;DOES **MORE**, THEN HOMES UP
CNP.C:	AOS AT.PGN(T)		;CLEAR SCREEN - AOS PAGENUM
CNP.T:	SETZM AT.LNN(T)		;HOME UP - CLEAR LINENUM AND CHARPOS
CNP.IL:				;INSERT LINE - CLEAR CHARPOS
CNP.DL:				;DELETE LINE - CLEAR CHARPOS
	SETZM AT.CHS(T)
	JRST CZECHI

CNP.A:	SKIPN AT.CHS(T)		;CRLF, UNLESS AT START OF LINE
	 JRST CZECHI
	SETZM AT.CHS(T)		;CLEAR CHARPOS, THEN INCR LINENUM
CNP.D:	AOS D,AT.LNN(T)		;MOVE DOWN
	CAML D,FO.PGL(T)	;WRAP AROUND OFF BOTTOM TO TOP
	 SETZM AT.LNN(T)
	JRST CZECHI

CNP.F:	AOS D,AT.CHS(T)		;MOVE FORWARD - WRAP AROUND
	CAML D,FO.LNL(T)	; OFF END TO LEFT MARGIN
	 SETZM AT.CHS(T)
	JRST CZECHI

CNP.H:	HLRZ D,TT		;SET HORIZONTAL POSITION
	TRZ D,400000		;CLEAR LISP'S FLAG (IF PRESENT)
	SUBI D,7		;ACCOUNT FOR ITS'S 8
	SKIPGE FO.LNL(T)	;IF NEGATIVE, THEN ASSUME C(D) IS ACTUAL HPOS
	 JRST CNP.H1
	CAMLE D,FO.LNL(T)	;PUT ON RIGHT MARGIN IF TOO BIG
	 MOVE D,FO.LNL(T)
CNP.H1:	SUBI D,1
	MOVEM D,AT.CHS(T)
	JRST CZECHI

CNP.I:	AOS AT.CHS(T)		;NOT REALLY THE RIGHT THING, BUT CLOSE
	JRST CZECHI

CNP.Z:	SETZM AT.LNN(T)		;HOME DOWN (GO UP FROM TOP!)
CNP.U:	MOVE D,FO.RPL(T)	;MOVE UP
	SUBI D,1		;WRAP AROUND FROM TOP TO BOTTOM
	SOSGE AT.LNN(T)		; USING "REAL" PAGE LENGTH
	 MOVEM D,AT.LNN(T)
	JRST CZECHI

CNP.V:	HLRZ D,TT		;SET VERTICAL POSITION
	SUBI D,7		;IF TOO LARGE, PUT ON BOTTOM
	CAMLE D,FO.RPL(T)
	 MOVE D,FO.RPL(T)
	SUBI D,1
	MOVEM D,AT.LNN(T)
	JRST CZECHI


] 	;END OF ITS\D20


;;; VARIOUS ROUTINES FOR PRINTING ^P CODES


CNPBBL:	MOVEI D,"B
	PUSHJ P,CNPCOD
CNPBL:	MOVEI D,"B
	PUSHJ P,CNPCOD
CNPL:	MOVEI D,"L
	JRST CNPCOD

CNPU:	MOVEI D,"U
	JRST CNPCOD

CNPF:	MOVEI D,"F
	JRST CNPCOD

RCPOS:
IFN ITS,[
	MOVE TT,TTSAR(AR1)	;file array in AR1, Read cursorpos into D	
	.CALL RCPOS1		;GET CURRENT CURSOR POSITION
	 .LOSE 1400
	POPJ FLP,
RCPOS1:	SETZ
	SIXBIT \RCPOS\		;READ CURSOR POSITION
	      ,,F.CHAN(TT)	;CHANNEL #
	  2000,,D		;MAIN CURSOR POSITION
	402000,,R		;ECHO CURSOR POSITION
]		;END OF IFN ITS
IFN D20,[
	PUSHJ FXP,SAV3		;PRESERVE LOW THREE AC'S
	MOVEI TT,F.JFN
	HRRZ 1,@TTSAR(AR1)
	RFPOS
	MOVE D,2
	PUSHJ FXP,RST3
]		;END OF IFN D20
	POPJ FLP,

RSTCUR:				;RESTORE SAVED CURSOR POSITION
	HLLZ D,-3(FXP)		;FOR ITS, USE ^P CODES TO SET
	HRRI D,"V-10		; CURSOR POSITION
	PUSHJ P,RSTCU3
	HRLZ D,-3(FXP)
	HRRI D,"H-10
RSTCU3:	ADD D,R70+10
	JRST CNPCOD



;;; ROUTINE FOR OPENING UP THE INITIAL TTY FILE ARRAYS.
;;; SKIPS ON SUCCESS (FAILS IF THIS JOB NEVER HAD THE TTY).

OPNTTY:
IFN ITS,[
	.SUSET [.RTTY,,T]	;GET .TTY USER VARIABLE
	TLNE T,%TBWAT		;IF SUPERIOR SET %TBWAT, IT CERTAINLY
	 JRST OPNT0		; ANTICIPATES OUR OPENING TTY - LET'S OBLIGE
	TLNE T,%TBNOT		;ELSE DON'T OPEN IF WE DON'T HAVE THE TTY
	 POPJ P,
OPNT0:	
]		;END OF IFN ITS
;;; 20$	WARN [SHOULD WE NOT OPEN TTY IF DETACHED, OR CHECK .PRIIN?]
	AOS (P)
	HRRZ A,V%TYO		;save default end-of-page function
	MOVE TT,TTSAR(A)
	MOVEI TT,FO.EOP
	PUSH P,@TTSAR(A)
	PUSHJ P,[PUSH P,A		;OPEN UP TTY OUTPUT ARRAY
		 MOVNI T,1
		 JRST $OPEN]
OPNT1:	MOVEI AR1,(A)
	POP P,A
	MOVEI TT,FO.EOP
	MOVEM A,@TTSAR(AR1)	;restore default end-of-page function
	MOVEI TT,FO.LNL
	MOVE TT,@TTSAR(AR1)
	MOVEM TT,DLINEL		;SET UP DEFAULT LINEL FROM INITIAL JOB CONSOLE
	MOVEI TT,FO.PGL
	MOVE TT,@TTSAR(AR1)
	MOVEM TT,DPAGEL		;SET UP DEFAULT PAGEL "
	JSP TT,XFOSP
	 JRST .+2
	 JRST [ PUSH P,COPT1A
		PUSH P,AR1
		MOVNI T,1
		JRST STTYTYPE ]
COPT1A:	SETZ A,OPNT1A
OPNT1A:	MOVEM A,VTTY		;INITIALIZE "TTY" TO (STATUS TTYTYPE)
	HRRZ A,V%TYI
	MOVE TT,TTSAR(A)	;TRUE, INTERRUPTS AREN'T LOCKED OUT HERE,
	PUSH P,TI.BFN(TT)	; BUT WHO CARES?	
IFN ITS+D20+SAIL,[		;SAVE CHARACTERISTICS OVER OPENING OUTPUT TTY
SA% ZZZ==2
SA$ ZZZ==4
REPEAT ZZZ,	CONC [PUSH FLP,(TT)TI.ST]\<.RPCNT+1>
20$ 	PUSH FLP,(TT)TI.ST6	;TERMINAL MODE WORD
]	;END OF IFN ITS+D20+SAIL
	PUSH P,COPNT2		;OPEN UP TTY INPUT ARRAY
	PUSH P,A 		;  GENERALLY, V%TYI
	MOVNI T,1
	JRST $OPEN
OPNT2: LOCKI
	MOVE TT,TTSAR(A)
	POP P,TI.BFN(TT)
IFN ITS+D20+SAIL,[		;RESTORE CERTAIN STATUS WORDS, AS REQUESTED
20$ 	POP FLP,(TT)TI.ST6	;TERMINAL MODE WORD
REPEAT ZZZ,	CONC [POP FLP,(TT)TI.ST]\<ZZZ-.RPCNT>
	HRLZI T,AS.FIL		;IF V%TYI IS A SFA, THEN DO REAL ACTIONS
	TDNN T,ASAR(A)		; FROM THE INITIAL TTY FILE ARRAY
	 MOVE TT,TTSAR+TTYIFA
IT$	.CALL TTY2ST
IT$	 .LOSE 1400
SA$	MOVEI T,TI.ST1(TT)
SA$	SETACT T
IFN D20,[
	HRRZ 1,F.JFN(TT)	;EVEN FOR THE OUTPUT TTY, WE MAY WANT TO
	MOVE 2,TI.ST1(TT)	;RE-DO THIS STUFF, JUST TO BE SURE
	MOVE 3,TI.ST2(TT)
	SFCOC			;SET CCOC WORDS
	MOVE 2,TI.ST3(TT)
	SFMOD			;SET JFN MODE WORD
	SKIPN VTS20P	;If we are on VTS, then make sure we will win.
	 JRST OPNT4	; Use the saved value of the right half of the mode
	RTMOD		; word (in practice this apparently is always 0?),
	HRR 2,TI.ST6(TT)	; and the left half of the current one, which
	IOR 2,[STDTMW]	; contains the stuff users set per-session, like more
	STMOD		; processing.  But turn on the display-code option!
OPNT4:	SETZB 2,3
]		;END OF IFN D20
]		;END OF IFN ITS+D20+SAIL
	UNLOCKI
	HRRZ A,V%TYI
	HRRZ B,V%TYO
	PUSHJ P,SSTTYCONS	;CONS THEM TOGETHER AS CONSOLE
COPNT2:	POPJ P,OPNT2


SUBTTL	CLEAR-INPUT, CLEAR-OUTPUT

;;; (CLEAR-INPUT X) CLEARS ANY PENDING INPUT.
;;; CURRENTLY ONLY EFFECTIVE FOR TTY'S.

CLRIN:	PUSH P,AR1		;SUBR 1
	MOVEI AR1,(A)

IFN SFA,[
	JSP TT,XFOSP		;Check for maybe a SFA
	  JFCL			; not file or SFA, OFILOK errs
	    CAIA		;   FILE, fall through
	      JRST CLRISF	;     Go tell the SFA how.
]

	PUSHJ P,IFILOK		;MAKE SURE ARGUMENT IS AN INPUT FILE
	TLNE TT,TTS.TY
	 PUSHJ FXP,CLRI3	;IF A TTY, CLEAR ITS INPUT
	JRST $OUT1

CLRI3:
IFN ITS,[
	.CALL CLRIN9		;RESET TTY INPUT AT ITS LEVEL
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	MOVE D,F.DEV(TT)
	CAMN D,[SIXBIT \TTY\]
	 CLRBFI
]		;END OF IFN D10
IFN D20,[
	PUSH P,A
	HRRZ 1,F.JFN(TT)
	CFIBF			;CLEAR FILE INPUT BUFFER
	POP P,A
]		;END OF IFN D20
	SETZM FI.BBC(TT)	;CLEAR BUFFERED-BACK CHARS
;	SETZM FI.BBF(TT)	;CLEAR BUFFERED-BACK FORMS
	POPJ FXP,

IFN ITS,[
CLRIN9:	SETZ
	SIXBIT \RESET\		;RESET I/O CHANNEL
	400000,,F.CHAN(TT)	;CHANNEL #
]		;END OF IFN ITS

;;; (CLEAR-OUTPUT X) CLEARS ANY OUTPUT NOT ACTUALLY ON
;;; THE OUTPUT DEVICE YET.  CURRENTLY ONLY EFFECTIVE FOR TTY'S.

CLROUT:	PUSH P,AR1		;SUBR 1
	MOVEI AR1,(A)

IFN SFA,[
	JSP TT,XFOSP		;Check for maybe a SFA
	  JFCL			; not file or SFA, OFILOK errs
	    CAIA		;   FILE, fall through
	      JRST CLROSF	;     Go tell the SFA how.
] ;End IFN SFA,

	PUSHJ P,OFILOK
	TLNE TT,TTS<TY>		;SKIP IF TTY
	 PUSHJ FXP,CLRO3
	JRST $OUT1

IFN SFA,[
CLROSF:	SKIPA T,[SO.OCL]	;CLEAR-OUTPUT
CLRISF:	  MOVEI T,SO.ICL	;  CLEAR-INPUT
	SETZ C,			;Arg of ()
	PUSHJ P,ISTCAL		;pass the buck to the SFA
	POP P,AR1		;And return, unlocking etc.
	POPJ P,
]; End IFN SFA,

CLRO3:
IFN ITS,[
	.CALL CLRIN9		;RESET CHANNEL
	 .LOSE 1400
CLRO4:	.CALL RCPOS1		;RESET CHARPOS AND LINEL
	 .LOSE 1400
	HLL T,F.MODE(TT)
	TLNE T,FBT.EC
	 MOVE D,R		;FOR ECHO MODE, USE ECHO MODE CURSORPOS
	HLRZM D,AT.LNN(TT)
	HRRZM D,AT.CHS(TT)
]		;END OF IFN ITS
IFN D10,[
	MOVE D,F.DEV(TT)
	CAMN D,[SIXBIT \TTY\]
	 CLRBFO
]		;END OF IFN D10
IFN D20,[
	PUSH P,A
	HRRZ 1,F.JFN(TT)
	CFOBF			;CLEAR FILE OUTPUT BUFFER
	CAIA
CLRO4:	 PUSH P,A
	PUSH P,B
	HRRZ 1,F.JFN(TT)
	RFPOS			;READ FILE POSITION
	HLRZM 2,AT.LNN(TT)	;STORE LINENUM
	HRRZM 2,AT.CHS(TT)	;STORE CHARPOS
	POP P,B
	POP P,A
]		;END OF IFN D20
IFE D10,[
	PUSH FXP,T
	TLNN T,FBT.CM		;IF BLOCK MODE, RESET
	 JSP D,FORCE6		; LISP BUFFER POINTERS
	POP FXP,T
]	;END OF IFE D10

	POPJ FXP,


;;; STANDARD **MORE** PROCESSOR

TTYMOR:	PUSHJ P,STTYCONS	;SUBR 1
	JUMPE A,CPOPJ		;STTYCONS LEFT ARG IN AR1
	PUSH P,AR1
	PUSH P,A
	SETZ A,			;RESET NOINTERRUPT STATUS
	PUSHJ P,NOINTERRUPT	; SO INTERRUPT CHARS WILL TAKE EFFECT
	HRRZ AR1,-1(P)
	STRT AR1,[SIXBIT \####MORE####!\]	;# IS QUOTE CHAR
TTYMO3:	PUSHJ P,[PUSH P,R70
		 PUSH P,-2(P)
		 MOVNI T,2
		 JRST TYIPEEK+1]
TTYMO1:	CAILE TT,40
	 CAIN TT,177
	  PUSHJ P,[PUSH P,-1(P)	;SWALLOW SPACE OR RUBOUT
		   MOVNI T,1
		   JRST %TYI+1]
TTYMO2:	CAIE TT,^S		;DON'T IGNORE ^S
	 CAIN TT,33		;OR <ALT>
	  JRST TTYMOZ
	CAIGE TT,40		;COMPLETELY IGNORE CONTROL CHARS
	 JRST TTYMO3		? SA$ WARN [SAIL TTYMOR?]
TTYMOZ:	POPI P,1
	POP P,AR1
IT%	POPJ P,
IFN ITS,[
	MOVE D,[10,,"H]		;GO TO BEGINNING OF LINE
	PUSHJ P,CNPCOD
	PUSHJ P,CNPL		;CLEAR TO END OF LINE
	HRLI AR1,600000		;FLAG TO TERPRI (THIS IS ACTUAL FILE ARRAY)
	JRST TERP1		;DO SEMI-INTERNAL TERPRI
]		;END OF IFN ITS



IFN SFA,[
SUBTTL SFA FUNCTIONS (INTERNAL AND USER)

; (SFA-CREATE <old-sfa or sfa-function>
;	      <amount-of-local-user-storage>
;	      <printname>)
STCREA:	SKOTT A,LS\SY
	 JRST STCRE1
;HERE TO CREATE A NEW SFA: SFA-FUNCTION IN A, LISP FIXNUM IN B
STCREN:	JSP T,FXNV2		;GET THE LENGTH OF THE USER AREA INTO D
	PUSH P,A
	PUSH P,B
	PUSH P,C
	MOVEI TT,<SR.LEN*2>+1(D)	;TO INSURE GETTING ENOUGH HALFWORDS
	LSH TT,-1		;THEN CONVERT TO NUMBER OF WORDS
	MOVSI A,-1		;JUST NEED THE SAR
	PUSHJ P,MKLSAR		;GET A GC-PROTECTED ARRAY
	POP P,C
	LOCKI			;GOING TO HACK WITH THE ARRAY
	MOVE TT,TTSAR(A)	;POINTER TO THE ARRAY DATA AREA
	POP P,B			;LENGTH OF THE USER DATA AREA
	MOVE T,(B)
	MOVEM T,SR.UDL(TT)	;REMEMBER LENGTH OF USER DATA
	EXCH A,(P)		;RESTORE FUNCTION AND SAVE SAR ADR
	HRLI A,(CALL 3,)	;A CALL FUNCTION GOES IN UN-MARKED-FROM SLOT
	MOVEM A,SR.CAL(TT)	;STORE THE CALL INSTRUCTION
	HRRZM A,SR.FUN(TT)	;STORE THE FUNCTION, and zero the TTYCONS slot
	HRRZM C,SR.PNA(TT)	;STORE THE PRINTNAME, and zero the PLIST slot
	ROT T,-1		;LENGTH OF USER AREA IN T
	SKIPGE T		;CONVERT INTO NUMBER OF WORDS NEEDED
	 ADDI T,1
	ADDI T,SR.LEN-SR.FML	;NUMBER OF SYSTEM WORDS MARKED
	MOVNI R,(T)		;NUMBER OF WORDS TO MARK
	HRLZI R,(R)		;IN LEFT HALF
	HRRI R,SR.FML(TT)	;POINTER TO FIRST MARKED LOCATION IN RH
	HRRZ D,@(P)		;GET SAR
	MOVEM R,-1(D)		;STORE GC MARKING AOBJN POINTER
	HRLZI TT,AS.SFA		;TURN THE ARRAY INTO AN SFA
	IORM TT,@(P)		;TURN ON SFA BIT IN THE SAR
	UNLOCKI			;ALLOW INTERRUPTS AGAIN	
;THE FOLLOWING CODE SIMULATES:
;	(SFA-CALL <NEWLY-CREATED-SFA> 'WHICH-OPERATIONS NIL)
	HRRZ A,(P)		;FIRST ARG TO SFA IS SFA-OBJCT ITSELF
	MOVEI B,QWOP		;WHICH-OPERATIONS
	SETZ C,			;NO THIRD ARG
	MOVEI TT,SR.CAL		;CALL INSTRUCTION SLOT
	XCT @TTSAR(A)		;DO CALL INDIRECTLY THROUGH TTSAR
	JUMPE A,STCRE3		;THE SFA CAN'T DO ANYTHING, BUT WHY WORRY...
	SKOTT A,LS		;BETTER HAVE GOTTEN A LIST BACK
	 JRST SCREBS		;BAD SFA IF DIDN'T GET BACK A LIST!
STMASK:	SETZ F,			;F ACCUMLATES KNOWN SYSTEM OPERATIONS MASK
STCRE4:	MOVE R,[-STKNOL,,STKNOT] ;AOBJN POINTER OVER KNOWN OPERATIONS
	HLRZ B,(A)		;CAR IS THE OPERATION
STCRE5:	HRRZ T,(R)		;KNOWN OPERATIOON
	CAIE T,(B)		;MATCH?
	 JRST STCRE6		;NOPE, KEEP LOOPING
	HRRZ T,R		;GET POINTER
	HLLZ TT,(R)		;GET MASK
	CAIL T,STKNOT+18.	;LEFT HALF VALUE?
	 MOVSS TT		;NOPE, ASSUMED WRONG
	TDOA F,TT		;ACCUMLATE THIS OPERATION AND EXIT LOOP
STCRE6:	 AOBJN R,STCRE5		;CONTINUE LOOPING UNTIL ALL LOOPED OUT
	HRRZ A,(A)		;CDR DOWN THE WHICH-OPERATIONS LIST
	JUMPN A,STCRE4		;DON'T JUMP IF DON'T HAVE TO
STCRE3:	POP P,A			;POINTER TO SAR
	MOVEI TT,SR.WOM		;POINT TO KNOWN OPERATIONS MASK
	MOVEM F,@TTSAR(A)	;STORE IN ARRAY
	POPJ P,			;THEN RETURN SAR

SCREBS:	FAC [NON-LIST FOR WHICH-OPERATIONS MSG!]

STCRE1:	FAC [SFA FOR 1ST ARG ? -- SFA-CREATE!]


;SFA OPERATION/INTERNAL BIT CORRESPONDANCE TABLE
STKNOT:
;LH BITS
SO.OPN,,Q$OPEN
SO.CLO,,Q$CLOSE
SO.REN,,Q$RENAMEF
SO.DEL,,Q$DELETEF
SO.TRP,,Q%TERPRI
SO.PR1,,Q%PR1
SO.TYI,,Q%TYI
SO.UNT,,QUNTYI
SO.TIP,,QTYIPEEK
SO.IN,,Q$IN
SO.EOF,,QEOFFN
SO.TYO,,Q%TYO
SO.PRO,,Q%PRO
SO.FOU,,QFORCE
SO.RED,,QOREAD
SO.RDL,,Q%READLINE
SO.PRT,,Q%PRINT
SO.PRC,,Q%PRC

;RH BITS
SO.MOD,,QFILEMODE
SO.POS,,QFILEPOS
SO.ICL,,QCLRIN
SO.OCL,,QCLROUT
SO.OUT,,Q$OUT
SO.CUR,,QCURSORPOS
SO.RUB,,QRUBOUT
STKNOL==:.-STKNOT		;LENGTH OF TABLE


;;; (SFA-CALL <sfa-object> <operation> <extra-arg>)
STCAL1:	%WTA @STDISW
STCALL:	SKOTT A,SA		;MUST BE AN ARRAY HEADER
	 JRST STCAL1
	HRLZI TT,AS.SFA		;NOW CHECK FOR SFA-NESS
	TDNN TT,ASAR(A)
	 JRST STCAL1		;AN ARRAY BUT NOT A REAL SFA
	MOVEI TT,SR.CAL
	XCT @TTSAR(A)		;INVOKE THE SFA
	POPJ P,

;INTERNAL SFA CALL, BIT INDICATNG OP IN T, SFA-OBJECT IN AR1,
; THIRD ARG TO SFA IN C.  RETURNS VALUE OF SFA IN A.  DESTORYS ALL
; ACS.
ISTCAL:	JFFO T,ISTCA0		;MUST HAVE ONE BIT SET
	 JRST ISTCA1
ISTCA0:	HRRZ B,STKNOT(TT)	;GET SYMBOL REPRESENTING OPERATION
	MOVEI A,(AR1)		;SFA GETS ITSELF AS FIRST ARG
	MOVEI TT,SR.WOM		;CHECK FOR LEGAL OP -- USE WHICH OP MASK
	TDNN T,@TTSAR(A)	;MAKE SURE THIS INTERNAL OP IS DOABLE
	 JRST ISTCA1 
;ENTER HERE FOR 'SHORT' INTERNAL CALL PROTOCOL, A, B, AND C SET UP CORRECTLY
ISTCSH:	MOVEI TT,SR.CAL		;EXECUTE THE CALL TO THE SFA
	XCT @TTSAR(A)
	POPJ P,			;RETURN TO CALLER WITH RESULT IN A

ISTCA1:	LERR [SIXBIT \INVOKING SFA ON UNSUPPORTED OPERATION!\]

;;; (SFAP <object>) RETURNS T IF <object> IS AN SFA, ELSE NIL
STPRED:	JSP TT,AFOSP		;CHECK IF A FILE OR SFA
	 JRST FALSE		;NEITHER, RETURN NIL
	  JRST FALSE		;FILE, RETURN FALSE
	   JRST TRUE		;SFA, RETURN TRUE


;;; (SFA-GET <sfa-object> <fixnum or system-location-name>)
;;; (SFA-STORE <sfa-object> <fixnum or system-location-name> <new-value>)

STSTOR:	SKIPA F,[STSTOD]	;SFA-STORE DISPATCH TABLE
STGET:	 MOVEI F,STGETD		;SFA-GET DISPATCH TABLE
	SKIPA
STDISW:	 WTA [NOT A SFA -- SFA-GET/SFA-STORE/SFA-CALL!]
	JSP TT,AFOSP		;INSURE WE HAVE AN SFA, A ==> AR1
	 JRST STDISW		;NOT AN SFA
	  JRST STDISW		;A FILE-OBJECT, BUT STILL NOT AN SFA
	SKOTT B,FX
	 JRST STDIS1		;NOPE, MUST BE A SYSTEM-LOCATION NAME
	SKIPGE R,(B)		;GET THE ACTUAL FIXNUM, hopefully positive
	 JRST STDIOB		;NOPE, GIVE OUT-OF-BOUNDS CALL
	MOVEI TT,SR.UDL		;CHECK AGAINST THE MAXIMUM VALUE
	CAML R,@TTSAR(AR1)	;IN RANGE?
	 JRST STDIOB		;NOPE, GIVE OUT-OF-BOUNDS CALL
	ROT R,-1		;MAKE INTO AN OFFSET AND A FLAG BIT (RH/LH)
	JRST @-1(F)		;GIVE USER LOCATION ACCESS RETURN

STDIOB:	EXCH A,B		;GIVE AN OUT-OF-BOUNDS ERROR
	%FAC IXEXBD

STDIS1:	MOVE T,[-STRSLN,,0]	;FIND SYS-LOC THAT 2ND ARG IS EQ TO
STDIS2:	CAME B,STSYSL(T)	;MATCH THIS ENTRY?
	 AOBJN T,STDIS2		;NOPE, CONTINUE THE LOOP
	ADDI T,(F)		;MAKE CORRECT TABLE ADDRESS
	SKIPGE T		;BUT DID WE REALY FIND A MATCH?
	 JRST @(T)		;YES, SO DISPATCH
	JRST STDIOB

;SFA SYSTEM-NAME TABLE
STSYSL:	QFUNCTION		;FUNCTION	  ;stream-specific handler
	QWOP			;WHICH-OPERATIONS ;list of all acceptible msgs
	QPNAME			;PNAME		  ;name for print to use
	Q$XCONS 		;Associated SFA for bi-directional sfas
	QPLIST 			;PLIST		  ;general property list
STRSLN==:.-STSYSL

;SFA-GET DISPATCH TABLE AND FUNCTIONS

	STGETU			;USER LOCATION
STGETD:	STGFUN			;FUNCTION
	STGWOM			;OPERATIONS MASK
	STGPNA			;PRINT NAME
	STGCNS 			;TTYCONS (i.e., associate for bi-directional)
	STGPLI 			;PLIST 

STGETU:	MOVEI TT,SR.FUS(R)	;INDEX INTO ARRAY
	HLRZ A,@TTSAR(AR1)	;TRY THE LEFT HALF
	SKIPGE R		;BUT IS IT THE RIGHT HALF?
	 HRRZ A,@TTSAR(AR1)	;YUP, SO FETCH THAT
	POPJ P,			;RETURN SLOT'S VALUE

STGPNA:	SKIPA TT,[SR.PNA]	;RETURN THE PNAME
STGFUN:	 MOVEI TT,SR.FUN	;RETURN THE FUNCTION
	HRRZ A,@TTSAR(AR1)
	POPJ P,

STGCNS:	SKIPA TT,[SR.CNS]	;TTYCONS IS IN LH OF WORD WITH THE FUN
STGPLI:	 MOVEI TT,SR.PLI	;PLIST IS STORED IN LH OF WORD CONTAING PNAME
	HLRZ A,@TTSAR(AR1)
	POPJ P,


STGWOM:	MOVEI TT,SR.WOM		;RETURN THE WHICH-OPERATIONS MASK
	MOVE D,@TTSAR(AR1)	;GET THE MACHINE NUMBER AND CONS UP A FIXNUM
	SETZ A,			;START OFF WITH NIL
STGWO1:	JFFO D,STGWO2		;ANY MORE LEFT TO DO?
	 POPJ P,		;NOPE, RETURN WITH CONSED UP LIST IN A
STGWO2:	HRRZ B,STKNOT(R)	;GET ATOM CORRESPONDING TO MASK BIT
	JSP T,%XCONS		;ADD TO THE HEAD OF THE LIST
	HRLZI T,400000		;NOW TURN OFF THE BIT WE JUST HACKED
	MOVNS R			;MUST NEGATE TO ROTATE
	ROT T,(R)		;SHIFT INTO CORRECT BIT POSITION
	TDZ D,T			;TURN OFF THE BIT
	JRST STGWO1		;AND DO THE REMAINING BITS


;SFA-STORE DISPATCH TABLE AND ROUTINES

	STSTOU			;USER LOCATION
STSTOD:	STSFUN			;FUNCTION
	STSWOM			;OPERATIONS MASK
	STSPNA			;PRINT NAME
	STSCNS 			;TTYCONS (i.e., associate for bi-directional)
	STSPLI 			;PLIST 

STSTOU:	MOVEI A,(C)		;PDLNMK THE THING WE ARE GOING TO STORE
	JSP T,PDLNMK
	MOVEI TT,SR.FUS(R)	;INDEX INTO ARRAY
	JUMPL R,STSTU1		;RIGHT HALF
	HRLM A,@TTSAR(AR1)	;STORE IN THE LEFT HALF
	POPJ P,			;RETURN SLOT'S VALUE
STSTU1:	HRRM A,@TTSAR(AR1)	;LEFT HALF
	POPJ P,

STSPNA:	SKIPA TT,[SR.PNA]	;STORE THE PNAME
STSFUN:	 MOVEI TT,SR.FUN	;STORE THE FUNCTION
	HRRM C,@TTSAR(AR1)
	MOVEI A,(C)		;RETURN THE STORED VALUE
	CAIE TT,SR.FUN		;WERE WE HACKING THE FUNCTION?
	 POPJ P,		;NO, SO WE ARE DOINE
	HRLI C,(CALL 3,)	;WE MUST ALSO FIX THE CALL INSTRUCTION
	MOVEI TT,SR.CAL
	MOVEM C,@TTSAR(AR1)
	POPJ P,

STSPLI:	SKIPA TT,[SR.PLI]	;STORE THE PLIST
STSCNS:	 MOVEI TT,SR.CNS	;STORE THE "TTYCONS"
	HRLM C,@TTSAR(AR1)
	MOVEI A,(C)		;RETURN THE STORED VALUE
	POPJ P,


STSWO1:	EXCH A,C
	%WTA NAPLMS
	EXCH A,C
STSWOM:	SKOTT C,LS		;IS THE ARGUMENT A LIST?
	 JRST STSWO1		;NOPE, WRONG TYPE ARG ERROR
	PUSH P,AR1		;SAVE THE SFA FOR STMASK ROUTINE
	MOVEI A,(C)		;EXPECTS WHICH-OPERATIONS LIST IN A
	JRST STMASK		;THEN GENERATE A NEW MASK AND RETURN
]		;END IFN SFA

	PGTOP QIO,[NEW I/O PACKAGE]
