Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393T-SM - monitor-sources/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
; *** Edit 7364 to DIRECT.MAC by MCCOLLUM on 12-Sep-86, for SPR #20928
; Fix DELDEL and DELFIL to retry ARCMSG if free space is exhausted. 
; *** Edit 7360 to DIRECT.MAC by RASPUZZI on 3-Sep-86
; Remove edit 7335 because it does not work with structures that have large
; directories disabled 
; *** Edit 7335 to DIRECT.MAC by RASPUZZI on 15-Jul-86, for SPR #20399
; Don't allow a directory to grow so big as to allow a byte pointer to access
; an FDB to exceed 400000 as this may cause problems. 
; *** Edit 7219 to DIRECT.MAC by WAGNER on 2-Jan-86
; Edit 7218 does not apply to V4.1, breaks compilation, remove it. 
; *** Edit 7218 to DIRECT.MAC by WAGNER on 31-Dec-85, for SPR #20996
; Clear PPN entry from INDEX TABLE when killing directories to allow subsequent
; directories to use that same PPN. 
;Edit 3161 to DIRECT.MAC by LOMARTIRE on Fri 7-Sep-84
;		Revoke edits 3151, 3152, and 3154 due to bad side effects
;Edit 3154 to DIRECT.MAC by LOMARTIRE on Tue 28-Aug-84
;		Fix another bug in 3151 with deleted files at EXTSC1
;Edit 3152 to DIRECT.MAC by LOMARTIRE on Mon 27-Aug-84
;		Fix an AC smashing bug in edit 3151
;Edit 3151 to DIRECT.MAC by LOMARTIRE on Thu 23-Aug-84, for SPR #18475
;		Make the use of FC%DIR work correctly for DIR and GTJFN
;Edit 3140 to DIRECT.MAC by LOMARTIRE on Tue 24-Jul-84, for SPR #15114
;		Check access when setting deleted file non-existant in VERLKH
;Edit 3123 to DIRECT.MAC by MOSER on Wed 13-Jun-84
;		MAKE UNMIDX GLOBAL FOR EDIT 3120
;Edit 3114 to DIRECT.MAC by CJOHNSON on Thu 31-May-84, for SPR #17074
;		Make lookups discriminate between files and directories
;;		so directory lookups finding exact match filenames work
;Edit 3018 to DIRECT.MAC by TBOYLE on Thu 22-Sep-83, for SPR #18747
;		Make deletions remove dirs from special cache if necc.
;Edit 2988 to DIRECT.MAC by PRATT on Tue 12-Jul-83, for SPR #17020
;		Scan next FDB when doing version lookup and FB%NXF is set
;Edit 2986 to DIRECT.MAC by TSANG on Wed 6-Jul-83, for SPR #18697
;		Subroutine ADRCHK is used in MDDDC1 to validate FBEXL field.
;Edit 2981 to DIRECT.MAC by JCAMPBELL on Tue 5-Jul-83
;		Add FB%FOR for FORTRAN carriage control files
;Edit 2981 - Add FB%FOR to flags not to propogate
;Edit 2980 to DIRECT.MAC by LOMARTIRE on Thu 30-Jun-83 - Remove edit 2977
;Edit 2977 to DIRECT.MAC by LOMARTIRE on Mon 27-Jun-83, for SPR #19196
;		Require write access to create higher generation
; UPD ID= 286, FARK:<4-1-WORKING-SOURCES.MONITOR>DIRECT.MAC.5,  13-Jan-83 16:25:37 by MOSER
;EDIT 2896 - ADD CCBROT AND CGROFN
; UPD ID= 157, FARK:<4-1-WORKING-SOURCES.MONITOR>DIRECT.MAC.4,  10-Sep-82 13:47:24 by MOSER
;EDIT 2808 - DON'T TRASH FDBS BELONGING TO OPEN FILES
; UPD ID= 143, FARK:<4-1-WORKING-SOURCES.MONITOR>DIRECT.MAC.2,   3-Sep-82 15:59:14 by MOSER
;EDIT 2801 - DON;T PROPAGETE FB%TMP TO NEW FDBS.
;<4-1-FIELD-IMAGE.MONITOR>DIRECT.MAC.2, 25-Feb-82 20:17:16, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 920, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.10,  10-Dec-81 13:42:07 by DONAHUE
;Edit 1966 - Unmap current directory at CHKBAK:
; UPD ID= 859, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.9,  13-Oct-81 09:35:09 by DONAHUE
;Edit 1955 - Set flag to release directory at MAPELN:
; UPD ID= 757, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.7,  28-Aug-81 10:03:02 by GROUT
;Edit 1934 - Fix indirect words in SETDIR/SETDRR call from MDDDIR
; UPD ID= 737, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.6,  21-Aug-81 10:11:57 by ZIMA
;Edit 1927 - put edit 1909 in standard form.  No code changes.
; UPD ID= 659, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.4,  16-Jul-81 15:28:43 by GROUT
;Edit 1909 - Make MDDDIR not check privs if called from .RCUSR
; UPD ID= 492, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.3,   4-May-81 10:08:49 by SCHMITT
;Edit 1862 - Fix byte pointer construction at DIRUNQ
; UPD ID= 435, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.2,   7-Apr-81 17:35:44 by ZIMA
;Edit 1842 - fix GJ%FOU and exact generation case for invisible files.
; UPD ID= 152, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.2,  27-Aug-80 15:01:13 by ZIMA
;Edit 1768 - clear FB%BAT for new file generations in VRLK6A.
;<4.MONITOR>DIRECT.MAC.27,  3-Jan-80 08:08:30, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<OSMAN.MON>DIRECT.MAC.1, 10-Sep-79 15:25:27, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>DIRECT.MAC.25,  5-Sep-79 14:58:09, Edit by LCAMPBELL
; Remove useless JRST at ASGDF7
;<4.MONITOR>DIRECT.MAC.24, 28-Aug-79 15:55:46, Edit by KONEN
;ADD FB%FCF TO FLAGS THAT ARE ZEROED IN FDB OF NEW VERSIONS OF FILES
;<4.MONITOR>DIRECT.MAC.1, 13-Aug-79 17:08:43, EDIT BY WILSON
;TCO 4.2394 INCLUDE STRUCTURE NAME FOR DIRBLK BUGCHK
;<4.MONITOR>DIRECT.MAC.22, 19-Jul-79 15:54:02, Edit by KONEN
;CHECK IF THERE IS AN OFN BEFORE CALLING RELOFN
;<4.MONITOR>DIRECT.MAC.21, 17-Jul-79 09:00:37, Edit by KONEN
;CALL RELOFN, INSTEAD OF DWNSHR, TO DECREMENT COUNTS
;<4.MONITOR>DIRECT.MAC.20, 16-Jul-79 16:08:34, Edit by KONEN
;INCREMENT/DECREMENT INDEX TABLE AND DIRECTORY SHARE COUNTS
;<4.MONITOR>DIRECT.MAC.19,  7-Jul-79 18:45:51, Edit by KONEN
;ALLOW FOR FORK IDXORA WHEN CREATING STRUCTURE
;<4.MONITOR>DIRECT.MAC.18, 31-May-79 12:26:04, Edit by LCAMPBELL
; Use good error code at MDDDIR
;<4.MONITOR>DIRECT.MAC.17, 30-May-79 12:01:24, EDIT BY DBELL
;TCO 4.2262 - FAIL IN MDDDIR IF NOTHING BEING STEPPED AND GNJFF SET
;<4.MONITOR>DIRECT.MAC.16, 10-May-79 18:33:44, EDIT BY HALL
;IN SETDIR, REPLACE STKVAR IN OPTIONAL DATA WITH AN AC
;<4.MONITOR>DIRECT.MAC.15,  9-Mar-79 17:33:27, EDIT BY MILLER
;FIX MDDDID SO ALL DIRECTORIES ARE FOUND
;<4.MONITOR>DIRECT.MAC.14,  4-Mar-79 15:07:49, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>DIRECT.MAC.13, 12-Jan-79 20:53:29, EDIT BY DBELL
;TCO 4.2160 - FIX EXTSCN TO NOT CHECK OLDNF IF STEPPING FILES
;<4.MONITOR>DIRECT.MAC.12, 12-Jan-79 15:05:15, EDIT BY HURLEY.CALVIN
; CAUSE FDBINI TO USE DIRECTORY'S OFFLINE-EXPIRATION IF THERE, THEN
; TAPE-RECYCLE-PERIOD (IF SET) AND SYSTEM DEFAULT (.STDFE) AS LAST
; RESORT
;<4.MONITOR>DIRECT.MAC.11,  6-Jan-79 16:27:55, EDIT BY MILLER
;FIX GDIRST TO CHECK IDX%IV AFTER CALLING GETIDX
;<4.MONITOR>DIRECT.MAC.10,  7-Nov-78 12:15:39, EDIT BY HALL
;FIX BUGS IN CALVIN'S EDITS
;<4.MONITOR>DIRECT.MAC.9,  6-Nov-78 21:07:44, Edit by CALVIN
; FIX TREATMENT OF EXACT MATCH OF FIELD IN CASE OF RECOGNITION
;<4.MONITOR>DIRECT.MAC.7, 24-Oct-78 16:04:09, EDIT BY MURPHY
;ADD DIRX5 TO DR0CHK FOR DIRECTORY TOO LARGE
;<4.MONITOR>DIRECT.MAC.6, 23-Oct-78 19:27:58, EDIT BY MILLER
;<4.MONITOR>DIRECT.MAC.5, 23-Oct-78 15:01:15, EDIT BY MILLER
;<4.MONITOR>DIRECT.MAC.4, 23-Oct-78 14:58:06, EDIT BY MILLER
;MAKE SURE PROCESS WITH DIRECTORY LOCKED IS CSKED
;<ARC-DEC>DIRECT.MAC.3, 21-Aug-78 10:42:29, EDIT BY CALVIN
; Default online and offline expiration dates/intervals into new files,
; and new versions
;<CALVIN>DIRECT.MAC.1, 17-Aug-78 05:51:25, EDIT BY CALVIN
; Make FDBINI use length in FDB length of BLT to clear FDB
;[BBN-TENEXD]<3-EONEIL>DIRECT.MAC.1,  7-Jun-78 11:38:21, Ed: EONEIL
; Implemented invisible files, nonrecognition of del./invis. files
;<2MCLEAN>DIRECT.MAC.16, 10-Aug-78 17:39:00, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.15, 10-Aug-78 00:21:50, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.14, 10-Aug-78 00:01:39, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.13, 10-Aug-78 00:00:33, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.12, 16-Jul-78 14:39:35, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.11, 15-Jul-78 16:18:33, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.10, 15-Jul-78 16:15:53, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.9, 15-Jul-78 15:30:00, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.8, 14-Jul-78 00:38:56, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.7, 14-Jul-78 00:33:56, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.6, 13-Jul-78 17:50:44, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.5, 12-Jul-78 16:54:21, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.4, 12-Jul-78 16:39:28, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.3, 12-Jul-78 04:40:32, Edit by MCLEAN
;MORE CACHE FIXES
;<4.MONITOR>DIRECT.MAC.2, 11-Jul-78 15:25:57, Edit by MILLER
;<2MCLEAN>DIRECT.MAC.13,  9-Jul-78 01:56:29, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.12,  9-Jul-78 01:50:52, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.11,  7-Jul-78 14:59:41, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.10,  7-Jul-78 13:10:29, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.9,  7-Jul-78 01:03:56, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.8,  7-Jul-78 00:50:57, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.6,  6-Jul-78 02:44:09, Edit by MCLEAN
;MAPDIR CACHE
;<2MCLEAN>DIRECT.MAC.5,  6-Jul-78 02:30:29, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.1, 28-Jul-78 09:37:30, EDIT BY MILLER
;TCO 1961. ADD CALLS TO FDBCHK IN SUBDIRECTORY LOGIC





;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG
	TTITLE DIRECT
	SWAPCD

;SPECIAL AC DEFINITIONS

DEFAC (STS,P1)
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)

INTERN NSDIR0

;THIS IS A LIST OF FREQUENTLY USED DIRECTORIES WHICH HAVE THEIR
;DIRECTORY NUMBERS SETUP IN AN IN-CORE TABLE.  THIS SAVES
;THE PROBE OF THE INDEX AND SUBINDEX WHEN THESE DIRECTORIES ARE
;BEING LOOKED UP.

DEFINE SDIR (NAM)<
	XWD 0,[ASCIZ /NAM/]>

SDIRT0:: SDIR (SUBSYS)		;TABLE SEARCHED LINEARLY, SO ORDER
	SDIR (SYSTEM)		; IS IN DECREASING FREQUENCY OF USE
	SDIR (SPOOL)
	SDIR (ACCOUNTS)
NSDIR0==.-SDIRT0

RS SDIRTB,NSDIR0		;TABLE WITH DIRNUMS FILLED IN
RS NSDIRT,1			;NUMBER OF ENTRIES IN RUNTIME TABLE

	RESCD
	LIT
	SWAPCD
; Check protection of file/directory
; Call:	A		; LOCATION OF THE FDB (FOR ACCCHK)
;	LH(B)		; BITS TO INDICATE ACCESS DESIRED 
;THESE BITS ARE DEFINED IN MONSYM AND ARE OF THE FORM DC%XXX AND FC%XXX.
;	CALL DIRCHK	; To check access to a directory
; 	    Or
;	CALL ACCCHK	; To check access to a file
; Return
;	+1		; Error, access not allowed
;	+2		; Ok

;THIS ROUTINE CHECKS WHETHER THE USER CAN ACCESS A FILE (IF ACCCHK IS
;CALLED) OR DIRECTORY (DIRCHK) AS REQUESTED.  THE BITS IN AC 2 INDICATE
;THE ACCESS DESIRED.  THEY ARE CHECKED AGAINST THE APPROPRIATE FIELD
;IN THE FILE (OR DIRECTORY) PROTECTION, AS FOLLOWS:
;	OWNER IF USER IS ACCESSING LOGGED-IN DIRECTORY ON PS,
;		ACCESSED DIRECTORY ELSEWHERE, OR CONNECTED DIRECTORY
;	GROUP IF USER BELONGS TO A USER GROUP MATCHING THE
;		DIRECTORY'S GROUP NUMBER
;	WORLD OTHERWISE

;NOTE: NO ACCESS IS ALLOWED TO DIRECTORY FILES UNLESS THE USER IS
;	AN ENABLED WHEEL OR OPERATOR. IN THOSE CASES, ONLY READ AND LIST
;	ARE ALLOWED.

;THIS IS CALLED AFTER A CALL TO SETDIR FOR THE DIRECTORY TO BE CHECKED.
;THUS THE DIRECTORY AND STRUCTURE ARE LOCKED

DIRCHK::SE1CAL
	MOVE C,DIRORA		;GET THE PROTECTION OF THE MAPPED DIR
	LOAD C,DRPRT,(C)	;...
	JRST ACCCH1		;ENTER COMMON CODE

ACCCHK::SE1CAL
	JE FBDIR,(A),ACCCH0	;IS THIS A DIRECTORY FILE?
	MOVX D,SC%WHL!SC%OPR	;YES - CHECK SPECIAL CAPABILITIES
	MOVE C,B		;GET A COPY OF DESIRED ACCESS
	AND C,[FC%MSK]		;ONLY LOOK AT THE ACCESS BITS
	TXZ C,FC%DIR		;ALWAYS ALLOW DIR LISTING
	TDNE D,CAPENB		;WHEEL OR OPERATOR?
	TXZ C,FC%RD		;YES, ALLOW READ
	JUMPE C,ACCCH0		;IF NOT ASKING FOR OTHER ACCESS, OK
	RETBAD(OPNX13)		;INVALID ACCESS

ACCCH0:	LOAD C,FBPRT,(A)	;Get protection of this file
ACCCH1:	SAVEQ			;GET SOME WORKING ACS
	STKVAR<ACCCHB,ACCBTS>
	MOVE D,CAPENB		;CHECK ENABLED CAPABILITIES
	TRNE D,SC%WHL!SC%OPR
	RETSKP			;WHEEL OR OPERATOR HAVE ALL PRIVILEGES
	MOVEM B,ACCCHB		;SAVE ACCESS REQUEST
	MOVE Q1,DIRORA		;GET BASE OF DIRECTORY
	LOAD Q2,DRNUM,(Q1)	;GET DIR NUMBER OF MAPPED DIR

;INITIALLY ASSUME OWNER+GROUP+WORLD ACCESS RIGHTS

	MOVE D,C		;MAKE OWNER SUPERSET OF GROUP AND WORLD
	LSH D,6			;AND GROUP SUPERSET OF WORLD
	IORM D,C		;OR GROUP INTO OWNER AND WORLD INTO GROUP
	LSH D,6			;AND OR WORLD FIELD INTO OWNER FIELD
	IORM D,C
	MOVEM C,ACCBTS		;PRESERVE C OVER SUBROUTINES

;IF TRYING TO ACCESS LOGGED IN DIRECTORY ON PUBLIC STRUCTURE, HAVE OWNERSHIP RIGHTS

	MOVE D,JOBNO		;GET THIS JOB'S NUMBER
	HRRZ D,JOBDIR(D)	;GET LOGGED IN DIR OF THIS USER
	CAMN D,Q2		;REFERENCE TO LOGGED IN DIR?
	JRST [	JE CURSTR,,ACCCH9 ;IF ON PUBLIC STRUCTURE, THIS IS THE 
				; LOGGED IN DIRECTORY
		JRST .+1]	;NOT THE PUBLIC STRUCTURE.

;IF TRYING TO ACCESS 'ACCESSED' DIRECTORY, HAVE OWNER RIGHTS

	LOAD A,CURUC		;A/STRUCTURE UNIQUE CODE FOR MAPPED DIRECTORY
	SETZ Q3,		;INITIALIZE OFFSET
	CALL FNDSTO		;GET OFFSET IN JSB FOR THIS STRUCTURE
	 JRST ACCCH3		;NO. GO SEE IF CONNECTED TO THIS DIRECTORY
	MOVE C,ACCBTS		;GET THE ACCESS BIT AGAIN
	HRRZM B,Q3		;SAVE OFFSET IN JSB
	LOAD B,JSADN,(Q3)	;GET ACCESSED DIRECTORY NUMBER ON THIS STRUCTURE
	CAMN B,Q2		;IS IT THE DIRECTORY BEING ACCESSED?
	JRST ACCCH9		;YES. HAVE OWNER RIGHTS

;IF TRYING TO ACCESS CONNECTED DIRECTORY, HAVE OWNERSHIP ACCESS

ACCCH3:	CALL GTCSCD		;GET CONNECTED STR CODE,,DIRECTORY FOR THIS JOB
	MOVE C,ACCBTS		;RESTORE ACCESS BITS
	HLRZ D,A		;GET CONNECTED STRUCTURE UNIQUE CODE
	HRRZS A			;GET CONNECTED DIRECTORY
	CAMN A,Q2		;REFERENCE TO CONNECTED DIRECTORY?
	JRST [	LOAD A,CURUC	;YES. GET STRUCTURE FOR MAPPED DIRECTORY
		CAMN D,A	;IS IT THE CONNECTED STRUCTURE?
		JRST ACCCH9	;YES. GIVE OWNER ACCESS
		JRST .+1]	;NO. TRY FOR GROUP

;DON'T HAVE OWNERSHIP. SEE IF GROUP OR WORLD

	LOAD A,CURUC		;A/STRUCTURE CODE FOR MAPPED DIRECTORY
	JUMPE Q3,ACCCH4		;IF NO GROUPS, SKIP CALL TO CHKGRP
	HRRZS Q3
	OPSTR <SKIPE>,JSGRP,(Q3) ;IF NO GROUPS, DON'T CALL CHKGRP
	CALL CHKGRP		;SEE IF DIR AND USER ARE IN SAME GROUP
ACCCH4:	 LSH C,6		;NO, HAVE WORLD ACCESS
	LSH C,6			;YES. HAVE GROUP ACCESS

;BITS 18-23 OF C CONTAIN THE MAXIMUM ACCESS TO BE APPLIED TO THIS
;DIRECTORY.  B CONTAINS THE ACCESS DESIRED.  SEE IF THEY AGREE

ACCCH9:	ANDCAI C,770000		;Mask off 6 bits and complement
	LSH C,^D18-1		;SHIFT TO LINE UP BITS BETWEEN B AND C
	HLLZ B,ACCCHB		;GET BACK ACCESS REQUESTED
	AND B,C			;Get bad bits
	JFFO B,ACCCH2		;If any ones, access not permitted
	RETSKP
;ACCESS NOT ALLOWED

ACCCH2:	SOS C			;Get bit number
	ROT C,-1		;Divide by 2
	HRRZ A,ACCERT(C)	;Get error number
	SKIPL C
	HLRZ A,ACCERT(C)
	RET

ACCERT:	XWD OPNX3,OPNX4
	XWD OPNX5,OPNX6
	XWD OPNX12,OPNX13


;ROUTINE TO CHECK USER GROUPS FOR A MATCH WITH DIR GROUPS
;ASSUMES DIR IS MAPPED
;ACCEPTS:
;	T1/STRUCTURE UNIQUE CODE
;	CALL CHKGRP
;RETURNS +1:	NO MATCH
;	 +2:	GROUPS MATCH
;DESTROYS NO ACS

CHKGRP:	SAVET
	SAVEQ
	CALL FNDSTO		;GET ADDRESS OF BLOCK IN JSB FOR THIS STRUCTURE
	 RETBAD
	OPSTR <SKIPN Q1,>,JSGRP,(B) ;ARE THERE ANY USER GROUPS?
	RETBAD			;NO
CHKGR1:	HLRZ A,0(Q1)		;GET FIRST GROUP NUMBER IN LIST
	CALL CHKDGP		;CHECK IT AGAINST DIR GROUP LIST
	 SKIPA			;NO MATCH
	RETSKP			;MATCHED!
	HRRZ A,0(Q1)		;GET NEXT GROUP NUMBER
	CALL CHKDGP		;CHECK IT
	 SKIPA			;NO MATCH
	RETSKP
	AOBJN Q1,CHKGR1		;LOOP BACK UNTIL LIST EXHAUSTED
	RETBAD			;NO MATCH WAS FOUND
;ROUTINE TO CHECK A GROUP NUMBER AGAINST LIST IN DIR
;ACCEPTS IN A/	GROUP NUMBER
;	CALL CHKDGP	OR	CALL CHKUGP
;RETURNS +1:	NO MATCH
;	 +2:	MATCH

CHKDGP::SE1CAL
	JUMPE A,R		;0 IS NOT MACTHED
	MOVE D,DIRORA		;GET BASE OF DIR
	LOAD D,DRDGP,(D)	;GET POINTER TO DIR GROUP LIST
	JRST CHKUG0		;ENTER COMMON CODE

CHKUGP::SE1CAL
	JUMPE A,R		;0 IS NOT MATCHED
	MOVE D,DIRORA		;GET BASE OF DIR
	LOAD D,DRUGP,(D)	;GET POINTER TO USER GROUP LIST
CHKUG0:	JUMPE D,R		;0 MEANS NOT A MEMBER OF A GROUP
	ADD D,DIRORA		;GET ABS ADR OF LIST
	LOAD C,BLKTYP,(D)	;GET TYPE OF BLOCK
	CAIE C,.TYGDB		;IS THIS A DIR GROUP BLOCK?
	RET			;NO, DIR SCREWED UP
	LOAD C,BLKLEN,(D)	;GET NUMBER OF WORDS IN LIST
	SOS C			;SKIP OVER HEADER
CHKDG1:	HLRZ B,1(D)		;GET FIRST ELEMENT IN LIST
	CAMN A,B		;DO THEY MATCH?
	RETSKP			;YES
	HRRZ B,1(D)		;GET NEXT ELEMENT IN LIST
	CAMN A,B		;MATCH?
	RETSKP			;YES
	AOS D			;STEP TO NEXT WORD IN LIST
	SOJG C,CHKDG1		;LOOP THROUGH LIST
	RET			;NO MATCH FOUND
;SUPCHK - CHECK ACCESS TO SUPERIOR

