Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 7/ft3/monitor/stanford/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
;[MACBETH]SRC:<7.FT2.MONITOR.STANFORD>DIRECT.MAC.2,  6-Apr-88 01:07:19, Edit by A.APPLEHACKS
; FT7.2 Merge
; 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
;[MACBETH.STANFORD.EDU]SRC:<7.FT1.MONITOR.STANFORD>DIRECT.MAC.4, 16-Feb-88 07:05:05, Edit by A.ALDERSON
; Change LOGINS to LGSIDX at line 17 of DRLK0B
;[MACBETH]SRC:<7.FT1.MONITOR.STANFORD>DIRECT.MAC.2,  6-Feb-88 18:50:03, Edit by A.APPLEHACKS
; FT7 Merge 
;	- plus new mod to CSSTSP to find login structure in DEC way [ESC]
;
;[SU-SIERRA.ARPA]SRC:<6.1.MONITOR.STANFORD>DIRECT.MAC.4, 23-Oct-86 11:53:48, Edit by GROSSMAN
; Add Hegarty's non-PS login stuff
;
; 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. 
;------------------------- Autopatch Tape # 13 -------------------------
; *** 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. 
;------------------------- Autopatch Tape # 12 -------------------------
;<6-1-MONITOR.FT6>DIRECT.MAC.3, 12-Aug-85 21:15:17, Edit by WHP4
; add variable lost in STKVAR due to REDIT lossage
;<6-1-MONITOR.FT6>DIRECT.MAC.2, 11-Aug-85 19:23:25, Edit by WHP4
;Stanford changes:
; Partial recognition of filenames
; Case Western Reserve's attribute lookup performance hacks for DUMPER
; ACCCHK invokes ACJ if file protection is zero and all other access checks
;  have failed.  ACJ hook is .GOFIL
; Call ACJ to allow users owner-access to their subdirectories
; If structure is domestic its directory groups are associated with the
;   corresponding user groups on the public structure 
; Relative directory naming
; Paranoia bugchecks in MDDDIR for debugging smashed index tables
; Make list-protected files invisible to completion
;Sumex changes:
; Call DELUNS on LAST READER string in DELFBF
; Call UNSCHK on LAST READER string in FDBCHK
; Call UNSRBD on LAST READER string in RBLDUN
;
; 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)	;...
IFN STANSW,<
	SETO A,			;FLAG THAT WE ARE CHECKING A DIRECTORY (.GOFIL)
>;IFN STANSW
	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
IFE STANSW,<
	STKVAR<ACCCHB,ACCBTS>
>;IFE STANSW
IFN STANSW,<
	STKVAR<ACCCHB,ACCBTS,ACCFDB>	;(.GOFIL)
	MOVEM A,ACCFDB		;SAVE ADDRESS OF FDB (-1 IF DIRECTORY) (.GOFIL)
>;IFN STANSW
	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
IFN STANSW,<
	CALL CSSTSP		;SWITCH Q3 AND T1 TO PS: IF DOMESTIC
>;IFN STANSW
	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:
IFN STANSW,<
	HLLZ B,ACCCHB		;GET REQUESTED ACCESS
	MOVE A,ACCBTS		;CURRENT FILE/DIRECTORY PROTECTION
	CALL ACCSUB		;ASK ACJ IF ACCESSING USER'S SUBDIR (.GOSUB)
	 TRNA			;ACJ SAID NO, TRY EXTRAORDINARY FILE ACCESS
	  RETSKP		;ACJ SAID OKAY
	MOVE B,ACCCHB		;GET REQUESTED ACCESS
	SKIPL A,ACCFDB		;WERE WE CHECKING A FILE?
	 CALL ACCACJ		;YES, MAYBE WE SHOULD ASK ACJ NOW (.GOFIL)
	  SKIPA			;NOT A FILE OR ACCESS REFUSED
	   RETSKP		;ACJ SAID OKAY
>;IFN STANSW
	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
