fopen.mcr352

TITLE OPEN - CHANNEL OPENER FOR MUDDLE

RELOCATABLE

;C. REEVE  MARCH 1973

.INSRT MUDDLE >

SYSQ

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

;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
.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS
.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO
.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,BYTDOP,TNXIN
.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO
.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS
.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL
.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


.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
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

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


; TABLE OF LEGAL MODES

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

; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS

IFN ITS,[

DEVS:	IRP A,,[DSK,TPL,SYS,COM,TTY,USR,STY,[ST ],NET,DIS,E&S,INT,PTP,PTR
[P  ],[DK ],[UT ],[T  ],NUL,[AI ]
[ML ],[DM ],[AR ],ARC]B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OUSR,OSTY,OSTY,ONET,ODIS,ODIS
OINT,OPTP,OPTP,ODSK,ODSK,OUTN,OTTY,ONUL,ODSK,ODSK,ODSK,ODSK,ODSK]
	B,,(SIXBIT /A/)
	TERMIN
]
IFE ITS,[
DEVS:	IRP A,,[DSK,TTY,INT,NET]B,,[ODSK,OTTY,OINT,ONET]
	B,,(SIXBIT /A/)
	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
	JRST	FINIS

; SUBR TO JUST CREATE A CHANNEL

MFUNCTION 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
	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)
	HLRZS	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)
]
	CAIE	D,(SIXBIT /INT/); INTERNAL?
	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
	PUSHJ	P,GIBLOK	; GET A BLOCK OF STUFF
	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
	MOVEM	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)
	POPJ	P,

; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN

CHNET:	CAIE	D,(SIXBIT /NET/)	; IS IT NET
IFN ITS,	JRST	MAKCH1
IFE ITS,[
	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

	CAME	B,[SIXBIT /PRINTO/]	; KLUDGE TO MAKE PRINTO AS PRINTB
	JRST	.+3
	MOVEI	A,3		; CODE FOR PRINTB
	POPJ	P,

	MOVSI	A,-NMODES	; SCAN TO SEE IF LEGAL MODE
	CAME	B,MODES(A)
	AOBJN	A,.-1
	JUMPGE	A,WRONGD	; ILLEGAL MODE NAME
	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:	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)
	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:	CAIG	0,40		; SPACE?
	JRST	NDFLD		; YES, TERMINATE THIS FIELD
	CAIN	0,":		; DEVICE ENDED?
	JRST	GOTDEV
	CAIN	0,";		; SNAME ENDED
	JRST	GOTSNM

GOTCNQ:	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
	PUSHJ	P,6TOCHS	; CONVERT TO STRING
	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
	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
	HLRZ	A,S.DEV(C)	; GET DEVICE
	CAIE	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
	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
	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:	S.NM1(D)
	S.NM2(D)
	S.DEV(D)
	S.SNM(D)
	S.X1(D)
]

RDTBL:	RDEVIC(B)
	RNAME1(B)
	RNAME2(B)
	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,[-7,,]	; 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]
CHKLST:	JUMPGE	AB,CPOPJ1
	SKIPGE	(P)		; IF FROM OPEN, ALLOW ONE MORE
	POPJ	P,
	PMOVEM	(AB),T.XT(TB)
	ADD	AB,[2,,2]
	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 ">"
	JUMPE	B,ILLNAM	; RAN OUT
	CAIE	A,">		; SKIP IF WINS
	JRST	ILLNAM
	PUSHJ	P,TN.CPS	; COPY TO NEW STRING
	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,440700
	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:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE ILLEGAL-TENEX-FILE-NAME
	JRST	CALER1

TN.MLT:	MOVEI	A,(AB)
	HRLI	A,-10

TN.ML1:	GETYP	0,(A)
	CAIE	0,TFIX
	CAIN	0,TCHSTR
	JRST	.+2
	JRST	RGPRSS		; ASSUME SINGLE STRING 
	ADD	A,[2,,2]
	JUMPL	A,TN.ML1

	MOVEI	A,T.NM1(TB)
	HRLI	A,(AB)
	BLT	A,T.SNM+1(TB)	; BLT 'EM IN
	ADD	AB,[10,,10]	; SKIP THESE GUYS
	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
	HRLM	A,S.DEV(C)