;ACCEPTS:
;	T1/ (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
;	T2/ BITS INDICATING ACCESS REQUIRED

;CALL SUPCHK

;RETURNS +1: ACCESS NOT ALLOWED OR OTHER FAILURE
;		T1/ ERROR CODE
;	 +2: ACCESS ALLOWED

;THIS ROUTINE CHECKS TO SEE IF THE CALLER CAN ACCESS THE
;SUPERIOR OF THE GIVEN DIRECTORY IN THE REQUESTED MANNER.  IT IS
;ANALOGOUS TO DIRCHK, AND IN FACT CALLS DIRCHK ON THE DIRECTORY'S
;SUPERIOR

SUPCHK::
	STKVAR <SUPCDN,SUPCBT,SUPCSN,SUPCSP>
	MOVEM T1,SUPCDN		;SAVE DIRECTORY NUMBER
	MOVEM T2,SUPCBT		;SAVE BITS
	HLRZS T1		;T1/ STRUCTURE UNIQUE CODE
	CALL CNVSTR		;CONVERT TO STRUCTURE NUMBER
	 RETBAD			;FAILURE
	MOVEM T1,SUPCSN		;SAVE STRUCTURE NUMBER
	CALL MAPIDX		;MAP INDEX TABLE FOR THIS STRUCTURE
	 JRST SUPCH2		;FAILED. GO UNLOCK STRUCTURE AND RETURN
	HRRZ T1,SUPCDN		;T1/ DIRECTORY NUMBER
	CALL GETIDX		;GET DATA ON THIS DIRECTORY
	 JRST SUPCH2
	HLL T3,SUPCDN		;FORM 36-BIT NUMBER OF SUPERIOR
	MOVEM T3,SUPCSP		;SAVE SUPERIOR NUMBER
	MOVE T1,SUPCSN		;GET STRUCTURE NUMBER
	CALL ULKSTR		;UNLOCK THE STRUCTURE
	MOVE T1,SUPCSP		;T1/ DIRECTORY OF SUPERIOR
	CALL SETDIR		;MAP IN THE SUPERIOR
	 RETBAD
	MOVE T2,SUPCBT		;T2/ DESIRED PRIVILEGE
	CALL DIRCHK		;SEE IF WE CAN DO IT
	 JRST SUPCH1		;NO.
	CALL USTDIR		;UNLOCK THE SUPERIOR
	RETSKP			;RETURN SUCCESS

;HERE ON FAILURE WHEN DIRECTORY IS MAPPED. UNMAP IT AND FAIL

SUPCH1:	CALL USTDIR		;UNLOCK THE SUPERIOR
	RETBAD			;RETURN FAILURE

;HERE ON FAILURE WHEN STRUCTURE IS LOCKED. UNLOCK AND FAIL

SUPCH2:	EXCH T1,SUPCSN		;SAVE ERROR CODE, GET STRUCTURE NUMBER
	CALL ULKSTR		;UNLOCK STRUCTURE AND GO OKINT
	MOVE T1,SUPCSN		;T1/ ERROR CODE
	RETBAD ()		;RETURN FAILURE
; Directory lookup
; Call:	A			; -<NWORDS-1>,,FIRSTWORD OF STRING-1
;	B			; STRUCTURE UNIQUE CODE
;	C			; LOCATION OF LAST BYTE IF RECOGNITION
;	CALL DIRLUK		; For recognition
; Or
;	CALL DIRLKX		; For no recognition
; Returns
; +1	A/  0	NO MATCH
;	   -1	AMBIGUOUS
; +2	OK, WITH:	A/ DIRECTORY NUMBER
;			B/ UPDATED POINTER
; Clobbers a,b,c,d, and bits mtchf, ambgf, norec1

DIRLUK::TQZA <NREC1>		;ALLOW RECOGNITION
DIRLKX::TQO <NREC1>		;DONT ALLOW RECOGNITION
	SE1CAL
	STKVAR <DIRLKS,DIRLKP,DIRLKI,DIRLKC,DIRLKT,<DIRLKB,MAXLW>> ;ALLOCATE LOCAL STORAGE
	JUMPE B,RETZ		;IF NO UNIQUE CODE, RETURN FAILURE
	AOS A			;BUILD BYTE POINTER TO INPUT
	HRLI A,(<POINT 7,.-.>)	; ...
	MOVEM A,DIRLKI		;SAVE INPUT POINTER
	MOVEM B,DIRLKS		;SAVE STRUCTURE NUMBER
	MOVEM C,DIRLKP		;SAVE LOCATION OF LAST BYTE
	SETZM DIRLKT		;ZERO TOTAL LENGTH OF INPUT STRING
	TQZ <UNLKF>		;UNLOCK THE DIRECTORY ON EXIT
	TQNN <NREC,NREC1>	;RECOGNITION WANTED?
	JRST DRLK0B		;YES
	MOVE A,DIRLKS		;GET STRUCTURE UNIQUE CODE
	CALL CNVSTR		;CONVERT UNIQUE CODE TO STRUCTURE NUMBER
	 JRST RETZ		;NOT MOUNTED.
	MOVEM A,DIRLKC		;SAVE STRUCTURE NUMBER
	MOVE C,STRTAB(A)	 ;GET ADDRESS OF STRUCTURE DATA BLOCK
	JN STCRD,(C),[	CALL ULKSTR    ;UNLOCK AND OKINT
			MOVEI A,ROOTDN ;IF CREATING ROOT-DIR, USE THAT #
			MOVE B,DIRLKP	;RETURN POINTER
			RETSKP]	     ;RETURN
	LOAD A,CURUC		;CHECK IF FOR DIR FROM CURRENT STR
	CAME A,DIRLKS		;SAME?
	JRST DRLK0A		;NO - UNLOCK STR AND CONTINUE
	MOVE A,DIRORA		;CHECK WHAT MAY BE A DIR MAPPED
	CALL MRMAP		;GET IDENT
	 JRST DRLK0A		;NOT A FILE PAGE
	CALL MRPACS		;DOES THE PAGE EXIST?
	TLNN A,(PA%PEX)		; ???
	JRST DRLK0A		;NO - MUST DO FULL LOOKUP
	MOVE A,DIRORA		;GET DIR BASE ADDR
	LOAD A,DRNAM,(A)	;GET DIR NAME STRING
	JUMPE A,DRLK0A		;PROTECT AGAINST BAD DIR
	HRLI A,(<POINT 7,.-.(Q1),35>) ;BUILD BYTE POINTER
	MOVE B,DIRLKI		;GET INPUT STRING
	PUSH P,Q1		;SAVE INDEX AC
	MOVE Q1,DIRORA		;GET DIR BASE
	CALL STRCMP		;COMPARE THE STRINGS
	 JRST [	POP P,Q1	;RESTORE INDEX AC
		JRST DRLK0A]	;NOT EQUAL
	POP P,Q1		;RESTORE INDEX AC
	MOVE A,DIRORA		;GET DIRECTORY ORIGIN
	LOAD B,DRNUM,(A)	;GET DIR NUMBER
	MOVE A,DIRLKC		;GET STR NUMBER
	CALL ULKSTR		;UNLOCK STR
	MOVE A,B		;COPY DIR NUMBER
	MOVE B,DIRLKP		;RETURN POINTER
	RETSKP			;RETURN SUCCESS

DRLK0A:	MOVE A,DIRLKC		;GET STR NUMBER
	CALL ULKSTR		;UNLOCK STR AND OKINT
	MOVE A,DIRLKC		;GET STR NUM AGAIN
	CAIE A,PSNUM		;IS THIS THE PUBLIC STRUCTURE?
	JRST DRLK0B		;NO - DO LOOKUP
	MOVE A,DIRLKI		;GET INPUT POINTER
	CALL DIRSLK		;GO TRY TO FIND IT IN SPECIAL TABLE
	 JRST DRLK0B		;WAS NOT IN TABLE
	MOVE B,DIRLKP		;FOUND - RETURN POINTER AND
	RETSKP			;DIR

DRLK0B:	TQZ <MTCHF,AMBGF>
	MOVEI A,ROOTDN		;GET DIR # OF ROOT DIRECTORY
DIRLK1:	HRL A,DIRLKS		;GET STRUCTURE NUMBER
	CALL SETDIR		;Map IN ROOT DIRECTORY
	 JRST RFALSE		;INDICATE NO MATCH
	MOVEI A,DIRLKB		;CLEAR TEMP STRING BLOCK
	HRL A,A			; BUILD BLT POINTER
	AOS A			; ...
	SETZM DIRLKB		; CLEAR FIRST WORD
	BLT A,<MAXLW-1>+DIRLKB	; UNTIL END OF BLOCK
	SETZM DIRLKC		;CLEAR COUNT OF CHARS IN TEMP STRING
	MOVSI A,(<POINT 7,.-.>)	;BUILD BYTE POINTER TO TEMP STRING BLOCK
	HRRI A,DIRLKB		; ...
DIRLK2:	ILDB B,DIRLKI		;GET NEXT INPUT CHARACTER
	JUMPE B,DIRLK4		;END OF INPUT
	CAIN B,"."		;SEPARATOR CHARACTER?
	JRST DIRLK3		;YES - LOOKUP THIS LEVEL
	IDPB B,A		;NO - STORE IN TEMP STRING
	AOS DIRLKC		;COUNT THIS CHAR
	JRST DIRLK2		;LOOP FOR THIS LEVEL
;HERE TO LOOKUP AN INTERMEDIATE LEVEL DIR FROM INPUT STRING. NO
;RECOGNITION IS DONE, SEARCH FAILURE MEANS DIRLUK FAILURE.

DIRLK3:	MOVEI A,1		;GET COUNT FOR THIS SEGMENT OF INPUT STRING
	ADD A,DIRLKC		; ...
	ADDM A,DIRLKT		;UPDATE TOTAL LENGTH
	MOVEI A,DIRLKB		;GET POINTER TO TEMP STRING BLOCK
	MOVE B,DIRLKC		;GET CHAR COUNT
	CALL DSLUK		;FIND DIR FDB
	 JRST DIRLER		;FAILED - RETURN NO MATCH
	CALL USTDIR		;FOUND THIS LEVEL, DIR NUM IN A
	JRST DIRLK1		;UNLOCK AND SEARCH AT NEXT LEVEL

;HERE TO LOOKUP LOWEST LEVEL IN INPUT STRING. RECOGNITION WILL BE
;DONE IF REQUESTED

DIRLK4:	MOVE A,DIRLKC		;GET LENGTH OF THIS INPUT SEGMENT
	ADDM A,DIRLKT		;PRODUCE GRAND TOTAL INPUT LENGTH
	MOVEI A,DIRLKB		;SETUP TO FIND DIR FDB FOR THIS STRING
	MOVE B,DIRLKC		;COUNT OF CHARS IN STRING
	CALL DSLUK		;FIND DIRECTORY FDB
	 JRST DIRFND		;FAILED - SEE IF AMBIGUOUS
	CALL USTDIR		;SUCCESS - UNLOCK DIR
	MOVE B,DIRLKP		;RETURN DIRNUM IN A, END POINTER IN B
	RETSKP

;LOCAL ROUTINE TO LOOKUP A STRING AND RETURN A FDB THAT IS
;A DIRECTORY
;A/ WORD ADDRESS OF START OF STRING
;B/ NUMBER OF CHARACTERS IN STRING
;	CALL DSLUK	;DIRECTORY STRING LOOKUP
;RETURNS+1:
;	FAILURE - LOOKUP FAILED, NO DIR FDB OR FDBCHK FAILED
;RETURNS+2:
;	SUCCESS - DIR NUM IN A, FDB ADDRESS(ABSOLUTE) IN B

DSLUK:	IDIVI B,5		;GET NUMBER OF WORDS IN STRING
	MOVEI C,.ETNAM		;DIRS ARE ENTRY TYPE NAME
;**;[3114] Change 1 line at DSLUK:+2L	1-Mar-84	CRJ
	CALL LOOKP1		;SEARCH SYMTAB
	 RET			;FAILED
	CALLRET DRLKFD		;FIND DIR FDB IF PRESENT

;LOCAL ROUTINE TO SCAN EXTENSION AND GENERATION CHAINS LOOKING FOR
;A DIR FDB.
;ASSUMES DRLOC SETUP
;	CALL DRLKFD
;RETURNS+1:
;	FAILURE - NO GOOD FDB FOUND
;RETURNS+2:
;	SUCCESS - DIR NUM IN A, ABSOLUTE FDB ADDRESS IN B

DRLKFD:	MOVE C,DRLOC		;GET SYMTAB POINTER
	LOAD C,SYMAD,(C)	;GET START OF FDB CHAINS
	ADD C,DIRORA		;AS AN ABSOLUTE ADDRESS
DRLKF1:	MOVE A,C		;COPY POINTER FOR GENERATION SEARCH
DRLKF2:	CALL FDBCHK		;BLESS THIS FDB
	 RET			;FAILED
	JE FBDIR,(A),DRLKF3	;IS THIS A DIRECTORY?
	LOAD B,FBDRN,(A)	;YES - GET ITS NUMBER
	JUMPE B,DRLKF3		;IF ZERO, IGNORE IT
	EXCH A,B		;PUT DIRNUM AND FDB IN PROMISE PLACES
	RETSKP			;SUCCESS

DRLKF3:	LOAD A,FBGNL,(A)	;GET FDB OF NEXT GENERATION
	ADD A,DIRORA		;AS AN ABSOLUTE ADDRESS
	CAME A,DIRORA		;WAS IT ZERO?
	JRST DRLKF2		;NO - EXAMINE THIS FDB
	LOAD C,FBEXL,(C)	;YES - GET NEXT EXTENSION
	ADD C,DIRORA		;AS ABSOLUTE ADDRESS
	CAME C,DIRORA		;WAS THERE ONE?
	JRST DRLKF1		;YES - EXAMINE THIS EXTENSIONS GENERATIONS
	RET			;NO - FAILURE

;HERE WHEN A LOOKUP FAILS, PERFORM RECOGNITION IF NEEDED.

DIRFND:	TQNE <MTCHF>
	TQNE <NREC,NREC1>	;Since we do not have an exact match
	JRST DIRLER		;TAKE ERROR RETURN WHEN NO RECGNITION
	TQNE <AMBGF>
	JRST DIRAMB		;Ambiguous
	MOVE B,DRLOC		;GET POINTER TO SYMBOL
	ADDI B,.SYMLN		;Ok so far, make sure not ambiguous
	MOVE A,DIRORA		;GET BASE ADDRESS OF MAPPED DIR
	LOAD A,DRSTP,(A)	;GET POINTER TO TOP OF SYMBOL TABLE
	ADD A,DIRORA		;MAKE ADDRESS ABSOLUTE
	CAML B,A		;examinE the next entry IN TABLE
	JRST DIRUNQ		;ABOVE END OF SYMBOL TABLE
	LOAD A,SYMVL,(B)	;GET SYMBOL TABLE VALUE
	CAMN A,[-1]		;SEE IF SYMBOL TABLE SCREWED UP
	JRST DIRLER		;YES - GIVE ERROR RETURN
	LOAD A,SYMET,(B)	;GET THE SYMBOL TYPE
	CAIE A,.ETNAM		;STILL IN THE NAME REGION?
	JRST DIRUNQ		;NO
	CALL NAMCMM		;SEE IF NEXT SYMBOL IS STILL SUBSET
	 JUMPN A,DIRUNQ		;NOT EQUAL AND NOT SUBSET
	JRST DIRAMB		;SUBSET is ambiguous

DIRUNQ:	CALL DRLKFD		;FIND DIR FDB FROM SYMTAM POINTER
	 JRST DIRLER		;FDB IS BAD, GIVE UP
	MOVEI C,MAXLC		;COMPUTE MAX RESIDUAL TO RECOGNISE
	SUBM C,DIRLKT		; ...
;**;[1862] Replace 4 lines with 4 lines at DIRUNQ: +4L	RAS	4-MAY-81
	LOAD D,FBNAM,(B)	;[1862] GET ADDRESS OF NAME STRING
	ADD D,DIRORA		;[1862] GET ABSOLUTE ADDRESS INTO DIR
	ADDI T4,1		;[1862] SKIP STRING BLOCK HEADER
	HRLZI C,(<POINT 7,(D)>)	;[1862] BUILD BYTE POINTER TO STRING
	MOVE A,DIRLKC		;GET COUNT OF INPUT CHARS AT THIS LEVEL
	ADJBP A,C		;ADJUST POINTER TO FIRST NEW CHAR
DIRUN1:	ILDB C,A		;GET NEXT INPUT CHARACTER
	JUMPE C,DIRUN2		;END OF STRING?
	SOSGE DIRLKT		;DECREMENT/CHECK RESIDUAL
	JRST DIRAMB		;RETURN AMBIGUOUS
	IDPB C,DIRLKP		;NO - COPY TO OUTPUT
	JRST DIRUN1		;LOOP

DIRUN2:	MOVE A,DIRLKP		;STORE NULL WITHOUT CHANGEING OUTPUT PTR
	IDPB C,A		; ...
	MOVX A,FB%SDR		;DOES THIS DIR HAVE ANY SUBDIRS
	TDNE A,.FBCTL(B)	; ???
	JRST DIRAMB		;YES - RETURN AMBIGUOUS
	LOAD A,FBDRN,(B)	;NO - GET DIR NUMBER FROM FDB
	MOVE B,DIRLKP		;RETURN UPDATED OUTPUT POINTER
	CALL USTDIR		;UNLOCK DIR
	RETSKP			;SUCCESS

DIRAMB:	CALL USTDIR		;UNLOCK THE DIRECTORY
	SETOM A			;INDICATE AMBIGUOUS
	MOVE B,DIRLKP		;RETURN ANY POSSIBLE OUTPUT
	RET			;RETURN

DIRLER:	CALL USTDIR		;UNLOCK THE DIRECTORY
	SETZM A			;INDICATE NO MATCH
	RET			;RETURN
;LOOKUP ROUTINE FOR SPECIAL DIRECTORIES.   THESE DIRECTORIES ARE
;ASSUMED TO BE USED FREQUENTLY AND SO ARE KEPT IN A RESIDENT
;TABLE ALONG WITH THEIR DIRECTORY NUMBERS.
; A/ BYTE POINTER TO INPUT STRING
;	CALL DIRSLK
; RETURNS +1: NOT FOUND, A PRESERVED

; RETURNS +2: FOUND, DIRNUM IN A

DIRSLK:	PUSH P,Q1
	PUSH P,A
	HRLZ Q1,NSDIRT		;GET NEG NUMBER OF SPECIAL DIRS
	JUMPE Q1,DIRSL0		;IT COULD BE 0
DIRSL1:	HRRZ A,SDIRTB(Q1)	;GET PTR TO THIS DIR
	HRLI A,(POINT 7,0)	;CONSTRUCT ILDB PTR
	MOVE B,0(P)		;GET PTR TO REQUESTED DIR
	CALL STRCMP		;COMPARE STRINGS
	 JRST [	AOBJN Q1,DIRSL1	;NOT EQUAL, KEEP LOOKING
		JRST DIRSL0]	;SEARCH DONE, DIR NOT FOUND
	HLRZ A,SDIRTB(Q1)	;DIR FOUND, GET ITS DIRNUM
	POP P,(P)		;FLUSH INPUT POINTER
	POP P,Q1
	RETSKP

DIRSL0:	POP P,A			;RESTORE ORIG PTR FOR CONTINUING LOOKUP
	POP P,Q1
	RET

;**;[3018]Add 20 lines at DIRSL0: + 4L	21-SEP-83	TAB
;[3018] Removal routine for special directories.  If the structure is PS: and
;[3018] the directory number is present in the special table, it is removed.
;[3018] Call:	T3	; The directory number to remove
;[3018]		T4	; The structure number
;[3018]		CALL DIRSLK
;[3018] Return:
;[3018]		+1	; Always
;[3018] Clobbers T1,T2

REMSDR::MOVEI T1,PSNUM		;[3018]
	CAME T1,T4		;[3018]IS THE DIRECTORY ON PS:?
	RET			;[3018]NO, RETURN
	HRLZ T1,NSDIRT		;[3018]YES, NOW GET NEG NUMBER OF DIRS
	JUMPE T1,R		;[3018]RETURN IF ZERO
REMSDL:	HLRZ T2,SDIRTB(T1)	;[3018]DIR NUMBER FROM TABLE ENTRY
	CAMN T2,T3		;[3018]IS IT THE DIR WE ARE LOOKING FOR?
	SETZM SDIRTB(T1)	;[3018]YES, ZERO THE TABLE ENTRY
	AOBJN T1,REMSDL		;[3018]SEARCH THE WHOLE TABLE
	RET			;[3018]DONE
; Directory number to string conversion
; Call:	A	; The directory number
;	CALL GDIRST
; Return
;	+1	; Error, no such directory number (error code in A)
;	+2	; Ok, in a, pointer to string block holding the name
; The directory AND STR ARE locked upon exit, and must be unlocked
; After the string is used
; Clobbers a,b,c,d

GDIRST::SE1CAL
	STKVAR <GDRSTN,GDRSTR,GDRSDR>
	HRRZM A,GDRSTN		;SAVE DIRECTORY NUMBER
	CALL CNVDIR		;GET A DIR NUMBER FROM THE USER NUMBER
	MOVEM A,GDRSDR		;SAVE WHOLE DIRECTORY NUMBER
	HLRZS A			;GET JUST THE UNIQUE CODE
	CALL CNVSTR		;GET A STR NUMBER
	 RETBAD ()		;NONE
	MOVEM A,GDRSTR		;SAVE THE STR INDEX
	JE IDXFLG,,GDRST2	;NO IDXTAB
	LOAD A,CURUC		;GET UNIQUE CODE FOR STR THAT IS MAPPED
	HLRZ B,GDRSDR		;GET UNIQUE CODE FROM DIRECTORY NUMBER
	CAME A,B		;IS THIS OURS?
	JRST GDRST2		;NO
	MOVE A,DIRORA
	CALL MRMAP		;GET HANDLE ON PAGE 0 OF DIR
	 JRST GDRST3		;NO DIR MAPPED
	CALL MRPACS		;GET PAGE ACCESS
	TLNN A,(PA%PEX)		;DOES PAGE EXIST?
	JRST GDRST3		;NO, GO MAP IN ROOT- DIR
	MOVE B,DIRORA		;SET UP BASE OF DIR AREA
	LOAD C,DRTYP,(B)	;CHECK FOR A LEGAL DIR TYPE
	CAIE C,.TYDIR
	JRST GDRST3		;NOT A LEGAL DIR MAPPED
	LOAD A,DRNUM,(B)	;GET DIR NUMBER OF MAPPED DIR
	CAME A,GDRSTN		;IS THIS THE DIR WE WANT
	JRST GDRST3		;NO, - CONSIDER WHAT TO MAP
	CALL DR0CHK		;MAKE SURE THIS IS A GOOD DIR
	 JRST GDRST6		;IT ISNT
	MOVE A,GDRSTN		;GET DIR NUMBER
	LOAD B,CURSTR		;GET CURRENT STR #
	CALL LCKDNM		;LOCK IT
GDRST1:	MOVE A,DIRORA		;GET BASE ADDRESS OF DIR
	LOAD A,DRNAM,(A)	;GET ADDRESS OF NAME STRING
	ADD A,DIRORA		;MAKE IT A VIRTUAL ADDRESS
	LOAD B,NMTYP,(A)	;GET TYPE OF BLOCK
	CAIE B,.TYNAM		;IS IT A NAME BLOCK?
	RETBAD (DIRX3,<CALL USTDIR>) ;NO RETURN FAILURE
	RETSKP			;RETURN WITH ADR OF NAME STRING IN A

GDRST2:	MOVE A,GDRSTR		;GET STR NUMBER TO MAP IDXTAB
	CALL MAPIDX		;MAP INDEX
	 JRST GDRST7		;FAILED - UNLOCK STR AND ERROR
GDRST3:	MOVE A,GDRSTN		;GET DIR NUMBER
	CALL GETIDX		;GET INDEX INFORMATION IN A - C
	 JRST GDRST7		;FAILED
	TXNE D,IDX%IV		;IS THIS ENTRY VALID?
	RETBAD (DIRX3,<MOVE A,GDRSTR
			CALL ULKSTR>) ;NO. UNLOCK STURUCTURE AND GIVE ERROR
	CAIE C,ROOTDN		;IS ROOT DIR SUPERIOR?
	JRST GDRST5		;NO - MUST MAP DIR ITSELF
GDRST4:	MOVE A,GDRSTR		;GET STR NUMBER TO UNLOCK
	CALL ULKSTR		;MUST MAP IN NEW DIRECTORY NOW
	MOVEI A,ROOTDN		;GET ROOT-DIR NUMBER
	HLL A,GDRSDR		;GET STR NUMBER TO BE MAPPED
	CALL SETDIR		;MAP IN THE APPROPRIATE DIR
	 RETBAD ()		;None
	MOVE A,GDRSTN		;GET DIR NUMBER AGAIN
	CALL GETIDX		;GET FDB ADDRESS OF THIS DIR FILE
	 RETBAD (,<CALL USTDIR>)	;FAILED
	TXNE D,IDX%IV		;VALID IDX ENTRY?
	RETBAD (DIRX3)		;NO. ERROR
	ADD A,DIRORA		;GET ABS ADR OF FDB
	CALL FDBCHK		;MAKE SURE FDB IS GOOD
	 RETBAD (,<CALL USTDIR>)	;IT ISNT
	LOAD A,FBNAM,(A)	;GET POINTER TO NAME STRING
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	RETSKP			;RETURN WITH DIR LOCKED AND ADR IN A

;HERE WHEN ROOT IS NOT SUPERIOR - MUST MAP SUBJECT DIR

GDRST5:	MOVE A,GDRSTR		;FIRST UNLOCK STR
	CALL ULKSTR		; ...
	MOVE A,GDRSDR		;GET FULLWORD DIR NUMBER
	CALL SETDIR		;MAP IT
	 RETBAD()		;FAILED - NO RECOURSE
	JRST GDRST1		;CHECK DIR AND RETURN STRING

;HERE WHEN THE SUBJECT DIR APPEARS BAD. CHECK IF NAME CAN COME FROM
;ROOT DIR

GDRST6:	MOVE A,GDRSTN		;GET HALFWORD DIR NUMBER
	CALL GETIDX		;GET INDEX INFO IN A-C
	 JRST GDRST7		;FAILED
	CAIN C,ROOTDN		;ROOT SUPERIOR?
	 JRST GDRST4		;YES - TRY FOR IT
GDRST7:	EXCH A,GDRSTR		;NO - SAVE ERR CODE AND GET STR NUM
	CALL ULKSTR		;UNLOCK STR
	MOVE A,GDRSTR		;RESTORE ERROR CODE
	RETBAD()		; FAIL
;INSERT AUTHOR/LAST-WRITER STRING IN FDB
; A/ FDB ADDRESS
; B/ POINTER TO STRING
; C/ FDB OFFSET (.FBAUT OR .FBLWR)
;	CALL INSUNS
; RETURNS +1 ALWAYS

INSUNS::SE1CAL
	STKVAR <INSUST,INSUNL>
	MOVEM B,INSUST		;SAVE USER NAME STRING
	ADD C,A			;ADDRESS OF WORD TO MODIFY
	MOVEM C,INSUNL		;LOCATION OF AUTHOR/LAST-WRITER STR
	CALL DELUNS		;DELETE USER NAME STRING
	AOS A,INSUST		;START OF STRING
	HRRZ B,-1(A)		;LENGTH OF STRING
	JUMPE B,INSUNX		;INSERT NULL IF ZERO
	SUBI B,2		;GET NUMBER OF FULL WORDS
	MOVEI C,.ETUNS		;USER NAME STRING TYPE
	CALL LOOKUP		;SEE IF THERE
	 JRST INSUN2		;NO - MUST ADD IT
	MOVE B,DRLOC		;GET POINTER TO SYMBOL ENTRY
	LOAD B,DIRLA,(B)	;GET ADDRS OF USER NAME STRING
INSUN1:	MOVE A,B		;PUT ADDRS IN A
	CALL UNSCHK		;GRNTEE VALID BLOCK
	 JRST [	MOVEI B,0	;NO - RETURN A ZERO
		JRST INSUNX]
	ADD A,DIRORA		;RELOCATE ADDRESS OF STRING
	INCR UNSHR,(A)		;INCREMENT SHARE COUNT
INSUNX:	MOVE A,INSUNL		;LOCATION TO STORE RESULT
	MOVEM B,0(A)		;STORE POINTER OR 0
	RET			;RETURN

INSUN2:	MOVE B,DRINL		;LENGTH OF STRING
	ADDI B,3		;ALLOW FOR HEADER AND PARTIAL WD
	CALL ASGDFR		;ALLOCATE SPACE IN DIRECTORY
	 JRST [	MOVEI B,0	;STORE 0 IF NO ROOM
		JRST INSUNX]
	MOVEI B,.TYUNS		;TYPE USER NAME STRING
	STOR B,UNTYP,(A)	;SET UP BLOCK
	XMOVEI C,2(A)		;DESTINATION
	PUSH P,A		;SAVE ADDRESS
	MOVE A,DRINL		;LENGTH
	AOS A			;+1
	HRRZ B,DRINP		;START OF SOURBE STRING
	CALL XBLTA
	POP P,A			;RESTORE A
	MOVE D,DRINL		;LENGTH OF TRANSFER
	ADD D,A			;FINAL ADDRESS OF XFER
	MOVE C,DRMSK		;CLEAR UNUSED CHARS
	ANDM C,2(D)		;...
	SETZRO UNSHR,(A)	;INIT SHARE COUNT
	LOAD B,UNVAL,(A)	;GET FIRST 5 CHARS OF STRING
	SUB A,DIRORA		;CONVERT TO RELATIVE ADDRS
	MOVEM A,INSUST		;SAVE FOR A WHILE
	MOVEI C,.ETUNS		;USER NAME STRING TYPE
	CALL INSSYM		;INSERT INTO SYMBOL TABLE
	 JFCL			;IGNORE ERROR
	MOVE B,INSUST		;RESTORE BLOCK ADDRS
	JRST INSUN1		;CHECK AND STORE
;ROUTINE TO DELETE A USER NAME STRING FROM AN FDB
; A/ FDB ADDRESS
; C/ ADDRESS OF AUTHOR OR LAST-WRITE STRING
;	CALL DELUNS
;RETURNS +1

DELUNS:	CALL FDBCHK		;VALIDATE FDB
	 RETBAD ()
	MOVE A,0(C)		;FETCH NAME STRING PNTR
	SETZM 0(C)		;CLEAR OUT PNTR
	JUMPE A,R		;DONE IF NONE
	ADD A,DIRORA		;RELOCATE BLOCK ADDRS
	LOAD C,UNSHR,(A)	;GET SHARE COUNT
	SOJG C,[STOR C,UNSHR,(A) ;UPDATE COUNT
		RET]		;RETURN OF .GT. 0
	PUSH P,A		;SAVE BLOCK ADDRS
	LOAD B,UNLEN,(A)	;GET BLOCK LENGTH
	SUBI B,3		;GET # OF FULL WORDS
	ADDI A,2		;POINT TO STRING BEG
	MOVEI C,.ETUNS		;TYPE USER NAME STRING
	CALL LOOKUP		;FIND STRING IN SYMBOL TABLE
	 SKIPA			;NOT FOUND
	CALL DELSYM		;FOUND - DELETE IT
	POP P,B			;RESTORE PNTR TO B
	CALLRET RELDFA		; AND RELEASE STORAGE
; INSERT ACCOUNT STRING/NUMBER IN FDB

INSACT::SE1CAL
	ASUBR <INSAC1>
	MOVEM B,INSAC1		;SAVE THE POINTER
	CALL GETFDB		;GET THE ADDRESS OF THE FDB INTO A
	 RET			;NOT FOUND
	MOVE B,INSAC1
	CALL INSAC0		;GO DO THE WORK
	 RETBAD ( ,<CALL USTDIR>) ;UNLOCK DIR AND GIVE ERROR RETURN
	CALL USTDIR
	RETSKP			;SUCCESS RETURN

; Insert account string/number in fdb
; Call:	A		; Location of fdb
;	B		; LOOKUP POINTER TO ACCOUNT
;	CALL INSAC0
; RETURNS +1	FAILED, ERROR CODE IN A
;	  +2	SUCCESS
; Clobbers b,c

INSAC0:	STKVAR <INSACF,INSACA>
	MOVEM A,INSACF		;SAVE ADDRESS OF FDB
	MOVEM B,INSACA		;SAVE POINTER TO ACCOUNT
	HRRZ A,FILDDN(JFN)	;GET DIRECTORY NUMBER
	LOAD B,FILUC,(JFN)	;GET STRUCTURE UNIQUE CODE
	HRL A,B			;36-BIT DIRECTORY NUMBER
	MOVE B,INSACA
	SKIPN 0(B)		;NULL STRING?
	BUG(BADDAC)
CPYAC3:	CALL VERACT		;VALID ACCOUNT?
	 RETBAD ()		;NO, ERROR RETURN
	MOVE A,INSACF		;ACCOUNT VALID, GET BACK ADDRESS OF FDB
	CALL DELACT		;DELETE THE PRESENT ACCOUNT
	HRRZ A,INSACA
	ADDI A,1		;GET START OF TEXT STRING IN A
	HLRE B,INSACA
	MOVNS B			;NUMBER OF FULL WORDS
	MOVEI C,.ETACT		;LOOKING FOR AN ACCOUNT STRING ENTRY
	CALL LOOKUP		;SEE IF ACCOUNT STRING EXISTS ALREADY
	 JRST CPYAC1		;IT DOESNT, GO ADD IT TO SYMBOL TABLE
	MOVE B,DRLOC		;GET POINTER TO SYMBOL ENTRY
	LOAD B,DIRLA,(B)	;GET ADDRESS OF ACCOUNT BLOCK
CPYAC0:	MOVE A,B		;GET ADDRESS OF ACCOUNT STRING BLOCK
	CALL ACTCHK		;MAKE SURE THIS IS A GOOD ACCOUNT BLOCK
	 RETBAD ()		;IT ISN'T, RETURN ERROR
	ADD A,DIRORA		;GET VIRTUAL ADDRESS OF BLOCK
	INCR ACSHR,(A)		;INCREMENT SHARE COUNT FOR STRING
CPYACG:	MOVE A,INSACF		;GET BACK FDB ADDRESS
	STOR B,FBACT,(A)	;Store as account
	RETSKP

CPYACF:	MOVE B,[XWD 500000,.DFACT] ;GET DEFAULT #
	JRST CPYACG
CPYAC1:	MOVE B,DRINL		;GET LENGTH OF STRING
	ADDI B,3		;ADD IN HEADER LENGTH PLUS PARTIAL WORD
	CALL ASGDFR		;ASSIGN SPACE FOR ACCOUNT BLOCK
	 RETBAD ()		;NO ROOM IN DIR
	MOVEI B,.TYACT		;MARK IT AS AN ACCOUNT STRING BLOCK
	STOR B,ACTYP,(A)	;...
	PUSH P,A
	MOVE B,DRINP		;GET START OF SOURCE STRING
	XMOVEI C,2(A)		;GET START OF DESTINATION STRING
	MOVE A,DRINL		;GET LENGTH OF STRING -1
	AOS A
	CALL XBLTA		;DO BLT
	POP P,A			;RESTORE ADDRESS
	MOVE D,DRINL		;FIND END ADDRESS
	ADD D,A
	MOVE C,DRMSK		;ZERO UNUSED CHARACTERS IN PARTIAL WORD
	ANDM C,2(D)		;...
	SETZRO ACSHR,(A)	;INITIALIZE SHARE COUNT
	LOAD B,ACVAL,(A)	;GET FIRST 5 CHARACTERS OF STRING
	SUB A,DIRORA		;GET RELATIVE ADDRESS OF STRING BLOCK
	MOVEM A,INSACA		;SAVE ADDRESS OF BLOCK
	MOVEI C,.ETACT		;GET ENTRY TYPE
	CALL INSSYM		;INSERT THIS ENTRY INTO SYMBOL TABLE
	 JFCL			;IGNORE FAILURE
	MOVE B,INSACA		;GET BACK ADR OF BLOCK
	JRST CPYAC0
;ROUTINE TO DELETE AN ACCOUNT FROM AN FDB
;ACCEPTS IN A/	ADR OF FDB (ABSOLUTE)
;	CALL DELACT
;RETURNS +1:	ALWAYS

DELACT:	CALL FDBCHK		;MAKE SURE WE HAVE A GOOD FDB
	 RETBAD			;NO
	LOAD B,FBACT,(A)	;GET THE CURRENT ACCOUNT
	SETZRO FBACT,(A)	;CLEAR THE ACCOUNT FIELD
	JUMPLE B,R		;NUMERIC ACCOUNTS REQUIRE NO WORK
	MOVE A,B		;GET ADDRESS OF ACCOUNT BLOCK
	CALL ACTCHK		;MAKE SURE THIS IS AN ACCOUNT STRING
	 RET			;NO, DONT TRY TO DELETE IT
	ADD A,DIRORA		;GET ABS ADR OF ACCOUNT STRING
	LOAD C,ACSHR,(A)	;GET SHARE COUNT OF THIS ACCOUNT STRING
	SOJG C,[STOR C,ACSHR,(A) ;STORE UPDATED COUNT
		RET]		;STRING IS BEING SHARED
	PUSH P,A		;SAVE ADR OF BLOCK
	LOAD B,ACLEN,(A)	;GET # OF WORDS IN BLOCK
	SUBI B,3		;GET # OF FULL WORDS IN STRING
	ADDI A,2		;GET POINTER TO START OF STRING
	MOVEI C,.ETACT		;THIS IS AN ACCOUNT TYPE
	CALL LOOKUP		;LOOKUP THIS ACCOUNT STRING
	 SKIPA			;COULD NOT FIND IT IN SYM TAB
	CALL DELSYM		;DELETE THIS SYMBOL
	POP P,B			;GET BACK POINTER TO STRING BLOCK
	CALLRET RELDFA		;RELEASE THE STORAGE SPACE


;ROUTINE TO DELETE A SYMBOL FROM THE SYMBOL TABLE
;ASSUMES:	DRLOC SET UP BY LOOKUP
;	CALL DELSYM
;RETURNS +1:	ALWAYS

DELSYM:	CALL SYMCHK		;CHECK THAT THE SYMBOL TABLE IS OK
	 RET			;NOT LEGAL FORMAT
	MOVE D,DIRORA		;GET BASE ADR OF MAPPED DIR
	LOAD A,DRSBT,(D)	;GET BOTTOM OF SYMBOL TABLE
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	AOS A			;SET UP FOR END TEST
	MOVE B,DRLOC		;GET ADR OF SYMBOL BEING DELETED
DELSY1:	MOVE C,-1(B)		;GET A WORD
	MOVEM C,.SYMLN-1(B)	;MOVE IT UP BY ONE SYMBOL
	CAMLE B,A		;FINISHED YET?
	SOJA B,DELSY1		;NO, LOOP BACK UNTIL DONE
	LOAD A,DRSBT,(D)	;GET OLD BOTTOM
	ADDI A,.SYMLN		;UPDATE IT
	STOR A,DRSBT,(D)
	RET			;AND RETURN
;EXPUNGE FILES FROM DIRECTORY
; F/	DD%DTF 			;DELETE ;T FILES
;	DD%DNF			;DELETE NON-EXISTENT FILES
;	DD%RST			;REBUILD SYMBOL TABLE
; B17 = DELETE ALL FILES
; A/ DIRECTORY NUMBER
;	CALL DELDEL
;RETURNS +1:	AN ERROR OCCURED DURING THE DELETING
;	 +2:	THE OPERATION WAS SUCCESSFUL

DELDEL::SE1CAL
;**;[7364] ADD 2 LINES AT DELDEL: + 1L	JDM	12-SEP-86
	TRVAR <SAVDNO,PASS2F,SAVFDB,RFLAG> ;[7364] CALLED DIRECTORY NUMBER, 2ND PASS FLAG
	MOVEM T1,SAVDNO		;[7364] SAVE DIRECTORY NUMBER FOR DELWAT
	SAVEPQ			;SAVE THE PERMANENT ACS
	CALL SETDIR		;MAP IN THE DIRECTORY NUMBER
	 RETBAD ()		;COULD NOT MAP THE DIRECTORY
	TXNE F,1B17		;DELETE ALL?
	JRST [	MOVE A,DIRORA	;YES - CHECK FOR SUBDIRS
		LOAD A,DRSDC,(A) ;GET COUNT
		JUMPN A,[RETBAD(DELF10,<CALL USTDIR>)] ;CANNOT DELETE WITH SUBDIRS
		JRST .+1]	;NO - OK TO DELETE ALL
	TXNE F,DD%CHK		;CHECKING ONLY?
	JRST [	MOVEI A,0	;YES
		CALL RBLDST	;DO THE CHECK
		 RETBAD (,<CALL USTDIR>) ;DIRECTORY IS NOT CONSISTENT
		CALL USTDIR	;DIR IS GOOD
		RETSKP]
	TXNE F,DD%RST		;REBUILD SYMBOL TABLE?
	JRST [	SETO A,		;YES, GO REBUILD IT
		CALL RBLDST	;...
		 RETBAD (DELFX4,<CALL USTDIR>) ;REBUILD FAILED
		JRST .+1]
	CALL SYMCHK		;MAKE SURE SYMBOL TABLE IS OK
	 RETBAD (DELFX5,<CALL USTDIR>) ;IT ISNT, GIVE ERROR RETURN
	MOVE A,DIRORA		;GET BASE ADDRESS OF MAPPED DIR
	SETZ Q1,		;INITIALIZE RETURN VALUE TO TRUE
	LOAD Q2,DRSBT,(A)	;GET BOTTOM OF SYMBOL TABLE
	ADD Q2,DIRORA		;MAKE IT BE ABSOLUTE
DELDL1:	ADDI Q2,.SYMLN		;STEP TO NEXT SYMBOL IN TABLE
	MOVE A,DIRORA		;GET BASE ADDRESS OF MAPPED DIR
	LOAD B,DRSBT,(A)	;GET BOTTOM OF SYMBOL TABLE
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	CAMG Q2,B		;DID SYMBOL TABLE CONTRACT PAST Q2?
	JRST DELDL1		;YES, GO INCREMENT Q2
	LOAD A,DRSTP,(A)	;GET THE TOP OF THE SYMBOL TABLE
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CAML Q2,A		;AT THE TOP OF THE SYMBOL TABLE?
	JRST [	CALL UPDDIR	;UPDATE DIR PAGES
		CALL USTDIR	;YES, UNLOCK THE DIR
		SKIPE A,Q1	;ANY ERRORS?
		RETBAD()	;YES
		RETSKP]		;GIVE OK RETURN
	LOAD A,SYMVL,(Q2)	;GET VALUE OF THIS SYMBOL
	CAMN A,[-1]		;IS IT THE SYMBOL TABLE HEADER?
	JRST DELDL8		;YES, GO COMPLAIN
	LOAD A,SYMET,(Q2)	;GET SYMBOL TYPE
	CAIE A,.ETNAM		;IS THIS STILL A NAME TYPE?
	JRST [	CALL UPDDIR	;UPDATE DIR PAGES
		CALL USTDIR	;NO, UNLOCK THE DIR
		SKIPE A,Q1	;ANY ERRORS?
		RETBAD()	;YES
		RETSKP]		;GIVE OK RETURN
	LOAD P3,DIRLA,(Q2)	;GET ADR OF FIRST NAME FDB
	;..
	;..
DELDL2:	JUMPE P3,DELDL1		;AT END OF CHAIN?
	ADD P3,DIRORA		;NO, GET ABS ADR OF THIS TOP EXT FDB
	MOVE Q3,P3		;GET ADDRESS OF CURRENT FDB
;**;[7364] ADD ONE LINE AT DELDL5: + 0L		JDM	12-SEP-86
DELDL5:	SETZM PASS2F		;[7364]RESET PASS 2 FLAG
	MOVE A,Q3		;GO CHECK THE FDB OUT
	CALL FDBCHK		;MAKE SURE IT IS REASONABLE
	 JRST DELDL9		;NO, GO BOMB OUT
	CALL DELTST		;SEE IF THIS FILE SHOULD BE DELETED
	 JRST DELDL4		;NO, DONT DELETE IT
DELDL3:	MOVE D,Q3		;GET FDB ADR OF CURRENT FILE
	LOAD Q3,FBGNL,(Q3)	;STEP TO NEXT FDB IN GEN CHAIN
	JUMPE Q3,DELDL6		;NO MORE GEN'S, GO STEP TO NEXT EXT
	ADD Q3,DIRORA		;GET ABS ADR OF NEXT FDB IN CHAIN
	CAMN P3,D		;IS THE DELETED FDB SAME AS TOP ONE?
	MOVE P3,Q3		;YES, NEXT FDB IS NOW TOP EXT FDB
;**;[7364] ADD A LABEL AT DELDL5: + 12L	JDM	12-SEP-86
DELD51:	CALL DELFIL		;[7364]DELETE THE CURRENT FDB
;**;[7364] REPLACE 4 LINES WITH 1 AT DELDL5: + 13L	JDM	12-SEP-86
	 JRST DELFS1		;[7364] COULDN'T, CHECK IF RECOVERABLE
	JRST DELDL5		;GO CONTINUE SCANNING

DELDL6:	LOAD P3,FBEXL,(P3)	;STEP TO NEXT EXT
;**;[7364] ADD A LABEL AT DELDL6: + 1L	JDM	12-SEP-86
DELD61:	CALL DELFIL		;[7364]DELETE THE FDB IN D
;**;[7364] REPLACE 4 LINES WITH 1 AT DELDL6: + 2L	JDM	12-SEP-86
	 JRST DELFS2		;[7364] COULDN'T, CHECK IF RECOVERABLE
	JRST DELDL2		;GO SCAN DOWN THIS GEN CHAIN

DELDL4:	LOAD Q3,FBGNL,(Q3)	;NOT DELETING, GET NEXT GEN IN CHAIN
	JUMPE Q3,DELDL7		;IF END OF CHAIN, GO STEP TO NEXT EXT
	ADD Q3,DIRORA		;GET ABS ADR OF FDB
	JRST DELDL5		;GO SEE IF THIS ONE NEEDS DELETING

DELDL7:	LOAD P3,FBEXL,(P3)	;STEP TO NEXT EXT
	JRST DELDL2		;GO SCAN DOWN THIS GEN CHAIN

DELDL8:	MOVE A,DIRORA		;SET UP DIR OFFSET
	LOAD A,DRNUM,(A)	;GET DIRECTORY NUMBER FOR SYSERR BLK
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRSY1,<<A,D>,<B,D>>)
DELDL9:	MOVEI A,DELFX6		;DIR FORMAT IS SCREWED UP
	CALLRET USTDIR		;UNLOCK THE DIR AND RETURN
;**;[7364] ADD 46 LINES AT DELDL9:+2.L		JDM	12-SEP-86
;[7364]
;[7364] HERE IF A CALL TO DELFIL FAILED. IF THE PROBLEM IS THAT THERE WAS NO
;[7364] FREE SPACE AVAILABLE TO SEND AN ARCHIVE MESSAGE, THEN LET'S WAIT A
;[7364] LITTLE WHILE AND TRY AGAIN, BUT ONLY ONE RETRY IS ALLOWED. THIS CODE
;[7364] MUST PRESERVE THE CONTENTS OF AC D IF IT INTENDS TO RETRY THE CALL
;[7364] TO DELFIL.
;[7364]
DELFS1:	SETZM RFLAG		;[7364]CLEAR RFLAG
	SKIPA			;[7364]
DELFS2:	SETOM RFLAG		;[7364]REMEMBER ENTRY POINT
	CAIN T1,ARCX13		;[7364]ARCMSG FAIL?
	IFSKP.			;[7364]NO.
	  TXNN F,1B17		;[7364]IF EXPUNGING ALL, GIVE ERROR
	  CAIE T1,DELFX2	;[7364]EXPECTED ERROR IF FILE OPENED
	  MOVE Q1,A		;[7364]NO, THEN REMEMBER FAILURE
	  SKIPE RFLAG		;[7364]CONTINUE
	  JRST DELDL2		;[7364] FROM THE APPROPRIATE
	  JRST DELDL5		;[7364] PLACE
	ENDIF.			;[7364]
	SKIPN PASS2F		;[7364]ALREADY TRIED WAITING?
	IFSKP.			;[7364]YES. GIVE UP
	  CALL UPDDIR		;[7364]()UPDATE WHAT'S BEEN DONE
	  CALL USTDIR		;[7364]()UNLOCK THE DIRECTORY
	  RETBAD()		;[7364]RETURN THE ERROR IN A
	ENDIF.			;[7364]
	MOVEM D,SAVFDB		;[7364]SAVE THE FDB ADDRESS
	CALL DELWAT		;[7364]()NO. GO WAIT FOR FREE SPACE
	 RETBAD()		;[7364]FAILED. RETURN THE ERROR
	MOVE D,SAVFDB		;[7364]GET BACK FDB ADDRESS
	SETOM PASS2F		;[7364]FLAG THAT WE HAD TO WAIT FOR RETRY
	SKIPE RFLAG		;[7364]GO BACK TO CORRECT PLACE
	JRST DELD61		;[7364]RETRY DELFIL
	JRST DELD51		;[7364] AT APPROPRIATE SPOT

