/NOW SEE IF THE SEGMENT BEING SOUGHT IS ONE WHICH FOLLOWS
/THOSE WHICH ARE PRESENTLY IN THE CORE WINDOW. IF THE
/SOUGHT BLOCK DOES FOLLOW THE PRESENT ONE, WE CAN LOOK
/THROUGH THE RETRIEVAL INFORMATION BLOCKS STARTING AT THE ONE
/NOW IN CORE. OTHERWISE, WE MUST START AT THE VERY BEGINNING
/OF THE LIST OF FILE RETRIEVAL INFORMATION BLOCKS
	TAD	WNSEGC
	SPA SNA
	JMP	WND6		/PREVIOUS BLOCK, SO MUST START AT BEGINNING OF STRING
	JMS I	WND201		/DIVIDE BY 7
	CIA
	DCA	WNDCNT		/MOVE FORWARD THIS MANY WINDOWS
	TAD	WNDPTR
WND10,	DCA	WNDIRP
	TAD I	WNDIRP		/PICK UP ADDRESS OF NEXT WINDOW
	CFLD			/CHANGE TO CURRENT FIELD
	SNA
	JMP	WND13		/END OF STRING
	DCA	WND11
	TAD	WNRETP		/POINTER TO UFD RETRIEVAL INFORMATION
	JMS I	GE01		/GET ENTRY INTO CORE
WND11,	0
	ISZ	WNDCNT		/HAVE WE MOVED AHEAD ENOUGH BLOCKS?
	JMP	WND10		/NOT PROPER WINDOW, KEEP LOOKING
	DCA	WNDIRP
WND13,	6202			/CIF FIELD 0
	BLT
	6221			/SOURCE FIELD (ALWAYS 2)
WNDIRP,	0			/SOURCE
	DATFLD			/DESTINATION FIELD
WNDPTR,	0			/DESTINATION
	-10			/WORD COUNT
	TAD	WNDCNT		/CORRECT FOR WINDOWS THAT WEREN'T THERE
	JMS	WND30		/MULTIPLY BY 7
	TAD	WNSEGC		/SEGMENT NUMBER OF FIRST IN WINDOW
	DATFLD
	DCA I	WNFCBP		/FILE CONTROL BLOCK POINTER
	ISZ	WNFCBP		/POINT AT PROTECTION WORD IN CONTROL BLOCK
	TAD I	WNFCBP		/GET CURRENT STATUS
	AND	P0007		/SAVE ONLY STATUS BITS
	TAD	WND11		/ADD IN POINTER TO CURRENT RETRIEVAL WINDOW
	DCA I	WNFCBP		/AND SAVE
	JMP I	.+1		/GO SET #JSIOTC# BEFORE EXITING
	INF6

WND6,	CFLD			/CHANGE TO CURRENT FIELD
	CLA CLL
	TAD	WNSEGC		/SEGMENT TO GET INTO IN CORE WINDOW
	JMS I	WND201		/DIVIDE BY 7
	CMA
	DCA	WNDCNT		/WINDOW NUMBER TO GET INTO CORE
	ISZ	WNENTP
	TAD I	WNENTP		/UFD ENTRY ADDRESS OF OPEN FILE
	DCA	WND5
	TAD	WNRETP		/RETRIEVAL INFORMATION POINTER
	JMS I	GE01		/GET ENTRY INTO CORE
WND5,	0
	TAD	P0007
	JMP	WND10

/ROUTINE TO MULTIPLY A NUMBER BY 7

WNDSCT,
WND30,	0
	DCA	CFH
	TAD	CFH
	CLL RAL
	TAD	CFH
	CLL RAL
	TAD	CFH
	JMP I	WND30

WNFCBP,	0
WNENTP,	0
WNRETP,	0
WNDCNT,	0
WNSEGC,	0
WNDCCT,	7773
WNCURS,	0
C0177,	177


IODISP,
	ASD1
	REL1
	REN0
	OPN0
	CLS0
	WND0
	PRT0
	WND0
	CRF0
	EXT0
	RED0
	INF0
	LGI0
	LGO0
	WHO0
	SEGS0

*1200

/ROUTINE TO CREATE A NEW FILE

