.NLIST
; COPYRIGHT (C) 1974,1975
;
; DIGITAL EQUIPMENT CORPORATION
; MAYNARD, MASSACHUSETTS 01754
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
; ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
; THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
; SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED
; OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON EXCEPT
; FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE
; LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE
; SHALL AT ALL TIMES REMAIN IN DIGITAL.
;
; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DIGITAL ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DIGITAL.
	.LIST
.IIF DF	NLUSR,	.NLIST	;USR UPDATE LEVEL 10
.SBTTL	USR ENTRY, EMT 376 PROCESSOR

RTORG:
USRBUF:	JSR	PC,LOCATE		;FIND REAL POINTERS
	JMP	@R5			;AND GO TO IT!

LOCATE:	MOV	R1,-(SP)
	MOV	R2,-(SP)	;R2 IS VALUABLE.
	MOV	@#SYSPTR,R5	;ADDRESS OF THIS RMON
	MOV	#<ENDLST-RELIST>/2,R2 ;NUMBER OF ITEMS TO RELOCATE
	ADDR	RELIST,R1	;GO THRU RELIST AND MAKE UP
10$:	ADD	R5,(R1)+	; A LIST OF RESIDENT ADDRESSES WE NEED
	DEC	R2		;END OF LIST ?
	BNE	10$		;NOT YET
	ADDR	USRBUF,R5	;POINT TO DIRECTORY BOTTOM
	MOV	R5,.USRBU	;POINTER TO BUFFER
	ADD	#12,R5		;POINTER TO DIR BOTTOM
	MOV	R5,.USRBO	;POINT INTO USR, NOT RMON.
	ADD	#2000-12,R5	;POINT TO TOP OF USRBUF (= USR)
	MOV	R5,.USRTO	;SAVE OUR POINTER TO TOP OF USRBUF
	MOV	R5,@.USRLO	;THE MONITOR WILL NOW CALL USR
	CLR	@.BLKEY		;CLEAR DIRECT BLK IN CORE.
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RTS	PC

.IF EQ	BF

.SBTTL	ERROR HANDLER

;**************************************************
; THIS IS THE ERROR PROCESSOR FOR RT11 SINGLE USER.
; EMT 376 BRINGS THE USER HERE WHEN A FATAL MONITOR TYPE
; ERROR HAS BEEN DETECTED. THE APRROPRIATE MESSAGE IS
; PRINTED, AS WELL AS THE PC OF THE USER EMT WHICH WAS IN ERROR.
; THE PROCESSOR IS ENTERED WITH R4= ERROR CODE AND R3=PC OF ERRANT EMT.
;**************************************************

IOFSET	= FATAL - USRBUF

.ENABL	LSB

FATAL:	JSR	PC,LOCATE	;SET UP RELOCATION LIST
	ADDR	IOTLS,R1	;POINT TO POINTER LIST
	ASL	R4		;CODE TIMES 2
	ADD	R4,R1		;ADD IN CODE
	MOV	(R1),R1		;MSG POINTER TO R1
	ADD	PC,R1		;GET ABSOLUTE ADDRESS
IOTPC:	MOVB	(R1)+,R0	;PRINT CHAR BY CHAR
	BEQ	3$		;0 MEANS DONE
	.TTYOUT			;PRINT IT
	BR	IOTPC
3$:	MOV	#30,R0		;PRINT THE PC
	SEC
4$:	ROL	R3
	ROLB	R0
	.TTYOUT
	MOV	#206,R0
5$:	ASL	R3
	BEQ	6$
	ROLB	R0
	BCS	5$
	BR	4$
6$:	BIC	#RSTRT$,@#JSW	;NO RESTART
	CLR	R0
	.EXIT			;LET'S GET OUT

IOTLS:	F.0	-IOTPC	;ILLEGAL USR/EXIT CALL
	F.1	-IOTPC		;NO DEVICE HANDLER
	F.2	-IOTPC		;DIRECTORY IO ERROR
	F.3	-IOTPC		;ERROR IN FETCH
	F.4	-IOTPC		;OVERLAY READ ERROR
	F.5	-IOTPC		;DIRECTORY OVERFLOW
	F.6	-IOTPC		;ADDRESS CHECK ERROR
	F.7	-IOTPC		;ILLEGAL CHANNEL NUMBER
	F.10	-IOTPC		;ILLEGAL EMT CODE
	F.11	-IOTPC		;TRAP TP LOC. 4
	F.12	-IOTPC		;TRAP TO 10
	F.13	-IOTPC		;FPP TRAP

.MACRO	ERRMSG	CODE,TEXT
.IRP	..TMP2,<\..TEMP>
F.'..TMP2:	.ASCIZ	TEXT
.ENDR
CODE'.E	= ..TEMP
..TEMP	= ..TEMP+1
.ENDM	ERRMSG

..TEMP	= 0

	ERRMSG	USRX,<"?M-ILL USR ">
	ERRMSG	NODV,<"?M-NO DEV ">
	ERRMSG	DIRI,<"?M-DIR IO ERR ">
	ERRMSG	FETC,<"?M-BAD FETCH ">
	ERRMSG	OVLY,<"?M-OVLY ERR ">
	ERRMSG	DOVR,<"?M-DIR OVFLO ">
	ERRMSG	ADDR,<"?M-ILL ADDR ">
	ERRMSG	CHAN,<"?M-ILL CHAN ">
	ERRMSG	EMT,<"?M-ILL EMT ">
	ERRMSG	TR04,<"?M-TRAP TO 4 ">
	ERRMSG	TR10,<"?M-TRAP TO 10 ">
	ERRMSG	FPP,<"?M-FP TRAP ">
.EVEN

.DSABL	LSB
.ENABL	LSB
CDFN:	MOV	ARGM1,R2	;R2= # TO CREATE
	MOV	R2,R1		;AS DOES R1 FOR LATER
	MOV	.I.CNU,R5	;POINT R5 T0 ADD. OF # NOW AROUND
	CMP	R2,(R5)		;DEFINING <= WHAT WE HAVE NOW?
	BLOS	24$		;YES. THAT'S DUMB. GIVE AN ERROR
21$:	MOV	.QSIZE,R3	;WAIT FOR IO TO SUBSIDE
	CMP	(R3)+,(R3)
	BNE	21$
	MOV	(R5),R4		;MAKE R4= # WORDS IN CURRENT TABLE
	ASL	R4
	ASL	R4
	ADD	(R5)+,R4
	MOV	(R5),R3		;R3 IS WHERE THEY NOW START
	ASL	R2		;MAKE R2= # WDS TO CREATE
	ASL	R2
	ADD	R1,R2
	SUB	R4,R2		;NOW R2=NUMBER LEFT TO 0 OUT
22$:	MOV	(R3)+,(R0)+	;COPY ALL OLD CHANNELS
	DEC	R4
	BNE	22$
23$:	CLR	(R0)+		;AND THEN ZERO THE REST
	DEC	R2
	BNE	23$
	MOV	(SP),(R5)	;ADDRESS OF NEW TABLE
	MOV	R1,-(R5)	;NUMBER OF ENTRIES
	BR	25$
24$:	EMTERR+0
25$:	JMP	COMXIT

.ENDC
.DSABL	LSB

.SBTTL	USR
.ENABL	LSB

; THESE PARAMETERS ARE OFFSETS ONTO THE STACK WHEN AN EMT IS RUNNING

SAVE	= 12			;6 REGISTERS ON STACK
OLDPS	= SAVE+4		;EMT OP. PROCESSOR STATUS
ERRPS	= OLDPS*2+2		;EMT 17 ALTERS C BIT HERE
ERRPC	= OLDPS*2		;PC OF ERRANT EMT

.	= RTORG+2000

	MOV	@SP,R0		;RESET POINTER TO DEV:FILE.EXT
.IF EQ	BF
	TST	@.RECUR		;CALLED VIA COMPLETION?
	BEQ	USRA
	MONERR	USRX.E,0,FATAL	;RECURSION IS FATAL ERROR
USRA:
.ENDC
	CLR	@.SPUSR		;CLEAR SOFTWARE ERR FLAG
	MOV	(R1)+,(PC)+	;SAVE FIRST ARG
ARGM1:	.WORD	0
	MOV	(R1)+,(PC)+
ARGM2:	.WORD	0
	MOV	R2,(PC)+	;NEW/OLD FLAG
USREMT:	.WORD	0
	MOV	SP,(PC)+	;CURRENT SP IN CASE ERROR
USRSP:	.WORD	0
	CLR	R5		;SOME EMT'S WANT R5=0
	ROL	R2		;CLEAR TOP BIT, MAKE INDEX INTO LIST.
	TST	(R2)+		;INDEX INTO OUR LIST
	ADD	PC,R2
	ADD	(R2),PC
ULS:	QSET-ULS		;SETUP IO QUEUE
.IF EQ BF
	CDFN-ULS		;DEFINE IO CHANNELS
.IFTF
	DELETE-ULS		;DELETE FILE EMT
	PHETCH-ULS
	KLOSE-ULS
	ENTER-ULS
	LOOKUP-ULS
	RENAME-ULS
	GESTAT-ULS		;GET DEVICE STATUS
.IFT
	SOFRST-ULS		;SOFT RESET ONLY
	HDRSET-ULS		;HARD +SOFT RESET
.ENDC
..CSI	= <. - ULS> / 2		;INDEX NUMBER FOR CSI
	CSI-ULS			;COMMAND INTERPRETER

; USRPOP IS A BYTE TABLE GIVING THE NUMBER OF ARGUMENTS EACH USR
;	REQUEST MAY REQUIRE TO BE POPPED OFF AT MONOUT.
USRPOP:	.BYTE	1		; QSET HAS 1 ARG


.IF EQ BF
	.BYTE	0		;CDFN HAS NONE
.IFTF
	.BYTE	0,1,0,1,0,0,1
.IFT
	.BYTE	0,0		;HRESET AND SRESET ONLY IN SJ MONITOR
.IFTF
	.BYTE	0		;CSI
.ENDC
	.EVEN

; COMERR IS THE COMMON ERROR EXIT FOR ALL FATAL USR ROUTINES.
;	R0 WILL CONTAIN THE ERROR CODE TO BE USED BY EMT 376.
COMERR:	MOVB	(R5),CODE	;R5 POINTS TO CODE
	MOV	USRSP,SP	;RESET STACK
	CLR	@.DFLG		;TURN OFF PROTECTION
	CLR	@.BLKEY		;NO DIRECTORY IN CORE
	EMT	376		;FATAL ERROR
	.BYTE	0		;LEVEL
CODE:	.BYTE	0		;CODE

; AT COMXIT, R2 IS LOADED WITH THE CORRECT NUMBER OF ARGS FOR MONOUT.
;	FOR NEW FORMAT EMT'S, NO ARGS NEED TO BE POPPED.
COMXIT:	MOVB	USREMT,R2	;GET THE ORIGINAL FUNCTION
	ADD	PC,R2		;POINT TO USRPOP ENTRY
	MOVB	USRPOP-.(R2),R2	;PUT ARGUMENT NUMBER IN R2
USRB:	JMP	@.MONOU		;AND EXIT USR

.DSABL	LSB

.SBTTL	LOOKUP AND RENAME

; LOOKUP AND RENAME ARE USED TO OPEN A FILE FOR INPUT AND/OR OUTPUT.
; R0 -> DEV:FILE.EXT IN RAD50.
; THE  DEVICE FOR THE EMT MUST BE IN CORE

.ENABL	LSB

RENAME:	MOV	#RENAM$,R5	;WILL BE RENAME BIT IN CSW
LOOKUP:	JSR	R5,USRCOM	;(R5 IS CLEAR FOR LOOKUP)
	 BR	LNFILE		;NON FILE ORIENTED DEVICE
	 BR	SPLOOK		;SPECIAL DEVICE LOOKUP
	MOV	R4,SBLK		;R4 CONTAINS SEGMENT START BLK
	JSR	R5,DLEET	;GET A PERMANENT ENTRY OF A FILE NAME.
	 BR	LKER1		;THAT DOESN'T EXIST.
	BIT	#RENAM$,(R3)	;A RENAME DONE?
	BNE	RNAM2		;YES. PROCESS THE RENAME
	TST	(R3)+		;POINT TO CHANNEL INFORMATION
	ADD	#E.LENG,R1	;POINT TO LENGTH WORDS
	MOV	SBLK,(R3)+	;PUT STARTING BLOCK INTO CSW AREA
	MOV	(R1),(SP)	;LENGTH TO R0 ON RETURN
	MOV	(R1)+,(R3)+	;AND ALSO TO CSW AREA
	MOV	(R1)+,(R3)+	;DATA LENGTH
	BR	COMXIT

