Google
 

Trailing-Edge - PDP-10 Archives - BB-M081R-SM - monitor-sources/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
; Edit= 8946 to DIRECT.MAC on 25-Aug-88 by GSCOTT
;Update BUG. documentation, change repeat 0ed DIRDNL to DIRDNX.
; Edit= 8884 to DIRECT.MAC on 12-Aug-88 by RASPUZZI
;Update BUG. documentation.
; Edit= 8823 to DIRECT.MAC on 8-Apr-88 by RASPUZZI, for SPR #21883
;Prevent OFNBDB BUGHLTs when the INDEX-TABLE.BIN is damaged. Have GETIDX be
;defensive about what it finds.
; UPD ID= 8503, RIP:<7.MONITOR>DIRECT.MAC.7,   9-Feb-88 14:52:51 by GSCOTT
;TCO 7.1218 - Update copyright notice.
; UPD ID= 8456, RIP:<7.MONITOR>DIRECT.MAC.6,   5-Feb-88 09:20:16 by GSCOTT
;More of TCOP 7.1210 - Fix spelling in DIREXT.
; UPD ID= 8408, RIP:<7.MONITOR>DIRECT.MAC.5,   4-Feb-88 10:48:30 by GSCOTT
;TCO 7.1210 - Set CCBROT, CGROFN, DIRACT, DIRB2L, DIRB2S, DIRBAD, DIRBAF,
; DIRBCB, DIRBLK, DIREXT, DIRFDB, DIRFRE, DIRIFB, DIRNAM, DIRPG0, DIRPG1,
; DIRRHB, DIRSY1, DIRSY2, DIRSY3, DIRSY4, DIRSY5, DIRSY6, DIRULK, DIRUNS, and
; LNGDIR to be not normally dumpable.
; UPD ID= 8399, RIP:<7.MONITOR>DIRECT.MAC.4,   2-Feb-88 14:52:33 by RASPUZZI
;TCO 7.1204 - Prevent ILMNRFs when STRFND is called to recognize a directory
; UPD ID= 28, RIP:<7.MONITOR>DIRECT.MAC.3,  29-Jun-87 16:37:34 by RASPUZZI
;TCO 7.1014 - Implement partial file recognition.
; *** Edit 7398 to DIRECT.MAC by LOMARTIRE on 20-Nov-86, for SPR #21362
; Prevent SHROFD and TCSOFN BUGHLTs 
; *** 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 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. 
; UPD ID= 2064, SNARK:<6.1.MONITOR>DIRECT.MAC.49,   3-Jun-85 14:29:45 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1942, SNARK:<6.1.MONITOR>DIRECT.MAC.48,   9-May-85 17:02:12 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1938, SNARK:<6.1.MONITOR>DIRECT.MAC.47,   8-May-85 09:38:37 by LOMARTIRE
;TCO 6.1.1295 - Install TCO 6.2005 which fixes directory recognition
; UPD ID= 1893, SNARK:<6.1.MONITOR>DIRECT.MAC.46,   4-May-85 15:39:25 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1872, SNARK:<6.1.MONITOR>DIRECT.MAC.45,   4-May-85 11:21:31 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1817, SNARK:<6.1.MONITOR>DIRECT.MAC.44,  24-Apr-85 16:14:57 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1725, SNARK:<6.1.MONITOR>DIRECT.MAC.43,   8-Apr-85 12:39:38 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 4929, SNARK:<6.MONITOR>DIRECT.MAC.42,  15-Oct-84 12:59:47 by GRANT
;The assembly switch CFSCOD has been eliminated
; UPD ID= 4804, SNARK:<6.MONITOR>DIRECT.MAC.41,  17-Sep-84 09:54:20 by PURRETTA
;Update copyright notice
; UPD ID= 4784, SNARK:<6.MONITOR>DIRECT.MAC.40,  31-Aug-84 13:01:16 by LOMARTIRE
;Remove TCO 6.2178 since the problem is not solved fully and has side effects
; UPD ID= 4781, SNARK:<6.MONITOR>DIRECT.MAC.39,  30-Aug-84 15:53:47 by LOMARTIRE
;Still more TCO 6.2178 - Handle deleted files better at EXTSCN 
;Also, handle the case of old files (GJ%OLD or OLDNF) only.
; UPD ID= 4759, SNARK:<6.MONITOR>DIRECT.MAC.38,  27-Aug-84 12:40:22 by LOMARTIRE
;More TCO 6.2178 - Do NOT smash ACs at VERLK1
; UPD ID= 4749, SNARK:<6.MONITOR>DIRECT.MAC.37,  24-Aug-84 13:54:34 by LOMARTIRE
;TCO 6.2178 - Do not allow directory access to files without FC%DIR set
; UPD ID= 4669, SNARK:<6.MONITOR>DIRECT.MAC.36,   8-Aug-84 15:30:17 by LOMARTIRE
;TCO 6.2124 - Check access when setting deleted file non-existant in VERLKH
; UPD ID= 4305, SNARK:<6.MONITOR>DIRECT.MAC.35,   7-Jun-84 16:33:44 by MOSER
;TCO 6.2086 - MAKE UNMIDX GLOBAL
; UPD ID= 4060, SNARK:<6.MONITOR>DIRECT.MAC.34,  11-Apr-84 14:45:57 by GRANT
;In UPDIDX, don't call UPDPGS with OFN 0
; UPD ID= 3795, SNARK:<6.MONITOR>DIRECT.MAC.33,  29-Feb-84 01:41:30 by TGRADY
; Implement Global Job Numbers
; - In DELTS1, check temp file generation number against global job number,
;   instead of local index (JOBNO)
; UPD ID= 2983, SNARK:<6.MONITOR>DIRECT.MAC.32,   4-Oct-83 15:59:20 by TBOYLE
;TCO 6.1803 Add REMSDR to remove special dirs on dir removals.
; UPD ID= 2704, SNARK:<6.MONITOR>DIRECT.MAC.31,  18-Jul-83 16:14:46 by JCAMPBELL
;TCO 6.1729 - Make sure FB%FOR in .FBCTL (FORTRAN data file) not propogated.
; UPD ID= 2694, SNARK:<6.MONITOR>DIRECT.MAC.30,  12-Jul-83 16:28:24 by PRATT
;TCO 6.1710 - Check for stepping versions in VRLKH1 if FB%NXF is set.
; UPD ID= 2689, SNARK:<6.MONITOR>DIRECT.MAC.29,  11-Jul-83 13:51:02 by TSANG
;TCO 6.1717 - Insert subroutine ADRCHK in MDDDC1 to check the address of next
;        extension.
; UPD ID= 2594, SNARK:<6.MONITOR>DIRECT.MAC.28,  20-Jun-83 10:33:14 by HALL
;TCO 6.1689 - Move fork tables to extended section
;	Reference FKSTAT via DEFSTR
; UPD ID= 2549, SNARK:<6.MONITOR>DIRECT.MAC.27,  31-May-83 23:57:28 by PAETZOLD
;Delete very old edit history and update copyright
; UPD ID= 2539, SNARK:<6.MONITOR>DIRECT.MAC.26,  31-May-83 13:58:24 by MILLER
;Fix UPDIDX to detect non-ex IDX table
; UPD ID= 2173, SNARK:<6.MONITOR>DIRECT.MAC.25,   6-Apr-83 07:13:37 by FLEMMING
; UPD ID= 2121, SNARK:<6.MONITOR>DIRECT.MAC.24,  29-Mar-83 20:07:16 by MILLER
;TCO 6.1579. Have RBLDST call ADJALC when fixing allocations
; UPD ID= 1792, SNARK:<6.MONITOR>DIRECT.MAC.23,  12-Feb-83 18:50:31 by MILLER
;TCO 6.1094. Free directroy allocation resource in INVIDX
; UPD ID= 1638, SNARK:<6.MONITOR>DIRECT.MAC.22,  11-Jan-83 14:55:23 by MOSER
;MORE TCO 6.1408
; UPD ID= 1610, SNARK:<6.MONITOR>DIRECT.MAC.20,   3-Jan-83 14:54:38 by MILLER
;TCO 6.1434. Set FILUB in calls to RELOFN
; UPD ID= 1520, SNARK:<6.MONITOR>DIRECT.MAC.19,   8-Dec-82 17:15:31 by MOSER
;TCO 6.1408 - BUGINF CCBROT IN CHKBAK
; UPD ID= 1519, SNARK:<6.MONITOR>DIRECT.MAC.18,   8-Dec-82 17:08:42 by MOSER
;TCO 6.1381 - MOVE CGROFN TO THIS MODULE
; UPD ID= 1416, SNARK:<6.MONITOR>DIRECT.MAC.17,   5-Nov-82 09:52:27 by MILLER
;TCO 6.1094. Set OFNDU0 in call to ASROFN
; UPD ID= 1260, SNARK:<6.MONITOR>DIRECT.MAC.16,  30-Sep-82 15:26:34 by MCINTEE
;TCO 6.1230 - Teach DR0CHK about remote alias blocks
;             Add comments to SETDIR and GDIRST about unlocking.
; UPD ID= 1217, SNARK:<6.MONITOR>DIRECT.MAC.15,  23-Sep-82 09:18:33 by MCINTEE
;previous edit's TCO number is really 6.1258
; UPD ID= 1166, SNARK:<6.MONITOR>DIRECT.MAC.14,  13-Sep-82 12:51:05 by MOSER
;TCO 6.1256 - PREVENT REINITIALIZATION OF FDBs IN USE
; UPD ID= 1140, SNARK:<6.MONITOR>DIRECT.MAC.13,   3-Sep-82 16:08:47 by MOSER
;TCO 6.1239 - DON'T PROPAGATE FB%TMP TO NEW GENERATIONS.
; UPD ID= 883, SNARK:<6.MONITOR>DIRECT.MAC.12,   9-Jun-82 15:56:54 by MCINTEE
;TCO 6.1030 - change a MDDOK to DSKOK
; UPD ID= 837, SNARK:<6.MONITOR>DIRECT.MAC.11,   4-Jun-82 22:01:29 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 646, SNARK:<6.MONITOR>DIRECT.MAC.10,  14-Apr-82 17:19:50 by MILLER
;TCO 6.1094. Add code for CFS directory locking
; UPD ID= 385, SNARK:<6.MONITOR>DIRECT.MAC.9,   5-Feb-82 16:01:18 by HALL
;TCO 6.1000 - Support the 2080. Remove extended addressing checks
;	SETDIR - Don't check EXADDR before testing DRMAP
;	MAPDIR and CHKBAK - always map into non-zero section
;	MAPIDX and UNMIDX - always map index table into non-zero section
;	UNMAPD - Always unmap from non-zero section
; UPD ID= 354, SNARK:<6.MONITOR>DIRECT.MAC.8,  27-Jan-82 13:30:36 by MCINTEE
;More TCO 6.1051
; UPD ID= 265, SNARK:<6.MONITOR>DIRECT.MAC.7,  21-Dec-81 10:11:12 by MCINTEE
; UPD ID= 255, SNARK:<6.MONITOR>DIRECT.MAC.6,  15-Dec-81 15:02:34 by MCINTEE
;TCO 6.1051 - Put ambiguity back in recognition of extension field
; UPD ID= 166, SNARK:<6.MONITOR>DIRECT.MAC.5,  24-Oct-81 19:21:23 by PAETZOLD
;More TCO 5.1581
; UPD ID= 132, SNARK:<6.MONITOR>DIRECT.MAC.4,  19-Oct-81 15:11:53 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 122, SNARK:<6.MONITOR>DIRECT.MAC.3,  18-Oct-81 15:49:17 by PAETZOLD
;TCO 5.1581 - Fix problem where OFN's do not get deassigned
;<6.MONITOR>DIRECT.MAC.2, 16-Oct-81 17:50:26, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
; UPD ID= 133, SNARK:<5.MONITOR>DIRECT.MAC.7,   1-Sep-81 10:07:42 by GROUT
;TCO 5.1479 - Fix possible section changes between MDDDIR and SETDIR/SETDRR
; UPD ID= 55, SNARK:<5.MONITOR>DIRECT.MAC.6,  21-Jul-81 11:40:42 by GROUT
;TCO 5.1425 - Make MDDDIR not check privs if called from .RCUSR
; UPD ID= 2003, SNARK:<5.MONITOR>DIRECT.MAC.5,  14-May-81 23:17:56 by ZIMA
;TCO 5.1327 - fix GJ%FOU and exact generation case for invisible files.
; UPD ID= 1931, SNARK:<5.MONITOR>DIRECT.MAC.4,   4-May-81 10:41:31 by SCHMITT
;TCO 5.1304 - Correct pointer construction at DIRUNQ
; UPD ID= 1426, SNARK:<5.MONITOR>DIRECT.MAC.3,   8-Jan-81 17:02:51 by HALL
;TCO 5.1229 - ADD SOME CALLS TO FDBCHK IN NAMSCN AND EXTSCN
; UPD ID= 695, SNARK:<5.MONITOR>DIRECT.MAC.2,  25-Jun-80 15:13:24 by DBELL
;TCO 5.1078 - TYPE OFFSET INTO DIRECTORIES FOR LOTS OF BUGCHKS
; UPD ID= 332, SNARK:<4.1.MONITOR>DIRECT.MAC.30,  14-Mar-80 10:59:31 by KONEN
; UPD ID= 328, SNARK:<4.1.MONITOR>DIRECT.MAC.29,  13-Mar-80 13:35:03 by KONEN
; UPD ID= 323, SNARK:<4.1.MONITOR>DIRECT.MAC.28,  12-Mar-80 12:25:32 by KONEN
;Add descriptors to optional data for BUGs
; UPD ID= 13, SNARK:<4.1.MONITOR>DIRECT.MAC.27,  26-Nov-79 13:46:43 by KONEN
;TCO 4.1.1028 -- Don't propagate FB%BAT through different versions of FDB's
;<OSMAN.MON>DIRECT.MAC.1, 10-Sep-79 15:25:27, EDIT BY OSMAN

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	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::EA.ENT
	MOVE C,DIRORA		;GET THE PROTECTION OF THE MAPPED DIR
	LOAD C,DRPRT,(C)	;...
	JRST ACCCH1		;ENTER COMMON CODE

