Google
 

Trailing-Edge - PDP-10 Archives - BB-T573C-DD_1986 - 10,7/ufdset.mac
There are 4 other files named ufdset.mac in the archive. Click here to see a list.
UNIVERSAL UFDPRM - Parameter file for UFDSET
SUBTTL	D. Mastrovito /DPM	16-AUG-85

;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1983,1984,1985,1986.
;ALL RIGHTS RESERVED. 
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


; Assembly instructions
;
;	.COMPILE UFDSET.MAC
;
; Produces UFDPRM.UNV and UFDSET.REL


; Version numbers
;
	UFDVER==1			;MAJOR VERSION
	UFDMIN==0			;MINOR VERSION
	UFDEDT==40			;EDIT LEVEL
	UFDWHO==0			;WHO DID IT
	%%UFDS==<BYTE(3)UFDWHO(9)UFDVER(6)UFDMIN(18)UFDEDT>
SUBTTL	Edit history


; RCOMP edit History
;
; 1	Initial subroutine to do recomputes for PLRDSK.
;
; 2	Add super mode input to read ribs to speed up things.
;
; 3	Routine FINISH wasn't calling the user supplied typeout subroutine.
;
; 4	Append STR:[PPN] to errors generated by ERRPRC.
;
; 5	Remove extra instruction in routine LOKUFD.
;
; 6	Add routines for search list manipulation and UFD creation.
;
;
; UFDSET edit history
;
;
; 7	Create UFDSET from the remains of RCOMP.
;
; 10	Remove edit 4, it was a bad idea. Enhance text generation code.
;
; 11	Fix bugs in single access code. Remove error code UFCSU% (Can't
;	set UFD interlock) and issue a warning instead. We can't wait for
;	the interlock since PULSAR shouldn't block. If a program really needs
;	this functionality, it should handle the interlock itself and lite
;	the UF.NLK bit.
;
; 12	Add functions .UFDASL and .UFRSL plus about a dozen lines of code
;	to handle system search list changes.
;
; 13	Fix obscrure PATH block pointer problem caused by 702.
;
; 14	Make sure the job and PPN match for MOUNT and DISMOUNT functions.
;
; 15	Fix off-by-one bug in S/L definition size that showed up only when
;	a user dismounted a disk when his S/L was full.
;
; 16	Release any open channels after processing errors at ERRPRC.
;
; 17	Close off UFD channel if create fails to find a UFD.
;
; 20	Don't try to use a released channel when creating UFDs.
;
; 21	Fix up quota checking for zero block logged out quotas.
;
; 22	Enhancementes required for use in LOGIN:
;	1) Clear RP.ERR in the UFD if no error bits found in file RIBs
;	   during recomputing pass.
;	2) Add functions .UFAJL and .UFRJL to only add and remove structures
;	   from a job search list. Needed for the SWITCH.INI handling.
;	3) Add functions .UFSUI and .UFCUI to set and clear the UFD interlock.
;	4) Set current date/time in the RIB and return it in .UFCDT
;	   and .UFCTM words.
;
; 23	Move 'File errors exist' message to the rename code, so if a recomp
;	is done and no errors exist, the message won't be generated.  Also
;	setup PATH block before attempting to a super I/O LOOKUP.  This will
;	allow the correct filespec typeout to occur if file errors exist.
;
; 24	Clear out LKPFIL @SETFIL to prevent junk dates, protections, etc.
;	from being set on ENTERs.
;
; 25	Some files don't get quota checked.  MOVX instead of a MOVE.
;
; 26	Fix bad test that allowed anyone to dismount a structure, even
;	if they were over quota.
;
; 27	RIBUSD can be zero for a non-empty UFD if the monitor hasn't
;	rewritten the RIB yet.  Don't blindly try to delete a UFD
;	without first doing a DISK. UUO to see if the monitor really
;	knows the number of blocks used.
;
; 30	Correct check of "own" job number and fix off by one bug in
;	GOBSTR loop when searching for other jobs in the recomp checking
;	code.  Give UFDSET a real version number too.
;
; 31	Function .UFRDU forgot to LOOKUP the UFD.
;
; 32	Files of the form nnnTEC.TMP print incorrectly.
;
; 33	Fix incorrect block number calculation when doing super I/O on a
;	unit whose cluster size does not divide evenly into the unit size.
;
; 34	Correct test for blocks in use before attempting to delete a UFD
;	on a dismount.
;
; 35	Only change RIBUSD when recomputing disk usage.
;
; 36	Avoid RENAME error 26 by renaming the UFD before defining the
;	search list which could set the structure status to NOWRITE.
;
; 37	A job can go over quota if we mount a structure which is already
;	in the job's search list because the previous value in RIBUSD
;	gets written back into the RIB instead of the actual number of
;	blocks in use.  Check UFBTAL.
;
; 40	Do Copyrights.
;
;End of edit history
SUBTTL	Calling sequence and program interface


; Call:	MOVE	T1,address of argument block
;	PUSHJ	P,.UFD##
;	<non-skip>
;	<skip>
;
; Non-skip:	An error has occured. The error code is stored
;		in the argument block.
;
; Skip:		The requested operations performed and argument
;		block updated where necessary.
;
; Argument block
;
	 RELOC	0
	 PHASE	0
.UFFLG:! BLOCK	1	;FLAG WORD
   UF.LGI==1B0		   ;ALWAYS SET LOGGED IN (TURN ON RIPLOG)
   UF.LGO==1B1		   ;ALWAYS SET LOGGED OUT (TURN OFF RIPLOG)
   UF.NLK==1B2		   ;DON'T INTERLOCK THE UFD (CALLER ALREADY DID)
   UF.ARD==1B3		   ;ALWAYS RECOMPUTE DISK USAGE
   UF.NRD==1B4		   ;NEVER RECOMPUTE DISK USAGE
   UF.PSL==1B5		   ;ADD TO PASSIVE SEARCH LIST
   UF.SIN==1B6		   ;MOUNT SINGLE ACCESS
   UF.NOQ==1B7		   ;DON'T DO QUOTA CHECKING
   UF.TSP==1B8		   ;TYPE STRUCTURE AND PPN IN QUOTA MESSAGE
   UF.NUE==1B9		   ;NO UFD EXISTS (RETURNED BY UFDSET)
   UF.WLD==1B10		   ;GENERATE A UNIQUE WILD PROGRAMMER NUMBER [10,#]
   UF.NDL==1B11		   ;RIPNDL IS TURNED ON FOR THIS UFD
   UF.AIS==1B12		   ;STRUCTURE IS ALREADY IN S/L (FOR LOGIN)
   UF.FNC==17B35	   ;FUNCTION CODE
      .UFMNT==1		      ;MOUNT
      .UFDMO==2		      ;DISMOUNT
      .UFRDU==3		      ;RECOMPUTE
      .UFASL==4		      ;ADD STR TO SSL
      .UFRSL==5		      ;REMOVE STR FROM SSL
      .UFAJL==6		      ;ADD STR TO JSL
      .UFRJL==7		      ;REMOVE STR FROM JSL
      .UFSUI==10	      ;SET UFD INTERLOCK
      .UFCUI==11	      ;CLEAR UFD INTERLOCK
      .UFMAX==.UFCUI	      ;MAXIMUM FUNCTION CODE
.UFSTR:! BLOCK	1	;SIXBIT STRUCTURE NAME
.UFPPN:! BLOCK	1	;PPN
.UFJOB:! BLOCK	1	;JOB NUMBER
.UFPRO:! BLOCK	1	;UFD PROTECTION TO SET (RIGHT JUSTIFIED)
.UFDED:! BLOCK	1	;DIRECTORY EXPIRATION DATE TO SET
.UFQTF:! BLOCK	1	;FCFS LOGGED-IN QUOTA
.UFQTO:! BLOCK	1	;LOGGED-OUT QUOTA
.UFQTR:! BLOCK	1	;RESERVED QUOTA
.UFSTS:! BLOCK	1	;FILE STRUCTURE STATUS BITS (FROM AUXACC)
.UFUSD:! BLOCK	1	;BLOCKS USED
.UFLOK:! BLOCK	1	;LH:= # SECS TO WAIT FOR INTERLOCK, RH:= # SECS FOR MSG
.UFCDT:! BLOCK	1	;UFD CREATION DATE IN 15 BIT FORMAT
.UFCTM:! BLOCK	1	;UFD CREATION TIME IN MINUTES SINCE MIDNIGHT
.UFERR:! BLOCK	1	;ERROR CODE RETURNED ON FAILURE
.UFTYO:! BLOCK	1	;ADDRESS OF TYPE OUT ROUTINE
.UFPFX:! BLOCK	1	;LH:= SEVERITY CHARACTER, RH:= SIXBIT PREFIX
.UFTXT:! BLOCK	1	;ADDRESS OF TEXT
.UFSIZ:!		;SIZE OF BLOCK
	 DEPHASE
	 RELOC	0
; Error codes
;
UFIDV%==1		;ILLEGAL DEVICE
UFISN%==2		;IMPROPER STRUCTURE NAME
UFIOE%==3		;DIRECTORY I/O ERROR
UFCAD%==4		;CAN'T ACCESS DIRECTORY TO RECOMPUTE DISK USAGE
UFLFU%==5		;LOOKUP FAILED FOR UFD DURING UPDATE
UFRFU%==6		;RENAME FAILED FOR UFD DURING UPDATE
UFCRS%==7		;CAN'T READ SEARCH LIST
UFIFC%==10		;ILLEGAL FUNCTION CODE
UFEFU%==11		;ENTER FAILED FOR UFD
UFCCS%==12		;CAN'T CHANGE SEARCH LIST
UFCSO%==13		;CAN'T RESET ORIGINAL S/L AFTER SINGLE ACCESS FAILED
UFCSS%==14		;CAN'T MOUNT STRUCTURE SINGLE ACCESS
UFSND%==15		;STRUCTURE NOT DISMOUNTED
UFUBT%==16		;UFD INTERLOCK IS BUTY FOR TOO LONG
UFUIC%==17		;UFD INTERLOCK CANNOT BE CLEARED
UFPGF%==20		;PROGRAMMER NUMBER GENERATION FAILED


	PRGEND
TITLE	UFDSET - Perform UFD and search list operations


	SALL				;FOR CLEAN LISTINGS
	.DIRECT	FLBLST			;FOR CLEANER LISTINGS

	SEARCH	JOBDAT			;TOPS-10 JOB DATA LOCATIONS
	SEARCH	MACTEN			;TOPS-10 MACROS
	SEARCH	UUOSYM			;TOPS-10 UUO SYMBOLS
	SEARCH	UFDPRM			;UFDSET SYMBOLS

	%%JOBD==%%JOBD			;PUT JOBDAT VERSION IN SYMBOL TABLE
	%%MACT==%%MACT			;PUT MACTEN VERSION IN SYMBOL TABLE
	%%UUOS==%%UUOS			;PUT UUOSYM VERSION IN SYMBOL TABLE
	%%UFDS==%%UFDS			;PUT UFDSET VERSION IN SYMBOL TABLE


.BCOPY
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1986.  ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
.ECOPY

	TWOSEG				;MAKE US SHARABLE
	RELOC	.JBHGH			;START LOADING HIGH SEGMENT HERE

	ENTRY	.UFD			;ENTRY POINT
SUBTTL	Definitions


; Accumulators
;
	T1=1				;4 TEMPORARY ACS
	T2=T1+1
	T3=T2+1
	T4=T3+1
	P1=5				;4 PERMINENT ACS
	P2=P1+1
	P3=P2+1
	P4=P3+1
	L=11				;DIRECTORY LEVEL
	BP=12				;BYTE POINTER
	AP=16				;ARGUMENT BLOCK POINTER
	P=17				;PDL

	.AP==T1				;USER AC THAT POINTS TO ARGUMENT BLOCK


; Assembly parameters
;
	SFDMAX==5			;MAXIMUM NUMBER OF SFDS
	DIRLVL==SFDMAX+1		;MAXIMUM NUMBER OF DIRECTORY LEVELS
	BLKSIZ==200			;SIZE OF A DISK BLOCK IN PAGES
	BUFSIZ==<^D132/5>+1		;TEXT BUFFER SIZE
	FOPSIZ==.FOMAX			;LENGTH OF FILOP BLOCK TO USE
	RIBSIZ==.RBMAX			;LENGTH OF RIB TO USE
	PTHSIZ==.PTMAX			;LENGTH OF PATH BLOCK TO USE
	DCHSIZ==.DCMAX			;DSKCHR BLOCK SIZE
	STRMAX==^D10+1			;MAXIMUM NUMBER OF STRS = 10 + FENCE
	SLSIZE==.FSDSO+<.DFJBL*STRMAX>+1 ;LENGTH OF A SEARCH LIST
	LOKTIM==2			;# SECS BETWEEN TRIES FOR UFD INTERLOCK


; Macro to make life easier
;
DEFINE	$ERR	(CODE),<
	PUSHJ	P,ERRPRC		;;CALL THE ERROR PROCESSOR
	CAI	UF'CODE'%		;;STORE ERROR CODE HERE
>
SUBTTL	Subroutine entry and exit


	RELOC	.JBHGH

.UFD::	MOVEM	0,USRACS+0		;SAVE AC 0
	MOVE	0,[1,,USRACS+1]		;SET UP BLT
	BLT	0,USRACS+17		;SAVE ACS 1 - 17
	MOVE	0,USRACS+0		;RELOAD AC 0
	MOVE	AP,.AP			;GET ADDRESS OF USER'S ARGUMENT BLOCK

	PUSHJ	P,INITIA		;INITIALIZE THE WORLD, GET FUNCT CODE
	PUSHJ	P,@FNCTAB-1(T1)		;DISPATCH

ERRXIT:	MOVE	0,[USRACS+1,,1]		;SET UP BLT
	BLT	0,17			;RESTORE ACS 1 - 17
	MOVE	0,USRACS+0		;RELOAD AC 0
	SKIPN	.UFERR(.AP)		;DID WE RETURN AN ERROR CODE?
CPOPJ1:	AOS	(P)			;NO - FORCE SKIP RETURN
CPOPJ:	POPJ	P,			;RETURN


FNCTAB:	EXP	$MOUNT			;(01) MOUNT A STRUCTURE
	EXP	$DISMOUNT		;(02) DISMOUNT A STRUCTURE
	EXP	$RECOMPUTE		;(03) RECOMPUTE DISK USAGE
	EXP	$ASSL			;(04) ADD STR TO SSL
	EXP	$RSSL			;(05) REMOVE STR FROM SSL
	EXP	$AJSL			;(06) ADD STR TO JSL
	EXP	$RJSL			;(07) REMOVE STR FROM JSL
	EXP	$UFDLOK			;(10) SET UFD INTERLOCK
	EXP	$UFDCLR			;(11) CLEAR UFD INTERLOCK
SUBTTL	Mount a structure (function 1)


$MOUNT:	PUSHJ	P,FIXPPN		;FIX UP THE PPN
	PUSHJ	P,READSL		;READ THE JOB'S SEARCH LIST
	PUSHJ	P,CREUFD		;CREATE A UFD IF NECESSARY
	PUSHJ	P,LOKUFD		;GET UFD INTERLOCK
	PUSHJ	P,RCPCHK		;SEE IF WE NEED TO RECOMPUTE
	  JRST	MOUN.1			;NO
	PUSHJ	P,RCPMSG		;ISSUE RECOMPUTING DISK USAGE MESSAGE
	PUSHJ	P,COMPRS		;COMPRESS THE UFD
	PUSHJ	P,SETSUP		;OPEN THINGS FOR SUPER I/O
	PUSHJ	P,RECOMP		;RECOMPURE DISK USAGE
	PUSHJ	P,FINSUP		;CLEANUP SUPER I/O CHANNEL
	PUSHJ	P,QTAMSG		;OUTPUT FINAL QUOTA MESSAGE

MOUN.1:	PUSHJ	P,ADDJSL		;ADD THE STR TO THE JOB SEARCH LIST
	PUSHJ	P,RENUFD		;RENAME THE UFD
	PUSHJ	P,DEFJSL		;DEFINE THE NEW JOB SEARCH LIST
	PUSHJ	P,CLRUFD		;CLEAR UFD INTERLOCK
	PJRST	MNTMSG			;ISSUE MOUNT MESSAGE AND RETURN
SUBTTL	Dismount a structure (function 2)


$DISMOUNT:
	PUSHJ	P,FIXPPN		;FIX UP THE PPN
	PUSHJ	P,READSL		;READ THE JOB'S SEARCH LIST
	PUSHJ	P,LOKUFD		;GET UFD INTERLOCK
	PUSHJ	P,REDUFD		;READ QUOTAS FROM THE UFD
	PUSHJ	P,RCPCHK		;SEE IF WE NEED TO RECOMPUTE
	  JRST	DISM.1			;NO
	PUSHJ	P,RCPMSG		;ISSUE RECOMPUTING DISK USAGE MESSAGE
	PUSHJ	P,COMPRS		;COMPRESS THE UFD
	PUSHJ	P,SETSUP		;OPEN THINGS FOR SUPER I/O
	PUSHJ	P,RECOMP		;RECOMPURE DISK USAGE
	PUSHJ	P,FINSUP		;CLEANUP SUPER I/O CHANNEL
	PUSHJ	P,QTAMSG		;OUTPUT FINAL QUOTA MESSAGE

DISM.1:	PUSHJ	P,QTACHK		;CHECK FOR BEING OVER QUOTA
	PUSHJ	P,DELJSL		;DELETE STR FROM THE JOB SEARCH LIST
	PUSHJ	P,DEFJSL		;DEFINE THE NEW JOB SEARCH LIST
	PUSHJ	P,RENUFD		;RENAME (MAYBE DELETE) THE UFD
	PUSHJ	P,CLRUFD		;CLEAR UFD INTERLOCK
	PJRST	DMOMSG			;ISSUE DISMOUNT MESSAGE AND RETURN
SUBTTL	Recompute disk usage (function 3)


$RECOMPUTE:
	PUSHJ	P,LOKUFD		;GET UFD INTERLOCK
	PUSHJ	P,REDUFD		;READ QUOTAS FROM THE UFD
	PUSHJ	P,RCPCHK		;SEE IF WE NEED TO RECOMPUTE
	  JRST	RECOM1			;NO
	PUSHJ	P,COMPRS		;COMPRESS UFD
	PUSHJ	P,LOKUFD		;SET UFD INTERLOCK
	PUSHJ	P,SETSUP		;OPEN THINGS FOR SUPER I/O
	PUSHJ	P,RECOMP		;RECOMPURE DISK USAGE
	PUSHJ	P,FINSUP		;CLEANUP SUPER I/O CHANNEL

RECOM1:	PUSHJ	P,RENUFD		;RENAME AND SET QUOTAS IN THE UFD
	PUSHJ	P,CLRUFD		;CLEAR UFD INTERLOCK
	PJRST	QTAMSG			;ISSUE QUOTA MESSAGE AND RETURN
SUBTTL	Add a structure to the system search list (function 4)


$ASSL:	PUSHJ	P,READSL		;READ THE SEARCH LIST
	PUSHJ	P,ADDJSL		;ADD STR TO SEARCH LIST
	PUSHJ	P,DEFJSL		;DEFINE A NEW SEARCH LIST
	PJRST	ASLMSG			;ISSUE MESSAGE AND RETURN
SUBTTL	Remove a structure from the system search list (function 5)


$RSSL:	PUSHJ	P,READSL		;READ THE SEARCH LIST
	PUSHJ	P,DELJSL		;REMOVE STR FROM SEARCH LIST
	PUSHJ	P,DEFJSL		;DEFINE A NEW SEARCH LIST
	PJRST	RSLMSG			;ISSUE MESSAGE AND RETURN
SUBTTL	Add a structure to a job search list (function 6)


$AJSL:	PUSHJ	P,READSL		;READ THE SEARCH LIST
	PUSHJ	P,ADDJSL		;ADD STR TO SEARCH LIST
	PUSHJ	P,DEFJSL		;DEFINE A NEW SEARCH LIST
	PJRST	AJLMSG			;ISSUE MESSAGE AND RETURN
SUBTTL	Remove a structure from a job search list (function 7)


$RJSL:	PUSHJ	P,READSL		;READ THE SEARCH LIST
	PUSHJ	P,DELJSL		;REMOVE STR FROM SEARCH LIST
	PUSHJ	P,DEFJSL		;DEFINE A NEW SEARCH LIST
	PJRST	RJLMSG			;ISSUE MESSAGE AND RETURN
SUBTTL	Set the UFD interlock (function 10)


$UFDLOK:HLRZ	P1,.UFLOK(AP)		;GET TIME TO WAIT FOR INTERLOCK
	HRRZ	P2,.UFLOK(AP)		;GET TIME TO WAIT FOR MESSAGE

UFDL.1:	PUSHJ	P,ULOCK			;TRY TO INTERLOCK THE UFD
	  SKIPA				;CAN'T
	POPJ	P,			;RETURN
	JUMPLE	P2,UFDL.2		;ALREADY OUTPUT THE MESSAGE?
	SUBI	P2,LOKTIM		;COUNT DOWN TIME UNTIL MESSAGE
	JUMPG	P2,UFDL.2		;NOT TIME FOR IT
	MOVE	T1,["[",,'UIB']		;GET SEVEREITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |UFD interlock is busy for @A; please wait|]
	PUSHJ	P,TEXT			;GENERATE TEXT