RNAM2:	ADD	#10,R0		;POINT TO NEW NAME
	MOV	#EMPTY,(R1)+	;SO DLEET CAN FIND OLD COPY
	MOV	(R0)+,(R1)+
	MOV	(R0)+,(R1)+	;FILL IN NEW NAME
	MOV	(R0)+,(R1)+
	SUB	#10,R1		;POINT R1 AT STATUS WORD
	JMP	CLOCOM		;DO COMMON CLOSE OPERATIONS

LNFILE:	TST	(R3)+		;LEAVE CSW ALONE, GO CLEAR START BLK
	BR	DELOUT

;**************************************************
; SPLOOK, SPDEL, AND SPCLOS ARE ROUTINES
; TO HANDLE REQUESTS FOR SPECIAL DIRECTORY DEVICES
; THEY PASS THE INDICATED FUNCTION ON TO THE
; HANDLER THROUGH ROUTINE SPESHL
;**************************************************

SPLOOK:	TST	R5		;RENAME DONE?
	BNE	LKER1		;YES. GIVE ERROR 1
	BIS	#DWRIT$,(R3)	;REWRITE DIRECTORY BIT
	JSR	R4,SPSHL1
	 .BYTE	377,LOOK..
	BCC	COMXIT		;NO ERROR
ENER1:
LKER1:	EMTERR+1		;CODE 1 ERROR
DELOUT:	CLR	(R3)+		;DEACTIVATE CHANNEL
	BR	COMXIT

SPDEL:	JSR	R4,SPSHL1	;DO A DELETE
	 .BYTE	377,DELE..
	BCC	DELOUT		;NO ERROR. DEACTIVATE CHANNEL
	BR	LKER1		;ERROR OCCURRED.

SPCLOS:	JSR	R4,SPESHL
	 .BYTE	377,CLOS..		;DO A CLOSE
	BR	DELOUT

.DSABL	LSB

.IF EQ	BF
.SBTTL	RESET, EXIT TO KMON
; THESE ARE THE ENTRIES FOR THE SOFT AND HARD RESET EMT'S
SOFRST:	MOV	(PC)+,R0	;JUST DO CHANNEL AND DEVICE RESET
HDRSET:	CLR	R0		;JUST HARDWARE RESET.
	JSR	PC,RSTSR	;DO THE RESET
	BR	COMXIT
.ENDC

.SBTTL	DELETE

; DELETE USES USRCOM TO SET UP A CHANNEL  FOR DIRECTORY
; OPERATIONS, AND THEN CALLS DLEET TO ACTUALLY FIND THE
; FILE TO BE DELETED. THE ENTRY IS MADE INTO
; AN EMPTY FILE. THE DIRECTORY CONSOLIDATOR IS CALLED
; AT CLSQSH, AND THE CHANNEL IS CLOSED.

DELETE:	JSR	R5,USRCOM	;SETUP THE CHANNEL FOR DIRECTORY IO
	 BR	DELOUT		;NON FILE DEVICE
	 BR	SPDEL		;DO SPECIAL DELETE
	JSR	R5,DLEET	;FIND THE FILE. R0 POINTS TO IT.
	 BR	LKER1		;NO SUCH FILE TO DELETE
	MOV	#EMPTY,(R1)	;MAKE ENTRY AN EMPTY
	JMP	CLSQSH		;CONSOLIDATE SEGMENT AND EXIT

.SBTTL	ENTER

; ENTER PROCESSOR
; HANDLES OPENING OF NEW FILES ON DEVICES. THE FILE IS ADDED
; INTO THE DIRECTORY IN FRONT OF AN ALREADY EXISTING EMPTY
; DIRECTORY ENTRY. IF THE ENTRY BEFORE THE EMPTY IS A TENTATIVE
; FILE, AN EMPTY OF LENGTH 0 IS INSERTED AFTER THE SECOND 
; TENTATIVE ENTRY

.ENABL	LSB

ENTER:	MOV	#DWRIT$,R5	;SET DIRECTORY REWRITE NEEDED
	JSR	R5,USRCOM	;DO COMMON STARTUP
	 BR	ENOUT		;ENTER ON NON-FILE DEVICE IS EASY
	 BR	SPENTR		;SPECIAL ENTER IS SPECIAL
	MOV	USRBUF+4,LSTBLK	;REMEMBER HIGHEST DIRECTORY BLOCK
	CLR	FNAME		;USE FNAME BLOCK TO FIND LARGEST
	CLR	FNAME+2		;  AND 2ND LARGEST ENTRIES
	BR	2$		;ENTER LOOP (BLOCK 1 ALREADY IN CORE)

1$:	JSR	R5,NXBLK	;READ NEXT BLOCK INTO CORE
	 BR	10$		;NO MORE DIRECTORY
2$:	JSR	PC,CONSOL	;CONSOLIDATE THIS BLOCK
	MOV	R4,SBLK		;REMEMBER START BLOCK
3$:	ADDR	FNAME,R5	;POINT TO 2ND LARGEST SO FAR
	JSR	R5,ENTRY	;GET AN EMPTY ENTRY
	 EMPTY
	 BR	1$		;NO MORE EMPTIES IN THIS BLOCK
	MOV	E.LENG(R1),R0	;GET LENGTH OF EMPTY
	MOV	ARGM1,R2	;GET REQUESTED SIZE
	BEQ	4$		;0 => GET LARGEST TWO
	CMP	#-1,R2		;-1 => LARGEST
	BNE	15$		;NO, A SPECIFIC REQUEST
4$:	CMP	(R5)+,R0	;2ND LARGEST : THIS HOLE
	BHIS	6$		;NO GOOD, IGNORE IT
	CMP	@R5,R0		;LARGEST : THIS HOLE
	BHIS	5$		; GREATER => THIS IS NEW 2ND LARGEST
	MOV	@R5,-(R5)	;MOVE FORMER LARGEST TO 2ND SPOT
	ADD	#8.,R5		;ADVANCE POINTER
	MOV	-(R5),-(R5)	;COPY BLOCK INDEX
5$:	MOV	R0,-(R5)	;SAVE HOLE SIZE
	MOV	@R3,4(R5)	;SAVE BLOCK POINTER
6$:	ADD	R0,SBLK		;MAINTAIN START BLOCK
	JSR	PC,INCR1	;BUMP R1 POINTER
	BR	3$		;KEEP LOOKING

SPENTR:	JSR	R4,SPESHL	;SPECIAL DEVICE ENTER
	 .BYTE	377,ENTR..
	BCC	ENOUT		;DONE GOOD
	EMTERR+0
ENOUT:	JMP	COMXIT

10$:	TST	(R5)+		;END OF PASS 1. POINT R5 TO LARGEST
	MOV	ARGM1,R2	;GET REQUEST SIZE
	BNE	11$		;MIGHT HAVE BEEN SPECIFIC OR MAX
	ROR	@R5		;TAKE HALF THE LARGEST HOLE
	CMP	@R5,-(R5)	;COMPARE IT TO THE 2ND LARGEST HOLE
	BLO	13$		;2ND LARGEST IS BIGGER
	TST	(R5)+		;THAT HALF IS BIGGER
13$:	CMP	@.MAXBL,@R5	;ASKING FOR TOO MUCH?
	BHIS	12$		;NO. LEAVE IT ALONE
	MOV	@.MAXBL,@R5	;GIVE ONLY THE MAXIMUM
	BR	12$
11$:	INC	R2		;IF IT WASN'T -1,
	BNE	ENER1		;THEN IT WAS A FAILING SPECIFIC REQUEST
12$:	MOV	@R5,ARGM1	;CONVERT REQUEST TO SPECIFIC
	BEQ	ENER1		;GOLLY, THERE'S NO ROOM AT ALL
	BIC	#DBLK$M,@R3	;CLEAR OUT BLOCK NUMBER
	BIS	4(R5),@R3	;START RESCAN AT A GOOD PLACE
RENTR:	JSR	R5,BLKCHK	;GET DBLOCK INTO CORE
	BR	2$		;START LOOP

15$:	CMP	R0,R2		;SPECIFIC REQUEST SATISFIED?
	BLO	6$		;NO. GET NEXT
	MOV	R1,-(SP)	;SAVE POSITION OF EMPTY, AND
	MOV	DREND,R1	;SEE IF ROOM FOR 3 MORE ENTRIES
	JSR	PC,INCR2
	JSR	PC,INCR1
	CMP	R1,.USRTO
	BHI	EXTEND		;HAVE TO OPEN NEW BLOCK
	MOV	(SP)+,R1
	MOV	SBLK,R4		;SAVE STARTING BLOCK
	MOV	R1,R5
	SUB	R2,E.LENG(R1)	;DECREASE LENGTH OF EMPTY
	SUB	#L.ENTR,R5	;STATUS OF PREVIOUS ENTRY
	SUB	USRBUF+6,R5	;WASTE WORDS
	CMP	R5,.USRBO	;OUTSIDE DIRECTORY BUFF?
	BLO	20$		;YES. PREVIOUS NOT TENTATIVE
	BIT	#TENT,(R5)	;PREVIOUS TENTATIVE?
	BEQ	20$		;GUESS NOT.
	JSR	PC,PUSH		;PUT IN EMPTY OF LENGTH 0
	MOV	#EMPTY,(R1)	;STATUS ENTRY
	CLR	E.LENG(R1)	;CLEAR OUT THE LENGTH
	JSR	PC,INCR1	;POINT TO NEXT ENTRY
20$:	JSR	PC,PUSH		;MAKE ROOM FOR REAL ENTRY
	MOV	#TENT,(R1)	;AND MAKE IT TENTATIVE.
	MOV	(SP),R0		;RESET R0 TO DEV:
	CMP	(R0)+,(R1)+	;POINT TO NAME AREAS
	MOV	(R0)+,(R1)+	;FILL IN FILE NAME
	MOV	(R0)+,(R1)+
	MOV	(R0)+,(R1)+
	MOV	R2,(R1)+	;LENGTH OF HOLE
.IF NE	BF
	MOVB	CHNLRG,(R1)+	;PUT IN CHANNEL OF REQUEST
	MOVB	@.JOBNUM,(R1)+	;  AND JOB OF REQUESTOR
.IFF
	MOV	CHNLRG,(R1)+	;PUT IN CHANNEL NUMBER 
.ENDC
	MOV	@.$DATE,(R1)+	;DATE WORD
	TST	(R3)+		;FILL IN CHANNEL STUFF
	CLR	(R3)
	JSR	R5,SEGRW2	;WRITE THE SEGMENT
	 11*400
	MOV	R4,(R3)+	;INSERT START BLOCK
	MOV	R2,(R3)+	;HOLE LENGTH
	CLR	(R3)		;DATA LENGTH
	MOV	-(R3),(SP)	;GIVE BACK THE HOLE LENGTH
	BR	ENOUT

.DSABL	LSB

.SBTTL	DIRECTORY EXTEND
; ENTER EXTEND IS PERFORMED WHEN AN ENTRY WILL NOT FIT INTO
; AN EXISTING DIRECTORY BLOCK. IF THE DIRECTORY CONTAINS ANOTHER
; DIRECTORY BLOCK, EXTEND DOES THE FOLLOWING THINGS:

