TITLE OPEN - CHANNEL OPENER FOR MUDDLE
  
RELOCATABLE

;C. REEVE  MARCH 1973

.INSRT MUDDLE >

SYSQ

FNAMS==1
F==E+1
G==F+1

IFE ITS,[
IF1,	.INSRT STENEX >
]
;THIS PROGRAM HAS ENTRIES:  FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING,
;			    PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS?

;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM.

;	FOPEN	- OPENS A FILE FOR EITHER READING OR WRITING.  IT TAKES
;		FIVE OPTINAL ARGUMENTS AS FOLLOWS:

;		FOPEN (<DIR>,<FILE NAME1>,<FILE NAME2>,<DEVICE>,<SYSTEM NAME>)
;
;		<DIR> - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ

;		<FILE NAME1> - FIRST FILE NAME.  DEFAULT INPUT OR OUTPUT.

;		<FILE NAME2> - SECOND FILE NAME.  DEFAULT MUDDLE.

;		<DEVICE> - DEVICE FROM WHICH TO OPEN.  DEFAULT IS DSK.

;		<SNAME> - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME.

;	FOPEN	RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL


;	FCLOSE	- CLOSES A FILE.  TAKES A CHANNEL OBJECT AS ITS ARGUMENT.  IT ALSO TAKES
;	ACCESS	- DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES


; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION

;	CHANNO	;ITS I/O CHANNEL NUMBER.  0 MEANS NOT A REAL CHANNEL.
;	DIRECT	;DIRECTION (EITHER READ OR PRINT)
;	NAME1	;FIRST NAME OF FILE AS OPENED.
;	NAME2	;SECOND NAME OF FILE
;	DEVICE	;DEVICE UPON WHICH THE CHANNEL IS OPEN
;	SNAME	;DIRECTORY NAME
;	RNAME1	;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)
;	RNAME2	;REAL SECOND NAME
;	RDEVIC	;REAL DEVICE
;	RSNAME	;SYSTEM OR DIRECTORY NAME
;	STATUS	;VARIOUS STATUS BITS
;	IOINS	;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER
;	ACCESS	;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO)
;	RADX	;RADIX FOR CHANNELS NUMBER CONVERSION

;	*** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***
;	LINLN	;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE
;	CHRPOS	;CURRENT POSITION ON CURRENT LINE
;	PAGLN	;LENGTH OF A PAGE
;	LINPOS	;CURRENT LINE BEING WRITTEN ON

;	*** THE FOLLOWING FILEDS FOR INPUT ONLY ***
;	EOFCND	;GETS EVALUATED  ON EOF
;	LSTCH	;BACKUP CHARACTER
;	WAITNS	;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING
;	EXBUFR	;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST
;	BUFSTR	;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES

; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER
BUFLNT==100

;THIS DEFINES BLOCK MODE BIT FOR OPENING
BLOCKM==2		;DEFINED IN THE LEFT HALF
IMAGEM==4


;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME

	CHANLNT==4			;INITIAL CHANNEL LENGTH

; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS
BUFRIN==-1	;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER
SCRPTO==-3	;SPECIAL HACK FOR SCRIPT CHANNELS
PROCHN:

IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR]
[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR]
[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR]
[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX]
[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]]

	IRP	B,C,[A]
		B==CHANLNT-3
		T!C,,0
		0
		.ISTOP
		TERMIN
	CHANLNT==CHANLNT+2
TERMIN


; EQUIVALANCES FOR CHANNELS

EOFCND==LINLN
LSTCH==CHRPOS
WAITNS==PAGLN
EXBUFR==LINPOS
DISINF==BUFSTR	;DISPLAY INFO
INTFCN==BUFSTR	;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS


;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS

IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR]
A==.IRPCNT
TERMIN

EXTBFR==BYTPTR+1+<100./5>	;LENGTH OF ADD'L BUFFER




.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS
.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR
.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST
.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL
.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO
.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN
.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST
.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS
.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR
.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1
.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT
.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH
.GLOBAL TGFALS,ONINT

.VECT.==40000

; PAIR MOVING MACRO

DEFINE PMOVEM A,B
	MOVE	0,A
	MOVEM	0,B
	MOVE	0,A+1
	MOVEM	0,B+1
	TERMIN

; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN

T.SPDL==0		; SAVES P STACK BASE
T.DIR==2		; CONTAINS DIRECTION AND MODE
T.NM1==4		; NAME 1 OF FILE
T.NM2==6		; NAME 2 OF FILE
T.DEV==10		; DEVICE NAME
T.SNM==12		; SNAME
T.XT==14		; EXTRA CRUFT IF NECESSARY
T.CHAN==16		; CHANNEL AS GENERATED

; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES)

S.DIR==0		; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY
			; S.DIR(P) = <control word>,,<direction>
IFN ITS,[
S.DEV==1		; SIXBIT DEVICE RIGHT JUSTIFIED
S.NM1==2		; SIXBIT NAME1
S.NM2==3		; SIXBIT NAME2
S.SNM==4		; SIXBIT SNAME
S.X1==5			; TEMPS
S.X2==6
S.X3==7
]

IFE ITS,[
S.DEV==1
S.X1==2
S.X2==3
S.X3==4
]


; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES

NOSTOR==400000		; ON MEANS DONT BUILD NEW STRINGS
MSTNET==200000		; ON MEANS ONLY THE "NET" DEVICE CAN WIN
SNSET==100000		; FLAG, SNAME SUPPLIED
DVSET==040000		; FLAG, DEV SUPPLIED
N2SET==020000		; FLAG, NAME2 SET
N1SET==010000		; FLAG, NAME1 SET
4ARG==004000		; FLAG, CONSIDER ARGS TO BE 4 STRINGS

RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR
]

; TABLE OF LEGAL MODES

MODES:	IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO]
	SIXBIT /A/
	TERMIN
NMODES==.-MODES

MODCOD:	0?1?2?3?3?1
; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS

IFN ITS,[
DEVSTB:	IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL]
	SIXBIT /A/		; DEVICE NAMES
	TERMIN

DEVS:	IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL]
	SETZ B			; POINTERS
	TERMIN
]

IFE ITS,[
DEVSTB:	IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET]
	SIXBIT /A/
	TERMIN

DEVS:	IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET]
	SETZ B
	TERMIN
]
NDEVS==.-DEVS



;SUBROUTINE TO DO OPENING BEGINS HERE

MFUNCTION NFOPEN,SUBR,[OPEN-NR]

	JRST	FOPEN1

MFUNCTION FOPEN,SUBR,[OPEN]

FOPEN1:	ENTRY
	PUSHJ	P,MAKCHN	;MAKE THE CHANNEL
	PUSHJ	P,OPNCH	;NOW OPEN IT
	JUMPL	B,FINIS
	SUB	D,[4,,4]	; TOP THE CHANNEL
	MOVEM	D,RCYCHN+1	; RECYCLE DEAD CHANNEL
	SETZM	(D)		; ZAP IT
	MOVEI	C,1(D)
	HRLI	C,(D)
	BLT	C,CHANLNT-1(D)
	JRST	FINIS

; SUBR TO JUST CREATE A CHANNEL

IMFUNCTION CHANNEL,SUBR

	ENTRY
	PUSHJ	P,MAKCHN
	MOVSI	A,TCHAN
	JRST	FINIS




; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT

MAKCHN:	PUSH	TP,$TPDL
	PUSH	TP,P		; POINT AT CURRENT STACK BASE
	PUSH	TP,$TCHSTR
	PUSH	TP,CHQUOTE READ
	MOVEI	E,10		; SLOTS OF TP NEEDED
	PUSH	TP,[0]
	SOJG	E,.-1
	MOVEI	E,0
	EXCH	E,(P)		; GET RET ADDR IN E
IFE ITS,	PUSH	P,[0]
IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]]
	MOVE	B,IMQUOTE ATM
IFN ITS,	PUSH	P,E
	PUSHJ	P,IDVAL1
	GETYP	0,A
	CAIN	0,TCHSTR
	JRST	MAK!ATM

	MOVE	A,$TCHSTR
IFN ITS,	MOVE	B,CHQUOTE MDF
IFE ITS,	MOVE	B,CHQUOTE TMDF
MAK!ATM:
	MOVEM	A,T.!ATM(TB)
	MOVEM	B,T.!ATM+1(TB)
IFN ITS,[
	POP	P,E
	PUSHJ	P,STRTO6	; RESULT LEFT ON P STACK AS DESIRED
]
	TERMIN
	PUSH	TP,[0]		; PUSH SLOTS
	PUSH	TP,[0]

	PUSH	P,[0]		; EXT SLOTS
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,E		; PUSH RETURN ADDRESS
	MOVEI	A,0

	JUMPGE	AB,MAKCH0	; NO ARGS, ALREADY DONE
	GETYP	0,(AB)		; 1ST ARG MUST BE A STRING
	CAIE	0,TCHSTR
	JRST	WTYP1
	MOVE	A,(AB)		; GET ARG
	MOVE	B,1(AB)
	PUSHJ	P,CHMODE	; CHECK OUT OPEN MODE

	PMOVEM	(AB),T.DIR(TB)	; SAVE MODE NAME IN TEMPS
	ADD	AB,[2,,2]	; BUMP PAST DIRECTION
	MOVEM	AB,ABSAV(TB)
	MOVEI	A,0
	JUMPGE	AB,MAKCH0	; CHECK NAME1 BASED ON JUST MODE

	MOVEI	0,0		; FLAGS PRESET
	PUSHJ	P,RGPARS	; PARSE THE STRING(S)
	JRST	TMA

; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL

MAKCH0:
IFN ITS,[
	MOVE	C,T.SPDL+1(TB)
	MOVE	D,S.DEV(C)	; GET DEV
]
IFE ITS,[
	MOVE	A,T.DEV(TB)
	MOVE	B,T.DEV+1(TB)
	PUSHJ	P,STRTO6
	POP	P,D
	HLRZS	D
	MOVE	C,T.SPDL+1(TB)
	MOVEM	D,S.DEV(C)
]
IFE ITS,	CAIE	D,(SIXBIT /INT/);INTERNAL?
IFN ITS,	CAME	D,[SIXBIT /INT   /]
	JRST	CHNET		; NO, MAYBE NET
	SKIPN	T.XT+1(TB)	; WAS FCN SUPPLIED?
	JRST	TFA

; FALLS TROUGH IF SKIP



; NOW BUILD THE CHANNEL

ARGSOK:	MOVEI	A,CHANLNT	; GET LENGTH
	SKIPN	B,RCYCHN+1	; RECYCLE?
	PUSHJ	P,GIBLOK	; GET A BLOCK OF STUFF
	SETZM	RCYCHN+1
	ADD	B,[4,,4]	; HIDE THE TTY BUFFER SLOT
	PUSH	TP,$TCHAN
	PUSH	TP,B
	HRLI	C,PROCHN	; POINT TO PROTOTYPE
	HRRI	C,(B)		; AND NEW ONE
	BLT	C,CHANLN-5(B)	; CLOBBER
	MOVSI	C,TLIST		; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS
	HLLM	C,SCRPTO-1(B)

; NOW BLT IN STUFF FROM THE STACK

	MOVSI	C,T.DIR(TB)	; DIRECTION
	HRRI	C,DIRECT-1(B)
	BLT	C,SNAME(B)
	MOVEI	C,RNAME1-1(B)	; NOW "REAL" SLOTS
	HRLI	C,T.NM1(TB)
	BLT	C,RSNAME(B)
	MOVE	B,IMQUOTE MODE
	PUSHJ	P,IDVAL1
	GETYP	0,A
	CAIN	0,TFIX
	 JRST	.+3
	MOVE	B,(TP)
	POPJ	P,
 
	MOVE	C,(TP)
IFE ITS,[
	 ANDI	B,403776		; ONLY ALLOW NON-CRITICAL BITSS
]
	HRRM	B,-4(C)			; HIDE BITS
	MOVE	B,C
	POPJ	P,

; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN

CHNET:
IFN ITS,[
	CAME	D,[SIXBIT /NET   /]	; IS IT NET
	JRST	MAKCH1]
IFE ITS,[
	CAIE	D,(SIXBIT /NET/)	; IS IT NET
	JRST	ARGSOK]
	MOVSI	D,TFIX		; FOR TYPES
	MOVEI	B,T.NM1(TB)	; MAKE SURE ALL ARE FIXED
	PUSHJ	P,CHFIX
	MOVEI	B,T.NM2(TB)
	PUSHJ	P,CHFIX
	MOVEI	B,T.SNM(TB)
	LSH	A,-1		; SKIP DEV FLAG
	PUSHJ	P,CHFIX
	JRST	ARGSOK

MAKCH1:	TRNN	A,MSTNET	; CANT HAVE SEEN A FIX
	JRST	ARGSOK
	JRST	WRONGT

IFN ITS,[
CHFIX:	TRNE	A,N1SET		; SKIP IF NOT SPECIFIED
	JRST	CHFIX1
	SETOM	1(B)		; SET TO -1
	SETOM	S.NM1(C)
	MOVEM	D,(B)		; CORRECT TYPE
]
IFE ITS,CHFIX:
	GETYP	0,(B)
	CAIE	0,TFIX
	JRST	PARSQ
CHFIX1:	ADDI	C,1		; POINT TO NEXT FIELD
	LSH	A,-1		; AND NEXT FLAG
	POPJ	P,
PARSQ: CAIE	0,TCHSTR
	JRST	WRONGT
IFE ITS,	POPJ	P,
IFN ITS,[
	PUSH	P,A
	PUSH	P,C
	PUSH	TP,(B)
	PUSH	TP,1(B)
	SUBI	B,(TB)
	PUSH	P,B
	MCALL	1,PARSE
	GETYP	0,A
	CAIE	0,TFIX
	JRST	WRONGT
	POP	P,C
	ADDI	C,(TB)
	MOVEM	A,(C)
	MOVEM	B,1(C)
	POP	P,C
	POP	P,A
	POPJ	P,
]


; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE

CHMODE:	PUSHJ	P,CHMOD		; DO IT
	MOVE	C,T.SPDL+1(TB)
	HRRZM	A,S.DIR(C)
	POPJ	P,

CHMOD:	PUSHJ	P,STRTO6	; TO SIXBIT
	POP	P,B		; VALUE ENDSUP ON STACK, RESTORE IT

	MOVSI	A,-NMODES	; SCAN TO SEE IF LEGAL MODE
	CAME	B,MODES(A)
	AOBJN	A,.-1
	JUMPGE	A,WRONGD	; ILLEGAL MODE NAME
	MOVE	A,MODCOD(A)
	POPJ	P,


IFN ITS,[
; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES

RGPRS:	MOVEI	0,NOSTOR	; DONT STORE STRINGS IF ENTER HERE

RGPARS:	CAMGE	AB,[-7,,]	; MULTI-STRING CASE POSSIBLE?
	IORI	0,4ARG		; 4 STRING CASE
	HRLM	0,(P)		; LH IS FLAGS FOR THIS PROG
	MOVSI	E,-4		; FIELDS TO FILL

RPARGL:	GETYP	0,(AB)		; GET TYPE
	CAIE	0,TCHSTR	; STRING?
	JRST	ARGCLB		; NO, JUST CLOBBER IT IN RAW
	JUMPGE	E,CPOPJ		; DON'T DO ANY MORE
	PUSH	TP,(AB)		; GET AN ARG
	PUSH	TP,1(AB)

FPARS:	PUSH	TP,-1(TP)	; ANOTHER COPY
	PUSH	TP,-1(TP)
	HLRZ	0,(P)
	TRNN	0,4ARG
	PUSHJ	P,FLSSP		; NO LEADING SPACES
	MOVEI	A,0		; WILL HOLD SIXBIT
	MOVEI	B,6		; CHARS PER 6BIT WORD
	MOVE	C,[440600,,A]	; BYTE POINTER INTO A

FPARSL:	HRRZ	0,-1(TP)	; GET COUNT
	JUMPE	0,PARSD		; DONE
	SOS	-1(TP)		; COUNT
	ILDB	0,(TP)		; CHAR TO 0

	CAIE	0,"		; FILE NAME QUOTE?
	JRST	NOCNTQ
	HRRZ	0,-1(TP)
	JUMPE	0,PARSD
	SOS	-1(TP)
	ILDB	0,(TP)		; USE THIS
	JRST	GOTCNQ

NOCNTQ:	HLL	0,(P)
	TLNE	0,4ARG
	JRST	GOTCNQ
	ANDI	0,177
	CAIG	0,40		; SPACE?
	JRST	NDFLD		; YES, TERMINATE THIS FIELD
	CAIN	0,":		; DEVICE ENDED?
	JRST	GOTDEV
	CAIN	0,";		; SNAME ENDED
	JRST	GOTSNM

GOTCNQ:	ANDI	0,177
	PUSHJ	P,A0TO6		; CONVERT TO 6BIT AND CHECK

	JUMPE	B,FPARSL	; IGNORE IF AREADY HAVE 6
	IDPB	0,C
	SOJA	B,FPARSL

; HERE IF SPACE ENCOUNTERED

NDFLD:	MOVEI	D,(E)		; COPY GOODIE
	PUSHJ	P,FLSSP		; FLUSH REDUNDANT SPACES
	JUMPE	0,PARSD		; NO CHARS LEFT

NFL0:	PUSH	P,A		; SAVE SIXBIT WORD
	SKIPGE	-1(P)		; SKIP IF STRING TO BE STORED
	JRST	NFL1
	PUSH	TP,$TAB		; PREVENT AB LOSSAGE
	PUSH	TP,AB
	PUSHJ	P,6TOCHS	; CONVERT TO STRING
	MOVE	AB,(TP)
	SUB	TP,[2,,2]
NFL1:	HRRZ	0,-1(TP)	; RESTORE CHAR COUNT

NFL2:	MOVEI	C,(D)		; COPY REL PNTR
	SKIPGE	-1(P)		; SKIP IF STRINGS TO BE STORED
	JRST	NFL3
	ASH	D,1		; TIMES 2
	ADDI	D,T.NM1(TB)
	MOVEM	A,(D)		; STORE
	MOVEM	B,1(D)
NFL3:	MOVSI	A,N1SET		; FLAG IT
	LSH	A,(C)
	IORM	A,-1(P)		; AND CLOBBER
	MOVE	D,T.SPDL+1(TB)	; GET P BASE
	POP	P,@SIXTBL(C)	; AND STORE SIXBIT OF IT

	POP	TP,-2(TP)	; MAKE NEW STRING POINTER
	POP	TP,-2(TP)
	JUMPE	0,.+3		; SKIP IF NO MORE CHARS
	AOBJN	E,FPARS		; MORE TO PARSE?
CPOPJ:	POPJ	P,		; RETURN, ALL DONE

	SUB	TP,[2,,2]	; FLUSH OLD STRING
	ADD	E,[1,,1]
	ADD	AB,[2,,2]	; BUMP ARG
	MOVEM	AB,ABSAV(TB)
	JUMPL	AB,RPARGL	; AND GO ON
CPOPJ1:	AOS	A,(P)		; PREPARE TO WIN
	HLRZS	A
	POPJ	P,



; HERE IF STRING HAS ENDED

PARSD:	PUSH	P,A		; SAVE 6 BIT
	MOVE	A,-3(TP)	; CAN USE ARG STRING
	MOVE	B,-2(TP)
	MOVEI	D,(E)
	JRST	NFL2		; AND CONTINUE

; HERE IF JUST READ DEV

GOTDEV:	MOVEI	D,2		; CODE FOR DEVICE
	JRST	GOTFLD		; GOT A FIELD

; HERE IF  JUST READ SNAME

GOTSNM:	MOVEI	D,3
GOTFLD:	PUSHJ	P,FLSSP
	SOJA	E,NFL0


; HERE FOR NON STRING ARG ENCOUNTERED

ARGCLB:	SKIPGE	(P)		; IF NOT STORING, CONSIDER THIS THE END

	POPJ	P,
	MOVE	C,T.SPDL+1(TB)	; GET P-BASE
	MOVE	A,S.DEV(C)	; GET DEVICE
	CAME	A,[SIXBIT /INT   /]; IS IT THE INTERNAL DEVICE
	JRST	TRYNET		; NO, COUD BE NET
	MOVE	A,0		; OFFNEDING TYPE TO A
	PUSHJ	P,APLQ		; IS IT APPLICABLE
	JRST	NAPT		; NO, LOSE
	PMOVEM	(AB),T.XT(TB)
	ADD	AB,[2,,2]	; MUST BE LAST ARG
	MOVEM	AB,ABSAV(TB)
	JUMPL	AB,TMA
	JRST	CPOPJ1		; ELSE SUCCESSFUL RETURN
TRYNET:	CAIE	0,TFIX		; FOR NET DEV, ARGS MUST BE FIX
	JRST	WRONGT		; TREAT AS WRONG TYPE
	MOVSI	A,MSTNET	; BETTER BE NET EVENTUALLY
	IORM	A,(P)		; STORE FLAGS
	MOVSI	A,TFIX
	MOVE	B,1(AB)		; GET NUMBER
	MOVEI	0,(E)		; MAKE SURE NOT DEVICE
	CAIN	0,2
	JRST	WRONGT
	PUSH	P,B		; SAVE NUMBER
	MOVEI	D,(E)		; SET FOR TABLE OFFSETS
	MOVEI	0,0
	ADD	TP,[4,,4]
	JRST	NFL2		; GO CLOBBER IT AWAY
]


; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD

FLSSP:	HRRZ	0,-1(TP)	; GET CHR COUNNT
	JUMPE	0,CPOPJ		; FINISHED STRING
FLSS1:	MOVE	B,(TP)		; GET BYTR
	ILDB	C,B		; GETCHAR
	CAIE	C,^Q		; DONT FLUSH CNTL-Q
	CAILE	C,40
	JRST	FLSS2
	MOVEM	B,(TP)		; UPDATE BYTE POINTER
	SOJN	0,FLSS1

FLSS2:	HRRM	0,-1(TP)	; UPDATE STRING
	POPJ	P,

IFN ITS,[
;TABLE FOR STFUFFING SIXBITS AWAY

SIXTBL:	SETZ S.NM1(D)
	SETZ S.NM2(D)
	SETZ S.DEV(D)
	SETZ S.SNM(D)
	SETZ S.X1(D)
]

RDTBL:	SETZ RDEVIC(B)
	SETZ RNAME1(B)
	SETZ RNAME2(B)
	SETZ RSNAME(B)



IFE ITS,[

; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING)


RGPRS:	MOVEI	0,NOSTOR

RGPARS:	HRLM	0,(P)		; SAVE FOR STORE CHECKING
	CAMGE	AB,[-2,,]	; MULTI-STRING CASE POSSIBLE?
	JRST	TN.MLT		; YES, GO PROCESS
RGPRSS:	GETYP	0,(AB)		; CHECK ARG TYPE
	CAIE	0,TCHSTR
	JRST	WRONGT		; FOR NOW ONLY STRING ARGS WIN
	PUSH	TP,(AB)
	PUSH	TP,1(AB)
	PUSHJ	P,FLSSP		; FLUSH LEADING SPACES
	PUSHJ	P,RGPRS1
	ADD	AB,[2,,2]
	MOVEM	AB,ABSAV(TB)