UFDL.2:	SUBI	P1,LOKTIM		;COUNT DOWN THE SECONDS
	JUMPLE	P1,UFDL.3		;CAN'T GET INTERLOCK
	MOVEI	T1,LOKTIM		;GET SECONDS TO WAIT BETWEEN TRIES
	SLEEP	T1,			;ZZZZZZ
	JRST	UFDL.1			;TRY IT AGAIN

UFDL.3:	$ERR	(UBT)			;? UFD INTERLOCK BUSY
SUBTTL	Clear the UFD interlock (function 11)


$UFDCLR:PUSHJ	P,UNLOCK		;UNLOCK THE UFD
	  $ERR	(UIC)			;? UFD INTERLOCK CANNOT BE CLEARED
	POPJ	P,			;RETURN
SUBTTL	Initialization


INITIA:	SETZM	ZBEG			;CLEAR A WORD
	MOVE	T1,[ZBEG,,ZBEG+1]	;SET UP BLT
	BLT	T1,ZEND-1		;CLEAR OUR DATA BASE
	SETZM	.UFUSD(AP)		;CLEAR BLOCKS USED
	MOVE	T1,[%NSHJB]		;ARGUMENT TO RETURN THE
	GETTAB	T1,			;HIGHEST JOB NUMBER IN USE
	  MOVEI	T1,^D511		;SICK MONITOR
	MOVEM	T1,HGHJOB		;SAVE IT
	MOVE	T1,[%LDMFD]		;GET THE MFD PPN
	GETTAB	T1,			;FROM THE MONITOR
	  MOVE	T1,[1,,1]		;BUT IT WON'T TELL US
	MOVEM	T1,MFDPPN		;REMEMBER IT
	MOVE	T1,[%LDSYS]		;GET THE SYS PPN
	GETTAB	T1,			;FROM THE MONITOR
	  MOVE	T1,[1,,4]		;LEVEL D DEFAULT
	MOVEM	T1,SYSPPN		;SAVE IT
	MOVEI	T1,TXTBUF		;POINT TO START OF STRING
	MOVEM	T1,.UFTXT(AP)		;STORE FOR CALLER
	MOVE	T1,.UFJOB(AP)		;GET TARGET JOB NUMBER
	PJOB	T2,			;GET OUR JOB NUMBER
	CAMN	T1,[-1]			;DEFAULTED?
	MOVE	T1,T2			;MAKE IT OUR JOB
	CAMN	T1,T2			;IS IT US?
	SETOM	SLFFLG			;YES - REMEMBER FOR LATER
	MOVEM	T1,.UFJOB(AP)		;RESET INCASE IT WAS DEFAULTED
	MOVE	T1,.UFPPN(AP)		;GET TARGET PPN
	CAMN	T1,[-1]			;DEFAULTED?
	GETPPN	T1,			;MAKE IT OUR PPN
	  JFCL				;JACCT
	MOVEM	T1,.UFPPN(AP)		;RESET IT INCASE IT WAS DEFAULTED
	LDB	T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
	CAILE	T1,0			;RANGE
	CAILE	T1,.UFMAX		; CHECK IT
	  $ERR (IFC)			;ILLEGAL FUNCTION CODE
	MOVE	T1,.UFSTR(AP)		;GET STRUCTURE
	MOVEM	T1,DCHBLK+.DCNAM	;STORE NAME
	MOVE	T1,[DCHSIZ,,DCHBLK]	;POINT TO DSKCHR BLOCK
	DSKCHR	T1,UU.PHY		;READ DISK CHARACTERISTICS
	  $ERR	(IDV)			;ILLEGAL DEVICE
	LDB	T1,[POINTR (T1,DC.TYP)]	;SEE WHAT KINDA JUNK HE GAVE US
	CAIE	T1,.DCTFS		;ONLY WANT A FULL STRUCTURE NAME
	  $ERR	(ISN)			;IMPROPER STRUCTURE NAME
	LDB	T1,[POINTR (DCHBLK+.DCUCH,DC.UCC)];GET BLOCKS PER CLUSTER
	MOVEM	T1,BPC			;SAVE FOR CFP COMPUTATION
	PUSHJ	P,SETFIL		;SET UP FILE BLOCKS
	SETOM	LEVEL			;INDICATE NO CHANNELS OPEN
	MOVEI	L,0			;POINT TO TOP LEVEL
	PUSHJ	P,SETBLK		;SET UP SOME BLOCKS
	MOVE	T1,.UFPPN(AP)		;GET THE PPN
	MOVEM	T1,LKPBLK+.RBNAM(P2)	;STORE AS THE FILE NAME
	MOVE	T1,[IOWD BLKSIZ,DSKBUF]	;POINT TO DISK BUFFER
	MOVEM	T1,IOLIST		;STORE IOWD
	LDB	T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE AGAIN
	POPJ	P,			;RETURN
SUBTTL	PPN fixup


; Here to on MOUNT and DISMOUNT functions to insure the job number
; and the PPN match. They might not, due to races between the user's
; job, QUASAR, and PULSAR. Typically this will happen when some
; Bozo changes his S/L and immediately changes his PPN too. QUASAR
; will get the S/L change message and GETTAB the PPN of the job,
; remembering it forever more. The guy then changes his PPN back
; and types DISMOUNT FOO. PULSAR gets the error return from UFDSET
; (because a STRUUO failed) and starts bitching at the operator.
;
FIXPPN:	MOVX	T1,UF.WLD		;GET WILD PROGRAMMER NUMBER BIT
	TDNE	T1,.UFFLG(AP)		;WANT US TO GENERATE A PPN?
	POPJ	P,			;YES - DO NOTHING FOR NOW
	HRLZ	T1,.UFJOB(AP)		;GET THE JOB NUMBER
	HRRI	T1,.GTPPN		;GETTAB TABLE
	GETTAB	T1,			;READ THE JOB'S PPN
	  SKIPA				;CAN'T
	MOVEM	T1,.UFPPN(AP)		;RESET IT
	POPJ	P,			;RETURN
SUBTTL	Directory searching and recomputing logic


