Google
 

Trailing-Edge - PDP-10 Archives - AP-4178E-RM - swskit-sources/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
;<3A.MONITOR>DIRECT.MAC.4, 19-Jun-78 14:44:59, EDIT BY KIRSCHEN
;CHECK SYMBOL DRMSDA FOR A LIMITED STRUCTURE
;<3A.MONITOR>DIRECT.MAC.3, 22-Mar-78 13:07:39, EDIT BY MILLER
;XPANDP WILL FAIL IF STRUCTURE NOT FULLY MOUNTED
;<3A.MONITOR>DIRECT.MAC.2, 22-Feb-78 09:58:31, EDIT BY MILLER
;CHANGE CHECK AT XPAND. COMPARE AGAINST DRMASZ
;<3A.MONITOR>DIRECT.MAC.1, 22-Feb-78 09:53:48, EDIT BY MILLER
;CHECK FOR LIMITED STRUCTURE IN XPAND.
;<3-MONITOR>DIRECT.MAC.335,  7-Nov-77 13:00:08, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>DIRECT.MAC.334, 10-Oct-77 14:37:55, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>DIRECT.MAC.333,  9-Sep-77 10:05:37, EDIT BY MILLER
;MAKE FDBIN0 INSURE THAT ONLY FB%NSF IS ON IS FDB
;<3-MONITOR>DIRECT.MAC.332, 26-Aug-77 00:04:33, EDIT BY BOSACK
;<3-MONITOR>DIRECT.MAC.331, 25-Aug-77 10:49:30, Edit by MACK
;DR0CHK NOW CHECKS DEFAULT DIR ACCOUNT BLOCK
;<3-MONITOR>DIRECT.MAC.330, 25-Aug-77 10:31:35, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.329, 15-Aug-77 18:22:32, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.328, 15-Aug-77 11:19:25, EDIT BY HURLEY
;FIXED THE MDDDIR STEP ALGORITHM TO FIND <NAME.*> MATCHES
;<3-MONITOR>DIRECT.MAC.327, 15-Aug-77 10:35:16, EDIT BY HURLEY
;FIXED ACCCHK AGAIN
;<3-MONITOR>DIRECT.MAC.326, 12-Aug-77 16:58:21, EDIT BY HURLEY
;MAKE ACCCHK ALLOW DIR ACCESS TO DIRECTORY FILES
;<3-MONITOR>DIRECT.MAC.325,  8-Aug-77 10:50:12, EDIT BY MILLER
;CHECK FOR ZERO RETURN FROM FPTA
;<3-MONITOR>DIRECT.MAC.324,  4-Aug-77 19:08:20, Edit by HESS
;FIX TO FDBIN0 FOR USER NAME STRING USE COUNT BUG
;<3-MONITOR>DIRECT.MAC.323,  3-Aug-77 14:13:57, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.322,  2-Aug-77 16:54:31, EDIT BY HALL
;FIX UP THE SPEEDUP (TEMPORARILY)
;<3-MONITOR>DIRECT.MAC.321, 29-Jul-77 10:34:05, EDIT BY HURLEY
;SPEED UP WILD CARD DIRECTORY LOOKUPS
;<3-MONITOR>DIRECT.MAC.320, 27-Jul-77 16:00:42, EDIT BY HALL
;MAKE GDIRST CHECK FOR VALID NAME BLOCK
;<3-MONITOR>DIRECT.MAC.319, 27-Jul-77 14:26:30, EDIT BY HALL
;MAKE ACCCHK FAIL IF TRYING TO WRITE DIRECTORY FILE
;<3-MONITOR>DIRECT.MAC.318, 27-Jul-77 12:41:40, EDIT BY HALL
;TCO 1813 - SPEED UP SUPCHK
;<3-MONITOR>DIRECT.MAC.317, 22-Jul-77 10:21:00, EDIT BY HURLEY
;MAKE SETIDX NOT STORE THE HIGHEST DIRECTORY NUMBER SEEN
;<3-MONITOR>DIRECT.MAC.316, 20-Jul-77 20:00:23, EDIT BY HALL
;ALWAYS STORE IN DIROFN; SET DRROF IF RELEASING OFN IN UNMAPD
;<3-MONITOR>DIRECT.MAC.315, 20-Jul-77 19:55:55, EDIT BY HALL
;BUG FIXES TO SUPCHK
;<3-MONITOR>DIRECT.MAC.314, 20-Jul-77 16:50:56, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.313, 19-Jul-77 18:58:45, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.312, 19-Jul-77 18:27:24, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.311, 19-Jul-77 17:57:15, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.310, 19-Jul-77 17:04:29, EDIT BY HALL
;BUG FIXES TO SUPCHK
;<3-MONITOR>DIRECT.MAC.309, 19-Jul-77 16:46:20, EDIT BY HURLEY
;FIX THE FDBCHK CACHE FOR EXTENDED ADDRESSING
;<3-MONITOR>DIRECT.MAC.308, 19-Jul-77 16:44:05, EDIT BY HURLEY
;ADD SUPPORT FOR SUBDIRECTORY RECONSTRUCTION
;<3-MONITOR>DIRECT.MAC.307, 19-Jul-77 13:43:13, EDIT BY HALL
;ADD SUPCHK TO CHECK ACCESS TO SUPERIOR
;<3-MONITOR>DIRECT.MAC.306, 13-Jul-77 16:26:41, Edit by MACK
;TCO 1822 - INSACT CHANGES TO SUPPORT ACCOUNT VALIDATION
;<3-MONITOR>DIRECT.MAC.305, 12-Jul-77 00:39:07, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.304, 12-Jul-77 00:05:36, Edit by MCLEAN
;MAKE MXDIRN MEMORY LOCATION
;<3-MONITOR>DIRECT.MAC.303, 11-Jul-77 22:57:20, EDIT BY CROSSLAND
;TCO 1840 EXPUNGE ;T FILES WITH VERSION NUMBER LESS THAN 100000
; WHEN DOING ;T FILES WITH VERSION NUMBER 100000+JOBNO.
;<3-MONITOR>DIRECT.MAC.302,  9-Jul-77 15:05:15, EDIT BY HALL
;MAKE XPANDP TEST FOR EXCEEDING QUOTA BEFORE EXPANDING SYMBOL TABLE
;<3-MONITOR>DIRECT.MAC.301,  3-Jul-77 18:17:42, EDIT BY BOSACK
;PREVENT DIRLUK FROM RECOGNIZING MORE THAN 39 CHAR
;<3-MONITOR>DIRECT.MAC.300, 30-Jun-77 14:36:30, EDIT BY BOSACK
;FIX DIRLUK "IMPROVEMENT" FOR EXADDR
;<3-MONITOR>DIRECT.MAC.299, 27-Jun-77 13:34:06, Edit by HESS
;REMOVE OLD REFS TO ACCTPT
;<3-MONITOR>DIRECT.MAC.298, 21-Jun-77 14:58:09, EDIT BY HALL
;FIX INSSYM TO SET UP LENGTH FOR XBLTA CORRECTLY
;<3-MONITOR>DIRECT.MAC.297, 10-Jun-77 15:27:21, EDIT BY BOSACK
;CORRECT CHECK FOR PAGE EXISTS IN DIRLUK AND GDIRST
;<3-MONITOR>DIRECT.MAC.296, 10-Jun-77 13:39:41, EDIT BY HURLEY
;MERGE RELEASE 2 PERFORMANCE IMPROVEMENTS INTO RELEASE 3
;<2-PERF>DIRECT.MAC.252,  7-Jun-77 20:43:35, EDIT BY BOSACK
;ALWAYS RETURN UPDATED POINTER ON DIRLUK SUCCESS
;<2-PERF>DIRECT.MAC.249,  2-Jun-77 22:58:32, EDIT BY MURPHY
;<2-PERF>DIRECT.MAC.246, 26-May-77 19:39:17, EDIT BY BOSACK
;<2-PERF>DIRECT.MAC.245, 26-May-77 15:20:14, EDIT BY HURLEY
;ADD CHECK IN DIRLKX TO SEE IF DESIRED DIR IS THE ONE MAPPED
;<2-PERF>DIRECT.MAC.244, 26-May-77 15:12:24, EDIT BY HURLEY
;ADDED FDBCHK SPEED UP BY KEEPING ADR OF LAST FDB CHECKED
;<3-MONITOR>DIRECT.MAC.294,  9-Jun-77 21:57:30, EDIT BY MURPHY
;PERFORMANCE ENHANCEMENTS
;<1BOSACK>DIRECT.MAC.293,  7-Jun-77 20:37:38, EDIT BY BOSACK
;ALWAYS RETURN UPDATED POINTER ON DIRLUK SUCCESS
;<1BOSACK>DIRECT.MAC.292, 30-May-77 20:00:26, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.291, 30-May-77 19:48:33, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.290, 30-May-77 17:07:00, EDIT BY BOSACK
;MAKE GETNDN SCAN ENTIRE INDEX TABLE FOR FREE DIR NUMBER
;CORRECTLY ENTER ROOTDIR IN INDEX TABLE IN MDDDIR
;<1BOSACK>DIRECT.MAC.289, 30-May-77 16:43:17, EDIT BY BOSACK
;PREVENT DELDEL FROM CLEARING A DIR WITH SUBDIRS
;DETECT LONG DIR FILE AND BUGCHK IN MDDDIR
;<1BOSACK>DIRECT.MAC.288, 30-May-77 13:39:30, EDIT BY BOSACK
;REPAIR RECOGNITION WITH EXADDR
;DO PARTIAL RECOGNITION IF DIR HAS SUBDIRS
;<1BOSACK>DIRECT.MAC.287, 29-May-77 22:17:29, EDIT BY BOSACK
;CHECK/CORRECT SUBDIR COUNT FOR SYMBOL TABLE REBUILD
;<3-MONITOR>DIRECT.MAC.286, 19-May-77 22:50:28, EDIT BY BOSACK
;<3-MONITOR>DIRECT.MAC.285, 19-May-77 15:20:38, EDIT BY BOSACK
;SPEED UP DIRLUK BY FIRST CHECKING FOR ANY MAPPED DIR
;<3-MONITOR>DIRECT.MAC.284, 19-May-77 14:19:47, EDIT BY BOSACK
;<3-MONITOR>DIRECT.MAC.283, 17-May-77 19:47:51, EDIT BY BOSACK
;TCO 1798 - FIX SPECIAL DIR LOOKUP LOGIC TO SPEED UP DIRLUK
;<3-MONITOR>DIRECT.MAC.282, 13-May-77 13:48:37, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.281,  2-May-77 19:42:37, EDIT BY BOSACK
;ELIMINATE USE MACRO
;<1BOSACK>DIRECT.MAC.280, 31-Mar-77 19:10:36, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.279, 27-Mar-77 16:47:14, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.278, 17-Mar-77 17:00:49, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.277, 16-Mar-77 15:31:36, EDIT BY BOSACK
;UNMAP DIR IN UNMIDX
;<3-MONITOR>DIRECT.MAC.276,  4-Mar-77 15:25:27, EDIT BY HURLEY
;TCO 1751 - FIX ACCCHK SECURITY HOLE IF NO GROUPS SET UP
;<1BOSACK>DIRECT.MAC.275, 23-Feb-77 17:14:14, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.274, 22-Feb-77 20:17:15, EDIT BY BOSACK
;DISALLOW ALL ACCESS TO DIRECTORY FILES UNLESS ENABLED WHOPER
;<1BOSACK>DIRECT.MAC.273, 21-Feb-77 17:16:02, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.272, 21-Feb-77 15:26:25, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.271, 21-Feb-77 15:16:42, EDIT BY BOSACK
;REWORK INTERNAL DIRST FOR DIR TREE
;<1BOSACK>DIRECT.MAC.270, 17-Feb-77 14:24:48, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.269, 16-Feb-77 18:06:06, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.268, 16-Feb-77 16:55:55, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.267, 16-Feb-77 15:02:55, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.266, 15-Feb-77 22:15:46, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.265, 15-Feb-77 22:11:31, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.264, 15-Feb-77 21:55:28, EDIT BY BOSACK
;CAUSE DIRLUK/LKX TO KNOW ABOUT DIR TREE
;<1BOSACK>DIRECT.MAC.263,  5-Feb-77 01:00:52, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.262,  5-Feb-77 00:08:14, EDIT BY BOSACK
;<1BOSACK>DIRECT.MAC.261,  4-Feb-77 03:03:55, EDIT BY BOSACK
;NEW DIR STEPPING LOGIC FOR DIRECTORY TREE
;<3-MONITOR>DIRECT.MAC.260, 27-Jan-77 15:50:57, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.259, 24-Jan-77 21:22:17, EDIT BY BOSACK
;CHANGE MDDDIR CALLING SEQUENCE TO REQUIRE FULLWORD DIR NUMBER
;<3-MONITOR>DIRECT.MAC.258, 21-Jan-77 17:55:05, EDIT BY BOSACK
;ADD SUPERIOR DIRECTORY FIELD TO IDXTAB
;<3-MONITOR>DIRECT.MAC.257, 20-Jan-77 22:14:43, EDIT BY HURLEY
;MAKE ALPHA-NUMERIC ACCOUNTS LEGAL FOR EVERYBODY
;<3-MONITOR>DIRECT.MAC.256, 20-Jan-77 14:45:13, EDIT BY HURLEY
;PROPERLY INITIALIZE THE FREE BIT TABLE WHEN DIR IS GREATER THAN 36
;<3-MONITOR>DIRECT.MAC.255,  7-Jan-77 18:40:54, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.254,  5-Jan-77 14:34:15, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.253,  3-Jan-77 13:11:45, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.252, 27-Dec-76 17:31:22, EDIT BY HURLEY
;<3-MONITOR>DIRECT.MAC.251, 22-Dec-76 11:58:32, EDIT BY HURLEY
;TCO 1687 - FIX OVER RELOCATION OF FDB ADR AT NEWNA1
;<3-MONITOR>DIRECT.MAC.250, 19-Dec-76 17:36:59, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.249, 16-Dec-76 16:48:55, Edit by HESS
;TCO 1685 - FIX TO FDBINU TO UNLOCK DIRECTORY
;<3-MONITOR>DIRECT.MAC.248, 10-Dec-76 03:22:08, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.247,  9-Dec-76 03:44:12, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.246,  9-Dec-76 00:36:21, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.245,  8-Dec-76 21:16:57, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.244,  8-Dec-76 17:54:22, EDIT BY HURLEY
;TCO 1646 - FIX VERLK6 TO WORK WHEN SYMBOL TABLE IS MOVED
;<3-MONITOR>DIRECT.MAC.243,  5-Dec-76 02:18:50, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.242,  4-Dec-76 17:02:40, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.241,  4-Dec-76 02:56:18, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.240,  2-Dec-76 03:26:21, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.239, 28-Nov-76 12:44:53, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.238, 26-Nov-76 17:21:38, Edit by MCLEAN
;<3-MONITOR>DIRECT.MAC.237, 26-Nov-76 17:17:14, Edit by MCLEAN
;TCO 1669 EXTENDED ADDRESSING
;<2-MONITOR>DIRECT.MAC.236, 24-Nov-76 15:11:40, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.235, 16-Nov-76 17:45:57, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.234, 15-Nov-76 17:05:33, Edit by HESS
;FIX FDB INITIATION OF OLD V.0 FDB'S
;<2-MONITOR>DIRECT.MAC.233, 11-Nov-76 16:59:11, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.232,  8-Nov-76 17:00:06, EDIT BY HURLEY
;ADDED SIXBIT STRUCTURE NAME TO EACH BUG CHECK ADDITIONAL DATUM
;<2-MONITOR>DIRECT.MAC.231, 29-Oct-76 18:15:56, EDIT BY MILLER
;FIX ACCCHK TO CHECK FOR CONNECTED DIR IF NOT ACCESSED
;<2-MONITOR>DIRECT.MAC.230, 23-Oct-76 16:41:56, EDIT BY HALL
;IN CHKBAK, REMOVED CHECK OF DSKALK
;<2-MONITOR>DIRECT.MAC.229, 18-Oct-76 19:11:04, EDIT BY HURLEY
;INITIALIZE IDXTAB TO 0'S DURING SYSTEM STARTUP
;<2-MONITOR>DIRECT.MAC.228, 13-Oct-76 15:58:47, EDIT BY HURLEY
;FIX ACCES TO ALLOW OWNERSHIP ACCESS TO ACCESSED DIRECTORY
;<2-MONITOR>DIRECT.MAC.227, 12-Oct-76 15:42:53, EDIT BY HURLEY
;MAKE MDDDIR MAP THE CORRECT IDXTAB BEFORE USING IT
;<2-MONITOR>DIRECT.MAC.226, 11-Oct-76 13:24:34, EDIT BY MILLER
;TCO 1584 AGAIN. USE STKVAR TO HOLD FKSTAT TEST
;<2-MONITOR>DIRECT.MAC.225, 11-Oct-76 12:52:45, EDIT BY MILLER
;TCO 1584. CHANGE ULKDI1 TO PICK UP FKSTAT RACE-FREE
;<2-MONITOR>DIRECT.MAC.224, 11-Oct-76 10:29:44, EDIT BY KIRSCHEN
;make mapidx always succeed if index table file ofn not yet set up
;<2-MONITOR>DIRECT.MAC.223,  8-Oct-76 17:41:43, EDIT BY KIRSCHEN
;<2-MONITOR>DIRECT.MAC.222,  8-Oct-76 11:15:47, EDIT BY KIRSCHEN
;DO NOT TOUCH DIRECTORY POSSIBLY ON DISMOUNTED STR IN SETDIR
;<2-MONITOR>DIRECT.MAC.221,  7-Oct-76 16:30:06, EDIT BY KIRSCHEN
;FIX CONFLICT IN CHKBAK WITH STKVAR STRNUM
;<2-MONITOR>DIRECT.MAC.220,  7-Oct-76 15:16:44, EDIT BY KIRSCHEN
;NO LONGER CALL UNMIDX FROM UNMAPD
;<2-MONITOR>DIRECT.MAC.219,  4-Oct-76 12:13:06, EDIT BY HALL
;BUG FIX IN DIRCHK (C WAS CLOBBERED BY FNDSTO)
;<2-MONITOR>DIRECT.MAC.218,  4-Oct-76 11:24:21, EDIT BY KIRSCHEN
;<2-MONITOR>DIRECT.MAC.217, 30-Sep-76 13:09:11, EDIT BY KIRSCHEN
;FIX TYPO IN MAPIDX - STORE STRUCTURE NUMBER BEFORE DOING ANYTHING ELSE
;<2-MONITOR>DIRECT.MAC.216, 29-Sep-76 15:15:36, EDIT BY KIRSCHEN
;MAKE SETDIR AND GDIRST CHECK UNIQUE CODE; STORE UNIQUE CODE IN MAPIDX
;<2-MONITOR>DIRECT.MAC.215, 29-Sep-76 14:12:56, EDIT BY HALL
;MORE DIRCHK EDITS
;<2-MONITOR>DIRECT.MAC.214, 29-Sep-76 13:49:32, EDIT BY HALL
;CHANGED DIRCHK AND CHKGRP TO USE STRUCTURE UNIQUE CODES
;<2-MONITOR>DIRECT.MAC.213, 27-Sep-76 11:00:19, Edit by HESS
;CLEAR BLOCK VERSION # IN ASGDFR & RELDFA
;<2-MONITOR>DIRECT.MAC.212, 21-Sep-76 13:13:36, EDIT BY HURLEY
;TCO 1532 - MAKE RECOGNITION NOT FIND FILES WITHOUT LIST ACCESS
;<2-MONITOR>DIRECT.MAC.211, 14-Sep-76 18:09:34, EDIT BY HURLEY
;TCO # 1526 - FIX OVER POPPING OF STACK WHEN DIRECTORY IS FULL
;<2-MONITOR>DIRECT.MAC.210,  9-Sep-76 10:34:49, Edit by HESS
;<2-MONITOR>DIRECT.MAC.209,  1-Sep-76 14:25:28, Edit by HESS
;TCO 1506 - ADD STR NUMBER TO LDTAB
;<2-MONITOR>DIRECT.MAC.208, 31-Aug-76 12:12:04, Edit by HESS
;TCO 1496 - ADD AUTHOR/LAST-WRITER STRINGS TO FDB
;<2-MONITOR>DIRECT.MAC.207, 24-Aug-76 15:25:01, EDIT BY KIRSCHEN
;MAKE SETMSB GLOBAL
;<2-MONITOR>DIRECT.MAC.206, 17-Aug-76 16:37:43, EDIT BY HURLEY
;REMOVED CALL TO UPDDIR IN INSACT FOR PERFORMANCE IMPROVEMENT
;<2-MONITOR>DIRECT.MAC.205, 11-Aug-76 12:13:06, EDIT BY HURLEY
;MAKE GDIRST TRANSLATE USER NUMBERS TO DIR NUMBERS
;<2-MONITOR>DIRECT.MAC.204,  8-Aug-76 19:39:18, EDIT BY KIRSCHEN
;FIX DIRLUK BUG IN CHECKING WHETHER OF NOT TO USE SPECIAL DIR TABLE
;<2-MONITOR>DIRECT.MAC.203,  5-Aug-76 19:02:48, EDIT BY HALL
;FIXED DIRCHK TO LOAD T1 BEFORE CALLING CHKGRP
;<2-MONITOR>DIRECT.MAC.202,  4-Aug-76 17:07:48, EDIT BY HALL
;FIXED CALLS TO DIRCHK TO USE NEW ACCESS BITS
;<2-MONITOR>DIRECT.MAC.201,  4-Aug-76 16:54:26, EDIT BY HALL
;CHANGES TO DIRCHK AND ACCCHK TO GET STRUCTURE OUT OF CURSTR
;AND CHECK FOR 'ACCESSED' DIRECTORY
;<2-MONITOR>DIRECT.MAC.200,  4-Aug-76 14:13:09, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.199,  3-Aug-76 22:22:15, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.198,  3-Aug-76 20:46:11, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.197,  3-Aug-76 20:43:01, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.196,  3-Aug-76 20:19:48, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.195,  3-Aug-76 20:07:14, EDIT BY HURLEY
;<2-MONITOR>DIRECT.MAC.194,  3-Aug-76 20:03:24, EDIT BY HURLEY
;EXPAND DIRECTORY NUMBERS TO 36 BITS
;<HESS>DIRECT.MAC.1, 28-Jul-76 15:29:12, Edit by HESS
;TCO 1478 - QUOTA CHECKING
;<2-MONITOR>DIRECT.MAC.192,  2-Aug-76 09:21:56, EDIT BY KIRSCHEN
;MAKE GETNDN ACCEPTS A RUCTURE NUMBER
;<2-MONITOR>DIRECT.MAC.191,  1-Aug-76 18:31:06, EDIT BY HALL
;CHANGES TO DIRCHK TO HANDLE NEW STORAGE OF GROUPS IN THE JSB
;(ALSO FOR VERSION 190)
;<2-MONITOR>DIRECT.MAC.189, 30-Jul-76 09:39:25, EDIT BY KIRSCHEN
;MAKE DIRLUK RETURN ROOTDN IF CREATING ROOT-DIRECTORY
;<2-MONITOR>DIRECT.MAC.188, 28-Jul-76 19:15:28, EDIT BY MILLER
;DON'T BELIEVE SPECIAL DIR TABLE UNLESS LOOKUP IS ON PS
;<2-MONITOR>DIRECT.MAC.187, 25-Jul-76 13:05:32, EDIT BY HALL
;FIXED CHANGED IN DIRCHK
;<2-MONITOR>DIRECT.MAC.186, 24-Jul-76 14:12:31, EDIT BY HALL
;IN DIRCHK CHANGED REFERENCE TO JOBDNO FOR CONNECTED DIRECTORY TO CAL
;TO GTCSNO
;<1B-MONITOR>DIRECT.MAC.183, 11-JUN-76 11:58:49, EDIT BY HALL
;TCO 1388 - ALLOW DELETING OF SICK  DIRECTORIES
;<1B-MONITOR>DIRECT.MAC.182,  9-JUN-76 15:05:59, EDIT BY HURLEY
;TCO 1376 - GIVE FAIL RETURN IF OLD FILE WANTED BUT FILE IS NXF
;<2-MONITOR>DIRECT.MAC.14, 20-MAY-76 10:19:45, EDIT BY KIRSCHEN
;CHANGE TRIPLE SKIP RETURN FROM DIRLUK TO BE STANDARD FAIL/SUCCESS RETURN
;<2-MONITOR>DIRECT.MAC.13, 19-MAY-76 10:10:43, EDIT BY KIRSCHEN
;CHANGE CALL TO DIRLUK TO TAKE STRUCTURE # AND POINTER INSTEAD OF FILOPT
;<2-MONITOR>DIRECT.MAC.12, 14-MAY-76 09:15:11, EDIT BY KIRSCHEN
;REMOVE REFERENCES TO LSTDRN (REFER TO SDB INSTEAD)
;<2-MONITOR>DIRECT.MAC.11, 13-MAY-76 09:40:15, EDIT BY KIRSCHEN
;REMOVE REFERENCES TO DIDSCB
;<2-MONITOR>DIRECT.MAC.10, 11-MAY-76 12:47:45, EDIT BY KIRSCHEN
;REMOVE ASSUMPTION OF STR 0 FROM SETDIR. ADD TEMP CHECK OF STR # IN MAPDIR
;<2-MONITOR>DIRECT.MAC.9, 11-MAY-76 12:33:55, EDIT BY KIRSCHEN
;ADD STR # TO ALL CALLS TO SETDIR FROM DIRECT
;REMOVE TEMP STR 0 FROM MAPDIR;  MAKE SETDIR CHECK BOTH DIR # AND STR #
;<2-MONITOR>DIRECT.MAC.8, 10-MAY-76 10:56:00, EDIT BY KIRSCHEN
;ADD STRUCTURE # TO SETDRR, SET UP STR # IN CALLS TO SETDRR IN MDDDIR
;<2-MONITOR>DIRECT.MAC.7,  8-MAY-76 13:41:01, EDIT BY HALL
;MADE CHKBAK ACCEPT A STRUCTURE NUMBER AND PASS IT TO CPYBAK AND ASOFN
;<2-MONITOR>DIRECT.MAC.6,  7-MAY-76 14:42:21, EDIT BY KIRSCHEN
;ADD CODE TO OBTAIN ROOT-DIR OFN FROM SDB (FROM FIELD STRRDO)
;<2-MONITOR>DIRECT.MAC.5,  3-MAY-76 22:40:46, EDIT BY KIRSCHEN
;<1KIRSCHEN>DIRECT.MAC.4,  3-MAY-76 09:08:14, EDIT BY KIRSCHEN
;MOVE CALL TO MAPIDX FROM SETDIR TO MAPDIR; CLEAR IDXFLG IN UNMIDX
;<2-MONITOR>DIRECT.MAC.3, 26-APR-76 10:29:15, EDIT BY KIRSCHEN
;ADD CALLS TO MAPIDX AND UNMIDX
;<2-MONITOR>DIRECT.MAC.3, 22-APR-76 10:46:22, EDIT BY KIRSCHEN
;<2-MONITOR>DIRECT.MAC.2, 22-APR-76 10:37:41, EDIT BY KIRSCHEN
;ADD MAPIDX, UNMIDX ROUTINES
;<2-MONITOR>DIRECT.MAC.1, 18-APR-76 17:59:45, EDIT BY MILLER
;<1A-MONITOR>DIRECT.MAC.181,  1-APR-76 14:11:18, EDIT BY HURLEY
;<1A-MONITOR>DIRECT.MAC.180,  1-APR-76 13:55:37, EDIT BY HURLEY
;TCO # 1230 - FIX SPELLING ERRORS IN BUGCHK MESSAGES
;<1MONITOR>DIRECT.MAC.179,  2-MAR-76 18:50:20, EDIT BY HURLEY
;<1MONITOR>DIRECT.MAC.178,  2-MAR-76 13:12:00, EDIT BY HURLEY
;TCO #1141 - DONT ALLOW BACK-UP-COPY-OF-ROOT-DIR TO BE SEEN BY GTJFN
;<1MONITOR>DIRECT.MAC.177, 26-FEB-76 19:44:59, EDIT BY MILLER
;TCO 1120. FIX WILD CARD IR SEARCHES
;<2MONITOR>DIRECT.MAC.176, 30-JAN-76 12:42:07, EDIT BY HURLEY
;MCO 44 - UNMAP DIRECTORIES BEFORE KILLING A FORK
;<2MONITOR>DIRECT.MAC.175, 16-JAN-76 17:43:02, EDIT BY MURPHY
;<2MONITOR>DIRECT.MAC.174, 23-DEC-75 18:11:53, EDIT BY HURLEY





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

	SEARCH PROLOG
	TTITLE DIRECT
	SWAPCD