ACCCHK::EA.ENT
	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
	CAME D,Q2		;REFERENCE TO LOGGED IN DIR?
	IFSKP.
	  JE CURSTR,,ACCCH9 	;IF ON PUBLIC STRUCTURE, THIS IS THE
				; LOGGED IN DIRECTORY
	ENDIF.

;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
	CAME A,Q2		;REFERENCE TO CONNECTED DIRECTORY?
	IFSKP.
	  LOAD A,CURUC		;YES. GET STRUCTURE FOR MAPPED DIRECTORY
	  CAMN D,A		;IS IT THE CONNECTED STRUCTURE?
	  JRST ACCCH9		;YES. GIVE OWNER ACCESS
	ENDIF.

;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
	TMNE 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::EA.ENT
	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::EA.ENT
	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
	EA.ENT
	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
	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		; ...
	LOAD D,FBNAM,(B)	;GET NAME STRING ADDRESS
	ADD D,DIRORA		;GET VIRTUAL ADDRESS OF NAME STRING
	ADDI D,1		;SKIP STRING BLOCK HEADER
	HRLZI C,(<POINT 7,(D)>)	;BUILD BYTE POINTER TO START
	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

; Removal routine for special directories.  If the structure is PS: and
; the directory number is present in the special table, it is removed.
; Call:	T3	; The directory number to remove
;	T4	; The structure number
;	CALL DIRSLK
; Return:
;	+1	; Always
; Clobbers T1,T2

REMSDR::MOVEI T1,PSNUM
	CAME T1,T4		;IS THE DIRECTORY ON PS:?
	RET			;NO, RETURN
	HRLZ T1,NSDIRT		;YES, NOW GET NEG NUMBER OF DIRS
	JUMPE T1,R		;RETURN IF ZERO
REMSDL:	HLRZ T2,SDIRTB(T1)	;DIR NUMBER FROM TABLE ENTRY
	CAMN T2,T3		;IS IT THE DIR WE ARE LOOKING FOR?
	SETZM SDIRTB(T1)	;YES, ZERO THE TABLE ENTRY
	AOBJN T1,REMSDL		;SEARCH THE WHOLE TABLE
	RET			;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
; To unlock, CALL USTDIR
; Clobbers a,b,c,d