RECOMP:	CAMG	L,LEVEL			;CURRENT LEVEL HAVE A FILE OPEN?
	JRST	RECO.4			;YES - PROCEED
	AOS	LEVEL			;POINT TO NEXT LEVEL
	HRRZI	T1,FOPBLK(P1)		;GET ADDRESS OF FILOP BLOCK
	HRLI	T1,FOPSIZ		;GET LENGTH OF BLOCK
	FILOP.	T1,			;OPEN THE FILE
	  JRST	RECO.2			;CAN'T - FORGET THIS DIRECTORY
	MOVE	T1,FOPBLK+.FOFNC(P1)	;GET ORIGINAL FUNCTION WORD
	ANDX	T1,FO.CHN		;KEEP JUST THE CHANNEL NUMBER
	HRRI	T1,.FOINP		;LOAD FUNCTION CODE TO READ
	MOVEM	T1,FUNBLK(L)		;SAVE FUNCTION WORD FOR LATER
	MOVE	T1,LKPBLK+.RBNAM(P2)	;GET DIRECTORY FILE NAME
	MOVEM	T1,PTHBLK+.PTPPN(L)	;ADD TO THE END OF THE PATH SPEC
	SETZM	DIRBLK(L)		;CLEAR DIRECTORY BLOCK NUMBER
	JUMPN	L,RECO.1		;CHECK FOR TOP LEVEL
	PUSHJ	P,UOQINI		;SET UP .UFQ??
	SETZM	.UFUSD(AP)		;INIT BLOCKS USED COUNTER
	JRST	RECO.1			;CONTINUE

RECO.0:	SOSA	DIRBLK(L)		;ADJUST BLOCK NUMBER FOR RE-READ

RECO.1:	SETZM	IDXBLK(L)		;CLEAR INDEX INTO BUFFER
	MOVE	T1,[2,,T2]		;SET UP AC
	MOVE	T2,FOPBLK+.FOFNC(P1)	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL NUMBER
	HRRI	T2,.FOUSI		;GET USETI FUNCTION
	AOS	T3,DIRBLK(L)		;GET BLOCK NUMBER
	FILOP.	T1,			;POSITION FOR INPUT
	  JRST	RECO.A			;CAN'T
	MOVE	T1,[2,,T2]		;SET UP AC
	MOVE	T2,FOPBLK+.FOFNC(P1)	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL NUMBER
	HRRI	T2,.FOINP		;GET USETI FUNCTION
	MOVEI	T3,IOLIST		;POINT TO I/O COMMAND LIST
	FILOP.	T1,			;READ A BLOCK
	  SKIPA				;CAN'T - ANALYZE ERROR
	JRST	RECO.4			;PROCEED
RECO.A:	TXNE	T1,IO.EOF		;CHECK FOR ERRORS
	JRST	RECO.3			;JUST CLOSE CHANNEL ON EOF
	PUSHJ	P,DIRIOE		;REPORT DIRECTORY I/O ERROR
	SKIPG	L			;TOPLEVEL DIRECTORY?
	AOS	TOPERR			;YES - INDICATE I/O ERROR
	JRST	RECO.3			;ONE ERROR IS ENOUGH

RECO.2:	PUSHJ	P,DIRERR		;REPORT DIRECTORY ERROR
	SKIPG	L			;TOPLEVEL DIRECTORY?
	SOS	TOPERR			;YES - INDICATE LOOKUP ERROR

RECO.3:	MOVE	T1,[1,,T2]		;SET UP AC
	MOVE	T2,FOPBLK+.FOFNC(P1)	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL
	HRRI	T2,.FOREL		;LOAD RELEASE FUNCTION
	FILOP.	T1,			;RELEASE THE CHANNEL
	  JFCL				;IGNORE ERRORS
	MOVX	T1,FO.CHN		;GET CHANNEL FIELD
	ANDCAM	T1,FOPBLK+.FOFNC(P1)	;CLEAR FOR NEXT TIME
	SETZM	PTHBLK+.PTPPN(L)	;TERMINATE PATH PROPERLY
	SOS	L,LEVEL			;BACKUP A LEVEL
	PUSHJ	P,SETPTR		;SET UP POINTERS
	SKIPN	T1,TOPERR		;WAS THERE A TOPLEVEL DIRECTORY ERROR?
	JUMPGE	L,RECO.0		;NO - CONTINUE
	CAIN	T1,1			;I/O ERROR?
	  $ERR	(IOE)			;YES
	CAMN	T1,[-1]			;LOOKUP ERROR?
	  $ERR	(CAD)			;YES
	POPJ	P,			;RETURN

RECO.4:	SKIPGE	DIRBLK(L)		;NEED TO RE-READ BLOCK?
	JRST	RECO.0			;YES
	MOVE	T4,IDXBLK(L)		;GET INDEX INTO BUFFER
	CAIL	T4,BLKSIZ		;END OF BUFFER?
	JRST	RECO.1			;YES - READ ANOTHER BLOCK
	MOVE	T1,DSKBUF+0(T4)		;GET FILE NAME
	HLLZ	T2,DSKBUF+1(T4)		;GET EXTENSION
	HRRZ	T3,DSKBUF+1(T4)		;GET COMPRESSED FILE POINTER
	MOVEI	T4,2			;ACCOUNT FOR TWO WORD ENTRIES
	ADDM	T4,IDXBLK(L)		;POINT PAST THE WORDS WE JUST READ
	JUMPE	T1,RECO.4		;FLUSH NULL ENTRIES

RECO.5:	MOVEM	T1,LKPFIL+.RBNAM	;STORE FILE NAME
	MOVEM	T2,LKPFIL+.RBEXT	;STORE EXTENSION
	MOVE	T1,LKPBLK+.RBNAM(P2)	;GET CURRENT DIRECTORY NAME
	MOVEM	T1,PTHFIL+.PTPPN(L)	;STORE AT THE END OF THE PATH SPEC
	SETZM	PTHFIL+.PTSFD(L)	;MAKE SURE PATH IS TERMINATED
	MOVE	T1,T3			;COPY CFP
	PUSHJ	P,RIBSUP		;READ RIB WITH SUPER I/O IF WE CAN
	  SKIPA	T1,[FOPSIZ,,FOPFIL]	;CAN'T - SET UP FILOP
	JRST	RECO.9			;SAVE FILSER SOME WORK
	FILOP.	T1,			;LOOKUP A FILE
	  JRST	RECO.6			;CAN'T
RECO.9:	MOVE	T1,LKPFIL+.RBALC	;GET BLOCKS ALLOCATED TO THIS FILE
	MOVX	T2,RP.NQC		;NON-QUOTA CHECKED FILE BIT
	TDNN	T2,LKPFIL+.RBSTS	;DO QUOTA CHECKING ON THIS FILE?
	ADDM	T1,.UFUSD(AP)		;YES - ADD TO TOTAL SO FAR
	PUSHJ	P,RIBCHK		;CHECK FOR FILE ERRORS
	JRST	RECO.7			;ALLS WELL SO FAR

RECO.6:	PUSHJ	P,FILERR		;REPORT FILE ERRORS
	SETZM	LKPFIL+.RBEXT		;CLEAR SO WE DON'T DO EXTRA LOOKUP

RECO.7:	MOVE	T1,[1,,T2]		;SET UP AC
	MOVE	T2,FOPFIL+.FOFNC	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL NUMBER
	HRRI	T2,.FOREL		;LOAD NEW FUNCTION CODE
	FILOP.	T1,			;RELEASE THE CHANNEL
	  JFCL				;IGNORE ERRORS
	MOVX	T1,FO.PRV!FO.ASC+.FORED	;USE PRIVS/ASSIGN CHANNEL/READ
	MOVEM	T1,FOPFIL+.FOFNC	;RESET FOR ENXT TIME
	HLRZ	T1,LKPFIL+.RBEXT	;GET THE EXTENSION
	CAIN	T1,'SFD'		;LOWER LEVEL DIRECTORY?
	AOSA	L			;YES - DROP DOWN A LEVEL
	JRST	RECOMP			;GO BACK AND DO ANOTHER FILE

RECO.8:	PUSHJ	P,SETBLK		;SET UP BLOCKS AND POINTERS
	MOVE	T1,LKPFIL+.RBNAM	;GET A DIRECTORY NAME
	MOVEM	T1,LKPBLK+.RBNAM(P2)	;STORE IT
	HLLZ	T1,LKPFIL+.RBEXT	;GET IT'S EXTENSION
	MOVEM	T1,LKPBLK+.RBEXT(P2)	;STORE IT TOO
	JRST	RECOMP			;GO BACK AND DO ANOTHER FILE
	SUBTTL	RIBSUP - Read and verify a rib


; Call:	T1/ CFP
; error return if not a good rib, normal return if verified
;
; Note:	Unit of RIB = (CFP/CPU)
;	Block on unit = (CFP - (unit of RIB * CPU)) * BPC
;	Block of RIB = (USZ * unit of RIB) + block on unit
;
; CFP - Compressed File Pointer
; CPU - Clusters Per Unit
; BPC - Blocks per cluster
; USZ - Number of blocks on a unit

RIBSUP:	MOVE	T2,T1			;COPY CFP FOR LATER
	IDIV	T2,CPU			;COMPUTE UNIT WE ARE WORKING WITH
	MOVE	T3,CPU			;GET THE CLUSTERS PER UNIT
	IMULI	T3,(T2)			;COMPUTE THE NUMBER OF CLUSTERS
					; BEFORE THIS UNIT
	SUB	T1,T3			;COMPUTE CLUSTER WITHIN UNIT
	IMUL	T1,BPC			;DETERMINE BLOCK WITHIN UNIT
	IMUL	T2,USZ			;DETERMINE BLOCKS BEFORE THIS UNIT
	ADD	T1,T2			;DETERMINE BLOCK WITHIN STRUCTURE
	MOVEM	T1,SUPFOP+1		;STORE ARG
	MOVEI	T1,.FOUSI		;USETI
	DPB	T1,[POINTR (SUPFOP+.FOFNC,FO.FNC)];STORE FUNCTION
	MOVE	T1,[2,,SUPFOP]		;POINT TO FILOP. BLOCK
	FILOP.	T1,			;SHOOT
	 POPJ	P,			;FAILED
	MOVEI	T1,.FOINP		;INPUT
	DPB	T1,[POINTR (SUPFOP+.FOFNC,FO.FNC)];STORE FUNCTION
	MOVE	T1,[IOWD BLKSIZ,RIBBLK]	;POINT TO A RIB
	MOVEI	T2,0			;CLEAR IO LIST
	MOVEI	T3,T1			;ADDRESS OF I/O LIST
	MOVEM	T3,SUPFOP+1		;STORE
	MOVE	T3,[2,,SUPFOP]		;POINT TO FILOP. BLOCK
	FILOP.	T3,			;READ THE RIB
	 POPJ	P,			;CANT

;Now verify RIB

	MOVE	T1,LKPFIL+.RBNAM	;GET DESIRED NAME
	CAME	T1,RIBBLK+.RBNAM	;MATCH RIB?
	 POPJ	P,			;NO
	HLLZ	T1,LKPFIL+.RBEXT	;GET EXTENSION
	HLLZ	T2,RIBBLK+.RBEXT	;AND FROM RIB
	CAME	T1,T2			;MATCH?
	 POPJ	P,			;NO
	MOVE	T1,PTHBLK+.PTPPN	;GET PPN?
	CAME	T1,RIBBLK+.RBPPN	;MATCH?
	 POPJ	P,			;NO

;Now copy RIB

	PUSH	P,LKPFIL+.RBPPN		;SAVE PATH POINTER
	PUSH	P,LKPFIL+.RBCNT		;SAVE COUNTER
	MOVE	T1,[RIBBLK,,LKPFIL]	;SETUP BLT
	BLT	T1,LKPFIL+RIBSIZ	;MOVE THE RIB OVER
	POP	P,LKPFIL+.RBCNT		;FUDGE THEM BACK
	POP	P,LKPFIL+.RBPPN		;...
	AOS	(P)			;SKIP RETURN
	POPJ	P,			;TO CALLER
	SUBTTL	SETSUP - Setup for super I/O

SETSUP:	MOVE	T1,[FO.ASC+.FOSIO]	;SUPER MODE
	MOVEM	T1,SUPFOP+.FOFNC	;STORE
	MOVEI	T1,.IODMP		;DUMP MODE
	MOVEM	T1,SUPFOP+.FOIOS	;STORE
	MOVE	T1,.UFSTR(AP)		;GET STR
	MOVEM	T1,SUPFOP+.FODEV	;STORE DEVICE
	MOVE	T1,[4,,SUPFOP]		;POINT TO BLOCK
	FILOP.	T1,			;OPEN IT UP
	 $ERR	(IDV)			;??
	POPJ	P,			;AND RETURN

	SUBTTL	FINSUP - Finish up super I/O

FINSUP:	MOVEI	T1,.FOREL		;RELEASE FUNCTION
	DPB	T1,[POINTR (SUPFOP+.FOFNC,FO.FNC)];STORE
	MOVE	T1,[1,,SUPFOP]		;POINT TO BLOCK
	FILOP.	T1,			;RELEASE CHANNEL
	 JFCL				;OH WELL
	POPJ	P,			;AND RETURN
SUBTTL	Set up .UFQ??


; Here to set up .UFQTF, .UFQTO, .UFQTR and .UFUSD
;
UOQINI:	SKIPGE	T1,.UFQTF(AP)		;GET QUOTA TO SET
	MOVE	T1,LKPBLK+.RBQTF(P2)	;GET LOGGED-IN QUOTA
	MOVEM	T1,.UFQTF(AP)		;STORE IT
	SKIPGE	T1,.UFQTO(AP)		;GET QUOTA TO SET
	MOVE	T1,LKPBLK+.RBQTO(P2)	;GET LOGGED-OUT QUOTA
	MOVEM	T1,.UFQTO(AP)		;STORE IT
	SKIPGE	T1,.UFQTR(AP)		;SET QUOTA TO SET
	MOVE	T1,LKPBLK+.RBQTR(P2)	;GET RESERVED QUOTA
	MOVEM	T1,.UFQTR(AP)		;STORE IT
	POPJ	P,			;RETURN
SUBTTL	Check for file errors


