TITLE OPEN - CHANNEL OPENER FOR MUDDLE

RELOCATABLE

;C. REEVE  JAN 1971

.INSRT MUDDLE >

;THIS PROGRAM HAS TWO ENTRIES.  FOPEN,FCLOSE AND FDELETE.
;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


;A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION

;	CHANNO==1			;ITS I/O CHANNEL NUMBER.  0 MEANS NOT A REAL CHANNEL.
;	DIRECT==3	;DIRECTION (EITHER READ OR PRINT)
;	DEVICE==5	;DEVICE UPON WHICH THE CHANNEL IS OPEN
;	NAME1==7	;FIRST NAME OF FILE AS OPENED.
;	NAME2==11	;SECOND NAME OF FILE
;	SNAME==13	;DIRECTORY NAME
;	RDEVIC==15	;REAL DEVICE
;	RNAME1=17	;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS)
;	RNAME2==21	;REAL SECOND NAME
;	RSNAME==23	;SYSTEM OR DIRECTORY NAME
;	STATUS==25	;VARIOUS STATUS BITS
;	IOINS==27	;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER
;	ACCESS==31	;ACCESS POINTER FOR RAND ACCESS
;	RADX==33	;RADIX FOR CHANNELS NUMBER CONVERSION
;	*** THE FOLLOWING FIELDS FOR OUTPUT ONLY ***

;	LINLN==35			;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE
;	CHRPOS==37	;CURRENT POSITION ON CURRENT LINE
;	PAGLN==41	;LENGTH OF A PAGE
;	LINPOS==43	;CURRENT LINE BEING WRITTEN ON
;	*** THE FOLLOWING FILEDS FOR INPUT ONLY ***

;	EOFCND==35			;GETS EVALUATED  ON EOF
;	LSTCHR==37	;BACKUP CHARACTER
;	BUFRIN==41	;POINTER TO BUFFER FOR TTY FLAVOR DEVICES


;CHANLNT==42	;LENGTH OF A CHANNEL OBJECT

;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME

	CHANLNT==1			;INITIAL CHANNEL LENGTH

; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS

PROCHN:

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

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


; EQUIVALANCES FOR INPUT CHANNELS

EOFCND==LINLN
LSTCH==CHRPOS
BUFRIN==PAGLN

;PRESET LINE LENGTH AND PAGE LENGTH

ZZZ==.	;SAVE CURRENT LOCATION

LOC PROCHN+RADX
10.

LOC PROCHN+LINLN
TTYLNL				;USE TTY LINE LENGTH

LOC PROCHN+PAGLN
TTYPGL	;USE TTY PAGE LENGTH

LOC ZZZ	;RESET LOCATIN
CHANLNT==CHANLNT-1


INBIT==0	;LH BITS FOR INPUT
OUTBIT==1	;AND FOR OUTPUT

;PAGE AND LINE LENGTH FOR TTY

TTYLNL==80.
TTYPGL==60.

;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS

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

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




.GLOBAL IPNAME,OPEN,CLOSE,IOT,ILOOKU,6TOCHS,ICLOS,OCLOS
.GLOBAL OPNCHN,CHMAK,READC,TYO,RADX,SYSCHR,BRFCHR,LSTCH
.GLOBAL CHRWRD

.GLOBAL DISOPN,DISCLS,DCHAR,DISLNL,DISPGL,CHANL0,BUFRIN,IOIN2
.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP

;SUBROUTINE TO DO OPENING BEGINS HERE

MFUNCTION FOPEN,SUBR,[OPEN]

	ENTRY
	PUSHJ	P,MAKCHN	;MAKE THE CHANNEL
	PUSHJ	P,OPNCHN	;NOW OPEN IT
	JRST	FINIS

; SUBROUTINE TO JUST CREATE A CHANNEL

MFUNCTION CHANNEL,SUBR

	ENTRY
	PUSHJ	P,MAKCHN
	JRST	FINIS
;INTERNAL CHANNEL CREATOR


MAKCHN:

; CYCLE THROUGH THE GIVEN ARGUMENTS

	MOVSI	A,-5		;NUMBER OF ARGUMENTS INTO A
ARGLP:	JUMPGE	AB,ARGDON	;IF AB>=0, NO MORE ARGS
	HLRZ	C,(AB)		;CHECK THE TYPE
	CAIN	C,TCHRS		;MUST BE AN CHRS
	JRST	ARGWIN
	CAIE	C,TCHSTR
	JRST	WRONGT