CHKLST:	JUMPGE	AB,CPOPJ1
	SKIPGE	(P)		; IF FROM OPEN, ALLOW ONE MORE
	POPJ	P,
	PMOVEM	(AB),T.XT(TB)
	ADD	AB,[2,,2]
	MOVEM	AB,ABSAV(TB)
	JUMPL	AB,TMA
CPOPJ1:	AOS	(P)
	POPJ	P,

RGPRS1:	PUSH	P,[0]		; ALLOW A DEVICE SPEC
TN.SNM:	MOVE	A,(TP)
	HRRZ	0,-1(TP)
	JUMPE	0,RPDONE
	ILDB	A,A
	CAIE	A,"<		; START "DIRECTORY" ?
	JRST	TN.N1		; NO LOOK FOR NAME1
	SETOM	(P)		; DEV NOT ALLOWED
	IBP	(TP)		; SKIP CHAR
	SOS	-1(TP)
	PUSHJ	P,TN.CNT	; COUNT CHARS TO ">" OR "."
	JUMPE	B,ILLNAM	; RAN OUT
	CAIE	A,".
	JRST	TN.SN3
	PUSH	TP,0
	PUSH	TP,C
TN.SN1:	PUSHJ	P,TN.CNT	; COUNT CHARS TO ">"
	JUMPE	B,ILLNAM	; RAN OUT
	CAIE	A,".
	JRST	TN.SN2
	MOVEM	0,-1(TP)
	MOVEM	C,(TP)
	JRST	TN.SN1
TN.SN2:	HRRZ	B,-3(TP)
	SUB	B,0
	SUBI	B,1
	SUB	TP,[2,,2]	
TN.SN3:	CAIE	A,">		; SKIP IF WINS
	JRST	ILLNAM
	PUSHJ	P,TN.CPS	; COPY TO NEW STRING
	HLLOS	T.SPDL(TB)
	MOVEM	A,T.SNM(TB)
	MOVEM	B,T.SNM+1(TB)

TN.N1:	PUSHJ	P,TN.CNT
	JUMPE	B,RPDONE
	CAIE	A,":		; GOT A DEVICE
	JRST	TN.N11
	SKIPE	(P)
	JRST	ILLNAM
	SETOM	(P)
	PUSHJ	P,TN.CPS
	MOVEM	A,T.DEV(TB)
	MOVEM	B,T.DEV+1(TB)
	JRST	TN.SNM		; NOW LOOK FOR SNAME

TN.N11:	CAIE	A,">
	CAIN	A,"<
	JRST	ILLNAM
	MOVEM	A,(P)		; SAVE END CHAR
	PUSHJ	P,TN.CPS	; GEN STRING
	MOVEM	A,T.NM1(TB)
	MOVEM	B,T.NM1+1(TB)

TN.N2:	SKIPN	A,(P)		; GET CHAR BACK
	JRST	RPDONE
	CAIN	A,";		; START VERSION?
	JRST	.+3
	CAIE	A,".		; START NAME2?
	JRST	ILLNAM		; I GIVE UP!!!
	HRRZ	B,-1(TP)	; GET RMAINS OF STRING
	PUSHJ	P,TN.CPS	; AND COPY IT
	MOVEM	A,T.NM2(TB)
	MOVEM	B,T.NM2+1(TB)
RPDONE:	SUB	P,[1,,1]	; FLUSH TEMP
	SUB	TP,[2,,2]
CPOPJ:	POPJ	P,

TN.CNT:	HRRZ	0,-1(TP)	; CHAR COUNT
	MOVE	C,(TP)		; BPTR
	MOVEI	B,0		; INIT COUNT TO 0

TN.CN1:	MOVEI	A,0		; IN CASE RUN OUT
	SOJL	0,CPOPJ		; RUN OUT?
	ILDB	A,C		; TRY ONE
	CAIE	A,"		; TNEX FILE QUOTE?
	JRST	TN.CN2
	SOJL	0,CPOPJ
	IBP	C		; SKIP QUOTED CHAT
	ADDI	B,2
	JRST	TN.CN1

TN.CN2:	CAIE	A,"<
	CAIN	A,">
	POPJ	P,

	CAIE	A,".
	CAIN	A,";
	POPJ	P,
	CAIN	A,":
	POPJ	P,
	AOJA	B,TN.CN1

TN.CPS:	PUSH	P,B		; # OF CHARS
	MOVEI	A,4(B)		; ADD 4 TO B IN A
	IDIVI	A,5
	PUSHJ	P,IBLOCK	; GET BLOCK OF WORDS FOR STRING

	POP	P,C		; CHAR COUNT BACK
	HRLI	B,010700
	SUBI	B,1
	MOVSI	A,TCHSTR
	HRRI	A,(C)		; CHAR STRING
	MOVE	D,B		; COPY BYTER

	JUMPE	C,CPOPJ
	ILDB	0,(TP)		; GET CHAR
	IDPB	0,D		; AND STROE
	SOJG	C,.-2

	MOVNI	C,(A)		; - LENGTH TO C
	ADDB	C,-1(TP)	; DECREMENT WORDS COUNT
	TRNN	C,-1		; SKIP IF EMPTY
	POPJ	P,
	IBP	(TP)
	SOS	-1(TP)		; ELSE FLUSH TERMINATOR
	POPJ	P,

ILLNAM:	ERRUUO	EQUOTE ILLEGAL-TENEX-FILE-NAME

TN.MLT:	MOVE	A,AB		; AOBJN POINTER TO ARGS IN A

TN.ML1:	GETYP	0,(A)		; IS THIS ARG OF RIGHT TYPE
	CAIE	0,TFIX
	CAIN	0,TCHSTR
	JRST	.+2
	JRST	RGPRSS		; ASSUME SINGLE STRING 
	ADD	A,[2,,2]
	JUMPL	A,TN.ML1	; TRY NEXT ARG IF ANY LEFT

	MOVEI	0,T.NM1(TB)	; 1ST WORD OF DESTINATION
	HLRO	A,AB		; MINUS NUMBER OF ARGS IN A
	MOVN	A,A		; NUMBER OF ARGS IN A
	SUBI	A,1
	CAMGE	AB,[-10,,0]
	MOVEI	A,7		; IF MORE THAN 10 ARGS, PUT 7
	ADD	A,0		; LAST WORD OF DESTINATION
	HRLI	0,(AB)
	BLT	0,(A)		; BLT 'EM IN
	ADD	AB,[10,,10]	; SKIP THESE GUYS
	MOVEM	AB,ABSAV(TB)
	JRST	CHKLST

]


; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE.  NAMES ARE ASSUMED TO ALREADY
; BE ON BOTH TP STACK AND P STACK

OPNCH:	MOVE	C,T.SPDL+1(TB)	; GET PDL BASE
	HRRZ	A,S.DIR(C)
	ANDI	A,1		; JUST WANT I AND O
IFE ITS,[
	HRLM	A,S.DEV(C)
;	.TRANS	S.DEV(C)	; UNDO ANY TRANSLATIONS
;	JRST	TRLOST		; COMPLAIN
]
IFN ITS,[
	HRLM	A,S.DIR(C)
]

IFN ITS,[
	MOVE	A,S.DEV(C)	; GET SIXBIT DEVICE CODE
]

IFE ITS,[HRLZS	A,S.DEV(C)
]

	MOVSI	B,-NDEVS	; AOBJN COUNTER
DEVLP:	SETO	D,
	MOVE	0,DEVSTB(B)	; GET ONE FROM TABLE
	MOVE	E,A 
DEVLP1:	AND	E,D		; FLUSH POSSIBLE DIGITNESS
	CAMN	0,E
	 JRST	CHDIGS		; MAKE SURE REST IS DIGITS
	LSH	D,6
	JUMPN	D,DEVLP1	; KEEP TRUCKING UNTIL DONE

; WASN'T THAT DEVICE, MOVE TO NEXT
NXTDEV:	AOBJN	B,DEVLP
	JRST	ODSK		; UNKNOWN DEVICE IS ASSUMED TO BE DISK

IFN ITS,[
OUSR:	HRRZ	A,S.DIR(C)	; BLOCK OR UNIT?
	TRNE	A,2		; SKIP IF UNIT
	JRST	ODSK
	PUSHJ	P,OPEN1		; OPEN IT
	PUSHJ	P,FIXREA	; AND READCHST IT
	MOVE	B,T.CHAN+1(TB)	; RESTORE CHANNEL
	MOVE	0,[PUSHJ P,DOIOT]	; GET AN IOINS
	MOVEM	0,IOINS(B)
	MOVE	C,T.SPDL+1(TB)
	HRRZ	A,S.DIR(C)
	TRNN	A,1
	JRST	EOFMAK
	MOVEI	0,80.
	MOVEM	0,LINLN(B)
	JRST	OPNWIN

OSTY:	HLRZ	A,S.DIR(C)
	IORI	A,10		; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT)
	HRLM	A,S.DIR(C)
	JRST	OUSR
]

; MAKE SURE DIGITS EXIST

CHDIGS:	SETCA	D,
	JUMPE	D,DISPA		; NO DIGITS, WIN IMMEDIATE
	MOVE	E,A
	AND	E,D		; LEAVES ONLY DIGITS, IF WINNING
	LSH	E,6
	LSH	D,6
	JUMPG	D,.-2		; KEEP GOING TIL DIGITS LEFT SHIFTED
	JRST	CHDIGN

CHDIG1:	CAIG	D,'9
	 CAIGE	D,'0
	  JRST	NXTDEV		; NOT A DIGIT, LOSE
	JUMPE	E,DISPA		; IF THAT'S ALL THE CHARACTERS, WIN!
CHDIGN:	SETZ	D,
	ROTC	D,6		; GET NEXT CHARACTER INTO D
	JRST	CHDIG1		; GO TEST?

; HERE TO DISPATCH IF SUCCESSFUL

DISPA:	JRST	@DEVS(B)


IFN ITS,[

; DISK DEVICE OPNER COME HERE

ODSK:	MOVE	A,S.SNM(C)	; GET SNAME
	.SUSET	[.SSNAM,,A]	; CLOBBER IT
	PUSHJ	P,OPEN0		; DO REAL LIVE OPEN
]
IFE ITS,[

; TENEX DISK FILE OPENER

ODSK:	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL
	PUSHJ	P,STSTK		; EXPAND STRING ONTO STACK (E POINTS TO OLD P)
	MOVE	A,DIRECT-1(B)
	MOVE	B,DIRECT(B)
	PUSHJ	P,STRTO6	; GET DIR NAME
	MOVE	C,(P)
	MOVE	D,T.SPDL+1(TB)
	HRRZ	D,S.DIR(D)
	CAME	C,[SIXBIT /PRINAO/]
	CAMN	C,[SIXBIT /PRINTO/]
	IORI	D,100		; TURN ON BIT TO SAY USE OLD FILE
	MOVSI	A,101		; START SETTING UP BITS EXTRA BIT FOR MSB
	TRNE	D,1		; SKIP IF INPUT
	TRNE	D,100		; WITE OVER?
	TLOA	A,100000	; FORCE OLD VERSION
	TLO	A,600000	; FORCE NEW VERSION
	HRROI	B,1(E)		; POINT TO STRING
	GTJFN
	TDZA	0,0		; SAVE FACT OF NO SKIP
	MOVEI	0,1		; INDICATE SKIPPED
	POP	P,C		; RECOVER OPEN MODE SIXBIT
	MOVE	P,E		; RESTORE PSTACK
	JUMPE	0,GTJLOS	; FIND OUT WHAT HAPPENED

	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL
	HRRZ	0,-4(B)		; FUNNY MODE BITS
	HRRZM	A,CHANNO(B)	; SAVE IT
	ANDI	A,-1		; READ Y TO DO OPEN
	MOVSI	B,440000	; USE 36. BIT BYES
	HRRI	B,200000	; ASSUME READ
;	CAMN	C,[SIXBIT /READB/]
;	 TRO	B,2000		; TURN ON THAWED IF READB
	IOR	B,0
	TRNE	D,1		; SKIP IF READ
	HRRI	B,300000	; WRITE BIT
	HRRZ	0,FSAV(TB)	; SEE IF REF DATE HACK
	CAIN	0,NFOPEN
	TRO	B,400		; SET DON'T MUNG REF DATE BIT
	MOVE	E,B		; SAVE BITS FOR REOPENS
	OPENF
	JRST	OPFLOS
	MOVE	B,[2,,11]	; GET LENGTH & BYTE SIZE
	PUSH	P,[0]
	PUSH	P,[0]
	MOVEI	C,-1(P)
	GTFDB
	LDB	0,[300600,,-1(P)]	; GET BYTE SIZE
	MOVE	B,(P)
	SUB	P,[2,,2]
	CAIN	0,7
	 JRST	SIZASC
	CAIN	0,36.
	SIZEF			; USE OPENED SIZE
	JFCL
	IMULI	B,5		; TO BYTES
SIZASC:	MOVEI	0,C.OPN+C.READ+C.DISK
	TRNE	D,1		; SKIP FOR READ
	MOVEI	0,C.OPN+C.PRIN+C.DISK
	TRNE	D,2		; SKIP IF NOT BINARY FILE
	TRO	0,C.BIN
	HRL	0,B
       	MOVE	B,T.CHAN+1(TB)
	TRNE	D,1
	 HLRM	0,LSTCH-1(B)	; SAVE CURRENT LENGTH
	MOVEM	E,STATUS(B)
	HRRM	0,-2(B)		; MUNG THOSE BITS
	ASH	A,1		; POINT TO SLOT
	ADDI	A,CHNL0	; TO REAL SLOT
	MOVEM	B,1(A)		; SAVE CHANNEL
	PUSHJ	P,TMTNXS	; GET STRING FROM TENEX
	MOVE	B,CHANNO(B)	; JFN TO A
	HRROI	A,1(E)		; BASE OF STRING
	MOVE	C,[111111,,140001]	; WEIRD CONTROL BITS
	JFNS			; GET STRING
	MOVEI	B,1(E)		; POINT TO START OF STRING
	SUBM	P,E		; RELATIVIZE E
	PUSHJ	P,TNXSTR	; MAKE INTO A STRING
	SUB	P,E		; BACK TO NORMAL
	PUSH	TP,A
	PUSH	TP,B
	PUSHJ	P,RGPRS1	; PARSE INTO FIELDS
	MOVE	B,T.CHAN+1(TB)
	MOVEI	C,RNAME1-1(B)
	HRLI	C,T.NM1(TB)
	BLT	C,RSNAME(B)
	JRST	OPBASC
OPFLOS:	MOVEI	C,(A)		; SAVE ERROR CODE
	MOVE	B,T.CHAN+1(TB)
	HRRZ	A,CHANNO(B)	; JFN BACK TO A
	RLJFN			; TRY TO RELEASE IT
	JFCL
	MOVEI	A,(C)		; ERROR CODE BACK TO A

GTJLOS:	MOVE	B,T.CHAN+1(TB)
	PUSHJ	P,TGFALS	; GET A FALSE WITH REASON
	JRST	OPNRET

STSTK:	PUSH	TP,$TCHAN
	PUSH	TP,B
	MOVEI	A,4+5		; COUNT CHARS NEEDED (NEED LAST 0 BYTE)
	MOVE	B,(TP)
	ADD	A,RDEVIC-1(B)
	ADD	A,RNAME1-1(B)
	ADD	A,RNAME2-1(B)
	ADD	A,RSNAME-1(B)
	ANDI	A,-1		; TO 18 BITS
	MOVEI	0,A(A)
	IDIVI	A,5		; TO WORDS NEEDED
	POP	P,C		; SAVE RET ADDR
	MOVE	E,P		; SAVE POINTER
	PUSH	P,[0]		; ALOCATE SLOTS
	SOJG	A,.-1
	PUSH	P,C		; RET ADDR BACK
	INTGO			; IN CASE OVERFLEW
	PUSH	P,0
	MOVE	B,(TP)		; IN CASE GC'D
	MOVE	D,[440700,,1(E)]	; BYTE POINTER TO IT
	MOVEI	A,RDEVIC-1(B)
	PUSHJ	P,MOVSTR	; FLUSH IT ON
	HRRZ	A,T.SPDL(TB)
	JUMPN	A,NLNMS		; USER GAVE NAME, USE IT (CAREFUL, RELIES ON
				;			  A BEING NON ZERO)
	PUSH	P,B
	PUSH	P,C
	MOVEI	A,0		; HERE TO SEE IF THIS IS REALLY L.N.
	HRROI	B,1(E)
	HRROI	C,1(P)
	LNMST			; LOOK UP LOGICAL NAME
	 MOVNI	A,1		; NOT A LOGICAL NAME
	POP	P,C
	POP	P,B
NLNMS:	MOVEI	0,":
	IDPB	0,D
	JUMPE	A,ST.NM1	; LOGICAL NAME, FLUSH SNAME
	HRRZ	A,RSNAME-1(B)	; ANY SNAME AT ALL?
	JUMPE	A,ST.NM1	; NOPE, CANT HACK WITH IT
	MOVEI	A,"<
	IDPB	A,D
	MOVEI	A,RSNAME-1(B)
	PUSHJ	P,MOVSTR	; SNAME UP
	MOVEI	A,">
	IDPB	A,D
ST.NM1:	MOVEI	A,RNAME1-1(B)
	PUSHJ	P,MOVSTR
	MOVEI	A,".
	IDPB	A,D
	MOVEI	A,RNAME2-1(B)
	PUSHJ	P,MOVSTR
	SUB	TP,[2,,2]
	POP	P,A
	POPJ	P,

MOVSTR:	HRRZ	0,(A)		; CHAR COUNT
	MOVE	A,1(A)		; BYTE POINTER
	SOJL	0,CPOPJ
	ILDB	C,A		; GET CHAR
	IDPB	C,D		; MUNG IT UP
	JRST	.-3

; MAKE A TENEX ERROR MESSAGE STRING

TGFALS:	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	P,A		; SAVE ERROR CODE
	PUSHJ	P,TMTNXS	; STRING ON STACK
	HRROI	A,1(E)		; POINT TO SPACE
	MOVE	B,(E)		; ERROR CODE
	HRLI	B,400000	; FOR ME
	MOVSI	C,-100.		; MAX CHARS
	ERSTR			; GET TENEX STRING
	JRST	TGFLS1
	JRST	TGFLS1

	MOVEI	B,1(E)		; A AND B BOUND STRING
	SUBM	P,E		; RELATIVIZE E
	PUSHJ	P,TNXSTR	; BUILD STRING
	SUB	P,E		; P BACK TO NORMAL
TGFLS2:
IFE FNAMS,	SUB	P,[1,,1]	; FLUSH ERROR CODE SLOT
IFN FNAMS,[
	PUSH	TP,A
	PUSH	TP,B
	SKIPN	B,-2(TP)
	JRST	TGFLS3
	PUSHJ	P,STSTK
	MOVEI	B,1(E)
	SUBM	P,E
	MOVSI	A,440700
	HRRI	A,(P)
	MOVEI	C,5
	ILDB	0,A
	JUMPE	0,.+2
	SOJG	C,.-2

	PUSHJ	P,TNXSTR
	PUSH	TP,A
	PUSH	TP,B
	SUB	P,E
TGFLS3:	POP	P,A
	PUSH	TP,$TFIX
	PUSH	TP,A
	MOVEI	A,3
	SKIPN	B
	MOVEI	A,2
]
IFE FNAMS,[
	MOVEI	A,1
]
	PUSHJ	P,IILIST	; BUILD LIST
	MOVSI	A,TFALSE	; MAKE IT FALSE
	SUB	TP,[2,,2]
	POPJ	P,

TGFLS1:	MOVE	P,E		; RESET STACK
	MOVE	A,$TCHSTR
	MOVE	B,CHQUOTE UNKNOWN PROBLEM IN I/O
	JRST	TGFLS2

]
; OTHER BUFFERED DEVICES JOIN HERE

OPDSK1:
IFN ITS,[
	PUSHJ	P,FIXREA	; STORE THE "REAL" NAMES INTO THE CHANNEL
]
OPBASC:	MOVE	C,T.SPDL+1(TB)	; C WAS CLOBBERED, GET IT BACK
	HRRZ	A,S.DIR(C)	; FIND OUT IF OPEN IS ASCII OR WORD
	TRZN	A,2		; SKIP IF BINARY
	PUSHJ	P,OPASCI	; DO IT FOR ASCII

; NOW SET UP IO INSTRUCTION FOR CHANNEL

MAKION:	MOVE	B,T.CHAN+1(TB)
	MOVEI	C,GETCHR
	JUMPE	A,MAKIO1	; JUMP IF INPUT
	MOVEI	C,PUTCHR	; ELSE GET INPUT
	MOVEI	0,80.		; DEFAULT LINE LNTH
	MOVEM	0,LINLN(B)
	MOVSI	0,TFIX
	MOVEM	0,LINLN-1(B)
MAKIO1:
	HRLI	C,(PUSHJ P,)
	MOVEM	C,IOINS(B)	; STORE IT
	JUMPN	A,OPNWIN	; GET AN EOF FORM FOR INPUT CHANNEL

; HERE TO CONS UP <ERROR END-OF-FILE>

EOFMAK:	MOVSI	C,TATOM
	MOVE	D,EQUOTE END-OF-FILE
	PUSHJ	P,INCONS
	MOVEI	E,(B)
	MOVSI	C,TATOM
	MOVE	D,IMQUOTE ERROR
	PUSHJ	P,ICONS
	MOVE	D,T.CHAN+1(TB)	; RESTORE CHANNEL
	MOVSI	0,TFORM
	MOVEM	0,EOFCND-1(D)
	MOVEM	B,EOFCND(D)

OPNWIN:	MOVEI	0,10.		; SET UP RADIX
	MOVSI	A,TCHAN		; OPEN SUCCEEDED, RET CHANNEL
	MOVE	B,T.CHAN+1(TB)
	MOVEM	0,RADX(B)

OPNRET:	MOVE	D,T.CHAN+1(TB)	; IN CASE WE RECYCLE IT
	MOVE	C,(P)		; RET ADDR
	SUB	P,[S.X3+2,,S.X3+2]
	SUB	TP,[T.CHAN+2,,T.CHAN+2]
	JRST	(C)


; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O

OPASCI:	PUSH	P,A		; CONTAINS MODE, SAVE IT
	MOVEI	A,BUFLNT	; GET SIZE  OF BUFFER
	PUSHJ	P,IBLOCK	; GET STORAGE
	MOVSI	0,TWORD+.VECT.	; SET UTYPE
	MOVEM	0,BUFLNT(B)	; AND STORE
	MOVSI	A,TCHSTR
	SKIPE	(P)		; SKIP IF INPUT
	JRST	OPASCO
	MOVEI	D,BUFLNT-1(B)	; REST BYTE POINTER
OPASCA:	HRLI	D,010700
	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL BACK
	MOVEI	0,C.BUF
	IORM	0,-2(B)		; TURN ON BUFFER BIT
	MOVEM	A,BUFSTR-1(B)
	MOVEM	D,BUFSTR(B)	; CLOBBER
	POP	P,A
	POPJ	P,