; Here to check for file errors (error bits in RIBSTS)
;
RIBCHK:	MOVX	T1,RP.ERR		;GET MASK OF ALL FILE ERRORS
	TDNN	T1,LKPFIL+.RBSTS	;ANY SET
	POPJ	P,			;NO
	AOS	RIBERR			;COUNT ERROR BITS
	SKIPN	.UFTYO(AP)		;CALLING PROGRAM WANT TO SEE MESSAGE?
	POPJ	P,			;NO
	PUSH	P,P1			;SAVE P1
	MOVEI	P1,0			;CLEAR INDEX

RIBC.1:	HRRZ	T1,RIBTAB(P1)		;GET BIT TO TEST
	TDNN	T1,LKPFIL+.RBSTS	;BIT ON?
	JRST	RIBC.2			;NO - TRY ANOTHER
	MOVEI	T1,FOPFIL		;GET FILOP BLOCK ADDRESS
	MOVEM	T1,FOPADR		;SAVE IT
	HLRZ	T1,RIBTAB(P1)		;GET TEXT ADDRESS
	MOVEM	T1,TXTADR		;SAVE IT
	MOVE	T1,["%",,'FLE']		;FLAG AS WARNING
	MOVEI	T2,[ASCIZ |Error on @J; @K|] ;GET TEXT
	PUSHJ	P,TEXT			;GENERATE TEXT

RIBC.2:	CAIGE	P1,RIBMAX-1		;DONE CHECKING?
	AOJA	P1,RIBC.1		;NO - LOOP
	POP	P,P1			;RESTORE P1
	POPJ	P,			;RETURN


; Macro to build RIBTAB
;
DEFINE	$RIB	(BIT,TXT),<[ASCIZ |TXT|],,RP.'BIT>


; Table of RIB bits and error messages
;
RIBTAB:	$RIB	(BDA,<file damage>)
	$RIB	(CRH,<closed after a crash>)
	$RIB	(BFA,<tape read error restoring file>)
	$RIB	(FRE,<hard data read error>)
	$RIB	(FWE,<hard data write error>)
	$RIB	(FCE,<software detected checksum error>)
RIBMAX==.-RIBTAB
SUBTTL	Search list routines -- Read a S/L


; Read a search list
;
READSL:	MOVEI	T2,.FSDSL		;GET FUNCTION CODE
	MOVEM	T2,OLDSL+.FSFCN		;SAVE IT
	MOVE	T1,.UFJOB(AP)		;GET JOB NUMBER
	MOVEM	T1,OLDSL+.FSDJN		;SAVE IT
	MOVEM	T1,GOBBLK+.DFGJN	;HERE TOO
	MOVE	T1,.UFPPN(AP)		;GET PPN
	MOVEM	T1,OLDSL+.FSDPP		;SAVE IT
	SETZM	OLDSL+.FSDFL		;CLEAR FLAG WORD
	MOVEI	T2,OLDSL+.FSDSO		;POINT TO FIRST STR BLOCK
	SETZM	GOBBLK+.DFGPP		;NO PPN
	SETOM	GOBBLK+.DFGNM		;START WITH THE FIRST STRUCTURE

READ.1:	MOVE	T1,[.DFGST+1,,GOBBLK]	;SET UP UUO
	MOVE	T3,[GOBSTR T1,]		;ASSUME ANY JOB
	SKIPN	SLFFLG			;OUR JOB?
	JRST	READ.2			;NO
	MOVE	T1,[.DFJBL,,GOBBLK+2]	;ADJUST ARGUMENT
	MOVE	T3,[JOBSTR T1,]		;FOR OUR JOB

READ.2:	XCT	T3			;GET THE NEXT STRUCTURE IN S/L
	  $ERR	(CRS)			;CAN'T READ S/L
	MOVSI	T1,GOBBLK+.DFGNM	;POINT TO ARGUMENTS RETURNED
	HRRI	T1,(T2)			;BUILD BLT POINTER
	BLT	T1,.DFJBL-1(T2)		;COPY THEM
	ADDI	T2,.DFJBL		;POINT TO NEXT STR BLOCK
	MOVE	T1,GOBBLK+.DFGNM	;GET LAST STR RETURNED
	AOJN	T1,READ.1		;LOOP IF NOT END OF S/L
	MOVEI	T1,OLDSL		;GET S/L BLOCK ADDRESS
	POPJ	P,			;RETURN
SUBTTL	Search list routines -- Find a structure in a S/L



; Find a search list entry in either OLDSL or NEWSL
; Call:	MOVE	T1, STR
;	PUSHJ	P,FINDOS	;OLDSL
;	PUSHJ	P,FINDNS	;NEWSL
;	<NON-SKIP>		;ENTRY NOT FOUND
;	<SKIP>			;ENTRY FOUND, T2:= ENTRY ADDRESS
;
FINDOS:	SKIPA	T2,[OLDSL]		;POINT TO OLD S/L
FINDNS:	MOVEI	T2,NEWSL		;POINT TO NEW S/L
	ADDI	T2,.FSDSO		;POINT TO FIRST STRUCTURE

FIND.1:	MOVE	T3,.DFJNM(T2)		;GET A STRUCTURE FROM THE S/L
	CAMN	T3,T1			;FOUND WHAT WE'RE LOOKING FOR?
	JRST	CPOPJ1			;YES - RETURN T2:= ADDRESS
	AOJE	T3,CPOPJ		;CHECK FOR END OF S/L
	ADDI	T2,.DFJBL		;POINT TO NEXT ENTRY
	JRST	FIND.1			;TRY THE NEXT
SUBTTL	Search list routines -- Add a structure


ADDJSL:	MOVE	T1,[OLDSL,,NEWSL]	;SET UP BLT
	BLT	T1,NEWSL+.FSDFL		;COPY HEADER STUFF
	MOVEI	P1,OLDSL+.FSDSO		;POINT TO FIRST STR IN OLD S/L
	MOVEI	P2,NEWSL+.FSDSO		;POINT TO FIRST STR IN NEW S/L
	MOVE	P3,.UFFLG(AP)		;GET FLAGS
	MOVE	T1,.UFSTR(AP)		;GET STRUCTURE
	PUSHJ	P,FINDOS		;FIND IT
	  JRST	ADDJ.1			;ADD IT SOMEWHERE IN THE S/L
	MOVE	P4,T2			;SAVE ADDRESS
	MOVEI	T1,0			;FENCE
	PUSHJ	P,FINDOS		;FIND IT
	  POPJ	P,			;CAN'T HAPPEN
	TXNN	P3,UF.PSL		;WANT ACTIVE?
	CAML	P4,T2			;ALREADY ON THE ACTIVE SIDE?
	  SKIPA				;NO TO EITHER
	JRST	ADDJ.2			;YES - LEAVE IT WHERE IT IS
	TXNE	P3,UF.PSL		;WANT PASSIVE?
	CAMG	P4,T2			;ALREADY ON THE PASSIVE SIDE?
	  SKIPA				;NO TO EITHER
	JRST	ADDJ.2			;YES - THEN LEAVE IT WHERE IT IS
	TXNN	P3,UF.PSL		;WHERE DO WE WANT IT?
	JRST	ADDJ.3			;PUT IN THE ACTIVE S/L
	JRST	ADDJ.4			;PUT IN THE PASSIVE S/L
; Here to add a new structure
;
ADDJ.1:	TXNN	P3,UF.PSL		;WHERE TO WE WANT IT
	TDZA	T1,T1			;PUT IN THE ACTIVE S/L
	MOVX	T1,-1			;PUT IN THE PASSIVE S/L
	PUSHJ	P,FINDOS		;FIND THE FENCE OR END
	  POPJ	P,			;SHOULDN'T FAIL
	MOVEI	T1,(T2)			;COMPUTE WORDS TO MOVE
	SUBI	T1,(P1)			;FROM BEGINING TO END
	PUSHJ	P,MOVSTR		;MOVE THEM
	PUSHJ	P,ADDSTR		;ADD STR TO END OF ACTIVE OR PASSIVE
	PUSHJ	P,FINSTR		;FINISH COPYING THE S/L
	POPJ	P,			;RETURN


; Here to copy an existing structure
;
ADDJ.2:	MOVEI	T1,(P4)			;GET STR ADDRESS
	SUBI	T1,(P1)			;COMPUTE WORDS TO COPY
	PUSHJ	P,MOVSTR		;MOVE THEM
	PUSHJ	P,CPYSTR		;COPY STR TO NEW S/L
	PUSHJ	P,FINSTR		;FINISH COPYING THE S/L
	POPJ	P,			;RETURN


; Here to put a structure in the active S/L
;
ADDJ.3:	MOVEI	T1,0			;FENCE
	PUSHJ	P,FINDOS		;FIND IT
	  POPJ	P,			;CAN'T HAPPEN
	MOVEI	T1,(T2)			;GET ADDRESS OF FENCE
	SUBI	T1,(P1)			;COMPUTE WORDS TO MOVE
	PUSHJ	P,MOVSTR		;MOVE THEM
	PUSHJ	P,ADDSTR		;ADD THE STRUCTURE TO ACTIVE S/L
	MOVEI	T1,(P4)			;GET STR ADDRESS
	SUBI	T1,(P1)			;COMPUTE WORDS TO MOVE
	PUSHJ	P,MOVSTR		;MOVE THEM
	ADDI	P1,.DFJBL		;POINT BEYOND THE STR
	PUSHJ	P,FINSTR		;FINISH UP
	POPJ	P,			;RETURN


; Here to put a structure in the passive S/L
;
ADDJ.4:	MOVEI	T1,(P4)			;GET POSITION OF STR IN OLD S/L
	SUBI	T1,(P1)			;COMPUTE WORDS TO COPY
	PUSHJ	P,MOVSTR		;MOVE THAT MANY WORDS
	ADDI	P1,.DFJBL		;SKIP OVER THE STR
	MOVX	T1,-1			;END OF S/L
	PUSHJ	P,FINDOS		;FIND IT
	  POPJ	P,			;CAN'T HAPPEN
	MOVEI	T1,(T2)			;GET ADDRESS OF END OF S/L
	SUBI	T1,(P1)			;COMPUTE WORDS TO MOVE
	PUSHJ	P,MOVSTR		;MOVE THAT MANY WORDS
	PUSHJ	P,ADDSTR		;NOW ADD THE STRUCTURE
	PUSHJ	P,FINSTR		;FINISH UP
	POPJ	P,			;RETURN
; Copy a structure block from the old S/L to the new S/L
;
CPYSTR:	TDZA	T1,T1			;INDICATE COPY


; Add a new structure block to the new S/L
;
ADDSTR:	SKIPA	T1,.			;INDICATE ADD
	SKIPA	T2,.DFJNM(P1)		;GET STR TO COPY
	MOVE	T2,.UFSTR(AP)		;GET STR TO ADD
	MOVEM	T2,.DFJNM(P2)		;SAVE STR IN NEW S/L
	SETZM	.DFJDR(P2)		;CLEAR DIRECTORY
	MOVE	T2,.UFSTS(AP)		;GET FILE STRUCTURE STATUS BITS
	MOVEM	T2,.DFJST(P2)		;SAVE THEM
	SKIPN	T1			;ADDING?
	ADDI	P1,.DFJBL		;POINT TO NEXT OLD STR BLOCK IF COPY
	ADDI	P2,.DFJBL		;POINT TO NEXT NEW STR BLOCK
	POPJ	P,			;RETURN


; Move structure blocks from the old S/L to the new S/L
;
MOVSTR:	SKIPN	T1			;ANYTHING TO MOVE?
	POPJ	P,			;NO
	MOVSI	T2,(P1)			;GET OLD S/L ADDRESS
	HRRI	T2,(P2)			;GET NEW S/L ADDRESS
	MOVEI	T3,(P2)			;GET CURRENT POSITION
	ADDI	T3,(T1)			;PLUS THE NUMBER OF WORDS TO MOVE
	BLT	T2,-1(T3)		;COPY PART OF THE S/L
	ADDI	P1,(T1)			;INCREMENT OLD S/L POINTER
	ADDI	P2,(T1)			;INCREMENT NEW S/L POINTER
	POPJ	P,			;RETURN


; Finish copying structures from the old S/L to the new S/L
;
FINSTR:	MOVX	T1,-1			;FENCE
	PUSHJ	P,FINDOS		;FIND IT
	  POPJ	P,			;CAN'T HAPPEN
	CAMN	T2,P1			;ALREADY POINTING AT IT?
	ADDI	T2,1			;YES
	SUBI	T2,(P1)			;GET OFFSET TO END OF OLD S/L
	ADDI	T2,(P2)			;COMPUTE FINAL BLT ADDRESS
	MOVSI	T1,(P1)			;GET OLD S/L ADDRESS
	HRRI	T1,(P2)			;GET NEW S/L ADDRESS
	BLT	T1,(T2)			;COPY REMANINDER IF S/L
	POPJ	P,			;RETURN
SUBTTL	Search list routines -- Delete a structure


DELJSL:	MOVX	T1,-1			;GET END OF S/L INDICATOR
	PUSHJ	P,FINDOS		;FIND IT
	  POPJ	P,			;CAN'T HAPPEN
	MOVEI	P1,-OLDSL(T2)		;GET LENGTH IN WORDS
	MOVE	T1,[OLDSL,,NEWSL]	;SET UP BLT
	BLT	T1,NEWSL(P1)		;COPY S/L
	MOVE	T1,.UFSTR(AP)		;GET STR TO REMOVE
	PUSHJ	P,FINDNS		;FIND IT IN THE NEW SEARCH LIST
	  POPJ	P,			;CAN'T - SAY WE DID IT
	SUBI	T2,NEWSL		;GET OFFSET
	MOVSI	T1,OLDSL+.DFJBL(T2)	;GET ADDRESS BEYOND STR BLOCK
	HRRI	T1,NEWSL(T2)		;POINT TO STR BLOCK IN NEW S/L
	BLT	T1,NEWSL-.DFJBL(P1)	;SLIDE S/L UP BY ONE STR BLOCK
	POPJ	P,			;RETURN
SUBTTL	Search list routines -- Define a S/L