;SPECIAL AC DEFINITIONS

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

INTERN NSDIR0

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

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

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

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

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

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

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

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

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

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

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

;INITIALLY ASSUME OWNER+GROUP+WORLD ACCESS RIGHTS

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

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

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

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

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

;IF TRYING TO ACCESS CONNECTED DIRECTORY, HAVE OWNERSHIP ACCESS

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

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

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

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

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

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

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


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

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

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

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

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

;CALL SUPCHK

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

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

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

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

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

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

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

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

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

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

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

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

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

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

DSLUK:	IDIVI B,5		;GET NUMBER OF WORDS IN STRING
	MOVEI C,.ETNAM		;DIRS ARE ENTRY TYPE NAME
	CALL LOOKUP		;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		; ...
	MOVE D,DIRORA		;GET DIR BASE
	LOAD C,FBNAM,(B)	;GET NAME STRING POINTER
	ADDI C,1		;SKIP STRING BLOCK HEADER
	HRLI 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
; Directory number to string conversion
; Call:	A	; The directory number
;	CALL GDIRST
; Return
;	+1	; Error, no such directory number
;	+2	; Ok, in a, pointer to string block holding the name
; The directory AND STR ARE locked upon exit, and must be unlocked
; After the string is used
; Clobbers a,b,c,d

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

