Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - filuuo.mac
There are 13 other files named filuuo.mac in the archive. Click here to see a list.
TITLE FILUUO LEVEL D DISK SERVICE ROUTINE  V564
SUBTTL DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW  05 APR 77
	SEARCH	F,S
	$RELOC
	$HIGH
;***COPYRIGHT 1973,1974,1975,1976,1977 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.***
XP VFILUU,564

;ASSEMBLY INSTRUCTIONS: FILUUO,FILUUO/C_F,S,FILUUO
	ENTRY	FILUUO
FILUUO::

;ASSEMBLY PARAMETER FOR FNDFIL INTERLOCK

	ENTRY	FILSER,FILUUO
FILSER::
FILUUO::



;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
IOSALC==2000	;DON'T CHANGE ACCALC WHEN GIVING UP BLOCKS OF A FILE
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
DEFINE	NOSCHEDULE <>
DEFINE SCHEDULE <>
IFE	FTCBDB,<
DEFINE	CBDBUG(A,B)<>
>

IFN	FTCBDB,<
DEFINE	CBDBUG(A,B)<
IFIDN	<A>,<Y><
	EXCH	T1,CBUSER##
	CAME	T1,JOB##
	HALT	.
	EXCH	T1,CBUSER##
>
IFIDN	<B>,<Y><
PUSHJ	P,CKBAS##
>
AOSA	.+1
0
>
>
IFE FTSFD,<
IFN FTLIB,<
	PRINTX	?FTLIB REQUIRES FTSFD
>>
IFN FTCBDB,<
	PRINTX	%FTCBDB SHOULD = 0
>
;DISPATCH TABLE
	POPJ	P,		;DEVOP UUO
	JRST	REGSIZ##	;LENGTH CAN BE GOTTEN FROM DDB
	JRST	DSKINI##	;INITIALIZE
	JRST	HNGDSK##
DSKDSP::JRST	DSKREL
	JRST	CLOSOU
	JRST	OUTPT
	JRST	INPT
	JRST	UENTR
	JRST	ULOOK
	JRST	DMPOUT
	JRST	DMPIN
	JRST	USETO0##
	JRST	USETI0##
	POPJ	P,		;UGETF
	JRST	RENAM
	JRST	CLOSIN
	POPJ	P,		;UTPCLR
	POPJ	P,		;MTAPE

SUBTTL	INTERFACE SUBROUTINES WITH THE REST OF THE MONITOR

;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


IFN	FTSWAP,<
;SUBROUTINE TO CLEAN UP THE ACCESS TABLES FOR A JOB AFTER A SWAP-READ ERROR
;SCANS THE DDB'S, WHEN IT FINDS ONE FOR THE JOB IT FIXES IT-
; DECREMENTS THE READ-COUNT IF READING, CLEARS THE STATUS BYTE IF WRITING
; AND INCREMENTS THE QUOTA IF CREATE OR SUPERSEDE
;IT EXITS BY RETURNING ANY SYSTEM RESOURCES THE JOB MIGHT HAVE
SWPCLN::MOVEI	F,DSKDDB##	;START AT PROTOTYPE DDB
SWPCL1:	HLRZ	F,DEVSER(F)	;LINK TO NEXT DDB
	JUMPE	F,CPOPJ##	;DONE IF 0
	MOVE	T1,DEVMOD(F)
	TLNN	T1,DVDSK	;IS THIS DDB A DISK?
	POPJ	P,		;NO, THROUGH
	LDB	T1,PJOBN##	;YES, SAME JOB?
	CAME	T1,J
	JRST	SWPCL1		;NO, TRY NEXT DDB
	MOVE	S,DEVIOS(F)	;YES
	HRRZ	T1,DEVACC##(F)	;LOC OD A.T.
	JUMPE	T1,SWPCL5	;THROUGH IF NONE
	MOVNI	T2,ACPCNT##	
	TLZN	S,IOSRDC	;DECREMENT READ-COUNT IF ITS UP
	SETZ	T2,
	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, TRY NEXT DDB
	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?
	TDNE	T3,DEVWRT##(F)	;NO, IS THIS DDB AN UPDATER?
	JRST	SWPCL5		;NO, LEAVE A.T. ALONE
IFN FTDSIM,<
	LDB	T2,ACYWCT##	;HE IS AN UPDATER
	SUBI	T2,1		;DECR COUNT OF UPDATERS
	DPB	T2,ACYWCT##	;DONT CLEAR AUALPD IF OTHER UPDATERS
	JUMPN	T2,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:	PUSHJ	P,RETRES##
	HLLZS	DEVACC##(F)
	JRST	SWPCL1		;ANS STEP TO NEXT DDB
>	;END CONDITIONAL ON FTSWAP
IFN FTSWAP!FTEL,<
;SUBROUTINE TO DETERMINE IF A JOB HAS A SHARABLE DISK RESOURCE
;ENTER	J=JOB NUMBER
;EXIT CPOPJ IF NO, CPOPJ1 IF YES
;RESPECTS T1,T2
FLSDR::	CAME	J,CBUSER##	;JOB HAVE CB
	CAMN	J,DAUSER##	; OR DA?
	PJRST	CPOPJ1##	;YES - SKIP RETURN
	CAMN	J,AUUSER##	;JOB HAVE AU?
	PJRST	CPOPJ1##	;YES
	HRRZ	T3,BUFLST##	;NO, LOC OF 1ST MON BUF
FLSDR1:	CAMN	J,MBFJOB##(T3)	;JOB OWN MON BUF?
	PJRST	CPOPJ1##	;YES
	HRRZ	T3,(T3)		;NO, TRY NEXT
	JUMPN	T3,FLSDR1	;JOB HAS NO RESOURCES
	POPJ	P,
>	;END OF FTSWAP!FTEL CONDITIONAL
;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 NON-0 IF 'DEVX', AND DSKX EXISTS
SDVTST::SETZB	T2,T3		;T2=INDEX T3=0 IF STRAIGHT MATCH
SDVTS1:	HLLZ	T4,SDVTBL##(T2)	;NAME
	CAMN	T1,T4		;MATCH?
IFE FTLIB,<
	PJRST	CPOPJ1##	;YES, SKIP-RETURN
>
IFN FTLIB,<
	JRST	SDVTS2		;EXTRA WORK IF LIB
>
	CAIGE	T2,SDVLEN##	;END OF TABLE?
	AOJA	T2,SDVTS1	;NO, TRY NEXT
	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,SDVTST	;IS DEV A SPECIAL DEVICE?
	  PJRST	TPOPJ##		;NO, NON-SKIP
	MOVEI	T3,1		;YES, SET T3 NON-0
	PJRST	TPOPJ1##	;FOUND - SKIP RETURN 
IFN FTLIB,<
SDVTS2:	CAIE	T2,LIBNDX##	;GOOD RETURN IF NOT LIB:
	PJRST	CPOPJ1##
	PUSH	P,T1
	PUSHJ	P,LIBPP		;GOT LIB PPN
	JUMPE	T1,TPOPJ##	;NOT A DISK IF NONE
	PJRST	TPOPJ1##	;A DISK IF LIB EXISTS
>
IFN FTLIB,<
;SUBROUTINE TO GET THE PPN ASSOCIATED WITH DEVICE LIB:
;RETURNS PPN IN T1, 0 IF NO LIB
;RESPECTS ALL ACS (EXCEPT T1)
LIBPP:	PUSHJ	P,CPUJOB##	;JOB NUMBER
	HLRZ	T1,JBTSFD##(J)	;LIB SPECIFICATION
	TRZ	T1,3		;CLEAR SYS,NEW BITS
	JUMPE	T1,CPOPJ##	;RETURN IF NONE
	MOVE	T1,PPBNAM##(T1);GET LIB PPN
	POPJ	P,		;AND RETURN
>	;END CONDITIONAL ON FTLIB


IFN FTNUL,<
;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
>	;END CONDITIONAL ON FTNUL

;SUBROUTINE TO GET THE PPN ASSOCIATED WITH SYS:
;RETURNS PPN IN T3
;RESPECTS ALL ACS EXCEPT T3
SYSNM::
IFN FTLIB,<
	MOVE	T3,.C0JOB##	;JOB NO
	MOVE	T3,JBTSFD##(T3)
	TLNE	T3,JBPXSY##	;NEW ENABLED?
	SKIPA	T3,XSYPPN##	;YES
>
	MOVE	T3,SYSPPN##	;NO
	POPJ	P,
;SUBROUTINE TO TEST IF THE DEVICE WHOSE NAME IS IN T1 IS A DISK
;ENTER WITH J = JOB NUMBER
;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
	PUSHJ	P,SDVTST	;IS IT A SPECIAL DEV?
	  JRST	TSTDS0		;NO
	CAIG	T2,SYSNDX##	;YES, IS IT SYS?
	TLO	F,SYSDEV	;YES, LIGHT SYSDEV
	POPJ	P,		;AND RETURN
TSTDS0:
IFN FTNUL,<
	CAMN	T1,['NUL   ']	;'NUL'
	POPJ	P,		; IS A DISK
>
	TLNN	T1,-1		;XWD 0,,"A"?
	PJRST	CPOPJ1##	;YES,NOT A DSK
IFN FTPSTR,<
	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	TSTDS1		;YES, AN STR
	PUSHJ	P,MSKUNI##	;SET T2=MASK FOR NAME
	PUSHJ	P,SRUNI##	;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
	JUMPE	T3,TSTDS2	;JOB MUST BE PRIVILEGED IF UNIT NOT IN AN STR
TSTDS1:
IFN FTSTR,<	;IF MORE THAN ONE STR
IFN FTPSTR,<
	MOVE	T4,STRPVS##(T3)	;F.S. IS PRIVATE BIT
	TRNN	T4,STPPVS##	;IS THIS A PRIVATE F.S.?
	JRST	TSTD1A		;NO, ALL IS WELL
	PUSHJ	P,SLPTR##	;FIND THIS JOBS S.L.
	  JRST	TSTDS2		;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	TSTDS2		;NO, ILLEGAL UNLESS PRIV'ED
TSTD1A:>
	SKIPLE	T4,STRJOB##(T3)	;STR SINGLE-ACCESS?
	CAIN	J,(T4)		;YES. FOR THIS JOB?
>
	JRST	TSTDS4		;YES, OK
TSTDS2:	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,TSTDS3	;IF A COMMAND,
	CAMN	T1,FSFPPN##	; ONLY [1,2] IS LEGAL
TSTDS3:	PUSHJ	P,PRVJO##	;PRIV'D JOB?
	  JRST	UPOPJ1##	;NO. ERROR RETURN
TSTDS4:
IFN FTDHIA,<
	MOVE	T2,UNIUST##(U)	;NO NEW ACCESSES FOR UNIT?
	TLNE	T2,UNPNNA##
	JRST	UPOPJ1##	;YES, SAY IT ISNT A DSK
>
	JRST	UPOPJ##		;YES. OK RETURN
;ROUTINE TO WRITE THE SATS OF ALL UNITS WHICH HAVE CHANGED
;ENTER WITH RIB IN MONITOR BUFFER
;EXITS WITH U=LAST UNIT IN RIB
RIBSAT::TLNE	S,IOSDA		;HAVE DA?
	JRST	RIBSA1		;YES
	PUSHJ	P,UPDA##	;NO, GET IT
	PUSHJ	P,RIBSA1	;WRITE CHANGED SATS
	PJRST	DWNDA##		;GIVE UP DA AND RETURN
RIBSA1:	PUSHJ	P,SAVE1##	;SAVE P1
IFN FTDMRB,<
	SKIPGE	DEVRIB##(F)	;IF IN AN EXTENDED RIB,
	PUSHJ	P,WTUSAT	; NO UNIT-CHANGE TO EXTENDED RIB
>
	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,WTUSAT	;WRITE SAT FOR UNIT IF IT CHANGED
RIBSA3:	AOBJN	P1,RIBSA2	;AND TRY NEXT POINTER
	POPJ	P,		;DON'T - RETURN

;SUBROUTINE TO WRITE SATS FOR A UNIT
WTUSAT::PUSHJ	P,SAVE2##		;SAVE P1,P2
	LDB	P1,UNYSIC##	;NUMBER OF SAB BLOCKS FOR UNIT
	HLRZ	P2,UNISAB##(U)	;LOC OF 1ST SAB
	JUMPE	P2,CPOPJ##	;EXIT IF UN HAS NO SAB (OFF-LINE OR DOWN)
WTUSA2:	SKIPGE	SABFIR##(P2)	;HAS SAT BEEN MODIFIED?
	PUSHJ	P,SATWRT##	;YES. WRITE IT
	HLRZ	P2,SABRNG##(P2)	;STEP TO NEXT SAB IN RING
	SOJG	P1,WTUSA2	;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
ONCWAT::MOVE	S,DEVIOS(F)	;S
	TRNE	S,IOACT		;STILL ACTIVE?
	JRST	ONCWAT		;YES, KEEP TRYING
DSKSTP::POPJ	P,


;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	TSTPP0		;%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,DDBCOR##	;NO OF 4-WORD BLOCKS NEEDED
	PUSHJ	P,GET4WD##	;GET THE CORE
	  JRST	TPOPJ##		;CANT GET IT - RETURN
SETDD3:	HRR	F,T1		;LOC OF THE CORE
	HRLI	T1,DSKDDB##	;FROM THE PROTOTYPE
	BLT	T1,DEVRB1##-1(F)	;BLT THE NEEDED INFORMATION
	HRLM	F,DSKDDB##+DEVSER	;LINK PROTOTYPE TO THEIS DDB
				;(COPY ALREADY CONTAINS LINK TO NEXT)
IFN FTSPL,<
	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)
IFN FTMOUNT,<
	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)
>	;END CONDITIONAL ON FTMOUNT
SETDD2:	POP	P,DEVNAM(F)	;SET NAME INTO DDB
IFN FTNUL,<
	PUSHJ	P,NULTST	;IN NUL:
	  SKIPA	T2,[XWD -1-TTYATC,177777] ;ALL DV'S, ALL MODES
	PJRST	CPOPJ1##
	IORM	T2,DEVMOD(F)
>
	PJRST	CPOPJ1##	;AND RETURN
;SUBROUTINE TO CLEAR A DISK DEVICE DATA BLOCK
;ENTER WITH F=LOC OF DDB
;CALLED BY RELEASE CODE
CLRDDB::MOVEI	T1,DSKDDB##	;START AT PROTOTYPE
CLRDD1:	MOVE	T2,T1
	HLRZ	T1,DEVSER(T2)	;GET SUCCESSOR TO THIS DDB
	SKIPN	T1		;END?
	STOPCD	CPOPJ##,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
	SKIPE	DINITF##	;IN ONCE-ONLY CODE?
	POPJ	P,		;YES, DON'T GIVE UP CORE
	MOVEI	T1,DDBCOR##	;NO OF 4-WORD BLOCKS TO RETURN
	HRRZ	T2,F		;LOC OF DDB TO CLEAR
	PJRST	GIV4WD##	;RETURN THE CORE AND RETURN TO CALLER



;SUBROUTINE TO SET UP A DDB
;EXITS WITH F=LOC OF DDB
;EXIT CPOPJ IF NO FREE CORE, CPOPJ1 IF OK
FAKDDB::MOVEI	T2,DDBCOR##	;GET CORE FOR A DDB
	PUSHJ	P,GET4WD##
	  POPJ	P,		;NONE AVAILABLE - RETURN CPOPJ
	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,.C0JOB##	;SET UP J
	PUSHJ	P,SETDVL##	;STORE JOB NUMBER
	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


;SUBROUTINE TO FIND THE OWNER(S) OF MONITOR BUFFERS
;ENTER WITH P1=0(FIRST TIME) OR ADR OF A MONITOR BUFFER
;RETURNS CPOPJ IF NO MORE BUFFERS
;RETURNS CPOPJ1 NORMALLY, WITH T3 = JOB NUMBER OF OWNER OF NEXT BUFFER
NXTJBB::SKIPN	P1	;FIRST TIME?
	SKIPA	P1,BUFLST	;YES, START AT FIRST MON-BUF

NXTJBC:	HRRZ	P1,(P1)		;GET POINTER TO NEXT BUFFER
	JUMPE	P1,CPOPJ##	;DONE IF NO MORE
	SKIPL	(P1)		;IS IT IN USE?
	JRST	NXTJBC		;NO, LOOK AT NEXT
	HRRZ	T3,MBFJOB##(P1);YES, SET T3= OWNER
	PJRST	CPOPJ1		;AND 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

IFN FTDSTT,<

DSKCOM::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
>	;END CONDITIONAL ON FTDSTT

IFN FTWATCH,<
;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,2		;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##
>;END FTWATCH

IFN FTWATCH ! FTDSTT,<


;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)	;@ECREASE 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
>	;END CONDITIONAL ON FTWATCH & FTDSTT
IFE FTDSTT,<
DSKCOM==:CPOPJ##
>
;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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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,UNINAM##(P1)	;PHYSICAL UNIT NAME
	SKIPN	UNILOG##(P1)	;NO SKIP IF UNIT IS NOT IN A FILE STRUCTURE
	PUSHJ	P,NAMCOM	;YES, TYPE ITS NAME
	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	/,/
IFN FTDBAD,<
;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
	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 O OR OW?
	CAIN	T1,OWCOD##
	AOSA	T1		;YES
	PJRST	UPOPJ##		;NO, NON-SKIP RETURN
	ADDI	T1,1		;O2COD=OCOD+2,OW2COD=OWCOD+2
	MOVEM	T1,UNISTS##(U)	; (CANT AOS UNISTS SINCE INTERRUPT MIGHT HAPPEN)
	PJRST	 UPOPJ1##	;SKIP RETURN

DSKQU2:	PUSHJ	P,DECIN1##	;GET THRESHOLD
	  POPJ	P,
	  POPJ	P,
	MOVEM	T2,RIBECT##	;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::
IFN	FTSFD,<
	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		;NO FREE CORE - CANT RESET OLD UFD
	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,JOB##		;RESET J
DSKKJ1:
IFN	FTLIB,<
	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
	MOVE	J,JOB##		;RESET J
>	;END CONDITIONAL ON FTLIB
DSKKJ2:	SETZM	JBTSFD##(J)	;CLEAR DEFAULT DIRECTORY
>
	MOVE	T1,JBTPPN##(J)	;GET PPN
	PUSHJ	P,ONLYTS	;IS THERE ANY JOB USING THIS PPN?
	  SKIPA		;YES
	PUSHJ	P,DSKLGO	;NO, DELETE DISK 4-WORD CONTROL BLOCKS
	SCHEDULE		;TURN SCHEDULING BACK ON
	POPJ	P,		;AND EXIT
SUBTTL	DISK. UUO - MISC DISK FUNCTIONS
;CALLI AC,DISK.
;LH(AC)=FUNCTION RH(AC)=ADR
DSKUUO::HLRZ	T2,T1		;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
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
DUULEN==.-DUUTBL-1

IFE FTDPRI,<
PRIUUO==CPOPJ##
>
IFN FTDPRI,<
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
	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?
	CAIG	T1,17		;YES, LEGAL?
	SKIPN	F,USRJDA##(T1)	;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:	HRRZ	T1,USRHCU##	;NO OF OPEN CHANS
PRIUU4:	SKIPE	F,USRJDA##(T1)	;THIS CHAN OPEN?
	PUSHJ	P,PRIDEP	;YES, SET PRIORITY IN DDB 
	SOJGE	T1,PRIUU4	;LOOP FOR ALL CHANS
	PJRST	CPOPJ1##	;TAKE GOOD RETURN
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,
>	;END FTDPRI CONDITIONAL
SUBTTL	INPUT/OUTPUT UUO'S

;BUFFERRED MODE INPUT
INPT:
IFN FTNUL,<
	PUSHJ	P,NULTST	;IF NULL DEVICE,
	  JRST	SETION		; RETURN EOF
>
IFN FTSPL,<
	PUSHJ	P,SPTSTI	;SEE IF 1ST SPOOLED INPUT
	  PJRST	SETION		;YES, AND NO FILE - SET IOEND
>
	TLNE	F,LOOKB		;LOOKUP BEEN DONE?
	TLNE	S,IOSUPR	;YES. IS FILE SUPER USETI MODE?
	PJRST	SETIMP		;YES. LIGHT IOIMPM AND RETURN
IFE	FTAIR,<
	PUSHJ	P,TSTAPN	;NO, TRYING TO READ AN APPEND-ONLY FILE?
	  PJRST	SETIMP		;YES, SET IOIMPM
>
	TLZ	S,IO		;NO. INDICATE INPUT
	MOVEM	S,DEVIOS(F)	;SAVE S
	PUSHJ	P,SAVE2##	;SAVE SOME ACS
INPTU:	PUSHJ	P,UUOSET##	;SET DDB PNTRS FOR THIS BLOCK
	  TLOA	S,IOEND		;EOF.LIGHT A BIT
	PJRST	UUOPWQ##	;OK. GO QUEUE REQUEST

IFN FTSTR,<	;IF MORE THAN ONE STR
;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 L(A.T.)
	MOVE	P2,T1		;P2= SL. PTR.
	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,CLOSIN	;CLOSE CURRENT A.T.
	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
	  PJRST	[SETZM DEVUNI (F)	;PREVENT USETI FROM "WINNING"
		 PJRST UFDSR3]		;AND GIVE EOF
;STILL IN FTSTR CONDITIONAL
	POP	P,P2		;RETURN POSSIBLE TEMP SL. (SETSRC CALL)
	PUSHJ	P,SLGVT##
	TLO	F,LOOKB		;FOUND ONE. SET F AS IF LOOKUP HAPPENED
	TLZ	S,IOEND		;IT ISNT REALLY AN EOF YET
	HRRZ	T3,DEVACC##(F)	;LOC OF A.T.
	PUSHJ	P,AT2DDB##	;COPY DATA FROM A.T. TO DDB
	  JRST	UFDSR2		;A.T. DATA IS VERY WRONG
	SKIPE	T1,DEVMBF##(F)	;DID FNDFIL GET MONITOR BUFFER?
	PUSHJ	P,GVMNBF##	;YES. GIVE IT UP
IFN	FTSFD,<
	PUSHJ	P,UFORSS##	;GET LOC OF FATHER SFD OR UFB
	TRZN	T2,NMPSFU##	;AS SFD?
	JRST	INPTU		;NO, CONTINUE
	MOVE	T1,T2		;YES, L(A.T.) INTO T1
	PUSHJ	P,INCONE	;INCREMENT THE USE-COUNT
>
	PJRST	INPTU		;DO 1ST INPUT ON NEW DIRECTORY FILE


;HERE IF THE ACCESS TABLE PRODUCES A NON-EXISTENT UNIT
UFDSR2:	SKIPE	T1,DEVMBF##(F)	;HAVE A MON-BUF?
	PUSHJ	P,GVMNBF##	;YES, RETURN IT
>	;END CONDITIONAL ON FTSTR
	PJRST	STOIOS##	;MAKE BELIEVE NO MORE UFD'S


UFDSR3:	POP	P,P2		;RETURN TEMP SL. (IF ANY)
	PUSHJ	P,SLGVT##
	PJRST	STOIOS##	;AND RETURN NO MORE UFDS
;BUFFERRED MODE OUTPUT
OUTPT:
IFN FTNUL,<
	PUSHJ	P,NULTST	;IF NUL:,
	  JRST	OUTPT1		; EAT OUTPUT
>
IFN FTSPL,<
	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)
	TLO	S,IO		;NO. INDICATE OUTPUT
	MOVEM	S,DEVIOS(F)	;SAVE S
	PUSHJ	P,UUOSET##	;SET DDB PNTRS FOR THIS OPERATION
	  JRST	CHKLBK		;QUOTA EXHAUSTED OR APPEND-ONLY
	PJRST	UUOPWQ##	;OK - GO QUEUE REQUEST

IFN FTNUL,<
OUTPT1:	PUSHJ	P,ADVBFE##	;NULL DEVICE-EAT THE BUFFER
	  JFCL
	POPJ	P,		;AND RETURN
>
;DUMP MODE INPUT
DMPIN:
IFN FTNUL,<
	PUSHJ	P,NULTST	;IF NUL:,
	  JRST	SETION		; RETURN EOF
>
IFN FTSPL,<
	PUSHJ	P,SPTSTI	;SEE IF 1ST INPUT IN SPOOL MODE
	  PJRST	SETION		;YES, AND NO FILE - SET IOEND
>
IFN FTDSUP,<			;SUPER USETI/USETO
	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
IFE	FTAIR,<
	PUSHJ	P,TSTAPN	;TRYING TO READ AN APPEND-ONLY FILE?
	  PJRST	SETIMP		;YES, LIGHT IOIMPM
>
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)
IFN FTSFD,<
	CAIE	T1,(SIXBIT .SFD.) ;AN SFD?
>
	CAIN	T1,(SIXBIT /UFD/)  ;OR UFD?
	SOS	(P)		;YES, YOU LOSE
	PJRST	CPOPJ1##
;DUMP MODE OUTPUT
DMPOUT:
IFN FTNUL,<
	PUSHJ	P,NULTST	;IF NUL,
	  POPJ	P,		; DONT WRITE ANYTHING