DEFJSL:	MOVX	T1,DF.SRM		;GET A BIT
	MOVEM	T1,NEWSL+.FSDFL		;REMOVE STRS NOT IN NEW S/L
	MOVE	T1,.UFPPN(AP)		;GET PPN INCASE WE GENERATED ONE
	MOVEM	T1,NEWSL+.FSDPP		;UPDATE IT
	MOVX	T1,-1			;GET END OF LIST
	PUSHJ	P,FINDNS		;FIND IT
	  $ERR	(CCS)			;CAN'T HAPPEN, BUT...
	MOVSI	T1,-NEWSL(T2)		;GET LENGTH
	HRRI	T1,NEWSL		;GET ADDRESS
	STRUUO	T1,			;DEFINE A NEW SEARCH LIST
	  $ERR	(CCS)			;? CAN'T ADD STR TO SEARCH LIST
	LDB	T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
	SKIPE	.UFJOB(AP)		;SCREWING AROUND WITH THE SSL?
	CAIN	T1,.UFDMO		;DISMOUNT?
	POPJ	P,			;YES - THEN NOTHING ELSE TO DO
	MOVE	T1,[.DCMAX,,DCHBLK]	;SET UP UUO
	DSKCHR	T1,			;GET UPDATED DISK CHARACTERISTICS
	  POPJ	P,			;STRANGE
	HRRZ	T1,DCHBLK+.DCSAJ	;GET JOB # THAT MIGHT HAVE STR MOUNTED
	CAME	T1,.UFJOB(AP)		;IS IT THE JOB WE'RE DOING THINGS FOR?
	POPJ	P,			;NO - CAN'T CHANGE STATUS
	MOVEI	T1,.FSRDF		;GET FUNCTION CODE
	MOVEM	T1,NEWSL+.FSFCN		;SAVE IT
	MOVE	T1,.UFSTR(AP)		;GET STRUCTURE NAME
	MOVEM	T1,NEWSL+.FSRNM		;SAVE IT
	MOVX	T1,UF.SIN		;GET SINGLE ACCESS BIT
	TDNN	T1,.UFFLG(AP)		;WHAT KIND OF ACCESS DO WE WANT?
	TDZA	T1,T1			;MULTI ACCESS
	MOVX	T1,FS.RSA		;SINGLE ACCESS
	MOVEM	T1,NEWSL+.FSRST		;SAVE THE CODE
	MOVE	T1,[.FSRST+1,,NEWSL]	;SET UP AC
	STRUUO	T1,			;MAKE STR SINGLE ACCESS
	  SKIPA	T1,[DF.SRM]		;CAN'T - WE'RE IN TROUBLE NOW
	POPJ	P,			;DONE
	MOVEM	T1,OLDSL+.FSDFL		;YES - REMOVE STR FROM S/L
	MOVX	T1,-1			;FENCE
	PUSHJ	P,FINDOS		;FIND IT IN THE OLD S/L
	  $ERR	(CSO)			;CAN'T HAPPEN, BUT...
	MOVSI	T1,-OLDSL(T2)		;GET LENGTH
	HRRI	T1,OLDSL		;GET ADDRESS
	STRUUO	T1,			;TRY TO RESET THE ORIGINAL S/L
	  $ERR	(CSO)			;? CANNOT RESET ORIGINAL SEARCH LIST
	$ERR	(CSS)			;? CANNOT CHANGE STRUCTURE STATUS
SUBTTL	Set up file FILOP, LOOKUP, and PATH block


SETFIL:	MOVX	T1,FO.PRV!FO.ASC+.FORED	;USE PRIVS/ASSIGN CHANNEL/READ
	MOVEM	T1,FOPFIL+.FOFNC	;STORE IT
	MOVX	T1,UU.PHS+.IODMP	;PHYSICAL ONLY/DUMP MODE
	MOVEM	T1,FOPFIL+.FOIOS	;STORE IT
	MOVE	T1,.UFSTR(AP)		;GET STRUCTURE NAME
	MOVEM	T1,FOPFIL+.FODEV	;STORE IT
	SETZM	FOPFIL+.FOBRH		;NO BUFFER RING HEADERS
	SETZM	FOPFIL+.FONBF		;THEREFORE, NO BUFFERS
	SETZM	FOPFIL+.FOPAT		;NO NEED FOR A PATH BLOCK
	SETZM	FOPFIL+.FOPPN		;CLEAR IN-YOUR-BEHALF PPN
	MOVEI	T1,LKPFIL		;GET ADDRESS OF LOOKUP BLOCK
	MOVEM	T1,FOPFIL+.FOLEB	;STORE IT
	MOVEI	T1,RIBSIZ		;GET LOOKUP BLOCK LENGTH
	MOVEM	T1,LKPFIL+.RBCNT	;STORE IT
	MOVEI	T1,PTHFIL		;GET ADDRESS OF PATH BLOCK
	MOVEM	T1,LKPFIL+.RBPPN	;PUT IN THE LOOKUP BLOCK TOO
	SETZM	LKPFIL+.RBPRV		;CLEAR A WORD
	MOVE	T1,[LKPFIL+.RBPRV,,LKPFIL+.RBPRV+1] ;SET UP BLT
	BLT	T1,LKPFIL+RIBSIZ-1	;CLEAR REMAINDER OF BLOCK
	POPJ	P,			;RETURN
SUBTTL	Set up file FILOP, LOOKUP, and PATH block for a UFD


SETUFD:	PUSHJ	P,SETFIL		;SET UP THE FILE BLOCKS
	MOVE	T1,.UFPPN(AP)		;GET FILE NAME (PPN)
	MOVEM	T1,LKPFIL+.RBNAM	;STORE IT
	HRLZI	T1,'UFD'		;GET EXTENSION (UFD)
	MOVEM	T1,LKPFIL+.RBEXT	;STORE IT
	MOVE	T1,MFDPPN		;GET MFD PPN
	MOVEM	T1,PTHFIL+.PTPPN	;STORE IT
	SETZM	PTHFIL+.PTSFD		;TERMINATE PATH
	POPJ	P,			;RETURN
SUBTTL	Set up block pointers


SETPTR:	MOVE	P1,L			;GET LEVEL
	IMULI	P1,FOPSIZ		;INDEX INTO FOPBLK
	MOVE	P2,L			;GET LEVEL
	IMULI	P2,RIBSIZ		;INDEX INTO LKPBLK
	POPJ	P,			;RETURN
SUBTTL	Set up a directory FILOP, LOOKUP, and PATH blocks


SETBLK:	PUSHJ	P,SETPTR		;SET UP THE POINTERS
	MOVX	T1,FO.PRV!FO.ASC+.FORED	;USE PRIVS/ASSIGN CHANNEL/READ
	MOVEM	T1,FOPBLK+.FOFNC(P1)	;STORE IT
	MOVX	T1,UU.PHS+.IODMP	;PHYSICAL ONLY/DUMP MODE
	MOVEM	T1,FOPBLK+.FOIOS(P1)	;STORE IT
	MOVE	T1,.UFSTR(AP)		;GET STRUCTURE NAME
	MOVEM	T1,FOPBLK+.FODEV(P1)	;STORE IT
	SETZM	FOPBLK+.FOBRH(P1)	;NO BUFFER RING HEADERS
	SETZM	FOPBLK+.FONBF(P1)	;THEREFORE, NO BUFFERS
	SETZM	FOPBLK+.FOPAT(P1)	;NO NEED FOR A PATH BLOCK
	SETZM	FOPBLK+.FOPPN(P1)	;CLEAR IN-YOUR-BEHALF PPN

	MOVEI	T1,RIBSIZ		;GET LENGTH OF LOOKUP BLOCK
	MOVEM	T1,LKPBLK+.RBCNT(P2)	;STORE IT
	MOVEI	T1,LKPBLK(P2)		;GET ADDRESS OF LOOKUP BLOCK
	MOVEM	T1,FOPBLK+.FOLEB(P1)	;STORE IT

	MOVEI	T1,PTHBLK		;GET ADDRESS OF PATH BLOCK
	MOVEM	T1,LKPBLK+.RBPPN(P2)	;STORE IN LOOKUP BLOCK
	MOVE	T1,MFDPPN		;GET THE MFD PPN
	SKIPE	L			;TOP LEVEL?
	MOVE	T1,.UFPPN(AP)		;NO - GET THE UFD PPN
	MOVEM	T1,PTHBLK+.PTPPN	;SET UP A PPN
	HRLZI	T1,'UFD'		;GET THE UFD EXTENSION
	SKIPE	L			;TOP LEVEL?
	HRLZI	T1,'SFD'		;NO - GET A DIFFERENT EXTENSION
	MOVEM	T1,LKPBLK+.RBEXT(P2)	;STORE IT
	POPJ	P,			;RETURN
SUBTTL	Create a UFD


CREUFD:	MOVX	T1,UF.WLD		;GET WILD PROGRAMMER NUMBER FLAG
	TDNE	T1,.UFFLG(AP)		;WANT US TO GENERATE A PPN?

CREU.0:	PUSHJ	P,CREPRG		;YES
	PUSHJ	P,SETUFD		;SET UP FOR UFD LOOKUP
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP UUO
	FILOP.	T1,			;TRY TO LOOKUP THE UFD
	  JRST	CREU.1			;CAN'T
	MOVX	T1,UF.WLD		;GET WILD PROGRAMMER NUMBER FLAG
	TDNN	T1,.UFFLG(AP)		;WANT US TO GENERATE A PPN?
	PJRST	REDU.1			;NO - GO READ UFD QUOTAS, ETC.
	PUSHJ	P,RELUFD		;CLOSE THE CHANNEL
	JRST	CREU.0			;AND TRY AGAIN

CREU.1:	PUSH	P,T1			;SAVE T1
	PUSHJ	P,RELUFD		;CLOSE OF CHANNEL
	POP	P,T1			;GET ERROR CODE BACK
	CAIE	T1,ERFNF%		;FILE NOT FOUND?
	  $ERR	(LFU)			;LOOKUP FAILED FOR UFD
	SETZ	T1,			;CLEAR AN AC
	SKIPL	.UFQTF(AP)		;WANT TO SET LOGGED IN QUOTA?
	IOR	T1,.UFQTF(AP)		;YES
	SKIPL	.UFQTO(AP)		;WANT TO SET LOGGED OUT QUOTA?
	IOR	T1,.UFQTO(AP)		;YES
	SKIPL	.UFQTR(AP)		;WANT TO SET RESERVED QUOTA?
	IOR	T1,.UFQTR(AP)		;YES
	JUMPN	T1,CREU.2		;IF SETTING QUOTAS, THEN CREATE A UFD
	MOVX	T1,UF.NUE		;GET NO UFD EXISTS BIT
	IORM	T1,.UFFLG(AP)		;SAVE FOR CURIOUS PROGRAMS
	MOVE	T1,["%",,'NUC']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |No UFD created on @A|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN

CREU.2:	PUSHJ	P,SETUFD		;SET UP FOR UFD ENTER
	MOVEI	T1,.FOWRT		;GET WRITE FUNCTION CODE
	HRRM	T1,FOPFIL+.FOFNC	;STORE IT
	MOVX	T1,RP.DIR		;GET DIRECTORY BIT
	MOVEM	T1,LKPFIL+.RBSTS	;SAVE FILE STATUS BITS
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP UUO
	FILOP.	T1,			;TRY TO LOOKUP THE UFD
	  $ERR	(EFU)			;?ENTER FAILED FOR UFD
	MOVEI	T1,.FOUSO		;USETO FUNCTION
	HRRM	T1,FOPFIL+.FOFNC	;SAVE IT
	MOVEI	T1,2			;2 BLOCKS
	MOVEM	T1,FOPFIL+.FOIOS	;ALLOCATE THIS MUCH
	MOVE	T1,[2,,FOPFIL]		;SET UP UUO
	FILOP.	T1,			;ALLOCATE SOME BLOCK
	  JFCL				;IGNORE ERRORS
	PJRST	RELUFD			;RELEASE CHANNEL AND RETURN


; Here to create a unique programmer number if necessary
;
CREPRG:	HRRZ	T1,.UFPPN(AP)		;GET PROGRAMMER NUMBER
	JUMPN	T1,CREP.1		;FIRST TIME THROUGH?
	MSTIME	T1,			;GET TIME IN MILLISECONDS
	TRZ	T1,7B20			;CLEAR A DIGIT
	TROA	T1,1B18			;SET FIRST DIGIT TO 4

CREP.1:	ADDI	T1,1			;CHANGE IT
	HRRM	T1,.UFPPN(AP)		;SAVE NEW PROGRAMMER NUMBER
	MOVE	T1,.UFPPN(AP)		;GET FULL PPN
	CHGPPN	T1,			;CHANGE TO THE NEW PPN
	  $ERR	(PGF)			;? PROGRAMMER GENERATION FAILED
	GETPPN	T1,			;OTHER USERS LOGGED IN WITH NEW PPN?
	  POPJ	P,			;NO - RETURN
	JRST	CREP.1			;TRY A DIFFERENT PROGRAMMER NUMBER
SUBTTL	Read a UFD


REDUFD:	PUSHJ	P,SETUFD		;SET UP FOR UFD LOOKUP
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP UUO
	FILOP.	T1,			;TRY TO LOOKUP THE UFD
	  JRST	REDU.2			;CAN'T