DELWAT:	CALL UPDDIR		;[7364]()UPDATE DIR TO SAVE THOSE ALREADY DONE
	CALL USTDIR		;[7364]()AND UNLOCK TO AVOID CONTENTION
	SETOM IPPKFR		;[7364]SET FLAG FOR FREESPACE CLEAR
	MOVEI T1,IPPKFR		;[7364]ADDRESS
	CALL DISE		;[7364](T1/)WAIT UNTIL HAVE CLEARED FREESPACE
	MOVEI T1,^D45000	;[7364]45 SECONDS
	DISMS%			;[7364]WAIT
	MOVE T1,SAVDNO		;[7364]GET BACK DIRECTORY NUMBER
	CALL SETDIR		;[7364](T1/)MAP IT AND LOCK IT AGAIN
	 RETBAD()		;[7364]COULDN'T
	RETSKP			;[7364] RESUME
;ROUTINE TO SEE IF A FILE SHOULD BE DELETED
;ACCEPTS IN A/	FDB ADDRESS
;	CALL DELTST
;RETURNS +1:	DO NOT DELETE THE FILE
;	 +2:	DELETE THIS FILE

DELTST:	TXNE F,1B17		;DELETE ALL FILES?
	JRST [	SETZRO FBPRM,(A) ;YES, GUARANTEE THAT THIS GOES AWAY
		RETSKP]
	JN FBDEL,(A),RSKP	;IF DELETED, ALWAYS DELETE IT
	TXNN F,DD%DNF		;DELETE NON-EXISTENT FILES?
	JRST DELTS1		;NO
	JN <FBNXF,FBNEX>,(A),RSKP ;IF NON-EXISTENT OR NO EXT, DELETE IT
DELTS1:	JE FBTMP,(A),R		;IF NOT TEMPORARY, DO NOT DELETE IT
	TXNN F,DD%DTF		;DELETE TEMPORARY FILES?
	RET			;NO, DONT DELETE IT
	LOAD B,FBGEN,(A)	;GET GENERATION NUMBER OF FILE
	CAIGE B,^D100000	;IS THIS BELOW JOB RELATED FILES
	RETSKP			;YES. DELETE THIS FILE
	SUBI B,^D100000		;NO. EXTRACT JOB NUMBER FROM GENERATION
	CAME B,JOBNO		;YES, IS THIS FILE OURS?
	RET			;NO, DONT DELETE IT
	RETSKP			;DELETE THIS FILE

;ROUTINE TO DELETE AN FDB OF A NON-X FILE ON A RLJFN
;ASSUMES JFN AND STS ARE SET UP AS PER CHKJFN
;	CALL DELJFB
;RETURNS +1:	ALWAYS

DELJFB::SE1CAL
	HLRZ A,FILNEN(JFN)	;WAS THERE A NAME SET UP YET?
	JUMPE A,R		;IF 0, FDB COULD NOT HAVE BEEN MADE
	HRRZ A,DEV		;GET ADDRESS ONLY
	HRRZ A,NLUKD(A)		;SEE IF THIS IS A DIRECTORY DEV
	CAIE A,MDDNAM
	RET			;NO, RETURN NOW
	CALL GETFDB		;MAP IN FDB
	 JRST DELJF2		;FAILED, MUST BE NON-EXISTENT FILE
DELJF0:	CALL FDBCHK		;MAKE SURE THAT FDB IS GOOD
	 JRST DELJF1		;NOT GOOD
	JE FBNXF,(A),DELJF1	;IF FILE EXISTS, DONT DELETE IT
	MOVE D,A		;SET UP TO DELETE FDB
	CALL DELFIL		;DELETE FILE AND FDB
	 JFCL			;COULD GET HERE ON PERMANENT FILES
DELJF1:	CALLRET USTDIR		;UNLOCK DIR AND RETURN

DELJF2:	CAMGE A,DIRORA		;ADR MUST BE REASONABLE
	RET			;NO, IGNORE THIS FDB
	PUSH P,A		;SAVE FDB ADR
	HRRZ A,FILDDN(JFN)	;GET DIR NUMBER
	LOAD B,FILUC,(JFN)	;GET STRUCTURE NUMBER
	HRL A,B			;GET 36 BIT DIR NUMBER
	CALL SETDIR		;MAP IN THIS DIR
	 JRST PA1		;FAILED
	POP P,A			;GET BACK FDB ADDRESS
	JRST DELJF0		;GO DELETE FDB IF NON-EXISTENT
;ROUTINE TO DELETE AN FDB (DIR SPACE ONLY)
;ACCEPTS IN A/	FDB ADDRESS (ABSOLUTE)
;	CALL DELFDB
;RETURNS +1:	ERROR OCCURED, FDB NOT DELETED
;	 +2:	OK, ALL SPACE RETURNED

DELFDB::SE1CAL
	STKVAR <DELFBA,DELFBT>
	MOVEM A,DELFBA		;SAVE THE ADR OF THE FDB
	CALL FDBCHK		;GUARANTEE THAT FDB IS GOOD
	 RETBAD (DELFX7)	;IT ISNT, SO BOMB OUT
	LOAD A,FBNAM,(A)	;GET THE ADDRESS OF THE NAME BLOCK
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	LOAD B,NMLEN,(A)	;GET LENGTH OF NAME BLOCK
	ADDI A,1		;GET ADDRESS OF FIRST WORD IN STRING
	SUBI B,2		;GET # OF FULL WORDS
	MOVEI C,.ETNAM		;THIS IS A NAME SYMBOL
	CALL LOOKUP		;GO LOOK THIS NAME UP IN SYMBOL TABLE
	 RETBAD (DELFX8)	;COULD NOT FIND IT, ERROR RETURN
	MOVE B,DRLOC		;GET ADDRESS OF SYMBOL
	LOAD A,DIRLA,(B)	;GET FDB ADR OF FIRST FDB IN CHAIN
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CAME A,DELFBA		;IS THIS THE FDB WE ARE LOOKING FOR?
	JRST DELFB1		;NO
	LOAD C,FBGNL,(A)	;YES, SEE IF IT HAS ANY GENERATIONS
	JUMPE C,DELFB0		;NO
	MOVEM A,DELFBT		;CHECK THAT WE HAVE A GOOD FDB
	MOVE A,C
	CALL FDBCHR		;RELATIVE CHECK
	 RETBAD (DELFX7)	;BAD FDB
	MOVE A,DELFBT		;GET BACK ADR OF FIRST FDB IN CHAIN
	STOR C,DIRLA,(B)	;YES, MAKE SYMTAB POINT TO THIS VERSION
	ADD C,DIRORA		;GET ABSOLUTE ADR OF NEXT FDB
	LOAD A,FBEXL,(A)	;GET THE EXTENSION CHAIN POINTER
	CALL FDBCHR		;CHECK IF THIS IS A GOOD VALUE
	 MOVEI A,0		;NO, END CHAIN HERE
	STOR A,FBEXL,(C)	;PRESERVE CHAIN
	JRST DELFBF		;GO DELETE THIS FDB

DELFB0:	LOAD A,FBEXL,(A)	;FDB HAS NO GEN'S, CHECK FOR EXT'S
	CALL FDBCHR		;CHECK THIS FOR GOODNESS
	 MOVEI A,0		;END THIS CHAIN IF BAD
	STOR A,DIRLA,(B)	;FIX UP SYMTAB POINTER ALWAYS
	JUMPE A,DELFBN		;IF NO EXT'S, DELETE NAME, EXT, AND FDB
	JRST DELFBE		;OTHERWISE DELETE EXT AND FDB BLOCKS

DELFB1:	LOAD C,FBGNL,(A)	;GET NEXT GENERATION FDB
	JUMPE C,DELFB2		;IF NO MORE, STEP TO NEXT EXT
	ADD C,DIRORA		;GET ABS ADR OF FDB
	CAMN C,DELFBA		;IS THIS THE DESIRED FDB
	JRST DELFB3		;YES, GO DELETE IT
	MOVE A,C		;REMEMBER LAST FDB ADR
	JRST DELFB1		;GO CHECK NEXT GENERATION
DELFB2:	LOAD A,DIRLA,(B)	;GET POINTER TO TOP FDB IN GEN CHAIN
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	LOAD C,FBEXL,(A)	;GET POINTER TO NEXT EXT FDB
	JUMPE C,[RETBAD (DELFX8)] ;IF NO MORE, FDB WAS NOT FOUND
	MOVE B,A		;STEP POINTER TO EXTENSION FDB
	ADDI B,.FBEXL		;THIS IS A DIRLA POINTER
	ADD C,DIRORA		;GET ABS ADR OF THIS FDB
	CAMN C,DELFBA		;IS THIS THE DESIRED ONE?
	JRST DELFB4		;YES
	MOVE A,C		;REMEMBER THIS FDB AS LAST ONE SEEN
	JRST DELFB1		;GO CONTINUE LOOKING

DELFB3:	LOAD D,FBGNL,(C)	;GET POINTER TO NEXT GEN FDB
	EXCH A,D		;GET NEXT GEN FDB INTO A
	CALL FDBCHR		;GO CHECK IT OUT
	 MOVEI A,0		;END THE CHAIN
	STOR A,FBGNL,(D)	;MAKE LAST FDB POINT TO NEXT FDB
	JRST DELFBF		;GO DELETE JUST THE FDB BLOCK

DELFB4:	LOAD D,FBGNL,(C)	;SEE IF THERE IS ANOTHER GENERATION FDB
	JUMPN D,DELFB5		;YES, GO SET UP LINKS TO IT
	LOAD A,FBEXL,(C)	;NO, DELETING LAST GEN OF AN EXT
	CALL EFIXUP		;SET UP POINTERS TO NEXT EXT
	JRST DELFBE		;GO DELETE EXT AND FDB BLOCKS

DELFB5:	MOVE A,D		;REMEMBER NEW FDB ADR
	ADD D,DIRORA		;GET ABS ADR OF TOP FDB FOR THIS EXT
	LOAD C,FBEXL,(C)	;GET EXT CHAIN FROM FDB BEING DELETED
	EXCH C,A		;CHECK IT OUT
	CALL FDBCHR
	 MOVEI A,0		;END CHAIN
	EXCH C,A
	STOR C,FBEXL,(D)	;SET UP CHAIN POINTER
	CALL EFIXUP		;GO SET UP NEW EXT POINTERS
	JRST DELFBF		;GO DELETE JUST THE FDB BLOCK
DELFBN:	CALL DELSYM		;DELETE THE SYMBOL TABLE ENTRY
	MOVE A,DELFBA		;GET ADR OF FDB BEING DELETED
	LOAD B,FBNAM,(A)	;GET NAME BLOCK
	SETZRO FBNAM,(A)	;CLEAR OUT POINTER TO BLOCK
	SKIPE A,B		;DONT RELEASE BLOCK IF NONE THERE
	CALL NAMCHK		;MAKE SURE THIS IS A LEGAL BLOCK
	 JRST DELFBE		;IT ISNT, DONT RELEASE IT
	CALL RELDFR		;RELEASE THE NAME BLOCK
DELFBE:	MOVE A,DELFBA		;GET ADR OF FDB AGAIN
	LOAD B,FBEXT,(A)	;GET ADR OF EXT BLOCK
	SETZRO FBEXT,(A)	;CLEAR OUT POINTER TO BLOCK
	SKIPE A,B		;DONT RELEASE BLOCK IF NONE THERE
	CALL EXTCHK		;MAKE SURE IT IS AN EXT BLOCK
	 JRST DELFBF		;IT ISNT, DONT DELETE IT
	CALL RELDFR		;GO RELEASE SPACE
DELFBF:	MOVE A,DELFBA		;GET FDB ADR
	CALL DELACT		;DELETE THE ACCOUNT STRING IF ANY
	MOVE A,DELFBA		;GET FDB ADDRS
	LOAD B,FBVER,(A)	;GET VERSION #
	CAIGE B,1		;CHECK VER #0
	JRST DELFBG		;OLD FDB - SKIP THIS
	MOVE C,A		;COPY FDB ADDRS
	ADDI C,.FBAUT		;POINT TO AUTHOR STRING
	CALL DELUNS		;DELETE USER NAME STRING
	MOVE A,DELFBA		;FDB ADDR
	MOVE C,A		;COPY IT
	ADDI C,.FBLWR		;POINT TO LAST WRITER
	CALL DELUNS		;DELETE USER NAME STRING
DELFBG:	MOVE B,DELFBA		;GET FDB ADR FOR LAST TIME
	CALL RELDFA		;RELEASE THE SPACE HELD BY THE FDB
	RETSKP			;AND GIVE SUCCESSFUL RETURN
;ROUTINE TO DO A FAST GTFDB
;ASSUMES JFN IS SET UP POINTING TO THE APPROPRIATE JFN BLOCK
;	CALL FSTGFB
;RETURNS +1:	FAST GTFDB FAILED, A LOOKUP MUST BE DONE
;	 +2:	FDB FOUND, ADDRESS OF FDB IN A
;		DIRECTORY IS LOCKED AND FORK IS NOINT

FSTGFB::SE1CAL
	HRRZ A,FILDDN(JFN)	;GET DIRECTORY NUMBER
	JUMPE A,R		;IF NONE, GIVE ERROR RETURN
	LOAD B,FILUC,(JFN)	;GET STRUCTURE NUMBER
	HRL A,B			;GET 36 BIT DIRECTORY NUMBER
	CALL SETDIR		;MAP IN THE DIRECTORY
	 RET			;FAILED
	SKIPN A,FILFDB(JFN)	;GET THE ADDRESS OF THE FDB
	JRST FSTGFE		;IF NONE, GO UNLOCK AND GIVE ERROR RET
	CALL FDBCHQ		;CHECK IT (WITHOUT BUG-CHECKING)
	 JRST FSTGFE		;NOT AN FDB ANYMORE
	LOAD B,FBNAM,(A)	;GET POINTER TO NAME STRING
	HLRZ A,FILNEN(JFN)	;GET POINTER TO NAME STRING IN JFN
	JUMPE A,FSTGFE		;IF NO NAME IN JFN, GIVE ERROR RETURN
	CALL DIRSTC		;GO COMPARE THE TWO STRINGS
	 JRST FSTGFE		;NOT A MATCH, NOT RIGHT FDB
	MOVE A,FILFDB(JFN)	;GET ADR OF FDB AGAIN
	LOAD B,FBEXT,(A)	;GET POINTER TO EXTENSION STRING
	HRRZ A,FILNEN(JFN)	;GET POINTER TO EXT IN JFN BLOCK
	JUMPE A,FSTGFD		;IF NO EXT YET, THIS IS OK
	CALL DIRSTC		;GO COMPARE STRINGS
	 JRST FSTGFE		;ERROR, GO UNLOCK DIR
	MOVE A,FILFDB(JFN)	;GET ADR OF FDB AGAIN
	LOAD B,FBGEN,(A)	;GET GENERATION OF THIS FDB
	HRRZ C,FILVER(JFN)	;GET GEN FROM JFN BLOCK
	JUMPE C,FSTGFD		;IF GEN NOT SET YET, THIS IS OK
	CAME B,C		;GENERATIONS MATCH
	JRST FSTGFE		;NO, GO UNLOCK AND BOMB OUT
FSTGFD:	MOVE A,FILFDB(JFN)	;GET THE FDB ADDRESS INTO A
	RETSKP			;EXIT LEAVING DIR LOCKED

FSTGFE:	CALLRET USTDIR		;UNLOCK THE DIR
;ROUTINE TO COMPARE A STRING IN THE JSB WITH A DIR STRING
;ACCEPTS IN A/	ADDRESS OF STRING IN JSB
;	    B/	RELATIVE ADDRESS OF STRING IN DIRECTORY
;	CALL DIRSTC
;RETURNS +1:	NO MATCH
;	 +2:	STRINGS MATCH

DIRSTC::SE1CAL
	STKVAR <DIRSTP>
	JUMPE B,R		;IF NO STRING IN DIR, GIVE ERROR RET
	ADD B,DIRORA		;GET ABSOLUTE ADR OF STRING
	HRLI A,(POINT 7,0,35)	;SET UP BYTE POINTER
	MOVSI C,(POINT 7,0(B),35)
	MOVEM C,DIRSTP		;SAVE BYTE POINTER TO DIR STRING
DIRSTL:	ILDB C,A		;GET A BYTE FROM JFN BLOCK STRING
	ILDB D,DIRSTP		;GET A BYTE FROM THE DIR STRING
	CAME C,D		;MATCH?
	RET			;NO, GIVE ERROR RETURN
	JUMPN C,DIRSTL		;REACHED THE NULL YET?
	RETSKP			;YES, STRINGS MATCH
; Insert protection into fdb
; Call:	FILPTR(JFN)	; Protection number
;	A		; Location of fdb
;	CALL INSPRT
; Returns +1
; Clobbers b

INSPRT::SE1CAL
	CALL GETFDB		;GET THE ADDRESS OF THE FDB
	 RET
	PUSH P,A		;SAVE VIRTUAL ADDRESS OF FDB
	MOVX B,DC%CN		;B/CONNECT ACCESS
	CALL DIRCHK		;SEE IF WE CAN CONNECT (AND THUS BECOME
				; LIKE OWNER)
	 JRST [	POP P,A		;NOT LEGAL ACCESS
		JRST ERRET]
	POP P,A
	MOVE B,FILPRT(JFN)	;GET THE NEW PROTECTION SETTING
	STOR B,FBPRT,(A)	;STORE IT IN THE DIRECTORY
	JRST ERRET		;EXIT UNLOCKING THE DIRECTORY

;SET UP DEFAULT AUTHOR AND LAST-WRITER STRINGS IN NEW FDB
;CALL:	FILFDB(JFN)	;FDB ADDRESS
;	CALL FDBINU
;RETURNS +1
;CLOBBERS A,B,C,D

FDBINU::SE1CAL
	CALL GETFDB		;MAP IN FDB AND DIRECTORY
	 RET
	LOAD B,FBVER,(A)	;GET VERSION #
	CAIGE B,1		;VERSION 1 OR LATER
	JRST [	CALL FV0FIX	;FIXUP V0 FDB
		JRST ERRET]	;EXIT AND UNLOCK DIRECTORY
	PUSH P,A		;SAVE FDB ADDRESS
	MOVEI B,USRNAM		;POINT TO USER NAME
	MOVEI C,.FBAUT		;SET UP AUTHOR FIELD
	CALL INSUNS		;INSERT USER NAME STRING
	POP P,A			;GET FDB ADDRS BACK
	MOVEI B,USRNAM		;THIS USER
	MOVEI C,.FBLWR		;SET LAST WRITER
	CALL INSUNS		;INSERT STRING
	JRST ERRET		;EXIT UNLOCKING DIRECTORY
; Initialize fdb
; Call:	A		; Location of fdb
;	CALL FDBINI
; Return +1 always
; Initializes the fdb as follows:
;	FDBCTL	; Fdbnxf (non-existent)
;	FDBCRE	; Date and time of now
;	FDBCRV	; Date and time of now
; All else is zeroed including fdbext, fdbver, etc.
; Clobbers b,c,d
; Preserves a

FDBINI:	LOAD C,FBLEN,(A)	;GET THE LENGTH OF THE FDB
	MOVSI B,0(A)		;ZERO THE FDB AREA
	HRRI B,1(A)		;SET UP BLT POINTER
	SETZM 0(A)		;ZERO FIRST WORD
	ADD A,C			; End of FDB
	BLT B,-1(A)		;Clear the entire fdb
	SUB A,C			; Back to top of FDB
	STOR C,FBLEN,(A)	;RESTORE LENGTH
	MOVEI B,.TYFDB		;SET UP THE TYPE FIELD
	STOR B,FBTYP,(A)	;...
	MOVEI B,1		;INIT VERSION # OF FDB
	STOR B,FBVER,(A)	;...
	CALL FDBIN0		;GO INITIALIZE REST OF FDB
	MOVE C,DIRORA		;GET BASE ADDRESS OF DIR
	LOAD B,DRDPW,(C)	;GET DEFAULT FILE PROTECTION
	STOR B,FBPRT,(A)	;PUT DEF PROT IN DIRECTORY
	LOAD B,DRDBK,(C)	;GET DEFAULT NUMBER VERSIONS
	STOR B,FBGNR,(A)	;PUT IN FDB
	MOVE B,[500000,,.DFACT]	;SET ACCOUNT TO DEFAULT
	STOR B,FBACT,(A)	;...
	LOAD B,DRDNE,(C)	; Get default online expiration
	CAIN B,0		; Is it 0? (not set up for directory)
	MOVX B,.STDNE		; Yes, use system default then
	STOR B,FBNET,(A)	; Put in FDB
	LOAD B,FBLEN,(A)	; Get FDB length
	CAIGE B,.FBLXT		; Long enough for offline exp?
	RET			; No, done then
	LOAD B,DRDFE,(C)	; Get default offline expiration
	CAIN B,0		; Is it 0? (not setup for dir)
	SKIPE B,TPRCYC		; USE TAPE-RECYCLE-PERIOD IF SPEC'D
	SKIPA
	MOVX B,.STDFE		; USE SYSTEM DEFAULT AS LAST DITCH
	STOR B,FBFET,(A)	; Put in FDB
	RET

;ENTRY TO INIT FIELDS NOT COPIED FROM PREVIOUS VERSIONS

FDBIN0:	PUSH P,A		;SAVE ADDRESS OF FDB
	CALL LGTAD		;Get today
	MOVE B,0(P)		;GET FDB ADDRS BACK
	STOR A,FBCRE,(B)	;Set LAST WRITE DATE
	STOR A,FBCRV,(B)	;CREATION DATE
	POP P,A			;RESTORE FDB ADR IN A
	MOVX B,FB%NXF		;MARK FILE NON-EXISTENT
	MOVEM B,.FBCTL(A)	;AND IMPLCITELY CLEAR ALL OTHER BITS
	LOAD B,FBVER,(A)	;GET FDB VERSION #
	CAIGE B,1		;NEW ?
	CALLRET FV0FIX		;OLD - SET DEFAULTS
	RET

FV0FIX:	MOVE B,JOBNO		;GET JOB #
	HRRZ B,JOBDIR(B)	;LOGGED IN DIRECTORY #
	HRLS B			;COPY TO LHS ALSO
	MOVEM B,.FBUSE(A)	;STORE IN FDB USE WORD
	RET			;RETURN
; MAP A DIRECTORY INTO PROCESS VIRTUAL ADDRESS SPACE
; Call:	A		; 36 BIT Directory number
;	CALL SETDIR	; For mapping a directory
; Return
;	+1		; Non-existent directory, OR COULD NOT MAP INDEX TABLE
;	+2		; Normal, the DIR IS MAPPED IN AT DIRORG
;			; LEAVES STR AND DIR LOCKED AND FORK NOINT
; Clobbers a,b,c,d

SETDIR::SE1CAL
	STKVAR <SETDIN,SETDIS,SETDIE,SETDNM>
	MOVEM A,SETDIN		;SAVE DIR #
	HLRZS A			;GET THE UNIQUE STR NUMBER
	CALL CNVSTR		;CONVERT IT TO STR INDEX
	 RETBAD ()		;NO SUCH STR
	MOVEM A,SETDIS		;SAVE THE STR INDEX
	MOVE B,STRTAB(A)	;GET POINTER TO SDB
	LOAD B,STRNAM,(B)	;GET SIXBIT NAME
	MOVEM B,SETDNM		;SAVE IT IN CASE OF AN ERROR
	HLRZ A,SETDIN		;GET UNIQUE CODE FOR REQUESTED STRUCTURE
	LOAD B,CURUC		;GET UNIQUE CODE FOR CURRENTLY MAPPED STRUCTURE
	CAME A,B		;REQUESTED STRUCTURE ALREADY MAPPED ?
	JRST SETDI1		;NO, GO MAP DESIRED DIRECTORY ON THAT STRUCTURE
	MOVE A,DIRORA		;YES, GET STARTING ADDRESS OF MAP AREA
	SKIPN EXADDR		;CHECK FOR EXTENDED ADDRESSING
	JRST SETDIB		;YES -- SKIP OVER THIS CHECK
	SKIPN DRMAP		;CHECK FOR MAPPED
	JRST SETDI1		;NO -- GO MAP IT
SETDIB:	CALL FPTA		;GET IDENT OF FIRST PAGE
	JUMPE T1,SETDI1		;IF NO SECTION, NOT MAPPED
	CALL MRPACS		;Read access of page
	TLNN A,(1B5)		;PAGE EXIST?
	JRST SETDI1		;NO, NO DIR MAPPED IN
	HRRZ A,SETDIN		;GET DIRECTORY NUMBER BACK
	MOVE B,DIRORA		;GET START OF MAPPED AREA
	LOAD C,DRTYP,(B)	;GET DIRECTORY BLOCK TYPE
	CAIE C,.TYDIR		;VERIFY THAT WE HAVE A GOOD DIR MAPPED
	JRST SETDI1		;DIRECTORY IS BAD, MAP IN DESIRED DIR
	LOAD B,DRNUM,(B)	;GET DIR NUMBER OF MAPPED DIR
	CAMN A,B		;different?
	JRST SETDI2		;NO, REQUESTED DIRECTORY ALREADY MAPPED
SETDI1:	HRRZ A,SETDIN		;GET DIR NUMBER TO MAP
	MOVE B,SETDIS		;GET STRUCTURE NUMBER
	CALL MAPDIR		;Must map it first
	 JRST SETDI6		;COULD NOT MAP THE DIR
SETDI2:	HRRZ A,SETDIN		;GET DESIRED DIR NUMBER
	CALL DR0CHK		;MAKE SURE DIRECTORY HEADER IS GOOD
	 JRST SETDI6		;HEADER NOT GOOD, BOMB OUT
	CALL FBTINI		;CHECK FOR A GOOD FREE BIT TABLE
	HRRZ A,SETDIN		;GET BACK DIR NUMBER
	MOVE B,SETDIS		; AND STR NUMBER
	CALL LCKDNM		;LOCK THE DIRECTORY
	HRRZ A,SETDIN		;GET BACK DIR NUMBER
	RETSKP

SETDI6:	MOVEM A,SETDIE		;SAVE THE ERROR CODE
	MOVE A,SETDIS		;GET STRUCTURE NUMBER
	CALL ULKSTR		;UNLOCK THE STR
	MOVE A,SETDIE		;GET ERROR CODE AGAIN
	RET			;AND RETURN NON-SKIP


SETDI4:	HRRZ A,SETDIN		;GET DIR NUMBER (RH ONLY)
	MOVE D,SETDNM		;GET THE SIXBIT STRUCTURE NAME
	BUG(DIRBAD,<<A,D>,<D,D>>)
	OKINT
	RETBAD (DELFX6)

SETDI5:	HRRZ B,SETDIN		;GET STR RELATIVE DIR NUMBER
	SKIPE A			;NONX PAGE?
	BUG(DIRFKP,<<B,D>,<SETDNM,D>>)
	JRST SETDI1
;ROUTINE TO INITIALIZE THE FREE BIT TABLE IF NECESSARY

;	CALL FBTINI
;RETURNS +1:	ALWAYS

FBTINI:	MOVE D,DIRORA		;GET BASE ADR OF DIR AREA
	LOAD C,DRFBT,(D)	;GET ADR OF FREE BIT TABLE
	JUMPE C,FBTIN0		;IF NONE, TRY TO CREATE ONE
	ADD C,DIRORA		;GET ABS ADR OF TABLE
	LOAD B,BLKTYP,(C)	;CHECK FOR LEGAL BLOCK TYPE
	CAIE B,.TYFBT		;MUST BE THE FREE BIT TABLE
	JRST FBTIN1		;ILLEGAL, GO CREATE ONE
	LOAD B,BLKLEN,(C)	;GET LENGTH OF FREE TABLE
	CAML B,FBTSIZ		;IS IT BIG ENOUGH?
	RET			;YES, THE FREE BLOCK IS OK
FBTIN0:	LOAD B,DRFBT,(D)	;FIRST, RELEASE OLD TABLE
	JUMPE B,FBTIN1		;IF ANY
	CALL RELDFR		;RELATIVE POINTER
FBTIN1:	MOVE D,DIRORA		;SET UP OFFSET AGAIN
	SETZRO DRFBT,(D)	;CLEAR OUT POINTER TO OLD TABLE
	MOVE B,FBTSIZ		;GET A BLOCK FOR THE FREE BIT TABLE
	CALL ASGDFR
	 RET			;NO ROOM FOR TABLE, ALWAYS LOOK AT PAGE
	MOVE D,DIRORA		;GET BASE ADR OF DIR
	MOVEI B,.TYFBT		;SET UP BLOCK TYPE
	STOR B,BLKTYP,(A)	;IN NEW FREE BIT TABLE
	LOAD B,BLKLEN,(A)	;GET LENGTH OF BLOCK
	MOVE C,A		;SET UP TO INITIALIZE TABLE
FBTIN2:	SOJLE B,FBTIN3		;INITIALIZED TABLE YET?
	SETOM 1(C)		;NO, SET ALL BITS TO 1
	AOJA C,FBTIN2		;LOOP BACK TILL ALL WORDS SET

FBTIN3:	SUB A,DIRORA		;GET RELATIVE ADR OF TABLE
	STOR A,DRFBT,(D)	;SAVE ADR OF TABLE IN DIR HEADER
	RET
;UPDATE DIRECTORY -- GET PAGES COPIED TO DSK
; DIRECTORY MAPPED AS USUAL
;	CALL UPDDIR
; RETURNS +1 ALWAYS

UPDDRR::SE1CAL
	SAVET			;ENTRY POINT FOR NOT UPDATING DRUDT
	JRST UPDDR1

UPDDIR::SE1CAL
	SAVET			;PRESERVE TEMPORARIES
	CALL UPDDTM		;UPDATE THE LAST DIR WRITE TIME
UPDDR1:	OPSTR <HRLZ A,>,DIROFN	;GET THE OFN,,0 OF THE MAPPED DIR
	MOVE B,NDIRPG		;GET LENGTH OF DIRECTORY
	CALL UPDPGS		;UPDATE DIRECTORY PAGES
	LOAD A,DIROFN		;GET THE OFN
	CALL UPDOFN		;UPDATE IT TOO
	RET

;ROUTINE TO SET TIME AND DATE INTO DRUDT (DIR UPDATE TIME)
;ASSUMES DIR IS MAPPED
;	CALL UPDDTM
;RETURNS +1:	ALWAYS, WITH DATE AND TIME IN A

UPDDTM::SE1CAL
	CALL LGTAD		;GET CURRENT DATE AND TIME
	MOVE B,DIRORA		;NOW GET BASE ADDRESS INTO DIR
	CAME A,[-1]		;TIME BEEN SET YET?
	STOR A,DRUDT,(B)	;YES, UPDATE TIME OF LAST DIR CHANGE
	RET			;RETURN WITH TIME IN A

; Unlock directory

USTDIR::SE1CAL
	ULKDIR			;UNLOCK THE DIRECTORY
	OKINT
	RET

;UNLOCK MAPPED DIRECTORY -- INVOKED VIA ULKDIR MACRO
;CLOBBERS NO ACS

ULKMD0::SE1CAL
	PUSH P,T1		;SAVE AN AC
	PUSH P,T2
	MOVE T1,DIRORA		;FIRST VERIFY THAT A DIR IS MAPPED
	LOAD T1,DRTYP,(T1)	;THE DIRECTORY BLOCK TYPE MUST BE GOOD
	CAIE T1,.TYDIR		;...
	JRST ULKMD2		;DONT UNLOCK GARBAGE
	MOVE T1,DIRORA		;GET BASE ADDRESS OF DIR
	LOAD T1,DRNUM,(T1)	;GET DIR # OF MAPPED DIR
	CALL ULKDNM		;UNLOCK DIR
ULKMD1:	LOAD T1,CURSTR		;GET THE STRUCTURE NUMBER
	CALL ULKST1		;UNLOCK THE STR ALSO
	JRST PA2		;AND RETURN

ULKMD2:	MOVE T1,DIRORA		;GET DIR NUMBER
	LOAD T1,DRNUM,(T1)	; FOR SYSERR REPORT
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRULK,<<T1,D>,<T2,D>>)
	JRST ULKMD1
;DIRECTORY LOCK/UNLOCK
;DIRECTORY IS LOCKED IF ITS NUMBER APPEARS IN TABLE LDTAB.
;FORKS WHICH ARE WAITING FOR A DIRECTORY TO BE UNLOCKED ARE
;MARKED IN BIT TABLE LCKDBT.  WHEN A DIRECTORY IS UNLOCKED,
;THIS BIT TABLE IS SCANNED, AND THE FIRST FORK FOUND
;WAITING FOR THE DIRECTORY IS UNBLOCKED.

;STORAGE IN STG.MAC

	EXTN <LCKDBT,LCKDBN>
	EXTN <LKDTST,LKDSPT>	;RESIDENT SCHED TESTS

;STORAGE

NLDTAB==:20			;LENGTH OF LOCK TABLE

NR LDTAB,NLDTAB			; STRNUM,,DIRNUM
NR LDTBF,NLDTAB			; FLAGS,,FORKX
RS MLDTAB,1			;HIGHEST ENTRY IN USE IN LDTAB
NR LDTLCK,1			;LOCK ON LDTAB

;FLAGS IN LDTAB

LCKDFF==1B0			;ENTRY IS FREE
LKDWTF==1B1			;ANOTHER FORK IS WAITING
DEFSTR (LDTFK,LDTBF,35,18)	;FORK INDEX IN LDTBF

;ROUTINE TO SEARCH TABLE FOR GIVEN DIRECTORY NUMBER
; T1/ DIRECTORY NUMBER
; T2/ STRUCTURE NUMBER
;	CALL LCKDSC
; RETURN +1, NOT FOUND, Q1/ FIRST FREE ENTRY OR -1
; RETURN +2, FOUND, Q1/ INDEX OF ENTRY
; T1/ STRNUM,,DIRNUM

LCKDSC:	HRL T1,T2		;FORM FULL TABLE ENTRY
	SETO Q1,		;INIT PLACE TO REMEMBER FREE ENTRY
	HRLZ Q2,MLDTAB		;GET LIMIT OF TABLE
	MOVN Q2,Q2		;INIT AOBJN PTR
	JUMPGE Q2,R		;QUIT NOW IF TABLE EMPTY
LCKDS2:	SKIPG Q3,LDTAB(Q2)	;SKIP IF ENTRY IS INUSE
	JRST [	SKIPGE Q1	;FREE ENTRY, HAVE ONE ALREADY?
		HRRZ Q1,Q2	;NO, REMEMBER THIS ONE
		JRST LCKDS1]
	CAMN T1,Q3		;WANT THIS ONE?
	JRST [	HRRZ Q1,Q2	;YES, RETURN INDEX
		RETSKP]
LCKDS1:	AOBJN Q2,LCKDS2		;SCAN TABLE
	RET			;NOT FOUND
;LOCK DIRECTORY
; A/ DIRECTORY NUMBER
; B/ STR #
;	CALL LCKDIR
; RETURN +1 ALWAYS, DIRECTORY LOCKED.  BLOCK UNTIL ABLE TO LOCK
;FORK MUST BE NOINT WHILE DIRECTORY LOCKED.

LCKDNM::SE1CAL
	SAVEQ
	STKVAR <LCKSV>
LCKDI0:	CSKED			;BE SURE WE GET REASONABLE SCHEDULING
	LOCK LDTLCK		;LOCK TABLE
	CALL LCKDSC		;SEARCH FOR GIVEN DIRNUM
	 JRST LCKDI3		;NOT FOUND, ENTER IT
	MOVX Q2,LCKDFF		;ALREADY IN TABLE
	TDNE Q2,LDTBF(Q1)	;ENTRY NOW FREE?
	JRST [	ANDCAM Q2,LDTBF(Q1) ;YES, GRAB IT
		JRST LCKDI5]
	LOAD Q2,LDTFK,(Q1)	;FORK OWNING LOCK
	CAMN Q2,FORKX		;THIS FORK?
	BUG (LCKDIR)
	MOVX Q2,LKDWTF		;DIRECTORY ALREADY LOCKED
	IORM Q2,LDTBF(Q1)	;NOTE THIS FORK WAITING FOR IT
	MOVEM T1,LCKSV		;SAVE ARGS
	HRLZ T1,Q1		;INDEX INTO LDTAB TO WAIT FOR
	HRRZ Q1,FORKX		;SET BIT IN FORK BIT TABLE
	IDIVI Q1,^D36
	MOVE Q2,BITS(Q2)
	IORM Q2,LCKDBT(Q1)
	UNLOCK LDTLCK		;UNLOCK TABLE
	ECSKED			;NO LONGER NEED SPECIAL SCHEDULING
	HRRI T1,LKDTST		;ROUTINE FOR SCHEDULER
	MDISMS			;BLOCK UNTIL DIR UNLOCKED
