Google
 

Trailing-Edge - PDP-10 Archives - bb-bt99h-bb - filfnd.x14
There are 3 other files named filfnd.x14 in the archive. Click here to see a list.
TITLE FILFND LEVEL D DISK SERVICE ROUTINE  V770
SUBTTL DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW 20 MAY 86
	SEARCH	F,S
	$RELOC
	$HIGH



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
.CPYRT<1973,1986>
;COPYRIGHT (C) 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986
;BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
;ALL RIGHTS RESERVED.
;
;
XP VFLFND,770

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



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

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

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

;IOSERR=IOSHRE+IOSHWE+IOSSCE
;IOSMER=-IOSERR
DEFINE	NOSCHEDULE <>
DEFINE SCHEDULE <>
IFE	FTCBDB,<
DEFINE	CBDBUG(A,B) <>
>

IFN	FTCBDB,<
DEFINE	CBDBUG(A,B)<
	AOSA	.+1
	0
IFIDN	<A>,<Y><
	EXCH	T1,CBUSER##
	CAME	T1,.CPJOB##
	HALT	.
	EXCH	T1,CBUSER##
>
IFIDN	<B>,<Y><
	PUSHJ	P,CKBAS
>
>
>


REPEAT 0,<
ASSUME NO EXEC-MODE RESCHEDULING


RULES:
NN  CAN READ WITHOUT CB RES WRITE WITHOUT
NC  CAN READ WITHOUT, NEED CB TO WRITE
CN  NEED CB TO READ, CAN WRITE WITHOUT
CC  NEED CB TO READ, NEED CB TO WRITE

PPBNAM##		NC
PPBSYS##		CC	(LINK)
PPBKNO##,YES	CC
PPBUFB##		CC
PPBLOK##		NN
PPBNMB##		CC
PPBNLG##		NN

UFBTAL##		NN
UFBPPB##		CC	(LINK)
UFBRRV		NN
UFBUN1##,1PT	NN
UFBFSN		NC
UFBPT1##		NN
UFBWRT##		NN
UFBQTF		NN

NMBNAM##		NC
NMBPPB##		CC	(LINK)
NMBKNO##,YES	CC
NMBFSN##,CFP	NN
NMBEXT##		NC
NMBNMB##		CC	(SFD)
NMBACC##		CC
NMBSFD##		NC
NMBGRB##		NC

ACCAKB##		NC
ACCPPB##		NC
ACCNMB##		CC	(LINK)
ACCSTS##		NC	(STS+NIO+REN+DEL)
ACCCNT##		NN
ACCUSE##		NC	(SFD)
ACCFSN##		NC
ACCWRT##		NN
ACCDOR##		CC

ACCALC##		NN
ACCADT##		NN
ABC		NN
LBS		NN
1PT		NN
UN1,PT1,DIR	NC
NDL		NC
SBC		NN
PRV		NN
MOD,CTM,CDT	NN

>
IFN	FTCBDB,<
;INTEGRITY CHECKER FOR IN-CORE DATA BASE
;ERROR DETECTED - HALT
;PRESERVES ALL ACS

;ROUTINE TO CHECK AN ADDRESS
;CKADR RETURNS CPOPJ1 IF 0, ELSE CPOPJ
;CKADN HALTS IF 0 ELSE CPOPJ
;CKADF CHECKS THAT THE BLOCK IS NOT ON THE FREE-CORE LIST
;HALT IF ADDR OUT OF RANGE OR ON FREE-CORE LIST
;WIPES OUT P4
CKADR:	JUMPE	P2,CPOPJ1##
CKADN:	SKIPN	P2
	PUSHJ	P,CKBAD
	CAILE	P2,PATCH##
	CAMLE	P2,SYSSIZ##
	PUSHJ	P,CKBAD
CKADF:	HLRZ	P4,SYSCOR##
CKAD1:	JUMPE	P4,CPOPJ##
	CAIN	P4,(P2)
	PUSHJ	P,CKBAD
	HLRZ	P4,CORLNK##(P4)
	JRST	CKAD1
CKBAD:	HALT	.


;DRIVER FOR INTEGRITY CHECKER
;PRESERVES ALL ACS

CKBAS::	PUSHJ	P,SAVE4##
	HLRZ	P2,SYSPPB##
	JUMPE	P2,CPOPJ##

CKBA1:	PUSHJ	P,CKADN		;NEXT PPB
	MOVE	P1,P2
	HLRZ	P2,PPBUFB##(P1)
CKBA2:	PUSHJ	P,CKADR		;NEXT UFB
	  HLRZ	P2,UFBPPB##(P2)
	JUMPN	P2,CKBA2

	HLRZ	P2,PPBNMB##(P1)
CKBA3:	PUSHJ	P,CKADR		;NEXT NMB
	  SKIPA	P3,P2
	JRST	CKBA7
	HLRZ	P2,NMBACC##(P2)
CKBA4:	PUSHJ	P,CKADN		;NEXT A.T.
	TRZE	P2,DIFNAL##
	JRST	CKBA5
	HLRZ	P2,ACCNMB##(P2)
	JRST	CKBA4

CKBA5:	HLRZ	P3,NMBRNG##(P2)
	JUMPE	P3,CKBA6
	MOVE	P2,P3
	TRZN	P2,NMPUPT##
	JRST	CKBA3
CKBA6:	HLRZ	P2,NMBPPB##(P2)
	TRZE	P2,NMPUPT##
	JRST	CKBA6
	JUMPN	P2,CKBA3
CKBA7:	HLRZ	P2,PPBSYS##(P1)
	JUMPN	P2,CKBA1

	HRRZ	P2,SYSPPB##	;RH(SYSPPB) 0
	JUMPE	P2,CKBA9
	HLRZ	P1,SYSPPB##	;OR MUST POINT TO
CKBA8:	CAIN	P1,(P2)		; SOME PPB
	JRST	CKBA9
	HLRZ	P1,PPBSYS##(P1)
	JUMPN	P1,CKBA8
	HALT	.		;IT DOESN'T - HALT

	HLRZ	P2,SYSDOR##
	MOVEI	P1,SYSDOR##
CKBAC:	PUSHJ	P,CKADR
	  SKIPA P3,ACCDOR##(P2)
	POPJ	P,
	CAIE	P1,(P3)
	HALT	.
	MOVE	P1,P2
	HLRZ	P2,ACCDOR##(P2)
	JRST	CKBAC

>	;END FTCBDB CONDITIONAL
	SUBTTL	HIGH AVAILABILITY UUO ERROR RETURNS

;ERROR CODES RETURNED BY HIGH AVAILABILITY UUOS

.ERDIP==1			;KONTROLLER/CHANNEL OFF-LINE ALREADY IN PROGRESS
.ERNSK==2			;NO SUCH KONTROLLER
.ERPSS==3			;PROBLEM WITH SWAPPING SPACE
.ERUIS==4			;UNIT IS IN A FILE STRUCTURE
.ERNES==5			;NOT ENOUGH SPACE FOR IOWDS

;ADD SWAPPING UNIT ERROR CODES
.ERNSU==1			;NO SUCH UNIT
.ERAIS==2			;ALREADY IN SWAPPING LIST
.ERSIF==3			;SWPTAB IS FULL
.ERNM4==4			;BLOCKS/CYLINDER NOT MULTIPLE OF 4
.ERNSS==5			;NO SWAPPING SPACE ON PACK

ERCODE	HIAARP,.ERDIP		;SETTING OFF-LINE ALREADY IN PROGRESS
ERCODE	HIANSK,.ERNSK		;NO SUCH CONTROLLER
ERCODE	HIANES,.ERPSS		;NOT ENOUGH SWAPPING SPACE IF CONTROLLER OFF-LINE
ERCODE	HIAUFS,.ERUIS		;UNIT IN A F.S. CANNOT BE PUT OFF-LINE
ERCODE	HIANEL,.ERNES		;NOT ENOUGH LOW CORE 4-WORD IOWD SPACE AVAILABLE
ERCODE	HIANSU,.ERNSU		;NO SUCH UNIT
ERCODE	HIAAIS,.ERAIS		;ALREADY IN SWAPPING LIST
ERCODE	HIASIF,.ERSIF		;SWPTAB IS FULL
ERCODE	HIANM4,.ERNM4		;BLOCKS/CTL NOT MULTIPLE OF 4
ERCODE	HIANSS,.ERNSS		;NO SWAPPING
SUBTTL	HIGH-AVAILABILITY UUOS
SOONDN::SKIPE	MIGRAT##	;A KONTROL/CHAN ALREADY BEING TAKEN DOWN?
	JRST	HIAARP		;YES, CANT DO 2 AT ONCE
	PUSHJ	P,DWNKON	;NO, GET 1ST UNIT ON KONTROLLER
	  JRST	HIANSK		;NO SUCH KONTROLLER
	MOVEI	T3,0		;T3 WILL ACCUMULATE SWAPPING SPACE
SOOND1:	PUSHJ	P,NXDWN		;GET 1ST (OR NEXT) UNIT
	  JRST	SOOND2		;END
	  JRST	SOOND1		;NOT A SWAPPING UNIT
	LDB	T1,UNYK4S##	;GET AMOUNT OF SWAP SPACE ON UNIT
	LSH	T1,K2PLSH##	;CONVERT TO K
	ADD	T3,T1		;ACCUMULATE
	JRST	SOOND1		;AND TEST NEXT UNIT

SOOND2:	CAML	T3,VIRTAL##	;TRYING TO REMOVE TOO MUCH SWAP SPACE?
	JRST	HIANES		;YES, ERROR RETURN
	JUMPE	T3,SOOND5	;NO, GO IF NO SWAP UNITS
	MOVNS	T3		;SWAPPING UNITS, REDUCE VIRTAL
	SKIPGE	T4		;IF REMOVE SWAP SPACE
	SKIPA	T4,T3		;SAVE VIRTAL, DECREMENT LATER
	ADDM	T3,VIRTAL##
	PUSH	P,P1
	PUSH	P,T4		;SAVE SOME ACS
IFN FTMP,<
	PUSHJ	P,UPMM##	;GET MEMORY MANAGEMENT RESOURCE
>
	MOVE	P1,SEGPTR##
SOON2A: MOVSI	T1,400000	;IF TAG NO SWAP SPACE (-INF)
	MOVEM	T1,UNIFKS##(U)	;..
SOON2B:
SOON2C:
IFN FTMP,<
	PUSHJ	P,DWNMM##
>
	POP	P,T4
	POP	P,P1
	MOVE	J,.CPJOB##	;RESTORE ACS
IFN	FTIPCF,<
	MOVEI	T2,JOBMAX##
	MOVNM	T2,MIGRAT	;FLAG WORKING ON IPCF STUFF
>
	MOVEI	T2,1		;SET A FLAG SO JOBS WILL
IFE	FTIPCF,<
	MOVEM	T2,MIGRAT##	; BE SWAPPED OFF THE BAD UNIT(S)
>
	MOVEI	T1,JS.MIG	;CLEAR BIT IN EACH JOBS STATUS WORD
SOOND3:	ANDCAM	T1,JBTST2##(T2)	;BIT WILL BE SET WHEN JOB HAS SWAPPED
	CAMG	T2,HIGHJB##	; SO IS NO LONGER ON THE BAD UNIT
	AOJA	T2,SOOND3
SOOND5:	HLL	T3,UNISWP##(U)
	TLNN	T3,-1
	HLL	T3,SWPUNI##	;ENSURE SWPUN2 ISNT POINTING AT A REMOVED UNIT
	HLRZ	T2,SWPUN2##
	CAIN	T2,(U)
	HLLM	T3,SWPUN2##
	HLRZ	T2,NXTSUN##	;ENSURE NXTSUN ISNT POINTING AT A REMOVED UNIT
	CAIN	T2,(U)
	HLLM	T3,NXTSUN##
IFN FTIPCF,<
	PUSH	P,T4		;SAVE ENTRY FLAG
	PUSH	P,U
SOON5A:
IFN FTMP,<
	PUSHJ	P,UPMM##
>
	PUSHJ	P,BMSLST##	;MAKE EVERYTHING ON PAGE QUEUES GO OUT
IFN FTMP,<
	PUSHJ	P,DWNMM##	;OK TO RELEASE MM NOW AS PAGING I/O WILL WAIT
>				;FOR MIGRATE TO PASS
SOON5B:	SKIPN	PAGIPQ##	;I/O IN PROGRESS NOW?
	JRST	SOON5D		;NO
	MOVEI	T1,^D1		;SLEEP A BIT
	PUSHJ	P,SLEEPF##
	JRST	SOON5B
SOON5D:
	SKIPN	PAGINC##	;MAKE SURE ALL QUEUES FLUSHED
	SKIPE	PAGSNC##
	JRST	SOON5A		;TRY AGAIN
IFN FTMP,<
	PUSHJ	P,UPMM##	;NEED THE MM AGAIN
>
	PUSHJ	P,FLSOPQ##	;FLUSH "OUT" QUEUE - PUT PAGES ON FREE CORE LIST
IFN FTMP,<
	PUSHJ	P,DWNMM##
>
	POP	P,U		;RESTORE U
	SKIPA	T1,[FNDIPC##]	;START AT THE VERY BEGINNING
SOOND6:	MOVEI	T1,FNDIP0##	;DON'T START AT THE TOP AGAIN
	PUSHJ	P,(T1)		;ANY IPCF PAGES ON THE UNIT?
	  JRST	SOOND7		;NONE OR ALL HAVE BEEN MIGRATED
	MOVE	J,.CPJOB##	;GET JOB # BACK
	PUSH	P,T1		;SAVE ADDRESS IN PACKET OF DISK ADDRESS OF PAGE
	PUSH	P,T4		;SAVE DISK ADDRESS OF THE PAGE
IFN FTMP,<
	PUSHJ	P,UPMM##	;MUST HAVE THE MM RESOURCE
>
IFN FTXMON,<
	XJRST	 [MCSEC1+.+1]	;MUST BE IN SECTION 1
>
	MOVEI	T3,1		;GET ONE PAGE OF PHYSICAL MEMORY
	PUSHJ	P,GETPHP##	; ..
	SSX	T1,MS.MEM	;SET SECTION INDEX FOR PAGTAB
	MOVSI	T2,MONTRB+TNCSHB;GETPHP TURNED THESE BITS ON
	ANDCAM	T2,PAGTAB(T1)	;CLEAR THEM
	MOVSI	T2,IPCBIT	;THIS WILL BE AN IPCF PAGE
	IORM	T2,PAGTAB(T1)	;SO INDICATE THAT BY SETTING THE BIT
	POP	P,T4		;RESTORE DISK ADDRESS
	TLO	T4,(MT.LEF)	;MAKE MEMTAB ENTRY
	MOVEM	T4,MEMTAB(T1)	;STORE IT
IFN FTMP,<
	PUSHJ	P,DWNMM##	;GIVE UP THE MM
>
IFN FTXMON,<
	JRST	@[0,,.+1]	;BACK TO SECTION 0
	HRRZS	T1		;CLEAR SECTION NUMBER
>
	PUSH	P,T1		;SAVE PHYSICAL PAGE
	LSH	T1,11		;POSITION PAGE NUMBER FOR A SWPLST ENTRY
	TDO	T1,[SL.IPC+1]	;MAKE A SWPLST ENTRY FOR SWAP-IN
	PUSHJ	P,PAGEIT##	;SWAP IN THE IPCF PAGE
	  JFCL			;**********PAGING I/O ERROR
	POP	P,T2		;RESTORE PHYSICAL PAGE NUMBER
	PUSHJ	P,IPCPAG##	;PAGE OUT THE PAGE ON A NEW UNIT
	  JFCL			;**********PAGING I/O ERROR
	POP	P,T1		;RESTORE ADDRESS IN THIS PACKET
	MOVEM	T2,(T1)		;STORE PAGE NUMBER ON NEW UNIT
	PUSHJ	P,IPCULK##	;RELEASE IPCF INTERLOCK FOR THIS JOB
	JRST	SOOND6		;SEE IF ANY MORE IPCF PAGES ON THE UNIT
SOOND7:	MOVEI	T4,1		;NOW FLAG WORKING ON JOBS
	MOVEM	T4,MIGRAT##
	POP	P,T4		;RESTORE ENTRY FLAG
>;END IFN FTIPCF
	JUMPL	T4,REMSW2	;GO BACK IF CALLED FROM REMSWP
	HLRZ	T2,SWPUNI##	;MAKE SURE SWPUNI ISNT POINTING AT A REMOVED UNIT
	CAIN	T2,(U)		; (IF REMSWP WE WILL UNLINK IT LATER)
	HLLM	T3,SWPUNI##
	MOVSI	T1,UNPNNA##	;GET THE BIT
	IORM	T1,UNIUST##(U)	;INDICATE NO NEW ACCESSES FOR EACH UNIT
IFN FTMDA,<
	SETZM	UNILTM##(U)	;CLEAR LOCKTIME
> ;END IFN FTMDA
	HLRZ	U,UNICHN##(U)	;STEP TO NEXT UNIT ON CHAN
	CAME	U,T4		;AND SET NNA FOR IT
	JRST	SOOND5
	JRST	CPOPJ1##	;DONE, GOOD RETURN
NOWDWN::PUSHJ	P,DWNKON	;GET KONTROLLER, 1ST UNIT
	  JRST	HIANSK		;NO SUCH KONTROLLER
	SKIPE	MIGRAT##	;STILL SWAPPING ON UNIT?
	JRST	HIANES		;YES, ERROR RETURN
	MOVSI	T3,UNPNNA##	;NO, WAS NNA LIT FOR THE UNIT/CHAN?
	TDNN	T3,UNIUST##(U)
	JRST	HIAARP		;HAVE TO LIGHT NO NEW ACCESSES FIRST
	PUSHJ	P,SAVE4##	;IF DODELE WONT SAVE ACS WE WILL
NOWDW1:	PUSHJ	P,NXDWN		;GET 1ST, OR NEXT, UNIT ON CHAN
	  JRST	NOWDW3		;NO MORE
	  JRST	NOWDW2		;NOT A SWAPPING UNIT
IFN FTMP,<
	PUSHJ	P,GGVMM##	;GET MM
>
	PUSH	P,T4
	MOVEI	P2,-1		;DELETE ALL DORMANT SEGS ON THE
	PUSHJ	P,DODELE##	; UNIT
	  JFCL
	POP	P,T4

NOWDW2:	HRRZ	T1,UNISTR##(U)	;UNIT IN A FILE STRUCTURE?
	JUMPN	T1,HIAUFS	;UNIT MUST NOT BE IN A STR
	JRST	NOWDW1		;NO, TEST NEXT UNIT ON CHAN
NOWDW3:
IFN FTKL10,<
	PUSHJ	P,GCH4WD##	;GET A 4-WORD LOW CORE BLOCK FOR IOWDS
	  JRST	HIANEL		;NOT ENOUGH SPACE
>
IFN FTKS10,<
	SETZ	T1,		;DON'T NEED LOW-CORE SPACE FOR UNIBUS
>
	AOS	(P)		;GOOD RETURN
	JRST	STOTAC##	;TELL USER IOWD LOC AND RETURN
;REMOVE DISK UNIT FROM SWAPPING LIST
;CALL WITH
;(T1) = FUNCTION,DRIVE ADDR
;(M) = RH = ADD (RPA?)
REMSWP::SKIPE	MIGRAT##	;ALREADY BEING TAKEN DOWN
	  JRST	HIAARP		;YES, ERROR
	PUSHJ	P,GETWDU##	;GET DRIVE NAME FROM USER
	JUMPE	T1,[SETO U,	;REMOVE 'DEAD' UNITS
		    JRST REMSW1]
	SETO	T2,		;UNIT NAMES ARE 6 CHARS
	PUSHJ	P,SRUNI		;SET UP UDB IN U
	  JRST	HIANSU		;NO SUCH UNIT
	  JRST	HIANSU		;LOGICAL MATCH
	SKIPL	UNIPTR##(U)	;UNIT IN ASL?
	JRST	CPOPJ1		;NO, RETURN IMMEDIATELY
REMSW1:	MOVSI	T3,MSWPMX##	;GET LENGTH OF SWPTAB
	CAME	U,SWPTAB##(T3)	;IS UNIT IN TABLE?
	AOBJN	T3,.-1		;NOT HERE, TRY NEXT
	JUMPGE	T3,CPOPJ1##	;NOT AT ALL, QUIT
	SETO	T4,		;MARK THIS ROUTINE
	JUMPL	U,SOOND2	;DEALLOCATE SPACE
	LDB	T3,UNYK4S##	;GET AMOUNT OF SWAPPING
	JUMPLE	T3,CPOPJ1	;NONE, TAKE GOOD RETURN
	LSH	T3,K2PLSH##	;CONVERT TO K
	MOVSI	T1,UNPRSS##	;INDICATE REMOVING SWAP SPACE
	CAMGE	T3,VIRTAL##
	IORM	T1,UNIUST##(U)
	PJRST	SOOND2		;DE-ALLOCATE SPACE
;HERE WHEN MIGRAT IS SET UP
REMSW2:	MOVE	J,.CPJOB##
	SKIPN	MIGRAT##	;MIGRATING YET?
	JRST	REMSW3		;NO, MUST BE DONE
	MOVEI	T1,5		;GO TO SLEEP FOR A WHILE
	PUSHJ	P,SLEEP##	;AND WAIT
	JRST	REMSW2		;CHECK AGAIN
;HERE WHEN UNIT IS NOT BEING USED AS A SWAPPER
REMSW3:	JUMPLE	U,REMS3A	;ALREADY GONE
	ADDM	T4,VIRTAL##	;LESS SWAPPING SPACE
	ADDM	T4,K4SWAP##	;SO SYSDPY KNOWS
	MOVSI	T1,UNPRSS##
	ANDCAM	T1,UNIUST##(U)
REMS3A:
IFN FTMP,<
	PUSHJ	P,GGVMM##	;GET MM
>
	PUSH	P,P2
	MOVEI	P2,-1		;GET RID OF DORMANT SEGMENTS
	PUSHJ	P,DODELE##	; ON THIS UNIT
	  JFCL
	POP	P,P2
	MOVSI	T1,MSWPMX##	;# OF SWAP TABLE ENTRIES
REMS3D:	CAMN	U,SWPTAB##(T1)	;LOOK FOR UNIT ENTRY
	JRST	REMSW4		;FOUND IT
	AOBJN	T1,.-2
	JRST	CPOPJ1##		;WHAT!? NOT STILL THERE?!! VIRTAL IS WRONG
REMSW4:	SETZM	SWPTAB##(T1)	;CLEAR ENTRY
	JUMPL	U,REMS3D	;CLEAR ALL -1S
;UNLINK SWAPPER FOR SYSTAT
	MOVEI	T1,SWPUNI##-UNISWP## ;PRESET PRED FOR 1ST SWAP UNIT
REMSW6:	HLRZ	T2,UNISWP##(T1)	;GET UDB
	CAMN	T2,U		;IS IT THE ONE WE ARE REMOVING
	JRST	REMSW7		;YES
	MOVE	T1,T2		;NO, STEP TO NEXT
	JRST	REMSW6
REMSW7:	HLR	T2,UNISWP##(U)	;YES
	HRLM	T2,UNISWP##(T1)	;RE-LINK
	SETOM	UNIFKS##(U)
	PUSHJ	P,ASLBLD##	;REBUILD THE PRESERVED ASL
	  JFCL			;BOOTSTRAP NOT AVAILABLE
	JRST	CPOPJ1##	;TAKE GOOD RETURN
;THIS ROUTINE LETS A PRIVILEDGED JOB ALLOW
;ACCESS TO A UNIT WHICH WAS IN MDA STATE.
;TYPICALLY DONE AFTER READING HOM BLOCKS
IFN FTMDA,<
CLRMDA::PUSHJ	P,GETWDU##	;GET DRIVE NAME
	SETO	T2,		;UNIT NAMES ARE 6 CHARS
	PUSHJ	P,SRUNI		;GET THE UDB
	  JRST	HIANSU		;NO SUCH UNIT
	  JRST	HIANSU		;DISSALLOW LOGICAL MATCH
	MOVSI	T1,UNPWMD##	;GET WAITING FOR MDA
	ANDCAM	T1,UNIDES##(U)	;CLEAR IT
IFN FTDUAL,<
	SKIPE	T2,UNI2ND##(U)	;AUXILLIARY PORT?
	ANDCAM	T1,UNIDES##(T2)	;YES, IT'S NOT WAITING.
>;IFN FTDUAL
	MOVE	T2,UNISTS##(U)	;GET CURRENT STATUS
	CAIN	T2,MDACOD##	;'MDA' IDLE?
	SETZM	UNISTS##(U)	;YES, MAKE A REAL IDLE
IFN FTDUAL,<
	PUSHJ	P,SECCOD##	;SET OTHER PORT.
>;IFN FTDUAL
	JRST	CPOPJ1##	;WIN!
>;IFN FTMDA
;ADD A SWAPPER TO THE ACTIVE SWAPPING LIST
ADDSWP::SE1ENT			;MAKE SATS ADDRESSABLE
	PUSHJ	P,GETWDU##	;GET DRIVE NAME
	SETO	T2,		;UNIT NAMES ARE 6 CHARS
	PUSHJ	P,SRUNI		;SET UP UDB IN U
	  JRST	HIANSU		;NO SUCH UNIT
	  JRST	HIANSU		;LOGICAL MATCH, LOSE
	PUSHJ	P,SAVE3##
	SETZ	P1,		;NO EMPTY SLOT
	MOVSI	T2,MSWPMX##
ADDSW0:	CAMN	U,SWPTAB##(T2)	;IF ALREADY IN SWPTAB
	JRST	HIAAIS		; CALLER IS VERY CONFUSED
	JUMPN	P1,.+3
	SKIPN	SWPTAB##(T2)
	MOVE	P1,T2
	AOBJN	T2,ADDSW0
	JUMPGE	P1,HIASIF	;SWPTAB FULL IF P1 POSITIVE
	PUSHJ	P,SAVR##	;NEED TO USE R FOR SECTION
IFE FTXMON,<
	SETZ R,		;IF SECTION ZERO MACHINE, SATS LIVE IN SEC 0
>
IFN FTXMON,<
	LDB	R,UNYSNS##	;ASSUME THERE'S ALREADY A TABLE THERE
>
	SKIPGE	T1,UNIPTR##(U)	;ALREADY A SWAPPING SAT?
	  JRST	ADDSW1		;YES, USE IT
	LDB	T2,UNYK4S	;AMOUNT OF SWAP SPACE
	JUMPE	T2,HIANSS	;CAN'T SWAP IF NO SPACE
	LSH	T2,K2PLSH##	;CONVERT TO P
	IDIVI	T2,^D36		;COMPUTE NUMBER OF WORDS
	AOJ	T2,		;ALWAYS LEAVE A ZERO
	MOVN	T1,T2		;LEFT HALF OF AOBJN POINTER
	HRLM	T1,UNIPTR##(U)	;SET IT
IFN FTXMON,<
	MOVEI	R,(MS.SAT)	;ASSUME GETTING IT IN SECTION 2
	PUSHJ	P,GFWNZ2##	;TRY SECTION 2 FIRST
	  SKIPA			;TRY SECTION 0 OTHERWISE
	JRST	ADDSWA		;GOT IT
	SETZ	R,		;GETTING IN SECTION 0
	HLRE	T2,UNIPTR##(U)	;RESTORE SIZE
	MOVNS	T2
>
	PUSHJ	P,GETWDS##	;TRY SECTION ZERO
	  JRST	[SETZM	UNIPTR##(U)
		 JRST	HIANSS	   ] ;CAN'T GET SPACE
ADDSWA:	HRRM	T1,UNIPTR##(U)	;SET THE OTHER HALF
IFN	FTXMON,<
	DPB	R,UNYSNS##	;SAVE IT
>
	MOVE	T1,UNIPTR##(U)	;GET CURRENT POINTER
ADDSW1:
IFE FTXMON,<
	SETZ	R,		;NO RELOCATION
	HLRE	T2,T1		;T2 = -LENGTH OF SAT
	HRLI	T1,1(T1)
	MOVNS	T2		;POINT T2 AT TOP OF SWAP SAT
	ADDI	T2,-1(T1)
	SETZM	(T1)		;INITIALIZE SWAPPING SAT TO ZEROES
	MOVSS	T1		; (WE LOSE BAT BLOCK INFO THIS WAY
	BLT	T1,(T2)		; BUT SUCH IS LIFE)
	MOVE	T1,UNIPTR##(U)	;GET POINTER
	MOVSI	T3,400000	;MAKE LOG BLOCK 0 UNAVAIL
	IORM	T3,(T1)
>
IFN FTXMON,<
	MOVSS	R		;ADDRESS OF THERE START OF THE SECTION
	HLRE	T1,UNIPTR##(U)	;- LENGTH OF SAT
	MOVNS	T1		;POSITIVE LENGTH
	SOS	T1		;ONE WORD WILL BE ZEROED BY HAND
	HRRZ	T2,UNIPTR##(U)	;RELATIVE ADDRESS OF SAT WITHIN SECTION
	HLL	T2,R		;ADDRESS OF THE SAT
	MOVE	T4,T2		;SAVE IT FOR LATER
	SETZM	(T2)		;ZERO FIRST WORD
	MOVE	T3,T2
	AOS	T3		;SECOND WORD OF THE SAT
	SKIPE	T1		;SKIP IF SAT IS ONLY 1 WORD LONG
	EXTEND	T1,[XBLT]	;ZERO THE ENTIRE SAT
	MOVSI	T1,400000	;MAKE LOGICAL BLOCK ZERO UNAVAILABLE
	IORM	T1,(T4)
	MOVE	T1,UNIPTR##(U)
>
	LDB	T3,UNYK4S##	;AMOUNT OF SWAPPING SPACE
	LSH	T3,K2PLSH##
	IDIVI	T3,^D36		;GET NUMBER OF 0'S IN LAST WORD OF SAT
	SETO	T3,
	MOVNS	T4		;MAKE BLOCKS PAST TOP OF SWAP SPACE UNAVAILABLE
	LSH	T3,-1(T4)
	IORM	T3,(T2)
	PUSH	P,T1
	TDZA	P2,P2		;CLEAR COUNT
CHKCYL: PUSHJ	P,SETSST	;SET THE BIT IN THE TABLES
CKCY1:	LDB	T3,UNYBPY##	;GET BLOCKS/CYLINDER
	ADD	P2,T3		;STEP TO NEXT CYLINDER
	CAMLE	P2,UNIBPU(U)	;OVER THE TOP OF THE DISK?
	JRST	CKCY2		;YES
	MOVE	T2,P2		;NO, MAKE TEMPORARY COPY OF BLOCK NUMBER
	SUB	T2,UNISLB(U)	;RELATIVE BLOCK IN SWAPPING SPACE
	JUMPL	T2,CKCY1
	IDIVI	T2,SWBKPP##	;CONVERT TO PAGES
	JUMPE	T3,CKCY1	;ON AN EVEN BOUNDARY, DON'T DO ANYTHING
	MOVE	T1,P2		;ELSE MARK IT IN USE
	JRST	CHKCYL		;DO SO AND LOOP BACK FOR MORE
CKCY2:	POP	P,T1
	PUSHJ	P,SATCN##	;COUNT "0" BITS = K
	ADDM	T2,VIRTAL##	;ADD TO SYSTEM TOTAL
	ADDM	T2,K4SWAP##	;SO SYSDPY KNOWS
	MOVEM	T2,UNIFKS##(U)	;AND TO UNIT
	HRRZM	U,SWPTAB##(P1)	;INSERT UNIT IN SWPTAB
	MOVEI	P3,SWPUNI##-UNISWP## ;POINT AT PREDECESSOR
	LDB	P2,UNYCFS##	;GET NEW UNIT'S CLASS FOR SWAPPING
ADDSW2:	MOVE	P1,P3		;SAVE CURRENT UNIT
	HLRZ	P3,UNISWP##(P1)	;GET NEXT UNIT
	JUMPE	P3,ADDSW3	;IF END OF CHAIN, LINK IN AT END
	MOVE	T1,UNICFS##(P3)	;GET UNIT CLASS WORD
	LDB	T1,UNZCFS##	;GET SWAPPING CLASS FROM T1
	CAMG	T1,P2		;END OF CLASS REGION?
	JRST	ADDSW2		;NO
ADDSW3:	HRLM	P3,UNISWP##(U)	;LINK UDB INTO UNISWP CHAIN AT RIGHT POINT
	HRLM	U,UNISWP##(P1)	;LINK IN THE NEW UDB
	PUSHJ	P,ASLBLD##	;REBUILD THE PRESERVED ASL
	  JFCL			;BOOTSTRAP NOT AVAILABLE
	JRST	CPOPJ1##	;TAKE THE GOOD RETURN
;ROUTINE (SIMILAR, BUT NOT QUITE) TO ONE IN ONCMOD)
SETSST: PUSHJ	P,SAVE4##	;SAVE ACS
	SUB	T1,UNISLB##(U)	;CONVERT TO RELATIVE BLOCK IN SWAPPING SPACE
	JUMPL	T1,CPOPJ##	;NOT THERE??
	LDB	P3,UNYK4S##	;NUMBER OF PAGES FOR SWAPPING
	JUMPE	P3,CPOPJ##	;IF NONE
	MOVE	T2,P3		;COPY TO T2
	LSH	T2,BLKSPK##	;CONVERT TO BLOCKS
	CAML	T1,T2		;OFF THE END OF THE SWAP SPACE?
	POPJ	P,		;YES,RETURN
	MOVEI	P1,SWBKPP##	;BLOCKS PER PAGE
	SETZ	P2,		;GROUP #0 REPRESENTED BY FIRST BIT
	SUBI	P3,1		;MAKE GROUP NUMBER
IFN FTXMON,<
	LDB	P4,UNYSNS##
	HRL	P4,UNIPTR##(U)
	MOVSS	P4
>
IFE FTXMON,<
	HRRZ	P4,UNIPTR##(U)	;IF NO KLP
>
	SUBI	P4,1		;MAKE IOWD POINTER
	PUSHJ	P,CHKBIT	;GENERATE MASK
	  IORM	T4,(T1)		;SET THE BIT (WASN'T SET)
	POPJ	P,
;SUBROUTINE TO CHECK IF A BIT IS SET IN A BLOCK IN WHICH EACH BIT REPRESENTS A GROUP OF BLOCKS
;ARGS	P1=# OF BLOCKS REPRESENTED BY 1 BIT
;	P2=GROUP NUMBER REPRESENTED BY FIRST BIT
;	P3=GROUP NUMBER REPRESENTED BY BEST ACTUAL DATA BIT
;	P4=IOWD PTR TO BLOCK
;	T1=BLOCK NUMBER
;RETURN POPJ IF NOT SET
;SKIP IF SET
CHKBIT::IDIV	T1,P1		;T1=GROUP #
	SUB	T1,P2		;T1=RELATIVE GROUP # IN THIS BLOCK
	IDIVI	T1,^D36		;T1=INDEX IN BLOCK OF WORD CONTAINING LIST
	MOVNS	T2		;T2=BITS TO SHIFT RIGHT
	MOVSI	T4,400000	;SET LEFTMOST BIT
	LSH	T4,(T2)		;POSITION BIT
	ADD	T1,P4		;T1=ADDR-1 OF WORD CONTAINING BIT
	TDNN	T4,1(T1)	;SKIP IF BIT SET
	AOJA	T1,CPOPJ##	;NO, POPJ, RETURN, POINT T1 AT WORD
	AOJA	T1,CPOPJ1##	;YES SKIP RETURN
NOWUP::	PUSHJ	P,DWNKON	;GET KONTROLLER, 1ST UNIT
	  JRST	HIANSK		;NO SUCH KONTROLLER
	MOVSI	T3,UNPNNA##	;WAS CHAN/KON/UNIT TAKEN DOWN?
	TDNN	T3,UNIUST##(U)
	JRST	HIAARP		;CONTROLLER WASNT DOWN
NOWUP1:	PUSHJ	P,NXDWN		;GET 1ST OR NEXT UNIT ON CHAN
	  JRST	NOWUP2		;DONE
	  JFCL
	ANDCAM	T3,UNIUST##(U)	;CLEAR UNPNNA FROM UNIT
IFN FTMDA,<
	SETZM	UNILTM##(U)	;CLEAR LOCK
> ;END IFN FTMDA
	JRST	NOWUP1		;AND TEST NEXT

NOWUP2:
IFN FTKL10,<
	PUSHJ	P,GETWD1##	;GET LOC OF IOWD BLOCK
	SETZM	3(T1)		;TERMINATE IT
	PUSHJ	P,RTNIOW##	;AND RETURN IT TO SYSTEM
>
	JRST	CPOPJ1##	;GOOD RETURN



;RETURNS U=BIT 0 + 1ST UNIT ON KONTROLLER, T4=RH(U)
DWNKON:	PUSHJ	P,GETWDU##	;GET KONTROLLER NAME
	MOVSI	T2,-1		;KONS ARE 3 LETTERS
	SKIPA	T3,LOCSRU
DWNKO1:	MOVEI	T3,SRUNX
	PUSHJ	P,(T3)		;FIND A MATCHING TNIT
	  POPJ	P,		;NO MATCH
	  JRST	DWNKO1		;LOGICAL MATCH
	HRRZ	T4,U		;SAVE 1ST UNIT ON KONTROLLER
	TLO	U,400000	;INDICATE 1ST TIME
	JRST	CPOPJ1##	;AND RETURN

;RETURNS NON-SKIP IF NO MORE UNITS, CPOPJ1 IF NOT IN ASL
;RETURNS CPOPJ2 IF UNIT IS IN ASL
;RESPECTS T3
NXDWN:	TLZE	U,400000	;1ST TIME?
	JRST	NXDWN1		;YES
	HLRZ	U,UNICHN##(U)	;NO, GET NEXT UNIT
	CAMN	U,T4		;BACK WHERE WE STARTED?
	POPJ	P,		;YES, DONE
NXDWN1:	SKIPGE	UNIPTR##(U)	;SWAPPING UNIT?
	AOS	(P)		;YES, CPOPJ2
	JRST	CPOPJ1##	;SKIP OR DOUBLE-SKIP RETURN
SUBTTL  F.S. UUO ERROR RETURN CODES

;STRUUO & GOBSTR ERROR CODES

XP .ERILF,0	;ILLEGAL FUNCTION CODE
XP .ERSNF,1	;1 OR MORE FILE STRUCTURES NOT FOUND
XP .ERSSA,2	;1 OR MORE FILE STRUCTURES SINGLE ACCESS ONLY
XP .ERILE,3	;1 OR MORE ILLEGAL ENTRIES IN ARG. LIST
XP .ERTME,4	;TOO MANY ENTRIES IN SEARCH LIST
XP .ERUNA,5	;1 OR MORE UNITS NOT AVAILABLE
XP .ERPPN,6	;JOB # , PP # DO NOT MATCH
XP .ERMCN,7	;MOUNT COUNT NOT 0
XP .ERNPV,10	;NOT PRIVILEGED USER
XP .ERFSA,11	;F.S. ALREADY EXISTS
XP .ERILL,12	;ILLEGAL ARG. LIST LENGTH (LH UUO AC)
XP .ERUNC,13	;UNABLE TO COMPLETE THE FUNCTION
XP .ERNFS,14	;SYSTEM FULL OF FILE STRUCTURES
XP .ERNCS,15	;NOT ENOUGH FREE CORE FOR DATA BLOCK
XP .ERUNF,16	;ILLEGAL UNIT
XP .ERRSL,17	;FILE STRUCTURE REPEATED IN SEARCH LIST DEFINITION
XP .ERASL,20	;UNITS IN THIS FILE STRUCTURE ARE IN THE ACTIVE SWAPPING LIST
XP .ERISN,21	;ILLEGAL STRUCTURE NAME
SUBTTL SYSSTR UUO
;UUO TO RETURN NAME OF NEXT FILE STRUCTURE IN SYSTEM
;NOTE THAT ACCUMULATOR J AND CONTAINS THE JOB NUMBER OF THE JOB
; EXECUTING THE UUO



SYSTUU::JSP	T4,STLOCK	;INTERLOCK
	JUMPE	T1,SYSTU1	;JUMP IF 1ST STR DESIRED
	PUSHJ	P,SRSTR		;SEE IF ARG IS AN STR NAME (ARG IN T1)
	  POPJ	P,		;NO, ERROR RETURN
	MOVE	T1,T4		;AOBJN PTR TO T1
	JRST	SYSTU2		;YES

SYSTU1:	MOVE	T1,STRAOB##	;START WITH 1ST FSN.
	SKIPG	T3,TABSTR##(T1)	;SKIP IF THIS IS A REAL STR
SYSTU2:	AOBJN	T1,.-1		;NO, TRY NEXT NUM
	JUMPGE	T1,RTZER1##	;RETURN 0 IF END OF SEARCH LIST
IFN FTPSTR,<
	PUSHJ	P,PVSTR		;A PRIVATE STR?
	  JRST	SYSTU2		;YES, SKIP IT
>

	MOVE	T1,STRNAM##(T3)	;GET NAME OF STR
	JRST	STOTC1##
SUBTTL SYSPHY UUO
;CALLI AC,51
;UUO TO RETURN NAME OF NEXT PHYS.DEV. NAME IN SYSTEM
; CALLING SEQUENCE IS SIMILAR TO SYSSTR UUO


SYSPHY::HLRZ	U,SYSUNI##	;U=ADDRESS 1ST UNIT D.B.
	SETO	T2,		;INDICATE IN SYSUNI CHAIN
	JUMPE	T1,SYSPH4	;IF USER AC=0: RETURN 1ST UNIT

SYSPH2:	CAMN	T1,UNINAM##(U)	;THIS UNIT PHYS.NAME = ARGUMENT?
	JRST	SYSPH3		;YES-GO RETURN NEXT PHYS.NAME
	HLRZ	U,UNISYS##(U)	;NO--GET NEXT UNIT
	JUMPN	U,SYSPH2	;IF THIS IS LAST UNIT:
	AOJN	T2,CPOPJ##	;   GIVE ERROR RETURN IF AT END OF SYSDET CHAIN
	HLRZ	U,SYSDET##	;GET ADDRESS OF FIRST DETACHED UNIT D.B.
	JUMPN	U,SYSPH2	;CHECK THEM IF THERE ARE ANY DETACHED UNITS
	POPJ	P,		;NO DETACHED UNITS, LAST UNIT, ERROR RETURN

SYSPH3:	SETZ	T1,		;RETURN 0 IN CASE IT WAS LAST UNIT
	HLRZ	U,UNISYS##(U)	;GET NEXT UNIT D.B.
	JUMPN	U,SYSPH4	;RETURN PHYS NAME IF NOT LAST UNIT
	AOJN	T2,STOTC1##	;IF THAT WAS LAST UNIT: RETURN 0
	HLRZ	U,SYSDET##	;GET ADDRESS OF FIRST DETACHED UNIT D.B.
	JUMPE	U,STOTC1##	;IF THAT WAS LAST UNIT: RETURN 0
SYSPH4:	MOVE	T1,UNINAM##(U)	;OTHERWISE RETURN PHYS.NAME
	JRST	STOTC1##
SUBTTL GOBSTR UUO
; GENERALIZED JOBSTR UUO  -  CALLI AC,66


;ERROR RETURN CODES:

ERCODE GERIFS,.ERILE	;1ST ARG. NOT VALID (-1 OR F.S. NAME IN JOBS SRCH LIST)
ERCODE GERPPN,.ERPPN	;JOB# (1ST ARG) NO GOOD OR DOESNT MATCH PPN (2ND ARG)
ERCODE GERILL,.ERILL	;ILLEGAL ARG.LIST LENGTH (LH OF UUO AC)
; ALSO .ERNPV		;(SUBROUT PRIVJ) NOT PRIVILEGED JOB


GOBSTR::PUSHJ	P,SAVE3##
	HRRM	T1,M		;RH UUO=ADDR. USERS ARG. LIST
	HLRZ	P1,T1		;P1=LENGTH OF ARG. LIST
	SKIPN	P1		;CONVERT 0 TO 3
	MOVEI	P1,3
	CAIG	P1,5		;LENGTH LESS THAN 5?
	CAIGE	P1,3		;LENGTH 3 OR GREATER?
	JRST	GERILL		;NO--ERROR RETURN
	SOS	M		;SO GETWD1 IN CKJPPN WILL WORK

	PUSHJ	P,CKJPPN	;JOB # MATCH PPN?
	  JRST	GERPPN		;NO--ERROR RETURN
	JUMPE	F,GOBST1	;JUMP IF SYS.SRC.LST
	MOVE	T4,JBTPRV##(J)	;   IF DOESN'T HAVE PRIVILEGES
	TLNE	T4,PVSPYA!PVSPYM
	JRST	GOBST1

	CAME	T1,JBTPPN##(J)	;   OR IF PPN NOT SAME AS THIS JOBS PPN
	JSP	T4,PRIVJ	;   THEN THIS JOB MUST BE PRIV
GOBST1:	AOS	M		;BECAUSE JOBSTR CODE DOES GETWDU
	SUBI	P1,2		;CORRECT LENGTH OF ARGUMENT TEST FOR JOBSTR
	MOVE	J,F		;SAVE F SINCE STLOCK ZEROES IT
	PUSHJ	P,JOBST0	;PUSHJ TO JOBSTR CODE SO I
	  JRST	GERIFS		;   CAN HANDLE MY OWN ERROR RETURN
	JRST	CPOPJ1##	;GOOD RETURN--PASS IT ON
;UUO  TO RETURN NEXT STR IN JOB'S OWN SEARCH LIST

JOPSWL==400000		;BIT FOR SOFTWARE WRITE LOCK TO RETURN TO USER
JOPNCR==200000		;BIT FOR NO CREATE TO RETURN TO USER

;SO GOBSTR CAN USE THIS SAME CODE:
;   F HOLDS # OF JOB WHOSE SEARCH LIST IS TO BE SEARCHED (0 IS SYS SL)
;   J HOLDS # OF JOB EXECUTING THE UUO
;   P1=# OF ARGUMENTS

JOBSTR::PUSHJ	P,SAVE3##
	HRRM	T1,M		;ADDR OF USER'S ARGUMENT LIST
	HLRZ	P1,T1		;P1=NUMBER OF ARGS DESIRED
	SKIPN	P1
	MOVEI	P1,1		;CONVERT 0 TO 1
	CAILE	P1,3		;IS THE # OF ARGS LEGAL (0-3)?
	  JRST	GERILL		;NO
;HERE FROM GOBSTR
JOBST0:	JSP	T4,STLOCK	;INTERLOCK

;HERE WITH J=JOBNUM.OF SL. TO GET (OR 0 FOR SYS.SL.)
;GET CALLER'S 1ST ARG.AND DISPATCH (FS.NAME, 0 (FENCE), OR -1 (BEGINNING)

	MOVE	F,J		;GETWDU MODIFIES J
	PUSHJ	P,GETWDU##	;T1=ARG.
	MOVE	J,F
	PUSHJ	P,SLPTR		;P2=SL.PTR.
	  MOVE	P2,EMTSRC##	;USE EMPTY SL. IF JOB HAS NONE
	AOJE	T1,JOBSR4	;JUMP IF -1
	SOJE	T1,[		;JUMP IF 0
		MOVEI	T1,.FSFNC	;LOOK FOR FENCE
		JRST	JOBSR2
		]
	PUSHJ	P,SRSTR		;T3=STR.DB. ADDR. FOR NAMED FS.
	  JRST	GERIFS		;NOSKIP ERROR IF NO SUCH FS.NAME
	HRRZ	T1,STRFSN##(T3)	;T1=CORRESPONDING FSN.

JOBSR2:	;HERE WITH FSN. (OR FENCE) TO LOOK FOR IN T1

	PUSHJ	P,SLFND
	  JRST	GERIFS		;NOSKIP ERROR IF NOT ON LIST
JOBSR4:	;HERE WITH P2 POINTING TO DESIRED FSN.

	PUSHJ	P,SLIGT
	  JRST	[		;END OF LIST--RETURN -1
		SETO	T1,
		SETZ	P3,
		JRST	JOBSR6
		]
	CAIN	T1,.FSFNC	;RETURN 0 IF FENCE
	JRST	[
		SETZB	T1,P3
		JRST	JOBSR6
		]
	MOVE	T1,TABSTR##(T1)	;GET FS.NAME FOR THIS FSN.
	MOVE	T1,STRNAM##(T1)
	PUSHJ	P,SLGTB		;GET FS.BITS AND TRANSLATE FOR UUO ARG
	SETZ	P3,
	TRNE	T2,FS.WLK
	TLO	P3,JOPSWL
	TRNE	T2,FS.NCR
	TLO	P3,JOPNCR

JOBSR6:	;HERE WITH T1=FS.NAME (OR 0 OR -1), P3=FS.BITS

	PUSHJ	P,PUTWDU##
	SOJE	P1,CPOPJ1##	;SKIP RETURN IF NO MORE ARGS DESIRED
	MOVEI	T1,0		;ZERO FOR PPN WORD FOR NOW ***
	PUSHJ	P,PUTWD1##
	SOJE	P1,CPOPJ1##	;SKIP RETURN IF NO MORE ARGS DESIRED
	MOVE	T1,P3		;STORE STATUS BITS
	PUSHJ	P,PUTWD1##
	JRST	CPOPJ1##	;SKIP RETURN
SUBTTL STRUUO UUO
;UUO TO PERFORM VARIOUS FUNCTIONS FOR FILE STRUCTURES
;NOTE THAT ACCUMULATOR J AND CONTAINS THE JOB NUMBER OF THE JOB
; EXECUTING THE UUO


;ERROR CODES

ERCODE ILLERR,.ERILL	;ILLEGAL ARG.LIST LENGTH (LH UUO AC)
ERCODE NPVERR,.ERNPV	;NOT PRIVILEGED PROGRAM
ERCODE PPNERR,.ERPPN	;JOB #--PPN MISMATCH
ERCODE SNXERR,.ERSNF	;F.S. NOT FOUND (NONEXISTANT)
ERCODE TMEERR,.ERTME	;TOO MANY ENTRIES (FILE STRUCTURES)
ERCODE RSLERR,.ERRSL	;REPEATED F.S. IN ARG LIST
ERCODE ILFERR,.ERILF	;ILLEGAL FUNCTION
ERCODE NFSERR,.ERNFS	;NO ROOM FOR THIS F.S. (NO MORE F.S. #S)
ERCODE UNFERR,.ERUNF	;NO SUCH UNIT
ERCODE NCSERR,.ERNCS	;NOT ENOUGH FREE CORE
ERCODE FSAERR,.ERFSA	;F.S.ALREADY EXISTS
ERCODE UNAERR,.ERUNA	;UNIT NOT AVAILABLE
ERCODE MCNERR,.ERMCN	;MOUNT COUNT NOT ZERO
ERCODE SSAERR,.ERSSA	;A F.S. IS SING. ACCESS FOR ANOTHER
ERCODE ASLERR,.ERASL	;F.S. CONTAINS UNITS STILL IN ASL
ERCODE ISNERR,.ERISN	;ILLEGAL STRUCTURE NAME



STRUUO::PUSHJ	P,SAVE4##	;SAVE ALL 4 GLOBAL ACCUMULATORS
	MOVE	P4,T1		;SAVE T1 IN P4
	HRRM	T1,M		;ADDRESS OF ARGUMENT LIST
	PUSHJ	P,GETWDU##	;GET FIRST ARGUMENT = FUNCTION
	JUMPL	T1,ILFERR	;ILLEGAL IF NEGATIVE
	CAIL	T1,STRFNN	;SEE IF LEGAL FUNCTION
	JRST	ILFERR		;WELL, NO
	JRST	@STRFNC(T1)


ETSSTR==ILFERR
STRFNC:	XWD	ZERO5,SRCSTR	;(0) DEFINE NEW SEARCH LIST (UNPRIVILEGED)
	XWD	ZERO5,DSLSTR	;(1) DEFINE NEW SEARCH LIST (PRIVILEGED)
	XWD	ZERO5,DEFSTR	;(2) DEFINE NEW FILE STRUCTURE
	XWD	ZERO5,RDFSTR	;(3) REDEFINE FILE STRUCTURE (CHANGE BITS)
	XWD	ZERO5,LOKSTR	;(4) LOCK OUT NEW INIT'S, ENTER'S ,ETC.
	XWD	ZERO5,REMSTR	;(5) REMOVE FILE STRUCTURE FROM SYSTEM
	XWD	ZERO5,ULKSTR	;(6) TEST/SET UFD INTERLOCK FOR LOGIN, LOGOUT, ETC
	XWD	ZERO5,UCLSTR	;(7) CLEAR UFD INTERLOCK
	XWD	ZERO5,ETSSTR	;(10) ERROR TEST UUO (SIMULATE ERRORS) .FSETS
	XWD	ZERO5,RSLSTR	;(11) CHANGE NOCREATE AND WRITE LOCK FOR 1 STR
IFN FTMDA,<
	XWD	ZERO5,CLKSTR	;(12) CLEAR LOCK FOR A STRUCTURE
> ;IFN FTMDA
STRFNN==.-STRFNC
KILJSL::PUSHJ	P,SAVE4##	;STRUUO CORE CLDBBERS THE P ALS
	JSP	T4,STLOCK	;NEED THE FILSER INTERLOCK
	SETZ	P3,		;NO UUO ARGUMENTS
	MOVE 	F,.CPJOB##	;JSL FOR RUNNING JOB
	PUSHJ 	P,SLKILL	;KILL DUR JSL
	  POPJ	P,		;IGNORE ERRORS
	POPJ	P,		;AND RETURN TO JOBKL
SUBTTL STRUUO UUO - DEFINE NEW SEARCH LIST
;FUNCTIONS TO DECLARE NEW SEARCH LISTS

;BITS IN 3RD ARG. OF EACH UNI TRIPLET

SETSWL==400000	;1=SOFTWARE WRITE-LOCKED BIT
SETNCR==200000	;1=NO-CREATE BIT

;FOR THIS JOB (UNPRIVILEGED)


SRCSTR:	JSP	T4,STLOCK	;GET FF RESOURCE
	MOVE	F,J		;JOBS OWN SEARCH LIST
	HLRZ	P3,P4		;P3=ARG.LIST LENGTH - 1
	CAILE	P3,3*.SLMXJ##+1	;TOO LONG?
	JRST	ILLERR		;YES LOSE
	SOJA	P3,SLSTRR


;FOR ANY JOB (PRIVILEGED)


;BITS IN 5TH ARGUMENT (.FSDSL ONLY)

SETDEL==1	;DELETE (FORGET) MISSING F.S'S FROM NEW S.L.
		;   OTHERWISE MOVE TO OTHER SIDE OF FENCE (REMEMBER)

DSLSTR:	JSP	T4,STLOCK	;GET FF RESOURCE
	PUSHJ	P,CKJPPN	;JOB # MATCH PPN?
	  JRST	PPNERR		;NO--ERROR RETURN
	CAME	F,J		;IF NOT FOR THIS JOB
	JSP	T4,PRIVJ	;   THEN THIS JOB MUST BE PRIV
	HLRZ	P3,P4		;P3=ARG.LIST LENGTH - 4
	SUBI	P3,4
	PUSHJ	P,GETWD1##	;CK FOR 'DELETE' BIT IN FLAGS
	TRNE	T1,SETDEL	;IF WANTS TO DELETE F.S.'S
	JSP	T4,PRIVJ	;   THEN MUST BE PRIV
	SKIPE	F		;IF SYS.SRC.LST:  ALWAYS DELETE
	TRNE	T1,SETDEL
;J=# OF JOB EXECUTING THE UUO
;RH(F)=# OF JOB WHOSE SEARCH LIST IS TO BE DEFINED (0=SYS.SRC.LST.)
;P3=ARG.LIST LENGTH (EXCLUDING INITIAL STUFF LIKE FUNCTION NO.)

;FALL OR SKIP INTO HERE FROM DSLSTR CODE

SLKILL:	TLOA	F,400000	;HERE TO 'FORGET' MISSING F.S'S
SLSTRR:	TLZ	F,400000	;HERE TO 'REMEMBER' MISSING F.S'S
;BUILD CALLERS SL. IN A TEMPORARY SL.
;PUSHJ TO SLSTR SO CAN GET CONTROL BACK TO RETURN TEMP.SL.

IFN FTPSTR,<
	PUSHJ	P,PRVJO		;JOB PRIV'ED
	  TLZA	F,200000	;NO, REMEMBER THAT
	TLO	F,200000	;YES REMEMBER THAT
>
	MOVEI	T2,.SLMXJ	;T2=HOW BIG SL.MUST BE
	PUSHJ	P,SLPRT
	  JRST	NCSERR		;NOT ENOUGH FREE CORE ERROR
	PUSH	P,P2
	PUSHJ	P,SLSTR
	  SKIPA			;PROPAGATE SKIP/NOSKIP
	AOS	-1(P)
	POP	P,P2
	PUSHJ	P,SLGVT		;RETURN TEMP.SL.
	TRNN	F,-1		;JOB ZERO?
	PUSHJ	P,SSLBLD##	;REBUILD THE PRESERVED SSL
	  JFCL			;BOOTSTRAP NOT AVAILABLE
	POPJ	P,		;RETURN

SLSTR:	;HERE WITH P2=PTR.TO TMP.SL.
	MOVE	P1,P2
	MOVE	P4,J		;GET PTR. TO OLD SL.
	HRRZ	J,F
	PUSHJ	P,SLPTR
	  JRST	[
		JUMPE	P2,PPNERR	;ERROR IF NO SUCH SL.
		PUSHJ	P,SLINI		;IF NULL SL. (EG. LOGIN CALLING)
		JRST	.+1		;  SET IT EMPTY
		]
	MOVE	J,P4
	MOVE	P4,P2

;IN THE FOLLOWING
;	P1=PTR.TO BEG.OF TEMP.SL (NOT INCREMENTED)
;	P2=PTR.TO NEXT POSITION ON TEMP.SL.(INCREMENTED)
;	P3=LENGTH OF ARGUMENT LIST
;	P4=POINTER TO OLD S.L.
;	S =FENCE COUNTER
	SETO	S,
	MOVE	P2,P1

;IF NO ARGS, WE'RE FINISHED

	JUMPLE	P3,SLSR4
;HERE TO GET EACH UUO ARGUMENT TRIPLET

SLSR0:	PUSHJ	P,GETWD1##
	JUMPE	T1,[		;JUMP IF FENCE (0) SPECIFIED
		AOJG	S,RSLERR	;2 FENCES IS AN ERROR
		MOVEI	T1,.FSFNC
		SETZ	T2,
		ADDI	M,2		;IGNORE 2ND,3RD ARGS
		JRST	SLSR2
		]

;HERE WITH FS.NAME IN T1

	PUSHJ	P,SRSTR		;GET STR.DB. FOR THIS FS.
	  JRST	SNXERR		;NO SUCH FS.
	MOVE	T4,STRJOB##(T3)	;SING.ACCESS FOR SOMEONE ELSE?
	CAIE	T4,(F)
	JUMPG	T4,SSAERR	;YES
	HRRZ	T1,STRFSN##(T3)	;T1=FSN.


	MOVE	T2,P2		;IS FSN. ALREADY ON SL.?
	MOVE	P2,P1
	PUSHJ	P,SLFND
	  SKIPA	P2,T2		;NO
	JRST	RSLERR		;YES-ERROR

IFN FTPSTR,<
	MOVE	T4,STRPVS##(T3)	;WORD CONTAINING PRIVATE F.S. BIT
	TRNE	T4,STPPVS##	;IS THIS A PUBLIC F.S.?
	TLNE	F,200000	; OR DOING THIS FOR A PRIVILEGED JOB?
	JRST	SLSR1		;YES, EVERYTHING OK
	MOVE	P2,P4		;POINTER TO OLD S.L.
	PUSHJ	P,SLFND		;THIS F.S. ALREADY IN THE JOB'S S.L.?
	  JRST	NPVERR		;NO, ILLEGAL SINCE NOT PRIVILEGED
	MOVE	P2,T2		;RESTORE POINTER TO TEMP. S.L.
SLSR1:>

;GET FS.STATUS BITS AND TRANSLATE FOR SL.

	PUSH	P,T1
	AOS	M
	PUSHJ	P,GETWD1##
	SETZ	T2,
	TLNE	T1,SETSWL
	TRO	T2,FS.WLK
	TLNE	T1,SETNCR
	TRO	T2,FS.NCR
	POP	P,T1
;HERE WITH T1=FSN., T2=BITS, P2=PTR.
SLSR2:	PUSHJ	P,SLAPD		;APPEND TO THE LIST
	  JRST	TMEERR		;RAN OUT OF ROOM ERROR
	SUBI	P3,3		;COUNT UUO ARGS
	JUMPG	P3,SLSR0	;DO IT AGAIN IF MORE ARGS

;HERE WHEN FINISHED WITH ALL UUO ARGS
;MAKE SURE THERE IS A FENCE

	AOJG	S,SLSR3		;JUMP IF CALLER SUPPLIED FENCE
	MOVEI	T1,.FSFNC	;ELSE PUT ONE AT END
	SETZ	T2,
	PUSHJ	P,SLAPD
	  JRST	TMEERR		;NO ROOM
SLSR3:
SLSR4:	;HERE WITH P1=BEG. OF NEW SL., P2=END OF NEW SL.

;FOR EVERY FS. ON OLD SL. BUT NOT ON NEW SL.:
;	EITHER APPEND IT TO NEW SL. (PASSIVE LIST), OR DECREMENT
;	ITS MOUNT COUNT, DEPENDING ON SWITCH F.

	MOVE	P3,P4		;P3=BEG. OLD S.L.

IFN FTMDA,<
	FRAME	(SLCHNG)	;ALLOCATE A FLAG
	SETZM	SLCHNG		;INITIALLY, NO SL CHANGES
>;END IFN FTMDA
SLSR5:	;HERE WTO GET EACH FS. FROM OLD SL.
	;P1=BEG.NEW SL.,  P3=BEG.OLD SL.,  P4=NEXT FSN. ON OLD SL.

	MOVE	P2,P4
	PUSHJ	P,SLIGT
	  JRST	SLSR7		;END OF OLD SL.
	MOVE	P4,P2
	MOVE	P2,P1		;ON NEW SL.?
	PUSHJ	P,SLFND
	  SKIPA
	JRST	SLSR5		;YES
	JUMPL	F,SLSR6		;NO--JUMP IF DELETING FS'S
	SETZ	T2,		;ELSE APPEND TO END OF NEW SL.
	PUSHJ	P,SLAPD
	  JRST	TMEERR
	JRST	SLSR5
;DECREMENT MOUNT COUNT. IF GOES TO 0, SET STRJOB =0.
SLSR6:
IFN FTMDA,<
	SETOM	SLCHNG		;NOTE CHANGE IN SL
>;END IFN FTMDA
	MOVE	T3,TABSTR##(T1)
	SOSGE	T2,STRMNT##(T3)
	STOPCD	.+1,DEBUG,MCN,	;++MOUNT COUNT NEGATIVE
	JUMPN	T2,SLSR5
	SETZM	STRJOB##(T3)
	JRST	SLSR5
SLSR7:	;HERE WITH P1=BEG.NEW SL.,  P3=BEG.OLD SL.

;FOR EVERY FS. ON NEW SL. BUT NOT ON OLD SL.:
;	INCREMENT ITS MOUNT COUNT.
	MOVE	P4,P1

SLSR8:	;HERE TO GET NEXT FS. ON NEW SL.
	;P1=BEG.NEW SL.,  P3=BEG.OLD SL.,  P4=NEXT NEW SL.
	MOVE	P2,P4
	PUSHJ	P,SLIGT
	  JRST	SLSR9		;FINISHED
	MOVE	P4,P2		;IS IT ON OLD SL.?
	MOVE	P2,P3
	PUSHJ	P,SLFND
	  SKIPA
	JRST	SLSR8		;YES

;HERE IF NOT ON OLD SL. INCREMENT MOUNT COUNT.
;IF NOT A SINGLE ACCESS FS., THEN SET STRJOB = -1,,JOB OR 0 DEPENDING
;ON WHETHER THIS IS 1ST OR SUBSEQUENT MOUNTER.
	MOVE	T3,TABSTR##(T1)
	SKIPLE	STRJOB##(T3)
	JRST	SLSR81
	SETZM	STRJOB##(T3)
	SKIPN	STRMNT##(T3)
	HRROM	F,STRJOB##(T3)	;-1,,JOB  TO SIGNIFY ONLY USER
SLSR81:	AOS	STRMNT##(T3)
IFN FTMDA,<
	SETOM	SLCHNG		;NOTE CHANGE IN SL
>;END IFN FTMDA
	JRST	SLSR8		;LOOP FOR NEXT FS.


SLSR9:	;HERE WHEN FINISHED FIXING THINGS UP. REPLACE OLD SL. WITH NEW.
	;P1=BEG.NEW SL.,  P3=BEG.OLD SL.
	MOVE	P2,P1
	PUSHJ	P,SLCHK		;MAKE SURE NUMBER OF F.S DOES NOT
	  JRST	TMEERR		;EXCEED MAXIMUM (.SLMXJ)
	PUSHJ	P,SLBLT
	  JRST	TMEERR
IFN FTMDA,<
	SKIPE	SLCHNG		;DID THE LIST CHANGE IN CONTENT?
	PUSHJ	P,SLNOTF	;YES, TELL MDA OF CHANGE
	JFCL			;IGNORE ERROR
>;END IFN FTMDA
	PJRST	ADJPT##		;FIX AT'S AND RETURN
IFN FTMDA,<
;THIS ROUTINE SENDS THE NEW SEARCH LIST TO MDA
;CALL
;	P1	NEWSL PTR
;RETURNS CPOPJ	NOT SENT
;	CPOPJ1	DONE

SLNOTF:	JUMPE	J,CPOPJ1##	;DON'T NOTIFY IF SSL CHANGES
	MOVE	T1,JBTPRG##(J)	;GET PROGRAM THEY ARE RUNNING
	MOVE	T2,JBTSTS##(J)	;GET JOB STATUS WORD
	CAMN	T1,LOGTXT##	;REAL BONAFIDE
	TLNN	T2,JACCT	; JACCT LOGIN?
	SKIPA			;NO, AN IMPOSTER
	POPJ	P,		;YES, WAIT UNTIL THE LOGIN UUO DOES THIS
SLNMSG::SKIPE	%SIMDA##	;IS MDA RUNNING?
	CAMN	J,TLPJOB##	; OR IS THIS MDA'S COHORT?
	  POPJ	P,		;NO, MDA OR DONE BY MDA
	PUSHJ	P,SAVE4##
	MOVE	P2,P1		;READ DOWN NEW SL
	MOVEI	T2,.SLMXJ+2	;GET SPACE FOR THE MESSAGE
	PUSHJ	P,GETWDS##	;+2 FOR HEADER
	  POPJ	P,		;OH WELL
	HRRZ	P3,T1		;SAVE MSG ADRS
	MOVE	P1,[XWD 2,.IPCSC##] ;INITIAL LENGTH,,MSG TYPE
	MOVEM	P1,0(P3)	;MARK IT
	MOVEM	J,1(P3)		;SAY WHO'S DOING IT
	HRRZI	P4,2-1(P3)	;MAKE COUNT IN LH, PDL PTR

SLNOT1:	PUSHJ	P,SLIGT		;GET NEXT STR
	  JRST	SLNOT2		;NO MORE
	CAIN	T1,.FSFNC	;FENCE?
	  JRST	SLNOT1		;YES, SKIP IT
	MOVE	T1,TABSTR##(T1)	;GET ITS STR DATA BLOCK
	MOVE	T1,STRNAM##(T1)	;GET STRUCTURE NAME
	PUSH	P4,T1		;PUT IN MESSAGE, COUNT IT
	JRST	SLNOT1		;TRY THEM ALL!

SLNOT2:	HLLZS	P4		;JUST COUNT # OF STRS
	ADDM	P4,0(P3)	;COUNT THE MESSAGE
	MOVE	T1,P3		;AIM AT THE MESSAGE
	MOVEI	T2,.SLMXJ+2	;LENGTH WE GOT
	PJRST	SNDMDN##	;SEND IT, RETURN SPACE
>;END IFN FTMDA
;CHANGE NO CREATE AND WRITE LOCK FOR 1 STR
RSLSTR:	PUSHJ	P,SLPTR		;GET S.L. INTO P2
	  JRST	SNXERR		;SEARCH LIST IS EMPTY
	PUSHJ	P,GETWD1##	;GET STR NAME
	PUSHJ	P,SRSTR		;FIND STR
	  JRST	SNXERR		;CAN'T
	HRRZ	T1,STRFSN##(T3)	;GET F.S.N.
	PUSHJ	P,SLFNA		;FIND IT
	  JRST	SNXERR		;CAN'T
	PUSHJ	P,GETWD1##	;GET FLAGS
	MOVEI	T2,0		;COPY BITS
	TLNE	T1,SETSWL	; ..
	TRO	T2,FS.WLK
	TLNE	T1,SETNCR
	TRO	T2,FS.NCR
	PUSHJ	P,SLGTX		;GET FSN BACK
	PUSHJ	P,SLPUT		;STORE NEW BITS
	  PUSHJ	P,SLXAES	;SHOULD NOT BE DONE
	JRST	CPOPJ1##	;GOOD RETURN
SUBTTL STRUUO UUO - DEFINE A F.S.
;FUNCTION TO DEFINE A NEW FILE STRUCTURE

DEFAWL==400000		;SOFTWARE WRITE LOCK FOR ALL JOBS ON THIS STR
DEFSAF==200000		;SINGLE ACCESS STR

DEFSTR:	JSP	T4,PRIVJ	;PRIVILEGED JOB?
	PUSHJ	P,DEFINC	;MAKE SURE ALL ARGUMENTS ARE IN CORE
	JSP	T4,STLOCK	;GET FF RESOURCE

;GET A # FOR THIS F.S. NAME
	PUSHJ	P,MVWRD		;GET F.S. NAME (INTO T1)
	TRNE	T1,7777		;ALLOW 4 CHARACTER NAMES
	  JRST	ISNERR		;LOSE
	PUSHJ	P,SRSTR		;IS IT ALREADY DEFINED?
	  SKIPA
	JRST	FSAERR		;YES-ERROR RETURN
	PUSHJ	P,SRCTBS	;GET A # FOR IT (INTO P2)
	  JRST	NFSERR		;NO MORE #S LEFT--ERROR RETURN

;BUILD PROTOTYPE STR D.B.
	MOVEI	T1,DIFSTR##	;SET PREDECESSOR
DEFST1:	HLRZ	T1,STRSYS##(T1)	;GET NEXT
	JUMPE	T1,DEFST2	;GET FREE CORE IF END OF LIST
	SKIPE	STRNAM##(T1)	;STR BLOCK AVAILABLE?
	JRST	DEFST1		;NO, TRY NEXT
	JRST	DEFST3		;FOUND A FREE BLOCK, USE IT

DEFST2:	MOVEI	T2,STRLEN##	;GET CORE FOR STR D.B.
	PUSHJ	P,GETWDS##
	  JRST	NCSERR		;NOT ENOUGH--ERROR RETURN
;NOTE--FROM HERE ON ERR RETURNS MUST 1ST CALL REMOV TO RETURN CORE ETC.
	MOVE	T2,SYSSTR##	;LINK STR D.B. TO OTHER STRS
	HLLM	T2,STRSYS##(T1)
	HRLM	T1,SYSSTR##
DEFST3:	MOVE	F,T1		;F=ADDR. OF STR D.B.
	HRLI	T1,STRDB##+2	;INIT. D.B. WITH PROTOTYPE
	ADDI	T1,STRUNI##
	BLT	T1,STRLEN##-1(F)
	HRRM	P2,STRFSN##(F)	;PUT F.S. # IN D.B.

;FILL WITH USER ARGUMENTS
	SOS	M		;MOVE USER ARGS. IN
	MOVE	T2,F		;BECAUSE BYTE PTRS. USE T2
	MOVEI	P1,FSTAB
	PUSHJ	P,MVARG
	HRLZI	T1,77		;CLEAR INDEX AND @ FIELDS IN PTRS.
	ANDCAM	T1,STYCNP##(F)
	ANDCAM	T1,STYCKP##(F)
	ANDCAM	T1,STYCLP##(F)

;SETUP FOR UNIT DEFINITIONS
	HRRZ	P3,STRUNM##(F)	;P3=# OF UNITS
	MOVEI	U,DIFUNI##(F)	;SO STRUNI GETS ADDR. 1ST UNIT D.B.
;HERE FOR EVERY UNIT
;IS UNIT DEFINED AND AVAILABLE?

	SE1ENT			;MUST BE IN SECTION 1 TO CHASE SAB RINGS
DEFST4:	MOVE	P4,U		;P4=ADDR. OF LAST UNIT D.B.
	MOVEI	P1,UNTAB	;GET PHYS DRIVE NAME (INTO T1)
	PUSHJ	P,MVWRD
	SETO	T2,		;DOES IT EXIST?
	PUSHJ	P,SRUNI
	  JRST	UNFDEF		;NO--ERROR
	  JRST	UNFDEF		;YES BUT IT IS LOGICAL NAME--ERROR
;----TEST FOR UNIT DOWN-----
	LDB	T1,UNYUST##	;IS IT IN 'NO PACK MOUNTED' STATE?
	CAIE	T1,UNVNPM##
	JRST	UNADEF		;NO--ERROR
	MOVEI	T1,UNVPIM##	;YES-SET STATE TO 'MOUNTED'
	DPB	T1,UNYUST##

;LINK THE UNIT D.B. TO OTHERS

	HRLM	U,UNISTR##(P4)	;LINK THIS D.B. TO PROVIOUS
	HRRM	F,UNISTR##(U)	;LINK IT TO STR D.B.

;MOVE IN USER VALUES

	SOS	M		;MOVE USER ARGS IN TO UNIT D.B.
	MOVEI	P1,UNTAB
	PUSHJ	P,MVARG		;LEAVES P2=USER PTR.WRD. TO SPT TABLE
				;       S =STATUS BITS

IFN FTDUAL,<
	SKIPE	T2,UNI2ND##(U)	;UNIT DUAL PORTED?
	PUSHJ	P,CPYST##	;YES, COPY INFORMATION TO OTHER PORT
>
;*****SAY NO SWAPPING FOR NOW*****
;	SETZB	T1,UNIFKS##(U)
;	DPB	T1,UNYK4S##
;*****
	MOVE	T1,UNIDES##(U)	;GET UNIDES
	TLZ	T1,UNPSTL##	;CLEAR BITS TO BE CHANGED
	TLNE	S,DEFAWL	;WRITE-LOCK?
	TLO	T1,UNPAWL##
;CREATE AN SPT TABLE (UNIDES IN T1)

	LDB	P1,UNYSPU##	;P1=# SATS/UNIT
	CAILE	P1,1		;SET UNPMSB IF SPU.GT.1
	TLO	T1,UNPMSB##
	MOVEM	T1,UNIDES##(U)	;STORE NEW UNIDES
REPEAT	0,<			;DO THIS WITH ADDSWP NOW
	SETZM	UNIPTR##(U)	;INSURE NOT IN ASL
	LDB	T2,UNYK4S##	;ANY SWAPPING SPACE?
	JUMPE	T2,DEFST5	;JUMP IF NOT
	MOVEI	P4,SPTFIR##+1(P1) ;GET LENGTH OF SAT
	LSH	T2,K2PLSH##	;DOUBLE SIZE IF SWAP PAGES
	IDIVI	T2,^D36		;
	AOJ	T2,		;INSURE A ZERO WORD
	MOVN	T1,T2		;MAKE LENGTH -VE FOR AOBJN
	HRLM	T1,UNIPTR##(U)	;STORE IN UDB
	LSH	T2,1
	ADD	T2,P4		;COMPUTE # WORD IN SPT AND SAT
	CAIA			;GET CORE IF NEEDED
>				;END REPEAT 0
DEFST5:	MOVEI	T2,SPTFIR##+1(P1) ;T2=LENGTH OF SPT TABLE
DEFST6:
IFN	FTXMON,<
	PUSHJ	P,GFWNZ2##	;TRY SECTION 2
	  SKIPA			;WELL, MAYBE NOT
	JRST	DEFST7
	MOVEI	T2,SPTFIR##+1(P1);RESET LENGTH
>
	PUSHJ	P,GETWDS##	;GET CORE FOR IT
	  JRST	NCSDEF		;NOT ENOUGH--ERROR RETURN
DEFST7:	MOVEM	T1,UNISPT##(U)	;PUT SPT ADDR. IN UNIT D.B.
	SETOM	UNIFKS##(U)	;NO FREE SPACE FOR SWAPPING
	PUSH	P,M		;SAVE M
	HRRI	M,-1(P2)	;POINT M TO USERS TABLE
	MOVE	P2,T1
DEFST8:	PUSHJ	P,GETWD1##	;GET SPT POINTER
	MOVEM	T1,SPTFIR##(P2)	;STORE IT IN TABLE
	ADDI	P2,1
	SOJG	P1,DEFST8	;LOOP
	SETZM	(P2)		;ADD TERMINATING ZERO
REPEAT	0,<			;DO THIS WITH ADDSWP NOW
	LDB	T1,UNYK4S##	;GET SWAP K
	ADDI	P2,1
	SKIPE	T1		;ANK SWAPPING K?
	HRRM	P2,UNIPTR##(U)	;SAVE IN UDB
IFN FTXMON,<
	MOVSS	P2		;SECTION NUMBER
	DPB	P2,UNYSNS##	;STORE THAT EVEN THOUGH UNIPTR MAY BE 0
>
>				;END REPEAT 0
	POP	P,M		;RESTORE M
;CREATE A SAB RING
	LDB	P1,UNYSIC##	;P1=#SATS IN CORE
	MOVEI	P2,DIFSAB##(U)	;SO UNISAB GETS 1ST LINK
	SETZM	UNISAB##(U)	;INIDICATE NO RING SETUP YET
DEFS10:	LDB	T2,UNYWPS##	;T2=SAB LENGTH
	ADDI	T2,SABBIT##
DEFS11:
IFN	FTXMON,<
	PUSHJ	P,GFWNZ2##	;GET IN SECTION 2 IF CAN
	  SKIPA			;CAN'T
	JRST	DEFS12		;GOT IT
	LDB	T2,UNYWPS##	;RESET LENGTH
	ADDI	T2,SABBIT##
>
	PUSHJ	P,GETWDS##	;GET CORE FOR A SAB
	  JRST	DEFS13		;NOT ENOUGH--ERROR RETURN
DEFS12:	MOVEM	T1,SABRNG##(P2)	;LINK INTO RING
	MOVE	P2,T1
	SETO	T2,		;FORCE SAF BLOCK TO BE READ
	TLZ	T2,SAPDOB##	;CLEAR 'CHANGE' & 'BAD' BITS
	MOVEM	T2,SABFIR##(T1)
	LDB	T2,UNYWPS##	;SETUP AOBJ WD. FOR SABSCN
	MOVNS	T2
	HRLI	T2,SABBIT##
	MOVSM	T2,SABSCN##(T1)
	SOJG	P1,DEFS10	;LOOP ON P1
DEFS13:	MOVE	T1,UNISAB##(U)	;ALLOCATE ANY SABS?
	JUMPE	T1,NCSDEF	;NO--ERROR RETURN
	MOVEM	T1,SABRNG##(P2)	;YES-CLOSE THE RING
	SOJGE	P1,NCSDEF	;ERROR IF NOT ALL SABS ALLOCATED
	SOJG	P3,DEFST4	;LOOP ON NO. OF UNITS
	HRRZS	UNISTR##(U)	;END OF UNISTR CHAIN
;FINISH UP
	PUSHJ	P,BMPGEN	;SET UNIT GENERATION NUMBER
	HRRZ	T3,STRFSN##(F)	;GET F.S. #
	MOVEM	F,TABSTR##(T3)	;   AND MAKE TABSTR ENTRY
IFN FTMDA,<
	CAME	J,TLPJOB##	;PULSAR DOING THE MOUNT?
	PUSHJ	P,STRMPA##	;NO--TELL QUASAR WHATS GOING ON
> ;END IFN FTMDA
	JRST	CPOPJ1##	;RETURN TO HAPPY USER

;ERROR RETURNS WHICH UNDO WHAT WAS DONE
UNFDEF:	PUSHJ	P,REMOV
	JRST	UNFERR
UNADEF:	PUSHJ	P,REMOV
	JRST	UNAERR
NCSDEF:	PUSHJ	P,REMOV
	JRST	NCSERR
	PUSHJ	P,REMOV
	JRST	TMEERR
REMOV:	PUSHJ	P,REMFS		;DUMP STR D.B.
	PJRST	REMUN		; & UNIT D.B'S
;SUBROUTINE TO TRANSFER USER ARGS. INTO MONITOR
;ENTRY MVWRD:
;	GETS ONLY 1ST WORD OF USER TABLE  RETURNS IT IN T1
;	M=ADDR. OF USER'S PTR - 1 (BUMPED ON RETURN)
;ENTRY MVARG:
;	P1='XCT' TABLE ADDRESS--DESTROYED
;	M AS IN MVWRD

MVWRD:	MOVEI	P1,WD1TAB	;WILL GET ONLY 1ST WORD
MVARG:	AOS	M
	PUSHJ	P,GTWST2##	;GET USER PTR.
	PUSH	P,M		;SAVE M
	HRR	M,T1		;SET M TO USER PTR
	HLRZS	T1		;MAKE AOBJ WRD WITH USER LENGTH
	MOVNS	T1
	HRL	P1,T1
MVARG1:	PUSHJ	P,GTWST2##	;GET AN ARGUMENT
	AOS	M
	XCT	(P1)		;MOVE IT IN
	AOBJN	P1,MVARG1	;LOOP
	JRST	MPOPJ##		;RESTORE M

;FOR ENDING TABLES:
	DEFINE	XCTEND<
	JRST	MPOPJ##>
UNTAB:	;------UNIT DATA BLOCK VALUES------
SKIP			;(0) PHYS.DRIVE NAME
MOVEM	T1,UNIHID##(U)	;(1) UNIT ID
MOVEM	T1,UNILOG##(U)	;(2) LOGICAL (WITHIN F.S.) UNIT NAME
DPB	T1,UNYLUN##	;(3) LOGICAL UNIT # (WITHIN F.S.)
MOVEM	T1,S		;(4) STATUS BITS (SAVE IN S)
HRLM	T1,UNIGRP##(U)	;(5) # SEQ.BLKS. TO TRY FOR ON SEQ. OUTPUT
MOVEM	T1,UNITAL##(U)	;(6) # FREE BLOCKS LEFT ON UNIT
DPB	T1,UNYBPC##	;(7) BLOCKS/CLUSTER
HRRM	T1,UNICPS##(U)	;(10) CLUSTERS/SAT
DPB	T1,UNYWPS##	;(11) WORDS/SAF BLOCK
DPB	T1,UNYSIC##	;(12) # SAT BLKS. IN CORE
DPB	T1,UNYSPU##	;(13) SAT BLOCKS/UNIT
	UDBSPT==.-UNTAB	;OFFSET TO SPT TABLE POINTER
MOVEM	T1,P2		;(14) PTR TO SPT TABLE(SAVE IN P2)
PUSHJ	P,[SUBI T1,4	;(15) 1ST BLOCK FOR SWAPPING ON UNIT
	   MOVEM T1,UNISLB##(U)
	   POPJ P,]
DPB	T1,UNYK4S##	;(16) AMOUNT OF SWAPPING ON UNIT
XCTEND


FSTAB:	;------STR DATA BLOCK VALUES------
MOVEM	T1,STRNAM##(T2)	;(0) F.S. NAME
	SDBUNM==.-FSTAB	;OFFSET TO NUMBER OF UNITS
HRRM	T1,STRUNM##(T2)	;(1) # OF UNITS
MOVEM	T1,STRHGH##(T2)	;(2) HIGHEST LOGICAL BLK. #
MOVEM	T1,STRSIZ##(T2)	;(3) SIZE OF F.S. (BLOCKS)
MOVEM	T1,STRGAR##(T2)	;(4) MAX. GUARRENTEED FOR RESERVED QUOTAS
MOVEM	T1,STRRES##(T2)	;(5) # RESERVED FREE BLOCKS LEFT
MOVEM	T1,STRTAL##(T2)	;(6) # FCFS FREE BLKS. LEFT (- ASAFTY FACTOR)
MOVEM	T1,STROVR##(T2)	;(7) # BLKS. ALLOWED ON OVERDRAW
MOVEM	T1,STRPT1##(T2)	;(10) 1ST RET.PTR. TO MFD
DPB	T1,STY1PT##	;(11) 1 IF STRPT1 IS ONLY PTR TO UFD
DPB	T1,STYUN1##	;(12) F.S. UNIT # OF STRPT1
DPB	T1,STYTRY##	;(13) # RETRYS ON ERROR
MOVEM	T1,STRBPU##(T2)	;(14) NOMINAL BLKS/UNIT
HRLM	T1,STRBSC##(T2)	;(15) BLKS/SUPER CLUSTER
HRRM	T1,STRSCU##(T2)	;(16) SUPER CLUSTERS/UNIT
JFCL			;(17) STRJOB NOT SET BY .FSDEF ANYMORE
HLLM	T1,STYCNP##(T2)	;(20) BYTE PTR. TO RET.PTR CLUSTER COUNT
HLLM	T1,STYCKP##(T2)	;(21) ...CHK.SUM
HLLM	T1,STYCLP##(T2)	;(22) ...CLUSTER ADDRESS
IFN FTPSTR,<
DPB	T1,STYPV2##	;(23) 1 IF STR IS PRIVATE
>
IFE FTPSTR,<
	JFCL
>
MOVEM	T1,STRPPN##(T2)	;(24) PPN OF THE OWNER OF THIS F.S.
MOVEM	T1,STRCRS##(T2)	;(25) BLOCK IN STR OF RIB FOR CRASH.EXE
HRRM	T1,STRK4C##(T2)	;(26) K FOR CRASH
IFE FTSETS,<
	JFCL
>; END IFE FTSETS
IFN FTSETS,<
DPB	T1,STYSE2##	;(27) SET NUMBER
>; END IFN FTSETS
WD1TAB:	XCTEND	;NULL XCT-TABLE FOR MVWRD
;ROUTINE TO ENSURE ARGUMENTS FOR THE STRUUO DEFINE STRUCTURE
;FUNCTION ARE IN CORE (SINCE PULSAR IS USUALLY VIRTUAL) SO WE
;DON'T RESTART THE UUO AND LOSE FREE CORE, ETC.

DEFINC:	PUSH	P,M		;SAVE ORIGINAL ARGUMENT POINTER
	PUSHJ	P,GETWD1##	;GET POINTER TO SDB DATA
	PUSHJ	P,DEFCKP	;ADDRESS CHECK THE STRUCTURE DATA BLOCK DATA
	PUSH	P,M		;SAVE POINTER A MOMENT
	HRRI	M,SDBUNM(T1)	;ADDRESS OF WORD CONTAINING # OF UNITS
	PUSHJ	P,GETWDU##	;GET IT
	MOVE	P1,T1		;COPY COUNT TO P1
	POP	P,M		;RESTORE POINTER
DEFIN1:	PUSHJ	P,GETWD1##	;GET NEXT UNIT POINTER
	PUSHJ	P,DEFCKP	;ADDRESS CHECK THE UNIT DATA BLOCK DATA
	PUSH	P,M		;SAVE POINTER A MOMENT
	HRRI	M,UDBSPT(T1)	;ADDRESS OF WORD CONTAINING SPT TABLE POINTER
	PUSHJ	P,GETWDU##	;GET IT
	PUSHJ	P,DEFCKP	;ADDRESS CHECK THE SPT TABLE
	POP	P,M		;RESTORE POINTER
	SOJG	P1,DEFIN1	;LOOP FOR ALL UNITS
	JRST	MPOPJ##		;RESTORE ORIGINAL POINTER AND RETURN

;HELPER ROUTINE TO CHECK A POINTER TO DATA.  CALL WITH POINTER
;(LEN,,ADDR) IN T1, RESOLVES TO ADDR IN T1, LEN IN T2.  NEVER
;RETURNS IF ADDRESS CHECK (EXITS VIA UADERR).

DEFCKP:	HLRZ	T2,T1		;GET LENGTH
	HRRZS	T1		;ISOLATE ADDRESS
	PUSHJ	P,ARNGE##	;MAKE SURE IN CORE
	 POPJ	P,		;OK IF NOT LEGAL FOR I/O
	  JRST	UADERR##	;ADDRESS CHECK
	POPJ	P,		;LOOKS OK
SUBTTL STRUUO UUO - REDEFINE F.S. STATUS
;FUNCTION TO REDEFINE A FILE STRUCTURE, WHICH MEANS CHANGING THE BITS

RDFSTR:	JSP	T4,PRIVJ	;MUST BE PRIVILEGED
	JSP	T4,STLOCK	;GET FF RESOURCE
	PUSHJ	P,CKJPPN	;MAKE F=USER JOB # (OR 0 FOR SYS.SRC.LST)
	  JRST	PPNERR		;BAD JOB # - PPN PAIR
	PUSHJ	P,GETWD1##	;GET STR NAME
	PUSHJ	P,SRSTR		;SEE IF IT EXISTS
	  JRST	SNXERR		;NO
	MOVE	T1,STRMNT##(T3)	;MOUNT COUNT MUST = 0 OR 1
	SOJG	T1,MCNERR
	HRRZ	P1,STRJOB##(T3)	;   OR JOB MUST BE ONLY USER
	CAME	P1,F
	JUMPE	T1,MCNERR
	PUSHJ	P,GETWD1##	;GET NEW STATUS BITS IN T1
	SETZM	STRJOB##(T3)
	SKIPE	STRMNT##(T3)	;IF M.C.=1
	HRROM	F,STRJOB##(T3)	;   LH (STRJOB) = -1
	TLNE	T1,DEFSAF	;IF SINGLE ACCESS
	HRRZM	F,STRJOB##(T3)	;   RH (STRJOB) = F
	SETZB	P1,P2
	TLO	P2,UNPSTS##	;CONVERT UUO BITS TO UNIDES BITS
	TLNE	T1,DEFAWL
	TLO	P1,UNPAWL##

RDFST1:	ANDCAM	P2,UNIDES##(U)
	ORM	P1,UNIDES##(U)
	HLRZ	U,UNISTR##(U)
	JUMPN	U,RDFST1
	JRST	CPOPJ1##
SUBTTL STRUUO UUO - LOCK OUT## A F.S.
;FUNCTION TO LOCK OUT NEW INIT'S, ENTER'S, ETC.

LOKSTR:	JSP	T4,PRIVJ	;MUST BE PRIVILEGED TO DO THIS
	JSP	T4,STLOCK	;GET FF RESOURCE
	PUSHJ	P,GETWD1##	;GET FILE STRUCTURE
	PUSHJ	P,SRSTR		;SEE IF IT EXISTS
	  JRST	SNXERR		;NO
LCKSTR:	MOVSI	T1,UNPNNA##	;NO NEW ACCESS BIT
IFN FTMDA,<
	MOVE	T2,DATE##	;GET CURRENT DATE
> ;END IFN FTMDA
LOKST1:	IORM	T1,UNIUST##(U)
IFN FTMDA,<
	MOVEM	T2,UNILTM##(U)	;MARK TIME OF LOCK
> ;END IFN FTMDA
	HLRZ	U,UNISTR##(U)
	JUMPN	U,LOKST1
IFN FTMDA,<
;SET JS.OLS FOR ALL JOBS WHICH HAVE MOUNTED
; THE JUST-LOCKED STRUCTURE

	PUSHJ	P,SAVE2##	;AND SOME P'S
	PUSH	P,J		;SAVE CURRENT JOB
	MOVE	J,HIGHJB##	;GET HIGHEST JOB IN USE
	HRRZ	P1,STRFSN##(T3)	;GET LOCKED STR NUMBER

LOKST2:	PUSHJ	P,SLPTR		;MAKE PTR IN P2 FOR THIS JOB
	 JRST	LOKST3		;CAN'T, TRY NEXT JOB
	MOVE	T1,P1		;GET BACK STR NUMBER
	MOVSI	T2,(JB.LBT)	;GET BATCH BIT
	TDNN	T2,JBTLIM##(J)	;IS THIS JOB BATCH?
	PUSHJ	P,SLFND		;NO, DOES JOB HAVE STR?
	 JRST	LOKST3		;BATCH, OR NOT MOUNTED, QUIT
	MOVSI	T1,(JS.OLS)	;T/S WITH STR MOUNTED,
	IORM	T1,JBTST2##(J)	; LITE BIT FOR RESET CHECK.
LOKST3:	SOJG	J,LOKST2	;CHECK ALL JOBS
	POP	P,J		;RESTORE LOCKER'S JOB #
> ;END IFN FTMDA
	JRST	CPOPJ1##


IFN FTMDA,<
;FUNCTION TO CLEAR LOCK OUT NEW INIT'S, ENTER'S, ETC.

CLKSTR:	JSP	T4,PRIVJ	;MUST BE PRIVILEGED TO DO THIS
	JSP	T4,STLOCK	;GET FF RESOURCE
	PUSHJ	P,GETWD1##	;GET FILE STRUCTURE
	PUSHJ	P,SRSTR		;SEE IF IT EXISTS
	  JRST	SNXERR		;NO
	MOVSI	T1,UNPNNA##	;NO NEW ACCESS BIT
	TDNE	T1,UNIUST##(U)	;WAS THE STRUCTURE LOCKED
	SKIPN	UNILTM##(U)	; AND BY THE OPERATOR
	PJRST	ILFERR		;NO THEN ILLEGAL
CLKST1:	ANDCAM	T1,UNIDES##(U)
	SETZM	UNILTM##(U)	;STORE THE TIME OF THE LOCK COMMAND
	HLRZ	U,UNISTR##(U)
	JUMPN	U,CLKST1
	JRST	CPOPJ1##
>;END IFN FTMDA
;SUBROUTINE CHKLOK - CHECK THE STATUS OF THE LOCK BIT FOR A UNIT
;CALL	MOVEI	U,POINTER TO THE UNIT
;	PUSHJ	P,CHKLOK
;RETURN	CPOPJ		;UNIT IS LOCKED BY THE SYSTEM (NO ACCESS)
			; OR LOCKED BY THE OPERATOR FOR THIS JOB
;	CPOPJ1		;UNIT IS NOT LOCKED

IFN FTMDA,<
CHKLOK::
	PUSHJ	P,SAVT##
	MOVE	T1,UNIUST##(U)	;GET THE LOCK WORD
	TLNN	T1,UNPNNA##	;IS THE STRUCTURE LOCKED
	JRST	CPOPJ1##	;NO, CONTINUE
	SKIPN	UNILTM##(U)	;GET THE TIME OF THE LOCK (IF BY OPR)
	JRST	CPOPJ1##		;NOT BY THE OPERATOR (SYSTEM LOCK)
	PUSHJ	P,SAVJW##
	MOVE	J,.CPJOB##	;GET THE JOB NUMBER
	PUSHJ	P,FNDPDB##	;YES, FIND THE PDB
	JRST	CPOPJ1##	;NO PDB?!
	MOVE	T1,UNILTM##(U)	;GET THE LOCK TIME
	MOVSI	T2,(JB.LBT)	;GET BATCH BIT
	TDNE	T2,JBTLIM##(J)	;IS THIS JOB BATCH?
	JRST	CPOPJ1##	;YES, LET IT IN.
	MOVSI	T2,JACCT	;IF JACCTED
	TDNN	T2,JBTSTS##(J)	;SKIP IF BATCH
	CAMLE	T1,.PDSTM##(W)	;T/S, WAS JOB USING STR BEFORE LOCK?
	AOS	(P)		;UNIT LOCKED BY OPERATOR BUT OK FOR THIS JOB
	POPJ	P,
>;END IFN FTMDA
SUBTTL STRUUO UUO - REMOVE A F.S.
;FUNCTION TO REMOVE A FILE STRUCTURE FROM THE SYSTEM

REMSTR:	JSP	T4,PRIVJ	;MUST BE PRIVILEGED TO DO THIS
	PUSHJ	P,GETWD1##	;GET STR NAME
	TDZA	T2,T2		;USE T2 AS A FLAG TO
RMVSTR::SETOM	T2		; REMEMBER ENTRY POINT
	PUSHJ	P,SAVE4##	;SAVE P1-P4
	JSP	T4,STLOCK	;GET FF RESOURCE
	PUSHJ	P,SRSTR		;SEE IF WE EXIST
	  JRST	CPOPJ1##	;NO, EXIT
	PUSHJ	P,CHKSWP	;INSURE NO UNITS IN ASL
	  JUMPE	T2,ASLERR	;GIVE FAIL RETURN IF ENTRY AT REMSTR
	MOVE	F,T3		;SAVE STR D.B. ADDR.
	PUSH	P,T2		;SAVE ENTRY FLAG

	MOVSI	T1,UNPNNA##	;HAS STR BEEN LOCKED AGAINST NEW ACCESSES?
	TDNN	T1,UNIUST##(U)	;...
	PUSHJ	P,LCKSTR	;NO, DO SO NOW
	  JFCL			;SKIP RETURNS
	PUSHJ	P,WATIDL	;WAIT FOR STR TO BECOME IDLE

	SETOM	STRSDL##(F)	;REMOVE FROM THE SDL
	PUSHJ	P,SDLBLD##	;REBUILD THE PRESERVED SDL
	  JFCL			;BOOTSTRAP NOT AVAILABLE
	MOVSI	U,MJOBN##	;MINUS MAXIMUM NUMBER OF JOBS
	HRRZ	T1,STRFSN##(F)	;T1=F/S#

REMST1:

;HERE FOR EACH JOB NUM., REMOVE FSN IF IN JOB'S SEARCH LIST
;RH(U) = JOB NUMBER OR 0 (FOR SYS SL), T1=FSN
	HRRZ	J,U
	PUSHJ	P,SLPTR
	  JRST	REMST4		;NO SUCH SEARCH LIST
	PUSHJ	P,SLFND
	  JRST	REMST4		;JUMP IF FSN NOT IN SL.
	PUSHJ	P,REMSL		;ELSE REMOVE IT

REMST4:	AOBJN	U,REMST1	;CHECK ALL SEARCH LISTS
;	RETURN ALL CORE BLOCKS

	HRRZ	P4,STRFSN##(F)	;REMCB WANTS F.S. # IN P4
	PUSHJ	P,REMCB		;RETURN CORE FOR NMB,UFB, AND ACL BLOCKS
	HLRZ	U,STRUNI##(F)	;START AT 1ST UNIT IN F/S
REMST5:	PUSHJ	P,CSDELU##	;INVALIDATE DISK CACHE FOR THIS UNIT
	HRRZ	T2,UNIPTR##(U)	;DE-ALLOCATE ANY SWAPPING SAT CORE
IFN FTXMON,<
	LDB	T1,UNYSNS##	;FROM THE RIGHT SECTION
	HRLI	T2,(T1)		;..
>
	HLRE	T1,UNIPTR##(U)	;HOW MUCH
	JUMPE	T1,REMST6	;NOTHING
	SETZM	UNIPTR##(U)	;DON'T HAVE ANY MORE SWAPPING SAT
	SETZM	UNIK4S##(U)	;NO MORE SWAPPING SPACE AVAILABLE ON UNIT
	MOVNS	T1
	PUSHJ	P,TSTGIV	;RETURN THE CORE
REMST6:	HLRZ	U,UNISTR##(U)	;GET NEXT UNIT
	JUMPN	U,REMST5	;IF ANY
	PUSHJ	P,REMUN		;RETURN THE UNIT DB.S
	POP	P,T2		;RESTORE FLAG
IFN FTMDA,<
	MOVE	T1,.CPJOB##	;GET OUR JOB NUMBER
	SKIPN	T2		;REPORT CHANGE IF DETACHING CPU
	CAME	T1,TLPJOB##	;IS IT PULSAR?
	PUSHJ	P,REMMPA##	;TEL MDA
>
	PUSHJ	P,REMFS		;RETURN STR D.B., # ETC.
	JRST	CPOPJ1##	;   AND SKIP RETURN TO USER
;ROUTINE TO BUMP UNIGEN OF ALL UNITS IN STR AND WAIT FOR STR
;TO BECOME IDLE.
;CALL:
;	F/ STR DB ADDR

WATIDL:	PUSHJ	P,BMPGEN	;BUMP GENERATION NUMBER OF ALL UNITS
	PUSH	P,F		;SAVE F
	SETZ	F,		;DON'T DIDDLE WITH EVM
	PUSHJ	P,GVCBJ		;GIVE UP THE CB SO OTHERS BLOCKED IN FILSER
				; CAN COMPLETE BEFORE WE RETURN
	POP	P,F		;RESTORE F

;NOW WAIT FOR ALL UNITS TO BECOME IDLE

WATID1:	HLRZ	U,STRUNI##(F)	;BACK TO FIRST UNIT
WATID2:	SKIPE	UNIQUE##(U)	;ANYTHING QUEUED?
	JRST	WATID3		;YES, MUST WAIT A WHILE LONGER
	SKIPE	T1,UNISTS##(U)	;GET UNIT STATUS, SKIP IF UNIT IS IDLE
	CAIL	T1,OWCOD##	;SOME FLAVOR OF OPR WAIT?
	SKIPA			;IDLE OR IN OPR WAIT
	JRST	WATID3		;UNIT ISN'T IDLE
	HLRZ	U,UNISTR##(U)	;NEXT UNIT IN THIS STR
	JUMPN	U,WATID2	;LOOP FOR ALL
	PUSH	P,F		;SAVE F A BIT
	SETZ	F,		;DON'T DIDDLE WITH EVM
	PUSHJ	P,GETCB		;GET CB BACK
	JRST	FPOPJ##		;RETURN

WATID3:	MOVEI	T1,1		;WAIT FOR A SECOND
	PUSHJ	P,SLEEPF##	;ZZZ
	JRST	WATID1		;CHECK AGAIN
SUBTTL	STRUUO - UFD INTERLOCK
LKCLNA==3			;MUST HAVE 3 ARGS INCLUDING FUNCTION CODE
ULKSTR:	TDZA	P3,P3		;CLEAR P3 AND SKIP
UCLSTR:	SETO	P3,		;SET P3 NON-0
	JSP	T4,PRIVJ	;ONLY RETURN IF PRIVILEGED JOB
	HLRZ	T1,P4		;T1=NUMBER OF ARGS
	CAIGE	T1,LKCLNA	;MUST HAVE ENOUGH ARGS
	PJRST	ILLERR		;NOT ENOUGH ARGUMENTS
	PUSHJ	P,GETWD1##	;GET STR NAME
	MOVE	P1,T1		;SAVE IN P1 FOR LOKPPB OR NLKPPB
	PUSHJ	P,GETWD1##	;GET PPN
	MOVE	P2,T1		;SAVE IN P2 FOR LOKPPB OR NLKPPB
	PJUMPE	P3,LOKPPB	;IF ILK, CALL LOKPPB TO TEST/SET
	PUSHJ	P,NLKPPB	;ELSE CALL NLKPPB TO CLEAR
	PJRST	CPOPJ1##	;AND RETURN OK
;CODE TO INTERLOCK FILSER DATA BASE FOR STR UUOS
;   I.E. DO ONE UUO AT A TIME

;	JSP	T4,STLOCK
;	--WILL BE UNLOCKED BY MATCHING POPJ (OR CPOPJ1)--

STLOCK:	SETZM	F		;INDICATE NO DDB
	PUSHJ	P,CBWAIT##
	PUSHJ	P,(T4)
	SOS	(P)
	SETZM	F		;INDICATE NO DDB
	PJRST	GVCBJ1
;SUBROUTINE TO TEST/SET UFD INTERLOCK
;ENTER WITH P1=STR NAME   P2=PRJ-PRG
;CALL LOKPPB TO TEST/SET INTERLOCK
;RETURN CPOPJ IF UFD WAS ALREADY INTERLOCKED
;CPOPJ1 IF IT WAS NOT - IT NOW IS INTERLOCKED
LOKPPB:	PUSHJ	P,PPBBIT	;GET L(UFB), BIT TO TEST
	  PJRST	SNXERR		;NOT F/S NAME - ERROR RETURN
	TDNE	T1,PPBLOK##(T2)	;%LOCKED?
	PJRST	GVCBJ		;%YES - NON SKIP RETURN
	ORM	T1,PPBLOK##(T2)	;%NO. NOW IT IS
	PJRST	GVCBJ1		;%GIVE UP CB AND SKIP-RETURN

;SUBROUTINE TO CLEAR THE UFD INTERLOCK
;CALL WITH P1=STR NAME   P2=PRJ-PRG
;ALWAYS RETURNS CPOPJ
NLKPPB:	PUSHJ	P,PPBBIT	;GET UFB, BIT TO CLEAR
	  POPJ	P,		;NOT AN STR NAME
	ANDCAM	T1,PPBLOK##(T2)	;%CLEAR THE BIT
	MOVE	T1,P2		;%GET PPN
	PJRST	TSTPPX##	;%AND TRY TO REMOVE PPB


;SUBROUTINE TO COMPUTE THE UFB LOC, AND BIT POSITION FOR LOKPPB/NLKPPB
;ENTER WITH P1=STR NAME, P2=PRJ-PRG
;EXIT CPOPJ  IS P1 IS NOT AN STR NAME
;EXIT CPOPJ1 OK, WITH T1=BIT,  T2= UFB LOC RETURNS WITH CB RESOURCE
PPBBIT:	MOVE	T1,P1		;STR NAME
	PUSHJ	P,SRSTR		;FIND THE STR
	  POPJ	P,		;NOT AN STR
	HRRZ	T1,T4		;INDEX OF STR
	PUSHJ	P,FSNPS2	;POSITION BIT FOR THE STR
	PUSH	P,T2		;SAVE THE BIT
	MOVE	T1,P2		;PRJ-PRG
	MOVEI	F,0		;INDICATE NO DDB
	PUSHJ	P,GETCB
	HLRZ	T2,SYSPPB##	;%1ST PPB IN SYSTEM
	MOVEI	T3,DIFPPL##	;%IN CASE THIS CREATES 1ST PPB BLOCK
	PUSHJ	P,LSTSRC	;%FIND PPB FOR THIS USER (MAY CREATE ONE)
	SKIPE	T2		;%CREATED ONE
	PJRST	TPOPJ1##	;%RESTORE THE BIT INTO T1 AND RETURN
	POP	P,(P)		;ADJUST STACK
	POP	P,(P)
	PUSHJ	P,GVCBJ		;RETURN THE CB
	PJRST	NCSERR		;NO FREE CORE - ERROR RETURN
;SUBROUTINE TO UNLINK STR D.B. & RETURN CORE IF IN FREE CORE,
; CLEAR STRNAM IF PERMANENTLY ASSIGNED MONITOR CORE
;CALL	F=ADDR. STR D.B.
;MAY ALSO BE CALLED BY THE DEFINE FUNCTION (SUBROT REMOV)

REMFS:	HRRZ	T1,STRFSN##(F)	;GET STR#
	SETZM	TABSTR##(T1)	; & RETURN IT
	PUSHJ	P,REMSEG##	;DELETE ALL SHARABLE HIGH SEGMENTS
				; INITIALIZED FROM THIS STR
				; (MARK FOR DELETION IF STILL IN USE)
	MOVEI	T1,DIFSTR##	;REMOVE FROM SYSSTR CHAIN
REMFS0:	MOVE	T2,T1
	HLRZ	T1,STRSYS##(T1)
	JUMPE	T1,REMFS1
	CAME	T1,F
	JRST	REMFS0
	MOVE	T1,STRSYS##(T1)
	HLLM	T1,STRSYS##(T2)
REMFS1:	MOVE	T2,F		;RETURN THE FREE CORE
	MOVEI	T1,STRLEN##
	PJRST	TSTGIV


;SUBROUTINE TO REMOVE F.S. FROM SEARCH LIST WORD
;CALL P2 = PTR TO FSN TO REMOVE
;	USES T3,T4
;STOPCD AES IF P2 POINTS TO END OF SL. OR IMPOSSIBLE RETURN FROM SLBLT

REMSL:	PUSHJ	P,SAVE3##	;SAVE SOME ACS
	PUSH	P,T1
	MOVE	P3,P2		;P3=PTR TO FSN TO REMOVE
	PUSHJ	P,SLGET
	  PUSHJ	P,SLXAES	;STOPCD AES
	PUSHJ	P,SLINC
	  PUSHJ	P,SLXAES
	PUSHJ	P,SLBLT		;BLT OVER FSN TO BE REMOVED
	  PUSHJ	P,SLXAES	;CANT HAPPEN
	PJRST	TPOPJ##		;DONE - RETURN
;SUBROUTINE TO SET F.S. UNITS TO 'NO PACK  MOUNTED' AND
;   RETURN ANY FREE CORE USED
;CALL:		F=ADDRESS STR D.B.
;		;  USES U
;MAY ALSO BE CALLED BY THE DEFINE FUNCTION (SUBROT REMOV)

REMUN:	HLRZ	U,STRUNI##(F)
	JUMPE	U,CPOPJ##	;RETURN IF NO UNITS
	PUSHJ	P,BMPGEN	;SET UNIT GENERATION NUMBER
	HLRZ	U,STRUNI##(F)	;GET 1ST UNIT BACK
REMUN1:	SETZM	UNIHID##(U)	;CLEAR UNIT, ID
	SETZM	UNILOG##(U)	;   AND LOG. NAME
	HLLZS	UNIFKS##(U)
	HLLZS	UNISTR##(U)	; & PTR TO STR DB
IFN FTDUAL,<
	SKIPN	T1,UNI2ND##(U)	;DUAL PORTED
	JRST	REMUN2		;NO
	SETZM	UNIHID##(T1)	;CLEAR UNIT ID AND
	SETZM	UNILOG##(T1)	; LOG NAME FOR 2ND PORT ALSO
	HLLZS	UNISTR##(T1)
REMUN2:
>
	PUSHJ	P,CSDELU##	;INVALIDATE DISK CACHE FOR THIS UNIT
	MOVEI	T1,UNVNPM##	;SET STATE TO NO PACK MOUNTED
	DPB	T1,UNYUST##
	MOVEI	T1,-1		;DONT KNOW HOW MANY
	DPB	T1,UNYBCT##	; SLOTS LEFT IN BAT BLOCK
	MOVSI	T1,UNPNNA##	;MAKE SURE NO NEW ACCESSES IS OFF
	ANDCAM	T1,UNIUST##(U)	; SO OMOUNT WILL FIND UNIT
IFN FTMDA,<
	SETZM	UNILTM##(U)	;CLEAR LOCK TIME
> ;END IFN FTMDA
	PUSHJ	P,SSTGIV	;GIVE BACK CORE FOR SAB AND SPT

	HLRZ	U,UNISTR##(U)	;GET ADDR OF NEXT UNIT ON STR
	JUMPN	U,REMUN1	;LOOP FOR ALL

	POPJ	P,
;ROUTINE TO SET THE UNIT GENERATION NUMBER ON ALL UNITS IN STR.
BMPGEN:	HLRZ	U,STRUNI##(F)	;GET 1ST UNIT
	AOS	T1,SYSGEN##	;BUMP COUNT
BMPGN1:	HRRZM	T1,UNIGEN##(U)	;STORE IN PRIME PORT
IFN FTDUAL,<
	SKIPE	T2,UNI2ND##(U)	;AND IN SECOND PORT
	HRRZM	T1,UNIGEN##(T2)
>
	HLRZ	U,UNISTR##(U)	;STEP TO NEXT UNIT IN STR
	JUMPN	U,BMPGN1	;AND LOOP
	POPJ	P,
;SUBROUTINE TO RETURN CORE ALLOCATED FOR SAB AND SPT FOR A UNIT
;ARG	U=ADDR OF UNIT DATA BLOCK

SSTGIV:	PUSHJ	P,SAVE4##
	SE1ENT			;MUST BE IN SECTION 1 TO FOLLOW THE SAB RING
	MOVE	P3,UNISAB##(U)	;P3=ADDR OF SAB RING
	JUMPE	P3,SSTGV2	;JUMP IF NO RING SET UP
	SETZM	UNISAB##(U)	;SAY WE'VE GIVEN BACK SAB
	MOVE	P2,P3
	LDB	P4,UNYWPS##	;DATA WORDS PER SAT BLOCK
SSTGV1:	MOVE	T2,P3		;T2=ADDR OF CURRENT SAB BLOCK
	MOVE	P3,SABRNG##(P3)	;P3=ADDR OF NEXT
	MOVEI	T1,SABBIT##(P4)	;T1=NUMBER OF WORDS PER SAB
	PUSHJ	P,TSTGIV
	CAME	P3,P2		;GONE AROUND THE RING?
	JRST	SSTGV1		;NO, LOOK AT NEXT ONE
SSTGV2:	MOVE	T2,UNISPT##(U)	;START OF SPT
	JUMPE	T2,CPOPJ##	;JUMP IF NO SPT SET UP
	SETZM	UNISPT##(U)	;SAY WE'VE GIVEN BACK SPT
	LDB	T1,UNYSPU##	;NUMBER OF WRDS IN SPT
	ADDI	T1,SPTFIR##+1	; + OVERHEAD
;	PJRST	TSTGIV		;RETURN THE SPACE AND RETURN

TSTGIV:	MOVEI	T3,GIVWDS##	;ASSUME LOW CORE
	TLNN	T2,-1		;NZS CORE?
	CAMGE	T2,LOCORE##	;OR ONCE CORE?
	MOVEI	T3,GVFWDS##	;YES
	PJRST	(T3)
;SUBROUTINE TO RETURN CORE AND FIX CORE BLOCKS FOR
;   A DISAPEARING F.S.
;CALL:		P4=F.S. #
;		;USES P1,P2,P3

;SCAN ALL PPB BLOCKS

REMCB:	MOVEI	P1,DIFPPL##
REMCB2:	HLRZ	P1,PPBSYS##(P1)	;P1=NEXT PPB BLOCK
	JUMPE	P1,CPOPJ##	;RETURN IF NO MORE PPB BLOCKS
	MOVE	T1,P4		;CLEAR KNO, YES, AND LOK BITS
	PUSHJ	P,FSNPS2
	ANDCAM	T2,PPBKNO##(P1)	;CLEAR KNO
	ANDCAM	T2,PPBYES##(P1)	;  YES
	ANDCAM	T2,PPBLOK##(P1)	;  CLEAR UFD INTERLOCK BITS

;REMOVE ANY UFB BLOCKS WITH THIS F.S. #

	MOVEI	T2,DIFPBC##(P1)
REMCB4:	MOVE	T3,T2		;REMEMBER AS PREVIOUS BLOCK
	HLRZ	T2,UFBPPB##(T2)	;T2=NEXT UFB BLOCK
	JUMPE	T2,REMCB5	;JUMP IF END OF CHAIN
	LDB	T1,UFYFSN##	;T1=ITS F.S.#
	CAIE	T1,(P4)		;SAME AS ONE WE'RE REMOVING?
	JRST	REMCB4		;NO--GET NEXT BLOCK
	MOVE	T4,T2		;YES - REMOVE IT
	PUSHJ	P,RET4WD##

;SCAN ALL NMB BLOCKS FOR THIS PPB BLOCK

REMCB5:	MOVEI	P2,DIFPNL##(P1)
REMCB6:	HLRZ	P2,NMBPPB##(P2)	;P2=NEXT NMB BLOCK
	JUMPE	P2,REMCB2	;JUMP IF NO MORE NMB'S
	TRZE	P2,NMPUPT##	;IF UPWARD POINTER FROM LOWER SFD
	JRST	REMC6B		; DO IT NOW
REMC6A:	HLRZ	T1,NMBRNG##(P2)	;IS THIS AN SFD NMB?
	SKIPE	T1
	TRZE	T1,NMPUPT##	;WHICH POINTS AT A LOWER-LEVEL NMB CHAIN?
	JRST	REMC6B		;NO
	HRRZ	P2,T1		;YES, DROP DOWN TO THAT CHAIN
	JRST	REMC6A		;AND TEST THE NMBS ON THAT LEVEL
REMC6B:	MOVE	T1,P4		;FSN
	PUSHJ	P,FSNPS2	;GET BIT TO CLEAR KNO & YES
	ANDCAM	T2,NMBKNO##(P2)
	ANDCAM	T2,NMBYES##(P2)
	MOVE	T2,P2		;DOES NMB HAVE OUR F.S.#?
	LDB	T1,NMYFSN##
	CAIN	T1,(P4)
	HLLZS	NMBCFP##(P2)	;YES - CLEAR CFP
;FIND ALL A.T.'S WITH THIS F.S. #

REMCBX:	MOVEI	T1,DIFNAL##(P2)
REMCB7:	HLRZ	T1,ACCNMB##(T1)	;T1=NEXT A.T.
	TRNE	T1,DIFNAL##	;END OF RING?
	JRST	REMCB6		;YES-GET NEXT NMB BLOCK
	LDB	T2,ACZFSN##	;NO--T2=ITS F.S. #
	CAIE	T2,(P4)		;SAME AS ONE WE'RE REMOVING?
	JRST	REMCB7		;NO--KEEP LOOKING

	LDB	T2,ACYCNT##	;NUMBER OF READERS ON THIS F/S
	MOVNS	T2
	ADDM	T2,NMBCNT##(P2)	;DECREMENT NMB USE-COUNT
	ADDM	T2,PPBCNT##(P1)	;DECREMENT PPB USE-COUNT

;REMOVE THE A.T.

	PUSH	P,F		;TELL ATRMOV 'NO DDB'
	SETZ	F,
	PUSHJ	P,ATRMOV	;REMOVE IT AND RETURN ITS CORE
	POP	P,F
;HERE TO TEST IF ANYBODY HAD THEIR PATH SET TO AN
;SFD THAT EXISTED ON THE STR WE JUST YANKED.
	MOVE	T3,HIGHJB##	;STARTING JOB
REMCBY:	HRRZ	T4,JBTSFD##(T3)	;PATH SET HERE?
	TRZ	T4,CORXTR##
	CAME	T4,P2
	JRST	REMCBZ		;NO
	AOS	NMBCNT##(P2)	;YES, WE ADJUSTED COUNT TOO MUCH
	AOS	PPBCNT##(P1)	;SET PATH BUMPS ONLY ACCCNT
	MOVE	T2,JBTSFD##(T3)	;GET SCAN SWITCH
	ANDI	T2,CORXTR##-JBPUFB##
	ADDI	T2,JBPUFB##(P1)	;BUILD POINTER TO UFD
	HLRZ	T4,NMBACC##(P2)	;SFD EXIST ONLY ON YANKED STR?
	TRNE	T4,DIFNAL##	;I.E. NO ACCS LEFT
	HRRM	T2,JBTSFD##(T3)	;YES, SET PATH TO UFD
REMCBZ:	SOJG	T3,REMCBY	;NEXT JOB
	JRST	REMCBX		;CHECK NEXT ACC
;SUBROUTINE TO GET JOB # & PPN FROM ARG. LIST AND CK FOR A MATCH
;CALL:		UUO=ADDRESS-1 OF JOB # ARG.
;		    PPN ARG. FOLLOWS
;RETURN+0	IF RIDICULOUS JOB # OR DOESNT MATCH PPN
;RETURN+1	IF JOB # ARG. MATCHES PPN ARG.: F=JOB # ARG. T1=PPN ARG
;		IF JOB # ARG.=PPN ARG.=-1: F=J (CURRENT JOB #) T1=JOBS PPN
;		IF JOB # ARG. = 0, :  F = 0 (SYS.SRC.LIST) T1=SYSPPN

CKJPPN:	PUSHJ	P,GETWD1##	;T1=JOB # (1ST ARG.)
	JUMPN	T1,CKJPP2	;IF 0:
	PUSHJ	P,GETWD1##	;   FORCE PPN=SYSPPN
	MOVE	T1,SYSPPN##
	SETZ	F,		;   RETURN 0 FOR SYS.SRC.LST
	JRST	CPOPJ1##
CKJPP2:	SKIPG	T1		;IF -1: USE CURRENT JOB #
	MOVE	T1,J		;F=JOB NUMBER
	PUSHJ	P,LGLPRC##	;LEGAL JOB #?
	  POPJ	P,		;NO
	MOVE	T4,JBTSTS##(T1)	;MAYBE  (CK JNA BIT)
	TLNN	T4,JNA
	POPJ	P,		;NO
	MOVE	F,T1		;YES--MAKE F=JOB #
	PUSHJ	P,GETWD1##	;T1=PPN
	SKIPG	T1		;IF -1: USE CURRENT PPN
	MOVE	T1,JBTPPN##(F)
	CAME	T1,JBTPPN##(F)	;IS PPN FOR THIS JOB #?
	POPJ	P,		;NO
	JRST	CPOPJ1##	;YES--GOOD MATCH
;SUBROUTINE TO FIND A 0 ENTRY IN TABSTR
;EXIT P2=INDEX TO ENTRY
SRCTBS:	MOVE	P2,STRAOB##	;AOBJN WORD FOR TABSTR
	SKIPLE	TABSTR##(P2)
	AOBJN	P2,.-1
	JUMPL	P2,CPOPJ1##
	POPJ	P,		;NO SLOTS AVAILABLE


;SUBROUTINE TO CK FOR PRIVILEGED JOB (FAILSAFE PPN OR JACCT LIT)
;CALL:	JSP	T4,PRIVJ
;		J=JOB #
;		PRESERVES T1
;RETURNS IF PRIVILEGED OTHERWISE GOES TO NPVERR
PRIVJ:	MOVE	T3,JBTPPN##(J)	;IS IT FAILSAVE
	MOVE	T2,JBTSTS##(J)	;    OR JACCT=1?
	CAME	T3,FFAPPN##
	TLNE	T2,JACCT
	JRST	(T4)		;YES-RETURN
	JRST	NPVERR		;NO--ERROR RETURN TO USER


;SUBROUTINE TO INSURE THAT NO UNITS IN A STR ARE IN THE ASL.
;CALL:	U=UDB FOR FIRST UNIT IN STR
;	PUSHJ	P,CHKSWP
;RETURN+0 IF SOME UNIT IN ASL
;RETURN+1 IF NONE IN ASL
;RESPECTS T2,T3

CHKSWP:	JUMPE	U,CPOPJ1##	;PROTECT AGAINST ABSURD CALL
CHKSW1:	MOVSI	T1,MSWPMX##	;BUILD AOBJN POINTER FOR SWPTAB
	CAME	U,SWPTAB##(T1)	;FIND THIS UNIT IN SWPTAB?
	AOBJN	T1,.-1		;NO, LOOP
	JUMPL	T1,CPOPJ##	;SOME UNIT FOUND
	HLRZ	U,UNISTR##(U)	;STEP TO NEXT UNIT IN STR
	JUMPN	U,CHKSW1	;CHECK THAT ONE
	JRST	CPOPJ1##	;GIVE GOOD RETURN
SUBTTL DSKCHR UUO

CODDSK==0
CODSFS==1
MCDSFS==CODSFS-CODLUF
CODSTR==2
CODLUF==3
MCDLUF==CODLUF-CODSTR
CODKNC==4
CODKON==5
CODPUN==6

DSKCHR::PUSHJ	P,SAVE2##
	HLRZ	T3,T1		;COMPUTE LAST ADDRESS OF TABLE
	MOVN	J,T3
	HRLZS	J

	JSP	T4,STLOCK	;LOCK DATA SO IT CAN BE BELIEVED

	HRR	M,T1
	PUSH	P,J		;SAVE J
	PUSHJ	P,GETWDU##	;GET DISK NAME FROM USER "LOC"
				;  AND SET J TO CURRENT JOB
	TLNE	T1,-1		;SIXBIT?
	JRST	DSKCH0		;YES
	PUSHJ	P,DVCNSG##	;NO-CHAN NUMBER?
	  JRST	TPOPJ##		;NO, ERROR
	MOVE	T1,DEVNAM(F)	;YES, GET SIXBIT NAME
	MOVSI	T2,DVDSK	;IS IT A DISK?
	TDNN	T2,DEVMOD(F)
	JRST	DSKCH0		;NO
	HRRZ	T2,DEVACC##(F)	;FILE OPEN?
	JUMPE	T2,DSKCH0
	HLRZ	U,DEVUNI##(F)	;YES, GET UNIT OF RIB
	MOVE	T1,UNINAM##(U)	;TELL USER UNIT NAME
DSKCH0:	MOVSI	S,CODDSK	;PRESUME ARG. TO BE "DSK". SET CODE ACCORDINGLY
	PUSHJ	P,DEVLG##	;SEARCH ALL LOGICAL NAMES IN SYSTEM FOR A MATCH
	  JRST	DSKCHK		;NO MATCH - CHECK FOR "DSK"
	MOVSI	T2,DVDSK
	TDNN	T2,DEVMOD(F)	;IS IT A DISK?
	JRST	TPOPJ##		;NO - EXIT
	MOVE	T1,DEVNAM(F)	;PICK UP
;HERE TO SEE WHETHER C(T1) IS "DSK","DS" OR "D"
DSKCHK:
	SETZ	F,		;NO DDB
	TLNN	P1,PHONLY##	;DON'T MATCH IF PHYS ONLY
	PUSHJ	P,LNMTSN##	;PATHOLOGICAL DEVICE?
	  JRST	DSKCH7		;NO
	MOVE	P2,@.USLNM	;YES, GET ADDR OF 1ST FILESPEC
	ADDI	P2,LNMDEV##-LNRDEV##
DSKCH8:	SKIPN	T1,LNRDEV##(P2)	;DEVICE NAME
	JRST	DSKFND		;LAST SPEC, DON'T CRY
	PUSHJ	P,SDVTS1##	;ERSATZ DEVICE?
	  CAIA			;NO
	JRST	DSKCH9		;YES, USE THIS FILESPEC
	PUSHJ	P,SRSTR		;IS STR MOUNTED?
	PUSHJ	P,ALIASD	;OR DEVICE "DSK"
	  JRST	DSKCH2		;YES, USE THIS FILESPEC
	PUSHJ	P,SRUNA		;UNIT NAME?
	  JRST	DSKCH6		;NO
	  JRST	DSKCH2		;YES
	JRST	DSKCH2		;YES
DSKCH6:	ADDI	P2,LNRSFD##	;STEP TO NEXT FILESPEC
DSKCH5:	SKIPE	(P2)
	AOJA	P2,DSKCH5
	AOJA	P2,DSKCH8	;AND TEST IF MOUNTED
DSKCH7:
	PUSHJ	P,SDVTS1##	;A SPECIAL DEVICE?
	  JRST	DSKCH2		;NO
DSKCH9:	PUSHJ	P,SDSRC		;GET SEARCH LIST
	TRNN	T1,-1		;IS IT DEVX?
	SKIPN	P2,T3		;NO, IS THERE AN IMPLIED SEARCH LIST?
	JRST	DSKCH1		;NO, PRETEND IT'S DSK(X)
	JRST	DSKFN2		;YES,GET 1ST STR IN THE LIST


DSKCH1:	HRLI	T1,'DSK'
DSKCH2:
	CAME	T1,[SIXBIT /NUL/]	;IS IT NUL?
	JRST	DSKCH3		;NO
	PUSHJ	P,RTZER##	;YES, RETURN A ZERO IN AC
	PJRST	JPOPJ1##	;AND TAKE GOOD RETURN

DSKCH3:	SETZ	F,		;CLEAR F FOR ALIASD ROUTINE
	PUSHJ	P,ALIASD	;IS NAME AN ALIAS FOR "DSK"?
	  JRST	DSKFND		;YES - FIND FIRST UNIT OF 1ST. STR FOR THIS JOB
	MOVSI	S,CODSTR	;PRESUME ARG. TO BE STR NAME
	PUSHJ	P,SRSTR		;DO ANY STR NAMES MATCH?
	  TLOA	S,MCDLUF	;NO MATCH - PRESUME ARG. TO BE LOG. UNIT WITHIN STR
	JRST	FNDSTR		;DEPOSIT VALUES IN TABLE AND SETUP USER AC.
	TRNE	T1,-1		;IF SOME TYPE OF UNIT NAME SPECIFIED,
	SETO	T2,		; SET MASK TO LOOK FOR EXACT MATCH
LOCSRU:	PUSHJ	P,SRUNA		;SCAN ALL PHYSICAL AND LOGICAL UNIT NAMES
	  JRST	TPOPJ##		;NO MATCH - EXIT
	  JRST	LOGCHK		;MATCH ON LOGICAL NAME
	MOVSI	S,CODKNC	;PRESUME KONTROLLER CLASS (1 OR 2 CHARS)
	TLNE	T1,77		;3 CHARACTERS?
	MOVSI	S,CODKON	;YES, PRESUME KONTROLLER NAME
	TRNE	T1,-1		;MORE THAN 3 CHARACTERS?
	MOVSI	S,CODPUN	;YES, PHYSICAL UNIT NAME
	JRST	FNDUNI		;DEPOSIT VALUE IN TABLE AND SETUP USER AC.
;HERE WHEN ARG. WAS OR IMPLIED "DSK" TO FIND FIRST UNIT OF JOB'S FIRST FILE STRUCTURE

DSKFND:	PUSHJ	P,SLPTR		;P2=JOB SL.PTR.
	  SKIPA			;OR IF NO JOB SL., USE SYS.SL.
DSKFN2:	PUSHJ	P,SLITA		;T1=NEXT FSN.
	  JRST	[		;USE SYS.SL IF JOB SL.IS EMPTY
		MOVE	P2,SYSSRC##
		PUSHJ	P,SLGTA
		  PUSHJ	P,SLXESS	;STOPCD ESS IF EMPTY SYS.SL.
		JRST	.+1
		]
	HRRZ	T3,TABSTR##(T1)	;GET STR DATA BLOCK ADR
	JUMPE	T3,DSKFN2	;ERROR RETURN IF STR REMOVED
	HLRZ	U,STRUNI##(T3)	;GET UNIT DB LOC OF 1ST UNIT IN STR
	JRST	FNDSTR		;DEPOSIT VALUES IN TABLE AND SETUP USER AC.


;SUBROUTINE TO TEST IF A NAME IS AN ALIAS FOR "DSK"
;ENTER WITH NAME IN T1, F=ADR OF DDB OR 0 IF NO DDB
;EXIT NAME IN T1, MASK IN T2
;RETURN CPOPJ IF NAME IS AN ALIAS FOR "DSK", CPOPJ1 OTHERWISE
ALIASD::PUSHJ	P,MSKUNI	;GENERATE MASK IN T2 FROM # OF CHARS. IN T1
	MOVSI	T3,(SIXBIT .DSK.)
	AND	T3,T2		;MASK OUT SUPERFLUOUS CHARS
IFN FTSPL,<
	SKIPE	F		;DONT CHECK SPOOL-MODE IF NO DDB
	SKIPL	DEVSPL(F)	;IF IN SPOOL MODE
>
	CAMN	T1,T3		;OR MATCH ON "D", "DS" OR "DSK"
	POPJ	P,		;RETURN CPOPJ IF A MATCH
	PJRST	CPOPJ1##	;NO MATCH - SKIP RETURN
;HERE WHEN A MATCH IS FOUND BETWEEN LOGICAL NAME(UNILOG) & C(T1)

LOGCHK:	CAME	T1,UNILOG##(U)	;EXACT MATCH WITH LOGICAL UNIT NAME?
	MOVSI	S,CODSFS	;NO - MUST BE SUBSET OF STRS
FNDUNI:	HRRZ	T3,UNISTR##(U)	;PICK UP ADDRESS OF STR THIS UNIT IS IN
	SKIPN	T3		;IF UNIT NOT IN F.S.
	MOVEI	T3,STRDB##	; ADDRESS PROTOTYPE F.S.
FNDSTR:	MOVE	T1,UNIDES##(U)	;LOAD UP BITS FOR USER AC.
	TLZ	T1,37		;CLEAR EXTRANEOUS BITS
	IOR	T1,S		;"OR" IN ARG. TYPE CODE.
	SKIPN	STRMNT##(T3)	;IS UNIT MEMBER OF STR WITH 0 MOUNT COUNT?
	TLO	T1,UNPZMT##	;YES - FLAG IT
	SKIPLE	STRJOB##(T3)	;IS F.S. SINGLE ACCESS?
	TLO	T1,UNPSAF##	;YES -- SET BIT
	MOVE	J,.CPJOB##	;JOB # FOR WRPCK
	PUSHJ	P,WRPCK		;IS UNIT A MEMBER OF A STR THAT
				;  IS SOFTWARE WRITE PROTECTED?
	  TLO	T1,UNPSWP##	;YES - FLAG IT
				;T4 = FSN # OR -1 IF NOT IN AN STR
IFN FTDUAL,<
	SKIPE	UNI2ND##(U)	;SKIP IF NOT DUAL PORTED
	TLO	T1,UNPALT##	;SET BIT IF ALTERNATE PATH
>
IFN FTPSTR,<
	MOVE	T2,STRPVS##(T3)	;WORD CONTAINING PRIVATE F.S. BIT
	TRNE	T2,STPPVS##	;IS THIS A PRIVATE F.S.?
	TLO	T1,UNPPRF##	;YES, INDICATE THAT TO THE CALLER
>
	MOVE	P1,T3		;PRESERVE LOC OF STR
IFN FTMP,<
	PUSH	P,T1		;SAVE VALUE SO FAR
	MOVE	T1,UNICAM##(U)	;GET CPU ACCESSIBILITY MASK
	PUSHJ	P,CAMCPU##	;PICK A CPU NUMBER
	MOVE	T2,.C0CPN##(T4)	;FETCH ITS CPU NUMBER
	POP	P,T1		;RESTORE VALUE SO FAR
	DPB	T2,[POINT 2,T1,13] ;FOR THE USER
>
	POP	P,J		;RESTORE USER ARG
	PUSHJ	P,STOTAC##	;EITHER STR NONEXISTANT OR NO WRITE PROTECT
				;STORE BITS IN USER AC.
	AOBJP	J,CPOPJ1##	;IS LENGTH .GT. 1?
	MOVSI	T2,MATLEN	;SETUP LENGTH & INDEX INTO ARGTAB
ARGLUP:	XCT	ARGTAB(T2)	;GET NEXT VALUE FOR USER TABLE
	PUSHJ	P,PUTWD1##	;DEPOSIT IN TABLE
	AOBJP	J,CPOPJ1##	;FINISHED?
	AOBJN	T2,ARGLUP	;NO INCREMENT INDEX
	JRST	CPOPJ1##	;RETURN
ARGTAB:	PUSHJ	P,GUFBT		;LOC+1(.UFTAL)
	MOVE	T1,STRTAL##(P1)	;LOC+2(.STTAL)
	MOVE	T1,UNITAL##(U)	;LOC+3(.UNTAL)
	MOVE	T1,STRNAM##(P1)	;LOC+4(.STNAM)
	MOVE	T1,UNICHR##(U)	;LOC+5(.UNCHR)
	MOVE	T1,UNIBPU##(U)	;LOC+6(.UNBPU)
	MOVE	T1,STRMNT##(P1)	;LOC+7(.STMNT)
	LDB	T1,UNYWPS##	;LOC+10(.UNWPS)
	LDB	T1,UNYSPU##	;LOC+11(.UNSPU)
	LDB	T1,UNYK4S##	;LOC+12(.UNK4S)
	MOVE	T1,STRJOB##(P1)	;LOC+13(.STJOB)
	MOVE	T1,UNILOG##(U)	;LOC+14(.UNLOG)
	MOVE	T1,UNINAM##(U)	;LOC+15(.UNNAM)
	MOVE	T1,UNIHID##(U)	;LOC+16(.UNHID)
	MOVE	T1,UNISLB##(U)	;LOC+17(.UNSLB)
	MOVE	T1,UNIBPM##(U)	;LOC+20(BLOCKS PER UNIT INC. MAINT.)
	MOVE	T1,UNICYL##(U)	;LOC+21(CURRENT CYLINDER)
	MOVE	T1,UNIBUC##(U)	;LOC+22

	MOVE	T1,UNIQUL##(U)	;LOC+23
	PUSHJ	P,[HRRZ	T1,UNICHN##(U)	;LOC+24
		   MOVE	T1,CHNQUL##(T1)
		   POPJ	P,0]

IFN FTDUAL,<
	PUSHJ	P,[SKIPE T1,UNI2ND##(U)	;LOC+25 GETS...
		   MOVE T1,UNINAM##(T1)  ;UNIT NAME FOR ALTERNATE PORT
		   POPJ P,0]		; OR 0 IF NONE
>
IFE FTDUAL,<
	SETZ	T1,
>
IFN FTPSTR,<
	MOVE	T1,STRPPN##(P1)	;LOC+26 (OWNER PPN)
>
IFE FTPSTR,<
	SETZ	T1,		;LOC+26
>
	PUSHJ	P,FNDSWP	;LOC+27 POSITION IN ACTIVE SWAPPING LIST
	PUSHJ	P,[SKIPL T1,STRSDL##(P1) ;LOC+30 POSITION IN SYSTEM DUMP LIST
		   AOJ	 T1,
		   POPJ	 P,]
	HLRZ	T1,STRBSC##(P1)	;LOC+31 BLOCKS PER SUPERCLUSTER
	PUSHJ	P,GETXCH	;LOC+32 EXTENDED UNIT CHARACTERISTICS
IFN FTDUAL,<
	PUSHJ	P,[HRRZ T1,UNIALT##(U) ;LOC+33 GETS NAME OF DETACHED PORT
		   SKIPE T1
		   MOVE T1,UNINAM##(T1)
		   POPJ P,]
>
IFE FTDUAL,<
	SETZ	T1,
>
	PUSHJ	P,[HLRZ	T1,UNISTR##(U)  ;LOC+34 GET NAME OF NEXT UNIT IN STR
		SKIPE	T1
		MOVE	T1,UNINAM##(T1)
		POPJ	P,]
	MOVE	T1,UNIBRC##(U)	;LOC+35 USER BUFFERED READS
	MOVE	T1,UNIBWC##(U)	;LOC+36 USER BUFFERED WRITES
	MOVE	T1,UNIDRC##(U)	;LOC+37 USER DUMP READS
	MOVE	T1,UNIDWC##(U)	;LOC+40 USER DUMP WRITES
	MOVE	T1,UNIMRC##(U)	;LOC+41 MONITOR READS
	MOVE	T1,UNIMWC##(U)	;LOC+42 MONITOR WRITES
	MOVE	T1,UNIICT##(U)	;LOC+43 SWAP READS
	MOVE	T1,UNIOCT##(U)	;LOC+44 SWAP WRITES
	MOVE	T1,UNIPCI##(U)	;LOC+45 PAGE READS
	MOVE	T1,UNIPCO##(U)	;LOC+46 PAGE WRITES
	MOVE	T1,UNIFKS##(U)	;LOC+47 FREE SWAPPING SPACE LEFT
	MOVE	T1,UNICBK##(U)	;LOC+50 DISK CACHE BLOCKS IN USE
	MOVE	T1,UNICRC##(U)	;LOC+51 DISK CACHE READS
	MOVE	T1,UNICRH##(U)	;LOC+52 DISK CACHE READ HITS
	MOVE	T1,UNICWC##(U)	;LOC+53 DISK CACHE WRITES
	MOVE	T1,UNICWH##(U)	;LOC+54 DISK CACHE WRITE HITS
	HLRZ	T1,UNISCT##(U)	;LOC+55 COUNT OF SOFT DEVICE/SEARCH ERRORS
	HRRZ	T1,UNISCT##(U)	;LOC+56 COUNT OF SOFT DATA ERRORS
	HLRZ	T1,UNIHCT##(U)	;LOC+57 COUNT OF HARD DEVICE/SEARCH ERRORS
	HRRZ	T1,UNIHCT##(U)	;LOC+60 COUNT OF HARD DATA ERRORS
	HRRZ	T1,UNIECT##(U)	;LOC+61 COUNT OF RETRIES ON LAST ERROR
	LDB	T1,[POINT 12,UNIMCT##(U),11]  ;LOC+62 COUNT OF "SAT" ERRORS
	LDB	T1,[POINT 12,UNIMCT##(U),23]  ;LOC+63 COUNT OF "RIB" ERRORS
	LDB	T1,[POINT 12,UNIMCT##(U),35]  ;LOC+64 COUNT OF CHECKSUM ERRORS
	MOVE	T1,UNIHBN##(U)	;LOC+65 LOGICAL BLOCK NUMBER OF ERROR
	MOVE	T1,UNIERR##(U)	;LOC+66 LAST ERROR STATUS
	MOVE	T1,UNISOF##(U)	;LOC+67 LAST ERROR STATUS
	MOVE	T1,UNIHDI##(U)	;LOC+70 LAST ERROR STATUS
	MOVE	T1,UNISDI##(U)	;LOC+71 LAST ERROR STATUS
	LDB	T1,[POINT 9,UNIHNG##(U),08]  ;LOC+72 TRANSFER HUNG, NO RECOVERY
	LDB	T1,[POINT 9,UNIHNG##(U),17]  ;LOC+73 TRANSFER HUNG ERRORS
	LDB	T1,[POINT 9,UNIHNG##(U),26]  ;LOC+74 POSITION HUNG ERRORS
	LDB	T1,[POINT 9,UNIHNG##(U),35]  ;LOC+75 SOFTWARE HUNG ERRORS
MATLEN==ARGTAB-.		;ADD NEW ENTRIES TO TABLE HERE
;SUBROUTINE TO COMPUTE TOTAL RESERVE+FCFS BLOCKS IN A UFD
;CALL	P1	STR.DB.ADDR. (STRDB## IF NOT IN FS.)
;NOSKIP	T1= # FREE+PRESERVED BLOCKS LEFT IN THE UFB
;RESPECTS CONTENTS OF T2
GUFBT:	SETZ	T1,		;ASSUME 0 IF UNIT NOT IN AN STR
	MOVE	T3,P1		;STR DATA BLOCK
	CAIN	T3,STRDB##	;PROTOTYPE DB.? (IE. NOT IN FS.?)
	POPJ	P,		;YES-RETURN 0
	MOVE	T1,.CPJOB##	;T1=JOB NUMBER
	MOVE	T1,JBTPPN##(T1)	;GET PROJ-PROG # FOR THIS JOB
GUFBT0:	HRRZ	T4,STRFSN##(T3)	;GET # OF THIS STRUCTURE
	MOVE	T3,T1		;SAVE PPN FOR MATCH
	HLRZ	T1,SYSPPB##	;GET ADR. OF 1ST. PPB IN SYSTEM
	CAIA
GUFBT1:	HLRZ	T1,CORLNK##(T1)	;GET ADR. OF NEXT PPB
	JUMPE	T1,GUFBT3	;NONE LEFT - RETURN WITH T1=0
	CAME	T3,PPBNAM##(T1)	;IS THIS PPB # SAME AS JOB'S?
	JRST	GUFBT1		;NO - REPEAT
	HLRZ	T1,PPBUFB##(T1)	;YES - GET ADR. OF 1ST. UFB IN PPB
	CAIA
GUFBT2:	HLRZ	T1,CORLNK##(T1)	;GET ADR. OF NEXT UFB IN PPB
	JUMPE	T1,GUFBT3	;NONE LEFT - RETURN WITH T1=0
	LDB	T3,COZFSN##	;GET FSN # FOR THIS UFB
	CAME	T3,T4		;IS IT THE SAME AS THIS FSN #?
	JRST	GUFBT2		;NO - REPEAT
	SKIPA	T1,UFBTAL##(T1)	;YES - GET # FREE + RESERVED BLOCKS LEFT IN THIS UFB
GUFBT3:	TLO	T1,400000	;RETURN MOST NEGATIVE NUMBER IF NO UFB BLOCK
	HRRZ	T3,TABSTR##(T4)
	POPJ	P,		;GO DEPOSIT IT IN TABLE
;HERE TO DO DISK. TO RETURN UFBTAL FOR ARBITRARY
; STR:[,PN]
;	M/ USER ADRS OF 2 WORD ARG BLOCK (STR,PPN)
;	CPOPJ - ILLEGAL STR NAME GIVEN
;	CPOPJ1 - USER'S AC HAS UFBTAL OR 1B0 (UFB UNKNOWN)

;ERROR CODES:
	.ERISS==1		;NO FS BY THAT NAME

	ERCODE	DUFISS,.ERISS

GGUFBT::
	PUSHJ	P,GETWDU##	;GET USER ARG 1: STR NAME
	PUSHJ	P,SRSTR		;FIND IT'S DATA BLOCK
	  JRST	DUFISS		;ILLEGAL STR NAME
	PUSHJ	P,GETWD1##	;GET DESIRED PPN
	PUSHJ	P,GUFBT0	;SEARCH PPBS, UFBS
	PUSHJ	P,STOTAC##	;GIVE THAT TO USER.
	JRST	CPOPJ1##	;WIN
;SUBROUTINE TO SEE WHETHER A FILE STRUCTURE IS SOFTWARE WRITE PROTECTED FOR THIS JOB
;CALLED AT UUO LEVEL ONLY
;CALL	MOVE	T3,STR ADR. (OR STRDB## SIGNIFING 'NOT IN FS.')
;	MOVE	J,JOB #	;USE 0 FOR SYS.SRC.LST
;	PUSHJ	P,WRPCK
;	  WRITE PROTECTED
;	NOT WRITE PROTECTED OR STR NOT FOUND
;T1 & T3 ARE RESPECTED, MODIFIES T2,P2

WRPCK:	PUSH	P,T1
	CAIE	T3,STRDB##	;SKIP RETURN IF THIS IS THE PROTOTYPE DB.
	PUSHJ	P,SLPTR		;P2=SL.PTR.
	  JRST	TPOPJ1##	;SKIP RETURN IF NO SUCH SL.
	HRRZ	T1,STRFSN##(T3)	;T1=FSN.
	PUSHJ	P,SLFNA
	  JRST	TPOPJ1##	;SKIP RETURN IF NOT IN SL.
	PUSHJ	P,SLGTB		;GET FS. BITS
	TRNN	T2,FS.WLK	;NOSKIP RETURN IF BIT IS ON
	AOS	-1(P)
	JRST	TPOPJ##


;SUBROUTINE TO FIND THE POSITION OF A UNIT IN THE ACTIVE SWAPPING
;LIST (AS OPPOSED TO THE OFFSET IN SWPTAB).
;CALL	MOVE	U,UDB ADDRESS
;	PUSHJ	P,FNDSWP
;	RETURN HERE ALWAYS WITH POSITION IN T1
;RESPECTS T2 AND T3

FNDSWP:	MOVEI	T1,0		;SETUP POSITION
	MOVSI	T4,MSWPMX##	;GET AOBJN POINTER TO SWPTAB
FNDSW1:	SKIPN	SWPTAB##(T4)	;THIS ENTRY EMPTY?
	JRST	FNDSW2		;YES
	CAMN	U,SWPTAB##(T4)	;MATCH?
	POPJ	P,		;YES, RETURN WITH POSITION IN T1
	AOS	T1		;INCREMENT POSITION
FNDSW2:	AOBJN	T4,FNDSW1	;LOOP FOR ENTIRE TABLE
	JRST	M1POPJ##	;NOT THERE, RETURN -1
;SUBROUTINE TO RETURN EXTENDED CHARACTERISTICS WORD FOR A UNIT
;CALL	MOVE	U,UDB ADDRESS
;	PUSHJ	P,GETXCH
;RETURNS CHARACTERISTICS WORD IN T1

GETXCH:	PUSHJ	P,SAVE2##	;FREE UP P1-P2
	MOVE	T1,UNICAM##(U)	;GET CPU ACCESSIBILITY MASK
	ANDI	T1,CPUMSK##	;KEEP JUST 6 BITS WORTH
	HRRZ	P1,UNICHN##(U)	;GET CHN ADDRESS
	LDB	P2,UNYPUN##	;PHYSICAL UNIT NUMBER
	DPB	P2,[POINT 9,T1,26] ;STORE IT
	LDB	P2,UNYKNM##	;KONTROLLER NUMBER
	DPB	P2,[POINT 9,T1,17] ;STORE IT
	LDB	P2,CHYSCN##	;SOFTWARE CHANNEL NUMBER
	DPB	P2,[POINT 9,T1,8] ;STORE IT
	POPJ	P,		;RETURN
;SUBROUTINE TO SEARCH FILE STRUCTURE NAMES FOR A MATCH WITH C(T1)
;CALL	MOVE	T1,SIXBIT NAME OF FILE STRUCTURE, UNIT, KONTROLLER, ETC.
;	PUSHJ	P,SRSTR
;	  NON MATCH RETURN	T1 & T2 ARE RESPECTED.
;	MATCH RETURN		T1 & T2 ARE RESPECTED, T3 IS ADR. OF STR.
;				U IS ADR. OF THE FIRST UNIT IN STR.

SRSTR::	MOVE	T4,STRAOB##	;PICK UP NEG. # OF STR'S IN SYSTEM
LUPSTR:	SKIPLE	T3,TABSTR##(T4)	;DOES STR CURRENTLY EXIST?
	CAME	T1,STRNAM##(T3)	;YES - DOES ARG. MATCH NAME
	AOBJN	T4,LUPSTR	;NO
	JUMPGE	T4,CPOPJ##	;DID WE FIND A MATCH?
	HLRZ	U,STRUNI##(T3)	;YES - PICK UP ADR. OF FIRST UNIT IN STR
	JRST	CPOPJ1##	;FOUND A MATCH IN STR RETURN
;SUBROUTINE TO SEARCH ALL UNITS, INCLUDING SECOND PORTS, FOR A MATCH
; SAME CALL AS TO SRUNI, SAME RETURN IF A "REAL" MATCH
;IF A MATCH ON A 2ND PORT RETURNS CPOPJ2 WITH LH(U) = -1
SRUNA::	PUSHJ	P,SRUNI		;TRY "REAL" UNITS FIRST
	  JRST	.+3		;NO MATCH
	  JRST	CPOPJ1##	;LOGICAL NAME MATCH
	  JRST	CPOPJ2##	;PHYSICAL UNIT MATCH
IFN FTDUAL,<
	HLRZ	U,SYSUNI##	;START AT 1ST UNIT
SRUNA1:	SKIPN	T4,UNI2ND##(U)	;GET POINTER TO SECONDARY UDB
	JRST	SRUNA2		;THERE IS NONE
	MOVE	T3,UNINAM##(T4)	;GET UNIT NAME
	AND	T3,T2		;MASK DOWN
	CAME	T1,T3		;MATCH?
	JRST	SRUNA2		;NO
	HRROI	U,(T4)		;YES, SET LH(U)=-1 AS A FLAG
	JRST	CPOPJ2##	;AND TAKE FOUND-RETURN
SRUNA2:	HLRZ	U,UNISYS##(U)	;NO MATCH, TRY NEXT
	JUMPN	U,SRUNA1
>
	MOVEI	U,SYSDET##-UNISYS## ;PRESET PREDECESSOR
SRUNA3:	HLRZ	U,UNISYS##(U)	;GET NEXT DETACHED UNIT
	JUMPE	U,CPOPJ##	;RETURN IF END OF LIST
	MOVE	T3,UNINAM##(U)	;GET PHYSICAL UNIT NAME
	AND	T3,T2		;MASK
	CAME	T1,T3		;MATCH?
	JRST	SRUNA3		;NO
	HRROS	U		;SET LH(U)=-1 AS A FLAG
	JRST	CPOPJ2##	;AND TAKE FOUND-RETURN

;SUBROUTINE TO SEARCH UNIT DATA BLOCKS FOR A MATCH BETWEEN C(T1)
;AND AN EQUIVALENT NUMBER OF CHARACTERS OF UNILOG AND UNINAM
;CALL	MOVE	T2,MASK
;	MOVE	T1,SIXBIT NAME OF FILE STRUCTURE,UNIT,KONTROLLER, ETC.
;	PUSHJ	P,SRUNI
;	  NON MATCH RETURN	T1 & T2 ARE RESPECTED. U IS 0
;	  LOGICAL NAME MATCH	T1 & T2 ARE RESPECTED. U IS THE ADR. OF UNIT DATA BLOCK.
;	PHYSICAL NAME MATCH
;RETURNS T4 = PREDECESSOR

SRUNI::	HLRZ	U,SYSUNI##	;GET ADR. OF FIRST UNIT IN SYSTEM
	MOVEI	T4,DIFUSY##	;PRESET PREDECESSOR
	CAME	T1,[SIXBIT /DF/]	;SPECIAL DISK?
	CAMN	T1,[SIXBIT /DC/]	;...
	HRLI	T1,'FH '	;YES, MAKE INTO A "FH"
LUPUNI:	MOVE	T3,UNINAM##(U)	;GET PHYSICAL UNIT NAME
	AND	T3,T2		;MASK
	CAMN	T1,T3		;MATCH?
	JRST	CPOPJ2##	;YES - FOUND A PHYSICAL UNIT MATCH RETURN
	MOVE	T3,UNILOG##(U)	;GET LOGICAL UNIT NAME WITHIN STR
	AND	T3,T2		;MASK OUT UNWANTED CHARS.
	CAMN	T1,T3		;MATCH?
	JRST	CPOPJ1##	;YES - FOUND A LOGICAL UNIT MATCH RETURN
SRUNX:	MOVE	T4,U
	HLRZ	U,UNISYS##(U)	;GET ADR. OF NEXT UNIT IN SYSTEM
	JUMPN	U,LUPUNI	;LAST ONE?
	POPJ	P,		;YES - RETURN
SUBTTL	COMMON SEARCH LIST ROUTINES
REPEAT 0,<

ALL SL.ACCESS AND MODIFICATION IS DONE ONLY WITH THE FOLLOWING ROUTINES.
I.E. THE REST OT THE MONITOR DOES NOT KNOW HOW SL.S ARE IMPLIMENTED.
THE ONLY FACTS THE REST OF THE MONITOR IS ALLOWED TO ASSUME ARE:

	0 IS NEVER A LEGAL FSN. OR MARKER.
	.FSMIN,...,.FSMAX ARE THE LEGAL FSN.S.
	.FSFNC IS THE CODE FOR THE 'FENCE'.
	.FSXX1 IS A GENERAL PURPOSE MARKER:		SAME SIZE BYTE AS AN FSN BUT IS GUARENTEED NOT TO BE
		AN FSN.  .FSXX1 MUST NEVER BE PUT INTO A SL.

SOME OF THESE ROUTINES DEPEND ON SPECIFIC PARAMETR ASSIGNMENTS,
GRATUITOUS FEATURES OF THE INSTRUCTION SET, ETC.  SUCH DEPENDENCIES
ARE LISTED BELOW:

1.	.FSMAX LESSTHAN .FSFNC LESSTHAN .FSEND LESSTHAN .FSSTP

2.	A 'PRE-DECREMENTED' POINTER (ONE WHICH IS ILDB'D TO GET
	THE	1ST BYTE SUCH AS 'POINT X,0') HAS SIGN BIT ON
	AND	ALL OTHER POINTERS HAVE SIGN BIT OFF.  AS A CONSEQUENCE,
	SL. BYTE SIZE (.FSSIZ) MUST BE .GE. 5 (I.E 'POINT 4,0,3'
	IS	NOT PRE-DECREMENTED BUT SIGN BIT IS ON).

GENERAL PHILOSOPHY, CONVENTIONS, ETC

1.	AC ARGUMENTS ARE STANDARDIZED:

		P2	SL. POINTER (OF COURSE OUTSIDE ROUTINES DONT
			KNOW ITS A BYTE POINTER AND MUST NOT USE IT
			AS SUCH)
		T1	FSN.
		T2	FS. STATUS BITS (NCR,WLK,ETC)
		J	.CPJOB## NUMBER IF NON-0.  IF 0, IT SIGNIFIES SYS.SL.
		F	DDB ADDRESS

2.	IN GENERAL ALL AC.S ARE PRESERVED.

>	;END REPEAT 0
REPEAT 0,<

3.	THOSE ROUTINES WHICH CREATE A BYTE POINTER (SLPTR, ETC)
	RETURN	A PRE-DECREMENTED POINTER SO THAT IT IS EASY TO
	'FALL' INTO SL. INCREMENTING LOOPS.  FOR CONVENIENCE, ALL
	ROUTINES, WHETHER OR NOT THEY INCREMENT THE SL. POINTER, GET OR PUT
	THE	1ST ITEM IF CALLED WITH A PRE-DECREMENTED POINTER.  HENCE
	THE	FOLLOWING ARE EQUIVALENT (RETURNS 1ST FSN.):

		PUSHJ	P,SLPTR		PUSHJ	P,SLPTR
		  JRST	ERROR		  JRST	ERROR
		PUSHJ P,SLIGT ;1ST	PUSHJ	P,SLGET ;1ST

		NOTE----THE FOLLOWING ARE NOT EQUIVALENT:

		PUSHJ	P,SLPTR		PUSHJ	P,SLPTR
		  JRST	ERROR		  JRST	ERROR
		PUSHJ	P,SLINC ;1ST	PUSHJ	P,SLINC ;1ST
		  JRST	EMPTY		  JRST	EMPTY
		PUSHJ	P,SLIGT ;2ND	PUSHJ	P,SLGET ;1ST AGAIN

>	;END REPEAT 0

E$$BTS:	IFL	.FSSIZ-5,<PRINTX %FILFND:E$$BTS: .FSSIZ MUST BE .GE. 5>
;SUBROUTINES THAT CREATE SL.PTR'S

;SUBROUTINE TO MAKE SL.PTR. FOR JOB OR SYS DEPENDING ON J.
;
;CALL	J	.LT. OR= 0:	SYS.SL.
;		.GT. 0:	JOB SL. FOR J
;NOSKIP	NEVER IF CALLED WITH J=0
;	ELSE	P2	= 0:	NO SUCH (ACTIVE) JOB
;			NOT= 0:	NULL SL. (NOT SAME AS EMPTYSL.)
;				E.G. LOGIN HASNT CREATED SL. YET.
;				P2=PTR. TO NULL SL. (CALL SLINI).
;SKIP	P2	SL. PTR.
;
;NOTE	SL.PTR.S ARE ABSOLUTE (NO INDEXING OR INDIRECTION). OBVIOUSLY
;	THIS WONT WORK IF PDB'S ARE EVER MOVED (OR SWAPPED).
;CHANGES P2

SLPTR::	JUMPE	J,[		;J=0 FOR SYS.SL.
		MOVE	P2,SYSSRC##
		PJRST	CPOPJ1##
		]
	PUSH	P,W
	PUSHJ	P,FNDPDB##	;W=PDB ADR.
	  JRST	[		;IF NO PDB, NOSKIP RETURN WITH P2=0
		SETZ	P2,
		JRST	WPOPJ##
		]
	MOVEI	P2,@JOBSRC##	;MAKE ABSOLUTE PTR TO SL. IN PDB.
	HLL	P2,JOBSRC##	; ...
	TLZ	P2,77		; ...
	SKIPE	(P2)		;IF NULL SL. NON-SKIP
	AOS	-1(P)		; ELSE SKIP RETURN
	PJRST	WPOPJ##		;RESTORE W
;SUBROUTINE TO RETURN SL.PTR. FOR CURRENT DDB'S JOB.
;	SIMILAR TO SLPTR EXCEPT USES PJOBN INSTEAD OF J. AND STOPCDS
;	ON ANY NON-VALID JOB SL.
;CALL	F	DDB ADDRESS
;NOSKIP	IF PJOBN=0 OR NULL SL
;	P2	SL.PTR. FOR DDB'S JOB'S SL.
;
;STOPCD	NSL	IF PJOBN GIVES 0, NO SUCH JOB (PDB), OR NULL SL.
;CHANGES P2

SLPRJ:	PUSH	P,J
	LDB	J,PJOBN##
	SKIPE	J		;STOPCD ON NO JOB NUM.
	PUSHJ	P,SLPTR
	  SOS	-1(P)		;NO PDB OR NULL ST
	JRST	JPOPJ1##


;SUBROUTINE TO RETURN SL.PTR. IN T1  FOR CURRENT DDB'S JOB.
;	SIMILAR TO SLPTRJ EXCEPT RETURNS POINTER IN T1 INSTEAD OF P2
;CALL	F	DDB ADDRESS
;NOSKIP	IF PJOBN=0 OR NULL SL
;	T1	SL.PTR. FOR DDB'S JOB'S SL.
;
;CHANGES P2

SLPTJ::	MOVE	T1,P2
	PUSHJ	P,SLPRJ
	  SOS	(P)		;NO S.L.
	EXCH	T1,P2
	JRST	CPOPJ1##


;SUBROUTINE TO PICK A SL.PTR. FOR A DDB.
;	SIMILAR TO SLPTRJ EXCEPT RETURN SYS.SL. IF 'SYSDEV' BIT
;	IS ON IN F, OR NULL JOB SL.
;
;CALL	F	DDB ADDR. (RETURN SYS.SL. IF SYSDEV=1)
;NOSKIP	ALWAYS
;	P2	JOB OR SYS SL.PTR.
;CHANGES P2

SLPRF:	PUSH	P,J
	LDB	J,PJOBN##
	TLNE	F,SYSDEV	;FORCE SYS.SL. IF SYSDEV=1
SLPTF2:	SETZ	J,
	PUSHJ	P,SLPTR
	  JRST	SLPTF2		;USE SYS.SL.
	JRST	JPOPJ##
;SUBROUTINE TO CREATE A TEMPORARY (WORK) SL. AND RETURN ITS PTR.
;
;CALL	T2	MINIMUM NUM.OF FSN.S (EXCLUDING FENCE) TO ACCOMMODATE
;		(MAY BE CREATED LARGER)
;NOSKIP	NOT ENOUGH FREE CORE.
;SKIP	P2	PTR. TO CREATED, EMPTY SL.
;	T2	MODIFIED
;
;NOTE	TEMPORARY SL.S ARE CREATED IN MONITOR 'FREE CORE' AND HENCE
;	MUST BE 'RETURNED' AFTER USE BY CALLING SLGVT.
;	TEMP.SL.S ARE MARKED WITH A SPECIAL CODE (.FSTMP) TO DESTINGUISH
;	THEM FROM THOSE THAT SHOULD NOT BE 'RETURNED'.  GET AND PUT
;	ROUTINES IGNORE THIS CODE.
;	SLGVT WILL NOT RETURN A SL. WHICH DOESNT HAVE THIS CODE,
;	THEREFORE SLGVT MAY BE CALLED WHEN YOU 'MIGHT' HAVE A TEMPORARY
;	SL. BUT ARE NOT SURE.
;
;	THE SL. PROPER STARTS IN THE 2ND WORD OF THE FREE BLOCK,
;	THE LENGTH OF THE BLOCK IS STORED IN THE 1ST WORD FOR SLGVT.
;CHANGES P2

SLPRT:	PUSH	P,T1
	PUSH	P,T2
	ADDI	T2,<.SLIPW-1>+3	;+3 FOR TMP,FNC, & STP
	IDIVI	T2,.SLIPW
	AOS	P2,T2		;+1 FOR STORED WD.COUNT, P2=T2=NUM.WDS.TO GET
	PUSHJ	P,GETWDS##
	  PJRST	TTPOPJ##	;NOSKIP IF NO FREE CORE
	MOVEM	P2,(T1)		;SAVE WD.COUNT IN 1ST WORD
	MOVEI	T2,-1(P2)	;T2=NUM.WDS.TO CLEAR
	AOS	P2,T1		;P2=T1=1ST WD. OF SL.
SLPTT1:	SETZM	(T1)		;REMOVE ANY POSSIBLE STP MARKERS
	AOS	T1
	SOJG	T2,SLPTT1
	MOVEI	T2,.FSSTP	;PUT STP MARKER AT END
	DPB	T2,[POINT .FSSIZ,-1(T1),.SLPSE]
	MOVEI	T2,.FSTMP	;PUT TMP MARKER AT BEGINING
	DPB	T2,[POINT .FSSIZ,(P2),.SLPSB]
	HRLI	P2,(POINT .FSSIZ)	;P2=PRE-DECREMENTED POINTER
	PUSHJ	P,SLINI		;INIT AS EMPTY
	PJRST	TTPPJ1		;SKIP RETURN
;SUBROUTINE TO RETURN TEMP.SL. TO FREE STORAGE.
;	MAY BE CALLED WHETHER OR NOT SL. IS KNOWN TO BE TEMPORARY.
;
;CALL	P2	SL.PTR.
;NOSKIP	ALWAYS	SL. RETURNED IF IT WAS A TEMP.
;	P2	MODIFIED
;CHANGES P2, RESPECTS T1,T2

SLGVT::	PUSH	P,T1
	SKIPGE	P2		;UNPREDECREMENT
	IBP	P2
	LDB	T1,P2		;TEMP.SL.?
	CAIE	T1,.FSTMP
	JRST	TPOPJ##		;NO-RETURN
	PUSH	P,T2
	MOVEI	T2,-1(P2)	;YES-T2=ADDR.1ST WORD
	MOVE	T1,(T2)		;T1=WORD COUNT
	PUSHJ	P,GIVWDS##
	PJRST	TTPOPJ##
;SUBROUTINES TO GET AND PUT FSN.S AND BITS

;SUBROUTINE TO GET FSN. SL.PTR. IS CURRENTLY POINTING TO
;
;CALL	P2	SL.PTR.
;NOSKIP	END OF LIST (PHYSICAL OR LOGICAL)
;	P2	POINTS TO END MARKER (INTERNAL USE ONLY--IE. SL???? ROUTINES)
;	T1	END MARKER (.FSEND OR .FSSTP) (INTERNAL USE ONLY)
;SKIP	T1	FSN.
;	P2	MAY BE MODIFIED BUT 'POINTS' TO THE SAME FSN.
;CHANGES P2, RESPECTS T4

SLGET:	SKIPGE	P2		;UNPREDECREMENT
SLGET2:	IBP	P2
	HRRZ	T1,P2
	CAIN	T1,.PDJSE##(W)	;IF JUST WENT PAST TOP OF S.L.
	JRST	[MOVEI T1,.FSSTP	; RETURN PHYSICAL END
		 POPJ P,]
	LDB	T1,P2
	ANDI	T1,FS.NMK	;REMOVE STATUS BITS
	CAIN	T1,.FSTMP	;IGNORE TEMP.SL. MARKERS
	JRST	SLGET2
	CAIL	T1,.FSEND	;END?
	POPJ	P,		;YES-NOSKIP
	PJRST	CPOPJ1##	;NO-SKIP


;SUBROUTINE TO GET FS.BITS FOR CURRENT FSN.
;
;CALL	P2	SL.PTR.
;NOSKIP	ALWAYS
;	T2	BITS (.FSNCR=NOCREATE, .FSWLK=SOFT.WRITE LOCK)
;		(=0 IF END OF LIST)
;	P2	MAY BE MODIFIED BUT 'POINTS' TO SAME FSN.&B ITS
;CHANGES P2, RESPECTS T1

SLGTB:	PUSH	P,T1
	PUSHJ	P,SLGET
	  TDZA	T2,T2
	LDB	T2,P2
	ANDI	T2,FS.BMK
	PJRST	TPOPJ##
;SUBROUTINE TO INCREMENT THE SL.PTR.
;
;CALL	P2	SL.PTR.
;NOSKIP	PTR.POINTS TO END (LOGICAL OR PHYSICAL) BEFORE INCREMENTATION.
;	P2	POINTS TO END MARKER (INTERNAL USE ONLY)
;	T1	END MARKER (INTERNAL USE ONLY)
;SKIP	P2	POINTS TO NEXT FSN.
;CHANGES P2, RESPECTS T4

SLINC:	PUSH	P,P2
	PUSHJ	P,SLGET		;FIX PTR. AND CK FOR END
	  JRST	SLINC3
	SKIPL	(P)		;DONT IBP IF WAS A PREDECREMENTED PTR.
	IBP	P2
	AOS	-1(P)
SLINC3:	POP	P,(P)
	POPJ	P,


;SUBROUTINE TO GET NEXT FSN. IN SL.
;	SIMILAR TO SLGET EXCEPT PTR. IS INCREMENTED FIRST.
;
;CALL	P2	SL.PTR.
;NOSKIP	END OF SL. (EITHER BEFORE OR AFTER INCREMENTATION)
;SKIP	P2	INCREMENTED PTR.
;	T1	FSN.
;CHANGES P2

SLIGT:	PUSHJ	P,SLINC
	  POPJ	P,
	PJRST	SLGET



;SUBROUTINE TO GET CURRENT FSN. IN ACTIVE LIST ONLY
;	SIMILAR TO SLGET EXCEPT NOSKIP IF FENCE ENCOUNTERED
;
;CALL	P2	SL.PTR.
;NOSKIP	END OF ACTIVE LIST
;SKIP	T1	FSN.
;	P2	MAY BE MODIFIED BUT POINTS TO SAME FSN.
;CHANGES P2

SLGTA:	PUSHJ	P,SLGET
	  POPJ	P,
	CAIE	T1,.FSFNC	;FENCE?
	AOS	(P)		;NO-SKIP
	POPJ	P,
;SUBROUTINE TO GET CURRENT FSN. OR STOPCD
;	SIMILAR TO SLGTA EXCEPT STOPCD'S IF END OF LIST
;
;CALL	P2	SL.PTR.
;NOSKIP	ALWAYS	T1=FSN.
;
;STOPCD	AES	IF END OF ACTIVE SL.
;CHANGES P2

SLGTX:	PUSHJ	P,SLGTA
	  PUSHJ	P,SLXAES
	POPJ	P,


;SUBROUTINE TO GET NEXT FSN. IN ACTIVE LIST ONLY
;	SIMILAR TO SLIGT EXCEPT NOSKIP IF FENCE ENCOUNTERED
;
;CALL	P2	SL.PTR.
;NOSKIP	END OF ACTIVE LIST (EITHER BEFORE OR AFTER INCREMENTATION)
;SKIP	T1	FSN.
;	P2	INCREMENTED

;CHANGES P2, PRESERVES T2
NXSTR:	PUSH	P,U		;PRESERVE U
NXSTR0:
	PUSHJ	P,SLITA		;GET NEXT STR
	JRST	UPOPJ##
	SKIPN	T3,TABSTR##(T1)
	JRST	NXSTR0		;NOT THERE, TRY NEXT
IFN FTPSTR,<
	PUSHJ	P,PVSTR		;IS THE CURRENT STR PRIVATE? (ALL S.L.)
	  JRST	NXSTR0		;YES, TRY NEXT STR
>
	SKIPLE	T4,STRJOB##(T3)	;SINGLE ACCESS?
	CAMN	T4,.CPJOB##	;YES, BY THIS JOB
	JRST	NXSTR1		;OK
	MOVE	T4,.CPJOB##	;SINGLE ACCESS
	MOVE	T4,JBTPPN##(T4)	;IS HE [1,2]?
	CAME	T4,FFAPPN##
	JRST	NXSTR0		;NO, CAN'T USE STR
NXSTR1:
IFE FTMDA,<
	HLRZ	T3,STRUNI##(T3)
	MOVE	T3,UNIUST##(T3)
	TLNE	T3,UNPNNA##	;IF NO NEW ACCESS...
> ;END IFE FTMDA
IFN FTMDA,<
	HLRZ	U,STRUNI##(T3)	;GET FIRST DDB IN STR
	PUSHJ	P,CHKLOK	;NO NEW ACCESS?
> ;END IFN FTMDA
	 JRST	NXSTR0		;... NO, TRY NEXT
	JRST	UPOPJ1##	;OK, TRY THIS STR

SLITA::	PJUMPL	P2,SLGTA	;IF PREDECREMENTED, GET 1ST FSN.
	PUSHJ	P,SLGTA		;END OF SL.?
	  POPJ	P,		;YES
	IBP	P2		;NO-INCREMENT
	PJRST	SLGTA
;SUBROUTINE TO CHECK IF THE CURRENT STR IS PRIVATE AND IF SO,
; CHECK IF THE CURRENT USER HAS ACCESS TO IT
IFN FTPSTR,<
PVSTR:	PUSHJ	P,SAVE2##	;SAVE P1-P2
	MOVE	P1,STRPVS##(T3)	;WORD CONTAINING PRIVATE STR BIT
	TRNN	P1,STPPVS##	;IS IT A PRIVATE STR?
	JRST	CPOPJ1##	;NO
	MOVE	J,.CPJOB##	;JOB #
	PUSHJ	P,SLPTR		;YES, GET THE USERS S.L.
	  PJRST	PRVJO		;NO S.L., ONLY IF PRIVILEGED
	PUSHJ	P,SLFND		;IS THIS STR IN THE USERS S.L.
	  PJRST	PRVJO		;NO, SKIP IT UNLESS THE USER HAS PRIV'S
	JRST	CPOPJ1##	;YES, USER CAN ACCESS IT
>
;SUBROUTINE TO PUT FSN.& BITS INTO CURRENT SL. POSITION
;
;CALL	P2	SL.PTR.
;	T1	FSN.
;	T2	BITS (FS.WLK, FS.NCR)
;NOSKIP	PHYSICAL END OF LIST (FSN.& BITS NOT STORED)
;SKIP	P2	MAY BE MODIFIED BUT 'POINTS' TO SAME (STORED) FSN.
;CHANGES P2, RESPECTS T4

SLPUT:	PUSH	P,T1
	PUSHJ	P,SLGET		;FIX UP PTR AND CK. FOR END
	  JRST	[
		CAIN	T1,.FSSTP	;PHYSICAL END?
		JRST	TPOPJ##		;YES--NOSKIP
		JRST	.+1		;NO--CONTINUE
		]
	MOVE	T1,T2		;COMBINE FSN.& BITS
	ANDI	T1,FS.BMK
	IOR	T1,(P)
	DPB	T1,P2
	JRST	TPOPJ1##	;SKIP

;SUBROUTINE TO PUT FSN. AND BITS AT NEXT POSITION IN SL.
;	SIMILAR TO SLPUT EXCEPT INCREMENTS POINTER FIRST
;
;CALL	P2	SL.PTR.
;	T1	FSN.
;	T2	FS. BITS
;NOSKIP	END OF LIST (EITHER BEFORE OR AFTER INCREMENTATION)
;SKIP	P2	POINTS TO NEXT (STORED) FSN.
;CHANGES P2, RESPECTS T4

SLIPT:	PUSH	P,T1
	PUSHJ	P,SLINC
	  JRST	[
		CAIN	T1,.FSSTP	;PHYSICAL END?
		JRST	TPOPJ##		;YES--NOSKIP
		JRST	.+1		;NO--OK TO STORE
		]
	POP	P,T1
	PJRST	SLPUT
;SUBROUTINE TO COPY ONE SL. TO ANOTHER.
;	MAY BE USED TO COPY PART OF SL. ONTO ITSELF AS IN REMOVING
;	A FSN. FROM A SL.
;
;CALL	P2	'FROM' SL.PTR.-- POINTING TO 1ST FSN. TO MOVE
;	P3	'TO'   SL.PTR.--POINTING TO 1ST PLACE TO STORE
;NOSKIP	'TO' SL. TOO SMALL TO ACCOMODATE 'FROM' LIST
;SKIP	SUCCESSFUL

SLBLT:	PUSHJ	P,SAVE3##
	PUSH	P,T1
	PUSH	P,T2
	PUSHJ	P,SLGET
	  JRST	[ADD	P3,[110000,,0]
		JRST	SLFIN]
	PUSHJ	P,SLGTB
	EXCH	P3,P2
	PUSHJ	P,SLPUT
	  PJRST	TTPOPJ##
SLBLT2:	EXCH	P3,P2
	PUSHJ	P,SLIGT
	  PJRST	SLFIN
	PUSHJ	P,SLGTB
	EXCH	P2,P3
	PUSHJ	P,SLIPT
	  JRST	TTPOPJ##
	JRST	SLBLT2


;SUBROUTINE TO APPEND FSN.& BITS TO SL.
;	SIMILAR TO SLPUT EXCEPT FOLLOWS PUT WITH INCREMENT & PUT 'END(
;
;CALL	P2	SL.PTR.
;	T1	FSN.
;	T2	FS. BITS
;NOSKIP	END OF LIST (FSN. NOT STORED)
;SKIP	P2	POINTS TO END (PHYSICAL OR LOGICAL) FOLLOWING STORED FSN.
;RETURNS T1,T2 UNCHANGED, CHANGES P2

SLAPD::	PUSH	P,T1
	PUSH	P,T2
	PUSHJ	P,SLPUT
	  PJRST	TTPOPJ##	;NO ROOM--NO SKIP
	EXCH	P2,P3		;CAUSE SLFIN WILL EXCH THEM BACK

	PUSHJ	P,SLFIN1	;ADD THE TERMINATOR
	  JRST	TTPOPJ##	;NO ROOM--NO SKIP
	JRST	TTPPJ1		;RESTORE ACS AND SKIP
SLFIN:	PUSHJ	P,SLFIN1	;ADD THE TERMINATOR
	  PUSHJ	P,SLXSLO	;STOPCODE SLO
TTPPJ1: AOS	-2(P)		;SKIP RETURN
	JRST	TTPOPJ##
SLFIN1: MOVEI	T1,.FSEND	;MARK END OF LIST
	SETZ	T2,
	EXCH	P2,P3
	PJRST	SLIPT
;SUBROUTINE TO INIT A SL. AS EMPTY
;
;CALL	P2	SL.PTR.
;NOSKIP	ALWAYS	P2 UNMODIFIED
;
;STOPCD	AES	SL.NOT LONG ENOUGH FOR FENCE  MARKERS
;RESPECTS T1

SLINI::	PUSH	P,T1
	PUSH	P,P2
	MOVEI	T1,.FSFNC	;PUT FENCE
	SETZ	T2,
	PUSHJ	P,SLAPD
	  PUSHJ	P,SLXAES	;STOPCD AES
	POP	P,P2
	PJRST	TPOPJ##
;SUBROUTINES TO SEARCH FOR AN FSN. IN A SL.
;
;CALL	SLFND	SEARCH BOTH ACTIVE AND PASIVE LISTS
;	SLFNA	SEARCH ONLY ACTIVE LIST (I.E. STOP ON FENCE)
;
;	P2	SL.PTR. FOR WHERE TO START LOOKING
;	RH(T1)	FSN.:	FIND THIS FSN.
;		.FSFNC:	FIND THE FENCE (FOR SLFNDA, USE .FSEND BELOW)
;		.FSEND:	IF SLFND, FIND END (LOGICAL OR PHYSICAL) OF WHOLE LIST
;			IF SLFNDA, FIND FENCE (END OF ACTIVE LIST)
;NOSKIP	NEVER IF RH(T1)=.FSEND
;	ELSE FAIL TO FIND FSN. (OR FENCE)
;	P2	POINTS TO END OF LIST
;SKIP	P2	POINTS TO FSN. (OR FENCE) SOUGHT
;		POINTS TO END (LOGICAL OR PHYSICAL) IF CALLED WITH .FSEND
;CHANGES P2

SLFND::	PUSHJ	P,SAVE1##
	MOVEI	P1,SLGET	;SEARCH WHOLE LIST
	JRST	SLFND0

SLFNA::	PUSHJ	P,SAVE1##
	MOVEI	P1,SLGTA	;ONLY ACTIVE SL.

SLFND0:	PUSH	P,T1
	PUSHJ	P,(P1)		;SLGET OR SLGETA
	  JRST	SLFND2
SLFND1:	TDC	T1,(P)		;IS THIS THE ONE?
	TRNN	T1,-1
	PJRST	TPOPJ1##	;YES-SKIP RETURN
	PUSHJ	P,SLINC		;NO-GET NEXT ONE
	  JRST	SLFND2
	PUSHJ	P,(P1)
	  JRST	SLFND2
	JRST	SLFND1

SLFND2:	HRRZ	T1,(P)		;HERE ON END OF LIST--LOOKING FOR END?
	CAIN	T1,.FSEND
	AOS	-1(P)		;YES-FOUND IT SO SKIP RETURN
	PJRST	TPOPJ##		;NO--NOSKIP RETURN
;SUBROUTINE TO CHECK THE NUMBER OF F.S. IN A SL.
;IF NUMBER EXCEEDS THE MAXIMUM ALLOWED (.SLMXJ) TAKE ERROR
;RETURN.
;CALL	P1	POINTING TO BEGINING OF SL.
;NOSKIP	SL CONTAINS TOO MANY F.S. (EXCEEDS .SLMXJ)
;SKIP	SUCCESSFUL
SLCHK:	PUSHJ	P,SAVT##	;SAVE T1-T4
	MOVE	T1,[POINT 9,(P1)] ;SET UP COUNTER TO SL.
	SETZ	T2,		;COUNTER
SLCHK0:	ILDB	T3,T1		;GET NEXT
	CAIN	T3,.FSTMP	;IGNORE TMP MARKERS
	JRST	SLCHK0
	CAIN	T3,.FSSTP	;STOP MASK BEFORE END ?
	POPJ	P,		;YES -- ERROR
	CAIE	T3,.FSEND	;END MASK ?
	AOJA	T2,SLCHK0	;NO -- INCREMENT COUNT AND CONTINUE
	CAILE	T2,.SLMXJ+1	;YES -- HAVE WE EXCEEDED MAX ?
	POPJ	P,		;YES -- ERROR
	PJRST	CPOPJ1##	;NO -- SKIP RETURN
;MULTIPURPOSE STOPCDS FOR SEARCH LIST CODE
;	PUSHJ'D TO SO CAN FIND EXACT TROUBLE SPOT

SLXESS:	STOPCD	.+1,JOB,ESS,		;++EMPTY SYSTEM SEARCH LIST
	POPJ	P,


SLXAES::STOPCD	.+1,JOB,AES,		;++ABNORMAL END OF SEARCH LIST
	POPJ	P,

SLXBPT::STOPCD	.+1,JOB,BPT,		;++BAD SEARCHLIST POINTER
	POPJ	P,

SLXSLO:	STOPCD	.+1,JOB,SLO		;++SEARCH LIST OVERFLOW
	POPJ	P,
SUBTTL	FNDFIL - MANIPULATE DIRECTORIES, ACCESS TABLES
;IN THIS MODULE P3=LOC OF PPB, P4=LOC OF NMB, P2=BYTE POINTER TO P1 (SEARCH LIST)


;SUBROUTINE TO FIND A FILE NAME IN CORE OR ON DISK
;ENTER WITH DEVPPN=PPN  T2=SEARCH LIST
;M HAS UUOREN,UUOLUK, OR UUOENT ON IN LH
;RETURNS CPOPJ IF ERROR
;RETURNS CPOPJ1 IF OK
;IF FNDFIL READ THE RIB IT WILL RETURN WITH THE MONITOR BUFFER, AND THE RIB IN IT
;IN THAT CASE, IOSRIB IS ON IN S, AND L(MON BUF) IS IN T1
;IN THIS MODULE P3=LOC OF PPB, P4=LOC OF NMB,
;P1=PTR.TO BEGINNING OF SL.,  P2=WORKING PTR. TO SL. (INCREMENTED ETC.)

;SUBROUTINE TO FIND A FILE NAME IN CORE OR ON DISK
;ENTER WITH DEVPPN=PPN  T2=PREDECREMENTED SEARCH LIST POINTER
;	(MUST PNT.TO BEG.OF SL.FOR CALL TO SLGVT (SEE BELOW))
;M HAS UUOREN,UUOLUK, OR UUOENT ON IN LH
;RETURNS CPOPJ IF ERROR
;RETURNS CPOPJ1 IF OK
;IF FNDFIL READ THE RIB IT WILL RETURN WITH THE MONITOR BUFFER, AND THE RIB IN IT
;IN THAT CASE, IOSRIB IS ON IN S, AND L(MON BUF) IS IN T1
;BEFORE RETURN TO CALLER, FNDFIL CALLS SLGVT TO GIVE UP POSSIBLE
;	TEMP.SL.  CALL FNDFLA TO AVOID CALL TO SLGVT.

FNDFIL::HRRZM	P,.USLBF	;INDICATE WE CAN USE LARGE BUFFERS
	PUSH	P,T2		;SAVE SL.PTR.FOR CALL TO SLGVT LATER
	PUSHJ	P,FNDFLA
	  SOS	-1(P)		;PROPAGATE NOSKIP
	EXCH	P2,(P)
	PUSHJ	P,SLGVT
	POP	P,P2
RMVLBF::SETZ	T2,
	EXCH	T2,.USLBF	;INDICATE DON'T USE EXTRA PAGE FOR DIRECT SEARCH
	JUMPGE	T2,CPOPJ1##	;RETURN IF WE DIDNT GET ONE
	MOVEI	T2,1(T2)	;HAD ONE - GET ITS ADDRESS
	PUSH	P,T1		;SAVE POSSIBLE ERROR CODE
	MOVEI	T1,4*BLKSIZ##
	PUSHJ	P,GVFWDS##	;GIVE IT UP
	PJRST	TPOPJ1##	;AND RETURN

FNDFLA::	;CALL HERE TO AVOID SLGVT CALL
	HLRZ	T3,DEVEXT(F)	;GET EXTENSION
	CAIN	T3,(SIXBIT /UFD/)	;UFD?
	TLNE	M,UUODIR##	;YES. PRIVILEGED JOB AND RIPDIR SET?
	SKIPA			;OK
	JUMPGE	M,FNER2W	;NO - ENTER OR RENAME IS ILLEGAL
				;("UFD" IS A RESERVED EXTENSION)
	PUSHJ	P,SAVE4##	;SAVE P1-P4
FNDFLZ:	TLZ	M,UUOSF2##	;MAKE SURE THESE BITS ARE 0
	TLZ	S,IOSUPR	;MAKE SURE SUPER USETI BIT IS OFF
	MOVE	P1,T2		;SEARCH LIST INTO P1
	LDB	P4,PJOBN##	;JOB NUMBER
	HRRZ	T1,DEVACC##(F)
	JUMPE	T1,FNDFL1
	MOVE	T2,ACCSTS##(T1)
	TRNE	T2,ACPSUP+ACPCRE
	PUSHJ	P,ATRMOV	;IF STR FILLED ON ENTER AFTER UFBSZ
FNDFL1:	MOVE	J,.CPJOB##	;WE OWN THE CB ALREADY
	CAME	J,CBUSER##	; IF COMING FROM ADJPT
	PUSHJ	P,GETCB
	HLRZ	T2,SYSPPB##	;START OF PPB LIST
	MOVEI	T3,DIFPPL##	;SYSPPB-CORLNK (IN CASE THIS 1ST. PPB)
	MOVE	T1,DEVPPN(F)	;PPN
	PUSHJ	P,LSTSRC	;SEARCH FOR RIGHT PP BLOCK
	  JUMPLE T2,FNER1A	;%NO FREE CORE IF 0
	CBDBUG	(Y,Y);
	MOVE	T4,PPBNLG##(T2)	;%LOGGED-IN WORD
	CAME	T1,JBTPPN##(P4)	;%PPN OF FILE=PPN OF JOB?
	CAMN	T1,SPLPPN##	;% NO, IS IT PRINT (MPB) PPN?
	TRO	T4,PPPNLG##	;%YES - PPN IS LOGGED IN
	CAME	T1,MFDPPN##	;%IS IT MFD PPN
	CAMN	T1,SYSPPN##	;%OR CUSP PPN?
	TRO	T4,PPPNLG##	;%YES, SET LOGGED-IN BIT
	CAMN	T1,XSYPPN##	;%KEEP CORE BLOCKS
	TRO	T4,PPPNLG##	;% FOR NEW
	MOVEM	T4,PPBNLG##(T2)	;%
	SKIPE	DEVFIL(F)	;%NAME=0?
	JRST	NMBLUP		;%NO, CONTINUE
	HRRM	T2,DEVACC##(F)	;%YES, SETPTH WANTS TO KNOW LOC
	PJRST	GVCBJ1		;% OF PPB, SO TELL IT IN DEVACC AND RETURN
;HERE WITH T2 = LOC OF PPB BLOCK
NMBLUP:	MOVE	P3,T2		;%P3=LOC OF PP BLOCK
	AOS	PPBCNT##(P3)	;%1 MORE USER OF PPB
	PUSHJ	P,SET1NM##	;%SET T2=LOC OF 1ST NMB IN LIST
	MOVE	T1,DEVFIL(F)	;%NAME OF FILE
	PUSHJ	P,LSTSRA	;%SCAN FOR MATCHING NAME BLOCK
	  JRST	SETNMB		;%JUST CREATED A NAME BLOCK FOR FILE
FNDNM2:	HLRZ	T4,DEVEXT(F)	;%NAMES MATCH- CHECK EXTENSIONS
	HRRZ	T3,NMBEXT##(T2)	;%CHECK EXTENSIONS
	CAIN	T3,(T4)		;%MATCH?
	JRST	STRLUK		;%YES, FOUND THE NAME BLOCK
	PUSHJ	P,LSTSR1	;%WRONG - SEARCH FOR ANOTHER
	  JRST	SETNMB		;%JUST CREATED ONE
	JRST	FNDNM2		;%CHECK EXTENSIONS


;HERE WHEN A NEW NAME BLOCK HAS JUST BEEN CREATED
SETNMB:	JUMPE	T2,FNER1B	;%ERROR IF NO FREE CORE
	HLRZ	T1,DEVEXT(F)	;%GET EXTENSION (NAME ALREADY SET UP)
	HRRZM	T1,NMBEXT##(T2)	;%SAVE IN NAME BLOCK
	MOVEI	T3,NMPUPT##(T2)	;%IS THIS AN SFD?
	CAIN	T1,'SFD'
	HRLM	T3,NMBRNG##(T2)	;%YES, STORE UPWARD-POINTER TO ITSELF
	MOVEI	T1,DIFNAL##(T2)	;%SET NMBACC TO POINT TO ITSELF (+DIFNAL)
	HRLM	T1,NMBACC##(T2)	; SO THAT IT IS IN A 1-ITEM RING
	MOVE	T1,PPBYES##(P3)	;%MARK THAT THE FILE DOESN'T EXIST IN
	ANDCA	T1,PPBKNO##(P3)	;% ANY STRS WHERE THE UFD DOESN'T EXIST
	LSH	T1,COJKNO##	;%
	DPB	T1,NMYKNO##	;%

;HERE WITH T2= LOC OF NAME BLOCK
STRLUK:	HRR	P4,T2		;%P4= LOC OF NAME BLOCK
	AOS	NMBCNT##(P4)	;%1 MORE USER OF NMB
	PUSHJ	P,GVCBJ		;%GIVE UP CB RESOURCE
STRLK1:	MOVE	P2,P1		;P2 = SL. PTR
STRLUP:	PUSHJ	P,NXSTR		;GET NEXT STR IN LIST
	  JRST	STRDON		;YES, LOOKED AT ALL STR'S
	PUSHJ	P,SETUFB	;STORE UFB LOC (IF THERE IS ONE) IN DDB
	  JFCL			;NO UFB YET
	HRL	P3,T2		;SAVE LOC OF UFB (OR 0) IN LH(P3)
	MOVE	U,TABSTR##(T1)	;NO. LOC OF STR DATA BLOCK

	HLRZ	U,STRUNI##(U)	;LOC OF 1ST UNIT DB IN STR
IFE FTMDA,<
	MOVE	T1,UNIUST##(U)	;HAS F/S BEEN LOCKED?
	TLNE	T1,UNPNNA##
> ;END IFE FTMDA
IFN FTMDA,<
	PUSHJ	P,CHKLOK	;IS IT LOCKED
> ;END IFN FTMDA
	JRST	SCNSTR		;YES-SKIP THIS ONE
	PUSHJ	P,STORU##	;NO--SAVE LOC OF UNIT IN DDB
	PUSHJ	P,FSNPOS	;POSITION A BIT FOR TESTING NMBKNO,NMBYES
	TDNE	T2,PPBYES##(P3)	;DOES A UFD EXIST IN THIS STR?
	TLO	M,UUOUFD##	;YES. LIGHT A BIT IN UUO
	TLZE	P3,-1		;IF THERE IS NO UFB, OR
	TDNN	T2,NMBKNO##(P4)	;DO WE KNOW IF FILE EXISTS IN STR?
	JRST	STRLP2		;DONT KNOW - READ UFD
	TDNN	T2,NMBYES##(P4)	;YES. IS IT THERE?
	JUMPL	M,SCNSTR	;NOT THERE - TRY NEXT STR IF LOOKUP
				;HAVE TO SCAN AT'S ANYWAY IF ENTER/RENAME
				;SINCE ANOTHER JOB MIGHT HAVE DELETED THE FILE,
				;THEN DONE A NEW ENTER
	PUSHJ	P,GETCB		;GET CB RESOURCE
STRLP9:	HLRZ	T2,NMBACC##(P4)	;%YES. SCAN ACCESS TABLES FOR A  MATCH
	PUSHJ	P,BYTSCA	;%
	  JRST	ACCLP1		;%FOUND AN A.T. ENTRY
	JRST	CFPCHK		;%NO ACCESS TABLES AT ALL

;HERE WHEN WE DONT KNOW IF FILE EXISTS IN STR
STRLP2:	TDNE	T2,PPBKNO##(P3)	;DOES UFD EXIST IN STR?
	TDNE	T2,PPBYES##(P3)
	JRST	UFBLUP		;YES OR MAYBE - READ AND CHECK
	JRST	NOFIL2		;NO. MARK NMB
;LOOP TO CHECK ACCESS TABLES FOR THE RIGHT ONE
ACCLUP:	PUSHJ	P,BYTSC1	;%ANOTHER A.T. FOR THIS STR?
ACCLP1:	  SKIPA	T4,ACCSTS##(T2)	;%FOUND. GET STATUS
	JRST	CFPCHK		;%NONE THERE
	TRNE	T4,ACPDEL##	;%FILE MARKED FOR DELETION?
	JRST	ACCLUP		;%YES. IGNORE THIS A.T.

;HERE WHEN RIGHT ACCESS TABLE ENTRY FOUND
	HRRZ	T3,DEVUFB##(F)	;%LOC OF UFB BLOCK
	JUMPE	T3,UFBLP1	;%MUST HAVE THE UFB BLOCK IN CORE IF WE FIND THE A.T.
				; SINCE DEVUFB IS USED AS A FLAG TO SEE IF A NOT
				; LOGGED-IN PPB AND ITS NMB'S CAN BE DELETED
	JUMPG	M,ACCLP2	;%M NEGATIVE IF LOOKUP
	TRNE	T4,ACPCRE+ACPSUP;%IS FILE READABLE?
	JRST	ACCLUP		;%NO, LOOK FOR ANOTHER A.T. FOR FILE
	HRRM	T2,DEVACC##(F)	;%YES. SAVE LOC OF A.T.
	MOVSI	T1,DEPPRV##
	TDNE	T1,DEVPRV##(F)	;IF JUST SETTING UP A PATH
	JRST	ACLP1C		; DON'T CHECK INTERMEDIATE SFD'S
	MOVEI	T1,FNCRED##	;%SEE IF WE CAN READ THE FILE
	PUSHJ	P,CHKPRV	;%CHECK ACCESS PRIVILEGES
	  JRST	FNER2X		;%WRONG PRIVILEGES - ERROR
	HRRZ	T2,DEVACC##(F)	;%LOC OF A.T.
	MOVE	T1,ACCSTS##(T2)	;%A.T. STATUS
	TRNN	T1,ACPDEL##+ACPCRE+ACPSUP ;%FILE STILL READABLE?
	JRST	ACLP1C		;%YES
	HLLZS	DEVACC##(F)	;%NO, CLEAR POINTER TO A.T.
	LDB	T1,ACYFSN##	;%GET BACK FSN
	JRST	ACCLUP		;%LOOK FOR ANOTHER A.T.
ACLP1C:	HRRZ	T2,DEVACC##(F)	;%FILE CAN BE READ
	SKIPE	T1,ACCDOR##(T2)	;%DORMANT?
	PUSHJ	P,UNLINK	;%YES. MAKE ACTIVE
	CBDBUG	(Y,Y);
	HLRZ	T1,NMBRNG##(P4)
	TLZN	M,UUO2SF##	;%SECOND TIME WE'VE LOOKED?
	SKIPN	T1		;%NO, IS THIS AN SFD?
	JRST	ACLP1B		;%NO, CONTINUE
	TLO	M,UUOSFD##	;%YES, INDICATE FOUND AN SFD
ACLP1A:	PUSHJ	P,GVCBJ		;%GIVE UP CB
	JRST	SCNSTR		;AND GO LOOK FOR ONE ON ANOTHER STR
ACLP1B:
	MOVEI	T3,ACPCNT##	;%UPDATE COUNT OF READERS
	ADDM	T3,ACCCNT##(T2)	;%
	MOVE	T1,ACC1PT##(T2)	;%1ST UNIT WORD
	LDB	T2,UN1PTR##	;%1ST UNIT
	PUSHJ	P,NEWUNI##	;%SET U TO RIGHT UNIT
	  SKIPA			;%INVALID UNIT
	HRLM	U,DEVUNI##(F)	;%SAVE 1ST UNIT IN DDB
	SETZM	DEVRIB##(F)	;%CLEAR DEVRIB FOR DPB'S
	LDB	T2,UNYLUN##	;%GET LOGICAL UNIT NUMBER
	DPB	T2,DEYRBU##	;%TO CURRENT RIB WORD
	MOVE	T4,UNISTR##(U)	;%GET POINTER TO STRUCTURE DATA BLOCK
	MOVE	T2,T1		;%GET FIRST POINTER INTO T1
	LDB	T2,STYCLP##(T4)	;%EXTRACT CLUSTER ADDRESS
	DPB	T2,DEYRBA##	;%AND SET TO CURRENT RIB POINTER
	TLO	S,IOSRDC	;%THIS FILE HAS READ COUNT UP
	PUSHJ	P,STWLK		;%SET BIT IN S IF STR IS WRITE LOCKED
	PJRST	FNDXIT		;%GIVE UP CB AND SKIP-RETURN

;HERE WHEN A.T. FOUND FOR ENTER OR RENAME
ACCLP2:	TLNE	M,UUOREN##	;%RENAME?
	JRST	FNDER5		;%YES. ERROR
	HLRZ	T3,NMBRNG##(P4)	;%NO, ENTER
	SKIPN	T3		;%TRYING TO SUPERSEDE AN SFD?
	TLNE	M,UUODIR##	;OR A UFD?
	JRST	FNDR10		;%YES, ILLEGAL
	SKIPL	T3,DEVSPL(F)	;%NO, SPOOL-MODE
	TRNE	T3,DEPECS	;%OR NON-SUPERSEDING ENTER
	JRST	NOSUPR		;%YES, CANT SUPERSEDE
	TRNE	T4,ACPCRE+ACPREN+ACPSUP+ACPUPD;%NO. CREATE, SUPERSEDE OR UPDATE?
	JRST	FNDER7		;%YES. ERROR
	HRRM	T2,DEVACC##(F)	;%NO. SAVE LOC OF A.T.
ACCLP3:	PUSHJ	P,BYTSC1	;%SEARCH FOR MORE A.T.'S (MAY BE A SUPERSEDER)
	  SKIPA	T4,ACCSTS##(T2)	;%FOUND AN A.T.
	JRST	ACCLP4		;%NO MORE. OK
	TRNE	T4,ACPCRE+ACPSUP+ACPUPD+ACPREN	;%THIS A.T. WRITING?
	JRST	FNDER7		;%YES. ERROR
	JRST	ACCLP3		;%NO. TEST NEXT
;HERE IF TRYING TO SUPERSEDE ON A SPOOL-MODE OR NON-SUPERSEDING ENTER.
NOSUPR:	MOVEI	T1,AEFERR
	PJRST	FNDLC		;%REMOVE DUMMY A.T. AND RETURN


;HERE WHEN THE FILE MAY BE WRITTEN (NO WRITER YET)
ACCLP4:	PUSHJ	P,NXSTR		;%GET NEXT STR
	  JRST	ACCLP5		;%AT END
	JRST	ACCLP3		;%TEST THIS STR

IFN	FTFDAE,<
;ROUTINE TO TEST IF SOME OTHER JOB IS SUPERSEDING THE FILE
;P1 PASSES SL PTR
;P4 PASSES NMB ADDR
;RETURNS CPOPJ IF SOMEBODY SUPERSEDING
;RETURNS CPOPJ1 IF ALL CLEAR
TSTRIT:	PUSHJ	P,SAVE2		;%SAVE P1-P2
	MOVE	P2,P1		;%START AT BEGINING OF SL
TSTRT1:	PUSHJ	P,NXSTR		;%GET NEXT FSN IN SL
	 JRST	CPOPJ1		;%NONE LEFT, IT'S OK

	MOVEI	T2,DIFNAL##(P4)	;%START AT 1ST ACC
TSTRT2:	PUSHJ	P,BYTSC1	;%GET NEXT ACC ON THIS STR
	 SKIPA	T4,ACCSTS##(T2)	;%GET STATUS
	JRST TSTRT1		;%NONE LEFT, TRY NEXT STR
	TRNN	T4,ACPDEL##	;%IGNORE IF MARKED FOR DELETION
	TRNN	T4,ACPCRE+ACPREN+ACPSUP+ACPUPD;%IF NOBODY IS WRITTING
	JRST	TSTRT2		;%CHECK FOR ANOTHER ACC
	POPJ	P,		;%SOMEBODY IS WRITTING, FAIL
>
;ROUTINE TO TEST IF THE A.T. GOT MARKED FOR DELETION
;THIS CAN HAPPEN IF FILDAE WAS CALLED
;ENTER WITH DEVACC, DEVUFB, AND U SET UP
;ENTER WITH CB
;EXIT CPOPJ1 IF THE A.T. WAS OK
;CPOPJ1 STILL HAVING CB
;EXIT CPOPJ IF THE A.T. WAS MARKED FOR DELETION.
;IF THE A.T. IS MARKED FOR DELETION, AND WE ARE THE LAST USER
;THEN DELETE THE A.T. AND RETURN THE DISK BLOCKS.
;CPOPJ WITHOUT CB
;DETROYS ALL TEMPORARIES
TSTAMD::HRRZ	T3,DEVACC##(F)	;%GET ADDR OF A.T.
	JUMPE	T3,CPOPJ1##	;%ALL IS OK IF NO A.T.
	MOVE	T2,ACCSTS##(T3)	;%GET STATUS WORD
	TRNN	T2,ACPDEL##	;%MARKED FOR DELETION?
	JRST	CPOPJ1##	;%NO, A.T. IS OK
	TRNE	T2,ACMCNT	;%YES, ANY MORE USERS?
	PJRST	GVCBJ		;%MORE USERS, LEAVE IT ALONE
	PUSHJ	P,GVCBJ		;%GIVE UP CB. NOBODY WILL GRAB THE
				;% A.T. SINCE IT HAS ACPDEL ON
	PUSHJ	P,SAVE1##	;SAVE P1
	PUSHJ	P,AT2DDB	;SET UP DDB POINTERS FROM A.T.
	  JRST	TSTAM1		;BAD POINTER
	PUSHJ	P,REDRIB##	;READ THE PRIME RIB
	  JRST	TSTAM1		;RIB ERROR
	PUSHJ	P,SPTRW##	;GET AOBJN POINTER TO RTP'S
	MOVE	P1,T1
	PUSHJ	P,DELRIB##	;RETURN ALL THE DISK BLOCKS
	  JFCL
TSTAM1:	HRRZ	T2,DEVACC##(F)	;GET A.T. BACK
	PUSHJ	P,GETCB		;GET INTERLOCK
	PJRST	ATRMVX		;%DELETE THE A.T. AND GIVE UP CB
;HERE IF THERE ARE NO WRITERS IN ANY STR IN SEARCH LIST
ACCLP5:	MOVEI	T1,FNCSUP##	;%SEE IF SUPERSEDE IS LEGAL
	PUSHJ	P,CHKPRV	;%CHECK PRIVILEGES
	  JRST	FNER2X		;%PRIVILEGES WRONG
IFN	FTFDAE,<
	PUSHJ	P,TSTAMD	;%A.T. MARKED FOR DELETION?
	  JRST	STRLK1		;YES, THROW IT AWAY AND START OVER
	PUSHJ	P,TSTRIT	;%ANOTHER SUPERSEDER SNEAK IN?
	  JRST	FNDER7		;%YES
>
	HRRZ	T2,DEVACC##(F)	;%
	MOVE	T1,ACCNDL##(T2)	;%DONT-DELETE WORD
	TRNE	T1,ACPNDL##	;%IS THIS A MAGIC FILE?
	JRST	FNER2X		;%YES, EVEN [1,2] CANT SUPERSEDE IT
	LDB	T3,ACZCNT##	;%NO, GET USER COUNT
	SKIPE	ACCDOR##(T2)	;%IS THE A.T. DORMANT?
	JUMPE	T3,FILRR5	;%MAYBE, DON'T TRUST ACCDOR IF FILDAE LIT ACCCNT

;HERE IF THE A.T. WE FOUND IS NOT DORMANT (MUST BE READING)
ACCLP6:	LDB	T1,ACYFSN##	;%FSN OF FILE TO BE SUPERSEDED
	DPB	T1,DEYFSN##	;%SAVE FSN OF SUPERSEDED FILE
	HLLZ	P2,ACCPRV##(T2)	;%PROTECTION  OF OLD FILE
	TLZ	P2,777		;%PROTECTION ALONE
	PUSHJ	P,CREAC		;%SET UP ACCESS TABLE
	  JRST	FNDER1		;%NO TABLE ROOM
	MOVEM	P2,ACCPRV##(T3)	;%SET OLD FILE'S PROT INTO NEW A.T.
	HRRM	T2,DEVACC##(F)	;%SAVE LOC OF A.T.
	DPB	T1,ACYFSN##	;%INDICATE FSN OF FILE
	PUSHJ	P,STWLK		;%LIGHT IOSWLK IF STR IS READ-ONLY
	JRST	STRD3A		;%GO STORE VALUES INTO NEW A.T.
;HERE WHEN A.T. NOT FOUND FOR THIS FILE FOR THIS STR. HAVE TO READ RIB
CFPCHK:	PUSHJ	P,FSNPS2	;%DOES FILE EXIST ON THIS STR?
	TDNN	T2,NMBYES##(P4)
	JRST	ACLP1A		;%NO, DON'T BOTHER TO READ THE DIR
	HRRZ	T2,NMBCFP##(P4)	;%POINTER TO FILE RIB BLOCK
	LDB	T3,NMXFSN##	;T3=FSN OF CFP
	CAIN	T1,(T3)		;%CFP FOR THIS STR?
	JUMPN	T2,FILRIB	;%YES. READ IT IF IT EXISTS
	CAIA

;HERE WHEN CFP IS NOT FOR THIS STR. READ UFD (OR SFD)
UFBLUP:	PUSHJ	P,GETCB		;GET CB RESOURCE IF COMING FROM STRLUP
	HRRZ	T3,DEVCFS##(F)	;%CFP SUPPLIED?
	JUMPE	T3,UFBLP1	;%NO. PROCESS NORMALLY
	HRRM	T3,NMBCFP##(P4)	;%YES, SAVE CFP IN NMB
	JRST	FILRIB		;%DO LOOKUP USING SUPPLIED CFP
UFBLP1:	HLRZ	T2,PPBUFB##(P3)	;%LOC OF UFB BLOCK
	PUSHJ	P,BYTSCA	;%FIND RIGHT UFB FOR THIS STR
	  SKIPN	UFBPT1##(T2)	;%FOUND RIGHT UFB IF POINTER NON-0
	PUSHJ	P,GVCBJ1	;%NOT THERE, GIVE UP CB RESOURCE AND SKIP
	JRST	SCNUFD		;%FOUND UFB - READ IT

;HERE WHEN NO POINTERS TO UFD EXIST - READ MFD
UFBLP2:	SKIPG	T3,TABSTR##(T1)	;STR DATA BLOCK LOC
	JRST	NOUFD1		;NO STR OF THIS NUMBER EXISTS
	PUSH	P,DEVACC##(F)	;SAVE CURRENT DEVACC
	HRRM	T1,DEVACC##(F)	;STORE FSN IN DEVACC (FOR FNDUF1)
	MOVE	T2,STRPT1##(T3)	;1ST MFD POINTER FOR STR
	MOVE	T1,STRUN1##(T3)	;UNIT WHICH PT1 REFERS TO
	PUSHJ	P,SETFST	;SET UP FOR READING MFD
	  JRST	NOUFD0		;A.T. DATA FOULED UP BADLY - NO UFD EXISTS
	PUSHJ	P,GTMNBF##	;GET MONITOR BUFFER
	MOVE	T1,MFDPPN##	;PPN FOR UFD'S
	PUSHJ	P,FNDUF1##	;GET L(UFB) FOR MFD IN THIS STR
	  JRST	UFBLP3		;NOT THERE - NOTHING WE CAN DO ABOUT IT
	HRRM	T2,DEVUFB##(F)	;%FOUND - SAVE LOC OF UFB SO DIRRED
	PUSHJ	P,GVCBJ		;% WILL READ ALL OF THE MFD
UFBLP3:	POP	P,T1		;RESTORE DEVACC
	HRRM	T1,DEVACC##(F)
	MOVE	T3,DEVUFB##(F)
	LDB	T3,UFYWRT##	;GET CURRENT SIZE
	PUSH	P,T3		;SAVE FOR POSSIBLE LATER USE
;HERE TO READ AN MFD BLOCK
MFDLUP:	PUSH	P,DEVPPN(F)	;SAVE CURRENT PRJ,PRG
	MOVE	T1,MFDPPN##	;STORE MFD PRJ,PRG IN DDB
	MOVEM	T1,DEVPPN(F)	;IN CASE DIRRED READS THE RIB
	PUSHJ	P,DIRRED	;READ NEXT MFD BLOCK(S)
	  JRST	NOUF0		;UFD NOT FOUND
	POP	P,DEVPPN(F)	;RESTORE REAL PRJ,PRG
	MOVE	T1,PPBNAM##(P3)	;PRJ-PRG NUMBER
	MOVEI	T2,(SIXBIT .UFD.)
	PUSHJ	P,DIRSCN	;SEARCH MFD FOR UFD
	  JRST	MFDLUP		;NOT THERE - TRY NEXT BLOCK
	POP	P,(P)
	JRST	UFDRIB		;FOUND UFD

;HERE WHEN NO UFD HAS BEEN FOUND IN THIS STR'S MFD
NOUFD0:	POP	P,DEVACC##(F)	;RESTORE DEVACC
	JRST	NOUFD1		;AND CONTINUE
NOUF0:	POP	P,DEVPPN(F)
	POP	P,T1		;GET ORIGINAL SIZE
	MOVE	T3,DEVUFB##(F)
	LDB	T3,UFYWRT##	;GET CURRENT SIZE
	CAMG	T1,T3		;HAS SIZE GOTTEN SMALLER?
	JRST	NOUFD1		;NO--PROCEED AS USUAL
	MOVE	T1,DEVUFB##(F)	;YES-SET UP TO RETRY
	LDB	T1,COZFSN##
	JRST	UFBLP2
NOUFD1:	TRZE	S,IODTER+IODERR	;ERROR READING RIB?
	JRST	SCNSTR		;YES, DONT MARK FILE NON-EXISTANT
	PUSHJ	P,FSNPOS	;NO, SET A BIT FOR THIS STR
	ANDCAM	T2,PPBYES##(P3)	;INDICATE UFD IS NOT IN THIS STR
	ANDCAM	T2,NMBYES##(P4)	;INDICATE FILE IS DEFINITELY NOT IN STR
	SKIPN	TABSTR##(T1)	;IF NOT A FILE STRUCTURE (DEVICE ALL:)
	JRST	SCNSTR		; DON'T KNOW ABOUT UFD
	ORM	T2,PPBKNO##(P3)
	ORM	T2,NMBKNO##(P4)
	JRST	SCNSTR		;GO LOOK AT NEXT STR
;HERE WHEN UFD HAS BEEN FOUND IN THIS STR. CFP IN T1
UFDRIB:	PUSHJ	P,CFP2BK	;CONVERT TO BLOCK NO. FOR RIB
	  JRST	NOFILE		;BAD CFP - FILE NOT FOUND
	PUSHJ	P,UFDRED##	;READ THE UFD RIB
	  JRST	SCNSTR		;BAD UFD - FILE NOT FOUND
	MOVE	T2,RIBSIZ##+1(T1) ;LENGTH (IN WORDS) OF UFD DATA
	TRZN	T2,BLKSIZ##-1	;MULTIPLE OF 200 WORDS?
	JRST	UFDRB0		;YES
	ADDI	T2,BLKSIZ##	;NO, MAKE IT SO (SO THAT RETURNING NO. OF WORDS IN
	MOVEM	T2,RIBSIZ##+1(T1)	; LAST BLOCK WILL ALWAYS WORK - RETURNING ACTUAL NO OR MORE)
	MOVE	T2,RIBSLF##+1(T1)	;BLOCK NUMBER OF UFD RIB AGAIN
	PUSHJ	P,MONWRT##	;REWRITE UFD RIB
UFDRB0:	PUSHJ	P,SLGTX		;T1=STR NUMBER

	PUSHJ	P,GETCB		;GET CB RESOURCE
	HLRZ	T2,PPBUFB##(P3)	;%SET UP TO SCAN UFB BLOCKS
	MOVEI	T3,DIFPBC##(P3)	;%SET T3 AS PREDECESSOR IN CASE NO UFB
	PUSHJ	P,BYTSRC	;%SEE IF THE RIGHT UFB SNUCK IN
	  JRST	UFDRB1		;%CREATED THE UFB
	SKIPE	UFBPT1##(T2)	;%FOUND A SNEAK-IN IF PNTR NON-0
	JRST	SCNUFD		;%SNEAK-IN.  USE IT
UFDRB1:	JUMPLE	T2,FNDR1B	;%NO CORE BLOCKS AVAILABLE IF 0
	DPB	T1,UFYFSN##	;%STORE FSN IN UFB
	SETZ	T1,		;%
	HRRM	T2,DEVUFB##(F)	;%SAVE LOC OF UFB IN DDB
	MOVE	T3,.USMBF	;%LOC OF MON BUF
	ADD	T3,RIBFIR##+1(T3) ;%LOC OF 1ST RETRIEVAL POINTER
	MOVE	T4,1(T3)	;%NUMBER OF 1ST UNIT
	DPB	T4,UN1PTR##	;%STORE IN T1
	MOVE	T2,2(T3)	;%GET REAL 1ST POINTER
	SKIPN	3(T3)		;%ONLY POINTER?
	TRO	T1,UFP1PT##	;%YES. LIGHT 1PT
	MOVE	T4,DEVUFB##(F)	;%LOC OF UFB BLOCK
	HRRM	T1,UFBUN1##(T4)	;%STORE UN1,1PT DATA
	MOVEM	T2,UFBPT1##(T4)	;%STORE FIRST POINTER IN UFB
	HRRZ	T3,.USMBF	;%LOC OF MONITOR BUFFER (-1) AGAIN
	MOVE	T1,RIBQTF##+1(T3) ;%TOTAL QUOTA
	SUB	T1,RIBUSD##+1(T3) ;% - AMOUNT USED
	MOVEM	T1,UFBTAL##(T4)	;%=QUOTA LEFT
	MOVE	T1,RIBSIZ##+1(T3)	;%SIZE OF FILE (IN WORDS)
	ADDI	T1,BLKSIZ##-1	;%ACCOUNT FOR PARTIAL BLOCKS
	LSH	T1,MBKLSH##	;%NO OF BLOCKS WRITTEN
	DPB	T1,UFZWRT##	;%SAVE IN UFB BLOCK
	LDB	T1,RIYPRV##	;%GET PRIVS
	DPB	T1,UFYPRV##	;%SAVE IN UFB
	PUSHJ	P,FSNPOS	;%POSITION A BIT FOR THIS STR
	ORM	T2,PPBYES##(P3)	;%INDICATE UFD EXISTS IN THIS STR
	ORM	T2,PPBKNO##(P3)	;%
	JRST	SCNUF2		;%
;HERE WHEN THE UFD HAS BEEN FOUND - SEARCH FOR FILE NAME
SCNUFD:	HRRM	T2,DEVUFB##(F)	;%SAVE LOC OF UFB
SCNUF2:	PUSHJ	P,GVCBJ		;%GIVE UP CB RESOURCE
	TLO	M,UUOUFD##	;INDICATE AT LEAST 1 UFD FOUND FOR USER
	PUSHJ	P,UFDSRC	;SEARCH UFD FOR DEVFIL,DEVEXT
	  JRST	NOFILE		;FILE NAME DOESNT EXIST IN THIS UFD
	PUSHJ	P,GETCB		;FOUND. GET CB RESOURCE
	TLNE	M,UULKRN##	;%ENTER?
	JRST	SCNUF3		;%NO
	PUSH	P,T1		;%YES, SAVE CFP
	PUSHJ	P,FSNPOS	;%
	POP	P,T1		;%
	TDNE	T2,NMBKNO##(P4)	;%DO WE KNOW ABOUT FILE?
	TDNE	T2,NMBYES##(P4)	;%YES, IS IT THERE?
	JRST	SCNUF3		;%THIS ENTER IS OK
	PUSHJ	P,GVCBJ		;%FILE MUST BE IN PROCESS OF RENAME
	JRST	NOFIL2		;% SO PRETEND IT ISN'T THERE
SCNUF3:	HRRM	T1,NMBCFP##(P4)	;%SAVE FILE CFP IN NAME BLOCK
	PUSHJ	P,FSNPOS	;%SET BIT FOR THIS STR
	ORM	T2,NMBKNO##(P4)	;%INDICATE FILE EXISTS IN THIS STR
	ORM	T2,NMBYES##(P4)	;%
	MOVEI	T2,(P4)		;%POINT T2 TO NMB BLOCK
	DPB	T1,NMYFSN##	;%SAVE FSN IN NAME BLOCK

	JRST	FILRRB		;%READ FILE'S RIB


;HERE WHEN FILE WAS NOT FOUND IN UFD
NOFILE:	PUSHJ	P,FSNPOS	;POSITION A BIT FOR STR NUMBER
NOFIL2:	TRNN	S,IODTER+IODERR	;IF NO ERROR READING RIB,
	ORM	T2,NMBKNO##(P4)	;INDICATE WE KNOW ABOUT FILE (IE, IT ISN'T THERE)
	TRZE	S,IODTER+IOIMPM	;UFD RIB ERROR?
	TLNE	M,UULKRN##	;YES, ENTER?
	JRST	SCNSTR		;UFD OK OR NOT ENTER
	HRRZ	T1,DEVUFB##(F)
	SETZM	UFBTAL##(T1)
;HERE WHEN AN STR HAS BEEN LOOKED AT - CHECK NEXT
SCNSTR:	JRST	STRLUP		;TRY NEXT STR



;HERE IF FILE NOT FOUND, OR "WRONG" ONE FOUND
STRDON:	TLNN	M,UUOSFD##	;FOUND AN SFD?
	JRST	STRDN0		;NO
	TLO	M,UUO2SF##	;YES, INDICATE SECOND TIME AROUND
	JRST	STRLK1		;AND TRY AGAIN (WE NOW HAVE ALL AT'S
				; FOR THE SFD IN CORE)
STRDN0:	TLNN	M,UUOUFD##	;WAS ANY UFD SEEN?
	JRST	FNDER8		;NO. ERROR RETURN
	JUMPL	M,FNDER3	;ERROR IF LOOK UP


;HERE IF FILE NOT FOUND ON AN ENTER
;(MAY HAVE FOUND A FILE IN AN EARLIER STR)
;MAKE SURE NO ACCESS TABLE ENTRY SNUCK IN BY CHECKING NMBYES
;THIS IS LEGAL, SINCE WE KNOW ABOUT THE FILE IN EVERY STR AT THIS POINT
	MOVE	P2,P1		;P2=SL PTR
	PUSHJ	P,GETCB		;GET CB RESOURCE
STRDN1:	PUSHJ	P,NXSTR		;%GET NEXT STR
	  JRST	STRDN3		;%YES. A.T. DIDN'T SNEAK IN
	HLRZ	T2,NMBACC##(P4)	;%LOC OF A.T.
STRDN2:	PUSHJ	P,BYTSCA	;%FIND A.T. FOR THIS STR
	  SKIPA	T3,ACCSTS##(T2)	;%FOUND - CHECK IT
	JRST	STRDN1		;%NOT THERE - CONTINUE
	TRNE	T3,ACPNIU	;%MARKED FOR DELETION?
	JRST	STRD2A		;%YES, IT REALLY ISN'T THERE
	TLNE	M,UUOREN##	;%RENAME?
	JRST	FNER11		;%YES, FILE ALREADY EXISTS
	TRNE	T3,ACPCRE+ACPREN+ACPSUP+ACPUPD;%IS THE SNUCK-IN A.T. READING?
	JRST	FNDER7		;%NO - ERROR RETURN
	LDB	T4,DEYFSN##	;%FORMER SNEAK-IN?
	SKIPN	T4
	DPB	T1,DEYFSN##	;%NO, WE'LL SUPERCEDE ON THIS STR - REMEMBER NUMBER
STRD2A:	HLRZ	T2,ACCNMB##(T2)	;%STEP TO NEXT A.T. IN RING
	JRST	STRDN2		;%CHECK NEXT
;HERE WHEN ACCESS TABLE ENTRY DID NOT SNEAK IN. CREATE ONE
STRDN3:	TLNE	M,UUOREN##	;%RENAME?
	JRST	RENDN1		;%YES. MAKE SURE ITS OK
	PUSHJ	P,CREACC	;%NO. SET UP AN A.T. ENTRY
	  JRST	FNDER1		;NO TABLE ROOM
	HRRM	T2,DEVACC##(F)	;%SAVE LOC IN DDB
STRD3A:	MOVE	T1,NMBACC##(P4)	;%LINK A.T. INTO THIS NMB RING
	HRRZ	T2,DEVACC##(F)	;%LOC OF A.T.
	HRLM	T2,NMBACC##(P4)	;%POINT NMB TO THIS A.T.
	HLLM	T1,ACCNMB##(T2)	;%LINK THIS TO NEXT A.T.
	CBDBUG	(Y,Y);
	LDB	T1,DEYFSN##	;%FSN OF ANY READER
	JUMPN	T1,STRDN4	;%SUPERSEDE IF FOUND ONE
STRD3B:	PUSHJ	P,UFBSZ		;%CREATE - PICK AN STR TO WRITE
	  JRST	FNER9A		;%NO ROOM
	SKIPA	T3,[ACPCRE]	;%INDICATE CREATE
STRDN4:	MOVEI	T3,ACPSUP	;%INDICATE SUPERSEDE
	HRRZ	T2,DEVACC##(F)	;%LOC OF A.T.
	DPB	T1,ACYFSN##	;%SAVE FSN IN A.T.
	MOVE	P2,T3		;%SAVE STATUS OF FILE
	IORM	T3,ACCSTS##(T2)	;%SAVE STATE IN A.T.
REPEAT 0,<
	TRC	T3,ACPCRE!ACPSUP
	ANDCAM	T3,ACCSTS##(T2)	;%MAKE SURE EXTRANEOUS BITS ARE CLEAR
>
	HRLM	T1,P2		;%SAVE IN LH(P2)

	PUSHJ	P,SETUFB	;%STORE LOC OF UFB IN DDB
	  STOPCD .,JOB,NUB,	;++NO UFB BLOCK
	SKIPL	T3,TABSTR##(T1)	;%STR ADDRESS

	SKIPG	STRTAL##(T3)	;%ANY ROOM?
	JRST	STRFUL		;%NO - HAVE TO SUPERSEDE ON ANOTHER STR
	SKIPLE	UFBTAL##(T2)	;%YES. USER HAVE A QUOTA ON STR?

	JRST	STRDN5		;% YES
;HERE WHEN THE UFB HAS NO ROOM (MUST BE SUPERSEDE, CAN'T WRITE ON THIS STR)
STRFUL:	DPB	T1,DEYFSN##	;%SAVE FSN OF FILE BEING SUPERSEDED
	PUSHJ	P,UFBSZ		;%FIND A UFB WITH ROOM
	  JRST	FNER9A		;%CANT FIND ANY - ERROR
	PUSHJ	P,FSNPS2	;%SET BIT FOR NEW STR
	ORM	T2,NMBYES##(P4)	;%INDICATE WE KNOW ABOUT FILE,
	ORM	T2,NMBKNO##(P4)	;% AND THAT IT EXISTS IN NEW STR
	JRST	STRDN4		;%SET UP SOME NUMBERS AND FINISH

;HERE WHEN WE HAVE THE UFD WE WANT TO WRITE IN
STRDN5:	TRNE	P2,ACPSUP	;%SUPERSEDING?
	JRST	FNDXIT		;%YES. GOOD RETURN
	HLRZ	U,STRUNI##(T3)	;MAKE SURE DEVUNI IS SETUP
	PUSHJ	P,STORU##	; FOR GETAC
IFN FTFDAE,<
	MOVE	T2,DEVACC##(F)	;%IF WE BLOCK WAITING FOR FILDAE
	SETZ	T1,		; AND USER TYPES ^C, WE DONT WANT FBM ERRORS
	DPB	T1,ACYFSN##	; SO POINT THE A.T. AT FILE STRUCTURE 0
>
	MOVEI	T1,FNCCRE##	;%NO. CREATE
	PUSHJ	P,CHKPRV	;%SEE IF PRIVS ALLOW FUNCTION
	  JRST	FNER2Z		;%NO. ERROR
IFN FTFDAE,<
	HLRZ	T1,P2		;%IF THE FILE DAEMON GOT CALLED,
	MOVEI	T2,DIFNAL##(P4)	; ANOTHER JOB MIGHT HAVE CREATED THE
STRDN6:	PUSHJ	P,BYTSC1	; FILE, SO CHECK FOR ACCESS TABLES
	  JRST	[MOVE T3,ACCSTS##(T2) ;%SOMEONE GOT THROUGH - FILE BEING MODIFIED
		 TRNE T3,ACPDEL##
		 JRST STRDN6
		 SKIPN ACCDOR##(T2)
		 JRST FNER21
		 JRST .+1]
	PUSHJ	P,FSNPS2	;%IF NMBYES=1 FILES HAS BEEN CREATED,
	TDNE	T2,NMBYES##(P4)	; LOOKED UP, CLOSED
	JRST	FNER21		;%SO THIS JOB LOSES
	MOVE	T2,DEVACC##(F)	;%OK.  RESTORE FSN IN AT
	DPB	T1,ACYFSN##
	MOVE	T1,TABSTR##(T1)	; IF GAVE UP THE DA RESOURCE
	SKIPG	STRTAL##(T1)	; SO SOME OTHER JOB COULD HAVE USED IT UP
	JRST	STRD3B		;%ALL USED UP-TRY ANOTHER STR
>
	HLRZ	T1,P2		;%YES. GET FSN
	LDB	T2,NMXFSN##	;%FSN
	CAIN	T1,(T2)		;%IS THIS THE STR OF THE CFP?
	HLLZS	NMBCFP##(P4)	;%YES, ZERO CFP (IT IS NOT CURRENT)
	PUSHJ	P,STWLK		;LIGHT IOSWLK IF APPROPIATE
	JRST	FNDXIT		;%GIVE UP CB AND GOOD RETURN
;HERE ON A RENAME WHEN THE FILE HAS NOT BEEN FOUND
RENDN1:	HRRZ	P2,DEVACC##(F)	;%LOC OF A.T.
	MOVE	T1,ACCSTS##(P2)	;%STATUS OF FILE
	TRNE	T1,ACPREN+ACPDEL##	;%FILE BEING RENAMED OR MARKED
				; FOR DELETION ALREADY?
	JRST	FNER14		;%YES. THIS RENAME IS ILLEGAL
	TRNE	T1,ACPCRE+ACPSUP+ACPUPD;%NO. CREATE,SUPERSEDE OR UPDATE?
	TLNE	F,ENTRB		;%YES. IS THIS THE USER DOING IT?
	SKIPA	T2,P2		;%YES, LEGAL
	JRST	FNER14		;%NO. ERROR
	TRZE	T1,ACPSUP	;%WAS OLD FILE SUPERSEDING?
	TRO	T1,ACPCRE	;%YES IT IS NOW A CREATE
	MOVEM	T1,ACCSTS##(P2)	;%SAVE STATUS
	LDB	T1,ACYFSN##	;%GET FSN

	PUSHJ	P,SETUFB	;%SET UP DEVUFB
	  JRST	FNER17		;%UFB WAS DELETED
	MOVE	T2,DEVACC##(F)	;%LOC OF A.T. AGAIN
	HLRZ	T2,ACCNMB##(T2)	;%NEXT IN RING
	TRZN	T2,DIFNAL##	;%NAME BLOCK?
	JRST	.-2		;%NO. TRY NEXT IN RING
	HRLM	T2,P2		;%YES. SAVE ITS LOC IN LH(P2)
	HRRZ	P1,ACCPPB##(P2)	;%OLD PPB LOC
	HRRM	P3,ACCPPB##(P2)	;%NEW PPB LOC(IF CHANGING DIRECTORIES)

	MOVEI	T1,FNCCNM##	;%CHANGE-NAME FUNCTION
	CAIE	P1,(P3)		;%CHANGING DIRS?
	MOVEI	T1,FNCCRE##	;%YES. SEE IF CREATE IN NEW DIR IS LEGAL

	PUSHJ	P,CHKPRV	;%IS FUNCTION ALLOWED?
	  JRST	FNER12		;%NO. ERROR RETURN
	CAIN	P1,(P3)		;%YES. CHANGING DIRS?
	JRST	RENDN4		;%NO
	MOVE	T2,P2		;%YES. OLD FSN=NEW FSN
	LDB	T1,ACYFSN##
	HLRZ	T2,PPBUFB##(P3)	;%SET TO SCAN FOR THE UFB BLOCK
	PUSHJ	P,BYTSCA	;%DOES NEW DIRECTORY HAVE UFD IN THIS STR?
	  SKIPA	T1,ACCALC##(P2)	;%YES, GET SIZE OF FILE
	JRST	FNER13		;%NO. CANT CHANGE DIRECTORIES
	CAMLE	T1,UFBTAL##(T2)	;%IS THERE ROOM FOR FILE IN NEW DIRECTORY?
	JRST	FNER18		;%NO. CANT CHANGE DIRS.

	MOVNS	T1		;%YES
	ADDM	T1,UFBTAL##(T2)	;%DECREASE QUOTA IN NEW DIR
	HRRM	T2,DEVUFB##(F)	;%SAVE LOC OF NEW UFB IN DDB
	TLZ	M,UUOREN##	;%INDICATE CHANGING DIRS BY ZEROING UUOREN
;HERE WHEN NEW DIRECTORY IS SET UP (IF CHANGING)
RENDN4:	HRRZ	T1,P2		;%LOC OF A.T.
	HLRZ	T2,NMBRNG##(P4)	;%IS FILE IN AN SFD?
	JUMPE	T2,REND4B
	LDB	T2,ACYCNT##	;%YES, IS READ-COUNT = 1?
	SOJG	T2,FNER20	;%NO, CANT DO THE RENAME
REND4B:	PUSHJ	P,ATNLNK	;%UNLINK IT FROM OLD NMB RING
	MOVE	T1,NMBACC##(P4)	;%SET TO LINK A.T. INTO RING
	HRLM	P2,NMBACC##(P4)	;% FOR NEW NAME BLOCK
	HLLM	T1,ACCNMB##(P2)	;%
	CBDBUG	(Y,Y);
	MOVEI	T4,ACPREN	;%INDICATE RENAME IS IN PROGRESS
	IORB	T4,ACCSTS##(P2)	;%IN A.T.
	MOVE	T2,P2
	LDB	T1,ACYFSN##	;%GET FSN

	PUSHJ	P,FSNPS2	;%POSITION A BIT FOR NMBYES
	HLRZ	T3,P2		;%LOC OF OLD NMB
	TRNE	T4,ACPCRE	;%IF NOT CREATING,
	JRST	REND4A
	ANDCAM	T2,NMBYES##(T3)	;%INDICATE OLD FILE NOT IN THIS STR
REND4A:	ORM	T2,NMBYES##(P4)	;%INDICATE NEW FILE IS IN STR
	MOVE	T1,DEVACC##(F)
	LDB	T1,ACYCNT##	;%NO OF READERS OF FILE
	ADDM	T1,NMBCNT##(P4)	;%COUNT UP NEW NMB COUNT
	SUBI	T1,1		;%COUNT UP NEW PPB COUNT
	ADDM	T1,PPBCNT##(P3)
	MOVNS	T1
	ADDM	T1,PPBCNT##(P1)	;%COUNT DOWN OLD PPB COUNT
	SUBI	T1,1
	ADDM	T1,NMBCNT##(T3)	;%COUNT DOWN OLD NMB COUNT
	HLLZS	NMBCFP##(T3)	;%REMOVE CFP FROM OLD FILE NMB
	HRRZ	T2,DEVSFD##(F)	;%RAISE NEW SFD
	MOVEI	T4,1
	PUSHJ	P,FIXUSE
	HLRZ	T2,DEVSFD##(F)	;%LOWER OLD SFD
	SETO	T4,
	PUSHJ	P,FIXUSE
	HLRZ	T3,P2		;%GET OLD NMB BACK
	PUSHJ	P,GETNMB##	;%BUMP COUNT IF IN SOMEBODY'S PATH
	PUSHJ	P,FIXPTH##
	HLRZ	T1,NMBRNG##(T3)	;IF THIS IS AN SFD
	JUMPE	T1,FNDXIT
	TRZE	T1,NMPUPT##	; WHICH POINTS TO LOWER NMB'S
	JRST	FNDXIT
	MOVEI	T2,NMPUPT##(T3)	;POINT IT AT ITSELF
	HRLM	T2,NMBRNG##(T3)
	HRLM	T1,NMBRNG##(P4)	;POINT NEW NMB AT RING
REND4C:	MOVE	T2,T1		;FIND THE END OF THIS NMB RING
	HLRZ	T1,NMBPPB##(T1)
	TRZN	T1,NMPUPT##
	JRST	REND4C
	MOVEI	T1,NMPUPT##(P4)	;POINT THE RING AT THE NEW NMB
	HRLM	T1,NMBPPB##(T2)
	JRST	FNDXIT		;%AND EXIT
;ROUTINE TO FIX THE SFD USE COUNTS
;T2 PASSES ADDR OF SFD NMB
;T4 PASSES +1 IF COUNTS NEED TO BE RAISED
;T4 PASSES -1 IF COUNTS NEED TO BE LOWERED
;MUST HAVE CB
;CLOBBERS T1-T4
FIXUSE:	JUMPE	T2,CPOPJ##	;%GO IF NOT IN AN SFD
	PUSHJ	P,SAVE1##	;%SAVE P1
	MOVE	T1,DEVACC##(F)	;%GET ADDR OF ACC
	LDB	P1,ACYCNT##	;%NUMBER OF PEOPLE USING THE FILE
	SOJLE	P1,CPOPJ##	;%GO IF WE'RE THE ONLY ONE
	IMUL	P1,T4		;%MAGNITUDE AND DIRECTION
	ADDM	P1,NMBCNT##(T2)	;%BUMP THE SFD NMB
	LDB	T1,ACZFSN##	;%FSN FILE IS ON
	TRO	T2,DIFNAL##	;%PRESET PREDECESSOR
	PUSHJ	P,BYTSC1	;%SEARCH FOR SFD ACC
	  SKIPA	T3,ACCPPB##(T2)	;%FOUND, GET ADDR OF PPB
	POPJ	P,		;%NOT FOUND
	ADDM	P1,PPBCNT##(T3)	;%BUMP THE SFD PPB
	LDB	T1,ACZCNT##	;%BUMP THE SFD ACC
	ADD	T1,P1
	DPB	T1,ACZCNT##
	POPJ	P,
;HERE WHEN CFP HAS BEEN FOUND FROM NAME BLOCK.
FILRIB:
;ENTER HERE WHEN UFD WAS READ. DEVUFB ALREADY SET UP
FILRRB:	HRL	P3,NMBCFP##(P4)	;%SAVE CFP FOR THIS NMB
	JUMPL	M,FILRRA	;IF ENTER,
	SKIPL	T3,DEVSPL(F)	;IF IN SPOOL MODE,
	TROE	T3,DEPECS	; OR NON-SUPERSEDING ENTER
	PJRST	NOSUPR		;SUPERSEDE IS ILLEGAL
FILRRA:	PUSHJ	P,GVCBJ		;%GIVE UP CB RESOURCE
	TLNE	M,UUOREN##	;RENAME?
	JRST	FNDER6		;YES/A ERROR
	HLRZ	T1,P3		;CFP FOR FILE
	PUSHJ	P,CFP2BK	;CONVERT TO BLOCK NUMBER
	  JRST	FNER16		;BAD CFP - ERROR RETURN
	PUSHJ	P,RIBRED##	;READ THE RIB
	  JRST	FNER16		;RIB ERR - GIVE ERROR RETURN
	MOVEM	S,DEVIOS(F)	;%
	PUSHJ	P,GETCB		;GET CB RESOURCE
	PUSHJ	P,CHEKU##	;%IS STR STILL THERE?
	JRST	FNR16A		;%
	PUSHJ	P,FSNPOS	;%POSITION A BIT
	TDNN	T2,NMBYES##(P4)	;%IS THE FILE STILL THERE?
	JRST	FNDERB		;%NO, SOMEBODY MUST HAVE DELETED IT
	HRLZ	T2,NMBCFP##(P4)	;%STILL SAME CFP?
	XOR	T2,P3
	LDB	T3,NMXFSN##	;%AND STILL SAME STR?
	CAMN	T3,T1
	TLNE	T2,-1
	JRST	STRLP9		;%NO
	HLRZ	T2,NMBACC##(P4)	;%%LOOK AT A.T. ENTRIES
	MOVEI	T3,DIFNAL##(P4)	;%%PRESET PREDECESSOR
FILRR0:	PUSHJ	P,BYTSRC	;%%LOOK FOR SNUCK-IN A.T.
	  JRST	FILRR1		;%CREATED A 1ST HALF - GET MORE CORE
	HRLZ	T4,ACCSTS##(T2)	;%CURRENT STATUS
	TLNN	T4,ACPDEL##	;%MARKED FOR DELETION?
	JRST	FILRRC		;%NO
	JUMPGE	T4,FILRRD	;%YES, CONTINUE WITH NEXT IF IN UFD

;HERE IF ACPNIU IS ON IN THE A.T.  2 POSSIBILITIES EXIST-
;A) THE FILE IS CURRENTLY BEING DELETED, OR
;B) SOME JOB IS READING A SUPERCEDED VERSION
	PUSHJ	P,SPTRW##	;%SET FOR FIRST RET POINTER
	MOVE	T1,1(T1)	;%GET FIRST POINTER (AFTER UNIT-CHANGE)
	CAMN	T1,ACCPT1##(T2)	;%IS THE FIRST POINTER THE SAME?
	JRST	FNDERB		;% YES, FILE IS BEING DELETED.  GIVE FNF ERR
	PUSHJ	P,SLGTX		;% NO, A.T. IS FOR A SUPERCEDED VERSION.  OK
	JRST	FILRRD		;% TEST NEXT A.T. IN RING
FILRRC:	JUMPG	M,SNUKIN	;%NO,SNEAK-IN IF NOT A LOOKUP
	TLNN	T4,ACPCRE+ACPSUP	;%CREATE OR SUPERSEDE?
	JRST	SNUKIN		;%NO, SNEAK-IN. TEST IT
FILRRD:	MOVE	T3,T2		;%YES, THIS AT OK. RESET PRED.
	HLRZ	T2,ACCNMB##(T2)	;%STEP TO NEXT A.T. IN RING
	JRST	FILRR0		;%KEEP LOOKING FOR SNEAK-INS
;HERE IF AN A.T. DID SNEAK IN
SNUKIN:	CBDBUG	(Y,Y);
	PUSHJ	P,SLGTX		;%SET T1=FSN AGAIN

	JRST	ACCLP1		;%AND GO TEST IT

;HERE IF NO A.T. SNUCK IN
FILRR1:	JUMPLE	T2,FILNRM	;%NONE AVAILABLE
	HRRM	P3,ACCPPB##(T2)	;%SAVE LOC OF PPB
	HRRM	T2,DEVACC##(F)	;%LOC OF ACC IN DDB
	HRRZ	T4,.USMBF	;%LOC OF MON BUF(-1)
	HRRZ	T1,RIBEXT##+1(T4) ;%ACCESS DATE
	MOVSM	T1,ACCADT##(T2)	;%SAVE IN A.T.
	MOVE	T1,RIBSIZ##+1(T4) ;%SIZE IN WORDS
	ADDI	T1,BLKSIZ##-1	;%
	LSH	T1,MBKLSH##	;%CONVERT TO BLOCKS
	MOVEM	T1,ACCWRT##(T2)	;%SAVE IN A.T.
	SKIPE	T1,RIBSIZ##+1(T4)	;%SIZE IN WORDS
	TRNE	T1,BLKSIZ##-1	;%IS THERE A PARTIAL LAST BLOCK?
	TRZA	T1,BLKSIZ##	;%YES. MAKE SURE TOTAL IS .LT. 200
	MOVEI	T1,BLKSIZ##	;%NO. SET LENGTH=FULL BUFFER
	DPB	T1,ACYLBS##	;%
	MOVE	T1,RIBALC##+1(T4)	;%SPACE ALLOCATED IN WORDS
	MOVEM	T1,ACCALC##(T2)	;%SAVE IN A.T.
	MOVE	T1,RIBPRV##+1(T4)	;%DATE AND PRIVS WORD
	MOVEM	T1,ACCPRV##(T2)	;%SAVE IN A.T.
	MOVE	T1,RIBSTS##+1(T4)	;%RIB STATUS WORD
	TRNN	T1,RIPDIR##	;%DIRECTORY FILE?
	TDZA	T3,T3		;%NO
	MOVEI	T3,ACPDIR##	;%YES
	TRNE	T1,RIPABC##	;%FILE HAVE ALWAYS-BAD CHECKSUM?
	TRO	T3,ACPABC##	;%YES. LIGHT BIT IN ACC
	TRNE	T1,RIPNDL##	;%NO-DELETE BIT ON?
	TRO	T3,ACPNDL##	;%YES
	ORM	T3,ACCDIR##(T2)	;%SET DIR BIT IN ACC IF A DIRECTORY
	TRNN	T1,RIPPAL##	;%PRE-ALLOCATED FILE?
	TDZA	T3,T3		;%NO
	MOVEI	T3,ACPPAL##	;%YES
	IORM	T3,ACCPAL##(T2)	;%SAVE BIT IN A.T.
	ADD	T4,RIBFIR##+1(T4);%POINT TO 1ST RETRIEVAL POINTER
	MOVE	T2,1(T4)	;%UN1 WORD
	SETZ	T1,		;%
	DPB	T2,UN1PTR##	;%SAVE UN1 IN T1
	MOVE	T2,2(T4)	;%REAL 1ST POINTER
	SKIPN	3(T4)		;%ONLY POINTER?
	TRO	T1,ACP1PT##	;%YES. LIGHT 1PT
	HRRZ	T4,DEVACC##(F)	;%LOC OF A.T.
	ORM	T1,ACCUN1##(T4)	;%SAVE UN1 WORD IN A.T.
	MOVEM	T2,ACCPT1##(T4)	;%SAVE 1ST POINTER IN A.T.
	SETZM	DEVRIB##(F)	;%CLEAR DEVRIB FOR DPB'S
	LDB	T1,UNYLUN##	;%GET LOGICAL UNIT NUMBER
	DPB	T1,DEYRBU##	;%STORE IN DEVRIB
	MOVE	T1,UNISTR##(U)	;%POINTER TO STRUCTURE DATA BLOCK
	LDB	T1,STYCLP##(T1)	;%GET CLUSTER ADDRESS
	DPB	T1,DEYRBA##	;%STORE IN DEVRIB
	CBDBUG	(Y,Y);
	PUSHJ	P,SLGTX		;%GET STR

	MOVE	T2,DEVACC##(F)
	DPB	T1,ACYFSN##	;SAVE FSN IN A.T.
	HLRZ	T1,NMBRNG##(P4)	;%IS THIS AN SFD?
	JUMPE	T1,FILR1A	;%NO
	TLO	M,UUOSFD##	;%INDICATE FOUND AN SFD
	PUSHJ	P,GETNMB##
	PUSHJ	P,FIXPTH##	;%BUMP COUNT IF IN SOMEBODY'S PATH
	PJRST	ACLP1A		;%AND LOOK FOR SFD'S ON OTHER STR'S
FILR1A:	PUSHJ	P,CPYFST	;%COPY FIRST POINTERS INTO DDB, SET DEVBLK ETC
	  JUMPL	M,FNR16A	;%A.T. DATA FOULED UP - RIB ERR IF LOOKUP
				;%BUT IGNORE IF ENTER (SUPERSEDE)
	HRROI	T1,FNCRED##	;%SET UP FUNCTION TO READ
	SKIPL	M		;%
	HRROI	T1,FNCSUP##	;%OR SUPERCEDE
	PUSHJ	P,CHKPRV	;%CHECK PRIVILEGES
	  JRST	FNER2Z		;%NOT RIGHT
;HERE WHEN EVERYTHING IS OK. SET STATE CODE IN A.T. ENTRY
	HRRZ	T2,DEVACC##(F)	;%LOC OF ACCESS TABLE
	JUMPG	M,FILRR6	;%M NEGATIVE IF LOOKUP

;HERE ON A LOOKUP OF A NEWLY CREATED A.T.
	TLO	S,IOSRDC!IOSRIB	;%THIS FILE HAS READ COUNT UP
	MOVEI	T3,ACPCNT##	;%INDICATE 1 READER
	ADDM	T3,ACCSTS##(T2)	;%SAVE STATUS IN A.T.
	PUSHJ	P,STWLK		;%SET BIT IN S IF STR IS WRITE-LOCKED
	JRST	FNDXIT		;%RETURN WITH RIB IF A LOOKUP

;HERE ON AN ENTER OF A NEWLY CREATED A.T.
FILRR6:	MOVE	T1,ACCNDL##(T2)
	TRNE	T1,ACPNDL##	;%SPECIAL FILE?
	JRST	FNER2Z		;%YES, ERROR IF ENTER
	TRNE	T1,ACPDIR##	;UFD?
	JRST	FNDR10		;%YES, ERROR IF ENTER
IFN	FTFDAE,<
	PUSHJ	P,TSTAMD	;%A.T. MARKED FOR DELETION?
	  JRST	STRLK1		;YES, THROW IT AWAY AND START OVER
	PUSHJ	P,TSTRIT	;%ANOTHER SUPERSEDER SNEAK IN?
	  JRST	FNER21		;%YES
>
	HRRZ	T2,DEVACC##(F)	;%GET A.T. BACK
IFN	FTFDAE,<
	LDB	T3,ACZCNT##	;%IF FILDAE WAS CALLED, SOMEBODY
	JUMPN	T3,ACCLP6	;% MAY HAVE SNUCK IN
>

;HERE IF THE A.T. WE FOUND IS DORMANT (WE MAY SUPERSEDE IT).
FILRR5:	SKIPE	T1,ACCDOR##(T2)	;%IS THE A.T. DORMANT?
	PUSHJ	P,UNLINK	;%YES, MAKE ACTIVE
	MOVEI	T1,ACRSUP	;%MARK AS SUPERSEDING
	DPB	T1,ACYSTS##	;%
	PUSHJ	P,STWLK		;%SET BIT IN S IF STR IS WRITE LOCKED
	HRRZ	T1,UNISTR##(U)	;%LOC OF STR DATA BLOCK
	SKIPLE	STRTAL##(T1)	;%IS STR FULL?
	PJRST	FNDXIT		;%NO, RETURN
	MOVE	T2,DEVACC##(F)	;%YES
	MOVE	T3,ACCPAL##(T2)	;%PRE-ALLOCATED FILE
	TRNE	T3,ACPPAL##	;% WHOSE ALLOCATION WE'LL USE?
	PJRST	FNDXIT		;%YES, USE THIS STR
	LDB	T1,ACYFSN##	;%GET FSN OF FILE TO BE SUPERSEDED ON CLOSE

	JRST	STRFUL		;%FIND NEW STR TO SUPERSEDE ON
REPEAT 0,<
;SUBROUTINE TO CALL SETSRC AND REGAIN CONTROL TO RETURN TEMPORARY SL.
;	SO CALLER WONT HAVE TO WORRY ABOUT IT
;
;CALL AND RETURNS ARE IDENTICAL TO SETSRC EXCEPT T3 MODIFIED

GETSRC::PUSHJ	P,SETSRC
	  POPJ	P,		;NO TEMP.SL. IF NOSKIP RETURN
	MOVE	T3,T1
	EXCH	T3,(P)
	PUSHJ	P,(T3)		;FORCE CALLER TO RETURN HERE

;HERE WHEN GETSRC CALLER RETURNS TO HIS CALLER

	SKIPA			;PROPOGATE SKIP/NOSKIP
	AOS	-1(P)
	EXCH	P2,(P)		;GIVE UP POSSIBLE TEMP.SL.
	PUSHJ	P,SLGVT
	POP	P,P2
	POPJ	P,
>	;END REPEAT 0
;SUBROUTINE TO SET UP A SEARCH LIST
;ENTER WITH F=DDB LOC
;EXIT CPOPJ IF NO STRS ARE IN SEARCH LIST
;EXIT CPOPJ1 WITH SEARCH LIST POINTER IN T1
;	T3=0 IF NON-TEMPORARY SL., -1 IF TEMPORARY
;NOTE---THE SL. SETSRC GIVES WITH SKIP RETURN MAY BE A TEMPORARY
;	WHICH MUST BE GIVEN BACK TO FREE CORE.
;	I.E. ALWAYS CALL SLIGIVT AFTER GETTING SKIP RETURN WITH T3=-1
SETSRC::PUSHJ	P,SAVE2##
	SKIPE	T1,DEVLNM##(F)	;LOGICAL NAME?
	SKIPA	T1,LNRDEV##(T1)	;YES, GET DEVICE FROM FUNNY SPACE
	SKIPLE	T1,DEVNAM(F)	;PHYSICAL DEVICE NAME
	TLNE	T1,-1		; (A DISK IF POSITIVE - IN PTHUUO)
	PUSHJ	P,ALIASD	;IS NAME AN ALIAS FOR DSK?
	  SKIPA			;YES
	JRST	SETSR1		;NO
	PUSHJ	P,SLPRF		;GET JOB SL.PTR. (OR SYS.SL. IF NO JOB SL.)
	MOVE	P1,P2
	JRST	SETSX0		;SKIP RETURN

;HERE IF THE USER DOESN'T WANT GENERIC "DSK"
SETSR1:	PUSHJ	P,SDVTS1##	;IS IT A SPECIAL DEVICE?
	  JRST	SETSR3		;NO
	JUMPE	T3,SETSR2	;YES, IS IT DEVX?
	HRLI	T1,'DSK'	;YES, MAKE IT DSKX
	JRST	SETSR3		;AND SET UP THAT SEARCH-LIST
SETSR2:	PUSHJ	P,SDSRC		;GET SEARCH LIST
	SKIPE	P1,T3		;GET SL.PTR.
	JRST	SETSX0		;
	PUSHJ	P,SLPRF		;USE JOB SL.INSTEAD
	MOVE	P1,P2		;
	JRST	SETSX0		;
SETSR3:	MOVEI	T2,.SLMAX	;MAKE A TEMP.SL.
	PUSHJ	P,SLPRT		;
	  POPJ	P,		;NO FREE CORE - CANT BUILD SEARCH LIST
	MOVE	P1,P2		;
	PUSHJ	P,SRSTR		;IS THIS AN STR NAME?
	  JRST	SETSR4		;NO, SEARCH UNIT NAMES
	MOVE	T1,T4		;YES, APPEND TO SL.
	PUSHJ	P,SLAPD		;
	  PUSHJ	P,SLXAES	;STOPCD AES IF NO ROOM FOR ONE FS.
	JRST	SETSX1		;SET T1 AND RETURN
SETSR4:	PUSHJ	P,MSKUNI	;SET T2=MASK
	PUSHJ	P,UNSRCH	;FIND A MATCHING UNIT
	  PJRST	SLGVT		;NONE - EROR RETURN
SETSR5:	EXCH	T1,T4		;APPEND FSN. TO SL.
	PUSHJ	P,SLAPD		;
	  JRST	SETSX1		;FORGET THE REST IF NO MORE ROOM
	EXCH	T1,T4
	AOBJP	T4,SETSX1	;JUMP IF LOOKED AT ALL FS.S
	PUSHJ	P,UNSER0	;CONTINUE AT NEXT STR
	  JRST	SETSX1		;DONE
	JRST	SETSR5		;SAVE FSN, TRY NEXT STR
SETSX0:				;HERE TO RETURN WITHOUT A TEMP SL.
	TDZA	T3,T3		;T3=0 FOR NO TEMP.SL.
SETSX1:				;HERE TO RETURN WITH A TEMP SL.
	SETO	T3,		;T3=-1 FOR TEMP.SL.
	MOVE	T1,P1		;
	JRST	CPOPJ1##	;SKIP RETURN


;SUBROUTINE TO FIND A MATCHING UNIT(SEARCHES ONE STR AT A TIME)
;ENTER WITH T1=NAME  T2=MASK	J=JOB NUMBER (J=J)
;EXIT CPOPJ IF NOT FOUND
;EXIT CPOPJ1 IF FOUND, WITH T1=NAME, T2=MASK,T3=UNIT DB LOC, T4=STR NUMBER

UNSRCH::
	MOVE	T4,STRAOB##	;AOBJN WORD FOR TABSTR


;SUBROUTINE TO FIND A MATCHING UNIT
;SAME ARGUMENTS, VALUES AS ABOVE EXCEPT ENTER HERE IF T4 ALREADY SET UP
UNSER0::PUSH	P,T1		;SAVE NAME
UNSRC1:	SKIPG	T1,TABSTR##(T4)	;GET STR DB LOC
	JRST	UNSRC3		;THIS STR NOT IN USE

	HLRZ	T3,STRUNI##(T1)	;LOC OF 1ST UNIT IN STR
UNSRC2:	MOVE	T1,UNINAM##(T3)	;UNIT PHYSICAL NAME
	AND	T1,T2		;MASK IT
	CAMN	T1,(P)		;MATCH?
	PJRST	TPOPJ1##	;YES, TAKE GOOD RETURN
	MOVE	T1,UNILOG##(T3)	;NO. LOGICAL UNIT NAME
	AND	T1,T2		;MASK IT
	CAMN	T1,(P)		;MATCH?
	PJRST	TPOPJ1##	;YES, TAKE SKIP-RETURN
	HLRZ	T3,UNISTR##(T3)	;NO. STEP TO NEXT UNIT
	JUMPN	T3,UNSRC2	;TEST IT
UNSRC3:	AOBJN	T4,UNSRC1	;STEP TO NEXT STR AND TEST

	JRST	TPOPJ##		;ALL DONE - NO MATCH
;SUBROUTINE TO SET UP A SEARCH-MASK FOR A NAME
;ENTER WITH T1 =NAME
;EXIT WITH T1=NAME, T2=MASK
MSKUNI::SKIPN	T2,T1		;GET NAME
	POPJ	P,		;NOT A NAME - RETURN MASK =0
	MOVSI	T3,770000	;SET  UP MASK
	PUSH	P,T1		;SAVE VALUE
UNIMS1:	TDOE	T2,T3		;MASK T2
	TDZ	T1,T3		; WHILE WE EMPTY T1
	LSH	T3,-6		;SHIFT MASK
	JUMPN	T1,UNIMS1	;LOOP TILL GONE
	JRST	TPOPJ##		;RESTORE AND RETURN


;SUBROUTINE TO SET A BIT ACCORDING TO FSN FOR CORKNO, CORYES
;ENTER WITH P2= SL PNTR
;EXIT WITH FSN IN T1, BIT IN T2
FSNPOS:	PUSHJ	P,SLGTA		;%GET FSN
	  TDZA	T1,T1		;STR REMOVED, RETURN 0

;FSNPS SAME AS FSNPS2, PRESERVES T3
FSNPS::
FSNPS2::MOVE	T2,FSNBIT##	;%BIT FOR 1ST STR
	LSH	T2,-.FSMIN(T1)	;%POSITION IT FOR THIS STR

	POPJ	P,		;%AND RETURN


;SUBROUTINE TO RETURN SEARCH LIST FOR SPECIAL DEVICES
;CALL WITH T2=INDEX INTO SDVTBL
;RETURNS T3=BYTE POINTER TO LIST
;PRESERVES T1,T2
SDSRC:	HRRZ	T3,SDVTBL##(T2)	;BIT FOR WHICH S.L.
	CAIN	T3,PT.SSL##	;SYS?
	MOVE	T3,SYSSRC##	;YES
	CAIN	T3,PT.ASL##	;ALL?
	MOVE	T3,ALLSRC##	;YES
	TLNN	T3,-1		;VALID BYTE POINTER?
	SETZ	T3,		;NO, RETURN ZERO
	POPJ	P,
;SUBROUTINE TO REMOVE AN ACCESS TABLE FROM THE SYSTEM
;ENTER WITH T1=LOC OF A.T.
;ENTER AT ATRMVX WITH CB, L(AT) IN T2
;REMCB (STRUUO) CALLS THIS WITH F=0 & THE CB RESOURCE
ATRMOV::MOVE	T2,T1		;LOC OF A.T. INTO T2
	PUSHJ	P,GETCBX	;GET CB RESOURCE
ATRMVX::SKIPE	T1,ACCDOR##(T2)	;%IS A.T. DORMANT?
	PUSHJ	P,UNLINK	;%YES. UNLINK FROM DORMANT RING
	MOVE	T1,T2		;%RESTORE A.T. LOC TO T1
	PUSHJ	P,ATNLNK	;%UNLINK A.T. FROM NMB RING
	PJUMPE	F,ATSFR0	;%IF CALLED BY REMCB (STRUUO)
	HRRZ	T2,DEVACC##(F)	;%A.T. FOR THIS DDB
	CAIN	T2,(T1)		;%DID WE JUST REMOVE IT?
	HLLZS	DEVACC##(F)	;%YES - CLEAR DEVACC
	CBDBUG	(Y,Y);
	PJRST	ATSFR0		;%PUT INTO FREE CORE LIST AND RETURN

;SUBROUTINE TO REMOVE AN ITEM FROM THE DORMANT ACCESS TABLE RING
;ENTER WITH T1=ACCDOR ENTRY TO BE UNLINKED, T2=LOC OF A.T.
;RETURNS T2 = LOC OF A.T.
UNLINK::HRRZ	T3,T1		;%PREDECESSOR IN DORMANT LIST
	CAIN	T3,SYSDOR##	;%=SYSDOR?
	SUBI	T3,ACCDOR##	;%YES. DONT STORE IN SYSDOR+ACCDOR
	HLLM	T1,ACCDOR##(T3)	;%RESET FORWARD LINK IN PREDECESSOR
	MOVSS	T1		;%NEXT ENTRY IN LIST
	TRNE	T1,-1		;%IS THERE ONE?
	HLRM	T1,ACCDOR##(T1)	;%RESET BACKWARD LINK IN NEXT A.T. ENTRY
	SETZM	ACCDOR##(T2)	;%INDICATE NOT DORMANT NOW
	CBDBUG	(Y,Y);
	POPJ	P,		;%AND RETURN
;SUBROUTINE TO PUT AN A.T. ON THE DORMANT LIST
;ENTER WITH T1=LOC OF ACCESS TABLE
;MAY ENTER WITH CB, F=0
ATSDRA::CBDBUG	(Y,N)
	HLRZ	T2,SYSDOR##	;%FORMER 1ST J IN DORMANT LIST
	HRLM	T1,SYSDOR##	;%THIS A.T. IS NOW 1ST
	SKIPE	T2		;%IS THERE A DORMANT A.T. ALREADY?
	HRRM	T1,ACCDOR##(T2)	;%YES,SAVE AS PRED. TO FORMER 1ST A.T.
	HRLI	T2,SYSDOR##	;%PRED TO THIS A.T. IS SYSDOR
	MOVSM	T2,ACCDOR##(T1)	;%THIS A.T. POINTS TO SYSDOR AND NEXT A.T.
	CBDBUG	(Y,Y);
	JRST	GVCBJX		;%GIVE UP CB AND RETURN
;SUBROUTINE TO PUT AN A.T. ON THE FREE CORE LIST
;ENTER WITH T1=LOC OF A.T.
;CAN GET HERE WITH F=0&CB RESOURCE (SEE ATRMOV)
ATSFR0::SKIPE	ACCDOR##(T1)	;%ALREADY DORMANT?
	STOPCD	.,JOB,BAD,	;++BLOCK ALREADY DORMANT
	PUSHJ	P,GVCOR		;%RETURN THE CORE BLOCK

	PJRST	GVCBJX		;%GIVE UP CB AND RETURN



;SUBROUTINE TO UNLINK AN ACCESS TABLE FROM AN NMB RING
;ENTER WITH T1=LOCATION OF THE ACCESS TABLE
;EXIT T1=LOC OF A.T., T2=LOC OF PREDECESSOR, T3=LOC OF NEXT IN RING
ATNLNK::SKIPE	ACCDOR##(T1)	;%A.T. DORMANT?
	STOPCD	.+1,DEBUG,AAD,	;++A.T. ALREADY DORMANT
	HRRZ	T2,T1		;NO, LOC OF A.T.
	MOVE	T4,CORNUM##	;GET A LIMIT FOR RING TRIES
ATNLN1:	HLR	T2,ACCNMB##(T2)	;NEXT A.T.
	HLRZ	T3,ACCNMB##(T2)	;GET ITS LINK
	CAIN	T3,(T1)		;IS ITS LINK THIS A.T.?
	JRST	ATNLN2		;YES
	SOJGE	T4,ATNLN1	;TRY ANOTHER RING
	STOPCD	.+1,DEBUG,ARM	;ACCESS RINGS ALL MESSED UP
ATNLN2:	HLRZ	T3,ACCNMB##(T1)	;YES.LINK AROUND THIS A.T.
	HRLM	T3,ACCNMB##(T2)	;% (THIS LINK INTO PREDECESSOR)
	CBDBUG	(Y,Y);
	POPJ	P,		;%AND RETURN


;SUBROUTINE TO RETURN A CORE BLOCK TO THE FREE CHAIN
;CALL WITH T1=LOC OF BLOCK
GVCOR:	MOVE	T2,SYSCOR##	;%OLD 1ST BLOCK
	HRLM	T1,SYSCOR##	;%THIS IS 1ST ON CHAIN NOW
	HLLM	T2,CORLNK##(T1)	;%LINK IT TO FORMER FIRST
	POPJ	P,		;%AND RETURN
;SUBROUTINE TO SEARCH A LIST FOR AN STR BYTE
;ENTER WITH CB RES & T1=BYTE(FSN), T2 = WHERE TO LOOK
;IF T2 MAY BE 0 ON ENTRY, SET T3 = LOC OF PREDECESSOR
;EXITS WITH SAME VALUES AS LSTSRC (NEXT PAGE)

BYTSRC:	PUSHJ	P,BYTSCA	;%SEARCH FOR MATCHING STR BYTE
	  JRST	CPOPJ1##		;%FOUND
	PJRST	LSTSR2		;%NO MATCH-CREATE ONE

;SUBROUTINE TO SEARCH FOR AN STR BYTE
;RETURNS CPOPJ IF FOUND WITH T1 UNCHANGED, T2=LOC OF BLOCK
;CPOPJ1 IF NOT FOUND WITH T3=PREDECESSOR, T2=LOC OF NMB(IF A.T.), OR 0
;ENTER WITH, AND ALWAYS RETURNS WITH CB RESOURCE
BYTSC0:	LDB	T4,COYFSN##	;%FSN OF BLOCK
	CAIN	T1,(T4)		;%MATCH?

	POPJ	P,		;%YES. NON-SKIP RETURN

;HERE TO START SEARCH AT NEXT ITEM IN LIST
BYTSC1::MOVE	T3,T2		;%NO. SAVE PREDECESSOR
	HLRZ	T2,CORLNK##(T2)	;%STEP TO NEXT BLOCK
BYTSCA::BYTSCN::
	TRNN	T2,DIFNAL##	;%END? (SINCE FREE-CORE ADRS. ARE ALWAYS
				; 0 MODULO 4, THE ONLY TIME THIS BIT COULD
				; BE ON IS IN A LINK FROM AN A.T. TO ITS NMB)
	JUMPN	T2,BYTSC0	;%NO. TEST IT
	JRST	CPOPJ1##	;%END  - NOT-FOUND RETURN
;SUBROUTINE TO SCAN A LIST
;ENTER, EXIT WITH SAME ARGUMENTS AS LSTSRC  EXCEPT:
;DONT CREATE A NEW BLOCK IF THE BLOCK WANTED WAS NOT FOUND
LSTSCN::SETO	T3,		;%INDICATE DONT CREATE NEW BLOCK


;SUBROUTINE TO SEARCH A LIST
;ENTER WITH CB RES & NAME IN T1, WHERE TO LOOK IN T2
;IF T2 MAY BE 0 ON ENTRY, SET T3= LOC OF PREDECESSOR
;IF LH(T3)=-1, DONT CREATE A NEW BLOCK IF NOT FOUND
;IF LH(T3)=0, CREATE A NEW BLOCK
;RETURNS LOC OF BLOCK IN T2, PREDECESSOR IN T3
;RETURNS CPOPJ IF JUST CREATED A BLOCK OR NO FREE CORE.
; (T2=0 IF NO FREE CORE)
;RETURNS CPOPJ1 IF FOUND
;ALWAYS RETURNS WITH CB RESOURCE
LSTSRC::JUMPE	T2,LSTSR3	;%NO MATCH IF T2=0
LSTSR0:	CAMN	T1,CORNAM##(T2)	;%MATCH?
	JRST	CPOPJ1##	;%YES. SKIP-RETURN

;HERE TO START SEARCH AT NEXT J IN LIST
LSTSR1:	HRR	T3,T2		;%SAVE PREDECESSOR
	HLRZ	T2,CORLNK##(T2)	;%STEP TO NEXT BLOCK
LSTSRA::TRNN	T2,DIFNAL##	;%END? (SINCE FREE-CORE ADRS. ARE ALWAYS
				; 0 MODULO 4, THE ONLY TIME THIS BIT COULD
				; BE ON IS IN A LINK FROM AN A.T. TO ITS NMB)
	JUMPN	T2,LSTSR0	;%NO. TEST THIS BLOCK IF IT EXISTS
LSTSR3:	JUMPL	T3,CPOPJ##	;%EXIT IF DONT WANT NEW BLOCK CREATED

;HERE WHEN DESIRED ITEM IS NOT ON LIST, CREATE NEW BLOCK
LSTSR2:	PUSHJ	P,GTCOR		;%GET FREE SPACE
	JUMPLE	T2,CPOPJ##	;%NO FREE CORE
	MOVE	T4,CORLNK##(T3)	;%LINK WORD OF PREDECESSOR
	HRLM	T2,CORLNK##(T3)	;%PREDECESSOR TO THIS BLOCK
	HLLM	T4,CORLNK##(T2)	;%LINK THIS BLOCK TO NEXT
	MOVEM	T1,CORNAM##(T2)	;%SAVE NAME IN BLOCK
	POPJ	P,		;%NON-SKIP RETURN
;SUBROUTINE TO GET THE CB RESOURCE
;ALL ACS PRESERVED
GETCBX::JUMPE	F,CPOPJ##	;ALREADY HAVE CB OF F=0
GETCB::	SKIPE	DINITF##	;IF IN ONCE-ONLY,
	POPJ	P,		; RETURN IMMEDIATELY
	PUSH	P,J		;SAVE AN AC
	MOVE	J,.CPJOB##	;LOAD THIS JOB
	CAMN	J,CBUSER##	;DOES HE HAVE CB?
	STOPCD	JPOPJ##,DEBUG,AOC,	;++ ALREADY OWN CB
	POP	P,J		;NO, RESTORE AC AND
	PJRST	CBWAIT##	;CALL THE SCHEDULER


;SUBROUTINE TO GIVE UP CB RESOURCE AND RETURN
;ALL ACS RESPECTED
GVCBJ1::AOSA	(P)		;%SET FOR SKIP RETURN
GVCBJX::JUMPE	F,CPOPJ##	;DON'T RETURN CB IF F=0
GVCBJ::	SKIPE	DINITF##	;%IF IN ONCE-ONLY.
	POPJ	P,		;%RETURN IMMEDIATELY
	CBDBUG	(Y,N)
	PUSH	P,J		;SAVE AN AC
	MOVE	J,.CPJOB##	;LOAD THIS JOB
	CAME	J,CBUSER##	;MAKE SURE WE HAVE CB ALREADY
	 STOPCD	JPOPJ##,DEBUG,DOC, ;++ DON'T OWN CB
	POP	P,J		;OK, RESTORE THE AC
	PJRST	CBFREE##	;%OTHERWISE CALL THE SCHEDULER
;SUBROUTINE TO GET 4 WORDS OF FREE CORE
;IT IS ASSUMED THAT T3 POINTS TO AN UNAVAILABLE CORE BLOCK (IT MAY NOT)
;RETURNS LOCATION IN T1.  T2=0 IF NO FREE CORE
;RETURNS WITH THE CORE BLOCK ZEROED
;JOB MUST HAVE CB RESOURCE WHEN ROUTINE IS CALLED
;T1 AND T3 RESPECTED
FSTIME==1		;FIRST TIME THROUGH NMB LIST
FOUNDN==2		;FOUND AT LEAST 1 NMB THE 1ST TIME THROUGH
GTCOR:	CBDBUG	(Y,Y);
	HLRZ	T2,SYSCOR##	;%1ST FREE BLOCK ON LIST
	JUMPN	T2,GTCOR2	;%THER IS FREE CORE IF NON-0
	PUSH	P,T1		;%NO FREE CORE - SAVE T1
	PUSH	P,T3		;%SAVE T3

;HERE TO GRAB A DORMANT CORE BLOCK AND PUT IT ON THE FREE CORE LIST
;THE CORE BLOCK POINTED TO BY T3 WILL NOT BE TAKEN
	HLRZ	T2,SYSDOR##	;%1ST A.T. ON DORMANT LIST
	SETZ	T4,		;%T3 WILL CONTAIN THE LAST A.T. FOUND
CORGR0:	JUMPE	T2,CORGR1	;%SCANNED ALL A.T.'S IF 0
IFN FTFDAE,<
	MOVE	T1,ACCCNT##(T2)	;%READ-COUNT COULD BE UP
	TRNN	T1,ACMUCT##	;% WHILE JOB WAITING FOR
				;% FILDAE TO BLESS IT - IGNORE THE A.T.
>
	CAIN	T2,(T3)		;%IS THIS THE ONE WE CANT TAKE?
	JRST	CORG0D		;%YES, TRY ANOTHER
	MOVE	T1,T2		;%GET NMB FOR THIS A.T.
	PUSHJ	P,GTNM1##	;%
	MOVE	T3,NMBNAM##(T1)
	HRRZ	J,NMBEXT##(T1)	;%PRESERVE SWITCH.INI
	  CAMN	T3,[SIXBIT /SWITCH/]
	  CAIE	J,'INI'
	  CAIA
	JRST	CORG0C		;%CAUSE EVERYONE READS IT
	HLRZ	T3,NMBRNG##(T1)	;%IS IT AN SFD?
	JUMPE	T3,CORG0B	;%NO
	JUMPN	T4,CORG0C	;%YES, DONT USE IT IF FOUND ANY AT'S
	SKIPN	NMBCNT##(T1)	;%IS SOMEBODY INSIDE FNDFIL?
	TRNN	T3,NMPUPT##	;%IS IT POINTING TO ANOTHER LIST?
	JRST	CORG0C		;%YES, CANT USE IT
	HLRZ	T1,NMBACC##(T1)	;%NO, LOOK AT ALL AT'S ON THE NMB
	MOVEI	T3,ACMUCT##	;%
CORG0A:	TDNE	T3,ACCUSE##(T1)	;%IS THE READ-COUNT UP?
	JRST	CORG0C		;%YES, CANT USE IT
	HLRZ	T1,ACCNMB##(T1)	;%NO, TRY NEXT AT
	TRNN	T1,DIFNAL##	;%
	JRST	CORG0A		;%
CORG0B:	SKIPA	T3,(P)		;%THIS AT IS USABLE
CORG0C:	SKIPA	T3,(P)		;%THIS AT ISN'T USABLE
	MOVE	T4,T2		;%NO, SAVE ITS LOC
CORG0D:	HLRZ	T2,ACCDOR##(T2)	;%STEP TO NEXT A.T. IN DORMANT LIST
	JRST	CORGR0		;%AND TEST IT
CORGR1:	SKIPN	T2,T4		;%FOUND ANY A.T.?
	JRST	CORGR4		;%NO - TAKE AN NMB
	MOVE	T1,ACCDOR##(T2)	;%YES. GET PRED, SUCCESSOR  ON DORMANT LIST
	PUSHJ	P,UNLINK	;%UNLINK THIS A.T. FROM DORMANT LIST
	MOVE	T1,T2		;%LOC OF A.T. INTO T2

;HERE WHEN A DORMANT A.T. IS FOUND.
	PUSHJ	P,ATNLNK	;%UNLINK THIS A.T. FROM RING
	HRLM	T1,SYSCOR##	;%SAVE THIS A.T. ON FREE CORE LIST
	SETZM	CORLNK##(T1)	;%INDICATE THIS IS THE END

	JRST	GTCOR1		;%AND CONTINUE

;HERE IF THERE ARE NO DORMANT ACCESS TABLE ENTRIES
CORGR4:	PUSH	P,P3		;%SAVE P3
	HRRZ	T1,SYSPPB##	;%WHERE TO START SCAN
	SKIPN	T1		;%IF 0 START AT 1ST PPB IN SYS
	HLRZ	T1,SYSPPB##	;%1ST PPB BLOCK
	MOVE	P3,T1		;%SAVE FOR END TEST
CORGR5:	HLRZ	T2,PPBNMB##(T1)	;%FIRST NMB FOR PPB
	JUMPE	T2,CORGR7	;%NONE IF 0
	HRLI	P3,DIFPNL##(T1)	;%LH(P3) WILL CONTAIN PREDECESSOR
CORGR6:	HLRZ	T4,NMBRNG##(T2)	;%POINTER TO SFD LIST
	JUMPE	T4,CORG6A	;%GO IF NOT AN SFD
	EXCH	T2,T4		;%SFD. DOES IT POINT TO ANOTHER LIST?
	TRZE	T2,NMPUPT##	;%
	JRST	CORG6A		;%NO, USE IT
	HRLI	P3,DIFNMC##(T4)	;%YES, GO DOWN THAT LIST
	JRST	CORGR6		;%
CORG6A:	SKIPN	NMBCNT##(T2)	;%ANY USERS OF THE NMB?
	CAIN	T2,(T3)		;%NO, IS IT THE ONE WE CANT TAKE?
	JRST	CORG6B		;%YES. TRY NEXT NMB
	MOVE	T4,NMBACC##(T2)
	TLNE	T4,DIFNAL##	;%NO. ARE THERE A.T.'S ON THE NMB?
	JRST	CORGR8		;%NO - AVAILABLE - USE IT
CORG6B:	HRLM	T2,P3		;%SAVE PREDECESSOR
	HLRZ	T2,NMBPPB##(T2)	;%AND STEP TO NEXT NMB IN PPB
	TRZE	T2,NMPUPT##	;POINTING TO ANOTHER LIST?
	JRST	CORG6B		;YES, SCAN IT
	JUMPN	T2,CORGR6	;%TEST IT IF NOT 0
;HERE WHEN THERE ARE NO DORMANT NAME BLOCKS IN THIS PPB
CORGR7:	TLON	T1,FSTIME	;%1ST TIME THROUGH?
	TLNN	T1,FOUNDN	;%YES. ANY NMB AT ALL FOUND?
	SKIPA			;%NO.
	JRST	CORGR5		;%YES. TAKE AN NMB WHICH POINTS TO A REAL FILE
	HLRZ	T1,PPBSYS##(T1)	;%STEP TO NEXT PPB IN SYSTEM
	SKIPN	T1		;%IF END OF PPBS
	HLRZ	T1,SYSPPB##	;% START AT THE FIRST AGAIN
	CAIE	T1,(P3)		;%BACK TO WHERE WE STARTED?
	JRST	CORGR5		;%NO. TEST THE NMB BLOCKS
	JRST	CORGR9		;%YES. NONE AVAILABLE

;HERE WITH T2 = LOC OF GRABBABLE NMB
CORGR8:	MOVE	T3,NMBNAM##(T2)	;%NAME.EXE
	HRRZ	T4,NMBEXT##(T2)
	CAMN	T3,[SIXBIT /SWITCH/]
	CAIE	T4,'INI'	;%SWITCH.INI?
	SKIPA	T4,ALLYES##	;%NO. DOES THE FILE EXIST?
	JRST	CORG8A		;%YES, DON'T DELETE NMB IF WE CAN HELP IT
	TDNE	T4,NMBYES##(T2)
CORG8A:	TLNE	T1,FSTIME	;%YES. 1ST TIME THROUGH?
	JRST	CORG8B		;%NO. USE IT
	TLO	T1,FOUNDN	;%YES. INDICATE AT LEAST 1 NMB FOUND
	MOVE	T3,-1(P)
	JRST	CORG6B		;AND LOOK FOR AN UNUSED NMB
CORG8B:	HLRZS	P3		;%LOC OF PREDECESSOR
	MOVE	T3,NMBPPB##(T2)	;%LINK WORD OF THIS BLOCK
	HLLM	T3,NMBPPB##(P3)	;%SAVE IN PREDECESSOR LINK
	HRLM	T2,SYSCOR##	;%SAVE THIS ADR. IN FREE CORE LIST
	SETZM	CORLNK##(T2)	;%MAKE SURE LINK=0
	HLRZ	T1,PPBSYS##(T1)	;%START AT NEXT PPB WHEN
	HRRM	T1,SYSPPB##	;% NEXT GRABBING NMB BLOCKS
CORGR9:	POP	P,P3		;%RESTORE P3

GTCOR1:	POP	P,T3		;%RESTORE T3
	POP	P,T1		;%AND T1
	SKIPN	T2,SYSCOR##	;%FOUND ANY FREE CORE?
	JRST	CPOPJ##		;%NO. RETURN
	HLRZ	T2,SYSCOR##	;%YES, FIRST FREE LOC

;HERE WITHH T2= LOC OF FIRST FREE CORE BLOCK
GTCOR2:	MOVE	T4,CORLNK##(T2)	;%THIS BLOCKS LINK
	HLLM	T4,SYSCOR##	;%LINK AROUND THIS BLOCK
	SETZM	(T2)
	MOVSI	T4,(T2)
	HRRI	T4,1(T2)	;%ZERO THE CORE BLOCK JUST OBTAINED
	BLT	T4,CRWDM1##(T2)
	CBDBUG	(Y,Y);
	MOVE	J,.CPJOB##
	POPJ	P,		;%AND RETURN
;SUBROUTINE TO SET INITIAL VALUES INTO DDB
;ENTER WITH RIB IN MONITOR BUFFER
;EXIT WITH PNTRS IN DDB, DEVREL,DEVBLK,DEVLFT,DEVRSU,DEVRLC,DEVUNI SET UP
;EXIT CPOPJ IF RIB RETR. DATA IS FOULED UP, CPOPJ1 IF OK
CPYFST::PUSHJ	P,SPTRW##	;SET AN AOBJN WORD FOR POINTERS
	MOVEI	T2,0		;DEVRLC WILL BE SET 0
	PUSHJ	P,PTRBL1##	;COPY 1ST POINTERS TO DDB
	MOVE	T2,DEVRB1##(F)	;1ST UNIT
	TRZ	T2,RIPNUB##	;ZERO THE BIT WHICH IS ALWAYS ON
	PUSHJ	P,NEWUNI##	;SET IN U, DEVUNI(F)
	  PJRST	RIBERR##	;INVALID UNIT!
	HRLM	U,DEVUNI##(F)	;SAVE UNIT OF RIB
	MOVE	T2,DEVRB2##(F)	;FIRST REAL RETRIVAL POINTER
	AOS	DEVRET##(F)	;POINT DEVRET TO DEVRB2
	PUSHJ	P,CNVPTR##	;CONVERT TO ADDRESS, COUNT
	  JFCL			;BAD UNIT CHANGE PNTR
	  PJRST	RIBERR##	;IT HAS TO BE A REAL POINTER!
	SUBI	T1,1		;SUBTRACT 1 FROM COUNT (FOR RIB)
	HRRM	T1,DEVLFT##(F)	;SAVE IN DDB
	AOS	DEVBLK##(F)	;BUMP BLOCK BY 1 (FOR RIB)
	MOVSI	T1,1		;AT 1ST RELATIVE BLOCK IN FILE
	MOVSM	T1,DEVREL##(F)	;SAVE RELATIVE BLOCK IN DDB
	SETZM	DEVFLR##(F)	;1ST BLOCK IN PTR WINDOW IS 0
	HRRM	U,DEVFUN##(F)	;UNIT OF RIB IS CORRESPONDING 1ST UNIT
	TLO	S,IOSFIR	;INDICATE HAVE TO COMPUTE CHECKSUM
	AOS	(P)		;SET FOR SKIP-RETURN
	ADDM	T1,DEVRSU##(F)	;FIX DEVRSU
	PJRST	STOIOS##	;AND RETURN
;SUBROUTINE TO SET EXTENDED RIB INITIAL VALUES INTO DDB
;ENTER WITH EXTENDED RIB IN MONITOR BUFFER
;EXIT WITH POINTERS IN DDB, DEVREL,DEVBLK,DEVLFT,DEVRSU,DEVRLC,DEVUNI SET UP
;EXIT CPOPJ IF THE RIB IS SCREWED UP, CPOPJ1 IF OK
CPYEXT::PUSHJ	P,SPTRW##		;SET UP AOBJN WORD FOR POINTERS
	MOVEI	T2,0		;DEVRLC WILL BE 0
	PUSHJ	P,PTRBL1##	;COPY FIRST POINTERS TO DDB
	MOVE	T2,DEVRB1##(F)	;GET FIRST RETRIEVAL POINTER IN DDB
	PUSHJ	P,CNVPTR##	;CONVERT TO ADDRESS,COUNT
	  JRST	RIBERR##	;BAD UNIT-CHANGE POINTER
	  SKIPA	T2,DEVRB2##(F)	;UNIT CHANGE POINTER, GET NEXT
	JRST	CPYEX1		;WAS A VALID RETRIEVAL POINTER
	AOS	DEVRET##(F)	;POINT TO NEXT POINTER
	MOVSI	T1,1		;BUMP DEVRSU TO COUNT
	ADDM	T1,DEVRSU##(F)	; THE UNIT-CHANGE PTR
	PUSHJ	P,CNVPTR##	;CONVERT THIS POINTER
	  JFCL
	  JRST	RIBERR##	;MUST BE A VALID PNTR, SO RIB IS FOULED UP
CPYEX1:	SUBI	T1,1		;SUBTRACT ONE FROM COUNT (FOR RIB)
	HRRM	T1,DEVLFT##(F)	;AND STORE IN DDB
	AOS	DEVBLK##(F)	;ACCOUNT FOR RIB IN BLOCK NUMBER
	MOVE	T2,.USMBF	;IOWD FOR MONITOR BUFFER
	MOVE	T1,RIBFLR##+1(T2) ;GET FIRST BLOCK NUMBER IN RIB
	MOVEM	T1,DEVFLR##(F)	;AND STORE IN DDB
	HRRM	U,DEVFUN##(F)	;SET FIRST UNIT WORD TO CURRENT UNIT
	TLO	S,IOSFIR	;INDICATE HAVE TO COMPUTE CHECKSUM
	JRST	CPOPJ1##


;SUBROUTINE TO SET UP DEVBLK,DEVREL, ETC. FROM ACCESS TABLE DATA
;ENTER WITH T3= LOC OF ACC
;EXIT WITH DDB STUFF SET UP
;EXIT CPOPJ1 IF OK, CPOPJ IF A.T. STUFF FOULED UP
AT2DDB::MOVE	T1,ACCUN1##(T3)	;UN1 WORD
	MOVE	T2,ACCPT1##(T3)	;1ST POINTER
	PUSHJ	P,SETFS0	;SET DEVBLK, ETC FROM 1ST POINTER
	  POPJ	P,		;A.T. BAD
	AOS	DEVBLK##(F)	;ADD 1 FOR RIB
	AOS	DEVREL##(F)	;SET DEVREL AT 1 (0 IS FOR RIB)
	PJRST	CPOPJ1##	;AND RETURN
;SUBROUTINE TO SCAN A DIRECTORY FOR A FILE NAME
;THE DIRECTORY IS SPECIFIED BY DEVUFB(F), THE FILE BY DEVNAM,DEVEXT
;EXIT CPOPJ IF FILE NOT FOUND
;EXIT CPOPJ1 IF FOUND WITH T1=CFP, T3=LOC OF DIRECTORY ENTRY
;DEVBLK HAS THE NUMBER OF THE DIRECTORY BLOCK, DEVSFU IS SET UP
UFDSRC::PUSHJ	P,DIRSET	;GET RETRIEVAL INFORMATION
	  JRST	UFDLP2		;DIRECTORY WAS DELETED - ERROR RETURN
	PUSHJ	P,SETFS0	;SET UP TO READ DIRECTORY
	  POPJ	P,		;CANT READ DIRECTORY - RETURN
	PUSHJ	P,GTMNBF##	;GET MONITOR BUFFER IF DON'T HAVE IT
	PUSHJ	P,UFORSS	;GET UFB OR SFD AT
	TRZE	T3,NMPSFU##
	SKIPA	T3,ACCWRT##(T3)
	LDB	T3,UFYWRT##	;GET CURRENT LENGTH
	PUSH	P,T3		;SAVE SAME

UFDLUP:	PUSHJ	P,DIRRED	;READ DIRECTORY BLOCK(S)
	  JRST	UFDLP1		;EOF - FILE DOESNT EXIST
	MOVE	T1,DEVFIL(F)	;FILE NAME
	HLRZ	T2,DEVEXT(F)	;FILE EXTENSION
	PUSHJ	P,DIRSCN	;SEARCH BLOCK FOR MATCH
	  JRST	UFDLUP		;NOT FOUND - READ NEXT DIRECTORY BLOCK
	JRST	T2POJ1##	;FOUND. TAKE SKIP RETURN

UFDLP1:	PUSHJ	P,UFORSS	;GET UFB OR SFD AT
	POP	P,T1		;GET INTIAL VALUE
	TRZE	T3,NMPSFU##
	SKIPA	T3,ACCWRT##(T3)
	LDB	T3,UFYWRT##	;GET CURRENT LENGTH
	CAMLE	T1,T3		;IF UFD IS SMALLER NOW
	JRST	UFDSRC		;SEARCH AGAIN
UFDLP2:	TLZ	S,IOSRIB	;RIB IS NOT IN MONITOR BUFFER
	PJRST	STOIOS##	;SAVE S AND RETURN
;SUBROUTINE TO GET L(UFB OR SFD A.T.)
;SAME ARGS, VALUES AS UFORSF; HALTS IF NO LOC, RETURNS CPOPJ NORMALLY
UFORSS::PUSHJ	P,UFORSF
BNTSTP::STOPCD CPOPJ##,DEBUG,BNT, ;++BLOCK NOT THERE
	POPJ	P,

;SUBROUTINE TO GET L(UFB OR SFD)
;RETURNS CPOPJ1, T4=LOC
;RESPECTS T1-T3
UORSS:	PUSHJ	P,SAVT##	;SAVE T ACS
	PUSHJ	P,UFORSS	;FIND LOC
	MOVEM	T2,-4(P)	;T4 IS RESTORED FROM HERE
	JRST	CPOPJ1##	;SKIP RETURN


;SUBROUTINE TO RETURN LOC OF UFB OR SFD AT
;EXIT CPOPJ IF NO UFB OR SFD A.T.
;EXIT CPOPJ1 NORMALLY, WITH T2=T3=LOC, NMPSFU ON IF AN SFD A.T.
UFORSF::HRRZ	T2,DEVUFB##(F)	;LOC OF UFB
	JUMPE	T2,CPOPJ##	;RETURN IS NO UFB
	HRRZ	T3,DEVSFD##(F)	;LOC OF SFD
	JUMPE	T3,UFORS1	;NONE - TALK ABOUT THE UFD
	LDB	T1,UFYFSN##	;FSN

	HLRZ	T2,NMBACC##(T3)	;POINT TO 1ST A.T. UNDER THE SFD
	PUSHJ	P,BYTSCA	;FIND THE RIGHT STR
	  TROA	T2,NMPSFU##	;FOUND - LIGHT SFU
	POPJ	P,		;NOT THERE, NON-SKIP RETURN
UFORS1:	MOVE	T3,T2		;PUT LOC OF UFB OR SFD IN T3
	PJRST	CPOPJ1##	;AND SKIP-RETURN


;SUBROUTINE TO GET FIRST RETRIEVAL POINTERS FOR A DIRECTORY
;ENTER WITH DEVUFB, DEVSFD SET UP
;EXIT CPOPJ IF NO POINTERS
;EXIT CPOPJ1 NORMALLY, T1=UN1 WORD  T2=PT1 WORD
DIRSET::PUSHJ	P,UFORSF	;GET LOC OF DIRECTORY CORE BLOCK
	  POPJ	P,		;NONE, NON-SKIP
	TRZN	T2,NMPSFU##	;IS IT AN SFD?
	JRST	DIRSE1		;NO
	MOVE	T1,ACCUN1##(T2)	;1ST UNIT
	MOVE	T2,ACCPT1##(T2)	;1ST POINTER
	PJRST	CPOPJ1##	;GOOD RETURN
DIRSE1:	MOVE	T1,UFBUN1##(T2)	;1ST UNIT
	SKIPN	T2,UFBPT1##(T2)	;1ST POINTER
	SOS	(P)		;OOPS, THE UFD WAS DELETED
	PJRST	CPOPJ1##	;RETURN
;SUBROUTINE TO SET DDB FOR READING 1ST DATA BLOCK
;FROM THE 1ST PTR SAVED IN CORE
;ENTER T1=UN1 WORD T2=1ST PTR T3=STRUCTURE DB LOC
;EXIT T2=DEVDMP=LOGICAL BLOCK NO OF RIB
; AND DEVRET,DEVRB1,DEVBLK,DEVREL,DEVLFT,DEVRLC,DEVRSU SET
;EXIT CPOPJ IF RIBB ERROR, CPOPJ1 IF OK
SETFS0::HRRZ	T3,UNISTR##(U)	;SET T3=LOC OF STR DATA BLOCK
SETFST:	PUSHJ	P,DDBZR##	;ZERO RETRIVAL POINTERS IN DDB
	MOVEI	T4,DEVRBN##(F)	;SET DEVRET TO DEVRBN IF MORE POINTERS EXIST
	TRNE	T1,COP1PT##	;MORE POINTERS?
	MOVEI	T4,DEVRB1##(F)	;NO, SET DEVRET TO DEVRB1
	HRRM	T4,DEVRET(F)	;SET DEVRET. IF DEVRET=DEVRBN, MORE POINTERS WILL
				;BE READ FROM RIB. IF =DEVRB1, EOF AFTER THIS
				; POINTER IS EXHAUSTED
	MOVEM	T2,DEVRB1##(F)	;SAVE POINTER IN DDB
	MOVSI	T4,MRIBLN##+1	;SET DEVRSU (WILL BE RESET WHEN PNTRS READ)
	HLLM	T4,DEVRSU##(F)
	MOVEI	T4,1		;SET CURRENT POINTER LOC AT 1
	DPB	T4,DEYRLC##
	SETZM	DEVFLR##(F)	;1ST BLOCK IN DDB PNTRS IS 0
	LDB	T2,UN1PTR##	;1ST UNIT NUMBER
	HLRZ	U,STRUNI##(T3)	;POINT U TO 1ST UNIT IN STR
	PUSHJ	P,NEWUN##	;SET U AND DEVUNI(F) TO CORRECT UNIT
	  PJRST	RIBERR##		;INVALID UNIT!
	HRLM	U,DEVUNI##(F)	;SAVE UNIT OF RIB
	HRRM	U,DEVFUN##(F)	;SAVE UNIT OF 1ST POINTER IN DDB
	LDB	T4,UNYBPC##	;NO OF BLOCKS PER CLUSTER
	MOVE	T2,DEVRB1##(F)	;1ST POINTER AGAIN
	SETZM	DEVRIB##(F)	;CLEAR DEVRIB FOR DPB'S
	LDB	T2,UNYLUN##	;GET CURRENT LOGICAL UNIT NUMBER
	DPB	T2,DEYRBU##	;STORE IN DEVRIB
	MOVE	T2,DEVRB1##(F)	;GET FIRST RETRIEVAL POINTER
	LDB	T1,STYCLP##(T3)	;EXTRACT CLUSTER ADDRESS
	DPB	T1,DEYRBA##	;STORE IN DEVRIB
	LDB	T1,STYCNP##(T3)	;GET COUNT FIELD
	IMUL	T1,T4		;CONVERT CLUSTERS TO BLOCKS
	SUBI	T1,1		;-1 FOR RIB
	HRRM	T1,DEVLFT##(F)	;NUMBER OF BLOCKS LEFT IN PNTR
	LDB	T2,STYCLP##(T3)	;CLUSTER ADDRESS
	IMUL	T2,T4		;LOC OF RIB
	MOVEM	T2,DEVBLK##(F)	;SAVE IN DDB
	MOVEM	T2,DEVDMP##(F)	;SAVE ADR. OF RIB IN DEVDMP
	SETZM	DEVREL##(F)	;HAVE READ NO BLOCKS OF FILE
	TLO	S,IOSFIR	;INDICATE HAVE TO CHECK CHKSUM
	AOS	(P)		;SET FOR SKIP-RETURN
	PJRST	STOIOS##	;SAVE S AND RETURN
;SUBROUTINE TO READ A DIRECTORY BLOCK
;***********SPECIAL KLUDGE - ENTER WITH DEVNAM(F)=0 TO WRITE***********
;ENTER WITH F=DDB LOC, RIB ADDRESS IN DEVDMP(F)
;EXIT CPOPJ IF EOF, CPOPJ1 IF DATA READ WITH T1=IOWD
;EXIT WITH DEVBLK=NUMBER OF THE BLOCK READ, OR 1 PAST LAST BLOCK IF EOF
DIRRED::PUSHJ	P,CHEKU##	;UNIT YANKED?
	  POPJ	P,		;YES, FILE NOT FOUND
	HRRZ	T1,DEVLFT##(F)	;NUMBER OF BLOCKS LEFT
	SOJGE	T1,RETRD5	;POINTER NOT EXHAUSTED IF COUNT .GT. 0
RETRD1:	MOVSI	T1,1		;THIS POINTER DONE. PNTRS LEFT?
	ADDB	T1,DEVRSU##(F)
	JUMPGE	T1,CPOPJ##	;NO. THROUGH
	AOS	T1,DEVRET##(F)	;YES. POINTERS IN DDB?
	CAIG	T1,DEVRBN##(F)
	JRST	RETRD3		;YES.
	JSP	T4,SAVUN##	;PUSH U,SET U=LH(DEVUNI)
	MOVE	T2,DEVDMP##(F)	;LOC OF RIB
	PUSHJ	P,UFDRED##	;READ THE RIB
	  JRST	TPOPJ##		;UFD RIB ERR - FILE NOT FOUND
	POP	P,U		;RESTORE UNIT
	PUSHJ	P,STORU##	;SAVE IN DDB
	TLO	S,IOSRIB	;RIB IS NOW IN MONITOR BUFFER
	PUSHJ	P,SPTRW##	;SET AN AOBJN WORD FOR POINTERS
	PUSHJ	P,PTRCPY##	;COPY CURRENT POINTERS FROM MON BUF TO DDB

;HERE WITH POINTERS IN DDB
RETRD3:	SKIPN	T2,@DEVRET##(F)	;GET NEXT POINTER
	POPJ	P,		;EOF
	PUSHJ	P,CNVPTR##	;CONVERT TO ADR, COUNT
	  POPJ	P,		;BAD UNIT:CHANGE PNTR
	  JRST	RETRD1		;CHANGE-UNIT. TRY AGAIN
	SOS	T1		;REAL POINTER-COUNT THIS BLOCK
	SOS	T2,DEVBLK##(F)	;BLOCK TO READ

RETRD5:	HRRM	T1,DEVLFT##(F)	;SAVE UPDATED COUNT OF BLOCKS LEFT IN POINTER
	PUSHJ	P,UFORSF	;GET L(UFB OR SFD A.T.)
	  JRST	[MOVEI T3,1	;IGNORE THIS IF NO UFB YET ESTABLISHED
		 JRST RETRD6]
	TRZE	T3,NMPSFU##	;IS IT AN SFD?
	SKIPA	T3,ACCWRT##(T3)	;YES, USE ACCWRT
	LDB	T3,UFYWRT##	;HIGHEST WRITTEN BLOCK IN DIRECTORY
	AOS	T4,DEVREL##(F)	;RELATIVE BLOCK WE ARE GOING TO READ
	SUBI	T3,-1(T4)	;TRYING TO READ PAST WHAT WAS WRITTEN?
	JUMPLE	T3,CPOPJ##	;YES IF NEGATIVE - RETURN AN EOF
RETRD6:	AOS	T2,DEVBLK##(F)	;NO, INCREMENT BLOCK TO READ
	PUSHJ	P,SAVE1##
	MOVE	T1,.USMBF	;GET IOWD
	TLZ	S,IOSRIB	;RIB IS NO LONGER IN MONITOR BUFFER
	SKIPN	DEVNAM(F)	;DEVNAM=0?
	PJRST	MONWRT##	;YES, WRITE THE DATA
	AOS	(P)		;NO, READ. SET FOR SKIP RETURN
;;;TEMPORARY
	PJRST	MONRED##	;ALWAY READ 1 BLOCK
REPEAT 0,<			;**TEMPORARY UNTIL I FIGURE OUT HOW BEST
				;  TO INTERFACE MULTI-BLOCK READS IN CACHE
	SKIPN	P1,.USLBF	;CAN WE USE AN EXTRA PAGE?
	PJRST	MONRED##	;NO, READ INTO MONITOR BUFFER
	HRRZ	T4,DEVLFT##(F)	;NUMBER OF BLOCKS LEFT IN POINTER
	ADDI	T4,1		;IT HAS ALREADY BEEN SOS'D
	CAMLE	T4,T3		;MORE THAN TO END OF CYL?
	MOVE	T4,T3		;YES, TAKE AMOUNT TO EOC
	CAILE	T4,4		;MORE THAN A PAGE?
	MOVEI	T4,4		;YES, TAKE A PAGE
	SKIPE	CORTAL##	;CORE IN CORE?
	CAIG	T4,1		; AND MORE THAN 1 BLOCK OF DATA?
	JUMPG	P1,MONRED##	;DON'T GET AN EXTRA PAGE IF WE DONT HAVE ONE
;HERE TO READ THE DIRECTORY INTO AN EXTRA PAGE
	PUSH	P,T4
	JUMPL	P1,RETRD7	;GO IF WE ALREADY HAVE AN EXTRA PAGE
	MOVEI	T2,4*BLKSIZ##	;GET A PAGE
	PUSHJ	P,GTFWDC##	; OF CACHED SPACE
	  MOVEI	T1,1		;CANT GET ONE, TOO BAD
	SOS	P1,T1		;SAVE LOC OF PAGE
	MOVE	T2,DEVBLK##(F)	;RESTORE BLOCK NUMBER
RETRD7:	POP	P,T1		;RESTORE NO OF BLOCKS TO DO
	JUMPE	P1,RETRD8	;GO IF COULDNT GET A FUNNY PAGE
	LSH	T1,^D18+BLKLSH##;CONVERT TO AN IOWD
	MOVNS	T1		;NO OF WORDS
	HRRI	T1,(P1)		;LOCATION
	MOVEM	T1,.USLBF	;SAVE IOWD FOR DIRSCN TO SEE
	MOVE	T3,.USMBF	;SAVE LOC OF MON BUF
	MOVEM	T3,.USSBF	; IN CASE MONRED DOESN'T RETURN
	SKIPA	P1,T1		;SAVE IOWD IN P1
RETRD8:	MOVE	T1,.USMBF	;READ INTO MON BUF
	PUSH	P,.USMBF	;SAVE POINTER TO MON BUF
	MOVEM	T1,.USMBF	;FAKE OUT MAPIO SO IT WILL RELOCATE IOWD
	PUSHJ	P,MONRED##	;READ DIRECTORY
	POP	P,.USMBF	;RESTORE PREVIOUS
	SETZM	.USSBF
	JUMPGE	P1,CPOPJ##	;GO IF INTO MON BUF
	LDB	T1,DEYNBB##	;INTO FUNNY PAGE - GET NO OF BLOCKS DONE
	SUBI	T1,1		;-1 (AOS'S ALREADY DONE)
	ADDM	T1,DEVREL##(F)	;UPDATE THE DDB LOCS
	ADDM	T1,DEVBLK##(F)
	MOVNS	T1
	ADDM	T1,DEVLFT##(F)
	POPJ	P,		;AND TAKE SKIP-RETURN
>;END REPEAT 0
;SUBROUTINE TO CONVERT CFP TO BLOCK NUMBER
;ENTER T1=CFP,  EXIT T2=BLOCK NUMBER, U AND DEVUNI SET UP
;EXIT CPOPJ IF THE CFP POINTS TO AN INVALID UNIT
CFP2BK::HRRZ	T4,UNISTR##(U)	;LOC OF STR DATA BLOCK
	JUMPE	T4,CPOPJ##	;EXIT PRESERVING U IF STR WAS YANKED
	HRRZ	T3,STRSCU##(T4)	;NO. OF SUPER CLUSTERS/UNIT
	IDIV	T1,T3		;CONVERT TO UNIT, SUPER CLUSTER NO.
	JUMPE	T2,CPOPJ##	;BLOCK 0 IS ILLEGAL
	EXCH	T1,T2		;UNIT INTO T2
	HLRZ	U,STRUNI##(T4)	;1ST UNIT IN STR
	PUSHJ	P,NEWUN##	;SET UP U, DEVUNI(F)
	  POPJ	P,		;INVALID UNIT RETURN
	HLRZ	T2,STRBSC##(T4)	;NO. OF BLOCKS/SUPER CLUSTER
	IMUL	T2,T1		;CONVERT SUPER CLUSTER TO BLOCK ADR
	JRST	CPOPJ1##	;TAKE GOOD RETURN


;SUBROUTINE TO COMPUTE A CFP
;CFP IS DERIVED FROM THE UNIT IN P3, AND THE POINTER IN ACCPT1
;CFP IS RETURNED IN T1
SETCFP::EXCH	U,P3		;UNIT OF RIB INTO U
	LDB	T1,UNYLUN##	;LOGICAL UNIT NUMBER OF RIB
	EXCH	U,P3		;RESTORE CURRENT U
	MOVE	T4,UNISTR##(U)	;LOC OF STR DB
	HRRZ	T2,STRSCU##(T4)	;NO OF SUP. CLUSTERS PER UNIT
	IMUL	T1,T2		;SUP CLUS NO FOR BLOCK 0 OF THIS UNIT
	PUSHJ	P,RIBAD##	;GET ADDRESS OF RIB
	HLRZ	T4,STRBSC##(T4)	;NO OF BLOCKS PER SUP CLUSTER
	IDIV	T2,T4		;SUP CLUS ADR RELATIVE TO BLOCK 0 OF UNIT
	SKIPE	T3		;CFP MUST START AT AN EVEN BLOCK
	STOPCD	.+1,DEBUG,CME,	;++CFP MODULO ERROR
	ADD	T1,T2		;COMPLETE SUP CLUS NUMBER
	POPJ	P,		;RETURN
;SUBROUTINE TO SCAN A DIRECTORY BLOCK
;ENTER WITH NAME IN T1, EXT IN RH(T2)
;EXIT CPOPJ IF NOT FOUND, CPOPJ1 IF FOUND, WITH CFP IN T1,T3=LOC OF DIR ENTRY
DIRSCN:	SKIPL	T3,.USLBF	;HAVE AN EXTRA PAGE FOR DIRECTORY?
	MOVE	T3,.USMBF	;IOWD FOR BLOCK
	AOS	T3		;POINT TO FIRST DATA WORD
DIRSC1:	CAME	T1,(T3)		;NAMES MATCH?
	JRST	DIRSC2		;NO. TRY NEXT
	HLRZ	T4,1(T3)	;YES. EXTENSIONS MATCH?
	CAIE	T4,(T2)
	JRST	DIRSC2		;NO. TRY NEXT
	HRRZ	T1,1(T3)	;YES, GET CFP
	JRST	CPOPJ1##	;GOOD RETURN

DIRSC2:
IFN FTDUFC,<
	SKIPE	(T3)		;IF DATA BLOCK NOT EMPTY
	TLO	T2,200000	; LIGHT A BIT IN T2
>
	ADD	T3,[XWD 2,2]	;STEP TO NEXT NAME
IFN FTDUFC,<
	TLNE	T3,BLKSIZ##-1
	JRST	DIRSC3
	TLZN	T2,200000
	TLO	T2,400000
DIRSC3:>
	JUMPL	T3,DIRSC1	;TRY FOR MATCH
IFN FTDUFC,<
	JUMPGE	T2,CPOPJ##	;IF EMPTY DATA BLOCK
	PUSHJ	P,UFORSF	;FIND UFB OR SFD AT
	  POPJ	P,		;NONE, TOO BAD
	TRZ	T2,NMPSFU##
	MOVSI	T3,UFPZRB##	;SET A BIT SO UFD COMPRESSER
	IORM	T3,UFBZRB##(T2)	; WILL BE CALLED ON NEXT OUTPUT CLOSE
>
	POPJ	P,		;THROUGH - NO MATCH
;SUBROUTINE TO DETERMINE WHAT STR TO ENTER A FILE ON.
;CALL WITH P1=SL.PTR.
;RETURNS CPOPJ IF NO ROOM, CPOPJ1 WITH T1=FSN IF A UFB WITH ROOM IS FOUND
;CHANGES P2

UFBSZ:	PUSHJ	P,SAVE4##	;%
	MOVE	T1,DEVNAM(F)	;%NAME USER INITED
	CAME	P1,SYSSRC##	;USE NCR BITS IF ERSATZ DEL
	PUSHJ	P,ALIASD	;%IS IT AN ALIAS FOR "DSK"?
	  SKIPA	T3,[FS.WLK!FS.NCR]	;%YES,DONT IGNORE NCR BITS
	MOVEI	T3,FS.WLK	;%NO, IGNORE NCR BITS
	PUSHJ	P,SLPRF		;%GET JOB OR SYS. SL.PTR.
	TLNE	F,SYSDEV	;%IF SYS.SL., HONOR WLK AND NCR
	MOVEI	T3,FS.WLK!FS.NCR;%
	PUSH	P,T3		;%GET READY FOR LOOP
	PUSH	P,P2		;%
	MOVE	P4,P1		;%

;HERE TO GET NEXT CALLER'S FSN.
;P4=CALLERS SL.PTR., (P)=JOB'S SL.PTR., -1(P)=BITS TO CK.

UFBSZ1:	MOVE	P2,P4		;%GET NEXT STR NUMBER FROM SL.
	PUSHJ	P,NXSTR		;%
	  JRST	UFBSZ6		;%END OF LIST
	MOVE	P4,P2
	MOVE	P2,(P)		;%IS IT ON JOB SEARCH LIST?
	PUSHJ	P,SLFNA		;%
	  JRST	UFBSZ7		;%NOT ON JOB SL.--DONT SWEAT THE BITS
	PUSHJ	P,SLGTB		;%YES, GET BITS FROM JOB SL.
	TDNE	T2,-1(P)	;%IS A BIT ON?
	JRST	UFBSZ1		;%YES, CANT USE THIS STR
				;%NO, THIS MUST BE THE ONE
UFBSZ7:				;%
	HRRZ	T2,DEVSFD##(F)	;LOC OF SFD NMB
	JUMPE	T2,UFBSZ5	;NONE
	HLRZ	T2,NMBACC##(T2)	;LOC OF 1ST A.T.
	PUSHJ	P,BYTSCA	;FIND RIGHT A.T.
	  SKIPA	T3,ACCSTS##(T2)	;FOUND THE A.T.
	JRST	UFBSZ2		;NONE THERE, TRY NEXT STR
	TRNE	T3,ACPDEL##+ACPNIU ;MARKED FOR DELETION?
	JRST	UFBSZ2		;YES, A.T. WASN'T REALLY FOUND
UFBSZ5:	TLZ	M,UUOUFD##	;FOUND THE AT, INDICATE SO
	MOVE	T3,TABSTR##(T1)	;%YES. LOC OF STR DATA BLOCK
	SKIPG	STRTAL##(T3)	;%ANY ROOM IN STR?
	JRST	UFBSZ2		;%NO. LOOK AT NEXT STR

	HLRZ	T2,PPBUFB##(P3)	;% LOC OF UFB LIST
	PUSHJ	P,BYTSCA	;%SEARCH FOR UFB BLOCK FOR THIS STR
	  SKIPN	UFBPT1##(T2)	;%UFD BEEN DELETED FROM THIS STR?
	JRST	UFBSZ2		;%YES, CHECK NEXT STR
	MOVE	T2,UFBTAL##(T2)
	SOJLE	T2,UFBSZ2	;%HAVE MORE THAN 1 BLOCK?
	MOVE	T2,TABSTR##(T1)	;LOC OF THE STR
	HLRZ	T2,STRUNI##(T2)	;1ST UNIT IN THE STR
	MOVE	T2,UNIDES##(T2)	;IS THE UNIT (STR) HARDWARE WRITE-LOCKED?
	TLNE	T2,UNPHWP##
	JRST	UFBSZ2		;YES, TRY NEXT STR
	JRST	UFBSZ9		;%TAKE GOOD RETURN

UFBSZ2:				;%
				;%
	JRST	UFBSZ1		;%TRY NEXT ONE

UFBSZ6:	MOVEI	T1,NRMERR	;NO-ROOM ERROR
	TLOE	M,UUOUFD##	;UNLESS NO SFD WAS FOUND
	MOVEI	T1,NCEERR	;NONE FOUND - NO-CREATE ON ENTER ERROR
	SOS	-2(P)		;%NON-SKIP RETURN
UFBSZ9:	POP	P,(P)		;%TIDY UP THE STACK
	PJRST	T2POJ1##	;%1 MORE POP AND SKIP-RETURN
;SUBROUTINE TO FIND THE UFB BLOCK FOR A FILE
;ENTER WITH T1=FSN
;EXIT CPOPJ1 WITH T2=DEVUFB= LOC OF UFB BLOCK, T1=FSN
;NON-SKIP RETURN IF UFB NOT FOUND
SETUFB:	HLRZ	T2,PPBUFB##(P3)	;%LOC OF 1ST UFB BLOCK
	PUSHJ	P,BYTSCA	;%SCAN FOR RIGHT UFB
	  AOSA	(P)		;%FOUND
	SETZ	T2,		;%NOT FOUND, ZERO DEVUFB
	HRRM	T2,DEVUFB##(F)	;%SAVE LOC OF UFB
	POPJ	P,		;%AND RETURN


;SUBROUTINE TO CREATE (BUT NOT LINK) ACCESS TABLE
;RETURNS T2=ACC  T3=ACC, THE 2 HALVES LINKED
;ASSUMES JOB HAS CB RESOURCE BEFORE ENTRY
;EXIT CPOPJ IF NOT ENOUGH TABLE SPACE, CPOPJ1 NORMALLY
;CREAC IS SAME, BUT PRESERVES T1
CREAC:
CREACC::PUSHJ	P,GTCOR		;%GET CORE FOR 1ST PART
	JUMPLE	T2,GVCBJ
	MOVE	T3,T2

	HRRM	P3,ACCPPB##(T3)	;%
	PJRST	CPOPJ1##	;%AND RETURN
;SUBROUTINE TO CHECK ACCESS PRIVILEGES
;ENTER WITH T1=DESIRED FUNCTION, LH(T1)=-1 IF HAVE MON BUF BUT CAN GIVE IT UP
;EXIT CPOPJ IF PRIVS DON'T ALLOW OPERATION
;EXIT CPOPJ1 IF OK, T1=FUNCTION
CHKPRV::
IFN FTFDAE,<
	MOVEI	T2,M.XFFA##	;EXCLUDE FULL FILE ACCESS PROGRAMS FROM FILE
	JUMPE	T2,CHKPV0	; DAEMON CALLS MONGEN SYMBOL; JUMP IF NOT SET BY MONGEN
	PUSHJ	P,PRVJB		;SET, A FULL FILE ACCESS PROGRAM OR USER?
	  CAIA			;NO
	JRST	CPOPJ1##	;YES, ALLOW ALL PRIVILEGES
>
CHKPV0:	PUSHJ	P,SAVE2##	;SAVE P1-P2
	HLLZ	P2,T1		;SAVE FLAG WHICH SAYS CAN GIVE UP MON BUF
	HRRZS	T1		;TYPE OF ACCESS REQUESTED
	PUSH	P,T1		;SAVE IT
	SETZ	P1,		;SIGNAL FIRST CALL TO CHKPR
	PUSHJ	P,CHKPR		;ACCESS ALLOWED?
	  CAIA			;NO, NEEDS FUTHER CHECKING
	JRST	TPOPJ1##	;YES, ACCESS ALLOWED RETURN
IFN FTFDAE,<
	PUSHJ	P,CHKFD		;IS THE FILE DAEMON RUNNING?
	  JRST	CHKPV6		;NO, DO DEFAULT THINGS
	MOVE	T1,(P)		;FUNCTION BEING ATTEMPTED
	CAIN	T1,FNCCRE##	;CREATE?
	TLZ	P1,200000	;CREATING AN SFD IS LIKE CREATING A FILE
	HRRI	P1,.FDCAD	;SET TO INDICATE DIRECTORY ACCESS FAILURE
	TLNE	P1,600000	;READING THE DIRECTORY AS A FILE?
	JRST	CHKPV2		;YES, JUST SEND DIRECTORY FILE SPEC TO THE F.D.
	TLNE	P1,100000	;WAS THE FAILURE BECAUSE OF DIRECTORY PROTECTION?
	JRST	CHKPV1		;YES, SEND FILE SPEC TO THE FILE DAEMON
	MOVE	T4,DEVACC##(F)	;PROTECTED AGAINST THE ACCESSOR
	LDB	T1,ACYPRV##	;GET PROTECTION FROM A.T.
	TRNN	T1,400		;PROTECTED 4 IN OWNER FIELD?
	JRST	CHKPV6		;NO, DO USUAL THINGS
CHKPV1:	HRRI	P1,.FDCAC	;ASSUME ORDINARY FILE ACCESS
	LDB	T2,PJOBN##	;JOB NUMBER OF THE ACCESSOR
	MOVEI	T3,JS.RUU+JS.ASA ;BIT WHICH SAYS RUN UUO IS IN PROGRESS
	TDNE	T3,JBTSTS##(T2)	;DOING A RUN UUO OR COMMAND?
	HRRI	P1,.FDCPA	;YES, TELL THE FILE DAEMON THAT INSTEAD
CHKPV2:	MOVE	T1,DEVACC##(F)	;ADDRESS OF THE ACCESS TABLE
	MOVEI	T2,ACPCNT##	;READ COUNT BIT
	ADDM	T2,ACCCNT##(T1)	;BUMP THE READ COUNT SO THE A.T. DOESN'T GO AWAY
	PUSHJ	P,SAVSTS##	;SAVE STATE OF JOBS RESOURCES
	MOVE	T1,P1
	HRL	T1,-1(P)	;TYPE OF ACCESS
	MOVSI	P1,DEPFCU##	;INDICATE AT COUNT IS HIGH
	IORM	P1,DEVFCU##(F)
	PUSHJ	P,SNDFMG	;SEND THE FILE SPEC TO THE FILE DAEMON
	  JRST	CHKPV5		;NOT RUNNING
	ANDCAM	P1,DEVFCU##(F)	;NO LONGER HAVE COUNT UP
	MOVE	P1,T2		;SAVE THE ANSWER RETURNED BY THE FILE DAEMON
	HRRZS	T2		;GET HIGHEST ACCESS ALLOWED
	MOVSI	T1,DEPFDA##	;ASSUME FILE DAEMON WANTS CONTROL ON CLOSE
	TLNE	P1,(FD.COC)	;DOES IT?
	IORM	T1,DEVFDA##(F)	;YES, REMEMBER UNTIL CLOSE TIME
	POP	P,T3		;RESTORE SAVED RESOURCES RECORD
	PUSHJ	P,CKRES		;RESTORE ANY RESOURCE JOB HAD
	MOVEI	T1,JS.RUU	;RUN UUO OR COMMAND BIT
	LDB	T3,PJOBN##	;JOB NUMBER OF THE ACCESSOR
	TDNN	T1,JBTSTS##(T3)	;RUN UUO OR COMMAND IN PROGRESS?
	JRST	CHKPV3		;NO
	MOVSI	T1,(JS.CFX)	;YES, FILE DEAMON WANTS CONTROL ON EXIT BIT
	TLNE	P1,(FD.COX)	;DOES IT
	IORM	T1,JBTST2##(T3)	;YES, REMEMBER TO CALL IT AT EXIT TIME
CHKPV3:	POP	P,T1		;RESTORE ACCESS REQUESTED
	CAIN	T1,FNCCRE##	;CREATE?
	TLNN	P1,(FD.SCP)	;YES, FILE DAEMON SPECIFY PROTECTION?
	JRST	CHKP3A		;NO
	HLRZ	P2,P1		;YES, GET PROTECTION BITS
	PUSH	P,J		;SAVE J
	LDB	J,PJOBN##	;JOB NUMBER
	PUSHJ	P,FNDPDS##	;FIND THE PDB
	POP	P,J		;RESTORE J
	DPB	P2,PDYFSP##	;STORE PROTECTION FOR FILUUO
	MOVSI	P2,(PD.FSP)	;INDICATE FILE DAEMON
	IORM	P2,.PDDFL##(W)	; SUPPLIED THE PROTECTION
CHKP3A:	CAMG	T1,T2		;ACCESS REQUESTED GREATER THAN ACCESS ALLOWED?
	JRST	CHKPV4		;NO, ALL IS WELL
	MOVSI	T4,(JS.FXO)	;MAYBE EXECUTE ONLY?
	PUSHJ	P,CKXCT		;CHECK THAT
	  SOSA	(P)		;NOT EXECUTE ONLY, DENY ACCESS
	IORM	T4,JBTST2##(T1)	;EXECUTE ONLY, MARK THAT
CHKPV4:	TLNE	P1,(FD.CAA)	;DOES THE FILE DAEMON WANT TO BE CALLED ON EACH ACCESS?
	MOVEI	T2,0		;YES
	DPB	T2,DEYFNC##	;STORE HIGHEST ACCESS ALLOWED OR 0
	JRST	CPOPJ1##	;AND RETURN
CHKPV5:	POP	P,T3		;RESTORE RECORD OF RESOURCES
	PUSHJ	P,CKRES		;RESTORE RECOURCES JOB HAD
	ANDCAM	P1,DEVFCU##(F)	;NO LONGER HAVE COUNT UP
>;END IFN FTFDAE
CHKPV6:	LDB	T1,PJOBN##	;ACCESSOR'S JOB NUMBER
	PJRST	PRVJB0		;ONLY ALLOW ACCESS IF PRIVILEGED
;SUBROUTINE TO DO ACTUAL PRIVILEGE CHECKING
; RETURNS CPOPJ1 IF NO FURTHER CHECKING IS REQUIRED, CPOPJ IF MORE
; IS NEEDED, P1 NON-ZERO IF THE FILE BEING ACCESSED IS A DIRECTORY
; T1 = DESIRED FUNCTION, T2 = HIGHEST ACCESS ALLOWED

CHKPR:	LDB	T2,DEYFNC##	;GET MOST POWERFUL OPERATION ALLOWED
	CAIE	T1,FNCCPR##	;IF NOT TRYING TO CHANGE PROTECTION
	JUMPN	T2,CHKPR5	;CHECK IT IF STORED
	LDB	T2,PJOBN##	;GET JOB NUMBER
	SKIPN	T3,DEVUPP##(F)	;USE "IN YOUR BEHALF" PPN IF SPECIFIED
	MOVE	T3,JBTPPN##(T2)	;GET PRJ,PRG WORD
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	HRRZ	T2,ACCPPB##(T2)	;LOC OF PPB
	HLRZ	T4,DEVEXT(F)	;EXTENSION
	CAIE	T4,(SIXBIT .UFD.);UFD?
	JRST	CHKPR1		;NO
	MOVE	T2,DEVFIL(F)	;YES, COMPARE PRJ-PRG WITH UFD NAME
	TLO	P1,400000	;SET P1 NEGATIVE
	TLOA	M,UUODIR##	;AND LIGHT A BIT
CHKPR1:	MOVE	T2,PPBNAM##(T2)	;MASK FILE'S PRJ,PRG AGAINST USER'S
	CAIN	T4,(SIXBIT .SFD.);IS FILE AN SFD?
	TLO	P1,200000	;YES, SET P1 .GT. 0
	PUSHJ	P,GETAC		;T3=BYTE POINTER TO ACCESS CODE IN RH T2
	  PUSHJ	P,UORSS		;NEEDS MORE CHECKING, LOC OF UFB
	JRST	CPOPJ1##	;OK RETURN, OWNER CHANGING PROTECTION
IFN FTFDAE,<
	TLO	P1,100000	;IF PROTECTION FAILURE ITS BECAUSE OF DIRECTORY
				; PROTECTION
>
	TRZE	T4,NMPSFU##	;FILE IN AN SFD?
	JRST	[LDB T2,ACYPRV##	;YES, GET PRIVS FROM A.T.
		 JRST .+2]
	LDB	T2,UFYPRV##	;GET UFD PRIVS FOR OWNER+PROJ+UNIV
	LDB	T2,T3		;GET PRIV BYTE FOR OWNER OR PROJ OR UNIV
	JUMPGE	P1,CHKPR2	;GO IF NOT A UFD
	CAILE	T1,FNCRED##	;UFD, HIGHEST FUNC ALLOWED IS READ
	PJRST	PRVJB		;ERROR IF NOT PRIVILIGED
	JRST	CHKPR3		;GO CHECK ACTUAL UFD PROTECTION
CHKPR2:	CAIE	T1,FNCCRE##	;CREATE?
	JRST	CHKPR3		;NO
	TRNN	T2,UFRXCR##	;YES. CREATE IN UFD ALLOWED?
	POPJ	P,		;ERROR IF NOT PRIVILIGED
	PJRST	CPOPJ1##	;YES, OK
CHKPR3:	TRNN	T2,UFRXLK##	;DATA FILE - LOOKUP ALLOWED?
	JRST	PRERCK		;ONLY IF PRGRAM NAME = FILE NAME
IFN FTFDAE,<
	TLZ	P1,100000	;FAILURE AFTER THIS IS BECAUSE OF FILE PROTECTION
>
	HRRZ	T4,DEVACC##(F)	;LOC OF A.T.
	LDB	T2,ACYPRV##	;ACCESS PRIVS(T4) FOR OWNER+PROJ+UNIV
	PUSHJ	P,GTPRV		;GET PRIVS FOR OWNER, PROJ, OR UNIVERSE
				; (CONVERTED FROM PROTECTION TO PRIVS)
	JUMPE	P1,CHKPR4	;GO IF NOT A UFD
	TRNE	T2,UFRXRD##	;YES. CAN THIS USER READ THIS UFD?
				;(TRC OF PROT WAS DONE IN GTPRV)
	POPJ	P,		;USER CANT READ UFD - ERROR IF NOT PRIVILIGED
	SKIPL	P1		;SFD?
	TRCA	T2,7		;YES, RECOMPLEMENT PROTECTION
	MOVEI	T2,FNCRED##	;YES, SET HIGHEST FUNCTION ALLOWED=READ
CHKPR4:	CAIG	T2,FNCRED##	;CONVERT PRIVS BYTE TO MOST POWERFUL FUNCTION
	JRST	PRSTOR		;BYTE=FNC IF LESS THAN FNCRED
	LSH	T2,1		;2*BYTE-1  OR 2*BYTE OTHERWISE
	CAIGE	T2,FNCCPR##+1
	CAIG	T2,FNCTRN##+1
	SOS	T2
PRSTOR:	DPB	T2,DEYFNC##	;SAVE MOST POWERFUL FUNCTION ALLOWED
CHKPR5:	LDB	T3,PJOBN##	;YES. GET JOB NUMBER
	CAMG	T1,T2		;TRYING A MORE POWERFUL FUNCTION?
	JRST	CPOPJ1##	;NO. LEGAL
;CKXCT PRESERVES T4
CKXCT:
CHKXCT:	EXCH	T1,T3		;JOB NUMBER IN T1, PROTECTION IN T3
;	PJRST	XOCHK		;FOR CALL TO XOCHK
;SUBROUTINE TO SEE IF THE MONITOR IS READING AN
; EXECUTE ONLY FILE AND MAKE THE PROGRAM XO IF SO
;CALLING SEQUENCE:
;	MOVE	T1,JOB NUMBER
;	MOVE	T2,HIGHEST ACCESS ALLOWED
;	MOVE	T3,TYPE OF ACCESS BEING ATTEMPTED
;	PUSHJ	P,XOCHK
;RETURNS CPOPJ1 IF XO PROGRAM, CPOPJ IF NOT
;PRESERVES T2,T4

XOCHK:	CAIN	T2,FNCEXC##	;FILE EXECUTE ONLY?
	CAILE	T3,FNCRED##	;YES, TRYING TO READ?
	POPJ	P,		;ERROR IF NOT PRIVILIGED
	MOVEI	T3,JS.RUU+JS.ASA
	TDNN	T3,JBTSTS##(T1)	;YES, RUN COMMAND OR UUO?
	POPJ	P,		;ERROR IF NOT PRIVILIGED
	MOVEI	T3,JS.XOR	;YES, INDICATE JOB IS XCT ONLY
	IORM	T3,JBTSTS##(T1)
	PJRST	CPOPJ1##	;AND TAKE GOOD RETURN

;HERE IF PRIVS DO NOT ALLOW FUNCTION (NORMALLY)
;ALLOW THIS FUNCTION IF A PROPRIETARY JOB (JOB NAME=FILE NAME)
PRERCK:
REPEAT	0,<		;THIS CODE NEEDS MORE CHECKING THAN EXISTS HERE
	LDB	T2,PJOBN##	;JOB NUMBER
	MOVE	T2,JBTNAM##(T2)	;PROGRAM NAME
	CAMN	T2,DEVFIL(F)	;SAME AS FILE NAME?
	AOS	(P)		;YES. LEGAL
>
	POPJ	P,		;ERROR IF NOT PRIVILIGED

IFN FTFDAE,<
;PRESERVES T2
CKRES:	PUSHJ	P,RESTS##	;RESTORE RESOURCES
	MOVNI	T1,ACPCNT##	;REDUCE READ COUNT
	MOVE	T3,DEVACC##(F)
	ADDM	T1,ACCCNT##(T3)
	POPJ	P,
>
IFN FTFDAE,<
;SUBROUTINE TO SEND A FILE SPECIFICATION TO THE FILE DAEMON
; CALLING SEQUENCE:
;	MOVE	T1,CODE
;	MOVE	F,ADDRESS OF THE DDB
;	PUSHJ	P,SNDFMG
;RETURNS CPOPJ ON ERROR, CPOPJ1 IF SUCCESSFUL
SNDFMG::PUSH	P,T1		;SAVE CODE
	MOVEI	T2,1+4+MAXLVL##	;SPACE FOR CODE, STR, NAME, EXT, PPN, & SFDS
	PUSHJ	P,GTFWDC##	;GET FROM FUNNY SPACE
	  JRST	TPOPJ##		;COULDN'T
	POP	P,(T1)		;CODE
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVE	P1,T1		;COPY PACKET ADDRESS
	HRRZ	T1,DEVACC##(F)	;IF NO A.T.
	JUMPE	T1,SNDFM5	; LOSE
	PUSHJ	P,GETNMB##
	MOVSI	T3,1(P1)	;CLEAR THE PACKET
	HRRI	T3,2(P1)
	SETZM	1(P1)
	BLT	T3,1+4+MAXLVL##-1(P1)
	LDB	T3,ACYFSN##	;GET FSN
	JUMPE	T3,[MOVE T2,DEVUFB##(F)
		    LDB T3,UFYFSN##
		    HRRZ T2,DEVACC##(F)
		    JRST .+1]
	MOVE	T3,TABSTR##(T3)	;STR DB ADDR
	MOVE	T3,STRNAM##(T3)
	MOVEM	T3,1(P1)	;STR
	SKIPGE	DEVRAD##(F)
	SKIPA	T4,DEVFIL(F)
	MOVE	T4,NMBNAM##(T1)
	MOVEM	T4,2(P1)	;NAME
	SKIPGE	DEVRAD##(F)
	SKIPA	T4,DEVEXT(F)
	HRLZ	T4,NMBEXT##(T1)
	HLLZM	T4,3(P1)	;EXT
	MOVE	T4,ACCPPB##(T2)
	MOVE	T4,PPBNAM##(T4)
	MOVEM	T4,4(P1)	;PPN
	PUSH	P,[0]		;MARK START OF SFD LIST
	MOVE	T4,DEVSFD##(F)
	TRNN	T4,-1
	JUMPN	T4,SNDFM3
	TRNE	T4,-1
	SKIPL	DEVRAD##(F)
	JRST	SNDFM1
	HRRZ	T1,T4
	JRST	SNDFM2
;STILL IN FTFDAE CONDITIONAL

SNDFM1:	HLRZ	T1,NMBPPB##(T1)	;GET NEXT SFD NMB
	TRZN	T1,NMPUPT##	;SEE IF NMB
	JUMPN	T1,SNDFM1	;IF NOT, LOOP FOR MORE
	JUMPE	T1,SNDFM3	;JUMP IF AT END
SNDFM2:	PUSH	P,NMBNAM##(T1)	;SAVE SFD NAME
	JRST	SNDFM1		;LOOP
SNDFM3:	MOVEI	T2,5(P1)	;ADDRESS OF START OF SFD LIST IN PACKET
SNDFM4:	POP	P,T1		;GET SFD NAME OR ZERO
	CAIGE	T2,1+4+MAXLVL##(P1) ;STORED THE MAXIMUM?
	MOVEM	T1,(T2)		;NO, STORE SFD
	AOS	T2		;BUMP ADDRESS OF SFD LIST
	JUMPN	T1,SNDFM4	;GO IF MORE
	PUSH	P,J		;SAVE J
	MOVE	J,.CPJOB##	;MAKE SURE IT'S SET UP
	PUSHJ	P,FNDPDS##	;GET THE PDB POINTER FOR SEQUENCE # IN SENDFD
	SKIPN	T4,DEVUPP##(F)
	MOVE	T4,JBTPPN##(J)
	POP	P,J		;RESTORE J
	MOVE	T1,P1		;GET PACKET ADDRESS IN T1
	PUSHJ	P,SENDFD	;SEND THE MESSAGE TO THE FILE DAEMON
	  POPJ	P,		;ERROR, NON-SKIP RETURN
	JRST	CPOPJ1##	;GOOD RETURN

SNDFM5:	MOVE	T2,P1		;PACKET ADDRESS
	MOVEI	T1,1+4+MAXLVL##	;SPACE FOR CODE, STR, NAME, EXT, & SFDS
	PJRST	GVFWDS##	;RETURN THE SPACE AND NON-SKIP RETURN
>;END IFN FTFDAE
IFN FTFDAE,<
;SUBROUTINE TO CALL THE FILE DAEMON TO DETERMINE WHETHER THE
; ACCESS THAT THE CURRENT JOB WANTS TO A FILE IS ALLOWED
;CALLING SEQUENCE:
;	SETUP FILMSG TO BE THE FULL PATH TO THE FILE IN QUESTION
;	MOVE	T1,ADDRESS OF MESSAGE
;	MOVE	T4,SENDER'S PPN
;	MOVE	W,PDB TO REMEMBER SEQUENCE # (SENDER) IN
;	PUSHJ	P,SENDFD
;RETURNS CPOPJ IF THE MESSAGE COULDN'T BE SENT
;RETURNS CPOPJ1 WITH THE HIGHEST FUNCTION ALLOWED IN T2
;PRESERVES J

SENDFD::PUSHJ	P,CHKFD		;FILE DAEMON RUNNING?
	  JRST	SENDFX		;NO, ERROR RETURN, BUT GIVE BACK CORE
	PUSH	P,J		;SAVE J
	HRRZ	T2,%CNIPS##	;USE THE SYSTEM IPCF MESSAGE COUNTER
	HRRM	T2,3(T1)	;STORE IT INTO THE "EXT" WORD OF THE MSG
	HRLM	T2,.PDQSN##(W)	; ...AND STORE IT TO CHECK LATER
	MOVSI	T2,1+4+MAXLVL##	;LENGTH OF PACKET
	HRR	T2,T1		;COPY ADDRESS
	MOVE	T1,[40,,%SIFDA##] ;SYSTEM SENDER'S CODE,,RECEIVER'S PID
	MOVE	T3,PIDTAB##+1	;PID OF SYSTEM GOPHER
	ADDI	T3,1
	PUSHJ	P,SENDSP##	;SEND THE MESSAGE TO THE FILE DAEMON
	  JRST	JPOPJ##		;ERROR
	HLRZ	T2,.PDEPA##(W)	;ADDRESS OF THE PACKET RETURNED
	PUSH	P,.IPCFD##+1(T2);GET THE ANSWER
	LDB	T1,PKLNT2##	;LENGTH OF THE PACKET DATA
	ADDI	T1,.IPCFD##	;PLUS OVERHEAD
	PUSHJ	P,GIVWDS##	;RETURN THE PACKET TO FREE CORE
	POP	P,T2		;RESTORE THE ANSWER
	JRST	JPOPJ1##	;RESTORE J AND GIVE GOOD RETURN

SENDFX:	MOVE	T2,T1		;PACKET ADDRESS
	MOVEI	T1,1+4+MAXLVL##	;SPACE FOR CODE, STR, NAME, EXT, & SFDS
	PJRST	GVFWDS##	;RETURN THE SPACE AND NON-SKIP RETURN
;STILL IN FTFDAE CONDITIONAL

;SUBROUTINE TO CHECK IF TRYING TO CALL THE FILE DAEMON
; IN BEHALF OF THE FILE DAEMON AND TO VERIFY THAT THE FILE DAEMON IS
; RUNNING.  RETURNS CPOPJ IF TRYING TO CALL THE FILE DAEMON IN ITS BEHALF
; OR IF THE FILE DAEMON ISN'T RUNNING.  CPOPJ1 OTHERWISE
;PRESERVES T1,T2, AND T4

CHKFD::	PUSH	P,T1		;SAVE CALLERS
	SKIPE	T1,FDAJOB##	;FILE DAEMON RUNNING
	CAMN	T1,.CPJOB##	;YES, IS THIS HIM
	PJRST	TPOPJ##		;DON'T CALL THE FILE DAEMON
	PUSH	P,T2		;SAVE CALLERS
	MOVE	T2,[SIXBIT/FILDAE/] ;JOB FILDAE?
	CAMN	T2,JBTNAM##(T1)	;
	SKIPL	JBTSTS##(T1)	;YES, RUNNING?
	PJRST	TTPOPJ		;NO
	PJRST	TTPPJ1		;GO
>
;SUBROUTINE TO DETERMINE IF A JOB IS PRIVILEGED
;ENTER AT PRVJB FOR JOB # IN DDB, ENTER PRVJO FOR JOB # IN AC J(= J)
;RETURNS CPOPJ IF NOT, CPOPJ1 IF PRIVILEGED (PRJ,PRG=1,2 OR JACCT ON)
;RESPECTS T1-T3
PRVJO::	PUSH	P,T1		;SAVE T1
	MOVE	T1,J		;JOB NUMBDR
	JRST	PRVJB1
PRVJB::	PUSH	P,T1		;SAVE T1
	LDB	T1,PJOBN##	;JOB NUMBER
PRVJB0:	MOVSI	T4,DEPFFA	;DID THIS GUY ASK FOR
	TDNE	T4,DEVJOB(F)	;PRIVS IN FILOP. UUO
	JRST	TPOPJ##		;NO--DO NOT LOOK
	SKIPE	T4,DEVUPP##(F)	;USE "IN YOUR BEHALF" PPN IF SPECIFIED
	TDZA	T1,T1		;DONT TEST JACCT IF IN YOUR BEHALF
PRVJB1:	MOVE	T4,JBTPPN##(T1)	;PRJ,PRG OF JOB
	CAMN	T4,FFAPPN##	;IS IT FULL-FILE-ACCESS PPN?
	JRST	TPOPJ1##	;YES. ALWAYS LEGAL
	MOVE	T4,JBTSTS##(T1)	;STATUS WORD
	TLNE	T4,JACCT	;JACCT=1?
	PJRST	TPOPJ1##	;YES. OK RETURN
	PJRST	TPOPJ##		;NO, ERROR RETURN
;SUBROUTINE TO CHECK ACCESS PRIVS FOR THE UUO
;CALL:	MOVEI AC,LOC
;	CALLI AC,ACCCHK,
;LOC:	XWD ACTION,PROTECTION
;LOC+1:	XWD OWNER PRJ-PRG
;LOC+2:	XWD REQUESTOR PRJ-PRG
;RETURN CPOPJ1, AC=0 IF OK; AC=-1 IF ACCESS NOT ALLOWED
ACCCHK::PUSHJ	P,SAVE2##	;SAVE P1-P2
	AOS	(P)
	HRR	M,T1		;LOC OF ARGUMENTS
	PUSHJ	P,GETWDU##	;GET ACTION,PROT
	MOVE	P1,T1		;SAVE IN P1
	PUSHJ	P,GETWD1##	;GET OWNER PPN
	MOVE	P2,T1		;SAVE
	PUSHJ	P,GETWD1##	;GET REQUESTOR PPN
	CAMN	T1,FFAPPN##	;REQUESTOR=GOD?
	JRST	RTZER##		;YES, OK
	MOVE	T2,P2		;NO, OWNER JBTPPN
	MOVE	T3,T1		;REQUESTOR JBTPPN
	HLRZ	T1,P1		;ACTION
IFN FTFDAE,<
	PUSHJ	P,PRVJO		;PRIVILEGED JOB?
	  CAIA			;NO
	SKIPN	[M.XFFA##]	;YES, SKIP IF PRIVILEGED JOBS DON'T CALL THE FILE DAEMON
	PUSHJ	P,CHKFD		;SEE IF FILE DAEMON IS RUNNING
	  JRST	ACCCH0		;FILE DAEMON ISN'T RUNNING
	CAIGE	T1,7		;IF A UFD,
	TRNE	P1,400		; OR A FILE FOR WHICH THE FILE DAEMON WILL BE CALLED,
	JRST	RTZER##		; SAY ITS OK SINCE THE FILE DAEMON WILL CHECK ACCESS
ACCCH0:>
	HRRZ	T4,P1		;PROTECTION
	CAIL	T1,7		;DATA OPERATION?
	JRST	ACCCH1		;NO - UFD
	TRCN	T1,7		;REVERSE USER'S FUNCTION TO AGREE WITH FILSER'S
	MOVEI	T1,FNCCPR##	;0=CHANGE PROT - SET TO EXACTLY THAT FUNCTION
	PUSHJ	P,GETAC0
	  CAIA
	JRST	RTZER##
	CAIN	T1,FNCCPR##	;CHANGE PROTECTION?
	MOVEI	T1,7		;YES, CHANGE IT BACK TO 7
	CAMLE	T1,T2
	JRST	RTM1##
	JRST	RTZER##
;HERE IF FILE IS A UFD
;FOR A UFD, PROT IS IN BITS 18-26
ACCCH1:	PUSHJ	P,GETAC0	;GET RIGHT BYTE POINTER
	  JFCL
	HRRZ	T2,P1		;GET PROTECTION
	LSH	T2,-11
	TRO	T2,UFRXRD##*100	;OWNER MAY ALWAYS READ
	LDB	T2,T3		;GET RIGHT BYTE
	MOVEI	T3,UFRXCR##	;SET T2 FOR RIGHT TEST
	CAIE	T1,7		;TESTING IF CREATE IS LEGAL?
	MOVEI	T3,UFRXRD##	;NO - TEST IF READING UFD LEGAL
	TDNE	T2,T3		;IS IT OK?
	JRST	RTZER##		;YES, T1=0
	JRST	RTM1##		;NO, T1=-1

;SUBROUTINE TO CHECK ACCESS CODE FOR FILE OR HIGH SEGMENT
;CALLED FROM SEGCON FOR ACCESS TO SHARABLE HIGH SEGMENTS
;CALL:	MOVE	J,JOB NO.
;	MOVEI	T1,PROTECTION CODE (PR.EXC = 6, PR.WRT = 2)
;	MOVE	T2, FILE PROJ,PROG
;	MOVE	T3,PROJ-PROG OF READER
;	MOVE	T4,9 BIT PROTECTION FOR FILE
;	PUSHJ	P,CHKACC
;	  CANNOT PERFORM FUNCTION
;	OK TO PERFORM FUNCTION
;ENTER AT CHKAC0 IF PRIVILEGED JOBS DONT AUTOMATICALLY WIN

CHKACC::PUSH	P,T4		;SAVE PROTECTION
	PUSHJ	P,PRVJO		;PRIVILEGED (J ALREADY SET UP TO JOB #) JOB?
	  TRCA	T1,7		;NO, TEST MORE. CONVERT PROT TO PRIV
	PJRST	TPOPJ1##	;YES, TAKE GOOD RETURN
	POP	P,T4		;RESTORE PROTECTION
CHKAC0:	PUSHJ	P,GETAC0	;T2=HIGHEST ACCESS ALLOWED
	  CAMG	T1,T2		;COMPARE DESIRED PRIVILEGE WITH HIGHEST ALLOWED
	PJRST	CPOPJ1##	;OK, DESIRED IS LESS THAN OR EQ OR OWNER CHG PRV
	MOVE	T3,.CPJOB##	;LEGAL IF READING AN XC ONLY FILE
	PJRST	CHKXCT
;SUBROUTINE TO GET HIGHEST ACCESS FOR OWNER,PROJ,UNIVERSE ALLOWED
;SET UP BYTE POINTER FOR WHICH EVER OF THREE FIELDS
;CALL:	MOVE	T1,FUNCTION FNCXXX
;	MOVE	T2, FILE PROJ,PROG
;	MOVE	T3,PROJ-PROG OF REQUESTOR
;	MOVE	T4, 9 BIT ACCESS FOR FILE(NEEDED ONLY ON CALL FROM CHKACC)
;	PUSHJ	P,GETAC
;	  T3=BYTE POINTER TO PROPER FIELD IN AC T2, T1=FUNCTION FNCXXX
;	OK RETURN-OWNER CHANGING PROTECTION(ALWAYS LEGAL)

GETAC:	JUMPE	F,GETAC0	;NO STR IF NO DDB
	PUSHJ	P,SAVE1##	;SAVE P1
	HRRZ	P1,DEVUNI##(F)	;ADDRESS OF THE UNIT DATA BLOCK
	JUMPE	P1,GETAC0	;NO STR IF NO UNIT
	HRRZ	P1,UNISTR##(P1)	;ADDRESS OF THE STR DATA BLOCK
	MOVE	P1,STRPPN##(P1)	;PPN OF THE OWNER OF THE STR
	TLC	P1,-1		;WILD CARD PROJECT NUMBER?
	TLCN	P1,-1
	HLL	P1,T3		;YES, THIS PROJECT MATCHES
	TRC	P1,-1		;WILD CARD PROGRAMMER NUMBER?
	TRCN	P1,-1
	HRR	P1,T3		;YES, THIS PROGRAMMER NUMBER MATCHS THAT
	CAMN	P1,T3		;IS REQUESTOR THE OWNER OF THE STR?
	JRST	GETAC3		;YES, ALLOW HIM OWNER ACCESS TO IT
GETAC0:	XOR	T3,T2		;COMPARISON OF TWO PPN'S
	TDNE	T3,[XWD INDPPN##,-1]	;APPEAR TO BE OWNER?
				;IF INDPPN=0 (USUAL) ONLY PROG FIELD
				;IF INDPPN=777777 THEN BOTH MUST MATCH PROJECT
				;AND PROGRAMMER MUST MATCH. INDPPN
				;MAYBE CHANGED FROM 0 WITH MONGEN
	JRST	GETAC1		;NOT OWNER.
	TLNN	T3,-1		;DOES PROJECT MATCH TOO?
	JRST	GETAC3		;YES. HE IS OWNER.
	TLNN	T2,777770	;NO. IS OWNER ONLY IF DATA IS NOT
				;IN A PROJECT UNDER TEN.
	JRST	GETAC1		;NOT OWNER. E.G., 100, 4 READING 1,4.
;HERE IF REQUESTOR IS OWNER
GETAC3:	MOVE	T3,[POINT 3,T2,29]	;POINT TO OWNER PRV BYTE
	CAILE	T1,FNCRED##	;YES, IS OWNER LOOKING UP OR READING?
	CAIN	T1,FNCCPR##	;NO, IS OWNER CHANGING PROTECTION?
	JRST	CPOPJ1##	;YES, GIVE OK RETURN
	JRST	GETAC2		;NO, GIVE NEED MORE CHECKING RETURN

GETAC1:	MOVE	T2,T3
	MOVE	T3,[POINT 3,T2,29]	;POINT TO OWNER PRIVS
	TLNE	T2,-1		;SAME PROJECT?
	IBP	T3		;NO, MOVE TO PROJ FIELD, THEN TO UNIVERSE FIELD
	IBP	T3		;YES, MOVE TO PROJ FIELD
GETAC2:	MOVE	T2,T4		;SETUP 9 BIT ACCESS (IN CASE THIS IS CHKACC CALL)
;	PJRST	GTPRV		;FALL INTO GTPRV
;SUBROUTINE TO GET OWNER, PROJ, OR UNIVERSE PROT. CODE, AND CONVERT TO PRIVILEGE CODE
;T3=PROPER BYTE TO T4, T4=9 BIT PROT CODE
;PRIV RETURNED IN T2, T1 RESPECTED
GTPRV:	LDB	T2,T3		;RETURN PROPER 3 BIT ACCESS CODE
IFN FTFDAE,<
	CAMN	T3,[POINT 3,T2,29]
	CAIG	T2,2		;OWNER, 3 OR GREATER MUST BE REMAPPED
	JRST	GTPRV1		;NOT THE OWNER
	TRZ	T2,4		;CLEAR THE CALL FILE DAEMON BIT
	LSH	T2,1		;4 MAPS TO 0, 5 MAPS TO 2
	TRNE	T2,4		;6 MAPS TO 5, 7 MAPS TO 7
	TRO	T2,1
>
GTPRV1:	TRC	T2,7		;CONVERT PROT TO PRIVS
	POPJ	P,
;SUBROUTINE TO DETERMINE IF SOFTWARE WRITE-LOCK IS ON FOR THIS JOB OR ALL JOBS
;IF EITHER, IOSWLK IS SET IN S
;ENTER WITH A.T. LOC IN DEVACC
STWLK:	PUSHJ	P,SAVE2##	;SAVE SOME ACS
	HRRZ	T2,DEVACC##(F)	;LOC OF A.T.
	LDB	T1,ACYFSN##	;FILE-STRUCTURE NUMBER
	PUSHJ	P,SLPRF		;GET JOB OR SYS SL
	JUMPE	T1,STWLK0	;DONT LOOK AT JOB SL. IF NOT YET SET UP
	PUSHJ	P,SLFNA		;FIND FSN IN IT
	  JRST	STWLK0		;NOT IN SL. SO BIT NOT ON
	PUSHJ	P,SLGTB		;GET BITS
	TRNE	T2,FS.WLK	;SOFTWARE WRITE LOCK?
	JRST	STWLK1		;YES

STWLK0:	MOVE	T2,UNIAWL##(U)	;NOT LOCKED - IS WHOLE UNIT LOCKED?
	MOVE	T1,UNIDES##(U)	;OR IS UNIT HARDWARE-WRITE-LOCKED?
	TLNN	T2,UNPAWL##
	TLNE	T1,UNPHWP##
STWLK1:	TLO	S,IOSWLK	;YES
	POPJ	P,		;AND RETURN

;SUBROUTINE TO ADJUST PPB AND NMB USE-COUNTS
;T1 RESPECTED
FNDLS:	PUSHJ	P,GETCB		;GET CB RESOURCE
FNDLC:	PUSHJ	P,DORZER	;%MAKE SFD ACC DORMANT
	SOS	PPBCNT##(P3)	;%1 LESS PPB USER
	SOSA	NMBCNT##(P4)	;%1 LESS NMB USER

;HERE ON GOOD RETURN FROM FNDFIL
FNDXIT:	AOS	(P)		;%SET FOR SKIP-RETURN
	SETZM	DEVRB1##(F)	;%MAKE SURE NO POINTERS IN DDB
	PJRST	GVCBJ		;%GIVE UP CB AND RETURN

;A LOOKUP OF AN SFD IS DONE IN TWO PASSES:
;THE FIRST PASS MERELY LOADS ALL THE ACC'S INTO CORE AND
;SETS THEM NON-DORMANT. IT'S THE SECOND PASS THAT ACTUALLY
;DOES THE LOOKUP. IF, FOR SOME REASON, THE SECOND PASS
;SHOULD FAIL, WE MUST GO BACK AND MAKE THE ACC'S DORMANT
;AGAIN. ELSE THE CORE GRABBER WILL NEVER RECYCLE THEM.
;ENTER WITH CB AND P4=NMB
;PRESERVES ALL AC'S
DORZER:	PUSH	P,T1		;%QUIT UNLESS SFD
	HLRZ	T1,NMBRNG##(P4)
	JUMPE	T1,TPOPJ##
	PUSH	P,T2
	PUSH	P,F		;%FLAG THAT WE HAVE CB
	SETZ	F,
	MOVEI	T1,DIFNAL##(P4)	;%PRESET PRED
DORZR1:	HLRZ	T1,ACCNMB##(T1)	;%STEP TO NEXT ACC
	JUMPE	T1,DORZR2
	TRNE	T1,DIFNAL##	;%BACK TO NMB?
	JRST	DORZR2		;%YES
	MOVE	T2,ACCCNT##(T1)	;%ZERO COUNT?
	ANDI	T2,ACMCNT+ACPCRE;%AND NOT CREATE?
	IOR	T2,ACCDOR##(T1)	;%AND NON-DORMANT?
	SKIPN	T2
	PUSHJ	P,ATSDRA	;%YES, MAKE DORMANT
	JRST	DORZR1		;%LOOP ONCE FOR EACH ACC
DORZR2:	POP	P,F		;%RESTORE F
	JRST	TTPOPJ##	;%RESTORE T2 AND T1
FILNRM:
FNDR1B:	PUSHJ	P,GVCBJ		;%
FNDER1:	SCHEDULE
	PUSHJ	P,ERMNBF
	MOVEI	T1,NETERR	;NO FREE CORE
	POPJ	P,
FNER1B:	SOS	PPBCNT##(P3)

FNER1A:	MOVEI	T1,NETERR
	PJRST	GVCBJ		;%

ERMNB0:	PUSHJ	P,GVCBJ
ERMNBF:	PJRST	FNDLS


FNER2Z:IFN	FTFDAE,<
	PUSHJ	P,TSTAMD	;%RETURN BLOCKS IF A.T. MARKED FOR DELETION
	  JRST	FNER47		;GO GET CB BACK
>
	HRRZ	T2,DEVACC##(F)
IFN FTFDAE,<
;WE NEVER GET HERE WITH THE COUNT UP FOR US.
;SO IF THE COUNT IS UP, THERE MUST BE SOMEBODY ELSE USING THE FILE.
	LDB	T1,ACZCNT##
	JUMPN	T1,FNER2X
>
	PUSHJ	P,ATRMVX
FNER47:	PUSHJ	P,GETCB

FNER2X:IFN	FTFDAE,<
	PUSHJ	P,TSTAMD	;%RETURN BLOCKS IF A.T. MARKED FOR DELETION
	  PUSHJ	P,GETCB		;GET CB BACK
>
	HLLZS	DEVACC##(F)
	PUSHJ	P,ERMNB0
	PUSHJ	P,TSTPPB##
FNER2W:	MOVEI	T1,PRTERR	;SUPERSEDE ILLEGAL
	POPJ	P,

FNDER3:	PUSHJ	P,ERMNBF
FNER3A:	MOVEI	T1,FNFERR	;FILE NOT FOUND
	POPJ	P,

FNER21:	PUSHJ	P,FNER2Z
	MOVEI	T1,FBMERR
	POPJ	P,

FNDER5:	PUSHJ	P,GVCBJ

FNDER6:	PUSHJ	P,ERMNBF
	MOVEI	T1,AEFERR	;RENAME TO AN EXISTING NAME
	POPJ	P,

FNDER7:	HLLZS	DEVACC##(F)	;NOT OURS
	MOVEI	T1,FBMERR	;TRYING TO ENTER, A FILE IS BEING CREATED
	JRST	FNDLC

FNDER8:	PUSHJ	P,FNDER3
	MOVE	P2,P1		;SEARCH LIST EMPTY?
	PUSHJ	P,SLGTA
	  SKIPA	T1,[SLEERR]	;YES
	MOVEI	T1,IPPERR	;NO, ILLEGAL PPN ERROR
	POPJ	P,

FNDR10:	MOVEI	T1,CSDERR	;SUPERSEDE ILLEGAL
	PJRST	FNDLC

FNER9A:	PUSH	P,T1		;SAVE ERROR CODE
	PUSHJ	P,FNDLC		;RETURN DUMMY A.T.
	HRRZ	T1,DEVACC##(F)	;REMOVE OUR A.T.
	PUSHJ	P,ATRMOV
	MOVE	T1,(P)		;GET ERROR CODE
	MOVE	J,.CPJOB##
	MOVE	T4,JBTSTS##(J)	;JOB STATUS
	TRNE	T4,JS.SFL	;IF HE HAS DSKFUL PAUSE
	CAIE	T1,NRMERR	;AND THE DISK IS FULL
	PJRST	TPOPJ##
	MOVEI	T4,.ERFUL	;SEE IF HE'S INTERCEPTING
	PUSHJ	P,SETINJ##
	  SKIPA		;NO
	PJRST	TPOPJ##		;YES, LET IT HAPPEN
	PUSHJ	P,DSKFUL##	;STOP THE JOB FOR HIM
	POP	P,(P)		;HE SAID CONTINUE,
	MOVE	T2,P1		;MAKE THINGS RIGHT AGAIN
	PJRST	FNDFLZ		;AND GO TRY TO FIND SOME ROOM
FNER20:	SKIPA	T1,[SIUERR]	;%RENAME SFD WHICH IS IN USE
FNER11:	MOVEI	T1,FBMERR	;%ENTER, RENAME IN PROGRESS
	PJRST	FNDLC		;%

FNER12:	MOVEI	T1,PRTERR
	JRST	FNER19
FNER13:	SKIPA	T1,FNER17
FNER18:	MOVEI	T1,NRMERR
FNER19:	PUSHJ	P,GVCBJ
	HRRM	P1,ACCPPB##(P2)	;RESTORE ACCPPB (IN CASE CHANGING DIRECTORIES)

	MOVE	P1,T1
	PUSHJ	P,TSTPPB##
	HRRZ	T1,P1
	PJRST	FNDLS		;%

FNER14:	MOVEI	T1,FBMERR	;%RENAME, FILE MARKED FOR DELETION
	PJRST	FNDLC		;%
FNER17:	MOVEI	T1,IPPERR	;% NO UFD
	PJRST	FNDLC

FNR16A:	PUSHJ	P,GVCBJ


FNER16:	PUSHJ	P,ERMNBF
	HLLZS	NMBCFP##(P4)	;CLEAR CFP, SO NEW ENTER WILL WIN IF UFD
				; WAS FIXED UP BY SUPER USETO-TYPE STUFF
	MOVEI	T1,TRNERR
	TLZ	S,IOSERR##
	PJRST	STRIOS##
FNDERB:	HLLZS	NMBCFP##(P4)	;DON'T LEAVE BAD CFP AROUND
	PUSHJ	P,SLGTX		;%GET FSN BACK
	JUMPG	M,STRLP9	;%IF AN ENTER, IT'S OK
	PUSHJ	P,ERMNB0	;%A.T. SAYS FILE BEING DELETED
	PJRST	FNER3A
FNDEND:	END