IFN STANSW,<
; AT STANFORD WE CALL THE ACJ TO ALLOW USERS FULL ACCESS TO THEIR SUBDIRS.
;WE FIRST CHECK IF THE ACCESS IS LEGAL IF THE USER WAS THE "OWNER" AND IF
;THE ACCESS IS ALLOWED, WE CALL THE ACJ TO SEE IF THE TARGET DIRECTORY IS
;A SUBDIR OF THE LOGGED-IN DIRECTORY.  THE GETOK% ARGS ARE:
;	1. DIRECTORY NUMBER OF REQUESTOR
;	2. SIXBIT STRUCTURE NAME OF REQUESTED DIRECTORY
;	3. NAME OF REQUESTED DIRECTORY (1(C)...10(C))
;THE REASON WE PASS THE DIRECTORY NAME (INSTEAD OF THE NUMBER AND LET
;THE ACJ DO A DIRST%) IS THAT THE DIRST% REQUIRES THE DIRECTORY LOCK AND
;WE ALREADY HAVE THE LOCK.  TO SAVE TIME, WE ONLY CALL THE ACJ IF THE
;TARGET DIRECTORY IS A SUBDIRECTORY.
;NOTE...IF THE REQUESTED ACCESS IS LEGAL IF THE USER WERE AN "OWNER"
;THEN WE CALL THE ACJ ON BOTH DIRECTORY AND FILE ACCESS CHECKS AND, IF
;THE TARGET DIRECTORY IS A SUBDIR OF THE LOGGED-IN DIRECTORY, WE ALLOW
;THE ACCESS.

ACCSUB:	SAVEAC<C>		;PRESERVE C IN CASE WE NEED TO RETURN AN ERROR
	ANDCAI A,770000		;MASK OFF 6 BITS AND COMPLEMENT
	LSH A,^D18-1		;SHIFT TO LINE UP BITS BETWEEN B AND C
	AND B,A			;GET BAD BITS
	JFFO B,R		;IF ANY ONES, ACCESS NOT PERMITTED
	MOVE C,DIRORA		;BASE ADDR OF MAPPED DIR
	LOAD C,DRNAM,(C)	;GET RELATIVE ADDR OF NAME STRING
	ADD C,DIRORA		;MAKE ADDR VIRTUAL
	LOAD B,NMTYP,(C)	;GET BLOCK TYPE
	CAIE B,.TYNAM		;NAME STRING?
	 RET			;NO, SOMETHING'S REALLY WRONG
	LOAD Q2,NMLEN,(C)	;LENGTH OF NAME BLOCK
	SOJ Q2,			;NUMBER OF WORDS IN NAME STRING
	IMULI Q2,5		;MAX NUMBER OF CHARS TO SERACH
	XMOVEI B,1(C)		;GLOBAL ADDR OF NAME STRING
	TXO B,61B5		;7-BIT ONE WORD GLOBAL BYTE PTR
	DO.
	  ILDB A,B		;GET CHAR FROM NAME STRING
	  JUMPE A,R		;JUMP IF NOT A SUBDIR
	  CAIE A,"."		;SUBDIR DELIMITER?
	   SOJG Q2,TOP.		;NO
	ENDDO.
	JUMPLE Q2,R		;JUMP IF NOT A SUBDIR
	MOVE A,JOBNO		;GET LOGGED-IN DIR NUMBER
	MOVE A,JOBDIR(A)
	LOAD B,CURUC		;USE SAME STR AS MAPPED DIR
	HRLI A,(B)		;INCLUDE STR CODE (TO KEEP DIRST% HAPPY)
	LOAD B,CURSTR		;GET MAPPED DIR'S STR NUMBER
	SKIPL B,DEVNAM+DVXST0(B);GET SIXBIT STR NAME
	 RET			;WHAT THE $#%&
	GTOKM(.GOSUB,<A,B,1(C),2(C),3(C),4(C),5(C),6(C),7(C),10(C)>,<R>)
	RETSKP			;ACJ GAVE ITS BLESSING, SKIP RETURN