LCKDI1:	HRRZ T1,LCKSV		;RESTORE ARGS (DIRECTORY NUMBER)
	HLRZ T2,LCKSV		; STRUCTURE NUMBER
	JRST LCKDI0		;TRY AGAIN

;ASSIGN NEW ENTRY FOR DIR NUM

LCKDI3:	SKIPGE Q1		;FREE ENTRY TO REUSE?
	JRST [	MOVE Q1,MLDTAB	;NO, USE NEXT ONE AT END
		CAIL Q1,NLDTAB	;TABLE FULL?
		JRST LCKDI4	;YES, BLOCK UNTIL ROOM
		AOS MLDTAB	;INCREMENT END
		JRST .+1]
	MOVEM T1,LDTAB(Q1)	;SETUP ENTRY
	MOVX Q2,LCKDFF!LKDWTF	;CLEAR THESE
	ANDCAM Q2,LDTBF(Q1)	;...
LCKDI5:	MOVE Q2,FORKX		;NOTE FORK OWNING LOCK
	STOR Q2,LDTFK,(Q1)
	UNLOCK LDTLCK		;UNLOCK TABLE
	RET

;TABLE FULL (SHOULD HAPPEN VERY RARELY)

LCKDI4:	UNLOCK LDTLCK		;UNLOCK TABLE
	ECSKED			;NO LONGER CRITICLA
	MOVEM T1,LCKSV		;SAVE ARGS
	MOVEI T1,LKDSPT		;SETUP SCHED TEST
	MDISMS			;DISMISS UNTIL ROOM IN TABLE
	JRST LCKDI1		;TRY AGAIN
;UNLOCK DIRECTORY
; T1/ DIRECTORY NUMBER
;	CALL ULKDIR
; RETURN +1 ALWAYS, DIRECTORY UNLOCKED
;PRESERVES T3,T4

ULKDNM::SAVEQ
	SE1CAL
	LOCK LDTLCK		;LOCK TABLE
	LOAD T2,CURSTR		;CURRENT STRUCTURE
	CALL LCKDSC		;SEARCH TABLE FOR DIRNUM
	 JRST ULKDI7		;NOT FOUND, SOMEBODY CONFUSED
	MOVX Q2,LKDWTF
	TDNE Q2,LDTBF(Q1)	;ANOTHER FORK WAITING FOR THIS?
	JRST ULKDI1		;YES
ULKDI5:	SETOM LDTAB(Q1)		;RELEASE ENTRY
	MOVE Q2,MLDTAB		;CHECK END OF TABLE
	SKIPGE LDTAB-1(Q2)	;LAST ENTRY DELETED?
	JRST [	SOSE Q2,MLDTAB	;YES, LOWER END
		JRST .-1	;CHECK NEW LAST ENTRY
		JRST .+1]	;TABLE EMPTY
ULKDI8:	UNLOCK LDTLCK		;UNLOCK TABLE
	ECSKED			;NO LONGER CRITICAL
	RET

ULKDI7:	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRDNL,<<T1,D>,<T2,D>>)
	UNLOCK LDTLCK
	ECSKED			;NO LONGER CRITICAL
	RET
;OTHER FORK(S) WAITING FOR DIR JUST UNLOCKED - TRY TO FIND ONE
;AND WAKE IT UP.

ULKDI1:	SAVET			;NEED MORE AC'S HERE
	STKVAR <SAVSTS>		;SAVE FORK'S STATUS HERE
	MOVSI T4,-LCKDBN	;SETUP TO SCAN BIT TABLE
ULKDI2:	SKIPE Q2,LCKDBT(T4)	;ANY BITS HERE?
ULKDI3:	JFFO Q2,ULKDI6		;YES, FIND ONE
ULKDI4:	AOBJN T4,ULKDI2		;SCAN BIT TABLE
	JRST ULKDI5		;FOUND NO FORK, DELETE TABLE ENTRY

ULKDI6:	TDZ Q2,BITS(Q3)		;REMOVE BIT JUST FOUND
	HRRZ T3,T4		;COMPUTE FORK NUMBER
	IMULI T3,^D36
	ADD T3,Q3
	MOVE T2,FKSTAT(T3)	;GET BLOCK TEST WORD FOR FORK
	MOVEM T2,SAVSTS		;SAVE IT AWAY
	HRRZS T2		;GET ROUTINE NAME
	CAIE T2,LKDTST		;STILL WAITING FOR DIRECTORY?
	JRST [	MOVE T2,BITS(Q3) ;NO, REMOVE IT FROM BIT TABLE
		ANDCAM T2,LCKDBT(T4)
		JRST ULKDI3]	;SEE IF OTHER BITS IN THIS WORD
	HLRZ T2,SAVSTS		;GET DIR NUMBER
	CAME T2,Q1		;THIS ENTRY?
	JRST ULKDI3		;NO, BYPASS BIT
	MOVX T2,LCKDFF		;YES, MARK TABLE WORD AS FREE
	IORM T2,LDTBF(Q1)	;BUT LEAVE ENTRY IN TABLE
	MOVE T2,BITS(Q3)	;WAKE FORK UP
	ANDCAM T2,LCKDBT(T4)
	MOVE T1,T3		;FORK INDEX
	CALL UNBLKF		;UNBLOCK IT
	JRST ULKDI8		;UNLOCK TABLE AND RETURN
;MAP DIRECTORY INTO USUAL AREA AT DIRORG
;ACCEPTS IN A/	DIRECTORY NUMBER
;	    B/  STRUCTURE NUMBER
;	CALL MAPDIR
;RETURNS +1:	ERROR, NON-EXISTANT DIR OR DIR SCREWED UP
;	 +2:	DIRECTORY IS MAPPED (BUT NOT LOCKED)

MAPDIR::SE1CAL
	STKVAR <MAPDIN,MAPDIS,MAPCSH>
	MOVEM A,MAPDIN		;SAVE DIR # TO BE MAPPED
	MOVEM B,MAPDIS		;SAVE STRUCTURE NUMBER
	CAIGE B,STRN		;STRUCTURE NUMBER TOO HIGH ?
	SKIPGE B		; OR NEGATIVE ?
	RETBAD (DIRX1)		;INVALID STRUCTURE #
	SKIPLE A		;ZERO OR NEGATIVE IS FATAL
	CAML A,MXDIRN		;IS THIS A LEGAL DIR #?
	RETBAD (DIRX1)		;NO, GIVE ERROR RETURN
	CALL UNMAPD		;UNMAP PREVIOUS DIR
	MOVE A,MAPDIS		;GET STRUCTURE NUMBER
	CALL MAPIDX		;GO MAP INDEX TABLE FOR THIS STRUCTURE
	 RETBAD			;COULD NOT MAP INDEX TABLE
	MOVE A,MAPDIN		;GET DESIRED DIR #
	CAIN A,ROOTDN		;IS THIS THE ROOT DIR BEING ASKED FOR
	JRST [	MOVE A,MAPDIS	;GET STRUCTURE NUMBER
		MOVE A,STRTAB(A) ;GET SDB ADDRESS
		LOAD A,STRRDO,(A) ;GET OFN OF ROOT-DIRECTORY
		SETZRO DRROF	;INDICATE UNMAPD SHOULD NOT RELEASE OFN
		JRST MAPDI2]	;SKIP DOING AN ASOFN FOR ROOT DIR
	MOVEI D,DIRCSZ		;CHECK FOR CACHE SIZE
	JUMPE D,MAPASO		;NO CACHE
	MOVEI B,DIRCSH		;GET CACHE TABLE
	MOVE C,MAPDIS		;GET STRUCTURE NUMBER
	MOVE C,STRTAB(C)	;GET TABLE POINTER
	HLL C,SDBFLK(C)		;GET UNIQUE CODE
	HRR C,MAPDIS
	LOCK DIRCLK		;LOCK CACHE TABLE
MAPDL:	CAME A,DCDIRN(B)	;CHECK FOR DIRECTORY MATCH
	JRST MAPNOF		;NOT THIS ONE
	CAME C,DCSTRN(B)	;CHECK STRUCTURE NUMBER
	JRST MAPNOF		;NOPE HERE EITHER
	AOS DCSHRC(B)		;UPDATE OFN IN USE COUNT
	MOVE C,TODCLK		;SET TIME LAST USED
	MOVEM C,DCSTIM(B)
	SETZRO DRROF		;INSURE WE DON'T RELEASE THIS ONE
	MOVEM B,MAPCSH		;SAVE CACHE ENTRY ADDRESS
	CALL GETIDX		;SEE IF THERE IS AN IDX ENTRY
	JRST [	MOVE B,MAPCSH	;GET ENTRY BACK
		CALL MAPFGX	;AND RELEASE IT
		UNLOCK DIRCLK
		RET]		;RETURN
	MOVE B,MAPCSH		;GET CACHE ENTRY
	MOVE A,DCSOFN(B)	;GET OFN
	TXNE D,IDX%IV		;CHECK TO SEE IF LEGAL
	JRST [	MOVEI A,DIRX3	;ILLEGAL FOR DELETED DIRECTORY
		CALL MAPFGX	;RELEASE OFN
		UNLOCK DIRCLK
		RET]		;RETURN
	UNLOCK DIRCLK		;UNLOCK CACHE
	JRST MAPDI0

MAPNOF:	ADDI B,DCSIZE		;LOOK AT NEXT ENTRY
	SOJG D,MAPDL	
	UNLOCK DIRCLK		;UNLOCK DIRECTORY CACHE
MAPASO:	CALL GETIDX
	RETBAD
	TXNE D,IDX%IV		;INVALID?
	RETBAD (DIRX3)		;YES, FAIL
	MOVE A,B		;GET ADDRESS OF INDEX BLOCK
	TXO A,FILWB+THAWB+OFNDUD ;WRITE, THAWED, AND NO AUTO-UPDATE
	MOVE B,MAPDIS		;GET STRUCTURE NUMBER
	CALL ASROFN		;ASSIGN AN OFN FOR THIS FILE
	 RETBAD ()		;ERROR, NONE AVAILABLE
	MOVEI B,DIRCSH		;GET CACHE ADDRESS
	MOVEI C,DIRCSZ		;GET SIZE OF CACHE
	JUMPE C,[ SETONE DRROF	;INDICATE UNMAP SHOULD RELEASE OFN
		 JRST MAPDI2]
	
	LOCK DIRCLK		;LOCK CACHE LOCK
	MOVE D,TODCLK		;START WITH CURRENT TIME
	SETZM MAPCSH		;INDICATE NONE FOUND YET
MAPELP:	SKIPN DCDIRN(B)		;QUICK CHECK FOR FREE ENTRY
	JRST [	MOVEM B,MAPCSH	;SAVE CACHE ENTRY ADDRESS
		JRST MAPFIN]	;AND QUIT
	SKIPE DCSHRC(B)		;CHECK TO SEE IF DORMANT ENTRY
	JRST [	SOSE DCSHRC(B)	;CHECK TO SEE IF ENTRY IS 1 SINCE WE CAN RELEASE THIS CASE
		AOSA DCSHRC(B)	;NO GET IT BACK TO THE OLD STATE
		AOSA DCSHRC(B)
		JRST MAPELN	;TRY NEXT ENTRY THIS ONE CAN'T BE BOTHERED
		JRST .+1]	;WORK ON THIS ENTRY
	CAMGE D,DCSTIM(B)	;CHECK TIME
	JRST MAPELN		;NOT OLDEST TRY NEXT ONE
	MOVE D,DCSTIM(B)	;SET NEW OLDEST
	MOVEM B,MAPCSH		;SAVE POINTER TO THIS ONE
MAPELN:	ADDI B,DCSIZE		;GO TO NEXT ENTRY
	SOJG C,MAPELP		;GO ON TO NEXT ONE
	
	SKIPN B,MAPCSH		;CHECK TO SEE IF ENTRY FOUND
;**;[1955] Change 1 line at MAPELN:+4L	PED	13-OCT-81
	JRST [	SETONE DRROF	;[1955] INDICATE TO RELEASE THIS
		UNLOCK DIRCLK	;RELEASE LOCK
		JRST MAPDI2]
MAPFIN:	EXCH A,DCSOFN(B)	;SET NEW OFN
	MOVE C,TODCLK		;SET NEW TIME
	MOVEM C,DCSTIM(B)	;STORE NEW TIME
	JUMPE A,MAPDRO		;DON'T RELEASE IF THERE IS NONE
	SKIPN DCSHRC(B)		;DON'T RELEASE IT IF IT WAS 1 (NOTE
				;HERE IT IS EITHER 0 OR 1)
	CALL RELOFN		;RELEASE OFN
MAPDRO:	MOVE B,MAPCSH		;GET CACHE ENTRY
	MOVEI C,1		;SET SHARE COUNT TO 1
	MOVEM C,DCSHRC(B)
	MOVE C,MAPDIN		;GET DIRECTORY ENTRY
	MOVEM C,DCDIRN(B)	;SAVE IT
	MOVE C,MAPDIS		;GET DIRECTORY NUMBER
	MOVE C,STRTAB(C)	;NEED UNIQUE CODE
	MOVE C,SDBFLK(C)
	HRR C,MAPDIS		;GET FULL UNIQUE CODE
	MOVEM C,DCSTRN(B)	;SAVE STRUCTURE UNIQUE CODE
	MOVE A,DCSOFN(B)	;GET OFN
	UNLOCK DIRCLK		;UNLOCK CACHE
MAPDI0:	MOVEM B,DIRCAD		;STORE CACHE ADDRESS
MAPDI2:	STOR A,DIROFN		;SAVE THIS OFN
	SKIPE EXADDR		;CHECK FOR EXTENDED ADDRESSING
	JRST [	CALL MAPDRP	;MAP DIRECTORY PAGE
		JRST MAPDI1]
	HRLZS A			;SET UP OFN.PN
	MOVX B,PTRW+PM%IND	;READ WRITE ACCESS, INDIRECT PTRS
	IOR B,DIRORA		;ADD IN BASE ADDRESS FOR MAPPING INTO
	MOVE C,NDIRPG		;GET # OF PAGES IN DIRECTORY
	CALL MSETMP		;MAP IN THE DIR
MAPDI1:	MOVE A,MAPDIN		;RESTORE DIRECTORY NUMBER

BP$022:				;BREAKPOINT FOR ASOFN FOR DIRECTORIES
				;ASSUMES T1 HAS DIRECTORY# AND OFN IS
				;IN DIROFN USUALLY, IN RDOFN IF T1=ROOTDN
	RETSKP			;AND EXIT
;ROUTINE TO CLEAR CACHE OF A SPECIF ENTRY IF SHARE COUNT IS 0 OR 1
MAPFGX:	SAVET			;SAVE ACS
	MOVE A,DCSHRC(B)	;GET SHARE COUNT
	SOJG A,R		;DON'T RELEASE UNLESS SHARE COUNT IS 0 OR 1
	JRST MAPFGC		;DO COMMON STUFF

;ROUTINE TO CLEAR CACHE OF A SPECIFIC ENTRY IF IT'S SHARE COUNT IS 0

MAPFGA:	SAVET			;SAVE AC'S
	SKIPE A,DCSHRC(B)	;GET SHARE COUNT
	RET			;DON'T RELEASE UNLESS SHARE COUNT IS  0
MAPFGC:	SETZ A,0		;ZERO OFN
	EXCH A,DCSOFN(B)	;GET OLD OFN
	JUMPE A,R		;IF NO OFN QUIT
	SETZM DCDIRN(B)		;CLEAR CACHE ENTRIES
	SETZM DCSTRN(B)
	SETZM DCSHRC(B)
	SETZM DCSTIM(B)
	CALL RELOFN		;RELEASE THE OFN
	RET			;GO BACK TO CALLER

;ROUTINE TO CLEAR CACHE OF NULL ENTRIES
DIRCFL::SAVET			;SAVE TEMPS
	MOVEI D,DIRCSZ		;CHECK CACHE SIZE
	JUMPE D,R		;QUIT NO CACHE
	MOVEI B,DIRCSH		;GET POINTER TO CACHE
DRFL1:	CALL MAPFGA		;RELEASE IT IF 0 
	ADDI B,DCSIZE		;LOOK AT NEXT ENTRY
	SOJG D,DRFL1		;NO TRY NEXT ONE
	RET			;RETURN
;MAPDRP -- DOES REAL MAP OF DIRECTORY PAGE TO SECTION 2
;ACCEPTS OFN IN A

MAPDRP:	MOVE B,SHRPTR		;MAKE A SHARE POINTER
	HRR B,A			;POINT TO OFN
	MOVEM B,DRMAP		;SET SHARE POINTER IN PSB
	CALL UPSHR		;INCREMENT OFN SHARE COUNT
	CALLRET MONCLA		;CLEAR HARDWARE PAGE TABLE AND RETURN



;ROUTINE TO UNMAP A DIRECTORY FOR A FORK
;	CALL UNMAPD
;RETURNS +1:	ALWAYS

UNMAPD::SE1CAL
	SKIPE EXADDR		;CHECK FOR EXTENDED ADDRESSING (SEC2)
	JRST [	HRRZ A,DRMAP	;GET OFN
		SKIPE A		;SKIP IF NO OFN
		CALL RELOFN	;DECREMENT OFN SHARE COUNT
		SETZM DRMAP	;CLEAR MAP SHARE POINTER
		CALL MONCLA	;CLEAR HARDWARE PAGE TABLE
		JRST UNMAP1]	;AND CONTINUE
	MOVEI A,0		;CLEAR OUT PREVIOUS DIRECTORY PAGES
	MOVE B,DIRORA		;GET STARTING ADDRESS OF MAPPED DIR
	MOVE C,NDIRPG		;GET NUMBER OF PAGES IN DIR
	CALL MSETMP		;UNMAP THE OLD PAGES (IF ANY)
UNMAP1:	LOAD A,DIROFN		;GET THE LAST OFN
	JUMPE A,R		;IF NONE, RETURN NOW
	SETZ B,0		;FREE DIRCAD ALWAYS
	EXCH B,DIRCAD		;GET OLD CACHE POINTER
	JUMPE B,UNMAP2		;NONE ALL DONE
	LOCK DIRCLK		;LOCK CACHE
	CAME A,DCSOFN(B)	;IS THIS THE SAME OFN?
	JRST [	UNLOCK DIRCLK	;NO -- UNLOCK CACHE
		JRST UNMAP3]	;RELEASE THE OFN
	SOS DCSHRC(B)		;UPDATE THE LOCK COUNT
	UNLOCK DIRCLK		;RELEASE LOCK
	RET			;QUIT

UNMAP2:	JE DRROF,,R		;IF NOT RELEASING OFN, RETURN
UNMAP3:	SETZRO DIROFN		;CLEAR OUT OFN FROM PSB
	SETZRO DRROF		; AND FLAG FOR RELEASING OFN
	CALL RELOFN		;RELEASE THE OFN
	RET			;AND RETURN
;ROUTINE TO SET THE NONX BIT IN STS AND FILSTS

;	CALL SETNXF
;RETURNS +1:	ALWAYS

SETNXF:	PUSH P,T1		;SAVE ALL ACS USED
	MOVX T1,NONXF		;GET BIT TO SET
	IORM T1,FILSTS(JFN)	;SET BIT
	TQO <NONXF>		;SET BIT IN STS ALSO
	JRST PA1		;RETURN RESTORING T1
;**;[1927] Change 1909 lines at SETNXF: +6L	JGZ	21-AUG-81
; Multiple directory device directory lookup routine
; Call:	A	;FULLWORD Directory number
;**;[1909] Change 1 line at SETNXF: +8L	JRG	16-JUL-81
;[1909]	B	;UNIT NUMBER (NOT USED FOR DISK) OR .RCUSR (IF FROM THERE)
;	C	;ADR OF BLOCK CONTAINING A WILD MASK (OR 0 IF NONE)
;	CALL MDDDIR
; Returns
;	+1	; Not used here, means non-directory device
;	+2	; No such directory
;	+3	; Ok, the directory is mapped and locked

;THE ALGORITHIM USED IS A PREORDER TRANSITION WHOSE STACK USAGE
;IS INDEPENDENT OF TREE HEIGHT. THE ALGORITHM IS NOT RECURSIVE IN
;THE CONVENTIONAL SENSE. BY USING A PREORDER TRANSITION AND BY HAVING
;UPWARD LINKS AVAILABLE FROM EACH NODE AND BY KNOWING THAT THERE IS
;A CONSTANT ORDERING FUNCTION AVAILABLE FOR THE SUBDIRECTORIES OF
;EACH DIRECTORY IT IS POSSIBLE TO WALK THE TREE WITH CONSTANT STACK
;CONSUMPTION. NOTE THAT IF DIRECTORIES ARE CREATED DURING A TRANSITION
;BY THIS CODE NO MALFUNCTION (LOOP) OCCURS. THE NEW DIRECTORY WILL
;EITHER BE TOUCHED OR NOT - NO CONFUSION RESULTS AS WOULD HAPPEN WITH
;MOST COMMON RECURSIVE ALGORITHMS.

MDDDIR::SE1CAL
	AOS 0(P)		;ALWAYS SKIPS AT LEAST ONCE
	SAVEQ
;**;[1909] Change 1 line at MDDDIR:+3L	JRG	16-JUL-81
	STKVAR <MDDDNO,MDDFLG,MDDDWS,MDDDPT,<MDDDNM,MAXLW>> ;[1909]
	MOVEM T1,MDDDNO		;SAVE ARGUMENT
;**;[1909] Add 4 lines at MDDDIR:+5L	JRG	16-JUL-81
	CAIN T2,.RCUSR		;[1909] CALL FROM .RCUSR?
	TDZA T2,T2		;[1909] YES
	MOVEI T2,1		;[1909] NO
	MOVEM T2,MDDFLG		;[1909] SAVE FLAG
	MOVEM T3,MDDDWS		;SAVE POINTER TO WILD MASK IF ANY
	TQNE <STEPF>		;STEPPING ANYTHING?
	TQNN <DIRSF>		;STEPPING DIRS?
	SKIPA			;NO TO EITHER QUESTION
	JRST MDDDI1		;YES TO BOTH QUESTIONS
	TXNN F1,DIRSF!NAMSF!EXTSF!VERSF	;NOTHING BEING STEPPED?
	TXNN F1,GNJFF		;AND DOING A GNJFN?
	SKIPA			;NO
	ERRJMP (GJFX32,MDDERT)	;YES, SAY NO MORE DIRECTORIES
	CALL SETDRR		;JUST SETUP REQUESTED DIRECTORY
	 JRST MDDERT		;COULDNT - GIVE ERROR
MDDDRT:	MOVE T1,MDDDNO		;RESTORE ARGUMENT
	RETSKP			;SUCCESS RETURN

MDDERT:	RETBAD()		;ERROR RETURN

;HERE WHEN STEPPING DIRECTORIES.
;FOR THE DIRECTORY SEARCHES BELOW, THE Q REGISTERS ARE USED AS FOLLOWS:
;Q1/ SYMBOL TABLE POINTER
;Q2/ POINTER TO CURRENT EXTENSION FDB
;Q3/ POINTER TO CURRENT GENERATION FDB
;ALL POINTERS ARE ABSOLUTE

MDDDI1:	TRNE T1,-1		;FIRST TIME?
	JRST MDDDI2		;NO
	HRRI T1,ROOTDN		;YES - BEGIN WITH THE ROOT
	MOVEM T1,MDDDNO		;SAVE CURRENT DIR
;**;[1927] Change 1909 lines at MDDDI1: +4L	JGZ	21-AUG-81
;**;[1909] Revamp code at MDDDI1:+4L	JRG	16-JUL-81
	MOVE T2,MDDFLG		;[1909] GET .RCUSR FLAG
;**;[1934] Change 2 lines at MDDDI1:+5L	JRG	28-AUG-81
	CALL @[IFIW!SETDIR	;[1909][1934]
	       IFIW!SETDRR](T2)	;[1909][1934] TRY TO MAP IT
	 JRST MDDDI2		;COULDNT - TRY REST OF TREE
	JRST MDDDRT		;SUCCESS
MDDDI2:	MOVE T1,MDDDNO		;GET CURRENT DIR
	CALL SETDIR		;MAP IT
	 JRST MDDERT		;ERROR - RETURN CODE IN T1
	MOVE T1,DIRORA		;GET DIR ORIGIN
	LOAD T1,DRSDC,(T1)	;GET COUNT OF SUBDIRECTORIES
	JUMPN T1,MDDDI8		;IF ANY EXIST, FIND ONE TO RETURN
MDDDI3:	CALL USTDIR		;NO SUBDIRECTORIES - FREE THIS ONE
MDDDI4:	HRRZ T1,MDDDNO		;ARE WE BACK UP TO THE ROOT?
	CAIN T1,ROOTDN		; ???
	ERRJMP (GJFX32,MDDERT)	;YES - GIVE NO MORE DIRECTORIES RETURN
	LSH T1,1		;NO - GET FDB AND SUPERIOR
	SKIPN T2,FKXORA		;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
	MOVE T2,IDXORA
	ADD T1,T2		; ...
	LOAD Q1,IDXFB,(T1)	;GET FDB OF CURRENT DIR
	ADD Q1,DIRORA		;AS ABSOLUTE ADDRESS
	LOAD T1,IDXSD,(T1)	;GET SUPERIOR
	HLL T1,MDDDNO		;BUILD FULLWORD DIR NUMBER
	MOVEM T1,MDDDNO		;SAVE AS SOON TO BE CURRENT DIR
	CALL SETDIR		;MAP SUPERIOR
	 JRST MDDERT		;ERROR - RETURN CODE IN T1
	MOVE T4,DIRORA		;COPY DIR NAME TO MDDDNM
	LOAD T4,DRNAM,(T4)	;GET POINTER TO NAME STRING IN DIR
	ADD T4,DIRORA		;GET ABS ADR
	MOVSI T3,(POINT 7,(T4),35) ;T3 IS POINTER TO NAME STRING
	MOVEI T2,MDDDNM		;GET ADR OF STRING BLOCK
	HRLI T2,(POINT 7,0)	;SET UP BYTE POINTER
	HRRZ T1,MDDDNO		;GET DIR NUMBER OF DIRECTORY
	CAIN T1,ROOTDN		;IS THIS THE ROOT DIRECTORY
	JRST MDDI4B		;YES, DONT PUT ITS NAME IN THE STRING
MDDI4A:	ILDB T1,T3		;COPY NAME TO MDDDNM STRING
	JUMPE T1,MDDI4B		;DONT COPY THE NULL
	IDPB T1,T2		;PUT CHAR IN STRING
	JRST MDDI4A		;LOOP BACK FOR REST OF THE STRING

MDDI4B:	MOVEM T2,MDDDPT		;SAVE POINTER TO END OF STRING
	MOVE T1,Q1		;COPY FDB ADDRESS
	CALL FDBCHK		;BLESS THIS FDB
	 JRST MDDDI3		;BAD FDB - GO UP A LEVEL AND RETRY
	LOAD T1,FBNAM,(Q1)	;GET CURRENT DIRECTORY RELATIVE NAME
	ADD T1,DIRORA		;AS ABSOLUTE ADDRESS
	LOAD T2,NMLEN,(T1)	;GET LENGTH OF BLOCK
	ADDI T1,1		;SKIP HEADER
	SUBI T2,2		;CORRECT FOR HEADER
	MOVEI T3,.ETNAM		;SEARCHING FOR A NAME BLOCK
	CALL LOOKUP		;FIND CURRENT DIRS NAME
	 JRST MDDDI3		;COULDNT - TRY UP ONE LEVEL
	MOVE T4,DRLOC		;GET POINTER INTO SYMBOL TABLE
	EXCH T4,Q1		;INTO Q1 AND GET CURRENT DIR FDB IN T4
MDDDI5:	LOAD Q2,SYMAD,(Q1)	;GET FIRST FDB OF THIS NAME
	ADD Q2,DIRORA		;AS AN ABSOLUTE ADDRESS
MDDDI6:	MOVE Q3,Q2		;START GENERATION SEARCH HERE
MDDDI7:	CAMN T4,Q3		;FDB WE ARE LOOKING FOR?
	JRST MDDDIC		;YES - NOW CONTINUE SCAN FOR OTHER DIRS
	LOAD Q3,FBGNL,(Q3)	;NO - GET NEXT GENERATION FDB
	ADD Q3,DIRORA		;ABSOLUTE ADDRESS
	CAME Q3,DIRORA		;ANY MORE?
	JRST MDDDI7		;YES
	LOAD Q2,FBEXL,(Q2)	;NO - TRY NEXT EXTENSION
	ADD Q2,DIRORA		;ABSOLUTE ADDRESS
	CAME Q2,DIRORA		;WAS THERE ONE?
	JRST MDDDI6		;YES
	ADDI Q1,.SYMLN		;NO - TRY NEXT ENTRY IN SYMBOL TABLE
	MOVE T1,DIRORA		;IS THIS
	LOAD T1,DRSTP,(T1)	;THE TOP OF THE
	ADD T1,DIRORA		;SYMBOL TABLE?
	CAML Q1,T1		; ???
	JRST MDDDI3		;YES - TRY UP A LEVEL
	LOAD T1,SYMET,(Q1)	;STILL IN NAME PORTION
	CAIE T1,.ETNAM		;OF SYMBOL TABLE?
	JRST MDDDI3		;NO
	JRST MDDDI5		;YES - LOOK IN THIS SET OF FDBS
;HERE WHEN THE CURRENT DIRECTORY HAS SUBDIRECTORIES. START LOOKING
;FOR THEM IN THE SYMBOL TABLE.

MDDDI8:
;COPY THE DIRECTORY STRING TO THE STACK FOR CHKWLD
	MOVE T4,DIRORA		;COPY DIR NAME TO MDDDNM
	LOAD T4,DRNAM,(T4)	;GET POINTER TO NAME STRING IN DIR
	ADD T4,DIRORA		;GET ABS ADR
	MOVSI T3,(POINT 7,(T4),35) ;T3 IS POINTER TO NAME STRING
	MOVEI T2,MDDDNM		;GET ADR OF STRING BLOCK
	HRLI T2,(POINT 7,0)	;SET UP BYTE POINTER
	HRRZ T1,MDDDNO		;GET DIR NUMBER OF DIRECTORY
	CAIN T1,ROOTDN		;IS THIS THE ROOT DIRECTORY
	JRST MDDI8B		;YES, DONT PUT ITS NAME IN THE STRING
MDDI8A:	ILDB T1,T3		;COPY NAME TO MDDDNM STRING
	JUMPE T1,MDDI8B		;DONT COPY THE NULL
	IDPB T1,T2		;PUT CHAR IN STRING
	JRST MDDI8A		;LOOP BACK FOR REST OF THE STRING

MDDI8B:	MOVEM T2,MDDDPT		;SAVE POINTER TO END OF STRING
	MOVE Q1,DIRORA		;GET BOTTOM OF
	LOAD Q1,DRSBT,(Q1)	;SYMBOL TABLE
	ADD Q1,DIRORA		;AS AN ABSOLUTE ADDRESS
	ADDI Q1,.SYMLN		;SKIP HEADER ENTRY
MDDDI9:	LOAD Q2,SYMAD,(Q1)	;GET FDB FOR THIS SYMTAB ENTRY
	ADD Q2,DIRORA		;ABSOLUTE ADDRESS
	MOVE T1,Q2		;GET FDB ADDRESS
	CALL FDBCHK		;MAKE SURE THIS FDB IS VALID
	 JRST MDDDC0		;NOT. SKIP IT
MDDDIA:	MOVE Q3,Q2		;START GENERATION SEARCH HERE
MDDDIB:	MOVE T1,Q3		;GET FDB ADDRESS
	CALL FDBCHK		;VALIDATE IT
	 JRST MDDDC1		;NOT VALID. SKIP IT
	JN FBDIR,(Q3),MDDDID	;IS THIS FDB A DIRECTORY?
MDDDIC:	LOAD Q3,FBGNL,(Q3)	;NO - TRY NEXT
	ADD Q3,DIRORA		;GET ABSOLUTE ADDRESS
	CAME Q3,DIRORA		;IS THERE ANOTHER?
	JRST MDDDIB		;YES - EXAMINE IT
MDDDC1:	LOAD Q2,FBEXL,(Q2)	;NO - TRY NEXT EXTENSION
	ADD Q2,DIRORA		;ABSOLUTE ADDRESS
;**;[2986]	Add 3 lines at MDDDC1+2		YKT	JUL-06-83
	MOVE T1,Q2		;[2986] GET THE ADDRESS
	CALL ADRCHK		;[2986] MAKE SURE THE ADDRESS IS VALID
	 JRST MDDDC0		;[2986] NO, NOT VALID. SKIP THIS FILE
	CAME Q2,DIRORA		;YET ANOTHER EXTENSION?
	JRST MDDDIA		;YES
MDDDC0:	ADDI Q1,.SYMLN		;NO - TRY NEXT SYMTAB ENTRY
	MOVE T1,DIRORA		;CHECK IF
	LOAD T1,DRSTP,(T1)	;PAST THE END
	ADD T1,DIRORA		;OF THE SYMBOL TABLE
	CAML Q1,T1		; ???
	 JRST MDDDI3		;YES - NO MORE SUBDIRS OF THIS DIR
	LOAD T1,SYMET,(Q1)	;STILL WITHIN BOUND,
	CAIE T1,.ETNAM		;STILL IN NAME PORTION OF SYMTAB?
	JRST MDDDI3		;NO - HENCE UP A LEVEL
	JRST MDDDI9		;YES - EXAMINE THESE FILES
;HERE WHEN A FDB WITH FB%DIR IS FOUND. SEE IF IT CAN BE RETURNED.

MDDDID:	LOAD T1,FBDRN,(Q3)	;GET DIR NUMBER OF POSSIBLE SUBDIR
	JUMPE T1,MDDDIC		;IF NONE, KEEP LOOKING
	MOVE T2,T1		;GET IDXTAB ENTRY
	LSH T2,1		; ...
	SKIPN T4,FKXORA		;GET SPECIAL FORK IDXORA IF STR CREATION
	MOVE T4,IDXORA
	ADD T2,T4		; ...
	LOAD T2,IDXSD,(T2)	;GET SUPERIOR DIRECTORY
	HRRZ T3,MDDDNO		;CHECK AGAINST CURRENT DIR
	CAME T2,T3		;SAME?
	JRST MDDDIF		;NO
MDDDIE:	CAIN T1,ROOTDN		;ROOT DIR?
	JRST MDDDIC		;IGNORE LOOP IN DIR STRUCTURE
	LOAD T4,FBNAM,(Q3)	;GET POINTER TO NAME BLOCK
	ADD T4,DIRORA		;GET ABS ADR OF NAME BLOCK
	MOVSI T3,(POINT 7,(T4),35) ;T3 IS BYTE POINTER TO NAME
	MOVE T2,MDDDPT		;GET POINTER TO END OF NAME STRING
;DON'T COPY A DOT IF ROOT-DIRECTORY BECAUSE ITS NAME WASN'T COPIED
	MOVE T1,DIRORA
	LOAD T1,DRNUM,(T1)
	CAIE T1,ROOTDN
	SKIPA T1,["."]		;PUT IN A "DOT"
MDDIE1:	ILDB T1,T3		;GET NEXT CHAR OF NAME
	IDPB T1,T2		;STORE NEXT CHAR INTO STRING
	JUMPN T1,MDDIE1		;LOOP BACK TIL STRING IS COMPLETE
	MOVE T2,MDDDWS		;GET ADR OF WILD STRING
	JUMPE T2,MDDIE2		;IF NONE, DONT CALL CHKWLD
	MOVEI T1,MDDDNM		;GET BYTE POINTER TO NAME BLOCK
	HRLI T1,(POINT 7,0)	;...
	CALL CHKWLD		;GO SEE THIS DIRECTORY IS A MATCH
	 JRST [	JUMPE T1,MDDDIC	;NOT A MATCH, GO STEP TO NEXT DIR
		LOAD T1,FBDRN,(Q3) ;STRING IS A SUBSET
		HRRM T1,MDDDNO	;GO MAP THIS DIR AND LOOK DOWN THE TREE
		CALL USTDIR	;UNLOCK THE SUPERIOR
		JRST MDDDI2]	;GO LOOK DOWN THE TREE
MDDIE2:	LOAD T1,FBDRN,(Q3)	;GET DIRECTORY NUMBER AGAIN
	HRRM T1,MDDDNO		;MAKE CURRENT
	CALL USTDIR		;RELEASE SUPERIOR
	MOVE T1,MDDDNO		;ATTEMPT TO MAP NEW CURRENT DIR
;**;[1927] Change 1909 lines at MDDIE2: +4L	JGZ	21-AUG-81
;**;[1909] Revamp code at MDDIE2:+4L	JRG	16-JUL-81
	MOVE T2,MDDFLG		;[1909] GET .RCUSR FLAG