GDRST2:	MOVE A,GDRSTR		;GET STR NUMBER TO MAP IDXTAB
	CALL MAPIDX		;MAP INDEX
	 JRST GDRST7		;FAILED - UNLOCK STR AND ERROR
GDRST3:	MOVE A,GDRSTN		;GET DIR NUMBER
	CALL GETIDX		;GET INDEX INFORMATION IN A - C
	 JRST GDRST7		;FAILED
	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
	ADD A,DIRORA		;GET ABS ADR OF FDB
	CALL FDBCHK		;MAKE SURE FDB IS GOOD
	 RETBAD (,<CALL USTDIR>)	;IT ISNT
	LOAD A,FBNAM,(A)	;GET POINTER TO NAME STRING
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	RETSKP			;RETURN WITH DIR LOCKED AND ADR IN A

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

DELDL6:	LOAD P3,FBEXL,(P3)	;STEP TO NEXT EXT
	CALL DELFIL		;DELETE THE FDB IN D
	 CALL [	TXNN F,1B17	;IF EXPUNGING ALL, GIVE ERROR
		CAIE T1,DELFX2	;EXPECTED FAILURE IF FILE OPENED
		MOVE Q1,A	;NO, THEN REMEMBER FAILURE
		RET]
	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,<DELDL8: DIRECTORY SYMBOL TABLE FOULED UP FOR DIRECTORY:>,<A,B>)