OPASCO:	HRROI	C,777776
	MOVEM	C,(B)		; -1 THE BUFFER (LEAVE OFF LOW BIT)
	MOVSI	C,(B)
	HRRI	C,1(B)		; BUILD BLT POINTER
	BLT	C,BUFLNT-1(B)	; ZAP
	MOVEI	D,-1(B)		; START MAKING STRING POINTER
	HRRI	A,BUFLNT*5	; SET UP CHAR COUNT
	JRST	OPASCA


; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.)

IFN ITS,[
ONUL:
OPTP:
OPTR:	PUSHJ	P,OPEN0		; SET UP MODE AND OPEN
	SETZM	S.NM1(C)	; CLOBBER UNINTERESTING FIELDS
	SETZM	S.NM2(C)
	SETZM	S.SNM(C)
	JRST	OPDSK1

; OPEN DEVICES THAT IGNORE SNAME

OUTN:	PUSHJ	P,OPEN0
	SETZM	S.SNM(C)
	JRST	OPDSK1

]

; INTERNAL CHANNEL OPENER

OINT:	HRRZ	A,S.DIR(C)	; CHECK DIR
	CAIL	A,2		; READ/PRINT?
	JRST	WRONGD		; NO, LOSE

	MOVE	0,INTINS(A)	; GET INS
	MOVE	D,T.CHAN+1(TB)	; AND CHANNEL
	MOVEM	0,IOINS(D)	; AND CLOBBER
	MOVEI	0,C.OPN+C.READ
	TRNE	A,1
	MOVEI	0,C.OPN+C.PRIN
	HRRM	0,-2(D)
	SETOM	STATUS(D)	; MAKE SURE NOT AA TTY
	PMOVEM	T.XT(TB),INTFCN-1(D)

; HERE TO SAVE PSEUDO CHANNELS

SAVCHN:	HRRZ	E,CHNL0+1	; POINT TO CURRENT LIST
	MOVSI	C,TCHAN
	PUSHJ	P,ICONS		; CONS IT ON
	HRRZM	B,CHNL0+1
	JRST	OPNWIN

; INT DEVICE I/O INS

INTINS:	PUSHJ	P,GTINTC
	PUSHJ	P,PTINTC


; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET)

IFN ITS,[
ONET:	HRRZ	A,S.DIR(C)	; DIRECTION CODE
	CAILE	A,1		; ASCII ?
	IORI	A,4		; TURN ON IMAGE BIT
	SKIPGE	S.NM1(C)	; NAME1 I.E. LOCAL HOST GIVEN
	IORI	A,10		; NO, WE WILL LET ITS GIVE US ONE
	SKIPGE	S.NM2(C)	; NORMAL OR "LISTEN"
	IORI	A,20		; TURN ON LISTEN BIT
	MOVEI	0,7		; DEFAULT BYTE SIZE
	TRNE	A,2		; UNLESS
	MOVEI	0,36.		; IMAGE WHICH IS 36
	SKIPN	T.XT(TB)	; BYTE SIZE GIVEN?
	MOVEM	0,S.X1(C)	; NO, STORE DEFAULT
	SKIPG	D,S.X1(C)	; BYTE SIZE REASONABLE?
	JRST	RBYTSZ		; NO <0, COMPLAIN
	TRNE	A,2		; SKIP TO CHECK ASCII
	JRST	ONET2		; CHECK IMAGE
	CAIN	D,7		; 7-BIT WINS
	JRST	ONET1
	CAIE	D,44		; 36-BIT INDICATES BLOCK ASCII MODE
	JRST	.+3
	IORI	A,2		; SET BLOCK FLAG
	JRST	ONET1
	IORI	A,40		; USE 8-BIT MODE
	CAIN	D,10		; IS IT RIGHT
	JRST	ONET1		; YES
]

RBYTSZ:	ERRUUO	EQUOTE BYTE-SIZE-BAD

IFN ITS,[
ONET2:	CAILE	D,36.		; IMAGE SIZE REASONABLE?
	JRST	RBYTSZ		; NO
	CAIN	D,36.		; NORMAL
	JRST	ONET1		; YES, DONT SET FIELD

	ASH	D,9.		; POSITION FOR FIELD
	IORI	A,40(D)		; SET IT AND ITS BIT

ONET1:	HRLM	A,S.DIR(C)	; CLOBBER OPEN BLOCK
	MOVE	E,A		; SAVE BLOCK MODE INFO
	PUSHJ	P,OPEN1		; DO THE OPEN
	PUSH	P,E

; CLOBBER REAL SLOTS FOR THE OPEN

	MOVEI	A,3		; GET STATE VECTOR
	PUSHJ	P,IBLOCK
	MOVSI	A,TUVEC
	MOVE	D,T.CHAN+1(TB)
	HLLM	A,BUFRIN-1(D)
	MOVEM	B,BUFRIN(D)
	MOVSI	A,TFIX+.VECT.	; SET U TYPE
	MOVEM	A,3(B)
	MOVE	C,T.SPDL+1(TB)
	MOVE	B,T.CHAN+1(TB)

	PUSHJ	P,INETST		; GET STATE

	POP	P,A		; IS THIS BLOCK MODE
	MOVEI	0,80.		; POSSIBLE LINE LENGTH
	TRNE	A,1		; SKIP IF INPUT
	MOVEM	0,LINLN(B)
	TRNN	A,2		; BLOCK MODE?
	JRST	.+3
	TRNN	A,4		; ASCII MODE?
	JRST	OPBASC	; GO SETUP BLOCK ASCII
	MOVE	0,[PUSHJ P,DOIOT]
	MOVEM	0,IOINS(B)

	JRST	OPNWIN

; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL

INETST:	MOVE	A,S.NM1(C)
	MOVEM	A,RNAME1(B)
	MOVE	A,S.NM2(C)
	MOVEM	A,RNAME2(B)
	LDB	A,[1100,,S.SNM(C)]
	MOVEM	A,RSNAME(B)

	MOVE	E,BUFRIN(B)		; GET STATE BLOCK
INTST1:	HRRE	0,S.X1(C)
	MOVEM	0,(E)
	ADDI	C,1
	AOBJN	E,INTST1

	POPJ	P,


; ACCEPT A CONNECTION

MFUNCTION NETACC,SUBR

	PUSHJ	P,ARGNET	; CHECK THAT ARG IS AN OPEN NET CHANNEL
	MOVE	A,CHANNO(B)	; GET CHANNEL
	LSH	A,23.		; TO AC FIELD
	IOR	A,[.NETACC]
	XCT	A
	JRST	IFALSE		; RETURN FALSE
NETRET:	MOVE	A,(AB)
	MOVE	B,1(AB)
	JRST	FINIS

; FORCE SYSTEM NETWORK BUFFERS TO BE SENT

MFUNCTION NETS,SUBR

	PUSHJ	P,ARGNET
	CAME	A,MODES+1
	CAMN	A,MODES+3
	SKIPA	A,CHANNO(B)	; GET CHANNEL
	JRST	WRONGD
	LSH	A,23.
	IOR	A,[.NETS]
	XCT	A
	JRST	NETRET

; SUBR TO RETURN UPDATED NET STATE

MFUNCTION NETSTATE,SUBR

	PUSHJ	P,ARGNET	; IS IT A NET CHANNEL
	PUSHJ	P,INSTAT
	JRST	FINIS

; INTERNAL NETSTATE ROUTINE

INSTAT:	MOVE	C,P		; GET PDL BASE
	MOVEI	0,S.X3		; # OF SLOTS NEEDED
	PUSH	P,[0]
	SOJN	0,.-1
; RESTORED FROM MUDDLE 54.  IT SEEMED TO WORK THERE, AND THE STUFF
; COMMENTED OUT HERE CERTAINLY DOESN'T.
	MOVEI	D,S.DEV(C)
	HRL	D,CHANNO(B)
	.RCHST	D,
;	HRR	D,CHANNO(B)	; SETUP FOR RFNAME CALL
;	DOTCAL	RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
;	 .LOSE	%LSFIL		; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF
				; LOSSAGE
	PUSHJ	P,INETST	; INTO VECTOR
	SUB	P,[S.X3,,S.X3]
	MOVE	B,BUFRIN(B)
	MOVSI	A,TUVEC
	POPJ	P,
]
; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE

ARGNET:	ENTRY	1
	GETYP	0,(AB)
	CAIE	0,TCHAN
	JRST	WTYP1
	MOVE	B,1(AB)		; GET CHANNEL
	SKIPN	CHANNO(B)	; OPEN?
	JRST	CHNCLS
	MOVE	A,RDEVIC-1(B)	; GET DEV NAME
	MOVE	B,RDEVIC(B)
	PUSHJ	P,STRTO6
	POP	P,A
	CAME	A,[SIXBIT /NET   /]
	JRST	NOTNET
	MOVE	B,1(AB)
	MOVE	A,DIRECT-1(B)	; CHECK FOR A READ SOCKET
	MOVE	B,DIRECT(B)
	PUSHJ	P,STRTO6
	MOVE	B,1(AB)		; RESTORE CHANNEL
	POP	P,A
	POPJ	P,

IFE ITS,[

; TENEX NETWRK OPENING CODE

ONET:	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL
	MOVSI	C,100700
	HRRI	C,1(P)
	MOVE	E,P
	PUSH	P,[ASCII /NET:/]	; FOR STRINGS
	GETYP	0,RNAME1-1(B)	; CHECK TYPE
	CAIE	0,TFIX		; SKIP IF # SUPPLIED
	JRST	ONET1
	MOVE	0,RNAME1(B)	; GET IT
	PUSHJ	P,FIXSTK
	JFCL
	JRST	ONET2
ONET1:	CAIE	0,TCHSTR
	JRST	WRONGT
	HRRZ	0,RNAME1-1(B)
	MOVE	B,RNAME1(B)
	JUMPE	0,ONET2
	ILDB	A,B
	JSP	D,ONETCH
	SOJA	0,.-3
ONET2:	MOVEI	A,".
	JSP	D,ONETCH
	MOVE	B,T.CHAN+1(TB)
	GETYP	0,RNAME2-1(B)
	CAIE	0,TFIX
	JRST	ONET3
	GETYP	0,RSNAME-1(B)
	CAIE	0,TFIX
	JRST	WRONGT
	MOVE	0,RSNAME(B)
	CAIG	0,377		;NEW STYLE 32 BIT HOST NUMBER?
	 JRST	ONET2A
;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS
	MOVEI	A,0
	LDB	B,[001100,,0]	;HOST NUMBER:	1.1-1.9 ->
	DPB	B,[201000,,A]	;		2.8-3.6
	LDB	B,[111100,,0]	;IMP LOW BITS:	2.1-2.9 ->
	DPB	B,[001000,,A]	;		1.1-1.8
	LDB	B,[221100,,0]	;IMP HIGH BITS:	3.1-3.9 ->
	DPB	B,[101000,,A]	;		1.9-2.7
	LDB	B,[331100,,0]	;NETWORK:	4.1-4.9 ->
	DPB	B,[301000,,A]	;		3.7-4.5
	MOVE	0,A
ONET2A:	PUSHJ	P,FIXSTK
	JRST	ONET4
	MOVE	B,T.CHAN+1(TB)
	MOVEI	A,"-
	JSP	D,ONETCH
	MOVE	0,RNAME2(B)
	PUSHJ	P,FIXSTK
	JRST	WRONGT
	JRST	ONET4
ONET3:	CAIE	0,TCHSTR
	JRST	WRONGT
	HRRZ	0,RNAME2-1(B)
	MOVE	B,RNAME2(B)
	JUMPE	0,ONET4
	ILDB	A,B
	JSP	D,ONETCH
	SOJA	0,.-3

ONET4:
ONET5:	MOVE	B,T.CHAN+1(TB)
	GETYP	0,RNAME2-1(B)
	CAIN	0,TCHSTR
	JRST	ONET6
	MOVEI	A,";
	JSP	D,ONETCH
	MOVEI	A,"T
	JSP	D,ONETCH
ONET6:	MOVSI	A,1
	HRROI	B,1(E)		; STRING POINTER
	GTJFN			; GET THE G.D JFN
	TDZA	0,0		; REMEMBER FAILURE
	MOVEI	0,1
	MOVE	P,E		; RESTORE P
	JUMPE	0,GTJLOS	; CONS UP ERROR STRING

	MOVE	B,T.CHAN+1(TB)
	HRRZM	A,CHANNO(B)	; SAVE THE JFN

	MOVE	C,T.SPDL+1(TB)
	MOVE	D,S.DIR(C)
	MOVEI	B,10
	TRNE	D,2
	MOVEI	B,36.
	SKIPE	T.XT(TB)
	MOVE	B,T.XT+1(TB)
	JUMPL	B,RBYTSZ
	CAILE	B,36.
	JRST	RBYTSZ
	ROT	B,-6
	TLO	B,3400
	HRRI	B,200000
	TRNE	D,1		; SKIP FOR INPUT
	HRRI	B,100000
	ANDI	A,-1		; ISOLATE JFCN
	OPENF
	JRST	OPFLOS		; REPORT ERROR
	MOVE	B,T.CHAN+1(TB)
	ASH	A,1		; POINT TO SLOT
	ADDI	A,CHNL0	; TO REAL SLOT
	MOVEM	B,1(A)		; SAVE CHANNEL
	MOVE	C,T.SPDL+1(TB)	; POINT TO P BASE
	HRRZ	A,S.DIR(C)	; 0/ 0 FOR READ 0/ 1 FOR PRINT
	MOVEI	0,C.OPN+C.READ
	TRNE	A,1
	MOVEI	0,C.OPN+C.PRIN
	TRNE	A,2
	TRO	0,C.BIN
	HRRM	0,-2(B)
	MOVE	A,CHANNO(B)
	CVSKT			; GET ABS SOCKET #
	FATAL NETWORK BITES THE BAG!
	MOVE	D,B
	MOVE	B,T.CHAN+1(TB)
	MOVEM	D,RNAME1(B)
	MOVSI	0,TFIX
	MOVEM	0,RNAME1-1(B)

	MOVSI	0,TFIX
	MOVEM	0,RNAME2-1(B)
	MOVEM	0,RSNAME-1(B)
	MOVE	C,T.SPDL+1(TB)
	MOVE	C,S.DIR(C)
	MOVE	0,[PUSHJ P,DONETO]
	TRNN	C,1		; SKIP FOR OUTPUT
	MOVE	0,[PUSHJ P,DONETI]
	MOVEM	0,IOINS(B)
	MOVEI	0,80.		; LINELENGTH
	TRNE	C,1		; SKIP FOR INPUT
	MOVEM	0,LINLN(B)
	MOVEI	A,3		; GET STATE UVECTOR
	PUSHJ	P,IBLOCK
	MOVSI	0,TFIX+.VECT.
	MOVEM	0,3(B)
	MOVE	C,B
	MOVE	B,T.CHAN+1(TB)
	MOVEM	C,BUFRIN(B)
	MOVSI	0,TUVEC
	HLLM	0,BUFRIN-1(B)
	MOVE	B,CHANNO(B)	; GET JFN
	MOVEI	A,4		; CODE FOR GTNCP
	MOVEI	C,1(P)
	ADJSP	P,4		; ROOM FOR DATA
	MOVE	D,[-4,,1]	; GET FHOST, LOC SOC, F SOC
	GTNCP
	 FATAL	NET LOSSAGE	; GET STATE
	MOVE	B,(P)
	MOVE	D,-1(P)
	MOVE	C,-3(P)
	ADJSP	P,-4
	MOVE	E,T.CHAN+1(TB)
	MOVEM	D,RNAME2(E)
	MOVEM	C,RSNAME(E)
	MOVE	C,BUFRIN(E)
	MOVEM	B,(C)		; INITIAL STATE STORED
	MOVE	B,E
	JRST	OPNWIN

; DOIOT FOR TENEX NETWRK

DONETO:	PUSH	P,0
	MOVE	0,[BOUT]
	JRST	.+3

DONETI:	PUSH	P,0
	MOVE	0,[BIN]
	PUSH	P,0
	PUSH	TP,$TCHAN
	PUSH	TP,B
	MOVEI	0,(A)		; POSSIBLE OUTPUT CHAR TO 0
	MOVE	A,CHANNO(B)
	MOVE	B,0
	ENABLE
	XCT	(P)
	DISABLE
	MOVEI	A,(B)		; RET CHAR IN A
	MOVE	B,(TP)
	MOVE	0,-1(P)
	SUB	P,[2,,2]
	SUB	TP,[2,,2]
	POPJ	P,
	
NETPRS:	MOVEI	D,0
	HRRZ	0,(C)
	MOVE	C,1(C)

ONETL:	ILDB	A,C
	CAIN	A,"#
	POPJ	P,
	SUBI	A,60
	ASH	D,3
	IORI	D,(A)
	SOJG	0,ONETL
	AOS	(P)
	POPJ	P,

FIXSTK:	CAMN	0,[-1]
	POPJ	P,
	JFFO	0,FIXS3		; PUT OCTAL DIGITS INTO STIRNG
	MOVEI	A,"0
	POP	P,D
	AOJA	D,ONETCH
FIXS3:	IDIVI	A,3
	MOVEI	B,12.
	SUBI	B,(A)
	HRLM	B,(P)
	IMULI	A,3
	LSH	0,(A)
	POP	P,B
FIXS2:	MOVEI	A,0
	ROTC	0,3		; NEXT DIGIT
	ADDI	A,60
	JSP	D,ONETCH
	SUB	B,[1,,0]
	TLNN	B,-1
	JRST	1(B)
	JRST	FIXS2

ONETCH:	IDPB	A,C
	TLNE	C,760000	; SKIP IF NEW WORD
	JRST	(D)
	PUSH	P,[0]
	JRST	(D)

INSTAT:	MOVE	E,B
	MOVE	B,CHANNO(B)	; GET JFN
	MOVEI	A,4		; CODE FOR GTNCP
	MOVEI	C,1(P)
	ADJSP	P,4		; ROOM FOR DATA
	MOVE	D,[-4,,1]	; GET FHOST, LOC SOC, F SOC
	GTNCP
	 FATAL	NET LOSSAGE	; GET STATE
	MOVE	B,(P)
	MOVE	D,-1(P)
	MOVE	C,-3(P)
	ADJSP	P,-4
	MOVEM	D,RNAME2(E)	; UPDATE FOREIGN SOCHKET
	MOVEM	C,RSNAME(E)	; AND HOST
	MOVE	C,BUFRIN(E)
	XCT	ITSTRN(B)	; XLATE TO LOOK MORE LIKE ITS
	MOVEM	B,(C)		; STORE STATE
	MOVE	B,E
	POPJ	P,

ITSTRN: MOVEI   B,0
        JRST    NLOSS
        JRST    NLOSS
        MOVEI   B,1
        MOVEI   B,2
        JRST    NLOSS
        MOVEI   B,4
        PUSHJ   P,NOPND
        MOVEI   B,0
        JRST    NLOSS
        JRST    NLOSS
        PUSHJ   P,NCLSD
        MOVEI   B,0
        JRST    NLOSS
	MOVEI	B,0

NLOSS:	FATAL ILLEGAL NETWORK STATE

NOPND:	MOVE	B,DIRECT(E)	; SEE IF READ OR PRINT
	ILDB	B,B		; GET 1ST CHAR
	CAIE	B,"R		; SKIP FOR READ
	JRST	NOPNDW
	SIBE		; SEE IF INPUT EXISTS
	JRST	.+3
	MOVEI	B,5
	POPJ	P,
	MOVEM	B,2(C)		; STORE BYTES IN STATE VECTOR
	MOVEI	B,11		; RETURN DATA PRESENT STATE
	POPJ	P,

NOPNDW:	SOBE			; SEE IF OUTPUT PRESENT
	JRST	.+3
	MOVEI	B,5
	POPJ	P,

	MOVEI	B,6
	POPJ	P,

NCLSD:	MOVE	B,DIRECT(E)
	ILDB	B,B
	CAIE	B,"R
	JRST	RET0
	SIBE
	JRST	.+2
	JRST	RET0
	MOVEI	B,10
	POPJ	P,

RET0:	MOVEI	B,0
	POPJ	P,


MFUNCTION NETSTATE,SUBR

	PUSHJ	P,ARGNET
	PUSHJ	P,INSTAT
	MOVE	B,BUFRIN(B)
	MOVSI	A,TUVEC
	JRST	FINIS

MFUNCTION NETS,SUBR

	PUSHJ	P,ARGNET
	CAME	A,MODES+1	; PRINT OR PRINTB?
	CAMN	A,MODES+3
	SKIPA	A,CHANNO(B)
	JRST	WRONGD
	MOVEI	B,21
	MTOPR
NETRET:	MOVE	B,1(AB)
	MOVSI	A,TCHAN
	JRST	FINIS

MFUNCTION NETACC,SUBR

	PUSHJ	P,ARGNET
	MOVE	A,CHANNO(B)
	MOVEI	B,20
	MTOPR
	JRST	NETRET

]

; HERE TO OPEN TELETYPE DEVICES

OTTY:	HRRZ	A,S.DIR(C)	; GET DIR CODE
	TRNE	A,2		; SKIP IF NOT READB/PRINTB
	JRST	WRONGD		; CANT DO THAT

IFN ITS,[
	MOVE	A,S.NM1(C)	; CHECK FOR A DIR
	MOVE	0,S.NM2(C)
	CAMN	A,[SIXBIT /.FILE./]
	CAME	0,[SIXBIT /(DIR)/]
	SKIPA	E,[-15.*2,,]
	JRST	OUTN		; DO IT THAT WAY

	HRRZ	A,S.DIR(C)	; CHECK DIR
	TRNE	A,1
	JRST	TTYLP2
	HRRI	E,CHNL1
	PUSH	P,S.DEV(C)	; SAVE THE SIXBIT DEV NAME
   ;	HRLZS	(P)		; POSTITION DEVICE NAME

TTYLP:	SKIPN	D,1(E)		; CHANNEL OPEN?
	JRST	TTYLP1		; NO, GO TO NEXT
	MOVE	A,RDEVIC-1(D)		; GET DEV NAME
	MOVE	B,RDEVIC(D)
	PUSHJ	P,STRTO6	; TO 6 BIT
	POP	P,A		; GET RESULT
	CAMN	A,(P)		; SAME?
	JRST	SAMTYQ		; COULD BE THE SAME
TTYLP1:	ADD	E,[2,,2]
	JUMPL	E,TTYLP
	SUB	P,[1,,1]	; THIS ONE MUST BE UNIQUE
TTYLP2:	MOVE	C,T.SPDL+1(TB)	; POINT TO P BASE
	HRRZ	A,S.DIR(C)	; GET DIR OF OPEN
	SKIPE	A		; IF OUTPUT,
	IORI	A,20		; THEN USE DISPLAY MODE
	HRLM	A,S.DIR(C)	; STORE IN OPEN BLOCK
	PUSHJ	P,OPEN2		; OPEN THE TTY
	MOVE	A,S.DEV(C)	; GET DEVICE NAME
	PUSHJ	P,6TOCHS	; TO A STRING
	MOVE	D,T.CHAN+1(TB)	; POINT TO CHANNEL
	MOVEM	A,RDEVIC-1(D)
	MOVEM	B,RDEVIC(D)
	MOVE	C,T.SPDL+1(TB)	; RESTORE PDL BASE
	MOVE	B,D		; CHANNEL TO B
	HRRZ	0,S.DIR(C)	; AND DIR
	JUMPE	0,TTYSPC
TTY1:	DOTCAL	TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]]
	 .LOSE	%LSSYS
	DOTCAL	TTYSET,[CHANNO(B),MODE1,MODE2,D]
	 .LOSE	%LSSYS
	MOVE	A,[PUSHJ P,GMTYO]
	MOVEM	A,IOINS(B)
	DOTCAL	RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]
	 .LOSE	%LSSYS
	MOVEM	D,LINLN(B)
	MOVEM	A,PAGLN(B)
	JRST	OPNWIN