;**;[1934] Change 2 lines at MDDIE2:+5L	JRG	28-AUG-81
	CALL @[IFIW!SETDIR	;[1909][1934]
	       IFIW!SETDRR](T2)	;[1909][1934]
	 JRST MDDDI2		;COULDNT
	JRST MDDDRT		;ALL OK, RETURN THIS DIR

;HERE WHEN IDXTAB DOES NOT HAVE A CORRECT BACK POINTER

MDDDIF:	JUMPN T2,MDDDIC		;NULL ENTRY?
	MOVX T4,FB%LNG		;IS THIS A LONG FILE?
	TDNE T4,.FBCTL(Q3)	; ???
	JRST [	BUG(LNGDIR,<<T3,D>>)
		JRST MDDDIC]	;IGNORE IT
	MOVE T4,T3		;COPY SUPERIOR
	LOAD T3,FBADR,(Q3)	;GET XB ADDRESS
	MOVE T2,Q3		;GET FDB ADDRESS
	SUB T2,DIRORA		;AS A RELATIVE ADDRESS
	CALL SETIDX		;ATTEMPT TO SETUP INDEX
	 JRST MDDDIC		;FAILED
	LOAD T1,FBDRN,(Q3)	;GET DIRNUM BACK
	JRST MDDDIE		;AND RETURN IT



;SETUP DIRECTORY AND CHECK FOR LEGAL READ ACCESS
;ACCEPTS:	1/FULLWORD DIR NUMBER
;RETURNS:	+1 NO ACCESS. DIRECTORY NOT LOCKED
;		+2 ACCESS ALLOWED. DIR LOCKED

SETDRR::SE1CAL
	CALL SETDIR		;SET DIRECTORY
	 RETBAD (GJFX36)	;PROBABLY SICK
	MOVX B,DC%RD		;B/READ ACCESS
	CALL DIRCHK		;CHECK FOR READ ACCESS TO THIS DIRECTORY
	 JRST [	CALL USTDIR	;NOT LEGAL
		MOVEI A,GJFX35
		RET]
	RETSKP
; Multiple directory device name lookup routine
; Call:	A	; Lookup pointer
;	DIRORG	; The correct subdirectory, locked and psi off
;	JRST MDDNAM
; Return
;	+1	; Match is impossible
;	+2	; Ambiguous
;	+3	; Success, if nrec&nrec1 are 0, the remainder if any
;		; Is appended to the string addressed by filopt(jfn)

MDDNAM::SE1CAL
	JUMPE A,MDDSTP		;ZERO MEANS GET FIRST NAME IN DIR
	HLRE B,A		;GET # OF WORDS IN STRING
	MOVNS B
	MOVEI A,1(A)		;GET STARTING ADR OF STRING
	MOVEI C,.ETNAM		;LOOKUP A NAME
	CALL LOOKUP
	 JRST NAMFND		;EXACT MATCH NOT FOUND
	TQNE <STEPF>		;STEPPING?
	TQNN <NAMSF>		;YES, STEPPING NAME FIELD?
	JRST NAMLK9		;NO
MDDSN1:	AOS DRLOC		;STEP TO NEXT SYMBOL
	AOS B,DRLOC		;Location in symtab of next after match
	MOVE D,DIRORA		;GET BASE OF DIRECTORY
	LOAD A,DRSTP,(D)	;GET TOP OF SYMBOL TABLE
	ADD A,DIRORA
	CAML B,A		;ARE WE AT TOP OF SYMBOL TABLE?
	JRST [	MOVEI A,GJFX18	;NO, NONE LEFT
		JRST ERRET]
	LOAD C,SYMVL,(B)	;GET THE VALUE
	CAMN C,[-1]		;IS THIS THE SYMBOL TABLE HEADER
	JRST MDDNA1		;YES, SYMBOL TABLE IS FOULED UP
	LOAD C,SYMET,(B)	;GET ENTRY TYPE OF NEXT SYMBOL
	CAIE C,.ETNAM		;STILL LOOKING AT NAME SYMBOLS?
	 JRST [	MOVEI A,GJFX18	;NO, Then fail
		JRST ERRET]	;None left
	LOAD C,SYMAD,(B)	;GET POINTER TO FDB
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	MOVE A,C		;SEE IF THERE IS AN EXISTING FILE
	CALL NAMSCN		;  WITH THIS NAME
	 JRST MDDSN1		;THERE ISNT, GO STEP NAME AGAIN
	LOAD D,FBNAM,(C)	;GET POINTER TO NAME STRING
	ADD D,DIRORA
	MOVSI A,(POINT 7,0(D),35)
	JRST UNIQL1		;Copy new name to filopt

MDDNA1:	MOVE A,DIRORA		;GET DIR NUMBER
	LOAD A,DRNUM,(A)	; FOR SYSERR BLOCK
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRSY2,<<A,D>,<B,D>>)
MDDNA2:	MOVEI A,GJFX36		;SMASHED DIR
	JRST ERRET		;BOMB OUT
NAMLK9:	MOVE B,DRLOC		;GET POINTER TO SYMBOL
	LOAD A,DIRLA,(B)	;GET ADDRESS OF FDB
	ADD A,DIRORA		;MAKE ABSOLUTE ADDRESS
NAMLKM:	CALL FDBCHK		;MAKE SURE THIS IS A GOOD FDB
	 JRST MDDNA2		;NO
	CALL NAMSCN		;SEE IF THERE IS A NON-DELETED FILE
	 JRST [	MOVEI A,GJFX18	;NO, DONT FIND THIS NAME
		TQNE <NREC,NREC1> ; DOING RECOGNITION?
		JRST ERRET	; NO, DON'T FIND THIS NAME
		JRST NAMFN1]	; YES, LOOK FOR LONGER PARTIAL MATCH
NAMLK1:	TQNE <UNLKF>
	JRST SK2RET		;Do not unlock directory
	CALL USTDIR
	JRST SK2RET

MDDSTP:	MOVE D,DIRORA		;GET POINTER TO JUST BELOW FIRST SYMBOL
	LOAD B,DRSBT,(D)	;...
	ADD B,DIRORA		;MAKE ADDRESS BE ABSOLUTE
	MOVEM B,DRLOC
	JRST MDDSN1		;GO STEP DRLOC

NAMFND:	TQNE <NREC,NREC1>	;Is recognition being performed
	JRST NEWNAM		;No. try to insert a new name
	MOVEI A,GJFX18
	TQNN <MTCHF>		;Yes, did at least one string match?
	JRST ERRET		;Error return, no match possible
NAMFN1:	TQZ <MTCHF>		; Redetermine flags, checking
	TQZ <AMBGF>		; invisible status
	MOVE B,DRLOC		; Now check file name
	MOVEM B,DRSCN		; Initial symbol in scan of subsets
NAMTST:	LOAD A,SYMAD,(B)	; Get FDB address
	ADD A,DIRORA		; Make it absolute
	CALL NAMSCN		; Check FDB chain
	 JRST NAMNXT		; Only del./ invis. files--keep looking
	MOVEM B,DRLOC		; For non-deleted visible file
	TQON <MTCHF>		; Flag non-deleted visible file
	 JRST NAMNXT		; First found--keep looking
	TQO <AMBGF>		; Second found--ambiguous
	MOVEI A,GJFX18
	JRST AMBRET

NAMNXT:	ADDI B,.SYMLN		;Point b to following entry
	MOVEM B,DRSCN		; New scan symbol pointer
	MOVE A,DIRORA		;GET SYMTOP TO SEE IF ANY MORE SYMBOLS
	LOAD A,DRSTP,(A)
	ADD A,DIRORA		;GET ABS ADR
	CAML B,A		;If above top,
	JRST UNIQUE		; Have found at most one FDB
	CALL NAMCMM		;Compare strings
	 JUMPN A,UNIQUE		; Out of subsets
	MOVE B,DRSCN		; Pointer to current symbol
	JRST NAMTST		; Subset: check it out

AMBRET:	TQNN <UNLKF>		;Ambiguity is failure if unlkf
	AOS (P)
ERRET:	CALL USTDIR
	RET
UNIQUE:	MOVEI A,GJFX18
	TQNN <MTCHF>		; Non-deleted, visible match found?
	JRST ERRET		; No
;**;[3161]  Replace the 7 lines removed by 3151		DML	7-Sep-84
;**;[3151]  Remove 7 lines at UNIQUE:+3			DML	23-Aug-84
	MOVE A,DRLOC		;NOW SEE IF LIST ACCESS NOT ALLOWED
	LOAD A,DIRLA,(A)	;GET FDB ADR
	ADD A,DIRORA
	MOVX B,FC%DIR		;SINCE RECOGNITION BEING DONE, CHECK ACCESS
	CALL ACCCHK		;DONT DO RECOGNITION ON NO LIST FILES
	 JRST [	MOVEI A,GJFX18
		JRST AMBRET]	;RETURN AMBIGUOUS SO BELL WILL RING
	MOVE B,DRLOC		;Location in symtab of matching entry
	LOAD C,DIRLA,(B)	;GET FDB ADDRESS
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	LOAD D,FBNAM,(C)	;GET POINTER TO NAME STRING
	ADD D,DIRORA
UNIQU1:	MOVN A,DRINP		;Start of input string
	ADD A,FILOPT(JFN)	;End of input rELATIVE to beginning
	AOS A			;POINT TO FIRST WORD IN STRING
	TLO A,D			;ADD INDEX REGISTER TO BYTE POINTER
	LDB C,A			;GET FIRST CHAR TO BE COPIED
	DPB C,FILOPT(JFN)	;STORE IN JFN BLOCK
UNIQL1:	ILDB C,A		;Copy tail to input string
	JUMPE C,[MOVE A,FILOPT(JFN)
		IDPB C,A
		JRST NAMLK9]	;Terminate with null
	IDPB C,FILOPT(JFN)
	JRST UNIQL1		;LOOP UNTIL TAIL IS COPIED
NEWNAM:	SKIPG DRINL		;ANY FULL WORDS
	SKIPE DRMSK		;NO, IS THIS A NULL NAME?
	JRST NEWNA1		;NO
	MOVEI A,GJFX33		;YES
	JRST ERRET		;Null names not allowed
NEWNA1:	MOVEI A,GJFX24
	TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
	TQNE <OLDNF>		;Are new names ok?
	JRST NEWNA2		;No new names, error return
	MOVX B,DC%CF		;B/CREATE-FILE ACCESS
	CALL DIRCHK		;CHECK FOR ABILITY TO ADD FILES TO DIRECTORY
	JRST [	MOVEI A,GJFX35	;NO, GIVE ERROR RETURN
		JRST ERRET]
	TQO <NEWF>		;Remember we entered a new file name
	MOVEI B,.FBLEN
	CALL ASGDFR		;Assign space for fdb
	 JRST [	MOVEI A,GJFX23	;NO ROOM IN DIR FOR FDB
		JRST ERRET]
	CALL FDBINI		;Initialize fdb
	SETONE <FBNEX,FBNXF>,(A) ;SET NON-EXISTENT AND NO-EXTENSION
	PUSH P,A		;Save loc of fdb
	CALL CPYDIR		;Copy the input string into directory
	 JRST [	POP P,B		;FAILED, GIVE BACK FDB SPACE
		CALL RELDFA
		MOVEI A,GJFX23	;AND GIVE ERROR RETURN TO CALLER
		JRST ERRET]
	MOVEI C,.TYNAM
	STOR C,NMTYP,(A)	;Mark as string block for name
	MOVE C,0(P)		;GET FDB LOCATION
	LOAD B,NMVAL,(A)	;GET FIRST 5 CHARACTERS FOR SYMBOL TAB
	SUB A,DIRORA		;GET RELATIVE ADDRESS OF NAME STRING
	STOR A,FBNAM,(C)	;Store location of name string in fdb
	MOVE A,C		;GET ADDRESS OF FDB
	SUB A,DIRORA		;MAKE IT RELATIVE
	MOVEI C,.ETNAM		;THE ENTRY TYPE IS "NAME"
	CALL INSSYM		;INSERT THE NAME
	 JRST [	MOVE B,0(P)	;GET BACK THE FDB ADDRESS
		LOAD B,FBNAM,(B)
		SKIPE B		;DONT RELEASE IF NO NAME STRING
		CALL RELDFR	;RELEASE NAME STRING
		POP P,B
		CALL RELDFA	;RELEASE FDB AREA
		MOVEI A,GJFX23	;NO ROOM IN DIR
		JRST ERRET]
	POP P,(P)		;CLEAN UP THE STACK
	CALL SETNXF		;SET NONXF BIT IN STS AND FILSTS
	JRST NAMLK9		;GO GIVE SUCCESS RETURN

NEWNA2:	JRST ERRET		;NO, GIVE ERROR
;ROUTINE TO INSERT A SYMBOL INTO THE SYMBOL TABLE
;ACCEPTS IN A/	RELATIVE ADDRESS OF THE FDB OR STRING
;	    B/	VALUE OF THE SYMBOL (FIRST 5 CHARACTERS)
;	    C/	ENTRY TYPE
;	    DRLOC POINTING AT LOCATION IN SYMBOL TABLE
;	CALL INSSYM
;RETURNS +1:	COULD NOT EXPAND THE SYMBOL TABLE
;	 +2:	OK

INSSYM:	STKVAR <INSSYV,INSSYT,INSSYA>
	MOVEM A,INSSYA		;SAVE ADR
	MOVEM B,INSSYV		;SAVE VALUE
	MOVEM C,INSSYT		;SAVE ENTRY TYPE
INSSY0:	MOVE D,DIRORA		;SET UP BASE ADDRESS
	LOAD A,DRSBT,(D)	;GET SYMBOT
	SUBI A,.SYMLN		;SEE IF THERE IS ROOM
	LOAD B,DRFTP,(D)	;GET FREE TOP
	CAMGE A,B		;IS THERE ROOM?
	JRST [	CALL XPAND	;NO, TRY TO EXPAND
		 RETBAD (GJFX23) ;NO ROOM
		JRST INSSY0]
	STOR A,DRSBT,(D)	;UPDATE NEW BOTTOM OF SYMBOL TABLE
	MOVE B,DRLOC		;GET PLACE IN SYMBOL TABLE
	SUBI B,.SYMLN		;PUT SYMBOL BELOW THIS
	MOVEM B,DRLOC		;STORE UPDATED DRLOC
	PUSH P,B		;SAVE B
	LOAD C,DRSBT,(D)	;GET DESTINATION OF BLT
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	MOVE A,B		;START COMPUTING LENGTH
	XMOVEI B,.SYMLN(C)	;SET UP SOURCE ADDRESS
	SUB A,C
	CALL XBLTA		;DO BLT
	POP P,B
INSSY1:	MOVE A,INSSYV		;GET VALUE
	STOR A,SYMVL,(B)	;STORE VALUE
	MOVE A,INSSYT		;GET ENTRY TYPE
	STOR A,SYMET,(B)
	MOVE A,INSSYA		;GET ADR
	STOR A,SYMAD,(B)	;SYMBOL IS NOW SET UP
	RETSKP			;RETURN SUCCESSFUL
; Multiple directory device extension lookup
; Call:	A	; Lookup pointer
;	B	; Pointer to start pointer (as left by mddnam)
;	JRST MDDEXT
; Return
;	+1	; No match
;	+2	; Ambiguous
;	+3	; Ok, the remaining string is appended to filopt(jfn)

MDDEXT::SE1CAL
	JUMPE A,MDDSTE		;Set to first extension
	MOVEM B,DRSCN		;Save loc of pointer
	CALL SETMSK		;Set up mask etc
	MOVE A,DRSCN		;Save location of pointer
	MOVEM A,DRLOC		;INITIALIZE POINTER TO FDB CHAIN
	LOAD A,DIRLA,(A)	;GET ADDRESS OF FIRST FDB IN CHAIN
	ADD A,DIRORA		;As absolute address
EXTLK1:	CALL FDBCHK		;CHECK THE FDB FOR CONSISTENCY
	 JRST MDDEXB		;NOT GOOD
	JN FBNEX,(A),NEWEXT	;NO EXTENSION YET?
	LOAD A,FBEXT,(A)	;GET POINTER TO EXTENSION STRING
	ADD A,DIRORA		;GET ABS ADR
	LOAD D,EXLEN,(A)	;GET LENGTH OF BLOCK
	MOVEI D,-2(D)		;GET # OF FULL WORDS
	AOS C,A			;POINT TO FIRST WORD OF STRING
	MOVE A,DRINP		;Get pointer to input
	MOVE B,DRINL		;GET NUMBER OF WORDS IN STRING
	CALL STWCMP		;Compare strings
	 JRST [	JUMPN A,EXTNEQ	;OTHER THAN SUBSTRING?
		JRST EXTSUB]	;NO, SUBSTRING
	TQNE <STEPF>		;EXACT MATCH
	TQNN <EXTSF>
	JRST EXTLKL
EXTLK2:	MOVE B,DRSCN		;Get loc of pointer
	LOAD B,DIRLA,(B)	;GET ADR OF NEXT FDB IN CHAIN
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	ADDI B,.FBEXL		;POINT TO THE LINK ITSELF
	;..
	;..
MDDSTE:	MOVEM B,DRSCN		;STORE POINTER TO LINK WORD
	MOVEM B,DRLOC		;UPDATE DRLOC ALSO
	LOAD A,DIRLA,(B)	;GET ADDRESS OF NEXT FDB
	JUMPE A,[MOVEI A,GJFX19	;END OF CHAIN?
		JRST ERRET]	;YES, None left
	ADD A,DIRORA		;GET ACTUAL ADR OF FDB
	CALL FDBCHK		;CHECK THE CONSISTENCY OF FDB
	 JRST MDDEXB		;NO GOOD
	JN FBNEX,(A),EXTLK2	;IF NO EXT, GO STEP TO NEXT FDB
	CALL EXTSCN		;MAKE SURE THERE IS A NON-DELETED FILE
	 JRST EXTLK2		;THERE ISNT, GO STEP TO NEXT EXT
	LOAD D,FBEXT,(A)	;GET ADDRESS OF EXTENSION STRING
	ADD D,DIRORA		;MAKE IT ABSOLUTE
	MOVSI A,(POINT 7,0(D),35)
	JRST UNIQL1		;GO COPY TAIL

MDDEXB:	MOVEI A,GJFX36		;SMASHED DIR
	JRST ERRET
EXTLKL:	MOVE B,DRSCN		;Exact match. get loc of pointer
	LOAD A,DIRLA,(B)	;GET FDB ADR OF EXTENSION
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CALL EXTSCN		; CHECK FOR NON-DEL, VISIBLE FILES
	 JRST [	MOVEI A,GJFX19	; NONE THERE
		TQNE <NREC,NREC1> ; DOING RECOGNITION?
		JRST ERRET	; NO
		JRST EXTSUB]	; YES, LOOK FOR LONGER PARTIAL MATCH
	CALL FDBCHK		; MAKE SURE OF GOOD FDB
	 JRST MDDNA2
	JRST NAMLK1		; DOUBLE SKIP RETURN & UNLOCK DIRECTORY

EXTSUB:	TQNE <NREC,NREC1>	;DOING RECOGNITION?
	JRST EXTNEQ		;NO
	MOVE B,DRSCN
	LOAD A,DIRLA,(B)	; Get FDB address
	ADD A,DIRORA		; Make it absolute
	CALL EXTSCN		; Check FDB chain
	 JRST EXTNXT		; Only del./invis. files--keep looking
	MOVEM B,DRLOC		; For non-deleted visible file
	TQON <MTCHF>		; Flag non-deleted visible file
	JRST EXTNXT		; First found--keep looking
	TQO <AMBGF>		; Second found--ambiguous
	MOVEI A,GJFX19
	JRST AMBRET

EXTNEQ:	JUMPL A,EXTFND		;GONE TOO FAR IN CHAIN?
	TQNE <NREC,NREC1>	;NO, DOING RECOGNITION?
	JUMPE A,EXTFND		;NO, STOP AT FIRST SUBSET
EXTNXT:	MOVE B,DRSCN		;GET POINTER TO FDB
	LOAD B,DIRLA,(B)	;GET ADDRESS OF FDB
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	ADDI B,.FBEXL		;POINT TO LINK WORD
	MOVEM B,DRSCN		;STORE NEW POINTER
	LOAD A,DIRLA,(B)	;GET ADDRESS OF NEXT FDB
	JUMPN A,[ADD A,DIRORA	;ANOTHER EXTENSION IS PRESENT
		JRST EXTLK1]
EXTFND:	TQNE <NREC,NREC1>
	JRST NEWEX1		;New extension
	MOVEI A,GJFX19
	TQNN <MTCHF>		; Non-deleted visible file found?
	JRST ERRET		; No
	MOVE B,DRLOC		; Yes
	LOAD C,DIRLA,(B)	;GET FDB ADDRESS
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	LOAD D,FBEXT,(C)	;GET ADDRESS OF EXTENSION STRING
	ADD D,DIRORA		;MAKE IT ABSOLUTE
	JRST UNIQU1		;And copy tail to input
NEWEX1:	MOVEI A,GJFX24
	TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
	TQNE <OLDNF>		;Are new files allowed?
	JRST NEWEX3
	MOVX B,DC%CF		;CREATE-FILE ACCESS
	CALL DIRCHK		;CHECK FOR ABILITY TO CREATE FILES
	JRST [	MOVEI A,GJFX35
		JRST ERRET]
	MOVEI B,.FBLEN
	CALL ASGDFR		;Get space for new fdb
	JRST [	MOVEI A,GJFX23
		JRST ERRET]
	CALL FDBINI		;Initialize the fdb
	MOVE B,DRLOC		;GET POINTER TO NEXT FDB
	LOAD B,DIRLA,(B)	;GET FDB ADR
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	EXCH A,B		;CHECK THIS FDB
	CALL FDBCHK		;TO AVOID PICKING UP GARBAGE
	 JRST [	MOVEI A,GJFX36	;DIR BAD
		JRST ERRET]	;BOMB OUT
	LOAD C,FBNAM,(A)	;GET POINTER TO NAME STRING
	STOR C,FBNAM,(B)	;MAKE NEW FDB POINT TO NAME STRING TOO
	PUSH P,B		;Save fdb location
	CALL CPYDIR		;Copy extension string to directory
	 JRST [	POP P,B		;NO ROOM TO PUT STRING INTO DIR
		CALL RELDFA	;RELEASE FDB STORAGE
		MOVEI A,GJFX23
		JRST ERRET]	;BOMB OUT WITH NO ROOM ERROR
	MOVEI C,.TYEXT
	STOR C,EXTYP,(A)	;MarK as string block for extension
	EXCH A,0(P)		;SAVE EXT STRING ADR AND GET FDB ADR
	MOVE B,DRSCN		;Location of last extension pointer
	LOAD C,DIRLA,(B)	;GET FDB ADR POINTED TO BY LAST EXT
	EXCH A,C		;CHECK THIS FDB ADR
	CALL FDBCHR
	 JRST [	MOVEI A,GJFX36	;DIR IS SCREWED UP
		JRST ERRET]
	EXCH A,C
	STOR C,FBEXL,(A)	;MAKE NEW FDB POINT DOWN THE CHAIN
	SUB A,DIRORA		;GET RELATIVE ADR OF NEW FDB
	CALL EFIXUP		;GO SET UP POINTERS TO NEW EXT
	CALL SETNXF		;GO SET NONXF IN STS AND FILSTS
	POP P,A
	JRST NEWEX2

NEWEX3:	JRST ERRET		;NO, GIVE ERROR RETURN
;ROUTINE TO FIX UP POINTERS TO A NEW EXT IN FDB CHAIN
;ACCEPTS IN A/	RELATIVE ADR OF NEW FDB
;	    B/	DIRLA POINTER TO TOP FDB OF EXT CHAIN
;	CALL EFIXUP
;RETURNS +1:	ALWAYS

EFIXUP:	CALL FDBCHR		;CHECK OUT FDB BEING STORED
	 RET			;DONT DO ANYTHING
	STOR A,DIRLA,(B)	;STORE TOP LEVEL POINTER ALWAYS
VFIXUP:	MOVE C,DIRORA		;GET BASE ADR OF MAPPED AREA
	LOAD C,DRSBT,(C)	;GET SYMBOT
	ADD C,DIRORA		;GET ABS ADR OF BOTTOM OF SYMBOL TABLE
	CAML B,C		;IS DIRLA POINTER WITHIN AN FDB?
	RET			;NO, IT IS IN THE SYMBOL TABLE
	SUBI B,.FBEXL		;GET ADDRESS OF FDB
	EXCH B,A		;PUT NEW FDB ADR INTO A
EFIXU1:	LOAD A,FBGNL,(A)	;GET POINTER TO NEXT GENERATION IN CHAIN
	JUMPE A,R		;IF 0, AT END OF CHAIN
	CALL FDBCHR		;SEE IF THIS IS A GOOD FDB
	 RET			;IT ISNT, RETURN
	ADD A,DIRORA		;GET ABSOLUTE ADR OF THIS FDB
	STOR B,FBEXL,(A)	;UPDATE POINTER TO NEXT EXTENSION
	JRST EFIXU1		;LOOP FOR ALL GENERATIONS ON CHAIN
NEWEXT:	TQNN <NREC,NREC1>
	JRST [	MOVEI A,GJFX19
		JRST ERRET]	;Recognition wanted
	TQNE <OLDNF>
	JRST [	MOVEI A,GJFX24
		JRST ERRET]	;No new files
	PUSH P,A
	CALL CPYDIR		;Copy string block into directory
	JRST [	MOVEI A,GJFX23
		JRST ERRET]
	MOVEI C,.TYEXT
	STOR C,EXTYP,(A)	;Mark as string block for extension
	POP P,C			;GET BACK ADR OF FDB BLOCK
	SETZRO FBNEX,(C)	;MARK THAT FILE HAS AN EXTENSION
NEWEX2:	MOVE B,DRSCN		;NOW PUT IN POINTER TO EXT STRING
	LOAD C,DIRLA,(B)	;GET FDB ADDRESS
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	SUB A,DIRORA		;MAKE POINTER TO EXT STRING RELATIVE
	STOR A,FBEXT,(C)	;STORE POINTER TO EXT INTO FDB
	TQO <NEWF>		;Remember this is a new file
	MOVE A,C		;LEAVE ABS ADR OF FDB IN A
	JRST NAMLK1		;Double skip return
;ROUTINE TO SCAN A FDB CHAIN LOOKING FOR A FILE THAT IS NOT DELETED
;ACCEPTS IN A/	ABSOLUT FDB ADR
;	CALL NAMSCN
;RETURNS +1:	NO VISIBLE, NON-DELETED FILE FOUND
;	 +2:	THERE IS AT LEAST ONE VISIBLE, NON-DELETED FILE WITH
;		THIS NAME

NAMSCN:	SAVET			;THIS ROUTINE CLOBBERS NO ACS
NAMSC1:	CALL EXTSCN		;SCAN THIS VERSION CHAIN
	 SKIPA A,.FBEXL(A)	;NONE ON THIS CHAIN, STEP TO NEXT EXT
	RETSKP			;A FILE WAS FOUND, RETURN OK
	JUMPE A,R		;IF AT END OF CHAIN, RETURN +1
	ADD A,DIRORA		;GET ABS ADR OF FDB
	JRST NAMSC1		;LOOP BACK TILL ONE FOUND


;ROUTINE TO SCAN A VERSION CHAIN LOOKING FOR A NON-DELETED FILE
;ACCEPTS IN A/	ABS FDB ADR
;	CALL EXTSCN
;RETURNS +1:	NO FILE FOUND
;	 +2:	AT LEAST ONE FILE WITH THIS NAME AND EXT IS VISIBLE
;		AND NOT DELETED

;**;[3161]  Remove all parts of edits 3151 and 3154	DML	7-Sep-84
EXTSCN:	TQNN <DIRSF,NAMSF,EXTSF,VERSF>	;STEPPING FILES?
	TQNE <OLDNF>		;OR OLD FILE ONLY?
	SKIPA			;YES
	RETSKP			;NO, ALLOW CREATING OF NEW NAMES
	SAVET			;CLOBBERS NO ACS
EXTSC1:	JN FBNXF,(A),EXTSC2	;IF NON-EXISTANT, STEP TO NEXT FDB
	TQNE <IGIVF>		; Finding invisible?
	 JRST EXTSC3		; Yes
	JN FBINV,(A),EXTSC2	; No, if invis., step to next FDB
EXTSC3:	TQNE <IGDLF>		;IF IGNORING DELETED BIT,
	RETSKP			;  THEN GIVE OK RETURN
	JE FBDEL,(A),RSKP	 ;IF FILE NOT DELETED AND EXISTS, RSKP
EXTSC2:	SKIPN A,.FBGNL(A)	;AT END OF CHAIN YET?
	RET			;YES, RETURN UNSUCCESSFUL
	ADD A,DIRORA		;GET ABS ADR OF FDB
	JRST EXTSC1		;LOOP BACK FOR NEXT VERSION IN CHAIN
; Multiple directory device version lookup routine
; Call:	A	; Desired version
;	B	; STARTING POINTER
;	DIRORG-	; The appropriate directory locked and psi off
;	JRST MDDVER
; Return
;	+1	; Version not found
;	+2	; Success version in a if unlkf=1
;		; Fdb address in a if unlkf=0
;		; FDB ADR IN B ALWAYS

MDDVER::SE1CAL
;**;[3161]  Remove all parts of edits 3151 and 3152	DML	7-Sep-84
;**;[3152]  Change 1 line of edit 3151			DML	27-Aug-84
;**;[3151]  Change 1 line at MDDVER:+1			DML	23-Aug-84
;**;[3140]  Change 1 line at MDDVER:+1			DML	24-JUL-84
STKVAR <MDDVRA,MDDVRT,MDDVRL,MDDVRF,MDDVFB>  ;[3161][3152][3151][3140]
MDDVR1:	HRRES A			;Extend sign
	MOVEM A,DRINP
	MOVEM B,MDDVRA		;SAVE POINTER TO TOP FDB IN GEN CHAIN
	MOVEM B,DRLOC
	SETZM MDDVRL		;INIT LAST VERSION NUMBER SEEN
	JUMPL A,[CAME A,[-2]	;LOWEST?
		CAMN A,[-1]	;OR A NEW ONE?
		JRST .+1	;YES. IS A GOOD VALUE
		MOVEI A,GJFX20	;NO. RETURN WITH ERROR
		JRST ERRET]	;ALL DONE
	LOAD D,DIRLA,(B)	;GET ADDRESS OF FDB OF FIRST GEN
	ADD D,DIRORA		;MAKE IT ABSOULTE
	EXCH A,D		;CHECK THE FDB
	CALL FDBCHK
	 JRST MDDVRB		;FDB IS BAD
	EXCH A,D
	CAMN A,[-2]		;WANT LOWEST VERSION?
	MOVEM D,DRLOC		;YES, SAVE STEPPED ADDRESS
	LOAD C,FBGEN,(D)	;GET GENERATION NUMBER FROM FDB
	JUMPE C,VERLK7		;This is first version of this file
	JRST VRLK0A

VERLK0:	EXCH D,A		;CHECK THIS FDB
	CALL FDBCHK
	 JRST MDDVRB		;FDB IS BAD
	EXCH D,A
VRLK0A:	MOVEM B,DRSCN		;Save scan pointer
	JUMPG A,VERLK1		;JUMP IF Specific version wanted
	CAMN A,[-2]		;OLDEST VERSION WANTED?
	JRST VERLKC		;YES
	JUMPL A,VERLK2		;GO DO A NEW ONE THEN
	JN FBDEL,(D),<[TQNN <IGDLF> ;YES, USER WANTS 'IGNORE DELETED'?
		JRST VERLK1	;NO, GO TO NEXT VERSION
		JRST .+1]>	;YES, THIS VERSION POTENTIALLY OK
	JN FBINV,(D),<[TQNN <IGIVF> ; User want to find invisible?
		JRST VERLK1	; No, go to next one
		JRST .+1]>
	JN FBNXF,(D),<[	TQNE <OLDNF> ;NO, USER REQUIRES OLD FILE?
		JRST VERLK1	;YES, GO TO NEXT VERSION
		JRST VERLK2]>	;NEW VERSION OK
	;..
	;..
VERLK3:	MOVE A,D		;Found
VERLK8:	TQNE <NEWVF,NEWF>	;NEW VERSION
	JRST VERLKB		;YES
	TQNE <NEWNF>		;NO NEW FILES
	JRST [	MOVEI A,GJFX27	;YES, GIVE ERROR RETURN
		JRST ERRET]
VERLKB:	TQNE <STEPF>		;STEPPING?
	TQNN <VERSF>		;YES, STEPPING VERSION?
	JRST VERLKE		;NO
	SKIPG DRINP		;HAVE A POINTER TO A VERSION?
	JRST VERLKE		;NO
	MOVEI A,GJFX20
	SKIPG MDDVRL		;ANY PREVIOUS VERSIONS SEEN
	JRST ERRET		;NO, END OF LIST
	MOVE A,MDDVRF		;GET POINTER TO FDB
	LOAD A,DIRLA,(A)	;GET ADR OF FDB
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CALL FDBCHK		;CHECK THE FDB
	 JRST MDDVRB		;FDB IS BAD
	TQNE <IGDLF>		;IGNORE DELETED FILES?
	JRST VERLKG		;NO
	JN FBDEL,(A),VERLKF	;SEE IF FILE IS DELETED
VERLKG:	TQNE <IGIVF>		; Find invisible files?
	 JRST VERLG1		; Yes
	JN FBINV,(A),VERLKF	; File invisible?
VERLG1:	JN FBNXF,(A),VERLKF	;FILE EXIST?
	JN FBNEX,(A),VERLKF	;YES, ALSO HAVE EXTENSION?
VERLKE:	CALL FDBCHK		;CHECK THAT WE HAVE A GOOD FDB
	 JRST MDDVRB		;IT IS BAD
	MOVE B,A		;GET FDB ADR INTO B
	TQNE <UNLKF>
	RETSKP			;Return without unlocking directory
	LOAD A,FBGEN,(B)	;GET GENERATION NUMBER
	CALL USTDIR
	RETSKP


VERLKF:	MOVE A,MDDVRL		;SCAN LOOKING FOR THIS VERSION NOW
	MOVE B,MDDVRA		;GET POINTER BACK TO THE TOP FDB
	JRST MDDVR1		;GO DO SCAN AGAIN


VERLK7:	SKIPG A
	MOVEI A,1		;However it can be most recent+1
	STOR A,FBGEN,(D)	;Or specific version
	JRST VERLK3
;**;[2808]ADD 12 LINES AT VERLK7:+5L	TAM	10-SEP-82
VRLK2A:	PUSH P,T4		;[2808] SAVE T4
	SKIPN T1,.FBADR(T4)	;[2808] ANY ADDRESS
	JRST VRLK2B		;[2808] NO, OK TO REINIT
	LOAD T2,DIROFN		;[2808] GET OFN OF DIRECTORY
	LOAD T2,STRX,(T2)	;[2808] GET STRUCTURE FOR DIRECTORY
	CALL CHKOFN		;[2808] OPEN FILES FOR THIS FDB?
	 JRST [POP P,T4		;[2808] YES, GET T4 BACK
	       JRST VRLK5A]	;[2808] USE DON'T CHANGE THIS FDB
VRLK2B:	POP P,T1		;[2808] NOT IN USE. FDB ADDR IN T1
	CALL FDBIN0		;[2808] UPDATE STUFF IN FDB
	SETZRO FBSIZ,(A)	;[2808]
	JRST VERLK8		;[2808]

;HERE IF NEW VERSION WANTED

VERLK2:	TQO <NEWVF>
	TQZ <NEWF>
;**;[2808]MAKE CHANGES AT VERLK2:+2L	TAM	10-SEP-82
	JN FBNXF,(D),VRLK2A	;[2808] NONEXISTANT CHECK FOR OPEN FILE
	MOVE C,DRINP		;GET INPUT ARG
	CAME C,[-1]		;WANT NEXT VERSION?
	JRST VERLK6		;NO. USE CURRENT
	LOAD D,FBGEN,(D)	;GET VERSION OF THIS FILE
	CAIN D,377777		;IS IT ALREADY AT MAX VALUE?
	JRST [	MOVEI A,GJFX20	;YES. GIVE ERROR THEN
		JRST ERRET]	;""

VERLK6:	MOVEI A,GJFX24
	TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
	TQNE <OLDNF>
	TQNE <OUTPF>		;IF USER WANTS NEXT HIGHER VERSION,
	SKIPA			; THEN ALLOW NEW FDB SINCE NAME.EXT EXISTS
	JRST VERLK9		;Old files only
	MOVX B,DC%CF		;B/CREATE-FILES ACCESS
	CALL DIRCHK		;CHECK FOR ABILITY TO CREATE FILES
	JRST [	MOVEI A,GJFX35
		JRST ERRET]