DELDL9:	MOVEI A,DELFX6		;DIR FORMAT IS SCREWED UP
	CALLRET USTDIR		;UNLOCK THE DIR AND RETURN
;ROUTINE TO SEE IF A FILE SHOULD BE DELETED
;ACCEPTS IN A/	FDB ADDRESS
;	CALL DELTST
;RETURNS +1:	DO NOT DELETE THE FILE
;	 +2:	DELETE THIS FILE

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

FDBINI:	LOAD C,FBLEN,(A)	;GET THE LENGTH OF THE FDB
	MOVSI B,0(A)		;ZERO THE FDB AREA
	HRRI B,1(A)		;SET UP BLT POINTER
	SETZM 0(A)		;ZERO FIRST WORD
	BLT B,.FBLEN-1(A)	;Clear the entire 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)	;...
	RET

;ENTRY TO INIT FIELDS NOT COPIED FROM PREVIOUS VERSIONS

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

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

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

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


SETDI4:	HRRZ A,SETDIN		;GET DIR NUMBER (RH ONLY)
	BUG(CHK,DIRBAD,<SETDI4: SMASHED DIRECTORY NUMBER:>,<A,SETDNM>)
	OKINT
	RETBAD (DELFX6)

SETDI5:	HRRZ B,SETDIN		;GET STR RELATIVE DIR NUMBER
	SKIPE A			;NONX PAGE?
	BUG(CHK,DIRFKP,<SETDIR-DIR PAGE 0 BELONGS TO FORK IN DIRECTORY:>,<B,SETDNM>)
	JRST SETDI1
;ROUTINE TO INITIALIZE THE FREE BIT TABLE IF NECESSARY

;	CALL FBTINI
;RETURNS +1:	ALWAYS

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

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

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

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

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

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

; Unlock directory

USTDIR::SE1CAL
	ULKDIR			;UNLOCK THE DIRECTORY
	OKINT
	RET

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

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

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

;STORAGE IN STG.MAC

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

;STORAGE

NLDTAB==:20			;LENGTH OF LOCK TABLE

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

;FLAGS IN LDTAB

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

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

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

LCKDNM::SE1CAL
	SAVEQ
	STKVAR <LCKSV>
LCKDI0:	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,<ATTEMPT TO LOCK DIRECTORY TWICE FOR SAME FORK>)
	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
	HRRI T1,LKDTST		;ROUTINE FOR SCHEDULER
	MDISMS			;BLOCK UNTIL DIR UNLOCKED
LCKDI1:	HRRZ T1,LCKSV		;RESTORE ARGS (DIRECTORY NUMBER)
	HLRZ T2,LCKSV		; STRUCTURE NUMBER
	JRST LCKDI0		;TRY AGAIN

;ASSIGN NEW ENTRY FOR DIR NUM

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

;TABLE FULL (SHOULD HAPPEN VERY RARELY)

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

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

ULKDI7:	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRDNL,<ULKDIR-DIRECTORY NOT LOCKED, DIRECTORY NUMBER:>,<T1,T2>)
	UNLOCK LDTLCK
	RET
;OTHER FORK(S) WAITING FOR DIR JUST UNLOCKED - TRY TO FIND ONE
;AND WAKE IT UP.

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

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

