TAD I	LOJOBP		/PICK UP PROJ,PROG NUMBER
	JMS I	UTS01		/SEARCH UFD TABLE
	JMP	LGO2		/OOPS!! MIGHT AS WELL TRY TO LEAVE GRACEFULLY
	ISZ I	UTPRNU		/REMOVE THIS JOB FROM ACCESS COUNT
	JMP	LGO2
	CLA CMA			/LAST USER ACCESSING THIS UFD
	TAD	UTPRNU
	JMS I	TF01		/FREE THE UFD TABLE ENTRY
LGO2,	CLA
	DCA I	LOJOBP		/REMOVE USER FROM JOB TABLE
	TAD	LGO4A		/KLUDGE FIEXIT TO RETURN TO LGO4
	DCA	LGKLUJ
TABOUT,	CLA CMA
	DCA	TABSTA		/FORCE TABLES OUT
	JMP I	FIEXIT
LOJOBP,	0

LOSRRI,	RTABLE
	0
LGO4A,	LGO4
LGO1A,	LGO1
LGKLUJ,	FIX500
LGRESA,	LGRES0
/ROUTINE TO OPEN A UFD

/CALLING SEQUENCE:
/	TAD (PROJ,PROG NUMBER)
/	JMS UFO0
/	ERROR RETURN (AC=0 IF TABLES FULL; OTHERWISE UFD NOT FOUND)
/	NORMAL RETURN (POSITION ON TABLE IN AC)

*3200

UFO0,	0
	JMS	UFO6		/GO GET THE RETR. INFO FOR THIS GUY'S UFD INTO CORE
	JMP I	UFO0		/COULDN'T GET IT
	DCA	UOBUFP		/POINTER TO RETRIEVAL INFORMATION
	TAD	UFDTBL
	IAC
	DCA	UOUFDP		/UFD TABLE POINTER
/SEARCH FOR A FREE SLOT IN UFDTBL
UFO3,	TAD I	UOUFDP
	SNA CLA
	JMP	UFO2		/FOUND A FREE SLOT ON THE TABLE
	TAD	UOUFDP		/THIS SLOT IS OCCUPIED
	TAD	P0004
	DCA	UOUFDP		/NEXT POSITION (ACCES COUNT ENTRY)
	TAD	UFDEND		/ARE WE AT THE END OF THE TABLE
	CMA
	TAD	UOUFDP
	SNA CLA			/HAVE WE SEARCHED THE WHOLE TABLE?
	JMP I	UFO0		/NO ROOM ON TABLE
	JMP	UFO3		/LOOK AT NEXT SLOT

/COMES HERE WITH UOUFDP POINTING TO A FREE SLOT IN UFDTBL
UFO2,	CLL STA RAL		/AC=-2
	TAD	UOUFDP		/BACK UP THE POINTER
	DCA	INDEX
	TAD	UFORET+1
	JMS I	UFQUOA		/LOAD THE UFD TABLE
	STA
	TAD	UFDTBL
	CIA
	TAD	INDEX
	CLL RTR
	DCA	UFO6		/RELATIVE POSITION ON TABLE
	TAD	UFO6
	JMS I	BLDP1		/GENERATE A PTR INTO RETTBL
	DCA	UFORET		/RETRIEVAL POINTER
	TAD	C7771
	DCA	CFH		/COUNTER FOR TRANSFER TO TABLE
/NOW MOVE RETRIEVAL INFORMATION FOR THIS GUY'S
/UFD INTO RETTBL
UFO4,	ISZ	UOBUFP
	TAD I	UOBUFP
	DCA I	UFORET
	ISZ	UFORET
	ISZ	CFH		/ENTIRE RETRIEVAL BLOCK TRANSFERRED?
	JMP	UFO4		/NO, KEEP IT UP
	ISZ	UFO0		/YES, PREPARE FOR NORMAL RETURN
	TAD	UFO6		/PICK UP RELATIVE POSITION
	JMP I	UFO0

UFORET,	0
	0
UFQUOA,	UFQUOT
UOUFDP=	UTPRNU
UOBUFP,	0


UFO6,	0
	DCA	UFORET+1	/SET UP CALLING SEQUENCE FOR MFD SEARCH
	TAD	RETTBL
	DCA	UFORET
	CMA
	JMS I	DS01		/ONE WORD MASTER FILE DIRECTORY SEARCH FOR PROJ,PROG MATCH
	UFORET
	JMP I	UFO6		/COULD NOT FIND UFD ENTRY
	TAD	P0004		/POINT AT DISK QUOTA WORD
	DCA	UFORET
	TAD I	UFORET
	AND	P0077		/SAVE ONLY LOGIN QUOTA
	DCA	SEGLIM		/SAVE FOR LATER
	TAD	P0003
	TAD	UFORET
	DCA	UFORET		/POINTER TO UFD RETRIEVAL INFORMATION
	TAD I	UFORET
	DCA	UFO1
	TAD	RETTBL		/POINTER TO RET. INFO OF FILE BEING SEARCHED (IN THIS CASE, THE MFD)
	JMS I	GE01		/GET RETRIEVAL INFORMATION INTO CORE
UFO1,	0
	ISZ	UFO6
	JMP I	UFO6
/ROUTINE TO SEARCH UFD TABLE FOR PROJ,PROG NUMBER

/CALLING SEQUENCE:
/	TAD (PROJ,PROG NUMBER)
/	JMS UTS0
/	NOT FOUND RETURN
/	NORMAL RETURN (RETRIEVAL POSITION IN AC)

UTS0,	0
	DCA	UTPR1		/PROJ,PROG NUMBER
	TAD	UFDTBL		/PTR TO HEAD OF UFDTBL
	DCA	UTUPTR
UTS1,	TAD	UFDEND		/END OF UFD TABLE
	CIA
	TAD	UTUPTR
	SNA CLA
	JMP I	UTS0		/COULD NOT FIND PROJ,PROG NUMBER ON TABLE
	TAD I	UTUPTR
	CIA
	TAD	UTPR1
	SNA CLA
	JMP	UTS3		/FOUND ENTRY, GET POINTER
	TAD	UTUPTR		/STEP UP ONE SLOT
	TAD	P0004
	DCA	UTUPTR
	JMP	UTS1		/LOOK IN THE NEXT ENTRY
UTS3,	TAD	UFDTBL
	CIA
	TAD	UTUPTR
	CLL RTR			/RELATIVE POSITION ON TABLE
	IAC			/THE RELATIVE POSITION
	ISZ	UTPRNU		/UTPRNU POINTS TO ACCESS COUNT OF THIS PROJ, PROG #
	ISZ	UTS0
	JMP I	UTS0

DVT1,
UTPR1,	0
UTUPTR=	UTPRNU