;  FIND THE TOTAL NUMBER OF ENTRIES IN THE DIRECTORY
; SEGMENT. DIVIDE THAT BY 2, AND SET R1 TO THE ENTRY THAT IS
; ROUGHLY 1/2  THE WAY DOWN IN THE DIRECTORY. STARTING THERE, WE
; SEARCH FOR A PERMANENT OR TENTATIVE OR ENTRY ENTRY. WHEN AN ENTRY
; IS FOUND, THE CURRENT SEGMENT IS TERMINATED WITH AN END
; BLOCK MARK, AND WRITTEN OUT. THE REMAINING ENTRIES ARE THE FIRST
; ENTRIES IN A NEW SEGMENT. THE SEGMENTS ARE LINKED, AND THE NEWLY
; CREATED SEGMENT IS WRITTEN OUT. BLOCK 1 OF THE DIRECTORY IS
; UPDATED TO REFLECT THE HIGHEST BLOCK USED IN THE DIRECTORY, AND
; ENTER IS RESTARTED AT THE DIRECTORY BLOCK WHICH WAS SPLIT.

EXTEND:	TST	(SP)+		;CLEAN OFF STACK
	MOV	(PC)+,R2	;HIGHEST BLOCK NOW IN USE
LSTBLK:	0
	INC	@.DFLG		;HOLD OFF ON ^C
	CMP	R2,USRBUF	;IS THERE ANOTHER BLOCK?
	BLT	1$		;YES, USE IT
	JSR	R5,COMERR	;NO MORE SEGMENTS AVAILABLE
	 .WORD	DOVR.E
1$:	CLR	R4		;NOW LOOK FOR END MARK
	JSR	PC,NTHENT	;THIS CALL COUNTS THE ENTRIES
	ASR	R4
	NEG	R4		;GET THE HALF WAY ENTRY
	JSR	PC,NTHENT
3$:	BIT	#PERM!TENT,(R1)	;IS IT PERMANENT OR TENTATIVE?
	BNE	2$
	ADD	E.LENG(R1),R5	;NO-INCREASE START BLOCK OF NEW FILE
	JSR	PC,INCR1	;GET NEXT ENTRY
	BR	3$
2$:	MOV	@R1,-(SP)	;SAVE TYPE OF ENTRY
	MOV	#ENDBLK,(R1)	;TERMINATE SEGMENT
	INC	R2		;POINT TO NEW HIGH BLOCK IN DIRECT.
	MOV	USRBUF+2,-(SP)	;SAVE LINK TO NEXT BLOCK
	MOV	R2,USRBUF+2	;LINK TO NEW BLOCK
	JSR	R5,SEGRW2	;WRITE OUT SHORTENED BLOCK
	 11*400			;RE WRITE SEGMENT
	MOV	.USRBU,R0	;NOW CREATE NEW SEGMENT HEADER
	TST	(R0)+		;LEAVE # SEGMENTS OPEN ALONE
	MOV	(SP)+,(R0)+	;GET LINK TO NEXT SEGMENT
	MOV	(SP)+,(R1)	;RESTORE ORIGINAL STATUS
	CMP	(R0)+,(R0)+	;IGNORE HIGH SEG AND # XTRA BYTES
	MOV	R5,(R0)+	;START BLOCK OF TSEGMENT
4$:	MOV	(R1)+,(R0)+	;SLIDE DIRECTORY BUFF UP TO HEADER
	CMP	R1,.USRTO
	BLOS	4$
	MOV	R2,R0		;WRITE OUT NEW DIRECTORY BLOCK
	JSR	R5,SEGRW
	 11*400
	JSR	R5,SEGRW1	;READ IN DBLOCK 1
	 10*400
	INC	USRBUF+4	;UPDATE HIGHEST BLOCK USED
	JSR	R5,SEGRW1	;AND REWRITE THE BLOCK
	 11*400
	DEC	@.DFLG
	CLR	@.BLKEY		;GET CORRECT BLOCK IN CORE
	JMP	RENTR		;RESTART ENTER

NTHENT:	ADDR	USRBUF+10,R1	;GET N'TH ENTRY IN DIRECTORY
	MOV	(R1)+,R5	;INITIAL START BLOCK OF FILES
1$:	BIT	(R1),#ENDBLK	;AT END OF SEGMENT?
	BNE	2$		;YES. EXIT NOW
	ADD	E.LENG(R1),R5	;UPDATE START BLOCK
	JSR	PC,INCR1	;BUMP R1 TO NEXT ENTRY
	INC	R4		;R4 HAS DESIRED ENTRY, IN NEG. FORM
	BNE	1$
2$:	RTS	PC

.SBTTL	GET DEVICE STATUS EMT

; DSTATUS RETURNS THE STATUS OF A PARTICULAR DEVICE IN THE SYSTEM.
; THE 2ND ARGUMENT IS A POINTER TO WHERE THE USER WANTS THE INFORMATION
; R0 -> THE DEVICE NAME IN RAD50. THE INFORMATION RETURNED IS:
;	1-  $STAT TABLE ENTRY
;	2-  SIZE OF DEVICE HANDLER IN WORDS
;	3-  ENTRY POINT OF HANDLER. 0 IF NONRES.
;	4-  SIZE OF DEV DIRECT IN 256 WORD BLOCKS
; R0 -> WORD ONE OF THE BLOCK ON RETURN.

GESTAT:	JSR	R4,LK4DEV	;SEARCH TABLES FOR DEVICE
	 BR	FCE0		;NO SUCH NAME
	MOV	ARGM1,R0	;POINTER TO USERS AREA
	MOV	R0,@SP		;MAKE SURE HE GETS IT BACK
	MOV	@R2,(R0)+	;R2 POINTS TO STATUS TABLE
	ADD	PC,R3		;GET HANDLER SIZE FROM TABLE
1$:	MOV	$HSIZE-.(R3),(R0)+ ;(PIC) AND GIVE IT TO HIM
	MOV	@R5,(R0)+	;ENTRY POINT
	MOV	$DVSIZE-1$(R3),(R0)+
	BR	PHOUT		;EXIT. ONE ARG ON STACK

.SBTTL	DEVICE HANDLER FETCH, DEFINE CHANNELS
PHETCH:	JSR	R4,LK4DEV	;SEARCH FOR R0 FILE DESCRIPTOR
	 BR	FCE0		;NO SUCH DEVICE
	MOV	ARGM1,@SP	;LOAD POINT TO STACK (R0 ON RET.)
	CMP	@SP,#400	;< 400 WILL IMPLY A RELEASE
	BLOS	RLEAS
	MOV	R5,R4		;LK4DEV LEFT R5 AT $ENTRY ENTRY
.IF EQ BF
	TST	(R5)		;IS IT ALREADY RESIDENT?
	BNE	PHOUT		;YES, GO AWAY
.IFF
	TST	@.JOBNUM	;FETCH FROM FG?
	BEQ	1$		;BRANCH IF NOT
	CMP	@R5,@.SYSLO	;IS HANDLER IN BG OR NON-RES.?
	BLO	2$		;YES, THAT'S BAD
1$:	TST	@R5		;IS HANDLER RESIDENT?
	BNE	PHOUT		;YES, GO ON.
.ENDC
	MOV	R3,R2		;COPY DEVICE INDEX
	ADD	PC,R2		;AND IN A PIC WAY
	MOV	$HSIZE-.(R2),R2	;GET HANDLER SIZE
	MOV	@#SYSPTR,R0	;CHECK FOR OVERLAYING RMON
	ADD	R0,R3		;POINT R3 TO $DVREC IN RMON
	ADD	#$DVREC-$RMON,R3
	TST	KMONIN-$RMON(R0) ;IS THE KMON FETCHING ?
	BNE	3$		;YES. ASSUME IT IS CLEVER
	SUB	R2,R0		;MUST LOAD BELOW HERE
	CMP	(SP),R0		;IS IT BELOW THE RMON ?
	BHI	2$		;NO, BOOT HIM
	MOV	.USRBU,R1	;NOW TEST FOR LEGAL LIMITS
	SUB	R2,R1		;LOAD HANDLER. CAN'T OVERRUN
	CMP	(SP),R1		;USR OR RMON
	BLOS	3$
	ADD	#USRLEN*2,R1	;SEE IF IT LOADS ABOVE USR
	ADD	R2,R1		;ADD LENGTH BACK
	CMP	(SP),R1		;R1 NOW POINTS TO TOP OF USR
	BHI	3$
2$:	JSR	R5,COMERR	;ILLEGAL ADDRESS
	 .WORD	FETC.E
3$:	MOV	(R3),R0		;GET RECORD NO OF HANDLER
	BEQ	FCE0A		;0 BLOCK => NO DEVICE
	ADDR	PHLST+6,R5	;POINT TO ARG LIST
	CLR	-(R5)		;WAIT FOR COMPLETION
	MOV	R2,-(R5)	;SIZE IN BYTES
	ASR	(R5)		;SIZE IN WORDS
	MOV	(SP),-(R5)	;LOAD POINT
	JSR	PC,@.$SYS	;READ HANDLER IN
	BCS	2$		;LOAD FAILED
4$:	MOV	(SP),R0		;NOW SET INTERRUPT VECTORS
	MOV	(R0)+,R1	;VECTOR ADDRESS TO R1
	BEQ	6$		;IF 0, DON'T CHANGE VECTOR
	MOV	R0,(R1)
	ADD	@R0,(R1)+	;FILL IN FINAL ADDRESS OF INTERRUPT
	MOV	#PR7,(R1)+	;INTERRUPT STATUS
6$:	CMP	(R0)+,(R0)+	;SKIP INTERRUPT OFFSET & PRIORITY
	MOV	R0,(R4)		;ENTRY POINTS TO LAST Q ENTRY
	ADD	R2,(SP)		;POINT TO ADDRESS ABOVE HANDLER
	MOV	@SP,R2		;MAKE LAST WORD OF HANDLER
	MOV	.$INTEN,-(R2)	; POINT TO $INTEN
PHOUT:	JMP	COMXIT

RLEAS:	CMP	(R5),@.SYSLO	;TRYING TO KILL A RESIDENT DEV?
	BHI	PHOUT		;YES. DON'T DO IT
	CLR	(R5)		;0 ENTRY POINT
	BR	PHOUT

FCE0A:	CLR	(R4)		;ERASE ENTRY POINT
FCE0:	EMTERR+0
	BR	PHOUT


.SBTTL	USR INITIALIZATION FOR LOOKUP, ENTER, RENAME, DELETE
; USRCOM--
; USRCOM IS USED BY LOOKUP/RENAME AND ENTER TO PREPARE A CHANNEL
; FOR I/O OPERATIONS. ON ENTRY, THE STACK POINTS TO THE OLD VALUE
; OF R5, WHICH INDICATES WHETHER AN ENTER, LOOKUP OR RENAME IS
; REQUIRED. USRCOM DOES THE FOLLOWING:
;	TEST TO SEE IF CHANNEL IS OPEN
;	TEST IF SPECIFIED DEVICE IS LEGAL
;	READ FIRST DIRECTORY BLOCK OF THE PROPER DEVICE

.ENABL	LSB

USRCOM:	ASR	R4		;MAKE R4 INTO CHANNEL NUMBER
	MOV	R4,CHNLRG	;SAVE CHANNEL SELECTOR
	TST	(R3)		;CHANNEL ACTIVE?
	BMI	1$		;YES, GIVE ERROR
	CLR	2(R3)		;CLEAR STARTING BLOCK
	MOV	2(SP),R0	;RESTORE R0
	MOV	R5,-(SP)	;NEED TO SAVE REGISTERS 3,5
	MOV	R3,-(SP)
	JSR	R4,LK4DEV	;IS DEVICE IN CORE?
	 BR	COMNDV		;NO SUCH NAME
	BEQ	COMNDV		;NO DEVICE IS THERE!
				;NOTE THAT R0 POINTS TO FILE.EXT
.IF NE	BF
	MOV	R1,R5		;COPY UNIT #
	ASR	R5		; UNIT /2
	ADD	R3,R5		; +2*DEVICE INDEX
	ADD	R3,R5
	ADD	.$OWNER,R5	;POINT TO OWNERSHIP TABLE
	MOVB	@R5,R5		;R5 = OWNERSHIP BYTE
	BIT	#1,R1		;IF UNIT IS ODD,
	BEQ	2$
	ASR	R5		;THEN USE HIGH 4 BITS
	ASR	R5
	ASR	R5
	ASR	R5