ARGWIN:	PUSH	TP,(AB)		;NOW TO TEMPS
	PUSH	TP,1(AB)
	ADD	AB,[2,,2]	;BUMP ARGG POINTER
	AOBJN	A,ARGLP		;CYCLE

;NOW PUSH ANY MORE GOODIES FOR DEFAULTS

ARGDON:
	MOVEI	A,(A)		;GET NUMBER DONE
	CAIN	A,5		;FINISHED?
	JRST	GETCHN		;YES
	LSH	A,1
	CAIE	A,2		;WASONLY DIRECTION GIVEN?
	JRST	DFLTAB(A)	;NO
	MOVEI	B,-1(TP)	;PICK UP DIRECTION
	PUSHJ	P,CHRWRD	;GET WORD
	JRST	WRONGT
	CAMN	B,CHQUOTE READ
	JRST	DFLTB1		;YES,GO PUSH 'INPUT'
	PUSH	TP,$TCHSTR
	PUSH	TP,CHQUOTE OUTPUT
	JRST	DFLTB2

DFLTAB:	PUSH	TP,$TCHSTR	;DEFAULT DIRECTION
	PUSH	TP,CHQUOTE READ
DFLTB1:	PUSH	TP,$TCHSTR	;DEFAULT NAME1
	PUSH	TP,CHQUOTE INPUT
DFLTB2:	PUSH	TP,$TCHSTR	;DEFAULT NAME2
	PUSH	TP,CHQUOTE MUDDLE
	PUSH	TP,$TCHSTR	;DEFAULT DEVICE
	PUSH	TP,CHQUOTE DSK
	.SUSET	[.RSNAM,,A]
	PUSHJ	P,6TOCHS
	PUSH	TP,A
	PUSH	TP,B		;AND DEFAULT SYS NAME

GETCHN:	PUSH	TP,$TFIX	;SETUP CALL TO VECTOR
	PUSH	TP,[CHANLN_-1]
	MCALL	1,VECTOR	;GO GET STORAGE
	HRLI	C,PROCHN	;SETUP FOR BLT
	HRRI	C,(B)
	BLT	C,CHANLNT-1(B)	;BLT IN THE TYPES
	MOVE	A,(TB)		;GET TYPE
	MOVEM	A,DIRECT-1(B)	;AND CLOBBER
	MOVE	A,1(TB)		;GET THE DIRECTION
	MOVEM	A,DIRECT(B)	;STORE IT
	MOVE	A,2(TB)		;TYPE FIRST
	MOVEM	A,NAME1-1(B)
	MOVEM	A,RNAME1-1(B)
	MOVE	A,3(TB)		;GET NAME1
	MOVEM	A,NAME1(B)
	MOVEM	A,RNAME1(B)	;ALSO REAL NAME 1
	MOVE	A,4(TB)		;TYPE
	MOVEM	A,NAME2-1(B)
	MOVEM	A,RNAME2-1(B)
	MOVE	A,5(TB)		;MAME 2
	MOVEM	A,NAME2(B)
	MOVEM	A,RNAME2(B)	;ALSO REAL NAME 2
	MOVE	A,6(TB)
	MOVEM	A,DEVICE-1(B)
	MOVEM	A,RDEVICE-1(B)
	MOVE	A,7(TB)		;GET DEVICE NAME
	MOVEM	A,DEVICE(B)
	MOVEM	A,RDEVIC(B)
	MOVE	A,10(TB)
	MOVEM	A,SNAME-1(B)
	MOVEM	A,RSNAME-1(B)
	MOVE	A,11(TB)	;FINALLY UNAME
	MOVEM	A,SNAME(B)
	MOVEM	A,RSNAME(B)
	SUB	TP,[10.,,10.]	;GARBAGE COLLECT TP
	MOVSI	A,TCHAN		;MAKE TYPE INTO CHANNEL
	POPJ	P,		;RETURN

;OPEN THE CHANNEL POINTED TO BY B