; MAKE AN IOT

IOTMAK:	HRLZ	A,CHANNO(B)	; GET CHANNEL
	ROT	A,5
	IOR	A,[.IOT A]	; BUILD IOT
	MOVEM	A,IOINS(B)	; AND STORE IT
	POPJ	P,


; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY

SAMTYQ:	MOVE	D,1(E)		; RESTORE CURRENT CHANNEL
	MOVE	A,DIRECT-1(D)	; GET DIR
	MOVE	B,DIRECT(D)
	PUSHJ	P,STRTO6
	POP	P,A		; GET SIXBIT
	MOVE	C,T.SPDL+1(TB)
	HRRZ	C,S.DIR(C)
	CAME	A,MODES(C)	; SKIP IF DIFFERENT DIRECTION
	JRST	TTYLP1

; HERE IF A RE-OPEN ON A TTY

	HRRZ	0,FSAV(TB)	; IS IT FROM A FOPEN
	CAIN	0,FOPEN
	JRST	RETOLD		; RET OLD CHANNEL

	PUSH	TP,$TCHAN
	PUSH	TP,1(E)		; PUSH OLD CHANNEL
	PUSH	TP,$TFIX
	PUSH	TP,T.CHAN+1(TB)
	MOVE	A,[PUSHJ P,CHNFIX]
	MOVEI	PVP,0		; SAY MIGHT BE NON-ATOMS
	PUSHJ	P,GCHACK
	SUB	TP,[4,,4]
	
RETOLD:	MOVE	B,1(E)		; GET CHANNEL
	AOS	CHANNO-1(B)	; AOS REF COUNT
	MOVSI	A,TCHAN
	SUB	P,[1,,1]	; CLEAN UP STACK
	JRST	OPNRET		; AND LEAVE


; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER

CHNFIX:	CAIN	C,TCHAN
	CAME	D,(TP)
	POPJ	P,
	MOVE	D,-2(TP)	; GET REPLACEMENT
	SKIPE	B
	MOVEM	D,1(B)		; CLOBBER IT AWAY
	POPJ	P,
]

IFE ITS,[
	MOVE	C,T.SPDL+1(TB)	; POINT TO P BASE
	HRRZ	0,S.DIR(C)	; 0/ 0 FOR READ 0/ 1 FOR PRINT
	MOVE	A,[PUSHJ P,INMTYO]
	MOVE	B,T.CHAN+1(TB)
	MOVEM	A,IOINS(B)
	MOVEI	A,100		; PRIM INPUT JFN
	JUMPN	0,TNXTY1
	MOVEI	E,C.OPN+C.READ+C.TTY
	HRRM	E,-2(B)
	MOVEM	B,CHNL0+2*100+1
	JRST	TNXTY2
TNXTY1:	MOVEM	B,CHNL0+2*101+1
	MOVEI	A,101		; PRIM OUTPUT JFN
	MOVEI	E,C.OPN+C.PRIN+C.TTY
	HRRM	E,-2(B)
TNXTY2:	MOVEM	A,CHANNO(B)
	JUMPN	0,OPNWIN
]
; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES

TTYSPC:	MOVEI	A,EXTBFR	; GET EXTRA BUFFER
	PUSHJ	P,IBLOCK	; GET BLOCK
	MOVE	D,T.CHAN+1(TB)	;RESTORE CHANNEL POINTER
IFN ITS,[
	MOVE	A,CHANNO(D)
	LSH	A,23.
	IOR	A,[.IOT A]
	MOVEM	A,IOIN2(B)
]
IFE ITS,[
	MOVE	A,[PBIN]
	MOVEM	A,IOIN2(B)
]
	MOVSI	A,TLIST
	MOVEM	A,EXBUFR-1(D)	; FOR WAITING TTY BUFFERS
	SETZM	EXBUFR(D)	; NIL LIST
	MOVEM	B,BUFRIN(D)	;STORE IN CHANNEL
	MOVSI	A,TUVEC		;MAKE SURE TYPE IS UNIFORM VECTOR
	HLLM	A,BUFRIN-1(D)
	MOVEI	A,177		;SET ERASER TO RUBOUT
	MOVEM	A,ERASCH(B)
IFE ITS,[
	MOVEI	A,25
	MOVEM	A,KILLCH(B)
]
IFN ITS,[
	SETZM	KILLCH(B)	;NO KILL CHARACTER NEEDED
]
	MOVEI	A,33		;BREAKCHR TO C.R.
	MOVEM	A,BRKCH(B)
	MOVEI	A,"\		;ESCAPER TO \
	MOVEM	A,ESCAP(B)
	MOVE	A,[010700,,BYTPTR(E)]	;RELATIVE BYTE POINTER
	MOVEM	A,BYTPTR(B)
	MOVEI	A,14		;BARF BACK CHARACTER FF
	MOVEM	A,BRFCHR(B)
	MOVEI	A,^D
	MOVEM	A,BRFCH2(B)

; SETUP DEFAULT TTY INTERRUPT HANDLER

	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE CHAR,CHAR,INTRUP
	PUSH	TP,$TFIX
	PUSH	TP,[10]		; PRIORITY OF CHAR INT
	PUSH	TP,$TCHAN
	PUSH	TP,D
	MCALL	3,EVENT		; 1ST MAKE AN EVENT EXIST
	PUSH	TP,A
	PUSH	TP,B
	PUSH	TP,$TSUBR
	PUSH	TP,[QUITTER]	; DEFAULT HANDLER IS QUITTER
	MCALL	2,HANDLER

; BUILD A NULL STRING

	MOVEI	A,0
	PUSHJ	P,IBLOCK		; USE A BLOCK
	MOVE	D,T.CHAN+1(TB)
	MOVEI	0,C.BUF
	IORM	0,-2(D)
	HRLI	B,010700
	SUBI	B,1
	MOVSI	A,TCHSTR
	MOVEM	A,BUFSTR-1(D)
	MOVEM	B,BUFSTR(D)
	MOVEI	A,0
	MOVE	B,D		; CHANNEL TO B
	JRST	MAKION


; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST

IFN ITS,[
OPEN2:	MOVEI	A,S.DIR(C)	; POINT TO OPEN BLOCK
	PUSHJ	P,MOPEN		; OPEN THE FILE
	JRST	OPNLOS
	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL BACK
	MOVEM	A,CHANNO(B)	; SAVE THE CHANNEL
	JRST	OPEN3

; FIX UP MODE AND FALL INTO OPEN

OPEN0:	HRRZ	A,S.DIR(C)	; GET DIR
	TRNE	A,2		; SKIP IF NOT BLOCK
	IORI	A,4		; TURN ON IMAGE
	IORI	A,2		; AND BLOCK

	PUSH	P,A
	PUSH	TP,$TPDL
	PUSH	TP,C		; SAVE CRUFT TO CHECK FOR PRINTO, HA HA
	MOVE	B,T.CHAN+1(TB)
	MOVE	A,DIRECT-1(B)
	MOVE	B,DIRECT(B)	; THIS KLUDGE THE MESS OF NDR
	PUSHJ	P,STRTO6
	MOVE	C,(TP)
	POP	P,D		; THE SIXBIT FOR KLUDGE
	POP	P,A		; GET BACK THE RANDOM BITS
	SUB	TP,[2,,2]
	CAME	D,[SIXBIT /PRINAO/]
	CAMN	D,[SIXBIT /PRINTO/]
	IORI	A,100000	; WRITEOVER BIT
	HRRZ	0,FSAV(TB)
	CAIN	0,NFOPEN
	IORI	A,10		; DON'T CHANGE REF DATE
OPEN9:	HRLM	A,S.DIR(C)	; AND STORE IT

; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL

OPEN1:	MOVEI	A,S.DIR(C)	; POINT TO OPEN BLOCK
	PUSHJ	P,MOPEN
	JRST	OPNLOS
	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL BACK
	MOVEM	A,CHANNO(B)	; CLOBBER INTO CHANNEL
	DOTCAL	RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]]
	JFCL

; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL

OPEN3:	MOVE	A,S.DIR(C)
	MOVEI	0,C.OPN+C.READ
	TRNE	A,1
	MOVEI	0,C.OPN+C.PRIN
	TRNE	A,2
	TRO	0,C.BIN
	HRRM	0,-2(B)
	MOVE	A,CHANNO(B)	; GET CHANNEL #
	ASH	A,1
	ADDI	A,CHNL0	; POINT TO SLOT
	MOVEM	B,1(A)		; NOT: TYPE ALREADY SETUP

; NOW GET STATUS WORD

DOSTAT:	HRRZ	A,CHANNO(B)	; NOW GET STATUS WORD
	DOTCAL	STATUS,[A,[2002,,STATUS]]
	JFCL
	POPJ	P,


; HERE IF OPEN FAILS (CHANNEL IS IN A)

OPNLOS:	JUMPL	A,NOCHAN	; ALL CHANNELS ARE IN USE
	LSH	A,23.		; DO A .STATUS
	IOR	A,[.STATUS A]
	XCT	A		; STATUS TO A
	MOVE	B,T.CHAN+1(TB)
	PUSHJ	P,GFALS		; GET A FALSE WITH A MESSAGE
	SUB	P,[1,,1]	; EXTRA RET ADDR FLUSHED
	JRST	OPNRET		; AND RETURN
]

CGFALS:	SUBM	M,(P)
	MOVEI	B,0
IFN ITS,	PUSHJ	P,GFALS
IFE ITS,	PUSHJ	P,TGFALS
	JRST	MPOPJ

; ROUTINE TO CONS UP FALSE WITH REASON
IFN ITS,[
GFALS:	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	P,[SIXBIT /   ERR/]	; SET UP OPEN TO ERR DEV
	PUSH	P,[3]		; SAY ITS FOR CHANNEL
	PUSH	P,A
	.OPEN	0,-2(P)		; USE CHANNEL 0 FOR THIS
	FATAL CAN'T OPEN ERROR DEVICE
	SUB	P,[3,,3]	; DONT WANT OPEN BLOCK NOW
IFN FNAMS,	PUSH	P,A
	MOVEI	A,0		; PREPARE TO BUILD STRING ON STACK
EL1:	PUSH	P,[0]		; WHERE IT WILL GO
	MOVSI	B,(<440700,,(P)>)	; BYTE POINTER TO TOP OF STACK
EL2:	.IOT	0,0		; GET A CHAR
	JUMPL	0,EL3		; JUMP ON -1,,3
	CAIN	0,3		; EOF?
	JRST	EL3		; YES, MAKE STRING
	CAIN	0,14		; IGNORE FORM FEEDS
	JRST	EL2		; IGNORE FF
	CAIE	0,15		; IGNORE CR & LF
	CAIN	0,12
	JRST	EL2
	IDPB	0,B		; STUFF IT
	TLNE	B,760000	; SIP IF WORD FULL
	AOJA	A,EL2
	AOJA	A,EL1		; COUNT WORD AND GO

EL3:
IFN FNAMS,[
	SKIPN	(P)
	SUB	P,[1,,1]
	PUSH	P,A
	.CLOSE	0,
	PUSHJ	P,CHMAK
	PUSH	TP,A
	PUSH	TP,B
	SKIPN	B,-2(TP)
	JRST	EL4
	MOVEI	A,0
	MOVSI	B,(<440700,,(P)>)
	PUSH	P,[0]
	IRP	XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40]
IFSN YY,0,[
	MOVEI	0,YY
	JSP	E,1PUSH
]
	MOVE	E,-2(TP)
	MOVE	C,XX(E)
	HRRZ	D,XX-1(E)
	JSP	E,PUSHIT
	TERMIN
]
	SKIPN	(P)		; ANY CHARS AT END?
	SUB	P,[1,,1]	; FLUSH XTRA
	PUSH	P,A		; PUT UP COUNT
	.CLOSE	0,		; CLOSE THE ERR DEVICE
	PUSHJ	P,CHMAK		; MAKE STRING
	PUSH	TP,A
	PUSH	TP,B
IFN FNAMS,[
EL4:	POP	P,A
	PUSH	TP,$TFIX
	PUSH	TP,A]
IFE FNAMS,	MOVEI	A,1
IFN FNAMS,[
	MOVEI	A,3
	SKIPN	B
	MOVEI	A,2
]
	PUSHJ	P,IILIST
	MOVSI	A,TFALSE	; MAKEIT A FALSE
IFN FNAMS,	SUB	TP,[2,,2]
	POPJ	P,

IFN FNAMS,[
1PUSH:	MOVEI	D,0
	JRST	PUSHI2
PUSHI1:	PUSH	P,[0]
	MOVSI	B,(<440700,,(P)>)
PUSHIT:	SOJL	D,(E)
	ILDB	0,C
PUSHI2:	IDPB	0,B
	TLNE	B,760000
	AOJA	A,PUSHIT
	AOJA	A,PUSHI1
]
]


; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL

FIXREA:
IFE ITS,	HRLZS	S.DEV(C)	; KILL MODE BITS
	MOVE	D,[-4,,S.DEV]

FIXRE1:	MOVEI	A,(D)		; COPY REL POINTER
	ADD	A,T.SPDL+1(TB)	; POINT TO SLOT
	SKIPN	A,(A)		; SKIP IF GOODIE THERE
	JRST	FIXRE2
	PUSHJ	P,6TOCHS	; MAKE INOT A STRING
	MOVE	C,RDTBL-S.DEV(D); GET OFFSET
	ADD	C,T.CHAN+1(TB)
	MOVEM	A,-1(C)
	MOVEM	B,(C)
FIXRE2:	AOBJN	D,FIXRE1
	POPJ	P,

IFN ITS,[
DOOPN:	HRLZ	A,A
	HRR	A,CHANNO(B)	; GET CHANNEL
	DOTCAL	OPEN,[A,-3(P),-2(P),-1(P),(P)]
	 SKIPA
	  AOS	-1(P)
	POPJ	P,
]

;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
STRTO6:	PUSH	TP,A
	PUSH	TP,B
	PUSH	P,E		;SAVE USEFUL FROB
	MOVEI	E,(A)		; CHAR COUNT TO E
	GETYP	A,A
	CAIE	A,TCHSTR		; IS IT ONE WORD?
	JRST	WRONGT		;NO
	CAILE	E,6		; SKIP IF L=? 6 CHARS
	MOVEI	E,6
CHREAD:	MOVEI	A,0		;INITIALIZE OUTPUT WORD
	MOVE	D,[440600,,A]	;AND BYTE POINTER TO IT
NEXCHR:	SOJL	E,SIXDON
	ILDB	0,B		; GET NEXT CHAR
	CAIN	0,^Q		; CNTL-Q, QUOTES NEXT CHAR
	JRST	NEXCHR
	JUMPE	0,SIXDON	;IF NULL, WE ARE FINISHED
	PUSHJ	P,A0TO6		; CONVERT TO SIXBIT
	IDPB	0,D		;DEPOSIT INTO SIX BIT
	JRST	NEXCHR		; NO, GET NEXT
SIXDON:	SUB	TP,[2,,2]	;FIX UP TP
	POP	P,E
	EXCH	A,(P)		;LEAVE RESULT ON P-STACK
	JRST	(A)		;NOW RETURN


;SUBROUTINE TO CONVERT SIXBIT TO ATOM

6TOCHS:	PUSH	P,E
	PUSH	P,D
	MOVEI	B,0		;MAX NUMBER OF CHARACTERS
	PUSH	P,[0]		;STRING WILL GO ON P SATCK
	JUMPE	A,GETATM	; EMPTY, LEAVE
	MOVEI	E,-1(P)		;WILL BE BYTE POINTER
	HRLI	E,10700		;SET IT UP
	PUSH	P,[0]		;SECOND POSSIBLE WORD
	MOVE	D,[440600,,A]	;INPUT BYTE POINTER
6LOOP:	ILDB	0,D		;START CHAR GOBBLING
	ADDI	0,40		;CHANGET TOASCII
	IDPB	0,E		;AND STORE IT
	TLNN	D,770000	; SKIP IF NOT DONE
	JRST	6LOOP1
	TDNN	A,MSKS(B)	; CHECK IF JUST SPACES LEFT
	AOJA	B,GETATM	; YES, DONE
	AOJA	B,6LOOP		;KEEP LOOKING
6LOOP1:	PUSH	P,[6]		;IF ARRIVE HERE, STRING IS 2 WORDS
	JRST	.+2
GETATM:	MOVEM	B,(P)		;SET STRING LENGTH=1
	PUSHJ	P,CHMAK		;MAKE A MUDDLE STRING
	POP	P,D
	POP	P,E
	POPJ	P,

MSKS:	7777,,-1
	77,,-1
	,,-1
	7777
	77


; CONVERT ONE CHAR

A0TO6:	CAIL	0,141		;IF IT IS GREATER OR EQUAL TO LOWER A
	CAILE	0,172		;BUT LESS THAN OR EQUAL TO LOWER Z
	JRST	.+2		;THEN
	SUBI	0,40		;CONVERT TO UPPER CASE
	SUBI	0,40		;NOW TO SIX BIT
	JUMPL	0,BAD6		;CHECK FOR A WINNER
	CAILE	0,77
	JRST	BAD6
	POPJ	P,

; SUBR TO TEST THE EXISTENCE OF FILES

MFUNCTION FEXIST,SUBR,[FILE-EXISTS?]

	ENTRY

	JUMPGE	AB,TFA
	PUSH	TP,$TPDL
	PUSH	TP,P		; SAVE P-STACK BASE
	ADD	TP,[2,,2]
	MOVSI	E,-4		; 4 THINGS TO PUSH
EXIST:
IFN ITS,	MOVE	B,@RNMTBL(E)
IFE ITS,	MOVE	B,@FETBL(E)
	PUSH	P,E
	PUSHJ	P,IDVAL1
	POP	P,E
	GETYP	0,A
	CAIE	0,TCHSTR	; SKIP IF WINS
	JRST	EXIST1

IFN ITS,	PUSHJ	P,STRTO6	; CONVERT TO SIXBIT
IFE ITS,[
;	PUSH	P,E
;	PUSHJ	P,ADDNUL	; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA
;	POP	P,E
	PUSH	TP,A		; DEFAULT TYPE AND VALUE GIVEN BY USER
	PUSH	TP,B		; IN VALUE OF DEV, SNM, NM1, NM2
	]
IFN ITS,	JRST	.+2
IFE ITS,	JRST	.+3

EXIST1:
IFN ITS,	PUSH	P,EXISTS(E)	; USE DEFAULT
IFE ITS,[
	PUSH	TP,FETYP(E)	; DEFAULT TYPE AND VALUE IF NO
	PUSH	TP,FEVAL(E)	; DEFAULT GIVEN BY USER
	]
	AOBJN	E,EXIST

	PUSHJ	P,RGPRS		; PARSE THE ARGS
	JRST	TMA		; TOO MANY ARGUMENTS
	
IFN ITS,[
	MOVE	0,-3(P)		; GET SIXBIT DEV NAME
	MOVEI	B,0
	CAMN	0,[SIXBITS /DSK   /]
	MOVSI	B,10		; DONT SET REF DATE IF DISK DEV
	.IOPUSH
	DOTCAL	OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]]
	 JRST	.+3
	.IOPOP
	JRST	FDLWON		; WON!!!
	.STATUS	0,A		; FIND THE STATUS OF CHANNEL BEFORE POPING
	.IOPOP
	JRST	FDLST1]

IFE ITS,[
	MOVE	B,TB
	SUBI	B,10		; GET B TO POINT CORRECTLY TO ARGS
	PUSHJ	P,STSTK		; GET FILE NAME IN A STRING
	HRROI	B,1(E)		; POINT B TO THE STRING
	MOVSI	A,100001
	GTJFN
	JRST	TDLLOS		; FILE DOES NOT EXIST
	RLJFN			; FILE EXIST SO RETURN JFN
	JFCL
	JRST	FDLWON		; SUCCESS
	]

IFN ITS,[
EXISTS:	SIXBITS /DSK   INPUT >           /
	]
IFE ITS,[
FETBL:	SETZ IMQUOTE	NM1
	SETZ IMQUOTE	NM2
	SETZ IMQUOTE	DEV
	SETZ IMQUOTE	SNM

FETYP:	TCHSTR,,5
	TCHSTR,,3
	TCHSTR,,3
	TCHSTR,,0

FEVAL:	440700,,[ASCIZ /INPUT/]
	440700,,[ASCIZ /MUD/]
	440700,,[ASCIZ /DSK/]
	0
	]

; SUBR TO DELETE AND RENAME FILES

MFUNCTION RENAME,SUBR

	ENTRY

	JUMPGE	AB,TFA
	PUSH	TP,$TPDL
	PUSH	TP,P		; SAVE P-STACK BASE
	GETYP	0,(AB)		; GET 1ST ARG TYPE
IFN ITS,[
	CAIN	0,TCHAN		; CHANNEL?
	JRST	CHNRNM		; MUST BE RENAME WHILE OPEN FOR WRITING
]
IFE ITS,[
	PUSH	P,[100000,,-2]
	PUSH	P,[377777,,377777]
]
	MOVSI	E,-4		; 4 THINGS TO PUSH
RNMALP:	MOVE	B,@RNMTBL(E)
	PUSH	P,E
	PUSHJ	P,IDVAL1
	POP	P,E
	GETYP	0,A
	CAIE	0,TCHSTR	; SKIP IF WINS
	JRST	RNMLP1

IFN ITS,	PUSHJ	P,STRTO6	; CONVERT TO SIXBIT
IFE ITS,[
	PUSH	P,E
	PUSHJ	P,ADDNUL
	EXCH	B,(P)
	MOVE	E,B
]
	JRST	.+2

RNMLP1:	PUSH	P,RNSTBL(E)	; USE DEFAULT
	AOBJN	E,RNMALP

IFN ITS,[
	PUSHJ	P,RGPRS		; PARSE THE ARGS
	JRST	RNM1		; COULD BE A RENAME

; HERE TO DELETE A FILE

DELFIL:	MOVE	A,(P)		; AND GET SNAME
	.SUSET	[.SSNAM,,A]
	DOTCAL	DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]]
	JRST	FDLST		; ANALYSE ERROR