;ACCACJ - HERE IF ALL NORMAL ACCESS CHECKING FOR A FILE HAS FAILED.
;WE DECIDE WHETHER OR NOT TO INVOKE THE ACJ FOR FURTHER CHECKING.
;AT PRESENT THE ACCESS CONTROL JOB IS INVOKED ONLY IF THE FILE PROTECTION
;IS ZERO. WE SEND THE FOLLOWING INFORMATION:
;	1. 18-BIT PROTECTION CODE OF THE FILE (FOR NOW, ALWAYS ZERO)
;	2. ACCESS REQUESTED BY USER (THE FP%XXX BITS DEFINED IN MONSYM)
;	3. 36-BIT NUMBER OF THE DIRECTORY IN WHICH THE FILE RESIDES.
;TAKES	A/ ADDRESS OF FDB
;	B/ BITS INDICATING ACCESS REQUESTED

ACCACJ:	SAVEAC <C>		;MAKE SURE C ISN'T EVER CLOBBERED
	LOAD A,FBPRT,(A)	;GET PROTECTION OF THE FILE
	HRRZS A			;MAKE SURE OF JUST 18 BITS
	JUMPN A,R		;WE ONLY TRAP ON A ZERO PROTECTION
	LSH B,-^D29		;TRANSFORM FROM MONITOR BITS TO USER BITS
	LOAD C,CURUC		;GET STRUCTURE UNIQUE CODE OF MAPPED DIRECTORY
	HRL Q2,C		;SET UP A 36-BIT DIRECTORY NUMBER
	GTOKM(.GOFIL,<A,B,Q2>,<R>)	;ASK ACJ, SINGLE RETURN IF DENIED
	RETSKP			;ACJ GAVE ITS BLESSING, SKIP RETURN
;CSSTSP - IF THIS STRUCTURE IS DOMESTIC, CHANGE Q3 TO THE JSB
; INDEX FOR THE PUBLIC STRUCTURE AND T1 TO BE THE STRUCTURE CODE.
; THIS IS USED TO MAKE USER GROUP NUMBERS COME FROM THE PUBLIC STRUCTURE
;
; ACCEPTS:
; T1 - A STRUCTURE CODE.
; Q3 - JSB INDEX FOR THIS STRUCTURE.
; RETURNS +1: ALWAYS T2-T4 PRESERVED, T1 - NEW INDEX., Q3 JSB INDEX.

CSSTSP:	SAVEAC <T2,T3,T4>	;PRESERVE OTHER TEMPS.
	LDB T2,[POINT STRNS,T1,35] ;GET THE STRUCTURE NUMBER
	JUMPE T2,R		;IF PS, NOTHING MORE TO DO.
	MOVE T2,STRTAB(T2)	;GET ADDRESS OF STRUCTURE TABLE.
	MOVE T2,SDBSTS(T2)	;GET FLAGS.
	TXNN T2,MS%DOM		;DOMESTIC?
	 RET			;NO, LEAVE Q3,T1 ALONE.
	MOVE T2,LGSIDX		;[ESC][7.1112] Get Login Structure number
	MOVE T2,STRTAB(T2)	;[ESC][7.1112] Get pointer to SDB
	HLRZ T3,SDBFLK(T2)
	SETZ Q3,		;ASSUME NO JSB ENTRY.
	MOVE T1,T3		;GET UNIQUE CODE.
	CALL FNDSTO		;GET INDEX INTO JSB.
	 SETZ T2,		;PS NOT MOUNTED EH?
	HRRZM T2,Q3		;CHANGE OFFSET.
	MOVE T1,T3		;REGET UNIQUE CODE.
	RET