;	.TRANS	S.DEV(C)	; UNDO ANY TRANSLATIONS
;	JRST	TRLOST		; COMPLAIN

	HRRZ	A,S.DEV(C)	; GET SIXBIT DEVICE CODE
	MOVEI	E,(A)		; COPY TO E
	ANDI	E,777700	; WITHOUT LAST
	MOVEI	D,(E)		; AND D
	ANDI	D,770000	; WITH JUST LETTER
	MOVSI	B,-NDEVS	; AOBJN COUNTER

DEVLP:	HRRZ	0,DEVS(B)	; GET ONE
	CAIN	0,(A)		; FULL DEV?
	JRST	DISPA
	CAIN	0,(D)		; ONE LETTER
	JRST	CH2DIG
	CAIN	0,(E)		; 2 LTTERS
	JRST	CH1DIG
NXTDEV:	AOBJN	B,DEVLP		; LOOP THRU

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.DEV(C)
	IORI	A,10		; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT)
	HRLM	A,S.DEV(C)
	JRST	OUSR
]
IFE ITS,[
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE NO-SUCH-DEVICE?
	JRST	CALER1
]

; MAKE SURE DIGITS EXIST

CH2DIG:	LDB	0,[60600,,A]
	CAIG	0,'9		; CHECK DIGITNESS
	CAIGE	0,'0
	JRST	NXTDEV		; LOSER

CH1DIG:	LDB	0,[600,,A]	; LAST CHAR
	CAIG	0,'9
	CAIGE	0,'0
	JRST	NXTDEV

; HERE TO DISPATCH IF SUCCESSFUL

DISPA:	HLRZ	B,DEVS(B)
IFN ITS,[
	HRRZ	A,S.DIR(C)	; GET DIR OF OPEN
	CAIN	A,5		; IS IT DISPLAY
	CAIN	B,ODIS		; BETTER BE OPENING DISPLAY
	JRST	(B)		; GO TO HANDLER
	JRST	WRONGD
]
IFE ITS,	JRST	(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
	POP	P,C
	MOVE	D,T.SPDL+1(TB)
	HRRZ	D,S.DIR(D)
	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 NEW VERSION
	TLO	A,400000	; FORCE OLD
	HRROI	B,1(E)		; POIT TO STRING
	GTJFN
	TDZA	0,0		; SAVE FACT OF NO SKIP
	MOVEI	0,1		; INDICATE SKIPPED
	MOVE	P,E		; RESTORE PSTACK
	JUMPE	0,GTJLOS	; FIND OUT WHAT HAPPENED

	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL
	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
	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
	OPENF
	JRST	OPFLOS
	MOVEI	0,C.OPN+C.READ
	TRNE	D,1		; SKIP FOR READ
	MOVEI	0,C.OPN+C.PRIN
	MOVE	B,T.CHAN+1(TB)
	HRRM	0,-4(B)		; MUNG THOSE BITS
	ASH	A,1		; POINT TO SLOT
	ADDI	A,CHNL0(TVP)	; 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:	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
	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
	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
	MOVEI	A,":
	IDPB	A,D
	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
	MOVEI	A,RNAME1-1(B)
	PUSHJ	P,MOVSTR
	MOVEI	A,".
	IDPB	A,D
ST.NM1:	MOVEI	A,RNAME2-1(B)
	PUSHJ	P,MOVSTR
	SUB	TP,[2,,2]
	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	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:	SUB	P,[1,,1]	; FLUSH ERROR CODE SLOT
	MOVE	C,A
	MOVE	D,B
	PUSHJ	P,INCONS	; BUILD LIST
	MOVSI	A,TFALSE	; MAKE IT FALSE
	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	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(B)	; REST BYTE POINTER
OPASCA:	HRLI	D,440700
	MOVE	B,T.CHAN+1(TB)	; GET CHANNEL BACK
	MOVEI	0,C.BUF
	IORM	0,-4(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,(B)		; START MAKING STRING POINTER
	HRRI	A,BUFLNT*5	; SET UP CHAR COUNT
	JRST	OPASCA


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

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

; OPEN THE DISPLAY DEVICE

ODIS:	MOVEI	B,T.DIR(TB)	; GET CHANNEL
	PUSHJ	P,CHRWRD	; TO ASCII
	JFCL
	MOVE	E,B		; DIR TO E
	MOVE	B,T.CHAN+1(TB)	; CHANNEL
	MOVE	0,[PUSHJ P,DCHAR]	; IOINS
	CAIN	A,1
	MOVEM	0,IOINS(B)
	PUSHJ	P,DISOPN
	JRST	DISLOS		; LOSER

	MOVE	D,T.CHAN+1(TB)	; GET CHANNEL
	MOVEI	0,C.OPN+C.PRIN
	HRRM	0,-4(D)
	MOVEM	A,DISINF-1(D)	; AND STORE
	MOVEM	B,DISINF(D)
	SETZM	CHANNO(D)	; NO REAL CHANNEL
	MOVEI	0,DISLNL
	MOVEM	0,LINLN(D)
	MOVEI	0,DISPGL
	MOVEM	0,PAGLN(D)
	MOVEI	0,10.		; SET RADIX
	MOVEM	0,RADX(D)
	JRST	SAVCHN		; ADD TO CHANNEL LIST


; 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,-4(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(TVP)	; POINT TO CURRENT LIST
	MOVSI	C,TCHAN
	PUSHJ	P,ICONS		; CONS IT ON
	HRRZM	B,CHNL0+1(TVP)
	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:	PUSH	TP,$TATOM	; CALL ERROR
	PUSH	TP,EQUOTE BYTE-SIZE-BAD
	JRST	CALER1

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.DEV(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)
	MOVEM	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

	MOVEI	D,S.DEV(C)		; SETUP FOR .RCHST
	HRL	D,CHANNO(B)
	.RCHST	D,		; GET THE GOODS

	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)
	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(TVP)	; TO REAL SLOT
	MOVEM	B,1(A)		; SAVE CHANNEL
	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
	MOVEM	0,BUFRIN-1(B)
	MOVE	A,CHANNO(B)	; GET JFN
	GDSTS			; GET STATE
	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	A,CHANNO(E)
	GDSTS
	LSH	B,-32.
	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(TVP)
	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.DEV(C)	; STORE IN OPEN BLOCK
	PUSHJ	P,OPEN2		; OPEN THE TTY
	HRLZ	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]]
	FATAL .CALL FAILURE
	DOTCAL	TTYSET,[CHANNO(B),MODE1,MODE2,D]
	FATAL .CALL FAILURE
	MOVE	A,[PUSHJ P,GMTYO]
	MOVEM	A,IOINS(B)
	DOTCAL	RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]]
	FATAL .CALL FAILURE
	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]
	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,MTYO]
	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
	HRRM	E,-4(B)
	MOVEM	B,CHNL0+2*100+1(TVP)
	JRST	TNXTY2