GDIRST::EA.ENT
	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::EA.ENT
	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
	TQO <NREC>		;[7.1014] No recognition here
	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
	TQO <NREC>		;[7.1014] No recognition here
	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::EA.ENT
	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,FLUC,(JFN)	;GET STRUCTURE UNIQUE CODE
	HRL A,B			;36-BIT DIRECTORY NUMBER
	MOVE B,INSACA
	SKIPN 0(B)		;NULL STRING?
	BUG.(HLT,BADDAC,DIRECT,SOFT,<INSACT - Null account string seen>,,<

Cause:	A null account string was given for insertion into the FDB by the
	monitor during the creation of a file or while executing a SACTF JSYS.
>)
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
	TQO <NREC>		;[7.1014] No recognition here
	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
	TQO <NREC>		;[7.1014] No recognition here
	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::EA.ENT
	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
	TXNN F,1B17		;DELETE ALL?
	IFSKP.
	  MOVE A,DIRORA		;YES - CHECK FOR SUBDIRS
	  LOAD A,DRSDC,(A) 	;GET COUNT
	ANDN. A
	  RETBAD(DELF10,<CALL USTDIR>) ;CANNOT DELETE WITH SUBDIRS
	ENDIF.
	TXNN F,DD%CHK		;CHECKING ONLY?
	IFSKP.
	  MOVEI A,0		;YES
	  CALL RBLDST		;DO THE CHECK
	   RETBAD (,<CALL USTDIR>) ;DIRECTORY IS NOT CONSISTENT
	  CALL USTDIR		;DIR IS GOOD
	  RETSKP
	ENDIF.
	TXNN F,DD%RST		;REBUILD SYMBOL TABLE?
	IFSKP.
	  SETO A,		;YES, GO REBUILD IT
	  CALL RBLDST		;...
	   RETBAD (DELFX4,<CALL USTDIR>) ;REBUILD FAILED
	ENDIF.
	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
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
	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
DELD51:	CALL DELFIL		;[7364]DELETE THE CURRENT FDB
	 JRST DELFS1		;[7364] COULDN'T, CHECK IF RECOVERABLE
	JRST DELDL5		;GO CONTINUE SCANNING