>;IFN STANSW
;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
IFN STANSW,<
;THIS CODE SUPPORTS SOME UNIX-STYLE DIRECTORY NAMING CONVENTIONS:
;	STR:<.FOO>  - refers to subdirectory of connected directory
;	STR:<..FOO> - refers to another subdirectory of direct superior
;	STR:<..>    - refers to superior directory of connected directory
;	PS:<~>	    - refers to login directory
;	PS:<~.FOO>  - refers to subdirectory of login directory

	MOVE B,DIRLKI		;GET DIRECTORY POINTER
	ILDB C,B		;GET FIRST CHARACTER OF DIRECTORY NAME
	CAIN C,"."		;WAS IT "."?
	 JRST DRLK1A		;YES, GO HANDLE DOT CASES
	CAIE C,"~"		;TILDE?
	 JRST DIRLK1		;NO, CONTINUE MAIN ROUTINE
	MOVE C,DIRLKC		;GET STRUCTURE CODE
	SKIPGE A,LGSIDX		;GET THE LOGIN STRUCTURE INDEX INTO SDB
	 MOVEI A,PSNUM		; FAILED, USE PS INSTEADD
	CAME C,A		;IS THIS THE LOGIN STRUCTURE?
	 JRST RFALSE		;NO, NON-PS AND HOME DIRECTORY IS CONTRADICTION
	MOVE C,JOBNO		;GET OUR JOB NUMBER
	SKIPN A,JOBDIR(C)	;GET LOGGED IN DIRECTORY NUMBER
	 JRST RFALSE		;WE ARE NOT LOGGED IN, SO WE FAIL
	HRL A,DIRLKS		;MAKE A FULL DIRECTORY NUMBER
	IBP DIRLKI		;MOVE POINTER PAST THE TILDE
	ILDB C,B		;GET SECOND BYTE
	JUMPE C,DRLK1C		;IF NULL, THEN "PS:<~>" WAS GIVEN
	CAIN C,"."		;WAS "PS:<~.something>" GIVEN?
	 IBP DIRLKI		;YES, MOVE POINTER PAST THE DOT
	JRST DIRLK1		;GO LOOKUP REST OF FILE SPEC

;HERE WHEN INITIAL BYTE WAS A DOT

DRLK1A:	HLRZ C,JSBSDN		;GET STRUCTURE CODE FOR OUR CONNECTED DIR.
	CAME C,DIRLKS		;SEE IF RELATIVE SEARCH IS POSSIBLE 
	 JRST RFALSE		;NO, SAY NO MATCH
	IBP DIRLKI		;YES, MOVE POINTER PAST THE DOT
	MOVE A,JSBSDN		;AND USE CONNECTED DIR #
	ILDB C,B		;LOOK AT THE SECOND CHARACTER
	CAIE C,"."		;DO WE HAVE A LEADING ".."?
	 JRST DIRLK1		;NO, CONTINUE MAIN ROUTINE
	IBP DIRLKI		;YES, BUMP POINTER A SECOND TIME
	MOVE A,DIRLKS
	CALL CNVSTR		;LOCK THE STRUCTURE
	 JRST RFALSE		;NOT MOUNTED
	MOVEM A,DIRLKC		;SAVE STRUCTURE CODE
	CALL MAPIDX		;ENSURE THE INDEX FILE IS MAPPED
	 JRST DRLK1B		;SAY NO MATCH
	HRRZ A,JSBSDN		;GET BACK OUR CONNECTED DIR NUMBER
	CALL GETIDX		;GET INDEX FILE INFORMATION
	 JRST DRLK1B		;SAY NO MATCH
	TXNE D,IDX%IV		;VALID ENTRY?
DRLK1B:	 SETZ C,		;NOPE. SET C TO ZERO TO INDICATE FAILURE
	MOVE A,DIRLKC		;GET BACK STRUCTURE CODE
	PUSH P,C		;SAVE SUPERIOR'S DIR. NUMBER ('WARE STKVARS!)
	CALL ULKSTR		;UNLOCK THE STRUCTURE
	POP P,A			;RESTORE THAT DIRECTORY NUMBER/FLAG
	JUMPE A,RFALSE		;IF ZERO, INDICATE NO MATCH
	MOVE B,DIRLKI		;LOOK AT THIRD BYTE FOR "STR:<..>" CASE
	ILDB C,B		; ...
	JUMPN C,DIRLK1		;IF NULL, THEN WE WANT SUPERIOR ITSELF