TNXTY1:	MOVEM	B,CHNL0+2*101+1(TVP)
	MOVEI	A,101		; PRIM OUTPUT JFN
	MOVEI	E,C.OPN+C.PRIN
	HRRM	E,-4(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
	MOVEM	A,BUFRIN-1(D)
IFN ITS,	MOVEI	A,177		;SET ERASER TO RUBOUT
IFE ITS,	MOVEI	A,1		; TRY ^A FOR TENEX
	MOVEM	A,ERASCH(B)
	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,-4(D)
	HRLI	B,440700
	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

OPEN2:	MOVEI	A,S.DEV(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 /PRINTO/]
	JRST	OPEN9		; WELL NOT THIS TIME
	IORI	A,100000	; WRITEOVER BIT

	HRRZ	0,FSAV(TB)
	CAIN	0,NFOPEN
	IOR	A,4		; DON'T CHANGE REF DATE
OPEN9:	HRLM	A,S.DEV(C)	; AND STORE IT

; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL

OPEN1:	MOVEI	A,S.DEV(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
	MOVSI	A,(A)		; SET UP READ CHAN STATUS
	HRRI	A,S.DEV(C)
	.RCHST	A,		; GET THE GOODS

; 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,-4(B)
	MOVE	A,CHANNO(B)	; GET CHANNEL #
	ASH	A,1
	ADDI	A,CHNL0(TVP)	; POINT TO SLOT
	MOVEM	B,1(A)		; NOT: TYPE ALREADY SETUP

; NOW GET STATUS WORD

DOSTAT:	HRLZ	A,CHANNO(B)	; NOW GET STATUS WORD
	ROT	A,5
	IOR	A,[.STATUS STATUS(B)]	; GET INS
	XCT	A		; AND DO IT
	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
	PUSHJ	P,GFALS		; GET A FALSE WITH A MESSAGE
	SUB	P,[1,,1]	; EXTRA RET ADDR FLUSHED
	JRST	OPNRET		; AND RETURN

; ROUTINE TO CONS UP FALSE WITH REASON

GFALS:	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
	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:	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
	MOVE	C,A
	MOVE	D,B		; COPY STRING
	PUSHJ	P,INCONS	; CONS TO NIL
	MOVSI	A,TFALSE	; MAKEIT A FALSE
	POPJ	P,


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

FIXREA:	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,

DOOPN:	PUSH	P,A
	HRLZ	A,CHANNO(B)	; GET CHANNEL
	ASH	A,5
	HRR	A,(P)		; POINT
	TLO	A,(.OPEN)
	XCT	A
	SKIPA
	AOS	-1(P)
	POP	P,A
	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
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
	JUMPE	0,SIXDON	;IF NULL, WE ARE FINISHED
	PUSHJ	P,A0TO6		; CONVERT TO SIXBIT
	IDPB	0,D		;DEPOSIT INTO SIX BIT
	TRNN	A,77		;IS OUTPUT FULL
	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 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,,0]
	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,B		; PUSH BYTE POINTER
	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:	MOVEI	A,0		; SETUP FDELE
	EXCH	A,(P)		; AND GET SNAME
	.SUSET	[.SSNAM,,A]
	HLRZS	-3(P)		; FIXUP DEVICE
	.FDELE	-3(P)		; DO IT TO IT
	JRST	FDLST		; ANALYSE ERROR

FDLWON:	MOVSI	A,TATOM
	MOVE	B,MQUOTE T
	JRST	FINIS
]
IFE ITS,[
	MOVE	A,(TP)		; GET BASE OF PDL
	MOVEI	A,1(A)		; POINT TO CRAP
	MOVE	B,1(AB)		; STRING POINTER
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,[0]
	GTJFN			; GET A JFN
	JRST	TDLLOS		; LOST
	ADD	AB,[2,,2]	; PAST ARG
	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,MQUOTE 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:	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:	IMQUOTE DEV
	IMQUOTE SNM
	IMQUOTE NM1
	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,MQUOTE TO
	JRST	WRONGT		; NO, LOSE
	ADD	AB,[2,,2]	; BUMP PAST "TO"
	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

	HLRZS	A,-7(P)		; FIX AND GET DEV1
	HLRZS	B,-3(P)		; SAME FOR DEV2
	CAIE	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)
	.FDELE	-4(P)		; TRY THE RENAME
	JRST	FDLST
	JRST	FDLWON