2$:	BIC	#177760,R5	;4 BIT FIELD
	BEQ	3$		;0 => PUBLIC
	DEC	R5		;REMOVE GUARD BIT
	CMP	@.JOBNUM,R5	;DO WE OWN IT?
	BNE	COMNDV		;NO, GIVE AN ERROR
.ENDC
3$:	MOV	R3,R5
	MOV	(SP)+,R3	;RESTORE CSW POINTER
	ADD	R5,(R3)
	ADD	#ACTIV$+DBLOK$*1,@R3 ;SET CHANNEL ACTIVE, DBLOCK=1
	MOV	(SP)+,R5
	SWAB	R1		;R1 CONTAINS DEVICE # INDEX
	MOV	R1,C.DEVQ(R3)	;PUT IT INTO CSW BLOCK
	TST	(R2)		;IS IT FILE STRUCTURED?
	BPL	USRNF		;NO. DON'T ALTER CHANNEL WORD
	BIS	(SP),(R3)	;SET RENAME OR DIRECT. REWRITE BIT
	TST	(R0)		;IS THE NAME NULL?
	BEQ	USR3		;IF YES, IT'S NON FILE OP.
	JSR	R5,BLKCHK	;GET A DIRECTORY BLOCK IN CORE
USR2:	TST	(R5)+		;RETURN FOR FILE TYPE OP.
ENXT:	TST	(R5)+
USR3:	RTS	R5

USRNF:	BIT	#SPECL$,(R2)	;IS IT A SPECIAL DEVICE?
	BEQ	USR3
	BIS	(SP),(R3)	;SET REWRITE BIT FOR SPECIAL DEV
	BR	ENXT		;SPECIAL DEVICE EXIT

1$:	MOV	(SP)+,R5	;POP STACK
	BR	FCE0		;GIVE CHANNEL ACTIVE ERROR

COMNDV:	JSR	R5,COMERR	;NO HANDLER THERE
	 .WORD	NODV.E

.DSABL	LSB

.SBTTL	ENTRY MATCH, PUSH

; ENTRY--
; FIND AN ENTRY OF A SPECIFIED TYPE IN A DIRECTORY SEGMENT
; CALLING SEQUENCE:
;	R1  ->	DIRECTORY ENTRY
;	JSR	R5,ENTRY
;	 .WORD	ENTRYTYPE (TENT, EMPTY, OR ENDBLK)
;	 ERROR RETURN - NO ENTRY FOUND
;	NORMAL RETURN
; RETURNS:
;	R1 -> ENTRY OF SPECIFIED TYPE, OR END-OF-BLOCK MARKER
;		IF NO ENTRY IS FOUND

ENTRY:	BIT	@R5,@R1		;A MATCH?
	BNE	USR2		;YES, GET OUT
	BIT	@R1,#ENDBLK	;END OF BLOCK?
	BNE	ENXT		;YES, RETURN
	ADD	E.LENG(R1),(PC)+ ;UPDATE LENGTH
SBLK:	0
	JSR	PC,INCR1	;NEXT ENTRY IN SEGMENT
	BR	ENTRY		;AND LOOP

; PUSH--
; USED TO PHYSICALLY ENLARGE DIRECTORY WHEN AN ENTER IS DONE.

PUSH:	MOV	R3,-(SP)	;SAVE VITAL R3 POINTER
	MOV	R1,R5		;MARK POSITION OF EMPTY
	JSR	R5,ENTRY	;FIND END OF DIRECTORY
	 .WORD	0		;SEARCH FOR NO MASK GETS TO END OF BLOCK!
	MOV	R1,R3		;R3 POINTS TO END OF DATA
	JSR	PC,INCR1	;ONE ENTRY PAST ENDBLK IS WHERE NEW
				;DIRECTORY WILL END
	CMP	(R3)+,(R1)+	;MOVE ALL ENTRIES
2$:	MOV	-(R3),-(R1)
	CMP	R3,R5
	BNE	2$
	MOV	R5,R1		;POINT BACK TO WHERE FILE GOES.
	MOV	(SP)+,R3	;RESTORE R3
	RTS	PC

.SBTTL	CHECK DIR. SEGMENT
; NXBLK GETS THE NEXT IN THE SEQUENCE OF DIRECTORY BLOCKS,
; IF ONE ACTUALLY EXISTS.
NXBLK:	MOV	USRBUF+2,R0	;IS THERE A NEXT BLOCK?
	BEQ	ENRTS		;NO.
	SWAB	R0		;PUT BLOCK # IN PLACE
	BIC	#DBLK$N,R0	;ISOLATE BLOCK NUMBER
	BIC	#DBLK$M,(R3)	;CLEAR OUT BLOCK # IN CSW
	BIS	R0,(R3)
	TST	(R5)+		;SET NORMAL RETURN, FALL INTO BLKCHK

; BLKCHK--
; THIS ROUTINE CHECKS THAT THE DIRECTORY BLOCK NUMBER INDICATED IN
; THE CURRENT CHANNEL STATUS WORD IS ACTUALLY IN CORE.
; IF IT IS NOT, THE IN-CORE POINTERS ARE UPDATED, AND THE
; PROPER BLOCK IS READ INTO CORE.

BLKCHK:	MOV	R0,-(SP)	;SAVE NAME POINTER
	MOV	(R3),R0		;ISOLATE DESIRED BLOCK
	SWAB	R0
	BIC	#177740,R0
	MOV	C.DEVQ(R3),-(SP) ;SEE IF DIRECTORY OF CORRECT DEV
	MOVB	(R3),(SP)	;IS IN CORE. CHECK DEV POINTER,
	BIC	#301,(SP)	;AND DEV. INDEX
	CMP	R0,@.BLKEY	;CORRECT SEGMENT # IN CORE ?
	BNE	1$		;NO, WE MUST READ
	CMP	(SP),@.CHKEY	;CORRECT DEVICE & UNIT ?
	BEQ	2$		;YES, NO NEED TO READ
1$:	MOV	R0,@.BLKEY	;SAVE THE BLOCK IN CORE
	JSR	R5,SEGRW	;READ IT IN
	 10*400			;READ EMT
2$:	MOV	(SP)+,@.CHKEY	;PURGE STACK, SET CHKEY
	ADDR	USRBUF+10,R1	;POINT R1 AT ENTRY HEADER
	MOV	(R1)+,R4	;SAVE FILE START BLOCK
	MOV	(SP)+,R0	;R0 POINTS TO FILE.EXT
ENRTS:	RTS	R5

SEGRW1:	MOV	#1,R0		;USE SEGMENT #1
	BR	SEGRW		;ENTER ROUTINE
SEGRW2:	MOV	@.BLKEY,R0
SEGRW:	ASL	R0		;DIRECT. BLK TO PHYSICAL BLOCK
	ADD	#DOFSET,R0	;OFFSET TO DIRECTORY
	CLR	-(SP)		;ALWAYS WAIT FOR COMPLETION
	MOV	#1000,-(SP)
	MOV	.USRBU,-(SP)	;POINT TO BUFFER ON STACK
	MOV	R0,-(SP)	;LOAD BLOCK NUMBER
	MOV	(PC)+,-(SP)	;CHANNEL NUMBER TO LIST
CHNLRG:	0
	ADD	(R5)+,(SP)	;ADD IN OP CODE
	MOV	SP,R0		;POINT R0 TO LIST
	EMT	375		;AND DO THE EMT
	BCS	IOER		;DEC DIDN'T HURT C BIT
	ADD	#10.,SP		;BACK TO BEFORE ARGS
	RTS	R5

.SBTTL	SPECIAL DEVICES
; SPESHL IS THE HEART AND SOUL OF THE SPECIAL DEVICE FUNCTION PROCESSOR
; CALLING SEQUENCE:
;	JSR	R4,SPESHL
;	 .BYTE	377,FUNCTION
; FUNCTION BYTE IS USED IN A PSEUDO READC TO THE DEVICE HANDLER.
; THE Q MANAGER DETECTS THE 377 IN THE COMPLETION ADDRESS WORD,
; AND STUFFS THE FUNCTION CODE INTO THE FUNCTION BYTE IN THE Q ELEMENT.
; THE HANDLER THEN EXECUTES THE INDICATED JOB.

SPSHL1:	MOV	ARGM1,ARGM2
SPESHL:	BIC	#EOF$+HDERR$,(R3) ; CLEAR END FILE, HARD ERR
	CLR	-(SP)		;MAKE IT SYNCHRONOUS
	MOV	(R4)+,-(SP)	;COMPLETION FUNCTION
	CLR	-(SP)		;0 WORD COUNT
	MOV	8.(SP),-(SP)	;NAME POINTER (BUFFER POINTER)
	ADD	#2,(SP)		;MAY BE ODD IN .CLOSE. POINT TO FILE NAME
	CLR	-(SP)		;0 BLOCK FOR NOW.
	TST	USREMT		;NEW FORMAT EMT?
	BPL	1$		;NO. DO A REWIND
	MOV	ARGM2,(SP)	;FILL IN FILE COUNT
1$:	MOV	CHNLRG,-(SP)	;NOW FORM FUNCTION WORD
	ADD	#10*400,(SP)	;MAKE IT A READ-WAIT
	MOV	SP,R0		;POINT R0 TO OUR ARG. LIST
	EMT	375		;READW
	BCS	IOER		;IO ERROR SOMEWHERE
	ADD	#12.,SP		;CLEAN OFF STACK
	CLR	@.BLKEY		;NO DIRECTORY IN CORE
	MOV	@.SPUSR,-(SP)	;WAS THERE A SOFTWARE ERROR?
	NEG	(SP)+		;SET CARRY IF SO (NON-0)
	RTS	R4

IOER:	JSR	R5,COMERR	;M ERROR 5
	.WORD	DIRI.E

.SBTTL	DIRECTORY CONSOLIDATOR
; CONSOL REMOVES ANY UNNECESSARY ENTRIES FROM A GIVEN DIRECTORY.
; THIS IS DONE BEFORE AN ENTER AND AFTER A CLOSE.
; UNNECESSARY ENTRIES COME IN SEVERAL FLAVORS:
;	A) UNASSOCIATED TENTATIVE ENTRIES
;	B) MULTIPLE CONSECUTIVE EMPTIES
;	C) EMPTIES OF LENGTH 0 FOLLOWING A PERMANENT ENTRY
;
; CONSOL MAKES TWO PASSES OVER THE DIRECTORY SEGMENT.
; IN PASS 1, UNASSOCIATED TENTATIVES ARE MADE INTO EMPTIES.
; IN PASS 2, CONSECUTIVE EMPTIES ARE CONSOLIDATED AND
; EMPTY ENTRIES PRECEEDED BY A PERMANENT ENTRY ARE DELETED.

CONSOL:	MOV	R4,-(SP)	;SAVE ACTIVE REGISTERS
	MOV	R3,-(SP)
	MOV	R1,-(SP)	;R1 POINTS TO TOP OF DIRECTORY
	MOV	#16,R4		;PUT ENTRY SIZE INTO R4
	ADD	USRBUF+6,R4
1$:	JSR	R5,ENTRY	;GET A TENTATIVE ENTRY
	 TENT
	 BR	14$		;NO MORE. DO PASS 2
.IF NE	BF
	MOVB	E.JNUM(R1),R2	;GET JOB # OF TENTATIVE
	ADD	.$IMPUR,R2
	MOV	@R2,R2		;R2 -> IMPURE AREA OF CREATOR
	BEQ	3$		;NO JOB, SO TENTATIVE IS UNUSED
.IFTF
	CLR	R5		;GET CHANNEL NUMBER
	BISB	E.CHAN(R1),R5	; IN R5
.IFT
	CMPB	I.CNUM(R2),R5	;LEGAL CHANNEL FOR JOB?
	BLOS	3$		;NO
	CMP	@.CNTXT,R2	;IS THIS OUR TENTATIVE?
	BNE	2$		;NO
.IFF
	CMPB	@.I.CNU,R5	;COMPARE WITH MAX CHAN. #
	BLOS	3$
.IFTF
	CMPB	CHNLRG,R5	;YES. IS TENTATIVE ON THIS CHANNEL?
	BEQ	3$		;YES, CLOBBER IT