CRF0,	TAD	FIOSTK+1
	SNA CLA
	JMP	CRF30
	JMS I	JBLD0
	JMS I	UTS01		/SEARCH THE UFD TABLE
	JMP I	DIRBAD		/***************DEBUG**************
	JMS I	BLDP1		/BUILD A PTR TO RETTBL
	DCA	FIOSTK		/MAKE A LINKAGE FOR DIRECTORY SEARCH
	JMS I	ACC01		/IS IT ACCOUNT 1?
	CMA			/YES; MAKE IT A ONE WORD SEARCH
	JMS I	DS01		/SEARCH THE DIRECTORY FOR THIS NAME
	FIOSTK			/POINTER TO SEARCH PARAMETERS
	JMP	CRF2		/COULD NOT FIND THIS NAME, CONTINUE
	DCA	CRBUFP		/FOUND A FILE OF THIS NAME IN UFD. PTR INTO CRBUFP
	JMS I	ACC01		/SEE IF THIS IS ACCOUNT 1
	JMP	CRF30		/CAN'T DELETE UFD'S AS THOUGH THEY ARE FILES
	TAD I	ZDS1		/POINTER TO "DS1"=ADDR WITHIN UFD WHERE THIS FILE NAME'S BLOCK IS
	DCA	CRF11		/UFD ADDRESS OF DIRECTORY ENTRY
	TAD	FIOSTK
	JMS I	CRENS		/SEARCH ENT TABLE FOR ACCESSES TO THIS FILE
CRF11,	0			/UFD ADDR OF DIRECTORY ENTRY
	JMP	CRF10		/ERROR, FILE IS OPEN
/COMES HERE IF A FILE BY THIS NAME ALREADY EXISTS, BUT NO ONE HAS OPENED IT
	TAD	CRF11
	DCA I	CRGD11		/GD1
	TAD	FIOSTK
	DCA	GDRETP
	TAD	CRBUFP		/PTR TO WHERE IN CORE BUFFER THE UFD BLOCK FOR THIS FILE IS
	JMS I	SAVCRA		/DELETE THE EXISTING FILE OF THIS NAME
	JMS I	DS01		/SEARCH THE UFD FOR AN EXISTING FILE OF THE SAME NAME
	FIOSTK
	SKP			/NONE THERE, SO OKAY TO CREATE ONE
	JMP I	DIRBAD		/**************DEBUG ONLY**********
/NOW ALL SET TO CREATE THE FILE. TO DO THIS, WE NEED TWO BLOCKS OF
/THE UFD -- ONE FOR A NAME BLOCK AND THE SECOND FOR A FILE RETRIEVAL INFORMATION
/BLOCK. THESE BLOCKS ARE OBTAINED BY TWO CALLS TO DE0. AFTER THE FIRST,
/A DUMMY 7777 IS PUT IN THE FOUND BLOCK TO PREVENT THE SECOND CALL
/TO DE0 FROM FINDING THE SAME BLOCK. IF BOTH BLOCKS CANNOT BE OBTAINED,
/THE CREATE CANNOT BE EXECUTED.
CRF2,	DCA	CRLINK		/ADDR OF LINK WORD OF LAST ENTRY IN UFD CHAIN
	ISZ	UTPRNU		/POINTS AT LOGIN DISK QUOTA
	TAD I	UTPRNU		/-SEGMENTS ALLOWED WHILE LOGGED IN
	TAD	SEGLIM		/PLUS NUMBER OF SEGMENTS FOUND WHILE SEARCHING HIS/HER DIRECTORY
	ISZ	UTPRNU		/POINT AT HOLD REG FOR SEGMENT COUNT
	SMA CLA			/IS [S]HE ALLOWED ONE MORE?
	JMP	CRF1		/NO; TELL HIM/HER DIRECTORY FULL
	TAD	FIOSTK		/POINTER TO RETRIEVAL INFORMATION
	JMS I	DE01		/FIND AN EMPTY DIRECTORY ENTRY
	JMP	CRF1		/ERROR, NO AVAILABLE ENTRIES
	DCA	CRF4		/ADDRESS OF THIS ENTRY
	JMS	CRF40		/GET THIS ENTRY INTO CORE
	CLA CMA
	DCA I	CRBUFP		/SIMULATE A USED ENTRY
	DCA	BUFMOD		/SCHEDULE WRITE
	TAD	FIOSTK
	JMS I	DE01		/FIND ANOTHER ENTRY
	JMP	CRF51		/ERROR
	DCA	CRF3
	TAD	FIOSTK
	JMS I	GE01		/MAKE SURE SECOND ENTRY IS IN CORE
CRF3,	0
	DCA	INDEX
	JMS I	SATL1		/FIND A FREE SEGMENT IN THE SAT
	SNA
	JMP	CRF20		/COULD NOT FIND A FREE SEGMENT
/AT THIS POINT, WE HAVE A DISC SEGMENT AND TWO BLOCKS FROM THE
/UFD. THIS IS ALL THAT IS NEEDED, SO GO AHEAD AND EXECUTE THE CREATE
	DCA	CRF11		/SAVE SEGMENT NUMBER
	TAD	CRF11
	DCA I	INDEX		/PUT IT IN THE FIRST BLOCK OF RETRIEVAL
	DCA	BUFMOD		/SCHEDULE WRITE
	JMS	CRF40		/GET FIRST FOUND ENTRY INTO CORE
	TAD	FIOSTK+1	/TRANSFER FILE NAME INTO DIRECTORY ENTRY
	DCA I	CRBUFP
	TAD	CRBUFP		/MOVE POINTER TO AUTO-INDEX
	DCA	INDEX
	TAD	FIOSTK+2
	DCA I	INDEX
	TAD	FIOSTK+3
	DCA I	INDEX
	DCA I	INDEX		/ZERO LINK (THIS IS THE LAST FILE)
	TAD	CRPROT		/PICK UP PROTECTION BITS
	DCA I	INDEX		/STORE INITIAL PROTECTION CODE
	JMS I	CRFUFA		/GO SEE IF WE'RE CREATING A NEW ACCOUNT
	CDF			/CDF FIELD 0
	TAD I	DATE		/GLOBAL TO DATE
	CFLD			/CHANGE TO CURRENT FIELD
CRFUFR,	DCA I	INDEX		/STORE DATE OF CREATION
	TAD	CRF3		/POINTER TO RETRIEVAL
	DCA I	INDEX		/SET UP PTR TO RETRIEVAL INFORMATION
	DCA	BUFMOD		/SCHEDULE WRITE
	TAD	FIOSTK		/GET LAST ENTRY ON STRING INTO CORE
	JMS I	GE01
CRLINK,	0
	DCA	CRBUFP		/PTR TO WHERE THE PRESENT LAST ENTRY IS
	TAD	CRF4
	DCA I	CRBUFP
	DCA	BUFMOD		/SCHEDULE WRITE
	JMS I	ACC01		/IS [S]HE CREATING A NEW UFD?
	JMP	CRFUFZ		/YES
	IAC
CRFSEG,	TAD	SEGLIM		/STORE SEGMENT COUNT IN THE UFDTBL
	DCA I	UTPRNU
	JMP I	.+1		/REMEMBER TO WRITE OUT THE TABLES
	TABOUT

CRFUFZ,	TAD	CRF11
	JMS I	SCL01		/WRITE OUT DIRECTORY BLOCK & CLEAR NEW UFD BLBOCK
	JMP I	FIEXIT		/DON'T MODIFY THE MFD'S ENTRY IN THE UFDTBL
CRF20,	STL RTR			/DISK FULL
	STL RTR
	DCA	FIUSAC		/SAVE PARTIAL ERROR CODE
CRF51,	JMS	CRF40		/GET FIRST ENTRY BACK AGAIN
	DCA I	CRBUFP		/ZERO OUT THE -1 WE PUT THERE
	DCA	BUFMOD		/SCHEDULE WRITE
CRF1,	CLA CLL CML RTR
	CLL CML RAR
	TAD	FIUSAC		/GET PARTIAL ERROR CODE
	DCA	FIUSAC		/SAVE ERROR CODE; EITHER DISK FULL OR DIRECTORY FULL
	JMP	CRFSEG		/GO SAVE SEGMENT COUNT ANYWAY
CRF30,	CLA CLL CML RTR
CRF10,	TAD	C4400
	DCA	FIUSAC		/SAVE ERROR CODE; EITHER FILE IN USE OR BAD FILE NAME
	JMP I	FIEXIT

CRF40,	0
	TAD	FIOSTK
	JMS I	GE01
CRF4,	0
	DCA	CRBUFP
	JMP I	CRF40


CRPROT,	12
CRGD11,	GD1
CRENS,	ENS0
SAVCRA,	SAVCRE
SCL01,	SCL0
CRFUFA,	CRFUFD
CRBUFP,	0
/ROUTINE TO EXTEND A FILE

*1400

EXT0,	JMS	EXT1		/MAKE SURE IT'S OKAY TO EXTEND THIS FILE
	TAD	P0007		/...EXT1 RETURNS WITH PTR TO NAME BLOCK FOR THIS FILE
	DCA	EXBUFP		/SAVE POINTER TO RETRIEVAL CHAIN
	JMS I	EXTQUA		/CHECK THE DISK QUOTA FOR THIS USER
/NOW TRACE THROUGH TO LAST RETRIEVAL INFORMATION BLOCK FOR THIS FILE
EXT4,	TAD I	EXBUFP
	SNA			/END OF CHAIN?
	JMP	EXT3		/YES
	DCA	EXWNDP		/WINDOW POINTER
	TAD	EXWNDP
	JMS	EXGE0		/GET WINDOW INTO CORE
	DCA	EXBUFP		/SAVE POINTER TO NEXT RETRIEVAL WINDOW
	JMP	EXT4		/KEEP LOOKING FOR END

EXT3,	TAD	C7771
	DCA	EXT1		/7 SEGS PER WINDOW
EXT5,	ISZ	EXBUFP
	TAD I	EXBUFP		/PICK UP ENTRY IN WINDOW
	SNA CLA			/IS IT THE FIRST FREE?
	JMP	EXT7		/YES, FIND A SEGMENT
	ISZ	EXT1		/END OF WINDOW?
	JMP	EXT5		/NO, KEEP LOOKING
EXT9,	TAD	GDRETP		/RETRIEVAL POINTER
	JMS I	DE01		/FIND AN EMPTY ENTRY
	JMP	EXT20		/PARTIALLY SATISFIED
	DCA	EXNFRE		/FREE SEGMENT ADDRESS
	TAD	EXWNDP		/CURRENT WINDOW POINTER
	JMS	EXGE0		/GET IT INTO CORE
	DCA	EXBUFP
	JMS I	SATL1		/GET A FREE DISK SEGMENT FOR THE NEXT WINDOW
	SNA
	JMP	EXT20		/THERE ARE NONE; AVOID LINKING TO NEXT WINDOW
	DCA	EXPROP		/SAVE UNTIL WINDOWS ARE LINKED UP
	TAD	EXNFRE		/NEXT FREE WINDOW
	DCA I	DXBUFP		/LINK IT ONTO CHAIN
	DCA	BUFMOD		/SCHEDULE WRITE
	TAD	EXNFRE
	DCA	EXWNDP		/UPDATE CURRENT WINDOW POINTER
	TAD	EXWNDP
	JMS	EXGE0		/GET NEW WINDOW INTO CORE
	IAC
	DCA	EXBUFP		/POINTER TO FIRST ENTRY OF NEW WINDOW
	TAD	C7771		/ALLOW 7 ENTRIES IN NEW WINDOW
	DCA	EXT1
	TAD	EXPROP		/GET DISK SEGMENT
EXT12,	DCA I	EXBUFP		/STORE SEGMENT IN RETRIEVAL WINDOW
	DCA	BUFMOD		/SCHEDULE WRITE
	ISZ I	EXQ1		/INCREMENT TOTAL COUNT IN UFDTBL
	ISZ	EXBUFP		/INCR WINDOW POINTER
	ISZ	EXSEGC		/HAVE WE EXTENDED FAR ENOUGH?
	JMP	EXT6		/NO
EXT20,	TAD	EXSEGC
	CIA
	DCA	FIUSAC		/NUMBER OF SEGMENTS WE FAILED TO FIND
	TAD	FIOSTK+1	/REQUEST IS SATISFIED
	JMS I	GD01		/GET DIRECTORY ENTRY INTO CORE
	TAD	C0005
	DCA	EXBUFP		/POINTER TO SEGMENT COUNT
	TAD	FIOSTK+2	/NUMBER OF WORDS TO BE ADDED
	TAD I	EXBUFP		/NUMBER ALREADY IN FILE
	TAD	EXSEGC		/MINUS NUMBER WE FAILED TO GET
	DCA I	EXBUFP		/UPDATE ENTRY
	DCA	BUFMOD		/SCHEDULE WRITE
	JMP I	.+1		/EXIT AND WRITE OUT TABLES
	TABOUT

EXT6,	ISZ	EXT1		/END OF CURRENT WINDOW?
	SKP			/NOT YET
	JMP	EXT9		/YES, TRY LINKING TO ANOTHER
EXT7,	JMS I	SATL1		/GET A FREE SEGMENT FROM SAT
	SNA
	JMP	EXT20		/PARTIALLY SATISFIED
	JMP	EXT12		/SAVE NEW SEGMENT
EXGE0,	0			/GET WORD OF THIS UFD INTO CORE
	DCA	EXGE1
	TAD	GDRETP
	JMS I	GE01
EXGE1,	0
	JMP I	EXGE0

EXT30,	TAD	C4400
	JMP	EXT10+2

EXT10,	CLL CML RAR
	CLL CML RAR
	DCA	FIUSAC
	JMP I	FIEXIT

EXTQUA,	EXTQU0
EXFCBP,	0
EXPROP,	0
EXBUFP,	0
EXWNDP,	0
EXSEGC,	0
EXNFRE,	0
/ROUTINE TO SET UP TO ALTER A FILE (BY EITHER EXTENDING IT OR
/REDUCING IT). CHECK PROTECTION CODE TO SEE IF THIS IS ALLOWED. MAKE SURE
/NO ONE ELSE HAS THIS FILE OPEN. JMP TO ERROR EXIT ON EITHER OF THESE CON-
/DITIONS. IF ALL IS OKAY. RETURN WITH PTR TO UFD NAME BLOCK ENTRY
EXT1,	0
	JMS I	IFN01		/MASK OFF BITS 0-9 OF FIOSTK+1
	TAD	FIOSTK+1	/INTERNAL FILE NUMBER
	JMS I	LNK01		/GET PTR TO APPROPRIATE FILE CONTROL BLOCK
	SNA
	JMP	EXT10+1		/ERROR, FILE NOT OPEN
	DCA	EXFCBP		/FILE CONTROL BLOCK POINTER
	JMS I	ACC01		/AS [S]HE UNDER ACCOUNT1?
	JMP	EXT2		/YES; SKIP PROTECTION CHECK
	TAD	FILPRP		/GLOBAL TO "FILPRO"
	TAD	EXFCBP
	DCA	EXPROP		/POINTER TO PROTECTION BIT
	DATFLD			/CDF FIELD 1
	TAD I	EXPROP		/PICK UP PROTECTION BIT
	CFLD			/CHANGE TO CURRENT FIELD
	AND	P0004		/STRAIN OFF ANY EXTRANEOUS BITS
	SZA CLA
	JMP	EXT10		/WRITE PROTECTED
EXT2,	TAD	FIOSTK+1	/INTERNAL FILE NUMBER
	JMS I	GD01		/GET DIRECTORY ENTRY INTO CORE
	DCA	REL6		/POINTS TO WHERE UFD NAME BLOCK IS IN CORE
	JMS I	ENR01		/IS THIS THE ONLY USER WHO HAS THIS FILE OPEN?
	JMP	EXT30		/NO, SO ABORT AND RETURN ERROR CODE
	TAD	FIOSTK+2	/ARE ANY SEGMENTS INVOLVED?
	SNA
	JMP I	FIEXIT		/NO, NOTHING TO DO THEN
	CIA
	DCA	EXSEGC		/SAVE NEGATIVE COUNT
	DATFLD
	TAD I	EXFCBP		/GET POINTER TO CURRENT WINDOW
	DCA	EXPROP
	IAC
	DCA I	EXPROP		/INVALIDATE THE WINDOW
	CFLD
	TAD	REL6
	JMP I	EXT1
/ROUTINE TO REDUCE A FILE

*1600

RED0,	JMS I	EXT11		/MAKE SURE IT'S OKAY TO REDUCE THIS FILE
	DCA	REBUFP		/...IF OKAY, RETURNS WITH PTR TO FILE NAME BLOCK
	JMS I	ACC01		/IS [S]HE UNDER ACCOUNT 1?
	JMS I	REDUFD		/SEE IF [S]HE'S REDUCING A UFD
	TAD	REBUFP
	TAD	C0005
	DCA	RELINK		/NOW POINTS TO NUMBER OF SEGMENTS PRESENTLY IN FILE
	TAD	FIOSTK+2	/SEGMENTS TO BE REMOVED
	SPA			/IS IT NEGATIVE?
	JMP	RED5		/YES; DELETE THE ENTIRE FILE
	CIA
	TAD I	RELINK
	SMA SZA			/DELETE THE FILE?
	JMP	RED6		/NO, REDUCE IT
RED5,	CLA CLL			/YES, WIPE IT OUT AND CLOSE
	TAD	REBUFP
	JMS	RED1		/WIPE OUT THE FILE NAME BLOCK FROM THE UFD
	TAD	FIOSTK+1	/INTERNAL FILE NUMBER
	JMS I	CL01		/CLOSE THIS FILE SINCE IT NO LONGER EXISTS
	JMP I	FIEXIT
RED6,	DCA I	RELINK		/UPDATE SEGMENT COUNT
	DCA	BUFMOD		/SCHEDULE WRITE
	TAD I	RELINK
	DCA	CFH
	ISZ	RELINK
	ISZ	RELINK
	TAD I	RELINK
	DCA	RELINK		/POINTER TO FIRST WINDOW ON CHAIN
	TAD	CFH
	JMS	RED40		/WIPE OUT REST OF FILE
	JMP I	FIEXIT

REDGD1,	GD1

RED40,	0
	JMS I	WND201		/DIVIDE BY 7
	CMA
	DCA	REWNDC		/NUMBER OF WHOLE WINDOWS WHICH ARE TO REMAIN
	TAD	RELINK		/GET POINTER TO FIRST RETRIEVAL WINDOW
	JMS I	RED302		/ROUTINE TO DO ACTUAL REDUCTION
	JMP I	RED40

EXT11,	EXT1
LINK01,	LINK0
RED302,	RED30
REDUFD,	REDUF0
REBUFP,	0
/ROUTINE TO DELETE A FILE

UFBUFP,
RED1,	0
	DCA	REBUFP		/PTR TO THE UFD ENTRY FOR THE FILE
	TAD	REBUFP
	TAD	P0003
	DCA	RELINK		/LINK TO NEXT FILE NAME IN THIS UFD
	TAD I	RELINK
	DCA	RED3
	TAD I	REDGD1		/UFD ADDR OF THIS DIRECTORY ENTRY
	DCA	RED4
	TAD	REBUFP
	TAD	P0007
	DCA	RELINK		/NOW POINTS TO A RETRIEVAL BLOCK FOR THIS FILE
	TAD I	RELINK
	DCA	RELINK
RED2,	DCA I	REBUFP		/CLEAR OUT FIRST WORD OF ENTRY
	ISZ	REBUFP
	TAD	REBUFP
	AND	P0007
	SZA CLA			/END OF CURRENT WINDOW?
	JMP	RED2		/NO, KEEP CLEARING
	DCA	BUFMOD		/SCHEDULE WRITE
	JMS I	LINK01
RED4,	0			/UFD ADDR OF THIS DIRECTORY ENTRY
RED3,	0			/UFD ADDR OF DIRECTORY ENTRY WHICH IS NEXT IN THE CHAIN
	JMS	RED40		/GO WIPE OUT ACTUAL FILE
	JMP I	RED1
/ROUTINE TO EXTEND A UFD

/CALLING SEQUENCE:
/	TAD (RETRIEVAL POINTER)
/	JMS UFD0
/	ERROR RETURN
/	NORMAL RETURN

UFD0,	0
	DCA	UFRETP		/RETRIEVAL POINTER
	TAD	C7771
	DCA	CFH		/COUNTER FOR OVERSIZE UFD
/NOW SCAN DOWN THE UFD'S FILE RETRIEVAL BLOCK
UFD2,	TAD I	UFRETP
	SNA CLA
	JMP	UFD1		/FOUND THE END OF THE LIST OF SEGMENT NUMBERS
	ISZ	UFRETP		/POINT TO NEXT SEGMENT NUMBER
	ISZ	CFH		/UFD ALREADY MAXIMUM SIZE?
	JMP	UFD2		/NO, LOOK AT NEXT WORD
	JMP I	UFD0		/YES, ERROR RETURN

/COMES HERE WHEN IT HAS FOUND THE END OF THE RETRIEVAL BLOCK'S LIST OF SEGMENTS
UFD1,	JMS I	SATL1		/GET A FREE SEGMENT FROM SAT
	SNA
	JMP I	UFD0		/NO MORE FREE SEGMENTS
	DCA I	UFRETP		/ADD TO RETRIEVAL INFORMATION
	TAD	UFRETP
	JMS I	ENS31		/CONVERT ABS RETTBL PTR TO A RELATIVE ENTRY NUMBER
	CLL RTL			/...TIMES FOUR
	TAD	UFDTBL		/...PLUS BASE ADDR OF UFDTBL
	DCA	CFH		/POINTER TO PROJ,PROG NUMBER OF FILE OWNER
	TAD I	CFH		/PICK UP PROJ,PROG NUMBER
	JMS I	UFO61		/GO GET THE RETRIEVAL INFO FOR THIS GUY'S UFD INTO CORE
	JMP I	DIRBAD		/*************DEBUG ONLY***********
	DCA	UFBUFP		/PTR TO RETRIEVAL INFORMATION
	ISZ	UFBUFP
	TAD I	UFBUFP
	SZA CLA			/SCAN TO END OF LIST OF SEGMENT NUMBERS
	JMP	.-3
	TAD I	UFRETP		/GET NUMBER OF NEW SEGMENT
	DCA I	UFBUFP		/PUT IT IN RETRIEVAL BLOCK LIST
	DCA	BUFMOD		/SCHEDULE WRITE
	STA
	DCA	TABSTA		/SET TABLE STATUS TO CHANGE
	TAD I	UFRETP		/NEW SEGMENT NUMBER
	JMS	SCL0		/ZERO OUT THE NEW SEGMENT
	ISZ	UFD0		/SET UP NORMAL RETURN
	JMP I	UFD0

ENS31,	ENS3
UFO61,	UFO6
/ROUTINE TO ZERO OUT A DISC SEGMENT
/IT ZEROES THE CORE BUFFER THEN EXECUTES A CALL
/TO RD301 (THE ACTUAL READ NEVER HAPPENS).
/THUS, THE SYSTEM THINKS THAT THE SEGMENT BEING
/CLEARED IS ACTUALLY IN CORE. IT WILL BE WRITTEN OUT LATER.
SCL0,	0
	DCA	UFRETP		/SEGMENT NUMBER
	JMS I	WRT1		/MAKE SURE THE BUFFER IS EMPTY
	TAD	P7400
	DCA	CFH		/SET UP COUNTER FOR CLEARING SEGMENT
	TAD	BUFFER
	DCA	UFBUFP
UFD3,	DCA I	UFBUFP		/START TO CLEAR BUFFER AREA
	ISZ	UFBUFP
	ISZ	CFH
	JMP	UFD3
	STA
	TAD	UFRETP		/SEGMENT NUMBER
	JMS I	SCL11		/NOW FAKE A READ
	DCA	BUFMOD		/SCHEDULE WRITE
	JMP I	SCL0
RELINK,
UFRETP,	0
SCL11,	SCL1
P7400,	7400

/ROUTINE TO PROVIDE FILE INFORMATION

*2000

INF0,	JMS I	IFN01		/GET INTERNAL FILE NUMBER IN FIOSTK+1
	TAD	FIOSTK+1	/INTERNAL FILE NUMBER
	JMS I	EBLD0
	DCA	CFH		/RELATIVE POINTER TO UFD RETRIEVAL INFORMATION
	TAD I	CFH		/GET PTR TO RETTBL OUT OF ENTTBL
	SNA			/DOES IT EXIST?
	JMP	INF1		/NO, SO FILE IS NOT OPEN
	CIA
	CLL CMA RTL		/SUBTRACT ONE; MULTIPLY BY FOUR
	TAD	UFDTBL
	DCA	INUFDP		/POINTER TO USER PROJ,PROG NUMBER
	TAD I	INUFDP
	DCA	FIOSTK+2	/SET UP LINKAGE FOR GD0
	TAD	FIOSTK+1	/INTERNAL FILE NUMBER
	JMS I	GD01		/GET DIRECTORY ENTRY FOR THIS FILE INTO CORE
	CIA
	CMA
	DCA	INDEX		/SET UP INDEX REGISTER FOR TRANSFER
	TAD I	INDEX		/OF NAME AND OTHER DIRECTORY INFORMATION
	DCA	FIOSTK+3
	TAD I	INDEX
	DCA	FIOSTK+4
	TAD I	INDEX
	DCA	FIOSTK+5
	ISZ	INDEX
	TAD I	INDEX
	DCA	FIOSTK+6
	TAD I	INDEX
	DCA	FIOSTK+7
INF5,	DATFLD
	TAD I	FIOPTR		/PICK UP JOBLNK WORD FROM JOB STATUS BLOCK
	DCA	INF4		/DESTINATION IN FIELD 0
	CFLD			/CHANGE TO PRESENT FIELD
	6202			/CIF FIELD 0
	BLT			/MOVE FIOSTK INFORMATION INTO IOT PARAMETER BLOCK
	6221			/SOURCE FIELD
	FIOSTK			/SOURCE
	DATFLD			/DESTINATION FIELD
INF4,	0			/DESTINATION
	-10			/WORD COUNT
INF6,	CDF
	TAD I	OURFLD
	AND	C0200
	SZA CLA
	JMP I	FIEXIT		/WE WERE CALLED BY SI - DON'T SET JSIOTC OR WE'LL GAG
	DATFLD
	TAD I	JOBDAT		/GLOBAL TO "JOBDAT"
	IAC
	DCA	INSPTR		/NOW POINTS TO STATUS WORD
	TAD	INIOTC		/JSIOTC
	CMA
	AND I	INSPTR		/SET JSIOTC TO INDICATE THAT FIP
	TAD	INIOTC		/...IS RETURNING INFORMATION IN THE IOT PAR. BLOCK
	DCA I	INSPTR
	JMP I	FIEXIT		/EXIT

INF1,	DCA	FIOSTK+2
	JMP	INF5

INUFDP,	0
INSPTR,	0
OURFLD,	CORTBL+1
INIOTC,	40


/ROUTINE TO SKIP IF CALLING USER IS NOT SYSTEM MANAGER
ACT01,	0
	JMS I	JBLD0		/GET PPN
	CLL RAR
	SZA CLA			/IS IN ACCOUNT 1?
	ISZ	ACT01		/NO; SKIP ON RETURN
	JMP I	ACT01
/LOGIN ROUTINE

LGI0,	TAD	RETTBL		/MFD RETRIEVAL IS IN ENTRY 0
	DCA	FIOSTK+1	/SET UP PTR TO RETRIEVAL INFORMATION CONTAINED IN RETTBL
	TAD	FIOSTK+2	/ACCOUNT #0
	SNA CLA
	JMP	LGI20		/UNAUTHORIZED ACCOUNT
	JMS I	DS01		/SEARCH THE MFD (AC=0 TO INDICATE 3-WORD SEARCH)
	FIOSTK+1		/ADDR OF PTR TO RETRIEVAL INFORMATION OF DIRECTORY TO BE SEARCHED
	JMP	LGI20		/COULD NOT FIND ENTRY IN MFD
	DCA	LGMFDP		/OK TO LOG IN - POINTER TO DIRECTORY ENTRY IS IN ACC.
	TAD	FIOSTK+2	/PROJ,PROG NUMBER
	JMS I	UTS01		/SEARCH THE UFD TABLE
	SKP			/THIS PROJ,PROG NUMBER NOT THERE
	JMP	LGI1		/UFD ALREADY ON TABLE - RETURNS WITH ITS RELATIVE POSITION IN TABLE
	TAD	FIOSTK+2	/PROJ,PROG NUMBER
	JMS I	UFO01		/OPEN THE UFD - I.E. MAKE AN ENTRY IN UFDTBL, RETTBL
	JMP	LGI20		/COULD NOT FIND ROOM ON TABLE

LGI1,	CLA CMA
	TAD I	UTPRNU
	DCA I	UTPRNU		/ACCOUNT FOR NEW ENTRY IN ACCESS COUNT

/COMES HERE WHEN THE UFDTBL & RETTBL HAVE BEEN UPDATED
/TO INCLUDE THIS LOGIN

	FGETJT
	JOBSTS
	DCA	LGI3		/ADDRESS OF STR0
	TAD	FIOSTK+2	/ACCOUNT NUMBER?
	AND	C7774		/IS IT LESS THAN 4?
	SNA CLA
	TAD	C0200		/YES - SET ACCOUNT PRIVILEGE BIT
	DATFLD
	DCA I	LGI3		/AND SAVE IT
	JMS I	JBLD0
	CLA
	TAD	FIOSTK+2	/PROJ,PROG NUMBER
	JMP I	.+1
	RESET

LGI20,	CFLD
	CLA CMA			/COULD NOT LOGIN - RETURN WITH 7777
	DCA	FIUSAC		/INDICATE INABILITY TO LOG IN
	JMP I	FIEXIT

GTB1,
LGMFDP,	0

/DIRECTORY SEARCH

/CALLING SEQUENCE:
/	CLA OR CIA (3 OR 1 WORD SEARCH)
/	JMS DS0
/	POINTER-----------------RETRIEVAL STACK POINTER
/	RETURN IF NOT FOUND	NA
/	GOOD RETURN		ME
/	(POINTER IN AC)		XX

*2200
DS0,	0
	SNA CLA			/SKIP IF ONE WORD SEARCH
	CLL CML RTL		/THREE WORD COMPARE
	CMA
	DCA	DSWDNR		/MINUS NUMBER OF WORDS TO COMPARE
	TAD I	DS0		/PICK UP POINTER TO RETRIEVAL INFORMATION
	DCA	DSRETS
	ISZ	DS0
	TAD	DSM160		/SET UP COUNTER ON # ENTRIES CHECKED
	DCA	DSKCNT
	TAD I	DSRETS		/GET RETRIEVAL POINTER
	CIA
	TAD	RETTBL
	SNA CLA
	STA			/INHIBIT SEGMENT COUNTING OF THE MFD
	DCA	SEGLIM		/ZERO SEGMENT COUNTER
DS2,	DCA	DS1
	TAD I	DSRETS		/GET PTR TO RETRIEVAL INFORMATION BLOCK
	JMS I	GE01		/GET THE ENTRY INTO CORE
DS1,	0			/WORD NUMBER -- I.E. THE ADDR WITHIN THE DIRECTORY
	SNA
	JMP	BADDIR		/FOULED-UP DIRECTORY!
	DCA	DSENTP		/STORE POINTER TO ENTRY
	TAD	C0005
	TAD	DSENTP
	DCA	DSCNTR		/POINTS TO SEGMENT COUNT
	TAD	SEGLIM		/THE TOTAL FOR THIS UFD
	SPA			/IS IT A UFD?
	JMP	DS4		/NO; SEE IF WE SHOULD RESET THE MFD
	TAD I	DSCNTR		/ADD THIS FILE'S COUNT
	DCA	SEGLIM		/SAVE NEW TOTAL
DS3,	TAD	DSWDNR		/NUMBER OF WORDS TO COMPARE
	DCA	DSCNTR
	TAD	DSRETS
	DCA	DSOBJT		/POINTER TO OBJECT NAME
	TAD	DSENTP
	DCA	DSENT		/POINTER TO NAME IN BUFFER
DSCOM2,	TAD I	DSENT
	ISZ	DSENT
	CIA
	ISZ	DSOBJT
	TAD I	DSOBJT
	SZA CLA
	JMP	DSCOM1		/NOT FOUND
	ISZ	DSCNTR
	JMP	DSCOM2		/LOOK AT NEXT WORD OF NAME
	ISZ	DS0		/FOUND THE ENTRY
	TAD	DSENTP		/PICK UP POINTER
	JMP I	DS0		/RETURN
/THIS ENTRY IS NOT THE ONE WE'RE LOOKING FOR, SO WE MUST
/GO LOOK AT THE NEXT ONE.  IN THIS ENTRY IS A RELATIVE PTR TO THE NEXT ONE
/GET IT.
DSCOM1,	ISZ	DSKCNT		/BAD DIRECTORY?
	JMP	DSCOM3		/IT ISN'T BAD AT THIS POINT
BADDIR,	DCA	RESFLG		/CLEAR AC AND RESET FLAG
	TAD	P5400		/YES, INDICATE BAD DIRECTORY AND GET OUT
	DCA	FIUSAC		/ONCE AGAIN, GOODNESS TRIUMPHS OVER EVIL
	JMP	RETURN		/GO CLEAN UP BEFORE ABORTING
DSCOM3,	TAD	P0003		/CREATE POINTER TO NEXT ENTRY
	TAD	DSENTP
	DCA	DSCNTR
	TAD I	DSCNTR
	SZA			/IS THIS THE END OF THE DIRECTORY CHAIN?
	JMP	DS2		/NO, SO CONTINUE SEARCH
	TAD	P0003
	TAD	DS1
	JMP I	DS0
DS4,	TAD	RESFLG		/SHOULD WE RESET?
	SZA CLA
	JMP	DS3		/NO
	DCA I	DSCNTR		/CLEAR CPU TIME ACCUMULATOR
	ISZ	DSCNTR
	DCA I	DSCNTR		/CLEAR DEVICE TIME ACCUMULATOR
	DCA	BUFMOD		/REMEMBER TO WRITE IT BACK
	JMP	DS3
DSWDNR,	0
ENRETP,
DSRETS,	0
ENADDR,
DSENTP,	0
DSOBJT,	0
DSENT,	0
DSM160,	-161			/-MAXIMUM # FILES USER CAN OWN (+2)
/RETURN A BLOCK OF FREE CORE
RESFLG,
RETBKS,	0
	CFLD
	CIF
	RETBLK
	JMP I	RETBKS
/RETURN A LINKED LIST OF FREE BLOCKS
ENTPTR,
DSKCNT,
RETBLS,	0
	SNA
	JMP I	RETBLS
	JMS	RETBKS
	JMP	.-3
/SEARCH ENTTBL FOR OPENINGS TO FILE
/CALLING SEQUENCE:
/	TAD (RETRIEVAL POINTER)
/	JMS ENS0
/	UFD ADDRESS OF DIRECTORY ENTRY
/	RETURN - FOUND AN ACCESS
/	RETURN - FOUND NO ACCESS

DSCNTR,
ENS0,	0
	JMS I	ENS30
	DCA	ENRETP		/RELATIVE POINTER
	TAD I	ENS0		/GET FILE DIRECTORY ADDRESS
	CIA
	DCA	ENADDR
	ISZ	ENS0		/SKIP PAST ARG
	TAD	ENTTBL
	DCA	ENTPTR
ENS2,	TAD	ENRETP
	CMA
	TAD I	ENTPTR
	ISZ	ENTPTR
	SZA CLA
	JMP	ENS1		/DIFFERENT UFD ACCESS
	TAD I	ENTPTR		/SAME UFD, SAME FILE?
	TAD	ENADDR
	SZA CLA
	JMP	ENS1		/DIFFERENT FILE
	TAD	FIOSTK		/WHICH IOT BROUGHT US HERE?
	TAD	ENSCRF		/IF IT'S "CRF" ONE MATCH IS ENOUGH
	SNA CLA
	JMP I	ENS0		/IT WAS; GET OUT
	TAD	FIOSTK+1	/FOUND A SIMILAR ENTRY
	JMS I	EBLD0		/SEE IF WE FOUND THE ENTRY FOR
	CMA			/THE GUY WHO CAUSED THE CALL TO
	TAD	ENTPTR		/ENS0; IF IT IS, IGNORE THIS MATCH
	SZA CLA
	JMP I	ENS0		/FOUND A SIMILAR ENTRY; DIFFERENT ENTTBL ENTRY
ENS1,	ISZ	ENTPTR
	TAD	ENTPTR
	CIA
	TAD	ENTEND		/END OF ENT TABLE
	SZA CLA
	JMP	ENS2		/KEEP LOOKING
	ISZ	ENS0		/SKIP ON RETURN
	JMP I	ENS0
ENS30,	ENS3
ENSCRF,	-CRF
/ROUTINE TO LOOK IN THE SAT FOR A FREE SEGMENT

/CALLING SEQUENCE:
/	JMS SATLOK
/	RETURN (SEGMENT NUMBER IN AC, 0=NONE AVAILABLE)
*2400
SATLOK,	0
	CLA CMA CLL RAL		/7776
	DCA	SATMSK		/MAKE TWO PASSES OF THE TABLE
	TAD I	SATCNT		/# OF AVAILABLE DISC SEGMENTS
	SNA			/ARE THERE ANY?
	JMP I	SATLOK		/NO, SO FORGET IT
	CIA
	CMA
	DCA I	SATCNT		/DECREMENT SATCNT
	DCA	SATCT2
	CLA CMA
	DCA	SATSTA		/SET SAT STATUS TO WRITE OUT
/LOOK FOR A WORD IN SAT TABLE WITH A ZERO BIT IN IT
SAT1,	TAD I	SATPNT		/GET A WORD FROM SAT TABLE
	CMA
	SZA CLA			/ARE ALL BITS SET TO ONE?
	JMP	SAT2		/NO, SO WE'VE FOUND A SEGMENT
	ISZ	SATPNT		/WAS THIS THE LAST WORD IN THE SAT TABLE?
	JMP	SAT1		/NO, SO KEEP LOOKING
	TAD	SAT5		/START LOOKING FROM THE BEGINNING
	DCA	SATPNT		/PTR INTO SAT TABLE
	ISZ	SATMSK
	JMP	SAT1		/MAKE 1 MORE PASS
	DCA I	SATCNT		/SOMETHING WRONG.. BETTER AVOID L2Q OVERFLOW
				/BY SAYING NO SEGMENTS AVAILABLE
	JMP I	SATLOK
SAT5,	-SATSIZ+2

/WE FOUND A SAT WORD WITH A ZERO BIT. NOW FIND THAT BIT.
SAT2,	CLL CML RAR		/4000 INTO ACC.
	DCA	SATMSK
	ISZ	SATCT2
	TAD I	SATPNT		/GET WORD FROM SAT TABLE
	AND	SATMSK		/IS THE BIT CORRESPONDING TO THE ONE IN SATMSK SET?
	SNA
	JMP	SAT3		/NO, SO WE FOUND THE ZERO BIT
	RAR			/MOVE MASK BIT ONE TO THE RIGHT
	JMP	SAT2+1		/...AND LOOK AT THE NEXT BIT

/FOUND THE BIT WITHIN THE WORD - SATCNT INDICATES WHICH ONE IT IS
SAT3,	TAD	SATMSK
	TAD I	SATPNT
	DCA I	SATPNT		/SET THE BIT IN SATTBL TO INDICATE THAT THIS SEGMENT IS NOW ALLOCATED
	TAD	SATPNT
	TAD	C0526
	DCA	SATMSK
/NOW CALCULATE THE NUMBER OF THE DISC SEGMENT
/WHICH CORRESPONDS TO THIS BIT IN THE SAT TABLE
	TAD	SATMSK
	CLL RAL
	TAD	SATMSK
	RTL
	TAD	SATCT2
	JMP I	SATLOK		/EXIT WITH DISC SEGMENT NUMBER IN AC


SATPNT,	-SATSIZ+2
SATCNT,	-SATSIZ+1
SATEMP,
SATCT2,	0
SATMSK,	0
/ROUTINE TO RELEASE A SEGMENT IN SAT

/CALLING SEQUENCE:
/	TAD (SEGMENT NUMBER)
/	JMS SATREL

/DIVIDE SEGMENT NUMBER BY 14 (12 DECIMAL)
/QUOTIENT INDICATES WHICH WORD IN SAT TABLE CORRESPONDS
/TO THIS DISC SEGMENT. REMAINDER INDICATES WHICH BIT IN
/THAT WORD.
SATREL,	0
	TAD	P2000		/SUBTRACT 14 X 400
	SZL			/WAS THE SEGMENT THAT BIG?
	JMP	.+3		/YES
	TAD	P6000		/NO, ADD 14 X 400
	CLL			/UN-DO THE LINK
	RAL			/SHIFT OUT A BIT OF THE QUOTIENT
	ISZ	CFH
	JMP	SATREL+1	/MORE TO DO YET
	DCA	SATPNT		/REMAINDER IN LINK THRU AC2; QUOTIENT IN AC3 THRU AC11
	TAD	SATPNT
	AND	P7000
	RTL
	RTL
	CMA			/NEGATE THE REMAINDER
	DCA	SATEMP
	TAD	SATPNT
	AND	P0777		/JUST THE QUOTIENT THIS TIME
	TAD	SAT5
	DCA	SATPNT
	CLL CMA
	RAR
	ISZ	SATEMP		/SET UP A MASK CORRESPONDING TO PROPER BIT
	JMP	.-2
	AND I	SATPNT		/CLEAR SAT TABLE BIT; SEGMENT IS NOW AVAILABLE
	DCA I	SATPNT
	ISZ I	SATCNT		/UPDATE THE AVAILABLE SEGMENTS COUNT
	CLL STA
	DCA	SATSTA		/REMEMBER WE CHANGED THE SAT TABLE
	JMP I	SATREL
/ACTUAL I/O ROUTINE
/SET UP ALL I/O PARAMETERS IN #FLPARB#, AND JMS FIPIO

FIPIO,	0
	TAD	FIPFLD
	RAR
	DCA	FLPARB+2	/='S FIELD WE'RE IN TIMES 4
	CDF
	TAD I	JOB
	AND	C0400		/FIP OR SI CORTBL BIT ON?
	SNA CLA
	JMP	.+3		/SI
	TAD	FIJOB
	DCA I	FIPJOB		/FIP - KEEP HIGH PRIORITY ON THE SCHEDULER
	TAD	FIRETP		/POINTER TO FIORET
	DCA	1		/RETURN ADDRESS - SET TO RETURN BELOW WHEN FIP IS RESTARTED
	TAD	FIO3		/GET FIPBLK
	DATFLD
	DCA I	FIUTBA
	CFLD
	CIF 00
	BLT			/MOVE DISC TRANSFER PARAMETERS INTO FREE BLOCK LINKED TO DSUTBL
	CFLD			/FIP ALWAYS IN FIELD 2
	FLPARB			/PARAMETER BLOCK
	DATFLD			/DESTINATION FIELD
FIO3,	FIPBLK			/DESTINATION
	-10			/WORD COUNT
	CDF CIF 00
	ISZ I	DSBUSY		/GLOBAL TO "DSBUSY"
	WAIT			/DISK BUSY
	JMP I	OVER		/GO TO FIELD 0 TO INITIATE THE TRANSFER

/MONITOR RETURNS CONTROL HERE AFTER COMPLETING THE TRANSFER
FIORET,	CLA			/RETURNS FROM DISC I/O COME HERE
	TAD	C0200		/RESET THE FIP STARTING ADDRESS
	DCA	1		/... TO 0200
	FGETJT
	JOBSTS
	DATFLD
	DCA	FIPTR1
	TAD I	FIPTR1		/PICK UP #JOBSTS#
	CFLD			/CHANGE TO CURRENT FIELD
	TAD	P0003
	AND	P0007		/CHECK ERROR BITS
	SZA CLA
	ISZ	FIPIO		/NO DISC TRANSFER ERROR
	JMP I	FIPIO		/EXIT WITHOUT SKIPPING TO INDICATE DISC TRANSFER ERROR

FIPTR1,	0
FIUTBA,	DSUTBL+4+4
FIRETP,	FIORET
C0526,	0526
OVER,	OVRLA1
/ROUTINE TO GET A DIRECTORY WORD INTO CORE
/CALLING SEQUENCE:
/	TAD (POINTER TO RETRIEVAL INFORMATION)
/	JMS GE0
/	WORD NUMBER
/	RETURN (BUFFER POINTER IN AC. 0 IF NON-EXISTENT)

*2600

GE0,	0
	DCA	GERETP		/STORE RETRIEVAL INFORMATION POINTER
	TAD I	GE0
	CLL RAL
	RTL
	RTL
	AND	P0007
	TAD	GERETP
	DCA	GERETP
	TAD I	GERETP
	SNA
	JMP	GE3
	CIA
	CMA
	DCA	RDTEMP
/FILE READ ROUTINE, CHECKS TO SEE IF BUFFER IS FULL.
/IF SO, IS IT THE SEGMENT WE ARE TRYING TO READ?
/IF YES, LEAVE. IF NO, WRITE OUT THE BUFFER
/BEFORE READING THE PROPER SEGMENT.
	TAD	RDCURR		/MAY THE DESIRED SEGMENT ALREADY BE IN THE BUFFER
	CIA
	TAD	RDTEMP
	SNA CLA
	TAD	BUFSTA		/PROBABLY; IS THE DATA STILL VALID?
	SPA
	JMP	RD3		/YES
	SNA			/MAYBE
	JMS I	WRT1		/WRONG SEGMENT, SO WRITE IT OUT (IF MODIFIED)
	DCA	BUFSTA		/SAVE BUFFER STATUS
	TAD	RDTEMP
	JMS	RD30		/SET UP PARAMETERS FOR A READ OPERATION
	TAD	BUFSTA		/WAS THE CORRECT DATA IN THE BUFFER AFTER ALL?
	SZA CLA
	JMP	RD3		/YES; ONLY NEEDED TO SET THE DISK PARAMETERS
	JMS I	FIO01		/PERFORM THE READ
	JMP I	DIRBAD		/ERROR ON READ
	IAC
	DCA	BUFMOD		/NEW DATA AS YET UNCHANGED
RD3,	CLA CMA
	DCA	BUFSTA		/SET BUFFER STATUS TO FULL
	TAD	C0377
	AND I	GE0		/ADDRESS WITHIN SEGMENT
	TAD	BUFFER		/CREATE A POINTER
GE3,	ISZ	GE0
	JMP I	GE0		/RETURN
GERETP,	0
RDTEMP,	0
RDCURR,	0
K7400,	7400
C0377,	0377



/ROUTINE TO DIVIDE A NUMBER BY 7
/REMAINDER IS LEFT IN WNDREM, PAGE 0

WND20,	0
	DCA	WNDREM
	DCA	CFH
	TAD	WNDREM
WND24,	TAD	C7771
	SPA
	JMP	WND21
	ISZ	CFH
	JMP	WND24
WND21,	TAD	P0007
	DCA	WNDREM
	TAD	CFH
	JMP I	WND20

/ROUTINE TO SET UP FOR A READ.
/ENTER WITH SEGMENT NUMBER. THIS IS CONVERTED TO
/A PHYSICAL DISC ADDRESS.
RD30,	0
	DCA	RDCURR		/SAVE SEGMENT NUMBER
	TAD	RDCURR
	CLL RTR
	RTR
	DCA	RDTEMP
	TAD	RDTEMP
	RAR
	AND	K7400
	DCA	FLPARB+5
	TAD	RDTEMP
	AND	C0377
	TAD	FIBASE
	CLL RTL
	DCA	FLPARB+1
	CFLD			/CHANGE TO CURRENT FIELD
	TAD	K7400
	DCA	FLPARB+3	/WORD COUNT (ONE BUFFER)
	CLA CMA
	TAD	BUFFER
	DCA	FLPARB+4	/CORE ADDRESS
	TAD	C0603		/READ IOT
	DCA	FLPARB
	JMP I	RD30
FIPFIP=	C0400


FIX301,	FIX30
C5600,	5600
USENAM,	0			/CALLED ONLY ONCE BY RE-NAME ROUTINE
	TAD	FIOSTK+1	/TO SEE IF THE NEW NAME EXISTS IN DIRECTORY
	DCA	FIOSTK
	JMS I	JBLD0
	JMS I	UTS01
	JMP I	DIRBAD
	JMS I	BLDP1
	DCA	FIOSTK+1
	JMS I	DS01
	FIOSTK+1
	ISZ	USENAM		/NO FILE OF THIS NAME FOUND - OK TO RENAME
	CLA
	JMP I	USENAM

NUCOR,	CORSRC-2
C7437,	SWAP LOCK NOTRUN FIP CJOB
JOBMX,	-JOBMAX
FIPLOC,	FIPLOK
FIPTIM,	TIMFIP

REL1,	TAD	FIOSTK+1	/RELEASE A DEVICE
	SPA			/DON'T LET THE USER RELEASE CONSOLES
	JMS I	REL01
	CLA
	JMP I	FIEXIT


FIX50,	TAD I	FIOPTR
	AND	FIPFIP		/GLOBAL TO "FIP"
	SNA CLA			/IF FIP BIT IS NOT SET, FIP WAS CALLED BY SI
	JMP I	FIX301		/GET THE SYSTEM INTERPRETER BACK INTO CORE
	TAD	C5600
	AND I	FIOPTR
	DCA I	FIOPTR		/CLEAR OUT THE LOCK BIT
	TAD	JOBMX
	DCA	CFH		/SAVE COUNT OF JOBS TO SCAN
	STL RTL
	TAD I	NUCOR
	SMA
	JMP	FIX51
	DCA I	FIPTIM
	TAD	C7437
	DCA I	FIPLOC
FIX51,	CLA
	DATFLD
	TAD	FIJOB
	TAD	DEVOVR
	DCA	INDEX
FIX50L,	TAD	INDEX
	TAD	JEND
	SZA CLA
	JMP	.+3
	TAD	DEVOVR
	DCA	INDEX
	TAD I	INDEX
	SZA
	JMS I	FIX5CK
	ISZ	CFH
	JMP	FIX50L
	JMP I	.+1
	FIXOUT
JEND,	-JOBTBL-JOBMAX
FIX5CK,	FIXSCH
/ROUTINE TO FREE AN ENTRY ON THE UFD TABLE AND RETTBL

/CALLING SEQUENCE:
/	TAD (POSITION ON UFDTBL)
/	JMS TF0
/	RETURN


TF0,	0
	DCA	TFUFDP		/POSITION ON TABLE
	DCA I	TFUFDP		/CLEAR OWNER'S PROJ,PROG NUMBER
	TAD	UFDTBL		/BEGINNING OF TABLE
	CIA
	TAD	TFUFDP
	CLL RTR			/RELATIVE POSITION ON TABLE
	IAC
	JMS I	BLDP1		/BUILD A PTR TO RETTBL
	DCA	TFUFDP		/POINTER TO RETRIEVAL INFORMATION
	TAD	P7770		/8 WORDS PER ENTRY
	DCA	TFCNTR
TF1,	DCA I	TFUFDP		/ZERO OUT THE ENTRY
	ISZ	TFUFDP
	ISZ	TFCNTR
	JMP	TF1
	JMP I	TF0

TFUFDP,	0
TFCNTR,	0

/ROUTINE TO CHECK WHETHER THE FILE A USER
/IS ATTEMPTING TO ACCESS IS HIS/HERS OR SOMEONE ELSE'S.

/CALLING SEQUENCE:
/	TAD (INTERNAL FILE NUMBER)
/	JMS UC0
/	ERROR RETURN (AC=0 IF FILE NOT OPEN)
/	NORMAL RETURN

UC0,	0
	JMS I	EBLD0
	DCA	UCENTP
	TAD I	UCENTP		/PICK UP ENTRY FOR THIS FILE OF THIS USER'S
	SNA
	JMP I	UC0		/FILE NOT OPEN
	CIA
	CLL CMA RTL		/SUBTRACT ONE; MULTIPLY BY FOUR
	TAD	UFDTBL
	DCA	UCUFDP		/POINTER TO OPEN UFD TABLE
	JMS I	JBLD0
	CIA
	TAD I	UCUFDP
	SNA			/SKIP IF DIFFERENT
	ISZ	UC0		/CORRECT RETURN
	JMP I	UC0

UCENTP,	0
UCUFDP,	0
/LOGOUT ROUTINE

LGO0,	JMS I	ACC01		/IS IT FROM ACCOUNT 1?
	TAD	FIOSTK+1	/YES; SEE IF [S]HE WANTS TO RESET
	TAD	FIJOB		/SEE IF HIS/HER AC=JOB
	SNA CLA
	JMP I	LGRESA		/GO CLEAR EVERYBODY'S CPU & DEVICE TIME ACCUMULATORS
	TAD	FIOSTK+1	/DID [S]HE SET HIS/HER AC= TO HIS/HER JOB #?
	CIA
	TAD	FIJOB
	SZA CLA
	JMP I	LGO1A		/NO; SO SEE IF [S]HE WANTS COUNT OF USERS UNDER HIS/HER ACCOUNT
	JMS I	LNS01		/RELEASE ALL HIS/HER DEVICES
	JMP	.+3
	JMS I	REL01
	JMP	.-3		/KEEP GOING
	JMS I	CL01		/CLOSE FILE 0
	IAC
	JMS I	CL01		/CLOSE FILE 1
	CLL CML RTL
	JMS I	CL01		/CLOSE FILE 2
	TAD	P0003
	JMS I	CL01		/CLOSE FILE 3
	JMS I	JBLD0
	DCA	LOSRRI+1	/DELIVER TO CALLING SEQUENCE FOR SEARCH
	TAD	CFH
	DCA	LOJOBP
	CLA CMA
	JMS I	DS01		/FIND MFD ENTRY; 1 WORD SEARCH
	LOSRRI
	JMP I	DIRBAD		/************DEBUG ONLY***********
	TAD	C0006
	DCA	LOSRRI+1	/POINTER TO CP TIME COUNTER
	FGETJT
	JOBRTM			/JOB RUN TIME IN STATUS
	DCA	FIOSTK+6	/INTS TO LOW ORDER RUN TIME
	DATFLD
	TAD I	FIOSTK+6
	RTR
	RTR
	RTR			/USE ONLY HIGH ORDER OF LOW ORDER RUN TIME
	AND	P0077
	DCA	FIOSTK+7
	ISZ	FIOSTK+6
	TAD I	FIOSTK+6
	CFLD			/BACK TO THIS FIELD
	AND	P0077
	CLL RTL
	RTL
	RTL
	TAD	FIOSTK+7
	TAD I	LOSRRI+1
	DCA I	LOSRRI+1	/LOW ORDER TIME UPDATE
	DCA	BUFMOD		/SCHEDULE WRITE