; HERE FOR RENAME WHILE OPEN FOR WRITING

CHNRNM:	ADD	AB,[2,,2]	; NEXT ARG
	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
	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 #
	MOVEM	A,-2(P)
	.FDELE	-4(P)
	JRST	FDLST
	MOVEI	A,-4(P)		; SET UP FOR RDCHST
	HRL	A,CHANNO(B)
	.RCHST	A,
	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,(TP)		; PBASE BACK
	PUSH	A,[400000,,0]
	MOVEI	A,(A)
	MOVE	B,1(AB)
	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
]
; HERE FOR LOSING .FDELE

FDLST:	.STATUS	0,A		; GET STATUS
	PUSHJ	P,GFALS		; ANALYZE IT
	JRST	FINIS

; SOME .FDELE ERRORS

DEVDIF:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE DEVICE-OR-SNAME-DIFFERS
	JRST	CALER1

; 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(TVP)
	CAMN	B,TTOCHN+1(TVP)
	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
	HLRZS	-3(P)		; FIX DEVICE SPEC
]
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:	MOVE	B,1(AB)
	CAME	B,TTOCHN+1(TVP)
	CAMN	B,TTICHN+1(TVP)
	PUSHJ	P,TTYOP2
	PUSHJ	P,DOSTAT
	DOTCAL	RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]]
	FATAL .CALL FAILURE
	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
	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(TVP)	;POINT TO FIRST REAL CHANNEL

CHNLP:	SKIPN	1(B)		;OPEN?
	JRST	NXTCHN		;NO, SKIP
	HRRZ	E,(B)		; ABOUT TO FLUSH?
	JUMPN	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(TVP)+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,	HLRZS	E,-3(P)		; GET DEVICE IN PROPER PLACE
IFE ITS,	HLRZS	E,(P)
	MOVE	B,(TP)		; RESTORE CHANNEL
	CAIN	E,(SIXBIT /DSK/)
	JRST	DISKH		; DISK WINS IMMEIDATELY
	CAIN	E,(SIXBIT /TTY/)	; NO NEED TO RE-OPEN THE TTY
	JRST	REOPD1