MAPDIR::SE1CAL
	STKVAR <MAPDIN,MAPDIS>
	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 #
	CAML A,MXDIRN		;IS THIS A LEGAL DIR #?
	RETBAD (DIRX1)		;NO, GIVE ERROR RETURN
	JUMPLE A,[RETBAD (DIRX1)] ;ZERO OR NEGATIVE IS FATAL
	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 MAPDI0]	;SKIP DOING AN ASOFN FOR ROOT DIR
	CALL GETIDX		;GET ADDRESS OF INDEX BLOCK FOR DIR
	 RETBAD			;NOT A DEFINED DIRECTORY
	TXNE D,IDX%IV		;INVALID?
	RETBAD (DIRX3)		;YES, FAIL
	MOVE A,B		;GET ADDRESS OF INDEX BLOCK
	TXO A,FILWB+THAWB+OFNDUD ;WRITE, THAWED, AND NO AUTO-UPDATE
	MOVE B,MAPDIS		;GET STRUCTURE NUMBER
	CALL ASROFN		;ASSIGN AN OFN FOR THIS FILE
	 RETBAD ()		;ERROR, NONE AVAILABLE
	SETONE DRROF		;INDICATE UNMADP SHOULD RELEASE OFN
MAPDI0:	STOR A,DIROFN		;SAVE THIS OFN
	SKIPE EXADDR		;CHECK FOR EXTENDED ADDRESSING
	JRST [	CALL MAPDRP	;MAP DIRECTORY PAGE
		JRST MAPDI1]
	HRLZS A			;SET UP OFN.PN
	MOVX B,PTRW+PM%IND	;READ WRITE ACCESS, INDIRECT PTRS
	IOR B,DIRORA		;ADD IN BASE ADDRESS FOR MAPPING INTO
	MOVE C,NDIRPG		;GET # OF PAGES IN DIRECTORY
	CALL MSETMP		;MAP IN THE DIR
MAPDI1:	MOVE A,MAPDIN		;RESTORE DIRECTORY NUMBER

BP$022:				;BREAKPOINT FOR ASOFN FOR DIRECTORIES
				;ASSUMES T1 HAS DIRECTORY# AND OFN IS
				;IN DIROFN USUALLY, IN RDOFN IF T1=ROOTDN
	RETSKP			;AND EXIT
;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
	CALLRET MONCLA		;CLEAR HARDWARE PAGE TABLE AND RETURN



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

UNMAPD::SE1CAL
	SKIPE EXADDR		;CHECK FOR EXTENDED ADDRESSING (SEC2)
	JRST [	SETZM DRMAP	;CLEAR MAP SHARE POINTER
		CALL MONCLA	;CLEAR HARDWARE PAGE TABLE
		JRST UNMAP1]	;AND CONTINUE
	MOVEI A,0		;CLEAR OUT PREVIOUS DIRECTORY PAGES
	MOVE B,DIRORA		;GET STARTING ADDRESS OF MAPPED DIR
	MOVE C,NDIRPG		;GET NUMBER OF PAGES IN DIR
	CALL MSETMP		;UNMAP THE OLD PAGES (IF ANY)
UNMAP1:	LOAD A,DIROFN		;GET THE LAST OFN
	JUMPE A,R		;IF NONE, RETURN NOW
	JE DRROF,,R		;IF NOT RELEASING OFN, RETURN
	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)
;	C	;ADR OF BLOCK CONTAINING A WILD MASK (OR 0 IF NONE)
;	CALL MDDDIR
; Returns
;	+1	; Not used here, means non-directory device
;	+2	; No such directory
;	+3	; Ok, the directory is mapped and locked

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

MDDDIR::SE1CAL
	AOS 0(P)		;ALWAYS SKIPS AT LEAST ONCE
	SAVEQ
	STKVAR <MDDDNO,MDDDWS,MDDDPT,<MDDDNM,MAXLW>> 
	MOVEM T1,MDDDNO		;SAVE ARGUMENT
	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
	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
	CALL SETDRR		;TRY TO MAP IT
	 JRST MDDDI2		;COULDNT - TRY REST OF TREE
	JRST MDDDRT		;SUCCESS
MDDDI2:	MOVE T1,MDDDNO		;GET CURRENT DIR
	CALL SETDIR		;MAP IT
	 JRST MDDERT		;ERROR - RETURN CODE IN T1
	MOVE T1,DIRORA		;GET DIR ORIGIN
	LOAD T1,DRSDC,(T1)	;GET COUNT OF SUBDIRECTORIES
	JUMPN T1,MDDDI8		;IF ANY EXIST, FIND ONE TO RETURN
MDDDI3:	CALL USTDIR		;NO SUBDIRECTORIES - FREE THIS ONE
MDDDI4:	HRRZ T1,MDDDNO		;ARE WE BACK UP TO THE ROOT?
	CAIN T1,ROOTDN		; ???
	ERRJMP (GJFX32,MDDERT)	;YES - GIVE NO MORE DIRECTORIES RETURN
	LSH T1,1		;NO - GET FDB AND SUPERIOR
	ADD T1,IDXORA		; ...
	LOAD Q1,IDXFB,(T1)	;GET FDB OF CURRENT DIR
	ADD Q1,DIRORA		;AS ABSOLUTE ADDRESS
	LOAD T1,IDXSD,(T1)	;GET SUPERIOR
	HLL T1,MDDDNO		;BUILD FULLWORD DIR NUMBER
	MOVEM T1,MDDDNO		;SAVE AS SOON TO BE CURRENT DIR
	CALL SETDIR		;MAP SUPERIOR
	 JRST MDDERT		;ERROR - RETURN CODE IN T1
	MOVE T4,DIRORA		;COPY DIR NAME TO MDDDNM
	LOAD T4,DRNAM,(T4)	;GET POINTER TO NAME STRING IN DIR
	ADD T4,DIRORA		;GET ABS ADR
	MOVSI T3,(POINT 7,(T4),35) ;T3 IS POINTER TO NAME STRING
	MOVEI T2,MDDDNM		;GET ADR OF STRING BLOCK
	HRLI T2,(POINT 7,0)	;SET UP BYTE POINTER
	HRRZ T1,MDDDNO		;GET DIR NUMBER OF DIRECTORY
	CAIN T1,ROOTDN		;IS THIS THE ROOT DIRECTORY
	JRST MDDI4B		;YES, DONT PUT ITS NAME IN THE STRING
MDDI4A:	ILDB T1,T3		;COPY NAME TO MDDDNM STRING
	JUMPE T1,MDDI4B		;DONT COPY THE NULL
	IDPB T1,T2		;PUT CHAR IN STRING
	JRST MDDI4A		;LOOP BACK FOR REST OF THE STRING

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

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

MDDI8B:	MOVEM T2,MDDDPT		;SAVE POINTER TO END OF STRING
	MOVE Q1,DIRORA		;GET BOTTOM OF
	LOAD Q1,DRSBT,(Q1)	;SYMBOL TABLE
	ADD Q1,DIRORA		;AS AN ABSOLUTE ADDRESS
	ADDI Q1,.SYMLN		;SKIP HEADER ENTRY
MDDDI9:	LOAD Q2,SYMAD,(Q1)	;GET FDB FOR THIS SYMTAB ENTRY
	ADD Q2,DIRORA		;ABSOLUTE ADDRESS
MDDDIA:	MOVE Q3,Q2		;START GENERATION SEARCH HERE
MDDDIB:	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
	LOAD Q2,FBEXL,(Q2)	;NO - TRY NEXT EXTENSION
	ADD Q2,DIRORA		;ABSOLUTE ADDRESS
	CAME Q2,DIRORA		;YET ANOTHER EXTENSION?
	JRST MDDDIA		;YES
	ADDI Q1,.SYMLN		;NO - TRY NEXT SYMTAB ENTRY
	MOVE T1,DIRORA		;CHECK IF
	LOAD T1,DRSTP,(T1)	;PAST THE END
	ADD T1,DIRORA		;OF THE SYMBOL TABLE
	CAML Q1,T1		; ???
	 JRST MDDDI3		;YES - NO MORE SUBDIRS OF THIS DIR
	LOAD T1,SYMET,(Q1)	;STILL WITHIN BOUND,
	CAIE T1,.ETNAM		;STILL IN NAME PORTION OF SYMTAB?
	JRST MDDDI3		;NO - HENCE UP A LEVEL
	JRST MDDDI9		;YES - EXAMINE THESE FILES
;HERE WHEN A FDB WITH FB%DIR IS FOUND. SEE IF IT CAN BE RETURNED.

MDDDID:	LOAD T1,FBDRN,(Q3)	;GET DIR NUMBER OF POSSIBLE SUBDIR
	JUMPE T1,MDDDIC		;IF NONE, KEEP LOOKING
	MOVE T2,T1		;GET IDXTAB ENTRY
	LSH T2,1		; ...
	ADD T2,IDXORA		; ...
	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
	CALL SETDRR		; ...
	 JRST MDDDI4		;COULDNT
	JRST MDDDRT		;ALL OK, RETURN THIS DIR