REDU.1:	SKIPGE	T1,.UFQTF(AP)		;DEFAULTING FCFS?
	MOVE	T1,LKPFIL+.RBQTF	;GET FCFS QUOTA FROM RIB
	MOVEM	T1,.UFQTF(AP)		;SAVE IT
	SKIPGE	T1,.UFQTO(AP)		;DEFAULTING LOGGED-OUT QUOTA?
	MOVE	T1,LKPFIL+.RBQTO	;GET LOGGED-OUT QUOTA FROM RIB
	MOVEM	T1,.UFQTO(AP)		;SAVE IT
	SKIPGE	T1,.UFQTR(AP)		;DEFAULTING RESERVED QUOTA?
	MOVE	T1,LKPFIL+.RBQTR	;GET RESERVED QUOTA FROM RIB
	MOVEM	T1,.UFQTR(AP)		;SAVE IT
	MOVE	T1,LKPFIL+.RBUSD	;GET BLOCKS USED FROM RIB
	MOVEM	T1,.UFUSD(AP)		;SAVE IT
	PUSHJ	P,GETDTM		;EXTRACT UFD CREATION DATE/TIME
	MOVE	T1,[.DUFRE,,T2]		;SET UP UUO
	MOVE	T2,.UFSTR(AP)		;GET STR NAME
	MOVE	T3,.UFPPN(AP)		;GET PPN
	DISK.	T1,			;GET UFBTAL
	  SKIPA				;FAILED??
	CAMN	T1,[1B0]		;LOGGED IN PPN?
	PJRST	RELUFD			;NO--USE ASSUMED VALUE
	MOVE	T2,LKPFIL+.RBQTF	;GET FCFS QUOTA
	SUB	T2,T1			;COMPUTE BLOCKED USED
	MOVEM	T2,LKPFIL+.RBUSD	;UPDATE RIB
	PJRST	RELUFD			;RELEASE CHANNEL AND RETURN

REDU.2:	MOVX	T2,UF.NUE		;GET NO UFD EXISTS BIT
	IORM	T2,.UFFLG(AP)		;SET IT
	CAIN	T1,ERFNF%		;FILE NOT FOUND?
	PJRST	RELUFD			;THATS OK
	$ERR	(LFU)			;LOOKUP FAILED FOR UFD
SUBTTL	Rename the UFD


RENUFD:	MOVX	T1,UF.NUE		;GET THE NO FD CREATED BIT
	TDNE	T1,.UFFLG(AP)		;DID WE SET IT?
	POPJ	P,			;YES - THEN CAN'T RENAME THE UFD
	PUSHJ	P,SETUFD		;SET UP BLOCKS FOR UFD
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP AC
	FILOP.	T1,			;LOOKUP FILE
	  $ERR	(LFU)			;?LOOKUP FAILED FOR UFD
	MOVEI	T1,.FORNM		;GET REMANE FUNCTION
	HRRM	T1,FOPFIL+.FOFNC	;STORE IT
	MOVE	T1,[LKPFIL,,LKPBLK]	;SET UP BLT
	BLT	T1,LKPBLK+RIBSIZ-1	;COPY THE ENTIRE RIB
	MOVE	T1,[PTHFIL,,PTHBLK]	;SET UP BLT
	BLT	T1,PTHBLK+PTHSIZ-1	;COPY THE ENTIRE PATH

RENU.1:	MOVEI	T1,LKPBLK		;GET ADDRESS OF RENAME BLOCK
	HRLM	T1,FOPFIL+.FOLEB	;STORE IT
	MOVEI	T1,PTHFIL		;GET ADDRESS OF PATH BLOCK
	MOVEM	T1,LKPBLK+.RBPPN	;STORE IT

	SKIPL	T1,.UFPRO(AP)		;GET PROTECTION CODE TO SET
	DPB	T1,[POINTR (LKPBLK+.RBPRV,RB.PRV)] ;STORE IT
	SKIPL	T1,.UFQTF(AP)		;GET LOGGED-IN QUOTA
	MOVEM	T1,LKPBLK+.RBQTF	;STORE IT
	SKIPL	T1,.UFQTO(AP)		;GET LOGGED IN QUOTA
	MOVEM	T1,LKPBLK+.RBQTO	;STORE IT
	SKIPL	T1,.UFQTR(AP)		;GET RESERVED QUOTA
	MOVEM	T1,LKPBLK+.RBQTR	;STORE IT
	MOVE	T1,.UFUSD(AP)		;GET BLOCKS USED
	MOVEM	T1,LKPBLK+.RBUSD	;STORE IT
	SKIPL	T1,.UFDED(AP)		;GET DIRECTORY EXPIRATION DATE
	MOVEM	T1,LKPBLK+.RBDED	;STORE IT
	MOVE	T1,LKPBLK+.RBSTS	;GET STATUS WORD
	TXNN	T1,RP.NDL		;NO-DELETE TURNED ON?
	JRST	RENU.2			;NO
	MOVX	T2,UF.NDL		;GET THE NDL BIT
	IORM	T2,.UFFLG(AP)		;SET IT SO THE CALLER KNOWS THIS
	PJRST	RELUFD			;AND RETURN
RENU.2:	MOVE	T2,.UFFLG(AP)		;GET FLAG WORD
	LDB	T3,[POINTR (T2,UF.FNC)]	;GET FUNCTION CODE
	CAIN	T3,.UFMNT		;MOUNT?
	MOVX	T2,UF.LGI		;SET RIPLOG
	CAIN	T3,.UFDMO		;DISMOUNT?
	MOVX	T2,UF.LGO		;CLEAR RIPLOG
	TXNE	T2,UF.LGI		;LOGGING IN?
	TXO	T1,RP.LOG		;YES
	TXNE	T2,UF.LGO		;LOGGIN OUT?
	TXZ	T1,RP.LOG		;YES
	SKIPGE	RIBERR			;FIND ANY FILES WITH ERROR BITS ON?
	TDZ	T1,[RP.ERR,,RP.ERR]	;NO - CLEAR ERRORS
	MOVEM	T1,LKPBLK+.RBSTS	;STORE UPDATED STATUS BITS
	TLNN	T1,RP.ERR		;ANY FILE ERRORS IN THIS UFD?
	JRST	RENU.3			;NOPE
	MOVE	T1,["%",,'FEE']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |@A file errors exist|]
	PUSHJ	P,TEXT			;GENERATE TEXT

RENU.3:	PUSHJ	P,PUTDTM		;SET UFD CREATION DATE/TIME
	CAIE	T3,.UFDMO		;DISMOUNTING?
	JRST	RENU.4			;NOPE
	MOVE	T1,[.DUFRE,,T2]		;SET UP UUO
	MOVE	T2,.UFSTR(AP)		;GET STR NAME
	MOVE	T3,.UFPPN(AP)		;GET PPN
	MOVE	T4,LKPFIL+.RBQTF	;GET LOGGED IN QUOTA
	ADD	T4,LKPFIL+.RBQTR	;INCLUDE THE RESERVED QUOTA TOO
	SUB	T4,LKPFIL+.RBUSD	;COMPUTE BLOCKS FREE IF LOGGED OUT PPN
	DISK.	T1,			;RETURN FREE SPACE IN THE UFD
	  SKIPA				;CAN'T
	CAMN	T1,[1B0]		;LOGGED IN PPN?
	MOVE	T1,T4			;NO--USE ASSUMED VALUE
	CAME	T1,LKPFIL+.RBQTF	;REMAING = FCFS QUOTA?
	JRST	RENU.4			;DON'T ATTEMPT DELETE IF BLOCKS USED
	MOVEI	T1,.FODLT		;GET DELETE FUNCTION
	HRRM	T1,FOPFIL+.FOFNC	;SET IT

RENU.4:	SKIPN	RCPFLG			;DID WE RECOMPUTE?
	SETOM	LKPFIL+.RBUSD		;NO--DON'T CHANGE BLOCKS USED
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP AC
	FILOP.	T1,			;RENAME THE UFD
	  SKIPA				;CAN'T
	PJRST	RELUFD			;RELEASE THE CHANNEL AND RETURN
	MOVEM	T1,FOPERR		;SAVE THE ERROR CODE
	$ERR	(RFU)			;? RENAME FAILED TO UPDATE UFD
SUBTTL	Release a UFD channel


RELUFD:	MOVE	T1,[1,,T2]		;SET UP AC
	MOVE	T2,FOPFIL+.FOFNC	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL NUMBER
	HRRI	T2,.FOREL		;GET NEW FUNCTION CODE
	FILOP.	T1,			;RELEASE THE CHANNEL
	  JFCL				;IGNORE ERRORS
	POPJ	P,			;RETURN
SUBTTL	Compress UFD


; Perform UFD compression
;
COMPRS:	PUSHJ	P,SETFIL		;SET UP SOME BLOCKS
	MOVEI	T1,.FOCRE		;CREATE FILE (NEVER SUPERSEDE)
	HRRM	T1,FOPFIL+.FOFNC	;STORE FUNCTION CODE
	MSTIME	T1,			;GET TIME IN MILLISECONDS
	AND	T1,[070707,,070707]	;MAKE IT NUMERIC
	TDO	T1,[SIXBIT/000000/]	;TURN ON SOME BITS
	MOVEM	T1,LKPFIL+.RBNAM	;STORE AS THE FILE NAME
	HRLZI	T1,'TMP'		;A TEMPORARY EXTENSION
	MOVEM	T1,LKPFIL+.RBEXT	;STORE IT
	MOVE	T1,.UFPPN(AP)		;GET THE PPN
	MOVEM	T1,PTHFIL+.PTPPN	;STORE IT
	SETZM	PTHFIL+.PTSFD		;TERMINATE PATH
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP AC
	FILOP.	T1,			;CREATE THE FILE
	  SKIPA				;CAN'T
	JRST	COMP.0			;ONWARD
	CAIN	T1,ERNRM%		;NO ROOM?
	JRST	COMP.3			;WE MUST HAVE JUST CREATED THE UFD
	JRST	COMP.1			;ELSE WE HAVE A REAL ERROR

COMP.0:	MOVE	T1,[.DUUFD,,T2]		;SET UP AC
	LDB	T2,[POINTR (FOPFIL+.FOFNC,FO.CHN)] ;GET CHANNEL NUMBER
	DISK.	T1,			;TELL MONITOR UFD COMPRESSION WANTED
	  JRST	COMP.1			;CAN'T
	MOVE	T1,[1,,T2]		;SET UP AC
	MOVE	T2,FOPFIL+.FOFNC	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL
	HRRI	T2,.FOREL		;LOAD FUNCTION CODE
	FILOP.	T1,			;RELEASE CHANNEL AND COMPRESS UFD
	  JRST	COMP.1			;CAN'T
	JRST	COMP.2			;FINISH UP
COMP.1:	MOVE	T1,["%",,'CCU']		;FLAG AS WARNING
	MOVEI	T2,[ASCIZ |Could not perform UFD compression on @D.UFD|]
	PUSHJ	P,TEXT			;GENERATE TEXT

COMP.2:	MOVE	T1,[FO.PRV!FO.ASC+.FODLT] ;GET RENAME FUNCTION
	MOVEM	T1,FOPFIL+.FOFNC	;STORE IT
	MOVEI	T1,RENFIL		;POINT TO RENAME BLOCK
	HRLM	T1,FOPFIL+.FOLEB	;STORE IT
	MOVE	T1,[FOPSIZ,,FOPFIL]	;SET UP AC
	FILOP.	T1,			;DELETE THE FILE
	  JFCL

COMP.3:	MOVE	T1,[1,,T2]		;SET UP AC
	MOVE	T2,FOPFIL+.FOFNC	;GET FUNCTION WORD
	ANDX	T2,FO.CHN		;KEEP JUST THE CHANNEL
	HRRI	T2,.FOREL		;LOAD FUNCTION CODE
	FILOP.	T1,			;RELEASE CHANNEL
	  JFCL				;IGNORE ERRORS
	PJRST	SETFIL			;RESET FILE BLOCKS AND RETURN
SUBTTL	UFD date/time handling


; Get the UFD creation date/time
;
GETDTM:	LDB	T1,[POINTR (LKPFIL+.RBPRV,RB.CRD)] ;GET LOW DATE
	LDB	T2,[POINTR (LKPFIL+.RBPRV,RB.CRT)] ;GET TIME
	LDB	T3,[POINTR (LKPFIL+.RBEXT,RB.CRX)] ;GET HIGH DATE
	LSH	T3,^D12			;SHIFT IT OVER
	IORI	T1,(T3)			;OR INTO RESULT
	MOVEM	T1,.UFCDT(AP)		;SAVE THE DATE
	MOVEM	T2,.UFCTM(AP)		;SAVE THE TIME
	POPJ	P,			;RETURN


; Store the UFD creation date/time
;
PUTDTM:	DATE	T1,			;GET DATE IN 15 BIT FORMAT
	DPB	T1,[POINTR (LKPBLK+.RBPRV,RB.CRD)] ;SAVE LOW DATE
	LSH	T1,-^D12		;SHIFT OFF 12 BITS
	DPB	T1,[POINTR (LKPBLK+.RBEXT,RB.CRX)] ;SAVE HIGH DATE
	MSTIME	T1,			;GET CURRENT TIME IN MILLISECONDS
	IDIVI	T1,^D60000		;CONVERT TO MINUTES
	DPB	T1,[POINTR (LKPBLK+.RBPRV,RB.CRT)] ;SAVE TIME
	POPJ	P,			;RETURN
SUBTTL	Random messages


MNTMSG:	MOVE	T1,["[",,'MNT']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Structure @A mounted|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


DMOMSG:	MOVE	T1,["[",,'DMO']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Structure @A dismounted|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


RCPMSG:	MOVE	T1,["[",,'RDU']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Recomputing disk usage|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


QTAMSG:	MOVE	T1,.UFFLG(AP)		;GET FLAG WORD
	TXNE	T1,UF.NUE		;DOES A UFD EXIST?
	JRST	NUSMSG			;NO UFD ON STRUCTURE
	MOVE	T1,["[",,'QTA']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |@A@I|]	;GET TEXT
	MOVX	T3,UF.TSP		;GET A BIT
	TDNE	T3,.UFFLG(AP)		;WANT BOTH STR AND PPN IN MESSAGE?
	MOVEI	T2,[ASCIZ |@D@I|]	;YES
	PJRST	TEXT			;GENERATE TEXT AND RETURN

NUSMSG:	MOVE	T1,["%",,'NUS']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |No UFD exists on structure @A|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


ASLMSG:	MOVE	T1,["[",,'ASL']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Structure @A added to the system search list|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