IFN ITS,[
	ANDI	E,777700	; COULD BE "UTn"
	MOVE	D,CHANNO(B)	; GET CHANNEL
	ASH	D,1
	ADDI	D,CHNL0(TVP)	; DON'T SEEM TO BE OPEN
	SETZM	1(D)
	SETZM	CHANNO(B)
	CAIN	E,(SIXBIT /UT /)
	JRST	REOPD		; CURRENTLY, CANT RESTORE UTAPE CHANNLES
	CAIN	E,(SIXBIT /AI /)
	JRST	REOPD		; CURRENTLY CANT RESTORE AI CHANNELS
	CAIN	E,(SIXBIT /ML /)
	JRST	REOPD		; CURRENTLY CANT RESTORE ML CHANNELS
	CAIN	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
	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
	POP	P,C
	POP	P,A
DISKH2:	SUBI	C,(D)		; UPDATE CHAR ACCESS
	IDIVI	C,5		; BACK TO WORD ACCESS
	IORI	A,6		; BLOCK IMAGE
IFN ITS,[
	TRNE	A,1
	IORI	A,100000	; WRITE OVER BIT
	HRLM	A,-3(P)
	MOVEI	A,-3(P)
	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
	HRLZ	A,CHANNO(B)
	ASH	A,5
	IOR	A,[.ACCESS (P)]
	XCT	A
	POP	P,A
	POPJ	P,

DOIOTO:
DOIOTI:
DOIOT:
	PUSH	P,0
	MOVSI	0,TCHAN
	MOVEM	0,BSTO(PVP)	; IN CASE OF INTERRUPT
	ENABLE
	HRLZ	0,CHANNO(B)
	ASH	0,5
	IOR	0,[.IOT A]
	XCT	0
	DISABLE
	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,[

	HRROI	B,1(E)		; TENEX STRING POINTER
	MOVEI	A,1(P)		; A POINT TO BLOCK OF INFO
	PUSH	P,[100400,,0]	; FORCE JFN REUSE AND ONLY ACCEPT EXISTING FILE
	PUSH	P,[377777,,377777]	; NO I/O FOR CORRECTIONS ETC.
	REPEAT	6,PUSH P,[0]		; OTHER SLOTS
	MOVE	D,-2(TP)	; CHANNEL BACK
	PUSH	P,CHANNO(D)	; AND DESIRED JFN
	GTJFN			; GO GET IT
	JRST	RGTJL		; COMPLAIN
	MOVE	P,(TP)		; RESTORE P
	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,-2(TP)	; CHANNEL
	MOVE	A,CHANNO(A)	; 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
	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(TVP)	; CHECK FOR TTY
	CAMN	B,TTOCHN+1(TVP)
	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
	HLRZS	A,(P)
	MOVE	B,1(AB)		; RESTORE CHANNEL
	CAIE	A,(SIXBIT /E&S/)
	CAIN	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
	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(TVP)	;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	-4(B)
	MOVSI	A,TCHAN		;RETURN THE CHANNEL
	JRST	FINIS

CLSTTY:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL
	JRST	CALER1


REMOV:	MOVEI	D,CHNL0(TVP)+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
	GETYP	0,BUFSTR-1(B)	; IS THERE AN OUTPUT BUFFER
	SKIPN	BUFSTR(B)
	JRST	CFIN1
	CAIE	0,TCHSTR
	JRST	CFINX1
IFE ITS,	PUSH	P,A		; SAVE MODE
	PUSHJ	P,BFCLOS
IFE ITS,[
	POP	P,A		; RESTORE MODE
	MOVE	0,RDEVIC(B)
	ILDB	0,0
	CAIN	0,"D
	CAME	A,[SIXBIT /PRINT/]
	JRST	CFINX1
	MOVE	A,CHANNO(B)	; GET JFN
	TLO	A,400000	; BIT MEANS DONT RELEASE JFN
	CLOSF			; CLOSE THE FILE
	FATAL	CLOSF LOST?
	MOVE	E,B		; SAVE CHANNEL
	MOVE	A,CHANNO(B)
	HRLI	A,11
	MOVSI	B,7700		; MASK
	MOVSI	C,700		; MAKE NEW SIZE 7
	CHFDB
	HRLI	A,12
	SETOM	B
	MOVE	C,ACCESS(E)	; LENGTH IN CHARS
	CHFDB
]
	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]
	JRST	MACCA
	PUSH	P,[2]		;ACCESS ON PRINTB CHANNEL
	MOVE	B,1(AB)
	SKIPE	BUFSTR(B)	;SEE IF WE MUST FLUSH PART BUFFER
	PUSHJ	P,BFCLS1
	JRST	MACC
MACCA:	PUSH	P,[0]		; READ RATHER THAN READB INDICATOR
	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
	SKIPN	CHANNO(B)	;CLOSED CHANNELS HAVE CHANNO ZEROED OUT
	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...ALL NEGS = -5
	MOVNI	C,-5
;BUT .ACCESS -1 ISN'T IMPLEMENTED ON ITS YET, SO TELL HIM
	JUMPGE	C,MACC1
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE NEGATIVE-ACCESS-NOT-ON-ITS
	JRST	CALER1
MACC1:	SKIPN	(P)
	IDIVI	C,5

;SETUP THE .ACCESS
	MOVE	B,1(AB)		;GET BACK PTR TO CHANNEL
	MOVE	A,CHANNO(B)	;A GETS REAL CHANNEL NUMBER
IFN ITS,[
	ROT	A,23.		;SET UP IN AC FIELD
	IOR	A,[.ACCESS 0,C]	;C CONTAINS PLACE TO ACCESS TO

;DO IT TO IT!
	XCT	A
]
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
	CAIN	E,2
	JRST	DONADV		; PRINTB CHANNEL
	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
	MOVEM	A,BUFSTR(B)
	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
	MOVEM	C,ACCESS(B)
	MOVE	A,$TCHAN	;TYPE OF RESULT = "CHANNEL"
	JRST	FINIS		;DONE...B CONTAINS CHANNEL

IFE ITS,[
ACCFAI:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE ACCESS-FAILURE
	JRST	CALER1
]


;WRONG TYPE OF DEVICE ERROR
WRDEV:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE NON-DSK-DEVICE
	JRST	CALER1

; BINARY READ AND PRINT ROUTINES

MFUNCTION PRINTB,SUBR

	ENTRY	2

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

MFUNCTION READB,SUBR

	ENTRY

	PUSH	P,[0]
	HLRZ	0,AB
	CAIG	0,-3
	CAIG	0,-7
	JRST	WNA

BINI1:	GETYP	0,(AB)		; SHOULD BE UVEC OR STORE
	CAIN	0,TUVEC
	JRST	BINI2
	CAIE	0,TSTORAGE
	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
	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]
	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
	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)