;HERE WHEN IDXTAB DOES NOT HAVE A CORRECT BACK POINTER

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



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

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

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

MDDNA1:	MOVE A,DIRORA		;GET DIR NUMBER
	LOAD A,DRNUM,(A)	; FOR SYSERR BLOCK
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRSY2,<MDDNAM: SYMBOL TABLE FOULED UP IN DIRECTORY:>,<A,B>)
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
		JRST ERRET]	;THIS ALLOWS LOGICAL NAME TO BE STEPPED
NAMLK1:	TQNE <UNLKF>
	JRST SK2RET		;Do not unlock directory
	CALL USTDIR
	JRST SK2RET

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

NAMFND:	TQNE <NREC,NREC1>	;Is recognition being performed
	JRST NEWNAM		;No. try to insert a new name
	MOVEI A,GJFX18
	TQNE <AMBGF>		;Ambiguous?
	JRST AMBRET		;Yes
	TQNN <MTCHF>		;Yes, did at least one string match?
	JRST ERRET		;Error return, no match possible
	MOVE B,DRLOC		;GET POINTER TO THIS SYMBOL
	ADDI B,.SYMLN		;Point b to following entry
	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		;TREAT LIKE NOT AMBIGUOUS
	CALL NAMCMM		;Compare strings
	 JUMPN A,UNIQUE		;IF NOT SUBSET, GO TO UNIQUE
	MOVEI A,GJFX18
	JRST AMBRET		;SUBSET IS AMBIGUOUS

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

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

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

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

MDDEXB:	MOVEI A,GJFX36		;SMASHED DIR
	JRST ERRET
EXTLKL:	MOVE B,DRSCN		;Exact match. get loc of pointer
	LOAD A,DIRLA,(B)	;GET FDB ADR OF EXTENSION
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	JRST NAMLKM		;Double skip return & unlock directory

EXTSUB:	TQNE <NREC,NREC1>	;DOING RECOGNITION?
	JRST EXTNEQ		;NO
	MOVE B,DRSCN
	MOVEM B,DRLOC		;Save location of pointer to match fdb
	TQOE <MTCHF>		;Set mtchf, was it already set?
	JRST [	MOVEI A,GJFX19
		JRST AMBRET]	;Yes,  ambiguous return
EXTNEQ:	JUMPL A,EXTFND		;GONE TOO FAR IN CHAIN?
	TQNE <NREC,NREC1>	;NO, DOING RECOGNITION?
	JUMPE A,EXTFND		;NO, STOP AT FIRST SUBSET
	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>
	JRST ERRET
	MOVE B,DRLOC
	LOAD C,DIRLA,(B)	;GET FDB ADDRESS
	ADD C,DIRORA		;MAKE IT ABSOLUTE
	MOVE A,C		;SEE IF THERE IS A NON-DELETED VERSION
	CALL EXTSCN		;WITH THIS NAME AND EXTENSION
	 JRST [	MOVEI A,GJFX19	;NO, DONT FIND THIS EXTENSION
		JRST ERRET]	;THE SEARCH LIST CAN THUS BE STEPPED
	LOAD D,FBEXT,(C)	;GET ADDRESS OF EXTENSION STRING
	ADD D,DIRORA		;MAKE IT ABSOLUTE
	JRST UNIQU1		;And copy tail to input
NEWEX1:	MOVEI A,GJFX24
	TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
	TQNE <OLDNF>		;Are new files allowed?
	JRST NEWEX3
	MOVX B,DC%CF		;CREATE-FILE ACCESS
	CALL DIRCHK		;CHECK FOR ABILITY TO CREATE FILES
	JRST [	MOVEI A,GJFX35
		JRST ERRET]
	MOVEI B,.FBLEN
	CALL ASGDFR		;Get space for new fdb
	JRST [	MOVEI A,GJFX23
		JRST ERRET]
	CALL FDBINI		;Initialize the fdb
	MOVE B,DRLOC		;GET POINTER TO NEXT FDB
	LOAD B,DIRLA,(B)	;GET FDB ADR
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	EXCH A,B		;CHECK THIS FDB
	CALL FDBCHK		;TO AVOID PICKING UP GARBAGE
	 JRST [	MOVEI A,GJFX36	;DIR BAD
		JRST ERRET]	;BOMB OUT
	LOAD C,FBNAM,(A)	;GET POINTER TO NAME STRING
	STOR C,FBNAM,(B)	;MAKE NEW FDB POINT TO NAME STRING TOO
	PUSH P,B		;Save fdb location
	CALL CPYDIR		;Copy extension string to directory
	 JRST [	POP P,B		;NO ROOM TO PUT STRING INTO DIR
		CALL RELDFA	;RELEASE FDB STORAGE
		MOVEI A,GJFX23
		JRST ERRET]	;BOMB OUT WITH NO ROOM ERROR
	MOVEI C,.TYEXT
	STOR C,EXTYP,(A)	;MarK as string block for extension
	EXCH A,0(P)		;SAVE EXT STRING ADR AND GET FDB ADR
	MOVE B,DRSCN		;Location of last extension pointer
	LOAD C,DIRLA,(B)	;GET FDB ADR POINTED TO BY LAST EXT
	EXCH A,C		;CHECK THIS FDB ADR
	CALL FDBCHR
	 JRST [	MOVEI A,GJFX36	;DIR IS SCREWED UP
		JRST ERRET]
	EXCH A,C
	STOR C,FBEXL,(A)	;MAKE NEW FDB POINT DOWN THE CHAIN
	SUB A,DIRORA		;GET RELATIVE ADR OF NEW FDB
	CALL EFIXUP		;GO SET UP POINTERS TO NEW EXT
	CALL SETNXF		;GO SET NONXF IN STS AND FILSTS
	POP P,A
	JRST NEWEX2

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

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


;ROUTINE TO SCAN A FDB CHAIN LOOKING FOR A FILE THAT IS NOT DELETED
;ACCEPTS IN A/	ABSOLUT FDB ADR
;	CALL NAMSCN
;RETURNS +1:	NO NON-DELETED FILE FOUND
;	 +2:	THERE IS AT LEAST ONE NON-DELETED FILE WITH THIS NAME

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


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

EXTSCN:	TQNN <OLDNF>		;OLD FILE ONLY?
	RETSKP			;NO, ALLOW CREATING OF NEW NAMES
	SAVET			;CLOBBERS NO ACS
EXTSC1:	JN FBNXF,(A),EXTSC2	;IF NON-EXISTANT, STEP TO NEXT FDB
	TQNE <IGDLF>		;IF IGNORING DELETED BIT,
	RETSKP			;  THEN GIVE OK RETURN
	JE FBDEL,(A),RSKP	 ;IF FILE NOT DELETED AND EXISTS, RSKP
EXTSC2:	SKIPN A,.FBGNL(A)	;AT END OF CHAIN YET?
	RET			;YES, RETURN UNSUCCESSFUL
	ADD A,DIRORA		;GET ABS ADR OF FDB
	JRST EXTSC1		;LOOP BACK FOR NEXT VERSION IN CHAIN
; Multiple directory device version lookup routine
; Call:	A	; Desired version
;	B	; STARTING POINTER
;	DIRORG-	; The appropriate directory locked and psi off
;	JRST MDDVER
; Return
;	+1	; Version not found
;	+2	; Success version in a if unlkf=1
;		; Fdb address in a if unlkf=0
;		; FDB ADR IN B ALWAYS

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

VERLK0:	EXCH D,A		;CHECK THIS FDB
	CALL FDBCHK
	 JRST MDDVRB		;FDB IS BAD
	EXCH D,A
VRLK0A:	MOVEM B,DRSCN		;Save scan pointer
	JUMPG A,VERLK1		;JUMP IF Specific version wanted
	CAMN A,[-2]		;OLDEST VERSION WANTED?
	JRST VERLKC		;YES
	JUMPL A,VERLK2		;GO DO A NEW ONE THEN
	JN FBDEL,(D),<[TQNN <IGDLF> ;YES, USER WANTS 'IGNORE DELETED'?
		JRST VERLK1	;NO, GO TO NEXT VERSION
		JRST .+1]>	;YES, THIS VERSION POTENTIALLY OK
	JN FBNXF,(D),<[	TQNE <OLDNF> ;NO, USER REQUIRES OLD FILE?
		JRST VERLK1	;YES, GO TO NEXT VERSION
		JRST VERLK2]>	;NEW VERSION OK
	;..
	;..
VERLK3:	MOVE A,D		;Found
VERLK8:	TQNE <NEWVF,NEWF>	;NEW VERSION
	JRST VERLKB		;YES
	TQNE <NEWNF>		;NO NEW FILES
	JRST [	MOVEI A,GJFX27	;YES, GIVE ERROR RETURN
		JRST ERRET]