DELDL6:	LOAD P3,FBEXL,(P3)	;STEP TO NEXT EXT
DELD61:	CALL DELFIL		;[7364]DELETE THE FDB IN D
	 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.(CHK,DIRSY1,DIRECT,HARD,<DELDL8 - Directory symbol table fouled up for directory>,<<A,DIRNUM>,<B,STRNAM>>,<

Cause:	A disordered directory symbol table was found while expunging a
	directory or rebuilding a symbol table.

Action:	Rebuild the symbol table.  If that fails, delete directory with DELETE
	command using the DIRECTORY subcommand and rebuild the directory.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
DELDL9:	MOVEI A,DELFX6		;DIR FORMAT IS SCREWED UP
	CALLRET USTDIR		;UNLOCK THE DIR AND RETURN
;[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.

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,GBLJNO		;YES, IS THIS FILE OURS?(Same Global Job Number)
	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::EA.ENT
	HLRZ A,FILNEN(JFN)	;WAS THERE A NAME SET UP YET?
	JUMPE A,R		;IF 0, FDB COULD NOT HAVE BEEN MADE
	BLCAL. DSKOK,<DEV>	;THIS A DSK?
	 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,FLUC,(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::EA.ENT
	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
	TQO <NREC>		;[7.1014] No recognition here
	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::EA.ENT
	HRRZ A,FILDDN(JFN)	;GET DIRECTORY NUMBER
	JUMPE A,R		;IF NONE, GIVE ERROR RETURN
	LOAD B,FLUC,(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::EA.ENT
	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::EA.ENT
	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::EA.ENT
	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
; To unlock, CALL USTDIR.
; Clobbers a,b,c,d

SETDIR::EA.ENT
	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 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

REPEAT 0,<			;[8946] Not used!
SETDI4:	HRRZ A,SETDIN		;GET DIR NUMBER (RH ONLY)
	MOVE D,SETDNM		;GET THE SIXBIT STRUCTURE NAME
	BUG.(CHK,DIRBAD,DIRECT,HARD,<SETDI4 - Smashed directory number>,<<A,DIRNUM>,<D,STRNUM>>,<

Cause:	No path to this bugchk.

Data:	DIRNUM - Directory number
	STRNAM - Sixbit structure number
>,,<DB%NND>)			;[7.1210]
	OKINT
	RETBAD (DELFX6)
>				;[8946] End of repeat 0
;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::EA.ENT
	SAVET			;ENTRY POINT FOR NOT UPDATING DRUDT
	JRST UPDDR1

UPDDIR::EA.ENT
	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::EA.ENT
	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::EA.ENT
	ULKDIR			;UNLOCK THE DIRECTORY
	OKINT
	RET
;UNLOCK MAPPED DIRECTORY -- INVOKED VIA ULKDIR MACRO
;CLOBBERS NO ACS

ULKMD0::EA.ENT
	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.(CHK,DIRULK,DIRECT,HARD,<ULKMD2 - Attempt to unlock illegally formatted directory>,<<T1,DIRNUM>,<T2,STRNAM>>,<

Cause:	Either there was an attempt to unlock a directory that is disordered,
	or a bad argument was given to a subroutine to unlock directory.

Action:	Use the DOB% facility to take a dump of this BUGCHK.  If you have a
	reliable case for reproducing this problem, please include this
	procedure when you submit the dump as an SPR.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	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 LCKDNM
; RETURN +1 ALWAYS, DIRECTORY LOCKED, AND CSKED.
;BLOCK UNTIL ABLE TO LOCK

;FORK MUST BE NOINT WHILE DIRECTORY LOCKED.

   REPEAT 0,<			;CFSCOD NO LONGER USED
   IFE CFSCOD,<

LCKDNM::EA.ENT
	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.(HLT,LCKDIR,DIRECT,SOFT,<Attempt to lock directory twice for same fork>,,<

Cause:	A fork is trying to lock a directory it has already locked.  This
	BUGHLT does not occur since the code is not in the monitor any more.
>)
	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:	IFL. Q1			;FREE ENTRY TO REUSE?
	  MOVE Q1,MLDTAB	;NO, USE NEXT ONE AT END
	  CAIL Q1,NLDTAB	;TABLE FULL?
	  JRST LCKDI4		;YES, BLOCK UNTIL ROOM
	  AOS MLDTAB		;INCREMENT END
	ENDIF.
	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
	EA.ENT
	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.(CHK,DIRDNX,DIRECT,SOFT,<ULKDIR - Directory not locked or directory number wrong>,<<T1,DIRNUM>,<T2,STRNAM>>,<

Cause:	There has been an attempt to unlock a directory that was never locked.
	Or a directory number is wrong.  This BUG will not appear in the field
	since it is under REPEAT 0 because CFS handles this now.

Action:	Use the DOB% facility to produce a dump.  Also, if you can reproduce
	this case reliably, indicate the procedure on the SPR.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>)
	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
	LOAD T2,FKSTX,(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
   >	;IFE CFSCOD
   >				;END REPEAT 0
;Code to lock/unlock directories
;This code uses a separate CFS lock so that read/only sharing
;works efficiently. That is, by not using the file token, the
;locker of the directory determines implicitly what kind of
;file access in needed.
;Same args and conditions as above

;   IFN CFSCOD,<

LCKDNM::EXCH T1,T2		;PUT ARGS IN RIGHT ORDER
	CALLRET CFSLDR		;LOCK 'ER UP AND RETURN

ULKDNM::SAVET
	MOVE T2,T1		;COPY NUMBER
	LOAD T1,CURSTR		;GET STRUCTURE NUMBER
	CALLRET CFSRDR		;RELEASE IT
;   >	;IFN CFSCOD
;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::EA.ENT
	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
MAPASO:	CALL GETIDX		;[7398] (T1/T1,T2,T3,T4)
	 JRST MAPAER		;[7398] (T1/)Error - unlock cache and return
	TXNN D,IDX%IV		;[7398] Directory entry marked invalid?
	IFSKP.			;[7398] Yes 
	  MOVX T1,DIRX3		;[7398] Get appropriate error code 
	  JRST MAPAER   	;[7398] (T1/)Unlock cache and return error
	ENDIF.			;[7398] 
	MOVE A,B		;GET ADDRESS OF INDEX BLOCK
	TXO A,FILWB+THAWB+OFNDUD+OFNDU0 ;WRITE, THAWED, AND NO AUTO-UPDATE
	MOVE B,MAPDIS		;GET STRUCTURE NUMBER
	CALL ASROFN		;[7398] (T1,T2/T1)Assign an OFN for file
	 JRST MAPAER		;[7398] (T1/)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]
	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
	SKIPN DCSHRC(B)		;CHECK TO SEE IF DORMANT ENTRY
	IFSKP.
	  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
	ENDIF.
	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
	JRST [	SETONE DRROF	;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
	CALL MAPDRP		;MAP DIRECTORY PAGE
	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
;[7398] MAPAER - Routine called from MAPASO upon error
;[7398] 
;[7398] Accepts:	T1/ Error code to return, if any
;[7398] 
;[7398] Usage:		JRST MAPAER
;[7398] 
;[7398] This code checks to see if there is a directory cache in use.
;[7398] If not, then it simply returns with the error code in T1.
;[7398] If there is a directory cache, then the cache is unlocked and 
;[7398] the error code is returned in T1.
;[7398] 
;[7398] NOTE:  This routine expects to be called when either there is no
;[7398] directory cache in use, or with the directory cache in use and locked.

MAPAER:	MOVEI B,DIRCSZ		;[7398] Check for cache size
	JUMPE B,R		;[7398] No cache, just return
	UNLOCK DIRCLK		;[7398] Unlock directory cache
	RET			;[7398] Return error to caller

;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::EA.ENT
	HRRZ A,DRMAP		;GET OFN
	IFN. A			;If we have one
	 TXO A,FILUB		;Don't decrement open count
	 CALL RELOFN		;DECREMENT OFN SHARE COUNT
	ENDIF.
	SETZM DRMAP		;CLEAR MAP SHARE POINTER
	CALL MONCLA		;CLEAR HARDWARE PAGE TABLE
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
; Multiple directory device directory lookup routine
; Call:	A	;FULLWORD Directory number
;	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	; No such directory
;	+2	; 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::EA.ENT
	SAVEQ
	STKVAR <MDDDNO,MDDFLG,MDDDWS,MDDDPT,<MDDDNM,MAXLW>>
	MOVEM T1,MDDDNO		;SAVE ARGUMENT
	CAIN T2,.RCUSR		;CALL FROM .RCUSR?
	TDZA T2,T2		;YES
	MOVEI T2,1		;NO
	MOVEM T2,MDDFLG		;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
	MOVE T2,MDDFLG		;GET .RCUSR FLAG
	CALL @[IFIW!SETDIR
	       IFIW!SETDRR](T2)	;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
	IMULI T1,.IDXLN		;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
	MOVE T1,Q2
	CALL ADRCHK
	 JRST MDDDC0
	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
	IMULI T2,.IDXLN		; ...
	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
	MOVE T2,MDDFLG		;GET .RCUSR FLAG
	CALL @[IFIW!SETDIR
	       IFIW!SETDRR](T2)
	 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.(CHK,LNGDIR,DIRECT,HARD,<Long directory file in directory>,<<T3,DIRNUM>>,<

Cause:	The subdirectory has an incorrect superior directory.

Action:	Use the EXPUNGE command with subcommand REBUILD to rebuild index table
	of the directory listed in the additional data.  If this doesn't cure
	the problem, delete the directory and rebuild it.

Data:	DIRNUM - Directory number
>,,<DB%NND>)			;[7.1210]
		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
	CALL USTDIR		;UNLOCK CURRENT DIRECTORY
	HLL T1,MDDDNO		;STR UNIQUE CODE
	CALL SETDIR		;MAP DIRECTORY
	 JRST MDDDIC		;FAILED
	MOVE T2,DIRORA		;DIRECTORY ORGIN
	LOAD T1,DRNUM,(T2)	;GET DIRECTORY NUMBER
	CAILE T1,HSDPPN		;SYSTEM DEFINED PPN?
	JRST MDDIE3		;NO
	MOVE T3,CRDPTB-1(T1)	;PPN CORRESPONDING TO THIS SYSTEM DEFINED DIR
	STOR T3,DRPPN,(T2)	;STORE THE PPN IN THE DIRECTORY
MDDIE3:	CALL SETPPN		;STORE PPN IN IDXTAB EXTENSION
	CALL USTDIR		;UNLOCK
	MOVE T1,MDDDNO		;SUPERIOR
	CALL SETDIR		;GET IT BACK AGAIN
	 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::EA.ENT
	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 or ambiguous (AMBGF)
;	+2	; Success, if nrec&nrec1 are 0, the remainder if any
;		; Is appended to the string addressed by filopt(jfn)

MDDNAM::EA.ENT
	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 FDBCHK		;SEE IF THIS FDB IS GOOD
	 JRST ERRET		;NO GOOD. QUIT THE SCAN
	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.(CHK,DIRSY2,DIRECT,SOFT,<MDDNAM - Symbol table fouled up in directory>,<<A,DIRNUM>,<B,STRNAM>>,<

Cause:	A bad symbol table format was found when looking up a directory.

Action:	Use the EXPUNGE command with subcommand REBUILD to rebuild index table
	of the directory listed in the additional data.  If this doesn't cure
	the problem, delete the directory and rebuild it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
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:	TQNN <UNLKF>
	CALL USTDIR
	RETSKP

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 FDBCHK		;IS THE FDB GOOD?
	 JRST ERRET		;NO. QUIT THE SCAN
	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
	CALL UPDSTR		;[7.1014] (/) Some match, update string accordingly
	MOVE B,DRREC		;[7.1014] Get number of characters matching
	JUMPE B,NAMLK9		;[7.1014] If unique, give success return
	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:	TQOA AMBGF		;NOTE AMBIGUOUS RETURN
ERRET:	TQZ AMBGF		;PLAIN FAILURE
	CALL USTDIR
	RET
;[7.1014]
;UPDSTR - Routine to update a string to recognize as much as possible.
;
; Call with:
;	DRINP/ pointer to input string
;	DRREC/ # of characters matching + 1 (0 if all)
;	DRLOC/ Address of symbol table entry for string
;	CALL UPDSTR
;
; Returns:
;	+1 - Always, FILOPT/FILCNT updated

UPDSTR:	EA.ENT			;Enter here from NAMFND
	MOVE B,DRLOC		;Location in symtab of matching entry
	LOAD C,DIRLA,(B)	;FDB address
	ADD C,DIRORA		;Make it absolute
	LOAD D,FBNAM,(C)	;Get pointer to name string
	ADD D,DIRORA		;Get it out of directory
	SKIPA			;Already in section 1

UPDSTF:	EA.ENT			;Enter here from EXTFND
	MOVN A,DRINP		;Start of input string
	ADD A,FILOPT(JFN)	;End of input relative to beginning

; At this point A has byte ptr info in the LH, and a word offset in the RH
; Use 18-bit arithmetic to add in the word offset

	ADDI D,1(A)		;Add word offset to 30-bit address

; The following snippit of code converts the P field of the (presumed)
; 7-bit byte pointer in A into P&S bits 0-5 corresponding to a one-word
; global pointer in A. See processor reference manual, Sec 2.11, page 2-85

	LSH A,-^D30		;Slide the P field over for arithmetic
	IDIVI A,7		;Compute (4 - byte # within word)
	MOVNI A,-66(A)		;-1,,(66  - (byte # - 4))
	LSH A,^D30		;Slide back over to bits 0-5
	IOR D,A			;Or in the P&S bits with 30-bit address
	MOVE B,DRREC		;Get # chars agreeing
	IFE. B
	  LOAD B,BLKLEN,(C) 	;If none, use the block length
	  SUBI B,1
	  IMULI B,5
	ELSE.
	  SUBI B,1		;Account for extra count if substring
	ENDIF.
	JUMPLE B,R		;If still non-positive, quit
UPDSTC:	ILDB A,D		;Copy tail to input
	JUMPE A,UPDSTE		;Quit if encountered null
	SOSGE FILCNT(JFN)	;Update buffer char count
	JRST UPDSTE		;If overflow, quit
	IDPB A,FILOPT(JFN)	;Also update FILOPT
	SOJG B,UPDSTC		;Do up to maximum count
UPDSTE:	MOVEI A,.CHNUL		;Tack on a trailing null
	MOVE B,FILOPT(JFN)	;Get FILOPT pointer
	IDPB A,B		;And stick the NUL in
	RET

UNIQUE:	MOVEI A,GJFX18
	TQNN <MTCHF>		; Non-deleted, visible match found?
	JRST ERRET		; No
	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 or ambiguous (AMBGF)
;	+2	; Ok, the remaining string is appended to filopt(jfn)

MDDEXT::EA.ENT
	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		; 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
	TQON <MTCHF>		; Flag non-deleted visible file
	IFNSK.			;[7.1014] First match
	  MOVE C,DRSCN		;[7.1014] Note this is the first match
	  MOVEM C,DRLOC		;[7.1014] Keep this up to date
	  SETZM DRREC		;[7.1014] Zap count of matching characters
	ELSE.			;[7.1014] Subsequent matches
	  MOVE A,DRSCN		;[7.1014] Compute address of current string block
	  LOAD A,DIRLA,(A)	;[7.1014] And put it in A
	  ADD A,DIRORA		;[7.1014] Make it absolute
	  LOAD A,FBEXT,(A)	;[7.1014] Address of extension string
	  MOVE B,DRLOC		;[7.1014] Compute address of first string block
	  LOAD B,DIRLA,(B)	;[7.1014] And it will go in B
	  ADD B,DIRORA		;[7.1014] Make it absolute
	  LOAD B,FBEXT,(B)	;[7.1014] Address of extension string
	  MOVE C,DRREC		;[7.1014] Count of previous matching characters
	  CALL SUBSTR		;[7.1014] (A,B,C/A) Get new substring count
	  MOVEM A,DRREC		;[7.1014] And save it
	ENDIF.			;[7.1014]
	JRST EXTNXT		; Next
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 AMBRET		; 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
	CALL UPDSTF		;[7.1014] (D/) Copy tail to the input
	MOVE C,DRREC		;[7.1014] Count of matching characters
	JUMPE C,NAMLK9		;[7.1014] No multiple matches, return successfully
	TQO <AMBGF>		;[7.1014] Else, ambiguous
	MOVEI A,GJFX19		;[7.1014] And pass error back
	JRST AMBRET		;[7.1014] Pass it back
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 AMBRET]	;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

;NOTE: CALLER SHOULD HAVE CALLED FDBCHK ON THIS FDB. THIS ROUTINE WILL
;CHECK ANY NEW FDB'S THAT IT FINDS

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
	CALL FDBCHK		;IS THIS A GOOD FDB?
	 RETBAD ()		;NO. RETURN ERROR CODE
	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

EXTSCN:	IFQN. <NREC,NREC1>	;[7.1014] Always see what is visible if doing recognition
	  TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;[7.1014] Stepping anything?
	  TQNE <OLDNF>		;[7.1014] Or old file only?
	  SKIPA			;[7.1014] Yez'm
	  RETSKP		;[7.1014] No, allow creating of new names
	ENDIF.			;[7.1014]
	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:	CALL EXTPRT		;[7.1014] (A/) See if this file can be seen
	 JRST EXTSC2		;[7.1014] It can't, so ignore it
	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
	CALL FDBCHK		;IS THIS A GOOD FDB?
	 RETBAD ()		;NO. RETURN ERROR CODE
	JRST EXTSC1		;LOOP BACK FOR NEXT VERSION IN CHAIN
;[7.1014]
;EXTPRT - Routine to check to see if this file can be seen because
;of its protection.
;
; Called with:
;	A/ FDB
;	CALL EXTPRT
;
; Returns:
;	+1 - This FDB cannot be seen due to its protection
;	+2 - This FDB can be seen

EXTPRT:	TQNE <NREC,NREC1>	;Protection only affects recognition
	 RETSKP			;File can be seen
	SAVET			;Recognition being done
	MOVX B,FC%DIR		;Access code
	CALLRET ACCCHK		;(A,B/) Check access (ala protection)
; 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::EA.ENT
	STKVAR <MDDVRA,MDDVRT,MDDVRL,MDDVRF,MDDVFB>
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
	IFL. A
	  CAME A,[-2]		;LOWEST?
	  CAMN A,[-1]		;OR A NEW ONE?
	ANSKP.
	  MOVEI A,GJFX20	;NO. RETURN WITH ERROR
	  JRST ERRET		;ALL DONE
	ENDIF.
	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
	IFQN. FBDEL,(D)
	  TQNN <IGDLF>		;YES, USER WANTS 'IGNORE DELETED'?
	  JRST VERLK1		;NO, GO TO NEXT VERSION
	ENDIF.
	IFQN. FBINV,(D)
	  TQNN <IGIVF>		; User want to find invisible?
	  JRST VERLK1		; No, go to next one
	ENDIF.
	IFQN. FBNXF,(D)
	  TQNE <OLDNF> 		;NO, USER REQUIRES OLD FILE?
	  JRST VERLK1		;YES, GO TO NEXT VERSION
	  JRST VERLK2		;NEW VERSION OK
	ENDIF.
	;..
	;..
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

VRLK2A:	PUSH P,T4		;SAVE T4
	SKIPN T1,.FBADR(T4)	;ANY ADDRESS
	JRST VRLK2B		;NO, OK TO REINIT
	LOAD T2,DIROFN		;GET OFN OF DIRECTORY
	LOAD T2,STRX,(T2)	;GET STRUCTURE FOR DIRECTORY
	CALL CHKOFN		;OPEN FILES FOR THIS FDB?
	 JRST [POP P,T4		;YES, GET T4 BACK
	       JRST VRLK5A]	;USE DON'T CHANGE THIS FDB
VRLK2B:	POP P,T1		;NOT IN USE. FDB ADDR IN T1
	CALL FDBIN0		;UPDATE STUFF IN FDB
	SETZRO FBSIZ,(A)
	JRST VERLK8
;HERE IF NEW VERSION WANTED

VERLK2:	TQO <NEWVF>
	TQZ <NEWF>
	JN FBNXF,(D),VRLK2A	;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]
	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
	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 ; 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?
	JRST VERLK5		;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
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
	TQNE <OUTPF>		;IF FILE IS FOR OUTPUT,
	 JRST VERLKH		; 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?
		MOVEM A,MDDVFB	 ;Yes, save pointer to FDB
		MOVX B,DC%CF	 ;Get access required
		CALL DIRCHK	 ;(B/) Check for create file access
		IFNSK.
		  MOVEI A,GJFX35  ;Access denied
		  JRST ERRET	  ;Return error
		ENDIF.
		MOVE A,MDDVFB	 ;Restore pointer to FDB
		SETZRO FBDEL,(A) ;CLEAR DELETED BIT
		SETONE FBNXF,(A) ;AND SET NON-EXISTENT
		JRST VRLKH1]
VRLKH1:	JE FBNXF,(A),VERLK8	;FILES EXIST?
   	TQNE <STEPF>		;NO - STEPPING ?
 	TQNN <VERSF>		; AND VERSION STEPPING ?
	TQNN <OLDNF>		;NO - OLD FILE ONLY?
	JRST [TQO <NEWVF>	;SET NEW VERSION FLAG
	      JRST VERLK8]	;FOUND
	MOVEI A,GJFX24		;YES, THEN GIVE AN ERROR RETURN
	JRST ERRET


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
;	NREC on in F1 if no recognition allowed per [7.1014]
;	CALL LOOKUP	to indicate a file lookup
;	 or
;	CALL LOOKP1	to indicate a directory lookup
; Return
;	+1	; No exact match found
;	+2	; Exact match found

LOOKUP:	TDZA D,D		;Clear flag: normal entry
LOOKP1:	SETO D,			;Set flag: directory lookup
	STKVAR <LOOKUE,LOOKUI,LOOKUB,LOOKUD,DIRSRC> ;[7.1014]
	TQZ <MTCHF,AMBGF>	;CLEAR RESULT FLAGS
	MOVEM C,LOOKUE		;SAVE ENTRY TYPE
	MOVEM D,DIRSRC		;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
	CAML B,C
	IFSKP.
	  MOVE C,DIRORA		;GET DIR #
	  LOAD C,DRNUM,(C)
	  MOVEM B,LOOKUB	;SAVE B
	  CALL GETSNM		;GET STR NAME
	  BUG.(CHK,DIRSY3,DIRECT,HARD,<LOOKUP - Symbol search fouled up in directory>,<<C,DIRNUM>,<B,STRNAM>>,<

Cause:	A disordered symbol table was found while looking for string in a
	directory.

Action:	Use the EXPUNGE command with subcommand REBUILD to rebuild index table
	of the directory listed in the additional data.  If this doesn't cure
	the problem, delete the directory and rebuild it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	  MOVE B,LOOKUB		;RESTORE B
	ENDIF.
	;..
	;..
SYMCMP:	MOVEM A,LOOKUI		;Save increment
	MOVEM B,DRLOC		;And symtab loc
	MOVE A,LOOKUE		;GET ENTRY TYPE
	CALL NAMCM1
	 JRST SYMCM0		;No exact match
	SKIPN DIRSRC		;Looking up a directory?
	IFSKP.			;Yes
	  CALL DRLKFD		;Scan types and gens for a directory
	  JRST SYMCM1		;No dir, treat as a partial match
	ENDIF.
	RETSKP			;SYMBOL FOUND

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

;Here if a subset match occurred

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

;Here on a subset match

SYMCM1:	TQOE <MTCHF>		; A IS SUBSET OF B
	TQO <AMBGF>
SYMCM2:	MOVE A,LOOKUI		;If not found, restore variables
	MOVE B,DRLOC
	JRST MOVDN
;STRFND - Routine to compare the user's input string with a found
;file to see if the two match. Also updates DRREC for partial
;recognition.
;
; Call with:
;	no arguments
;	CALL STRFND
;
; Returns:
;	+1 - Always, with DRREC updated

STRFND:	ADDI B,.SYMLN		;STEP TO NEXT SYMBOL
STRFDD:	MOVEM B,DRLOC
	SKIPL DIRSRC		;[7.1204] Are looking up directory?
	TQNE <NREC,NREC1>	;Skip if recognition allowed
	RET			;[7.1204] No symbol found or looking for directory
	MOVEM B,LOOKUD		;Save this hit location
	SETZM DRREC		;Blast count of matching characters
STRFD0:	MOVEI B,.SYMLN		;Examine next entry
	ADDB B,DRLOC		;Update this too
	MOVE A,DIRORA		;Check for top of symbol table
	LOAD A,DRSTP,(A)
	ADD A,DIRORA		;Make it absolute
	CAML B,A		;Entry index .LT. top?
	JRST STRFD2		;No
	MOVE A,LOOKUE		;Entry type
	CALL NAMCM1		;(A,B/A,B) Still substring?
	 JUMPE A,STRFD1		;A=0; A is subset of B
	JRST STRFD2		;Else A .LT. B, A .GT. B; or A=B, done in any case

STRFD1:	MOVE B,DRLOC		;Recover clobbered ptr
	LOAD A,SYMAD,(B)	;Relative pointer to FDB
	ADD A,DIRORA		;Make absolute
	CALL FDBCHK		;(A/) Check FDB for OKness
	 JRST STRFD2		;Go no further
	CALL NAMSCN		;(A/) Ensure at least 1 non-deleted, visible
	 JRST STRFD0		;You can't recognize what you can't see
	MOVE A,LOOKUD		;Get string block of first candidate
	LOAD A,SYMAD,(A)	;Ptr to FDB
	ADD A,DIRORA		;Make absolute
	LOAD A,FBNAM,(A)	;Address of name string
	MOVE B,DRLOC		;And that of the current candidate
	LOAD B,SYMAD,(B)	;Pointer to FDB
	ADD B,DIRORA		;Make it absolute
	LOAD B,FBNAM,(B)	;Address of name string
	MOVE C,DRREC		;Count of currently matching characters
	CALL SUBSTR		;(A,B,C/A) Get new substring length
	MOVEM A,DRREC		;And save it here
	JRST STRFD0		;Make sure to do them all

STRFD2:	MOVE A,LOOKUD		;Restore initial hit location
	MOVEM A,DRLOC		;Put it here
	RET
;[7.1014]
;SUBSTR - This routine finds the largest common substring between 2
;inputs and less that or equal to some a priori limit
;
; Call with:
;	A/ Rel address of first string block
;	B/ Rel address of second string block
;	C/ Max substring size + 1 (0 = infinite)
;	CALL SUBSTR
;
; Returns:
;	+1 - Always, with number of common characters + 1 in A

SUBSTR:	SAVEQ			;Save these
	EA.ENT			;In section 1
	ADD A,DIRORA		;Form 30-bit virtual address
	ADD B,DIRORA		;Same here
	IFG. C			;Test count
	  SOJE C,SUBST2		;Remove +1 part; If 0, quit
	  JRST SUBST0		;Otherwise, measure strings
	ENDIF.
	LOAD C,BLKLEN,(A)	;Length of A string here
	LOAD D,BLKLEN,(B)	;Length of B string here
	CAILE C,0(D)
	MOVEI C,0(D)		;C now has MIN (C,D)
	SOS C			;Account for header
	IMULI C,5		;Max number of characters that can match
SUBST0:	MOVNI C,0(C)		;Make AOBJN pointer
	HRLZS C
	MOVN Q1,DRINP		;Negative word address of 1st byte of input
	ADD Q1,FILOPT(JFN)	;Plus current byte pointer

;At this point, Q1 has byte pointer info in LH and a word offset in RH.
;Use 18 bit arithmetic to add in the word offset of the 2 byte pointers

	ADDI A,1(Q1)		;Add word offset + 1 to 30-bit address
	ADDI B,1(Q1)		;Same here

;The following code converts the P field of the (presumed) 7-bit
;byte pointer in Q1 into P&S bits 0-5 corresponding to a one-word
;global byte pointer in Q1. See processor reference manual, sec 2.11
;page 2-85.

	LSH Q1,-^D30		;Slide P field over for arithmetic
	IDIVI Q1,7		;Compute (4 - byte # within word)
	MOVNI Q1,-66(Q1)	;-1,,(66 - (byte # - 4))
	LSH Q1,^D30		;Move back to bits 0-5
	IOR A,Q1		;Or in P&S bits with 30-bit address
	IOR B,Q1		;Or in P&S bits with 30-bit address

SUBST1:	ILDB Q1,A		;Input character from 1st string
	ILDB Q2,B		;Input character from 2nd string
	CAIE Q1,0(Q2)		;Same?
	JRST SUBST2		;No
	JUMPE Q1,SUBST2		;Yes, but if NUL then still quit
	AOBJN C,SUBST1		;Count it and do the rest

SUBST2:	MOVEI A,1(C)		;Count of compares + 1
	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.(CHK,DIRSY4,DIRECT,SOFT,<NAMCM4 - Directory symbol table fouled up in directory>,<<A,DIRNUM>,<B,STRNAM>>,<

Cause:	A disordered symbol table was found while comparing name strings.

Action:	Use the EXPUNGE command with subcommand REBUILD to rebuild index table
	of the directory listed in the additional data.  If this doesn't cure
	the problem, delete the directory and rebuild it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	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::EA.ENT
	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::EA.ENT
	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::EA.ENT
	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::EA.ENT
	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
	BUG.(INF,CGROFN,DIRECT,SOFT,<CHKBAK - Can't get root-directory OFN>,<<T1,LSTERR>>,<

Cause:	An OFN cannot be assigned for the backup Root-Directory of a file.

Action:	There may be insufficient OFNs on your system.  If this problem
	persists, increase NOFN and rebuild your monitor.  If this does not
	help, then use the DOB% facility to take a dump and submit an SPR.

Data:	LSTERR - Error returned from ASGOFN
>,R,<DB%NND>)			;[7.1210]
	STOR A,DIROFN		;SAVE THIS OFN
	SETONE DRROF		;INDICATE UNMAPD SHOULD RELEASE OFN
	CALL MAPDRP		;MAP DIRECTORY PAGE
	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
	CALL CPYBAK		;GO MAKE A COPY OF THE FILE
	BUG.(INF,CCBROT,DIRECT,HARD,<CPYBAK - Can't copy backup root-directory>,<<T1,LSTERR>>,<

Cause:	The monitor has detected a problem with the backup root-directory and
	is attempting to copy the primary root-directory to the backup.  The
	copy failed.

Action:	Determine which disk was being used at the time and have Field Service
	check the device to see if it is working properly.

Data:	LSTERR - Error returned from CPYBAK
>,R,<DB%NND>)			;[7.1210]
	RETSKP			;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.(CHK,MPIDXO,DIRECT,SOFT,<MAPIDX - No OFN for Index Table File>,,<

Cause:	There is no open file number for the structure index table.  The
	structure index table file cannot be mapped.

Action:	If this BUGCHK can be reproduced, set it dumpable and submit an SPR
	with the dump and instructions on reproducing the problem.
>)
	RETBAD(DELFX6)		;GIVE FAILURE RETURN
; MAP THE DESIRED INDEX TABLE FILE

MPIDX4:	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
	SKIPN B,FKXORA		;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
	MOVE B,IDXORA		;GET STARTING ADDRESS OF INDEX TABLE
	MOVE C,MXDIRN		;MAX NUMBER OF DIRECTORIES
	IMULI C,.IDXLN+.PPNLN	;NUMBER OF WORDS IN IDXTAB
	LSH C,-PGSFT		;NUMBER OF PAGE IN INDEX + PPN EXTENSION
	HRRZ A,IDXMAP		;GET OFN
	IFN. A			;If we have an OFN
	 TXO A,FILUB		;Don't decrement the open count
	 CALL RELOFN		;RELEASE OFN
	ENDIF.
	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::EA.ENT
	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+.PPNLN	;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::EA.ENT
	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
	IMULI A,.IDXLN		;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::EA.ENT
	CALL CNVIDX		;CONVERT DIR # TO IDXTAB INDEX
	 RETBAD			;ILLEGAL #
	LOAD B,IDXMB,(A)	;[8823] Load the non-storage address bits
	JUMPN B,GETID1		;[8823] If not 0, index table trashed
	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
	CAILE D,IDX%MX		;[8823] Valid flags?
	JRST GETID1		;[8823] No, the INDEX-TABLE is munged
	LOAD A,IDXFB,(A)	;GET THE FDB ADR
	RETSKP			;GOOD RETURN

GETID1:	LOAD A,CURSTR		;[8823] Get current structure
	MOVE A,STRTAB(A)	;[8823] Now get SDB address
	MOVE A,SDBNAM(A)	;[8823] Finally, get structure name
	BUG.(CHK,DIRITD,DIRECT,HARD,<GETIDX - Structure INDEX-TABLE has been damged>,<<A,STRNAM>>,<

Cause:	The non-storage related bits in the INDEX-TABLE are not 0.  The
	structure's INDEX-TABLE is damaged.

Action:	Determine the structure name (it's in SIXBIT in the additional data)
	and RECONSTRUCT the INDEX-TABLE of this structure with CHECKD.

Data:	STRNAM - SIXBIT structure name

>,,<DB%NND>)			;[8823] Let everyone know we found a bad one
	RETBAD (DIRX6)		;[8823] And return to the user

;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
	IMULI A,.IDXLN		;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::EA.ENT
	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
	IMULI D,.IDXLN		;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::EA.ENT
	STKVAR <SVDNUM>		;[7218]STORAGE TO HOLD DIRECTORY NUMBER
	MOVEM A,SVDNUM		;[7218]SAVE DIR #
	CALL CNVIDX		;GET INDEX INTO IDXTAB
	 RET
	SETZRO IDXFB,(A)	;CLEAR ALL ENTRIES
	SETZRO IDXIB,(A)
	SETZRO IDXSD,(A)
	SETZRO IDXFG,(A)
	MOVE A,SVDNUM		;[7218] GET BACK DIRECTORY NUMBER
	CALL ADRPPN		;[7218] CALCULATE PPN OFFSET
	 CALLRET UPDIDX		;[7218]  NO PPNS, SO UPDATE IDXTAB
	SKIPE (A)		;[7218] PREVENT WRITING OUT UNCHANGED PAGE
	SETZM (A)		;[7218] ENTRY EXISTS, SO CLEAR IT
	CALLRET UPDIDX		;UPDATE IDXTAB
	ENDSV.			;[7218] END STORAGE

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

INVIDX::EA.ENT
	ASUBR <DIRNO>
;   IFN CFSCOD,<			;for CFS
	MOVE T2,T1		;Copy directory number
	LOAD T1,CURSTR		;Get structure number
	CALL REMALC		;Release CFS resource
	MOVE T1,DIRNO		;Dir number again
;   >	;IFN CFSCOD
	CALL CNVIDX		;GET INDEX INTO IDXTAB
	 RET
	SETONE IDXIV,(A)	;MARK IT INVALID
	CALLRET UPDIDX		;GO UPDATE THE IDX FILE
	ENDAS.
;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 FKXORA		;Real IDX?
	SKIPN T1,STRTAB(T1)	;GET POINTER TO SDB
	RET			;NONE? DONT DO ANYTHING
	LOAD T1,STRIDX,(T1)	;GET THE OFN OF IDXFIL
	SKIPN T1		;IS THERE ONE?
	RET			;NO, THEN NOTHING TO DO
	HRLZS T1		;GET OFN,,PN FOR PAGE 0
	MOVE T2,MXDIRN		;MAX NUMBER OF DIRECTORIES
	IMULI T2,.IDXLN+.PPNLN	;NUMBER OF WORDS IN IDXTAB
	LSH T2,-PGSFT		;NUMBER OF PAGE IN INDEX + PPN EXTENSION
	CALLRET UPDPGS		;GO UPDATE THEM
;ROUTINE TO MOVE PPN FROM DIRECTORY TO PPN EXTENSION OF IDXTAB
;ACCEPTS IN A/	DIR #
;	CALL SETPPN
;RETURNS +1:	ALWAYS - PPN STORED, IDXTAB UPDATED ON DISK
;DIRECTORY AND IDXTAB MUST BE MAPPED

SETPPN::EA.ENT
	CALL ADRPPN		;COMPUTE ADDRESS TO STORE PPN
	  RET			;CAN'T STORE PPN IF NO IDXTAB EXTENSION
	MOVE B,DIRORA		;DIRECTORY ORIGIN
	LOAD B,DRPPN,(B)	;PPN FROM DIRECTORY
	MOVEM B,(A)		;STORE IT IN IDXTAB EXTENSION
	CALLRET UPDIDX		;REWRITE TABLE AND RETURN

;ROUTINE TO COMPUTE THE ADDRESS OF A PPN IN THE IDXTAB EXTENSION
;ACCEPTS IN A/	DIR #
;	CALL ADRPPN
;RETURNS +1:	IF FKXORA.NE.0
;RETURNS +2:	(A) = ADDRESS OF PPN ENTRY IN IDXTAB EXTENSION

ADRPPN:	SKIPE FKXORA		;SPECIAL FORK IDXORA IF STR CREATION
	RET			;YES, NO EXTENSION TO IDXTAB EXISTS
	MOVE B,MXDIRN		;MAX NUMBER OF DIRECTORIES
	IMULI B,.IDXLN		;NUMBER OF WORDS FOR OLD IDXTAB
	MOVE C,IDXORA		;NO, GET IDXTAB ORIGIN
	ADD B,C			;ADDRESS OF BEGINNING OF PPN EXTENSION
	ADD A,B			;LOC OF PPN FOR THIS DIR
	RETSKP

;ROUTINE TO MAP A PPN INTO A DIRECTORY NUMBER
;ACCEPTS IN A/ 	PPN
;	CALL FNDPPN
;RETURNS +1:	NO MATCH ON PPN
;RETURNS +2:	(A) = DIR # CORRESPONDING TO PPN
;		(B) = PPN
;IDXTAB MUST BE MAPPED

FNDPPN::JUMPE A,R		;ZERO IS NOT A PPN
	EA.ENT
	STKVAR <SAVPPN>		;TEMP
	MOVEM A,SAVPPN		;SAVE PPN
	MOVEI A,0		;START AT THE BEGINNING OF THE PPN EXTENSION
	CALL ADRPPN		;GET ADDRESS OF PPNS
	  RET			;NO PPN IF NO IDXTAB EXTENSION
	MOVE C,A		;ADDRESS TO C
	SETZ A,			;INITIALIZE DIRECTORY NUMBER
	MOVE B,SAVPPN		;CALLER SUPPLIED PPN
FNDPP1:	CAMN B,(C)		;MATCH?
	RETSKP			;YES, FOUND THE PPN
	AOS C			;NEXT LOC
	CAMGE A,MXDIRN		;LOOKED THROUGH THE ENTIRE TABLE?
	AOJA A,FNDPP1		;NO, LOOK AT THE NEXT ENTRY
	RET			;NOT FOUND RETURN
;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:	LOAD A,DRRNA,(D)	;GET REMOTE ALIAS POINTER
	JUMPE A,DR0CH4		;COULD BE ZERO
	CALL RNACHK		;CHECK IT OUT
	 RET			;FAILED
DR0CH4:	RETSKP			;EVERYTHING IS IN ORDER
DR0CHB:	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG.(CHK,DIRPG0,DIRECT,HARD,<DR0CHK - Illegal format for directory page 0 in directory>,<<A,DIRNUM>,<B,STRNAM>>,<

Cause:	The directory header contains incorrect information.

Action: Delete directory and rebuild it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	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,C		;MOVE BLOCK ADDRESS TO RIGHT AC
	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRPG1,DIRECT,HARD,<DRHCHK - Directory header block is bad in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The directory header contains incorrect information.

Action: Delete the directory and rebuild it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)

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

SYMCHK::EA.ENT
	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.(CHK,DIRSY5,DIRECT,HARD,<SYMBAD - Illegal format for directory symbol table in directory>,<<A,DIRNUM>,<B,STRNAM>>,<

Cause:	A symbol table header contains incorrect information.

Action:	Use the EXPUNGE command with subcommand REBUILD to rebuild index table
	of the directory listed in the additional data.  If this doesn't cure
	the problem, delete the directory and rebuild it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	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,FDBCHA		;GET BACK FDB ADDRESS
	CALL GETDSA		;COLLECT INFORMATION FOR BUGCHK
	SKIPE FDBCHF		;BUG CHECK MESSAGE WANTED?
	BUG.(CHK,DIRFDB,DIRECT,HARD,<Illegal format for FDB in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The format for a FDB in a directory is incorrect.

Action:	The directory should be rebuilt.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - The FDB address within the directory
>,,<DB%NND>)			;[7.1210]
	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:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRNAM,DIRECT,HARD,<NAMBAD - Illegal format for directory name block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The file name block is not correct in the symbol table.

Action: Delete and expunge file, then restore it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>)
	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:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIREXT,DIRECT,HARD,<EXTBAD - Illegal format for directory extension block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The file extension block is not correct in symbol table.

Action: Delete and expunge file, then restore it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	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:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRACT,DIRECT,SOFT,<ACTBAD - Illegal format for directory account block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The file account string block is not correct in the symbol table.

Action: Delete and expunge file, then restore it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	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
	MOVE C,A		;COPY ADDRESS
	SUB C,DIRORA		;GET RELATIVE ADR OF THIS BLOCK
	XOR C,B			;SEE IF THE BLOCKS ARE ON THE SAME PAGE
	TRZ C,PGSIZ-1		;MASK OFF LOW ORDER BITS
	JUMPN C,FREBAD		;IF NOT ON SAME PAGE, GO COMPLAIN
FRECH1:	RETSKP			;BLOCK IS OK

FREBAD:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRFRE,DIRECT,SOFT,<FREBAD - Illegal format for directory free block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The directory free block is not correct.

Action:	Use the DELETE command with subcommand DIRECTORY to delete the
	directory file, then rebuild the directory.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	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.(CHK,DIRUNS,DIRECT,HARD,<UNSBAD - Illegal format for directory user name block in directory>,<<A,DIRNUM>,<B,STRNAM>>,<

Cause:	The user name string block is incorrect in the symbol table.

Action:	Use the DELETE command with subcommand DIRECTORY to delete the
	directory file, then rebuild the directory.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)
;check validity of remote alias block
;CALL RNACHK
;A/ relative address of remote alias block
;returns +2 on success
;returns +1 on failure, with BUGCHK
RNACHK:	SAVEAC <T1,T2,T3,T4,Q1>
	ADD A,DIRORA		;make address absolute
	CALL ADRCHK		;see if valid
	 JRST RNABAD		;it isn't
	LOAD B,RNTYP,(A)	;get block type
	LOAD C,RNLEN,(A)	;and length
	CAIL C,2		;length must be at least 2
	CAIE B,.TYRNA		;and type must be remote alias
	JRST RNABAD		;failed
	MOVE D,A		;get working copy of block address
	MOVE Q1,A		;get permanent copy of block address
	SKIPN A,RN.NXT(D)	;is there a real next pointer ?
	IFSKP.
	  ADD A,DIRORA		;there is one, make address absolute
	  LOAD B,RNTYP,(A)	;check
	  CAIN B,.TYRNA		; type
	  CALL ADRCHK		;  and address
	   JRST RNABAD		;failed
	ENDIF.
	LOAD C,RNLEN,(D)	;get count of
	SUBI C,RN.NOD		; name block slots.
	JUMPE C,RSKP		;if none, then done
	ADDI D,RN.NOD		;get to name blocks (node, userid, password)
RNACH1:	SKIPN A,(D)		;get (relative) address of name block
	IFSKP.
	  CALL NAMCHK		;there really is one, check it out.
	   JRST RNABAD		;failed.
	ENDIF.
	AOS D 			;step to
	SOJG C,RNACH1		; next entry
	RETSKP			;done. success

;here on failure
RNABAD:	MOVE A,Q1		;get address of remote alias block
	CALL GETDSA		;(A/A,B,C) directory #, structure name, addr
	BUG.(CHK,DRXRNA,DIRECT,SOFT,<DIRRNA - Illegal formatted remote alias block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	Illegal formatted remote alias block.

Action:	Use the DELETE command with subcommand DIRECTORY to delete the
	directory file, then rebuild the directory.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>)
	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
;PRESERVES A, USES ONLY B

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?
	RET			;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
	CAMN A,RBLDSC		;SAME AS LOCAL COUNT?
	IFSKP.
	  JUMPE P3,[RETBAD(DIRX3)] ;NO - ERROR IF JUST CHECKING
	  MOVE A,RBLDSC		;GET CORRECT COUNT
	  STOR A,DRSDC,(Q1) ;STORE CORRECTED COUNT IN DIR
	ENDIF.
	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
	MOVE T3,A		;Get it back
	OPSTR <SUB T3,>,DRDCA,(Q1) ;Compute the difference
	STOR A,DRDCA,(Q1)	;STORE CORRECT USAGE COUNT
	LOAD A,DRNUM,(Q1)	;Get # of this dir
	LOAD B,CURSTR		;Get STR # as well
	CALL ADJALC		;Update any local copies (T1,T2,T3)
	 NOP
	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
	TQO <NREC>		;[7.1014] No recognition here
	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
	TQO <NREC>		;[7.1014] No recognition here
	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.(CHK,DIRSY6,DIRECT,SOFT,<RBLDST - Prematurely ran out of room in symbol table in directory>,<<A,DIRNAM>,<B,STRNAM>>,<

Cause:	Symbol table space was exhausted while rebuilding symbol table on a
	DELDF JSYS.

Action: Move some files out of the directory.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
>,,<DB%NND>)			;[7.1210]
	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
	TQO <NREC>		;[7.1014] No recognition here
	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::EA.ENT
	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,Q1		;GET ADDRESS OF BLOCK
	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRBLK,DIRECT,SOFT,<BLKSCN - Illegal block type in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	There is an unknown code in a directory block.

Action:	Use the DELETE command with subcommand DIRECTORY to delete the
	directory file, then rebuild the directory.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	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
	.TYRNA,,RNACHK		;REMOTE ALIAS BLOCK
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::EA.ENT
	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
	 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
	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::EA.ENT
	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:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRB2S,DIRECT,SOFT,<RLDFB1 - Directory free block too small in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	A bad directory block is being returned.  Disk space will be lost until
	CHECKD is run on the structure.

Action: No immediate action is required.  Run CHECKD to reclaim lost space.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)

RLDFB2:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRB2L,DIRECT,SOFT,<RLDFB2 - Directory free block too large in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	A bad directory block is being returned.

Action: No immediate action is required.  Run CHECKD to reclaim lost pages.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)

RLDFB3:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRBCB,DIRECT,SOFT,<RLDFB3 - Directory free block crosses page boundary in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	A bad directory block is being returned.

Action: No immediate action is required.  Run CHECKD to reclaim lost pages.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)
REPEAT 0,<			;[8946]
RLDFB4:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRIFB,DIRECT,SOFT,<RLDFB4 - Illegal block type on directory free list in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	No path to the BUGCHK.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in Directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)
>				;[8946] End of repeat 0

RLDFB5:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRBAF,DIRECT,SOFT,<RLDFB5 - Block already on directory free list in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The directory block returned already.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)

RLDFB6:	CALL GETDSA		;COLLECT INFORMATION
	BUG.(CHK,DIRRHB,DIRECT,SOFT,<RLDFB6 - Attempting to return a header block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<

Cause:	The address of a block being returned is illegal.

Action:	There is an inconsistancy in either the monitor's data structure or on
	the file structure.  Dismount the structure and run CHECKD on it.  If
	this does not fix the problem, and this BUGCHK is reproducible on a
	healthy file structure, set this bug dumpable and submit an SPR along
	with the dump and instructions on reproducing it.

Data:	DIRNUM - Directory Number
	STRNAM - Sixbit Structure Name
	ADDR - Address in directory
>,,<DB%NND>)			;[7.1210]
	RETBAD (DIRX3)
;ROUTINES TO COLLECT INFORMATION FOR BUGCHKS.  GETSNM ONLY
;CLOBBERS AC B.  GETDSA CLOBBERS A, B, AND C.  GETDSA ASSUMES
;THE ABSOLUTE ADDRESS OF A BLOCK IS IN A.

GETDSA:	MOVE C,A		;MOVE BLOCK ADDRESS
	SUB C,DIRORA		;CONVERT IT TO A RELATIVE ADDRESS
	MOVE A,DIRORA		;GET FIRST ADDRESS OF DIRECTORY
	LOAD A,DRNUM,(A)	;AND GET THE DIRECTORY NUMBER

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
	SUBTTL End of DIRECT

	TNXEND
	END