FDLWON:	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	JRST	FINIS
]
IFE ITS,[
	MOVE	A,(AB)
	MOVE	B,1(AB)
	PUSHJ	P,ADDNUL
	MOVE	A,(TP)		; GET BASE OF PDL
	MOVEI	A,1(A)		; POINT TO CRAP
	CAMGE	AB,[-3,,]	; SKIP IF DELETE
	HLLZS	(A)		; RESET DEFAULT
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,[0]
	GTJFN			; GET A JFN
	JRST	TDLLOS		; LOST
	ADD	AB,[2,,2]	; PAST ARG
	MOVEM	AB,ABSAV(TB)
	JUMPL	AB,RNM1		; GO TRY FOR RENAME
	MOVE	P,(TP)		; RESTORE P STACK
	MOVEI	C,(A)		; FOR RELEASE
	DELF			; ATTEMPT DELETE
	JRST	DELLOS		; LOSER
	RLJFN			; MAKE SURE FLUSHED
	JFCL

FDLWON:	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	JRST	FINIS

RNMLOS:	PUSH	P,A
	MOVEI	A,(B)
	RLJFN
	JFCL
DELLO1:	MOVEI	A,(C)
	RLJFN
	JFCL
	POP	P,A		; ERR NUMBER BACK
TDLLOS:	MOVEI	B,0
	PUSHJ	P,TGFALS	; GET FALSE WITH REASON
	JRST	FINIS

DELLOS:	PUSH	P,A		; SAVE ERROR
	JRST	DELLO1
]

;TABLE OF REANMAE DEFAULTS
IFN ITS,[
RNMTBL:	IMQUOTE	DEV
	IMQUOTE	NM1
	IMQUOTE	NM2
	IMQUOTE	SNM

RNSTBL:	SIXBIT /DSK   _MUDS_>           /
]
IFE ITS,[
RNMTBL:	SETZ IMQUOTE DEV
	SETZ IMQUOTE SNM
	SETZ IMQUOTE NM1
	SETZ IMQUOTE NM2

RNSTBL:	-1,,[ASCIZ /DSK/]
	0
	-1,,[ASCIZ /_MUDS_/]
	-1,,[ASCIZ /MUD/]
]
; HERE TO DO A RENAME

RNM1:	JUMPGE	AB,TMA		; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING
	GETYP	0,(AB)
	MOVE	C,1(AB)		; GET ARG
	CAIN	0,TATOM		; IS IT "TO"
	CAME	C,IMQUOTE TO
	JRST	WRONGT		; NO, LOSE
	ADD	AB,[2,,2]	; BUMP PAST "TO"
	MOVEM	AB,ABSAV(TB)
	JUMPGE	AB,TFA
IFN ITS,[
	MOVEM	P,T.SPDL+1(TB)	; SAVE NEW P-BASE

	MOVEI	0,4		; FOUR DEFAULTS
	PUSH	P,-3(P)		; DEFAULT DEVICE IS CURRENT
	SOJN	0,.-1

	PUSHJ	P,RGPRS		; PARSE THE NEXT STRING
	JRST	TMA

	MOVE	A,-7(P)		; FIX AND GET DEV1
	MOVE	B,-3(P)		; SAME FOR DEV2
	CAME	A,B		; SAME?
	JRST	DEVDIF

	POP	P,A		; GET SNAME 2
	CAME	A,(P)-3		; SNAME 1
	JRST	DEVDIF
	.SUSET	[.SSNAM,,A]
	POP	P,-2(P)		; MOVE NAMES DOWN
	POP	P,-2(P)
	DOTCAL	RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)]
	JRST	FDLST
	JRST	FDLWON

; HERE FOR RENAME WHILE OPEN FOR WRITING

CHNRNM:	ADD	AB,[2,,2]	; NEXT ARG
	MOVEM	AB,ABSAV(TB)
	JUMPGE	AB,TFA
	MOVE	B,-1(AB)	; GET CHANNEL
	SKIPN	CHANNO(B)	; SKIP IF OPEN
	JRST	BADCHN
	MOVE	A,DIRECT-1(B)	; CHECK DIRECTION
	MOVE	B,DIRECT(B)
	PUSHJ	P,STRTO6	; TO 6 BIT
	POP	P,A
	CAME	A,[SIXBIT /PRINT/]
	CAMN	A,[SIXBIT /PRINTB/]
	JRST	CHNRN1
	CAMN	A,[SIXBIT /PRINAO/]
	JRST	CHNRM1
	CAME	A,[SIXBIT /PRINTO/]
	JRST	WRONGD

; SET UP .FDELE BLOCK

CHNRN1:	PUSH	P,[0]
	PUSH	P,[0]
	MOVEM	P,T.SPDL+1(TB)
	PUSH	P,[0]
	PUSH	P,[SIXBIT /_MUDL_/]
	PUSH	P,[SIXBIT />/]
	PUSH	P,[0]

	PUSHJ	P,RGPRS		; PARSE THESE
	JRST	TMA

	SUB	P,[1,,1]	; SNAME/DEV IGNORED
	MOVE	AB,ABSAV(TB)	; GET ORIG ARG POINTER
	MOVE	B,1(AB)
	MOVE	A,CHANNO(B)	; ITS CHANNEL #
	DOTCAL	RENMWO,[A,[17,,-1],(P)]
	JRST	FDLST
	MOVE	A,CHANNO(B)	; ITS CHANNEL #
	DOTCAL	RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]]
	JFCL
	MOVE	A,-3(P)		; UPDATE CHANNEL
	PUSHJ	P,6TOCHS	; GET A STRING
	MOVE	C,1(AB)
	MOVEM	A,RNAME1-1(C)
	MOVEM	B,RNAME1(C)
	MOVE	A,-2(P)
	PUSHJ	P,6TOCHS
	MOVE	C,1(AB)
	MOVEM	A,RNAME2-1(C)
	MOVEM	B,RNAME2(C)
	MOVE	B,1(AB)
	MOVSI	A,TCHAN
	JRST	FINIS
]
IFE ITS,[
	PUSH	P,A
	MOVE	A,(AB)
	MOVE	B,1(AB)
	PUSHJ	P,ADDNUL
	MOVE	A,(TP)		; PBASE BACK
	PUSH	A,[400000,,0]
	MOVEI	A,(A)
	GTJFN
	JRST	TDLLOS
	POP	P,B
	EXCH	A,B
	MOVEI	C,(A)		; FOR RELEASE ATTEMPT
	RNAMF
	JRST	RNMLOS
	MOVEI	A,(B)
	RLJFN			; FLUSH JFN
	JFCL
	MOVEI	A,(C)		; MAKE SURR OTHER IS FLUSHED
	RLJFN
	JFCL
	JRST	FDLWON


ADDNUL:	PUSH	TP,A
	PUSH	TP,B
	MOVEI	A,(A)		; LNTH OF STRING
	IDIVI	A,5
	JUMPN	B,NONUAD	; DONT NEED TO ADD ONE

	PUSH	TP,$TCHRS
	PUSH	TP,[0]
	MOVEI	A,2
	PUSHJ	P,CISTNG	; COPY OF STRING
	POPJ	P,

NONUAD:	POP	TP,B
	POP	TP,A
	POPJ	P,
]
; HERE FOR LOSING .FDELE

IFN ITS,[
FDLST:	.STATUS	0,A		; GET STATUS
FDLST1:	MOVEI	B,0
	PUSHJ	P,GFALS		; ANALYZE IT
	JRST	FINIS
]

; SOME .FDELE ERRORS

DEVDIF:	ERRUUO	EQUOTE DEVICE-OR-SNAME-DIFFERS

; HERE TO RESET A READ CHANNEL

MFUNCTION FRESET,SUBR,RESET

	ENTRY	1
	GETYP	A,(AB)
	CAIE	A,TCHAN
	JRST	WTYP1
	MOVE	B,1(AB)		;GET CHANNEL
	SKIPN	IOINS(B)		; OPEN?
	JRST	REOPE1		; NO, IGNORE CHECKS
IFN ITS,[
	MOVE	A,STATUS(B)	;GET STATUS
	ANDI	A,77
	JUMPE	A,REOPE1	;IF IT CLOSED, JUST REOPEN IT, MAYBE?
	CAILE	A,2		;SKIPS IF TTY FLAVOR
	JRST	REOPEN
]
IFE ITS,[
	MOVE	A,CHANNO(B)
	CAIE	A,100		; TTY-IN
	CAIN	A,101		; TTY-OUT
	JRST	.+2
	JRST	REOPEN
]
	CAME	B,TTICHN+1
	CAMN	B,TTOCHN+1
	JRST	REATTY
REATT1:	MOVEI	B,DIRECT-1(B)	;POINT TO DIRECTION
	PUSHJ	P,CHRWRD	;CONVERT TO A WORD
	JFCL
	CAME	B,[ASCII /READ/]
	JRST	TTYOPN
	MOVE	B,1(AB)		;RESTORE CHANNEL
	PUSHJ	P,RRESET"	;DO REAL RESET
	JRST	TTYOPN

REOPEN:	PUSH	TP,(AB)		;FIRST CLOSE IT
	PUSH	TP,(AB)+1
	MCALL	1,FCLOSE
	MOVE	B,1(AB)		;RESTORE CHANNEL

; SET UP TEMPS FOR OPNCH

REOPE1:	PUSH	P,[0]		; WILL HOLD DIR CODE
	PUSH	TP,$TPDL
	PUSH	TP,P
	IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS]
	PUSH	TP,A-1(B)
	PUSH	TP,A(B)
	TERMIN

	PUSH	TP,$TCHAN
	PUSH	TP,1(AB)

	MOVE	A,T.DIR(TB)
	MOVE	B,T.DIR+1(TB)	; GET DIRECTION
	PUSHJ	P,CHMOD	; CHECK THE MODE
	MOVEM	A,(P)		; AND STORE IT

; NOW SET UP OPEN BLOCK IN SIXBIT

IFN ITS,[
	MOVSI	E,-4		; AOBN PNTR
FRESE2:	MOVE	B,T.CHAN+1(TB)
	MOVEI	A,@RDTBL(E)	; GET ITEM POINTER
	GETYP	0,-1(A)		; GET ITS TYPE
	CAIE	0,TCHSTR
	JRST	FRESE1
	MOVE	B,(A)		; GET STRING
	MOVE	A,-1(A)
	PUSHJ	P,STRTO6
FRESE3:	AOBJN	E,FRESE2
]
IFE ITS,[
	MOVE	B,T.CHAN+1(TB)
	MOVE	A,RDEVIC-1(B)
	MOVE	B,RDEVIC(B)
	PUSHJ	P,STRTO6		; RESULT ON STACK
	HLRZS	(P)
]

	PUSH	P,[0]		; PUSH UP SOME DUMMIES
	PUSH	P,[0]
	PUSH	P,[0]
	PUSHJ	P,OPNCH		; ATTEMPT TO DO THEOPEN
	GETYP	0,A
	CAIE	0,TCHAN
	JRST	FINIS		; LEAVE IF FALSE OR WHATEVER

DRESET:	MOVE	A,(AB)
	MOVE	B,1(AB)
	SETZM	CHRPOS(B)	;INITIALIZE THESE PARAMETERS
	SETZM	LINPOS(B)
	SETZM	ACCESS(B)
	JRST	FINIS

TTYOPN:
IFN ITS,[
	MOVE	B,1(AB)
	CAME	B,TTOCHN+1
	CAMN	B,TTICHN+1
	PUSHJ	P,TTYOP2
	PUSHJ	P,DOSTAT
	DOTCAL	RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]
	 .LOSE	%LSSYS
	MOVEM	C,PAGLN(B)
	MOVEM	D,LINLN(B)
]
	JRST	DRESET

IFN ITS,[
FRESE1:	CAIE	0,TFIX
	JRST	BADCHN
	PUSH	P,(A)
	JRST	FRESE3
]

; INTERFACE TO REOPEN CLOSED CHANNELS

OPNCHN:	PUSH	TP,$TCHAN
	PUSH	TP,B
	MCALL	1,FRESET
	POPJ	P,

REATTY:	PUSHJ	P,TTYOP2
IFE ITS,	SKIPN	DEMFLG		; SKIP IF DEMONFLAG IS ON
	SKIPE	NOTTY
	JRST	DRESET
	MOVE	B,1(AB)
	JRST	REATT1

; FUNCTION TO LIST ALL CHANNELS

MFUNCTION CHANLIST,SUBR

	ENTRY	0

	MOVEI	A,N.CHNS-1	;MAX # OF REAL CHANNELS
	MOVEI	C,0
	MOVEI	B,CHNL1	;POINT TO FIRST REAL CHANNEL

CHNLP:	SKIPN	1(B)		;OPEN?
	JRST	NXTCHN		;NO, SKIP
	HRRE	E,(B)		; ABOUT TO FLUSH?
	JUMPL	E,NXTCHN	; YES, FORGET IT
	MOVE	D,1(B)		; GET CHANNEL
	HRRZ	E,CHANNO-1(D)	; GET REF COUNT
	PUSH	TP,(B)
	PUSH	TP,1(B)
	ADDI	C,1		;COUNT WINNERS
	SOJGE	E,.-3		; COUNT THEM
NXTCHN:	ADDI	B,2
	SOJN	A,CHNLP

	SKIPN	B,CHNL0+1	;NOW HACK LIST OF PSUEDO CHANNELS
	JRST	MAKLST
CHNLS:	PUSH	TP,(B)
	PUSH	TP,(B)+1
	ADDI	C,1
	HRRZ	B,(B)
	JUMPN	B,CHNLS

MAKLST:	ACALL	C,LIST
	JRST	FINIS

; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE


REOPN:	PUSH	TP,$TCHAN
	PUSH	TP,B
	SKIPN	CHANNO(B)	; ONLY REAL CHANNELS
	JRST	PSUEDO

IFN ITS,[
	MOVSI	E,-4		; SET UP POINTER FOR NAMES

GETOPB:	MOVE	B,(TP)		; GET CHANNEL
	MOVEI	A,@RDTBL(E)	; GET POINTER
	MOVE	B,(A)		; NOW STRING
	MOVE	A,-1(A)
	PUSHJ	P,STRTO6	; LEAVES SIXBIT ON STACK
	AOBJN	E,GETOPB
]
IFE ITS,[
	MOVE	A,RDEVIC-1(B)
	MOVE	B,RDEVIC(B)
	PUSHJ	P,STRTO6	; GET DEV NAME IN SIXBIT
]
	MOVE	B,(TP)		; RESTORE CHANNEL
	MOVE	A,DIRECT-1(B)
	MOVE	B,DIRECT(B)
	PUSHJ	P,CHMOD	; CHECK FOR A VALID MODE

IFN ITS,	MOVE	E,-3(P)		; GET DEVICE IN PROPER PLACE
IFE ITS,	HLRZS	E,(P)
	MOVE	B,(TP)		; RESTORE CHANNEL
IFN ITS,	CAMN	E,[SIXBIT /DSK   /]
IFE ITS,[
	CAIE	E,(SIXBIT /PS /)
	CAIN	E,(SIXBIT /DSK/)
	JRST	DISKH		; DISK WINS IMMEIDATELY
	CAIE	E,(SIXBIT /SS  /)
	CAIN	E,(SIXBIT /SRC/)
	JRST	DISKH		; DISK WINS IMMEIDATELY
]
IFN ITS,	CAMN	E,[SIXBIT /TTY   /]	; NO NEED TO RE-OPEN THE TTY
IFE ITS,	CAIN	E,(SIXBIT /TTY/)
	JRST	REOPD1
IFN ITS,[
	AND	E,[777700,,0]	; COULD BE "UTn"
	MOVE	D,CHANNO(B)	; GET CHANNEL
	ASH	D,1
	ADDI	D,CHNL0	; DON'T SEEM TO BE OPEN
	SETZM	1(D)
	SETZM	CHANNO(B)
	CAMN	E,[SIXBIT /UT    /]
	JRST	REOPD		; CURRENTLY, CANT RESTORE UTAPE CHANNLES
	CAMN	E,[SIXBIT /AI    /]
	JRST	REOPD		; CURRENTLY CANT RESTORE AI CHANNELS
	CAMN	E,[SIXBIT /ML    /]
	JRST	REOPD		; CURRENTLY CANT RESTORE ML CHANNELS
	CAMN	E,[SIXBIT /DM    /]
	JRST	REOPD		; CURRENTLY CANT RESTORE DM CHANNELS
]
	PUSH	TP,$TCHAN	; TRY TO RESET IT 
	PUSH	TP,B
	MCALL	1,FRESET

IFN ITS,[
REOPD1:	AOS	-4(P)
REOPD:	SUB	P,[4,,4]
]
IFE ITS,[
REOPD1:	AOS	-1(P)
REOPD:	SUB	P,[1,,1]
]
REOPD0:	SUB	TP,[2,,2]
	POPJ	P,

IFN ITS,[
DISKH:	MOVE	C,(P)		; SNAME
	.SUSET	[.SSNAM,,C]
]
IFE ITS,[
DISKH:	MOVEM	A,(P)		; SAVE MODE WORD
	PUSHJ	P,STSTK		; STRING TO STACK
	MOVE	A,(E)		; RESTORE MODE WORD
	PUSH	TP,$TPDL
	PUSH	TP,E		; SAVE PDL BASE
	MOVE	B,-2(TP)	; CHANNEL BACK TO B
]
	MOVE	C,ACCESS(B)	; GET CHANNELS ACCESS
	TRNN	A,2		; SKIP IF NOT ASCII CHANNEL
	JRST	DISKH1
	HRRZ	D,ACCESS-1(B)	; IF PARTIAL WORD OUT
	IMULI	C,5		; TO CHAR ACCESS
	JUMPE	D,DISKH1	; NO SWEAT
	ADDI	C,(D)
	SUBI	C,5
DISKH1:	HRRZ	D,BUFSTR-1(B)	; ANY CHARS IN MUDDLE BUFFER
	JUMPE	D,DISKH2
	TRNN	A,1		; SKIP IF OUTPUT CHANNEL
	JRST	DISKH2
	PUSH	P,A
	PUSH	P,C
	MOVEI	C,BUFSTR-1(B)
	PUSHJ	P,BYTDOP	; FIND LENGTH OF WHOLE BUFFER
	HLRZ	D,(A)		; LENGTH + 2 TO D
	SUBI	D,2
	IMULI	D,5		; TO CHARS
	SUB	D,BUFSTR-1(B)
	POP	P,C
	POP	P,A
DISKH2:	SUBI	C,(D)		; UPDATE CHAR ACCESS
	IDIVI	C,5		; BACK TO WORD ACCESS
IFN ITS,[
	IORI	A,6		; BLOCK IMAGE
	TRNE	A,1
	IORI	A,100000	; WRITE OVER BIT
	PUSHJ	P,DOOPN
	JRST	REOPD
	MOVE	A,C		; ACCESS TO A
	PUSHJ	P,GETFLN	; CHECK LENGTH
	CAIGE	0,(A)		; CHECK BOUNDS
	JRST	.+3		; COMPLAIN
	PUSHJ	P,DOACCS	; AND ACESS
	JRST	REOPD1		; SUCCESS

	MOVE	A,CHANNO(B)	; CLOSE THE G.D. CHANNEL
	PUSHJ	P,MCLOSE
	JRST	REOPD

DOACCS:	PUSH	P,A
	HRRZ	A,CHANNO(B)
	DOTCAL	ACCESS,[A,(P)]
	JFCL
	POP	P,A
	POPJ	P,

DOIOTO:
DOIOTI:
DOIOT:
	PUSH	P,0
	MOVSI	0,TCHAN
	MOVE	PVP,PVSTOR+1
	MOVEM	0,BSTO(PVP)	; IN CASE OF INTERRUPT
	ENABLE
	HRRZ	0,CHANNO(B)
	DOTCAL	IOT,[0,A]
	JFCL
	DISABLE
	MOVE	PVP,PVSTOR+1
	SETZM	BSTO(PVP)
	POP	P,0
	POPJ	P,

GETFLN:	MOVE	0,CHANNO(B)	; GET CHANNEL
	.CALL	FILBLK		; READ LNTH
	.VALUE
	POPJ	P,

FILBLK:	SETZ
	SIXBIT /FILLEN/
	0
	402000,,0	; STUFF RESULT IN 0
]
IFE ITS,[
	MOVEI	A,CHNL0
	ADD	A,CHANNO(B)
	ADD	A,CHANNO(B)
	SETZM	1(A)		; MAY GET A DIFFERENT JFN	
	HRROI	B,1(E)		; TENEX STRING POINTER
	MOVSI	A,400001	; MAKE SURE
	GTJFN			; GO GET IT
	JRST	RGTJL		; COMPLAIN
	MOVE	D,-2(TP)
	HRRZM	A,CHANNO(D)	; COULD HAVE CHANGED
	MOVE	P,(TP)		; RESTORE P
	MOVEI	B,CHNL0
	ASH	A,1		; MUNG ITS SLOT
	ADDI	A,(B)
	MOVEM	D,1(A)
	HLLOS	(A)		; MARK CHANNEL NOT TO BE RELOOKED AT
	MOVE	A,(P)		; MODE WORD BACK
	MOVE	B,[440000,,200000]	; FLAG BITS
	TRNE	A,1		; SKIP FOR INPUT
	TRC	B,300000	; CHANGE TO WRITE
	MOVE	A,CHANNO(D)	; GET JFN
	OPENF
	JRST	ROPFLS
	MOVE	E,C		; LENGTH TO E
	SIZEF			; GET CURRENT LENGTH
	JRST	ROPFLS
	CAMGE	B,E		; STILL A WINNER
	JRST	ROPFLS
	MOVE	A,CHANNO(D)	; JFN
	MOVE	B,C
	SFPTR
	JRST	ROPFLS
	SUB	TP,[2,,2]	; FLUSH PDL POINTER
	JRST	REOPD1

ROPFLS:	MOVE	A,-2(TP)
	MOVE	A,CHANNO(A)
	CLOSF			; ATTEMPT TO CLOSE
	JFCL			; IGNORE FAILURE
	SKIPA

RGTJL:	MOVE	P,(TP)
	SUB	TP,[2,,2]
	JRST	REOPD

DOACCS:	PUSH	P,B
	EXCH	A,B
	MOVE	A,CHANNO(A)
	SFPTR
	JRST	ACCFAI
	POP	P,B
	POPJ	P,
]
PSUEDO:	AOS	(P)		; ASSUME SUCCESS FOR NOW
	MOVEI	B,RDEVIC-1(B)	; SEE WHAT DEVICE IS
	PUSHJ	P,CHRWRD
	JFCL
	JRST	REOPD0		; NO, RETURN HAPPY
IFN 0,[	CAME	B,[ASCII /E&S/]	; DISPLAY ?
	CAMN	B,[ASCII /DIS/]
	SKIPA	B,(TP)		; YES, REGOBBLE CHANNEL AND CONTINUE
	JRST	REOPD0		; NO, RETURN HAPPY
	PUSHJ	P,DISROP
	SOS	(P)		; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS
	JRST	REOPD0]

;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL

MFUNCTION FCLOSE,SUBR,[CLOSE]

	ENTRY	1		;ONLY ONE ARG
	GETYP	A,(AB)		;CHECK ARGS
	CAIE	A,TCHAN		;IS IT A CHANNEL
	JRST	WTYP1
	MOVE	B,1(AB)		;PICK UP THE CHANNEL
	HRRZ	A,CHANNO-1(B)	; GET REF COUNT
	SOJGE	A,CFIN5		;  NOT READY TO REALLY CLOSE
	CAME	B,TTICHN+1	; CHECK FOR TTY
	CAMN	B,TTOCHN+1
	JRST	CLSTTY
	MOVE	A,[JRST	CHNCLS]
	MOVEM	A,IOINS(B)	;CLOBBER THE IO INS
	MOVE	A,RDEVIC-1(B)	;GET THE NAME OF THE DEVICE
	MOVE	B,RDEVIC(B)
	PUSHJ	P,STRTO6
IFN ITS,	MOVE	A,(P)
IFE ITS,	HLRZS	A,(P)
	MOVE	B,1(AB)		; RESTORE CHANNEL
IFN 0,[
	CAME	A,[SIXBIT /E&S   /]
	CAMN	A,[SIXBIT /DIS   /]
	PUSHJ	P,DISCLS]
	MOVE	B,1(AB)		; IN CASE CLOBBERED BY DISCLS
	SKIPN	A,CHANNO(B)	;ANY REAL CHANNEL?
	JRST	REMOV		; NO, EITHER  CLOSED OR PSEUDO CHANNEL

	MOVE	A,DIRECT-1(B)	; POINT TO DIRECTION
	MOVE	B,DIRECT(B)
	PUSHJ	P,STRTO6	; CONVERT TO WORD
	POP	P,A
IFN ITS,	LDB	E,[360600,,(P)]	; FIRST CHAR OD DEV NAME
IFE ITS,	LDB	E,[140600,,(P)]	; FIRST CHAR OD DEV NAME
	CAIE	E,'T		; SKIP IF TTY
	JRST	CFIN4
	CAME	A,[SIXBIT /READ/]	; SKIP IF WINNER
	JRST	CFIN1
IFN ITS,[
	MOVE	B,1(AB)		; IN ITS CHECK STATUS
	LDB	A,[600,,STATUS(B)]
	CAILE	A,2
	JRST	CFIN1
]
	PUSH	TP,$TCHSTR
	PUSH	TP,CHQUOTE CHAR
	PUSH	TP,(AB)
	PUSH	TP,1(AB)
	MCALL	2,OFF		; TURN OFF INTERRUPT
CFIN1:	MOVE	B,1(AB)
	MOVE	A,CHANNO(B)
IFN ITS,[
	PUSHJ	P,MCLOSE
]
IFE ITS,[
	TLZ	A,400000	; FOR JFN RELEASE
	CLOSF			; CLOSE THE FILE AND RELEASE THE JFN
	JFCL
	MOVE	A,CHANNO(B)
]
CFIN:	LSH	A,1
	ADDI	A,CHNL0+1	;POINT TO THIS CHANNELS LSOT
	SETZM	CHANNO(B)
	SETZM	(A)		;AND CLOBBER IT
	HLLZS	BUFSTR-1(B)
	SETZM	BUFSTR(B)
	HLLZS	ACCESS-1(B)
CFIN2:	HLLZS	-2(B)
	MOVSI	A,TCHAN		;RETURN THE CHANNEL
	JRST	FINIS

CLSTTY:	ERRUUO	EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL


REMOV:	MOVEI	D,CHNL0+1	;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST
REMOV0:	SKIPN	C,D		;FOUND ON LIST ?
	JRST	CFIN2		;NO, JUST IGNORE THIS CLOSED CHANNEL
	HRRZ	D,(C)		;GET POINTER TO NEXT
	CAME	B,(D)+1		;FOUND ?
	JRST	REMOV0
	HRRZ	D,(D)		;YES, SPLICE IT OUT
	HRRM	D,(C)
	JRST	CFIN2


; CLOSE UP ANY LEFTOVER BUFFERS

CFIN4:
;	CAME	A,[SIXBIT /PRINTO/]
;	CAMN	A,[SIXBIT /PRINTB/]
;	JRST	.+3
;	CAME	A,[SIXBIT /PRINT/]
;	JRST	CFIN1
	MOVE	B,1(AB)		; GET CHANNEL
	HRRZ	A,-2(B)		;GET MODE BITS
	TRNN	A,C.PRIN
	 JRST	CFIN1
	GETYP	0,BUFSTR-1(B)	; IS THERE AN OUTPUT BUFFER
	SKIPN	BUFSTR(B)
	JRST	CFIN1
	CAIE	0,TCHSTR
	JRST	CFINX1
	PUSHJ	P,BFCLOS
IFE ITS,[
	MOVE	A,CHANNO(B)
	MOVEI	B,7
	SFBSZ
	JFCL
	CLOSF
	JFCL
]
	HLLZS	BUFSTR-1(B)
	SETZM	BUFSTR(B)
CFINX1:	HLLZS	ACCESS-1(B)
	JRST	CFIN1

CFIN5:	HRRM	A,CHANNO-1(B)
	JRST	CFIN2
;SUBR TO DO .ACCESS ON A READ CHANNEL
;FORM:	<ACCESS  CHANNEL FIX-NUMBER>
;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER
;H. BRODIE 7/26/72

MFUNCTION MACCESS,SUBR,[ACCESS]
	ENTRY	2	;ARGS: CHANNEL AND FIX-NUMBER

;CHECK ARGUMENT TYPES
	GETYP	A,(AB)
	CAIE	A,TCHAN		;FIRST ARG SHOULD BE CHANNEL
	JRST	WTYP1
	GETYP	A,2(AB)		;TYPE OF SECOND
	CAIE	A,TFIX		;SHOULD BE FIX
	JRST	WTYP2

;CHECK DIRECTION OF CHANNEL
	MOVE	B,1(AB)		;B GETS PNTR TO CHANNEL
;	MOVEI	B,DIRECT-1(B)	;GET DIRECTION OF CHANNEL
;	PUSHJ	P,CHRWRD	;GRAB THE CHAR STRNG
;	JFCL
;	CAME	B,[<ASCII /PRINT/>+1]
	HRRZ	A,-2(B)		; GET MODE BITS
	TRNN	A,C.PRIN
	JRST	MACCA
	MOVE	B,1(AB)
	SKIPE	C,BUFSTR(B)	;SEE IF WE MUST FLUSH PART BUFFER
	PUSHJ	P,BFCLOS
	JRST	MACC
MACCA:
;	CAMN	B,[ASCIZ /READ/]
;	JRST	.+4
;	CAME	B,[ASCIZ /READB/]	; READB CHANNEL?
;	JRST	WRONGD
;	AOS	(P)			; SET INDICATOR FOR BINARY MODE

;CHECK THAT THE CHANNEL IS OPEN
MACC:	MOVE	B,1(AB)		;GET BACK PTR TO CHANNEL
	HRRZ	E,-2(B)
	TRNN	E,C.OPN
	JRST	CHNCLS		;IF CHNL CLOSED => ERROR

;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN
;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER
ADEVOK:	SKIPGE	C,3(AB)		;GET CHAR POSN
	ERRUUO	EQUOTE NEGATIVE-ARGUMENT
MACC1:	MOVEI	D,0
      	TRNN	E,C.BIN		; SKIP FOR BINARY FILE
	IDIVI	C,5

;SETUP THE .ACCESS
	TRNN	E,C.PRIN
	 JRST	NLSTCH
	HRRZ	0,LSTCH-1(B)
	MOVE	A,ACCESS(B)
	TRNN	E,C.BIN
	 JRST	LSTCH1
	IMULI	A,5
	ADD	A,ACCESS-1(B)
	ANDI	A,-1
LSTCH1:	CAIG	0,(A)
	 MOVE	0,A
	MOVE	A,C
	IMULI	A,5
	ADDI	A,(D)
	CAML	A,0
	 MOVE	0,A
	HRRM	0,LSTCH-1(B)	; UPDATE "LARGEST"
NLSTCH:	MOVE	A,CHANNO(B)	;A GETS REAL CHANNEL NUMBER
IFN ITS,[
	DOTCAL	ACCESS,[A,C]
	 .LOSE	%LSFIL		;PRESUMABLY LOSSAGE MATTERS
]

IFE ITS,[
	MOVE	B,C
	SFPTR			; DO IT IN TENEX
	JRST	ACCFAI
	MOVE	B,1(AB)		; RESTORE CHANNEL
]
;	POP	P,E		; CHECK FOR READB MODE
	TRNN	E,C.READ
	JRST	ACCOUT		; PRINT TYPE CHANNEL, GO DO IT
	SKIPE	BUFSTR(B)	; IS THERE A READ BUFFER TO FLUSH
	JRST	.+3
	SETZM	LSTCH(B)	; CLEAR OUT POSSIBLE EOF INDICATOR
	JRST	DONADV

;NOW FORCE GETCHR TO DO A .IOT FIRST THING
	MOVEI	C,BUFSTR-1(B)	; FIND END OF STRING
	PUSHJ	P,BYTDOP"
	SUBI	A,2		; LAST REAL WORD
	HRLI	A,010700
	MOVEM	A,BUFSTR(B)
	HLLZS	BUFSTR-1(B)	; CLOBBER CHAR COUNT
	SETZM	LSTCH(B)	;CLOBBER READ'S HIDDEN CHARACTER

;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS
	JUMPLE	D,DONADV
ADVPTR:	PUSHJ	P,GETCHR
	MOVE	B,1(AB)		;RESTORE IN CASE CLOBBERED
	SOJG	D,ADVPTR

DONADV:	MOVE	C,3(AB)		;FIXUP ACCESS SLOT IN CHNL
	HLLZS	ACCESS-1(B)
	MOVEM	C,ACCESS(B)
	MOVE	A,$TCHAN	;TYPE OF RESULT = "CHANNEL"
	JRST	FINIS		;DONE...B CONTAINS CHANNEL

IFE ITS,[
ACCFAI:	ERRUUO	EQUOTE ACCESS-FAILURE
]
ACCOUT:	SKIPN	C,BUFSTR(B)	; FIXUP BUFFER?
	 JRST	ACCOU1
	HRRZ	F,BUFSTR-1(B)
	ADD	F,[-BUFLNT*5-4]
	IDIVI	F,5
	ADD	F,BUFSTR(B)
	HRLI	F,010700
	MOVEM	F,BUFSTR(B)
	MOVEI	F,BUFLNT*5
	HRRM	F,BUFSTR-1(B)
ACCOU1:	TRNE	E,C.BIN		; FINISHED FOR BINARY CHANNELS
	 JRST	DONADV

	JUMPE	D,DONADV	; THIS CASE OK
IFE ITS,[
	MOVE	A,CHANNO(B)	; GET LAST WORD
	RFPTR
	JFCL
	PUSH	P,B
	MOVNI	C,1
	MOVE	B,[444400,,E]	; READ THE WORD
	SIN
	JUMPL	C,ACCFAI
	POP	P,B
	SFPTR
	JFCL
	MOVE	B,1(AB)		; CHANNEL BACK
	MOVE	C,[440700,,E]
	ILDB	0,C
	IDPB	0,BUFSTR(B)
	SOS	BUFSTR-1(B)
	SOJG	D,.-3
	JRST	DONADV
]
IFN ITS,	ERRUUO	EQUOTE CANT-ACCESS-ASCII-ON-ITS


;WRONG TYPE OF DEVICE ERROR
WRDEV:	ERRUUO	EQUOTE NON-DSK-DEVICE

; BINARY READ AND PRINT ROUTINES

MFUNCTION PRINTB,SUBR

	ENTRY

PBFL:	PUSH	P,.		; PUSH NON-ZERONESS
	MOVEI	A,-7
	JRST	BINI1

MFUNCTION READB,SUBR

	ENTRY

	PUSH	P,[0]
	MOVEI	A,-11
BINI1:	HLRZ	0,AB
	CAILE	0,-3
	 JRST	TFA
	CAIG	0,(A)
	 JRST	TMA

	GETYP	0,(AB)		; SHOULD BE UVEC OR STORE
	CAIE	0,TSTORAGE
	 CAIN	0,TUVEC
	  JRST	BINI2
	CAIE	0,TCHSTR
	 CAIN	0,TBYTE
	  JRST	BYTOK
	   JRST	WTYP1		; ELSE LOSE
BINI2:	MOVE	B,1(AB)		; GET IT
	HLRE	C,B
	SUBI	B,(C)		; POINT TO DOPE
	GETYP	A,(B)
	PUSHJ	P,SAT"		; GET ITS ST.ALOC.TYPE
	CAIE	A,S1WORD
	 JRST	WTYP1
BYTOK:	GETYP	0,2(AB)
	CAIE	0,TCHAN		; BETTER BE A CHANNEL
	 JRST	WTYP2
	MOVE	B,3(AB)		; GET IT
;	MOVEI	B,DIRECT-1(B)	; GET DIRECTION OF
;	PUSHJ	P,CHRWRD	; INTO 1 WORD
;	JFCL
;	MOVNI	E,1
;	CAMN	B,[ASCII /READB/]
;	MOVEI	E,0
;	CAMN	B,[<ASCII /PRINT/>+1]
	HRRZ	A,-2(B)		; MODE BITS
	TRNN	A,C.BIN		; IF NOT BINARY
	 JRST	WRONGD
	MOVEI	E,0
	TRNE	A,C.PRIN
	MOVE	E,PBFL
;	JUMPL	E,WRONGD		; LOSER
	CAME	E,(P)		; CHECK WINNGE
	 JRST	WRONGD
	MOVE	B,3(AB)		; GET CHANNEL BACK
	SKIPN	A,IOINS(B)	; OPEN?
	 PUSHJ	P,OPENIT		; LOSE
	CAMN	A,[JRST CHNCLS]
	 JRST	CHNCLS		; LOSE, CLOSED
	JUMPN	E,BUFOU1	; JUMP FOR OUTPUT
	MOVEI	C,0
	CAML	AB,[-5,,]	; SKIP IF EOF GIVEN
	 JRST	BINI5
	MOVE	0,4(AB)
	MOVEM	0,EOFCND-1(B)
	MOVE	0,5(AB)
	MOVEM	0,EOFCND(B)
	CAML	AB,[-7,,]
	 JRST	BINI5
	GETYP	0,6(AB)
	CAIE	0,TFIX
	 JRST	WTYP
	MOVE	C,7(AB)
BINI5:	SKIPE	LSTCH(B)	; INDICATES IF EOF HIT
	 JRST	BINEOF
	GETYP	0,(AB)		; BRANCH BASED ON BYTE SIZE
	CAIE	0,TCHSTR
	 CAIN	0,TBYTE
	  JRST	BYTI
	MOVE	A,1(AB)		; GET VECTOR
	PUSHJ	P,PGBIOI	; READ IT
	HLRE	C,A		; GET COUNT DONE
	HLRE	D,1(AB)		; AND FULL COUNT
	SUB	C,D		; C=> TOTAL READ
	ADDM	C,ACCESS(B)
	JUMPGE	A,BINIOK	; NOT EOF YET
	SETOM	LSTCH(B)
BINIOK:	MOVE	B,C
	MOVSI	A,TFIX		; RETURN AMOUNT ACTUALLY READ
	JRST	FINIS

BYTI:
IFE ITS,[
	MOVE	A,1(B)
	RFBSZ 
	FATAL RFBSZ-LOST
	PUSH	P,B
	LDB	B,[300600,,1(AB)]
	SFBSZ
	FATAL SFBSZ-LOST
	MOVE	B,3(AB)
	HRRZ	A,(AB)		; GET BYTE STRING LENGTH
	MOVNS	A
	MOVSS	A		; MAKE FUNNY BYTE POINTER
	HRR	A,1(AB)
	ADDI	A,1
	PUSH	P,C
	HLL	C,1(AB)		; GET START OF BPTR
	MOVE	D,[SIN]
	PUSHJ	P,PGBIOT
	HLRE	C,A		; GET COUNT DONE
	POP	P,D
	SKIPN	D
	HRRZ	D,(AB)		; AND FULL COUNT
	ADD	D,C		; C=> TOTAL READ
	LDB	E,[300600,,1(AB)]
	MOVEI	A,36.
	IDIVM	A,E
	IDIVM	D,E
	ADDM	E,ACCESS(B)
	SKIPGE	C		; NOT EOF YET
	SETOM	LSTCH(B)
	MOVE	A,1(B)
	POP	P,B
	SFBSZ
	FATAL SFBSZ-LOST
	MOVE	C,D
	JRST	BINIOK
]
BUFOU1:	SKIPE	BUFSTR(B)	; ANY BUFFERS AROUND?
	 PUSHJ	P,BFCLS1	; GET RID OF SAME
	MOVEI	C,0
	CAML	AB,[-5,,]
	 JRST	BINO5
	GETYP	0,4(AB)
	CAIE	0,TFIX
	 JRST	WTYP
	MOVE	C,5(AB)
BINO5:	MOVE	A,1(AB)
	GETYP	0,(AB)		; BRANCH BASED ON BYTE SIZE
	CAIE	0,TCHSTR
	 CAIN	0,TBYTE
	  JRST	BYTO
	PUSH	P,C
	PUSHJ	P,PGBIOO
	POP	P,C
	JUMPE	C,.+3
	HLRE	C,1(AB)
	MOVNS	C
	ADDM	C,ACCESS(B)
BYTO1:	MOVE	A,(AB)		; RET VECTOR ETC.
	MOVE	B,1(AB)
	JRST	FINIS

BYTO:
IFE ITS,[
	MOVE	A,1(B)
	RFBSZ 
	FATAL RFBSZ-FAILURE
	PUSH	P,B
	LDB	B,[300600,,1(AB)]
	SFBSZ
	FATAL SFBSZ-FAILURE
	MOVE	B,3(AB)
	HRRZ	A,(AB)		; GET BYTE SIZE
	MOVNS	A
	MOVSS	A		; MAKE FUNNY BYTE POINTER
	HRR	A,1(AB)
	ADDI	A,1		; COMPENSATE FOR PGBIOT DOING THE WRONG THING
	HLL	C,1(AB)		; GET START OF BPTR
	MOVE	D,[SOUT]
	PUSHJ	P,PGBIOT
	LDB	D,[300600,,1(AB)]
	MOVEI	C,36.
	IDIVM	C,D
	HRRZ	C,(AB)
	IDIVI	C,(D)
	ADDM	C,ACCESS(B)
	MOVE	A,1(B)
	POP	P,B
	SFBSZ
	FATAL SFBSZ-FAILURE
	JRST	BYTO1
]

BINEOF:	PUSH	TP,EOFCND-1(B)
	PUSH	TP,EOFCND(B)
	PUSH	TP,$TCHAN
	PUSH	TP,B
	MCALL	1,FCLOSE	; CLOSE THE LOSER
	MCALL	1,EVAL
	JRST	FINIS

OPENIT:	PUSH	P,E
	PUSHJ	P,OPNCHN	;TRY TO OPEN THE LOSER
	JUMPE	B,CHNCLS	;FAIL
	POP	P,E
	POPJ	P,
; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE
; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF
; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS.

R1CHAR:	SKIPN	A,LSTCH(B)		; CHAR READING ROUTINE FOR FCOPY
	PUSHJ	P,RXCT
	TLO	A,200000		; ^@ BUG
	MOVEM	A,LSTCH(B)
	TLZ	A,200000
	JUMPL	A,.+2			; IN CASE OF -1 ON STY
	TRZN	A,400000		; EXCL HACKER
	JRST	.+4
	MOVEM	A,LSTCH(B)		; SAVE DE-EXCLED CHAR
	MOVEI	A,"!
	JRST	.+2
	SETZM	LSTCH(B)
	PUSH	P,C
	HRRZ	C,DIRECT-1(B)
	CAIE	C,5			; IF DIRECTION IS 5 LONG THEN READB
	JRST	R1CH1
	AOS	C,ACCESS-1(B)
	CAMN	C,[TFIX,,1]
	AOS	ACCESS(B)		; EVERY FIFTY INCREMENT
	CAMN	C,[TFIX,,5]
	HLLZS	ACCESS-1(B)
	JRST	.+2
R1CH1:	AOS	ACCESS(B)
	POP	P,C
	POPJ	P,

W1CHAR:	CAIE	A,15		; CHAR WRITING ROUTINE, TEST FOR CR
	JRST	.+3
	SETOM	CHRPOS(B)
	AOSA	LINPOS(B)
	CAIE	A,12			; TEST FOR LF
	AOS	CHRPOS(B)		; IF NOT LF AOS CHARACTE5R POSITION
	CAIE	A,14			; TEST FOR FORM FEED
	JRST	.+3
	SETZM	CHRPOS(B)		; IF FORM FEED ZERO CHARACTER POSITION
	SETZM	LINPOS(B)		; AND LINE POSITION
	CAIE	A,11			; IS THIS A TAB?
	JRST	.+6
	MOVE	C,CHRPOS(B)
	ADDI	C,7
	IDIVI	C,8.
	IMULI	C,8.			; FIX UP CHAR POS FOR TAB
	MOVEM	C,CHRPOS(B)		; AND SAVE
	PUSH	P,C
	HRRZ	C,-2(B)			; GET BITS
	TRNN	C,C.BIN			; SIX LONG MUST BE PRINTB
	JRST	W1CH1
	AOS	C,ACCESS-1(B)
	CAMN	C,[TFIX,,1]
	AOS	ACCESS(B)
	CAMN	C,[TFIX,,5]
	HLLZS	ACCESS-1(B)
	JRST	.+2
W1CH1:	AOS	ACCESS(B)
	PUSH	P,A
	PUSHJ	P,WXCT
	POP	P,A
	POP	P,C
	POPJ	P,

R1C:	SUBM	M,(P)			;LITTLE ENTRY FOR COMPILED STUFF
;	PUSH	TP,$TCHAN		;SAVE THE CHANNEL TO BLESS IT
;	PUSH	TP,B
;	MOVEI	B,DIRECT-1(B)
;	PUSHJ	P,CHRWRD
;	JFCL
;	CAME	B,[ASCIZ /READ/]
;	CAMN	B,[ASCII /READB/]
;	JRST	.+2
;	JRST	BADCHN
	HRRZ	A,-2(B)			; GET MODE BITS
	TRNN	A,C.READ
	 JRST	BADCHN
	SKIPN	IOINS(B)		; IS THE CHANNEL OPEN
	PUSHJ	P,OPENIT		; NO, GO DO IT
	PUSHJ	P,GRB			; MAKE SURE WE HAVE A READ BUFFER
	PUSHJ	P,R1CHAR		; AND GET HIM A CHARACTER
	JRST	MPOPJ			; THATS ALL FOLKS

W1C:	SUBM	M,(P)
	PUSHJ	P,W1CI
	JRST	MPOPJ

W1CI:	
;	PUSH	TP,$TCHAN
;	PUSH	TP,B
	PUSH	P,A			; ASSEMBLER ENTRY TO OUTPUT 1 CHAR