VERLKB:	TQNE <STEPF>		;STEPPING?
	TQNN <VERSF>		;YES, STEPPING VERSION?
	JRST VERLKE		;NO
	SKIPG DRINP		;HAVE A POINTER TO A VERSION?
	JRST VERLKE		;NO
	MOVEI A,GJFX20
	SKIPG MDDVRL		;ANY PREVIOUS VERSIONS SEEN
	JRST ERRET		;NO, END OF LIST
	MOVE A,MDDVRF		;GET POINTER TO FDB
	LOAD A,DIRLA,(A)	;GET ADR OF FDB
	ADD A,DIRORA		;MAKE IT ABSOLUTE
	CALL FDBCHK		;CHECK THE FDB
	 JRST MDDVRB		;FDB IS BAD
	TQNE <IGDLF>		;IGNORE DELETED FILES?
	JRST VERLKG		;NO
	JN FBDEL,(A),VERLKF	;SEE IF FILE IS DELETED
VERLKG:	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
;HERE IF NEW VERSION WANTED

VERLK2:	TQO <NEWVF>
	TQZ <NEWF>
	JN FBNXF,(D),[	MOVE A,D ;FILE IS NON-EXISTANT. USE IT
			CALL FDBIN0 ;UPDATE STUFF IN FDB
			SETZRO FBSIZ,(A)
			JRST VERLK8]
	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
	SETONE FBNXF,(A)	;MARK AS NON-EXISTENT
	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)
	SOSGE D,DRINP		;VERSION SPECIFIED?
	LOAD D,FBGEN,(C)	;NO, GET VERSION OF OLD HIGHEST FILE
	AOS D			;MAKE VERSION BE ONE HIGHER
	STOR D,FBGEN,(A)	;STORE NEW VERSION #
	MOVE B,DRSCN		;GET POINTER TO LIST
	LOAD D,DIRLA,(B)	;GET ADR OF NEXT FDB ON LIST
	EXCH A,D
	CALL FDBCHR		;MAKE SURE IT IS A VALID FDB ADR
	 JRST MDDVRB		;DIR IS BAD
	STOR A,FBGNL,(D)	;MAKE NEW FDB POINT DOWN THE LIST
	MOVEM D,MDDVRT		;SAVE FDB ADR
	SUB D,DIRORA		;GET RELATIVE ADR OF NEW FDB
	STOR D,DIRLA,(B)	;MAKE LIST POINT TO NEW FDB
	TQO <NEWVF>		;Remember we created a new version
	MOVE B,MDDVRA		;GET POINTER TO FIRST FDB IN CHAIN
	LOAD A,DIRLA,(B)	;GET FDB ADR
	CALL VFIXUP		;MAKE ALL PREVIOUS EXT'S POINT RIGHT
	MOVE A,MDDVRT		;GET BACK FDB ADR
	JRST VERLK8		;LEAVE FDB ADR IN A
VERLKC:	JN FBDEL,(D),<[TQNN IGDLF ;IGNORING DELETED FILES
		JRST VERLK1	;NO
		JRST VRLKC1]>	;YES, SEE IF FILE EXISTS
VRLKC1:	JN FBNXF,(D),VERLK1	;IF FILE DOESNT EXIST, USE THIS FDB
	MOVEM D,DRLOC		;Save FDB ADR for later
VERLK1:	LOAD C,FBGEN,(D)	;Get version number of this fdb
	CAMG C,A		;Below desired version?
	JRST VERLK5		;Yes, we have found where it belongs
	MOVE B,DRSCN		;GET POINTER TO NEXT FDB
	MOVEM B,MDDVRF		;SAVE LAST POINTER TO FDB
	LOAD B,DIRLA,(B)	;GET ADDRESS OF FDB
	ADD B,DIRORA		;MAKE IT ABSOLUTE
	ADDI B,.FBGNL		;MAKE IT POINT TO LINK TO NEXT GEN
	LOAD D,DIRLA,(B)	;GET ADR OF NEXT FDB
	JUMPN D,[ADD D,DIRORA	;IF ONE EXISTS, GET ITS ABSOLUTE ADR
		MOVEM C,MDDVRL	;UPDATE LAST VERSION NUMBER SEEN
		JRST VERLK0]
	JUMPE A,[MOVEI A,GJFX20	;WANT HIGHEST VERSION?
		TQNE <OLDNF>	;WANT OLD FILES
		JRST ERRET	;YES. HE GETS AN ERROR THEN
		SETO A,		;NO. ASK FOR NEXT HIGHEST
		MOVE B,MDDVRA	;GET BACK STARTING FDB ADDRESS
		JRST MDDVR1]	;AND GO CREATE A NEW FILE
	CAMN A,[-2]		;OLDEST VERSION WANTED?
	JRST VERLKD		;YES
	MOVEM B,DRSCN
	JRST VERLK6		;Insert new version here

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

VERLKD:	TQZ <NEWF,NEWVF>
	MOVEI A,GJFX20
	MOVE D,DRLOC
	JN FBDEL,(D),<[TQNN IGDLF ;DELETED, IGNORING DELETED?
		JRST VERLKF	;NO, SCAN UP THE FDB CHAIN TO PREVIOUS
		JRST VRLKD1]>	;YES
VRLKD1:	JN 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
	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
	JE FBDEL,(A),VERLKH	;IF NOT DELETED, GO TO VERLKH
	TQNE <OUTPF,IGDLF>	;IGNORE DELETED?
	JRST VERLKH		;YES
	MOVEI A,GJFX20		;NO, GIVE ERROR RETURN
	JRST ERRET

VERLKH:	TQNE <OUTPF>
	 JRST [	JE FBDEL,(A),VRLKH1 ;DELETED?
		SETZRO FBDEL,(A) ;YES, CLEAR DELETED BIT
		SETONE FBNXF,(A) ;AND SET NON-EXISTENT
		JRST VRLKH1]
VRLKH1:	JE FBNXF,(A),VERLK8	;FILE EXIST?
	TQNE <OLDNF>		;OLD FILE ONLY?
	JRST [	MOVEI A,GJFX24	;YES, THEN GIVE AN ERROR RETURN
		JRST ERRET]
	TQO <NEWVF>		;NO, SET NEW VERSION FLAG
	JRST VERLK8		;Found


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

LOOKUP:	STKVAR <LOOKUE,LOOKUI,LOOKUB>
	TQZ <MTCHF,AMBGF>	;CLEAR RESULT FLAGS
	MOVEM C,LOOKUE		;SAVE ENTRY TYPE
	CALL SETMSB		;Set up input pointer and mask
	MOVE D,DIRORA		;GET BASE OF MAPPED DIR
	LOAD A,DRSTP,(D)	;GET TOP OF DIRECTORY
	LOAD B,DRSBT,(D)	;GET BOTTOM OF SYMBOL TABLE
	ADDI B,.SYMLN		;MAKE IT POINT TO FIRST SYMBOL
	SUB A,B			;GET LENGTH OF SYMBOL TABLE
	JFFO A,.+2		;Get top 1 bit
	MOVEI B,^D34
	MOVNS B
	MOVSI A,400000
	LSH A,(B)		;Largest power of 2 <= length
	LOAD B,DRSBT,(D)	;GET BOTTOM OF SYMBOL TABLE
	ADD B,DIRORA		;MAKE IT ABSOULTE
MOVUP:	JUMPE A,STRFND		;And move up
	CAIG A,1		;DONT SPLIT A SYMBOL ENTRY
	JRST STRFND		;ALL DONE
	ADD B,A
	ASH A,-1		;Halve increment
	MOVE C,DIRORA		;GET BASE ADR
	LOAD C,DRSTP,(C)	;GET TOP OF SYMBOL TABLE
	ADD C,DIRORA		;MAKE IT RELATIVE
	CAMGE B,C		;TOO BIG?
	JRST SYMCMP		;No, compare strings
MOVDN:	JUMPE A,STRFDD
	CAIG A,1		;DONT SPLIT A SYMBOL ENTRY
	JRST STRFDD
	SUB B,A
	ASH A,-1
	MOVE D,DIRORA		;GET BASE ADR
	LOAD C,DRSTP,(D)	;GET TOP OF SYMBOL TABLE
	ADD C,DIRORA		;MAKE IT RELATIVE
	CAML B,C		;STILL BELOW TOP?
	JRST MOVDN		;NO, MOVE DOWN
	LOAD C,DRSBT,(D)	;ABOVE BOTTOM?
	ADDI C,.SYMLN
	ADD C,DIRORA		;MAKE IT RELATIVE
	CAMGE B,C
	JRST [	MOVE C,DIRORA	;GET DIR #
		LOAD C,DRNUM,(C)
		MOVEM B,LOOKUB	;SAVE B
		CALL GETSNM	;GET STR NAME
		BUG(CHK,DIRSY3,<LOOKUP: SYMBOL SEARCH FOULED UP IN DIRECTORY:>,<C,B>)
		MOVE B,LOOKUB	;RESTORE B
		JRST .+1]
	;..
	;..