DVT0,	0			/COMPUTE DEVICE TIME AT RELEASE
	DCA	DVT1		/ELAPSED DEVICE TIME
	JMS I	JBLD0
	DCA	DVT3		/PROJ,PROG NUMBER OF CURRENT USER
	CLA CMA
	JMS I	DS01		/SEARCH MFD FOR PROJ,PROG NUMBER
	DVT4
	JMP I	DIRBAD		/***********DEBUG ONLY***********
	TAD	C0005
	DCA	CFH		/POINTER TO DEVICE TIME WORD
	TAD	DVT1
	TAD I	CFH		/UPDATE USER'S CUMULATIVE DEVICE TIME
	DCA I	CFH
	DCA	BUFMOD		/SCHEDULE WRITE
	DATFLD
	JMP I	DVT0

DVT4,	RTABLE
DVT3,	0



/COMES HERE IF FIP WAS CALLED BY S.I.
/READ S.I. BACK IN AND RETURN TO IT
FIX30,	CFLD			/CHANGE TO CURRENT FIELD
	TAD	C0603
	DCA	FLPARB		/SET UP READ IOT
	DCA	FLPARB+1	/SI IS ON TRACK 0 OF THE DISC
	JMS I	FIX401
	JMS I	FIO01		/RETURN WILL BE TO SI


SCL1,	0
	JMS I	RD301		/SET UP DISK PARAMETERS
	STA
	DCA	BUFSTA		/FUDGE TO APPEAR THAT READ WAS DONE
	JMP I	SCL1

RD301,	RD30
/EXIT ROUTINE
/COMES HERE WHEN FIP HAS COMPLETED ITS TASK
/FIRST, SEE IF ANY INTERNAL FILES HAVE BEEN CHANGED
/THOSE THAT HAVE CHANGED MUST BE WRITTEN BACK OUT TO DISC
*3400
/*** ANY DATA FIELD IS OK AT THIS POINT!!

FIX0,	JMS I	WRT1		/MAKE SURE THE BUFFER IS EMPTY
	ISZ	TABSTA		/CHECK TABLE STATUS
	JMP	FIX1		/NOTHING CHANGED IN TABLES
	TAD	JOBTAB		/BOTTOM OF TABLE AREA
	JMP	FIX2		/SAVE TABLES BEFORE EXIT

FIX1,	ISZ	SATSTA		/CHECK SAT STATUS
	JMP	FIX20		/NOTHING TO BE SAVED, EXIT
	TAD	SATBOT		/BOTTOM OF SAT
FIX2,	JMS I	FIX401
	TAD	FIDEXP		/GLOBAL TI "FIPDEX"
	DCA	FLPARB+1	/MEMORY FIELD
	TAD	C0605
	DCA	FLPARB		/WRITE IOT
	JMS I	FIO01		/PERFORM THE WRITE
	HLT			/ERROR ON WRITE, FATAL

/ALL DISC TABLES ARE NOW UP TO DATE (*** ANY DATA FIELD IS OK AT THIS POINT!!)
FIX20,	FGETJT
	JOBSTS
	DCA	FIOPTR
	DATFLD
	TAD I	FIOPTR
	AND	FISIOT
	DCA I	FIOPTR
	CFLD
	FGETJT			/RESTORE USER AC
	JOBREG+2
	DCA	FIOPTR		/ADDRESS OF USER'S AC
	TAD	FIUSAC
	DATFLD
	DCA I	FIOPTR
	CDF
	TAD	C002		/FIP ALWAYS RUNS IN FIELD 2 SO ADD 2 TO CORTBL
	TAD	CORTBA		/GLOBAL TO "CORTBL"
	DCA	FIOPTR		/POINTS TO THIS FIELD'S ENTRY IN CORTBL
	JMP I	.+1
FIX500,	FIX50

FISIOT,	-JSIOT-1
/ROUTINE TO DETERMINE IF A DEVICE IS ASSIGNED TO THIS JOB

/CALLING SEQUENCE:
/	TAD (DEVICE NUMBER)
/	JMS DTE0
/	0	(SET BY DTE0 TO POINT TO ENTRY IN DEVTBL)
/	RETURN (DEVICE NOT ASSIGNED TO THIS JOB)
/	RETURN (DEVICE ASSIGNED)

DTE0,	0
	SPA
	JMP	DTE10		/NON-TTY DEVICE
	TAD	NULNM1		/CHECK FOR VALID TTY NUMBER
	SMA
	JMP	DTE6		/INVALID TTY NUMBER
	CLL RAL			/TWO WORDS PER TTY
DTE4,	TAD	DEVEND		/FIND LOCATION IN DEVTBL
DTE5,	CFLD
	DCA I	DTE0		/RETURN ARGUMENT
	TAD I	DTE0
	ISZ	DTE0
	DCA	DTE2
	DATFLD
	TAD I	DTE2		/GET POINTER TO DDB
	SNA			/IS THERE ONE?
	JMP I	DTE0		/NO, RETURN
	DCA	DTE2		/YES
	ISZ	DTE2
	TAD I	DTE2		/GET JOB NUMBER
	CIA
	TAD	FIJOB		/NUMBER OF CURRENT JOB
	AND	P0037
	SNA CLA			/DOES DEVICE BELONG TO THIS JOB?
	ISZ	DTE0		/YES
	JMP I	DTE0		/RETURN
DTE6,	STA
	TAD	DEVTBA		/POINT TO DUMMY DEVTBL ENTRY
	JMP	DTE5


DTE2,	0
NULNM1,	-NULINE-1
P3777,	3777
NUDEVM,	DEVTBE-JOBTBL
NUDEV,	JOBTBL-DEVTBE

DTE10,	AND	P3777
	TAD	NUDEVM		/CHECK DEVICE NUMBER FOR VALIDITY
	SMA
	JMP	DTE6		/INVALID DEVICE NUMBER
	TAD	NUDEV		/GET DEVICE NUMBER BACK
	JMP	DTE4		/GO FINISH UP
LNK0,	0			/GET FILE LINKAGE
	TAD	LNKF
	DCA	LNK1
	FGETJT
LNK1,	0
	DCA	CFH
	DATFLD
	TAD I	CFH		/PTR TO FILE CONTROL BLOCK
	JMP I	LNK0
LNKF,	JOBF0
SAV1,
FGETJ0,	0
	CFLD
	TAD I	FGETJ0
	DCA	.+4
	TAD	JOBDAT
	CIF
	GETJTA
	0
	ISZ	FGETJ0
	JMP I	FGETJ0
SAVCRE,	0
	DCA	SAV1
	TAD	SAV1		/FILE ADDR
	TAD	P0004		/PTR TO PROTECTION BITS IN FILE
	DCA	SAV2
	TAD I	SAV2		/GET THE PROTECTION BITS
	AND	C0020		/IS IT WRITE PROTECTED AGAINST THE OWNER?
	SZA CLA
	JMP I	EXT10A		/YES, RETURN WITH PROT. VIOLATION MESSAGE
	TAD	SAV1		/NO, REDUCE THE FILE TO 0 SEGS
	JMS I	RED11		/GO DO REDUCTION
	JMP I	SAVCRE		/RETURN
RED11,	RED1
EXT10A,	EXT10
SAV2,
CRFUFD,	1
	JMS I	ACC01		/IS THIS ACCOUNT 1?
	JMP	CRFUF1		/YES
	IAC
	DCA I	INDEX		/FILE SIZE INITIALLY 1
	JMP I	CRFUFD		/BACK FOR THE DATE
CRFUF1,	DCA I	INDEX		/ZERO CPU TIME
	JMP I	.+1		/GO ZERO DEVICE TIME ALSO
	CRFUFR
/CONVERT AN ABSOLUTE PTR INTO RETTBL TO A RELATIVE ENTRY NUMBER
ENS3,	0
	CIA
	TAD	RETTBL		/REL. PTR TO ADDRESS WITHIN RETTBL
	CIA
	AND	P7770		/ANY POINTER WITHIN THE BLOCK IS OK
	CLL RTR
	RAR			/DIVIDE BY 8
	JMP I	ENS3
/ROUTINE TO ASSIGN A DEVICE

*3600
ASD1,	TAD	FIOSTK+1
	SMA			/TTY?
	JMP I	LGI201		/DON'T LET HIM/HER ASSIGN TTY'S! RETURN WITH AC=7777
	JMS I	DTE01		/IS THIS DEVICE ASSIGNED TO THIS JOB?
ASD2,	0			/SET BY DTE01 TO POINT TO PROPER ENTRY IN DEVTBL
	SKP
	JMP	ASD4		/YES
	TAD I	ASD2		/GET DDB ADDRESS FOR THIS DEVICE
	SZA			/ZERO?
	JMP	ASD11		/NO, SO SOMEONE HAS IT
/COMES HERE IF OKAY TO MAKE THIS ASSIGNMENT
	CFLD			/CHANGE TO CURRENT FIELD
	TAD	ASD2
	6202			/CIF FIELD 0
	GETDDB			/GET A BLOCK FROM THE FREE LIST AND LINK IT INTO DEVTBL
	JMP I	LGI201		/NO BLOCK.. REDO IN CASE OF USER OTHERWISE ERROR RETURN FOR SI
	DATFLD
	TAD I	ASD2			/PICK DDB ADDRESS FROM DEVTBL
	DCA	CFH		/SAVE IT
	TAD	FIOSTK+1
	AND	P0037		/CLEAR BIT 0
	DCA I	CFH		/SET TO REFLECT THE DEVICE NUMBER
	ISZ	CFH
	TAD	FIJOB
	DCA I	CFH		/PLUG IN THE JOB NUMBER
ASD7,	CFLD
	JMP I	FIEXIT

/COMES HERE IF ONE JOB ATTEMPTS TO ASSIGN AN ALREADY ASSIGNED DEVICE
ASD11,	IAC
	DCA	CFH
	TAD I	CFH
	SNA
	CMA
	DCA	FIUSAC		/DELIVER TO USER'S AC
	JMP	ASD7		/EXIT

ASD4,	TAD	FIOSTK+1
	CLL RAL
	SZA CLA			/PTR?
	JMP	ASD7		/NO
	TAD I	ASD2
	CIF 00
	JMS I	ASDCLR		/CLEAR THE READER BUFFER
	JMP	ASD7
ASDCLR,	SICLR
/ROUTINE TO PERFORM ACTUAL REDUCTION

/CALLING SEQUENCE:
/	TAD (NUMBER OF SEGMENTS TO REMAIN)
/	JMS RED30
/	RETRIEVAL CHAIN POINTER
/	UFD RETRIEVAL POINTER
/	RETURN


/FIRST TRACE THRU THE LINKED LIST OF FILE INFORMATION
/RETRIEVAL BBLOCKS UNTIL WE GET TO THE ONE IN WHICH THE
/NEW LAST SEGMENT IS
RED30,	0
	DCA	RED31		/LINKAGE TO RETRIEVAL CHAIN
	TAD	GDRETP		/PICK UP RETRIEVAL POINTER
	JMS I	GE01		/GET THIS WORD INTO CORE
RED31,	0
	DCA	REBUFF
	TAD I	REBUFF		/PICK UP LINK TO NEXT
	DCA	RED31		/SAVE LINK
	TAD	WNDREM		/DELETING ENTIRE WINDOW?
	SNA CLA
	JMP	RED36		/YES, REMOVE LINK TO LAST WINDOW AS WELL
RED37,	ISZ	REWNDC		/AT END OF CHAIN?
	JMP	RED30+2		/NO, KEEP SAVING
	DCA I	REBUFF		/YES, TERMINATE IT
/FOUND RETRIEVAL BLOCK IN WHICH TO CHOP OFF
/THE LIST OF SEGMENTS.
/START DELETING THE SEGMENT NUMBERS AND RETURNING
/THE ACTUAL DISC SEGMENTS TO THE POOL
	TAD	WNDREM
	IAC			/GET POINTER TO FIRST SEGMENT TO BE DELETED
	TAD	REBUFF
	DCA	REBUFF		/POINTER TO FIRST SEGMENT TO REMOVE
	DCA	SEGLIM		/CLEAR SEGMENT COUNTER
	TAD	WNDREM		/NUMBER OF SEGMENTS TO LEAVE IN RET. WINDOW
RED32,	TAD	C7771		/7 SEGMENTS PER RETRIEVAL WINDOW
	DCA	REWNDC		/SAVE COUNT
	DCA	BUFMOD		/REMEMBER TO WRITE OUT THE BUFFER
RED33,	TAD	REDM9
	DCA	CFH		/SET COUNT FOR SATREL DIVIDE
	STL STA
	TAD I	REBUFF		/PICK UP THE SEGMENT NUMBER
	SZL			/IS IT A REAL SEGMENT
	JMP	RED38		/NO; END OF WINDOW, END OF FILE
	JMS I	SATREA		/RELEASE IT ON SAT
	DCA I	REBUFF		/CLEAR THE CCELL
	ISZ	SEGLIM		/COUNT SEGMENT
	ISZ	REBUFF
	ISZ	REWNDC		/END OF CURRENT RETRIEVAL WINDOW?
	JMP	RED33		/NO, CONTINUE
	TAD	RED31		/YES, MOVE TO NEXT
	SNA			/END OF CHAIN?
	JMP	RED39		/YES, EXIT
RED34,	DCA	RED35		/NO
	TAD	GDRETP
	JMS I	GE01		/GET NEXT WINDOW
RED35,	0
	DCA	REBUFF
	TAD I	REBUFF
	DCA	RED31		/SET UP LINK TO NEXT
	DCA I	REBUFF		/CLEAR FIRST WORD OF WINDOW
	ISZ	REBUFF
	JMP	RED32		/KEEP WIPING OUT

RED36,	STL CLA RTL		/ARE WE TWO WINDOWS FROM THE END YET?
	TAD	REWNDC
	SZA CLA
	JMP	RED37		/NOT EXACTLY
	DCA I	REBUFF		/YES, CLEAR LINK TO NOW EMPTY WINDOW
	DCA	BUFMOD		/SCHEDULE WRITE
	JMP	RED37

RED38,	CLA
	DCA I	REBUFF		/CLEAR TO END OF WINDOW
	ISZ	REBUFF
	ISZ	REWNDC		/ARE WE THERE YET?
	JMP	RED38		/NO
RED39,	TAD	GDRETP		/GET RETRIEVAL POINTER
	JMS I	ENS32		/CONVERT IT INTO A RELATIVE ENTRY NUMBER
	STL RTL			/TIMES 4 PLUS 2
	IAC
	TAD	UFDTBL		/POINTS TO WORD3 OF UFDTBL ENTRY
	DCA	REBUFF
	TAD I	REBUFF		/HAS HIS/HER SEGMENT COUNT BEEN SET UP YET?
	SNA CLA
	JMP I	RED30		/NO; SO JUST EXIT
	TAD	SEGLIM		/NUMBER OF SEGMENTS WE REMOVED FROM THIS FILE
	CIA
	TAD I	REBUFF		/SUBTRACT FROM THOSE THAT WE KNEW ABOUT
	DCA I	REBUFF		/UPDATE UFDTBL ENTRY
	STA
	DCA	TABSTA		/REMEMBER TO WRITE OUT THE TABLES
	JMP I	RED30		/EXIT

ENS32,	ENS3
REDM9,	-11
SATREA,	SATREL
REBUFF,	0
*4000
/RENAME ROUTINE

REN0,	JMS I	ACC01		/IS IT ACCOUNT 1?
	JMP	PASSQU		/YES; GO CHANGE PASSWORD AND DISK QUOTA
	JMS I	IFN01
	TAD	FIOSTK+1	/PICK UP INTERNAL FILE NUMBER
	JMS I	UC01		/USER-OWNER CHECK
	JMP I	REN1A		/USER NOT OWNER, ERROR
	JMS I	FILNAM		/CHECK IF THIS NEW NAME IS IN DIRECTORY
	JMP I	BADNAM		/YES, DON'T RENAME
	TAD	FIOSTK		/PICK UP INTERNAL FILE NUMBER NOW SHIFTED TO FIOSTK
	JMS I	GD01		/GET THIS DIRECTORY ENTRY INTO CORE
	DCA	REENTP		/POINTER TO DIRECTORY ENTRY
	TAD	REENTP
	TAD	P0004
	DCA	REPRTP		/POINTER TO PROTECTION BITS
	TAD I	REPRTP		/PICK UP PROTECTION BITS
	AND	C0020		/WRITE PROTECTED AGAINST OWNER?
	SZA
	JMP I	REN1A		/YES, ERROR
	TAD	FIOSTK+2	/TRANSFER NEW NAME TO DIRECTORY
	SNA			/IS IT A NULL NAME?
	JMP I	BADNAM		/YES, DON'T RENAME
	DCA I	REENTP
	ISZ	REENTP
	TAD	FIOSTK+3
	DCA I	REENTP
	ISZ	REENTP
	TAD	FIOSTK+4
	DCA I	REENTP
	DCA	BUFMOD		/SCHEDULE WRITE
	JMP I	FIEXIT		/EXIT FROM FILE PHANTOM
REN1A,	REN1
FILNAM,	USENAM
BADNAM,	CRF30
SEGS0,	TAD I	SEGCNT
	DCA	FIUSAC
	JMP I	FIEXIT
SEGCNT,	-SATSIZ+1
SIFLD,	CORTBL+1

PASSQU,	CDF 00
	TAD I	SIFLD		/IS THIS REQUEST FROM SI?
	AND	C0200
	CFLD
	SZA
	JMP I	REN1A
	TAD	FIOSTK+1	/OR IS [S]HE TRYING ACCOUNT 0?
	SNA
	JMP I	BADNAM		/YES; ERROR
	JMP I	.+1
	PASQU0
/BUILD A RETRIEVAL POINTER GIVEN RELATIVE POSITION ON RETTBL

/CALLING SEQUENCE:
/	TAD (RELATIVE POSITION)
/	JMS BLDP
/	RETURN (POINTER IN AC)

REENTP,
BLDP,	0
	DCA	CFH
	CLA CMA
	TAD	CFH
	CLL RAL
	RTL
	TAD	RETTBL
	JMP I	BLDP
/JMS I LINK01
/MISSING SEGMENT ADD
/REPLACEMENT

LINK0,	0
	DCA	LINK1
	TAD	GDRETP
	JMS I	GE01
LINK1,	0			/GET A DIRECTORY WORD INTO CORE
	TAD	P0003
	DCA	LINK2
	TAD I	LINK2
	CIA
	TAD I	LINK0
	SZA CLA			/SEARCH THROUGH UFD UNTIL WE FIND ENTRY BEING SOUGHT
	JMP	LINK3
	ISZ	LINK0
	TAD I	LINK0		/TAKE A BLOCK OUT OF THE CHAIN
	DCA I	LINK2
	DCA	BUFMOD		/SCHEDULE WRITE
	ISZ	LINK0
	JMP I	LINK0

REPRTP,
LINK2,	0

LINK3,	TAD I	LINK2
	JMP	LINK0+1
/ROUTINE TO SET UP A UFDTBL ENTRY AS FOLLOWS:
/WORD 0:	PROJECT, PROGRAMMER NUMBER
/WORD 1:	-ACCESS COUNT
/WORD 2:	-DISK SEGMENT QUOTA (LOGIN)
/WORD 3:	ACTUAL NUMBER OF SEGMENTS OWNED.
/(WORDS 1 AND 3 ARE INITIALLY SET TO 0.)
/WORD 3 IS LOADED BY "CREATE," OR BY "EXTEND" IF IT HAS NOT PREVIOUSLY
/BEEN LOADED. "CREATE" & "EXTEND" ALWAYS MODIFY WORD 3, "REDUCE" ONLY
/MODIFIES WORD 3 IF IT IS NON-ZERO.

UFQUOT,	0
	DCA I	INDEX		/SAVE PROJECT, PROGRAMMER NUMBER
	DCA I	INDEX		/ZERO ACCESSES SO FAR
	TAD	SEGLIM		/LOGGED IN QUOTA
	CLL RAL			/TIMES 2
	TAD	SEGLIM		/THREE
	RAL			/SIX
	RTL			/TWENTY FOUR
	TAD	SEGLIM		/TWENTY FIVE
	CIA			/NEGATE
	DCA I	INDEX		/SAVE LOGGED-IN SEGMENT QUOTA
	DCA I	INDEX		/NO KNOWN SEGMENTS AS OF YET
	JMP I	UFQUOT
/ROUTINE TO GET THE NUMBER OF A DEVICE ATTACHED TO THIS JOB

/CALLING SEQUENCE:
/	JMS LNS0
/	RETURN IF NONE AVAILABLE
/	NORMAL RETURN (DEVICE NUMBER IN AC)

LNS0,	0
	TAD	DEVTBA		/GLOBAL TO #DEVTBL#
	DCA	CFH
	DATFLD			/CDF FIELD 0
LNS4,	TAD I	CFH		/PICK UP POINTER TO DDB
	SNA
	JMP	LNS2		/DEVICE UNASSIGNED
	IAC
	DCA	LNS3		/POINTER TO SECOOND WORD OF DDB
	TAD I	LNS3
	AND	P0037		/PICK OFF THE JOB NUMBER OF OWNER
	CIA
	TAD	FIJOB		/NUMBER OF CURRENT JOB
	SNA CLA
	JMP	LNS5		/THIS DEVICE IS OURS
LNS2,	ISZ	CFH
	TAD	CFH
	CMA
	TAD	DEVOVR		/GLOBAL TO "JOBTBL"
	SZA CLA
	JMP	LNS4		/CONTINUE LOOKING DOWN TABLE
LNS7,	CFLD			/MAKE SURE WE ARE IN THIS FIELD
	JMP I	LNS0		/FOUND NOW DEVICES

LNS5,	TAD	DEVEND
	CIA
	TAD	CFH
	ISZ	LNS0
	SMA
	JMP	LNS6
	TAD	LNS10
	CLL RAR
	JMP	LNS7

LNS6,	TAD	C4000
	JMP	LNS7

LNS10,	DEVTBE-DEVTBL
LNS3,	0
C4000,	4000
/ROUTINE TO RELEASE A DEVICE

*4200

REL00,	0
	JMS I	DTE01		/IS THIS DEVICE ASSIGNED TO THIS USER?
REL5,	0			/SET BY DTE0 TO POINT TO DEVTBL ENTRY FOR THIS DEVICE
	JMP	REL13		/NO, SO DON'T RELEASE IT
	TAD I	REL5
	DCA	REL6		/SAVE ADDRESS OF DDB FOR LATER
	TAD	REL6
	TAD	P0003		/POSITION OF TIME IN DDB
	DCA	REL2
	TAD I	REL2		/GET TIME ASSIGNED
	CIA
	DCA	REL2		/-TIME ASSIGNED
	CDF
	TAD I	RELCK1		/GET TIME NOW
	RTL
	RTL
	AND	P0007		/JUST SIGNIFICANT PART OF LOW ORDER TIME
	DCA	REL3
	TAD I	RELCK2
	DATFLD
	RTL
	RAL
	AND	P7770		/JUST INSIGNIFICANT PART OF HI ORDER
	TAD	REL3		/TIME AT RELEASE
	CLL
	TAD	REL2		/-TIME AT ASSIGNMENT
	DCA	REL2		/TIME WE OWNED IT
	TAD	REL2
	SNL			/GONE THRU MIDNITE WHILE ASSIGNED?
	TAD	RELCON		/YES, FUDGE TO PROPER VALUE
	SZA
	JMS I	DVT01		/RECORD TIME SINCE WE USED A MEASURABLE AMOUNT
	STL
	TAD	REL5
	TAD	RELCDR		/IS IT A CARD READER OR DECTAPE OR RK05?
	SPA
	RAR			/NO - IS IT A KEYBOARD OR THE PTR?
	SNL
	JMP	REL11		/EITHER KEYBOARD, PTR, CDR, DTA, OR RK05
	TAD	RELREG		/EITHER PTP OR LPT
REL8,	DCA	REL6		/ENTER HERE FROM REL12 FOR TELEPRINTER
	STA
	TAD I	REL5
	DCA	INDEX		/POINT TO WORD 0 OF DDB (AUTOINDEXED)
	TAD I	INDEX		/CHECK STATUS IF TELEPRINTER
	SPA CLA
	JMP	REL4		/[S]HE'S IN THE ^S CONDITION - FLUSH HIM/HER OUT
	DCA I	INDEX		/CLEAR THE JOB NUMBER
	ISZ	INDEX
	ISZ	INDEX
	TAD I	INDEX		/CHECK FILL POINTER
	SZA CLA
	JMP	REL9		/STILL BUSY - LET "CONOUT" RELEASE IT
	TAD	REL6
	SZA CLA			/ASSIGNABLE DEVICE?
	JMP	REL7		/YES
REL4,	TAD I	REL5
	CIF 00
	JMS I	RELTBL		/MAKE SURE THE BUFFER IS CLEAR
	DATFLD
	TAD I	REL5		/RELEASE THE DDB
	JMS I	RETBK1
	CLA
	DATFLD
	DCA I	REL5
REL9,	CFLD
	JMP I	REL00
REL7,	CIF 20			/INHIBIT INTERRUPTS
	TAD I	REL6
	CLL RAL
	SNA
	JMP	REL4
	SPA
	STL
	RAR
	DCA I	REL6
	JMP	REL9
REL11,	SMA CLA			/IS IT A KEYBOARD OR THE PTR?
	JMP	REL12		/NO
	TAD	REL6
	CIF 00
	JMS I	RELTBL		/FLUSH OUT THE BUFFER
REL12,	TAD	REL6
	JMS I	RETBK1		/RELEASE THE DDB
	CLA
	DATFLD
	DCA I	REL5		/REMOVE FROM DEVTBL
	TAD	DEVEND
	CIA
	TAD	REL5
	SMA CLA
	JMP	REL9
	ISZ	REL5
	JMP	REL8

REL13,	CDF
	TAD I	JOB
	AND	C0200
	CFLD
	SZA CLA			/CALLED BY SI??
	JMP I	LGI201		/YES, INDICATE ERROR WITH AC=-1
	JMP I	REL00		/NO, UUO CALL
RELREG,	OUTREG+NULINE+3
RELCDR,	-DEVTBE-4
DVT01,	DVT0
REL2,	0
REL3,	0
RELCK1,	CLK1
RELCK2,	CLK2
RELCON,	3227			/FUDGE FOR MIDNIGHT OVERFLOW
RELTBL,	SICLR
P0100,	100
FIXSCH,	0
	IAC
	DCA	REL5
	TAD I	REL5
	AND	P0100
	SNA CLA
	JMP I	FIXSCH
	TAD	DEVOVR
	CIA
	TAD	INDEX
FIXOUT,	CIF CDF
	DCA I	FIPJOB
	WAIT
EXCEED,	215;212;"[;" ;" ;" ;" ;" ;" ;" ;"E;"X;"C;"E;"E;"D;"I;"N;"G
	" ;"D;"I;"S;"K;" ;"Q;"U;"O;"T;"A;"];215;212;0
/COMPLETION OF LOGOUT ROUTINE
/REMOVES JOB FROM PERMANENT MONITOR TABLES
/MUST BE DONE LAST, SINCE WE NEED THE JOB STATUS BLOCKS
/TO INDICATE ANY ERRORS IN THE FIP I/O

LGO4,	TAD	LGO500		/RESTORE THE FIP EXIT
	CFLD
	DCA I	LGOFIX
	TAD	FIJOB		/SEE IF [S]HE OWNS ANY CORE FIELDS
	CIF
	CORE			/SEARCH CORE TABLE FOR HIM/HER
	FIP SI CJOB
	JMP	LGO5		/NO; NOTHING TO RELEASE
	AND	P0007		/YES; RELEASE THE FIELD
	TAD	CORTBA
	DCA	CFW		/POINTS TO ENTRY IN CORTBL
	CDF
	DCA I	CFH		/ZERO THE ENTRY
LGO5,	TAD	FIJOB		/RETURN STATUS BLOCKS
	TAD	DEVOVR		/START OF JOB TABLE (END OF DEVTBL)
	DCA	LGO6		/POINTS TO JOB TABLE ENTRY
	DATFLD
	TAD I	LGO6		/GET ADDRESS OF JOB STATUS
	JMS I	LGOBLS		/RETURN STATUS
	DATFLD
	DCA I	JOBDAT		/CLEAR JOBDAT
	DCA I	LGO6		/CLEAR POINTER IN JOBTABLE
	CDF
	DCA I	JOB		/CLEAR JOB (SO SAVJOB WON'T SAVE US)
	JMP I	.+1		/AND NOW GO DO FIX50
LGO500,	FIX50
LGOBLS,	RETBLS
LGOFIX,	FIX500
LGO1,	TAD	FIOSTK+1	/LOGOUT WITH AC=0?
	SZA CLA
	JMP I	LGI201		/NO, SO IT'S AN ERROR
	TAD	FIJOB
	TAD	JOBTAB
	DCA	CFH		/GET HIS/HER PROJ-PROG #
	TAD I	CFH
	CIA
	DCA	FIOSTK+2	/SAVE HIS/HER #
	TAD	JOBTAB
	DCA	INDEX		/INITIALIZE TO START OF TABLES
	TAD	LGOMAX		/-JOBMAX
	DCA	FIOSTK+3	/COUNT OF JOBS TO CHECK
	DCA	FIOSTK+4	/COUNT OF MATCHES
	TAD I	INDEX
	TAD	FIOSTK+2	/COMPARE
	SNA CLA
	ISZ	FIOSTK+4	/EXACT MATCH - INDEX COUNT
	ISZ	FIOSTK+3	/DONE?
	JMP	.-5		/NO
	STA			/YES - RETURN # OF MATCHES -1
	TAD	FIOSTK+4
	DCA	FIUSAC
	JMP I	FIEXIT		/AND AWAY

LGOMAX,	-JOBMAX
OPN11,	0
	DCA	OPN13
	TAD	FIOSTK+2	/GET RETRIEVAL POINTER OF UFD BEING ACCESSED
	CIA
	TAD	RETTBL		/IS IT THE MFD?
	SNA CLA
	JMP	OPN14		/MFD OR UFD, READ OK/WRITE NEVER OK
	JMS I	ACC01		/IS [S]HE THE SYSTEM MANAGER?
	JMP	OPN12		/YES; SKIP PROTECTION CHECK
	TAD I	OPN11		/GET PROPER TEST BITS
	AND	P0007		/JUST TEST FOR READ PROTECTION FIRST
	AND I	OPN13		/COMPARE AGAINST FILE'S PROTECTION WORD
	SZA CLA
	JMP I	OPNPRA		/PROTECTION ERROR
	TAD I	OPN11		/READ OK, GET TEST BITS FOR WRITE
	CLL RAL			/CHECK FOR WRITE PROTECTION
	AND I	OPN13
OPN12,	CMA
	DCA	LGO6		/-1 IF OK TO WRITE
	TAD I	ZDS1		/SOME MORE CONDITIONS TO TEST
	DCA	OPN13
	TAD	FIOSTK+2
	JMS I	OPN16		/IS [S]HE THE ONLY PERSON TO OPEN THE FILE?
OPN13,	0
	JMP	OPN14		/NO
	TAD	BASSWT
	CIA
	DATFLD
	SZA
	DCA I	BASWIN		/MAKE SURE THE BASIC WINDOW GETS LOADED
	CFLD
	ISZ	LGO6		/IS [S]HE ALLOWED TO MODIFY IT?
OPN14,	TAD	P0004		/NO, SO WRITE PROTECT BIT IS ON
	ISZ	OPN11		/SKIP ON RETURN
	JMP I	OPN11
OPN16,	ENS0
OPNPRA,	OPNPRE


LGO6,
FIX40,	0
	DCA	FLPARB+3
	TAD	FLPARB+3
	DCA	FLPARB+5
	CLA CMA
	TAD	FLPARB+5
	DCA	FLPARB+4
	JMP I	FIX40
*4600
TTYTBA,	TTYTBL
CLK1A,	CLK1
CLK2A,	CLK2
RESET,	DCA I	CFH
	FGETJT
	JOBACC
	DCA	ADDR
	DATFLD
	TAD	FIOSTK+2
	DCA I	ADDR		/PLUG HIS/HER ACCOUNT # INTO HIS JOB STATUS BLOCKS
	TAD	FIJOB		/GET JOB #
	TAD	TTYTBA
	DCA	ADDR
	TAD I	ADDR		/GET LINE #
	CLL RAL
	TAD	DEVTBA		/FIND THE DDB
	DCA	ADDR
	TAD	P0003
	TAD I	ADDR
	DCA	ADDR
	CDF
	TAD I	CLK1A
	RTL
	RTL
	AND	P0007
	DCA	CFH
	TAD I	CLK2A
	RTL
	RAL
	AND	P7770
	TAD	CFH
	DATFLD			/NOW RESET THE
	DCA I	ADDR		/ASSIGN TIME
	JMP I	.+1		/THEN EXIT
	TABOUT
BASCO0,	0
	JMS I	IFN01		/JUST RETURN INTERNAL FILE # IN FIOSTK+1
	TAD	FIOSTK+1
	JMS I	CL01		/CLOSE ANY FILE THAT IS OPEN
	TAD	FIOSTK+3	/MAY BE
	SNA			/IS IT A NULL FILE NAME?
	JMP I	OPN3A		/YES, ERROR RETURN
	TAD	OPN3A+1		/COMPARE BA
	SZA CLA
	JMP	BASSET		/NO MATCH
	TAD	FIOSTK+2	/IS ACCT # 2?
	SNA
	JMS I	JBLD0		/WHAT'S HIS/HER ACCOUNT?
	CLL RTR
	SNA CLA
	TAD	FIOSTK+4	/COMPARE SI
	TAD	OPN3A+2
	SNA CLA
	TAD	FIOSTK+5
	TAD	OPN3A+3		/COMPARE C
	SNA CLA
	CMA			/IF BASIC, BASSWT=-1
BASSET,	DCA	BASSWT		/IF NOT, BASSWT=0
	TAD	FIOSTK+1
	JMS I	EBLD0		/GET PTR TO ENTTBL WORD 1 RELATIVE PTR WORD 2 ADDRESS IN UFD
	JMP I	BASCO0		/RETURN
OPN3A,	OPN3
	-4241		/-BA
	-6351		/-SI
	-4300		/-C 

CLOBAS,	0
	JMS I	RETBK1
	DCA	BAS3
	TAD	BAS3
	CIA
	TAD	BASWIN
	SNA CLA
	JMP	CLOBA1
	TAD	BAS3
	JMS I	RETBK1
	CLA SKP
CLOBA1,	CLA CMA
	JMP I	CLOBAS
BAS0,	0
	DCA	BAS1		/SAVE BUFFER ADDRESS OF RETRIEVAL WINDOW
	TAD	BASWIN		/BASIC WINDOW ADDRESS
	DCA	ADDR		/GET BUFFER ADDRESS READY
BAS5,	TAD	BAS1		/
	DCA	BAS2
	TAD	C7771
	DCA	BAS3		/COUNT OF 7 SEGS PER WINDOW
BAS4,	ISZ	BAS2
	CFLD
	TAD I	BAS2		/PICK UP THE SEG #
	ISZ	ADDR
	SNA
	JMP	BAS6
	DATFLD
	DCA I	ADDR		/SAVE IT IN WINDOW
	ISZ	BAS3		/COUNT
	JMP	BAS4		/STILL IN SAME BLOCK
	CFLD
	TAD I	BAS1		/CHANGE THE BLOCK
	SNA
	JMP	BAS6		/NO MORE SEGMENTS
	DCA	BAS1
	TAD	FIOSTK+2	/GET THIS BLOCK OF UFD IN BUFFER
	JMS I	GE01
BAS1,	0
	DCA	BAS1		/SAVE THE BUFFER ADDRESS CONTAINING THE NEEDED BLOCK
	JMP	BAS5		/CONTINUE
BAS6,	SNA
	TAD I	BAS1
	SZA CLA
	JMP I	BAS123		/BASIC MUST BE 39 SEGMENTS OR LESS TO USE SPECIAL WINDOW
	TAD	ADDR
	SMA CLA
	JMP	.+5
	DATFLD
	DCA I	ADDR
	ISZ	ADDR
	JMP	.-2
	DATFLD
	CLA CMA
	DCA I	BASWIN		/-1 IN FIRST WORD TO MARK BASIC WINDOW
	JMP I	BAS0
ADDR,	0
BAS2,	0
BAS3,	0
BAS123,	OPN123
/ROUTINE TO LET SYSTEM MANAGER CHANGE PASSWORDS AND DISK QUOTAS

UFDNAM,	RTABLE
	0

PASQU0,	DCA	UFDNAM+1	/SAVE ACCOUNT NUMBER TO SEARCH FOR
	CMA
	JMS I	DS01		/SEARCH MFD FOR THIS ACCOUNT
	UFDNAM
	JMP	PASNOT		/ACCOUNT NOT FOUND IN MFD
	DCA	INDEX		/SAVE POINTER TO OLD PASSWORD
	TAD	FIOSTK+2	/FIRST TWO CHARACTERS OF NEW PASSWORD
	DCA I	INDEX		/SAVE IN MFD NAME BLOCK
	TAD	FIOSTK+3	/SECOND TWO CHARACTERS OF NEW PASSWORD
	DCA I	INDEX		/SAVE IN MFD
	ISZ	INDEX		/SKIP PAST LINK TO NEXT UFD
	TAD	FIOSTK+4	/GET NEW DISK QUOTA
	DCA I	INDEX		/SAVE NEW QUOTA
	DCA	BUFMOD		/REMEMBER TO WRITE OUT THE MFD SEGMENT
	TAD	FIOSTK+1	/SEE IF THIS ACCOUNT IS CURRENTLY IN THE UFDTBL
	JMS I	UTS01
	JMP I	FIEXIT		/NOT THERE
	ISZ	UTPRNU		/POINTS TO -QUOTA ENTRY
	STA
	TAD	FIOSTK+1	/IS IT THE QUOTA FOR THE "GRACE SPACE"?
	SNA CLA
	JMP	PASQU1		/YES
	TAD	FIOSTK+4	/TRIM OFF THE LOGOUT PORTION OF THE QUOTA
	AND	P0077
	DCA	FIOSTK+4
	TAD	FIOSTK+4
	CLL RAL			/MULTIPLY BY TWO
	TAD	FIOSTK+4	/THREE
	RAL			/SIX
	RTL			/TWENTY FOUR
PASQU1,	TAD	FIOSTK+4	/TWENTY FIVE; OR ACTUAL COUNT IF FOR "GRACE SPACE"
	CIA			/NEGATE THE RESULT
	DCA I	UTPRNU		/SAVE AWAY IN THE UFDTBL
	JMP I	.+1
	TABOUT

PASNOT,	TAD	P7000		/RETURN FILE NOT FOUND
	DCA	FIUSAC
	JMP I	FIEXIT
/SUBROUTINE TO FIND AN EMPTY DIRECTORY ENTRY

/CALLING SEQUENCE:
/	TAD (POINTER TO UFD RETRIEVAL INFORMATION)
/	JMS DE0
/	BAD RETURN (COULD NOT FIND A FREE ENTRY)
/	NORMAL RETURN (POINTER TO ENTRY IN AC)

DE0,	0
	DCA	DERETP		/SAVE RETRIEVAL PTR
	DCA	DE2		/ZERO THE ADDRESS IN UFD
	TAD	BUFSTA		/IS THERE A SEGMENT IN THE BUFFER?
	SMA CLA
	JMP	DE7		/NO, SO START FROM THE BEGINNING
	TAD I	GERETA		/GET THE SEGMENT IN CORE
	CMA
	DCA	NSEGCR
	TAD	DERETP		/GET RETRIEVAL PTR FOR INCREMENT
	DCA	UFDPTR
DE5,	TAD I	UFDPTR
	SNA			/IS THERE A SEGMENT?
	JMP	DE7		/NO, START FROM 0 LOC IN UFD
	TAD	NSEGCR		/YES, DOES IT AGREE WITH THE SEGMENT IN CORE?
	SNA CLA
	JMP	DE6		/YES, START SEARCHING AT THIS POINT
	TAD	DE2		/NO, INCREMENT THE ADDR
	TAD	C0400
	DCA	DE2
	ISZ	UFDPTR		/POINT TO NEXT SEGMENT IN RETRIEVAL BLOCK
	JMP	DE5		/GO BACK
DE7,	DCA	DE2		/INDICATE THAT SEARCH IS FROM WORD 0
	STA
DE6,	DCA I	UFD01		/SAVE SECOND PASS FLAG
DE1,	TAD	DERETP
	JMS I	GE01		/GET ENTRY INTO CORE
DE2,	0
	SNA			/SKIP IF ENTRY EXISTS
	JMP	DE4		/DID NOT EXIST, EXTEND UFD
	DCA	DEBUFP
	TAD I	DEBUFP		/FIRST WORD OF ENTRY
	SZA CLA
	JMP	DE3		/NOT EMPTY, LOOK AT NEXT ENTRY
	ISZ	DEBUFP		/ZERO COULD MEAN END OF STRING OF RETRIEVAL INFORMATION BLOCKS
	TAD I	DEBUFP		/LOOK AT SECOND WORD OF ENTRY
	SZA CLA			/IF ZERO, EMPTY ENTRY
	JMP	DE3		/NOT EMPTY, KEEP LOOKING
	TAD	DE2		/PICK UP ENTRY POINTER
	SNA			/ENTRY 0 NEVER AVAILABLE
	JMP	DE3
	ISZ	DE0		/POINT TO NORMAL RETURN
	JMP I	DE0
DE3,	TAD	C0010		/INCREMENT TO NEXT ENTRY
	TAD	DE2
	DCA	DE2		/SAVE NEXT ENTRY INDEX
	JMP	DE1		/LOOK AT NEXT ONE

DE4,	ISZ I	UFD01		/HAVE WE TRIED FROM THE BEGINNING YET?
	JMP	DE7		/NO, WELL TRY IT THEN...
	TAD	DERETP
	JMS I	UFD01		/TRY EXTENDING THE UFD
	JMP I	DE0		/TOO BAD, CAN'T EXTEND UFD
	JMP	DE1		/NOW WE HAVE PLENTY OF ROOM
DEBUFP,	0
UFD01,	UFD0
DERETP,	0
UFDPTR,	0
GERETA,	RDCURR
NSEGCR,	0

/ROUTINE TO OUTPUT QUOTA EXCEEDED MESSAGE
EXTEL0,	0
	DATFLD
	TAD	FIJOB		/CURRENT JOB NUMBER
	TAD	TTYTAB		/POINTS AT POSITION IN TTYTBL
	DCA	DE0
	TAD I	DE0		/GET CONSOLE NUMBER FOR THIS JOB
	STL RAL			/TIMES 2 PLUS 1
	TAD	DEVTBA		/INDEX TO OUTPUT DDB
	CDF
	DCA I	CONDVA		/STORE FOR FIELD 0 PRINT ROUTINE
	CFLD
	TAD	EXTMES		/GET MESSAGE POINTER
	DCA	INDEX
EXTEL1,	TAD I	INDEX		/GET CHARACTER OF THE MESSAGE
	SNA			/ANY LEFT?
	JMP I	EXTEL0		/NO; SO GO EXTEND
	CIF CDF 00
	DCA I	FICHAR		/STORE FOR PRINT OUT ROUTINE
	CFLD
	PRINT			/SEND MESSAGE #[EXCEEDING DISK QUOTA]#
	JMP I	EXTEL0		/RAN OUT OF SPACE IN THE OUTPUT BUFFER (TOO BAD!)
	JMP	EXTEL1		/BACK FOR NEXT CHARACTER

TTYTAB,	TTYTBL
CONDVA,	CONDBA
EXTMES,	EXCEED-1
FICHAR,	TTCHAR
/ROUTINE TO CLEAR ALL CPU AND DEVICE TIME ACCUMULATORS IN THE MFD
/THIS IS USED BY THE #RESET# FUNCTION IN THE CUSP #CAT#
LGRES0,	CLA IAC			/SET RESET FLAG IN DIRECTORY SEARCH ROUTINE
	DCA I	RETBK1
	TAD	RETBK1
	DCA	EXQ1		/SET POINTER SO FLAG WILL CLEAR ON COMPLETION
	TAD	RETTBL
	DCA	GDRETP		/SET RETRIEVAL POINTER
	JMS	LOQUO		/GO DO THE RESET
	CMA			/SHOULD RETURN A ZERO IN AC
	JMP	EXTQU1

/ROUTINE TO COUNT TOTAL SEGMENTS OWNED BY A UFD AND
/SAVE THE RESULT IN WORD 3 OF THE UFDTBL ENTRY FOR THE RESPECTIVE UFD
/CALL:
/	EXQ1 POINTS TO WORD 3 OF CORRECT UFDTBL ENTRY
/	JMS	LOQUO
/	RETURN (ENTRY 3 LOADED, TOTAL ALSO IN AC)

EXQ3,
LOQUO,	0
	DCA	WNDREM		/FUDGE A FILE NAME BEGINNING WITH TWO SPACES
	JMS I	DS01		/SEARCH DIRECTORY TO DETERMINE SEGMENT COUNT
	GDRETP			/(HOPE NO ONE SCRAMBLES LOC. 23-26 ON PAGE 0!!)
	CLA SKP			/GOOD - COULDN'T FIND SUCH A FILE
	JMP I	DIRBAD		/FOUND IT! OOPS!
	TAD	SEGLIM		/GET THE TOTAL FROM THE DIRECTORY SEARCH
	DCA I	EXQ1		/SAVE IN UFDTBL
	TAD	FIOSTK+1	/INTERNAL FILE NUMBER?
	SMA			/IF THIS IS NOT A "RESET" WE MUST RELOAD
	JMS I	GD01		/THE CORRECT DIRECTORY SEGMENT
	DCA	REL6		/SAVE POINTER TO NAME BLOCK
	TAD	SEGLIM		/RETURN WITH CURRENT TOTAL
	JMP I	LOQUO


EXTQU8,	CLA			/WE'VE BEEN HERE BEFORE FOR THIS GUY
	CFLD
	TAD	EXQ2		/WILL THIS EXTEND CARRY
	TAD I	EXQ1		/THIS FILE ACROSS THE QUOTA BOUNDARY AGAIN?
	SMA SZA CLA		/(I.E. HAS [S]HE REDUCED SINCE LAST EXTEND?)
	JMP	EXTQU9		/NO; [S]HE'S STILL ABOVE QUOTA, EXTEND QUIETLY
EXTQU6,	TAD	EXFILE		/ADDRESS WITHIN MESSAGE TO STORE FILE NAME
	DCA	INDEX
	JMS	EXTNAM		/CHAR 1 & 2 OF FILE NAME
	JMS	EXTNAM		/CHAR 3 & 4 OF FILE NAME
	JMS	EXTNAM		/CHAR 5 & 6 OF FILE NAME
	JMS I	EXTELL		/NOTIFY USER THAT QUOTA IS BEING EXCEEDED
EXTQU9,	CLA
	JMP I	EXTQU0		/EXIT TO EXTEND FILE AS REQUESTED

EXTQU5,	TAD	FIOSTK+2	/NUMBER OF SEGMENTS [S]HE WON'T GET
EXTQU1,	DCA	FIUSAC		/PASS RESULT BACK TO THE USER
	JMP I	FIEXIT
/ROUTINE TO CHECK LOGIN QUOTA BEFORE EXTENDING A FILE

EXTQU0,	0
	TAD	GDRETP		/COMPARE RETRIEVAL POINTER
	CIA
	TAD	RETTBL		/AGAINST THE MFD'S ENTRY
	SNA CLA			/IS IT FROM THE SYSTEM MANAGER?
	JMP I	VIOLAT		/GET OUT QUICK, BEFORE [S]HE DESTROYS THE SYSTEM
	TAD	FIOSTK+2	/NUMBER OF SEGMENTS TO BE ADDED
	SPA			/IS [S]HE BEING REASONABLE?
	JMP	EXTQU1		/NO - [S]HE DESERVES TO FAIL!
	CLL CIA
	TAD I	SATSEG		/ARE THERE THAT MANY SEGMENTS LEFT ON THE SYSTEM?
	SNL CLA
	JMP	EXTQU5		/NO; SO DON'T GIVE ANY
	TAD	GDRETP		/RETRIEVAL POINTER
	JMS I	ENS33		/CONVERT TO RELATIVE ENTRY NUMBER
	STL RTL			/TIMES FOUR PLUS TWO
	TAD	UFDTBL		/POINTS AT -LOGIN QUOTA
	DCA	EXQ1		/SAVE POINTER
	TAD I	EXQ1		/GET NEGATIVE QUOTA
	DCA	EXQ2		/AND SAVE
	ISZ	EXQ1		/POINTS AT CURRENTLY OWNED COUNT
	TAD I	EXQ1		/GET HIS/HER PRESENT TOTAL
	SNA			/HAS THE COUNT BEEN SET UP YET?
	JMS	LOQUO		/NO; GO FIGURE IT OUT
	TAD	FIOSTK+2	/ADD THE NUMBER [S]HE WANTS
	TAD	EXQ2		/AND SUBTRACT FROM QUOTA
	SPA SNA			/WILL THIS EXCEED THE QUOTA FOR THIS ACCOUNT?
	JMP	EXTQU9		/NO; GO EXTEND
	TAD I	GRACE		/WILL IT GO BEYOND THE #GRACE SPACE#?
	SMA SZA CLA
	JMP	EXTQU5		/YES; DON'T BOTHER EXTENDING
	TAD	FIOSTK+1	/SEE IF THIS FILE IS ALREADY IN THE GRACE AREA
	JMS I	LNK01		/GET POINTER TO FILE CONTROL BLOCK
	TAD	FILPRP		/POINT TO STATUS WORD
	DCA	EXQ3
	DATFLD
	TAD I	EXQ3		/GET CURRENT STATUS FOR THIS FILE
	RAR
	SZL			/IS THIS FILE IN THE GRACE AREA?
	JMP	EXTQU8		/MAYBE; SEE IF [S]HE'S REENTERING
	STL RAL			/SET GRACE BIT
	DCA I	DXQ3
	CFLD
	JMP	EXTQU6		/SEND MESSAGE, THEN GO EXTEND
/ROUTINE TO PLANT FILE NAME INTO "EXCEEDING QUOTA" MESSAGE

EXTNAM,	0
	TAD I	REL6		/GET PART OF FILE NAME
	RTR
	RTR
	RTR
	AND	P0077		/SAVE LEFT BYTE
	TAD	P0240		/CONVERT TO ASCII
	DCA I	INDEX		/STORE IN THE MESSAGE AREA
	TAD I	REL6		/NOW FOR THE RIGHT BYTE
	AND	P0077
	TAD	P0240		/CONVERT TO ASCII
	DCA I	INDEX		/SAVE RIGHT BYTE
	ISZ	REL6		/POINT TO NEXT CHARACTER
	JMP I	EXTNAM

/ROUTINE TO CHECK FOR THE SAFE REDUCTION OF A UFD
/TWO CONDITIONS MUST BE MET:
/	THE ACCOUNT CANNOT BE IN USE TO ANYONE
/	THE ACCOUNT MUST HAVE AN EMPTY DIRECTORY

EXQ2,
REDUF0,	0
	TAD	GDRETP		/GET RETRIEVAL POINTER
	CIA
	TAD	RETTBL		/IS [S]HE TRYING TO REDUCE A UFD?
	SZA CLA
	JMP I	REDUF0		/NO; LET HIM/HER REDUCE NORMAL FILES
	TAD I	REL6		/GET THE ACCOUNT NUMBER OF THE UFD IN QUESTION
	JMS I	UTS01		/LOOK IT UP IN THE UFD TABLE
	JMP	REDUF1		/NOT THERE - GOOD
	CLA
	TAD	C4400		/TELL HIM "FILE IN USE"
	JMP	EXTQU1
REDUF1,	TAD I	REL6		/GET THE ACCOUNT NUMBER OF THE UFD TO BE DELETED
	JMS I	UFO01		/LOAD ITS RETRIEVAL WINDOW INTO RTABLE
	JMP	EXTQU5		/COULDN'T; PAS HIS/HER OWN AC BACK AS AN ERROR INDICATION
	JMS I	BLDP1		/MAKE A RETRIEVAL POINTER
	DCA	GDRETP		/SAVE IT FOR THE SEARCH
	ISZ	EXQ1		/POSITION UFDTBL POINTER FOR THIS ACCOUNT
	ISZ	EXQ1		/TO POINT TO THE SEGMENT ACCUMULATOR
	JMS	LOQUO		/SEE IF THIS UFD STILL CONTAINS FILES
	CLL STA RTL		/AC=-3
	TAD	EXQ1		/POSITION WE'VE BEEN ASSIGNED ON UFDTBL
	JMS I	TF01		/FREE THE POSITION
	TAD I	EXQ1		/DID [S]HE OWN ANY SEGMENTS?
	SZA CLA
	JMP I	VIOLAT		/STILL SOME FILES IN THERE!
	STA
	DCA	FIOSTK+2	/FORCE HIM/HER TO COMPLETELY DELETE THIS UFD
	JMP I	REDUF0

VIOLAT,	PRT1+1
ENS33,	ENS3
SATSEG,	-SATSIZ+1
EXFILE,	EXCEED+2
EXTELL,	EXTEL0
P0240,	240
GRACE,	UTABLE+2

$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$