OPNCHN:	PUSH	TP,$TCHAN	;SAVE THE CHANNEL
	PUSH	TP,B
	MOVEI	B,DIRECT-1(B)	;POINT TO DIRECTION
	PUSHJ	P,CHRWRD	;PUT INTO A WORD
	JFCL
	MOVE	E,B		;TO E
	MOVE	B,(TP)
	MOVE	A,DEVICE-1(B)	;GET DEVICE
	MOVE	B,DEVICE(B)
	PUSHJ	P,STRTO6	;CONVERT TO 6-BIT
	HLRZS	A,(P)		;DEVICE TO RH
	CAIN	A,(SIXBIT /E&S/)	;DISPLAY HACK?
	JRST	DISCHK		;YES, GO HACK
	MOVE	B,(TP)		;RESTORE B
	MOVE	A,NAME1-1(B)	;TYPE OF NAME1
	MOVE	B,NAME1(B)	;GET THE FIRST NAME
	PUSHJ	P,STRTO6	;TO 6-BIT
	MOVE	B,(TP)		;RESTORE B
	MOVE	A,NAME2-1(B)
	MOVE	B,NAME2(B)	;SECOND NAME
	PUSHJ	P,STRTO6	;ALSO TO 6 BIT
	MOVE	B,(TP)
	MOVSI	A,INBIT		;GET BIT FOR INPUT OPEN
	CAME	E,[ASCII /READ/]	;REALLY INPUT?
	MOVSI	A,OUTBIT	;NO GET OUTPUT BIT
	IORM	A,-2(P)		;INTO OPEN STUFF
	MOVE	A,SNAME-1(B)
	MOVE	B,SNAME(B)	;GOBBLE SNAME
	PUSHJ	P,STRTO6	;6 BIT
	POP	P,A		;RESTORE RESULT
	.SUSET	[.SSNAM,,A]	;SET THE SYSTEM NAME
	MOVEI	A,-2(P)		;POINT TO OPEN BLOCK
	PUSHJ	P,OPEN		;DO THE OPEN
	JRST	OPNFAI		;OPEN FAILED, LOSE
	MOVE	B,(TP)		;RESTORE B
	PUSHJ	P,DOSTAT	;GOBBLE THE STATUS
	LDB	C,[600,,STATUS(B)]	;GOBBLE STATUS
	CAMN	E,[ASCII /PRINT/]
	CAIE	C,2		;SKIP IF DATAPOINT CROCK
	JRST	OPNCH2		;NOT SAME FOR OUTPUT

	PUSHJ	P,CLOSE		;CLOSE THE FILE
	MOVSI	A,OUTBIT+20	;AND RE-OPEN IN DISPLAY MODE
	HLLM	A,-2(P)
	MOVEI	A,-2(P)		;POINT TO OPEN BLOCK
	PUSHJ	P,OPEN		;NOW OPEN THE DEVICE
	JRST	OPNFAI		;CANT OPEN

OPNCH2:	SUB	P,[3,,3]	;REMOVE OPEN BLOCK
	MOVEM	A,CHANNO(B)	;RESTORE CHANNEL NUMBER
	MOVEI	D,(A)		;COPY CHANNEL NO.
	LSH	D,1
	ADDI	D,CHANL0+1(TVP)	;POINT TO THIS CHANNELS TV ENTRY
	MOVEM	B,(D)
	HRLZS	A  		;CHANNEL NO. TO LH
	MOVE	C,A		;COPY TO C
	ROT	C,5		;INTO C'S AC FILED
	IOR	C,[.IOT 0,A]	;AND AN I/O INSTRUCTION
	MOVEM	C,IOINS(B)	;SAVE IN CHANNEL
; THIS CODES SETS THE 'REAL' NAMES, DEVICES AND SNAMES

	HRRI	A,1(P)		;POINT INTO P
	MOVEI	C,(A)		;C ALSO POINTS
	ADD	P,[5,,5]	;ALLOCATE SOME P
	JUMPGE	P,[.VALUE [ASCIZ 'P/']]	;DIE ON PDL LOSSAGE
	.RCHST	A,		;READ THE STATUS
	HRLZS	(C)		;FOR NOW KILL LH OF DEVICE
	HRLI	C,-5		;5 GOODIES
	PUSH	P,C
	PUSH	P,[0]		;USED AS A COUNTER
NXTREL:	MOVEM	C,-1(P)		;SAVE C
	SKIPN	A,(C)		;WAS THIS ONE GIVEN?
	JRST	NXTLOK		;NO, SKIP CHANGE
	PUSHJ	P,6TOCHS	;YES, MAKE INTO ATOM
	MOVEI	C,RDTBL		;FIND OUT WHERE
	ADD	C,(P)		;FOR THIS ONE
	MOVE	C,(C)		;NOW HAVE TH OFFSET TO USE
	ADD	C,(TP)		;ADD TO POINTER
	MOVEM	A,-1(C)
	MOVEM	B,(C)		;CLOBBER THE NEW ATOM IN
	MOVE	C,-1(P)		;RESTORE C
NXTLOK:	AOS	(P)		;COUNT THE GOODIES
	AOBJN	C,NXTREL

	SUB	P,[7,,7]	;GC ON P