BINI5:	SKIPE	LSTCH(B)	; INDICATES IF EOF HIT
	JRST	BINEOF
	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

BUFOU1:	SKIPE	BUFSTR(B)	; ANY BUFFERS AROUND?
	PUSHJ	P,BFCLS1	; GET RID OF SAME
	MOVE	A,1(AB)
	PUSHJ	P,PGBIOO
	HLRE	C,1(AB)
	MOVNS	C
	addm	c,ACCESS(B)
	MOVE	A,(AB)		; RET VECTOR ETC.
	MOVE	B,1(AB)
	JRST	FINIS


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
	MOVEM	A,LSTCH(B)
	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,DIRECT-1(B)
	CAIE	C,6			; 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)
	PUSHJ	P,WXCT
	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
	POP	TP,B
	POP	TP,(TP)
	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)
	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:	PUSH	P,A			; SAVE THE CHAR TO WRITE
	PUSH	TP,$TCHAN		; AND SAVE THE CHANNEL TOO
	PUSH	TP,B
	XCT	IOINS(B)		; DO THE REAL ONE
	JRST	DOSCPT			; AND CHECK OUT SCRIPTAGE

RXCT:	PUSH	TP,$TCHAN
	PUSH	TP,B			; DO IT FOR READS, SAVE THE CHAN
	XCT	IOINS(B)		; READ IT
	PUSH	P,A			; AND SAVE THE CHAR AROUND
	JRST	DOSCPT			; AND CHECK OUT SCRIPTAGE