2$:	ASL	R5		;CHANNEL * 10.
	MOV	R5,-(SP)
	ASL	R5
	ASL	R5
	ADD	(SP)+,R5
.IFT
	ADD	I.CSW(R2),R5	;R5 -> CHANNEL OF TENTATIVE
.IFF
	ADD	@.I.CSW,R5	;R5 -> CHANNEL OF TENTATIVE
.ENDC
	TST	@R5		;IS ASSOCIATED CHANNEL OPEN?
	BPL	3$		;NO, TENT. IS INVALID
	MOV	C.DEVQ(R5),R2	;GET UNIT # IN HIGH ORDER
	CLRB	R2
	BISB	@R5,R2		;ASSEMBLE DEVICE INDEX
	BPL	3$		;OOPS, ASSOCIATED CHANNEL IS LOOKED UP
	BIC	#301,R2		;R2 = CHKEY FOR TENTATIVE'S CHANNEL
	CMP	@.CHKEY,R2	;SAME DEVICE AND UNIT?
	BEQ	4$		;YES, TENT.'S CHANNEL STILL OPEN ON
				; THIS PARTICULAR TENTATIVE
3$:	MOV	#EMPTY,@R1	;CONVERT TENT. TO EMPTY
4$:	ADD	R4,R1		;NEXT ENTRY
	BR	1$

14$:	MOV	(SP),R1		;POINT R1 BACK TO TOP
5$:	JSR	R5,ENTRY	;GET AN EMPTY ENTRY
	 EMPTY
	 BR	CNSLOV		;DONE. GET OUT
	MOV	R1,R2
	ADD	R4,R2		;POINT R2 TO NEXT ENTRY
	BIT	#EMPTY,(R2)	;IS IT EMPTY?
	BEQ	7$		;NO. CHECK FOR EMPTY OF LTH 0
	ADD	E.LENG(R2),E.LENG(R1)	;COMBINE LENGTHS.
; SQUEEZE THE DIRECTORY
6$:	MOV	R2,R5		;THE ENTRY AT R2 WILL BE CRUNCHED
	ADD	R4,R5		;ONE ENTRY BEYOND
	MOV	R1,-(SP)	;SAVE R1
	JSR	R5,ENTRY	;GET END OF DIRECTORY MARK
	 .WORD	0		;SEARCH FOR 0 FINDS END OF BLOCK
	MOV	R1,R3		;R3 POINTS TO END MARK
12$:	MOV	(R5)+,(R2)+	;SQUEEZE THE ENTRY
	CMP	R5,R3
	BLOS	12$
	MOV	(SP)+,R1	;RESTORE R1
	BR	5$

7$:	TST	E.LENG(R1)	;IS IT LENGTH 0?
	BNE	8$		;NO. GET NEXT ENTRY
	MOV	R1,R2		;SEE IF PREVIOUS IS PERMANENT
	MOV	R1,R3
	SUB	R4,R3
	CMP	R3,.USRBO	;DOING FIRST ENTRY IN DIRECT?
	BLO	8$		;YES. GET NEXT ENTRY
	BIT	#PERM,(R3)	;PERMANENT ENTRY?
	BNE	6$		;YES, SQUEEZE IT OUT
8$:	ADD	R4,R1		;ADVANCE TO NEXT ENTRY
	BR	5$

CNSLOV:	MOV	R1,(PC)+		;SAVE POSITION OF END OF DIRECT
DREND:	0
	MOV	(SP)+,R1
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	RTS	PC

.SBTTL	DEVICE NAME SEARCH SR.
; THIS ROUTINE LOOKS UP A DEVICE NAME IN THE SYSTEM TABLES.
; IF THE DEVICE NAME IS ASSIGNED, THE ASSOCIATED PERM NAME IS USED.
; CALLING SEQUENCE:
;	R0 -> DEVICE NAME BLOCK
;	JSR   R4,LK4DEV
;	 ERROR RETURN
;	NORMAL RETURN
; RETURNS:
;	R0 -> FILENAME IN BLOCK
;	R1 =  UNIT #
;	R2 -> $STAT WORD
;	R3 =  DEVICE INDEX #
;	R5 -> $ENTRY WORD
;	COND.CODES SET FROM $ENTRY WORD

LK4DEV:	MOV	(R0)+,R5	;GET NAME IN R5, ADVANCE R0
	BEQ	7$		;NULL NAME GIVES ERROR RETURN
	MOV	.$UNAM,R1	;POINT TO LIST OF USER NAMES
	MOV	#$SLOT+3,R3	;COUNTER IN R3
1$:	DEC	R3		;DONE USER NAME TABLE ?
	BEQ	2$		;YES
	CMP	R5,(R1)+	;MATCH THIS ENTRY ?
	BNE	1$		;NO, KEEP TRYING
	MOV	$UNAM1-$UNAM2-2(R1),R5 ;GET ASSOCIATED PERM NAME
2$:	MOV	.$PNAM,	R2	;POINT TO PERM NAME TABLE
	CMP	-(R2),-(R2)	;2 WORDS BEFORE TABLE
	MOV	#-2,R3		;CLEAR SLOT COUNTER
3$:	MOV	R5,R1		;GET SEARCH OBJECT
	SUB	(R2)+,R1	;TRY THIS ENTRY
	BLO	4$		;NO, ENTRY TOO HIGH
	BEQ	5$		;EXACT MATCH
	SUB	(PC)+,R1	;TRY RANGE OF 0-7 UNIT
	 .RAD50	/  0/
	BLO	4$		;NOT IN RANGE
	CMP	R1,#7
	BLOS	5$		;GOT IT
4$:	INC	R3		;INCREMENT SLOT #
	CMP	R3,#$SLOT	;TOO MANY ?
	BLT	3$		;NOT YET
	RTS	R4		;NOT FOUND. TAKE ERROR RETURN

5$:	ASL	R3		;DOUBLE DEVICE INDEX
	BPL	55$		;POSITIVE MEANS NOT DK OR SY
	MOV	@.SYINDX,R3	;GET INDEX OF SYSTEM DEVICE
55$:	MOV	.$ENTR,R5	;POINT TO ENTRY POINT TABLE
	ADD	R3,R5		;INDEX TO PROPER ENTRY
	MOV	R5,R2		;COPY THAT POINTER
	ADD	#$STAT-$ENTRY,R2 ;AND POINT R2 TO STATUS ENTRY
	TST	(R4)+		;TAKE THE SUCCESS RETURN
	TST	(R5)		;SET COND CODE ON WHETHER HANDLER IS IN
7$:	RTS	R4		;RETURN

.SBTTL	CLOSE PROCESSOR

.ENABL	LSB

KLOSE:	ASR	R4		;MAKE INTO A REAL CHANNEL
	MOV	R4,CHNLRG
	MOV	(R3),R5		;SEE IF THIS IS SPECIAL
	BIC	#177701,R5
	ADD	.$STAT,R5
	BIT	#SPECL$,(R5)
	BNE	10$		;DO SPECIAL CLOSE
	CLR	2(R3)		;CLEAR ST BLOCK FOR READ/WRITE
	JSR	R5,BLKCHK	;GET A DIRECTORY BLOCK IN CORE.
	BR	2$		;AND ENTER LOOP
1$:	JSR	R5,NXBLK	;GET NEXT DIR BLOCK
	 BR	CLSOUT		;CANNOT FIND THAT TENTATIVE
2$:	JSR	R5,ENTRY	;FIND AN ENTRY 'TENTATIVE'
	 TENT
	 BR	1$		;NOT IN THIS BLOCK
.IF NE	BF
	CMPB	E.JNUM(R1),@.JOBNUM ;DOES TENTATIVE BELONG TO US?
	BNE	3$		;NO
.ENDC
	CMPB	E.CHAN(R1),CHNLRG ;TENTATIVE ON THIS CHANNEL?
	BEQ	CLOCOM		;YES. PROCESS IT
3$:	JSR	PC,INCR1	;R1 TO NEXT ENTRY
	BR	2$

CLOCOM:	ADDR	FNAME,R0	;PUT FILE NAME IN PERMANENT PLACE
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	MOV	(R1)+,(R0)+
	MOV	@R1,@R0		;MOVE EXTENSION
	CMP	-(R0),-(R0)	;POINT R0 TO NAME
	SUB	#6,R1		;R1 TO STATUS ENTRY
	MOV	R1,-(SP)
	MOV	(R3),-(SP)	;SAVE FOR RE-READ OF THIS FILE
	BIC	#DBLK$N,(SP)	;ISOLATE SEGMENT NUM.
	BIC	#DBLK$M,(R3)	;START SEARCH AT BLOCK 1
	ADD	#DBLOK$,(R3)
	JSR	R5,DLEET	;FIND OLD (PERMANENT) COPY
	 BR	4$		;NONE TO DELETE
	MOV	#EMPTY,(R1)	;DELETE THE ONE WE FOUND
	MOV	(R3),R1		;SEE IF WE'RE IN SAME SEGMENT
	BIC	#DBLK$N,R1	;ISOLATE SEGMENT BITS
	CMP	R1,(SP)
	BEQ	4$		;YES. DON'T REWRITE SEGMENT
	INC	@.DFLG		;NO. HOLD OFF ^C
	JSR	PC,CLOSUP	;CONSOLIDATE AND REWRITE SEGMENT
4$:	BIC	#DBLK$M,(R3)	;PUT RIGHT SEG.
	BIS	(SP)+,(R3)	;BACK INTO CSW WORD
	JSR	R5,BLKCHK	;GET CORRECT BLOCK INTO CORE
	MOV	(SP)+,R1	;POINT TO ENTRY 
	MOV	#PERM,(R1)	;MAKE IT PERMANENT
	BIT	#RENAM$,(R3)	;RENAME?
	BNE	5$		;YES. LEAVE LENGTHS ALONE
	ADD	#E.LENG,R1	;OFFSET R1 TO LENGTH WORD
	MOV	@R1,R2		;NO, GET ALLOCATED LENGTH
	MOV	C.USED(R3),@R1	;CHANGE FILE ENTRY TO AMOUNT USED
	SUB	@R1,R2		;R2 NOW HAS UNUSED PORTION
	JSR	PC,INCR1	;POINT TO TRAILING EMPTY
	ADD	R2,@R1		;RECLAIM UNUSED SPACE
CLSQSH:	JSR	PC,CLOSUP	;CONSOLIDATE AND REWRITE
	CLR	@.DFLG		;ALLOW ^C
CLSOUT:	JMP	DELOUT

INCR2:	MOV	PC,-(SP)	;TWICE AROUND THE LOOP
INCR1:	ADD	USRBUF+6,R1
	ADD	#16,R1
	RTS	PC

; THIS ROUTINE CONSOLIDATES A DIRECTORY SEGMENT AND REWRITES IT.
CLOSUP:	MOV	R0,-(SP)	;SAVE FNAME POINTR
	MOV	.USRBO,R1	;BOTTOM OF SEGMENT BUFFER
	JSR	PC,CONSOL	;CONSOLIDATE THE SEGMENT
	JSR	R5,SEGRW2	;RE WRITE THE SEGMENT
	 11*400
	MOV	(SP)+,R0
	RTS	PC

5$:	TST	(R1)+
	MOV	(R0)+,(R1)+	;RE-INSERT RENAMED FILENAME
	MOV	(R0)+,(R1)+
	MOV	(R0)+,(R1)+
	BR	CLSQSH		;CLEAN UP AND GET OUT

10$:	JSR	R4,SPESHL	;DO SPECIAL DEVICE STUFF
	 .BYTE	377,CLOS..
	BR	CLSOUT

.DSABL	LSB

.SBTTL	DLEET - LOCATE PERM FILE IN DIRECTORY

;DLEET--
; DLEET IS USED TO LOCATE A PERMANENT FILE OF A GIVEN NAME
; CALLING SEQUENCE:
;	R0  ->	FILE NAME.EXT TO BE FOUND
;	JSR	R5,DLEET
;	 ERROR RETURN - NO SUCH FILE
;	NORMAL RETURN
; RETURNS:
;	R1  ->	DIRECTORY ENTRY FOR FILE (STATUS WORD)
; DESTROYS: R2