>
IFN FTSPL,<
	PUSHJ	P,SPTSTO	;SEE IF 1ST OUTPUT IN SPOOL MODE
	  PJRST	SETIMP		;YES, AND ERROR ON ENTER - SET IOIMPM
>
IFN FTDSUP,<			;SUPER USETI/USETO
	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
IFN FTDSUP,<
	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
	JUMPN	T1,DUMPG2	;IF IOWD GO ON TO DO IT
	SETZM	DEVDMP##(F)	;THROUGH - ZERO DEVDMP
IFN FTDSUP,<
	TRZ	S,UDSX		;MAKE SURE WRITE-FORMAT OFF
>
	PJRST	STOIOS##	;AND RETURN TO USER


DUMPG2:	HLL	P1,T1		;SAVE UNRELOCATED IOWD
	MOVE	T2,T1		;SAVE WDCNT
	SUBI	T1,(R)
	HRR	P1,T1
DUMPG3:	HLLZM	T2,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	T1,DEVDMP##(F)	;-WORDCOUNT OF IOWD
	TRNE	T1,BLKSIZ##-1	;EVEN MULTIPLE OF 200 WORDS?
	TLNN	S,IO		;NO. INPUT?
	JRST	DUMPG5		;YES. IOWD IS OK AS IT IS
	LDB	T2,UNYKTP##	;OUTPUT. GET KONTROLLER TYPE
	CAIE	T2,TYPRP##	;OR RP04.
	CAIN	T2,TYPDP##	;DISK PACK?
	JRST	DUMPG5		;YES, HARDWARE WILL WRITE 0'S TO END OF BLOCK

;SINCE NON DISK-PACK TYPE DISKS DO NOT WRITE ZEROS FROM THE LAST DATA WORD
; TO THE END OF BLOCK (JUST TO THE END OF SECTOR), AND THIS REQUEST IS
; FOR A NON-EVEN NUMBER OF WORDS,WE WILL HAVE TO WRITE FILLER 0'S BY HAND
	MOVNS	T1		;+WORDCOUNT
	LSH	T1,MBKLSH##	;NUMBER OF BLOCKS  IOWD WILL TRANSFER
	HRRZ	T2,DEVLFT##(F)	;NO OF BLOCKS LEFT IN CURRENT GROUP
	CAML	T1,T2		;WILL THIS GROUP FINISH THE IOWD?
	JRST	DUMPG5		;NO. DON'T NEED MON BUF TILL LATER
	PUSHJ	P,GTMNBF##	;YES. GET MONITOR BUFFER
	MOVSI	T2,1(T1)	;1ST WORD IN BUFFER
	HRRI	T2,2(T1)	;SET UP TO ZERO IT
	SETZM	1(T1)
	BLT	T2,BLKSIZ##(T1)	;ZERO ENTIRE MON BUFFER
;HERE WITH A ZEROED MONITOR BUFFER IF IT WILL BE NEEDED
; (SETLST ASSUMES MON BUFFER IS SET UP IF IT IS NEEDED)
DUMPG5:	MOVE	T1,P1		;ORIGINAL IOWD
	HLRE	T2,T1		;-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
	PUSHJ	P,SAVDDL##	;ADJUST RH IN CASE PHIS IS A SAVE OF A HIGH SEGMENT
				; WHICH HAS BEEN SHUFFLED SINCE LAST IO
IFN FTKI10!FTKL10,<
	PUSHJ	P,UVACKS##	;COMPUTE USER VIRTUAL ADDRESS OF THE CHECKSUM
	HRLM	T2,DEVUVA##(F)	;STORE IT FOR COMPUTING THE CHECKSUM
>
IFN FTKA10,<
	HRLM	T1,DEVUVA##(F)	;STORE IT FOR COMPUTING THE CHECKSUM
>
	ADDI	T1,(R)		;RELOCATE RH OF IOWD
	HRRM	T1,DEVDMP##(F)	;STORE ABS ADR FOR DATA TRANSFER
				; (RH ALREADY SET -IGNORE OVERFLOW FROM LH)
	PUSHJ	P,UUOPWQ##	;OK - GO QUEUE REQUEST
	PUSHJ	P,PWAIT1##	;WAIT FOR IO TO FINISH
DUMPG6:	SKIPE	T1,DEVMBF##(F)	;HAVE MONITOR BUFFER?
	PUSHJ	P,GVMNBF##	;YES. RETURN IT
	MOVE	T2,DEVDMP##(F)	;THIS COMMAND DONE?
	TLNE	T2,-1
	JRST	DUMPG3		;NO. CONTINUE WITH THIS IOWD
	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	CHKLBK		;NO, QUOTA EXHAUSTED, DISK FULL OR APPEND-ONLY
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


IFE	FTAIR,<
;SUBROUTINE TO TEST IF APPEND-ONLY
;RETURNS CPOPJ IF YES, CPOPJ1 IF NO
TSTAPN:	LDB	T1,DEYFNC##
	CAIE	T1,FNCAPP##	;IS IT APPEND-ONLY?
	PJRST	CPOPJ1##	;NO, RETURN
	PJRST	PRVJB##		;YES, SKIP RETURN ONLY IF PRIV'D JOB
>

;SUBROUTINE TO GET A WORD FROM USERS CORE, SAVE J
JWORD:	PUSH	P,J		;SAVE J (POSSIBLE KONTROLLER DB LOC)
	PUSHJ	P,GETWDU##	;GET THE WORD
	PJRST	JPOPJ##		;RESTORE J AND RETURN
;HERE ON NON-SKIP RETURN FROM UUOSET
IFE	FTAPLB,<
CHKLBK==SETBTL			;IOBKTL IF CANT APPEND TO LAST BLOCK OF FILE
>
IFN	FTAPLB,<
CHKLBK:	PUSHJ	P,SAVE2##	;SAVE P1,P2
	LDB	T1,DEYFNC##	;PROTECTION OF FILE
	TLNE	S,IO		;WRITING?
	CAIE	T1,FNCAPP##	;YES, APPEND-ONLY?
	JRST	SETBTL		;NO, SET IOBKTL
	MOVE	T2,DEVACC##(F)	;YES, L(A.T.)
	MOVE	T1,ACCWRT##(T2)	;NUMBER OF BLOCKS WRITTEN
	LDB	P1,ACYLBS##	;SIZE OF LAST BLOCK
	CAMN	T1,DEVREL##(F)	;TRYING TO WRITE LAST BLOCK?
	CAIL	P1,BLKSIZ##	;YES, LAST BLOCK HAVE ROOM?
	JRST	SETBTL		;NO, SET IOBKTL
	TLZ	S,IOSFIR	;DON'T ALLOW CHECKSUMS
	PUSHJ	P,GTMNBF##	;YES, GET A MON-BUF
	MOVE	T2,DEVBLK##(F)	;NUMBER OF LAST BLOCK
	PUSHJ	P,MONRED##	;READ IT
	PJUMPN	T3,GVMNBF##	;RETURN IF ERRORS DETECTED IN MONRED
	LDB	P2,PIOMOD##	;MODE OF FILE
	CAIL	P2,SD		;DUMP?
	JRST	CHKLB1		;YES
	MOVE	T1,DEVOAD(F)	;NO, GET SIZE OF BUFFER
IFN FTKA10,<
	MOVEI	T1,@T1		;RELOCATE KA10 STYLE
>
	EXCTUX	<MOVE T1,1(T1)>
	CAIG	T1,(P1)		;REALLY APPEND?
	JUMPN	T1,CHKLB2	;NO, ERROR
	HRRZ	T1,DEVOAD(F)	;NO, GET LOC OF USERS BUFFER
	HRLI	T1,MBLKSZ##	;LENGTH = 200
	JRST	CHKLB4

;HERE IF DUMP MODE
CHKLB1:	PUSHJ	P,JWORD		;GET THE IOWD
	MOVE	T4,[XWD BLKSIZ##,BLKSIZ]
	ADDM	T4,DEVDMP##(F)	;UPDATE THE IOWD SAVED IN THE DDB
	HLRE	T3,T1		;NUMBER OF WORDS TO WRITE
	CAML	T3,[-1,,MBLKSZ##]  ;IF IOWD NOW DONE,
	JUMPL	T3,[HRRZS DEVDMP##(F)
		    JRST .+1]	; CLEAR LH(DEVDMP)
	ADD	T3,P1		;MORE THAN CURRENT SIZE OF BLOCK?
	JUMPL	T3,CHKLB3	;OK IF POITIVE
CHKLB2:	PUSHJ	P,GVMNB0##	;BAD - RETURN THE MON BUF
	PJRST	SETBTL		;AND SET IOBKTL
CHKLB3:	SUBI	T1,1		;ADJUST IOWD
;STILLL IN FTAPLB CONDITIONAL
;HERE WITH T1=IOWD, P1=NUMBER OF WORDS IN BUFFER
CHKLB4:	MOVE	T3,DEVMBF##(F)	;LOC OF MON BUFFER
	ADDI	T1,2(P1)	;ACCOUNT FOR HOUSEKEEPING WORDS
	ADDI	T3,1(P1)	;POINT TO FIRST NEW WORD IN MON BUF
IFN FTKA10,<
	ADDI	T1,(R)		;POINT TO FIRST NEW IN USER'S AREA
>
	HRL	T3,T1		;SET FOR BLT
	HLRES	T1		;NUMBER OF WORDS TO TRANSFER
	MOVNS	T1		;+N
	CAILE	T1,BLKSIZ##	;MAKE SURE IT ISNT TOO HIGH
	MOVEI	T1,BLKSIZ##	;IT IS, REDUCE IT
	ADD	T1,DEVMBF##(F)	;POINT TO END OF BLT
	EXCTUX	<BLT T3,(T1)>	;INTO MON-BUF
	MOVE	T1,DEVMBF##(F)	;IOWD FOR THE DATA
	PUSHJ	P,MONWRT##	;GO WRITE IT
	PUSHJ	P,GVMNBF##	;RETURN THE MON-BUF
	AOS	DEVBLK##(F)	;UPDATE COUNTS
	AOS	DEVREL##(F)
	SOS	DEVLFT##(F)

;HERE WHEN THE NEW LAST BLOCK HAS BEEN WRITTEN
	CAIL	P2,SD		;DUMP MODE?
	JRST	DUMPG6		;YES, FINISH UP
	MOVE	T1,DEVOAD(F)	;NO, POINT TO THE DATA
	EXCTUX	<SKIPN T1,1(T1)>;GET THE WORD COUNT
	MOVEI	T1,BLKSIZ##	;200 WORDS IF NOT SPECIFIED
	MOVE	T2,DEVACC##(F)	;LOC OF A.T.
	DPB	T1,ACYLBS##	;SAVE NEW LAST-BLOCK SIZE
	PUSHJ	P,ADVBFE##	;ADVANCE 1 BUFFER
	  JFCL
	POPJ	P,		;AND RETURN
>	;END CONDITIONAL ON FTAPLB
IFN FTSPL,<

;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
IFN FTSTR,<	;IF MORE THAN ONE STR
	PUSHJ	P,SLPTJ##	;SET T1= SL. PTR.
	  POPJ	P,		;NO S.L.
>
	PUSHJ	P,ULOOK2	;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
	HLLM	F,USRJDA##(P1)	;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
	PUSHJ	P,SAVE1##	;NO. SAVE P1
	MOVEI	T2,1		;GET 1 4-WORD BLOCK
	PUSHJ	P,GET4WD##
	  POPJ	P,		;NONE AT ALL- CANT FAKE THE ENTER
	MOVE	P1,T1		;GOT ONE - SAVE ITS LOC IN P1
	HRLI	T1,140(R)	;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,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,141(R)	;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'
>
SPTST4:	HRRM	T1,140(R)	;SAVE RH OF FILE NAME IN ENTER BLOCK
	MOVEI	T1,^D640	;THERE ARE 36**2 LEGAL NAMES STARTING WITH "Q",
	HRRM	T1,141(R)	; SO SET A LIMIT OF HALF THAT
SPTST5:	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
;STILL IN FTSPL CONDITIONAL
	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,141(R)	;COUNT OF TRIES
	TRNE	T1,-1		;TRIED (AND LOST) ENOUGH?
	SOSA	141(R)		;NO
	DPB	T2,[POINT 6,T3,23]	;YES, 1ST CHAR = RANDOM
	HRLM	T3,140(R)	;SAVE NAME
	PUSH	P,M		;SAVE UUO
	HRRI	M,140		;POINT M TO THE FAKED ENTER-BLOCK
IFN FTSTR,<	;IF MORE THAN ONE STR
	PUSHJ	P,SLPTJ##	;T1 = SL. PTR.
	  POPJ	P,		;NO S.L.
>
	MOVE	T2,SPLPRT##	;PROTECTION FOR SPOOLED FILES
	MOVEM	T2,142(R)
	SETZM	143(R)		;ZERO PRJ,PRG
IFN FTGALAXY,<
	MOVE	T2,QUEPPN##	;GET QUEPPN
	SKIPE	%SIQSR##	;QUASAR RUNNING?
	MOVEM	T2,143(R)	;YES, PUT FILE IN QUEPPN
>
	PUSHJ	P,UENT2		;FAKE AN ENTER
	  JRST	SPTST6		;DID NOT WIN
	TLO	F,ENTRB		;OK - TURN ON ENTRB
	AOSA	T1,-1(P)	;SET FOR SKIP-RETURN
SPTST6:	TLZ	F,ENTRB		;MAKE SURE ENTRB OFF ON FAILURE
	POP	P,M		;RESTORE UUO
	LDB	T2,PUUOAC##	;GET CHAN NUM
	HLLM	F,USRJDA##(T2)	;SAVE BITS IN USRJDA
	CAIN	T1,AEFERR	;CAN'T - SUPERSEDE ERROR?
	JRST	SPTST5		;YES, TRY AGAIN
	HRLZ	T2,P1		;LOC OF 4-WORD BLOCK
	HRRI	T2,140(R)	;SET TO RESTORE USER'S 0-3
	BLT	T2,143(R)	;BACK AS GOOD AS NEW
	MOVEI	T1,1		;DONE - GIVE UP CORE BLOCK
	HRRZ	T2,P1
	PJRST	GIV4WD##	;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,SAVE1##	;SAVE P1
	HLRZ	U,DEVUNI##(F)	;SET U TO UNIT OF RIB
IFN FTSTR,<
	JUMPE	U,CPOPJ##	;RETURN IF UNIT WAS YANKED
>
	PUSHJ	P,TSTRDR	;IS ANYONE ELSE READING FILE?
	JUMPE	T1,STOIOS##	;RETURN IF NO AT
	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:	SKIPN	DEVMBF##(F)	;FILE HAVE MON BUF?
	PUSHJ	P,GTMNBF##	;NO. GET IT
NOTOL2:	PUSHJ	P,SAVE1##	;SAVE P1
	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
IFN	FTSFD,<
	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
	SKIPE	T1,DEVMBF##(F)	;HAVE MONITOR BUFFER?
	PUSHJ	P,GVMNBF##	;YES. RETURN IT
	PUSHJ	P,GETCB##	;GET CB RESOURCE
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	CBDBUG	(Y,Y);
	PJRST	CLSN3A		;%DELETE NMB, TEST LOGGED-IN, AND EXIT
;HERE WHEN FILE IS NOT MARKED FOR DELETION
CLSIN2:	TRNE	M,CLSOUT	;SUPPRESSING OUTPUT CLOSE?
	JRST	CLSN2B		;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
CLSN2B:	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	CLSIN3		;YES, DON'T WRITE RIB
	TLNN	S,IOSWLK	;FILE WRITE LOCKED?
	TLNN	F,INPB		;NO. ANY INPUTS DONE?
	JRST	CLSIN3		;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	CLSIN3		;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	CLSN2A		;RIB ERR - DON'T REWRITE IT
	TRNE	M,CLSACC
	JRST	CLSN2C
	MOVE	T1,DEVMBF##(F)	;LOC OF BUF (-1)
	MOVE	T2,THSDAT##	;GET TODAYS DATE
	DPB	T2,[POINT 15,RIBEXT##+1(T1),35]
	HRRM	U,DEVUNI##(F)
CLSN2C:
IFN FTDBBK,<
	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
IFN FTDBBK,<
	PUSHJ	P,ERRFIN	;WRITE BAT BLOCK IF THERE WAS AN ERROR
>
CLSN2A:	PUSHJ	P,GVMNB0##	;GIVE UP MONITOR BUFFER
CLSIN3:	TLNE	F,ENTRB+RENMB	;ENTER OR RENAME DONE?
	JRST	CLSXIT		;YES, EXIT (UPDATE SUPPRESSING OUTPUT CLOSE)
IFN FTFDAE,<
	MOVSI	T1,DEPFDA##	;CALL FILE DAEMON ON CLOSE BIT
	TDNN	T1,DEVFDA##(F)	;SHOULD THE FILE DAEMON BE CALLED?
	JRST	CLSN3D		;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
CLSN3D:>
IFN FTSFD,<
	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,CLSIN5	;%EXIT IF READ-COUNT NON-0
	TRNE	T2,ACPREN	;%RENAME IN PROGRESS (BY ANOTHER JOB)?
	JRST	CLSIN5		;%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	CLSIN6		;%YES, JUST MAKE A.T. DORMANT
IFN FTSFD,<
	MOVE	T3,T1		;%SAVE LOC OF A.T.
	PUSHJ	P,GTNM1		;%GET L(NMB)
	EXCH	T1,T3		;%L(NMB) INTO T3, L(A.T.) INTO T1
	MOVE	T2,NMBSFD##(T3)	;%IS THE FILE AN SFD?
	TRNN	T2,NMPSFD##	;%
	JRST	CLSN3B		;%NO, CONTINUE
	MOVE	T2,NMBNMB##(T3)	;%YES, DOES IT POINT TO ANY NMB'S?
	TLNN	T2,NMPUPT##	;% (IF SO, THERE IS AN NMB POINTING TO IT)
	JRST	CLSIN6		;%YES, THE NMB MAY NOT BE DELETED
CLSN3B:>
;HERE IF NMB NOW HAS NO A.T.S IN ITS RING
CLSN3A:	JUMPE	T1,CLSIN5	;IF STR WAS REMOVED
	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?
	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,TSTPPB	;%EXIT IF NMB STILL IN USE
	HLRZ	T2,P1		;%LOC OF PPB FOR FILE
	PUSHJ	P,SET1NM	;%SET T2 TO 1ST NMB IN LIST
	JUMPE	T2,CLSIN5	;%GO IF NONE (SYSTEM ERROR?)
CLSN3C:	CAIN	T2,(P1)		;%THIS THE RIGHT NMB?
	JRST	CLSIN4		;%YES. HAVE PRED IN T3
	MOVE	T3,T2		;%NO. NEW PREDECESSOR
	HLRZ	T2,NMBPPB##(T2)	;%STEP TO NEXT NMB IN RING
IFN	FTSFD,<
	TRNN	T2,NMPUPT##	;%UPWARD PNTR (NOT SAME LIST) IF ON
>
	JUMPN	T2,CLSN3C	;%GO TEST IT
	JRST	CLSIN5		;%CANT FIND THE PREDECESSOR (SYSTEM ERROR?)

;HERE WITH T3=LOC OF PREDECESSOR NMB TO THE ONE WE WANT TO DELETE
CLSIN4:	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
CLSIN5:	PUSHJ	P,GVCBJ1##	;%GIVE UP CB AND SKIP
CLSIN6:	PUSHJ	P,ATSDRA##	;%MAKE A.T. DORMANT
	SETZM	DEVUNI##(F)	;THIS FILE NO LONGER OPEN (SO ENTER WILL TEST UNIT)
IFN	FTLIB,<
	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:
IFN	FTLIB,<
	MOVSI	T1,DEPLIB##	;CLEAR FILE-FROM-LIB
	ANDCAM	T1,DEVLIB##(F)	;SO UPDATE WILL WIN
>
	POPJ	P,		;EXIT
;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
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
;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::HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	SKIPN	T1,T2		;IS THERE ONE?
	JRST	GTNM2
GTNM1::	HLRZ	T1,ACCNMB##(T1)	;STEP TO NEXT IN RING
	TRZN	T1,DIFNAL##	;IS IT AN NMB?
	JRST	.-2		;NO. TRY NEXT
	POPJ	P,		;YES. RETURN


GTNM2:	SKIPN	DEVUNI(F)
	POPJ	P,
	STOPCD	CPOPJ##,DEBUG,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.
CLSNAM::PUSHJ	P,GETNMB	;SET T1= NMB,  T2=A.T.
	MOVE	T3,NMBNAM##(T1)	;NAME
	MOVEM	T3,DEVFIL(F)	;INTO DDB
	PUSHJ	P,GTNMX		;GET EXTENSION FROM NMB
	HLLM	T4,DEVEXT(F)	;INTO DDB
	POPJ	P,		;RETURN
;SUBROUTINE TO GET THE EXTENSION FROM THE NMB BLOCK
;RESPECTS T1,T2,T3
GTNMX::
IFN	FTSFD,<
	MOVE	T4,NMBSFD##(T1)	;GET LOC OF SFD-WORD
	TRNN	T4,NMPSFD##	;IS THE FILE AN SFD?
	SKIPA	T4,NMBEXT##(T1)	;NO, GET EXT. FROM NMB
	MOVSI	T4,(SIXBIT .SFD.) ;YES, EXT="SFD"
	POPJ	P,		;RETURN
>
IFE	FTSFD,<
	MOVE	T4,NMBEXT##(T1)
	POPJ	P,
>


;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::
IFN	FTSFD,<
	HRRZ	T4,DEVSFD##(F)
	JUMPE	T4,SETIN1
	HLRZ	T2,NMBNMB##(T4)	;IN AN SFD - 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
	SUB	T3,T4		;T3=WHERE TO STOP BLT
	BLT	T1,-2(T3)	;(BLT 1 WORD TOO MANY IN CASE THIS
				;IS THE 64TH ENTRY IN THE BLOCK)
	SETZM	-2(T3)		;ZERO LAST SLOT IN UFD BLOCK
	SETZM	-1(T3)
	MOVE	T1,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	MOVE	T2,DEVBLK##(F)	;BLOCK NUMBER
	PUSHJ	P,WRTUFD	;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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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
IFN FTDBBK,<
;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
;ENTER WITH T1=C(DEVMBF)
;EXIT WITH T1=C(DEVMBF)
TSTBAD:	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,SAVE1##	;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
	LDB	T2,DEYELB##	;BAD BLOCK NUMBER
	MOVEI	P1,1		;P1 WILL COUNT # OF BLOCKS IN BAD REGION
	MOVSI	T1,MBLKSZ##	;IOWD TO READ  1 BLOCK, BUT NOT STORE DATA
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,MONRED##	;NO, READ IT
	TRNE	T3,IODTER+IODERR ;IS IT BAD?
	AOJA	P1,TSTBD2	;YES. COUNT AND TRY NEXT BLOCK
TSTBD3:	MOVE	T1,DEVMBF##(F)	;NO. LOC OF MON BUF (AND RIB)
	HRRM	P1,RIBNBB##+1(T1) ;SAVE COUNT IN RIB
	POP	P,U		;RESTORE ORIGINAL U
	HRRM	U,DEVUNI##(F)	;SAVE IN DDB
	POPJ	P,		;AND RETURN
;STILL IN FTDBBK CONDITIONAL
;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,DEVMBF##(F)	;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,DEVMBF##(F)	;LOC OF RIB
	HRRZ	P2,RIBNBB##+1(T1)	;LENGTH OF BAD REGION
	ADD	P2,P1		;TOP BLOCK(+1) OF BAD REGION
	HRRZ	T2,UNIHOM##(U)	;LOC OF 1ST HOME BLOCK
	ADDI	T2,LBOBAT##	;OFFSET FOR 1ST BAT BLOCK
	PUSHJ	P,MONRED##	;READ IT
	HLRZ	T2,UNIHOM##(U)	;LOC OF 2ND HOME BLOCK
	ADDI	T2,LBOBAT##	;LOC OF 2ND BAT BLOCK
	TRZE	T3,IODTER+IODERR+IOIMPM	;ERROR READING 1ST BAT?
	PUSHJ	P,MONRED##	; YES. READ 2ND 
	MOVE	T1,DEVMBF##(F)	;LOC OF BAT BLOCK
	MOVEI	T2,1(T1)	;1ST REAL WORD OF BAT
	ADD	T2,BAFFIR##(T2)	;COMPUTE AOBJN WORD FOR BAT REGIONS
	MOVS	T3,BAFNAM##+1(T1) ;NAME OF BLOCK
	CAIE	T3,'BAT'	;"BAT"?
	PJRST	SDWNDA##	;NO, DON'T UPDATE
;STILL IN FTDBBK CONDITIONAL
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
	LDB	T4,BAYNBB##	;NO OF BLOCKS IN REGION-1
	ADDI	T4,1(T3)	; TOP BLOCK(+1) OF BAD REGION
	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
	LDB	T4,UNYPUN##	;THIS UNIT NUMBER
	LSH	T3,(T4)		;POSITION BIT FOR THIS UNIT
	ORB	T3,BAFPUB##(T2)	;MARK IN TALLY OF UNITS WHICH SAW BAD REGION
;STILL IN FTDBBK CONDITIONAL
;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
	MOVE	P1,T2
	HRRZ	T2,UNIHOM##(U)	;LOC OF 1ST HOME BLOCK
	ADDI	T2,LBOBAT##	;LOC OF 1ST BAT BLOCK
	PUSHJ	P,MONWRT##	;WRITE IT
	HLRZ	T2,UNIHOM##(U)	;LOC OF 2ND HOME BLOCK
	ADDI	T2,LBOBAT##	;LOC OF 2ND BAT BLOCK
	PUSHJ	P,MONWRT##	;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,SDWNDA##	;GIVE UP DA RESOURCE IF NOT SIM. UPDATE
	JRST	ERFIN5

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

;HERE AFTER BAT BLOCK IS WRITTEN
ERFIN5:
	PUSHJ	P,UPAU##	;NO, GET AU RESOURCE
	HRRZ	P1,DEVUFB##(F)	;LOC OF UFB
	JUMPE	P1,DWNAU##	;NO UFB IF SUPER IO
	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,DEVMBF##(F)	;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
	ORM	T3,RIBSTS##+1(T1)	;MARK IN LH(RIBSTS)
	PUSHJ	P,MONWRT##	;WRITE UFD RIB
	PJRST	DWNAU##		;GIVE UP AU AND RETURN
>	;END CONDITIONAL ON FTDBBK
;CLOSE OUTPUT

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

CLOSOU:
IFN FTSPL,<
	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
	PUSHJ	P,GTMNBF##	;YES, GET THE MON BUFFER
	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
IFN FTKA10,<
	TLO	T2,R		;SET TO RELOCATE
>
	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	CLSO1A		;NO, SKIP ON
	HLL	T3,T2		;SET TO RELOCATE BUFFER POINTER
	AOS	T1,T3		;GET ADDR OF USER WORD COUNT IN T1,T3
IFN FTKA10,<
	MOVEI	T1,(T1)		;CLEAR INDEX PC FOR ADDR CHECK>
	PUSHJ	P,UADRCK##	;MAKE SURE LEGAL, NO RETURN IF NOT
	EXCTUX	<HRRZ T4,@T3>	;GET USER WORD COUNT
CLSO1A:	JUMPE	T4,NOOUTP	;DON'T OUTPUT IF LENGTH .LE. 0
	TLZ	S,IOSRIB	;RIB IS NO LONGER IN MON BUF
				;(OUTPUT MAY READ RIB BACK)
	PUSHJ	P,OUT##		;WRITE THE LAST BUFFER
	PUSHJ	P,PWAIT1##	;WAIT FOR IT
;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!
	HRRZ	U,DEVUNI##(F)	;SET U TO UNIT OF SECOND RIB
IFN FTSTR,<
	JUMPE	U,CPOPJ##	;A.T. WAS FIXED IF STR 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
	SKIPN	T1,DEVMBF##(F)	;JOB HAVE MONITOR BUFFER?
	PUSHJ	P,GTMNBF##	;NO. GET IT
IFN FTDSIM,<
	MOVE	T1,DEVACC##(F)	;IF THIS IS A SIMULTANEOUS UPDATE FILE
	MOVE	T1,ACCSMU##(T1)	; GET THE DA RESOURCE AS A GUARD AGAINST
	TRNE	T1,ACPSMU	; RACE CONDITIONS INVOLVING RIBS
	PUSHJ	P,UPDA##	; GET DA 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
IFE FTDSIM,<
	JUMPN	T3,NOOUT2	;RIB ERROR - FORGET IT
>
IFN FTDSIM,<
	JUMPE	T3,NOOUT1	;GO IF NO RIB ERROR
	TLNE	S,IOSDA		;RIB ERROR - HAVE DA?
	PUSHJ	P,DWNDA##	;YES (SIM UPDATE). RETURN IT
	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
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	TLZN	F,RESETB	;RESET BEING PERFORMED?
	JRST	CLSOU2		;NO. CONTINUE
IFN	FTDMRB,<
	SKIPL	DEVRIB##(F)	;IN EXTENDED RIB?
	JRST	NOUT1A		;NO
	PUSHJ	P,WRTRIB##	;YES, WRITE CURRENT RIB
	PUSHJ	P,REDRIB##	;READ PRIME RIB
	  JRST	CLRSTS		;ERROR READING RIB
	HRRZ	T1,DEVACC##(F)	;RESTORE AT LOC
NOUT1A:
>


	PUSHJ	P,ATRMOV##	;GET RID OF A.T.
IFN	FTSFD,<
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNT OF SFD A.T.
>
	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:	MOVE	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,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
	TLNN	F,RESETB	;CLOSE ACTING LIKE RESET?
	TRNN	T1,ACPCRE	;CREATE?
	JRST	CLRSTS		;NO, DON'T TOUCH OLD FILE
	JRST	CLSRB7		;YES, ENTER NAME IN UFD
;HERE WITH THE RIB IN CORE, AND ALL PNTRS IN THE RIB
CLSOU2:
IFN FTDSIM,<
	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
IFN FTDMRB,<
	SKIPL	DEVRIB##(F)	;NOT LAST WRITER - IN PRIME RIB?
	JRST	CLSRB4		;YES, JUST UPDATE DATES
	PUSHJ	P,WRTRIB##	;NO, WRITE CURRENT RIB
	PUSHJ	P,REDRIB##	;READ PRIME RIB
	  JRST	NOOUT2		;RIB ERR
>	;END FTDMRB
	JRST	CLSRB4		;AND GO UPDATE DATE/TIME
CLSSIM:	PUSHJ	P,DOWNIF##	;LADT WRITER - GIVE UP DA
>	;END FTDSIM
	MOVE	T1,P1		;AOBJN WORD FOR POINTERS
CLSLUP:	HRRZ	T4,DEVACC##(F)	;LOC OF ACC
	MOVE	T3,ACCWRT##(T4)	;HIGHEST WRITTEN BLOCK OF FILE
IFN FTDMRB,<			;IF MULTIPLE RIBS
	MOVE	T4,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T4) ;GET FIRST BLOCK NUMBER IN RIB
	SKIPL	DEVRIB##(F)	;EXTENDED RIB?
>				;END CONDITIONAL ON FTDMRB
	SETZ	T2,		;NO, ZERO STARTING BLOCK IN CASE OLD FILE
	PUSHJ	P,SCNPTR##	;GET THE POINTER FOR THIS BLOCK
	  JRST	CLSO2A		;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
IFN FTDMRB,<
	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
CLSOU3:	AOBJP	P1,CLSO3A	;STEP TO NEXT POINTER SLOT
	SKIPE	T2,(P1)		;IS THERE ONE?
	JRST	CLSOU6		;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,CLSOU4	;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	CLSOU4		;CANT GET IT THERE - TRY ANYWHERE
IFN FTDSIM,<
	PUSHJ	P,DOWNIF##	;TAKBLK KEEPS DA IF SIM. UPD.
>
	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
CLSO2A:
IFN FTDMRB,<			;IF MULTIPLE RIBS
	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	CLSO2B		;EITHER ERROR OR NONE
	PUSHJ	P,SPTRW##	;PUT AOBJN WORD TO POINTERS IN T1
	JRST	CLSLUP		;GO SCAN THIS RIB
CLSO2B:	JUMPN	T3,NOOUT2	;IF T3 NON-ZERO, ERROR
>				;END CONDITIONAL ON FTDMRB
	STOPCD	NOOUT2,DEBUG,NER,	;++NO EXTENDED RIB
;HERE WHEN POINTERS RAN OUT, WE KNOW THERE IS ONE MORE BLOCK IN THE LAST POINTER
CLSO3A:	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
CLSOU4:	AOBJP	P1,CLSFUL	;STEP TO NEXT POINTER SLOT
	PUSHJ	P,SUPDA##
CLSO4A:	HRRM	P1,DEVRET##(F)	;SAVE LOC OF NEW POINTER (IN MON BUF)
	SKIPLE	UNITAL##(U)	;UNIT HAVE ANY SPACE LEFT?
	JRST	CLSOU5		;YES
	PUSHJ	P,NEXTUN##	;NO. STEP TO NEXT UNIT
	  JRST	CLSO4B		;NO UNIT IN STR HAS SPACE!
	AOBJN	P1,CLSO4A	;FOUND. STEP TO NEXT PNTR LOC IF ROOM IN RIB
	SETZM	@DEVRET##(F)	;NO ROOM IN RIB - ZERO UNIT-CHANGE
	PUSHJ	P,LSTUNI	;RESET U TO LAST UNIT IN RIB
				;AND FALL INTO CLSFUL
CLSO4B:	PUSHJ	P,DWNDA##


;HERE WHEN THERE IS NO SPACE IN STR, OR ALL POINTER SLOTS ARE TAKEN
CLSFUL:	TRO	S,IOBKTL	;LIGHT ERROR BIT
	HRRZ	T1,DEVACC##(F)	;LOC OF ACC
	SOSGE	ACCWRT##(T1)	;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
	JRST	CLSRB2		;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
CLSOU5:	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)
CLSOU6:	PUSHJ	P,CNVPTR##	;CONVERT POINTER TO COUNT, ADDRESS
	  JRST	NOOUT2		;BAD UNIT-CHANGE PNTR
	  JRST	CLSOU3		;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
CLSRB2:
IFN FTDMRB,<			;IF MULTIPLE RIBS
	MOVE	T1,DEVRIB##(F)	;GET DEVRIB INTO T1 IN CASE NOT GO TO UPDGIV
>
	TRNE	M,CLSDLL	;DELETE UNWRITTEN BLOCKS FROM FILE?
	JRST	CLSR2A		;NO
IFN FTDMRB,<			;IF MULTIPLE RIBS
	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
IFN FTDMRB,<			;IF MULTIPLE RIBS
	POP	P,T1		;RESTORE PREVIOUS CURRENT RIB TO T1
>
CLSR2A:
IFN FTDMRB,<
	SKIPL	DEVRIB##(F)	;SKIP IF NOT IN PRIME RIB
	JRST	CLSRB3		;PRIME RIB, GO WRITE REDUNDANT
	CAME	T1,DEVRIB##(F)	;ARE WE STILL IN THE SAME EXTENDED RIB?
	JRST	CLSR2C		;NO, GET PRIME
	PUSHJ	P,WRTRIB##	;WRITE OUT THE CURRENT RIB
CLSR2C:	PUSHJ	P,REDRIB##	;GET THE PRIME RIB INTO CORE
	  JRST	NOOUT2		;ERROR READING RIB
>				;END CONDITIONAL ON FTDMRB

CLSRB3:	HLRZ	T1,DEVEXT(F)	;EXTENSION OF FILE
IFN	FTSFD,<
	CAIN	T1,(SIXBIT .SFD.) ;AN SFD?
	TLOA	M,400000	;YES, LIGHT SIGN BIT, DON'T CHANGE UFB
>
	CAIE	T1,(SIXBIT .UFD.) ;A UFD?
	JRST	CLSRB4		;NO
	TLO	M,400000	;INDICATE FILE IS A DIRECTORY
	PUSHJ	P,FNDUFB	;YES. FIND UFB FOR FILE
	  JRST	CLSRB4		;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
CLSRB4:	MOVE	T1,DEVMBF##(F)	;IOWD FOR MON BUF
	HRRZ	P1,DEVACC##(F)	;LOC OF A.T.
	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,CLSRB5	;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
CLSRB5:	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	CLSR5A		;NOT PRE-ALLOCATING OR WRITTEN
	IORM	T2,RIBSTS##+1(T1)  ;PRE-ALLOCATED, LIGHT BIT
	JRST	CLSR5B
CLSR5A:	MOVEM	T3,DEVPAL##(F)	;ENSURE DEPPAL=0
	ANDCAM	T2,RIBSTS+1(T1)  ; AND THE BIT IS OFF
CLSR5B:	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	CLSRB6		;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	CLSR6A		;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)
CLSRB6:	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
CLSR6A:	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
IFN FTDBBK,<
	MOVE	T1,DEVMBF##(F)	;GET IOWD TO MONBUF
	PUSHJ	P,TSTBAD	;SET RIBELB, ETC IF ERROR