DOSCPT:	MOVE	B,(TP)			;CHECK FOR SCRIPTAGE
	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,0				; INDICATE INPUT
	PUSHJ	P,CHKCHN		; CHECK FOR GOOD CHANNEL
	MOVE	A,-1(TP)
	MOVE	B,(TP)			; GET OUT CHAN
	MOVEI	0,1			; 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:	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
	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)
	CAIE	0,TCHAN
	JRST	WTYP2		; SECOND ARG NOT CHANNEL
	MOVE	B,3(AB)
	MOVEI	B,DIRECT-1(B)
	PUSHJ	P,CHRWRD
	JFCL
	MOVNI	E,1		; CHECKING FOR GOOD DIRECTION
	CAMN	B,[ASCII /READ/]
	MOVEI	E,0
	CAMN	B,[ASCII /PRINT/]
	MOVEI	E,1
	CAMN	B,[<ASCII /PRINT/>+1]
	MOVEI	E,1
	CAMN	B,[ASCII /READB/]
	MOVEI	E,0
	CAME	E,(P)
	JRST	WRONGD		; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE
	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
	TLZ	A,TYPMSK#777777
	CAME	A,$TCHAN
	JRST	BADCHN		; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL
	PUSH	TP,A
	PUSH	TP,B
STRIO3:	MOVE	B,(TP)		; GET CHANNEL
	SKIPN	E,IOINS(B)		; MAKE SURE HE IS OPEN
	PUSHJ	P,OPENIT		; IF NOT GO OPEN
	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	.+4		; WIN
	PUSH	TP,$TATOM	; LOSAGE, COUNT TOO GREAT
	PUSH	TP,EQUOTE COUNT-GREATER-THAN-STRING-SIZE
	JRST	CALER1
	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)
	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)
	PUSHJ	P,GWB		; MAKE SURE WE HAVE BUFF
OUTLP1:	INTGO
	MOVE	B,-2(TP)
	MOVE	C,-1(P)		; MAX COUNT TO DO
	CAMG	C,(P)		; HAVE WE DONE ENOUGH
	JRST	STREOF
	ILDB	A,(TP)		; GET THE CHAR
	SOS	-1(TP)	; SUBTRACT FROM STRING LENGTH
	AOS	(P)		; INC COUNT OF CHARS DONE
	PUSHJ	P,W1CHAR	; 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)
	MOVE	C,B
	HRLI	C,440700
	MOVE	B,(TP)
	MOVEI	0,C.BUF
	IORM	0,-4(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(B)
	POP	TP,B
	MOVEI	0,C.BUF
	IORM	0,-4(B)
	HRLI	C,440700
	MOVEM	C,BUFSTR(B)
	MOVSI	C,TCHSTR
	MOVEM	C,BUFSTR-1(B)
	SUB	TP,[1,,1]
	POPJ	P,

MTSTRN:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE EMPTY-STRING
	JRST	CALER1

; 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
BDCHAN:	PUSH	TP,$TATOM	; ERROR RETURN
	PUSH	TP,EQUOTE BAD-INPUT-BUFFER
	JRST	CALER1

; BUFFER WAS GOOD
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

	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

; RESET THE BYTE POINTER IN THE CHANNEL.
; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D
BUFGOO:	HRLI	D,440700	; GENERATE VIRGIN LH

	MOVEM	D,BUFSTR(B)	; STASH IN THE BUFFER BYTE PNTR SLOT
	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
IFE ITS,[
	CAIN	A,32	; TENEX EOF?
	JRST	.+3
]
	CAIE	A,3		; EOF?
	POPJ	P,		; AND RETURN
IFN ITS,[
	LDB	A,[600,,STATUS(B)]	; CHECK FOR TTY
	CAILE	A,2		; SKIP IF TTY
]
IFE ITS,	SKIPN	BUFRIN(B)

	JRST	.+3
RETEO1:	HRRI	A,3
	POPJ	P,

	HRRZ	A,@BUFSTR(B)	; SEE IF RSUBR START BIT IS ON
	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
IFN ITS,[
PGBIOO:
PGBIOI:	MOVE	D,A		; COPY FOR LATER
	MOVSI	C,TUVEC		; PREPARE TO HANDDLE INTS
	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
	SETZM	BSTO(PVP)
	SETZM	ASTO(PVP)
	SETZM	DSTO(PVP)
	POPJ	P,
]

IFE ITS,[
PGBIOT:	PUSH	P,D
	PUSH	TP,$TCHAN
	PUSH	TP,B
	MOVEI	C,(A)		; POINT TO BUFFER
	HRLI	C,444400
	MOVE	D,A		; XTRA POINTER
	MOVE	A,CHANNO(B)	; FILE JFN
	MOVE	B,C
	HLRE	C,D		; - COUNT TO C
	XCT	(P)		; DO IT TO IT
	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,

PGBIOO:	SKIPA	D,[SOUT]
PGBIOI:	MOVE	D,[SIN]
	JRST	PGBIOT
DOIOTO:	PUSH	P,D
	PUSH	P,C
	PUSHJ	P,PGBIOO
DOIOTE:	POP	P,C
	POP	P,D
	POPJ	P,
DOIOTI:	PUSH	P,D
	PUSH	P,C
	PUSHJ	P,PGBIOI
	JRST	DOIOTE
]

; 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,440700	; POINT INTO BUFFER
	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
	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
	HRLI	A,440700
	MOVEM	A,BUFSTR(B)		; STORE BACK
	JRST	PUTCH1


; HERE TO FLUSH FINAL BUFFER

BFCLOS: HLLZS	ACCESS-1(B)	; CLEAR OUT KLUDGE PRINTB PART ACCESS COUNT
	MOVE	C,B		; THIS BUFFER FLUSHER THE WORK OF NDR
	MOVEI	B,RDEVIC-1(B)	; FIND OUT IF THIS IS NET
	PUSHJ	P,CHRWRD
	JFCL
	TRZ	B,77777		; LEAVE ONLY HIGH 3 CHARS
	MOVEI	A,0		; FLAG 0=NET 1=DSK
	CAME	B,[ASCIZ /NET/]	; IS THIS NET?
	AOS	A
	PUSH	P,A		; SAVE THE RESULT OF OUR TEST
	MOVE	B,C		; RESTORE CHANNEL IN B
	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
	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
	MOVE	E,[A,,BUFLNT]
	SUBI	E,(C)	; FIX UP FOR BACKWARDS BLT
	POP	A,@E		; AMAZING GRACE
	TLNE	A,-1
	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
	JUMPE	C,BFCLSD	; IF NO ODD CHARS FINISH UP
	JUMPN	D,BFCDSK	; GO FINISH OFF DSK
	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
BFCLSD:	HRRZ	A,(TP)	; GET PTR TO DOPE WORD
	SUBI	A,BUFLNT
	HRLI	A,440700	; AOBJN POINTER TO FIRST OF BUFFER
	MOVEM	A,BUFSTR(B)
	MOVEI	A,BUFLNT*5
	HRRM	A,BUFSTR-1(B)
	SUB	TP,[2,,2]
	POPJ	P,

BFCDSK: MOVE	C,A		; FOR FUNNY AOBJN PTR
	HLL	C,BUFSTR(B)	; POINT INTO WORD AFTER LAST CHAR
	TRZ	0,1
	MOVEM	0,(A)
IFN ITS,	MOVEI	0,3		; CONTROL C
IFE ITS,	MOVEI	0,32		; CNTL Z
	IDPB	0,C
	PUSHJ	P,PGBIOO
	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)
	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,INTFCN-1(B)
	PUSH	TP,INTFCN(B)
	MCALL	1,APPLY
	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:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT
	JRST	CALER1

