PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/mon/filuuo.mac

TITLE	FILUUO LEVEL D DISK SERVICE ROUTINE  V1213
SUBTTL DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW  21-JUN-88

	SEARCH	F,S,DEVPRM
	$RELOC
	$HIGH

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;  OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988.
;ALL RIGHTS RESERVED.

.CPYRT<1973,1988>


XP VFILUUO,1214

FILUUO::ENTRY	FILUUO

;ASSEMBLY PARAMETER FOR FNDFIL INTERLOCK

	ENTRY	FILSER
FILSER::
	SUBTTL	DEFINITIONS

;BITS IN THE ACCESS TABLE STATUS WORD
ACPCRE==:40
ACPSUP==:20
ACPUPD==:10
ACPREN==:200
ACRSUP==:2
ACPNIU==:400000
ACMCNT==:377400
ACPSMU==:4


IOSMON==400000	;THIS FILE IS CURRENTLY DOING MONITOR IO
IOSAU==200000	;THIS FILE HAS THE ALTER-UFD RESOURCE
IOSUPR==100000	;SUPER USETI/USETO DONE ON THIS CHAN
IOSDA==40000	;THIS FIL HAS DISK ALLOCATION QUEUE
IOSRIB==20000	;RIB IS IN MONITOR BUFFER
IOSRDC==:10000	;THIS USER CHANNEL HAS READ COUNT UP FOR FILE
IOSWLK==4000	;FILE (WHOLE STR) IS SOFTWARE WRITE-=LOCKED
		; EITHER FOR ALL JOBS OR FOR THIS JOB ONLY
IOSPBF==2000	;PARTIAL BUFFER DONE
IOSFIR==1000	;COMPUTE AND STORE OR CHECK THE CHECKSUM
IOSHMS==IOBEG	;HUNG-DEVICE MESSAGE ALREADY TYPED
IOSRST==IOFST	;RESET (RELEASE) WAS DONE ON A SPOOLED DEVICE

;THE FOLLOWING S BITS ARE DEFINED IN COMMON.MOD
;BECAUSE THEY WANT TO BE IN THE SAME POSITION IN S AS IN RIB STATUS WORD
;IOSHRE=100	;HARD READ ERROR ENCOUNTERED
;IOSHWE=200	;HARD WRITE ERROR ENCOUNTERED
;IOSSCE=400	;SOFTWARE CHECKSUM ERROR ENCOUNTERED OR HARD POSITIONING ERROR

;IOSERR=IOSHRE+IOSHWE+IOSSCE
;IOSMER=-IOSERR

;BITS IN RH OF S
UDSX==:200	;SUPER USETO IS TO WRITE FORMATS ON THE DISK
IOSFA==:400	;DDB HAS FA RESOURCE (BUG, SHOULD BE IN LH)

;BITS IN LH(M) USED IN LOOKUP/ENTER/RENAME

UUOMSK==777000	;MASK FOR ALL POSSIBLE UUO BITS
UUOLUK==400000	;LOOKUP IN PROGRESS
UUOSFD==:200000	;SFD FOUND ON SOME STR IN SEARCH LIST
UUOREN==:100000	;RENAME IN PROGRESS
UUOUFD==:40000	;AT LEAST 1 UFD FOUND IN SEARCH LIST (FNDFIL)
UUOUPD==20000	;ENTER IS AN UPDATE
UUO2SF==:UUOUPD	;ON IF JUST SCANNING AT'S FOR AN SFD (2ND PASS)
UUOSF2==:UUOSFD+UUO2SF
UULKRN==:UUOLUK+UUOREN
UUODIR==:10000	;UUO IS FOR A DIRECTORY
UALASK==4000	;ALLOCATION REQUESTED ON ENTER
UPARAL==2000	;BIT ON IF PARTIAL ALLOCATION OR ENTER
UTRTWC==2000	;TRIED LOOKUP ON MORE THAN 1 SPECIFICATION
EXTUUO==1000	;BIT ON IN LH(UUO) IF EXTENDED UUO
DEFINE	NOSCHEDULE <>
DEFINE SCHEDULE <>
DEFINE	CBDBUG(A,B)<>



REPEAT 0,<
THE FOLLOWING IS THE ORDER IN WHICH RESOURCES SHOULD BE OBTAINED:

FIRST GET:	THEN GET:
MON BUF		CB, DA, OR AU
CB		DA
AU		CB
>
SUBTTL	INTERFACE SUBROUTINES WITH THE REST OF THE MONITOR

;DISPATCH TABLE
	POPJ	P,		;(-4) DEVOP UUO
	JRST	DBFSIZ		;(-3) GET BUFFER SIZE
	JRST	DSKINI		;(-2) INITIALIZE
	JRST	CPOPJ1##	;(-1) HUNG, LET DSKSEC HANDLE IT
DSKDSP::JRST	DSKREL		;(0) RELEASE
	JRST	CLOSOU		;(1) OUTPUT CLOSE
	JRST	OUTPT		;(2) OUTPUT
	JRST	INPT		;(3) INPUT
	JRST	UENTR		;(4) ENTER
	JRST	ULOOK		;(5) LOOKUP
	JRST	DMPOUT		;(6) DUMP-MODE OUTPUT
	JRST	DMPIN		;(7) DUMP-MODE INPUT
	JRST	USETO0##	;(10) USETO
	JRST	USETI0##	;(11) USETI
	POPJ	P,		;(12) UGETF
	JRST	RENAM		;(13) RENAME
	JRST	CLOSIN		;(14) INPUT CLOSE
	POPJ	P,		;(15) UTPCLR
	POPJ	P,		;(16) MTAPE


	$INIT

DSKINI:	SETZM	DSKDDB##+DEVIOS	;ZERO THE S WORD IN PROTOTYPE DDB
	SETZM	SYSPPB##	;INSURE THAT SYSPPB
	SETZM	SYSDOR##	;AND SYSDOR ARE 0
	MOVE	T1,STRAOB##	;INITIZE ALL STR DATA BLOCKS
DSKIN1:	MOVE	T3,TABSTR##(T1)	;SETT2=STR D.B.ADDR.
	JUMPE	T3,DSKIN2	;   IF 0 THEN NO F.S. FOR THIS #
	SETZM	STRJOB##(T3)	;CLEAR STRJOB
	SETZM	STRMNT##(T3)	;SET MOUNT COUNT 0
	MOVE	P2,SYSSRC##	;IN SYSTEM SEARCH LIST?
	PUSHJ	P,SLFNA##
	  JRST	DSKIN2		;NO
	AOS	STRMNT##(T3)	;YES - BUMP MOUNT COUNT
DSKIN2:	AOBJN	T1,DSKIN1	;CHECK ALL STRS
	MOVE	T1,TIME##	;INIT SPOOL NAME GENERATOR TO RANDOM START
	IDIVI	T1,^D3600	;START WITH MINUTES SINCE MIDNIGHT
	ADD	T1,THSDAT##	;PLUS DATE
	MOVEM	T1,SPLGEN##	;SAVE FOR FILSER
	MOVSI	T1,(POPJ P,)	;ONCE ONLY
	MOVEM	T1,DSKDSP+DINI	;SO DON'T CALL US AGAIN
	POPJ	P,		;AND RETURN

	$HIGH
;SUBROUTINE TO DETERMINE IF A JOB HAS A SHARABLE DISK RESOURCE
;ENTER	J=JOB NUMBER
;EXIT CPOPJ IF NO, CPOPJ1 IF YES
;RESPECTS ALL AC'S
FLSDR::	HLL	J,JBTSTS##(J)	;JOB STATUS BITS
	TLZ	J,-1-JXPN	;CLEAR ALL BUT JXPN
	TLZE	J,JXPN		;RESTORE JOB NUMBER, SKIP IF JXPN CLEAR
	POPJ	P,		;JOB IS EXPANDING, LIE ABOUT RESOURCES
IFN FTMP,<
	CAME	J,MCUSER##	;OWN MC? CAN'T SWAP OWNER
>
	CAMN	J,CBUSER##	;JOB HAVE CB
	PJRST	CPOPJ1##	;YES
	PJRST	TSTFAD##	;NO, GO TEST AU, DA, AND FA
;SUBROUTINE TO CLEAN UP THE ACCESS TABLES FOR A JOB AFTER AN ERROR.
; DECREMENTS THE READ-COUNT IF READING, CLEARS THE STATUS BYTE IF WRITING
; AND INCREMENTS THE QUOTA IF CREATE OR SUPERSEDE
SWPCLN::HLRZ	F,SWPDDB##+DEVSER ;START AT FIRST DSK
SWPCL1:	MOVE	T1,DEVMOD(F)	;IS THIS A DISK?
	SKIPL	DEVSPL(F)
	TLNE	T1,DVDSK
	TDZA	T2,T2		;YES
	POPJ	P,		;NO MORE DISKS
	LDB	T1,PJOBN##	;IS IT OURS?
	CAME	T1,J
	JRST	SWPCL6		;NO
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	JUMPE	T1,SWPCL6	;THROUGH IF NONE
	MOVE	S,DEVIOS(F)	;DECREMENT READ-COUNT IF IT'S UP
	TLZE	S,IOSRDC
	MOVNI	T2,ACPCNT##
	ADDB	T2,ACCCNT##(T1)	;UPDATE COUNT, GET STATUS
	MOVEM	S,DEVIOS(F)
	TRNN	T2,ACPUPD+ACPREN+ACPCRE+ACPSUP ;IS THE FILE BEING WRITTEN?
	JRST	SWPCL4		;NO
	TRNN	T2,ACPUPD+ACPREN ;YES, BEING RENAMED OR UPDATED?
	JRST	SWPCL2		;NO
	TRNN	T2,ACMCNT	;YES, IS THE READ-COUNT NOW 0?
	JRST	SWPCL3		;YES, CLEAN UP THE A.T.
	MOVEI	T3,DEPWRT##
	TRNN	T2,ACPREN	;IS THE FILE BEING RENAMED?
	TDNN	T3,DEVWRT##(F)	;NO, IS THIS DDB AN UPDATER?
	JRST	SWPCL5		;NO, LEAVE A.T. ALONE
	LDB	T3,ACYWCT##	;HE IS AN UPDATER
	SUBI	T3,1		;DECR COUNT OF UPDATERS
	DPB	T3,ACYWCT##	;DONT CLEAR ACPUPD IF OTHER UPDATERS
	JUMPN	T3,SWPCL4

	JRST	SWPCL3		;CLEAN UP A.T.
SWPCL2:	MOVE	T2,ACCALC##(T1)	;NUMBER OF BLOCKS ALLOCATED TO THE FILE
	HRRZ	T3,DEVUFB##(F)	;LOC OF UFB
	SKIPE	T3
	ADDM	T2,UFBTAL##(T3)	;UPDATE THE USER'S QUOTA BY THE SIZE OF THE FILE
SWPCL3:	MOVEI	T2,ACPUPD+ACPREN+ACPSUP+ACPCRE
	ANDCAB	T2,ACCSTS##(T1)	;CLEAN OUT THE STATUS OF THE A.T.
SWPCL4:	PUSH	P,F		;SAVE F
	SETZ	F,		;INDICATE DONT USE CB (ON CLOCK LEVEL)
	TRNN	T2,ACMCNT	;READ-COUNT NOW 0?
	PUSHJ	P,ATRMOV##	;GET RID OF A.T.
	POP	P,F
SWPCL5:	HLLZS	DEVACC##(F)
SWPCL6:	PUSHJ	P,NXDDB##	;FIND NEXT DDB
	  CAMN	J,.USJOB	;DON'T DO FUNNY SPACE IF NOT ADDRESSABLE
	JUMPN	F,SWPCL1	;DO THIS ONE TOO
	POPJ	P,		;ALL DONE
;SUBROUTINE TO GET WORD POINTED TO BM FROM USER'S AREA
;RETURNS WORD IN T3, PRESERVES T1 AND T2
GTWDT3:	PUSH	P,T1		;SAVE T1
	PUSHJ	P,GTWST2##	;GET THE WORD INTO T1
	MOVE	T3,T1		;RETURN IT IN T3
	JRST	TPOPJ##		;RESTORE T1 AND RETURN

;ROUTINE FOR TESTING FOR SPECIAL DEVICE NAMES
;ENTER T1=DEVICE NAME
;EXIT CPOPJ IF NOT A SPECIAL DEVICE, WITH T1=NAME
;EXIT CPOPJ1 IF YES, T1=NAME, T2=INDEX IN TABLE (=0 FOR SYS, 1 FOR SXS)
; T3=0 IF JUST 'DEV', T3 =1 IF 'DEVX', AND DSKX EXISTS
; T4=INDEX INTO LOGICAL NAME TABLE IF A LOGICAL NAME
;CALL SDVTS1 TO IGNORE LOGICAL NAMES
;CALL SDVTSP TO IGNORE LOGICAL NAMES IF PT.PHO IS ON IN P1
SDVTSP:	TLNN	P1,PT.PHO##	;IGNORE LOGICAL NAMES?
SDVTST::PUSHJ	P,LNMTST	;IS DEVICE A LOGICAL NAME?
	  JRST	SDVTS1		;NO, SEE IF IT IS IN TABLE
	MOVEI	T2,LIBNDX##	;YES, PRETEND IT IS LIB
	SETZ	T3,		;NOT DEVX
	JRST	CPOPJ1##
SDVTS1::SETZB	T2,T3		;T2=INDEX T3=0 IF STRAIGHT MATCH
	TRNE	T1,-1		;ERSATZ DEVS ARE 3 CHARS
	JRST	SDVTS4		; SO A LONGER NAME DOESN'T MATCH
SDVTS2:	HLLZ	T4,SDVTBL##(T2)	;NAME
	CAMN	T1,T4		;MATCH?
	JRST	SDVTS3		;EXTRA WORK IF LIB
	CAIGE	T2,SDVLEN##	;END OF TABLE?
	AOJA	T2,SDVTS2	;NO, TRY NEXT
SDVTS4:	TRNN	T1,7777		;NO REAL MATCH
	TRNN	T1,770000	;IS IT DEVX?
	POPJ	P,		;NO - NO MATCH
	PUSH	P,T1		;YES, SAVE NAME
	HRLI	T1,'DSK'	;MAKE IT DSKX
	HRROI	T2,770000	;SET T2=MASK FOR DSKX
	PUSHJ	P,UNSRCH##	;LOOK FOR UNIT
	  PJRST	TPOPJ##		;NOT FOUND
	HLLZ	T1,(P)		;DSKX EXISTS
	PUSHJ	P,SDVTS1	;IS DEV A SPECIAL DEVICE?
	  PJRST	TPOPJ##		;NO, NON-SKIP
	CAIN	T2,LIBNDX##
	JRST	TPOPJ##		;"LIBX" DOESN'T EXIST
	MOVEI	T3,1		;YES, SET T3 NON-0
	PJRST	TPOPJ1##	;FOUND - SKIP RETURN
SDVTS3:	CAIE	T2,LIBNDX##	;GOOD RETURN IF NOT LIB:
	PJRST	CPOPJ1##
				;DROP THROUGH TO NEXT PAGE IF LIB
;HERE ON DEVICE "LIB", BUT NO LOGICAL DEVICE BY THAT NAME

;SUBROUTINE TO FIND THE LIB (SPEC WHICH IS SEARCHED ON LOOKUP FAILURE)
;EXIT NON-SKIP IF NONE
;SKIP-RETURN IF FOUND, T4=INDEX
;PRESERVES T1-T3
FNDLB:	SETZ	T4,		;START AT 1ST LOGICAL NAME
	SKIPE	.USLNM		;ARE THERE LOG NAMES?
FNDLB1:	SKIPN	@.USLNM		;YES, AT END?
	POPJ	P,		;NO LIB
	SKIPL	@.USLNM		;IS THIS A LIB?
	AOJA	T4,FNDLB1	;NO, TRY NEXT
	JRST	CPOPJ1##	;YES

;SUBROUTINE TO FIND A LOGICAL NAME
;ENTER T1=NAME
;EXIT T1=NAME, T3=BITS, T4=INDEX INTO TABLE
;ENTER AT LNMTSN IF F IS NOT POINTING AT A DDB
LNMTST::MOVE	T4,DEVPHO##(F)
	TLNE	T4,DEPPHO##	;PHYSICAL ONLY?
	JUMPN	F,CPOPJ##	;YES, NO MATCH
LNMTSN::IFN FTXMON,<PUSHJ P,SSEC0##>	;ENTER SECTION ZERO
	SETZ	T4,		;START AT BEGINNING
	CAMN	T1,[-1]		;WOULD WE MATCH OLD-STYLE LIB KLUDGERY?
	POPJ	P,		;YES, HACK, NO MATCH FOR ARGUMENT OF -1
	SKIPE	.USLNM		;ANY AT ALL?
LNMTS1:	SKIPN	T3,@.USLNM	;YES, DONE?
	POPJ	P,		;NO MATCH
	CAMN	T1,(T3)		;IS THIS THE ONE WE WANT?
	JRST	CPOPJ1##	;MATCH
	AOJA	T4,LNMTS1	;TRY NEXT

;SUBROUTINE  TO CHECK FOR DEVICE "NUL"
;RETURNS CPOPJ IF NUL:, ELSE CPOPJ1
NULTST::MOVS	T1,DEVNAM(F)	;NAME USER INITED
	CAIE	T1,'NUL'	;NUL:?
	AOS	(P)		;NO
	POPJ	P,		;RETURN POPJ OR POPJ1
;SUBROUTINE TO GET THE PPN ASSOCIATED WITH SYS:
;RETURNS NON-SKIP IF "SYS" IS A LOGICAL NAME OR A PATH(O)LOGICAL NAME
;SKIP-RETURNS WITH PPN IN T3 OTHERWISE
;RESPECTS ALL ACS EXCEPT T3
SYSNM::	PUSHJ	P,SAVT##	;SAVE ACS
	MOVE	T1,.JDAT+SGAMOD##
	TLNE	T1,PHONLY	;PHYSICAL ONLY SYS?
	JRST	SYSNM1		;YES, GET SYSPPN
	SKIPE	DEVLOG(F)	;IF F POINTS AT A DDB WITH A LOGICAL NAME
	POPJ	P,		;THE NAME MUST BE "SYS"
	MOVSI	T1,'SYS'	;SEE IF WE HAVE A PATH(O)LOGICAL NAME
	PUSHJ	P,LNMTST	;NO. LOGICAL NAME?
SYSNM1:	  SKIPA	T3,.CPJOB##	;NO, GIVE SYS IS NOT A LOGICAL NAME RETURN
	POPJ	P,		;HAS SUCH A NAME
	MOVE	T3,JBTSFD##(T3)
	TLNE	T3,JBPXSY##	;NEW ENABLED?
	SKIPA	T3,NEWPPN##	;YES
	MOVE	T3,SYSPPN##	;NO
	MOVEM	T3,-3(P)	;WHERE SAVT WILL RESTORE T3 FROM
	JRST	CPOPJ1##
;SUBROUTINE TO TEST IF THE DEVICE WHOSE NAME IS IN T1 IS A DISK
;ENTER WITH J = JOB NUMBER
;RH(P1) CONTAINING DD%PHO IF PHYSICAL ONLY
;EXIT CPOPJ IF A DISK, WITH F=PROTOTYPE DDB
;EXIT CPOPJ1 IF NOT A DISK, OR A SINGLE-ACCESS DISK NOT FOR THIS JOB
;LIGHTS SYSDEV IN LH(F) IF THE NAME IS SOME FLAVOR OF SYS (EG "SYSB")
;CALLED BY DEVPHY
TSTDSK::JUMPE	T1,CPOPJ1##	;"0" IS NOT A DISK
	PUSHJ	P,SAVT##	;SAVE T2-T4
	MOVEI	F,DSKDDB##	;SET F FOR PROTOTYPE DDB
	PUSHJ	P,ALIASD##	;IS NAME AN ALIAS FOR "DSK"?
	  POPJ	P,		;YES. NON-SKIP RETURN
	TRNN	P1,DD%PHO##	;PHYSICAL ONLY?
	PUSHJ	P,LNMTST	;NO, LOOK FOR A LOGICAL NAME
	  CAIA			;NOT FOUND OR PHYSICAL ONLY
	POPJ	P,		;FOUND A LOGICAL NAME
	PUSHJ	P,SDVTS1	;IS IT A SPECIAL DEV?
	  JRST	TSTDS1		;NO
	CAIG	T2,SYSNDX##	;YES, IS IT SYS?
	TLO	F,SYSDEV	;YES, LIGHT SYSDEV
	POPJ	P,		;AND RETURN
TSTDS1:	CAMN	T1,['NUL   ']	;'NUL'
	POPJ	P,		; IS A DISK
	TLNN	T1,-1		;XWD 0,,"A"?
	PJRST	CPOPJ1##	;YES,NOT A DSK
	PUSHJ	P,SAVE2##	;S.L. ROUTINES CLOBBER P1 AND P2

	PUSH	P,U		;SAVE U FOR REST OF MON
	PUSHJ	P,SRSTR##	;USER SUPPLYING STR NAME?
	  SKIPA			;NOT AN STR NAME
	JRST	TSTDS2		;YES, AN STR
	PUSHJ	P,MSKUNI##	;SET T2=MASK FOR NAME
	MOVEI	T4,SRUNI##	;ASSUME NO SECONDARY PORT SEARCH
IFN FTDUAL,<
	TRNE	P1,DD%ALT##	;ALSO SEARCHING FOR ALTERNATE PORTS
	MOVEI	T4,SRUNA##	;YES, GET THAT ROUTINE
>
	PUSHJ	P,(T4)		;IS USER SUPPLYING A UNIT NAME?
	  JRST	UPOPJ1##	;NOT A DISK - SKIP RETURN
	  JFCL			;PHYSICAL DSK NAME
	HRRZ	T3,UNISTR(U)	;YES, SET T3 TO STR DB LOC
	JUMPN	T3,TSTDS2	;IF UNIT NOT IN A STR
	MOVE	T1,.PDOBI##(W)
	TLNE	T1,(JP.OPP)	;DOES JOB HAVE OPR PRIVS?
	JRST	TSTDS6		;YES, OK
	JRST	TSTDS4		;NO, ONLY IF PRIV'D
TSTDS2:	MOVE	T4,STRPVS##(T3)	;F.S. IS PRIVATE BIT
	TRNN	T4,STPPVS##	;IS THIS A PRIVATE F.S.?
	JRST	TSTDS3		;NO, ALL IS WELL
	PUSHJ	P,SLPTR##	;FIND THIS JOBS S.L.
	  JRST	TSTDS4		;NONE OR EMPTY, LEGAL ONLY IF PRIV'ED
	HRRZ	T1,STRFSN##(T3)	;F.S. NMBER
	PUSHJ	P,SLFND##	;IS THIS F.S. IN THE USER'S S.L.
	  JRST	TSTDS4		;NO, ILLEGAL UNLESS PRIV'ED
TSTDS3:	SKIPLE	T4,STRJOB##(T3)	;STR SINGLE-ACCESS?
	CAIN	J,(T4)		;YES. FOR THIS JOB?

	JRST	TSTDS6		;YES, OK
TSTDS4:	MOVE	T1,JBTPPN##(J)	;NO. JOB MUST BE PRIVILEGED TO DO IT
;HERE IF TRYING TO GET A UNIT NOT IN AN STR, OR SINGLE ACCESS STR NOT FOR THIS JOB
;ALLOW IT IS JOB IS PRIVILEGED, OTHERWISE ERROR RETURN
	JUMPGE	M,TSTDS5	;IF A COMMAND,
	SKIPL	DEVJOB(F)	;M NEGATIVE IF FILOP.
	CAMN	T1,FFAPPN##	; ONLY [1,2] IS LEGAL
TSTDS5:	PUSHJ	P,PRVJO##	;PRIV'D JOB?
	  JRST	TSTDS7
TSTDS6:
IFE FTMDA,<
	MOVE	T2,UNIUST(U)	;NO NEW ACCESSES FOR UNIT?
	TLNE	T2,UNPNNA
> ;END IFE FTMDA
IFN FTMDA,<
	PUSHJ	P,CHKLOK##	;LOCKED?
> ;END IFN FTMDA
	JRST	UPOPJ1##	;YES, SAY IT ISNT A DSK

	JRST	UPOPJ##		;YES. OK RETURN
TSTDS7:	CAMN	T1,UMDPPN##	;IF USER MODE DIAG
	JUMPE	T3,UPOPJ##	;OK IF RIGHT PPN
	JRST	UPOPJ1##	;NOPE, LOSE
;ROUTINE TO WRITE THE SATS OF ALL UNITS WHICH HAVE CHANGED
;ENTER WITH RIB IN MONITOR BUFFER
;ENTER/EXIT WITH U=UNIT THAT HAS DA (IF ANY)
;ALWAYS EXITS WITH DA ON SAME UNIT AS WHEN ENTERED (IF ANY)

RIBSAT::TLNE	S,IOSDA		;HAVE DA?
	JRST	RIBSAD		;YES
	PUSHJ	P,UPDA##	;NO, GET IT
	PJRST	RIBSAW		;WRITE CHANGED SATS, RETURNS DA

RIBSAD:	PUSH	P,U		;SAVE UNIT THAT HAS DA
	PUSHJ	P,RIBSAW	;WRITE CHANGED SATS
	POP	P,U		;GET ORIGINAL UNIT BACK
	PUSHJ	P,STORU##	;STORE IT IN DEVUNI
	PJRST	UPDA##		;GET DA BACK ON THAT UNIT

;ROUTINE TO WRITE SATS - MUST BE CALLED WITH DA, RETURNS WITHOUT DA

RIBSAW:	PUSHJ	P,SAVE1##	;SAVE P1
	SKIPGE	DEVRIB##(F)	;IF IN AN EXTENDED RIB,
	PUSHJ	P,WTUSAT	; NO UNIT-CHANGE TO EXTENDED RIB
	PUSHJ	P,DWNDA##	;GIVE UP DA
	PUSHJ	P,SPTRW##	;GET AOBJN WORD FOR POINTERS
	MOVE	P1,T1		;INTO P1
RIBSA2:	SKIPN	T2,(P1)		;GET A POINTER
	POPJ	P,		;DONE
	TLNE	T2,-1		;UNIT CHANGE?
	JRST	RIBSA3		;NO, TRY NEXT
	TRZ	T2,RIPNUB##	;YES, GET UNIT NUMBER
	PUSHJ	P,NEWUNI##	;SET U TO THIS UNIT
	  JRST	RIBSA3		;NO GOOD - DON'T TOUCH SATS
	PUSHJ	P,UPDA##
	PUSHJ	P,WTUSAT	;WRITE SAT FOR UNIT IF IT CHANGED
	PUSHJ	P,DWNDA##	;GIVE UP DA
RIBSA3:	AOBJN	P1,RIBSA2	;AND TRY NEXT POINTER
	POPJ	P,		;DON'T - RETURN

;SUBROUTINE TO WRITE SATS FOR A UNIT
WTUSAT::PUSHJ	P,SAVE1##	;SAVE P1
	PUSHJ	P,SAVR##	;AND R
	SE1ENT			;ENTER SECTION 1
	LDB	P1,UNYSIC##	;NUMBER OF SAB BLOCKS FOR UNIT
	SKIPN	R,UNISAB(U)	;LOC OF 1ST SAB
	POPJ	P,		;UNIT HAS NO SAB (OFF-LINE, DOWN, OR STR YANKED)
WTUSA1:	SKIPGE	SABFIR##(R)	;HAS SAT BEEN MODIFIED?
	PUSHJ	P,SATWRT##	;YES. WRITE IT
	SKIPN	UNISAB(U)	;UNIT STILL HAVE SAB?
	POPJ	P,		;NO, STR YANKED WHILE BLOCKED IN UUOPWQ
	MOVE	R,SABRNG##(R)	;STEP TO NEXT SAB IN RING
	SOJG	P1,WTUSA1	;GO IF IT HASNT BEEN CHECKED
	POPJ	P,		;RETURN
;SINCE SAT TABLES ARE ALWAYS WRITTEN BEFORE UFD'S, THERE IS NO NEED
;FOR SPECIAL CODE TO WRITE SAT'S ON A 147 RESTART,   SO.......
;MAKE DSKSTP BE A POPJ
;FAKE WAIT1 FOR USE DURING RESTART

	$INIT

ONCWAT::MOVSI	T1,ONCTIM##	;SET UP A HUNG TIMER
ONCWA1:	MOVE	S,DEVIOS(F)
	TRNN	S,IOACT		;DONE?
	POPJ	P,		;YES
	PUSHJ	P,APRCHK##	;KEEP TIME UP TO DATE
	SOJG	T1,ONCWA1
	MOVE	U,DEVUNI##(F)	;TIMED OUT
	MOVE	J,UDBKDB(U)
	PUSHJ	P,@KONSTP(J)	;STOP THE DEVICE
	  JFCL
	SETZM	UNISTS(U)	;SET UNIT IDLE
	MOVSI	T1,KOPBSY	;SET KONTROLLER IDLE
	ANDCAM	T1,KONBSY(J)
	SETOM	@KDBCHN(J)	;SET CHANNEL IDLE
	TRC	S,IOACT+IODERR	;CLEAR IOACT, LIGHT DEVICE ERROR
	PJRST	STOIOS##	; AND RETURN

	$HIGH

;HERE ON A LOGOUT, WHEN THERE ARE NO OTHER JOBS LOGGED IN UNDER THIS PPB
;CALLED BY LOGOUT , WITH AC=PPN  (DSKLGO UUO)
DSKLGO::MOVEI	F,0		;NO REAL DDB
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	HLRZ	T2,SYSPPB##	;%NO. SET TO SEARCH PPB'S
	PUSHJ	P,LSTSCN##	;%FIND PPB FOR THIS JOB
	  JUMPLE T2,GVCBJ##	;%NOT THERE - EXIT IF NO CORE BLOCK SET UP
	MOVEI	T1,PPPNLG##	;%FOUND - SET NLG
	ANDCAM	T1,PPBNLG##(T2)	;% IN PPB BLOCK
	PJRST	TSTPP2		;%AND GO DELETE PPB,UFBS FOR THIS PRJ,PRG
;SUBROUTINE TO BUILD A DISK DEVICE DATA BLOCK
;ENTER WITH T1=DEVICE NAME, F=LOC OF DDB (OR PROTOTYPE DDB)
;IF A SPOOLING DEVICE, P1 CONTAINS DEVMOD, ELSE P1=0
;CALLED BY ASSPRG
;HERE FROM ONCE-ONLY CODE
;RETURNS CPOPJ IF NO MORE DDB SPACE, CPOPJ1 NORMALLY
;PRESERVES T2-T4
SETDDO::PUSH	P,DSKDDB##	;SAVE NAME
	JRST	SETDD3		;GO CREATE THE DDB
;THIS IS THE NORMAL ENTRY POINT
SETDDB::PUSHJ	P,SAVT##	;SAVE T2-T4
	HRRZ	T3,F		;ADDR. OF THE DDB
	CAIE	T3,DSKDDB##	;IS IT THE PROTOTYPE?
	MOVE	T1,DEVNAM(F)	;NO. GET THE PHYSICAL DEVICE NAME
	PUSH	P,T1		;SAVE NAME
	MOVE	T1,DEVMOD(F)
	TRNE	T1,ASSPRG	;DDB BEEN INITED?
	JRST	SETDD1		;YES. HAVE TO COPY PROTOTYPE
	CAIE	T3,DSKDDB##	;IS IT PROTOTYPE?
	JRST	SETDD2		;NO. USE IT

;HERE WHEN WE MUST MAKE A COPY OF THE PROTOTYPE DDB
SETDD1:	MOVEI	T2,DDBLEN##	;NO OF 4-WORD BLOCKS NEEDED
	MOVEI	T1,GTFWDU##	;ASSUME NOT A GET/RUN
	MOVE	T3,J		;COPY/JOB CONTEXT HANDLE
	ANDI	T3,JOBMSK##	;ISOLATE JOB NUMBER
	MOVE 	T3,JBTSTS##(T3)	;GET JOB STATUS WORD
	TRNE	T3,JS.ASA
	MOVEI	T1,GFWDUD##	;ALWAYS WIN FOR GET/RUN
	PUSHJ	P,(T1)		;GET THE CORE
	  JRST	TPOPJ##		;CANT GET IT - RETURN
	SKIPA	T2,F		;PRESERVE OLD DDB (SETDDB)
SETDD3:	SETZ	T2,		;CLEAR OLD DDB (SETDDO)
	HRR	F,T1		;LOC OF THE CORE
	HRLI	T1,DSKDDB##	;FROM THE PROTOTYPE
	BLT	T1,DEVRB1##-1(F) ;BLT THE NEEDED INFORMATION
	JUMPE	T2,SETDD6	;HAVE AN OLD DDB
	HRRZ	T1,DEVSPM##(T2)	;DOES THE OLD DDB HAVE A
	JUMPE	T1,SETDD6	; SPOOLED PARAMETER BLOCK?
	PUSH	P,T1		;YES, REMEMBER ADDRESS
	MOVEI	T2,SPBMAX##	;SIZE OF AN SPB
	PUSHJ	P,GTFWDC##	;GET CORE
	  JRST	TTPOPJ##	;RAN OUT OF PER-PROCESS FUNNY SPACE
	HRRZM	T1,DEVSPM##(F)	;STORE NEW SPB ADDRESS IN NEW DDB
	MOVEI	T2,SPBMAX##(T1)	;COMPUTE END ADDRESS OF BLOCK
	POP	P,T3		;GET OLD SPB ADDRESS
	HRLI	T1,(T3)		;SET UP BLT POINTER
	BLT	T1,-1(T2)	;COPY SPB
SETDD6:	HRRZ	T2,F		;GET NEW DDB ADDRESS
	CAIG	T2,FYSORG+FYSSIZ ;DDB LIVE WITHIN
	CAIGE	T2,FYSORG	; FUNNY SPACE?
	JRST	SETDD7		;NO, LINK AFTER SWPDDB
	SKIPN	DINITF##	;DISK INITIALIZATION IN PROGRESS?
	JRST	SETDD4		;NO, LINK DDB INTO FUNNY SPACE CHAIN
SETDD7:	SKIPE	.UONCE##	;TWICE?
	JRST	TPOPJ1##	;YES, GO AWAY
	DDBSRL
	MOVE	T1,SWPDDB##+DEVSER
	HLLM	T1,DEVSER(F)
	HRLM	F,SWPDDB##+DEVSER ;LINK PROTOTYPE TO THIS DDB
	DDBSRU
	JRST	SETDD5
SETDD4:	MOVE	T2,.USLST
	HLLM	T2,DEVSER(F)
	HRLM	F,.USLST
				;FALL INTO SETDD5
SETDD5:	SKIPE	P1		;IF THIS IS A SPOOLING DDB
	MOVEM	P1,DEVMOD(F)	;SAVE DEVMOD OF REAL DEVICE

	MOVEI	T1,ASSCON+ASSPRG ;MAKE SURE ASSIGN BITS ARE OFF
	ANDCAM	T1,DEVMOD(F)	;(1 WILL BE TURNED ON BY ASSPRG)
	MOVE	T1,(P)		;GET NAME
	PUSHJ	P,MSKUNI##	;SET UP A MASK
	PUSHJ	P,UNSRCH##	;FIND THE UNIT (OR STR)
	  SETZ	T3,		;NONE (SHOULDN'T HAPPEN)
	HRRM	T3,DEVUNI##(F)	;SAVE IN DEVUNI (SO DDB
				; WILL BE FOUND ON A REMOVE)
SETDD2:	POP	P,DEVNAM(F)	;SET NAME INTO DDB
IFN FTMP,<
	MOVSI	T2,1000		;MP & QUEUED PROTOCOL 1
	HLLM	T2,DEVCPU##(F)	;STORE FOR UUOCON
>
	PUSHJ	P,NULTST	;IF NUL:
	  SKIPA	T2,[XWD -1-TTYATC,177777] ;ALL DV'S, ALL MODES
	JRST	CPOPJ1##
	IORM	T2,DEVMOD(F)
	JRST	CPOPJ1##
; ROUTINE TO CREATE A SPOOLED PARAMETER BLOCK
; CALL:	PUSHJ	P,SETSPB
;	  <ERROR>		;NO FREE CORE
;	<SKIP>			;T1 AND DEVSPM SETUP
;
SETSPB::SKIPE	T1,DEVSPM##(F)	;IS THERE A SPOOL PARAM BLOCK?
	JRST	CPOPJ1##	;YES--ALL DONE
	MOVEI	T2,SPBMAX##	;HOW MUCH CORE WE NEED
	PUSHJ	P,GTFWDC##	;GET THAT CORE
	  POPJ	P,		;NO FREE CORE
	MOVEM	T1,DEVSPM##(F)	;REMEMBER WHERE IT IS
	HRLZ	T2,T1		;SET ADR,,0
	HRRI	T2,1(T1)	;ADR,,ADR+1
	SETZM	0(T1)		;CLEAR FIRST WORD
	BLT	T2,SPBMAX##-1(T1) ;CLEAR THE REST
	JRST	CPOPJ1##	;RETURN
;SUBROUTINE TO COMPUTE THE SIZE OF THE BUFFER
DBFSIZ:	TLNN	M,.OPLBF	;LARGE BUFFERS?
	 JRST	DBFSZ1		;NO - GO RESET THE VALUE IN CASE IT CHANGED
	SKIPN	T1,.PDLBS##(W)	;YES, HAVE DEFAULTS?
	MOVEI	T1,LBFSIZ##+1	;NO, USE SYSTEM DEFAULT
	TLNE	T1,-1		;SET BY UUO?
	HLRZS	T1		;YES, USE THAT SIZE
	POPJ	P,		;RETURN TELLING UUOCON THE BUFFER SIZE

;HERE TO SET THE BUFFER SIZE FROM THE PROTOTYPE DISK DDB
DBFSZ1:	PUSH	P,F		;SAVE F FOR A MOMEMT
	MOVEI	F,DSKDDB##	;POINT AT PROTOTYPE DISK DDB
	PUSHJ	P,REGSIZ##	;GET THE DEFAULT BUFFER SIZE
	JRST	FPOPJ##		;RESTORE F AND RETURN
;SUBROUTINE TO CLEAR A DISK DEVICE DATA BLOCK
;ENTER WITH F=LOC OF DDB
;CALLED BY RELEASE CODE
CLRDDB::HRRZ	T1,F		;COPY DDB ADDRESS
	CAIG	T1,FYSORG+FYSSIZ ;DDB LIVE WITHIN
	CAIGE	T1,FYSORG	; FUNNY SPACE?
	SKIPA	T1,[SWPDDB##]	;LOW CORE DDB
	MOVEI	T1,.USLST-DEVSER ;FUNNY SPACE DDB
	DDBSRL
CLRDD1:	MOVE	T2,T1
	HLRZ	T1,DEVSER(T2)	;GET SUCCESSOR TO THIS DDB
	SKIPN	T1		;END?
	STOPCD	CLRDD2,DEBUG,DNF, ;++ DDB NOT FOUND
	CAIE	T1,(F)		;NO. IS LINK THE ONE WE WANT?
	JRST	CLRDD1		;NO. TRY NEXT

;HERE WITH T2=LOC OF DDB WHOSE LINK IS THE ONE WE WANT
	MOVE	T3,DEVSER(F)	;LINK OF DDB WE ARE REMOVING
	HLLM	T3,DEVSER(T2)	;SAVE IN LINK OF PREDECESSOR
CLRDD2:	DDBSRU
	SKIPE	DINITF##	;IN ONCE-ONLY CODE?
	POPJ	P,		;YES, DON'T GIVE UP CORE
	HRRZ	T2,DEVSPM##(F)	;A SPOOLING PARAMETER BLOCK?
	JUMPE	T2,CLRDD3	;NO, JUST GO ON
	MOVEI	T1,SPBMAX##	;GET SIZE OF BLOCK
	PUSHJ	P,GVFWDS##	;AND GIVE IT BACK
CLRDD3:	MOVEI	T1,DDBLEN##	;NO OF 4-WORD BLOCKS TO RETURN
	HRRZ	T2,F		;LOC OF DDB TO CLEAR
	CAIG	T2,FYSORG+FYSSIZ ;DDB LIVE WITHIN
	CAIGE	T2,FYSORG	; FUNNY SPACE?
	PJRST	GIVWDS##	;NO, RETURN LOW CORE DDB
	PUSHJ	P,DMPFZR##	;ZERO F IN DUMP AC'S AND SAVED CONTEXT
	PJRST	GVFWDS##



;SUBROUTINE TO SET UP A DDB
;EXITS WITH F=LOC OF DDB
;EXIT CPOPJ IF NO FREE CORE, CPOPJ1 IF OK
FAKDDB::MOVEI	T2,DDBLEN##	;GET CORE FOR A DDB
	PUSHJ	P,GETWDS##
	  POPJ	P,		;NONE AVAILABLE - RETURN CPOPJ
FAKDDX::PUSHJ	P,SAVE1##
	SETZB	S,P1		;SO SETDDB WON'T CHANGE DEVMOD, CLEAR RANDOM BITS IN S
	PUSHJ	P,SETDDO	;GOT IT - MAKE A DDB FROM THE SPACE
	  STOPCD .,JOB,SER,	;++SETDDO ERROR RETURN
	MOVE	J,.CPJOB##	;SET UP J
	DPB	J,PJCHN##	;STORE IN DDB
	PJRST	CPOPJ1##	;AND TAKE SKIP-RETURN
;SUBROUTINE TO RETURN THE ACTUAL STR NAME FOR A DDB
;ENTER WITH F=LOC OF DDB
;EXIT CPOPJ IF NOT A DISK OR NO UNIT ASSOCIATED WITH DDB (LOOKUP NOT DONE)
;EXIT CPOPJ1 IF A DISK, WITH T1=NAME OF STR

NAMSTR::MOVE	T1,DEVMOD(F)	;IS DEVICE A DISK?
	TLNN	T1,DVDSK
	POPJ	P,		;NO, NON-SKIP RETURN
	HRRZ	T1,DEVFUN##(F)	;YES, GET SOME UNIT IN STR
	JUMPE	T1,CPOPJ##	;NONE - NO LOOKUP HAS BEEN DONE
	MOVE	T1,UNISTR(T1)	;GOT ONE. GET STR DATA BLOCK LOC
	MOVE	T1,STRNAM##(T1)	;NAME OF STR
	PJRST	CPOPJ1##	;SKIP-RETURN

SUBTTL	COMCON - COMMAND DECODER INTERFACE ROUTINES

;SUBROUTINE TO PERFORM "DISK" COMMAND - PRINT DISK ACCESSES
;CALL:	MOVE	J,JOB NO.
;	PUSHJ	P,DSKCOM	;CALLED FROM COMCON - COMMAND DECODER
;	ALWAYS RETURN
;PRINTS INCREMENTAL READS AND WRITES, TOTAL READS AND WRITES
;TOTAL BLOCKS ALLOCATED, AND KILO-DISK-MIN FOR ALL STRS COMBINED


DSKCOM::PUSHJ	P,SAVJW##	;PRESERVE J (W GETS A RIDE)
	PUSHJ	P,GETJOB##	;GET DECIMAL JOB NO. ARG IF ANY
	  JRST	DSKCM1		;NO ARG, ASSUME USER'S OWN JOB(AC [=J)
	MOVE	J,T2		;NO, SETUP JOB NUMBER
	JRST	DSKCM2		;PRINT DATA FOR SPECIFIED JOB

;HERE WHEN USER DID NOT SPECIFY A JOB NUMBER - SO DO HIS WITH INCREMENTAL
DSKCM1:	PUSHJ	P,INLMES##	;NO, PRINT MESSAGE
	ASCIZ	/Rd,Wt=/
	PUSHJ	P,DSKINC	;PRINT INCREMENTAL DISK READS
	PUSHJ	P,INLMES##	;COMMA
	ASCIZ	/,/
	PUSHJ	P,PRTWDW	;PRINT NO OF INCREMENTAL DISK WRITES
	PUSHJ	P,CRLF##	;PRINT CRLF
;STILL IN FTDSTT
;HERE TO PRINT DATA FOR ANOTHER JOB(IE DO NOT PRINT INCREMENTAL)
DSKCM2:	PUSHJ	P,INLMES##	;PRINT HEADING
	ASCIZ	/Rd,Wt=/
	LDB	T1,JBYRCT##	;TOTAL NO. OF READS FOR JOB SINCE LOG-IN
	PUSHJ	P,RADX10##	;PRINT DECIMAL
	PUSHJ	P,INLMES##	;PRINT COMMA
	ASCIZ	/,/
	LDB	T1,JBYWCT##	;TOTAL NO. OF WRITES FOR JOB SINCE LOGIN
	PUSHJ	P,RADX10##	;PRINT DECIMAL
REPEAT 0,<			;ALLOCATION NOT CODED YET
	PUSHJ	P,INLMES##	;PRINT HEADER
	ASCIZ	/
Al=/
	LDB	T1,JBYTDB	;NO. OF BLOCKS ON ALL STRS FOR JOB
	PUSHJ	P,RADX10##	;PRINT
	PUSHJ	P,INLMES##	;PRINT HEADER
	ASCIZ	/
Kilo-dsk-min=/
	MOVE	T1,JBTTDB(J)	;TOTAL DISK BLOK SEC SO FAR
				;***NEED TO RECOMPUTE*** ON COMMAND
	IDIVI	T1,^D60*^D1000/^D128	;CONVERT TO J-MIN
	PUSHJ	P,RADX10##	;PRINT DECIMAL
>	;END REPEAT 0
	PJRST	CRLF##		;PRINT CRLF AND RETURN

;ROUTINE TO PRINT DISK BLOCK # FOR CONTROL-T
DSKCTT::MOVE	S,DEVIOS(F)	;GET I/O STATUS
	JUMPL	S,DSCTT2	;JUMP IF IOSMON=1
	TLNE	S,IOSUPR	;SUPER MODE?
	JRST	DSCTT1		;YES -- PRINT BLOCK #
	MOVE	T1,DEVREL##(F)
	CAIG	T1,0		;EARLY BLOCK?
	JRST	DSCTT2		;YES -- ASSUME MONITOR I/O
DSCTT1:	MOVEI	T1,[ASCIZ " block "]
	PUSHJ	P,CONMES##	;PRINT TITLE
	TLNN	S,IOSUPR	;SUPER I/O
	SKIPA	T1,DEVREL##(F)	;NO--GET RELATIVE BLOCK
	MOVE	T1,DEVBLK##(F)	;YES--GET ABSOLUTE BLOCK #
	PJRST	RADX10##	;PRINT THE NUMBER
DSCTT2:	MOVEI	T1,[ASCIZ " (Monitor I/O)"]
	PJRST	CONMES##


;SUBROUTINE TO PRINT NO OF DISK WRITES (RESULT OF WATCH COMMAND)
;CALL:	MOVE J,JOB NO [J=J]
;	PUSHJ P,PRTWDW
PRTWDW::ADDI	J,JBDIRD##	;INCREASE JOB NO BY DIFF IN READ/WRITE TABLE ORIGINS
	PUSHJ	P,DSKINC	;PRINT INCREMENTAL DISK WRITES
	MOVEI	J,MJBDRD##(J)	;DECREASE JOB NO BY DIFF IN TABLE ORIGINS
	POPJ	P,


;SUBROUTINE TO PRINT INCREMENTAL NO. OF BLOCKS READ OR WRITTEN
;CALL:	MOVE	J,JOB NO.(J=J)
;	PUSHJ	P,DSKINC
;	ALWAYS RETURN


PRTWDR::			;PRINT INCREMENTAL NO OF BLOCKS READ
DSKINC:	LDB	T1,JBYRCT##	;TOTAL NO OF READS(OR WRITES) FOR JOB
	LDB	T2,JBYIRD##	;INCREMENTAL SETTING(LOW ORDER N BITS
				; OR TOTAL NO.)
	DPB	T1,JBYIRD##	;UPDATE INCREMENTAL SETTING WITH CURRENT TOTAL
	SUB	T1,T2		;DIFFERENCE CUR TOTAL-LAST TOTAL
	ANDI	T1,JBRIRD##	;MASK OUT ALL BITS OUTSIDE INCREMENTAL FIELD
	PJRST	RADX10##	;PRINT DECIMAL AND RETURN
;COMMAND TO PRINT FILE STRUCTURES IN SYSTEM, AND UNITS NOT IN STRUCTURES
; (RESOURCES COMMAND)
DSKRES::PUSHJ	P,SAVE1##	;SAVE P1
	HLRZ	P1,SYSSTR##	;FIRST STR DATA BLOCK ADDRESS

DSKR1:	SKIPE	T2,STRNAM##(P1)	;FILE STRUCTURE NAME
	PUSHJ	P,NAMCOM	;TYPE NAME AND COMMA
	HLRZ	P1,STRSYS##(P1)	;NEXT STR LOC
	JUMPN	P1,DSKR1	;TYPE NAME IF THERE IS ONE


	HLRZ	P1,SYSUNI##	;ADDR OF 1ST UNIT IN SYSTEM
DSKR2:	MOVE	T2,UDBNAM(P1)	;PHYSICAL UNIT NAME
	EXCH	P1,U		;SETUP U FOR UNYUST
	LDB	T1,UNYUST##	;GET UNIT STATUS
	EXCH	P1,U		;RESTORE U FOR NAMCOM
	CAIN	T1,UNVDWN	;DOWN OR DOESN'T EXIST?
	JRST	DSKR4		;YES, DON'T PRINT
	SKIPN	UNILOG(P1)	;NO SKIP IF UNIT IS NOT IN A FILE STRUCTURE
	PUSHJ	P,NAMCOM	;YES, TYPE ITS NAME
DSKR4:	HLRZ	P1,UNISYS(P1)	;STEP TO NEXT UNIT IN SYSTEM
	JUMPN	P1,DSKR2	;TEST IT IF NOT THE END
	POPJ	P,		;THROUGH - RETURN


;SUBROUTINE TO TYPE NAME AND COMMA    T2=SIXBIT NAME
NAMCOM:	PUSHJ	P,PRNAME##	;PRINT NAME
	JSP	T1,CONMES##	;THEN COMMA AND RETURN
	ASCIZ	/,/
;ROUTINE TO TURN OFF OPR MESSAGES FOR AN OFF-LINE DISK
;ENTER T1=(PHYSICAL) NAME
;NON SKIP-RETURN IF NOT A DISK OR NOT IN OPR WAIT
;SKIP-RETURN IF OK
DSKQUI::CAMN	T1,[SIXBIT /RIB/]
	JRST	DSKQU2
	CAMN	T1,[SIXBIT /DSKERR/]
	JRST	DSKQU3
	PUSH	P,U		;SAVE U
	PUSHJ	P,MSKUNI##	;GENERATE MASK FOR UNIT
	PUSHJ	P,SRUNI##	;FIND UNIT
	  PJRST	UPOPJ##		;NO MATCH
	  PJRST	UPOPJ##		;LOGICAL NAME MATCH - NOT GOOD ENOUGH
	MOVE	T1,UNISTS(U)	;STATUS OF UNIT
	CAIE	T1,OCOD##	;IS IT OPR WAIT?
	PJRST	UPOPJ##		;NO, NON-SKIP RETURN
	MOVEI	T1,O2COD##	;YES
	PUSHJ	P,BTHSTS##	;STORE IT
	PJRST	UPOPJ1##	;SKIP RETURN

;HERE TO SET RIB-ERROR THRESHOLD
DSKQU2:	PUSHJ	P,DECIN1##	;GET THRESHOLD
	  POPJ	P,
	  POPJ	P,
	MOVEM	T2,RIBECT##	;SAVE
	PJRST	CPOPJ1##	; AND GOOD-RETURN


;HERE TO SET DSK ERROR THRESHOLD
DSKQU3:	PUSHJ	P,DECIN1##	;GET THRESHOLD
	  POPJ	P,
	  POPJ	P,
	MOVEM	T2,HERLIM##	;SAVE
	PJRST	CPOPJ1##	;AND GOOD RETURN
;SUBROUTINE TO CLEAN UP CORE ON A KJOB COMMAND
;CALLED AT CLOCK LEVEL IF NO CORE, UUO LEVEL IF CORE WHEN JOB IS KILLED
;CALL	MOVE J,JOB NUMBER
;	PUSHJ P,DSKKJB
DSKKJB::PUSHJ	P,SFDPPN	;FIND DEFAULTS FOR JOB
	JUMPE	T1,DSKKJ1	;NONE IF T1=0
	PUSHJ	P,SAVE2##	;SAVE P1-P2
	MOVE	P1,T4		;SAVE DEFLT PPN
	HLRZ	P2,T1		;SAVE DEFLT LOC (SFD OR PPB)
	SKIPE	T1,T2		;IS THERE A DEFAULT SFD?
	PUSHJ	P,DECALL	;YES, DECR. ALL USE-COUNTS FOR IT
	CAMN	P1,JBTPPN##(J)	;IS IT JOB'S PPN?
	JRST	DSKKJ1		;YES
	PUSHJ	P,FAKDDB	;NO, SET UP A FAKE DDB FROM FREE CORE
	  JRST	DSKKJ2
	MOVE	T1,P1		;GOR ONE, T1=DEFAULT PPN
	PUSHJ	P,PTHCHG	;DELETE CORE BLOCKS, REWRITE NEW QUOTA INFO
	PUSHJ	P,CLRDDB	;GIVE UP THE DDB
	MOVE	J,.CPJOB##	;RESET J
DSKKJ1:	HLRZ	P2,JBTSFD##(J)	;PPB OF LIB
	TRZ	P2,CORXTR##	;ZAP THE EXTRA BITS
	JUMPE	P2,DSKKJ2	;FORGET IT IF NO LIB
	PUSHJ	P,FAKDDB	;THERE IS - GET A DDB
	  JRST	DSKKJ2		;CANT GET ONE, CONTINUE
	MOVE	T1,PPBNAM##(P2)	;GET PPN OF LIB
	PUSHJ	P,PTHCHG	;FINISH UP IF NO OTHER JOBS USING
	PUSHJ	P,CLRDDB	; THE PPN NOW
DSKKJ2:	SKIPN	.USLNM		;ANY LOGICAL NAMES?
	JRST	DSKKJ5		;NO
	SETZ	T4,		;YES, START AT FIRST
DSKKJ3:	SKIPN	@.USLNM		;PICK UP NEXT LOGICAL NAME
	JRST	DSKKJ4		;DONE
	PUSHJ	P,PTKUDF	;UNDEFINE IT, RETURN FUNNY SPACE
	  JFCL
	AOJA	T4,DSKKJ3	;AND TRY NEXT
DSKKJ4:	MOVEI	T1,LNMMAX##+MAXLVL##+1 ;GIVE UP THE LOGICAL NAME TABLE SPACE
	HRRZ	T2,.USLNM
	PUSHJ	P,GVFWDS##
	SETZM	.USLNM
				;FALL INTO DSKKJ5
DSKKJ5:	MOVE	J,.CPJOB##	;RESET J
	SETZM	JBTSFD##(J)	;CLEAR DEFAULT DIRECTORY
	HLRZ	T2,.USSWI
	JUMPE	T2,DSKKJ6
	HRRZ	T1,SWILEN##(T2)	;FUNNY SPACE WHERE SWITCH.INI IS SAVED
	PUSHJ	P,GVFWDS##	;RETURN IT
	HRRZS	.USSWI
DSKKJ6:	MOVE	T1,JBTPPN##(J)	;GET PPN
	PUSHJ	P,ONLYTS	;IS THERE ANY JOB USING THIS PPN?
	  CAIA			;YES
	PUSHJ	P,DSKLGO	;NO, DELETE DISK 4-WORD CONTROL BLOCKS
	SCHEDULE		;TURN SCHEDULING BACK ON
	SKIPN	.USSBF		;WILL RETURN IT ELSEWHERE IF .UPSBF NON-0
	SKIPN	T1,.USMBF	;HAVE MON BUFF?
	POPJ	P,		;NO, THATS ALL
	SETZM	.USMBF

;SUBROUTINE TO RETURN MONITOR BUFFER
;ENTER WITH T1=LOC OF MON BUF-1
GVMNBF:	MOVEI	T2,1(T1)	;START ADR OF MON BUF
	MOVEI	T1,BLKSIZ##
	PUSHJ	P,GVFWDS##	;RETURN THE MONITOR BUFFER
	POPJ	P,		;AND EXIT
;SUBROUTINE TO FIX UP DATA BASE WHEN SET DATA/TIME COMMAND
;CALLED WITH T1 INCREMENTAL TIME TO FUDGE
;MUST PRESERVE T1!

FILSDT::
IFN FTMDA,<
	HLRZ	T2,SYSUNI##	;GET FIRST UNIT IN UDB CHAIN
SDT.1:	SKIPE	UNILTM(T2)	;LOCK TIME SET?
	ADDM	T1,UNILTM(T2)	;YES--FIX IT UP
IFN FTDUAL,<
	SKIPE	T3,UNI2ND(T2)	;DUAL PORTED?
	SKIPN	UNILTM(T3)	;YES--LOCK TIME SET?
	CAIA			;NO
	ADDM	T1,UNILTM(T3)	;YES--FIX IT UP TOO
>;END IFN FTDUAL
	HLRZ	T2,UNISYS(T2)	;GET NEXT UDB
	JUMPN	T2,SDT.1	;LOOP IF MORE
>;END FTMDA
	POPJ	P,		;AND RETURN
	SUBTTL	QUESER - INTERFACE ROUTINES

;FILIRC	-- INCREMENT READER COUNT OF FILE
;CALL:
;	MOVE	T1,ACCESS-TABLE-ADDRESS
;	PUSHJ	P,FILIRC
;	RETURN HERE ALWAYS

FILIRC::PUSH	P,T2		;SAVE T2
	MOVEI	T2,ACPCNT##	;GET 1 FIELD FOR A.T. READ COUNT
	ADDM	T2,ACCCNT##(T1)	;INCREMENT READ COUNT SO FILE STAYS
	JRST	T2POPJ##	;RETURN

;FILDRC	-- DECREMENT READER COUNT OF FILE
;CALL:
;	MOVE	T1,ACCESS-TABLE-ADDRESS
;	PUSHJ	P,FILDRC
;	RETURN HERE ALWAYS

FILDRC::PUSH	P,T2		;SAVE T2
	MOVNI	T2,ACPCNT##	;-1 IN COUNT FIELD
	ADDM	T2,ACCCNT##(T1)	;DECREMENT READER COUNT IN A.T.
	JRST	T2POPJ##	;RETURN

;FILNDR	-- SET 'NO DELETE ON RESET' STATUS BIT
;CALL:
;	MOVE	T1,ACCESS-TABLE-ADDRESS
;	PUSHJ	P,FILNDR
;	RETURN HERE ALWAYS

FILNDR::PUSH	P,T2		;SAVE T2
	MOVEI	T2,ACPNDR##	;GET NO DELETE ON RESET BIT
	IORM	T2,ACCSTS##(T1)	;PUT IN STATUS WORD
	JRST	T2POPJ##	;RETURN

;FILGFC	-- CHECK TO SEE IF FILE IS A GHOST FILE
;CALL:
;	MOVE	T1,ACCESS-TABLE-ADDRESS
;	PUSHJ	P,FILGFC
;	  <IF FILE IS A GHOST FILE>
;	<IF FILE IS NOT A GHOST FILE>

FILGFC::PUSH	P,T2		;SAVE T2
	MOVE	T2,ACCSTS##(T1)	;GET A.T. STATUS
	TRNE	T2,ACPDEL##!ACPSUP!ACPCRE ;GHOST FILE? (BEING CREATED
				; OR SUPERSEDED)
	JRST	T2POPJ##	;YES, RETURN
	JRST	T2POJ1##	;NOT A GHOST FILE, SKIP RETURN
SUBTTL	DISK. UUO - MISC DISK FUNCTIONS

;CALLI AC,DISK.
;LH(AC)=FUNCTION RH(AC)=ADR

DSKUUO::HLRE	T2,T1		;FUNCTION
	CAML	T2,[-CDULEN]	;LEGAL CUSTOMER FUNCTION?
	CAILE	T2,DUULEN	;LEGAL?
	PJRST	RTM1##		;NO, ERROR RETURN
	HRR	M,T1		;ADDRESS
	SKIPL	T2,DUUTBL(T2)	;PRIV'D?
	JRST	(T2)		;NO, DISPATCH
	PUSHJ	P,PRVJ##	;YES, CAN THIS JOB DO THE FUNCTION?
	  JRST	(T2)		;YES, DISPATCH
	PJRST	RTM2##		;NO, RETURN AC=-2

CDUTBL:!			;START OF CUSTOMER DISK. UUO FUNCTIONS
				;INSERT CUSTOMER FUNCTIONS HERE
DUUTBL:	EXP	PRIUUO		;SET DISK PRIORITY
	XWD	400000,SETCPT##	;(1) SET 10/11 COMPATABILITY MODE
	XWD	400000,CLRCPT##	;(2) CLEAR 10/11 COMPATABILITY MODE
	XWD	400000,UNLOAD##	;(3) UNLOAD A DRIVE (RP04)
	XWD	400000,SOONDN##	;(4) TAKE CHAN/KONTROLLER OFF LINE SOON
	XWD	400000,NOWDWN##	;(5) TAKE CHAN/KONTROLLER OFF LINE NOW
	XWD	400000,NOWUP##	;(6) PUT CHAN/KONTROLLER BACK ON LINE
	XWD	0,CMPRSS	;(7) SET TO CALL UFD COMPRESSOR
	XWD	400000,REMSWP##	;(10) REMOVE A SWAPPING UNIT
	XWD	400000,ADDSWP##	;(11) ADD A SWAPPING UNIT
	XWD	400000,SDLADD	;(12) ADD STRUCTURE TO SYSTEM DUMP LIST
	XWD	400000,SDLREM	;(13) REMOVE STRUCTURE FROM SYSTEM DUMP LIST
	XWD	0,LENGTH	;(14) TELL LENGTH OF FILE
IFN FTMDA,<
	XWD	400000,CLRMDA##	;(15) CLEAR A DISK UNIT FROM MDA
>
IFE FTMDA,<
	XWD	400000,CPOPJ1## ;(15) FEATURE TEST OFF
>
	XWD	0,GGUFBT##	;(16) GET UFBTAL FOR STR:[P,PN]
DUULEN==.-DUUTBL-1
CDULEN==DUUTBL-CDUTBL		;MAXIMUM LEGAL CUSTOMER FUNCTION
;ERROR CODES RETURNED BY DISK. UUO FUNCTIONS 12 AND 13

DUDND%==1		;NO SUCH STRUCTURE
DUDNC%==2		;NO CRASH SPACE ON STRUCTURE
DUDAD%==3		;STRUCTURE ALREADY IN SYSTEM DUMP LIST
DUDDF%==4		;SYSTEM DUMP LIST FULL
DUDNS%==1		;STRUCTURE NOT IN SYSTEM DUMP LIST


ERCODE	DSUNSS,DUDND%
ERCODE	DSUNKC,DUDNC%
ERCODE	DSUADL,DUDAD%
ERCODE	DSUDLF,DUDDF%
ERCODE	DSUNDL,DUDNS%
; DISK. UUO FUNCTION 12 - ADD A STRUCTURE TO THE SDL

SDLADD:	PUSHJ	P,SAVE1##	;SAVE P1
	PUSHJ	P,GETWDU##	;GET THE SIXBIT STR NAME
	PUSHJ	P,SRSTR##	;FIND STR DATA BLOCK
	  JRST	DSUNSS		;NO SUCH STRUCTURE
	MOVE	P1,T3		;COPY TO A SAFE PLACE
	HRRZ	T1,STRK4C##(P1)	;GET K FOR CRASH
	JUMPE	T1,DSUNKC	;NO CRASH SPACE
	SKIPL	STRSDL##(P1)	;ALREADY IN THE SDL?
	  JRST	DSUADL		;YES--ERROR
	PUSHJ	P,SDLFRE	;FIND THE FIRST FREE ENTRY
	  JRST	DSUDLF		;ERROR IF SDL IS FULL
	MOVEM	T2,STRSDL##(P1)	;STORE POSITION IN THE STR DB
	PUSHJ	P,SDLBLD##	;REBUILD THE PRESERVED SDL
	  JFCL			;BOOTSTRAP NOT AVAILBLE
	PUSHJ	P,FRCCPY##	;COPY ANY UNPROCESSED DUMP ON THIS STR
	JRST	CPOPJ1##	;RETURN


; DISK. UUO FUNCTION 13 - REMOVE A STRUCTURE FROM THE SDL

SDLREM:	PUSHJ	P,GETWDU##	;GET SIXBIT STRUCTURE NAME
	PUSHJ	P,SDLCHK	;SEE IF IT'S IN THE SDL
	  JRST	DSUNDL		;IT'S NOT
	SETOM	STRSDL##(T3)	;REMOVE FROM THE SDL
	PUSHJ	P,SDLBLD##	;REBUILD THE PRESERVED SDL
	  JRST	DSUNDL		;NO BOOTSTRAP
	JRST	CPOPJ1##	;RETURN


; CHECK FOR A STR IN THE SDL
SDLCHK:	PUSHJ	P,SRSTR##	;FIND THE STR WITH THIS NAME
	  POPJ	P,		;NOT IN SDL IF DOESN'T EXIST
	SKIPL	STRSDL##(T3)	;IF STR IS IN SDL,
	AOS	(P)		;THEN SKIP
	POPJ	P,		;RETURN


; FIND THE FIRST FREE POSITION IN THE SDL
SDLFRE:	SETZ	T1,		;INIT MASK
	MOVEI	T2,DIFSTR##	;GET PRDECESSOR OF SYSSTR
SDLFR1:	HLRZ	T2,STRSYS##(T2)	;GET NEXT STR IN SYSTEM
	JUMPE	T2,SDLFR2	;DONE SEARCHING IF NO MORE
	SKIPGE	T3,STRSDL##(T2)	;GET STR'S POSITION IN THE SDL
	JRST	SDLFR1		;NOT IN THE SDL
	ANDI	T3,77		;PARANOIA
	IOR	T1,BITTBL##(T3)	;INCLUDE THIS BIT
	JRST	SDLFR1		;LOOP OVER ALL STR DB'S
SDLFR2:	SETCA	T1,		;FLIP BITS
	JFFO	T1,CPOPJ1##	;RETURN FIRST FREE POSITION
	POPJ	P,		;NON-SKIP IF FULL
CMPRSS:	PUSHJ	P,SAVE1##
	PUSHJ	P,GETWDU##	;GET CHAN
	MOVE	P1,T1		;WHERE WE EXPECT CHAN
	PUSHJ	P,VALUUO##	;SET UP F
	  POPJ	P,		;NO OPEN DISK ON THAT CHAN
	HRRZ	T1,DEVUFB##(F)
	JUMPE	T1,CPOPJ1##	;FORGET IT IF NO OPEN FILE
	MOVSI	T2,UFPZRB##	;LIGHT A BIT TO CALL
	IORM	T2,UFBZRB##(T1)	;COMPRESSOR AT NOTOLD
	JRST	CPOPJ1##	;AND RETURN


;FUNCTION TO RETURN LENGTH OF A FILE
LENGTH:	PUSHJ	P,GETWDU##	;CHAN
	PUSHJ	P,SAVE1##
	MOVE	P1,T1
	PUSHJ	P,VALUUO##	;SET UP F
	  PJRST	ECOD2##		;NOT A DISK
	HRRZ	T1,DEVACC##(F)
	JUMPE	T1,ECOD1##	;NO OPEN FILE
	MOVE	T1,ACCWRT##(T1)	;SIZE OF FILE
	AOS	(P)
	PJRST	STOTAC##	;TELL USER AND RETURN
PRIUUO:	HRR	M,T1		;LOC OF ARGUMENT
	PUSHJ	P,GETWDU##	;GET IT
	HRRE	T2,T1		;PRIORITY HE'S TRYING TO SET
	PUSHJ	P,PRCHK		;LEGAL?
	  PJRST	ECOD1##		;NO, NON-SKIP
	PUSHJ	P,SAVE1##
	MOVSI	T3,DVDSK
	HLRE	T1,T1		;YES, GET CHAN NUMBER
	TRO	T2,DEPUUO	;LIGHT THE SET-BY-UUO BIT
	JUMPL	T1,PRIUU1	;IS IT A REAL CHAN?
	MOVE	P1,T1		;YES, LEGAL?
	PUSHJ	P,SETUF##	;YES, IS A FILE OPEN ON THE CHAN?
	  PJRST	ECOD2##		;NO, NON-SKIP RETURN
	PUSHJ	P,PRIDEP	;YES, SAVE NEW PRIORITY IN DDB
	PJRST	CPOPJ1##	;AND RETURN

;HERE IF CHAN IS NEGATIVE
PRIUU1:	AOJE	T1,PRIUU3	;GO IF LH(ADR)=-1
	AOJN	T1,ECOD3##	;ERROR IF LH NOT=-2
PRIUU2:	DPB	T2,JBYPRI##	;-2, SET JOB'S DISK PRIORITY
	PJRST	CPOPJ1##	;AND GOOD RETURN

;HERE IF SETTING PRIORITY FOR ALL OPEN CHANS
PRIUU3:	SETZ	P1,		;NO OF OPEN CHANS
PRIUU4:	PUSHJ	P,NXTCH##	;THIS CHAN OPEN?
	  JRST	CPOPJ1##
	MOVE	F,T1
	PUSHJ	P,PRIDEP	;YES, SET PRIORITY IN DDB
	JRST	PRIUU4		;LOOP FOR ALL CHANS
PRICOM::PUSHJ	P,PRCHK		;HERE ON COMMAND.  LEGAL?
	  POPJ	P,		;NO
	JRST	PRIUU2		;YES, SET JOB'S PRIORITY AND EXIT

;SUBROUTINE TO DETERMINE IF SETTING DISK PRIORITY IS LEGAL
;ENTER T2=DESIRED PRIORITY
;EXIT CPOPJ IF NO, CPOPJ1 IF YES
;PRESERVES T1
PRCHK:	LDB	T3,JBZPRI##	;MAX PRIORITY JOB CAN SET
	CAMLE	T2,T3		;TRYING TO SET HIGHER?
	POPJ	P,		;YES, ERROR RETURN
	JUMPGE	T2,CPOPJ1##	;NO, OK IF POSITIVE
	MOVMS	T2		;NEGATIVE.  GET +N
	CAILE	T2,3		;TO LOW?
	MOVEI	T2,3		;YES, SET MAX NEGATIVE VALUE
	TRO	T2,MINDPR	;SET THE NEGATIVE-BIT
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;SUBROUTINE TO SET DISK PRIORITY
PRIDEP:	TDNE	T3,DEVMOD(F)	;IS IT A DISK?
	DPB	T2,DEXPRI##	;YES, SET PRIORITY
	POPJ	P,
SUBTTL	INPUT/OUTPUT UUO'S

;BUFFERRED MODE INPUT

INPT:	PUSHJ	P,NULTST	;IF NULL DEVICE,
	  JRST	SETION		; RETURN EOF
	PUSHJ	P,SPTSTI	;SEE IF 1ST SPOOLED INPUT
	  PJRST	SETION		;YES, AND NO FILE - SET IOEND

	TLNE	S,IOSUPR	;SUPER USETI DONE?
	JRST	INPSW9		;YES

	TLNN	F,LOOKB		;LOOKUP BEEN DONE?
	PJRST	SETIMP		;NO, LIGHT IOIMPM AND RETURN
INPSW9:	TLZ	S,IO		;NO. INDICATE INPUT
	MOVEM	S,DEVIOS(F)	;SAVE S
	PUSHJ	P,SAVE2##	;SAVE SOME ACS
	PUSHJ	P,UUOSET##	;SET DDB PNTRS FOR THIS BLOCK
	  JRST	INPT1		;EOF. LIGHT A BIT
	MOVE	T1,DEVFIL(F)
	HLRZ	T2,DEVEXT(F)
	CAMN	T1,[SIXBIT /SWITCH/]
	CAIE	T2,'INI'	;READING SWITCH.INI?
	PJRST	UUOPWR##	;NO. GO QUEUE REQUEST
	MOVE	T4,.CPJOB##	;YES, READING THIS JOB'S SWITCH.INI?
	MOVE	T4,JBTPPN##(T4)
	SKIPN	DEVSFD##(F)
	CAME	T4,DEVPPN(F)
	JRST	UUOPWR##	;NO, GO DO NORMAL STUFF
;HERE WHEN USER IS READING SWITCH.INI. WORRY ABOUT IN-CORE COPY
	PUSHJ	P,SAVE3##
	HLRZ	P1,.USSWI	;LOC OF FUNNY-SPACE SWITCH.INI
	HRRZ	P2,DEVACC##(F)	;AT FOR ONE WE JUST LOOKED UP
	MOVE	T2,P2
	LDB	T1,ACYLBS##	;SIZE OF LOOKED-UP COPY
	MOVE	P3,ACCWRT##(P2)
	SUBI	P3,1
	LSH	P3,BLKLSH##	;SIZE IN WORDS OF SWITCH.INI
	ADD	P3,T1
	HRL	P3,ACCUN1##(P2)	;UNIT OF LOOKED-UP COPY
	JUMPE	P1,INPSW1	;GO IF NO FUNNY-SPACE COPY
	MOVE	T1,ACCPRV##(P2)	;PRIVS/CREATION DATE,TIME
	CAME	T1,SWIPRV##(P1)	;MATCH?
	JRST	INPSW1		;NO, READ NEW ONE INTO FUNNY SPACE
	MOVE	T1,ACCPT1##(P2)	;1ST PNTR OF FUNNY-SPACE COPY
	CAMN	T1,SWIPT1##(P1)	;ARE THEY THE SAME?
	CAME	P3,SWIUN1##(P1)
INPSW1:	SKIPA	T1,DEVREL##(F)	;NO, SET TO COPY TO FUNNY SPACE
	JRST	INPSW7		;YES, GIVE FUNNY COPY TO USER
	SOJN	T1,UUOPWR##	;JUST READ FILE IF NOT 1ST BLOCK (TOO LARGE)
	JUMPE	P1,INPSW3	;GO IF DON'T ALREADY HAVE ONE
	PUSHJ	P,GETNMB	;ALREADY HAVE ONE IN FUNNY SPACE
	HLRZ	T1,NMBACC##(T1)
INPSW2:	CAIE	T1,(P2)		;LOOK FOR AN A.T.
	SKIPE	ACCDOR##(T1)	;IF NOT OURS AND NOT DORMANT
	SKIPA	T2,P1
	JRST	UUOPWR##	; WE CAN'T GET RID OF THIS COPY
	HLRZ	T1,ACCNMB##(T1)
	TRNN	T1,DIFNAL##	;LOOK FOR ANOTHER A.T.
	JRST	INPSW2
	HRRZ	T1,SWILEN##(P1)	;YES, RETURN IT
	PUSHJ	P,GVFWDS##
	HRRZS	.USSWI		;CLEAR POINTER TO IT
				;FALL INTO INPSW3
INPSW3:	MOVE	T2,ACCWRT##(P2)	;SIZE OF CURRENT SWITCH.INI
	CAILE	T2,3		;TOO LARGE TO FIT?
	PJRST	UUOPWQ##	;YES, JUST PLAIN READ INTO USER SPACE
	LSH	T2,BLKLSH##	;FITS FINE. COMPUTE NO OF WORDS WE NEED
	ADDI	T2,SWIDAT##
	MOVE	P1,T2		;SAVE LENGTH
	PUSHJ	P,GTFWDC##	;GET SPACE FOR IT
	  PJRST	UUOPWQ##	;OH WELL, JUST READ INTO USER SPACE
	EXCH	P1,T1		;SAVE LOC, GET LENGTH
	HRLM	P1,.USSWI	;SAVE LOC IN UPMP
	MOVEM	P3,SWIUN1##(P1)	;SAVE UN1,,NO OF WORDS
	MOVEM	T1,SWILEN##(P1)	;SAVE NUMBER OF FUNNY-SPACE WORDS WE HAVE
	MOVE	T1,ACCPT1##(P2)
	MOVEM	T1,SWIPT1##(P1)	;SAVE RETIREVAL POINTER
	MOVE	T1,ACCPRV##(P2)	;SAVE CREATION DATE,TIME
	MOVEM	T1,SWIPRV##(P1)
	PUSHJ	P,GTMNBF##	;NOW READ SWITCH.INI INTO FUNNY SPACE
INPSW4:	MOVE	T2,DEVBLK##(F)	;READ A BLOCK
	PUSHJ	P,MONRDU##	;READ NOT FROM DISK CACHE
	JUMPN	T3,INPSW5	;LOSE IF IO ERROR
	MOVE	T2,DEVREL##(F)	;RELATIVE BLOCK OF FILE
	LSH	T2,BLKLSH##	;COMPUTE WHERE IT GOES IN FUNNY SPACE
	CAMLE	T2,SWILEN##(P1)	;IF ABOVE TOP
	JRST	INPSW5		; SOME OTHER JOB IS MAKEING IT LARGER
	ADDI	T2,SWIDAT##-BLKSIZ##(P1)
	HRLI	T2,1(T1)
	MOVE	T1,T2		;SAVE IT IN USER'S SPACE
	BLT	T2,BLKSIZ##-1(T1)
	AOS	DEVREL##(F)	;POINT TO NEXT BLOCK OF FILE
	AOS	DEVBLK##(F)
	SOS	DEVLFT##(F)
	PUSHJ	P,UUOSET##	;SET TO READ NEXT BLOCK
	  JRST	INPSW6		;EOF
	MOVE	T1,.USMBF	;NEXT BLOCK IS THERE - GO READ IT
	JRST	INPSW4
;HERE ON IO ERROR READING SWITCH.INI
INPSW5:	PUSHJ	P,INPSW8	;RESET DDB TO POINT AT 1ST BLOCK
	HRRZ	T2,P1
	HRRZ	T1,SWILEN##(P1)
	PUSHJ	P,GVFWDS##	;RETURN THE FUNNY SPACE
	HRRZS	.USSWI
	PJRST	UUOPWQ##	; AND READ INTO USER'S AREA

;HERE WHEN ALL OF SWITCH.INI IS IN CORE
INPSW6:	TRNE	S,IOIMPM+IOBKTL+IODTER+IODERR  ;ANY ERRORS?
	JRST	INPSW5		;YES
	PUSHJ	P,INPSW8	;RESET DDB TO POINT AT 1ST BLOCK OF FILE

;HERE TO READ FIRST (OR NEXT) BLOCK OF SWITCH.INI
INPSW7:	SKIPN	T3,DEVREL##(F)
	PJRST	UUOPWQ##	;READING RIB (DIRECT) IF 0
	SUBI	T3,1		;CONVERT BLOCK NUMBER
	LSH	T3,BLKLSH##	;TO WORD COUNT
	HRRZ	T4,SWIUN1##(P1)	;TOTAL LENGTH OF FILE
	SUB	T4,T3		;NUMBER OF WORDS LEFT TO READ
	HRRZ	T2,DEVIAD(F)	;GET THE USER'S BUFFER ADDRESS
	EXCTXU	<HLRZ T1,(T2)>	;GET THE BUFFER SIZE
	ADDI	T2,2		;POINT TO THE BUFFER DATA
	SUBI	T1,1		;GET RID OF OVERHEAD
	CAMLE	T4,T1		;READING LAST BLOCK?
	MOVE	T4,T1		;NO.  READ A WHOLE BUFFER
	EXCTXU	<MOVEM T4,-1(T2)> ;STORE AS WORDCOUNT OF FILE
	ADDI	T4,BLKSIZ##-1	;ROUND UP TO THE
	ANDI	T4,MBLKSZ##	; NUMBER OF BLOCKS THIS IS
	ADDI	T3,SWIDAT##(P1)	;POINT TO THE SOURCE OF THE DATA
	HRL	T2,T3		;SET UP BLT POINTER
	HRRZ	T1,T2		;COPY THE BUFFER POINTER
	ADDI	T1,-1(T4)	;COMPUTE LAST WORD TO WRITE
	EXCTXU	<BLT T2,(T1)>	;COPY CURRENT BLOCK TO USER SPACE
	LSH	T4,-BLKLSH##	;CONVERT WORD COUNT TO BLOCK COUNT
	ADDM	T4,DEVBLK##(F)	;POINT DDB AT NEXT BLOCK
	ADDM	T4,DEVREL##(F)
	MOVNS	T4		;NEGATE BLOCK COUNT
	ADDM	T4,DEVLFT##(F)
	PUSHJ	P,ADVBFF##	;TELL UUOCON THE BUFFER IS FULL
	  JFCL
	JRST	CPOPJ1##	;AND GO AWAY HAPPY

;SUBROUTINE TO RESET TO READ 1ST BLOCK OF SWITCH.INI
INPSW8::HRRZ	T3,DEVACC##(F)	;POINT TO ACCESS TABLE
	PUSHJ	P,AT2DDB##	;RESET TO FIRST BLOCK
	  JFCL			;ALLOW IT TO PROPAGATE
	PJRST	CPZPTR##	;AND COPY
;HERE ON EOF (KEEP GOING IF CONTINUED DIRECTORY)
INPTU:	PUSHJ	P,UUOSET##
INPT1:	  TLOA	S,IOEND		;LIGHT EOF BIT
	PJRST	UUOPWR##
;IF THE FILE BEING READ IS A DIRECTORY, NO EOF TILL ALL STR'S LOOKED AT
	MOVE	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCDIR##(T1)
	TRNE	T1,ACPDIR##	;A DIRECTORY?
	PUSHJ	P,SETSRC##	;YES. GET SEARCH LIST
	  PJRST	STOIOS##	;NO. REAL EOF
	PUSH	P,T1		;SAVE SL PTR
	SETZ	P1,		;COUNT NUMBER OF STRS IN SL
	MOVE	P2,T1
UFDSR5:	PUSHJ	P,SLITA##
	 SKIPA	P2,(P)		;RESET SL PTR
	AOJA	P1,UFDSR5
	SOJE	P1,UFDSR3	;ONLY ONE STR, LEAVE THINGS ALONE
;HERE WITH P1 NON-0
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	LDB	T1,ACYFSN##	;CURRENT STR NUMBER
	PUSHJ	P,SLFNA##	;FIND IT IN SEARCH LIST
	  JRST	UFDSR3		;DONE IF NOT THERE

;P2 NOW HAS PREDECREMENTED PTR TO NEXT STR (FOR CALL TO FNDFIL BELOW)
	PUSHJ	P,SFDUP		;BUMP PPBCNT AND NMBCNT
	HRRZ	T1,DEVSFD##(F)	;BUMP ALL ACC'S
	SKIPE	T1
	PUSHJ	P,INCALL
	PUSHJ	P,CLOSIN	;CLOSE CURRENT A.T.
UFDSR6:	TLZ	M,UUOMSK	;SET UUO TO LOOK LIKE A LOOKUP
	TLO	M,UUOLUK
	MOVEI	T2,0		;FORCE RECOMPUTING
	DPB	T2,DEYFNC##
	MOVE	T2,P2		;SEARCH LIST INTO T2
	PUSHJ	P,FNDFLA##	;LOOK FOR UFD ON NEXT STR'S IN SYSTEM
	  JRST	UFDSR4		;NO DIRECTORY ON NEXT STRS
;STILL IN FTSTR CONDITIONAL
	PUSHJ	P,DECMST	;DECR ALL BUT THE RIGHT ACC
	POP	P,P2		;RETURN POSSIBLE TEMP SL. (SETSRC CALL)
	PUSHJ	P,SLGVT##
	TLO	F,LOOKB		;FOUND ONE. SET F AS IF LOOKUP HAPPENED
	HRRZ	T3,DEVACC##(F)	;LOC OF A.T.
	PUSHJ	P,AT2DDB##	;COPY DATA FROM A.T. TO DDB
	  JRST	STOIOS##	;A.T. DATA IS VERY WRONG
	JUMPE	P1,STOIOS##	;JUST RE-OPENED 1ST STR, GIVE EOF RETURN
	TLZ	S,IOEND		;IT ISN'T REALLY AN EOF YET
	PJRST	INPTU		;DO 1ST INPUT ON NEW DIRECTORY FILE
;HERE WHEN SL IS EXHAUSTED
UFDSR4:	MOVE	P2,(P)		;RESET SL PTR TO BEGINING
	TRZE	P1,-1		;1ST TIME HERE?
	JRST	UFDSR6		;YES, RE-OPEN 1ST STR (SO REWIND WORKS)
	PUSHJ	P,JDAADR##	;2ND TIME (STR YANKED)
	HLLM	F,(T1)		;CLEAR LOOKB IN USRJDA
	SETZM	DEVUNI##(F)	;FILE IS LEFT CLOSED SO USETI UUO
				;WOULD BE INTERPRETED AS SUPER USETI.
				;ZERO DEVUNI TO MAKE USETI FAIL.
	PUSHJ	P,DECSFD	;DECR ALL ACC'S
	PUSHJ	P,SFDDEC	;DECR PPBCNT AND NMBCNT
	PUSHJ	P,TSTPPB	;DELETE CORE BLOCKS FOR THE PPN
				;AND FALL INTO UFDSR3

UFDSR3:	POP	P,P2		;RETURN TEMP SL. (IF ANY)
	PUSHJ	P,SLGVT##
	PJRST	STOIOS##	;AND RETURN NO MORE UFDS

;BUFFERRED MODE OUTPUT

OUTPT:	PUSHJ	P,NULTST	;IF NUL:,
	  JRST	OUTPT1		; EAT OUTPUT
	PUSHJ	P,SPTSTO	;SEE IF 1ST SPOOLED OUTPUT
	  PJRST	SETIMP		;YES, AND ERROR ON ENTER - SET IOIMP

	TLNE	F,ENTRB		;ENTER BEEN DONE?
	TLNE	S,IOSWLK+IOSUPR	;YES. STR WRITE-LOCKED?
	JRST	SETIMP		;YES. SET IOIMPM
	SKIPG	DEVREL##(F)	;TRYING TO WRITE A RIB (USETI 0 OR -N/OUTPUT)
	JRST	SETBTL		;YES. LIGHT IOBKTL AND RETURN
	PUSHJ	P,TSTSFD	;MAKE SURE NOT DOING OUTPUT TO AN SFD OR UFD
	  JRST	SETIMP		; (CAN'T ENTER *.SFD IF FTSFD=0)
	HRRZ	U,DEVUNI##(F)
	PUSHJ	P,WTRBIC##	;REWRITE RIB IF CHANGED, USER WANTS IT
				; (FROM A PREVIOUS OUTPUT)
	TLO	S,IO		;NO. INDICATE OUTPUT
	MOVEM	S,DEVIOS(F)	;SAVE S
	PUSHJ	P,UUOSET##	;SET DDB PNTRS FOR THIS OPERATION
	  JRST	SETBTL		;QUOTA EXHAUSTED
	PUSHJ	P,CHKLBK	;CHECK FOR LAST BLOCK OF APPEND-ONLY
	  JRST	SETBTL		;NOT ALLOWED
	  PJRST	UUOPWQ##	;OK, GO QUEUE REQUEST
	POPJ	P,		;ALREADY DONE
OUTPT1:	PUSHJ	P,ADVBFE##	;NULL DEVICE-EAT THE BUFFER
	  JFCL
	POPJ	P,		;AND RETURN

;DUMP MODE INPUT

DMPIN:	PUSHJ	P,NULTST	;IF NUL:,
	  JRST	SETION		; RETURN EOF
	PUSHJ	P,SPTSTI	;SEE IF 1ST INPUT IN SPOOL MODE
	  PJRST	SETION		;YES, AND NO FILE - SET IOEND

	TLNE	S,IOSUPR	;SUPER USETI DONE?
	JRST	DMPIN1		;YES. DON'T CHECK POINTERS

	TLNN	F,LOOKB		;LOOUP BEEN DONE?
	PJRST	SETIMP		;NO. LIGHT IOIMPM AND RETURN
DMPIN1:	TLZ	S,IO		;NO. INDICATE INPUT
	JRST	DUMPST		;AND CONTINUE

;SUBROUTINE TO MAKE SURE AN OUTPUT UUO ISNT BEING DONE TO AN SFD OR UFD
TSTSFD:	HLRZ	T1,DEVEXT(F)
	CAIE	T1,(SIXBIT .SFD.)	;AN SFD?
	CAIN	T1,(SIXBIT /UFD/)	;OR UFD?
	SOS	(P)		;YES, YOU LOSE
	PJRST	CPOPJ1##
;DUMP MODE OUTPUT

DMPOUT:	PUSHJ	P,NULTST	;IF NUL,
	  POPJ	P,		; DONT WRITE ANYTHING
	PUSHJ	P,SPTSTO	;SEE IF 1ST OUTPUT IN SPOOL MODE
	  PJRST	SETIMP		;YES, AND ERROR ON ENTER - SET IOIMPM

	TLNE	S,IOSUPR	;SUPER USETO DONE?
	JRST	[SKIPE	U,DEVUNI##(F)	;IF UNIT ISNT IN AN STR
		 SKIPE	UNILOG(U)	; THEN WRITE HEADERS IS LEGAL
		 TRZN	S,UDSX		;IF IN AN STR,
		 JRST	DMPOU1
		 JRST	SETIMP]		;WRITE HEADERS IS A NO-NO

	TLNE	F,ENTRB		;ENTER BEEN DONE?
	TLNE	S,IOSWLK	;YES. STR WRITE LOCKED?
	JRST	SETIMP		;YES. SET IOIMPM
	SKIPG	DEVREL##(F)	;NO. TRYING TO WRITE A RIB (USETI 0 OR -N/OUTPUT)
	JRST	SETBTL		;YES. LIGHT IOBKTL AND RETURN
	PUSHJ	P,TSTSFD	;MAKE SURE NOT OUTPUTTING TO AN SFD
	  JRST	SETIMP		;YES WE ARE, ILLEGAL
DMPOU1:	TLO	S,IO		;NO. INDICATE OUTPUT

DUMPST:	PUSHJ	P,SAVE1##

DUMPGO:	MOVEM	S,DEVIOS(F)	;SAVE S
	PUSH	P,S		;FILSER ALWAYS RETURNS TO UUO
				;LEVEL FOR EACH IOWD. HENCE WE DO
				;NOT SAVE THE LIMITS OR FLAG, AND WE
	PUSHJ	P,COMCHK##	;RECOMPUTE THE LIMITS. COMCHK RETURNS
				;HERE WITH S=0 IF OK,-1 IF ERROR
				;P AND P1 CONTAIN THE LIMITS, BUT WE
	JUMPE	S,DUMPG1	;THROW THEM AWAY. JUMP IF NO ERROR
	POP	P,S		;THERE WAS AN ERROR
	TRZ	S,UDSX		;MAKE SURE FORMAT-SWITCH IS OFF
	MOVEM	S,DEVIOS(F)

	JRST	ADRERR##	;RESTORE S AND GO REPORT IT
;HERE WHEN THE IO LIST HAS BEEN CHECKED, M POINTS TO LIST
DUMPG1:	POP	P,S		;RESTORE S WHEN NO ERROR
	MOVE	P1,T1		;SAVE UNRELOCATED IOWD
	JUMPN	T1,DUMPG3	;IF IOWD GO ON TO DO IT
	SETZM	DEVDMP##(F)	;THROUGH - ZERO DEVDMP
	TRZ	S,UDSX		;MAKE SURE WRITE-FORMAT OFF

	PUSHJ	P,WTRBIC##	;REWRITE RIB IF CHANGED, USER WANTS IT
	PJRST	STOIOS##	;AND RETURN TO USER


;HERE TO DO A RETRY AT UUO LEVEL
DUMPG9:	HLRZ	T1,DEVUVA##(F)	;REBUILD THE IOWD
	SUBI	T1,(P1)
	HRLS	T1
	ADD	T1,P1
DUMPG3:	HLLZM	T1,DEVDMP##(F)	;STORE -NO OF WORDS LEFT, CORE ADR=0
				;RH GETS SET BELOW AT DUMPG5
	PUSHJ	P,UUOSET##	;SET DDB POINTERS FOR THIS OPERATION
	  JRST	DUMPG8		;EOF OR QUOTA EXHAUSTED
	HLRE	T2,P1		;-NO OF WORDS LEFT TO GO IN THIS IOWD
	HLRE	T1,DEVDMP##(F)	;-NO OF WDS TOTAL IN THIS IOWD
	SUBM	T2,T1		;-NO OF WDS DONE SO FAR IN THIS IOWD
	MOVNS	T1		;+NO OF WDS DONE SO FAR IN THIS IOWD
	HRLS	T1		;SET TO UPDATE ORIGINAL IOWD
	ADD	T1,P1		;INCREMENT BOTH HALVES BY TOTAL SO FAR

	HRRM	T1,DEVDMP##(F)	;STORE ABS ADR FOR DATA TRANSFER
				; (RH ALREADY SET -IGNORE OVERFLOW FROM LH)
	HRLM	T1,DEVUVA##(F)	;SAVE FOR COMPUTING THE CHECKSUM
	PUSHJ	P,CHKLBK	;CHECK FOR LAST BLOCK OF APPEND ONLY
	  JRST	SETBTL
	PUSHJ	P,UUOPWQ##	;OK - GO QUEUE REQUEST
	PUSHJ	P,PWAIT1##	;WAIT FOR IO TO FINISH
	TLZE	S,IOSTBL	;TROUBLE?
	JRST	DUMPG9		;YES, RETRY AT UUO LEVEL
	MOVE	T1,DEVDMP##(F)	;THIS COMMAND DONE?
	TLNE	T1,-1
	JRST	DUMPG3		;NO. CONTINUE WITH THIS IOWD
	MOVEM	P1,DEVDMP##(F)	;PUT ORIGINAL IOWD BACK
	TLC	S,IO!IOSUPR	;SUPER OUTPUT
	TLCN	S,IO!IOSUPR	;?
	  PUSHJ	P,CSDELI##	;YES--DELETE THIS IOWD FROM CACHE

	HRRZ	T1,DEVACC##(F)	;GET LOC OF A.T.
	JUMPE	T1,DUMPG7	;GO ON IF NO A.T.
	MOVE	T1,ACCWRT##(T1)	;NO OF BLOCKS WRITTEN
	CAMGE	T1,DEVREL##(F)	;IS THIS THE LAST BLOCK OF THE FILE?
	TLNN	S,IO		;YES, WRITING?
DUMPG7:	AOJA	M,DUMPGO	;NO. GO GET NEXT IOWD AND CHECK IT
	HLRE	T1,P1		;YES. GET WORDCOUNT OF IOWD
	MOVNS	T1		;+N
	TRNE	T1,BLKSIZ##-1	;AN EVEN MULTIPLE OF BLKSIZ WORDS?
	TRZA	T1,BLKSIZ##	;NO. MAKE SURE COUNT LT 200
	MOVEI	T1,BLKSIZ##	;YES. MAKE SURE ONLY BLKSIZ IS ON
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	DPB	T1,ACYLBS##	;SAVE WORDCOUNT OF LAST BLOCK
	AOJA	M,DUMPGO	; GO GET NEXT IOWD AND CHECK IT
;HERE ON AN ERROR RETURN FROM UUOSET
DUMPG8:	TLNE	S,IO		;INPUT?
	JRST	SETBTL		;NO, QUOTA EXHAUSTED, DISK FULL
SETION:	TDO	S,[XWD IOEND,IODEND]	;YES. EOF
	PJRST	STOIOS##	;SAVE S AND RETURN TO CALLER




;HERE ON AN OUTPUT REQUEST TO RELATIVE BLOCK 0 OF THE FILE
;(OCCURS AFTER USETI/USETO 0)
SETBTL:	TROA	S,IOBKTL	;LIGHT IOBKTL
;HERE ON AN OUTPUT REQUEST TO A WRITE-LOCKED STR
SETIMP::TRO	S,IOIMPM	;LIGHT WRITE-LOCK ERROR BIT
	PJRST	STOIOS##	;SAVE S AND RETURN TO CALLER
;ROUTINE TO CHECK IF WRITING LAST BLOCK OF APPEND ONLY FILE.
;DO NOT ALLOW THE USER TO ALTER THE PORTION OF THE BLOCK
;WHICH WAS PREVIOUSLY WRITTEN.
;READ THE LAST BLOCK INTO A MONITOR BUFFER, AND COPY
;THE FIRST PORTION INTO THE USER'S BUFFER. THUS IF THE
;USER IS ATTEMPTING TO ALTER THE FIRST PORTION, HIS DATA WILL
;BE OVERWRITTEN WITH THE CORRECT VALUES.
;RETURN CPOPJ IF TRANSFER IS NOT TO BE ALLOWED.
;I.E. NEW BUFFER IS SMALLER THAN OLD.
;RETURN CPOPJ1 IF IT'S OK TO LET HIM DO THE TRANSFER
;RETURN CPOPJ2 IF TRANSFER IS ALREADY DONE (CAN ONLY HAPPEN IN BUFFERED).
CHKLBK:	TLNE	S,IO		;WRITING?
	TLNE	S,IOSUPR	;AND NOT SUPER?
	JRST	CPOPJ1		;NO, OK
	LDB	T1,DEYFNC##	;PROTECTION OF FILE
	HRRZ	T2,DEVACC##(F)	;ADDR OF ACC
	MOVE	T3,ACCWRT##(T2)	;NUMBER OF BLOCKS WRITTEN
	CAMN	T3,DEVREL##(F)	;LAST BLOCK?
	CAIE	T1,FNCAPP##	;AND APPEND-ONLY?
	JRST	CPOPJ1##	;NO, OK
	PUSHJ	P,SAVE2##	;SAVE P1,P2
	LDB	P1,ACYLBS##	;SIZE OF LAST BLOCK
	JUMPE	P1,CPOPJ1##	;IF EMPTY LET HIM DO IT
	CAIL	P1,BLKSIZ##	;LAST BLOCK HAVE ROOM?
	POPJ	P,		;NO, DON'T LET HIM
	LDB	T1,PIOMOD##	;MODE OF FILE
	CAIL	T1,SD		;DUMP MODE OR BUFFERED?
	JRST	CHKLB1		;DUMP
	HRRZ	P2,DEVOAD(F)	;BUFFERED, GET ADDR OF BUFFER
	EXCTUX	<MOVE T1,1(P2)>	;GET SIZE
	ADDI	P2,2
	JRST	CHKLB4

;HERE IF DUMP MODE
CHKLB1:	HLRE	T1,DEVDMP##(F)	;GET SIZE OF USER BUFFER
	MOVNS	T1
	HLRZ	P2,DEVUVA##(F)	;GET ADDR OF USER BUFFER
	ADDI	P2,1
;HERE WITH:
;T1=SIZE OF USER BUFFER
;P1=SIZE OF LAST BLOCK
;P2=ADDR OF USER BUFFER
CHKLB4:	CAMGE	T1,P1		;NEW SIZE MUST BE BIGGER THAN OLD
	POPJ	P,
	PUSHJ	P,GTMNBF##	;GET A MON-BUF
	MOVE	T2,DEVBLK##(F)	;NUMBER OF LAST BLOCK
	PUSHJ	P,MONRDU##	;READ IT
	PJUMPN	T3,CPOPJ##	;RETURN IF ERRORS DETECTED IN MONRED
	HRLZI	T1,1(T1)	;FROM
	HRR	T1,P2		;TO
	ADDI	P2,-1(P1)	;STOP AT
	EXCTXU	<BLT T1,(P2)>	;COPY FIRST PORTION OF BLOCK
	LDB	T1,PIOMOD##	;MODE OF FILE
	CAIL	T1,SD		;DUMP MODE OR BUFFERED?
	JRST	CPOPJ1		;DUMP
	PUSHJ	P,UUOPWQ##	;BUFFERED, START THE TRANSFER
	PUSHJ	P,WSYNC##	;WAIT FOR COMPLETION (EVEN IF NON-BLOCKING)
				; WE DON'T WANT TO GIVE CONTROL BACK TO
				; THE USER UNTIL THE TRANSFER IS COMPLETE.
				; ELSE A MALICIOUS USER MIGHT ALTER THE BUFFER.
	AOS	-3(P)		;EXIT CPOPJ2 FROM SAVE2
	JRST	CPOPJ1##

;TEST FOR 1ST SPOOL-MODE INPUT. IF IT IS, DO THE LOOKUP
SPTSTI:	SKIPL	DEVSPL(F)	;IS THIS A SPOOLING DDB?
	JRST	CPOPJ1##	;NO, RETURN
	MOVE	T1,DEVMOD(F)	;YES, GET DEVMOD
	TLNN	T1,DVIN		;CAN DEVICE DO INPUT?
	JRST	ILLINP##	;NO, ERROR
	SKIPE	DEVPPN(F)	;YES.  ALREADY SET UP FILE?
	PJRST	CPOPJ1##	;YES, RETURN
	LDB	J,PJOBN##	;NO. GET THE JOB NUMBER
	HLRZ	T2,JBTSPL##(J)	;INPUT FILE-NAME
	SKIPN	T2		;IF NOT SET UP
	MOVEI	T2,'QAA'	; START AT QAA.CDR
	MOVSM	T2,DEVFIL(F)	;SAVE NAME IN DECFIL
	MOVEI	T2,'CDR'	;EXTENSION
	MOVSM	T2,DEVEXT(F)	;INTO DEVEXT
	PUSHJ	P,SFDPPN	;GET DEFAULT PPN
	MOVEM	T4,DEVPPN(F)	;INTO DDB
	TLZ	M,UUOMSK	;SET UP UUO
	PUSHJ	P,SLPTJ##	;SET T1= SL. PTR.
	  POPJ	P,		;NO S.L.

	PUSHJ	P,ULOOK3	;DO THE LOOKUP
	  PJRST	SETBTL		;NOT FOUND- IMMEDIATE RETURN
	HLRZ	T1,DEVFIL(F)	;FOUND. GET THE FILE NAME
	AOS	T1		;AND INCREMENT BY 1
SPTST2:	LDB	T2,[POINT 6,T1,35]	; SO IF NO NEW SET IS DONE,
	CAIG	T2,'Z'		; THE NEXT FILE WILL BE READ
	JRST	SPTST3
	SUBI	T1,'Z'-'A'+1	;RESET TO 'A'
	ROT	T1,-6		;GET THE NEXT CHAR
	TRNE	T1,-1		;IS THERE ONE?
	AOJA	T1,SPTST2	;YES, INCREMENT IT
	ROT	T1,6		;DONE - SET UP IN RH AGAIN
SPTST3:	TLNE	T1,-1		;COMPLETELY IN RH?
	JRST	.-2		;NO, GET NEXT CHAR
	LDB	J,PJOBN##	;JOB NUMBER
	HRLM	T1,JBTSPL##(J)	;SAVE NEXT FILE-NAME IN JBTSPL
	TLO	F,LOOKB		;INDICATE LOOKUP DONE
	PUSHJ	P,JDAADR##
	HLLM	F,(T1)		;SAVE BITS IN USRJDA
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN
;STILL IN FTSPL CONDITIONAL
;TEST FOR 1ST SPOOL-MODE OUTPUT
SPTSTO:	MOVE	T1,DEVMOD(F)	;DEVMOD OF REAL DEVICE
	TLNN	T1,DVOUT	;CAN IT DO OUTPUT?
	JRST	SPTST9		;NO, GIVE ERROR
	SKIPGE	DEVSPL(F)	;SPOOLING DDB?
	SKIPE	DEVPPN(F)	;YES, ALREADY SET UP?
	PJRST	CPOPJ1##	;YES, RETURN
	TLNE	S,IOSRST	;DOING A RESET UUO?
	PJRST	CPOPJ1##	;YES, DON'T ENTER ANYTHING
SPTSTR:	PUSHJ	P,SAVE2##	;NO. SAVE P1,P2
	MOVEI	T2,4		;GET 1 4-WORD BLOCK
	PUSHJ	P,GETWDS##	;ALLOCATE CORE
	  POPJ	P,		;NONE AT ALL- CANT FAKE THE ENTER
	MOVE	P1,T1		;GOT ONE - SAVE ITS LOC IN P1
	HRLI	T1,.JDAT+140	;SINCE GETWRD WANTS M TO POINT TO A USER'S AREA,
	BLT	T1,3(P1)	; SAVE USER'S 140-143,
				; USE THESE LOCS FOR THE FAKED ENTER
	MOVE	T1,DATE##	;GET DATE
	MOVEM	T1,SPLGEN##	;SAVE IT
SPTSO1:	AOS	T1,SPLGEN##	;INCR AND LOAD
	IDIV	T1,[44*44*44*44*44] ;DIVIDE BY 36^5
	MOVE	T1,[POINT 6,.JDAT+140] ;POINT TO FILENAME
	SETZM	.JDAT+140
	MOVEI	T3,'Q'		;LOAD FIRST LETTER
	IDPB	T3,T1		;STORE IT
	PUSHJ	P,SPTSO2	;MAKE A NAME
	MOVEI	T1,'SPL'	;RELEASE 4 EXTENSION
	SKIPN	%SIOPR##	;IS ORION RUNNING
	HLRZ	T1,DEVNAM(F)	;NO, GET INIT'ED DEVICE
	CAIE	T1,'LL '	;LOWER
	CAIN	T1,'LU '	;UPPER
	MOVEI	T1,'LPT'	;SOME FLAVOR OF LPT
	HRLZM	T1,.JDAT+141	;STORE
	SKIPE	T1,%SIQSR##
	MOVE	T1,SPLPPN##	;GET PPN
	MOVEM	T1,.JDAT+143	;SAVE IT
	JRST	SPTSO3


SPTSO2:	IDIVI	T2,^D36		;DIVIDE BY 36
	PUSH	P,T3		;SAVE RESIDUE
	SKIPE	T2		;SKIP IF DONE
	PUSHJ	P,SPTSO2	;ELSE RECURSE
	POP	P,T2		;GET A CHAR
	ADDI	T2,'0'		;MAKE IT SIXBIT
	CAILE	T2,'9'		;IF NOT A DIGIT
	ADDI	T2,'A'-'9'-1	;MAKE IT ALPHA
	IDPB	T2,T1		;DEPOSIT
	POPJ	P,		;UNWIND
SPTSO3:	JUMPN	T1,SPTS5A	;DON'T CHANGE NAME IF QUASAR RUNNING
	MOVE	T1,DEVNAM(F)	;GET DEVICE USER INITED
	HLRZ	T3,T1		;GET LEFT HALF
	CAIE	T3,'LL '	;IS IT LL?
	CAIN	T3,'LU '	;OR LU?
	MOVSI	T1,'LPT'	;MAKE IT LPT
	HLLZM	T1,.JDAT+141	;AND STORE IT
IFN FTNET,<
	TRNE	T1,-1		;IS THERE A RIGHT HALF?
	JRST	SPTST4		;YES
	LDB	T2,PJOBN##	;NO, JOB NUMBER
	MOVE	T1,JBTLOC##(T2)	;WHERE THE JOB IS
	PUSHJ	P,CVTSBT##	;CONVERT TO SIXBIT
	LSH	T1,-^D24	;INTO RH(T1)
	TRO	T1,'S  '	;'S' FOR STATION
	CAIN	T3,'LL '	;IS IT LL?
	TRC	T1,370000	;YES MAKE 'S' INTO 'L'
	CAIN	T3,'LU '	;IS IT LU?
	TRC	T1,060000	;YES MAKE 'S' INTO 'U'
>	;END IFN FTNET
SPTST4:	HRRM	T1,.JDAT+140	;SAVE RH OF FILE NAME IN ENTER BLOCK
	MOVEI	T1,^D640	;THERE ARE 36**2 LEGAL NAMES STARTING WITH "Q",
	HRRM	T1,.JDAT+141	; SO SET A LIMIT OF HALF THAT
	AOS	T1,SPLGEN##	;START WHERE LEFT OFF LAST
	IDIVI	T1,^D46655	; ENSURE .LT. 36^3
	IDIVI	T2,^D36		; CONVERT TO NUMBER
	ADDI	T3,20		;TO "SIXBIT
	CAILE	T3,31
	ADDI	T3,7		; LETTER
	LSHC	T3,-6		;SAVE THE CHAR
	IDIVI	T2,^D36		;SECOND CHAR
	ADDI	T3,20
	CAILE	T3,31
	ADDI	T3,7
	LSHC	T3,6		;2 CHARS IN T3
	TRO	T3,'Q  '	;+ 'Q'
	ADDI	T2,20
	MOVE	T1,.JDAT+141	;COUNT OF TRIES
	TRNE	T1,-1		;TRIED (AND LOST) ENOUGH?
	SOSA	.JDAT+141	;NO
	DPB	T2,[POINT 6,T3,23]	;YES, 1ST CHAR = RANDOM
	HRLM	T3,.JDAT+140	;SAVE NAME
	SETZM	.JDAT+143	;ZERO PPN
SPTS5A:
	PUSH	P,M		;SAVE M
	HRRI	M,140		;POINT M TO THE FAKED ENTER-BLOCK
	MOVE	T2,SPLPRT##	;PROTECTION FOR SPOOLED FILES
	MOVEM	T2,.JDAT+142
	MOVEI	P2,UENT4
	SKIPL	DEVSPL(F)
	HRROI	P2,RECLSD
IFN FTKL10&FTMP,<
	PUSH	P,DEVNBF(F)	;WE'LL CHANGE THIS NUMBER DOING THE ENTER
>
	PUSHJ	P,(P2)		;FAKE AN ENTER
	  JRST	SPTST6		;DID NOT WIN
	SKIPL	P2
	TLO	F,ENTRB		;OK - TURN ON ENTRB
IFE FTKL10&FTMP,<
	AOSA	T1,-1(P)	;SET FOR SKIP-RETURN
>
IFN FTKL10&FTMP,<
	AOSA	T1,-2(P)
>
SPTST6:	TLZ	F,ENTRB		;MAKE SURE ENTRB OFF ON FAILURE
IFN FTKL10&FTMP,<
	POP	P,DEVNBF(F)
>
	POP	P,M		;RESTORE UUO
	PUSH	P,T1		;GET CHAN NUM
	PUSHJ	P,JDAADR##
	HLLM	F,(T1)		;SAVE BITS IN USRJDA
	POP	P,T1
	TLZ	T1,-1
	CAIE	T1,FBMERR	;FILE BEING MODIFIED?
	CAIN	T1,AEFERR	;OR SUPERSEDE ERROR?
	JRST	SPTSO1		;YES, TRY AGAIN
	HRLZ	T2,P1		;LOC OF 4-WORD BLOCK
	HRRI	T2,.JDAT+140	;SET TO RESTORE USER'S 0-3
	BLT	T2,.JDAT+143	;BACK AS GOOD AS NEW
	MOVEI	T1,4		;DONE - GIVE UP CORE BLOCK
	HRRZ	T2,P1		;CORE ADDRESS
	PJRST	GIVWDS##	;RETURN BLOCK AND EXIT
SPTST9:	TLNE	S,IOSRST	;FORGET IT IF RELEASE (PROBABLY A COMMAND)
	POPJ	P,		;COMMAND - ALLOW IT TO FINISH
	PJRST	ILLOUT##	;UUO - ERROR MESSAGE



;END FTSPL CONDITIONAL
SUBTTL	CLOSE
;WHEN RENAME CALLS CLOSE, IT MAY ALREADY HAVE THE MONITOR BUFFER, AND THE RIB
;MAY BE IN IT. IF SO, DEPRIB IS ON IN S

;INPUT CLOSE
CLOSIN:	TLZE	F,LOOKB		;LOOKUP IN FORCE?
	TLZN	S,IOSRDC	;YES, READ COUNT UP FOR CHAN?
	PJRST	STOIOS##	;NO. RETURN
CLOSRN:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	PUSHJ	P,SETU##	;WAS F/S YANKED?
	  POPJ	P,		;YES, RETURN
	HLRZ	U,DEVUNI##(F)	;SET U TO UNIT OF RIB

	PUSHJ	P,TSTRDR	;IS ANYONE ELSE READING FILE?
	JUMPE	T1,STOIOS##	;RETURN IF NO AT
	MOVE	P2,T1		;SET RH(P2)=LOC OF NMB
CLOSR1:	HLRZ	P2,ACCNMB##(P2)
	SKIPN	P2
	STOPCD	UACLX,JOB,ALW,	;++ACCESS TABLE LINKED WRONG.
				;IT'S PROBABLY ON THE FREE LIST.
				;PROBABLE CAUSE: USE COUNT IS
				;WRONG.
	TRZN	P2,DIFNAL##
	JRST	CLOSR1		;LOOP
	MOVSI	T4,DEPRAD##	;DONT DECR PPB COUNT
	TDNN	T4,DEVRAD##(F)	; IF RENAME ACROSS DIRS

	HRL	P2,ACCPPB##(T1)	;AND LH(P2)=LOC OF PPB
	ANDCAM	T4,DEVRAD##(F)	;NO LONGER RENAMING ACCROSS DINS

	TRNE	T2,ACMCNM##	;NOT IF READ COUNT=1
	JRST	CLSIN2		;YES. RESET ACCESS DATE AND EXIT
	MOVEI	T4,ACPSBC##
	ANDCAM	T4,ACCSBC##(T1)
	TRNN	T2,ACPREN	;FILE BEING RENAMED (BY SOME OTHER JOB)?
				; CANT BE FOR THIS JOB SINCE ACPREN IS A VERY
				; TRANSIENT BIT - RENAME CALLS CLOSE WHICH CLEARS IT
	TRNN	T2,ACPDEL##	;NO, FILE MARKED FOR DELETION?
	JRST	CLSIN2		;NO
;HERE, CALLED FROM CLRSTS, IF THERE WAS A RENAMER, WHEN HE FINISHES
;NEEDED SINCE DELETE CODE CANT ACTUALLY DO ANYTHING EVEN IF READ-COUNT =0
;WHEN THERE IS A RENAME IN PROGRESS BY SOME OTHER JOB
CLOSR2:	PUSHJ	P,CLSNAM	;SET T1=LOC OF NMB,  RESET DEVFIL, DEVEXT
	MOVE	P1,T1		;P1=LOC OF NMB (FOR DELNAM)
	MOVE	T2,ACCSTS##(T2)	;STATUS OF FILE
	TRNE	T2,ACPNIU	;HAS FILE BEEN REMOVED FROM UFD?
	JRST	CLSIN1		;GO DELETE BLOCKS OF FILE
	PUSHJ	P,UPAU##	;GET AU (ALTER UFD) RESOURCE
	TLZ	S,IOSRIB	;RIB IS NOT IN MON BUF ANY MOR
	PUSHJ	P,DELNAM	;FIND FILE NAME AND DELETE IT FROM UFD
	  JRST	FREACC		;FILE NAME NOT FOUND IN UFD
CLSIN1:	TLO	F,RENMB		;SO RIBCHK WON'T CHECK RIBDIR
	PUSHJ	P,REDRIB##	;GO READ THE RIB INTO CORE
	  JRST	FREAC1		;RIB ERROR, DON'T COUNT ON THE DATA
	TLZ	F,RENMB
	PUSHJ	P,SPTRW##	;SET UP AN AOBJN WORD FOR POINTERS
	MOVE	P1,T1		;AOBJN WORD INTO P1
	PUSHJ	P,DELRIB	;GO DELETE THE BLOCKS OF THE FILE
	  STOPCD .+1,DEBUG,DNS,	;++DELRIB NON-SKIP RETURN
	PUSHJ	P,LOGTST	;RECOMPUTE RIBUSD IF PPN NOT LOGGED IN
	PUSHJ	P,SFDDEC	;DECR PPBCNT, NMBCNT
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNTS OF THE FATHER SFD AT'S
	JRST	FREAC1		;FINISH UP

;HERE WHEN THE FILE NAME WAS NOT FOUND IN THE UFD.
FREACC:	PUSHJ	P,DWNAU##	;GIVE UP AU RESOURCE

FREAC1:	TLZ	F,RENMB		;TURN OFF RENMB SO CLOSE OUTPUT WONT DO ANYTHING
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	HRRZ	T1,DEVACC##(F)	;%LOC OF A.T.
	CBDBUG	(Y,Y);
	SETZM	DEVFIL(F)	;FOR SET WATCH FILE

	HLRZ	T2,NMBRNG##(P2)	;%IS THE FILE AN SFD?
	TRNN	T2,NMPUPT##	;%DOES THE SFD HAVE CHILDREN?
	JUMPN	T2,CLSIN8	;%YES, RETURN ACC, LEAVE NMB
	JRST	CLSIN7		;%RETURN NMB IF POSSIBLE
;HERE WHEN FILE IS NOT MARKED FOR DELETION
CLSIN2:	TRNE	M,CLSOUT	;SUPPRESSING OUTPUT CLOSE?
	JRST	CLSIN3		;YES, CHECK (POSSIBLY UPDATE) ACCESS DATE
	TLNE	F,ENTRB+RENMB	;NO, ENTER OR RENAME DONE?(IF SO CLSOUT WILL BE CALLED)
	JRST	CLSXIT		;YES. DECREMENT COUNT AND EXIT
CLSIN3:	JUMPE	T1,TSTPPB	;DEVACC=0 IF F/S WAS JERKED OUT
	TLNN	S,IOSERR##	;UPDATE BAT BLOCK IF ERROR
	TRNN	M,CLSACC	;NO. SUPPRESS UPDATING ACCESS DATE?
	TRNE	T2,ACPREN+ACPUPD;OR RENAME OR UPDATE HAPPENING (BY A DIFFERENT JOB)?
	JRST	CLSIN5		;YES, DON'T WRITE RIB
	TLNN	S,IOSWLK	;FILE WRITE LOCKED?
	TLNN	F,INPB		;NO. ANY INPUTS DONE?
	JRST	CLSIN5		;NO. DON'T CHANGE ACCESS DATE
	TLNE	S,IOSERR##	;ANY ERRORS ENCOUNTERED?
	TDZA	T4,T4		;YES. FORCE WRITING OF RIB
	LDB	T4,[POINT 15,ACCADT##(T1),17]	;ACCESS DATE
	CAMN	T4,THSDAT##	;NO. AC. DATE=TODAY?
	JRST	CLSIN5		;YES. JUST SET A.T. DORMANT
	MOVE	T4,THSDAT##	;NO. SET ACCESS DATE=TODAY
	DPB	T4,[POINT 15,ACCADT##(T1),17]	;IN ACC
	PUSHJ	P,CLSNAM	;UPDATE DEVFIL, DEVEXT
	PUSHJ	P,BUFRIB##	;GET MON BUF, READ RIB INTO IT
	  JRST	CLSIN5		;RIB ERR - DON'T REWRITE IT
	TRNE	M,CLSACC
	JRST	CLSIN4
	MOVE	T1,.USMBF	;LOC OF BUF (-1)
	MOVE	T2,THSDAT##	;GET TODAYS DATE
	DPB	T2,[POINT 15,RIBEXT##+1(T1),35]
	PUSHJ	P,STORU##
CLSIN4:	PUSHJ	P,TSTBAD	;SET RIBELB IF ERROR
	MOVE	T2,RIBSLF##+1(T1)	;BLOCK NO. OF RIB
	PUSHJ	P,MONWRT##	;REWRITE THE RIB WITH NEW AC. DATE
	PUSHJ	P,ERRFIN	;WRITE BAT BLOCK IF THERE WAS AN ERROR

CLSIN5:	TLNE	F,ENTRB+RENMB	;ENTER OR RENAME DONE?
	JRST	CLSXIT		;YES, EXIT (UPDATE SUPPRESSING OUTPUT CLOSE)
	PUSHJ	P,CLSNAM	;UPDATE DDB IN CASE SOMEBODY RENAMED THE FILE
IFN FTFDAE,<
	MOVSI	T1,DEPFDA##	;CALL FILE DAEMON ON CLOSE BIT
	TDNN	T1,DEVFDA##(F)	;SHOULD THE FILE DAEMON BE CALLED?
	JRST	CLSIN6		;NO
	ANDCAM	T1,DEVFDA##(F)	;YES, CLEAR THE BIT
	MOVEI	T1,.FDCLI	;INDICATE INPUT CLOSE
	PUSHJ	P,SNDFMG##	;TELL THE FILE DAEMON THAT
	  JFCL			;DON'T CARE
CLSIN6:>
	PUSHJ	P,SFDDEC	;DECR NMBCNT,PPBCNT FOR SFD
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNTS OF THE FATHER SFD AT'S
	PUSHJ	P,DECRDR	;NO, DECREMENT COUNT
	  SETZ	T1,		;%READ COUNT NOT 0
	PUSHJ	P,UACLX		;%RESET A.T. LOC AND UFB LOC IN DDB
	JUMPE	T1,CLSI13	;%EXIT IF READ-COUNT NON-0
	TRNE	T2,ACPREN	;%RENAME IN PROGRESS (BY ANOTHER JOB)?
	JRST	CLSI13		;%YES, LEAVE THE A.T. ALONE
	TRNN	M,CLSDAT	;%CNT=0. WANT A.T. TO GO AWAY?
	TLNN	F,INPB		;%NO, ANY INPUTS BEEN DONE?
	TRNE	M,CLSNMB	;%YES. USER WANT CORE BLOCKS TO STAY AROUND ANYWAY?
	JRST	CLSI14		;%YES, JUST MAKE A.T. DORMANT
	HLRZ	T2,NMBRNG##(P2)	;%IS THE FILE AN SFD?
	JUMPE	T2,CLSIN7	;%GO IF NOT SFD
	MOVE	T4,NMBCNT##(P2)	;%IS SOMEBODY INSIDE FNDFIL?
	CAIG	T4,1
	TRNN	T2,NMPUPT##	;%DOES THE SFD HAVE CHILDREN?
	JRST	CLSI14		;%YES, JUST MAKE ACC DORMANT
CLSIN7:	MOVE	T4,NMBCNT##(P2)
	SOJLE	T4,CLSIN9	;%LEAVE NMB IF ANOTHER READING
CLSIN8:	PUSHJ	P,ATNLNK##	;%ANOTHER USER OF NMB EXISTS
	JRST	CLSI10		;% RETURN AT, LEAVE NMB
CLSIN9:	HRL	P1,ACCPPB##(T1)	;%DELETE ALL CORE BLOCKS FOR FILE(IF POSSIBLE)
	PUSHJ	P,ATNLNK##	;%UNLINK A.T. FROM NMB RING
	TRZE	T2,DIFNAL##	;%PREDECESSOR A NAME BLOCK?
	TRZN	T3,DIFNAL##	;%YES. SUCCESSOR AN NMB?
CLSI10:	TDZA	P1,P1		;%NO. THERE ARE OTHER A.T.S IN RING
	HRR	P1,T2		;%YES, SAVE LOC OF NMB
	PUSH	P,F		;%SAVE F
	SKIPE	P1		;%IF WE'RE GOING TO REMOVE THE NMB,
	SETZ	F,		;%ZERO F SO ATSDRA WONT GIVE UP CB
	PUSHJ	P,ATSFR0##	;%PUT THIS A.T. ON FREE CORE LIST
	POP	P,F		;%RESTORE DDB LOC
	HLLZS	DEVACC##(F)	;%MAKE SURE THE A.T. ISN'T REUSED
	JUMPE	P1,CLSI15	;%EXIT IF NMB STILL IN USE
;HERE IF NMB NOW HAS NO A.T.S IN ITS RING
	HLRZ	T2,P1		;%LOC OF PPB FOR FILE
	PUSHJ	P,SET1NM	;%SET T2 TO 1ST NMB IN LIST
	JUMPE	T2,CLSI13	;%GO IF NONE (SYSTEM ERROR?)
CLSI11:	CAIN	T2,(P1)		;%THIS THE RIGHT NMB?
	JRST	CLSI12		;%YES. HAVE PRED IN T3
	MOVE	T3,T2		;%NO. NEW PREDECESSOR
	HLRZ	T2,NMBPPB##(T2)	;%STEP TO NEXT NMB IN RING
	TRNN	T2,NMPUPT##	;%UPWARD PNTR (NOT SAME LIST) IF ON
	JUMPN	T2,CLSI11	;%GO TEST IT
	JRST	CLSI13		;%CANT FIND THE PREDECESSOR (SYSTEM ERROR?)
;HERE WITH T3=LOC OF PREDECESSOR NMB TO THE ONE WE WANT TO DELETE
CLSI12:	MOVE	T1,NMBPPB##(P1)	;%NMB'S LINK
	HLLM	T1,NMBPPB##(T3)	;%SAVE IN LINK OF PRED
	MOVE	T1,SYSCOR##	;%PREVIOUS 1ST FREE CORE BLOCK
	HRLM	P1,SYSCOR##	;%THIS NMB IS NEW 1ST FREE
	HLLM	T1,CORLNK##(P1)	;%LINK PREVIOUS 1ST FREE TO THIS ONE
	HLLZS	P2		;NO NMB USE-COUNT TO DECR
CLSI13:	PUSHJ	P,GVCBJ1##	;%GIVE UP CB AND SKIP
CLSI14:	PUSHJ	P,ATSDRA##	;%MAKE A.T. DORMANT
CLSI15:	SETZM	DEVUNI##(F)	;THIS FILE NO LONGER OPEN (SO ENTER WILL TEST UNIT)
	PUSHJ	P,CLRLIB
	PJRST	TSTPPB		;TEST IF PPB LOGGED IN, AND EXIT
;HERE TO DECREMENT READ-COUNT, EXIT
CLSXIT:	PUSHJ	P,DECRDR	;%COUNT DOWN BY 1
	  JFCL			;%READ COUNT  NON-0
	CBDBUG	(Y,Y);
	PUSHJ	P,GVCBJ##
;TURN OFF DEPLIB
CLRLIB:	MOVSI	T1,DEPLIB##	;CLEAR FILE-FROM-LIB
	ANDCAM	T1,DEVLIB##(F)	;SO UPDATE WILL WIN
;FALL INTO DECUC

;SUBROUTINE TO DECREMENT USE-COUNTS
;ENTER P2=PPB,,NMB
;PRESERVES ALL ACS EXCEPT P2, WHICH IT CHANGES
DECUC:	TRNN	P2,-1		;IF FROM CLRSTS, COUNTS ALREADY DECR'D
	JRST	DECUC1
	SOSL	NMBCNT##(P2)	;DECREMENT NMB COUNT
	JRST	DECUC1
	;STOPCD	.+1,DEBUG,NUN,	;++NMB USE-COUNT NEGATIVE
	SETZM	NMBCNT##(P2)	;RESET COUNT
	PUSH	P,T1		;SAVE SOME DEBUGGING INFO
	AOS	NUNCNT		;COUNT OF "NUN STOPCDS"
	MOVE	T1,PPBNAM##(P2)
	MOVEM	T1,NUNSFD
	HLRZ	T1,NMBACC##(P2)
	TRZE	T1,DIFNAL##
	JRST	.+3
	MOVE	T1,ACCPPB##(T1)
	MOVE	T1,PPBNAM##(T1)
	MOVEM	T1,NUNPPN
	POP	P,T1
DECUC1:	HLRZS	P2
	JUMPE	P2,CPOPJ##	;NO PPB TO DECR IF 0
	SOSL	PPBCNT##(P2)	;DECREMENT PPB COUNT
	POPJ	P,
	;STOPCD	.+1,DEBUG,PUN,	;++PPB USE-COUNT NEGATIVE
	SETZM	PPBCNT##(P2)
	AOS	PUNCNT		;COUNT OF "PUN STOPCDS"
	PUSH	P,PPBNAM##(P2)
	POP	P,PUNPPN
	POPJ	P,		;EXIT
	$LOW
PUNCNT:	0
PUNPPN:	0
NUNCNT:	0
NUNPPN:	0
NUNSFD:	0
	$HIGH
;SUBROUTINE TO SET UP P2 FOR DECUC
;RETURNS T1=L(AT), P2 CHANGED
DECSU:	PUSHJ	P,GETNMB	;GET LOC OF NMB,AT
	EXCH	T1,T2		;T1=LOC OF AT
	MOVE	P2,T2		;P2=NMB
	HRL	P2,ACCPPB##(T1)	;P2=PPB,,NMB
	POPJ	P,		;RETURN

;SUBROUTINE TO DECREMENT NMB,PPB COUNTS IF FILE IS IN AN SFD
;PRESERVES T1,T2
SFDEC:
SFDDEC:	SKIPA	T4,[-1]		;SET TO COUNT DOWN
SFDUP:	MOVEI	T4,1		;SET TO COUNT UP
	HRRZ	T3,DEVSFD##(F)	;LOC OF SFD
	JUMPE	T3,CPOPJ##	;RETURN IF NONE
	ADDM	T4,NMBCNT##(T3)	;CHANGE NMBCNT
	HLRZ	T3,NMBACC##(T3)
	TRNE	T3,DIFNAL##	;POINT AT A.T.
	POPJ	P,		;NO A.T., RETURN
	MOVE	T3,ACCPPB##(T3)	;POINT AT PPB
	ADDM	T4,PPBCNT##(T3)	;COUNT PPBCNT UP OR DOWN
	POPJ	P,		;AND RETURN
;SUBROUTINE TO FIND THE ACCESS-TABLE FOR A FILE, GET THE STATUS
; IN T2
;ALWAYS RETURNS CPOPJ WITH T2=STATUS=READ COUNT
TSTRDR:	TDZA	T2,T2		;DECREMENT COUNT BY 0
				;AND FALL INTO DECRDR

;SUBROUTINE TO DECREMENT THE NUMBER OF READERS OF A FILE
;EXIT CPOPJ IF THERE ARE OTHER READERS, CPOPJ1 IF THE READ COUNT HAS GONE TO 0
;EXITS WITH THE COUNT (=STATUS) WORD IN T2, WITH CB RESOURCE, AND T1=A.T. LOC (OR 0).
DECRDR::MOVNI	T2,ACPCNT##	;SET TO DECREASE READ COUNT
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	JUMPE	T1,CPOPJ##	;SYSTEM ERROR (?) IF 0
	SKIPE	T2		;IF CHANGING THE READ-COUNT,
	PUSHJ	P,GETCB##	; GET CB RESOURCE
	ADDB	T2,ACCCNT##(T1)	;%1 LESS JOB IS READING FILE
	MOVEM	S,DEVIOS(F)	;%SAVE S (IOSRDC NOW OFF)
				; SO REDOING CLOSE WON'T DECREMENT
				; AGAIN (EG ON ADR ERR ON CLOSE)
	TRNE	T2,ACMCNT+ACPREN+ACPUPD	;%ANYONE USING FILE AT ALL?
	POPJ	P,		;%YES, NON-SKIP
	PJRST	CPOPJ1##	;%NO, SKIP-RETURN


;SUBROUTINE TO GET THE LOC OF THE NMB FROM THE DDB
;GETNMB GETS/GIVES CB RESOURCE IF NECESSARY, GTNM1 EXPECTS CALLER
;ALREADY OBTAINED THE CB RESOURCE.
;RETURNS T1=LOC OF NMB, T2=LOC OF A.T.
;ENTER AT GTNM1 WITH LOC OF A.T. IN T1; T,T2,T3 RESPECTED
GETNMB::PUSHJ	P,UPCB##	;GET THE CB RESOURCE IF WE DON'T ALREADY OWN IT
	HRRZ	T2,DEVACC##(F)	;%LOC OF A.T.
	SKIPN	T1,T2		;%IS THERE ONE?
	JRST	GTNM2		;%NO, BAD NEWS
GTNM1::	JUMPE	T1,S..NNF	;%IF A.T. RING RUNS OUT, DIE
	HLRZ	T1,ACCNMB##(T1)	;%STEP TO NEXT IN RING
	TRZN	T1,DIFNAL##	;%IS IT AN NMB?
	JRST	GTNM1		;%NO. TRY NEXT
	POPJ	P,		;%YES. RETURN

GTNM2:	SKIPN	DEVUNI##(F)
	POPJ	P,
	STOPCD	CPOPJ##,STOP,NNF, ;++NMB NOT FOUND

;SUBROUTINE TO SET UP DEVFIL AND DEVEXT FROM NMB
; CALLED BY CLOSE INPUT (SINCE ANOTHER JOB MIGHT HAVE RENAMED THE FILE
; THIS JOB WAS USING, SWITCHING THE A.T. TO A NEW NMB)
;RETURNS T1=LOC OF NMB   T2=LOC OF A.T.
CLSNM::	PUSHJ	P,GETNMB	;SET T1=NMB, T2=A.T.
	MOVE	T3,NMBNAM##(T1)	;NAME
	MOVEM	T3,DEVFIL(F)	;INTO DDB
	HRLZ	T4,NMBEXT##(T1)	;GET EXTENSION
	HLLM	T4,DEVEXT(F)	;INTO DDB
	POPJ	P,		;RETURN

;ROUTINE TO FIX DEVFIL, DEVEXT, DEVPPN, DEVSFD, AND DEVUFB
CLSNAM::PUSHJ	P,CLSNM		;FIX DEVFIL AND DEVEXT
	PUSHJ	P,SAVT##	;RETURN AC'S LIKE THIS
CLSNM1:	HLRZ	T1,NMBPPB##(T1)	;FIND NMB OF PARENT SFD
	TRZN	T1,DIFNAL##
	JUMPN	T1,CLSNM1
	MOVEM	T1,DEVSFD##(F)	;STORE NEW SFD
	MOVE	T3,ACCPPB##(T2)	;ADDR OF NEW PPB
	MOVE	T4,PPBNAM##(T3)	;NEW PPN
	CAMN	T4,DEVPPN(F)	;HAS IT CHANGED?
	POPJ	P,		;NO
	MOVEM	T4,DEVPPN(F)	;YES, SAVE NEW PPN
	LDB	T1,ACYFSN##	;GET FILE STR
	HLRZ	T2,PPBUFB##(T3)	;ADDR OF 1ST UFB
	PUSHJ	P,BYTSCA##	;FIND THE RIGHT UFB
	  HRRM	T2,DEVUFB##(F)	;SHOULD NEVER SKIP, SAVE IT
	POPJ	P,

;ROUTINE TO COMPUTE THE CURRENT LEVEL OF SFD NESTING
;T1 RETURNS LEVEL (E.G. UFD=0)
CNTLVL:	HRRZ	T2,DEVSFD##(F)	;CURRENT SFD
CNTLV0:	SETZ	T1,		;INITIALIZE COUNT
CNTLV1:	JUMPE	T2,CPOPJ	;QUIT IF TOP LEVEL
CNTLV2:	HLRZ	T2,NMBPPB##(T2)	;FIND PARENT SFD
	TRZN	T2,DIFNAL##
	JUMPN	T2,CNTLV2
	AOJA	T1,CNTLV1	;BUMP COUNT AND DO NEXT LEVEL
;SUBROUTINE TO SET THE ADR OF THE 1ST NMB IN THE LIST
;ENTER WITH T2=LOC OF PPB
;EXIT T3=LOC OF PREDECESSOR, T2= 1ST NMB IN LIST
;IF AN SFD, RETURNS T4= LOC OF FATHER SFD NMB
SET1NM::HRRZ	T4,DEVSFD##(F)
	JUMPE	T4,SETIN1	;IN AN SFD?
	HLRZ	T2,NMBRNG##(T4)	;YES, GET 1ST NMB IN LIST
	MOVEI	T3,DIFNMC##(T4)	;AND PREDECESSOR
	POPJ	P,
SETIN1:	MOVEI	T3,DIFPNL##(T2)	;PRESET PRED
	HLRZ	T2,PPBNMB##(T2)	;1ST NMB IN PPB-LIST
	POPJ	P,		;AND RETURN


;SUBROUTINE TO DELETE A FILE NAME FROM A UFD
;ENTER WITH NAME TO BE DELETED IN DEVNAM,DEVEXT; UFD SPECIFIED BY DEVUFB
;AND P1=LOC OF NMB
;JOB MUST HAVE AU RESOURCE BEFORE CALLING DELNAM
;EXIT CPOPJ IF NAME NOT FOUND (STILL WITH AU RESOURCE)
;EXIT CPOPJ1 IF FOUND, WITH CFP IN T1, AND AU RES GIVEN UP
; THE UFD WILL HAVE BEEN REWRITTEN WITHOUT THE FILE NAME ON  GOOD RETURN
; AND THE NMB WILL BE ADJUSTED (NMBYES=0 FOR THE STR)
DELNAM:	HLRZ	U,DEVUNI##(F)	;SET U TO UNIT OF RIB
	PUSHJ	P,UFDSRC##	;SEARCH UFD
	  POPJ	P,		;TAKE NOT-FOUND RETURN
	PUSH	P,T1		;FOUND MATCH - SAVE CFP
	HRLI	T1,2(T3)	;BLT REST OF NAMES IN UFD DOWN
	HRRI	T1,(T3)		; BY 2 (OVERWRITE THIS NAME)
	HLRE	T4,T3		;DISTANCE FROM NAME TO END OF BLOCK
	MOVNS	T4
	ADD	T3,T4		;ADDR ONE PAST END OF BUF
	CAIE	T4,2		;DON'T DO BLT IF LAST ENTRY
	BLT	T1,-3(T3)	;SLIDE EVERYTHING DOWN
	SETZM	-2(T3)		;ZERO LAST SLOT IN UFD BLOCK
	SETZM	-1(T3)
	PUSHJ	P,WRTDIR	;GO WRITE THE UPDATED UFD
	PUSHJ	P,DWNAU##	;GIVE UP AU RESOURCE
	JUMPE	P1,TPOPJ1##	;DON'T CHANGE NMB IF P1=0
	PUSHJ	P,GETCB##	;CHANGE NMB - GET CB RESOURCE
	HRRZ	T2,DEVUFB##(F)	;%LOC OF UFB
	LDB	T1,UFYFSN##	;%GET FSN

	PUSHJ	P,FSNPS2##	;%SET A BIT FOR NMBYES
	ORM	T2,NMBKNO##(P1)	;%YES WE KNOW ABOUT FILE
	ANDCAM	T2,NMBYES##(P1)	;%NO IT IS NOT IN THIS STR
	POP	P,T1		;%RESTORE CFP TO T1
	PJRST	GVCBJ1##	;%GIVE UP CB AND SKIP RETURN
;SUBROUTINE TO TO SEE IF A BAD BLOCK (OR REGION) WAS ENCOUNTERED
;IF SO, SET RIBELB,RIBEUN,RIBNBB,RIBSTS. DO NOT WRITE RIB,AS THIS IS DONE BY CALLING ROUTINE
;EXIT WITH T1=C(.UPMBF)
TSTBAD:	MOVE	T1,.USMBF	;POINT AT RIB
	HLRZ	T3,S		;LH STATUS BITS
	ANDI	T3,IOSERR##	;MASK OUT ALL BUT ERROR BITS
	JUMPE	T3,CPOPJ##	;RETURN IF NONE
	MOVEI	T2,RIPABC##	;SET TO TEST FOR ALWAYS BAD CHECKSUM
	TDNN	T2,RIBSTS##+1(T1)	;ALWAYS BAD CHECKSUM?
	ORM	T3,RIBSTS##+1(T1)	;NO, SAVE ERROR BITS IN RH(RIBSTS)
	SKIPN	T2,DEVELB##(F)	;SHOULD A REGION BE MARKED IN BAT.SYS?
	POPJ	P,		;NO. RETURN

;HERE WITH T2=1ST BLOCK OF A REGION TO MARK IN BAT.SYS
	MOVEM	T2,RIBELB##+1(T1) ;SAVE 1ST BLOCK NO IN RIB
	LDB	T3,DEYEUN##	;UNIT (WITHIN STR) OF ERROR
	MOVSM	T3,RIBEUN##+1(T1) ;SAVE IN LH OF RIBEUN
	PUSHJ	P,SAVE2##	;SAVE P1
	PUSH	P,U		;SAVE U
	MOVE	T2,T3		;UNIT NUMBER WITHIN F/S
	PUSHJ	P,NEWUNI##	;SET U TO RIGHT UNIT
	  MOVE	U,(P)		;BAD NUMBER - ASSUME ORIGINAL U IS RIGHT
	MOVEI	P1,1		;P1 WILL COUNT # OF BLOCKS IN BAD REGION
IFN FTCIDSK,<
	SETZ	P2,		;ASSUME WE WON'T NEED A BUFFER
	LDB	T2,UNYKTP##	;GET KONTROLLER TYPE
	CAIE	T2,TYPRA	;CI DISK?
	JRST	TSTBD1		;NO
	MOVEI	T2,BLKSIZ##	;SIZE OF A BLOCK
	PUSHJ	P,GFWDCD##	;GET A BUFFER TO SCAN THE BAD BLOCK/REGION
	  STOPCD TSTBD5,DEBUG,CGB, ;++CAN'T GET BUFFER TO READ BAD BLOCK
	SOS	P2,T1		;GET ADDRESS -1
	TLOA	T1,MBLKSZ##	;IOWD TO READ 1 BLOCK, AND STORE DATA
>; END IFN FTCIDSK
TSTBD1:	MOVSI	T1,MBLKSZ##	;IOWD TO READ 1 BLOCK, BUT NOT STORE DATA
	LDB	T2,DEYELB##	;BAD BLOCK NUMBER
	PUSH	P,DEVISN##(F)	;SAVE USER'S SECTION #
	SETZM	DEVISN##(F)	;MAKE SURE MAPIO IGNORES SECTION #
TSTBD2:	ADDI	T2,1		;STEP TO NEXT BLOCK IN REGION
	CAIGE	P1,BAFNUM##	;ALREADY READ AS MANY BLOCKS AS WILL FIT IN 1 PNTR?
	CAMLE	T2,UNIBPU(U)	;NO, PAST TOP OF UNIT?
	JRST	TSTBD3		;YES, ALL FINISHED READING BAD BLOCKS
	PUSHJ	P,MONRDU##	;NO, READ IT
	TRNE	T3,IODTER+IODERR ;IS IT BAD?
	AOJA	P1,TSTBD2	;YES. COUNT AND TRY NEXT BLOCK
TSTBD3:
IFN FTCIDSK,<
	JUMPE	P2,TSTBD4	;JUMP IF NO BUFFER TO RETURN
	MOVEI	T2,1(P2)	;GET ADDRESS OF BUFFER
	MOVEI	T1,BLKSIZ##	;SIZE OF A BLOCK
	PUSHJ	P,GVFWDS##	;RETURN THE SPACE
>; END IFN FTCIDSK
TSTBD4:	MOVE	T1,.USMBF	;LOC OF MON BUF (AND RIB)
	HRRM	P1,RIBNBB##+1(T1) ;SAVE COUNT IN RIB
	POP	P,DEVISN##(F)	;RESTORE SECTION #
TSTBD5:	POP	P,U		;RESTORE ORIGINAL U
	PJRST	STORU##		;SAVE IN DDB AND RETURN
;SUBROUTINE TO FINISH UP IF AN ERROR OCCURRED
;UPDATE BATBLK, LH(RIBSTS) IN THE UFD RIB
ERRFIN:	TLNN	S,IOSERR##	;ANY ERROR?
	POPJ	P,		;NO. RETURN
	PUSHJ	P,SAVE2##	;YES. SAVE P1,P2
	MOVE	T1,.USMBF	;LOC OF RIB
	MOVE	P1,RIBELB##+1(T1) ;REGION TO WRITE IN BAT.SYS?
	TLZ	P1,BATMSK##	;JUST BLOCK NO.
	JUMPE	P1,ERFIN5	;NOT IF 0
	HLRZ	T2,RIBEUN##+1(T1)	;YES. BAD UNIT IN STR
	HRRZ	T3,UNISTR(U)	;LOC OF STR DATA BLOCK
	JUMPE	T3,ERFIN0	;DON'T GO TO NEWUNI IF NOT IN A F/S
				;(FROM RELEASE AFTER SUPER USETI/O)
	PUSHJ	P,NEWUNI##	;SET U TO DATA BLOCK
	  JRST	ERFN4A		;BAD UNIT NUMBER - IGNORE BAT BLOCK
ERFIN0:	PUSHJ	P,SUPDA##	;GET DA RESOURCE IF DONT ALREADY HAVE IT (SIM UPDATE)
	MOVE	T1,.USMBF	;LOC OF RIB
	HRRZ	P2,RIBNBB##+1(T1) ;LENGTH OF BAD REGION
	ADD	P2,P1		;TOP BLOCK(+1) OF BAD REGION
	PUSHJ	P,REDBAT##	;READ AND VERIGY BAT BLOCKS
	  PJRST	DWNDA##		;BOTH BLOCKS BAD, DON'T UPDATE
	MOVEI	T2,1(T1)	;1ST REAL WORD OF BAT
	ADD	T2,BAFFIR##(T2)	;COMPUTE AOBJN WORD FOR BAT REGIONS
ERFIN1:	MOVE	T3,BAFELB##(T2)	;1ST BLOCK OF A BAD REGION
	TLZ	T3,BATMSK##
	JUMPE	T3,ERFIN3	;IF 0 DONE, THIS IS A NEW REGION
	MOVEI	T4,BAPNTP##	;OLD STYLE?
	TDNN	T4,BAFAPN##(T2)
	HRRZS	T3		;YES, ONLY 18 BITS OF BLOCK NUMBER
	LDB	T4,BAYNBB##	;NO OF BLOCKS IN REGION-1
	ADD	T4,T3		; TOP BLOCK OF BAD REGION
	ADDI	T4,1		; TOP BLOCK +1
	CAML	P2,T3		;DOES NEW REGION OVERLAP THIS REGION?
	CAMLE	P1,T4
	JRST	SCNBAD		;NO. LOOK AT NEXT REGION IN BAT
	CAMLE	P1,T3		;YES. NEW 1ST BLOCK LT OLD 1ST BLOCK?
	MOVE	P1,T3		;NO. SET P1=LOWEST BLOCK
	CAMGE	P2,T4		;NEW TOP BLOCK GT OLD TOP BLOCK?
	MOVE	P2,T4		;SET P2=HIGHEST BLOCK
	LDB	T3,BAYAPN##	;SERIAL NO OF APR WHICH 1ST SAW BAD REGION
	CAME	T3,SERIAL##	;WAS IT THIS APR?
	JRST	ERFIN2		;NO.
	LDB	T3,BAYKNM##	;YES. KONTROLLER NO. WHICH 1ST SAW REGION
	LDB	T4,UNYKNM##	;THIS KONTROLLER NUMBER
	CAMN	T3,T4		;SAME?
	JRST	STOPUB		; YES. STORE NEW LIMITS OF REGION

;HERE IF A DIFFERENT APR OR KONTROLLER SAW THIS REGION BEFORE
ERFIN2:	MOVSI	T3,BAPOTH##	;SET A FLAG FOR MULTIPLE KONTROLLERS
	ORB	T3,BAFOTH##(T2)	; IN THIS BAT REGION
	JRST	WRTBAT		;ABD WRITE BAT (DON'T MARK THIS UNIT IN BAFPUB)

SCNBAD:	AOBJN	T2,.+1		;2 WORDS PER BAT ENTRY
	AOBJN	T2,ERFIN1	;GO TEST NEXT BAT ENTRY
	JRST	ERFIN4		;NO ROOM TO ENTER REGION - CANT DO ANYTHING WITH BAT

;HERE TO STORE A BAT ENTRY THE 1ST TIME
ERFIN3:	MOVE	T3,SERIAL##	;SERIAL NO OF APR
	TRO	T3,BAPNTP##	;NEW-STYLE ENTRY
	MOVEM	T3,BAFAPN##(T2)
	LDB	T3,UNYKNM##	;KONTROLLER NUMBER
	DPB	T3,BAYKNM##	;SAVE IT
	AOS	BAFCNT##+1(T1)	;INCREMENT COUNT OF BAT ENTRIES

;HERE TO MARK THE UNIT WHICH SAW THE ERROR
STOPUB:	MOVSI	T3,BARPUB##	;BIT FOR UNIT 0
	MOVE	T4,UDBPDN(U)	;PHYSICAL DRIVE NUMBER
	ANDI	T4,7		;MODULUS 8
	LSH	T3,(T4)		;POSITION BIT FOR THIS UNIT
	ORB	T3,BAFPUB##(T2)	;MARK IN TALLY OF UNITS WHICH SAW BAD REGION
;HERE WITH P1,P2=NEW LIMITS FOR THE BAD REGION WHOSE INDEX IS IN T2
WRTBAT:	SUBI	P2,1(P1)	;LENGTH OF BAD REGION+1
	DPB	P2,BAYNBB##	;SAVE IN BAT ENTRY(NO. BAD BLKS-1)
	MOVEM	P1,BAFELB##(T2)	;SAVE 1ST BLOCK OF REGION
	HLLZ	P1,DEVELB##(F)	;GET ERROR CODE
	TLZ	P1,MBTMSK##
	TRNE	T3,BAPNTP##
	IORM	P1,BAFELB##(T2)	;SAVE THEM IN BAT
	HRRZ	T2,UNIHOM(U)	;LOC OF 1ST HOME BLOCK
	ADDI	T2,LBOBAT##	;LOC OF 1ST BAT BLOCK
	PUSHJ	P,MONWRS##	;WRITE IT
	HLRZ	T2,UNIHOM(U)	;LOC OF 2ND HOME BLOCK
	ADDI	T2,LBOBAT##	;LOC OF 2ND BAT BLOCK
	PUSHJ	P,MONWRS##	;WRITE IT
	MOVEI	T3,1(T1)	;POINT TO BAT
	LDB	T4,BAYNBR##	;NO OF SLOTS THE MAPPER FOUND
	ADD	T4,BAFCNT##(T3)	;+ NO THE MONITOR FOUND
	HLRE	T3,BAFFIR##(T3)
	ASH	T3,-1		;2 WORDS PER ENTRY
	ADD	T3,T4		;-TOTAL NUMBER
	MOVNS	T3		;=-(NO OF SLOTS LEFT IN BAT)
	DPB	T3,UNYBCT##
ERFIN4:	PUSHJ	P,DWNDA##	;GIVE UP DA RESOURCE
	JRST	ERFIN5

;HERE IF A BAD RIBEUN IN RIB
ERFN4A:	HRRZ	U,DEVUNI##(F)	;RESET U

;HERE AFTER BAT BLOCK IS WRITTEN
ERFIN5:	HRRZ	P1,DEVUFB##(F)	;LOC OF UFB
	JUMPE	P1,CPOPJ##	;NO UFB IF SUPER IO
	PUSHJ	P,UPAU##	;GET AU RESOURCE
	MOVE	T1,UFBUN1##(P1)	;UNIT OF UFD
	LDB	T2,UN1PTR##	;NUMBER (IN STR) OF UNIT
	PUSHJ	P,NEWUNI##	;SET U TO UNIT DB
	  STOPCD DWNAU##,DEBUG,IUN,	;++INVALID UNIT NUMBER
	SKIPE	T2,UFBPT1##(P1)	;1ST RETRIEVAL POINTER OF UFD
	PUSHJ	P,CNVPTR##	;GET ADDRESS
	JFCL			;BAD UNIT-CHANGE PNTR!!!
	  PJRST DWNAU##		;UFB WAS DELETED - GIVE UP AU AND RETURN
	MOVE	T1,.USMBF	;IOWD FOR MON BUFFER
	MOVE	T2,DEVBLK##(F)	;BLOCK NUMBER OF UFD
	PUSHJ	P,MONRED##	;READ UFD RIB
	PJUMPN	T3,DWNAU##	;ERROR ON READ-GIVE UP AU AND RETURN
	HLLZ	T3,S
	TLZ	T3,IOSMER##	;ERROR BITS
	IORB	T3,RIBSTS##+1(T1)	;MARK IN LH(RIBSTS)
	TRNN	T3,RIPNDL##	;DON'T WRITE UNCLEARABLE BITS
	PUSHJ	P,MONWRT##	;WRITE UFD RIB
	PJRST	DWNAU##		;GIVE UP AU AND RETURN
;CLOSE OUTPUT

CHNDIR==1		;BIT ON IN M IF CHANGE DIRECTORY ON A CLOSE

CLOSOU:	PUSHJ	P,SPTSTO	;TEST FOR SPOOL-MODE FIRST OUTPUT
	  JRST	SETIMP		;IT WAS, AND ERROR ON ENTER - SET IOIMP
	TLNN	F,ENTRB+RENMB	;ENTER OR RENAME DONE?
	POPJ	P,		;NO. RETURN
	HRRZ	T1,DEVACC##(F)	;LOC OF ACCESS TABLE
	JUMPE	T1,CPOPJ##	;RETURN IF NONE
	PUSHJ	P,SAVE4##	;SAVE SOME ACS
	TLZN	S,IOSWLK	;STR WRITE-LOCKED?
	JRST	CLSOU1		;NO
	HRRZ	U,DEVFUN##(F)	;SET U IN CASE WRITE-LOCKED, NOT LOGGED-IN
	JRST	CLRSTS		;AND FINISH UP (WITHOUT WRITING ON THE DISK)
CLSOU1:	TLNN	S,IOSRST	;RESET OF A SPOOLED OUTPUT DEV?
	TLNN	F,ENTRB		;NO, RENAME ONLY?
	JRST	NOOUTP		;YES, DON'T FIDDLE WITH BUFFERS
	TLO	F,OCLOSB	;TURN ON OCLOSB (SPTSTO MIGHT HAVE ZEROED IT)
	LDB	T2,PIOMOD##	;MODE OF FILE
	CAIGE	T2,SD		;BUFFERRED MODE?
	TLNE	F,RESETB	;YES. FROM RESET UUO?
	JRST	NOOUTP		;YES. DON'T WORRY ABOUT LAST BUFFER
	HLRZ	T2,DEVBUF(F)	;OUTPUT LAST BUFFER LOC OF HEADER
	JUMPE	T2,NOOUTP
	EXCTUX	<SKIPG T3,@T2>	;VIRGIN RING?
	JRST	NOOUTP		;YES. NOTHING TO OUTPUT
	AOS	T2		;NO. POINT TO POINTER WORD
	EXCTUX	<HRRZ T4,@T2>	;LAST WORD FILLED
	SKIPE	T4		;IGNORE IT IF 0
	SUBI	T4,1(T3)	;-1ST WORD=LENGTH OF LAST BUFFER
	TRNN	S,IOWC		;USER COMPUTING OWN WORD COUNT?
	JRST	CLSOU2		;NO, SKIP ON
	HLL	T3,T2		;SET TO RELOCATE BUFFER POINTER
	AOS	T1,T3		;GET ADDR OF USER WORD COUNT IN T1,T3
	PUSHJ	P,UADRCK##	;MAKE SURE LEGAL, NO RETURN IF NOT
	EXCTUX	<HRRZ T4,@T3>	;GET USER WORD COUNT
CLSOU2:	JUMPE	T4,NOOUTP	;DON'T OUTPUT IF LENGTH .LE. 0
	TLZA	S,IOSRIB	;RIB IS NO LONGER IN MON BUF
				;(OUTPUT MAY READ RIB BACK)
CLSOU3:	IORM	T1,DEVADV(F)	;MAKE SURE UUOCON DOESN'T ADVANCE BUFFERS
	PUSHJ	P,OUT##		;WRITE THE LAST BUFFER
	PUSHJ	P,PWAIT1##	;WAIT FOR IT
	MOVEI	T1,DEPOND
	TLNE	S,IOSTBL	;CLOSE HAVE A PARTIAL BUFFER LEFT?
	JRST	CLSOU3		;YES, TRY ONCE MORE TO GET LAST BUFFER OUT
	ANDCAM	T1,DEVADV(F)	;CAN ADVANCE BUFFERS ONCE AGAIN
	TLO	F,OUTPB		;REMEMBER AN OUTPUT WAS DONE
	MOVSI	T1,DEPFFA	;FILOP. UPDATE RIB BIT
	MOVEI	T2,UP.MLB	;THE MERGE LAST BLOCK BIT
	TDNE	T1,DEVJOB(F)	;ARE WE INSIDE FOP.UR?
	IORM	T2,.USBTS	;YES - REMEMBER WE DID OUTPUT
;HERE WHEN THE FILE IS COMPLETELY WRITTEN
NOOUTP:	SKIPL	DEVSPL(F)	;SPOOLING DDB?
	JRST	NOOUT0		;NO, CONTINUE ON
	TLNE	F,OUTPB		;ANY OUTPUTS DONE?
	TRZA	M,CLSRST	;YES, NEVER DO RESET
	TRO	M,CLSRST	;NO, DON'T CREATE NULL FILE
NOOUT0:	TRNE	M,CLSRST	;CLOSE-RESET?
	TLO	F,RESETB	;YUP!
	PUSHJ	P,SETU##	;SET UP U FROM DDB
	  POPJ	P,		;A.T. WAS FIXED IF STR WAS YANKED
	TLNN	F,OCLOSB	;OUTPUT FILE BEEN CLOSED?
	TLNN	F,ENTRB		;NO. HAS AN ENTER BEEN DONE?
	SKIPA	T2,DEVACC##(F)	;NO. JUST GET LOC OF A.T.
	PUSHJ	P,CLSNAM	;YES. RESET DEVFIL, DEVEXT
				;(ELSE ENTER, RENAME WITH NO CLOSE LOSES)
	MOVE	T2,ACCSTS##(T2)	;STATUS OF FILE
	TRNE	T2,ACPUPD+ACPPAL##	;UPDATING OR PRE-ALLOCATED?
	TLZ	F,RESETB	;YES. MAKE SURE FILE ISNT DELETED
	MOVE	T1,DEVACC##(F)	;IF THIS IS A SIMULTANEOUS UPDATE FILE
	MOVE	T1,ACCSMU##(T1)	; GET THE FA RESOURCE AS A GUARD AGAINST
	TRNE	T1,ACPSMU	; RACE CONDITIONS INVOLVING RIBS
	PUSHJ	P,UPFA##	;GET FA BEFORE READING THE RIB
	TLOE	S,IOSRIB	;PRIME RIB IN CORE?
	JRST	NOOUT1		;YES, NO REASON TO READ
	PUSHJ	P,RIBCUR##	;NO. READ THE RIB
	JUMPE	T3,NOOUT1	;GO IF NO RIB ERROR
	PUSHJ	P,DWNIFA##	;RETURN FA IF WE HAVE IT (SIM UPDATE)
	JRST	NOOUT2		;AND CONTINUE

NOOUT1:	PUSHJ	P,SPTRW##	;SET AN AOBJN WORD FOR THE RETRIEVAL PNTRS
	MOVE	P1,T1		;SAVE POINTER IN P1
	PUSHJ	P,DD2MN##	;COPY LAST DDB POINTERS TO MON BUF
	  JFCL			;MAY OVERFLOW FROM  LAST 0'S IN DDB
	SKIPGE	DEVRIB##(F)	;EXTENDED RIB?
	PUSHJ	P,WRTRIB##	;YES WRITE IT NOW
				;PRIME RIB WILL GET WRITTEN LATER

	TLZN	F,RESETB	;RESET BEING PERFORMED?
	JRST	CLSOU4		;NO. CONTINUE
	SKIPL	DEVRIB##(F)	;IN EXTENDED RIB?
	JRST	NOUT1A		;NO
	PUSHJ	P,REDRIB##	;READ PRIME RIB
	  JRST	CLRSTS		;ERROR READING RIB
NOUT1A:	PUSHJ	P,DECSU		;SET P2 TO DECR
	PUSHJ	P,ATRMOV##	;GET RID OF A.T.
	PUSHJ	P,DECUC		;DECREMENT USE-COUNTS
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNT OF SFD A.T.
	PUSHJ	P,SFDDEC	;DECREMENT NMB/PPB COUNT OF SFD
	SETZM	DEVSFD##(F)	;WIPE THE POINTER
	HLLZS	DEVACC##(F)	;YES. SET DEVACC=0
	HLRZ	U,DEVUNI##(F)	;SET U TO UNIT OF (1ST) RIB
	JRST	CLSDL1		;AND DELETE THE FILE

;HERE ON A RIB ERROR TRYING TO CLOSE THE FILE
;DON'T DESTROY OLD VERSION IF SUPERSEDE, ENTER FILE IN UFD ANYWAY
;IF CREATE (DAMAGE ASSESMENT MAY MAKE SOME SENSE OUT OF IT LATER)
NOOUT2:	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	JUMPE	T1,CLRSTS	;GO IF UNIT WAS YANKED
	HRLZ	T2,ACCSTS##(T1)	;STATUS
	HLRZ	U,DEVUNI##(F)	;MAKE SURE U IS OK (MAY NOT BE IF UFD CFP ERR)
	MOVE	P3,U		;SET UP P3 FOR SETCFP
	TLNE	T2,ACPUPD	;UPDATE?
	DPB	T2,ACZFSN##	;YES, DON'T USE THIS A.T. AGAIN
	TLNN	F,RESETB	;CLOSE ACTING LIKE RESET?
	TLNN	T2,ACPCRE	;CREATE?
	JRST	CLRSTS		;NO, DON'T TOUCH OLD FILE
	JRST	CLSR11		;YES, ENTER NAME IN UFD
;HERE WITH THE RIB IN CORE, AND ALL PNTRS IN THE RIB
CLSOU4:	MOVE	T1,DEVACC##(F)	;IF THIS IS AN UPDATE FILE
	MOVE	T2,ACCSTS##(T1)
	TRNN	T2,ACPUPD
	JRST	CLSSIM
	LDB	T2,ACYWCT##	;IF SIM-UPD FILE
	SOJLE	T2,CLSSIM
	TLZ	M,400000	;INDICATE NOT A DIRECTORY TO CLSRI5
	SKIPL	DEVRIB##(F)	;NOT LAST WRITER - IN PRIME RIB?
	JRST	CLSRI5		;YES, JUST UPDATE DATES
	PUSHJ	P,REDRIB##	;READ PRIME RIB
	  JRST	NOOUT2		;RIB ERR
	JRST	CLSRI5		;AND GO UPDATE DATE/TIME
CLSSIM:	PUSHJ	P,DWNIFA##	;LAST WRITER - GIVE UP FA
	MOVE	T1,P1		;AOBJN WORD FOR POINTERS
CLSLUP:	HRRZ	T4,DEVACC##(F)	;LOC OF ACC
	MOVE	T3,ACCWRT##(T4)	;HIGHEST WRITTEN BLOCK OF FILE
	MOVE	T4,.USMBF	;IOWD FOR MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T4) ;GET FIRST BLOCK NUMBER IN RIB
	SKIPL	DEVRIB##(F)	;EXTENDED RIB?
	SETZ	T2,		;NO, ZERO STARTING BLOCK IN CASE OLD FILE
	PUSHJ	P,SCNPTR##	;GET THE POINTER FOR THIS BLOCK
	  JRST	CLSOU6		;NOT IN THIS RIB, LOOK IN NEXT
	MOVE	P1,T1		;AOBJN WORD STARTING AT LAST POINTER USED
	AOS	DEVBLK##(F)	;POINT TO 1ST BLOCK AFTER LAST WRITTEN
	AOS	DEVREL##(F)	;POINT TO LAST RELATIVE BLOCK DESIRED
	AOBJN	T1,.+2		;IF IN LAST POINTER,
	AOSA	T1,DEVLFT##(F)	; DEVLFT HAS BEEN ADJUSTED

	HRRZ	T1,DEVLFT##(F)	;NUMBER OF BLOCKS LEFT IN THIS PNTR
	SOJN	T1,CLSRIB	;GO IF THERE IS A BLOCK IN PNTR FOR  LAST RIB
CLSOU5:	AOBJP	P1,CLSOU8	;STEP TO NEXT POINTER SLOT
	SKIPE	T2,(P1)		;IS THERE ONE?
	JRST	CLSO12		;YES. USE IT
	SUB	P1,[XWD 1,1]	;NO. BACK UP P1 TO LAST PNTR
;HERE WHEN WE HAVE TO ALLOCATE 1 MORE CLUSTER TO WRITE THE LAST RIB OF THE FILE
	HRRM	P1,DEVRET##(F)	;SET DEVRET TO POINT TO LAST PNTR
	MOVEI	T2,1		;WE WANT TO ALLOCATE 1 BLOCK
	PUSHJ	P,CHKADD##	;CAN WE ADD TO CURRENT POINTER?
	JUMPE	T2,CLSOU9	;IF T2=0 CANT ADD
	MOVE	T1,DEVBLK##(F)	;1ST BLOCK AFTER HIGHEST WRITTEN BLOCK
	PUSHJ	P,TAKBLK##	;TRY TO GET 1 CLUSTER STARTING THERE
	  JRST	CLSOU9		;CANT GET IT THERE - TRY ANYWHERE
	PUSHJ	P,ADDPTR##	;GOT IT. ADD TO CURRENT POINTER
	JRST	CLSRIB		;AND CONTINUE


;HERE TO LOOK FOR THE LAST WRITTEN BLOCK IN THE NEXT RIB
CLSOU6:	SKIPLE	DEVRIB##(F)	;PRIME RIB IN CORE?
	PUSHJ	P,WRTRIB##	;YES, WRITE IT (MIGHT HAVE CHANGED)
	PUSHJ	P,PTRNXT##	;GET THE NEXT RIB INTO CORE
	JRST	CLSOU7		;EITHER ERROR OR NONE
	PUSHJ	P,SPTRW##	;PUT AOBJN WORD TO POINTERS IN T1
	JRST	CLSLUP		;GO SCAN THIS RIB
CLSOU7:	JUMPN	T3,NOOUT2	;IF T3 NON-ZERO, ERROR
	STOPCD	NOOUT2,DEBUG,NER,	;++NO EXTENDED RIB
;HERE WHEN POINTERS RAN OUT, WE KNOW THERE IS ONE MORE BLOCK IN THE LAST POINTER
CLSOU8:	SUB	P1,[XWD 1,1]	;BACK UP TO LAST POINTER
	AOJA	T1,CLSRIB	;FORCE DEVLFT TO BE 1
;HERE WHEN WE HAVE TO CREATE A NEW POINTER TO ALLOCATE THE LAST BLOCK
CLSOU9:	AOBJP	P1,CLSFUL	;STEP TO NEXT POINTER SLOT
	HRRM	U,DEVUNI##(F)
CLSO10:	PUSHJ	P,SUPDA##
	HRRM	P1,DEVRET##(F)	;SAVE LOC OF NEW POINTER (IN MON BUF)
	SKIPLE	UNITAL(U)	;UNIT HAVE ANY SPACE LEFT?
	JRST	CLSO11		;YES
	PUSHJ	P,DWNDA##
	PUSHJ	P,NEXTUN##	;NO. STEP TO NEXT UNIT
	  JRST	CLSFUL		;NO UNIT IN STR HAS SPACE!
	AOBJN	P1,CLSO10	;FOUND. STEP TO NEXT PNTR LOC IF ROOM IN RIB
	SETZM	@DEVRET##(F)	;NO ROOM IN RIB - ZERO UNIT-CHANGE
	HRRZ	U,DEVUNI##(F)	;RESET U TO LAST UNIT IN RIB
				;AND FALL INTO CLSFUL


;HERE WHEN THERE IS NO SPACE IN STR, OR ALL POINTER SLOTS ARE TAKEN
CLSFUL:	TRO	S,IOBKTL	;LIGHT ERROR BIT
	HRRZ	T2,DEVACC##(F)	;LOC OF ACC
	SOSGE	ACCWRT##(T2)	;DECREASE AMOUNT WRITTEN BY 1
	JRST	CLSFL2		;NOTHING WRITTEN
	SOS	DEVREL##(F)	;POINT TO LAST RELATIVE BLOCK DESIRED
	SOS	DEVBLK##(F)	;POINT TO LAST DATA BLOCK
	HRRI	M,CLSDLL	;INDICATE DON'T DELETE ANYTHING ON CLOSE
	HRRZ	U,DEVUNI##(F)	;SET U TO UNIT WITH LAST DATA
	MOVEI	T1,BLKSIZ##	;REINITIALIZE COUNT
	DPB	T1,ACYLBS##
	JRST	CLSRI1		;GO WRITE LAST RIB OVER LAST DATA BLOCK

;HERE WHEN NO ROOM IN STR, AND ACCWRT = 0
;DELETE THE FILE (WHICH IS JUST THE 1ST RIB)
CLSFL2:	SUB	P1,[XWD 1,1]	;SET P1 = AOBJN WORD
	PUSHJ	P,DELRIB	;GIVE BACK THE BLOCK
	  STOPCD .+1,DEBUG,DER,	;++DELRIB ERROR RETURN
	PJRST	CLRSTS		;FINISH UP (DON'T WRITE UFD)

;HERE WHEN A UNIT HAS BEEN FOUND WITH SPACE ON IT
CLSO11:	MOVEI	T2,1		;WE WANT 1 BLOCK
	SETZ	T1,		;ANYWHERE ON THE UNIT
	PUSHJ	P,TAKBLK##	;GET A CLUSTER
	  STOPCD .,STOP,UFI,	;++UNIT FREE-COUNT INCONSISTENT
	MOVEM	T2,(P1)		;SAVE THE PNTR IN THE MON BUF
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	MOVEI	T3,ACP1PT##	;TURN OFF 1PT BIT IN A.T.
	ANDCAM	T3,ACC1PT##(T1)
CLSO12:	PUSHJ	P,CNVPTR##	;CONVERT POINTER TO COUNT, ADDRESS
	  JRST	NOOUT2		;BAD UNIT-CHANGE PNTR
	  JRST	CLSOU5		;UNIT CHANGE - TRY NEXT POINTER
;HERE WITH DEVBLK,DEVREL,DEVLFT SET TO REDUNDANT LAST RIB BLOCK
CLSRIB:	HRRM	T1,DEVLFT##(F)	;SAVE COUNT OF BLOCKS LEFT IN PNTR
CLSRI1:	MOVE	T1,DEVRIB##(F)	;GET DEVRIB INTO T1 IN CASE NOT GO TO UPDGIV
	TRNE	M,CLSDLL	;DELETE UNWRITTEN BLOCKS FROM FILE?
	JRST	CLSRI2		;NO
	PUSH	P,DEVRIB##(F)	;SAVE POINTER TO CURRENT RIB
	MOVE	P2,DEVBLK##(F)	;YES. SAVE BLOCK OF RIB
	MOVE	P3,DEVREL##(F)	;SAVE DEVREL IN CASE UPDGIV CHANGES IT
	PUSHJ	P,UPDGIV	;GIVE UP THE UNWRITTEN BLOCKS OF THE FILE
	  STOPCD .+1,DEBUG,SBT,	;++SHOULDN'T BE TRUNCATING
	MOVEM	P3,DEVREL##(F)	;RESTORE TO DDB
	MOVEM	P2,DEVBLK##(F)	;RESTORE BLOCK NO. OF LAST RIB
	POP	P,T1		;RESTORE PREVIOUS CURRENT RIB TO T1

CLSRI2:	SKIPL	DEVRIB##(F)	;SKIP IF NOT IN PRIME RIB
	JRST	CLSRI4		;PRIME RIB, GO WRITE REDUNDANT
	CAME	T1,DEVRIB##(F)	;ARE WE STILL IN THE SAME EXTENDED RIB?
	JRST	CLSRI3		;NO, GET PRIME
	PUSHJ	P,WRTRIB##	;WRITE OUT THE CURRENT RIB
CLSRI3:	PUSHJ	P,REDRIB##	;GET THE PRIME RIB INTO CORE
	  JRST	NOOUT2		;ERROR READING RIB

CLSRI4:	TLZ	M,400000
	HLRZ	T1,DEVEXT(F)	;EXTENSION OF FILE
	CAIN	T1,(SIXBIT .SFD.)	;AN SFD?
	TLOA	M,400000	;YES, LIGHT SIGN BIT, DON'T CHANGE UFB
	CAIE	T1,(SIXBIT .UFD.)	;A UFD?
	JRST	CLSRI5		;NO
	TLO	M,400000	;INDICATE FILE IS A DIRECTORY
	PUSHJ	P,FNDUFB	;YES. FIND UFB FOR FILE
	  JRST	CLSRI5		;NOT THERE - CONTINUE
	PUSHJ	P,SPTRW##	;%FOUND - SET AOBJN WORD FOR PNTRS
	MOVE	T3,(T1)		;%UNIT OF UFD
	DPB	T3,COYUN1##	;%SAVE UNIT IN UFB
	MOVE	T1,1(T1)	;%FIRST REAL POINTER
	MOVEM	T1,UFBPT1##(T2)	;%SAVE IN UFB
	PUSHJ	P,GVCBJ##	;%RETURN CB RESOURCE
CLSRI5:	MOVE	T1,.USMBF	;IOWD FOR MON BUF
	HRRZ	P1,DEVACC##(F)	;LOC OF A.T.
	JUMPE	P1,CLRSTS	;GO IF UNIT YANKED
	SKIPE	T4,ACCWRT##(P1)	;NO. OF BLOCKS WRITTEN
	SUBI	T4,1		;-1
	LSH	T4,BLKLSH##	;*128
	MOVE	T3,P1
	LDB	P2,ACZLBS##	;SIZE OF LAST BLOCK
	JUMPGE	M,CLSRI6	;IF THE FILE IS A DIRECTORY
	SKIPE	ACCWRT##(P1)	; WHICH IS NOT EMPTY,
	MOVEI	P2,BLKSIZ##	; MAKE SURE THE LAST BLOCK IS "FULL"
	DPB	P2,ACZLBS##	;SAVE NEW SIZE IN ACC
CLSRI6:	ADD	T4,P2		;TOTAL NUMBER OF WORDS IN FILE
	MOVEM	T4,RIBSIZ##+1(T1)	;SAVE IN RIB
	MOVEI	T2,RIPPAL##
	MOVE	T3,DEVPAL##(F)	;PRE-ALLOCATING?
	TRZE	T3,DEPPAL##
	TLNE	F,OUTPB		;YES, OUTPUT DONE?
	JRST	CLSRI7		;NOT PRE-ALLOCATING OR WRITTEN
	IORM	T2,RIBSTS##+1(T1)	;PRE-ALLOCATED, LIGHT BIT
	JRST	CLSRI8
CLSRI7:	MOVEM	T3,DEVPAL##(F)	;ENSURE DEPPAL=0
	ANDCAM	T2,RIBSTS##+1(T1)	; AND THE BIT IS OFF
CLSRI8:	MOVE	T2,ACCSTS##(P1)	;STATUS OF FILE
	TLNN	F,RENMB		;FILE BEING RENAMED?
	TRNE	T2,ACPUPD	;UPDATE?
	TLNN	F,OUTPB+INPB	;YES, ANY OUTPUTS OR INPUTS DONE?
	JRST	CLSRI9		;NO
	MOVE	T3,TIME##	;YES, ACCESS DATE
	IDIV	T3,TICMIN##	;T3=TIME RIGHT ADJUSTED
	HRRZ	T4,THSDAT##	;DATE
	DPB	T4,[POINT 15,ACCADT##(P1),17]	;SAVE NEW ACCESS DATE
	DPB	T4,[POINT 15,RIBEXT##+1(T1),35]	; IN RIB AND A.T.
	TLNN	F,OUTPB		;OUTPUTS DONE?
	JRST	CLSR10		;NO, DON'T UPDATE CREATION DATE
	LDB	T2,[POINT 3,T4,23]	;HI PART OF CREATION DATE
	DPB	T3,[POINT 11,T4,23];POSITION TIME IN WORD
	MOVSI	T3,777740	;SET TO MASK OUT TIME,DATE
	AND	T3,RIBPRV##+1(T1)	;GET MODE, PROTECTION
	ORM	T3,T4		;PLUS NEW DATE, TIME
	MOVEM	T4,RIBPRV##+1(T1)	;SAVE NEW DATE, TIME WORD IN RIB
	MOVEM	T4,ACCPRV##(P1)	; AND IN ACC
	DPB	T2,[POINT 3,RIBEXT##+1(T1),20]	;SAVE HI CRE-DATE IN RIB
	DPB	T2,[POINT 3,ACCADT##(P1),2]	; AND IN A.T.
	MOVE	T3,DATE##	;MOVE NEW DATE TIME IN
	HRRZ	T4,RIBFIR##+1(T1)	;NO OF VALUES IN RIB
	CAIL	T4,RIBTIM##+1	;DON'T WIPE OUT 1ST PNTR IF OLD FILE
	MOVEM	T3,RIBTIM##+1(T1)

CLSRI9:	LDB	T2,UNYKNM##	;KONTROL NUMBER
	LSH	T2,17
	IOR	T2,.C0ASN##	;APR NUMBER
	HRRZ	T3,RIBUNI##+1(T1)
	CAIE	T3,(T2)		;SAME AS BEFORE?
	SETZM	RIBUNI##+1(T1)	;NO, NO UNITS YET WROTE
	HRRM	T2,RIBUNI##+1(T1)
	HLRZ	U,DEVUNI##(F)	;UNIT WITH RIB
	PUSHJ	P,ORINUN	;LIGHT BIT
	HRRZ	U,DEVUNI##(F)	;CURRENT UNIT
	PUSHJ	P,ORINUN	;LIGHT BIT
CLSR10:	MOVE	T3,ACCALC##(P1)	;AMOUNT OF SPACE ALLOCATED
	MOVEM	T3,RIBALC##+1(T1)	;SAVE IN RIB
	PUSHJ	P,SPTRW##	;GET AOBJN WORD FOR POINTERS
	MOVE	T2,1(T1)	;GET FIRST POINTER IN PRIME RIB
	MOVEM	T2,ACCPT1##(P1)	;MOVE TO ACC
	PUSHJ	P,TSTBAD	;SET RIBELB, ETC IF ERROR

	HLRZ	P3,DEVUNI##(F)	;SAVE FIRST UNIT IN P3 FOR LATER CALL TO SETCFP
ALLPT1:	TRNE	S,IOSFA		;IF HAVE FA, MUST BE SIM UPDATE
	JRST	ALLPT5		;SO JUST REWRITE PRIME RIB (WITH NEW DATES)
	MOVE	T2,RIBFLR##+1(T1) ;GET FIRST BLOCK NUMBER IN RIB
	SKIPL	DEVRIB##(F)	;SKIP IF EXTENDED RIB
	SETZ	T2,		;NOT EXTENDED, FIRST BLOCK =0
	SKIPN	T3,DEVREL##(F)	;DEVREL=0 MEANS INACTIVE RIB
	JRST	ALLPT2		;GO WRITE REDUNDANT RIB NEXT TO REAL
	PUSHJ	P,SCNPT0##	;SCAN THE RIB FOR THE BLOCK IN T3
	  JRST	ALLPT3		;NOT FOUND, MUST BE A FULL RIB
	SETZM	DEVREL##(F)	;FLAG THAT NEXT RIB(IF ANY) IS INACTIVE
	JRST	ALLPT4		;GO WRITE REDUNDANT

;HERE WHEN WORKING IN AN INACTIVE RIB (BLOCKS ALLOCATED BUT NOT USED)
ALLPT2:	MOVE	T3,T2		;GET NUMBER OF FIRST BLOCK IN RIB TO T3
	AOJ	T3,		;POINT TO NEXT BLOCK
	PUSHJ	P,SCNPT0##	;SCAN THE RIB FOR THIS BLOCK
	  STOPCD .,JOB,BMR,	;++BLOCK MISSING FROM RIB
	SETZM	DEVREL##(F)	;RESET THE INACTIVE RIB FLAG TO 0
	JRST	ALLPT4		;GO WRITE THE RIB
	;STILL IN FTDMRB CONDITONAL
;HERE TO WRITE THE REDUNDANT RIB IN THE LAST BLOCK OF THE RIB
ALLPT3:	PUSH	P,DEVREL##(F)	;SAVE FLAG FOR INACTIVE RIBS
	PUSHJ	P,GTLPT		;GET LAST RIB POINTER
	PUSHJ	P,CNVPTR##	;DECODE THE POINTER
	  JFCL			;BAD UNIT-CHANGE
	  STOPCD .,JOB,LPU,	;++LAST POINTER UNIT-CHANGE
	SOS	T2,T1		;LENGTH OF POINTER -1 TO T2
	ADDM	T2,DEVBLK##(F)	;BLOCK NUMBER FOR WRITE TO DDB
	POP	P,DEVREL##(F)	;RESTORE BLOCK FOR LAST ACTIVE REDUNDANT WRITE
;HERE TO WRITE RIB IN CORE REDUNDANTLY IN BLOCK NUMBER CONTAINED IN DEVBLK
ALLPT4:	MOVE	T1,.USMBF	;GET IOWD FOR MONITOR BUFFER
	MOVE	T2,DEVBLK##(F)	;GET BLOCK NUMBER FOR REDUNDANT WRITE
	MOVEM	T2,RIBSLF##+1(T1) ;PUT IN RIB
	MOVEI	T3,CODRIB##	;777777 TO RH(T3)
	MOVEM	T3,RIBCOD##+1(T1)	;MAKE SURE CODE IS IN RIB
	TLNE	F,RENMB		;DOING A RENAME?
	PUSHJ	P,NAMNW		;YES, PUT NEW NAME,EXT AND PPN IN RIB
	PUSHJ	P,MONWRU##	;WRITE REDUNDANT RIB (KEEP OUT OF DISK CACHE)
ALLPT5:	PUSHJ	P,WRTRIB##	;WRITE REAL RIB
	JUMPE	T3,ALLPT6	;GO IF WRITTEN OK
	MOVE	T1,DEVACC##(F)
	HRLZ	T2,ACCSTS##(T1)	;IF AN UPDATE FILE
	TLNE	T2,ACPUPD
	DPB	T2,ACZFSN##	;MAKE SURE A.T. ISN'T FOUND LATER
ALLPT6:	PUSHJ	P,RIBSAT	;WRITE SATS WHICH HAVE CHANGED
	MOVE	T1,.USMBF	;IOWD TO MONITOR BUFFER
	PUSH	P,RIBXRA##+1(T1) ;GET POINTER TO NEXT RIB (IF ANY)
	SKIPGE	DEVRIB##(F)	;PRIME RIB?
	JRST	ALLPT7		;NO, DON'T DO ANYTHING ABOUT BAT BLOCKS
	SKIPE	RIBFLR##+1(T1)	;SKIP IF EXTENDABLE RIB
	SETZM	(P)		;NOT EXTENDABLE, RIBFLR IS GARBAGE
	PUSH	P,U
	PUSHJ	P,ERRFIN	;YES, WRITE BAT BLOCK IF ERRORS
	POP	P,U

ALLPT7:	POP	P,DEVRIB##(F)	;GET POINTER FROM PREVIOUS RIB
	SKIPN	DEVRIB##(F)	;ANY MORE RIBS?
	JRST	ALLPT8		;NO, THROUGH
	PUSHJ	P,RIBCUR##	;READ THE NEXT RIB
	JUMPN	T3,NOOUT2	;IF T3 NON-ZREO, RIB ERROR
	JRST	ALLPT1		;TAKE CARE OF THE EXTENDED RIB

;HERE WHEN WE ARE FINISHED CLEANING UP SATS AND RIBS
ALLPT8:	TRNN	S,IOSFA		;SIM UPDATE?
	JRST	CLSR11		;NO, CHANGE DIRECTORY
	PUSHJ	P,DWNFA##	;YES, GIVE UP FA SINCE RIB NOW WRITTEN
	JRST	CLRSTS		;AND FINISH THE CLOSE


;ROUTINE TO STORE THE CFP
;T1 PASSES THE CFP
;T2 PASSES ADDR OF NMB
SAVCFP:	HRRM	T1,NMBCFP##(T2)	;SAVE THE CFP
	HRRZ	T1,DEVACC##(F)	;SAVE FSN CFP IS FOR
	LDB	T1,ACZFSN##
	DPB	T1,NMYFSN##
	MOVE	T3,T2		;ADDR OF NMB
	PUSHJ	P,FSNPS2##	;POSITION A BIT
	ORM	T2,NMBYES##(T3)	;FILE EXISTS ON THIS STR
	POPJ	P,

;NOW CHANGE THE DIRECTORY
CLSR11:	PUSHJ	P,UPAU##	;GET AU RESOURCE
	HRRZ	P1,DEVACC##(F)	;LOC OF ACC
	MOVE	T1,ACCSTS##(P1)	;STATUS OF FILE
	TRNE	T1,ACPCRE	;CREATING?
	JRST	NOTOLD		;YES
	HRRZ	T3,ACCPPB##(P1)	;NO. LOC OF PPB
	MOVE	T4,PPBNAM##(T3)	;NEW PRJ,PRG NUMBER
	CAME	T4,DEVPPN(F)	;SAME AS OLD?
	JRST	NOTOL1		;NO. CREATE FILE IN NEW DIR.

	TLNN	F,RENMB		;IF A RENAME WAS DONE,
	JRST	CLSR12
	MOVE	T3,DEVSFD##(F)	;DEFAULT SFD
	HLRZ	T4,T3		;ORIGINAL SFD
	CAIE	T4,(T3)		;SAME AS "NEW" SFD?
	JRST	NOTOL1		;NO, CREATE THE NAME IN NEW SFD
	HLRZ	T4,DEVEXT(F)	;RENAMED A UFD
	CAIE	T4,'UFD'	;NO NEED TO RE-WRITE MFD
CLSR12:	TRNE	T1,ACPNIU+ACPUPD	;YES, FILE BEEN REMOVED FROM DIRECTORY OR JUST UPDATE?
	JRST	CLRST2		;YES, DON'T HAVE TO CHANGE DIRECTORY
	TRNN	T1,ACPREN	;IF FILE NOT BEING RENAMED,
	TRNN	T1,ACPPAL##	;IF PRE-ALLOCATED
	CAIA
	JRST	CLRST2		; LEAVE THE UFD ALONE
	PUSHJ	P,UFDSRC##	;NO. FIND FILE NAME IN DIRECTORY
	  JRST	NOTOLD		;CANT FIND IT - CREATE NEW NAME
	EXCH	P1,T1		;P1 HAS CFP, T1 HAS LOC OF ACC
	PUSHJ	P,GTNM1		;FIND NMB
;HERE WITH T1=LOC OF NMB FOR THE FILE
	MOVE	T2,NMBNAM##(T1)	;(NEW) FILE NAME
	MOVEM	T2,UFDNAM##(T3)	;SAVE IN DIRECTORY
	HRLZ	T4,NMBEXT##(T1)	;(NEW) EXTENSION
	HLLM	T4,UFDEXT##(T3)	;SAVE IN DIRECTORY
	HRLM	T3,P1		;SAVE LOC OF DIRECTORY SLOT
	PUSH	P,T1		;SAVE LOC OF NMB
	PUSHJ	P,SETCFP##	;COMPUTE CFP FROM A.T. AND U
	HLRZ	T3,P1		;LOC OF DIRECTORY SLOT
	HRRM	T1,UFDCFP##(T3)	;SAVE CFP IN UF
	MOVE	T2,(P)		;LOC OF NMB
	HRRZ	T3,DEVACC##(F)	;SAVE ACPSUP
	HRL	P1,ACCSTS##(T3)
	PUSHJ	P,NEWCFP	;SAVE CFP IN NMB
	  JFCL
	PUSHJ	P,WRTDIR	;GO WRITE THE UPDATED DIRECTORY BLOCK
	;PUSHJ	P,DWNAU##	;DON'T GIVE UP AU UNTIL WE'RE
				; DONE WITH DELRIB. ELSE SOMEBODY
				; ELSE CAN SNEAK IN A DELETE WHILE
				; WE'RE BLOCKED IN RIBCUR
	TLNE	P1,ACPSUP	;SUPERSEDER?
	JRST	ALLPT9		;YES. REMOVE OLD FILE
	POP	P,T1		;NO. REMOVE JUNK FROM PD LIST
	JRST	CLRSTS		;AND FINISH UP
ALLPT9:	HRRZ	T1,P1		;CFP FOR THE OLD FILE
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
ALLP10:	CBDBUG	(N,Y);

	LDB	P1,ACYFSN##	;STR NUMBER

	PUSHJ	P,CFP2BK##	;CONVERT TO BLOCK ADR
	  JRST	ALLP11		;CFP BAD - LEAVE OLD FILE ALONE
	SETZM	DEVRIB##(F)	;ZERO OUT DEVRIB FOR DPB'S
	LDB	T3,UNYLUN##	;GET LUGICAL UNIT NUMBER FOR UFD RIB
	DPB	T3,DEYRBU##	;DEPOSIT IN RIB POINTER
	LDB	T3,UNYBPC##	;GET NUMBER OF BLOCKS PER CLUSTER
	IDIV	T2,T3		;CONVERT BLOCK NUMBER TO CLUSTER NUMBER
	DPB	T2,DEYRBA##	;TO DDB
	PUSHJ	P,RIBCUR##	;GET THE RIB POINTER AT BY DEVRIB INTO CORE
	JUMPN	T3,ALLP11	;JUMP IF RIB ERROR, LEAVE OLD FILE ALONE
	PUSHJ	P,SPTRW##	;SET AN AOBJN WORD FOR PNTRS
	EXCH	P1,T1		;P1=AOBJN WORD, T1=FSN
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	POP	P,T2		;%LOC OF NMB
	TRO	T2,DIFNAL##	;%ADJUST FOR ACCNMB
DELTST:	PUSHJ	P,BYTSC1##	;%SEARCH FOR AN A.T.
	  SKIPA	T3,ACCSTS##(T2)	;%FOUND ONE. GET STATUS
	JRST	CLSDL3		;%NO A.T. TO DELETE
	TRNE	T3,ACPCRE+ACPUPD+ACPSUP+ACPREN	;%FILE JUST READING?
	JRST	DELTST		;%NO. IGNORE IT
	MOVE	T4,DEVACC##(F)	;%IF A LOOKUP GOT THROUGH FNDFIL
	MOVE	T4,ACCPT1##(T4)	;% AND READ THE NEW RIB AFTER
	CAME	T4,ACCPT1##(T2)	;% OUR CALL TO WRTUFD HE IS READING
	JRST	DELTS1		;% THE NEW FILE, WHICH WE SHOULDN'T DELETE
	HRRZ	T2,DEVACC##(F)	;%DELETE OUR A.T. AND THE OLD FILE
	JRST	CLSDEL		;% LEAVING THE OTHER A.T. ALONE
;HERE WITH T2=LOC OF AN A.T. WHICH MUST BE DELETED
DELTS1:	LDB	T4,ACZCNT##	;%FILE DORMANT?
	JUMPE	T4,CLSDEL	;%YES, DELETE A.T., FILE
	TRNN	T3,ACPDEL##	;%ALREADY MARKED FOR DELETION ?
	JRST	DELTS2		;%NO, MARK IT
	MOVE	T3,1(P1)	;% IF THE A.T. WE FOUND
	CAME	T3,ACCPT1##(T2)	;% IS NOT FOR THIS FILE
	JRST	DELTST		;% THEN THE FILE CAN BE DELETED NOW
DELTS2:	MOVEI	T1,ACPDEL##+ACPNIU ;MARK FILE TO BE DELETED ON CLOSE
	ORM	T1,ACCDEL##(T2)	;SO FILE WILL DISAPPEAR WHEN READ COUNT EXHAUSTED
	PUSHJ	P,GVCBJ##	;%RELEASE CB RESOURCE
	JRST	CLRSTS		;AND FINISH UP

;HERE WHEN THERE IS NO A.T. TO REMOVE
CLSDL3:	PUSHJ	P,GVCBJ1##	;%GIVE UP CB AND SKIP

;HERE WITH T2=LOC OF A.T. WHEN THERE IS AN A.T. TO REMOVE
CLSDEL:	PUSHJ	P,ATRMVX##	;REMOVE THE A.T. FROM SYSTEM

;HERE TO DELETE A FILE, WITH RIB IN MON BUF
CLSDL1:	MOVEI	P4,DEPALC##
	IORM	P4,DEVALC##(F)	;ACCALC SHOULD NOT BE CHANGED
	HRRZ	T1,DEVACC##(F)	;CLEAR SUPERSEDING BIT, SO
	JUMPE	T1,CLSDL2
	MOVEI	T2,ACPSUP	; SNUKIN CODE WILL WORK IF WE
	ANDCAM	T2,ACCSTS##(T1)	; GET RESCHEDULED AND A LOOKUP IS IN PROGRESS
	MOVEI	T2,ACPCNT##	;IF WE GET RESCHEDULED AND A LOOKUP/CLOSE HAPPENS
	ADDM	T2,ACCCNT##(T1)	; THE A.T. WILL BECOME DORMANT, SO BUMP READ-COUNT
CLSDL2:	PUSHJ	P,DELRIB	;DELETE THE FILE
	  STOPCD .+1,DEBUG,DCR,	;++DELRIB CPOPJ RETURN
	ANDCAM	P4,DEVALC##(F)	;CHANGE ACCALC AGAIN
	MOVNI	P4,ACPCNT##	;DECR READ-COUNT WHEN
	JRST	CLRSTX		; WE ARE THROUGH (CLRST0)
ALLP11:	POP	P,T1		;ERR READING RIB - REMOVE JUNK FROM PD LIST
	JRST	CLRSTS		;AND FINISH UP
;HERE TO CREATE A NEW NAME IN A DIRECTORY BLOCK
NOTOLD:	TRZA	M,-1		;NO OLD DIR
NOTOL1:	HRRI	M,CHNDIR	;INDICATE DELETE NAME FOM OLD DIR
	HRRZ	T1,DEVACC##(F)	;IF ACPNIU IS LIT, WE MUST BE DOING
	MOVE	T1,ACCSTS##(T1)	; A RENAME ACCROSS DIRS AND SOMEBODY
	TRNE	T1,ACPNIU	; SNUCK IN WITH A LOOKUP AND RENAME TO 0.
	JRST	FNDFRY		; SO DON'T PUT IT IN THE DIR
	PUSHJ	P,DIRSET##	;GET RETRIEVAL PNTRS TO READ THE DIR
	  TROA	S,IOIMPM	;NOT THERE - LIGHT AN ERROR BIT
	JRST	NOTOL3		;THERE IS A REAL PNTR
	PUSHJ	P,DWNAU##	;GIVE UP AU RESOURCE
	PUSHJ	P,SPTRW##	;SET AN AOBJN WORD FOR WHOLE RIB PNTRS
	EXCH	P1,T1		;P1=AOBJN WORD, T1=LOC OF A.T.
	MOVE	T2,T1		;A.T. LOC INTO T2
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	JRST	CLSDEL		;%DELETE THE FILE WHICH WAS JUST WRITTEN
NOTOL3:	PUSHJ	P,SETFS0##	;SET UP TO READ DIRECTORY
	  JRST	BADUFD		;ERROR READING DIRECTORY - CANT ENTER NAME
	PUSHJ	P,UFORSS##	;GET UFB OR SFD A.T. LOC
	TRZE	T3,NMPSFU##	;AN SFD?
	SKIPA	P2,ACCWRT##(T3)	;YES, GET SIZE FROM ACCWRT
	LDB	P2,UFYWRT##	;NO OF DATA BLOCKS IN DIRECTORY
;IN THE FOLLOWING CODE, P4 IS A FLAG THAT TELLS YOU WHETHER OR NOT TO COMPRESS:
;P4=NEGATIVE, NEVER COMPRESS
;P4=ZERO, SOMETIMES COMPRESS (ONLY COMPRESS IF YOU REALLY HAVE TO)
;P4=POSITIVE, ALWAYS COMPRESS
	HLRZ	P4,UFBZRB##(T3)	;"ALWAYS" COMPRESS IF BLOCK OF ZEROES
	ANDI	P4,UFPZRB##
	CAIGE	P2,2		;NEVER COMPRESS UNLESS AT LEAST TWO BLOCKS
	SETO	P4,
	JUMPE	P2,UFDNXT	;DON'T TRY TO READ ZERO LENGTH DIR
	JUMPLE	P4,NOTO3B	;ONLY CALL CMPOK IF GOING TO COMPRESS
	PUSHJ	P,CMPOK		;OK TO COMPRESS?
	  TLOA	P4,-1		;NO
	JRST	UFDNXT		;YES, DO IT NOW
NOTO3B:	MOVE	T2,DEVDMP##(F)	;ADR OF RIB
	ADD	T2,P2		;(PROBABLE) DIRECTORY BLOCK
	HRRZ	T4,DEVLFT##(F)	;NO OF BLOCKS IN FIRST POINTER
	CAIG	P2,(T4)		;IS BLOCK TO WRITE IN 1ST PNTR?
	JRST	NOTOL6		;YES
	PUSHJ	P,UFDCRD	;NO, READ DIRECTORY RIB
	  JRST	BADUFD		;ERROR READING RIB
	SETZ	T2,		;START AT 1ST PNTR
	MOVE	T3,P2		;BLOCK WE'RE LOOKING FOR
	PUSHJ	P,SCNPT0##	;GO FIND PNTR TO BLOCK
	  STOPCD .,JOB,BNR,	;++BLOCK NOT RIB
	MOVEM	T2,DEVFLR##(F)	;SAVE LOWEST BLOCK IN DDB
	PUSHJ	P,PTRBLT##	;COPY PNTRS INTO DDB
	MOVE	T2,DEVBLK##(F)	;DIRECTORY BLOCK TO WRITE
	JRST	NOTOL6		;GO MAKE SURE IT'S NOT FULL
;STILL IN FTDUFC CONDITIONAL
;HERE AFTER COMPRESSING THE DIRECTORY
NOTOL5:	POP	P,T1		;REMOVE JUNK FROM PD LIST
	MOVE	P2,DEVREL##(F)	;RESET LENGTH OF DIRECTORY

;HERE WITH T2= BLOCK FOR DIRECTORY
NOTOL6:	MOVEM	T2,DEVBLK##(F)	;SAVE DATA BLOCK NO.
	MOVE	T1,.USMBF	;IOWD FOR DATA
	PUSHJ	P,MONRED##	;READ THE DIRECTORY BLOCK
	JUMPN	T3,UFDNXT	;LEAVE DATA BLOCK ALONE IF ERROR READING

	SKIPN	BLKSIZ##-1(T1)	;IS IT FULL?
	AOJA	T1,FNDFRE	;NO - GO FIND FIRST EMPTY SLOT
;HERE TO INITIALIZE THE NEXT BLOCK FOR THE DIRECTORY
UFDNXT:	JSP	T4,SAVUN##	;PUSH U, SET DEVUNI TO RIB UNIT
	PUSHJ	P,UFDCRD	;READ THE UFD RIB
	  JRST	BADUF0		;ERROR READING RIB - CANT ENTER FILE

;HERE WITH THE UFD RIB IN THE MONITOR BUFFER
	PUSHJ	P,UFORSS##	;GET LOC OF UFB OR SFD AT
	EXCH	P2,T2		;LOC INTO P2, T2 HAS HIGHEST DATA BLOCK
	SETZ	P1,		;ASSUME ONLY 1 POINTER
	JUMPG	P4,UFDNX3	;COMPRESS IF A WHOLE BLOCK OF ZEROES

	HRRZ	T1,.USMBF	;LOC OF MON BUF (-1)
	ADDI	T2,2		;ACCOUNT FOR 2 RIB BLOCKS
	CAMGE	T2,RIBALC##+1(T1) ;HAVE WE WRITTEN IN ALL ALLOCATED BLOCKS?
	JRST	UFDNX2		;NO. ZERO OUT NEXT BLOCK AND WRITE IN IT
;HERE IF "SOMETIMES" OR "NEVER"
	JUMPL	P4,UFDNX4	;GO IF "NEVER" COMPRESS
	MOVE	T2,P2		;HAVEN'T CALLED CMPOK YET
	PUSHJ	P,CMPOK		;OK TO COMPRESS?
	  JRST	UFDNX4		;NO
UFDNX3:	PUSHJ	P,UFDCMP	;YES. SQUEEZE ZEROS OUT OF UFD
	  JRST	NOTOL5		;DELETED SOME UFD SLOTS - TRY AGAIN
;HERE WHEN ONE MORE CLUSTER MUST BE ALLOCATED TO THE UFD
	JSP	T4,RIBUN##	;GET RIB UNIT BACK
	PUSHJ	P,UFDCRD	;READ THE RIB AGAIN
	  JRST	BADUF0		;ERROR
UFDNX4:	HRRZ	T1,.USMBF	;GET HIGHEST BLOCK WRITTEN
	MOVE	T3,RIBALC##+1(T1)
	SUBI	T3,2		;ACCOUNT FOR BOTH RIBS
	SETZ	T2,		;RIB STARTS AT BLOCK ZERO
	PUSHJ	P,SCNPT0##	;FIND HIGHEST BLOCK WRITTEN
	  STOPCD .,JOB,NLB	;++NO LAST BLOCK
	MOVE	P1,T1		;SAVE AOBJN PNTR TO LAST RTP
	HRRM	T1,DEVRET##(F)	;SAVE LOC OF LAST POINTER IN DEVRET
	MOVEI	T2,DEPALC##
	IORM	T2,DEVALC##(F)	;DON'T CHANGE ACCALC
	MOVEI	T2,1		;WANT 1 MORE BLOCK
	PUSHJ	P,CHKADD##	;CAN WE ADD TO CURRENT PNTR?
	JUMPE	T2,UFDAL2	;NOT IF T2=0
	MOVE	T1,DEVBLK##(F)	;YES. BLOCK WE WANT
	ADDI	T1,2		;1 PAST FORMER END (ALLOW FOR 2ND RIB)
	PUSHJ	P,TAKBLK##	;TRY TO GET 1 MORE CLUSTER
	  JRST	UFDAL2		;CANT ADD TO END
	PUSHJ	P,ADDPTR##	;GOT IT. UPDATE POINTER
	MOVE	T2,P2		;UFB LOC
	TRZ	T2,NMPSFU##	;T2 = L(A.T.) IF AN SFD
	PUSHJ	P,SPTRW##	;SET AOBJN WORD FOR POINTERS
	MOVE	T3,1(T1)	;GET 1ST REAL POINTER (MAY HAVE UPDATED IT)
	MOVEM	T3,CORPT1##(T2)	;SAVE IN UFB BLOCK
	SETZ	P1,		;INDICATE STILL ONLY 1 PNTR
	MOVE	T1,DEVPPN(F)	;PRJ,PRG
	TRNN	P2,NMPSFU##	;IS IT A UFD
	CAME	T1,MFDPPN##	;YES, IS IT [1,1]?
	JRST	UFDAL9		;NO
	LDB	T1,UFYFSN##	;YES, GET STR INDEX
	MOVE	T1,TABSTR##(T1)	;STR DB LOC
	MOVEM	T3,STRPT1##(T1)	;UPDATE VERSION IN SDB
	JRST	UFDAL9		;AND CONTINUE
;HERE WHEN WE HAVE TO GET A NEW POINTER FOR THE EXTRA BLOCK IN THE UFD
UFDAL2:	AOBJP	P1,UFDFUL	;POINT TO FIRST FREE SLOT
UFDAL3:	MOVEI	T2,1		;WANT 1 BLOCK
	SETZ	T1,		;ANYWHERE ON THE UNIT
	PUSHJ	P,TAKBLK##	;TRY FOR A BLOCK
	  SKIPA			;CANT GET 1 ON THIS UNIT
	JRST	UFDAL8		;GOT A BLOCK
	HRRM	P1,DEVRET##(F)	;SAVE THE POINTER SLOT IN THE DDB
	PUSHJ	P,NEXTUN##	;STEP TO NEXT UNIT WITH SPACE
	  JRST	UFDAL5		;NO UNIT HAS UNITAL GT 0
	MOVSS	(P)		;SAVE UNIT TO WRITE DATA BLOCK ON
	HRRM	U,(P)		;SAVE UNIT TO WRITE 2ND RIB ON
	AOBJN	P1,UFDAL3	;GOT ONE. STEP TO NEXT POINTER SLOT

;HERE WHEN THERE ARE NO POINTER SLOTS IN THE UFD RIB
UFDFUL:	TRO	S,IOBKTL	;LIGHT AN ERROR BIT
	POP	P,T1		;REMOVE GARBAGE FROM PD LIST
	JRST	BADUFD		;AND FINISH UP (DON'T WRITE UFD)


;HERE WHEN NO UNIT HAS UNITAL GT 0.(THERE STILL MAY BE SPACE SINCE UNITAL
; DOES NOT SHOW ALL THE FREE BLOCKS IN THE UNIT)
UFDAL5:	HRRZ	U,UNISTR(U)	;LOC OF STR DB
	HLRZ	U,STRUNI##(U)	;SET U TO 1ST UNIT IN STR
UFDAL6:	SETZ	T1,		;WANT A BLOCK ANYWHERE
	MOVEI	T2,1		;ONLY 1 BLOCK
	PUSHJ	P,TAKBLK##	;TRY TO GET ONE
	  SKIPA			;THIS UNIT REALLY FULL
	JRST	UFDAL7		;FOUND A FREE BLOCK
	HLRZ	U,UNISTR(U)	;STEP TO NEXT UNIT IN STR
	JUMPN	U,UFDAL6	;TEST IT IF NOT END
	LDB	J,PJOBN##	;JOB NUMBER
	PUSH	P,P1		;SAVE P1
	PUSHJ	P,HNGSTP##	;TYPE MESSAGE TO USER (STR FULL)
	POP	P,P1		;RESTORE P1
	MOVE	U,(P)		; AND U
	JRST	UFDAL3		;GO TRY FOR A BLOCK AGAIN

;HERE WHEN WE GOT A BLOCK ON SOME UNIT IN STR
UFDAL7:	LDB	T1,UNYLUN##	;UNIT NUMBER
	TRO	T1,RIPNUB##	;INSURE NON-0
	MOVEM	T1,(P1)		;SAVE UNIT-CHANGE PNTR IN RIB
	AOBJP	P1,UFDFUL	;STEP TO NEXT PNTR SLOT
	MOVSS	(P)		;SAVE UNIT FOR DATA BLOCK
	HRRM	U,(P)		;SAVE NEW CURRENT UNIT (FOR 2ND RIB)
;HERE WITH T2=NEW POINTER, P1=LOC IN MONITOR BUFFER
UFDAL8:	MOVEM	T2,(P1)		;SAVE POINTER IN MON BUF
	PUSHJ	P,CNVPTR##	;CONVERT TO ADR, COUNT
	  JFCL			;BAD UNIT-CHANGE
	  STOPCD .,JOB,NAP,	;++NOT ADDRESS POINTER
	MOVE	T2,P2		;L(UFB OR SFD A.T.)
	TRZ	T2,NMPSFU##	;L(A.T.) IF AN  SFD
	MOVEI	P1,UFP1PT##	;PNTR SAVED IN UFB CANT BE THE ONLY PNTR,
	ANDCAM	P1,COR1PT##(T2)	; SO INSURE 1PT IS OFF
	MOVE	T1,DEVPPN(F)	;PRJ,PRG
	TRNN	P2,NMPSFU##	;IS IT A UFD
	CAME	T1,MFDPPN##	;YES, IS IT [1,1]?
	JRST	UFDAL9		;NO
	LDB	T1,UFYFSN##	;YES, GET STR INDEX
	MOVE	T1,TABSTR##(T1)	;STR DB LOC
	ANDCAM	P1,STRUN1##(T1)	;INDICATE MORE THAN 1 PTR IN MFD
UFDAL9:	PUSHJ	P,WTUSAT	;WRITE CHANGED SAT
	LDB	T3,UNYBPC##	;DONT COUNT BLOCKS ADDED TO UFD
	TRNN	P2,NMPSFU##
	ADDM	T3,UFBTAL##(P2)	; AS PART OF THIS JOBS QUOTA
	MOVEI	T1,DEPALC##
	ANDCAM	T1,DEVALC##(F)
	MOVE	T1,.USMBF
	ADDM	T3,RIBALC##+1(T1);UPDATE NO OF BLOCKS ALLOCATED
UFDNX2:	TRNE	P2,NMPSFU##	;AN SFD?
	AOSA	T3,DIFAWU##(P2)	;YES, GET ACCWRT
	AOS	T3,UFBWRT##(P2)	;UPDATE NO OF DIRECTORY BLOCKS WRITTEN
	ANDI	T3,UFWMSK##	;JUST NO OF BLOCKS IN UFD
	MOVE	T4,T3		;NEW NUMBER OF BLOCKS
	LSH	T4,BLKLSH##	;NUMBER OF WORDS
	MOVEM	T4,RIBSIZ##+1(T1)	;STORE NEW SIZE OF UFD IN RIB
	ADDI	T3,1		;+1=LOC OF 2ND UFD RIB
	SETZ	T2,		;START AT BEGINNING
	PUSHJ	P,SPTRW##	;SINCE SCNPTR WONT FIND LAST BLOCK
	SUB	T1,[1,,0]	; FAKE IT OUT IN CASE RIB IS FULL
	PUSHJ	P,SCNPTR##	;FIND POINTER FOR THE BLOCK
				; (STORE LOC OF 2ND RIB IN DEVBLK)
	  STOPCD .,JOB,SPM,	;++SECOND POINTER MISSING
	TRNE	P2,NMPSFU##	;AN SFD?
	JRST	UFDALB		;YES, DON'T LOOK FOR A UFD A.T.
	PUSHJ	P,UFDACC	;FIND THE A.T. FOR THE UFD
	    SKIPA T3,P2		;%FOUND - UPDATE ACCWRT
	JRST	UFDALA		;%NOT THERE
	LDB	T1,UFYWRT##	;NO OF BLOCKS IN UFD
	MOVEM	T1,ACCWRT##(T2)	;STORE IN A.T.
	ANDCAM	P1,ACC1PT##(T2)	;%TURN OFF 1PT IF CAME THROUGH UFDAL8
UFDALA:	PUSHJ	P,GVCBJ##	;%
UFDALB:	PUSHJ	P,UFORSS##	;GET LOC OF THE DIRECTORY BLOCK
	TRZN	T2,NMPSFU##	;AN SFD?
	JRST	UFDALX		;NO
	MOVEI	T3,BLKSIZ##	;SET NO OF WORDS WRITTEN
	DPB	T3,ACYLBS##	;=A FULL BLOCK
UFDALX:	MOVE	T1,.USMBF	;IOWD FOR MON BUF
	MOVE	T2,DEVDMP##(F)	;ADR OF UFD RIB
	JSP	T4,RIBUN##	;SET U TO UNIT OF 1ST RIB
	PUSHJ	P,MONWRT##	;WRITE THE UPDATED RIB
	MOVE	T2,DEVBLK##(F)	;LOC OF 2ND UFD RIB
	MOVEM	T2,RIBSLF##+1(T1)
	POP	P,U		;UNIT FOR NEW UFD BLOCK
	PUSHJ	P,STORU##	;SAVE IN DDB
	PUSHJ	P,MONWRU##	;WRITE 2ND RIB (KEEP OUT OF DISK CACHE)
	TLNN	U,-1		;IS THERE A DIFFERENT UNIT FOR THE DATA?
	JRST	UFDALC		;NO
	HLRZS	U		;YES, SET U TO DATA BLOCK UNIT
	PUSHJ	P,STORU##	;AND SAVE IN DDB
UFDALC:	HRRZ	T3,DEVUFB##(F)	;LOC OF UFB
	TRNE	P2,NMPSFU##	;AN SFD?
	SKIPA	T3,DIFAWU##(P2)	;YES, GET ACCWRT
	LDB	T3,UFYWRT##	;NO OF BLOCKS IN UFD
	SETZ	T2,		;INDICATE START AT 1ST BLOCK IN FILE
	PUSHJ	P,SCNPT0##	;FIND PTR FOR LAST DATA BLOCK IN UFD
	  STOPCD .,JOB,UDM,	;++UFD DATA MISSING
	PUSHJ	P,PTRBLT##	;COPY POINTERS FROM RIB TO DDB (NEED FOR WRTUFD)
	HRRZ	T1,.USMBF	;LOC OF MON BUF (-1)
	MOVSI	T2,1(T1)	;SET TO ZERO ENTIRE BUFFER
	HRRI	T2,2(T1)
	SETZM	1(T1)
	BLT	T2,BLKSIZ##(T1)	;ENTIRE BLOCK IS 0
	AOSA	T1		;T1=LOC OF 1ST WORD IN BUF
FNDFRZ:	ADDI	T1,2		;STEP TO NEXT NAME LOC

;HERE WITH T1=START OF MON BUF,EMPTY SLOT SOMEWHERE IN BLOCK
FNDFRE:	SKIPE	(T1)		;EMPTY UFD SLOT?
	JRST	FNDFRZ		;NO. TRY NEXT
	PUSH	P,T1		;SAVE ADDR OF UFD SLOT
	PUSHJ	P,GETNMB	;FIND THE NMB
	PUSH	P,T1		;SAVE ADDR OF NMB
	PUSHJ	P,SETCFP##	;BUILD A CFP
	POP	P,T2		;ADDR OF NMB
	POP	P,T4		;ADDR OF UFD SLOT
	MOVE	T3,NMBNAM##(T2)	;GET FILENAME FROM NMB
	MOVEM	T3,UFDNAM##(T4)	;STORE IN UFD
	HRL	T1,NMBEXT##(T2)	;ADD EXT TO CFP
	MOVEM	T1,UFDEXT##(T4)	;STORE IN UFD
	PUSHJ	P,NEWCFP	;SAVE CFP IN NMB
	  JFCL
	PUSHJ	P,WRTDIR	;WRITE THE NEW DIRECTORY BLOCK
FNDFRY:	PUSHJ	P,GETNMB	;FIND THE NMB AND ACC
	LDB	T3,ACYFSN##	;GET FSN
	PUSH	P,T3		;SAVE FSN
	HLRZ	P1,T1		;SAVE NMB IN A SAFE PLACE
	HRRZ	P3,ACCPPB##(T2)	;GET ADDR OF NEW PPB
	HRRZ	P2,DEVUFB##(F)	;SAVE LOC OF UFB
	SETZ	P4,		;INDICATE NO EXTRA PPB
	TRNN	M,CHNDIR	;CHANGING DIRECTORIES?
	JRST	FNDFR1		;NO
				;YES, FALL INTO NEXT PAGE

;HERE WHEN CHANGING DIRECTORIES - DELETE THE FILE FROM THE OLD DIR
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNT OF NEW SFD
	HRRZ	T1,DEVSFD##(F)	;IF RENAME INTO A UFD
	JUMPE	T1,[SKIPE DEVSFD##(F) ; FROM AN SFD
		    AOS PPBCNT##(P3)  ; PPBCNT IS TOO LOW, SO BUMP IT
		    JRST .+2]
	SOS	NMBCNT##(T1)	;RENAME INTO SFD - ADJUST COUNT
	SKIPE	DEVSFD##(F)	;IF RENAME INTO/OUT OF AN SFD
	TLO	P3,-1		; SET A FLAG FOR FNDFR1
	HLRZS	DEVSFD##(F)	;RESTORE SFD LOC OF OLD DIRECTORY
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	HLRZ	T2,SYSPPB##	;%START OF PPB BLOCKS
	MOVE	T1,DEVPPN(F)	;%OLD PRJ,PRG
	PUSHJ	P,LSTSCN##	;%FIND THE OLD PPB BLOCK
	  JRST	FNDFRA		;%PPB WAS DELETED (SYSTEM ERROR)
	MOVE	P4,T2		;SAVE LOC OF PPB
	MOVE	T1,(P)		;%FSN

	HLRZ	T2,PPBUFB##(T2)	;%START OF UFB BLOCKS FOR FILE
	PUSHJ	P,BYTSCA##	;%FIND THE UFB
	  JRST	FNDFR0		;%FOUND UFB
;STILL IN FTDRDR CONDITIONAL
;HERE IF THE PPB AND/OR THE UFB WAS DELETED (BY TSTPPB)
FNDFRA:	PUSHJ	P,GVCBJ##	;%RELEASE CB RESOURCE
	TLZ	M,UUOMSK	;WIPE BITS OUT OF LH(UUO)
	TLO	M,UUOLUK	;MAKE BELIEVE THIS IS A LOOKUP
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  STOPCD FNDFR1,DEBUG,SLM,	;++SEARCH LIST MISSING
	MOVE	T2,T1		;SEARCH LIST INTO T2
	PUSHJ	P,FNDFIL##	;SET UP UFB BLOCK
	  JFCL			;FNDFIL GETS A RIB ERROR ON LOOKUP(WRONG RIBPPN)
	JRST	FNDFRB		;AND CONTINUE
FNDFR0:	PUSHJ	P,GVCBJ##
	PUSHJ	P,DWNAU##	;GIVE UP AU FOR OLD UFB
	MOVEM	T2,DEVUFB##(F)	;SAVE OLD UFB LOC IN DDB
	PUSHJ	P,UPAU##	;GET AU FOR NEW UFB
	PUSHJ	P,LOGTS2	;REWRITE UFD RIB WITH NEW QUOTA
	PUSHJ	P,UPAU##	;GET AU RESOURCE AGAIN

FNDFRB:	SETZ	P1,		;INDICATE NMB SHOULD BE LEFT ALONE
	PUSHJ	P,DELNAM	;DELETE THE NAME FROM THE UFD
FNDFR1:	  PUSHJ	P,DWNAU##	;NOT THERE - RELEASE AU
	HRRM	P2,DEVUFB##(F)	;RESTORE NEW UFB LOC
	CAIN	P4,(P3)		;IF RENAME IN SAME PPN
	TLZ	P3,-1		; COUNTS ARE RIGHT
	TLNE	P3,-1		;IF RENAME TO/FROM SFD ACCROSS PPNS
	SOS	PPBCNT##(P3)	; THEN PPB COUNT IS TOO HIGH
	MOVE	P3,PPBNAM##(P3)	;GET NEW PPN
	MOVEM	P3,DEVPPN(F)	;SAVE IN DDB (NEEDED BY LOGTST
				;IF RENAMING INTO NEW DIR)
	SKIPE	P4		;DECR OLD PPB USE-COUNT
	SOS	PPBCNT##(P4)	; SO TSTPPB CAN DO ITS THING
	HLRZ	T1,DEVEXT(F)	;EXTENSION OF FILE
	CAIE	T1,(SIXBIT .UFD.)	;UFD?
	JRST	FNDFR3		;NO
	MOVE	T1,DEVFIL(F)	;YES. PRJ,PRG
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	HLRZ	T2,SYSPPB##	;%T1=START OF PPB'S
	PUSHJ	P,LSTSCN##	;%FIND PPB FOR FILE
	  JRST	FNDFR2		;%NOT THERE
	MOVE	T1,(P)		;%FOUND. T1=FSN

	MOVE	T4,T2		;%SAVE PPB LOC
	PUSHJ	P,FSNPS2##	;%POSITION A BIT FOR FSN
	ORM	T2,PPBKNO##(T4)	;%INDICATE THAT THERE IS A UFD
	ORM	T2,PPBYES##(T4)	;% FOR THIS STR
FNDFR2:	PUSHJ	P,GVCBJ##	;%GIVE UP CB
FNDFR3:	POP	P,T1		;REMOVE FSN FROM PD LIST
	LDB	T1,DEYFSN##	;FSN OF FILE BEING SUPERSEDED
	JUMPE	T1,CLRSTS	;NONE IF 0

;HERE IF A FILE IN 1 STR IS SUPERSEDING A FILE IN ANOTHER STR
;(NO ROOM TO WRITE NEW FILE IN ORIGINAL STR)
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	LDB	T3,ACYFSN##	;FSN THEN NEW FILE EXISTS OR
	CAMN	T3,T1		;IF THE SAME,
	JRST	CLRSTS		; THE SUPERCEEDED FILE GOT DELETED
	HRRZ	T2,ACCPPB##(T2)	;LOC OF PPB
	HLRZ	T2,PPBUFB##(T2)	;1ST UFB LOC
	PUSHJ	P,BYTSCA##	;FIND UFB FOR FORMER FILE
	  SKIPA
	JRST	CLRSTS		;NOT THERE
	HRRM	T2,DEVUFB##(F)	;SAVE LOC OF UFB FOR UFDSRC
	PUSHJ	P,UPAU##	;GET AU
	LDB	T1,UFYFSN##	;FSN
	MOVE	U,TABSTR##(T1)	;STR DATA BLOCK LOC
	HLRZ	U,STRUNI##(U)	;SET U TO ANY UNIT IN STR
	HRLM	U,DEVUNI##(F)	;SAVE IN DDB (FOR DELNAM)
	HLRZS	P1		;LOC OF NMB
	PUSHJ	P,DELNAM	;REMOVE NAME FROM UFD
	  JRST	CLRST2		;NOT THERE - SOMEONE ALREADY DELETED IT
	PUSH	P,P1		;SAVE LOC OF NMB
	HRRZ	T2,DEVUFB##(F)	;LOC OF UFB
	JRST	ALLP10		;GO DELETE OLD FILE

;HERE WHEN WE CANT ENTER THE FILE IN THE UFD
BADUF0:	POP	P,U		;REMOVE U FROM PDLIST
BADUFD:	TLNE	S,IOSAU		;HAVE AU RESOURCE?
	PUSHJ	P,DWNAU##	;NOT ANY MORE
	PUSHJ	P,REDRIB##	;READ THE PRIME-RIB AGAIN
	  JRST	CLRSTS		;NOW THAT'S GONE BAD?
	PUSHJ	P,SPTRW##	;GET PNTR TO RET PNTRS
	MOVE	P1,T1		;INTO P1 FOR DELRIB
	PUSHJ	P,DELRIB	;
	  STOPCD	.+1,DEBUG,DDS,	;++ DELRIB DIDNT SKIP
	JRST	CLRSTS
CLRST2:	PUSHJ	P,DWNAU##	;GIVE UP AU RESOURCE
;HERE WHEN THE UFD IS WRITTEN
CLRSTS:	SETZ	P4,		;PREPARE FOR ADDM P4,ACCCNT
CLRSTX:	TLNE	S,IOSAU		;STILL HAVE AU?
	PUSHJ	P,DWNAU##	;YES, GIVE IT UP
	MOVE	T1,DEVUFB##(F)
	MOVSI	T2,UFPCHG##	;SOME FILE HAS BEEN WRITTEN OR RENAMED
	IORM	T2,UFBCHG##(T1)
	TLNE	M,UUOREN	;IF RENAME
	PUSHJ	P,CLSNM		; GET DDB RIGHT FOR WATCH FILE


	PUSHJ	P,GETCB##	;DID FILOP TELL US TO SLIP?
	PUSHJ	P,NWCFP0
	  JRST	CLRSTB		;NO
;HERE IF FILOP IS SLIPPING THE FILE INTO UPDATE MODE.
;MOST OF THE WORK WAS ALREADY DONE BY NEWCFP, WE MERELY
;NEED TO CLEAN UP (I.E. DO THE STUFF THAT COULDN'T
;BE DONE WHILE THE DIRECTORY POINTERS WERE IN CORE)
	HRRZ	T3,DEVACC##(F)	;ADDR OF ACC
	ADDM	P4,ACCCNT##(T3)	;DECR IF CLSDEL DID INCR
	PUSHJ	P,AT2DDB##	;SET UP POINTERS FROM ACC
	  JFCL
	TLZ	F,ICLOSB+OCLOSB	;UNDO CLOSE
	TLO	F,ENTRB+LOOKB
	HRRZ	T3,DEVCPY##(F)	;ALREADY GOT COPY?
	JUMPN	T3,CLRSTY
	PUSHJ	P,GETCPY	;NO, COPY THE POINTERS
	CAIA
CLRSTY:	PUSHJ	P,CPYPTR	;YES, UPDATE THE COPY
	HRRZ	T2,DEVACC##(F)
	MOVE	W,ACCWRT##(T2)	;SIZE OF FILE
	ADDI	W,1		;EOF
	PUSHJ	P,USETO0##	;UPDATE POINTERS
	JRST	STOIOS##	;DONE
;ROUTINE TO STORE THE CFP AND SLIP THE FILE INTO UPDATE MODE.
;IF, INDEED, THE FILE MUST BE SLIPPED INTO UPDATE MODE, THIS MUST
;BE DONE BEFORE THE DIRECTORY IS WRITTEN (ELSE SOME OTHER JOB CAN
;START A LOOKUP AND BUILD A DUPLICATE ACC).
;WE MUST CLEAR ACPCRE+ACPSUP SO THAT HE WILL SEE OUR OWN ACC
;AND USE IT. ORDINARILY A DUPLICATE ACC WOULD NOT BE
;A PROBLEM, WE'D DETECT HIS ACC AND DELETE OUR COPY.
;BUT DURING A FILOP SLIP, WE CANNOT DELETE OUR ACC AND
;THEREFORE CANNOT ALLOW HIM TO BUILD A DUPLICATE.
;T1 PASSES THE CFP
;T2 PASSES ADDR OF NMB
;CPOPJ IF NO SLIP, CPOPJ1 IF SLIP
NEWCFP:	PUSHJ	P,GETCB##	;GET THE CB
	PUSHJ	P,SAVCFP	;%STORE CFP IN NMB
;HERE IF NMB DOESN'T NEED TO BE UPDATED
NWCFP0:	MOVE	T3,DEVJOB(F)	;%DID FILOP TELL US TO SLIP?
	TLNE	T3,DEPFFA
	PUSHJ	P,TSTSFD
	  PJRST	GVCBJ##		;%NO
	JUMPL	M,GVCBJ##	;%NO
	HRRZ	T2,DEVACC##(F)
	JUMPE	T2,GVCBJ##	;%NO
	LDB	T1,ACYSTS##	;%ALREADY IN UPDATE MODE?
	CAIN	T1,ACRUPD##
	JRST	NWCFP1		;%YES
	MOVEI	T1,ACRUPD##	;%NO, SET UPDATE NOW
	DPB	T1,ACYSTS##
	MOVEI	T1,1		;%FIRST WRITTER
	DPB	T1,ACZWCT##
	MOVEI	T1,ACPSMU
	TLNE	T3,DEPSIM	;%SIMULTANEOUS UPDATE?
	IORM	T1,ACCSTS##(T2)	;%YES, LIGHT BIT IN ACC

NWCFP1:	TLOE	S,IOSRDC	;%INPUT CLOSE DONE?
	PJRST	GVCBJ1##	;%NO
	MOVEI	T1,ACPCNT##	;%YES, UNDO INPUT CLOSE
	ADDM	T1,ACCCNT##(T2)
	PUSHJ	P,INCUC
	MOVEM	S,DEVIOS(F)
	PJRST	GVCBJ1##
;HERE WITH P4=0 OR -ACPCNT (CLSDL1)
CLRSTB:	CBDBUG	(N,Y);
	SKIPN	DEVSPN##(F)
	SKIPGE	DEVSPL(F)	;SPOOLED FILE?
	PUSHJ	P,[PUSHJ P,CLSNAM ;YES, TELL QUASAR
		   JRST QSRSPL##]
	SETZM	DEVSPN##(F)

IFN FTFDAE,<
	MOVSI	T1,DEPFDA##	;CALL THE FILE DAEMON ON CLOSE BIT
	TDNN	T1,DEVFDA##(F)	;SHOULD THE FILE DAEMON BE CALLED?
	JRST	CLRST0		;NO
	ANDCAM	T1,DEVFDA##(F)	;YES, CLEAR THE BIT
	MOVEI	T1,.FDCLO	;INDICATE OUTPUT CLOSE
	PUSHJ	P,SNDFMG##	;TELL THE FILE DAEMON
	  JFCL			;DON'T CARE
	PUSHJ	P,GTMNBF##
CLRST0:>
	PUSHJ	P,DDBZR		;CLEAR OUT PNTRS IN CASE OF NEW ENTER
	MOVEI	T1,DEPWRT##	;CLEAR THE DDB - IS - WRITING BIT
	ANDCAM	T1,DEVWRT##(F)
	TLZ	F,ENTRB+RENMB+OUTPB	;ZERO RENAME, OUTPUT AND ENTER BITS
	HRRZ	T1,DEVACC##(F)	;LOCATION OF ACCESS TABLE
	JUMPE	T1,[SETZM DEVUNI##(F)
		    PUSHJ P,LOGTSP	;DO UFD ACCOUNTING
		    SETO T1,
		    JRST CLRSTC]
	MOVE	T2,ACCSTS##(T1)	;FILE STATUS
	TRNE	T2,ACPUPD	;UPDATE MODE ?
	TLNE	F,ICLOSB	;YES, IMPUT SIDE STILL OPEN ?
	SETZM	DEVUNI##(F)	;NO, CLEAR DEVUNI
	PUSHJ	P,LOGTST	;TURN ON RIPLOG IN UFD IF PPB NOT LOGGED IN
	PUSHJ	P,DDBZR		;LOGTST MIGHT SET PNTRS UP AGAIN
	PUSHJ	P,GETNMB	;GET THE NMB
	MOVE	T3,ACCSTS##(T2)	;DON'T CALL FIXPTH IF RENAME
	TRNN	T3,ACPREN	;IT WAS ALREADY DONE BY FNDFIL
	PUSHJ	P,FIXPTH	;BUMP COUNT IF IN SOMEBODY'S PATH
	EXCH	T1,T2		;T1=LOC OF AT, T2=NMB
	MOVE	P2,T2		;SET P2 TO DECREMENT COUNTS
	HRL	P2,ACCPPB##(T1)
	LDB	J,PJOBN##	;JOB NUMBER
	TLNE	F,LOOKB		;CLOSIN WILL GET IT IF INPUT SIDE OPEN
	JRST	CLRS0A
	PUSHJ	P,SFDDEC	;DEC PPBCNT,NMBCNT FOR SFD
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNTS FOR SFD
CLRS0A:	HRRZ	T1,DEVACC##(F)	;RESET T1 TO LOC OF A.T.
	PUSHJ	P,GETCB##	;%GET CB RESOURCE
	MOVE	T3,ACCSTS##(T1)	;%FILE STATUS
	TRNE	T3,ACPUPD	;%UPDATE?
	TLNE	F,ICLOSB	;%YES, INPUT SIDE CLOSED?
	PUSHJ	P,UACLR		;%YES, TAKE A.T. OUT OF DDB, CLEAR DEVUFB
	MOVSI	T2,DEPSIM	;%CLEAR SIM. UPDATE BIT FROM DDB
	ANDCAM	T2,DEVJOB(F)	;%
	LDB	T4,ACYWCT##	;%DECREMENT NUMBER OF WRITERS
	TRNE	T3,ACPUPD	;% IF AN UPDATE FILE
	SUBI	T4,1		;%(UP EVEN IF NOT SIM-UPD)
	DPB	T4,ACYWCT##
	MOVEI	T2,ACPCRE!ACPREN!ACPSUP+ACPPAL##
	SKIPN	T4		;%SIM UPDATE?
	TRO	T2,ACPUPD!ACPSMU	;%DONT CLEAR ACPUPD IF STILL UPDATERS

	ADDM	P4,ACCCNT##(T1)	;DECR READ-COUNT IF IT WAS COUNTED UP
				; AT CLSDL1 TO PREVENT A.T. GOING DORMANT
	ANDCAB	T2,ACCSTS##(T1)	;%CLEAR THE STATE CODE
	PUSHJ	P,DECUC		;%DECR USE-COUNTS OF NMB, PPB
	MOVEI	T3,ACPPAL##
	MOVE	T4,DEVPAL##(F)	;%IF PRE-ALLOCATED,
	TRZE	T4,DEPPAL##
	IORM	T3,ACCPAL##(T1)	;% LIGHT BIT IN A/T/
	MOVEM	T4,DEVPAL##(F)	;% AND CLEAR THE DDB BIT
CLRSTC:	HRRZ	T4,DEVCPY##(F)	;% IS THERE AN IN-CORE COPY?
	JUMPE	T4,CLRSTG
	MOVEI	T3,SYSPTR##-PTRSYS## ;% YES, START AT BEGINNING
	PUSH	P,T1
	DDBSRL			;% INTERLOCK IT
CLRSTD:	HLRZ	T1,PTRSYS##(T3)	;% STEP TO NEXT
	CAIN	T1,(T4)		;% IS IT THE ONE WE WANT?
	JRST	CLRSTE		;% YES
	SKIPE	T3,T1		;% NO, STEP TO NEXT
	JRST	CLRSTD
	JRST	CLRSTF		;% NONE. (SYSTEM ERROR)
CLRSTE:	MOVE	T1,PTRSYS##(T4)	;% GET LINK OF THIS ONE
	HLLM	T1,PTRSYS##(T3)	;% STORE IN PREVIOUS LINK
CLRSTF:	DDBSRU			;% NO NEED FOR INTERLOCK NOW
	HLLZS	DEVCPY##(F)	;% NO IN-CORE COPY NOW
	MOVE	T2,T4		;% ADDRESS
	MOVEI	T1,PTRCOR##	;% WORDS USED
	PUSHJ	P,GIVWDS##	;% GIVE UP THE SPACE
	POP	P,T1		;% RESTORE T1
	MOVE	T2,ACCSTS##(T1)	;% AND T2
CLRSTG:	JUMPL	T1,CLRST1	;GO IF NO ACCESS TABLE
	TRNE	T2,ACMCNT!ACPUPD ;%ANYONE READING FILE?
	JRST	CLRST4		;%YES, RETURN
	TRNE	T2,ACPDEL##	;%FILE MARKED FOR DELETION (RACE CONDITION-
				; CAUSED BY THIS JOB BEING HELD UP IN OUTPUT CLOSE
				; AND ANOTHER JOB ZOOMING THROUGH DELETE)
	JRST	CLRST3		;%YES, GO DELETE FILE NOW
	SKIPE	T2,ACCDOR##(T1)	;%NO,  A.T. DORMANT?
	STOPCD	GVCBJ##,DEBUG,FAD,	;%++FILE ALREADY DORMANT
	PUSHJ	P,SPARKS	;%DID ANOTHER A.T. SNEAK IN?
	  PUSHJ	P,ATSDRA##	;%NO, MAKE OUR A.T. DORMANT
CLRST1:	PJRST	TSTPPB		;TEST IF PPB LOGGED IN, EXIT

;HERE ON A WIERD TIMING PROBLEM
CLRST3:	HRRM	T1,DEVACC##(F)	;CAUSE CLOSR2 CALLS GETNMB
	PUSHJ	P,GVCBJ##
	PUSHJ	P,STORU##
	HRLM	U,DEVUNI##(F)	;SAVE U IN DDB
	SETZ	P2,		;DONT DECR USE-COUNTS AGAIN
	JRST	CLOSR2		;GO BACK TO INPUT CLOSE AND DELETE FILE

;HERE IF OTHER READERS OF THE FILE
CLRST4:	PUSHJ	P,GVCBJ##
	HRRZ	T3,DEVACC##(F)	;AT
	JUMPE	T3,CPOPJ##	;IF 0 THEN WE'RE NOT UPDATING
				;UPDATER - RESET DDB POINTERS
	PUSHJ	P,AT2DDB##	; (ELSE NEXT INPUT WILL READ UFD)
	  JFCL			;AT IS MESSED UP - HE'LL FINE OUT SOON
	POPJ	P,

;THIS ROUTINE TESTS FOR AN OBSCURE RACE.
;IF WE JUST CREATED A NEW VERSION OF THE FILE,
;THEN IT IS POSSIBLE THAT A LOOKUP SNUCK IN
;AFTER WE WROTE THE UFD. THE JOB DOING THE LOOKUP
;IGNORED OUR A.T. BECAUSE IT WAS MARKED AS EITHER
;ACPCRE OR ACPSUP. HE NOW HAS AN A.T. FOR THE
;NEW VERSION OF THE FILE. HIS A.T. IS
;NOW AN EXACT DUPLICATE OF OUR OWN. WE CANNOT ALLOW
;DUPLICATE A.T.'S SO WE MUST DESTROY ONE OF THE TWO.
;WE CHOOSE TO DESTROY OUR OWN A.T. AS IT IS KNOWN
;TO BE DORMANT.

;CALL WITH T1=A.T.
;CALL WITH CB
;NORMALLY EXITS CPOPJ (STILL HAVING CB)
;EXITS CPOPJ1 IF THERE WAS A DUPLICATE A.T. (IT HAS
;BEEN DESTROYED AND CB WAS GIVEN AWAY).
SPARKS:	PUSH	P,T1		;%SAVE ADDR OF OUR A.T.
	PUSHJ	P,GTNM1		;%GET ADDR OF NMB
	MOVEI	T2,DIFNAL##(T1)	;%ADDR OF NMBACC
	MOVE	T1,(P)		;%GET FSN OF OUR A.T.
	LDB	T1,ACZFSN##
SPARK1:	PUSHJ	P,BYTSC1##	;%FIND ANOTHER A.T.
	  SKIPA	T3,ACCPT1##(T2)	;%GET ITS RTP
	JRST	TPOPJ##		;%NO MORE A.T.'S
	MOVE	T4,(P)		;%ADDR OF OUR A.T.
	CAME	T2,T4		;%SKIP OVER OUR OWN
	CAME	T3,ACCPT1##(T4)	;%SAME RTP?
	JRST	SPARK1		;%NO, KEEP LOOKING
	POP	P,T2		;%YES, GET BACK OUR A.T.
	PUSHJ	P,ATRMVX##	;%DESTROY OUR A.T.
	JRST	CPOPJ1##

;SUBROUTINE TO TEST IF USER IS LOGGED IN (ON A CLOSE)
;IF NOT, RECOMPUTE RIBUSD AND REWRITE THE RIB
;ENTER AT LOGTS1 IF KNOWN NOT TO BE LOGGED IN
;ENTER AT LOGTS2 IF ALREADY HAVE AU RESOURCE
;ENTER AT LOGTSP IF A.T. NOT AVAILABLE
LOGTSP:	MOVE	T1,DEVPPN(F)	;GET THE FILE'S PPN
	HLRZ	T2,SYSPPB##	;GET LOC OF 1ST PPB
	PUSHJ	P,LSTSCN##	;SEARCH FOR THE PPB
	  POPJ	P,		;NONE.  JUST RETURN
	MOVE	T1,T2		;COPY THE PPB
	JRST	LOGTS3		;PICK UP WITH PPB BELOW
LOGTST:	MOVE	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCPPB##(T1)	;LOC OF PPB
LOGTS3:	MOVE	T1,PPBNLG##(T1)	;LOGGED-IN WORD
	TLNE	S,IOSWLK	;DON'T WRITE IF STR IS WRITE-LOCKED
	POPJ	P,		;YES. RETURN
	PUSHJ	P,SAVE2##	;S.L. STUFF WIPES P2
	TRNN	T1,PPPNLG##	;IS USER LOGGED IN ?
	JRST	LOGTS1		;NO, WRITE RIB
	SKIPN	T1,DEVUFB##(F)	;YES. GET UFB
	JRST	LOGTS1
	MOVE	T1,UFBLOG##(T1)
	TLNE	T1,UFPLOG##	;IS RIPLOG ON IN UFD?
	POPJ	P,		;YES, RETURN
LOGTS1:	PUSHJ	P,UPAU##	;NO. GET AU RESOURCE
	CAIA
LOGTS2:	PUSHJ	P,SAVE1##
	HRRZ	P1,DEVUFB##(F)	;LOC OF UFB
	JUMPE	P1,DWNAU##
	SKIPN	T2,UFBPT1##(P1)	;RETRIEVAL PNTR FOR UFD
	PJRST	DWNAU##		;UFD WAS DELETED - RETURN
	MOVE	T1,UFBUN1##(P1)	;UNIT WORD
	PUSHJ	P,SETFS0##	;SET UP U, BLOCK IN T2
	  PJRST	DWNAU##		;ERROR READING RIB - RETURN
	PUSHJ	P,UFDRED##	;READ THE UFD RIB
	  PJRST	DWNAU##		;ERROR READING RIB - RETURN
	MOVEI	T3,RIPNDL##	;GET NO DELETE BIT
	TDNE	T3,RIBSTS##+1(T1) ;IS IT SET FOR THIS UFD?
	PJRST	DWNAU##		;YES, DON'T UPDATE
	MOVE	T3,UFBCHG##(P1)	;HAS ANY FILE BEEN CHANGED?
	TLZN	T3,UFPCHG##
	TDZA	T2,T2		;NO, DON'T SET BIT IN RIB
	MOVSI	T2,RIPCHG##	;YES, SET BIT IN RIB
	MOVEM	T3,UFBCHG##(P1)	;CLEAR BIT IN UFB
	TDNE	T2,RIBSTS##+1(T1) ;BIT ALREADY SET IN RIB?
	SETZ	T2,		;YES, DON'T REWRITE RIB
	IORM	T2,RIBSTS##+1(T1) ;LIGHT RIBSTS BIT IF CHANGE
	MOVE	T3,RIBQTF##+1(T1) ;COMPUTE NUMBER OF BLOCKS USED
	SUB	T3,UFBTAL##(P1)
	CAME	T3,RIBUSD##+1(T1) ;SAME AS BEFORE?
	SETO	T2,		;NO, MUST REWRITE RIB
	MOVEM	T3,RIBUSD##+1(T1) ;STORE NEW VALUE IN RIB
	JUMPE	T2,DWNAU##	;DON'T REWRITE IF DIDN'T ALTER RIB
	MOVE	T2,RIBSLF##+1(T1) ;BLOCK NUMBER OF RIB
	PUSHJ	P,MONWRT##	;REWRITE 1ST RIB OF UFD
	PJRST	DWNAU##		;RETURN AU RESOURCE AND EXIT
;SUBROUTINE CALLED ON OUTPUT CLOSE OF A FILE
;CLEARS DEVACC, DEVUFB UNLESS FLOW WILL GET GO CLRST3
;ENTER WITH T3=ACCSTS. CALL UACLX TO CLEAR DEVACC, DEVUFB
;PRESERVES ALL ACS
UACLR:	TRNN	T3,ACMCNT	;%ANY READERS?
	TRNN	T3,ACPDEL##	;%YES, MARKED FOR DELETION
	CAIA			;%READERS OR NOT TO DELETE - OK
	POPJ	P,		;%GOING TO DELETE NOW - DON'T CLEAR DDB
				;% (CALL INPUT CLOSE TO DELETE FILE NOW)
UACLX:	HLLZS	DEVACC##(F)	;%CLEAR DEVACC, DEVUFB
	SETZM	DEVUFB##(F)	;%
	POPJ	P,		;%

;SUBROUTINE TO READ THE UFD RIB DURING CLOSE
;ENTER WITH U SET UP, EXIT CPOPJ IF ERROR READING RIB
;EXIT CPOPJ1 NORMALLY, WITH RIB IN MONITOR BUFFER
UFDCRD:	PUSH	P,DEVPPN(F)	;SAVE OLD PRJ-PRG
	MOVE	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCPPB##(T1)	;LOC OF (NEW) PPB
	MOVE	T1,PPBNAM##(T1)	;(NEW)PRJ-PRG
	MOVEM	T1,DEVPPN(F)	;SAVE IN DEVPPN SO UFDRED WONT GIVE AN ERROR
				;RETURN IF RENAMING INTO ANOTHER DIRECTORY
	MOVE	T2,DEVDMP##(F)	;BLOCK NUMBER OF RIB
	PUSHJ	P,UFDRED##	;GO READ THE RIB
	  JRST	TPOPJ##		;BAD UFD RIB, ERROR RETURN
	POP	P,DEVPPN(F)	;RESTORE OLD PRJ-PRG
	JRST	CPOPJ1##	;AND RETURN

;SUBROUTINE TO FIND THE LAST UNIT-CHANGE POINTER IN THE RIB
;ENTER WITH RIB IN MON BUF
;EXIT U=RH(DEVUNI)=LAST UNIT POINTED TO BY RIB
LSTUNI:	PUSHJ	P,SPTRW##	;SET AOBJN WORD FOR POINTERS
LSTUN2:	SKIPN	T3,(T1)		;GET A POINTER
	JRST	LSTUN3		;THROUGH
	TLNN	T3,-1		;UNIT CHANGE?
	MOVE	T2,T3		;YES, SAVE IN T2
	AOBJN	T1,LSTUN2	;TEST NEXT POINTER
LSTUN3:	PUSHJ	P,CNVPTR##	;CONVERT POINTER TO UNIT
	  CAIA			;BAD UNIT-CHANGE PNTR
	  POPJ	P,		;AND RETURN
	STOPCD	CPOPJ##,DEBUG,NUP,	;++NO UNIT CHANGE POINTER

;SUBROUTINE TO LIGHT UNIT-BIT IN RIBUNI
;ENTER T1=C(.UPMBF), U=UNIT
;LIGHTS RIGHT BIT IN LH(RIBUNI) FOR THIS UNIT
;EXIT T1=C(.UPMBF)
ORINUN:	MOVSI	T2,1		;BIT FOR DRIVE 0
	LSH	T2,@UDBPDN(U)	;POSITION BIT FOR PHYSICAL DRIVE NUMBER
	IORM	T2,RIBUNI##+1(T1)	;STORE IN RIB
	POPJ	P,		;AND RETURN

;SUBROUTINE TO GET LAST RIB POINTER
;ENTER WITH RIB IN MONITOR BUFFER
;EXIT WITH T2 = LAST POINTER
;PRESERVES T3
GTLPT::	PUSHJ	P,SPTRW##	;GET AOBJN WORD FOR PNTRS
	HLRE	T2,T1		;NUMBER OF PNTRS
	SUB	T1,T2		;POINT AT END +1
	MOVE	T2,-1(T1)	;GET LAST POINTER
	POPJ	P,		;AND RETURN
;SUBROUTINE TO UPDATE RIBNAM,RIBEXT, RIBPPN IN THE CASE OF A CLOSE FOR RENAME
;T1=IOWD FOR MONITOR BUFFER, T1,T2 RESPECTED.
NAMNW:	PUSH	P,T2		;SAVE T2
	HRRZ	T4,DEVACC##(F)	;GET ADDRESS OF A.T.
	HLRZ	T4,ACCNMB##(T4)	;STEP TO NEXT IN RING
	TRZN	T4,DIFNAL##	;NAME BLOCK?
	JRST	.-2		;NO, LOOK AT NEXT
	MOVE	T2,NMBNAM##(T4)	;GET NEW NAME
	MOVEM	T2,RIBNAM##+1(T1) ;TO RIB
	MOVE	T2,NMBEXT##(T4)	;NEW EXTENSION
	HRLM	T2,RIBEXT##+1(T1) ;TO RIB
	HRRZ	T2,DEVACC##(F)	;GET A.T. AGAIN
	HRRZ	T4,ACCPPB##(T2)	;LOCATION OF PPB
	MOVE	T3,PPBNAM##(T4)	;NEW PPN
	MOVEM	T3,RIBPPN##+1(T1)	;TO RIB
	PUSH	P,T1
	LDB	T1,ACYFSN##	;STR NUMBER
	HLRZ	T2,PPBUFB##(T4)	;START OF UFB CHAIN
	PUSHJ	P,BYTSCN##	;FIND UFB (ANOTHER JOB MIGHT
	  CAIA			; HAVE RENAMED ACCROSS DIRECTORIES)
	STOPCD	.+1,DEBUG,UNF,	;++ UFB NOT FOUND
	HRRM	T2,DEVUFB##(F)	;SAVE (NEW) DEVUFB
	POP	P,T1
	PUSHJ	P,SETUFR	;SET UP RIBUFD
	PJRST	T2POPJ##	;RESTORE T2 AND RETURN
;SUBROUTINE TO COMPRESS THE UFD INTO AS FEW BLOCKS AS POSSIBLE
;ENTER WITH 1 MONITOR BUFFER, UFD RIB IN IT

; SETS DEVREL TO NEW SIZE OF THE FILE
;EXIT CPOPJ IF NO MORE BLOCKS HAVE TO BE ALLOCATED, T2=BLOCK TO WRITE
;EXIT CPOPJ1 IF MORE BLOCKS MUST BE ALLOCATED
UFDCMP:	PUSHJ	P,SAVE4##	;SAVE P1-P4
	PUSHJ	P,CPYFST##	;COPY 1ST VALUES FROM UFD RIB TO DDB
	  POPJ	P,		;RIB FOULED UP BADLY - RETURN
	SOS	T1,DEVBLK##(F)	;POINT DEVBLK TO RIB
	MOVEM	T1,DEVDMP##(F)	;SAVE RIB BLOCK NO IN DDB
	SETZB	P4,DEVREL##(F)	;DEVREL WILL BE BUMPED IN DIRRED
	MOVE	P3,F		;SAVE LOC OF DDB
	PUSHJ	P,FAKDDB	;GET AN EXTRA DDB
	  JRST	UFDCMD		;NO ROOM
	EXCH	P3,F		;RESTORE F, SAVE NEW DDB LOC
	MOVE	S,DEVIOS(F)	;RESTORE S
	MOVEM	U,DEVUNI##(P3)	;SAVE U IN CASE NO HOLES
	MOVE	T1,.USMBF	;LOC OF MON-BUF
	MOVE	T2,RIBSTS##+1(T1) ;GET RIB STATUS BITS
	TROE	T2,RIPCMP##	;LIGHT UFD-BEING-COMPRESSED BIT
	TRO	T2,RIPCBS##	;PLUS RIPCBS IF RIPCMP WAS ALREADY ON
	MOVEM	T2,RIBSTS##+1(T1) ;REPLACE STATUS BITS
	MOVE	T2,RIBSLF##+1(T1); (UFD CAN GET ZAPPED IF SYSTEM CRASHES
	PUSHJ	P,MONWRT##	; WHILE A UFD IS BEING COMPRESSED)
	MOVE	P1,.USMBF	;SAVE ADDR OF MON BUF
	SETZM	.USMBF		;SET TO GET ANOTHER BUFFER
	PUSHJ	P,GTMNBF##	;GET SECOND MON-BUF
	MOVE	P2,.USMBF	;LOC OF MON BUF INTO P2
;STILL IN FTDUFC CONDITIONAL
;HERE WITH P1,P2 = LOC OF MON BUFS, P3=L(EXTRA DDB)
UFDCM4:	PUSHJ	P,DIRRED##	;READ A UFD BLOCK
	  JRST	[HRRM P2,DEVDMP(P3)	;NO HOLES AT ALL
		 MOVEM P1,.USMBF	;FIX THINGS UP
		 JRST UFDCMB]		;AND EXIT
	TRNE	S,IOIMPM!IODERR!IODTER!IOBKTL	;ANY READ ERRORS?
	JRST	[HRRM P2,DEVDMP(P3)	;YES, FIX THINGS UP
		 MOVEM P1,.USMBF	;AND DON'T COMPRESS
		 JRST UFDCMC]
	SKIPE	BLKSIZ##-2(P2)	;IS BLOCK FULL?
	AOJA	P4,UFDCM4	;YES - READ NEXT BLOCK

;HERE WHEN A UFD BLOCK WITH AT LEAST 1 HOLE HAS BEEN FOUND
	MOVEI	T1,DEVMOD(P3)	;LOC OF EXTRA DDB
	HRLI	T1,DEVMOD(F)	;SET TO BLT CURRENT STATE OF DDB
	BLT	T1,DEVRBN##(P3)	;EXTRA DDB POINTS TO 1ST UFD BLOCK TO WRITE
	HRRZ	T1,P3		;NOW ADJUST DEVRET IN COPIED UFD
	SUBI	T1,(F)		;RELATIVE DISTANCE
	ADDM	T1,DEVRET##(P3)	;NEW DEVRET POINTS TO RIGHT PNTR
	SOS	DEVBLK##(P3)	;RESET LOCS IN THE DDB WHICH WE WILL WRITE FROM
	SOS	DEVREL##(P3)	; (DIRRED INCREMENTS BEFORE I/O)
	AOS	DEVLFT##(P3)
	MOVEM	P1,.USMBF	;BUFFER TO READ INTO
	MOVE	P4,P2		;PNTR TO MON BUF WITH UFD DATA
	AOSA	P4		;GO FIND 1ST EMPTY SLOT
	ADD	P4,[XWD 2,2]
	SKIPE	(P4)		;THIS SLOT FREE?
	JRST	.-2		;NO, TRY NEXT
	MOVEM	S,DEVIOS(P3)	;SAVE S (IOSFIR) IN WRITING-DDB
	PUSH	P,DEVPPN(F)	;IF DIRRED HAS TO READ THE UFD RIB
	MOVE	T1,DEVACC##(F)	; AND WE WERE CALLED VIA
	MOVE	T1,ACCPPB##(T1)	; RENAME ACROSS DIRECTORIES
	MOVE	T1,PPBNAM##(T1)	; UFDRED WILL CHECK DEVPPN
	MOVEM	T1,DEVPPN(F)	;SO MAKE IT RIGHT



UFDCM5:	PUSHJ	P,DIRRED##	;READ INTO P1-BUFFER
	  JRST	UFDCM9		;EOF - FINISH UP
	MOVE	P1,.USMBF	;POINTER TO THIS UFD BLOCK DATA
UFDCM6:	SKIPN	T1,1(P1)	;PICK UP UFD ENTRY
	JRST	UFDCM5		;DONE - READ NEXT UFD BLOCK
	MOVEM	T1,(P4)		;SAVE IN OUTPUT-BUFFER
	MOVE	T1,2(P1)	;GET EXTENSION, CFP
	MOVEM	T1,1(P4)	;SAVE IN OUT-BUF
	AOBJN	P4,.+1		;COUNT OUTPUT WORDS
	AOBJP	P4,UFDCM8	;GO IF OUT-BUFFER IS FULL
UFDCM7:	AOBJN	P1,.+1		;COUNT INPUT WORDS
	AOBJN	P1,UFDCM6	;GO IF MORE IN THIS BLOCK
	JRST	UFDCM5		;BLOCK THROUGH - READ NEXT
;STILL IN FTDUFC CONDITIONAL
;HERE WITH P2-BUFFER FULL, WRITE IT
UFDCM8:	EXCH	P2,.USMBF	;WRITE THE P2-BUFFER
	PUSHJ	P,DIRWRT	;WRITE THE UFD BLOCK
	EXCH	P2,.USMBF
	MOVE	P4,P2		;POINTER TO THE BUFFER
	AOJA	P4,UFDCM7	;GO FILL IT AGAIN

;HERE WHEN THE UFD HAS BEEN COMPLETELY READ
UFDCM9:	POP	P,DEVPPN(F)
	HLRE	P1,P4		;SAVE NO OF WDS IN LAST BUFFER
	SETZM	(P4)		;ZERO THE REST OF THE UFD BLOCK
	AOBJN	P4,.-1
	HLLOM	DEVLFT##(P3)	;MAKE SURE DIRWRT DOESNT CHANGE DDB DATA
				; (LAST BLOCK OF A GROUP)
	EXCH	P2,.USMBF	;WRITE P2-BUFFER
	PUSHJ	P,DIRWRT	;WRITE THE LAST UFD DATA BLOCK
	EXCH	P2,.USMBF
	HRRM	P2,DEVDMP##(P3)	;SAVE LOC OF EXTRA MON BUF
	MOVE	P4,DEVREL##(P3)	;NEW SIZE OF UFD
	CAMN	P4,DEVREL##(F)	;SAME AS ORIGINAL SIZE?
	CAMG	P1,[EXP -2*6]	;YES. AT LEAST 6 FREE SLOTS?
	SETZ	P1,		;YES. SET P1=0(DON'T ALLOCATE)
	PUSHJ	P,UFORSS##	;GET L(UFB OF SFD A.T.)
	TRZ	T3,NMPSFU##	;CLEAR NOISE BIT
	MOVSI	T4,UFPZRB##	;COMPRESSED SUCCESSFULLY
	ANDCAM	T4,UFBZRB##(T3)	;BLOCK OF ZEROES IS GONE
	MOVE	P2,DEVPPN(F)	;IN CASE IT IS H OR SFD
	TRZE	T2,NMPSFU##	;SFD?
	JRST	[PUSHJ P,GETCB## ;YES, JUST UPDATE ACCWRT
		 JRST UFDCMA]
	MOVE	T3,T2		;NO, GET LOC IN T3
	DPB	P4,UFYWRT##	;SAVE NEW NO OF BLOCKS WRITTEN
	MOVE	P2,DEVACC##(F)	;GET (NEW) PPB NAME
	MOVE	P2,ACCPPB##(P2)	; AND SAVE IN DEVPPN FOR UFDACC
	MOVE	P2,PPBNAM##(P2)
	EXCH	P2,DEVPPN(F)
	PUSHJ	P,UFDACC	;FIND THE UFD NMB IN [1,1]
UFDCMA:	  MOVEM	P4,ACCWRT##(T2)	;%SAVE UPDATED SIZE IN NMB
	MOVEM	P2,DEVPPN(F)	;RESTORE OLD PPN
	PUSHJ	P,GVCBJ##	;%GIVE UP CB RESOURCE
UFDCMB:	JSP	T4,RIBUN##	;SET U TO UNIT OF UFD RIB
	PUSHJ	P,UFDCRD	;READ THE RIB
	  JRST	UFDCMC		;CAN'T READ IT
	LSH	P4,BLKLSH##	;COMPUTE NO WDS IN UFD
	MOVEM	P4,RIBSIZ##+1(T1) ;SAVE IN RIB
	MOVE	T3,RIBSTS##+1(T1) ;GET STATUS BITS
	TRZN	T3,RIPCBS##	;TURN OFF RIBCBS
	TRZ	T3,RIPCMP##	;BUT NOT RIPCMP IF IT WAS ON GNTRY
	MOVEM	T3,RIBSTS##+1(T1) ;REPLACE BITS
	PUSHJ	P,MONWRT##	;AND GO REWRITE THE RIB
;STILL IN FTDUFC CONDITIONAL
UFDCMC:	EXCH	P3,F		;SET F=L(EXTRA DDB)
	HRRZ	T1,DEVDMP##(F)	;LOC OF EXTRA MON BUF
	PUSHJ	P,GVMNBF	;RETURN 2ND MONITOR BUFFER
	HRRZ	U,DEVUNI##(F)	;SAVE UNIT OF LAST UFD BLOCK
	MOVE	P2,DEVBLK##(F)	;AND NO OF THE BLOCK
	PUSHJ	P,CLRDDB	;RETURN THE EXTRA DDB
	MOVE	F,P3		;RESTORE F
	JUMPN	P1,CPOPJ1##	;GO IF HAVE TO ALLOCATE MORE BLOCKS
	MOVE	T2,P2		;DON'T ALLOCATE - BLOCK TO WRITE
	PJRST	STORU##		;SAVE UNIT TO WRITE THE BLOCK AND NON-SKIP

;HERE IF NO ROOM FOR ANOTHER DDB
UFDCMD:	MOVE	F,P3
	PJRST	CPOPJ1##

;SUBROUTINE TO WRITE A UFD BLOCK
;WRITES THE MONITOR BUFFER WHOSE ADDR IS IN THE EXTRA DDB (POINTED TO BY P3)
DIRWRT:	EXCH	P3,F		;SAVE F, SET UP OTHER DDB
	HRRZ	U,DEVUNI##(F)	;UNIT OF UFD DATA
	SETZM	DEVNAM(F)	;DEVNAM=0 - WRITE UFD BLOCK
	PUSHJ	P,DIRRED##	;GO WRITE THE BLOCK
	HRRZ	T1,DEVLFT##(F)	;NO OF BLOCKS LEFT IN POINTER
	SOJGE	T1,DIRWR1	;GO IF THERE IS ANOTHER BLOCK

;HERE IF THE PNTR IS EXHAUSTED
;CALL DIRRED ONCE MORE TO SET UP NEXT PNTR
;(MAY HAVE TO READ THE RIB INTO MON BUF)
	SETOM	DEVNAM(F)	;SO DIRRED WON'T WRITE
	PUSHJ	P,DIRRED##	;GO SET UP NEXT PNTR
	  JFCL			;DIRRED RETURNS CPOPJ1
	SOS	DEVBLK##(F)	;RESET THE DDB LOCS WHICH DIRRED CHANGED
	SOS	DEVREL##(F)	; (THESE LOCS ARE BUMPED BEFORE WRITING)
	AOS	DEVLFT##(F)
DIRWR1:	EXCH	P3,F		;RESTORE F
	HRRZ	U,DEVUNI##(F)	; AND U
	POPJ	P,		;AND EXIT
;STILL IN FTDUFC CONDITIONAL
;ROUTINE TO TEST IF IT'S OK TO COMPRESS
;DON'T COMPRESS IF SOMEBODY IS READING THE DIRECTORY AS A FILE.
;IT'LL SCREW UP HIS WILDCARD ROUTINE.
;T2 PASSES UFB OR SFD ACC
;CPOPJ IF NOT OK TO COMPRESS
;CPOPJ1 IF OK
;RULES:
;1. DON'T CALL CMPOK EXCEPT AS A LAST DITCH BEFORE
;YOU COMPRESS. (CMPOK IS SLOW).
;2. IF CMPOK SAYS DON'T COMPRESS, THEN TRY EVERYTHING
;POSSIBLE BEFORE ALLOCATING MORE DIRECTORY BLOCKS.
CMPOK:	TRZN	T2,NMPSFU##	;SFD OR UFD?
	JRST	CMPOK1		;UFD
	PUSHJ	P,GETCB##	;SFD, GET INTERLOCK
	LDB	T1,ACZCNT##	;%GET USE COUNT
	SOJE	T1,GVCBJ1##	;%COMPRESS IF WE'RE THE ONLY GUY
CMPOK2:	HLRZ	T2,ACCNMB##(T2)	;%FIND NMB
	TRZN	T2,DIFNAL##
	JRST	CMPOK2
	MOVE	T3,NMBCNT##(T2)	;%COUNT UP ONLY BECAUSE SET PATH?
	SOJE	T3,GVCBJ1##	;%SET PATH DOESN'T BUMP NMBCNT
;NMBCNT IS PROBABLY WRONG AGAIN, DOUBLE CHECK.
	MOVE	T3,HIGHJB##	;%HIGHEST JOB IN USE
CMPOK3:	HRRZ	T4,JBTSFD##(T3)	;%DOES JOB HAVE PATH SET HERE?
	TRZ	T4,CORXTR##
	CAMN	T2,T4
	SOJE	T1,GVCBJ1##	;%YES, COMPRESS IF ALL ACCOUNTED FOR
	SOJG	T3,CMPOK3	;%NO, TEST NEXT JOB
	PJRST	GVCBJ##		;%SOMEBODY LEFT, DON'T COMPRESS
CMPOK1:	PUSHJ	P,UFDACC	;FIND THE UFD'S ACC
	  SKIPA	T1,ACCCNT##(T2)	;%PICK UP THE USE COUNT
	PJRST	GVCBJ1##	;%NO ACC, NO READER, COMPRESS
	TRNN	T1,ACMCNT	;%IS THERE A READER?
	AOS	(P)		;%NO, COMPRESS
	PJRST	GVCBJ##
;RELEASE UUO
DSKREL:	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO STOP
	PUSHJ	P,NULTST	;IF NULL
	  POPJ	P,		; DONT DO ANYTHING
	MOVE	J,.CPJOB##	;SET J FOR RETRES
IFN FTFDAE,<
	PUSHJ	P,CHKFCU	;CHECK IF AT COUNT UP FOR FILDAE
>
	PUSHJ	P,RETRES##	;RETURN ANY RESOURCES DDB HAS
				;IN CASE OF ERROR RE-ENTRY)
	SKIPGE	DEVSPL(F)	;SPOOLING DEVICE?
	TLOE	S,IOSRST	;YES, DO A CLOSE INSTEAD OF A RELEASE
				; (BUT IF ERROR, NEXT RELEASE WILL RESET)
	TLO	F,RESETB	;INDICATE RESET IN PROGRESS
	PUSHJ	P,GTMNBF##	;COULD HAVE GIVEN IT UP ON A KJOB
	PUSHJ	P,CLOSIN	;CLOSE INPUT (IF NOT ALREADY DONE)
	TLO	F,ICLOSB
	PUSHJ	P,CLOSOU	;CLOSE OUTPUT (DITTO)
	TLO	F,OCLOSB
	TLZE	S,IOSUPR	;SUPER USETI/O?

	TLNN	S,IOSERR##	;YES, ANY ERRORS?
	JRST	DSKRL1		;NO
;HERE TO WRITE BAT BLOCK FOR ERRORS DETECTED DURING INPUT/OUTPUT WITH SUPER USETI/O
;MUST DO AT RELEASE SINCE NO FILE IS OPEN SO CLOSE WONT WRITE THEM
	MOVEM	S,DEVIOS(F)	;SAVE S, IOSUPR OFF
	PUSHJ	P,SETU##	;WRITE BAT BLOCK SINCE CLOSE DID NOT
	  JRST	DSKRL1		;IF F/S JERKED, OR OUTPUT CLOSE DONE
	MOVSI	T1,UNPHWP	;DON'T TRY TO UPDATE BAT BLOCK
	TDNE	T1,UNIDES(U)	;IF THE UNIT IS HARDWARE WRITE PROT.
	JRST	DSKRL1		;IT IS SO FORGET IT
	MOVEI	T1,DEPDER	;IF ERROR RECOVERY HAS BEEN DISABLED,
	TDNE	T1,DEVSTA(F)	; ...
	JRST	DSKRL1		;THEN DON'T MESS WITH BAT BLOCKS
	PUSHJ	P,TSTBAD	;FIND EXTENT OF BAD REGION
	MOVE	T1,.USMBF	;LOC OF MON BUF
	HRRZ	T2,RIBNBB##+1(T1) ;NO OF BAD BLOCKS
	MOVE	T1,DEVELB##(F)	;FIRST BAD BLOCK
	TLZ	T1,BATMSK##	;ONLY BLOCK NUMBER
	JUMPE	T1,DSKRL0
	HRRZ	T3,UNISTR(U)	;DONT ALLOCATE IF NOT IN A STR
	JUMPE	T3,DSKRL0
	PUSHJ	P,TAKBLK##	;ALLOCATE THEM IF POSSIBLE
	  JFCL			; (SO WONT BE GIVEN UP AGAIN)
DSKRL0:	PUSHJ	P,ERRFIN	;WRITE BAT BLOCKS
	TLZ	S,IOSERR##	;NO BAD BLOCKS NOW

DSKRL1:	TLZ	F,RESETB	;RESET BIT
	SETZM	DEVFIL(F)	;INDICATE FILE RELEASED
	SETZM	DEVUFB##(F)	;ZERO DEVUFB SO UFDLK WILL WORK RIGHT
	SETZM	DEVREL##(F)	;ZERO DEVREL SO SUPER USETI WILL WORK RIGHT
	SETZM	DEVPPN(F)	;ZERO DEVPPN SO SPTSTO/I WILL WORK RIGHT
	SETZM	DEVSFD##(F)	;ZERO DEVSFD SO NO SFD TO START
	SETZM	DEVELB##(F)	;ZERO DEVELB SO NEXT ERROR WILL GET IN BAT BLOCK

	HLLZS	DEVCPY##(F)	;SUPERSTITION
	TLZ	S,IOSWLK!IOSUPR!IOSRST!IOSMON	;ZERO SOME BITS
	MOVSI	T1,DEPLIB##	;CLEAR DEPLIB IN DDB
	ANDCAM	T1,DEVLIB##(F)
	MOVEI	T1,DEPPAL##	;CLEAR PRE-ALLOCATING FILE
	ANDCAM	T1,DEVPAL##(F)
	PJRST	STOIOS##	;SAVE IN DDB AND RETURN

;ROUTINE TO WRITE A DIRECTORY BLOCK
WRTDIR:	MOVE	T1,.USMBF	;IOWD FOR MONITOR BUFFER
	MOVE	T2,DEVBLK##(F)	;BLOCK NUMBER
	;PJRST	WRTUFD		;GO WRITE THE UPDATED UFD

;SUBROUTINE TO WRITE A UFD BLOCK
;ENTER WITH AC'S, DATA SET AS FOR MONWRT
WRTUFD:	TLZ	S,IOSFIR	;MAKE SURE IOSFIR IS OFF
	PJRST	MONWRT##	;WRITE UFD
IFN FTFDAE,<
;SUBROUTINE TO CHECK IF AT COUNT IS UP
;IF SO, DECREMENT COUNT
CHKFCU:	MOVSI	T1,DEPFCU##
	TDNN	T1,DEVFCU##(F)	;COUNT UP?
	POPJ	P,		;NO
	ANDCAM	T1,DEVFCU##(F)	;YES, BUT NO LONGER
	PUSHJ	P,DECRDR	;DECR COUNT
	  JUMPN	T1,GVCBJ##	;%EXIT IF OTHER READERS
	JUMPE	T1,CPOPJ##	;%DON'T HAVE CB IF NO AT
	SKIPN	ACCDOR##(T1)	;%ALREADY DORMANT?
	JRST	ATSDRA##	;%NO, MAKE DORMANT
	PJRST	GVCBJ##		;%AND RETURN
>
;SUBROUTINE TO FIND THE ACCESS TABLE FOR A UFD
;ASSUMES PRJ,PRG IS IN DEVPPN  -  UFD JUST READ UNDER [1,1]
;RETURNS CPOPJ IF FOUND, WITH T2=LOC OF A.T.;  CPOPJ1 IF NOT FOUND
;ALWAYS RETURNS WITH THE CB RESOURCE
UFDACC:	MOVE	T1,MFDPPN##	;PPN FOR UFD'S
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	HLRZ	T2,SYSPPB##	;%START OF UFD BLOCKS
	PUSHJ	P,LSTSCN##	;%SEARCH FOR THIS MFD PPB
	  JRST	CPOPJ1##	;%NOT THERE
	HLRZ	T2,PPBNMB##(T2)	;%START OF NMBS UNDER MFD
	MOVE	T1,DEVACC##(F)	;%GET PPN FROM A.T.
	MOVE	T1,ACCPPB##(T1)	;% (DEVPPN "WRONG" IF RENAMING
	MOVE	T1,PPBNAM##(T1)	;%ACROSS DIRECTORIES)
	SETO	T3,		;%INDICATE DON'T CREATE NMB IF NOT FOUND
UFDAC1:	PUSHJ	P,LSTSRA##	;%SEARCH FOR IT
	  JRST	CPOPJ1##	;%NOT THERE
	HRRZ	T3,NMBEXT##(T2)	;%EXTENSION
	CAIN	T3,(SIXBIT .UFD.) ;%IS IT "UFD"?
	JRST	UFDAC2		;%YES. OK
	HLRZ	T2,NMBPPB##(T2)	;%NO. IGNORE THE ENTRY
	TRNE	T2,NMPUPT##	;%IS IT A REAL NMBPPB POINTER?
	PJRST	CPOPJ1##	;%NO, RETURN (UPWARD PNTR TO FATHER SFD)
	JRST	UFDAC1		;%YES, SCAN FOR ANOTHER JBTPPN NAME BLOCK
UFDAC2:	HLRZ	T2,NMBACC##(T2)	;%FOUND NMB FOR THIS UFD. LOC OF 1ST A.T.
	MOVE	T1,DEVACC##(F)	;%A.T. FOR THIS FILE
	LDB	T1,ACZFSN##	;%FSN OF FILE (=FSN OF UFD)

	PJRST	BYTSCA##	;%SEARCH FOR A.T. FOR UFD
;SUBROUTINE TO TEST IF THE PPB BLOCK IS IN USE
;IF SO,RETURN     IF NOT, TEST THE UFB BLOCKS
;IF A UFB IS FOUND WHICH IS NOT CURRENTLY BEING USED BY A FILE, RETURN TO FREE CORE
;IF ALL UFB'S ARE RETURNED, RETURN THE PPB TO FREE CORE
;CALLED BY CLOSE
TSTPPB::CBDBUG	(N,Y);
	LDB	J,PJOBN##	;JOB NUMBER
	MOVE	T1,JBTSTS##(J)	;STATUS WORD
	TLNE	T1,JACCT	;JACCT ON (PROBABLY LOGIN)?
	TLNE	T1,JLOG		;YES, JOB LOGGED IN?
	CAIA			;YES, CAN'T BE LOGIN
	POPJ	P,		;NO. LEAVE CORE BLOCKS ALONE
TSTPP1:	PUSHJ	P,GETCB##	;GET CB RESOURCE
	MOVE	T1,DEVPPN(F)	;%PPN OF FILE
TSTPPX::HLRZ	T2,SYSPPB##	;%NO, GET LOC OF 1ST PPB
	PUSHJ	P,LSTSCN##	;%SEARCH FOR PPB BLOCK
	  PJRST	GVCBJ##		;%
TSTPP2:	MOVE	T1,PPBNLG##(T2)	;%LOGGED-IN WORD
	SKIPN	PPBCNT##(T2)	;%ANY DDBS USING PPB?
	TRNE	T1,PPPNLG##	;%IS PPN LOGGED IN?
	PJRST	GVCBJ##		;%YES. GIVE UP CB AND RETURN
	PUSH	P,T2		;%NO. SAVE LOC OF PPB
	CAMN	T3,[-1]		;%FIRST PPB?
	MOVEI	T3,SYSPPB##	;%YES, SET PREDECESSOR
	HRLM	T3,(P)		;%SAVE LOC OF PREDECESSOR
	MOVEI	T3,DIFPBC##(T2)	;%PPB=PRED OF 1ST UFB
	HLRZ	T4,PPBUFB##(T2)	;%LOC OF 1ST UFB IN PPB
	JUMPE	T4,TSTPP4	;%NONE IF 0
TSTPP3:	HLL	T4,CORLNK##(T4)	;%SAVE LINK TO NEXT UFB
	PUSHJ	P,RET4WD	;%NO, DELETE THIS UFB
	HLRZS	T4		;%NEXT UFB INTO T4
	JUMPN	T4,TSTPP3	;%TEST IT IF IT EXISTS
TSTPP4:	POP	P,T1		;%LOC OF PPB
	HLRZ	T2,PPBNMB##(T1)	;%LOC OF 1ST NMB UNDER PPB
	PUSHJ	P,SAVE2##	;%SAVE P1,P2
	PUSH	P,T1		;%SAVE LOC OF PPB 1ST ON PD LIST
	SKIPA	P1,T2		;%P1=LOC OF 1ST NMB
TSTPP5:	HLRZS	P1		;%NEXT NMB
	TRZE	P1,NMPUPT##	;%IS IT A PNTR TO A FATHER SFD?
	JRST	TSTPP7		;%YES, GO CHECK FATHER
TSTPP6:	JUMPE	P1,TSTPP9	;%NO NMBS  - DELETE PPB
	HLRZ	T3,NMBRNG##(P1)	;%NMB FOR AN SFD?
	JUMPE	T3,TSTPP7	;%NO, CONTINUE
	MOVE	P1,T3		;%YES, DOES IT POINT TO ANOTHER NMB LIST?
	TRZN	P1,NMPUPT##	;%
	JRST	TSTPP6		;%YES, TURN DOWN THAT CHAIN
;HERE WHEN THE NMB IS REMOVABLE
TSTPP7:	HLRZ	T1,NMBACC##(P1)	;%LOC OF 1ST A.T. ON NMB RING
	TRNE	T1,DIFNAL##	;%1-ITEM RING?
	JRST	TSTPP8		;%YES. ALL A.T.'S GIVEN UP
	PUSH	P,F		;%NO, SAVE F
	MOVEI	F,0		;%INDICATE DONT MESS WITH CB RESOURCE
	PUSHJ	P,ATRMOV##	;%REMOVE THE ACCESS TABLE
	POP	P,F		;%RESTORE F
	JUMPE	F,TSTPP7	;%CANT BE OUR AT IF DEVACC =0
	HRRZ	T2,DEVACC##(F)	;%OUT A.T.
	CAIN	T2,(T1)		;%DID WE REMOVE THE AT FOR THIS DDB?
	HLLZS	DEVACC##(F)	;YES, CLEAR DEVACC
	JRST	TSTPP7		;%AND GO TEST NEXT AT IN THE RING
TSTPP8:	HLL	T1,SYSCOR##	;%CURRENT 1ST FREE CORE BLOCK
	HRLM	P1,SYSCOR##	;%THIS NMB IS NEW 1ST FREE
	HLL	P1,NMBPPB##(P1)	;%LH(P1)=LOC OF NEXT NMB
	HLLM	T1,CORLNK##(P1)	;%LINK PREVIOUS 1ST FREE TO THIS
	JRST	TSTPP5		;%AND GO DELET NEXT NMB RING


TSTPP9:	POP	P,T4		;%LOC OF PPB
	SKIPE	PPBLOK##(T4)	;%ANY INTERLOCKS SET?
	PJRST	TSTP10		;%YES, LEAVE PPB ALONE
	HLRZ	T3,T4		;%PRED OF PPB
	CAIN	T3,SYSPPB##	;%PRED=SYSPPB?
	SUBI	T3,CORLNK##	;%YES. ADJUST PREDECESSOR
	PUSHJ	P,RET4WD	;%RETURN PPB TO FREE CORE
	HRRZ	T2,SYSPPB##	;%PPB THE CORE GRABBER WILL LOOK AT NEXT
	CAIN	T2,(T4)		;%DID WE JUST DELETE IT?
	HLLZS	SYSPPB##	;%YES, START AT 1ST PPB NEXT TIME
	CBDBUG	(Y,Y);
	PJRST	GVCBJ##		;%GIVE UP CB RESOURCE AND RETURN

;HERE IF INTERLOCKS SET IN PPB
TSTP10:	SETZM	PPBNMB##(T4)	;%DON'T LEAVE FUNNY LINKS
	SETZM	PPBUFB##(T4)	;% HANGING AROUND IN DATABASE
	PJRST	GVCBJ##


;SUBROUTINE TO RETURN A 4-WORD BLOCK TO FREE CORE.
;THIS ROUTINE LINKS THE PREDECESSOR BLOCK AROUND THE BLOCK BEING RETURNED
;ENTER WITH T4=LOC OF BLOCK TO RETURN,  T3=LOC OF PREDECESSOR
;ENTER AT RETXWD IF DONT CARE ABOUT PREDECESSOR LINK
RETXWD:	MOVE	T3,T4		;%MAKE SURE DONT CLOBBER ANYTHING WITH T3
RET4WD::MOVE	T1,CORLNK##(T4)	;%LINK TO NEXT BLOCK
	HLLM	T1,CORLNK##(T3)	;%SAVE AS LINK IN PREDECESSOR
	MOVE	T1,SYSCOR##	;%1ST FREE CORE BLOCK
	HRLM	T4,SYSCOR##	;%SAVE THIS AS 1ST BLOCK
	HLLM	T1,CORLNK##(T4)	;%LINK PREVIOUS 1ST TO THIS ONE
	POPJ	P,		;%AND RETURN
SUBTTL	LOOKUP

ULOOK:	PUSHJ	P,NULTST	;ON DEVICE NUL,
	  PJRST	CPOPJ1##	; LOOKUP WINS
	SKIPGE	DEVSPL(F)	;SPOOL-MODE?
	PJRST	CPOPJ1##	;YES, OK RETURN

	TLNE	F,ENTRB		;ENTER IN FORCE?
	JRST	LUKER1		;YES. ERROR RETURN
	SETZM	DEVSFD##(F)
	TLZ	F,INPB		;MIGHT BE ON FROM SUPER I/O
	SETZM	DEVLNM##(F)	;NOT A LOGICAL NAME TO START WITH
	PUSHJ	P,SAVE4##	;SAVE ACS (SETLER RETURNS STUFF IN P3,P4)
	PUSHJ	P,SETLER	;NO, SET UP UUO FOR LOOKUP
	  JRST	ILNMER		;ILLEGAL NAME - ERROR RETURN
	MOVSI	T2,DEPLIB##	;MAKE SURE DEPLIB IS OFF
	ANDCAM	T2,DEVLIB##(F)	; SO UPDATE WILL WIN
	SKIPE	DEVLNM##(F)	;IF A LOGICAL NAME
	TLZ	F,SYSDEV	;NOT FROM SYS (YET)
	MOVSI	T2,DEPFFS##!DEPFFL## ;CLEAR FOUND BY SCANNING, FOUND IN LIB
	ANDCAM	T2,DEVPTB##(F)	; BITS FROM THE DDB
	PUSH	P,[-1,,0]	;INITIALIZE ERROR - SAVE
	TLOA	M,UUOLUK
ULOOK2:	TLO	M,UTRTWC
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST IN T1
	JRST	[SKIPN DEVLNM##(F)
		 JRST ULOO20
		 MOVEI T1,SLEERR
		 JRST ULOOK4]
ULOOK3:	TLO	M,UUOLUK	;INSURE FNDFIL KNOWS
	MOVE	T2,T1		;SEARCH LIST INTO T2

	TLZ	S,IOSWLK	;MAKE SURE IOSWLK OFF (IN CASE OF RENAME)
	PUSHJ	P,FNDFIL##	;SEARCH FOR FILE NAME
	  SKIPA			;ERROR
	JRST	FOUND		;FILE FOUND

;HERE ON AN ERROR RETURN FROM FNDFIL
	SETZM	DEVUNI##(F)	;ZERO DEVUNI SO THAT UNILUP WILL WORK RIGHT IF AN
				; ENTER IS DONE (IT POINTS TO UFD-UNIT NOW)
	SETZM	DEVUFB##(F)	;ZERO DEVUFB SO TSTPPB WILL WORK RIGHT
	SKIPGE	DEVSPL(F)	;SPOOL MODE?
	POPJ	P,		;YES, IMMEDIATE RETURN

	CAIE	T1,TRNERR
	CAIN	T1,PRTERR
	SETZM	(P)
ULOOK4:	HRRM	T1,(P)
	PUSHJ	P,TSTPPB	;DELETE USELESS CORE BLOCKS
	SKIPL	(P)
	JRST	ULOO15

	HRRZ	T1,DEVSFD##(F)	;SCAN - GET LOC OF SFD
	JUMPE	T1,ULOOK7	;DONE IF 0 (JUST SEARCHED UFD)
	PUSHJ	P,SFDDEC
	LDB	T2,DEYSCN##	;SCANNING SWITCH
	JUMPE	T2,ULOOK6	;DON'T SCAN IF 0
	MOVSI	T2,DEPFFS##	;SET FILE-FOUND-BY-SCANNING BIT IN DDB
	IORM	T2,DEVPTB##(F)	;(WILL CLEAR IF NOT FOUND)
	PUSHJ	P,DECALL	;DECR. USE-COUNTS OF THIS SFD
ULOOK5:	HLRZ	T1,NMBPPB##(T1)	;SCAN FOR POINTER TO FATHER SFD
	TRZN	T1,NMPUPT##
	JUMPN	T1,ULOOK5
	HRRM	T1,DEVSFD##(F)	;FOUND - SAVE AS CURRENT SFD
	SKIPE	T1		;UFD ITSELF?
	PUSHJ	P,INCALL	;NO, INCR. USE-COUNTS OF A.T.'S
	PUSHJ	P,SFDUP
	JRST	ULOOK2		;AND RETRY THE LOOKUP IN THIS DIRECTORY
ULOOK6:	HRRZ	T1,DEVSFD##(F)	;IF AN SFD IS DEFAULT PATH
	JUMPE	T1,ULOOK7	; AND SCAN IS OFF
	PUSHJ	P,DECALL	;DECR SFD USE-COUNTS
ULOOK7:	SETZM	DEVSFD##(F)	;SO LIB WILL BE SEARCHED
	MOVSI	T2,DEPFFS##	;DIDN'T FIND IT BY SCANNING
	ANDCAM	T2,DEVPTB##(F)
	SKIPL	(P)		;ARE WE REMEMBERING AN ERROR?
	JRST	ULOO15		;YES, DON'T TRY LOGICAL NAMES
	SKIPN	DEVLNM##(F)	;NO, LOOKING AT LOGICAL NAME?
	JRST	ULOOK8		;NO, SEE IF /SYS
	PUSHJ	P,NXTSPC	;YES, GET NEXT PART OF SPECIFICATION
	  JRST	ULOOK2		;TRY LOOKUP ON THIS PPN/SFD
	SETZM	DEVLNM##(F)	;AT END OF SPEC - NOT IN TTHIS LOG NAME
	JRST	ULOO10		;SEE IF /SYS WANTED
ULOOK8:	MOVSI	T2,'SYS'
	CAMN	T2,DEVNAM(F)	;IF LOOKUP SYS:FILE TRIED NEW:
	JRST	ULOO12		; THEN TRY SYS: WITHOUT DEPLIB
	SUB	T2,DEVLOG(F)	;T2 = 0 IF LOGICAL SYS
	MOVSI	T1,DEPPP0##
	TDZE	T1,DEVPP0##(F)	;WAS E+3=0 ON LOOKUP?
	JUMPN	T2,ULOO20	;NO, NO LIB/SYS IF NOT LOGICAL SYS
	HLR	T2,T1		;T2=0 IF LOGICAL SYS, NOT DSK=SYS
	MOVE	T1,DEVLLE##(F)	;HOW WE HANDLE LIB
	TLNE	T1,DEPDSL##	;DON'T SEARCH IT (OR SYS?)
	JRST	ULOO20		;YES, LOOKUP FAILS
	TLNE	T1,DEPAUL##	;ALLOW UPDATE/RENAME IN LIB?
	TDZA	T1,T1		;YES, DON'T LIGHT DEPLIB
	MOVSI	T1,DEPLIB##	;INDICATE FROM LIB/SYS
	ORM	T1,DEVLIB##(F)	;IN CASE THIS LOOKUP WINS
				; (IN CASE OF UPDATE)
	TLNE	F,SYSDEV	;SYSTEM?
	JRST	ULOO12		;YES
	JUMPE	T2,ULOO10	;SEARCH SYS IF LOGICAL SYS
	SKIPN	T1,.PDOSL##(W)	;IS THERE AN OLD-STYLE LIB?
	JRST	ULOOK9
	CAMN	T1,DEVPPN(F)	;YES. ALREADY SEARCHED IT?
	JRST	ULOO10		;YES, TRY SYS
	MOVEM	T1,DEVPPN(F)	;NO, SEARCH IT NOW
	JRST	ULOOK2
ULOOK9:	MOVE	T1,DEVNAM(F)	;SEARCH LIB IF OPEN WAS
	PUSHJ	P,ALIASD##	; DONE ON "DSK"
	  PUSHJ	P,FNDLB		;IS THERE A LIB?
	  JRST	ULOO10		;NO, TEST IF /SYS
	MOVSI	T1,DEPFFL##	;LIGHT FILE-FOUND-IN-LIB
	IORM	T1,DEVPTB##(F)	; SINCE ITS EITHER IN LIB/SYS OR LOOKUP FAILS
	MOVE	T1,@.USLNM	;YES, POINT AT LIB SPEC
	ADDI	T1,LNMDEV##-LNRDEV##
	HRRZM	T1,DEVLNM##(F)	;SAVE IT IN THE DDB
	PUSHJ	P,NXTSP3	;POINT AT START OF THE SPEC
	  JRST	ULOOK2		;GO LOOKUP FILE IN THIS PPB
;HERE IF DSK AND LIB ARE DONE, TRY SYS:
ULOO10:	HLRZ	T1,JBTSFD##(J)	;LIB, SYS BITS
	TRNN	T1,JBPSYS##	;USER WANT TO LOOKUP SYS:?
	JRST	ULOO14		;NO, FILE NOT FOUND
	MOVE	T2,NEWPPN##	;YES, GET NEW: PPN
	TRNE	T1,JBPXSY##	;WANT NEW:?
	CAMN	T2,DEVPPN(F)	;YES, HAVE WE TRIED IT ALREADY?
	MOVE	T2,SYSPPN##	;YES, TRY REAL SYS
	TLO	F,SYSDEV	; AND SAY ITS REAL
ULOO11:	MOVEM	T2,DEVPPN(F)	;SAVE SYS OR NEW PPN
	MOVE	T1,DEVNAM(F)	;ARGUMENT FOR ALIASD
	PUSHJ	P,ALIASD##	;IS THIS "DSK"?
	  SKIPA			;YES, USE SYSTEM 'SL
	PUSHJ	P,SETSRC##	;NO, GET SEARCH LIST FROM DEVICE NAME
	  MOVE	T1,SYSSRC##
	MOVSI	T2,DEPFFL##	;LIGHT FOUND-IN-LIB
	IORM	T2,DEVPTB##(F)	; SINCE ITS EITHER IN SYS OR LOOKUP FAILS
	MOVE	T2,T1		;FNDFIL WANTS T2=SEARCH LIST
	PUSHJ	P,FNDFIL##	;LOOKUP THE FILE
ULOO12:	  SKIPA	T2,SYSPPN##	;DIDN'T FIND IT
	JRST	FOUND		;FOUND - FINISH UP
	TLNE	F,SYSDEV	;IF SYS (NEW)
	JUMPE	T1,ULOO13	;DON'T REMEMBER FNF ERROR
	SKIPGE	(P)		;ERROR CODE STORED? (NOT IF FNF ON SYS:)
	TLNE	T1,-1		;NO, ERROR RETURN FROM FNDFIL?
	CAIA			;NO
	MOVEM	T1,(P)		;YES, STORE ERROR NOW
ULOO13:	CAME	T2,DEVPPN(F)	;TRIED SYS?
	JRST	ULOO11		;NO, TRY IT NOW
ULOO14:	TLNE	M,UTRTWC
	SETZM	(P)
ULOO15:	PUSH	P,M		;SAVE M
	PUSHJ	P,GETWDU##	;GET E+3
	TLNN	T1,-1		;PATH POINTER ?
	HRRI	M,2(T1)		;YES, POINT AT PPN WRD
	HRRZ	T1,-1(P)	;GET THE ERROR CODE
	CAIE	T1,TRNERR	;RIB ERROR
	CAIN	T1,PRTERR	; OR PROTECTION FAILURE?
	SKIPA	T1,DEVPPN(F)	;YES, STORE THE PPN IN THE LOOKUP BLOCK
	SETZ	T1,		;NO, ZERO PPN WORD ON LOOKUP FAILURE
	PUSHJ	P,PUTWDU##
	SETZM	DEVPPN(F)	;SO PATH. WILL WIN
	JUMPE	T1,ULOO19	;DON'T STORE PATH IF NO PPN
	CAMN	M,(P)		;ARE WE FILLING IN A PATH BLOCK?
	JRST	ULOO19		;NO.  ALL DONE THEN.
	PUSH	P,[0]		;YES, PUT A MARKER ON THE STACK
	HRRZ	T2,DEVSFD##(F)	;GET THE FIRST SFD NMB POINTER
	JUMPE	T2,ULOO18	;JUMP IF NO SFD
ULOO16:	PUSH	P,NMBNAM##(T2)	;SAVE THE SFD NAME
ULOO17:	HLRZ	T2,NMBPPB##(T2)	;GET THE NEXT NMB LINK
	TRZN	T2,NMPUPT##	;POINTER TO THE NEXT HIGHER LEVEL?
	JUMPN	T2,ULOO17	;NO, TRY NEXT
	JUMPN	T2,ULOO16	;YES, REMEMBER THIS ONE
ULOO18:	POP	P,T1		;RESTORE AN SFD NAME
	PUSHJ	P,PUTWD1##	;STORE THE SFD NAME IN THE PATH BLOCK
	JUMPN	T1,ULOO18	;DO ALL OF THEM.
ULOO19:	POP	P,M
ULOO20:	POP	P,T1		;RESTORE ERROR CODE
	PJRST	LKENR4		;AND GO TELL USER
;HERE WHEN FILE NAME IS FOUND ON LOOKUP
;HERE WITH M AT PPN
FOUND:	MOVE	J,.CPJOB##	;JOB
	MOVE	T1,JBTSTS##(J)
	MOVE	T2,DEVFIL(F)	;FILE NAME WE LOOKED UP
	TRNE	T1,JS.ASA	;MONITOR DO THE LOOKUP (SAVGET)?
	MOVEM	T2,.JDAT+SGANAM## ;YES. MAKE SURE WE KNOW THE REAL FILE
	MOVE	T1,DEVPPN(F)	;PPN WE FOUND FILE IN
	CAME	T1,SYSPPN##	;IS IT SYS
	CAMN	T1,NEWPPN##	; OR NEW?
	SKIPA	T2,DEVACC##(F)	;YES, GET A.T.
	JRST	FOUND0		;NO
	LDB	T1,ACYFSN##	;GET FSN WE FOUND FILE ON
	PUSH	P,P2
	MOVE	P2,SYSSRC##
	PUSHJ	P,SLFND##	;IS FSN IN SYS SEARCH LISTT?
	  CAIA			;NO
	TLO	F,SYSDEV	;YES, TELL THE WORLD WE FOUND IT ON SYS
	POP	P,P2
FOUND0:	PUSHJ	P,CMPSLP	;WAIT TILL UFD COMPRESSOR IS DONE
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T. ENTRY
	MOVE	T3,T2		;INTO T3 ALSO
	SKIPGE	DEVSPL(F)	;SPOOL-MODE?
	JRST	FOUND3		;YES, DON'T STORE IN USER AREA
	POP	P,(P)		;REMOVE "ERROR CODE" FROM LIST
	TLNE	M,EXTUUO	;EXTENDED UUO?
	JRST	FOUND2		;YES
	PUSHJ	P,WRDCNT	;SAVE LENGTH IN E+3
	HRRI	M,-<UUNPPN-UUNATT>(M)	;POINT TO ATTRIBUTES WORD
	MOVE	T1,ACCPRV##(T3)	;DATE AND TIME WORD
	PUSHJ	P,PUTWDU##
	HRRI	M,-<UUNATT-UUNEXT>(M)	;POINT M TO ACCESS DATE WORD
	PUSHJ	P,GTWST2##	;GET ACCESS DATE WORD
	HLR	T1,ACCADT##(T3)	;ACCESS DATE
	PUSHJ	P,PUTWDU##	;STORE IT IN THE USER'S AREA
	HRRI	M,UUNPPN-UUNEXT(M) ;BACK TO PPN
	JRST	FOUND3		;FINISH UP (RIB DOESN'T HAVE TO BE READ)
;SUBROUTINE TO COMPUTE THE CONTENTS OF E+3 FOR LOOKUP/UPDATE ENTER
;EXITS T1=E+3 WORD (ALSO STORED IN USERS AREA)
; T2, T3=LOC OF A.T.
WRDCNT:	HRRZ	T2,DEVACC##(F)	;AT LOC INTO T2
	MOVE	T3,T2		;AND T3
	SKIPE	T1,ACCWRT##(T2)	;GET HIGHEST WRITTEN BLOCK
	SUBI	T1,1		;LAST BLOCK WILL BE COUNTED SEPERATELY
	CAIL	T1,2000		;GT 2^17 WORDS?
	AOJA	T1,FOUND1	;YES, STORE +BLOCK COUNT
	LSH	T1,BLKLSH##	;NO, CONVERT TO WORDS
	LDB	T4,ACZLBS##	;GET NO. OF WORDS IN LAST BLOCK
	ADD	T1,T4		;ADD INTO TOTAL NUMBER OF WORDS
	MOVNS	T1		;STORE -N IN LH
FOUND1:	HRLZS	T1
	PJRST	PUTWDU##	;STORE LENGTH IN E+3 AND RETURN

;HERE WHEN FILE IS FOUND FOR AN EXTENDED LOOKUP
FOUND2:	HRRI	M,-UUXPPN(M)
	PUSHJ	P,GTWST2##	;NUMBER OF ARGUMENTS
	MOVE	P1,T1
	TRZ	P1,RB.BIT	;CLEAR FLAG BITS
	HRRI	M,UUXPPN(M)	;POINT TO PPN WORD
	PUSH	P,M
	PUSHJ	P,GETWDU##	;GET PPN/SFD LIST WORD
	TLNN	T1,-1		;IS IT AN SFD POINTER?
	HRRI	M,2(T1)		;YES. POINT M TO REAL PPN WORD
	MOVE	T1,DEVPPN(F)	;GET PPN (MIGHT BE LIB,SYS,NEW)
	PUSHJ	P,PUTWDU##	;TELL USER REAL PPN
	POP	P,M
	CAIGE	P1,4		;STORE VALUES?
	JRST	FOUND3		;NO. FINISH UP
	HRRI	M,UUXPRV-UUXPPN(M)	;YES. POINT TO PRIVS WORD
	MOVE	T1,ACCPRV##(T3)	;PRIVILEGES WORD
	PUSHJ	P,PUTWDU##	;SAVE IN USERS AREA
	HRRI	M,-<UUXPRV-UUXEXT>(M)	;POINT TO ACCESS DATE WORD
	PUSHJ	P,GTWST2##	;GET ACCESS DATE WORD
	HLR	T1,ACCADT##(T3)	;ACCESS DATE
	PUSHJ	P,PUTWDU##	;STORE IT IN THE USER'S AREA
	HRRI	M,UUXSIZ-UUXEXT(M)	;POINT TO LENGTH WORD
	SKIPE	T1,ACCWRT##(T2)	;LENGTH
	SUBI	T1,1		;LAST BLOCK WILL BE COUNTED SEPERATELY
	LSH	T1,BLKLSH##	;CONVERT TO WORDS
	LDB	T4,ACZLBS##	;NUMBER OF WORDS IN LAST BLOCK
	ADD	T1,T4		;=TOTAL NUMBER OF WORDS IN FILE
	CAILE	P1,UUXPRV	;WANT LENGTH IN DIRECTORY BLOCK?
	PUSHJ	P,PUTWDU##	;YES. SAVE IT
	HRRI	M,UUXPPN-UUXSIZ(M) ;BACK TO PPN
	CAILE	P1,UUXSIZ	;NEED MORE VALUES?
	JRST	FOUND4		;YES. GO READ RIB
;HERE TO FINISH UP A LOOKUP IF THE RIB DOESN'T HAVE TO BE READ
;HERE WITH M AT PPN
FOUND3:	TLZ	S,IO		;INDICATE READING
	PUSHJ	P,AT2DDB##	;SET DEVREL, ETC FROM A.T. DATA
	  JRST	LKRIB		;ACCESS TABLE DATA IS BADLY FOULED UP!
	JRST	LKXIT		;GIVE UP MON BUF AND GOOD RETURN


;HERE WHEN USER WANTS MORE VALUES THAN ARE STORED IN ACCESS TABLE
;READ RIB (IF IT ISN'T ALREADY IN CORE)
FOUND4:	PUSH	P,M		;SAVE ADDR OF PPN
	HRRI	M,RIBVER##-RIBPPN##(M)
	TLNE	S,IOSRIB	;JOB HAVE RIB IN MONITOR BUFFER?
	JRST	FOUND5		;YES
	MOVE	T1,ACCUN1##(T3)	;UN1 WORD
	LDB	T2,UN1PTR##	;UNIT NUMBER
	PUSHJ	P,NEWUNI##	;SET U,DEVUNI
	  JRST	FOUND7		;BAD UNIT - MAKE DO WITH DATA FROM A.T.
	HRLM	U,DEVUNI##(F)	;SAVE AS RIB UNIT NO.
	PUSHJ	P,BUFRIB##	;GET MON BUF, READ RIB INTO IT
	  JRST	FOUND7		;RIB ERR - GIVE DATA FROM A.T.

;HERE WITH FILE RIB IN CORE
FOUND5:	HRRZ	T2,.USMBF	;LOC OF MONITOR BUF
	HRRZ	T1,RIBFIR##+1(T2);NO OF VALUES IN RIB
	HRRZ	P2,P1		;NUMBER OF ARGS USER WANTS
	CAIL	P2,UUXACT	;WANT ACCOUNT STRING?
	CAIGE	T1,UUXACT	;YES, IS THERE ONE IN THE RIB?
	JRST	FND5A		;NO
	SUBI	P2,UUXACT	;YES, NO. OF ACCOUNT STRING WORDS HE WANTS
	CAILE	P2,MAXACS##	;WANT MORE THAN THERE POSSIBLY ARE?
	MOVEI	P2,MAXACS##	;YES, GIVE HIM THE MAX
	MOVNS	P2		;P2 NEGATIVE NUMBER OF ARGS TO STORE
	MOVE	T3,RIBACT##+1(T2);AOBJN WORD FOR ACCT STRING
	ADDI	T3,1(T2)	;RELOCATE IT
	MOVEI	P1,UUXACT-1	;ONLY STORE UP TO ACCT STRING IN 1ST LOOP
FND5A:	CAILE	P1,-1(T1)	;USER WANT TOO MANY?
	MOVEI	P1,-1(T1)	;YES, SETTLE FOR EVERYTHING
	MOVE	T1,UNILOG(U)	;(ALIAS) NAME OF UNIT
	MOVEM	T1,RIBDEV##+1(T2);STORE IN RIB IN CASE USER WANTS IT
	HLRZ	T1,DEVEXT(F)	;RIBUSD IS ONLY MEANINGFUL FOR UFD
	CAIN	T1,'UFD'
	PUSHJ	P,FIXUSD	;FIX RIBUSD
	ADDI	T2,RIBVER##+1	;SET TO LOC OF RIBVER
	MOVNI	P1,-UUXSIZ(P1)	;WE ALREADY STORED UUXSIZ VALUES,
	HRLI	T2,(P1)		; SO SET AOBJN WORD FOR VALUES -UUXSIZ
FOUND6:	MOVE	T1,(T2)		;GET A NUMBER FROM RIB
	PUSHJ	P,PUTWDU##	;SAVE IN DIRECTORY BLOCK FOR USER
	HRRI	M,1(M)		;POINT TO NEXT WORD
	AOBJN	T2,FOUND6	;AND CONTINUE IF MORE WANTED
	JUMPGE	P2,FND6C	;GO IF NO ACCOUNT STUFF TO STORE
FND6A:	SKIPA	T1,(T3)		;GET AN ACCOUNT-STRING WORD
FND6B:	SETZ	T1,		;NO MORE IN RIB, RETURN A 0
	PUSHJ	P,PUTWDU##	;TELL THE USER
	HRRI	M,1(M)
	AOJGE	P2,FND6C	;GO IF ALL STORED
	AOBJN	T3,FND6A	;GET ANOTHER VALUE IF MORE IN RIB
	JRST	FND6B		;NO MORE IN RIB, STORE A 0
FND6C:	POP	P,M		;RESTORE ADDR OF PPN
	PUSHJ	P,CPYFST##	;COPY POINTERS TO DDB, SET DEVBLK,ETC
	  JRST	LKRIB		;RIB IS BADLY FOULED UP
;HERE WHEN LOOKUP ALL THROUGH
LKXIT:	PUSHJ	P,DECMST	;DECREMENT ALL SFD AT'S EXCEPT THE RIGHT ONE
	SETZM	DEVFLR##(F)	;1ST POINTER INDDB IS FOR BLOCK 0
	HRRZ	U,DEVUNI##(F)	;LOC OF UNIT DATA BLOCK
	HRRM	U,DEVFUN##(F)	;=UNIT OF 1ST POINTER IN DDB
	SETZM	DEVRIB##(F)	;CLEAR POINTER TO CURRENT RIB
	LDB	T2,UNYLUN##	;GET CURRENT LOGICAL UNIT NUMBER
	DPB	T2,DEYRBU##	;STORE IN DEVRIB
	MOVE	T3,UNISTR(U)	;GET SDB ADDRESS FOR CURRENT RIB
	MOVE	T2,DEVACC##(F)	;GET ADDRESS OF A.T.
	MOVE	T2,ACCPT1##(T2)	;GET FIRST RETRIEVAL POINTER
	LDB	T2,STYCLP##(T3)	;PICK OUT CLUSTER ADDRESS
	DPB	T2,DEYRBA##	;STORE IN DEVRIB
	TLZ	S,IOSRIB	;RIB IS NO LONGER IN MON BUFFER
	MOVEM	S,DEVIOS(F)
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;HERE WHEN CANNOT READ RIB - GIVE USER DATA FROM A.T.
FOUND7:	HRRZ	T3,DEVACC##(F)	;LOC OF A.T.
	POP	P,M		;RESTORE ADDR OF PPN
	JRST	FOUND3		;GO GET A.T. STUFF


;HERE IF THE DATA IN THE RIB IS BADLY FOULED UP, BUT RIBCHK PASSED IT
;DON'T ATTEMPT TO DECREMENT THE USE COUNT ON THE FILE ITSELF,
;THE ACC IS PROBABLY CLOBBERED.
;OK TO DECREMENT THE SFD
LKRIB:	MOVEI	T1,TRNERR	;ERROR CODE
	PJRST	LKENR4		;GO GIVE AN ERROR RETURN
SUBTTL	ENTER

UENTR:	PUSHJ	P,NULTST	;ON DEVICE NUL,
	  PJRST	CPOPJ1##	; ENTER WINS
	SKIPL	DEVSPL(F)	;SPOOLING DEVICE?
	JRST	UENT3		;NO
	PUSH	P,M		;SAVE M
	PUSHJ	P,GETWDU##	;YES, GET NAME OR ADDRESS USER IS ENTERING
	MOVE	T2,T1		;SAVE INCASE IYB
	TLNE	T1,-1		;FILENAME OR ADDRESS
	  JRST	UENT2		;FILENAME
	HRRI	M,UUXNUM(M)	;POINT M TO LENGTH IN ENTER BLOCK
	PUSHJ	P,GETWDU##	;GET LENGTH OF ENTER BLOCK
	HRRI	M,<UUXNAM-UUXNUM>(M) ;ASSUME FILENAME FOR SPOOLED NAME
	CAIGE	T1,<UUXFUT-UUXNUM> ;IS THE BLOCK LONG ENOUGH TO
				; INCLUDE A SPOOLED NAME?
	  JRST	UENT1		;NO, USER FILENAME
	HRRI	M,<UUXFUT-UUXNAM>(M) ;POINT M TO SPOOLED NAME IN
				; THE ENTER BLOCK
	PUSHJ	P,GETWDU##	;GET THE SPOOLED NAME
	JUMPN	T1,UENT2	;IF ZERO NAME USER FILENAME
	HRRI	M,<UUXNAM-UUXFUT>(M) ;ZERO SPOOLED NAME, SO USER FILENAME
UENT1:	PUSHJ	P,GETWDU##	;GET FILENAME FOR SPOOL NAME
UENT2:	MOVEM	T1,DEVSPN##(F)	;SAVE TEMPORARILY IN DDB
	SETZM	DEVPPN(F)
	POP	P,M		;RESTORE M
	MOVSI	T1,(UP.IYB)	;IN-YOUR-BEHALF BIT
	TLNN	T2,-1		;EXTENDED ENTER?
	TDNN	T1,.USBTS	;IS THAT WHAT WE'RE DOING?
	PJRST	CPOPJ1##	;NO--JUST RETURN
	ANDI	T2,<-1-RB.BIT>	;KEEP ONLY THE WORD COUNT
	CAIGE	T2,UUXACT	;ACCT STRING SPECIFIED?
	JRST	CPOPJ1##	;NOPE
	MOVEI	T3,ACTSTL##	;GET ACCT STRING LENGTH AS DEFINED IN COMMON
	JUMPE	T3,CPOPJ1##	;RETURN IF ZERO
	SUBI	T2,UUXACT	;COMPUTE LENGTH OF
	CAILE	T2,(T3)		; SPECIFIED STRING
	MOVEI	T2,(T3)		;  IN THE ENTER BLOCK
	MOVNS	T2		;NEGATE
	HRLZS	T2		;MAKE IT -LEN,,0
	PUSH	P,T2		;AND SAVE COUNT
	PUSHJ	P,SETSPB	;SET UP SPB
	  JRST	CPOPJ1##	;NO FREE CORE
	HRRI	M,UUXACT-1(M)	;POINT TO ACCT STRING IN ENTER BLOCK
	POP	P,T2		;GET -LEN,,0
	HRRI	T2,SPBACT##(T1)	;POINT TO ACCT STRING IN SPB
UENT3A:	PUSHJ	P,GETWD1##	;GET A WORD
	MOVEM	T1,(T2)		;PUT A WORD
	AOBJN	T2,UENT3A	;LOOP
	JRST	CPOPJ1##	;AND RETURN
UENT3:	TLNE	F,LOOKB		;LOOKUP IN FORCE?
	JRST	UPDATE		;YES. UPDATE
;HERE FOR AN ENTER WHICH IS A CREATE OR SUPERSEDE
UENT4:	SETZM	DEVSFD##(F)
	PUSHJ	P,SAVE4##	;SAVE ACS (SETLER RETURNS STUFF IN P3,P4)
	MOVE	J,.CPJOB##
	PUSH	P,JBTSFD##(J)	;SAVE JBTSFD
	MOVSI	T1,JBPXSY##
	ANDCAM	T1,JBTSFD##(J)	;MAKE SURE NEW: ISN'T WRITTEN
	MOVSI	T1,DEPLIB##
	ANDCAM	T1,DEVLIB##(F)	;IN CASE OF LOOKUP FAILURE FIRST
	SETZM	DEVLNM##(F)	;START WITH NO LOGICAL NAME
	PUSHJ	P,SETLER	;NO. SET UUO FOR ENTER
	  JRST	ILNMEN		;BAD NAME - ERROR
	MOVE	J,.CPJOB##
	POP	P,JBTSFD##(J)
	TLNN	M,UUODIR	;TRYING TO ENTER A DIRECTORY?
	JRST	UENT5		;NO
	PUSHJ	P,CNTLVL	;YES, GET SFD LEVEL
	CAMGE	T1,SFDLVL##	;ALREADY AT LIMIT?
	JRST	UENT5		;BELOW LIMIT
	MOVEI	T1,LVLERR	;ABOVE, GIVE HIM ERROR
	JRST	LKENR4
UENT5:
;HERE IF NOT TRYING TO ENTER A DIRECTORY
UENT6:	SKIPN	T1,DEVLNM##(F)	;LOGICAL NAME SPEC?
	JRST	UENT11		;NO
	TLO	M,UUOLUK	;NO, SEE IF FILE EXISTS HERE
UENT7:	JUMPGE	P4,UENT8	;/OVERRIDE?
	MOVE	T1,DEVLNM##(F)	;YES. GET SPEC
	HRLZ	T2,P4		;IS NAME.EXT FROM LOOKUP/ENTER BLOCK
	CAMN	P3,LNRNAM##(T1)	; THE SAME AS THE PATHOLOGICAL NAME SPEC?
	CAME	T2,LNREXT##(T1)
	JRST	UENT9		;NO, STEP TO NEXT SPEC
UENT8:	PUSHJ	P,SETSRC##
	  JRST	UENT9		;UNIT NOT THERE
	MOVE	T2,T1
	PUSHJ	P,FNDFIL##	;DOES FILE EXIST HERE?
	  JRST	UENT99		;NO
	PUSH	P,P2		;YES, SET UP P2 FOR DECUC
	PUSHJ	P,DECSU
	PUSHJ	P,DECRDR	;DECREMENT ACC
	  PUSHJ	P,GVCBJ1##	;%OTHER READERS, GIVE UP CB
	PUSHJ	P,TSTAMD##	;%LAST READER, FILE MARKED FOR DELETION?
	  CAIA			;YES
	PUSHJ	P,ATSDRA##	;%NO, MAKE ACC DORMANT
	PUSHJ	P,DECUC		;DECREMENT PPB+NMB
	POP	P,P2		;RESTORE P2
	JRST	UENT10		;USE THIS STR
UENT99:	CAIN	T1,PRTERR	;PROTECTION FAILURE?
	JRST	UENT10		;YES, THIS STR WILL FAIL
UENT9:	PUSHJ	P,SFDDEC	;CLEAR ANY SFD STUFF WE SET UP
	PUSHJ	P,DECSFD
	SETZM	DEVSFD##(F)
	PUSHJ	P,NXTSPC	;STEP TO NEXT SPEC
	  JRST	UENT7		;SEE IF FILE EXISTS THERE
	MOVE	T1,DEVNAM(F)	;NO FILE TO SUPERSEDE - GO BACK TO START
	PUSHJ	P,SDVTST
	  PUSHJ	P,LNMSTP	;WHAT? IT USED TO BE A LOG NAME
	MOVE	T1,@.USLNM	;GO TO 1ST PART OF SPEC
	ADDI	T1,LNMDEV##-LNRDEV##
	HRRZM	T1,DEVLNM##(F)
	PUSHJ	P,NXTSP3
	  CAIA
	PUSHJ	P,LNMSTP	;WHAT? IT USED TO BE THERE

;HERE WITTH DDB SET UP TO THE PPN/SFD WE WANT TO CREATE/SUPERSEDE IN
UENT10:	TLZ	M,UUOLUK	;NOT A LOOKUP ANY MORE
UENT11:	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  SKIPA	T1,DEVLNM##(F)	;LOG NAME?
	JRST	UENT12
	JUMPE	T1,CPOPJ##	;NO, LOSE
	PUSHJ	P,NXTSPC	;YES, GET NEXT PART
	  JRST	UENT11		;SEE IF DEVICE EXISTS
	POPJ	P,
UENT12:	MOVE	T2,T1		;SEARCH LIST INTO T2
	TLZ	S,IOSWLK	;MAKE SURE IOSWLK IS OFF
	MOVEM	S,DEVIOS(F)	; (COULD BE ON FROM PREVIOUS LOOKUP)
	PUSHJ	P,FNDFIL##	;SEARCH FOR MATCH, SET A.T.
	  JRST	LKENR4		;ERROR
	HLRZ	T1,DEVEXT(F)	;GET EXTENSION
	MOVE	T2,DEVPPN(F)	; AND PPN
	CAIN	T1,'UFD'	;TRYING TO CREATE A UFD ?
	CAMN	T2,MFDPPN##	;YES. IN THE MFD ?
	SKIPA	T2,DEVACC##(F)	;YES, GET LOC OF A.T.
	JRST	NTFOUN		;NO, ERROR
	HRRZ	P1,ACCSTS##(T2)
	TRNE	P1,ACPSUP	;SUPERSEDING
	TRNN	P1,ACPPAL##	; A PRE-ALLOCATED FILE?
	CAIA			;NO
	JRST	SETE19		;YES, FINISH UP
	TLNE	S,IOSWLK	;FILE (STR) WRITE LOCKED?
	JRST	ENER12		;YES. ERROR
	HRRZ	P2,U		;REMEMBER UNIT WE OWN DA FOR
	PUSHJ	P,DDBZR		;ZERO THE DDB POINTERS
	MOVSI	T4,MRIBLN##+1	;SET UP DEVRSU(COUNT 1 FOR 1ST UNIT)
	HLLM	T4,DEVRSU##(F)
	SETZM	ACCALC##(T2)	;INSURE THAT THE ALLOCATION WORD IS 0
	LDB	T4,ACYFSN##	;T4 = FSN
	MOVE	P1,TABSTR##(T4)	;LOC OF STR DATA BLOCK INTO P1
	SETO	T2,		;SET MASK=-1 (COMPARE WHOLE NAME)
	MOVE	T1,DEVNAM(F)	;NAME USER INITED
	PUSHJ	P,UNSER0##	;LOOK FOR MATCHING UNINAM
	  JRST	UNILUP		;NO MATCH - PICK BEST UNIT
	SKIPLE	UNITAL(T3)	;HE WANTS PARTICULAR UNIT - ANY ROOM?
	JRST	USEUNI		;YES. USE REQUESTED UNIT
;HERE WHEN A PARTICULAR UNIT WAS NOT SPECIFIED - FIND THE MOST EMPTY
; UNIT IN THE STR WITH NO OPEN FILES TO START THE FILE ON
UNILUP:	SETZB	T1,T4		;T4 WILL  CONTAIN BEST UNITAL
UNILP0:	HLR	T3,STRUNI##(P1)	;FIRST UNIT IN STR
	PUSH	P,P1		;SAVE P1
UNILP1:	CAML	T4,UNITAL(T3)	;IS THIS THE BEST UNIT SO FAR?
	JRST	UNILP5		;NO. TRY NEXT
	MOVSI	T2,DEPNLB##
	TDNN	T2,DEVNLB##(F)	;DID USER ASK FOR ANY UNIT?
	TLNE	T3,-1		;YES. AVOIDING UNITS WITH OPEN FILES?
	JRST	UNILP4		;NO, USE THIS UNIT
	SKIPL	T2,USRHCU##	;YES. NO OF CHANS USER HAS OPEN
	SETZ	P1,
UNILP2:	PUSHJ	P,NXTCH##
	  JRST	UNILP4
	MOVSI	T2,DVDSK
	TDNE	T2,DEVMOD(T1)
	CAIN	T1,(F)
	JRST	UNILP2
	HLRZ	T2,DEVEXT(T1)	;YES. FILE'S EXTENSION
	PUSHJ	P,EXTCK		;IS IT A DIR?
	JRST	UNILP2		;YES. PUTTING DATA FILE ON SAME UNIT IS OK
	HLRZ	T2,DEVUNI##(T1)	;UNIT OF THE FILE
	CAIN	T2,(T3)		;IS IT THIS UNIT?
	JRST	UNILP5		;YES. DON'T WANT TO WRITE THE FILE ON THIS UNIT
	JRST	UNILP2		;TEST NEXT USER CHAN
UNILP4:	MOVE	T4,UNITAL(T3)	;THIS IS THE BEST SO FAR. SAVE ITS TALLY
	HRRZ	U,T3		;SAVE LOC OF UNIT DATA BLOCK
UNILP5:	HLR	T3,UNISTR(T3)	;STEP TO NEXT UNIT IN STR
	MOVE	S,DEVIOS(F)
	TRNE	T3,-1		;IS THERE ONE?
	JRST	UNILP1		;YES. TEST IT
	POP	P,P1		;RESTORE P1
	JUMPN	T4,USEUN1	;FOUND A UNIT WITH FREE BLOCKS IF T4 NON 0
	TLON	T3,-1		;INDICATE ANY UNIT WILL DO
	JRST	UNILP0		;GO FIND ANY UNIT WITH FREE BLOCKS
	JRST	UENT6		;NONE FREE, TRY AGAIN
USEUNI:	MOVE	U,T3		;SET U TO USER SPECIFIED UNIT
;HERE WHEN U IS SET UP (IT MAY BE CHANGED BY NON-0 E+11)
USEUN1:	PUSHJ	P,STOAU##	;SAVE LOC OF UNIT DB IN DDB
	PUSHJ	P,UPDA##	;AND GET IT FOR NEW UNIT
	SKIPLE	UNITAL(U)	;ANY SPACE ON UNIT?
	JRST	USEU1A		;YES, PUSH ON
	PUSHJ	P,DWNDA##	;NO, SOME OTHER JOB SNUCK IN AND GRABBED IT
	MOVE	T1,UNISTR(U)
	SKIPLE	STRTAL##(T1)	;IS THERE SPACE ANYWHERE ON STR?
	JRST	UNILUP		;YES, GO FIND ANOTHER UNIT TO WRITE ON
	JRST	UENT6		;NO, CALL FILFND AGAIN
USEU1A:	MOVEI	T3,DEVRB2##(F)	;SET DEVRET TO DEVRB2 (1ST REAL PNTR)
	HRRM	T3,DEVRET##(F)
	MOVE	J,UDBKDB(U)	;LOC OF KONTROLLER DB
	HRRZ	P2,DEVACC##(F)	;SET P2 AND P3 POINTING
	HRRI	M,-1(M)
	TLNN	M,EXTUUO	;EXTENDED ENTER?
	JRST	CREAL4		;NO. POINT TO PRIVS WORD
	PUSHJ	P,GETWDU##	;GET NUMBER OF ARGUMENTS(VALUES)
	TRZ	T1,RB.BIT	;CLEAR NO-SUPERSEDE BIT
	HRRZ	P1,T1
	CAILE	P1,RIBENT##	;ASKING FOR TOO MANY?
	MOVEI	P1,RIBENT##	;YES. TAKE SMALLER AMOUNT
	HRRI	M,UUXALC(M)	;POINT TO (ALLOCATION WORD)
	CAIL	P1,UUXALC
	PUSHJ	P,GETWDU##
	CAIL	P1,UUXALC	;MAY HE BE SPECIFYING ALLOCATION?
	SKIPG	T2,T1		;YES. PICK UP AMOUNT
	CAIA			;NO, ESTIMATED LENGTH GIVEN?
	JRST	USEUN2		;YES, USE IT
	HRRI	M,-1(M)
	CAIL	P1,UUXEST
	PUSHJ	P,GETWDU##
	HRRI	M,1(M)
	CAIL	P1,UUXEST
	SKIPG	T2,T1		;GET ESTIMATED ALLOCATION
	HLRZ	T2,UNIGRP(U)	;NO ESTIMATED, USE UNIGRP
	CAIA
USEUN2:	TLO	M,UALASK	;INDICATE ASKING FOR A SPECIFIC AMOUNT

	HRRZ	T4,DEVUFB##(F)	;LOC OF UFB
	CAMG	T2,UFBTAL##(T4)	;ASKING FOR MORE THAN QUOTA ALLOWS?
	JRST	CREAL1		;NO. OK
	SKIPG	T2,UFBTAL##(T4)	;YES. ANY LEFT AT ALL?
	HLRZ	T2,UNIGRP(U)	;NO - TAKE UNIGRP BLOCKS
				;(WE DON'T CHECK QUOTAS ON SUPERSEDE IN A F/S)
	TLNE	M,UALASK
	TLO	M,UPARAL	;YES. REMEMBER FOR PARTIAL ALLOC. ERROR
;HERE WITH T2=SPACE WE WOULD LIKE TO GET
CREAL1:	HRRI	M,1(M)		;POINT TO START ADDRESS WORD
	PUSH	P,T2		;SAVE T2
	HRRZ	P3,U		;SAVE THIS UNIT
	PUSHJ	P,ALSTRT	;SET T1 FOR POSSIBLE START-ADR. SPECIFICATION
	  JRST	ENERR3		;CANT START AT SPECIFIED BLOCK (ADR. TOO HIGH)
	CAIN	P3,(U)		;DID WE STAY ON THE SAME UNIT ?
	JRST	CREAL2		;YES
	EXCH	U,P3		;NO, RETURN DA FOR FIRST UNIT
	PUSHJ	P,DWNDA##
	MOVE	U,P3		;POINT AT NEW UNIT
	PUSHJ	P,UPDA##	;GET THE DA FOR THAT ONE
CREAL2:
;HERE WITH T1=START ADR (OR 0), T2=NUMBER OF BLOCKS REQUESTED
	PUSHJ	P,ENTALC	;ALLOCATE SPACE
	  JRST	ENERR4		;CANT START AT SPECIFED BLOCK
	MOVE	T1,ACCALC##(P2)	;AMOUNT OF SPACE ALLOCATED
	CAIL	P1,UUXALC	;IF USER WANTS TO KNOW,
	PUSHJ	P,PUTWDU##	; TELL HIM AMOUNT ALLOCATED
	JRST	CREAL5		;ALLOCATION COMPLETE - CONTINUE
;HERE FOR ALLOCATION ON A 4-WORD ENTER
CREAL4:	HLRZ	T2,UNIGRP(U)	;NUMBER OF BLOCKS TO GET
	SETZ	T1,		;GET THEM ANYWHERE
	PUSHJ	P,ADJALC	;GET SOME SPACE
	  JRST	ENERR2		;NO ROOM -ERROR
	MOVEM	T2,DEVRB2##(F)	;SAVE THE POINTER
	MOVEM	T1,ACCALC##(P2)	;SAVE NUMBER OF BLOCKS ALLOCATED
	MOVEI	P1,UUXPRV	;SET P1 SO PRIVS WORD WILL BE STORED
	AOSA	DEVRET##(F)	;SET DEVRET TO DEVRB2+1

;HERE WHEN ALL ALOCATION IS DONE
CREAL5:	POP	P,T2		;REMOVE GARBAGE FROM PD LIST
	HRLM	U,DEVUNI##(F)	;SAVE  UNIT OF RIB
	PUSHJ	P,DECMST	;DECR ALL A.T. USE COUNTS
				; EXCEPT THE ONE FOR THIS STR
	LDB	T4,UNYLUN##	;LOGICAL UNIT NUMBER
	TRO	T4,RIPNUB##	;MAKE SURE NON-0
	MOVEM	T4,DEVRB1##(F)	;SAVE IN THE DDB
	SETZ	T1,		;WILL SET UP T1
	DPB	T4,UN1PTR##	;SAVE UN1 IN T1
	MOVE	T2,DEVRB2##(F)	;1ST REAL POINTER
	SKIPN	DEVRB2##+1(F)	;ONLY POINTER?
	TRO	T1,ACP1PT##	;YES. LIGHT 1PT BIT
	SETZM	ACCWRT##(P2)	;INDICATE 0 BLOCKS WRITTEN
	HRRM	T1,ACCUN1##(P2)	;SAVE UN1 WORD IN A.T.
	MOVEM	T2,ACCPT1##(P2)	;SAVE 1ST PNTR IN A.T.
	MOVEI	T2,ACPNCK##	; FILE A DIRECTORY, PLUS ALWAYS BAD CHECKSUM
				;(SINCE OTHERWISE EARLIER MONITORS WILL COMPLAIN)
	TLNE	M,UUODIR	;IS IT A DIRECTORY?
	ORM	T2,ACCDIR##(P2)	;YES. SET BITS IN ACC
	TLNE	M,EXTUUO	;EXTENDED ENTER?
	HRRI	M,-<UUXALC-UUXPRV>(M)	;YES. POINT TO PROTECTION WORD
	CAIGE	P1,UUXPRV	;USER SPECIFYING DATE?
	TDZA	T1,T1		;NO, USE NOW
	PUSHJ	P,GETWDU##	;YES, GET TIME,DATE,PROTECTION WORD
	HRLM	T1,P2
	TRNE	T1,-1		;TIME DATE GIVEN?
	JRST	SETEN1		;YES
	MOVE	T2,TIME##	;NO. TIME, DATE =NOW
	IDIV	T2,TICMIN##
	HRR	T1,THSDAT##	;TODAY'S DATE
	DPB	T2,[POINT 11,T1,23]	;STORE TIME IN T2
SETEN1:	MOVSI	T3,777000	;SET TO GET PROTECTION OF OLD FILE (IF ANY)
	AND	T3,ACCPRV##(P2)	;IF NON-0, THIS FILE IS SUPERSEDING
	JUMPN	T3,SETEN4	;DEFAULT PROT=OLD FILE'S PROT IF SUPERSEDE
	MOVE	T3,UFDPRT##	;STANDARD DIRECTORY PROTECTION
	TLNE	M,UUODIR	;A DIRECTORY ?
	JRST	SETEN4		;YES
	LDB	J,PJOBN##	;J WAS WIPED IF I/O WAS DONE
	PUSHJ	P,FNDPDS##	;DEFAULT PROTECTION WAS SPECIFIED BIT
IFN FTFDAE,<
	MOVSI	T2,(PD.FSP)	;FILE DAEMON SPECIFIED PROT BIT
	TDNN	T2,.PDDFL##(W)	;DID THE FILE DAEMON SPECIFY PROT?
	JRST	SETEN2		;NO
	ANDCAM	T2,.PDDFL##(W)	;YES, CLEAR THE BIT
	MOVEI	T3,777000	;GET PROTECTION
	AND	T3,.PDDFL##(W)
	MOVSS	T3		;POSITION TO CORRECT FIELD
	TLZ	T1,777000	;IGNORE WHAT ENTER SAID
	JRST	SETEN4		;SET PROTECTION FIELD
SETEN2:>
	TLNN	F,SYSDEV	;IS DEVICE = SYS?
	JRST	SETEN3		;NO
	HLRZ	T3,DEVEXT(F)	;YES, PROT = <155>
	CAIN	T3,'SYS'	; EXCEPT FOR .SYS FILES
	SKIPA	T3,SYSPRY##	; WHICH ARE <157>
	MOVE	T3,SYSPRT##
	JRST	SETEN4
SETEN3:	MOVSI	T2,(PD.DPS)	;DEFAULT PROTECTION SET BIT
	MOVSI	T3,777000	;MASK TO EXTRACT DEFAULT PROTECTION FROM THE PDB
	TDNN	T2,.PDDFL##(W)	;HAS A DEFAULT PROTECTION BEEN SPECIFIED
	SKIPA	T3,STNPRT##	;NO, USE SYSTEM DEFAULT
	AND	T3,.PDDFL##(W)	;YES, GET USER SPECIFIED DEFAULT

SETEN4:	TLNN	T1,777000	;PROTECTION  ALREADY GIVEN?
	OR	T1,T3		;NO, SET STANDARD PROTECTION
	DPB	S,[POINT 4,T1,12] ;MODE
	PUSH	P,T1		;PROT, MODE, LO CRE-DATE
	HRRI	M,-<UUXPRV-UUXEXT>(M)
	PUSHJ	P,GETWDU##	;ACCESS DATE, HI CRE-DATE
	SKIPGE	DEVSPL(F)
	HRRI	T1,0		;RH(E+1) IS A COUNT IF SPOOLED

	LDB	T2,[POINT 15,T1,35]
	SKIPE	T2		;IF NO ACCESS DATE GIVEN
	CAMLE	T2,THSDAT##	;OR IF GREATER THAN TODAY
	MOVE	T2,THSDAT##	;USE TODAY'S DATE
	DPB	T2,[POINT 15,T1,35] ;SAVE IN USERS AREA
	LDB	T4,[POINT 3,T1,20] ;HIGH PART OF CREATION DATE
	LDB	T3,[POINT 12,P2,17] ;USER-SUPPLIED LOW PART OF CREATION DATE
	DPB	T4,[POINT 3,T3,23]
	SKIPE	T3
	CAMLE	T3,THSDAT##
	MOVE	T3,THSDAT##	;NO CREATION DATE, OR DATE TOO HIGH
	SUB	T2,T3		;ACC DATE - CREATION DATE
	SKIPGE	T2		;IF ACC DATE TOO LOW,
	SUB	T1,T2		; CHANGE IT TO = CREATION DATE
	DPB	T3,[POINT 12,(P),35] ;SAVE LOW CREATION DATE
	LSH	T3,-14
	DPB	T3,[POINT 3,T1,20] ;SAVE HIGH CREATION DATE
	PUSHJ	P,PUTWDU##
	EXCH	T1,(P)
	HRRI	M,UUXPRV-UUXEXT(M)
	CAIL	P1,4		;SAVE PRIVS, LOW CRE-DATE IN USERS AREA
	PUSHJ	P,PUTWDU##	; IF HE ASKED FOR IT
	SETZ	T2,
	XOR	T1,ACCPRV##(P2)	;GET BITS WHICH ARE BEING CHANGED
	TLNE	T1,777000	;CHANGING PROTECTION?
	DPB	T2,DEYFNC##	;YES, FORCE RECOMPUTE OF PRIV'S
	XORB	T1,ACCPRV##(P2)	;STORE NEW VALUE IN ACC
	PUSHJ	P,GTMNBF##	;GET THE MONITOR BUFFER
	MOVE	T2,T1
	HRLI	T1,1(T2)	;SET TO ZERO THE ENTIRE BUFFER
	HRRI	T1,2(T2)
	SETZM	1(T2)
	BLT	T1,200(T2)	;ZERO IT
	MOVE	T3,UNILOG(U)	;NAME OF FIRST UNIT FOR FILE
	MOVEM	T3,RIBDEV##+1(T2)	;SAVE IN RIB
	TLNN	M,EXTUUO	;EXTENDED UUO?
	AOJA	T2,SETEN5	;NO
	HRRI	M,-<UUXPRV-UUXEXT>(M)	;POINT TO ACCESS DATE WORD
	MOVEM	M,(P)		;WIPE OUT DATE, SAVE M ON LIST
	MOVE	T1,DEVPPN(F)	;PPN
	MOVEM	T1,RIBPPN##+1(T2)	;SAVE IN RIB
	HRRI	M,-<UUXEXT-UUXNAM>(M)	;POINT TO NAM WORD
	HRLI	T2,-UUXEXT+1	;SET TO SAVE FIRST FEW VALUES
	PUSHJ	P,GTWST2##	;GET A VALUE
	MOVEM	T1,RIBNAM##+1(T2)	;SAVE IN RIB
	HRRI	M,1(M)		;POINT TO NEXT VALUE
	AOBJN	T2,.-3		;GO GET IT
	PUSHJ	P,SETVAN	;STORE USER-ARGS IN RIB
	POP	P,M
	JRST	SETEN6		;AND CONTINUE

;HERE TO SET UP RIB BLOCK FROM A 4-WORD ENTER
SETEN5:	PUSHJ	P,GTWST2##	;DATE, PROT WORD
	MOVEM	T1,RIBATT##(T2)	;SAVE IN RIB
	POP	P,T1		;GET EXT, DATE
	MOVEM	T1,RIBEXT##(T2)	;SAVE IN RIB
	HRRI	M,-<UUNATT-UUNNAM>(M)	;POINT TO E
	PUSHJ	P,GTWST2##	;GET NAME
	MOVEM	T1,RIBNAM##(T2)	;INTO RIB
	HRRI	M,UUNPPN-UUNNAM(M)	;POINT TO PPN WORD
	MOVE	T1,DEVPPN(F)	;PRJ,PRG NUMBER
	MOVEM	T1,RIBPPN##(T2)	;INTO RIB
	MOVE	T1,DEVSPN##(F)
	SKIPGE	DEVSPL(F)
	MOVEM	T1,RIBSPL##(T2)	;SAVE (POSSIBLE) NAME ENTERED ON A SPOOL-ENTER

	MOVE	T1,.JDAT+.JBVER## ;GET BERSION NUMBER
	SKIPGE	USRHCU##	;IN SAVE COMMAND?
	MOVEM	T1,RIBVER##(T2)	;YES--SAVE VERSION IN RIB



;HERE WHEN THE RIB BLOCK IS SET UP. INSERT CONSTANT VALUES, WRITE IT
SETEN6:	PUSHJ	P,RIBAD##	;COMPUTE ADR. OF RIB
	MOVE	T1,.USMBF	;LOC OF RIB(-1)
	MOVEM	T2,RIBSLF##+1(T1) ;SAVE ADR AS LAST WORD OF RIB
	SETZM	RIBSIZ##+1(T1)	;NUMBER OF WORDS WRITTEN=0
	MOVE	T2,DEVFIL(F)	;SINCE WE MIGHT DEFAULT NAME, EXT
	MOVEM	T2,RIBNAM##+1(T1) ; SET THEM UP FROM THE DDB, WHICH IS RIGHT
	MOVE	T2,DEVEXT(F)
	HLLM	T2,RIBEXT##+1(T1)
	SKIPE	RIBAUT##+1(T1)	;IF NO PRJ,PRG GIVEN
	JRST	SETEN8
	LDB	T3,PJOBN##	;JOB NUMBER
	MOVE	T3,JBTPPN##(T3)	;AUTHORS PRJ,PRG NUMBER
	MOVE	T4,DEVPPN(F)	;DIRECTORY OF FILE
	CAMN	T3,FFAPPN##	;IF AUTHOR IS [1,2]
	CAMN	T4,SPLPPN##	; UNLESS WRITING IN [3,3]
	JRST	SETEN7
	SKIPN	T3,DEVUPP##(F)	;USE IN-YOUR-BEHALF IF THERE
	MOVE	T3,T4		;MAKE AUTHOR = DIRECTORY OWNER
SETEN7:	MOVEM	T3,RIBAUT##+1(T1) ;STORE USERS PRJ,PRG
SETEN8:	MOVEI	T3,CODRIB##	;CODE WORD SHOWING THIS BLOCK IS A RIB
	MOVEM	T3,RIBCOD##+1(T1) ;SAVE IN RIB BLOCK
	MOVE	T2,[XWD MRIBLN##,RIBENT##+1]	;SET UP RIBFIR
	MOVEM	T2,RIBFIR##+1(T1)
	MOVE	T4,ACCALC##(P2)	;AMOUNT OF SPACE ALLOCATED
	MOVEM	T4,RIBALC##+1(T1) ;SAVE IN RIB
	MOVE	T4,ACCPRV##(P2)	;PRIVS, DATE
	MOVEM	T4,RIBPRV##+1(T1) ;SAVE IN RIB
	SETZM	RIBFLR##+1(T1)	;BLOCK 0 STARTS PRIME RIB
	MOVE	T4,RIBEXT##+1(T1) ;ACCESS DATE
	HRLM	T4,ACCADT##(P2)	;SAVE IN ACCESS TABLE
	MOVSI	T4,RIPLOG##	;INDICATE JOB NOT LOGGED OUT
	TLNE	M,UUODIR	;IF A DIRECTORY
	CAIL	P1,UUXSTS	; AND NOT SPECIFYING A STATUS
	SETZ	T4,		;NOT A DIR, OR STATUS GIVEN
	TLNE	M,UUODIR	;DIRECTORY FILE?
	TRO	T4,RIPNCK##	;YES. SET A BIT IN RIBSTS - RIPDIR+RIPABC
				; (RIPABC ELSE EARLIER MONITORS WILL COMPLAIN)
	ORM	T4,RIBSTS##+1(T1)
	MOVSI	T3,DEVRB1##(F)	;SET UP TO BLT POINTERS FROM DDB
	HRRI	T3,RIBENT##+2(T1)	; INTO RIB
	BLT	T3,RIBWN1##+1(T1) ;(THERE MAY BE PTRLEN POINTERS)
	HRRI	M,UUXALC-UUXEXT(M)	;POINT TO ESTIMATED LENGTH
	PUSHJ	P,CHKPAR	;STORE PAOERR IF NEEDED
	MOVE	P3,P1		;SAVE ARGUMENT COUNT
	HRRI	M,-<UUXALC-UUXEST>(M)
	CAIL	P1,UUXEST
	PUSHJ	P,GTWDT3
	CAIL	P1,UUXEST	;SPECIFYING ESTIMATED LENGTH?
	SKIPG	T3
	JRST	SETE14		;NO
	SUB	T3,RIBALC##+1(T1) ;YES. ALREADY HAVE THAT MUCH?
	JUMPLE	T3,SETE14	;YES IF NEGATIVE
	HRRZ	P1,DEVRET##(F)	;NO. GET MORE
	SUBI	P1,DEVRB1##(F)	;COMPUTE NUMBER OF POINTERS
	HRLS	P1
	PUSHJ	P,SPTRW##	;SET T1 TO AN AOBJN WORD FOR POINTERS
	ADD	P1,T1		;SET P1=AOBJN WORD FOR NEW POINTERS
	TLZ	F,OCLOSB	;SO TAKBLK WONT GIVE BLOCKS IF UNITAL LT 0
	MOVE	T2,T3		;NUMBER OF BLOCKS TO GET
	PUSHJ	P,CHKQTA##	;CHECK QUOTA
	SKIPG	P2,T2		;P2=AMOUNT WE CAN GET
	JRST	SETE13		;CANT GET ANY MORE - FORGET IT
;STILL IN FTDALC CONDITIONAL
SETEN9:	PUSHJ	P,SCDCHK##	;SEE IF SCHED WANTS TO RUN ANOTHER JOB
	PUSHJ	P,TAKCHK##	;GET AS LARGE A GROUP AS THERE IS
	  JRST	SETE11		;ON A NEW UNIT
SETE10:	MOVEM	T2,(P1)		;SAME UNIT - SAVE POINTER
	SUB	P2,T1		;SUBTRACT NUMBER OF BLOCKS OBTAINED
	JUMPLE	P2,SETE12	;DONE IF NO MORE TO GET
	MOVE	T2,P2		;NEW AMOUNT TO GET
	AOBJN	P1,SETEN9	;GO TRY AGAIN
	JRST	SETE12		;NO MORE POINTER SLOTS IN RIB - DONE
SETE11:	JUMPE	T3,SETE12	;STR FULL IF T3=0
	MOVEM	T3,(P1)		;SAVE UNIT-CHANGE IN RIB
	AOBJN	P1,SETE10	;STORE REAL POINTER IN RIB
	MOVEM	T2,-1(P1)	;NO ROOM - DELETE UNIT CHANGE, SET UP TO
	SUBI	P1,1		; GIVE BACK THE BLOCKS JUST OBTAINED
	PUSHJ	P,DELRIB	; SINCE ONLY 1 PNTR SLOT LEFT
	  STOPCD .+1,DEBUG,DNR,	;++DELRIB NON-SKIP RETURN
SETE12:	MOVE	P2,DEVACC##(F)
	TRZ	S,IOBKTL	;MAKE SURE IOBKTL OFF
	MOVE	T1,.USMBF	;LOC OF MONITOR BUFFER
	MOVEI	T3,ACP1PT##	;CLEAR THE 1PT BIT
	ANDCAM	T3,ACC1PT##(P2)	; IN THE A.T.
	MOVE	T3,ACCALC##(P2)	;NO OF BLOCKS ALLOCATED
	MOVEM	T3,RIBALC##+1(T1) ;SAVE IN RIB
	HRRI	M,UUXALC-UUXEST(M) ;POINT TO ALLOCATION WORD
	MOVE	T1,T3
	CAIL	P3,UUXALC	;IF .RBCNT .LE. .RBALC, DON'T RETURN .RBALC
	PUSHJ	P,PUTWDU##	;TELL USER THE FINAL RESULT
SETE13:	HRROI	P1,DEVRBN##(F)	;PREPARE TO SET DEVRET=DEVRBN
	HRRI	M,-<UUXALC-UUXEST>(M)	;POINT BACK AT EST LENGTH

SETE14:	PUSHJ	P,SETUFR	;SET RIBUFD IN RIB
	MOVE	T2,DATE##	;INTERNAL CREACTION TIME, DATE
	MOVEM	T2,RIBTIM##+1(T1); INTO RIB
	MOVE	T2,[XWD MACTSL##,RIBACS##]
	MOVEM	T2,RIBACT##+1(T1)	;STORE AOBJN POINTER TO ACCOUNT STRING
	JUMPGE	T2,SETE18	;GO IF 0-LENGTH ACCT STRING
	ADDI	T2,1(T1)	;AOBJN WORD FOR ACCT-STRING IN RIB
	PUSH	P,M		;SAVE POINTER
	PUSH	P,DEVUPP##(F)
	SETZM	DEVUPP##(F)	;ALLOW PRIVS HERE
	CAIL	P3,UUXACT	;IF NO STRING SPECIFIED,
	PUSHJ	P,PRVJB##	; OR IF NOT A PRIV'D JOB
	  JRST	SETE16		;GET STRING FROM PDB
	HRRI	M,UUXACT-UUXEST-1(M) ;POINT TO STRING DATA IN ENTER BLOCK
	SUBI	P3,UUXACT	;NO. OF ARGS TO GET
SETE15:	HRRI	M,1(M)		;ADVANCE TO NEXT ARGUMENT
	PUSHJ	P,GTWST2##	;GET AN ARGUMENT
	JUMPE	T1,SETE16	;DONE (OR USE PDB) IF 0
	MOVEM	T1,(T2)		;SAVE IN RIB
	AOBJP	T2,SETE17	;DONE IF RIB FULL
	SOJE	P3,SETE17	;DONE IF NO MORE VALUES
	JRST	SETE15		;GO GET ANOTHER ARG FRO USER
SETE16:	HLRZ	T3,DEVEXT(F)	;IF A UFD
	TLC	T2,MACTSL##	;OR WE ALREADY STORED AT LEAST 1 FROM BLOCK
	TLNN	T2,-1		; AND THEN TERMINATED ON A 0
	CAIN	T3,'UFD'
	JRST	SETE17		;THEN WE'RE DONE
	HRLI	T2,.PDACS##(W)	;DEFAULT CASE - BLT ACCT. STRING
	MOVE	T3,T2		; FROM PDB TO RIB
	BLT	T2,ACTSTL##-1(T3)
SETE17:	MOVE	T1,.USMBF	;RESTORE T1
	POP	P,DEVUPP##(F)
	POP	P,M		;RESTORE POINTER
SETE18:	MOVE	T2,RIBSLF##+1(T1) ;RESTORE RIB ADDRESS
	HLRZ	U,DEVUNI##(F)	;RESET U TO UNIT OF RIB
	PUSHJ	P,MONWRT##	;WRITE THE RIB
SETE19:	HRRZ	T3,DEVACC##(F)	;LOC OF THE A.T.
	JUMPE	T3,CPOPJ##	;LOSE IF UNIT REMOVED
	TLO	S,IO		;INDICATE WRITING
	PUSHJ	P,AT2DDB##	;SET UP DEVBLK,DEVREL, ETC FROM A.T. DATA
	  STOPCD .,JOB,UPC,	;++UNIT-CHANGE POINTER CLOBBERED
	MOVEI	T2,1		;INDICATE AT RELATIVE POINTER 1
	DPB	T2,DEYRLC##	;(0 IS THE UNIT N0, NOT NOW N DDB)
	SKIPGE	P1		;POINTERS IN RIB WHICH AREN'T IN DDB?
	HRRM	P1,DEVRET##(F)	;YES, SET DEVRET=DEVRBN SO RIB WILL
				; BE READ BEFORE ALLOCATION IS DONE
ENTXIT:	TLZ	F,OCLOSB	;TURN OFF OCLOSB IN CASE OF PARTIAL ALLOCATION
	PUSHJ	P,JDAADR##
	TLNN	M,UPARAL	;PARTIAL ALLOCATION ONLY?
	JRST	ENTXI1		;NO
	HRRI	M,-<UUXALC-UUXEXT>(M)	;ADJUST
	TLOA	F,ENTRB		;YES. SET FOR NON-SKIP RETURN
ENTXI1:	AOSA	(P)		;NO. SKIP(GOOD) RETURN
	HLLM	F,(T1)		;UUOCON DOESN'T STORE F ON AN ENTER ERROR RETURN
CLRSRB:	TLZ	S,IOSRIB	;RIB IS NO LONGER IN MON BUFFER
	JRST 	STRIOS##	;SAVE S AND RETURN TO USER
;HERE WHEN THE ENTER IS AN UPDATE (LOOKUP ALREADY DONE)
UPDATE:	PUSHJ	P,SAVE3##
	PUSHJ	P,CLSNAM	;IN CASE OF RENAME
	HRRZ	U,DEVUNI##(F)	;SET UP U
	TLZ	M,UUOMSK	;ZERO MEANINGFUL BITS IN UUO
	TLO	M,UUOUPD	;INDICATE UPDATE
	PUSHJ	P,SETLE1	;CHECK FOR EXTENDED UUO, OK NAME
	  JRST	UILNMR		;ZERO NAME - ERROR
	PUSHJ	P,GETWDU##	;GET NAME
	HRRZ	P1,DEVLNM##(F)	;GET THE LOGICAL NAME POINTER IF ANY
	CAMN	T1,DEVFIL(F)	;SAME AS LOOKED-UP NAME?
	JRST	UPDAT0		;YES, GO ON.
	JUMPE	P1,UILNMR	;FILNAME MISMATCH IF NO LOGICAL NAME POINTER
	SKIPE	T1,LNRNAM##(P1)	;SO FAR SO GOOD.  ANY FILENAME?
	CAME	T1,DEVFIL(F)	;YES. SAME AS LOOKED UP NAME?
	JRST	UILNMR		;NO. ERROR
UPDAT0:	HRRI	M,UUNEXT-UUNNAM(M)	;YES. POINT TO EXTENSION
	PUSHJ	P,GETWDU##	;SUPPLIED EXTENSION
	MOVE	P3,T1
	TRZ	T1,-1
	HLLZ	T2,DEVEXT(F)	;LOOKED-UP EXT
	HRRI	M,-1(M)		;BUMP FOR BELOW
	MOVE	T3,DEVLIB##(F)	;IF THE FILE WASN'T IN UFD, BUT IN LIB
	TLNN	T3,DEPLIB##	; MAKE UPDATE ILLEGAL
	CAMN	T1,T2		;MATCH?
	JRST	UPDA0A		;YES, SKIP THIS
	JUMPE	P1,UILNMR	;ERROR IF NO LOGICAL NAME TO LOOK AT
	HLL	P3,LNREXT##(P1)	;GET THE LOGICAL'S EXTENSION
	HLLZ	T1,P3		;COPY IT
	CAME	T1,T2		;MATCH?
	JRST	UILNMR		;NO. ERROR
UPDA0A:	HRRI	M,UUNPPN-UUNEXT+1(M)	;POINT TO PRJ,PRG
	TLNE	M,EXTUUO	;EXTENDED UUO?
	HRRI	M,-<2+UUXEXT-UUXPPN>(M)	;YES,
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	HRRZ	T2,ACCPPB##(T2)	;LOC OF PPB
	MOVE	T2,PPBNAM##(T2)	;PRJ,PRG OF LOOKED-UP FILE
	PUSHJ	P,GTWST2##	;PPN GIVEN?
	JUMPE	T1,UPDAT2	;NO PPN IF T1=0
	TLNE	T1,-1		;POINTER TO A PATH?
	JRST	UPDAT1		;NO
	PUSH	P,M		;YES, SAVE M
	HRRI	M,2(T1)		;POINT TO PPN WORD IN PATH
	PUSHJ	P,GTWST2##	;GET PPN
	POP	P,M
	JUMPE	T1,UPDAT2	;SAME PPN IF 0
UPDAT1:	CAMN	T1,T2		;PPN'S MATCH?
	JRST	UPDAT2		;YES, EVERYTHING'S COOL
	JUMPE	P1,UPDERY	;WE'RE IN TROUBLE IF NO LOGICAL NAME HERE
	SKIPE	T1,LNRPPN##(P1)	;IS THERE A PPN IN THIS LOGICAL?
	CAME	T1,T2		;YES, PPN'S MATCH?
	JRST	UPDERY		;NO, ISU ERROR
;HERE WHEN THE NAME, EXTENSION AND PRJ,PRG AGREE WITH THE LOOKED-UP FILE
UPDAT2:	PUSHJ	P,GETCB##	;GET CB RESOURCE
	PUSHJ	P,TSTSFD	;%DON'T ALLOW UPDATE OF DIRECTORY
	  JRST	UPDER9
	MOVEI	T1,FNCAPP##	;%CHECK TO SEE IF APPEND IS LEGAL
	PUSHJ	P,CHKPRV##
	  JRST	UPDER9
	HRRZ	T1,DEVACC##(F)	;%OK, LOC OF A.T.
	MOVE	T2,ACCNDL##(T1)	;%IS THIS A MAGIC FILE?
	TRNE	T2,ACPNDL##
	JRST	UPDER9		;%YES, IT CAN'T BE UPDATED
	MOVE	T1,ACCSTS##(T1)	;%STATUS
	TRNE	T1,ACPDEL##	;%MARKED FOR DELETION?  (IF SO, ANOTHER JOB
	JRST	UPDER5		;%DID A SUPERSEDE BEFORE THIS ENTER)
	PUSHJ	P,TSTWRT	;%TEST IF WRITING IS ALLOWED
	  JRST	UPDER7		;%NO, GIVE FILE-BEING-MODIFIED ERROR
	MOVEI	T1,FNCCAT##	;%CAN USER CHANGE ATTRIBUTES?
	SETZ	P2,
	PUSHJ	P,CHKPRV##
	  SETO	P2,
IFN FTFDAE,<
	PUSHJ	P,TSTWRT	;%FILE STILL WRITABLE?
	  JRST	UPDER7		;%NO, FILDAE MUST HAVE BLESSED 2 AT ONCE
>
	MOVEI	T2,ACPUPD	;%INDICATE THIS FILE BEING UPDATED
	MOVE	T3,DEVACC##(F)	;%
	HLL	T3,DEVJOB(F)	;%SIM UPDATE BIT
	TLNE	T3,DEPSIM	;%DDB ENABLED FOR SIM UPDATE?
	TRO	T2,ACPSMU	;%YES, FILE IS SIM UPDATE
	MOVSI	T1,ACPWCT##	;%INCREMENT WRITE COUNT
	ADDM	T1,ACCWCT##(T3)	; %EVEN FOR NON- SIM UPDATE FILES

	ORM	T2,ACCSTS##(T3)	;%
	PUSHJ	P,INCUC		;%INCR NMB, PPB USE-COUNTS
	PUSHJ	P,GVCBJ##	;%GIVE UP CB RES
	PUSHJ	P,WAIT1##
	TLNE	S,IOSWLK	;IS FILE (STR) WRITE LOCKED?
	JRST	CPOPJ1##	;YES. TAKE GOOD RETURN (DON'T CHANGE RIB)
	PUSHJ	P,DDBZR		;ZERO POINTERS IN CASE OF EXTENDED RIB
	TLNN	M,EXTUUO	;NO. EXTENDED ENTER?
	JRST	UPDER1		;NO
	HRRI	M,-UUXPPN(M)	;YES. POINT TO E
	HLRZ	U,DEVUNI##(F)	;SET U TO UNIT OF RIB
	PUSHJ	P,GETWDU##	;NUMBER OF ARGS/VALUES
	TRZ	T1,RB.BIT	;IGNORE NOISE BITS
	MOVE	P1,T1
	HRRI	M,UUXALC(M)	;POINT TO ALLOCATION WORD
	CAIL	P1,UUXALC
	PUSHJ	P,GETWDU##	;GET IT
	CAIL	P1,UUXALC	;SPECIFYING ALLOCATION?
	SKIPGE	T2,T1
	JRST	UPDER2		;NO. TAKE GOOD RETURN
	JUMPN	T1,UPDAT3	;SPECIFIED .RBALC IN ARGUMENT BLOCK?
	HRRI	M,-1(M)		;NO, POINT TO .RBEST
	PUSHJ	P,GETWDU##
	HRRI	M,1(M)		;PUT M BACK TO WHAT IT WAS
	SKIPN	T2,T1		;SPECIFIED .RBEST?
	JRST	UPDER2		;NO, TAKE GOOD RETURN
	MOVE	T3,DEVACC##(F)
	SUB	T2,ACCALC##(T3)	;HOW BIG IS THE FILE NOW?
	JUMPLE	T2,UPDER2	;IT'S ALREADY BIGGER THAN .RBEST, RETURN
	TLO	M,UALASK	;INDICATE ALLOCATION
	PUSHJ	P,UPDALC	;ADD MORE BLOCKS AT END OF FILE
	 JRST	UPDER2		;QUOTA EXCEEDED, RETURN ANYWAY
	  JRST	UPDER2		;BLOCK NOT FREE, RETURN ANYWAY
	TLZ	M,UPARAL	;DO NOT GIVE PARTIAL ALLOCATION FAILURE
	JRST	UPDAT4		;GO WRITE SATS
UPDAT3:	MOVE	T3,DEVACC##(F)
	SUB	T2,ACCALC##(T3)	;N-J
	JUMPLE	T2,DELGRP	;TRUNCATING IF NEGATIVE
				;CANT GET HERE FOR SIMULTANEOUS UPDATE,
				;SINCE LOOKUP STORES REAL ACCALC IN ENTER BLOCK
	TLO	M,UALASK	;INDICATE SPECIFYING ALLOCATION
	PUSHJ	P,UPDALC	;ADD MORE BLOCKS TO FILE
	 JRST	ENERR7		;QUOTA EXCEEDED
	  JRST	ENERR1		;COULDN'T START WHERE REQUESTED (E+11)
UPDAT4:	PUSHJ	P,WTUSAT
	SKIPL	DEVRIB##(F)	;EXTENDED RIB?
	JRST	UPDAT5		;NO
	PUSHJ	P,SPTRW##	;SETUP TO WRITE NEW POINTERS
	PUSHJ	P,PTRWRT##	;WRITE OUT DDB RETRIEVAL POINTERS
	PUSHJ	P,DDBZRO	;MAKE SURE UPDFIN DOESN'T SCREW UP
UPDAT5:	TLOE	S,IOSRIB	;ALREADY HAVE RIB IN CORE?
	JRST	UPDER3		;YES
	PUSHJ	P,PTRGET##	;NO, READ RIB INTO CORE
	PUSHJ	P,UPDSET	;ADJUST DEYRLC FOR CURRENT POSITION
	JRST	UPDER3		;AND CONTINUE
;SUBROUTINE TO SEE IF WRITING A FILE IS ALLOWED
;ENTER WITH DEVACC SET UP
;EXIT CPOPJ IF FILE ALREADY BEING WRITTEN
;EXIT CPOPJ1 IF OK TO WRITE
TSTWRT:	PUSHJ	P,GETNMB	;%GET LOC OF NMB
	MOVE	T3,ACCSTS##(T2)	;%STATUS OF DDB'S A.T.
	TRNE	T3,ACPDEL##	;%MARKED FOR DELETION?
	POPJ	P,		;%YES CANT RENAME OR UPDATE
	LDB	T2,ACYFSN##	;%STR NO IN T2

	EXCH	T1,T2		;%T=FSN, T2=LOC OF NMB
	TRO	T2,DIFNAL##	;%ADD OFFSET FOR NMBACC
TSTWR1:	PUSHJ	P,BYTSC1##	;%FIND AN A.T. FOR THIS STR
	  SKIPA	T3,ACCSTS##(T2)	;%FOUND - GET STATUS
	JRST	CPOPJ1##	;%NO MORE - UPDATE IS LEGAL
	TRNN	T3,ACPUPD!ACPSUP!ACPREN	;%FILE BEING WRITTEN?
	JRST	TSTWR1		;%NO, LOOK FOR MORE A.T.'S
	TRNN	T3,ACPSUP!ACPREN ;%BEING SUPERSEDED OR RENAMED?
	TRNN	T3,ACPSMU	;%NO, OPEN FOR SIM UPDATE?
	POPJ	P,		;%ERROR IF NOT UPDATE ON SIM UPDATE FILE
	MOVE	T3,DEVJOB(F)	;%SIM UPDATE FILE,
	TLNE	T3,DEPSIM	;%DDB IN SIM UPDATE MODE?
	TLNN	M,UUOUPD	;%AND AN UPDATE UUO?
	POPJ	P,		;%NOT SIM UPDATER OR RENAME UUO
	JRST	CPOPJ1##	;%SIM UPDATE FILE AND DDB - OK



;HERE ON 4-WORD UPDATE   SET UP SIZE IN E+3
UPDER1:	PUSHJ	P,WRDCNT	;STORE WRDCNT IN E+3
	PUSHJ	P,SIMRIB	;GET FA, IF SIM UPDATE, THEN READ RIB
	  JRST	ENERR6		;RIB ERROR
	PUSHJ	P,UPDAUT	;UPDATE RIBAUT
	  JRST	UPDFN1		;RIBAUT DIDN'T CHANGE - LEAVE RIB ALONE
	PJRST	UPDFIN		;REWRITE RIB AND TAKE GOOD RETURN
;SUBROUTINE TO UPDATE RIBAUT
;ENTER WITH RIB IN MONITOR BUFFER
;EXIT CPOPJ IF RIBAUT DIDN'T CHANGE
;EXIT CPOPJ1 IF IT DID, RIBAUT UPDATED
UPDAUT:	LDB	T1,PJOBN##	;JOB NUMBER
	MOVE	T1,JBTPPN##(T1)	;IF [1,2] IS UPDATING IN [3,3],
	MOVE	T2,DEVPPN(F)
	CAMN	T1,FFAPPN##
	CAME	T2,SPLPPN##
	SKIPA	T2,.USMBF
	POPJ	P,		;DON'T CHANGE RIBAUT
	CAMN	T1,RIBAUT##+1(T2)	;RIBAUT CHANGING?
	POPJ	P,		;NO
	MOVEM	T1,RIBAUT##+1(T2)	;YES, STORE NEW VALUE
	PJRST	CPOPJ1##	;AND SKIP-RETURN

;SUBROUTINE TO INCREMENT NMB, PPN USE-COUNTS
;PRESERVES T2
INCUC:	MOVE	T1,DEVACC##(F)
	MOVE	T3,ACCPPB##(T1)	;%LOC OF PPB
	AOS	PPBCNT##(T3)	;%BUMP COUNT
	HLRZ	T1,ACCNMB##(T1)
	TRZN	T1,DIFNAL##	;%FIND NMB
	JRST	.-2
	AOS	NMBCNT##(T1)	;%BUMP ITS COUNT
	POPJ	P,		;%AND RETURN
;HERE WHEN ALL ALLOCATION IS DONE. SET VALUES INTO USER AREA
UPDER2:	PUSHJ	P,SIMRIB	;GET FA IF SIM UPDATE, READRIB
	  JRST	UPDFN2		;RIB ERROR

UPDER3:	PUSHJ	P,UPDAUT	;UPDATE RIBAUT
	  JFCL
	SKIPGE	P2		;IF USER HASN'T GOT PRIVS TO CHANGE ATTS.
	TLO	M,400000	; SET A FLAG
	PUSHJ	P,SETVAL	;YES, STORE USER-SUPPLIED VALUES INTO THE RIB
	TLZ	M,400000
	MOVE	T1,.USMBF
	CAIE	P1,3		;DID USER SPECIFY 3-WORD BLOCK?
	 JRST	UPDER4		;NO, USE HIS CREATION DATE
	TRNN	P3,700000	;DID HE SPECIFY BITS?
	 IOR	P3,RIBEXT##+1(T1) ;NO, GET THEM FROM THE RIB.
UPDER4:	TRNN	P3,77777	;USER SUPPLIED HI CREATION DATE
	IOR	P3,THSDAT##	;SUPPLY ACCESS DATE IF 0
	HRRM	P3,RIBEXT##+1(T1) ;SAVE IN RIB
	HRRZ	T2,DEVACC##(F)	;GET THE ACCESS TABLE POINTER
	MOVE	T3,RIBPRV##+1(T1)	;GET THE PRIVS WORD
	MOVEM	T3,ACCPRV##(T2)	;STORE IN THE AT
	HRRZ	T3,RIBEXT##+1(T1)	;GET THE ACCESS DATE, HI CREATION DATE
	HRLM	T3,ACCADT##(T2)	;STORE IN THE AT

;HERE WHEN ALL NON-POINTER INFO IS STORED IN RIB
UPDFIN:	PUSHJ	P,SPTRW##	;SET UP AN AOBJN WORD FOR THE PTRS IN THE MON BUF
	PUSHJ	P,PTRWRT##	;COPY POINTERS INTO MON BUF AND WRITE
UPDFN1:	PUSHJ	P,DWNIFA##	;IF HAVE FA, RETURN IT NOW THAT RIB IS WRITTEN
	SOS	T1,DEVREL##(F)	;SAVE DEVREL
	TLNE	T1,-1		; FOR POSSIBLE USETO -1
	SETZ	T1,		;OPPS! LARGER THAN 2**18
	HRLM	T1,DEVLRL##(F)
	PUSH	P,DEVRSU##(F)
	PUSHJ	P,CPYFST##	;SET UP FIRST DDB NUMBERS (DEVBLK, ETC)
	  JFCL			;SHOULD NEVER HAPPEN
	POP	P,DEVRSU##(F)
	PUSHJ	P,GETCPY
UPDFN2:	PJRST	ENTXIT		;AND EXIT THE UUO
;SUBROUTINE TO GET IN-CORE COPY SPACE AND LINK IT IN
GETCPY:	MOVEI	T2,PTRCOR##	;WORDS NEEDED
	PUSHJ	P,GETWDS##	;GET SOME SPACE FOR POINTERS
	  POPJ	P,		;NONE AVAILABLE, FORGET IT
	HRRM	T1,DEVCPY##(F)	;SAVE THE SPACE
	HRRZ	T3,DEVACC##(F)	;POINT COPY TO ACCESS TABLE
	HRRM	T3,PTRAT##(T1)	; FOR IDENTIFICATION
	DDBSRL			;INTERLOCK THIS STUFF
	MOVE	T2,SYSPTR##	;INSERT THIS COPY AT FRONT OF LIST
	HRLM	T1,SYSPTR##
	HLLM	T2,PTRSYS##(T1)	;POINT THIS ONE AT FORMER FIRST
	DDBSRU			;UNLOCK
	PJRST	CPYPTR##	;STUFF POINTERS INTO SPACE WE GOT, RETURN

;HERE TO RETURN SOME BLOCKS ON AN UPDATE ENTER
DELGRP:	JUMPE	T2,UPDER2	;NO ALLOCATION IF T2=0  - FINISH UP
	MOVE	T2,ACCCNT##(T3)	;NUMBER OF READERS
	TRNE	T2,ACMCNM##	;IF MORE THAN 1 READER,
	JRST	UPDER6		; CANT TRUNCATE FILE (SECURITY RISK -
				; THE BLOCKS MAY BE REUSED FOR ANOTHER FILE)
	PUSHJ	P,PTRGET##	;READ RIB INTO MON BUFFER
	PUSHJ	P,GTWDT3	;GET LAST GOOD BLOCK
	MOVEI	T2,0		;RIB STARTS AT BLOCK 0
DELLUP:	PUSHJ	P,SCNPTR##	;FIND THE RIGHT POINTER
	  JRST	DELGP1		;;NOT HERE, LOOK AT OTHER RIBS
	PUSH	P,DEVRIB##(F)	;SAVE POINTER TO CURRENT RIB
	PUSHJ	P,UPDGV9	;GIVE UP SOME BLOCKS
	  JRST	UPDER8		;PRIVS WONT ALLOW IT - ERROR RETURN
	POP	P,T1		;RESTORE PREVIOUS DEVRIB
	CAME	T1,DEVRIB##(F)	;SKIP IF UPDGIV DID NOT MOVE INTO ANOTHER RIB
	JRST	DELG0A		;IF ANOTHER RIB, PREVIOUS CURRENT RIB ALREADY WRITTEN

;DEALLOCATION IS COMPLETE - FINISH UP
	MOVE	T1,.USMBF	;LOC OF MON BUF (-1)
	PUSHJ	P,WRTRIB##	;GO WRITE NEW RIB
	SKIPL	DEVRIB##(F)	;PRIME RIB IN CORE?
	JRST	DELG0B		;YES, PROCEED
DELG0A:	PUSHJ	P,REDRIB##	;READ THE PRIME RIB INTO CORE
	  JRST	UPDFN2		;ERROR READING RIB

DELG0B:	PUSHJ	P,WTUSAT	;WRITE CHANGED SAT
	JRST	UPDER3		;AND FINISH UP


;HERE TO LOOK AT OTHER RIBS
DELGP1:	PUSHJ	P,PTRNXT##	;GET NEXT RIB, IF ANY
	  STOPCD .,JOB,NNR,	;++NO NEXT RIB
	PUSHJ	P,GETALC##	;GET REAL ACCALC (BASED ON THE EXTENDED RIB)
	PUSHJ	P,GTWDT3	;GET LAST GOOD BLOCK
	SUB	T1,T3		;BLKS IN FILE - HIS ARGUMENT
	JUMPLE	T1,UPDER2	;NOT REALLY TRUNCATING IF NON-POS
	MOVE	T2,.USMBF	;IOWD FOR MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T2) ;FIRST BLOCK NUMBER IN CURRENT RIB
	PUSHJ	P,SPTRW##	;SET UP AOBJN WORD TO POINTERS IN T1
	JRST	DELLUP		;SCAN THIS RIB
SUBTTL	LOOKUP/ENTER SETUP (INCLUDING SFD PATHS)
;SUBROUTINE TO SET UP FOR LOOKUP, ENTER
;RETURNS WITH EXTUUO ON IN LH(M) IF EXTENDED UUO, AND M POINTING TO PRJ,PRG NO.
;RETURNS P3= ORIGINAL LOOKUP NAME, P4=ORIGINAL EXT (LH=-1 IF /OVERRIDE)
;SETS UP DEVPPN ON RETURN
;ON ERROR RETURN, IF UUOREN IS ON, THE ERROR CODE IS IN T1
;	M WILL POINT TO THE FILE NAME WORD
SETLER:	TLZ	M,UUOMSK	;ZERO BITS IN LH(UUO)
	TLZ	S,IOSPBF+IOSERR## ;MAKE SURE PERMANENT ERR BITS ARE OFF
	SETZM	DEVFIL(F)	;FOR SET WATCH FILE

IFN FTFDAE,<
	PUSHJ	P,CHKFCU	;CHECK IF AT COUNT IS UP FROM FILDAE
>
SETLE1:	PUSHJ	P,GETWDU##
	SETZ	T2,		;SET TO ZERO PROTECTION BYTE
	DPB	T2,DEYFNC##	;IN CASE OF LOOKUP WITH NO PRECEDING CLOSE
	DPB	T2,DEYFSN##	;IN CASE OF ENTER WITH NO PRECEDING CLOSE
	MOVSI	T2,DEPDSL##+DEPAUL##+DEPNLB## ;CLEAR BITS LEFT FROM PREVIOUS UUO
	ANDCAM	T2,DEVLLE##(F)
	MOVEI	T2,DEPECS	;CLEAR NO-SUPERSEDE BIT IN DDB
	SKIPL	DEVJOB(F)
	ANDCAM	T2,DEVSPL(F)
IFN FTKL10&FTMP,<
	SETZM	DEVNBF(F)	;CLEAR COUNTERS OF BUFFERS SWEPT FOR
	SETZM	DEVSBF(F)
>
	TLNN	T1,-1		;NAME?
	JUMPN	T1,SETL11	;NO, MUST BE EXTENDED UUO
SETLE2:	TLNE	M,UUOUPD	;UPDATE?
	JRST	CPOPJ1##	;YES. GOOD RETURN
	MOVE	P3,T1		;ORIGINAL NAME FROM LOOKUP BLOCK
	PUSHJ	P,GETWD1##	;GET EXTENSION
	HLRZ	P4,T1		;SAVE IN P4
	LDB	J,PJOBN##

	SETZM	DEVPPN(F)	;START WITH DEVPPN=0
	SETZM	DEVSFD##(F)	;MAKE SURE START AT UFD
	PUSH	P,M		;SAVE M
	HRRI	M,UUNPPN-UUNEXT(M) ;POINT TO PPN WORD
	TLNE	M,EXTUUO
	HRRI	M,-<3+UUXNAM-UUXPPN>(M)
	MOVE	T1,DEVNAM(F)
	PUSHJ	P,SDVTST	;IS THIS AN ERSATZ DEVICE?
	  JRST	SETLE3		;NO, CARRY ON
	CAIE	T2,LIBNDX##	;YES, IS IT A LOGICAL NAME?
	JRST	SETLE3		;NO
	MOVE	T1,@.USLNM	;YES, POINT AT THE START
	ADDI	T1,LNMDEV##-LNRDEV##
	HRRZM	T1,DEVLNM##(F)	;SAVE IN DDB
	TLNE	T1,LNPOVR##	;OVERRIDE?
	TLO	P4,-1		;YES, SET P4 NEGATIVE
	PUSHJ	P,NXTSP3	;GO GET FIRST SPEC IN LOG NAME
	  CAIA
	JRST	SETLE9		;NOT THERE, ERROR RETURN
	PUSHJ	P,GETWDU##	;GET PPN
	CAME	T1,MFDPPN##	;IS PPN [1,1]?
	JRST	SETL99		;NO
	MOVEM	T1,DEVPPN(F)	;YES, OVERIDE THE IMPLIED PPN
	PUSHJ	P,SFDDEC	;AND WIPE THE SFD (IF ANY)
	PUSHJ	P,DECSFD
	SETZM	DEVSFD##(F)
SETL99: MOVE	T1,DEVPPN(F)
	PUSHJ	P,PUTWDU##	;TELL USER THE PPN
	JRST	SETLE5
SETLE3:	JUMPE	P3,MPOPJ##	;IF NO LOG NAME, LOOKUP 0 IS ILLEGAL
	PUSHJ	P,GTWDT3	;IS IT IS XWD 0,ADR?
	SKIPLE	T2,T3
	TLNE	T2,-1
	JRST	SETLE4		;NO, PATH NOT GIVEN
	HRR	M,T2		;YES, POINT M TO PATH LIST
	SETOM	DEVFIL(F)	;MAKE SURE A 1ST SFD NAME OF 0 DOESN'T SCAN FOR A UFD
	PUSHJ	P,SETPT2	;FIND THE SFD HE WANTS
	  JRST	SETLE9		;NO SEARCH LIST OR NO SFD
	MOVE	J,.CPJOB##	;PARANOIA
SETLE4:	MOVEM	P3,DEVFIL(F)	;SAVE NAME IN DDB
	HRLM	P4,DEVEXT(F)	;SAVE EXT IN DDB
SETLE5:	POP	P,M		;RESTORE M
	HRRZ	T1,P4		;GET EXT ALONE
	CAIN	T1,(SIXBIT .SFD.) ;IS THE FILE AN SFD?
	TLO	M,UUODIR	;YES, SET UUODIR IN M
	HRRI	M,UUNPPN-UUNEXT-1(M)	;POINT TO PRJ, PRG WORD
	TLNE	M,EXTUUO	;EXTENDED UUO HAS PRJ,PRG
	HRRI	M,-<2+UUXEXT-UUXPPN>(M)	; IN WORD 1
	SKIPLE	DEVPPN(F)	;PRJ,PRG ALREADY SET UP?
	AOJA	M,CPOPJ1##	;YES, PATH WAS SPECIFIED. RETURN
	PUSHJ	P,PPNPP0	;GET PPN
	CAMN	T2,MFDPPN##	;LOOKING FOR [1,1]?
	MOVE	T1,T2		;YES, DONT USE IMPLIED PPN
	MOVEM	T1,DEVPPN(F)	;SAVE PPN IN DDB
	PUSHJ	P,PUTWDU##	;TELL USER THE PPN
	TLNE	F,SYSDEV	;IS THIS SYS:?
	JRST	CPOPJ1##	;YES, GOOD RETURN
	SKIPN	T3		;USE DEFAULT DIR?
	CAME	T1,T4		;YES, WRITING IN DEFAULT PPN?
	JRST	CPOPJ1##	;NO, USE UFD
	PUSHJ	P,SFDPPN
	HRRM	T2,DEVSFD##(F)	;YES, SAVE NEW PATH
	DPB	T3,DEYSCN##	;SAVE SCAN SWITCH
	SKIPN	T1,T2		;IS THE DEFAULT AN SFD?
	PJRST	CPOPJ1##	;NO, GOOD RETURN
	PUSHJ	P,SFDUP
	PUSHJ	P,INCALL	;YES, INCREMENT A.T.'S(INSURANCE FROM CORE-GRABBER)
	PUSHJ	P,SAVE3##
	MOVE	P3,NMBYES##(T1)	;P1=YES BITS
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  POPJ	P,		;NULL SL. WILL BE CAUGHT ELSEWHERE
	MOVE	P1,T1
	MOVE	P2,T1		;P2=SL.PTR.
SETLE6:	PUSHJ	P,SLITA##	;NEXT STR IN SEARCH LIST
	  JRST	SETLE7		;END OF LIST, SFD WASN'T FOUND
	PUSHJ	P,FSNPS2##	;POSITION BIT FOR YES WORD
	TDNE	T2,P3		;DOES SFD EXIST IN THIS STR?
	JRST	[		;YES-GIVE UP TEMP.SL.(IF ANY) AND RETURN
		MOVE	P2,P1
		AOS	(P)
		PJRST	SLGVT##
		]
	JRST	SETLE6		;NO, TRY NEXT STR

;HERE WHEN THE SFD DOESN'T EXIST IN THE SEARCH LIST
SETLE7:	MOVE	P2,P1		;GIVE UP POSSIBLE TEMP SL.
	PUSHJ	P,SLGVT##
	HRRI	M,-<UUNPPN-UUNEXT+1>(M)
	TLNE	M,EXTUUO
	HRRI	M,2+UUXEXT-UUXPPN(M)	;POINT M TO EXT, ERROR CODE WORD
	MOVE	T1,DEVSFD##(F)	;DECR. USE-COUNTS
	PUSHJ	P,DECALL
	PUSHJ	P,SFDDEC
	TLO	M,UUOREN	;FLAG TO USE ERROR IN T1
	ADDI	M,UUNEXT	;ACCOUNT FOR LATER SUBI
	JRST	SETL10		;AND GIVE SFD-NOT-FOUND ERROR RETURN
;HERE ON ERROR RETURN FROM SETPT3
;IF THIS CODE IS EXECUTED FROM THE RENAME CODE, THE ERROR
;MUST BE PLACED INTO THE USER'S AREA BY THIS ROUTINE.
;OTHERWISE, ONLY LIGHT UUOREN AND SET THE ERROR CODE INTO T1.
;THE CODE AT ILNMER WILL SET THE ERROR INTO THE USER'S AREA
SETLE8:	POP	P,M
	TLOA	M,UUOREN
SETLE9:	POP	P,M		;RESTORE LOC OF NAME
	TLON	M,UUOREN	;TURN ON UUOREN
	JRST	SETL10		;IF ENTER, ONLY SET ERROR
	PUSHJ	P,GETWD1##	;RENAME, GET EXTENSTION WORD
	HRRI	T1,SNFERR	;SFD-NOT-FOUND
	PUSHJ	P,PUTWDU##	;SAVE IN LOOKUP/ENTER BLOCK
SETL10:	MOVEI	T1,SNFERR	;GET SFD-NOT-FOUND
	HLRZS	DEVSFD##(F)	;MAKE SURE DEVSFD=0
	SUBI	M,UUNEXT	;POINT BACK AT NAME
	POPJ	P,		;AND TAKE ERROR RETURN

;HERE ON EXTENDED UUO
SETL11:	TLO	M,EXTUUO	;INDICATE EXTENDED UUO
	TRZE	T1,RB.NSE	;NO-SUPERSEDE ENTER?
	IORM	T2,DEVSPL(F)	;YES, LIGHT BIT IN DDB
	SETZB	U,T2		;INDICATE NON SINGLE-ACCESS
				;SET BITS FOR LIB SEARCH/UPDATE
	TRZE	T1,RB.DSL
	TLO	T2,DEPDSL##
	TRZE	T1,RB.AUL
	TLO	T2,DEPAUL##
	TRZE	T1,RB.NLB
	TLO	T2,DEPNLB##
	IORM	T2,DEVLLE##(F)	;AND STORE IN DDB
	MOVE	T2,T1
	CAIL	T1,UUXSTS	;IS THIS A DIRECTORY FILE ENTER?
	PUSHJ	P,PRVJB##	;YES, IS THIS A PRIVILEGED JOB?
	  JRST	SETL12		;NO, CANT ENTER A UFD
	HRRI	M,UUXSTS(M)	;POSSIBLY.
	PUSHJ	P,GTWST2##
	TRNE	T1,RIPDIR##	;DIR BIT ON FOR ENTER?
	TLO	M,UUODIR	;YES. ENTERING A UFD
	HRRI	M,-UUXSTS(M)	;RESET ADR. OF UUO
SETL12:	HRRI	M,UUXNAM(M)	;UUOCHK ADR CHECKS IF VM
	PUSHJ	P,GTWST2##
	CAIGE	T2,UUXEXT	;MUST HAVE AT LEAST 3 ARGUMENTS
	POPJ	P,		;NOT ENOUGH ARGUMENTS
	JRST	SETLE2		;ARG BLOCK OK, KEEP ON
;SUBROUTINE TO STEP TO NEXT PART OF LOGICAL NAME SPEC
;EXIT CPOPJ1 IF NONE OR AT END
;EXIT CPOPJ IF FOUND, WITH DEVLNM, DEVSFD SET UP
;ENTER AT NXTSP3 IF USE CURRENT DEVLNM = T1 TO START
NXTSPC:	LDB	J,PJOBN##
	HRRZS	P1,DEVLNM##(F)	;LNM SPEC OF DDB
	JUMPE	P1,CPOPJ1##	;SKIP RETURN IF NONE
	MOVS	T1,LNRDEV##(P1)	;CURRENT LOGICAL NAME
	MOVE	T2,DEVPPN(F)	;AND PPN
	CAIN	T1,'SYS'	;IF IT IS SYS
	CAME	T2,NEWPPN##	;AND WE'RE CURRENTLY LOOKING AT NEW
	JRST	NXTSP2
	HLRZ	T1,JBTSFD##(J)	;IF USER HAS NEW ENABLED
	TRNN	T1,JBPXSY##
	JRST	NXTSP2
	MOVE	T1,SYSPPN##	;THEN DO SYS NOW
	JRST	NXTS12
NXTSP0: HLLZS	DEVSFD##(F)	;SETPTH MAY HAVE LEFT JUNK
	MOVE	J,.CPJOB##
NXTSP2:	PUSHJ	P,NXTILN	;GET NEXT PART OF SPEC
	  JRST	CPOPJ1##	;NOT A LOGICAL NAME
NXTSP3:	HRRZ	P1,DEVLNM##(F)	;ADDR OF CURRENT SPEC
	SKIPN	LNRNAM##(P1)	;ZERO FILENAME?
	JUMPE	P3,NXTSP2	;BOTH ZERO, TRY NEXT SPEC
	MOVE	T1,LNRDEV##(P1)	;GET NAME
	PUSHJ	P,SDVTS1	;ERSATZ DEVICE?
	  JRST	NXTSP9		;NO, USE PPN AS GIVEN
	JUMPN	T2,NXTSP8	;YES. SYS?
	MOVE	J,.CPJOB##
	HLRZ	T1,JBTSFD##(J)	;YES. IS NEW ENABLED?
	TRNE	T1,JBPXSY##
	MOVEI	T2,NEWNDX##	;YES. USE NEW PPN
NXTSP8:	SKIPG	T1,@SDVPPN##(T2) ;IMPLIED PPN FOR ERSATZ DEV?
	JRST	NXTSP9		;NO
NXTS12:	SKIPN	LNRPPN##(P1)	;YES, IS PATH SPECIFIED?
	JRST	NXTS11		;NO, USE ERSATZ PPN
	JRST	NXTS13		;USE ERSATZ PPN AND PATHOLOGICAL SFDS
NXTSP9:	SKIPN	T1,LNRPPN##(P1)	;GET PPN, IS IT DEFAULT?
	JRST	NXTSP4		;YES, SET UP FOR IT
NXTS13:	SKIPN	LNRSFD##(P1)	;NO, IS THERE AN SFD?
	JRST	NXTS11		;NO, UFD
NXTSP4:	PUSHJ	P,SETPT1	;YES, SET UP FOR THE SFD
	  JRST	NXTSP0		;CAN'T FIND IT, STEP TO NEXT PART OF SPEC
	SKIPA	J,.CPJOB##
NXTS11:	PUSHJ	P,PPNXWD	;SAVE PPN IN DDB
	SKIPE	T1,LNRNAM##(P1)	;PATHOLOGICAL NAME HAVE A FILE NAME?
	JUMPL	P4,NXTSP6	;YES, USE IT IF /OVERRIDE
	SKIPE	P3		;NOT /OVERRIDE, LOOKUP NAME GIVEN?
	MOVE	T1,P3		;YES, USE NAME FROM LOOKUP BLOCK
NXTSP6:	MOVEM	T1,DEVFIL(F)	;SAVE NAME IN DDB
	SKIPE	T1,LNREXT##(P1)	;PATHOLOGICAL NAME HAVE AN EXTENSION?
	JUMPL	P4,NXTSP7	;YES. USE IT OF /OVERRIDE
	TRNE	P4,-1		;NOT /OVERRIDE. EXT IN LOOKUP BLOCK?
	HRL	T1,P4		;YES, USE IT
NXTSP7:	HLLM	T1,DEVEXT(F)	;SAVE EXT IN DDB
	POPJ	P,

;ROUTINE TO STORE PPN
;T1 PASSES PPN (-1 IN EITHER HALF MEANS LOGGED IN PPN)
PPNXWD:	MOVE	J,.CPJOB##
	TLC	T1,-1		;NO, WANT LOGGED IN PROJ NUMBER?
	TLCN	T1,-1
	HLL	T1,JBTPPN##(J)	;YES
	TRC	T1,-1		;WANT LOGGED IN PROG NUMBER?
	TRCN	T1,-1
	HRR	T1,JBTPPN##(J)	;YES
	MOVEM	T1,DEVPPN(F)	;SAVE PPN IN DDB
	POPJ	P,


;SUBROUTINE TO FIND NEXT DEV, PPN, SFD SET IN LOG NAME SPEC
;NON-SKIP RETURN IF END, OR NOT A LOGICAL NAME
;SKIP-RETURN IF LOG NAME, WITH T1=RH(DEVLNM)=NEXT DEVICE IN SPEC
NXTILN:	HRRZ	T1,DEVLNM##(F)	;LOGICAL NAME SPEC
	JUMPE	T1,CPOPJ##	;NOT THERE
	ADDI	T1,LNRPPN##	;POINT AT PPN SPEC (OR END)
	SKIPE	(T1)		;FIND THE END OF THIS PART
	AOJA	T1,.-1
	SKIPN	1(T1)		;AT END OF ENTIRE SPEC?
	POPJ	P,		;YES, NO NEXT PART
	ADDI	T1,1		;NO, POINT DDB AT NEXT PART OF SPEC
	MOVEM	T1,DEVLNM##(F)
	JRST	CPOPJ1##	;AND GOOD RETURN
;SUBROUTINE TO GET NEXT SFD IN SPEC
;NON-SKIP RETURN IF NOT USING A LOGICAL NAME
;SKIP RETURN IF LOGICAL NAME, T1=NEXT SFD (CAN BE 0)
NXTSLN:	SKIPN	T1,DEVLNM##(F)	;IN LOG NAME?
	POPJ	P,		;NO
	MOVE	T2,LNRPPN##(T1)	;YES. GET PPN
	TLNN	T1,-1		;1ST TIME HERE?
	SKIPE	T2		;DEFAULT PATH?
	JRST	NXTSL6		;NOT DEFAULT PATH OR ALREADY SET UP
	HRRZ	T2,.USLNM	;POINT AT TEMP SPACE
	ADDI	T2,LNMMAX##+MAXLVL##-2 ;AT TOP
	SETZM	1(T2)		;TERMINATE THE SPEC
	HRRZ	T1,JBTSFD##(J)
	TRZ	T1,JBPSCN##
	JUMPE	T1,NXTSL5	;GET PPN FROM JBTPPB IF NO JBTSFD
	TRZE	T1,JBPUFB##	;DEFAULT PATH AN SFD?
	JRST	NXTSL4		;UFB - GET IT, DONT STORE SFDS
	HLRZ	T4,NMBACC##(T1)	;SFD - POINT TO ITS AT
	MOVE	T4,ACCPPB##(T4)	;PRESERVE POINTER TO PPB
	JRST	NXTSL2		;GO STORE THIS SFD NAME IN TEMP SPACE
NXTSL1:	HLRZ	T1,NMBPPB##(T1)	;LINK
	TRZN	T1,NMPUPT##	;POINT AT FATHER SFD?
	JUMPN	T1,NXTSL1	;NO, GO TO NEXT
	JUMPE	T1,NXTSL3
NXTSL2:	MOVE	T3,NMBNAM##(T1)
	MOVEM	T3,(T2)
	SOJA	T2,NXTSL1
NXTSL3:	MOVE	T1,T4		;GET PPB POINTER BACK
NXTSL4:	SKIPA	T1,PPBNAM##(T1)	;GET PPN
NXTSL5:	MOVE	T1,JBTPPN##(J)
	MOVEM	T1,DEVPPN(F)
	MOVSI	T1,(T2)		;POINT JUST BEFORE 1ST SFD SPEC
NXTSL6:	TLNN	T1,-1		;ALREADY POINTING AT AN SFD?
	JRST	NXTSL7		;NO, POINT AT 1ST SFD
	HLRZS	T1		;YES, POINT AT THIS SFD
	AOSA	T1		;STEP TO NEXT PART
NXTSL7:	ADDI	T1,LNRSFD##
	HRLM	T1,DEVLNM##(F)	;SAVE IN DDB
	MOVE	T1,(T1)		;GET SFD NAME (OR 0 IF UFD)
	JRST	CPOPJ1##	;AND SKIP-RETTURN

;HERE IF WE COULDN'T SET UP LIB AGAIN AFTER ENTER COULDN'T FIND  THE FILE
LNMSTP:	STOPCD	.+1,DEBUG,LND, ;++LOGICAL NAME NOT FOUND
	POP	P,(P)
	JRST	LKENER
;ROUTINE TO GET THE PPN
;ENTER M POINTING TO USERS ARG (-1)
;ENTER AT CURPPX IF NO USER ARG
;EXIT T1=PPN, T2=SPECIFIED PPN IF SPECIAL DEV, OTHERWISE LH(T2)=0
; EXIT T4=JOBS DEFAULT PPN
;CURPPN RETURNS NON-SKIP IF USE DEFAULT PPN(E+3=0)
; IT RETURNS CPOPJ1 IF E+3 POSITIVE
;CURPPX ALWAYS RETURNS NON-SKIP
CURPPX::HRRZ	T2,F
	CAIN	T2,DSKDDB##	;GET DEVNAM IF NOT PROTOTYPE
	SKIPL	T1		;T1 A CHAN NUMBER?
	MOVE	T1,DEVNAM(F)	;YES, GET NAME
	PUSH	P,T1		;SAVE ON PD LIST
	PUSHJ	P,SFDPPN	;GET DEFAULT PPN
	SETZ	T3,
	JRST	CURPPY		;AND CONTINUE
CURPPN:	PUSHJ	P,SFDPPN	;GET DEFAULT
	PUSHJ	P,GETWD1##	;GET USERS ARG
	MOVEI	T3,1
	PUSH	P,DEVNAM(F)	;SAVE NAME
	JUMPG	T1,[AOS -1(P)	;IF NOT SPECIFIED
		SETZ	T3,
		JRST	CURPP1]
CURPPY:	MOVE	T1,T4		;T1=DEFAULT PPN
CURPP1:	EXCH	T1,(P)		;SAVE PPN, GET NAME
	PUSH	P,T4
	PUSH	P,T3
	PUSHJ	P,SDVTST	;SPECIAL DEV?
	  MOVEI	T2,ZPPNDX##	;NO, POINT T2 AT @0
	CAILE	T2,SYSNDX##	;IF NOT SYS
	TLZ	F,SYSDEV	; CLEAR BIT IN F
	POP	P,T3
	CAIE	T2,LIBNDX##	;LOGICAL NAME?
	JRST	CURPP2		;NO
	MOVE	T1,@.USLNM	;YES, GET PPN FROM SPECIFICATION
	MOVE	T1,LNMPPN##(T1)
	MOVEM	T1,-1(P)	;SAVE AS DEFAULT PPN
CURPP2:	POP	P,T4
	SKIPG	T1,@SDVPPN##(T2) ;YES, IS THERE AN IMPLIED PPN?
	JRST	TPOPJ##		;NO, RETURN
	ADDM	T3,-1(P)	;YES, SKIP RETURN IF CALL TO CURPPN
	JUMPN	T2,T2POPJ##	;LOOKING FOR SYS?
	MOVE	T2,JBTSFD##(J)	;YES, WANT NEW?
	TLNE	T2,JBPXSY##
	MOVE	T1,NEWPPN##	;YES
	PJRST	T2POPJ##	;THROW AWAY OLD PPN AND RETURN

;ROUTINE TO GET CURRENT PPN, SET DEPPP0
;CALL, EXIT SAME AS CURPPN
;ALWAYS RETURNS CPOPJ
PPNPP0:	PUSHJ	P,CURPPN	;GET PPN
	  TDZA	T3,T3		;PPN=0
	MOVEI	T3,1		;PPN NON-0
	TLNE	F,SYSDEV	;SYS?
	MOVEI	T3,0		;YES, SET SO NEW: SEARCHES SYS
	DPB	T3,DEYPP0##	;REMEMBER STATE OF PPN WORD
	POPJ	P,		;RETURN
PTHUUO::PUSHJ	P,SAVE4##	;SAVE P1
	HRR	M,T1		;LOC OF ARG LIST
	HLRZ	P4,T1		;N-3 INTO P4
	SKIPE	P4		;MAKE 0 ARGS DEFAULT TO 3
	SUBI	P4,3		;NO. OF ARGS-3
	JUMPL	P4,ECOD11##	;1 OR 2 ARGS ILLEGAL
	PUSHJ	P,GETWDU##	;GET VALUE
PTHUU1:	HLRE	P2,T1		;GET JOB NUMBER
	SKIPLE	P2		;IF .LE. 0
	CAILE	P2,JOBMAX##	;  OR TOO HIGH
	MOVE	P2,.CPJOB##	;USE CURRENT JOB
	TLNN	T1,770000
	HRRES	T1		;GET ARGUMENT
	MOVN	T2,T1
	SKIPLE	T2
	CAILE	T2,MXPATH
	JRST	PTHU13
	JRST	@PTHDSP-1(T2)

PTHDSP:	PTHU20			; -1  READ DEFAULT PATH
	PTHUU3			; -2 SET DEFAULT PATH
	PTHUU2			; -3 SET LIB, SYS, NEW
	PTHU12			; -4 READ LIB, SYS, NEW
	PTHSLN			; -5 SET LOGICAL NAME
	PTHRLN			; -6 READ LOGICAL NAME
MXPATH==.-PTHDSP

PTHUU2:	SETOB	P1,P4		;SET SOME FLAGS
	PUSHJ	P,GETWD1##	;GET ARGUMENT
	TRNN	T1,PT.DTL##	;DONT CHANGE LIST?
	SOJA	M,PTHUU3	;NO, DO REGULAR STUFF
	ANDI	T1,CORXTR##	;YES, CLEAR OUT FUNNY BITS
	MOVE	T2,JBTSFD##(J)	;GET CURRENT DEFAULT
	TLZ	T2,CORXTR##
	TLO	T2,(T1)		;SET NEW LIB/SYS BITS
	MOVEM	T2,JBTSFD##(J)	;SAVE AS CURRENT DEFAULT
	JRST	CPOPJ1##	;AND GOOD RETURN

PTHUU3:	PUSHJ	P,FAKDDB	;SET UP A DDB FROM FREE CORE
	  POPJ	P,		;NO FREE CORE LEFT - CANT SET THE PATH
	MOVEM	P4,DEVNAM(F)	;STORE N-3 IN NAME
	PUSHJ	P,SETPT2	;SET UP THE DEFAULT PATH
	  PJRST	PTHUU6		;SOME SFD WASN'T THERE
	JUMPL	P4,PTHUU7	;SET LIB, SYS IF -3
	MOVE	T2,DEVSFD##(F)
	TRNN	T2,JBPUFB##	; IF POINTING AT UFD
	PUSHJ	P,SFDDEC
	PUSHJ	P,SFDPPJ	;GET OLD DEFAULT
	HLRZ	P2,T1		;SAVE LOC OF SFD NMB OR PPB
	LDB	T1,DEYSCN##	;GET VALUE OF SCAN-SWITCH
	OR	T1,DEVSFD##(F)	;PLUS L(SFD NMB)
	HRRM	T1,JBTSFD##(J)	;SET AS NEW DEFAULT
	MOVE	P1,T4		;SAVE OLD PPN
	SKIPE	T1,T2		;IS THERE AN OLD SFD?
	PUSHJ	P,DECALL	;YES, DECREMENT ITS USE-COUNTS
	CAMN	P1,DEVPPN(F)	;OLD PPN=NEW PPN?
	JRST	PTHUU5		;YES, FINISH UP
	MOVE	T1,P1		;NO, GET OLD PPN
	CAME	T1,JBTPPN##(J)	;SAME AS JOB'S PPN?
	PUSHJ	P,PTHCHX	;NO, CLEAN UP OLD DEFAULT
	MOVE	T1,DEVPPN(F)	;NEW DEFAULT PPN
	CAMN	T1,JBTPPN##(J)	;IS IT JOB'S PPN?
	JRST	PTHUU5		;YES
	PUSHJ	P,SFDPPN	;NO, GET L(PPB)
	HLRS	T1
PTHUU4:	MOVEI	T2,PPPNLG##	;PRETEND NEW DEFAULT PPN IS LOGGED IN
	ORM	T2,PPBNLG##(T1)
PTHUU5:	PUSHJ	P,TSTPPB	;DELETE PPB IF UNUSED
	PUSHJ	P,CLRDDB	;RETURN THE DDB
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;HERE ON ERROR RETURN FROM SETPT3
PTHUU6:	PUSHJ	P,TSTPPB	;DELETE PPB IF NOW UNUSED
	PUSHJ	P,CLRDDB	;RETURN THE DDB TO FREE CORE
	LDB	T1,PUUOAC##	;GET CALLI AC
	HRR	M,T1		;INTO ADDRESS OF M
	PJRST	RTM1##		;RETURN -1 AS INDICATION OF FAILURE
;HERE TO SET UP A LIB
PTHUU7:	PUSHJ	P,GETWDU##	;GET ARGUMENT
	JUMPN	T1,PTHUU8	;CLEARING LIB?
	SETZM	.PDOSL##(W)
	PUSHJ	P,FNDLB		;YES, FIND OLD LIB
	  JRST	PTHUU9		;NOT THERE
	MOVSI	T1,LN.LIB##	;CLEAR LIB SPEC
	ANDCAM	T1,@.USLNM
	JRST	PTHUU9		;AND CONTINUE
PTHUU8:	SETO	P4,		;DEFINE A LOGICAL NAME
	PUSHJ	P,PTHSL		; SO WE DONT HAVE TO SPECIAL CASE THE OLD STUFF
	  PJRST	CLRDDB		;CANT DEFINE IT - ERROR RETURN
PTHUU9:	PUSHJ	P,FNDPDS##
	HRRZ	T2,DEVSFD##(F)	;LIB, SYS, AND NNEW
	PUSHJ	P,GTWST2##
	SKIPN	T1		;CLEARING LIB?
	ANDI	T2,CORXTR##	;YES, IGNORE WHAT SETPTH SAID
	MOVEM	T1,.PDOSL##(W)	;SAVE OLD-STYLE LIB
	MOVE	J,.CPJOB##
	HLRZ	P2,JBTSFD##(J)	;OLD LIB
	HRLM	T2,JBTSFD##(J)	;SAVE NEW LIB, SYS BITS
	TRZ	P2,CORXTR##	;ZAP THE EXTRA BITS
	JUMPE	P2,PTHU10	;GO IF NO OLD LIB
	TRZ	T2,CORXTR##
	CAMN	T2,P2		;
	JRST	PTHU10		; OR IF OLD LIB = NEW

;HERE IF THERE IS AN OLD LIB
	MOVE	T1,PPBNAM##(P2)	;GET PPN
	PUSHJ	P,PTHCHX	;FINISH UP IF NOW NO USER OF THE PPN
PTHU10:	SETO	T1,
	HLRZ	T2,JBTSFD##(J)	;IS THERE A NEW LIB?
	TRNN	T2,-1-CORXTR##
	PUSHJ	P,PTXUDF	;NO, UNDEFINE THE OLD ONE
	  JRST	PTHU11		;NO OLD LIB
	PUSHJ	P,PTHSL2	;RETURN THE SPACE FOR IT
	  JFCL
PTHU11:	HRRZ	T1,DEVSFD##(F)	;NEW PPB INTO T1
	TRZ	T1,CORXTR##	;CLEAR /SYS/NEW
	JRST	PTHUU4		;GO SET IT LOGGED-IN
;HERE TO READ LIB, SYS
PTHU12:	HLRZ	T1,JBTSFD##(P2)	;LIB, SYS,NEW
	ANDI	T1,CORXTR##	;JUST SYS, NEW
	PUSHJ	P,PUTWD1##	;TELL USER
	MOVE	T1,P2		;JOB# IN T1
	MOVE	T2,JBTSTS##(T1)	;IS JOB NUMBER ASSIGNED?
	TLNN	T2,JNA##
	PJRST	ECOD7##		;NO, GIVE ERROR CODE PTNSJ%
	PUSHJ	P,FPDBT1##	;GET POINTER TO JOB'S PDB
	  PJRST	NPJSTP##	;NO PDB FOR JOB, GIVE STOPCD AND ERROR RETURN
	MOVE	T1,.PDOSL##(T1)	;OLD STYLE LIB
	PUSHJ	P,PUTWD1##	;TELL USER
	PJRST	CPOPJ1##	;AND TAKE SKIP-RETURN

;HERE WHEN TRYING TO READ THE PATH
PTHU13:	PUSHJ	P,DVCNSG##	;GET DDB
	  PJRST	ECOD0##		;NONE - RETURN 0 TO USER
	SETOM	P3		;SET ALL FLAGS.
	TDO	P1,[-1-<PT.PHO##,,0>] ;MAINTAIN STATE OF PT.PHO (PHONLY)
	MOVE	T2,DEVMOD(F)
	TLNN	T2,DVDSK	;DSK?
	PJRST	RTZER##		;NO, RETURN 0
	HRRZ	T2,F		;ADR OF DDB (SYSDEV MIGHT BE ON)
	CAIE	T2,DSKDDB##	;PROTOTYPE DDB?
	MOVE	T1,DEVNAM(F)	;NO, GET NAME
	PUSHJ	P,ALIASD##	;IS IT DSK?
	TLZ	P1,PT.GEN##	;YES, CLEAR A BIT
	PUSHJ	P,SDVTSP	;SPECIAL DEVICE?
	  JRST	PTHU14
	MOVE	P3,T2		;SAVE INDEX
	HRL	P3,T3		;LH P3=0 IF DEV, 1 IF DEVX
	HRR	P1,T4		;SAVE LOGICAL NAME INDEX
	CAIN	T2,LIBNDX##	;LOGICAL NAME?
	PUSHJ	P,SDVTS1	;YES, ALSO AN ERSATZ DEVICE?
	  JRST	PTHU15		;NO
	TLZA	P1,PT.ESZ##	;YES, MAKE P1 POSITIVE
PTHU14:	MOVSI	T1,'DSK'
PTHU15:	HRRZ	T2,DEVACC##(F)	;LOC OF AT
	JUMPE	T2,PTHU16	;NO OPEN FILE, NAME='DSK'
	LDB	T2,ACYFSN##	;AN OPEN FILE, GET STR NUMBER

	MOVE	T1,@TABSTR##(T2) ; TELL USER STR NAME
				;FALL INTO PTHU16
PTHU16:	CAIE	P3,LIBNDX##
	JRST	PTHU17
	MOVE	T4,P1
	MOVE	T4,@.USLNM
	MOVE	T1,LNMDEV##(T4)
PTHU17:	PUSHJ	P,PUTWDU##	;STORE IT FOR USER
	LDB	T3,DEYSCN##	;SCAN-SWITCH
	HRRZ	T2,DEVACC##(F)	;IF NO A.T.
	JUMPE	T2,PTHU18	; FILE HAS BEEN CLOSED
	HRRZ	T2,DEVSFD##(F)	;LOC OF SFD NMB
	SKIPE	T4,DEVPPN(F)	;PPN SET UP?
	JRST	PTHU21
	JRST	PTHU19
PTHU18:	CAIE	P3,LIBNDX##
	JRST	PTHU19
	HRRO	T2,T4		;LOG NAME-REMEMBER LOC
	SKIPA	T4,LNMPPN##(T4)
PTHU19:	PUSHJ	P,SFDPPN	;NO, TELL HIM DEFAULT PPN
	TRZ	T3,JBPUFB##	;SO SCAN BITS WILL BE CORRECT
	TLNE	F,SYSDEV
	MOVE	T4,SYSPPN##
	JRST	PTHU21		;CONTINUE

;HERE TO READ DEFAULT PATH
PTHU20:	SETO	P3,
	SETZ	P1,		;INSURE PT.JSL GETS SET
	MOVEI	F,DSKDDB##	;FAKE UP F
	MOVE	J,P2		;JOB NUMBER
	PUSHJ	P,SFDPPN	;GET DEFAULT
	TRZ	T3,JBPUFB##	;MASK OUT DEFAULT=UFB BIT
PTHU21:	MOVEI	T1,1(T3)	;INTERNAL SCAN-SWITCH +1
	HLRZ	T3,JBTSFD##(J)	;LIB, SYS, NEW
	TRZE	T3,777774	;CLEAR EVERYTHING BUT SYS,NEW
	TRO	T1,PT.LIB##	;LIB NON-0 , LIGHT A BIT
	LSH	T3,2		;POSITION SYS,NEW BITS
	TRO	T1,(T3)		;LIGHT THEM IN T1
	JUMPL	P3,PTHU22	;IF A SPECIAL DEVICE,
	TLNN	P1,PT.ESZ##	;BOTH LOGICAL NAME AND ERSATZ DEVICE?
	TRO	T1,PT.EDA##	;YES, LITE A BIT
	HRRZ	T3,SDVTBL##(P3)	; GET SEARCH-LIST TYPE
	TLZN	P3,-1		;WAS IT DEVX?
	IOR	T1,T3		;NO, RETURN TYPE TO USER

	SKIPE	@SDVPPN##(P3)	;IF THERE IS AN IMPLIED PPN
	TRO	T1,PT.IPP##	;LIGHT A BIT
PTHU22:	TLNN	P1,PT.GEN##	;GENERIC DSK?
	TRO	T1,PT.JSL##	;YES, LIGHT JOB SEARCH LIST
	PUSH	P,T4		;PROTECT T4 IN CASE OF ABSURD USAGE
	CAIE	P3,LIBNDX##	;IF A LOGICAL NAME
	JRST	PTHU30		;NO
	HRRZ	T4,P1		;GET LOGICAL NAME INDEX
	MOVE	T4,@.USLNM	;GET ADDRESS OF ENTRY
	MOVE	T4,LNMPLN##(T4)	;GET NAME
	AOJE	T4,PTHU30	;IF OLD-STYLE LIB:, CAN'T GET INFO (SEE PTHRL5)
	TRO	T1,PT.DLN##	;HE CAN GET MORE INFO WITH PATH
PTHU30:	MOVE	T4,DEVPTB##(F)
	TLNE	T4,DEPFFS##	;FOUND BY SCANNING?
	TRO	T1,PT.FFS##
	TLNE	T4,DEPFFL##	;FOUND IN LIB?
	TRO	T1,PT.FFL##
	PUSHJ	P,PUTWD1##	;TELL THE USER
	POP	P,T4
	CAIN	P3,LIBNDX##	;LIB OR LOGICAL NAME?
	JRST	PTHU25		;YES, PPN ALREADY SET UP
	JUMPL	P3,PTHU25	;IF  A SPECIAL DEVICE,
	JUMPN	P3,PTHU23	; IF SYS
	HLRZ	T1,JBTSFD##(J)	; IS NEW ON FOR USER ?
	TRNE	T1,JBPXSY##
	MOVEI	P3,NEWNDX##	; YES, RETURN NEWPPN
PTHU23:	JUMPGE	P2,PTHU24	;IF ASKING FOR NAME.EXT,
	MOVE	T1,DEVFIL(F)	; TELL HIM
	PUSHJ	P,PUTWD1##
	HLLZ	T1,DEVEXT(F)
	PUSHJ	P,PUTWD1##
PTHU24:	HRRZ	T1,DEVACC##(F)	;LOOKUP DONE?
	JUMPN	T1,PTHU25	;YES, GO TELL THE TRUTH
	SKIPLE	T1,@SDVPPN(P3)	;IS THERE AN IMPLIED PPN?
	TDZA	T2,T2		;YES, FLAG NOT TO USE SFDS FROM DEFAULT PATH
PTHU25:	MOVE	T1,T4		;DEFAULT PPN
	PUSHJ	P,PUTWD1##	;SAVE FOR USER
	JUMPLE	P4,CPOPJ1##	;RETURN IF THAT'S ALL HE WANTS
	JUMPL	T2,PTHU29	;GO IF PATH.[SIXBIT /LOGNAM/]
	PUSH	P,[0]		;SAVE TERMINATOR
	JUMPE	T2,PTHU28	;DONE IF HAVE A 0 NAME
PTHU26:	PUSH	P,NMBNAM##(T2)	;GET THE NEXT NAME
PTHU27:	HLRZ	T2,NMBPPB##(T2)	;SCAN FOR FATHER SFD
	TRZN	T2,NMPUPT##
	JUMPN	T2,PTHU27
	JUMPN	T2,PTHU26	;SAVE ITS NAME AND CONTINUE
PTHU28:	POP	P,T1		;READ A NAME FROM LIST
	SOSL	P4
	PUSHJ	P,PUTWD1##	;STORE IT IN USERS AREA
	JUMPN	T1,PTHU28	;GET NEXT
	PJRST	CPOPJ1##	;DONE - GOOD RETURN
;HERE ON A LOGICAL NAME. GIVE PATH OF 1ST COMPONENT
PTHU29:	MOVE	T1,LNMSFD##(T2)	;GET SFD
	PUSHJ	P,PUTWD1##	;TELL USER
	JUMPE	T1,CPOPJ1##	;TERMINATE ON END OF SFD'S
	SOJLE	P4,CPOPJ1##	;TERMMINATE ON FILLING BLOCK
	AOJA	T2,PTHU29	;TELL HIM NEXT SFD
;HERE TO SET A LOGICAL NAME
PTHSLN:	CAILE	P4,1		;LEGAL NUMBER OF ARGS?
	CAILE	P4,LNMMXL##-1
	JRST	ECOD1##		;NO, ERROR 1
	ADDI	M,2		;YES, POINT AT LOGICAL NAME
	PUSHJ	P,GETWDU##	;GET IT
	JUMPE	T1,ECOD5##	;MUST NOT BE BLANK
	PUSHJ	P,DEVLG##	;IS THERE A LOGICAL NAME ALREADY DEFINED?
	  CAMN	T1,[SIXBIT /DSK/] ;NO, TRYING TO DEFINE LOG NAME "DSK"?
	JRST	ECOD5##		;YOU LOSE
	SUBI	M,1		;POINT M BACK AT BITS
	MOVEI	F,DSKDDB##	;FAKE UP F FOR LNMTST

;CALLED FROM PATH FUNCTION -3 (SET LIB)
;WIPES OUT P ACS
PTHSL:	SKIPE	T1,.USLNM	;LOGICAL NAME TABLE EXIST?
	JRST	PTHSL1		;YES
	MOVEI	T2,LNMMAX##+MAXLVL##+1 ;NO, GET SPACE FOR TABLE, TEMP SPACE
	PUSHJ	P,GTFWDC##
	  JRST	ECOD4##		;NO FUNNY SPACE AVAILABLE
	HRLI	T1,T4
	MOVEM	T1,.USLNM	;SAVE ADDR (INDEXED BY T4) IN UPMP
	SETZM	(T1)
	MOVS	T2,T1		;MAKE SURE THE TABLE IS EMPTY
	HRRI	T2,1(T1)
	BLT	T2,LNMMAX##(T1)
PTHSL1:	JUMPL	P4,PTHSL4	;GO IF CALLED FROM PATH FNCN -3
	PUSHJ	P,GETWDU##	;GET BITS
	TLNN	T1,LN.UDF##	;UNDEFINE A LOGICAL NAME?
	JRST	PTHSL4		;NO

;HERE TO DELETE A LOGICAL NAME
	PUSHJ	P,PTHUDF	;UNDEFINE THE NAME
	  JRST	ECOD3##		;NO SUCH NAME
PTHSL2:	MOVEI	T1,@.USLNM	;POINT AT THIS LOGICAL NAME
	SKIPN	T3,1(T1)	;IS IT THE LAST NAME IN TABLE?
	JRST	PTHSL3		;YES
	MOVEI	T2,1(T1)	;NO, FIND LAST
	SKIPE	1(T2)
	AOJA	T2,.-1
	MOVE	T3,(T2)		;GET LAST LOGICAL NAME
	SETZM	(T2)		;CLEAR THE SPACE
PTHSL3:	EXCH	T3,(T1)		;SAVE PREVIOUS LAST NAME (OR 0) IN THIS SPACE
	SETZ	T4,		;SEE IF FIRST LOGICAL NAME TABLE SLOT ZERO
	SKIPE	@.USLNM		;(WE UNDEFINED LAST LOGICAL NAME SPEC)
	JRST	PTHSL5		;NO
	PUSH	P,T3		;SAVE LIBEDNESS FLAG
	MOVEI	T1,LNMMAX##+MAXLVL##+1 ;GIVE UP THE LOGICAL NAME TABLE SPACE
	HRRZ	T2,.USLNM
	PUSHJ	P,GVFWDS##
	SETZM	.USLNM		;FORGET ABOUT IT
	POP	P,T3		;RESTORE LIBEDNESS FLAG
PTHSL5:	JUMPGE	T3,PTHS12	;EXIT IF IT WASN'T LIB WE UNDEF'D
	PUSHJ	P,GETCB##	;WE GOT RID OF LIB - RETURN CORE BLOCKS
	PJRST	PTHS11		; IF THIS IS LAST USER OF THAT PPN
;HERE TO DEFINE A LOGICAL NAME
PTHSL4:	MOVE	P1,T1		;PRESERVE BITS
	PUSHJ	P,PTHUDF	;UNDEFINE PREVIOUS SPEC FOR THIS NAME
	  TDZA	T4,T4		;NO PREVIOUS SPEC. START AT BEGINNING
	JRST	PTHSL6		;THERE WAS ONE, USE ITS TABLE SLOT
	SKIPE	@.USLNM		;FIND FIRST FREE TABLE SLOT
	AOJA	T4,.-1
	CAILE	T4,LNMMAX##-1	;REACHED END OF TABLE?
	JRST	ECOD2##		;YES, TOO MANY NAMES TO DEFINE A NEW ONE

;HERE WITH T4=INDEX TO NEW NAME
PTHSL6:	SKIPGE	T2,P4		;CALLED BY PATH. FNCN -3?
	MOVEI	T2,4		;YES, 4 WDS ("DSK", 0 NAME, 0 EXT, PPN)
	ADDI	T2,3		;ACCOUNT FOR OVERHEAD WORDS
	DPB	T2,LNYLEN##	;SAVE LENGTH OF THIS ENTRY
	MOVEI	P2,@.USLNM	;POINT AT TABLE ENTRY
	MOVE	P3,T1		;SAVE NAME
	PUSHJ	P,GTFWDC##	;GET FUNNY SPACE FOR THE SPECIFICATTION
	  JRST	[SETZM (P2)	;NOT ENOUGH FUNNY SPACE
		 JRST ECOD4##]
	HRRM	T1,(P2)		;SAVE ADDR OF SPEC IN TABLE
	MOVEM	P3,LNMPLN##(T1)	;SAVE LOGICAL NAME
	MOVEI	P3,LNMDEV##(T1)	;POINT AT DEV (DSK, UNIT, STR,...)
	JUMPL	P4,[MOVSI T1,'DSK' ;IF CALLED BY PATH. -3
		    MOVEM T1,(P3) ; NAME IS "DSK"
		    SETZM 1(P3)	;NO NAME
		    SETZM 2(P3)	;NO EXT
		    ADDI P3,2	;POINT AT PPN
		    MOVE T1,DEVPPN(F) ; PPN IS GOTTEN FROM DDB
		    AOJA P3,PTHSL9] ;SAVE PPN AND FINISH UP
				;FALL INTO PTHSL7 IN NOT PATH. -3
PTHSL7:	MOVEI	R,LNRPPN##	;ALWAYS READ 1ST FEW ARGUMENTS
	AOSA	M		;SKIP NODE
PTHSL8:	JUMPE	T1,PTHSL7	;DO NEXT PART IF DONE WITH THIS
	PUSHJ	P,GETWD1##	;GET AN ARGUMENT
PTHSL9:	MOVEM	T1,(P3)		;REAL ARG - SAVE IT
	SOSL	R		;IN 1ST PART (NODE, DEV, NAME, EXT)?
	MOVEI	T1,1		;YES. MAKE SURE WE DONT TERMINATE
	SOSLE	P4		;MORE TO GO?
	AOJA	P3,PTHSL8	;YES, GET NEXT PART OF SPEC
	SETZM	1(P3)		;INDICATE WE ARE AT END
	SETZM	2(P3)
	MOVSI	T1,LNPOVR##
	ANDCAM	T1,(P2)		;CLEAR BITS IN SPEC
	TLNN	P1,LN.OVR##	;/OVERRIDE?
	TLZ	T1,LNPOVR##	;NO
	IORM	T1,(P2)		;SAVE BITS IN SPEC WORD
	MOVSI	T1,LN.LIB##
	HLL	P2,(P2)		;GET OLD LIB SPEC
	ANDCAM	T1,(P2)		;CLEAR LIBEDNESS
	TLNN	P1,LN.LIB##	;WAS IT FORMERLY A LIB?
	JUMPGE	P4,PTHS10	;NO (IF NOT PATH. -3)
	PUSHJ	P,FNDLB		;FIND OLD LIB
	  CAIA			;NO OLD LIB
	ANDCAM	T1,@.USLNM	;CLEAR LIBEDNESS FROM OLD LIB
	IORM	T1,(P2)		;SET LIBEDNESS IN NEW LIB
	JUMPL	P4,PTHS12	;DONE IF PATH. -3
	PUSHJ	P,FNDPDS##
	SETZM	.PDOSL##(W)	;NO OLD-SYLE LIB
	CAIA
				;FALL INTO NEXT PAGE
				;DROPS INTO HERE FROM PREVIOUS PAGE
PTHS10:	JUMPGE	P2,PTHS12	;WAS THERE AN OLD LIB?
	PUSHJ	P,GETCB##	;YES
	HLRZ	T2,SYSPPB##	;%START AT 1ST PPB IN SYSTEM
	HRRZ	T3,(P2)		;%GET NEW LIB PPN
	MOVE	T1,LNMPPN##(T3)
	PUSHJ	P,LSTSRC##	;%FIND NEW LIB PPB (CREATE IF NONEXISTENT)
	  JUMPE	T2,[PUSHJ P,GVCBJ## ;%EXIT IF NO CORE BLOCKS
		   SOS (P)
		   JRST PTHS12]
	MOVEI	T3,PPPNLG##
	SKIPGE	P2		;%IS THERE A NEW LIB?
PTHS11:	TDZA	T2,T2		;%NO
	IORM	T3,PPBNLG##(T2)	;%YES, PRETEND (1ST) PPN IS LOGGED IN
	HLRZ	P2,JBTSFD##(J)	;%GET OLD SYS/NEW BITS
	TRZ	P2,-1-CORXTR##
	TRO	T2,(P2)		;%INSERT NEW LIB PPN ADDR
	HLRZ	P2,JBTSFD##(J)	;%SAVE OLD LIB
	HRLM	T2,JBTSFD##(J)	;%STORE NEW LIB
	PUSHJ	P,GVCBJ##	;%RETURN CB RESOURCE
	CAIN	P2,(T2)		;OLD LIB+NEW LIB?
	JRST	PTHS12		;YES, DONE
	TRZ	P2,CORXTR##	;NO SAVE ADDR OF OLD PPB
	PUSHJ	P,FAKDDB	;LOGTST WILL REWRITE OLD UFD RIB
	  JRST	PTHS12		;NO SPACE FOR FAKE DDB, GOOD EXIT
	MOVE	T1,PPBNAM##(P2)	;GET OLD LIB PPN
	PUSHJ	P,PTHCHX	;REWRITE UFD RIB IF NOW NOT LOGGED IN
	PUSHJ	P,CLRDDB	;GIVE UP THE FAKE DDB
PTHS12:	JRST	CPOPJ1##	;AND TAKE GOOD RETURN


;HERE ON PATH. -6 (READ LOGICAL NAMES)
PTHRLN:	CAILE	P4,0		;NUMBER OF ARGUMENTS LEGAL?
	CAILE	P4,LNMMXL##-1
	JRST	ECOD1##		;NO
	MOVEI	F,DSKDDB##	;LNMTST LOOKS AT DDB
	PUSHJ	P,GETWD1##	;YES, GET ARGUMENT
	MOVE	P1,T1		;SAVE BITS
	PUSHJ	P,GETWD1##	;GET NEXT WORD (WHERE TO START)
	SKIPE	T4,T1		;WANT FIRST NAME?
	AOJA	P1,PTHRL3	;NO
	SKIPE	T1,.USLNM	;YES, ANY NAMES AT ALL?
	AOJA	P1,PTHRL5	;YES, GET 1ST
PTHRL1:	AOS	(P)		;NO, RETURN 0 (END)
	PJRST	PUTWDU##
;HERE WHEN USER SPECIFIES WHERE TO START
PTHRL3:	PUSHJ	P,LNMTST	;FIND THIS LOGICAL NAME
	  JRST	ECOD6##		;NONE SUCH NAME - ERROR
	TLNN	P1,LN.RIT##	;RETURN INFO ABOUT THIS NAME?
PTHRL4:	ADDI	T4,1		;NO, POINT TO NEXT NAME
PTHRL5:	SKIPN	T1,@.USLNM	;GET SPEC FOR THIS NAME
	JRST	PTHRL1		;DONE - RETURN 0
	MOVE	T2,LNMPLN##(T1)	;IF -1 IT IS OLD-STYLE LIB
	AOJE	T2,PTHRL4	; SO DON'T TELL ABOUT IT
	TDZ	T1,[-1-LN.LIB##-LNPOVR##,,-1] ;SAVE LIBEDNESS
	TLZE	T1,LNPOVR##	;/OVERRIDE?
	TLO	T1,LN.OVR##	;YES
	SUBI	M,1		;POINT AT BITS
	PUSHJ	P,PUTWDU##	;TELL CALLER IF THIS IS LIB
	MOVE	P1,@.USLNM	;POINT AT SPEC
	MOVE	T1,(P1)		;GET PATHOLOGICAL NAME
	PUSHJ	P,PUTWD1##	;TELL USER
	ADDI	P1,1		;POINT AT DEV
PTHRL6:	MOVEI	P3,LNRPPN##+1	;ALWAYS STORE FIRST ARGS
	SOS	P1		;ACCOUNT FOR LATER ADDI
	TDZA	T1,T1		;STORE A ZERO FOR NODE
PTHRL7:	MOVE	T1,(P1)		;GET NEXT WORD OF SPEC
	PUSHJ	P,PUTWD1##	;TELL USER
	SOJLE	P4,CPOPJ1##	;DONE IF NO MORE SPACE IN CALLERS BLOCK
	ADDI	P1,1		;POINT AT NEXT PART OF SPEC
	SOJGE	P3,PTHRL7
	JUMPN	T1,PTHRL7	;GET NEXT SFD IF DIDN'T END
	SKIPE	(P1)		;END OF THIS PART. FINAL PART?
	JRST	PTHRL6		;NO, STORE NEXT PART
	SETZB	T1,P4		;YES, MAKE SURE WE EXIT
	PUSHJ	P,PUTWD1##	;STORE THE 2ND 0
	JRST	PTHRL7		;AND STORE THE FINAL ZERO

;SUBROUTINE TO UNDEFINE A LOGICAL NAME
;ENTER WITH M POINTING AT THE NAME -1
;RETURNS CPOPJ IF NO MATCH, CPOPJ1 IF MATCH WITH T1=NAME
;RETURNS T4=INDEX IN LOG NAME TABLE IF A MATCH
PTHUDF:	SKIPL	T1,P4		;CALLED BY PATH. -3 ?
	PUSHJ	P,GETWD1##	;NO, GET NAME
PTXUDF:	PUSHJ	P,LNMTST	;FIND ITS SLOT
	  POPJ	P,		;NO SUCH NAME
PTKUDF:	PUSH	P,T1
	PUSH	P,T4
	LDB	T1,LNYLEN##	;NO OF WORDS FOR THIS SPEC
	HRRZ	T2,@.USLNM	;ADDR OF SPEC
	PUSHJ	P,GVFWDS##	;RETURN THE SPACE
	POP	P,T4
	JRST	TPOPJ1##	;AND RETURN
;SUBROUTINE TO SET UP THE PATH
;ENTER WITH M POINTING TO THE 1ST WD IN THE PATH SPEC, J= JOB NUMBER
;ENTER WITH DEVSFD=0
;IF DEVNAM IS POSITIVE, IT IS ASSUMED TO BE A COUNT OF SFD LEVELS (PTHUUO)
;IF DEVNAM=-1 IT IS ASSUMED THAT THE CALL IS TO SET A LIBRARY
;EXIT CPOPJ IF NO SEARCH LIST OR A NAME IN THE PATH ISN'T FOUND
;EXIT CPOPJ1 NORMALLY, WITH DEVSFD SET UP, USE CNTS UP IN SFD AT'S
;0 FOR PPN MEANS DEFAULT (NOT NECCESSARILY JOB'S PPN)
;ENTER WITH T1=LOC OF "FORBIDDEN" NMB-ERROR IF THIS
; NMB IS ON THE PATH (USED BY RENAME TO PREVENT A DIRECTORY INCONSISTENCY)
;ENTER AT SETPT2 IF ANY SFD IS LEGAL
;ENTER AT SETPT1 IF GETTING SFDS FROM LOGICAL NAME SPEC (WITH T1=PPN)
SETPT1:	PUSHJ	P,SAVE4##
	SETZB	P1,P2		;NO SCAN, NO FORBIDDEN NMB
	DPB	P1,DEYSCN##	;CLEAR SCAN SWITCH
	PUSHJ	P,PPNXWD	;SAVE PPN IN DDB
	SETOM	DEVFIL(F)	;DON'T CALL FNDFIL IF 1ST SFD IS ZERO
	PJRST	SETPT7		;AND KEEP ON TRUCKIN
SETPT2:
SETPT3:	PUSHJ	P,SAVE4##
	MOVE	P2,T1		;SAVE FORBIDDEN NMB LOC
	HRRZ	T1,M
	PUSHJ	P,SETP16	;ADDRESS CHECK ARGUMENTS (MIGHT GET EUE
	MOVE	T3,M		;GET SET TO ADDRESS-CHECK THE ARGUMENTS
	MOVE	T2,SFDLVL##	;GET MAX. NUMBER OF SFD'S
	HRRI	M,1(M)		;GO TO WORD BEFORE FIRST SFD
SETPT4:	MOVEI	T1,1(M)		;GET ADDRESS OF NEXT SFD
	PUSHJ	P,SETP16	;ADDRESS-CHECK IT
	PUSHJ	P,GETWD1##	;GET SFD SPEC ITSELF
	SKIPE	T1		;HIT ZERO?
	SOJGE	T2,SETPT4	;NO, GO UNTIL SFD LVL IS REACHED
	MOVE	M,T3		;RESTORE M
	PUSHJ	P,GETWD1##
	ANDI	T1,3
	MOVE	P1,T1		;SCANNING SWITCH
	AOSN	DEVNAM(F)	;DEVNAM=-1?
	TROA	P1,400000	;YES, P1 WILL BE NEGATIVE
	SOSA	DEVNAM(F)	;NO, RESET DEVNAM
	JRST	SETPT6		;WANT ALL OF WORD IF LIB
	JUMPN	P1,SETPT5	;IF NO CHANGE,
	MOVE	P1,JBTSFD##(J)	;GET OLD VALUE
	ANDI	P1,JBPSCN##
	JRST	SETPT6
SETPT5:	CAIE	T1,2		;IF HE IS SPECIFYING IT
	TDZA	P1,P1		;2 MEANS NO SCAN,
	MOVEI	P1,JBPSCN##	;OTHERWISE SCAN
SETPT6:	HRLZS	P1		;SAVE IN LH(P1)
	DPB	P1,DEYSCN##	;SCAN SWITCH=0 FOR NOW
	HLLZS	DEVSFD##(F)	;START AT UFD
	PUSHJ	P,PPNPP0	;GET PPN
	MOVEM	T1,DEVPPN(F)	;SAVE AS PPN
	SKIPN	DEVNAM(F)	;IF NOT SETTING LIB,
	JRST	SETPT7
	PUSHJ	P,PUTWRD##	;TELL USER
	  JRST	ADRERR##	;CANT STORE IN PROTECTED JOB DATA AREA
SETPT7:	TLO	M,UUOLUK	;INDICATE LOOKUP
	MOVSI	T1,(SIXBIT .SFD.)
	MOVEM	T1,DEVEXT(F)	;PREPARE TO LOOKUP SFD'S
	PUSH	P,DEVUNI##(F)	;SAVE DEVUNI (FNDFIL WILL CHANGE IT)
	SKIPN	T1,DEVNAM(F)	;UFD IF DEVNAM ALREADY IS ZERO
	AOSA	DEVNAM(F)	;SET DEVNAM NON-ZERO
SETPT8:	JRST	[PUSHJ P,NXTSLN	;GET NEXT SFD IN LOGICAL NAME
		   PUSHJ P,GETWD1## ;NOT LOG NAME, GET USERS ARG
		 JRST .+1]
	SKIPE	DEVFIL(F)	;IF NOT 1ST TIME,
	JUMPE	T1,SETP12	; 0 TERMONATES THE LIST
	MOVEM	T1,DEVFIL(F)	;SAVE SFD NAME (0 MEANS UFD)

	MOVSI	P3,DEPPRV##	;DON'T CHECK PRIVS
	IORM	P3,DEVPRV##(F)	; IN LOWER SFDS
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  JRST	SETP14		;NONE - ERROR
	MOVE	T2,T1
				;SO CHK PRV WONT BE CALLED
	MOVE	P4,S		;SAVE IOSRDC
	PUSHJ	P,FNDFIL##	;LOOKUP NAME.SFD
	  JRST	SETP14		;NOT FOUND
	TLNN	P4,IOSRDC
	TLZ	S,IOSRDC	;IOSRDC IS FOR FILE, NOT SFD
	MOVEM	S,DEVIOS(F)	; SO CLEAR IT
	ANDCAM	P3,DEVPRV##(F)
	PUSHJ	P,SFDDEC	;DECR NMB USE-COUNT
	SKIPN	DEVFIL(F)	;LOOKING FOR UFD?
	JRST	SETP10		;YES
				;NO, FALL INTO NEXT PAGE
;HERE WHEN NAME.SFD WAS FOUND BY FNDFIL
	PUSHJ	P,DECSFD	;DECREMENT USE-COUNTS OF OLD SFD
	PUSHJ	P,GETNMB	;FIND NMB FOR NEW SFD
	CAMN	T1,P2		;THE FORBIDDEN NMB?
	JRST	SETP13		;YES, ERROR
	HRRM	T1,DEVSFD##(F)	;SAVE AS CURRENT SFD
	PUSHJ	P,INCSFD	;INCREMENT ITS USE-COUNTS
	SKIPL	T1,DEVNAM(F)	;IF DEVNAM IS A POSITIVE NUMBER
	TLNE	T1,-1
	JRST	SETPT9
	SOSG	DEVNAM(F)	;DECR BY 1
	AOJA	P1,SETP12	;DONE ALL HE ASKED FOR - RETURN
SETPT9:	MOVEI	T1,1(P1)	;COUNT LEVEL UP
	CAIGE	T1,MAXLVL##	;TOO HIGH?
	AOJA	P1,SETPT8	;NO, TRY NEXT NAME IN USERS LIST
	AOJA	P1,SETP12	;YES, DONE

;HERE ON GOOD RETURN FROM FNDFIL WITH DEVFIL=0 (LOOKING FOR UFD)
SETP10:	HRRZ	T1,DEVACC##(F)	;SAVE DEVACC (LOC OF UFB)
	TLZE	P1,400000	;SETTING LIB?
	TSOA	T1,P1		;YES, COPY SYS AND NEW BITS
	TRO	T1,JBPUFB##	;NOT LIB, INDICATE UFD
	HRRM	T1,DEVSFD##(F)	;SAVE IN DDB
SETP12:	HLRZS	P1		;SCAN SWITCH
	DPB	P1,DEYSCN##	;SAVE IN DDB
	POP	P,DEVUNI##(F)	;RESTORE DEVUNI
	HRRZ	U,DEVUNI##(F)	; AND U
	HLLZS	T2,DEVACC##(F)	;WANT TO RECOMPUTE PROTECTION
	DPB	T2,DEYFNC##	; SO SET THE BYTE=0
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;HERE ON ERROR RETURN FROM SETSRC OR FNDFIL
SETP13:	HRRZ	T1,DEVACC##(F)	;DECREMENT FAILING SFD'S
	PUSHJ	P,DECONE	; USE COUNT
	JRST	SETP15
SETP14:	PUSHJ	P,DECSFD	;DECR USE COUNT
	PUSHJ	P,SFDDEC
SETP15:	HLLZS	DEVACC##(F)	;ZERO DEVACC
	ANDCAM	P3,DEVPRV##(F)
	POP	P,DEVUNI##(F)
	POPJ	P,		;AND ERROR RETURN
SETP16:	TRNE	T1,-20
	PUSHJ	P,UADRCK##
	POPJ	P,
;LOGICAL END OF SLSTR, PUT IN FILUUO WITH REST OF PATH STUFF
;FIXES UP ACCESS TABLES, ACCESS TABLE COUNTS WHEN AN STR IS ADDED TO S.L.
; AND THE DEFAULT PATH IS IN AN SFD
;WIPES OUT P1-P4, RETURNS CPOPJ1
;ENTER, EXIT WITH CB
ADJPT::	PUSHJ	P,SFDPPN	;% GET DEFAULT PATH
	JUMPE	T2,CPOPJ1##	;%NOTHING TO DO IF IT ISN'T AN SFD
	SETZB	P1,P3		;%
	PUSHJ	P,FAKDDB	;%GET A DDB TO WORK WITH
	  JRST	ADJPT6		;%NO FREE CORE, HOPE FOR THE BEST
ADJPT1:	PUSHJ	P,SFDPPJ	;%GET DEFAULT SFD
	JUMPN	P1,ADJPT2	;%IF FIRST TIME,
	HRLI	M,UUOLUK	;%INDICATE LOOKUP
	EXCH	P3,F		;%ZERO F CAUSE WE ALREADY HAVE CB
	PUSHJ	P,DECALL	;%DECREMENT USE-COUNTS IN CURRENT SFD A.T'S
	MOVE	F,P3		;%RESTORE F
	MOVEM	T4,DEVPPN(F)	;%SAVE PPN
	MOVSI	T2,'SFD'	;%SAVE EXTENSION
	MOVEM	T2,DEVEXT(F)
ADJPT2:	CAIN	P1,(T1)		;%ARE WE AT DEFAULT PATH?
	JRST	ADJPT5		;%YES, FINISH UP
	MOVE	T2,T1		;%NO, SAVE CURRENT SFD
ADJPT3:	HLRZ	T1,NMBPPB##(T1)	;%SEARCH FOR ITS FATHER SFD (OR UFD)
	TRZN	T1,NMPUPT##
	JUMPN	T1,ADJPT3
	CAIN	T1,(P1)		;%ARE WE THERE?
	JRST	ADJPT4		;%YES
	MOVE	T2,T1		;%NO, SAVE THIS AS CURRENT
	JUMPN	T1,ADJPT3	;%AND FIND ITS FATHER
	JRST	ADJPT7		;%SYSTEM ERROR
ADJPT4:	HRRM	T1,DEVSFD##(F)	;%SAVE FATHER SFD
	MOVE	T1,(T2)		;%GET NAME OF CURRENT SFD
	MOVEM	T1,DEVFIL(F)	;%SAVE IT FOR FNDFIL
	MOVE	T2,ALLSRC##
	MOVE	P2,JBTSFD##(J)
	HLLZS	JBTSFD##(J)	;%DON'T WANT FILFND TO MESS WITH SFDS
	PUSHJ	P,FNDFLA##	;%GO LOOKUP THIS SFD
	  JRST	ADJPT8		;COULDN'T?
	MOVE	J,.CPJOB##
	MOVEM	P2,JBTSFD##(J)	;RESTORE DEFAULT SFD
	PUSHJ	P,GETNMB	;GET NMB, AT FOR THIS SFD
	HRRM	T1,DEVSFD##(F)	;SAVE SFD NMB LOC
	HRRZ	P1,T1		;SAVE WHERE WE ARE NOW
	PUSHJ	P,SFDEC		;DECREMENT PPB,NMB CNTS WHICH FILFND INCR'D
	PUSHJ	P,GETCB##
	MOVNI	T1,ACPCNT##	;%DECREMENT USE-COUNT
	ADDM	T1,ACCCNT##(T2)	;%IN CURRENT AT
	JRST	ADJPT1		;%AND GO LOOKUP NEXT SFD (IF NOT UP TO DEFAULT)
;HERE WHEN "REAL" SFD HAS BEEN LOOKED UP
ADJPT5:	HRRZ	T1,DEVSFD##(F)	;%CURRENT SFD (=DEFAULT)
	SETZ	F,		;%CAUSE WE HAVE CB
	PUSHJ	P,INCALL	;%BUMP USE-COUNTS IN ALL AT'S
	MOVE	F,P3
	PUSHJ	P,CLRDDB	;%RETURN THE DDB
ADJPT6:	SETZ	F,
	JRST	CPOPJ1##	;%AND GOOD RETURN

;HERE WHEN FILE.SFD CANT BE FOUND
ADJPT8:	PUSHJ	P,GETCB##	;GETCB BACK
ADJPT7:	MOVE	J,.CPJOB##
	HLLZS	JBTSFD##(J)	;%CLEAR DEFAULT SFD
	PJRST	ADJPT6		;%AND FINISH UP
;ROUTINE TO FIX THE ACC USE COUNT
;BUMPS THE COUNT ONCE FOR EACH JOB THAT HAS HIS PATH SET TO THE SFD
;T1 PASSES ADDR OF NMB
;T2 PASSES ADDR OF ACC
;PRESERVES ALL AC'S
FIXPTH::PUSHJ	P,SAVE3##	;PRESERVES AC'S
	HLRZ	P1,NMBRNG##(T1)	;ONLY IF SFD
	JUMPE	P1,CPOPJ##
	MOVE	P1,HIGHJB##	;SET UP LOOP
	MOVEI	P3,ACPCNT##
FXPTH1:	HRRZ	P2,JBTSFD##(P1)	;IS HIS PATH HERE?
	TRZ	P2,CORXTR##
	CAMN	P2,T1
	ADDM	P3,ACCCNT##(T2)	;YES, BUMP COUNT
	SOJG	P1,FXPTH1	;TEST EACH JOB
	POPJ	P,
;SUBROUTINE TO INCREMENT/DECREMENT THE USE-COUNT OF AN SFD A.T.
;ENTER WITH T1=LOC OF THE A.T.
;ENTER WITH F=0 IF HAVE CB
;EXIT T1=LOC OF THE A.T.
INCONE:	SKIPA	T2,[EXP ACPUSE##];SET TO INCR. COUNT
DECONE::MOVNI	T2,ACPUSE##	;SET TO DECR COUNT
	PUSHJ	P,GETCBX##
	ADDM	T2,ACCUSE##(T1)	;%UPDATETHE USE COUNT
	JUMPGE	T2,INCON2	;%
	MOVE	T2,ACCUSE##(T1)	;%IF DECREMENTING,
	TRNN	T2,ACMUCT##+ACPREN+ACPCRE	;%IF NOW UNUSED,
	SKIPE	ACCDOR##(T1)	;%
	PJRST	GVCBJX##	;%
	PJRST	ATSDRA##	;%MAKE THE A.T. DORMANT
INCON2:	SKIPN	T2,ACCDOR##(T1)	;%IF INCREMENTING,
	PJRST	GVCBJX##	;%
	EXCH	T1,T2		;%
	PUSHJ	P,UNLINK##	;%MAKE UNDORMANT IF IT WAS DORMANT
	MOVE	T1,T2		;%
	PJRST	GVCBJX##	;%


;SUBROUTINE TO INCREMENT/DECREMENT THE A.T. OF THE FATHER SFD FOR A FILE
INCUSA:	SKIPA	T1,INCLOC
DECUSA:	MOVEI	T1,DECONE
	PUSH	P,T1		;WHERE TO GO
	PUSHJ	P,UFORSS##	;FIND UFB OR SFD A.T.
	TRZN	T2,NMPSFU##	;SFD?
	PJRST	TPOPJ##		;NO, RETURN
	MOVE	T1,T2		;YES, A.T. LOC INTO T1
INCLOC:	POPJ	P,INCONE	;GO INCR OR DECR THE USE-COUNT
;SUBROUTINE TO INCREMENT ALL A.T.'S FOR AN SFD
;ENTER WITH T1=LOC OF SFD NMB
;EXIT WITH T1=LOC OF SFD NMB
;ENTER WITH F=0 IF HAVE CB
INCALL:	SKIPA	T2,INCLOC
DECALL::MOVEI	T2,DECONE
	PUSH	P,F
	PUSHJ	P,GETCBX##	;GET CB IF DONT HAVE IT ALREADY
	SETZ	F,		;INDICATE NOW HAVE CB
	PUSH	P,T2		;WHERE TO GO
	HLRZ	T1,NMBACC##(T1)	;1ST A.T. LOC
DECAL1:	TRZE	T1,DIFNAL##	;BACK TO THE NMB?
	JRST	DECAL2		;YES, FINISH UP
	HRL	T1,ACCSTS##(T1)	;STILL BEING CREATED?
	TLNN	T1,ACPCRE
	PUSHJ	P,@(P)		;NO, GO INCR OR DECR
	HLRZ	T1,ACCNMB##(T1)	;STEP TO NEXT A.T.
	JRST	DECAL1		;AND DO IT
DECAL2:	POP	P,(P)		;REMOVE GARBAGE FROM PD LIST
	POP	P,F		;RESTORE F (MAY STILL BE 0)
	PJRST	GVCBJX##	;RETURN CB IF GOT IT ABOVE
;SUBROUTINE TO DECREMENT ALL A.T.'S FOR THE FATHER SFD EXCEPT
; THE ONE FOR THE STR ON WHICH THE FILE ACTUALLY IS
;(NEEDED SINCE SETLER INCREMENTS ALL A.T.'S, BUT AFTER THE LOOKUP/ENTER
; PICKS AN STR, ONLY THAT A.T. SHOULD HAVE ITS COUNT UP)
DECMST:	PUSHJ	P,UFORSF##	;FIND SFD A.T. OR UFB
	  JRST	DECMS1
	TRZN	T2,NMPSFU##	;SFD?
	POPJ	P,		;NO
	MOVE	T1,T2		;YES, GET ITS LOC IN T1
	PUSHJ	P,INCONE	;INCR ITS USE-COUNT (DECSFD WILL DECR ALL AT'S)

				;AND FALL INTO DECSFD

;SUBROUTINE TO DECREMENT ALL A.T.'S FOR THE FATHER SFD
DECSFD:	HRRZ	T1,DEVSFD##(F)	;LOC OF SFD NMB
	JUMPE	T1,CPOPJ##
	PJRST	DECALL		;DECR ALL A.T. COUNTS


;SUBROUTINE TO INCREMENT ALL SFD'S FOR THE FATHER SFD EXCEPT C(DEVACC)
;NEEDED SINCE FNDFIL INCREMENTS THE USE-COUNT OF THE 1ST SFD A.T. IN THE RING
; WHEN A LOOKUP IS DONE ON THE SFD
INCSFD:	HRRZ	T1,DEVSFD##(F)	;L(NMB)
	PUSHJ	P,INCALL	;INC ALL USE-COUNTS
	HRRZ	T1,DEVACC##(F)	;THEN DECR THE RIGHT ONE
	PJRST	DECONE

;HERE IF NO SFD AT WAS FOUND
DECMS1:	HLLZ	T2,DEVSFD##(F)	;RENAMING ACCROSS SFD's?
	JUMPN	T2,CPOPJ##	;YES, THIS IS OK
	PJRST	BNTSTP##	;NO, CRASH
;ROUTINE TO EXTRACT INFORMATION ABOUT THE DEFAULT SFD AND PPN
;ENTER AT SFDPPJ IF J IS NOT SET UP (GET FROM DDB)
;ENTER AT SFDPPN IF J=JOB NUMBER
;ENTER AT SFDPP1 WITH T1=LOC OF SFD
;EXIT CPOPJ WITH T4=PPN
;T3=JBPUFB & JBPSCN BITS
;T2=0 IF NO DEFAULT OR DEFAULT IS A BARE UFD, ELSE = L(SFD NMB)
;T1=JBTSFD, WITH EXTRANEOUS BITS =0
;LH(T1)= L(PPB) IF A DEFAULT IS GIVEN (RH(T1) NOT 0)
SFDPPJ:	LDB	J,PJOBN##	;JOB NUMBER
SFDPPN:	HRRZ	T1,JBTSFD##(J)	;LOC OF DEFAULT SFD
SFDPP1:	SETZB	T2,T3
	JUMPE	T1,SFDPP2	;RETURN PPN IF NO DEFAULT
	LDB	T3,SFYSCU##	;JBPUFB & JBPSCN
	TRZ	T1,CORXTR##	;ZERO EXTRANEOUS BITS
	HRLS	T1		;LH(T1)=L(PPB) IF JBPUFB=1
	TRNE	T3,JBPUFB##	;IS IT A UFB?
	SKIPA	T4,PPBNAM##(T1)	;YES, T4=PPN
	SKIPA	T2,T1		;NO, T2=L(SFD NMB)
	POPJ	P,		;RETURN IF A UFB
	HLRZ	T4,NMBACC##(T1)	;L(1ST A.T. IN RING)
	TRNE	T4,DIFNAL##	;IS THERE AN A.T.?
	JRST	SFDPP2		;NO. SYSTEM ERROR?
	MOVE	T4,ACCPPB##(T4)	;YES, GET L(PPB)
	HRL	T1,T4		;SAVE IN LH(T1)
	SKIPA	T4,PPBNAM##(T4)	;SET T4=PPN
SFDPP2:	MOVE	T4,JBTPPN##(J)	;PPN=JOB'S PPN
	POPJ	P,
;SUBROUTINE TO SEE IF THIS IS THE ONLY USER OF A PPN
;CALL WITH T1=PPN, J=JOB NUMBER
;EXITS POPJ IF THERE IS ANOTHER JOB WITH THIS PPN, OR SOME JOB
; HAS A DEFAULT PATH IN THIS PPN
;EXITS CPOPJ1 IF NO OTHER JOB IS USING PPN
;EXITS UNDER THE NOSCHED MACRO, WITH T1=PPN
ONLYTS:	CAME	T1,SYSPPN##	;IF CUSP
	CAMN	T1,MFDPPN##	; OR MFD
	POPJ	P,		;PRETEND STILL LOGGED IN
	CAMN	T1,SPLPPN##	;IF QUEUE AREA
	POPJ	P,		; PRETEND STILL LOGGED IN
	PUSHJ	P,SAVE1##
	PUSH	P,J		;SAVE J
	NOSCHEDULE
	MOVE	P1,T1		;SAVE PPN
	MOVE	J,HIGHJB##
ONLYT1:	CAMN	J,(P)		;DON'T TEST THE JOB FOR WHICH WE'RE LOOKING
	JRST	ONLYT3
	HLRZ	T1,JBTSFD##(J)	;LOC OF LIB
	TRZ	T1,CORXTR##	;ZAP THE EXTRA BITS
	SKIPE	T1		;0 IF NO LIB
	MOVE	T1,PPBNAM##(T1)	;PPN
	CAMN	T1,P1		;IS IT THE RIGHT ONE?
	JRST	ONLYT2		;YES, NON-SKIP RETURN
	PUSHJ	P,SFDPPN	;GET DEFAULT PPN
	CAME	P1,T4		;IS IT THIS PPN?
	CAMN	P1,JBTPPN##(J)	;IS IT JOB'S PPN?
ONLYT2:	SOSA	-1(P)		;YES, SET FOR NON-SKIP RETURN
ONLYT3:	SOJG	J,ONLYT1	;NO, TEST NEXT JOB
	POP	P,J		;RESTORE J
	MOVE	T1,JBTPPN##(J)	; AND PPN
	PJRST	CPOPJ1##	;TAKE SKIP OR NON-SKIP RETURN
;SUBROUTINE TO CLEAN UP WHEN CHANGING DEFAULT SFD'S FROM ONE PPN TO ANOTHER
;ENTER WITH T1= OLD PPN, P2=LOC(PPB) - AS RETURNED BY SFDPPN
;ENTER AT PTHCHX IF THIS JOB SHOULD BE LOOKED AT
;(E.G. CHANGING LIB, BUT DEFAULT PATH FOR THAT PPN EXISTS)
PTHCHX:	SETZ	J,
PTHCHG:	PUSHJ	P,ONLYTS	;ANY OTHER JOB WITH THIS PPN?
	  JRST	[LDB J,PJOBN##	;YES, RETURN
		 POPJ P,]
	PUSHJ	P,GTMNBF##	;NO, GET A MON-BUF
	MOVE	T1,PPBNAM##(P2)	;PPN
	MOVEM	T1,DEVPPN(F)	;SAVE IN DDB
	AOS	PPBCNT##(P2)	;PROTECT AGAINST OTHER CLOSERS
	MOVEI	T1,PPPNLG##	;INDICATE PPN NOT LOGGED-IN
	ANDCAM	T1,PPBNLG##(P2)
	HLRZ	T1,PPBUFB##(P2)	;LOC OF 1ST UFB
	JUMPE	T1,PTHCH2
PTHCH1:	HRRM	T1,DEVUFB##(F)	;SAVE IN DEVUFB
	LDB	T1,ACZFSN##	;STR NUMBER
	MOVE	T1,TABSTR##(T1)

	HLRZ	U,STRUNI##(T1)	;SET U TO 1ST UNIT IN STR
	PUSHJ	P,STOAU##	;SAVE IN DDB
	PUSHJ	P,LOGTS1	;GO REWRITE UFD WITH NEW QUOTAS
	MOVE	T1,DEVUFB##(F)	;STEP TO NEXT UFB
	HLRZ	T1,UFBPPB##(T1)
	JUMPN	T1,PTHCH1	;REWRITE IT
PTHCH2:	SCHEDULE
	SOS	PPBCNT##(P2)
	PUSHJ	P,TSTPP1	;DELETE THE 4-WORD CORE BLOCKS FOR THE PPB
	LDB	J,PJOBN##	;RESTORE JOB NO
	POPJ	P,		;AND EXIT
SUBTTL	RENAME

RENAM:	PUSHJ	P,NULTST	;ON DEVICE NUL
	  PJRST	CPOPJ1##	;RENAME WINS
	MOVE	T1,DEVLIB##(F)	;IF FILE NOT IN UFD, BUT IN LIB
	TLNE	F,LOOKB		; MAKE RENAME ILLEGAL
	TLNN	T1,DEPLIB##	; (ERROR 0 IF LOOKUP FAILED)
	SKIPN	DEVFIL(F)	;IS THERE AN OPEN FILE?
	JRST	RENER4		;NO. ERROR RETURN
	TLNE	S,IOSWLK	;STR WRITE LOCKED?
	JRST	RENER3		;YES. ERROR RETURN
RECLSD:	PUSHJ	P,SAVE4##	;SAVE P1-P4
	TLZ	M,UUOMSK	;ZERO INDICATOR BITS IN M
	MOVE	P2,M		;SAVE ORIGINAL ADDRESS
	PUSHJ	P,GTWST2##	;GET 1ST WORD
	JUMPE	T1,RENAM1	;RENAMING TO ZERO
	TLNE	T1,-1		;EXTENDED UUO?
	JRST	RENAM1		;NO
	MOVE	P3,T1		;YES, SAVE NUMBER OF ARGS
	TLO	P2,EXTUUO	;SET EXTENDED BIT
	HRRI	M,UUXNAM(M)	;POINT TO FILENAME
	PUSHJ	P,GTWST2##	;GET IT
RENAM1:	TLNE	F,LOOKB+ENTRB	;DOES HE HAVE A FILE OPEN?
	JRST	RENAM2		;YES
	HRRZS	T3,DEVSFD##(F)	;NO, WAS PREVIOUS FILE IN AN SFD?
	JUMPE	T3,RENAM2	;NOT SFD, LET HIM DO IT
	PUSHJ	P,SFDPPN	;WE CAN'T BE SURE THAT THE NMB  DEVSFD
	HRRZM	T2,DEVSFD##(F)	; POINTS TO IS STILL THERE, SO FORGET
	MOVEM	T4,DEVPPN(F)	; DEVSFD AND USE DEFAULT PATH INSTEAD
	PUSHJ	P,SFDUP		;BUMP PPBCNT AND NMBCNT
RENAM2:				;FALL INTO NEXT PAGE
	TLNN	F,ENTRB		;AN ENTER BEEN DONE?
	JRST	RENAM3		;NO

;HERE ON A RENAME WITH AN OPEN OUTPUT FILE - HAVE TO CLOSE IT
;SINCE WE WILL NEED THE DDB POINTER SPACE TO READ THE UFD
	HRRI	M,0		;THESE BITS MEAN THINGS TO CLOSE
	TLNE	F,LOOKB		;CREATE OR UPDATE?
	SETO	T1,		;UPDATE, CLSRST WON'T MAKE IT GO AWAY
	SKIPN	T1		;DELETE A CREATE?
	TROA	M,CLSRST	;YES, TELL CLOSE NOT TO ENTER IN UFD
	PUSHJ	P,SFDUP		;NO, BUMP THE COUNTS SO THAT THE BLOCK
				; DEVSFD POINTS TO WON'T GO AWAY WHILE THE
				; FILE IS CLOSED.
	PUSH	P,DEVUPP##(F)	;SAVE "IN YOUR BEHALF" PPN
	PUSHJ	P,CLOSE1##	;CLOSE THE FILE
	POP	P,DEVUPP##(F)	;RESTORE PPN THAT CLOSE1 BLEW AWAY
	TRNE	M,CLSRST	;DELETE A CREATE?
	JRST	CPOPJ1##	;YES, ALL DONE
RENAM3:	MOVE	M,P2		;RESTORE ORIGINAL ADDRESS
	PUSHJ	P,WAIT1##
	PUSHJ	P,DDBZR		;OUTPUT CLOSE WANTS TO CALL DD2MN
	TLO	M,UUOLUK	;INDICATE LOOKUP FOR FNDFIL
	HLRZ	U,DEVUNI##(F)	;SET U IN CASE DON'T GO TO FNDFIL
	JUMPE	U,RENM3A	;U MAY BE ZERO IF RENAME AFTER CLOSE (MAYBE LEGAL)
	PUSHJ	P,CHEKU##	;CHECK IF STR YANKED
	  JRST	RENER5		;PRETEND FILE NOT FOUND
RENM3A:	HRRZ	P2,DEVACC##(F)	;LOC OF ACCES BLOCK
	JUMPN	P2,RENAM5	;DON'T HAVE TO LOOKUP IF THERE
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  POPJ	P,		;NULL LIST - SHOULD NEVER HAPPEN
	MOVE	T2,T1		;SEARCH LIST INTO T2

	PUSHJ	P,FNDFIL##	;SET UP AN ACCESS BLOCK FOR IT
	  JRST	RENER5
	PUSHJ	P,INCUSA	;INCREMENT USE-COUNT OF FATHER SFD
	PUSH	P,DEVUFB##(F)	;SAVE DEVUFB IN CASE OF FAILURE

	PUSHJ	P,RENAM4	;AND GO DO REST OF RENAME
	  PJRST	REFAIL		;ERROR - FIX UP ACCESS TABLE
				;(UUOCON WONT DO A CLOSE SINCE THE RENAME FAILED)
	PJRST	TPOPJ1##	;GOOD RETURN
;HERE ON RENAME FAILURE
REFAIL:	TLZ	S,IOSRIB	;INVALIDATE RIB IN MONITOR BUFFER (SECURITY)
	POP	P,DEVUFB##(F)	;RESTORE DEVUFB
	HRRZ	T1,DEVACC##(F)
	JUMPE	T1,CLOSIN
	PUSHJ	P,CLSNAM
	PJRST	CLOSIN		;FIX ACCESS TABLE AND EXIT


RENAM4:	TLO	F,LOOKB		;SET SO CLOSE INPUT WILL HAPPEN
	TLZ	F,OCLOSB+ICLOSB
	SKIPA	P2,DEVACC##(F)	;LOC OF A.T. INTO P2

RENAM5:	PUSHJ	P,CLSNAM	;GET REAL NAME OF FILE (IN CASE OF UNSUCCESSFUL
				; RENAME DEVFIL, DEVEXT ARE WRONG)
	HRRZ	T2,ACCNDL##(P2)	;NO-DELETE WORD
	TRNE	T2,ACPNDL##	;IS THIS A MAGIC FILE?
	MOVSI	T2,-1		;YES, NOT EVEN [1,2] CAN DELETE IT
	TLNE	M,EXTUUO	;EXTENDED UUO?
	HRRI	M,UUXNAM(M)	;YES, POINT TO FILENAME
	PUSHJ	P,GTWST2##	;GET FILENAME
	JUMPN	T1,RENA11	;GO IF NOT DELETE
;HERE WHEN RENAMING A FILE TO 0 (DELETING)
	JUMPL	T2,RENE16	;NDL FILE IF T2 NEG
	PUSHJ	P,ZDYFNC	;ZERO DEYFNC
	MOVEI	T1,FNCDEL##	;CAN USER DELETE FILE?
	PUSHJ	P,CHKPRV##
	  JRST	RENE16		;NO. ERROR RETURN
	MOVE	T2,ACCDIR##(P2)	;IS FILE A DIRECTORY?
	TRNN	T2,ACPDIR##
	JRST	DIRDL4		;NO
	MOVE	T2,ACCSTS##(P2)	;YES, GET USE-COUNT
	TRNE	T2,ACMUCM##	;IS COUNT=1 (FOR THIS READER)?
	JRST	DIRDL2		;NO, CANT DELETE
	MOVE	T2,ACCPT1##(P2)	;YES, GET RETRIEVAL INFO
	MOVE	T1,ACCUN1##(P2)
	PUSHJ	P,SETFS0##	;SET UP TO READ THE DIRECTORY
	  JRST	DIRDL2
	PUSH	P,DEVSFD##(F)	;SAVE L(SFD)
	PUSHJ	P,GETNMB	;GET L(NMB)
	HRRM	T1,DEVSFD##(F)	;SAVE AS DEVSFD
DIRDL1:	PUSHJ	P,DIRRED##	;READ A DIRECTORY BLOCK
	  JRST	DIRDL3		;EOF - IT'S EMPTY
	SKIPN	1(T1)		;GOT A BLOCK - EMPTY?
	JRST	DIRDL1		;YES, READ NEXT
	POP	P,DEVSFD##(F)	;RESTORE DEVSFD
DIRDL2:	MOVEI	T1,DNEERR	;DIR-NOT-EMPTY
	AOJA	M,PUTERR	;RETURN THE ERROR
DIRDL3:	POP	P,DEVSFD##(F)	;RESTORE DEVSFD
DIRDL4:	PUSHJ	P,UPAU##	;GET AU
	PUSHJ	P,GETCB##
	HRRZ	T1,P2		;GET ACCESS TABLE ADDRESS
	MOVEI	T2,ACPNDR##	;NO DELETE ON RESET REQUESTED?
	TDNN	T2,ACCSTS##(T1)
	JRST	NONDR		;NO, FILE CAN BE DELETED
	PUSHJ	P,ENQNDR##	;DOES QUESER STILL NEED THIS FILE?
	  JRST	RENE19		;YES,IT CAN'T BE DELETED
	ANDCAM	T2,ACCSTS##(T1)	;CLEAR BIT NOW
NONDR:
	MOVE	T1,ACCSTS##(P2)	;%STATUS OF FILE
	TRNE	T1,ACPUPD	;%FILE BEING UPDATED BY ANOTHER JOB?
	JRST	RENE17		;%YES, ERROR RETURN
	TROE	T1,ACPDEL##+ACPNIU	;%NO, FILE ALREADY MARKED FOR DELETION?
	JRST	RENAM9		;%YES, JUST CLOSE FILE
	MOVEM	T1,ACCSTS##(P2)	;%NO, SET FOR DELETE AFTER LAST READER CLOSES
	PUSHJ	P,GETNMB	;%GET LOC OF NMB
	MOVE	P1,T1		;%NMB LOC INTO P1
	LDB	T1,ACYFSN##	;%FSN

	PUSHJ	P,FSNPS2##	;%SET A BIT FOR THIS STR
	ANDCAM	T2,NMBYES##(P1)	;%INDICATE FILE ISNT IN THIS STR
	HLLZS	NMBCFP##(P1)	;%MAKE SURE A BAD CFP ISN'T LEFT AROUND
	HLRZ	T3,DEVEXT(F)	;GET EXTENSION
	CAIE	T3,'UFD'	;IS THIS A UFD?
	JRST	RENAM7		;%NO
	MOVE	P3,T2		;%YES. SAVE FSN BIT
	PUSHJ	P,GVCBJ##	;%GIVE UP CB RESOURCE
	PUSHJ	P,FNDUFB	;FIND UFB FOR THIS FILE
	  JRST	RENAM8		;NOT THERE
	SETZM	UFBPT1##(T2)	;%ZERO POINTER TO UFD
	ANDCAM	P3,PPBYES##(T1)	;%INDICATE UFD NO LONGER THERE
	SETZM	UFBWRT##(T2)	;% IN CASE UFD GETS RECREATED

RENAM7:	PUSHJ	P,GVCBJ##	;%GIVE UP CB
RENAM8:	PUSH	P,DEVUNI##(F)	;SAVE DEVUNI (DELNAM WILL CHANGE IT)
	PUSHJ	P,DELNAM	;REMOVE FILE NAME FROM UFD
	  PUSHJ	P,DWNAU##	;ANOTHER JOB MUST HAVE DELETED THE NAME
	POP	P,U		;RESTORE DEVUNI(FOR INPUT-CLOSE)
	PUSHJ	P,STOAU##
	TLZ	F,RENMB+ENTRB	;SO CLOSE INPUT WONT THINK CLOSE OUTPUT WILL HAPPEN
	TLZE	S,IOSRDC	;IS FILE READING?
	JRST	RENA10		;YES - LOOKUP, RENAME OR ENTER,CLOSE,RENAME DONE
	MOVEI	T1,ACPCNT##	;NO. ENTER, RENAME DONE - FAKE UP A.T.
	ADDM	T1,ACCCNT##(P2)	;SO CLOSIN WILL DELETE THE FILE
	JRST	RENA10
RENAM9:	PUSHJ	P,GVCBJ##	;%GIVE UP CB
	PUSHJ	P,DWNAU##	;GIVE UP AU
RENA10:	PUSHJ	P,CLOSRN	;GO FINISH UP FILE
	TLZ	F,LOOKB		;ZERO LOOKB SO A FOLLOWING ENTER WILL SUCCEED
	PUSHJ	P,JDAADR##	;GET CHAN NUM
	HLLM	F,(T1)		;UUOCON WONT SAVE LH(F)
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN
;HERE TO RENAME A FILE TO SOMETHING (NOT DELETE)
RENA11:	JUMPL	T2,RENE16	;NDL FILE IF T2 NEG
	PUSHJ	P,TSTWRT	;CAN THIS FILE BE RENAMED?
	  JRST	RENE18		;NO, ALREADY BEING WRITTEN - FBMERR
	PUSH	P,M		;SAVE LOC OF NAME
	HRRI	M,UUXPRV-UUXNAM(M)	;POINT TO PROT WORD
	TRZ	P3,RB.BIT	;CLEAR NOISE BITS
	TLNN	M,EXTUUO	;EXTENDED UUO?
	MOVEI	P3,UUXPRV	;NO, THEN PRIV WORD IS ALWAYS THERE
	CAIGE	P3,UUXPRV	;IS PRIV WORD THERE?
	TDZA	T1,T1		;NO, DON'T CHANGE PRIVS
	PUSHJ	P,GETWDU##	;GET IT
	SKIPE	T1		;TRYING TO CHANGE IT?
	XOR	T1,ACCPRV##(P2)	;MAYBE, XOR WITH ORIGINAL PROT
	HLRZ	P1,DEVEXT(F)	;FNCCAT IS NEVER LEGAL FOR UFD
	CAIN	P1,'UFD'	;IS THIS THE UFD?
	TLO	T1,777000	;YES, TRY FNCCPR (IT'S SOMETIMES LEGAL)
	LDB	P1,[POINT 9,T1,8];GET 0 OR NEW PROT
	SKIPN	T1,P1		;IF 0 HE ISNT CHANGING PROT
	TROA	T1,FNCCAT##	; SO TEST TO SEE IF HE CAN CHANGE ATTS
	MOVEI	T1,FNCCPR##	;CHANGING PROT, SEE IF HE CAN
	PUSHJ	P,CHKPRV##	;LEGAL?
	  TLOA	P1,400000	;NO, P1 NEGATIVE
	SETZ	P1,		;YES, P1 0
	SKIPE	P1		;IF P1 IS NOT 0
	TLO	P1,200000	;CANT CHANGE PROTECTION, TRYING TO
	MOVE	M,(P)		;RESTORE LOC OF NAME
	HRRI	M,-1(M)		;POINT M TO PPN
	TLNN	M,EXTUUO	;EXTENDED-FORMAT ARG BLK?
	HRRI	M,UUNPPN-UUNNAM+1(M)	;NO, ADVANCE TO E+3
	HRLS	DEVSFD##(F)	;SAVE OLD DIRECTORY IN LH(DEVSFD)
	HRRZS	-1(P)		;SET LH (PD WRD) = 0 IF NO PATH GIVEN
	PUSHJ	P,GETWDU##	;GET PPN
	SKIPLE	P4,T1
	TLNE	P4,-1		;POINTER TO A PATH?
	JRST	RENA12		;NO
	HRRI	M,2(P4)		;YES. POINT TO PPN
	HRROS	-1(P)		;INDICATE A PATH IS GIVEN
	PUSHJ	P,GETWDU##	;GET PPN
	SKIPE	P4,T1		;SAVE PPN IN P4
RENA12:	SKIPG	P4		;IF NO PPN GIVEN,
	MOVE	P4,DEVPPN(F)	;USE SAME PPN AS LOOKED-UP FILE
	MOVE	T1,DEVNAM(F)	;DEVICE NAME
	PUSHJ	P,SDVTST	;ERSATZ?
	  JRST	RENA13		;NO
	SKIPLE	@SDVPPN##(T2)	;YES, IS THERE AN IMPLIED PPN?
	MOVE	P4,@SDVPPN##(T2) ;YES, USET IT IN SPITE OF WHAT E+3 SAYS
RENA13:	MOVE	T1,P4		;TELL USER THE PPN
	PUSHJ	P,PUTWDU##
	POP	P,M		;RESTORE LOC OF NAME
	MOVE	T4,M		;SAVE LOC OF NAME
	PUSHJ	P,GETWDU##
	CAMN	P4,DEVPPN(F)	;IF NOT CHANGING PPN
	TLNN	P1,200000	;IF TRYING TO CHANGE PROT AND CANT
	CAIA
	JRST	RENE15		;LOSE WITH PROT ERR
	CAMN	P4,DEVPPN(F)

	CAME	T1,DEVFIL(F)	;RENAMING TO SAME NAME?
	JRST	RENA14		;NO
	PUSHJ	P,GETWD1##	;GET EXTENSION
	TRZ	T1,-1
	HLLZ	T2,DEVEXT(F)	;OLD EXTENSION
	XOR	T1,T2
	SKIPL	(P)		;PATH SPECIFIED?
	JUMPE	T1,RENA22	;NO, JUMP IF EXTENSIONS MATCH
;HERE WHEN CHANGING NAME, EXTENSION, OR DIRECTORY
RENA14:	SKIPE	T1		;IF T1=0 THEN NAME,EXT AND PPN'S MATCH
	HRRZS	(P)		;WANT PDWORD  NEGATIVE ONLY IF ALL MATCH
	HRRI	M,1(T4)		;POINT TO EXTENSION
	PUSHJ	P,GETWDU##	;GET NEW EXTENSION
	HLRZ	T2,T1
	XOR	T1,DEVEXT(F)	;SAME AS OLD?
	TLNN	T1,-1
	JRST	RENA15		;YES, CONTINUE
	PUSHJ	P,EXTCK		;NO, RENAMING TO "UFD" OR "SFD"?
	  JRST	RENE14
	HLRZ	T2,DEVEXT(F)	;NO, RENAMING FROM "UFD" OR "SFD"?
	PUSHJ	P,EXTCK
	  JRST	RENE14
RENA15:	HRRI	M,-1(T4)	;POINT M TO UUXPPN
	TLNN	M,EXTUUO	;EXTENDED UUO?
	HRRI	M,1+UUNPPN-UUNNAM(M)	;NO. POINT TO PPN WORD
	CAMN	P4,DEVPPN(F)	;NEW PPN=OLD PPN?
	JRST	RENA16		;YES
	PUSHJ	P,GETNMB	;GET L(NMB)
	HLRZ	T1,NMBRNG##(T1)	;IS FILE IN AN SFD?
	JUMPN	T1,RENER7	;YES, CANT CHANGE PPN (ELSE ALL FILES IN SFD
				; WOULD HAVE TO CHANGE ALSO)
	MOVEI	T1,FNCDEL##	;CHANGING DIRECTORIES
	PUSHJ	P,CHKPRV##	;CAN JOB DELETE FROM OLD DIRECTORY?
	  JRST	RENER7		;DELETE FROM OLD DIR IS ILLEGAL
	MOVEM	P4,DEVPPN(F)	;SAVE NEW PPN IN DDB
	SETZB	T1,P4		;OK. WIPE OUT OLD HIGHEST FUNCTION
	DPB	T1,DEYFNC##	;(WANT TO RECOMPUTE IT FOR NEW DIRECTORY)
	MOVSI	T1,DEPRAD##	;RENAMING ACROSS DIRECTORIES
	IORM	T1,DEVRAD##(F)

;HERE WHEN RENAME HAS BEEN CHECKED (IF CHANGING DIRECTORIES)
RENA16:	HRL	P2,M		;SAVE LOC OF PPN
	HRRI	M,1(M)		;POINT TO NAME WORD AT E+2
	TLNN	M,EXTUUO	;EXTENDED FORMAT ARG BLK?
	HRRI	M,-<UUNPPN-UUNNAM+1>(M)	;NO, NAME AT E+0
	PUSH	P,M		;SAVE M
	HLR	M,P2		;POINT TO PPN
	PUSHJ	P,GTWST2##	;POINTING TO A PATH?
	SKIPLE	T1
	TLNE	T1,-1
	JRST	RENA19		;NO
	HRR	M,T1		;YES, PATH LOC INTO M
	HRRZ	P3,DEVACC##(F)	;SAVE DEVACC
	PUSHJ	P,GETNMB	;SET T1="FORBIDDEN" NMB LOC
				; (ELSE AN SFD COULD "SWALLOW" ITSELF)
	PUSH	P,DEVUFB##(F)	;SAVE DEVUFB (TO TELL IF RENAMING ACROSS DIRECTORIES)
	PUSH	P,DEVLNM##(F)	;SAVE THEE LOGICAL NAME POINTER
	PUSH	P,DEVNAM(F)	;SAVE THE DEVICE NAME
	HRRZ	T1,DEVLNM##(F)	;GET THE LOGICAL NAME POINTER IF ANY
	JUMPE	T1,REN16A	;SKIP THIS IF NO LOGICAL NAME
	SETZM	DEVLNM##(F)	;PRETEND THERE ISN'T ONE
	SKIPN	T1,LNRDEV##(T1)	;GET THE DEVICE NAME WE'RE USING
	MOVSI	T1,'DSK'	;NONE.  DEFAULT
	MOVEM	T1,DEVNAM(F)	;STORE THE REAL DEVICE NAME
REN16A:	PUSHJ	P,SETPT3	;SET UP NEW PATH
	  TLO	P3,-1		;ERROR
	POP	P,DEVNAM(F)	;RESTORE THE DEVICE NAME
	POP	P,DEVLNM##(F)	;RESTORE THE LOGICAL NAME POINTER
	POP	P,DEVUFB##(F)
	HRRM	P3,DEVACC##(F)	;RESTORE DEVACC
	JUMPL	P3,SETLE8	;GO IF AN ERROR
	HRRZ	T1,DEVSFD##(F)	;NEW SFD
	HLRZ	T2,DEVSFD##(F)	;OLD SFD
	CAME	T1,T2		;NEW SFD=OLD SFD?
	JRST	RENA17		;NO, THIS REALLY DOES CHANGE SOMETHING
	PUSHJ	P,DECSFD	;YES, SETPT3 COUNTED SFD USE-COUNT UP, SO
	PUSHJ	P,SFDDEC	; DECR IT
	SKIPL	-1(P)
	JRST	RENA20		;GO IF NAME, EXT, OR PPN ARE BEING CHANGED
	POP	P,(P)		;THIS ISN'T CHANGING NAME EXT OR DIRECTORY
	HLR	M,P2		;RESTORE AC'S AND DDB
	PUSHJ	P,CLSNM
	JRST	RENA23		;AND CONTINUE

;HERE ON A RENAME CHANGING SFD'S
RENA17:	PUSHJ	P,GTUFR		;SFD EXIST ON THIS STR?
	  SKIPA	T1,SETL10	;NO
	JRST	RENA18		;YES
	POP	P,M		;RESTORE M = LOC OF NAME
	AOJA	M,RENER9
RENA18:	PUSHJ	P,DECMST	;ADJUST USE-COUNTS
	JRST	RENA20
;HERE IF NO PATH IS GIVEN
RENA19:	JUMPN	P4,RENA20	;IF CHANGING PPN'S
	HLLZS	DEVSFD##(F)	; RENAME INTO THE UFD
RENA20:	POP	P,M		;RESTORE M
	PUSHJ	P,GETWDU##	;GET NAME
	MOVEM	T1,DEVFIL(F)	;SAVE IN DDB (FOR FNDFIL)
	PUSHJ	P,GETWD1##	;GET EXTENSION
	HLLM	T1,DEVEXT(F)	;SAVE IN DDB
	HLRZS	T1		;RENAMING AN SFD?
	CAIE	T1,'SFD'
	JRST	RENA99		;NO
	HLRZ	T2,DEVSFD##(F)	;YES, COUNT OLD LEVEL
	PUSHJ	P,CNTLV0
	PUSH	P,T1		;SAVE OLD LEVEL
	PUSHJ	P,CNTLVL	;COUNT NEW LEVEL
	POP	P,T2
	CAMLE	T1,T2		;CAN'T GO DEEPER
	JRST	RENER8
RENA99:	MOVE	P3,DEVUFB##(F)	;LOC OF UFB
	MOVE	P4,DEVUNI##(F)	;ADDR. OF UNIT DATA BLOCK
	PUSHJ	P,SETSRC##	;GET SEARCH LIST
	  PUSHJ	P,SLXBPT##	;STOPCD BPT IF NONE
	MOVE	T2,T1		;SL INTO T2

	TLC	M,UUOLUK+UUOREN	;ZERO UUOLUK, LIGHT UUOREN
	PUSHJ	P,FNDFIL##	;CHECK THAT NEW FILE NAME DOESN'T EXIST
	  JRST	RENA21		;NEW FILE NAME ALREADY EXISTS
	TLNE	M,UUOREN	;CHANGING DIRECTORIES?

	MOVEM	P3,DEVUFB##(F)	;NO, RESTORE LOC OF UFB
	MOVEM	P4,DEVUNI##(F)	;RESTORE LOC OF UNIT DATA BLOCK
	HLR	M,P2		;RESTORE LOC OF PPN
	MOVE	T2,UFBTAL##(P3)
	MOVE	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCALC##(T1)	;SIZE OF FILE
	CAME	P3,DEVUFB##(F)	;NEW UFD=OLD UFD?
	ADDM	T1,UFBTAL##(P3)	;NO. CHANGING DIRECTORIES
				;INCREASE AMOUNT OF ROOM LEFT IN OLD DIR
	JUMPL	T2,RENA24	;WAS QUOTA POSITIVE?
	SKIPGE	UFBTAL##(P3)	;YES, DID QUOTA BECOME HUGELY NEGATIVE?
	HRLOS	UFBTAL##(P3)	;YES (OVERFLOW). MAKE IT POSITIVE AGAIN

	JRST	RENA24		;AND CONTINUE
RENA21:	HRRM	P3,DEVUFB##(F)
	MOVEM	P4,DEVUNI##(F)	;IN CASE ANOTHER RENAME IS DONE
	MOVE	P2,DEVACC##(F)	;GET THE ACCESS TABLE
	MOVE	T2,ACCPPB##(P2)	;GET THE PPB
	MOVE	T2,PPBNAM##(T2)	;GET THE PPN
	MOVEM	T2,DEVPPN(F)	;YES, RESTORE OLD ONE
	JRST	RENER9		;GIVE USER THE ERROR CODE


;SUBROUTINE TO CHECK EXTENSIONS
;ENTER T2=EXTENSION
;RETURN CPOPJ IF "SFD" OR "UFD"
;RETURN CPOPJ1 OTHERWISE
;T4 PRESERVED
EXTCK:	CAIE	T2,(SIXBIT /UFD/)
	CAIN	T2,(SIXBIT /SFD/)
	POPJ	P,
	PJRST	CPOPJ1##
;HERE ON A RENAME WHEN THE NAME, EXTENSION AND DIRECTORY ARE NOT BEING CHANGED
RENA22:	HRRI	M,-1(T4)	;POINT TO UUXPPN
	TLNN	M,EXTUUO	;EXTENDED UUO?
	HRRI	M,1+UUNPPN-UUNNAM(M)	;NO. POINT TO PPN WORD
RENA23:	PUSHJ	P,GETCB##	;GET CB RESOURCE
	MOVE	T1,ACCSTS##(P2)	;% STATUS OF FILE
	TLC	M,UUOLUK+UUOREN	;%ZERO UUOLUK, LIGHT UUOREN
	TRNE	T1,ACPCRE+ACPSUP+ACPUPD	;%FILE BEING WRITTEN?
	TLNE	F,ENTRB		;%YES, BY THIS JOB?
	TROE	T1,ACPREN	;%RENAME IN PROGRESS?
	JRST	RENER2		;%YES, ERROR
	MOVEM	T1,ACCSTS##(P2)	;%NO. INDICATE RENAME IN PROGRESS
	PUSHJ	P,GVCBJ##	;%GIVE UP CB RESOURCE
	PUSH	P,P2
	PUSHJ	P,DECSU		;SET P2 TO PPB,,NMB
	AOS	NMBCNT##(P2)	;SINCE FNDFIL WONT BE CALLED
	HLRZS	P2		; WE MUST INCR COUNTS BY HAND
	AOS	PPBCNT##(P2)	; CAUSE CLOSE WILL DECR THEM
	POP	P,P2
	TLNE	S,IOSRIB	;PRIME RIB IN CORE?
	JRST	RENA25		;YES, NO NEED TO READ IT
RENA24:	PUSHJ	P,GTMNBF##	;GET A MONITOR BUFFER
	HLRZ	U,DEVUNI##(F)	;GET UNIT OF PRIME RIB
	PUSHJ	P,STORU##	;SAVE AS CURRENT UNIT
	PUSHJ	P,PRMRIB##	;SET UP TO READ PRIME RIB
	PUSHJ	P,MONRED##	;READ THE PRIME RIB
	JUMPN	T3,RENE13	;ERROR READING RIB IF T3 NON-ZERO
	MOVE	T3,RIBCOD##+1(T1)	;GET RIB CODE WORD
	CAIN	T3,CODRIB##	;IS IT A RIB?
	CAME	T2,RIBSLF##+1(T1)	;YES, RIGHT ONE?
	JRST	RENE13		;NO,ERROR
	TLO	S,IOSRIB	;INDICATE PRIME RIB IS IN CORE
	MOVEM	S,DEVIOS(F)	;SAVE IN DDB

;HERE WHEN WE HAVE THE MONITOR BUFFER, AND THE RIB IS IN IT
RENA25:	HRRZ	T1,.USMBF	;LOC OF MON BUFFER
	MOVE	T2,RIBNAM##+1(T1) ;GET OLD FILE NAME
	MOVEM	T2,DEVFIL(F)	;RESTORE IN DDB
	HLLZ	T2,RIBEXT##+1(T1)	;GET OLD EXTENSION
	HLLM	T2,DEVEXT(F)	;AND SAVE IN DDB
	MOVE	T2,RIBPPN##+1(T1)	;GET OLD PPN
	MOVEM	T2,DEVPPN(F)	;SAVE OLD PPN IN DDB
	PUSHJ	P,SETUFR	;SET UFD ADR INTO RIB
;HERE WITH THE RIB IN THE MON BUF, M POINTING TO PPN WORD
	HRRI	M,-1(M)
	TLNN	M,EXTUUO	;EXTENDED UUO?
	JRST	RENA26		;NO. POINT TO ATT WORD
	HRRI	M,-<UUXPPN-1>(M)	;POINT TO E
	PUSHJ	P,GETWDU##	;GET NO. OF ARGS
	TRZ	T1,RB.BIT	;CLEAR NOISE BITS
	HRR	P1,T1
	CAIGE	T1,RIBATT##	;SPECIFYING ATTRIBUTES?
	JRST	[JUMPG P1,RENA37	;OK IF CAN CHANGE ATT'S
		 HRRI	M,4(M)	;CAN'T - ERROR
		 JRST RENE12]
	HRRI	M,UUXPRV(M)	;MAYBE. POINT TO ATT WORD
RENA26:	HRRI	M,-1(M)		;POINT TO EXTENSION WORD
	PUSHJ	P,GETWDU##	;GET EXT. HIGH CREATION DATE
	LDB	P3,[POINT 3,T1,20]	;HIGH CREATION DATE
	MOVE	T1,.USMBF	;POINT TO MON BUF
	LDB	P4,[POINT 3,RIBEXT##+1(T1),20]	;HI CREATION DATE FROM RIB
	SUB	P4,P3		;P4=DIFFERENCE
	PUSHJ	P,GETWD1##	;GET ATTRIBUTES WORD
	MOVE	T2,T1		;
	HRRZ	T3,.USMBF	;LOC OF MON BUF (-1)
	SKIPN	P3		;IF HI CREATION DATE = 0
	JUMPE	T2,RENA30	; RIBATT = 0 MEANS NO CHANGE
	XOR	T2,RIBATT##+1(T3)	;COMPARE WITH RIB ATTR. WORD
	SKIPN	P4		;HI CREATION DATE THE SAME?
	JUMPE	T2,RENA30	;YES, ALL THE SAME IF T2=0
	TLNN	M,UUOREN	;CHANGING DIRECTORIES?
	JRST	RENA28		;YES, IT'S LEGAL

	TLNN	T2,777740	;IF PROTECTION AND MODE SAME
	TDNE	T1,[37,,-1]	;IF 0 LOW DATE
	JRST	RENA27		;NO, A CHANGE
	TLNN	M,EXTUUO	; AND NOT EXTENDED
	JUMPE	P3,RENA30	; AND HI DATE 0, WIN
RENA27:	TLNE	T2,777000	;IF CHANGING PROTECTION
	MOVEI	T1,FNCCPR##	;REMEMBER THAT
	JRST	RENA29		;WE ALREADY CHECKED FNCCAT OR FNCCPR
RENA28:	TLZ	P1,-1		;INDICATE NO PROT ERROR
RENA29:	HRRZ	T2,.USMBF	;LOC OF MON BUF
	PUSH	P,T1		;GET PRIVS FROM USER
	PUSHJ	P,GTWST2##
	LDB	T4,[POINT 4,T1,12]	;GET SPECIFIED I/O MODE
	MOVEI	T3,1		;GET A BIT TO POSITION
	LSH	T3,(T4)		;MAKE INTO MODE BIT
	LDB	T4,[POINT 4,RIBATT##+1(T2),12]	;GET VALUE FROM RIB
	TDNN	T3,DEVMOD(F)	;LEGAL MODE?
	DPB	T4,[POINT 4,T1,12]	;NO, OVERRIDE USER'S VALUE
	LDB	T4,[POINT 15,T1,35]	;CREATION DATE SUPPLIED?
	DPB	P3,[POINT 3,T4,23]
	MOVEI	T3,0
	SKIPE	T4		;IF NO CREATION DATE,
	CAMLE	T4,THSDAT##	; OR DATE TOO HIGH
	HRLOI	T3,37		;DON'T CHANGE THE CURRENT DATE
	ANDM	T3,RIBATT##+1(T2)	;CLEAR OLD PROTECTION (AND MAYBE LOW DATE)
	ANDCAM	T3,T1
	IORM	T1,RIBATT##+1(T2)	;STORE NEW VALUE(S)
	LSH	T4,-14
	SKIPN	T3		;IF CHANGING DATE,
	DPB	T4,[POINT 3,RIBEXT##+1(T2),20]	;SAVE HIGH CREATION DATE
	POP	P,T1		;RESTORE PROTECTION BYTE
	HLRZ	T3,DEVEXT(F)	;EXTENSION
	CAIN	T1,FNCCPR##	;CHANGING PROTECTION
	CAIE	T3,(SIXBIT /UFD/); OF A UFD?
	JRST	RENA30		;NO
	PUSHJ	P,FNDUFB	;YES. FIND UFB FOR FILE
	  JRST	RENA30		;NOT THERE
	PUSHJ	P,GTWST2##
	LDB	T1,[POINT 9,T1,8];%FOUND - GET PROTECTION
	MOVE	T4,T2		;%LOC OF UFB
	DPB	T1,UFYPRV##	;%SAVE NEW PROT IN UFB BLOCK
	PUSHJ	P,GVCBJ##	;%AND RETURN CB RESOURCE
RENA30:	TLZE	P1,-1		;PROT ERR? (CAN'T CHANGE ATT, NOT CHANGING PROT)
	PJSP	T1,RENE12	;YES, LOSE
	SETZ	P4,
	MOVSI	T1,DEPALW	;SPECIFYING ALLOCATION IN WORDS?
	CAIL	P1,UUXSIZ
	TDNN	T1,DEVJOB(F)
	JRST	RENA31		;NO
	PUSHJ	P,GETWD1##	;YES, GET IT
	MOVE	P4,T1		;SAVE IT
	TRNE	T1,BLKSIZ##-1	;PARTIAL BLOCK?
	ADDI	T1,BLKSIZ##	;YES, ACCOUNT FOR IT
	LSH	T1,MBKLSH##	;CONVERT TO BLOCKS
	HRRI	M,UUXALC-UUXSIZ(M) ;POINT AT "REAL" ALLOCATION WORD
	PUSHJ	P,PUTWDU##	;SAVE IN USER'S RENAME BLOCK
	JRST	RENA32		;AND CARRY ON
RENA31:	HRRI	M,UUXALC-UUXPRV(M) ;POINT TO ALLOCATION WORD
	TLNE	M,EXTUUO	;EXTENDED UUO?
	CAIGE	P1,UUXALC	;YES. CHANGING ALLOCATION?
	JRST	RENER1		;NO
	PUSHJ	P,GETWDU##	;SPECIFYING ALLOCATION?
RENA32:	SKIPLE	T2,T1
	CAMN	T2,ACCALC##(P2)	;YES. ALLOCATION SAME AS BEFORE?
	JRST	RENER1		;YES. NOT REALLY CHANGING IT
	MOVE	T3,ACCDIR##(P2)	;GET DIRECTORY WORD
	MOVEI	T1,FNCTRN##	;ASSUME TRUNCATING
	CAML	T2,ACCWRT##(P2)	;RIGHT ?
	SKIPA	T1,[FNCALL##]	;NO, ALLOCATE
	TRNN	T3,ACPDIR##	;DON'T ALLOW UFD TRUNCATION
	PUSHJ	P,CHKPRV##	;CHECK IT
	  JRST	RENE11		;CANT DO IT - ERROR
	MOVE	T1,ACCSTS##(P2)	;STATUS OF FILE
	TRNE	T1,ACMCNM##	;OTHER READERS?
	JRST	RENE10		;YES, CANT CHANGE ALLOCATION
	PUSHJ	P,GETWDU##	;OK. HIGHEST BLOCK HE WANTS
	MOVE	T2,T1
	SUB	T2,ACCALC##(P2)	;CHECK ALLOCATION OR DEALLOCATION
	JUMPL	T2,RENA33	;DEALLOCATING IF NEGATIVE
	PUSHJ	P,UPDALC	;ALLOCATING - GET MORE
	 JRST	ENERR7		;QUOTA EXCEEDED
	  JRST	RENE20		;CANT START WHERE SPECIFIED - ERROR
	PUSHJ	P,UPDSET	;UPDATE DEYRLC FOR NEW POINTERS STORED IN RIB
	PUSHJ	P,CHKPAR	;STORE ERROR WORD IF PARTIAL ALLOCATION
	JRST	RENER1		;AND CONTINUE
;STILL IN CONDITIONAL ON FTDALC
;HERE TO DEALLOCATE/TRUNCATE ON A RENAME
RENA33:	PUSHJ	P,GTWDT3	;LAST BLOCK TO KEEP
	MOVEI	T2,0		;SET T2=0 (1ST BLOCK IN RIB IS 0)
RENA34:	PUSHJ	P,SCNPT0##	;GO FIND POINTER TO LAST BLOCK DESIRED
	  JRST	RENA38		;NOT IN THIS RIB, TRY NEXT
	MOVE	P3,P1		;SAVE NUMBER OF ARGS
	PUSH	P,DEVRIB##(F)	;SAVE POINTER TO CURRENT RIB
	PUSHJ	P,UPDGV9	;GO DEALLOCATE SOME BLOCKS
	  STOPCD .+1,DEBUG,TCI,	;++TRUNCATION CHECK INCONSISTENT
	MOVE	T2,DEVACC##(F)	;ALLOCATION GIVEN IN WORDS?
	JUMPE	P4,RENA35	;NO
	TRNN	P4,BLKSIZ##-1	;YES, PARTIAL BLOCK?
	TROA	P4,BLKSIZ##	;NO, LAST BLOCK IS FULL
	TRZ	P4,BLKSIZ##	;YES, ENSURE LESS THAN 1 BLOCK
	SKIPE	ACCWRT##(T2)
	DPB	P4,ACYLBS##	;YES, SAVE SIZE OF LAST BLOCK
RENA35:	POP	P,T1		;RESTORE PREVIOUS CURRENT RIB TO T1
	SKIPL	DEVRIB##(F)	;CURRENTLY IN PRIME RIB?
	JRST	RENA36		;YES, NO NEED TO WRITE THE RIB
	CAMN	T1,DEVRIB##(F)	;STILL LOOKING AT THE SAME RIB?
	PUSHJ	P,WRTRIB##	;YES, MAKE SURE UPDATED COPY GETS WRITTEN
	PUSHJ	P,REDRIB##	;READ THE PRIME RIB BACK INTO CORE
	  JRST	RENE13		;ERROR READING RIB
RENA36:	MOVE	P1,P3
	PUSHJ	P,CPYFST##	;COPY UPDATED POINTERS TO DDB
	  JRST	RENE13		;RIB ERROR
;HERE WHEN ALLOCATION/DEALLOCATION IS THROUGH. SET UP FOR CLOSE
RENER1:	TLO	M,UUOREN
	PUSH	P,M		;SAVE ADDR OF ALC
	PUSHJ	P,SETVAL	;STORE ARGUMENTS FROM USER IN RIB
	POP	P,M		;POINT AT ERROR CODE
	HRRI	M,<UUXEXT-UUXALC>(M);IN CASE PARTIAL ALLOCATION
;WE MUST DO "SET WATCH FILES" STUFF NOW WHILE
;DEVSFD STILL POINTS TO THE RIGHT PLACE (THE NEW SFD) AND
;WHILE THE SFD USE COUNTS ARE STILL UP
RENA37:	TLNN	M,UPARAL	;PARTIAL ALLOCATION ERROR?
	TRZ	M,-1		;NO, INDICATE NO ERROR CODE
	PUSHJ	P,WCHFIL##	;TYPE SET WATCH FILES
	 CAI	"R"
	MOVEI	T1,UP.SWF	;LIGHT BIT SO WE DON'T DO IT AGAIN
	IORM	T1,.USBTS
	MOVE	T1,.USMBF	;LOC OF MON BUF
	MOVE	T2,RIBPRV##+1(T1)	;PRIVS WORD (MAY HAVE BEEN CHANGED)
	MOVEM	T2,ACCPRV##(P2)	;SAVE IN ACC
	MOVE	T2,RIBEXT##+1(T1)	;GET ACCESS DATE HI CREATION DATE
	HRLM	T2,ACCADT##(P2)	; SAVE IN A.T. (CRE-DATE MIGHT CHANGE)
	MOVE	T1,ACCSTS##(P2)	;GET STATUS
	TRNE	T1,ACPCRE+ACPSUP	;IF FILE WAS JUST WRITTEN
	TRZA	M,-1		;SET TO DEALLOCATE ON CLOSE
	HRRI	M,CLSDLL	;OTHERWISE SET TO KEEP ALL ALLOCATED BLOCKS
	TLO	F,RENMB		;MAKE SURE RENAME BIT IS ON
	TLZ	F,OCLOSB	;AND THAT OUTPUT CLOSE HAPPENS
	MOVEM	S,DEVIOS(F)	;SAVE S BITS IN DDB
	PUSH	P,DEVBUF(F)
	SETZM	DEVBUF(F)	;MAKE SURE CLOSE1 DOESN'T FIND ADR ERR
	PUSHJ	P,CLOSE1##	;CALL CLOSE CODE IN UUOCON
	POP	P,DEVBUF(F)
	PUSHJ	P,JDAADR##	;GET CHAN NUM
	TLZ	F,ICLOSB	;CLEAR INPUT CLOSED INDICATION
	HLLM	F,(T1)		;SO SUBSEQUENT CLOSE WILL WIN
	TLNN	M,UPARAL	;PARTIAL ALLOCATION ERROR?
	AOS	(P)		;NO. SET FOR SKIP-RETURN
ZDYFNC:	SETZ	T1,
	DPB	T1,DEYFNC##	;CLEAR PROT SO WILL RECOMPUTE IT
	POPJ	P,		;RETURN TO USER

;HERE WHEN WE HAVE TO SCAN ANOTHER RIB TO FIND THE CORRECT POINTER
RENA38:	PUSHJ	P,PTRNXT##	;GET THE NEXT RIB
	  STOPCD .,JOB,NRM,	;++NEXT RIB MISSING
	MOVE	T1,.USMBF	;IOWD FOR MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T1)	;GET FIRST BLOCK NUMBER IN RIB
	PUSHJ	P,GTWDT3	;LAST BLOCK TO KEEP
	JRST	RENA34		;SCAN THIS RIB
;HERE TO RENAME A FILE INTO [3,3] ON SPPRM, FUNCTION 2
SPLREN::TLNE	F,ENTRB
	TLNE	F,OCLOSB
	TLNN	F,LOOKB
	JRST	ECOD5##		;DOCUMENT
	MOVE	T1,DEVFIL(F)
	MOVEM	T1,DEVSPN##(F)
	PJRST	SPTSTR
;SUBROUTINE TO ALLOCATE EXTRA BLOCKS FOR A FILE - ENTER UPDATE OR RENAME
;ENTER WITH T2= AMOUNT TO GET AND M POINTING TO ALLOCATION WORD
;EXIT CPOPJ IF QUOTA EXCEEDED
;EXIT CPOPJ1 IF CANT START WHERE REQUESTED
;EXIT CPOPJ2 IF GOT ANY BLOCKS (UPARAL MAY BE ON IN M)

UPDALC:	HRRZ	T4,DEVUFB##(F)	;LOC OF UFB
	CAMG	T2,UFBTAL##(T4)	;DOES HE WANT MORE THAN HE CAN GET?
	AOJA	M,UPDAL1	;NO. OK
	SKIPN	T2,UFBTAL##(T4)	;YES. DOES HE HAVE ANY SPACE AT ALL?
	POPJ	P,		;NO. CANT GET MORE

	ADDI	M,UUXPOS-UUXALC	;YES. HE CAN GET PART OF IT
	TLO	M,UPARAL	;INDICATE PARTIAL ALLOCATION

UPDAL1:	AOS	(P)		;SET FOR SKIP/DOUBLE SKIP RETURN
	PUSH	P,T2		;SAVE NUMBER OF BLOCKS TO GET
	PUSHJ	P,DDBZR		;ZERO OUT THE DDB RETRIEVAL POINTERS
	MOVEI	T1,DEVRB1##(F)	;SET UP DEVRET TO POINT TO
	HRRM	T1,DEVRET##(F)	; DEVRB1
	TLON	S,IOSRIB	;RIB ALREADY IN CORE?
	PUSHJ	P,PTRGET##	;NO, READ IT
	PUSHJ	P,PTRNXT##	;READ NEXT EXTENDED RIB
	  SKIPA			;LAST OF THEM (OR RIB ERROR)
	JRST	.-2		;KEEP LOOKING FOR LAST RIB
	JUMPN	T3,TPOPJ##	;ALL BETS ARE OFF IF RIB ERROR
	PUSHJ	P,LSTUNI	;SET U TO LAST UNIT OF FILE
	PUSHJ	P,UPDSET	;UPDATE DEYRLC, DEVRSU
	MOVSI	T1,-1		;SEE IF ANY RETRIEVAL POINTER SLOTS LEFT IN RIB
	TDNE	T1,DEVRSU##(F)	;...
	JRST	UPDA1A		;YES, PROCEED
	PUSHJ	P,UPDEXT	;ALLOCATE EXTENDED RIB
	  JRST	TPOPJ##		;CAN'T EXTEND
UPDA1A:	PUSHJ	P,ALSTRT	;SET UP T1 FOR START ADR OF BLOCKS
	  JRST	TPOPJ##		;CANT START AT SPECIFIED LOCATION
	JUMPN	T1,UPDAL4	;NO START ADR. IF 0
	MOVE	T2,(P)		;RESTORE REQUESTED AMOUNT
	CAMG	T2,UNITAL(U)	;DOES THIS UNIT HAVE ENOUGH FREE SPACE?
	JRST	UPDAL5		;YES. TRY TO GET IT
	MOVE	T3,UNISTR(U)	;NO. POINT TO 1ST UNI IN STR
	HLRZ	T3,STRUNI##(T3)	;1ST UNIT
UPDAL2:	CAMG	T2,UNITAL(T3)	;DOES THIS UNIT HAVE ENOUGH?
	JRST	UPDAL3		;YES. USE IT
	HLRZ	T3,UNISTR(T3)	;NO. STEP TO NEXT UNIT IN STR
	JUMPN	T3,UPDAL2	;AND TRY IT
	TLO	M,UPARAL	;INDICATE REQUESTING MORE BLOCKS
	JRST	UPDAL5		;NO UNIT HAS ENOUGH. USE ORIGINAL UNIT
UPDAL3:	MOVE	U,T3		;SET UP NEW U
UPDAL4:	PUSHJ	P,STORU##	;SAVE IN DDB
	LDB	T2,UNYLUN##	;GET LOGICAL UNIT NUMBER
	TRO	T2,RIPNUB##	;INSURE NON-0
	PUSHJ	P,PTSTO##	;SAVE CHANGE-UNIT POINTER
	AOS	DEVRET##(F)	;POINT TO NEXT POINTER SLOT
UPDAL5:	PUSH	P,T1		;SAVE T1
	PUSHJ	P,UPDSET	;UPDATE DEYRLC, DEVRSU
	POP	P,T1		;RESTORE T1
	MOVE	T2,(P)		;AND T2
	PUSHJ	P,ENTALU	;ALLOCATE SPACE FOR UPDATE
	  JRST	TPOPJ##		;ERROR RETURN
UPDAL6:	POP	P,T2		;REMOVE GARBAGE FROM PDL
	PUSHJ	P,CHKPAR	;SET ERROR BIT IF PARTIAL ALLOCATION
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCALC##(T1)	;AMOUNT OF SPACE ALLOCATED
	PUSHJ	P,PUTWDU##	;TELL USER AMOUNT ALLOCATED
	JRST	CPOPJ1##	;TAKE GOOD RETURN

;SUBROUTINE TO UPDATE DEYRLC AFTER UPDAT5 HAS ALLOCATED MORE SPACE
; (CANT BE DONE IN UPDAT5 SINCE RIB MAY NOT BE IN CORE YET)
;ENTER AT UPDSE2 IF T1 HAS ALREADY BEEN SET TO AN AOBJN POINTER
UPDSET:	PUSHJ	P,SPTRW##	;SET AOBJN WORD FOR POINTERS
	MOVE	T2,T1		;INTO T2
	SKIPE	(T2)		;THIS POINTER SLOT EMPTY?
	AOBJN	T2,.-1		;NO. TRY NEXT
	HLLM	T2,DEVRSU##(F)	;YES, UPDATE DEVRSU
	SUBI	T2,(T1)		; COMPUTE NEW LENGTH
	DPB	T2,DEYRLC##	;SAVE LENGTH IN DDB
	POPJ	P,		;AND RETURN

;SUBROUTINE TO READ RIB FOR UPDATE-ENTER
;RETURNS CPOPJ WITHOUT FA IF RIB ERROR
;RETURNS CPOPJ1 IF OK, WITH RIB IN CORE AND FA IF SIM UPDATE
SIMRIB:	TLOE	S,IOSRIB	;IF WE ALREADY HAVE RIB IN CORE
	JRST	CPOPJ1##	;ALL IS OK
	MOVE	T1,DEVACC##(F)	;A.T. LOC
	MOVE	T1,ACCSMU##(T1)	;IF A SIMULTANEOUS UPDATE FILE,
	TRNE	T1,ACPSMU	; GET THE FA RESOURCE BEFORE READING RIB
	PUSHJ	P,UPFA##	;AS PROTECTION AGAINST RACE CONDITIONS
	PUSHJ	P,REDRIB##	; INVOLVED IN REWRITING RIBS
	  PJRST	DWNIFA##	;ERROR READING RIB - RETURN FA - GIVE UP
	MOVEI	T1,DEPWRT##	;INDICATE THIS IS A
	IORM	T1,DEVWRT##(F)	; WRITING DDB
	JRST	CPOPJ1##	;TAKE GOOD RETURN
;SUBROUTINE TO ALLOCATE AN EXTENDED RIB FOR UPDALC.
;CALLED WHEN LAST RETRIEVAL POINTER IN RIB HAS BEEN FILLED
;EXIT CPOPJ IF CAN'T ALLOCATE EXTENDED RIB
;EXIT CPOPJ1 IF EXTENDED RIB ALLOCATED, DEVRET/DEVRSU UPDATED
;PRESERVES T1 AND T2

UPDEXT:	PUSH	P,T1		;SAVE THE AC'S LIKE ADVERTISED
	PUSH	P,T2
	PUSHJ	P,PTRWRT##	;WRITE OUT DDB RETRIEVAL POINTERS
	PUSHJ	P,EXTRIB##	;ALLOCATE AN EXTENDED RIB
	  JRST	TTPOPJ##	;CAN'T, ERROR RETURN
	PUSHJ	P,CPYEXT##	;SET UP THE DDB
	  JRST	TTPOPJ##	;CAN'T, ERROR RETURN (DUH?)
	PUSHJ	P,DDBZRO	;CLEAR OUT RETRIEVAL POINTERS IN DDB
	MOVEI	T1,DEVRB1##(F)	;RESET DEVRET
	HRRM	T1,DEVRET##(F)	;...
	AOS	-2(P)		;SET FOR SKIP RETURN
	JRST	TTPOPJ##	;RESTORE AC'S AND RETURN
;SUBROUTINE TO DEALLOCATE OR TRUNCATE BLOCKS FROM A FILE
;ENTER WITH P1=AOBJN WORD FOR POINTERS,  DEVREL,DEVBLK SET TO LAST DESIRED BLOCK
;EXIT CPOPJ IF PRIVS DON'T ALLOW TRUNCATION, FUNCTION IS TRUNCATE
;EXIT CPOPJ1 NORMALLY WITH RIB SET UP, BUT NOT WRITTEN
;HERE WITH T1=AOBJN
UPDGV9:	MOVE	P1,T1		;PUT IT IN A SAFE PLACE
	AOBJN	T1,UPDGIV	;LAST RTP IN RIB?
	AOS	DEVBLK##(F)	;YES, SCNPTR LEFT DEVLFT ONE TOO LOW
				;COMPENSATE BY BUMPING DEVBLK
;HERE WITH P1=AOBJN
UPDGIV:	HRRZ	T3,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,DEVREL##(F)	;LAST DESIRED BLOCK
	CAML	T1,ACCWRT##(T3)	;THROWING AWAY BLOCKS WITH DATA?
	JRST	UPDGV0		;NO. OK
	MOVEI	T1,FNCTRN##	;YES. SEE IF PRIVS ALLOW TRUNCATING
	PUSHJ	P,CHKPRV##	;OK?
	  POPJ	P,		;NO. ILLEGAL
	HRRZ	T3,DEVACC##(F)	;YES. GET A.T. LOC AGAIN
	MOVE	T1,DEVREL##(F)	;NEW HIGHEST BLOCK
	MOVEM	T1,ACCWRT##(T3)	;SAVE AS HIGHEST BLOCK WITH DATA
	MOVEI	T4,BLKSIZ##
	DPB	T4,ACZLBS##	;LAST BLOCK IS FULL


;HERE WHEN ACCWRT IS SET. T1=DEVREL HAS THE NUMBER OF THE LAST BLOCK TO KEEP
UPDGV0:	SOS	DEVLFT##(F)	;YES, ACCOUNT FOR THE REDUNDANT RIB BLOCK
	LDB	T4,UNYBPC##	;NUMBER OF BLOCKS PER CLUSTER
	HRRZ	T1,DEVLFT##(F)	;GET NUMBER OF BLOCKS LEFT IN CROUP
	IDIV	T1,T4		;CONVERT LAST BLOCK TO CLUSTER ADDR.
	JUMPE	T2,UPDGV1	;EXACT NUMBER OF CLUSTERS IF 0
	ADDM	T2,DEVBLK##(F)	;UPDATE LAST BLOCK ADR
	ADDM	T2,DEVREL##(F)	;UPDATE LAST LOGICAL BLOCK
	MOVNS	T2
	ADDM	T2,DEVLFT##(F)	;UPDATE AMOUNT TO THROW AWAY IN THIS CLUSTER
;HERE WHEN DEVREL AND DEVBLK POINT TO THE LAST BLOCK IN THE CLUSTER
UPDGV1:	HRRZ	T1,DEVLFT##(F)	;NO OF BLOCKS LEFT IN GROUP
	JUMPE	T1,UPDGV3	;NOTHING TO DELETE IF 0
	IDIV	T1,T4		;YES. CONVERT TO CLUSTERS
	SKIPE	T2		;SHOULD BE AN EVEN NO OF CLUSTERS
	STOPCD	.+1,DEBUG,ONC,	;++ODD NUMBERED CLUSTER
	PUSH	P,T1		;SAVE NO OF CLUSTERS TO DELETE
	MOVE	T4,UNISTR(U)	;LOC OF STR DATA BLOCK
	MOVE	T2,(P1)		;LAST POINTER
	CAME	T2,ACCPT1##(T3)	;IS IT 1ST POINTER?
	SETZ	T3,		;NO. INDICATE BY T3=0
	LDB	T1,STYCNP##(T4)	;PREVIOUS CLUSTER COUNT
	SUB	T1,(P)		;DECREASE BY AMOUNT WE AREW DELETING
	DPB	T1,STYCNP##(T4)	;SAVE NEW CLUSTER COUNT
	POP	P,T1		;REMOVE JUNK FROM PD LIST
	MOVEM	T2,(P1)		;SAVE POINTER
	SKIPE	T3		;IS THIS 1ST POINTER?
	MOVEM	T2,ACCPT1##(T3)	;YES. UPDATE PNTR IN ACC ALSO
	HRRZ	T2,DEVLFT##(F)	;NUMBER OF BLOCKS IN CLUSTER TO DELETE
	AOS	T1,DEVBLK##(F)	;1ST ADR NOT WANTED
UPDGV2:	HLRZ	T3,DEVEXT(F)	;GET EXTENSION OF FILE
	CAIE	T3,'UFD'	;A DIRECTORY?
	CAIN	T3,'SFD'	; OF SOME FLAVOR?
	PUSHJ	P,[PUSHJ P,SAVT## ;YES, SALT AWAY THE AC'S FOR GIVBLK
		   JRST CSDELR##] ;FLUSH THE DIRECTORY DATA FROM THE CACHE
	PUSHJ	P,GIVBLK##	;DELETE SOME BLOCKS
UPDGV3:	AOBJP	P1,DELRB2	;THROUGH IF NO MORE

;SUBROUTINE TO DELETE A FILE
;ENTER WITH RIB BLOCK IN CORE, P1=AOBJN WORD FOR POINTERS
;EXIT CPOPJ1
DELRIB::SKIPN	T2,(P1)		;GET NEXT POINTER FROM RIB
	JRST	DELRB2		;THROUGH IF 0
	SETZM	(P1)		;ZERO THE POINTER (IN CASE OF TRUNCATE)
	PUSHJ	P,CNVPTR##	;CONVERT TO ADR, COUNT
	  JRST	DELRB2		;BAD UNIT-CHANGE PNTR. STOP DELETING
	  JRST	UPDGV3		;CHANGE-UNIT, TRY AGAIN
	MOVE	T2,T1		;COUNT INTO T2
	MOVE	T1,DEVBLK##(F)	;ADDRESS INTO T1
	JRST	UPDGV2		;GO DELETE THIS POINTER
;HERE WHEN ALL THE BLOCKS HAVE BEEN RELEASED IN THE CURRENT RIB
DELRB2:	MOVE	P1,.USMBF	;LOC OF MONITOR BUFFER
	PUSH	P,U		;SAVE CURRENT U
	SKIPL	DEVRIB##(F)	;CURRENT RIB EXTENDED?

	SKIPN	T1,RIBELB##+1(P1)  ;ERROR REGION?
	JRST	DELRB3		;NO. FINISH UP
	HLRZ	T2,RIBEUN##+1(P1)	;YES. GET UNIT OF ERROR
	PUSHJ	P,NEWUNI##	;SET U TO UNIT DATA BLOCK LOC
	  JRST DELRB3		;BAD UNIT NUMBER - CONTINUE RECOVERS
	MOVE	T1,RIBELB##+1(P1)  ;JUST BLOCK NUMBER(CLEAR CONI BITS IN LH)
	TLZ	T1,BATMSK##	;CLEAR ERROR BITS
	JUMPE	T1,DELRB3	;DON'T ALLOCATE IF NO BLOCK NUMBER GIVEN
	HRRZ	T2,RIBNBB##+1(P1)  ;GET NO OF BAD BLOCKS IN REGION
	SKIPN	T2		;IF RIBNBB=0
	MOVEI	T2,1		; TRY FOR 1 CLUSTER
	PUSHJ	P,TAKBLK##	;MARK THEM AS TAKEN
	  JFCL

DELRB3:	MOVE	U,(P)
	HRRZ	U,UNISTR(U)	;GET ADR STR
	HLRZ	U,STRUNI##(U)	;GET ADR 1ST UNIT IN STR
DELRB4:	PUSHJ	P,STORU##	;SAVE IN DDB
	PUSHJ	P,WTUSAT	;GO WRITE SATS FOR THIS UNIT IF NOT CURRENT UNIT
	HLRZ	U,UNISTR(U)	;GET NEXT IN THE STRUCTURE
	JUMPN	U,DELRB4	;REWRITE THE SAT IF ITS BEEN CHANGED
	POP	P,U		;RESTORE CURRENT U
	PUSHJ	P,STORU##	;RESET DDB
	SKIPL	DEVRIB##(F)	;SKIP IF CURRENT RIB IS EXTENDED
	SKIPN	RIBFLR##+1(P1)	;NOT EXTENDED, NON-0 RIBFLR MEANS OLD FILE
	SKIPN	T1,RIBXRA##+1(P1)  ;IS THERE ANOTHER RIB ON CHAIN?
	PJRST	CPOPJ1##	;NO, EXIT
	PUSH	P,T1		;SAVE POINTER TO NEXT RIB
	SETZM	RIBXRA##+1(P1)	;CLEAR THE POINTER BECAUSE THE OTHERS WILL GO AWAY
	PUSHJ	P,WRTRIB##	;WRITE THE CURRENT RIB
	POP	P,DEVRIB##(F)	;SET UP DEVRIB TO POINT TO NEXT RIB
	PUSHJ	P,PTRCUR##	;GET THE RIB INTO CORE
	JUMPN	T3,CPOPJ1##	;ERROR READING RIB IF T3 NON-ZERO
	MOVE	P1,T1		;GET ADDRESS OF FIRST POINTER
	JRST	DELRIB		;AND DELETE THIS RINFULL
;SUBROUTINE TO CHECK FOR START-ADDRESS SPECIFICATION.
;RETURNS CPOPJ IF THE SPECIFIED ADDRESS IS HIGHER THAN THE HIGHEST BLOCK IN STR.
;RETURNS CPOPJ1 IN NORMAL CASE, WITH T1 SET UP (POSSIBLY 0).
;RESTORES T2 FROM -1(P)  -  ASSUMES NUMBER OF BLOCKS IN IT
;IF A START ADR. IS GIVEN, U WILL BE CHANGED TO POINT TO THE RIGHT UNIT

ALSTRT:	CAIL	P1,UUXPOS
	PUSHJ	P,GETWDU##	;POSSIBLY SPECIFYING START ADR.?
	HRRI	M,-1(M)		;DEC M FOR RETURN
	CAIL	P1,UUXPOS
	SKIPN	T1		;YES. IS HE?
	JRST	ALSTR1		;NO. GET SPACE ANYWHERE
	SKIPL	T1		;NEGATIVE BLOCK NUMBER LOSES
	PUSHJ	P,ADR2UN	;CONVERT T1 TO UNIT, BLOCK WITHIN UNIT
	  POPJ	P,		;BLOCK GT HIGHEST BLOCK IN STR - NON-SKIP RETURN
	SKIPA	T2,-1(P)	;PICK UP NUMBER OF BLOCKS AGAIN
ALSTR1:	SETZ	T1,		;ZERO T1, SO TAKE BLOCKS ANYWHERE
	JRST	CPOPJ1##	;TAKE GOOD RETURN


;SUBROUTINE TO CHECK FOR PARTIAL ALLOCATION, STORE AN ERROR NUMBER IF SO
;ENTER WITH UUO POINTING TO ALC WORD, LH(UUO) HAS UPARAL IF AN ERROR
CHKPAR:	TLNN	M,UPARAL	;PARTIAL ALLOCATION?
	POPJ	P,		;NO. RETURN
	HRRI	M,-<UUXALC-UUXEXT>(M)	;YES. POINT UUO TO ERROR WORD
	PUSHJ	P,GTWST2##	;GET THE WORD
	HRRI	T1,PAOERR	;PARTIAL ALLOCATION ERROR NUMBER
	PUSHJ	P,PUTWDU##	;STORE ERR BIT IN USER AREA
	HRRI	M,UUXALC-UUXEXT(M)	;POINT TO ALC WORD AGAIN
	POPJ	P,		;AND RETURN


;SUBROUTINE TO CONVERT FROM A BLOCK NUMBER WITHIN AN STR TO A UNIT AND BLOCK WITHIN UNIT
;ENTER WITH T1=BLOCK NUMBER
;EXIT CPOPJ IF THE NUMBER IS HIGHER THAN THE HIGHEST BLOCK IN STR
;EXIT CPOPJ1 NORMALLY, U AND DEVUNI=NEW UNIT,  T1=BLOCK WITHIN UNIT
ADR2UN::MOVE	T4,UNISTR(U)	;LOC OF STR DB
	CAMLE	T1,STRHGH##(T4)	;START BLOCK ABOVE HIGHEST IN STR?
	POPJ	P,		;YES. NON-SKIP RETURN
	MOVE	T3,STRBPU##(T4)	;NO. NUMBER OF BLOCKS/UNIT
	IDIV	T1,T3		;CONVERT START ADR TO UNIT, BLOCK NO.
	EXCH	T1,T2		;SET UNIT INTO T2
	HLRZ	U,STRUNI##(T4)	;LOC OF 1ST UNI IN STR
	PUSHJ	P,NEWUN##	;SET U, DEVUNI TO DESIRED UNIT
	  JFCL
	JRST	CPOPJ1##	;AND RETURN
;SUBROUTINE TO ALLOCATE INITIAL BLOCKS FOR A FILE
;SINCE FILES MUST START AT EVEN SUPER-CLUSTER BLOCKS,
;  THE START ADR. MUST BE MODIFIED
ADJALC::HRRZ	T4,UNISTR(U)	;STR LOC
	HLRZ	T4,STRBSC##(T4)	;NUMBER OF BLOCKS/SUPER-CLUSTER
	JUMPE	T1,ADJAL1	;GO IF NO START-ADR. GIVEN
	MOVE	T3,T1		;DESIRED START ADR.
	IDIV	T3,T4		;CONVERT TO SUPER-CLUSTER
	JUMPE	T4,TAKBLK##	;IF NO REMAINDER IT IS A VALID ADR.
	POPJ	P,		;NOT A START ADR FOR A SUPER CLUSTER. ILLEGAL

;HERE WHEN NO START ADR. IS SPECIFIED
ADJAL1:	LDB	T3,UNYBPC##	;NO. OF BLOCKS PER CLUSTER
	SUB	T4,T3		;SUBTRACT FROM NO. IN A SUP. CLUS.
	JUMPE	T4,TAKBLK##	;ANY CLUSTER ADR. IS OK IS THEY ARE THE SAME
	ADD	T2,T4		;ADJUST AMOUNT REQUESTED BY THE DIFFERENCE
	HRRZ	T4,DEVUFB##(F)	;LOC OF UFB
	CAMLE	T2,UFBTAL##(T4)	;WANT MORE THAN QUOTA ALLOWS?
	SKIPLE	T2,UFBTAL##(T4)	;YES. TAKE LESSER AMOUNT

	PUSHJ	P,TAKBLK##	;TRY FOR THAT MANY
	  POPJ	P,		;RETURN (QUOTA 0 OR BELOW)
	PUSHJ	P,SAVE2##	;GOT SOME BLOCKS. SAVE P1,P2
	PUSHJ	P,GRPAD##	;CONVERT TO BLOCK ADR OF THE GROUP
	MOVE	P1,T1		;SAVE NUMBER OF BLOCKS IN P1
	MOVE	P2,T2		;SAVE START ADR OF THE GROUP
	HRRZ	T4,UNISTR(U)	;LOC OF STR DB
	HLRZ	T3,STRBSC##(T4)	;NO. OF BLOCKS PER SUP. CLUS.
	IDIV	T2,T3		;CONVERT BLOCK TO SUP. CLUS ADR.
	JUMPE	T3,ADJAL2	;EVEN ADR. IF T3=0
	HLRZ	T4,STRBSC##(T4)	;NO OF BLKS/SUPER CLUSTER
	SUBM	T4,T3		;NO OF BLKS WE CAN'T USE

;HERE WITH T3= NO. OF BLOCKS AT START OF FILE WHICH WE CANT USE
	SUB	P1,T3		;ADJUST BLOCK COUNT
	MOVE	T1,P2		;1ST BLOCK TO RETURN
	MOVE	T2,T3		;NO. OF BLOCKS TO RETURN
	ADD	P2,T3		;ADJUST START ADR
	PUSHJ	P,GIVBLK##	;GIVE THEM UP

;NOW RECONSTRUCT A GROUP POINTER FROM P1,P2
ADJAL2:	JUMPE	P1,CPOPJ##	;ERROR RETURN IF ALL BLOCKS GIVEN BACK
	MOVE	T2,P2		;STARTING BLOCK NO
	LDB	P2,UNYBPC##	;BLOCKS PER CLUSTER
	IDIV	T2,P2		;COMPUTE START CLUSTER ADR
	SKIPE	T3		;MUST BE AN EVEN CLUSTER ADR
	STOPCD	.+1,DEBUG,CNE,	;++CLUSTER NOT EVEN
	MOVE	T1,P1		;NUMBER OF BLOCKS IN GROUP
	IDIV	P1,P2		;CONVERT TO CLUSTER COUNT
	SKIPE	P2		;MUST BE AN EVEN NO OF CLUSTERS
	STOPCD	.+1,DEBUG,CAO,	;++CLUSTER ADDRESS ODD
	HRRZ	T3,UNISTR(U)	;LOC OF STR DB
	DPB	P1,STYCNP##(T3)	;SAVE GROUP SIZE IN T2
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN

;SUBROUTINE TO ALLOCATE FOR ENTER UUO
;ENTER WITH T2=(P)=NUMBER OF BLOCKS TO GET
;EXIT CPOPJ IF CANT START AT SPECIFIED BLOCK
;EXIT CPOPJ1 NORMALLY (UPARAL MAY BE ON)

;ENTER AT ENTALC TO GET INITIAL BLOCKS FOR A FILE
;ENTER AT ENTALU TO GET ADDITIONAL BLOCKS FOR AN EXISTING FILE
ENTALU:	PUSHJ	P,TAKBLK##	;GET ANY BLOCKS (NOT STARTING AT A SUPER-CLUSTER
	  POPJ	P,		;CANT START WHERE SPECIFIED
 	JRST	ENTAL1		;GOT SOME - CONTINUE

ENTALC:	PUSHJ	P,ADJALC	;GET THE BLOCKS REQUESTED STATING AT A SUPERCLUSTER
	  POPJ	P,		;CANT START AT SPECIFIED BLOCK
ENTAL1:	PUSH	P,DEVRSU##(F)
ENTAL2:	PUSHJ	P,PTSTO##	;SAVE POINTER IN DDB
	MOVSI	T4,1		;UPDATE DEVRSU
	ADDB	T4,DEVRSU##(F)
	JUMPGE	T4,ENTAL3	;ALL POINTERS TAKEN IF NOT NEGATIVE
	AOS	T4,DEVRET##(F)	;STEP TO NEXT POINTER LOC
	CAILE	T4,DEVRBN##(F)	;FILLED DDB?
ENTAL3:	TLOA	M,UPARAL	;YES. PARTIAL ALLOCATION ERROR
	TLNN	M,UALASK	;NO. DID HE SPECIFY A PARTICULAR AMOUNT?
	JRST	ENTAL4		;ALL BLOCKS ARE ALLOCATED
	MOVN	T4,T1		;-NUMBER OF BLOCKS GOTTEN
	ADDB	T4,-2(P)	;UPDATE AMOUNT REQUESTED
	JUMPLE	T4,ENTAL4	;OK IF GOT THEM ALL

;SINCE THERE IS A RESTRICTION ON THE NUMBER OF BLOCKS WHICH WILL
;FIT INTO A RETRIEVAL POINTER, LESS THAN THE AMOUNT REQUESTED MAY HAVE BEEN
;OBTAINED AND THE NEXT CONTIGUOUS BLOCKS MAY BE AVAILABLE - TEST FOR THIS
	MOVE	T3,UNISTR(U)
	LDB	T2,STYCLP##(T3)	;ADDRESS OF 1ST CLUSTER GOTTEN
	LDB	T4,UNYBPC##	;NUMBER OF BLOCKS PER CLUSTER
	IMUL	T2,T4		;INITIAL BLOCK ADDRESS
	ADD	T1,T2		;+NUMBER OF BLOCKS GOTTEN=NEW START ADDR.
	MOVE	T2,-2(P)	;NUMBER OF BLOCKS LEFT TO GET
	PUSHJ	P,TAKBLK##	;TRY TO GET MORE
	  TLOA	M,UPARAL	;PARTIAL ALLOCATION ERROR
	JRST	ENTAL2		;SAVE THE NEW POINTER AND TRY AGAIN

;HERE WHEN DONE
ENTAL4:	POP	P,DEVRSU##(F)	;RESTORE DEVRSU
	PJRST	CPOPJ1##	;AND SKIP-RETURN
;SUBROUTINE TO STORE USER-SUPPLIED ARGUMENTS IN THE RIB BLOCK
;CALLED BY UPDATE AND RENAME
;ENTER WITH MONITOR BUF, P1=NUMBER OF ARGS,  M=ALLOCATION WORD
; BIT 0 OF M=1 IF USER CANT CHANGE ANY VALUES
;ENTER AT SETVAN FROM ENTER, WITH M=PRVS WORD (EXTENDED UUO ONLY)
SETVAL:	TLNE	M,EXTUUO	;EXTENDED UUO?
	CAIGE	P1,UUXPRV	;YES. WANT MORE THAN ALREADY ARE STORED?
	POPJ	P,		;NO. RETURN
	HRRI	M,-<UUXALC-UUXPRV>(M) ;YES. POINT M TO PRIVS WORD
	SKIPA	T3,P1		;REMEMBER TRUE NUMBER OF ARGS
SETVAN:	SETZ	T3,		;MARK THAT WE CAME FROM SETVAN
	PUSHJ	P,SAVE2##
	SETO	P2,		;P2 FOR UNPRV'D STATUS BITS
	CAILE	P1,UUXENX	;FORCE LIMIT OF KNOWN RIB ARGS
	MOVEI	P1,UUXENX
	PUSHJ	P,PRVJB##	;PRIVILEGED JOB?
	  JRST	SETVAU		;NO, NOT ALL ARGUMENTS ARE LEGAL
;
;HERE WE ARE PRIV'D, T3 HAS TRUE # OF ARGS, M=PRIV WORD
;TRY TO COPY ACCOUNT STRING FROM USER TO RIB. SIMILAR TO SETE15
;
SETVAP:	SKIPGE	T2,[XWD MACTSL##,RIBACS##] ;GET MAX ACCT STRING LENGTH
	CAIGE	T3,UUXACT	;DID THE USER SPECIFY ACCT STRING?
	JRST	SETVP3		;MAX IS 0 OR USER DIDN'T SPECIFY
	MOVE	T1,.USMBF	;POINT TO MONITOR BUFFER
	MOVEM	T2,RIBACT##+1(T1) ;STORE AOBJN POINTER TO ACCT STRING
	ADDI	T2,1(T1)	;MAKE AOBJN WORD FOR ACCT STRING IN RIB
	HRLZ	T1,T2		;MAKE A BLT POINTER
	HRRI	T1,1(T2)
	SETZM	(T2)		;ZAP THE EXISTING ACCOUNT STRING
	BLT	T1,-MACTSL-1(T2) ;NOTE THAT MACTSL IS A NEG NUMBER
	PUSH	P,M		;SAVE USER ARG POINTER
	HRRI	M,UUXACT-UUXPRV-1(M) ;POINT TO USER SUPPLIED STRING
	SUBI	T3,UUXACT
SETVP1:	PUSHJ	P,GETWD1##	;GET NEXT USER WORD
	JUMPE	T1,SETVP2	;DONE (SINCE ACCOUNT IS ASCIZ)
	MOVEM	T1,(T2)		;STORE A WORD IN RIB
	AOBJP	T2,SETVP2	;DONE IF RIB FULL
	SOJG	T3,SETVP1	;CONTINUE IF MORE ARGS
SETVP2:	POP	P,M		;RESTORE USER ARG POINTER TO UUXPRV
SETVP3:	HLRZ	T1,DEVEXT(F)	;RIBUSD IS ONLY MEANINGFUL FOR UFD
	CAIN	T1,'UFD'
	CAIGE	P1,UUXUSD	;MIGHT UUXUSD BE IN ENTER BLOCK?
	JRST	SETVP4		;NO
	HRRI	M,UUXUSD-UUXPRV(M) ;YES. POINT TO USD ARGUMENT
	PUSHJ	P,GTWST2##	;JOB WANT USD COMPUTED?
	HRRI	M,-<UUXUSD-UUXPRV>(M)	;POINT M TO PRIV WORD AGAIN
	JUMPGE	T1,SETVP4	;DON'T BOTHER IF NOT NEGATIVE ARGUMENT
	PUSHJ	P,FIXUSD	;FIX RIBUSD
	SKIPA	T3,SETVPB	;NORMAL PRIVILEGED USER BITS
SETVP4:	SKIPA	T3,SETVPB	;NORMAL PRIVILEGED USER BITS
	TLO	T3,1		;RIBUSD NOT SETTABLE
	JRST	SETVAB
;HERE IF UNPRIVED

SETVAU:	CAIGE	P1,UUXSTS	;TRYING TO SET/CLR STATUS BITS?
	JRST	SETVU1		;NO
	HRRI	M,UUXSTS-UUXPRV(M) ;YES, POINT AT STATUS WORD
	PUSHJ	P,GETWDU##	;GET ARGUMENT
	ANDI	T1,RIPRMS##	;GET UNPRIV'D BITS
	MOVE	P2,T1		;PRESERVE THEM IN P2
	HRRI	M,-<UUXSTS-UUXPRV>(M) ;RESET M
SETVU1:	MOVE	T3,SETVUB	;ASSUME DATA FILE
	PUSHJ	P,TSTSFD	;SFD OR UFD?
	  TLO	T3,17		;YES, CAN'T SET DIR STUFF
;	JRST	SETVAB		;FALL INTO SETVAB


;HERE WITH P1=NUMBER OF ARGUMENTS USER IS SUPPLYING
SETVAB:	TLNE	M,UUOREN	;RENAME?
	TLO	T3,400000	;YES, CRE-DATE, PRIVS ALREADY CORRECT IN MON-BUF
	SKIPGE	M		;IF USER CANT CHANGE VALUES
	SETO	T3,		; JUST STORE IN ENTER/RENAME BLOCK
	MOVE	T2,.USMBF
	HRRZ	T4,RIBFIR##+1(T2) ;NO OF VALUES IN FILE
	JUMPE	T4,SETVA1	;HUH?!
	CAILE	P1,-1(T4)	;USER SUPPLYING MORE?
	MOVEI	P1,-1(T4)	;YES, DON'T LET HIM (OLD FILE)
SETVA1:	HRRZ	T2,.USMBF	;LOC OF MON BUF
	MOVE	T1,UNILOG(U)	;GET CURRENT UNIT NAME
	MOVEM	T1,RIBDEV##+1(T2) ;STORE IN RIB
	ADDI	T2,RIBPRV##+1	;POINT TO PRIVS WORD
	MOVNI	T1,-UUXPRV+1(P1) ;T1=-NUMBER OF ARGS TO STORE
	HRLM	T1,T2		;SAVE NUMBER IN LH(T2)
SETVA2:	JUMPG	T3,SETVA3	;PROTECTED ARGUMENT?
	MOVE	T1,(T2)		;YES, GET VALUE FROM RIB
	PUSHJ	P,PUTWDU##	;STORE IN USERS AREA
	JRST	SETVA4		;CONTINUE
SETVA3:	PUSHJ	P,GTWST2##	;GET AN ARG FROM USER
	MOVEM	T1,(T2)		;SAVE IT IN RIB
SETVA4:	HRRI	M,1(M)		;STEP TO NEXT ARG
	LSH	T3,1		;SET NEXT CANT-SUPPLY BIT IN T3
	AOBJN	T2,SETVA2	;GO IF HE WANTS ANOTHER
	MOVE	T2,DEVACC##(F)
	CAIGE	P1,UUXALC	;NEED TO GET ALLOCATION WORD?
	JRST	SETVA5		;NO, GO ON
	SUBI	M,-UUXALC+1(P1)	;POINT TO .RBALC IN USER'S AREA
	MOVE	T1,ACCALC##(T2)	;GET ACTUAL ALLOCATION OF FILE
	PUSHJ	P,PUTWDU##	;STORE IT IN USER'S ARG BLOCK
SETVA5:	MOVE	T1,.USMBF	;MAKE SURE NO-DELETE BIT OFF
	MOVE	T2,ACCDIR##(T2)	;IS FILE A DIRECTORY?
	MOVEI	T4,RIPDIR##
	TRNE	T2,ACPDIR##
	IORM	T4,RIBSTS##+1(T1)  ;YES, DONT LET RIPDIR OR RIPPAL BE CLEARED
	MOVEI	T4,RIPNDP##	; OTHERWISE COULD CREATE A
	ANDCAM	T4,RIBSTS##+1(T1)  ; NON-DELETABLE FILE
	JUMPL	P2,SETVA6	;TRYING TO SET UNPRIV'D BITS?
	MOVEI	T4,RIPRMS##
	ANDCAM	T4,RIBSTS##+1(T1) ;YES, CLEAR OR SET ACCORDINGLY
	IORM	P2,RIBSTS##+1(T1)
SETVA6:	HLRZ	T1,DEVEXT(F)	;GET EXTENSION
	CAIN	T1,'UFD'	;ONLY LEGAL FOR UFD
	PUSHJ	P,FNDUFB	;FIND UFB FOR FILE
	  POPJ	P,		;NOT THERE -RETURN
	PUSHJ	P,PRVJB##	;AND ALLOWED TO ?
	  PJRST	GVCBJ##		;NO, RETURN
	MOVE	T1,.USMBF	;%FOUND IT - L(MON BUF)
	MOVSI	T3,UFPLOG##
	ANDCAM	T3,UFBLOG##(T2)	;CLEAR UFPLOG
	SKIPGE	RIBSTS##+1(T1)	;IS RIPLOG ON?
	IORM	T3,UFBLOG##(T2)	;YES. LIGHT UFPLOG
	MOVE	T3,RIBQTF##+1(T1)  ;%LOGGED-IN QUOTA
	SUB	T3,RIBUSD##+1(T1)  ;%-AMOUNT USED
	MOVEM	T3,UFBTAL##(T2)	;%=CURRENT QUOTA
	PJRST	GVCBJ##		;%GIVE UP CB AND RETURN

;MASKS FOR ARGS IN RIB WHICH CANNOT BE SET BY USER.  BIT ZERO
;REPRESENTS RIBPRV, BIT ONE REPRESENTS RIBSIZ, AND SO ON.
;TABLE BELOW INDICATES CORRESPONDANCE OF THESE BITS AND THE RIBXXX
;EXTENDED RIB ARGUMENT NAMES.

;LH BITS (LAST 4 ARE MEANINGFUL FOR UFDS ONLY):
;PRV SIZ VER  FUT EST ALC  POS FT1 NCA  MTA DEV STS  ELB EUN QTF  QTO QTR USD
;(ALTERNATE USES FOR LAST 4 IN NON-UFD FILES)                TYP  BSZ RSZ FFB
;RH BITS:
;AUT NXT PRD  PCA UFD FLR  XRA TIM LAD  DED ACT AC2  AC3 AC4 AC5  AC6 AC7 AC8

SETVPB:	XWD 202260, 036200	;PRIVILEGED USER BIT MASK
SETVUB:	XWD 202760, 777777	;UNPRIVILEGED USER BIT MASK
;SUBROUTINE TO ZERO THE RETRIEVAL POINTERS IN THE DDB
;RESPECTS T1,T2,T3
DDBZR::	MOVSI	T4,DEPLPC##	;LAST POINTER IS NOT IN CORE
	ANDCAM	T4,DEVLPC##(F)

DDBZRO::SETZM	DEVRB1##(F)	;ZERO 1ST PNTR
	MOVSI	T4,DEVRB1##(F)
	HRRI	T4,DEVRB2##(F)	;SET TO BLT
	BLT	T4,DEVRBN##(F)
	HRRZ	T4,DEVCPY##(F)	;LOC OF IN-CORE COPY
	JUMPE	T4,CPOPJ##
	HRLI	T4,MPTRLN##	;SET TO CLEAR IT OUT
	SETZM	PTRDAT##(T4)
	AOBJN	T4,.-1		;ZERO THOSE POINTERS TOO
	POPJ	P,		;AND RETURN
;SUBROUTINE TO COMPUTE THE RIBUFD WORD
;RESPECTS T1
GTUFR::	PUSH	P,T1
	PUSHJ	P,DIRSET##
	  PJRST	TPOPJ##
	MOVE	T4,UNISTR(U)	;LOC OF STR DATA BLOCK
	LDB	T2,STYCLP##(T4)	;GET ADDRESS
	LDB	T1,UN1PTR##	;GET UN1 ALONE
	LDB	T3,UNYBPC##	;BLOCKS PER CLUSTER
	IMUL	T2,T3		;CONVERT CLUSTER ADR TO BLOCK ADR
	MOVE	T3,STRBPU##(T4)	;HIGHEST BLOCK PER UNIT
	IMUL	T1,T3		;NO OF PRECEEDING BLOCKS IN STR
	ADD	T2,T1		;PLUS BLOCK NO RELATIVE TO UNIT
	PJRST	TPOPJ1##	;RETURN WITH T2=RIBUFD WORD

;SUBROUTINE TO SET RIBUFD WORD IN RIB
;EXIT WITH T1=L(MON BUF-1)  AND RIBUFD WORS SET TO 1ST BLOCK OF UFD
SETUFR:	PUSHJ	P,GTUFR		;COMPUTE RIBUFD WORD
	  JRST	SETUF1		;OOPS
	MOVE	T1,.USMBF	;LOC OF MON BUF
	MOVEM	T2,RIBUFD##+1(T1)	;SAVE ADR IN RIB
FBMLOC:	POPJ	P,FBMERR	;AND RETURN

SETUF1:	SKIPN	DEVSFD##(F)	;IF THERE IS AN SFD,
	SKIPN	DEVUFB##(F)	; OR THERE IS NO UFB
	STOPCD	.,JOB,NUE,	;++NO UFB ERROR
WLKLOC:	POPJ	P,NCEERR	;UFD WAS DELETED - JUST RETURN
;SUBROUTINE TO FIND THE UFB BLOCK FOR A FILE
;ENTER WITH DEVFIL(F)=PRJ,PRG (DEVFIL,DEVEXT=A,B.UFD)
;EXIT CPOPJ IF NO UFB FOR FILE, CB RESOURCE RETURNED
;EXIT CPOPJ1 IF FOUND, WITH CB RESOURCE,
;T1=LOC OF PPB  AND T2=LOC OF UFB
;ENTER AT FNDUF1 WITH T1=PRJ,PRG FOR PPB TO BE SEARCHED
;ENTER WITH DEVACC=A.T. WHICH HAS RIGHT FSN, OR FSN ITSELF IN DEVACC
FNDUFB:	MOVE	T1,DEVFIL(F)	;UFD NAME
FNDUF1::PUSHJ	P,GETCB##	;GET CB RESOURCE
	HLRZ	T2,SYSPPB##	;%START OF PPB'S
	PUSHJ	P,LSTSCN##	;%TRY TO FIND THIS PPB
	  PJRST	GVCBJ##		;%NOT THERE - RETURN
	HRRZ	T1,DEVACC##(F)	;%FOUND.  GET FSN
	CAILE	T1,.FSMAX	;%ACTUAL FSN IF DEVACC LT FSNEND
	LDB	T1,ACZFSN##	;%A.T. LOC - GET FSN FROM ACCFSN
	PUSH	P,T2		;%SAVE LOC OF PPB
	HLRZ	T2,PPBUFB##(T2)	;%START OF UFB'S
	PUSHJ	P,BYTSCA##	;%SEARCH FOR MATCHING UFB
	  JRST	TPOPJ1##	;%FOUND - TAKE GOOD RETURN
	POP	P,T1		;%REMOVE GARBAGE FROM LIST
	PJRST	GVCBJ##		;%NOT THERE RETURN

;ROUTINE TO FIX THE VALUE OF RIBUSD IN THE RIB
;(ONLY THE VALUE IN UFBTAL IS KNOWN TO BE RIGHT)
;RESPECTS ALL ACS EXCEPT T1
FIXUSD:	PUSHJ	P,SAVT##
	PUSHJ	P,FNDUFB	;FIND THE UFB
	  POPJ	P,		;NOT THERE
	MOVE	T1,.USMBF	;%GET QUOTA FROM RIB
	MOVE	T3,RIBQTF##+1(T1)
	SUB	T3,UFBTAL##(T2)	;%MINUS AMOUNT LEFT
	MOVEM	T3,RIBUSD##+1(T1);%GIVES AMOUNT USED
	PJRST	GVCBJ##		;%GIVE UP CB
;DO NOT ALLOW A LOOKUP OF A DIRECTORY THAT IS BEING COMPRESSED
;MAKE LOOKUP BLOCK UNTIL THE COMPRESSOR IS DONE
CMPSLP:	PUSHJ	P,TSTSFD	;IS FILE A DIRECTORY?
	  CAIA			;YES
	POPJ	P,		;NO, LOOKUP IS OK
	CAIE	T1,'SFD'	;UFD OR SFD?
	JRST	CMPSL1		;UFD
	PUSHJ	P,UPAU##	;SFD, WAIT FOR COMPRESSOR TO FINISH
	PJRST	DWNAU##		;DIDN'T REALLY WANT AU ANYWAY
;HERE IF UFD
CMPSL1:	PUSHJ	P,FNDUFB	;FIND UFB (DEVUFB POINTS TO [1,1])
	  POPJ	P,		;NOT FOUND, COMPRESSOR NOT IN PROGRESS
	AOS	PPBCNT##(T1)	;%MAKE SURE UFB DOESN'T GO AWAY
	PUSHJ	P,GVCBJ##	;%NOW IT'S OK TO GIVE AWAY INTERLOCK
	EXCH	T2,DEVUFB##(F)	;POINT DDB AT RIGHT UFB
	PUSHJ	P,UPAU##	;WAIT FOR COMPRESSOR TO FINISH
	PUSHJ	P,DWNAU##	;DIDN'T REALLY WANT AU ANYWAY
	MOVEM	T2,DEVUFB##(F)	;POINT BACK AT [1,1]
	SOS	PPBCNT##(T1)	;PUT USE COUNT BACK
	POPJ	P,
;ERROR STUFF
ILNMEN:	MOVE	J,.CPJOB##
	POP	P,JBTSFD##(J)
	JRST	ILNMER
UILNMR:	MOVEI	T1,ISUERR
	AOJA	M,PUTERR
ILNMER:	TLZN	M,UUOREN	;IS ERROR CODE ALREADY IN T1?
	MOVEI	T1,FNFERR
	AOJA	M,LKENR2
UPDER7:	SKIPA	T1,FBMLOC	;%FILE BEING MODIFIED
UPDER5:	MOVEI	T1,FCUERR	;%FILE CANNOT BE UPDATED
	JRST	UPDERZ		;%GO STORE ERROR CODE
UPDER6:	HRRI	M,UUXEXT-UUXALC(M)
	HRRZ	T1,DEVACC##(F)
	PUSHJ	P,ENER11
	MOVEI	T1,FBMERR
PUTERR:	MOVE	T3,T1
	PUSHJ	P,GETWDU##
	HRR	T1,T3
	PJRST	PUTWDU##
RENER2:	PUSHJ	P,GVCBJ##
	SKIPA	T1,FBMLOC

NTFOUN:	MOVEI	T1,FNFERR
;HERE WITH M AT PPN
LKENER:	TLZA	T1,-1		;LH=0 MEANS LEAVE NMBCNT ALONE
LKENR4:	TLO	T1,-1		;LH=NON-0 MEANS DECREMENT NMBCNT
	SKIPGE	DEVSPL(F)	;SPOOL-MODE?
	POPJ	P,		;YES, IMMEDIATE RETURN

	HRRI	M,UUNEXT-UUNPPN(M) ;RESET M FOR ERROR CODE DEPOSIT
	TLNE	M,EXTUUO
	HRRI	M,UUXEXT-UUXPPN-<UUNEXT-UUNPPN>(M) ;BUMP M FOR EXTENDED FORMAT
	TLNN	T1,-1
LKENR2:	TLZA	T1,-1		;LH=0 MEANS LEAVE NMBCNT ALONE
LKENR9:	TLO	T1,-1		;LH=NON-0 MEANS DECREMENT NMBCNT
	PUSHJ	P,SAVE2##	;PUT ERROR CODE IN A SAFE PLACE
	MOVE	P1,T1
	PUSHJ	P,GETWDU##
	HRR	T1,P1
	PUSHJ	P,PUTWDU##
	HRRZ	T1,DEVSFD##(F)	;JOB HAVE AN SFD?
	SKIPN	P2,T1
	JRST	LKENR3		;NO
	PUSHJ	P,GETCB##	;YES, GET INTERLOCK
	HLRZ	T2,NMBACC##(P2)	;%ADDR OF 1ST A.T.
	TRNN	T2,DIFNAL##	;%REALLY AN A.T.?
	HRL	P2,ACCPPB##(T2)	;%YES, GET ADDR OF PPB
	PUSHJ	P,GVCBJ##	;GIVE UP THE INTERLOCK
	HLRZ	T2,DEVSFD##(F)	;HAVE OLD SFD?
	CAMN	T1,T2		;NEW=OLD?
	JRST	LKENR3		;YES, USE COUNT NOT OP
	TLNE	M,UUOREN
	PUSHJ	P,DECUSA
	TLNN	M,UUOREN
	PUSHJ	P,DECALL	;NO, DECREMENT USE-COUNTS
	TLNE	P1,-1		;SHOULD WE DECREMENT NMBCNT?
	PUSHJ	P,DECUC		;YES, DO IT
LKENR3:	HLRZS	DEVSFD##(F)	;MAKE SURE NO NEW DIRECTORY
	TLNN	M,UUOUPD	;IF NOT AN UPDATE (E.G. FILE NOT OPEN)
	PUSHJ	P,TSTPPB	;CLEAR OUT PPB IF NOT LOGGED-IN
	PJRST	CLRSRB		;CLEAR IOSRIB AND RETURN
ENERR2:	PUSHJ	P,DECMST
	JRST	ENERR7
ENERR3:
ENERR4:	PUSHJ	P,DECMST
	POP	P,T2
ENERR5:	JUMPE	T1,ENERR7
ENERR1:	MOVEI	T1,BNFERR
	JRST	ENERR8
ENERR6:	SKIPA	T1,[TRNERR]
ENERR7:	MOVEI	T1,NRMERR
ENERR8:	HRRI	M,-1(M)		;DECREMENT M FOR ERROR CODE
	TLNE	M,EXTUUO	;EXTENDED FORMAT?
	HRRI	M,-<UUXALC-UUXEXT-1>(M)
	PUSH	P,T1
	TLNE	S,IOSDA
	PUSHJ	P,DWNDA##
	TRNE	S,IOSFA		;HAVE FA RESOURCE?
	PUSHJ	P,DWNFA##	;YES, RETURN IT
	HRRZ	T1,DEVACC##(F)
	SKIPE	T1
	TLNN	M,UUOREN	;RENAME?
	JRST	ENER10
	PUSHJ	P,DECRDR	;YES, DECR READ COUNT
	  JFCL
	DMOVEM	T1,T3
	LDB	T1,ACZFSN##
	PUSHJ	P,FSNPS##	;POSITION BIT FOR STR
	HLRZ	T3,ACCNMB##(T3)
	TRZN	T3,DIFNAL	;FIND NMB
	JRST	.-2
	ANDCAM	T2,NMBYES##(T3)	;REMOVE FAILED - CLEAR YES BIT
	PUSHJ	P,GVCBJ##	;%
	HRRZ	T1,DEVACC##(F)
	HLLZS	DEVACC##(F)	;CLEAR DEVACC
	TRNN	T4,ACMCNT	;DONT RETURN A.T. TO FREE CORE IF OTHER READERS
ENER10:	PUSHJ	P,ENER11
	POP	P,T1
	JRST	LKENR2
RENER3:	SKIPA	T1,WLKLOC	;WRITE LOCK ERROR
RENER4:				;RENAME, NO LOOKUP OR ENTER
LUKER1:	MOVEI	T1,ISUERR	;LOOKUP, ENTER ALREADY IN FORCE
TSTWD0:	PUSHJ	P,GTWDT3
	SKIPE	T2,T3
	TLNE	T2,-1
	AOSA	M
	HRRI	M,UUXEXT(M)
	JRST	PUTERR

ENER11:	MOVEI	T2,ACPUPD	;UPDATE (BY THIS JOB)?
	TDNN	T2,ACCSTS##(T1)
	PJRST	ATRMOV##	;NO, ZAP THE AT
	ANDCAM	T2,ACCSTS##(T1)
	PUSHJ	P,DECSU		;YES, RESET AT, DDB NUMBERS
	PUSHJ	P,DECUC
	MOVSI	T2,-ACPWCT##
	ADDM	T2,ACCWCT##(T1)

	POPJ	P,		; AND DON'T WIRE THE AT
ENER12:	PUSHJ	P,DECMST
	HRRZ	T1,DEVACC##(F)	;ENTER DIDN'T HAPPEN SO A.T. WONT BE REMOVED
	PUSHJ	P,ATRMOV##	;BY OUTPUT CLOSE
	MOVE	T1,WLKLOC
	JRST	LKENER
RENER5:	PUSHJ	P,SFDDEC	;DROP THE COUNT
	SETZM	DEVSFD##(F)	;WIPE THE POINTER
RENER6:	MOVEI	T1,FNFERR	;FILE NOT FOUND
	JRST	TSTWD0		;DETERMINE WHERE TO STORE THE ERROR

UPDER8:	POP	P,(P)		;FIX STACK
	PUSHJ	P,INPSW8	;USETI TO BLOCK ONE
	MOVE	T1,DEVACC##(F)	;POINT TO ACC BLOCK
	PUSHJ	P,ENERR3	;FIX USE COUNTS
	HRRI	M,UUXEXT-UUXALC(M)
	MOVEI	T1,PRTERR	;GET PROTECTION ERROR CODE
	JRST	PUTERR		;STORE ERROR CODE

UPDER9:	MOVEI	T1,PRTERR	;%PROTECTION FAILURE
UPDERZ:	PUSHJ	P,GVCBJ1##	;%GIVE UP THE INTERLOCK
UPDERY:	MOVEI	T1,ISUERR	;ILLEGAL SEQUENCE OF UUO'S
	HRRI	M,UUXEXT-UUXPPN(M) ;POINT AT EXT
	TLNN	M,EXTUUO
	HRRI	M,UUNEXT-<UUNPPN+UUXEXT-UUXPPN>(M)
	PJRST	PUTERR
RENER7:	MOVEI	T1,PRTERR	;PRIVS WON'T ALLOW UPDATE
	JRST	LKENER
RENER8:	MOVEI	T1,SLLERR
	TLO	M,UUOREN
RENER9:	MOVSI	T2,DEPRAD##
	ANDCAM	T2,DEVRAD##(F)

	JRST	LKENR9
RENE10:	MOVEI	T3,FBMERR
	SETZ	T1,

RENE11:	HRRI	M,-5(M)
RENE12:	PUSHJ	P,CLREW
	SKIPN	T1		;NON-0 FROM CHKPRV
	SKIPA	T1,T3
	MOVEI	T1,PRTERR	;RENAME, NOT DELETE. NO PRIVS
	HRRI	M,-1(M)
	JRST	LKENR2
RENE13:	PUSHJ	P,CLREW
	MOVEI	T1,TRNERR
	JRST	LKENER

RENE14:	HRRI	M,-1(M)
RENE15:	HLRZS	DEVSFD##(F)
RENE16:	MOVEI	T1,PRTERR
	AOJA	M,PUTERR
RENE17:	PUSHJ	P,GVCBJ##
	PUSHJ	P,DWNAU##
RENE18:	MOVEI	T1,FBMERR
	AOJA	M,PUTERR
RENE19:	PUSHJ	P,GVCBJ##
	PUSHJ	P,DWNAU##
	MOVEI	T1,NDRERR
	AOJA	M,PUTERR
RENE20:	PUSHJ	P,CLREW		;CLEAR RENAME IN PROGRESS
	PUSHJ	P,DECSU		;ADJUST COUNTS
	PUSHJ	P,DECUC
	MOVEI	T1,BNFERR	;GET ERROR
	HRRI	M,UUXEXT-UUXPRV(M)
	JRST	LKENR2		;CONTINUE

;PRESERVES ALL ACS
;BE CAREFUL NOT TO CALL THIS
;ROUTINE UNLESS YOUR'RE THE
;JOB THAT LIT ACPREN.
CLREW:	PUSH	P,T1
	MOVEI	T1,ACPREN
	ANDCAM	T1,ACCSTS##(P2)
	MOVSI	T1,DEPRAD##
	ANDCAM	T1,DEVRAD##(F)

	JRST	TPOPJ##

FUUEND:	END