;**;[2980]  Remove all 11 lines of edit 2977		DML	30-JUN-83
	MOVE B,DIRORA		;MAKE MODVRA RELATIVE TO START OF DIR
	LOAD B,DRSBT,(B)	;GET START ADR OF SYMBOL TABLE
	ADD B,DIRORA		;GET ABSOLUTE ADR OF SYMBOL TAB START
	CAMGE B,MDDVRA		;IS POINTER INTO SYMBOL TABLE
	SUBM B,MDDVRA		;YES, MAKE IT NOT BE RELATIVE TO SYMTAB
	MOVEI B,.FBLEN
	CALL ASGDFR		;Assign space for a new fdb
	JRST [	MOVEI A,GJFX23
		JRST ERRET]
	SKIPL MDDVRA		;WAS THIS POINTER IN THE SYMBOL TABLE?
	JRST VRLK6A		;NO
	MOVE C,DIRORA		;YES, MAKE IT POINT INTO SYMTAB AGAIN
	LOAD C,DRSBT,(C)	;GET ADR OF START OF SYMTAB
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	SUBM C,MDDVRA		;MAKE POINTER CORRECT AGAIN
VRLK6A:	CALL FDBINI		;Initialize the fdb
	MOVE C,DRLOC		;GET POINTER TO NEXT FDB
	LOAD C,DIRLA,(C)	;GET ADDRESS OF FDB
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	EXCH A,C
	CALL FDBCHK		;CHECK VALIDITY OF NEXT FDB
	 JRST MDDVRB		;DIR IS BAD
	EXCH A,C
	LOAD D,FBFLG,(C)	; Get previous flag bits
;**;[2801] CHANGE 1 LINE AT VRLK6A:+9L	TAM	3-SEP-82
;**;[1768] Change one line at VRLK6A: +9L	JGZ	27-AUG-80
	TXZ D,FB%DEL!FB%LNG!FB%PRM!FB%SHT!FB%DIR!FB%INV!FB%OFF!FB%ARC!FB%FCF!FB%BAT!FB%TMP!FB%FOR ;[1768][2801][2981] Don't propagate these
	TXO D,FB%NXF		; Mark as non-exstent
	STOR D,FBFLG,(A)	; Into new FDB
	LOAD D,FBBK0,(C)	; Get some other bits
	ANDX D,AR%NAR+AR%EXM	; Propagate resist & exempt
	STOR D,FBBK0,(A)	; Into new FDB
	CALL SETNXF		;GO SET NONXF IN STS AND FILSTS
	LOAD D,FBNAM,(C)	;GET POINTER TO NAME STRING
	STOR D,FBNAM,(A)	;MAKE THIS FDB POINT TO SAME NAME
	LOAD D,FBEXT,(C)	;GET POINTER TO EXTENSION STRING
	STOR D,FBEXT,(A)
	LOAD D,FBEXL,(C)	;SET UP SAME EXTENSION LINK
	STOR D,FBEXL,(A)
	LOAD D,FBGNR,(C)	;SET UP RETENTION COUNT
	STOR D,FBGNR,(A)
	LOAD D,FBPRT,(C)	;SET UP PROTECTION
	STOR D,FBPRT,(A)
	LOAD D,FBNET,(C)	; Set up same online expiration
	STOR D,FBNET,(A)
	LOAD D,FBLEN,(A)	; See if new FDB large enough
	CAIGE D,.FBLXT
	JRST VRLK6Z		; No, skip offline exp altogether
	LOAD D,FBLEN,(C)	; Old FDB have off exp?
	CAIGE D,.FBLXT
	JRST [	MOVE D,DIRORA	; Old FDB doesn't have it, use directory
		LOAD D,DRDFE,(D) ; Get default for the directory
		JRST VRLK6Y]
	LOAD D,FBFET,(C)	; Get previous guy's off exp
VRLK6Y:	STOR D,FBFET,(A)	; Put into new FDB
VRLK6Z:	LOAD D,FBFET,(C)	; Set up same offline expiration
	STOR D,FBFET,(A)
	SOSGE D,DRINP		;VERSION SPECIFIED?
	LOAD D,FBGEN,(C)	;NO, GET VERSION OF OLD HIGHEST FILE
	AOS D			;MAKE VERSION BE ONE HIGHER
	STOR D,FBGEN,(A)	;STORE NEW VERSION #
	MOVE B,DRSCN		;GET POINTER TO LIST
	LOAD D,DIRLA,(B)	;GET ADR OF NEXT FDB ON LIST
	EXCH A,D
	CALL FDBCHR		;MAKE SURE IT IS A VALID FDB ADR
	 JRST MDDVRB		;DIR IS BAD
	STOR A,FBGNL,(D)	;MAKE NEW FDB POINT DOWN THE LIST
	MOVEM D,MDDVRT		;SAVE FDB ADR
	SUB D,DIRORA		;GET RELATIVE ADR OF NEW FDB
	STOR D,DIRLA,(B)	;MAKE LIST POINT TO NEW FDB
	TQO <NEWVF>		;Remember we created a new version
	MOVE B,MDDVRA		;GET POINTER TO FIRST FDB IN CHAIN
	LOAD A,DIRLA,(B)	;GET FDB ADR
	CALL VFIXUP		;MAKE ALL PREVIOUS EXT'S POINT RIGHT
	MOVE A,MDDVRT		;GET BACK FDB ADR
	JRST VERLK8		;LEAVE FDB ADR IN A
VERLKC:	JN FBDEL,(D),<[TQNN IGDLF ;IGNORING DELETED FILES
		JRST VERLK1	;NO
		JRST VRLKC1]>	;YES, SEE IF FILE EXISTS
VRLKC1:	JN FBINV,(D),<[TQNN <IGIVF> ; Find invisible files?
		JRST VERLK1	; No, bypass this one then
		JRST VRLKC3]>
VRLKC3:	JN FBNXF,(D),VERLK1	;IF FILE DOESNT EXIST, USE THIS FDB
	MOVEM D,DRLOC		;Save FDB ADR for later
VERLK1:	LOAD C,FBGEN,(D)	;Get version number of this fdb
	CAMG C,A		;Below desired version?
;**;[3161]  Remove all parts of edits 3151 and 3152	DML	7-Sep-84
;**;[3152]  Add 3 lines to edit 3151			DML	27-Aug-84
;**;[3151]  Replace 1 line with 24 at VERLK1:+2		DML	23-Aug-84
	JRST VERLK5		;[3161] Yes, we have found where it belongs
	MOVE B,DRSCN		;GET POINTER TO NEXT FDB
	MOVEM B,MDDVRF		;SAVE LAST POINTER TO FDB
	LOAD B,DIRLA,(B)	;GET ADDRESS OF FDB
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	ADDI B,.FBGNL		;MAKE IT POINT TO LINK TO NEXT GEN
	LOAD D,DIRLA,(B)	;GET ADR OF NEXT FDB
	JUMPN D,[ADD D,DIRORA	;IF ONE EXISTS, GET ITS ABSOLUTE ADR
		MOVEM C,MDDVRL	;UPDATE LAST VERSION NUMBER SEEN
		JRST VERLK0]
	JUMPE A,[MOVEI A,GJFX20	;WANT HIGHEST VERSION?
		TQNE <OLDNF>	;WANT OLD FILES
		JRST ERRET	;YES. HE GETS AN ERROR THEN
		SETO A,		;NO. ASK FOR NEXT HIGHEST
		MOVE B,MDDVRA	;GET BACK STARTING FDB ADDRESS
		JRST MDDVR1]	;AND GO CREATE A NEW FILE
	CAMN A,[-2]		;OLDEST VERSION WANTED?
	JRST VERLKD		;YES
	MOVEM B,DRSCN
	JRST VERLK6		;Insert new version here

VERLK9:	JRST ERRET		;ERROR
;HERE IF USER WANTS OLDEST VERSION

VERLKD:	TQZ <NEWF,NEWVF>
	MOVEI A,GJFX20
	MOVE D,DRLOC
	JN FBDEL,(D),<[TQNN IGDLF ;DELETED, IGNORING DELETED?
		JRST VERLKF	;NO, SCAN UP THE FDB CHAIN TO PREVIOUS
		JRST VRLKD1]>	;YES
VRLKD1:	JN FBINV,(D),<[TQNN <IGIVF> ; Find invisible files?
		JRST VERLKF	; No
		JRST VRLKD2]>	; Yes, go on
VRLKD2:	JN FBNXF,(D),VERLKF	;IF NON-EXISTENT, SCAN UP CHAIN
	JRST VERLK3

VERLK5:	CAME C,A		;Exactly the right one?
	JRST VERLK6		;Insert a new one
;**;[2808]ADD A LABEL AT VERLK5:+2L	TAM	10-SEP-82
VRLK5A:	MOVE B,DRSCN
	LOAD A,DIRLA,(B)	;GET ADR OF POINTER TO FDB
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CALL FDBCHK		;CHECK THIS FDB
	 JRST MDDVRB		;FDB IS BAD
;**;[1842] Add 2 lines at VERLK5: +7L	JGZ	7-APR-81
	TQNE <OUTPF>		;[1842] IF FILE IS FOR OUTPUT,
	 JRST VERLKH		;[1842]  THEN WE HAVE FOUND IT.
	TQNE <IGIVF>		; Find invisible?
	 JRST VERL51		; Yes
	JN FBINV,(A),VERL52	; File invisible?
VERL51:	JE FBDEL,(A),VERLKH	;IF NOT DELETED, GO TO VERLKH
	TQNE <OUTPF,IGDLF>	;IGNORE DELETED?
	JRST VERLKH		;YES
VERL52:	MOVEI A,GJFX20		;NO, GIVE ERROR RETURN
	JRST ERRET

VERLKH:	TQNE <OUTPF>
	 JRST [	JE FBDEL,(A),VRLKH1 ;DELETED?
;**;[3140]  Add 8 lines after VERLKH:+1			DML	24-JUL-84
		MOVEM A,MDDVFB	;[3140] Yes, save pointer to FDB
		MOVX B,DC%CF	;[3140] Get access required
		CALL DIRCHK	;[3140] (B/) Check for create file access
		IFNSK.		;[3140]
		  MOVEI A,GJFX35 ;[3140] Access denied
		  JRST ERRET	;[3140] Return error
		ENDIF.		;[3140]
		MOVE A,MDDVFB	;[3140] Restore pointer to FDB
		SETZRO FBDEL,(A) ;CLEAR DELETED BIT
		SETONE FBNXF,(A) ;AND SET NON-EXISTENT
		JRST VRLKH1]

;**;[2988] Replace 5 lines with 7 lines at VRLKH1+1	JMP	8-Jul-83

VRLKH1:	JE FBNXF,(A),VERLK8	;FILES EXIST?
;**;[3161]  Remove the label added by edit 3151		DML	7-Sep-84
;**;[3151]  Add a label at VRLKH1:+1			DML	23-Aug-84
       	TQNE <STEPF>		;[3161][3151][2988] NO - STEPPING ?
 	TQNN <VERSF>		;[2988]  AND VERSION STEPPING ?
	TQNN <OLDNF>		;[2988] NO - OLD FILE ONLY?
	JRST [TQO <NEWVF>	;[2988] NEW FILE - SET NEW VERSION FLAG
	      JRST VERLK8]	;[2988] SCAN NEXT FDB
	MOVEI A,GJFX24		;[2988] YES, THEN GIVE AN ERROR RETURN
	JRST ERRET		;[2988]


MDDVRB:	MOVEI A,GJFX36		;DIR IS SMASHED
	JRST ERRET
; Lookup of string in a directory
; Call:	A	; ADR OF FIRST WORD IN STRING
;	B	; # OF FULL WORDS IN STRING
;	C	; ENTRY TYPE
;	CALL LOOKUP		to indicate a file lookup
;	 or
;	CALL LOOKP1		to indicate a directory file lookup
; Return
;	+1	; No exact match found
;	+2	; Exact match found

;**;[3114] Add 2 lines at LOOKUP:	16-May-84	CRJ 
LOOKUP:	TDZA D,D		;Clear flag: normal entry
LOOKP1:	SETO D,			;Set flag: directory lookup
;**;[3114] Change 1 line at LOOKUP:+0L	16-May-84	CRJ
	STKVAR <LOOKUE,LOOKUI,LOOKUB,DIRSRC>
	TQZ <MTCHF,AMBGF>	;CLEAR RESULT FLAGS
	MOVEM C,LOOKUE		;SAVE ENTRY TYPE
;**;[3114] Add 1 line at LOOKUP:+4L	16-May-84	CRJ
	MOVEM D,DIRSRC		;[3114] Setup internal flag
	CALL SETMSB		;Set up input pointer and mask
	MOVE D,DIRORA		;GET BASE OF MAPPED DIR
	LOAD A,DRSTP,(D)	;GET TOP OF DIRECTORY
	LOAD B,DRSBT,(D)	;GET BOTTOM OF SYMBOL TABLE
	ADDI B,.SYMLN		;MAKE IT POINT TO FIRST SYMBOL
	SUB A,B			;GET LENGTH OF SYMBOL TABLE
	JFFO A,.+2		;Get top 1 bit
	MOVEI B,^D34
	MOVNS B
	MOVSI A,400000
	LSH A,(B)		;Largest power of 2 <= length
	LOAD B,DRSBT,(D)	;GET BOTTOM OF SYMBOL TABLE
	ADD B,DIRORA		;MAKE IT ABSOULTE
MOVUP:	JUMPE A,STRFND		;And move up
	CAIG A,1		;DONT SPLIT A SYMBOL ENTRY
	JRST STRFND		;ALL DONE
	ADD B,A
	ASH A,-1		;Halve increment
	MOVE C,DIRORA		;GET BASE ADR
	LOAD C,DRSTP,(C)	;GET TOP OF SYMBOL TABLE
	ADD C,DIRORA		;MAKE IT RELATIVE
	CAMGE B,C		;TOO BIG?
	JRST SYMCMP		;No, compare strings
MOVDN:	JUMPE A,STRFDD
	CAIG A,1		;DONT SPLIT A SYMBOL ENTRY
	JRST STRFDD
	SUB B,A
	ASH A,-1
	MOVE D,DIRORA		;GET BASE ADR
	LOAD C,DRSTP,(D)	;GET TOP OF SYMBOL TABLE
	ADD C,DIRORA		;MAKE IT RELATIVE
	CAML B,C		;STILL BELOW TOP?
	JRST MOVDN		;NO, MOVE DOWN
	LOAD C,DRSBT,(D)	;ABOVE BOTTOM?
	ADDI C,.SYMLN
	ADD C,DIRORA		;MAKE IT RELATIVE
	CAMGE B,C
	JRST [	MOVE C,DIRORA	;GET DIR #
		LOAD C,DRNUM,(C)
		MOVEM B,LOOKUB	;SAVE B
		CALL GETSNM	;GET STR NAME
		BUG(DIRSY3,<<C,D>,<B,D>>)
		MOVE B,LOOKUB	;RESTORE B
		JRST .+1]
	;..
	;..
SYMCMP:	MOVEM A,LOOKUI		;Save increment
	MOVEM B,DRLOC		;And symtab loc
	MOVE A,LOOKUE		;GET ENTRY TYPE
	CALL NAMCM1
;**;[3114] Replace 1 line with 6 at SYMCMP:+4L	16-May-84	CRJ
	 JRST SYMCM0		;[3114] No exact match
	SKIPN DIRSRC		;[3114] Looking up a directory?
	IFSKP.			;[3114] Yes
	   CALL DRLKFD		;[3114] Scan types and gens for a directory
	   JRST SYMCM1		;[3114] No dir, treat as a partial match
	ENDIF.			;[3114]
	RETSKP			;SYMBOL FOUND
;**;[3114] Add 2 lines at SYMCMP:+11L	16-May-84	CRJ

SYMCM0:	MOVE C,A		;[3114] Keep NAMCM1 result
	MOVE A,LOOKUI		;GET INCREMENT
	MOVE B,DRLOC		;AND POINTER
	JUMPL C,MOVDN		; A<B
	JUMPG C,MOVUP		; A>B

;**;[3114] Add 15 lines at	16-May-84	CRJ
;Here if a subset match occurred

	SKIPN DIRSRC		;[3114] Looking for directories or files?
	 JRST SYMCM1		;[3114] If files, normal subset action
	CALL DRLKFD		;[3114] If dirs, scan types and generations
	IFNSK.			;[3114] No directory file found?
	   TQO <MTCHF,AMBGF>	;[3114] Nope, treat as ambiguous
	   JRST SYMCM2		;[3114]
	ENDIF.			;[3114]

;Here on a subset match

SYMCM1:
	TQOE <MTCHF>		; A IS SUBSET OF B
	TQO <AMBGF>
;**;[3114] Add 3 lines at	16-May-84	CRJ

SYMCM2:	MOVE A,LOOKUI		;[3114] If not found, restore variables
	MOVE B,DRLOC		;[3114]
	JRST MOVDN

STRFND:	ADDI B,.SYMLN		;STEP TO NEXT SYMBOL
STRFDD:	MOVEM B,DRLOC
	RET
;ROUTINE TO COMPARE NAME STRINGS
;ACCEPTS IN A/	ENTRY TYPE (IF CALLING NAMCM1)
;	    B/	ADR IN SYMBOL TABLE
;		DRINP AND DRINL MUST BE SET UP
;	CALL NAMCMM
;RETURNS +1:	A=-1 => A<B, A=0 => A IS SUBSET OF B, A=1 => A>B
;	 +2:	A=B

NAMCMM:	MOVEI A,.ETNAM		;ASSUME NAME ENTRY TYPE
NAMCM1:	LOAD C,SYMVL,(B)	;CHECK THE VALUE
	CAMN C,[-1]
	JRST NAMCM4		;SYMBOL TABLE IS MESSED UP
	LOAD C,SYMET,(B)	;GET ENTRY TYPE OF SYMBOL
	CAMGE C,A		;Less than that being sought?
	JRST STWAGB		;YES, A>B
	CAMLE C,A		;Greater than entry type being sought?
	JRST RETO		;YES, A<B
	MOVE A,DRINP		;GET INPUT POINTER
	MOVE D,(A)		;GET FIRST WORD
	SKIPG DRINL		;ANY WORDS THERE?
	AND D,DRMSK		;NO, MASK PARTIAL WORD
	LOAD A,SYMVL,(B)	;GET VALUE OF SYMBOL
	LSH A,-1		;GET RID OF LOW ORDER BIT
	LSH D,-1		; AND GUARANTEE WORD IS POSITIVE
	CAMGE A,D		;LESS THAN ONE SOUGHT?
	JRST STWAGB		;YES, A>B
	CAMLE A,D		;GREATER THAN ONE BEING SOUGHT
	JRST NAMCM3		;YES, A<B - GO SEE IF SUBSET
	LOAD A,SYMAD,(B)	;GET ADDRESS OF FDB
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CAIE C,.ETNAM		;IS THIS A NAME SYMBOL
	JRST NAMCMA		;NO, DONT GO TO FDB FOR NAME STRING
	CALL FDBCHK		;VERIFY THAT THIS IS A GOOD FDB
	 JRST RETO		;NO, BOMB OUT
	LOAD A,FBNAM,(A)	;GET ADDRESS OF NAME STRING
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	LOAD D,NMLEN,(A)	;GET LENGTH OF STRING
	JRST NAMCM2		;GO COMPARE THE STRINGS
NAMCMA:	LOAD D,ACLEN,(A)	;GET LENGTH OF ACCOUNT STRING
	AOS A			;YES, STEP OVER SHARE COUNT
	SOS D
NAMCM2:	MOVEI D,-2(D)		;GET NEGATIVE LENGTH OF WORDS IN STRING
	AOS C,A			;STEP TO FIRST WORD
	MOVE A,DRINP		;GET POINTER TO INPUT STRING
	MOVE B,DRINL		;GET # OF WORDS IN STRING
	CALLRET STWCMP		;GO COMPARE THE STRINGS


NAMCM3:	SKIPE DRINL		;IS THIS STRING ONLY ONE WORD LONG?
	JRST RETO		;NO, RETURN A<B
	LSH A,1			;GET BACK CORRECT WORD
	LSH D,1
	AND A,DRMSK		;MASK OUT UNWANTED BITS
	CAME A,D		;IS D A SUBSET OF A
	JRST RETO		;NO, RETURN A<B
	JRST RETZ		;YES, A IS A SUBSET OF B

NAMCM4:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRSY4,<<A,D>,<B,D>>)
	JRST RETO
;String compare routine
;ACCEPTS IN A/	ADR OF FIRST WORD OF STRING A
;	    B/	# OF FULL WORDS IN STRING A
;	    C/	ADR OF FIRST WORD OF STRING B
;	    D/	# OF FULL WORDS IN STRING B
;	CALL STWCMP
;ReturnS +1:	A = -1		;STRING A < STRING B
;		A = 0		;STRING A IS SUBSET OF STRING B
;		A = 1		;STRING A > STRING B
;	 +2:			;STRING A = STRING B
;Clobbers a,b,c,d

STWCMP:	SAVEQ
STRCM0:	JUMPLE B,STRCM1		;Down to last word of string a?
	MOVE Q2,(C)		;Get word of string b
	MOVE Q1,(A)		;And word of string a
	LSH Q1,-1		;GET RID OF BIT 35
	LSH Q2,-1		;MAKE SURE THESE WORDS ARE POSITIVE
	CAMGE Q2,Q1		;A > B?
STRCM3:	JRST STWAGB		;YES
	CAMLE Q2,Q1		;A < B?
	JRST RETO		;YES
	SOJL D,STRCM3		;IS B GONE?
	AOS C			;NO, STEP TO NEXT WORD
	AOS A			;STEP A ALSO
	SOJA B,STRCM0

STRCM1:	MOVE Q2,(A)		;Get last word of string a
	AND Q2,DRMSK		;Get rid of garbage
	SKIPG D			;If string b is also down to last word,
	CAME Q2,(C)		; Check for exact match
	JRST STRCM4		;Not exact match
	RETSKP			;EXACT MATCH

STRCM4:	MOVE Q1,DRMSK		;GET MASK FOR LAST WORD
	AND Q1,(C)		;Truncate string b to same length as a
	LSH Q1,-1		;GET RID OF BIT 35
	LSH Q2,-1
	CAMGE Q1,Q2		;A > B?
	JRST STWAGB		;YES
	CAMLE Q1,Q2		;A < B?
	JRST RETO		;YES
	JRST RETZ		;NO, A IS SUBSET OF B

STWAGB:	MOVEI A,1		;RETURN A 1 IN A
	RET
; Setup mask and input pointer for directory looks
; Call:	A	; ADDRESS OF FIRST WORD (OR LOOKUP POINTER FOR SETMSK)
;	B	; # OF FULL WORDS IN STRING (FOR SETMSB)
;	CALL SETMSB	OR	CALL SETMSK
; Return
;	+1	; In DRINP, a string compare pointer to input
;		; IN DRINL, THE LENGTH OF THE STRING
; In DRMSK, a mask of ones for masking last word of input string
; Clobbers a,b,c,d

SETMSK::SE1CAL
	HLRE B,A		; Get size of the string block
	MOVNS B			; GET POSITIVE # OF WORDS
	MOVEI A,1(A)		; GET ADR OF FIRST WORD
SETMSB::SE1CAL
	MOVEM A,DRINP		; SAVE ADR OF STRING
	MOVEM B,DRINL		; SAVE LENGTH OF STRING
	ADD A,B			; GET ADR OF END OF STRING
	MOVSI B,774000		; 7 bit mask left justified
	MOVNI C,1		; Mask of bits to ignore
SETMS0:	TDNN B,0(A)		; Look for the terminating null
	JRST SETMS1		; There it is, c has 1's for ignoration
	LSH B,-7		; Not there, shift to next bit
	LSH C,-7
	JRST SETMS0

SETMS1:	SETCAM C,DRMSK		; Get mask of bits to test in last word
	RET
; Copy the DRINP string to a new string block in directory
; Call:	DRINP		; The input pointer
;	DRINL		; LENGTH OF INPUT STRING (AS SET UP BY SETMSK)
;	CALL CPYDIR
; Return
;	+1	; No room
;	+2	; Ok, in a, the location of the string block
; Clobbers a,b,c,d

CPYDIR::SE1CAL
	MOVE B,DRINL		; Get length of input
	ADDI B,2		;  for header and partial word
	PUSH P,B		; Save for below
	CALL ASGDFR		; Assign space for name string
	JRST [	POP P,B		; No room
		RET]
	HRRZ B,DRINP		; GET LOC OF INPUT STRING BLOCK
	XMOVEI C,1(A)		; AND STRING BLOCK IN DIRECTORY
	PUSH P,A		;SAVE ADDRESS FOR RETURN
	MOVE A,-1(P)		;GET LENGTH OF BLOCK
	SOS A
	CALL XBLTA		; DO BLT
	POP P,A			; RESTORE
	POP P,D
	ADD D,A
	MOVE C,DRMSK		; Get mask
	ANDM C,-1(D)		; Zero low part of last word of string
	RETSKP
;ROUTINE TO VERIFY THAT THE BACKUP COPY OF THE ROOT DIR IS GOOD

;ACCEPTS:
;	A/STRUCTURE NUMBER

;	CALL CHKBAK
;RETURNS +1:	BACKUP FILE COULD NOT BE MADE
;	 +2:	BACKUP FILE IS NOW GOOD

CHKBAK::SE1CAL
	STKVAR <CKBSTR>
	MOVEM A,CKBSTR		;SAVE STRUCTURE NUMBER
	MOVE A,STRTAB(A)	;GET ADDRESS OF SDB
	LOAD A,STRBXB,(A)	;GET ADDRESS OF XB OF BACKUP FILE
	TLO A,(FILWB+THAWB)	;OPEN IT FOR WRITE THAWED
	MOVE B,CKBSTR		;B/STRUCTURE NUMBER
	CALL ASROFN		;GET AN OFN ON BACKUP FILE
;**;[2896]REPLACE 1 LINE WITH 2 AT CHKBAK:+8L	TAM	11-JAN-83
	 JRST [ BUG(CGROFN,<<T1,LSTERR>>) ;[2896]CAN'T, COMPLAIN
		RET]		;[2896] FAIL
	STOR A,DIROFN		;SAVE THIS OFN
	SETONE DRROF		;INDICATE UNMAPD SHOULD RELEASE OFN
	SKIPE EXADDR		;CHECK FOR SEC 2
;**;[1966] Add 4 lines at CHKBAK:+12.L	PED	10-DEC-81
	JRST [	HRRZ A,DRMAP	;[1966] GET CURRENT MAPPED DIRECTORY
		SKIPE A		;[1966] IS THERE ONE?
		CALL RELOFN	;[1966] YES
		LOAD A,DIROFN	;[1966] GET NEW OFN
		CALL MAPDRP	;MAP DIRECTORY PAGE
		JRST CHKBKA]	;AND CONTINUE
	HRLZS A			;GET OFN.PN FOR MAPPING THIS FILE
	MOVX B,PTRW		;MAP FILE IN AS READ WRITE ALLOWED
	IOR B,DIRORA		;GET ADDRESS OF AREA TO MAP INTO
	MOVE C,NDIRPG		;MAP IN WHOLE FILE
	CALL MSETMP		;THIS FILE SHOULD LOOK LIKE A DIRECTORY
CHKBKA:	MOVEI A,ROOTDN		;CHECK THAT IT IS LIKE THE ROOT-DIR
	CALL DR0CHK		;CHECK PAGE 0
	 JRST CHKBK1		;NOT VALID, GO COPY IT
	CALL SYMCHK		;MAKE SURE SYMBOL TABLE OK
	 JRST CHKBK1		;NOT OK, GO COPY ROOT DIR
	CALL BLKSCN		;SCAN ENTIRE FILE
	 JRST CHKBK1		;SOMETHING WAS BAD
	CALL UNMAPD		;UNMAP THE FILE AND RELEASE THE OFN
	RETSKP			;BACKUP FILE IS GOOD

CHKBK1:	CALL UNMAPD		;UNMAP THE FILE AND RELEASE THE OFN
	MOVE A,CKBSTR		;A/STRUCTURE NUMBER
;**;[2896] MAKE CHANGES AT CHKBK1:+2L	TAM	11-JAN-83
	CALL CPYBAK		;[2896] GO MAKE A COPY OF THE FILE
	 JRST [ BUG (CCBROT,<<T1,LSTERR>>) ;[2896] COULDN'T, COMPLAIN
		RET]		;[2896] AND FAIL
	RETSKP			;[2896] OK
;ROUTINES TO REFERENCE THE INDEX TABLE

; ROUTINE TO MAP AN INDEX TABLE FILE INTO THE PER-PROCESS AREA
;
; CALL:	ACCEPTS IN T1/	STRUCTURE NUMBER
;		CALL MAPIDX
; RETURNS: +1	 ERROR
;	   +2	SUCCESS, INDEX TABLE MAPPED

MAPIDX:	STKVAR <MPIDXS,MPIDXC>
	MOVEM T1,MPIDXS		;SAVE STRUCTURE NUMBER
	CALL STRCNV		;GO GET THE UNIQUE CODE FOR THIS STRUCTURE
	 RET			;FAILED, RETURN FAILURE
	MOVEM T1,MPIDXC		;SAVE UNIQUE CODE FOR THIS STRUCTURE
	JE IDXFLG,,MPIDX2	;OMIT CHECK IF NO INDEX FILE MAPPED
	LOAD T2,CURUC		;GET UNIQUE CODE OF CURRENTLY MAPPED INDEX FILE
	CAMN T2,MPIDXC		;SAME AS DESIRED STRUCTURE ?
	RETSKP			;YES, NO MORE WORK REQUIRED
MPIDX2:	CALL UNMIDX		;NO, GO UNMAP CURRENTLY MAPPED INDEX FILE

; GET OFN OF INDEX TABLE FILE FOR DESIRED STRUCTURE

	MOVE T1,MPIDXS		;GET DESIRED STRUCTURE #
	MOVE T1,STRTAB(T1)	;GET ADDRESS OF SDB FOR THIS STRUCTURE
	LOAD T2,STRIDX,(T1)	;GET OFN OF INDEX TABLE FILE FOR THIS STR
	JUMPN T2,MPIDX4		;IF OFN EXISTS, GO MAP INDEX TABLE
	JE STIDX,(T1),MPIDX5	;GO ON IF OFN OF INDEX TABLE FILE NOT YET SET UP
	BUG(MPIDXO)
	RETBAD(DELFX6)		;GIVE FAILURE RETURN

; MAP THE DESIRED INDEX TABLE FILE

MPIDX4:	SKIPE EXADDR		;CHECK FOR EXTENDED ADDRESSING
	JRST MPIDX3		;YES PUT IDXTAB IN 3,,0
	HRLZ T1,T2		;GET OFN.PN FOR FIRST PAGE OF INDEX TABLE FILE
	SKIPN T2,FKXORA		;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
	MOVE T2,IDXORA		;GET BASE ADDRESS OF INDEX TABLE
	TXO T2,PTRW		;GET ACCESS BITS
	MOVX T3,NIDXPG		;GET # OF PAGES TO MAP
	CALL MSETMP		;MAP INDEX TABLE FILE
	JRST MPIDX5

MPIDX3:	HLL T2,SHRPTR		;SET UP THE SHARE POINTER FOR THE OFN
	MOVEM T2,IDXMAP		;SET UP THE MAP POINTER
	HRRZ T1,T2		;GET OFN IN T1
	CALL UPSHR		;INCREMENT SHARE COUNT FOR INDEX TABLE
	CALL MONCLA		;RESET THE MONITOR MAP

; STASH AWAY STR # AND UNIQUE CODE OF CURRENTLY MAPPED INDEX FILE, AND RETURN

MPIDX5:	MOVE T1,MPIDXS		;GET STRUCTURE NUMBER
	STOR T1,CURSTR		;SAVE STRUCTURE # IN PSB
	MOVE T1,MPIDXC		;GET UNIQUE CODE
	STOR T1,CURUC		;STORE UNIQUE CODE IN PSB
	SETONE IDXFLG		;MARK THAT AN INDEX TABLE FILE IS NOW MAPPED
	RETSKP			;RETURN SUCCESS
; ROUTINE TO UNMAP AN INDEX TABLE FILE
;
; CALL:		CALL UNMIDX
; RETURNS: +1	ALWAYS, INDEX TABLE FILE NO LONGER MAPPED

UNMIDX::CALL UNMAPD		;UNMAP ANY DIR
	JE IDXFLG,,R		;IF NO INDEX TABLE FILE MAPPED, JUST RETURN
	MOVEI A,0		;CLEAR OUT PREVIOUS INDEX PAGES
	SKIPN B,FKXORA		;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
	MOVE B,IDXORA		;GET STARTING ADDRESS OF INDEX TABLE
	MOVX C,NIDXPG		;GET # OF PAGES IN INDEX
	SKIPN EXADDR		;CHECK FOR EXTENDED ADDRESSING
	JRST [CALL MSETMP	;UNMAP THE OLD PAGES
		SETZRO IDXFLG	;MARK THAT INDEX TABLE IS NO LONGER MAPPED
		RET]		;RETURN
	HRRZ A,IDXMAP		;GET OFN
	SKIPE A			;SKIP IF NO OFN
	CALL RELOFN		;RELEASE OFN
	SETZM IDXMAP		;CLEAR MAP FOR EXTENDED ADDRESSING
	CALL MONCLA		;AND TELL HARDWARE ABOUT IT
	SETZRO IDXFLG		;MARK THAT INDEX TABLE IS NO LONGER MAPPED
	RET			;RETURN



;ROUTINE TO INITIALIZE IDXTAB

;	CALL CLRIDX		;MUST HAVE IDXTAB MAPPED
;RETURNS +1:	ALWAYS

CLRIDX::SE1CAL
	SKIPN A,FKXORA		;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
	MOVE A,IDXORA		;GET START OF THE IDXTAB
	MOVE B,MXDIRN		;GET MAX SIZE OF IDXTAB
	IMULI B,.IDXLN		;GET TIMES LENGTH OF EACH ENTRY
CLRID1:	SETZM 0(A)		;CLEAR THIS WORD
	AOS A			;STEP TO NEXT WORD
	SOJG B,CLRID1		;ZERO THE WHOLE TABLE
	CALL UPDIDX		;UPDATE THE IDX PAGES
	RET			;DONE
;ROUTINE TO SET VALUES INTO THE TABLE
;ACCEPTS IN A/	DIR #
;	    B/	RELATIVE ADR OF FDB IN ROOT DIRECTORY FILE
;	    C/	DISK ADR OF INDEX BLOCK FOR DIRECTORY FILE
;	    D/	DIRECTORY NUMBER OF SUPERIOR DIRECTORY
;	* * *  ASSUMES THAT THE INDEX TABLE IS ALREADY MAPPED * * *
;	CALL SETIDX
;RETURNS +1:	ILLEGAL DIR # OR INDEX ALREADY SET FOR THIS #
;	 +2:	INDEX VALUE SET UP

SETIDX::SE1CAL
	SKIPLE A		;ZERO OR NEGATIVE IS BAD
	CAML A,MXDIRN		;IS THIS A LEGAL DIRECTORY NUMBER
	 RETBAD (DIRX1)		;NO
	SKIPLE D		;CHECK SUPERIOR DIR NUMBER
	CAML D,MXDIRN		;WITHIN RANGE?
	 RETBAD (DIRX1)		;NO.
	PUSH P,D		;SAVE SUPERIOR DIR NUMBER
	LSH A,1			;GET RELATIVE INDEX INTO TABLE
	SKIPN D,FKXORA		;GET SPECIAL IDXORA IF STR CREATION
	MOVE D,IDXORA
	ADD A,D			;MAKE ABSOLUTE ADDRESS OF INDEX ENTRY
	LOAD D,IDXIB,(A)	;MAKE SURE THE ENTRY IS NOT ALREADY SET
	CAME D,C		;IF IT IS SET, IT MUST BE THE SAME
	JUMPN D,[	POP P,(P)	;SCRAP STACK
			RETBAD (DIRX1)]
	STOR B,IDXFB,(A)	;SET UP ADDRESS OF FDB
	STOR C,IDXIB,(A)	;SET UP DISK ADR OF INDEX BLOCK
	POP P,D			;GET SUPERIOR DIR NUMBER BACK
	STOR D,IDXSD,(A)	;STORE SUPERIOR DIR NUMBER
	SETZRO IDXFG,(A)	;ZERO THE FLAGS
	CALL UPDIDX		;UPDATE THE IDX FILE
	RETSKP			;AND EXIT
;ROUTINE TO GET THE FDB ADR AND INDEX BLOCK ADR FOR A DIRECTORY
;ACCEPTS IN A/	DIR #
;	CALL GETIDX
;RETURNS +1:	ILLEGAL DIR #
;	 +2:	A/	FDB ADR
;		B/	INDEX BLOCK DISK ADR
;		C/	SUPERIOR DIR NUMBER
;		D/	FLAGS FROM IDXFG