;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,INTFCN-1(B)	;PUSH TYPE OF GIVEN OBJ
	PUSH	TP,INTFCN(B)	;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.)
	PUSH	TP,$TCHRS	;PUSH THE TYPE "CHARACTER"
	PUSH	TP,A		;PUSH THE CHAR
	MCALL	2,APPLY		;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)]
	MOVE	B,1(AB)
	GETYP	0,BUFSTR-1(B)
	CAIN	0,TCHSTR
	SKIPN	C,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)
	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,1(AB)
IFN ITS,[
	.CALL	FILL1
	JRST	FILLOS		; GIVE HIM A NICE FALSE
]
IFE ITS,[
	MOVE	A,CHANNO(C)
	SIZEF
	JRST	FILLOS
]
	POP	P,C
	IMUL	B,C
	MOVE	A,$TFIX
	JRST	FINIS

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

FILLOS:	MOVE	A,CHANNO(C)
	PUSHJ	P,GFALS
	JRST	FINIS
]
IFE ITS,[
FILLOS:	PUSHJ	P,TGFALS
	JRST	FINIS
]


;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O

NOTNET:
BADCHN:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE BAD-CHANNEL
	JRST	CALER1

WRONGD:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE WRONG-DIRECTION-CHANNEL
	JRST	CALER1

CHNCLS: PUSH	TP,$TATOM
	PUSH	TP,EQUOTE CHANNEL-CLOSED
	JRST	CALER1

BAD6:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME
	JRST	CALER1

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

NOCHAN:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE ITS-CHANNELS-EXHAUSTED
	JRST	CALER1

MODE1:	232020,,202020
MODE2:	232023,,332320

END