DLEET:	MOV	R0,-(SP)	;SAVE FILE POINTER
	JSR	R5,BLKCHK
10$:	MOV	(SP),R0		;RESTORE POINTER
	JSR	R5,ENTRY	;GET A PERM ENTRY
	 PERM
	 BR	4$		;NOPE. SEE IF MORE
	TST	(R1)+		;POINT TO NAME
	MOV	R1,R2
	ADD	#6,R2		;R2 -> END OF NAME
1$:	CMP	(R0)+,(R1)+
	BNE	3$		;MISMATCH.
	CMP	R1,R2		;DONE?
	BNE	1$
	SUB	#10,R1		;RESET R1 TO STATUS WORD.
	TST	(R5)+
2$:	MOV	(SP)+,R0
	RTS	R5

3$:	MOV	R2,R1		;GET TO NEXT ENTRY
	ADD	(R1)+,SBLK	;COMPUTE START BLOCK FOR LOOKUP
	CMP	(R1)+,(R1)+
	ADD	USRBUF+6,R1
	BR	10$

4$:	JSR	R5,NXBLK
	 BR	2$		;NO MORE AT ALL!
	BR	10$		;START A NEW SEGMENT

.IF EQ	BF
.ENABL	LSB

	.SBTTL	RESET, RMON PTRS.

RSTSR:	BNE	3$		;R0 NOT 0 MEANS SOFT RESET
1$:	TST	@.TTOBU		;WAIT FOR RING BUFF TO EMPTY
	BNE	1$
2$:	INC	(PC)+		;WAIT FOR 11/05
	0
	BNE	2$
	RESET			;STOP ALL IO
	TST	@.CONFI		;DO WE HAVE A CLOCK?
	BPL	3$		;NO.
	MOV	(PC),@#LKCS	;YES. TURN ON INTERRUPTS
3$:	MOV	#15.*5,R1	;RESET TO NORMAL CHANNELS
	BIT	#OVLY$,@#JSW	;OVERLAYS THERE?
	BNE	4$
	ADD	#5,R1		;NO. CLEAR ALL 16 CHANNELS.
4$:	MOV	.$CSW,R2	;RESET TO NORMAL CSW AREA
	MOV	R2,@.I.CSW
5$:	CLR	(R2)+
	DEC	R1
	BNE	5$

CLRHND:	MOV	.$ENTR,R2	;NOW ZAP NON RESIDENT HANDLERS
	MOV	#$SLOT,R1
6$:	CMP	(R2),@.SYSLO	;IS THIS LOADED OR SY:?
	BLO	7$		;NO. ZERO IT'S $ENTRY SLOT
	CLR	@(R2)+		;YES. CLEAR BUSY FLAG
	BR	8$
7$:	CLR	(R2)+
8$:	DEC	R1
	BNE	6$
QRESET:	MOV	.QSIZE,R1	;ADD. OF QSIZE TO R1
	CMP	(R1)+,(R1)	;IS IO QUIESCENT?
	BLO	QRESET		;NO. WAIT A WHILE
	MOV	#1,-(R1)	;SIZE IS ONE ELEMENT
	MOV	(R1)+,(R1)+	;ALSO ONE ELEMENT AVAILABLE.
	MOV	R1,(R1)		;POINT AVAIL TO THE Q
	ADD	#2,(R1)
.IF NDF	$RXPRO							;###
	MOV	@.TTKS,-(SP)	;SET BIT ON FOR OUTPUT
	BIS	#IENABL,@(SP)+
.IFTF								;###
	RTS	PC
.IFF								;###
	.BLKW	4						;###
.ENDC	;$RXPRO							;###


.DSABL	LSB

.ENDC
.SBTTL	USR TABLES
; THIS IS A LIST OF POINTERS TO VARIOUS LOCATIONS IN THE RESIDENT.
; THE USR SETS UP THIS TABLE EACH TIME IT IS REREAD
; FROM THE DEVICE. THE LOCATIONS GET FILLED WITH THE ABSOLUTE
; ADDRESSES THEY REPRESENT.

RELIST:
.USRLO:	.WORD	USRLOC-$RMON	;USRLOC
.KMLOC:	.WORD	KMLOC-$RMON	;KMLOC
.$USRL:	.WORD	$USRLC-$RMON	;$USRLC
.$KMLO:	.WORD	$KMLOC-$RMON	;$KMLOC
.SYSLO:	.WORD	SYSLOW-$RMON	;SYSLOW
.USRBU:	.WORD	USRBUF-$RMON	;START OF DIR BUFFER
.USRBO:	.WORD	USRBUF+12-$RMON	;START OF DIR BUFFER+12
.USRTO:	.WORD	USRBUF+2000-$RMON ;END OF BUFFER
.MONOU:	.WORD	MONOUT-$RMON	;MONOUT
.$CSW:	.WORD	$CSW-$RMON	;$CSW
.$UNAM:	.WORD	$UNAM2-$RMON	;$UNAM2
.$ENTR:	.WORD	$ENTRY-$RMON	;$ENTRY
.SYINDX:.WORD	SYINDX-$RMON
.BLKEY:	.WORD	BLKEY-$RMON	;BLKEY
.CHKEY:	.WORD	CHKEY-$RMON	;CHKEY
.$DATE:	.WORD	$DATE-$RMON	;$DATE
.DFLG:	.WORD	DFLG-$RMON	;ABORT HOLDOFF FLAG
.$SYS:	.WORD	$SYS-$RMON	;MONITOR IO ENTRY POINT
.$SWPB:	.WORD	$SWPBL-$RMON	;$SWPBL
.$STAT:	.WORD	$STAT-$RMON
.$PNAM:	.WORD	$PNAME-$RMON
.SPUSR:	.WORD	SPUSR-$RMON
.CORPT:	.WORD	CORPTR-$RMON	;POINTER TO FREE CORE LIST
.$INTEN:.WORD	$INTEN-$RMON
.MAXBL:	.WORD	MAXBLK-$RMON	;MAXIMUM SIZE FOR ENTER

.IF EQ	BF
.TTOBU:	.WORD	TTOBUF+2-$RMON	;OUTPUT RING BUFFER COUNT
.I.CSW:	.WORD	I.CSW-$RMON	;POINTER TO CHANNEL POINTER
.CONFI:	.WORD	CONFIG-$RMON	;CONFIGURATION WORD
.I.CNU:	.WORD	I.CNUM-$RMON	;MAXIMUM CHANNEL NUMBER
.RECUR:	.WORD	RECURS-$RMON	;RECURS
.QSIZE:	.WORD	QSIZE-$RMON	;ADDRESS OF Q SIZE WORD
.TTKS:	.WORD	TTKS-$RMON
.IFF
.$OWNE:	.WORD	$OWNER-$RMON	;OWNERSHIP TABLE FOR DEVICES
.CNTXT:	.WORD	CNTXT-$RMON	;CURRENT CONTEXT
.$IMPUR:.WORD	$IMPUR-$RMON	;TABLE OF IMPURE POINTERS
.JOBNUM:.WORD	JOBNUM-$RMON	;CURRENT JOB NUMBER
.CSIER:	.WORD	CSIERR-$RMON	;MONITOR ENTRY POINT FOR CSI ERRORS
.ENDC

ENDLST:

PHLST:	.WORD	0		;LIST USED FOR FETCH. THE FIRST
FNAME:	BSS	4		;WORD IS ALWAYS 0. FNAME IS USED
				;BY THE RENAME DIRECTIVE.

; THE FOLLOWING TABLES ARE FILLED BY THE HANDLR MACRO CALLS IN RMON
; $HSIZE IS A TABLE WHOSE ENTRIES ARE THE SIZES OF EACH DEVICE
; HANDLER IN BYTES.

$HSIZE:	BSS	$SLOT

; $DVSIZ IS A TABLE WHOSE ENTRIES ARE THE DIRECTORY SIZES FOR
; EACH FILE STRUCTURED DEVICE IN THE SYSTEM

$DVSIZ:	BSS	$SLOT

.SBTTL	QUEUE EXTEND EMT

QSET:	MOV	R0,R5		;NUMBER OF ADDITIONAL ENTRIES
	BLE	QSOUT		;JUST FOOLING AROUND!
	MOV	ARGM1,R1	;ADDRESS OF FIRST NEW ENTRY
	MOV	R1,R4		;WE'LL LINK AVAIL TO THIS SOON
.IF NE	BF
	MOV	@.CNTXT,R2	;R2 -> CURRENT CONTEXT
	TST	(R2)+		;R2 -> AVAIL QUEUE HEAD
.IFF
	MOV	.QSIZE,R2	;POINT R2 AT AVAIL
	CMP	(R2)+,(R2)+
.ENDC
				;WHERE AVAIL POINTS NOW,
				;WE'LL POINT NEW LIST TO SAME PLACE
1$:	MOV	R1,R3
	ADD	#16,R1
	MOV	R1,(R3)
	DEC	R0
	BNE	1$		;KEEP LINKING
.IIF NDF	$RXPRO,	SPL	7 ;CAN'T ABIDE ANY INTERRUPTS HERE ;###
.IIF DF	$RXPRO,	DSAR$S		;DISABLE AST'S			;###
	MOV	(R2),(R3)	;POINT OUR LIST TO WHERE AVAIL GOES
	MOV	R4,(R2)		;AND LINK AVAIL TO OUR LIST
.IF EQ	BF
	ADD	R5,-(R2)	;INCREASE FREE AND TOTAL COUNT
	ADD	R5,-(R2)
.ENDC
.IIF NDF	$RXPRO,	SPL	0 ;BACK TO LEVEL 0		;###
.IIF DF	$RXPRO,	ENAR$S		;ENABLE AST'S			;###
	MOV	R1,(SP)		;R0 POINTS TO NEXT FREE CORE
QSOUT:	JMP	COMXIT

.SBTTL	COMMAND STRING INTERPRETER

CSI:	MOV	#13,R1		;COUNT OF THINGS TO SAVE
	ADDR	STKSAV,R2	;SETUP POINTER TO STACK SAVE AREA
1$:	MOV	(SP)+,-(R2)	;SAVE THE STACK STUFF (BACKWARDS)
	DEC	R1		;ANY MORE ??
	BNE	1$		;YES
				;NOTE - R2 -> CSI BUFFER NOW!
	MOV	SP,STKLVL	;SAVE SP FOR POSSIBLE RESTART
	MOV	R4,EMTMOD	;SAVE MODE FLAG. SPECIAL MODE?
RESTRT:	BNE	2$		;DON'T CLOSE CHANNELS IN SPECIAL MODE
	MOV	#6*400+10,R5	;CLOSE CHANNELS 10-0
1$:	MOV	R5,R0		;ISSUE CLOSE
	EMT	374
	DECB	R5		;CHANNEL 0?
	BPL	1$		;DO 'EM ALL
2$:	MOV	R2,R5		;COPY BUFFER POINTER FOR LATER
	MOV	STRING,R3	;GET STRING ADDRESS
.IF EQ	BF
	BNE	3$		;DON'T PRINT * IF FROM CORE
	MOV	.$ENTR,R0	;R0 -> $ENTRY TABLE
	MOV	BA.NUM(R0),R0	;R0 -> BA.SYS ENTRY
	BEQ	20$		;BR IF NOT IN MEMORY
	TST	6(R0)		;IS BATCH RUNNING?
	BNE	3$		;YES, SKIP PROMPT CHAR
20$:	.TTYOUT	#'*		;PROMPT USER WITH A *
.ENDC
3$:	MOV	#74.,R1		;SETUP COUNTER (72 CHARS)
	CLR	R4		;CLEAR OUTPUT FILES SWITCH
4$:	TST	R3		;WHERE DOES INPUT COME FROM ?
	BEQ	8$		;THE TELETYPE
	MOVB	(R3)+,R0	;GET CHAR FROM THE STRING
	BIC	#177600,R0	;ONLY USE SEVEN BITS
	BEQ	9$		;TERMINATE ON ZERO CHAR