; DETERMIN EIF THIS IS A TTY FLAVOR DEVICE

	MOVE	B,(TP)		;RESTORE CHANEL POINTER
	MOVE	A,STATUS(B)	;GET STATUS
	ANDI	A,77		;ISOLATE DEVICE SPEC
	CAMN	E,[ASCIZ /READ/]
	CAILE	A,2		;NOT A TTY, NO FURTHER ACTION
	JRST	OPNRET

	PUSH	TP,$TFIX	;CALL UVECTOR FOR BUFFER
	PUSH	TP,[EXTBFR]
	MCALL	1,UVECTOR	;GET VECTOR
	MOVE	C,[PUSHJ P,READC]	;GET NEW IOINS
	MOVE	D,(TP)		;RESTORE CHANNEL POINTER
	EXCH	C,IOINS(D)	;STORE NEW ONE AND GE OLD
	MOVEM	C,IOIN2(B)	;STORE
	MOVEM	B,BUFRIN(D)	;STORE IN CHANNEL
	MOVSI	A,TUVEC		;MAKE SURE TYPE IS UNIFORM VECTOR
	MOVEM	A,BUFRIN-1(D)
	MOVEI	A,177		;SET ERASER TO RUBOUT
	MOVEM	A,ERASCH(B)
	SETOM	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(B)]	;RELATIVE BYTE POINTER
	MOVEM	A,BYTPTR(B)
	MOVEI	A,14		;BARF BACK CHARACTER FF
	MOVEM	A,BRFCHR(B)

OPNRET:	POP	TP,B		;GET CHANNEL POINTER BACK

	POP	TP,A		;RESTORE TYPE OF CHANNEL
	POPJ	P,


;TABLE USED TO DO THE 'REAL GOODIES'

RDTBL:	RDEVIC
	RNAME1
	RNAME2
	RSNAME
	ACCESS


;HERE TO DO STATUS FOR OPEN LOSSAGE ETC.

DOSTAT:	PUSH	P,A		;SAVE CHANNEL
	ROT	A,23.		;INTO AC FILED
	IOR	A,[.STATUS STATUS(B)]	;GOBBLE THE STATUS
	XCT	A		;DO IT
	POP	P,A
	POPJ	P,


;MAKE THE DISPLAY DEVICE  A PSEUDO DEVICE HANDLED BY "DCHAR" ROUTINE
DISCHK:	SUB	P,[1,,1]	;POP OFF JUNK
	MOVE	B,(TP)		;GET POINTER TO CHANNEL
	SETZM	CHANNO(B)	;A PSEUDO CHANNEL NUMBER
	MOVE	C,[PUSHJ  P,DCHAR]
	MOVEM	C,IOINS(B)	;GO TO THIS ROUTINE TO HANDLE I/O
	MOVEI	C,DISLNL
	MOVEM	C,LINLN(B)
	MOVEI	C,DISPGL
	MOVEM	C,PAGLN(B)
	PUSHJ	P,DISOPN	;GO INITIALIZE THE DISPLAY
	JRST	OPNFAI
	JRST	OPNRET

;ARRIVE HERE IF FOPEN CALLED WITH WRONG TYPES OF ARGUMENTS

WRONGT:	PUSH	TP,$TATOM	;SET UP CALL TO ERROR
	PUSH	TP,MQUOTE WRONG-TYPE
	JRST	CALER1


;THIS ROTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES
STRTO6:	PUSH	TP,A
	PUSH	TP,B
	PUSH	P,E		;SAVE USEFUL FROB
	MOVEI	E,-1(A)		;GET END+1 OF TCHSTR
	HLRZS	A		;CHECK THE TYPE(ONE WORD OR VECTOR)
	CAIE	A,TCHRS		; IS IT ONE WORD?
	JRST	CHREAD		;NO
	MOVEI	B,(TP)		;YES, CREATE DUMMY VECTOR POINTER
	HRLI	B,350700
	MOVEI	E,1(TP)		;AND DUMMY VECTOR END+1
CHREAD:	MOVEI	A,0		;INITIALIZE OUTPUT WORD
	MOVE	D,[440600,,A]	;AND BYTE POINTER TO IT
	LDB	0,B		;PICK UP FIRST CHARACTER