>
	HLRZ	P3,DEVUNI##(F)	;SAVE FIRST UNIT IN P3 FOR LATER CALL TO SETCFP
ALLPT0:
IFN FTDSIM,<
	TLNE	S,IOSDA		;IF HAVE DA MUST BE SIM UPDATE
	JRST	ALLP0D		;SO JUST REWRITE PRIME RIB (WITH NEW DATES)
>
IFN FTDMRB,<			;IF MULTIPLE RIBS
	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	ALLP0A		;GO WRITE REDUNDANT RIB NEXT TO REAL
	PUSHJ	P,SCNPT0##	;SCAN THE RIB FOR THE BLOCK IN T3
	  JRST	ALLP0B		;NOT FOUND, MUST BE A FULL RIB
	SETZM	DEVREL##(F)	;FLAG THAT NEXT RIB(IF ANY) IS INACTIVE
	JRST	ALLP0C		;GO WRITE REDUNDANT
	;STILL IN FTDMRB CONDITONAL
;HERE WHEN WORKING IN AN INACTIVE RIB (BLOCKS ALLOCATED BUT NOT USED)
ALLP0A:	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	ALLP0C		;GO WRITE THE RIB
;HERE TO WRITE THE REDUNDANT RIB IN THE LAST BLOCK OF THE RIB
ALLP0B:	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
>	;END CONDITIONAL ON FTDMRB
;HERE TO WRITE RIB IN CORE REDUNDANTLY IN BLOCK NUMBER CONTAINED IN DEVBLK
ALLP0C:	MOVE	T1,DEVMBF##(F)	;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,MONWRT##	;WRITE REDUNDANT RIB
ALLP0D:	PUSHJ	P,WRTRIB##	;WRITE REAL RIB
	PUSHJ	P,RIBSAT	;WRITE SATS WHICH HAVE CHANGED
IFN FTDMRB,<			;IF MULTIPLE RIBS
	MOVE	T1,DEVMBF##(F)	;IOWD TO MONITOR BUFFER
	PUSH	P,RIBXRA##+1(T1)	;GET POINTER TO NEXT RIB (IF ANY)
	SKIPGE	DEVRIB##(F)	;PRIME RIB?
	JRST	ALLP3A		;NO, DON'T DO ANYTHING ABOUT BAT BLOCKS
	SKIPE	RIBFLR##+1(T1)	;SKIP IF EXTENDABLE RIB
	SETZM	(P)		;NOT EXTENDABLE, RIBFLR IS GARBAGE
>				;END CONDITIONAL ON FTDMRB
IFN FTDBBK,<
	PUSHJ	P,ERRFIN	;YES, WRITE BAT BLOCK IF ERRORS
>
IFN FTDMRB,<			;IF MULTIPLE RIBS
ALLP3A:	POP	P,DEVRIB##(F)	;GET POINTER FROM PREVIOUS RIB
	SKIPN	DEVRIB##(F)	;ANY MORE RIBS?
	JRST	ALLPTR		;NO, THROUGH
	PUSHJ	P,RIBCUR##	;READ THE NEXT RIB
	JUMPN	T3,NOOUT2	;IF T3 NON-ZREO, RIB ERROR
	JRST	ALLPT0		;TAKE CARE OF THE EXTENDED RIB
>	;END CONDITIONAL ON FTDMRB

;HERE WHEN WE ARE FINISHED CLEANING UP SATS AND RIBS
ALLPTR:
IFN FTDSIM,<
	TLNN	S,IOSDA		;SIM UPDATE?
	JRST	CLSRB7		;NO, CHANGE DIRECTORY
	PUSHJ	P,DWNDA##	;YES, GIVE UP DA SINCE RIB NOW WRITTEN
	JRST	CLRSTS		;AND FINISH THE CLOSE
>

;NOW CHANGE THE DIRECTORY
CLSRB7:	PUSHJ	P,GETNMB	;GET LOC OF NMB,A.T.
	MOVE	P1,T1		;P1=LOC OF NMB
IFN FTSTR,<	;IF MORE THAN ONE STR
	LDB	T1,ACYFSN##	;FSN
>
	PUSHJ	P,FSNPS2##	;POSITION A BIT FOR NMBYES
	ORM	T2,NMBYES##(P1)	;INDICATE FILE EXISTS IN STR (ANOTHER JOB MIGHT
				; HAVE DELETED ORIGINAL AFTER JOB WENT THROUGH FNDFIL)
	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
IFN FTDRDR,<
	MOVE	T4,PPBNAM##(T3)	;NEW PRJ,PRG NUMBER
	CAME	T4,DEVPPN(F)	;SAME AS OLD?
	JRST	NOTOL1		;NO. CREATE FILE IN NEW DIR.
>
IFN	FTSFD,<
	TLNN	F,RENMB		;IF A RENAME WAS DONE,
	JRST	CLSRB8
	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
CLSRB8:>
	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
	HLRZ	T1,ACCNMB##(T1)	;STEP TO NEXT IN A.T. RING
	TRZN	T1,DIFNAL##	;IS IT A NAME BLOCK?
	JRST	.-2		;NO. TRY NEXT IN RING
;HERE WITH T1=LOC OF NMB FOR THE FILE
	MOVE	T2,NMBNAM##(T1)	;(NEW) FILE NAME
	MOVEM	T2,UFDNAM##(T3)	;SAVE IN DIRECTORY
	PUSHJ	P,GTNMX		;GET EXT FROM NMB BLOCK
	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
	HRRM	T1,NMBCFP##(T2)	;SAVE CFP IN NMB
IFN FTSTR,<	;IF MORE THAN ONE STR
	HRRZ	T1,DEVACC##(F)	;LOC OF ACC
	LDB	T1,ACZFSN##	;FSN OF THIS FILE
	DPB	T1,NMYFSN##	;SAVE IN THE NMB
>	;END CONDITIONAL ON FTSTR
	MOVE	T1,DEVMBF##(F)	;IOWD FOR THE MON BUF
	MOVE	T2,DEVBLK##(F)	;ADR. OF THE DIRECTORY BLOCK
	PUSHJ	P,WRTUFD	;GO WRITE THE UPDATED DIRECTORY BLOCK
	PUSHJ	P,DWNAU##	;GIVE UP AU RESOURCE
	HRRZ	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCSTS##(T1)	;STATUS
	TRNE	T1,ACPSUP	;SUPERSEDER?
	JRST	ALLPT4		;YES. REMOVE OLD FILE
	POP	P,T1		;NO. REMOVE JUNK FROM PD LIST
	JRST	CLRSTS		;AND FINISH UP
ALLPT4:	HRRZ	T1,P1		;CFP FOR THE OLD FILE
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
ALLPT5:	CBDBUG	(N,Y);

IFN FTSTR,<	;IF MORE THAN ONE STR
	LDB	P1,ACYFSN##	;STR NUMBER
>
	PUSHJ	P,CFP2BK##	;CONVERT TO BLOCK ADR
	  JRST	ALLPT6		;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,ALLPT6	;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:	SKIPE	ACCDOR##(T2)	;%FILE DORMANT?
	JRST	CLSDEL		;%YES. DELETE A.T., FILE
	TRNE	T3,ACPDEL	;MARKED FOR DELETION?
	JRST	DELTST		;YES, IGNORE IT AND LOOK FOR ANOTHER
	MOVEI	T1,ACPDEL##+ACPNIU ;%NO. 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:	TLO	S,IOSALC	;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
	HRRZ	T1,DEVACC##(F)	;GET BACK A.T. LOC
	MOVNI	T2,ACPCNT##
	SKIPE	T1		;IF WE BUMPED READ-COUNT,
	ADDM	T2,ACCCNT##(T1)	; COUNT IT BACK DOWN
	TLZA	S,IOSALC	;ZERO IOSALC
ALLPT6:	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:
IFN FTDRDR,<
	TRZA	M,-1		;NO OLD DIR
NOTOL1:	HRRI	M,CHNDIR	;INDICATE DELETE NAME FOM OLD 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
NOTO1A:	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
IFN FTDUFC,<			;IF KEEP FILES IN ORDER IN UFO
	PUSHJ	P,UFORSS##	;GET UFB OR SFD A.T. LOC
IFN	FTSFD,<
	TRZE	T3,NMPSFU##	;AN SFD?
	SKIPA	P2,ACCWRT##(T3)	;YES, GET SIZE FROM ACCWRT
>
	LDB	P2,UFYWRT##	;NO OF DATA BLOCKS IN DIRECTORY
	JUMPN	P2,NOTO3A	;GO IF NOT EMPTY
	AOS	DEVBLK##(F)	;ZERO UFD, SET TO WRITE 1ST BLOCK
	JRST	UFDNXT		;SET UP TO WRITE IT
NOTO3A:	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,DEVMBF##(F)	;IOWD FOR DATA
	PUSHJ	P,MONRED##	;READ THE DIRECTORY BLOCK
	JUMPN	T3,UFDNXT	;LEAVE DATA BLOCK ALONE IF ERROR READING
>	;END CONDITIONAL ON FTDUFC

IFE FTDUFC,<

	TDZA	P2,P2
SCNFRE:	TLZ	S,IOSFIR	;NOT 1ST BLOCK IN PTR
	PUSHJ	P,DIRRED##	;READ NEXT UFD BLOCK
	  JRST	UFDNXT		;NO SPACE - ALLOCATE ANOTHER BLOCK
	JUMPN	T3,UFDNXT	;LEAVE DATA BLOCK ALONE IF ERROR READING
	HRRZ	T1,DEVMBF##(F)	;LOC OF MON BUF (-1)
>
	SKIPN	BLKSIZ##-1(T1)	;IS IT FULL?
	AOJA	T1,FNDFRE	;NO - GO FIND FIRST EMPTY SLOT
IFE FTDUFC,<
	AOJA	P2,SCNFRE	;NO, READ NEXT BLOCK
>
;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
UFDNX1:	PUSHJ	P,UFORSS##	;GET LOC OF UFB OR SFD AT
	EXCH	P2,T2		;LOC INTO P2, T2 HAS HIGHEST DATA BLOCK
	SETZ	P1,		;AS SOME ONLY 1 POINTER
	HRRZ	T1,DEVMBF##(F)	;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
IFN FTDUFC,<
	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
	PUSHJ	P,UFDCRD	;READ THE RIB AGAIN
	  JRST	BADUF0		;ERROR
>
	PUSHJ	P,SPTRW##	;SET AN AOBJN WORD FOR THE RIB PNTRS
	SKIPE	(T1)		;EMPTY POINTER SLOT?
	AOBJN	T1,.-1		;NO. TRY NEXT
	MOVE	P1,T1		;SAVE IN P1
	SUBI	T1,1		;POINT TO LAST POINTER
	HRRM	T1,DEVRET##(F)	;SAVE LOC OF LAST POINTER IN DEVRET
	TLO	S,IOSALC	;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
IFN	FTSFD,<
	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
	JRST	UFDAL9		;AND CONTINUE
;HERE WHEN WE HAVE TO GET A NEW POINTER FOR THE EXTRA BLOCK IN THE UFD
UFDAL2:	JUMPG	P1,UFDFUL	;NO POINTER SLOTS AVAILABLE IF P1 POSITIVE
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.)
IFN	FTSFD,<
	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
IFN	FTSFD,<
	TRNN	P2,NMPSFU##	;IS IT A UFD
>
	CAME	T1,MFDPPN##	;YES, IS IT [1,1]?
	JRST	UFDAL9		;NO
IFN FTSTR,<	;IF MORE THAN ONE STR
	LDB	T1,UFYFSN##	;YES, GET STR INDEX
	MOVE	T1,TABSTR##(T1)	;STR DB LOC
>	;END CONDITIONAL ON FTSTR
IFE FTSTR,<	;IF ONLY ONE STR
	MOVE	T1,TABSTR##	;GET ADDR OF STR DATA BLOCK
>
	ANDCAM	P1,STRUN1##(T1)	;INDICATE MORE THAN 1 PTR IN MFD
UFDAL9:	LDB	T3,UNYBPC##	;DONT COUNT BLOCKS ADDED TO UFD
	IFN	FTSFD,<
	TRNN	P2,NMPSFU##
>
	ADDM	T3,UFBTAL##(P2)	; AS PART OF THIS JOBS QUOTA
	TLZ	S,IOSALC
	MOVE	T1,DEVMBF##(F)
	ADDM	T3,RIBALC##+1(T1)  ;UPDATE NO OF BLOCKS ALLOCATED
UFDNX2:
IFN	FTSFD,<
	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,SCNPT0##	;FIND POINTER FOR THE BLOCK
				; (STORE LOC OF 2ND RIB IN DEVBLK)
	  STOPCD .,JOB,SPM,	;++SECOND POINTER MISSING
IFN	FTSFD,<
	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:IFN	FTSFD,<
	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,DEVMBF##(F)	;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
	HRRM	U,DEVUNI##(F)	;SAVE IN DDB
	PUSHJ	P,MONWRT##	;WRITE 2ND RIB
	TLNN	U,-1		;IS THERE A DIFFERENT UNIT FOR THE DATA?
	JRST	UFDALC		;NO
	HLRZS	U		;YES, SET U TO DATA BLOCK UNIT
	HRRM	U,DEVUNI##(F)	;AND SAVE IN DDB