5$:	CMP	#'=,R0		;CHECK FOR EQUALS
	BEQ	6$		;YES
	CMP	#'<,R0		;< SAME AS =
	BNE	7$		;NO
	INC	R0		;REPLACE < WITH =
6$:	COM	R4		;PREVIOUS =  ???
	BNE	7$		;FIRST TIME IS OK
	CLR	R1		;SET TO GIVE ERROR LATER
7$:	DEC	R1		;COUNT DOWN CHARACTERS
	BLE	4$		;IGNORE IF NO ROOM
	MOVB	R0,-(R2)	;PUT CHAR INTO BUFFER (BACKWARDS)
	BR	4$		;GO GET NEXT CHAR

8$:	.TTYIN			;GET CHAR FROM SYS TTY HANDLER
	CMP	#CR,R0		;IS IT A CARRIAGE RETURN ?
	BEQ	8$		;YES, IGNORE IT
	CMP	#LF,R0		;IS IT LF?
	BNE	5$		;NO, PROCEED
9$:	TST	R1		;OVERFLOW ?
	BLE	SYNERR

.SBTTL	GET FILE DESCRIPTORS AND OPEN FILES
	CLRB	-(R2)		;REPLACE CR WITH ZERO BYTE
				;NOTE R5 -> CSIBUF = HANSPC !
	MOV	@R5,R2		;IF SPECIAL MODE GET ADDR OF OUTPUT AREA
	MOV	R2,REG0		;IF GENERAL, GET HANDLER SPACE ADDRESS
	TST	EMTMOD		;IS IT SPECIAL MODE ??
	BEQ	11$		;NO, DON'T CLEAR OUTPUT AREA
	MOV	#39.,R1		;COUNT
	MOV	R2,R3		;COPY POINTER
10$:	CLR	(R3)+		;CLEAR
	DEC	R1		;MORE ?
	BNE	10$		;YES
11$:	CLR	R3		;FILE COUNTER
	CLR	SWTCNT		;SWITCH COUNTER
	TST	R4		;INPUT LIST ONLY ??
	BNE	GETDE		;NO, START WITH OUTPUT FILES
STRTIN:	MOV	#3,R3		;BEGIN INPUT LIST
	MOV	HANSPC,R2	;SET FILE NUM = 3 AND R2 TO
	ADD	#36,R2		;START OF OUTPUT SPACE (SPECIAL MODE)
	CLR	R4		;SET SWITCH TO INPUT
GETDE:	MOV	DEFEXT,R1	;GET ADDRESS OF DEFAULT EXTENSIONS
	MOV	#15270,DEV1	;USE DEFAULT DEVICE "DK"
NXTFIL:	CMP	R3,#10		;HOW MANY FILES?
	BGT	SYNERR		;TOO MANY.
	TST	R4		;OUTPUT OR INPUT FILES ??
	BEQ	6$		;INPUT
	TST	(R1)+		;OUTPUT FILES, GO TO NEXT EXTENSION
6$:	TST	(PC)+		;GENERAL OR SPECIAL MODE ?
EMTMOD:	0
	BNE	SPECAL		;SPECIAL, NO FETCH, ENTER, OR LOOKUP
	ADDR	FILDES,R2	;SETUP POINTER TO FILE DESCRIPTOR
	JSR	PC,GETFD	;GET THE FILE DESCRIPTOR
	TST	(R0)		;WAS IT A NULL FILE ?
	BEQ	SWITCH		;YES
	MOV	R0,-(SP)	;SAVE R0
	MOV	REG0,-(SP)	;HANDLER SPACE ADDRESS
	EMT	343		;FETCH THE HANDLER
	BCS	HANERR		;ERROR ON FETCH
	MOV	R0,REG0		;NEW HANDLER SPACE ADDR
	MOV	R0,HANSPC	;CAN'T GO LOWER NOW!
	MOV	(SP)+,R0	;POINTER TO F.D. FOR LOOKUP OR ENTER
	TST	R4		;INPUT OR OUTPUT
	BEQ	INFILE		;INPUT, NO OUTPUT CHECKS
	JSR	PC,OUSTUF	;GO HANDLE SOME OUTPUT FILE CHECKS
	MOV	(R2),-(SP)	;PUSH SIZE ONTO STACK
	MOV	#EMT+40,-(SP)	;BUILD THE EMT
	ADD	R3,@SP		;BAD TECHNIQUE
	MOV	(SP)+,@PC	; BADDDDD
	 HALT
	BCC	SWITCH		;GO LOOK FOR SWITCHES
	CSIERR	<DEV FUL>,3
SPECAL:	JSR	PC,GETFD	;GET FILE DESCRIPTOR
	TST	R4		;INPUT OR OUTPUT
	BEQ	SWITCH		;INPUT, GET SWITCHES
	TST	(R0)		;NULL OUTPUT FILE?
	BEQ	1$		;YES.
	JSR	PC,OUSTUF	;HANDLE SOME OUTPUT FILE CHECKS
1$:	TST	(R2)+		;BUMP POINTER
	BR	SWITCH		;AND GO LOOK FOR SWITCHES
INFILE:	MOV	#EMT+20,-(SP)	;MAKE THE EMT
	ADD	R3,@SP		;PUT IN THE FILE NUMBER
	MOV	(SP)+,@PC	;BAD TECHNIQUE
	 HALT			;LOOKUP THE FILE
	BCC	SWITCH		;FOUND IT. GO DO SWITCHES
	CSIERR	<FIL NOT FND>,4	;GIVE ERROR

.SBTTL	GET SWITCHES
; THIS IS HERE SO EVERYBODY CAN REACH SYNERR
NOSWIT:	INC	R3		;INCREMENT FILE NUMBER
	CMPB	@R5,#',		;LOOK FOR A COMMA
	BEQ	NXTFIL		;YES, GET NEXT FILE
	CMPB	@R5,#'=		;LOOK FOR EQUALS
	BEQ	STRTIN		;START INPUT LIST
	MOV	(PC)+,-(SP)	;PREPARE TO FIND A NULL BYTE
SWTCNT:	0
	TSTB	(R5)		;IS IT A CR ??
	BEQ	RETURN		;YES. GO HOME
SYNERR:	CSIERR	<ILL CMD>,0
HANERR:	CSIERR	<ILL DEV>,1

.ENABL	LSB

5$:	TST	R0		;NO ! OR :. IS THERE NO VALUE AT ALL?
	BMI	SWITCH		;AN EARLIER VALUE
	MOV	R0,-(SP)	;NO VALUE. JUST STUFF IT
	INC	SWTCNT		;INCREMENT COUNT OF SWITCHES
SWITCH:	CMPB	(R5),#'/	;CHECK FOR /  START OF SWITCH
	BNE	NOSWIT		;NO SWITCH IF NO /
	MOVB	-(R5),R0	;GET SWITCH CHAR AND SAVE IT
	BEQ	SYNERR		;ERROR IF CR
	SWAB	R0		;SWAP SWITCH CHAR TO ODD BYTE
	ADD	R3,R0		;ADD IN FILE NUMBER
	SWAB	R0		;SWAP IT BACK
	DEC	R5		;MOVE TO VALUE DELIMITER
10$:	CMPB	@R5,#'!		;DECIMAL SWITCH?
	SEC			;(SET CARRY FOR CALL)
	BEQ	1$		;YES, GO GET IT
	CMPB	@R5,#':		;IS THERE AN OCTAL VALUE (:XXXXX)
	BNE	5$		;NO, THERE AIN'T
	CMPB	#'A-1,-1(R5)	;CHECK FOR OCTAL OR RAD50
	BLO	2$		;ALPHA => RAD50
1$:	JSR	PC,CVTNUM	;CONVERT OCTAL OR DECIMAL NUMBER
	BR	3$
2$:	MOV	R2,-(SP)	;SAVE R2
	MOV	SP,R2		;RAD50 PACK RETURNS IN @R2
	MOV	@SP,-(SP)	;SAVE R2 FOR REAL, NOW
	MOV	R0,-(SP)	;AND R0
	JSR	PC,GETNM1	;PACK IT UP
	MOV	(SP)+,R0	;RESTORE R0
	MOV	(SP)+,R2
3$:	BIS	#100000,R0	;SET VALUE FLAG
	MOV	R0,-(SP)	;PUT STUFF ONTO STACK
	INC	SWTCNT		;INCREMENT COUNT OF SWITCHES
	BR	10$		;LOOK FOR ANOTHER SWITCH

.DSABL	LSB

.SBTTL	RETURN AND ERROR PROCESSING
CSIER1:	BIS	#1,SAVSTK	;SET CARRY IN PS
RETURN:	MOV	#10,R2		;COUNT FOR STACK RESTORATION
	ADDR	SAVSTK,R1	;SETUP POINTER
1$:	MOV	(R1)+,-(SP)	;RESTORE STACK ELEMENT
	DEC	R2		;MORE ??
	BNE	1$		;YES
				;NOTE R2=0 => NO ARGS TO POP
.IF NE	BF
	MOV	@.CNTXT,-(SP)	;TURN OFF BIT THAT SUPPRESSES ADDR CHK
	BIC	#CSIRN$,@(SP)+	; IN THE JOB'S JSTAT
.ENDC
	JMP	@.MONOU		;RETURN TO RESIDENT.

; THIS IS THE CSI ERROR ROUTINE
MSG:	MOV	(PC)+,SP	;RESTORE STACK (ELIMINATE JUNK)
STKLVL:	0
	MOVB	(R0)+,@#ERRBYT
	TST	STRING		;WHERE DID INPUT COME FROM ??
	BNE	CSIER1		;FROM INSIDE, NO RESTART
	.PRINT			;OUTPUT STRING
.IF EQ	BF
	ADDR	CSIBUF,R2	;POINT TO BUFFER AGAIN
	TST	EMTMOD		;SET COND. CODE FOR MADE
	JMP	RESTRT		;TRY AGAIN (GET NEW LINE FROM TTY)
.IFF
	MOV	#13,R1		;FIX UP STACK FOR A RETRY
	ADDR	HANSPC,R2	;POINT TO STUFF TO RESTORE
2$:	MOV	(R2)+,-(SP)
	DEC	R1
	BNE	2$
	MOV	EMTMOD,R4	;RESTORE EMT MODE
	JMP	@.CSIER		;GET RID OF USR, GET LINE, TRY AGAIN
.ENDC

.SBTTL	OUSTUF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	OUSTUF VERIFIES THAT A FILE STRUCTURED DEVICE IS NOT
;	BEING OPENED FOR OUTPUT AS NON-STRUCTURED (SYNTAX ERROR).
;	IT THEN SCANS OFF A CONSTRUCTION OF THE FORM [DECIMAL NUMBER]
;	WHICH SPECIFIES THE SIZE OF THE OUTPUT FILE IN BLOCKS.
;	CALLING SEQUENCE:
;		R0  ->	FILE DESCRIPTOR IN RAD50
;		R2  ->	WORD TO CONTAIN OUTPUT FILE SIZE
;		R5  ->	INPUT STRING
;	RETURNS:
;		R5  ->	CHARACTER AFTER ] IF GIVEN, ELSE AFTER FILENAME
;		@R2 =	FILE SIZE, 0 IF NOT GIVEN
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

.ENABL	LSB

OUSTUF:	MOV	R0,-(SP)	;SAVE F.D. POINTER
	TST	2(R0)		;IS FILE NAME GIVEN ??
	BNE	1$		;YES
	ADDR	DEVSTS,SP	;POINTER TO INFORMATION BLOCK
	EMT	342		;GET DEVICE INFORMATION
	BCS	HANERR		;ILLEGAL DEVICE
	TST	@R0		;IS IT A DIRECTORY DEVICE ??
	BMI	HANERR		;YES, THIS WILL DESTROY ITS DIRECTORY
1$:	CLR	@R2		;ZERO DESTINATION OF SIZE
	CMPB	@R5,#'[		;IS IT A [ ??
	BNE	3$		;NO, NO SIZE SPECIFIED
	JSR	PC,DECNUM	;GET THE SIZE IN BLOCKS
	CMPB	@R5,#']		;CHECK FOR ]
	BNE	SYNERR		;ERROR IF NOT PRESENT
	DEC	R5		;MOV R5 TO NEXT CHAR