SYMCMP:	MOVEM A,LOOKUI		;Save increment
	MOVEM B,DRLOC		;And symtab loc
	MOVE A,LOOKUE		;GET ENTRY TYPE
	CALL NAMCM1
	 SKIPA C,A		;FAILED
	RETSKP			;SYMBOL FOUND
	MOVE A,LOOKUI		;GET INCREMENT
	MOVE B,DRLOC		;AND POINTER
	JUMPL C,MOVDN		; A<B
	JUMPG C,MOVUP		; A>B
	TQOE <MTCHF>		; A IS SUBSET OF B
	TQO <AMBGF>
	JRST MOVDN


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

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


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

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

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

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

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

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

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

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

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

;ACCEPTS:
;	A/STRUCTURE NUMBER

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

CHKBAK::SE1CAL
	STKVAR <CKBSTR>
	MOVEM A,CKBSTR		;SAVE STRUCTURE NUMBER
	MOVE A,STRTAB(A)	;GET ADDRESS OF SDB
	LOAD A,STRBXB,(A)	;GET ADDRESS OF XB OF BACKUP FILE
	TLO A,(FILWB+THAWB)	;OPEN IT FOR WRITE THAWED
	MOVE B,CKBSTR		;B/STRUCTURE NUMBER
	CALL ASROFN		;GET AN OFN ON BACKUP FILE
	 RET			;FAILED, GO COMPLAIN
	STOR A,DIROFN		;SAVE THIS OFN
	SETONE DRROF		;INDICATE UNMAPD SHOULD RELEASE OFN
	SKIPE EXADDR		;CHECK FOR SEC 2
	JRST [	CALL MAPDRP	;MAP DIRECTORY PAGE
		JRST CHKBKA]	;AND CONTINUE
	HRLZS A			;GET OFN.PN FOR MAPPING THIS FILE
	MOVX B,PTRW		;MAP FILE IN AS READ WRITE ALLOWED
	IOR B,DIRORA		;GET ADDRESS OF AREA TO MAP INTO
	MOVE C,NDIRPG		;MAP IN WHOLE FILE
	CALL MSETMP		;THIS FILE SHOULD LOOK LIKE A DIRECTORY
CHKBKA:	MOVEI A,ROOTDN		;CHECK THAT IT IS LIKE THE ROOT-DIR
	CALL DR0CHK		;CHECK PAGE 0
	 JRST CHKBK1		;NOT VALID, GO COPY IT
	CALL SYMCHK		;MAKE SURE SYMBOL TABLE OK
	 JRST CHKBK1		;NOT OK, GO COPY ROOT DIR
	CALL BLKSCN		;SCAN ENTIRE FILE
	 JRST CHKBK1		;SOMETHING WAS BAD
	CALL UNMAPD		;UNMAP THE FILE AND RELEASE THE OFN
	RETSKP			;BACKUP FILE IS GOOD

CHKBK1:	CALL UNMAPD		;UNMAP THE FILE AND RELEASE THE OFN
	MOVE A,CKBSTR		;A/STRUCTURE NUMBER
	CALLRET CPYBAK		;GO MAKE A COPY OF THE FILE
;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,<MAPIDX - No OFN for Index Table File>)
	RETBAD(DELFX6)		;GIVE FAILURE RETURN

; MAP THE DESIRED INDEX TABLE FILE

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

MPIDX3:	HLL T2,SHRPTR		;SET UP THE SHARE POINTER FOR THE OFN
	MOVEM T2,IDXMAP		;SET UP THE MAP POINTER
	CALL MONCLA		;RESET THE MONITOR MAP

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

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

UNMIDX:	CALL UNMAPD		;UNMAP ANY DIR
	JE IDXFLG,,R		;IF NO INDEX TABLE FILE MAPPED, JUST RETURN
	MOVEI A,0		;CLEAR OUT PREVIOUS INDEX PAGES
	MOVE B,IDXORA		;GET STARTING ADDRESS OF INDEX TABLE
	MOVX C,NIDXPG		;GET # OF PAGES IN INDEX
	SKIPN EXADDR		;CHECK FOR EXTENDED ADDRESSING
	CALL MSETMP		;UNMAP THE OLD PAGES
	SETZM IDXMAP		;CLEAR MAP FOR EXTENDED ADDRESSING
	CALL MONCLA		;AND TELL HARDWARE ABOUT IT (THESE TWO
				;INSTRUCTIONS UNNECESSARY FOR MODEL A BUT DON'T HURT
	SETZRO IDXFLG		;MARK THAT INDEX TABLE IS NO LONGER MAPPED
	RET			;RETURN



;ROUTINE TO INITIALIZE IDXTAB

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

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

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

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


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

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

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

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

DELIDX::SE1CAL
	CALL CNVIDX		;GET INDEX INTO IDXTAB
	 RET
	SETZRO IDXFB,(A)	;CLEAR ALL ENTRIES
	SETZRO IDXIB,(A)
	SETZRO IDXSD,(A)
	SETZRO IDXFG,(A)
	CALLRET UPDIDX		;UPDATE IDXTAB


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

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

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

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

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

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

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

DRHCHB:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRPG1,<DRHCHK: DIRECTORY HEADER BLOCK IS BAD IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)


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

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

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

;ROUTINE TO CHECK A RELATIVE FDB ADR

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

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

	; ..
	; ..

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

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

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

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


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

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

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

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

ACTBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRACT,<ACTBAD: ILLEGAL FORMAT FOR DIRECTORY ACCOUNT BLOCK IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)


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

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

FREBAD:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRFRE,<FREBAD: ILLEGAL FORMAT FOR DIRECTORY FREE BLOCK IN DIRECTORY:>,<A,B>)
	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,<UNSBAD: ILLEGAL FORMAT FOR DIRECTORY USER NAME BLOCK IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)
;ROUTINE TO CHECK THAT AN ADR IS WITHIN THE DIR BOUNDS
;ACCEPTS IN A/	ABS ADR TO BE CHECKED
;	CALL ADRCHK
;RETURNS +1:	ILLEGAL ADR
;	 +2:	OK

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

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

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

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

RBLDS7:	CALL RBLDS9		;REPORT ERROR
	RETBAD (DIRX3)

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

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

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

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

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

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

BLKSCE:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	BUG(CHK,DIRBLK,<BLKSCN: ILLEGAL BLOCK TYPE IN DIRECTORY:>,<A>)
	RETBAD (DIRX3)

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

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

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


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

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

ASGDFR::SE1CAL
	SAVEQ			;SAVE ANY PERMANENT ACS USED
	TRVAR <ASGDFN,ASGDFM,ASGDFA,ASGDFS,ASGDFP,ASGDFL>
	MOVEM B,ASGDFN		;SAVE THE DESIRED BLOCK SIZE
	ADDI B,.FRHLN		;GET MINIMUM SIZE IF NOT EXACTLY EQUAL
	MOVEM B,ASGDFM		;THIS QUARANTEES NO BLK SMALLER THAN 2
	MOVE Q1,DIRORA		;SET UP BASE ADDRESS OF DIRECTORY
	CALL ASGDF		;SEE IF ROOM CAN BE FOUND
	 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,ASGDF8		;INITIALIZED TABLE YET?
	SETOM 1(A)		;MARK ALL PAGES AS HAVING ROOM
	AOJA A,ASGDF7		;STEP TO NEXT TABLE ELEMENT

ASGDF8:	CALLRET ASGDF		;SEE IF THERE IS ROOM NOW

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

RLDFB2:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRB2L,<RLDFB2: DIRECTORY FREE BLOCK TOO LARGE IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)

RLDFB3:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRBCB,<RLDFB3: DIRECTORY FREE BLOCK CROSSES PAGE BOUNDARY IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)

RLDFB4:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRIFB,<RLDFB4: ILLEGAL BLOCK TYPE ON DIRECTORY FREE LIST IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)

RLDFB5:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRBAF,<RLDFB5: BLOCK ALREADY ON DIRECTORY FREE LIST IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)

RLDFB6:	MOVE A,DIRORA		;GET DIR #
	LOAD A,DRNUM,(A)	;FOR SYSERR
	CALL GETSNM		;GET THE SIXBIT STRUCTURE NAME INTO B
	BUG(CHK,DIRRHB,<RLDFB6: ATTEMPTING TO RETURN A HEADER BLOCK IN DIRECTORY:>,<A,B>)
	RETBAD (DIRX3)


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

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

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


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

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

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

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

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

XPAND2:	SUB B,DIRORA		;MAKE RELATIVE ADDRESS OF FREE TOP
	JUMPE B,XPANDP		;DONT