UFDALC:	HRRZ	T3,DEVUFB##(F)	;LOC OF UFB
IFN	FTSFD,<
	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,DEVMBF##(F)	;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
	HRRZ	P1,DEVACC##(F)	;LOC OF A.T.
	HLRZ	P1,ACCNMB##(P1)	;STEP TO NEXT IN NMB RING
	TRZN	P1,DIFNAL##	;NAME BLOCK?
	JRST	.-2		;NO. TRY NEXT
	MOVE	T3,NMBNAM##(P1)	;YES. (NEW) NAME
	MOVEM	T3,UFDNAM##(T1)	;SAVE IN UFD BLOCK
	EXCH	P1,T1		;SAVE T1, NMB LOC INTO T1
	PUSHJ	P,GTNMX		;GET EXTENSION FROM NMB
	EXCH	P1,T1		;RESTORE T1
	HLLM	T4,UFDEXT##(T1)	;SAVE EXT IN UFD BLOCK
	HRLM	T1,P1		;SAVE LOC OF UFD SLOT
	PUSHJ	P,SETCFP##	;GET CFP FROM P2, ACCPT1
	HRRM	T1,NMBCFP##(P1)	;SAVE CFP IN NMB
	MOVSS	P1		;UFD SLOT LOCATION
	HRRM	T1,UFDCFP##(P1)	;SAVE CFP IN UFD
	HLRZ	T2,P1		;NMB LOC
	MOVE	P2,DEVACC##(F)	;A.T. LOC
IFN FTSTR,<	;IF MORE THAN ONE STR
	MOVE	T1,P2
	LDB	T1,ACZFSN##	;GET FSN
	PUSH	P,T1		;SAVE ON PD LIST
	DPB	T1,NMYFSN##
>	;END CONDITIONAL ON FTSTR
	MOVE	T2,DEVBLK##(F)	;UFD BLOCK NUMBER
	MOVE	T1,DEVMBF##(F)	;IOWD FOR MON BUF
	MOVE	P3,ACCPPB##(P2)	;LOC OF (NEW) PPB
	MOVE	P3,PPBNAM##(P3)	;(NEW)PROJ,R
	PUSHJ	P,WRTUFD	;WRITE THE NEW DIRECTORY BLOCK
	HRRZ	P2,DEVUFB##(F)	;SAVE LOC OF UFB
	SETZ	P4,		;INDICATE NO EXTRA DDB
IFN FTDRDR,<
	TRNN	M,CHNDIR	;CHANGING DIRECTORIES?
	JRST	FNDFR1		;NO
;STILL IN FTDRDR CONDITIONAL
;HERE WHEN CHANGING DIRECTORIES - DELETE THE FILE FROM THE OLD DIR
IFN	FTSFD,<
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNT OF NEW SFD
	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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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
	PUSHJ	P,GVMNB0##	;GIVE UP MONITOR BUFFER(FNDFIL NEEDS IT)
	TLZ	M,UUOMSK	;WIPE BITS OUT OF LH(UUO)
	TLO	M,UUOLUK	;MAKE BELIEVE THIS IS A LOOKUP
IFN FTSTR,<	;IF MORE THAN ONE STR
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  STOPCD FNDFR1,DEBUG,SLM,	;++SEARCH LIST MISSING
	MOVE	T2,T1		;SEARCH LIST INTO T2
>	;END CONDITIONAL ON FTSTR
	PUSHJ	P,FNDFIL##	;SET UP UFB BLOCK
	  JFCL			;FNDFIL GETS A RIB ERROR ON LOOKUP(WRONG RIBPPN)
	SKIPN	DEVMBF##(F)	;IF FNDFIL DIDN'T GET MON BUF,
	PUSHJ	P,GTMNBF##	;GET MON BUF AGAIN
	JRST	FNDFRB		;AND CONTINUE
FNDFR0:
	PUSHJ	P,GVCBJ##
	PUSH	P,T2		;SAVE OLD UFB LOC
	MOVE	P4,F		;SAVE DDB LOC
	PUSHJ	P,FAKDDB	;GET AN EXTRA DDB
	  SETZ	F,		;NONE AVAILABLE
	EXCH	F,P4		;RESTORE F,SAVE EXTRA DDB LOC
				;SAVE DEVUFB IN EXTRA DDB SO
	SKIPE	P4		; TSTPPB WONT DELETE THE PPB IN CASE
	MOVEM	P2,DEVUFB##(P4)	; RENAMING INTO A NOT LOGGED-IN PPB
	MOVE	S,DEVIOS(F)	;RESTORE S (WITH IOSAV ON)
	POP	P,DEVUFB##(F)	;SAVE LOC OF OLD UFB IN DDB
	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
>	;END CONDITIONAL ON FTDRDR
FNDFR1:	  PUSHJ	P,DWNAU##	;NOT THERE - RELEASE AU
	HRRM	P2,DEVUFB##(F)	;RESTORE NEW UFB LOC
	JUMPE	P4,FNDFRC	;WAS THERE AN EXTRA DDB?
	EXCH	P4,F		;YES--RENAMING, DDB WAS INSURANCE
	PUSHJ	P,CLRDDB	; AGAINST TSTPPB.  GIVE UP DDB
	MOVE	F,P4
FNDFRC:
	MOVEM	P3,DEVPPN(F)	;AND PRJ-PRG (NEEDED BY LOGTST
				;IF RENAMING INTO NEW DIR)
	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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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:
IFN FTSTR,<	;IF MORE THAN ONE STR
	POP	P,T1		;REMOVE FSN FROM PD LIST
	LDB	T1,DEYFSN##	;FSN OF FILE BEING SUPERSEDED
	JUMPE	T1,CLRSTS	;NONE IF 0
	SLCKFS	(T1)		;CHECK FOR 0 FSN


;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.
	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	ALLPT5		;GO DELETE OLD FILE
>	;END CONDITIONAL ON FTSTR

IFE FTSTR,<	;IF ONLY ONE STR
	JRST	CLRSTS
>
;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:
IFN FT5UUO,<
	MOVE	P1,DEVJOB(F)	;JUST UPDATE RIB?
	TLNN	P1,DEPFFA
	JRST	CLRSTB		;NO, CHARGE AHEAD
	HRRZ	T3,DEVACC(F)	;COPY A.T. ADDRESS
	JUMPE	T3,CLRSTB	;GET OUT IF NO AT (RIB ERR)
	PUSHJ	P,AT2DDB	; UPDATE DDB SO WE
	  JFCL			; DO NOT WIPE UFD
	TLZ	F,ICLOSB+OCLOSB	;UNDO CLOSE
	TLO	F,ENTRB+LOOKB	;..
	SKIPE	T1,DEVMBF##(F)
	PUSHJ	P,GVMNBF	;RETURN MON BUF
	HRRZ	T2,DEVACC##(F)	;GET A.T. ADDRESS
	PUSHJ	P,GETCB##	;INTERLOCK
	LDB	T1,ACYSTS##	;STATUS
	CAIN	T1,ACRUPD##	;ALREADY IN UPDATE MODE?
	JRST	CLRSTA
	MOVEI	T1,ACRUPD##	;NO, MAKE IT UPDATE
	DPB	T1,ACYSTS##
IFN FTDSIM,<
	MOVEI	T1,1
	DPB	T1,ACZWCT##	;IT HAS 1 WRITER
>
CLRSTA:	PUSHJ	P,GVCBJ##	;RETURN CB
	MOVEI	T1,ACPCNT	;IF READ COUNT NOT UP
	TLON	S,IOSRDC	; LIGHT THE BIT
	ADDM	T1,ACCCNT##(T2)	; AND BUMP READ-COUNT
	MOVEM	S,DEVIOS(F)
	HRR	M,ACCWRT(T2)	;SIZE OF FILE
	HRRI	M,1(M)		;EOF
	PUSHJ	P,USETO0##	;UPDATE POINTERS
IFN FTDSIM,<
	MOVEI	T1,ACPSMU
	TLNE	P1,DEPSIM	;SIM UPDATE?
	IORM	T1,ACCSTS##(T2)	;YES - LIGHT BIT
>
	JRST	STOIOS		;DONE
CLRSTB:>	;END FT5UUO
	CBDBUG	(N,Y);
IFN FTGALAXY&FTSPL,<
	SKIPGE	DEVSPL(F)	;SPOOLED FILE?
	PUSHJ	P,QSRSPL##	;YES, TELL HIM
>
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
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
	SKIPN	T1		;IS THE A.T. THERE ?
	SETZM	DEVUNI##(F)	;NO, ZERO DEVUNI
	JUMPE	T1,CLRST1	; AND LEAVE
	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
IFN	FTSFD,<
	PUSHJ	P,GETNMB	;GET THE NMB
	EXCH	T1,T2		;T1=LOC OF AT, T2=NMB
	LDB	J,PJOBN##	;JOB NUMBER
	HRRZ	T3,JBTSFD##(J)	;DEFAULT DIRECTORY
	TRZ	T3,CORXTR##
	CAMN	T2,T3		;IS THIS FILE FOR THE DEFAULT?
	PUSHJ	P,INCONE	;YES, INCREMENT THE USE-COUNT
				; (SO USE CNT WILL STAY UP AFTER DECUSA)
	PUSHJ	P,DECUSA	;DECREMENT USE-COUNTS FOR SFD
>
	HRRZ	T1,DEVACC##(F)	;RESET T1 TO LOC OF A.T.
	PUSHJ	P,GETCB##
	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
IFE FTDSIM,<
	MOVEI	T2,ACPCRE+ACPREN+ACPSUP+ACPUPD+ACPPAL##
>
IFN FTDSIM,<
	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
>
	ANDCAB	T2,ACCSTS##(T1)	;%CLEAR THE STATE CODE
	MOVEI	T3,ACPPAL##
	MOVE	T4,DEVPAL##	;%IF PRE-ALLOCATED,
	TRZE	T4,DEPPAL
	IORM	T3,ACCPAL##(T1)	; LIGHT BIT IN A/T/
	MOVEM	T4,DEVPAL##(F)	; AND CLEAR THE DDB BIT
	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	GVMNB0##,DEBUG,FAD,	;%++FILE ALREADY DORMANT
	PUSHJ	P,ATSDRA##	;%NO. MAKE IT DORMANT NOW
CLRST1:	PUSHJ	P,GVMNB0##	;GIVE UP MONITOR BUFFER
	PJRST	TSTPPB		;TEST IF PPB LOGGED IN, EXIT

;HERE ON A WIERD TIMING PROBLEM
CLRST3:	PUSHJ	P,GVCBJ##
	HRRM	U,DEVUNI##(F)
	HRLM	U,DEVUNI##(F)	;SAVE U IN DDB
	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,GVMNB0##	;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
	PJRST	GVMNB0##	;GIVE UP MON-BUF AND RETURN
;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
LOGTST:	MOVE	T1,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCPPB##(T1)	;LOC OF PPB
	MOVE	T1,PPBNLG##(T1)	;LOGGED-IN WORD
	TLNE	S,IOSWLK	;DON'T WRITE IF STR IS WRITE-LOCKED
	POPJ	P,		;YES. RETURN
	TRNN	T1,PPPNLG##	;IS USER LOGGED IN ?
	JRST	LOGTS1		;NO, WRITE RIB
	LDB	J,PJOBN##	;YES, GET JOB NUMBER
	PUSHJ	P,SLPTR##	;AND FIND JOB'S SEARCH LIST
	  JRST	LOGTS1		;NO SEARCH LIST; WRIT RIB
	MOVE	T1,DEVACC##(F)	;GET LOC OF A.T.
	LDB	T1,COZFSN##	;GET F.S. NUMBER
	PUSHJ	P,SLFND##	;IS IT IN S.L. ?
	  CAIA			;NO, WRITE RIB
	POPJ	P,		;YES, RETURN
LOGTS1:	PUSHJ	P,UPAU##	;NO. GET AU RESOURCE
LOGTS2:	PUSHJ	P,SAVE1##
	MOVE	P1,DEVUFB##(F)	;LOC OF UFB
	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,RIBQTF##+1(T1)	;LOGGED-IN QUOTA
	SUB	T3,UFBTAL##(P1)	;- AMOUNT LEFT IN QUOTA
	MOVEM	T3,RIBUSD##+1(T1)	;=AMOUNT USED
	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(DEVMBF), U=UNIT
;LIGHTS RIGHT BIT IN LH(RIBUNI) FOR THIS UNIT
;EXIT T1=C(DEVMBF)
ORINUN:	MOVSI	T2,1		;BIT FOR DRIVE 0
	LDB	T3,UNYPUN##	;DRIVE NUMBER
	LSH	T2,(T3)		;POSITION BIT
	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
IFE	FTSFD,<
	MOVE	T2,NMBEXT##(T4)	;NEW EXTENSION
>
IFN	FTSFD,<
	MOVE	T2,NMBSFD##(T4)
	TRNN	T2,NMPSFD##	;IS FILE AN SFD?
	SKIPA	T2,NMBEXT##(T4)	;NO, GET REAL EXTENSION
	MOVSI	T2,(SIXBIT .SFD.) ;YES, EXT = 'SFD'
>
	HLLM	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
IFN FTDUFC,<			;IF KEEPING FILES IN ORDER
;SUBROUTINE TO COMPRESS THE UFD INTO AS FEW BLOCKS AS POSSIBLE
;*****NOTE THAT THIS ROUTINE REQUIRES 2 MONITOR BUFFERS
;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,DEVMBF##(F)	;LOC OF MON-BUF
	MOVEI	T2,RIPCMP##	;UFD IS BEING COMPRESSED,
	IORM	T2,RIBSTS##+1(T1); SO LIGHT A BIT IN THE STATUS WORD
	MOVE	T2,RIBSLF##+1(T1); (UFD CAN GET ZAPPED IF SYSTEM CRASHES
	PUSHJ	P,MONWRT##	; WHILE A UFD IS BEING COMPRESSED)
UFDCM1:	MOVE	P1,DEVMBF##(F)	;SAVE BUF LOC IN P1
	MOVEM	P1,DEVMBF##(P3)	;AND IN EXTRA DDB (IN CASE NO HOLES)
	SKIPGE	MQREQ##		;SECOND MON BUF AVAILABLE?
	JRST	UFDCM2		;YES
	TLNE	S,IOSAU		;NO. JOB HAVE AU RESOURCE?
	PUSHJ	P,DWNAU##	;YES. GIVE IT UP (ELSE CAN GET INTO SCHEDULING BIND-
				;ANOTHER JOB COULD HAVE MQ, BE WAITING FOR AU)
	AOSG	MQ2WAT##	;ANOTHER JOB WAITING FOR 2 MON BUFS?
	JRST	UFDCM2		;NO
	PUSHJ	P,GVMNB0##	;YES - GIVE UP MON BUF (HE HAS 1, WONT RELEASE IT)
	PUSHJ	P,GTMNBF##	;WAIT FOR MON BUF TO BECOME AVAILABLE AGAIN
	JRST	UFDCM1		;GO TRY FOR 2ND MON BUF AGAIN
UFDCM2:	PUSHJ	P,GTMNB0##	;GET SECOND MON-BUF
	SETOM	MQ2WAT##	;INDICATE NO JOB WAITING FOR 2 MON BUFS
	TLNN	S,IOSAU		;DID WE GIVE UP AU RESOURCE?
	PUSHJ	P,UPAU##	;YES, GET IT AGAIN
	MOVE	P2,DEVMBF##(F)	;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	UFDCMB		;NO HOLES IN UFD AT ALL
	TRNE	S,IOIMPM!IODERR!IODTER!IOBKTL  ;ANY READ ERRORS?
	JRST	UFDCMC		;YES, DON'T COMPRESS
	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,DEVMBF##(F)	;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


UFDCM5:	PUSHJ	P,DIRRED##	;READ INTO P1-BUFFER
	  JRST	UFDCM9		;EOF - FINISH UP
	MOVE	P1,DEVMBF##(F)	;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

;HERE WITH P2-BUFFER FULL, WRITE IT
UFDCM8:	PUSHJ	P,DIRWRT	;WRITE THE UFD BLOCK
	MOVE	P4,DEVMBF##(P3)	;POINTER TO THE BUFFER
	AOJA	P4,UFDCM7	;GO FILL IT AGAIN
;STILL IN FTDUFC CONDITIONAL
;HERE WHEN THE UFD HAS BEEN COMPLETELY READ
UFDCM9:	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)
	PUSHJ	P,DIRWRT	;WRITE THE LAST UFD DATA BLOCK
	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.)
IFN	FTSFD,<
	MOVE	P2,DEVPPN(F)	;IN CASE IT IS H OR SFD
	TRZE	T2,NMPSFU##	;SFD?
	JRST	UFDCMA		;YES, JUST UPDATE ACCWRT
>
	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
	MOVEI	T3,RIPCMP##	;OUT OF COMPRESSOR, SO CLEAR THE STATUS BIT
	ANDCAM	T3,RIBSTS##+1(T1)
	PUSHJ	P,MONWRT##	;AND GO REWRITE THE RIB
;STILL IN FTDUFC CONDITIONAL
UFDCMC:	EXCH	P3,F		;SET F=L(EXTRA DDB)
	PUSHJ	P,GVMNB0##	;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
	HRRM	U,DEVUNI##(F)	;SAVE UNIT TO WRITE THE BLOCK
	POPJ	P,		;AND TAKE NON-SKIP RETURN

;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
>	;END CONDITIONAL ON FTDUFC
;RELEASE UUO
DSKREL:	PUSHJ	P,WAIT1##	;WAIT FOR I/O TO STOP
	MOVE	J,JOB##		;SET J FOR RETRES
IFN FTDSEK,<
	MOVEI	T1,2
	LDB	T2,DEYCOD##	;IF DDB IS SEEKING
	CAIE	T2,SCOD##	; WAIT1 WANT NOTICE IT,
	CAIN	T2,SWCOD##
	PUSHJ	P,SLEEP##	;SO WAIT FOR A WHILE
>
	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,CLOSIN	;CLOSE INPUT (IF NOT ALREADY DONE)
	PUSHJ	P,CLOSOU	;CLOSE OUTPUT (DITTO)
IFN FTDBBK,<
IFN FTDSUP,<			;SUPER USETI/USETO
	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
	HRRZ	U,DEVUNI##(F)	;YES, WRITE BAT BLOCK SINCE CLOSE DID NOT
	JUMPE	U,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
	PUSHJ	P,GTMNBF##	;GET THE MON BUF
	PUSHJ	P,TSTBAD	;FIND EXTENT OF BAD REGION
	MOVE	T1,DEVMBF(F)	;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
	PUSHJ	P,GVMNB0##	;GIVE UP MONITOR BUFFER
>
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
IFN	FTSFD,<
	SETZM	DEVSFD##(F)	;ZERO DEVSFD SO NO SFD TO START
>
IFN FTDBBK,<
	SETZM	DEVELB##(F)	;ZERO DEVELB SO NEXT ERROR WILL GET IN BAT BLOCK
>
	TLZ	S,IOSWLK!IOSUPR!IOSRST ;ZERO SOME BITS
IFN	FTLIB,<
	PUSHJ	P,CLRLIB	;CLEAR DEPLIB
>
	MOVEI	T1,DEPPAL##	;CLEAR PRE-ALLOCATING FILE
	ANDCAM	T1,DEVPAL##(F)
	PJRST	STOIOS##	;SAVE IN DDB AND RETURN

;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
;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
	HLRZ	T3,NMBEXT##(T2)	;%EXTENSION
	CAIN	T3,(SIXBIT .UFD.)	;%IS IT "UFD"?
	JRST	UFDAC2		;%YES. OK
	HLRZ	T2,NMBPPB##(T2)	;%NO. IGNORE THE ENTRY
IFN	FTSFD,<
	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.
IFN FTSTR,<	;IF MORE THAN ONE STR
	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
TSTPPK:
	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##		;%
TSTPP0:	MOVE	T1,PPBNLG##(T2)	;%LOGGED-IN WORD
	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,TSTPP2	;%NONE IF 0
TSTPP1:	HLL	T4,CORLNK##(T4)	;%SAVE LINK TO NEXT UFB
	PUSHJ	P,UFDLK		;%IS UFD CURRENTLY IN USE?
	  JRST	TSTPP3		;%YES
	PUSHJ	P,RET4WD	;%NO, DELETE THIS UFB
	JRST	TSTPP4		;%AND CONTINUE
TSTPP3:	HRRO	T3,T4		;%THIS UFB =NEW PREDECESSOR
TSTPP4:	HLRZS	T4		;%NEXT UFB INTO T4
	JUMPN	T4,TSTPP1	;%TEST IT IF IT EXISTS
TSTPP2:	POP	P,T1		;%LOC OF PPB
	TLNE	T3,-1		;%ANY UFB BEING USED NOW?
	PJRST	GVCBJ##		;%YES. GIVE UP CB AND RETURN
	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
	MOVEI	P2,ACMUCT##	;SET FOR READ-COUNT TEST
	SKIPA	P1,T2		;%P1=LOC OF 1ST NMB
TSTPP5:	HLRZS	P1		;%NEXT NMB
IFN	FTSFD,<
	TRZE	P1,NMPUPT##	;IS IT A PNTR TO A FATHER SFD?
	JRST	TSTP6A		;YES, GO CHECK FATHER
TSTP5A:>
	JUMPE	P1,TSTPP8	;%NO NMB IN USE - DELETE PPB
	HLRZ	T1,NMBACC##(P1)	;%LOC OF 1ST A.T. IN NMB RING
TSTP5B:	TRNE	T1,DIFNAL##	;%NMB?
	JRST	TSTPP6		;%YES - THIS NMB NOT IN USE
	TDNE	P2,ACCUSE##(T1)	;%IS THE USE-COUNT 0?
	JRST	TSTPP9		;%NO, LEAVE DATA BASE ALONE
	LDB	T2,ACZFSN##	;%FSN = 'INCOMPLETE' MARKER?
	SLCKMK	(T2)
	CAIN	T2,FSNINC##
	JRST	TSTPP9		;%YES
	HLRZ	T1,ACCNMB##(T1)	;%REAL A.T. - STEP TO NEXT IN RING
	JRST	TSTP5B		;%TEST IT

;HERE IF NO A.T. IN NMB RING IS A DUMMY A.T.
TSTPP6:
IFN	FTSFD,<
	MOVE	T3,NMBSFD##(P1)	;%IS IT AN SFD?
	TRNN	T3,NMPSFD##
	JRST	TSTP6A		;%NO, CONTINUE
	HLRZ	P1,NMBNMB##(P1)	;% DOES THIS NMB POINT TO ANOTHER NAME LIST?
	TRZN	P1,NMPUPT##	;%
	JRST	TSTP5A		;%YES, TURN DOWN THAT CHAIN
>
;HERE WHEN THE NMB IS REMOVABLE
TSTP6A:	HLRZ	T1,NMBACC##(P1)	;%LOC OF 1ST A.T. ON NMB RING
	TRNE	T1,DIFNAL##	;%1-ITEM RING?
	JRST	TSTPP7		;%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,TSTP6A	;%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	TSTP6A		;%AND GO TEST NEXT AT IN THE RING
TSTPP7:
	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
IFN FTCBDB,<
	MOVE	T4,(P)		;FAKE OUT DATA-BASE CHECKER
	HLLM	P1,PPBNMB##(T4)	; BY SETTING PPBNMB TO 1ST REMAINING NMB
>
	JRST	TSTPP5		;%AND GO DELET NEXT NMB RING


;HERE IF NO DUMMY A.T.'S WERE FOUND - DELETE THE PPB
TSTPP8:	POP	P,T4		;%LOC OF PPB
	SKIPE	PPBLOK##(T4)	;%ANY INTERLOCKS SET?
	PJRST	TSTP8A		;%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
TSTP8A:	SETZM	PPBNMB##(T4)	;%DON'T LEAVE FUNNY LINKS
	SETZM	PPBUFB##(T4)	;% HANGING AROUND IN DATABASE
	PJRST	GVCBJ##
;HERE IF A DUMMY A.T. WAS ENCOUNTERED IN AN NMB RING - THERE IS A JOB IN FNDFIL
; WHICH IS REALLY USING THIS PPB, BUT HAS NOT YET SET UP DEVUFB
;NOTHING CAN BE DONE ABOUT THE UFB'S WE DELETED, BUT WE CANT DELETE THE PPB
TSTPP9:	POP	P,T1		;%LOC OF PPB
	MOVE	T2,ALLYES##	;%SINCE WE KNOW NOTHING ABOUT WHAT STATE THE
	ANDCAM	T2,PPBYES##(T1)	; OTHER JOB IS IN, PRETEND NOTHING IS KNOWN
	ANDCAM	T2,PPBKNO##(T1)	; ABOUT WHAT UFD'S EXIST FOR PPN
IFN	FTSFD,<
	MOVE	T2,P1		;%SAVE LOC OF THIS NMB