GETIDX::SE1CAL
	CALL CNVIDX		;CONVERT DIR # TO IDXTAB INDEX
	 RETBAD			;ILLEGAL #
	LOAD B,IDXIB,(A)	;GET THE DISK ADR OF INDEX BLOCK
	JUMPE B,[RETBAD(DIRX1)]	;IF 0, NOT SET UP YET
	LOAD C,IDXSD,(A)	;GET SUPERIOR DIR NUMBER
	LOAD D,IDXFG,(A)	;GET FLAGS INTO D
	LOAD A,IDXFB,(A)	;GET THE FDB ADR
	RETSKP			;GOOD RETURN


;ROUTINE TO CONVERT A DIR # TO AN IDXTAB INDEX
;ACCEPTS IN T1/	18-BIT DIR #
;	CALL CNVIDX
;RETURNS +1:	ILLEGAL DIR NUMBER
;	 +2:	A/	INDEX INTO IDXTAB

CNVIDX:	SKIPLE A		;ZERO OR NEGATIVE IS BAD
	CAML A,MXDIRN		;IS NUMBER TOO HIGH?
	RETBAD (DIRX1)		;YES, ILLEGAL DIR NUMBER
	LSH A,1			;GET RELATIVE INDEX
	SKIPN B,FKXORA		;GET SPECIAL IDXORA IF STR CREATION
	MOVE B,IDXORA
	ADD A,B			;MAKE ABSOLUTE INDEX INTO TABLE
	RETSKP
;ROUTINE TO GET NEXT FREE DIRECTORY NUMBER
; ACCEPTS IN A/ STRUCTURE NUMBER
;	CALL GETNDN
;RETURNS +1:	NO MORE DIRECTORY NUMBERS AVAILABLE
;	 +2:	DIRECTORY NUMBER IN A

GETNDN::SE1CAL
	MOVE A,STRTAB(A)	;GET SDB
	LOAD B,STRLDN,(A)	;GET CURRENT LAST DIRNUM
	MOVE C,B		;COPY TO START LOOP
GTNDN1:	ADDI C,1		;STEP TO NEXT
	CAML C,MXDIRN		;OVERFLOW?
	MOVEI C,NRESDN		;YES - WRAPAROUND
	CAMN C,B		;BACK TO ORIGINAL?
	RETBAD(GJFX32)		;YES - NO MORE DIR NUMBERS
	MOVE D,C		;CHECK INDEX 
	LSH D,1			;TO SEE IF THIS
	SKIPN B,FKXORA		;GET SPECIAL FORK IDXORA IF STR CREATION
	MOVE B,IDXORA
	ADD D,B			;NUMBER IS FREE
	JN IDXIV,(D),GTNDN1	;SKIP ANY INVALID ENTRIES
	LOAD D,IDXIB,(D)	;CHECK IF INDEX BLOCK
	JUMPN D,GTNDN1		;IS KNOWN
	STOR C,STRLDN,(A)	;SAVE NEW LAST DIR
	MOVE A,C		;DIRNUM IS FREE, RETURN IT
	RETSKP

;ROUTINE TO DELETE AN ENTRY FROM THE INDEX TABLE
;ACCEPTS IN A/	DIR NUMBER
;	CALL DELIDX
;RETURNS +1:	ALWAYS

DELIDX::SE1CAL
;**;[7219] REMOVE EDIT 7218 AT DELIDX:+1.L	DSW	1/3/86
	CALL CNVIDX		;GET INDEX INTO IDXTAB
	 RET
	SETZRO IDXFB,(A)	;CLEAR ALL ENTRIES
	SETZRO IDXIB,(A)
	SETZRO IDXSD,(A)
	SETZRO IDXFG,(A)
;**;[7219] REMOVE EDIT 7218 AT DELIDX:+7.L	DSW	1/3/86
	CALLRET UPDIDX		;UPDATE IDXTAB
;**;[7219] REMOVE EDIT 7218 AT DELIDX:+8.L	DSW	1/3/86

;ROUTINE TO INVALIDATE AN IDXTAB ENTRY
;ACCEPTS IN A/	18-BIT DIR NUMBER
;	CALL INVIDX
;RETURNS +1:	ALWAYS

INVIDX::SE1CAL
	CALL CNVIDX		;GET INDEX INTO IDXTAB
	 RET
	SETONE IDXIV,(A)	;MARK IT INVALID
	CALLRET UPDIDX		;GO UPDATE THE IDX FILE
;ROUTINE TO PUSH BACK THE PAGES TO IDXFIL
;	CALL UPDIDX
;RETURNS +1:	ALWAYS - IDXFIL IS NOW GOOD ON DISK

UPDIDX:	LOAD T1,CURSTR		;GET STR NUMBER
	SKIPN T1,STRTAB(T1)	;GET POINTER TO SDB
	RET			;NONE? DONT DO ANYTHING
	LOAD T1,STRIDX,(T1)	;GET THE OFN OF IDXFIL
	HRLZS T1		;GET OFN,,PN FOR PAGE 0
	MOVEI T2,NIDXPG		;GET # OF IDX FILE PAGES
	CALLRET UPDPGS		;GO UPDATE THEM
;ROUTINES TO CHECK THE CONSISTENCY OF THE DIRECTORY

;ROUTINE TO CHECK THE CONSISTENCY OF THE HEADER ON THE FIRST DIR PAGE
;ASSUMES DIR IS MAPPED
;ACCEPTS IN A/	DIR NUMBER
;	CALL DR0CHK
;RETURNS +1:	HEADER IS SCREWED UP
;	 +2:	OK
;DOES NOT SAVE TEMPORARY ACS

DR0CHK:	MOVE D,DIRORA		;GET BASE ADR OF MAPPED DIR AREA
	LOAD B,DRNUM,(D)	;GET DIR NUMBER
	CAME A,B		;DO THE DIRECTORY NUMBERS MATCH?
	JRST DR0CHB		;NO
	LOAD B,DRTYP,(D)	;GET BLOCK TYPE
	CAIE B,.TYDIR		;IS BLOCK TYPE CORRECT?
	JRST DR0CHB		;NO
	LOAD B,DRRPN,(D)	;GET RELATIVE PAGE #
	JUMPN B,DR0CHB		;MUST BE 0
	LOAD B,DRSTP,(D)	;GET TOP OF SYMBOL TABLE
	SOS B			;GET LAST WORD USED
	LSH B,-PGSFT		;TURN IT INTO PAGE #
	CAML B,NDIRPG		;WITHIN BOUNDS?
	RETBAD (DIRX5)		;NO, PROBABLY CAME FROM EXTENDED SYSTEM
	LOAD B,DRFFB,(D)	;GET ADR OF FIRST FREE BLOCK
	TRZ B,777		;IT MUST POINT ONTO THIS PAGE
	JUMPN B,DR0CHB
	LOAD A,DRNAM,(D)	;NOW CHECK NAME BLOCK
	JUMPE A,DR0CH1		;DONT WORRY IF NO NAME
	CALL NAMCHK		;MAKE SURE THIS IS A NAME BLOCK
	 RET			;NO
DR0CH1:	LOAD A,DRPSW,(D)	;GET PASSWORD POINTER
	JUMPE A,DR0CH2		;COULD BE 0
	CALL NAMCHK		;CHECK BLOCK TYPE
	 RET			;FAILED CHECK
DR0CH2:	LOAD A,DRACT,(D)	;GET PTR TO DEFAULT DIR ACCOUNT
	JUMPE A,DR0CH3		;COULD BE 0
	CALL NAMCHK		;CHECK THE BLOCK TYPE
	 RET			;FAILED
DR0CH3:	RETSKP			;EVERYTHING IS IN ORDER

DR0CHB:	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRPG0,<<A,D>,<B,D>>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK HEADERS OF PAGES OTHER THAN 0
;ACCEPTS IN A/	PAGE #
;	CALL DRHCHK
;RETURNS +1:	HEADER IS BAD
;	 +2:	OK

DRHCHK:	JUMPE A,RSKP		;IF PAGE 0, ASSUME GOOD
	MOVE D,DIRORA		;GET BASE ADR
	LOAD B,DRNUM,(D)	;GET DIR NUMBER FROM PAGE 0
	MOVE C,A		;GET PAGE NUMBER
	LSH C,PGSFT		;TURN IT INTO RELATIVE ADDRESS
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	LOAD D,DRRPN,(C)	;GET RELATIVE PAGE #
	CAME A,D		;MUST MATCH ARGUMENT
	JRST DRHCHB		;FAILURE
	LOAD D,DRFFB,(C)	;GET ADR OF FIRST FREE BLOCK ON PAGE
	JUMPE D,DRHCH1		;COULD BE 0 IF NONE
	LSH D,-PGSFT		;GET PAGE # OF ADDRESS
	CAME A,D		;MUST MATCH PAGE # OF THIS PAGE
	JRST DRHCHB
DRHCH1:	LOAD A,DRNUM,(C)	;GET DIR # OF THIS PAGE
	CAME A,B		;MUST BE SAME AS PAGE 0 DIR #
	JRST DRHCHB
	LOAD A,DRTYP,(C)	;GET HEADER TYPE CODE
	CAIE A,.TYDIR		;IS THIS A HEADER BLOCK?
	JRST DRHCHB		;NO
	RETSKP			;HEADER IS OK

DRHCHB:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRPG1,<<A,D>,<B,D>>)
	RETBAD (DIRX3)


;ROUTINE TO CHECK THE SYMBOL TABLE HEADER
;	CALL SYMCHK
;RETURNS +1:	BAD
;	 +2:	OK

SYMCHK::SE1CAL
	SAVET			;SAVE ALL ACS
	MOVE D,DIRORA		;GET BASE ADDRESS
	LOAD A,DRSBT,(D)	;GET ADDRESS OF SYMBOL TABLE
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	LOAD B,SYMTY,(A)	;GET HEADER TYPE
	CAIE B,.TYSYM		;IS THIS A SYMBOL TABLE?
	JRST SYMBAD		;NO
	LOAD B,SYMDN,(A)	;GET DIRECTORY NUMBER
	LOAD C,DRNUM,(D)	;GET DIR # FROM PAGE 0
	CAME B,C		;THEY MUST MATCH
	JRST SYMBAD
	LOAD B,SYMVL,(A)	;GET SECOND WORD
	CAMN B,[-1]		;MUST BE -1
	RETSKP			;SYMBOL TABLE HEADER OK
SYMBAD:	LOAD A,DRNUM,(D)	;GET DIR # FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRSY5,<<A,D>,<B,D>>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK AN FDB
;ACCEPTS IN A/	ABSOLUTE ADR OF FDB
;	CALL FDBCHK
;RETURNS +1:	BAD FDB
;	 +2:	FDB OK
;ALL ACS ARE SAVED AND RESTORED

FDBCHQ:	SAVET			;ENTRY POINT FOR NO BUGCHK ON FAILURE
	STKVAR <FDBCHA,FDBCHF>
	SETZM FDBCHF		;MARK THAT BUGCHK NOT WANTED
	JRST FDBCH0		;GO ENTER COMMON CODE

;ROUTINE TO CHECK A RELATIVE FDB ADR

FDBCHR:	JUMPE A,RSKP		;0 IS ALRIGHT
	SAVET			;SAVE ALL ACS
	ADD A,DIRORA		;GET ABSOLUTE ADR
	JRST FDBCH4		;ENTER COMMON CODE

FDBCHK:	SAVET			;SAVE ALL ACS USED
FDBCH4:	STKVAR <FDBCHA,FDBCHF>
	SETOM FDBCHF		;MARK THAT BUGCHK TO BE DONE ON FAILURE
FDBCH0:	MOVEM A,FDBCHA		;SAVE ADR OF FDB
	LOAD B,DRLFDB		;GET THE ADR OF THE LAST FDB CHECKED
	HRRZS B			;ONLY CHECK 18 BITS
	CAIN B,0(A)		;IF DIFFERENT, THEN MUST DO THE CHECK
	RETSKP			;OTHERWISE, SKIP THE CHECK
	CALL ADRCHK		;CHECK THIS ADDRESS
	 JRST FDBBAD		;NOT GOOD
	LOAD B,FBTYP,(A)	;GET BLOCK TYPE
	LOAD C,FBLEN,(A)	;GET LENGTH OF BLOCK
	CAIL C,.FBLN0		;MUST BE GREATER THAN GROUND 0 LENGTH
	CAIE B,.TYFDB		;BLOCK TYPE MUST BE "FDB"
	JRST FDBBAD		;BAD FDB
	LOAD A,FBNAM,(A)	;GET POINTER TO NAME STRING
	JUMPE A,FDBCH1		;NAME NOT SET UP YET
	CALL NAMCHK		;CHECK NAME
	 RET			;BAD
FDBCH1:	MOVE A,FDBCHA		;GET BACK FDB ADR
	LOAD A,FBEXT,(A)	;GET POINTER TO EXT STRING
	JUMPE A,FDBCH2		;MIGHT NOT BE SET UP YET
	CALL EXTCHK		;CHECK EXT BLOCK
	 RET			;BAD
FDBCH2:	MOVE A,FDBCHA		;GET FDB ADR AGAIN
	LOAD A,FBACT,(A)	;GET POINTER TO ACCOUNT STRING
	JUMPLE A,FDBCH3		;SEE IF THERE IS AN ACCOUNT STRING
	CALL ACTCHK		;YES, CHECK ITS BLOCK TYPE
	 RET			;BAD

	; ..
	; ..

FDBCH3:	MOVE A,FDBCHA		;GET BACK FDB ADDR
	LOAD B,FBVER,(A)	;GET VERSION #
	CAIGE B,1		;VER #1 OR LATER?
	JRST FDBCH6		;OLDER - JUST EXIT
	LOAD A,FBLWR,(A)	;GET LAST WRITER STRING
	JUMPE A,FDBCH5		;IGNORE OF NONE
	CALL UNSCHK		;CHECK ITS BLOCK TYPE
	 RET			;BAD
FDBCH5:	MOVE A,FDBCHA		;FDB ADDRS AGAIN
	LOAD A,FBAUT,(A)	;GET AUTHOR STRING
	JUMPE A,FDBCH6		;ALL DONE IF NONE
	CALL UNSCHK		;CHECK ITS BLOCK TYPE
	 RET			;BAD
FDBCH6:	MOVE A,FDBCHA		;GET ADR OF FDB
	STOR A,DRLFDB		;SAVE IT FOR NEXT TIME
	RETSKP			;FDB LOOKS OK

FDBBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	SKIPE FDBCHF		;BUG CHECK MESSAGE WANTED?
	BUG(DIRFDB,<<A,D>,<B,D>>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK A NAME BLOCK
;ACCEPTS IN A/	RELATIVE ADR OF NAME BLOCK
;	CALL NAMCHK
;RETURNS +1:	BAD BLOCK TYPE
;	 +2:	OK
;ALL ACS SAVED AND RESTORED

NAMCHK:	SAVET			;SAVE ALL ACS
	ADD A,DIRORA		;MAKE ADDRESS ABSOLUTE
	CALL ADRCHK		;CHECK THIS ADDRESS
	 JRST NAMBAD		;NO GOOD
	LOAD B,NMTYP,(A)	;GET BLOCK TYPE
	LOAD C,NMLEN,(A)	;GET LENGTH
	CAIL C,2		;MUST BE AT LEAST 2 WORDS LONG
	CAIE B,.TYNAM		;AND MUST BE A NAME BLOCK
	JRST NAMBAD		;LOSE
	RETSKP			;NAME BLOCK OK

NAMBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRNAM,<<A,D>,<B,D>>)
	RETBAD (DIRX3)


;ROUTINE TO CHECK AN EXTENSION BLOCK
;ACCEPTS IN A/	RELATIVE ADR OF EXTENSION BLOCK
;	CALL EXTCHK
;RETURNS +1:	BAD BLOCK
;	 +2:	OK
;SAVES AND RESTORES ALL ACS

EXTCHK:	SAVET
	ADD A,DIRORA		;MAKE ADDRESS ABSOLTE
	CALL ADRCHK		;SEE IF ADR IS GOOD
	 JRST EXTBAD		;NO GOOD
	LOAD B,EXTYP,(A)	;GET TYPE
	LOAD C,EXLEN,(A)	;AND LENGTH
	CAIL C,2		;LENGTH MUST BE AT LEAST 2
	CAIE B,.TYEXT		;EXTENSION TYPE OK?
	JRST EXTBAD		;NO GOOD
	RETSKP			;OK

EXTBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIREXT,<<A,D>,<B,D>>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK AN ACCOUNT STRING BLOCK
;ACCEPTS IN A/	RELATIVE ADR OF ACCOUNT STRING BLOCK
;	CALL ACTCHK
;RETURNS +1:	BAD ACCOUNT BLOCK
;	 +2:	OK
;SAVES AND RESTORES ALL ACS

ACTCHK:	SAVET
	ADD A,DIRORA		;GET ABS ADR
	CALL ADRCHK		;CHECK ADR
	 JRST ACTBAD		;BAD ADR
	LOAD B,ACTYP,(A)	;GET BLOCK TYPE
	LOAD C,ACLEN,(A)	;AND LENGTH
	CAIL C,3		;MUST BE AT LEAST 3 WORDS LONG
	CAIE B,.TYACT		;ACCOUNT BLOCK TYPE?
	JRST ACTBAD		;NO
	RETSKP			;OK

ACTBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRACT,<<A,D>,<B,D>>)
	RETBAD (DIRX3)


;ROUTINE TO CHECK A FREE BLOCK
;ACCEPTS IN A/	RELATIVE ADR OF FREE BLOCK
;	CALL FRECHK
;RETURNS +1:	BAD
;	 +2:	OK
;SAVES AND RESTORES ALL ACS

FRECHK:	SAVET
	ADD A,DIRORA		;GET ABSOLUTE ADDRESS OF BLOCK
	CALL ADRCHK		;CHECK THE ADDRESS
	 JRST FREBAD		;BAD
	LOAD B,FRTYP,(A)	;GET BLOCK TYPE
	LOAD C,FRLEN,(A)	;AND LENGTH
	CAIL C,2		;LENGTH MUST BE AT LEAST 2
	CAIE B,.TYFRE		;MUST BE A FREE BLOCK
	JRST FREBAD
	LOAD B,FRNFB,(A)	;GET NEXT BLOCK ON CHAIN
	JUMPE B,FRECH1		;0 IS ALWAYS OK
	SUB A,DIRORA		;GET RELATIVE ADR OF THIS BLOCK
	XOR A,B			;SEE IF THE BLOCKS ARE ON THE SAME PAGE
	TRZ A,777		;MASK OFF LOW ORDER BITS
	JUMPN A,FREBAD		;IF NOT ON SAME PAGE, GO COMPLAIN
FRECH1:	RETSKP			;BLOCK IS OK

FREBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRFRE,<<A,D>,<B,D>>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK A USER NAME STRING BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF NAME STRING BLOCK
;	CALL UNSCHK
;RETURNS +1:	BAD USER NAME BLOCK
;	 +2:	OK
;SAVES AND RESTORES ALL ACS

UNSCHK:	SAVET
	ADD A,DIRORA		;GET ABS ADDR
	CALL ADRCHK		;CHECK ADDR
	 JRST UNSBAD		;BAD ADDRS
	LOAD B,UNTYP,(A)	;GET BLOCK TYPE
	LOAD C,UNLEN,(A)	; AND LENGTH
	CAIL C,3		;MUST BE AT LEAST 3
	CAIE B,.TYUNS		;USER NAME BLOCK TYPE?
	JRST UNSBAD		;SOMETHING WRONG
	RETSKP			;GIVE GOOD RETURN

UNSBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR MESSAGE
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG (DIRUNS,<<A,D>,<B,D>>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK THAT AN ADR IS WITHIN THE DIR BOUNDS
;ACCEPTS IN A/	ABS ADR TO BE CHECKED
;	CALL ADRCHK
;RETURNS +1:	ILLEGAL ADR
;	 +2:	OK

ADRCHK:	MOVE B,DIRORA		;GET UPPER BOUNDS
	LOAD B,DRSBT,(B)	;MUST BE BELOW SYMBOL TABLE
	ADD B,DIRORA		;GET ABSOLUTE ADR
	CAML A,DIRORA		;ABOVE LOWER LIMIT?
	CAML A,B		;AND BELOW UPPER LIMIT?
	RETBAD (DIRX3)		;NO
	RETSKP			;YES, ADR IS OK
;ROUTINE TO REBUILD THE SYMBOL TABLE (ON DELDF JSYS)
;ASSUMES DIRECTORY IS MAPPED
;ACCEPTS IN A/	0 - CHECK DIRECTORY
;		-1 - REBUILD DIRECTORY SYMBOL TABLE
;	CALL RBLDST
;RETURNS +1:	DIR IS SCREWED UP AND NOTHING WAS DONE
;	 +2:	SYMBOL TABLE WAS REBUILT

RBLDST:	SAVEPQ			;SAVE PERMANENT ACS USED
	STKVAR <RBLDSP,RBLDSC>
	MOVEM A,P3		;STORE REBUILD FLAG
	SETZM RBLDSC		;CLEAR SUBDIR COUNT
	SETZM RBLDSP		;INITIALIZE POINTER WORD
	CALL BLKSCN		;SCAN THE DIR FOR CONSISTENCY IN BLOCKS
	 RETBAD ()		;DIR IS NOT CONSISTENT, DONT REBUILD
	JUMPN P3,RBLD0A		;REBUILDING?
	CALL SYMSCN		;NO, SCAN SYMBOL TABLE FOR VALIDITY
	 RETBAD ()		;NEEDS REBUILDING
RBLD0A:	MOVE Q1,DIRORA		;GET BASE ADR OF MAPPED AREA
	JUMPE P3,RBLDS0		;IF CHECKING, DONT ZERO SYMBOL TABLE
	LOAD A,DRSTP,(Q1)	;GET TOP OF SYMBOL TABLE
	SUBI A,.SYMLN		;GET NEW BOTTOM OF SYMBOL TABLE
	STOR A,DRSBT,(Q1)	;SYMBOL TABLE IS NOW EMPTY
	ADD A,DIRORA		;GET ABS ADR OF NEW BOTTOM
	MOVEI B,.TYSYM		;SET UP SYMBOL TABLE HEADER
	STOR B,SYMTY,(A)	;BLOCK TYPE
	LOAD B,DRNUM,(Q1)	;DIR NUMBER
	STOR B,SYMDN,(A)	;...
	OPSTRM <SETOM >,SYMVL,(A) ;VALUE = -1
RBLDS0:	LOAD Q2,DRFTP,(Q1)	;GET TOP OF FREE AREA
	ADD Q2,DIRORA		;GET ABS ADR OF TOP OF FREE AREA
RBLDS1:	LOAD A,BLKTYP,(Q1)	;SCAN FOR FDB'S
	CAIN A,.TYFDB		;FOUND AN FDB YET?
	JRST RBLDS3		;YES, GO PROCESS IT
RBLDS2:	LOAD A,BLKLEN,(Q1)	;GET LENGTH OF THIS BLOCK
	ADD Q1,A		;STEP TO NEXT BLOCK IN DIR
	CAMGE Q1,Q2		;REACHED TOP OF DIR YET?
	JRST RBLDS1		;NO, CONTINUE LOOKING FOR FDB'S
	MOVE Q1,DIRORA		;GET BASE ADR
	LOAD A,DRSDC,(Q1)	;GET SUBDIR COUNT FROM DIR
	CAME A,RBLDSC		;SAME AS LOCAL COUNT?
	JRST [	JUMPE P3,[RETBAD(DIRX3)] ;NO - ERROR IF JUST CHECKING
		MOVE A,RBLDSC	;GET CORRECT COUNT
		STOR A,DRSDC,(Q1) ;STORE CORRECTED COUNT IN DIR
		JRST .+1]	;AND CONTINUE
	LOAD A,DRDCA,(Q1)	;GET QUOTA COUNT
	CAMN A,RBLDSP		;DO THEY MATCH?
	RETSKP			;YES, ALL IS OK
	JUMPE P3,[RETBAD (DIRX3)] ;NO, GIVE ERROR IF CHECKING
	MOVE A,RBLDSP		;GET CORRECT COUNT
	STOR A,DRDCA,(Q1)	;STORE CORRECT USAGE COUNT
	RETSKP

RBLDS3:	LOAD A,FBNPG,(Q1)	;GET PAGE COUNT OF THIS FILE
	ADDM A,RBLDSP		;KEEP THIS COUNT
	MOVX A,FB%DIR		;CHECK IF THIS IS A DIRECTORY
	TDNE A,.FBCTL(Q1)	; ??
	AOS RBLDSC		;IT IS - COUNT IT
	LOAD A,FBNAM,(Q1)	;GET POINTER TO NAME STRING
	JUMPE A,RBLDS2		;IF NO NAME, DONT ACCOUNT FOR THIS FDB
	ADD A,DIRORA		;SET UP INDEX REG POINTING TO NAME BLK
	LOAD Q3,NMVAL,(A)	;GET FIRST 5 CHARACTERS OF STRING
	LOAD B,NMLEN,(A)	;GET LENGTH OF STRING
	SUBI B,2		;GET # OF FULL WORDS IN STRING
	AOS A			;MAKE A POINT TO FIRST WORD OF STRING
	MOVEI C,.ETNAM		;LOOKING FOR NAME ENTRY
	CALL LOOKUP		;SEE IF THIS NAME IS IN TABLE ALREADY
	 JRST RBLDS4		;IT ISNT, GO PUT IT INTO SYMBOL TABLE
	MOVE A,DRLOC		;GET POINTER SYMBOL IN TABLE
	LOAD A,SYMAD,(A)	;GET FDB ADR OF FIRST NAME ON CHAIN
	MOVE B,Q1		;GET FDB ADR OF THE BLOCK WE JUST FOUND
	SUB B,DIRORA		;NEED THE RELATIVE ADR FOR FDBSCN
	CALL FDBSCN		;SEE IF THIS FDB IS ON CHAIN ALREADY
	 JRST RBLDS2		;ILLEGAL FORMAT ENCOUNTERED
	JUMPN A,RBLDS5		;IF A=-1, FDB IS ON CHAIN ALREADY
	JUMPE P3,[RETBAD (DIRX3)] ;IF CHECKING, THEN THIS IS AN ERROR
	MOVE A,Q1		;GET FDB ADDRESS
	SUB A,DIRORA		;GET RELATIVE ADR OF FDB
	MOVE B,DRLOC		;GET POINTER TO SYMBOL TABLE ENTRY
	STOR A,SYMAD,(B)	;PUT NEW FDB ADDRESS IN SYMBOL TABLE
	JRST RBLDS5		;NO NEED TO INSERT THE SYMBOL
RBLDS4:	JUMPE P3,[RETBAD (DIRX3)] ;IF CHECKING, THEN THIS IS AN ERROR
	MOVE A,Q1		;GET FDB ADDRESS
	SUB A,DIRORA		;MAKE IT RELATIVE
	MOVE B,Q3		;GET FIRST 5 CHARS OF NAME STRING
	MOVEI C,.ETNAM		;THIS IS A NAME SYMBOL
	CALL INSSYM		;PUT THIS SYMBOL INTO THE TABLE
	 JRST RBLDS7		;RAN OF OF ROOM, GO COMPLAIN
RBLDS5:	LOAD A,FBACT,(Q1)	;GET POINTER TO ACCOUNT STRING IF ANY
	JUMPLE A,RBLDUN		;IF A NUMBERED ACCOUNT, GO CHECK MORE
	ADD A,DIRORA		;GET ABS POINTER TO ACCOUNT STRING
	MOVE Q3,A		;SAVE POINTER TO ACCOUNT STRING
	ADDI A,2		;STEP OVER HEADER AND SHARE COUNT
	LOAD B,ACLEN,(Q3)	;GET LENGTH OF BLOCK
	SUBI B,3		;GET # OF FULL WORDS IN ACCOUNT STRING
	MOVEI C,.ETACT		;LOOKING UP AN ACCOUNT SYMBOL
	CALL LOOKUP		;SEE IF THIS IS ALREADY IN TABLE
	 JRST RBLDS6		;IT ISNT, GO ADD IT TO TABLE
	JUMPE P3,RBLDUN		;IF CHECKING - DON'T INCREMENT
	INCR ACSHR,(Q3)		;INCREMENT SHARE COUNT
	JRST RBLDUN		;CONTINUE 

RBLDS6:	JUMPE P3,[RETBAD (DIRX3)] ;IF CHECKING, THEN THIS IS AN ERROR
	LOAD A,FBACT,(Q1)	;GET ADR OF ACCOUNT STRING
	LOAD B,ACVAL,(Q3)	;GET FIRST 5 CHARS OF STRING
	MOVEI C,.ETACT		;MAKE IT BE AN ACCOUNT SYMBOL
	CALL INSSYM		;INSERT SYMBOL INTO TABLE
	 JRST RBLDS7		;NO MORE ROOM IN SYMBOL TABLE
	MOVEI A,1		;SET THE SHARE COUNT TO 1
	STOR A,ACSHR,(Q3)	;...
	JRST RBLDUN		;GO CONTINUE CHECKING

RBLDS7:	CALL RBLDS9		;REPORT ERROR
	RETBAD (DIRX3)

RBLDS9:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRSY6,<<A,D>,<B,D>>)
	RET
RBLDUN:	LOAD A,FBVER,(Q1)	;GET FDB VERSION NUMBER
	CAIGE A,1		;VER #1 OR LATER
	JRST RBLDS2		;OLD VERSION - IGNORE USER NAMES
	LOAD A,FBAUT,(Q1)	;GET AUTHOR STRING
	JUMPE A,RBDUN1		;IGNORE IF NONE
	CALL UNSRBD		;DO USER NAME ROUTINE
	 RETBAD (DIRX3)		;ERROR
RBDUN1:	LOAD A,FBLWR,(Q1)	;DO LAST WRITER
	JUMPE A,RBLDS2		;DONE IF ZERO
	CALL UNSRBD		;COMMON SUBR
	 RETBAD (DIRX3)		;BAD
	JRST RBLDS2		;CONTINUE SCAN

;COMMON ROUTINE TO CHECK/RE-BUILD A USER NAME STRING
; A/ RELATIVE ADDRS OF STRING
; Q1/ FDB ADDRESS
; P3/ CHECK/RE-BUILD FLAG
;	CALL UNSRBD
;RETURNS +1 IF ERROR
;RETURNS +2 IF OK

UNSRBD:	STKVAR <PTUNS>		;POINTER TO USER NAME
	MOVEM A,PTUNS		;SAVE PNTR
	ADD A,DIRORA		;GET ABS POINTER TO NAME STRING
	MOVE Q3,A		;SAVE POINTER
	ADDI A,2		;ADVANCE OVER HEADER
	LOAD B,UNLEN,(Q3)	;GET LENGTH OF BLOCK
	SUBI B,3		;# OF FULL WORDS
	MOVEI C,.ETUNS		;USER NAME TYPE
	CALL LOOKUP		;SEE IF IN TABLE
	 JRST UNSRB1		;NOT THERE, ENTER IT
	JUMPE P3,RSKP		;RETURN OK IF JUST CHECKING
	INCR UNSHR,(Q3)		;INCREMENT SHARE COUNT
	RETSKP			;GOOD RETURN

UNSRB1:	JUMPE P3,R		;RETURN ERROR IF CHECKING
	MOVE A,PTUNS		;RESTORE POINTER
	LOAD B,UNVAL,(Q3)	;GET FIRST 5 CHARS OF STRING
	MOVEI C,.ETUNS		;USER NAME TYPE
	CALL INSSYM		;INSERT SYMBOL
	 CALLRET RBLDS9		;REPORT ERROR AND RETURN
	MOVEI A,1		;SET SHARE COUNT TO 1
	STOR A,UNSHR,(Q3)	;...
	RETSKP			;GOOD RETURN
;ROUTINE TO SCAN SYMBOL TABLE FOR VALIDITY
;	CALL SYMSCN
;RETURNS +1:	SYMBOL TABLE IS INCONSISTENT
;	 +2:	OK

SYMSCN:	SAVEQ
	CALL SYMCHK		;CHECK THE HEADER
	 RETBAD ()		;BAD
	MOVE D,DIRORA		;GET BASE ADDRESS
	LOAD C,DRSBT,(D)	;GET BASE OF SYMBOL TABLE
	LOAD D,DRSTP,(D)	;GET TOP OF SYMBOL TABLE
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	ADD D,DIRORA
	SETZB Q1,Q2		;INITIALIZE PREVIOUS SYMBOL VALUE
SYMSCL:	ADDI C,.SYMLN		;STEP TO NEXT SYMBOL
	CAML C,D		;AT END OF SYMBOL TABLE YET?
	RETSKP			;YES, ALL DONE
	LOAD A,SYMET,(C)	;GET SYMBOL TYPE
	CAIE A,.ETNAM		;NAME TYPE?
	RETSKP			;NO, ALL DONE
	LOAD A,SYMAD,(C)	;GET FDB ADDRESS
	ADD A,DIRORA		;GET ABSOLUTE ADR OF FDB
	LOAD A,FBNAM,(A)	;GET ADDRESS OF NAME STRING
	ADD A,DIRORA
	CAMN A,Q2		;SAME ADDRESS OF LAST NAME STRING?
	RETBAD (DIRX3)		;YES, THIS IS AN ERROR
	MOVE Q2,A		;SAVE ADR OF LAST NAME STRING
	LOAD B,SYMVL,(C)	;GET FIRST 5 CHARACTERS
	CAME B,1(A)		;IS THIS A MATCH?
	RETBAD (DIRX3)		;NO, SYMBOL TAABLE IS BAD
	LSH B,-1		;CLEAR OUT BIT 35
	CAMGE B,Q1		;IS THIS SYMBOL GREATER THAN LAST ONE?
	RETBAD (DIRX3)		;NO, NEED TO REBUILD
	MOVE Q1,B		;SAVE LAST SYMBOL VALUE
	JRST SYMSCL		;LOOP BACK FOR ALL SYMBOLS
;ROUTINE TO SCAN ALL BLOCKS IN A DIR TO SEE IF DIR IS CONSISTENT
;ASSUMES DIR IS MAPPED
;	CALL BLKSCN
;RETURNS +1:	DIR IS NOT IN A CONSISTENT STATE
;	 +2:	DIR IS OK

BLKSCN::SE1CAL
	SAVEQ
	MOVE Q1,DIRORA		;GET BASE ADR OF DIR AREA
	LOAD Q2,DRFTP,(Q1)	;GET TOP OF FREE AREA
	ADD Q2,DIRORA		;MAKE IT ABSOLUTE
BLKSC1:	LOAD A,BLKTYP,(Q1)	;GET TYPE OF THIS BLOCK
	MOVSI B,-BLKTBL		;SET UP AOBJN POINTER TO BLOCK TABLE
BLKSC2:	HLRZ C,BLKTAB(B)	;GET BLOCK TYPE FROM TABLE
	CAME A,C		;FOUND THIS BLOCK TYPE?
	AOBJN B,BLKSC2		;NO, KEEP LOOKING
	JUMPGE B,BLKSCE		;IF NOT FOUND, BOMB OUT
	HRRZ B,BLKTAB(B)	;GET DISPATCH ADDRESS
	MOVE A,Q1		;GET ADR OF BLOCK
	SUB A,DIRORA		;MAKE IT RELATIVE
	CALL 0(B)		;CHECK THIS BLOCK TYPE
	 RETBAD ()		;BLOCK IS BAD
	LOAD A,BLKLEN,(Q1)	;GET LENGTH OF BLOCK
	ADD Q1,A		;STEP TO NEXT BLOCK IN DIR
	CAMGE Q1,Q2		;REACHED END YET?
	JRST BLKSC1		;NO, GO CONTINUE CHECKING
	CAME Q1,Q2		;LAST BLOCK MUST END AT FRETOP
	RETBAD (DIRX3)		;IT DIDNT
	RETSKP			;DIRECTORY IS IN GOOD SHAPE

BLKSCE:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET STRUCTURE NAME FOR CONNECTED STRUCTURE
	BUG(DIRBLK,<<A,D>,<B,D>>)
	RETBAD (DIRX3)

BLKTAB:	.TYNAM,,NAMCHK		;NAME BLOCK
	.TYEXT,,EXTCHK		;EXTENSION BLOCK
	.TYACT,,ACTCHK		;ACCOUNT BLOCK
	.TYUNS,,UNSCHK		;USER NAME BLOCK
	.TYFDB,,FDBSCN		;FDB BLOCK
	.TYDIR,,DRCHK		;DIR HEADER BLOCK
	.TYFRE,,FRECHK		;FREE BLOCK
	.TYGDB,,RSKP		;GROUP DESCRIPTOR BLOCK
	.TYFBT,,RSKP		;FREE BIT TABLE