DRLK1C: MOVE B,DIRLKP		;GET LOOKUP POINTER INTO PLACE
	RETSKP			;RETURN TO CALLER, A AND B SETUP

>;IFN STANSW
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,SOFT,<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 and DIRECTORY subcommand.

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
IFN STANSW&SUMXSW,< 
	MOVE A,DELFBA		;FDB ADDR
	MOVE C,A		;COPY IT
	ADDI C,.FBBK2		;POINT TO LAST READER
	CALL DELUNS		;DELETE USER NAME STRING
>;IFN STANSW&SUMXSW
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


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)
;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.

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.

>)
	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,DIRDNL,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.

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
IFE STANSW,<
	STKVAR <MDDDNO,MDDFLG,MDDDWS,MDDDPT,<MDDDNM,MAXLW>>
>;IFE STANSW
IFN STANSW,<
	STKVAR <MDDDNO,MDDFLG,MDDDWS,MDDDPT,MDDPRV,<MDDDNM,MAXLW>>
	MOVEM T1,MDDPRV		;SAVE PREVIOUS DIRECTORY NUMBER
>;IFN STANSW
	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
IFE STANSW,<
	 JRST MDDDI3		;BAD FDB - GO UP A LEVEL AND RETRY
>;IFE STANSW
IFN STANSW,<
	 JRST MDDI3X		;BAD FDB - BUG CHECK, GO UP A LEVEL AND RETRY
>;IFN STANSW
	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
IFE STANSW,<
	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
>;IFE STANSW
IFN STANSW,<
	 JRST MDDI3X		;YES - BUG CHECK, TRY UP A LEVEL
	LOAD T1,SYMET,(Q1)	;STILL IN NAME PORTION
	CAIE T1,.ETNAM		;OF SYMBOL TABLE?
	 JRST MDDI3X		;NO
	JRST MDDDI5		;YES - LOOK IN THIS SET OF FDBS

MDDI3X:	MOVE T1,MDDPRV		;PREVIOUS DIRECTORY NUMBER, NOW MISSING
	MOVE T2,MDDDNO		;CURRECT DIRECTORY, WHICH IS PARENT
	BUG.(CHK,MDDFDB,DIRECT,SOFT,<FDB of previous dir missing.  Prev,parent =>,<<T1,PREV>,<T2,PARENT>>)
	JRST MDDDI3