TSTP9A:	HLRZ	T2,NMBPPB##(T2)	;%SCAN NMB LIST FOR A POINTER
	JUMPE	T2,TSTP9B	;% TO AN UPWARD (FATHER) SFD NMB
	TRZN	T2,NMPUPT##	;%IF FOUND,
	JRST	TSTP9A	;%
	HRLM	P1,NMBNMB##(T2)	;%LINK THE FATHER SFD TO THE NEXT NMB
	JRST	TSTP9C		;% IN THE LOWER CHAIN
TSTP9B:>
	HRLM	P1,PPBNMB##(T1)	;%THIS IS 1ST REMAINING NMB FOR PPB
TSTP9C:	CBDBUG	(Y,Y);

	PJRST	GVCBJ##		;%RETURN WITH AS LITTLE INFORMATION DELETED AS POSSIBLE
;SUBROUTINE TO TEST IF A UFB IS CURRENTLY IN USE
;RETURNS CPOPJ IF IT IS IN USE, CPOPJ1 OTHERWISE
;ENTER WITH T4=LOC OF UFB
;RESPECTS T3
UFDLK:	SKIPA	T2,PROTO	;%SET T2 TO LOC OF PROTOTYPE AND TEST ITS LINK
UFDLK1:	CAIN	T2,(F)		;%THIS DDB THE ONE WE'RE USING?
	JRST	UFDLK2		;%YES, DON'T TEST FOR MATCH
	HRRZ	T1,DEVUFB##(T2)	;%NO, LOC OF UFB DDB IS USING
	CAIN	T1,(T4)		;%MATCH?
	POPJ	P,		;%YES. NON-SKIP RETURN
UFDLK2:	HLRZ	T2,DEVSER(T2)	;%NO. STEP TO NEXT DDB IN SYSTEM
	MOVE	T1,DEVMOD(T2)	;%DEVMOD WORD
IFN FTSPL,<
	SKIPL	DEVSPL(T2)	;SPOOLED DDB AS A DSK
>
	TLNE	T1,DVDSK	;%DEVICE A DISK?
	JUMPN	T2,UFDLK1	;%YES. TEST ITS UFB
	JRST	CPOPJ1##	;%NO MATCH - SKIP REYRN


;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
PROTO:	POPJ	P,DSKDDB##	;%AND RETURN
SUBTTL	LOOKUP

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
EXTUUO==1000	;BIT ON IN LH(UUO) IF EXTENDED UUO

;LOOKUP
ULOOK:
IFN FTNUL,<
	PUSHJ	P,NULTST	;ON DEVICE NUL,
	  PJRST	CPOPJ1##	; LOOKUP WINS
>
IFN FTSPL,<
	SKIPGE	DEVSPL(F)	;SPOOL-MODE?
	PJRST	CPOPJ1##	;YES, OK RETURN
>
	TLNE	F,ENTRB		;ENTER IN FORCE?
	JRST	LUKER1		;YES. ERROR RETURN
	TLZ	F,INPB		;MIGHT BE ON FROM SUPER I/O
	PUSHJ	P,SETLER	;NO, SET UP UUO FOR LOOKUP
	  JRST	ILNMER		;ILLEGAL NAME - ERROR RETURN
IFN FTLIB,<
	MOVSI	T2,DEPLIB##	;MAKE SURE DEPLIB IS OFF
	ANDCAM	T2,DEVLIB##(F)	; SO UPDATE WILL WIN
>
	PUSH	P,[-1,,0]	;INITIALIZE ERROR - SAVE
ULOOK1:
IFN FTSTR,<	;IF MORE THAN ONE STR
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST IN T1
	  JRST	ULOOK8		;SEARCH LIST NULL - ERROR
>	;END CONDITIONAL ON FTSTR
ULOOK2:
IFN FTSTR,<	;IF MORE THAN ONE STR
	MOVE	T2,T1		;SEARCH LIST INTO T2
>
	TLO	M,UUOLUK	;INDICATE LOOKUP
	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
IFN FTSPL,<
	SKIPGE	DEVSPL(F)	;SPOOL MODE?
	POPJ	P,		;YES, IMMEDIATE RETURN
>
	SKIPL	(P)		;ALREADY STORED FIRST ERROR?
	JRST	ULOO2A		;YES
	TLNE	F,SYSDEV	;NO, DON'T STORE IF FILE NOT FOUND NO SYS:
	SKIPE	T1		; (MIGHT BE NEW:, BETTER ERROR MSG FROM STD:)
	MOVEM	T1,(P)		;NO, SAVE ERROR ON LIST
ULOO2A:	CAILE	T1,IPPERR	;ERROR OTHER THAN NOT FOUND OR PPN?
	JRST	ULOOK8		;YES, GIVE ERROR RETURN
	PUSHJ	P,TSTPPB	;DELETE USELESS CORE BLOCKS

IFN	FTSFD,<
	HRRZ	T1,DEVSFD##(F)	;SCAN - GET LOC OF SFD
	JUMPE	T1,ULOOK4	;DONE IF 0 (JUST SEARCHED UFD)
	LDB	T2,DEYSCN##	;SCANNING SWITCH
	JUMPE	T2,ULOOK4	;DON'T SCAN IF 0
	PUSHJ	P,DECALL	;DECR. USE-COUNTS OF THIS SFD
ULOOK3:	HLRZ	T1,NMBPPB##(T1)	;SCAN FOR POINTER TO FATHER SFD
	TRZN	T1,NMPUPT##
	JUMPN	T1,ULOOK3
	HRRM	T1,DEVSFD##(F)	;FOUND - SAVE AS CURRENT SFD
	SKIPE	T1		;UFD ITSELF?
	PUSHJ	P,INCALL	;NO, INCR. USE-COUNTS OF A.T.'S
	JRST	ULOOK1		;AND RETRY THE LOOKUP IN THIS DIRECTORY
ULOOK4:
IFN	FTLIB,<
	MOVE	T1,DEVPP0##(F)	;WAS E+3=0 ON LOOKUP
	TLNE	T1,DEPPP0##
	JRST	ULOOK8		;NO, DON'T SEARCH LIB, SYS
	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	ULOOK7		;YES
	MOVE	J,JOB##		;NO, GET USER'S JOB NUMBER
	HLRZ	T1,JBTSFD##(J)	;NO, GET LIB PPB
	TRZ	T1,CORXTR##	;MAKE SURE EXTAR BITS ARE 0
	JUMPE	T1,ULOOK5	;GO IF NO LIB
	MOVE	T1,PPBNAM##(T1)	;GET LIB PPN
	CAMN	T1,DEVPPN(F)	;IS IT CURRENT PPN?
	JRST	ULOOK5		;YES, TRY SYS
	MOVEM	T1,DEVPPN(F)	;NO, SAVE NEW PPN IN DDB
	JRST	ULOOK1		;GO LOOKUP FILE IN THIS PPB
;HERE IF DSK AND LIB ARE DONE, TRY SYS:
ULOOK5:	HLRZ	T1,JBTSFD##(J)	;LIB, SYS BITS
	TRNN	T1,JBPSYS##	;USER WANT TO LOOKUP SYS:?
	JRST	ULOOKX		;NO, FILE NOT FOUND
	MOVE	T2,XSYPPN##	;YES, GET EXP-SYS PPN
	TRNE	T1,JBPXSY##	;WANT EXP-SYS?
	CAMN	T2,DEVPPN(F)	;YES, HAVE WE TRIED IT ALREADY?
	MOVE	T2,SYSPPN##	;YES, TRY REAL SYS
ULOOK6:	MOVEM	T2,DEVPPN(F)	;SAVE SYS OR NEW PPN
	MOVE	T1,DEVNAM(F)	;ARGUMENT FOR ALIASD
	PUSHJ	P,ALIASD	;IS THIS "DSK"?
	  SKIPA	T1,SYSSRC##		;YES, USE SYSTEM 'SL
	PUSHJ	P,SETSRC	;NO, GET SEARCH LIST FROM DEVICE NAME
	  JFCL
	MOVE	T2,T1		;FNDFIL WANTS T2=SEARCH LIST
	PUSHJ	P,FNDFIL##	;LOOKUP THE FILE
ULOOK7:	  SKIPA	T2,SYSPPN##	;DIDN'T FIND IT
	JRST	FOUND		;FOUND - FINISH UP
	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
	CAME	T2,DEVPPN(F)	;TRIED SYS?
	JRST	ULOOK6		;NO, TRY IT NOW
ULOOKX:	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
	SETZ	T1,		;ZERO PPN WORD ON LOOKUP FAILURE
	PUSHJ	P,PUTWDU##
	SETZM	DEVPPN(F)	;SO PATH. WILL WIN
	POP	P,M
>	;END CONDITIONAL ON FTLIB
>	;END CONDITIONAL ON FTSFD
ULOOK8:	POP	P,T1		;RESTORE ERROR CODE
	PJRST	LKENER		;AND GO TELL USER
;HERE WHEN FILE NAME IS FOUND ON LOOKUP
FOUND:
IFN	FTSFD,<
	PUSHJ	P,DECMST	;DECREMENT ALL SFD AT'S EXCEPT THE RIGHT ONE
>
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T. ENTRY
	MOVE	T3,T2		;INTO T3 ALSO
IFN FTSPL,<
	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
	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,-1(M)
	PUSHJ	P,SAVE2##	;SAVE P1, P2
	PUSHJ	P,GTWST2##	;NUMBER OF ARGUMENTS
	MOVE	P1,T1
	HRRI	M,UUXPPN(M)	;POINT TO PPN WORD
IFN FTLIB,<
	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
	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
FOUND3:	TLZ	S,IO		;INDICATE READING
	PUSHJ	P,AT2DDB##	;SET DEVREL, ETC FROM A.T. DATA
	  JRST	LKNRI2		;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:	HRRI	M,1(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,DEVMBF##(F)	;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
	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:	PUSHJ	P,CPYFST##	;COPY POINTERS TO DDB, SET DEVBLK,ETC
	  JRST	LKRIB		;RIB IS BADLY FOULED UP
;HERE WHEN LOOKUP ALL THROUGH
LKXIT:	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
	SKIPE	T1,DEVMBF##(F)	;JOB HAVE MONITOR BUFFER?
	PUSHJ	P,GVMNBF##	;YES. GIVE IT UP
	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.
	HRRI	M,-3(M)
	JRST	FOUND3		;GO GET A.T. STUFF


;HERE IF THE DATA IN THE RIB IS BADLY FOULED UP, BUT RIBCHK PASSED IT
LKNRIB:	TDZA	T1,T1		;OFFSET +1 FOR M
LKRIB:	MOVNI	T1,UUXSIZ-UUXEXT+1(P1)  ;OFFSET +1 FOR M
	ADDI	T1,-1(M)	;T1:= DESIRED ADDRESS FOR M
	HRR	M,T1		;GET DESIRED ADDRESS, PRESERVE LH
LKNRI2:	MOVEI	T1,TRNERR	;ERROR CODE
	PJRST	LKENR2		;GO GIVE AN ERROR RETURN
SUBTTL	ENTER
UENTR:
IFN FTNUL,<
	PUSHJ	P,NULTST	;ON DEVICE NUL,
	  PJRST	CPOPJ1##	; ENTER WINS
>
IFN FTSPL,<
	SKIPL	DEVSPL(F)	;SPOOLING DEVICE?
	JRST	UENT1		;NO
	PUSHJ	P,GETWDU##	;YES, GET NAME USER IS ENTERING
	HRRI	M,UUXNAM(M)
	TLNN	T1,-1
	PUSHJ	P,GETWDU##	;(EXTENDED ENTER)
	MOVEM	T1,DEVSPN##(F)	;SAVE TEMPORARILY IN DDB
	SETZM	DEVPPN(F)
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN
UENT1:
>	;END CONDITIONAL ON FTSPL
	TLNE	F,LOOKB		;LOOKUP IN FORCE?
	JRST	UPDATE		;YES. UPDATE
UENT2:
IFN	FTLIB,<
	MOVE	J,JOB##
	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
>
	PUSHJ	P,SETLER	;NO. SET UUO FOR ENTER
	  JRST	ILNMEN		;BAD NAME - ERROR
IFN	FTLIB,<
	POP	P,JBTSFD##(J)
>
IFN FTSFD,<
	LDB	T1,DEYLVL##	;GET CURRENT LEVEL OF NESTING
	TLNE	M,UUODIR	;TRYING TO ENTER A DIRECTORY?

	CAMGE	T1,SFDLVL##	;YES, TOO HIGH?
	JRST	UENT3		;NO, CONTINUE
	HLRZ	T1,DEVEXT(F)	;YES, AN SFD?
	CAIN	T1,'UFD'
	JRST	UENT3		;NO, OK
	MOVEI	T1,LVLERR	;YES, SET ERROR CODE IN L/E BLOCK
	JRST	LKENER
UENT3:
>	;END CONDITIONAL ON FTSFD
;HERE IF NOT TRYING TO ENTER A DIRECTORY
IFN FTSTR,<	;IF MORE THAN ONE STR
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  POPJ	P,		;NULL LIST - SHOULD NEVER HAPPEN
	MOVE	T2,T1		;SEARCH LIST INTO T2
>	;END CONDITIONAL ON FTSTR
	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.
	  TLO	M,400000	;MATCH - MAKE M NEGATIVE
	JUMPL	M,LKENER	;ERROR IF M IS NEGATIVE
	PUSHJ	P,SAVE3##	;SAVE P1,P2,P3
	MOVE	T2,DEVACC##(F)	;LOC OF A.T.
	MOVE	T1,ACCSTS##(T2)
	TRNE	T1,ACPSUP	;SUPERSEDING
	TRNN	T1,ACPPAL##	; A PRE-ALLOCATED FILE?
	SKIPA	P3,P1		;NO, P3=USER CHAN
	JRST	[PUSHJ P,DWNDA##  ;YES. FNDFIL KEPT DA
		 JRST  SETENC]	;SO RETURN IT AND FINISH UP

;ON A GOOD RETURN FNDFIL HAS OBTAINED THE DA RESOURCE - GIVE IT UP IN TAKBLK
	TLNE	S,IOSWLK	;FILE (STR) WRITE LOCKED?
	JRST	ENERR2		;YES. ERROR
	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
IFN FTSTR,<	;IF MORE THAN ONE STR
	LDB	T4,ACYFSN##	;T4 = FSN
	MOVE	P1,TABSTR##(T4)	;LOC OF STR DATA BLOCK INTO P1
>	;END CONDITIONAL ON FTSTR
IFE FTSTR,<	;IF ONLY ONE STR
	MOVE	P1,TABSTR##	;ADDR OF STR DATA BLOCK
>
	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	T1,STRUNI##(P1)	;FIRST UNIT IN STR
	PUSH	P,P1		;SAVE P1
	MOVSI	P1,DVDSK	;BIT WHICH DEFINES A DISK DDB
UNILP1:	CAML	T4,UNITAL##(T1)	;IS THIS THE BEST UNIT SO FAR?
	JRST	UNILP5		;NO. TRY NEXT
IFN FTDALC,<			;FANCY ALLOCATION CODE
	TLNE	T1,-1		;YES. AVOIDING UNITS WITH OPEN FILES?
	JRST	UNILP4		;NO, USE THIS UNIT
	MOVE	T2,USRHCU##	;YES. NO OF CHANS USER HAS OPEN
UNILP2:	CAMN	T2,P3		;ENTER BEING DONE ON THIS CHAN?
	JRST	UNILP3		;YES
	SKIPE	T3,USRJDA##(T2)	;NO. IS THERE A DDB ON THIS CHAN?
	TDNN	P1,DEVMOD(T3)	;YES. IS IT A DISK DDB?
	JRST	UNILP3		;NO. LOOK AT NEXT CHAN
	HLRZ	T3,DEVEXT(T3)	;YES. FILE'S EXTENSION
	CAIN	T3,(SIXBIT /UFD/)	;IS IT A UFD?
	JRST	UNILP3		;YES. PUTTING DATA FILE ON SAME UNIT IS OK
	MOVE	T3,USRJDA##(T2)	;NO. RESTORE LOC OF DDB
	HLRZ	T3,DEVUNI##(T3)	;UNIT OF THE FILE
	CAIN	T3,(T1)		;IS IT THIS UNIT?
	JRST	UNILP5		;YES. DON'T WANT TO WRITE THE FILE ON THIS UNIT
UNILP3:	SOJGE	T2,UNILP2	;TEST NEXT USER CHAN
>				;END CONDITIONAL ON FTDALC
UNILP4:	MOVE	T4,UNITAL##(T1)	;THIS IS THE BEST SO FAR. SAVE ITS TALLY
	HRRZ	U,T1		;SAVE LOC OF UNIT DATA BLOCK
UNILP5:	HLR	T1,UNISTR##(T1)	;STEP TO NEXT UNIT IN STR
	TRNE	T1,-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
IFN FTDALC,<			;FANCY ALLOCATION CODE
	TLON	T1,-1		;INDICATE ANY UNIT WILL DO
	JRST	UNILP0		;GO FIND ANY UNIT WITH FREE BLOCKS
>				;END CONDITIONAL ON FTDALC
	STOPCD	.,JOB,SFI,	;++STR FREE-COUNT INCONSISTENT
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:	MOVEM	U,DEVUNI##(F)	;SAVE LOC OF UNIT DB IN DDB
	MOVEI	T3,DEVRB2##(F)	;SET DEVRET TO DEVRB2 (1ST REAL PNTR)
	HRRM	T3,DEVRET##(F)
	MOVE	J,UNIKON##(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,400000	;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)
IFN FTDALC,<			;FANCY ALLOCATION CODE
	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)
	PUSHJ	P,GETWDU##
	HRRI	M,1(M)
	CAIL	P1,UUXEST
	SKIPG	T2,T1		;GET ESTIMATED ALLOCATION
>	;END CONDITIONAL ON FTDALC
	HLRZ	T2,UNIGRP##(U)	;NO ESTIMATED, USE UNIGRP
IFN FTDALC,<
	CAIA
USEUN2:	TLO	M,UALASK	;INDICATE ASKING FOR A SPECIFIC AMOUNT
>
IFN FTDQTA,<
	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)
IFN FTDALC,<			;FANCY ALLOCATION CODE
	TLNE	M,UALASK
	TLO	M,UPARAL	;YES. REMEMBER FOR PARTIAL ALLOC. ERROR
>	;END CONDITIONAL ON FTDALC
>	;END CONDITIONAL ON FTDQTA
;HERE WITH T2=SPACE WE WOULD LIKE TO GET
CREAL1:	HRRI	M,1(M)		;POINT TO START ADDRESS WORD
	PUSH	P,T2		;SAVE T2
IFN FTDALC,<	;FANCY ALLOCATION CODE
	PUSHJ	P,ALSTRT	;SET T1 FOR POSSIBLE START-ADR. SPECIFICATION
	  JRST	ENERR1		;CANT START AT SPECIFIED BLOCK (ADR. TOO HIGH)
>	;END CONDITIONAL ON FTDALC
IFE FTDALC,<			;NO FANCY ALLOCATION CODE
	SETZ	T1,		;TAKE BLOCKS ANYWHERE
	HRRI	M,-1(M)		;POINT M TO ALLOCATION WORD AGAIN
>

;HERE WITH T1=START ADR (OR 0), T2=NUMBER OF BLOCKS REQUESTED
	PUSHJ	P,ENTALC	;ALLOCATE SPACE
	  JRST	ENER1A		;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	ENER1X		;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
IFN FTSFD,<
	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,SETEN2	;DEFAULT PROT=OLD FILE'S PROT IF SUPERSEDE
IFE FTSET&FTFDAE,<
	TLNE	M,UUODIR	;CREATE, SET UP DEFAULT PROT. DIRECTORY FILE?
	SKIPA	T3,UFDPRT##	;YES. USE UFD STANDARD PROTECTION
	MOVE	T3,STNPRT##	;NO. USE REGULAR STANDARD PROTECTION
>
IFN FTSET!FTFDAE,<
	MOVE	T3,UFDPRT##	;STANDARD DIRECTORY PROTECTION
	TLNE	M,UUODIR	;A DIRECTORY ?
	JRST	SETEN2		;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	SETN1A		;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	SETEN2		;SET PROTECTION FIELD
SETN1A:>>
IFN FT5UUO,<
	TLNN	F,SYSDEV	;IS DEVICE = SYS?
	JRST	SETN1B		;NO
	HLRZ	T3,DEVEXT(F)	;YES, PROT = <155>
	CAIN	T3,'SYS'	; EXCEPT FOR .SYS FILES
	SKIPA	T3,SYSPRY##	; WHICH ARE <157>
	MOVE	T3,SYSPRT##
IFN FTSET,<
	JRST	SETEN2
SETN1B:>>
IFN FTSET,<
	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
>
SETEN2:	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
IFN FTSPL,<
	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
	MOVEM	T1,ACCPRV##(P2)	;SAVE 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,SETEN4	;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	SETEN5		;AND CONTINUE
;HERE TO SET UP RIB BLOCK FROM A 4-WORD ENTER
SETEN4:	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
IFN FTSPL,<
	MOVE	T1,DEVSPN##(F)
	SKIPGE	DEVSPL(F)
	MOVEM	T1,RIBSPL##(T2)	;SAVE (POSSIBLE) NAME ENTERED ON A SPOOL-ENTER
>
	LDB	T1,PJOBN##	;GET JOB NUMBER
	MOVE	T1,JBTADR##(T1)	;GET ADDRESS OF JOBDAT
	MOVE	T1,.JBVER##(T1)	;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
SETEN5:	PUSHJ	P,RIBAD##	;COMPUTE ADR. OF RIB
	MOVE	T1,DEVMBF##(F)	;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
	SKIPE	RIBAUT##+1(T1)	;IF NO PRJ,PRG GIVEN
	JRST	SETN5B
	LDB	T3,PJOBN##	;JOB NUMBER
	MOVE	T3,JBTPPN##(T3)	;AUTHORS PRJ,PRG NUMBER
	MOVE	T4,DEVPPN(F)	;DIRECTORY OF FILE
	CAMN	T3,FSFPPN##	;IF AUTHOR IS [1,2]
	CAMN	T4,QUEPPN##	; UNLESS WRITING IN [3,3]
	JRST	SETN5A
	MOVE	T3,T4		;MAKE AUTHOR = DIRECTORY OWNER
SETN5A:	MOVEM	T3,RIBAUT##+1(T1)  ;STORE USERS PRJ,PRG
SETN5B:	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)
IFN FTDALC,<			;FANCY ALLOCATION CODE
	PUSHJ	P,GTWDT3
	CAIL	P1,UUXEST	;SPECIFYING ESTIMATED LENGTH?
	SKIPG	T3
	JRST	SETENA		;NO
	SUB	T3,RIBALC##+1(T1) ;YES. ALREADY HAVE THAT MUCH?
	JUMPLE	T3,SETENA	;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
IFN FTDQTA,<
	MOVE	T2,T3		;NUMBER OF BLOCKS TO GET
	PUSHJ	P,CHKQTA##	;CHECK QUOTA
	SKIPG	P2,T2		;P2=AMOUNT WE CAN GET
	JRST	SETENB		;CANT GET ANY MORE - FORGET IT
>	;END CONDITIONAL ON FTDQTA
;STILL IN FTDALC CONDITIONAL
SETEN6:	PUSHJ	P,TAKCHK##	;GET AS LARGE A GROUP AS THERE IS
	  JRST	SETEN8		;ON A NEW UNIT
SETEN7:	MOVEM	T2,(P1)		;SAME UNIT - SAVE POINTER
	SUB	P2,T1		;SUBTRACT NUMBER OF BLOCKS OBTAINED
	JUMPLE	P2,SETEN9	;DONE IF NO MORE TO GET
	MOVE	T2,P2		;NEW AMOUNT TO GET
	AOBJN	P1,SETEN6	;GO TRY AGAIN
	JRST	SETEN9		;NO MORE POINTER SLOTS IN RIB - DONE
SETEN8:	JUMPE	T3,SETEN9	;STR FULL IF T3=0
	MOVEM	T3,(P1)		;SAVE UNIT-CHANGE IN RIB
	AOBJN	P1,SETEN7	;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
SETEN9:	MOVE	P2,DEVACC##(F)
	TRZ	S,IOBKTL	;MAKE SURE IOBKTL OFF
	MOVE	T1,DEVMBF##(F)	;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
SETENB:	HRROI	P1,DEVRBN##(F)	;PREPARE TO SET DEVRET=DEVRBN
IFN FTACCT,<
	HRRI	M,-<UUXALC-UUXEST>(M)  ;POINT BACK AT EST LENGTH
>
>	;END CONDITIONAL ON FTDALC
SETENA:	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
IFN FTACCT,<
	JUMPGE	T2,STRAC4	;GO IF 0-LENGTH ACCT STRING
	ADDI	T2,1(T1)	;AOBJN WORD FOR ACCT-STRING IN RIB
	CAIL	P3,UUXACT	;IF NO STRING SPECIFIED,
	PUSHJ	P,PRVJB##	; OR IF NOT A PRIVZD JOB
	  JRST	STRAC2		;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
STRAC1:	HRRI	M,1(M)		;ADVANCE TO NEXT ARGUMENT
	PUSHJ	P,GTWST2	;GET AN ARGUMENT
	JUMPE	T1,STRAC2	;DONE (OR USE PDB) IF 0
	MOVEM	T1,(T2)		;SAVE IN RIB
	AOBJP	T2,STRAC3	;DONE IF RIB FULL
	SOJE	P3,STRAC3	;DONE IF NO MORE VALUES
	JRST	STRAC1		;GO GET ANOTHER ARG FRO USER