NEXCHR:
	JUMPE	0,SIXDON	;IF NULL, WE ARE FINISHED
	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
	JUMPLE	0,BAD6		;CHECK FOR A WINNER
	CAILE	0,77
	JRST	BAD6
	IDPB	0,D		;DEPOSIT INTO SIX BIT
	TRNE	A,77		;IS OUTPUT FULL
	JRST	SIXDON		;YES, LEAVE
	ILDB	0,B		;GET NEXT CHAR AND INC POINTER
	HRRZ	C,B		;GET ADDRESS PART OF BYTE POINTER
	CAME	C,E		;HAS POINTER REACHED LIMIT?
	JRST	NEXCHR		;NO, GOBBLE NEXT CHARACTER
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
	MOVEI	B,6		;MAX NUMBER OF CHARACTERS
	PUSH	P,[0]		;STRING WILL GO ON P SATCK
	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
	JUMPE	0,GETATM	;IF ZERO, FINISHED
	ADDI	0,40		;CHANGET TOASCII
	IDPB	0,E		;AND STORE IT
	SOJG	B,6LOOP		;KEEP LOOKING
	PUSH	P,[2]		;IF ARRIVE HERE, STRING IS 2 WORDS
	JRST	.+2
GETATM:	AOS	(P)		;SET STRING LENGTH=1
	PUSHJ	P,CHMAK		;MAKE A MUDDLE STRING
	POP	P,E
	POPJ	P,


;HERE IF OPEN FAILS

OPNFAI:	MOVE	B,(TP)		;RESTORE CHANNEL POINTER
	SETOM	STATUS(B)	;SET TO -1
	JUMPL	A,.+2		;A<0 MEANS NO CHANNELS
	PUSHJ	P,DOSTAT	;GOBBLE STATUS
	SUB	TP,[2,,2]	;PATCH UP TP
	SUB	P,[3,,3]	;REMOVE CRAP
RETNIL:	MOVSI	A,TFALSE	;RETURN A FALSE
	MOVEI	B,0
	POPJ	P,

;ERROR FOR BAD CHARACTER IN SIX BIT STRING

BAD6:	PUSH	TP,$TATOM	;SETUP ERROR CALL
	PUSH	TP,MQUOTE FILE-NAME-NOT-6-BIT
	JRST	CALER1


; FUNCTION TO LIST ALL CHANNELS

MFUNCTION CHANLIST,SUBR

	ENTRY	0

	MOVEI	A,16.		;MAX # OF CHANNELS
	MOVEI	C,0
	MOVEI	B,CHANL0(TVP)	;POINT TO FIRST

CHNLP:	SKIPN	1(B)		;OPEN?
	JRST	NXTCHN		;NO, SKIP
	PUSH	TP,(B)
	PUSH	TP,1(B)
	ADDI	C,1		;COUNT WINNERS
NXTCHN:	ADDI	B,2
	SOJN	A,CHNLP

	ACALL	C,LIST
	JRST	FINIS


;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL

MFUNCTION FCLOSE,SUBR,[CLOSE]

	ENTRY	1		;ONLY ONE ARG
	HLRZ	A,(AB)		;CHECK ARGS
	CAIE	A,TCHAN		;IS IT A CHANNEL
	JRST	WRONGT
	MOVE	B,1(AB)		;PICK UP THE CHANNEL
	CLEARM	IOINS(B)	;CLOBBER THE IO INS
	MOVEI	B,DEVICE-1(B)	;GE THE NAME OF THE DEVICE
	PUSHJ	P,CHRWRD
	JFCL
	MOVE	A,B
	MOVE	B,1(AB)
	CAMN	A,[ASCIZ /TTY/]	;IS IT THE TTY?
	JRST	TTYCLS		;YES, DO SPECIAL  HACK
	CAMN	A,[ASCIZ /DIS/]
	PUSHJ	P,DISCLS	;GO RELEASE THE DISPLAY SPACE
	SKIPE	A,CHANNO(B)	;IS THERE A CHANNEL NO.?
	PUSHJ	P,CLOSE		;YES, CLOSE IT
CFIN:	SKIPN	A,CHANNO(B)	;ANY CHANNEL?
	JRST	CFIN2
	LSH	A,1
	ADDI	A,CHANL0+1(TVP)	;POINT TO THIS CHANNELS LSOT
	SETZM	CHANNO(B)
	SETZM	(A)		;AND CLOBBER IT
CFIN2:	MOVSI	A,TCHAN		;RETURN THE CHANNEL
	JRST	FINIS

TTYCLS:	MOVE	A,DIRECT(B)	;GET THE DIRECTION OF THE CHANNEL
	CAMN	A,CHQUOTE READ,	;IS IT READ
	PUSHJ	P,ICLOS		;YES, CLOSE THAT
	CAMN	A,CHQUOTE PRINT,	;IS IT PEINT
	PUSHJ	P,OCLOS		;YES CLOSE TTY OUT CHANNEL
	JRST	CFIN


END