;	MOVEI	B,DIRECT-1(B)
;	PUSHJ	P,CHRWRD		; INTERNAL CALL TO W1CHAR
;	JFCL
;	CAME	B,[ASCII /PRINT/]
;	CAMN	B,[<ASCII /PRINT/>+1]
;	JRST	.+2
;	JRST	BADCHN
;	POP	TP,B
;	POP	TP,(TP)
	HRRZ	A,-2(B)
	TRNN	A,C.PRIN
	 JRST	BADCHN
	SKIPN	IOINS(B)		; MAKE SURE THAT IT IS OPEN
	PUSHJ	P,OPENIT
	PUSHJ	P,GWB
	POP	P,A			; GET THE CHAR TO DO
	JRST	W1CHAR

; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT
; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH.


WXCT:
RXCT:  	XCT	IOINS(B)		; READ IT
	SKIPN	SCRPTO(B)
	POPJ	P,

DOSCPT:	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	P,A			; AND SAVE THE CHAR AROUND

	SKIPN	SCRPTO(B)		; IF ZERO FORGET IT
	JRST	SCPTDN			; THATS ALL THERE IS TO IT
	PUSH	P,C			; SAVE AN ACCUMULATOR FOR CLEANLINESS
	GETYP	C,SCRPTO-1(B)		; IS IT A LIST
	CAIE	C,TLIST
	JRST	BADCHN
	PUSH	TP,$TLIST
	PUSH	TP,[0]		; SAVE A SLOT FOR THE LIST
	MOVE	C,SCRPTO(B)		; GET THE LIST OF SCRIPT CHANNELS
SCPT1:	GETYP	B,(C)			; GET THE TYPE OF THIS SCRIPT CHAN
	CAIE	B,TCHAN
	JRST	BADCHN			; IF IT ISN'T A CHANNEL, COMPLAIN
	HRRZ	B,(C)			; GET THE REST OF THE LIST IN B
	MOVEM	B,(TP)			; AND STORE ON STACK
	MOVE	B,1(C)			; GET THE CHANNEL IN B
	MOVE	A,-1(P)			; AND THE CHARACTER IN A
	PUSHJ	P,W1CI		; GO TO INTERNAL W1C, IT BLESSES GOODIES
	SKIPE	C,(TP)			; GET THE REST OF LIST OF CHANS
	JRST	SCPT1			; AND CYCLE THROUGH
	SUB	TP,[2,,2]		; CLEAN OFF THE LIST OF CHANS
	POP	P,C			; AND RESTORE ACCUMULATOR C
SCPTDN:	POP	P,A			; RESTORE THE CHARACTER
	POP	TP,B			; AND THE ORIGINAL CHANNEL
	POP	TP,(TP)
	POPJ	P,			; AND THATS ALL


; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT
; ON THE INPUT CHANNEL
; CALL IS <FILECOPY IN OUT> WHERE DEFAULTS ARE INCHAN AND OUTCHAN

	MFUNCTION	FCOPY,SUBR,[FILECOPY]

	ENTRY
	HLRE	0,AB
	CAMGE	0,[-4]
	JRST	WNA			; TAKES FROM 0 TO 2 ARGS

	JUMPE	0,.+4			; NO FIRST ARG?
	PUSH	TP,(AB)
	PUSH	TP,1(AB)		; SAVE IN CHAN
	JRST	.+6
	MOVE	A,$TATOM
	MOVE	B,IMQUOTE INCHAN
	PUSHJ	P,IDVAL
	PUSH	TP,A
	PUSH	TP,B
	HLRE	0,AB			; CHECK FOR SECOND ARG
	CAML	0,[-2]			; WAS THERE MORE THAN ONE ARG?
	JRST	.+4
	PUSH	TP,2(AB)		; SAVE SECOND ARG
	PUSH	TP,3(AB)
	JRST	.+6
	MOVE	A,$TATOM		; LOOK UP OUTCHAN AS DEFAULT
	MOVE	B,IMQUOTE OUTCHAN
	PUSHJ	P,IDVAL
	PUSH	TP,A
	PUSH	TP,B			; AND SAVE IT

	MOVE	A,-3(TP)
	MOVE	B,-2(TP)		; INPUT CHANNEL
	MOVEI	0,C.READ			; INDICATE INPUT
	PUSHJ	P,CHKCHN		; CHECK FOR GOOD CHANNEL
	MOVE	A,-1(TP)
	MOVE	B,(TP)			; GET OUT CHAN
	MOVEI	0,C.PRIN		; INDICATE OUT CHAN
	PUSHJ	P,CHKCHN		; CHECK FOR GOOD OUT CHAN

	PUSH	P,[0]			; COUNT OF CHARS OUTPUT

	MOVE	B,-2(TP)
	PUSHJ	P,GRB			; MAKE SURE WE HAVE READ BUFF
	MOVE	B,(TP)
	PUSHJ	P,GWB			; MAKE SURE WE HAVE WRITE BUFF

FCLOOP:	INTGO
	MOVE	B,-2(TP)
	PUSHJ	P,R1CHAR		; GET A CHAR
	JUMPL	A,FCDON			; IF A NEG NUMBER WE GOT EOF
	MOVE	B,(TP)			; GET OUT CHAN
	PUSHJ	P,W1CHAR		; SPIT IT OUT
	AOS	(P)			; INCREMENT COUNT
	JRST	FCLOOP

FCDON:	SUB	TP,[2,,2]		; POP OFF OUTCHAN
	MCALL	1,FCLOSE		; CLOSE INCHAN
	MOVE	A,$TFIX
	POP	P,B			; GET CHAR COUNT TO RETURN
	JRST FINIS

CHKCHN:	PUSH	P,0			; CHECK FOR GOOD TASTING CHANNEL
	PUSH	TP,A
	PUSH	TP,B
	GETYP	C,A
	CAIE	C,TCHAN
	JRST	CHKBDC			; GO COMPLAIN IN RIGHT WAY
;	MOVEI	B,DIRECT-1(B)
;	PUSHJ	P,CHRWRD
;	JRST	CHKBDC
;	MOVE	C,(P)			; GET CHAN DIRECT
	HRRZ	C,-2(B)			; MODE BITS
	TDNN	C,0
	JRST	CHKBDC
;	CAMN	B,CHKT(C)
;	JRST	.+4
;	ADDI	C,2			; TEST FOR READB OR PRINTB ALSO
;	CAME	B,CHKT(C)		; TEST FOR CORRECT DIRECT
;	JRST	CHKBDC
	MOVE	B,(TP)
	SKIPN	IOINS(B)		; MAKE SURE IT IS OPEN
	PUSHJ	P,OPENIT		; IF ZERO IOINS GO OPEN IT
	SUB	TP,[2,,2]
	POP	P,			; CLEAN UP STACKS
	POPJ	P,

CHKT:	ASCIZ /READ/
	ASCII /PRINT/
	ASCII /READB/
	<ASCII /PRINT/>+1

CHKBDC:	POP	P,E
	MOVNI	D,2
	IMULI	D,1(E)
	HLRE	0,AB
	CAMLE	0,D			; SEE IF THIS WAS HIS ARG OF DEFAULT
	JRST	BADCHN
	JUMPE	E,WTYP1
	JRST	WTYP2

; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB,
; THAT IS THEY READ INTO AND OUT OF STRINGS.  IN ADDITION BOTH ACCEPT
; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF
; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING.

; FORMAT IS <READSTRING .STRING .INCHANNEL .EOFCOND .MAXCHARS>
; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN

; FORMAT FOR PRINTSTRING IS <PRINTSTRING .STRING .OUTCHANNEL .MAXCHARS>

; THESE WERE CODED 9/16/73 BY NEAL D. RYAN

	MFUNCTION	RSTRNG,SUBR,READSTRING

	ENTRY
	PUSH	P,[0]		; FLAG TO INDICATE READING
	HLRE	0,AB
	CAMG	0,[-1]
	CAMG	0,[-9]
	JRST	WNA		; CHECK THAT IT HAS FROM 1 TO 4 ARGS
	JRST 	STRIO1

	MFUNCTION	PSTRNG,SUBR,PRINTSTRING

	ENTRY
	PUSH	P,[1]		; FLAG TO INDICATE WRITING
	HLRE	0,AB
	CAMG	0,[-1]
	CAMG	0,[-7]
	JRST	WNA		; CHECK THAT IT HAS FROM 1 TO 3 ARGS

STRIO1:	PUSH	TP,[0]		; SAVE SLOT ON STACK
	PUSH	TP,[0]
	GETYP	0,(AB)
	CAIE	0,TCHSTR		; MAKE SURE WE GOT STRING
	JRST	WTYP1
	HRRZ	0,(AB)		; CHECK FOR EMPTY STRING
	SKIPN	(P)
	JUMPE	0,MTSTRN
	HLRE	0,AB
	CAML	0,[-2]		; WAS A CHANNEL GIVEN
	JRST	STRIO2
	GETYP	0,2(AB)
	SKIPN	(P)		; SKIP IF PRINT
	JRST	TESTIN
	CAIN	0,TTP		; SEE IF FLATSIZE HACK
	JRST	STRIO9
TESTIN:	CAIE	0,TCHAN
	JRST	WTYP2		; SECOND ARG NOT CHANNEL
	MOVE	B,3(AB)
	HRRZ	B,-2(B)
	MOVNI	E,1		; CHECKING FOR GOOD DIRECTION
	TRNE	B,C.READ		; SKIP IF NOT READ
	MOVEI	E,0
	TRNE	B,C.PRIN		; SKIP IF NOT PRINT
	MOVEI	E,1
	CAME	E,(P)
	JRST	WRONGD		; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
STRIO9:	PUSH	TP,2(AB)
	PUSH	TP,3(AB)	; PUSH ON CHANNEL
	JRST	STRIO3
STRIO2:	MOVE	B,IMQUOTE INCHAN
	MOVSI	A,TCHAN
	SKIPE	(P)
	MOVE	B,IMQUOTE OUTCHAN
	PUSHJ	P,IDVAL
	GETYP	0,A
	SKIPN	(P)		; SKIP IF PRINTSTRING
	JRST	TESTI2
	CAIN	0,TTP		; SKIP IF NOT FLATSIZE HACK
	JRST	STRIO8
TESTI2:	CAIE	0,TCHAN
	JRST	BADCHN		; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
STRIO8:	PUSH	TP,A
	PUSH	TP,B
STRIO3:	MOVE	B,(TP)		; GET CHANNEL
	SKIPN	E,IOINS(B)
	PUSHJ	P,OPENIT		; IF NOT GO OPEN
	MOVE	E,IOINS(B)
	CAMN	E,[JRST CHNCLS]
	JRST	CHNCLS		; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED
STRIO4:	HLRE	0,AB
	CAML	0,[-4]
	JRST	STRIO5		; NO COUNT TO WORRY ABOUT
	GETYP	0,4(AB)
	MOVE	E,4(AB)
	MOVE	C,5(AB)
	CAIE	0,TCHSTR
	CAIN	0,TFIX		; BETTER BE A FIXED NUMBER
	JRST	.+2
	JRST	WTYP3
	HRRZ	D,(AB)		; GET ACTUAL STRING LENGTH
	CAIN	0,TFIX
	JRST	.+7
	SKIPE	(P)	; TEST FOR WRITING
	JRST 	.-7		; IF WRITING WE GOT TROUBLE
	PUSH	P,D		; ACTUAL STRING LENGTH
	MOVEM	E,(TB)	; STUFF HIS FUNNY DELIM STRING
	MOVEM	C,1(TB)
	JRST	STRIO7
	CAML	D,C		; MAKE SURE THE STRING IS LONG ENOUGH
	JRST	.+2		; WIN
	ERRUUO	EQUOTE COUNT-GREATER-THAN-STRING-SIZE
	PUSH	P,C	; PUSH ON MAX COUNT
	JRST	STRIO7
STRIO5:
STRIO6:	HRRZ	C,(AB)	; GET CHAR COUNT
	PUSH	P,C		; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN
STRIO7:	HLRE	0,AB
	CAML	0,[-6]
	JRST	.+6
	MOVE	B,(TP)		; GET THE CHANNEL
	MOVE	0,6(AB)
	MOVEM	0,EOFCND-1(B)	; STUFF IN SLOT IN CHAN
	MOVE	0,7(AB)
	MOVEM	0,EOFCND(B)
	PUSH	TP,(AB)		; PUSH ON STRING
	PUSH	TP,1(AB)
	PUSH	P,[0]		; PUSH ON CURRENT COUNT OF CHARS DONE
	MOVE	0,-2(P)		; GET READ OR WRITE FLAG
	JUMPN	0,OUTLOP	; GO WRITE STUFF

	MOVE	B,-2(TP)	; GET CHANNEL
	PUSHJ	P,GRB		; MAKE SURE WE HAVE BUFF
	SKIPGE	A,LSTCH(B)	; CHECK FOR EOF ALREADY READ PREVIOUSLY
	JRST	SRDOEF		; GO DOES HIS EOF HACKING
INLOP:	INTGO
	MOVE	B,-2(TP)	; GET CHANNEL
	MOVE	C,-1(P)		; MAX COUNT
	CAMG	C,(P)		; COMPARE WITH COUNT DONE
	JRST	STREOF		; WE HAVE FINISHED
	PUSHJ	P,R1CHAR	; GET A CHAR
	JUMPL	A,INEOF		; EOF HIT
	MOVE	C,1(TB)
	HRRZ	E,(TB)		; DO WE HAVE A STRING TO WORRY US?
	SOJL	E,INLNT		; GO FINISH STUFFING
	ILDB	D,C
	CAME	D,A
	JRST	.-3
	JRST	INEOF
INLNT:	IDPB	A,(TP)		; STUFF IN STRING
	SOS	-1(TP)		; DECREMENT STRING COUNT
	AOS	(P)		; INCREMENT CHAR COUNT
	JRST	INLOP

INEOF:	SKIPE	C,LSTCH(B)	; IS THIS AN ! AND IS THERE A CHAR THERE
	JRST 	.+3		; YES
	MOVEM	A,LSTCH(B)	; NO SAVE THE CHAR
	JRST 	.+3
	ADDI	C,400000
	MOVEM	C,LSTCH(B)
	MOVSI	C,200000
	IORM	C,LSTCH(B)
	HRRZ	C,DIRECT-1(B)	; GET THE TYPE OF CHAN
	CAIN	C,5		; IS IT READB?
	JRST	.+3
	SOS	ACCESS(B)	; FIX UP ACCESS FOR READ CHANNEL
	JRST	STREOF		; AND THATS IT
	HRRZ	C,ACCESS-1(B)	; FOR A READB ITS WORSE
	MOVEI	D,5
	SKIPG	C
	HRRM	D,ACCESS-1(B)	; CHANGE A 0 TO A FIVE
	SOS	C,ACCESS-1(B)
	CAMN	C,[TFIX,,0]
	SOS	ACCESS(B)	; AND SOS THE WORD COUNT MAYBE
	JRST	STREOF

SRDOEF:	SETZM	LSTCH(B)	; IN CASE OF -1, FLUSH IT
	AOJE	A,INLOP		; SKIP OVER -1 ON PTY'S
	SUB	TP,[6,,6]
	SUB	P,[3,,3]	; POP JUNK OFF STACKS
	PUSH	TP,EOFCND-1(B)
	PUSH	TP,EOFCND(B)	; WHAT WE NEED TO EVAL
	PUSH	TP,$TCHAN
	PUSH	TP,B
	MCALL	1,FCLOSE	; CLOSE THE LOOSING CHANNEL
	MCALL	1,EVAL		; EVAL HIS EOF JUNK
	JRST	FINIS

OUTLOP:	MOVE	B,-2(TP)
OUTLP1:	INTGO
	MOVE	A,-3(TP)		; GET CHANNEL
	MOVE	B,-2(TP)
	MOVE	C,-1(P)		; MAX COUNT TO DO
	CAMG	C,(P)		; HAVE WE DONE ENOUGH
	JRST	STREOF
	ILDB	D,(TP)		; GET THE CHAR
	SOS	-1(TP)		; SUBTRACT FROM STRING LENGTH
	AOS	(P)		; INC COUNT OF CHARS DONE
	PUSHJ	P,CPCH1		; GO STUFF CHAR
	JRST	OUTLP1

STREOF:	MOVE	A,$TFIX
	POP	P,B		; RETURN THE LOOSER A COUNT OF WHAT WAS DONE
	SUB	P,[2,,2]
	SUB	TP,[6,,6]
	JRST 	FINIS


GWB:	SKIPE	BUFSTR(B)
	POPJ	P,
	PUSH	TP,$TCHAN
	PUSH	TP,B		; GET US A WRITE BUFFER ON PRINTB CHAN
	MOVEI	A,BUFLNT
	PUSHJ	P,IBLOCK
	MOVSI	A,TWORD+.VECT.
	MOVEM	A,BUFLNT(B)
	SETOM	(B)
	MOVEI	C,1(B)
	HRLI	C,(B)
	BLT	C,BUFLNT-1(B)
	MOVEI	C,-1(B)
	HRLI	C,010700
	MOVE	B,(TP)
	MOVEI	0,C.BUF
	IORM	0,-2(B)
	MOVEM	C,BUFSTR(B)
	MOVE	C,[TCHSTR,,BUFLNT*5]
	MOVEM	C,BUFSTR-1(B)
	SUB	TP,[2,,2]
	POPJ	P,


GRB:	SKIPE	BUFSTR(B)
	POPJ	P,
	PUSH	TP,$TCHAN
	PUSH	TP,B		; GET US A READ BUFFER
	MOVEI	A,BUFLNT
	PUSHJ	P,IBLOCK
	MOVEI	C,BUFLNT-1(B)
	POP	TP,B
	MOVEI	0,C.BUF
	IORM	0,-2(B)
	HRLI	C,010700
	MOVEM	C,BUFSTR(B)
	MOVSI	C,TCHSTR
	MOVEM	C,BUFSTR-1(B)
	SUB	TP,[1,,1]
	POPJ	P,

MTSTRN:	ERRUUO	EQUOTE EMPTY-STRING

; INPUT UNBUFFERING ROUTINE.  THIS DOES THE CHARACTER UNBUFFERING
; FOR INPUT.  THE OPEN ROUTINE SETUPS A PUSHJ P, TO
; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE.

; H. BRODIE 7/19/72

; CALLING SEQ:
;	PUSHJ	P,GETCHR
;		B/ AOBJN PNTR TO CHANNEL VECTOR
;		RETURNS NEXT CHARACTER IN AC A.
;	ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND
;	TRANSMITS ONLY ^C ON SUCCESSIVE CALLS


GETCHR:
; FIRST GRAB THE BUFFER
;	GETYP	A,BUFSTR-1(B)	; GET TYPE WORD
;	CAIN	A,TCHSTR	; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER)
;	JRST	GTGBUF		; IS GOOD BUFFER...SKIP ERROR RETURN
GTGBUF:	HRRZ	A,BUFSTR-1(B)	; GET LENGTH OF STRING
	SOJGE	A,GTGCHR	; JUMP IF STILL MORE

; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS)
; GENERATE AN .IOT POINTER
;FIRST SAVE C AND D AS I WILL CLOBBER THEM
NEWBUF:	PUSH	P,C
	PUSH	P,D
IFN ITS,[
	LDB	C,[600,,STATUS(B)]	; GET TYPE
	CAIG	C,2		; SKIP IF NOT TTY
]
IFE ITS,[
	SKIPE	BUFRIN(B)
]
	JRST	GETTTY		; GET A TTY BUFFER

	PUSHJ	P,PGBUFI	; RE-FILL BUFFER

IFE ITS,	MOVEI	C,-1
	JUMPGE	A,BUFGOO	;SKIPS IF IOT COMPLETED...FIX UP CHANNEL
	MOVEI	C,1		; MAKE SURE LAST EOF REALLY ENDS IT
	ANDCAM	C,-1(A)
	MOVSI	C,014000	; GET A ^C
	MOVEM	C,(A)		;FAKE AN EOF

IFE ITS,[
	HLRE	C,A		; HOW MUCH LEFT
	ADDI	C,BUFLNT	; # OF WORDS TO C
	IMULI	C,5		; TO CHARS
	MOVE	A,-2(B)		; GET BITS
	TRNE	A,C.BIN		; CAN'T HELP A BINARY CHANNEL
	JRST	BUFGOO
	MOVE	A,CHANNO(B)
	PUSH	P,B
	PUSH	P,D
	PUSH	P,C
	PUSH	P,[0]
	PUSH	P,[0]
	MOVEI	C,-1(P)
	MOVE	B,[2,,11]	; READ WORD CONTAINING BYTE SIZE
	GTFDB
	LDB	D,[300600,,-1(P)]	; GET BYTE SIZE
	MOVE	B,(P)
	SUB	P,[2,,2]
	POP	P,C
	CAIE	D,7		; SEVEN BIT BYTES?
	JRST	BUFGO1		; NO, DONT HACK
	MOVE	D,C
	IDIVI	B,5		; C IS NUMBER IN LAST WORD IF NOT EVEN
	SKIPN	C
	MOVEI	C,5
	ADDI	C,-5(D)		; FIXUP C FOR WINNAGE
BUFGO1:	POP	P,D
	POP	P,B
]
; RESET THE BYTE POINTER IN THE CHANNEL.
; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
BUFGOO:	HRLI	D,010700	; GENERATE VIRGIN LH
	SUBI	D,1

	MOVEM	D,BUFSTR(B)	; STASH IN THE BUFFER BYTE PNTR SLOT
IFE ITS,	HRRM	C,LSTCH-1(B)	; SAVE IT
	MOVEI	A,BUFLNT*5-1
BUFROK:	POP	P,D		;RESTORE D
	POP	P,C		;RESTORE C


; HERE IF THERE ARE CHARS IN BUFFER
GTGCHR:	HRRM	A,BUFSTR-1(B)
	ILDB	A,BUFSTR(B)	; GET A CHAR FROM BUFFER

IFN ITS,[
	CAIE	A,3		; EOF?
	POPJ	P,		; AND RETURN
	LDB	A,[600,,STATUS(B)]	; CHECK FOR TTY
	CAILE	A,2		; SKIP IF TTY
]
IFE ITS,[
	PUSH	P,0
	HRRZ	0,LSTCH-1(B)
	SOJL	0,.+4
	HRRM	0,LSTCH-1(B)
	POP	P,0
	POPJ	P,

	POP	P,0
	MOVSI	A,-1
	SKIPN	BUFRIN(B)
]
	JRST	.+3
RETEO1:	HRRI	A,3
	POPJ	P,

	HRRZ	A,BUFSTR(B)	; SEE IF RSUBR START BIT IS ON
	HRRZ	A,(A)
	TRNN	A,1
	MOVSI	A,-1
	JRST	RETEO1

IFN ITS,[
PGBUFO:
PGBUFI:
]
IFE ITS,[
PGBUFO:	SKIPA	D,[SOUT]
PGBUFI:	MOVE	D,[SIN]
]
	SKIPGE	A,BUFSTR(B)	; POINT TO CURRENT BUFFER POSIT
	SUBI	A,1		; FOR 440700 AND 010700 START
	SUBI	A,BUFLNT-1	; CALCULATE PNTR TO BEG OF BUFFER
	HRLI	A,-BUFLNT	; IOT (AOBJN) PNTR IN A
	MOVSI	C,004400