STRAC2:	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	STRAC3		;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)
STRAC3:	MOVE	T1,DEVMBF##(F)	;RESTORE T1
STRAC4:>
	MOVE	T2,RIBSLF##+1(T1)	;RESTORE RIB ADDRESS
	HLRZ	U,DEVUNI##(F)	;RESET U TO UNIT OF RIB
	PUSHJ	P,MONWRT##	;WRITE THE RIB
	PUSHJ	P,GVMNB0##	;GIVE UP MONITOR BUFFER
SETENC:	HRRZ	T3,DEVACC##(F)	;LOC OF THE A.T.
	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
	LDB	T1,PUUOAC##
	TLNE	M,UPARAL	;PARTIAL ALLOCATION ONLY?
	TLOA	F,ENTRB		;YES. SET FOR NON-SKIP RETURN
	AOSA	(P)		;NO. SKIP(GOOD) RETURN
	HLLM	F,USRJDA##(T1)	;UUOCON DOESN'T STORE F ON AN ENTER ERROR RETURN
	POPJ	P,		;RETURN TO USER
;HERE WHEN THE ENTER IS AN UPDATE (LOOKUP ALREADY DONE)
UPDATE:
	PUSHJ	P,GETCB##	;%GET CB RESOURCE
	HRRZ	U,DEVUNI##(F)	;%SET UP U
	TLZ	M,UUOMSK	;%ZERO MEANINGFUL BITS IN UUO
	TLO	M,UUOUPD	;%INDICATE UPDATE
	PUSHJ	P,SETLE0	;%CHECK FOR EXTENDED UUO, OK NAME
	  JRST	UILNMR		;%ZERO NAME - ERROR
	PUSHJ	P,GETWDU##	;%GET NAME
	CAME	T1,DEVFIL(F)	;%SAME AS LOOKED-UP NAME?
	JRST	UILNMR		;%NO. ERROR
	HRRI	M,UUNEXT-UUNNAM(M)  ;%YES. POINT TO EXTENSION
	PUSHJ	P,GETWDU##	;%SUPPLIED EXTENSION
	TRZ	T1,-1
	HLLZ	T2,DEVEXT(F)	;%LOOKED-UP EXT
	HRRI	M,-1(M)		;%BUMP FOR BELOW
IFN	FTLIB,<
	MOVE	T3,DEVLIB##(F)	;%IF THE FILE WASN'T IN UFD, BUT IN LIB
	TLNN	T3,DEPLIB##	; MAKE UPDATE ILLEGAL
>
	CAME	T1,T2		;%MATCH?
	JRST	UILNMR		;%NO. ERROR
	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,UPDAT1	;%NO PPN IF T1=0
IFN	FTSFD,<
	TLNE	T1,-1		;POINTER TO A PATH?
	JRST	UPDAT0		;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,UPDAT1	;SAME PPN IF 0
UPDAT0:>
	CAMN	T1,T2		;PPN'S MATCH?
	JRST	UPDAT1		;YES
	MOVEI	T1,ISUERR	;%NO, ISU ERROR
	PUSHJ	P,GVCBJ##	;%RETURN CB RESOURCE
	PJRST	LKENER
;HERE WHEN THE NAME, EXTENSION AND PRJ,PRG AGREE WITH THE LOOKED-UP FILE
UPDAT1:	MOVEI	T1,FNCAPP##	;%CHECK TO SEE IF APPEND IS LEGAL
	HLRZ	T3,DEVEXT(F)	;%IS EXTENSION = "UFD"
	CAIE	T3,(SIXBIT /UFD/)
	PUSHJ	P,CHKPRV##	;% OR PRIVS NOT RIGHT?
	  JRST	UPDER2		;%ERROR
	HRRZ	T1,DEVACC##(F)	;%OK, LOC OF A.T.
	MOVE	T2,ACCNDL##(T1)	;%IS THIS A MAGIC FILE?
	TRNE	T2,ACPNDL##
	JRST	UPDER2		;%YES, IT CAN'T BE UPDATED
	MOVE	T1,ACCSTS##(T1)	;%STATUS
	TRNE	T1,ACPDEL##	;%MARKED FOR DELETION?  (IF SO, ANOTHER JOB
	JRST	UPDER4		; DID A SUPERSEDE BEFORE THIS ENTER)
	PUSHJ	P,TSTWRT	;%TEST IF WRITING IS ALLOWED
	  JRST	UPDER3		;%NO, GIVE FILE-BEING-MODIFIED ERROR
	MOVEI	T2,ACPUPD	;%INDICATE THIS FILE BEING UPDATED
	MOVE	T3,DEVACC##(F)	;%
IFN FTDSIM,<
	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,GVCBJ##	;%GIVE UP CB RES
	PUSHJ	P,SAVE2##	;SAVE SOME ACS
	MOVEI	T1,FNCCAT##	;CAN USER CHANGE ATTRIBUTES?
	SETZ	P2,
	PUSHJ	P,CHKPRV##
	  SETO	P2,		;NO
	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	UPDEN3		;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
	MOVE	P1,T1
	HRRI	M,UUXALC(M)	;POINT TO ALLOCATION WORD
IFN FTDALC,<			;FANCY ALLOCATION CODE
	PUSHJ	P,GETWDU##	;GET IT
	CAIL	P1,UUXALC	;SPECIFYING ALLOCATION?
	SKIPG	T2,T1
>	;END CONDITIONAL ON FTDALC
	JRST	UPDEND		;NO. TAKE GOOD RETURN
IFN FTDALC,<			;FANCY ALLOCATION CODE
	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,UPDATA	;ADD MORE BLOCKS TO FILE
	  JRST	ENER1B		;COULDN'T START WHERE REQUESTED (E+11)
	PUSHJ	P,WTUSAT
	SKIPE	DEVMBF##(F)	;ALREADY HAVE RIB IN CORE?
	JRST	UPDEN2		;YES
	PUSHJ	P,PTRGET##	;NO, READ RIB INTO CORE
	PUSHJ	P,UPDSET	;ADJUST DEYRLC FOR CURRENT POSITION
	JRST	UPDEN2		;AND CONTINUE
>	;END CONDITIONAL ON FTDALC
;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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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
IFE FTDSIM,<
	POPJ	P,		;%YES, GIVE ERROR RETURN
>
IFN FTDSIM,<
	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
UPDEN3:	PUSHJ	P,WRDCNT	;STORE WRDCNT IN E+3
IFE FTDSIM,<
	PUSHJ	P,PTRGET##	;READ CURRENT PNTRS
	JUMPN	T3,ENER1E	;IF RIB ERROR
>
IFN FTDSIM,<
	PUSHJ	P,SIMRIB	;GET DA, IF SIM UPDATE, THEN READ RIB
	  JRST	ENER1E		;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,FSFPPN##
	CAME	T2,QUEPPN##
	SKIPA	T2,DEVMBF##(F)
	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
;HERE WHEN ALL ALLOCATION IS DONE. SET VALUES INTO USER AREA
UPDEND:
IFE FTDSIM,<
	PUSHJ	P,PTRGET##	;READ THE RIB INTO CORE
	JUMPL	T3,UPDFN2	;GO IF RIB ERR
>
IFN FTDSIM,<
	PUSHJ	P,SIMRIB	;GET DA IF SIM UPDATE, READRIB
	  JRST	UPDFN2		;RIB ERROR
>
UPDEN2:	PUSHJ	P,UPDAUT	;UPDATE RIBAUT
	  JFCL
	JUMPL	P2,UPDFIN	;GO IF USER HASN'T GOT PRIVS TO CHANGE ATTS.
	PUSHJ	P,SETVAL	;YES, STORE USER-SUPPLIED VALUES INTO THE RIB

;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:
IFN FTDSIM,<
	TLNE	S,IOSDA		;SIM UPDATE?
	PUSHJ	P,DWNDA##	;YES, GIVE UP DA 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)
UPDFN2:	PUSHJ	P,GVMNB0##	;COPY PNTRS TO DDB, RETURN THE MONITOR BUFFER
IFE FTDSIM,<
	MOVEI	T1,DEPWRT##	;SET A BIT IN DDB TO INDICATE
	IORM	T1,DEVWRT##(F)	; THAT THIS IS THE WRITER
>
	PJRST	ENTXIT		;AND EXIT THE UUO
IFN FTDALC,<			;FANCY ALLOCATION CODE
;HERE TO RETURN SOME BLOCKS ON AN UPDATE ENTER
DELGRP:	JUMPE	T2,UPDEND	;NO ALLOCATION IF T2=0  - FINISH UP
	MOVE	T2,ACCCNT##(T3)	;NUMBER OF READERS
	TRNE	T2,ACMCNM##	;IF MORE THAN 1 READER,
	JRST	UPDR3A		; 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
	MOVE	P1,T1		;SAVE AOBJN WORD FOR THE PNTRS IN THE MON BUF
IFN FTDMRB,<			;IF MULTIPLE RIBS
	PUSH	P,DEVRIB##(F)	;SAVE POINTER TO CURRENT RIB
>
	PUSHJ	P,UPDGIV	;GIVE UP SOME BLOCKS
	  JRST	UPDR2A		;PRIVS WONT ALLOW IT - ERROR RETURN
IFN FTDMRB,<			;IF MULTIPLE RIBS
	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
>				;END CONDITIONAL ON FTDMRB

;DEALLOCATION IS COMPLETE - FINISH UP
	MOVE	T1,DEVMBF##(F)	;LOC OF MON BUF (-1)
	PUSHJ	P,WRTRIB##	;GO WRITE NEW RIB
IFN FTDMRB,<			;IF MULTIPLE RIBS
	SKIPL	DEVRIB##(F)	;PRIME RIB IN CORE?
	JRST	DELG0B		;YES, PROCEED
DELG0A:	PUSHJ	P,REDRIB##	;READ THE PRIME RIB INTO CORE
	  JRST	UPDER2		;ERROR READING RIB
>
DELG0B:
	PUSHJ	P,WTUSAT	;WRITE CHANGED SAT
	JRST	UPDEN2		;AND FINISH UP


;HERE TO LOOK AT OTHER RIBS
DELGP1:
IFN FTDMRB,<			;IF MULTIPLE RIBS
	PUSHJ	P,PTRNXT##	;GET NEXT RIB, IF ANY
>
	  STOPCD .,JOB,NNR,	;++NO NEXT RIB
IFN FTDMRB,<			;IF MULTIPLE RIBS
	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,UPDEND	;NOT REALLY TRUNCATING IF NON-POS
	MOVE	T2,DEVMBF##(F)	;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
>	;END CONDITIONAL ON FTDMRB
>	;END CONDITIONAL ON FTDALC
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.
;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,IOSERR##	;MAKE SURE PERMANENT ERR BITS ARE OFF
SETLE0:	PUSHJ	P,GETWDU##	;E=0?
	JUMPE	T1,CPOPJ##
	SETZ	T2,		;NO. 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
	MOVEI	T2,DEPECS	;CLEAR NO-SUPERSEDE BIT IN DDB
	SKIPL	DEVJOB(F)
	ANDCAM	T2,DEVSPL(F)
	TLNN	T1,-1		;NAME?
	JRST	SETLEX		;NO, MUST BE EXTENDED UUO
SETLE1:	TLNE	M,UUOUPD	;UPDATE?
	JRST	CPOPJ1##	;YES. GOOD RETURN
	LDB	J,PJOBN##

IFN	FTSFD,<
	SETZM	DEVPPN(F)	;START WITH DEVPPN=0
	SETZM	DEVSFD##(F)	;MAKE SURE START AT UFD
	PUSH	P,M		;SAVE M
	HRRI	M,UUNPPN(M)	;POINT TO PPN WORD
	TLNE	M,EXTUUO
	HRRI	M,-<3+UUXNAM-UUXPPN>(M)
	PUSHJ	P,GTWDT3	;IS IT IS XWD 0,ADR?
	SKIPLE	T2,T3
	TLNE	T2,-1
	JRST	SETLE2		;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,SETPTX	;FIND THE SFD HE WANTS
	  JRST	SETLE5		;NO SEARCH LIST OR NO SFD
SETLE2:	POP	P,M		;RESTORE M
	PUSHJ	P,GTWST2##	;RESTORE FILE NAME
>
	MOVEM	T1,DEVFIL(F)	;STORE NAME IN DDB
	HRRI	M,UUNEXT-UUNNAM(M)  ;POINT TO EXT WORD
	PUSHJ	P,GTWST2##	;GET EXTENSION
	HLRZS	T1
IFE	FTSFD,<
	CAIN	T1,(SIXBIT .SFD.) ;IS EXTENSION SFD?
	POPJ	P,		;YES, ILLEGAL
>
IFN	FTSFD,<
	CAIN	T1,(SIXBIT .SFD.) ;IS THE FILE AN SFD?
	TLO	M,UUODIR	;YES, SET UUODIR IN M
>
	HRLM	T1,DEVEXT(F)	;SAVE EXT IN DDB
	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
IFN FTSFD,<
	SKIPE	DEVPPN(F)	;PRJ,PRG ALREADY SET UP?
	AOJA	M,CPOPJ1##	;YES, PATH WAS SPECIFIED. RETURN
>
	PUSHJ	P,PPNPP0	;GET PPN
SETLE3:	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
IFE	FTSFD,<
	PJRST	CPOPJ1##
>
IFN	FTSFD,<
	SKIPN	T3		;USE DEFAULT DIR?
	CAME	T1,T4		;YES, WRITING IN DEFAULT PPN?
	PJRST	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,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.
SETL4A:	PUSHJ	P,SLITA##	;NEXT STR IN SEARCH LIST
	  JRST	SETL4B		;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	SETL4A		;NO, TRY NEXT STR