2$:	MOV	(SP)+,@R2	;PUT SIZE WHERE IT BELONGS
3$:	MOV	(SP)+,R0	;RESTORE F.D. POINTER
	RTS	PC

.SBTTL	GET FILE DESCRIPTOR SUBROUTINE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	GETFD GETS A FILE DESCRIPTOR FROM THE INPUT STRING AND
;	CREATES 4 WORDS OF RADIX 50 INFORMATION OF THE FORM:
;		.RAD50	"DEV"
;		.RAD50	"FILNAM"
;		.RAD50	"EXT"
;	CALLING SEQUENCE:
;		R1  ->	DEFAULT EXTENSION
;		R2  ->	OUTPUT AREA (4 WORDS)
;		R5  ->	INPUT STRING
;	RETURNS:
;		R0  ->  ORIGINAL OUTPUT AREA (R2 INPUT)
;		R2  ->	WORD AFTER THE EXTENSION WORD
;		R5  ->	CHARACTER THAT DELIMITED THE NAME
;	DESTROYS: R0
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
GETFD:	MOV	R2,-(SP)	;SAVE R2 (LATER RESTORED INTO R0)
	JSR	PC,GETNAM	;LOOK FOR DEVICE NAME
	BEQ	6$		;IT WAS A NULL FILE
	CMPB	@R5,#':		;DEVICE NAME FOLLOWED BY COLON
	BNE	5$		;IF NO COLON, NOT A DEVICE NAME
	MOV	(R2)+,DEV1	;SAVE DEVICE NAME AS NEW DEFAULT
	JSR	PC,GETNAM	;NOW LOOK FOR FILE NAME
4$:	CMP	(R2)+,(R2)+	;SKIP PAST FILE NAME
	CMPB	@R5,#'.		;IF PERIOD, EXTENSION FOLLOWS
	BNE	7$		;NO . MEANS NO EXTENSION
	MOV	2(R2),-(SP)	;PRESERVE EXTRA WORD
	JSR	PC,GETNAM	;GET EXTENSION
	TST	(R2)+		;SKIP PAST EXTENSION
	BR	2$		;GO RESTORE SAVED WORD AND RETURN
5$:	MOV	@R2,-(SP)	;SAVE FIRST WORD OF FILE NAME
	MOV	(PC)+,(R2)+	;USE DEFAULT DEVICE
DEV1:	.RAD50	"DK"
	MOV	(R2)+,@R2	;COPY SECOND WORD OF FILE NAME
	MOV	(SP)+,-(R2)	;PUT IN PREVIOUSLY SAVED FIRST WORD
	BR	4$		;GO PROCESS EXTENSION
6$:	ADD	#6,R2		;SKIP DEVICE AND FILE NAMES
7$:	MOV	@R1,(R2)+	;PUT IN DEFAULT EXTENSION
	BR	3$		;GO RESTORE R0 AND EXIT

.DSABL	LSB

.SBTTL	GET NAME SUBROUTINE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	GETNAM CONVERTS A SEQUENCE OF 0 TO 6 ALPHANUMERICS TO RAD50.
;	A 2-WORD RESULT IS STORED AT THE PLACE POINTED TO BY R2.
;	THE RESULT IS PADDED WITH 0'S (RAD50 BLANK) IF < 6 CHARACTERS.
;	CALLING SEQUENCE:
;		R2  ->	2-WORD RESULT AREA
;		R5  ->	SOURCE STRING (BACKWARDS)
;		JSR	PC,GETNAM
;	RETURNS:
;		R2 UNCHANGED
;		R5  ->	CHARACTER THAT DELIMITED THE NAME
;		CONDITION CODE 'ZERO' IF NAME IS ALL ZEROS
;	DESTROYS: R0
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

.ENABL	LSB

GETNM1:	MOV	R4,-(SP)	;ENTER HERE FOR 1-WORD CONVERSION
	MOV	#20000,-(SP)
	BR	2$
GETNAM:	MOV	R4,-(SP)	;SAVE R4
	MOV	#22000,-(SP)	;MASK KEEPS TRACK OF WHERE WE ARE
	TST	EMTMOD		;ARE WE IN SPECIAL MODE?
	BEQ	2$		;NO, GENERAL ALLOWS NO *
	CMPB	-(R5),#'*	;IS IS A STAR?
	BNE	1$		;NO
	MOV	#132500,(R2)+	;PUT IN CODE FOR RAD 50 *
	CLR	(R2)+		;ZERO TOP OF NAME
	BR	4$		;LEAVE
1$:	INC	R5		;FIX R5
2$:	CLR	R4		;CLEAR ACCUMULATOR
3$:	MOVB	-1(R5),R0	;GET NEXT BYTE
	SUB	#'9+1,R0	;CHECK FOR DIGIT RANGE
	ADD	#'9+1-'0,R0
	BCC	12$		;NO DIGIT
	ADD	#36,R0		;INCREASE R0 TO RAD50 DIGIT
	BR	13$		;GO ADVANCE R5
11$:	SUB	#20,R0		;TRY LOWER CASE
12$:	SUB	#20,R0		;WE SUBTRACTED 60. NOW TRY FOR ALPHA
	BLE	14$		;NO GOOD
	CMP	R0,#'Z-100	;IS IT ALPHA?
	BHI	11$		;NO. GO TRY LOWER CASE
13$:	CMPB	-(R5),(PC)+	;DECREMENT R5, SKIP NEXT INSTRUCTION
14$:	CLR	R0		;DO NOT CHANGE R5, FILL WITH 0'S
	ASL	R4		;ASSEMBLE RAD50
	ASL	R4
	ASL	R4
	ADD	R4,R0
	ASL	R4
	ASL	R4
	ADD	R0,R4
	ASL	@SP		;ARE WE DONE YET?
	BCC	3$		;NOT DONE THIS WORD
	MOV	R4,(R2)+	;DONE A WORD. PUT IT IN
	TST	@SP		;DONE ALL WORDS?
	BNE	2$		;NO, CLEAR ACCUMULATOR AND LOOP
4$:	CMP	-(R2),(SP)+	;FIX R2, PRUNE STACK
	DEC	R5		;MAKE R5 -> DELIMITER
	MOV	(SP)+,R4	;RESTORE R4
	TST	-(R2)		;FIX R2, SET CONDITION CODES
	RTS	PC

.SBTTL	OCTAL/DECIMAL CONVERSION ROUTINE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;	NUM GETS AN OCTAL/DECIMAL NUMBER FROM THE INPUT STRING
;	AND RETURNS IT ON THE STACK.
;	CALLING SEQUENCE:
;		R5  ->	INPUT STRING (BACKWARDS)
;		JSR	PC,OCTNUM/DECNUM/CVTNUM
;		(IF CALLED AT CVTNUM, CARRY 0 => OCTAL, 1 => DECIMAL
;	RETURNS:
;		@SP IS CONVERTED NUMBER
;		R5  ->	DELIMITER
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

.ENABL	LSB

OCTNUM:	TST	(PC)+		;CLEAR CARRY, SKIP THE SEC
DECNUM:	SEC			;INDICATE DECIMAL
CVTNUM:	MOV	(SP),-(SP)	;SAVE RETURN & LEAVE ROOM FOR VALUE
	MOV	R3,-(SP)	;SAVE REGISTERS
	MOV	R4,-(SP)
	MOV	#100004,-(SP)	;SET THE RADIX AND SET ASL TO GIVE CARRY
	ADC	@SP
	CMPB	-(R5),#'-	;IS IT A NEGATIVE NUMBER?
	BNE	1$		;NO, GO BUMP R5
	ADD	#140000,@SP	;YES, DON'T BUMP R5 BUT LEAVE @SP<0
1$:	ASL	@SP		;DOUBLE RADIX
	ADC	R5		;FIX R5 IF NO - SIGN
	CLR	R4		;CLEAR ACCUMULATING REGISTER
2$:	MOVB	-(R5),R3	;GET NEXT CHARACTER
	SUB	#'0,R3		;CHECK FOR A DIGIT
	CMPB	R3,@SP
	BHIS	4$		;NO,END OF NUMBER
	ASL	R4		;SHIFT ACCUMULATOR LEFT
	CMPB	@SP,#12		;IS IT OCTAL OR DECIMAL ??
	BNE	3$
	ADD	R4,R3		;DECIMAL, MULT OLD BY 10 (INSTEAD OF 8)
3$:	ASL	R4
	ASL	R4
	ADD	R3,R4		;PUT IN NEW DIGIT
	BR	2$		;GET NEXT DIGIT
4$:	TST	(SP)+		;REMOVE RADIX
	BPL	5$		;WAS IT MINUS?
	NEG	R4		;YEP, NEGATE IT
5$:	MOV	R4,6(SP)	;SAVE THE RESULT
	MOV	(SP)+,R4	;RESTORE REGS
	MOV	(SP)+,R3
	RTS	PC

.DSABL	LSB

	.SBTTL	LINE BUFFER AND STACK SAVE AREA
	.BLKB	74.		;CHARACTER BUFFER (CHARS GO BACKWARDS)
KMCBUF:				;KMON COMMAND BUFFER
.IF NE	BF
	.BYTE	40,0		;THIS BLANK IS USED BY THE KMON
	.BLKB	74.		;F/B NEEDS A SEPARATE BUFFER
.ENDC
CSIBUF:				;LINE BUFFER ALSO USED BY KMON
HANSPC:	.WORD	0		;HANDLER SPACE ADDRESS
DEFEXT:	.WORD	0		;DEFAULT EXTENSION BLOCK ADDRESS
STRING:	.WORD	0		;INPUT STRING (0 MEANS INPUT FROM TTY)
SAVSTK:	.BLKW	7		;STACK SAVE (PS,PC,R1,R2,R3,R4,R5,R0)
REG0:	.WORD	0		;TOP OF HANDLER SPACE RETURNED HERE
STKSAV:
FILDES:	.BLKW	5		;FILE DESCRIPTOR (GENERAL MODE ONLY)
DEVSTS:	.BLKW	4		;DEVICE INFORMATION BLOCK

; THE FOLLOWING ARE SIZE PARAMETERS FOR THE USR
USRSZ	= . - USRBUF + 777 / 1000 ;SIZE OF USR IN BLOCKS
USRSIZE	= USRSZ * 1000		;SIZE OF USR IN BYTES
USRLEN	= USRSZ * 400		;SIZE OF USR IN WORDS
.	= USRBUF + USRSIZE

; THIS ROUTINE MUST SIT AT THE TOP OF THE USR
; IT IS USED TO HELP MOVE THE KMON/USR DOWNWARD IN CORE
.	= . - 26.		;CAUTION ON THIS SIZE !!!!!!!!
MOVEDN:	MOV	SP,R3		;SAVE SP TO FIND IT IN LOOP
	CLR	-(SP)		;AND MAKE US STOP AT STACK TOP
1$:	MOV	(R1)+,(R4)+	;COPY A WORD
	BNE	1$		;LOOP WHEN NON-0
	CMP	R1,PC		;ARE WE DONE (PAST OURSELVES)?
	BHI	2$		;YES
	CMP	R1,R3		;DID WE GET THE STACK TOPPER ?
	BNE	1$		;KEEP MOVING
	MOV	R4,SP		;SWITCH TO NEW STACK (& POP!)
	BR	1$		;AND CONTINUE
2$:	ADD	R0,@SP		;RELOCATE RETURN ADDRESS
	RTS	PC		;BYE
	.WORD	0		;THIS STOPS THE MOVE!

.IF NE	<. - MOVEDN> - 26.
.ERROR	SIZE OF MOVEDN CHANGED!!!
.ENDC

.CSECT	SWAP			;NOW ALLOCATE ENOUGH SWAP BLOCKS
.	= . + KMSIZE + USRSIZ + 1000
; THE EXTRA BLOCK IS BECAUSE WE SWAP TOO MUCH IF THE KMON
; IS NOT ON A BLOCK BOUNDARY
SWAPSZ	= KMONSZ + USRSZ + 1

.IIF DF	NLUSR,	.LIST