IFN ITS,[
PGBIOO:
PGBIOI:	MOVE	D,A		; COPY FOR LATER
	MOVSI	C,TUVEC		; PREPARE TO HANDDLE INTS
	MOVE	PVP,PVSTOR+1
	MOVEM	C,DSTO(PVP)
	MOVEM	C,ASTO(PVP)
	MOVSI	C,TCHAN
	MOVEM	C,BSTO(PVP)

; BUILD .IOT INSTR
	MOVE	C,CHANNO(B)	; CHANNEL NUMBER IN C
	ROT	C,23.		; MOVE INTO AC FIELD
	IOR	C,[.IOT 0,A]	; IOR IN SKELETON .IOT

; DO THE .IOT
	ENABLE			; ALLOW INTS
	XCT	C		; EXECUTE THE .IOT INSTR
	DISABLE
	MOVE	PVP,PVSTOR+1
	SETZM	BSTO(PVP)
	SETZM	ASTO(PVP)
	SETZM	DSTO(PVP)
	POPJ	P,
]

IFE ITS,[
PGBIOT:	PUSH	P,D
	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	P,C
	HRRZS	(P)
	HRRI	C,-1(A)		; POINT TO BUFFER
	HLRE	D,A		; XTRA POINTER
	MOVNS	D
	HRLI	D,TCHSTR
	MOVE	PVP,PVSTOR+1
	MOVEM	D,BSTO(PVP)
	MOVE	D,[PUSHJ P,FIXACS]
	MOVEM	D,ONINT
	MOVSI	D,TUVEC
	MOVEM	D,DSTO(PVP)
	MOVE	D,A
	MOVE	A,CHANNO(B)	; FILE JFN
	MOVE	B,C
	HLRE	C,D		; - COUNT TO C
	SKIPE	(P)
	 MOVN	C,(P)		; REAL DESIRED COUNT
	SUB	P,[1,,1]
	ENABLE
	XCT	(P)		; DO IT TO IT
	DISABLE
	MOVE	PVP,PVSTOR+1
	SETZM	BSTO(PVP)
	SETZM	DSTO(PVP)
	SETZM	ONINT
	MOVEI	A,1(B)
	MOVE	B,(TP)
	SUB	TP,[2,,2]
	SUB	P,[1,,1]
	JUMPGE	C,CPOPJ		; NO EOF YET
	HRLI	A,(C)		; LOOK LIKE AN AOBJN PNTR
	POPJ	P,

FIXACS:	PUSH	P,PVP
	MOVE	PVP,PVSTOR+1
	MOVNS	C
	HRRM	C,BSTO(PVP)
	MOVNS	C
	POP	P,PVP
	POPJ	P,

PGBIOO:	SKIPA	D,[SOUT]
PGBIOI:	MOVE	D,[SIN]
	HRLI	C,004400
	JRST	PGBIOT
DOIOTO:	PUSH	P,[SOUT]
DOIOTC:	PUSH	P,B
	PUSH	P,C
	EXCH	A,B
	MOVE	A,CHANNO(A)
	HLRE	C,B
	HRLI	B,444400
	XCT	-2(P)
	HRL	B,C
	MOVE	A,B
DOIOTE:	POP	P,C
	POP	P,B
	SUB	P,[1,,1]
	POPJ	P,
DOIOTI:	PUSH	P,[SIN]
	JRST	DOIOTC
]

; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE

PUTCHR:	PUSH	P,A
	GETYP	A,BUFSTR-1(B)	; CHECK TYPE OF ARG
	CAIE	A,TCHSTR	; MUST BE STRING
	JRST	BDCHAN

	HRRZ	A,BUFSTR-1(B)	; GET CHAR COUNT
	JUMPE	A,REBUFF	; PREV RESET BUFF, UNDO SAME

PUTCH1:	POP	P,A		; RESTORE CHAR
	CAMN	A,[-1]		; SPECIAL HACK?
	JRST	PUTCH2		; YES GO HANDLE
	IDPB	A,BUFSTR(B)	; STUFF IT
PUTCH3:	SOS	A,BUFSTR-1(B)	; COUNT DOWN STRING
	TRNE	A,-1		; SKIP IF FULL
	POPJ	P,

; HERE TO FLUSH OUT A BUFFER

	PUSH	P,C
	PUSH	P,D
	PUSHJ	P,PGBUFO	; SETUP AND DO IOT
	HRLI	D,010700	; POINT INTO BUFFER
	SUBI	D,1
	MOVEM	D,BUFSTR(B)	; STORE IT
	MOVEI	A,BUFLNT*5	; RESET  COUNT
	HRRM	A,BUFSTR-1(B)
	POP	P,D
	POP	P,C
	POPJ	P,

;HERE TO DA ^C AND TURN ON MAGIC BIT

PUTCH2:	MOVEI	A,3
	IDPB	A,BUFSTR(B)	; ZAP OUT THE ^C
	MOVEI	A,1		; GET BIT
IFE ITS,[
	PUSH	P,C
	HRRZ	C,BUFSTR(B)
	IORM	A,(C)
	POP	P,C
]
IFN ITS,[
	IORM	A,@BUFSTR(B)	; ON GOES THE BIT
]
	JRST	PUTCH3

; RESET A FUNNY BUF

REBUFF:	MOVEI	A,BUFLNT*5		; 1ST COUNT
	HRRM	A,BUFSTR-1(B)
	HRRZ	A,BUFSTR(B)		; NOW POINTER
	SUBI	A,BUFLNT+1
	HRLI	A,010700
	MOVEM	A,BUFSTR(B)		; STORE BACK
	JRST	PUTCH1


; HERE TO FLUSH FINAL BUFFER

BFCLOS:	HRRZ	C,-2(B)		; THIS BUFFER FLUSHER THE WORK OF NDR
	MOVEI	A,0
	TRNE	C,C.TTY
	 POPJ	P,
	TRNE	C,C.DISK
	 MOVEI	A,1
	PUSH	P,A		; SAVE THE RESULT OF OUR TEST
	JUMPN	A,BFCLNN	; DONT HAVE TO CHECK NET STATE
	PUSH	TP,$TCHAN
	PUSH	TP,B		; SAVE CHANNEL
	PUSHJ	P,INSTAT	; GET CURRENT NETWORK STATE
	MOVE	A,(B)		; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE
	POP	TP,B		; RESTORE B
	POP	TP,
	CAIE	A,5		; IS NET IN OPEN STATE?
	CAIN	A,6		; OR ELSE IS IT IN RFNM WAIT STATE
	JRST	BFCLNN		; IF SO TO THE IOT
	POP	P,		; ELSE FLUSH CRUFT AND DONT IOT
	POPJ	P,		; RETURN DOING NO IOT
BFCLNN:	MOVEI	C,BUFLNT*5	; NEW BUFFER FLUSHER BY NDR
	HRRZ	D,BUFSTR-1(B)	; SO THAT NET ALSO WORKS RIGHT
	SUBI	C,(D)		; GET NUMBER OF CHARS
	IDIVI	C,5		; NUMBER OF FULL WORDS AND REST
	PUSH	P,D		; SAVE NUMBER OF ODD CHARS
	SKIPGE	A,BUFSTR(B)	; GET CURRENT BUF POSITION
	SUBI	A,1		; FIX FOR 440700 BYTE POINTER
IFE ITS,[
	HRRO	D,A
	PUSH	P,(D)
]
IFN ITS,[
	PUSH	P,(A)		; SAVE THE ODD WORD OF BUFFER
]
	MOVEI	D,BUFLNT
	SUBI	D,(C)
	SKIPE	-1(P)
	SUBI	A,1
	ADDI	D,1(A)		; FIX UP FOR POSSIBLE ODD CHARS
	PUSH	TP,$TUVEC
	PUSH	TP,D		; PUSH THE DOPE VECTOR ONTO THE STACK
	JUMPE	C,BFCLSR	; IN CASE THERE ARE NO FULL WORDS TO DO
	HRL	A,C
	TLO	A,400000
	MOVE	E,[SETZ BUFLNT(A)]
	SUBI	E,(C)	; FIX UP FOR BACKWARDS BLT
	POP	A,@E		; AMAZING GRACE
	TLNE	A,377777
	JRST	.-2
	HRRO	A,D		; SET UP AOBJN POINTER
	SUBI	A,(C)
	TLC	A,-1(C)
	PUSHJ	P,PGBIOO	; DO THE IOT OF ALL THE FULL WORDS
BFCLSR:	HRRO	A,(TP)		; GET IOT PTR FOR REST OF JUNK
	SUBI	A,1		; POINT TO WORD BEFORE DOPE WORDS
	POP	P,0		; GET BACK ODD WORD
	POP	P,C		; GET BACK ODD CHAR COUNT
	POP	P,D		; FLAG FOR NET OR DSK
	JUMPN	D,BFCDSK	; GO FINISH OFF DSK
	JUMPE	C,BFCLSD	; IF NO ODD CHARS FINISH UP
	MOVEI	D,7
	IMULI	D,(C)		; FIND NO OF BITS TO SHIFT
	LSH	0,-43(D)	; SHIFT BITS TO RIGHT PLACE
	MOVEM	0,(A)	; STORE IN STRING
	SUBI	C,5		; HOW MANY CHAR POSITIONS TO SKIP
	MOVNI	C,(C)		; MAKE C POSITIVE
	LSH	C,17
	TLC	A,(C)		; MUNG THE AOBJN POINTER TO KLUDGE
	PUSHJ	P,PGBIOO	; DO IOT OF ODD CHARS
	MOVEI	C,0
BFCLSD:	HRRZ	A,(TP)		; GET PTR TO DOPE WORD
	SUBI	A,BUFLNT+1
	JUMPLE	C,.+3
	SKIPE	ACCESS(B)
	MOVEM	0,1(A)		; LAST WORD BACK IN BFR
	HRLI	A,010700	; AOBJN POINTER TO FIRST OF BUFFER
	MOVEM	A,BUFSTR(B)
	MOVEI	A,BUFLNT*5
	HRRM	A,BUFSTR-1(B)
	SKIPN	ACCESS(B)
	 JRST	BFCLSY
	JUMPL	C,BFCLSY
	JUMPE	C,BFCLSZ
	IBP	BUFSTR(B)
	SOS	BUFSTR-1(B)
	SOJG	C,.-2
BFCLSY:	MOVE	A,CHANNO(B)
	MOVE	C,B
IFE ITS,[
	RFPTR
	FATAL RFPTR FAILED
	HRRZ	F,LSTCH-1(C)	; PREVIOUS HIGH
	MOVE	G,C		; SAVE CHANNEL
	MOVE	C,B
	CAML	F,B
	 MOVE	C,F
	MOVE	F,B
	HRLI	A,400000
	CLOSF
	JFCL
	MOVNI	B,1
	HRLI	A,12
	CHFDB
	MOVE	B,STATUS(G)
	ANDI	A,-1
	OPENF
	FATAL OPENF LOSES
	MOVE	C,F
	IDIVI	C,5
	MOVE	B,C
	SFPTR
	FATAL SFPTR FAILED
	MOVE	B,G
]
IFN ITS,[
	DOTCAL	RFPNTR,[A,[2000,,B]]
	 .LOSE	%LSFIL		;PRESUMABLY LOSSAGE MATTERS
	SUBI	B,1
	DOTCAL	ACCESS,[A,B]
	 .LOSE	%LSFIL		;PRESUMABLY LOSSAGE MATTERS
	MOVE	B,C
]
BFCLSZ:	SUB	TP,[2,,2]
	POPJ	P,

BFCDSK:	TRZ	0,1
	PUSH	P,C
IFE ITS,[
	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	P,0		; WORD OF CHARS
	MOVE	A,CHANNO(B)
	MOVEI	B,7		; MAKE BYTE SIZE 7
	SFBSZ
	JFCL
	HRROI	B,(P)
	MOVNS	C
	SKIPE	C
	SOUT
	MOVE	B,(TP)
	SUB	P,[1,,1]
	SUB	TP,[2,,2]
]
IFN ITS,[
	MOVE	D,[440700,,A]
	DOTCAL	SIOT,[CHANNO(B),D,C]
	 .LOSE	%LSFIL		;PRESUMABLY LOSSAGE MATTERS
]
	POP	P,C
	JUMPN	C,BFCLSD
BFCDS1:	MOVNI	C,1		; INDICATE NOT TOHACK BUFFER
       	JRST	BFCLSD

BFCLS1:	HRRZ	C,DIRECT-1(B)
	MOVSI	0,(JFCL)
	CAIE	C,6
	MOVE	0,[AOS ACCESS(B)]
	PUSH	P,0
	HRRZ	C,BUFSTR-1(B)
	IDIVI	C,5
	JUMPE	D,BCLS11
	MOVEI	A,40		; PAD WITH SPACES
	PUSHJ	P,PUTCHR
	XCT	(P)		; AOS ACCESS IF NECESSARY
	SOJG	D,.-3		; TO END OF WORD
BCLS11:	POP	P,0
	HLLZS	ACCESS-1(B)
	HRRZ	C,BUFSTR-1(B)
	CAIE	C,BUFLNT*5
	PUSHJ	P,BFCLOS
	POPJ	P,


; HERE TO GET A TTY BUFFER

GETTTY:	SKIPN	C,EXBUFR(B)	; SKIP IF BUFFERS BACKED UP
	JRST	TTYWAI
	HRRZ	D,(C)		; CDR THE LIST
	GETYP	A,(C)		; CHECK TYPE
	CAIE	A,TDEFER	; MUST BE DEFERRED
	JRST	BDCHAN
	MOVE	C,1(C)		; GET DEFERRED GOODIE
	GETYP	A,(C)		; BETTER BE CHSTR
	CAIE	A,TCHSTR
	JRST	BDCHAN
	MOVE	A,(C)		; GET FULL TYPE WORD
	MOVE	C,1(C)
	MOVEM	D,EXBUFR(B)	; STORE CDR'D LIST
	MOVEM	A,BUFSTR-1(B)	; MAKE CURRENT BUFFER
	MOVEM	C,BUFSTR(B)
	HRRM	A,LSTCH-1(B)
	SOJA	A,BUFROK

TTYWAI:	PUSHJ	P,TTYBLK	; BLOCKED FOR TTY I/O
	JRST	GETTTY		; SHOULD ONLY RETURN HAPPILY

;INTERNAL DEVICE READ ROUTINE.

;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,
;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER,
;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE"

;H. BRODIE 8/31/72

GTINTC:	PUSH	TP,$TCHAN	;SAVE THE CHANNEL...WE'LL CLOBBER B
	PUSH	TP,B
	PUSH	P,C	;AND SAVE THE OTHER ACS
	PUSH	P,D
	PUSH	P,E
	PUSH	P,0
	PUSH	TP,$TCHAN
	PUSH	TP,B
	MCALL	1,INTFCN-1(B)
	GETYP	A,A
	CAIE	A,TCHRS
	JRST	BADRET
	MOVE	A,B
INTRET:	POP	P,0		;RESTORE THE ACS
	POP	P,E
	POP	P,D
	POP	P,C
	POP	TP,B		;RESTORE THE CHANNEL
	SUB	TP,[1,,1]	;FLUSH $TCHAN...WE DON'T NEED IT
	POPJ	P,


BADRET:	ERRUUO	EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT

;INTERNAL DEVICE PRINT ROUTINE.

;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR)
;TO THE CURRENT CHARACTER BEING "PRINTED".

PTINTC:	PUSH	TP,$TCHAN	;SAVE THE CHANNEL...WE'LL CLOBBER B
	PUSH	TP,B
	PUSH	P,C	;AND SAVE THE OTHER ACS
	PUSH	P,D
	PUSH	P,E
	PUSH	P,0
	PUSH	TP,$TCHRS	;PUSH THE TYPE "CHARACTER"
	PUSH	TP,A		;PUSH THE CHAR
	PUSH	TP,$TCHAN	;PUSH THE CHANNEL
	PUSH	TP,B
	MCALL	2,INTFCN-1(B)	;APPLY THE FUNCTION TO THE CHAR
	JRST	INTRET



; ROUTINE TO FLUSH OUT A PRINT BUFFER

MFUNCTION BUFOUT,SUBR

	ENTRY	1

	GETYP	0,(AB)
	CAIE	0,TCHAN
	JRST	WTYP1

	MOVE	B,1(AB)
;	MOVEI	B,DIRECT-1(B)
;	PUSHJ	P,CHRWRD	; GET DIR NAME
;	JFCL
;	CAMN	B,[ASCII /PRINT/]
;	JRST	.+3
;	CAME	B,[<ASCII /PRINT/>+1]
;	JRST	WRONGD
;	TRNE	B,1		; SKIP IF PRINT
;	PUSH	P,[JFCL]
;	TRNN	B,1		; SKIP IF PRINTB
;	PUSH	P,[AOS ACCESS(B)]
	HRRZ	0,-2(B)
	TRNN	0,C.PRIN
	 JRST	WRONGD
;	TRNE	0,C.BIN		; SKIP IF PRINT
;	 PUSH	P,[JFCL]
;	TRNN	0,C.BIN		; SKIP IF PRINTB
;	 PUSH	P,[AOS ACCESS(B)]
;	MOVE	B,1(AB)
;	GETYP	0,BUFSTR-1(B)
;	CAIN	0,TCHSTR
;	SKIPN	A,BUFSTR(B)		; BYTE POINTER?
;	JRST	BFIN1
;	HRRZ	C,BUFSTR-1(B)	; CHARS LEFT
;	IDIVI	C,5		; MULTIPLE OF 5?
;	JUMPE	D,BFIN2		; YUP NO EXTRAS

;	MOVEI	A,40		; PAD WITH SPACES
;	PUSHJ	P,PUTCHR	; OUT IT GOES
;	XCT	(P)		; MAYBE BUMP ACCESS
;	SOJG	D,.-3		; FILL

BFIN2:	PUSHJ	P,BFCLOS	; WRITE OUT BUFFER

BFIN1:	MOVSI	A,TCHAN
	JRST	FINIS



; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL

MFUNCTION FILLNT,SUBR,[FILE-LENGTH]
	ENTRY	1

	GETYP	0,(AB)
	CAIE	0,TCHAN
	JRST	WTYP1
	MOVE	B,1(AB)
	PUSHJ	P,CFILLE
	JRST	FINIS

CFILLE:
IFN 0,[
	MOVEI	B,DIRECT-1(B)	; GET CHANNEL TYPE
	PUSHJ	P,CHRWRD
	JFCL
	CAME	B,[ASCIZ /READ/]
	JRST	.+3
	PUSH	P,[5]		; MULTIPLICATIVE FACTOR FOR READ
	JRST	.+4
	CAME	B,[ASCII /READB/]
	JRST	WRONGD
	PUSH	P,[1]		; MULTIPLICATIVE FACTOR FOR READ
]
	MOVE	C,-2(B)		; GET BITS
	MOVEI	D,5		; ASSUME ASCII
	TRNE	C,C.BIN		; SKIP IF NOT BINARY
	MOVEI	D,1
	PUSH	P,D
	MOVE	C,B
IFN ITS,[
	.CALL	FILL1
	JRST	FILLOS		; GIVE HIM A NICE FALSE
]
IFE ITS,[
	MOVE	A,CHANNO(C)
	PUSH	P,[0]
	MOVEI	C,(P)
	MOVE	B,[1,,11]	; READ WORD CONTAINING BYTE SIZE
	GTFDB
	LDB	D,[300600,,(P)]	; GET BYTE SIZE
	JUMPN	D,.+2
	 MOVEI	D,36.		; HANDLE "0" BYTE SIZE
	SUB	P,[1,,1]
	SIZEF
	JRST	FILLOS
]
	POP	P,C
IFN ITS,	IMUL	B,C
IFE ITS,[
	CAIN	C,5
	CAIE	D,7
	JRST	NOTASC
]
YESASC:	MOVE	A,$TFIX
	POPJ	P,

IFE ITS,[
NOTASC:	MOVEI	0,36.
	IDIV	0,D		; BYTES PER WORD
	IDIVM	B,0
	IMUL	C,0
	MOVE	B,C
	JRST	YESASC
]

IFN ITS,[
FILL1:	SETZ			; BLOCK FOR .CALL TO FILLEN
	SIXBIT /FILLEN/
	CHANNO	(C)
	SETZM	B

FILLOS:	MOVE	A,CHANNO(C)
	MOVE	B,[.STATUS A]		;MAKE A CALL TO STATUS TO FIND REASON
	LSH	A,23.			;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE
	IOR	B,A			;FIX UP .STATUS
	XCT	B
	MOVE	B,C
	PUSHJ	P,GFALS
	POP	P,
	POPJ	P,
]
IFE ITS,[
FILLOS:	MOVE	B,C
	PUSHJ	P,TGFALS
	POP	P,
	POPJ	P,
]


; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS

;CALLING ROUTINE:	AC-A contains pointer to block of SIXBIT data
;			DIR ? DEV ? FNM1 ? FNM2 ? SNM
;RETURNED VALUE :	AC-A = <channel #, or -1 if no channel available>
IFN ITS,[
MOPEN:	PUSH	P,B
	PUSH	P,C
	MOVE	C,FRSTCH	; skip gc and tty channels
CNLP:	DOTCAL	STATUS,[C,[2000,,B]]
	 .LOSE	%LSFIL
	ANDI	B,77
	JUMPE	B,CHNFND	; found unused channel ?
	ADDI	C,1		; try another channel
	CAIG	C,17		; are all the channels used ?
	 JRST	CNLP
	SETO	C,		; all channels used so C = -1
	JRST	CHNFUL
CHNFND:	MOVEI	B,(C)
	HLL	B,(A)		; M.DIR slot
	DOTCAL	OPEN,[B,1(A),2(A),3(A),4(A)]
	 SKIPA
	AOS	-2(P)		; successful  skip when returning
CHNFUL:	MOVE	A,C
	POP	P,C
	POP	P,B
	POPJ	P,

MIOT:	DOTCAL	IOT,[A,B]
	 JFCL
	POPJ	P,

MCLOSE:	DOTCAL	CLOSE,[A]
	 JFCL
	POPJ	P,

IMPURE

FRSTCH: 1

PURE
]
;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O

NOTNET:
BADCHN:	ERRUUO	EQUOTE BAD-CHANNEL
BDCHAN:	ERRUUO	EQUOTE BAD-INPUT-BUFFER

WRONGD:	ERRUUO	EQUOTE WRONG-DIRECTION-CHANNEL

CHNCLS:	ERRUUO	EQUOTE CHANNEL-CLOSED

BAD6:	ERRUUO	EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME

DISLOS:	MOVE	C,$TCHSTR
	MOVE	D,CHQUOTE [DISPLAY NOT AVAILABLE]
	PUSHJ	P,INCONS
	MOVSI	A,TFALSE
	JRST	OPNRET

NOCHAN:	ERRUUO	EQUOTE ITS-CHANNELS-EXHAUSTED

MODE1:	232020,,202020
MODE2:	232023,,330320

END