BLKTBL==.-BLKTAB
;ROUTINE TO SCAN AN FDB CHAIN FOR LEGALITY
;ACCEPTS IN A/	RELATIVE ADR OF STARTING FDB
;	    B/	RELATIVE ADR OF ANOTHER FDB (OPTIONAL)
;	CALL FDBSCN
;RETURNS +1:	FDB CHAIN IS MESSED UP
;	 +2:	FDB CHAIN IS OK
;		A/	0 MEANS SECOND FDB IS NOT ON THE CHAIN
;			-1 MEANS SECOND FDB IS ON THE CHAIN

FDBSCN:	STKVAR <FDBSCA,FDBSCB,FDBSCV>
	MOVEM B,FDBSCB		;SAVE ADR OF SECOND FDB
	SETZM FDBSCV		;INITIALIZE RETURN VALUE
FDBSC1:	CAMN A,FDBSCB		;FOUND THE SECOND FDB?
	SETOM FDBSCV		;YES, RETURN TRUE
	ADD A,DIRORA		;GET ABS ADR OF FDB
	MOVEM A,FDBSCA		;SAVE ADDRESS OF FDB
FDBSC2:	CALL FDBCHK		;CHECK THE LEGALITY OF THIS FDB
	 RET			;BAD
	LOAD A,FBGNL,(A)	;GET POINTER TO NEXT GENERATION FDB
	JUMPE A,FDBSC3		;END OF GENERATION CHAIN?
	CAMN A,FDBSCB		;IS THIS THE FDB BEING LOOKED FOR
	SETOM FDBSCV		;YES, MARK THAT IT IS ON CHAIN
	ADD A,DIRORA		;NO, GET ABS ADR OF THIS FDB
	JRST FDBSC2		;GO CONTINUE DOWN GENERATION CHAIN

FDBSC3:	MOVE A,FDBSCA		;GET ADR OF TOP FDB ON EXT CHAIN
	LOAD A,FBEXL,(A)	;STEP TO NEXT EXTENSION IN CHAIN
	JUMPN A,FDBSC1		;IF MORE FDB'S, GO LOOK AT THEM
	MOVE A,FDBSCV		;GET RETURN VALUE
	RETSKP			;FDB CHAIN IS OK


;ROUTINE TO CHECK A DIRECTORY HEADER BLOCK
;ACCEPTS IN A/	RELATIVE ADR OF BLOCK
;	CALL DRCHK
;RETURNS +1:	BAD FORMAT FOR HEADER
;	 +2:	OK

DRCHK:	TRNE A,777		;MUST BE ON A PAGE BOUNDARY
	RETBAD (DIRX3)		;OTHERWISE BLOCK IS BAD
	LSH A,-PGSFT		;GET PAGE #
	JUMPE A,RSKP		;HEADER ON PAGE 0 WAS CHECKED BY SETDIR
	CALLRET DRHCHK		;GO CHECK HEADER
;ROUTINE TO ASSIGN SPACE IN THE DIRECTORY
;ASSUMES THE APPROPRIATE DIRECTORY IS MAPPED
;ACCEPTS IN B/	NUMBER OF WORDS DESIRED
;	CALL ASGDFR
;RETURNS +1:	NO ROOM
;	 +2:	ABSOLUTE ADDRESS OF BLOCK

ASGDFR::SE1CAL
	SAVEQ			;SAVE ANY PERMANENT ACS USED
	TRVAR <ASGDFN,ASGDFM,ASGDFA,ASGDFS,ASGDFP,ASGDFL>
	MOVEM B,ASGDFN		;SAVE THE DESIRED BLOCK SIZE
	ADDI B,.FRHLN		;GET MINIMUM SIZE IF NOT EXACTLY EQUAL
	MOVEM B,ASGDFM		;THIS QUARANTEES NO BLK SMALLER THAN 2
	MOVE Q1,DIRORA		;SET UP BASE ADDRESS OF DIRECTORY
	CALL ASGDF		;SEE IF ROOM CAN BE FOUND
;**;[7360] Revoke edit 7335		MDR	3-SEP-86
;**;[7335] Add 5 lines at ASGDFR:+8L	MDR	15-JUL-86
	 SKIPA			;NO
	RETSKP			;YES, RETURN TO CALLER
	LOAD A,DRFBT,(Q1)	;GET POINTER TO FREE BIT TABLE
	JUMPE A,R		;IF NO TABLE, THEN THERE IS NO ROOM
	ADD A,DIRORA		;GET ABS ADR OF TABLE
	LOAD B,BLKTYP,(A)	;CHECK BLOCK TYPE
	CAIE B,.TYFBT		;MUST BE THE FREE BIT TABLE
	RET			;IF NOT, THEN THERE IS NO ROOM
	LOAD B,BLKLEN,(A)	;GET LENGTH OF TABLE
ASGDF7:	SOJLE B,ASGDF		;INITIALIZED TABLE YET?
	SETOM 1(A)		;MARK ALL PAGES AS HAVING ROOM
	AOJA A,ASGDF7		;STEP TO NEXT TABLE ELEMENT

ASGDF:	SETZM ASGDFP		;START AT PAGE 0 OF DIRECTORY
ASGDF1:	CALL ASDFRP		;GO LOOK AT CURRENT PAGE IN ASGDFP
	 JRST ASGDF4		;NO ROOM ON THAT PAGE
ASGDF0:	MOVE A,ASGDFA		;GET ADDRESS OF FREE BLOCK CHOSEN
	LOAD B,FRLEN,(A)	;GET ITS LENGTH
	SUB B,ASGDFN		;GET LENGTH OF REMAINDER OF FREE BLOCK
	JUMPE B,ASGDF2		;TAKING WHOLE BLOCK?
	ADD A,ASGDFN		;GET START OF REMAINDER OF THIS BLOCK
	STOR B,FRLEN,(A)	;SET UP NEW LENGTH OF THIS BLOCK
	MOVE C,ASGDFA		;GET ADDRESS OF BLOCK AGAIN
	LOAD C,FRNFB,(C)	;GET FORWARD LINK FROM OLD BLOCK
	STOR C,FRNFB,(A)	;MAKE SHORTENED BLOCK POINT DOWN CHAIN
	MOVEI C,.TYFRE		;SET UP BLOCK TYPE
	STOR C,FRTYP,(A)
	SUB A,DIRORA		;GET RELATIVE ADDRESS OF SHORTENED BLK
	MOVE C,ASGDFL		;GET POINTER TO LAST BLOCK
	STOR A,FRNFB,(C)	;FIX UP FREE CHAIN
	MOVE A,ASGDFA		;GET ADDRESS OF BLOCK FOR CALLER
	JRST ASGDF3		;GO RETURN ADDRESS OF BLOCK

ASGDF2:	LOAD B,FRNFB,(A)	;USING WHOLE BLOCK, CHANGE LINKS
	MOVE C,ASGDFL		;GET ADDRESS OF LAST FREE BLOCK
	STOR B,FRNFB,(C)	;ELIMINATE THIS BLOCK FROM CHAIN
ASGDF3:	MOVE B,ASGDFN		;GET SIZE OF BLOCK
	STOR B,FRLEN,(A)	;SET UP LENGTH OF BLOCK
	SETZRO FRVER,(A)	;CLEAR VERSION #
	RETSKP			;GIVE SUCCESSFUL RETURN WITH ADR IN A
ASGDF4:	AOS A,ASGDFP		;STEP TO NEXT PAGE IN THE DIRECTORY
	CAML A,NDIRPG		;ABOVE LIMIT OF DIR?
	RET			;YES, NO MORE ROOM
	LOAD B,DRFTP,(Q1)	;GET THE ADDRESS OF THE LAST PAGE USED
	SOS B			;START WITH ADR OF LAST WORD USED
	LSH B,-PGSFT		;GET PAGE NUMBER
	CAMG A,B		;ARE WE NOW ABOVE LAST USED PAGE?
	JRST ASGDF1		;NO, LOOP BACK AND LOOK AT NEXT PAGE
	SOS ASGDFP		;YES, GO BACK TO THAT PAGE
	LOAD A,DRFTP,(Q1)	;GET CURRENT FREE TOP
	MOVE B,A		;...
	ADDI B,PGSIZ-1		;STEP TO NEXT PAGE
	TRZ B,777		;GET ADDRESS OF FIRST WORD OF NEXT PAGE
	LOAD C,DRSBT,(Q1)	;GET ADDRESS OF START OF SYMBOL TABLE
	CAMLE B,C		;GET LOWEST UPPER LIMIT FOR FREE TOP
	MOVE B,C		;...
	SUB B,A			;GET FREE SPACE FROM FREE TOP TO LIMIT
	CAIGE B,.FRHLN		;ENOUGH TO GET A LEGAL SIZE FREE BLOCK?
	JRST ASGDF5		;NO, GO EXPAND BY ONE PAGE
	ADD A,DIRORA		;GET ABSOLUTE ADDRESS OF FREE TOP
	STOR B,FRLEN,(A)	;MAKE THIS INTO A FREE BLOCK
	SETZRO FRVER,(A)
	ADD B,A			;GET NEW FREE TOP
	SUB B,DIRORA		;MAKE IT RELATIVE
	STOR B,DRFTP,(Q1)	;STORE NEW FREE TOP
	MOVE B,A		;GET ADDRESS OF THIS BLOCK
	CALL RELDFA		;RELEASE THIS BLOCK TO THE FREE POOL
	CALL ASDFRP		;GO SEE IF THERE IS ENOUGH ROOM NOW
	 JRST ASGDF5		;NO, TRY MOVING SYMBOL TABLE UP
	JRST ASGDF0		;FOUND ROOM, GO RETURN IT
ASGDF5:	LOAD A,DRSBT,(Q1)	;NOW SEE IF ENOUGH ROOM TO INITIALIZE
	OPSTR <SUB A,>,DRFTP,(Q1) ; HEADER ON NEXT PAGE
	CAIGE A,.DIHL1		;ENOUGH ROOM FOR HEADER?
	JRST ASGDF6		;NO, MOVE SYMBOL TABLE UP ONE PAGE
	LOAD A,DRFTP,(Q1)	;GET FREE TOP
	TRNE A,777		;MAKE SURE IT IS ON A PAGE BOUNDARY
	JRST ASGDF6		;SHOULD HAVE BEEN, GO FIX THIS MESS
	ADD A,DIRORA		;MAKE ADDRESS ABSOLUTE
	MOVEI B,.TYDIR		;SET UP HEADER FOR THIS PAGE
	STOR B,DRTYP,(A)	;SET UP TYPE
	LOAD B,DRNUM,(Q1)	;DIR NUMBER
	STOR B,DRNUM,(A)	;FOR THIS PAGE
	MOVE B,A		;GET RELATIVE PAGE NUMBER OF THIS PAGE
	SUB B,DIRORA		;MAKE IT RELATIVE
	LSH B,-PGSFT		;...
	STOR B,DRRPN,(A)	;SAVE THIS FOR CONSISTENCY CHECK
	MOVEI B,.DIHL1		;GET LENGTH OF THIS HEADER AREA
	STOR B,DRHLN,(A)	;GUARANTEED TO BE OTHER THAN PAGE 0
	SETZRO DRFFB,(A)	;NO SPACE ON FREE LIST
	ADD B,A			;GET NEW FREE TOP ADDRESS
	SUB B,DIRORA		;GET RELATIVE ADDRESS
	STOR B,DRFTP,(Q1)	;SET UP NEW FREE TOP
	JRST ASGDF4		;GO TRY TO GET SPACE NOW

ASGDF6:	CALL XPANDP		;MOVE THE SYMBOL TABLE UP ONE PAGE
	 RET			;CANNOT GROW DIR ANY MORE
	JRST ASGDF4		;LOOP BACK AND LOOK AT THIS PAGE AGAIN
;ROUTINE TO LOOK FOR SPACE ON A PARTICULAR PAGE
;ASSUMES THAT ASGDFN, ASGDFM, AND ASGDFP ARE SET UP.
;	CALL ASDFRP		;CAN ONLY BE CALLED BY ASGDFR
;RETURNS +1:	NO BLOCK LARGE ENOUGH ON THIS PAGE
;	 +2:	ASGDFS, ASGDFL, AND ASGDFA SET UP

ASDFRP:	MOVE A,ASGDFP		;GET THE PAGE #
	CALL FBTCHK		;IS THERE ROOM ON THIS PAGE?
	 RET			;NO, DONT TOUCH THIS PAGE
	MOVE A,ASGDFP		;GET THE PAGE #
	CALL DRHCHK		;CHECK THE HEADER
	 RET			;HEADER BAD, SKIP THIS PAGE
	MOVE A,ASGDFP		;GET THE PAGE NUMBER
	LSH A,PGSFT		;TURN IT INTO AN ADDRESS
;**;[7360] Revoke edit 7335		MDR	3-SEP-86
;**;[7335] Add 2 lines at ASDFRP:+8L	MDR	15-JUL-86
	ADD A,DIRORA		;GET ABS ADR OF START OF THIS PAGE
	LOAD D,DRFFB,(A)	;GET ADDRESS OF FIRST FREE BLOCK
	JUMPE D,ASDFR4		;IF NONE, RETURN NOW
	MOVSI C,1		;START WITH LARGE NUMBER
	MOVEM C,ASGDFS		;IN SIZE WORD
	MOVE B,A		;GET ADDRESS OF DRFFB FOR THIS PAGE
	ADD B,[.DRFFB-.FRNFB]
ASDFR1:	EXCH A,D		;CHECK THIS FREE BLOCK
	CALL FRECHK		;...
	 RET			;BAD, SKIP THIS PAGE
	EXCH A,D
	ADD D,DIRORA		;MAKE ADDRESS BE ABSOLUTE
	EXCH B,D		;SAVE ADR OF LAST ONE IN D
	LOAD C,FRLEN,(B)	;GET LENGTH OF THIS FREE BLOCK
	CAMN C,ASGDFN		;EXACTLY THE RIGHT SIZE?
	JRST ASDFR2		;YES, USE IT
	CAMGE C,ASGDFM		;IS IT BIGGER THAN MINIMUM?
	JRST ASDFR3		;NO, GO LOOK DOWN REST OF CHAIN
	CAML C,ASGDFS		;LESS THAN THE BEST ONE YET?
	JRST ASDFR3		;NO, IGNORE IT
ASDFR2:	MOVEM C,ASGDFS		;SAVE THIS SIZE
	MOVEM B,ASGDFA		;SAVE ADR OF THIS BLOCK
	MOVEM D,ASGDFL		;AND ADDRESS OF LAST BLOCK
	CAMN C,ASGDFN		;EXACT MATCH?
	RETSKP			;YES, EXIT PROMPTLY
ASDFR3:	LOAD D,FRNFB,(B)	;GET ADDRESS OF NEXT FREE BLOCK
	JUMPN D,ASDFR1		;LOOP BACK TIL END OF CHAIN
	MOVE C,ASGDFS		;GET SIZE OF BEST ONE SEEN
	TLNN C,-1		;DID WE FIND ANY THAT WERE LARGE ENOUGH
	RETSKP			;YES, RETURN SUCCESSFUL
ASDFR4:	MOVE A,ASGDFP		;NO, GET PAGE NUMBER
	CALLRET FBTCLR		;MARK THAT THERE IS NO ROOM ON PAGE
;ROUTINE TO RETURN SPACE TO THE DIRECTORY FREE POOL
;ACCEPTS IN B/	ADDRESS OF THE BLOCK TO BE RETURNED
;		THE LENGTH FIELD OF THE BLOCK MUST BE CORRECT
;	CALL RELDFR	OR	CALL RELDFA
;RETURNS +1:	ALWAYS

RELDFR::ADD B,DIRORA		;RELATIVE ADDRESS ENTRY POINT
RELDFA::SE1CAL
	STKVAR <RELDFB>		;ABSOLUTE ADDRESS ENTRY POINT
	MOVE A,B		;GET ADDRESS IN AC A
	MOVEM A,RELDFB		;SAVE ADDRESS OF BLOCK
	TRZ B,777		;GET ADR OF START OF PAGE
	OPSTR <ADD B,>,DRHLN,(B) ;GET END OF HEADER AREA
	CAMLE B,RELDFB		;ADR CANNOT BE IN HEADER AREA
	JRST RLDFB6		;ERROR
	LOAD B,FRLEN,(A)	;GET LENGTH OF THE BLOCK
	CAIGE B,.FRHLN		;IS THIS A LEGAL SIZE BLOCK?
	JRST RLDFB1		;BLOCK TOO SMALL
	ADD B,A			;GET END OF THIS BLOCK
	MOVE C,DIRORA		;GET BASE OF DIRECTORY
	LOAD C,DRFTP,(C)	;GET TOP OF FREE SPACE
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	CAMLE B,C		;IS THIS BLOCK TOO LARGE?
	JRST RLDFB2		;BLOCK TOO LARGE
	SOS B			;GET LAST WORD OF THIS BLOCK
	TDZ B,A			;SEE IF BLOCK CROSES PAGE BOUNDARY
	TRNE B,777000		;HIGH ORDER BITS OF ADR'S MUST MATCH
	JRST RLDFB3		;BLOCK CROSSES PAGE BOUNDARY
	MOVEI C,.TYFRE		;TURN IT INTO A FREE BLOCK
	STOR C,FRTYP,(A)	;...
	SETZRO FRVER,(A)	;...
	TRZ A,777		;GET ADDRESS OF START OF THIS PAGE
	ADD A,[.DRFFB-.FRNFB]	;GET ADDRESS OF START OF CHAIN
	MOVE C,A		;REMEMBER STARTING ADR
RELDF1:	LOAD B,FRNFB,(A)	;GET NEXT BLOCK ON THE CHAIN
	JUMPE B,RELDF5		;REACHED THE END OF CHAIN?
	CAMN C,A		;IS THIS FIRST BLOCK
	JRST RLDF1A		;YES, DONT NEED TO CHECK BLOCK TYPE
	EXCH A,B		;CHECK THE FREE BLOCK
	CALL FRECHK		;...
	 RET			;BAD, RETURN
	EXCH A,B
RLDF1A:	ADD B,DIRORA		;NO, MAKE ADR ABSOLUTE
	CAMN B,RELDFB		;THE SAME AS BLOCK BEING RETURNED?
	JRST RLDFB5		;BLOCK ALREADY ON FREE LIST
	CAML B,RELDFB		;PAST THE BLOCK BEING RETURNED?
	JRST RELDF2		;YES, FOUND WHERE TO PUT BLOCK
	MOVEM B,A		;REMEMBER ADR OF LAST BLOCK
	JRST RELDF1		;LOOP BACK TIL RIGHT PLACE IS FOUND
RELDF2:	CAMN C,A		;DID WE GET PAST FIRST ONE?
	JRST RELDF4		;NO, HANDLE THIS SPECIALLY
	MOVE C,RELDFB		;GET ADDRESS OF BLOCK BEING RETURNED
	LOAD D,FRLEN,(A)	;GET LENGTH OF THIS FREE BLOCK
	ADD D,A			;GET ADR OF WORD AFTER BLOCK
	CAMGE C,D		;IS BLOCK BEING RETURNED ABOVE THIS
	JRST RLDFB5		;NO, BLOCK ON FREE LIST ALREADY
	LOAD D,FRNFB,(A)	;GET LAST LINK
	STOR D,FRNFB,(C)	;MAKE THIS BLOCK POINT DOWN THE LIST
	SUB C,DIRORA		;GET RELATIVE ADR OF THIS BLOCK
	STOR C,FRNFB,(A)	;MAKE LAST BLOCK POINT TO THIS ONE
RELDF6:	LOAD C,FRLEN,(A)	;NOW COMPACT THE BLOCKS
	ADD C,A			;GET END OF PREVIOUS BLOCK
	CAME C,RELDFB		;IS THIS SAME AS BLOCK RETURNED?
	JRST RELDF3		;NO
	LOAD D,FRLEN,(C)	;YES, GET LENGTH OF THIS BLOCK
	OPSTR <ADD D,>,FRLEN,(A) ;GET NEW LENGTH OF PREVIOUS BLOCK
	STOR D,FRLEN,(A)	;STORE NEW LENGTH
	LOAD D,FRNFB,(C)	;GET LINK FROM BLOCK
	STOR D,FRNFB,(A)	;MAKE PREVIOUS BLOCK POINT DOWN CHAIN
	MOVEM A,RELDFB		;UPDATE ADDRESS OF BLOCK BEING RETURNED
RELDF3:	MOVE A,RELDFB		;GET ADDRESS OF BLOCK BEING RETURNED
	LOAD C,FRLEN,(A)	;GET LENGTH OF THIS BLOCK
	ADD C,A			;GET END OF THIS BLOCK
	CAME C,B		;DOES IT BOUND ON NEXT BLOCK
	JRST RELDF7		;NO
	LOAD C,FRLEN,(B)	;YES, MERGE THE BLOCKS
	OPSTR <ADD C,>,FRLEN,(A) ;GET LENGTH OF COMBINED BLOCKS
	STOR C,FRLEN,(A)	;STORE NEW LENGTH
	SETZRO FRVER,(A)	;CLEAR VERSION FIELD
	LOAD C,FRNFB,(B)	;GET LINK
	STOR C,FRNFB,(A)	;UPDATE LINK TO NEXT BLOCK
RELDF7:	LOAD B,FRLEN,(A)	;GET LENGTH OF FREE BLOCK BEING RET'D
	CAIG B,.FRHLN		;IS THIS LONGER THAN THE MINIMUM
	JRST RELDF8		;NO, DONT ZERO ANY WORDS
	SETZM .FRHLN(A)		;YES, ZERO THE REMAINDER OF THE FREE BLK
	CAIN B,.FRHLN+1		;IS THIS BLOCK ALREADY ZEROED NOW?
	JRST RELDF8		;YES, DONT DO THE BLT
	ADD B,A			;GET END OF BLOCK
	HRLI A,.FRHLN(A)	;SET UP SOURCE FOR BLT
	HRRI A,.FRHLN+1(A)	;SET UP DESTINATION
	BLT A,-1(B)		;ZERO THE BLOCK
RELDF8:	MOVE A,RELDFB		;GET ADDRESS OF BLOCK
	SUB A,DIRORA		;MAKE IT RELATIVE
	LSH A,-PGSFT		;GET PAGE NUMBER
	CALLRET FBTSET		;MARK THAT THERE IS ROOM ON THIS PAGE
RELDF4:	SUB B,DIRORA		;MAKE ADDRESS OF NEXT BLOCK RELATIVE
RELDF5:	MOVE D,RELDFB		;GET ADDRESS OF BLOCK BEING RETURNED
	STOR B,FRNFB,(D)	;MAKE THIS BLOCK POINT DOWN THE CHAIN
	SUB D,DIRORA		;MAKE ADR OF THIS BLOCK RELATIVE
	STOR D,FRNFB,(A)	;SET UP POINTER TO THIS BLOCK
	ADD B,DIRORA		;GET ABSOLUTE ADDRESS AGAIN
	CAMN C,A		;IS THIS THE FIRST BLOCK ON THE CHAIN
	JRST RELDF3		;YES, ONLY COMPAT WITH NEXT BLOCK
	JRST RELDF6		;TRY TO COLAPSE IN BOTH DIRECTIONS
RLDFB1:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRB2S,<<A,D>,<B,D>>)
	RETBAD (DIRX3)

RLDFB2:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRB2L,<<A,D>,<B,D>>)
	RETBAD (DIRX3)

RLDFB3:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRBCB,<<A,D>,<B,D>>)
	RETBAD (DIRX3)

RLDFB4:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRIFB,<<A,D>,<B,D>>)
	RETBAD (DIRX3)

RLDFB5:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRBAF,<<A,D>,<B,D>>)
	RETBAD (DIRX3)

RLDFB6:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(DIRRHB,<<A,D>,<B,D>>)
	RETBAD (DIRX3)


;ROUTINE TO GET SIXBIT STRUCTURE NUMBER INTO AC B
; THIS ROUTINE DOES NOT CLOBBER ANYTHING EXCEPT B
; IT ASSUMES THAT THE DIRECTORY IS LOCKED

GETSNM:	LOAD B,CURSTR		;GET STRUCTURE NUMBER
	MOVE B,STRTAB(B)	;GET INDEX INTO STRTAB
	LOAD B,STRNAM,(B)	;GET SIXBIT STR NAME
	RET			;AND RETURN
;ROUTINES TO MANIPULATE THE FREE POOL BIT TABLE

;THE FREE BIT TABLE IS USED TO AVOID UNNECESSARY PAGING ACTIVITY
;DURING THE CREATION OF NEW FILES IN A DIRECTORY.  THERE IS A BIT PER
;DIRECTORY PAGE.  THE BIT SET MEANS THE LAST TIME A REQUEST FOR SPACE
;ON THIS PAGE WAS MADE, THERE WAS ROOM TO SATISFY THAT REQUEST.
;ASGDFR WILL ONLY LOOK ON A PAGE IF THE BIT IN THE FREE BIT TABLE IS
;SET.  IF NO FREE SPACE CANN BE FOUND, ASGDFR WILL THEN TRY ALL PAGES.
;BITS GET CLEARED WHEN A REQUEST FOR SPACE ON A PAGE FAILS, AND THEY
;GET SET WHEN ROOM IS RELEASED ON A PAGE.
;THIS MECHANISM SHOULD HELP KEEP FDB'S AND THE CORRESPONDING NAME OR
;EXTENSION STRINGS ALL ON THE SAME PAGE.


;ROUTINES TO SET AND CLEAR BITS IN FREE BIT TABLE
;ACCEPTS IN A/	PAGE NUMBER
;	CALL FBTSET	OR	CALL FBTCLR
;RETURNS +1:	ALWAYS

FBTSET:	TDZA C,C		;SET BIT
FBTCLR:	SETO C,			;CLEAR BIT
	MOVE D,DIRORA		;GET BASE ADR OF DIR AREA
	LOAD D,DRFBT,(D)	;GET ADR OF FREE BIT TABLE
	JUMPE D,R		;IF NO TABLE, IGNORE REQUEST
	ADD D,DIRORA		;GET ABS ADR OF TABLE
	LOAD B,BLKTYP,(D)	;CHECK BLOCK TYPE OF TABLE
	CAIE B,.TYFBT		;MUST BE FREE BIT TABLE
	RET			;IF NOT, IGNORE REQUEST
	IDIVI A,^D36		;GET BIT POSITION IN TABLE
	PUSH P,C		;SAVE REQUEST FLAG
	LOAD C,BLKLEN,(D)	;MAKE SURE PAGE IS WITHIN TABLE
	CAIG C,1(A)		;...
	JRST PA1		;BEYOND END OF TABLE, IGNORE REQUEST
	POP P,C			;GET BACK FLAG
	MOVE B,BITS(B)		;GET MASK
	ADD A,D			;GET ADR OF TABLE ENTRY
	JUMPE C,FBTST1		;C=0 MEANS SET BIT
	ANDCAM B,1(A)		;CLEAR BIT IN TABLE
	RET

FBTST1:	IORM B,1(A)		;SET BIT IN TABLE
	RET			;AND RETURN
;ROUTINE TO CHECK IF THERE IS ROOM ON A PAGE
;ACCEPTS IN A/	PAGE #
;	CALL FBTCHK
;RETURNS +1:	NO ROOM ON THIS PAGE
;	 +2:	THE BIT IS SET, MEANING THAT THERE MAY BE ROOM ON PAGE

FBTCHK:	STKVAR <FBTCHP>
	MOVEM A,FBTCHP		;SAVE PAGE NUMBER
FBTCH0:	MOVE D,DIRORA		;GET BASE OF DIR AREA
	LOAD D,DRFBT,(D)	;GET POINTER TO FREE BIT TABLE
	JUMPE D,RSKP		;IF NONE, GO LOOK ON THIS PAGE ALWAYS
	ADD D,DIRORA		;GET ABS ADR OF FREE BIT TABLE
	LOAD B,BLKTYP,(D)	;CHECK IT FOR LEGALITY
	CAIE B,.TYFBT		;MUST BE FREE BIT TABLE TYPE
	RETSKP			;PRETEND THERE IS ROOM ON PAGE
	LOAD B,BLKLEN,(D)	;GET LENGTH OF FREE TABLE
	CAMGE B,FBTSIZ		;IS IT BIG ENOUGH?
	RETSKP			;PRETEND THERE IS ROOM ON THIS PAGE
	IDIVI A,^D36		;GET INDEX INTO BIT TABLE AND BIT POS
	MOVE C,BITS(B)		;GET BIT MASK
	ADD A,D			;GET ADR OF WORD IN TABLE -1
	TDNN C,1(A)		;IS BIT SET?
	RET			;NO, GIVE NON-SKIP RETURN
	RETSKP			;YES, SKIP RETURN
;Expand symbol table region of a directory
;	CALL XPAND
;RETURNS +1:	DIRECTORY FULL AND CANNOT BE EXPANDED
;	 +2:	SUCCESSFUL
;		DRLOC IS UPDATED TO POINT TO NEW SYMBOL TABLE LOC

XPAND:	SAVET			;SAVE ALL ACS USED
	MOVE D,DIRORA		;SET UP BASE ADDRESS OF MAPPED DIR
	LOAD B,DRFTP,(D)	;GET TOP OF FREE POOL
	SOS B			;GET ADR OF LAST USED WORD
	TRZ B,777		;GET PAGE NUMBER OF LAST PAGE USED
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	MOVE A,B		;SAVE ADDRESS OF BASE
	ADD A,[.DRFFB-.FRNFB]	;GET ADDRESS OF POINTER TO FIRST BLOCK
	LOAD C,DRFFB,(B)	;GET FREE LIST POINTER FOR THIS PAGE
	JUMPE C,XPAND2		;IF NO FREE BLOCKS, TRY TO USE HEADER
XPAND0:	EXCH A,C		;CHECK THE FREE BLOCK
	CALL FRECHK		;...
	 JRST XPANDP		;BAD, GO EXPAND BY A PAGE
	ADD A,DIRORA		;GET ABSOLUTE ADR OF BLOCK
	LOAD B,FRNFB,(A)	;GET POINTER TO NEXT FREE BLOCK
	JUMPE B,XPAND1		;ZERO MEANS AT END OF LIST
	MOVE C,B		;SEARCH FOR THE END OF THE FREE LIST
	JRST XPAND0		; TO SEE IF WE CAN SHORTEN LAST BLK
XPAND1:	LOAD B,FRLEN,(A)	;GET THE LENGTH OF THIS BLOCK
	ADD B,A			;GET END OF THIS BLOCK
	LOAD D,DRFTP,(D)	;GET ACTUAL END OF DIR
	ADD D,DIRORA		;MAKE IT ABSOLUTE
	CAME B,D		;IS THIS FREE BLK AT END OF FREE SPACE?
	JRST XPANDP		;NO, GO EXPAND AN ENTIRE PAGE
	MOVE D,DIRORA		;GET BACK BASE ADDRESS
	LOAD B,FRLEN,(A)	;GET LENGTH OF LAST BLOCK AGAIN
	CAIN B,.SYMLN		;IS THIS EXACTLY THE RIGHT SIZE?
	JRST XPAND3		;YES, USE THE WHOLE BLOCK
	CAIGE B,.SYMLN+.FRHLN	;BIG ENOUGH TO SPLIT UP INTO 2 BLOCKS?
	JRST XPANDP		;NO, GO XPAND BY A PAGE
	MOVE C,B		;NOW GET AMOUNT TO SHORTEN BY
	ASH C,-3		;TAKE 1/8 OF THIS BLOCK
	ADDI C,.SYMLN		;PLUS ONE SYMBOL
	SUB B,C			;GET NEW LENGTH OF LAST BLOCK
	STOR B,FRLEN,(A)	;SHORTEN THE BLOCK
	SETZRO FRVER,(A)	;SET VERSION #
	LOAD B,DRFTP,(D)	;GET TOP OF FREE SPACE
	SUB B,C			;SHORTEN IT ALSO
	STOR B,DRFTP,(D)	;...
	RETSKP			;AND EXIT SUCCESSFUL

XPAND2:	SUB B,DIRORA		;MAKE RELATIVE ADDRESS OF FREE TOP
	JUMPE B,XPANDP		;DONT DELETE PAGE 0 HEADER
	LOAD C,DRFTP,(D)	;GET CURRENT FREE TOP
	SUB C,B			;GET # OF WORDS USED ON THIS PAGE
	CAIE C,.DIHL1		;IF NOT JUST A HEADER ON THIS PAGE,
	JRST XPANDP		;  GO GET ANOTHER PAGE
	STOR B,DRFTP,(D)	;OTHERWISE, USE HEADER AREA FOR SYMBOLS
	RETSKP			;AND RETURN SUCCESSFUL

XPAND3:	SETZRO FRNFB,(C)	;MARK LAST BLOCK AS LAST IN CHAIN
	SUB A,DIRORA		;GET RELATIVE ADR OF NEW FREE TOP
	STOR A,DRFTP,(D)	;SAVE NEW FREE TOP
	RETSKP			;AND RETURN SUCCESSFUL
;ROUTINE TO EXPAND THE DIR BY MOVING THE SYMBOL TABLE UP ONE PAGE
;	CALL XPANDP
;RETURNS +1:	COULD NOT EXPAND ANY MORE
;	 +2:	SUCCESSFUL

XPANDP:	MOVE D,DIRORA		;SET UP BASE ADDRESS OF MAPPED DIR
	LOAD A,DRSTP,(D)	;GET ADD OF TOP OF CURRENT SYMBOL TABLE
	ADDI A,1777
	ANDCMI A,777		;Move to NEXT page boundary
	MOVE C,A
	LSH C,-PGSFT		;SHIFT SIZE
	LOAD B,CURSTR		;GET STRUCTURE # OF DIR
	MOVE B,STRTAB(B)	;GET SDB ADDRESS
	JN MS%LIM,SDBSTS(B),[	CAILE C,DRSMDA ;LIMITED. SEE IF OKAY
				RETBAD() ;NOT
				JRST XPNDP1] ;IS
	CAMLE C,NDIRPG		;Absolute end of directory?
	RETBAD			;YES, Fail
XPNDP1:	SKIPN SDBBTB(B)		;IS THE STRUCTURE'S BIT TABLE INITED?
	RETBAD()		;NO. CAN'T EXPAND THEN
	MOVE B,A		;GET NEW END OF SYMBOL TABLE
	ADD B,DIRORA		;GET THE VIRTUAL ADDRESS
	MOVES -1(B)		;TOUCH PAGE THAT SYMBOL TABLE WILL GROW INTO
	 ERJMP [RETBAD]		;CAN'T CREATE THE PAGE. FAIL
	LOAD B,DRSTP,(D)	;GET OLD TOP OF SYMBOL TABLE
	SUB A,B			;GET DELTA INCREASE
	LOAD C,DRFTP,(D)	;GET TOP OF FREE AREA
	ADD C,DIRORA		;GET ABS ADR
	CAMGE C,DRLOC		;IS DRLOC POINTING WITHIN SYMBOL TABLE?
	ADDM A,DRLOC		;YES, Adjust DRLOC for symtab movement
	CAMGE C,DRSCN		;IS DRSCN WITHIN SYMBOL TABLE?
	ADDM A,DRSCN		;YES, DITTO FOR DRSCN
	LOAD B,DRSTP,(D)	;GET TOP OF SYMBOL TABLE
	LOAD C,DRSBT,(D)	;AND BOTTOM OF SYMBOL TABLE
	SUB B,C			;CALCULATE NUMBER OF WORDS TO BE MOVED
	PUSH P,A		;SAVE GROWTH INCREMENT
	LOAD C,DRSTP,(D)	;GET ADR OF TOP OF SYMBOL TABLE
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	MOVE D,C		;NOW CALCULATE NEW TOP
	ADD D,A			;OLD TOP PLUS INCREMENT
XPAND4:	MOVE A,-1(C)		;GET AN ELEMENT FROM OLD SYMBOL TABLE
	MOVEM A,-1(D)		;PUT IT IN THE NEW SYMBOL TABLE
	SOS C			;STEP TO NEXT WORD
	SOS D
	SOJG B,XPAND4		;LOOP UNTIL SYMBOL TABLE IS COPIED
	POP P,A			;GET BACK LENGTH
	MOVE D,DIRORA		;GET BASE ADDRESS OF MAPPED DIR AGAIN
	LOAD B,DRSTP,(D)	;GET TOP OF OLD SYMBOL TABLE
	ADD B,A			;UPDATE IT
	STOR B,DRSTP,(D)
	LOAD B,DRSBT,(D)	;GET BOTTOM OF SYMBOL TABLE
	ADD B,A			;UPDATE IT
	STOR B,DRSBT,(D)
	RETSKP			;AND RETURN

	TNXEND
	END