;HERE WHEN THE SFD DOESN'T EXIST IN THE SEACRCH LIST
SETL4B:	MOVE	P2,P1		;GIVE UP POSSIBLE TEMP SL.
	PUSHJ	P,SLGVT##
	HRRI	M,-<UUNPPN-UUNEXT>(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
	JRST	SETL5A		;AND GIVE SFD-NOT-FOUND ERROR RETURN
;HERE ON ERROR RETURN FROM SETPTH
;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
SETL5B:	POP	P,M
	TLOA	M,UUOREN
SETLE5:	POP	P,M		;RESTORE LOC OF NAME
	TLON	M,UUOREN	;TURN ON UUOREN
	JRST	SETL5A		;IF ENTER, ONLY SET ERROR
	HRRI	M,1(M)		;POINT TO EXT
	PUSHJ	P,GETWDU##
	HRRI	T1,SNFERR	;SFD-NOT-FOUND
	PUSHJ	P,PUTWDU##	;SAVE IN LOOKUP/ENTER BLOCK
SETL5A:	MOVEI	T1,SNFERR	;GET SFD-NOT-FOUND
	SETZM	DEVSFD(F)	;MAKE SURE DEVSFD=0
	POPJ	P,		;AND TAKE ERROR RETURN
>
;HERE ON EXTENDED UUO
SETLEX:	TLO	M,EXTUUO	;INDICATE EXTENDED UUO
	TRZE	T1,400000	;NO-SUPERSEDE ENTER?
	IORM	T2,DEVSPL(F)	;YES, LIGHT BIT IN DDB
	SETZ	U,		;INDICATE NON SINGLE-ACCESS
	MOVE	T2,T1
	CAIL	T1,UUXSTS	;IS THIS A DIRECTORY FILE ENTER?
	PUSHJ	P,PRVJB##	;YES, IS THIS A PRIVILEGED JOB?
	  JRST	SETLX2		;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
SETLX2:
IFN FTVM,<
	HRRI	M,UUXNAM(M)	;UUOCHK ADR CHECKS IF VM
>
IFE FTVM,<
	ADDI	M,(T2)		;POINT TO TOP OF BLOCK
	PUSHJ	P,GTWST2##	; ADR CHECK IT
	SUBI	M,-UUXNAM(T2)	;OK, POINT AT NAME
>
	PUSHJ	P,GTWST2##
	CAIL	T2,UUXEXT	;MUST HAVE AT LEAST 3 ARGUMENTS
	SKIPN	T1		;GET FILE NAME
	POPJ	P,		;NAME 0 - ERROR
	JRST	SETLE1		;NAME NOT 0- CONTINUE
;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
	POP	P,T3
	POP	P,T4
	SKIPN	T1,@SDVPPN##(T2)  ;YES, IS THERE AN IMPLIED PPN?
	JRST	TPOPJ##		;NO, RETURN
	ADDM	T3,-1(P)	;YES, SKIP RETURN IF CALL TO CURPPN
IFN FTLIB,<
	CAIN	T2,LIBNDX##	;DEVICE=LIB?
	PUSHJ	P,LIBPP		;YES, GET RIGHT PPN
	JUMPN	T2,T2POPJ##	;YES, LOOKING FOR SYS?
	MOVE	T2,JBTSFD##(J)	;YES, WANT NEW?
	TLNE	T2,JBPXSY##
	MOVE	T1,XSYPPN##	;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
IFE FTSFD,<
	 JFCL
	POPJ	P,
>
IFN FTSFD,<
	  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,SAVE3##	;SAVE P1
	HRR	M,T1		;LOC OF ARG LIST
	HLRZ	P1,T1		;N-3 INTO P1
	SUBI	P1,3		;NO. OF ARGS-3
	SKIPGE	P1		;IF P1 IS NEGATIVE,
	SETZ	P1,		; SET IT 0
	PUSHJ	P,GETWDU##	;GET VALUE
IFN	FTSFD,<
	HLRE	P2,T1		;GET JOB NUMBER
	SKIPLE	P2		;IF .LE. 0
	CAILE	P2,JOBMAX##	;  OR TOO HIGH
	MOVE	P2,JOB##
	TLNN	T1,770000
	HRRES	T1		;GET ARGUMENT##	;USE CURRENT JOB
	CAMLE	T1,[-2]		;DEFINING THE DEFAULT PATH?
	JRST	PTHUU5		;NO
IFE	FTLIB,<
	CAME	T1,[-2]		;IF NOT EXACTLY -2,
	JRST	PTHUU5		; LOOK FOR A DEVICE BY THAT NAME
>
IFN	FTLIB,<
	CAMN	T1,[-4]		;IF -4
	JRST	PTHUU4		;READ LIB, SYS, NEW BITS
	CAMN	T1,[-3]		;IF -3,
	SETO	P1,		;INDICATE BY P1=-1
	CAME	T1,[-2]		;LOOK FOR A DEVICE IF NOT -2
	JUMPGE	P1,PTHUU5	; OR -3
>
	PUSHJ	P,FAKDDB	;SET UP A DDB FROM FREE CORE
	  POPJ	P,		;NO FREE CORE LEFT - CANT SET THE PATH
	MOVEM	P1,DEVNAM(F)	;STORE N-3 IN NAME
	PUSHJ	P,SETPTX	;SET UP THE DEFAULT PATH
	  PJRST	PTHUU2		;SOME SFD WASN'T THERE
IFN	FTLIB,<
	JUMPL	P1,PTHUU3	;SET LIB, SYS IF -3
>
;STILL IN FTSFD CONDITIONAL
	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	PTHUU1		;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
	MOVE	J,JOB##		;(PTHCHX ZEROED J)
	CAMN	T1,JBTPPN##(J)	;IS IT JOB'S PPN?
	JRST	PTHUU1		;YES
	PUSHJ	P,SFDPPN	;NO, GET L(PPB)
	HLRS	T1
PTHUU0:	MOVEI	T2,PPPNLG##	;PRETEND NEW DEFAULT PPN IS LOGGED IN
	ORM	T2,PPBNLG##(T1)
PTHUU1:	PUSHJ	P,CLRDDB	;RETURN THE DDB
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;HERE ON ERROR RETURN FROM SETPTH
PTHUU2:	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
;STILL IN FTSFD

IFN	FTLIB,<
PTHUU3:	LDB	T2,DEYLVL##	;GET SYS,NEW BITS
	ANDI	T2,CORXTR##
	PUSHJ	P,GTWST2##
	SKIPE	T1		;SETTING NO LIB?
	OR	T2,DEVSFD##(F)	;NO, SAVE LIB IN JBTSFD
	MOVE	J,JOB##
	HLRZ	P2,JBTSFD##(J)	;OLD LIB
	HRLM	T2,JBTSFD##(J)	;SAVE NEW LIB, SYS BITS
	TRZ	P2,CORXTR##	;ZAP THE EXTRA BITS
	HRRZ	T1,DEVSFD##(F)
	JUMPE	P2,PTHUU0	;GO IF NO OLD LIB
	TRZ	T2,CORXTR##
	CAMN	T2,P2		;
	JRST	PTHUU0		; 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
	HRRZ	T1,DEVSFD##(F)	;NEW PPB INTO T1
	JRST	PTHUU0		;GO SET IT LOGGED-IN

;HERE TO READ LIB, SYS
PTHUU4:	HLRZ	T1,JBTSFD##(P2)	;LIB, SYS,NEW
	ANDI	T1,CORXTR##	;JUST SYS, NEW
	PUSHJ	P,PUTWD1##	;TELL USER
	HLRZ	T1,JBTSFD##(P2)	;LIB
	TRZ	T1,CORXTR##	;JUST LIB
	SKIPE	T1		;0 IF NO LIB
	MOVE	T1,PPBNAM##(T1)	;PPN
	PUSHJ	P,PUTWD1##	;TELL USER
	PJRST	CPOPJ1##	;AND TAKE SKIP-RETURN
>	;END CONDITIONAL ON FTLIB
;STILL IN FTSFD CONDITIONAL
;HERE WHEN TRYING TO READ THE PATH
PTHUU5:	SETO	P3,
	CAMN	T1,[-1]		;READING DEFAULT PATH?
	JRST	PTHUU7		;YES
>;END	FTSFD
;(RIGHT HERE IF FTSFD = 0)
IFE FTSFD,<
	SETO	P3,		;SPECIAL-DEVICE FLAG
>
IFN FT5UUO!FTNET!FTSFD,<
	PUSHJ	P,DVCNSG##	;NO, GET DDB
>
IFE FTSFD!FTNET!FT5UUO,<
	PUSHJ	P,DEVSRG##
>
	  PJRST	RTZER##		;NONE - RETURN 0 TO USER
	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,SDVTST	;SPECIAL DEVICE?
	  JRST	PTHU5A
	SKIPLE	P1
	MOVEI	P1,1		;REMEMBER NO SFD'S
	SKIPA	P3,T2		;SAVE INDEX
PTHU5A:	MOVE	T1,[SIXBIT/DSK/]
	TLO	P3,(T3)		;LH (P3)=0 IF "DEV" =1 IF "DEVX"
	HRRZ	T2,DEVACC##(F)	;LOC OF AT
	JUMPE	T2,PTHUU6	;NO OPEN FILE, NAME='DSK'
IFE FTSTR,<
	SETZ	T2,
>
IFN FTSTR,<
	LDB	T2,ACYFSN##	;AN OPEN FILE, GET STR NUMBER
>
	SKIPGE	P3		;IF NOT A SPECIAL DEVICE,
	MOVE	T1,@TABSTR##(T2)	; TELL USER STR NAME
PTHUU6:	TLNE	F,SYSDEV	;BUT IF SYS,
	HRLI	T1,(SIXBIT .SYS.) ;"SYS" IS THE NAME
	PUSHJ	P,PUTWDU##	;STORE IT FOR USER
IFN	FTSFD,<
	LDB	T3,DEYSCN##	;SCAN-SWITCH
	HRRZ	T2,DEVSFD##(F)	;LOC OF SFD NMB
	SKIPE	T4,DEVPPN(F)	;PPN SET UP?
	JRST	PTHUU8
	PUSHJ	P,SFDPPN	;NO, TELL HIM DEFAULT PPN
	TLNE	F,SYSDEV
	MOVE	T4,SYSPPN##
	JRST	PTHUU8		;CONTINUE
PTHUU7:	MOVEI	F,DSKDDB##	;FAKE UP F
	MOVE	J,P2		;JOB NUMBER
	PUSHJ	P,SFDPPN	;GET DEFAULT
	TRZ	T3,JBPUFB##	;MASK OUT DEFAULT=UFB BIT
>	;END	FTSFD
IFE	FTSFD,<
	SKIPN	T4,DEVPPN(F)	;PPN SET UP?
	MOVE	T4,JBTPPN##(J)	;PPN
>
PTHUU8:	MOVEI	T1,1(T3)	;INTERNAL SCAN-SWITCH +1
IFN	FTLIB,<
	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,PTHU8A	;IF A SPECIAL DEVICE,
IFN FTSTR,<
	HRRZ	T3,SDVTBL##(P3)	; GET SEARCH-LIST TYPE
	TLZN	P3,-1		;WAS IT DEVX?
	IOR	T1,T3		;NO, RETURN TYPE TO USER
>
IFE FTSTR,<
	HRRZS	P3
>
	SKIPE	@SDVPPN##(P3)	;IF THERE IS AN IMPLIED PPN
	TRO	T1,PT.IPP##	;LIGHT A BIT
PTHU8A:	PUSHJ	P,PUTWD1##	;TELL THE USER
IFN FTLIB,<
	CAIE	P3,LIBNDX##	;LIB?
	JRST	PTHU8B
	PUSHJ	P,LIBPP		;YES, GET RIGHT PPN
	JUMPN	T1,PTHU8E	;GO TELL USER
PTHU8B:>
	JUMPL	P3,PTHU8D	;IF  A SPECIAL DEVICE,
IFN FTLIB,<
	JUMPN	P3,PTHU8C	; IF SYS
	HLRZ	T1,JBTSFD##(J)	; IS NEW ON FOR USER ?
	TRNE	T1,JBPXSY##
	MOVEI	P3,NEWNDX##	; YES, RETURN NEWPPN
>
PTHU8C:	SKIPN	DEVPPN(F)	;TELL TRUTH IF LOOKUP WAS DONE
	SKIPN	T1,@SDVPPN##(P3); GET IMPLIED PPN
PTHU8D:	MOVE	T1,T4		;DEFAULT PPN
PTHU8E:	PUSHJ	P,PUTWD1##	;SAVE FOR USER
IFE	FTSFD,<
	PJRST	CPOPJ1##
>
IFN	FTSFD,<
	JUMPLE	P1,CPOPJ1##	;RETURN IF THAT'S ALL HE WANTS
	PUSH	P,[0]		;SAVE TERMINATOR
	JUMPE	T2,PTHUUB	;DONE IF HAVE A 0 NAME
PTHUU9:	PUSH	P,NMBNAM##(T2)	;GET THE NEXT NAME
PTHUUA:	HLRZ	T2,NMBPPB##(T2)	;SCAN FOR FATHER SFD
	TRZN	T2,NMPUPT##
	JUMPN	T2,PTHUUA
	JUMPN	T2,PTHUU9	;SAVE ITS NAME AND CONTINUE
PTHUUB:	POP	P,T1		;READ A NAME FROM LIST
	SOSL	P1
	PUSHJ	P,PUTWD1##	;STORE IT IN USERS AREA
	JUMPN	T1,PTHUUB	;GET NEXT
	PJRST	CPOPJ1##	;DONE - GOOD RETURN
>	;END CONDITIONAL ON FTSFD
IFN FTSFD,<
;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 SETPTX IF ANY SFD IS LEGAL
SETPTX:
SETPTH:	PUSHJ	P,SAVE3##	
	MOVE	P2,T1		;SAVE FORBIDDEN NMB LOC
	HRRZ	T1,M
	PUSHJ	P,SETPT9	;ADDRESS CHECK ARGUMENTS (MIGHT GET EUE
	ADD	T1,SFDLVL##	; IF BAD ADDRESS ON A GETSEG/RUN UUO
	PUSHJ	P,SETPT9
	PUSHJ	P,GETWD1##
	MOVE	P1,T1		;SCANNING SWITCH
IFN	FTLIB,<
	AOSN	DEVNAM(F)	;DEVNAM=-1?
	TROA	P1,400000	;YES, P1 WILL BE NEGATIVE
	SOSA	DEVNAM(F)	;NO, RESET DEVNAM
	JRST	SETPT2		;WANT ALL OF WORD IF LIB
>
	JUMPN	P1,SETPT1	;IF NO CHANGE,
	MOVE	P1,JBTSFD##(J)	;GET OLD VALUE
	ANDI	P1,JBPSCN##
	JRST	SETPT2
SETPT1:	CAIE	T1,2		;IF HE IS SPECIFYING IT
	TDZA	P1,P1		;2 MEANS NO SCAN,
	MOVEI	P1,JBPSCN##	;OTHERWISE SCAN
SETPT2:	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	SETPT3
	PUSHJ	P,PUTWRD##	;TELL USER
	  JRST	ADRERR##	;CANT STORE IN PROTECTED JOB DATA AREA
;STILL IN FTSFD CONDITIONAL
SETPT3:	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
SETPT4:	PUSHJ	P,GETWD1##	;NEXT SFD NAME
	SKIPE	DEVFIL(F)	;IF NOT 1ST TIME,
	JUMPE	T1,SETPT6	; 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
IFN FTSTR,<	;IF MORE THAN ONE STR
	PUSHJ	P,SETSRC##	;SET UP SEARCH LIST
	  JRST	SETPT7		;NONE - ERROR
	MOVE	T2,T1
>	;END CONDITIONAL ON FTSTR
				;SO CHK PRV WONT BE CALLED
	PUSHJ	P,FNDFIL##	;LOOKUP NAME.SFD
	JRST	SETPT7		;NOT FOUND
	ANDCAM	P3,DEVPRV##(F)
	SKIPN	DEVFIL(F)	;LOOKING FOR UFD?
	JRST	SETPT5		;YES

;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	SETPT8		;YES, ERROR
	HRRM	T1,DEVSFD##(F)	;SAVE AS CURRENT SFD
	PUSHJ	P,INCSFD	;INCREMENT ITS USE-COUNTS
	SKIPL	DEVNAM(F)	;IF DEVNAM IS A POSITIVE NUMBER
	SOSLE	DEVNAM(F)	;DECR BY 1
	SKIPA			;NOT NEGATIVE - CONTINUE
	JRST	SETPT6		;DONE ALL HE ASKED FOR - RETURN
	MOVEI	T1,1(P1)	;COUNT LEVEL UP
	CAIGE	T1,MAXLVL##	;TOO HIGH?
	AOJA	P1,SETPT4	;NO, TRY NEXT NAME IN USERS LIST
	AOJA	P1,SETPT6	;YES, DONE
;STILL IN FTSFD CONDITIONAL
;HERE ON GOOD RETURN FROM FNDFIL WITH DEVFIL=0 (LOOKING FOR UFD)
SETPT5:	HRRZ	T1,DEVACC##(F)	;SAVE DEVACC (LOC OF UFB)
	HLLZS	DEVACC##(F)	;ZERO DEVACC
	TRO	T1,JBPUFB##	;INDICATE DEVSFD IS REALLY A UFB
IFN	FTLIB,<
	JUMPGE	P1,SETP5A	;IF SETTING UP A LIB,
	TRZ	T1,JBPUFB##	; DON'T LIGHT JBPUFB
	HLRZS	P1		;STORE SYS, NEW IN DEYLVL
>
SETP5A:	HRRM	T1,DEVSFD##(F)	;SAVE IN DDB
SETPT6:	DPB	P1,DEYLVL##	;SAVE LEVEL OF NESTING
	HLRZS	P1		;SCAN SWITCH
	DPB	P1,DEYSCN##	;SAVE IN DDB
	POP	P,DEVUNI##(F)	;RESTORE DEVUNI
	HRRZ	U,DEVUNI##(F)	; AND U
	SETZ	T2,		;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
SETPT8:	HRRZ	T1,DEVACC##(F)	;DECREMENT FAILING SFD'S
	PUSHJ	P,DECONE	; USE COUNT
	JRST	.+2
SETPT7:	PUSHJ	P,DECSFD	;DECR USE COUNT
	HLLZS	DEVACC##(F)	;ZERO DEVACC
	ANDCAM	P3,DEVPRV##(F)
	POP	P,DEVUNI##(F)
	POPJ	P,		;AND ERROR RETURN
SETPT9:	TRNE	T1,-20
	PUSHJ	P,UADRCK##
	POPJ	P,
>	;END CONDITIONAL ON FTSFD
IFN	FTSFD,<
;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 ;%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
	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
;STILL IN FTSFD CONDITIONAL
;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,UFORSS##	;FIND SFD A.T. OR UFB
	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
>	;END CONDITIONAL IN FTSFD
;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:
IFE	FTSFD,<
	SETZB	T1,T2		;IF NO SFD'S,
	SETZM	T3
	MOVE	T4,JBTPPN##(J)	; PPN IS THE ONLY GOOD NUMBER
	POPJ	P,
>
IFN	FTSFD,<
	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,QUEPPN##	;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
IFN	FTSFD,<
IFN	FTLIB,<
	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
IFN	FTSFD,<
;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?
	  POPJ	P,		;YES, RETURN
	PUSHJ	P,GTMNBF##	;NO, GET A MON-BUF
	MOVE	T1,PPBNAM##(P2)	;PPN
	MOVEM	T1,DEVPPN(F)	;SAVE IN DDB
	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
IFN FTSTR,<	;IF MORE THAN ONE STR
	LDB	T1,ACZFSN##	;STR NUMBER
	MOVE	T1,TABSTR##(T1)
>
IFE FTSTR,<	;IF ONLY ONE STR
	MOVE	T1,TABSTR##	;ADDR OF STR DATA BLOCK
>
	HLRZ	U,STRUNI##(T1)	;SET U TO 1ST UNIT IN STR
	MOVEM	U,DEVUNI##(F)	;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
	PUSHJ	P,TSTPPK	;DELETE THE 4-WORD CORE BLOCKS FOR THE PPB
	LDB	J,PJOBN##	;RESTORE JOB NO
	PJRST	GVMNB0##	;RETURN MON BUF AND EXIT
>
SUBTTL	RENAME
RENAM:
IFN FTNUL,<
	PUSHJ	P,NULTST	;ON DEVICE NUL
	  PJRST	CPOPJ1##	;RENAME WINS
>
IFN FTLIB,<
	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	RENER0		;NO. ERROR RETURN
	TLNE	S,IOSWLK	;STR WRITE LOCKED?
	JRST	RENER5		;YES. ERROR RETURN
	TLNE	F,ENTRB		;NO, AN ENTER BEEN DONE?
	TLNE	F,OCLOSB	;YES, WAS A CLOSE DONE?
	JRST	RECLSD		;YES, NO OPEN OUTPUT FILE
;HERE ON A RENAME WITH AN OPEN OUTPUT FILE - HAVE TO CLOSE IT
;SINCE FNDFIL WILL NEED THE DDB POINTER SPACE TO READ THE UFD
	PUSH	P,M		;SAVE M
	HRRI	M,0		;ENSURE A CLOSE REALLY HAPPENS
	PUSHJ	P,CLOSE1##	;ZAP
	POP	P,M		;OK, NOW CONTINUE
RECLSD:	PUSHJ	P,WAIT1##
	PUSHJ	P,DDBZR		;OUTPUT CLOSE WANTS TO CALL DD2MN
	PUSHJ	P,SAVE4##	;SAVE P1-P4
	TLZ	M,UUOMSK	;ZERO INDICATOR BITS IN M
	TLO	M,UUOLUK	;INDICATE LOOKUP FOR FNDFIL
	HLRZ	U,DEVUNI##(F)	;SET U IN CASE DON'T GO TO FNDFIL
	HRRZ	P2,DEVACC##(F)	;LOC OF ACCES BLOCK
	JUMPN	P2,RENAM1	;DON'T HAVE TO LOOKUP IF THERE
IFN FTSTR,<
	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
IFE FTSFD,<
	  JRST	RENERR		;ERROR - RETURN
>
IFN FTSFD<
	JRST	[SETZM	DEVSFD(F)
		 JRST	RENERR]
>
IFN	FTSFD,<
	PUSHJ	P,INCUSA	;INCREMENT USE-COUNT OF FATHER SFD
>
	PUSH	P,DEVUFB##(F)	;SAVE DEVUFB IN CASE OF FAILURE

	PUSHJ	P,RENAM0	;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:	POP	P,DEVUFB##(F)	;RESTORE DEVUFB
IFN FTSFD,<
	HLRS	DEVSFD##(F)	;RESTORE DEVSFD
>
	HRRZ	T1,DEVACC##(F)
	JUMPE	T1,CLOSIN
	PUSHJ	P,CLSNAM
	PJRST	CLOSIN		;FIX ACCESS TABLE AND EXIT


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

RENAM1:	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
	PUSHJ	P,GTWST2##	;RENAMING TO 0?
	JUMPE	T1,RENAM2	;YES
	TLNE	T1,-1		;MAYBE. EXTENDED UUO?
	JRST	RENAM3		;NO
	MOVE	P3,T1		;SAVE NO OF ARGS
IFN FTVM,<
	HRRI	M,UUXNAM(M)	;UUOCHK ADR CHECKS IF VM
>
IFE FTVM,<
	ADDI	T1,(M)		;T1:= TOP OF BLOCK
	HRR	M,T1		;PICK UP 18 BIT ADDR
	PUSHJ	P,GTWST2##	; ADR CHECK IT
	SUBI	M,-UUXNAM(P3)	;OK, POINT TO NAME WORD
>
	TLO	M,EXTUUO	;INDICATE EXTENDED UUO
	PUSHJ	P,GTWST2##	;RENAMING TO 0?
	JUMPN	T1,RENAM3	;NO
;HERE WHEN RENAMING A FILE TO 0 (DELETING)
RENAM2:	JUMPL	T2,RENER1	;NDL FILE IF T2 NEG
	MOVEI	T1,FNCDEL##	;CAN USER DELETE FILE?
	PUSHJ	P,CHKPRV##
	  JRST	RENER1		;NO. ERROR RETURN
IFN	FTSFD,<
	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
	SKIPN	DEVMBF##(F)	;HAVE MON BUF?
	PUSHJ	P,GTMNBF##	;NO, GET IT
	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
	PUSHJ	P,GVMNB0##	;NO, RETURN MON BUF
	POP	P,DEVSFD##(F)	;RESTORE DEVSFD
DIRDL2:	MOVEI	T1,DNEERR	;DIR-NOT-EMPTY
	AOJA	M,LKENR2	;RETURN THE ERROR
DIRDL3:	PUSHJ	P,GVMNB0##	;RETURN THE MON BUF
	POP	P,DEVSFD##(F)	;RESTORE DEVSFD
DIRDL4:>
	PUSHJ	P,GETCB##
	MOVE	T1,ACCSTS##(P2)	;%STATUS OF FILE
	TRNE	T1,ACPUPD	;%FILE BEING UPDATED BY ANOTHER JOB?
	JRST	RENER8		;%YES, ERROR RETURN
	TROE	T1,ACPDEL##+ACPNIU	;%NO, FILE ALREADY MARKED FOR DELETION?
	PJRST	GVCBJ1##	;%YES, GIVE GOOD RETURN
	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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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	RENM2A		;%NO
	MOVE	P3,T2		;%YES. SAVE FSN BIT
	PUSHJ	P,GVCBJ##	;%GIVE UP CB RESOURCE
	PUSHJ	P,FNDUFB	;FIND UFB FOR THIS FILE
	  JRST	RENM2B		;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

RENM2A:
	PUSHJ	P,GVCBJ##	;%GIVE UP CB
RENM2B:	SKIPN	DEVMBF##(F)
	PUSHJ	P,GTMNBF##	;GET MONITOR BUFFER
	PUSHJ	P,UPAU##	;GET AU RESOURCE
	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
	PUSHJ	P,GVMNB0##	;RETURN MON BUF
	POP	P,DEVUNI##(F)	;RESTORE DEVUNI (FOR INPUT-CLOSE)
	TLZ	F,RENMB+ENTRB	;SO CLOSE INPUT WONT THINK CLOSE OUTPUT WILL HAPPEN
	TLOE	S,IOSRDC	;IS FILE READING?
	JRST	RENM2C		;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
RENM2C:	PUSHJ	P,CLOSRN	;GO FINISH UP FILE
	TLZ	F,LOOKB		;ZERO LOOKB SO A FOLLOWING ENTER WILL SUCCEED
	LDB	T1,PUUOAC##	;GET CHAN NUM
	HLLM	F,USRJDA##(T1)	;UUOCON WONT SAVE LH(F)
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN
;HERE TO RENAME A FILE TO SOMETHING (NOT DELETE)
RENAM3:	JUMPL	T2,RENER1	;NDL FILE IF T2 NEG
	PUSHJ	P,TSTWRT	;CAN THIS FILE BE RENAMED?
	  JRST	RENR8A		;NO, ALREADY BEING WRITTEN - FBMERR
	PUSH	P,M		;SAVE LOC OF NAME
	HRRI	M,UUXPRV-UUXNAM(M)  ;POINT TO PROT WORD
	PUSHJ	P,GETWDU##	;GET IT
	SKIPE	T1		;TRYING TO CHANGE IT?
	XOR	T1,ACCPRV##(P2);MAYBE, XOR WITH ORIGINAL PROT
	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
IFN	FTSFD,<
	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	RENM3A		;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
RENM3A:	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	RENM3B		;NO
	SKIPLE	@SDVPPN##(T2)	;YES, IS THERE AN IMPLIED PPN?
	MOVE	P4,@SDVPPN##(T2) ;YES, USET IT IN SPITE OF WHAT E+3 SAYS
RENM3B:	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##
IFE FTDRDR,<
	CAME	P4,DEVPPN(F)	;SKIP IF PPN MATCHES
	JRST	RENER1		;NO, MAY NOT CHANGE DIR IF FTDRDR OFF
>
IFN FTDRDR,<
	CAMN	P4,DEVPPN(F)	;IF NOT CHANGING PPN
	TLNN	P1,200000	;IF TRYING TO CHANGE PROT AND CANT
	CAIA
	JRST	RENER1		;LOSE WITH PROT ERR
	CAMN	P4,DEVPPN(F)
>
	CAME	T1,DEVFIL(F)	;RENAMING TO SAME NAME?
	JRST	RENAM4		;NO
	PUSHJ	P,GETWD1##	;GET EXTENSION
	TRZ	T1,-1
	HLLZ	T2,DEVEXT(F)	;OLD EXTENSION
	XOR	T1,T2
IFN FTSFD,<
	SKIPL	(P)		;PATH SPECIFIED?
>
	JUMPE	T1,RENAM6	;NO, JUMP IF EXTENSIONS MATCH
;HERE WHEN CHANGING NAME, EXTENSION, OR DIRECTORY
RENAM4:	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	RENM4C		;YES, CONTINUE
	PUSHJ	P,EXTCK		;NO, RENAMING TO "UFD" OR "SFD"?
	  JRST	[TLO M,UUOREN	;ILLEGAL, LIGHT UUOREN FOR LKEWR2
		 HRRI	M,-1(M)	;DEC M FOR ERROR-CODE STORAGE
		 JRST	RENER1]	;AND GIVE ERROR RETURN
	HLRZ	T2,DEVEXT(F)	;NO, RENAMING FROM "UFD" OR "SFD"?
	PUSHJ	P,EXTCK
	  JRST	[TLO M,UUOREN	;ILLEGAL, LIGHT UUOREN FOR LKEWR2
		 HRRI	M,-1(M)	;DEC M FOR ERROR-CODE STORAGE
		 JRST	RENER1]	;AND GIVE ERROR RETURN
RENM4C:	HRRI	M,-1(T4)	;POINT M TO UUXPPN
	TLNN	M,EXTUUO	;EXTENDED UUO?
	HRRI	M,1+UUNPPN-UUNNAM(M)  ;NO. POINT TO PPN WORD
	SKIPE	T1,DEVMBF##(F)	;JOB HAVE MONITOR BUFFER?
	PUSHJ	P,GVMNBF##	;YES. RETURN IT (FNDFIL NEEDS MON BUF)
IFN FTDRDR,<
	CAMN	P4,DEVPPN(F)	;NEW PPN=OLD PPN?
	JRST	RENM4A		;YES
IFN	FTSFD,<
	PUSHJ	P,GETNMB	;GET L(NMB)
	MOVE	T1,NMBSFD##(T1)
	TRNE	T1,NMPSFD##	;IS FILE AN SFD?
	JRST	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)
>				;END CONDITIONAL ON FTDRDR
;HERE WHEN RENAME HAS BEEN CHECKED (IF CHANGING DIRECTORIES)
RENM4A:	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
IFN	FTSFD,<
	PUSH	P,M		;SAVE M
	HLR	M,P2		;POINT TO PPN
	PUSHJ	P,GTWST2##	;POINTING TO A PATH?
	SKIPLE	T1
	TLNE	T1,-1
	JRST	RENM4B		;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)
	PUSHJ	P,SETPTH	;SET UP NEW PATH
	  TLO	P3,-1		;ERROR
	POP	P,DEVUFB##(F)
	HRRM	P3,DEVACC##(F)	;RESTORE DEVACC
	JUMPL	P3,SETL5B	;GO IF AN ERROR
	HRRZ	T1,DEVSFD##(F)	;NEW SFD
	HLRZ	T2,DEVSFD##(F)	;OLD SFD
	CAME	T1,T2		;NEW SFD=OLD SFD?
	JRST	RENM4S		;NO, THIS REALLY DOES CHANGE SOMETHING
	PUSHJ	P,DECSFD	;YES, SETPTH COUNTED SFD USE-COUNT UP, SO
	SKIPL	-1(P)		; DECREMENT IT
	JRST	RENAM5		;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,CLSNAM
	JRST	RENM6A		;AND CONTINUE

;HERE ON A RENAME CHANGING SFD'S
RENM4S:	PUSHJ	P,GTUFR		;SFD EXIST ON THIS STR?
	  CAIA  		;NO, ERROR
	JRST	RENAM5		;YES, CONTINUE
	POP	P,M		;RESTORE M = LOC OF NAME
	HRRI	M,7(M)		;ERROR CODE SUBTRACTS 6
	JRST	RENR4C		;GIVE ERROR RETURN (SNF)
;HERE IF NO PATH IS GIVEN
RENM4B:	JUMPN	P4,RENAM5	;IF CHANGING PPN'S
	HLLZS	DEVSFD##(F)	; RENAME INTO THE UFD
	PUSHJ	P,SFDPPN	; IF NOT RENAMING TO DEFAULT
	CAME	T4,DEVPPN(F)	;RENAMING INTO DEFAULT DIRECTORY?
	JRST	RENAM5		;NO
	HRRM	T2,DEVSFD##(F)	;YES, SET UP SFD
	SKIPE	T1,T2		;IS THERE AN SFD?
	PUSHJ	P,INCUSA	;YES, INCREMENT ITS COUNTS
RENAM5:	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
	MOVE	P3,DEVUFB##(F)	;LOC OF UFB
	MOVE	P4,DEVUNI##(F)	;ADDR. OF UNIT DATA BLOCK
IFN FTSTR,<
	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	RENM5B		;NEW FILE NAME ALREADY EXISTS
IFN FTDRDR,<
	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
IFN FTDRDR,<
	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,RENAM7	;WAS QUOTA POSITIVE?
	SKIPGE	UFBTAL##(P3)	;YES, DID QUOTA BECOME HUGELY NEGATIVE?
	HRLOS	UFBTAL##(P3)	;YES (OVERFLOW). MAKE IT POSITIVE AGAIN
>
	JRST	RENAM7		;AND CONTINUE
RENM5B:	HRRM	P3,DEVUFB##(F)
	MOVE	T2,DEVACC(F)	;GET THE ACCESS TABLE
	MOVE	T2,ACCPPB(T2)	;GET THE PPB
	MOVE	T2,PPBNAM(T2)	;GET THE PPN
	CAME	T2,DEVPPN(F)	;HAS IT CHANGED IN THE DDB?
	MOVEM	T2,DEVPPN(F)	;YES, RESTORE OLD ONE
	PJRST	LKENR2		;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
RENAM6:	HRRI	M,-1(T4)	;POINT TO UUXPPN
	TLNN	M,EXTUUO	;EXTENDED UUO?
	HRRI	M,1+UUNPPN-UUNNAM(M)  ;NO. POINT TO PPN WORD
RENM6A:
	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	RENER3		;%YES, ERROR
	MOVEM	T1,ACCSTS##(P2)	;%NO. INDICATE RENAME IN PROGRESS
	PUSHJ	P,GVCBJ##	;%GIVE UP CB RESOURCE
	TLNE	S,IOSRIB	;PRIME RIB IN CORE?
	JRST	RENAM8		;YES, NO NEED TO READ IT
RENAM7:	PUSHJ	P,GTMNBF##	;GET A MONITOR BUFFER
	HLRZ	U,DEVUNI##(F)	;GET UNIT OF PRIME RIB
	HRRM	U,DEVUNI##(F)	;SAVE AS CURRENT UNIT
	PUSHJ	P,PRMRIB##	;SET UP TO READ PRIME RIB
	PUSHJ	P,MONRED##	;READ THE PRIME RIB
	JUMPN	T3,RENER6	;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	RENER6		;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
RENAM8:	HRRZ	T1,DEVMBF##(F)	;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	RENM8A		;NO. POINT TO ATT WORD
	HRRI	M,-<UUXPPN-1>(M)  ;POINT TO E
	PUSHJ	P,GETWDU##	;GET NO. OF ARGS
	HRR	P1,T1
	CAIGE	T1,RIBATT##	;SPECIFYING ATTRIBUTES?
	JRST	[JUMPG P1,RENDEA  ;OK IF CAN CHANGE ATT'S
		 HRRI	M,4(M)	;CAN'T - ERROR
		 JRST RENER4]
	HRRI	M,UUXPRV(M)	;MAYBE. POINT TO ATT WORD
RENM8A:	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,DEVMBF##(F)	;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,DEVMBF##(F)	;LOC OF MON BUF (-1)
	SKIPN	P3		;IF HI CREATION DATE = 0
	JUMPE	T2,RENAM9	; RIBATT = 0 MEANS NO CHANGE
	XOR	T2,RIBATT##+1(T3) ;COMPARE WITH RIB ATTR. WORD
	SKIPN	P4		;HI CREATION DATE THE SAME?
	JUMPE	T2,RENAM9	;YES, ALL THE SAME IF T2=0