RSLMSG:	MOVE	T1,["[",,'RSL']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Structure @A removed from the system search list|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


AJLMSG:	MOVE	T1,["[",,'AJL']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Structure @A added to the search list of job @F|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


RJLMSG:	MOVE	T1,["[",,'RJL']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Structure @A removed from the search list of job @F|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN
SUBTTL	Set and clear UFD interlocks


; Set UFD interlock
;
LOKUFD:	MOVX	T1,UF.NLK		;WANT TO INTERLOCK THE UFD?
	TDNE	T1,.UFFLG(AP)		;CHECK
	POPJ	P,			;NOPE - CALLER SHOULD HAVE DONE IT
	PUSHJ	P,ULOCK			;INTERLOCK THE UFD
	  JRST	LOKU.1			;CAN'T
	AOS	LOKFLG			;REMEMBER UFD INTERLOCKED
	POPJ	P,			;RETURN

LOKU.1:	MOVE	T1,["%",,'CSU']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Can't set UFD interlock for @D|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


; Clear UFD interlock
;
CLRUFD:	SKIPN	LOKFLG			;HAVE THE INTERLOCK?
	POPJ	P,			;NO
	PUSHJ	P,UNLOCK		;RELEASE THE UFD INTERLOCK
	  JRST	CLRU.1			;CAN'T
	SETZM	LOKFLG			;CLEAR INTERLOCK FLAG
	POPJ	P,			;RETURN

CLRU.1:	MOVE	T1,["%",,'CCU']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Can't clear UFD interlock for @D|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


; Set the UFD interlock (called only by UFDLOK and LOKUFD)
;
ULOCK:	MOVE	T1,[3,,T2]		;SET UP AC
	MOVX	T2,.FSULK		;GET FUNCTION CODE
	MOVE	T3,.UFSTR(AP)		;GET STRUCTURE NAME
	MOVE	T4,.UFPPN(AP)		;GET PPN
	STRUUO	T1,			;SET INTERLOCK
	  POPJ	P,			;RETURN
	JRST	CPOPJ1			;RETURN


; Clear the UFD interlock (called only by UFDCLR and CLRUFD)
;
UNLOCK:	MOVE	T1,[3,,T2]		;SET UP AC
	MOVX	T2,.FSUCL		;GET FUNCTION CODE
	MOVE	T3,.UFSTR(AP)		;GET STRUCTURE NAME
	MOVE	T4,.UFPPN(AP)		;GET PPN
	STRUUO	T1,			;CLEAR INTERLOCK
	  POPJ	P,			;CAN'T
	JRST	CPOPJ1			;RETURN
SUBTTL	Recompute checking


; Here to see if we need to recompute disk usage.
; Call:	PUSHJ	P,RCPCHK
;	<NON-SKIP>	;RECOMPUTING NOT NECESSARY
;	<SKIP>		;NEED TO RECOMPUTE
;
RCPCHK:	MOVE	T1,.UFFLG(AP)		;GET FLAG WORD
	TXNE	T1,UF.NUE		;DOES A UFD EXIST?
	POPJ	P,			;THEN WE CAN'T RECOMPUTE
	TXNE	T1,UF.ARD		;ALWAYS RECOMPUTE DISK USAGE?
	JRST	RCPC.5			;YES
	TXNE	T1,UF.NRD		;NEVER RECOMPUTE DISK USAGE?
	POPJ	P,			;THATS RIGHT
	TXNE	T1,UF.AIS		;STR ALREADY IN S/L?
	JRST	RCPC.2			;YES

RCPC.1:	MOVE	T1,.UFSTR(AP)		;GET STR NAME
	LDB	T2,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
	CAIE	T2,.UFRDU		;JUST RECOMPUTING DISK USAGE?
	PUSHJ	P,FINDOS		;SEE IF IT'S IN OUR SEARCH LIST ALREADY

RCPC.2:	SKIPA	T1,[RP.LOG]		;IT ISN'T - GET LOGGED IN BIT
	SETZ	T1,			;SKIP RIPLOG TEST SINCE ALREADY MOUNTED
	SKIPGE	T2,.UFQTO(AP)		;GET DESIRED LOGGED-OUT QUOTA
	MOVE	T2,LKPFIL+.RBQTO	;IT'S DEFAULTED - USE WHAT THE RIB HAS
	LDB	T3,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
	CAIN	T3,.UFMNT		;TEST RIPLOG ONLY ON A MOUNT
	TDNN	T1,LKPFIL+.RBSTS	;WAS LAST USE LOGGED-OUT CLEANLY?
	SKIPGE	T1,LKPFIL+.RBUSD	;GET BLOCKS USED
	MOVE	T1,[377777,,777777]	;GET +INFINITY TO FORCE RECOMP
	CAMG	T1,T2			;USED MORE THAN LOGGED-OUT QUOTA?
	POPJ	P,			;NO - THEN WE'RE OK

RCPC.3:	MOVE	T1,.UFSTR(AP)		;GET STR NAME
	MOVEM	T1,GOBBLK+.DFGNM	;SAVE IT
	MOVE	T1,.UFPPN(AP)		;GET THE PPN
	MOVEM	T1,GOBBLK+.DFGPP	;SAVE IT
	MOVN	T1,HGHJOB		;GET -NUMBER OF JOBS
	HRLZS	T1			;MAKE AN AOBJN POINTER
	ADDI	T1,1			;START WITH JOB 1
	MOVE	T2,.UFJOB(AP)		;GET JOB NUMBER

RCPC.4:	HRRZM	T1,GOBBLK+.DFGJN	;SAVE THE JOB NUMBER
	MOVE	T3,[.DFGNM+1,,GOBBLK]	;SET UP UUO
	CAIE	T2,0(T1)		;WANT TO IGNORE THIS JOB?
	GOBSTR	T3,			;IS THE STR IN THIS JOB'S S/L?
	  AOBJN	T1,RCPC.4		;NO - ONTO THE NEXT JOB
	SKIPGE	T1			;FOUND ANOTHER USER USING THE STR?
	POPJ	P,			;NO

RCPC.5:	SETOM	RIBERR			;INIT ERROR BIT COUNTER
	SETOM	RCPFLG			;FLAG RECOMPUTING
	JRST	CPOPJ1			;RETURN AND RECOMPUTE DISK USAGE
SUBTTL	Check for over quota on dismount


QTACHK:	MOVE	T1,[.DUFRE,,T2]		;SET UP UUO
	MOVE	T2,.UFSTR(AP)		;GET STR NAME
	MOVE	T3,.UFPPN(AP)		;GET PPN
	DISK.	T1,			;RETURN FREE SPACE IN THE UFD
	  POPJ	P,			;CAN'T - BYPASS QUOTA CHECK
	CAMN	T1,[1B0]		;LOGGED IN PPN?
	POPJ	P,			;NO - BYPASS QUOTA CHECK
	MOVNS	T1			;MAKE IT NEGATIVE
	ADD	T1,.UFQTF(AP)		;BLOCKS USED = FCFS - FREE
;	ADD	T1,.UFQTR(AP)		;INCLUDE RESERVED BLOCKS
	MOVEM	T1,.UFUSD(AP)		;SAVE BLOCKS USED
	SUB	T1,.UFQTO(AP)		;TAKE OFF LOGGED-OUT QUOTA
	JUMPLE	T1,CPOPJ		;RETURN IF NOT OVER QUOTA

QTAC.1:	MOVEM	T1,OVRQTA		;SAVE AMOUNT WE'RE OVER QUOTA BY
	MOVE	T1,["%",,'OVQ']		;GET SEVERITY CHARACTER AND PREFIX
	MOVEI	T2,[ASCIZ |Over quota by @H blocks|] ;GET TEXT
	PUSHJ	P,TEXT			;GENERATE TEXT
	MOVX	T1,UF.NOQ		;GET NO QUOTA CHECKING BIT
	TDNE	T1,.UFFLG(AP)		;FORCE DISMOUNT ANYWAY?
	POPJ	P,			;RETURN
	$ERR	(SND)			;? STRUCTURE NOT DISMOUNTED
SUBTTL	Directory and File error processing