MDDDIZ:	BUG.(CHK,MDDDIX,DIRECT,SOFT,<Smashed IDXTAB or bad directory number.  #,parent =>,<<T1,DIR>,<T3,PARENT>>)
	JRST MDDDIC
>;IFN STANSW
;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:	
IFE STANSW,<
	JUMPN T2,MDDDIC		;NULL ENTRY?
>;IFE STANSW
IFN STANSW,<
	JUMPN T2,MDDDIZ		;NULL ENTRY?
>;IFN STANSW
	MOVX T4,FB%LNG		;IS THIS A LONG FILE?
	TDNE T4,.FBCTL(Q3)	; ???
	JRST [	BUG.(CHK,LNGDIR,DIRECT,SOFT,<Long directory file in directory>,<<T3,DIRNUM>>,<

Cause:	The subdirectory has an incorrect superior directory.

Action: Rebuild index table.

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: Rebuild symbol table.

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
IFN STANSW,<

; The check for stepping is necessary since the GNJFN% code first
; causes the file currently being examined to be looked up.  Unfortunately,
; the fact that attributes are scanned last means that the initial
; portion of GTJFN% can find a file that a later check won't, because
; of the new constraints imposed by the now-present attributes.  When
; GTJFN% decides to do an internal GNJFN%, it will fail immediately
; because what should be the current FDB is no longer valid and GNJFN%
; never even gets around to stepping it.  Another problem is that the
; DUMP-PENDING attribute mask will fail on all but the first file of
; a directory because when GNJFN% finds an FDB, returns it, DUMPER
; clears the DUMP-PENDING flag, and the GNJFN% tries to find it again
; prior to stepping the JFN it will fail and not bother to step to
; the next one, merely because the attribute has changed.  This will
; really have to be examined in detail at some point, but for the present,
; this shall serve.

	TQNN <STEPF>		;[CWR] ARE WE STEPPING NOW?
	IFSKP.			;[CWR]   TAKE BLOCK IF SO
	  CALL MDDAMC		;[CWR] WILL THIS FDB MATCH THE MASK?
	   JRST EXTSC2		;[CWR]   NO, STEP TO NEXT
	ENDIF.
>;IFN STANSW
	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
IFN STANSW,<
	EXCH A,D		;[CWR] TRADE REGISTERS
	CALL MDDAMC		;[CWR] ATTRIBUTE MASK OK?
	 JRST  [EXCH A,D	;[CWR] NO, RECOVER REGISTERS
		JRST VERLK1]	;[CWR]   AND GO TO NEXT VERSION
	EXCH A,D		;[CWR] ATTRIBUTES OK, REALIGN AC CONTEXT
>;IFN STANSW
	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
IFN STANSW,<
	CALL MDDAMC		;[CWR] CHECK ATTRIBUTES
	 JRST VERLKF		;[CWR]   FAILED
>;IFN STANSW
	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:	
IFN STANSW,<
	EXCH A,D		;[CWR] SWAP REGISTERS
	CALL MDDAMC		;[CWR] CHECK ATTRIBUTES
	 JRST  [EXCH A,D	;[CWR] FAILED, REGAIN REGISTERS
		JRST VERLK1]	;[CWR]   AND HANDLE FAILURE
	EXCH A,D		;[CWR] RECOVER REGISTERS AGAIN
>;IFN STANSW
	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>
IFN STANSW,<
	MOVE A,DRLOC		;[CWR] PICK UP OUR FDB
	CALL MDDAMC		;[CWR] CHECK EXTENDED ATTRIBUTES
	 JRST VERLKF		;[CWR]   FAILED CHECK, GO TO PREVIOUS
	MOVE D,A		;[CWR] SET UP FOR FOLLOWING CHECKS
>;IFN STANSW
IFE STANSW,<			; THE MOVEI SEEMS SUPERFLUOUS...
	MOVEI A,GJFX20
	MOVE D,DRLOC
>;IFE STANSW			;   AND THE MOVE D, IS TAKE CARE OF ABOVE
	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.
IFN STANSW,<

; Note: it is necessary to have a special case for stepping
; since the stepping code works by going to the "current"
; FDB and then stepping.  It would appear that the original
; code isn't right either for this case.

	CALL MDDAMC		;[CWR] CHECK ATTRIBUTE MASK
	IFNSK.
	  TQNN <STEPF>		;[CWR] FAILED, STEPPING?
	   JRST VERL52		;[CWR]   NO, REALLY FAILED
	ENDIF.			;[CWR] OTHERWISE, PRETEND SUCCESS
>;IFN STANSW
	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
IFN STANSW,<			;[CWR]

; Check attributes on a MDD file.
; Accepts:	T1/ Block address
;		T2/ Attribute value
;		GTJFN% registers setup
; Returns:	+1 Invalid: error code in T1
; 		+2 Good attribute
; Uses:		T2,T3,T4

MDDATR::STKVAR <MDDATC>		; Declare local storage
	MOVEM T2,MDDATC		; Save attribute code 
	MOVSI T3,-MAXMDA	; Get number of attributes in table
MDDAT0:	CAME T2,MDATTR(T3)	; Is this it?
	 AOBJN T3,MDDAT0	; Loop over table
	JUMPGE T3,[RETBAD(GJFX49)]	; Error if didn't find it
	MOVE T4,MDATTL(T3)	; Get pointer to exclusion list
MDDAT1:	MOVE T2,(T4)		; Get entry
	CALL MDAFND		; Has this attribute been specified?
	 RETBAD(GJFX45)		;   Yes, split with error
	AOBJN T4,MDDAT1		; Otherwise, process entire list
	MOVE T2,MDDATC		; Get back attribute code
	CAIE T2,.PFSNC		; Is this the SINCE: attribute?
	 RETSKP			; No, can return now
	SKIPN T1		; Pointer exists?
	 RETBAD(GJFX46)		; "Attribute value is required"
	HRLI T1,010700		; Fix up byte pointer
	MOVEI T3,^D12		; Decimal radix
	NIN%			; Read a number
	 ERJMPR R		; Return an error code in T1
	SKIPGE T2		; Check for negative numbers
	 RETBAD(STADX2)		; "Invalid date or time"
	MOVE T3,T2		; Copy number of days into a safe register
	LSH T3,^D18		; Convert to number of days, internal format
	CALL LGTAD		; Get current time and date
	SUB T1,T3		; Subtract off the specified number of days
	MOVEM T1,FILSNC(JFN)	; Remember the cutoff date for later use
	RETSKP			; We're finished

	ENDSV.
; MDD Attribute Find
; Accepts:	T2/ Prefix code for attribute
;		GTJFN% registers setup
; Returns:	+1 Attribute found
;		+2 Attribute not found
; Uses:		T3

MDAFND:	LOAD T3,FLATL,(JFN)	; Get list of attributes
MDAFN0:	JUMPE T3,RSKP		; What we're looking for isn't there
	OPSTR <CAME T2,>,PRFXV,(T3) ; Is this it?
	 JRST  [LOAD T3,PRFXL,(T3) ; No, get link
		JRST MDAFN0]	;   and keep looking
	RET			; Otherwise, we have it, return 

; Attribute Lists for search and check routine

MDATTR:	.PFINC&PFXMSK		; INCREMENTAL
	.PFSUM&PFXMSK		; SUMMARY
	.PFPND&PFXMSK		; DUMP-PENDING
	.PFSNC&PFXMSK		; SINCE:
MAXMDA==.-MDATTR

MDATTL:	IOWD <MAXMDA-1>,[.PFSUM
			 .PFSNC
			 .PFPND]
	IOWD <MAXMDA-1>,[.PFINC
			 .PFSNC
			 .PFPND]
	IOWD <MAXMDA-1>,[.PFINC
			 .PFSNC
			 .PFSUM]
	IOWD <MAXMDA-1>,[.PFINC
			 .PFSUM
			 .PFPND]
; MDD Attribute Mask Check Routine
; Called at end of version lookup to ensure that file has the attributes
; expected by the caller.  Newly created FDBs are always successful, old
; ones must match the required attribute or a failure is returned
;
; Accepts:	T1/ FDB Address
;		GTJFN% registers setup
; Returns:	+1 Failed mask check
;		+2 Passed mask check or mask didn't apply
; Uses:		T2,T3

MDDAMC::TQNE <NEWF,NEWVF>	; New file or New Version Found?
	 RETSKP			;   Yes, always succeeds
	SAVEAC (T4)		; Remain transparent to this register
	LOAD T4,FLATL,(JFN)	; Get head of list
MDDAM0:	JUMPE T4,RSKP		; If mask not specified, then success
	MOVSI T3,-MAXMDA	; Initialize search
	LOAD T2,PRFXV,(T4)	; Get attribute from list
	ANDX T2,PFXMSK		; Mask off all but prefix code
MDDAM1:	CAMN T2,MDATTR(T3)	; Do we have a match?
	 JRST @MDATTD(T3)	;   Yes, go validate FDB
	AOBJN T3,MDDAM1		; No, complete search through list
	LOAD T4,PRFXL,(T4)	; No match on that item, get next
	JRST MDDAM0		;   and begin again

MDATTD:	IFIW!MDAINC		; INCREMENTAL
	IFIW!MDASUM		; SUMMARY
	IFIW!MDAPND		; DUMP-PENDING
	IFIW!MDASNC		; SINCE:
; INCREMENTAL mask: return success only if write count has changed
;		    or the tape count is 0
; SUMMARY mask: same as incremental but with tape count of 1

MDAINC:	SKIPA T2,[1]		; Load desired tape count
MDASUM:	 MOVEI T2,2		; Desired tape count
MDACKD:	MOVE T3,.FBCTL(T1)	; First, check flags word
	TXNE T3,FB%NOD		; Should we bother?
	 RET			;   No, just leave
	STKVAR <MDATPC>		; Tape count
	MOVEM T2,MDATPC		; Save it for reference
	HLRZ T2,.FBCNT(T1)	; (T2) = count of writes
	HLRE T3,.FBBK0(T1)	; (T3) = tape count, but is negative
				;   if dump was interrupted so that
				;   a file with interrupted dump is 
				;   always dumped
	HRRZ T4,.FBBK0(T1)	; (T4) = Write count of last dump
	CAMN T2,T4		; Did write count change?
	 CAMGE T3,MDATPC	; No, is it on enough tapes or did dump get
				; interrupted?
	  RETSKP		; Count changed, not enough tapes, or 
				;   interrupted dump: return success
	RET			; Otherwise, all conditions fail, not this one

; DUMP-PENDING mask: Return success only if the DUMPER pass 1 bit set

MDAPND:	SKIPL .FBBK0(T1)	; Is the dump-pending bit set?
	 RET			;   No, this version is no good
	RETSKP			; Otherwise, it's what we want

; SINCE:<days in the past>.  Return success if last write of file is after the
; specified cutoff time.

MDASNC:	MOVE T2,.FBWRT(T1)	;Get last write date of the file
	CAMGE T2,FILSNC(JFN)	;Written after cutoff date?
	 RET			;No, ignore it
	RETSKP			;Yes, we want it
>;IFN STANSW			;[CWR]
; 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: Rebuild symbol table.

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 than 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: Rebuild the symbol table.

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.

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.

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 mappped.
>)
	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,IDXIB,(A)	;GET THE DISK ADR OF INDEX BLOCK
	JUMPE B,[RETBAD(DIRX1)]	;IF 0, NOT SET UP YET
	LOAD C,IDXSD,(A)	;GET SUPERIOR DIR NUMBER
	LOAD D,IDXFG,(A)	;GET FLAGS INTO D
	LOAD A,IDXFB,(A)	;GET THE FDB ADR
	RETSKP			;GOOD RETURN


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

CNVIDX:	SKIPLE A		;ZERO OR NEGATIVE IS BAD
	CAML A,MXDIRN		;IS NUMBER TOO HIGH?
	RETBAD (DIRX1)		;YES, ILLEGAL DIR NUMBER
	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,SOFT,<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,SOFT,<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: Rebuild symbol table.

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
IFN STANSW&SUMXSW,< 
	LOAD A,FBBK2,(A)	;GET LAST READER STRING
	IFN. A
	  CALL UNSCHK		;CHECK ITS BLOCK TYPE
	   RET			;BAD
	ENDIF.
	MOVE A,FDBCHA		;FDB ADDRS AGAIN
>;IFN STANSW&SUMXSW
	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,SOFT,<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,SOFT,<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,SOFT,<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: Check SYSERR for file.  Delete and expunge it,
	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: Check SYSERR for file.  Delete and expunge it, then
	restore the file.

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: Rebuild 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: Check SYSERR for file.  Delete and expunge it,
	then restore the file.

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.

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: Split directory into more directories.

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
IFN STANSW&SUMXSW,< 
	LOAD A,FBBK2,(Q1)	;GET LAST READER STRING
	IFN. A			;IGNORE IF NONE
	  CALL UNSRBD		;DO USER NAME ROUTINE
	   RETBAD (DIRX3)	;ERROR
	ENDIF.
>;IFN STANSW&SUMXSW
	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: Delete directory and rebuild it.

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: 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: 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: Run CHECKD to reclaim lost pages.

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

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.

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