IFN FTDRDR,<
	TLNN	M,UUOREN	;CHANGING DIRECTORIES?
	JRST	RENM8D		;YES, IT'S LEGAL
>
	TLNN	T2,777740	;IF PROTECTION AND MODE SAME
	TDNE	T1,[37,,-1]	;IF 0 LOW DATE
	JRST	RENM8C		;NO, A CHANGE
	TLNN	M,EXTUUO	; AND NOT EXTENDED
	JUMPE	P3,RENAM9	; AND HI DATE 0, WIN
RENM8C:	TLNE	T2,777000	;IF CHANGING PROTECTION
	MOVEI	T1,FNCCPR##	;REMEMBER THAT
	JRST	RENM8B		;WE ALREADY CHECKED FNCCAT OR FNCCPR
RENM8D:	TLZ	P1,-1		;INDICATE NO PROT ERROR
RENM8B:	HRRZ	T2,DEVMBF##(F)	;LOC OF MON BUF
	PUSH	P,T1		;GET PRIVS FROM USER
	PUSHJ	P,GTWST2##
	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	RENAM9		;NO
	PUSHJ	P,FNDUFB	;YES. FIND UFB FOR FILE
	  JRST	RENAM9		;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
RENAM9:	TLZE	P1,-1		;PROT ERR? (CAN'T CHANGE ATT, NOT CHANGING PROT)
	PJSP	T1,RENER4	;YES, LOSE
	HRRI	M,UUXALC-UUXPRV(M)  ;POINT TO ALLOCATION WORD
IFN FTDALC,<			;FANCY ALLOCATION CODE
	TLNE	M,EXTUUO	;EXTENDED UUO?
	CAIGE	P1,UUXALC	;YES. CHANGING ALLOCATION?
	JRST	RENRIB		;NO
	PUSHJ	P,GETWDU##	;SPECIFYING ALLOCATION?
	SKIPLE	T2,T1
	CAMN	T2,ACCALC##(P2)	;YES. ALLOCATION SAME AS BEFORE?
	JRST	RENRIB		;YES. NOT REALLY CHANGING IT
	MOVEI	T1,FNCALL##	;NO. CAN HE ALLOCATE/DEALLOCATE?
	CAMGE	T2,ACCWRT##(P2)
	MOVEI	T1,FNCTRN##	;OR TRUNCATE IF THROWING AWAY DATA BLOCKS
	MOVE	T1,ACCDIR##	;GET DIRECTORY WORD
	CAIN	T1,FNCTRN##	;IF TRUNCATING A DIRECTORY FILE
	TRNN	T2,ACPDIR##	;THEN GIVE PROTECTION FAILURE
	MOVE	T3,ACCDIR##(P2)	;GET DIRECTORY WORD
	MOVEI	T1,FNCTRN##	;ASSUME TRUNCATING
	CAML	T2,ACCWRT##(P2)	;RIGHT ?
	SKIPA	T1,[FNCALL##]	;NO, ALLOCATE
	TRNN	T3,ACCDIR##	;DON'T ALLOW UFD TRUNCATION
	PUSHJ	P,CHKPRV##	;CHECK IT
	  JRST	RENR4A		;CANT DO IT - ERROR
	MOVE	T1,ACCSTS##(P2)	;STATUS OF FILE
	TRNE	T1,ACMCNM	;OTHER READERS?
	JRST	RENR4B		;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,RENDEL	;DEALLOCATING IF NEGATIVE
	PUSHJ	P,UPDATA	;ALLOCATING - GET MORE
	  JRST	ENER1B		;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	RENRIB		;AND CONTINUE
;STILL IN CONDITIONAL ON FTDALC
;HERE TO DEALLOCATE/TRUNCATE ON A RENAME
RENDEL:
	PUSHJ	P,GTWDT3	;LAST BLOCK TO KEEP
	MOVEI	T2,0		;SET T2=0 (1ST BLOCK IN RIB IS 0)
RENLUP:	PUSHJ	P,SCNPT0##	;GO FIND POINTER TO LAST BLOCK DESIRED
	  JRST	RENDL1		;NOT IN THIS RIB, TRY NEXT
	MOVE	P3,P1		;SAVE NUMBER OF ARGS
	MOVE	P1,T1		;SAVE AOBJN POINTER IN P1
IFN FTDMRB,<			;IF MULTIPLE RIBS
	PUSH	P,DEVRIB##(F)	;SAVE POINTER TO CURRENT RIB
>
	PUSHJ	P,UPDGIV	;GO DEALLOCATE SOME BLOCKS
	  STOPCD .+1,DEBUG,TCI,	;++TRUNCATION CHECK INCONSISTENT
IFN FTDMRB,<
	POP	P,T1		;RESTORE PREVIOUS CURRENT RIB TO T1
	SKIPL	DEVRIB##(F)	;CURRENTLY IN PRIME RIB?
	JRST	RENLP1		;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	RENER6		;ERROR READING RIB
>	;END CONDITIONAL FTDMRB
RENLP1:	MOVE	P1,P3
	PUSHJ	P,CPYFST##	;COPY UPDATED POINTERS TO DDB
	JRST	RENER6		;RIB ERROR
>	;END CONDITIONAL ON FTDALC
;HERE WHEN ALLOCATION/DEALLOCATION IS THROUGH. SET UP FOR CLOSE
RENRIB:	TLO	M,UUOREN
	PUSHJ	P,SETVAL	;STORE ARGUMENTS FROM USER IN RIB
RENDEA:	MOVE	T1,DEVMBF##(F)	;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
	MOVSI	T1,DEPRAD##	;NO LONGER RENAMING ACROSS DIR
	ANDCAM	T1,DEVRAD##(F)
	PUSHJ	P,CLOSE1##	;CALL CLOSE CODE IN UUOCON
	POP	P,DEVBUF(F)
	LDB	T1,PUUOAC##	;GET CHAN NUM
	TLZ	F,ICLOSB	;CLEAR INPUT CLOSED INDICATION
	HLLM	F,USRJDA##(T1)	;SO SUBSEQUENT CLOSE WILL WIN
	TLNN	M,UPARAL	;PARTIAL ALLOCATION ERROR?
	AOS	(P)		;NO. SET FOR SKIP-RETURN
	SETZ	T1,
	DPB	T1,DEYFNC##	;CLEAR PROT SO WILL RECOMPUTE IT
	POPJ	P,		;RETURN TO USER

IFN FTDALC,<			;FANCY ALLOCATION CODE
;HERE WHEN WE HAVE TO SCAN ANOTHER RIB TO FIND THE CORRECT POINTER
RENDL1:
IFN FTDMRB,<			;IF MULTIPLE RIBS
	PUSHJ	P,PTRNXT##	;GET THE NEXT RIB
>
	  STOPCD .,JOB,NRM,	;++NEXT RIB MISSING
IFN FTDMRB,<			;IF MULTIPLE RIBS
	MOVE	T1,DEVMBF##(F)	;IOWD FOR MONITOR BUFFER
	MOVE	T2,RIBFLR##+1(T1) ;GET FIRST BLOCK NUMBER IN RIB
	PUSHJ	P,GTWDT3	;LAST BLOCK TO KEEP
	JRST	RENLUP		;SCAN THIS RIB
>	;END CONDITIONAL FTDMRB
>	;END CONDITIONAL ON FTDALC
IFN FTDALC,<			;FANCY ALLOCATION CODE
;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 CANT START WHERE REQUESTED
;EXIT CPOPJ1 IF GOT ANY BLOCKS (UPARAL MAY BE ON IN M)
UPDATA:
IFN FTDQTA,<
	HRRZ	T4,DEVUFB##(F)	;LOC OF UFB
	CAMG	T2,UFBTAL##(T4)	;DOES HE WANT MORE THAN HE CAN GET?
	AOJA	M,UPDAT2	;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
IFN FTDQTA,<
	TLO	M,UPARAL	;INDICATE PARTIAL ALLOCATION
>
UPDAT2:	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
	SKIPN	T1,DEVMBF##(F)	;RIB ALREADY IN CORE?
	PUSHJ	P,PTRGET##	;NO, READ IT
	PUSHJ	P,LSTUNI	;SET U TO LAST UNIT OF FILE
	PUSHJ	P,ALSTRT	;SET UP T1 FOR START ADR OF BLOCKS
	  JRST	TPOPJ##		;CANT START AT SPECIFIED LOCATION
	JUMPN	T1,UPDAT6	;NO START ADR. IF 0
	CAMG	T2,UNITAL##(U)	;DOES THIS UNIT HAVE ENOUGH FREE SPACE?
	JRST	UPDAT7		;YES. TRY TO GET IT
	MOVE	T3,UNISTR##(U)	;NO. POINT TO 1ST UNI IN STR
	HLRZ	T3,STRUNI##(T3)	;1ST UNIT
UPDAT4:	CAMG	T2,UNITAL##(T3)	;DOES THIS UNIT HAVE ENOUGH?
	JRST	UPDAT5		;YES. USE IT
	HLRZ	T3,UNISTR##(T3)	;NO. STEP TO NEXT UNIT IN STR
	JUMPN	T3,UPDAT4	;AND TRY IT
	TLO	M,UPARAL	;INDICATE REQUESTING MORE BLOCKS
	JRST	UPDAT7		;NO UNIT HAS ENOUGH. USE ORIGINAL UNIT
UPDAT5:	MOVE	U,T3		;SET UP NEW U
UPDAT6:	HRRM	U,DEVUNI##(F)	;SAVE IN DDB
	LDB	T3,UNYLUN##	;GET LOGICAL UNIT NUMBER
	TRO	T3,RIPNUB##	;INSURE NON-0
	MOVEM	T3,@DEVRET##(F)	;SAVE CHANGE-UNIT POINTER
	AOS	DEVRET##(F)	;POINT TO NEXT POINTER SLOT
;STILL IN FTDALC CONDITIONAL
UPDAT7:	PUSH	P,T1		;SAVE T1
	PUSHJ	P,UPDSET	;UPDATE DEYRLC, DEVRSU
	POP	P,T1		;RESTORE T1
	MOVE	T2,(P)		;AND T2
	SKIPG	DEVRSU##(F)	;DEVRSU ALREADY POSITIVE?
	PUSHJ	P,ENTALU	;NO, ALLOCATE SPACE FOR UPDATE
	  JRST	TPOPJ##		;ERROR RETURN
	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 UPDATA HAS ALLOCATED MORE SPACE
; (CANT BE DONE IN UPDATA 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
UPDSE2:	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
>	;END CONDITIONAL ON FTDALC

IFN FTDSIM,<
;SUBROUTINE TO READ RIB FOR UPDATE-ENTER
;RETURNS CPOPJ WITHOUT DA IF RIB ERROR
;RETURNS CPOPJ1 IF OK, WITH RIB IN CORE AND DA IF SIM UPDATE
SIMRIB:	SKIPE	DEVMBF##(F)	;IF WE HAVE THE MON BUF,
	JRST	CPOPJ1##	;ALL IS OK
	PUSHJ	P,GTMNBF##	;GET IT
	MOVE	T1,DEVACC##(F)	;A.T. LOC
	MOVE	T1,ACCSMU##(T1)	;IF A SIMULTANEOUS UPDATE FILE,
	TRNE	T1,ACPSMU	; GET THE DA RESOURCE BEFORE READING RIB
	PUSHJ	P,UPDA##	; AS PROTECTION AGAINST RACE CONDITIONS
	PUSHJ	P,REDRIB##	; INVOLVED IN REWRITING RIBS
	  JRST	DOWNIF##	;ERROR READING RIB - GIVE UP
	MOVEI	T1,DEPWRT##	;INDICATE THIS IS A
	IORM	T1,DEVWRT##(F)	; WRITING DDB
	JRST	CPOPJ1##	;TAKE GOOD 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
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,200
	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:	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,DEVMBF##(F)	;LOC OF MONITOR BUFFER
	PUSH	P,U		;SAVE CURRENT U
IFN FTDBBK,<
IFN FTDMRB,<	;IF MULTIPLE RIBS
	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
	HRRZ	T1,RIBELB##+1(P1)  ;JUST BLOCK NUMBER(CLEAR CONI BITS IN LH)
	HRRZ	T2,RIBNBB##+1(P1)	;GET NO OF BAD BLOCKS IN REGION
	PUSHJ	P,TAKBLK##	;MARK THEM AS TAKEN
	  JFCL
>				;END CONDITIONAL ON FTDBBK

DELRB3:	HRRZ	U,DEVUNI##(F)	;SET U TO CURRENT UNIT
	PUSHJ	P,WTUSAT	;WRITE CHANGED SATS
	HLRZ	U,DEVUNI##(F)	;SET U TO 1ST UNIT
	HRRM	U,DEVUNI##(F)	;SAVE IN DDB
	PUSHJ	P,WTUSAT	;GO WRITE SATS FOR THIS UNIT IF NOT CURRENT UNIT
	POP	P,U		;RESTORE CURRENT U
	HRRM	U,DEVUNI##(F)	;RESET DDB
IFN FTDMRB,<	;IF MULTIPLE RIBS
	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?
>	;END CONDITIONAL FTDMRB
	PJRST	CPOPJ1##	;NO, EXIT
IFN FTDMRB,<	;IF MULTIPLE RIBS
	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
>	;END CONDITIONAL FTDMRB
;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

IFN FTDALC,<			;FANCY ALLOCATION CODE
ALSTRT:	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
>	;END CONDITIONAL ON FTDALC


;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
IFN FTDALC,<			;FANCY ALLOCATION CODE
	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
>	;END CONDITIONAL ON FTDALC

;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
IFN FTDQTA,<
	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
IFN FTDALC,<
ENTALU:	PUSHJ	P,TAKBLK##	;GET ANY BLOCKS (NOT STARTING AT A SUPER-CLUSTER
	  POPJ	P,		;CANT START WHERE SPECIFIED
 	JRST	ENTAL1		;GOT SOME - CONTINUE
>	;END CONDITIONAL ON FTDALC

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:	MOVEM	T2,@DEVRET##(F)	;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:
IFE FTDALC,<
	TLO	M,UPARAL
>
IFN FTDALC,<
	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
	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
>	;END CONDITIONAL ON FTDALC

;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
;ENTER AT SETVAN FROM ENTER, WITH UUO=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 UUO TO PRIVS WORD
SETVAN:	PUSHJ	P,SAVE1##
	CAILE	P1,UUXENX	;YES. ALL ARGUMENTS ARE LEGAL
	MOVEI	P1,UUXENX
	PUSHJ	P,PRVJB##	;PRIVILEGED JOB?
	  JRST	SETVA1		;NO, NOT ALL ARGUMENTS ARE LEGAL
	HLRZ	T1,DEVEXT(F)	;GET EXTENSION
	CAIN	T1,'UFD'	;RIBUSD ONLY MEANINGFUL FOR UFD
	CAIGE	P1,UUXUSD	;MIGHT UUXUSD BE IN ENTER BLOCK?
	JRST	SETVA2		;NO
	HRRI	M,UUXUSD-UUXPRV(M)  ;YES. POINT TO USD ARGUMENT
	PUSHJ	P,GTWST2##	;JOB WANT USD COMPUTED?
	JUMPGE	T1,SETVA0	;NOT IF 0
	PUSHJ	P,FNDUFB	;YES. FIND UFB FOR PRJ-PRG
	  SKIPA	T3,DEVMBF##(F)	;NOT THERE - USE OLD RIBUSD
	SKIPA	T3,DEVMBF##(F)	;%FOUND - GET LOC OF MON BUF
	SKIPA	T1,RIBUSD##+1(T3) ;OLD RIBUSD
	SKIPA	T1,RIBQTF##+1(T3) ;%FOUND - GET OLD QTF
	TDZA	T3,T3		;NOT FOUND - SET T3=0 AS A SWITCH
	SUB	T1,UFBTAL##(T2)	;%FOUND,  OLD FCFS-CURRENT QUOTA LEFT
	PUSHJ	P,PUTWDU##	;%=NEW USD VALUE
	SKIPE	T3		;%IF UFB WAS FOUND,
	PUSHJ	P,GVCBJ##	;%RETURN CB RESOURCE
SETVA0:	HRRI	M,-<UUXUSD-UUXPRV>(M)  ;POINT UUO TO ALC WORD AGAIN
	JRST	SETVA2		;AND GO STORE USER-SUPPLIED ARGS
SETVA1:	SKIPA	T3,[200777,,-1]	;ONLY ARGS THROUGH UUXLNA MAY BE SUPPLIED
;HERE WITH P1=NUMBER OF ARGUMENTS USER IS SUPPLYING
SETVA2:	MOVE	T3,[XWD 202260,20020];BITS ON FOR ARGS WHICH CANT BE SUPPLIED BY USER
	TLNE	M,UUOREN	;RENAME?
	TLO	T3,400000	;YES, CRE-DATE, PRIVS ALREADY CORRECT IN MON-BUF
	MOVE	T2,DEVMBF##(F)
	HRRZ	T4,RIBFIR##+1(T2) ;NO OF VALUES IN FILE
	JUMPE	T4,SETV2A
	CAILE	P1,-1(T4)	;USER SUPPLYING MORE?
	MOVEI	P1,-1(T4)	;YES, DON'T LET HIM (OLD FILE)
SETV2A:	MOVNI	T1,-UUXPRV+1(P1) ;T1=-NUMBER AF ARGS TO STORE
	HRRZ	T2,DEVMBF##(F)	;LOC OF MON BUF
	ADDI	T2,RIBPRV##+1	;POINT TO PRIVS WORD
	HRLM	T1,T2		;SAVE NUMBER IN LH(T2)
SETVA3:	JUMPG	T3,SETVA4	;PROTECTED ARGUMENT?
	MOVE	T1,(T2)		;YES, GET VALUE FROM RIB
	PUSHJ	P,PUTWDU##	;STORE IN USERS AREA
	JRST	SETVA5		;CONTINUE
SETVA4:	PUSHJ	P,GTWST2##	;GET AN ARG FROM USER
	MOVEM	T1,(T2)		;SAVE IT IN RIB
SETVA5:	HRRI	M,1(M)		;STEP TO NEXT ARG
	LSH	T3,1		;SET NEXT CANT-SUPPLY BIT IN T3
	AOBJN	T2,SETVA3	;GO IF HE WANTS ANOTHER
	MOVE	T1,DEVMBF##(F)	;MAKE SURE NO-DELETE BIT OFF
	MOVE	T2,DEVACC##(F)
	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
	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
	CAIL	P1,UUXUSD	;CHANGING QUOTA ?
	PUSHJ	P,PRVJB		;AND ALLOWED TO ?
	  PJRST	GVCBJ##		;NO, RETURN
	MOVE	T1,DEVMBF##(F)	;%FOUND IT - L(MON BUF)
	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
;SUBROUTINE TO ZERO THE RETRIEVAL POINTERS IN THE DDB
;RESPECTS T1,T2,T3
DDBZR::
IFN FTDMRB,<
	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)
	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,DEVMBF##(F)	;LOC OF MON BUF
	MOVEM	T2,RIBUFD##+1(T1) ;SAVE ADR IN RIB
FBMLOC:	POPJ	P,FBMERR	;AND RETURN

SETUF1:
IFN	FTSFD,<
	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
IFN FTSTR,<	;IF MORE THAN ONE STR
	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
	SLCKFS	(T1)		;%GOOD FSN?
>
	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
;ERROR STUFF
IFN	FTLIB,<
ILNMEN:	MOVE	J,JOB##
	POP	P,JBTSFD##(J)
	JRST	ILNMER
>
UILNMR:
	PUSHJ	P,GVCBJ##
	TLO	M,UUOREN	;TELL ILNMER NOT TO CHANGE T1
	MOVEI	T1,ISUERR	;UPDATE, LOOKUP NAME NOT SAME AS ENTER NAME
IFE	FTLIB,<
ILNMEN:
>
ILNMER:	TLZN	M,UUOREN	;IS ERROR CODE ALREADY IN T1?
	MOVEI	T1,FNFERR
	AOJA	M,LKENR2
UPDER4:
	PUSHJ	P,GVCBJ##
	MOVEI	T1,FCUERR
	JRST	LKENER
UPDR3A:	HRRI	M,-10(M)	;RESET M FOR ERROR CODE DEPOSIT
RENER3:
UPDER3:
	PUSHJ	P,GVCBJ##
	SKIPA	T1,FBMLOC

NTFOUN:	MOVEI	T1,FNFERR
LKENER:
IFN FTSPL,<
	SKIPGE	DEVSPL(F)	;SPOOL-MODE?
	POPJ	P,		;YES, IMMEDIATE RETURN
>
	HRRI	M,-2(M)		;RESET M FOR ERROR CODE DEPOSIT
LKENR1:	TLNE	M,EXTUUO
	HRRI	M,4(M)		;BUMP M FOR EXTENDED FORMAT
LKENR2:	MOVE	T3,T1
	PUSHJ	P,GETWDU##
	HRR	T1,T3
	PUSHJ	P,PUTWDU##
	TLNN	M,UUOUPD	;IF NOT AN UPDATE (E.G. FILE NOT OPEN)
	PUSHJ	P,TSTPPB	;CLEAR OUT PPB IF NOT LOGGED-IN
IFN	FTSFD,<
	HRRZ	T1,DEVSFD##(F)	;JOB HAVE AN SFD?
	JUMPE	T1,LKENR3
	HLRZ	T2,DEVSFD##(F)	;YES, 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	;YES, DECREMENT USE-COUNTS
LKENR3:	HLRZS	DEVSFD##(F)	;MAKE SURE NO NEW DIRECTORY
>
	SKIPE	T1,DEVMBF##(F)	;JOB HAVE MONITOR BUFFER?
	PJRST	GVMNBF##	;YES. RETURN IT AND EXIT
AEFLOC:	POPJ	P,AEFERR	;NO. RETURN
ENER1X:
IFN FTSFD,<
	PUSHJ	P,DECMST
>
	JRST	ENER1C
ENERR1:
ENER1A:
IFN FTSFD,<
	PUSHJ	P,DECMST
>
	POP	P,T2
ENER1B:	JUMPE	T1,ENER1C
	MOVEI	T1,BNFERR
	JRST	ENER1D
ENER1E:	SKIPA	T1,[TRNERR]
ENER1C:	MOVEI	T1,NRMERR
ENER1D:	HRRI	M,-1(M)		;DECREMENT M FOR ERROR CODE
	TLNE	M,EXTUUO	;EXTENDED FORMAT?
	HRRI	M,-<UUXALC-UUXEXT+1>(M)  ;USE, DIDDLE M APPROPRIATELY
ENER1F:	PUSH	P,T1
	TLNE	S,IOSDA
	PUSHJ	P,DWNDA##
	HRRZ	T1,DEVACC##(F)
	TLNN	M,UUOREN	;RENAME?
	JRST	ENER1G
	PUSHJ	P,DECRDR	;YES, DECR READ COUNT
	  JFCL
	PUSHJ	P,GVCBJ##	;%
	HLLZS	DEVACC##(F)	;CLEAR DEVACC
	TRNN	T2,ACMCNT	;DONT RETURN A.T. TO FREE CORE IF OTHER READERS
ENER1G:	PUSHJ	P,ATRMOV##
	POP	P,T1
	JRST	LKENR2

RENER5:	SKIPA	T1,WLKLOC	;WRITE LOCK ERROR
RENER0:				;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
	ADDI	M,3
	JRST	LKENR2
ENERR2:	TLNE	S,IOSDA
	PUSHJ	P,DWNDA##
IFN FTSFD,<
	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
RENERR:	MOVEI	T1,FNFERR	;FILE NOT FOUND
	JRST	TSTWD0		;DETERMINE WHERE TO STORE THE ERROR

UPDR2A:	HRRI	M,-7(M)
UPDER2:
	PUSHJ	P,GVCBJ##
RENER7:	MOVEI	T1,PRTERR	;PRIVS WON'T ALLOW UPDATE
	JRST	LKENER
RENR4B:	SKIPA	T3,FBMLOC
RENR4C:	MOVEI	T3,SNFERR
	SETZ	T1,

RENR4A:	HRRI	M,-5(M)
RENER4:	MOVEI	T2,ACPREN
	ANDCAM	T2,ACCSTS##(P2)
	SKIPN	T1		;NON-0 FROM CHKPRV
	SKIPA	T1,T3
	MOVEI	T1,PRTERR	;RENAME, NOT DELETE. NO PRIVS
	HRRI	M,-1(M)
	JRST	LKENR2
RENER6:	MOVEI	T1,ACPREN
	ANDCAM	T1,ACCSTS##(P2)
	MOVEI	T1,TRNERR
	JRST	LKENER



RENER8:
	PUSHJ	P,GVCBJ##	;%
RENR8A:	SKIPA	T1,FBMLOC	;ATTEMPT TO DELETE A FILE BEING UPDATED
RENER1:	MOVEI	T1,PRTERR
	AOJA	M,LKENR2
FUUEND:	END