/FIP - UWM VERSION 25
/
/COPYRIGHT 1971, 1975		DIGITAL EQUIPMENT CORPORATION
/				MAYNARD, MASSACHUSETTS
/
/EXTENSIVELY MODIFIED AND CORRECTED BY
/	RICHARD BARTLEIN, 1974, 1976
/	UNIVERSITY OF WISCONSIN - MILWAUKEE

/HANDLES ALL NON RESIDENT FILE IOT'S
/RUNS IN EXEC MODE

	*0
	JMP I .+1
	FIP0
RETBK1,	RETBKS
LNK01,	LNK0
ZDS1,	DSWORD	/POINTER TO 'FIND' LOCATION IN DIRECTORY
P0004=	.
FIDEXP,	FIPDEX	/FIP DISC EXTENSION (SHIFTED 2 BITS)
C002=	.
FILPRP,	FILPRO
C0020=	.
FIPFLD,	20	/FIELD WE ARE RUNNING IN

*10
INDEX,	0	/ONLY REGISTER AVAILABLE IN FIP FOR INDEXING

/CONSTANTS

P0003,	3
C0005,	5
C0006,	6
P0007,	7
C0010,	10
P0037,	37
P0077,	77
C0200,	200
	IFNZRO WRDSEG-400	<GLITCH>
SEGSIZ=.	/WRDSEG
C0400,	400
P0777,	777
P1000,	1000
P2000,	2000
C3777,	3777
P5400,	5400
C6603,	6603	/DMAR - DISC READ IOT
C6605,	6605	/DMAW - DISC WRITE IOT
C7000,	7000
C7400,	7400
C7700,	7700
P7770,	-10
C7771,	-7
C7774,	-4

BUFSTA,	0	/BUFFER STATUS, 7777 IF FULL
BUFWRT,	0	/-1, IF BUFFER CHANGED
CORTBA,	CORTBL-1
FANFLD,	CORTBL-1+2	/PHANTOM FIELD ENTRY
FIBASE,	SWDEX+JOBMAX	/BASE ADDRESS OF ALLOCATABLE DISC STORAGE
FIUSPC,	0	/SAVED USER PC
FILINK,	0	/SAVED USER EAE MODE, LINK, GT, & SC
FIUSAC,	0	/SAVED USER AC
	0	/SAVED USER MQ (IF ANY)
FIACCT,	0	/USER'S ACCOUNT NUMBER
FIJOB,	0	/JOB NUMBER FILE PHANTOM IS REPRESENTING
FIOPTR,	0	/POINTER TO FIELD 0 IOT
GDRETP,	0	/RETRIEVAL POINTER, SET BY GD0 ROUTINE
JOBA,	JOB
JOBDAT,	CJOBDA
OPNFLG,	0
SATSTA,	0	/SAT STATUS, 7777 IF CHANGED THIS RUN
TABSTA,	0	/TABLE STATUS, 7777 IF CHANGED THIS RUN
WNDREM,	0	/REMAINDER FROM DIVISION BY 7

/GLOBALS TO MONITOR DATA AREA

DEVTBA,	DEVTBL
DEVEND,	DEVTBE

/POINTERS TO FILE PHANTOM'S INTERNAL TABLES

ENTEND,		/END OF ENTRY TABLE
UFDTBL,	UTABLE	/TABLE OF ALL ACCESSED UFD'S
UFDEND,		/TOP OF UFD TABLE
RETTBL,	RTABLE	/TABLE OF RETRIEVAL INFORMATION FOR ALL ACCESSED UFD'S
ENTTBL,	ENTABL-10	/TABLE REFLECTING STATE OF ALL POSSIBLE FILE NUMBERS
BUFFER,	SEGBUF	/BUFFER FOR DIRECTORY MANIPULATIONS
SATBOT,	-SATSIZ	/BOTTOM OF STORAGE ALLOCATION TABLE
DEVOVR,
JOBTBA,	JOBTBL	/END OF FIELD 1 DEVICE ASSIGNMENT TABLE


/SUBROUTINE POINTERS

BLDP1,	BLDP	/BUILD A POINTER TO RETTBL
BLT=	JMS I .	/BLOCK TRANSFER
	BLT0
CHKACT=	JMS I .	/CHECK TYPE OF ACCOUNT NUMBER
	CHKAC0
CHKPRV=	JMS I .	/CHECK FOR PRIVILEGE
	CHKPV0
CHKSRC=	JMS I .	/CHECK SOURCE OF FIP CALL
	CHKSR0
CL01,	CL0	/CLOSE A FILE
CORE=	JMS I .	/SEARCH THE CORTBL
	CORSRC
DE01,	DE0	/GET A FREE DIRECTORY ENTRY
DS01,	DS0	/DIRECTORY SEARCH
DTE01,	DTE0
EBLD0,	EBLD	/BUILD 'ENTTBL' ENTRY ADDRESS FROM FILE #
ENS01,	ENS0	/COUNT NUMBER OF FILE OPENINGS
FGETJT=	JMS I .	/FIND JOB STATUS-BLOCK WORD ADDRESS
	FGETJ0
FIO01,	FIPIO	/COMMON DISC IO ROUTINE
GD01,	GD0	/GET A FILE DIRECTORY ENTRY INTO CORE
GE01,	GE0	/GET A DIRECTORY WORD INTO CORE
GETBLK=	JMS I .	/FETCH A FREE BLOCK
	GETB
GETDDB=	JMS I .	/GET A DEVICE DATA-BLOCK
	GETDB0
GETJTA=	JMS I .	/GET A JOB-STATUS WORD ADDRESS
	GETJTB
GTBLO1,	GTBLOK
IFN01,	IFN0
REBOOT=	JMS I .	/INITIATE AUTOMATIC SYSTEM RESTART
	RBOOT
REL01,	REL00
RETBLK=	JMS I .	/RETURN A FREE-CORE BLOCK
	RETB
SATL1,	SATLOK	/GET A FREE SEGMENT FROM SAT
SATR1,	SATREL	/RELEASE A SEGMENT IN SAT
SAVBUF=	JMS I .	/SET 'BUFFER CHANGED' SWITCH
	SAVBF0
SCL01,	SCL0	/CLEAR A DISC SEGMENT TO ZEROES
TF01,	TF0	/FREE AN ENTRY ON UFD TABLE
UC01,	UC0	/USER-OWNER FILE CHECK
UFO01,	UFO0	/OPEN A UFD
UTS01,	UTS0	/SEARCH UFD TABLE FOR PROJ,PROG NUMBER
WAIT=	JMP I .	/RESCHEDULE
	WSCHED
WRT1,	WRITE	/MAKE SURE THE BUFFER IS EMPTY

FIEXIT,	FIX0	/EXIT ROUTINE
LGI201,	LGI20	/-1 TO USER AC

/UTILITY ROUTINES
UTPRNU,	0	/USED BY UTS0 ROUTINE TO HAVE THE PTR TO UFD TABLE WHILE SEARCHING
CFH,	0	/THIS LOCATION IS USED FOR TEMP STORAGE BY MANY ROUTINES
CFLD=	6221	/FIP IS IN FIELD 2 ALWAYS
BASWIN,	WINBAS	/FIELD 1 ADDRESS OF BASIC WINDOW

FIOSTK,	0	/STACK HOLDING IOT LINKAGE
	0
	0
	0
	0
	0
	0
	0

FLPARB,	0	/TABLE FOR READ OR WRITE PARAMETER CONSTRUCTION
	0
	0
	0
	0
	0
	OVERLA
	0

	IFNZRO BILLNG <
LOGACT,	-BILLNG	/BILLING SYSTEM ACCOUNT NUMBER
	>
	*200
/FILE PHANTOM START
/FIP'S FIRST JOB IS TO PICK UP THE IOT WHICH IT IS TO PERFORM
/AND THE PARAMETERS WHICH GO ALONG WITH IT. (IF ANY) THESE
/ARE MOVED INTO AN 8-WORD BLOCK CALLED 'FIOSTK'  THE FIRST REG-
/ISTER IN THIS BLOCK CONTAINS THE IOT. PARAMETERS FOLLOW

FIP0,	CLA CLL
	DCA SATSTA	/CLEAR SAT STATUS
	DCA TABSTA	/CLEAR TABLE STATUS
	DCA BUFWRT	/CLEAR THE 'WRITE BUFFER' SWITCH