; Here on a directory I/O error
;
DIRIOE:	MOVEM	T1,IOS			;SAVE I/O STATUS
	MOVEI	T1,FOPBLK(P1)		;GET FILOP BLOCK ADDRESS
	MOVEM	T1,FOPADR		;SAVE IT
	MOVE	T1,["%",,'IOE']		;FLAG I/O ERROR AS WARNING
	MOVEI	T2,[ASCIZ |Directory I/O error @B for @J|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN


; Here when a file lookup fails
;
FILERR:	SKIPA	T2,[FOPFIL]		;POINT TO FILOP BLOCK


; Here when a directory lookup fails
;
DIRERR:	MOVEI	T2,FOPBLK(P1)		;POINT TO FILOP BLOCK
	MOVEM	T2,FOPADR		;SAVE ADDRESS
	MOVEM	T1,FOPERR		;SAVE FILOP ERROR CODE
	MOVE	T1,["%",,'LKP']		;FLAG LOOKUP ERROR AS A WARNING
	MOVEI	T2,[ASCIZ |LOOKUP error (@E) for @J|]
	PJRST	TEXT			;GENERATE TEXT AND RETURN
SUBTTL	Text generation routines



; Build a text message
; Call:	MOVE	T1, severity chr,,prefix
;	MOVEI	T2, address of ASCIZ text
;	PUSHJ	P,TEXT
;
TEXT:	MOVEM	T1,.UFPFX(AP)		;SAVE PREFIX
	MOVE	T1,[TXTBUF,,TXTBUF+1]	;SET UP BLT
	SETZM	TXTBUF			;CLEAR THE FIRST WORD
	BLT	T1,TXTBUF+BUFSIZ-1	;CLEAR TEH ENTIRE BLOCK
	MOVE	BP,[POINT 7,TXTBUF]	;SET UP BYTE POINTER
	HRLI	T2,(POINT 7,)		;MAKE A BYTE POINTER
	MOVEM	T2,TXTPTR		;SAVE IT

TEXT.1:	ILDB	T1,TXTPTR		;GET A CHARACTER
	JUMPE	T1,TEXT.3		;DONE IF END OF STRING
	CAIN	T1,"@"			;SPECIAL FLAG CHARACTER?
	JRST	TEXT.2			;YES
	PUSHJ	P,TCHAR			;TYPE NORMAL CHARACTER
	JRST	TEXT.1			;LOOP

TEXT.2:	ILDB	T1,TXTPTR		;GET NEXT CHARACTER
	JUMPE	T1,TEXT.3		;SHOULDN'T NEED THIS CHECK
	SUBI	T1,"A"			;COMPUTE INDEX
	PUSHJ	P,@TXTTAB(T1)		;PROCESS SPECIAL TYPEOUT
	JRST	TEXT.1			;LOOP

TEXT.3:	SKIPE	.UFTYO(AP)		;WANT TO SEE THIS?
	PUSHJ	P,@.UFTYO(AP)		;INFORM CALLING PROGRAM
	POPJ	P,			;RETURN


TXTTAB:	EXP	TSTRUC			;A - STRUCTURE
	EXP	TIOS			;B - I/O STATUS
	EXP	TPPN			;C - PPN
	EXP	TSTPPN			;D - STR:[PPN]
	EXP	TFOPER			;E - FILOP ERROR
	EXP	TJOBN			;F - JOB NUMBER
	EXP	TFUNCT			;G - FUNCTION CODE
	EXP	TOVERQ			;H - OVER QUOTA
	EXP	TQUOTA			;I - QUOTAS
	EXP	TFILE			;J - FILESPEC
	EXP	TTEXT			;K - TEXT


; Character output
;
TCHAR:	CAME	BP,[POINT 7,TXTBUF+BUFSIZ-1,27] ;BUFFER FULL?
	IDPB	T1,BP			;NO - STORE CHARACTER
	POPJ	P,			;RETURN


; Sixbit output
;
TSIXW:	SKIPN	T2,T1			;PUT IN A BETTER PALCE
	POPJ	P,			;NOTHING TO OUTPUT
TSIX.1:	LSHC	T1,6			;SHIFT IN A CHARACTER
	ANDI	T1,77			;STRIP OFF JUNK
	ADDI	T1," "			;MAKE IT ASCII
	PUSHJ	P,TCHAR			;STORE IT
	JUMPN	T2,TSIX.1		;CONTINUE IF MORE
	POPJ	P,			;RETURN


; String output routine
;
TSTRG:	TXO	T1,<POINT 7>		;MAKE A BYTE POINTER
	PUSH	P,T1			;SAVE IT
TSTR.1:	ILDB	T1,(P)			;GET A CHARACTER
	JUMPE	T1,TSTR.2		;DONE?
	PUSHJ	P,TCHAR			;STORE CHARACTER
	JRST	TSTR.1			;LOOP
TSTR.2:	POP	P,T1			;TRIM STACK
	POPJ	P,			;RETURN


; Decimal and octal output
;
TDECW:	SKIPA	T3,[12]			;RADIX 10
TOCTW:	MOVEI	T3,10			;RADIX 8
TRDXW:	IDIVI	T1,(T3)			;DIVIDE BY RADIX
	HRLM	T2,(P)			;STORE REMAINDER ON STACK
	SKIPE	T1			;DONE?
	PUSHJ	P,TRDXW			;NO - RECURSE
	HLRZ	T1,(P)			;GET A CHARACTER
	ADDI	T1,"0"			;MAKE IT ASCII
	PJRST	TCHAR			;STORE TI AND RETURN
; PPN output
;
TPPNW:	PUSH	P,T1			;SAVE PPN
	MOVEI	T1,"["			;GET BRACKET
	PUSHJ	P,TCHAR			;TYPE IT
	POP	P,T1			;GET PPN
	PUSHJ	P,THLFW			;TYPE HALF WORDS
	MOVEI	T1,"]"			;GET BRACKET
	PJRST	TCHAR			;TYPE IT AND RETURN

; Type word as half words
;
THLFW:	PUSH	P,T1			;SAVE WORD
	HLRZS	T1			;GET LH
	PUSHJ	P,TOCTW			;TYPE IT
	MOVEI	T1,","			;SET SEPARATOR
	PUSHJ	P,TCHAR			;TYPE IT
	POP	P,T1			;GET WORD BACK
	HRRZS	T1			;GET RH
	PJRST	TOCTW			;TYPE IT AND RETURN
; Structure output
;
TSTRUC:	MOVE	T1,.UFSTR(AP)		;GET STR NAME
	PJRST	TSIXW			;TYPE IT AND RETURN


; Type STR:[PPN]
;
TSTPPN:	MOVE	T1,.UFSTR(AP)		;GET STRUCTURE NAME
	PUSHJ	P,TSIXW			;TYPE IT
	MOVEI	T1,":"			;GET A COLON
	PUSHJ	P,TCHAR			;SEPARATE FROM PPN


; Type [PPN] from argument block
;
TPPN:	MOVE	T1,.UFPPN(AP)		;GET PPN
	PJRST	TPPNW			;TYPE IT AND RETURN


; Type FILOP. UUO error code
;
TFOPER:	MOVE	T1,FOPERR		;GET FILOP ERROR
	PJRST	TOCTW			;TYPE IT AND RETURB

; Type job nnn
;
TJOBN:	MOVE	T1,.UFJOB(AP)		;GET JOB NUMBER
	PJRST	TDECW			;TYPE IT AND RETURN


; Type function code
;
TFUNCT:	LDB	T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
	PJRST	TOCTW			;TYPE IT AND RETURN


; Type blocks over quota
;
TOVERQ:	MOVE	T1,OVRQTA		;GET NUMBER OF BLOCKS
	PJRST	TDECW			;TYPE IT AND RETURN
; Type quotas
;
TQUOTA:	MOVEI	T4,0			;CLEAR COUNTER

TQUO.1:	HRRZ	T1,QTATAB(T4)		;GET SOME TEXT
	PUSHJ	P,TSTRG			;TYPE IT
	HLRZ	T1,QTATAB(T4)		;GET AN INDEX
	ADDI	T1,(AP)			;OFFSET INTO BLOCK
	MOVE	T1,(T1)			;GET A NUMBER
	CAMN	T1,[.INFIN]		;+INFINITY?
	JRST	TQUO.2			;YES - MAKE IT PRETTY
	PUSHJ	P,TDECW			;TYPE IT
	JRST	TQUO.3			;SEE IF WE'RE FINISHED

TQUO.2:	MOVEI	T1,[ASCIZ |infinity|]	;LOOKS BETTER THAN A LARGE NUMBER
	PUSHJ	P,TSTRG			;TYPE TEXT

TQUO.3:	CAIGE	T4,QTAMAX		;DONE?
	AOJA	T4,TQUO.1		;NO - GO ON
	POPJ	P,			;RETURN

; Macro to build QTATAB
;
DEFINE	$QTA	(IDX,TXT),<XWD	.UF'IDX,[ASCIZ | 'TXT':|]>


; Table of quota indicies and text strings
;
QTATAB:	$QTA	(QTF,<In>)		;LOGGED-IN
	$QTA	(QTO,<Out>)		;LOGGED-OUT
;	$QTA	(QTR,<Reserved>)	;RESERVED
	$QTA	(USD,<Used>)		;USED
QTAMAX==.-QTATAB-1			;LENGTH OF TABLE
; Type text
;
TTEXT:	MOVE	T1,TXTADR		;GET ADDRESS
	PJRST	TSTRG			;TYPE IT AND RETURN


; Type I/O status
;
TIOS:	MOVEI	T1,"("			;GET LEFT PARENTHESIS
	PUSHJ	P,TCHAR			;TYPE IT
	HRLZ	T1,IOS			;GET I/O STATUS WORD
	JFFO	T1,.+1			;GET NUMBER OF LEADING ZEROS
	IDIVI	T2,3			;GET NUMBER OF LEADING DIGITS
	SKIPA	T1,["0"]		;MAKE ZERO THE LEADING DIGIT
	PUSHJ	P,TCHAR			;TYPE A ZERO
	SOJGE	T2,.-1			;LOOP
	MOVEI	T1,")"			;GET RIGHT PARENTHESIS
	PJRST	TCHAR			;TYPE IT AND RETURN
; Filespec output
;
TFILE:	MOVE	T4,FOPADR		;COPY FILOP BLOCK ADDRESS
	MOVE	T1,.UFSTR(AP)		;ALWAYS GET STRUCTURE NAME FROM HERE
	PUSHJ	P,TSIXW			;TYPE IT
	MOVEI	T1,":"			;TERMINATE IT PROPERLY
	PUSHJ	P,TCHAR			;STORE COLON
	MOVE	T1,.FOLEB(T4)		;POINT TO LOOKUP BLOCK
	MOVEI	T2,TSIXW		;ASSUME SIXBIT
	HLRZ	T3,.RBEXT(T1)		;GET EXTENSION
	MOVE	T1,.RBNAM(T1)		;AND FILE NAME
	CAIN	T3,'UFD'		;A DIRECTORY?
	MOVEI	T2,TPPNW		;ITS A PPN
	PUSHJ	P,(T2)			;TYPE FILE NAME

	MOVEI	T1,"."			;GET A PERIOD
	PUSHJ	P,TCHAR			;STORE IT
	MOVE	T1,.FOLEB(T4)		;POINT TO LOOKUP BLOCK
	HLLZ	T1,.RBEXT(T1)		;GET EXTENSION
	PUSHJ	P,TSIXW			;TYPE IT
	HLRZ	T1,.RBEXT(T1)		;GET EXTENSION AGAIN
	CAIN	T1,'UFD'		;A UFD?
	POPJ	P,			;YES - ALL DONE
	MOVE	T1,.FOLEB(T4)		;POINT TO LOOKUP BLOCK
	MOVE	T4,.RBPPN(T1)		;POINT TO PATH BLOCK
	MOVEI	T1,"["			;GET BRACKET
	PUSHJ	P,TCHAR			;TYPE IT
	MOVE	T1,.PTPPN(T4)		;GET PPN
	PUSHJ	P,THLFW			;TYPE AS HALF WORDS
	MOVEI	T4,.PTSFD(T4)		;POINT TO START OF SFDS

TFIL.2:	SKIPN	(T4)			;HAVE AN SFD?
	JRST	TFIL.3			;NO - DONE
	MOVEI	T1,","			;GET A COMMA
	PUSHJ	P,TCHAR			;STORE IT
	MOVE	T1,(T4)			;GET SFD
	PUSHJ	P,TSIXW			;TYPE IT
	AOJA	T4,TFIL.2		;LOOP FOR MORE

TFIL.3:	MOVEI	T1,"]"			;GET A BRACKET
	PJRST	TCHAR			;TERMINATE PATH PROPERLY AND RETURN
SUBTTL	Error processing


ERRPRC:	MOVEI	T1,@(P)			;GET CALLER'S PC
	HRRZ	T1,(T1)			;GET ERROR CODE IN RH
	MOVEM	T1,.UFERR(AP)		;STORE IN ARGUMENT BLOCK
	HLRZ	T1,ERRTAB-1(T1)		;GET PERFIX
	HRLI	T1,"?"			;FLAG IT AS FATAL
	MOVE	T2,.UFERR(AP)		;GET THE ERROR CODE
	HRRZ	T2,ERRTAB-1(T2)		;GET ERROR TEXT ADDRESS
	PUSHJ	P,TEXT			;GENERATE TEXT
	PUSHJ	P,KILCHN		;KILL OFF ANY OPEN CHANNELS
	PUSHJ	P,CLRUFD		;CLEAR ANY UFD INTERLOCK WE MIGHT OWN
	JRST	ERRXIT			;MAKE A QUICK EXIT


; Kill off any open channels the might be left around when
; an error occurs
;
KILCHN:	MOVEI	T1,FOPBLK		;POINT TO START OF FILOP BLOCKS
	MOVEI	T2,DIRLVL		;GET DIRECTORY LEVEL COUNT

KILC.1:	MOVE	T3,[1,,T4]		;SET UP AC
	MOVE	T4,.FOFNC(T1)		;GET FUNCTION WORD
	ANDX	T4,FO.CHN		;KEEP JUST THE CHANNEL NUMBER
	JUMPE	T4,KILC.2		;WE NEVER USE CHANNEL 0
	HRRI	T4,.FOREL		;GET NEW FUNCTION CODE
	FILOP.	T3,			;RELEASE THE CHANNEL
	  JFCL				;IGNORE ERRORS

KILC.2:	ADDI	T1,FOPSIZ		;POINT TO NEXT FILOP BLOCK
	SOJG	T2,KILC.1		;LOOP
	MOVEI	T1,FOPFIL		;POINT TO SPECIAL FILOP BLOCK
	JUMPE	T2,KILC.1		;RELEASE THAT CHANNEL TOO
	POPJ	P,			;RETURN
; Macro to build ERRTAB
;
DEFINE	$ERRS	(PFX,TXT),<''PFX'',,[ASCIZ |TXT|]>


; Table of error strings
;
ERRTAB:
$ERRS	(IDV,<Illegal device "@A">)			;(01) UFIDV%
$ERRS	(ISN,<Improper structure name "@A">)		;(02) UFISN%
$ERRS	(IOE,<Directory I/O error @B>)			;(03) UFIOE%
$ERRS	(CAD,<Can't access directory>)			;(04) UFCAD%
$ERRS	(LFU,<LOOKUP error (@E) for @D.UFD>)		;(05) UFLFU%
$ERRS	(RFU,<RENAME error (@E) for @D.UFD>)		;(06) UFLFU%
$ERRS	(CRS,<Can't read search list for job @F>)	;(07) UFCRS%
$ERRS	(IFC,<Illegal function code (@G)>)		;(10) UFIFC%
$ERRS	(EFU,<ENTER error (@E) for @D.UFD>)		;(11) UFEFU%
$ERRS	(CCS,<Can't change search list>)	 	;(12) UFCCS%
$ERRS	(CSO,<Can't reset original search list after structure status change failed>) ;(14) UFCSO%
$ERRS	(CSS,<Can't change structure status for @D>)	;(14) UFCSS%
$ERRS	(SND,<Structure @A not dismounted>)		;(15) UFSND%
$ERRS	(UBT,<UFD interlock for @A is busy too long>)	;(16) UFUBT%
$ERRS	(UIC,<UFD interlock for @A cannot be cleared>)	;(17) UFUIC%
$ERRS	(PGF,<Programmer number generation failed>)	;(20) UFPGF%
SUBTTL	Data storage


	LIT


	RELOC	0

USRACS:	BLOCK	20			;USER ACS

ZBEG:!					;START OF BLOCK TO CLEAR

MFDPPN:	BLOCK	1			;MFD PPN
SYSPPN:	BLOCK	1			;SYS PPN
HGHJOB:	BLOCK	1			;HIGHEST JOB NUMBER IN USE
SLFFLG:	BLOCK	1			;SELF (OUR JOB)
LOKFLG:	BLOCK	1			;UFD INTERLOCK FLAG
OVRQTA:	BLOCK	1			;BLOCKS OVER QUOTA
RCPFLG:	BLOCK	1			;RECOMPUTING FLAG
RIBERR:	BLOCK	1			;COUNTER OF ERRORS FOUND IN RIBS
TOPERR:	BLOCK	1			;TOPLEVEL DIRECTORY ERROR CODE
LEVEL:	BLOCK	1			;CURRENT LEVEL
FUNBLK:	BLOCK	DIRLVL			;FILOP FUNCTION WORDS
FOPBLK:	BLOCK	FOPSIZ*DIRLVL		;FILOP BLOCKS
LKPBLK:	BLOCK	<RIBSIZ+1>*DIRLVL	;LOOKUP BLOCKS
DIRBLK:	BLOCK	DIRLVL			;CURRENT DIRECTORY BLOCK NUMBER
IDXBLK:	BLOCK	DIRLVL			;INDEX INTO BUFFER
PTHBLK:	BLOCK	PTHSIZ			;PATH BLOCK
DCHBLK:	BLOCK	DCHSIZ			;DSKCHR BLOCK
IOLIST:	BLOCK	2			;I/O COMMAND LIST
DSKBUF:	BLOCK	BLKSIZ			;DISK BUFFER

IOS:	BLOCK	1			;I/O STATUS ON INPUT ERRORS
FOPADR:	BLOCK	1			;FILOP BLOCK ADDRESS FOR TYPEOUT
FOPERR:	BLOCK	1			;FILOP ERROR CODE
FOPFIL:	BLOCK	FOPSIZ			;FILOP BLOCK FOR FILE LOOKUPS
LKPFIL:	BLOCK	RIBSIZ+1		;LOOKUP BLOCK FOR FILE LOOKUPS
PTHFIL:	BLOCK	PTHSIZ			;PATH BLOCK FOR FILE LOOKUPS
RENFIL:	BLOCK	RIBSIZ+1		;LOOKUP BLOCK FOR FILE RENAMES

TXTPTR:	BLOCK	1			;TEXT PROCESSOR BYTE POINTER
TXTADR:	BLOCK	1			;ASCIZ TEXT STRING ADDRESS
TXTBUF:	BLOCK	BUFSIZ			;TEXT BUFFER

BPC:	BLOCK	1			;BLOCKS PER CLUSTER
USZ:	BLOCK	1			;UNIT SIZE
CPU:	BLOCK	1			;CLUSTERS PER UNIT
RIBBLK:	BLOCK	BLKSIZ			;HOLDS A RIB
SUPFOP:	BLOCK	FOPSIZ			;FILOP BLOCK FOR SUPER I/O

OLDSL:	BLOCK	SLSIZE			;OLD SEARCH LIST BLOCK
NEWSL:	BLOCK	SLSIZE			;NEW SEARCH LIST BLOCK
GOBBLK:	BLOCK	.DFGST+1		;GOBSTR UUO BLOCK

ZEND:!					;END OF BLOCK TO CLEAR

	END