;;; -*- Mode: MIDAS -*-

;;; PDP-10 Chaosnet file server

;;; The source file for this program is kept in the following places
;;; on the MIT Chaosnet:
;;;
;;; AI: SYSENG; FILE >
;;; OZ:SS:<SYS.SYSTEM>FILE.MID
;;; SCRC:<CHAOS>FILE.MID
;;; SPEECH:SSY:<SYMBOLICS.CHAOS.SERVER>FILE.MID
;;; XX:SRC:<SYS.CHAOS>FILE.MID
;;;
;;; Send mail regarding this program to BUG-FILE at MIT-MC

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;	****
;;	**** Changes that have been made:
;;	****
;;
;; Wednesday, 21 July 1982 --Gren
;;
;;	If OPEN/DELETE/RENAME/CHANGE-PROPERTIES fails for access
;;	violation, will try and CONNECT no password then try again
;;	(see TRYCON - Must immediately proceed the failing JSYS).
;;
;;	Conditionally assembling the Chaosnet-user-Capability checking,
;;	since you could always just login as Anonymous, which has it.
;;	See the $$CCUC
;;
;;	Make a DIRECTORY command not return ?NO FILES MATCH THIS
;;	SPECIFICATION as an error, but just give an empty list.
;;
;; Thursday, 29 July 1982 --Gren
;;
;;	Make GTJFN errors "NO SUCH FILENAME", "NO SUCH FILE TYPE", and
;;	"NO SUCH VERSION NUMBER" come back as FNF, but with the original
;;	error text.
;;
;;	If you get auto-CONNECTed to a directory, you will disconnect
;;	back to your home dir after done with whatever file.  See the
;;	CNCTED flag.
;;
;;	Noticed this was already done (taken from SHOULD list):
;;
;;	"COMRFO should quote embedded spaces, colons, semicolons, ideally."
;;
;; Friday, 30 July 1982 --Gren
;;
;;	Instead of hassling you about logging in all the time, you will
;;	be logged in as ANONYMOUS if it all possible, and only pestered
;;	if it can't be done.  The LOGIN command then does the same as an
;;	ACCESS
;;
;; Wednesday, 4 August 1982 --Gren
;;
;;	Better yet than just logging you in as ANONYMOUS by default, it
;;	tries to log you in as <Q.hostname>, and only if that fails does
;;	it try ANONYMOUS.  The <Q> directory also has files of the form
;;	<Q>hostname.PASSWORD, which are analagous to ANONYMOUS.USERFILE.
;;	Note that these <Q> dirs have NOT-TTY-LOGINABLE set, so only the
;;	FILE server or other detached creatures can use them.  You may
;;	not explicitly give a N-T-L account with LOGIN - It is rejected.
;;
;;	"COMPFN should become more robust." - I poked at it some.  Looks
;;	fine to me.  Have yet to try it out tho.
;;
;;	In COMPFN, FN2 now defaults to ">" (it was left 0 before, and
;;	would choke).
;;
;; Saturday, 21 August 1982 --Gren
;;	Make the DIRECTORY command default FN1 and FN2 to "*" so that
;;	just saying "DIR" or "DIR FOO" will work.
;;
;;
;; Monday, 23 August 1982 --Gren
;;	Added support for SUBMIT OPEN option, conditionalized with the
;;	$$SUBM flag.
;;
;; Tuesday, 14 September 1982 --Gren
;;	Response to an OPEN is now:
;;	... QFASLP<SP>CHARACTERP<SP>"writer"<NL> ...
;;	where "writer" is the last writer of the file, in Lisp-READable
;;	format, with "'s and /'s quoted.
;;
;; Thursday, 16 September 1982 --Gren
;;	Fixed some of the COMPLETE code so it wouldn't blow up and
;;	cause the program to die horribly, and merged in Moon's time
;;	fixes.
;;
;; 9/20/82 Moon		Merged Gren's version and the Symbolics version
;;			into one
;;
;; Monday, 27 September 1982 --Gren
;;	Added support for ENABLE-CAPABILITIES.
;;
;; 9/27/82 Moon		Fix bugs in cross-device/directory rename checking on
;;			ITS.  Make CWD and ENABLE-CAPABILITIES work on Tenex
;;			Fix command name comparison so CREATE-LINK is not
;;			mis-parsed as CREATE-DIRECTORY
;;			Add CREATE-LINK command for ITS
;;
;; Saturday, 2 October 1982 --Gren
;;	Have ENABLE/DISABLE commands take arguments of which privs to
;;	toggle (currently only WHEEL, OPERATOR, or ALL), and have both
;;	return the state of your privs as <priv allowed> <T if enabled
;;	else NIL> ...
;;
;; 10/9/82 Moon		Send new standard 3-letter error codes
;;			Put error messages in upper and lower case
;;			Include disk free space in directory list, for Tenex
;;			(TOPS-20 should probably do it the way ITS does)
;;
;; Sunday, 10 October 1982 --Gren
;;	Scrapped assorted experimental OZ things, put in some 20X
;;	directory space listing stuff.
;;
;; Tuesday, 12 October 1982 --Gren
;;	Doing SETNMs now for clarity's sake, added NLI LispM suicide
;;	timout code, and conditionalized logging of activity, for
;;	debugging porpoises ($$LOG).
;;
;; Thursday, 14 October 1982 --Gren
;;	TWENEX returns freespace for all structures in directory stream
;;	as STRUCTURE1:free1 STRUCTURE2:free2 ...
;;
;; Friday, 15 October 1982 --Gren
;;	Conditionized out suicide stuff for now, since there don't seem
;;	to be any interrupt channels to do it on, and it's no solution
;;	anyway.  $$SUE
;;
;; 18 Oct 82 Moon
;;	Made it work again for ITS
;;	Added INHIBIT-LINKS option for OPEN (ignored by systems without links)
;;	Made OPEN options 10 characters instead of 5
;;	IFN 0'ed GTDAL in 20X directory header, commented why
;;	Got upset stomach from reading code in mixed case
;;	Fixed ITS error messages
;;
;; Tuesday, 19 October 1982 --Gren
;;	Put back in fixed GTDAL, Meta-C'd entire buffer.
;;
;; 10/21/82 Moon
;;	Fix IOC errors to send proper 3-letter code.
;;	Fix ITS error messages which I broke on 18 Oct.
;;	Remodularize the error-message code to be more host-independent
;; 
;; 10/26/82 MT
;;	For 20X rel 5: use FB%NDL instead of FB%UND, if it's defined.	
;;
;; Thursday, 28 October 1982 --Gren
;;	Get writes to a specific version of a file go through a scratch
;;	file, so there is no chance of clobbering the old copy.
;;
;; Saturday, 30 October 1982 --Gren
;;	Try to DWIM if you DIRECTORY a <dir> without the *'s.
;;
;; Monday, 1 November 1982 --Gren
;;	Put the directory-listing stuff on a separate GTJFN routine
;;	(COMGDJ - uses Long Form) to avoid that DWIM kludge.
;;
;; Tuesday, 9 November 1982 --Gren
;;	Change all ERJMP JSYSER's to ERCAL JSYSER's and include the
;;	address of JSYS error along with the error string.  JSYSER
;;	should only be called via ERCAL since it expects TOS to be
;;	the PC and such.  If you want to do like JRST JSYSER, JRST
;;	to COMFER instead. [Inoperative!]
;;
;; Saturday, 13 November 1982 --Gren
;;	Switch file-overwriting back to the old catch-OPNX27-error
;;	scheme, make sure JFNs released when erroring, fix delete/
;;	temporary-file dual usage of DATRFJ.  Ran out of usable bits
;;	in DATSTA LH!
;;
;; Monday, 15 November 1982  --Ian
;;	Various bug fixes having to do with when to release leftover
;;	JFNs (now only done at close time).  Returning number-of-
;;	LM-characters-received on a CLOSE reply.  No more $$SUE.
;;
;; Tuesday, 16 November 1982 --Ian
;;	Centralized most of the Closing/Releasing of JFNs at RELDJF
;;	and RELRJF
;;
;; 11/17/82 Moon  -- fixed bugs I noticed
;;	$$LOG should not be on by default
;;	NOTNEW was not always initialized before calling COMGJF/COMGJG
;;	COMOPN needs to release any JFNs held even if ST.ACT is not set
;;	TRYCON thought A was 1 and also broke ERCAL
;;	RLJFN fails if the JFN is open, so try CLOSF and RLJFN both
;;	Fix errors in TNX/ITS conditionalization, Tenex timebombs
;;	Use BUG 3-letter code for all unexpected errors
;;	Make SYSBUG bug-tracing message not be as mysterious to users
;;
;; 11/19/82 Moon
;;	Fix TRYCON more.
;;	Don't call RELDJF when not supposed to, at CNGERR
;;
;; 12/1/82 Moon
;;	If closing in abort mode, set CZ%ABT to suppress generation-retention-count
;;	Send an async mark if data packet discarded for any reason
;;	Send OPEN reply only after all done, in case interrupt accidentally
;;	 left enabled, so data packets don't arrive early (especially
;;	 when transaction-logging is turned on, making COMSND slow)
;;
;; 12/4/82 Moon
;;	Fix clobbering of error code introduced by centralized closing of JFNS
;;
;; (some time) Gren (I assume)
;;	OZ INQUIR data base has user groups
;;	Default version for directory to * when user is not a Lisp machine
;;	(unfortunately this was done in such a way that it can only work on OZ)
;;
;; 12/29/82 Moon
;;	Recognize BIN files
;;	Remove timebombs put in by previous modification
;;
;; 1/5/83 Moon
;;	Put more wheel/operator capability required 20X error codes into ERRTAB
;;
;; 2/15/83 Moon
;;	Revise error reporting.  Include octal PC for all file-system bugs.
;;	Normal expected errors from the file system are reported
;;	via PUSHJ P,FILERR (on 10X/20X this is ERCAL JSYSER or PUSHJ P,JSYSER
;;	usually, however JSYSER and FILERR are the same).
;;	For ITS, ERRCOD must have been set up (via .CALL error return value)
;;	PUSHJ P,SYSBUG is used for unexpected errors from the file system.
;;	In DEBUG mode, even non-bug error messages include the octal PC.
;;	You can also patch the JRST at BUGPAT to a JFCL to get this.
;;	Also fix commands that use IDX without initializing it.
;;
;; 5/18/83 Moon v.508
;;	Probe opening allowed for files that are off-line on Twenex
;;
;; Monday, 23 May 1983 --Ian
;;	Fix another case for directory-empty: GJFX19 (No such file type)
;;	is what you get if you directory "*.BAR" and there are no matching
;;	files.
;;
;; 5 June 1983 Moon
;;	Tops-20 needs to access other structure in COMPLETE command
;;
;; Wednesday, 8 June 1983  CSTACY
;;	Fix INQUIR kludges, use proper LSRTNS routines.
;;
;; 9 June 83 Moon v.514
;;	ACCCHK in COMPLETE command for Tops-20
;;
;; 14 June 83 Moon v.515
;;	Do ACCESS to foreign structures once, at login time, instead
;;	of all over the place.  This avoids the problem that there were
;;	lots of places that forgot to call ACCCHK.
;;
;; 16 June 83 Moon v.516
;;	Return truenames from RENAME command (not finished for ITS yet)
;;
;; 13 July 83 Moon v.519
;;	Don't return bogus file dates from ITS files that have never
;;	been referenced.
;;	More ACCESS/CONNECT fixes for Twenex
;;
;; 19 July 1983, GZ, v.519
;;	Process LOGICALS.CMD on login, under $$LNM switch (off except on OZ).
;;
;; 19 July 83 Moon v.520
;;	Merge my changes and GZ's changes
;;	EXPUNGE command ignored by ITS
;;	DELETED open option ignored by ITS
;;	HOMEDIR, FILE-SYSTEM-INFO commands
;;	Directory of FOO > on ITS matches only files with all-numeric FN2
;;
;; 23 August 83 Ian / Moon v.524
;;	Missing ERCAL after RCDIR in EXPUNGE command
;;
;; Sunday, 4 September 1983 --Ian (524)
;;	COMPFN defaults FN2 to ">" if STARF2/ 0 else "*" (for the sake
;;	of directory listings)
;;
;; 9/6/83 Moon v.526
;;	New OPEN options: ESTIMATED-LENGTH, PROBE-DIRECTORY,
;;	  IF-EXISTS, IF-DOES-NOT-EXIST (except for rename and rename-and-delete)
;;	  For ITS, the latter two aren't implemented yet
;;	
;; 9 September 1983 --Ian (527,531)
;;	Fixed 20X EXPUNGE not to need filename and to handle
;;	wildcarded directories;  Fix EXPUNGE code which somehow
;;	reverted to a non-working test version (11-Sep)
;;
;; 9/12/83 Moon
;;	Put back kludges needed to make EXPUNGE work on Tenex
;;
;; 9/19/83 Marty v533
;;	Turned on $$LNM for all Top-20 versions.
;;
;; 9/23/83 Moon v.534
;;	SFUSX6 gives a CSP error (mainly of use for Tenex)
;;	Undefined 10X/20X error codes don't give a blank error message!
;;
;; 3 October 1983 --Ian
;;	OZ Inquire support.
;;
;; 10/21/83 Moon
;;	Add IF-EXISTS TRUNCATE  (sets file length but doesn't return disk pages!)
;;	Replace DATDEL, DATRFJ, and ST.OVW with DATDSP, to implement 
;;	 IF-EXISTS RENAME and IF-EXISTS RENAME-AND-DELETE
;;	Don't send bogus months in dates (can exist in ITS dates sometimes)
;;	 Still can send bogus days, though, but I think that's okay for
;;	 the moment.  Dates should really be transmitted as universal times.
;;	IF-EXISTS, IF-DOES-NOT-EXIST still not implemented for ITS
;;
;; 10/27/83 Moon v.543
;;	Merge SCRC and OZ versions
;;	Fix typo in HOMEDIR command when no Inquir entry found
;;
;; 10/31/83 Moon v.545
;;	Ian's changes of 3 October broke users not registered in INQUIR on OZ
;;	Ian's changes since last assembled on ITS broke ITS assembly
;;
;; 11/28/83 Moon v.547
;;	PROBE-DIRECTORY bugs: release JFN, return truename, work on TOPS-20
;;
;; 12/06/83  Marty v. 546  (v. 548)
;;      Make Tops-20 abort all open connections upon logout.
;;
;; 12/13/83 Moon v.549
;;	Code was all scrambled in EXPUNGE command somehow
;;
;; 12/21/83 Moon v.551
;;	IF-EXISTS SUPERSEDE ignored on ITS since system 243.369 sends it
;;	Real implementation of IF-EXISTS, IF-DOES-NOT-EXIST for ITS still not done
;;
;; 1/4/84 Moon v.555
;;	PROPERTIES command
;;
;; 1/16/84 Moon v.556
;;	Merge the following changes from UTexas
;;
;;	 12/13/83 C.Dawson (UTexas) v. 10547
;;		Fix lossage when number of structures on system is exactly 
;;		equal to monitor's STRN.  In this case, the GETAB table will
;;		NOT contain a structure named STRnnn, and this can't be checked
;;		for loop termination.
;;	
;;	 12/13/83 B. Brown (UTexas) v. 20547
;;		Set session remark to "CHAOS SERVER" at startup.  Useful for
;;		Exec's who discriminate among various flavors of detached jobs.
;;	
;; 1/29/84 Moon v.557
;;	Lisp machine has gotten more picky about only accepting well-formed
;;	dates, so put in more checks for bogus dates in date printer.
;;
;; 2/21/84 Moon v.558
;;	Allow superseding a Tops-20 offline or archived file
;;
;; 20 June 1984 --Ian
;;	For OZ, make the session-remark "CHAOS SERVER hostname" so FINGER
;;	can show it.
;;
;; Monday, 9 July 1984, CJL
;;      For TWENEX, If the RETENA is nonzero, for opens that would normally
;;      bomb out will "File is off-line", a file retrieval is automatically
;;      run, and the open is retried.  For OZ, RETENA is set to -1. 
;;      Someday I hope there will be some way to change the value of RETENA
;;      so this feature can be enabled and disabled at runtime. Insrts also
;;      to LIB: instead of SYSTEM:, on OZ
;;
;; 9/7/84 MMcM v.567
;;	:CHARACTERS :DEFAULT re-OPENF should respect PRESERVE-DATES.
;;	Anonymous and archive retrieval changes weren't properly conditionalized.
;; 19-Nov-84, GZ, v.568
;;	Adopt to hakinq library changes (OZ only).
;;	Enable self at PURIFY so can dump file.
;;
;; 31 January 1985  --Ian  v.569
;;	Set XUNAME on ITS to name logging in as, fixed accumulated
;;	ITS-assembly problems.
;;
;; 23-Feb-85, GZ, v.570
;;	Add FILE-BYTE-SIZE open option on TNX
;;
;; 4/8/85, Alan, v.571 (ITS)
;;	Set HSNAME on ITS.
;;
;; 5/02/85, CStacy (apparently), v.572 (ITS)
;;	God only knows what he did.
;;
;; 20-May-86, COLE, v.571 (20X) (renamed v.573 after the fact on OZ)
;;      FILE now computes byte size even when not in binary mode
;;
;; 2-July-86, SRA, v.574
;;	Make session remark hack work for XX, without all the host
;;	table mapping crud fer gossake.  Added XX conditional.
;;	Make OZ and XX conditional IFNDEFs work in domainland.
;;	Merge OZ, XX, AI versions together again.
;;
;; 5-Oct-86 JTW v.575
;;	Set file byte size only on BINARY WRITE operations (undo 571,
;;	really). Fix incompatability with Symbolics Rel-7 which wants
;;	to set character files to 8-bit bytes.
;;
;; 8-Dec-86 GLR v.576
;;	Make open for output return filelength if file is old
;; 8-Dec-86 GLR v.582
;;	hack filepos to work for output files -- this has timing screws in it
;; 8-Dec-86 GLR v.586
;;	increase NIMPUR -- so it compiles on ITS
;;
;; 12/19/86 Alan v.587 (ITS)
;;	Fixed code in ITS directory creation that tried to assure that only
;;	people with directories can create directories.  I'll bet this is
;;	what CStacy did in v.572.
;;
;; 6/2/88 Alan v.591 (20X)
;;	Return .FBTP1 .FBSS1 .FBTP2 .FBSS2 file properties.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

IFNDEF ITS,[
IFE .OSMID-SIXBIT/ITS/,ITS==1
.ELSE ITS==0
];IFNDEF ITS
IFNDEF 10X,[
IFE .OSMID-SIXBIT/TENEX/,10X==1
.ELSE 10X==0
];IFNDEF 10X
IFNDEF 20X,[
IFE .OSMID-SIXBIT/TWENEX/,20X==1
.ELSE 20X==0
];IFNDEF 20X
IFNDEF TNX, TNX==1-ITS

IFN ITS, TITLE FILE JOB FOR ITS
IFN 20X, TITLE FILE JOB FOR TOPS-20
IFN 10X, TITLE FILE JOB FOR TENEX


IFE <<<SIXBIT/MIT-OZ/>-<.SITE >>*<<SIXBIT/OZ.AI./>-<.SITE >>>, OZ==1
.ELSE OZ==0

IFN OZ,	PRINTX /(OZ's munched on version)
/

IFE <<<SIXBIT/MIT-XX/>-<.SITE >>*<<SIXBIT/XX.LCS/>-<.SITE >>>, XX==1
.ELSE XX==0

IFN XX, PRINTX /(XX'S slightly munched on version)
/

DEFINE INFORM A,B,C,D,E,F,G
PRINTX /A!B!C!D!E!F!G
/
TERMIN

DEFINE CONC A,B,C,D,E,F,G
A!B!C!D!E!F!G!TERMIN

IFN ITS,[
NIMPUR==2	;Number of low impure pages (ran over by 1 word)
PURBEG==NIMPUR*2000
]	;END IFN ITS
IFN TNX,[
.DECSAV
NIMPUR==4	;Number of low impure pages
PURBEG==NIMPUR*1000
JOBSYM=116	;Pointer to symbol table, in our own core
NSYMPG==3	;Number of pages left for symbol table
IFN OZ,[
NSYMPG==4	;doesn't quite fit otherwise
IPAGE==400	;map in inquire database here
];End OZ
];END IFN TNX

;AC definitions
F=0                             ;FLAGS ET AL.

;;; AC's 1 thru 3 (and sometimes 4) are used for Tops-20 JSYS'
;;; On Tenex, the GETER JSYS will smash AC's 4-10 as well.

T=4                             ;SUPER TEMPORARIES
TT=5

A=6                             ;NOT SO SUPER TEMPORARIES, BUT FOR GENERAL USE
B=7
C=10
D=11

IDX=12				;INDEX INTO TABLES POINTING TO FILE CURRENTLY BEING HACKED
                                ; LOW ORDER BIT 0=INPUT, 1=OUTPUT
BP=13                           ;POINTER INTO PACKET
BYTE=14                         ;CURRENT BYTE BEING HACKED
FHN=15                          ;CURRENT FILE HANDLE
BC=16                           ;BYTE COUNT REMAINING IN CONTROL PACKET

P=17                            ;PDL POINTER, OF COURSE (THIS BETTER BE 17 FOR TOPS-20)

IFN ITS,[
;Get CHAOS definitions
.INSRT SYSTEM;CHSDEF
]	;END IFN ITS

IFN 20X,[
	LOC 140
IFE OZ\XX,[
.INSRT SYSTEM:CHSDEF
];NOT OZ\XX
IFN OZ\XX,[
.INSRT MID:CHSDEF
];OZ\XX
]	;END IFN 20X

IFN 10X,[
	LOC 140
.INSRT FILDEF
]	;END IFN 10X

%CPMXW== 126.		;Note: we want max over ALL systems here ...
%CPMXC== 488.

;IFNDEF CHPMXW, CHPMXW==%CPMXW-%CPKDT
;IFNDEF CHPMXC, CHPMXC==%CPMXC

;; Flag bits
F.FHN==:1_0                     ;IF SET THERE WAS A VALID FILE HANDLE IN THE CONTROL REQUEST
F.NWL==:1_1                     ;COMEUS HAS SEEN A NEWLINE
F.PRB==:1_2                     ;DOING A PROBE
F.QFP==:1_3                     ;QFASLP
F.FN1==:1_4                     ;Guess....
F.FN2==:1_5
F.DEV==:1_6
F.DIR==:1_7
IFN TNX,[
F.SPAC==:1_8			;A space has been seen while building error code
F.NRJ==:1_9			;Don't release JFN in CLOSIT
F.ENA==:1_10.			;Enable after login
]	;END IFN TNX
F.DEF==:1_11.			;:CHARACTERS :DEFAULT
IFN OZ,[
F.LSP==:1_12.			;Coming from a LispMachine
];OZ
F.PDR==:1_13.			;PROBE-DIRECTORY

;; Flag bits in LH(F) controlling file creation options for OPEN
F.CRE==:1_18.			;Create file if does not exist (for overwrite/append)
F.SUP==:1_19.			;Supersede even if ask for newest version
F.APP==:1_20.			;Append to file
F.OVW==:1_21.			;Overwrite file
F.NEW==:1_22.			;File must be new, error if already exists
F.REN==:1_23.			;Rename existing file
F.RND==:1_24.			;Rename and delete existing file
F.TRU==:1_25.			;Truncate existing file and overwrite

IFN ITS,[

DEFINE SYSCAL OP,ARGS
	.CALL [SETZ ? SIXBIT /OP/ ? ARGS ((SETZ))]
TERMIN

;; I/O CHANNELS
UTILCH==0                       ;UTILITY CHANNEL: PROBES, TTY

;;; The CHAOS channels must be contiguous
CTRLI==1                        ;CONTROL CONNECTION INPUT
CTRLO==2                        ;CONTROL CONNECTION OUTPUT

ERRCH==17			;Error channel

;; REMAINING CHANNELS FOR USE FOR REAL I/O
;; GROUP 1:
;; 3, DATA CONNECTION IN.  4, DATA CONNECTION OUT
;; 11, INPUT FILE.  12, OUTPUT FILE

;; GROUP 2:
;; 5, DATA CONNECTION IN.  6, DATA CONNECTION OUT
;; 13, INPUT FILE.  14, OUTPUT FILE

;; GROUP 3:
;; 7, DATA CONNECTION IN.  10, DATA CONNECTION OUT
;; 15, INPUT FILE.  16, OUTPUT FILE

;; EXTRA ENTRY FOR PROBING

CHACHN:	3 ? 4 ? 5 ? 6 ? 7 ? 10 ? -1

CHALOW==:1
CHAHIG==:10

CHABIT: 10 ? 20 ? 40 ? 100 ? 200 ? 400

DATCHN:	11 ? 12 ? 13 ? 14 ? 15 ? 16 ? UTILCH

MAXIDX==6                       ;NUMBER OF INFORMATION CHANNELS.  N/2 INPUT, N/2 OUTPUT
                                ;LOW ORDER BIT 0=INPUT, 1=OUTPUT
]	;END IFN ITS

IFN TNX,[
GDACC=<JSYS 331>		;Gotta add this to MIDAS's symbol table.

PRILE1:	0			;Three locations for storage of old PC at interrupt time
PRILE2:	0
PRILE3:	0

LV1ACS:	BLOCK 20		;Room for the ACs
LV1SAC:	0			;Routine to be JSR'ed to to save AC's at level 1
	MOVEM 0,LV1ACS
	MOVE 0,[1,,LV1ACS+1]
	BLT 0,LV1ACS+17
	MOVE 0,LV1ACS
	JRST @LV1SAC

MAXIDX==16.

CHABIT:	IRPS BITPOS,,[0,1,2,3,4,5,23,24,25,26,27,28,29,30,31,32,33]
	1_<35.-BITPOS!.>
	TERMIN

CHAICN:	0,,1
	2,,3
	4,,5
	23.,,24.
	25.,,26.
	27.,,28.
	29.,,30.
	31.,,32.
	33.,,33.
	;; Channels 34. and 35. are reserved by monitor for toplevel job!

CHAJFN:	BLOCK MAXIDX+1
]	;END IFN TNX

;;; Impure tables

;;; Per data-connection tables

DATFHN:	BLOCK MAXIDX+1	;File handle
DATSTA:	BLOCK MAXIDX+1	;Status
DATBYT:	BLOCK MAXIDX+1	;Byte-size
DATBPW:	BLOCK MAXIDX+1	;Bytes per word
DATBUF:	BLOCK MAXIDX+1	;Buffer
DATBPT:	BLOCK MAXIDX+1	;Buffer pointer
DATBCT:	BLOCK MAXIDX+1	;Buffer count
DATIOC:	BLOCK MAXIDX+1	;Storage over IOC errors
DATLEN:	BLOCK MAXIDX+1	;File bytes remaining (Text)
DATRCV:	BLOCK MAXIDX+1	;LM bytes received (Text)
DATSYA:	BLOCK MAXIDX+1	;Synch mark routine
DATSYN:	BLOCK MAXIDX+1	;Synch mark routine arg
DATLWD:	BLOCK MAXIDX+1	;Last word
DATICN:	BLOCK MAXIDX+1	;IOC error continuation address
IFN ITS,[
DATDEV:	BLOCK MAXIDX+1	;Device
DATFN1:	BLOCK MAXIDX+1	;First filename
DATFN2:	BLOCK MAXIDX+1	;Second filename
DATSNM:	BLOCK MAXIDX+1	;Sname (directory)
];ITS
IFN TNX,[
DATJFN:	BLOCK MAXIDX+1	;JFN
DATDSP:	BLOCK MAXIDX+1	;Disposition of file when closed
			;RH is JFN of file being replaced
			;LH is flag bits:
DD.SUP==:1		;Supersede old file by renaming to JFN in RH
DD.REN==:2		;Rename old file, then rename new file
DD.RND==:4		;Same as DD.REN, but delete old file too
DD.ABT==:10		;Close in abort mode, delete the new file
DD.OPN==:20		;File in RH is open (to lock it), remember to close it
DATFBS:	BLOCK MAXIDX+1	;File byte size
];TNX

;Status contains:
ST%CLO==:0			;Closed state (initial state)
ST%OPN==:1			;Open state
ST%ASY==:2			;Asynchronous marked state
ST%SYN==:3			;Synchronous marked state
ST%EOF==:4			;Eof state


ST.SYN==:(1_22)			;Synchronous mark (expected, on input; needed, on output)
ST.BIN==:(1_23)                 ;Binary mode
ST.UNC==:(1_24)			;The last asynchronous error is uncontinuable
ST.DEL==:(1_25)			;Deleted files are ok
IFN TNX,[
ST.TEM==:(1_26)			;Temporary file
]	;END IFN TNX
ST.OUT==:(1_27)			;COMGJF wants file for output
ST.RAW==:(1_30)			;Raw: no character translation whatsoever
ST.SUI==:(1_31)			;Super-image: don't treat rubouts specially
ST.DIR==:(1_32)			;This channel is in use for directory hackery
ST.ACT==:(1_43)			;This channel is active (sign bit!)
IFN TNX,[
ST.PON==:(1_33)			;COMGJF should do parse only
];TNX
ST.NOK==:(1_34)			;New file ok for completion, also used by COMPR4
ST.FST==:(1_35)			;Fast directory listing option
ST.ALD==:(1_36)			;Directories only listing option (ALL-DIRECTORIES)
ST.PDT==:(1_37)			;Don't update access dates, etc.
ST.SUB==:(1_40)			;Submit this file as batch
ST.PRO==:(1_40)			;Doing PROPERTIES rather than DIRECTORY (same as ST.SUB!!)
ST.INL==:(1_41)			;Inhibit links
IFN 20X,[
ST.RET==:(1_42)			;WE RETRIEVED THIS FILE
];20X

;Opcodes:
CO%SYN==:%CODAT+1               ;Synchronous mark
CO%ASY==:%CODAT+2		;Asynchronous mark
CO%NOT==:%CODAT+3		;Notification
CO%BDT==:%CODAT\100             ;Binary data
CO%TXT==:%CODAT                 ;Text opcode
CO%EOF==:%COEOF                 ;EOF opcode

%CLEND==400000

; Packets
CTLPKI:	BLOCK %CPMXW	;control in
CTLPKO:	BLOCK %CPMXW	;control out
REAPKT:	BLOCK %CPMXW
WRIPKT:	BLOCK %CPMXW
ASYPKT:	BLOCK %CPMXW

;;; Random impure data
DEBUG:	0			;-1 if debugging, +1 means dump ourselves if error (-20 only)
				;Set to zero if you purify, unless you change that
CHPMXW:	%CPMXW-%CPKDT		; Left as-is for ITS, but adjusted for TOPS-20
CHPMXC:	%CPMXC

IFN TNX,[
IFE OZ\XX,[
IFNDEF $$SUBM, $$SUBM==1	;Allowing people to SUBMIT files to us?
IFNDEF $$CCUC, $$CCUC==1	;Check Chaosnet-User-Capability?
IFNDEF $$LOG,  $$LOG==0		;Write log files
IFNDEF $$LNM,  $$LNM==0		;Parse logical-name definitions file at login time
];Not OZ\XX
IFN OZ\XX,[
IFNDEF $$SUBM, $$SUBM==1
IFNDEF $$CCUC, $$CCUC==0
IFNDEF $$LOG,  $$LOG==0
IFNDEF $$LNM,  $$LNM==0
];OZ\XX

ANONUM:	0			;ANONYMOUS's user#

IFN 20X,[
DEVDEG: 0			;[UTexas] for saving device designator
STRNAM:	BLOCK 5			;For converting sixbit structures to ascii
CNCTED:	0			;are you foreignly connected?
CONFNM:	BLOCK 10.		;Made by JFNS (for trying to CONNECT)
RETENA: 0			;AUTOMATIC FILE RETRIEVALS ENABLED?
$$LNM==1			;Process LOGICALS.CMD on login?
];20X

IFNDEF .SFCHA,$$CCUC==0		;Only if MIDAS knows about Chaos capability do we care
IFE 20X,$$CCUC==0		;No chaos checking on 10X
IFE 20X,$$SUBM==0		;Or batch (of QUASAR sort)

IF1,[
IFN $$SUBM, INFORM Ability to submit batch jobs included
IFN $$CCUC, INFORM Checking of chaosnet-user capability included
IFN $$LOG, INFORM Log-file writing included
IFN $$LNM, INFORM Reading of LOGICALS.CMD file included
];IF1

TMPFIL:	BLOCK 20		;Temporary filename, for overwriting.
DMPACS: BLOCK 20		;Save ACs when we dump ourselves

OZ$LOG==OZ*$$LOG
];TNX
IFE OZ,OZ$LOG==0

PDLEN==170
PDL:	-PDLEN,,.+1             ;Size carefully chosen to give 1K impure
	BLOCK PDLEN
FHNOUT:	BLOCK 1                 ;WORD TO OUTPUT FILE HANDLE FROM
	0
PTCVER:	0			;Protocol version number
IFN ITS, MACNAM: 0		;The machine we are on
CLODAT:	0			;Temporary storage by CLOSE operation
CLOLEN:	0
ERRCOD:	0                       ;Error code returned by .CALL OPEN
SYSBGF:	0			;Flag set to force 3-letter code to BUG
ERRLEN==:100.
ERRBUF:	BLOCK ERRLEN/5
IFN ITS, SSYDF2: 0		;Temporary storage of old DF2 word

TRANID:	0			;Transaction ID
	0
PKTLOC:	CTLPKO			;COMCTL (et al.) use this as packet address
USERID:	0			;User ID, set by LOGIN.  Must be non-zero to do OPEN's
DIRPDL:	0			;Saved stack for unwinding directory output

IFN ITS,[
STARF2:	0			;Non-0 want "*" for default FN2, else ">"
HSNAME:	0			;User HSNAME, sets files' authors
DIRLCK:	0			;Only one channel can use DIRBUF
WRITER:	BLOCK 2
]	;END IFN ITS
IFN TNX,[
RESLEN==:200
RESBLK:	BLOCK RESLEN/5
CTLJFN:	0
WILDIR:	0			;Temporary for EXPFNM
NOTNEW:	0			;Flag for COMGJF - No GJ%NEW, please (ran out
				;of bits for doing this in DATSTA, foo)
				;0 => ST.OUT => GF%FOU and GJ%NEW
				;1 => no GJ%FOU
				;-1 => GJ%OLD (ignore ST.OUT)

INQBLK:
GTJBLK:				;For long call GTJFN for completion
CRDBLK:				;Argument block for CRDIR
DIRINF:	BLOCK 50		;For GTDIR info (in LOGIN command) and GTFDB
JFNSTR:	BLOCK 30.		;For building JFN's, 149 chars should be ok
INQBLL==.-INQBLK
USRNUM:	BLOCK 1
UDRNUM:	BLOCK 1		;Your home dir#
CWDNUM:	BLOCK 1		;dir# you have explicitly connected to
DWNTIM:	BLOCK 1
IFN 10X, BLOCK 1
TIMINF:	BLOCK 1
SAVEBP:	BLOCK 1
WRITER:	BLOCK 40./5

JFNBLK:	.GJDEF		;Can be changed to .GJALL later
	.NULIO,,.NULIO
	0		;Connected structure
	0		;Connected directory
	-1,,[Ascii /*/]	;Default FILENAME,
	-1,,[Ascii /*/]	;EXTENSION,
	0		;Default protection,
	0		;and account.
	0		;Not used (.GJJFN)

IFN $$SUBM,[
.QOCQE==37
.QCFIL==10
.QCQUE==24
.OTBAT==4

QUTILB:	.MURSP		;Get PID of...
	.SPQSR		;QUASAR...
QSRPID:	0		;<here>

MSendB:	0		;Arg block for the SUBMIT MSEND
YerPID:	0		;Your PID
	0		;QUASAR's PID
	1000,,QSRPAG	;1 page from here (saved, then restored).
];$$SUBM

IFN $$LNM,[
strbsz==200.
strbuf:	block strbsz/5
atmbuf:	block strbsz/5

cmdblk:	0,,lnm10
	0,,.nulio		;.CMIOJ
	440700,,[0]		;.CMRTY - no prompt
	440700,,strbuf		;.CMBFP
	440700,,strbuf		;.CMPTR
	strbsz			;.CMCNT
	strbsz			;.CMINC
	440700,,atmbuf		;.CMABP
	strbsz			;.CMABC
	0			;.CMGJB
];$$LNM

IFN $$SUBM,[
QPBLK:	0,,.QOCQE		;Create Queue Entry
	0 ? 0			;Unused header words.
	0			;Unused flag word
	2			;Two arg blocks...
	2,,.QCQUE		;[#1] 2-word block: QUE type is...
	.OTBAT			;BATCH
	0,,.QCFIL		;[#2] n word block... a filespec.
	BLOCK 12.
];$$SUBM

IFN OZ\XX,[
KSITE:	BLOCK 10.	;Your site, like /MIT-LISPM-12/
Remark:	Block 20.	;Session remark, "CHAOS SERVER " + KSITE
HostN:	0		;Host number... hoo summoned us?
]

IFN OZ,[
GOTINQ:	0		;Non-0 if have Inquire mapped in.
INQADR:	0		;Address of user's Inquire entry (or 0 if none)
TimeOn:	0		;Suicide TIMER is on.
DownpT:	0		;System is going down, and channel 33 is in use.
LispMf:	0		;Non-0 if connected from a LispM
LogJFN:	0		;JFN for hangers-on log
IFN $$LOG,[
TriJFN:	0		;Trickle file JFN
Trikle:	Block 20	;Trickle filename
];$$LOG
];OZ
];END IFN TNX

IMPLOC==.
LOC PURBEG

;;; Pure tables
IFN ITS,[
CTLOUT:	SETZ
	SIXBIT /PKTIOT/
	%CLIMM,,CTRLO
	%CLIMM+%CLEND,,CTLPKO

CTLINP:	SETZ
	SIXBIT /PKTIOT/
	%CLIMM,,CTRLI
	%CLIMM+%CLEND,,CTLPKI
]	;END IFN ITS

IFN OZ,[	;NETWRK is pure code
.INSRT MID:MACROS

HOSTSP==100	;Map HOSTS2 at this page.
$$CHAOS==1	;We only want chaosnet.
$$HSTMAP==1	;Map/unmap file utils;
$$HOSTNM==1
$$SYMLOOK==1
NETWRK"E=IDX
IFN NETWRK"E-<D+1>, .ERR NETWRK wants E to be D+1
.INSRT MID:NETWRK

%%T==T ? %%TT==TT		;HAKINQ expects AC4 to be available
T=C ? TT=D			;and since T=4, it loses very badly.
$$MAP==1
$$READ==1
$$XLATE==1
$$NPNAME==1
.INSRT MID:HAKINQ
T=%%T ? TT=%%TT
];OZ

;;; Macros
DEFINE CERR CODE,TEXT
	JSP D,COMERR
	 SKIPA
	  '!CODE,,[ASCIZ \F TEXT\]
	TERMIN

DEFINE AERR CONTIN,CODE,TEXT
	JSP D,ASYERR
	 JRST .+3
	  '!CODE,,[ASCIZ \F TEXT\]
	  CONTIN
	TERMIN

DEFINE IOCERR ADR
	JSP D,ICCERR
	 SKIPA
	  ADR
	TERMIN

;;; Main program.  Startup, initialization, control connection main loop

FILE:
IFN ITS,SETZB F,DIRLCK
IFN TNX,SETZ F,
	MOVE P,PDL
IFN ITS,[
	.SUSET [.ROPTION,,T]
	TLO T,OPTINT\OPTOPC	;TURN ON NEW STYLE INTERRUPTS
	.SUSET [.SOPTION,,T]
	.SUSET [.SDF1,,[%PIDBG+%PIDWN]]	;DEFER SYS DOWN, SYS DEBUG
	.SUSET [.SMASK,,[%PIIOC+%PIDBG+%PIDWN]] ;ENABLE INTERRUPTS
	.CALL [ SETZ            ;GET OUT MACHINE'S NAME
		SIXBIT /SSTATU/
		MOVEM A ? MOVEM B ? MOVEM T ? MOVEM T ? MOVEM T
		SETZM MACNAM]
	 .LOSE %LSSYS
	SKIPLE A		;GET INITIAL HIT OF DOWN/DEBUG INTERRUPTS
	 .SUSET [.SIPIRQC,,[%PIDWN]]
	SKIPE B
	 .SUSET [.SIPIRQC,,[%PIDBG]]
        .CALL [	SETZ            ;ASSIGN CHAOSNET CONTROL CHANNELS
		SIXBIT /CHAOSO/
		%CLIMM,,CTRLI
		%CLIMM,,CTRLO
		%CLIMM,,5 ((SETZ))]
	 .LOGOUT 1,
	MOVEI T,%COLSN          ;LISTEN FOR OUR CONTACT NAME
	DPB T,[CTLPKO+$CPKOP]
	MOVE T,[.BYTE 8 ? "F ? "I ? "L ? "E]
	MOVEM T,CTLPKO+%CPKDT
	MOVEI T,4
	DPB T,[CTLPKO+$CPKNB]
	.CALL CTLOUT            ;OUTPUT THE LISTEN
	 .LOSE %LSSYS
	MOVEI T,30.*30.		;30. SEC TIMEOUT
	SKIPGE DEBUG		;UNLESS DEBUGGING
	 HRLOI T,177777
	.CALL [	SETZ            ;WAIT FOR A RESPONSE OR TIMEOUT
		SIXBIT /NETBLK/
		%CLIMM,,CTRLO
		%CLIMM,,%CSLSN
		T
		SETZM TT]
	 .LOSE %LSSYS
	CAIE TT,%CSRFC		;RFC RECEIVED?
	 .VALUE
	.CALL CTLINP            ;READ RFC PACKET
	 .LOSE %LSSYS
	LDB T,[CTLPKI+$CPKOP]
	CAIE T,%CORFC
	 .VALUE
	MOVE P,PDL
	PUSHJ P,CHKPVR		;CHECK PROTOCOL VERSION NUMBER
	 .VALUE			;ALREADY WILL HAVE SENT CLS IF NO GOOD
	MOVEI T,%COOPN		;SEND OPN BACK
	DPB T,[CTLPKO+$CPKOP]
	.CALL CTLOUT
	 .LOSE %LSSYS
	SKIPGE DEBUG		;DEBUGGING?
         JRST CTLLOP            ;YES, SO DON'T TRY TO LOGIN
	LDB T,[$CPKSA CTLPKI]	;GET SOURCE HOST ADDRESS
	MOVE TT,[SIXBIT /000C00/] ;CONVERT HOST NUMBER TO SIXBIT
	DPB T,[220300,,TT]
	LSH T,-3
	DPB T,[300300,,TT]
	LSH T,-3
	DPB T,[360300,,TT]
	.SUSET [.RUIND,,T]	;INCORPORATE USER INDEX ALSO
	DPB T,[000300,,TT]
	LSH T,-3
	DPB T,[060300,,TT]
	LSH T,-3
	DPB T,[170100,,TT]	;C77 + 1 = K00 TO AVOID DUPLICATIONS
	MOVE T,TT		;SAVE COPY FOR XUNAME
	MOVEI A,100(TT)		;DON'T LOOP FOREVER, ONLY 100 TIMES
CHALS1:	CAIN A,(TT)
	 .VALUE			;I DON'T THINK THIS CAN HAPPEN, BUT IT DOES ANYWAY
	.CALL [SETZ
	       SIXBIT /LOGIN/
	       TT ? [SIXBIT /CHAOS/] ? SETZ T]
	 AOJA TT,CHALS1		;ERROR, PERHAPS NEED TO TRY OTHER UNAME
	.SUSET [.SJNAME,,[SIXBIT /FILE/]]
	.CALL [SETZ ? 'DETACH ? MOVEI %JSELF ? ANDI 3 ]
	 .LOSE %LSSYS		;MAKE SELF SYSTEM-DAEMON FOR FAST RESPONSE

CTLLOP:	MOVE P,PDL              ;IN CASE OF ERROR, RESTORE PDL
	SETZ F,                 ;CLEAR FLAGS
	.SUSET [.SDF1,,[0]]	;ALLOW SYS DOWN, SYS DEBUG INTERRUPTS NOW
	.CALL CTLINP            ;GET NEXT CONTROL PACKET, HANG IF NECESSARY
	 .LOSE %LSSYS
	.SUSET [.SDF1,,[%PIDBG+%PIDWN]]	;DEFER THESE INTS WHILE PROCESSING
	LDB T,[CTLPKI+$CPKOP]
	CAIL T,%CODAT		;THIS A DATA PACKET?
	 JRST COMMAN		;YES, OK, GO DO A COMMAND FROM IT
	CAIE T,%COEOF		;LISP MACHINE WANT TO CLOSE THE CONNECTION?
         JRST CTLLOP            ;HMMM, BAD PACKET, IGNORE IT FOR NOW
CTLERR:
CTLDON:	.LOGOUT 1,              ;Go away immediately, do not RENMWO any output files
]	;END IFN ITS

IFN TNX,[
	RESET 			;Reset the Universe
	MOVEI 1,.FHSLF		;Setup our interrupt vector
	MOVE 2,[LEVTAB,,CHNTAB]
	SIR
	MOVEI 1,.FHSLF		;Turn on interrupt system
	EIR
	MOVEI 1,.FHSLF		;Enable interesting interrupts
	MOVE 2,[000747,,000004]
	AIC
IFN 20X,[
	MOVE 1,[SIXBIT /CHPMXT/]	; Get max packet size
	SYSGT
	TLNE 1,-1
	 JRST [	MOVE 1,[SIXBIT /LHOSTN/]	; Old flavor monitor
		SYSGT
		CAIE 1,54			; XX ?
		 SKIPA 1,300			; no - size is 300
		  MOVEI 1,488.			; yes - size is max
		JRST .+1 ]
	MOVEM 1,CHPMXC				; Set max # chars
	LSH 1,-2
	MOVEM 1,CHPMXW				; Set max # words
]
	MOVE 1,[SIXBIT /FILE/]
IFN 10X,SETNM
IFN 20X,[
	MOVE 2,1
	SETSN
	  JFCL
IFE OZ\XX,[
	SETO 1,			;THIS JOB
	MOVEI 2,.SJSRM		;SET SESSION REMARK
	HRROI 3,[ASCIZ /CHAOS SERVER/]
	SETJB			;DO IT
	 ERJMP .+1		;OR DON'T
];IFE OZ\XX
];20X
	HRLZI 1,(GJ%SHT)	;Short GTJFN to get the control channel
	HRROI 2,[ASCIZ \CHA:.FILE\]
	GTJFN
	 ERCAL CTLDON
	HRRZM 1,CTLJFN		;JFN for control channel
	MOVE 2,[100000,,OF%RD\OF%WR]
	OPENF			;Listen for connection
	 ERCAL CTLDON
	MOVEI 2,.MOPKR
	MOVEI 3,CTLPKI
	MTOPR
	 ERCAL CTLDON
	MOVE P,PDL
	PUSHJ P,CHKPVR		;CHECK PROTOCOL VERSION NUMBER
	 JRST CTLDN0		;ALREADY WILL HAVE SENT CLS IF NO GOOD
	MOVE 1,CTLJFN
	MOVEI 2,.MOOPN		;Accept the connection
	MTOPR
	 ERCAL CTLDON
	PUSHJ P,TIMIN1		;Turn on timer interrupts
IFN OZ,[
	SETOM	RETENA		;CHEAP WAY TO ENABLE FILE RETRIEVALS
	MOVEI A,HOSTSP
	PUSHJ P,NETWRK"HSTMAP	;Map in HOSTS2 database
	 JRST CTLLOP		; oops
];IFN OZ
IFN OZ\XX,[
	LDB B,[$CPKSA+CTLPKI]	;SOURCE ADDRESS
	Movem B,HostN		;Save for later.
];IFN OZ\XX
IFN OZ,[
	PUSHJ P,NETWRK"HSTSRC	;Look up name of who's knocking
	 JRST CTLLOO
	HRRO 2,A		;-1,,(A) in AC2
	HRROI 1,KSITE		;Get the host-name in KNAME
	SETZ 3,
	SOUT
];IFN OZ
IFN XX,{			;There's a perfectly good jsys,
	MOVEI 1,.CHNNS		;why map host tables?
	HRROI 2,KSITE
	MOVE 3,HostN
	CHANM%
	 ERJMP [HRROI 1,KSITE	;Lookup failed, use octal number
		MOVE 2,B
		MOVEI 3,8
		NOUT%
		 ERJMP .+1	;this shouldn't ever fail
		JRST .+1]
};IFN XX
IFN OZ\XX,[
	HRROI 1,REMARK
	HRROI 2,[ASCIZ "CHAOS SERVER "]
	SETZ 3,
	SOUT
	HRROI 2,KSITE
	SOUT
	SETO 1,			;THIS JOB
	MOVEI 2,.SJSRM		;SET SESSION REMARK
	HRROI 3,REMARK
	SETJB			;DO IT
	 ERJMP .+1		;OR DON'T
];IFN OZ\XX
IFN OZ,[
	HLRZ A,1(D)		;Address of system-name
	ADD A,NETWRK"HSTADR
	MOVE T,(A)
	CAMN T,[ASCII /LISPM/]
	 JRST [	TRO F,F.LSP	;We are a LispMachine
		MOVEI 1,.FHSLF
		SETO 3,
		EPCAP		;Enable!!
		JRST CTLLOO ]
	Movei 1,.GJALL		;Known not to be a Lisp machine, use * as default vers
	Movem 1,JFNBLK+.GJGEN
IFN $$LOG,[
	Setom LispMf
	GJINF
	Move T,3
	Hrroi 1,Trikle
	Hrroi 2,[Asciz "SS:<TRIKLE>"]
	Setz 3,
	SOUT
	Hrroi 2,KSite
	SOUT
;	Hrroi 2,[Asciz "-JOB-"]
;	SOUT
;	Move 2,T
;	Movei 3,10.
;	NOUT
;	  Jfcl
	Hrroi 2,[Asciz ".LOG"]
	Setz 3,
	SOUT
	Movsi 1,(GJ%SHT\GJ%FOU)
	Hrroi 2,Trikle
	GTJFN
	  Jrst CTLLOO		;No biggie (if it fails)
	Movem 1,TriJFN
	Move 2,[70000,,OF%WR]
	OPENF
	  Jrst [Move 1,TriJFN
		RLJFN
		  Jfcl
		Setzm TriJFN
		Jrst CTLLOO]
	Seto 2,			;Now
	Setz 3,
	ODTIM
	Hrroi 2,[Asciz " Log started
"]
	Setz 3,
	SOUT
];$$LOG
CTLLOO:	PUSHJ P,NETWRK"HSTUNMAP	;We don't need those pages anymore
];OZ

CTLLOP:	MOVE P,PDL		;For safety, reset the world
	SETZ F,
	SETO A,			;Allow timer interrupts
	EXCH A,TIMINF		;See if timer went off
	SKIPE A
	 PUSHJ P,DWNCHK		;It did, do check now
	MOVE 1,CTLJFN		;Wait for a control packet
	MOVEI 2,.MOPKR
	MOVEI 3,CTLPKI
	MTOPR
	 ERCAL CTLERR		;Flush ourselves if any error
IFN OZ$LOG,[
	Skipn 1,TriJFN
	  Jrst CTLLOR
	Seto 2,
	Setz 3,
	ODTIM
	Hrroi 2,[Asciz " <==
"] ?	Setz 3,
	SOUT

	Skipe TimeOn				;Activity!  Turn off pending
	  Jrst [Move 1,[.FHSLF,,.TIMAL]		;suicide interrupt (actually
		TIMER				;turn them all off)
		Setzm TimeOn
		Jrst .+1]
CTLLOR:
];OZ$LOG
	SETZM TIMINF		;No longer allow timer interrupts
	LDB T,[CTLPKI+$CPKOP]
	CAIL T,%CODAT		;THIS A DATA PACKET?
	 JRST COMMAN		;YES, OK, GO DO A COMMAND FROM IT
	CAIE T,%COEOF		;LISP MACHINE WANT TO CLOSE THE CONNECTION?
         JRST CTLLOP            ;HMMM, BAD PACKET, IGNORE IT FOR NOW
	PUSHJ P,CTLDON		;Does not return.

CTLDON:	SKIPG DEBUG		;Dump ourselves
	 JRST CTLDN0
	MOVEM 0,DMPACS
	MOVE 0,[1,,DMPACS+1]
	BLT 0,DMPACS+17
	MOVE 1,[GJ%SHT+GJ%FOU+GJ%NEW]
IFN 20X,HRROI 2,[ASCIZ \PS:<CRASH>DEAD-FILEJOB.EXE\]
IFN 10X,HRROI 2,[ASCIZ \DSK:<CHAOS>DEAD-FILEJOB.SAV\]
	GTJFN
	 JRST CTLDN0
	HRLI 1,.FHSLF
	MOVE 2,[777760,,20]
	SAVE
CTLDN0:
IFN OZ$LOG,[
	Skipn 1,TriJFN
	  Jrst ZZZ
	Seto 2,
	Setz 3,
	ODTIM
	Hrroi 2,[Asciz " Closing log file - EOF received"]
	Setz 3,
	SOUT
	CLOSF
	 Jfcl
ZZZ:
];OZ$LOG
IFN 10X,[			;Tenex LGOUT doesn't do this itself
	MOVEI IDX,MAXIDX-1	;Last output channel
CTLDN1:	HRRZ 1,DATSTA(IDX)
	JUMPE 1,CTLDN2		;ST%CLO
	MOVE 1,DATJFN(IDX)
	HRLI 1,(CO%NRJ)		;Close file, but keep around JFN
	CLOSF
	 ERJMP CTLDN2		;Ain't much else we can do...
	DELF			;Delete the file and release JFN
	 ERJMP CTLDN2
CTLDN2:	SUBI IDX,2
	JUMPGE IDX,CTLDN1
];IFN 10X
IFN 20X,[
	MOVEI 1,.FHSLF
	HRLI 1,(CZ%ABT+CZ%NUD)	;Abort all output operations +
				; don't update disk copy of directory   
	CLZFF			; and close all files 
	  ERJMP .+1		;oh well, we tried.
];IFN 20X	
	MOVNI 1,1		;-1 means log us out
	SKIPL DEBUG		;If debugging, just stop, will die if top-level
	 LGOUT			;Bye-bye
	 HALTF
	JRST .-1

CTLERR:	MOVEI 1,.FHSLF
	PUSHJ P,$GETER
	 PUSHJ P,CTLDON		;Punt if no err
	MOVE 1,[441000,,CTLPKO+%CPKDT]
	MOVSI 3,-%CPMXC
	ERSTR
	 PUSHJ P,CTLDON
	 JFCL
CTLER1:	SETZ BC,
IFN 10X,IDPB BC,1		;Put in null at end
	MOVE 1,[441000,,CTLPKO+%CPKDT]
	ILDB 2,1
	CAIE 2,0
	 AOJA BC,.-2		;Get real size
	MOVEI T,%COLOS		;Send LOS packet
	DPB T,[$CPKOP+CTLPKO]
	DPB BC,[$CPKNB+CTLPKO]
	MOVE 1,CTLJFN
	MOVEI 2,.MOPKS
	MOVEI 3,CTLPKO
	MTOPR
	 ERCAL CTLDON
	PUSHJ P,CTLDON
]	;END IFN TNX

;;; Called c(D)+1 has code,,pointer-to-asciz-string
COMERR:	MOVEI A,[ASCIZ \ERROR \] ;INDICATE AN ERROR TO THE REQUESTOR
	PUSHJ P,COMCTL
	HLLZ A,1(D)             ;GET ERROR CODE
	PUSHJ P,COMSXO
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	HRRZ A,1(D)             ;NOW OUTPUT THE ERROR STRING
	PUSHJ P,COMSTO
	PUSHJ P,COMSND
	JRST CTLLOP

MINPTC==0
MAXPTC==1

;;; Check protocol version number
CHKPVR:	MOVE BP,[441000,,CTLPKI+%CPKDT]
	LDB BC,[CTLPKI+$CPKNB]
	PUSHJ P,COMRD5		;SHOULD BE FILE
	 TDZA A,A
	PUSHJ P,COMDCI		;GET NUMBER INTO A
	MOVEM A,PTCVER
	CAIL A,MINPTC
	 CAILE A,MAXPTC
	 SKIPA
	 JRST POPJ1
	MOVEI A,[ASCIZ \PROTOCOL VERSION \]
	PUSHJ P,COMCTL
	MOVE A,PTCVER
	PUSHJ P,COMDCO
	MOVEI A,[ASCIZ \ NOT SUPPORTED\]
	PUSHJ P,COMSTO
	MOVEI T,%COCLS
	JRST COMSN1

;;; Here to handle a command over the control connection
COMBAD:	CERR BUG,[Illegal request format]

COMMAN:
IFN OZ$LOG,[
	SKIPN TRIJFN
	  JRST XXX2
	LDB A,[$CPKNB+CTLPKI]		;Byte-count
	MOVE B,[441000,,CTLPKI+%CPKDT]
	PUSHJ P,PKTPRT
XXX2:
];OZ$LOG
	MOVE BP,[441000,,CTLPKI+%CPKDT]
	LDB BC,[CTLPKI+$CPKNB]
	PUSHJ P,COMRD5		;Get transaction ID
	 JRST CTLLOP		;Error, ignore this request (what else?)
	MOVEM A,TRANID
	TRZ F,F.FHN             ;NO FILE HANDLE SEEN YET
	MOVEI B,5               ;MAXIMUM FILE-HANDLE SIZE
	SETZ FHN,
	MOVE A,[440700,,FHN]    ;ACCUMULATE FILE HANDLE
COMFHL:	SOJL BC,COMBAD          ;BAD CONTROL PACKET: PROTOCOL VIOLATION
	ILDB BYTE,BP            ;GET THE NEXT CHARACTER
	CAIN BYTE,40            ;SPACE TERMINATES FILE HANDLE
	 JRST COMMA1            ;KEEP PROCESSING
	IDPB BYTE,A
	SOJG B,COMFHL           ;ONLY READ FIRST 5 CHARACTERS
	PUSHJ P,COMEUS          ;EAT UNTIL SPACE SEEN
	 JRST COMBAD            ;NON-SKIP, HIT END OF PACKET OR NEWLINE, ERROR
COMMA1:	JUMPE FHN,COMMA2        ;DON'T HAVE A FILE HANDLE AFTER ALL
	TRO F,F.FHN
	MOVEI IDX,MAXIDX-1      ;LOOP OVER ALL INDICIES
COMMA3:	CAMN FHN,DATFHN(IDX)    ;MATCH?
	 JRST COMMA2            ;YUP, LEAVE IDX IN IDX
	SOJGE IDX,COMMA3
	CERR BUG,[Unknown file handle]

COMMA2:	PUSHJ P,COMR10          ;READ 10 CHARACTERS INTO A AND B
	 JFCL
	JUMPE A,[CERR BUG,[Null command name]]
	MOVSI T,-COMTAL		;AOBJN POINTER
COMCO1:	CAMN A,COMTAB(T)        ;MATCH?
	 CAME B,COMTAB+1(T)
	  AOJA T,COMCO2		;NO, TRY NEXT
	HRRZS T			;YES, RUN THE COMMAND
	LSH T,-1
	JRST @COMDSP(T)

COMCO2:	AOBJN T,COMCO1
	CERR UKC,[Unknown command]

;;; Command table
COMTAB:	ASCII \DATA-CONNE\	;DATA-CONNECTION
	ASCII \UNDATA-CON\	;UNDATA-CONNECTION
	ASCII \OPEN\ ? 0	;OPEN
	ASCII \CLOSE\ ? 0	;CLOSE
	ASCII \FILEPOS\		;FILEPOS
	ASCII \DELETE\	   	;DELETE
	ASCII \RENAME\	   	;RENAME
	ASCII \CONTINUE\	;CONTINUE
	ASCII \SET-BYTE-S\	;SET-BYTE-SIZE
	ASCII \LOGIN\ ? 0	;LOGIN
	ASCII \DIRECTORY\	;DIRECTORY
	ASCII \COMPLETE\	;COMPLETE
	ASCII \CHANGE-PRO\	;CHANGE-PROPERTIES
	ASCII \CREATE-DIR\	;CREATE-DIRECTORY
	ASCII \EXPUNGE\		;EXPUNGE
	ASCII \HOMEDIR\		;HOMEDIR
	ASCII \FILE-SYSTE\	;FILE-SYSTEM-INFO
	ASCII \PROPERTIES\	;PROPERTIES
IFN ITS,ASCII \CREATE-LIN\	;CREATE-LINK
IFN TNX,[
	ASCII \CWD\ ? 0		;CHANGE WORKING DIRECTORY (CONNECT)
IFN 20X,ASCII \ACCESS\		;ACCESS DIRECTORY
	ASCII \ENABLE-CAP\	;ENABLE-CAPABILITIES
	ASCII \DISABLE-CA\	;DISABLE-CAPABILITIES
];TNX
COMTAL==<.-COMTAB>/2

COMDSP:	COMDCN
	COMUDC
	COMOPN
	COMCLO
	COMFIL
	COMDEL
	COMREN
	COMCON
	COMSBS
	COMLOG
	COMDIR
	COMCPL
	COMCNG
	COMCRD
	COMEXP
	COMHOM
	COMFSI
	COMPRO
IFN ITS,COMCRL
IFN TNX,[
	COMCWD
IFN 20X,COMACD
	COMENA
	COMDIS
];TNX
IFN .-COMDSP-COMTAL, .ERR COMDSP and COMTAB lengths disagree

;;; Subroutines

;Read the next token from the stream.  Reads the first 5 bytes, and throws away the rest.
; Destroys T, TT, and BYTE; result in A.  Tail recurses to COMEUS
COMR10:	MOVEI T,10.		;ALLOW 10 CHARACTERS INTO A AND B
	TDZA B,B
COMRD5:	 MOVEI T,5
	TRZ F,F.NWL
	SETZ A,
	MOVE TT,[440700,,A]     ;ACCUMULATE TOKEN IN A
COMR5A:	SOJL BC,CPOPJ           ;END OF PACKET, HAVE TOKEN
	ILDB BYTE,BP            ;GET THE NEXT CHARACTER
	CAIN BYTE,215           ;NEWLINE TERMINATES
	 JRST COMEUN
	CAIN BYTE,40            ;SPACE TERMINATES THE TOKEN
	 JRST COMEUR
	IDPB BYTE,TT
	SOJG T,COMR5A           ;ONLY READ FIRST 5 CHARACTERS
;	JRST COMEUS	        ;FALL INTO COMEUS

;Eats until end of stream, space, or newline seen
; Non-skip return if end of packet or newline seen, skip return if space seen
COMEUS:	SOJL BC,COMEUP          ;IF END OF STREAM, RETURN
	ILDB BYTE,BP            ;NEXT BYTE
COMEUA:	CAIN BYTE,215           ;NEWLINE
	 JRST COMEUN
	CAIE BYTE,40            ;SPACE
	 JRST COMEUS            ;NOPE, KEEP GOING
COMEUR:	AOS (P)                 ;SKIP RETURN
COMEUP:	TRZA F,F.NWL
COMEUN:	 TRO F,F.NWL
CPOPJ:	POPJ P,

;Single byte output
;Must preserve TT
COMCHO:	CAML BC,CHPMXC
	 CERR BUG,[Too much information to fit in a packet]
	IDPB BYTE,BP
	AOJA BC,CPOPJ

;;; For TOPS-20, output from RESBLK, where lots of interesting things get returned
IFN TNX, COMRES: SKIPA A,[440700,,RESBLK]
;String out, string address in A, COMST0 if already byte pointer
COMSTO:	HRLI A,440700           ;MAKE A A STRING POINTER
COMST0:	ILDB BYTE,A             ;GET NEXT CHARACTER
COMST1:	JUMPE BYTE,CPOPJ	;TERMINATE ON NULL
	XCT CHR2LM(BYTE)        ;CONVERT TO LISP MACHINE CHARACTER SET
	 PUSHJ P,COMCHO         ;NON-SKIP, JUST OUTPUT
	 JRST COMST0
	 JRST COMST0		;IGNORE RUBOUT ESCAPE, SHOULDN'T HAPPEN HERE
	MOVEI BYTE,115		;POSSIBLY STRAY RETURN, OUTPUT M TO BE SAFE NOW
	PUSHJ P,COMCHO
	ILDB BYTE,A		;AND ABSORB FOLLOWING LINE FEED
	CAIE A,12
	 JRST COMST1
	MOVEI BYTE,215		;CARRIAGE RETURN FOR CRLF
	DPB BYTE,BP		;REPLACE M IN PACKET
	JRST COMST0

;Decimal output, value in A, destroys A and B
COMDCO:	JUMPL A,CPOPJ           ;IGNORE NEGATIVE NUMBERS
	PUSH P,[-1]             ;FLAG BOTTOM OF STACK
COMDO0:	IDIVI A,10.
	PUSH P,B
	JUMPN A,COMDO0
COMDO1:	POP P,BYTE
	JUMPL BYTE,CPOPJ        ;DO UNTIL NO MORE DIGITS
	ADDI BYTE,"0
	PUSHJ P,COMCHO
	JRST COMDO1

;Octal output, value in A, destroys A
COMOCO: PUSH P,[-1]             ;FLAG BOTTOM OF STACK
COMOO0:	PUSH P,A
	ANDI A,7		;SAVE BOTTOM DIGIT
	EXCH A,(P)
	LSH A,-3
	JUMPN A,COMOO0
COMOO1:	POP P,BYTE
	JUMPL BYTE,CPOPJ        ;DO UNTIL NO MORE DIGITS
	ADDI BYTE,"0
	PUSHJ P,COMCHO
	JRST COMOO1

;Sixbit output, sixbit in A, destroys A and B.  Quotes funny characters.
COMSXO:	MOVE B,A
COMSO0:	JUMPE B,CPOPJ           ;TERMINATE WHEN NO MORE BYTES
	SETZ A,
	LSHC A,6                ;GET NEXT BYTE
	JUMPE A,COMSOQ		;QUOTE LEADING SPACES
	CAIE A,':		;AND : OR ;
	 CAIN A,';
	 JRST COMSOQ
COMSO1:	MOVEI BYTE,40(A)        ;MAKE ASCII
	PUSHJ P,COMCHO          ;OUTPUT THE BYTE
	JRST COMSO0

COMSOQ:	MOVEI BYTE,"
	PUSHJ P,COMCHO
	JRST COMSO1

;Output date/time from A
COMDTO:	PUSH P,D
	MOVEI D,COMCHO		;Output char in BYTE to command response
	JRST COMDT0

DIRDTO:	PUSH P,D
	MOVEI D,DIRCHO		;Output char in BYTE to directory listing
COMDT0:
IFN TNX,[
;; Internal date/time in A -- convert to ITS format
	MOVE 2,A
	AOSN A			;If -1, then use 0
	 SETZ 2,
	SETZ 4,
	ODCNV			;Convert internal date/time to printable format
	 ERCAL SYSBUG
	HRRZ A,4		;Local time in seconds
	LSH A,1			;Number of half-seconds since midnight
	HLRZ T,2		;The year
	SUBI T,1900.
	DPB T,[330700,,A]
	AOS 2
	DPB 2,[270400,,A]	;The month
	HLRZ T,3		;The day
	AOS T
	DPB T,[220500,,A]
]	;END IFN TNX
IFN ITS,[
	HLRZ B,A
	ANDI B,177777
	CAIN B,-1
	 MOVEI A,0		;Unknown => start of century
]
	PUSH P,A
	LDB A,[270400,,0 (P)]	;MONTH  3.9-3.6
	CAIG A,12.
	 CAIG A,0
	  MOVEI A,1		;Lisp machine barfs if month is bogus
	IDIVI A,10.
	MOVEI BYTE,"0(A)
	PUSHJ P,(D)
	MOVEI BYTE,"0(B)
	PUSHJ P,(D)
	MOVEI BYTE,"/
	PUSHJ P,(D)
	LDB A,[220500,,0 (P)]	;DAY  3.5-3.1
	CAIG A,31.
	 CAIG A,0
	  MOVEI A,1		;Lisp machine barfs at bogus days now, too
	IDIVI A,10.
	MOVEI BYTE,"0(A)
	PUSHJ P,(D)
	MOVEI BYTE,"0(B)
	PUSHJ P,(D)
	MOVEI BYTE,"/
	PUSHJ P,(D)
	LDB A,[330700,,0 (P)]	;YEAR  4.7-4.1
	IDIVI A,100.
	MOVE A,B		;Ignore overflow if 3-digit year (garbage)
	IDIVI A,10.
	MOVEI BYTE,"0(A)
	PUSHJ P,(D)
	MOVEI BYTE,"0(B)
	PUSHJ P,(D)
	MOVEI BYTE,40
	PUSHJ P,(D)
	HRRZ A,(P)              ;TIME
	LSH A,-1		;Half-seconds since midnight, HOW RANDOM!
	CAIL A,86400.
	 MOVEI A,0		;I suppose the Lisp machine probably checks this too
	IDIVI A,60.		;Get number of seconds
	PUSH P,B		;Save them
	IDIVI A,60.		;Get number of minutes
	PUSH P,B		;Save them
REPEAT 3,[			;Output each of the sections with intervening colons
	IDIVI A,10.
	MOVEI BYTE,"0(A)
	PUSHJ P,(D)
	MOVEI BYTE,"0(B)
	PUSHJ P,(D)
IFN .RPCNT-2,[
	MOVEI BYTE,":
	PUSHJ P,(D)
	POP P,A
]	;End IFN
]	;End REPEAT
	POP P,A
	POP P,D
	POPJ P,

;Setup for returning a control packet
COMCTL:	MOVE BP,[441000,,%CPKDT]
	ADD BP,PKTLOC
	SETZ BC,
	PUSH P,A
	MOVEI A,TRANID		;Get current transaction ID
	PUSHJ P,COMSTO		;This heads all replies
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	TRNN F,F.FHN            ;FILE HANDLE?
	 JRST COMCT0
	MOVE A,DATFHN(IDX)      ;YES, GET THE FILE HANDLE
	MOVEM A,FHNOUT
	MOVEI A,FHNOUT          ;AND LEAD WITH IT
	PUSHJ P,COMSTO
COMCT0:	POP P,A
	MOVEI BYTE,40
	PUSHJ P,COMCHO          ;LEADING SPACE
	JRST COMSTO             ;OUTPUT THE APPROPRIATE COMMAND AND RETURN

;Send or expect synchronous mark.  For output files, A is pointer to routine to be run
; when mark arrives.  NOTE: this routine will not work recursivly
COMSSY:
IFN ITS,[
	.SUSET [.SPICLR,,[0]]   ;To prevent timing screws, turn off all interrupts
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF		;Disable interrupts temporarily to prevent timing lossage
	DIR
]	;END IFN TNX
	MOVE T,DATSTA(IDX)
	TLO T,ST.SYN            ;Send synchronous mark
	JRST @SSYDSP(T)         ;Dispatch on current state

SSYDSP:	SSYCLO                  ;Closed
	SSYOPN                  ;Open
	SSYASY                  ;Async marked
	SSYSYN                  ;Sync marked
	SSYEOF                  ;EOF state

;Sync marked state means that the mark has arrived already.  Run the routine here and now.
; A gets replaced with the channel status
SSYSYN:	EXCH T,A                ;Meanings are reversed
	TLZ A,ST.SYN            ;No longer marked
IFN ITS,[
	.SUSET [.SDF2,,[-1]]    ;Defer all channel interrupts
	.SUSET [.SPICLR,,[-1]]  ;Reenable things like IOC et al	
]	;END IFN ITS
	PUSHJ P,(T)	        ;Call routine
	MOVEM A,DATSTA(IDX)     ;May have changed channel state
IFN TNX,[
;; Since on Tops-20 there is no way to defer only a certain set of interrupts, they
;; will all be left defered.  This is a total loss.
	MOVEI 1,.FHSLF		;Turn interrupt back on
	EIR
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	AIC			;Reenable interrupts on this channel
;	MOVEI 1,.FHSLF
;	MOVE 2,CHABIT(IDX)
	IIC			;Force interrupt on channel to start ball rolling
]	;END IFN TNX
IFN ITS,[
	.SUSET [.SDF2,,SSYDF2]  ;Restore old DF2 value
	MOVE T,CHABIT(IDX)
	TRNN IDX,1	        ;This an output idx?
	 JRST SSYSY0		;Nope, need to cause interrupt to get ball rolling
	ANDCAM T,SSYDF2		;This interrupt is no longer deffered
	.SUSET [.SDF2,,SSYDF2]
;;; NOTE: Due to the fact that some packets may be sitting in the buffers but not
;;; interrupting (if we dismissed the interrupt with packets lying around), we
;;; better cause an interrupt to let them get processed
SSYSY0:	.SUSET [.SIIFPIR,,T]
]	;END IFN ITS
	POPJ P,

;Closed or in EOF state
SSYCLO:
SSYEOF:	TRNN IDX,1		;An input channel?
	 JRST SSYAS0		;Yes, cause an interrupt to get the ball rolling
	JRST SSYOPN

;Async marked means that interrupts (for output channels) have been deffered.
SSYASY:
IFN ITS,[
	TRNN IDX,1		;This an output channel?
	 JRST SSYAS0		;Nope, so no need to undefer
	MOVE TT,CHABIT(IDX)	;Get mask bit
	ANDCAM TT,SSYDF2	;Undefer
	.SUSET [.SDF2,,SSYDF2]

SSYAS0:	MOVE TT,CHABIT(IDX)
	.SUSET [.SIIFPIR,,TT]	;Cause interrupt to happen right now
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	AIC			;Reenable interrupts on this channel
SSYAS0:	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	IIC			;Force interrupt on channel to start ball rolling
]	;END IFN TNX
;	JRST SSYOPN		;Fall into SSYOPN

;Open just needs to set bit
SSYOPN:	MOVEM T,DATSTA(IDX)
	MOVEM A,DATSYA(IDX)	;A is pointer to action to be taken upon receipt/transmission
IFN ITS,[
	.SUSET [.SPICLR,,[-1]]  ;Reenable the world
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	EIR			;Turn the interrupt system back on
]	;END IFN TNX
	POPJ P,

;;; Send the control packet that has been built in CTLPKO
COMSND:	MOVEI T,CO%TXT
COMSN1:	DPB T,[$CPKOP+CTLPKO]
	DPB BC,[$CPKNB+CTLPKO]
IFN ITS,[
	.CALL [	SETZ
		SIXBIT /PKTIOT/
		%CLIMM,,CTRLO
		%CLIMM+%CLEND,,CTLPKO]
	 .LOSE %LSSYS
	POPJ P,
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CTLJFN
	MOVEI 2,.MOPKS
	MOVEI 3,CTLPKO
	MTOPR
	 ERCAL CTLERR
IFN $$LOG,[
	SKIPN 1,TRIJFN
	  POPJ P,
	SETO 2,
	SETZ 3,
	ODTIM
	HRROI 2,[ASCIZ " ==>
"] ?	SETZ 3,
	SOUT
	LDB A,[$CPKNB CTLPKO]
	MOVE B,[441000,,CTLPKO+%CPKDT]
	PUSHJ P,PKTPRT
];$$LOG
	POPJ P,
]	;END IFN TNX

IFN ITS,[
;File name reader.  Returns in DAT???(IDX)
COMPFN:	MOVSI TT,'DSK		;Default device is DSK
	MOVEM TT,DATDEV(IDX)
	SETZM DATSNM(IDX)	;Default directory is last-used
	SETZM DATFN1(IDX)       ;No default FN1
	MOVSI TT,(SIXBIT />/)
	SKIPE STARF2
	  MOVSI TT,(SIXBIT /*/)
	MOVEM TT,DATFN2(IDX)
	TRZ F,F.FN1+F.FN2+F.DEV+F.DIR
COMPF0:	PUSHJ P,COMSYL          ;Read next sixbit frob, BYTE has terminator
	JUMPE A,COMPF1
	CAIN BYTE,":
	 JRST [ MOVEM A,DATDEV(IDX) ? TRO F,F.DEV ? JRST COMPF0 ]
	CAIN BYTE,";
	 JRST [ MOVEM A,DATSNM(IDX) ? TRO F,F.DIR ? JRST COMPF0 ]
	SKIPN DATFN1(IDX)
	 JRST [ MOVEM A,DATFN1(IDX) ? TRO F,F.FN1 ? JRST COMPF1 ]
	MOVEM A,DATFN2(IDX)
	TRO F,F.FN2
COMPF1:	CAIN BYTE,215           ;Terminate on newline
	 JRST COMEUN
	JRST COMPF0
]	;END IFN ITS

IFN TNX,[
;;Look for a full file specification
COMGJF:	MOVE 2,BP		;Source of filename
	PUSHJ P,COMEUS		;Find end of filename
	 JRST [TRZN F,F.NWL	;Must be terminated with a newline
	        JRST COMBAD
	       JRST .+2]
	  JRST .-2		;Terminated by space, so keep searching
	SETZ 1,
	DPB 1,BP		;Insure terminating NULL
COMGJG:	PUSH P,2		;Save BP in case we need to re-try something.
	MOVE 1,[GJ%SHT+.GJDEF]	;Setup flags to GTJFN
	TLNE D,ST.OUT
	 SKIPGE NOTNEW
	  TLOA 1,(GJ%OLD)	;Input or know-to-be-existing file...
	   JRST [ TLO 1,(GJ%NEW)
		  SKIPG NOTNEW
		   TLO 1,(GJ%FOU)
		  JRST .+1 ]
	TLNE D,ST.DIR
	 JRST [	TLO 1,(GJ%IFG)
		JRST COMGJ1]	;Allow wild cards for directory
	TLNE D,ST.TEM		;Temporary file?
	 TLO 1,(GJ%TMP)
COMGJ1:	TLNE D,ST.DEL		;Permit deleted file?
	 TLO 1,(GJ%DEL)
	TLNE D,ST.PON
	 JRST [	TLO 1,(GJ%OFG)
		TLZ 1,(GJ%OLD)
		JRST .+1]	;Parse only if so desired
COMGJ2:	GTJFN
	  SKIPA			;JSYS error, return it to user
	AOS -1(P)
	POP P,2			;Leave AC2 pointing to the filename...
	POPJ P,

COMGDJ:	MOVE 2,BP		;Source of filename
	PUSH P,2
	PUSHJ P,COMEUS		;Find end of filename
	 JRST [TRZN F,F.NWL	;Must be terminated with a newline
	        JRST COMBAD
	       JRST .+2]
	  JRST .-2		;Terminated by space, so keep searching
	SETZ 1,
	DPB 1,BP		;Insure terminating NULL
	MOVSI 1,(GJ%OLD\GJ%IFG)
	TLNE D,ST.DEL		;Permit deleted file?
	 TLO 1,(GJ%DEL)
	TLNE D,ST.PON		;Parse-only?
	 TLC 1,(GJ%OFG\GJ%OLD\GJ%IFG)
	HLLM 1,JFNBLK
	MOVEI 1,JFNBLK
	JRST COMGJ2
]	;END IFN TNX

;Read a syllable
COMSYL:	SETZ A,
	MOVE TT,[440600,,A]
COMSY3:	SOJL BC,COMBAD          ;If no more bytes then done
	ILDB BYTE,BP
	CAIE BYTE,^Q		;Allow ^V to quote too, for the sake of
	 CAIN BYTE,^V		;20's on which ^Q is an interrupt character.
	  SKIPA
	   JRST COMSY1		;Not quoted char
	SOJL BC,COMBAD
	ILDB BYTE,BP
	JRST COMSY2

COMSY1:	CAIE BYTE,":            ;Colon, semicolon and space and control chars end syllable
	 CAIN BYTE,";
	  JRST CPOPJ
	CAIN BYTE,215
	 JRST COMEUN
	CAIN BYTE,40		;Space ends syllable if not quoted
	 JRST CPOPJ
COMSY2:	CAIGE BYTE,40		;Control chars end syllable even if ^Q'd.
	 POPJ P,
	CAIGE BYTE,140		;Skip if "lower case"
	 SUBI BYTE,40
	TLNE TT,770000
	 IDPB BYTE,TT
	JRST COMSY3

COMOCI:	SKIPA T,[8]
;;; Decimal number reader
COMDCI:	MOVEI T,10.		;Read in BASE 10
COMNUI:	SETZ A,
COMNU0:	SOJL BC,CPOPJ
	ILDB BYTE,BP
	CAIL BYTE,"0
	 CAIL BYTE,"0(T)
	  JRST COMEUA
	IMULI A,(T)
	ADDI A,-"0(BYTE)
	JRST COMNU0

;;; Sixbit input.  Raise case of letters.  Terminate on space or non-sixbit.
COMSXI:	MOVEI T,6.		;Maximum of 6 chars
	MOVE TT,[440600,,A]	;Collect in A
	SETZ A,
COMSI0:	SOJL BC,CPOPJ		;Return if nothing more to read
	ILDB BYTE,BP
	CAIL BYTE,"a
	 CAILE BYTE,"z
	  SKIPA
	   SUBI BYTE,"a-"A
	SUBI BYTE,40		;Convert to sixbit
	JUMPLE BYTE,CPOPJ	;Return if it's a non-sixbit character or space
	CAILE BYTE,77
	 POPJ P,
	SOJL T,COMSI0		;Don't stick in if no more room
	IDPB BYTE,TT
	JRST COMSI0

;;; Date input
IFN ITS,[			;This only allows MM/DD/YY HH:MM:SS
COMDTI:	SETZ A,
	PUSHJ P,COMDT1
	DPB T,[270400,,A]	;Month 3.9-3.6
	PUSHJ P,COMDT1
	DPB T,[220500,,A]	;Day 3.5-3.1
	PUSHJ P,COMDT1
	DPB T,[330700,,A]	;Year 4.7-4.1
	CAIN BYTE,215		;If no newline, then no time
	 JRST COMEUN
	PUSHJ P,COMDT1		;Hours
	MOVE B,T
	PUSHJ P,COMDT1		;Minutes
	IMULI B,60.
	ADD B,T
	PUSHJ P,COMDT1		;Seconds
	IMULI B,60.
	ADD B,T
	LSH B,1			;Half seconds
	HRR A,B
	POPJ P,

COMDT1:	SETZ T,
COMDT2:	SOJL BC,CPOPJ
	ILDB BYTE,BP
	CAIL BYTE,"0
	 CAILE BYTE,"9
	 POPJ P,
	IMULI T,10.
	ADDI T,-"0(BYTE)
	JRST COMDT2
]	;END IFN ITS

IFN TNX,[
COMDTI:	MOVE 1,BP		;Source of date
	PUSHJ P,COMEUS		;Find end
	 JRST [TRZN F,F.NWL	;Must be terminated with a newline
	        JRST COMBAD
	       JRST .+2]
	  JRST .-2		;Terminated by space, so keep searching
	SETZ 2,
	DPB 2,BP		;Insure terminating NULL
	IDTIM
	 ERCAL JSYSER
	MOVE A,2
	POPJ P,
]	;END IFN TNX

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; For a JSYS that might get an access violation, try it, and if it
;;; fails, see if you can CONNECT no password, and if so, try the
;;; JSYS again.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

IFN 20X,[
TRYCON:	PUSH P,1	;Save arg in AC1 which might be clobbered by error.
	PUSH P,A	;Save temp
	HRRZ A,-2(P)	;Get return addr, which should be addr of JSYS
	XCT (A)
	  ERJMP [CAIN 1,DELFX1	;DELF errors (delete access required)
		  JRST CONECT
		CAIN 1,RNAMX8	;RNAMF errors (write or owner on source)
		  JRST CONECT
		CAIE 1,OPNX3	;OPENF errors (read, write, execute,
		  CAIN 1,OPNX4	;or append access required).
		    JRST CONECT
		CAIE 1,OPNX5
		  CAIN 1,OPNX6
		    JRST CONECT
		CAIN 1,CFDBX3	;CHFDB error (write or owner access)
		  JRST CONECT
		JRST CONLUZ ]	;Not an error we know.
	POP P,A		;We win.  Clean the stack,
	POP P,1
	AOS (P)		;and skip-return past the JSYS (and its
	JRST POPJ1	;trailing error jump)

CONECT:	PUSH P,2
	HRROI 1,CONFNM
	MOVEM 1,RESBLK+.ACDIR
	HRRZ 2,DATJFN(IDX)			;JFN
	MOVE 3,[.JSAOF_33.+.JSAOF_30.+JS%PAF]
	JFNS			;Get DEV:<DIRECTORY> into CONFNM
	 ERJMP CONLZ1
	SETZM RESBLK+.ACPSW	;No password ...
	SETOM RESBLK+.ACJOB	;This job.

	MOVE 1,[AC%CON+3]	;AC%CONnext to dir, 3 word arg block.
	MOVEI 2,RESBLK		;Address of block.
	ACCES
	 ERJMP CONLZ1
	SETOM CNCTED
	POP P,2			;Clean the stack...
	POP P,A			;and return to the JSYS
	POP P,1
	POPJ P,

CONLZ1:	POP P,2			;CONECT failed
CONLUZ:	AOS -2(P)		;Address of instruction after JSYS
	HLRZ A,@-2(P)
	CAIN A,(ERCAL)		;Simulate ERCAL
	 JRST [	HRRZ A,@-2(P)		
		AOS -2(P)	;Return address for ERCAL
		MOVEM A,-1(P)
		POP P,A
		POPJ P, ]
	CAIN A,(ERJMP)		;Simulate ERJMP
	 JRST [	HRRZ A,@-2(P)
		MOVEM A,-2(P)
		JRST .+1 ]
	POP P,A
	SUB P,[1,,1]		;Return error code, not saved 1
	POPJ P,

DISCON:	SKIPN CNCTED
	 POPJ P,
	SKIPN 1,CWDNUM		;If you are in an explicit CONNECT
	 MOVE 1,UDRNUM		;state, then return there, else it
	MOVEM 1,RESBLK+.ACDIR	;an implicit one, so return to home
	SETZM RESBLK+.ACPSW	;dir.
	SETOM RESBLK+.ACJOB
	MOVE 1,[AC%CON+3]
	MOVEI 2,RESBLK
	ACCES
	 ERJMP CPOPJ
	SETZM CNCTED
	POPJ P,
];20X

;;; Create a new data connection
COMDCN:	TRZN F,F.FHN            ;MUST NOT HAVE A FILE HANDLE
	 TRZE F,F.NWL           ;NEWLINE TERMINATES COMMAND?
	  JRST COMBAD           ;ILLEGAL REQUEST FORMAT
	PUSHJ P,COMRD5          ;READ THE NEXT TOKEN, WHICH SHOULD BE THE INPUT FILE HANDLE
	 JRST COMBAD
	PUSH P,A                ;SAVE ON STACK
	PUSHJ P,COMRD5          ;NEXT TOKEN AS WELL
	 TRZE F,F.NWL           ;BETTER HAVE GOTTEN TO END OF PACKET
	  JRST COMBAD           ;NOT END OF PACKET, BUT DIDN'T WANT ANY MORE CRUFT
	MOVEI IDX,MAXIDX-2      ;CHECK FOR A FREE DATA CONNECTION
COMDC2:	SKIPN DATFHN(IDX)       ;BOTH FILE HANDLE'S NULL MEANS A FREE ONE
	 SKIPE DATFHN+1(IDX)
	  JRST COMDC1           ;NOT FREE, CONTINUE SEARCHING
	MOVEM A,DATFHN+1(IDX)   ;OUTPUT FILE HANDLE
	POP P,DATFHN(IDX)       ;AND INPUT FILE HANDLE
	MOVEM A,FHNOUT          ;FILE HANDLE TO RFC TO: USE THE OUTPUT SIDE
IFN ITS,[
	.CALL [	SETZ
		SIXBIT /CHAOSO/
		%CLIN,,CHACHN+1(IDX)
		%CLIN,,CHACHN(IDX)
		%CLIMM+%CLEND,,15.]
	 JRST [	SETZM DATFHN(IDX)	;IDX's not really in use
		SETZM DATFHN+1(IDX)
		CERR NER,[Not enough Chaosnet channels]]
	MOVEI A,FHNOUT          ;POINT TO IT
	SETZ BC,
	MOVE BP,[441000,,CTLPKO+%CPKDT]
	PUSHJ P,COMSTO          ;STRING-OUT TO PACKET, POINTER TO STRING IN A
	MOVEI T,%CORFC
	DPB T,[CTLPKO+$CPKOP]   ;RFC
	DPB BC,[CTLPKO+$CPKNB]  ;NUMBER OF BYTES
	LDB T,[CTLPKI+$CPKSA]
	DPB T,[CTLPKO+$CPKDA]
	.CALL [	SETZ
		SIXBIT /PKTIOT/
		%CLIN,,CHACHN(IDX)
		%CLIMM+%CLEND,,CTLPKO]
	 .LOSE %LSSYS
	MOVE T,CHABIT(IDX)	;Get input channel bit
	IOR T,CHABIT+1(IDX)	;And output channel bit
	.SUSET [.SIMSK2,,T]	;Enable interrupts on these channels
]	;END IFN ITS
IFN TNX,[
	HRROI 1,JFNSTR		;Build output string
	HRROI 2,[ASCIZ \CHA:\]
	SETZB 3,4
	SOUT
	 ERCAL SYSBUG
	LDB 2,[CTLPKI+$CPKSA]	;Source address
	MOVEI 3,8.
	NOUT
	 ERCAL SYSBUG
	MOVEI 2,".
	IDPB 2,1
	HRROI 2,FHNOUT
	SOUT			;Now have:  CHA:<host>.<contact name>
	 ERCAL SYSBUG
	HRLZI 1,(GJ%SHT)	;Short GTJFN to get the channel
	HRROI 2,JFNSTR
	GTJFN
	 ERCAL SYSBUG
	HRRZM 1,CHAJFN(IDX)	;This is this idx's input and output JFN
	HRRZM 1,CHAJFN+1(IDX)
	MOVE 2,[100000,,OF%RD\OF%WR]
	OPENF			;Listen for connection
	 ERCAL SYSBUG
	MOVE 1,CHAJFN(IDX)	;Set input window size
	MOVEI 2,.MOSWS
	MOVEI 3,15
	MTOPR
	 ERCAL SYSBUG
	MOVE 1,CHAJFN(IDX)	;Assign interrupt channel
	MOVEI 2,.MOACN
	MOVE 3,IDX
	LSH 3,-1
	MOVE 3,CHAICN(3)	;Output,,Input channels
	MTOPR
	 ERCAL SYSBUG
	MOVEI 1,.FHSLF		;Activate the interrupt channel
	MOVE 2,CHABIT(IDX)
	AIC
	SETZM DATJFN(IDX)
	SETZM DATDSP(IDX)
]	;END IFN TNX

	MOVEI A,[ASCIZ \DATA-CONNECTION\]
	PUSHJ P,COMCTL          ;SEND RESPONSE
	PUSHJ P,COMSND          ;SEND THE CONTROL PACKET
	JRST CTLLOP             ;RETURN TO MAIN CONTROL CONNECTION WAIT

COMDC1:	SUBI IDX,2
	JUMPGE IDX,COMDC2       ;LOOP IF MORE CHANNELS TO CHECK
	CERR NER,[Not enough I/O channels]

;;; Destroys a data connection
COMUDC:	TRNE F,F.FHN            ;Must have a file handle
	 TRZE F,F.NWL           ;Not terminated by newline
	  JRST COMBAD
	JUMPGE BC,COMBAD	;But that's all there is
	TRO IDX,1               ;Point to top of two channel pair
	SKIPGE DATSTA(IDX)      ;Channel active?
	 PUSHJ P,CLOSIT		;Yes, close it
	SETZM DATSTA(IDX)	;Make sure channel is deactivated
	TRZ IDX,1               ;Now point to bottom of pair
	SKIPGE DATSTA(IDX)      ;What about this on.  Is it active?
	 PUSHJ P,CLOSIT		;Yes, close it
	SETZM DATSTA(IDX)	;Make sure channel is deactivated
	MOVEI A,[ASCIZ \UNDATA-CONNECTION\]
	PUSHJ P,COMCTL          ;Setup control packet
	PUSHJ P,CHNFLS		;Flush the chaos channels
	PUSHJ P,COMSND          ;Send it
	JRST CTLLOP             ;Return to main loop


;;; Flush chaos net channels pointed to by IDX.  IDX assumed to point
;;; to the input (even) side.
CHNFLS:
IFN ITS,[
	MOVE T,CHABIT(IDX)
	IOR T,CHABIT+1(IDX)
	.SUSET [.SAMSK2,,T]	;Turn off interrupts for the two chaos channels of interest
	.CALL [ SETZ
		SIXBIT /CLOSE/  ;Close the chaos channels
		%CLIN+%CLEND,,CHACHN(IDX)]
	 .LOSE %LSSYS
	.CALL [ SETZ
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,CHACHN+1(IDX)]
	 .LOSE %LSSYS
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	DIC			;Disable the interrupt channel
	HRRZ 1,CHAJFN(IDX)	;Close and release JFN
	CLOSF
	 JFCL
]	;END IFN TNX
	SETZM DATFHN(IDX)       ;Make this pair available for a new data connection
	SETZM DATFHN+1(IDX)
	POPJ P,

;;; LOGIN command
COMLOG:	TRZN F,F.FHN		;No file handle
	 TRZE F,F.NWL		;No newline
	  JRST COMBAD
IFN ITS,[
	PUSHJ P,COMSXI		;Read user id in sixbit
	MOVEM A,USERID		;Remember for later
	MOVEI A,[ASCIZ \LOGIN \]
	PUSHJ P,COMCTL
	SKIPE A,USERID
	 PUSHJ P,GETNAM		;Output uname, hsname and personal name
	.SUSET [.SSNAME,,HSNAME]	;Initialize default directory
	.SUSET [.SHSNAM,,HSNAME]	; and home directory
	.SUSET [.SXUNAM,,USERID]	; and user name
]	;END IFN ITS
IFN TNX,[
	SKIPN ANONUM
	  JRST [MOVSI 1,(RC%EMO)
		HRROI 2,[ASCIZ "ANONYMOUS"]
		RCUSR
		TLNE 1,(RC%NOM)
		  SETO 3,
		MOVEM 3,ANONUM		;Anonymous's user#
		JRST .+1]
	JUMPLE BC,CTLDN0	;Really logout if no arguments
	MOVE 2,BP		;Save copy of byte pointer
	PUSHJ P,COMEUS		;Eat until space, newline, or end
	JUMPL BC,COMBAD		;End of packet is no good
	SETZ T,			;Deposit null to terminate string
	DPB T,BP
IFN OZ,[
	Push P,2
	Skipn GOTINQ		;Inquire database here?
	  Jrst [Movei A,IPAGE	;No, so map it in now.
		Pushj P,HAKINQ"MAPIN
		  Jrst BADINQ
		Setom GOTINQ
		Move A,(P)
		Jrst .+2]
	Move A,2
	Pushj P,HAKINQ"XLATE	;Lookup and turn into user#
	  Jrst BADINQ
	Movem A,INQADR		;Save address of inquire entry
	Movem B,USRNUM		;and user#
	Pop P,2
	Jrst COMLCC

BADINQ:	Setzm INQADR		;0 means we have no Inquire information.
	Pop P,2
];OZ Inquire login
	MOVSI 1,(RC%EMO)	;Exact match
	RCUSR
	 ERJMP .+2
	TLNE 1,(RC%NOM)		;Matched?
	 CERR UNK,[User not known]
	MOVEM 3,USRNUM		;Save user number
COMLCC:
IFN 20X,[
IFN $$CCUC,[			;and then only if turned on at assembly time
	MOVEI 1,.FHSLF		;Must enable for GTDIR
	RPCAP
	MOVE 3,2
	EPCAP
	MOVEI 1,0
	MOVE 2,USRNUM
	RCDIR			;Get dir number
	MOVE 1,3
	MOVEI 2,DIRINF		;Discover user's capabilities
	MOVEI 3,0
	SETZM DIRINF
	GTDIR
	 ERCAL SYSBUG
	MOVEI 1,.SFCHA		;See if Chaosnet checking is on
	TMON
	 ERJMP COMLG1		;Not even implemented - skip check
	JUMPE 2,COMLG1		;It's off - skip the check
	MOVE 1,DIRINF+.CDPRV	;Check for Chaos net privilege
	TRNN 1,SC%CHA
	 CERR LIP,[No Chaosnet privileges]
COMLG1:
]	;END IFN $$CCUC
]	;END IFN 20X
	PUSHJ P,ANONPW
	 JRST COMLGP		;Need a password, rats.
	HRROI 2,JFNSTR
	SETZB 3,T		;No account given
	JRST COMLG4

COMLGP:	MOVE 1,USRNUM		;Recover your old usernumber.
	MOVE 2,BP		;Beginning of password string	
	ILDB 3,2		;Get and save first char
	TRZ F,F.ENA
	CAIN 3,"*		;Is first letter * ?
	 TROA F,F.ENA		;Enable
	  SKIPA 2,BP		;Remember unbumped version
	   MOVE BP,2		;Update BP to skip *
IFN 10X, MOVE 3,BP		;Keep a copy to do uppercasing
	PUSHJ P,COMEUS		;Find next terminating character
	 JFCL
IFN 10X,[			;Tenex LOGIN expects uppercase?
COMLGU:	CAMN 3,BP		;Until end of this string
	 JRST COMLG0
	ILDB T,3		;Get a character of the password
	CAIL T,"a		;and force it to be uppercase
	 CAILE T,"z
	  CAIA
	    SUBI T,40
	DPB T,3			;Store back the uppercased char
	JRST COMLGU
COMLG0:
];END IFN 10X
	SETZ T,
	DPB T,BP		;Terminate password with null byte
	MOVE 3,BP		;This is account string
	PUSHJ P,COMEUS		;Then find end of string
	 JUMPGE BC,COMBAD
	SETZ T,
	DPB T,BP		;Terminate with null byte
	IDPB T,BP		;In case no acct string given
	MOVE T,3
	ILDB T,T
IFN 20X,[
	SKIPN T
	 SETZ 3,		;Use default if empty string
];20X
COMLG4:
IFN 10X,[
	JUMPN T,COMLG3
	PUSH P,2		;Save password string
	MOVEI 1,DIRINF		;Where to put account designator if string
	MOVE 2,USRNUM
	GDACC
	 SETZ 1,		;Doesn't seem to have a default, will get error
	MOVE 3,1		;Number or byte pointer
	POP P,2			;Get back password
COMLG3:	MOVE 1,USRNUM
];10X
	SKIPGE DEBUG
	 JRST [ PUSHJ P,$HELLO	;If debugging, don't do real login, or enable
		JRST COMLG2]
	PUSHJ P,$LOGIN
	 PUSHJ P,JSYSER
IFN OZ,[			;This doesn't do what we want, alas.
IFN 0,[
	TRNE F,F.LSP
	  JRST [MOVEI 1,.FHSLF	;((IFF LISPMACHINE)) --
		RPCAP		;Now that you're logged in, read your
		MOVE 3,2	;capabilities, and limit yourself to
		EPCAP		;them.
		JRST .+1]
];IFN 0
];OZ
COMLG2:	MOVEI A,[ASCIZ \LOGIN \]	;Success reply
	PUSHJ P,COMCTL
	PUSHJ P,GETNAM
]	;END IFN TNX
	PUSHJ P,COMSND		;Completion reply
	JRST CTLLOP		;Then we are done

;;; Auto-login (as Q.SITE or failing that, ANONYMOUS)
;;; This was not thought out.  It needs to be redone.

IFN OZ,[
AUTLOG:	CERR NLI,[Not logged in]
IFN 0,[
AUTLOG:	PUSHJ P,SITEPW		;try to login as <Q.hostname>
	  JRST ANNLOG		;Urg, no password file.
	HRROI 2,JFNSTR
	PUSHJ P,$LOGIN
	  SKIPA			;double urg, it's WRONG!!
	POPJ P,		;ahhh...

ANNLOG:	SETZM USRNUM
	PUSHJ P,ANONPW	;Can we can login as Anonymous w/o Password?
	  CERR NLI,[Can't defaultly log you in - no password file]
	HRROI 2,JFNSTR
	PUSHJ P,$LOGIN		;Login then,
	  CERR NLI,[Can't defaultly log you in - incorrect password file]
];IFN 0
	POPJ P,
];OZ

IFN TNX,[
;;; Log you in as user#(USERNUM), and turn on what privs you have (or else
;;; leave them all on - See the F.ENA flag in F) - Also, set USERID to
;;; reflect loggedinness.  Set subsystem name to "FILE".

$LOGIN:	LOGIN		;Login with specified parameters
	 POPJ P,	; LOSSAGE
	AOS (P)		;Will take success return
	GJINF		;Directory# in AC2
	MOVEM 1,USRNUM
	MOVEM 2,UDRNUM
	TRZN F,F.ENA	;If you want to be priv, don't limit
	 JRST $HELLO	; yourself, but keep full privs.
	MOVEI 1,.FHSLF
	RPCAP
	MOVE 3,2
	EPCAP		;Enable what capabilities you have.
$HELLO:	SETOM USERID		;Means we are logged in
;Now attempt to access all structures
IFN 20X,[
	PUSH P,C
	PUSH P,D
	MOVE 1,[SIXBIT /DEVNAM/]
	SYSGT
	HRRZ D,2		;Table#
	MOVEI C,1		;Should be 1st device name.
ACCST1:	HRLZ 1,C
	HRR 1,D			;Offset,,table#
	GETAB
	  JFCL
;;[UTexas] The following won't work if # of strs is maximum allowed by monitor
;;	HLRZ 2,1		;If no more devices, it's SIXBIT/STRnnn/
;;	CAIN 2,(SIXBIT /STR/)
;;	 JRST ACCST9
	MOVE 3,[440700,,DIRINF]
ACCST2:	SETZ 2,			;Turn sixbit structure name into asciz
	ROTC 1,6		;string.
	ADDI 2,40
	IDPB 2,3
	JUMPN 1,ACCST2
	MOVEI 1,":
	IDPB 1,3
	MOVEI 1,"<
	IDPB 1,3
	MOVE 1,3		;Set directory name from our user name
	MOVE 2,USRNUM
	DIRST
	 ERJMP ACCST9
	MOVEI 3,">
	IDPB 3,1		;Terminate user directory
	SETZ 3,			;Null to terminate string
	IDPB 3,1
;;Start of UTexas change
	PUSH P,1		;Save BP
	HRROI 1,DIRINF		;Set up to get device designator
	STDEV
	  ERJMP [POP P,1
	         JRST ACCST9]
	MOVE 1,2		;Set up device designator
	DVCHR			;Check device type
	  ERJMP [POP P,1
		 JRST ACCST9]
	POP P,1			;Restore BP
	LDB 3,[221100,,2]	;Get DV%TYP
	CAIE 3,.DVDSK		;Is it a disk?
	  JRST ACCST9		;No, done
;;End of UTexas changes
	HRRZ 2,1		;Get argument block after dir name
	ADDI 2,1		;First unused word after dir that is
	MOVE 1,[440700,,DIRINF] ;Directory name string
	MOVEM 1,0(2)		;Store as first word of arg block
	SETZM 1(2)		;No password supplied
	SETOM 2(2)		;And for this job
	MOVE 1,[200000,,3]	;Setup for ACCES call
	ACCES			;Attempt the Access
	 ERJMP .+1		;So what if it fails
ACCST8:	AOJA C,ACCST1		;Step to next structure.
ACCST9:	POP P,D
	POP P,C

IFN $$LNM,[			;Maybe Process LOGICALS.CMD
lnm:	move 2,USRNUM
	hrli 2,540000		;Make into directory #
	hrroi 1,strbuf
	DIRST
	  erjmp lnm11
	move 2,[440700,,[asciz/LOGICALS.CMD/]]
	ildb 3,2
	idpb 3,1
	jumpn 3,.-2
	hrroi 2,strbuf
	movsi 1,(gj%sht\gj%old)
	GTJFN
	  erjmp lnm11
	hrlm 1,cmdblk+.CMIOJ
	move 2,[.dpb 7,.bp of%bsz,of%rd]
	OPENF
	  erjmp [hlrz 1,cmdblk+.CMIOJ
		 RLJFN
		   erjmp lnm11
		 jrst lnm11]
lnm1:	movei 1,strbsz
	movem 1,cmdblk+.CMABC
	move 1,[440700,,atmbuf]
	movem 1,cmdblk+.CMABP
	movei 1,cmdblk
	movei 2,[.cmini_9,,0 ? 0 ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	movei 2,[.cmkey_9,,0 ? [1,,1 ? [asciz/DEFINE/],,0] ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	tlne 1,(cm%nop)
	  jrst lnm1
	;Some people like to put in the noise words in the command file
	movei 2,[.cmnoi_9,,0 ? 440700,,[asciz/logical name/] ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	tlne 1,(cm%nop)
	  jrst lnm1
	movei 2,[<(cm%po)\.cmdev_9>,,[.cmtok_9,,0 ? 440700,,[asciz/*/] ? 0 ? 0 ? 0]
		 0 ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	tlne 1,(cm%nop)
	  jrst lnm1
	hlrz 3,(3)
	movei 4,.CLNJA		;"def *" means delete all logical names
	cain 3,.cmtok_9
	   jrst lnm4		;Yup
	move 3,cmdblk+.CMABC	;Else find end of the device name
	move 4,cmdblk+.CMABP
	ildb 2,4
	soj 3,
	jumpn 2,.-2
	movem 3,cmdblk+.CMABC	;Will put equivalent name after the device
	movem 4,cmdblk+.CMABP
	movei 2,[.cmnoi_9,,0 ? 440700,,[asciz/as/] ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	tlne 1,(cm%nop)
	  jrst lnm1
	movei 2,[.cmcfm_9,,[.cmtxt_9,,0 ? 0 ? 0 ? 0 ? 0] ? 0 ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	tlne 1,(cm%nop)
	  jrst lnm1
	hlrz 3,(3)
	movei 4,.CLNJ1		;"def name:<cr>" means just delete the name
	cain 3,.cmcfm_9
	  jrst lnm5		;Yup
	movei 4,.CLNJB		;Else have a name to define
lnm4:	movei 2,[.cmcfm_9,,0 ? 0 ? 0 ? 0 ? 0]
	COMND
	  erjmp lnm10
	tlne 1,(cm%nop)
	  jrst lnm1
lnm5:	move 1,4
	move 2,[440700,,atmbuf]
	move 3,cmdblk+.CMABP
	CRLNM
	  erjmp .+1
	jrst lnm1

lnm10:	hlrz 1,cmdblk+.CMIOJ
	CLOSF
	  erjmp lnm11
lnm11:
];$$LNM
];20X
	POPJ P,
];TNX

;;; HOMEDIR command

COMHOM:	TRZN F,F.FHN		;No file handle
	 TRZE F,F.NWL		;No newline
	  JRST COMBAD
IFN ITS,[
	PUSHJ P,COMSXI		;Read user id in sixbit
	PUSH P,A		;Save uname
	PUSHJ P,GETINQ		;Get inquir entry address in B
	 SETZ B,		;Not found
	POP P,A
	SETZ C,			;Now find HSNAME for local host.
	MOVEI D,ERRCH
	PUSHJ P,LSRTNS"LSRHSN	;D gets the sixbit HSNAME.
	 JFCL
	MOVEI A,[ASCIZ \HOMEDIR \]
	PUSHJ P,COMCTL
	MOVE A,D		;HSNAMEP
	PUSHJ P,COMSXO
	MOVEI BYTE,";
	PUSHJ P,COMCHO
	PUSHJ P,UNGINQ
	PUSHJ P,COMSND
	JRST CTLLOP
];ITS
IFN TNX,[
	MOVE 2,BP		;BP to start of user name
	PUSHJ P,COMEUS		;Eat until space, newline, or end
	SKIPGE BC
	 IBP BP			;No delimiter
	SETZ T,			;Deposit null to terminate string
	DPB T,BP
IFE OZ,[
	MOVSI 1,(RC%EMO)	;Exact match
	RCUSR
	 ERCAL SYSBUG		;Monitor internal errors I guess
	TLNE 1,(RC%NOM)		;Matched?
	 CERR UNK,[User not known]
	PUSH P,3		;Save user number
	MOVEI A,[ASCIZ \HOMEDIR \]	;Always succeeds if we get here
	PUSHJ P,COMCTL
	MOVSI 1,(GJ%OLD\GJ%SHT)
IFN 20X,HRROI 2,[ASCIZ /SYS:PEOPLE.DATA/]
IFN 10X,HRROI 2,[ASCIZ /<INQUIR>PEOPLE.DATA/]
	PUSH P,[0]
	GTJFN
	 JRST COMHM3
	MOVEM 1,(P)		;Save jfn
	MOVE 2,[440000,,OF%RD]
	OPENF
	 JRST COMHM3
	HRRZ 3,-1(P)		;User number
	RIN
	JUMPE 2,COMHM3		;No information on this user
	HLRZ 3,2
	HRRZS 2
	SFPTR
	 JRST COMHM3
	CAILE 3,INQBLL
	 MOVEI 3,INQBLL
	MOVN 3,3
	MOVE 2,[444400,,INQBLK]
	SIN			;Get all data on the person
	MOVE A,[440600,,INQBLK+1]	;Byte counts
	MOVE B,[440700,,INQBLK+4]	;String starts
	SETZ C,				;Current field.
	MOVEI T,$DNAME
	PUSHJ P,GETFLD		;Output directory name followed by a CR
COMHM2:	SKIPE 1,(P)		;Release inquir file
	 CLOSF
	  JFCL
	PUSHJ P,COMSND
	JRST CTLLOP

COMHM3:	HRROI 1,RESBLK		;No inquir entry, default to user's name
	MOVE 2,-1(P)		;User number
IFN 20X,TLO 2,40000
	DIRST
	 JFCL
	PUSHJ P,COMRES
	JRST COMHM2
];Regular TOPS-20
IFN OZ,[
	Push P,2		;Save copy of BP
	Skipn GOTINQ		;Inquire database here?
	  Jrst [Movei A,IPAGE	;No, so map it in now.
		Pushj P,HAKINQ"MAPIN
		  Jrst NoSUsr
		Setom GOTINQ
		Jrst .+1]
	Move A,(P)
	Pushj P,HAKINQ"XLATE	;Lookup and turn into user#
	  Jrst NoSUsr
	Move 3,B
	Adjsp P,-1
	Jrst UserNo

NoSUsr:	Movsi 1,(RC%EMO)
	Pop P,2
	RCUSR
	  Erjmp .+2
	Tlne 1,(RC%NOM)
	  CERR UNK,[User not known]
UserNo:	Hrroi 1,RESBLK
	Move 2,3
	Hrli 2,540000		;PS: LH
	DIRST
	  Nop
	Movei A,[Asciz "HOMEDIR "]
	Pushj P,COMCTL
	Pushj P,COMRES
	Pushj P,COMSND
	Pushj P,CLOINQ
	Jrst CTLLOP
];OZ HOMEDIR from new Inquire
];TNX

IFN ITS,[
;;; INQUIR hacking
$$ULNM==0
$$ULNP==0
$$UNAM==0
$$HSNM==1

LSRTNS"E==T
LSRPGS==200			;Pages for LSRTNS hacking
NLSPGS==20			;Reserve 20 of them

.INSRT SYSENG;LSRTNS >

;;; Output UNAME<SP>HSNAME<NL>PERNAM<NL>GROUP
GETNAM:	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,A
	PUSHJ P,GETINQ
	  JRST [SETZ B,		;No entry there
		MOVE A,(P)	;UNAME
		PUSH P,B
		PUSHJ P,COMSXO
		JRST GETNM1]	;And go compute HSNAME.
	MOVE A,(P)		;UNAME in A, core addr still in B.
	PUSH P,B		;Save INQUIRE entry address
	PUSHJ P,COMSXO		;Output UNAME.
GETNM1:	MOVEI BYTE,40
	PUSHJ P,COMCHO		;SP.
	MOVE A,-1(P)		;Username
	MOVE B,(P)		;INQUIR entry
	SETZ C,			;Now find HSNAME for local host.
	MOVEI D,ERRCH
	PUSHJ P,LSRTNS"LSRHSN	;D gets the sixbit HSNAME.
	 JFCL
	MOVE A,D		;Get answer.
	MOVEM A,HSNAME
	PUSHJ P,COMSXO		;Output HSNAME or nothing.
	MOVEI BYTE,215
	PUSHJ P,COMCHO		;NL.
	MOVEI A,LSRTNS"I$NAME
	MOVE B,(P)		;INQUIRE entry
	PUSHJ P,LSRTNS"LSRITM	;Get personal name.
	 JRST [	MOVE A,[440700,,[ASCIZ /???/]]
		JRST .+1 ]
	PUSHJ P,COMST0		;Output PERNAM or nothing. 
	MOVEI BYTE,215
	PUSHJ P,COMCHO		;NL
	MOVEI A,LSRTNS"I$GRP
	POP P,B			;INQUIRE entry
	PUSHJ P,LSRTNS"LSRITM	;Get Group affiliation.
	 JRST [	MOVE A,[440700,,[ASCIZ /-/]]
		JRST .+1 ]
	PUSHJ P,COMST0		;Output GROUP.
UNMAPL:	PUSHJ P,UNGINQ
	POP P,A
	POP P,D
	POP P,C
	POP P,B
	POPJ P,

;Get INQUIR entry for uname on the stack, and skip return with inquir entry address in B
GETINQ:	MOVEI A,UTILCH		;Channel for LSRTNS
	MOVE B,[-NLSPGS,,LSRPGS]
	PUSHJ P,LSRTNS"LSRMAP
	 JRST [CERR NER,[Cannot map INQUIR database]]	;Random error
	MOVEI A,UTILCH		;Channels for INQUIR database
	MOVE B,-1(P)		;B gets sixbit UNAME.
	JRST LSRTNS"LSRUNM	;Map in the LSRTNS entry

;Flush inquir data base
UNGINQ:	MOVE B,[-NLSPGS,,LSRPGS]
	.CALL [	SETZ		;Done with these
		SIXBIT /CORBLK/
		%CLIMM,,0
	       	%CLIMM,,%JSELF
		SETZ B]
	 JFCL
	.CLOSE UTILCH,
	.CLOSE ERRCH,
	POPJ P,
]	;END IFN ITS

IFN TNX,[
;;; INQUIR hacking
;;; Output USERNAME<SP>DIRECTORY<NL>PERSONAL NAME<NL>GROUP

IFE OZ,[
$DNAME==0
$HNAME==1
$GROUP==14

GETNAM:	HRROI 1,RESBLK
	MOVE 2,USRNUM
	DIRST
	 JFCL
	MOVEI 2,0
	IDPB 2,1
	PUSHJ P,COMRES		;Output user name
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	MOVSI 1,(GJ%OLD\GJ%SHT)
IFN 20X,HRROI 2,[ASCIZ /SYS:PEOPLE.DATA/]
IFN 10X,HRROI 2,[ASCIZ /<INQUIR>PEOPLE.DATA/]
	PUSH P,[0]
	GTJFN
	 JRST GETNM3
	MOVEM 1,(P)		;Save jfn
	MOVE 2,[440000,,OF%RD]
	OPENF
	 JRST GETNM3
	HRRZ 3,USRNUM
	RIN
	JUMPE 2,GETNM3		;No information on this user
	HLRZ 3,2
	HRRZS 2
	SFPTR
	 JRST GETNM3
	CAILE 3,INQBLL
	 MOVEI 3,INQBLL
	MOVN 3,3
	MOVE 2,[444400,,INQBLK]
	SIN				;Get all data on the person
	MOVE A,[440600,,INQBLK+1]	;Byte counts
	MOVE B,[440700,,INQBLK+4]	;String starts
	SETZ C,				;Current field.
	MOVEI T,$DNAME
	PUSHJ P,GETFLD
	MOVEI T,$HNAME
	PUSHJ P,GETFLD
IFN OZ,[	;Only OZ has groups, but OZ doesn't use this code anymore
	MOVEI T,$GROUP
	PUSHJ P,GETFLD
];OZ
GETNM2:	POP P,1
	JUMPE 1,CPOPJ
	CLOSF
	 JFCL
	POPJ P,

GETFLD:	CAMN C,T
	  JRST GETFL1
	ILDB 1,A
GETFL0:	SKIPG 1
	  AOJA C,GETFLD
	ILDB 2,B
	SOJA 1,GETFL0


GETFL1:	ILDB T,A
GETFL2:	SKIPG T
	  AOJA C,GETFL3
	ILDB BYTE,B
	PUSHJ P,COMCHO
	SOJA T,GETFL2

GETFL3:	MOVEI BYTE,215
	JRST COMCHO
];Non-OZ TOPS-20 Inquire lookup stuff

IFN OZ,[
GETNAM:	Skipn INQADR		;We have Inquire information?
	  Jrst GETNM3		;  Nope.
IFN 0,[
	Move A,INQADR		;Address of start of entry
	ADD A,HAKINQ"SRDAT	;point to data portion
repeat hakinq"%uname,[		;Find uname
	ildb 1,A
	jumpn 1,.-1
	]
	Pushj P,COMSTO
]
.ELSE [
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	Hrroi 1,RESBLK		;**	Flush
	Move 2,USRNUM		;**	this
	DIRST			;**	when
	  Nop			;**	LMs
	Pushj P,COMRES		;**	no
	Move A,INQADR		;**	longer
	Add A,HAKINQ"SRDAT	;**	compare
repeat hakinq"%dname,[		;**	usernames
	Ildb 1,A		;**
	Jumpn 1,.-1		;**
       ]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
]
	Movei Byte,40
	Pushj P,COMCHO
	Pushj P,COMST0		;(cheat, 'cause directory's next)
	Movei Byte,215
	Pushj P,COMCHO
	Move B,A		;Yet MORE cheating, 'cause personal-name
	Hrroi A,RESBLK		;comes next
	Pushj P,HAKINQ"NPNAME	;(translate into human form)
	  Jfcl
	Pushj P,COMRES		;Output from RESBLK
	Movei Byte,215
	Pushj P,COMCHO
	Movei 2,HAKINQ"%GROUP-HAKINQ"%PNAME ;Number of fields we need to skip
	Sojl 2,COMLGG
	Ildb 1,B
	Jumpn 1,.-1
	Jrst .-3

COMLGG:	Ildb Byte,B		;First character of group.
	Skipe Byte		;No group?
	  Pushj P,COMCHO	;  Yes, so output character.
	Movei Byte,215
	Pushj P,COMCHO		;then all done.

CLOINQ:	Skipn GOTINQ		;If have Inquire database open
	  Popj P,		;  (we don't)
	Call HAKINQ"MAPOUT	;then unmap
	  Skipa			;  (failed??)
	    Setzm GOTINQ	;    and mark as disposed of.
	Popj P,
];OZ Inquire lookup.

;;; No INQUIR information
GETNM3:
IFN OZ,[	;OZ forgot to send this already
	HRROI 1,RESBLK		;User name
	MOVE 2,USRNUM
	DIRST
	 JFCL
	PUSHJ P,COMRES
	MOVEI BYTE,40
	PUSHJ P,COMCHO
];OZ
	HRROI 1,RESBLK		;Directory name
	MOVE 2,USRNUM
IFN 20X,TLO 2,40000
	DIRST
	 JFCL
	PUSHJ P,COMRES
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	MOVEI A,[ASCIZ /???/]
	PUSHJ P,COMSTO
	MOVEI BYTE,215
	PUSHJ P,COMCHO
IFE OZ,	JRST GETNM2
IFN OZ,	Jrst CLOINQ


;;; Before auto-logging as ANONYMOUS, try to login as Q.yourhostname,
;;; which is easier to track.  The password is in <Q>yourhostname.PASSWORD.

IFN OZ,[
IFN 0,[
SITEPW:	SKIPE KLOGIN
	 JRST SITEP2
	HRROI 1,KLOGIN
	HRROI 2,[ASCIZ /Q./]
	SETZ 3,
	SOUT
	HRROI 2,KSITE
	SOUT			;Q.hostname in KSITE
SITEP2:	MOVSI 1,(RC%EMO)
	HRROI 2,KLOGIN
	RCUSR
	 ERJMP CPOPJ		;make sure it exists.
	TLNE 1,(RC%NOM)
	 POPJ P,		; nope.  oh well...
	MOVEM 3,USRNUM
	SKIPE KPASSF
	 JRST SITEP3
	HRROI 1,KPASSF
	HRROI 2,[ASCIZ /PS:<Q>/]
	SETZ 3,
	SOUT
	HRROI 2,KSITE
	SOUT
	HRROI 2,[ASCIZ /.PASSWORD/]
	SOUT
SITEP3:	HRROI 2,KPASSF
	JRST GETPSW
];IFN 0
];OZ

;;; Check out the possibilities of an Anonymous login.  If the file seen
;;; below exists, then it contains the password for the Anon account.  We
;;; skip-return with password in JFNSTR if we find it, else non-skip. The
;;; user# is stored in USRNUM.

ANONPW:	MOVE 1,ANONUM
	CAMN 1,[-1]
	  POPJ P,
	SKIPE USRNUM	;If logging in normally, (we already got the USRNUM
	 CAMN 1,USRNUM	;just return, unless want to be "Anonymous".
	  SKIPA
	   POPJ P,
	MOVEM 1,USRNUM
IFN 20X,HRROI 2,[ASCIZ /SYSTEM:ANONYMOUS.USERFILE/]
.ELSE	HRROI 2,[ASCIZ /<SYSTEM>ANONYMOUS.USERFILE/]
GETPSW:	MOVSI 1,(GJ%OLD\GJ%SHT)
	GTJFN
	 POPJ P,	;File not there - Must specify password.
	PUSH P,1	;Save JFN
	MOVE 2,[070000,,OF%RD]
	OPENF
	 JRST [	POP P,1		;Clean stack,
		RLJFN		;release JFN,
		 JFCL
		POPJ P, ]	;and fail-return
	MOVE 3,[440700,,JFNSTR]
	MOVEI 4,39.
COMLA1:	BIN
	 ERJMP COMLA2
	CAIG 2,40
	 JRST COMLA2
	IDPB 2,3
	SOJG 4,COMLA1
COMLA2:	SETZ 2,
	IDPB 2,3	;Make the password string ASCIZ
	POP P,1		;Get back JFN,
	CLOSF		;and close the Anonymous userfile.
	 JFCL
	MOVE 1,USRNUM
	JRST POPJ1	;Skip-return -> We win, have Anonymous's password.
];IFN TNX

;;; Open a file
COMOPN:	SKIPN USERID		;Has the user logged in?
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	TRZ F,F.PRB\F.DEF\F.PDR
	TLZ F,(F.CRE\F.SUP\F.APP\F.OVW\F.NEW\F.REN\F.RND\F.TRU)
	TRNN F,F.FHN            ;MUST HAVE A FILE HANDLE FOR NORMAL OPEN
	 JRST OPNPRB            ;ELSE MUST BE A PROBE
	SKIPGE DATSTA(IDX)      ;THIS CHANNEL CURRENTLY ACTIVE?
	 PUSHJ P,CLOSIT		;YES, CLOSE IT
IFN TNX,[
	PUSHJ P,RELDJF		;Dispose of any left-over JFNs this channel is holding
	PUSHJ P,RELRJF		;if it err'ed out of a previous open
];TNX
OPNPR0:	SETZB D,DATSTA(IDX)     ;START OUT FRESH, D WILL CONTAIN NEW LH OF DATSTA
	MOVEI T,16.             ;DEFAULT DATBYT
	MOVEM T,DATBYT(IDX)
	MOVEI T,2.		;NUMBER OF BYTES PER WORD
	MOVEM T,DATBPW(IDX)
IFN TNX,[
	MOVEI T,36.		;Default file byte size
	MOVEM T,DATFBS(IDX)
];TNX
	SETZM DATRCV(IDX)	;Start at zero bytes received.
OPNOPT:	TRNE F,F.NWL            ;NEW LINE TERMINATED OPEN COMMAND?
	 JRST OPNFNM            ;YES, DEFAULT OPTIONS, PARSE FILENAME
	PUSHJ P,COMR10          ;GET NEXT TOKEN INTO A,B
	 JUMPL BC,COMBAD
OPNOLP:	MOVSI T,-OPNLEN		;LENGTH OF OPEN OPTION TABLE
OPNOL1:	CAMN A,OPNTAB(T)        ;MATCH?
	 CAME B,OPNTAB+1(T)
	  AOBJN T,[AOJA T,OPNOL1]
	JUMPGE T,[CERR UUO,[Unknown OPEN option]]
	HRRZS T
	LSH T,-1
	XCT OPNACT(T)           ;PERFORM APPROPRIATE ACTION
	 JRST COMBAD            ;ERROR
	JRST OPNOPT

OPNTAB:	ASCII \READ\ ? 0	;Read
	ASCII \WRITE\ ? 0	;Write
	ASCII \PROBE\ ? 0	;Probe
	ASCII \CHARACTER\	;Character mode
	ASCII \BINARY\		;Binary mode
	ASCII \DEFAULT\		;Default mode
	ASCII \BYTE-SIZE\	;Byte size specification
	ASCII \RAW\ ? 0		;Raw mode (the bytes as they come)
	ASCII \SUPER-IMAG\	;Super-image -- don't treat rubouts specially
	ASCII \SUPER\ ? 0	;Documented as SUPER-IMAGE but some people send SUPER
	ASCII \PRESERVE-D\	;Preserve-dates
	ASCII \INHIBIT-LI\	;Inhibit-links (ignored except on ITS)
	ASCII \DELETED\		;Deleted files are ok (ignored on ITS)
IFN TNX,[
	ASCII \TEMPORARY\	;Temporary file
	ASCII \FILE-BYTE-\	;file-byte-size
IFN $$SUBM,[
	ASCII \SUBMIT\
];$$SUBM
]	;END IFN TNX
	ASCII \ESTIMATED-\	;estimated-length
	ASCII \PROBE-DIRE\	;probe-directory
	ASCII \IF-EXISTS\
	ASCII \IF-DOES-NO\	;if-does-not-exist
OPNLEN==<.-OPNTAB>/2

OPNACT:	TRNE IDX,1
	TRNN IDX,1
	TROA F,F.PRB
	TLZA D,ST.BIN
	TLOA D,ST.BIN
	JRST [	TRO F,F.DEF
		TLO D,ST.BIN
		JRST OPNOPT]
	JRST OPNBYS
	TLOA D,ST.RAW
	TLOA D,ST.SUI
	TLOA D,ST.SUI
	TLOA D,ST.PDT
	TLOA D,ST.INL
	TLOA D,ST.DEL
IFN TNX,[
	TLOA D,ST.TEM
	JRST OPNFBS
IFN $$SUBM,[
	JRST OPNSUB
];$$SUBM
]	;END IFN TNX
	JRST OPNELN
	TROA F,F.PDR
	JRST OPNIFE
	JRST OPNIDN
IFN <.-OPNACT>-OPNLEN, .ERR OPNTAB and OPNACT not same length

OPNBYS:	TRNE F,F.NWL            ;BETTER NOT HAVE A NEWLINE
	 JRST COMBAD
	PUSHJ P,COMDCI          ;READ A NUMBER FROM THE STREAM
	 JUMPL BC,COMBAD        ;MUST HAVE STUFF LEFT
	SKIPLE A                ;BYTE-SIZE MUST BE BETWEEN 0 AND 16.
	 CAILE A,16.
	  CERR IBS,[Illegal byte size]
	MOVEM A,DATBYT(IDX)     ;SAVE THE BYTE SIZE
ifn tnx,[
	MOVEM A,DATFBS(IDX)	;Save here too
]
	MOVE B,A
	MOVEI A,36.
	IDIV A,B
	MOVEM A,DATBPW(IDX)	;REMEMBER BYTES PER WORD
	JRST OPNOPT             ;AND CONTINUE

IFN TNX,[
OPNFBS:	TRNN IDX,1
	 JRST COMBAD
	TRNE F,F.NWL
	 JRST COMBAD
	PUSHJ P,COMDCI
	 JUMPL BC,COMBAD
	SKIPLE A		;File byte size must be between 1 and 36.
	 CAILE A,36.
	  CERR IBS,[Illegal file byte size]
	MOVEM A,DATFBS(IDX)	;Save it
	JRST OPNOPT		;and continue
];TNX

OPNELN:	TRNE F,F.NWL            ;BETTER NOT HAVE A NEWLINE
	 JRST COMBAD
	PUSHJ P,COMDCI          ;READ A NUMBER FROM THE STREAM
	 JUMPL BC,COMBAD        ;MUST HAVE STUFF LEFT
	JRST OPNOPT		;Ignore the estimated length and continue

OPNIFE:	TRNE F,F.NWL            ;Better not have a newline
	 JRST COMBAD
	PUSHJ P,COMR10		;Get IF-EXISTS mode into A and B
	 JUMPL BC,COMBAD
	MOVSI T,-IFETBL
OPNIF1:	CAMN A,IFETAB(T)
	 CAME B,IFETAB+1(T)
	  JRST [ ADDI T,2
		 AOBJN T,OPNIF1
		 CERR UUO,[Unknown IF-EXISTS option] ]
	IOR F,IFETAB+2(T)
	JRST OPNOPT

IFN TNX,[
IFN $$SUBMIT,[
OPNSUB:	MOVE A,USRNUM
	CAMN A,ANONUM
	  CERR UUO,[Can't SUBMIT when logged in as Anonymous]
	TLO D,ST.SUB
	JRST OPNOPT
];$$SUBMIT
];IFN TNX

IFETAB:	ASCII /SUPERSEDE/  ? F.SUP
IFN TNX,[	;not implemented for ITS yet
	ASCII /APPEND/	   ? F.APP
	ASCII /OVERWRITE/  ? F.OVW
	ASCII /TRUNCATE/   ? F.TRU
	ASCII /RENAME/     ? F.REN
	ASCII /RENAME-AND/ ? F.RND	;RENAME-AND-DELETE
	ASCII /ERROR/ ? 0  ? F.NEW
];TNX
IFETBL==<.-IFETAB>/3

OPNIDN:	TRNE F,F.NWL            ;Better not have a newline
	 JRST COMBAD
	PUSHJ P,COMRD5		;Get IF-DOES-NOT-EXIST mode into A
	 JUMPL BC,COMBAD
	CAMN A,[ASCII/ERROR/]
	 JRST OPNOPT		;ERROR is the default
IFN TNX,[	;not implemented for ITS yet
	CAME A,[ASCII/CREAT/]
];TNX
	 JRST [	CERR UUO,[Unknown IF-DOES-NOT-EXIST option] ]
	TLO F,(F.CRE)
	JRST OPNOPT

OPNPRB:	MOVEI IDX,MAXIDX        ;SPECIAL PROBE INDEX
	TRO F,F.PRB             ;DOING A PROBE
	TRNN F,F.NWL            ;IF NO OPTIONS, THAT'S OK
	 JRST OPNPR0		;Now process options
OPNFNM:	HLLM D,DATSTA(IDX)
IFN ITS,[
	PUSHJ P,COMPFN          ;PARSE THE FILENAME
	SKIPE T,DATSNM(IDX)	;KEEP STICKY DEFAULT DIRECTORY
	 .SUSET [.SSNAME,,T]
	TRNE IDX,1              ;OUTPUT INDEX?
	 JRST OPNOUT            ;YES, HAS TO HAPPEN SOMEWHAT DIFFERENTLY
	MOVEI T,.UAI            ;ASSUME TEXT MODE
	TLNE D,ST.BIN           ;UNLESS REALLY BINARY
	 MOVEI T,.UII
	TLNE D,ST.PDT
	 TRO T,10
	TLNE D,ST.INL
	 TRO T,20
	TRNE F,F.PDR		;PROBE-DIRECTORY MODE
	 JRST [	MOVE TT,[SIXBIT/.FILE./]
		MOVEM TT,DATFN1(IDX)
		MOVE TT,[SIXBIT/(DIR)/]
		MOVEM TT,DATFN2(IDX)
		JRST .+1 ]
	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW,,T       ;Appropriate mode
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN,,DATFN2(IDX)
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR
	.CALL [ SETZ            ;GET TRUENAME TO RETURN TO USER
		SIXBIT /RFNAME/
		%CLIN,,DATCHN(IDX)
		%CLOUT,,DATDEV(IDX)
		%CLOUT,,DATFN1(IDX)
		%CLOUT,,DATFN2(IDX)
		%CLOUT+%CLEND,,DATSNM(IDX)]
	 JFCL                   ;WELL, IT SHOULDN'T BUT...
	TLNN D,ST.BIN		;Don't try to QFASLP for text files
	 JRST OPNFN0
	MOVEI T,1               ;READ THE FIRST WORD OF THE FILE FOR QFASLP
	MOVE TT,[444400,,B]     ;ONE BYTE INTO B
	.CALL [ SETZ
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,TT
		%CLIN+%CLEND,,T]
	 SETZ B,                ;HMMM....
	CAMN B,[SIXBIT/QFASL/]	;QFASL OR QBIN FILE?
	 JRST OPNQFA		;YES
	TRZ B,77_4		;ALLOW ANY VERSION BELOW 100
	CAMN B,[.BYTE 16. ? 170023 ? 0]	;BIN FILE?
OPNQFA:	 TROA F,F.QFP		;YES
	  JRST [TRNN F,F.DEF	;CHARACTERS DEFAULT?
		 JRST .+1	;NO
		TLZ D,ST.BIN	;YES, NOT BINARY THEN
		HLLM D,DATSTA(IDX)
		TRNE F,F.PRB
		 JRST .+1
		JRST OPNACF]	;And need to reopen in case it matters
	TRNE F,F.PRB		;This a probe?
	 JRST OPNFN0		;Yup, don't bother setting the access pointer back
	.CALL [ SETZ            ;RESET POINTER TO BEGINNING OF FILE
		SIXBIT /ACCESS/
		%CLIN,,DATCHN(IDX)
		%CLIMM+%CLEND,,0]
	 JRST OPNACF		;ACCESS can fail on things like job devices
	JRST OPNFN0

OPNACF:	.CALL [ SETZ
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL			;It can't fail...
	MOVEI T,.UAI		;ACCESS failed, so do it the slow way (reopen file)
	TLNE D,ST.BIN           ;UNLESS REALLY BINARY
	 MOVEI T,.UII
	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW,,T       ;Appropriate mode
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN,,DATFN2(IDX)
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR
	JRST OPNFN0

OPNOUT: MOVEI T,.UAO            ;ASSUME TEXT MODE
	TLNE D,ST.BIN           ;UNLESS REALLY BINARY
	 MOVEI T,.UIO
	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD  ;Error code
		%CLBTW,,T       ;Appropriate mode
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,[SIXBIT \_LSPM_\]
		%CLIN,,[SIXBIT \OUTPUT\]
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR
	SETZM DATLEN(IDX)	;Due to ITS lossage must keep our own length for output files
]	;END IFN ITS

IFN TNX,[
	SETZM DATDSP(IDX)	;No delete or rename when closed (so far)
	TRNE F,F.PDR
	 JRST OPNPDR		;PROBE-DIRECTORY
	TRNE IDX,1
	 TLO D,ST.OUT		;COMGJF wants output file
	SETZM NOTNEW
	TLNE F,(F.SUP\F.APP\F.OVW\F.NEW\F.TRU\F.REN\F.RND)
	 AOS NOTNEW		;Don't create a new version
	TLNE F,(F.APP\F.OVW\F.TRU)
	 TLNE F,(F.CRE)
	  CAIA
	   SETOM NOTNEW		;Must have an old file to append to or write over
	PUSHJ P,COMGJF		;Get JFN in AC1
	  SKIPA
	    JRST GTRLFL
	TLNN F,(F.NEW)
	 CAIE 1,GJFX27		;File already exists (new file required)
	  PUSHJ P,JSYSER	;Error: return it to the user

	;We have an existing file
	SETOM NOTNEW
	PUSHJ P,COMGJG		;Try opening again, as an old file...
	  PUSHJ P,JSYSER	;  Oh well...
	TLNE F,(F.APP\F.OVW\F.TRU)
	 JRST GTRLFL		;Use the old file
	MOVE T,1		;Supersede the old file
	HRLI T,DD.SUP+DD.OPN	;Remember that we need to close it first
	TLNE F,(F.REN)		;Set flags for rename/delete of old file
	 TLO T,DD.REN
	TLNE F,(F.RND)
	 TLO T,DD.RND
	MOVEM T,DATDSP(IDX)
	TLNN D,ST.BIN
	  SKIPA 2,[070000,,OF%RD+OF%PLN+OF%RTD]	;Input/ASCII/no line numbers!
	    MOVE 2,[440000,,OF%RD+OF%RTD]	;Input, 36-bit
	OPENF			;Open file, to lock it.
	 ERCAL [ MOVSI T,DD.OPN
		 ANDCAM T,DATDSP(IDX)
		 CAIE 1,OPNX30	;"CAN'T OPEN WHEN ARCHIVED"
		  CAIN 1,OPNX31	;"FILE OFFLINE"
		   POPJ P,	;Ignore these errors and supersede without locking
		 JRST JSYSER ]	;Probably invalid simultaneous access

	HRROI 1,TMPFIL		;Then make a temporary file in the same
	HRRZ 2,DATDSP(IDX)	;directory you want the final one...
	MOVE 3,[110000,,JS%PAF]
	JFNS			;dev:<dir>
	HRROI 2,[ASCIZ /-TEMPORARY-FILE-./]
	SETZ 3,
	SOUT
	PUSH P,1
	GTAD
	MOVE 2,1
	POP P,1
	MOVEI 3,8.
	NOUT
	  JFCL
	HRROI 2,[ASCIZ /.-1/]
	SETZ 3,
	SOUT

	SETZM NOTNEW
	HRROI 2,TMPFIL		;and we will write to that one instead.
	PUSHJ P,COMGJG
	 PUSHJ P,JSYSER
GTRLFL:	HRRZM 1,DATJFN(IDX)	;JFN for this index
	TRNN IDX,1
	  JRST [TLNN D,ST.BIN
		  SKIPA 2,[070000,,OF%RD+OF%PLN];Input/ASCII, no line numbers!
		   MOVE 2,[440000,,OF%RD]	;Input, 36-bit
		 JRST .+4]
	TLNN D,ST.BIN
	 SKIPA 2,[070000,,OF%WR]	;Output, ASCII
	  MOVE 2,[440000,,OF%WR]	;Output, 36-bit
	TLNE F,(F.APP)
	 TRC 2,OF%WR+OF%APP	;Open for append instead
	TLNE F,(F.OVW)
	 TRO 2,OF%RD		;Open for both read and write => don't truncate
	TLNE D,ST.PDT
	 TRO 2,OF%PDT
IFN 20X,PUSHJ P,TRYCON
	OPENF			;Open the file
	 ERCAL OPNJER		;Here if some error

	SETZM DATLEN(IDX)	;Will keep track of file lengths ourself
	TRNN IDX,1		;Output file, don't do QFASL-P check
	 TLNN D,ST.BIN		;Don't try to QFASLP for text files
	  JRST OPNFN0
	MOVE 1,DATJFN(IDX)
	BIN			;Read byte for QFASL-P
	ERJMP OPNNBN		;EOF, not binary
	CAMN 2,[SIXBIT/QFASL/]	;QFASL OR QBIN FILE?
	 JRST OPNQFA		;YES
	TRZ 2,77_4		;ALLOW ANY VERSION BELOW 100
	CAMN 2,[.BYTE 16. ? 170023 ? 0]	;BIN FILE?
OPNQFA:	 TROA F,F.QFP		;YES
	  JRST OPNNBN		;NO
OPNNB0:	TRNE F,F.PRB		;If a probe, no need to set file pointer back
	 JRST OPNFN0
	SETZ 2,			;Set pointer back to beginning of file
	SFPTR
	 JRST OPNACF		;For files that can't be set back, just reopen
	JRST OPNFN0

;Analyze OPENF failure
OPNJER:
IFN 20X,[
	TRNE F,F.PRB		;If probe, don't care if file is unavailable
	JRST	OPNJE1		;SO SKIP THIS STUFF
	CAIE	1,OPNX31	;IS THE FILE OFFLINE?
	JRST	JSYSER		;NO, SIGNAL THE ERROR
	SKIPN	RETENA		;ARE AUTOMATIC RETRIEVALS ENABLED?
	JRST	JSYSER		;NO, SIGNAL THE ERROR
	TLNE	D,ST.RET	;HAVE WE ALREADY TRIED RETRIEVING THIS FILE?
	JRST	JSYSER		;YES, SIGNAL THE ERROR
	MOVE    1,DATJFN(IDX)	;JFN OF FILE TO BE RETRIEVED
	HRRZI	2,.ARRFR	;ARCF RETRIEVAL FUNCTION CODE
	MOVE	3,[AR%WAT]	;WE WANNA WAIT FOR THE RETRIEVAL
	ARCF%			;RETRIEVE THE FILE
	 ERJMP	.+1		;IGNORE ANY ERRORS
	TLO	D,ST.RET	;INDICATE THAT WE HAVE TRIED RETRIEVING FILE
	MOVE    1,DATJFN(IDX)	;JFN OF FILE
	JRST	GTRLFL		;AND RETRY OPENING THE FILE

OPNJE1:
];20X
	MOVSI 2,-LERRTB
	HLRZ 3,ERRTAB(2)
	CAIE 3,(1)
	 AOBJN 2,.-2
	JUMPGE 2,JSYSER
	HRRZ 3,ERRTAB(2)
	CAIE 3,'NAV
	 JRST JSYSER
	POP P,3			;Flush return PC
	;Fall into OPNNBN

OPNNBN:	TRNN F,F.DEF	;CHARACTERS DEFAULT?
	 JRST OPNNB0	;NO
	TLZ D,ST.BIN	;YES, NOT BINARY THEN
	HLLM D,DATSTA(IDX)
	TRNE F,F.PRB
	 JRST OPNNB0
	JRST OPNACF	;And need to reopen in case it matters

OPNACF:	MOVE 1,DATJFN(IDX)
	HRLI 1,(CO%NRJ)		;Don't release the JFN
	CLOSF
	 ERCAL SYSBUG
	HRRZS 1
	TLNN D,ST.BIN
	 SKIPA 2,[070000,,OF%RD+OF%PLN]	;Input, ASCII, no line numbers!
	  MOVE 2,[447400,,OF%RD]	;Input, dump mode
	TLNE D,ST.PDT
	 TRO 2,OF%PDT
	OPENF			;Re-open file
	 ERCAL JSYSER		;Shouldn't happen, but...
];END IFN TOP20
OPNFN0:	MOVEI A,[ASCIZ \OPEN \]
	PUSHJ P,COMCTL
	SKIPE PTCVER
	 JRST OPNFN3
	TRNE F,F.PDR
	 JRST [	MOVEI BYTE,"1
		PUSHJ P,COMCHO
		JRST .+2 ]
	  PUSHJ P,COMVRS
	MOVEI BYTE,40
	PUSHJ P,COMCHO
OPNFN3:
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /RFDATE/
		%CLIN,,DATCHN(IDX)
		%CLOUT+%CLEND,,A]
	 SETZ A,                ;ASSUME 0 IF CALL FAILS
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVEI 2,A		;Return values starting in A
	MOVEI 3,1		;Want one values (last write date)
	SETZ A,
	RFTAD
	 ERCAL ERRPDR
]	;END IFN TNX
	PUSHJ P,COMDTO          ;OUTPUT DATE/TIME FROM A
	MOVEI BYTE,40
	PUSHJ P,COMCHO
IFN ITS,[
	TRNN IDX,1              ;RETURN 0 LENGTH FOR OUTPUT FILES
	 .CALL [ SETZ
		 SIXBIT /FILLEN/
		 %CLIN,,DATCHN(IDX)
		 %CLOUT+%CLEND,,A] ;SIZE IN 36 BIT BYTES
	  SETZ A,               ;HMM...
]	;END IFN ITS
IFN TNX,[
	SETZ A,
	TRNE IDX,1
	 skipge notnew		;GLR output file
          caia			;     that already exists -- calculate length
	   JRST OPNFN1		;Output file, return 0 length
	MOVE 1,DATJFN(IDX)
	MOVE 2,[2,,.FBBYV]	;Read two words: byte size info, and number of bytes
	MOVEI 3,T		;Return info in T and TT
	SETZB T,TT
	GTFDB
	 ERCAL ERRPDR
	MOVE A,TT
	LDB TT,[300600,,T]	;Get byte size
	HRLZI T,ST.BIN
	TDNN T,DATSTA(IDX)	;If binary mode, do calculation
	 JRST [CAIN TT,7	;ASCII mode, was original byte size 7 bits?
		JRST OPNFN1	;Yes, then A contains exact number of bytes
	       IMULI A,5	;Else fudge multiplying by number of bytes per word
	       JRST .+1]	;And do harder calculation
	MOVEI T,36.
	IDIVI T,(TT)		;And calculate number of bytes per word
	ADDI A,-1(T)		;Roundoff correctly
	IDIVI A,(T)		;A gets number of words in the file
]	;END IFN TNX
	HRLZI T,ST.BIN          ;BINARY MODE MULTIPLIES BY APPROPRIATE AMOUNT
	TDNN T,DATSTA(IDX)
	 JRST OPNFN1            ;A HAS ACTUAL LENGTH
	IMUL A,DATBPW(IDX)
OPNFN1:	MOVEM A,DATLEN(IDX)
	PUSHJ P,COMDCO          ;OUTPUT IN DECIMAL
	MOVEI A,[ASCIZ \ NIL\]	;ASSUME NOT QFASL
	TRZE F,F.QFP
	 MOVEI A,[ASCIZ \ T\]
	PUSHJ P,COMSTO          ;STRING-OUT THE APPROPRIATE RESPONSE
	MOVEI A,[ASCIZ \ NIL\]	;ASSUME NOT CHARACTERS
	HRLZI T,ST.BIN
	TDNN T,DATSTA(IDX)
	 MOVEI A,[ASCIZ \ T\]
	PUSHJ P,COMSTO
OPNFN2:	MOVEI A,[ASCIZ / "/]	;SEND AUTHOR
	PUSHJ P,COMSTO
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	HRLI 1,.GFLWR
	HRROI 2,WRITER
	GFUST
	  ERJMP OPNFN4
	MOVE A,[440700,,WRITER]
];20X
IFN ITS,[SYSCAL RAUTH,[DATCHN(IDX)
		       %CLOUT,,WRITER]
	  JRST OPNFN4
	MOVE A,[440600,,WRITER]
];ITS
OPNF2L:	ILDB BYTE,A
	JUMPE BYTE,OPNFN4
IFN ITS,ADDI BYTE,40			;Factor for 6bit -> 7bit
	CAIE BYTE,""
	  CAIN BYTE,"/
	    JRST [PUSH P,BYTE
		  MOVEI BYTE,"/
		  PUSHJ P,COMCHO
		  POP P,BYTE
		  JRST .+1]
	PUSHJ P,COMCHO
	JRST OPNF2L

OPNFN4:	MOVEI BYTE,""
	PUSHJ P,COMCHO
	MOVEI BYTE,215          ;A NEWLINE
	PUSHJ P,COMCHO
	PUSHJ P,COMRFO          ;OUTPUT THE REAL FILENAMES
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	TRZN F,F.PRB
	 JRST OPNFPS            ;IF NOT A PROBE, THEN WE ARE DONE
	PUSHJ P,COMSND		;PROBE: REPLY QUICKLY
IFN ITS,[
	.CALL [ SETZ            ;A PROBE, SO CLOSE THE CHANNEL, AS WE ARE DONE WITH IT
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL                   ;HMM...OH WELL
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)	;A probe, so close channel
	CLOSF
	 JRST [	MOVE 1,DATJFN(IDX)	;Might not be open
		RLJFN
		 JFCL
		JRST .+1 ]
	SETZM DATJFN(IDX)
]	;END IFN TNX
	SETZM DATSTA(IDX)       ;MAKE SURE WORLD KNOWS CHANNEL IS CLOSED
	JRST CTLLOP

OPNFPS:	PUSHJ P,BUFALO          ;ALLOCATE A BUFFER
	MOVEI T,ST%OPN          ;STATE IS NOW OPEN
	HRRM T,DATSTA(IDX)
	HRLZI T,ST.ACT		;CHANNEL IS NOW ACTIVE
	IORM T,DATSTA(IDX)
	PUSHJ P,COMSND
IFN ITS,[
	MOVE T,CHABIT(IDX)
	.SUSET [.SIMSK2,,T]     ;ENABLE INTERRUPTS ON THE CHAOS CHANNEL
	ANDCAM T,SSYDF2	        ;Update saved copy of DS2
	.SUSET [.SADF2,,T]
	.SUSET [.SIIFPIR,,T]	;Start the ball rolling with an interrupt
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	AIC			;Enable interrupts on this channel
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	IIC			;Force interrupt on channel to start ball rolling
]	;END IFN TNX
	JRST CTLLOP             ;WAIT FOR MORE WORK

IFN ITS,[
;Send version number over
COMVRS:	MOVE TT,DATFN2(IDX)      ;RETURN FN2 AS VERSION
	;SEND THE VERSION NUMBER IN DECIMAL OR -1 IF NOT A NUMBER
	;IF PARTIAL NUMBER SEND THAT
	MOVEI A,0		;SET IF ANY DIGITS OUTPUT
COMVR0:	MOVEI T,0
	LSHC T,6
	MOVEI BYTE,40(T)
	CAIL BYTE,"0
	 CAILE BYTE,"9
	  JRST COMVR1
	PUSHJ P,COMCHO
	MOVEI A,1
	JUMPN TT,COMVR0
COMVR1:	JUMPN A,CPOPJ
	MOVEI BYTE,"-
	PUSHJ P,COMCHO
	MOVEI BYTE,"1
	PUSHJ P,COMCHO
	POPJ P,

;Output filespec to the control stream from DATxxx
COMRFO:	MOVE A,DATDEV(IDX)      ;DEVICE NAME
	CAMN A,[SIXBIT /DSK/]   ;If DSK, then send machine name
	 MOVE A,MACNAM
	PUSHJ P,COMSXO
	MOVEI A,[ASCIZ \: \]	;COLON TERMINATES DEVICE
	PUSHJ P,COMSTO
COMRF2:	SKIPN A,DATSNM(IDX)      ;THEN SNAME
	 JRST .+4
	  PUSHJ P,COMSXO
	  MOVEI A,[ASCIZ \; \]	;SEMICOLON TERMINATES SNAME
	  PUSHJ P,COMSTO
	TRNE F,F.PDR
	 POPJ P,
	SKIPN A,DATFN1(IDX)	;FIRST FILENAME
	 JRST [	SKIPN A,DATFN2(IDX)
		 POPJ P,
		MOVEI BYTE,"
		PUSHJ P,COMCHO
		JRST COMSXO ]
	PUSHJ P,COMSXO
	SKIPN A,DATFN2(IDX)	;FINALLY, SECOND FILENAME
	 POPJ P,
	MOVEI BYTE,40		;SPACE ENDS FN1
	PUSHJ P,COMCHO
	JRST COMSXO             ;TAIL RECURSIVE CALL TO SIXBIT OUTPUT

;Version of COMRFO which omits the default device entirely rather than plugging in the host
COMRF1:	MOVE A,DATDEV(IDX)      ;DEVICE NAME
	CAMN A,[SIXBIT /DSK/]   ;If DSK, then send nothing
	 JRST COMRF2
	JRST COMRFO
]	;END IFN ITS

IFN TNX,[
COMRFO:	SKIPA 3,[111110,,JS%PAF]	;Device, directory, filename, file type, version
COMVRS:	 MOVE 3,[000010,,0]	;Only return generation
	TRNE F,F.PDR
	 TLZ 3,001110		;Probe-directory gives only device and directory
	HRROI 1,RESBLK		;Output to canonical place
	MOVE 2,DATJFN(IDX)
	JFNS
	 ERCAL SYSBUG
	JRST COMRES		;Output result block to control packet

;;; 10X/20X PROBE-DIRECTORY
OPNPDR:	TRNN F,F.PRB
	 JRST COMBAD
	PUSHJ P,PRSDIR		;Return JFN in 1, directory number in 3
	 PUSHJ P,OPNPD1		;Error
	  HRRZM 1,DATJFN(IDX)	;Really got some JFN, hang onto it
	SETZM DATLEN(IDX)
	JRST OPNFN0

OPNPD1:	CAIE 1,GJFX32		;Directory empty (no files match specification)
	 CAIN 1,GJFX19		;No such file type
	  JRST POPJ1
	CAIE 1,GJFX24		;Both Tenex and TOPS-20 can give GJFX24 randomly
	 CAIN 1,GJFX20		;I think only Tenex gives GJFX20
	  JRST POPJ1
	JRST JSYSER		;Some other error - Complain.

ERRPDR:	TRNN F,F.PDR
	 JRST SYSBUG
	POPJ P,
]	;END IFN TNX

;PUSHJ P, for errors that are bugs in the system or in this program
SYSBUG:	SETOM SYSBGF		;Set flag and drop into normal routine
;Handle failing .CALLs or JSYSes
FILERR:	PUSHJ P,OPNERP		;Setup error packet
	PUSHJ P,COMSND          ;Send the packet
	JRST CTLLOP             ;Then wait for more work

IFN TNX,JSYSER=FILERR

OPNERP:	MOVEI A,[ASCIZ \ERROR \]
	PUSHJ P,COMCTL          ;Start off error packet, open failed error code
IFN TNX,[
	MOVEI 1,.FHSLF
	PUSHJ P,$GETER		;Get last error that happened
	 PUSHJ P,CTLERR
	HRRZM 2,ERRCOD		;The number of the error
];TNX
	MOVE D,ERRCOD		;Send 3 letter code for this error
	PUSHJ P,ERR3
	PUSH P,A		;Save 3-letter code
	MOVSS A
	PUSHJ P,COMSXO		;Output the 3-letter code
	MOVEI A,[ASCIZ \ F \]	;Fatal error
	PUSHJ P,COMSTO
	PUSHJ P,ERRMSG		;Send the error message
	POP P,A			;Restore 3-letter code
	CAIE A,'BUG		;If it's a bug, include octal PC
BUGPAT:	 JRST [	SKIPN DEBUG	;Always include PC if in debugging mode
		 POPJ P,	;or if BUGPAT is patched to JFCL
		JRST .+1 ]
	MOVEI A,[ASCIZ \ (at \]
	PUSHJ P,COMSTO
	HRRZ A,-1(P)		;Caller of FILERR
	SUBI A,2		;Address of errored JSYS or other call
	PUSHJ P,COMOCO	
	MOVEI A,[ASCIZ/ inside FILE server)/]
	PUSHJ P,COMSTO
	POPJ P,

;Move 3-letter code for error in D to A
ERR3:	MOVEI A,'BUG		;Any errors not in our table must be file server bugs
	AOSN SYSBGF
	 POPJ P,
	MOVSI TT,-LERRTB	;Search table for appropriate 3 letter code
ERR3A:	HLRZ T,ERRTAB(TT)
	CAME T,D
	 AOBJN TT,ERR3A
	HRRZ A,ERRTAB(TT)
	POPJ P,

;Transmit error message to command packet, D has error code.
IFN ITS,[
ERRMSG:	.SUSET [.SPICLR,,[0]]	;ERR device can be used at interrupt level
	.CALL [ SETZ            ;Now open ERR device to get error message
		SIXBIT /OPEN/
		%CLBIT,,.UAI
		%CLIMM,,ERRCH
		%CLIN,,[SIXBIT /ERR/]
		%CLIMM,,4
		%CLIN+%CLEND,,D]
	 .LOSE %LSSYS
ERRMS1:	.IOT ERRCH,BYTE
	JUMPLE BYTE,ERRMS2	;EOF
	CAIN BYTE,15		;CR turns into Return
	 MOVEI BYTE,215
	CAIL BYTE,40		;Other control characters are ignored
	 PUSHJ P,COMCHO
	JRST ERRMS1
		
ERRMS2:	.CLOSE ERRCH,
	.SUSET [.SPICLR,,[-1]]	;Done with use of any shared resources
	POPJ P,
];ITS

IFN TNX,[
ERRMSG:	MOVEI 1,.FHSLF		;ERRBUF can be used at interrupt level
	DIR
	MOVE 2,D
	HRLI 2,.FHSLF
	HRROI 1,ERRBUF		;Output to canonical place, error in AC2
	SETZM ERRBUF
	MOVEI 3,ERRLEN-1	;Maximum number of bytes we can handle
	ERSTR
	 JFCL			;Undefined error number??
	  JFCL			;Won't fit -- too bad
	SKIPE ERRBUF
	 JRST ERRMS1
	HRROI 1,ERRBUF
	HRROI 2,[ASCIZ/Undefined system error code /]
	MOVEI 3,0
	SOUT
	HRRZ 2,D
	MOVEI 3,8
	NOUT
	 JFCL
ERRMS1:
IFN 10X,[
	SETZ 3,
	IDPB 3,1		;Put in null
];IFN 10X
	MOVEI A,ERRBUF
	PUSHJ P,COMSTO		;Output the error string
	MOVEI 1,.FHSLF		;Okay turn interrupts back on
	EIR
	POPJ P,
];END IFN TNX

;;; Close a data channel
COMCLO:	TRNN F,F.FHN            ;HAVE A FILE HANDLE?
	 JRST COMBAD            ;NOPE, ERROR
	JUMPGE BC,COMBAD        ;NO OPTIONS TO THE CLOSE COMMAND
	SKIPL T,DATSTA(IDX)	;CHANNEL ACTIVE?
	 CERR BUG,[Channel not open]
	TLNE T,ST.DIR		;Was it a directory listing?
	 JRST COMCLD
	MOVEI A,[ASCIZ \CLOSE \];SUCCESSFUL RESPONSE
	PUSHJ P,COMCTL          ;SETUP CONTROL PACKET
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /RFDATE/
		%CLIN,,DATCHN(IDX)
		%CLOUT+%CLEND,,CLODAT]
	 SETZM CLODAT           ;ASSUME 0 IF CALL FAILS
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVEI 2,A		;Return values starting in A
	MOVEI 3,1		;Want one value (last write date)
	RFTAD
	 ERCAL SYSBUG
	MOVEM A,CLODAT
]	;END IFN TNX
	TRNE IDX,1		;Input file?
	 JRST CLOLE0		;Nope, output, use calculated length
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /FILLEN/
		%CLIN,,DATCHN(IDX)
		%CLOUT+%CLEND,,A] ;SIZE IN 36 BIT BYTES
	 SETZ A,                ;HMM...
]	;END IFN ITS
IFN TNX,[
	SETZ A,
	MOVE 1,DATJFN(IDX)
	MOVE 2,[2,,.FBBYV]	;Read two words: byte size info, and number of bytes
	MOVEI 3,T		;Return info in T and TT
	GTFDB
	 ERCAL SYSBUG
	MOVE A,TT
	LDB TT,[300600,,T]	;Get byte size
	HRLZI T,ST.BIN
	TDNN T,DATSTA(IDX)	;If binary mode, do calculation
	 JRST [CAIN TT,7	;ASCII mode, was original byte size 7 bits?
		JRST CLOLE1	;Yes, then A contains exact number of bytes
	       JRST .+1]	;And do harder calculation
	MOVEI T,36.
	IDIVI T,(TT)		;And calculate number of bytes per word
	ADDI A,-1(T)
	IDIVI A,(T)		;A gets number of words in the file
]	;END IFN TNX
	HRLZI T,ST.BIN          ;BINARY MODE MULTIPLIES BY 2, TEXT MODE BY 5
	TDNN T,DATSTA(IDX)
	 SKIPA T,[5]            ;TEXT: 5
	  MOVEI T,2             ;BINARY: 2
	IMULI A,(T)
	JRST CLOLE1

CLOLE0:	MOVE A,DATLEN(IDX)	;Actual number of bytes in file
	HRLZI T,ST.BIN
	TDNN T,DATSTA(IDX)	;If not binary mode then this is the number we want
	 JRST CLOLE1
	MOVE T,DATBPW(IDX)
	ADDI A,-1(T)		;In order to round up
	IDIVI A,(T)		;Calculate number of words in file
	IMULI A,(T)		;Then calculate number of bytes rounded up
;	JRST CLOLE1

CLOLE1:	MOVEM A,CLOLEN
IFN ITS, PUSHJ P,CLOSIT		;Close the channel
IFN TNX, PUSHJ P,CLONRJ	;Close, but don't release JFN
	SKIPE PTCVER
	 JRST CLOLE2
	PUSHJ P,COMVRS
	MOVEI BYTE,40
	PUSHJ P,COMCHO
CLOLE2:	MOVE A,CLODAT
	PUSHJ P,COMDTO          ;OUTPUT DATE/TIME FROM A
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	MOVE A,CLOLEN           ;FILE LENGTH
	PUSHJ P,COMDCO          ;OUTPUT IN DECIMAL
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	MOVE A,DATRCV(IDX)
	PUSHJ P,COMDCO
	;; Don't send QFASL info
	MOVEI BYTE,215          ;A NEWLINE
	PUSHJ P,COMCHO
	PUSHJ P,COMRFO          ;OUTPUT THE REAL FILENAMES
	MOVEI BYTE,215
	PUSHJ P,COMCHO
CLOLED:	MOVEI A,CPOPJ           ;Routine to call in case mark already received
	PUSHJ P,COMSSY          ;Send/receive synchronous mark
	PUSHJ P,COMSND          ;Send control response
	HRLZI T,ST.SYN          ;Wait for mark to go out, or mark to come in
IFN ITS,[			; (for output, mark supposed to be here already!)
	TDNE T,DATSTA(IDX)
	 .HANG
]	;END IFN ITS
IFN TNX,[
	PUSHJ P,RELDJF
	;; Nothing winning like .HANG, so use small sleeps
	PUSHJ P,$HANG
	 TDNE T,DATSTA(IDX)
]	;END IFN TNX
	SETZM DATSTA(IDX)	;Done with channel now, deactivate it
	JRST CTLLOP

IFN TNX,[
$HANG:	TIME			;Don't wait forever
	IMULI 2,30.		;Just 30 seconds
	ADD 1,2
	MOVE TT,1
$HANG1:	XCT @(P)
	 CAIA
	  JRST POPJ1
	MOVEI 1,1
	DISMS
	TIME
	CAMG 1,TT
	 JRST $HANG1
	MOVE 1,[441000,,CTLPKO+%CPKDT]
	HRROI 2,[ASCIZ/Timed out waiting for synchronous mark on close/]
	SETZ 3,
	Sout
	IDPB 3,1
	JRST CTLER1
];TNX

IFN TNX, CLONRJ: TROA F,F.NRJ
CLOSIT:
IFN TNX, TRZ F,F.NRJ
	MOVE T,DATSTA(IDX)
	TLNE T,ST.DIR		;Directory command?
	 JRST CLODIR		;Yes, finish up specially
	TRNN IDX,1		;Output file?
	 JRST CLOSE0		;Nope, proceed
	HRRZ T,DATSTA(IDX)
	CAIN T,ST%OPN           ;Write out in-core buffer if channel state is OPEN
	 PUSHJ P,WRIFOR
IFN ITS,[
	SKIPN DATFN1(IDX)       ;Has file been DELEWO'ed?
	 JRST CLOSE1	    	;Yes, don't RENMWO or set author
	.CALL [ SETZ
		SIXBIT /RENMWO/
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN+%CLEND,,DATFN2(IDX)]
	 CERR CRF,[Cannot rename output file to real names]
	.CALL [ SETZ
		SIXBIT /SAUTH/
		%CLIN,,DATCHN(IDX)
		%CLIN+%CLEND,,HSNAME]
	 JFCL			;Unusual, but not fatal
CLOSE1:	.CALL [ SETZ            ;GET TRUENAME TO RETURN TO USER
		SIXBIT /RFNAME/
		%CLIN,,DATCHN(IDX)
		%CLOUT,,DATDEV(IDX)
		%CLOUT,,DATFN1(IDX)
		%CLOUT,,DATFN2(IDX)
		%CLOUT+%CLEND,,DATSNM(IDX)]
	 JFCL                   ;WELL, IT SHOULDN'T BUT...
]	;END IFN ITS
IFN TNX,[
CLOSE0:	MOVE 1,DATJFN(IDX)
	HRLI 1,(CO%NRJ)		;Close file, but keep around JFN
	MOVSI TT,DD.ABT
	TDNE TT,DATDSP(IDX)
	 TLO 1,(CZ%ABT)		;If going to delete, close in abort mode
	CLOSF
	 ERCAL SYSBUG		;Ain't much else we can do...

	TDNE TT,DATDSP(IDX)		;Delete?
	  JRST [MOVE 1,DATJFN(IDX)	;  Yes
		HRLI 1,(DF%NRJ)
		DELF
		  ERCAL JSYSER
		PUSHJ P,RELRJF		;Not going to rename to real name
		JRST CLOSE2]

	MOVE 1,DATDSP(IDX)
	TLNE 1,DD.OPN			;Before we can RNAMF this temporary
	  JRST [ HRLI 1,(CO%NRJ)	;file, it must be closed.
		 CLOSF
		  ERCAL SYSBUG
		 JRST .+1 ]

	MOVE TT,DATSTA(IDX)
	HRRZ 1,DATFBS(IDX)
	CAIN 1,36.		;Wants fullword?
	 JRST CLSIT0		;Yes, no conversison necessary
	TLNE TT,ST.BIN		;Is this a binary...
	 TRNN IDX,1		; ... WRITE operation?
	  JRST CLSIT0		;No, so don't hack the file size
	MOVE T,DATLEN(IDX)	;Number of transmission bytes in file
	MOVE 3,DATBPW(IDX)	;(do it this way in case lhs is used)
	IDIVI T,(3)		;T=number of words
	MOVE 3,DATBYT(IDX)
	IMULI TT,(3)		;TT=number of bits left over
	MOVEI 2,36.		;Convert it all to the file byte size
	IDIVI 2,(1)
	IMULI T,(2)
	MOVE 2,TT
	ADDI 2,-1(1)
	IDIVI 2,(1)
	ADD T,2
	HRRZ 1,DATJFN(IDX)	;Set the byte count
	HRLI 1,.FBSIZ\(CF%NUD)	;(minimize the non-atomicity...)
	SETO 2,
	MOVE 3,T
	CHFDB
	 ERCAL SYSBUG
	HRLI 1,.FBBYV		;And now the byte size
	MOVSI 2,(FB%BSZ)
	SETZ 3,
	MOVE T,DATFBS(IDX)
	DPB T,[.BP FB%BSZ,3]
	CHFDB
	 ERCAL SYSBUG
CLSIT0:

	MOVE TT,DATDSP(IDX)
	TLNN TT,DD.REN\DD.RND		;Get rid of existing file?
	 JRST CLOSE1

	HRROI 1,RESBLK			;Get a name to rename it to
	HRRZ 2,TT
	MOVE 3,[111000,,JS%PAF]
	JFNS				;dev:<dir>name
	 ERCAL SYSBUG
	HRROI 2,[ASCIZ /.REPLACED-FILE/]
	SETZ 3,
	SOUT
	MOVE 1,[GJ%FOU+GJ%NEW+GJ%SHT+.GJDEF]	;Setup flags to GTJFN
	HRROI 2,RESBLK
	GTJFN
	 ERCAL SYSBUG
	PUSH P,1

	HRROI 1,RESBLK			;Make a copy of the JFN so we can rename it
	HRRZ 2,TT
	MOVE 3,[111110,,JS%PAF]		;Device, directory, filename, file type, version
	JFNS
	 ERCAL SYSBUG
	MOVE 1,[GJ%OLD+GJ%SHT+.GJDEF]	;Setup flags to GTJFN
	HRROI 2,RESBLK
	GTJFN
	 ERCAL SYSBUG
	POP P,2
	RNAMF
	 ERCAL SYSBUG
	MOVE 1,2
	HRLI 1,(DF%NRJ)
	TLNE TT,DD.RND
	 DELF
	  ERCAL SYSBUG
	HRRZS 1
	RLJFN
	 JFCL
CLOSE1:	MOVSI TT,DD.SUP
	TDNN TT,DATDSP(IDX)		;Rename over existing file?
	  JRST CLOSE2			;  No.

	MOVE 1,DATJFN(IDX)	;Old name...
	HRRZ 2,DATDSP(IDX)	;...New name
	RNAMF
	  ERCAL JSYSER
	HRRZ 1,DATDSP(IDX)
	MOVEM 1,DATJFN(IDX)
CLOSE2:	SETZM DATDSP(IDX)	;Mark JFN in RH as released.
	TRNN F,F.NRJ
	  PUSHJ P,RELDJF

]	;END IFN TNX
IFN ITS, CLOSE0:
CLODON:	MOVE T,DATSTA(IDX)	;Get channel status
IFN TNX,[
IFN $$SUBM,[
	TLNN T,ST.SUB
	  JRST SUBM2
	SKIPE A,QSRPID
	  JRST SUBM1
SUBM0:	MOVEI 1,3		;Get QUASAR's PID.
	MOVEI 2,QUTILB
	MUTIL
	  JRST [MOVEI A,^D3000	;Sleep for three seconds
		DISMS
		JRST SUBM0]
	MOVE TT,QSRPID
	MOVEM TT,MSENDB+2	;Save QUASAR's pid in MSEND block.
SUBM1:	MOVE TT,[QPBLK,,QSRLOC]	;Blit in the args
	BLT TT,QSRLOC+19
	HRROI 1,QSRLOC+8.
	MOVE 2,DATJFN(IDX)
	MOVE 3,[111110,,JS%PAF]
	JFNS
	HRRZ 1,1		;A has last word written.
	SUBI 1,QSRLOC+6		;Number of words plus 1.
	HRLM 1,QSRLOC+7		;Length of block#2
	ADDI 1,7
	HRLM 1,QSRLOC		;Total length of block.
	SKIPN YERPID
	  SKIPA 1,[IP%CFV\IP%CPD]	;Page-long and make us a PID.
	    MOVEI 1,IP%CFV	;Just page-long send
	MOVEM 1,MSENDB+.IPCFL
	MOVEI 1,4
	MOVEI 2,MSENDB
	MSEND
	  CERR BUG,[Can't submit file]
SUBM2:
];$$SUBM
];TNX
	MOVEI TT,(T)
	CAIN TT,ST%OPN		;Was the channel open?
	 HRRI T,ST%CLO		;Yes, then close it
	MOVEM T,DATSTA(IDX)
	PUSHJ P,BUFDAL	  	;DEALLOCATE THE CORE BUFFER
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL                   ;HMMMM...."I GUESS WE'LL SURVIVE"
]	;END IFN ITS
	POPJ P,

IFN TNX,[
RELDJF:	SKIPN 1,DATJFN(IDX)	;Release data-file JFN, and mark as such.
	 POPJ P,
	HRLI 1,(CZ%ABT)		;Try closing since RLJFN fails if it's open
	CLOSF	
	 JFCL
RELDJ1:	MOVE 1,DATJFN(IDX)	;Here when not open, to not clobber error code
	RLJFN
	  JFCL
	SETZM DATJFN(IDX)
	POPJ P,

RELRJF:	HRRZ 1,DATDSP(IDX)
	JUMPE 1,CPOPJ
	HRLI 1,(CZ%ABT)
	CLOSF	
	 JFCL
RELRJ1:	HRRZ 1,DATDSP(IDX)	;Here when not open, to not clobber error code
	JUMPE 1,CPOPJ
	RLJFN
	  JFCL
	SETZM DATDSP(IDX)
	POPJ P,
];TNX

;;; FILEPOS: for input files only
COMFIL:	TRNN F,F.NWL            ;Can't have a newline
	 TRNN F,F.FHN           ;And must have a file handle
	  JRST COMBAD
	SKIPGE DATSTA(IDX)      ;IDX must be active
         caia			;GLR And ok if it is write
	  CERR BUG,[Illegal file handle for FILEPOS]

	trne idx,1		;GLR if output,
	 pushj p,wrifor		;GLR  send out the leftover characters in buffer

	JUMPL BC,COMBAD         ;Also need an argument
	PUSHJ P,COMDCI	  	;Read the arg in decimal
	JUMPGE BC,COMBAD        ;Better be the end
	HRLZI T,ST.BIN          ;Is this a binary channel?
	TDNN T,DATSTA(IDX)
	 JRST FILNBN            ;Nope, filepos is in A
	IDIV A,DATBPW(IDX)	;A is number of words in, B is number of bytes after that
	DPB B,[360600,,A]	;Need to save this for interrupt routine
FILNBN:	MOVEM A,DATSYN(IDX)     ;Location reserved for synchronous routines
	MOVEI A,FILSYN          ;Routine to call
	PUSHJ P,COMSSY	  	;Setup for the sync mark
	MOVEI A,[ASCIZ \FILEPOS\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	HRLZI T,ST.SYN          ;Wait for mark to go out
IFN ITS,[
	TDNE T,DATSTA(IDX)
	 .HANG
]	;END IFN ITS
IFN TNX,[
	;; Nothing winning like .HANG, so use small sleeps
	PUSHJ P,$HANG
	 TDNE T,DATSTA(IDX)
]	;END IFN TNX
	JRST CTLLOP             ;Ok, all done, go back for more

;;; Here after sync mark gets sent.  Called from interrupt and main program level
FILSYN:	MOVE T,DATSYN(IDX)      ;Get word (byte in text mode) address to ACCESS to
	TLZ T,770000		;Clear sub-word
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /ACCESS/
		%CLIN,,DATCHN(IDX)
		%CLIN+%CLEND,,T]
	 AERR CPOPJ,WKF,[Cannot set pointer]
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,T		;Where pointer is to get set to
	SFPTR
	 AERR CPOPJ,FOR,[Cannot set pointer]		;COULD BE WKF ALSO---
]	;END IFN TNX
	SETZM DATBPT(IDX)       ;No state is left
	SETZM DATBCT(IDX)
	SETZM DATLWD(IDX)
	HRRI A,ST%OPN		;Channel is now in open state
	TRNE IDX,1	        ;Output channel?
	 POPJ P,		;Yes, then we are done
	LDB T,[360600,,DATSYN(IDX)]	;Get number of bytes into first word
	JUMPE T,CPOPJ	   	;If none, then just return.
	PUSHJ P,REABUF	  	;Else read in the next bufferful
	SKIPG T,DATBCT(IDX)     ;Any bytes to hack?
	 POPJ P,		;Nope, just return, EOF will be sent next interrupt
	LDB TT,[360600,,DATSYN(IDX)]
	SUBI T,(TT)	        ;Calculate number of bytes that will remain in buffer
	JUMPLE T,FILSY0	 	;If it's gonna be 0 or negative, then EOF
	MOVEM T,DATBCT(IDX)     ;Else this is the new count
	IBP DATBPT(IDX)	 	;Step the pointer to the appropriate spot
	SOJG TT,.-1
	POPJ P,

FILSY0:	SETZM DATBPT(IDX)
	SETZM DATBCT(IDX)
	SETZM DATLWD(IDX)
	POPJ P,

;;; SET-BYTE-SIZE <new-byte-size> <new-filepos-in-terms-of-old-byte-size-for-input-files>
COMSBS:	JUMPL BC,COMBAD		;End of packet, losing format
	TRZE F,F.NWL		;Can't have new line either
	 JRST COMBAD
	SKIPGE T,DATSTA(IDX)	;This channel active?
	 TLNN T,ST.BIN		;And a binary channel?
	  CERR WKF,[SET-BYTE-SIZE only allowed for binary file]
	PUSHJ P,COMDCI		;Read new byte size in decimal
	JUMPL BC,COMBAD
	TRZE F,F.NWL
	 JRST COMBAD
	HRLM A,DATBYT(IDX)	;Remember new byte size
	TRNE IDX,1		;Need to set a filepos?
	 JRST SBSNFP		;Nope, ignore rest of packet
	PUSHJ P,COMDCI		;Else read the filepos
	IDIV A,DATBPW(IDX)	;A is number of words in, B is number of bytes after that
				; of current position in file
	DPB B,[360600,,A]	;Need to save this for interrupt routine
	MOVEM A,DATSYN(IDX)
SBSNFP:	MOVEI A,SBSSYN          ;Routine to call
	PUSHJ P,COMSSY	  	;Setup for the sync mark
	MOVEI A,[ASCIZ \SET-BYTE-SIZE\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	HRLZI T,ST.SYN          ;Wait for mark to go out
IFN ITS,[
	TDNE T,DATSTA(IDX)
	 .HANG
]	;END IFN ITS
IFN TNX,[
	;; Nothing winning like .HANG, so use small sleeps
	PUSHJ P,$HANG
	 TDNE T,DATSTA(IDX)
]	;END IFN TNX
	JRST CTLLOP             ;Ok, all done, go back for more

;;; Here upon receipt of synchronous mark
SBSSYN:	HLRZS TT,DATBYT(IDX)	;Set up new byte size as current byte size
	TRNN IDX,1		;If reading from file do filepos and return
	 JRST FILSYN
	SKIPE DATBPT(IDX)	;If a byte pointer is around, change its byte size
	 DPB TT,[360600,,DATBPT(IDX)]
	HRRI A,ST%OPN		;Channel is now in open state
	MOVEI T,36.		;Calculate and remember number of bytes per word
	IDIVI T,(TT)
	MOVEM T,DATBPW(IDX)
	POPJ P,			;Then we are done

;;; DELETE, RENAME and other sundry file operations

;;; DELETE
COMDEL:	TRNN F,F.FHN		;Did we have a file handle?
	 JRST DELFIL		;Nope, filename must be specified
	JUMPGE BC,COMBAD	;Must be end of command string here
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /DELEWO/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL			;Can't fail, can it??
	SETZM DATFN1(IDX)	;Flag file as deleted
]	;END IFN ITS
IFN TNX,[
	MOVSI TT,DD.ABT
	IORM TT,DATDSP(IDX)	;Flag for deletion later
]	;END IFN TNX
	MOVEI A,[ASCIZ \DELETE\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	JRST CTLLOP

DELFIL:	TRZN F,F.NWL		;Newline?
	 JRST COMBAD		;Nope, bad command format
	MOVEI IDX,MAXIDX	;Use the temporary channel for this
IFN ITS,[
	PUSHJ P,COMPFN		;Parse the filename to be deleted
	TRZN F,F.NWL		;Check for correct format
	 JRST COMBAD
	SKIPE T,DATSNM(IDX)	;Keep sticky default directory
	 .SUSET [.SSNAME,,T]
	.CALL [ SETZ
		SIXBIT /DELETE/
		%CLERR,,ERRCOD  ;Error code
		%CLIN,,DATDEV(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN,,DATFN2(IDX)
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR		;File error, tell about it
]	;END IFN ITS
IFN TNX,[
	SETZ D,			;COMGJF wants input file
	PUSHJ P,COMGJF		;Get JFN
	 PUSHJ P,JSYSER		;Error, return it to the user
	HRRZM 1,DATJFN(IDX)	;Save JFN
IFN 20X,PUSHJ P,TRYCON
	DELF
	 ERCAL JSYSER
]	;END IFN TNX
	MOVEI A,[ASCIZ \DELETE\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	JRST CTLLOP


;;; RENAME
COMREN:	TRZN F,F.NWL		;Both formats require newline
	 JRST COMBAD
	TRNN F,F.FHN		;Use an open file?
	 JRST RENFIL		;Nope, need two filenames
IFN ITS,[
	PUSH P,DATDEV(IDX)
	PUSH P,DATSNM(IDX)
	PUSHJ P,COMPFN		;Parse the filename
	TRZN F,F.NWL		;Must be terminated by newline
	 JRST COMBAD
	POP P,B			;Old directory
	POP P,A			;Old device
	PUSHJ P,RNMCHK
	TRNE IDX,1		;An output file?
	 JRST RENCOM		;Yes, using a temp name anyway, just proceed
	.CALL [ SETZ
		SIXBIT /RENMWO/
		%CLERR,,ERRCOD  ;Error code
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN+%CLEND,,DATFN2(IDX)]
	 PUSHJ P,FILERR
	MOVEI A,[ASCIZ \RENAME\]
	PUSHJ P,COMCTL
	MOVEI BYTE,215          ;A NEWLINE
	PUSHJ P,COMCHO
	.CALL [ SETZ            ;GET TRUENAME TO RETURN TO USER
		SIXBIT /RFNAME/
		%CLIN,,DATCHN(IDX)
		%CLOUT,,DATDEV(IDX)
		%CLOUT,,DATFN1(IDX)
		%CLOUT,,DATFN2(IDX)
		%CLOUT+%CLEND,,DATSNM(IDX)]
	 JFCL                   ;WELL, IT SHOULDN'T BUT...
	PUSHJ P,COMRFO          ;OUTPUT THE REAL FILENAMES
	PUSHJ P,COMSND
	JRST CTLLOP

;Here, the real filenames are not known yet.
RENCOM:	MOVEI A,[ASCIZ \RENAME\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	JRST CTLLOP

]	;END IFN ITS
IFN TNX,[
	HRLZI D,ST.OUT		;COMGJF wants output file
	SETZM NOTNEW
	PUSHJ P,COMGJF		;Get a JFN for the file
	 PUSHJ P,JSYSER
	MOVE 2,DATDSP(IDX)	;2 gets "current" (may not have that name yet really)
	TLNN 2,DD.SUP
	 MOVE 2,DATJFN(IDX)
	PUSHJ P,RENTNM		;Build return packet
	HRLI 1,DD.SUP
	PUSH P,1		;Save new name
	PUSHJ P,RELRJF		;Dispose of old DATDSP file name
	POP P,DATDSP(IDX)	;Defer processing until file gets closed
	PUSHJ P,COMSND
	JRST CTLLOP
];END IFN TNX

RENFIL:	MOVEI IDX,MAXIDX	;A phony IDX to use
IFN ITS,[
	PUSHJ P,COMPFN		;Parse the from filename
	TRZN F,F.NWL		;Must have trailing newline
	 JRST COMBAD
	SKIPE T,DATSNM(IDX)	;Keep sticky default directory
	 .SUSET [.SSNAME,,T]
IRPS WHAT,,[DATDEV,DATFN1,DATFN2,DATSNM]
	PUSH P,WHAT(IDX)
TERMIN
	PUSHJ P,COMPFN		;Parse the next filespec
	TRZN F,F.NWL
	 JRST COMBAD
	MOVE A,-3(P)		;DATDEV
	MOVE B,0(P)		;DATSNM
	PUSHJ P,RNMCHK
	.CALL [ SETZ
		SIXBIT /RENAME/
		%CLERR,,ERRCOD
		%CLIN,,A
		%CLIN,,-2(P)
		%CLIN,,-1(P)
		%CLIN,,B
		%CLIN,,DATFN1(IDX)
		%CLIN+%CLEND,,DATFN2(IDX)]
	 PUSHJ P,FILERR		;Report file error
	SUB P,[4,,4]		;Not really necessary, but get rid of pushed cruft
	JRST RENCOM

RNMCHK: MOVE T,DATDEV(IDX)	;Both devices must be the same.
	CAMN T,MACNAM
	 MOVE T,[SIXBIT/DSK/]
	CAMN A,MACNAM
	 MOVE A,[SIXBIT/DSK/]
	CAME A,T
	 JRST [	CERR RAD,[Cannot rename across devices] ]
	SKIPN B
	 .SUSET [.RSNAME,,B]
	SKIPN DATSNM(IDX)
	 MOVEM B,DATSNM(IDX)	;dir of second file defaults to the first one's.
	CAMN B,DATSNM(IDX)
	 POPJ P,		;They must also be the same.
	CERR RAD,[Cannot rename across directories]
]	;END IFN ITS

IFN TNX,[
	SETZ D,			;Get input file first
	PUSHJ P,COMGJF		;Get JFN for file
	 PUSHJ P,JSYSER		;Can't get JFN, so return
	MOVEM 1,DATDSP(IDX)	;Save source JFN
	TLO D,ST.OUT		;Next file is 'output' file
	SETZM NOTNEW
	PUSHJ P,COMGJF
	 PUSHJ P,RELINF		;Can't get output JFN, so release input JFN (doesn't return)
	MOVE 2,DATDSP(IDX)
	PUSHJ P,RENTNM		;Build response packet presuming success
	MOVE 2,1
	MOVE C,1		;Remember target in case of error
	MOVE 1,DATDSP(IDX)
IFN 20X,[
	MOVEM 1,DATJFN(IDX)	;Implicit arg to TRYCON
	PUSHJ P,TRYCON
];20X
	RNAMF
	 ERCAL [MOVE 1,C
		RLJFN
	         JFCL
	IFN 20X,SETZM DATJFN(IDX)
		JRST RELINF]
	MOVE 1,C
	RLJFN
	 JFCL
IFN 20X,SETZM DATJFN(IDX)
	PUSHJ P,COMSND
	JRST CTLLOP

RELINF:	PUSHJ P,RELRJ1		;Release DATDSP(IDX)
	JRST JSYSER

;Store target truename from JFN in 1, and source truename from 2
;into success packet, to be sent later if we succeed.  Preserves 1.
RENTNM:	PUSH P,1
	PUSH P,2
	MOVEI A,[ASCIZ \RENAME\]
	PUSHJ P,COMCTL
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	HRROI 1,RESBLK		;Target truename
	MOVE 2,-1(P)
	MOVE 3,[111110,,JS%PAF]	;Device, directory, filename, file type, version
	JFNS
	 ERCAL SYSBUG
	PUSHJ P,COMRES
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	HRROI 1,RESBLK		;Source truename
	POP P,2
	MOVE 3,[111110,,JS%PAF]	;Device, directory, filename, file type, version
	JFNS
	 ERCAL SYSBUG
	PUSHJ P,COMRES
POP1J:	POP P,1
	POPJ P,
];END IFN TNX

;;; CONTINUE command.  Continue processing after a recoverable asynchronous error
COMCON:	JUMPGE BC,COMBAD	;Better not have any more stuff
	TRNN F,F.FHN		;Need a file handle
	 JRST COMBAD
	SKIPL A,DATSTA(IDX)	;Channel must be active
CONCCC:	 CERR BUG,[Channel cannot continue]
	MOVEI T,ST%ASY		;Must be in async mark state
	CAIN T,(A)
	 TLNE A,ST.UNC		;And must be continuable
	  JRST CONCCC
	HRRI A,ST%OPN		;Ok, so fix up
	MOVEM A,DATSTA(IDX)
	MOVEI A,[ASCIZ \CONTINUE\]
	PUSHJ P,COMCTL		;Send completion response
	PUSHJ P,COMSND
IFN ITS,[
	.CALL [ SETZ		;Continue the interrupted I/O operation
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATBPT(IDX)
		%CLIN+%CLEND,,DATBCT(IDX)]
	 JRST CONERR		;Another IOC error, didn't really fix the problem
	.SUSET [.SPICLR,,[0]]	;Don't allow interrupts, and the continuation better not
				; do anything that causes them!
]	;END IFN ITS
IFN TNX,[
	PUSHJ P,DOSIO		;Continue I/O operation
	 JRST CONERR
	MOVEI 1,.FHSLF
	DIR
]	;END IFN TNX
	MOVE A,DATSTA(IDX)
	PUSHJ P,@DATICN(IDX)
	MOVEM A,DATSTA(IDX)
IFN ITS,[
	.SUSET [.SPICLR,,[-1]]
	MOVE T,CHABIT(IDX)
	ANDCAM T,SSYDF2		;Update saved copy of DF2 (can't hurt even if not masked)
	TRNE IDX,1		;Undefer interrupts if necessary
	 .SUSET [.SADF2,,T]
	.SUSET [.SIIFPIR,,T]	;Cause interrupt to start the ball rolling
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF		;Turn interrupt system back on
	EIR
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	AIC			;Reenable interrupts on this channel
	IIC			;Force interrupt on channel to start ball rolling
]	;END IFN TNX
	JRST CTLLOP		;Then done

CONERR:
IFN ITS,[
	.SUSET [.SPICLR,,[0]]	;Using shared resources, prevent timing screws
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	DIR
]	;END IFN TNX
	PUSH P,DATICN(IDX)	;Save important stuff over the IOC error emission
	MOVE A,DATSTA(IDX)	;ICCERR wants status in A
	MOVEI D,DATICN-1(IDX)	;And continuation in c(1(D))
	PUSHJ P,[PUSHJ P,ICCERR] ;*K*L*U*D*G*E*
	POP P,DATICN(IDX)
IFN ITS,[
	.SUSET [.SPICLR,,[-1]]
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	EIR
]	;END IFN TNX
	JRST CTLLOP		;Then done

IFN TNX,[
DOSIO:	MOVE 1,DATJFN(IDX)
	MOVE 2,DATBPT(IDX)
	MOVN 3,DATBCT(IDX)
	JUMPE 3,DOSIO1
	TRNE IDX,1
	 JRST DOSIOO		;Output
	SIN
	 ERJMP .+1
DOSIO1: PUSHJ P,ITSBP		;Turn BP in AC2 into an ITS standard byte pointer
	MOVEM 2,DATBPT(IDX)
	MOVNM 3,DATBCT(IDX)
	SKIPN 3			;Means we didn't make it all out
	 AOS (P)
	POPJ P,
DOSIOO:	SOUT
	 ERJMP DOSIO1
	JRST DOSIO1

ITSBP:	PUSH P,T
	LDB T,[360600,,2]	;PP field of BP in AC2
	JUMPN T,ITSBP0		;Some bits left, so is ok
	MOVEI T,44		;Make agree with ITS -- point off left of next word
	DPB T,[360600,,2]
	AOS 2
ITSBP0:	POP P,T
	POPJ P,
]	;END IFN TNX

;;; Directory command
DATNDR==:DATBYT			;Next directory, 0 = start, -1 = done
IFN ITS,[
DATDRP==:DATBPW			;File being processed (index to UFD)
.INSRT SYSTEM;FSDEFS
]	;END IFN ITS
IFN TNX,[
DATDRN==:DATBPW			;Directory number being processed
]

COMPRO:	TRZA F,F.DIR
COMDIR:	 TRO F,F.DIR
	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	TRNN F,F.FHN		;Must have file handle
	 CERR BUG,[Must have a file handle]
	TRNE IDX,1		;Input index?
	 CERR BUG,[Channel wrong direction]
	SKIPGE DATSTA(IDX)
	 PUSHJ P,CLOSIT		;Close open channel
	SETZM DATSTA(IDX)
	MOVSI D,ST.DIR
	TRZN F,F.DIR
	 TLO D,ST.PRO
DIROPT:	TRNE F,F.NWL		;End of options? Or no file handle in PROPERTIES
	 JRST DIRFNM
	TLNE D,ST.PRO
	 JRST COMPR1		;PROPERTIES command with a file handle
	PUSHJ P,COMRD5		;Get token
	 JUMPL BC,COMBAD
DIROLP:	MOVEI T,DIRLEN-1
DIROL1:	CAME A,DIRTAB(T)
	 SOJGE T,DIROL1
	JUMPL T,[CERR UUO,[Unknown DIRECTORY option]]
	XCT DIRACT(T)
	 JRST COMBAD
	JRST DIROPT

DIRTAB:	ASCII \DELET\		;Allow deleted files as well
	ASCII \FAST\
	ASCII \NO-EX\
	ASCII \DIREC\
	Ascii \SORTE\
DIRLEN==.-DIRTAB

DIRACT: TLOA D,ST.DEL
	TLOA D,ST.FST
	SKIPA
	TLOA D,ST.ALD
	SKIPA

;PROPERTIES command with a file handle
COMPR1:	PUSHJ P,COMRD5		;Get file handle
	 JFCL
	JUMPGE BC,COMBAD	;Shouldn't have anything left over	
	MOVEI B,MAXIDX-1	;LOOP OVER ALL INDICES
COMPR2:	CAMN A,DATFHN(B)	;MATCH?
	 JRST COMPR3		;YUP
	SOJGE B,COMPR2
	CERR BUG,[Unknown file handle argument to PROPERTIES]
COMPR3:	
IFN TNX,[
	MOVE 1,DATJFN(B)
	TLZ D,ST.NOK
	JRST SVDFLG

;PROPERTIES command with a file name joins
COMPR4: TLO D,ST.DEL\ST.NOK	;ST.NOK means we have a JFN to get rid of
	PUSHJ P,COMGJF		;Get JFN in AC1
	 PUSHJ P,JSYSER
	JRST SVDFLG
];TNX

IFN ITS,[
	MOVE B,DATCHN(B)
	.CALL [ SETZ		;Need device and directory names
		SIXBIT /RFNAME/
		%CLIN,,B
		%CLOUT,,DATDEV(IDX)
		%CLOUT,,DATFN1(IDX)
		%CLOUT,,DATFN2(IDX)
		%CLOUT+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,SYSBUG
	JRST COMPR5

;PROPERTIES command with a file name joins
COMPR4:	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW,,.UAI+30		;preserve dates, inhibit links
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN,,DATFN2(IDX)
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR
	MOVE B,DATCHN(IDX)
COMPR5:	MOVEM B,DATFN1(IDX)		;Save channel number in weird place
	JRST COMPR6
];ITS

DIRFNM:
IFN ITS,[
	TLNN D,ST.PRO
	 SETOM STARF2		;We want * for default FN2
	PUSHJ P,COMPFN		;Parse the filename spec
	SETZM STARF2
	SKIPE T,DATSNM(IDX)	;KEEP STICKY DEFAULT DIRECTORY
	 .SUSET [.SSNAME,,T]
	TLNE D,ST.PRO
	 JRST COMPR4
	MOVSI T,(SIXBIT/*/)
	SKIPN DATFN1(IDX)
	  MOVEM T,DATFN1(IDX)
COMPR6:	PUSHJ P,LCKDIR		;Get DIRLCK
	PUSHJ P,GETMFD		;Read in the MFD
	 PUSHJ P,[ HLRZ A,DATDEV(IDX)	;Archive devices just say they cannot work.
		   TRZ A,77
		   CAIE A,(SIXBIT /AR/)
		    JRST [ SETZM DIRLCK ? JRST FILERR ]
		   MOVEI A,[ASCIZ \ERROR \]
		   PUSHJ P,COMCTL          ;Start off error packet, open failed error code
		   MOVEI A,[ASCIZ \WKF F CANNOT LIST ARCHIVE DEVICE\]
		   PUSHJ P,COMSTO
		   PUSHJ P,COMSND
		   JRST CTLLOP ]

;The following might be nice, but the directory format of archives is evidently
;not 100% compatible since we get an MPV trying to look at the descriptors.
;So we give an error if we try to take the directory of an archive.
;Note that it is necessary to read in the MFD even if the sname is not wildcarded,
;since the MFD is needed to decode file authors.

IFN 0,[	 PUSHJ P,[ HLRZ A,DATDEV(IDX)	;Kludge around for archives
		   TRZ A,77
		   CAIE A,(SIXBIT/AR/)
		    JRST [ SETZM DIRLCK ? JRST FILERR ]	;Device doesn't exist?
		   PUSH P,DATDEV(IDX)
		   MOVSI A,'DSK
		   MOVEM A,DATDEV(IDX)
		   PUSHJ P,GETMFD
		    JRST [ POP P,DATDEV(IDX) ? SETZM DIRLCK ? JRST FILERR ]
		   POP P,DATDEV(IDX)
		   POPJ P, ]
];IFN 0

;; Allocate space for directory mapping
	MOVEI T,DIRBUF/2000
	PUSHJ P,PAGALO
	SETZM DATDRP(IDX)
]	;END IFN ITS

IFN TNX,[
	TLNE D,ST.PRO
	 JRST COMPR4
	TLNE D,ST.ALD
	 JRST [	TLO D,ST.PON	;Do parse only
		SETZM DATDRN(IDX)
		JRST .+1]
	PUSHJ P,COMGDJ		;Get directory JFN, with wildcards
	 JRST DIREMP

SVDFLG:	MOVEM 1,DATJFN(IDX)	;Save it,
DRNFIL:
]	;END IFN TNX
IFN ITS,[
	PUSHJ P,DIRSI2		;See if dir exists.
	 PUSHJ P,FILERR		;Failure.
];ITS
	SETZM DATNDR(IDX)	;Success, or hard to tell.  Will start listing next time around
	HLLM D,DATSTA(IDX)	;Save status bits
	MOVEI A,[ASCIZ \DIRECTORY\]
	TLNE D,ST.PRO
	 MOVEI A,[ASCIZ \PROPERTIES\]
	PUSHJ P,COMCTL
	JRST OPNFPS		;Finish up like open

IFN TNX,[
;GTJFN error code in 1
DIREMP:	SETZM DATJFN(IDX)	;Make sure cleared out from last time.
	CAIE 1,GJFX32		;Directory empty (no files match specification)
	 CAIN 1,GJFX19		;No such file type
	  JRST DRNFIL		;Yes, give directory stream with no files in it
	CAIE 1,GJFX24		;Both Tenex and TOPS-20 can give GJFX24 randomly
	 CAIN 1,GJFX20		;I think only Tenex gives GJFX20
	  JRST DRNFIL
	PUSHJ P,JSYSER		;Some other error - Complain.
];TNX

IFN ITS,[
;Skip if requesting either multiple directories or a single directory which exists.
;Do not skip if requesting a single directory which does not exist.
;If requesting a single directory which exists,
;we also read it in, so you can omit doing so later.
DIRSI2:	MOVE TT,DATSNM(IDX)	;Get directory requested
DIRSI0:	JUMPE TT,DIRSI1		;Simple case, no directory wildcards
	SETZ T,
	LSHC T,6
	CAIE T,'*		;A wildcard specifier?
	 JRST DIRSI0
	JRST POPJ1

;; Simple case, only one directory
;; Try to read it in now; if we fail, report an error now.
DIRSI1:	MOVE A,DATSNM(IDX)
	MOVSI T,ST.ALD
	TDNE T,DATSTA(IDX)	;Just wants directory names, not contents, => skip.
	 JRST POPJ1
	PUSHJ P,GETUF1
	 POPJ P,
	JRST POPJ1
];ITS

;;; Come here from REABUF when need some more input from a directory listing
;;; T has byte pointer to store into, TT has byte count
REDRBF:	PUSH P,A
	PUSH P,B		;Save some ac's
	PUSH P,BC
	PUSH P,BP

;; Directory loop, try to fill buffer with all info on one file, if we run out of room,
;; we back up the pointer to before the current file and return with that
	MOVE BP,T
	MOVE BC,TT
	MOVE D,DATSTA(IDX)
	SKIPN DATNDR(IDX)	;First time?
	 PUSHJ P,DIRHED		;Yes, print header
	PUSH P,BP		;Save byte pointer
	PUSH P,BC		;and counter
	MOVEM P,DIRPDL		;Save stack pointer

REDRB0:	PUSHJ P,DIRFIL		;Do one file
	 JRST REDBF1		;No file to do
	MOVEM BP,-1(P)		;Save updated byte pointer
	MOVEM BC,(P)		;and count
	JRST REDRB0

;; Done filling buffer, restore state and return
REDBF1:	MOVE P,DIRPDL
	POP P,TT		;Restore byte count
	POP P,T			;and pointer
	POP P,BP
	POP P,BC
	POP P,B
	POP P,A
	JRST REABF3		;Return to main body of code

;;; Come here from COMCLO for directory channel
COMCLD:	PUSHJ P,CLOSIT
	MOVEI A,[ASCIZ \CLOSE\]
	PUSHJ P,COMCTL
	JRST CLOLED

;;; Come here from CLOSIT when done with a directory channel
CLODIR:
IFN ITS,[
	MOVE TT,DATFN1(IDX)
	TLNE T,ST.PRO
	 CAME TT,DATCHN(IDX)
	  JRST CLODI1	  
	.CALL [ SETZ		;If we opened a file, close it
		SIXBIT/CLOSE/
		SETZ DATCHN(IDX) ]
	 JFCL
CLODI1:	MOVEI T,MFDBUF/2000
	PUSHJ P,PAGDAL
	MOVEI T,DIRBUF/2000
	PUSHJ P,PAGDAL
	SETZM DIRLCK
	MOVE T,DATSTA(IDX)	;Restore channel status
];END IFN ITS
IFN TNX,[
	TLNE T,ST.PRO
	 TLNN T,ST.NOK
	  JRST CLODI1
	MOVE 1,DATJFN(IDX)	;If we got a JFN, release it
	RLJFN
	 ERJMP .+1
CLODI1:
];TNX
	MOVEI TT,(T)
	CAIN TT,ST%OPN		;Was the channel open?
	 HRRI T,ST%CLO		;Yes, then close it
	MOVEM T,DATSTA(IDX)
	JRST BUFDAL		;Deallocate the core buffer and return

IFN ITS,[
;; Lock the lock for the MFD and UFD pages and associated variables
LCKDIR:	SKIPE T,DIRLCK
	 CAIN IDX,(T)
	 SKIPA
	 CERR NER,[Can't have more than one directory open at a time]
	HRROM IDX,DIRLCK	;Something random
	POPJ P,

;; Map in the MFD
GETMFD:	MOVEI T,MFDBUF/2000
	PUSHJ P,PAGALO
	.CALL [	SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW+%CLIMM,,.UII
		%CLIMM,,UTILCH
		%CLIN,,DATDEV(IDX)
		%CLIN,,[SIXBIT /M.F.D./]
		%CLIN,,[SIXBIT /(FILE)/]
		%CLIN+%CLEND,,DATSNM(IDX)]
	 POPJ P,
	MOVEI T,2000
	MOVE TT,[444400,,MFDBUF]
	.CALL [	SETZ
		SIXBIT /SIOT/
		%CLERR,,ERRCOD
		%CLIMM,,UTILCH
		%CLIN,,TT
		%CLIN+%CLEND,,T]
	 SETZM MFDBUF+MDCHK	;Normally 'M.F.D.
	.CLOSE UTILCH,
	 JFCL
	MOVE T,MFDBUF+MDCHK
	CAMN T,[SIXBIT /M.F.D./]
	 AOS (P)
	POPJ P,
];ITS

;;; Printing routines
IFN ITS,[
;;; Print directory header info
DIRHED:	MOVEI A,[ASCIZ \DONT-REAP NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE\]
	TLNE D,ST.PRO
	 JRST DIRSCL		;PROPERTIES command has abbreviated header
	PUSHJ P,DIRCLF		;Empty pathname for special information
	TLNE D,ST.FST\ST.ALD	;Fast option?
	 JRST DIRHDE		;Yes, skip rest of heading
	MOVEI A,[ASCIZ \SETTABLE-PROPERTIES DONT-REAP NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE\]
	PUSHJ P,DIRSCL
	MOVEI T,2000*36.
	MOVEI A,[ASCIZ \BLOCK-SIZE\]
	PUSHJ P,DIRDEC
	PUSHJ P,DIRFSI
	PUSHJ P,DIRCLF
DIRHDE:	JRST DIRCLF
	
;;; Print one file
DIRFIL:	SKIPGE DATDRP(IDX)	;Anything left at all to do?
	 POPJ P,		;No
	SKIPE DATNDR(IDX)	;Initialized?
	 JRST DIRFL1
	PUSHJ P,DIRINI		;No, do so
	JRST DIRFIL

DIRFL1:	PUSHJ P,DIR1FL		;Directory of one file
	PUSHJ P,DIRNFL		;Step to next file
POPJ1:	AOS (P)
	POPJ P,

DIRINI:	MOVE TT,DATSNM(IDX)	;Get directory requested
DIRIN1:	JUMPE TT,DIRSIM		;Simple case, no directory wildcards
	SETZ T,
	LSHC T,6
	CAIE T,'*		;A wildcard specifier?
	 JRST DIRIN1

;; The directory has some wildcards, figure out which ones to do
CNT==:1				;Temporary AC's for sort
LST==:2
DIRWLD:	SETO LST,		;LIST _ NIL
	SETZ CNT,		;COUNT _ 0
	SKIPA D,MFDBUF+MDNAMP
DIRWL1:	 ADDI D,LMNBLK
	CAIL D,2000
	 JRST DIRWL2		;End of MFD, go sort
	SKIPN TT,MFDBUF(D)
	 JRST DIRWL1
	MOVE B,DATSNM(IDX)
	PUSHJ P,DIRMAT		;Star match
	 JRST DIRWL1		;No good, try next
	MOVEM LST,MFDBUF+1(D)
	MOVEI LST,MFDBUF(D)	;LIST _ CONS(D,LIST)
	AOJA CNT,DIRWL1

;;; Attempt star matching, pattern in B, test in TT.  Clobbers A,T,TT
DIRMAT:	CAME B,[SIXBIT /*/]	;Just * matches all
DIRMT1:	 CAMN B,TT		;The same now?
	 JRST POPJ1		;A winner
	SETZB A,T
	LSHC A,6
	LSHC T,6
	CAIE A,(T)		;Same character
	 CAIN A,'*		;Or * in patter
	 JRST DIRMT1		;Yes, go on
	POPJ P,			;No, a loser

;;; Have all the matching entries linked thru LST, sort them
DIRWST:	CAIN CNT,1		;At end of list?
	 JRST DRWSTR		;Yes, return it
	PUSH P,CNT		;Save count
	LSH CNT,-1
	PUSHJ P,DIRWST		;Recurse for first section
	POP P,CNT
	PUSH P,A		;Save value
	ADDI CNT,1
	LSH CNT,-1
	PUSHJ P,DIRWST		;Recurse for second section
	POP P,B			;Get first value
	MOVEI C,D-1		;Where to accumulate list

;; Merge two sublists
DIRWSM:	JUMPL B,DRWST1		;No first arg, maybe use second
	JUMPL A,DRWSTB		;No second, use first
	MOVE T,(A)		;Get second name
	MOVE TT,(B)		;Get first name
;; Do magnitude comparison
	JUMPL T,DRWSM2		;T neg?
	JUMPL TT,DRWSTA		;No, and TT neg => TT greater
	JRST DRWSMC		;Both pos, just compare

DRWSM2:	JUMPGE TT,DRWSTB	;T neg and TT pos => T greater
	EXCH T,TT		;Both negative, reverse comparison
DRWSMC:	CAML T,TT
	 JRST DRWSTA		;1st greater => take it

DRWSTB:	MOVEM B,1(C)
	MOVEI C,(B)
	MOVE B,1(C)
	JRST DIRWSM

DRWSTA:	MOVEM A,1(C)		;Enter 1st at head
	MOVEI C,(A)		;Transfer it to tail
	MOVE A,1(C)		;Get next one
	JRST DIRWSM		;And continue

DRWST1:	JUMPGE A,DRWSTA		;Use 2nd if any
	SETOM 1(C)
	MOVE A,D
	POPJ P,

DRWSTR:	MOVEI A,(LST)		;A _ CAR(LIST)
	MOVE LST,1(LST)		;LIST _ CDR(LIST)
	SETOM 1(A)		;RPLACD(A,NIL)
	POPJ P,			;RETURN(A)

;; Simple case, only one directory
DIRSIM:	SETOM DATNDR(IDX)	;Flag that there is no next directory
	MOVE T,DATSTA(IDX)
	MOVE A,DATSNM(IDX)
	TLNE T,ST.ALD
	 JRST [	MOVEM A,DATFN1(IDX)	;Someplace to store directory name
		AOS DATDRP(IDX)
		POPJ P,]	;Directories only, skip mapping ufd
;In this special case, we already read in the directory
;when the directory command was processed.  So don't call DIRMAP now.
	MOVE D,DIRBUF+UDNAMP	;Initialize pointer to first file
	TLNN T,ST.PRO
	 JRST DIRNF1		;Then advance to next file
	MOVEI D,2000-LUNBLK	;Make dummy file block for PROPERTIES command
	.CALL [ SETZ
		'FILBLK
		%CLIN,,DATFN1(IDX) 
		%CLOUT,,DIRBUF+0(D)
		%CLOUT,,DIRBUF+1(D)
		%CLOUT,,DIRBUF+2(D)
		%CLOUT,,DIRBUF+3(D)
		%CLOUT+%CLEND,,DIRBUF+4(D)]
	 JRST DIRDIE
	JRST DIRNF4

DIRWL2:	SKIPL A,LST		;If there is anything there,
	 PUSHJ P,DIRWST		;sort it
	MOVEM A,DATNDR(IDX)	;DATNDR _ SORT(LIST)

;; Step to next directory
DIRNDR:	SKIPG A,DATNDR(IDX)	;Next directory link
	 JRST [	SETOM DATDRP(IDX)	;Flag that no files are left to do
		POPJ P,]	;Single return for no more
	MOVE T,1(A)
	MOVEM T,DATNDR(IDX)
	MOVE A,(A)		;Sixbit directory name

;; Start going on directory in A
DIRMAP:	MOVSI T,ST.ALD
	TDNE T,DATSTA(IDX)
	 JRST [	MOVEM A,DATFN1(IDX)	;Someplace to store directory name
		AOS DATDRP(IDX)
		POPJ P,]	;Directories only, skip mapping ufd
	PUSHJ P,GETUF1
	 JRST DIRDIE
	MOVE D,DIRBUF+UDNAMP	;Initialize pointer to first file
	JRST DIRNF1		;Then advance to next file

;;; Here if we can't get a directory.  Give an error over the connection and punt.
DIRDIE:	PUSH P,PKTLOC		;Direct data to the async packet
	MOVEI T,ASYPKT
	MOVEM T,PKTLOC
	MOVE A,DATSTA(IDX)
	HRRI A,ST%ASY		;Channel now in ASYNC-MARKED state
	TLO A,ST.UNC		;Not continuable
	MOVEM A,DATSTA(IDX)
	TRO F,F.FHN		;Force outputting of a file handle
	PUSH P,[DIRDIE+2]
	PUSHJ P,OPNERP
	PUSHJ P,ICCERP
	POP P,PKTLOC
	SETOM DATDRP(IDX)
	POPJ P,

;;; Map in directory in A
GETUFD:	MOVEI T,DIRBUF/2000	;Allocate space for directory mapping
	PUSHJ P,PAGALO
GETUF1:	.CALL [ SETZ
		SIXBIT /IOPUSH/
		%CLIN+%CLEND,,DATCHN(IDX) ]
	 PUSHJ P,SYSBUG
	.CALL [	SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW+%CLIMM,,.UII
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,[SIXBIT /.FILE./]
		%CLIN,,[SIXBIT /(DIR)/]
		%CLIN+%CLEND,,A]
	 JRST GETUF2
	MOVEI T,2000
	MOVE TT,[444400,,DIRBUF]
	.CALL [	SETZ
		SIXBIT /SIOT/
		%CLERR,,ERRCOD
		%CLIN,,DATCHN(IDX)
		%CLIN,,TT
		%CLIN+%CLEND,,T]
	 SETZM DIRBUF+UDNAME
	.CALL [	SETZ
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL
	SKIPE DIRBUF+UDNAME
	 AOS (P)
GETUF2:	.CALL [ SETZ
		SIXBIT /IOPOP/
		%CLIN+%CLEND,,DATCHN(IDX) ]
	 PUSHJ P,SYSBUG
	POPJ P,

;;; Step to next file
DIRNFL:	MOVE D,DATDRP(IDX)
	MOVSI T,ST.ALD
	TDNE T,DATSTA(IDX)
	 JRST [	JUMPE D,DIRNDR	;If directory already done, move to next
		POPJ P,]	;Else continue with it
DIRNF0:	ADDI D,LUNBLK
DIRNF1:	TLNE D,-1
	 HLRZS D		;D now points to next file to do
	CAIL D,2000		;Off the end?
	 JRST DIRNDR		;Yes, step to next directory
	MOVE B,DATFN1(IDX)	;Match FN1
	MOVE TT,DIRBUF+UNFN1(D)
	PUSHJ P,DIRMAT
	 JRST DIRNF0
	MOVS B,DATFN2(IDX)	;Newest or oldest version requested?
	CAIE B,(SIXBIT/</)
	 CAIN B,(SIXBIT/>/)
	  JRST DIRNF2
	MOVE B,DATFN2(IDX)	;Match FN2
	MOVE TT,DIRBUF+UNFN2(D)
	PUSHJ P,DIRMAT
	 JRST DIRNF0
DIRNF4:	MOVEM D,DATDRP(IDX)
	POPJ P,

;;; Next file when only want newest or oldest version of each file.
;;; Matching -only- files with numeric versions seems to be what people want.
;;; We used to include every file with a non-numeric FN2, to be conservative.
;;; DATDRP(IDX) is either the index of the file, or the index
;;; of the next file group in the LH and garbage in the RH.
DIRNF2:	MOVE TT,DIRBUF+UNFN2(D)
	PUSHJ P,DIRNMP		;Is this a group of versions?
	 JRST DIRNF0		;No, just a single file, skip it
	MOVE A,DIRBUF+UNFN1(D)	;Yes, find end of the group
	MOVEI B,(D)
DIRNF3:	ADDI B,LUNBLK
	CAIGE B,2000
	 CAME A,DIRBUF+UNFN1(B)
	  JRST DIRNF5
	MOVE TT,DIRBUF+UNFN2(B)
	PUSHJ P,DIRNMP
	 CAIA
	  JRST DIRNF3
DIRNF5:	HRL D,B			;File to look at next time
	MOVS TT,DATFN2(IDX)	;Want oldest of these or newest?
	CAIN TT,(SIXBIT/>/)
	 SKIPA C,[CAMGE TT,A]
	  MOVE C,[CAMLE TT,A]
	MOVE A,DIRBUF+UNFN2(D)	;Get right-adjusted version of first file
	TRNN A,77
	 JUMPN A,[ LSH A,-6
		   JRST .-1 ]
	MOVEI T,(D)
DIRNF6:	ADDI T,LUNBLK
	CAIL T,(B)		;More versions in group?
	 JRST DIRNF4		;No, D points at best one found
	MOVE TT,DIRBUF+UNFN2(T)	;Get right-adjusted version of this file
	TRNN TT,77
	 JUMPN TT,[ LSH TT,-6
		    JRST .-1 ]
	XCT C			;Skip if TT is better than A
	 JRST DIRNF6		;A,D is still best version
	MOVE A,TT		;New best version
	HRRI D,(T)		;New file to put in dir listing
	JRST DIRNF6

;Skip if sixbit in TT is purely numeric
DIRNMP:	MOVEI T,0
	LSHC T,6
	CAIL T,'0
	 CAILE T,'9
	  POPJ P,
	JUMPN TT,DIRNMP
	JRST POPJ1	

;;; Process one file
DIR1FL:	MOVE TT,DATSTA(IDX)
	TLNE TT,ST.ALD
	 JRST DIR1AD
	MOVE T,DIRBUF+UNRNDM(D)
	TLNE T,UNIGFL		;This file deleted?
	 TLNE TT,ST.DEL\ST.PRO	;Yes, list anyway?
	  SKIPA A,DATDEV(IDX)
	   POPJ P,		;No, don't output anything
	PUSHJ P,DIRSXO
	MOVEI A,[ASCIZ \: \]
	PUSHJ P,DIRSTR
	MOVE A,DIRBUF+UDNAME
	PUSHJ P,DIRSXO
	MOVEI A,[ASCIZ \; \]
	PUSHJ P,DIRSTR
	MOVE D,DATDRP(IDX)	;Get pointer to file
	MOVE A,DIRBUF+UNFN1(D)
	PUSHJ P,DIRSXO
	MOVEI BYTE,40
	PUSHJ P,DIRCHO
	MOVE A,DIRBUF+UNFN2(D)
	PUSHJ P,DIRSXO
	PUSHJ P,DIRCLF
	MOVSI TT,ST.FST
	TDNE TT,DATSTA(IDX)	;Fast option?
	 JRST DIR1FE		;Yes, skip rest
	MOVE T,DIRBUF+UNRNDM(D)
	TLNE T,UNLINK		;Is this file a link?
	 JRST DIR1LN		;Yes, special processing
	TLNN T,UNIGFL		;* file?
	 JRST DIR1F1		;No, ordinary
	MOVEI A,[ASCIZ \DELETED\]
	PUSHJ P,DIRSCL
DIR1F1:	TLNN T,UNREAP
	 JRST DIR1F2
	MOVEI A,[ASCIZ \DONT-REAP\]
	PUSHJ P,DIRSCL
DIR1F2:	TLNE T,UNDUMP
	 JRST DIR1F3
	MOVEI A,[ASCIZ \NOT-BACKED-UP\]
	PUSHJ P,DIRSCL
DIR1F3:	LDB T,[UNPKN DIRBUF+UNRNDM(D)]
	MOVEI A,[ASCIZ \PHYSICAL-VOLUME\]
	PUSHJ P,DIRDEC
	MOVEI T,2000*36.
	MOVEI A,[ASCIZ \BLOCK-SIZE\]
	PUSHJ P,DIRDEC
	PUSHJ P,DIRLN0		;Length in blocks into T
	MOVSI TT,ST.PRO
	TDNE TT,DATSTA(IDX)
	 PUSHJ P,DIR1F5		;PROPERTIES command, dir may have changed
	PUSH P,T		;Save it
	MOVEI A,[ASCIZ \LENGTH-IN-BLOCKS\]
	PUSHJ P,DIRDEC
	POP P,T			;Length in blocks
	LDB TT,[UNWRDC DIRBUF+UNRNDM(D)]	;Word count of last block
	SKIPE TT
	 SUBI T,1
	LSH T,10.
	ADDI T,(TT)		;Word count now in T
	PUSH P,T
	LDB T,[UNBYTE DIRBUF+UNREF(D)]	;Byte size info
	TRZE T,400
	 JRST [	IDIVI T,100	;400+100xS+C
		JRST DIR1F4]
	TRZE T,200
	 JRST [	IDIVI T,20	;200+20xS+C
		JRST DIR1F4]
	SUBI T,36.
	 JUMPGE T,[IDIVI T,4	;44+4xS+C
		   JRST DIR1F4]
	MOVMS T			;44-S
	SETZ TT,		;C=0
DIR1F4:	PUSH P,TT		;Save number of extra bytes
	PUSH P,T		;Save byte size
	MOVEI A,[ASCIZ \BYTE-SIZE\]
	PUSHJ P,DIRDEC
	MOVEI T,36.
	IDIV T,(P)		;Number of words per byte
	IMUL T,-2(P)		;Times number of words
	SUB T,-1(P)		;Less number of extra bytes
	SUB P,[3,,3]
	MOVEI A,[ASCIZ \LENGTH-IN-BYTES\]
	PUSHJ P,DIRDEC

DIR1FD:	MOVE T,DIRBUF+UNDATE(D)
	MOVEI A,[ASCIZ \CREATION-DATE\]
	PUSHJ P,DIRDAT
	HLLZ T,DIRBUF+UNREF(D)
	MOVEI A,[ASCIZ \REFERENCE-DATE\]
	PUSHJ P,DIRDAT
	LDB T,[UNAUTH DIRBUF+UNREF(D)]
	CAIN T,777		;No author?
	 JRST DIR1FE
	SUB T,MFDBUF+MDNUDS
	ASH T,1
	SKIPN T,MFDBUF+2000(T)	;Get sixbit directory name
	 JRST DIR1FE
	MOVEI A,[ASCIZ \AUTHOR\]
	PUSHJ P,DIRIND
	MOVE A,T
	PUSHJ P,DIRSXO
	PUSHJ P,DIRCLF
DIR1FE:	JRST DIRCLF

DIR1F5:	.CALL [ SETZ
		'FILLEN
		%CLIN,,DATFN1(IDX)
		%CLOUT,,T		;Length in bytes
		%CLOUT+%CLEND,,TT]	;Byte size
	 JRST DIRDIE
	MOVEI A,36.
	IDIVM A,TT
	IDIV T,TT		;Length in words
	ADDI T,1777
	LSH T,-10.
	POPJ P,

;; Link info output
DIR1LN:	MOVEI A,[ASCIZ \LINK-TO\]
	PUSHJ P,DIRIND
	PUSHJ P,DIRDSC		;Get link descriptor
	PUSHJ P,DIRLXO
	MOVEI BYTE,";
	PUSHJ P,DIRCHO
	MOVEI BYTE,40
	PUSHJ P,DIRCHO
	PUSHJ P,DIRLXO
	MOVEI BYTE,40
	PUSHJ P,DIRCHO
	PUSHJ P,DIRLXO
	PUSHJ P,DIRCLF
	JRST DIR1FD		;Return to main body

;;; Output link atom  b.p. in A
DIRLXO:	MOVEI T,6		;End on six characters
DIRLX0:	ILDB BYTE,A
	JUMPE BYTE,CPOPJ
	CAIN BYTE,';		; ; ends
	 POPJ P,
	CAIN BYTE,':		; : quotes
	 ILDB BYTE,A
	ADDI BYTE,40
	PUSHJ P,DIRCHO
	SOJG T,DIRLX0
	POPJ P,

;;; Get length in blocks into T
DIRLN0:	PUSHJ P,DIRDSC		;Get ufd descriptor
	MOVEI T,0
DIRLN1:	ILDB B,A
	JUMPE B,CPOPJ		;End by 0
	CAILE B,UDTKMX		;1-UDTKMX
	 JRST DIRLN2
	ADDI T,(B)		;Take N
	JRST DIRLN1

DIRLN2:	CAIGE B,UDWPH
	 AOJA T,DIRLN1		;Take 1
	CAIN B,UDWPH		;Write place holder
	 JRST DIRLN1
	IBP A
	IBP A
	AOJA T,DIRLN1

;;; Get file descriptor into A.  Clobbers B
DIRDSC:	LDB A,[UNDSCP DIRBUF+UNRNDM(D)]	;Get link descriptor
	IDIVI A,UFDBPW
	ADD A,[	440600,,DIRBUF+UDDESC
		360600,,DIRBUF+UDDESC
		300600,,DIRBUF+UDDESC
		220600,,DIRBUF+UDDESC
		140600,,DIRBUF+UDDESC
		060600,,DIRBUF+UDDESC](B)
	POPJ P,

;;; Directory output, just listing all directories.
;;; DATDRP is the directory name while it is pending, 0 while waiting for the next one.
DIR1AD:	MOVE A,DATDEV(IDX)
	PUSHJ P,DIRSXO
	MOVEI A,[ASCIZ \: \]
	PUSHJ P,DIRSTR
	MOVE A,DATFN1(IDX)
	PUSHJ P,DIRSXO
	MOVEI A,[ASCIZ \; \]
	PUSHJ P,DIRSTR
	PUSHJ P,DIRCLF
	PUSHJ P,DIRCLF
	SETZM DATDRP(IDX)
	POPJ P,

;;; SIXBIT output from A
DIRSXO:	MOVE B,A
DIRSO0:	JUMPE B,CPOPJ
	SETZ A,
	LSHC A,6
	JUMPE A,DIRSOQ
	CAIE A,':
	 CAIN A,';
	 JRST DIRSOQ
DIRSO1:	MOVEI BYTE,40(A)
	PUSHJ P,DIRCHO
	JRST DIRSO0

DIRSOQ:	MOVEI BYTE,"
	PUSHJ P,DIRCHO
	JRST DIRSO1
]	;END IFN ITS

IFN TNX,[
DIRHED:
IFN 20X,MOVEI A,[ASCIZ \NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE BYTE-SIZE LENGTH-IN-BYTES PROTECTION GENERATION-RETENTION-COUNT ACCOUNT TEMPORARY DELETED DONT-DELETE DONT-REAP\]
IFN 10X,MOVEI A,[ASCIZ \NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE BYTE-SIZE LENGTH-IN-BYTES PROTECTION GENERATION-RETENTION-COUNT ACCOUNT TEMPORARY DELETED DONT-DELETE\]
	TLNE D,ST.PRO
	 JRST DIRSCL		;PROPERTIES command has abbreviated header
	PUSHJ P,DIRCLF		;Empty pathname for special information
	TLNE D,ST.FST\ST.ALD	;Fast option?
	 JRST DIRHDE		;Yes, skip rest of heading
	MOVEI A,[ASCIZ \SETTABLE-PROPERTIES NOT-BACKED-UP AUTHOR CREATION-DATE REFERENCE-DATE BYTE-SIZE LENGTH-IN-BYTES PROTECTION GENERATION-RETENTION-COUNT ACCOUNT TEMPORARY DELETED DONT-DELETE\]
IFN 20X,[
	PUSHJ P,DIRSTR
	MOVEI A,[ASCIZ \ DONT-REAP\]
];20X
	PUSHJ P,DIRSCL
	PUSHJ P,DIRFSI
	PUSHJ P,DIRCLF
DIRHDE:	PUSHJ P,DIRCLF
	AOS DATNDR(IDX)
	POPJ P,

DIRFIL:	SKIPN DATJFN(IDX)	;Still have a file?
	 POPJ P,		;No, cannot fill in anything
	MOVSI TT,ST.ALD
	TDNE TT,DATSTA(IDX)
	 JRST DIRALD
	HRROI 1,RESBLK
	HRRZ 2,DATJFN(IDX)
	MOVE 3,[111110,,JS%PAF]
	JFNS
	PUSHJ P,DIRRES
	PUSHJ P,DIRCLF
	MOVSI TT,ST.FST
	TDNE TT,DATSTA(IDX)	;Fast option?
	 JRST DIRFLE		;Yes, skip rest
	HRRZ 1,DATJFN(IDX)
IFN 20X,MOVSI 2,.FBLEN
.ELSE,	MOVSI 2,.FBUSW+1
	MOVEI 3,DIRINF
	GTFDB
	 ERCAL JSYSER
	MOVE T,DIRINF+.FBCTL	;Get control bits
	MOVSI TT,-NDBITS
DIRFLL:	TDNN T,DIRBIT(TT)
	 JRST DIRFL1
	MOVE A,DIRBST(TT)
	PUSHJ P,DIRSCL
DIRFL1:	AOBJN TT,DIRFLL	
	HRRZ T,DIRINF+.FBPRT
	MOVEI A,[ASCIZ \PROTECTION\]
	PUSHJ P,DIROCT
	LDB T,[<.BP FB%RET> DIRINF+.FBBYV]
	MOVEI A,[ASCIZ \GENERATION-RETENTION-COUNT\]
	PUSHJ P,DIRDEC
	LDB T,[<.BP FB%BSZ> DIRINF+.FBBYV]
	MOVEI A,[ASCIZ \BYTE-SIZE\]
	PUSHJ P,DIRDEC
	MOVE T,DIRINF+.FBSIZ
	MOVEI A,[ASCIZ \LENGTH-IN-BYTES\]
	PUSHJ P,DIRDEC
	MOVEI T,1000*36.
	MOVEI A,[ASCIZ \BLOCK-SIZE\]
	PUSHJ P,DIRDEC
	LDB T,[<.BP FB%PGC> DIRINF+.FBBYV]
	MOVEI A,[ASCIZ \LENGTH-IN-BLOCKS\]
	PUSHJ P,DIRDEC
	MOVE T,DIRINF+.FBWRT	;Really time of last write
	MOVEI A,[ASCIZ \CREATION-DATE\]
	PUSHJ P,DIRDAT
	MOVEI A,[ASCIZ \REFERENCE-DATE\]
	SKIPE T,DIRINF+.FBREF
	 PUSHJ P,DIRDAT
	MOVEI A,[ASCIZ \NOT-BACKED-UP\]
	SKIPN DIRINF+.FBBK0
	 PUSHJ P,DIRSCL
	MOVSI T,(AR%NAR)
	MOVEI A,[ASCIZ \DONT-REAP\]
	TDNE T,DIRINF+.FBBBT
	 PUSHJ P,DIRSCL
	HRRZ 1,DATJFN(IDX)
IFN 20X,[
	HRLI 1,.GFLWR		;Really last writer
	HRROI 2,RESBLK
	GFUST
	MOVEI A,[ASCIZ \AUTHOR\]
	PUSHJ P,DIRRCL

IRP NAM,,[FBTP1,FBSS1,FBTP2,FBSS2]
	MOVEI A,[ASCIZ \NAM\]
	SKIPE T,DIRINF+.!NAM
	 PUSHJ P,DIROCT
TERMIN

]
IFN 10X,[
	HRROI 1,RESBLK
	HLRZ 2,DIRINF+.FBUSE	;Author
	DIRST
	 JRST .+3
	MOVEI A,[ASCIZ \AUTHOR\]
	PUSHJ P,DIRRCL
	HRROI 1,RESBLK
	HRRZ 2,DIRINF+.FBUSE	;Last reader
	DIRST
	 JRST .+3
	MOVEI A,[ASCIZ \READER\]
	PUSHJ P,DIRRCL
]
	HRROI 1,RESBLK
	HRRZ 2,DATJFN(IDX)
	MOVEI 3,JS%ACT
	JFNS
	MOVEI A,[ASCIZ \ACCOUNT\]
	PUSHJ P,DIRRCL

;; Done with this file, output blank line
DIRFLE:	MOVE 1,DATJFN(IDX)
	GNJFN
	 SETZM DATJFN(IDX)
DIRFE1:	PUSHJ P,DIRCLF
	AOS DATNDR(IDX)
POPJ1:	AOS (P)			;Skip return for full file
	POPJ P,	

DIRALD:	SKIPE 2,DATDRN(IDX)	;Have a directory number already?
	 JRST DIRAL1
	PUSHJ P,DIRSTP
	 POPJ P,
DIRAL1:	HRROI 1,RESBLK
	DIRST
	 JRST DIRAL2
IFN 10X,[
	MOVEI A,[ASCIZ /DSK:</]	;>
	PUSHJ P,DIRSTR
];10X
	MOVEI A,RESBLK
	PUSHJ P,DIRSTR
IFN 10X,[			;<
	MOVEI BYTE,">
	PUSHJ P,DIRCHO
];10X
	PUSHJ P,DIRCLF
DIRAL2:	PUSHJ P,DIRSTP
	 SETZM DATDRN(IDX)
	JRST DIRFE1

DIRSTP:	HRROI 1,RESBLK
	MOVE 2,DATJFN(IDX)
IFN 10X,MOVSI 3,(JS%DIR)
.ELSE	MOVE 3,[JS%DEV+JS%DIR+JS%PAF]
	JFNS
	MOVSI 1,(RC%AWL)
	HRROI 2,RESBLK
	SKIPE 3,DATDRN(IDX)
	 TLO 1,(RC%STP)
	RCDIR
	MOVEM 3,DATDRN(IDX)
	MOVE 2,3		;Return in 2
	TLNN 1,(RC%NMD\RC%NOM)
	 JRST POPJ1
	PUSHJ P,RELDJF
	POPJ P,

DIRBIT:	FB%TMP
	FB%DEL
IFN 20X,[
	FB%DIR
	FB%NOD
	FB%OFF
IFDEF FB%NDL,FB%NDL		; Twenex release 5 has new name and value
.ELSE [
 IFDEF FB%UND,FB%UND
 .ELSE	FB%PRM
 ]
];20X
.ELSE	400,,0
NDBITS==:.-DIRBIT

DIRBST:	[ASCIZ \TEMPORARY\]
	[ASCIZ \DELETED\]
IFN 20X,[
	[ASCIZ \DIRECTORY\]
	[ASCIZ \DONT-DUMP\]
	[ASCIZ \OFFLINE\]
];20X
	[ASCIZ \DONT-DELETE\]

;;; Output string in A, then RESBLK, then newline
DIRRCL:	PUSHJ P,DIRIND
	PUSHJ P,DIRRES
	JRST DIRCLF
]	;END IFN TNX

;;; Output indicator
DIRIND:	PUSHJ P,DIRSTR
	MOVEI BYTE,40
	JRST DIRCHO

;;; Output date in T with indicator in A
DIRDAT:	PUSHJ P,DIRIND
	MOVE A,T
	PUSHJ P,DIRDTO
	JRST DIRCLF

;;; Output octal number in T for property indicator in A
;;; NOTE: This function knows about returning from its caller
DIROCT:	SKIPA B,[8]
DIRDEC:	 MOVEI B,10.
	PUSHJ P,DIRIND
	PUSHJ P,DIRNUM
	JRST DIRCLF

;;; Just output number in T base in B
DIRNUM: PUSH P,[-1]
	JUMPGE T,DIRNM0
	MOVEI BYTE,"-
	PUSHJ P,DIRCHO
	MOVNS T
	TLZ T,400000
DIRNM0:	IDIVI T,(B)
	PUSH P,TT
	JUMPN T,DIRNM0
DIRNM1:	POP P,BYTE
	JUMPL BYTE,CPOPJ
	ADDI BYTE,"0
	PUSHJ P,DIRCHO
	JRST DIRNM1

DIRSCL:	PUSHJ P,DIRSTR
DIRCLF:	MOVEI A,[.BYTE 7 ? ^M ? ^J]
	JRST DIRSTR

IFN TNX,DIRRES: SKIPA A,[440700,,RESBLK]
DIRSTR:	HRLI A,440700
DIRST1:	ILDB BYTE,A		;Get next character
	JUMPE BYTE,CPOPJ	;Terminate on null
	PUSHJ P,DIRCHO
	JRST DIRST1

DIRCHO:	SOJLE BC,REDBF1		;Unwind when buffer filled
	IDPB BYTE,BP
	POPJ P,

;;; FILE-SYSTEM-INFO command
;;; The info had better all fit in one packet, or all hell will break loose!

COMFSI:	MOVEI A,[ASCIZ \FILE-SYSTEM-INFO \]
	PUSHJ P,COMCTL
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	SUBI BC,CHPMXC
	MOVNS BC		;So DIRCHO will act like COMCHO
IFN 20X,MOVEI IDX,MAXIDX
	PUSHJ P,DIRFSI	
	SUBI BC,CHPMXC
	MOVNS BC
	PUSHJ P,COMSND
	JRST CTLLOP

DIRFSI:
IFN 10X,[
	MOVEI A,[ASCIZ\DISK-SPACE-DESCRIPTION \]
	PUSHJ P,DIRSTR
	HRLOI 1,.DVDES+.DVDSK	;DSK: DESIGNATOR
	GDSKC			;1 gets pages used, 2 gets pages left
	ADD 1,2
	MOVEI B,10.
	MOVE T,2
	PUSHJ P,DIRNUM
	MOVEI A,[ASCIZ\ disk pages free out of \]
	PUSHJ P,DIRSTR
	MOVE T,1
	PUSHJ P,DIRNUM
	MOVEI A,[ASCIZ\ (\]
	PUSHJ P,DIRSTR
	MOVE T,1
	SUB T,2
	IMULI T,100.
	IDIV T,1
	PUSHJ P,DIRNUM
	MOVEI A,[ASCIZ\% full)\]
	JRST DIRSTR
];10X
IFN 20X,[
	MOVEI A,[ASCIZ\DISK-SPACE-DESCRIPTION \]
	PUSHJ P,DIRSTR
	HRRZ 2,DATJFN(IDX)
	JUMPE 2,FRESTR		;Not really anything here, no JFN.
	MOVSI 1,(RC%EMO)
	RCDIR
	TLNE 1,(RC%NOM)
	  JRST FRESTR		;No match, presumably wildcard was used.
	MOVE 1,3
	GTDAL			;Get directory allocation.
	MOVEI B,10.
	MOVE T,2		;Permanent quota
	PUSHJ P,DIRNUM
	MOVEI A,[ASCIZ / used, /]
	PUSHJ P,DIRSTR
	CAML 3,[377777,,0]
	  JRST [MOVEI A,[ASCIZ /+INF/]
		PUSHJ P,DIRSTR
		JRST .+3]
	  MOVE T,3
	  PUSHJ P,DIRNUM
	MOVEI A,[ASCIZ / allowed. /]
	PUSHJ P,DIRSTR
FRESTR:	MOVE 1,[SIXBIT /DEVNAM/]
	SYSGT
	HRRZ D,2		;Table#
	MOVEI C,1		;Should be 1st device name.
GSTRNM:	HRLZ 1,C
	HRR 1,D			;Offset,,table#
	GETAB
	  JFCL
;;This won't work if # of structures = STRN!
;;	HLRZ 2,1		;If no more devices, it's SIXBIT/STRnnn/
;;	CAIN 2,(SIXBIT /STR/)
;;	 JRST [	MOVEI A,[ASCIZ/ disk pages free./]
;;		JRST DIRSTR ]
	MOVE 3,[440700,,STRNAM]
ST6TO7:	SETZ 2,			;Turn sixbit structure name into asciz
	ROTC 1,6		;string.
	ADDI 2,40
	IDPB 2,3
	JUMPN 1,ST6TO7
	SETZ 2,
	IDPB 2,3		;Null terminate.
;;Start of UTexas change
	HRROI 1,STRNAM		;Set up to get device designator
	STDEV
	  ERJMP ENDSTR
	MOVE 1,2		;Set up device designator
	MOVEM 1,DEVDEG		;Save device designator for later
	DVCHR			;Check device type
	  ERJMP ENDSTR
	LDB 3,[221100,,2]	;Get DV%TYP
	CAIE 3,.DVDSK		;Is it a disk?
	  JRST ENDSTR		;No
;;End of UTexas change
	MOVEI BYTE,40
	PUSHJ P,DIRCHO
	PUSHJ P,DIRCHO
	MOVEI A,STRNAM
	PUSHJ P,DIRSTR
	MOVEI BYTE,":		;<sp><sp>STRUCTURE:<sp>nnnnn
	PUSHJ P,DIRCHO
	MOVEI BYTE,40
	PUSHJ P,DIRCHO
	MOVE 1,DEVDEG		;[UTexas] Restore device designator
	GDSKC
	MOVE T,2		;Free
	MOVEI B,10.
	PUSHJ P,DIRNUM
GNSTRN:	AOJA C,GSTRNM		;Step to next structure.

ENDSTR:	MOVEI A,[ASCIZ/ disk pages free./]
	JRST DIRSTR
];20X
IFN ITS,[
	MOVEI A,[ASCIZ \PHYSICAL-VOLUME-FREE-BLOCKS\]
	PUSHJ P,DIRSTR
	MOVE T,[SQUOZE 0,NQS]
	.EVAL T,
	 .LOSE %LSSYS
	MOVSI C,-1
	TLC C,-1(T)		;AOBJN pointer
	MOVE T,[SQUOZE 0,QSFT]
	.EVAL T,
	 .LOSE %LSSYS
	PUSH P,T
	MOVE T,[SQUOZE 0,QPKID]
	.EVAL T,
	 .LOSE %LSSYS
	PUSH P,T
	MOVEI B,10.
DIRFR0:	MOVE TT,(P)		;QPKID
	ADDI TT,(C)		;(Q)
	MOVSS TT
	HRRI TT,T
	.GETLOC TT,
	JUMPL T,DIRFR1
	MOVEI BYTE,",
	TRNN C,-1
	 MOVEI BYTE,40
	PUSHJ P,DIRCHO
	PUSHJ P,DIRNUM
	MOVEI BYTE,":
	PUSHJ P,DIRCHO
	MOVE TT,-1(P)		;QSFT
	ADDI TT,(C)		;(Q)
	MOVSS TT
	HRRI TT,T
	.GETLOC TT,
	PUSHJ P,DIRNUM
DIRFR1:	AOBJN C,DIRFR0
	SUB P,[2,,2]
	POPJ P,
];ITS

;;; Filename completion command
COMCPL:	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	SETZ D,			;Clear options here
CPLOPT:	TRNE F,F.NWL		;End of options?
	 JRST CPLFNM
	PUSHJ P,COMRD5		;Get token
	 JUMPL BC,COMBAD
CPLOLP:	MOVEI T,CPLLEN-1
CPLOL1:	CAME A,CPLTAB(T)
	 SOJGE T,CPLOL1
	JUMPL T,[CERR UUO,[Unknown COMPLETE option]]
	XCT CPLACT(T)
	 JRST COMBAD
	JRST CPLOPT

CPLTAB:	ASCII \DELET\
	ASCII \READ\
	ASCII \WRITE\
	ASCII \OLD\
	ASCII \NEW-O\
CPLLEN==.-CPLTAB

CPLACT: TLOA D,ST.DEL
	TLZA D,ST.OUT
	TLOA D,ST.OUT
	TLZA D,ST.NOK
	TLOA D,ST.NOK

IFN TNX,[
;;; Local storage
DEFDEV==RESBLK
DEFDIR==DEFDEV+1
DEFNAM==DEFDIR+1
DEFTYP==DEFNAM+1
DEFSTR==DEFTYP+1

;Parse only GTJFN doesn't quite work on Tenex
;So, if we get no such device or no such directory, flush that all together and
;hope the system defaults help.
IFN 10X,[
CPLFIX:	MOVEI BYTE,215
	DPB BYTE,BP		;Put back old end of line
	MOVE BP,3		;Get old byte pointer
	MOVE BC,4
CPLFX1:	SOJL BC,CPLFX2
	ILDB BYTE,BP
	JUMPN BYTE,CPLFX3
CPLFX2:	PUSHJ P,JSYSER		;End and no special character

CPLFX3:	CAIN BYTE,^V
	 JRST [	IBP BP
		SOJA BC,CPLFX1]
	CAIE BYTE,(1)		;One we want
	 JRST CPLFX1
]

CPLFNM:
IFN 10X,MOVE 3,BP		;Save current byte pointer
.ALSO	MOVE 4,BC
	TLO D,ST.PON
	PUSHJ P,COMGJF		;Get JFN for default
IFE 10X, PUSHJ P,JSYSER
.ELSE [	 JRST [	CAIN 1,GJFX16	;No such device
		 JRST [	MOVEI 1,":
			JRST CPLFIX]
		CAIN 1,GJFX17	;No such directory <
		 JRST [	MOVEI 1,">
			JRST CPLFIX]
		IRPS STR,,[DEV DIR NAME TYP]
		 SETZM DEF!STR	;Forget the damned defaults 
		 TERMIN
		JRST CPLFN1]
];10X
	MOVE 2,1		;Setup for JFNS
	MOVEI 1,DEFSTR		;Some string space
	SETZ A,
	MOVSI 3,100000		;Device initially...
IRPS STR,,[DEV DIR NAM TYP]
	MOVEI 1,1(1)		;Make sure pointing to fresh word...
	HRLI 1,440700
	MOVEM 1,DEF!STR		;Save pointer to this section.
	JFNS
	IDPB A,1
	LSH 3,-3		;Shift down file-part field...
TERMIN
	HRROI 1,1(1)
	PUSH P,1
	MOVSI 3,000010		;Generation field...
	JFNS
	POP P,1
	HRLI 1,440700
	ILDB 1,1
	CAIN 1,"*
	 TLO D,ST.DIR		;Remember if should have wild default
	MOVE 1,2
	RLJFN			;Done with this JFN
	 JFCL
CPLFN1:	SETZM GTJBLK
	MOVE A,[GTJBLK,,GTJBLK+1]
	BLT A,GTJBLK+.GJBFP	;Clear out long call GTJFN block
	MOVEM BP,DEFSTR		;Save user's string
	PUSHJ P,COMEUS		;Find end of it
	 JRST [TRZN F,F.NWL	;Must be terminated with a newline
	        JRST COMBAD
	       JRST .+2]
	  JRST .-2		;Terminated by space, so keep searching
	MOVEI 1,33		;Put in escape to get completion
	DPB 1,BP
	SETZ 1,
	IDPB 1,BP

;;; Now have defaults and user's string.  If this is an input file, the idea is to
;;; keep trying GTJFN without allowing new files and various default conditions
;;; until we manage to win.
	TLNN D,ST.OUT
	 SKIPA C,[-NCPLMT,,CPLMTH]	;Completion method routines
	 HRROI C,CPLOUT		;Completion for output
	TLNN D,ST.NOK		;New file ok?
	 ADD C,[1,,0]		;No, skip last method

;;; Here to try next method
CPLLUP:.GJTYP==.GJEXT			;Nothing is consistent
IRPS STR,,[DEV DIR NAM TYP]
	MOVE 1,DEF!STR
	MOVEM 1,GTJBLK+.GJ!STR
TERMIN
	MOVE 1,[.NULIO,,.NULIO]
	MOVEM 1,GTJBLK+.GJSRC
	MOVEI 1,2		;Two extra words
	MOVEM 1,GTJBLK+.GJF2
	HRROI 1,JFNSTR
	MOVEM 1,GTJBLK+.GJCPP
	MOVEI 1,30.*5
	MOVEM 1,GTJBLK+.GJCPC
	MOVSI 1,(GJ%OLD\GJ%FLG\GJ%XTN)
	TLNE D,ST.DEL
	 TLO 1,(GJ%DEL)
	TLNE D,ST.DIR
	 IOR 1,[GJ%IFG+.GJALL]
	XCT (C)
	MOVEM 1,GTJBLK+.GJGEN
	MOVEI 1,GTJBLK
	MOVE 2,DEFSTR
	GTJFN
	 JRST CPLNXT		;Failed, try next method
	MOVE 3,[111110,,JS%PAF]	;Device, directory, filename, file type, version

;;; Now, if the user didn't really type the generation number, don't give it back
	SKIPL GTJBLK+.GJGEN	;GJ%FOU supplied?
	 JRST [	TLNE 1,(GJ%UHV)	;No, highest existing = 0
		 JRST .+2
		JRST .+3]
	TLNE 1,(GJ%NHV)		;Yes, next higher = 0
	 TLZ 3,(JS%GEN)
	MOVE 2,1		;Jfn
	HRROI 1,JFNSTR
	JFNS
	MOVE 1,2
	RLJFN
	 JFCL
	MOVEI A,[ASCIZ \OLD\]
	MOVSI 1,(GJ%OLD)
	TDNN 1,GTJBLK+.GJGEN
	 MOVEI A,[ASCIZ \NEW\]
	JRST CPLDON

CPLNXT:	AOBJN C,CPLLUP		;Keep trying and finally return typescript as is
	LDB 1,GTJBLK+.GJCPP
	SETZ 2,
	CAIN 1,33		;Clear altmode from user's typescript
	 DPB 2,GTJBLK+.GJCPP
	MOVEI A,[ASCIZ \NIL\]
CPLDON:	PUSH P,A
	MOVEI A,[ASCIZ \COMPLETE \]
	PUSHJ P,COMCTL
	POP P,A
	PUSHJ P,COMSTO
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	MOVEI A,JFNSTR
	PUSHJ P,COMSTO
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	PUSHJ P,COMSND
	JRST CTLLOP

CPLMTH:	JFCL
	SETZM GTJBLK+.GJEXT
	SETZM GTJBLK+.GJNAM
	PUSHJ P,CPLNBT
	TLZ 1,(GJ%OLD)
NCPLMT==.-CPLMTH

CPLOUT:	TLC 1,(GJ%FOU\GJ%OLD\GJ%NEW)

CPLNBT:	SETZM GTJBLK+.GJNAM
	SETZM GTJBLK+.GJEXT
	POPJ P,

];END OF COMPLETION COMMAND FOR TNX

IFN ITS,[
;;; ITS COMPLETION COMMAND

CPLFNM:	MOVEI IDX,MAXIDX	;Use probe variables for filename parsing etc.
	HLLM D,DATSTA(IDX)	;Save status bits
	SETZM DATSNM(IDX)
	SETZM DATFN2(IDX)
	PUSHJ P,COMPFN		;Parse the filename spec for the default
	IRPS SYL,,[SNM FN1 FN2]
	 MOVE TT,DAT!SYL(IDX)	;Save the defaults
	 MOVEM TT,DEF!SYL'
	 TERMIN
	SETZM DATSNM(IDX)
	SETZM DATFN2(IDX)
	PUSHJ P,COMPFN		;Parse the user's string
	PUSHJ P,LCKDIR		;Get DIRLCK
	;; First, find the directory
	SKIPN A,DATSNM(IDX)	;Start from any specified directory
	 MOVE A,DEFSNM		;None, start from default
	SKIPN A
	 MOVE A,HSNAME		;If no default, use default default: user's homedir
	PUSHJ P,GETUFD		;Read in the directory
	 CAIA
	  JRST CPLFN3
	;; Directory doesn't exist, try completion on it
	PUSHJ P,GETMFD		;Read in the MFD
	 JRST CPLFN9		;Can't do much without any dirs
	PUSHJ P,CMPLT0
	SKIPA D,MFDBUF+MDNAMP
CPLFN1:	 ADDI D,LMNBLK
	CAIL D,2000
	 JRST CPLFN2
	MOVE A,MFDBUF(D)
	PUSHJ P,CMPLT1
	JRST CPLFN1

CPLFN2:	MOVE A,CMPLTW		;Result of directory completion
	MOVEM A,DATSNM(IDX)	;Return it whether or not directory exists
	PUSHJ P,GETUFD
	 JRST CPLFN9		;Directory doesn't exist, stop now
CPLFN3: MOVEM A,DATSNM(IDX)
	;; Now scan the directory.  First we plug in the defaults and complete.
	;; If that yields an existent file, or this is for output, take that as
	;; the result.  Otherwise complete without plugging in the defaults.
	;; If that yields an existent file, take it.  Otherwise take the results
	;; of plugging in the defaults and completing if new-file is okay.
	;; We don't distinguish defaulting FN1 and defaulting FN2.
	SKIPN A,DATFN1(IDX)
	 MOVE A,DEFFN1
	SKIPN B,DATFN2(IDX)
	 JRST [	MOVE B,DEFFN2	;Note, never take ">" from the defaults
		CAMN B,[SIXBIT/>/]
		 SETZ B,
		JRST .+1 ]
	PUSHJ P,CPLDIR
	 JRST [	MOVSI T,ST.OUT	;No existent file, doing output?
		TDNN T,DATSTA(IDX)
		 JRST CPLFN4	;No, try without defaults
		JRST CPLFN7 ]	;Matches non-existent file
	JRST CPLFN7		;Matches possibly-existent file

CPLFN4:	PUSH P,A		;Save results of completion with default
	PUSH P,B
	MOVE A,DATFN1(IDX)	;Try again without defaults
	MOVE B,DATFN2(IDX)
	PUSHJ P,CPLDIR
	 JRST [	MOVSI T,ST.NOK	;That didn't work either, new file okay?
		TDNN T,DATSTA(IDX)
		 JRST CPLFN9	;No, no completions found
		POP P,B		;Yes, take the completion-with-defaults
		POP P,A
		JRST .+2 ]
	 SUB P,[2,,2]
; A and B now have the result of the completion.  Determine NEW/OLD status.
CPLFN7:	MOVEM A,DATFN1(IDX)
	MOVEM B,DATFN2(IDX)
	SKIPA D,DIRBUF+UDNAMP	;See if completed file really exists
CPLF7A:	 ADDI D,LUNBLK
	CAIL D,2000
	 JRST CPLF7B
	CAME A,DIRBUF+UNFN1(D)
	 JRST CPLF7A
	CAMN B,DIRBUF+UNFN2(D)
	 JRST CPLF7C
	JUMPE B,CPLF7C		;The file exists
	CAME B,[SIXBIT/>/]
	 CAMN B,[SIXBIT/</]
	  JRST CPLF7C
	JRST CPLF7A	

CPLF7B:	SKIPA A,[[ASCIZ/NEW/]]
CPLF7C:	 MOVEI A,[ASCIZ/OLD/]
	JRST CPLDON

;Failure return
CPLFN9:	MOVEI A,[ASCIZ/NIL/]
CPLDON:	PUSH P,A
	MOVEI T,MFDBUF/2000
	PUSHJ P,PAGDAL
	MOVEI T,DIRBUF/2000
	PUSHJ P,PAGDAL
	SETZM DIRLCK
	MOVEI A,[ASCIZ \COMPLETE \]
	PUSHJ P,COMCTL
	POP P,A
	PUSHJ P,COMSTO
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	PUSHJ P,COMRF1		;Read back completed file name (sans host)
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	PUSHJ P,COMSND
	JRST CTLLOP

;Complete A and B against the directory in DIRBUF, return results in A and B
;Skip-return if any completions found
;Note that cannot complete FO BA to FOO BAR if FORD 1 also exists, i.e.
;it completes the two filenames separately.  Hopefully this is all right,
;although the Lisp machine completing reader is smarter.
;No attempt to do binary search although system has sorted the dir.
CPLDIR: PUSHJ P,CMPLT0		;Start completing FN1
	SKIPA D,DIRBUF+UDNAMP
CPLDR1:	 ADDI D,LUNBLK
	CAIL D,2000
	 JRST CPLDR2
	MOVE A,DIRBUF+UNFN1(D)
	PUSHJ P,CMPLT1
	JRST CPLDR1

CPLDR2:	MOVE C,CMPLTW		;Completed FN1
	SKIPGE CMPLTF		;Any completions found?
	 JRST CPLDR5		;Nope
	CAME B,[SIXBIT/>/]	;FN2 of < or > always matches
	 CAMN B,[SIXBIT/</]
	  JRST CPLDR5
	MOVE A,B		;Start completing FN2 against files with that FN1
	PUSHJ P,CMPLT0
	SKIPA D,DIRBUF+UDNAMP
CPLDR3:	 ADDI D,LUNBLK
	CAIL D,2000
	 JRST CPLDR4
	MOVE A,DIRBUF+UNFN2(D)
	CAMN C,DIRBUF+UNFN1(D)
	 PUSHJ P,CMPLT1
	JRST CPLDR3

CPLDR4:	JUMPN B,CPLDR6		;When completing a blank FN2, special hair
	SKIPE CMPLTF		;Exactly one match?
	 JRST CPLDR5		;No, result remains blank (i.e. ">")
	MOVE B,CMPLTW		;Yes, is it all numeric?
CPLDR7:	MOVEI A,0		;If so, we won't count it since it's a version not a type
	LSHC A,6
	CAIL A,'0
	 CAILE A,'9
	  JRST CPLDR6		;Blank FN2 matches a single filetype
	JUMPN B,CPLDR7
	TDZA B,B		;Result remains blank
CPLDR6:	 MOVE B,CMPLTW		;Completed FN2
CPLDR5:	MOVE A,C		;Completed FN1
	SKIPL CMPLTF		;Any completions found?
	 AOS (P)		;Yes, take skip return
	POPJ P,

CMPLTA==CLODAT			;Trying to keep the impure down to one page
CMPLTM==CLOLEN

;;; Completion of sixbit words
;;; Set up to complete the word in A
;;; After calling this, call CMPLT1 any number of times then pick
;;; up your result out of CMPLTW, which is either the original argument
;;; (in which case CMPLTF is negative), or else is the shortest existent
;;; extension of that.
CMPLT0:	MOVEM A,CMPLTA		;Word to match
	SETO T,
	TDNE A,T
	 JRST [	LSH T,-6
		JRST .-1 ]
	SETCAM T,CMPLTM		;Mask for fixed characters
	SETOM CMPLTF'		;No completions found yet
	MOVEM A,CMPLTW'		;Word found so far (result of completion)
	SETCAM T,CMPLTX'	;Mask for valid characters in that
	POPJ P,

;;; Use the sixbit in A as a possible completion.
CMPLT1:	MOVE TT,A
	XOR TT,CMPLTA
	TDNE TT,CMPLTM		;Does it match the fixed characters?
	 POPJ P,		;No.
	AOSE CMPLTF		;First completion found?
	 JRST CMPLT2		;No
	MOVEM A,CMPLTW		;Yes, save as result
	SETO T,			;and compute its length
	TDNE A,T
	 JRST [	LSH T,-6
		JRST .-1 ]
	SETCAM T,CMPLTX
	POPJ P,

CMPLT2:	MOVE TT,A		;Two completions, take their common prefix
	XOR TT,CMPLTW
	MOVE T,CMPLTX
	TDNE TT,T
	 JRST [	LSH T,6
		JRST .-1 ]
	MOVEM T,CMPLTX
	ANDM T,CMPLTW
	POPJ P,
];ITS

;;; Property changing command
COMCNG:	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	TRZN F,F.NWL		;Should be newline
	 JRST COMBAD
	TRNN F,F.FHN		;Use an open file?
	 JRST CNGFIL		;Nope, need a filename
	PUSHJ P,CNGLOP
	 PUSHJ P,FILERR		;Failed
	JRST CNGDN1

CNGFIL:	MOVEI IDX,MAXIDX	;Use dummy IDX
IFN ITS,[
	PUSHJ P,COMPFN
	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBIT,,.UAI
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,DATFN1(IDX)
		%CLIN,,DATFN2(IDX)
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR
]
IFN TNX,[
	MOVSI D,ST.DEL
	PUSHJ P,COMGJF
	 PUSHJ P,JSYSER
	MOVEM 1,DATJFN(IDX)	;Save jfn
]
	PUSHJ P,CNGLOP
	 CAIA
	  JRST CNGDON
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL
];ITS
IFN TNX,PUSHJ P,RELDJ1		;Failed, release file
	PUSHJ P,FILERR

;;; Done changing things, close the file, etc.
CNGDON:
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /CLOSE/
		%CLIN+%CLEND,,DATCHN(IDX)]
	 JFCL
];ITS
IFN TNX,PUSHJ P,RELDJ1
CNGDN1:	MOVEI A,[ASCIZ \CHANGE-PROPERTIES\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	JRST CTLLOP

CNGLOP:	JUMPLE BC,POPJ1		;Done when end or just blank line
	TRZ F,F.NWL
	PUSHJ P,COMR10		;Get property name
	 JRST COMBAD
CNGOLP:	MOVEI C,CNGLEN
CNGOL1:	SOJL C,[CERR UKP,[Unknown property]]
	CAMN A,CNGTAB-1(C)
	 CAME B,CNGTAB(C)
	 SOJA C,CNGOL1
	HRRZ T,CNGACT(C)	;Get routine
	PUSHJ P,(T)
IFN 20X,[
	SKIPL CNGACT(C)		;If sign (flag) bit on, then we want
	 JRST CNGLOP		;to do something else besides this
	HRRZ T,CNGALT(C)	;operation, so look in the parallel
	PUSHJ P,(T)		;table for de poop.
];20X
	JRST CNGLOP


;;; NOTE: If you change this, be sure to update the list of settable properties at
;;; the start of DIRHED.
CNGTAB:
IFN 20X+ITS,	ASCII \DONT-REAP\	;DONT-REAP
	ASCII \NOT-BACKED\	;NOT-BACKED-UP
	ASCII \AUTHOR\		;AUTHOR
	ASCII \CREATION-D\	;CREATION-DATE
	ASCII \REFERENCE-\	;REFERENCE-DATE
IFN TNX,[
	ASCII \BYTE-SIZE\	;BYTE-SIZE
	ASCII \LENGTH-IN-\	;LENGTH-IN-BYTES
	ASCII \PROTECTION\	;PROTECTION
	ASCII \GENERATION\	;GENERATION-RETENTION-COUNT
	ASCII \ACCOUNT\		;ACCOUNT
	ASCII \TEMPORARY\	;TEMPORARY
	ASCII \DELETED\		;DELETED
	ASCII \DONT-DELET\	;DONT-DELETE
]
CNGLEN==.-CNGTAB

IFN ITS,[
CNGACT:	SIXBIT /SREAPB/ ? -1,,CNGBIT	;DONT-REAP
	SIXBIT /SDMPBT/ ? 0,,CNGBIT	;NOT-BACKED-UP
	SIXBIT /SAUTH/ ? CNGAUT		;AUTHOR
	SIXBIT /SFDATE/ ? CNGDAT	;CREATION-DATE
	SIXBIT /SRDATE/ ? CNGDAT	;REFERENCE-DATE

CNGBIT:	HLRE A,CNGACT(C)
	PUSH P,A		;Get sense of boolean
	PUSHJ P,COMRD5
	 JFCL
	CAMN A,[ASCII /NIL/]
	 SETCMM (P)
	POP P,A

;; Perfor system call for this routine, argument in A
CNGCAL:	MOVE B,CNGACT-1(C)
	.CALL [	SETZ
		SIXBIT /CALL/
		%CLERR,,ERRCOD
		%CLIN,,B
		%CLIN,,DATCHN(IDX)
		%CLIN+%CLEND,,A]
	 JRST CNGERR
	POPJ P,

CNGAUT:	PUSHJ P,COMSXI		;Read sixbit author name
	JRST CNGCAL

CNGDAT:	PUSHJ P,COMDTI		;Read a date
	JRST CNGCAL
]	;END IFN ITS

IFN TNX,[
CNGACT:
IFN 20X,-1 ? .ARNAR,,CNGABT	;DONT-REAP
	-1 ? .FBBK0,,CNGBIT	;NOT-BACKED-UP
	SFUST ? 400000\.SFLWR,,CNGSTR	;AUTHOR (Sign bit means dualistic)
	-1 ? 400000\.FBWRT,,CNGDAT	;CREATION-DATE
	-1 ? .FBREF,,CNGDAT	;REFERENCE-DATE
	FB%BSZ ? .FBBYV,,CNGDEC	;BYTE-SIZE
	-1 ? .FBSIZ,,CNGDEC	;LENGTH-IN-BYTES
IFN 20X,[77,,-1] .ELSE [0,,-1] ? .FBPRT,,CNGOCT	;PROTECTION
	FB%RET ? .FBBYV,,CNGDEC	;GENERATION-RETENTION-COUNT
	SACTF ? CNGSTR		;ACCOUNT
	FB%TMP ? .FBCTL,,CNGBIT	;TEMPORARY
	FB%DEL ? .FBCTL,,CNGBIT	;DELETED
IFDEF FB%NDL,FB%NDL		; Twenex release 5 has new name and value
.ELSE [
 IFDEF FB%UND,FB%UND
 .ELSE	FB%PRM
 ]
	.FBCTL,,CNGBIT	;DONT-DELETE

IFN 20X,[
CNGALT:	0 ? 0
	0 ? 0
	SFUST ? .SFAUT,,CNGST1	;real 20X AUTHOR
	-1 ? .FBCRV,,CNGDA1	;real 20x CREATION-DATE
	;there had better not be any more sign bits!
];20X


CNGBIT:	PUSHJ P,COMRD5
	CAMN A,[ASCII \NIL\]
	 TDZA A,A
	 SETO A,
CNGFDB:	HRRZ 1,DATJFN(IDX)
	HLL 1,CNGACT(C)
	TLZ 1,400000		;Remove that flag bit.
	MOVE 2,CNGACT-1(C)	;Mask
	MOVE 3,A		;New value
IFN 20X,PUSHJ P,TRYCON
	CHFDB
	 ERJMP CNGERR
	POPJ P,

IFN 20X,[
CNGABT:	PUSHJ P,COMRD5		;Modify archival information via ARCF
	CAMN A,[ASCII \NIL\]
	 SKIPA 3,[.ARCLR]
	  MOVEI 3,.ARSET
	HRRZ 1,DATJFN(IDX)
	HLRZ 2,CNGACT(C)
	ARCF
	 ERJMP CNGERR
	POPJ P,
];20X

CNGDAT:	PUSHJ P,COMDTI
	JRST CNGFDB

IFN 20X,[
CNGDA1:	HRRZ 1,DATJFN(IDX)
	HLL 1,CNGALT(C)
	MOVE 2,CNGALT-1(C)	;Mask
	MOVE 3,A		;Old value (had better still be there)
	PUSHJ P,TRYCON
	CHFDB
	 ERJMP .+1		;OK if we fail.
	POPJ P,
];20X

CNGDEC:	PUSHJ P,COMDCI
	JRST CNGRFD

CNGOCT:	PUSHJ P,COMOCI
;;Here if right justified
CNGRFD:	MOVE T,CNGACT-1(C)	;Mask
	JFFO T,.+1
	SETCM T,CNGACT-1(C)
	LSH T,(TT)
	MOVNS TT
	LSH T,(TT)
	JFFO T,.+2
	 JRST CNGFDB		;No shifting necessary
	MOVEI T,36.
	SUBI T,(TT)
	LSH A,(T)
	JRST CNGFDB

CNGSTR:	MOVE 2,BP
	MOVEM 2,SAVEBP
	PUSHJ P,COMEUS		;Find end
	 SKIPA
	 JRST .-2		;Terminated by space, so keep searching
	SETZ 1,
	DPB 1,BP		;Insure terminating NULL
	HRRZ 1,DATJFN(IDX)
	HLL 1,CNGACT(C)
	TLZ 1,400000		;Make sure that flag bit is off...
	XCT CNGACT-1(C)
	 ERJMP CNGERR
	POPJ P,

IFN 20X,[
CNGST1:	HRRZ 1,DATJFN(IDX)
	HLL 1,CNGALT(C)
	MOVE 2,SAVEBP
	XCT CNGALT-1(C)
	  ERJMP .+1		;OK if we fail...
	POPJ P,
];20X
];END IFN TNX

;;; Error, take error return from CNGLOP
CNGERR:	SUB P,[1,,1]		;Flush return to CNGLOP
	POPJ P,

;;; Expunge directory command
COMEXP:	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	SETZ D,			;Clear options here
	MOVEI IDX,MAXIDX	;Use the temporary channel for this
EXPOPT:	TRNE F,F.NWL		;End of options?
	 JRST EXPFNM
	PUSHJ P,COMRD5		;Get token
	 JUMPL BC,COMBAD
IFN ITS,CERR UUO,[Unknown EXPUNGE option]
IFN TNX,[
EXPOLP:	MOVEI T,EXPLEN-1
EXPOL1:	CAME A,EXPTAB(T)
	 SOJGE T,EXPOL1
	JUMPL T,[CERR UUO,[Unknown EXPUNGE option]]
	XCT EXPACT(T)
	 JRST COMBAD
	JRST EXPOPT

EXPTAB:	ASCII \TEMPO\		;TEMPORARY
EXPLEN==.-EXPTAB

EXPACT:	SKIPA

EXPFNM:	TLO D,ST.ALD		;Allow wildcards
	PUSHJ P,PRSDIR		;Return JFN in 1, directory number in 3
	 PUSHJ P,JSYSER
	RLJFN			;Don't need that JFN anymore.
	 JFCL
	PUSH P,[0]		;Initial sum of freed pages.
EXPFN0:	MOVEM 3,WILDIR
	MOVE 1,3		;Directory#
	GTDAL
	 ERCAL JSYSER
	PUSH P,2		;Returns allocated pages in AC2
IFN 10X,[
	HRRZ 1,WILDIR		;Directory number
	DELDF			;Expunge (never skips, and blows it on ERCAL)
];10X
IFN 20X,[
	SETZ 1,
	MOVE 2,WILDIR
	DELDF			;Expunge.
	 ERCAL JSYSER
];20X
	MOVE 1,WILDIR
	GTDAL			;Get new allocation
	 ERCAL JSYSER
	POP P,1			;Old allocation
	SUB 1,2			;1/ pages freed
	ADDM 1,(P)		;Accumulate.
IFN 20X,[
	MOVSI 1,(RC%STP\RC%AWL)	;Step to next directory
	HRROI 2,RESBLK		;Pointer to directory string
	MOVE 3,WILDIR		;Old dir#
	RCDIR
	 ERCAL JSYSER
	TLNN 1,(RC%NMD\RC%NOM)	;No More Directories?
	  JRST EXPFN0		;  Yes more, so go do next.
];20X
];TNX
IFN ITS,[			;Always returns success
EXPFNM:	PUSHJ P,COMPFN          ;PARSE THE FILENAME
	PUSH P,[0]		;No space is ever reclaimed
];ITS
	MOVEI A,[ASCIZ \EXPUNGE \]
	PUSHJ P,COMCTL
	POP P,A
	PUSHJ P,COMDCO
	MOVEI BYTE,215		;<freed pages>NL<directory expunged>NL
	PUSHJ P,COMCHO
IFN TNX,PUSHJ P,COMRES
IFN ITS,[
	MOVE A,DATSNM(IDX)
	PUSHJ P,COMSXO
	MOVEI BYTE,";
	PUSHJ P,COMCHO
];ITS
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	PUSHJ P,COMSND
	JRST CTLLOP
		
IFN TNX,[
;Return JFN in 1, directory number in 3 (skip on success)
;Allows wildcard directories on Tops-20 if ST.ALD is set
;Failure takes non-skip return with error code in 1, or blows out
PRSDIR:	TLO D,ST.PON		;Parse only: don't care if there are no files in dir
	PUSHJ P,COMGDJ		;Get JFN
	 POPJ P,
	PUSH P,1		;Save JFN
	HRROI 1,RESBLK
	MOVE 2,(P)
IFN 10X,MOVSI 3,(JS%DIR)	;Tenex wants directory with no delimiters
.ELSE	MOVE 3,[110000,,JS%PAF]	;Just want device and directory
	JFNS
	 ERCAL SYSBUG
	HRRZS (P)		;Kill flags in LH(JFN)
IFN 20X,[
	MOVSI 1,(RC%AWL)	;Recognize directory, allowing wildcards
	TLNN D,ST.ALD
	 MOVSI 1,(RC%EMO)
];20X
IFN 10X,MOVSI 1,(RC%EMO)	;Tenex's RC%AWL is too slow, even when no wildcards present
	HRROI 2,RESBLK
	RCDIR			;Get dir# (initial if wildcard)
	 ERJMP PRSDI2		;Syntax error
	TLNE 1,(RC%NOM)
	 JRST PRSDI1
	POP P,1
	JRST POPJ1

PRSDI1:	MOVEI 1,.FHSLF		;Fake error return from RCDIR
	MOVEI 2,GJFX17
	SETER
PRSDI2:	MOVEI 1,.FHSLF		;Get last error
	PUSHJ P,$GETER
	 MOVEI 2,GJFX17		;If no error code, use No Such Directory
	POP P,1			;Release the parse-only JFN
	RLJFN
	 JFCL
	HRRZ 1,2		;Return just error number
	POPJ P,
];TNX

IFN TNX,[
;;; Enable your capabilities.
COMENA:	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	SETZ D,			;Mask of priv bits.
COMEN1:	JUMPLE BC,DOENA		;Jump if no options left
	PUSHJ P,COMRD5
	 JFCL
	MOVEI T,ENALEN-1	;Number of ENABLE options
COMEN2:	CAME A,ENATAB(T)	;Match?
	 SOJGE T,COMEN2		; No, keep checking.
	JUMPL T,[CERR UUO,[Unknown ENABLE/DISABLE option]]
	XCT ENAACT(T)
	JRST COMEN1

ENATAB:	ASCII /ALL/
	ASCII /OPERA/
	ASCII /WHEEL/
ENALEN==.-ENATAB

ENAACT:	SETO D,
	TRO D,SC%OPR
	TRO D,SC%WHL

DOENA:	MOVEI 1,.FHSLF
	RPCAP			;Get your capabilities.
	IOR 3,D			;Turn on requested bits.
	EPCAP
	MOVEI A,[ASCIZ /ENABLE-CAPABILITIES/]
DOEN1:	PUSHJ P,COMCTL
	MOVEI 1,.FHSLF
	RPCAP			;Possible in 2, enabled in 3.
	MOVSI T,-NPRIVS		;Return state of your priviledges.
DOEN2:	HRRZ TT,PRVTAB(T)
	TRNN 2,(TT)
	  JRST DOEN3		; You don't have this priv.
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	HLRZ A,PRVTAB(T)
	PUSHJ P,COMSTO		;You do, so send the name and then T if
	MOVEI BYTE,40		;it's on, else NIL.
	PUSHJ P,COMCHO
	MOVEI A,[ASCIZ /NIL/]	;This priv is disabled...
	TRNE 3,(TT)
	  MOVEI A,[ASCIZ /T/]	;(and this is is enabled)
	PUSHJ P,COMSTO
DOEN3:	AOBJN T,DOEN2
	MOVEI BYTE,215
	PUSHJ P,COMCHO
	PUSHJ P,COMSND
	JRST CTLLOP

PRVTAB:	[ASCIZ /WHEEL/],,SC%WHL			;Privs whose status we
	[ASCIZ /OPERATOR/],,SC%OPR		;will return
	[ASCIZ /CONFIDENTIAL-INFORMATION-ACCESS/],,SC%CNF
	[ASCIZ /MAINTENANCE/],,SC%MNT
	[ASCIZ /IPCF/],,SC%IPC
	[ASCIZ /ENQ-DEQ/],,SC%ENQ
	[ASCIZ /ARPANET-WIZARD/],,SC%NWZ
	[ASCIZ /ABSOLUTE-ARPANET-SOCKETS/],,SC%NAS
NPRIVS==.-PRVTAB

COMDIS:	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	MOVEI 1,.FHSLF
	RPCAP
	MOVE D,3		;What you have on now.
COMDI1:	JUMPLE BC,DODIS		;Jump if no options left
	PUSHJ P,COMRD5
	 JFCL
	MOVEI T,ENALEN-1
COMDI2:	CAME A,ENATAB(T)
	 SOJGE T,COMDI2		; No, keep checking.
	JUMPL T,[CERR UUO,[Unknown ENABLE/DISABLE option]]
	XCT DISACT(T)
	JRST COMDI1

DISACT:	TRZ D,SC%WHL+SC%OPR
	TRZ D,SC%WHL
	TRZ D,SC%OPR

DODIS:	MOVEI 1,.FHSLF
	RPCAP
	MOVE 3,D
	EPCAP
	MOVEI A,[ASCIZ /DISABLE-CAPABILITIES/]
	JRST DOEN1

];TNX (ENABLE AND DISABLE COMMANDS)

;;; Connect/access directory commands
IFN 20X,[
COMCWD:	PUSH P,[[ASCIZ/CWD/]]
	PUSH P,[AC%CON]		;Just want to connect
	JRST .+3
COMACD:	 PUSH P,[[ASCIZ/ACCESS/]]
	 PUSH P,[AC%OWN]	;Want ownership access to a directory
];20X
IFN 10X,COMCWD:
IFN TNX,[
	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]
	JUMPLE BC,CWDIRF	;No good
	MOVE 2,BP		;Save byte ref copy
	PUSHJ P,COMEUS		;Eat till end of line, hopefully
	JUMPL BC,CWDIRF		;Should be a password following
	SETZ T,			;Tie it off
	DPB T,BP
	MOVE 3,2		;Get start of fellow
	ILDB 3,3		;See if null
	JUMPE 3,[GJINF		;Sure enough, get user number into 1
		MOVE 2,1	;Do an RCDIR on that
		JRST .+1]
	MOVSI 1,(RC%EMO)	;See if it exists
	RCDIR
	 ERCAL JSYSER
	TLNE 1,(RC%NOM)		;Did it?
	 CERR DNF,[No such directory]
	MOVEM 3,RESBLK+.ACDIR	;Save directory number
	MOVEM BP,RESBLK+.ACPSW	; and password start
	MOVE 3,BP		;See if password is null
	ILDB 3,3
	SKIPN 3
	 SETZM RESBLK+.ACPSW	;Don't include a pointer if null password
	SETOM RESBLK+.ACJOB	;-1 means current job
	PUSHJ P,COMEUS		;Scan until end of password
	SETZ T,			; and tie it off as usual
	DPB T,BP
IFN 20X,[
	POP P,1			;Get back connect/access code
	HRRI 1,3		;3 elements
	MOVEI 2,RESBLK		; here
	ACCES
];20X
IFN 10X,[
	HRRZ 1,RESBLK+.ACDIR	;Directory number and no options
	MOVE 2,RESBLK+.ACPSW	;String pointer to password
	CNDIR
];10X
	 ERCAL JSYSER		;Give an error return here
IFN 20X,POP P,A			;Name of command for success reply
IFN 10X,MOVEI A,[ASCIZ \CWD\]
	PUSHJ P,COMCTL
	MOVEI BYTE,215		;ACCESS<NL>directory name
	PUSHJ P,COMCHO
	HRROI 1,RESBLK		;Build full directory specification
	MOVE 2,RESBLK+.ACDIR	;Get directory number
	DIRST
	 JFCL			;Ignore errors
	PUSHJ P,COMRES		;Send the directory spec
	PUSHJ P,COMSND
	JRST CTLLOP		;All done

CWDIRF:	CERR BUG,[Illegal request format (no directory name)]
];END IFN TNX

;;; Create directory

COMCRD:	SKIPN USERID
IFN OZ,	 PUSHJ P,AUTLOG
.ELSE	 CERR NLI,[Not logged in]

IFN TNX,[
IFN 10X,[
	MOVE T,[-777,,1]	;MUST FIND A FREE DIRECTORY SLOT
CRDFND:	HRROI 1,JFNSTR
	HRRZ 2,T
	DIRST
	 SKIPA
	 AOBJN T,CRDFND
	JUMPGE T,[CERR CCD,[No free directory slots]]
	HRRZM T,CRDBLK+.CDNUM
	MOVSI 2,(CD%NUM)
];IFN 10X
.ELSE	SETZ 2,			;DEFAULT OPTIONS
	SETZM CRDBLK+.CDMOD	;JUST IN CASE
CRDOPT:	TRNE F,F.NWL            ;NEW LINE TERMINATED OPEN COMMAND?
	 JRST CRDNAM
	PUSHJ P,COMRD5          ;GET NEXT TOKEN
	 JUMPL BC,COMBAD
CRDOLP:	MOVEI T,CRDLEN-1        ;LENGTH OF OPTION TABLE
CRDOL1:	CAME A,CRDTAB(T)        ;MATCH?
	 SOJGE T,CRDOL1         ;NOPE, KEEP ON
	JUMPL T,[CERR UUO,[Unknown CREATE-DIRECTORY option]]
	ASH T,1
	MOVE TT,CRDACT(T)	;GET BIT TO SET
	IOR 2,TT
	XCT CRDACT+1(T)		;CALL PARSER
	 JRST COMBAD		;PARSING ERROR
	MOVEM A,CRDBLK(TT)	;STICK INTO PARAMETER BLOCK
	JRST CRDOPT

CRDTAB:	ASCII \PASSW\
	ASCII \WORKI\
	ASCII \CAPAB\
	ASCII \FILES\
	ASCII \REPEA\
	ASCII \PERMA\
	ASCII \FILE-\
	ASCII \PROTE\
	ASCII \GENER\
	ASCII \USER-\
	ASCII \DIREC\
	ASCII \SUBDI\
	ASCII \ACCOU\
CRDLEN==.-CRDOPT

CRDACT:	CD%PSW+.CDPSW ? PUSHJ P,CRDPSW
	CD%LIQ+.CDLIQ ? PUSHJ P,CRDLIQ
	CD%PRV+.CDPRV ? PUSHJ P,CRDPRV
	CD%MOD+.CDMOD ? PUSHJ P,CRDDIR
	CD%MOD+.CDMOD ? PUSHJ P,CRDRLM
	CD%LOQ+.CDLOQ ? PUSHJ P,CRDLOQ
	CD%FPT+.CDFPT ? PUSHJ P,CRDFPT
	CD%DPT+.CDDPT ? PUSHJ P,CRDDPT
	CD%RET+.CDRET ? PUSHJ P,CRDRET
	CD%UGP+.CDUGP ? PUSHJ P,CRDUGP
	CD%DGP+.CDDGP ? PUSHJ P,CRDDGP
	CD%SDQ+.CDSDQ ? PUSHJ P,CRDSDQ
	CD%DAC+.CDDAC ? PUSHJ P,CRDDAC

CRDPSW:
CRDDAC:	MOVE A,BP
	PUSHJ P,COMEUS
	 JFCL
	SETZ B,
	DPB B,BP
	JRST POPJ1

CRDLIQ:	CRDLOQ:	CRDRET:
CRDSDQ:	PUSHJ P,COMDCI
	JRST POPJ1

CRDPRV:	PUSHJ P,COMOCI
	JRST POPJ1

CRDDIR:	MOVE A,CRDBLK+.CDMOD
	TLO A,(CD%DIR)
	JRST POPJ1

CRDRLM:	MOVE A,CRDBLK+.CDMOD
	TLO A,(CD%RLM)
	JRST POPJ1

CRDFPT:
CRDDPT:	PUSHJ P,COMOCI
	HLL A,500000
	JRST POPJ1

IFN 10X,[
CRDUGP:
CRDDGP:	SETZ B,
CRDGRP:	PUSHJ P,COMDCI
	MOVEI C,1
	LSH 1,(A)
	IORI B,C
	TRNN F,F.NWL
	 JRST CRDGRP
	JRST POPJ1
];10X
.ELSE [
CRDUGP:	SKIPA A,[JFNSTR]
CRDDGP: MOVEI A,JFNSTR+11.
	PUSH P,A
	MOVE B,A
	HRLI B,-10.
CRDGRP:	AOBJP B,[CERR BUG,[Too many directory groups]]
	PUSHJ P,COMDCI
	MOVEM A,(B)
	TRNN F,F.NWL
	 JRST CRDGRP
	POP P,A
	SUBI B,-1(A)
	HRRM B,(A)
	JRST POPJ1
];NOT 10X

CRDNAM:
IFN 20X,[
	MOVE 1,BP
	PUSHJ P,COMEUS
];20X
.ELSE [
CRDNM1:	SOJL BC,COMBAD
	ILDB BYTE,BP
	CAIE BYTE,"<
	 JRST CRDNM1
	MOVE 1,BP
CRDNM2:	SOJL BC,COMBAD
	ILDB BYTE,BP
	CAIE BYTE,">
	 JRST CRDNM2
];NOT 20X
	SETZ T,
	DPB T,BP
	HRRI 2,CRDBLK
	SETZ 3,			;NO PASSWORD
	CRDIR
	 ERCAL JSYSER

];IFN TNX

IFN ITS,[
	TRNN F,F.NWL		;MUST END IN NEWLINE
	 JRST COMBAD
	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW+%CLIMM,,.UAI
		%CLIMM,,UTILCH
		%CLIN,,[SIXBIT /DSK/]
		%CLIN,,[SIXBIT /.FILE./]
		%CLIN,,[SIXBIT /(DIR)/]
		%CLIN+%CLEND,,USERID]
	 JRST [ MOVEI A,%ENSDR
		JRST CRDNM4 ]
	.CLOSE UTILCH,
	MOVEI IDX,MAXIDX	;Use the temporary channel for this
	PUSHJ P,COMPFN          ;PARSE THE FILENAME
	.CALL [ SETZ
		SIXBIT /OPEN/
		%CLERR,,ERRCOD
		%CLBTW+%CLIMM,,.UII
		%CLIN,,DATCHN(IDX)
		%CLIN,,DATDEV(IDX)
		%CLIN,,[SIXBIT /..NEW./]
		%CLIN,,[SIXBIT /(UDIR)/]
		%CLIN+%CLEND,,DATSNM(IDX)]
	 SKIPA A,ERRCOD
	  MOVEI A,%ENSFL	;NO ERROR IF DIR ALREADY EXISTS
	CAIE A,%ENSFL
CRDNM4:	 PUSHJ P,FILERR		;WRONG ERROR => CANNOT CREATE DIR
];IFN ITS
	MOVEI A,[ASCIZ \CREATE-DIRECTORY\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	JRST CTLLOP		;All done

IFN ITS,[
COMCRL:	TRZN F,F.NWL		;Newline?
	 JRST COMBAD		;Nope, bad command format
	MOVEI IDX,MAXIDX	;Use the temporary channel for this
	PUSHJ P,COMPFN		;Parse the filename for the link
	TRZN F,F.NWL		;Check for correct format
	 JRST COMBAD
	PUSH P,DATDEV(IDX)	;Save link name
	PUSH P,DATFN1(IDX)
	PUSH P,DATFN2(IDX)
	PUSH P,DATSNM(IDX)
	MOVE T,BC		;Compensate for incompetently-defined protocol
	IDIVI T,4		;by appending NL to end of command
	ADD T,BP
	IBP T
	SOJGE TT,.-1
	MOVEI TT,215
	DPB TT,T
	AOS BC
	PUSHJ P,COMPFN		;Parse the name to link to
	TRZN F,F.NWL		;Check for correct format
	 JRST COMBAD
	JUMPG BC,COMBAD
	.CALL [ SETZ
		SIXBIT /MLINK/
		%CLERR,,ERRCOD  ;Error code
		%CLIN,,-3(P)
		%CLIN,,-2(P)
		%CLIN,,-1(P)
		%CLIN,,0(P)
		%CLIN,,DATFN1(IDX)
		%CLIN,,DATFN2(IDX)
		%CLIN+%CLEND,,DATSNM(IDX)]
	 PUSHJ P,FILERR		;File error, tell about it
	SUB P,[4,,4]
	MOVEI A,[ASCIZ \CREATE-LINK\]
	PUSHJ P,COMCTL
	PUSHJ P,COMSND
	JRST CTLLOP
]	;END IFN ITS

;;; Core buffer allocator
BUFALO:	MOVEI T,BUFBAS(IDX)     ;Index
	SETZM DATBPT(IDX)       ;Pointer is zero, meaning virgin buffer
	SETZM DATBCT(IDX)	;No room left in buffer
	SETZM DATLWD(IDX)	;No last word
IFN ITS,PUSHJ P,PAGALO
	LSH T,10.               ;Make into address
IFN TNX,[
	SETMM (T)		;Access page to create it
	SETMM 1000(T)		;Both half-pages
]	;END IFN TNX
	MOVEM T,DATBUF(IDX)	;Remember base of buffer
	POPJ P,

IFN ITS,[
PAGALO:	.CALL [ SETZ
		SIXBIT /CORBLK/
		%CLIMM,,%CBNDW+%CBNDR ;Write and read access
		%CLIMM,,%JSELF	;Into own job
		%CLIN,,T	;c(T) is page number
		%CLIMM+%CLEND,,%JSNEW] ;Fresh page
	 CERR NER,[System virtual memory full]
	POPJ P,
]	;END IFN ITS

;;; Core buffer deallocator
BUFDAL:	MOVEI T,BUFBAS(IDX)
	SETZM DATBPT(IDX)
	SETZM DATBCT(IDX)
	SETZM DATLWD(IDX)	;No last word
	SETZM DATBUF(IDX)
IFN ITS,PUSHJ P,PAGDAL
IFN TNX,[
	MOVNI 1,1		;-1 means unmapping a page
	MOVE 2,T		;Page number in right half
	ADD 2,T			;in half-pages
	HRLI 2,.FHSLF		;Process handle in left half
IFN 20X,[
	MOVE 3,[SETZ 2]		;Remove 2 half-pages
	PMAP
	 ERCAL CTLERR
];20X
IFN 10X,[
	SETZ 3,			;Delete page
	PMAP
	 ERCAL CTLERR
	AOS T			;Other half page
	PMAP
	 ERCAL CTLERR
];10X
]	;END IFN TNX
	POPJ P,

IFN ITS,[
PAGDAL:	.CALL [ SETZ
		SIXBIT /CORBLK/
		%CLIMM,,0	;Delete page
		%CLIMM,,%JSELF
		%CLIN+%CLEND,,T]
	 .LOSE %LSSYS
	POPJ P,
]	;END IFN ITS

;;; IOC error and asynchronous mark transmitters
;;; Both of these routines get called with all interrupts deffered and therefore can use a
;;;  shared packet
;;; A contains DATSTA(IDX)
;;; This must be called so that a POPJ returns to "top level".

;;; c(D)+1 contains error code,,pointer to asciz string
;;; c(D)+2 has return address
ASYERR:	PUSH P,PKTLOC		;Direct data to the async packet
	MOVEI T,ASYPKT
	MOVEM T,PKTLOC
	HRRI A,ST%ASY		;Channel now in ASYNC-MARKED state
	TLO A,ST.UNC		;But uncontinuable
	MOVEM A,DATSTA(IDX)
	TRO F,F.FHN		;Force outputting of a file handle
	MOVEI A,[ASCIZ \ERROR \]
	PUSHJ P,COMCTL		;This will output a transaction ID, which will be ignored
	HLLZ A,1(D)		;Get error code
	PUSHJ P,COMSXO
	MOVEI BYTE,40
	PUSHJ P,COMCHO
	HRRZ A,1(D)		;Now output the error string
	PUSHJ P,COMSTO
	MOVEI T,CO%ASY
	DPB T,[$CPKOP+ASYPKT]
	DPB BC,[$CPKNB+ASYPKT]
IFN ITS,[
	MOVEI T,CTRLO		;Perhaps have to send this over the control connection
	TRNN IDX,1		;Except if we are already sending data, use IDX's channel
	 MOVE T,CHACHN(IDX)
	.CALL [	SETZ
		SIXBIT /PKTIOT/
		%CLIN,,T
		%CLIMM+%CLEND,,ASYPKT]
	 .LOSE %LSSYS
	TRNN IDX,1		;if more packets might come in, defer interrupts
	 JRST ASYRET
	MOVE T,CHABIT(IDX)	;Defer interrupts on this channel until continued
	IORM T,SSYDF2		;Update saved copy of DF2
	.SUSET [.SIDF2,,T]
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CTLJFN
	TRNN IDX,1
	 MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOPKS
	MOVEI 3,ASYPKT
	MTOPR
	 ERCAL CTLERR
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	DIC
]	;END IFN TNX
ASYRET:	POP P,PKTLOC
	MOVE A,DATSTA(IDX)	;Insure A stays set up correctly
	JRST @2(D)

;;; c(D)+1 contains continuation address
ICCERR:	PUSH P,PKTLOC		;Direct data to the async packet
	MOVEI T,ASYPKT
	MOVEM T,PKTLOC
	HRRI A,ST%ASY		;Channel now in ASYNC-MARKED state
	TLZ A,ST.UNC		;They are continuable
	MOVEM A,DATSTA(IDX)
	HRRZ T,1(D)		;Get continuation address
	MOVEM T,DATICN(IDX)	;Remember in case user end asks us to go on
	TRO F,F.FHN		;Force outputting of a file handle
	MOVEI A,[ASCIZ \ERROR \]
	PUSHJ P,COMCTL          ;Start off error packet, open failed error code
IFN ITS,[
	.CALL [	SETZ
		'STATUS
		%CLIN,,DATCHN(IDX)
		%CLOUT+%CLEND,,C ]
	 .LOSE %LSSYS
	HLRZ D,C		;Get just the IOC error
	ANDI D,37000
	PUSHJ P,ERR3		;Get the 3-letter code
	HLRZ D,C		;Put error code in standard place
];END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	PUSHJ P,$GETER		;Get last error that happened
	 PUSHJ P,CTLERR
	HRRZM 2,D		;The number of the error
	PUSHJ P,ERR3		;Get the 3-letter code
];TNX
	MOVSS A
	PUSHJ P,COMSXO
	MOVEI A,[ASCIZ \ R \]	;Recoverable error (probably)
	PUSHJ P,COMSTO
	PUSHJ P,ERRMSG		;Output the error message now
	PUSHJ P,ICCERP		;Send packet
	POP P,PKTLOC
	SUB P,[1,,1]		;Flush the old return address
	POPJ P,			;And return to "superior" of routine that had error

;;; Send IOC error packet
ICCERP:	MOVEI T,CO%ASY
	DPB T,[$CPKOP+ASYPKT]
	DPB BC,[$CPKNB+ASYPKT]

IFN ITS,[
	MOVEI T,CTRLO		;Perhaps have to send this over the control connection
	TRNN IDX,1		;Except if we are already sending data, use IDX's channel
	 MOVE T,CHACHN(IDX)
	.CALL [	SETZ
		SIXBIT /PKTIOT/
		%CLIN,,T
		%CLIMM+%CLEND,,ASYPKT]
	 .LOSE %LSSYS
	TRNN IDX,1		;If more packets might come in, defer interrupts
	 JRST ICCRET
	MOVE T,CHABIT(IDX)	;Defer interrupts on this channel until continued
	IORM T,SSYDF2		;Update saved copy of DF2
				; Runs at interrupt level -- the interrupt top-level
				; will setup the saved defer word before dismissing.
]	;END IFN ITS

IFN TNX,[
	MOVE 1,CTLJFN
	TRNN IDX,1
	 MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOPKS
	MOVEI 3,ASYPKT
	MTOPR
	 ERCAL CTLERR
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	DIC
]	;END IFN TNX

ICCRET:	MOVE A,DATSTA(IDX)	;Insure A stays set up correctly
	POPJ P,

;;; Recieved a new packet.  Write it to the appropriate file.  IDX set up, but packet
;;; not read from system.  Since we can only get one interrupt at a time, we can use a
;;; common packet buffer for the data until/unless we get an IOC error in which case
;;; the data must be saved in the allocated buffer.
WRIONE:
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /PKTIOT/
		%CLIN,,CHACHN(IDX)
		%CLIMM+%CLEND,,WRIPKT]
	 .LOSE %LSSYS           ;HMM...THIS BETTER NOT HAPPEN
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOPKR
	MOVEI 3,WRIPKT
	MTOPR
	 ERCAL CTLERR
]	;END IFN TNX
	SKIPL A,DATSTA(IDX)     ;CHANNEL ACTIVE?
	 JRST WRIBAD		;HMMM...CHANNEL NOT ACTIVE, IGNORE THE PACKET
	LDB T,[WRIPKT+$CPKOP]   ;GET THE OPCODE
	CAIN T,CO%SYN           ;Synchronous mark, process it (ignoring channel state)
	 JRST WRIOSY
	JRST @WRIDSP(A)		;ACTIONS TO FOLLOW DEPEND UPON CHANNEL STATE

;Dispatch table
WRIDSP:	WRICLO                  ;CHANNEL CLOSED
	WRIOPN                  ;CHANNEL OPEN, NORMAL PROCESSING
	WRIASY                  ;ASYNCHRONOUS MARKED
	WRISYN                  ;SYNCHRONOUS MARKED STATE
	WRIEOF                  ;EOF STATE

;Channel closed, at eof, or sync or asynch mark.  Interrupts shouldn't happen
; Channel cannot stay in synchronous mark state for any amount of time, so this shouldn't
; happen either
;These are all reasons a data packet can get thrown away
WRICLO:	AERR WRILUZ,BUG,[Data packet being discarded because channel closed]
WRIASY:	AERR WRILUZ,BUG,[Data packet being discarded because channel async-marked]
WRISYN:	AERR WRILUZ,BUG,[Data packet being discarded because channel sync-marked]
WRIEOF:	AERR WRILUZ,BUG,[Data packet being discarded because channel at eof]
WRIBAD:	AERR WRILUZ,BUG,[Data packet being discarded because channel not active]

WRILUZ:	TLNN A,ST.SYN		;Expecting sync mark?
	 AOS (P)		;Nope, don't take any more interrupts
	POPJ P,                 ;Return and perform appropriate action

;Channel in open state, only one allowed to receive a new packet
WRIOPN:	CAIN T,CO%BDT           ;BINARY DATA
	 JRST WRIBIN
	CAIN T,CO%TXT           ;TEXT DATA
	 JRST WRITXT
	CAIN T,CO%EOF           ;END OF FILE?
	 JRST WRIOEO
	AERR WRILUZ,BUG,[Illegal packet opcode]

;Synchronous mark received
WRIOSY:	TLZE A,ST.SYN           ;WAS ONE EXPECTED
	 JRST WRISY0            ;YES, THROW IT AWAY AND PREPARE FOR MORE DATA
	HRRI A,ST%SYN           ;ELSE PUT CHANNEL INTO SYNC MARKED STATE
	MOVEM A,DATSTA(IDX)
IFN ITS,[
	MOVE T,CHABIT(IDX)	;Defer interrupts on this channel until mark processed
	IORM T,SSYDF2		;Update saved DF2
	.SUSET [.SIDF2,,T]
]	;END IFN ITS
IFN TNX,[
	MOVEI 1,.FHSLF
	MOVE 2,CHABIT(IDX)
	DIC
]	;END IFN TNX
	AOS (P)
	POPJ P,                 ;RETURN AND DISMISS INTERRUPT

WRISY0:	TLZ A,ST.SYN		;Make sure sync mark is no longer expected
	PUSHJ P,@DATSYA(IDX)    ;Call routine to handle receipt of sync mark
	MOVEM A,DATSTA(IDX)     ;Routine may have altered status
	POPJ P,

;EOF received
WRIOEO:	PUSHJ P,WRIFOR          ;FORCE OUT ANY REMAINING BUFFERS
	HRRI A,ST%EOF           ;PUT CHANNEL IN EOF STATE
	MOVEM A,DATSTA(IDX)
	POPJ P,                 ;RETURN AND DISMISS INTERRUPT

;Text data received
;Note: ITS SIOT is much faster if you always send a multiple of 5 characters
;so that everything stays on word boundaries.  So we will move any residual
;part word down to the front of the buffer and save it for next time, setting
;DATBCT to the number of characters saved and DATBPT to point after them.
WRITXT:	TLNE A,ST.BIN           ;FILE OPEN IN BINARY MODE?
WRIIDO:	 AERR WRILUZ,BUG,[Illegal data opcode]
	SETZ BC,
	MOVE BP,DATBUF(IDX)     ;USE BUFFER TO HOLD BYTES
	HRLI BP,440700          ;7 BIT BYTES
	SKIPE DATBPT(IDX)
	 MOVE BP,DATBPT(IDX)	;POINT AFTER OLD STUFF IN BUFFER
	LDB T,[WRIPKT+$CPKNB]   ;NUMBER OF BYTES
	ADDM T,DATRCV(IDX)
	MOVE TT,[441000,,WRIPKT+%CPKDT]
;;; Note: Assumption is that even if the packet consisted of all newlines the buffer could
;;;	  not be overflowed.  If this is not the case, then something else has to be hacked
;;;	  here.
WRITX1:	SOJL T,WRITX0           ;DONE WHEN NO MORE BYTES
	ILDB BYTE,TT            ;ELSE GET NEXT BYTE
	TLNN A,ST.RAW		;If raw mode, don't translate
	 XCT CHR210(BYTE)	;Convert to PDP-10 code
	  SKIPA			;Non-skip means character not processed
	   JRST WRITX1		;Skip means character has been processed
	IDPB BYTE,BP
	AOJA BC,WRITX1

WRITX0:	JUMPE BC,CPOPJ          ;If no bytes to write out (0 length packet), return and dismis
	ADDM BC,DATLEN(IDX)	;Keep track of number of bytes written
	MOVE BP,DATBUF(IDX)	;Write starting from beginning of buffer
	HRLI BP,440700
	ADD BC,DATBCT(IDX)	;Include characters left over from last time
	MOVE T,BC		;Round down to multiple of a word
	IDIVI T,5
	IMULI T,5
	SUB BC,T		;Number of characters that will be left over
	MOVEM BC,DATIOC(IDX)
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,BP
		%CLIN+%CLEND,,T]
	 JFCL                   ;Here if IOC error
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,BP
	MOVN 3,T
	JUMPE 3,.+3
	SOUT
	 ERJMP .+1
	MOVN T,3
	MOVE BP,2
]	;END IFN TNX
	MOVEM T,DATBCT(IDX)	;Save the byte count remaining within the word-aligned part
	MOVEM BP,DATBPT(IDX)    ;and the byte pointer to not-yet-output chars
	JUMPE T,WRITX2		;If everything SIOT'ed, go handle residue
	IOCERR WRITX2		;Else IOC error, continuation when fixed up after SIOT done

WRITX2:	SKIPN BC,DATIOC(IDX)	;Get number characters to be saved for next time
	 JRST [ SETZM DATBPT(IDX) ? POPJ P, ]	;No characters
	CAIL BC,5
	 PUSHJ P,CTLERR		;This can't happen
	MOVEM BC,DATBCT(IDX)
	MOVE T,DATBPT(IDX)
	;; Don't need to make BP agree with ITS on TOPS-20, since this IBP equalizes them
	IBP T			;Points to first byte to be saved for next time
	MOVE TT,(T)		;Move that word down to the front
	MOVE BP,DATBUF(IDX)	;Make a byte pointer to after them
	HRLI BP,440700
	IBP BP
	SOJG BC,.-1
	MOVEM BP,DATBPT(IDX)
	MOVEM TT,(BP)
	POPJ P,

;Binary data received
WRIBIN:	TLNN A,ST.BIN           ;MUST BE A BINARY MODE FILE
	 JRST WRIIDO
	SKIPE T,DATBPT(IDX)     ;ARE WE IN THE MIDDLE OF A PREVIOUS OPERATION?
	 JRST WRIBI0            ;YES, SO CONTINUE PROCESSING IT
	HRRZ T,DATBYT(IDX)
	CAIE T,16.              ;16 BIT BYTE MODE?
	 JRST WRIBI1            ;NOPE, SO NEED SPECIAL HANDLING ANYWAY
	LDB T,[WRIPKT+$CPKNB]   ;NUMBER OF BYTES
	MOVEI D,(T)             ;COPY INTO D
	LSH T,-1		;Number of bytes getting written
	ADDM T,DATLEN(IDX)
	LSH T,-1                ;NUMBER OF PDP-10 WORDS, ROUNDED DOWN
	MOVE TT,[444400,,WRIPKT+%CPKDT]
IFN ITS,[
	.CALL [ SETZ            ;WRITE THE DATA DIRECTLY FROM THE PACKET
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,TT       ;POINTER
		%CLIN+%CLEND,,T]
	SKIPA                   ;IOC error
	 JUMPE T,WRIBI2         ;WROTE OUT ALL THE DATA, PROCEED
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,TT		;Pointer
	MOVN 3,T		;Negative count -- output this many bytes
	JUMPE 3,.+3
	SOUT
	 ERJMP .+2
	  JRST [PUSHJ P,ITSBP
		MOVE TT,2	;Get updated pointer
		JRST WRIBI2]
	MOVN T,3
	MOVE TT,2
]	;END IFN TNX
	MOVE B,DATBUF(IDX)      ;SAVE PACKET IN IDX BUFFER
	MOVEI C,(B)             ;COPY FOR TERMINATION CONDITION
	HRLI B,WRIPKT
	BLT B,%CPMXW-1(C)       ;SAVE ALL OF PACKET
	SUBI C,WRIPKT           ;OFFSET FOR BYTE POINTER
	ADD TT,C
	MOVEM TT,DATBPT(IDX)    ;SAVE POINTER
	MOVEM T,DATBCT(IDX)     ;AND SAVE COUNT
	IOCERR WRIBI5           ;GIVE THE IOC ERROR, CONTINUATION

WRIBI5:	MOVE TT,DATBPT(IDX)     ;IOC ERROR RECOVERY PUTS FINAL BP HERE
	SETZM DATBPT(IDX)       ;No longer need pointer
	MOVE D,DATBUF(IDX)      ;SAVED PACKET, AND NEED TO GET BYTE COUNT BACK
	LDB D,[$CPKNB (D)]

WRIBI2:	TRNN D,3                ;DID WE GET AN ODD NUMBER OF BYTES?
	 POPJ P,                ;NOPE, THEN DONE WITH PACKET
;Here if 16 bit byte mode, but have an odd number of bytes.  Next packet will have to do
; it slowly
	LSH D,-2                ;NUMBER OF WORDS - 1
	IBP TT			;POINT AT NEXT BYTE TO BE DONE
	MOVE T,(TT)		;GET THE BYTE
	MOVE TT,DATBUF(IDX)     ;ADDRESS IN WHICH TO SAVE
	MOVEM T,(TT)            ;SAVE THE WORD CONTAINING THE BYTE IN THE BUFFER
	HRLI TT,242000          ;A POINTER TO IT
	MOVEM TT,DATBPT(IDX)
	MOVEI T,1               ;ONE BYTE REMAINS
	MOVEM T,DATBCT(IDX)
	POPJ P,                 ;THEN WE ARE DONE

;Here if non-16bit byte mode but no bytes left over from last time, byte size in T
WRIBI1:	SETZM DATBCT(IDX)       ;Make sure byte count is 0
	HRLI T,440000           ;Prototype byte pointer
	DPB T,[300600,,T]       ;Deposit correct byte size into pointer
	HRR T,DATBUF(IDX)       ;Pointer to buffer
;;; Fall into WRIBI0

;Here if had some bytes left over from last time, T has the pointer to last byte written
WRIBI0:	LDB BC,[WRIPKT+$CPKNB]  ;COUNT OF BYTES IN PACKET
	LSH BC,-1		;16 bit mode only has half as many
	ADDM BC,DATLEN(IDX)	;Keep track of number of more bytes to write
	MOVEI C,(BC)            ;Save number of bytes
	ADD C,DATBCT(IDX)       ;Add in number of bytes left over
	HRRZ TT,DATBUF(IDX)     ;Pointer for SIOT (used later)
	HRLI TT,444400
	JUMPE BC,WRIBI6         ;If no bytes in packet, finish up here and now
	HRRI B,(T)              ;THIS IS THE FIRST WORD TO SIOT OUT OF
	MOVE BP,[442000,,WRIPKT+%CPKDT]
WRIBI4:	SOJL BC,WRIBI3          ;LOOP OVER ALL BYTES
	ILDB BYTE,BP
	IDPB BYTE,T
	JRST WRIBI4

WRIBI3:	HRRZ D,DATBPW(IDX)
	CAIGE C,(D)		;Enough bytes to make up a word?
	 JRST WRIBI6            ;Nope
	MOVE D,T		;Must increment byte pointer in case last byte was written
	IBP D
	SUBI D,(B)
	HRRZI B,(D)		;Get rid of byte pointer part
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,TT
		%CLIN+%CLEND,,B]
	SKIPA                   ;IOC error
	 JUMPE B,WRIBI6         ;Done writing successfully, so go on
	MOVEM TT,DATBPT(IDX)
	MOVEM B,DATBCT(IDX)
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,TT
	MOVN 3,B
	JUMPE 3,.+3
	SOUT
	 ERJMP .+2
	  JRST [PUSHJ P,ITSBP
		MOVE TT,2	;Rest of code needs updated pointer
		JRST WRIBI6]
	MOVEM 2,DATBPT(IDX)
	MOVNM 3,DATBCT(IDX)
]	;END IFN TNX
	HLL C,T			;Save final byte pointer
	MOVEM C,DATIOC(IDX)     ;Remember total number of bytes in buffer for continuation
	IOCERR WRIBI7           ;IOC ERROR, CONTINUATION TO WRIBI7

WRIBI7:	MOVE TT,DATBPT(IDX)     ;Restore byte pointer, IOC error handler leaves final ptr here
	HRRZ C,DATIOC(IDX)      ;Restore total number of bytes that were in buffer
	HLLZ T,DATIOC(IDX)	;Also restore left half of final byte pointer

;Here after IOC error fixed or after normal completion of output operation
WRIBI6:	SETZM DATBPT(IDX)       ;Assume no bytes left
	IDIV C,DATBPW(IDX)	;Remainder is number of bytes left over in last word
	JUMPE D,CPOPJ           ;We assumed correctly, no extra words
	HRR T,DATBUF(IDX)	;Pointer to buffer
	IBP TT			;Point at next byte to go out
	MOVE C,(TT)		;Get the last word which has extra bytes in it
	MOVEM C,(T)             ;Store as first word in buffer
	MOVEM T,DATBPT(IDX)	;New byte pointer
	MOVEM D,DATBCT(IDX)     ;And character count
	POPJ P,

;;; Force out any data remaining in the buffer.  Called from main program level.
;;; This is -NOT- for continuing from IOC errors, which is done by a different routine.
;;; It is for writing out a residual half-word in binary mode, or for
;;; writing out residual part-word characters in text mode.
WRIFOR:	SKIPN T,DATBPT(IDX)	;Any bytes in buffer?
	 POPJ P,                ;Nope, then done right now
	MOVE TT,DATSTA(IDX)	;Binary mode?
	TLNN TT,ST.BIN
	 JRST [	MOVE TT,DATBUF(IDX)	;Pointer to beginning of buffer
		HRLI TT,440700
		MOVE T,DATBCT(IDX)	;Number of bytes now in buffer
		JRST WRIFR1 ]
	HRRZS T			;Get rid of byte position and size info
	MOVE TT,DATBUF(IDX)     ;To build byte pointer
	HRLI TT,444400
	SUBI T,1(TT)            ;First calculate actual number of words to SIOT
	MOVMS T
WRIFR1:
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,TT
		%CLIN+%CLEND,,T]
	 JFCL                   ;IOC errors will get handled in the wash
	MOVEM T,DATBCT(IDX)     ;This will be 0 if no IOC error
	MOVEM TT,DATBPT(IDX)
	JUMPN T,CPOPJ           ;If got IOC error, return now
	SETZM DATBPT(IDX)       ;Else leave pointer zeroed out
	POPJ P,
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,TT
	MOVN 3,T
	JUMPE 3,.+3
	SOUT
	 ERJMP .+2
	  JRST [SETZM DATBPT(IDX)
		POPJ P,]
	MOVEM TT,DATBPT(IDX)
	MOVNM T,DATBCT(IDX)
	POPJ P,
]	;END IFN TNX

;;; Here to send one packet over a data conneciton.  IDX is set up.  Called with interrupts
;;; off so that the shared packet buffer may be used
REAONE:	MOVE A,DATSTA(IDX)	;Get channel state
	TLZE A,ST.SYN           ;Is a synchronous mark required on this channel?
	 JRST REASSY            ;Yes, send it (ignoring channel state)
	JRST @READSP(A)		;Actions to follow depend upon channel state

;Dispatch table
READSP:	REACLO                  ;Channel closed
	REAOPN                  ;Channel open, normal processing
	REAASY                  ;Asynchronous marked (should never happen)
	REASYN                  ;Synchronous marked state
	REAEOF                  ;EOF state

;Channel closed, at eof, or sync or asynch mark.  Interrupts shouldn't happen
; Channel cannot stay in synchronous mark state for any amount of time, so this shouldn't
; happen either
REACLO:
REAASY:
REASYN:
REAEOF:	AOS (P)
	POPJ P,

;Here to send sync mark
REASSY:	MOVEI T,CO%SYN          ;Synchronous mark opcode
	HRRI A,ST%SYN           ;Now in sync mark state
	PUSHJ P,REAEPK          ;Output the packet, but return here
	 JFCL
	PUSHJ P,@DATSYA(IDX)    ;Call the routine to process the synchronous mark
	MOVEM A,DATSTA(IDX)
	POPJ P,

;Here to send an empty packet, opcode is in T
REAEPK:	DPB T,[$CPKOP+REAPKT]   ;Deposit in packet
	SETZ T,
	DPB T,[$CPKNB+REAPKT]   ;Packet contains no information other than opcode
IFN ITS,[
	.CALL [ SETZ
		SIXBIT/PKTIOT/
		%CLIN,,CHACHN(IDX)
		%CLIMM+%CLEND,,REAPKT]
	 .LOSE %LSSYS
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOPKS
	MOVEI 3,REAPKT
	MTOPR
	 ERCAL CTLERR
]	;END IFN TNX
	MOVEM A,DATSTA(IDX)     ;Remember to save new status word
	AOS (P)			;Skip return
	POPJ P,

;Here when hit EOF.  Put channel into EOF state and send EOF packet
REAOEO:	HRRI A,ST%EOF           ;EOF state
	MOVEI T,%COEOF          ;Send eof packet
IFN ITS,[
	JRST REAEPK
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOEOF
	MTOPR
	 ERCAL CTLERR
	MOVEM A,DATSTA(IDX)
	AOS (P)
	POPJ P,
]	;END IFN TNX

;Here to send more data over the data connection
REAOPN:	TLNE A,ST.BIN           ;Binary mode?
	 JRST REABIN            ;Yes, requires different code
	SKIPG DATBCT(IDX)       ;Any bytes left in buffer?
	 PUSHJ P,REABUF         ;Nope, fill up buffer
	SKIPG T,DATBCT(IDX)     ;Did we get any bytes?
	 JRST REAOEO            ;Nope, put channel into EOF state and send an EOF packet
	MOVE TT,DATBPT(IDX)     ;Pointer into buffer
	SETZ BC,                ;No bytes in packet
	MOVE BP,[441000,,REAPKT+%CPKDT] ;Pointer to start of data in packet
REATXT:	ILDB BYTE,TT            ;Get next byte from file
	TLNN A,ST.RAW		;Raw mode means don't translate
	 XCT CHR2LM(BYTE)	;Check if any special processing is needed
	  AOJA BC,REATX0	;None needed, just output character
	  JRST REATX1		;Special processing is done, so just punt the byte
	  JRST REATX4		;Skipped twice, a rubout escape.
	MOVEI BYTE,"M		;CR, store as M for now in case no LF
	IDPB BYTE,BP
	ADDI BC,1
	SOJLE T,REATX5		;and absorb following linefeed if any
REATX6:	ILDB BYTE,TT
	CAIN BYTE,12
	 JRST [	MOVEI BYTE,215
		DPB BYTE,BP
		JRST REATX1]
	ADD TT,[070000,,]	;Not a line feed, put it back
	AOJA T,REATX1		;Treat stray CR as CRLF

REATX5:	PUSHJ P,REABUF		;Get next buffer, first char follows a CR
	SKIPG T,DATBCT(IDX)
	 JRST REATXS		;End of file
	MOVE TT,DATBPT(IDX)
	JRST REATX6

REATX4:	TLNE A,ST.SUI		;Super-image mode means just send rubouts
	 AOJA BC,[MOVEI BYTE,177 ? JRST REATX0]
	SOJLE T,REATX2		;Jump if end of file-buffer
REATX3:	ILDB BYTE,TT		;Get the byte that follows the rubout
	XCT CHRQLM(BYTE)	;Convert.  Will need no special processing
	ADDI BC,1
REATX0: IDPB BYTE,BP		;Store the byte
REATX1:	CAML BC,CHPMXC          ;Have we written the maximum number of bytes?
	 SOJA T,REATXS		;Yes, send the packet and return (account for byte as well)
	SOJG T,REATXT		;If more characters in buffer just go on
	PUSHJ P,REABUF          ;Read a new bufferful
	SKIPG T,DATBCT(IDX)     ;Did we get any more data?
	 JRST REATXS            ;Nope, just send what we have so far
	MOVE TT,DATBPT(IDX)     ;Else get the byte pointer
	JRST REATXT             ;And proceed with the transmission

REATX2:	PUSHJ P,REABUF		;Get next buffer, first char is quoted with rubout
	SKIPG T,DATBCT(IDX)
	 JRST REATXS		;Oops, end of file in bad place, ignore the stray rubout
	MOVE TT,DATBPT(IDX)
	JRST REATX3

;Here to store T and TT and send the packet
REATXS:	MOVEM T,DATBCT(IDX)     ;Save byte count
	MOVEM TT,DATBPT(IDX)    ;And pointer
	JUMPE BC,CPOPJ		;Don't bother transmitting if the packet is null
	MOVEI T,CO%TXT          ;Data opcode
	TLNE A,ST.BIN           ;Except if binary mode
	 TRO T,100              ;This is the correct opcode
	DPB T,[REAPKT+$CPKOP]
	DPB BC,[REAPKT+$CPKNB]
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /PKTIOT/
		%CLIN,,CHACHN(IDX)
		%CLIMM+%CLEND,,REAPKT]
	 .LOSE %LSSYS
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOPKS
	MOVEI 3,REAPKT
	MTOPR
	 ERCAL CTLERR
]	;END IFN TNX
	POPJ P,                 ;Packet has been transmitted, so return

;Here to read in binary mode
REABIN:	HRRZ T,DATBYT(IDX)      ;Get byte size
	SKIPG DATBCT(IDX)	;If bytes in the buffer
	 CAIE T,16.		; or if not 16 bit bytes, use slow mode
	  JRST REABIS
	MOVE T,CHPMXW		;Maximum number of words in a packet
	MOVE TT,[444400,,REAPKT+%CPKDT]
IFN ITS,[
	.CALL [ SETZ            ;Read data into the packet
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,TT
		%CLIN+%CLEND,,T]
	 JRST REABI0            ;Ioc error
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,TT
	MOVN 3,T		;Negative count is number of bytes we want
	SIN
	 ERCAL REAIOC		;Skips if IOC error as opposed to EOF
	  SKIPA
	   JRST REABI0
	MOVN T,3
	MOVE TT,2
]	;END IFN TNX
	CAMN T,CHPMXW		;Did we get any data at all?
	 JRST REAOEO            ;Nope, EOF: send EOF packet, change channel state, and return
	MOVE BC,CHPMXW		;Calculate actual number of bytes read
	SUBI BC,(T)
	LSH BC,2
	SETZB T,TT		;Don't get faked into thinking stuff is buffered
	JRST REATXS             ;Send the packet

;Here on IOC error
REABI0:	MOVE B,DATBUF(IDX)      ;SAVE PACKET IN IDX BUFFER
	MOVEI C,(B)             ;COPY FOR TERMINATION CONDITION
	HRLI B,REAPKT
	BLT B,%CPMXW-1(C)       ;SAVE ALL OF PACKET
	SUBI C,WRIPKT           ;OFFSET FOR BYTE POINTER
	ADD TT,C
	MOVEM TT,DATBPT(IDX)    ;SAVE POINTER
	MOVEM T,DATBCT(IDX)     ;AND SAVE COUNT
	IOCERR REABI1           ;GIVE THE IOC ERROR, CONTINUATION

;IOC error continuation
REABI1:	MOVE BC,CHPMXW		;Calculate actual number of bytes read
	SUB BC,DATBCT(IDX)
	LSH BC,1
	MOVEI T,CO%BDT          ;Data opcode
	DPB T,[REAPKT+$CPKOP]
	DPB BC,[REAPKT+$CPKNB]
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /PKTIOT/
		%CLIN,,CHACHN(IDX)
		%CLIMM+%CLEND,,DATBUF(IDX)]
	 .LOSE %LSSYS
]	;END IFN ITS
IFN TNX,[
	MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOPKS
	MOVEI 3,DATBUF(IDX)
	MTOPR
	 ERCAL CTLERR
]	;END IFN TNX
	POPJ P,                 ;Packet has been transmitted, so return

;Slow binary mode.  Read block into buffer and use ILDB/IDPB loop to fill packet
REABIS:	SKIPG DATBCT(IDX)       ;Any bytes left in buffer?
	 PUSHJ P,REABUF         ;Nope, fill up buffer
	SKIPG T,DATBCT(IDX)     ;Did we get any bytes?
	 JRST REAOEO            ;Nope, put channel into EOF state and send an EOF packet
	MOVE TT,DATBPT(IDX)     ;Pointer into buffer
	SETZ BC,                ;No bytes in packet
	MOVE BP,[442000,,REAPKT+%CPKDT] ;Pointer to start of data in packet
REABS0:	ILDB BYTE,TT            ;Get next byte from file
	IDPB BYTE,BP            ;Store the byte
	ADDI BC,2		;Two more bytes
	CAML BC,CHPMXC		;Have we written the maximum number of bytes?
	 SOJA T,REATXS		;Yes, send the packet and return
	SOJG T,REABS0		;If more characters in buffer just go on
	HRRZ T,DATBYT(IDX)	;This 16 bit byte mode?
	CAIN T,16.
	 JRST REABS1		;Yup, send a small packet and do the rest quickly
	PUSHJ P,REABUF          ;Read a new bufferful
	SKIPG T,DATBCT(IDX)     ;Did we get any more data?
	 JRST REATXS            ;Nope, just send what we have so far
	MOVE TT,DATBPT(IDX)     ;Else get the byte pointer
	JRST REABS0             ;And proceed with the transmission

REABS1:	SETZB T,TT		;Make sure we go through fast path next time
	JRST REATXS


;;; Routine to fill up in-core buffer
;;; Destroy's: B, C, D, T, TT
REABUF:	MOVE T,DATBUF(IDX)      ;Pointer to the buffer
	HRLI T,440700           ;Assume 7 bit bytes
	TLNE A,ST.BIN           ;Binary mode?
	 HRLI T,444400          ;Yes, really 36 bit bytes
	MOVEM T,DATBPT(IDX)     ;Byte pointer if no IOC error
	MOVEI TT,2000*5         ;This is correct number of bytes for text mode
	TLNE A,ST.BIN           ;But is it binary mode?
	 MOVEI TT,2000          ;Yes, then this is correct byte count
	MOVEI B,(TT)            ;Count expected maximally
	TLNN A,ST.BIN		;Can't have saved word in binary mode
	 SKIPN D,DATLWD(IDX)	;Do we have a saved last word?
	  JRST REABF6		;Nope, proceed normally
	SETZM DATLWD(IDX)	;No more last word
	MOVEM D,(T)		;Save the word as first buffer word
	ADDI T,1		;Increment pointer
	SUBI TT,5		;Read 5 fewer bytes
REABF6:	TLNE A,ST.DIR		;Directory listing?
	 JRST REDRBF		;Yes, handled specially
IFN ITS,[
	.CALL [ SETZ
		SIXBIT /SIOT/
		%CLIN,,DATCHN(IDX)
		%CLIN,,T
		%CLIN+%CLEND,,TT]
	 JRST REABF1            ;IOC error
]	;END IFN ITS
IFN TNX,[
	MOVE 1,DATJFN(IDX)
	MOVE 2,T
	MOVN 3,TT		;Negative count is number of bytes we want
	SIN
	 ERCAL REAIOC		;Skips if IOC error as opposed to EOF, sets up T and TT
	  SKIPA
	   JRST REABF1
	MOVN TT,3
	MOVE T,2
]	;END IFN TNX
REABF3:	SUBI B,(TT)             ;Actual number of bytes read
	TLNN A,ST.BIN		;Binary mode?
	 JRST REABF4		;Nope, no special processing
	HRRZ D,DATBYT(IDX)
	DPB D,[300600,,DATBPT(IDX)] ;Correct size bytes
	MOVEI C,36.		;Have number of 36 bit words, need number of real bytes
	IDIVI C,(D)
	IMULI B,(C)		;Calculate actual number of bytes read
REABF4:	MOVEM B,DATBCT(IDX)     ;Remember count
IFN TNX,[
	POPJ P,			;No need to do trailing control-C checking here
]	;END IFN TNX
IFN ITS,[
	SKIPE B			;Return right away if we read nothing
	 TLNE A,ST.BIN		;If binary mode then done
	  POPJ P,
IFN ITS,[
;; TT has number of bytes we tried to read, T has pointer to last byte hacked (almost...)
;; Due to gross ITS lossage, check for initial special case of 440700,, and
;; fix it
	HLRZ TT,T
	CAIN TT,440700
	 SUB T,[430000,,1]
]	;END IFN ITS
	CAIE TT,(B)		;If we got less than we wanted, we hit EOF
	 JRST READLC
;; We got a full bufferload, but we may have hit EOF!  So, must save last word and tack
;; it on next time when we'll know for sure whether we got to EOF
	MOVE TT,(T)		;Get the last word
	TRO TT,1		;Force it to be non-zero by setting bit 35 (argghh!)
	MOVEM TT,DATLWD(IDX)	;Save the "Last word"
	SUBI B,5	
	MOVEM B,DATBCT(IDX)
	POPJ P,

;; Search backwards removing trailing eof chars from the last word
;; T has BP to last byte read, B has count of bytes
READLC:	LDB TT,T                ;Get last character
	CAIE TT,^C
	 CAIN TT,^L
	  SOJG B,[ ADD T,[070000,,]
		   JUMPGE T,READLC
		   SUB T,[430000,,1]
		   JRST READLC]
	JUMPE B,REABUF		;Get another bufferful if no valid bytes found
	MOVEM B,DATBCT(IDX)     ;Store number of bytes in buffer
	POPJ P,                 ;Then return
]	;END IFN ITS

REABF1:	POP P,DATIOC(IDX)       ;Save address of our caller
	HRLM B,DATIOC(IDX)      ;Also save total number of bytes to be read
	MOVEM T,DATBPT(IDX)     ;Pointer
	MOVEM TT,DATBCT(IDX)    ;Remaining bytes to read
	IOCERR REABF2

REABF2:	PUSH P,DATIOC(IDX)      ;Restore adr of our caller
	HLRZ B,DATIOC(IDX)      ;Total number of bytes expected
	MOVE TT,DATBCT(IDX)     ;Need bytes left to read
	JRST REABF3

IFN TNX,[
REAIOC:	MOVE T,2		;Updated byte pointer
	MOVN TT,3		;Updated count
	MOVEI 1,.FHSLF		;Get last error
	PUSHJ P,$GETER
	 JFCL
	HRRZS 2			;Only error number
	CAIE 2,IOX4		;EOF, so non-skip
	 AOS (P)
	MOVE 2,T		;Callers expect these results in 2 and 3
	MOVN 3,TT
	POPJ P,

$GETER:
IFN 10X,[
	PUSH P,4
	PUSH P,5
	PUSH P,6
	PUSH P,7
	PUSH P,10
]
	GETER
	 ERJMP .+2
IFN 10X,[
	 AOS -5(P)
	POP P,10
	POP P,7
	POP P,6
	POP P,5
	POP P,4
]
.ELSE	 AOS (P)
	POPJ P,

]	;END IFN TNX

;Interrupt table
IFN ITS,[
INTTAB:
	LOC 42
	-INTLEN,,INTTAB
LOC INTTAB
	17,,P
	%PIIOC ? 0 ? %PIIOC+%PIDBG+%PIDWN ? 177777 ? IOCINT
	%PIDBG ? 0 ? %PIDBG+%PIDWN ? 0 ? DBGINT
	%PIDWN ? 0 ? %PIDBG+%PIDWN ? 0 ? DWNINT
REPEAT MAXIDX,[
	0 ? 1_<.RPCNT+3> ? %PIDBG+%PIDWN ? 177777 ? CHAINT+<2*.RPCNT>
]

INTLEN==.-INTTAB

;;; Here on receipt of channel interrupt from one of the chaosnet channels.
;;; Figure out which one, and perform the appropriate actions.  All AC's saved by system.
;;; All other channel interrupts deffered
CHAINT:	MOVEI IDX,0             ;IDX will contain index that got interrupt
	JRST CHAIN0
	MOVEI IDX,1
	JRST CHAIN0
	MOVEI IDX,2
	JRST CHAIN0
	MOVEI IDX,3
	JRST CHAIN0
	MOVEI IDX,4
	JRST CHAIN0
	MOVEI IDX,5
;	JRST CHAIN0
CHAIN0:	PUSHJ P,CHALOP          ;Handle this IDX
	MOVE T,SSYDF2		;Cause correct DF2 when dismissed
	MOVEM T,-20(P)		;Correct offset: all AC's, the old PC
	.CALL [ SETZ
		SIXBIT /DISMIS/
		%CLBTW,,INTTAB
		%CLIN+%CLEND,,P]
	 .LOSE %LSSYS

;Here with IDX properly set up
CHALOP:	.CALL [ SETZ            ;Find out why the interrupt happened
		SIXBIT /WHYINT/
		%CLIN,,CHACHN(IDX)
		%CLOUT,,T       ;%WYCHA
		%CLOUT,,T       ;State
		%CLOUT+%CLEND,,TT] ;#in packets available ,, #out packets available
	 .LOSE %LSSYS           ;Hmm...
	JRST CHAIND(T)          ;Dispatch on state
]	;END IFN ITS

;Dispatch table for channel state
CHAIND:	JRST CHACLS             ;Closed, so close down the channel (protocol violation!!)
	JRST CHALSN             ;Listen!!
	JRST CHARFC             ;RFC received!!(!!)
	JRST CHARFS             ;RFC SENT!!!!!! (This is getting out of hand...)
	JRST CHAOPN             ;Open ("Better, better")
	JRST CHALOS             ;Hmm...LOS received
	JRST CHAINC             ;Incomplete [poor Lisp Machine died....]


CHARFS:	POPJ P,
CHALSN:
CHARFC:

CHALOS:
CHAINC:			
CHACLS:
;;; Hmmm...Lisp Machine went down or forgot us.  Go away if it was a channel in active
;;; use.  If not, it is possible that it was a channel that failed to open correctly,
;;; in which case it was just timing out.  That's probably ok.
	TRZ IDX,1		;Check input and output
	SKIPL DATSTA(IDX)
	 SKIPGE DATSTA+1(IDX)
	  PUSHJ P,CTLDON	;If either channel in use, Lisp Machine must have gone away.
	JRST CHNFLS		;Flush channels, then return

CHAOPN:	TRNE IDX,1              ;Reading or writing?
	 JRST CHAOPO            ;Writing, handle slightly differently
	TRNN TT,-1              ;Any output packets available?
	 POPJ P,                ;Nope, then done...just return
	PUSHJ P,REAONE          ;Handle the packet
	 JRST CHALOP            ;Loop if no error
	POPJ P,                 ;Else return

CHAOPO:	TLNN TT,-1              ;Any packets to read?
	 POPJ P,                ;Nope
	PUSHJ P,WRIONE
	 JRST CHALOP
	POPJ P,                 ;Error, return right away


IFN ITS,[
;;; IOC error handler

IOCINT:	.SUSET [.RBCHN,,T]	;Get channel that had error
	CAIL T,CHALOW
	 CAILE T,CHAHIG
	  JRST IOCDAT		;Not CHAOS channel, must be data error
	PUSHJ P,CTLDON		;Else something happened to Lisp Machine, we are done

IOCDAT:	AOS -17(P)		;Setup to return to location after call which caused error
	.CALL [ SETZ
		SIXBIT /DISMIS/
		%CLBTW,,INTTAB
		%CLIN+%CLEND,,P]
	 .LOSE %LSSYS

;;; System going down and system being debugged inform user then exit to CTLLOP
DBGINT:	PUSHJ P,DWNIN1		;Set up to return notification
	MOVEI A,[ASCIZ/system being debugged./]
	SKIPN C
	 MOVEI A,[ASCIZ/system no longer being debugged./]
DWNIN2:	PUSHJ P,COMSTO
DWNIN9:	.CLOSE ERRCH,
	MOVEI T,CO%NOT
	PUSHJ P,COMSN1
	JRST CTLLOP

DWNIN1:	MOVE BP,[441000,,%CPKDT+CTLPKO]
	SETZ BC,
	.CALL [ SETZ ? 'SSTATU ? MOVEM B ? SETZM C ]
	 .LOSE %LSSYS
	POPJ P,

DWNINT:	PUSHJ P,DWNIN1
	MOVEI A,[ASCIZ/system revived./]
	JUMPL B,DWNIN2
	MOVEI A,[ASCIZ/system going down in /]
	PUSHJ P,COMSTO
	IDIVI B,30.
	IDIVI B,60.		;B minutes until down, C seconds
	SKIPN A,B
	 JRST DWNIN3
	PUSHJ P,COMDCO
	MOVEI A,[ASCIZ/ minutes, /]
	PUSHJ P,COMSTO
DWNIN3:	MOVE A,C
	PUSHJ P,COMDCO
	MOVEI A,[ASCIZ/ seconds./]
	PUSHJ P,COMSTO
	.OPEN ERRCH,[.UAI,,'SYS ? SIXBIT/DOWN/ ? SIXBIT/MAIL/]
	 JRST DWNIN9
	MOVEI BYTE,215
DWNIN4:	CAMGE BC,CHPMXC
	 CAIGE BYTE,40
	  CAIA
	   PUSHJ P,COMCHO
	.IOT ERRCH,BYTE
	JUMPL BYTE,DWNIN9	;EOF
	CAIN BYTE,15
	 MOVEI BYTE,215
	JRST DWNIN4
]	;END IFN ITS

IFN TNX,[
LEVTAB:	0,,PRILE1
	0,,PRILE2
	0,,PRILE3

CHNTAB:	3,,INTID0		;Interrupt IDX 0 (channel 0)
	3,,INTID1		;Interrupt IDX 1
	3,,INTID2
	3,,INTID3
	3,,INTID4
	3,,INTID5		;Interrupt IDX 5 (channel 6)
	0			;Arithmetic overflow
	0			;Floating overflow
	0			;Reserved for D.E.C.
	1,,CTLERR		;PDL overflow
	1,,CTLERR		;EOF
	1,,CTLERR		;Data error
	1,,CTLERR		;Disk full or quota exceeded
	0 ? 0			;Reserved
	1,,CTLERR		;Illegal instruction
	1,,CTLERR		;Illegal read
	1,,CTLERR		;Illegal write
	0			;Reserved
	1,,CTLERR		;Inferior termination or freeze
	1,,CTLERR		;System resources exhausted
	0			;Reserved
	0			;Reference to non-existant page
	3,,INTID6		;Interrupt IDX 6 (channel 23.)
	3,,INTID7
	3,,INTID8
	3,,INTID9
	3,,INTIDA		;Interrupt IDX 10. (channel 27.)
	3,,INTIDB
	3,,INTIDC		;IDX 12.
	3,,INTIDD		;IDX 13.
	3,,INTIDE		;IDX 14.
	3,,INTIDF		;IDX 15.
	3,,TIMINT		;Timer interrupt
	0 ? 0			;34. and 35. reserved by monitor if 
				; the job runs at toplevel

INDEX=0
IRPS NAME,,[0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F]
INTID!NAME: JSR LV1SAC		;Save AC's
	    MOVEI IDX,INDEX
	    JRST CHAIN0
INDEX=INDEX+1
TERMIN

CHAIN0:	PUSHJ P,CHALOP
INTDEB:	MOVE 0,[LV1ACS+1,,1]
	BLT 0,17
	MOVE 0,LV1ACS
	DEBRK

;Here with IDX properly set up
CHALOP:	MOVE 1,CHAJFN(IDX)
	GDSTS			;This gets state in 2, and number of input packets in 3
	 ERCAL CTLERR
	MOVE T,2
	HRLZ TT,3
	MOVE 1,CHAJFN(IDX)
	MOVEI 2,.MOAWS
	MTOPR
	 ERCAL CTLERR
	HRR TT,3
	JRST CHAIND(T)          ;Dispatch on state

;Timer interrupt
TIMINT:	JSR LV1SAC
	PUSHJ P,TIMIN1
	JRST INTDEB		;Dismiss interrupt

;;;Here to initialize the timer
TINTVL==2*60.*1000.		;Every two minutes
TIMRKS:	30. ? 15. ? 10. ? 5. ? 1. ? -30.	;Times at which to notify

TIMIN1:	SKIPL TIMINF		;Ok for timer interrupt?
	 JRST [	AOS TIMINF	;No, note that one went off
		JRST SETTIM]	;And skip downtime check for now
	PUSHJ P,DWNCHK
	JRST SETTIM

DWNCHK:
IFN 10X,MOVE 1,[SIXBIT /SYSTAT/]
.ELSE	MOVE 1,[SIXBIT /DWNTIM/]
	SYSGT
	HRRZ A,2		;Table number
	MOVE 1,A
IFN 10X,HRLI 1,27
	GETAB
	 SETZ 1,
	JUMPE 1,NODWNT
	MOVE C,1
	GTAD
	SUB C,1			;Get time until shutdown
	TLNE C,-1		;More than a day?
	 JRST NODWNT
IFN 10X,IDIVI C,60.		;Into minutes
.ELSE [
	IMULI C,24.*60.
	HLRZS C
]
	SETZ D,
	CAMG C,TIMRKS(D)	;Find range of time
	 AOJA D,.-1
	JUMPE D,NODWNT		;More than maximum time
	CAMN D,DWNTIM		;Same as last notification?
	 POPJ P,		;Yes
	MOVEM D,DWNTIM
IFN 10X,SETOM DWNTIM+1
	PUSHJ P,DWNIN1
	MOVEI A,[ASCIZ /system going down in /]
	PUSHJ P,COMSTO
	MOVE A,C
	PUSHJ P,COMDCO
	MOVEI A,[ASCIZ / minute/]
	PUSHJ P,COMSTO
	MOVEI BYTE,"s
	CAIE C,1
	 PUSHJ P,COMCHO
	MOVEI BYTE,".
	PUSHJ P,COMCHO
	JRST DWNIN2
	
NODWNT:	SKIPN DWNTIM
	 POPJ P,
IFN 10X,[
	AOSN DWNTIM+1		;Tenex cancels shutdown just before shutting down
	 POPJ P,		;So don't say it's cancelled until it's cancelled twice
];10X
	SETZM DWNTIM
	PUSHJ P,DWNIN1		;Set up to return notification
	MOVEI A,[ASCIZ/shutdown cancelled./]
	PUSHJ P,COMSTO
DWNIN2:	MOVEI T,CO%NOT
	JRST COMSN1

DWNIN1:	MOVE BP,[441000,,%CPKDT+CTLPKO]
	SETZ BC,
	POPJ P,

;; Setup timer interrupt
SETTIM:	
IFN 20X,[
	MOVE 1,[.FHSLF,,.TIMEL]	;Tick the timer
	MOVE 2,[TINTVL]
	MOVEI 3,33.		;On channel 33
	TIMER
	 JFCL
];IFN 20X
.ELSE [
IFNDEF IIT,IIT=JSYS 630
	MOVEI 1,.FHSLF		;This fork
	MOVEI 2,4		;On channel 33.
	MOVE 3,[TINTVL]
	IIT			; Set to trigger it
];10X
	POPJ P,


;;; Print the contents of a Chaosnet packet.  A has the byte-count,
;;; and B a BP to the data area.

IFN $$LOG,[

PktPrt:	Move 1,TriJFN
	Movei 2,^I
	BOUT
	Setz 3,
PP0::	Sojl A,PP1
	Ildb 2,B
	Cain 2,215
	  Jrst [Hrroi 2,[Asciz "<NL>"]
		SOUT
		Jrst PP0]
	BOUT
	Jrst PP0
PP1:	Hrroi 2,[Asciz "<EOP>
"] ?	SOUT
	Popj P,

];$$LOG
];END IFN TNX

;;; Character translation tables

;Byte is a pdp10 character to be sent to Lisp machine.
;This table used when not preceded by rubout escape.
;Skip once to ignore it, twice if this is rubout escape, three times for CR.
CHR2LM:	REPEAT 10, JFCL		;0 through 7, leave alone
	REPEAT 3, ADDI BYTE,200 ;10 through 12 turn into backspace, tab, linefeed
	JFCL                    ;13 stays as uparrow
	ADDI BYTE,200		;14 form
	JSP BYTE,[JRST 3(BYTE)]	;15 skip three times for carriage return
	REPEAT 177-16, JFCL	;16-176 unchanged
	JSP BYTE,[JRST 2(BYTE)]	;177 skip twice for quoting special character
IFN .-CHR2LM-200, .ERR CHR2LM table not 200 long

;This table used when preceded by rubout escape.
CHRQLM:	REPEAT 10, ADDI BYTE,200	;0-7 => 200-207
	REPEAT 3,JFCL		;10-12 self
	ADDI BYTE,200		;13 => 213
	REPEAT 2, JFCL		;14, 15 self
	REPEAT 177-16, ADDI BYTE,200	;16-176 => 216-376
	JFCL			;177 self
IFN .-CHRQLM-200, .ERR CHRQLM table not 200 long

;BYTE is a lisp-machine character to be put into pdp10 buffer via BP and BC
;Skip to ignore it.
CHR210:	REPEAT 10, JFCL		;0 through 7, leave alone
	REPEAT 3, PUSHJ P,CHRQ10	;10, 11, 12 hidden under backspace, tab, lf
	JFCL			;13 stays as uparrow
	REPEAT 2, PUSHJ P,CHRQ10	;14, 15 hidden under form, cr
	REPEAT 177-16, JFCL	;No change to 16 through 176
	REPEAT 11, PUSHJ P,CHRQ10	;177-207 quoted
	REPEAT 3, SUBI BYTE,200 ;Scale down to PDP-10 equivalents for 210 - 212
	PUSHJ P,CHRQ10		;213 quoted
	SUBI BYTE,200		;Scale down to PDP-10 equivalent for 214
	PUSHJ P,[MOVEI BYTE,15  ;Insert <CR><LF> for newline
		 IDPB BYTE,BP
		 ADDI BC,1
		 MOVEI BYTE,12
		 POPJ P,]
	REPEAT 377-216, PUSHJ P,CHRQ10	;216-376 quoted
	SKIPA			;377 ignored
IFN .-CHR210-400, .ERR CHR210 table not 400 long

CHRQ10:	TLNE A,ST.SUI		;Super-image mode
	 POPJ P,		;Just output byte with no quoting in super-image mode
	HRLM BYTE,(P)		;Output this byte preceded by 177 to quote it
	MOVEI BYTE,177
	IDPB BYTE,BP
	ADDI BC,1
	HLRZ BYTE,(P)
	POPJ P,

;Error code table

IFN ITS,[
ERRTAB:	%ERODV,,'ACC		;ACCESS ERROR--DEVICE WRITE-LOCKED
	%ELCDV,,'ACC		;ACCESS ERROR--LOCAL DEVICE ONLY
	%EMCHN,,'ACC		;ACCESS ERROR--DEVICE NOT ASSIGNABLE TO THIS PROCESSOR
	%ETMDR,,'CCD		;CANNOT CREATE DIRECTORY--MFD FULL
	%ETMLK,,'CIR		;CIRCULAR LINK
	%ETMTR,,'CIR		;CIRCULAR "LINK"--TOO MANY TRANSLATIONS
	%ENSDV,,'DEV		;DEVICE NOT FOUND
	%ENSDR,,'DNF		;DIRECTORY NOT FOUND
	%ENSFL,,'FNF		;FILE NOT FOUND
	%ENAFL,,'LCK		;FILE LOCKED
	%EBDLK,,'LNF		;LINK TO NONEXISTENT FILE
	%ENRDV,,'NAV		;EXISTS BUT NOT AVAILABLE--DEVICE NOT READY
	%ENAPK,,'NAV		;--PACK NOT MOUNTED
	%ENADV,,'NAV		;--DEVICE NOT AVAILABLE
	%ENACR,,'NER		;NOT ENOUGH RESOURCES--NO CORE AVAILABLE
	%EFLDR,,'NMR		;NO MORE ROOM--DIRECTORY FULL
	%EFLDV,,'NMR		;NO MORE ROOM--DEVICE FULL (SHOULD BE NER SOMETIMES!)
	%EEXFL,,'REF		;RENAME TO EXISTING FILE
	%ENSMD,,'WKF		;WRONG KIND OF FILE--MODE NOT AVAILABLE
	%EBDDV,,'WKF		;WRONG KIND OF DEVICE

	;IOC errors.  These don't seem to have symbolic names.
	1000,,'MSC		;DEVICE HUNG OR REPORTING NON-DATA ERROR
	2000,,'FOR		;END OF FILE
	3000,,'DAT		;NON-RECOVERABLE DATA ERROR
	4000,,'DEV		;NON-EXISTENT SUB-DEVICE (?)
	;5000,,'BUG		;OVER IOPOP
	;6000,,'BUG		;OVER IOPUSH
	7000,,'WKF		;USR OP CHNL DOES NOT HAVE USR OPEN
	;10000,,'BUG		;CHNL NOT OPEN
	11000,,'NMR		;DEVICE FULL
	12000,,'WKF		;CHNL IN ILLEGAL MODE ON IOT
	13000,,'DAT		;ILLEGAL CHR AFTER CNTRL P ON TTY DISPLAY (?)
	14000,,'NMR		;DIRECTORY FULL
LERRTB==.-ERRTAB
];ITS

IFN TNX,[
ERRTAB:	GJFX29,,'ACC		;ACCESS ERROR--DEVICE NOT AVAILABLE TO THIS JOB
	ACESX7,,'ACC		;ACCESS ERROR--DIRECTORY IS FILES-ONLY
	CFDBX2,,'ACC		;ACCESS ERROR--INVALID TO CHANGE SPEC'D BITS
	CFDBX3,,'ACC		;ACCESS ERROR--WRITE OR OWNER ACCESS REQUIRED
	CRDIX1,,'ACC		;ACCESS ERROR--WHEEL/OPERATOR REQUIRED
	DELFX1,,'ACC		;ACCESS ERROR--DELETE ACCESS REQUIRED
	OPNX12,,'ACC		;--LIST ACCESS REQUIRED
	OPNX25,,'ACC		;--DEVICE WRITE-LOCKED
	CAPX1,,'ACC		;--WHEEL/OPERATOR
	CAPX2,,'ACC		;--WHEEL/OPERATOR/MAINTENANCE
	DELDX1,,'ACC		;--WHEEL/OPERATOR
	WHELX1,,'ACC		;--WHEEL/OPERATOR
	GTDIX1,,'ACC		;--WHEEL/OPERATOR
	MTOX7,,'ACC		;--WHEEL/OPERATOR
	CNDIX2,,'ACC		;--WHEEL/OPERATOR
IFDEF ACJX01,[			;MIT addition: access control job
	ACJX01,,'ACC
]
	GJFX35,,'ATD		;INCORRECT ACCESS TO DIRECTORY
	ACESX3,,'ATD		;INCORRECT ACCESS TO DIRECTORY--PASSWORD REQUIRED
	OPNX3,,'ATF		;ACCESS TO FILE--READ
	OPNX4,,'ATF		;ACCESS TO FILE--WRITE
	OPNX5,,'ATF		;ACCESS TO FILE--EXECUTE
	OPNX6,,'ATF		;ACCESS TO FILE--APPEND
	OPNX15,,'ATF		;ACCESS TO FILE--READ/WRITE
	RNAMX3,,'ATF		;ACCESS TO FILE--RENAME DESTINATION
	RNAMX8,,'ATF		;ACCESS TO FILE--RENAME SOURCE
	CRDI10,,'CCD		;CANNOT CREATE DIR--MAX DIR NUM EXCEEDED
	CRDI13,,'CCD		;--EXCEEDS WORKING QUOTA
	CRDI14,,'CCD		;--EXCEEDS PERMANENT QUOTA
	CRDI15,,'CCD		;--EXCEEDS SUBDIRECTORY QUOTA
	CRDI16,,'CCD		;--INVALID USER GROUP
	CRDI17,,'CCD		;--ILLEGAL LOGIN SUBDIR UNDER FILES-ONLY
	CRDI20,,'CCD		;--CANNOT CREATE DIR WITH NOT-HELD CAPABILITY
	CRDI21,,'CCD		;--WORKING SPACE TOO SMALL
	CRDI22,,'CCD		;--SUBDIR QUOTA TOO SMALL
	CRDI24,,'CCD		;--INVALID SUBDIR QUOTA
	CRDIX4,,'CCD		;--SUPERIOR DIRECTORY FULL
IFDEF CRDX01,[			;MIT addition: more CRDIR errors with inconsistent names
	CRDX01,,'CCD		;--SUPERIOR MAY NOT HAVE LOGIN SUBDIRECTORIES
	CRDX02,,'CCD		;--CREATE-LOGIN-SUBDIRECTORIES CAP REQUIRED
	CRDX03,,'CCD		;--DIRECTORY MUST BE FILES-ONLY
];CRDX01
	SFUSX6,,'CSP		;CAN'T SET PROPERTY--NO SUCH USER
	GJFX39,,'CIR		;CIRCULAR "LINK"--LOGICAL NAME LOOP
	CRDIX2,,'DAE		;DIR ALREADY EXISTS--ILLEGAL TO CHANGE DIR NUMBER
	IOX5,,'DAT		;DATA ERROR
	OPNX16,,'DAT		;DATA ERROR--INDEX BLOCK BAD
	GJFX16,,'DEV		;DEVICE NOT FOUND
	DELX13,,'DND		;DONT-DELETE SET--PERPETUAL
	GJFX17,,'DNF		;DIRECTORY NOT FOUND
	CRDI23,,'DNF		;SUPERIOR DIRECTORY NOT FOUND (CRDIR)
	GJFX27,,'FAE		;FILE ALREADY EXISTS
	GJFX18,,'FNF		;FILE NOT FOUND--NO SUCH NAME
	GJFX19,,'FNF		;FILE NOT FOUND--NO SUCH TYPE
	GJFX20,,'FNF		;FILE NOT FOUND--NO SUCH VERSION
	GJFX24,,'FNF		;FILE NOT FOUND
	GJFX52,,'FNF		;FILE NOT FOUND--END OF TAPE REACHED WHILE SEARCHING
	OPNX2,,'FNF		;FILE NOT FOUND--DOES NOT EXIST
	GJFX10,,'IPS		;INVALID PATHNAME SYNTAX--NON-NUMERIC VERSION
	GJFX11,,'IPS		;--MORE THAN ONE VERSION NUMBER
	GJFX33,,'IPS		;--FILENAME NOT SPECIFIED
	GJFX4,,'IPS		;--INVALID CHARACTER
	GJFX6,,'IPS		;--DEVICE FIELD MISPLACED
	GJFX7,,'IPS		;--DIRECTORY FIELD MISPLACED
	GJFX8,,'IPS		;--GREATER THAN MISPLACED
	GJFX9,,'IPS		;--MORE THAN ONE NAME
	GJFX40,,'IPS		;--UNDEFINED ATTRIBUTE
	GJFX5,,'IPS		;--FIELD LONGER THAN 39 CHARS
	CFDBX4,,'IPV		;INVALID PROPERTY VALUE
	LGINX4,,(SIXBIT/IP?/)	;INVALID PASSWORD
	CRDIX6,,'LCK		;FILE LOCKED--DIRECTORY FILE IS MAPPED
	CRDIX7,,'LCK		;--FILES OPEN IN DIR
	CRDI18,,'LCK		;--LOGIN DIR
	CRDI19,,'LCK		;--CONNECTED DIR
	OPNX9,,'LCK		;--INVALID SIMULTANEOUS ACCESS
	RNMX10,,'LCK		;FILE LOCKED--RENAME SOURCE IS OPEN
	LGINX1,,'LIP		;LOGIN PROBLEM--INVALID ACCOUNT
	LGINX2,,'LIP		;--FILES-ONLY
	LGINX3,,'LIP		;--DIRECTORY FUKT
	GJFX28,,'NAV		;NOT AVAILABLE--DEVICE NOT ONLINE
	OPNX7,,'NAV		;--ASSIGNED TO OTHER JOB
	OPNX8,,'NAV		;--NOT ONLINE
	DELX11,,'NAV		;--CAN'T DELETE WHEN ARCHIVED
	OPNX30,,'NAV		;--CAN'T OPEN WHEN ARCHIVED
	OPNX31,,'NAV		;--FILE OFFLINE
	CRDI12,,'NAV		;STRUCTURE IS NOT MOUNTED
IFDEF IOX35,[			;20X Release 5 addition
	IOX35,,'NAV		;Disk structure damaged--cannot allocate space
];IOX35
	LGINX6,,'NER		;NOT ENOUGH RESOURCES--NO JOB SLOTS
	CRDIX3,,'NER		;NOT ENOUGH RESOURCES--JSB FULL
	OPNX17,,'NER		;NOT ENOUGH RESOURCES--NO ROOM FOR LONG FILE PAGE TABLE
	GJFX22,,'NER		;NOT ENOUGH RESOURCES--JSB FULL
	GJFX3,,'NER		;NOT ENOUGH RESOURCES--NO JFN SLOTS
	ACESX2,,'NER
	IOX12,,'NER		;--SWAP SPACE FULL
	MONX01,,'NER
	MONX02,,'NER		;--JSB FULL
	MONX04,,'NER		;--SWAP SPACE FULL
	MONX05,,'NER		;--NO RESIDENT FREE SPACE
	RNMX13,,'NER
	GJFX23,,'NMR		;NO MORE ROOM--DIRECTORY FULL
	IOX11,,'NMR		;NO MORE ROOM--QUOTA EXCEEDED OR DISK FULL
	OPNX10,,'NMR		;NO MORE ROOM--STRUCTURE FULL
	OPNX23,,'NMR		;NO MORE ROOM--QUOTA EXCEEDED
	RNAMX4,,'NMR		;NO MORE ROOM--QUOTA EXCEEDED IN RENAME DESTINATION
IFDEF IOX34,[			;20X Release 5 addition
	IOX34,,'NMR		;Disk structure completely full
];IOX34
	RNAMX1,,'RAD		;RENAME ACROSS DIRECTORIES--ACROSS DEVICES ACTUALLY
	RNMX12,,'REF		;RENAME TO EXISTING FILE--SELF
	RNAMX2,,'REF		;--FILE NOT CLOSED
	GJFX38,,'WKF		;WRONG KIND OF FILE--OUTPUT-ONLY DEVICE
	OPNX13,,'WKF		;--"INVALID ACCESS REQUESTED" (Read of a dir gives this)
	OPNX14,,'WKF		;--"INVALID MODE REQUESTED"
	GJFX31,,'WNA		;WILDCARD NOT ALLOWED--INVALID WILDCARD DESIGNATOR
	GJFX34,,'WNA		;--INVALID QUESTION MARK

LERRTB==.-ERRTAB
];TNX
	0,,'BUG			;If run off end of table

PAT:
PATCH:	BLOCK 100

;;; Start here to install
PURIFY:	SETZM DEBUG
IFN ITS,[
	MOVE T,[-<PURPND-NIMPUR>,,NIMPUR]
	.CALL [ SETZ ? 'CORBLK ? MOVEI %CBNDR ? MOVEI %JSELF ? T ? SETZI %JSELF ]
	 .LOSE %LSSYS
	.VALUE [ASCIZ/:PDUMP DSK:DEVICE;CHAOS FILE/]
];END IFN ITS
IFN TNX,[
	HLRO 1,JOBSYM		;Find end of symbol table
	MOVNS 1
	ADD 1,JOBSYM
	HRRZS 1
	CAIG 1,PURPND*1000
	 JRST PURIF1
	HRROI 1,[ASCIZ/Not enough space left for symbol table/]
	PSOUT
	HALTF

PURIF1:	MOVEI 1,.FHSLF
	MOVE 2,[1,,FILE]
	SEVEC
	SETOB 2,3
	EPCAP
	MOVSI 1,(GJ%SHT+GJ%FOU+GJ%NEW)
RADIX 10.
IFN 20X,HRROI 2,[CONC [ASCIZ /SYSTEM:CHAOS.FILE.],\.FVERS,/]
IFN 10X,HRROI 2,[CONC [ASCIZ /DSK:<SYSTEM>CHAOS.FILE;],\.FVERS,/]
RADIX 8
	GTJFN
	 HALTF
	HRLI 1,.FHSLF
	MOVEI 2,[ -NIMPUR,,520000	;Low impure copy on write
		  -<PURPND-NIMPUR>,,120000+NIMPUR	;Pure pages
		  0 ]			;End
	SSAVE
	HRROI 1,[ASCIZ/Saved.
/]
	PSOUT
	HALTF
]	;END IFN TNX

	CONSTANTS

IFN ITS,[
MFDBUF==:.\1777+1
PURPND==:MFDBUF/2000
DIRBUF==:MFDBUF+2000
BUFBAS==:<DIRBUF+2000>/2000
];END IFN ITS

IFN TNX,[
PURPND==:<<.+777>/1000>+NSYMPG
IFN $$SUBM,[
QSRPAG==:PURPND
QSRLOC==:QSRPAG*1000
BUFBAS==:<QSRLOC+1777>/2000
];$$SUBM
.ELSE BUFBAS==:<PURPND*1000+1777>/2000
];TNX

BUFLOC==:BUFBAS*2000

PURLOC==.
LOC IMPLOC
	VARIABLES
IMPLOC==.
IFG .-PURBEG,[
INFORM Impure is ,\<.-PURBEG>, words too long!
.FATAL Too much impure, increase NIMPUR
]

IF2,[
	INFORM END OF IMPURE=,\IMPLOC
	INFORM START OF PURE=,\PURBEG
	INFORM END OF PURE=,\PURLOC
IFN TNX,[
IFN $$SUBM,[
	INFORM QUASAR IPCP LOC=,\QSRLOC
];$$SUBM
];TNX
	INFORM FIRST BUFFER LOC=,\BUFLOC
];IF2

IFN TNX, LOC PURLOC		;SEEMS TO CONTROL SYMBOL TABLE LOCATION

	END FILE