/
/*****	NOTE!!! IF, FOR ANY REASON, SOME PROGRAM IN THE SYSTEM
/	WRITES INTO ANY UFD (INCLUDING THE MFD), THE FOLLOWING
/	BUFFER STATUS-CHECK 'ISZ' SHOULD BE NOP'ED OUT. THIS WILL
/	HELP PREVENT THE CASE WHERE FIP READS A BLOCK, THE PROGRAM
/	WRITES INTO IT, AND THEN FIP WRITES IT BACK OUT, THUS
/	CLOBBERING WHAT THE PROGRAM JUST WROTE OUT. NOTE THAT THIS
/	COULD HAPPEN IN REVERSE ALSO, THEREBY MESSING UP FIP.
/
/	NOTE ALSO THAT BY DISALLOWING FIP TO 'REMEMBER' WHAT'S IN
/	ITS BUFFER CURRENTLY DOES NOT COMPLETELY PROTECT AGAINST
/	THE ABOVE PROBLEM AND SHOULD NOT BE TAKEN LIGHTLY.
/*****	*****	*****	*****	*****	*****	*****	*****	*****
	ISZ BUFSTA	/IS THERE ANYTHING IN THE BUFFER?
	JMP .+4		/NO - JUST CLEAR THE SWITCH
	TAD I RDCURA	/YES - RE-SET THE ADDRESS BECAUSE IT
	JMS I RD301	/ MIGHT HAVE BEEN CLOBBERED AT LAST EXIT
	CLA CMA		/THEN RESET THE SWITCH
	DCA BUFSTA
	CDF
	TAD I JOBA	/GLOBAL TO "JOB"
	AND P0037
	SNA		/IS EVERYTHING PROPER?
	REBOOT		/NO - ERROR *****
	DCA FIJOB	/SAVE IT
	FGETJT		/GET THE REGISTER SAVE-AREA ADDRESS
	 JOBREG
	DCA .+4
	CIF
	BLT		/SAVE THE USERS REGISTERS
	 DATFLD
FITPTR,	 0
	 CFLD
	 FIUSPC
	 -5
	CHKSRC		/WHERE ARE WE COMING FROM?
	CHKPRV		/A PROGRAM - DOES IT HAVE PRIVILEGE?
	JMS I FIPSFC	/EITHER 'SI' OR NO PRIVILEGE - CLOSE SPECIAL FILES
	FGETJT
	 JOBLNK		/IOT REQUEST WORD
	DCA FIOPTR	/POINTER TO IOT LINKAGE
	DATFLD		/CDF FIELD 0
	TAD I FIOPTR	/PICK UP LINKAGE
	AND C7400	/IS IT AN IOT? (IF IT IS, JOBDAT WILL HAVE BITS 0-3 CLEARED)
	SNA CLA
	JMP FIP2	/IS AN IOT, SO GO MOVE IT INTO FIOSTK (AC IS PARAMETER)
	TAD I FIOPTR	/IS A POINTER, PICK UP LINKAGE
	DCA FIP6	/POINTER TO LINKAGE TABLE
	CFLD
	CIF
	BLT		/MOVE IOT PARAMETERS INTO FIOSTK
	 DATFLD
FIP6,	 0
	 CFLD
	 FIOSTK		/IOT LINKAGE BUFFER
	 -10
	TAD FIOSTK
	SPA CLA		/WILL THE IOT PARAMETER BLOCK BE NEEDED TO RETURN PARS?
	JMP FIP4	/YES, SO DON'T RETURN IT
	TAD FIP6
	JMS I RETBK1	/RETURN THE IOT PARAMETER BLOCK TO FREE CORE
	CLA CLL
	DATFLD
	DCA I FIOPTR	/CLEAR THE 'JOBLNK' POINTER
	CFLD
/
/COMES HERE WHEN IOT AND ITS PARAMETERS ARE COMFORTABLY
/NESTLED IN FIOSTK
FIP4,	TAD IOTABL
	DCA FITPTR	/TABLE POINTER
FIP5,	ISZ FITPTR	/PICK UP IOT FROM TABLE
	TAD I FITPTR
	SNA		/END OF TABLE?
	REBOOT		/YES - ERROR *****
	CIA		/NO
	TAD FIOSTK	/IOT FROM USER
	SZA CLA		/DISPATCH?
	JMP FIP5	/NO
	TAD FITPTR	/YES - GET THE DISPATCH ADDRESS
	TAD IODSPA
	DCA FITPTR
	TAD I FITPTR
	DCA FITPTR
	TAD FIOSTK	/DOES THIS IOT REQUIRE PARAMETERS TO BE
			/RETURNED IN AN IOT PARAMETER BLOCK?
	SMA CLA		/...IF SO, USER AC CONTAINS A PTR. TO WHERE THEY WILL GO
	DCA FIUSAC	/CLEAR USER AC
	JMP I FITPTR	/DISPATCH

/COMES HERE FOR A "SHORT" IOT. SAVED AC IS ONLY PARAMETER
/PUT IT IN FIOSTK+1
FIP2,	TAD I FIOPTR	/PICK UP IOT
	DCA FIOSTK	/PLACE ON STACK
	TAD FIUSAC	/USER ACCUMULATOR
	DCA FIOSTK+1	/SIMULATE LINKAGE
	CFLD		/CHANGE TO CURRENT FIELD
	JMP FIP4
/
FIPSFC,	PRVCLS
RDCURA,	RDCURR	/POINTER TO SEGMENT # IN BUFFER
RD301,	RD30
IOTABL,	.		/TABLE OF USER FILE IOT'S
	ASD		/ASSIGN A DEVICE
	REL		/RELEASE A DEVICE
	REN		/RENAME A FILE
	OPEN		/OPEN A FILE
	CLOS		/CLOSE A FILE
	RFILE		/FILE READ (WINDOW MOVE)
	PROT		/FILE PROTECTION
	WFILE		/FILE WRITE (WINDOW MOVE)
	XOPEN		/OPEN A FILE WITH EXCLUSIVE USE
	CPASS		/CHANGE A USER'S PASSWORD
	CRF		/CREATE A FILE
	EXT		/EXTEND A FILE
	RED		/REDUCE A FILE
	FINF		/FILE INFORMATION
	LIN
	LOUT
	BCLR		/CLEAR ACCOUNT BILLING INFORMATION
	0

IODSPA,	IODISP-IOTABL-1
/ROUTINE TO GET A DIRECTORY ENTRY INTO CORE

/CALLING SEQUENCE:
/	TAD (INTERNAL FILE NUMBER)
/	JMS GD0
/	RETURN (BUFFER POINTER IN AC, 0=ERROR)

GD0,	0
	JMS I EBLD0
	DCA GDUFDP
	TAD I GDUFDP	/RELATIVE POSITION IN UFD TABLE
	JMS I BLDP1
	DCA GDRETP	/POINTER TO UFD RETRIEVAL INFORMATION
	ISZ GDUFDP
	TAD I GDUFDP	/PICK UP ENTRY ADDRESS WITHIN UFD
	DCA GD1
	TAD GDRETP
	JMS I GE01	/GET ENTRY INTO CORE
GD1,	0
	JMP I GD0

GDUFDP,
IFN0,	0
	TAD FIOSTK+1
	AND P0003
	DCA FIOSTK+1
	TAD FIOSTK+1	/RETURN THE FILE INDEX
	JMP I IFN0
	PAGE
/THIS HANDLES THE 'OPEN' & 'XOPEN' IOTS.
/THE 'XOPEN' WORKS EXACTLY LIKE THE NORMAL 'OPEN', EXCEPT
/THAT THE USER GAINS EXCLUSIVE USE OVER THE FILE IF HE
/IS ALLOWED TO WRITE IT. NO ONE ELSE MAY OPEN IT WHILE
/HE HAS IT EXCLUSIVELY.
/
/THERE ARE SEVERAL SPECIAL CASES WHICH ARE HANDLED:
/
/A USER NO LONGER NEEDS HIS ACCT # & PASSWORD TO OPEN HIS UFD.
/ALL HE NEEDS IS THE OWNER'S ACCT BE 0001 AND THE FIRST
/WORD OF THE NAME BE 0 OR HIS ACCT #. IF HIS IS A SYSTEM
/ACCOUNT, HE MAY OPEN ANY UFD (EXCEPT THE MFD) BY SETTING
/THE FIRST WORD OF THE NAME TO THE DESIRED ACCOUNT.
/
/EXCEPT WHEN OPENED BY THE SYSTEM MANAGER (0001), ALL UFD'S
/ARE WRITE-PROTECTED REGARDLESS OF THE PROTECTION CODE.
/THIS ALLOWS THESE BITS IN THE MFD TO BE USED FOR DISC QUOTAS.
/
/WHEN AN OPERATOR ACCOUNT TRIES TO OPEN A NON-EXISTENT
/UFD, HE IS RETURNED THE NUMBER OF THE NEXT UFD IN
/THE FOURTH WORD OF HIS OPEN PACKET.
/
/WHEN 'SI' OPENS A FILE FROM THE SYSTEM LIBRARY WHICH
/HAS THE ".SVP" EXTENSION, WE SET THE "JSPRIV" BIT IN
/THE USER'S JOB-STATUS WORD. THIS ALLOWS ONLY CERTAIN
/SYSTEM PROGRAMS TO USE THE "PEEK" IOT, THUS PREVENTING
/USERS FROM EXAMINING SYSTEM KEYBOARD BUFFERS AND
/STEALING PASSWORDS.
/
/A USER (OTHER THAN ACCOUNT 1 OR 7) CAN ONLY OPEN A FILE
/OWNED BY THE BILLING SYSTEM (ACCOUNT 7) IF HE IS RUNNING
/A PROGRAM WHICH ENABLES HIS 'JSPRIV' BIT. CHANGING THE
/PROGRAM (THUS CLEARING PRIVILEGE) DISALLOWS ANY FURTHER
/I-O TO A PRIVILEGED FILE AND FORCES THE FILE CLOSED AT THE
/NEXT CALL TO 'FIP'.
/
/THE SYSTEM MANAGER AND, IF CONFIGURED, THE BILLING SYSTEM
/ACCOUNT MAY OPEN ANY FILE IN THE SYSTEM AS IF THEY OWNED IT.
/NOTE THAT THIS IS ONLY NECESSARY FOR DELETING OTHER USERS'
/FILES WHEN BILLING OR REMOVING AN ACCOUNT NUMBER.
/
/THE SYSTEM LIBRARY FILE "BASIC" IS GIVEN ITS OWN PRIVATE
/RETRIEVAL WINDOW IN FIELD 1 ONLY IF IT IS WRITE-PROTECTED
/AND IT IS NOT TOO LARGE FOR THIS FIXED WINDOW.
/
/ANY NUMBER OF USERS MAY NOW READ-WRITE THE SAME FILE
/SIMULTANEOUSLY PROVIDING THAT NO ATTEMPTS ARE MADE
/TO EXTEND OR REDUCE THE FILE. OBVIOUSLY, PROGRAMS
/SHARING DATA FILES MUST USE SOME METHOD OF ENSURING
/GRACEFUL FILE HANDLING.
/
OPNACT=	FIOSTK+6
OPNBUF=	FIOSTK+7
/
XOPN0,	CLA CLL CML RAR	/SET THE 'EXCLUSIVE USE' BIT
OPN0,	DCA XOPNSW
	JMS I IFN01	/CHECK FOR A LEGAL FILE #
	JMS I CL01	/CLOSE THE FILE IF ANY OPEN
	TAD FIOSTK+2
	SNA		/IS IT ASSUMED TO BE THIS USER'S FILE?
	TAD FIACCT	/YES - FILL IT IN
	DCA OPNACT
	CLA CMA
	TAD OPNACT
	SZA CLA		/IS IT A FILE-DIRECTORY?
	JMP OPN2	/NO
/
/HE WANTS TO OPEN A DIRECTORY - WE CHECK TO SEE IF
/THE DIRECTORY HE WANTS IS HIS OR, IF NOT, IF HE
/IS THE MANAGER OR OTHER SYSTEM PERSONNEL OR THE
/BILLING SYSTEM ACCOUNT.
	TAD FIOSTK+3
	SNA		/IS IT ASSUMED TO BE HIS OWN?
	TAD FIACCT	/YES - SET IT
	DCA FIOSTK+3
	TAD FIACCT
	CIA
	TAD FIOSTK+3
	SNA CLA		/IS IT HIS OWN UFD?
	JMP OPN1	/YES
	CLA CLL CMA RAL
	TAD FIOSTK+3
	SNA		/IS IT THE LIBRARY UFD?
	JMP OPN1	/YES - ANYONE CAN READ THAT
	IAC
	SNA CLA		/NO - IS IT THE MFD?
	JMP OPNER2	/YES - "PROTECTION VIOLATION"
	CHKACT		/IS THIS THE MANAGER OR BILLING SYSTEM?
	JMP OPN1	/YES - THEY GET ANYTHING ELSE
	TAD FIACCT
	AND C7700
	SZA CLA		/IS THIS A SYSTEM OPERATOR OR MANAGER?
	JMP OPNER2	/NO - "PROTECTION VIOLATION"
OPN1,	CLA CMA		/SET NON-ZERO FOR ONE-WORD SEARCH
OPN2,	DCA OPNTYP	/ OF FILE-DIRECTORY
	TAD FIOSTK+3
	SNA CLA		/IS IT A NULL FILENAME?
	JMP OPNER1	/YES - "FILE NOT FOUND"
	TAD OPNACT
	JMS I UFO01	/OPEN THE OWNER'S UFD
	JMP OPNER1	/NO SUCH USER - "FILE NOT FOUND"
	TAD XOPNSW	/ADD IN THE 'EXCLUSIVE USE' BIT (4000)
	DCA XOPNSW	/ & SAVE FOR FIRST WORD OF 'ENTTBL' ENTRY
	TAD XOPNSW
	JMS I BLDP1	/GET THE 'RETTBL' ENTRY ADDRESS
	DCA FIOSTK+2
	TAD OPNTYP	/NOW GET THE SEARCH-TYPE AND DO
	JMS I DS01	/ A 1- OR 3-WORD DIRECTORY SEARCH
	 FIOSTK+2
	JMP OPNER0	/NO FIND - "FILE NOT FOUND"
	TAD P0004
	DCA OPNBUF	/SAVE THE POINTER TO THE PROTECT-WORD
/
/HERE WE FIGURE OUT THE TYPE OF ACCOUNT THIS USER
/HAS & THEN SEE IF THE FILE IS PROTECTED AGAINST THAT
/TYPE OF ACCESS.
	TAD OPNTYP
	SZA CLA		/WAS THIS AN OPEN OF A 'UFD'?
	JMP OPN3	/YES - ONLY MANAGER #1 CAN WRITE THEM
	JMS I OPNPRT	/CALCULATE THE PROTECTION CHECK-MASK
	DCA OPNFLG
	TAD OPNFLG	/'AND' THE PROTECTION-CODE TO THE LOW-
	AND P0007	/ ORDER 3 BITS OF THE MASK
	AND I OPNBUF
	SZA CLA		/IS THE FILE READ PROTECTED?
	JMP OPNER2	/YES - "PROTECTION VIOLATION"
	TAD OPNFLG	/NO - CHECK FOR 'WRITE-PROTECT'
	CLL RAL
	AND I OPNBUF
	SNA CLA		/IS IT WRITE-PROTECTED?
	JMP OPN4	/NO
OPN3,	TAD OPNTYP
	TAD FIACCT
	SNA CLA		/IS THIS THE MANAGER #1 OPENING A UFD?
	JMP OPN4	/YES - HE MUST BE ALLOWED TO WRITE IT
	TAD XOPNSW
	SPA CLA		/DOES THE USER WANT EXCLUSIVE USE?
	JMP OPNER2	/YES, TOO BAD - "PROTECTION VIOLATION"
	TAD P0004	/NO - SET 'PROTECTED' BIT
OPN4,	DCA OPNFLG
	TAD OPNACT
	TAD LOGACT
	SNA CLA		/WAS THIS AN ACCOUNT #7 (BILLING ACCOUNT) FILE?
	CHKACT		/YES - IS THIS A MERE ORDINARY USER?
	JMP .+4		/NO
	CHKPRV		/YES - IS HE RUNNING WITH PRIVILEGE?
	JMP OPNER2	/NO - ACCOUNT 7 FILES ARE SPECIAL - "PROTECTION VIOLATION"
	ISZ OPNFLG	/SET THE 'SPECIAL FILE' BIT IN THE CONTROL BLOCK
	TAD I ZDS1	/GET THE SEARCH-FIND ADDRESS
	DCA .+3
	TAD FIOSTK+2
	JMS I ENS01	/NOW CHECK FOR OTHER OPENINGS
OPNTYP,	 0
	SNA CLA		/ANYONE ELSE HAVE IT OPEN?
	JMP OPN5	/NO
	CLA CLL CMA CML
	TAD I OPNFND	/YES - GET THE LAST 'FIND' ENTRY (IN 'ENTTBL')
	DCA CFH
	TAD I CFH
	TAD XOPNSW
	SPA SZL CLA	/DOES SOMEONE ELSE HAVE 'EXCL. USE' OR DO WE WANT IT?
	JMP OPNER3	/YES, TOO BAD - "ANOTHER USER HAS FILE"
OPN5,	TAD FIOSTK+1	/WE HAVE THE FILE - NOW FILL IN THE
	JMS I EBLD0	/ 'ENTTBL' ENTRY
	DCA CFH
	TAD XOPNSW	/FIRST THE 'UFDTBL' INDEX &
	DCA I CFH	/ THE 'EXCLUSIVE USE' BIT
	ISZ CFH
	TAD I ZDS1	/THEN THE UFD ENTRY-ADDRESS
	DCA I CFH
	JMP I .+1	/ AND GO DO THE BOOKKEEPING
	OPN6

/COMES HERE TO RETURN VARIOUS ERROR STATUSES.
OPNER0,	CHKSRC		/IS THIS 'OPEN' FROM 'SI'?
	TAD OPNTYP	/NO - WAS IT A PROGRAMMATIC OPEN OF A 'UFD'?
	SZA CLA		/WAS THIS A DIRECTORY OPEN?
	JMP I OPNR0A	/YES - RETURN THE NEXT UFD NUMBER
			/NO - JUST RETURN THE ERROR CODE
OPNER1,	CLA CLL CML RAR	/7000 = "FILE NOT FOUND"
OPNER2,	CLL CML RAR	/6000 = "PROTECTION VIOLATION"
	SKP
OPNER3,	TAD P1000	/4400 = "ANOTHER USER HAS FILE OPEN"
	CLL CML RAR
OPNEXT,	DCA FIUSAC	/SET (OR CLEAR) HIS AC
	DATFLD
	TAD I FIOPTR
	JMS I RETBK1	/RETURN THE PARAMETER BLOCK
	JMP I FIEXIT	/THEN EXIT FIP
/
OPNFND,	ENSFND	/LOC. OF LAST 'FIND' IN ENS0
OPNPRT,	OPNPR0	/CALCULATE CHECK-MASK
OPNR0A,	OPNR01
XOPNSW,	0
	PAGE
/
/NOW WE CAN OPEN THE FILE - JUST BUILD THE FILE CONTROL-
/BLOCK AND THE SEGMENT RETRIEVAL WINDOW.
OPN6,	CLA CMA
	DCA TABSTA	/REMEMBER TO SAVE THE TABLES
	JMS I OPNPRV	/CHECK TO SEE IF THE 'PRIVILEGE' BIT GETS SET
	ISZ OPNBUF
	TAD I OPNBUF	/GET THE FILE SIZE (FOR BASIC CHECK)
	DCA OPNSIZ
	ISZ OPNBUF
	ISZ OPNBUF
	TAD I OPNBUF	/GET THE RETRIEVAL WINDOW ADDRESS
	DCA .+3
	TAD FIOSTK+2
	JMS I GE01	/NOW READ IN THE FIRST WINDOW
	 0
	DCA OPNWND	/ AND SAVE ITS IN-CORE ADDRESS
	TAD FIOSTK+1
	TAD OPNJF0	/FIND THE FILE STATUS WORD
	DCA .+2
	FGETJT		/ & GET ITS ADDRESS
OPNPTR,	 0
	JMS I GTBLO1	/THEN GET A LINKED-BLOCK FOR FILE CONTROL
	DCA OPNBUF	/ (POINTS TO WINDOW-ADDRESS)
	CLA CLL CML RTL	/GET THE PROTECTION-WORD LOCATION
	TAD OPNBUF
	DCA CFH
	TAD OPNFLG	/ AND SET THE PROTECTION-WORD IN THE BLOCK
	DCA I CFH	/ 0=READ/WRITE; 4=READ ONLY
/
/NOW WE CHECK TO SEE IF THIS IS BASIC AND SHOULD HAVE ITS
/OWN PRIVATE RETRIEVAL WINDOW.
	TAD FIOSTK+3
	TAD OPNBAS
	SZA CLA		/ "BA"?
	JMP OPN11	/NO
	CLA CLL CMA RAL
	TAD OPNACT
	SNA CLA		/IS IT FROM THE SYSTEM LIBRARY?
	TAD FIOSTK+4	/YES
	TAD OPNBAS+1
	SNA CLA		/ "BASI"?
	TAD FIOSTK+5
	TAD OPNBAS+2
	SNA CLA		/ "BASIC "?
	TAD OPNFLG
	SNA CLA		/YES - CAN HE ALTER IT?
	JMP OPN11	/YES - NO SPECIAL WINDOW
	TAD OPNSIZ
	TAD BASWIN
	SMA CLA		/NO - IS IT TOO LARGE?
	JMP OPN10	/YES - INVALIDATE THE SPECIAL WINDOW
/
/HERE WE BUILD THE SPECIAL WINDOW FOR BASIC. NOTE THAT WHEN BASIC
/IS TOO LARGE FOR THE WINDOW, WE INVALIDATE IT.  TO INSURE THAT
/THE SPECIAL WINDOW REFLECTS ANY CHANGES, WE ALWAYS REBUILD
/IT, SINCE WE (CURRENTLY) HAVE NO GRACEFUL WAY OF DETECTING
/A LONE USER CHANGING THE SIZE (SEVERAL USERS MAY NOW WRITE
/INTO A FILE SIMULTANEOUSLY).
	CFLD
	TAD BASWIN	/NO - SET THE WINDOW POINTER
	DCA OPNPTR
OPN7,	TAD OPNWND	/ AND THE RETRIEVAL-BLOCK BUFFER-ADDRESS
	DCA INDEX
	TAD C7771
	DCA CFH		/SET THE SEGMENT/BLOCK COUNT (-7)
OPN8,	TAD I INDEX	/NOW GET A SEGMENT NUMBER
	SNA		/AT THE END OF THE SEGMENTS?
	JMP OPN9	/YES
	ISZ OPNPTR	/NO - INCREMENT THE WINDOW POINTER
	SKP
	HLT		/OOPS!! ERROR IN SIZE CHECK *****
	DATFLD
	DCA I OPNPTR	/PLOP THE SEGMENT NUMBER INTO THE WINDOW
	CFLD
	ISZ CFH		/INCREMENT COUNT
	JMP OPN8	/ & CONTINUE
	TAD I OPNWND	/GET THE NEXT BLOCK ADDRESS
	SNA		/ARE WE DONE?
	JMP OPN9	/YES
	DCA .+3		/NO - SET NEXT ENTRY ADDRESS
	TAD FIOSTK+2
	JMS I GE01	/NOW GET THE NEXT WINDOW IN CHAIN
OPNSIZ,	 0
	DCA OPNWND	/ & SAVE ITS CORE-ADDRESS
	JMP OPN7	/OK - KEEP MOVING SEGMENT NUMBERS
OPN9,	DATFLD
	CLA CMA		/ALL DONE - SET THE 'SET UP' SWITCH
	DCA I BASWIN
	SKP
	DCA I OPNPTR	/CLEAR THE REST OF THE SPECIAL WINDOW
	ISZ OPNPTR
	JMP .-2
	TAD BASWIN	/SET THE WINDOW ADDRESS IN THE
	DCA I OPNBUF	/ FILE CONTROL-BLOCK
	JMP OPN12	/NOW FINISH UP
/
/HERE WE FETCH A FREE-CORE BLOCK AND COPY THE FIRST WINDOW
/INTO IT.
OPN10,	DCA I BASWIN	/CLEAR THE BASIC WINDOW FLAG
OPN11,	TAD OPNBUF	/GET THE WINDOW-ADDRESS POINTER
	JMS I GTBLO1	/ & AND LINK A BLOCK TO IT
	DCA OPNPRW
	CFLD
	CIF
	BLT		/NOW COPY OVER THE WINDOW
	 CFLD
OPNWND,	 0	/SOURCE
	 DATFLD
OPNPRW,	 0	/DESTINATION
	 -10	/WORD-COUNT
/
/ALL DONE - NOW JUST INCREMENT THE UFD-USAGE COUNT & EXIT.
OPN12,	CFLD
	CLA CMA
	TAD I UTPRNU	/INDICATE OUR UFD-USAGE
	DCA I UTPRNU
	JMP I .+1	/GO CLEAN UP & EXIT
	OPNEXT
/
OPNJF0,	JOBF0
OPNPRV,	OPNPV0
OPNBAS,	-4241	/ (-) "BASIC " IN TSS/8 6-BIT
	-6351
	-4300

/
/SUBROUTINE TO CALCULATE THE PROTECTION CHECK-MASK. THIS
/IS BASED ON WHO THE FILE OWNER IS COMPARED TO WHO IS
/REQUESTING THE FILE.
OPNPR0,	0
	TAD OPNACT
	CIA
	TAD FIACCT
	SZA CLA		/IS IT HIS OWN FILE?
	CHKACT		/NO - IS THIS A PRIVILEGED USER?
	JMP OPNPR1	/YES - HE OWNS EVERYTHING
	TAD OPNACT	/NO - GET THE OWNER'S PROJECT
	AND C7700
	CIA
	DCA OPNPRW
	TAD FIACCT	/ AND THE REQUESTOR'S PROJECT
	AND C7700
	TAD OPNPRW
	SNA CLA		/DO THE PROJECT NUMBERS MATCH?
	TAD P0003	/YES - MASK = 4
	CLL IAC		/NO - MASK = 1
	SKP
OPNPR1,	TAD C0010	/OWNS FILE - MASK = 10
	JMP I OPNPR0	/RETURN WITH AC = MASK
	PAGE
/ROUTINE TO CLOSE A FILE

CLS0,	DCA CLSIFN	/INTERNAL FILE NUMBER
	TAD C7774
	DCA CLCNTR	/COUNTER FOR BIT SCAN
CLS1,	TAD FIOSTK+1	/PICK UP BIT PATTERN
	RAL
	DCA FIOSTK+1
	SNL		/BIT SET FOR THIS FILE #?
	JMP .+3
	TAD CLSIFN	/YES - GET THE FILE #
	JMS CL0		/ AND CLOSE IT
	ISZ CLSIFN	/NEXT FILE NUMBER
	ISZ CLCNTR	/DONE ALL FOUR?
	JMP CLS1	/NO, KEEP AT IT
	JMP I FIEXIT	/THROUGH

CLSIFN,	0
CLCNTR,	0

/ROUTINE TO DO ACTUAL FILE CLOSE
CL0,	0
	JMS I EBLD0
	DCA ENR0	/SAVE THE 'ENTTBL' POINTER
	TAD CFH
	JMS I LNK01	/RETURNS WITH PTR. TO FILE CONTROL BLOCK FROM JOB STATUS BLOCK
	SNA
	JMP CL3		/FILE WAS NOT OPEN
	DCA ENR1	/SAVE IT
	DCA I CFH	/CLEAR POINTER  TO FILE CONTROL BLOCK---INDICATES FILE CLOSED
	CFLD		/SET DATA FIELD TO THIS FIELD
	TAD ENR1	/POINTER TO PARAMETER BLOCK
	JMS I RETBK1	/RETURN THE CONTROL-BLOCK
	DCA ENR1
	TAD ENR1	/GET THE RETRIEVAL-WINDOW ADDR.
	CIA
	TAD BASWIN
	SNA CLA		/IS IT THE SPECIAL BASIC WINDOW?
	JMP .+3		/YES - DON'T FREE IT
	TAD ENR1	/NO - RETURN IT TO FREE-CORE
	JMS I RETBK1
	CLA CLL CMA
	TAD I ENR0	/RELATIVE POINTER TO UFD RETRIEVAL TABLE
	CLL RAL		/ * 2 (AND ZAP 'EXCLUSIVE USE' BIT)
	IAC
	TAD UFDTBL
	DCA CLUFDP	/POINTER TO ACCESS COUNTER
	DCA I ENR0	/CLEAR PTR. IN ENTTBL TO INDICATE FILE IS CLOSED
	CLA CMA
	DCA TABSTA	/SET TABLE STATUS TO WRITE OUT
	ISZ I CLUFDP	/REMOVE THIS JOB FROM  ACCESS COUNT IN UFDTBL
	JMP I CL0

/THIS WAS THE ONLY GUY USING THIS UFD, SO CLOSE IT OUT
	CLA CMA		/NO ONE IS NOW ACCESSING THIS UFD
	TAD CLUFDP
	JMS I TF01	/FREE A TABLE ENTRY
	JMP I CL0

CL3,	CFLD
	JMP I CL0

CLUFDP,	0

/FIND THE NUMBER OF PEOPLE ACCESSING THIS FILE
/SKIPS IF EXACTLY ONE USER IS
ENR0,	0
	TAD FIOSTK+1
	JMS I EBLD0
	DCA ENR1	/PTR. INTO ENTTBL
	ISZ ENR1
	TAD I ENR1	/GET ADDRESS IN UFD
	DCA ENR1
	TAD GDRETP	/RTABLE
	JMS I ENS01	/HOW MANY PEOPLE HAVE THIS FILE OPEN?
ENR1,	 0
	CIA		/RETURNS WITH # OF PEOPLE WHO HAVE THIS FILE OPEN
	CMA
	SNA CLA		/IS THE PERSON TRYING TO CHANGE THE FILE THE
	ISZ ENR0	/...ONLY ONE WHO HAS IT OPEN?
	JMP I ENR0	/YES, SO SKIP

/CHANGE THE PROTECTION OF A FILE

PRT0,	TAD FIOSTK+1	/PICK UP INTERNAL FILE NUMBER
	RTR
	RTR
	RAR
	AND P0003	/AND OFF PROTECTION BITS
	DCA PRIFNU	/INTERNAL FILE NUMBER
	TAD PRIFNU
	JMS I UC01	/CHECK TO SEE IF USER IS OWNER
	JMP PRT1	/ERROR RETURN, USER IS NOT OWNER
	TAD PRIFNU
	JMS I GD01	/GET THIS DIRECTORY ENTRY INTO CORE
	SNA
	HLT		/WHOOPS - ERROR *****
	TAD P0004
	DCA PRENTP	/POINTER TO PROTECTION BITS OF THIS FILE
	TAD C7637
	AND FIOSTK+1	/PICK UP NEW PROTECTION BITS
	DCA I PRENTP	/ AND SET INTO THE DIRECTORY ENTRY
	SAVBUF		/THEN RE-WRITE THE BUFFER
	JMP I FIEXIT

PRT1,	SZA CLA		/ERROR
	CLL CML RAR	/6000 - "PROTECTION VIOLATION"
	CLL CML RAR	/4000 - "NO FILE OPEN"
	DCA FIUSAC
	JMP I FIEXIT

PRIFNU,	0
PRENTP,	0
C7637,	7637
/ROUTINE TO BUILD A RETRIEVAL POINTER FROM THE RELATIVE
/POSITION IN RETTBL (WHICH IS ALSO THE ENTTBL POINTER).

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

BLDP,	0
	AND C3777	/ZAP THE 'EXCLUSIVE USE' BIT
	DCA CFH
	CLA CMA
	TAD CFH		/POINTER = [(PTR - 1) * 8 + RETTBL]
	CLL RAL; RTL
	TAD RETTBL
	JMP I BLDP	/RETURN

/ROUTINE TO WRITE OUT THE SEGMENT-BUFFER IF NECESSARY.

WRITE,	0
	ISZ BUFWRT	/NEED IT BE SAVED?
	JMP I WRITE	/NO - JUST RETURN
	TAD C6605	/YES - SET THE 'WRITE' IOT
	DCA FLPARB
	JMS I FIO01	/THEN DO THE I/O
	HLT		/ERROR ON WRITE - JUST CRASH *****
	JMP I WRITE	/ OTHERWISE RETURN

/ROUTINE TO CHECK THIS USER'S ACCOUNT NUMBER AND
/SKIP IF HE IS A NORMAL USER; RETURN IS TO THE NEXT
/INSTRUCTION IF HE IS EITHER THE SYSTEM MANAGER
/(ACCOUNT NUMBER 0001) OR THE BILLING SYSTEM.

CHKAC0,	0
	CLA CMA
	TAD FIACCT
	SNA CLA		/IS IT THE SYSTEM MANAGER?
	JMP I CHKAC0	/YES - SPECIAL EXIT

	IFNZRO BILLNG <
	TAD FIACCT
	TAD LOGACT
	SZA CLA		/NO - IS IT THE BILLING SYSTEM?
	>
	ISZ CHKAC0	/NO - NORMAL EXIT
	JMP I CHKAC0
	PAGE
/ROUTINE TO MOVE THE RETRIEVAL WINDOW IN FIELD ZERO
WND0,	TAD FIOSTK+2	/PICK UP INTERNAL FILE NUMBER
	AND P0003	/AND OFF FIELD BITS
	JMS I EBLD0
	DCA WNENTP	/POINTER TO RETRIEVAL INFORMATION POINTER
	TAD I WNENTP
	JMS I BLDP1	/GENERATE ABSOLUTE PTR. INTO RETTBL
	DCA WNRETP	/RETRIEVAL POINTER
	TAD FIOSTK+7
	DCA WNFCBP	/PTR. TO THIS FILE'S FILE CONTROL BLOCK
	TAD FIOSTK+5
	DCA WND5	/LOW ORDER DISC ADDRESS
	DCA WNDCNT	/GET INTO CORE
	STA 
	TAD SEGSIZ
	AND FIOSTK+1	/GET HIGH ORDER FILE ADDRESS
	DCA WNDIRP
	TAD SEGSIZ	/GET RID OF ADDRESS WITHIN SEGMENT
	CIA
	AND WND5
	CLL RAL
	TAD WNDIRP	/WE NOW HAVE ALL THE NECESSARY BITS
	RTL; RTL	/ SO SHIFT THEM AROUND
	DCA WNSEGC	/SAVE AS SEGMENT # TO GET
	DATFLD		/WNSEGC NOW HAS SEGMENT NUMBER TO GET
	TAD I WNFCBP	/PICK UP FIELD 0 WINDOW POINTER
	DCA WNDPTR	/PNTS TO FILE RETRIEVAL WINDOW FOR THIS FILE
	ISZ WNFCBP
	TAD I WNFCBP	/PICK UP NUMBER OF CURRENT SEGMENT IN WINDOW
	DCA WNCURS	/CURRENT SEGMENT IN WINDOW
	TAD WNSEGC	/SEGMENT TO GET
	JMS WND20	/DIVIDE BY 7 (IGNORE REMAINDER)
	JMS WND30	/MULTIPLY BY 7
	DCA WNSEGC	/FIRST SEGMENT IN PROPER WINDOW
	CLA CMA
	TAD I WNDPTR	/GET FIRST WORD OF FILE RETIEVAL WINDOW
	SNA CLA		/ = 1?
	JMP WND6	/INVALID WINDOW POINTER
	TAD WNCURS	/CURRENT SEGMENT AT TOP OF CURRENT CORE WINDOW
	CLL CML CIA

/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
	SNA SZL
	JMP WND6	/PREVIOUS BLOCK, SO MUST START AT BEGINNING OF STRING
	JMS WND20	/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,	CIF
	BLT
	 CFLD	/SOURCE FIELD
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
	JMP I .+1	/GO SET "JSIOTC" BEFORE EXITTING
	INF6

WND6,	CFLD		/CHANGE TO CURRENT FIELD
	CLA CLL
	TAD WNSEGC	/SEGMENT TO GET INTO IN CORE WINDOW
	JMS WND20	/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

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
WNCURS,	0

/ROUTINE TO DIVIDE A NUMBER BY 7.
/QUOTIENT IS RETURNED IN THE AC; REMAINDER
/IS LEFT IN 'WNDREM' ON PAGE ZERO.

WND20,	0
	DCA WNDREM	/SAVE THE NUMBER
	DCA CFH		/CLEAR THE QUOTIENT
	TAD WNDREM
	CLL CML
	TAD C7771	/SUBTRACT 7
	SZL		/DID WE GO TOO FAR?
	JMP .+3		/YES - ALL DONE
	ISZ CFH		/NO - INCREMENT THE QUOTIENT
	JMP .-5		/ & TRY ANOTHER SUBTRACTION
	TAD P0007
	DCA WNDREM	/SAVE THE REMAINDER
	TAD CFH		/THEN RETURN WITH THE QUOTIENT
	JMP I WND20

/ROUTINE TO CHECK THE SOURCE OF THE FIP CALL
/AND SKIP IF WE WERE CALLED BY 'SI'.
CHKSR0,	0
	CLA
	CDF
	TAD I FANFLD	/GET THE 'CORTBL' ENTRY
	CFLD
	AND FIPFIP
	SNA CLA		/'FIP' BIT SET?
	ISZ CHKSR0	/NO - MUST BE FROM 'SI'
	JMP I CHKSR0

/ROUTINE TO SET THE 'BUFFER CHANGED' SWITCH SO THAT THE
/SEGMENT BUFFER WILL BE WRITTEN BACK OUT BEFORE THE NEXT
/BLOCK IS READ OR WHEN FIP EXITS.
SAVBF0,	0
	CLA CMA
	DCA BUFWRT	/'BUFFER CHANGED' = -1
	JMP I SAVBF0
	PAGE
/ROUTINE TO CREATE A NEW FILE

CRF0,	TAD FIOSTK+1
	SNA CLA		/IS THE NAME REASONABLE?
	JMP CRFER2	/NO - NO POINT CONTINUING
	TAD FIACCT	/GET USER'S ACCT #
	JMS I UTS01	/SEARCH THE UFD TABLE
	HLT		/MUST BE AN ENTRY IF WE'RE LOGGED-IN *****
	JMS I BLDP1	/BUILD A POINTER INTO RETTBL
	DCA FIOSTK	/ FOR THE DIRECTORY-SEARCH
CRF1,	CLA CMA
	TAD FIACCT
	SNA CLA		/WILL THIS FILE BE A DIRECTORY?
	CLA CMA		/YES - THEN NEW ACCOUNT NUMBER MUST BE UNIQUE
	JMS I DS01	/SEARCH THE DIRECTORY FOR THIS NAME
	 FIOSTK
	JMP CRF2	/COULD NOT FIND THIS NAME, CONTINUE
	DCA CRBUFP	/FILE ALREADY EXISTS - SAVE POINTER
	CLA CMA
	TAD FIACCT
	SNA CLA		/ARE WE THE MANAGER (I.E. IS THIS A DIRECTORY)?
	JMP CRFER3	/YES - WE WON'T AUTOMATICALLY DELETE
	TAD I ZDS1	/GET ITS RELATIVE UFD-ENTRY LOCATION
	DCA CRFSEG	/UFD ADDRESS OF DIRECTORY ENTRY
	TAD FIOSTK
	JMS I ENS01	/SEARCH ENT TABLE FOR ACCESSES TO THIS FILE
CRFSEG,	 0		/UFD ADDR. OF DIRECTORY ENTRY
	SZA CLA		/RETURNS WITH # OF ACCESSES TO THIS FILE
	JMP CRFER5	/ERROR - FILE IS IN USE

/COMES HERE IF A FILE BY THIS NAME ALREADY EXISTS, BUT NOONE
/HAS OPENED IT
	TAD CRFSEG
	DCA I CRGD11	/SET DIRECTORY-ENTRY LOCATION FOR 'RED1'
	TAD FIOSTK
	DCA GDRETP	/ ALONG WITH THE 'RETTBL' ENTRY ADDRESS
	TAD CRBUFP
	TAD P0004	/GET THE PROTECTION-WORD LOCATION
	DCA CRFENT
	TAD I CRFENT
	AND C0020
	SZA CLA		/IS THE FILE WRITE-PROTECTED AGAINST OWNER?
	JMP CRFER3	/YES - SAY "PROTECTION VIOLATION"
	TAD CRBUFP
	JMS I RED11	/NO - DELETE THE FILE
	JMP CRF1	/ AND LOOK AGAIN FOR THE CHAIN END

/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 CALLLS 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,	SNA		/WERE WE PASSED THE LAST LINK-ADDRESS?
	TAD P0003	/NO - MUST BE EMPTY DIRECTORY
	DCA CRFLNK	/ADDR. OF LINK WORD OF LAST ENTRY IN UFD CHAIN
	TAD FIOSTK	/POINTER TO RETRIEVAL INFORMATION
	JMS I DE01	/FIND AN EMPTY DIRECTORY ENTRY
	JMP CRFER4+1	/ERROR - "USER DIRECTORY FULL"
	DCA CRFENT
	TAD CRFENT
	JMS CRFGET	/GET THE WORD INTO CORE
	CLA CMA
	DCA I CRBUFP	/SIMULATE A USED ENTRY
	TAD FIOSTK
	JMS I DE01	/NOW FIND AN ENTRY FOR THE RETRIEVAL-BLOCK
	JMP CRFER4	/NONE AVAILABLE - "DIRECTORY FULL"
	DCA CRFRET
	TAD CRFRET
	JMS CRFGET	/MAKE SURE THE ENTRY IS IN CORE
	JMS I SATL1	/FIND A FREE SEGMENT IN THE SAT
	SNA
	JMP CRFER1	/NONE AVAILABLE - "DISC FULL"

/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
	ISZ CRBUFP
	DCA I CRBUFP	/SAVE THE SEGMENT NUMBER IN THE RETRIEVAL BLOCK
	TAD I CRBUFP
	DCA CRFSEG	/SAVE THE INDEX FOR CLEARING LATER
	TAD CRFENT
	JMS CRFGET	/GET BACK THE DIRECTORY NAME-ENTRY
	CLA CMA
	TAD CRBUFP
	DCA INDEX
	TAD FIOSTK+1	/TRANSFER FILE NAME INTO DIRECTORY ENTRY
	DCA I INDEX
	TAD FIOSTK+2
	DCA I INDEX
	TAD FIOSTK+3
	DCA I INDEX
	DCA I INDEX	/LEAVE A WORD FOR THE NEXT FORWARD LINK
	TAD CRPROT
	DCA I INDEX	/SET THE INITIAL PROTECTION
	CLA CLL IAC
	DCA I INDEX	/INITIAL FILE-SIZE IS 1 SEGMENT
	CDF
	TAD I DATEA	/PICK UP TODAY'S DATE
	CFLD
	DCA I INDEX	/ & SAVE AS DATE OF CREATION
	TAD CRFRET
	DCA I INDEX	/SET THE RETRIEVAL-BLOCK LOCATION
	TAD CRFLNK
	JMS CRFGET	/GET THE DIRECTORY FORWARD-LINK INTO CORE
	TAD CRFENT
	DCA I CRBUFP	/ & SET THIS ENTRY'S ADDRESS
	TAD CRFSEG
	JMS I SCL01	/NOW ZERO THE INITIAL SEGMENT
	JMP I FIEXIT	/ & EXIT

/CODE TO RETURN THE VARIOUS 'CREATE' ERROR STATUSES.
CRFER1,	JMS CRFCLR	/CLEAR THE 'DUMMY ENTRY' WORD
	CLA CLL IAC	/7400 - "DISC IS FULL"
CRFER2,	CLL CML RTR	/6400 - "INVALID FILE NAME"
CRFER3,	CLL CML RAR	/6000 - "PROTECTION VIOLATION"
	JMP .+4
CRFER4,	JMS CRFCLR	/5000 - "USER DIRECTORY FULL"
	TAD P1000
CRFER5,	TAD P1000	/4400 - "ANOTHER USER HAS FILE OPEN"
	CLL CML RAR
	DCA FIUSAC	/RETURN THE CODE IN HIS AC
	JMP I FIEXIT

/ROUTINE TO CLEAR THE 'DUMMY ENTRY' WORD WE PLACE IN THE
/DIRECTORY ENTRY. WE HAVE TO DO THIS WHEN AN ERROR OCCURS.
CRFCLR,	0
	TAD CRFENT
	JMS CRFGET	/GET THE ENTRY INTO CORE
	DCA I CRBUFP	/ & CLEAR THE FIRST WORD
	JMP I CRFCLR	/THEN JUST RETURN

/ROUTINE TO READ IN A SEGMENT AND SET 'CRBUFP'. IT ALSO
/SETS THE 'BUFFER CHANGED' SWITCH.
CRFGET,	0
	DCA .+3		/SET THE ENTRY-ADDRESS
	TAD FIOSTK
	JMS I GE01	/GET THE DIRECTORY WORD
CRBUFP,	 0
	DCA CRBUFP	/SAVE THE BUFFER-ADDRESS
	SAVBUF		/ AND SET THE 'SAVE BUFFER' SWITCH
	JMP I CRFGET	/THEN RETURN

CRFENT,	0
CRFLNK,	0
CRFRET,	0
CRGD11,	GD1
CRPROT,	12	/INITIAL FILE PROTECTION-WORD
DATEA,	DATE
RED11,	RED1
	PAGE
/ROUTINE TO EXTEND A FILE
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	/SET THE RETRIEVAL-CHAIN POINTER

/NOW TRACE THRU 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
	JMP EXT4	/KEEP LOOKING FOR END

EXT3,	TAD FIOSTK+2	/NUMBER OF SEGMENTS TO ADD
	CMA
	DCA EXSEGC
	DCA EXLAST	/CLEAR THE 'NEW LINK' SWITCH
EXT5,	ISZ EXBUFP
	TAD I EXBUFP	/PICK UP ENTRY IN WINDOW
	SNA CLA		/IS IT THE FIRST FREE ENTRY?
	JMP EXT6	/YES - START EXTENDING
	TAD EXBUFP
	AND P0007
	SZA CLA		/NO - AT END OF BLOCK?
	JMP EXT5	/NO - KEEP LOOKING
/
/NOW AT END OF LIST OF SEGMENTS MAKING UP THIS FILE
EXT6,	ISZ EXSEGC	/START EXTENDING
	JMP EXT7	/GET ANOTHER SEGMENT
EXT20,	TAD EXSEGC
	CIA
	DCA FIUSAC	/NUMBER OF SEGMENTS WE FAILED TO FIND
	TAD EXLAST	/GET THE LAST WINDOW ADDRESS
	SNA		/IS IT LINKED TO NOTHINGNESS?
	JMP EXT21	/NO - NO PROBLEM
	JMS EXGE0	/YES - GET THE PREVIOUS BLOCK
	DCA I EXBUFP	/ AND CLEAR ITS FORWARD LINK
	SAVBUF		/REMEMBER TO REWRITE THE BUFFER
EXT21,	TAD FIOSTK+1	/NOW UPDATE THE DIRECTORY ENTRY
	JMS I GD01	/GET DIRECTORY ENTRY INTO CORE
	TAD C0005

/HAVE A NEW BLOCK FOR RETRIEVAL
	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
	SAVBUF		/ AND SET 'BUFFER CHANGED' SWITCH
EXT8,	DATFLD		/SET DATA FIELD TO FIELD 1
	TAD I EXFCBP
	DCA EXPROP	/POINTER TO RETRIEVAL WINDOW
	IAC
	DCA I EXPROP	/INVALIDATE THE WINDOW
	JMP I FIEXIT

EXT7,	TAD EXBUFP
	AND P0007
	SZA CLA		/DO WE NEED A NEW BLOCK?
	JMP EXT12	/NO
	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
	TAD EXNFRE	/NEXT FREE WINDOW
	DCA I EXBUFP	/LINK IT ONTO CHAIN
	SAVBUF		/ AND SET 'CHANGED' SWITCH
	TAD EXWNDP	/SAVE PREVIOUS BLOCK LOCATION
	DCA EXLAST	/ IN CASE WE RUN OUT OF DISC NOW
	TAD EXNFRE
	DCA EXWNDP	/UPDATE CURRENT WINDOW POINTER
	TAD EXWNDP
	JMS EXGE0	/GET NEW WINDOW INTO CORE
	ISZ EXBUFP	/POINTER TO FIRST ENTRY OF WINDOW
EXT12,	JMS I SATL1	/GET A FREE SEGMENT FROM SAT
	SNA
	JMP EXT20	/PARTIALLY SATISFIED
	DCA I EXBUFP	/SET THE SEGMENT # IN THE WINDOW
	ISZ EXBUFP
	SAVBUF		/SET 'BUFFER CHANGED' SWITCH
	DCA EXLAST	/ AND CLEAR 'NEW LINK' SWITCH
	JMP EXT6	/FILL NEXT WORD


EXGE0,	0		/GET WORD OF THIS UFD INTO CORE
	DCA .+3		/STORE THE WORD NUMBER
	TAD GDRETP
	JMS I GE01	/FETCH THE WORD
EXBUFP,	 0
	DCA EXBUFP	/SET THE BUFFER POINTER
	JMP I EXGE0

EXT30,	TAD P1000	/4400 - "ANOTHER USER HAS FILE OPEN"
	SKP
EXT10,	CLL CML RAR	/6000 - "PROTECTION VIOLATION"
	CLL CML RAR	/4000 - "NO FILE OPEN"
	DCA FIUSAC
	JMP I FIEXIT

EXFCBP,	0
EXLAST,	0
EXNFRE,	0
EXPROP,	0
EXSEGC,	0
EXWNDP,	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
/NOONE 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
	JMS I LNK01	/GET PTR. TO APPROPRIATE FILE CONTROL BLOCK
	SNA
	JMP EXT10+1	/ERROR, FILE NOT OPEN
	DCA EXFCBP	/FILE CONTROL BLOCK POINTER
	TAD FILPRP	/GLOBAL TO "FILPRO"
	TAD EXFCBP
	DCA EXPROP	/POINTER TO PROTECTION BIT IN FIELD 0
	DATFLD		/CDF FIELD 0
	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
	TAD FIOSTK+1	/INTERNAL FILE NUMBER
	JMS I GD01	/GET DIRECTORY ENTRY INTO CORE
	DCA EXBUFP	/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 EXBUFP
	JMP I EXT1

ENR01,	ENR0
	PAGE
/ROUTINE TO REDUCE A FILE

RED0,	JMS I EXT11	/MAKE SURE IT'S OKAY TO REDUCE THIS FILE
	DCA REBUFP	/...IF OKAY, RETURNS WITH PTR. TO FILE NAME BLOCK
	TAD REBUFP
	TAD C0005
	DCA RELINK	/NOW POINTS TO NUMBER OF SEGMENTS PRESENTLY IN FILE
	TAD FIOSTK+2	/SEGMENTS TO BE REMOVED
	SNA		/IS HE REDUCING IT AT ALL?
	JMP I FIEXIT	/NO - SAVE OURSELVES WORK & AVOID A BUG
	SPA		/IS IT NEGATIVE?
	CLA CLL CMA RAR	/REPLACE THE NEGATIVE # BY 3777.
	CIA
	TAD I RELINK
	SMA SZA		/DELETE THE FILE?
	JMP RED6	/NO, REDUCE IT
	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
	SAVBUF		/ & INDICATE BUFFER CHANGED
	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 .+1	/THEN GO INVALIDATE THE RETRIEVAL WINDOW
	EXT8

/ROUTINE TO DELETE A FILE
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
	SAVBUF		/YES - SET 'BUFFER CHANGED'
RED5,	DCA .+3		/NOW SET THE ENTRY ADDRESS
	TAD GDRETP
	JMS I GE01	/ AND GET A DIRECTORY ENTRY IN CORE
REDPTR,	0
	TAD P0003	/GET TO THE LINK POINTER
	DCA REDPTR
	TAD I REDPTR	/GET THE LINK TO THE NEXT ENTRY
	CIA
	TAD RED4
	SNA CLA		/IS IT THE ENTRY WE'RE DELETING?
	JMP .+3		/YES
	TAD I REDPTR	/NO - GET ITS ADDRESS
	JMP RED5	/ AND KEEP SEARCHING
	TAD RED3	/SET THE NEW LINK TO NEXT ENTRY
	DCA I REDPTR	/ SO IT LINKS AROUND THE DELETED FILE
	SAVBUF		/SET 'BUFFER CHANGED'
	JMS RED40	/ AND GO DELETE THE FILE ITSELF
	JMP I RED1

RED3,	0	/UFD ADDRESS OF NEXT ENTRY IN DIRECTORY CHAIN
RED4,	0	/UFD ADDRESS OF THIS DIRECTORY ENTRY
REDGD1,	GD1

/ROUTINE TO REDUCE A FILE - ENTER WITH THE NUMBER OF
/SEGMENTS WHICH ARE TO REMAIN.
RED40,	0
	DCA CFH
	TAD GDRETP	/RTABLE
	DCA RERETP
	TAD CFH		/# OF SEGMENTS TO REMAIN
	JMS I RED302	/ROUTINE TO DO ACTUAL REDUCTION
RELINK,	0		/RETRIEVAL CHAIN PTR
RERETP,	0		/UFD RETRIEVAL PTR.
	JMP I RED40

EXT11,	EXT1
RED302,	RED30
REBUFP,	0
/SEARCH ENTTBL FOR OPENINGS TO FILE
/CALLING SEQUENCE:
/	TAD (RETRIEVAL POINTER)
/	JMS I ENS01
/	UFD ADDRESS OF DIRECTORY ENTRY
/	RETURN (COUNT OF ACCESSES IN AC)

ENS0,	0
	JMS ENS3
	CMA
	DCA ENRETP	/ (-) RELATIVE POINTER
	DCA ENACNT	/CLEAR ACCESS COUNTER
	TAD ENTTBL
	DCA ENTPTR
ENS2,	TAD I ENTPTR	/GET THE UFD POINTER FOR THIS FILE
	AND C3777	/ ZAP THE 'EXCLUSIVE USE' BIT
	TAD ENRETP	/ AND SUBTRACT THE ONE WE WANT
	ISZ ENTPTR
	SZA CLA		/FILE IN SAME UFD?
	JMP ENS1	/NO - KEEP LOOKING
	TAD I ENTPTR
	CIA
	TAD I ENS0
	SZA CLA		/YES - SAME FILE LOCATION?
	JMP ENS1	/NO
	ISZ ENACNT	/YES - INCREMENT ACCESS COUNT
	TAD ENTPTR	/ AND SAVE 'FIND' LOCATION
	DCA ENSFND
ENS1,	ISZ ENTPTR
	TAD ENTPTR
	CIA
	TAD ENTEND	/END OF ENT TABLE
	SZA CLA
	JMP ENS2	/KEEP LOOKING
	TAD ENACNT	/PICK UP ACCUMULATED ACCESS COUNT
	ISZ ENS0
	JMP I ENS0

ENTPTR,	0
ENRETP,	0
ENACNT,	0

/CONVERT AN ABSOLUTE PTR INTO RETTBL TO A RELATIVE ENTRY NUMBER
ENSFND,		/LOCATION OF LAST 'FIND' IN ENTTBL
ENS3,	0
	CIA
	TAD RETTBL	/REL. PTR. TO ADDRESS WITHIN RETTBL
	CIA
	AND P7770
	CLL RTR; RAR	/ DIVIDED BY 8
	JMP I ENS3
	PAGE
/ROUTINE TO PROVIDE FILE INFORMATION

INF0,	JMS I IFN01	/GET INTERNAL FILE NUMBER IN FIOSTK+1
	JMS I EBLD0
	DCA CFH		/RELATIVE POINTER TO UFD RETRIEVAL INFORMATION
	DCA FIOSTK
	DCA FIOSTK+2	/CLEAR OWNER JUST IN CASE
	TAD I CFH	/GET PTR. TO RETTBL OUT OF ENTTBL
	SNA		/DOES IT EXIST?
	JMP INF5	/NO, SO FILE IS NOT OPEN
	CIA
	CLL CMA RAL	/ * 2 (AND ZAP 'EXCLUSIVE USE' BIT)
	TAD UFDTBL
	DCA INUFDP	/POINTER TO USER PROJ,PROG NUMBER
	RAR		/GET BACK THE 'EXCLUSIVE USE' BIT
	TAD FIOSTK+1	/ AND SAVE IT WITH THE FILE #
	DCA INF4
	TAD I INUFDP
	DCA FIOSTK+2	/SET THE OWNER'S ACCOUNT (ALSO FOR 'GD0')
	TAD FIOSTK+1	/NOW GET THE INTERNAL FILE #
	JMS I GD01	/ AND GET THE FILE'S DIRECTORY ENTRY
	CIA
	CMA
	DCA INDEX
	TAD INF4	/SEND BACK THE 'EXCLUSIVE USE' BIT
	DCA FIOSTK+1	/ WITH THE FILE #
	TAD I INDEX	/NOW THE
	DCA FIOSTK+3
	TAD I INDEX	/	FILE
	DCA FIOSTK+4
	TAD I INDEX	/		NAME
	DCA FIOSTK+5
	ISZ INDEX
	TAD I INDEX
	DCA FIOSTK+6	/RETURN THE PROTECTION-WORD
	TAD I INDEX
	DCA FIOSTK+7	/ AND THE SIZE
	CLA CMA
	TAD FIOSTK+2
	SZA CLA		/IS THIS FILE A DIRECTORY?
	JMP INF5	/NO
	DCA FIOSTK+4	/YES - CLEAR THE PASSWORD
	TAD I INDEX	/ AND RETURN THE DATE-WORD (CPU TIME)
	DCA FIOSTK+5	/ (THE SIZE-WORD IS THE DEVICE-TIME)
INF5,	DATFLD
	TAD I FIOPTR	/PICK UP JOBLNK WORD FROM JOB STATUS BLOCK
	DCA INF4	/DESTINATION IN FIELD 0
	CFLD		/CHANGE TO PRESENT FIELD
	CIF
	BLT		/MOVE FIOSTK INFORMATION INTO IOT PARAMETER BLOCK
	 CFLD	/SOURCE FIELD
	 FIOSTK	/SOURCE
	 DATFLD	/DESTINATION FIELD 0
INF4,	 0	/DESTINATION
	 -10	/WORD COUNT
	TAD P0007	/GET THE NUMBER OF PARMS TO RETURN
INF6,	CLL RTL; RTL; RAL
	DCA INSPTR
	TAD FILINK	/GET THE LINK-SAVE WORD
	AND C7037	/ ZAP THE OLD COPY-COUNT
	TAD INSPTR
	DCA FILINK	/ AND SET THE NEW COUNT
	CHKSRC		/WERE WE CALLED FROM 'SI'?
	SKP
	JMP I FIEXIT	/YES - CAN'T SET 'JSIOTC' OR SCHEDULER FOULS UP
	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

C7037,	7037
INUFDP,	0
LGIDDB,
INSPTR,	0
INIOTC,	JSIOTC
/LOGIN ROUTINE

LGI0,	TAD RETTBL	/MFD RETRIEVAL IS IN ENTRY 0
	DCA FIOSTK+1
	TAD FIOSTK+2
	SNA CLA		/IS THE ACCOUNT # AT ALL REASONABLE?
	JMP LGI20	/NO - CAN'T LOG IN
	TAD FIOSTK+3
	SNA CLA		/IS THE FIRST WORD OF THE PASSWORD ZERO?
	TAD FIOSTK+4	/YES - THE 2ND WORD NON-ZERO FLAGS NO PASSWORD NEEDED
	JMS I DS01	/SEARCH THE MFD (AC=0 TO INDICATE 3-WORD SEARCH)
	 FIOSTK+1
	JMP LGI20	/COULD NOT FIND ENTRY IN MFD
	CLA CLL		/ (ENTRY ADDRESS RETURNED IN AC)
	TAD FIOSTK+2	/GET THE ACCOUNT NUMBER
	JMS I UFO01	/ AND OPEN THE UFD (I.E. FETCH RETRIEVAL INFO)
	JMP LGI20	/COULD NOT FIND ROOM ON TABLE
	CLA CMA
	TAD I UTPRNU
	DCA I UTPRNU	/ACCOUNT FOR NEW ENTRY IN ACCESS COUNT
	TAD FIJOB	/NOW GET THE KEYBOARD NUMBER
	TAD TTYTBA	/ FOR THIS JOB
	DCA LGIDDB
	DATFLD
	TAD I LGIDDB
	CLL RAL
	TAD DEVTBA	/FIND ITS DDB ADDRESS
	DCA LGIDDB
	TAD I LGIDDB	/GET THE LOCATION OF THE
	TAD P0003	/ 'ASSIGNED TIME' WORD
	DCA LGIDDB
	CDF
	TAD I CLK1A	/NOW CALCULATE THE VALUE FOR
	AND C7000
	CLL RAL
	DCA CFH
	TAD I CLK2A
	AND P0777
	TAD CFH
	RTL
	RAL
	DATFLD
	DCA I LGIDDB	/THEN SET THE CURRENT TIME IN THE DDB
	JMP I .+1	/NOW WRITE OUT THE TABLES
	TABOUT

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

CLK1A,	CLK1
CLK2A,	CLK2
TTYTBA,	TTYTBL
	PAGE
/ROUTINE TO PERFORM ACTUAL FILE REDUCTION

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

DSCNTR,
RED30,	0
	JMS I WND201	/DIVIDE BY 7
	CMA
	DCA REWNDC	/WINDOW COUNT-- NUMBER OF WHOLE WINDOWS WHICH ARE TO REMAIN
	TAD I RED30	/RETRIEVAL CHAIN POINTER
	ISZ RED30

/NOW TRACE THRU THE LINKED LIST OF FILE INFORMATION
/RETRIEVAL BLOCKS UNTIL WE GET TO THE ONE IN WHICH THE
/NEW LAST SEGMENT IS
RED32,	DCA RED31	/LINKAGE TO RETRIEVAL CHAIN
	TAD I RED30	/PICK UP RETRIEVAL POINTER
	JMS I GE01	/GET THIS WORD INTO CORE
DSENTP,
RED31,	 0
	DCA REBUFF
	TAD I REBUFF	/PICK UP LINK TO NEXT
	DCA RELINC	/SAVE LINK
	TAD WNDREM
	SZA CLA		/DELETING ENTIRE WINDOW?
	JMP RED37	/NO
	CLA CLL CML RTL
	TAD REWNDC
	SZA CLA		/YES - ARE WE ONE WINDOW FROM THE END YET?
	JMP RED37	/NO
	DCA I REBUFF	/YES - CLEAR THE LINK TO IT
	SAVBUF		/ AND SET 'BUFFER CHANGED'
RED37,	TAD RELINC
	ISZ REWNDC	/AT END OF CHAIN?
	JMP RED32	/NO, KEEP SAVING
	DCA RELINC	/SAVE LINC
	DCA I REBUFF	/YES, TERMINATE IT
	SAVBUF		/ AND SET 'BUFFER CHANGED' SWITCH

/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		/YES; GET POINTER TO FIRST SEGMENT TO BE DELETED
	TAD REBUFF
	DCA REBUFF	/POINTER TO FIRST SEGMENT TO REMOVE
RED33,	TAD I REBUFF	/PICK UP THE SEGMENT NUMBER
	SZA
	JMS I SATR1	/RELEASE IT ON SAT
	DCA I REBUFF	/CLEAR THE CELL
	ISZ REBUFF
	TAD REBUFF
	AND P0007
	SZA CLA		/END OF WINDOW?
	JMP RED33	/NO, CONTINUE
	TAD RELINC	/YES, MOVE TO NEXT
	SZA		/END OF CHAIN?
	JMP RED34	/NO, GET NEXT WINDOW
	ISZ RED30	/YES, EXIT
	JMP I RED30
RED34,	DCA RED35
	TAD I RED30
	JMS I GE01	/GET NEXT WINDOW
DSKCNT,
RED35,	 0
	DCA REBUFF
	TAD I REBUFF
	DCA RELINC	/SET UP LINK TO NEXT
	DCA I REBUFF	/WIPE OUT THIS LINK
	SAVBUF		/ AND INDICATE 'BUFFER CHANGED'
	ISZ REBUFF
	JMP RED33	/KEEP WIPING OUT

REBUFF,	0
RELINC,	0
REWNDC,	0
WND201,	WND20
/DIRECTORY SEARCH

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

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 DSMAX	/SET UP COUNTER ON # ENTRIES CHECKED
	DCA DSKCNT
	DCA DSNEXT	/CLEAR OUR NEXT-HIGHEST
DS1,	DCA DSWORD
	TAD I DSRETS	/GET PTR. TO RETRIEVAL INFORMATION BLOCK
	JMS I GE01	/GET THE ENTRY INTO CORE
DSWORD,	 0		/WORD NUMBER--I.E. THE ADDR. WITHIN THE DIRECTORY
	SNA		/DID WE GET THE ENTRY?
	HLT		/NO, BUT THERE WAS A POINTER TO IT - ERROR *****
	DCA DSENTP	/STORE POINTER TO ENTRY
	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
DS2,	TAD I DSENT
	ISZ DSENT
	CIA
	ISZ DSOBJT
	TAD I DSOBJT
	SZA CLA
	JMP DS3		/NOT FOUND
	ISZ DSCNTR
	JMP DS2		/LOOK AT NEXT WORD OF NAME

/WE FOUND IT - JUST RETURN THE POINTER
	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.  UPDATE OUR 'NEXT UFD' WORD
/AND THEN PICK UP THE LINK TO THE NEXT ENTRY.
DS3,	ISZ DSKCNT	/BAD DIRECTORY?
	SKP		/NOT YET
	HLT		/LOOPING LINKS - ERROR *****
	TAD I DSENTP	/GET THE LAST ENTRY
	CLL CML CIA
	TAD I DSOBJT
	SNL CLA		/GREATER THAN THE ONE WE WANT?
	JMP DS5		/NO
	TAD DSNEXT
	SNA		/YES - DO WE HAVE A NEXT YET?
	JMP DS4		/NO - JUST TAKE THIS ONE
	CLL CML CIA
	TAD I DSENTP
	SNL CLA		/SMALLER THAN OUR PREVIOUS 'NEXT'?
	JMP DS5		/NO
DS4,	TAD I DSENTP	/YES - SAVE THIS ONE INSTEAD
	DCA DSNEXT
DS5,	TAD P0003	/CREATE POINTER TO NEXT ENTRY
	TAD DSENTP
	DCA DSCNTR
	TAD I DSCNTR
	SZA		/IS THIS THE END OF THE DIRECTORY CHAIN?
	JMP DS1		/NO, SO CONTINUE SEARCH
	TAD P0003
	TAD DSWORD	/YES - RETURN ADDRESS OF LAST LINK-WORD
	JMP I DS0

DSENT,	0
DSMAX,	-161	/ - (MAX # OF FILES USER CAN OWN + 1)
DSNEXT,	0
DSOBJT=	REBUFF
DSRETS=	RELINC
DSWDNR=	REWNDC
	PAGE
/ROUTINE TO LOOK IN THE SAT FOR A FREE SEGMENT

/CALLING SEQUENCE:
/	JMS SATLOK
/	RETURN (SEGMENT NUMBER IN AC, 0=NONE AVAILABLE)
SATLOK,	0
	TAD SATTBL	/SET THE POINTER INTO THE TABLE
	DCA SATPNT
	TAD I SATCNT	/# OF AVAILABLE DISC SEGMENTS
	SNA		/ARE THERE ANY?
	JMP I SATLOK	/NO, SO SCREW 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
	HLT		/YES, BUT WE SUPPOSEDLY HAD A SLOT *****
	DCA I SATCNT	/ (IF SYSTEM IS CONTINUED, WE'LL FIX THE COUNT)
	JMP I SATLOK

/WE FOUND A SAT WORD WITH A ZERO BIT. NOW FIND THAT BIT
SAT2,	CLL CML RAR	/4000 INTO ACC.
	DCA SATMSK
	ISZ SATCT2	/INCREMENT THE BIT POSITION COUNT
	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	/SET THE BIT IN SATTBL TO INDICATE
	DCA I SATPNT	/ THAT THIS SEGMENT IS ALLOCATED
	TAD SATPNT
	TAD SATFIX
	DCA SATMSK
/
/NOW CALCULATE THE NUMBER OF THE DISC SEGMENT
/WHICH CORRESPONDS TO THIS BIT IN THE SAT TABLE
	TAD SATMSK	/THE WORD-NUMBER
	CLL RAL
	TAD SATMSK
	RTL		/ TIMES 12
	TAD SATCT2	/ PLUS THE BIT POSITION
	JMP I SATLOK	/EXIT WITH DISC SEGMENT NUMBER IN ACC.

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

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

SATREL,	0
	SNA		/REASONABLE SEGMENT NUMBER?
	HLT		/NO - ERROR *****
	DCA SATEMP	/SEGMENT NUMBER
	CLA CLL CMA CML
	DCA SATSTA	/MARK SAT STATUS AS HAVING BEEN CHANGED
	TAD SATEMP
	TAD SEGMAX
	SZA SNL CLA	/LEGAL SEGMENT NUMBER?
	HLT		/NO - ERROR *****
	DCA SATPNT
/
/NOW DIVIDE SEGMENT NUMBER BY 12 DECIMAL
/QUOTIENT INDICATES WHICH WORD IN SAT TABLE CORRESPONDS
/TO THIS DISC SEGMENT. REMAINDER INDICATES WHICH BIT IN
/THAT WORD
	CLA CMA		/SUBTRACT 1 SO SEGMENT TABLE STARTS AT 0
SATRL1,	TAD SATEMP
	SMA		/IS SEGMENT # > 3777?
	JMP SATRL2	/NO
	TAD CM3770	/YES - SUBTRACT 3770 FROM IT
	DCA SATEMP
	TAD SATPNT	/THEN PUSH THE POINTER BY 3770 SEGMENTS
	TAD C0252	/ WHICH IS 252 WORDS
	DCA SATPNT
	JMP SATRL1	/THEN CHECK AGAIN

/NOW FIND THE WORD-ADDRESS OF THIS BIT NUMBER.
	ISZ SATPNT
SATRL2,	TAD C7764	/-14
	SMA		/IS THIS THE WORD?
	JMP .-3		/NO - ADVANCE THE POINTER & SUBTRACT AGAIN
	DCA SATEMP	/YES - SAVE THE BIT-POSITION
	TAD SATPNT
	TAD SATTBL	/GET THE WORD-ADDRESS
	DCA SATPNT
	CLL CML
	RAL
	ISZ SATEMP	/SET UP A MASK CORRESPONDING TO PROPER BIT
	JMP .-2
	AND I SATPNT
	SNA		/IS THIS SEGMENT REALLY ASSIGNED?
	HLT		/NO - ERROR *****
	CMA
	AND I SATPNT	/CLEAR SAT TABLE BIT
	DCA I SATPNT	/ THE SEGMENT IS NOW AVAILABLE
	ISZ I SATCNT	/UPDATE THE AVAILABLE SEGMENTS COUNT
	JMP I SATREL

C0252,	252	/ [3770 BITS / 14 BITS PER WORD (OCTAL)]
C7764,	-14
CM3770,	-3770
SEGMAX,	-DSKSIZ+JOBMAX+SWDEX^20+1	/ (-) LARGEST SEGMENT NUMBER
/ROUTINE TO FETCH A LINKED-BLOCK (USED BY 'OPEN').
GTBLOK,	0
	DCA GTB1
	CFLD
	TAD GTB1
	CIF
	GETBLK
	JMP I GTBERR	/NO BLOCK AVAILABLE - SAY "PROTECTION VIOLATION"
	DATFLD
	TAD I GTB1
	JMP I GTBLOK
GTBERR,	OPNER2
GTB1,	0

/DISPATCH TABLE FOR IOTS

IODISP,	ASD1
	REL0
	REN0
	OPN0
	CLS0
	WND0
	PRT0
	WND0
	XOPN0
	CPASS0
	CRF0
	EXT0
	RED0
	INF0
	LGI0
	LGO0
	BCLR0
	PAGE
/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)

GE0,	0
	DCA GERETP	/STORE RETRIEVAL INFORMATION POINTER
	TAD I GE0
	AND K7400	/FIND UFD SEGMENT #
	CLL RTL; RTL; RAL
	TAD GERETP
	DCA GERETP
	TAD I GERETP	/GET THE PHYSICAL SEGMENT #
	SNA
	JMP GE3
	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.
	ISZ BUFSTA	/ANYTHING IN BUFFER?
	JMP RD0		/NO, READ
	TAD RDCURR	/YES, SAME AS SEGMENT WE ARE LOOKING FOR
	CIA
	TAD RDTEMP
	SNA CLA		/IS THIS THE SEGMENT WE WANT?
	JMP RD3		/YES - SEGMENT ALREADY IN CORE
	JMS I WRT1	/NO - WRITE IT OUT IF NECESSARY
RD0,	TAD RDTEMP
	JMS RD30	/SET UP PARAMETERS FOR A READ OPERATION
	JMS I FIO01	/PERFORM THE READ
	JMP I FIEXIT	/ERROR ON READ
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 ZERO A DISC SEGMENT. WE DON'T ACTUALLY WRITE
/OUT ZEROES, ALL WE DO IS ZERO THE CORE-BUFFER AND SET 
/THINGS UP SO IT WILL BE WRITTEN OUT THE NEXT TIME A BLOCK
/IS NEEDED OR WHEN FIP EXITS.

SCL0,	0
	DCA SCLSEG	/SAVE THE SEGMENT NUMBER
	JMS I WRT1	/WRITE OUT THE BUFFER IF NECESSARY
	TAD MSEGSZ
	DCA CFH		/SET THE BUFFER LENGTH
	TAD BUFFER
	DCA SCLPTR	/ AND THE BUFFER POINTER
SCL1,	DCA I SCLPTR	/NOW CLEAR THE BUFFER TO ZEROES
	ISZ SCLPTR
	ISZ CFH
	JMP SCL1
	TAD SCLSEG
	JMS RD30	/SET UP THE READ PARAMETERS
	CLA CMA		/ AND JUST INDICATE THE BUFFER IS FULL
	DCA BUFSTA
	SAVBUF		/ALSO SET 'BUFFER CHANGED'
	JMP I SCL0	/THEN JUST RETURN

MSEGSZ,	-WRDSEG
SCLPTR=	RDTEMP
SCLSEG=	RDCURR

/ROUTINE TO SET UP FOR A READ
/ENTER WITH SEGMENT NUMBER. THIS IS CONVERTED
/TO A PHYSICAL DISC ADDRESS
RD30,	0
	DCA RDCURR	/SAVE AS CURRENT BUFFERED SEGMENT
	CLA CMA
	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 C6603	/READ IOT
	DCA FLPARB
	JMP I RD30
/ACTUAL IO ROUTINE
/SET UP ALL IO PARAMETERS IN "FLPARB", AND JMS FIPIO

FIPIO,	0
	TAD FIPFLD
	RAR
	DCA FLPARB+2	/='S FIELD WE'RE IN TIMES 4
	CFLD		/CHANGE TO CURRENT FIELD IF NECESSARY
	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
	BLT		/MOVE DISC TRANSFER PARMS INTO DSUTBL BLOCK
	 CFLD
	 FLPARB
	 DATFLD		/DESTINATION FIELD
FIO3,	 FIPBLK		/DESTINATION
	 -10		/WORD COUNT
	CIF CDF
	ISZ I DSBSYA	/GLOBAL TO "DSBUSY"
	WAIT
	JMP I OVER	/GO TO FIELD 0, LOCATION "OVERLA+5"

/MONITOR RETURNS CONTROL HERE AFTER COMPLETING THE TRANSFER
FIORET,	CLA		/RETURNS FROM DISC IO 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
	AND P0007	/CHECK ERROR BITS
	SZA
	JMP FIO6	/SOME KIND OF ERROR OCCURRED
	ISZ FIPIO	/NO ERROR, NORMAL RETURN
	JMP I FIPIO
FIO6,	TAD C7773	/-5, DISC ERROR CODE
	SZA CLA
	ISZ FIPIO	/ERROR WAS NOT CAUSED BY DISC TRANSFER
	JMP I FIPIO	/EXIT WITHOUT SKIPPING TO INDICATE DISC TRANSFER ERROR

C7773,	-5
DSBSYA,	DSBUSY
FIPTR1,	0
FIUTBA,	DSUTBL+4+4
FIRETP,	FIORET
OVER,	OVRLA1
	PAGE
/ROUTINE TO CHECK WHETHER THE FILE A USER
/IS ATTEMPTING TO ACCESS IS HIS.

/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 'ENTTBL' ENTRY FOR THIS FILE
	SNA
	JMP I UC0	/FILE NOT OPEN
	CIA
	CMA
	CLL RAL		/ * 2 (AND ZAP 'EXCLUSIVE USE' BIT)
	TAD UFDTBL
	DCA UCUFDP	/POINTER TO OPEN UFD TABLE
	CLA CMA
	TAD I UCUFDP
	SNA CLA		/IS THIS A DIRECTORY?
	JMP UC1		/YES - ONLY OWNER GETS IT (NOT BILLING SYSTEM)
	CHKACT		/NO - IS THIS A PRIVILEGED USER?
	JMP UC2		/YES - HE GETS ANYTHING ELSE
UC1,	TAD FIACCT	/GET HIS ACCOUNT NUMBER
	CIA
	TAD I UCUFDP
	SNA 		/DOES HE OWN THIS?
UC2,	ISZ UC0		/YES - FIX RETURN ADDRESS
	JMP I UC0

UCUFDP,	0
/THIS HANDLES THE 'LOGOUT' IOT - IF THE AC IS SET TO THE
/USER'S JOB NUMBER, WE LOG HIM OUT; IF THE AC IS 0, WE RETURN
/THE NUMBER OF ADDITIONAL USERS LOGGED-IN UNDER HIS ACCOUNT.

LGO0,	TAD FIOSTK+1	/DID HE SET HIS AC= TO HIS JOB #?
	CIA
	TAD FIJOB
	SZA CLA
	JMP I LGO1A	/NO - SEE IF HE WANTS COUNT OF OTHER USERS
	JMS I LNS01	/YES - FIRST RELEASE ALL HIS DEVICES
	JMP .+3
	JMS I REL01
	JMP .-3		/KEEP GOING
	JMS I CL01	/CLOSE FILE 0
	IAC
	JMS I CL01	/CLOSE FILE1
	CLL CML RTL
	JMS I CL01	/CLOSE FILE 2
	TAD P0003
	JMS I CL01	/CLOSE FILE3
	TAD FIACCT	/GET USER'S ACCOUNT NUMBER
	DCA LGOPRM+1	/DELIVER TO CALLING SEQUENCE FOR SEARCH
	CLA CMA
	JMS I DS01	/FIND MFD ENTRY; 1 WORD SEARCH
	 LGOPRM
	HLT		/ERROR - MASTER DIRECTORY MAY BE LOST *****
	TAD C0006
	DCA LGOPTR	/POINTER TO CP TIME COUNTER
	TAD I ZDS1	/PICK UP THE RELATIVE UFD-LOCATION
	DCA LGOENT	/ FOR CHECKING IF REDUCTION IS POSSIBLE
	FGETJT
	 JOBRTM		/JOB RUN TIME IN STATUS
	DCA FIOSTK+6	/POINTS TO LOW ORDER RUN TIME
	FGETJT
	 JOBRTH
	DCA FIOSTK+7	/ AND HIGH-ORDER
	DATFLD
	TAD I FIOSTK+6
	AND C7700	/USE HIGH PART OF LOW-ORDER TIME
	CLL RAL
	DCA FIOSTK+6
	TAD I FIOSTK+7
	CFLD		/BACK TO THIS FIELD
	AND P0077
	TAD FIOSTK+6	/NOW COMBINE THE TWO
	RTL
	RTL
	RTL
	TAD I LGOPTR	/UPDATE RUNTIME (CPU TIME : DATE WORD)
	SZL		/DID IT JUST OVERFLOW?
	CLA CMA		/YES - FORCE IT TO THE MAXIMUM
	DCA I LGOPTR
	SAVBUF		/ & SET 'BUFFER CHANGED' SWITCH
	ISZ LGOPTR	/NOW GET TO THE RETRIEVAL-BLOCK POINTER
	TAD I LGOPTR
	DCA LGORET	/ & SAVE IT FOR POSSIBLE UFD REDUCTION
	TAD FIACCT
	JMS I UTS01	/FIND OUR ACCOUNT NUMBER IN 'UFDTBL'
	HLT		/ERROR - NO 'UFDTBL' ENTRY FOR US *****
	JMS I BLDP1	/CALCULATE THE 'ENTTBL' ENTRY LOCATION
	DCA LGOPTR	/ IN CASE WE'RE THE LAST USER OF THIS UFD
	ISZ I UTPRNU	/DECREMENT THE ACCESS-COUNT FOR THIS UFD
	JMP LGO3
	TAD RETTBL	/LAST USER ACCESSING THIS UFD
	JMS I ENS01	/FIND THE NUMBER OF USERS READING IT
UCENTP,
LGOENT,	 0
	SZA CLA		/DOES ANYONE HAVE IT OPEN AS A FILE?
	JMP LGO2	/YES - WE COULDN'T REDUCE IT NOW
	TAD LGOPTR
	JMS I GE01	/NO - GET THE INITIAL LINK-WORD IN THE UFD
	 3
	DCA LGOENT
	TAD I LGOENT
	SZA CLA		/IS THE UFD COMPLETELY EMPTY?
	JMP LGO2	/NO - CAN'T REDUCE IT THEN
	CLA CLL IAC
	JMS I RED301	/NOW REDUCE THE UFD TO ONE SEGMENT
LGORET,	 0
	 RTABLE		/ (FIRST RETTBL ENTRY IS ALWAYS MFD)
LGO2,	CLA CMA
	TAD UTPRNU
	JMS I TF01	/NOW FREE THE 'UFDTBL' ENTRY
LGO3,	CLA
	TAD LGO4A	/KLUDGE FIEXIT TO RETURN TO LGO4
	DCA I LGKLUJ
TABOUT,	CLA CMA
	DCA TABSTA	/FORCE TABLES OUT
	JMP I FIEXIT

LGKLUJ,	FIX500
LGOPRM,	RTABLE	/2-WORD PARAMETER BLOCK FOR 'DS01'
LGOPTR,	0
LGO1A,	LGO1
LGO4A,	LGO4
LNS01,	LNS0
RED301,	RED30

/ROUTINE TO RETURN A BLOCK TO FREE-CORE.
RETBKS,	0
	CFLD
	CIF
	RETBLK		/JUST LINK TO FIELD 0
	JMP I RETBKS	/ AND RETURN

/ROUTINE TO RETURN A LINKED LIST OF FREE-CORE BLOCKS.
RETBLS,	0
	SNA		/AT END OF CHAIN?
	JMP I RETBLS	/YES - RETURN
	JMS RETBKS	/NO - RELEASE THE BLOCK
	JMP .-3
	PAGE
/ROUTINE TO OPEN A UFD & LEAVE ZERO ACCESS COUNT

/CALLING SEQUENCE:
/	TAD (PROJ,PROG NUMBER)
/	JMS UFO0
/	ERROR RETURN
/	NORMAL RETURN (POSITION ON TABLE IN AC)

UFO0,	0
	DCA UFORET	/SAVE THE ACCOUNT NUMBER
	TAD UFORET
	JMS I UTS01	/SEARCH THE TABLE
	SKP CLA		/NOT FOUND - BUILD NEW ENTRY
	JMP UFOEXT	/GOT IT - JUST EXIT
	TAD UFORET
	JMS UFO6	/GET THE RETRIEVAL INFO. FOR THIS UFD
	JMP UFO5	/NO LUCK - TAKE ERROR EXIT
	DCA UOBUFP	/POINTER TO RETRIEVAL INFORMATION
	TAD UFDTBL
	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
	ISZ UOUFDP
	TAD I UOUFDP
	SNA CLA		/IS IT REALLY EMPTY?
	JMP UFO10	/YES - CLEAN UP

/NO IT IS OCCUPIED
	ISZ UOUFDP
	TAD UOUFDP
	CIA
	TAD UFDEND
	SZA CLA		/HAVE WE SEARCHED THE WHOLE TABLE?
	JMP UFO3	/LOOK AT NEXT SLOT
UFO5,	CLA CLL
	JMP I UFO0	/NO ROOM ON TABLE

/COMES HERE WITH UOUFDP POINTING TO A FREE SLOT IN UFDTBL
UFO10,	CLA CMA
	TAD UOUFDP	/BACK UP THE POINTER
	DCA UOUFDP
UFO2,	TAD UFORET+1
	DCA I UOUFDP	/PUT PROJ,PROG NUMBER ON TABLE
	ISZ UOUFDP
	DCA I UOUFDP	/ACCOUNT FOR THIS ACCESS
	CLA CMA
	TAD UFDTBL
	CIA
	TAD UOUFDP
	CLL RAR
	DCA UFO1	/RELATIVE POSITION ON TABLE
	TAD UFO1
	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
	TAD UFO1	/YES - PICK UP RELATIVE POSITION
UFOEXT,	ISZ UFO0	/PREPARE FOR NORMAL RETURN
	JMP I UFO0

UFORET,	0
	0
UOUFDP=UTPRNU

/ROUTINE TO READ IN THE RETRIEVAL INFORMATION FOR THE
/UFD BELONGING TO THE ACCOUNT NUMBER PASSED IN THE AC.
UOBUFP,
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 P0007
	DCA UFORET	/POINTER TO UFD RETRIEVAL INFORMATION
	TAD I UFORET
	DCA UFO1
	TAD RETTBL	/GET POINTER TO RETRIEVAL INFO FOR THE MFD
	JMS I GE01	/GET RETRIEVAL INFORMATION INTO CORE
UFO1,	 0
	ISZ UFO6
	JMP I UFO6
/ROUTINE TO ASSIGN A DEVICE

ASD1,	TAD FIOSTK+1
	JMS I DTE01	/IS THIS DEVICE ASSIGNED TO THIS JOB?
ASD2,	 0		/SET BY DTE01 TO POINT TO PROPER ENTRY IN DEVTBL
	SKP
	JMP ASD5	/YES
	TAD I ASD2	/GET THE DDB ADDRESS
	SNA		/IS THERE A DDB?
	JMP ASD3	/NO - OKAY TO ASSIGN IT
/
/COMES HERE IF ONE JOB ATTEMPTS TO ASSIGN AN ALREADY ASSIGNED DEVICE
	IAC
	DCA CFH		/NOW POINTS TO JOB # (OR LOC 0, IF ILLEGAL)
	TAD I CFH
	SNA		/JOB NUMBER THERE?
	CMA		/NO - RETURN 7777
	DCA FIUSAC	/RETURN THE OWNER'S JOB NUMBER
	JMP ASD4	/EXIT
/
/COMES HERE IF OKAY TO MAKE THIS ASSIGNMENT
ASD3,	TAD FIOSTK+1
	SMA		/IS THE DEVICE BEING ASSIGNED A TELETYPE?
	JMP I LGI201	/YES - THAT'S NOT ALLOWED
	TAD ASDCHK
	SPA CLA		/IS HE TRYING TO GET THE RK05?
	JMP .+3		/NO
	CHKPRV		/YES - DOES HE HAVE PRIVILEGE?
	JMP I LGI201	/NO - ERROR
	CFLD		/CHANGE TO CURRENT FIELD
	TAD ASD2
	CIF
	GETDDB		/GET A BLOCK FROM THE FREE LIST AND LINK IT INTO DEVTBL
	JMP I LGI201	/NO BLOCK - JUST RETURN A BAD STATUS
	DATFLD
	TAD I ASD2	/PICK DDB ADDRESS FROM DEVTBL
	DCA CFH		/SAVE IT
	TAD FIOSTK+1
	AND P0037
	DCA I CFH	/SET TO REFLECT THE DEVICE NUMBER
	ISZ CFH
	TAD FIJOB
	DCA I CFH	/ AND STORE THE JOB NUMBER
ASD4,	CFLD
	JMP I FIEXIT	/THEN JUST EXIT
/
/USER ALREADY OWNS THE DEVICE - IF IT'S THE HSR, JUST CLEAR THE BUFFER.
ASD5,	TAD FIOSTK+1
	CLL RAL
	SZA CLA		/HSR?
	JMP ASD4	/NO - JUST EXIT
	TAD I ASD2	/GET THE DDB POINTER
	CIF
	JMS I ASDCLR	/CLEAR THE BUFFER
	JMP ASD4

ASDCHK,	-4030		/RK05 DRIVE 0 ASSIGN CODE
ASDCLR,	SICLR

	PAGE

/EXIT ROUTINE
/COMES HERE WHEN FIP HAS COMPLETED ITS TASK
/FIRST, SEE IF ANY INTERNAL FILE HAVE BEEN CHANGED
/THOSE THAT HAVE CHANGED MUST BE WRITTEN BACK OUT TO DISC

FIX0,	CFLD
	CLA
	JMS I WRT1	/MAKE SURE THE BUFFER IS EMPTY
	ISZ TABSTA	/CHECK TABLE STATUS
	JMP FIX1	/NOTHING CHANGED IN TABLES
	TAD FIPTBS	/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 FIX40
	TAD FIDEXP	/GLOBAL TO "FIPDEX"
	DCA FLPARB+1	/MEMORY FIELD
	TAD C6605
	DCA FLPARB	/WRITE IOT
	JMS I FIO01	/PERFORM THE WRITE
	HLT		/ERROR ON WRITE, FATAL
/ALL DISC TABLES ARE NOW UP TO DATE
FIX20,	FGETJT
	 JOBSTS
	DCA FIOPTR
	DATFLD
	TAD I FIOPTR
	AND FISIOT	/CLEAR 'FIP IOT' BIT
	DCA I FIOPTR
	CFLD
	FGETJT		/RESTORE USER REGISTERS
	 JOBREG
	DCA FIX21
	CIF
	BLT
	 CFLD
	 FIUSPC
	 DATFLD
FIX21,	 0
	 -5
	JMP I .+1
FIX500,	FIX50	/CHANGED TO 'LGO4' DURING LOGOUT PROCESSING
FIX50,	CFLD
	TAD I SEGCNT
	CDF
	DCA I FIXCNT	/STORE # FREE SEGMENTS IN FIELD 0
	CHKSRC		/WHO CALLED US?
	JMP FIX30	/A USER - JUST CLEAR THE ENTRY
	TAD C6603	/'SI' - SET UP TO READ IT IN
	DCA FLPARB
	DCA FLPARB+1	/SI IS IN THE TRACK 0 OF THE DISC
	JMS FIX40
	JMS I FIO01	/RETURN WILL BE TO SI

/FIP WAS CALLED BY A USER - JUST CLEAR THE 'CORTBL' ENTRY
FIX30,	CDF
	TAD I FANFLD	/A USER - GET THE 'CORTBL' ENTRY
	AND FIPCLR	/ AND CLEAR THE JOB NUMBER & LOCK BIT
	DCA I FANFLD
	JMP I .+1	/NOW GO CHECK FOR OTHER 'FIPJOB'S
	FIXSCH

/ROUTINE TO SET UP THE PARAMETERS IN 'FLPARB'.
FIX40,	0
	DCA FLPARB+3	/SET (-) WORD-COUNT
	TAD FLPARB+3
	DCA FLPARB+5	/SET DISC ADDRESS
	CLA CMA
	TAD FLPARB+5
	DCA FLPARB+4	/SET CORE ADDRESS - 1
	JMP I FIX40

FIPCLR,	FSWP+NOTRUN+FIP+SI
FIPFIP=	C0400
FIPTBS,	ENTABL		/LOWEST TABLE IN FIP
FISIOT,	-JSIOT-1
FIXCNT,	NFSEGS		/VALUE FOR RESIDENT 'SEGS'
SEGCNT,	-SATSIZ+1	/POINTER TO # FREE SEGMENTS
/ROUTINE TO DETERMINE IF A DEVICE IS ASSIGNED TO THIS JOB

/CALLING SEQUENCE:
/	TAD (DEVICE NUMBER)
/	JMS DTE0
/	RETURN (DEVICE NOT ASSIGNED TO THIS JOB)
/	RETURN (DEVICE ASSIGNED) 

DTE0,	0
	SPA		/IS IT A TTY?
	JMP .+4		/NO
	CLL RAL		/YES - GET THE DEVTBL ENTRY-ADDRESS
	TAD DEVTBA
	JMP DTE1
	AND P0077	/EXTRACT THE DEVICE NUMBER
	TAD DEVEND	/ & FIND THE DEVTBL ENTRY
DTE1,	DCA DTE2	/POINTER TO DEVTBL ENTRY
	TAD DTE2
	CIA
	TAD DEVOVR
	SMA CLA		/IS IT A LEGAL DEVICE NUMBER?
	JMP .+3		/YES
	TAD DTEBAD
	DCA DTE2	/NO - FUDGE SO JOB=0 (CHANGED TO 7777)
	TAD DTE2
	CFLD
	DCA I DTE0	/PASS BACK THE DEVTBL POINTER
	ISZ DTE0
	DATFLD
	TAD I DTE2	/GET THE DDB ADDRESS
	SNA		/IS THERE A DDB?
	JMP I DTE0	/NO - DEVICE NOT ASSIGNED TO ANYONE
	DCA DTE2
	ISZ DTE2
	TAD I DTE2
	AND P0077	/EXTRACT JOB NUMBER
	CIA
	TAD FIJOB	/NUMBER OF CURRENT JOB
	SNA CLA
	ISZ DTE0	/"ASSIGNED" RETURN
	JMP I DTE0	/NOT OWNED BY THIS JOB

DTEBAD,	JOBTBL-1
/ROUTINE TO FREE AN ENTRY ON THE UFD TABLE

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

DTE2,
TF0,	0
	DCA TFUFDP	/POSITION ON TABLE
	DCA I TFUFDP	/CLEAR OWNERS PROJ,PROG NUMBER
	TAD UFDTBL	/BEGINNING OF TABLE
	CIA
	TAD TFUFDP
	CLL RAR		/RELATIVE POSITION ON TABLE
	IAC
	JMS I BLDP1	/BUILD A PTR. TO ENTTBL
	DCA TFUFDP	/POINTER TO RETRIEVAL INFORMATION
	TAD P7770	/SET # WORDS PER ENTTBL ENTRY
	DCA TFCNTR
TF1,	DCA I TFUFDP	/ZERO OUT THE ENTRY
	ISZ TFUFDP
	ISZ TFCNTR
	JMP TF1
	JMP I TF0


/ROUTINE TO GET THE FILE CONTROL-BLOCK FOR THE
/FILE WHOSE INTERNAL FILE NUMBER IS IN THE AC.

TFUFDP,
LNK0,	0		/GET FILE LINKAGE
	TAD LNKF
	DCA LNK1
	FGETJT
TFCNTR,
LNK1,	 0
	DCA CFH
	DATFLD
	TAD I CFH	/PTR TO FILE CONTROL BLOCK
	JMP I LNK0

LNKF,	JOBF0

	PAGE

/ROUTINE TO FIND AN EMPTY DIRECTORY ENTRY; THE UFD
/IS EXTENDED IF NECESSARY.
/CALL:	TAD (POINTER TO UFD RETRIEVAL INFORMATION)
/	JMS DE0
/	BAD RETURN (NO FREE ENTRY OR NO DISC FOR UFD)
/	NORMAL RETURN (POINTER TO ENTRY IN AC)

DE0,	0
	DCA DERETP	/SAVE THE RETRIEVAL POINTER
	DCA DEBEGG	/CLEAR THE 'FROM BEGINNING' SWITCH
	TAD DERETP
	DCA INDEX
/
/IN ORDER TO SAVE DISC I/O, WE START THE SEARCH FROM THE
/MIDDLE OF THE UFD IF WE ALREADY HAVE ONE OF ITS SEGMENTS
/IN OUR SEGMENT BUFFER. IF WE DON'T FIND AN ENTRY FROM THE
/MIDDLE, WE RE-CHECK THE UFD FROM THE BEGINNING; IF WE STILL
/DON'T FIND AN ENTRY, WE EXTEND THE UFD.
DE1,	TAD SEGSIZ
	DCA DEWORD	/SET INITIAL ADDRESS TO SECOND SEGMENT IN UFD
	TAD I INDEX	/GET THE NEXT SEGMENT INDEX IN THE UFD
	SNA		/IS THERE A NEXT?
	JMP DE2		/NO - WE SEARCH FROM THE TOP
	CIA
	TAD I DECURR
	SNA CLA		/YES - IS IT OUR BUFFERED SEGMENT?
	JMP DE4		/YES - START SEARCH FROM WHERE WE ARE
	TAD DEWORD	/NO - UPDATE OUR ADDRESS BY ONE SEGMENT
	JMP DE1		/ & CONTINUE CHECKING
/
/THE BUFFERED SEGMENT IS NOT ANY OF THIS UFD'S OR WE COULDN'T
/FIND A FREE ENTRY STARTING FROM THE MIDDLE OF THE UFD,
/SO WE SEARCH THE UFD FROM THE BEGINNING.
DE2,	CLA CMA
	DCA DEBEGG	/SET THE 'FROM BEGINNING' SWITCH
DE3,	TAD C0010
	DCA DEWORD	/SET THE NEW READ ADDRESS
DE4,	TAD DERETP
	JMS I GE01	/GET THE NEXT ENTRY
DEWORD,	 0
	SNA		/WAS IT WITHIN THE UFD?
	JMP DE6		/NO - GO TRY TO EXTEND IT
	DCA CFH		/YES - SAVE ITS CORE LOCATION
	TAD I CFH	/GET THE FIRST ENTRY-WORD
	SZA CLA		/IS IT CLEAR?
	JMP DE5		/NO - TRY THE NEXT
	ISZ CFH
	TAD I CFH	/YES - CHECK THE SECOND WORD
	SZA CLA		/IS THAT OK ALSO?
	JMP DE5		/NO
	TAD DEWORD	/YES - WE HAVE AN EMPTY ENTRY
	ISZ DE0		/ SO SKIP TO INDICATE IT
	JMP I DE0	/ AND RETURN WITH ITS LOCATION IN THE AC
DE5,	TAD DEWORD	/NOT THIS ENTRY - UPDATE THE ADDRESS
	JMP DE3		/ AND CONTINUE SEARCH
/
/WE'VE RUN PAST THE END OF THE UFD - WE MAY HAVE TO EXTEND IT.
DE6,	ISZ DEBEGG	/WAS THIS SEARCH FROM THE FRONT OF THE UFD?
	JMP DE2		/NO - SEARCH AGAIN, THIS TIME FROM THE FRONT
	TAD DERETP
	DCA DEPTR	/YES - FIND THE NEXT SEGMENT SLOT
	TAD C7771
	DCA CFH		/SET THE COUNTER (7 SEGMENTS MAXIMUM PER UFD)
DE7,	TAD I DEPTR	/GET THE NEXT SEGMENT POINTER
	SNA CLA		/IS THERE A NEXT?
	JMP DE8		/NO - WE HAVE ROOM FOR A SEGMENT
	ISZ DEPTR	/YES - INCREMENT THE POINTER
	ISZ CFH
	JMP DE7		/ & TRY AGAIN
	JMP I DE0	/CAN'T EXTEND THE UFD - TAKE ERROR EXIT
/
/WE HAVE ROOM FOR ANOTHER SEGMENT - GET ONE FROM SAT.
DE8,	JMS I SATL1	/FIND A FREE SEGMENT
	SNA		/WAS ONE AVAILABLE?
	JMP I DE0	/NO - TAKE ERROR EXIT
	DCA I DEPTR	/YES - SAVE IT IN THE RETRIEVAL TABLE
	TAD DERETP
	JMS I ENS31	/GET THE RELATIVE ENTRY NUMBER
	CLL RAL
	TAD UFDTBL	/ & THE POINTER INTO 'UFDTBL'
	DCA CFH
	TAD I CFH	/GET THE OWNER'S ACCOUNT NUMBER
	JMS I UFO61	/ & FETCH THE UFD RETRIEVAL BLOCK
	HLT		/ACCOUNT NOT FOUND - ERROR *****
	DCA CFH		/SAVE THE BUFFER POINTER
	ISZ CFH
	TAD I CFH	/GET THE SEGMENT NUMBERS
	SZA CLA		/IS THIS THE END OF THE POINTERS?
	JMP .-3		/NO - KEEP LOOKING
	TAD I DEPTR	/YES - SET OUR NEW SEGMENT NUMBER
	DCA I CFH	/ INTO THE RETRIEVAL BLOCK
	SAVBUF		/NOW SET THE SWITCH TO WRITE BACK THE BUFFER
	CLA CMA
	DCA TABSTA	/ AND INDICATE THE TABLES HAVE BEEN CHANGED
	TAD I DEPTR
	JMS I SCL01	/FINALLY WE ZERO THE NEW UFD SEGMENT
	JMP DE4		/ AND THEN FINISH OUR SEARCH

DECURR,	RDCURR
DEPTR,	0
DERETP,	0
ENS31,	ENS3
UFO61,	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)

DEBEGG,
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
	ISZ UTUPTR	/STEP UP ONE SLOT
	ISZ UTUPTR
	JMP UTS1	/LOOK IN THE NEXT ENTRY
UTS3,	TAD UFDTBL
	CIA
	TAD UTUPTR
	CLL RAR		/RELATIVE POSITION ON TABLE
	IAC		/THE RELATIVE POSITION
	ISZ UTPRNU	/UTPRNU POINTS TO ACCESS COUNT OF THIS PROJ, PROG #
	ISZ UTS0
	JMP I UTS0

UTUPTR=	UTPRNU


/ROUTINE TO FIND THE ADDRESS OF A WORD IN THE
/JOB STATUS BLOCKS FOR THIS JOB.

UTPR1,
FGETJ0,	0
	DATFLD
	TAD I JOBDAT
	SNA CLA		/IS EVERYTHING PROPER?
	REBOOT		/NO - ERROR *****
	CFLD
	TAD I FGETJ0	/GET THE RELATIVE WORD NUMBER
	DCA .+4
	TAD JOBDAT	/NOW GET THE ADDRESS OF A 'JOBTBL' POINTER
	CIF
	GETJTA		/ AND LET THE FIELD 0 ROUTINE DO THE WORK
	 0
	ISZ FGETJ0
	JMP I FGETJ0	/THEN JUST RETURN; AC=ADDRESS


/ROUTINE TO INITIATE AN AUTOMATIC SYSTEM RESTART.
/
RBOOT,	0
	IOF
	CLA
	TAD RBOOT
	CIF
	JMP I .+1	/OFF TO FIELD 0 WITH ERROR ADDRESS IN THE AC
	RELOAD

	PAGE

/THIS HANDLES THE 'REL' IOT - RELEASE A DEVICE.
REL0,	TAD FIOSTK+1	/GET THE DEVICE NUMBER
	SPA		/IS IT A TTY?
	JMS REL00	/NO - GO AHEAD AND RELEASE IT
	JMP I FIEXIT

/ROUTINE WHICH ACTUALLY RELEASES THE DEVICE.
REL00,	0
	JMS I DTE01	/IS THIS DEVICE ASSIGNED TO THIS USER?
RELDVT,	0		/SET BY DTE0 TO POINT TO DEVTBL ENTRY FOR THIS DEVICE
	JMP REL8	/NO - TAKE ERROR EXIT IF SI
	TAD I RELDVT
	DCA RELBLK	/SAVE ADDRESS OF DDB
	TAD RELBLK
	TAD P0003	/POSITION OF TIME IN DDB
	DCA RELASD
	TAD I RELASD	/GET TIME ASSIGNED
	CIA
	DCA RELASD	/-TIME ASSIGNED
	CDF
	TAD I RELCK1	/GET TIME NOW
	AND C7000	/JUST SIGNIFICANT PART OF LOW-ORDER
	CLL RAL
	DCA RELNOW
	TAD I RELCK2
	CFLD		/BACK TO THIS FIELD
	AND P0777	/ AND INSIGNIFICANT PART OR HIGH ORDER
	TAD RELNOW	/TIME AT  RELEASE
	RTL
	RAL
	TAD RELASD	/-TIME AT ASSIGNMENT (13-BIT SUBTRACT)
	SNL		/GONE THROUGH MIDNIGHT?
	TAD RELCON	/YES - ADD FUDGE FACTOR
	SNA		/ANYTHING TO RECORD?
	JMP REL1	/NO
	DCA RELASD	/YES - SAVE IT
	TAD FIACCT
	DCA RELRTB+1	/NOW BUILD THE PACKET FOR 'DS0'
	CLA CMA
	JMS I DS01	/FIND THE MASTER DIRECTORY ENTRY
	 RELRTB
	HLT		/MFD IS LOST *****
	TAD C0005
	DCA CFH		/NOW POINTS TO DEVICE TIME WORD
	CLA CLL
	TAD RELASD
	TAD I CFH	/ADD IN THE NEW TIME
	SZL		/DID IT OVERFLOW?
	CLA CMA		/YES - FORCE IT TO ITS LARGEST
	DCA I CFH
	SAVBUF		/REMEMBER TO WRITE BACK THE BLOCK
REL1,	DATFLD
	CLA CLL CML
	TAD RELDVT
	TAD RELDTA
	SPA		/IS IT THE DTA, OR RK05
	RAR		/NO - MUST BE HSR, ?, CDR, OR CHARACTER DEVICE
	SNL		/IS IT A CHARACTER OUTPUT DEVICE?
	JMP REL6	/NO - MUST BE KEYBOARD, HSR, ?, CDR, R2, OR X DEVICE
	TAD RELREG
REL2,	DCA RELBLK	/POINTS TO ENTRY IN 'OUTREG' (OR 0 FOR KEYBOARD OUTPUT)
	CLA CMA
	TAD I RELDVT
	DCA INDEX	/POINTS TO WORD 0 OF DDB
	TAD I INDEX
	SPA CLA		/IS THE TTY IN ^S MODE?
	JMP REL3	/YES - FLUSH IT OUT
	DCA I INDEX	/CLEAR THE JOB NUMBER
	ISZ INDEX
	ISZ INDEX
	TAD I INDEX
	SZA CLA		/IS THE FILL-POINTER ZERO?
	JMP REL4	/NO - LET 'CONOUT' RELEASE THE BLOCK
	TAD RELBLK
	SZA CLA		/ASSIGNABLE DEVICE?
	JMP REL5	/YES
REL3,	TAD I RELDVT
	CIF
	JMS I RELCLR	/FLUSH THE DEVICE BUFFER
	DATFLD
	TAD I RELDVT
	JMS I RETBK1	/ AND RELEASE THE BLOCK
	CLA
	DATFLD
	DCA I RELDVT	/THEN CLEAR THE DEVTBL ENTRY
REL4,	CFLD
	JMP I REL00	/ AND RETURN

REL5,	CIF 20		/ (JUST INHIBIT INTERRUPTS WHEN CHECKING OUTREG)
	TAD I RELBLK
	CLL RAL
	SNA		/IS AN INTERRUPT EXPECTED OR A CHARACTER BUFFERED?
	JMP REL3	/NO - JUST CLEAR OUT THE DDB
	SPA		/YES - IS AN INTERRUPT PENDING?
	CLL CML		/YES - INSURE DEVICE SERVICING
	RAR
	DCA I RELBLK	/ AND RESTORE THE WORD
	JMP REL4

REL6,	SMA CLA		/IS IT A KEYBOARD OR THE HSR?
	JMP REL7
	TAD RELBLK
	CIF
	JMS I RELCLR	/YES - CLEAR THE BUFFER
REL7,	TAD RELBLK
	JMS I RETBK1	/RETURN THE FREE-BLOCK
	CLA
	DATFLD
	DCA I RELDVT	/ AND CLEAR THE DEVTBL ENTRY
	TAD DEVEND
	CIA
	TAD RELDVT
	SMA CLA		/IS THIS A KEYBOARD?
	JMP REL4	/NO - JUST RETURN
	ISZ RELDVT	/YES - SET THE POINTER TO THE OUTPUT SIDE
	JMP REL2	/ AND RUN IT ALL AGAIN

/DEVICE RELEASED IS NOT OWNED BY THIS USER.
REL8,	CHKSRC		/IS HE USING A KEYBOARD COMMAND?
	JMP I REL00	/NO - JUST RETURN
	JMP I LGI201	/YES - TELL 'SI' HE BLEW IT

RELASD,	0
RELBLK,	0
RELRTB,	RTABLE		/TWO-WORD PACKET FOR 'DS0'
RELNOW,	0
RELCK1,	CLK1
RELCK2,	CLK2
RELCLR,	SICLR
RC1=	INCLK1%1000
RELCON,	INCLK2^10+RC1	/FUDGE FOR MIDNIGHT OVERFLOW
RELDTA,	-DEVTBE-20
RELREG,	DEVTBE+20-DEVTBL%2+OUTREG	/ = OUTREG+NULINE+CONTTY+10
	PAGE
/RENAME ROUTINE

REN0,	JMS I IFN01
	JMS I UC01	/DOES HE OWN THE FILE?
	JMP REN1	/NO - ERROR
	TAD FIOSTK+1	/YES - SAVE THE INTERNAL FILE #
	DCA FIOSTK
	TAD I RENUCP	/GET THE OWNER'S ACCOUNT NUMBER
	DCA REPRTP
	TAD I REPRTP
	JMS I UTS01	/ AND FIND THE 'UFDTBL' ENTRY
	HLT		/BAD - IF THE FILE'S OPEN, THERE MUST BE ONE *****
	JMS I BLDP1	/GET THE 'RETTBL' ENTRY ADDRESS
	DCA FIOSTK+1
	CLA CMA
	TAD I REPRTP	/CHECK THE OWNER'S ACCOUNT
	SNA CLA		/IS IT A DIRECTORY (I.E. OWNED BY ACCT # 1)?
	CLA CMA		/YES - THE FIRST WORD (ACCOUNT) MUST BE UNIQUE
	JMS I DS01	/NOW CHECK IF THE NAME ALREADY EXISTS
	 FIOSTK+1
	SKP CLA		/NOPE - OK TO RENAME
	JMP REN2	/YES - "INVALID FILE NAME"
	TAD FIOSTK
	JMS I GD01	/GET THIS DIRECTORY ENTRY INTO CORE
	DCA REENTP	/ AND SAVE THE POINTER
	TAD REENTP
	TAD P0004
	DCA REPRTP	/POINTER TO PROTECTION BITS
	TAD I REPRTP	/PICK UP PROTECTION BITS
	AND C0020
	SZA CLA		/WRITE-PROTECTED AGAINST OWNER?
	JMP REN1+1	/YES - "PROTECTION VIOLATION"
	TAD FIOSTK+2	/TRANSFER NEW NAME TO DIRECTORY
	SNA		/IS IT A NULL NAME?
	JMP REN2	/YES, DON'T RENAME
	DCA I REENTP
	ISZ REENTP
	TAD FIOSTK+3
	DCA I REENTP
	ISZ REENTP
	TAD FIOSTK+4
	DCA I REENTP
	SAVBUF		/SET 'BUFFER CHANGED' SWITCH
	JMP I FIEXIT	/EXIT FROM FILE PHANTOM

REN1,	SZA CLA		/WHICH ERROR?
CPERR2,	CLL CML RAR	/6000 - PROTECTION VIOLATION
	CLL CML RAR	/4000 - NO FILE OPEN
	DCA FIUSAC
	JMP I FIEXIT

REN2,	CLA CLL CML RTR	/6400 - INVALID FILE NAME
	JMP REN1+1

REENTP,	0
RENUCP,	UCUFDP
REPRTP,	0
/THIS HANDLES THE 'CPASS' IOT - CHANGE PASSWORD.
/IF THE SYSTEM MANAGER PASSES THE INCORRECT CURRENT
/PASSWORD, HE IS SIMPLY RETURNED AN ERROR CODE;
/IF ANYONE ELSE PASSES US AN INCORRECT CURRENT
/PASSWORD, THEY ARE AUTOMATICALLY LOGGED-OUT.

CPASS0,	TAD FIOSTK+1
	SNA CLA		/RATIONAL ACCOUNT NUMBER?
	JMP CPERR2	/NO - RETURN ERROR CODE
	CLA CMA
	TAD FIACCT
	SNA CLA		/IS THIS THE MANAGER?
	JMP CPASS1	/YES
	TAD FIACCT
	CIA
	TAD FIOSTK+1
	SZA CLA		/NO - IS THIS HIS OWN PASSWORD?
	JMP CPERR2	/NO - JUST SAY "PROTECTION VIOLATION"
CPASS1,	TAD RETTBL
	DCA FIOSTK	/MFD IS ALWAYS FIRST ENTRY
	JMS I DS01	/SEARCH FOR ACCT & PASSWORD IN MFD
	 FIOSTK
	JMP CPERR1	/NOT THERE - ERROR!
	DCA INDEX	/SAVE THE ENTRY CORE-ADDRESS
	CLA CMA
	TAD FIACCT
	SNA CLA		/IS THIS THE MANAGER (#1)?
	JMP CPASS2	/YES - HE CAN CHANGE ANYONE'S PASSWORD
	TAD INDEX	/NO - GET THE UFD PROTECTION
	TAD P0004
	DCA CFH
	TAD I CFH
	AND CPBIT	/CHECK THE 'CHANGE PASSWORD DISABLE' BIT
	SZA CLA		/CAN HE CHANGE HIS OWN PASSWORD?
	JMP CPERR2	/NO - "PROTECTION VIOLATION"
CPASS2,	TAD FIOSTK+4	/YES - SET THE NEW PASSWORD
	DCA I INDEX
	TAD FIOSTK+5
	DCA I INDEX
	SAVBUF		/SET THE 'BUFFER CHANGED' SWITCH
	JMP I FIEXIT	/ AND EXIT

CPERR1,	CLA CMA
	TAD FIACCT
	SNA CLA		/IS THIS THE MANAGER?
	JMP CPERR2	/YES - JUST RETURN ERROR CODE
	TAD CPLOUT	/NO - SET UP THE 'LOGOUT' PARMS
	DCA FIOSTK
	TAD FIJOB
	DCA FIOSTK+1
	JMP I .+1	/THEN LOG HIM OUT
	LGO0

CPBIT,	2000	/BIT IN UFD PROTECTION - IF SET, PROHIBITS CPASS
CPLOUT,	LOUT
/THIS HANDLES THE 'BCLR' IOT - THIS ALLOWS THE SYSTEM MANAGER
/AND THE BILLING SYSTEM TO CLEAR THE BILLING INFORMATION IN
/THE MFD TO ZEROES. BY USING AN IOT FOR THIS, WE AVOID THE
/NEED FOR ANY USER PROGRAM TO WRITE INTO THE MFD OR ANY UFD
/DIRECTLY (THUS AVOIDING ANY CONFLICT WITH FIP). WE THEREFORE
/NORMALLY SET THE PROTECTION CODES TO PREVENT ANYONE FROM
/WRITING ANY UFD.

BCLR0,	CHKACT		/IS THIS A PRIVILEGED ACCOUNT?
	SKP		/YES
	JMP CPERR2	/NO - SAY "PROTECTION VIOLATION"
	TAD FIOSTK+1
	SNA CLA		/DID HE PASS US AN ACCOUNT NUMBER?
	JMP REN2	/NO - BOO, HISS!!
	TAD RETTBL	/YES - THE MFD IS ALWAYS THE FIRST ENTRY
	DCA FIOSTK
	CLA CMA		/NOW DO A ONE-WORD SEARCH FOR THE ACCOUNT
	JMS I DS01
	 FIOSTK
	JMP REN2	/NO FIND - ERROR!!
	TAD P0004
	DCA INDEX	/SET THE POINTER TO THE INFORMATION
	DCA I INDEX	/ AND ZERO THE DEVICE TIME
	DCA I INDEX	/ AND THE CPU TIME
	SAVBUF		/NOW SET THE 'BUFFER CHANGED' SWITCH
	JMP I FIEXIT	/ AND EXIT


/ROUTINE TO CALCULATE A POINTER INTO 'ENTTBL'.
/AC = [JOB * 4 + FILEID] * 2 + 'ENTTBL'
EBLD,	0
	DCA CFH
	TAD FIJOB
	CLL RTL
	TAD CFH
	RAL
	TAD ENTTBL
	JMP I EBLD
	PAGE
/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 HE OWNS ANY CORE FIELDS
	CIF
	CORE		/SEARCH CORE TABLE FOR HIM
	 SI+FIP+CJOB
	JMP LGO5	/NO; NOTHING TO RELEASE
	AND P0007	/YES; RELEASE THE FIELD
	TAD CORTBA
	DCA CFH		/POINTS TO ENTRY IN CORTBL
	CDF
	DCA I CFH	/ZERO THE ENTRY
LGO5,	TAD FIJOB	/RETURN STATUS BLOCKS
	TAD JOBTBA	/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 'JOBTBL'
	TAD FIJOB
	TAD LGOCLK
	DCA LGO6
	DCA I LGO6	/CLEAR ANY 'CLKTBL' ENTRY
	CDF
	DCA I JOBA	/CLEAR JOB (SO SAVJOB WON'T SAVE US)
	DCA FIJOB	/ AND AVOID MISTAKING US FOR LOGGED-IN
	JMP I .+1	/AND NOW GO DO FIX50
LGO500,	FIX50
LGOBLS,	RETBLS
LGOCLK,	CLKTBL
LGOFIX,	FIX500
LGO6,	0
/
/ROUTINE TO HANDLE THE LOGOUT IOT WHEN THE PASSED AC = 0.
/WE COUNT UP THE NUMBER OF ADDITIONAL USERS ON THIS ACCOUNT.
LGO1,	TAD FIOSTK+1	/LOGOUT WITH AC = 0?
	SZA CLA
	JMP I LGI201	/NO, SO IT'S AN ERROR
	TAD LGOMAX	/YES - COUNT # OF OTHER USERS
	DCA LGOCNT	/ OF HIS ACCOUNT #
	TAD DEVOVR	/ADDRESS OF JOBTBL
	DCA JOBDAT	/INITIALIZE 'JOBDAT' TO LOOK AT ALL JOBS
	DCA FIUSAC	/ZERO 'FIND' COUNTER
LGOLP,	ISZ JOBDAT
	DATFLD
	TAD I JOBDAT
	CFLD
	SNA CLA		/IS THE JOB SLOT IN USE?
	JMP LGOLPE	/NO - ON TO THE NEXT
	FGETJT		/GET LOCATION OF USER'S ACCOUNT NUMBER
	 JOBACT
	DCA CFH
	DATFLD
	TAD I CFH	/PICK UP THE ACCOUNT NUMBER
	CFLD
	CIA
	TAD FIACCT
	SNA CLA		/SAME AS OURS?
	ISZ FIUSAC	/YES - INCREMENT COUNT
LGOLPE,	ISZ LGOCNT
	JMP LGOLP	/CONTINUE
	CLA CMA
	TAD FIUSAC	/NOW DISCOUNT OUR OWN JOB
	DCA FIUSAC
	TAD LGODAT	/THEN RESTORE JOBDAT
	DCA JOBDAT
	JMP I FIEXIT

LGOCNT,	0
LGODAT,	CJOBDA
LGOMAX,	-JOBMAX


/ROUTINE TO CLOSE ANY SPECIAL (ACCOUNT 7) FILES LEFT OPEN.
PRVCLS,	0
	TAD C7774
	DCA PCNUM	/SET FOR 4 FILES
PRVCL1,	TAD PCNUM
	TAD P0004
	JMS I LNK01	/GET THE FILE CONTROL-BLOCK
	SNA
	JMP PRVCL2
	TAD FILPRP
	DCA CFH		/NOW POINTS TO THE PROTECTION & PRIVILEGE WORD
	TAD I CFH
	CLL RAR
	SNL CLA		/IS THIS A PRIVILEGED FILE?
	JMP PRVCL2	/NO
	TAD PCNUM
	TAD P0004
	JMS I CL01	/YES - CLOSE IT
PRVCL2,	ISZ PCNUM
	JMP PRVCL1
	JMP I PRVCLS
/
PCNUM=	LGOCNT
/
/ROUTINE TO GET THE NUMBER OF A DEVICE ATTACHED TO THIS JOB
/CALLING SEQUENCE:
/	JMS LNS0
/	RETURN IF NONE AVAILABLE
/	NORMAL RETURN (LINE 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 SECOND 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 NO DEVICES

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

LNS6,	TAD C4000
	JMP LNS8

C4000,	4000
LNS10,	DEVTBE-DEVTBL
LNS3=	LGOCNT

	PAGE

/HERE WE CHECK FOR OTHER JOBS NEEDING 'FIP' TO TRY AND
/MINIMIZE THE NUMBER OF TIMES FIP NEEDS TO BE SWAPPED IN.

FIXSCH,	TAD FIXJMX
	SNA CLA		/HAVE WE ALREADY EXHAUSTED OUR PRIORITY RIGHTS?
	JMP FIXOUT	/YES
	TAD FIJOB
	TAD JOBTBA
	DCA INDEX
	DATFLD
FIXSC1,	TAD INDEX
	TAD FIXSTE
	SZA CLA		/REACHED END OF THE JOBTBL?
	JMP .+3
	TAD JOBTBA	/YES - RESET THE POINTER AT THE BEGINNING
	DCA INDEX
	TAD I INDEX
	SNA		/IS THERE A JOB IN THIS SLOT?
	JMP FIXSC2	/NO
	IAC
	DCA CFH		/YES - SET POINTER TO STR0 (JOBSTS)
	TAD I CFH
	AND FIXSJS
	SNA CLA		/IS THE JOB WAITING FOR 'FIP'?
	JMP FIXSC2	/NO
	TAD JOBTBA
	CIA
	TAD INDEX	/YES - GET HIS JOB NUMBER
	JMP FIXOUT	/ AND EXIT (SETTING 'FIPJOB')
FIXSC2,	ISZ FIXJMX
	JMP FIXSC1

/ALL DONE - SET (OR CLEAR) 'FIPJOB' IN FIELD 0 AND EXIT.
FIXOUT,	CIF CDF
	DCA I FIPJBA
	WAIT

FIPJBA,	FIPJOB
FIXJMX,	-JOBMAX		/GETS CLOBBERED, BUT RESET EVERY TIME FIP IS RELOADED
FIXSJS,	JSIOT
FIXSTE,	-JOBTBL-JOBMAX

/ROUTINE TO CHECK THE USERS 'PRIVILEGE' FLAG AND SKIP IF SET.

CHKPV0,	0
	FGETJT		/GET HIS STR0 LOCATION
	 JOBSTS
	DCA CFH
	DATFLD
	TAD I CFH
	AND CHKJSP
	SZA CLA		/IS HE PRIVILEGED NOW?
	ISZ CHKPV0	/YES - SKIP ON RETURN
	CFLD
	JMP I CHKPV0

/SUBROUTINE TO CHECK THE FILE EXTENSION AND POSSIBLY
/SET THE PRIVILEGE BIT FOR THIS JOB.

OPNPV0,	0
	TAD I OPNBUF	/GET THE FILE PROTECTION CODE
	AND C7700
	TAD OPNSVP
	SZA CLA		/IS EXTENSION .SVP (34)?
	JMP I OPNPV0	/NO - JUST RETURN
	CLA CLL CMA RAL
	TAD OPNACT
	SNA CLA		/IS THE FILE FROM THE SYSTEM LIBRARY?
	CHKSRC		/YES - WHO CALLED US?
	JMP I OPNPV0	/A USER - CAN'T SET 'PRIVILEGE'
	FGETJT		/'SI' - GET THE JOB STATUS-WORD
	 JOBSTS
	DCA CFH
	DATFLD
	TAD OPNJSP
	CMA
	AND I CFH	/CLEAR THE 'PRIVILEGE' BIT
	TAD OPNJSP	/ AND THEN SET IT
	DCA I CFH
	CFLD
	JMP I OPNPV0	/THEN JUST RETURN

OPNSVP,	-3400		/.SVP FILE EXTENSION
CHKJSP,
OPNJSP,	JSPRIV

/WE GET HERE WHEN THE 'UFD' HE TRIED TO OPEN DIDN'T
/EXIST. WE GIVE HIM THE NUMBER OF THE NEXT 'UFD'.

OPNR01,	DATFLD
	TAD I FIOPTR	/GET THE PARAMETER BLOCK
	DCA OPNBUF
	TAD C7000
	DCA I OPNBUF	/SET THE FINAL AC CONTENTS
	TAD OPNBUF
	TAD P0004
	DCA OPNBUF
	CFLD
	TAD I OPNNXT	/GET THE NEXT ACCOUNT
	DATFLD
	DCA I OPNBUF
	TAD P0004	/GET THE NUMBER OF PARAMETERS
	JMP I .+1	/ TO RETURN TO THE USER
	INF6

OPNNXT,	DSNEXT	/WORD IN 'DS0'

	IFZERO .-5200&4000 <GLITCH>
	*5200
SEGBUF,				/SEGMENT-SIZE BUFFER
	*WRDSEG+SEGBUF
ENTABL,				/4 2-WORD ENTRIES PER JOB
	*JOBMAX^10+ENTABL
UTABLE,				/A 2-WORD ENTRY FOR EACH UFD ACCESSED
	*JOBMAX^4+UTABLE
RTABLE,				/1 8-WORD ENTRY FOR EACH 'UTABLE' ENTRY
	*JOBMAX^20+RTABLE
FIPTOP,				/END OF FIP TABLES (EXCEPT 'SAT')
	IFZERO FIPTOP+SATSIZ&4000	<GLITCH>
	*-SATSIZ		/START OF DISC ALLOCATION TABLE
/////	$$$$$
	$$$$$