Google
 

Trailing-Edge - PDP-10 Archives - bb-y393c-sm - monitor-sources/jsysf.mac
There are 53 other files named jsysf.mac in the archive. Click here to see a list.
;Edit 3113 to JSYSF.MAC by SHTIL on Tue 29-May-84, for SPR #20128
;		Make CRDIR check the directory age when creates directories
;;		from a tape only if the user has no capabilities or 
;;		the expiration age is not set.
;Edit 3062 to JSYSF.MAC by CJOHNSON on Tue 3-Jan-84, for SPR #19729
;		Make CLZDO setup JFN before calling FNDUNT
;Edit 3035 to JSYSF.MAC by CJOHNSON on Tue 8-Nov-83, for SPR #17741
;		Change CHFDB% to return new error code CFDBX5 for non-disk jfns
;Edit 3031 to JSYSF.MAC by TSANG on Wed 19-Oct-83, for SPR #19533
;		The wrong register Q2 was used for testing.
;Edit 3025 to JSYSF.MAC by MOSER on Mon 10-Oct-83, for SPR #18746
;		ALLOW WRITER TO CHFDB FB%FCF - MAKE BITS CONSISTENT FOR WHEEL
;EDIT 3025 - ALLOW WRITER TO CHFDB FB%FCF - MAKE BITS FONSISTENT FOR WHEELS
;Edit 3020 to JSYSF.MAC by TSANG on Fri 23-Sep-83, for SPR #19523
;		UPDATE THE BYTE POINTER IN AC2 AFTER SFUST JSYS
;Edit 3018 to JSYSF.MAC by TBOYLE on Thu 22-Sep-83, for SPR #18747
;		Make deletions remove dirs from special cache if necc.
;Edit 3015 to JSYSF.MAC by TBOYLE on Tue 13-Sep-83, for SPR #18733
;		ALLOW CHANGING OF NON WORKING QUOTA ITEMS IF SUP. OVER QUOTA
;Edit 2981 to JSYSF.MAC by JCAMPBELL on Tue 5-Jul-83
;		Add FB%FOR for FORTRAN carriage control files
;Edit 2981 - Add FB%FOR to allowed bits in .FBCTL in FDB
;Edit 2942 by MOSER on Wed 30-Mar-83, for SPR #18970 - FIX OFFLINE EXPIRATION IN CRDIR
;EDIT 2942 - FIX OFFLINE EXPIRATION DEFAULTING IN CRDIR
;**Edit 2918 by SM - off by one in .ARCF
; UPD ID= 240, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.9,  10-Nov-82 18:09:54 by LOMARTIRE
;Edit 2867 - Add documentation to DELBDD BUGINF
; UPD ID= 153, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.7,   9-Sep-82 16:38:25 by MOSER
;EDIT 2806 - MAKE CHFDB WORK WITH NEWLY CREATED FILE
; UPD ID= 140, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.6,  26-Aug-82 10:55:42 by MOSER
;EDIT 2651 - FIX PROBLEM WITH 2639
; UPD ID= 115, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.5,  30-Jul-82 11:08:32 by MOSER
;EDIT 2639 - MAKE CHFDB RETURN CORRECT ERROR.
; UPD ID= 45, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.4,   3-Apr-82 18:23:07 by ZIMA
;Edit 2607 - add ENDAV.s to ACVARs to use v5 MACSYM, change some to SAVEAC.
; UPD ID= 28, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.3,  30-Mar-82 10:01:42 by MOSER
;EDIT 2601 - RETURN ATTRIBUTES FOR PARSE ONLY JFN WHEN JFNS REQUESTS.
; UPD ID= 17, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSF.MAC.2,  18-Mar-82 10:07:10 by ZIMA
;Edit 2005 - Fix ILMNRF and other problems from SFTAD not checking count arg.
;<4-1-FIELD-IMAGE.MONITOR>JSYSF.MAC.2, 25-Feb-82 20:25:57, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 990, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.19,  21-Feb-82 00:21:33 by ZIMA
;Edit 1985 - Fix RCUSR to return RC%NMD if trying to step non-wild string.
; UPD ID= 975, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.18,  12-Feb-82 15:31:40 by GROUT
;Edit 1979 - Put Edit 1977 in standard form
; UPD ID= 968, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.17,   8-Feb-82 14:21:44 by GROUT
;Edit 1977 - Make 600000+.DVTTY designator work for ERSTR
; UPD ID= 907, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.16,  24-Nov-81 09:30:51 by DONAHUE
;Edit 1963 - Use ALOC2 entry to determine quotas when changing them
; UPD ID= 823, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.15,  18-Sep-81 13:20:37 by TILLSON
;Edit 1945 - Clear archive status bit on discard
; UPD ID= 809, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.13,  16-Sep-81 12:09:41 by DONAHUE
;Edit 1944 - Increment <R-D>'s subdir. count when creating a new directory
; UPD ID= 736, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.12,  21-Aug-81 09:37:32 by ZIMA
;Edit 1927 - put edit 1909 in standard form.  No code changes.
; UPD ID= 660, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.11,  16-Jul-81 15:31:58 by GROUT
;Edit 1909 - Fix .RCUSR/.RCDIR for wild strings and .RCUSR for access checking
; UPD ID= 654, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.10,  15-Jul-81 15:19:00 by DONAHUE
;Edit 1908 - Return updated byte pointer to user at JFNSZ-2
; UPD ID= 624, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.9,  25-Jun-81 09:28:40 by GROUT
;Edit 1899 - Make CRDIR check quotas only if changing quotas
; UPD ID= 542, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.8,  20-May-81 12:43:24 by SCHMITT
;Edit 1878 - Release JFN if CHKOFN fails at DELDI6: +20L
; UPD ID= 490, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.7,  30-Apr-81 00:27:36 by ZIMA
;Edit 1861 - Recode GTSTS to consistently return status bits.
; UPD ID= 441, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.6,  13-Apr-81 16:38:06 by ZIMA
;Edit 1844 - Fix SIBE for LSTERR conditions.
; UPD ID= 437, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.5,   8-Apr-81 16:50:12 by ZIMA
;Edit 1843 - Fix CRDIR to preserve MAIL.TXT attributes - create only on
; directory creation.
; UPD ID= 324, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.4,  13-Dec-80 22:47:28 by ZIMA
;Edit 1817 - rewrite SACTF JSYS to fix GNJFN side-effects and other bugs.
; UPD ID= 299, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.3,  23-Nov-80 21:57:49 by ZIMA
;Edit 1810 - make CRDIR work with -1,,ADR pointer to pasword again.
; UPD ID= 291, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.2,  21-Nov-80 10:11:43 by DONAHUE
;Edit 1808 - make ARACCK check for EXE access
; UPD ID= 208, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.2,  19-Sep-80 15:14:08 by GRADY
;Edit 1784 - fix CRDONE routine to use correct superior directory #
; UPD ID= 174, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.10,  29-Aug-80 11:41:26 by ZIMA
;Edit 1773 - fix SFTAD error code and archival code check in SFTAD3.
; UPD ID= 171, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.9,  28-Aug-80 15:26:59 by ZIMA
;Edit 1772 - put 1745, 1747, 1749, 1756 into standard form, no code changes.
; UPD ID= 121, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.8,  14-Jul-80 13:30:52 by GRADY
; Edit 1756, correct problem with edit 1749 in CRDIR jsys.
; UPD ID= 108, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.7,  30-Jun-80 15:19:44 by GRADY
;[1749] TCO 5.1082 - PREVENT FROM DELETING DIRECTORIES IN USE.
; UPD ID= 97, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.6,  25-Jun-80 17:28:43 by GRADY
;TCO 5.1081 - Reload T4 with FDB index before using it at CHFDB1+1
; UPD ID= 93, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.5,  21-Jun-80 11:41:19 by SCHMITT
; Edit 1745 - Use TPRCYC for default offline exp if set at DIRINI
; UPD ID= 72, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.4,  11-Jun-80 13:53:57 by SCHMITT
; Edit 1741 - Insert some other offsets into SWJFNT table
; UPD ID= 60, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.3,  10-Jun-80 16:50:20 by ZIMA
;EDIT 1735 - FORCE EDITS 1727, 1728, 1729 INTO STANDARD FORM - NO CODE CHANGE
; UPD ID= 38, FARK:<4-WORKING-SOURCES.MONITOR>JSYSF.MAC.2,   6-Jun-80 09:30:41 by SANICHARA
; UPD ID= 277, SNARK:<4.MONITOR>JSYSF.MAC.110,  19-Feb-80 13:46:38 by DBELL
;TCO 4.2604 - FIX HUNG JOB PROBLEMS WITH TEMPORARY PATCH NEAR CLZFM1
;<4.MONITOR>JSYSF.MAC.109,  3-Jan-80 08:09:09, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>JSYSF.MAC.108, 14-Nov-79 16:35:52, EDIT BY DBELL
;TCO 4.2571 - MAKE ARCHIVED FILES VISIBLE WHEN THEY ARE RESTORED IN ARRST
;<4.MONITOR>JSYSF.MAC.107,  6-Nov-79 10:42:54, EDIT BY MILLER
;PUT ERJMP AFTER SETZM IN DIRINI TO PREVENT ILMNRF BUGHLTS
; IF STRUCTURE IS FULL
;<4.MONITOR>JSYSF.MAC.106,  6-Nov-79 09:21:36, EDIT BY GRANT
;MAKE SURE JFN IS RETRIEVED AT CRDR01
;ADD COMPARISON WITH MAXJFN AT RLJF1
;<4.MONITOR>JSYSF.MAC.105, 26-Oct-79 14:31:24, EDIT BY TOMCZAK
;TCO 4.2556 - FIX DELNF TO ACCEPT FLAGS IN LEFT HALF AC1
;<4.MONITOR>JSYSF.MAC.104, 20-Oct-79 14:04:27, EDIT BY MILLER
; CHANGE CLZFF JSYS TO SPECIFY BLOCK VIA MAPFKH AND TO UNLOCK
; FORK LOCK
;<4.MONITOR>JSYSF.MAC.103, 11-Oct-79 13:36:33, EDIT BY TOMCZAK
;TCO#4.2523 - Don't allow negative LIQ/LOQ for a directory
;<4.MONITOR>JSYSF.MAC.102,  9-Oct-79 16:43:43, Edit by KONEN
;CHECK FOR "DSK" IN INIT'ING STR IN RCDIR
;<4.MONITOR>JSYSF.MAC.101,  5-Oct-79 15:19:40, Edit by KONEN
;MAKE SURE STRUCTURE HAS FINISHED INIT'ING FOR RCDIR
;<4.MONITOR>JSYSF.MAC.100,  2-Oct-79 15:34:11, EDIT BY MILLER
;FIX ASND NOT TO CALL ACJ IF DEVICE ALREADY ASSIGNED TO
; CALLING JOB
;<4.MONITOR>JSYSF.MAC.99,  1-Oct-79 15:55:38, EDIT BY MILLER
;FIX ASND JSYS TO CHECK ARGS BEFORE INVOKING ACJ. THIS IMPLIES ACJ
; WILL BE CALLED ONLY FOR ASSIGNABLE DEVICES NOT YET ASSIGNED.
;<4.MONITOR>JSYSF.MAC.98, 26-Sep-79 15:40:16, EDIT BY HALL
;GTFDB AND RDDIR - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;<4.MONITOR>JSYSF.MAC.97, 26-Sep-79 13:16:50, EDIT BY MILLER
;ONE MORE FIX FOR NEW ACJ FUNCTION
;<4.MONITOR>JSYSF.MAC.95, 25-Sep-79 16:32:13, EDIT BY MILLER
;tco 4.2487. ADD .GOOAD GETOK REQUEST IN OPENF
;<4.MONITOR>JSYSF.MAC.94, 19-Sep-79 10:07:20, EDIT BY ENGEL
;PREVENT PRINTING OF ;PASSWORD IN JFNS
;<OSMAN.MON>JSYSF.MAC.1, 10-Sep-79 15:39:49, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>JSYSF.MAC.92, 30-Aug-79 08:13:49, EDIT BY MILLER
;FIX CHKTTR NOT TO TOUCH JFN BLOCK IF 100 OR 101 GIVEN AS ARGS
;<4.MONITOR>JSYSF.MAC.91, 23-Aug-79 11:35:31, EDIT BY R.ACE
;TCO 4.2416 - JFNS... IF PARSE-ONLY JFN, ALWAYS PUNCTUATE TYPE FIELD
;<4.MONITOR>JSYSF.MAC.90, 16-Aug-79 13:46:17, EDIT BY OSMAN
;CHANGE GTFDB2 TO GTFD2 TO NOT CONFLICT WITH GTFDB2 BUGHLT IN DISC
;<4.MONITOR>JSYSF.MAC.89, 13-Aug-79 15:44:52, EDIT BY GRANT
;TCO 4.2377 - RLJFN WITH T1/-1 NOW AFFECTS ONLY THE EXECUTING
;PROCESS AND ITS INFERIORS
;<4.MONITOR>JSYSF.MAC.88, 13-Aug-79 13:34:58, EDIT BY DBELL
;TCO 4.2392 - FIX FREE CORE PROBLEMS CAUSED BY -1 ARGUMENT TO RLJFN
;<4.MONITOR>JSYSF.MAC.87, 30-Jul-79 14:40:41, EDIT BY BLOUNT
;ADD CODE TO USE ARCHIVE OFFLINE DEFAULT
;<4.MONITOR>JSYSF.MAC.86, 15-Jul-79 12:02:15, EDIT BY HALL
;SMFILE - CALL UNLCKF IF FILE IS NOT OPEN
;<4.MONITOR>JSYSF.MAC.85, 25-Jun-79 16:36:10, Edit by LCAMPBELL
; Return correct error for SFUST for last writer and not WHOPER
;<4.MONITOR>JSYSF.MAC.84, 18-Jun-79 13:17:38, EDIT BY DBELL
;TCO 4.2292 - CHECK FOR PARSE-ONLY JFN IN .DELNF
;<4.MONITOR>JSYSF.MAC.83, 10-Jun-79 13:38:52, EDIT BY MILLER
;TCO 4.2281. ALLOW FLAG BITS IN LH OF AC1 FOR GDSTS
;<4.MONITOR>JSYSF.MAC.82, 20-May-79 17:41:47, EDIT BY R.ACE
;TCO 4.2254 - ADD "MOVE T4,P3" BEFORE CALL TO FSHFIL IN ARSST
;<4.MONITOR>JSYSF.MAC.81, 20-May-79 13:59:15, EDIT BY DBELL
;SMALL FIX TO GTFDB
;<4.MONITOR>JSYSF.MAC.80, 17-May-79 12:49:22, EDIT BY DBELL
;TCO 4.2248 - MAKE CHFDB AND GTFDB HANDLE VARYING SIZED FDBS.
;<4.MONITOR>JSYSF.MAC.79, 12-May-79 13:51:21, EDIT BY MILLER
;ALLOW GDSTS TO BE DONE ON TTY JFN
;<4.MONITOR>JSYSF.MAC.78, 24-Apr-79 06:13:19, EDIT BY R.ACE
;TCO 4.2241 - FIX CHFDB TO LET WHOPER SET ALL BITS OF .FBBK0
;<4.MONITOR>JSYSF.MAC.77, 19-Apr-79 13:33:46, EDIT BY R.ACE
;FIX BUGS IN ARRFR
;<4.MONITOR>JSYSF.MAC.76, 18-Apr-79 13:58:50, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.75,  5-Apr-79 11:19:53, Edit by MCLEAN
;REMOVE 1ST ARG FROM GTOKM
;<4.MONITOR>JSYSF.MAC.74, 28-Mar-79 11:44:20, Edit by LCAMPBELL
; Return proper error code if (regulated) structure not mounted
;<4.MONITOR>JSYSF.MAC.73, 21-Mar-79 14:44:33, Edit by MCLEAN
;MAKE .ASND DO RETERR NOT RETBAD
;<4.MONITOR>JSYSF.MAC.72, 16-Mar-79 11:54:30, EDIT BY R.ACE
;CHANGE FAILING CALL TO SETDIR IN RCDIR TO PASS SETDIR'S ERROR
;CODE UP TO THE USER INSTEAD OF RCDIX2
;<4.MONITOR>JSYSF.MAC.71, 15-Mar-79 21:01:33, Edit by LCAMPBELL
; If changing pswd to null, require WHOPER or connect access to superior
;<4.MONITOR>JSYSF.MAC.70,  7-Mar-79 14:01:12, Edit by KONEN
;AVOID 'SECNX' BUGHLT
;<4.MONITOR>JSYSF.MAC.69,  5-Mar-79 13:17:40, EDIT BY MILLER
;REMOVE CALL TO RELMT
;<4.MONITOR>JSYSF.MAC.68,  4-Mar-79 17:43:27, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>JSYSF.MAC.67,  2-Mar-79 15:26:27, Edit by MCLEAN
;FIX GETOKM MACROS
;<4.MONITOR>JSYSF.MAC.66,  9-Feb-79 13:12:40, EDIT BY KIRSCHEN
;DO NOT INDEX BY DEV GETTING NAME LOOKUP ROUTINE AT ARRST+23
; (DEV HAS POSITIVE LEFT HALF, CAUSES SECNX)
;<4.MONITOR>JSYSF.MAC.65,  1-Feb-79 17:41:51, EDIT BY HURLEY.CALVIN
; Don't allow temporary files to be archived or migrated
;<4.MONITOR>JSYSF.MAC.64, 31-Jan-79 18:25:13, EDIT BY MILLER
;SAVE F IN MJFCNT
;<4.MONITOR>JSYSF.MAC.63, 25-Jan-79 18:21:36, EDIT BY ZIMA
;TCO 4.2173 - Handle JFNS output case where JSCDF is zero
;<4.MONITOR>JSYSF.MAC.62, 10-Jan-79 21:26:51, EDIT BY ACARLSON
; Use the correct arguements to ARCF from OPENF (wait for file case)
;<4.MONITOR>JSYSF.MAC.61,  8-Jan-79 17:23:43, EDIT BY ZIMA
;TCO 4.2157 - PROTECT RCDIR/RCUSR CALCULATED BITS FROM DIR MODE WORD
;<4.MONITOR>JSYSF.MAC.60,  8-Jan-79 06:48:45, EDIT BY GILBERT
;TCO 4.2155 - Implement hidden symbol tables:
;	Change the JSVAR macro to JSBVAR.
;<4.MONITOR>JSYSF.MAC.59,  4-Jan-79 11:32:54, EDIT BY MILLER
;<4.MONITOR>JSYSF.MAC.58,  3-Jan-79 19:41:10, EDIT BY DBELL
;TCO 4.2146 - USE JSB STACK IN RCUS0 ROUTINE TO PREVENT LONG NOINT.
;<4.MONITOR>JSYSF.MAC.57,  2-Jan-79 16:10:24, EDIT BY MILLER
;DON'T ALLOW CHFDB ON .FBCTL IF FILE IS A DIR FILE
;<4.MONITOR>JSYSF.MAC.56, 29-Dec-78 13:30:57, EDIT BY KIRSCHEN
;RESTORE MAP COUNT AT CLZFW WHEN CLOSE BLOCKS SO THAT FILES ARE
; NOT INADVERTANTLY CLOSED BY OTHER FORKS WHEN CLOSE IS ATTEMPTED AGAIN
;<4.MONITOR>JSYSF.MAC.55, 28-Dec-78 20:58:01, EDIT BY DBELL
;CALL THE RIGHT ROUTINE FOR DSK*: OUTPUT.
;<4.MONITOR>JSYSF.MAC.54, 21-Dec-78 21:25:28, EDIT BY DBELL
;TCO 4.2131 - MAKE JFNS OUTPUT DSK*: IF GIVEN A WILD DEVICE
;<4.MONITOR>JSYSF.MAC.53, 21-Dec-78 12:13:57, EDIT BY MILLER
;ADD REAJFN. REASSIGN JFN TO FORK
;<4.MONITOR>JSYSF.MAC.52, 15-Dec-78 12:43:00, EDIT BY MILLER
;ONE MORE FIX TO JFNS FOR VERSION PRINT OUT
;<4.MONITOR>JSYSF.MAC.51, 11-Dec-78 14:04:03, Edit by MCLEAN
;FIX ASND TO RETBAD ON GETOK ERROR
;<4.MONITOR>JSYSF.MAC.50,  8-Dec-78 19:44:29, EDIT BY HURLEY.CALVIN
; Correct error # in CRDIR (ARGX26 becomes ARGX27)
;<4.MONITOR>JSYSF.MAC.49, 30-Nov-78 13:11:35, EDIT BY MILLER
;FIX JFNS ONCE MORE TO MAKE MT VERSIONS PRINT OUT
;<4.MONITOR>JSYSF.MAC.48, 29-Nov-78 19:04:03, EDIT BY HURLEY.CALVIN
; Change SET1ST, SET2ND, and ARGST over to use ULOAD and USTOR
;<4.MONITOR>JSYSF.MAC.47, 28-Nov-78 16:08:29, EDIT BY MILLER
;FIX MJFCNT TO DO PROPER COUNT
;<4.MONITOR>JSYSF.MAC.46, 17-Nov-78 18:49:30, EDIT BY HURLEY.CALVIN
; Have .ARSST (ARCF) restore offline page count if setting both tape IDs
;<4.MONITOR>JSYSF.MAC.45, 13-Nov-78 13:51:36, EDIT BY LCAMPBELL
; Add CD%LEN to CRDNWH so SET DIR ONLINE <FOO> +180 will work
; On errors in CKJFN, go to ARCFXY rather than ARCFX if GETFDB not done yet
;<4.MONITOR>JSYSF.MAC.43,  6-Nov-78 19:10:25, Edit by CALVIN
; FIX ARRAR SO .ARCLR PATH WORKS; FIX AC A CLOBBERAGE AT CHFD10
;<4.MONITOR>JSYSF.MAC.42,  4-Nov-78 14:45:18, EDIT BY DBELL
;USE AC Q3 INSTEAD OF F AT WLDJFN SINCE CHKJFN TRASHES F
;<4.MONITOR>JSYSF.MAC.41,  3-Nov-78 13:07:44, EDIT BY MILLER
;FIX CKJFN TO USE P3 INSTEAD OF DEV
;<4.MONITOR>JSYSF.MAC.40,  3-Nov-78 11:25:52, EDIT BY MILLER
;ALLOW JFNS OF VERSION IF DEVICE IS DV%PSD (I.E. MT'S)
;<4.MONITOR>JSYSF.MAC.39, 31-Oct-78 16:32:12, EDIT BY DBELL
;TCO 4.2076 - DON'T ALLOW DETACHED TERMINAL IN BKJFN JSYS.
;<4.MONITOR>JSYSF.MAC.38, 29-Oct-78 14:05:31, EDIT BY DBELL
;HAVE WILD% CALL CHKFIL INSTEAD OF CHKJFN.
;<4.MONITOR>JSYSF.MAC.37, 26-Oct-78 09:51:58, EDIT BY DBELL
;TCO 4.2066 - MAKE CRDIR WORK IF SPECIFYING DIRECTORY NUMBER AND NOT
;SPECIFYING A DEVICE NAME.
;[BBN-TENEXD]<3A-EONEIL>JSYSF.MAC.22,  1-Sep-78 16:44:58, Ed: EONEIL
; Removed routine CKARDL since ARACCK now handles archive checking
;[BBN-TENEXD]<3A-EONEIL>JSYSF.MAC.18, 30-Aug-78 14:50:11, Ed: CRDAVIS
; Changed CLRBOT to call ARCMSG properly.
;<CALVIN>JSYSF.MAC.1, 24-Aug-78 07:11:15, EDIT BY CALVIN
; Replace call in ARSST to DELFL1 to call to FSHFIL (in DISC)
;<ARC-DEC>JSYSF.MAC.9, 23-Aug-78 11:23:43, EDIT BY CALVIN
; Add code to support AR%CRQ in ARSST function of ARCF & fix "bug" concerning
; AR%OFL in ARSST-check for tape info rather than both AR%O1 & AR%O2
;<ARC-DEC>JSYSF.MAC.4, 21-Aug-78 12:47:39, EDIT BY CALVIN
; Cause migration requests to become archive requests if CD%DAR is on
; in the directory mode word
;<ARC-DEC>JSYSF.MAC.3, 21-Aug-78 12:08:43, EDIT BY CALVIN
; Modifications to CRDIR for archive system
;<CALVIN>JSYSF.MAC.10, 17-Aug-78 05:33:26, EDIT BY CALVIN
; Make CHFDB check offset against actual length of FDB in question
;<CALVIN>JSYSF.MAC.3, 15-Aug-78 11:40:23, EDIT BY CALVIN
; Add new entries in CHFDB masks
;[BBN-TENEXD]<CALVIN>JSYSF.MAC.1, 15-Aug-78 08:47:48, Ed: CALVIN
; Install DEC spec'd ARCF JSYS
;[BBN-TENEXD]<3-EONEIL>JSYSF.MAC.8, 11-Aug-78 10:45:53, Ed: EONEIL
;PUT TEMP FLAG JS%TM3 IN Q1 SINCE Q3 IS FULL
;[BBN-TENEXD]<3-EONEIL>JSYSF.MAC.6, 31-Jul-78 16:25:37, Ed: EONEIL
;IN JFNS, ADDED OFFLINE ATTRIBUTE
;[BBN-TENEXD]<3-EONEIL>JSYSF.MAC.2,  1-Jun-78 11:03:22, Ed: EONEIL
; Installed archive system: ARCF JSYS, etc.
;<4.MONITOR>JSYSF.MAC.35, 18-Oct-78 12:33:10, EDIT BY MILLER
;IF RLJFN IS DONE TO AN MT JFN, CALL RELMT
;<4.MONITOR>JSYSF.MAC.34, 16-Oct-78 23:22:47, EDIT BY DBELL
;FIX SIMPLE THINGS IN WILD%
;<4.MONITOR>JSYSF.MAC.33, 15-Oct-78 16:14:18, EDIT BY DBELL
;ADD WILD% JSYS
;<4.MONITOR>JSYSF.MAC.32, 28-Sep-78 13:27:13, Edit by MCLEAN
;FIX DVCHR TO HAVE CORRECT EXPRESSION FOR NUL DEVICE
;<4.MONITOR>JSYSF.MAC.31, 26-Sep-78 18:03:06, Edit by MCLEAN
;TCO 4.2025 FIX ASND TO RETURN REAL ERROR CODE
;<4.MONITOR>JSYSF.MAC.30, 26-Sep-78 08:20:43, EDIT BY R.ACE
;TCO 4.2021 - MAKE OPENF RETURN OPNX13 IF NO ACCESS BITS SET IN AC2
;<4.MONITOR>JSYSF.MAC.29, 19-Sep-78 15:32:32, EDIT BY HALL
;TCO 1900 - DISALLOW SWJFN FOR ATS
;<4.MONITOR>JSYSF.MAC.28, 18-Sep-78 14:59:58, Edit by MCLEAN
;REMOVE EXTRANEOUS CODE AT DIRINI FOR BLT/XBLT TO CLEAR PAGE
;I BELIEVE EXADDR STUFF WAS WRONG ANYWAY
;<4.MONITOR>JSYSF.MAC.27, 16-Sep-78 15:36:53, Edit by MCLEAN
;INSERT CREDIR GETOK
;<2MCLEAN>JSYSF.MAC.24,  5-Sep-78 12:58:09, Edit by MCLEAN
;<2MCLEAN>JSYSF.MAC.23, 27-Aug-78 21:46:04, Edit by MCLEAN
;MAKE DEVUNT UNIT 15 BITS
;<4.MONITOR>JSYSF.MAC.25, 29-Aug-78 11:30:23, EDIT BY ENGEL
;IMPROVE COMMENTS FOR FFFFP
;<4.MONITOR>JSYSF.MAC.24, 28-Aug-78 21:03:15, Edit by LCAMPBELL
; Change MRETN to JRST MRETN, it works better
;<4.MONITOR>JSYSF.MAC.23, 28-Aug-78 16:10:21, EDIT BY ENGEL
;TCO #4.1994 SPEED UP FFFFP
;<4.MONITOR>JSYSF.MAC.22, 12-Aug-78 20:06:07, Edit by HELLIWELL
;TCO # 4.1983 - ALLOW LOGICAL NAMES IN CRDIR
;<4.MONITOR>JSYSF.MAC.21,  9-Aug-78 14:17:29, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.20,  9-Aug-78 00:02:44, Edit by MCLEAN
;FIX CLOSE CO-ROUTINE
;<4.MONITOR>JSYSF.MAC.19,  8-Aug-78 16:19:17, Edit by ENGEL
;FIX DVCHR FOR .NULIO
;<4.MONITOR>JSYSF.MAC.18,  1-Aug-78 15:47:09, Edit by HELLIWELL
;REMOVE NOINT/OKINT AT DSM0 (ONLY DECTAPES CARE)
;<4.MONITOR>JSYSF.MAC.17,  1-Aug-78 13:57:54, EDIT BY HALL
;ADD MJFCNT ROUTINE
;<4.MONITOR>JSYSF.MAC.16, 18-Jul-78 12:11:59, Edit by KIRSCHEN
;FIX GETWRD/PUTWRD TO NOT FAIL ON NON-EX USER ADDRESSES
;<4.MONITOR>JSYSF.MAC.15, 17-Jul-78 23:32:29, Edit by MCLEAN
;MOVE GETWRD/PUTWRD IN LINEPR TO JSYSF BECAUSE IT WAS CALLED BY CARDREADER SERVICE AND I NEED IT FOR MTA'S
;<2MCLEAN>JSYSF.MAC.14, 15-Jul-78 23:34:42, Edit by MCLEAN
;INSERT GETOK IN .ASND
;<4.MONITOR>JSYSF.MAC.13, 14-Jul-78 14:46:55, Edit by MCLEAN
;FIX OPENB TO CHECK TO SEE IF JFN IS THE SAME
;<4.MONITOR>JSYSF.MAC.12, 14-Jul-78 14:37:39, Edit by MCLEAN
;CHANGE CO-ROUTINE IN MTOPR AND OPENF TO BE IN P6
;<4.MONITOR>JSYSF.MAC.11, 14-Jul-78 13:55:12, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.10, 12-Jul-78 18:06:50, Edit by MCLEAN
;CORRECT UNNECESSARY DIRECTORY WRITES
;<2MCLEAN>JSYSF.MAC.2, 12-Jul-78 02:40:02, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.9, 12-Jul-78 02:19:34, Edit by MCLEAN
;FIX .MTOPR CO-ROUTINE TO CHECK THAT JFN DIDN'T CHANGE DURING BLOCK
;<4.MONITOR>JSYSF.MAC.8, 10-Jul-78 11:38:32, EDIT BY MILLER
;TCO 1937. PASS UFPGS FLAGS TO PAGEM
;<3A.MONITOR>JSYSF.MAC.340, 13-Jun-78 13:30:23, Edit by PORCHER
;TCO # 1895 - FIX RCDIR AND RCUSR TO RETURN RC%NMD WHEN RC%STP SPECIFIED
; WITH NON-WILD DIRECTORY OR USER NAME
;<3A.MONITOR>JSYSF.MAC.339, 12-May-78 08:57:54, EDIT BY MILLER
;FXI GTFDB TO TOUCH ALL AFFECTED USER PAGES BEFORE LOCKING JFN
;CHECK FOR NULL DIR LIST AND NON-NULL USER LIST IN CDCKCU
;<3A.MONITOR>JSYSF.MAC.337, 27-Mar-78 12:12:29, EDIT BY MILLER
;CHECK FOR "FUNNY" JFN AT SIBE1
;<4.MONITOR>JSYSF.MAC.3,  1-Mar-78 09:36:34, EDIT BY MILLER
;MAKE SURE CRDIR CODE DOES NOT DIDDLE QUOTA OF "ROOT-DIRECTORY"
;<4.MONITOR>JSYSF.MAC.2, 16-Feb-78 17:40:08, EDIT BY MILLER
;FIX UP ERROR RETURN IN SMFILE
;<4.MONITOR>JSYSF.MAC.1, 16-Feb-78 17:28:12, EDIT BY MILLER
;ADD SUPPORT CODE FOR SMAP


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

	SEARCH PROLOG
	TTITLE JSYSF
	SWAPCD

;THIS FILE CONTAINS CODE WHICH IMPLEMENTS VARIOUS FILE JSYSES.
;ONLY JSYSES WHICH REQUIRE ONE OR MORE OF THE FILE-SPECIFIC AC
;DEFINITIONS (JFN, STS, ETC.) ARE HERE.

;FIRST PORTION OF THE FILE CONTAINES MISC SUBROUTINES USED HEREIN.
;SECOND (MAJOR) PORTION CONTAINES JSYSES ORDERED ALPHABETICALLY

;SPECIAL AC DEFINITIONS USED HEREIN

DEFAC (STS,P1)			;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)

;ERROR RETURNS AND TRAPS

ERUNLD::CALL UNLCKF
	RETERR()
; Set file byte number common code
; Call:	A	; Byte number
;	CALL SFBNR
; Return
;	+1	; Error of some sort, error number in a
;	+2	; Success
; Clobbers most temps

SFBNR::	TQNN <RNDF>
	JRST [	MOVEI A,SFPTX2
		RET]		; Illegal to reset pointer for this file
	CAMN A,[-1]
	MOVE A,FILLEN(JFN)	; Set to end of file if -1
	JUMPL A,[MOVEI A,SFPTX3
		RET]		; Illegal byte number
	MOVEM A,FILBYN(JFN)
	TQZ <EOFF>
	TQNE <WRTF>		;FILE OPEN FOR WRITING?
	JRST [	CAML A,FILLEN(JFN) ;YES, POINTER SET BEYOND CURRENT END?
		CALL [	MOVEM A,FILLEN(JFN)
			CALLRET UPDLEN]	;UPDATE END
		JRST SFBNR1]
	CAML A,FILLEN(JFN)
	JRST [	CALL GETLEN	;GET REAL FILLEN
		CAML A,FILLEN(JFN)
		TQO <EOFF>
		JRST SFBNR1]	;EXIT
SFBNR1:	SETZM FILCNT(JFN)	;FORCE NEW WINDOW NEXT OPERATION
	RETSKP

NFBSZ::	CAIE B,7		;IF USER SWITCHES TO NON-ASCII,
	TQO <PASLSN>		;THEN ASSUME IT'S NOT AN EDIT FILE
	MOVEI C,^D36
	IDIVM C,A		; Number of bytes per word
	MOVEI C,^D36
	IDIV C,B		; New number of bytes per word
	PUSH P,C
	IMUL C,FILBYN(JFN)	; Adjust byte number
	IDIV C,A
	CAIE D,0
	AOS C
	MOVEM C,FILBYN(JFN)
	POP P,C
	IMUL C,FILLEN(JFN)	; And adjust file length
	IDIV C,A
	CAIE D,0
	AOS C
	MOVEM C,FILLEN(JFN)
	DPB B,PBYTSZ		; Deposit new byte size
	RET
; This routine is called from write copy code in pagem to reduce the
; The map count of a page
; Call:	1	; Ofn.pn
;	CALL JFNDCR
; Returns +1 always

JFNDCR::CALL OFNJFX
	RET
	HLRZS A
	IMULI A,MLJFN		; CONVERT TO INTERNAL INDEX
	MOVSI B,-2
	ADDB B,FILLFW(A)	;REDUCE MAP COUNT
	TLNE B,777777		;COUNT NOW ZERO AND CLOSF DONE?
	 RET
	MOVX B,FRKF		;YES, UNRESTRICT FILE SO ANY CLZFF GETS IT
	ANDCAM B,FILSTS(A)
	RET

;ROUTINES TO CHECK TTY'S.

;CALL	JFN			;SOME KIND OF SOURCE/DESTINATION DESIGNATOR
;	CALL CHKTTR		;IS THIS A TERMINAL?
;RETURN
;	+1			;NO, ERROR CODE IN A.
;	+2			;YES
;ON SUCCESS, THE FOLLOWING ARE SET UP:
;	DEV			;CORRECT STUFF FOR REFERENCED TERMINAL
;	B			;LINE NUMBER
;	C			;0 IF JFN NOT GIVEN,  BYTE SIZE OF OPEN
;				;    IF A JFN WAS GIVEN

CHKTTR::UMOVE JFN,1		;GET DESIG
CHKTR1:	CAIGE JFN,1B18+NLINES	;TTY DESIG?
	CAIGE JFN,1B18
	JRST CHKTTC		;NO
	HRLI DEV,-1B18(JFN)	;YES, SET UP LINE #
CHKTC1:	HRRI DEV,TTYDTB		;SET UP TTY DISPATCH IN DEV
	MOVX STS,READF+WRTF+OPNF
	HLRZ B,DEV		;RETURN LINE NUMBER IN B
	SETZ C,			;NOT A JFN, NO BYTE SIZE
	RETSKP
CHKTTC:	HRLI DEV,(JFN)		;FIRST ASSUME TTY
	CAMGE JFN,[600000+.DVTTY,,NLINES]
	CAMGE JFN,[600000+.DVTTY,,0]
	CAIA
	JRST CHKTC1		;WE HAVE 600000+.DVTTY,,LINE #
	CALL CHKJFN
	 RETBAD(DESX1)		;GARBAGE
	 JRST CHKTT1		;TTY
	 RETBAD(DESX1)		;BYTE PTR
	CALL UNLCKF		;REGULAR JFN, UNLOCK IT
CHKTT1:	TQNE <ASTF>
	 RETBAD(DESX7)
	HRRZ A,DEV
	HLRZ 2,DEV		;GET LINE NUMBER
	CAIE 2,-1		;DETACHED INDICATION?
	CAIE A,TTYDTB
	 RETBAD (DESX6)		;NOT TTY
	LDB C,[POINT 4,STS,35]	;GET BYTE SIZE OF OPEN
	TXNE JFN,1B18		;SPECIAL DESIGNATOR (100 OR 101)?
	RETSKP			;YES. ALL DONE THEN
	SKIPN C,		;IF NONE...
	LDB C,PBYTSZ		;  GET THE BYTE SIZE FROM FILBYT(JFN)
	RETSKP

;CALL	JFN			;SOME KIND OF SOURCE/DESTINATION DESIGNATOR
;	CALL CHKTTR		;IS THIS AN AVAILABLE TERMINAL TO THIS JOB?
;RETURN
;	+1			;NO, ERROR CODE IN A.
;	+2			;YES
;ON SUCCESS, THE FOLLOWING ARE SET UP:
;	DEV			;CORRECT STUFF FOR REFERENCED TERMINAL
;	B			;LINE NUMBER

CHKTTM::SKIPA JFN,1		;GET DESIG
CHKTTY::UMOVE JFN,1
	STKVAR <LINENO>		;HOLDS TERMINAL LINE #
	CALL CHKTR1		;MAKE SURE IT'S A TERMINAL
	RETBAD ()		;IT'S NOT; ASSUME ERROR CODE IN T1.
	MOVEM B,LINENO		;SAVE THE LINE NUMBER
	MOVEI A,400000(B)	;MAKE TERMINAL DESIGNATOR
	CALL CHKDEV		;IS THIS DEVICE AVAILABLE ?
	RETBAD (DESX2)		;NOT AVAILABLE TO THIS JOB
	MOVE B,LINENO		;RESTORE THE LINE NUMBER
	RETSKP

;ROUTINE USED TO INCREMENT THE USE COUNT OF A JFN.
;	T1/ THE JFN
;	T2/ THE COUNT TO ADD TO CURRENT USE COUNT
;RETURNS:
;	+1 JFN VANISHED
;	+2 DONE

MJFCNT::SAVEP			;SAVE ALL VUNERABLE REGS
	SAVEAC <F>		;THIS IS VULNERABLE TOO
	LSH T2,1		;DOUBLE THE SHARE COUNT
	ASUBR <IJFN,COUNT>
	MOVE JFN,T1		;COPY JFN
	CALL DSKJFN		;VERIFY AND CONVERT JFN
	 RET			;WENT AWAY
	HRLZ T2,COUNT		;GET INCREMENT
	ADDM T2,FILLFW(JFN)	;APPLY IT
	CALL UNLCKF		;UNLOCK THE JFN
	RETSKP			;AND DONE
   REPEAT 0,<			;THIS IS INTENDED TO SUPPORT MULTIPLE
				;DISK UNITS BUT IS NOT PRESENTLY USED.
;SET UP UNIT
; A/	B17 ON IF NOT DEFAULT
; B/	DEVICE DESIGNATOR
; RETURNS +1 - FAIL
;	+2 - SUCCESS, U LOADED

SETUNT:	EXCH A,B
	MOVE U,JOBUNT
	TLNN B,(1B17)		;DEFAULT TAKEN IF B17 OFF
	RETSKP
	CALL CHKDEV
	 RET
	RETSKP
   >				;END OF REPEAT 0

;ROUTINE TO REASSIGN OWNERSHIP OF A JFN. THIS IS USED WHENEVER
;A NEW FORK NEEDS TO ASSUME RESPONSIBILITY FOR THE JFN. EXAMPLES
;ARE: IF A FORK OTHER THAN THE CREATER ENABLES FOR PSI
;VIA THE JFN.

;	JFN/ THE JFN
;		IT MUST BE LOCKED

;RETURNS:	+1 FAILURE. NONE DEFINED YET
;		+2 DONE

REAJFN::HLRZ T1,FILVER(JFN)	;GET PRESENT OWNER
	CAMN T1,FORKN		;ALREADY OWNED BY THIS GUY?
	RETSKP			;DONE. NO CHANGE NEEDED
	MOVE T1,FORKN		;NO. GET THIS FORK'S NUMBER
	HRLM T1,FILVER(JFN)	;AND SET IT AS NEW OWNER
	RETSKP			;AND DONE
; ARCF Jsys
; 1:JFN, 2: Function code, 3: Function dependent, normally 0
; Returns +1 always

.ARCF::	MCENT
	HRRZ JFN,T1		; Copy JFN
	CALL CKJFN		; Verify the JFN
	MOVE P3,T1		; Save FDB offset
	XCTU [ MOVE T1,2]	; Get function code
	XCTU [ MOVE Q3,3]	; Get param - if any
	CAIL T1,0		; Check function request
;**;[2918] At .ARCF:: +7L, Modified 1 line                  SM 23-Feb-83
	CAIL T1,NARFNS		; In range? ;[2918] test bounds correctly
	ERRJMP ARGX02,ARCFX	; Invalid function
	CALL @ARCFF(T1)		; Do it
	 JRST ARCFX		; Failed for some reason
	CALL UPDDIR		; Update directory
	CALL USTDIR
	CALL UNLCKF
	MRETNG			; Done

ARCFX:	CALL USTDIR		; Unlock things
ARCFXY:	CALL UNLCKF
	ITERR ()

ARCFF:	IFIW!ARRAR		; 0 Request voluntary archive
	IFIW!ARRIV		; 1 Request involuntary migration
	IFIW!AREXM		; 2 File is exempt from migration
	IFIW!ARRFR		; 3 Request file contents be restored
	IFIW!ARDIS		; 4 Discard tape status
	IFIW!ARSST		; 5 Set tape status for file
	IFIW!ARRST		; 6 Restore contents of a file
	IFIW!ARGST		; 7 Get tape status for file
	IFIW!ARRFL		; 10 Restore failed, tell waiting fork
	IFIW!ARNAR		; 11 Please don't migrate this file

NARFNS==.-ARCFF
; Request voluntary archive; Please don't migrate this file

ARNAR:	LOAD T1,FBBBT,(P3)
	TXNE T1,AR%RIV		; Requested?
	RETBAD(ARCX19)		; Request pending
	CALL CKAROF
	 RETBAD()
	MOVX T2,AR%NAR
	JRST ARRAR1

ARRAR:	MOVX T2,AR%RAR		; Bit to set
	HRRZ T1,Q3		; Get set/clear flag
	CAIN T1,.ARCLR		; Request to clear request?
	JRST ARRAR1		; Yes, can always clear it
	LOAD T1,FBBBT,(P3)	; Get CTL bits
	TXNE T1,AR%EXM		; File exempt ?
	RETBAD(ARCX10)		; Yes, don't allow request
	LOAD T1,FBFLG,(P3)	; Check some others too
	TXNE T1,FB%OFF!FB%PRM!FB%DIR!FB%ARC!FB%TMP
	RETBAD(ARCX10)		; Can't do it
ARRAR1:	PUSH P,T2		; Our bits will be stomped on
	CALL CKWOWN		; Have write or owner access?
	 RETBAD(,<ADJSP P,-1>)	; No, fail
	POP P,T2		; Recover them
	HRRZ T1,Q3		; Get set/clear code
	CAIN T1,.ARSET		; Set it?
	IORM T2,.FBBBT(P3)	; Yes
	CAIN T1,.ARCLR		; Clear the bit?
	ANDCAM T2,.FBBBT(P3)	; Yes
	TXNE T2,AR%NAR		; Did we say please don't?
	RETSKP			; Yes, done here
	CAIN T1,.ARCLR		; Have cleared the request?
	JRST [	SETZRO <K0NAR,K0NDL>,(P3) ; Clear resist & don't flush
		RETSKP]		; And exit
	CALL CLRBOT		; Clear any previous stuff (migrated?)
	SETZRO K0NAR,(P3)	; Can't still be resist now
	MOVX T2,AR%NDL
	TXNE Q3,AR%NDL		; Caller want don't flush set?
	IORM T2,.FBBBT(P3)	; Yes, do that
	RETSKP
; Involuntary migration; File exempt from migration

ARRIV:	HRRZS Q3		; No options through here
				;  - we may exit through ARRAR
	CAIN Q3,.ARCLR		; Clear migration request?
	JRST ARRIV1		; Yes, always valid (gotta be WHOPR)
	LOAD T1,FBBBT,(P3)
	TXNE T1,AR%EXM!AR%RAR	; File exempt from migration?
	RETBAD(ARCX15)		; Yes, fail
	LOAD T1,FBFLG,(P3)
	TXNE T1,FB%OFF!FB%PRM!FB%DIR!FB%ARC!FB%TMP
	RETBAD(ARCX15)		; Can't if any of those
ARRIV1:	CALL CKARDF		; Archive default for directory?
	CAIA
	JRST ARRAR		; Yes, turn migration into archive
	MOVX T2,AR%RIV		; Invlountary migration
	JRST AREXM1		; Join farther down

AREXM:	LOAD T1,FBFLG,(P3)
	TXNE T1,FB%OFF		; Offline?
	RETBAD(ARCX16)		; One of the 3 anyway
	MOVX T2,AR%EXM		; Exempt
AREXM1:	MOVE T1,CAPENB
	TXNN T1,SC%WHL+SC%OPR	; Have necessary caps?
	RETBAD(CAPX1)		; No
	LOAD T1,FBFLG,(P3)	; Get ctl flags
	HRRZ T1,Q3		; Get set/clear flag
	CAIN T1,.ARSET		; Set it?
	IORM T2,.FBBBT(P3)	; Yes
	CAIN T1,.ARCLR		; Clear it?
	ANDCAM T2,.FBBBT(P3)	; Yes
	TXNE T2,AR%RIV		; Migration request?
	RETSKP
	CAIN T1,.ARCLR		; Clearing exempt?
	RETSKP			; Yes, done here
	SETZRO <K0RIV,K0RAR,K0NDL>,(P3) ; Clear migration request (if any)
	CALLRET CLRBOT		;  and discard any tape info
; Request file be retrieved from offline storage

ARRFR:	LOAD T1,FBFLG,(P3)
	TXNN T1,FB%OFF		; Offline?
	RETBAD(ARCFX9)		; No, fail
	TXNE Q3,AR%WAT		; Caller waiting?
	SKIPN NRTWTS		; Waits allowed?
	CAIA			; Not waiting, or waits allowed
	RETBAD(ARCX18)		; Say can't do it right now

; %%% check to see if caller has space left for this file

	HRRI T1,.RETM		; Send a retrieve message
	HRLI T1,.RETR		; Default is normal request
	TXNE Q3,AR%WAT		; User waiting?
	HRLI T1,.RETRW		; Yes, relay that info
	MOVE T2,P3		; FDB offset
	CALL ARCMSG		; Send the msg
	 RETBAD(ARCX13)		; Failed, IPCF message didn't happen
	MOVX T1,AR%RFL
	ANDCAM T1,.FBBBT(P3)	; Clear any old request failed flag
	TXNN Q3,AR%WAT		; Done?
	RETSKP			; Yes

ARRFR1:	CALL USTDIR		; Unlock & make ourself interruptable
	CALL UNLCKF
RETTST:	MOVX T1,^D2*^D60*^D1000	; Busy wait for file to appear
	DISMS
	XCTU [HRRZ JFN,1]	; Recover the JFN
	CALL CKJFN		; Re-check things, GET T1/ FDB ADDR
	LOAD T2,FBFLG,(T1)	; Get flags
	TXNN T2,FB%OFF		; Still offline?
	RETSKP			; Is back!
	MOVX T2,AR%RFL		; Restore failed bit
	TDNN T2,.FBBBT(T1)	; Did it?
	JRST ARRFR1		; No, wait some more
	ANDCAM T2,.FBBBT(T1)	; Yes, clear the failure bit
	CALL UPDDIR		; Get it back to disc
	RETBAD(ARCX14)		; Tell 'em it failed
; Restore contents of an offline file

ARRST:	MOVE T1,CAPENB
	TXNN T1,SC%OPR+SC%WHL	; Permitted?
	RETBAD(CAPX1)		; No
	LOAD T1,FBFLG,(P3)	; Get flags
	TXNN T1,FB%OFF		; File offline?
	RETBAD(ARCFX9)		; No, fail here
	TQNE <OPNF>		; Cannot be open
	ERRJMP OPNX1,ARCFX
	SKIPE .FBADR(P3)	; File have contents?
	BUG(OFFONX)
	PUSH P,STS
	PUSH P,JFN		; Save stuff
	PUSH P,DEV
	CALL USTDIR		; Release it
	UMOVE JFN,3		; Get 2nd JFN
	CALL CHKJFN		; Can't use CKJFN
	 JRST ARCF1X		; Fails
	 JFCL
	 ERRJMP DESX4,ARCF1X
	TQNE <ASTF>		; Output *'s?
	ERRJMP DESX7,ARCFXX	; Yes, bomb
	HRRZ T1,DEV		; Get device dispatch table address
	HRRZ T1,NLUKD(T1)
	CAIE T1,MDDNAM		; Disc?
	ERRJMP ARCFX3,ARCFXX
	CALL GETFDB
	ERRJMP DESX3,ARCFXX
	MOVE P3,T1		; Copy FDB offset
	TQNE <OPNF>
	ERRJMP OPNX1,ARCFXX	; Can't be open
	CAME DEV,0(P)		; Gotta be same device too
	ERRJMP ARCFX5,ARCFXX
	SKIPN Q1,.FBADR(P3)	; Get page tbl ptr from file w/ contents
	ERRJMP RNAMX9,ARCFXX	; Can't do that...
	CALL CKAROF		; Archived or offline?
	 JRST ARCFXX		; Yes, can't use that as a source
	MOVE T1,Q1		; Index block address
	TLO T1,(THAWB)		; Restrict access
	LOAD B,STR,(JFN)	; Get structure no. from JFN block
	CALL ASFOFN
	 JRST [ MOVE T2,T1	; Busy or bad PT
		SETO T1,
		CAIE T2,OPNX9	; Busy?
		 JRST .+1	; No, go ahead
		MOVEI T1,RNMX10
		JRST ARCFXX]	; Bomb
	PUSH P,T1		; Save OFN

;...
; More of ARRST

	PUSH P,.FBCTL(P3)	; Save flags
	PUSH P,Q1		; Save addr
	PUSH P,.FBBYV(P3)	; # of pages etc.
	PUSH P,.FBSIZ(P3)	; And EOF
	SETZRO FBADR,(P3)	; Clear it, avoid multiple ptrs
	SETONE <FBNXF,FBDEL>,(P3) ; Delete the file
	LOAD T2,FBNPG,(P3)	; Get page count of source file
	MOVNS T2
	MOVE T3,DIRORA		; Base of directory area
	OPSTRM <ADDM T2,>,DRDCA,(T3) ; Reduce source dir pg cnt
	MOVE T4,P3
	CALL DELFIL		; Kill it
	 JFCL			; Was PRM???
	CALL UPDDIR		; Update source dir
	CALL USTDIR		; Done with it
	MOVE T1,-4(P)		; OFN of source we've clobbered
	SKIPL T1
	CALL RELOFN
	CALL UNLCKF
	CALL RELJFN		; Release it entirely
	MOVE STS,-7(P)
	MOVE JFN,-6(P)		; Now turn our attention to dest
	MOVE DEV,-5(P)
	CALL GETFDB
	 BUG(ARSTXX)
	POP P,.FBSIZ(T1)	; Fix up # of bytes
	POP P,.FBBYV(T1)	;  and # of pages
	POP P,.FBADR(T1)	;   and file address
	POP P,T2		; Flags from source
	TXZ T2,FB%TMP+FB%NEX+FB%NXF+FB%OFF ; Don't copy these over
	IORM T2,.FBCTL(T1)	; Put in dest
	MOVX T2,FB%INV		;GET SET
	ANDCAM T2,.FBCTL(T1)	;MAKE SURE THE FILE IS VISIBLE NOW
	ADJSP P,-1		; Dump OFN
	LOAD T2,FBNPG,(T1)	; Get no. pages in dest. file
	MOVE T3,DIRORA
	OPSTRM <ADDM T2,>,DRDCA,(T3) ; Update dir total
	SETZRO FBOFF,(T1)	; Is online now...
	POP P,DEV
	POP P,JFN
	POP P,STS
	RETSKP			; Done

ARCFXX:	CALL USTDIR		; Release current JFN
	CALL UNLCKF
ARCF1X:	POP P,DEV
	POP P,JFN
	POP P,STS
	CALL UNLCKF
	ITERR ()
; Discard tape status

ARDIS:	LOAD T1,FBFLG,(P3)
	TXNE T1,FB%OFF		; Offline?
	RETBAD(ARCFX4)		; File not online
	UMOVE Q1,3		; Get user's options
	ANDX Q1,AR%CR1+AR%CR2	; Take those we know about
	TXC Q1,AR%CR1+AR%CR2
;**;[1945] Change 1 line at ARDIS:+6L	RMT	15-SEP-81
	JUMPE Q1,ARDS1		; [1945] Do both
	MOVE T1,CAPENB
	TXNN T1,SC%WHL+SC%OPR	; Allowed?
	RETBAD(CAPX1)		; No
	TXC Q1,AR%CR1+AR%CR2	; Restore request flags
	TXNE Q1,AR%CR2
	CALL CLR2ND
	TXNE Q1,AR%CR1
	CALL CLR1ST		; Do first set
	SKIPN .FBTP1(P3)	; 1st tape say anything?
	SKIPE .FBTP2(P3)	; 2nd?
	RETSKP			; Yes
	SETZRO FBARC,(P3)	; Clear archive status
	SETZRO <K0NDL,K0RSN>,(P3) ; Clear don't flush request too
	SETZRO FBTDT,(P3)	; Clear tape TAD
	SETZRO FBFET,(P3)	; Offline expiration meaningless now
	RETSKP

;**;[1945] Add 2 lines at ARDIS:+22L	RMT	15-SEP-81
ARDS1:	SETZRO <K0NDL,K0RSN,K0RAR>,(P3) ; [1945] Clear and flush request
	SETZRO FBFET,(P3)	; [1945] Offline expiration meaningless now
				; [1945] Fall into CLRBOT to clear both tapes

; Note that AREXM may enter at CLRBOT, also DSKOPN calls CLRBOT

CLRBOT::JE <FBARC>,.FBCTL(P3),CLRBO1 ; Archived file?
	MOVE T1,[.ACLR,,.NOTM]	; Notification: archive sts cleared
	MOVE T2,P3		; FDB offset
	CALL ARCMSG		; Send message to user
	 RETBAD(ARCX13)		; Say failed & why
CLRBO1:	CALL CLR1ST
	CALL CLR2ND
	SETZRO FBTDT,(P3)	; Clear tape-write date & time
	SETZRO <K0RFL,K01ST,ARPSZ>,(P3) ; Clear tape-related data
	SETZRO FBARC,(P3)	; Clear archive status flag
	RETSKP			; Finished

CLR1ST:	SETZRO TFN1,(P3)	; Clear tape file #
	SETZRO TSN1,(P3)	; Clear save set #
	SETZRO ARTP1,(P3)	; And tape #
	RET

CLR2ND:	SETZRO TFN2,(P3)	; Clear tape file #
	SETZRO TSN2,(P3)	; Clear save set #
	SETZRO ARTP2,(P3)	; Clear tape #
	RET
; Set archive status for a file

ARSST:	MOVE T1,CAPENB
	TXNN T1,SC%WHL+SC%OPR
	RETBAD(CAPX1)		; Not enough caps
	LOAD T1,FBFLG,(P3)
	TXNE T1,FB%OFF		; Off-line?
	RETBAD(ARCFX4)		; Not on-line
	TXNE T1,FB%NOD!FB%DIR!FB%PRM!FB%TMP
	RETBAD(ARCFX7)		; Not allowed
	LOAD T1,FBBBT,(P3)	; Get archive bits
	TXNE T1,AR%EXM		; Exempt from archiving?
	RETBAD(ARCX10)		; Yes
	UMOVE Q2,.AROFL(Q3)	; Get flags
	TXNN Q2,AR%O1+AR%O2	; Asking for 1 or both passes?
	RETBAD(ARCFX7)		; Neither, garbage
ARSST1:	TXCE Q2,AR%O1		; Do run 1 stuff?
	CALL SET1ST		; Yes, do that pass
	TXCE Q2,AR%O2		; 2nd run stuff?
	CALL SET2ND		; Yes, do that too
	XCTU [SKIPN T1,.ARODT(Q3)] ; User supply a TAD?
	CALL LGTAD		; No, get now
	STOR T1,FBTDT,(P3)	; Set date & time
	CALL CKARDF		; Default to archive?
	CAIA			; No
	TXO Q2,AR%ARC		; Yes, force that option on
	MOVX T1,FB%ARC
	TXNE Q2,AR%ARC		; Mark as archived?
	IORM T1,.FBCTL(P3)	; Yes, do that
	SKIPN T1,ARRCYC		; Get archive recycle time
	MOVX T1,.STDAE		; NONE SET, USE DEFAULT
	TXNE Q2,AR%ARC		; Did we archive this?
	MOVEM T1,.FBFET(P3)	; Yes, put in special offline time
	LOAD T2,FBBBT,(P3)	; Get bits
	MOVX T1,.AREXP		; Assume file expired
	TXNE T2,AR%RAR
	MOVX T1,.ARARR		; File archived
	TXNE T2,AR%RIV
	MOVX T1,.ARRIR		; File migration requested
	STOR T1,K0RSN,(P3)	; Remember why we did this
	MOVX T1,AR%RAR!AR%RIV	; Request bits
	TXNE Q2,AR%CRQ		; Clear the requests?
	ANDCAM T1,.FBBBT(P3)	; Yes, clear migration & archive rq
	TXNN Q2,AR%OFL		; Want a flush?
	RETSKP			; No, done here
	SKIPE .FBTP1(P3)	; See if both sets of tape info set
	SKIPN .FBTP2(P3)
	RETSKP			; Not all tape info around
	MOVE T4,P3		;GET FDB ADDRESS IN T4 FOR FSHFIL
	CALL FSHFIL		; Delete contents of the file
	 RETBAD()		; Failed
	MOVE T4,P3		; FDB offset
	XCTU [SKIPE T1,.ARPSZ(Q3)] ; Get offline page count
	STOR T1,ARPSZ,(P3)	; If not 0, restore it into FDB
	RETSKP			; Done

SET1ST:	XCTU [MOVE T1,.ARTP1(Q3)] ; Get tape id
	LOAD T2,ARTP2,(P3)	; Get other tape ID (shouldn't be one)
	CAMN T2,T3		; A match?
	RETBAD(ARCFX7)		; Yes, not allowed
	STOR T1,ARTP1,(P3)	; Set tape tape id
	ULOAD T1,AR%TSN,.ARSF1(Q3) ; Get saveset #
	STOR T1,TSN1,(P3)	; And saveset #
	ULOAD T1,AR%TFN,.ARSF1(Q3) ; Get tape file #
	STOR T1,TFN1,(P3)	; And set tape file #
	RET

SET2ND:	XCTU [MOVE T3,.ARTP2(Q3)] ; Get tape #, run 2
	LOAD T2,ARTP1,(P3)	; Get run 1 tape #
	CAMN T2,T3		; Match?
	RETBAD(ARCFX7)		; Yes, not allowed
	ULOAD T1,AR%TFN,.ARSF2(Q3) ; Get tape file #
	STOR T1,TFN2,(P3)	; Set tape file #
	ULOAD T1,AR%TSN,.ARSF2(Q3) ; Get saveset #
	STOR T1,TSN2,(P3)	; Save set #
	STOR T3,ARTP2,(P3)	; And tape #
	RET
; Get tape info for caller

ARGST:	XCTU [	SETZM .AROFL(Q3)] ; Never return this word
	LOAD T1,ARTP1,(P3)	; Get tape #
	XCTU [	MOVEM T1,.ARTP1(Q3)] ; 1st tape #
	LOAD T1,TFN1,(P3)	; Tape file #
	USTOR T1,AR%TFN,.ARSF1(Q3) ; Return tape file # 1
	LOAD T1,TSN1,(P3)	; Get saveset #
	USTOR T1,AR%TSN,.ARSF1(Q3) ; Return it
	LOAD T1,ARTP2,(P3)	; Get 2nd tape #
	XCTU [	MOVEM T1,.ARTP2(Q3)]
	LOAD T1,TFN2,(P3)	; Get tape file #
	USTOR T1,AR%TFN,.ARSF2(Q3) ; Return it
	LOAD T1,TSN2,(P3)	; Get saveset # 2
	USTOR T1,AR%TSN,.ARSF2(Q3)
	LOAD T1,FBTDT,(P3)	; Get tape write
	XCTU [	MOVEM T1,.ARODT(Q3)]
	LOAD T1,ARPSZ,(P3)	; Get # of pages when pushed offline
	XCTU [	MOVEM T1,.ARPSZ(Q3)]
	RETSKP

; Flag that the restore failed (tell waiting process)

ARRFL:	MOVE T1,CAPENB
	TXNN T1,SC%WHL!SC%OPR	; Caller have caps necessary?
	RETBAD(CAPX1)		; No, tell him
	MOVX T1,AR%RFL
	IORM T1,.FBBBT(P3)	; Set it
	RETSKP
; Check for valid JFN etc.; also setup FDB

CKJFN:	CALL CHKJFN		; Check validity
	 ITERR ()		; Garbage
	 JFCL
	 ITERR (DESX4)		; Tty or byte ptr
	TQNE <ASTF>		; Output *'s?
	ERRJMP DESX7,ARCFXY	; Bomb with unlock
	HRRZ T1,NLUKD(P3)
	CAIE T1,MDDNAM
	ERRJMP ARCFX3,ARCFXY	; No FDB for non MDD devices
	CALL GETFDB		; Get the FDB
	 ERRJMP DESX3,ARCFX	; No FDB
	LOAD T2,FBLEN,(T1)	; Get length
	CAIGE T2,.FBLXT		; Should be at least this big
	ERRJMP ARCX17,ARCFX	;  or we can't do anything with the file
	RET

; Check file for write or owner access

CKWOWN:	MOVE T2,CAPENB
	TXNE T2,SC%WHL+SC%OPR	; Have special privs?
	RETSKP			; Yes, win that way
	MOVE T1,P3		; FDB offset ptr
	MOVX T2,WRTF		; Check write access first
	CALL ACCCHK
	 CAIA			; Don't have that
	RETSKP			; Ok, go with write access
	MOVX T2,XCTF		; Check for owner like privs
	CALL DIRCHK
	 RETBAD(CFDBX2)		; No access to file
	RETSKP			; Ok, proceed with owner access

; Check to see if file has archive status, or is offline

CKAROF:	LOAD T1,FBFLG,(P3)	; Get bits
	TXNE T1,FB%ARC		; Archive status?
	RETBAD(ARCFX2)		; Right
	TXNE T1,FB%OFF		; Offline?
	RETBAD(ARCFX4)		; Yes it is
	RETSKP			; File is fine

CKNAON:	LOAD T1,FBFLG,(P3)
	TXNN T1,FB%ARC		; Archived?
	RETBAD(ARCFX6)		; No
	TXNN T1,FB%OFF		; Offline?
	RETBAD(ARCFX9)		; No
	RETSKP

; See if the default is to archive rather than migrate a file

CKARDF:	HRRZ T1,FILDDN(JFN)	; Get directory # file is from
	MOVE T3,DIRORA		; Where directories live
	LOAD T2,DRNUM,(T3)	; Get mapped directory #
	CAME T1,T2		; They match?
	 BUG(ARCASS)
	LOAD T1,DRMOD,(T3)	; Get mode bits
	TXNE T1,CD%DAR		; Is the default to archive ?
	RETSKP			; Yes
	RET			; No

;**;[1808] Change 1 line at ARACCK:-11L	PED	21-NOV-80
;Routine to check read, write, execute, and append access restrictions imposed [1808]
;by the archive/virtual disk system.
;
;CALL:	T1/FDB address
;**;[1808] Change 1 line at ARACCK:-6L	PED	21-NOV-80
;	T2/access request bits (FC%RD, FC%WR, FC%APP, FC%EX) [1808]
;	CALL ARACCK
;RETURNS T1/0 if OK, -1 if OK with discard of tape pointer,
;	    -2 if OK with discard of tape pointer and request bits,
;	    error code if not allowed.
;
ARACCK::PUSH P,T3
	PUSH P,T4
	SETZ T3,
;**;[1808] Change 1 line at ARACCK:+3L	PED	21-NOV-80
	TXNN T2,FC%RD!FC%EX	;[1808] Read/Execute access requested?
	JRST CKARST		;No, check write, append
;**;[1808] Change 1 line at ARACCK:+4L	PED	21-NOV-80
	JE FBOFF,(T1),CKARST	;[1808] Finished read/execute ck if online
	MOVEI T3,OPNX31		;Offline, fail (unless ret. wait set)
	JRST CKADON
CKARST:	TXNN T2,FC%WR!FC%APP	;Write or append requested?
	JRST CKADON		;No, done
	LOAD T4,FBLEN,(T1)
	CAIGE T4,.FBLXT		;FDB has tape info?
	JRST CKADON		;No
	LOAD T4,FBFLG,(T1)
	TXNE T4,FB%ARC		;Yes, File has archive status?
	MOVEI T3,OPNX30		;Yes, no modifications allowed
	LOAD T4,FBBBT,(T1)
	TXNE T4,AR%RAR		;File has archive request pending?
	MOVEI T3,OPNX30		;Yes, no modifications allowed
	JUMPG T3,CKADON		;Done with archived files
	SKIPN .FBTP1(T1)	;Ordinary file: tape 1 info there?
	SKIPE .FBTP2(T1)	;Tape 2 info there?
	CAIA			;Tape info exists, check further
	JRST CKADON		;Neither tape there
	TXNN T2,FC%WR		;Ordinary file: write access requested?
	JRST CKARAP		;No, check append
	SETO  T3,		;Yes, Ok with discard of tape info
	TXNN T3,FC%RD!FC%APP	;Read or append too?
	MOVNI T3,2		;No, discard migrate bit also
CKARAP:	TXNN T2,FC%APP		;Append requested?
	JRST CKADON		;No, done
	SETO T3,		;OK so far with discard of tape ptr
	JE FBOFF,(T1),CKADON	;Done if online
	MOVEI T3,OPNX31		;Offline, fail (unless ret. wait set)
CKADON:	MOVE T1,T3
	POP P,T4
	POP P,T3
	RET

; Assign device
; 1/ DEVICE DESIGNATOR
;	ASND
; Return
;	+1	; Error, not assignable or bad designator etc.
;	+2	; Ok, the device specified is now assigned to this job

.ASND::	MCENT
	STKVAR <ASNPAS,ASNUAR,ASNDIX>
	MOVEM T1,ASNUAR		;SAVE USER ARG
	SETZM ASNPAS		;FIRST PASS
ASND0:	CALL LCKDVL
	CALL CHKDEV		;CHECK DEVICE AND SEE IF ALREADY ASSIGNED
	 RETERR(,<UNLOCK DEVLCK>)
	MOVEM T2,ASNDIX		;SAVE INDEX INTO DEVICE TABLES
	TXNN C,DV%AS		;ASSIGNABLE DEVICE?
	RETERR(ASNDX1,<UNLOCK DEVLCK>)
	SKIPN ASNPAS		;FIRST PASS?
	JRST [	HLRZ T4,DEVUNT(T2) ;GET OWNING JOB
		CAMN T4,JOBNO	;THIS JOB?
		JRST .+1	;YES. DON'T BOTHER WITH ACJ THEN
		UNLOCK DEVLCK	;YES
		OKINT		;ALLOW INTS NOW
		MOVE T1,ASNUAR	;GET USER'S ARG
		GTOKM (.GOASD,T1,[RETERR ()])		;DO GETOK AND RETURN IF ERROR
		MOVE T1,ASNUAR	;GET BACK ARG
		AOS ASNPAS	;ON SECOND PASS NOW
		JRST ASND0]	;AND CONTINUE
	HRRZ P3,DEV		;GET DISPATCH TABLE
	CAIN P3,TTYDTB		;IS THIS A TERMINAL?
	JRST [	HLRZ B,DEV	;YES. GET LINE NUMBER
		CALL TTYASC	;ASSIGN THE LINE
		 RETERR (,<UNLOCK DEVLCK>) ;FAILED
		MOVE B,ASNDIX	;RESTORE INDEX TO DEVICE TABLES
		JRST .+1]
	CALL DSMNT0		;DISMOUNT IT IF NECESSARY
	 JFCL
	MOVSI A,(DV%ASN)
	MOVE B,ASNDIX		;RESTORE INDEX TO DEVICE TABLES
	IORM A,DEVCHR(B)	; Mark this device as assigned by asnd
	MOVE A,JOBNO
	HRLM A,DEVUNT(B)	; Assign to this job
	UNLOCK DEVLCK
	SMRETN
; Backup file pointer by 1 byte
; Call:	1	JFN
;	BKJFN
; Returns
;	+1	; Error, cannot backup this designator
;	+2	; Ok.

.BKJFN::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 RETERR()
	 JRST BKJTTY
	 JRST BKJBYT
	HRRZ A,DEV
	CAIN A,TTYDTB		; Tty?
	JRST BKJTT1
	TQNN <OPNF>
	RETERR(DESX5,<CALL UNLCKF>)
	MOVE A,FILBYN(JFN)
	SOJL A,[RETERR(SFPTX3,<CALL UNLCKF>)]
	CALL SFBNR
	 RETERR(,<CALL UNLCKF>)
	CALL UNLCKF
	SMRETN

;DEVICE IS A TERMINAL. CALL DEVICE-SPECIFIC ROUTINE

BKJTT1:	CALL UNLCKF
BKJTTY:	HLRZ 2,DEV
	CAIN T2,-1		;DETACHED?
	 RETERR (DESX6)		;YES
	CALL TTBKPT
	 RETERR			;ROUTINE HAS SET UP ERROR CODE
	SMRETN

BKJBYT:	MOVE A,JFN
	CALL DBP
	UMOVEM A,1
	SMRETN
; Change fdb
; Call:	LH(1)	; Offset
;	RH(1)	; Jfn
;	2	; Mask
;	3	; Data
;	CHFDB

.CHFDB::MCENT
	CALL CHFDB0		;DO THE WORK
	 ITERR ()		;ERROR OCCURED
	JRST MRETN		;SUCCESSFUL

CHFDB0:	STKVAR <CHFDBA,CHFDBD>
	XCTU [HRRZ JFN,T1]	;SETUP THE JFN
	ULOAD T1,CF%DSP,T1	;GET DISPLACEMENT
	MOVEM T1,CHFDBD		;SAVE IT
	CAIL A,.FBLEN
	RETBAD(CFDBX1)		; Offset too big
	CALL CHKJFN		; Check jfn
	 RETBAD()		; Garbage
	 JFCL
	 RETBAD(DESX4)		; Tty or byte illegal
	TQNE <ASTF>
	ERRJMP DESX7,CHFDX
	HRRZ A,NLUKD(P3)
	CAIE A,MDDNAM
;**;[3035] Replace one line at CHFDB0:+14L	CRJ	8-Nov-83
	 ERRJMP CFDBX5,CHFDX	;[3035] No FDB for non-MDD devices
	CALL GETFDB		; Get the fdb
	ERRJMP DESX3,CHFDX
	MOVEM A,CHFDBA		; SAVE FDB ADDRESS
	LOAD B,FBLEN,(A)	; Get the length of this FDB
	CAMG B,CHFDBD		; Is it the FDB bigger than offset?
	ERRJMP CFDBX1,CHFDB9	; No, loose
	MOVE D,CHFDBD		; GET OFFSET
	UMOVE B,2		; Mask
	OPSTR <SKIPE>,FB%DIR,.FBCTL(A) ;A DIRECTORY FILE?
	CAIE D,.FBCTL		;YES. CHANGING FLAG WORD?
	SKIPA			;NO. PROCEED
	JRST CHFDB6		;YES. CAN'T DO IT
	ANDCM B,WRTR(D)		; Writer bits?
	JUMPN B,CHFDB1		; No, check owner and wheel
	JAND <OPNF,WRTF>,,CHFDB2 ;IF FILE IS OPEN FOR WRITE, THEN OK
	MOVX B,FC%WR		; Yes check for write access
	CALL ACCCHK
	 JRST CHFDB1		; NO WRITER ACCESS, CHECK OWNER
	JRST CHFDB2		; Ok, go ahead

CHFDB1:	UMOVE B,2		; GET MASK AGAIN
;**;[1772] Revamp [1747] lines at CHFDB1: +1L	JGZ	28-AUG-80
;**;[1747] Add one line at CHFDB1: +1L	TJG	25-JUN-80
	MOVE D,CHFDBD		;[1747] RETRIEVE FDB INDEX
	ANDCM B,OWNER(D)
	JUMPN B,CHFDB4		; Requires mor than owner status
	MOVE A,CHFDBA		; GET THE FDB ADR AGAIN
	CALL NFACHK		; SEE IF THIS IS A NEW FILE
	 JRST CHFDB3		; NO, GO CHECK OWNER RIGHTS
	JRST CHFDB2		; YES, THEN GIVE OWNER RIGHTS TO CALLER
CHFDB3:	MOVX B,DC%CN
	CALL DIRCHK		;SEE IF USER CAN CONNECT (AND THUS BE LIKE
				; AN OWNER)
	 JRST CHFDB5
	JRST CHFDB2

CHFDB6:	MOVEI A,CFDBX2
CHFDB9:	CALL USTDIR		;UNLOCK DIRECTORY
CHFDX:	CALL UNLCKF		;UNLOCK JFN
	RETBAD ()
CHFDB4:	ANDCM B,WOPR(D)
	JUMPN B,CHFDB6		; Can't be done
CHFDB5:	MOVE B,CAPENB
	TRNN B,SC%WHL!SC%OPR
;**;[2651] MAKE CHANGES TO 2639 LINES AT CHFDB5:+2L	TAM	26-AUG-82
;**;[2639] REPLACE 1 LINE WITH 2 AT CHFDB5:+2L	TAM	30-JUL-82
	JRST [MOVEI T1,CFDBX3	;[2639][2651] WRITE OR OWNER ACCESS REQUIRED
	      JRST CHFDB9]	;[2639][2651] RETURN ERROR
CHFDB2:	MOVE A,CHFDBA		; GET THE FDB ADDRESS BACK
	ADD A,CHFDBD		; GET ADR OF DATA WORD IN FDB
	UMOVE C,3		; Data
	MOVE B,(A)		; Old data
	UMOVE D,2		; Mask
	AND C,D			; Retain masked bits of new data
	ANDCM B,D		; Flush bits to be replaced from old
	IOR B,C
	MOVE C,CHFDBD		; Get word index
	CAIN C,.FBCTL		; Flags word?
	 JRST CHFD10		; Yes, check things carefully
CHFDB8:	MOVEM B,(A)
;**;[2806] REPLACE 8 LINES WITH 20 AT CHFDB8:+1L	TAM	22-AUG-82
;[2806]	MOVE C,CHFDBD		;GET THE OFFSET
;[2806]	CAIE C,.FBSIZ		;SETTING THE SIZE
;[2806]	CAIN C,.FBBYV		;OR BYTE SIZE
;[2806]	TQNN <OPNF>		;YES, IS THE FILE OPEN?
;[2806]	JRST CHFDB7		;NO, DONT SET UP THE NEW LENGTH
;[2806]	MOVE C,CHFDBA		;GET THE ADR OF THE FDB
;[2806]	LOAD A,FBBSZ,(C)	;GET BYTE SIZE
;[2806]	LOAD B,FBSIZ,(C)	;GET LENGTH OF FILE
	TQNN <OPNF>		;[2806] YES, IS THE FILE OPEN?
	JRST CHFDB7		;[2806] NO, DONT SET UP THE NEW LENGTH
	HLRZ B,FILOFN(JFN)	;[2806] GET OFN
	TQNE <LONGF>		;[2806] LONG FILE?
	HRRZ B,FILOFN(JFN)	;[2806] YES, USE THIS ONE
	LOAD A,OFNBSZ,(B)	;[2806] GET FILE BYTE SIZE
	LOAD B,OFNBC,(B)	;[2806] AND LENGTH
	MOVE C,CHFDBD		;[2806] GET OFFSET
	CAIE C,.FBBYV		;[2806] BYTE SIZE WORD
	JRST CHFD12		;[2806] NO TRY BYTE COUNT
	TXNN D,FB%BSZ		;[2806] BYTE SIZE FIELD CHANGED?
	JRST CHFDB7		;[2806] NO DON'T UPDATE LENGTH
	MOVE D,CHFDBA		;[2806] GET FDB ADDR
	LOAD A,FBBSZ,(D)	;[2806] GET BYTE SIZE FROM FDB
	JRST CHFD11		;[2806] AND UPDATE LENGTH
CHFD12:	CAIE C,.FBSIZ		;[2806] LENGTH CHANGE?
	JRST CHFDB7		;[2806] NO DON'T UPDATE IT
	MOVE D,CHFDBA		;[2806] ADDR OF FDB
	LOAD B,FBSIZ,(D)	;[2806] GET LENGTH FROM FDB
CHFD11:				;[2806] UPDATE LENGTH
	CALL UPDFLN		;UPDATE THE LENGTH
CHFDB7:	UMOVE T2,T1		;GET ARG
	TXNN T2,CF%NUD		;UPDATE DIRECTORY NOW?
	CALL UPDDIR		;YES
	CALL USTDIR
	CALL UNLCKF
	RETSKP

CHFD10:	TXNN B,FB%DEL		; Changing state of deleted?
	 JRST CHFDB8		; No, proceed normally
	PUSH P,A		; SAVE FDB LOC
	PUSH P,B		; Save this
	MOVX B,FC%WR		; Write access necessary for delete
	CALL ARACCK		; Check archive/vir. disk requirements
	JUMPLE A,[POP P,B	; Recover mask
		POP P,A
		JRST CHFDB8]	; And proceed
	POP P,B			; Clean up stack
	POP P,A
	JRST CHFDB9		; Fail

; Access tables for chfdb

;BITS WHICH CAN BE CHANGED IF PROGRAM HAS WRITE ACCESS TO FILE

WRTR:	0			;FBTYP ,, FBLEN
;**;[3025] CHANGE 1 LINE AT WRTR:+1L	TAM	10-OCT-83
	FB%NOD+FB%FCF+FB%FOR	;[3025][2981] FBFLG
	0			;FBEXL
	0			;FBADR
	0			;FBPRT
	0			;FBCRE
	0			;FBAUT
	0			;FBGEN
	0			;FBACT
	007717000000		;FBGNR, FBBSZ, FBMOD ,, FBNPG
	777777777777		;FBSIZ
	777777,,777777		;FBCRV
	777777,,777777		;FBWRT
	777777,,777777		;FBREF
	0			;FBNWR ,, FBNRF
	0			;FBBK0
	0			;FBBK1
	0			;FBBK2
	0			;FBBBT
	0			;FBNET
	0			;FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
	0			;FBTDT
	0			;FBFET
	0			;FBTP1
	0			;FBSS1
	0			;FBTP2
	0			;FBSS2
;BITS WHICH CAN BE CHANGED IF PROGRAM HAS OWNER ACCESS TO FILE

OWNER:	0			;FBTYP ,, FBLEN
	FB%PRM+FB%TMP+FB%DEL+FB%NOD+FB%INV+FB%FCF+FB%FOR ;[2981] FBFLG
	0			;FBEXL
	0			;FBADR
	000000777777		;FBPRT
	0			;FBCRE
	0			;FBAUT
	0			;FBGEN
	0			;FBACT
	777717000000		;FBGNR, FBBSZ, FBMOD ,, FBNPG
	777777777777		;FBSIZ
	777777,,777777		;FBCRV
	777777,,777777		;FBWRT
	777777,,777777		;FBREF
	0			;FBNWR ,, FBNRF
	0			;FBBK0
	0			;FBBK1
	0			;FBBK2
	0			;FBBBT
	0			;FBNET
	777777777777		;FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
	0			;FBTDT
	0			;FBFET
	0			;FBTP1
	0			;FBSS1
	0			;FBTP2
	0			;FBSS2

;BITS WHICH CAN BE CHANGED IF PROGRAM HAS WHEEL OR OPERATOR CAPABILITIES

WOPR:	0			;FBTYP ,, FBLEN
;**;[3025]CHANGE 1 LINE AT WOPR:+1L	TAM	10-OCT-83
	FB%PRM+FB%TMP+FB%DEL+FB%NOD+FB%INV+FB%FCF+FB%FOR ;[2981][3025] FBFLG
	0			;FBEXL
	0			;FBADR
;**;[3025]CHANGE 1 LINE AT WOPR:+4L	TAM	10-OCT-83
	000000777777		;[3025] FBPRT
	777777777777		;FBCRE
	0			;FBAUT
	0			;FBGEN
	0			;FBACT
	777777,,777777		;FBGNR, FBBSZ, FBMOD ,, FBNPG
	-1			;FBSIZ
	777777777777		;FBCRV
	777777777777		;FBWRT
	777777777777		;FBREF
	777777777777		;FBNWR ,, FBNRF
	777777777777		;FBBK0 DUMPER INCREMENTAL SAVE DATA
	0			;FBBK1
	0			;FBBK2
	AR%1ST+AR%WRN		;FBBBT
	0			;FBNET
;**;[3025]CHANGE 1 LINE AT WOPR:+20	TAM	10-OCT-83
	777777777777		;[3025] FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
	0			;FBTDT
	0			;FBFET
	0			;FBTP1
	0			;FBSS1
	0			;FBTP2
	0			;FBSS2
; Close a file
; Call:	RH(1)	; Jfn
;	1(0)	; If 1 do not release jfn
;	CLOSF
; Returns
;	+1	; Cannot close
;	+2	; Ok

.CLOSF::MCENT
	CAMN 1,[-1]		; -1 means all
	JRST CLZALL
	HRRZ JFN,1
	CAIE JFN,.PRIIN		;PRIMARY DESIGNATOR?
	CAIN JFN,.PRIOU
	SMRETN			;YES, DO NOTHING BUT RETURN GOOD
	CALL CLZF
	 RETERR()		; Can't close, reason in a
	XCTU [SKIPL 1]		; Don't release jfn
	TQNE <OPNF>		; Or still open?
	SMRETN			; Yes. all done.
	CALL RELJFN		; No, release jfn.
	SMRETN

CLZALL:	MOVEI A,.FHSLF		;SAME AS CLZFF ON SELF
	CLZFF
	SMRETN
;CLOSF...

CLZF::	MOVEI A,CLSX2
	HRRZ B,PRIMRY
	HLRZ C,PRIMRY		;DONT CLOSE PRIMARY IN OR OUT
	CAME JFN,C
	CAMN JFN,B
	RET
	PUSH P,JFN		;SAVE THIS IN CASE OF BLOCK
	CALL CHKJFD
	 JRST [	POP P,(P)	; Garbage
		RET]
	 JFCL
	 JRST [	POP P,(P)	; Byte and tty always succeeds
		RETSKP]
	TQNN <OPNF>
	JRST [	POP P,(P)
		MOVEI A,CLSX1
		JRST UNLCKF]
	MOVSI B,1
	ANDCAB B,FILLFW(JFN)
	TLNE B,777777
	JRST [	CALL CLZMRC	;TRY TO REASSIGN MAP COUNT
		 SKIPA		;FAILED, PAGES STILL MAPPED
		JRST .+1	;MAP COUNT NOW 0
		CALL CLZMFE	;MAKE FILE EXISTENT
		POP P,0(P)	;CLEAR STACK
		HRRZ A,DEV	;GET DEVICE TYPE
		CAIN A,DSKDTB	;IS THIS A DISK?
		CALL DEWNDW	;YES. FREE UP WINDOW PAGE THEN
		CALL UNLCKF	;UNLOCK THE JFN
		RETBAD(CLSX3)]	;SAY STILL MAPPED
	UMOVE A,A
	AND A,[CZ%ABT+CZ%NUD]	;ACCEPT ONLY THESE FLAGS
	MOVE B,0(P)		;PASS DOWN JFN
	CALL CLZDO		;DO DEVICE CLOSE AND DEASSIGN STUFF
	 JRST CLZFW		;DIDNT CLOSE, SEE IF BLOCKING
CLZF2:	POP P,(P)		;CLEAR OUT STACK
	CALL UNLCKF
	RETSKP

CLZFW:	TQZN <BLKF>		;DOES SERVICE ROUTINE WANT TO BLOCK?
	 JRST [POP P,(P)	;NO, CLEAR OUT STACK
		CALLRET UNLCKF]	;AND UNLOCK AND RETURN UNSUCCESSFULLY
	MOVSI B,1		;RESTORE MAP COUNT AGAIN SO THAT
	IORM B,FILLFW(JFN)	; FILES ARE NOT INADVERTANTLY CLOSED
	CALL UNLDIS		;YES, GO BLOCK
	POP P,JFN		;GET BACK THE JFN AGAIN FOR CHKJFN
	SE1ENT
	JRST CLZF		;TRY AGAIN
;TRY TO REASSIGN MAP COUNT FROM THIS JFN TO SOME OTHER JFN
;WITH THE SAME OFN
; JFN/ THE JFN INDEX
;	CALL JFNRMC
; RETURN +1: FAILED, COUNT STILL NON-0
; RETURN +2: OK, COUNT NOW 0

CLZMRC:	MOVEI A,0(JFN)		;GET JFN
	CALL DMOCHK		;SEE IF DISMOUNTED
	 RETSKP			;IT IS. SAY IT SUCCEEDED
	MOVX A,OPNF		;CLEAR OPNF SO OFNJFN WILL NOT FIND
	ANDCAM A,FILSTS(JFN)	;THIS JFN
	MOVEI A,0		;SAY PAGE 0
	CALL JFNOF1		;CONSTRUCT ID FOR PAGE 0 THIS FILE
	 JRST CLZMRX		;COULDN'T, FAIL
	CALL OFNJFN		;FIND A JFN FOR THIS OFN
	 JRST CLZMRX		;COULDN'T, FAIL
	HLRZ B,A		;MAKE JFN INDEX FROM JFN JUST FOUND
	IMULI B,MLJFN		; CONVERT TO INTERNAL INDEX
	HLLZ A,FILLFW(JFN)	;GET COUNT FROM ORIG JFN
	ADDM A,FILLFW(B)	;MOVE IT TO NEW JFN
	HRRZS FILLFW(JFN)	;CLEAR IT FROM ORIG JFN
	MOVX A,OPNF
	IORM A,FILSTS(JFN)	;RESTORE OPNF
	RETSKP

CLZMRX:	MOVX A,OPNF		;RESTORE OPNF
	IORM A,FILSTS(JFN)
	RET

;MAKE FILE EXISTENT.  DONE WHEN FILE CANNOT BE CLOSED BECAUSE OF
;NON-0 MAP COUNT, BECAUSE LATER CLOSE MIGHT BE DONE BY CLZFF WITH
;CZ%ABT WHICH WOULD VANISH NON-EXISTENT FILE

CLZMFE:	CALL GETFDB		;GET THE FDB FOR THIS JFN
	 RET			;COULDN'T, ASSUME OK
	MOVX B,FB%NXF
	TDNE B,.FBCTL(A)	;DON'T CAUSE WRITE IF ALREADY CLEAR
	ANDCAM B,.FBCTL(A)	;CLEAR NONX
	CALLRET USTDIR		;RELEASE DIRECTORY AND RETURN
;CLOSE FILES RELATIVE TO SPECIFIED FORK
; 1/	CZ%NIF (B0) - NO INFERIOR FORK FILES
;	CZ%NSF (B1) _ NOT AT SPECIFIED FORK
;	CZ%NFJ (B2) - NO RELEASE JFN'S
;	CZ%NCL (B3) - NO CLOSE FILES
;	CZ%UNR (B4) - UNRESTRICT FILES
;	CZ%ARJ (B5) - WAIT UNTIL MAP COUNT IS 0
;	CZ%ABT (B6) - ABORT, I.E. FLUSH NONX FILES AND NO WAIT FOR IO
;	CZ%NUD (B7) - NO UPDATE DIRECTORY
;	RH: FORK HANDLE
;	CLZFF
; RETURN +1: ALWAYS
; Traps if fork handle is bad

.CLZFF::MCENT
CLZFF0:	HRRZS A
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	MOVX T2,<CALL CLZFF1>	;ROUTINE TO DO
	CALL MAPFKH		; Call routine to map over the fork hdl
	 JRST [	CALL FUNLK	;BLOCKING
		CALL UNLDIS	;WAIT FOR CONDITION TO BE SATISIFED
		UMOVE A,1	;GET BACK USER'S ARGS
		JRST CLZFF0]	;AND TRY AGAIN
	CALL FUNLK		;UNLOCK THE FORK STRUCTURE
	JRST MRETN
;ROUTINE CALLED FOR EACH FORK SPECIFIED

CLZFF1:	MOVN JFN,MAXJFN
	HRLZS JFN

;LOOP OVER ALL JFNS

CLZFF2:	HLRZ B,PRIMRY
	CAIN B,(JFN)
	JRST CLZFF3		; Don't affect primary files
	HRRZ B,PRIMRY
	CAIN B,(JFN)
	JRST CLZFF3
	PUSH P,JFN
	PUSH P,1
	HRRZS A,JFN
	JUMPE A,CLZFF4		;ALWAYS SKIP 0
	IMULI A,MLJFN		; CONVERT TO INTERNAL INDEX
	SKIPL FILLCK(A)		;FILE LOCKED NOW?
	JRST CLZFF4		;YES, DON'T TRY TO CLOSE IT
	CALL CHKJFD		; See if this jfn is in use
	 JRST CLZFF8		; NO NAME, CHECK FOR ASGF
	 JRST CLZFF4		; Should not happen
	 JRST CLZFF4
	MOVSI B,777777
	TQNE <OPNF>		; If file is open
	TDNE B,FILLFW(JFN)	; And map count is zero
	SKIPA
	JRST CLZFF5		; Then it's ok to close it
	UMOVE C,1		;GET USER FLAGS
	HLRZ B,FILVER(JFN)
	MOVE A,(P)
	CAMN B,A		; Was this jfn created by this fork
	JRST [	TLNE C,(CZ%NSF)	; Are we to close files at the fork?
		JRST CLZFF7	; No, skip this jfn
		JRST CLZFF5]	; Yes, do it
	TXNE C,CZ%NIF		;CLOSE FILES OF INFERIOR FORKS?
	JRST CLZFF7		;NO, SKIP THIS JFN
	EXCH A,B
	CALL SKIIFA		; Skip if fork(a) < fork(b)
	JRST CLZFF7
	; ..
;CLZFF...

CLZFF5:	UMOVE C,1
	TLNE C,(CZ%UNR)		; Un restrict this file?
	TQZ <FRKF>		; Yes
	TQNE <OPNF>
	TLNE C,(CZ%NCL)
	JRST CLZFF6
	MOVSI B,1
	ANDCAB B,FILLFW(JFN)
	TLNN B,777777		;MAP COUNT NOW 0?
	JRST CLZFM1		;YES, CLOSE
	CALL CLZMRC	;NO, TRY TO REASSIGN COUNT
	 SKIPA		;COULDN'T
	JRST CLZFM1	;COUNT NOW 0, OK TO CLOSE
	UMOVE C,1	;GET FLAGS
	TXNN C,CZ%ABT	;FLUSH NONX FILES?
	CALL CLZMFE	;NO, MAKE SURE THIS ONE EXISTS
	UMOVE C,1
	TXNN C,CZ%ARJ	;WAIT FOR 0 MAP COUNT?
	JRST CLZFF7	;NO, DON'T CLOSE
	SKIPN FORKN	;TOP FORK OF THE JOB?
	JRST [	CALL CKMMOD	;AND FROM MONITOR MODE?
		JRST .+1	;NO, GO ON THEN
		HRRZS FILLFW(JFN)	;YES, IS LOGOUT, CLEAR COUNT
		JRST CLZFM1]	;AND PROCEED
	CALL UNLCKF	;UNLOCK JFN
	CALL FUNLK		;RELEASE FORK LOCK
	MOVEI A,^D1000	;WAIT 1 SEC
	DISMS
	CALL FLOCK		;GET FORK LOCK AGAIN
	POP P,1		;RESTORE AND TRY AGAIN
	POP P,JFN
	JRST CLZFF2

CLZFM1:	UMOVE A,1		;GET FLAGS SET BY USER
	MOVE B,-1(P)		;PASS DOWN JFN
	CALL CLZDO		;DO THE WORK
	 JRST CLZFFW		;FAILED TO CLOSE, CHECK IF BLOCKING
CLZFF6:	UMOVE C,1
	SE1ENT
	TQNN <OPNF>
	TLNE C,(CZ%NRJ)
	JRST CLZFF7
	MOVEI A,0(JFN)		;GET JFN
	CALL LUNLK0		;FREE UP STR LOCK
CLZFF9:	CALL RELJFN
	JRST CLZFF4

CLZFF7:	CALL UNLCKF
CLZFF4:	POP P,1
	POP P,JFN
CLZFF3:	AOBJN JFN,CLZFF2	;LOOP OVER ALL JFNS
	RET
;HERE ON +1 RETURN FROM CHKJFN, I.E. JFN DOESN'T EXIST OR IS RESTRICTED

CLZFF8:	CAIN A,DESX3		;BEING ASSIGNED?
	TQNN <ASGF>
	JRST CLZFF4		;NO, SKIP IT
	HLRZ B,FILVER(JFN)	;GET FORK
	SKIPGE SYSFK(B)		;FORK STILL EXISTS?
	JRST CLZFF9		;NO, RELEASE JFN
	CAME B,FORKN		;THIS FORK?
	JRST CLZFF4		;NO, SKIP IT
	SKIPE PSIBIP		;AT INTERRUPT LEVEL?
	JRST CLZFF4		;YES, LEAVE IT ALONE
	JRST CLZFF9		;NO, RELEASE IT

;HERE IF CAN'T CLOSE BECAUSE SERVICE ROUTINE WANTS TO BLOCK

CLZFFW:	SE1ENT
	TQZN <BLKF>		;SERVICE ROUTINE WANT TO BLOCK?
	 JRST CLZFF7		;NO, GO UNLOCK AND EXIT
	UMOVE B,1		;GET USER FLAGS AGAIN
	TXNE B,CZ%ABT	;WAS THE USER TRYING TO ABORT?
	 BUG(CLZABF)
	ADJSP P,-2		;CLEAN UP STACK
	RETSKP			;INDICATE WE WANT TO BLOCK
;COMMON DEVICE CLOSE FOR CLOSF AND CLZFF
;CALLED WITH CLZFF FLAGS IN A, ORIGINAL JFN I B
;RETURNS +1	NOT CLOSED OR ABOUT TO BLOCK IF BLKF IS 1
;	 +2	CLOSED OK

CLZDO:	STKVAR <CLZDOA,CLZDOJ>
	MOVEM A,CLZDOA		; SAVE FLAGS
	MOVEM B,CLZDOJ		; SAVE JFN
	CALL CHKENQ		; CHECK IF CLOSING IS ALLOWED BY ENQ/DEQ
	 RET			; FILE IS LOCKED, DONT CLOSE IT
	MOVE A,CLZDOA		; GET FLAGS BACK
	TQZE <BLKF>		; SEE IF FLAG IS OFF
	 BUG(BLKF3)
	XMOVEI C,CLZDOB		;BLOCK CO-ROUTINE
	MOVE D,CLZDOJ		;PASS ALONG JFN
	CALL @CLOSD(P3)		; Call DEVice dependent stuff
	 RET
	TQZ <OPNF>
	MOVEI A,0(JFN)		;GET JFN IN A
	CALL DMOCHK		;CHECK IF DISMOUNTED
	 RETSKP			;IT IS .ALL DONE
;**;[3062] Add 2 lines at CLZDO: +16L	CRJ	3-Jan-84
	MOVE JFN,CLZDOJ		;[3062] Get JFN (sometimes trashed)
	IMULI JFN,MLJFN		;[3062] Make a JFN block address
	CALL FNDUNT		;GET DEV INDEX
	MOVX C,DV%OPN
	TDNN C,DEVCHR(A)	;ASSIGNED BECAUSE OF OPEN?
	RETSKP			;NO.

;OPEN BIT IS STILL SET IN DEVICE TABLES. FOR TELETYPES, THIS WILL NOT
;BE TRUE BECAUSE THE DEVICE-DEPENDENT CODE BOTH DEASSIGNS THE
;DATA BLOCK AND CLEANS UP THE DEVICE TABLES.

	ANDCAB C,DEVCHR(A) 	;YES, CLEAR ASSIGNMENT
	MOVE B,DEVCH1(A)
	TXNE B,D1%ALC		;DEVICE ALLOCATED BY ALLOC JSYS?
	RETSKP			;YES. DON'T RELEASE IT
	TXNE C,DV%ASN		;ASSIGNED BY ASND?
	RETSKP			;YES. DON'T RELEASE IT
	MOVE B,A		;NO. B/ INDEX TO DEVICE TABLES
	CALL RELDEV		;GO CLEAR DEVICE TABLES
	 JRST CLZDO1		;FAILED. GO WAIT OR FAIL
	RETSKP

;RELDEV FAILED. THIS SHOULD NOT HAPPEN FOR NOW BECAUSE ONLY TELETYPE
;DEVICE DESIGNATOR CAN CAUSE THIS

CLZDO1:	TXZN T1,1B0		;HAVE TO WAIT?
	RETBAD			;NO. RETURN FAILURE
	TQO BLKF		;YES. INDICATE BLOCKING
	RETBAD
;ROUTINE TO SEE IF A FILE IS LOCKED UP BY ENQ/DEQ

;ASSUMES CHKJFN WAS CALLED
;	CALL CHKENQ
;RETURNS +1:	FILE IS LOCKED BY ENQ/DEQ AND CANNOT BE CLOSED
;	 +2:	FILE IS NOT LOCKED AND CAN BE CLOSED

CHKENQ:	HRRZ A,ENQLST		;SEE IF ANY LOCKS ARE SET
	JUMPE A,RSKP		;IF 0, NO ENQ REQUESTS OUTSTANDING
	HRRZ A,FILDEV(JFN)	;CHECK THAT THIS IS A DSK JFN
	CAIE A,DSKDTB		;OTHERWISE JFNOF1 WILL BUGHLT
	RETSKP			;NOT A DISK, IGNORE THIS CLOSE
	SETZ A,			;GET OFN OF PAGE 0 OF FILE
	CALL JFNOF1		;GET OFN OF FILE PAGE 0
	 RETSKP			;ILLEGAL FOR THIS JFN, CLOSE CAN PROCEED
				; MAY FAIL BECAUSE STRUCTURE IS
				; DISMOUNTED
	HLRZS A			;GET THE OFN ONLY FOR ENQCLS
	HRRZ B,JFN		;GET JFN BLOCK OFFSET
	IDIVI B,MLJFN		;CONVERT TO JFN BEING CLOSED
	CALLRET ENQCLS		;SEE IF FILE CAN BE CLOSED NOW

;ROUTINE CALLED BY SERVICE ROUTINE TO BLOCK

CLZDOB:	STKVAR <SVDES>
	MOVEM DEV,SVDES		;SAVE DEVICE
	PUSH P,T2		;SAVE JFN
	CALL UNLDIS		;UNLOCK AND BLOCK
	POP P,JFN		;RESTORE JFN
	CALL CHKJFD
	 RETBAD ()
	 JFCL
	 RETBAD (DESX3)
	CAME DEV,SVDES 		;CHECK TO SEE IF DEVICE THE SAME
	RETBAD (DESX4)		;YOU CAN'T CHANGE DESCRIPTOR
	RETSKP			;CONTINUE
;CRDIR -  CREATE FILE DIRECTORY OR MODIFY PARAMETERS.
;ACCEPTS:
;	A/ POINTER TO STRUCTURE:<DIRECTORY> STRING
;	B/ (FLAGS,,ADDRESS OF ARGUMENT BLOCK)
;	C/ POINTER TO PASSWORD STRING

;	CRDIR

; ReturnS +1: Error
;	  +2:Success
;		A/ (STRUCTURE UNIQUE CODE,,DIRECTORY number)

; In parameter block
;	.CDLEN=0	; (FLAGS,,LENGTH OF ARGUMENT BLOCK (LENGTH NOT USED))
;	.CDPSW=1	; Pointer to password string, 0 if none
;	.CDLIQ=2	; WORKING STORAGE (LOGGED-IN) QUOTA
;	.CDPRV=3	; PRIVILEGE BITS
;	.CDMOD=4	; MODE BITS
;		CD%DIR	;FILES-ONLY DIRECTORY
;		CD%ANA	;ALPHANUMERIC ACCOUNTS ALLOWED
;		CD%RLM	;REPEAT SYSTEM MESSAGES ON LOGIN
;	.CDLOQ=5	; PERMANENT STORAGE (LOGGED-OUT) QUOTA
;	.CDNUM=6	; DIR NUMBER
;	.CDFPT=7	; DEFAULT FILE PROTECTION
;	.CDDPT=10	; DIRECTORY PROTECTION
;	.CDRET=11	; DEFAULT # OF GENERATIONS TO KEEP
;	.CDLLD=12	; DATE OF LAST LOGIN
;	.CDUGP=13	; POINTER TO USER GROUPS
;	.CDDGP=14	; POINTER TO DIR GROUPS
;	.CDSDQ=15	; MAXIMUM NUMBER OF SUBDIRECTORIES
;	.CDCUG=16	; POINTER TO ALLOWED USER GROUPS FOR SUBDIR
;	.CDDAC=17	; Pointer to default account
;	.CDDNE=20	; Default online expiration
;	.CDDFE=21	; Default offline expiration

.CRDIR::MCENT
	GTOKM (.GOCRD,)		;GETOK CREDIR
	UMOVE Q3,2		;GET FLAGS AND POINTER TO BLOCK
	UMOVE A,1		;GET STRING POINTER TO NAME
	MOVEI B,2*MAXLW+2	;39-DEV:<39-DIR> + 1 HEADER WORD
	CALL CPYUSR		;Copy directory name string
	 ITERR CRDIX3		;No room in jsb
	CALL CRDIR0		;GO DO THE WORK
	 ITERR ()		;AN ERROR OCCURED
	JRST MRETN		;EXIT
;CRDIR0 - ROUTINE TO DO CRDIR JSYS
;ACCEPTS IN A/	POINTER TO NAME STRING IN JSB
;	   Q3/	(FLAGS,,POINTER TO PARAMETER BLOCK IN USER SPACE) - USER'S AC2
;	CALL CRDIR0
;RETURNS +1:	ERROR OCCURRED, ERROR CODE IN A
;	 +2:	SUCCESSFUL

; LOCAL VARIABLE DEFINITIONS (STORED IN JSB FREE SPACE)

;CRDIRN		;HOLDS POINTER TO COPY OF USER'S STRING IN JSB
;CRDIRS		;POINTER TO GTJFN STRING OF COMPLETE DIRECTORY NAME
;CRDIRD		;DIRECTORY NUMBER
;CRDIRE		;TEMPORARILY HOLDS ERROR CODE
;CRDIRJ		;JFN OF DIRECTORY FILE
;CRDIRT		;HOLDS POINTER TO STRINGS ACROSS SUBROUTINE CALLS
;CRDIRF		;TEMPORARY ERROR FLAG
;CRDIRA		;INDEX BLOCK ADDRESS IN DIRECTORY DELETE ROUTINE
;CRDDNM		;ADR OF BLOCK HOLDING DIR NAME,,CRDSTX
;CRDSTX		;STRUCTURE NUMBER
;CRDIRB		;HOLDS EXPECTED TERMINATING BRACKET ON DIRECTORY STRING
;CRDLEN		;LENGTH OF NAME OF DIRECTORY FOR SETMSB
;CRDCPY		;-1 IF NEED TO CALL CPYBAK, 0 OTHERWISE
;CRDCAP		;CAPENB OF USER
;CRDTMP		;STARTING ADDRESS OF FDB
;CRDDEV		;DEVICE DESIGNATOR FOR CHKNUM
;CRDSTR		;STRUCTURE NUMBER IN CHKNUM
;CRDSUP		;FULLWORD DIR NUMBER OF SUPERIOR
;CRDWHL		;NONZERO IF THE USER IS LOGICALLY A WHEEL WRT THE DIR
		;BEING MANIPULATED BY CRDIR - EITHER OWNER ACCESS OR A
		;REAL WHOPER
;CRDDIQ		;DELTA IN SUPERIORS LIQ AS A RESULT OF THIS CRDIR
;CRDDOQ		;DELTA IN SUPERIORS LOQ AS A RESULT OF THIS CRDIR
;CRDDSQ		;DELTA IN SUPERIORS SDQ AS A RESULT OF THIS CRDIR
;CRDFLG		;FLAG WORD FOR INTERNAL USE
;CRDUFL		;WORD TO HOLD .CDLEN FROM USER ARGUMENT BLOCK

; * * * *
;THE HANDLING OF THE STRUCTURE LOCK IS INCORRECT HERE.  WHENEVER THE
;CORRESPONDENCE BETWEEN A UNIQUE CODE AND A STRUCTURE NUMBER IS IN
;USE, THE STRUCTURE MUST BE LOCKED.  ALL EXIT PATHS MUST CONTAIN A
;CALL TO ULKSTR IF CNVSTR HAS BEEN CALLED.
; * * * *

CRDNWH:CD%LEN!CD%PSW!CD%FPT!CD%DPT!CD%RET!CD%DGP!CD%DAC
CDNWF==1B0			;BIT IN CRDFLG - NEW FILE BEING CREATED
CDDIR==1B1			;BIT IN CRDFLG - SUPERIOR IS FILES-ONLY
CDREC==1B2			;RECONSTRUCTING A DIRECTORY

CRDIR0:: SE1CAL
	JSBVAR <CRDIRN,<CRDIRS,40>,CRDIRD,CRDIRE,CRDIRJ,CRDIRF,CRDIRA,CRDIRT,<CRDDNM,MAXLW+4>,CRDSTX,CRDIRB,CRDLEN,CRDCPY,CRDCAP,CRDTMP,CRDDEV,CRDSTR,CRDSUP,CRDWHL,CRDDIQ,CRDDOQ,CRDDSQ,CRDFLG,CRDUFL>,[RETBAD (CRDIX3)]
	;..
;MISCELLANEOUS SETUP FOR CRDIR

	;..
	SETZM CRDFLG		;INITIALIZE FLAG WORD
	MOVE Q1,DIRORA		;GET BASE ADDRESS OF DIRECTORY
	HRRZ Q2,Q3		;GET ADDRESS OF USER'S BLOCK
	SETZ B,			;INITIALIZE USER .CDLEN WORD
	TXNE Q3,CD%LEN		;IS THE USER SPECIFIING A LENGTH
	UMOVE B,.CDLEN(Q2)	;YES, GET IT
	MOVE C,CAPENB		;GET ENABLED CAPABILITIES
	TXNN T3,SC%WHL!SC%OPR	;IS THE USER ENABLED?
	ANDX B,CD%NCE+CD%NED+CD%FED+777777 ;NO, ONLY ALLOW THESE FLAGS
	MOVEM B,CRDUFL		;SAVE THE FLAGS
	HRLI A,(POINT 7,0,34)	;FORM BYTE POINTER TO NAME STRING

;MAKE CRDIRN POINT TO FREE SPACE HOLDING STR:<DIRECTORY> STRING
;AS INPUT BY USER

	MOVEM A,CRDIRN		;SAVE NAME STRING ADDRESS
	HRRZ B,A
	MOVE B,1(B)		;CHECK FOR NULL NAME
	TLNN B,774000
	RETBAD (CRDIX5,<CALL CRDIR6>)	;Null name illegal
	SETZM CRDIRD		;INITIALIZE DIR NUMBER
	SETZM CRDIRF		;ASSUME DIR NUMBER NEED NOT BE CHECKED LATER
	MOVE B,A		;COPY POINTER TO NAME
	MOVX A,RC%EMO		;STRING MUST MATCH EXACTLY
	RCDIR			;PARSE DIRECTORY NAME
	 ERJMP [CALL CRDIR6	;FAILED, CLEAN UP
		MOVE A,LSTERR	;RETURN ERROR FROM RCDIR
		RETBAD ()] ;RETURN ERROR CODE
	TXNN A,RC%NOM		;MATCH?
	MOVEM C,CRDIRD		;YES, STORE DIR NUMBER
	TXNN Q3,CD%NUM		;SPECIFYING A NUMBER?
	JRST CRDI0B		;NO

;USER HAS SPECIFIED A DIRECTORY NUMBER.  SEE IF IT IS THE NUMBER FOR
;THE DIRECTORY SPECIFIED IN THE STR:<DIRECTORY> STRING

	TXNE A,RC%NOM		;A REAL DIRECTORY ?
	JRST [	SETOM CRDIRF ;NO, MARK THAT DIR # SHOULD BE CHECKED LATER
		JRST CRDI0B ]	;GO SET UP GTJFN STRING FOR NEW DIRECTORY
	XCTU [SKIPG B,.CDNUM(Q2)] ;GET NUMBER FROM USER
	RETBAD (CRDIX8,<CALL CRDIR6>) ;ILLEGAL DIR NUMBER
	CAIN B,ROOTDN		;IS THIS THE ROOT DIR?
	JRST [	HLRZ A,C	;GET UNIQUE CODE
		CALL CNVSTR	;GET STRUCTURE NUMBER
		 RETBAD (,<CALL CRDIR6>)
		MOVE P3,STRTAB(A) ;GET ADDRESS OF SDB FOR THIS STRUCTURE
		CALL ULKSTR	;UNLOCK THE STRUCTURE (LOCKED BY CNVSTR)
		JN STCRD,(P3),CRDI0B ;DO NOT CHECK NAME IF CREATING ROOT-DIR
		JRST .+1]	;CONTINUE, NOT CREATING ROOT-DIRECTORY
	UMOVE B,.CDNUM(Q2)	;GET NUMBER FROM USER AGAIN
	HRRZ C,CRDIRD		;GET NUMBER OF DIRECTORY
	CAME B,C		;MATCH ?
	RETBAD (CRDIX8,<CALL CRDIR6>) ;NO, RETURN ERROR CODE
	;..
;HERE IN ALL CASES.  CRDIRF IS -1 IF RCDIR FAILED ON DIRECTORY STRING.
;IF USER SPECIFIED DIRECTORY NUMBER, AND CRDIRF IS 0, NUMBER MATCHED
;THAT OF DIRECTORY IN STRING
;	CRDIRD/ (STRUCTURE,,DIRECTORY) FOR DIRECTORY STRING
;	CRDIRN/ POINTER TO ORIGINAL STRING

;THIS CODE BUILDS A STRING FOR THE DIRECTORY FILE CORRESPONDING TO THE
;DESIRED DIRECTORY.  IT IS SET UP FOR A GTJFN.

	;..
CRDI0B:	MOVE B,CRDIRN		;GET POINTER TO INPUT STRING
	ILDB C,B		;GET FIRST CHARACTER IN STRING
	CAIE C,.CHDI1		;DOES STRING BEGIN WITH A VALID
	CAIN C,.CHDI2		;  DIRECTORY PUNCTUATION ?
	SKIPA A,[POINT 7,[ASCIZ/DSK:/]]	;YES, DEFAULT THE DEVICE THEN
	MOVE A,CRDIRN		;NO, GET POINTER TO SUPPLIED DEVICE
	STDEV			;CONVERT LOGICAL NAMES TO PHYSICAL
	 RETBAD (,<PUSH P,B	;SAVE THE ERROR CODE
		CALL CRDIR6	;RELEASE THE SPACE
		POP P,A>)	;GET BACK THE ERROR CODE
	MOVE A,[POINT 7,CRDIRS]	;GET POINTER TO DESTINATION AREA
	DEVST			;PUT THE PHYSICAL NAME THERE
	 RETBAD (,<PUSH P,A	;SAVE THE ERROR CODE
		CALL CRDIR6	;RELEASE ALL SPACE
		POP P,A>)	;GET BACK THE ERROR CODE
	MOVEI B,":"		;END THE STR NAME WITH A COLON
	BOUT
	MOVE B,CRDIRN		;NOW UPDATE THE BYTE POINTER
CDI0B1:	ILDB C,B		;SCAN FOR :
	JUMPE C,CRDI0D		;AT END OF STRING?
	CAIE C,.CHDI1		;NO, DOES STRING BEGIN WITH A VALID
	CAIN C,.CHDI2		;  DIRECTORY PUNCTUATION?
	JRST CRDI0D		;YES, GO PROCESS DIRECTORY STRING
	CAIE C,":"		;NO, FOUND A COLON?
	JRST CDI0B1		;NO, LOOP BACK
CDI0B2:	IBP B			;MOVE POINTER PAST OPENING DIRECTORY BRACKET
	;..
;DIRECTORY MAY OR MAY NOT EXIST HERE.  IF IT DOESN'T, AND USER GAVE
;DIRECTORY NUMBER, NUMBER IS AVAILABLE.

;	B/ POINTER TO ORIGINAL STRING; POINTS JUST AFTER COLON
;	A/ POINTER TO GTJFN STRING; POINTS JUST AFTER COLON

;DETERMINE TYPE OF CLOSING BRACKET EXPECTED

	;..
CRDI0D:	MOVEM A,CRDIRT		;SAVE DESTINATION POINTER FOR NEXT SOUT
	LDB C,B			;GET OPENING BRACKET
	JUMPN C,CRDI0C		;DIRECTORY NAME FOLLOWS?
	SKIPN B,CRDIRD		;GET DIR NUM
	RETBAD (CRDIX5,<CALL CRDIR6>)	;Null name illegal
	DIRST			;GET STRING WITH DIR NAME IN IT
	 JRST [	PUSH P,A	;SAVE ERROR
		CALL CRDIR6
		POP P,A
		RETBAD()]
	MOVE B,CRDIRT		;NOW WE HAVE STR:<DIR>, GET TO <DIR>
CRDI1A:	ILDB C,B		;GET NEXT CHAR
	CAIE C,":"		;FOUND COLON YET?
	JRST CRDI1A
	ILDB C,B		;GET DIR STARTING CHAR
CRDI0C:	MOVEI D,.CHDT1		;ASSUME TYPE 1 PUNCTUATION (ANGLE BRACKETS)
	CAIE C,.CHDI1		;TYPE 1 PUNCTUATION ?
	MOVEI D,.CHDT2		;NO, GET TYPE 2 CLOSING BRACKET (SQUARE BRACKET)
	MOVEM D,CRDIRB		;SAVE TERMINATING BRACKET

;COPY JUST THE DIRECTORY NAME INTO LOCAL STORAGE (CRDDNM) AND COMPUTE
;ITS LENGTH. MAKE IT END WITH NULL

	HRROI A,CRDDNM		;SET UP POINTER TO WHERE NAME WILL GO
	MOVEI C,MAXLC+1		;GET MAX # OF CHARS ALLOWED IN DIRECTORY NAMES
	MOVEI D,.CHNUL		;ALSO TERMINATE ON END OF STRING, I.E. ON NULLS
	SOUT			;ISOLATE DIRECTORY NAME
	MOVEI B,MAXLC		;GET MAX # OF CHARACTERS POSSIBLY MOVED
	LDB D,A			;SEE IF ENDED ON A NULL
	CAIE D,.CHNUL		;...
	AOS B			;YES, DONT COUNT THE CLOSE BRACKET
	SUB B,C			;COMPUTE # OF CHARACTERS ACTUALLY IN STRING
	IDIVI B,5		;COMPUTE # OF WORDS IN STRING + REMAINDER
	SKIPN C			;DOES B HAVE EXACT # OF WORDS IN THE STRING ?
	SUBI B,1		;YES, SETMSB REQUIRES ONE LESS WORD IN COUNT
	MOVEM B,CRDLEN		;SAVE # OF WORDS IN DIRECTORY NAME STRING
	LDB B,A			;GET ACTUAL TERMINATING CHARACTER
	CAIE B,.CHNUL		;DID STRING TERMINATE WITH A NULL ?
	JRST CRDI0E		;NO, GO CHECK TERMINATING BRACKET
	BKJFN			;YES, BACK UP TO TERMINATING BRACKET
	 JFCL
	LDB B,A			;PICK UP TERMINATING BRACKET
CRDI0E:	CAME B,CRDIRB		;IS IT EXPECTED TERMINATING BRACKET ?
	RETBAD (CRDI11,<CALL CRDIR6>) ;NO, RETURN ERROR TO USER
	MOVEI C,.CHNUL		;GET A NULL TO MAKE AN ASCIZ STRING
	DPB C,A			;OVERWRITE CLOSING BRACKET WITH A NULL
	SKIPN CRDIRF		;NEED TO SEE IF SPECIFIED DIR # EXISTS?
	JRST CRDI0M		;NO, GO ON
	;..
;RCDIR GAVE NO-MATCH AND USER SPECIFIED A DIRECTORY NUMBER.  SEE IF IT
;EXISTS ON THE GIVEN STRUCTURE

	;..
	CALL CHKNUM		;YES, GO CHECK DIRECTORY NUMBER SUPPLIED
	JRST [  CALL CRDIR6	;BAD DIRECTORY NUMBER
		MOVE A,CRDIRE	;RETURN ERROR
		RETBAD ()]

;ADD THE FILENAME AND EXTENSION TO THE GTJFN STRING.  IF THE DIRECTORY
;IS IN <ROOT-DIRECTORY>, COPY DIRNAME.DIRECTORY.  IF THE DIRECTORY IS
;IN ANY OTHER DIRECTORY, COPY <SUPERIOR>DIRNAME.DIRECTORY.

CRDI0M:	MOVEI A,CRDDNM		;CHECK IF THE NEW DIR IS A SUBDIR OF
	HRLI A,(<POINT 7,.-.>)	;OTHER THAN ROOT-DIRECTORY
	MOVEI P3,0		;P3 WILL POINT TO LAST DOT
CRDI0F:	ILDB B,A		;GET A CHAR
	CAIN B,"."		;A SEPARATOR?
	MOVE P3,A		;YES - COPY POINTER
	JUMPN B,CRDI0F		;LOOP
	JUMPE P3,CRDI0G		;ANY FOUND?
	MOVEI A,.CHDI1		;YES - BUILD DIR PREFIX
	IDPB A,CRDIRT		; ...
	MOVEI A,.CHDT1		;CHANGE LAST SEP TO CLOSING DIR BRACKET
	DPB A,P3		; ...
CRDI0G:	MOVE A,CRDIRT		;GET POINTER TO DESTINATION AGAIN
	HRROI B,CRDDNM		;FORM POINTER TO DIRECTORY NAME
	SOUT			;SAVE JUST THE NAME OF THE DIRECTORY
	MOVEI B,"."		;REPLACE SEP IF NEEDED
	SKIPE P3		; ...
	DPB B,P3		; ...
	HRROI B,[ASCIZ/.DIRECTORY;P020200/]
	SOUT			;ADD ON EXTENSION
	;..
;HAVE A FILESPEC OF THE FORM DEV:NAME.DIRECTORY;P000000 OR
;DEV:<SUPERIOR>DIRNAME.DIRECTORY;P020200.  DO GTJFN, ALLOWING
;NON-EXISTENT FILE

	;..
	CALL CRDSWH		;SET WHEEL CAPABILITY
	MOVEI A,CRDGJB		;GET POINTER TO GTJFN BLOCK
	HRROI B,CRDIRS		;GET POINTER TO "NAME.DIRECTORY" STRING
	GTJFN			;CREATE NEW NAME IF NONE OR GET OLD ONE
	 JRST [	MOVEM A,CRDIRE ;SAVE ERROR CODE
		CALL CRDCWH	;CLEAR WHEEL
		CALL CRDIR6	;RELEASE ASSIGNED STORAGE
		MOVE B,CRDIRE	;RESTORE ERROR CODE
		MOVEI A,CRDIX4	;ASSUME SUPERIOR DIRECTORY IS FULL
		CAIN B,GJFX16	;NO SUCH DEVICE ?
		MOVEI A,CRDI12	;YES. SAY STRUCTURE NOT MOUNTED
		CAIN B,STRX09	;"Prior structure mount required" error?
		MOVEI A,CRDI12	;yes, say structure not mounted
		CAIN B,GJFX17	;NO SUCH DIRECTORY?
		MOVEI A,CRDI23	;YES. SAY SUPERIOR DIRECTORY DOESN'T EXIST
		RETBAD () ]	;RETURN ERROR
	MOVEM A,CRDIRJ		;SAVE THE JFN OF THE DIRECTORY FILE
	CALL CRDCWH		;CLEAR WHEEL
	MOVE A,CRDIRJ		;GET THE JFN
	IMULI A,MLJFN		;CONVERT TO JFN BLOCK OFFSET
	HRRZ B,FILDDN(A)	;GET HW DIR NUMBER OF SUPERIOR
	LOAD A,FILUC,(A)	;GET UNIQUE CODE FOR FILE STRUCTURE
	HRL B,A			;BUILD FW DIR NUMBER
	MOVEM B,CRDSUP		;SAVE
	CALL CNVSTR		;CONVERT UNIQUE CODE TO STRUCTURE NUMBER
	 JRST CRDIR4		;FAILED, RETURN ERROR TO USER
	HRRM A,CRDSTX		;SAVE STRUCTURE NUMBER
	CALL ULKSTR		;UNLOCK THE STRUCTURE (LOCKED BY CNVSTR)
	MOVE A,CRDSUP		;CHECK ACCESS TO SUPERIOR DIR
	CALL SETDIR		;FIRST MAP DIR
	 JRST CRDIR4		;FAILED
	SETZM CRDWHL		;ASSUME NOT A LOGICAL WHEEL
	MOVX B,DC%CN		;CHECK IF CAN CONNECT TO SUPERIOR
	CALL DIRCHK		; ???
	 SKIPA			;NO - USER MUST PASS LATER CHECKS
	SETOM CRDWHL		;YES - USER IS A LOGICAL WHEEL
	MOVE B,DIRORA		;POINT TO START OF DIRECTORY
	LOAD B,DRMOD,(B)	;GET MODE BITS
	TXNE B,CD%DIR		;IS THIS A FILES-ONLY DIRECTORY?
	JRST [	MOVX B,CDDIR	;YES. INDICATE IT IN THE LOCAL FLAG WORD
		IORM B,CRDFLG	;..
		JRST .+1]
	CALL USTDIR		;UNLOCK DIR
	HRRZ A,CRDIRJ		;GET JFN OF DIRECTORY FILE
	MOVE B,[1,,.FBCTL]	;NOW SEE IF THE FILE EXISTS
	MOVEI C,D		;GET FLAGS INTO D
	GTFDB
	TXNN D,FB%DIR!FB%NXF	;IS THIS A DIR OR NON-EX FILE?
	JRST [	MOVEI A,CRDIX9	;NO, ILLEGAL FORMAT DIRECTORY FILE
		JRST CRDIR4]	;GO CLEAN UP AND BOMB OUT
	MOVE B,[1,,.FBDRN]	;GET DIR NUMBER
	MOVEI C,C
	GTFDB
	HRRZM C,CRDIRD		;SAVE DIR NUMBER IF FILE EXISTS
	SETZM CRDCPY		;ASSUME DON'T HAVE TO CALL CPYBAK
	TXNN D,FB%NXF		;FILE EXIST YET?
	JRST CRDIR1		;YES, NOT CREATING A NEW DIR
	;..
;HERE WHEN CREATING A NEW DIRECTORY
;	CRDSUP/DIRECTORY OF SUPERIOR
;	CRDSTX/ STRUCTURE NUMBER

	;..
	MOVX A,CDNWF		;INDICATE NEW FILE FOR CLEANING UP
	IORM A,CRDFLG
	SKIPN CRDWHL		;CAN THIS USER CREATE?
	JRST [	MOVEI A,CRDIX1	;NO. RETURN ERROR
		JRST CRDIR4]
	HRRZ C,CRDSUP		;GET SUPERIOR
	CAIN C,ROOTDN		;ROOT-DIRECTORY?
	JRST [	SETOM CRDCPY	;YES - HAVE TO CALL CPYBAK
		JRST CRDI0H]	;AND OMIT LIMIT CHECKS

;CHECK PRIVILEGES

	MOVE A,CAPENB		;GET ENABLED CAPABILITIES
	TXNN A,SC%WHL!SC%OPR	;WHEEL OR OPERATOR?
	TXNN Q3,CD%PRV		;WANT TO SET PRIVILEGES?
	JRST CRDI0N		;WHEEL OR OPER OR NOT SETTING PRIVILEGES
	UMOVE A,.CDPRV(Q2)	;YES. GET DESIRED PRIVILEGES
	ANDCM A,CAPENB		;WE HAVE TO HAVE THEM ENABLED
	JUMPN A, [ MOVEI A,CRDI20
		JRST CRDIR4]

;DIRECTORY IS NOT BEING CREATED IN <ROOT-DIRECTORY>. MAP ITS SUPERIOR
;TO CHECK THE SUBDIRECTORY'S PARAMETERS AGAINST THE SUPERIOR'S

CRDI0N:	MOVE A,CRDSUP		;MAP SUPERIOR FOR LIMIT
	CALL SETDIR		;CHECKS
	 JRST CRDIR4		;FAILED

;CHECK LIST OF CREATABLE USER GROUPS

	TXNE Q3,CD%CUG		;SETTING CREATABLE USER GROUPS?
	JRST [	UMOVE A,.CDCUG(Q2)	;GET USER CREATABLE GROUPS LIST
		LOAD B,DRCUG,(Q1) ;GET CREATABLE GROUPS LIST
		CALL CDCKCU	;VALIDATE LIST
		 ERRJMP(CRDI16,CRDI0I) ;FAILED
		JRST .+1]	;SUCCESS - GO ON

;CHECK LIST OF USER GROUPS

	TXNE Q3,CD%UGP		;SETTING USER GROUPS?
	JRST [	UMOVE A,.CDUGP(Q2) ;YES - GET USERS LIST
		LOAD B,DRCUG,(Q1) ;GET CREATABLE USER GROUPS LIST
		CALL CDCKCU	;VALIDATE LIST
		 ERRJMP(CRDI16,CRDI0I) ;FAILED
		JRST .+1]
	;..
;NEW DIRECTORY, NOT IN ROOT-DIRECTORY...
;CHECK PERMANENT (LOGGED-OUT) QUOTA

	;..
	MOVE A,CRDUFL		;GET FLAGS FROM USER
	TXNE A,CD%NSQ		;CHANGING THE SUPERIOR'S QUOTA
	JRST CRDI0L		;NO, SKIP THESE CHECKS
	MOVX B,.STDMX		;GET DEFAULT PERMANENT QUOTA
	TXNE Q3,CD%LOQ		;USER SETTING LOQ?
	UMOVE B,.CDLOQ(Q2)	;YES - GET THAT VALUE
	LOAD C,DRLOQ,(Q1)	;COMPARE AGAINST SUPERIOR
	CALL CKLOQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 JRST CRDI0P		;INFINITE. DON'T CHECK
	SKIPL B			; ...
	CAMLE B,C		; ...
	ERRJMP(CRDI14,CRDI0I)	;EXCEEDED SUPERIOR LOQ OR .LT. 0

;CHECK QUOTA OF SUBDIRECTORIES

CRDI0P:	MOVX B,.STDSD		;GET DEFAULT SUBDIR QUOTA
	TXNE Q3,CD%SDQ		;SETTING SUBDIR QUOTA?
	UMOVE B,.CDSDQ(Q2)	;YES - GET USERS VALUE
	TLNE B,-1		;RIGHT HALF ONLY?
	ERRJMP (CRDI24,CRDI0I)	;NO. WON'T FIT IN ALLOTTED SPACE
	LOAD C,DRSDM,(Q1)	;COMPARE AGAINST
	OPSTR <SUB C,>,DRSDC,(Q1) ;REMAINING SUBDIR QUOTA
	CAML B,C		;LESS ONE FOR DIR BEING CREATED
	ERRJMP(CRDI15,CRDI0I)	;EXCEEDED SUPERIOR SDQ

;CHECK WORKING (LOGGED-IN) QUOTA

	HRRZ A,CRDSUP		;GET SUPERIOR DIR NUM
	MOVE B,CRDSTX		;GET STRUCTURE NUMBER
	CALL GETCAL		;GET CURRENT DIR FREE DISK
	 JRST [	LOAD A,DRLIQ,(Q1) ;DIRECTORY VALUES
		OPSTR <SUB A,>,DRDCA,(Q1) ; ...
		JRST .+1]
	MOVE C,A		;COPY FREE SPACE
	MOVX B,.STDMX		;GET DEFAULT LIQ
	TXNE Q3,CD%LIQ		;SETTING LIQ?
	UMOVE B,.CDLIQ(Q2)	;YES - GET USERS VALUE
	CALL CKLIQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 JRST CRDI0L		;YES. DON'T CHECK LIMITS
	SKIPL B			;DON'T ALLOW NEGATIVE
	CAMLE B,C		;WILL IT FIT?
	ERRJMP(CRDI13,CRDI0I)	;NO - SUPERIOR LIQ EXCEEDED OR .LT. 0

;DON'T ALLOW CREATION OF LOGIN SUBDIRECTORY UNDER A FILES-ONLY SUPERIOR.
;NOTE THAT THIS CODE HAS BEEN SKIPPED IF SUPERIOR IS ROOT-DIRECTORY

CRDI0L:	MOVX B,CDDIR		;SEE IF THE SUPERIOR IS FILES-ONLY
	TDNN B,CRDFLG		;..
	JRST CRDIR9		;NO. DOESN'T MATTER WHAT THIS ONE IS TO BE
	TXNN Q3,CD%MOD		;SUPERIOR IS FILES ONLY. ARE WE SETTING THE MODE?
	ERRJMP(CRDI17,CRDI0I)	;NO. CAN'T TAKE THE DEFAULT
	UMOVE A,.CDMOD(Q2)	;YES. GET THE MODE WORD FROM USER
	TXNN A,CD%DIR		;SETTING FILES ONLY?
	ERRJMP(CRDI17,CRDI0I)	;NO. ILLEGAL IN FILES-ONLY SUPERIOR
CRDIR9:	CALL USTDIR		;UNLOCK THE SUPERIOR
	;..
;NEW DIRECTORY...
;HERE WHEN QUOTAS AND MODE HAVE BEEN CHECKED OR ROOT-DIRECTORY IS THE
;SUPERIOR. GET USER'S CHOICE FOR DIRECTORY NUMBER OR NEXT AVAILABLE ONE
;AND SAVE IN CRDIRD

	;..
CRDI0H:	TXNE Q3,CD%NUM		;SETTING THE DIR NUMBER SPECIFICALLY?
	JRST [	UMOVE A,.CDNUM(Q2) ;YES, GET THE DIR NUMBER
		JRST CRDI0A]	;GO CHECK IF LEGAL
	HRRZ A,CRDSTX		;GET STRUCTURE NUMBER
	CALL GETNDN		;NO, GET NEXT AVAILABLE DIR NUMBER ON THIS STR
	 JRST [	MOVEI A,CRDI10	;MAXIMUM DIR # EXCEEDED
		JRST CRDIR4]	;GO CLEAN UP AND BOMB
	JRST CRDI0A		;CONTINUE BELOW

;HERE WHEN A LIMIT CHECK HAS FAILED

CRDI0I:	MOVEM A,CRDIRE		;SAVE ERROR
	CALL USTDIR		;RELEASE SUPERIOR
	MOVE A,CRDIRE		;RESTORE ERROR
	JRST CRDIR4		;AND UNDO WORK SO FAR

CRDI0A:	SKIPL A			;NEGATIVE IS ILLEGAL
	CAML A,MXDIRN		;IS THIS A LEGAL DIRECTORY NUMBER?
	JRST [	MOVEI A,CRDIX8	;NO, ILLEGAL DIR # SPECIFIED
		JRST CRDIR4]	;GO RELEASE JFN AND BOMB
	MOVEM A,CRDIRD		;SAVE DIR NUMBER
	CAIN A,ROOTDN		;IS THIS THE ROOT DIR BEING CREATED
	JRST [	SETZ A,		;YES, NO DISK ADDRESS
		CALL CRDIDX	;HANDLE THIS SPECIALLY
		 BUG(GTFDB6)
		JRST CRDIR1]	;ROOT DIR NOW EXISTS, DONT REINITIALIZE

;THIS IS NOT ROOT-DIRECTORY.  DO RECONSTRUCTION IF REQUESTED

	CALL CHKREC		;SEE IF DOING RECONSTRUCTION
	 JRST CRDIAA		;NO
	CALL CRDIDX		;YES, GO SET UP IDXTAB AND FBADR
	 JRST CRDIAA		;FAILED, CREATE NEW DIR
	MOVX A,CDREC		;DONE, MARK THAT RECONSTRUCTION BEING DONE
	IORM A,CRDFLG		;  IN FLAG WORD
	JRST CRDIAB		;SKIP THE DIRECTORY INITIALIZATION
	;..
;NEW DIRECTORY...
;THIS IS NOT ROOT-DIRECTORY, AND WE AREN'T DOING RECONSTRUCTION.
;OPEN AND CLOSE DIRECTORY FILE, SET IDXTAB ENTRY AND INITIALIZE THE DIRECTORY

	;..
CRDIAA:	HRRZ A,CRDIRJ		;GET JFN
	MOVE B,[FLD (^D36,OF%BSZ)+OF%RD+OF%WR+OF%THW]
	OPENF			;OPEN THE FILE TO CREATE THE INDEX BLK
	 JRST CRDIR4		;ERROR ON OPENF, GO RELEASE JFN
	HRLI A,(1B0)		;NOW CLOSE THE FILE KEEPING THE JFN
	CLOSF			;THE FILE EXISTS NOW
	 JFCL
	SETZ A,			;NO ADDRESS OF INDEX BLOCK YET
	CALL CRDIDX		;GO INITIALIZE THE INDEX TABLE
	 JRST CRDIR4		;BOMBED!
	MOVE A,CRDIRD		;GET THE DIRECTORY NUMBER
	HRRZ B,CRDSTX		;GET STRUCTURE NUMBER
	CALL DIRINI		;INITIALIZE THIS DIRECTORY
	 JRST CRDIR4		;COULD NOT INITIALIZE DIR

;DIRECTORY HAS BEEN INITIALIZED OR RECONSTRUCTED. UNLESS SUPERIOR IS
;ROOT-DIRECTORY, GET NEW DIRECTORY'S QUOTAS

CRDIAB:	HRRZ A,CRDSUP		;IS THE SUPERIOR ROOT-DIRECTORY?
	CAIN A,ROOTDN		; ???
;**;[1944] Change 1 line at CRDIAB:+2L	PED	15-SEP-81
	JRST CRDRD		;[1944] YES - NEVER DECREMENT QUOTAS
	HLL A,CRDSUP		;GET UNIQUE CODE
	HRR A,CRDIRD		;FORM NUMBER FOR DIRECTORY BEING CREATED
	CALL SETDIR		;MAP DIRECTORY BEING CREATED
	 JRST CRDIR4		;FAILED
	LOAD A,DRLIQ,(Q1)	;GET CURRENT QUOTA VALUES
	MOVEM A,CRDDIQ
	LOAD A,DRLOQ,(Q1)
	MOVEM A,CRDDOQ
	LOAD A,DRSDM,(Q1)
	MOVEM A,CRDDSQ
	CALL USTDIR		;UNLOCK THE DIRECTORY

;MAP THE SUPERIOR AND ADJUST ITS QUOTAS BY THE AMOUNT GIVEN TO
;THE NEW DIRECTORY

;**;[1944] Change 1 line at CRDIAB:+18.L	PED	15-SEP-81
CRDRD:	MOVE A,CRDSUP		;[1944] DECREMENT QUOTAS BY DEFAULTS
	CALL SETDIR		;MAP SUPERIOR
	 JRST CRDIR4		;FAILED
;**;[1944] Add 3 lines at CRDIAF:-13.L	PED	15-SEP-81
	INCR DRSDC,(Q1)		;[1944] ANOTHER SUBDIRECTORY
	HRRZ A,CRDSUP		;[1944] GET SUPERIOR DIR NUMBER
	CAIN A,ROOTDN		;[1944] ROOT-DIR?
	JRST CRDR1C		;[1944] YES, DON'T CHECK QUOTAS
	MOVE A,CRDUFL		;GET USER FLAGS
	TXNE A,CD%NSQ		;UPDATING SUPERIOR QUOTA
	JRST CRDIAC		;NO, SKIP OVER THIS CODE
	CALL CKLIQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 JRST CRDIAF		;YES. DON'T ADJUST IT
	LOAD A,DRLIQ,(Q1)	;DECREMENT WORKING
	SUB A,CRDDIQ		;...
	STOR A,DRLIQ,(Q1)	;STORE
	HRRZ A,CRDSUP		;A/ NUMBER OF SUPERIOR
	MOVE B,CRDSTX		;B/ STRUCTURE NUMBER
	MOVN C,CRDDIQ		;C/ AMOUNT TO ADD TO SUPERIOR'S ALLOCATION
	CALL ADJALC		;ADJUST SUPERIOR'S ALLOCATION BY SUBDIR'S QUOTA
CRDIAF:	CALL CKLOQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 JRST CRDIAD		;YES. DON'T ADJUST
	LOAD A,DRLOQ,(Q1)	 ;DECREMENT PERMANENT
	SUB A,CRDDOQ		;...
	STOR A,DRLOQ,(Q1)	;STORE
CRDIAD:	LOAD A,DRSDM,(Q1)	;DECREMENT SUBDIR QUOTA
	SUB A,CRDDSQ		;...
	STOR A,DRSDM,(Q1)	;STORE
;**;[1944] Delete 1 line at CRDIAC:+0L	PED	15-SEP-81
CRDIAC:	CALL UPDDIR		;[1944] UPDATE DISK COPY
	CALL USTDIR		;RELEASE SUPERIOR

;SET FLAG IN SUPERIOR'S FDB TO INDICATE IT HAS INFERIORS

	HRRZ A,CRDSUP		;GET SUPERIOR DIR NUMBER
	CALL GETIDX		;GET SUPERIOR'S SUPERIOR AND FDB ADDR
	 JRST CRDR1B		;IF NOT SETUP, GO ON
	MOVEM A,CRDTMP		;SAVE FDB OF SUPERIOR
	MOVE A,C		;GET SUP SUP DIR NUMBER
	HLL A,CRDSUP		;GET SUC FOR FWDN
	CALL SETDIR		;MAP SUPERIOR'S SUPERIOR
	 JRST CRDR1B		;NOT FATAL - GO ON
	MOVE A,CRDTMP		;GET FDB
	ADD A,DIRORA		;AS AN ABSOLUTE ADDRESS
	SETONE FB%SDR,.FBCTL(A)	;SET SUBDIR FLAG IN SUPERIORS FDB
	CALL UPDDIR		;UPDATE DISK COPY
	CALL USTDIR		;RELEASE SUP SUP
	JRST CRDR1B		;SETUP USERS VALUES
	;..
	;..

;NOT CREATING A NEW DIRECTORY.  SEE IF PRIVILEGED TO CHANGE THINGS

CRDIR1:	SKIPE CRDWHL		;LOGICAL WHEEL OR OPERATOR?
	JRST CRDR1B		;YES. OK TO DO ANYTHING
	MOVE A,FACTSW		;NO. DOES SYSTEM ALLOW USER TO CHANGE THINGS?
	TXNN A,SF%CRD		;CAN USER CHANGE FIELDS
	JRST [	MOVEI A,CRDIX1	;NO
		JRST CRDIR4]
	HLLZ A,Q3		;GET REQUESTED FUNCTIONS
	ANDCM A,CRDNWH		;COMPARE AGAINST ALLOWED FUNCTIONS
	JUMPN A,[MOVEI A,CRDIX1	;WANT TO DO SOMETHING NOT ALLOWED
		JRST CRDIR4]	;REQUIRE WHEEL OR OPERATOR
	HLL A,CRDSUP		;GET UNIQUE CODE
	HRR A,CRDIRD		;A/(UNIQUE CODE,,DIRECTORY NUMBER)
	CALL SETDIR		;MAP THE DIRECTORY
	 JRST CRDIR4		;FAILED.
	MOVX B,DC%CN		;B/CHECK FOR ABILITY TO CONNECT
	CALL DIRCHK		;CAN USER ACCESS THIS DIRECTORY?
	 JRST [	CALL USTDIR	;NO. UNLOCK THE DIRECTORY LOCKED BY SETDIR
		MOVEI A,CRDIX1	;WHEEL OR OPERATOR REQUIRED
		JRST CRDIR4]	;TAKE ERROR RETURN
	MOVE B,DIRORA		;GET ADDRESS OF MAPPED DIRECTORY
	LOAD B,DRPSW,(B)	;GET OFFSET OF PASSWORD BLOCK
	SKIPN B			;IF NONE, DIRECTORY HAS NO PASSWORD
	 JRST [	CALL USTDIR	;UNLOCK THE DIRECTORY LOCKED BY SETDIR
		MOVEI A,CRDIX1	;WHEEL OR OPERATOR REQUIRED
		JRST CRDIR4]	;TAKE ERROR RETURN
	ADD B,DIRORA		;GET ABSOLUTE ADDRESS OF PASSWORD BLOCK
	MOVE C,1(B)		;GET FIRST WORD AFTER HEADER
	TLNN C,774000		;IF FIRST CHARACTER IS NULL, NO PASSWORD
	 JRST [	CALL USTDIR	;UNLOCK THE DIRECTORY LOCKED BY SETDIR
		MOVEI A,CRDIX1	;WHEEL OR OPERATOR REQUIRED
		JRST CRDIR4]	;TAKE ERROR RETURN
	UMOVE B,3		;GET POINTER TO PASSWORD AS INPUT BY USER
	CALL CHKPSX		;SEE IF USER GAVE CORRECT PASSWORD
	 JRST [	ULKDIR		;FAILED. UNLOCK THE DIRECTORY LOCKED BY SETDIR
		MOVE B,A	;SAVE FLAG FROM CHKPSX
		MOVEI A,^D3000	;SLEEP 3 SECONDS
		SKIPN B		;NEED TO SLEEP?
		DISMS
		OKINT		;NOW CAN GO OKINT FROM CALL TO SETDIR
		MOVEI A,CNDIX1	;ASSUME INCORRECT PASSWORD GIVEN
		XCTU [	SKIPN 3] ;DID USER GIVE A PASSWORD?
		MOVEI A,ACESX3	;NO. RETURN 'PASSWORD REQUIRED'
		JRST CRDIR4]	;TAKE ERROR RETURN
CRDR1C:	CALL USTDIR		;PASSWORD IS OK.  UNLOCK THE DIRECTORY
				; LOCKED BY SETDIR
	;..
;COMMON CODE FOR NEW AND OLD DIRECTORIES.  IF NEW, IT HAS BEEN
;INITIALIZED.  IF OLD, PRIVILEGE HAS BEEN CHECKED.

	;..
CRDR1B:	HRRZ A,CRDIRD		;GET DIR NUMBER
	TXNE Q3,CD%NUM		;IS USER SPECIFYING A DIR NUMBER
	UMOVE A,.CDNUM(Q2)	;YES, GET THE NUMBER
	CAME A,CRDIRD		;IS THIS A MATCH OF WHAT IS IN DIR FILE
	RETBAD (CRDIX2)		;NO, DIR NUMBER MUST MATCH EXISTING #
	TXNE Q3,CD%DEL		;DELETE WANTED?
	 JRST DELDIR		; Yes
	MOVE A,CRDIRJ		;GET THE JFN OF THE DIR FILE
	RLJFN			;RELEASE THE JFN
	 JFCL
	SETZM CRDIRJ		;MARK THAT THE JFN HAS BEEN RELEASED
	HLL A,CRDSUP		;GET STR UNIQUE CODE
	HRR A,CRDIRD		;ADD DIRECTORY NUMBER
	CALL SETDIR		;MAP IN THIS DIRECTORY
	 JRST [	BUG(CRDSDF)
		JRST CRDIR4]

;PUT THE DIRECTORY'S NAME IN A NAME BLOCK POINTED TO BY THE DIRECTORY
;HEADER, AND RELEASE THE FREE SPACE CONTAINING THE NAME STRING

	MOVE A,DIRORA		;GET BASE ADR OF DIR AREA
	LOAD A,DRNAM,(A)	;GET POINTER TO NAME STRING
	JUMPN A,CRDR1A		;IF ALREADY SET, DONT SET IT AGAIN
	HRROI A,CRDDNM		;FORM POINTER TO NAME STRING
	MOVE B,CRDLEN		;GET LENGTH OF STRING
	CALL SETMSB		;SET UP MASK FOR LAST WORD
	CALL CPYDIR		;PUT THIS NAME IN THE DIR
	 RETBAD(CRDIX4,<ULKDIR	;FAILED TO GET ROOM IN DIR
			JRST CRDIR4>)
	MOVEI B,.TYNAM		;MARK THIS AS A NAME STRING
	STOR B,NMTYP,(A)	;...
	SUB A,DIRORA		;GET RELATIVE ADDRESS OF BLOCK
	STOR A,DRNAM,(Q1)	;PUT ADR IN DIR
CRDR1A:	CALL CRDIR6		;GO RELEASE JSB SPACE
	;..
	;..

;SET PASSWORD

	CALL CHKCHG		;CHECK IF CHANGE DESIRED
	 JRST CRDR3A		;NO, DO NOT CHANGE EXISTING PARAMETERS
	TXNN Q3,CD%PSW		;WANT TO SET PASSWORD?
	JRST CRDIR3		;No password change
	UMOVE A,.CDPSW(Q2)	;Get pointer to password
;**;[1810] Add 3 lines at CRDR1A: +11L	JGZ	23-NOV-80
	TLC T1,-1		;[1810] CHECK FOR -1,,ADR
	TLCN T1,-1		;[1810] AND IF SO,
	HRLI T1,(<POINT 7,0>)	;[1810]  MAKE IT INTO A REAL BYTE POINTER
	XCTBU [	ILDB A,A]	;Get first character of password
	JUMPN A,CRDR2A		;If non-null, OK
	SKIPN CRDWHL		;Must be WHOPER or have connect to superior
	RETBAD (CRDIX1,<ULKDIR>) ; in order to change password to null
CRDR2A:	UMOVE A,.CDPSW(Q2)	;Get pointer to password
	CALL CPYFUS		;Copy new password to free storage
	 RETBAD (CRDIX3,<ULKDIR>)
	MOVEM A,CRDIRN		;SAVE ADDRESS OF STRING
	CALL SETMSK		;Store in directory
	CALL CPYDIR		;And copy string to directory
	 RETBAD(CRDIX4,<CALL CRDIR6
			ULKDIR>)
	MOVEI B,.TYNAM		;MARK AS NAME BLOCK
	STOR B,NMTYP,(A)	;...
	LOAD B,DRPSW,(Q1)	;GET POINTER TO OLD PASSWORD STRING
	SUB A,DIRORA		;GET RELATIVE ADR OF PASSWORD STRING
	STOR A,DRPSW,(Q1)	;STORE NEW PASSWORD STRING POINTER
	JUMPE B,CRDIR2
	CALL RELDFR		;Release storage if any
CRDIR2:	CALL CRDIR6		;RELEASE JSB STORAGE

;SET DEFAULT ACCOUNT STRING

CRDIR3:	TXNN Q3,CD%DAC		;WANT TO SET DEFAULT ACCOUNT?
	JRST CRDR3F		;NO, PROCEED
	UMOVE A,.CDDAC(Q2)	;GET POINTER TO ACCOUNT
	CALL CPYFUS		;DRAG IT IN
	 RETBAD (CRDIX3,<ULKDIR>)
	MOVEM A,CRDIRN		;SAVE ADDRESS OF STRING
	CALL SETMSK		;STORE IN DIRECTORY
	CALL CPYDIR		;AND COPY STRING TO DIRECTORY
	 RETBAD (CRDIX4,<CALL CRDIR6
			 ULKDIR>)
	MOVEI B,.TYNAM		;MARK IT AS A NAME BLOCK
	STOR B,NMTYP,(A)	;
	LOAD B,DRACT,(Q1)	;GET POINTER TO OLD ACCOUNT
	SUB A,DIRORA		;RELATIVE ADDRESS OF ACCOUNT
	STOR A,DRACT,(Q1)	;STORE NEW ACCOUNT POINTER
	JUMPE B,CRDR3E		;WAS THERE AN OLD DEFAULT DIR ACCOUNT?
	CALL RELDFR		;YES, RELEASE SPACE FOR IT
CRDR3E:	CALL CRDIR6		;RELEASE JSB STORAGE

;SET PRIVILEGES

CRDR3F:	TXNN Q3,CD%PRV		;SETTING PRIVILEGES?
	JRST CRDR3G		;NO. SKIP THIS THEN
	UMOVE A,.CDPRV(Q2)	;Get privilege bits
	MOVE B,CAPENB		;LIMIT POSSIBLE PRIVS TO CURRENT USER
	TXNN B,SC%WHL!SC%OPR	;UNLESS WHOPER
	JRST [	MOVE B,A
		ANDCM B,CAPENB
		JUMPE B,.+1
		MOVEI A,CRDI20
		CALL USTDIR
		JRST CRDIR4]
	STOR A,DRPRV,(Q1)	;YES
	;..
;SET MODES

	;..
CRDR3G:	UMOVE A,.CDMOD(Q2)	;GET MODE BITS
	TXNN Q3,CD%MOD		;WANT TO SET MODE?
	JRST CRDI0K		;NO. SKIP
	MOVX B,CDNWF		;IF THIS IS A NEW DIRECTORY
	TDNE B,CRDFLG		; WE HAVE ALREADY CHECKED THE MODES
	JRST CRDI0J		;IT IS, SO SKIP THESE CHECKS
	MOVX B,CDDIR		;IF THE SUPERIOR IS FILES-ONLY
	TDNN B,CRDFLG		; HAVE TO CHECK FOR CREATING LOGIN DIR
	JRST CRDI0J		;NOT FILES-ONLY. OK TO CREATE USER IF DESIRED
	HRRZ B,CRDSUP		;IF SUPERIOR IS ROOT-DIRECTORY
	CAIN B,ROOTDN		; OK TO CREATE LOGIN DIRECTORY
	JRST CRDI0J
	TXNE A,CD%DIR		;TRYING TO MAKE THIS FILES ONLY?
	JRST CRDI0J		;YES. OK
	MOVEI A,CRDI17		;NO. CAN'T MAKE THIS A USER DIRECTORY
	CALL USTDIR		;UNLOCK THE DIRECTORY
	JRST CRDIR4		;TAKE ERROR ROUTE
CRDI0J:	STOR A,DRMOD,(Q1)	;YES

;SET LOGIN DATE

CRDI0K:	UMOVE A,.CDLLD(Q2)	;GET LAST LOGIN DATE
	LOAD B,DRDAT,(Q1)	;GET PREVIOUS DATE
	CAMG A,B		;IS THE NEW DATE BEFORE CURRENT DATE?
	JRST CRDR3A		;YES, DONT LET TIME GO BACKWARDS
	TXNE Q3,CD%LLD		;WANT TO SET IT?
	STOR A,DRDAT,(Q1)	;YES
CRDR3A:	CALL UPDDIR		;UPDATE DISK WITH RESULTS SO FAR

;COMPUTE CHANGES IN LOGGED-IN QUOTA, LOGGED-OUT QUOTA, AND SUBDIRECTORY
;QUOTA. IF DIRECTORY IS NEW, IT CURRENTLY IS SET UP FOR THE DEFAULT
;VALUES

;**;[1963] Delete 1 line, Add 6 lines at CRDR3A:+6L	PED	23-NOV-81
	HRRZ A,CRDIRD		;[1963] GET DIRECTORY NUMBER
	MOVE B,CRDSTX		;[1963]   AND STRUCTURE NUMBER
	CALL GETCAL		;[1963] GET CURRENT ALLOCATION
	 JRST [ LOAD A,DRLIQ,(Q1);[1963] CLOSED - USE LOGGED-IN QUOTA
		JRST CRD3 ]	;[1963]
	OPSTR <ADD A,>,DRDCA,(Q1);[1963] ADD NUMBER IN USE FOR TOTAL QUOTA
CRD3:	UMOVE B,.CDLIQ(Q2)	;GET USERS VALUE
	TXNN Q3,CD%LIQ		;BEING SET?
	MOVE B,A		;NO - NO CHANGE
	SUB A,B			;COMPUTE DELTA
;**;[1899] Add 2 lines at CRDR3A:+6L	JRG	24-JUN-81
	TXNN Q3,CD%LIQ!CD%LOQ	;[1899] CHANGING QUOTAS?
	 JRST CRD3AC		;[1899] NOPE, DON'T CHECK THEM
	MOVEM A,CRDDIQ		;SAVE IT
	MOVX A,CDNWF		;IF THIS IS A NEW FILE, DON'T
	TDNE A,CRDFLG		; TO CHECK ITS ALLOCATION
	JRST CRD3AC
	HRRZ A,CRDIRD		;A/ THIS DIRECTORY'S NUMBER
	MOVE B,CRDSTX		;B/ STRUCTURE NUMBER
	CAIN A,ROOTDN		;IS THIS "ROOT-DIRECTORY"?
	JRST CRD3AC		;YES. ALLOW IT THEN.
	CALL GETCAL		;GET CURRENT ALLOCATION
	 JRST [	LOAD A,DRLIQ,(Q1) ; NO FILES OPEN. GET LOGGED-IN QUOTA
		OPSTR <SUB A,>,DRDCA,(Q1) ; LESS NUMBER OF PAGES IN USE
		JRST .+1]
	SUB A,CRDDIQ		;ADJUST BY AMOUNT OF CHANGE FROM OLD VALUE
	JUMPL A,[ RETBAD (CRDI21,<CALL USTDIR>)] ;NOT ENOUGH QUOTA FOR EXISTING FILES
CRD3AC:	LOAD A,DRLOQ,(Q1)	;GET CURRENT LOQ
	UMOVE B,.CDLOQ(Q2)	;GET USERS VALUE
	TXNN Q3,CD%LOQ		;SETTING LOQ?
	MOVE B,A		;NO - NO CHANGE
	SUB A,B			;COMPUTE DELTA
	MOVEM A,CRDDOQ		;SAVE IT
	SETZM CRDDSQ		;ASSUME NO CHANGE IN SUBDIRECTORY QUOTA
	TXNN Q3,CD%SDQ		;SETTING SDQ?
	JRST CRD3AE		;NO. DON'T CHECK IT
	UMOVE B,.CDSDQ(Q2)	;GET USERS VALUE
	TLNE B,-1		;RIGHT HALF ONLY?
	RETBAD (CRDI24,<CALL USTDIR>) ;NO. WON'T FIT IN ALLOTTED SPACE
	LOAD C,DRSDC,(Q1)	;GET NUMBER OF SUBDIRECTORIES EXISTING
	CAMLE C,B		;IS NEW VALUE LESS THAN THIS?
	RETBAD (CRDI22,<CALL USTDIR>) ;CAN'T REDUCE QUOTA THIS MUCH
	LOAD A,DRSDM,(Q1)	;GET CURRENT SUBDIR QUOTA
	SUB A,B			;GET DELTA
	MOVEM A,CRDDSQ		;SAVE IT
CRD3AE:	CALL USTDIR		;RELEASE DIR
	;..
;IF NOT ROOT-DIRECTORY, VERIFY LIST OF GROUPS FOR SUBDIRECTORIES AND
;LIST OF USER GROUPS FOR THIS DIRECTORY

	;..
	HRRZ A,CRDSUP		;CHECK IF SUPERIOR IS
	CAIN A,ROOTDN		;ROOT-DIRECTORY
	JRST CRDR3B		;IT IS - DONT DECREMENT ANYTHING
	MOVE A,CRDSUP		;GET SUPERIOR DIR
	CALL SETDIR		;MAP IT
	 RETBAD (MONX03)	;ANOTHER IMPOSSIBLE ERROR
	TXNE Q3,CD%CUG		;SETTING CREATABLE USER GROUPS?
	JRST [	UMOVE A,.CDCUG(Q2)	;GET USER CREATABLE GROUPS LIST
		LOAD B,DRCUG,(Q1) ;GET CREATABLE GROUPS LIST
		CALL CDCKCU	;VALIDATE LIST
		 RETBAD(CRDI16,<CALL USTDIR>) ;FAILED
		JRST .+1]	;SUCCESS - GO ON
	TXNE Q3,CD%UGP		;SETTING USER GROUPS?
	JRST [	UMOVE A,.CDUGP(Q2) ;YES - GET USERS LIST
		LOAD B,DRCUG,(Q1) ;GET CREATABLE USER GROUPS LIST
		CALL CDCKCU	;VALIDATE LIST
		 RETBAD(CRDI16,<CALL USTDIR>) ;FAILED
		JRST .+1]
	MOVE A,CRDUFL		;SHOULD THE SUPERIOR BE DECREMENTED?
	TXNE A,CD%NSQ		;...
	JRST CRD3AA		;NO

;ADJUST SUPERIOR'S QUOTAS FOR LOGGED-IN QUOTA, LOGGED-OUT QUOTA, AND
;MAXIMUM SUBDIRECTORIES

	MOVX A,CDNWF		;IF THIS IS A NEW FILE, CHECKS HAVE ALREADY
	TDNE A,CRDFLG		; BEEN MADE
	JRST CRD3AD
	CALL CKLIQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 JRST CRD3AB		;YES. DON'T CHECK
;**;[3015]ADD TWO LINES AT CRD3AE: + 19L	13-SEP-83
	TXNN Q3,CD%LIQ		;[3015]BEING SET?
	JRST CRD3AD		;[3015]NO, DON'T DO CHECKS
	HRRZ A,CRDSUP		;A/ SUPERIOR'S DIRECTORY NUMBER
	MOVE B,CRDSTX		;B/ STRUCTURE NUMBER
	CALL GETCAL		;GET SUPERIOR'S AVAILABLE PAGES
	 JRST [	LOAD A,DRLIQ,(Q1) ;NO OPEN FILES. GET LOGGED-IN QUOTA
		OPSTR <SUB A,>,DRDCA,(Q1) ; LESS PAGES ASSIGNED
		JRST .+1]
	ADD A,CRDDIQ		;ADJUST BY CHANGE IN SUBDIR
	JUMPL A,[ RETBAD (CRDI13,<CALL USTDIR>)] ;CAN'T CHANGE SUPERIOR
CRD3AD:	LOAD A,DRLIQ,(Q1)	;GET LIQ
	ADD A,CRDDIQ		;ADD DELTA
CRD3AB:	LOAD B,DRLOQ,(Q1)	;GET LOQ
	ADD B,CRDDOQ		;ADD DELTA
	CALL CKLOQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 SKIPA			;YES. DON'T CHECK
	JUMPL B,[ RETBAD(CRDI14,<CALL USTDIR>)] ;LOQ EXHAUSTED
	LOAD C,DRSDM,(Q1)	;GET SDQ
	ADD C,CRDDSQ		;ADD DELTA
	MOVE D,C		;COPY IT
	OPSTR <SUB D,>,DRSDC,(Q1) ;SUBTRACT NUMBER OF SUBDIRS EXISTING
	JUMPL D,[ RETBAD(CRDI15,<CALL USTDIR>)] ;SDQ EXHAUSTED
	CALL CKLIQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 SKIPA			;YES. DON'T ADJUST LOGGED-IN QUOTA
	JRST [	STOR A,DRLIQ,(Q1) ;NO. ADJUST LOGGED-IN QUOTA
		JRST .+1]
	CALL CKLOQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 SKIPA			;YES. DON'T ADJUST LOGGED-OUT QUOTA
	JRST [	STOR B,DRLOQ,(Q1) ;NO. ADJUST LOGGED-OUT QUOTA
		JRST .+1]
	STOR C,DRSDM,(Q1)	; ...
	HRRZ A,CRDSUP		;A/ SUPERIOR'S DIRECTORY NUMBER
	MOVE B,CRDSTX		;B/ STRUCTURE NUMBER
	MOVE C,CRDDIQ		;C/ CHANGE IN QUOTA
	CALL CKLIQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 SKIPA			;YES. DON'T ADJUST ALLOCATION ENTRY
	CALL ADJALC		;ADJUST SUPERIOR'S ALLOCATION ENTRY
CRD3AA:	CALL UPDDIR		;UPDATE DISK IMAGE
	CALL USTDIR		;NEW VALUES PASS LIMIT CHECKS

;SET USER GROUPS FOR SUBDIRECTORIES AND THIS DIRECTORY'S USER GROUPS

CRDR3B:	MOVE A,CRDIRD		;MAP OBJECT DIR AGAIN
	HLL A,CRDSUP		; ...
	CALL SETDIR		; ...
	 RETBAD(MONX03)		;SHOULD BE IMPOSSIBLE
	CALL CHKCHG		;SHOULD PARAMETERS BE CHANGED
	 JRST CRDR3D		;NO
	UMOVE A,.CDCUG(Q2)	;GET CREATABLE USER GROUPS
	TXNE Q3,CD%CUG		;SETTING THEM?
	CALL CRDCUP		;YES - COPY TO DIR
	UMOVE A,.CDUGP(Q2)	;GET USER GROUPS
	TXNE Q3,CD%UGP		;WANT TO SET USER GROUPS?
	CALL CRDUGP		;YES, GO SET UP USER GROUPS
	;..
;DO ALLOCATION, DEFAULT PROTECTION, DIRECTORY PROTECTION
; Online & offline expiration defaults

	UMOVE A,.CDLOQ(Q2)	;GET LOGGED OUT QUOTA
	TXNE Q3,CD%LOQ		;SET IT?
	STOR A,DRLOQ,(Q1)	;YES
	UMOVE A,.CDLIQ(Q2)	;GET LOGGED IN QUOTA
	TXNE Q3,CD%LIQ		;SET LOGGED IN QUOTA?
	STOR A,DRLIQ,(Q1)	;YES
	HRRZ A,CRDIRD		;A/ DIRECTORY NUMBER
	MOVE B,CRDSTX		;B/ STRUCTURE NUMBER
	MOVN C,CRDDIQ		;C/ AMOUNT TO ADD TO QUOTA
	CAIE A,ROOTDN		;IS THIS "ROOT-DIRECTORY"?
	CALL ADJALC		;NO, ADJUST ALLOCATION ENTRY FOR THIS DIRECTORY
	UMOVE A,.CDSDQ(Q2)	;GET SUBDIR QUOTA
	TXNE Q3,CD%SDQ		;SETTING IT?
	STOR A,DRSDM,(Q1)	;YES.
	UMOVE A,.CDFPT(Q2)	;Default file protection
	ANDI A,777777
	TLO A,500000
	TXNE Q3,CD%FPT		;SET FILE PROTECTION?
	STOR A,DRDPW,(Q1)	;YES
	UMOVE A,.CDDPT(Q2)	;GET DIRECTORY PROTECTION
	ANDI A,777777
	TLO A,500000
	TXNE Q3,CD%DPT		;SET IT?
	STOR A,DRPRT,(Q1)	;YES
	MOVE B,CRDUFL		; Get flags
	UMOVE A,.CDDNE(Q2)	; Get user's online exp choice
	TXNE B,CD%NED		; Want to change that?
	STOR A,DRDNE,(Q1)	; Yes, set it
	TXNN B,CD%FED		; Want to do offline?
	JRST CRD3BB		; No, skip over that
	UMOVE A,.CDDFE(Q2)	; Get what user wants
;**;[3113] REPLACE 15 LINES AT CRD3BB-16 (SPR #20128)
	MOVE B,CAPENB		;[3113]
	SKIPE TPRCYC		;[3113] If user is wheel or no system limit set,
	TXNE B,SC%WHL		;[3113] don't check range.
      IFSKP.			;[3113]
	  TLNN A,-1		;[3113]  Is it an interval?
	IFSKP.			;[3113]
	  CALL LGTAD		;[3113] NO, A DATE. GET NOW
	  HLRZ D,A		;[3113] COMPUTE MAX ALLOWED END DAY
	  ADD D,TPRCYC		;[3113]
	  UMOVE A,.CDDFE(Q2)	;[3113]
	  HLRZ B,A		;[3113] GET USER SPECIFIED END DAY
	  CAMLE B,D		;[3113] LEGAL?
	  RETBAD(ARGX27,<ULKDIR>) ;[3113]   Out of reasonable range
	ELSE.			;[3113]
	  CAMLE A,TPRCYC	;[3113]  Within range?
	  RETBAD(ARGX27,<ULKDIR>) ;[3113]  No
	ENDIF.			;[3113]
      ENDIF.			;[3113]
	STOR A,DRDFE,(Q1)
CRD3BB:

;DO RETENTION SPEC, DIRECTORY GROUPS

	UMOVE A,.CDRET(Q2)	;GET # OF GENERATIONS TO KEEP
	ANDI A,777777
	TLO A,500000
	TXNE Q3,CD%RET		;SET IT?
	STOR A,DRDBK,(Q1)	;YES
	UMOVE A,.CDDGP(Q2)	;GET DIRECTORY GROUPS
	TXNE Q3,CD%DGP		;SET DIR GROUPS?
	CALL CRDDGP		;YES, GO SET UP DIR GROUP LIST
CRDR3D:	CALL UPDDIR		;FIX DIR ON DISK
	ULKDIR
	SKIPN CRDCPY		;WANT TO CALL CPYBAK?
	JRST CRDR3C		;NO
	HRRZ A,CRDSTX		;GET STRUCTURE NUMBER
	CALL CPYBAK		;MAKE A COPY OF THE ROOT-DIRECTORY
	 JRST [	MOVEI B,ROOTDN	;FAILED, SEE IF WE ARE CREATING ROOT-DIR
		CAME B,CRDIRD ;BACKUP FILE NOT CREATED YET IF ROOT
		BUG(CRDBAK)
		JRST .+1]
	;..
;MAKE THE MESSAGE FILE IF DIRECTORY IS NOT FILES-ONLY

	;..
;**;[1843] Add 3 lines at CRDR3C: +0L	JGZ	8-APR-81
CRDR3C:	MOVX T1,CDNWF		;[1843] IF THIS IS A NEW DIRECTORY
	TDNN T1,CRDFLG		;[1843]	 THEN CONTINUE
	 JRST CRDIR5		;[1843] NOT CREATING DIRECTORY - LEAVE ALONE
	HLL B,CRDSUP		;GET STR UNIQUE CODE
	HRR B,CRDIRD		;GET THE DIRECTORY NUMBER
	HRROI A,CRDIRS		;RESTORE POINTER
	DIRST
	 JRST [	CALL CRBUG1	;REPORT TROUBLE
		JRST CRDIR5]	;CLEAN UP AND ABORT
	MOVEM A,CRDIRT		;SAVE CURRENT POINTER
	SETZ A,
	HRROI B,CRDIRS		;FORM POINTER TO START OF DIRECTORY SPEC
	RCDIR			;GET DIRECTORY FLAGS
	TXNE A,RC%DIR		;FILES ONLY DIRECTORY?
	 JRST CRDIR5		;YES, DON'T MAKE MESSAGE FILE
	MOVE A,CRDIRT		;GET POINTER TO LAST CHAR
	HRROI B,[ASCIZ /MAIL.TXT;P770404/]
	SETZ C,
	SOUT
	CALL CRDSWH		;SET WHEEL
	HRROI B,CRDIRS		;GET START OF NAME STRING
	MOVE A,[GJ%FOU!GJ%PHY!GJ%SHT+1] ;VERSION 1
	GTJFN
	 JRST [	CALL CRBUG1	;REPORT TROUBLE
		JRST CRDR8A]	;CLEAN UP AND ABORT
	MOVE D,A		;SAVE JFN
	MOVE B,[070000,,OF%RD+OF%WR+OF%PDT]
	OPENF			;MAKE THE FILE EXIST
	 MOVE A,D		;IGNOR ERROR
	MOVE B,[1,,.FBCTL]	;GET THE CONTROL BITS
	MOVEI C,C
	GTFDB
	TXNN C,FB%NXF		;SEE IF THE FILE EXISTED BEFORE
	JRST CRDIR8		;YES, DONT CHANGE ITS STATE
	HRLI A,.FBCTL
	MOVX B,FB%PRM+FB%DEL
	MOVX C,FB%PRM+FB%DEL	;MAKE IT PERMANENT AND DELETED
	CHFDB
CRDIR8:	HRRZS A
	CLOSF			;RELEASE THE JFN
	 JFCL
CRDR8A:	CALL CRDCWH		;CLEAR WHEEL
	;..
;HERE ON SUCCESSFUL COMPLETION.  RETURN DIRECTORY NUMBER TO USER

	;..
CRDIR5:
	HLL A,CRDSUP		;GET STR UNIQUE CODE
	HRR A,CRDIRD		;FORM 36-BIT DIRECTORY DESIGNATOR
	UMOVEM A,1		;RETURN IT IN USER AC 1
	RETSKP			;GIVE SUCCESSFUL RETURN

; ERROR ROUTINES

CRDIR4:	MOVEM A,CRDIRE		;SAVE ERROR CODE
	CALL CRDIR6		;RELEASE JSB SPACE
	HRRZ A,CRDIRJ		;GET JFN OF DIR FILE
	JUMPE A,CRDR00		;DON'T RELEASE IT IF ALREADY RELEASED
	MOVX B,CDNWF		;IS THIS A NEW FILE?
	TDNN B,CRDFLG		;??
	JRST CRDR01		;NO. DON'T EXPUNGE IT OR CLEAR IDXTAB
	HRLI A,(DF%EXP)		;EXPUNGE THE FILE
	DELF
	JFCL			;IGNORE ERRORS
	SKIPG A,CRDIRD		;GET DIR NUMBER
	CALL DELIDX		;GET RID OF INDEX TABLE ENTRY
CRDR01:	HRRZ A,CRDIRJ		;GET BACK THE JFN
	RLJFN			;RELEASE THE JFN
	JFCL
CRDR00:	MOVE A,CRDIRE		;GET BACK ERROR CODE
	RETBAD ()		;AND EXIT

CRDIR6:	MOVEI A,JSBFRE		;RELEASE NAME STRING SPACE
	HRRZ B,CRDIRN		;B/ ADDRESS OF JSB FREE SPACE
	JUMPE B,R		;DON'T RELEASE IF THERE ISN'T ANY
	CALL RELFRE		;RELEASE THE BLOCK FOR LOCAL VARIABLES
	SETZM CRDIRN		;INDICATE THERE IS NO SPACE ASSIGNED NOW
	RET
;ROUTINE TO CHECK IF EXISTING PARAMETERS SHOULD BE CHANGED
;	CALL CHKCHG
;RETURNS +1:	PARAMETERS SHOULD NOT BE CHANGED
;	 +2:	CHANGES ARE DESIRED

CHKCHG:	MOVE B,CRDUFL		;GET THE USER FLAGS
	MOVE A,CRDFLG		;GET LOCAL FLAGS
	TXNN B,CD%NCE		;NO CHANGES IF EXIST BIT ON?
	RETSKP			;NO, DO THE CHANGES ALWAYS
	TXNE A,CDNWF		;YES, IS THIS A NEW DIRECTORY?
	TXNE A,CDREC		;YES, IS THIS A RECONSTRUCTION?
	RET			;DO NOT DO THE CHANGES
	RETSKP			;NEW AND NO RECONSTRUCT, DO THE CHANGES


;ROUTINE TO CHECK IF RECONSTRUCTION IS NEEDED
;	CALL CHKREC
;RETURNS +1:	NO RECONSTRUCTION
;	 +2:	RECONSTRUCTION TO BE DONE
;		A/	DISK ADR OF INDEX BLOCK OF DIRECTORY FILE

CHKREC:	SAVEQ			;SAVE PERMANENT ACS
	MOVE A,CRDIRD		;GET DIR NUMBER
	CALL GETIDX		;SEE IF THE NUMBER WAS IN USE
	 RET			;NO
	TXNE D,IDX%IV		;IS THIS ENTRY INVALID?
	JRST CHKRC2		;YES, GO DELETE IT
	MOVE Q3,B		;SAVE THE ADR OF THE INDEX BLOCK
	MOVE A,CRDIRD		;GET THE DIR NUMBER AGAIN
	HRRZ B,CRDSTX		;GET STRUCTURE NUMBER
	MOVE B,STRTAB(B)	;GET UNIQUE CODE
	LOAD B,STRUC,(B)	;...
	HRL A,B			;BUILD A 36-BIT DIR NUMBER
	CALL SETDIR		;MAP IN THAT DIRECTORY
	 JRST CHKRC2		;DIR IS BAD, GO DELETE IT
	CALL CHKNAM		;SEE IF THE NAME STRINGS MATCH
	 JRST CHKRC1		;NO, NO RECONSTRUCTION
	CALL USTDIR		;THE NAMES MATCH, DO RECONSTRUCTION
	MOVE A,Q3		;RETURN ADR OF INDEX BLOCK
	RETSKP			;GO AND DO RECONSTRUCTION

CHKRC1:	CALL USTDIR		;GO UNLOCK THE DIR
CHKRC2:	MOVE A,CRDIRD		;GET DIR NUMBER
	CALL DELIDX		;DELETE THE ENTRY FROM THE IDXTAB
	RET			;AND GO CREATE THE DIR WITHOUT RECONSTRUCTION
;ROUTINE TO COMPARE THE NAME STRING IN A DIRECTORY WITH THE NAME
;	STRING GIVEN BY THE USER
;ASSUMES THE CORRECT DIRECTORY IS MAPPED, AND THAT THE NAME STRING
;	IS SET UP IN CRDDNM

;RETURNS +1:	NAMES DO NOT MATCH
;	 +2:	NAMES MATCH

CHKNAM:	SAVEQ
	MOVE Q1,DIRORA		;GET START OF DIR AREA
	LOAD Q1,DRNAM,(Q1)	;GET POINTER TO THE DIRECTORY NAME
	ADD Q1,DIRORA		;GET ABS ADR OF DIR NAME
	MOVSI Q2,(POINT 7,(Q1),35)
	MOVE C,[POINT 7,CRDDNM]	;GET POINTER TO THIS DIR NAME
CHKNA0:	ILDB A,Q2		;GET NEXT CHAR FROM DIRECTORY
	ILDB B,C		;GET NEXT CHAR FROM CRDIR DATA BASE
	CAME A,B		;MATCH?
	RET			;NO
	JUMPN A,CHKNA0		;YES, CHECK THROUGH THE NULL
	RETSKP			;NAMES MATCH

;ROUTINES TO SET UP A LIST OF GROUPS IN THE DIRECTORY
;ACCEPTS IN A/	36 BIT GROUP DESIGNATOR
;	CALL CRDUGP	OR	CALL CRDDGP
;RETURNS +1:	ALWAYS

CRDUGP:	PUSH P,A		;SAVE NEW VALUE
	LOAD B,DRUGP,(Q1)	;GET OLD SETTING
	SKIPE B
	CALL RELDFR		;RELEASE DIR SPACE OF OLD GROUP LIST
	POP P,A			;GET BACK NEW SETTING
	CALL CRGDGB		;GET DIR GROUP BLOCK SET UP
	 MOVEI A,0		;FAILED, DONT SET ANY GROUPS
	STOR A,DRUGP,(Q1)	;STORE USER GROUPS
	RET			;AND RETURN

CRDDGP:	PUSH P,A		;SAVE NEW SETTING
	LOAD B,DRDGP,(Q1)	;GET POINTER TO OLD LIST
	SKIPE B			;IF THERE IS ONE
	CALL RELDFR		;THEN RELEASE THE SPACE
	POP P,A			;GET BACK NEW VALUE
	CALL CRGDGB		;GET A NEW DIR GROUP BLOCK
	 MOVEI A,0		;FAILED, DONT SET ANY
	STOR A,DRDGP,(Q1)	;STOR POINTER INTO DIR
	RET			;AND RETURN
;ROUTINE TO SETUP THE CREATABLE USER GROUPS LIST
;A/ USER ADDRESS OF NEW GROUP LIST
;	CALL CRDCUP
;RETURNS+1(ALWAYS):
;	NEW GROUP LIST SETUP

CRDCUP:	PUSH P,A		;SAVE POINTER TO NEW LIST
	LOAD B,DRCUG,(Q1)	;GET POINTER TO OLD LIST
	SKIPE B			;WAS THERE ANY?
	CALL RELDFR		;YES - RELEASE IT
	POP P,A			;RECOVER NEW LIST
	CALL CRGDGB		;CREATE NEW LIST
	 MOVEI A,0		;FAILED - SETUP NIL
	STOR A,DRCUG,(Q1)	; ...
	RET

;ROUTINE TO CHECK A LIST IN USER ADDRESS SPACE AGAINS A LIST IN
;A DIRECTORY

;A/ USER ADDRESS OF LIST
;B/ RELATIVE DIRECTORY ADDRESS OF GROUP BLOCK
;	CALL CDCKCU
;RETURNS+1:
;	USER LIST IS NOT A SUBSET OF DIR LIST
;RETURNS+2:
;	USER LIST IS A SUBSET OF DIR LIST

CDCKCU:	STKVAR <CDCKPT,CDCKCT,CDCKDP> ;KIUSER PTR, USER COUNT, DIR PTR
	MOVEM A,CDCKPT		;SAVE USER POINTER
	MOVEM B,CDCKDP		;SAVE DIR POINTER
	UMOVE A,(A)		;GET COUNT FROM USERS LIST
	MOVEM A,CDCKCT		;SAVE COUNT
	JUMPLE A,R		;CHECK FOR GARBAGE COUNT
	SOJE A,RSKP		;IF NULL LIST, ALL DONE
	JUMPE B,R		;IF NON-NULL USER LIST AND NO DIR LIST, NO MATCH
CDCKU1:	SOSG CDCKCT		;DECREMENT USER COUNT
	RETSKP			;END OF LIST - SUCCESS
	AOS A,CDCKPT		;STEP USER POINTER
	MOVE C,CDCKDP		;GET DIR POINTER
	ADD C,DIRORA		;AS ABSOLUTE ADDRESS
	LOAD D,BLKLEN,(C)	;GET BLOCK LENGTH
	SUB C,DIRORA		;AS RELATIVE ADDRESS
	HRLI C,(<POINT 18,.-.(Q1),35>) ;BUILD BYTE POINTER
CDCKU2:	SOJLE D,R		;EXHAUSTED DIR LIST - FAILURE
	ILDB B,C		;GET NEXT GROUP FROM DIR
	XCTU [CAMN B,(A)]	;COMPARE WITH USER LIST ELEMENT
	JRST CDCKU1		;EQUAL - GET NEXT USER ELEMENT
	ILDB B,C		;GET NEXT GROUP FROM DIR
	XCTU [CAMN B,(A)]	;COMPARE WITH USER ELEMENT
	JRST CDCKU1		;EQUAL - GET NEXT USER ELEMENT
	JRST CDCKU2		;NOT EQUAL - KEEP LOOKING
;ROUTINE TO GET SPACE IN DIR FOR GROUP LIST AND TO BUILD THE LIST
;ACCEPTS IN A/	ADDRESS OF LIST OF GROUP NUMBERS IN USER SPACE
;	CALL CRGDGB
;RETURNS +1:	FAILED
;	 +2:	RELATIVE ADR OF LIST IN AC A

CRGDGB:	STKVAR <CRGDGA,CRGDGC>
	TLNE A,-1		;GUARD AGAINST OLD FORMAT OF GROUPS
	JRST [	BUG(CRDOLD)
		RET]		;GIVE FAILURE RETURN
	MOVEM A,CRGDGA		;SAVE ADDRESS OF LIST IN USER SPACE
	JUMPE A,RSKP		;IF NO LIST, RETURN WITH A=0
	XCTU [HRRZ B,0(A)]	;GET LENGTH OF LIST
	SETZ A,			;SET UP FOR NULL LIST
	CAIG B,1		;LIST MUST HAVE MORE THAN HEADER
	RETSKP			;NULL LIST, RETURN WITH 0 IN A
	MOVEM B,CRGDGC		;SAVE LENGTH OF LIST
	ADDI B,2		;LEAVE ROOM FOR HEADER
	LSH B,-1		;WORDS ARE PACKED WHEN STORED IN DIR
	CALL ASGDFR		;GET SPACE FOR LIST
	 RETBAD (CRDIX4)	;FAILED TO GET SPACE
	MOVEI B,.TYGDB		;SET UP BLOCK TYPE
	STOR B,BLKTYP,(A)	;...
	MOVE B,CRGDGA		;GET POINTER TO USER LIST
	MOVEM A,CRGDGA		;SAVE ADR OF LIST IN DIR
	SOS C,CRGDGC		;GET COUNT OF ELEMENTS IN LIST
CRGDG1:	UMOVE D,1(B)		;GET NEXT GROUP NUMBER FROM USER SPACE
	HRLZM D,1(A)		;STORE IN DIR LIST
	AOS B			;STEP TO NEXT ELEMENT IN USER LIST
	SOJLE C,CRGDG2		;COUNT DOWN NUMBER OF GROUPS
	UMOVE D,1(B)		;GET NEXT GROUP FROM USER LIST
	HRRM D,1(A)		;STORE IT IN DIRECTORY
	AOS A			;STEP TO NEXT WORD IN DIR
	AOS B			;AND STEP USER LIST
	SOJG C,CRGDG1		;LOOP BACK FOR ALL GROUPS
CRGDG2:	MOVE A,CRGDGA		;GET ABS ADR OF LIST
	SUB A,DIRORA		;GET RELATIVE ADR
	RETSKP			;AND GIVE OK RETURN
;ROUTINE TO FIX UP ROOT DIR WHEN IT IS BEING CREATED DURING FILINI
;ACCEPTS IN A/ ADR OF FDB
;	    B/ STRUCTURE NUMBER
;	CALL RDFIX
;RETURNS +1:	ALWAYS

RDFIX:	MOVE B,STRTAB(B)	;GET ADDRESS OF SDB FOR THIS STRUCTURE
	LOAD B,STRRXB,(B)	;GET ADDRESS OF INDEX BLOCK FOR ROOT-DIRECTORY
	STOR B,FBADR,(A)	;MAKE FILE EXIST
	SETZRO FBNXF,(A)	;FILE NOW EXISTS
	SETONE FB%SDR,.FBCTL(A) ;SUBDIRS PRESENT
	MOVEI B,377777		;INITIALIZE SUBDIR LIMIT TO INF
	STOR B,DRSDM,(Q1)	; ...
	RET			;AND RETURN


;ROUTINE TO SET UP THE INDEX TABLE OF NEW DIRECTORIES
;ACCEPTS IN A/	ADR OF INDEX BLOCK IF ANY (0 IF NONE)
;	CALL CRDIDX
;RETURNS +1:	ERROR
;	 +2:	SUCCESSFUL - INDEX TABLE SET UP

CRDIDX:	STKVAR <CRDIDA>
	MOVEM A,CRDIDA		;SAVE DISK ADDRESS OF INDEX BLOCK
	HRRZ JFN,CRDIRJ		;GET JFN OF DIR FILE
	IMULI JFN,MLJFN		;GET INDEX INTO JFN TABLES
	MOVE STS,FILSTS(JFN)	;SET UP FOR CALL TO GETFDB
	HRRI DEV,DSKDTB
	HRL DEV,CRDSTX		;GET STRUCTURE NUMBER
	CALL GETFDB		;GET THE FDB MAPPED IN
	 RETBAD			;FAILED
	MOVEM A,CRDTMP		;SAVE ADDRESS OF FDB
	SETONE <FBNOD,FBDIR>,(A) ;MARK THAT THIS IS A DIR FILE
	MOVE C,CRDIRD		;GET DIRECTORY NUMBER
	STOR C,FBDRN,(A)	;STORE DIR # IN FDB OF DIR FILE
	MOVEM A,CRDIRT		;SAVE FDB ADDRESS
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER
	CAIN C,ROOTDN		;IS THIS THE ROOT DIR BEING CREATED?
	CALL RDFIX		;YES, SET UP SPECIAL INFO
	LOAD D,DRNUM,(Q1)	;GET DIR NUMBER OF SUPERIOR
	MOVE B,CRDIRT		;GET ADR OF FDB
	SUB B,DIRORA		;MAKE IT RELATIVE ADDRESS
	MOVE A,CRDIRT		;GET ADR OF FDB AGAIN
	SKIPN C,CRDIDA		;IF AN ADDRESS WAS SPECIFIED, USE IT
	LOAD C,FBADR,(A)	;GET ADDRESS OF INDEX BLOCK OF FILE
	LOAD A,FBDRN,(A)	;GET DIR NUMBER
	CALL SETIDX		;SET UP THE INDEX TABLE
	 JRST CRDIDE		;FAILED
	SKIPN B,CRDIDA		;IS THERE A DISK ADDRESS?
	JRST CRDID1		;NO
	MOVE A,CRDTMP		;YES, DOING RECONSTRUCTION
	STOR B,FBADR,(A)	;STORE THIS ADDRESS IN THE FDB
	SETZRO FBNXF,(A)	;AND MAKE THIS FILE EXISTENT
CRDID1:	ULKDIR			;UNLOCK THE DIR
	MOVE A,CRDIRT		;GET BACK FDB ADDRESS
	RETSKP			;AND RETURN

CRDIDE:	MOVE B,CRDTMP		;GET ADDRESS OF FDB
	SETZRO FBDIR,(B)	;UNDO WHAT CRDIDX HAS ALREADY DONE
	SETZRO FBDRN,(B)
	ULKDIR			;NOW UNLOCK THE DIR
	RETBAD ()


;COMMON FAILURE CASE FOR ABOVE

CRBUG1:	BUG(CRDNOM)
	RET
;DELDIR - DELETE THIS DIRECTORY

DELDIR:	SETZM CRDIRF		;INITIALIZE ERROR FLAG
	SETZM CRDIRE		;INITIALIZE ERROR CODE
	CALL CRDIR6		;RETURN ALL SPACE USED
	SETZM CRDDIQ		;CLEAR DELTAS IN CASE DIR IS BAD
	SETZM CRDDOQ		; ...
	SETZM CRDDSQ		; ...

;**;[1772] Revamp [1749] lines at DELDIR: +7L	JGZ	28-AUG-80
;**;[1749] Add lots of code at DELDIR: +7L	TJG	30-JUN-80
;[1749] TCO 5.1082 CHECK FOR OTHER JOB USING THIS DIRECTORY

	HLL T1,CRDSUP		;[1749]GET THE STRUCTURE UNIQUE CODE
	HRR T1,CRDIRD		;[1749] GET THE DIRECTORY NUMBER
	CALL SETDIR		;[1749] MAP THE DIRECTORY
	 JRST [ SETOM CRDIRF	;[1749] ASSUME DIRECTORY IS BAD
		JRST DELDI2 ]	;[1749] AND CONTINUE
	CALL GETIDX		;[1749] GET THE INDEX INFORMATION
	 JRST [ SETOM CRDIRF	;[1749] JUST WENT BAD?
		JRST DELDI2 ]	;[1749] CONTINUE
	PUSH P,T1		;[1749] SAVE THE INDEX INFO
	PUSH P,T2		;[1749] FOR CRDONE BELOW
	HRRZ T1,CRDIRD		;[1749] GET THE DIRECTORY # AGAIN
	NOINT			;[1749] BECOME UNINTERRUPTED
	CALL INVIDX		;[1749] INVALIDATE THE INDEX SO WE CAN LOOK AROUND
	MOVSI STS,-NJOBS	;[1749] SETUP AOBJN POINTER FOR DDLOOP
	HLL DEV,CRDSUP		;[1749] GET THE UNIQUE CODE AGAIN
	HRR DEV,CRDIRD		;[1749] AND THE DIRECTORY NUMBER
	LOAD P3,CURSTR		;[1749] AND THE STRUCTURE NUMBER
DDLOOP:	HRRZ T1,STS		;[1749] GET THE JOB NUMBER
	CAMN T1,JOBNO		;[1749] IS IT US?
	 JRST DDNXT		;[1749] YES, WE'LL CHECK THAT LATER
	CALL MAPJSB		;[1749] MAP THE OTHER JOB'S JSB
	 JRST DDNXT		;[1749] MUST NOT EXIST...
	CALL GTOJCD		;[1749] GET THE OTHER GUY'S CONNECTED DIRECTORY
	CAMN T1,DEV		;[1749] MATCH?
	 JRST DDBMB		;[1749] YES, RETURN AN ERROR
	CALL CLRJSB		;[1749] UNMAP THE OTHER JSB
	CAIE P3,PSNUM		;[1749] ARE WE LOOKING AT PS:?
	 JRST DDNXT		;[1749] NO, DON'T BOTHER LOOKING AT LOGGED-IN DIR.
	HRRZ T1,JOBDIR(STS)	;[1749] GET THE LOGGED-IN DIR OF OTHER JOB
	HRRZ T2,CRDIRD		;[1749] AND THE ONE WE'RE DELETING
	CAMN T1,T2		;[1749] ARE THEY THE SAME?
	 JRST DDBMB		;[1749] YES, DO THE ERROR RETURN
DDNXT:	AOBJN STS,DDLOOP	;[1749] LOOK AT EVERY JOB ON THE SYSTEM
	POP P,T3		;[1749] OK TO DELETE, GET THE INDEX INFO
	POP P,T2		;
	CALL CRDONE		;[1749] GO VALIDATE THE INDEX ENTRY

;DON'T LET USER DELETE THIS DIRECTORY IF CONNECTED TO IT

	CALL GTCSCD		;GET CONNECTED STRUCTURE,,DIRECTORY
	HLL B,CRDSUP		;GET UNIQUE CODE
	HRR B,CRDIRD		;GET (STRUCTURE,,DIRECTORY) TO DELETE
	CAMN A,B		;TRYING TO DELETE CONNECTED DIRECTORY?
;**;[1772] Revamp [1756] lines at DDNXT: +11L	JGZ	28-AUG-80
;**;[1756] Add one line in literal at DDNXT: +11L	TJG	14-JUL-80
	JRST [	CALL USTDIR	;[1756] UNLOCK DIRECTORY
		MOVEI D,CRDI19	;YES. DON'T ALLOW IT
		JRST DELDI3]	;GO CLEAN UP AND FAIL
	MOVE A,B		;A/(UNIQUE CODE,,DIRECTORY) TO DELETE

;DON'T ALLOW USER TO DELETE THIS DIRECTORY IF LOGGED-IN TO IT.

	MOVE A,JOBNO		;GET THIS JOB NUMBER
	HRRZ A,JOBDIR(A)	;GET ITS LOGGED-IN DIRECTORY NUMBER ON PS
	LOAD B,DRNUM,(Q1)	;GET NUMBER OF MAPPED DIRECTORY
	CAME A,B		;DO THEY MATCH?
	JRST DELDI6		;NO. OK TO DELETE IT
	LOAD B,CURSTR		;YES. GET STRUCTURE NUMBER FOR THIS DIRECTORY
	CAIE B,PSNUM		;IS IT THE PUBLIC STRUCTURE?
	JRST DELDI6		;YES. OK TO DELETE IT
	MOVEI D,CRDI18		;YES. CAN'T DELETE LOGGED-IN DIRECTORY
	CALL USTDIR		;UNLOCK THE DIRECTORY
	JRST DELDI3		;GO RETURN ERROR

;**;[1772] Revamp [1749] lines at DELDI6: -25L	JGZ	28-AUG-80
;**;[1749] Add code at DELDI6: -4L	TJG	30-JUN-80
;[1749] ROUTINE TO RETURN ERROR FROM DDLOOP ABOVE

DDBMB:	POP P,T3		;[1749] RESTORE IDXTAB STUFF
	POP P,T2		;[1749]
	CALL CRDONE		;[1749] GO CLEAN UP
	CALL CLRJSB		;[1749] UNMAP THE OTHER JOB'S JSB
	CALL USTDIR		;[1749] UNLOCK THE DIRECTORY
	OKINT			;[1749] MAKE US INTERRUPTIBLE
	MOVEI T4,CRDIX6		;[1749] SET ERROR TO "STILL MAPPED"
	JRST DELDI3		;[1749] GO TO ERROR RETURN

;[1749] ROUTINE TO RESET IDXTAB ENTRY FOR DDLOOP ABOVE

CRDONE:	HRRZ T1,CRDIRD		;[1749] GET DIR NUMBER
;**;[1784] FIX [1749] AT CRDONE: +1L	TJG	19-SEP-80
;	LOAD T4,CURSTR		;[1749] GET STRUCTURE NUMBER
;	HRLS T4			;[1749] SWAP IT TO LH
	HRRZ T4,CRDSUP		;[1749] SUPERIOR DIRECTORY NUMBER
	CALL SETIDX		;[1749] RESET INDEX ENTRY
	 RET			;[1749] SHOULD NOT HAPPEN
	RET			;[1749] ALL DONE.

;SAVE THE QUOTAS (DISK AND SUBDIRECTORY) FOR THIS DIRECTORY SO THEY
;CAN BE GIVEN BACK TO ITS SUPERIOR

DELDI6:	LOAD A,DRLIQ,(Q1)	;GET LIQ
	MOVEM A,CRDDIQ		;SAVE AS DELTA LIQ FOR SUPERIOR
	LOAD A,DRLOQ,(Q1)	;GET LOQ
	MOVEM A,CRDDOQ		;SAVE AS DELTA
	LOAD A,DRSDM,(Q1)	;GET SUBDIR QUOTA
	MOVEM A,CRDDSQ		;SAVE
	CALL USTDIR		;RELEASE DIR
;SEE IF DIRECTORY FILE IS MAPPED. IF SO, THE DIRECTORY CAN'T BE DELETED
;IN THIS MANNER

	MOVE A,CRDIRJ		;1/JFN
	MOVE B,[1,,.FBADR]	;2/(COUNT,,OFFSET INTO FDB)
	MOVEI C,D		;3/DESTINATION FOR RESULT
	GTFDB			;GET ADDRESS OF INDEX BLOCK
	 ERJMP [SETOM CRDIRF	;DIRECTORY IS BAD. DON'T BOTHER TO CHECK
		JRST DELDI2]	;GO DELETE THE DIRECTORY ANYWAY
	MOVEM D,CRDIRA		;SAVE IT
	CALL UNMAPD		;UNMAP THE DIRECTORY TO BE DELETED
	MOVE A,CRDIRA		;A/ADDRESS OF INDEX BLOCK
	HRRZ B,CRDSTX		;B/STRUCTURE NUMBER
	CALL CHKOFN		;SEE IF THIS FILE IS OPEN (DIRECTORY IS MAPPED)
;**;[1878] Replace one line with two lines at DELDI6: +20L  RAS	20-MAY-81
	 JRST [	MOVEI D,CRDIX6	;[1878] YES. CAN'T DELETE THE FILE, THEN
		JRST DELDI3]	;[1878] RELEASE JFN AND RETURN

;DELETE AND EXPUNGE ALL THE FILES IN THIS DIRECTORY. THIS WILL FAIL IF THE
;DIRECTORY HAS SUBDIRECTORIES

	HRRZ A,CRDSTX		;GET STRUCTURE NUMBER
	CALL STRCNV		;GET UNIQUE CODE FOR THIS STRUCTURE
	 JRST [	MOVE D,A	;FAILED, GET ERROR CODE
		JRST DELDI3 ]	;GO RETURN ERROR
	HRL A,A			;POSITION UNIQUE CODE
	HRR A,CRDIRD		;Get directory number to delete
	MOVX F,1B17		;DELETE AND EXPUNGE ALL FILES FROM DIR
	CALL DELDEL
	 JRST [	MOVEM T1,CRDIRE ;FAILED. SAVE ERROR CODE
		JRST DELDI1]	;GO SEE WHY FAILED
;FILES MAY OR MAY NOT HAVE BEEN DELETED AT THIS POINT.  NOW CLEAR DIRECTORY
;AND PERMANENT BITS SO THAT DIRECTORY FILE CAN BE DELETED

DELDI2:	HRRZ JFN,CRDIRJ		;GET JFN
	IMULI JFN,MLJFN		;GET INTERNAL FORMAT
	MOVE STS,FILSTS(JFN)	;SET UP FOR GETFDB CALL
	HRRI DEV,DSKDTB		;...
	HRL DEV,CRDSTX		;GET STRUCTURE NUMBER
	CALL GETFDB		;MAP IN THE FDB OF THIS FILE
	 JRST [	MOVEI D,CRDIX9	;FAILED. RETURN ILLEGAL FORMAT ERROR CODE
		JRST DELDI3]	;CLEAN UP AND TAKE ERROR RETURN
	SETZRO <FBPRM,FBDIR>,(A) ;CLEAR BITS SO DELF WILL WORK

;INCREMENT SUPERIOR'S QUOTAS BY THE AMOUNT PREVIOUSLY ASSIGNED TO THIS
;DIRECTORY

	HRRZ A,CRDSUP		;GET SUPERIOR DIRNO
	CAIN A,ROOTDN		;ROOT-DIR?
	JRST DELDI5		;YES - DONT INCREMENT QUOTAS
	CALL CKLIQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 SKIPA			;YES. DON'T ADJUST
	JRST [	LOAD A,DRLIQ,(Q1) ;NO. GET SUPERIOR LIQ
		ADD A,CRDDIQ 	;INCREMENT BY DELTA LIQ
		STOR A,DRLIQ,(Q1); ADJUST SUPERIOR'S LOGGED-IN QUOTA
		HRRZ A,CRDSUP	;A/ DIRECTORY NUMBER FOR SUPERIOR
		MOVE B,CRDSTX	;B/ STRUCTURE NUMBER
		MOVE C,CRDDIQ	;C/ AMOUNT TO ADD TO SUPERIOR
		CALL ADJALC	;ADJUST SUPERIOR'S ALLOCATION ENTRY
		JRST .+1]
	CALL CKLOQ		;SEE IF SUPERIOR HAS INFINITE QUOTA
	 SKIPA			;YES. DON'T ADJUST
	JRST [	LOAD A,DRLOQ,(Q1) ;NO. GET SUPERIOR LOQ
		ADD A,CRDDOQ	;INCREMENT BY DELTA LOQ
		STOR A,DRLOQ,(Q1) ;ADJUST SUPERIOR'S LOGGED-OUT QUOTA
		JRST .+1]
	LOAD A,DRSDM,(Q1)	;GET SUPERIOR SDQ
	ADD A,CRDDSQ		;GET SUBDIR DELTA
	STOR A,DRSDM,(Q1)	;STORE
DELDI5:	LOAD A,DRSDC,(Q1)	;GET CURRENT SUBDIR COUNT
	SUBI A,1		;ONE FEWER SUBDIRS
	STOR A,DRSDC,(Q1)	; ...
	MOVEM A,CRDDSQ		;SAVE RESIDUAL COUNT
	ULKDIR			;UNLOCK DIR

;REMOVE ENTRY FOR THIS DIRECTORY FROM IDXTAB

	MOVE A,CRDIRD		;GET DIR NUMBER AGAIN
	CALL DELIDX		;DELETE THIS ENTRY FROM INDEX TABLE

;IF DELETING THE LAST SUBDIRECTORY FROM ITS SUPERIOR, INDICATE THAT
;SUPERIOR NO LONGER HAS SUBDIRECTORIES

	SKIPE CRDDSQ		;NEED TO CLEAR SUBDIR FLAG IN SUP FDB?
	JRST DELDI4		;NO.
	HRRZ A,CRDSUP		;GET SUPERIOR DIR NUMER
	CALL GETIDX		;GET INDEX INFORMATION
	 JRST DELDI4		;CANT
	MOVEM A,CRDTMP		;SAVE FDB ADDRESS
	MOVE A,C		;GET SUPERIORS SUPERIOR DIR NUMBER
	HLL A,CRDSUP		;INSERT SUC
	CALL SETDIR		;MAP DIRECTORY
	 JRST DELDI4		;OH WELL, WASN'T ALL THAT IMPORTANT
	MOVE A,CRDTMP		;GET FDB OF SUPERIOR
	ADD A,DIRORA		;AS AN ABSOLUTE ADDRESS
	SETZRO FB%SDR,.FBCTL(A) ;CLEAR SUBDIR FLAG
	CALL UPDDIR		;UPDATE DISK IMAGE
	CALL USTDIR		;RELEASE

;DELETE THE DIRECTORY FILE AND EXPUNGE ITS CONTENTS

;**;[3018]Add 3 lines at DELDI4:	21-SEP-83	TAB
DELDI4:
	MOVE C,CRDIRD		;[3018]C/ DIRECTORY NUMBER
	MOVE D,CRDSTX		;[3018]D/ STRUCTURE NUMBER
	CALL REMSDR		;[3018]REMOVE FROM CACHE IF NECC.
	CALL CRDSWH		;SET WHEEL FOR DURATION OF DELETE
	MOVX A,DF%EXP		;EXPUNGE CONTENTS
	HRR A,CRDIRJ		;GET JFN OF DIR FILE
	DELF			;DELETE THE DIR FILE
	 JRST [	PUSH P,A	;SAVE ERROR CODE
		CALL CRDCWH	;CLEAR WHEEL
		POP P,D		;RESTORE ERROR CODE
		JRST DELDI3]	;GO CLEAN UP
	CALL CRDCWH		;CLEAR WHEEL
	SKIPE CRDIRF		;HAS DELDEL FAILED FOR A BAD DIRECTORY?
;**;[2867] Replace 1 line with 5 at DELDI4:+10		DML	10-NOV-82
	JRST [ HRRZ A,CRDSTX	;[2867] GET STRUCTURE NUMBER
	       HRRZ A,STRTAB(A)	;[2867] GET LOCATION OF SDB
	       MOVE A,(A)	;[2867] GET SIXBIT STRUCTURE NAME
	       BUG(DELBDD,<<A,STRNAM>>)	;[2867] DELBDD BUGINF
	       JRST .+1]	;[2867] CONTINUE
	HRRZ A,CRDIRJ		;GET JFN AGAIN
	RLJFN			;RELEASE THE JFN
	 JFCL
	HRRZ A,CRDSUP		;GET SUPERIOR DIRECTORY NUMBER
	CAIE A,ROOTDN		;IS IT ROOT-DIRECTORY?
	RETSKP			;NO. DON'T MAKE BACKUP
	HRRZ A,CRDSTX		;YES. GET STRUCTURE NUMBER
	CALL CPYBAK		;UPDATE BACKUP
	 JRST [	BUG(CRDBK1)
		RETSKP]
	RETSKP

;A FAILURE HAS OCCURRED. IF IT IS DUE TO A BAD DIRECTORY, FORCE IT TO
;BE DELETED ANYWAY.  IF NOT, ERROR IS PROBABLY OPEN FILE IN DIRECTORY, WHICH
;SHOULD FAIL

DELDI1:	SKIPE CRDIRF		;DID CONSISTENCY CHECK FAIL PREVIOUSLY?
	JRST [	MOVEI D,CRDIX9	;YES. RETURN BAD FORMAT FOR DIRECTORY
		JRST DELDI3]	;CLEAN UP AND TAKE ERROR RETURN
	MOVE A,CRDIRD		;NO. A/DIRECTORY NUMBER
	HLL A,CRDSUP		;GET STRUCTURE UNIQUE CODE IN LH
	MOVX F,DD%CHK		;CHECK CONSISTENCY OF DIRECTORY
	CALL DELDEL		; BUT DON'T FIX ANYTHING
	 JRST [ SETOM CRDIRF	;FAILED. INDICATE BAD DIRECTORY
		JRST DELDI2]	;GO DELETE THE DIRECTORY FILE
	SKIPN D,CRDIRE		;IF ERROR CODE SET, USE IT
	MOVEI D,CRDIX7		;IF NO CODE, ASSUME FILE IS OPEN
DELDI3:	HRRZ A,CRDIRJ		;GET JFN OF DIRECTORY FILE
	RLJFN			;RELEASE IT
	 JFCL
	MOVE A,D		;RESTORE ERROR CODE
	RETBAD ()		;GIVE ERROR RETURN
;CHKNUM - ROUTINE TO SEE IF DIR # SPECIFIED BY USER ALREADY EXISTS

CHKNUM:	SAVET			;PRESERVE TEMPORARY ACS
	HRROI A,CRDIRS		;GET POINTER TO DEVICE NAME
	STDEV			;GET DEVICE DESIGNATOR
	 JRST [ MOVEM B,CRDIRE	;RETURN ERROR NUMBER
		RETBAD ()]
	MOVEM B,CRDDEV		;SAVE DEVICE DESIGNATOR
	HRRZ A,B		;GET STRUCTURE UNIQUE CODE
	CALL CNVSTR		;CONVERT TO STR #
	 JRST [ MOVEM A,CRDIRE	;RETURN ERROR NUMBER
		RETBAD ()]
	MOVEM A,CRDSTR		;SAVE STRUCTURE #
	SKIPN C,STRTAB(A)	;GET SDB FOR THIS STRUCTURE
	 JRST [ MOVEI A,CRDI12	;INVALID STRUCTURE
		JRST CHKNM1]
	JN STCRD,(C),CHKNM2	;RETURN SUCCESS IF CREATING ROOT-DIRECTORY
	HRLZ A,CRDDEV		;GET STR UNIQUE CODE
	XCTU [HRR A,.CDNUM(Q2)]	;GET DIR NUMBER SPECIFIED BY USER
	CALL SETDIR		;SEE IF DIRECTORY WITH THIS NUMBER EXISTS
	 JRST CHKNM2		;NO SUCH DIRECTORY, SUCCESS
	CALL CHKNAM		;SEE IF THE NAME STRINGS MATCH
	 JRST CHKNM0		;NO, THIS IS ILLEGAL
	CALL USTDIR		;THEY MATCH, THIS MUST BE RECONSTRUCTION
	JRST CHKNM2

CHKNM0:	CALL USTDIR		;UNMAP THE DIRECTORY
	MOVEI A,CRDIX8		;DIRECTORY WITH SPECIFIED NUMBER ALREADY EXISTS

;CHKNUM ERROR RETURN

CHKNM1:	MOVEM A,CRDIRE		;SAVE ERROR NUMBER
	MOVE A,CRDSTR		;GET STR #
	CALL ULKSTR		;UNLOCK IT
	RETBAD ()

;CHKNUM SUCCESSFUL RETURN

CHKNM2:	MOVE A,CRDSTR		;GET STR #
	CALL ULKSTR		;UNLOCK IT
	RETSKP

;GTJFN BLOCK FOR CRDIR

CRDGJB:	GJ%DEL!GJ%PHY+1
	377777,,377777
	0			;DEVICE
	-1,,[ASCIZ/ROOT-DIRECTORY/]
	0			;NAME
	0			;EXT
	0			;PROTECTION
	0			;USE THE ACCOUNT OF THE CALLER
	0
;ROUTINE TO SET THE PROCESS INTO WHEEL STATE
;	CALL CRDSWH
;RETURNS +1:	USER IS NOINT AND WHEEL

CRDSWH:	NOINT
	MOVE A,CAPENB		;GET USER'S CAPABILITIES
	MOVEM A,CRDCAP		;SAVE THEM
	MOVX A,SC%WHL		;ADD WHEEL
	IORM A,CAPENB		; IN ORDER TO DO GTJFN
	RET			;AND RETURN


;ROUTINE TO CLEAR WHEEL AND PUT BACK THE PREVIOUS CAPABILITIES
;	CALL CRDCWH
;RETURNS +1:	OLD CAPABILITIES ARE RRESTORED, AND PROCESS IS OKINT

CRDCWH:	MOVE A,CRDCAP		;GET BACK ORIGINAL CAPABILITIES
	MOVEM A,CAPENB		;AND RESTORE TO USER
	OKINT
	RET			;AND RETURN


;CKLIQ AND CKLOQ - CHECK FOR INFINITE QUOTA

;ACCEPTS:
;	Q1/ CONTENTS OF DIRORA

;	CALL CKLIQ/CKLOQ

;RETURNS +1: QUOTA IS INFINITE
;	 +2: QUOTA IS NOT INFINITE

;CLOBBERS NO AC'S

;**;[2607] Change 2 lines at CKLIQ: +0L	JGZ	3-APR-82
CKLIQ:	SAVEAC <Q2>		;[2607] SAVE AN AC
	LOAD Q2,DRLIQ,(Q1)	;[2607] GET LOGGED-IN QUOTA
	JRST CKLQ1

;**;[2607] Change 4 lines at CKLOQ: +0L	JGZ	3-APR-82
CKLOQ:	SAVEAC <Q2>		;[2607] SAVE AN AC
	LOAD Q2,DRLOQ,(Q1)	;[2607] GET LOGGED-OUT QUOTA
CKLQ1:	TXNN Q2,1B0		;[2607]
	TXNN Q2,1B1		;[2607]
	RETSKP
	RET
;ROUTINE TO INITIALIZE A DIRECTORY
;ACCEPTS IN T1/	DIRECTORY NUMBER
;	    T2/ STRUCTURE NUMBER
;	CALL DIRINI
;RETURNS +1:	ERROR, ERROR CODE IN T1
;	 +2:	DIRECTORY IS INITIALIZED

DIRINI::SE1CAL
	STKVAR <DIRINN,DIRINS>
	MOVEM T1,DIRINN		;SAVE DIRECTORY NUMBER
	MOVEM T2,DIRINS		;SAVE STRUCTURE NUMBER
	CALL MAPDIR		;MAP IN THE DIRECTORY
	 RETBAD (CRDIX8)	;ILLEGAL DIR NUMBER
	MOVE T1,DIRINN		;GET BACK DIR NUMBER
	MOVE T2,DIRINS		; AND STRUCTURE NUMBER
	CALL LCKDNM		;LOCK THE DIRECTORY
	HRRZ T1,DIRINS		;GET STRUCTURE NUMBER
	MOVE T1,STRTAB(T1)	;GET ADDRESS OF SDB
	INCR STRLK,(T1)		;LOCK THE STRUCTURE
	MOVE T4,DIRORA		;SET UP POINTER TO DIRORG
	SETZM 0(T4)		;ZERO THE FIRST WORD
	ERJMP [	MOVE T1,DIRINN	;FAILED. GET DIR NUMBER
		MOVE T2,DIRINS	; AND STRUCTURE NUMBER
		CALL ULKDNM	;FREE LOCK
		HRRZ T1,DIRINS	;GET STRUCTURE # AGAIN
		MOVE T1,STRTAB(T1) ;GET SDB ADDRESS
		DECR STRLK,(T1) ;RELEASE STRUCTURE
		CALL UNMAPD	;UNMAP THE DIRECTORY
		MOVE T1,LSTERR	;GET PAGE FAULT HANDLER'S COMPLAINT
		RETBAD()]	;AND FAIL
	MOVEI T1,777		;DO XBLT OF 1 PAGE
	MOVE T2,T4		;START OF PAGE
	MOVE T3,T4		;START OF PAGE
	AOS T3			;+1
	CALL XBLTA
	MOVE T1,DIRINN		;GET BACK DIR NUMBER
	STOR T1,DRNUM,(T4)	;PUT DIRECTORY NUMBER INTO DIR
	MOVEI T1,.TYDIR		;GET DIR BLOCK TYPE
	STOR T1,DRTYP,(T4)	;STORE TYPE # FOR CONSISTENCY CHECK
	SETZRO DRRPN,(T4)	;RELATIVE PAGE # IS 0
	MOVEI T1,.DIHL0		;GET LENGTH OF PAGE 0 HEADER
	STOR T1,DRHLN,(T4)	;REMEMBER LENGTH IN HEADER ITSELF
	SETZRO DRFFB,(T4)	;NO FREE AREA
	STOR T1,DRFTP,(T4)	;STORE END POINTER INTO DIR
	MOVEI T1,PGSIZ		;INITIAL DIR IS 1 PAGE LONG
	STOR T1,DRSTP,(T4)	;WITH SYMBOL TABLE ENDING AT 777
	MOVEI T1,PGSIZ-2	;EMPTY SYMBOL TABLE IS 2 WORDS LONG
	STOR T1,DRSBT,(T4)	;  TO HOLD JUST THE BLOCK TYPE
	ADD T1,DIRORA		;GET ACTUAL ADDRESS IN MON VIRT SPACE
	MOVE T2,DIRINN		;GET DIRECTORY NUMBER
	STOR T2,SYMDN,(T1)	;PUT IT IN SYMBOL TABLE HEADER BLOCK
	MOVEI T2,.TYSYM		;GET BLOCK TYPE OF SYMBOL TABLE
	STOR T2,SYMTY,(T1)	;STORE IT AT HEAD OF SYMBOL TABLE
	SETONE SYMVL,(T1)	;SET SECOND WORD TO -1
	MOVE T1,[5B2+.STDFP]	;GET STANDARD DEFAULT FILE PROTECTION
	STOR T1,DRDPW,(T4)	;SAVE DEFAULT FILE PROT
	MOVE T1,[5B2+.STDDP]	;NOW SET UP DIRECTORY PROTECTION
	STOR T1,DRPRT,(T4)	;...
	MOVE T1,[5B2+.STDBS]	;AND SET UP STD BACKUP SPECIFICATION
	STOR T1,DRDBK,(T4)	;...
	MOVEI T1,.STDMX		;INIT MAX ALLOCATION (LOGGED OUT QUOTA)
	STOR T1,DRLOQ,(T4)	;...
	STOR T1,DRLIQ,(T4)	; AND LOGGED IN QUOTA
	MOVX T1,.STDSD		;GET DEFAULT SUBDIR QUOTA
	STOR T1,DRSDM,(T4)	;STORE IN DIR
	MOVX T1,.STDNE		; Default online expiration
	STOR T1,DRDNE,(T4)	; Into directory
;**;[1772] Revamp [1745] lines at .DELF: -18L	JGZ	28-AUG-80
;**;[1745] At .DELF-16 l Insert following one line	RAS	21-JUN-80
	SKIPG T1,TPRCYC		;[1745] Use Recycle period if set for
	MOVX T1,.STDFE		; Default offline expiration
	STOR T1,DRDFE,(T4)	; Into directory
	ULKDIR			;UNLOCK THE DIRECTORY
	RETSKP			;EXIT
; Delete file
; Call:	1	; Jfn
;	DELF
; Return
;	+1	; Error, cannot delete
;	+2	; Success

; DF%NRJ (B0) - DON'T RELEASE JFN
; DF%EXP (B1) - EXPUNGE CONTENTS
; DF%FGT (B2) - FORGET FILE

.DELF::	MCENT			; Become slow
	HRRZ JFN,1
	CALL CHKJFN		; Check it out
	 JRST GBGJFN
	 JFCL
	 ERUNLK DESX4		; Tty or byte illegal
	TQNE <ASTF>
	 ERUNLK(DESX7)		; Output stars not allowed
	CALL @DELD(P3)		; Call device dependent routine
	 ERUNLK()		; Couldn't delete
	UMOVE A,1
	TLNE A,(DF%NRJ)		;IF B0, DON'T RELEASE JFN
	JRST DELF1
	TQNN <OPNF>
	JRST [	MOVEI A,0(JFN)	;GET THE JFN
		CALL LUNLK0	;FREE THE STR LOCK
		CALL RELJFN	;RELEASE THE JFN
		SMRETN]
DELF1:	CALL UNLCKF
	SMRETN
;DELETE ALL BUT N VERSIONS OF FILE

; 1/	FLAG BITS+JFN
; 2/	NUMBER OF VERSIONS TO KEEP
;
;RETURNS +1 - ERROR
;	+2 - SUCCESS, NUMBER OF VERSIONS DELETED IN 2

.DELNF:: MCENT
	XCTU [HRRZ JFN,1]	;Get JFN only from user's AC1
	CALL CHKJFN		;CHECK THE JFN
	 JRST GBGJFN
	 JFCL
	 ERUNLK DESX4		;TTY OF BYTE ILLEGAL
	TQNE <ASTF>		;PARSE-ONLY?
	 ERUNLK(DESX7)		;YES, LOSE
	HRRZ A,NLUKD(P3)	;CHECK NAME LOOKUP DISPATCH
	CAIE A,MDDNAM		;IS MDDNAM?
	ERUNLK GFDBX1		;NO, CAN'T DO
	CALL GETFDB
	 ERUNLK DESX3
	UMOVE Q1,2		;NUMBER OF VERSIONS TO KEEP
DELNF2:	JN <FBNXF,FBDEL>,(A),DELNF1 ;SKIP DELETED OR NON-EX FILES
	UMOVE B,1		; Get flag
	TXNE B,DF%ARC		; Allowing deletes on archived ?
	 JRST DELNF5		; Yes, bypass check then
	PUSH P,A
	MOVX B,FC%WR		; Write access necessary for delete
	CALL ARACCK		; Check archive/vir. disk requirements
	JUMPG A,[POP P,A	; Not allowed--skip this file
		JRST DELNF1]
	POP P,A
DELNF5:	JN <FBTMP>,(A),DELNF3	;TEMPORARY FILES ARE SPECIAL
DELNF4:	SOJGE Q1,DELNF1		;SKIP IT IF STILL WITHIN KEEP COUNT
	PUSH P,A		;SAVE FDB ADR
	MOVX B,FC%WR		;MUST HAVE WRITE ACCESS TO DELETE
	CALL ACCCHK
	 JRST [	POP P,A		;NOT ENOUGH ACCESS RIGHTS
		ULKDIR
		ERUNLK (DELFX1)]
	POP P,A			;GET BACK FDB ADR
	SETONE FBDEL,(A)	;MARK IT AS DELETED
DELNF1:	LOAD A,FBGNL,(A)	;GET ADR OF FDB OF NEXT GENERATION
	JUMPE A,DELNFE		;DONE IF END OF LIST
	ADD A,DIRORA
	JRST DELNF2

DELNF3:	LOAD Q2,FBGEN,(A)	;GET GENERATION NUMBER
	SUBI Q2,^D100000	;OFFSET FOR TEMPORARY GENS
	CAMN Q2,JOBNO		;BELONGS TO CURRENT JOB?
	JRST DELNF4		;YES, DO NORMAL THING ON THIS FILE ONLY
	JRST DELNF1		;SKIP ALL TEMPORARY FILES NOT BELONGING TO THIS JOB

DELNFE:	SKIPLE Q1		;ANY FILES DELETED?
	MOVEI Q1,0		;NO, SET Q1=0
	XCTU [MOVNM Q1,2]	;STORE # OF FILES DELETED
	ULKDIR
	CALL UNLCKF
	SMRETN
; Dismount device
; Call:	1	; Device designator
;	DSMNT
; Return
;	+1	; Error
;	+2	; Ok

.DSMNT:: MCENT
	UMOVE A,1
	CALL CHKDEV
	 RETERR()		; Illegal designator or not available
	HRRZ P3,DEV		; SET UP ADDRESS ONLY
	CALL DSM0		;DO THE WORK
	 RETERR DSMX1		;FAILED
	SMRETN

;LOCAL ROUTINE TO DO DISMOUNT

DSM0:	PUSH P,B		;SAVE DEV INDEX
	HRRZ P3,DEV
	CALL @DSMD(P3)		;CALL DEVICE DEPENDENT PART
	 JRST [	POP P,B		;FAILED
		RET]
	MOVSI A,(DV%MNT)
	POP P,B			;RECOVER DEV INDEX
	ANDCAM A,DEVCHR(B)	;CLEAR MOUNTED BIT
	RETSKP

;INTERNAL ROUTINE TO DISMOUNT DEVICE
; B/ DEV TABLE INDEX

DSMNT0::SAVEP
	PUSH P,1
	HRRZ A,DEVUNT(B)	;GET UNIT NUMBER
	ANDI A,DV%UNT		;MASK TO UNIT NUMBER
	CAIN A,DV%UNT		;CHECK FOR -1
	MOVEI A,-1		;YES SET -1
	HRRZ DEV,DEVDSP(B)	;BE SURE DEV SETUP AS USUAL
	HRLI DEV,0(A)
	CALL DSM0		;DO THE WORK
	 SOS -1(P)		;FAILED, PREVENT SKIP RETURN
DSMNT1:	POP P,1
	RETSKP
; Get device characteristics
; Call:	1	; Device designator
;	DVCHR
; Return
;	+1	; Ok
;	2	; Device characteristics word
;	LH(3)	; Job to which device is assigned
;	RH(3)	; Unit number

.DVCHR::MCENT
	HLRZ B,1
	TRZ B,777
	CAIL 1,.TTDES		; Is this a tty designator?
	CAIL 1,.TTDES+NLINES
	CAIN B,.DVDES		; Or a device designator
	JRST DVCHR1		; Yes, do directly
	UMOVE JFN,1		; No. translate first
	CALL CHKJFN
	 ITERR()
	 JFCL
	 JRST [	CAMN JFN,[0,,.NULIO]	;IS THIS NULL
		MOVE JFN,[600000+.DVNUL,,+777777]	;GIVE THE DEVICE DESIGNATOR
		UMOVEM JFN,1
		JRST DVCHR1]
	CALL LCKDVL		;LOCK DEVICE TABLE TO AVOID 'SECNX'
	HLRZ A,FILDDN(JFN)	; Get pointer to device name block
	HRLI A,(<POINT 7,0,35>)
	CALL STDEVP		; Convert string to device designator
	 ITERR(<(A)>,<CALL UNLCKF
			UNLOCK DEVLCK>)
	CALL UNLCKF
	UNLOCK DEVLCK		;UNLOCK THE DEVICE TABLE
	UMOVEM A,1
DVCHR1:	UMOVE A,1
	CALL CHKDEV
	 JRST [	CAIE A,DEVX2	; Was error due to unavailablity
		ITERR()		;NO, ABORT
		MOVE C,DEVCHR(B)
		TLZ C,(DV%AV)	;SAY NOT AVAILABLE
		JRST DVCHR4]
	TLO C,(DV%AV)
DVCHR4:	UMOVEM C,2
	HRRZ A,DEV		;SEE IF THIS IS A DSK
	CAIE A,DSKDTB
	SKIPA A,DEVUNT(B)	;NOT A DISK
	HLLO A,DEVUNT(B)	;A DISK, ALWAYS SAY -1 IN RH OF 3
	UMOVEM A,3
	HLRZ A,DEVUNT(B)	;YES, GET THE ASSIGNER
	TXNN C,DV%AV		;IS DEVICE UNAVAILABLE?
	CAIE A,-1		;YES, DO WE HAVE ASSIGNER?
	JRST MRETN		;AVAILABLE, OR HAVE ASSIGNER
	HRRZ A,DEV		;FIND OUT WHAT DEVICE THIS IS
	CAIE A,TTYDTB		;IS THE UNAVAILABLE DEVICE A TTY?
	JRST DVCHR2		;NO
	HRRZ A,DEVUNT(B)	;NO ASSIGNER SO MUST BE UNAVAILABLE
	ANDI A,DV%UNT
	CAIN A,DV%UNT		;CHECK FOR -1
	MOVEI A,-1
	CALL TTYPTY		;ASSUME IT'S A PTY. GET PTY NUMBER
	HRLI A,<.DVDES+.DVPTY>	;MAKE IT A DEVICE DESIGNATOR
DVCHR3:	CALL CHKDES		;UNAVAILABLE.  GET INDEX FOR PTY
	BUG(DVCHRX)
	MOVX A,DV%ASN		;COPY THIS BIT TO USER
	AND C,A			;ONLY THIS BIT
	XCTU [ANDCAM A,2]	;CLEAR FROM USER
	XCTU [IORM C,2]		;COPY
	HLRZ A,DEVUNT(B)	;GET ASSIGNER OF PTY.
	XCTU [HRLM A,C]		;RETURN IT TO USER.
	JRST MRETN

DVCHR2:	CAIE A,PTYDTB		;IS UNAVAILABLE DEVICE A PTY?
	JRST DVCHR5		;NO
	PUSH P,B		;YES. SAVE AC
	HRRZ B,DEVUNT(B)	;GET ITS UNIT #
	ANDI B,DV%UNT
	CAIN B,DV%UNT		;CHECK FOR -1
	MOVEI B,-1		;SET -1
	CALL PTYTTY		;CONVERT TERMINAL NUMBER
	MOVEI A,.TTDES(B)	;MAKE IT 400000+LINE NUMBER
	POP P,B			;RESTORE DEVICE TABLE POINTER
	JRST DVCHR3		;GET UNIT OF TTY TO RETURN TO USER

DVCHR5:	CAIE A,MTADTB		;IS THIS A MAGTAPE?
	JRST MRETN		;NO
	XCTU [HRRZS 3]		;YES, MAKE IT ASSIGNED TO JOB 0
	JRST MRETN
;ROUTINE TO OUTPUT A BYTE FROM ERSTR - COMPLETES QUIETLY IF
;ANY PROBLEMS

ERST9::	SKIPE C
	SOJLE C,CPOPJ
	CALL SAVAC
	UMOVE JFN,1
	CALL ERBOUT
	SOS -NSAC(P)
	TLNN JFN,-1		;BYTE POINTER?
	JRST ERST91		;NO
	UMOVEM JFN,1		;YES, RETURN UPDATED STRING POINTER
	MOVEI B,0		;AND APPEND A NULL
	XCTBU [IDPB B,JFN]
ERST91:	CALL RESAC
	RETSKP

ERBOUT:	TRVAR <SAVJFN,SAVBYT>	;RESERVE LOCS TO SAVE THINGS
ERBOU1:	MOVEM JFN,SAVJFN	;SAVE ORIGINAL JFN
	CALL CHKJFN
	 RET			;Bad designator - Return
;**;[1977] Change 1 line at ERBOU1:+3L	JRG	8-FEB-82
;**;[1979] Change 1 line at ERBOU1:+3L	JRG	12-FEB-82
	 CALL C60DVT		;[1977][1979] TTY - Check for .DVDES+.DVTTY
	 JFCL			;Byte pointer
ERBOU2:	TQNE <ENDF>
	JRST UNLCKF
	TQNE <OPNF>
	TQNN <WRTF>
	JRST UNLCKF
	MOVEM B,SAVBYT		;SAVE THE BYTE
	CALL BYTOUA		;SEND OUT BYTE
	 JRST ERBOUW		;SERVICE ROUTINE WANTS TO BLOCK
	MOVE B,SAVBYT		;RESTORE BYTE
	CALL UNLCKF		;UNLOCK THE FILE
	RETSKP			;GIVE SUCCESSFUL RETURN

ERBOUW:	TQNE <ERRF>		;WAS IT AN ERROR?
	JRST [	MOVE B,SAVBYT	;YES. GET BACK BYTE
		CALLRET UNLCKF]	;AND DONE
	CALL UNLDIS		;UNLOCK AND BLOCK
	MOVE B,SAVBYT		;GET BACK BYTE
	JRST ERBOU1		;TRY AGAIN
;FIND FIRST FREE FILE PAGE
; CALL:	A/PAGE #,, JFN
;	FFFFP
; Return
;	+1
;	A/JFN,,PAGE #
;		OR
;	A/-1 IF NO FREE PAGES

.FFFFP::MCENT
FFFF0:	HRRZ JFN,1		;MOVE JFN INT BASE REG
	CALL CHKJFN		;GO SEE IF IT'S A DISK FILE
	 RETERR()		;ERROR ("A" HAS THE CODE)
	 JFCL
	 RETERR(DESX4)		;TTY AND BYTE POINTER ARE NO GOOD
	TQNE <ASTF>		;PARSE ONLY?
	RETERR(DESX7)
	TQNN <OPNF>		;IS THE FILE OPEN?
	ERUNLK(FFUFX1)		;NOT OPEN
	HRRZ A,NLUKD(P3)	;GET DISPATCH ADDRESS
	CAIE A,MDDNAM		;IS DEVICE DISK?
	ERUNLK(FFUFX2)		;NO.
	TQNE <LONGF>		;IS IT A LONG FILE?
	JRST FFFFPL		;YES - SPECIAL HANDLING
	XCTU [	MOVS A,1]	;PUT INTO <JFN,,PAGE NUMBER>
	TRNE A,777000		;IS THIS A "LONG FILE" PAGE NUMBER
	JRST FFFFPX		;YES - THEN IT'S THE FIRST FREE PAGE
	HLL A,FILOFN(JFN)	;GET THE OFN. A1 NOW HAS OFN,,PAGE #
	CALL FFFFF		;FIND THE FIRST FREE PAGE
	 ERUNLK(MONX01)		;SYSTEM OUT OF FREE SPACE
FFFFPX:	CAMN A,[-1]		;FREE PAGE NOT FOUND IN FILE
	HRRI A,1000		;YES - THEN PAGE IS IN "LONG FILE"
	XCTU [	HRL A,1]	;GET THE JFN INTO RIGHT HALF
FFFPX1:	UMOVEM A,1		;PUT FREE PAGE NUMBER IN USER AC
	CALL UNLCKF		;UNLOCK THE STRUCTURE
	JRST MRETN		;RETURN TO CALLER
;HERE TO SCAN A LONG FILE INDEX BLOCK.  THE BASIC PHILOSOPHY IS TO
;LOOK THROUGH THE SUPER INDEX BLOCK FOR VALID PAGE TABLE ENTRIES.  WHENEVER
;ONE IS FOUND SUBROUTINE FFFFF: IS CALLED TO  FIND A FREE PAGE IN
;THE PAGE TABLE. THE SEARCH CONTINUES TO FIRST FREE PAGE OR END OF FILE.

FFFFPL:	XCTU [	HLRZ Q1,1]	;GET PAGE NUMBER
FFFFP1:	MOVE Q3,Q1		; AND SAVE
	LSH Q3,-9		;GET THE PAGE TABLE NUMBER
	ADD Q3,FILLFW(JFN)	;INDEX INTO SUPER INDEX BLOCK
	HRRZS Q3		;ADDRESS ONLY
	MOVE A,Q1		;PUT PAGE NUMBER IN A FOR JUMP TO FFFFPX
	SKIPN (Q3)		;DOES PAGE TABLE EXIST
	JRST FFFFPX		;NO - THEN THIS IS THE PAGE
	CALL JFNOF3		;YES - GET <OFN,,PAGE NUMBER> INTO "A"
	 ERUNLK (MONX01)	;RETURN RESOURCES EXHAUSTED ERROR
	CALL FFFFF		;SCAN THE PAGE TABLE FOR A FREE ENTRY
	 ERUNLK (MONX01)	;NO SYSTEM STORAGE
	CAMN A,[-1]		;WAS THE PAGE TABLE COMPLETELY FULL
	JRST FFFFP3		;YES - TRY NEXT PAGE TABLE
	ANDI Q1,777000		;ISOLATE SUPER INDEX BLOCK PAGE NUMBER
	ADD A,Q1		;ADD PAGE NUMBER OF FREE PAGE FOUND
	JRST FFFFPX		;AND REPORT TO USER

FFFFP3:	ADDI Q1,1000		;BUMP TO NEXT PAGE TABLE
	ANDCMI Q1,777		;ELIMINATE TEH REGULAR PAGE NUMBERS
	TLNN Q1,777777		;DID WE BUMP PAST END OF SUPER INDEX BLOCK
	JRST FFFFP1		;NO - KEEP LOOKING
	SETO A,			;;YES - NO FREE PAGES
	JRST FFFPX1		;JOIN COMMON EXIT
;ROUTINE TO MAP AND SCAN PAGE TABLE FOR FREE PAGE ENTRY - SUBROUTINE FOR .FFFFP

;ACCEPTS:	A/ <OFN,,PAGE NUMBER>

;RETURNS:	+1,NO FREE STORAGE
;		+2,	A/ -1 - NO FREE PAGE FOUND IN THIS PAGE TABLE
;			A/ <0,,PAGE NUMBER> IF FREE PAGE FOUND

;EXAMINE EACH ENTRY IN THE PAGE TABLE. IF THE ENTRY IS ZERO THEN THE PAGE IS
;FREE.  OTHERWISE CHECK FOR SHARED POINTER (THEY ALWAYS POINT TO EXISTING
;PAGES). IF SHARED GO TO NEXT  ENTRY.  IF IT'S INDIRECT CALL MRPACS: TO CHECK
;THE ENTRY OUT.  NOTE ENTRIES OF THE FORM 124001,,0 ARE ASSUMED TO POINT TO
;FREE PAGES.

FFFFF:	STKVAR <TEMPA,<TEMPB,2>>
	MOVEM A,TEMPA		;SAVE OFN,,PAGE NUMBER
	CALL ASGPAG		;GET A PAGE TO MAP THE PAGE TABLE INTO
	 RET			;NO MEMORY - RETURN AN ERROR
	MOVE B,A		;CREATE ENTRY FOR SETMPG
	HRLI B,100000		;WHERE WE WANT PAGE TO BE MAPPED
	HLRZ A,TEMPA		;JFN WHOSE TABLE WE WANT
	CALL SETMPG		;MAP THE PAGE TABLE
	HRRZ A,TEMPA		;GET STARTING PAGE NUMBER
	ADDI A,(B)		;LOCATION OF DISK ADDRESS
FFFFF0:	SKIPN (A)		;EMPTY?
	JRST FFFFF2		;YES, FOUND IT
	MOVE C,(A)		;GET THE PAGE POINTER
	CAMN C,[124001,,0]	;SPECIAL CASE INVALID PAGE POINTER?
	JRST FFFFF2		;YES - FOUND FREE PAGE
	LOAD C,PTRCOD,C		;GET THE POINTER TYPE CODE
	CAIE C,INDCOD		;IS IT AN INDIRECT POINTER?
	JRST FFFFF3		;NO - PAGE EXISTS - TRY NEXT PAGE
	DMOVEM A,TEMPB		;SAVE ACCROSS THE CALL
	MOVE A,TEMPA		;GET THE <OFN,,PAGE NUMBER>
	CALL MRPACS		;GET THE PAGE ACCESS BITS (LIKE RPACS JSYS)
	MOVE C,A		;MOVING "A" ALLOWS REGS TO BE RESTORED
	DMOVE A,TEMPB		;RESTORE THE REGS
	TXNN C,PA%PEX		;DOES THE PAGE EXIST
	JRST FFFFF2		;NO - THEN TELL CALLER
FFFFF3:	CAIGE A,777(B)		;WHOLE PAGE TABLE SCANNED?
	AOJA A,FFFFF0		;NO, TRY NEXT ONE.
	MOVEI A,0
	CALL SETMPG		;UNMAP THE PAGE TABLE
	HRRZ A,B
	CALL RELPAG		;RELEASE THE PAGE
	SETO A,			;INDICATE NO FREE PAGE FOUND IN PAGE TABLE
	RETSKP
FFFFF2:	MOVEM A,TEMPA		;SAVE
	MOVEI A,0
	CALL SETMPG		;UNMAP THE PAGE TABLE
	HRRZ A,B
	CALL RELPAG		;RELEASE THE PAGE
	MOVE A,TEMPA		;RESTORE A
	ANDI A,777		;KEEP ONLY THE PAGE NUMBER
	RETSKP
; Find first used file page
; Call:	LH(1)	; Jfn
;	RH(1)	; Page number to start with
;	FFUFP
; Returns
;	+1	; Error
;	+2	; Success jfn.pn of first used page in 1

.FFUFP::MCENT
FFUF0:	HLRZ JFN,1
	CALL CHKJFN
	 RETERR()
	 JFCL
	 RETERR(DESX4)		; Tty and byte no good
	TQNE <ASTF>
	 RETERR(DESX7)
	TQNN <OPNF>
	ERUNLK(FFUFX1)		; Not open
	HRRZ A,NLUKD(P3)	; GET DISPATCH ADDRESS
	CAIE A,MDDNAM
	ERUNLK(FFUFX2)		; Not disk
	TQNE <LONGF>
	JRST FFUFPL
	UMOVE A,1
	TRNE A,777000
	ERUNLK(FFUFX3)		; Page beyond 777 of short can't exist
	HLL A,FILOFN(JFN)
	CALL FFUFF
	 ERUNLK(FFUFX3)		; No pages in use
FFUFPX:	XCTU [HRRM A,1]
	CALL UNLCKF
	UMOVE A,A		;GET THE ARG BACK
	RPACS			;CHECK ACTUAL ACCESS
	TLNE 2,(1B5)		;EXISTS?
	SMRETN			;YES, RETURN SUCCESS
	XCTU [AOS 1,1]		;NO, GO TO NEXT PAGE
	TRNE 1,777777		;OFF END OF WORLD?
	JRST FFUF0		;NO, TRY AGAIN
	RETERR(FFUFX3)
;FFUFP... EXTRA HAIR NEEDED FOR LONG FILE

FFUFPL:	UMOVE A,1
	HRRZS A
FFUFP1:	MOVE B,A
	LSH B,-9		; Get ptt number
	ADD B,FILLFW(JFN)
	HRRZS B			; ADDRESS ONLY
	SKIPE (B)		; Check for pt existence
	JRST FFUFP2		; Exists, scan it
FFUFP3:	ADDI A,1000
	ANDCMI A,777
	TLNN A,777777
	JRST FFUFP1
	ERUNLK(FFUFX3)

FFUFP2:	PUSH P,A
	CALL JFNOF1		; Get ofn.pn for this page
	 JRST [	POP P,A		;CLEAN UP THE STACK
		ERUNLK (MONX01)] ;RETURN RESOURCES EXHAUSTED ERROR
	CALL FFUFF		; Scan the pt for stuff
	 JRST [	POP P,A		; None found
		JRST FFUFP3]
	POP P,B
	ANDI B,777000
	ADD A,B
	JRST FFUFPX		; Success

;ROUTINE TO MAP AND SCAN PT FOR NON-0 PAGE

FFUFF:	PUSH P,A
	CALL ASGPAG		; Get a page to map the pt
	 JRST [	POP P,A
		RET]
	MOVE B,A
	HRLI B,100000
	HLRZ A,(P)
	CALL SETMPG		; Map the pt
	HRRZ A,(P)		; Get starting page number
	ADDI A,(B)		; Location of disc address
FFUFF0:	SKIPE (A)		; Empty?
	JRST FFUFF1		; No, found it
	CAIGE A,777(B)		; Whole pt scanned?
	AOJA A,FFUFF0		; No, try next one.
FFUFF2:	MOVEI A,0
	CALL SETMPG		; Unmap the pt
	HRRZ A,B
	CALL RELPAG		; Release the page
	POP P,A
	RET

FFUFF1:	ANDI A,777		; Get pn part
	MOVEM A,(P)
	AOS -1(P)		; Skip return
	JRST FFUFF2
; Get account of file
; Call:	1	; Jfn
;	2	; Core location to put string if any
;	GACTF
; Return
;	+1	; Error
;	+2
;	+3	; 5B2+number oR string pointer

.GACTF::MCENT
	UMOVE JFN,1		;GET JFN
	CALL DSKJFN		;GRNTEE DISK JFN
	 RETERR ()
	CALL GETFDB
	 ERUNLK(GACTX2)
	LOAD B,FBACT,(A)	;GET THE ACCOUNT
	JUMPG B,GACTF1		;IS THIS A STRING?
	UMOVEM B,2		;NO
	ULKDIR
	CALL UNLCKF
	AOS -1(P)		;DOUBLE SKIPPER
	SMRETN			;...

GACTF1:	ADD B,DIRORA		;GET ABS ADR OF STRING
	LOAD A,ACTYP,(B)	;CHECK THE CONSISTENCY OF DIR
	CAIE A,.TYACT		;IS THIS AN ACCOUNT STRING BLOCK
	ERUNLK(GACTX3,<ULKDIR>)	;NO, BAD BLOCK TYPE IN DIR
	CALL CPYXL		;COPY STRING TO USER SPACE
	SMRETN			;GOOD RETURN

;COPY ACCOUNT/USER NAME BLOCK TO USER
; T2/ POINTER TO BLOCK

CPYXL:	UMOVE T4,2		;USERS POINTER IN 2
	TLC T4,-1		;CHECK FOR SPECIAL PNTR
	TLCN T4,-1
	HRLI T4,(<POINT 7,0>)	;FORM BYTE PNTR
	MOVE T3,[POINT 7,2(2)]	;POINT TO TEXT IN BLOCK
CPYXL1:	ILDB T1,T3		;GET CHAR
	JUMPE T1,CPYXL2		;DONE IF ZERO
	XCTBU [IDPB T1,T4]	;DEPOSIT IN USER SPACE
	JRST CPYXL1		;LOOP BACK FOR NEXT
CPYXL2:	UMOVEM T4,2		;UPDATE USER POINTER
	XCTBU [IDPB T1,T4]	;DEPOSIT NULL
	ULKDIR			;UNLOCK DIRECTORY
	CALLRET UNLCKF		; AND JFN THEN RETURN
; Get device status
; Call:	1	; Jfn
;	GDSTS
; Returns
;	+1	; Error
;	+2	; Ok

.GDSTS::MCENT
GDSTS1:	XCTU [HRRZ JFN,1]	;GET JFN
	CALL CHKJFN
	 ITERR()
	 SKIPA			;ALLOW TTY JFNS
	 ITERR(DESX4)
	MOVE A,STS
	ANDI A,17
	TQZE <BLKF>		;BLKF MUST BE ZERO BEFORE CALL
	BUG(BLKF4)
	TQNE <OPNF>		;DEVICE MUST BE OPENED TO GET STATUS
	CALL @GDSTD(P3)
	TQZE <BLKF>		;ROUTINE WANT TO BLOCK?
	JRST GDSTSW		;YES, GO WAIT
	UMOVEM A,2
	JRST UNL

GDSTSW:	CALL UNLDIS		;GO UNLOCK AND DISMIS
	JRST GDSTS1		;TRY AGAIN
; GET FILE USER STRING
;
; CALL:	1/ FUNCTION ,, JFN
;	2/ DESTINATION POINTER
;		GFUST
; RETURNS: +1 ALWAYS, DESTINATION POINTER UPDATED

.GFUST::MCENT			;MONITOR CONTEXT ENTRY
	STKVAR <GFUFDA,GFUBLK,GFUERR>

; CHECK FUNCTION CODE

	XCTU [HLRZ T3,1]	;GET FUNCTION CODE FROM USER
	CAIE T3,.GFAUT		;IS FUNCTION "GET AUTHOR" ?
	CAIN T3,.GFLWR		;  OR "GET LAST WRITER" ?
	SKIPA			;YES, EVERYTHING KOSHER
	ITERR (GFUSX1)		;NO, REFUSE TO PROVIDE FURTHER SERVICE

; GET DIRECTORY NUMBERS FROM FDB AND OBTAIN SPACE FOR STRING

	XCTU [HRRZ JFN,1]	;GET JFN FROM USER
	CALL DSKJFN		;GRNTEE JFN ON DISK
	 ITERR ()
	CALL GETFDB		;GET FDB ADRS
	 ITERR (GFUSX3,<CALL UNLCKF>)
	MOVEM T1,GFUFDA		;SAVE FOR LATER
	LOAD T2,FBVER,(T1)	;GET FDB VERSION
	CAIGE T2,1		;VER #1 OR LATER?
	JRST GFUS10		;VERSION #0 SPECIAL
	XCTU [HLRZ T3,1]	;GET FCN AGAIN
	LOAD T2,FBAUT,(T1)	;ASSUME AUTHOR
	CAIE T3,.GFAUT		;WAS IT
	LOAD T2,FBLWR,(T1)	;NO - GET LAST WRITE
	JUMPE T2,[MOVEI T2,[EXP 0,0,0] ;DUMMY BLOCK IF NONE
		  JRST GFUS05]	;RETURN USER A NULL
	ADD T2,DIRORA		;RELOCATE POINTER
	LOAD T1,UNTYP,(T2)	;GET TYPE FIELD
	CAIE T1,.TYUNS		;USER NAME STRING?
	ITERR (GFUSX4,<CALL USTDIR
			CALL UNLCKF>) ;SOMETHING WRONG
GFUS05:	CALL CPYXL		;COPY STRING TO USER SPACE
	JRST MRETN		;RETURN
GFUS10:	MOVEI T2,MAXLW+1	;GET LENGTH OF BLOCK REQUIRED
	CALL ASGJFR		;ASSIGN JSB FREE SPACE FOR STRING
	 ITERR (GFUSX2,<CALL UNLCKF
			CALL USTDIR>)	;NO ROOM IN JSB
	MOVEM T1,GFUBLK		;SAVE ADDRESS OF BLOCK ASSIGNED

; TRANSLATE REQUESTED DIRECTORY NUMBER TO STRING

	HRROI T1,1(T1)		;FORM POINTER TO WHERE STRING SHOULD GO
	SETZM (T1)		;FORM NULL STRING TO BE RETURNED IN THE CASE
				; THE AUTHOR/LAST-WRITER DOES NOT EXIST
	XCTU [HLRZ T3,1]	;GET FUNCTION CODE FROM USER AGAIN
	MOVE T4,GFUFDA		;GET FDB ADDRESS
	LOAD T2,FBAT0,(T4)	;ASSUME AUTHOR STRING DESIRED
	CAIE T3,.GFAUT		;WAS AUTHOR REQUESTED ?
	LOAD T2,FBLW0,(T4)	;NO - GET LAST-WRITER INSTEAD
	ULKDIR			;UNLOCK DIRECTORY
	CALL UNLCKF		;UNLOCK JFN
	JUMPE T2,GFUS20		;NO AUTHOR/LAST-WRITER EXISTS, RETURN A NULL
	HRLI T2,USRLH		;ASSUME THE PUBLIC STRUCTURE
	DIRST			;TRANSLATE TO STRING
	 JRST [	CAIE T1,STRX06	;NO SUCH USER #
		CAIN T1,DIRX1	; OR INVALID DIRECTORY NUMBER ?
		JRST GFUS20	;YES, RETURN A NULL
		MOVEM T1,GFUERR	;FAILED, SAVE ERROR CODE
		MOVEI T1,JSBFRE	;GET FREE HEADER
		MOVE T2,GFUBLK	;GET ADDRESS OF BLOCK
		CALL RELFRE	;RELEASE SPACE FOR STRING
		OKINT		;PERMIT INTERRUPTS AGAIN
		MOVE T1,GFUERR	;RETRIEVE ERROR CODE
		ITERR ()]	;GIVE ERROR NOTICE TO USER
GFUS20:	UMOVE T1,2		;GET DESTINATION POINTER
	MOVE T2,GFUBLK		;GET ADDRESS OF BLOCK CONTAINING STRING
	CALL CPYTUS		;RETURN STRING TO USER
	MOVEI T1,JSBFRE		;GET FREE HEADER
	MOVE T2,GFUBLK		;GET ADDRESS OF BLOCK
	CALL RELFRE		;RELEASE SPACE USED TO HOLD STRING
	OKINT			;PERMIT INTERRUPTS AGAIN
	JRST MRETN		;GIVE USER SUCCESS RETURN
;GTFDB - RETURNS WORDS FROM A FILE'S FDB
;CALL:	1/	JFN
;	2/	LH: NUMBER OF WORDS TO READ, RH: OFFSET OF FIRST WORD
;	3/	LOCATION TO STORE WORDS
;
;RETURNS +1 IF SUCCESSFUL, ITRAPS ON ERRORS.
;IF THE FDB IS SHORTER THAN THE MAXIMUM SIZE OF AN FDB, ZERO WORDS
;ARE RETURNED FOR THE WORDS OFF THE END OF THE FDB.


.GTFDB::MCENT			;JSYS ENTRY
	STKVAR <GTFADR,GTFBEG,GTFEND,GTFZER>	;ALLOCATE VARIABLES
	MOVEM T3,GTFADR		;REMEMBER ADDRESS TO STORE DATA INTO
	HRRZM T2,GTFBEG		;SAVE BEGINNING OFFSET INTO FDB
	HLRZ T4,T2		;GET WORD COUNT BY ITSELF
	MOVE T1,GTFBEG		;GET BEGINNING OFFSET
	CAIL T1,.FBLEN		;MAKE SURE IT ISN'T TOO LARGE
	 ITERR(GFDBX1)		;YES, ERROR
	ADDI T1,-1(T4)		;COMPUTE LARGEST FDB ENTRY WANTED
	SKIPE T4		;MAKE SURE COUNT IS POSITIVE
	CAIL T1,.FBLEN		;AND OFFSET NOT TOO LARGE
	 ITERR(GFDBX2)		;NO, ERROR
	MOVEM T1,GTFEND		;SAVE ENDING OFFSET
	MOVE T1,GTFADR		;GET ADDRESS OF USER'S BLOCK
	XCTU [MOVES 0(T1)]	;MAKE SURE IT IS WRITABLE
	ADDI T1,-1(T4)		;GET ADDRESS OF END OF BLOCK
	XCTU [MOVES 0(T1)]	;MAKE SURE IT IS WRITABLE TOO
	UMOVE JFN,1		;GET JFN
	CALL CHKFIL		;MAKE SURE IT IS A FILE
	 ITERR()		;ILLEGAL
	TQNE <ASTF>		;SEE IF PARSE ONLY
	 ITERR(DESX7,<CALL UNLCKF>)	;YES, ERROR
	HRRZ T1,NLUKD(P3)	;GET DISPATCH FOR NAME LOOKUP
	CAIE T1,MDDNAM		;MUST BE MDDNAM
	 ITERR(GFDBX1,<CALL UNLCKF>)	;IF NOT, NOT LEGAL FOR THIS DEVICE
	CALL GETFDB		;GET POINTER TO THE FDB
	 ITERR(DESX3,<CALL UNLCKF>)	;FAILED
	MOVE T2,T1		;PUT FDB ADDRESS IN RIGHT AC
	LOAD T1,FBLEN,(T1)	;GET FIRST ILLEGAL OFFSET FOR THIS FDB
	MOVEM T1,GTFZER		;REMEMBER WHERE WE HAVE TO ZERO LATER
	MOVE T1,GTFEND		;GET LAST WORD WANTED OF FDB
	CAML T1,GTFZER		;WANTS DATA OFF OF THE END OF THE FDB?
	SOS T1,GTFZER		;YES, LIMIT IT TO LAST LEGAL WORD
	SUB T1,GTFBEG		;COMPUTE DIFFERENCE BETWEEN START AND END
	AOJLE T1,GTFD2		;CREATE NUMBER OF WORDS AND SKIP IF NONE
	ADD T2,GTFBEG		;ADD OFFSET TO FDB ADDRESS
	MOVE T3,GTFADR		;GET ADDRESS TO BLT TO
	CALL BLTMU1		;COPY SOME OF THE FDB TO THE USER
GTFD2:	CALL USTDIR		;UNLOCK THE DIRECTORY
	CALL UNLCKF		;AND THE JFN
				; ..
;NOW ZERO WORDS WHICH THIS FDB WAS NOT LONG ENOUGH TO CONTAIN.


GTFDB3:	AOS T1,GTFZER		;ADVANCE TO NEXT WORD
	CAMLE T1,GTFEND		;WANTS ANOTHER WORD OFF END OF FDB?
	MRETNG			;NO, ALL DONE
	SUB T1,GTFBEG		;YES, COMPUTE OFFSET IN USERS BLOCK
	JUMPL T1,GTFDB3		;NOT UP TO BLOCK YET, GO ON
	ADD T1,GTFADR		;ADD ADDRESS OF BLOCK
	XCTU [SETZM 0(T1)]	;CLEAR THE WORD
	JRST GTFDB3		;CONTINUE
; Get open file status
; Call:	1	; Jfn
;	GTSTS
; Return
;	+1
;	2	; Status word as in filsts

.GTSTS:: MCENT
;**;[1861] Revamp code at .GTSTS: +1L	JGZ	29-APR-81
	UMOVE JFN,1		;[1861] FETCH THE USER'S JFN
	CALL CHKJFD		;[1861] CHECK IT OUT, GET FILSTS TO STS
	 JRST GTSTS1		;[1861] ILLEGAL, RETURN ZERO
	 JFCL			;[1861] TTY, SAME AS
	 SETZM STS		;[1861] BYTE POINTER, RETURN ZERO
	CALL UNLCKF		;[1861] DON'T NEED THE FILE ANYMORE
	TXNN STS,NAMEF		;[1861] JFN ASSIGNED?
GTSTS1:	SETZM STS		;[1861]  NO, BE SURE ALL OTHER BITS CLEAR TOO
	ANDX STS,DOCSTS		;[1861] KEEP JUST THE DOCUMENTED BITS
	UMOVEM STS,2		;[1861] RETURN THEM TO THE USER
	MRETNG			;[1861] AND DONE
; Initialize directory
; Call:	1	; Device designator
;	INIDR
; Return
;	+1	; Error
;	+2	; Ok

.INIDR::MCENT
	TLO A,(1B3)		;SAY MOUNT WITHOUT READING DIRECTORY
	MOUNT			;MAKE SURE FRESHLY MOUNTED
	 RETERR()		;COULDN'T MOUNT
	UMOVE A,1		;GET DEVICE DESIGNATOR
	CALL CHKDEV
	 RETERR()
	HRRZ P3,DEV		;SET UP ADDRESS ONLY
	TLNN C,(1B8)
	RETERR(DEVX3)		; Not mounted
	CALL @INDD(P3)
	 RETERR()		;FAILED
	SMRETN
; Convert jfn to string
; Call:	1	; Jfn
;	2	; String pointer
;	3	; Format specification (see jsys manual)

	JS%TM1==40		;TEMP FLAG IN Q3 FOR PUNCTUATE NULL EXTENSION
	JS%TM2==20		;TEMP FLAG IN Q3 FOR MULTIPLE DIR DEV
	JS%TM3==1		;TEMP FLAG IN Q1 FOR SUPRESSING LEADING TAB

.JFNS::	MCENT
	UMOVE A,3		;GET BITS
	TRNE A,1B26		;IS AC2 JFN OR STRING POINTER?
	JRST JFNX0		;STRING
	HRRZ JFN,2
	CALL CHKJFD
	 ITERR()
	 JFCL
	 ITERR(DESX4)
	CALL UNLCKF
	UMOVE A,1
	TLNN A,777777
	 JRST JFNSZ		; Not byte pointer
	TLC A,777777
	TLCN A,777777
	 HRLI A,440700		; -1 in lh, fill in
	SETZ B,
;**;[1908] Add 1 line at JFNSZ:-2L	PED	15-JUL-81
	UMOVEM A,1		;[1908] Return byte pointer to user
	XCTBU [IDPB B,A]	; Deposit initial null in case
JFNSZ:	XCTU [HLLZ F1,2]
	XCTU [SKIPN Q3,3]
	MOVE Q3,[2B2!2B5!1B8!1B11!2B14!JS%ATR!JS%PSD!JS%PAF]
	SETZ Q1,		; Initialize tab flag
	HLRZ A,FILDDN(JFN)	; Get pointer to device block
	MOVN B,(A)
	HRLI A,-2(B)
	CALL DEVLUX
	 SETZ A,
	MOVE C,DEVUNT(B)	;GET PSEUDO-DEVICE FLAG
	CAME C,[-1]		;NO UNITS?
	TXNN C,DV%PSD		;PSEUDO-DEVICE?
	TLNE A,(DV%DIR)
	TROA Q3,JS%TM1
	TRZ Q3,JS%TM1
	TQNE <ASTF>		;PARSE-ONLY?
	TRO Q3,JS%TM1		;YES, ALWAYS PUNCTUATE EXTENSION
	CAME C,[-1]		;NO UNITS?
	TXNN C,DV%PSD		;PSEUDO-DEVICE?
	TLNE A,(DV%MDD)
	TROA Q3,JS%TM2
	TRZ Q3,JS%TM2

;DO DEVICE FIELD

	CALL GTCSCD		; GET THE STRUCTURE UNIQUE CODE
	HLRZ C,A		; OF THE CURRENT CONNECTED STR
	LDB D,[POINT 3,Q3,2]	; Get format control byte for device
	CALL TAB4
	JUMPE D,JFNS0		;GO ON IF NO PRINT WANTED
	TQNE <STRSF>		;WILD DEVICE?
	JRST [	MOVEI B,[ASCIZ/DSK*/]-1	;YES, POINT AT WILD STRING
		CALL JFSTA1	;OUTPUT IT
		JRST JFNSDW]	;GO DO PUNCTUATION
	LOAD A,FILUC,(JFN)	; GET THE UNIQUE CODE OF THE DEV
	CAIN D,2		; If it is suppress system default
	CAME A,C		; AND IS THE DEVICE THE CONNECTED STR?
	CAIN D,0		; Or if control is "no print"
	JRST JFNS0		; Don't print
	HLRZ A,FILDDN(JFN)	; GET THE DEVICE NAME STRING TO PRINT
	CALL JFNSS		; Output the string in a
JFNSDW:	MOVEI B,":"
	CALL PUNCT
	; ..
;DO DIRECTORY FIELD

JFNS0:	HRRZ A,FILDDN(JFN)	; Get directory number
	LDB D,[POINT 3,Q3,5]	; And format control
	CALL TAB4		; Tab before field if desired
	TQNE <DIRSF>
	JRST JFNS0A
	CAIN D,2		; If suppressing default,
	JRST [	LOAD T1,JSCDF	;CONNECTED DIRECTORY STRING VALID FLAG
		SKIPN T1	; SKIP IF STRING EXISTS IN JSB
		CALL JFNSCD	; ELSE TRY TO SET ONE UP
		JE JSCDF,,JFNS0A ;IF NO VALID NAME STRING IN JSB, PRINT DIR
		LOAD A,JSCDS	;GET ADR OF CONNECTED DIR STRING
		HRLI A,(POINT 7,0,35)
		LOAD B,FILDIR,(JFN) ;GET ADR OF DIR NAME STRING
		JUMPE B,JFNS1	;IF NO DIR NAME, DONT OUTPUT IT
		HRLI B,(POINT 7,0,35)
		CALL STRCMP	;COMPARE THE STRINGS
		 JRST JFNS0A	;THE STRINGS DONT MATCH, GO OUTPUT DIR
		JRST JFNS1]	;THEY MATCH, DO NOT OUTPUT THE DIR NAME
JFNS0A:	LDB D,[POINT 3,Q3,5]	; GET format control
	CAIN D,0		; if no print is wanted
	JRST JFNS1		; Then don't print
	LOAD B,FILDIR,(JFN)	; GET POINTER TO DIRECTORY STRING
	TQNN <DIRSF>		; IF STARS, GO RETURN THE WILD STRING
	JUMPE B,JFNS1		; IF NONE, DONT TRY TO OUTPUT IT
	MOVEI B,"<"
	CALL PUNCT		; Print punctuation if desired
	TQNE <DIRSF>
	JRST [	LOAD B,FILDMS,(JFN) ;GET WILD MASK
		CALL JFSTA1	; GO DO IT OR A STAR
		JRST JFNS0B]
	LOAD A,FILDIR,(JFN)	; GET POINTER TO DIRECTORY STRING
	JUMPE A,JFNS0B		; IF NONE, DONT TRY TO OUTPUT IT
	CALL JFNSSD		; Copy string to output
JFNS0B:	MOVEI B,">"
	CALL PUNCT		; And output terminating punct

;DO NAME FIELD

JFNS1:	HLRZ A,FILNEN(JFN)	; Get location of file name block
	LDB D,[POINT 3,Q3,8]	; And output control
	CALL TAB4		; Tab before field if required
	JUMPE D,JFNS2		; No print wanted
	TQNE <NAMSF>
	JRST [	LOAD B,FILNMS,(JFN) ;GET NAME WILD MASK
		CALL JFSTA1	; PRINT IT OR A STAR
		JRST JFNS2]
	CALL JFNSS		; Copy string to output
	; ..
;DO EXTENSION FIELD

JFNS2:	HRRZ A,FILNEN(JFN)	; Get location of extension block
	LDB D,[POINT 3,Q3,11]	; And output control
	CALL TAB4		; Tab before field if required
	JUMPE D,JFNS3		; No print wanted
	MOVEI B,"."
	MOVE C,1(A)		; SEE IF THERE IS AN EXTENSION STRING
	TLNN C,774000		; IF NON-NUL STRING, TYPE OUT PUNCT.
	TRNE Q3,JS%TM1
	CALL PUNCT		; Output punctuation if desired
	TQNE <EXTSF>
	JRST [	LOAD B,FILEMS,(JFN) ;GET EXTENSION WILD MASK
		CALL JFSTA1	; PRINT IT OR A STAR
		JRST JFNS3]
	CALL JFNSS		; Copy to output

;DO VERSION

JFNS3:	HRRE A,FILVER(JFN)	; Get version number
	LDB D,[POINT 3,Q3,14]	; And output control
	CALL TAB4		; Tab before field if required
	JUMPE D,JFNS4		; No print wanted
	TQNE <ASTF>		;HAD OUTPUT STARS?
	JRST [	JUMPN A,DOJF3	;YES. DO NON-ZERO VERSION
		TXNE F1,VERSF!RVERF!HVERF!LVERF ;ANY SPECIALS?
		JRST DOJF3	;YES. DO THEM
		JRST .+1]	;NO. DO LAST TEST
	TRNN Q3,JS%TM2
	JRST JFNS4
DOJF3:	MOVEI B,PNCVER
	CALL PUNCT
	MOVE B,A
	MOVEI C,12
	TQNE <VERSF>
	JRST [	CALL JFSTAR
		JRST MRETN]
	TQNE <RVERF>
	MOVNI B,0
	TQNE <HVERF>
	MOVNI B,1
	TQNE <LVERF>
	MOVNI B,2
	CALL NOUTXX
	; ..
;SAVE INFORMATION FOR ;A, ;P, ;T

JFNS4:	TQNE <ASTF>		;STARS?
	JRST JFNS44		;YES. SKIP ALL DIRECTORY STUFF
	HRRZ A,NLUKD(P3)
	CAIE A,MDDNAM
	JRST [	CAIN P3,MTDTB	;AN MT?
		CALL [	LDB D,[POINT 3,Q3,17] ;GET CTL BITS FOR PROTECTION
			CALL TAB4	;DO TAB CONTROL
			CALL MTGPRO	;GET PROTECTION
			JUMPE A,R	;IF NONE, DONE
			JUMPE D,R	;OR IF NO TYPEOUT, DONE
			TXO A,5B2	;MAKE SURE IT IS A NUMBER
			CALLRET JFNSP]	;AND DO IT
		CALL JFNSAT	;TYPE OUT ATTRIBUTES (IF ANY)
		MRETNG]		;DONE
	CALL GETFDB		; Get a pointer to the fdb
	 JRST [	CALL JFNSAT	;TYPE OUT ATTRIBUTES (IF ANY)
		MRETNG]		;DONE
	PUSH P,.FBREF(A)
	PUSH P,.FBWRT(A)
	PUSH P,.FBCRV(A)
	LOAD B,FBNPG,(A)
	PUSH P,B
	PUSH P,.FBCTL(A)
	MOVE B,.FBACT(A)	; Get account
	SETZ C,			; 0 words of string
	TLNN B,700000		; String account?
	 JRST [	ADD B,DIRORA	;GET ABSOLUTE ADR OF STRING
		EXCH A,D	;SAVE A
		LOAD A,ACLEN,(B) ;GET LENGTH OF STRING BLOCK
		SUBI A,.ACVAL	;SKIP HEADER AND SHARE COUNT
		HRL A,A		;TO BOTH HALVES
		XMOVEI C,1(P)	;WHERE TO PUT STRING ON STACK
		XMOVEI B,.ACVAL(B)	;WHERE TO GET STRING FOM
		ADD P,A
		PUSH P,A	;SAVE TO BEYOND STRING
		PUSH P,C	;SAVE STACK POINTER (POINTER TO STRING
		SOS 0(P)
		JUMPGE P,MSTKOV	;OVERFLOW
		CALL XBLTA	;DO BLT
		EXCH D,A	;RESTORE
		JRST JFNS43]
	PUSH P,C		; Save size of string
	PUSH P,B		; And account or pointer
JFNS43:	MOVE D,DIRORA		; GET BASE ADR OF MAPPED DIR
	LOAD D,DRDPW,(D)	; GET DEFAULT PROTECTION WORD
	PUSH P,D		; PUT IT ON THE STACK
	PUSH P,.FBPRT(A)
	CALL USTDIR		; Unlock directory (done with it)
JFNS44:	LDB D,[POINT 3,Q3,17]
	CALL TAB4
	TQNE <ASTF>		;PARSE ONLY?
	JRST [	SKIPE D		;YES. WANT OUTPUT OF PROTECTION?
		SKIPN FILPRT(JFN) ;YES. HAVE ONE?
		JRST JFNS5	;NO. GIVE IT UP
		JRST JFNS45]	;GO DO IT
	MOVE B,0(P)
	CAIN D,2
	CAME B,-1(P)
	CAIN D,0
	JRST JFNS5
	; ..
;DO ;P

JFNS45:	MOVE A,0(P)		;GET PROTECTION
	TQNE <ASTF>		;PARSE ONLY?
	MOVE A,FILPRT(JFN)	;YES. GET IT FROM JFN THEN
	CALL JFNSP		;AND DO IT

;DO ;A

JFNS5:	TQNN <ASTF>		; PARSE ONLY
	SUB P,[XWD 2,2]		; Flush protection and def prot
	LDB D,[POINT 3,Q3,20]
	CALL TAB4
	JUMPE D,JFNS6
	CAIN D,2		; WANT DEFAULT?
	TQNE <ASTF>		; YES, AND NOT OUTPUT STARS?
	JRST JFNS5A		; NO, PRINT OUT THE ACCOUNT STRING
	MOVE A,[POINT 7,ACCTSR]	; GET A POINTER TO THE CURRENT ACCOUNT
	MOVE B,0(P)		; GET POINTER TO THIS ACCOUNT STRING
	JUMPL B,JFNS5A		; IF OLD STYLE NUMERIC ACCOUNT, GO PRINT IT
	HRLI B,(POINT 7,0,35)	; OTHERWISE SET UP A BYTE POINTER
	CALL STRCMP		; SEE IF THE STRINGS ARE EQUAL
	 SKIPA			; NO, GO OUTPUT IT
	JRST JFNS6		; THE ACCOUNT IS THE DEFAULT, DONT OUTPUT
JFNS5A:	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"A"
	CALL PUNCT
	TQNE <ASTF>		; PARSE ONLY?
	SKIPA A,FILACT(JFN)	; YES. GET IT FROM JFN THEN
	MOVE A,(P)		; Get account or pointer
	MOVEI C,^D10
	SKIPE A			;IF ZERO, FORGET IT .
	CALL JFNSN

;DO ;T

JFNS6:	TQNE <ASTF>		;PARSE ONLY?
;**;[2601]REPLACE 1 LINE WITH 2 AT JFNS6:+1L	TAM	29-MAR-82
	JRST [CALL JFNSAT	;[2601] YES, DO ATTRIBUTES
	      MRETNG]		;[2601] ALL DONE NOW
	SUB P,BHC+1		; Flush account or pointer
	POP P,C			; Get size of saved string
	SUB P,C			; Flush string from stack
	LDB D,[POINT 1,Q3,21]
	POP P,B
	TXNE B,FB%TMP
	CAIN D,0
	JRST JFNS6A
	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"T"
	CALL BOUTA

JFNS6A:	LDB D,[POINT 1,Q3,29]	; Offline output bit
	TXNE B,FB%OFF		; File offline?
	CAIN D,0		; And ;OFFLINE output requested?
	JRST JFNS7		; No
	MOVEI B,PNCATT		; Yes
	CALL PUNCT
	MOVEI A,[ASCIZ /OFFLINE/]-1  ; String for output by JFNSS
	CALL JFNSS
	; ..
;DO SIZE IN PAGES

JFNS7:	CALL JFNSAT		;OUTPUT THE ATTRIBUTES
	LDB D,[POINT 1,Q3,22]
	CALL JFNCOM
	CALL TAB4
	JUMPE D,JFNS8
	MOVE B,0(P)		;GET SIZE
	MOVEI C,^D10
	CALL NOUTXX

;DO DATES

JFNS8:	SUB P,BHC+1
	POP P,B			;GET .FBCRV
	TRNE Q3,1B23
	CALL JFNDAT
	CALL TAB4
	POP P,B			;GET .FBWRT
	TRNE Q3,1B24
	CALL JFNDAT
	CALL TAB4
	POP P,B			;GET .FBREF
	TRNE Q3,1B25
	CALL JFNDAT
	 JFCL
	JRST MRETN

;LOCAL ROUTINE TO OUTPUT PROTECTION
;	A/ PROTECTION

JFNSP:	PUSH P,A		;SAVE PROTECTION
	MOVEI B,PNCATT
	CALL PUNCT		;DO PUNCT CHAR
	MOVEI B,"P"		;GET PREFIX
	CALL PUNCT		;DO IT AS WELL
	POP P,A			;GET BACK PROTECTION WORD
	MOVEI C,10		;IN OCTAL
	CALLRET JFNSN		;AND DO IT
;DO ATTRIBUTES

JFNSAT:	STKVAR <JFNSAC,JFNSAA,JFNSAV>
	TXNE Q3,JS%ATR		;WANT ALL ATTRIBUTES?
	JRST JFNAT1		;YES
	TXNN Q3,JS%AT1		;WANT ONE ATTRIBUTE?
	RET			;NO, DO NOTHING
	UMOVE A,4		;YES, GET THE POINTER TO PREFIX
	CALL CPYFUS		;COPY STRING TO MONITOR SPACE
	 ITERR()		;FAILED
	MOVEM A,JFNSAA		;SAVE ADR OF STRING BLOCK
	HRLI A,(POINT 7,0,35)	;SET UP A BYTE POINTER TO STRING
	MOVEI B,PRFXTB		;SET UP TO LOOK FOR PREFIX
	EXCH A,B
	TBLUK			;LOOK UP PREFIX
	 ERJMP JFN1AE		;FAILED
	TXNN B,TL%ABR!TL%EXM	;FOUND A MATCH?
	JRST JFN1AE		;NO, ERROR
	HRRZ B,0(A)		;GET THE PREFIX VALUE
	ANDI B,PFXMSK		;GET JUST THE VALUE
	LOAD A,FILATL,(JFN)	;GET POINTER TO START OF ATTRIBUTE LIST
JFN1A1:	JUMPE A,JFN1AE		;IF NONE, GIVE ERROR RETURN
	LOAD C,PRFXV,(A)	;GET PREFIX VALUE OF THIS ENTRY
	CAMN C,B		;FOUND A MATCH YET?
	JRST JFN1A2		;YES, GO RETURN THE VALUE
	LOAD A,PRFXL,(A)	;STEP TO NEXT ENTRY ON LIST
	JRST JFN1A1		;LOOP BACK TIL DESIRED ENTRY FOUND

JFN1A2:	CALL JFNSS		;GO RETURN THE STRING TO THE USER
	HRRZ B,JFNSAA		;GET ADDRESS OF TEMP STRING
	MOVEI A,JSBFRE		;RETURN TEMP STRING
	CALLRET RELFRE		;AND EXIT

JFN1AE:	HRRZ B,JFNSAA		;RETURN THE TEMP STRING
	MOVEI A,JSBFRE		;TO THE FREE POOL
	CALL RELFRE
	ITERR (GJFX40)		;NO SUCH ATTRIBUTE ERROR


;RETURN ALL ATTRIBUTES TO THE CALLER

JFNAT1:	SETZB A,JFNSAC		;INITIALIZE THE COUNT OF ATTRIBUTES
JFNAT2:	CALL GTNPFX		;GET THE NEXT PREFIX
	 RET			;NO MORE, RETURN
	MOVEM A,JFNSAA		;SAVE THE ADDRESS OF THE BLOCK
	LOAD B,PRFXV,(A)	;GET THE ATTRIBUTE PREFIX
	CAIN B,.PFPWD		;IS THIS THE PASSWORD ONE?
	JRST JFNAT3		;YES - THEN DO NOT PRINT IT
	MOVEI B,PNCATT		;GET THE STARTING PUNCTUATION
	CALL PUNCT		;PUT ";" INTO CALLER'S STRING
	MOVE A,JFNSAA		;GET BACK ADDRESS OF THE ATTRIBUTE
	LOAD A,PRFXV,(A)	;GET THE PREFIX VALUE FROM BLOCK
	CALL GTPFXS		;GET ADDRESS OF PREFIX STRING
	 RET			;COULD NOT FIND IT, JUST RETURN
	MOVEM B,JFNSAV		;SAVE THE VALUE
	CALL JFNSS		;OUTPUT THE PREFIX STRING
	MOVE C,JFNSAV		;GET BACK THE VALUE OF THE PREFIX
	TRNE C,NOATRF		;IS THIS A NO VALUE ATTRIBUTE?
	JRST JFNAT3		;YES, DO NOT ADD ON A NULL VALUE
	MOVEI B,PNCPFX		;GET PUNCTUATION OF PREFIX
	CALL PUNCT		;OUTPUT THE ":"
	HRRZ A,JFNSAA		;GET THE ADDRESS OF THE ATTRIBUTE BLOCK
	CALL JFNSS		;OUTPUT THE ATTRIBUTE VALUE
JFNAT3:	AOS A,JFNSAC		;STEP TO THE NEXT ATTRIBUTE
	JRST JFNAT2		;LOOP BACK TILL ALL ATTRIBUTES SEEN


;ROUTINE TO GET NEXT ATTRIBUTE ON CHAIN
;ACCEPTS IN A/	COUNT OF THE DESIRED BLOCK
;	CALL GTNPFX
;RETURNS +1:	NO MORE
;	 +2:	ADDRESS OF BLOCK IN AC A

GTNPFX:	MOVE D,A		;SAVE THE COUNT
	LOAD A,FILATL,(JFN)	;GET START OF ATTRIBUTE CHAIN
GTNPF1:	JUMPE A,R		;IF NO MORE, RETURN
	SOSGE D			;FOUND THE DESIRED ENTRY?
	RETSKP			;YES, RETURN WITH ADRRESS IN A
	LOAD A,PRFXL,(A)	;STEP TO NEXT ITEM ON THE CHAIN
	JRST GTNPF1		;LOOP BACK TILL DESIRED ENTRY IS FOUND


;ROUTINE TO GET ADDRESS OF PREFIX STRING (FOR JFNSS)
;ACCEPTS IN A/	VALUE OF THE DESIRED PREFIX
;	CALL GTPFXS
;RETURNS +1:	NOT FOUND
;	 +2:	A/	ADDRESS OF STRING BLOCK -1 (FOR JFNSS)

GTPFXS:	HLRZ D,PRFXTB		;GET NUMBER OF ENTRIES IN PREFIX TABLE
	MOVNS D			;BUILD AOBJN POINTER
	HRLZS D
	HRRI D,PRFXTB+1		;POINT TO FIRST ENTRY IN TABLE
GTPFX1:	HRRZ B,0(D)		;GET THE PREFIX VALUE
	ANDI B,PFXMSK		;GET JUST THE VALUE
	CAMN A,B		;FOUND IT YET?
	JRST GTPFX2		;YES
	AOBJN D,GTPFX1		;NO, LOOP BACK TIL FOUND
	RET			;NOT FOUND

GTPFX2:	HLRZ A,0(D)		;GET ADDRESS OF STRING
	HRRZ B,0(D)		;GET PREFIX VALUE AND FLAGS
	SOJA A,RSKP		;RETURN ADDRESS-1 FOR JFNSS
;JFNX
;SPECIAL STRING INPUT HANDLER TO PUT CORRECT PUNCTUATION AROUND
;THE STRING. PUNCTUATION USED IS THAT FOR THE FIRST NON-ZERO FIELD
;FOUND SCANNING FROM LEFT TO RIGHT
JFNX0:	MOVE JFN,2
	CALL CHKJFN
	 ITERR()
	 ITERR(DESX4)
	 JRST JFNX0A
	CALL UNLCKF
	ITERR(DESX1)

JFNX0A:	UMOVE A,1
	TLNN A,777777
	 JRST JFNX1		; Not byte pointer
	TLC A,777777
	TLCN A,777777
	 HRLI A,440700		; -1 in lh, fill in
	SETZ B,
	XCTBU [IDPB B,A]	; Deposit initial null in case
JFNX1:	XCTU [HLLZ F1,2]
	XCTU [MOVE Q3,3]
	MOVEI B,11
	TRNE Q3,3B34		;EITHER TAB REQUEST?
	CALL BOUTA		;YES, OUTPUT TAB
	TXNE Q3,7B2		;DEVICE?
	JRST JFNXDA		;YES
	TXNE Q3,7B5		;DIRECTORY?
	JRST JFNXDB		;YES
	TXNE Q3,7B8		;NAME?
	JRST JFNXN		;YES
	TXNE Q3,7B11		;EXTENSION?
	JRST JFNXE		;YES
	TXNE Q3,7B14		;VERSION?
	JRST JFNXV		;YES
	TXNE Q3,7B17		;PROTECTION?
	JRST JFNXP		;YES
	TXNE Q3,7B20		;ACCOUNT?
	JRST JFNXA		;YES
	TXNE Q3,1B21		; ";T" ?
	JRST JFNXT		;YES
	TXNE Q3,JS%ATR!JS%AT1	;ATTRIBUTES?
	JRST JFNXAT		;YES
	TXNE Q3,17B25		;SIZE OR ANY DATE?
	JRST JFNXSD		;YES
	TXNE Q3,JS%OFL		;OFFLINE?
	JRST JFNXOF
;DEVICE
JFNXDA:	CALL JFNXDO		;COPY USER STRING
	MOVEI B,":"
	JRST JFNXX1		; STORE PUNCTUATION AND EXIT

;DIRECTORY
JFNXDB:	MOVEI B,"<"
	CALL PUNCT
	CALL JFNXDO
	MOVEI B,">"
	JRST JFNXX1

;SIZE OR DATE
JFNXSD:	MOVEI B,","
	TRNE Q3,1B32
	CALL BOUTA
;NAME
JFNXN:	CALL JFNXDO
	JRST JFNXX2

;EXTENSION
JFNXE:	MOVEI B,"."
JFNXE1:	CALL PUNCT
	JRST JFNXN

;VERSION
JFNXV:	MOVEI B,PNCVER
	JRST JFNXE1

;ACCOUNT
JFNXA:	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"A"
	JRST JFNXE1

;PROTECTION
JFNXP:	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"P"
	JRST JFNXE1

;OFFLINE
JFNXOF:	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI A,[ASCIZ /OFFLINE/]-1
	CALL JFNSS
	JRST JFNXX2

;TEMPORARY
JFNXT:	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"T"
;END ROUTINE
JFNXX1:	CALL PUNCT
JFNXX2:	JRST MRETN

JFNXDO:	CAIN JFN,377777		;NIL?
	RET			;YES, DONE
JFNXD1:	XCTBU [ILDB B,JFN]	;GET BYTE FROM USER
	JUMPE B,R		;END ON NULL
	UMOVEM JFN,2		;UPDATE BYTE POINTER
	CALL BOUTA		;OUTPUT BYTE
	JRST JFNXD1
;ROUTINE TO PUNCTUATE ATTRIBUTES

JFNXAT:	MOVEI B,PNCATT		;ATTRIBUTE STARTING PUNCTUATION
	CALL PUNCT		;OUTPUT THE ";"
	CALL JFNXDO		;FOLLOWED BY THE PREFIX STRING
	TXNN Q3,JS%AT1		;DOES THIS HAVE A VALUE
	JRST JFNXX2		;NO, ALL DONE
	MOVEI B,PNCPFX		;YES, OUTPUT THE PUNCTUATION
	CALL PUNCT		;  BETWEEN FIELDS
	UMOVE JFN,4		;SET UP POINTER TO VALUE STRING
	TLC JFN,-1		;SEE IF -1 IN LH
	TLCN JFN,-1		;...
	HRLI JFN,(POINT 7,0)	;YES, SET UP BYTE POINTER
	CALL JFNXDO		;OUTPUT THE STRING
	JRST JFNXX2		;ALL DONE
;LOCAL NUMBER OUTPUT ROUTINE FOR JFNS
;NOUTXX ALWAYS PRINTS NUMBER
;JFNSN TAKES A AS STRING POINTER IF POSITIVE, NUMBER (AFTER FLUSHING
; BITS 0-2) IF NEGATIVE

JFNSN:	JUMPG A,JFNSS		; Copy to output
	MOVE B,A
	TLZ B,700000
NOUTXX::PUSH P,JFN
	PUSH P,DEV
	PUSH P,STS
	PUSH P,F1
	PUSH P,Q3
	PUSH P,D
	PUSH P,F
	PUSH P,C
	PUSH P,B
	CALL NOUTX
	 JFCL
	POP P,B
	POP P,C
	POP P,F
	POP P,D
	POP P,Q3
	POP P,F1
	POP P,STS
	POP P,DEV
	POP P,JFN
	RET



;LOCAL ROUTINE FOR JFNS TO TRY TO SET UP CONNECTED DIRECTORY STRING
;IN JSB WHEN ABSENT.  USES ACCES JSYS TO CONNECT TO CURRENTLY CONNECTED
;DIRECTORY.... (PRESENT BECAUSE ACCES JSYS FOR ANOTHER JOB CAN'T WRITE
;THE STRING INTO ANOTHER JOB'S JSB FREE SPACE)


JFNSCD:	SAVEQ			;PRESERVE Q REGS
	MOVX T1,AC%CON+3	;CONNECT FUNCTION
	MOVEI T2,Q1		;ARGS IN Q1-Q3
	MOVE Q1,JSBSDN		;CURRENTLY CONNECTED DIRECTORY
	SETZM Q2		;GIVE NO PASSWORD
	SETOM Q3		;-1=THIS JOB
	ACCES			;AND DO IT
	 ERJMP .+1		;IGNORE ERRORS
	RET			;AND DONE
;LOCAL DATE PRINTER FOR JFNS

JFNDAT:	PUSH P,B
	MOVEI D,1
	CALL JFNCOM
	CALL TAB4
	POP P,B
	PUSH P,A
	SETZ C,
	HRROI A,1(P)
	ADD P,[XWD 4,4]
	ODTIM
	MOVEI C,-3(P)
	HRLI C,(<POINT 7,0>)
JFNDA1:	ILDB B,C
	JUMPE B,[SUB P,[XWD 4,4]
		POP P,A
		RET]
	CALL BOUTA
	JRST JFNDA1

;PRINT COMMA IF D=TRUE AND Q3/B32=1

JFNCOM:	MOVEI B,","
	CAIE D,0
	TRNN Q3,1B32
	RET
	CALLRET BOUTA

;PRINT MASK ADDRESSED BY B OR A STAR IF B IS ZERO

JFSTAR:	SKIPA			; ALWAYS DO A STAR IF ENTERED HERE
JFSTA1:	SKIPN B			; HAVE A MASK INSTEAD?
	MOVEI B,[ASCIZ /*/]-1	; NO. USE A STAR
	HRLI B,(<POINT 7,0,35>)	; MAKE A STRING POINTER
	STKVAR (MSKSAV)		; SAVE STRING PTR IN TEMP STORAGE
	MOVEM B,MSKSAV		; SAVE B FOR NOW
JFLOP:	ILDB B,MSKSAV		; TOP OF PRINT LOOP
	JUMPE B,R		; IF AT THE END, RETURN
	CALL BOUTA		; OUTPUT THE BYTE
	JRST JFLOP		; DO ALL OF STRING

;PRINT PUNCTUATION IF Q3/B35=1

PUNCT:	TRNE Q3,1B35
	CALLRET BOUTA
	RET

;PRINT TAB PER Q3/B33-34 IF D=TRUE

TAB4:	MOVEI B,11		;TAB
	TRNE Q3,JS%TBP
	CAIG D,0
	TRNE Q3,JS%TBR
	TRON Q1,JS%TM3		; Tab usage flag in Q1
	RET
	CALLRET BOUTA
;JFNSS AND JFNSSD - WRITE ASCII STRING

;ACCEPTS:
;	A/ ADDRESS OF ASCII STRING, WHICH STARTS IN BYTE 0 OF THE WORD
;		AND ENDS WITH A NULL

;	CALL JFNSS TO PRECEDE ALL SPECIAL CHARACTERS WITH CTRL/V
;		OR
;	CALL JFNSSD TO PRECEDE ALL SPECIAL CHARACTERS BUT PERIOD WITH CTRL/V

;RETURNS +1: ALWAYS

;CALL BOUTA, WHICH USES USER MODE AC 1 TO DETERMINE DESTINATION OF
;STRING. TERMINATES ON NULL

JFNSSD::TDZA D,D		;INDICATE DOT SHOULD NOT GET CTRL/V
JFNSS::	SETOM D			;INDICATE DOT SHOULD GET CTRL/V
	ACVAR <W1>
	MOVE W1,D		;SAVE THE FLAG IN CASE BOUTA CLOBBERS IT
	MOVE C,A		;GET ADDRESS OF STRING
	HRLI C,(<POINT 7,0,35>)	;CONSTRUCT POINTER TO SOURCE

;LOOP THROUGH THE CHARACTERS IN THE STRING, PRINTING EACH ACCORDING
;TO ITS CHARACTER CLASS. CONTINUE UNTIL NULL IS FOUND.

JFNSS1:	ILDB B,C		;GET NEXT CHARACTER
	JUMPE B,CPOPJ		;NULL INDICATES END OF STRING
	PUSH P,C		;GET A WORK AC
	PUSH P,B		;SAVE THE CHARACTER

;DETERMINE THE CHARACTER CLASS FROM CHARACTER TABLES DEFINED IN GTJFN
;IF SPECIAL, PRINT CTRL/V BEFORE PRINTING THE CHARACTER

	;IDIVI B,^D36/CCSIZE
	MOVEI B,^D36		; Have to do it the hard way cause
	IDIVI B,CCSIZE		; Macro can't divide externals
	MOVE C,B
	MOVE B,0(P)		;GET THE CHARACTER
	IDIV B,C		; And finally the real divide
	LDB B,CPTAB(B+1)	;GET THE CHARACTER CLASS
	JUMPE B,NTSPC		;0 IS NORMAL ALPHAS (EXCLUDES SOME LETTERS)
	CAIN B,30		; Minus sign not special
	 JRST NTSPC
	CAIL B,21		; Digits t, p, a
	CAILE B,24
	 JRST [	CAIN B,14	;IS THIS A DOT?
		JUMPE W1,NTSPC	;YES. IF REQUESTED, DON'T INSERT CTRL/V
		MOVEI B,"V"-100	;OUTPUT CTRL/V
		CALL BOUTA	; ACCORDING TO USER'S DESIGNATOR
		JRST NTSPC]	;AND THEN GO DO THE CHARACTER
NTSPC:	POP P,B			;GET THE CHARACTER
	POP P,C
	CALL BOUTA		;OUTPUT ACCORDING TO USER'S DESIGNATOR
	JRST JFNSS1		;GO GET THE NEXT CHARACTER
;**;[2607] Add one line at NTSPC: +4L	JGZ	3-APR-82
	ENDAV.			;[2607] END ACVAR
; Mount device
; Call:	1	; Device designator
;	MOUNT
; Return
;	+1	; Error
;	+2	; Ok

.MOUNT::MCENT
	UMOVE A,1
	TLZN A,(1B3)		; Directory to be read?
	TDZA B,B		; Yes
	SETO B,			; No
	PUSH P,B
	CALL CHKDEV
	 RETERR()
	UMOVE 1,1
	TLZ 1,(1B3)
	TLNE C,(DV%MNT)		; Already mounted?
	 JRST [	DSMNT		; Attempt to dismount first
		 RETERR()	; Error if can't
		JRST .+1]
	EXCH B,(P)		; Save b, get directory read flag
	HRRZ P3,DEV		; GET ADDRESS ONLY
	CALL @MNTD(P3)		; Call P3ice mount routine
	 RETERR()		;MOUNT ERROR
	POP P,B
	MOVSI C,(DV%MNT)
	IORM C,DEVCHR(B)	; Mark device as mounted
	SMRETN			;NO, DONE NOW
; Special file operation
; Call:	1	; Jfn
;	2	; Operation desired
;	MTOPR

.MTOPR::MCENT
MTOPR1:	UMOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JRST .+2
	 ITERR(DESX4)

	TQNE <OPNF>
	JRST MTOPR2		;OPENED PATH
	CALL FNDUNT		;FIND DEVICE TABLE INDEX
	HLRZ C,DEVUNT(A)	;GET JOB #
	MOVX B,DV%ASN		;ASSIGNED BIT
	TDNE B,DEVCHR(A)	;DEVICE ASSIGNED?
	CAME C,JOBNO		;BY THIS JOB?
	ITERR(CLSX1,<CALL UNLCKF>)
MTOPR2:	TQZ <ERRF,EOFF>		;OK TO PROCEED
	UMOVE B,2
	TQZE <BLKF>		;BLKF MUST BE ZERO BEFORE CALL
	BUG(BLKF5)
	XMOVEI C,MTOPRB	;PASS DOWN BLOCKAGE ROUTINE
	CALL @MTPD(P3)
	 JRST [	TQZE <BLKF>	;ROUTINE WANT TO BLOCK?
		JRST MTOPRW	;YES, GO BLOCK
		CALL UNLCKF
		ITERR()]
	CALL UNLCKF
	JRST MRETN

MTOPRW:	CALL UNLDIS		;UNLOCK JFN AND DISMIS
	JRST MTOPR1		;LOOP BACK AND START AGAIN

;CO-ROUTINE USED TO PERFORM LOWER LEVEL BLOCK

MTOPRB:	STKVAR <DEVSAV>		;SAVE DEV OF THIS DEVICE
	MOVEM DEV,DEVSAV
	CALL UNLDIS		;UNLOCK JFN ETC.
	UMOVE JFN,1		;GET USER JFN AGAIN
	CALL CHKJFN		;VALIDATE IT
	 RETBAD ()		;RETURN ERRORS
	 JRST .+2		;TTY OK
	 RETBAD (DESX4)
	CAME DEV,DEVSAV		;CHECK TO SEE THAT THIS IS THE SAME DEVICE
	RETBAD (DESX4)		;NO SOMEONE CHANGED THINGS
	RETSKP			;GIVE GOOD RETURN

; ROUTINE TO LOAD/STORE A WORD IN MTOPR FUNCTION BLOCK
;
; CALL:	A/ OFFSET INTO FUNCTION BLOCK
;	B/ VALUE TO BE STORED (IF ANY)
;		CALL GETWRD/PUTWRD
; RETURNS: +1	 ARGUMENT BLOCK TOO SMALL
;	   +2	SUCCESS, ARGUMENT STORED OR RETURNED IN B

PUTWRD::TDZA D,D		;FLAG STORE INSTEAD OF LOAD
GETWRD::SETOM D			;INDICATE FETCH REQUESTED
	UMOVE C,3		;GET ADDRESS OF USER'S ARGUMENT BLOCK
	UMOVE C,(C)		;GET LENGTH OF ARGUMENT BLOCK
	 ERJMP R		;FAILED, NON-EXISTENT
	CAML A,C		;ARGUMENT BLOCK BIG ENOUGH ?
	RET			;NO, FAIL RETURN
	UMOVE C,3		;GET ADDRESS OF ARGUMENT BLOCK AGAIN
	ADD C,A			;COMPUTE ADDRESS OF DESIRED WORD IN BLOCK
	JUMPE D,PUTWD1		;IF STORING GO PUT VALUE IN ARGUMENT BLOCK
	UMOVE B,(C)		;FETCH WORD DESIRED
	 ERJMP R		;FAILED, NON-EXISTENT
	RETSKP			;RETURN WITH REQUESTED VALUE

PUTWD1:	UMOVEM B,(C)		;STORE VALUE IN ARGUMENT BLOCK
	 ERJMP R		;FAILED, NON-EXISTENT
	RETSKP			;RETURN
; Open a file
; Call:	1	; Job file number
;	2(0-5)	; Byte size
;	2(6-9)	; Data mode
;	RH(2)	; Access flags (see jsys manual)
;	OPENF
; Return
;	+1	; Cannot open file, error code in 1
;	+2	; Successful

.OPENF::MCENT			; Become slow, save ac's
	TRVAR <UNTIDX>		;SAVE UNIT INDEX HERE
OPENF0:	UMOVE JFN,1		; Get jfn
	CALL CHKJFN		; What kind of designator is this?
	 RETERR()		; Garbage designator
	 JRST OPENF1		;DON'T ALLOW 400000+TERMINAL NUMBER
	 JRST [	CAIE DEV,STRDTB	; IS THIS A STRING POINTER
		JRST OPENFZ	; NO, NUL DEVICE IS OK
		ERUNLK (OPNX26)] ; YES, STRING POINTER IS ILLEGAL
	UMOVE F1,2		; Get access bits
	TXNN F1,OF%RD+OF%WR+OF%EX+OF%APP
	ERUNLK OPNX13		;RETURN ERROR IF NO ACCESS REQUESTED
	TQNE <OPNF>
	ERUNLK OPNX1		; Already open
	TQNE <ASTF>
	 ERUNLK(DESX7)		; Output stars not allowed
	LDB A,[POINTR F1,OF%BSZ]	;GET BYTE SIZE
	SKIPN A			; ZERO SPECIFIED?
	MOVEI A,^D36		; YES, USE FULL WORD
	CAILE A,^D36
	ERUNLK SFBSX2
	DPB A,PBYTSZ		; Store as byte size of pointer
	CALL FNDUNT		;GET DEV INDEX FOR UNIT
	MOVE C,DEVCHR(A)	;GET DEVICE BITS
	TXNE C,DV%AS		;ASSIGNABLE DEVICE?
	JRST [	HLRZ B,DEVUNT(A) ;GET CURRENT ASSIGNMENT
		CAMN B,JOBNO	;ASSIGNED BY THIS JOB?
		JRST .+1	;YES. PROCEED
		HRRZM A,UNTIDX	;SAVE UNIT INDEX HERE
		HRR C,DEVUNT(A) ;GET UNIT
		TLZ C,777000 ;REMOVE JUNK BITS
		TLO C,.DVDES ;ADD BITS FOR DESIGNATOR
		GTOKM (.GOOAD,<C>,[ERUNLK ()],OPENB)
		MOVE B,UNTIDX	;RECOVER UNIT INDEX
		MOVE C,DEVCHR(B) ;RESTORE MODE BITS AS WELL
		UMOVE F1,2	;RECOVER ACCESS BITS AS WELL
		CALL DEVAV	;DEVICE AVAILABLE?
		ERUNLK(OPNX7)	;NO
		JRST .+1]	;YES
	LDB A,[POINTR F1,OF%MOD];GET MODE
	MOVN D,A
	ROT C,-1(D)
	JUMPGE C,[ERUNLK(OPNX14)] ; Illegal mode
	STOR (A,IOMODE)		;SAVE IO MODE
	;..
	;..
	ANDX STS,<NAMEF+NONXF+ASTF+FRKF+.RTJST(OF%MOD,OF%MOD)> ;KEEP ONLY THESE BITS
	TXNE F1,OF%HER		;MOVE CALLER BITS TO INTERNAL PLACE
	TXO STS,HLTF
	TXNE F1,OF%RD
	TXO STS,READF
	TXNE F1,OF%WR
	TXO STS,WRTF
	TXNE F1,OF%EX
	TXO STS,XCTF
	TXNE F1,OF%APP
	TXO STS,RNDF
	TXNN F1,OF%PLN		;USER WANT LINE NUMBERS?
	TXNE F1,OF%WR!OF%EX!OF%APP;WRITING OR EXECUTING?
	TQO <PASLSN>		;THEN THIS ISN'T A LINE #D FILE
	LDB A,[POINTR F1,OF%BSZ]
	CAIE A,7		;IF THE FILE ISN'T ASCII,
	TQO <PASLSN>		;THEN IT CAN'T HAVE LINE NUMBERS TO REMOVE
	HRRZ A,DEV		;AND FINALLY, LINE FILES COME ONLY FROM
	CAIN A,DSKDTB		;  DISK
	JRST OPNFOK
	CAIE A,MTADTB		;  MAGTAPE
	CAIN A,DTADTB		;  AND DECTAPE
	JRST OPNFOK
	TQO <PASLSN>		;ALL OTHERS DON'T NEED EXAMINING
OPNFOK:	SETZM FILCNT(JFN)
	XMOVEI C,OPENB		;OPEN BLOCK ROUTINE
	CALL @OPEND(P3)		; Call the DEVIce dependent routine
				;N.B. BITS IN F1 USED BY DSK!!!
	 JRST OPENR		; Cannot open
	TQO <OPNF>		; Success
	MOVSI B,1
	HLLM B,FILLFW(JFN)
	CALL FNDUNT		;GET DEV INDEX
	MOVE B,DEVCHR(A)	;GET DEVICE BITS
	TXNN B,DV%AS		;ASSIGNABLE DEVICE?
	JRST OPENFZ		;NO
	CALL CKJFTT		;IS THIS THE JFN  FOR 'TTY'?
	 JRST OPENFZ		;YES. DON'T CHANGE DEVICE TABLES
	MOVE B,JOBNO		;NO, ASSIGN IT TO THIS JOB
	HRLM B,DEVUNT(A)
	MOVX B,DV%OPN
	IORM B,DEVCHR(A)	;NOTE ASSIGNED BECAUSE OF OPEN
	MOVEI A,0(DEV)		;SEE WHAT THIS DEVICE IS
	CAIN A,PTYDTB		;IS IT A PTY?
	CALL PTYINI		;YES. GO INIT TTY PARAMETERS THEN
OPENFZ:	CALL UNLCKF
	SMRETN
;HERE IF GTOKM INDICATED BLOCK
;
OPENR:	TQZE <BLKF>		;WANT TO BLOCK?
	JRST OPENFW		;YES - WAIT
	CAIN A,OPNX31		; Offline?
	 JRST RETFIL		; Yes, handle that case
	CAIE A,OPNX9		;BUSY?
	ERUNLK()		;NO, SOME OTHER ERROR
	UMOVE B,2		;GET USER'S BITS AGAIN
	TRNN B,OF%NWT		;"NEVER WAIT"?
	TRNN B,OF%AWT		;OR NO "ALWAYS WAIT"?
	ERUNLK()		;YES, ERROR OUT
	CALL UNLCKF		;"ALWAYS WAIT" AND NO "NEVER WAIT", THEREFORE WAIT
	SETZM INTDF
	XCT INTDFF
	MOVEI A,"["		;PRINT "[DEVICE BUSY-"
	PBOUT
	MOVEI A,101
	UMOVE B,1
	MOVEI C,0
	JFNS
	HRROI A,[ASCIZ / Busy-/]
	PSOUT
OPENR1:	MOVEI A,^D3000		;WAIT SHORT TIME THEN TRY AGAIN
	DISMS
	UMOVE A,A
	UMOVE 2,2
	TRO B,OF%NWT
	OPENF
	 JRST OPENR1
	UMOVEM 1,1		;SUCCESS NOW, PRINT "GO]"
	HRROI 1,[ASCIZ /Go]
/]
	PSOUT
	SMRETN

RETFIL:	UMOVE B,2		; Get user bits again
	SKIPN ARDFRT		; Job want to wait?
	TXNE B,OF%RAR		; Or this call?
	 CAIA			; Yes, or yes
	  ERUNLK()		; Neither, bomb
	TXNE B,OF%NWT		; Never wait?
	 ERUNLK()		; Right, fail now
	CALL UNLCKF
	SETZM INTDF
	XCT INTDFF
	HRROI T1,[ASCIZ/[Retrieving /]
	PSOUT
	MOVX A,.PRIOU
	UMOVE B,1
	MOVEI C,0
	JFNS
	HRROI A,[ASCIZ/ from tape - /]
	PSOUT
	UMOVE A,1		; Recover the JFN
	MOVX B,.ARRFR		; Retrieve the file pls
	MOVX C,AR%WAT		; I'm waiting on you
	ARCF
	 ERJMP RETFAI		; Couldn't????
	HRROI A,[ASCIZ/Retrieved]
/]
	PSOUT
	UMOVE A,1		; Get AC's again, OPENF assumes these
	UMOVE B,2
	JRST .OPENF		; Start over...

RETFAI:	MOVX A,.PRIOU
	MOVE B,LSTERR
	HRLI B,.FHSLF
	SETZ C,
	ERSTR
	 JFCL
	 JRST RETFFA		; ??? now what...
	HRROI A,[ASCIZ/]
/]
	PSOUT
RETFFA:	RETERR(OPNX31)		; Fail
;ROUTINE TO CHECK IF THE OPENF IS ALLOWED TO WIN IF THE DEV IS OFFLINE

;RETURNS +1:	NOT ALLOWED
;	 +2:	ALLOWED TO BE OPENED EVEN IF OFFLINE

CHKOFL::TXNN F1,OF%OFL		;CHECK THE OFF LINE BIT FROM AC2
	RET			;NOT ALLOWED
	RETSKP			;ALLOWED

;HERE WHEN CHKJFN RETURNED +2, INDICATING TERMINAL. IF USER SPECIFIED
;.PRIIN, .PRIOU, OR (0,,-1) RETURN SUCCESS WITHOUT ASSIGNING TERMINAL
;IN DEVICE TABLES.  IF USER GAVE 400000+TERMINAL NUMBER, FAIL

OPENF1:	UMOVE T1,1		;GET USER'S INPUT AGAIN
	CAIE T1,.PRIIN		;PRIMARY INPUT?
	CAIN T1,.PRIOU		;NO. PRIMARY OUTPUT?
	SMRETN			;ALLOW THEM TO SUCCEED
	CAIE T1,-1		;CONTROLLING TERMINAL?
	RETERR (DESX1)		;NO. INVALID DESIGNATOR
	SMRETN			;YES. ALLOW SUCCESS

;CKJFTT - CHECK FOR JFN FOR 'TTY'

;ACCEPTS:
;	JFN/ A VALID JFN

;	CALL CKJFTT

;RETURNS +1: JFN FOR 'TTY'
;	 +2: ANY OTHER JFN

;THIS ROUTINE IS CHECKING FOR A JFN ON THE STRING 'TTY:'.  SINCE THIS
;STRING IS TAKEN TO MEAN 'JOB'S CONTROLLING TERMINAL', THE CODE THAT
;OPENS A JFN (BOTH IN OPENF AND IN TTYOPN OF FILMSC) MUST NOT ASSIGN
;THE ASSOCIATED TERMINAL IN THE DEVICE TABLES OR ACTIVATE THE LINE.
;THIS IS BECAUSE, IF THE JOB DETACHES AND ATTACHES TO ANOTHER
;TERMINAL, DOING I/O ON THIS JFN WILL GET THE NEW CONTROLLING TERMINAL.
;IF DV%OPN HAD BEEN SET ON THE ORIGINAL TERMINAL, THE DETACH WOULD
;NOT DEASSIGN IT. WHEN A DETACHED JOB DOES AN OPENF ON TTY:, THE OPENF
;WILL SUCCEED WITHOUT ACTIVATING THE LINE.  WHEN THE JOB DOES I/O ON
;THE JFN, IT WILL BLOCK UNTIL THE JOB IS ATTACHED

CKJFTT::ACVAR<W1>		;GET WORK AC
	HLRZ W1,FILDDN(JFN)	;GET THE ORIGINAL STRING FROM THE GTJFN
	MOVE W1,1(W1)		;POINT BEYOND HEADER
	TRZ W1,377		;GET RID OF POSSIBLE GARBAGE
	CAMN W1,[ASCIZ/TTY/]	;IS THIS 'TTY'?
	RET			;YES. NONSKIP
	RETSKP			;SKIP
;**;[2607] Add one line at CKJFTT: +6L	JGZ	3-APR-82
	ENDAV.			;[2607] END ACVAR
;NORMAL BLOCK ROUTINE

OPENFW:	CALL UNLDIS		;UNLOCK AND DISMIS
	JRST OPENF0		;RETRY

;OPENF BLOCK CO-ROUTINE

OPENB:	STKVAR <SAVDEV>
	MOVEM DEV,SAVDEV	;SAVE DEV
	CALL UNLDIS		;UNLOCK & DISMS
	UMOVE JFN,1		;FETCH JFN AGAIN
	CALL CHKJFN
	 RETBAD ()		;JUNK
	 JRST OPENB1		;400000+N
	 JRST [	CAIE DEV,STRDTB	;STRING PNTR?
		JRST .+1
		RETBAD (OPNX26)]
	CAME DEV,SAVDEV		;CHECK FOR SAME DEVICE
	RETBAD (DESX4)		;NO YOU CHANGED IT ON ME
	RETSKP			;GOOD RETURN

;HERE WHEN CHKJFN RETURNED +2, INDICATING TERMINAL. IF USER SPECIFIED
;.PRIIN, .PRIOU, OR (0,,-1) RETURN SUCCESS WITHOUT ASSIGNING TERMINAL
;IN DEVICE TABLES.  IF USER GAVE 400000+TERMINAL NUMBER, FAIL

OPENB1:	CAME DEV,SAVDEV		;CHECK FOR SAME DEVICE
	RETBAD (DESX4)		;NO IT WAS CHANGED
	UMOVE T1,1		;GET USER'S INPUT AGAIN
	CAIE T1,.PRIIN		;PRIMARY INPUT?
	CAIN T1,.PRIOU		;NO. PRIMARY OUTPUT?
	SMRETN			;ALLOW THEM TO SUCCEED
	CAIE T1,-1		;CONTROLLING TERMINAL?
	RETERR (DESX1)		;NO. INVALID DESIGNATOR
	SMRETN			;YES. ALLOW SUCCESS
;RCDIR - RECOGNIZE DIRECTORY NAME
;
; CALL:		1/ FLAGS
;		2/ POINTER TO ASCIZ DIRECTORY NAME STRING
;		RCDIR
;		1/ FLAGS INDICATING RESULT:
;			RC%NOM - NO MATCH FOR STRING
;			RC%AMB - STRING WAS AMBIGUOUS
;		2/ UPDATED POINTER IF RECOGNITION WAS PERFORMED
;
; THE LEGAL FORMATS FOR A DIRECTORY STRING ARE:
;		STR:<DIRECTORY>
;		STR:[DIRECTORY]
;		STR:
;		<DIRECTORY>
;		[DIRECTORY]

; DEFINITIONS OF PUNCTUATION CHARACTERS --

	.CHDI1==:"<"		;TYPE 1 OPENING DIRECTORY BRACKET
	.CHDT1==:">"		;TYPE 1 CLOSING DIRECTORY BARCKET
	.CHDI2==:"["		;TYPE 2 OPENING DIRECTORY BRACKET
	.CHDT2==:"]"		;TYPE 2 CLOSING DIRECTORY BRACKET
	.CHDEV==:":"		;FILE STRUCTURE DELIMITER
	.CHWL1=="*"		;FIRST WILD CHARACTER
	.CHWL2=="%"		;SECOND WILD CHARACTER

; ACCUMULATOR USAGE --
;
; Q1/	RESULT REGISTER: CAN RETURN NOM,AMB,WLD,NMD
; Q2/	COPY OF USER'S FLAGS

; LOCAL VARIABLE USAGE --

; RCDBLK - LOOKUP POINTER TO BLOCK CONTAINING COPY OF USER STRING
; RCDDPT - BYTE POINTER TO BEGINNING OF DIRECTORY STRING IN RCCBLK
; RCDSTR - CONTAINS THE STRUCTURE NAME IN ASCIZ
; RCDBK2 - LOOKUP POINTER TO BLOCK HOLDING COPY OF DIRECTORY STRING
; RCDIDP - TERMINATING,,INITAL DIRECTORY PUNCTUATION CHARACTERS
; RCDTPT - POINTER TO TAIL OF DIRECTORY STRING SO RECOGNITION CAN BE DONE
; RCDNUM - DIRECTORY DESIGNATOR
; RCDUC - UNIQUE CODE OF STRUCTURE SPECIFIED
; RCDLND - LOOKUP POINTER TO DIRECTORY NAME IF FOUND IN LOGICAL NAME
; RCDUPT - USER'S BYTE POINTER TO STRUCTURE/DIRECTORY STRING
; RCDBPR - UPDATED BYTE POINTER TO STRUCTURE FIELD STRING

.RCDIR::MCENT			;MONITOR CONTEXT ENTRY
	CALL RCDIR0		;CALL INNER ROUTINE
	 ITERR ()		;ERROR RETURN
	JRST MRETN		;GOOD RETURN

;THIS LEVEL OF ROUTINE IS NEEDED BECAUSE MRETN DOESN'T CLEAN UP FROM
;JSBVAR.

RCDIR0:	JSBVAR <RCDBLK,RCDDPT,<RCDSTR,MAXLW+2>,RCDBK2,RCDIDP,RCDTPT,RCDNUM,RCDUC,RCDLND,RCDUPT,GETDT3>
	CALL RCDIR1		;GO DO THE WORK
	 JRST [	MOVEM T1,Q1	;FAILED. SAVE ERROR CODE
		CALL RCDCLN	;RELEASE FREE SPACE IF NEEDED
		MOVE T1,Q1	;RESTORE ERROR CODE
		RETBAD]		;RETURN FAILURE
	CALL RCDCLN		;RELEASE FREE SPACE IF NEEDED
	RETSKP			;RETURN SUCCESS (Q1 MAY HAVE ERROR)

;THIS LEVEL OF CODE IS NEEDED IN ORDER TO HANDLE ERROR RETURNS
;CONSISTENTLY

RCDIR1:	SETZM RCDBLK		;INITIALIZE POINTERS TO FREE SPACE
	SETZM RCDBK2		; IF THESE ARE NON-ZERO ON RETURN TO RCDIR0
	SETZM RCDLND		; THEY POINT TO JSB SPACE
	SETZ Q1,		;INITIALIZE TO INDICATE NO ERRORS
	UMOVE Q2,1		;GET FLAGS
	LOAD T1,JSUC		;GET UNIQUE CODE OF CONNECTED STR
	MOVEM T1,RCDUC		;SAVE IT IN CASE DEVICE WASN'T SPECIFIED
	;..
	;..
	UMOVE T1,2		;GET POINTER TO DIRECTORY STRING
				; OR DIRECTORY NUMBER...
	LOAD T2,NMFLG,T1	;LOOK AT BITS 0-2
	CAIN T2,NUMVAL		;IS IT A NUMBER?
	JRST [	TXNE Q2,RC%STP	;YES. STEPPING?
		RETBAD(DESX1)	;YES - NOT ALLOWED
		CALL RCNUM	;CONVERT USER NUMBER IF NECESSARY
		MOVEM T1,RCDNUM	;SAVE (UNIQUE CODE,,DIRECTORY NUMBER)
		JRST RCD550]	;GO SEE IF DIRECTORY IS OK
	HLRZ T2,T1		;NO. SEE IF LEFT HALF IS 0
	SKIPN T2		;IF ZERO, THIS IS A JFN
	JRST [	TXNE Q2,RC%STP	;STEPPING?
		RETBAD(DESX1)	;YES - NOT ALLOWED
		CALL RCJFN	;GET THE STRUCTURE,,DIRECTORY FOR THIS JFN
		 RETBAD		;INVALID. RETURN ERROR
		MOVEM T1,RCDNUM	;SAVE (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
		JRST RCD550]	;GO SEE IF DIRECTORY IS OK

;THIS IS A STRING POINTER. COPY THE STRING TO BE RECOGNIZED

	MOVEM T1,RCDUPT		;SAVE FOR COPYING BACK HERE LATER
	MOVEI T2,2*MAXLW+1	;T2/ALLOW ROOM FOR LOGICAL NAME AND DIRECTORY PLUS
				; PUNCTUATION
	CALL CPYUSR		;COPY STRING FROM USER SPACE
	 RETBAD (RCDIX1)	;FAILED, RETURN "INSUFFICIENT RESOURCES" ERROR
	MOVEM T1,RCDBLK		;SAVE LOOKUP POINTER TO BLOCK CONTAINING STRING
	UMOVEM T3,2		;UPDATE THE USER'S BYTE POINTER

; DETERMINE IF A STRUCTURE NAME WAS INCLUDED IN THE STRING

	LDB T2,[POINT 7,1(T1),6] ;GET FIRST CHARACTER OF STRING
	HRLI T1,(POINT 7,0,35)	;FORM ILDB POINTER TO BEGINNING OF STRING
	MOVEM T1,RCDDPT		;ASSUME STRING STARTS WITH DIRECTORY
	CAIE T2,.CHDI1		;DOES THE STRING BEGIN WITH VALID
	CAIN T2,.CHDI2		;  DIRECTORY PUNCTUATION ?
	JRST RCD050		;YES, GO PROCESS DIRECTORY

; A DEVICE FIELD WAS SUPPLIED - COPY IT TO THE STACK
;STOP AT A NULL OR COLON OR WHEN THE MAXIMUM ALLOWED NUMBER OF
;CHARACTERS ARE DETECTED

	MOVEI T1,RCDSTR		;GET ADDRESS OF BLOCK ON STACK
	HRLI T1,(POINT 7,0,35)	;POINT BEYOND HEADER
	MOVE T2,RCDBLK		;GET ADDRESS OF BLOCK CONTAINING STRING
	HRLI T2,(POINT 7,0,35)	;FORM POINTER TO STRUCTURE NAME
	MOVEI T3,MAXLC+1	;COUNT IS MAX # OF CHARS IN NAME + ":"
RCD020:	ILDB T4,T2		;GET NEXT CHARACTER IN USER'S STRING
	IDPB T4,T1		;COPY IT TO THE STACK
	CAIE T4,.CHDEV		;WAS THIS A COLON?
	CAIN T4,.CHNUL		;NO. NULL?
	SKIPA			;COLON OR NULL
	SOJG T3,RCD020		;NEITHER. MAXIMUM CHARACTERS READ?

;DEVICE FIELD HAS BEEN COPIED. IF A COLON WAS NOT DETECTED, IT IS
;NOT A VALID DEVICE FIELD.

	CAIE T4,.CHDEV		;YES. ENDED WITH COLON?
	JRST [	TXNE Q2,RC%EMO	;NO. EXACT MATCH ONLY?
		RETBAD (RCDIX3)	;YES. INVALID STRUCTURE NAME
		MOVX Q1,RC%AMB	;NO. INDICATE AMBIGUOUS STRUCTURE NAME
		UMOVEM Q1,1	;TELL THE USER
		RETSKP]		;INDICATE SUCCESS
	SETZ T4,		;FOUND COLON. MAKE IT END WITH NULL
	DPB T4,T1		; FOR CHKLND
	MOVEM T2,RCDDPT		;SAVE POINTER TO BEGINNING OF DIRECTORY NAME
	;..
	;..

;DEVICE FIELD MAY CONTAIN LOGICAL NAME.  IF SO, GET THE DEVICE AND
;DIRECTORY SPECIFIED BY THE LOGICAL NAME.

	MOVEI T1,MAXLW+1	;SET UP LENGTH OF BLOCK CONTAINING DEVICE FIELD
	MOVEM T1,RCDSTR		;SAVE IT FOR CHKLND
	MOVEI T1,RCDSTR		;T1/LOCATION OF BLOCK WHERE DEVICE FIELD IS
	SETOM T2		;T2/WANT DIRECTORY STRING AS WELL AS DEVICE
	CALL CHKLND		;IF DEVICE FIELD IS LOGICAL NAME, CONVERT TO
				; DEVICE AND DIRECTORY
	MOVEM T2,RCDLND		;SAVE POINTER TO DIRECTORY NAME

;T2 POINTS TO LAST DEVICE FIELD IN CHAIN OF LOGICAL NAME DEFINITIONS
;SEE IF THIS IS REALLY A STRUCTURE AND GET ITS UNIQUE CODE

	CALL STDEVP		;SEE IF DEVICE FIELD IS A KNOWN DEVICE
	 JRST RCSNM		;STRUCTURE NOT UP
	HLRZ T2,T1		;GET LH OF DEVICE DESIGNATOR
	CAIE T2,.DVDES+.DVDSK	;IS IT A DISK?
	RETBAD (STRX01)		;NO. RETURN "STRUCTURE IS NOT MOUNTED"
	HRRZ T2,T1		;GET STRUCTURE UNIQUE CODE
	CAIN T2,-1		;IS THIS "DSK"?
	JRST [ LOAD T1,JSUC	;YES, GET CONNECTED STR UNIQUE CODE
		JRST RCD040]
	LDB T2,[POINT STRNS,T1,35] ;GET STRUCTURE INDEX
	MOVE T2,STRTAB(T2)	;GET SDB ADDRESS
	LOAD T2,STRJB,(T2)	;GET FORK INIT'ING STRUCTURE
	SKIPE T2		;SKIP IF NOT BEING INIT'ED
	 JRST [	CAMN T2,FORKX	;Are we the fork doing it?
		JRST .+1	;Yes, so that's ok
		MOVEI T1,STDVX1	;No, say "No such device",
		JRST RCSNM]	;STRUCTURE NOT UP
RCD040:	HRRZM T1,RCDUC		;SAVE UNIQUE CODE FOR STRUCTURE
	;..
;HERE TO PROCESS DIRECTORY STRING.  IF NONE WAS INPUT, AND A LOGICAL NAME
;WAS INPUT, USE THE LOGICAL NAME DEFINITION. IF NOT, ASSUME CONNECTED
;DIRECTORY.
	;..

RCD050:	ILDB T1,RCDDPT		;GET FIRST CHARACTER OF DIRECTORY STRING
	JUMPE T1,RCD060		;IS THERE A STRING?

;A DIRECTORY STRING WAS INPUT BY THE USER

	CALL GETDIR		;YES. CONVERT TO DIRECTORY NUMBER
	 RETBAD			;FAILED. ERROR CODE IS IN T1
	JRST RCD500		;GO CLEAN UP

;STRUCTURE NOT MOUNTED.  SAY "NO MATCH", BUT GO ON, TO MAKE SURE
;SYNTAX OF DIRECTORY NAME IS CORRECT.

RCSNM:	TXO Q1,RC%NOM		;MARK THAT THERE'S NO MATCH
	JRST RCD050		;PROCEED AND CHECK DIRECTORY NAME SYNTAX

;NO STRING WAS INPUT.  SEE IF THERE IS A LOGICAL NAME DEFINITION

;**;[2922]Replace 5 lines at RCD060: +0L	RWW	3-Mar-83
RCD060:	SKIPN T1,RCDLND		;[]NO. WAS ANYTHING FOUND?
	JRST RCD080		;NO.

;A LOGICAL NAME DEFINITION WAS FOUND.  CONVERT TO DIRECTORY NUMBER

	TQO <NREC>		;DIRECTORY WAS FOUND IN LOGICAL NAME. INDICATE
				; RECOGNITION NOT ALLOWED FOR DIRLUK
;**;[2922]Replace 8 lines at RCD060: +8L	RWW	3-Mar-83
	HRRZ	T3,RCDLND	;[2922]get address of logical name string block
	AOS	T3		;[2922]make it start at beginning of text
	HRLI	T3,440700	;[2922]make it a byte pointer
	HRRZ	T4,RCDDPT	;[2922]get address of directory name block
	HRLI	T4,440700	;[2922]make it a byte pointer
	MOVEM	T4,RCDDPT	;[2922]save it
	MOVEI	T1,.CHDI1	;[2922]get opening bracket
	IDPB	T1,T4		;[2922]write it to first byte
RCD062:	ILDB	T1,T3		;[2922]get byte from logical name
	JUMPE	T1,RCD064	;[2922]if end, clean up
	IDPB	T1,T4		;[2922]copy it to directory name
	JRST	RCD062		;[2922]go do next byte
RCD064:	MOVEI	T1,.CHDT1	;[2922]end of logical name, get closing bracket
	IDPB	T1,T4		;[2922]append it to end
	MOVEI	T1,.CHNUL	;[2922]get a nul
	IDPB	T1,T4		;[2922]make sure we have an ASCIZ string
	JRST	RCD050		;[2922]go try again.


;NO DIRECTORY WAS SPECIFIED.  FIND OUT WHAT DIRECTORY THE USER IS
;CONNECTED TO AND USE ITS NAME

RCD080:	TXO Q2,RC%EMO		;DON'T ALLOW RECOGNITION SINCE DIRST WILL CREATE
				; THE STRING
	CALL GTCSCD		;GET CONNECTED STRUCTURE UNIQUE CODE,,DIRECTORY
	MOVE T2,T1		;T2/(STRUCTURE UNIQUE CODE,,DIRECTORY)
	HRRO T1,RCDBLK		;T1/POINTER TO WHERE STRING IS TO BE WRITTEN
	AOS T1			;POINT BEYOND HEADER
	DIRST			;GET STRUCTURE AND DIRECTORY
	 RETBAD (RCDIX2)	;RETURN "INVALID DIRECTORY SPECIFICATION"
	MOVE T2,RCDBLK		;POINT TO START OF STRING
	HRLI T2,(POINT 7,0,35)
RCD051:	ILDB T1,T2		;GET THE NEXT CHARACTER
	CAIE T1,.CHDEV		;IS IT A DEVICE TERMINATOR?
	JRST RCD051		;NO. KEEP LOOKING
	MOVEM T2,RCDDPT		;YES. SAVE POINTER TO THIS CHARACTER
	ILDB T1,RCDDPT		;GET OPENING BRACKET OF DIRECTORY STRING
	CALL GETDIR		;CONVERT DIRECTORY NAME TO NUMBER
	 RETBAD			;FAILED. ERROR CODE IS IN AC 1
	JRST RCD500		;GO CLEAN UP
;HERE WHEN ENTIRE STRING HAS BEEN PARSED. Q1 CONTAINS FLAGS INDICATING
;RESULTS. RCDUC HAS STRUCTURE NUMBER; RCNUM HAS DIRECTORY NUMBER

RCD500:
	JUMPN Q1,RCD550		;IF NO MATCH OF AMBIGUOUS, GO RETURN VALUES
	HRRZ T1,RCDUC		;GET STRUCTURE NUMBER
	HRLM T1,RCDNUM		;SAVE UNIQUE PART OF DIRECTORY DESIGNATOR

; RETURN VALUES TO THE USER

RCD550:	TXNE Q1,RC%NOM!RC%AMB!RC%NMD ;IF NO MATCH, AMBIG, OR NO MORE DIR
	JRST RCD600		;DONT ATTEMPT MAPPING DIR
	TXNE Q1,RC%WLD		;WAS WILDCARD FOUND?
	JRST RCD555		;YES - DIR ALREADY MAPPED
	MOVE T1,RCDNUM		;GET DIRECTORY NUMBER
	CALL SETDIR		;MAP DIRECTORY
	 RETBAD ()		;FAILED, PASS ERROR UP
RCD555:	MOVE T4,DIRORA		;GET BASE ADDRESS OF DIRECTORY
	LOAD T1,DRMOD,(T4)	;GET MODE BITS
	TXZ T1,RC%NOM!RC%AMB!RC%NMD!RC%WLD	;DON'T SET THESE FROM T1
	TXO T1,MD%SA		;ALWAYS ALLOW STRING ACCOUNTS
	IOR Q1,T1		;ADD MODE BITS TO FLAG WORD
	CALL USTDIR		;UNLOCK DIRECTORY
RCD600:	UMOVEM Q1,1		;RETURN FLAGS GIVING RESULT OF LOOKUP
	MOVE T1,RCDNUM		;GET DIRECTORY NUMBER
	TXNN Q1,RC%NOM!RC%AMB	;NO MATCH OR AMBIGUOUS ?
	UMOVEM T1,3		;NO, SUCCESS, SO RETURN DIRECTORY NUMBER
	RETSKP			;RETURN TO USER
;RCDCLN - ROUTINE TO CLEAN UP AFTER RCDIR

;	CALL RCDCLN

;RETURNS +1: ALWAYS

RCDCLN:	SKIPN T2,RCDBLK		;DO WE HAVE A BLOCK FOR USER'S ORIGNAL STRING?
	JRST RCDCL1		;NO. NO NEED TO RELEASE IT
	MOVEI T1,JSBFRE		;YES. T1/ INDICATES JSB FREE SPACE
	CALL RELFRE		;RELEASE THE BLOCK
	OKINT

RCDCL1:	SKIPN T2,RCDBK2		;DO WE HAVE A BLOCK FOR DIRECTORY STRING?
	JRST RCDCL2		;NO. NO NEED TO RELEASE IT
	MOVEI T1,JSBFRE		;YES. T1/ INDICATES JSB FREE SPACE
	CALL RELFRE		;RELEASE THE BLOCK
	OKINT

RCDCL2:	SKIPN T2,RCDLND		;DID CHKLND RETURN A BLOCK FOR DIRECTORY STRING?
	RET			;NO. NO NEED TO RELEASE IT
	CAMN T2,[-1]		;DID CHKLND FIND A STAR?
	RET			;YES. NO BLOCK TO RELEASE
	MOVEI T1,JSBFRE		;YES. T1/ INDICATES JSB FREE SPACE
	CALL RELFRE		;RELEASE THE BLOCK
	OKINT
	RET
;GETDIR - GET THE DIRECTORY NUMBER

;ACCEPTS:
;	T1/FIRST CHARACTER IN DIRECTORY STRING
;	Q2/USER'S FLAGS

;	CALL GETDIR

;RETURNS +1: FAILURE
;		1/ERROR CODE
; 	 +2: SUCCESS
;		DIRECTORY NUMBER IN RCDNUM
;		RECOGNIZED STRING COPIED BACK TO USER

GETDIR:	CAIE T1,.CHDI1		;DOES THE DIRECTORY STRING BEGIN WITH
	CAIN T1,.CHDI2		;  VALID DIRECTORY PUNCTUATION ?
	SKIPA			;YES, SAVE INITIAL CHARACTER
	RETBAD (RCDIX2)	;NO, RETURN "INVALID DIRECTORY" SPEC"
	MOVEM T1,RCDIDP		;SAVE THE INITIAL DIRECTORY PUNCTUATION
	MOVEI T4,.CHDT1		;GET TYPE 1 TERMINATOR
	CAIE T1,.CHDI1		;WAS THIS A TYPE 1 OPENER?
	MOVEI T4,.CHDT2		;NO. GET TYPE 2 TERMINATOR
	HRLM T4,RCDIDP		;SAVE EXPECTED TERMINATOR

; ISOLATE THE DIRECTORY NAME STRING

	MOVEI T2,MAXLW+2	;GET NUMBER OF WORDS NEEDED FOR STRING
	NOINT			;NOINT WHILE JSB SPACE IS ASSIGNED
	CALL ASGJFR		;ASSIGN JSB FREE SPACE
	 RETBAD (RCDIX1,<OKINT>);RETURN "INSUFFICIENT RESOURCES"
	MOVEM T1,RCDBK2		;SAVE LOOKUP POINTER TO TEMPORARY BLOCK
	HRLI T1,(POINT 7,0,35)	;POINT BEYOND HEADER
	MOVE T2,RCDDPT		;GET POINTER TO DIRECTORY WITHIN USER STRING
	MOVEI T3,MAXLC+1	;MAX # OF CHARS IN DIRECTORY NAME + TERMINATOR

;COPY EACH CHARACTER STARTING WITH THE LEFT BRACKET UP TO INCLUDING
;EITHER A NULL OR MATCHING RIGHT BRACKET OR UNTIL THE MAXIMUM NUMBER
;OF CHARACTERS IS READ

GETD05:	ILDB T4,T2		;GET NEXT CHARACTER
	MOVEM T1,RCDTPT		;SAVE POINTER TO END OF STRING FOR DIRLUK
				; (LDB WOULD GET THE LAST CHARACTER COPIED)
	IDPB T4,T1		;COPY IT TO FREE SPACE
	CAIE T4,.CHWL1		;WILDCARD?
	CAIN T4,.CHWL2		; ???
	TXO Q1,RC%WLD		;YES - REMEMBER ONE SEEN
	MOVEM T3,GETDT3		;SAVE T3
	HLRZ T3,RCDIDP		;GET EXPECTED TERMINATING BRACKET
	CAMN T4,T3		;IS THE CURRENT CHARACTER A BRACKET?
	JRST [	TXO Q2,RC%EMO	;YES. DON'T ALLOW RECOGNITION
		JRST GETD07]	; AND DON'T LOOK AT MORE CHARACTERS
	CAIN T4,.CHNUL		;NO. IS IT A NULL?
	JRST GETD07		;BRACKET OR NULL. STOP COPYING
	MOVE T3,GETDT3		;RESTORE COUNTER
	SOJGE T3,GETD05		;END OF SPACE?

;END OF STRING. IF LAST CHARACTER WAS BRACKET, IT MUST BE FOLLOWED
;BY NULL. IF NOT, MUST BE DOING RECOGNITION. OTHERWISE ERROR.
;NOTE THAT IF THE STRING ENDS IN NULL, AND THE LAST NON-NULL IS
;THE WRONG KIND OF BRACKET, THE ENTIRE STRING INCLUDING THE BRACKET
;WILL BE PASSED TO DIRLUK, WHICH WILL RETURN NO-MATCH

GETD07:	TXNN Q1,RC%WLD		;WILDCARD FOUND?
	JRST GETD09		;NO
	TXO Q2,RC%EMO		;YES - ACT LIKE EXACT MATCH ONLY
	TXNN Q2,RC%AWL		;WILDCARD ALLOWED?
	RETBAD (RCDIX2)		;NO - ERROR
GETD09:	MOVE T3,RCDBK2		;GET POINTER TO STRING BLOCK
	SKIPN 1(T3)		;IS THE STRING NULL?
	JRST [	SETO T1,	;YES, THE STRING IS AMBIGUOUS
		JRST GETD21]
	HLRZ T3,RCDIDP		;GET EXPECTED TERMINATING BRACKET
	CAME T3,T4		;DIRECTORY TERMINATED BY EXPECTED BRACKET ?
	JRST [	TXNN Q2,RC%EMO	;NO. DOING RECOGNITION?
		JRST GETD10	;YES, CONTINUE
		RETBAD (RCDIX2)]	;NO. RETURN "INVALID DIRECTORY" ERROR
	ILDB T4,T2		;YES. GET THE NEXT CHARACTER
	CAIE T4,.CHNUL		;IS IT A NULL?
	RETBAD (RCDIX2)		;NO. MUST BE AN ASCIZ STRING
	DPB T4,T1		;REPLACE BRACKET BY NULL SO THAT
				; DIRLUK WILL SUCCEED
	;..
; FORM STANDARD LOOKUP POINTER AS EXPECTED BY DIRLUK: -<NWORDS-1>,,ADR-1

	;..
GETD10:	TXNE Q1,RC%NOM		;HAVE WE ALREADY DECIDED THERE'S "NO MATCH"?
	 RETSKP			;YES, SO DON'T BOTHER LOOKING UP DIRECTORY
	MOVE T2,RCDBK2		;POINT TO BLOCK CONTAINING STRING
	SUB T1,T2		;COMPUTE NUMBER OF WORDS WRITTEN
	SOS T1			;NUMBER -1
	MOVNS T1		;-<NWORDS-1>
	HRLM T1,RCDBK2		;FINISH THE LOOKUP POINTER

; SET UP FOR RECOGNITION AND SEE IF RECOGNITION WAS REQUESTED

	TQZ <NREC>		;ASSUME RECOGNITION WANTED
	TXNN Q2,RC%EMO		;EXACT MATCH OLY ?
	JRST GETD20		;NO, GO DO RECOGNITION
	TQO <NREC>		;YES, INDICATE NO RECOGNITION
	TXNN Q2,RC%STP		;STEPPING DIRECTORY?
	TXNE Q1,RC%WLD		;WILDCARD?
	JRST GETD25		;YES - GO PROCESS

; GET DIRECTORY NUMBER, RECOGNIZING IF NECESSARY

GETD20:	MOVE T1,RCDBK2		;GET ADDRESS OF BLOCK HOLDING DIRECTORY STRING
	HRRZ T2,RCDUC		;GET STRUCTURE UNIQUE NUMBER
	MOVE T3,RCDTPT		;GET POINTER TO TAIL OF STRING
	CALL DIRLUK		;LOOKUP DIRECTORY
GETD21:	 JRST [	MOVX Q1,RC%NOM	;FAILED, ASSUME NO MATCH AT ALL
		SKIPN T1	;NO MATCH OR AMBIGUOUS ?
		RETSKP		;NO MATCH. RETURN SUCCESS WITH Q1 SET
		MOVX Q1,RC%AMB	;AMBIGUOUS
		TXNN Q2,RC%PAR	;IS PARTIAL RECOGNITION ALLOWED?
		RETSKP		;NO. RETURN SUCCESS (Q1 INDICATES ERROR)
		JRST GETD30]	;YES. GO UPDATE USER'S STRING
	MOVEM T1,RCDNUM		;SAVE DIRECTORY NUMBER

; REASSEMBLE STRING IF RECOGNITION WAS DONE

GETD30:	TXNE Q2,RC%EMO		;EXACT MATCH ONLY DESIRED ?
	JRST GETD40		;YES. DON'T UPDATE THE STRING
	MOVE T1,RCDDPT		;GET POINTER TO DIRECTORY IN RCDBLK
	MOVE T2,RCDBK2		;GET ADDRESS OF TEMPORARY BLOCK
	HRROI T2,1(T2)		;FORM POINTER TO NAME AS FINISHED BY DIRLUK
	SETZM T3		;COPY UNTIL A NULL IS ENCOUNTERED
	SOUT			;APPEND DIRECTORY BACK TO USER'S STRING
	 ERJMP [RETBAD (RCDIX4)] ;ERROR, RETURN "INTERNAL ERROR"
	TXNN Q1,RC%AMB		;AMBIGUOUS?
	JRST [	HLRZ T4,RCDIDP	;NO. GET CLOSING BRACKET FOR DIRECTORY STRING
		IDPB T4,T1	;TERMINATE DIRECTORY
		JRST .+1]
	MOVEI T4,.CHNUL		;GET A NULL
	IDPB T4,T1		;FORM ASCIZ STRING
	JRST GETD40
;HERE IF A WILDCARD MASK WAS INPUT OR IF STEPPING

GETD25:	HRLZ T1,RCDUC		;GET STRUCTURE UNIQUE CODE
	TXNE Q2,RC%STP		;STEPPING?
	UMOVE T1,3		;YES - GET USERS DIR
	HLRZ T2,T1		;CHECK UNIQUE CODE
	CAME T2,RCDUC		;SAME?
	RETBAD (RCDIX2)		;NO. RETURN "INVALID DIRECTORY SPEC"
GETD26:	MOVEI F1,0		;CLEAR FLAGS
	TQO <STEPF,DIRSF>	;SET STEP FLAGS
	HRRZ T3,RCDBK2		;GET ADR OF WILD MASK BLOCK
	CALL MDDDIR		;STEP DIR
	 JRST GETD28		;ERROR
	 JRST GETD28
	MOVEM T1,RCDNUM		;SAVE DIRNUM
	MOVE T4,DIRORA		;GET DIR NAME STRING
	LOAD T4,DRNAM,(T4)	; ...
	ADD T4,DIRORA		;AS ABSOLUTE ADDRESS
	MOVSI T1,(<POINT 7,0(T4),35>)	;BUILD BYTE POINTER
	HRRZ T2,RCDBK2		;GET POINTER TO WILD MASK
	CALL CHKWLD		;CHECK FOR MATCH
	 SKIPA			;NO MATCH
	JRST GETD40		;MATCH - RETURN THIS DIR
	CALL USTDIR		;UNLOCK THIS DIR
	MOVE T1,RCDNUM		;NO MATCH - STEP THIS DIR
	JRST GETD26		; ...

GETD28:	CAIE T1,GJFX32		;NO MORE DIRS?
	RETBAD (RCDIX2)		;NO. RETURN "INVALID DIRECTORY SPEC"
;**;[1909] Add 2 lines at GETD28:+2L	JRG	16-JUL-81
	TXNN Q2,RC%STP		;[1909] YES, ARE WE STEPPING?
	TXOA Q1,RC%NOM		;[1909] NO, SET NO MATCH
;**;[1909] Change 1 line at GETD28:+2L	JRG	16-JUL-81
	TXO Q1,RC%NMD		;[1909] YES, SET NO MORE DIRECTORIES IN GROUP
	SETZB T1,RCDNUM		;RETURN 0
	;..
	;..
; COPY COMPLETED STRING TO USER SPACE IF DOING RECOGNITION

GETD40:	TXNE Q2,RC%EMO		;EXACT MATCH ONLY?
	RETSKP			;YES. DON'T COPY BACK TO USER
	MOVE T1,RCDUPT		;GET ORIGINAL POINTER IN USER SPACE
	MOVE T2,RCDBLK		;GET LOOKUP POINTER TO BLOCK
	CALL CPYTUS		;COPY STRING BACK TO USER
	RETSKP
;RCNUM - GET STRUCTURE,,DIRECTORY NUMBER FROM DIRECTORY OR USER NUMBER

;ACCEPTS:
;	T1/(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
;		OR
;	   (USRLH,,DIRECTORY NUMBER)

;	CALL RCNUM

;RETURNS +1: ALWAYS,
;	T1/(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)

;THIS ROUTINE DETECTS WHETHER THE INPUT IS A DIRECTORY NUMBER OR USER
;NUMBER.  IF A DIRECTORY NUMBER, IT RETURNS IT INTACT.  IF A USER NUMBER,
;IT RETURNS THE DIRECTORY NUMBER ON PS. RCDIR WILL CHECK THE VALIDITY OF THE
;DIRECTORY NUMBER LATER BY CALLING SETDIR

RCNUM:
	HLRZ T2,T1		;GET THE LEFT HALF
	CAIE T2,USRLH		;IS IT A USER NUMBER?
	RET			;NO. A DIRECTORY NUMBER
	MOVEI T2,PSNUM		;GET NUMBER OF PUBLIC STRUCTURE
	MOVE T2,STRTAB(T2)	;POINT TO START OF SDB FOR PUBLIC STRUCTURE
	LOAD T2,STRUC,(T2)	;GET UNIQUE CODE FOR PUBLIC STRUCTURE
	HRL T1,T2		;USE IT IN THE DIRECTORY NUMBER
	RET
;RCJFN - GET (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER) FROM JFN

;ACCEPTS:
;	T1/JFN

;	CALL RCJFN

;RETURNS +1: FAILURE
;	 +2: SUCCESS,
;	T1/(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)

RCJFN:
	MOVE JFN,T1		;JFN/THE JFN
	CALL DSKJFN		;SEE IF VALID JFN, LOCK JFN AND STRUCTURE
	 RETBAD			;INVALID
	LOAD T1,FILUC,(JFN)	;GET STRUCTURE UNIQUE CODE
	HRLZS T1		;PUT IN LH
	HRR T1,FILDDN(JFN)	;GET DIRECTORY NUMBER
	CALL UNLCKF		;UNLOCK THE JFN AND STRUCTURE
	RETSKP
;RCUSR - RECOGNIZE USER NAME

;ACCEPTS:
;	T1/ FLAGS
;	T2/ POINTER TO USER NAME

;	RCUSR

;RETURNS +1: ALWAYS
;		T1/ FLAGS
;		T2/ UPDATED POINTER
;		T3/ USER NUMBER

;INPUT FLAGS:
;	RC%PAR (1B14) - PARTIAL RECOGNITION IS ALLOWED
;	RC%STP (1B15) - STEP TO THE NEXT USER NUMBER
;	RC%AWL (1B16) - ALLOW WILD CARDS
;	RC%EMO (1B17) - EXACT MATCH ONLY (NO RECOGNITION)

;OUTPUT FLAGS:
;	RC%ANA (1B1) - ALPHANUMERIC ACCOUNTS ALLOWED
;	RC%RLM (1B2) - REPEAT MESSAGE OF THE DAY
;	RC%NOM (1B3) - NO MATCH
;	RC%AMB (1B4) - AMBIGUOUS
;	RC%NMD (1B5) - NO MORE DIRECTORIES

;CAN ITRAP ON MONITOR ERROR

.RCUSR::MCENT			;MONITOR CONTEXT ENTRY
	TRVAR <RCUBLK,RCUNUM,RCUUPT,RCUTPT,RCUMOD>
	CALL RCUS0		;CALL ROUTINE TO DO THE WORK
	 JRST [	MOVEM T1,Q1	;FAILED. SAVE ERROR CODE
		CALL RCUCLN	;RELEASE FREE SPACE IF NECESSARY
		MOVE T1,Q1	;RESTORE ERROR CODE
		ITERR]
	CALL RCUCLN		;RELEASE FREE SPACE IF NECESSARY
	JRST MRETN		;SUCCEEDED. TAKE NON-SKIP RETURN
;RCUS0 - ROUTINE TO DO RCUSR'S WORK.  ARGUMENTS ARE THE SAME AS
;FOR RCUSR

RCUS0:	UMOVE Q2,1		;Q2/USER'S FLAGS
	SETZ Q1,		;INITIALIZE RETURN FLAGS
	SETZM RCUBLK		;INDICATE NO FREE SPACE YET

; COPY NAME STRING FROM USER SPACE, AND STORE IT IN JSB FREE SPACE

	UMOVE T1,2		;GET POINTER TO NAME STRING
	MOVEM T1,RCUUPT		;SAVE IT FOR COPYING TO LATER
	CALL CPYFUS		;GO NOINT AND COPY STRING FROM USER SPACE
	 RETBAD (RCUSX1)	;FAILED, INSUFFICIENT RESOURCES
	UMOVEM T3,2		;RETURN UPDATED POINTER TO USER
	MOVEM T1,RCUBLK		;SAVE LOOKUP POINTER TO BLOCK
	MOVEM T2,RCUTPT		;SAVE POINTER TO END OF STRING
	MOVEI T2,STKCD1		;CODE FOR STRINGS
	CALL JSBSTK		;SAVE ADDRESS OF STRING ON JSB STACK
	OKINT			;INTERRUPTS ALLOWED NOW
	MOVE T1,RCUBLK		;RESTORE AC'S
	MOVE T2,RCUTPT		;THAT WERE TRASHED

;PARSE THE STRING LOOKING FOR WILD CARD CHARACTERS

	HRLI T1,(POINT 7,0,35)	;POINT BEYOND HEADER WORD
	MOVEI T3,MAXLC		;MAXIMUM ALLOWED CHARACTERS
RCU030:	ILDB T2,T1		;GET NEXT CHARACTER
	CAIE T2,.CHWL1		;WILD CARD?
	CAIN T2,.CHWL2
	TXO Q1,RC%WLD		;YES. INDICATE WILD CARD FOUND
	CAIN T2,.CHNUL		;NULL?
	JRST RCU050		;YES. END OF STRING
	SOJGE T3,RCU030		;GO GET NEXT CHARACTER UNLESS REACHED MAX

;HERE WHEN STRING HAS BEEN PARSED.  Q1 HAS RC%WLD SET IF A WILD
;CARD WAS FOUND

RCU050:	TXNN Q1,RC%WLD		;WILD CARD FOUND?
;**;[1985] Add 2 lines at RCU050: +1L	JGZ	21-FEB-82
	TXNE Q2,RC%STP		;[1985] OR STEPPING NAME?
	 SKIPA			;[1985]  YES
	JRST RCU070		;NO. GO LOOK UP USER NAME
	TXO Q2,RC%EMO		;YES. FORCE EXACT MATCH
	TXNN Q2,RC%AWL		;ARE WILD CARDS ALLOWED?
	RETBAD (STRX08)		;RETURN ERROR

;USER NAME IS A DIRECTORY ON PS.  GET DIRECTORY NUMBER ON THAT STRUCTURE

RCU070:	MOVEI T1,PSNUM		;GET STRTAB OFFSET FOR PUBLIC STRUCTURE
	CALL STRCNV		;CONVERT TO UNIQUE CODE
	 RETBAD (RCDIX4)	;RETURN 'INTERNAL ERROR'
	TXNN Q2,RC%EMO		;EXACT MATCH?
	TQZA <NREC>		;NO. ALLOW RECOGNITION
	JRST [	TXNN Q2,RC%STP	;YES. STEPPING TO NEXT USER?
		TXNE Q1,RC%WLD	; OR FOUND A WILD CARD?
		JRST RCU110	;YES. GO PROCESS IT
		TQO <NREC>	;NO. INDICATE NO RECOGNITION
		JRST .+1]

;NO WILD CARD WAS FOUND. CALL DIRLUK TO FIND DIRECTORY CORRESPONDING
;TO GIVEN USER NAME

	MOVE T2,T1		;2/UNIQUE CODE FOR PS:
	MOVE T1,RCUBLK		;1/POINTER TO USER NAME
	MOVE T3,RCUTPT		;3/POINTER TO END OF STRING
	CALL DIRLUK		;CONVERT DIRECTORY NAME TO NUMBER ON PS
	 JRST [	MOVX Q1,RC%NOM	;INITIALLY ASSUME NO MATCH
		SKIPN T1	;AMBIGUOUS?
		JRST RCU210	;NO. RETURN NO MATCH
		MOVX Q1,RC%AMB	;YES. RETURN THAT BIT INSTEAD
		TXNN Q2,RC%PAR	;IS USER ALLOWING PARTIAL RECOGNITION
		JRST RCU210	;NO. DON'T COPY THE STRING
		JRST RCU090]	;YES. GO COPY THE STRING
	HRLI T1,USRLH		;PUT THE REQUIRED CODE IN THE LH FOR A USER NAME
	MOVEM T1,RCUNUM		;SAVE IT FOR LATER

;IF USER WANTED RECOGNITION, COPY COMPLETED STRING BACK TO USER

RCU090:	TXNE Q2,RC%EMO		;EXACT MATCH ONLY?
	JRST RCU170		;YES. DON'T COPY THE STRING BACK TO THE USER
	MOVE T1,RCUUPT		;T1/USER'S ORIGINAL BYTE POINTER
	MOVE T2,RCUBLK		;T2/LOOKUP POINTER TO STRING
	CALL CPYTUS		;COPY BACK THE STRING AS UPDATED BY DIRLUK
				; AND UPDATE USER'S BYTE POINTER
	JRST RCU170		;GO FINISH

;A WILD CARD WAS FOUND OR STEPPING USER NAME.
;GET STARTING DIRECTORY NUMBER FROM USER.
;CALL MDDDIR TO GET NEXT DIRECTORY, CHKWLD TO SEE IF USER'S STRING
;MATCHES THE DIRECTORY.  IF NOT, CALL MDDDIR AGAIN.  CONTINUE UNTIL
;EITHER A MATCH OCCURS OR MDDDIR RETURNS FAILURE.

RCU110:	HRLZS T1		;IF NOT STEPPING, T1/(PS UNIQUE CODE,,0)
	TXNE Q2,RC%STP		;STEPPING?
	JRST [	UMOVE T1,3	;YES. GET STARTING USER NUMBER
		HLRZ T2,T1	;GET LEFT HALF
		CAIE T2,USRLH	;IS IT A VALID USER NUMBER?
		RETBAD (STRX07)	;NO. RETURN ERROR
		CALL CNVDIR	;CONVERT TO DIRECTORY NUMBER
		JRST .+1]

;GET THE NEXT DIRECTORY AND SEE IF IT MATCHES

RCU130:	MOVEI F1,0		;INITIALIZE FLAGS FOR MDDDIR
	TQO <STEPF,DIRSF>	;INDICATE STEPPING, STEPPING DIRECTORY
;**;[1927] Change 1909 lines at RCU130: +2L	JGZ	21-AUG-81
;**;[1909] Add 1 line at RCU130:+2L	JRG	16-JUL-81
	MOVEI T2,.RCUSR		;[1909] T2/ TELL WHERE WE'RE CALLING FROM
	HRRZ T3,RCUBLK		;T3/ ADDRESS OF BLOCK CONTAINING NAME
	CALL MDDDIR		;GET THE NEXT DIRECTORY
	 JRST RCU150
	 JRST RCU150
	MOVEM T1,RCUNUM		;SAVE DIRECTORY NUMBER
	MOVE T4,DIRORA		;SET UP BYTE POINTER TO NAME STRING
	LOAD T4,DRNAM,(T4)	; IN THE DIRECTORY THAT MDDDIR RETURNED
	ADD T4,DIRORA		; MAPPED
	MOVSI T1,(<POINT 7,0(T4),35>)	;T1/ BYTE POINTER TO NAME STRING
	HRRZ T2,RCUBLK		;T2/ ADDRESS OF USER'S STRING
	CALL CHKWLD		;DOES IT MATCH?
	 SKIPA			;NO
	JRST [	MOVE T2,DIRORA	;YES. THIS IS A USER NAME ONLY
		LOAD T2,DRMOD,(T2) ; IF THE DIRECTORY IS NOT FILES-ONLY
		TXNE T2,MD%FO	;IS IT?
		JRST .+1	;FILES-ONLY. GO GET ANOTHER DIRECTORY
		MOVE T1,RCUNUM	;GET THE DIRECTORY NUMBER
		HRLI T1,USRLH	;CONVERT IT TO A USER NUMBER
		MOVEM T1,RCUNUM	; TO RETURN TO THE USER
		JRST RCU170]
	CALL USTDIR		;UNMAP THIS DIRECTORY
	MOVE T1,RCUNUM		;RESTORE DIRECTORY NUMBER FOR MDDDIR
	JRST RCU130

;HERE WHEN MDDDIR FAILS. IF NO MORE DIRECTORIES, RETURN SUCCESS
;SETTING RC%NMD.  IF NOT, RETURN FAILURE.

RCU150:	CAIE T1,GJFX32		;NO MORE DIRECTORIES?
	RETBAD (RCDIX2)		;NO. TAKE ITERR RETURN
;**;[1909] Add 2 lines at RCU150:+2L	JRG	16-JUL-81
	TXNN Q2,RC%STP		;[1909] YES, ARE WE STEPPING?
	TXOA Q1,RC%NOM		;[1909] NO, SET NO MATCH
;**;[1909] Change 1 line at RCU150:+2L	JRG	16-JUL-81
	TXO Q1,RC%NMD		;[1909] YES, SET NO MORE USERS IN GROUP
	SETZM RCUNUM		;INDICATE NO DIRECTORY TO RETURN

;MAP DIRECTORY AND GET MODE BITS

RCU170:	TXNE Q1,RC%NOM!RC%AMB!RC%NMD ;ANY ERRORS?
	JRST RCU210		;YES. DON'T MAP DIRECTORY
	TXNE Q1,RC%WLD		;WILD CARD FOUND?
	JRST RCU190		;YES. DIRECTORY ALREADY MAPPED
	MOVE T1,RCUNUM		;T1/USER NUMBER
	CALL CNVDIR		;CONVERT TO DIRECTORY NUMBER ON PS
	CALL SETDIR		;MAP THE USER'S DIRECTORY FROM PS AND GO NOINT
	 JRST RCU210		;FAILED. DON'T LOOK AT MODE BITS

;DIRECTORY IS MAPPED. GET MODE BITS

RCU190:	MOVE T4,DIRORA		;GET START OF DIRECTORY
	LOAD T1,DRMOD,(T4)	;GET MODE BITS
	TXZ T1,RC%NOM!RC%AMB!RC%NMD!RC%WLD	;DON'T SET THESE FROM T1
	TXO T1,MD%SA		;ALWAYS ALLOW STRING ACCOUNTS
	IOR Q1,T1		;ADD IT TO BITS
	TXNE T1,MD%FO		;IS IT FILES-ONLY?
	MOVX Q1,RC%NOM		;YES. INDICATE NO MATCH
	CALL USTDIR		;UNLOCK THE DIRECTORY AND GO OKINT

RCU210:	UMOVEM Q1,1		;RETURN FLAGS
	MOVE T1,RCUNUM		;GET USER NUMBER
	TXNN Q1,RC%NOM!RC%AMB	;ERROR?
	UMOVEM T1,3		;NO. RETURN DIRECTORY NUMBER
	RETSKP			;TAKE SUCCESS RETURN

;RCUCLN - CLEAN UP FROM RCUSR

;	CALL RCUCLN

;RETURNS +1: ALWAYS

;RELEASES JSB FREE SPACE IF ANY IS ASSIGNED

RCUCLN:	SKIPN T2,RCUBLK		;GET ADDRESS OF BLOCK OBTAINED BY CPYFUS
	RET			;WASN'T ANY, DONE
	SETZM RCUBLK		;CLEAR IT
	MOVEI T1,JSBFRE		;SPACE WAS IN JSB FREE SPACE
	NOINT			;DISALLOW INTERRUPTS
	CALL RELFRS		;RETURN SPACE AND REMOVE JSB STACK ENTRY
	OKINT			;INTERRUPTS ALLOWED AGAIN
	RET			;DONE
; Read directory

.RDDIR::MCENT
	CALL CHKDEV
	 RETERR()
	MOVEI B,(DEV)
	CAIE B,DTADTB
	RETERR(RDDIX1)
	HLRZ A,DEV
	CALL DTAMCK		;CHECK FOR DIRECTORY IN CORE
	 RETERR(RDDIX1)		;FAILED, DRIVE PROBABLY OFF LINE
	HLRZ A,DEV
	HRRZ B,DTASTS(A)	;GET MONITOR BUFFER ADDRESS
	XMOVEI B,(B)		;MAKE IT CURRENT SECTION FOR BLT
	MOVEI T1,200		;200 WORDS TO MOVE
	UMOVE C,B		;GET USER ADDRESS
	CALL BLTMU1		;DO BLT
	SMRETN			;RETURN
; Read file byte size
; Call:	1	; Jfn
;	RFBSZ

.RFBSZ::MCENT
	MOVE JFN,1
	CALL CHKJFD
	 RETERR()
	 JFCL
	 RETERR(DESX4)
	TQNN <OPNF>
	RETERR(DESX5,<CALL UNLCKF>)
	LDB A,PBYTSZ
	UMOVEM A,2
	CALL UNLCKF
	SMRETN
; Read file byte number
; Call:	1	; Jfn
;	RFPTR
; Return
;	+1	; Error
; 	+2	; Success
;	2	; File byte number

.RFPTR::MCENT
	MOVE JFN,1
	CALL CHKJFD
	 RETERR()
	 JFCL
	 RETERR(DESX4)
	TQNN <OPNF>
	ERUNLK(DESX5)
	MOVE A,FILBYN(JFN)
	UMOVEM A,2
	CALL UNLCKF
	SMRETN
; READ FILE TIME AND DATE
; CALL:	1	;JFN
;	2	;ADDR
;	3	;COUNT
;	RFTAD
; RETURNS
;	+1	; ERROR, CODE IN 1
;	+2	; SUCCESS
; WITH:	1	; UNCHANGED
;	2	; UNCHANGED
; ADDR +0	;TIME AND DATE OF CREATION
; ADDR +1	;TIME AND DATE OF LAST WRITE
; ADDR +2	;TIME AND DATE OF LAST READ
; ADDR +3	;MONITOR LAST WRITE TIME AND DATE (PRIVILEGED)
;	FIRST "COUNT" LOCATIONS OF "ADDR" FILLED WITH DATES
;	ANY WORDS OF "ADDR" FOR WHICH NO DATE EXISTS ARE FILLED WITH -1

.RFTAD::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JFCL
	 JFCL
	UMOVE A,3		;GET COUNT
	JUMPE A,RFTAD1		;RETURN NOW IF 0 COUNT
	UMOVE Q3,2		;GET ADDR
	ADDI A,-1(Q3)		;CALC END ADDR
	MOVSI B,(Q3)
	HRRI B,1(Q3)		;MAKE BLT POINTER
	XCTU [SETOM (Q3)]	;INITIALIZE TABLE TO -1
	UMOVE Q1,3		;GET COUNT AGAIN FOR SUBR
	CAIE Q1,1		;DONE IF ONLY 1 WORD BUFFER
	XBLTUU [BLT B,(A)]	;FILL IT
	CALL @RFTADD(P3)	;CALL DEVICE DEPENDENT ROUTINE
	 ITERR(,<CALL UNLCKF>)	;ERROR
RFTAD1:	CALL UNLCKF
	MRETNG

;GLOBAL ROUTINE FOR NO DATES AVAILABLE
RFTADN::RETSKP
; Release jfn
; Call:	1	; Jfn
;	RLJFN
; Returns
;	+1	; Error
;	+2	; Success
; Cannot release jfn if being assigned unless this same process as
; Assigner, and not at interrupt level

.RLJFN::MCENT
	CAMN 1,[-1]		; Release all
	JRST RLALL		;YES
	HRRZ JFN,1
	CALL RLJF
	 RETERR()
	SMRETN

RLALL:	MOVX A,CZ%NCL!.FHSLF	;DON'T CLOSE, SELF AND INFERIORS
	CLZFF
	 ERJMP [MOVE A,LSTERR
	        RETERR()]	;GIVE USER LAST ERROR
	SMRETN

RLJF:	PUSH P,JFN
	HRRZS JFN
	CALL CHKJFD
	 JRST RLJF1		; Garbage jfn
	 JFCL
	 JRST [	MOVEI A,DESX4	; Tty or byte illegal
		JRST RLJF3]
	TQNE <OPNF>
	JRST [	MOVEI A,OPNX1	; File is open
		JRST RLJF4]
RLJF2:	MOVEI A,0(JFN)		;GET JFN
	CALL LUNLK0		;FREE THE STR LOCK
RLJF5:	CALL RELJFN		; Finally we can release it
	AOSA -1(P)
RLJF4:	CALL UNLCKF
RLJF3:	POP P,JFN
	RET

RLJF1:	CAMG JFN,MAXJFN		;IS IT A CURRENTLY ASSIGNED JFN?
	CAIE A,DESX3		;YES,  Is no name attached to this jfn?
	JRST RLJF3		; Some other error
	HLRZ B,FILVER(JFN)	; Get fork number of originator
	SKIPGE SYSFK(B)		; Fork still exists?
	JRST RLJF5		; No, ok to release
	CAME B,FORKN		; Is it me?
	JRST RLJF3		; No
	SKIPE PSIBIP		; Test if pi in progress
	JRST RLJF3		; Yes
	JRST RLJF5		; No pi in progress, ok to release
; Rename file
; Call:	1	; Jfn 1
;	2	; Jfn 2
;	RNAMF
; Return
;	+1	; Error
;	+2	; Ok

.RNAMF::MCENT
	CAMN 1,2		;BE SURE NOT SAME JFN
	SMRETN
	MOVE JFN,1
	CALL CHKJFN
	 RETERR()
	 JFCL
	 RETERR(DESX4)		; Cannot rename tty or byte
	TQNE <ASTF>
	 ERUNLK(DESX7)
	TQNE <OPNF>
	ERUNLK(OPNX1)		; File must not be open
	PUSH P,JFN
	PUSH P,DEV
	UMOVE JFN,2
	CALL CHKJFN		; Check the second jfn
;**;[1735] Change several [1729] lines at .RNAMF: +16L	JGZ	10-JUN-80
;**;[1729] Replace 19 lines at .RNAMF: +16L     ARS   6-JUN-80
	 JRST ERULK+1		;[1729] Failed - give error and restore status
	JFCL
	 JRST ERULK1		;[1729]
	TQNE <ASTF>
	 JRST ERULK2		;[1729]
	TQNE <OPNF>
	 JRST ERULK3		;[1729]
	POP P,A
	CAME A,DEV		; Can only rename on the same device
	 JRST ERULK4
	MOVE A,(P)
	PUSH P,JFN
	CALL @REND(P3)
	 JRST ERULK5
	POP P,JFN
;**;[1735] Change [1729] lines at .RNAMF: +33L	JGZ	10-JUN-80
;**;[1729] Add one line at .RNAMF: +33L	ARS	6-JUN-80
	MOVE STS,FILSTS(JFN)	;[1729]RESTORE STS FOR JFN
	CALL UNLCKF
	POP P,JFN
;**;[1735] Change [1729] lines at .RNAMF: +35L	JGZ	10-JUN-80
;**;[1729] Add one line at .RNAMF: +35L	ARS	6-JUN-80
	MOVE STS,FILSTS(JFN)	;[1729]RESTORE STS FOR JFN
	MOVEI A,0(JFN)
	CALL LUNLK0		;FREE UP THE STR LOCK
	CALL RELJFN
	AOS -1(P)
	JRST MRETN
;**;[1817] Replace entire SACTF JSYS routine	JGZ	12-DEC-80
; Set account for file
; Call:	1	; Jfn
;	2	; String pointer or 5B2+account number
;	SACTF
; Returns:
;	+1	; Error, code in 1
;	+2	; Ok

.SACTF::MCENT			;[1817] MONITOR CONTEXT ENTRY
	STKVAR <SACNUM,SACPTR>	;[1817] ACCOUNT NUMBER, FREE SPACE POINTER
	MOVE JFN,T1		;[1817] FETCH THE USER'S JFN
	CALL CHKFIL		;[1817] CHECK ITS VALIDITY, WE WANT A FILE
	 RETERR()		;[1817] INVALID
	TQNE <ASTF>		;[1817] PARSE-ONLY JFN?
	 ERUNLK(DESX7)		;[1817] YES, PARSE-ONLY IS AN ERROR
	HRRZ T1,NLUKD(P3)	;[1817] IS THIS A
	CAIE T1,MDDNAM		;[1817]  MULTIPLE DIRECTORY DEVICE?
	 ERUNLK(SACTX1)		;[1817] NO, ERROR
	CALL GETFDB		;[1817] YES, GET A POINTER TO THE FDB
	 ERUNLK(SACTX4)		;[1817] FAILED
	MOVX T2,DC%CN		;[1817] CODE TO CONNECT TO DIRECTORY
	CALL DIRCHK		;[1817] SEE IF USER CAN DO IT
	 ERUNLK(SACTX4,<ULKDIR>);[1817] NOT ENOUGH PRIVS
	ULKDIR			;[1817] UNLOCK THE DIRECTORY
	UMOVE T1,2		;[1817] GET USER'S POINTER OR ACCOUNT
	TLC T1,-1		;[1817] DO POINTER ADJUSTMENT
	TLCN T1,-1		;[1817] -1 ,, ADR?
	HRLI T1,(<POINT 7,0>)	;[1817] YES, SET UP BYTE POINTER INSTEAD
	CAMG T1,[6B2-1]		;[1817] SEE IF BYTEPOINTER OR NUMERIC ACCOUNT
	CAMGE T1,[5B2]		;[1817]
	 JRST SACTFS		;[1817] BYTE POINTER, GO DO STRING ACCOUNT

;HERE FOR A NUMERIC ACCOUNT - CONVERT TO STRING

	MOVEM T1,SACNUM		;[1817] SAVE NEW NUMERIC ACCOUNT IN SACNUM
	MOVEI T2,4		;[1817] NUMERIC ACCOUNT, CONVERT TO STRING
	CALL ASGJFR		;[1817] GET A SMALL BLOCK OF JSB FREE SPACE
	 ERUNLK(SACTX2)		;[1817] COULDN'T DO IT
	MOVEM T1,SACPTR		;[1817] SAVE LOCATION OF THE BLOCK
	HRROI T1,1(T1)		;[1817] PUT -1 IN LH, AND START IN SECOND WORD
	MOVE T2,SACNUM		;[1817] GET THE ACCOUNT NUMBER BACK
	TLZ T2,700000		;[1817] ISOLATE THE VALUE PORTION
	MOVEI T3,^D10		;[1817] ACCOUNT NUMBERS ARE DECIMAL
	NOUT			;[1817] DO THE CONVERSION TO A STRING
	 ERUNLK(,<MOVE T1,T3>)	;[1817] MOVE ERROR CODE TO T1 AND ERROR OUT
	IBP T1			;[1817] STEP PAST NULL SO COUNT IS RIGHT
	HRRZ T2,T1		;[1817] LAST LOCATION USED IN BLOCK
	MOVE T1,SACPTR		;[1817] ORIGIN OF THE BLOCK
	MOVE T3,T2		;[1817] COPY LAST
	SUB T3,T1		;[1817] FULL WORDS IN BLOCK - 1
	MOVNS T3		;[1817] NEGATE IT
	HRLM T3,SACPTR		;[1817] FUDGED LOOKUP POINTER TO ACCOUNT
	CALL TRMBLK		;[1817] TRIM THE BLOCK
	MOVE T2,SACPTR		;[1817] CALL INSACT WITH LOOKUP POINTER IN T2
	CALL INSACT		;[1817] INSERT NUMERIC ACCOUNT AS STRING
	 JRST SACTER		;[1817] INSACT FAILED, CLEANUP AND ERROR OUT
	JRST SACTFE		;[1817] CLEANUP AND EXIT
;HERE FOR STRING ACCOUNT

SACTFS:	CALL CPYFUS		;[1817] COPY FROM THE USER
	 ERUNLK(SACTX2)		;[1817] CANNOT COPY IT
	UMOVEM T3,2		;[1817] RETURN UPDATED POINTER TO USER
	MOVE T2,T1		;[1817] STRING LOOKUP POINTER TO T2 FOR INSACT
	HRRZM T1,SACPTR		;[1817] SAVE ACCOUNT STRING POINTER
	CALL INSACT		;[1817] SET THE ACCOUNT IN THE DIRECTORY
	 JRST SACTER		;[1817] INSACT FAILED, CLEANUP AND ERROR OUT

SACTFE:	MOVE T2,SACPTR		;[1817] GET OLD FILACT
	MOVEI T1,JSBFRE		;[1817] JSB SPACE TO FREE
	CALL RELFRE		;[1817] RELEASE FREE SPACE FOR OLD FILACT
	CALL UNLCKF		;[1817] RELEASE THE SPACE
	SMRETN			;[1817] AND SKIP RETURN TO USER

;HERE FOR AN ERROR FROM INSACT

SACTER:	MOVEM T1,LSTERR 	;[1817] FAILED, SAVE ERROR CODE
	MOVEI T1,JSBFRE		;[1817] AREA IS JSB FREE SPACE
	HRRZ T2,SACPTR		;[1817] GET FREE POINTER
	CALL RELFRE		;[1817] RELEASE THE STRING SPACE
	MOVE T1,LSTERR		;[1817] GET OLD ERROR CODE BACK
	ERUNLK()		;[1817] RETURN
; Set device status
; Call:	1	; Jfn
;	SDSTS
; Returns
;	+1	; Always unless traps

.SDSTS::MCENT
SDSTS1:	UMOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JFCL
	 ITERR(DESX4)
	UMOVE A,2
	TQZE <BLKF>		;BLKF MUST BE ZERO BEFORE CALL
	BUG(BLKF6)
	TQNE <OPNF>
	CALL @SDSTD(P3)
	TQZN <BLKF>		;ROUTINE WANT TO WAIT?
	JRST UNL		;NO, JUST EXIT
	CALL UNLDIS		;YES, GO DISMIS
	JRST SDSTS1		;LOOP BACK AND TRY AGAIN

; Set file byte size jsys
; Call:	1	; Job file number
;	2	; Byte size (1 to 36)
;	SFBSZ
; Return
;	+1	; Error number in a
;	+2	; Success

.SFBSZ::MCENT
	MOVE JFN,1
	CALL DSKJFN
	 RETERR()
	TQNN <OPNF>
	RETERR(CLSX1,<CALL UNLCKF>)
	XCTU [SKIPLE B,2]
	CAILE B,^D36
	RETERR(SFBSX2,<CALL UNLCKF>) ; Illegal byte size
	TQNE <SIZF>
	RETERR(SFBSX1,<CALL UNLCKF>) ; Illegal to change byte size
	LDB A,PBYTSZ		; Get previous byte size
	CALL NFBSZ
	SETZM FILCNT(JFN)	;FORCE NEW WINDOW NEXT OPERATION
	CALL UNLCKF		; Unlock file
	SMRETN
; Set file byte number
; Call:	1	; Job file number
;	2	; Byte number
;	SFPTR
; Return
;	+1	; Error
;	+2	; Successful

.SFPTR::MCENT			; Become slow etc.
	MOVE JFN,1
	CALL DSKJFN
	 RETERR()
	TQNN <OPNF>
	ERUNLK(CLSX1)
	UMOVE A,2
	CALL SFBNR		; Set the byte number
	 ERUNLK()
	CALL UNLCKF
	SMRETN
; SET FILE TIME AND DATE
; CALL:	1	;JFN
;	2	;ADDR
;	3	;COUNT
; ADDR +0	;TIME AND DATE OF CREATION
; ADDR +1	;TIME AND DATE OF LAST WRITE
; ADDR +2	;TIME AND DATE OF LAST READ
; ADDR +3	;MONITOR LAST WRITE TIME AND DATE (PRIVILEGED)
;		; TIME AND DATE = -1 FOR NO CHANGE
;	SFTAD
; RETURNS
;	+1	; ERROR, CODE IN 1
;	+2	; SUCCESS

.SFTAD::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JFCL
	 JFCL
	UMOVE Q1,3		;GET COUNT FOR SUBRS
;**;[2005] Change 1 line at .SFTAD: +7L	JGZ	18-MAR-82
	JUMPLE Q1,SFTAD1	;[2005] JUST RETURN IF COUNT = 0
	UMOVE Q3,2		;GET ADDR
;**;[3031]	Change i line at .SFTAD+10L	YKT	19-OCT-83
;**;[2005] Add 2 lines at .SFTAD: +9L	JGZ	18-MAR-82
	TLNE Q3,-1		;[3031][2005] DON'T ALLOW BIG ADDRESSES
	 ITERR(ILLX01,<CALL UNLCKF>) ;[2005] GENERATE ERROR
	MOVE T1,CAPENB		;CHECK DATES?
	TRNE T1,SC%WHL!SC%OPR	;WHEEL OR OPERATOR?
	JRST SFTAD2		;CAN SET ANYTHING
	CALL LGTAD		;GET TIME AND DATE IN STANDARD FORMAT
	JUMPL A,[ITERR(DATEX6,<CALL UNLCKF>)] ;LOSE IF NOT SET
	MOVN B,Q1		;GET - LENGTH
	HRLZ B,B
	HRR B,Q3		;AND TABLE ADDR
SFTAD3:	XCTU [MOVE C,(B)]	;GET ENTRY
	CAME C,[-1]		;NOT CHANGING,
	CAMG C,A		;OR LEGAL TIME AND DATE?
	AOBJN B,SFTAD3		;YES, GET NEXT
	JUMPGE B,SFTAD2		;  Checked all entries
	HRRZ D,B		; Get offset
;**;[1773] Add one line at SFTAD3: +6L	JGZ	29-AUG-80
	SUB D,Q3		;[1773] BY SUBTRACTING TABLE BASE
	CAIE D,.RSNET		; In range where an interval is legal?
	CAIN D,.RSFET
	CAIA
;**;[1773] Change one line at SFTAD3: +9L	JGZ	29-AUG-80
	ITERR(DATEX5,<CALL UNLCKF>) ;[1773] ILLEGAL TIME AND DATE?
	AOBJN B,SFTAD3		; Do all entries
SFTAD2:	CALL @SFTADD(P3)	;CALL DEVICE DEPENDENT ROUTINE
	 ITERR(,<CALL UNLCKF>)	;ERROR
SFTAD1:	CALL UNLCKF
	MRETNG

;GLOBAL ROUTINE FOR NO DATES AVAILABLE
SFTADN::RETSKP
; SET FILE USER STRING
;
; CALL: (ARGUMENTS IN USER SPACE)
; ACCEPTS IN T1/ FUNCTION,,JFN
;	     T2/ POINTER TO NAME STRING
;		SFUST
; RETURNS: +1 ALWAYS

.SFUST::MCENT			;MONITOR CONTEXT ENTRY
;**[3020]	Modify one line at .SFUST+1L	YKT	SEP-23-83
	TRVAR <SFUBLK,SFUFDA,SFUDIR,SFUERR,SFSPTR> ;[3020] ALLOCATE LOCAL STORAGE

; VALIDATE THE FUNCTION REQUESTED

	XCTU [ HLRZ T3,1 ]	;GET FUNCTION CODE FROM USER
	CAIE T3,.SFAUT		;IS FUNCTION "SET AUTHOR STRING" ?
	CAIN T3,.SFLWR		;  OR "SET LAST WRITER" ?
	SKIPA			;YES, PROCEED
	ITERR (SFUSX1)		;NO, RETURN "INVALID FUNCTION" ERROR

; COPY NAME STRING FROM USER AND TRANSLATE TO DIRECTORY NUMBER

	UMOVE T1,2		;GET POINTER TO NAME STRING IN USER SPACE
	CALL CPYFU0		;COPY STRING FROM USER SPACE
	 ITERR (SFUSX2)		;FAILED, RETURN "INSUFFICIENT RESOURCES" ERROR
	MOVEM T1,SFUBLK		;SAVE ADDRESS OF BLOCK ASSIGNED
;**;[3020]	Add one line at .SFUST+12L	YKT	SEP-23-83
	MOVEM T3,SFSPTR		;[3020] SAVE UPDATED BYTE POINTER
	XCTU [HRRZ JFN,1]	;GET JFN
	CALL DSKJFN		;VALIDATE FOR FILE ONLY
	 ITERR (,<MOVEM T1,SFUERR	;SAVE THE ERROR CODE
		CALL SFUX2
		MOVE T1,SFUERR>)
	CALL GETFDB		;GET FDB MAPPED
	 ITERR (SFUSX4,<CALL SFUX1>)
	MOVEM T1,SFUFDA		;SAVE FDB ADDRESS
	XCTU [HLRZ T3,1]	;GET FCN CODE AGAIN
	MOVE T2,CAPENB		;CHECK IF ENABLED
	TXNE T2,SC%WHL!SC%OPR
	JRST SFUSOK		;OK TO PROCEED
	CAIN T3,.SFLWR		;WANT TO SET LAST-WRITER?
	ITERR (CAPX1,<CALL SFUXIT>) ;NEED TO BE WHOPER
	MOVX T2,DC%CN		;ELSE OWNER PRIVS FOR AUTHOR
	CALL DIRCHK		; STRING SETTING
	 ITERR (SFUSX5,<CALL SFUXIT>)
SFUSOK:	MOVE T1,SFUFDA		;GET FDB ADDRS AGAIN
	LOAD T2,FBVER,(T1)	;LOOK AT FDB VERSION #
	CAIGE T2,1		;VERSION 1 OR LATER?
	JRST SFUS10		;OLD FDB - DIFFERENT CODE
	XCTU [HLRZ T2,1]	;GET FCN AGAIN
	MOVEI T3,.FBAUT		;ASSUME AUTHOR
	CAIE T2,.SFAUT		;IS IT?
	MOVEI T3,.FBLWR		;NO - SET LAST-WRITER
	MOVE T2,SFUBLK		;POINTER TO STRING BLOCK
	CALL INSUNS		;INSERT STRING INTO DIRECTORY
	CALL SFUXIT		;UNLOCK THINGS
;**;[3020]	Add two lines at SFUSOK+12L	YKT	SEP-23-83
	MOVE T2,SFSPTR		;[3020] RESTORE UPDATED BYTE POINTER
	UMOVEM T2,2		;[3020]
	JRST MRETN		;RETURN
;COMMON EXIT (CLEANUP) ROUTINES

SFUXIT:	CALL USTDIR		;UNLOCK DIRECTORY
SFUX1:	CALL UNLCKF		;UNLOCK JFN
SFUX2:	MOVEI T1,JSBFRE		;FREE UP JSB FREE SPACE
	MOVE T2,SFUBLK		;...
	CALL RELFRE
	OKINT			;ALLOW INTS AGAIN
	RET			;RETURN

;HANDLE OLD STYLE FDB (CONVERT STRING TO USER # FIRST)

SFUS10:	CALL USTDIR		;FIRST UNLOCK DIRECTORY
	MOVEI T1,PSNUM		;LOOK ON PUBLIC STR
	CALL STRCNV		;GET UNIQUE CODE
	 ITERR (SFUSX6,<CALL SFUX1>)
	MOVE T2,T1		;COPY FOR DIRLUK
	MOVE T1,SFUBLK		;POINT TO STRING
	MOVEI T3,0		;DON'T NEED THIS IF NO RECOG.
	TQO <NREC>		;SAY DON'T RECOGNIZE
	CALL DIRLUK		;SEE IF VALID USER NAME ON PS
	 ITERR (SFUSX6,<CALL SFUX1>) ; NO SUCH USER
	MOVEM T1,SFUDIR		;SAVE DIRECTORY NUMBER
	CALL GETFDB		;GET FDB AGAIN
	 ITERR (SFUSX4,<CALL SFUX1>) ;FILE DISAPPEARED
	XCTU [HLRZ T3,1]	;GET USER FCN AGAIN
	HRRZ T2,SFUDIR		;GET DIRECTORY NUMBER
	CAIE T3,.SFAUT		;SETTING AUTHOR?
	JRST [STOR T2,FBLW0,(T1) ;NO - ASSUME LAST WRITER THEN
		JRST SFUS20]
	STOR T2,FBAT0,(T1)	;YES - STASH DIR #
SFUS20:	CALL SFUXIT		;UNLOCK EVERYTHING
;**;[3020]	Add two lines at SFUS20+0L	YKT 	SEP-23-83
	MOVE T2,SFSPTR		;[3020] RESTORE UPDATED BYTE POINTER
	UMOVEM T2,2		;[3020]
	JRST MRETN		;AND RETURN
;SIBE - Skip if input buffer empty

;ACCEPTS:
;	T1/ DEVICE DESIGNATOR

;	SIBE

;RETURNS +1: INPUT BUFFER NOT EMPTY
;		T2/ NUMBER OF BYTES IN BUFFER
;	 +2: INPUT BUFFER EMPTY OR ERROR
;		T2/ 0 IF EMPTY OR NOT OPEN FOR READ
;			OR
;		    ERROR CODE IF ERROR

.SIBE::	MCENT
	STKVAR <SIBEBS>
	CALL CHKTTR
	 JRST SIBE1
	MOVEM C,SIBEBS		;SAVE BYTE SIZE

;DEVICE IS A TERMINAL

	CALL LCKTTY		;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
	 JRST [	CALL ULKTTY	;NOT ACTIVE. ALLOW DEALLOCATION
		MOVEI A,TTYX01	;INDICATE LINE IS NOT ACTIVE
		UMOVEM A,B	;RETURN ERROR CODE IN 2
;**;[1844] Add one line at .SIBE: +12L	JGZ	13-APR-81
		MOVEM T1,LSTERR	;[1844] AND LSTERR
		SMRETN]		;RETURN +2
	MOVE C,SIBEBS		;GET BYTE SIZE FOR TTSIBE
	CALL TTSIBE		;GO CHECK INPUT BUFFER
	JRST [	UMOVEM A,B	;NOT EMPTY. RETURN COUNT
		CALL ULKTTY	;ALLOW DEALLOCATION
		JRST EMRET1]	;RETURN +1
	CALL ULKTTY		;EMPTY. ALLOW DEALLOCATION
	UMOVEM A,B		;RETURN COUNT OF 0
	SMRETN			;RETURN +2

SIBE1:	CAIE A,DESX6		;LEGAL, NON-TTY DESIGNATOR?
;**;[1844] Change one line at SIBE1: +1L	JGZ	13-APR-81
	 JRST [	MOVEM T1,LSTERR	;[1844] RETURN ERROR CODE IN LSTERR
		UMOVEM T1,2	;[1844]  AND USER AC2
		SMRETN]		;[1844] THEN TAKE SKIP RETURN
	TQNE <OPNF>
	TQNN <READF>
	 JRST [	SETZ A,
		JRST SIBE2]
	CALL @JFNID(P3)		;GO INIT JFN FOR INPUT
	SKIPLE A,FILCNT(JFN)
	 JRST [	UMOVEM A,B
		JRST EMRET1]
SIBE2:	UMOVEM A,B		;RETURN ERROR CODE OR 0
	SMRETN			;+2 RETURN
; Get size of file
; Call:	1	; Jfn
;	SIZEF
; Return
;	+1	; Error, cannot get size of file
;	+2	; Success
;	1	; Size in bytes
;	2	; Size in pages

.SIZEF::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 JRST GBGJFN
	 JFCL
	 ERUNLK DESX4
	TQNE <ASTF>
	 ERUNLK(DESX7)
	HRRZ B,DEV		; Get dispatch address
	MOVEI A,DESX8
	CAIE B,DSKDTB
	ERUNLK()
	CALL GETFDB		; Get pointer to fdb
	 ERUNLK OPNX2
	LOAD B,FBNPG,(A)	; GET NUMBER OF PAGES
	TQNN <OPNF>		;FILE OPENED?
	JRST [	MOVE A,.FBSIZ(A) ; NO - USE LENGTH IN FDB
		JRST SIZEF1]
	HLRZ D,FILOFN(JFN)	;GET OFN
	TQNE <LONGF>
	HRRZ D,FILOFN(JFN)	;USE THIS IF LONG FILE
	LOAD A,OFNBC,(D)	;GET FILE LENGTH
SIZEF1:	UMOVEM A,2
	UMOVEM B,3
	CALL USTDIR
	CALL UNLCKF
	SMRETN

GBGJFN:	RETERR ()
;FILE PORTION OF SMAP JSYS. GOTTEN HERE IF MAPPING TO A FILE.

;ACCEPTS:
;	T1/ SOURCE I.D. (JFN,,SECTION NUMBER)
;	Q1/ STARTING SECTION IN SOURCE
;	Q2/ DESTINATION (SPT INDEX OF PSB,,SECTION NUMBER)
;	Q3/ ACCESS,,COUNT

;	CALL SMFILE

;RETURNS:	+1	FAILURE. T1/ERROR CODE
;		+2	SUCCESS

SMFILE::MOVEI T2,-1(Q3)		;GET COUNT
	ADD T2,Q1		;COMPUTE LAST SECTION IN SOURCE
	CAILE T2,777		;LEGAL SECTION?
	RETBAD (ARGX23)		;NO. ILLEGAL SECTION
	HLRZ JFN,T1		;GET THE JFN
	CALL DSKJFN		;VERIFY, LOCK
	 RETBAD ()		;NOT VALID
	TQNN <OPNF>		;OPENED?
	RETBAD (DESX5,<CALL UNLCKF>) ;NO. ERROR THEN
	TQNN <WRTF>		;OPEN FOR WRITE?
	TXZ Q3,PM%WT		;NO. CAN'T HAVE WRITE ACCESS THEN
	LSH Q1,PGSFT		;CONVERT SECTION # TO PAGE

;MAP A SECTION AT A TIME. GET THE OFN FOR EACH 1000-PAGE SECTION
;OF THE FILE AND MAP IT TO THE NEXT SECTION IN THE DESTINATION

;Q1/ PAGE NUMBER (SECTION NO. * 1000)

SMFIL1:	MOVE T1,Q1		;GET PAGE NUMBER OF SECTION
	TXNN Q3,PM%WT		;WANT WRITE?
	SKIPA T2,[JFNOF3]
	MOVEI T2,JFNOF1
	CALL 0(T2)		;GET OFN,,PN
	 JRST [	MOVE Q1,T1	;SAVE ERROR
		CALL UNLCKF	;UNLOCK FILE
		MOVE T1,Q1	;RESTORE ERROR
		RETBAD ()]	;DONE
	HLRZS T1		;GET OFN
	CALL UPSHR		;MAKE SURE IT DOESN'T DISAPPEAR
	DMOVE T2,Q2		;GET OTHER ARGS
	HLLZS T3		;ISOLATE FLAGS
	CALL SECMAP		;MAP IT
	ADDI Q1,PGSIZ		;NEXT SECTION
	ADDI Q2,1		;NEXT PROCESS SECTION
	SUBI Q3,1		;ONE LESS TO DO
	MOVX T1,2B17		;INCREMENTER
	ADDM T1,FILLFW(JFN)	;REMEMBER MAP
	TRNE Q3,-1		;MORE TO DO?
	JRST SMFIL1		;YES
	CALL UNLCKF		;NO. UNLOCK JFN
	RETSKP			;SUCCESS
; String to directory
; Call:	1	; Positive for no recognition
;	2	; Source designatoR
;	STDIR
; Return
;	+1	; No match
;	+2	; Ambiguous
;	+3	; Unique match

.STDIR::MCENT
	ITERR(STDIX1)		;STDIR WAS REPLACED BY RCUSR AND RCDIR
;JSYS TO CONVERT A STRING TO A PPN (TOPS10 STYLE)
;ACCEPTS IN T1/ 36-BIT DIRECTORY #
;		JFN
;		STRING-PNTR TO STR/DIRECTORY NAME
;RETURNS +1 ALWAYS T2/ PPN

.STPPN::MCENT
	UMOVE T1,1		;GET USER ARG
	TLNN T1,-1		;POSIBLE JFN?
	JRST STPPJ		;YES - TRY IT
	LOAD T2,NMFLG,T1	;CHECK FOR 36-BIT DIR NUMB
	CAIE T2,NUMVAL		;???
	JRST [	CALL CNVSTD	;STRING - TRY TO GET DIR #
		 ITERR ()
		JRST STPPNX]	;FINISH UP
   REPEAT 0,<
;THIS ISN'T REALLY NECESSARY AND ONLY BURNS CYCLES...
	CALL SETDIR		;DIR # - MAP IT
	 ITERR ()		;RETURN LOSAGE INFO
	CALL USTDIR>		;VALID # - UNLOCK DIR
	XCTU [HRRZ T1,1]	;GET USERS RHS
STPPNX:	HRLI T1,PPNLH		;OUR OWN LHS
	UMOVEM T1,2		;RETURN TO USER AC2
	JRST MRETN		;RETURN

STPPJ:	MOVE JFN,T1		;PUT JFN IN AC(JFN)
	CALL DSKJFN		;CHECK IF A DISK
	 ITERR ()		;NOPE - RETURN ERROR
	HRRZ T1,FILDDN(JFN)	;YES - GET DIR #
	CALL UNLCKF		;UNLOCK JFN
	JRST STPPNX		;COMMON EXIT
; Set status
; Call:	1	; Jfn
;	2	; New status
;	STSTS
; Returns
;	+1	; Erro2
;	+2	; Ok (only errf, hltf, and frkf can be changed)

.STSTS::MCENT
	MOVE JFN,1
	CALL CHKJFN
	 RETERR()		; Bad jfn
	 JFCL
	 RETERR(DESX4)		; Tty and byte bad
	UMOVE A,2		; Get new status
	ANDCA A,[ERRF!HLTF!FRKF]
	TDZ STS,A
	CALL UNLCKF
	SMRETN
; Swap jfn's
; Call:	1	; Jfn 1
;	2	; Jfn 2
;	SWJFN

.SWJFN::MCENT
	MOVE JFN,1
	CAMN 1,2		;SWAPPING SAME JFN?
	ITERR(SWJFX1)		;ILLEGAL, TELL USER
	CALL CHKJFN
	 ITERR()
	 JFCL
	 ITERR(DESX4)
	CALL CHKATS		;IS THIS AN ATS JFN?
	JRST [	MOVE A,JFN	;YES. SET UP JFN FOR LUNLKF
		CALL LUNLKF	;UNLOCK THE JFN
		ITERR (SWJFX2)]	;RETURN 'ILLEGAL TO SWAP ATS JFN'
	PUSH P,JFN		;NO. SAVE THE FIRST JFN
	UMOVE JFN,2		;GET THE SECOND JFN
	CALL CHKJFN
	 ITERR(,<POP P,JFN
		MOVE DEV,FILDEV(JFN)
		MOVE STS,FILSTS(JFN)	;RESTORE STS CLOBBERED BY CHKJFN
		CALL UNLCKF>)
	 JFCL
	 ITERR(DESX4,<POP P,JFN
		MOVE DEV,FILDEV(JFN)
		MOVE STS,FILSTS(JFN)	;RESTORE STS CLOBBERED BY CHKJFN
		CALL UNLCKF>)
	CALL CHKATS		;IS THIS AN ATS JFN?
	JRST [	MOVE A,JFN	;YES. SET UP FOR LUNLKF
		CALL LUNLKF	;UNLOCK THE SECOND JFN
		POP P,A		;SET UP THE FIRST JFN FOR LUNLKF
		CALL LUNLKF	;UNLOCK THE FIRST JFN
		ITERR (SWJFX2)]	;RETURN 'ILLEGAL TO SWAP ATS JFN'
	POP P,A			;NO. GET THE FIRST JFN
	MOVEI B,SWJFNT
	HRLI B,-SWJFNC
	HRLI A,D+(IFIW)
	HRLI JFN,D+(IFIW)
SWJFNL:	MOVE D,(B)
	MOVE C,@JFN
	EXCH C,@A
	MOVEM C,@JFN
	AOBJN B,SWJFNL
	CALL LUNLKF		;RELEASE LOCK ON THIS JFN
	MOVEI A,0(JFN)		;GET OTHER
	CALL LUNLKF		;AND RELEASE THIS ONE ALSO
	JRST MRETN

SWJFNT:	FILBYT
	FILBYN
;**;[1741] Insert FILACT in SWJFNT table  RAS  11-JUN-80
	FILACT
	FILLEN
	FILCNT
;**;[1741] Insert FILLCK in SWJFNT table  RAS  11-JUN-80
	FILWND
	FILSTS
	FILDEV
	FILOFN
	FILLFW
	FILDDN
;**;[1741] Insert FILDNM in SWJFNT table   RAS   11-JUN-80
	FILDNM
	FILNEN
	FILVER
	FILMS1
	FILMS2
	FILFDB
	FILCOD
SWJFNC==.-SWJFNT
;UPDATE FILE PAGES
; A/ IDENT OF FIRST PAGE (JFN,,PN)
; B/ COUNT OF SEQUENTIAL PAGES TO UPDATE
;	UFPGS
; RETURN +1: FAILURE
; RETURN +2: SUCCESS, ALL MODIFIED PAGES WRITTEN TO DSK.  FDB UPDATED
;	IF NECESSARY.  BLOCKS UNTIL ALL WRITES COMPLETE

.UFPGS::MCENT
	MOVE Q1,A		;SAVE ID
	HRRZ Q2,B		;SAVE COUNT
	HLRZ JFN,Q1
	CALL DSKJFN		;ENSURE JFN ON DSK
	 RETERR()
	TQNN <WRTF>		;OPEN FOR WRITE?
	ERUNLK ufPGX1		;NO, WRONG.
UFPG1:	HRRZ A,Q1		;GET CURRENT IDENT
	CALL JFNOF3		;GET OFN.PN
	 JRST [	CAIE A,LNGFX1	;TRIED TO CREATE A PT?
		JRST ERUNLD	;NO. GIVE THE ERROR THEN
		HRRO A,Q1	;GET PN IN RH AND -1 IN LH
		TRZ A,777000	;GET CURRENT PT OFFSET ONLY
		JRST .+1]	;GO IN-LINE
	MOVEM A,Q3
	MOVEI B,PGSIZ		;COMPUTE NUMBER WORDS LEFT IN PT
	SUBI B,0(A)
	CAML B,Q2		;GREATER THAN REMAINING COUNT?
	HRRZ B,Q2		;NO, USE COUNT
	ADD Q1,B		;UPDATE IDENT
	SUB Q2,B		;UPDATE COUNT
	SKIPGE Q3		;DOES THIS PT EXIST
	JRST UFPG2		;NO. SKIP OFN UPDATING THEN
	XCTU [HLL B,2]		;COPY FLAGS
	CALL UPDPGS		;DO THE WORK
	HLRZ A,Q3
	CALL UPDOFN		;UPDATE OFN ALSO
UFPG2:	JUMPG Q2,UFPG1		;LOOP OF COUNT NON-0
	CALL GETFDB		;CHECK FDB ALSO
	 JRST UFPG4		;COULDN'T, ASSUME OK (SHOULDN'T HAPPED)
	MOVX B,FILNB
	MOVX C,FB%NXF
	TDNN B,.FBADR(A)	;NEW FILE?
	TDNE C,.FBCTL(A)	;OR NONX?
	JRST [	ANDCAM B,.FBADR(A) ;YES, NORMALIZE
		ANDCAM C,.FBCTL(A)
		CALL UPDDIR	;AND UPDATE DIRECTORY
		JRST .+1]	;FILE NOW GUARANTEED ON DISK
	CALL USTDIR		;RELEASE DIRECTORY
UFPG4:	CALL UNLCKF		;UNLOCK JFN
	SMRETN
;WILD% JSYS.  USED TO COMPARE TWO STRINGS TO SEE IF THEY MATCH, OR
;TWO JFNS TO SEE IF THEY MATCH.  THE FIRST STRING OR JFN CAN CONTAIN
;WILDCARD CHARACTERS.



.WILD::	MCENT			;ENTER JSYS
	HLLZ F,T1		;PUT FLAGS IN A SAFE PLACE
	ANDI T1,-1		;ISOLATE FUNCTION CODE
	CAILE T1,WLDMXF		;LEGAL?
	 ITERR (ARGX02)		;NO
	SETZ Q2,		;INITIALIZE FLAGS TO BE RETURNED
	CALL @WLDDSP(T1)	;DO THE WORK
	UMOVEM Q2,1		;GIVE USER THE RESULT
	MRETNG			;DONE



WLDDSP:	IFIW	WLDSTR		;(0) COMPARE STRINGS
	IFIW	WLDJFN		;(1) COMPARE JFNS

	WLDMXF==.-WLDDSP-1	;MAXIMUM LEGAL FUNCTION
;STRING COMPARE FUNCTION.  AC2 CONTAINS BYTE POINTER TO WILD STRING,
;AC3 CONTAINS BYTE POINTER TO NON-WILD STRING.



WLDSTR:	TLNE F,-1-<(WL%LCD)>	;SPECIFYING ILLEGAL BITS?
	 ITERR (ARGX22)		;YES
	UMOVE T1,3		;SET UP NON-WILD POINTER
	UMOVE T2,2		;AND WILD POINTER
	TLC T1,-1		;GET SET TO DEFAULT LEFT HALFS
	TLC T2,-1
	TLCN T1,-1		;WAS LEFT HALF -1?
	HRLI T1,(POINT 7,)	;YES, USE DEFAULT
	TLCN T2,-1		;HOW ABOUT OTHER POINTER?
	HRLI T2,(POINT 7,)	;YES, FILL IN
	LDB T3,[POINT 6,T1,11]	;GET BYTE SIZES
	LDB T4,[POINT 6,T2,11]	;SO CAN CHECK THEM
	CAIL T3,7		;AT LEAST 7 BIT BYTES?
	CAIGE T4,7
	 ITERR (ARGX09)		;NO, LOSE
	MOVEI T3,[PUSHJ P,WLDCH1	;POINT AT INSTRUCTIONS
		  PUSHJ P,WLDCH2]	;WHICH WILL OBTAIN USER CHARS
	CALL CHKWLS		;SEE IF STRINGS MATCH
	TXOA Q2,WL%NOM		;NO, SET FLAG BIT
	RET			;YES, ALL DONE
	SKIPE T1		;IS IT AN ABBREVIATION?
	TXO Q2,WL%ABR		;YES, SET THAT
	RET			;DONE



;ROUTINES TO READ THE CHARACTERS FROM THE USER'S CORE.
;CHARACTERS HAVE TO BE RETURNED IN AC Q1 FOR CHKWLS TO USE.


WLDCH1:	XCTBMU [ILDB Q1,T2]	;READ CHARACTER OF WILD STRING
	ERJMP [ITERR (,<MOVE T1,LSTERR>)]	;FAILED, PASS UPWARDS
	JRST WLDCHC		;GO CHECK LOWER CASE

WLDCH2:	XCTBMU [ILDB Q1,T1]	;READ CHARACTER OF NON-WILD STRING
	ERJMP [ITERR (,<MOVE T1,LSTERR>)]	;FAILED, PROPAGATE ERROR

WLDCHC:	CAIL Q1,"A"+40		;IS CHARACTER LOWER CASE?
	CAILE Q1,"Z"+40		;WELL?
	RET			;NO
	TXNN F,WL%LCD		;SHOULD WE CONVERT TO UPPER CASE?
	SUBI Q1,40		;YES, DO SO
	RET			;DONE
;JFN COMPARE FUNCTION.  AC2 CONTAINS A WILD JFN, AND AC3 CONTAINS
;A NON-WILD JFN.



WLDJFN:	TLNE F,-1		;SUPPLYING ANY FLAGS?
	 ITERR (ARGX22)		;YES, GIVE ERROR
	UMOVE JFN,3		;GET JFN OF TEST FILE
	TLNE JFN,-1		;SPECIFYING ANY WILD FLAGS?
	 ITERR (WILDX1)		;YES, THAT IS ILLEGAL
	MOVE Q3,JFN		;SAVE FOR LATER
	CALL CHKFIL		;CHECK VALIDITY OF FILE JFN
	 ITERR ()		;ERROR IF BAD
	MOVE Q1,JFN		;REMEMBER JFN OFFSET OF TEST FILE
	UMOVE JFN,2		;GET JFN OF WILD FILE
	XOR Q3,JFN		;REMEMBER FLAG BITS AND COMPARE JFNS
	TRNN Q3,-1		;WERE THE WILD AND TEST JFNS THE SAME?
	JRST WLJFN2		;YES, A FILE MATCHES ITSELF!
	TLZ JFN,-1		;CLEAR FLAGS
	CALL CHKFIL		;VALIDATE THIS JFN TOO
	 ITERR (,<CALL WLERR>)	;BAD, UNLOCK FIRST JFN AND QUIT
	TXNN Q3,GJ%DEV!GJ%UNT	;DOES USER WANT WILD DEVICE OR UNIT?
	JRST WLDEV		;NO, GO COMPARE EXPLICIT DEVICES
	MOVE T1,FILSTS(Q1)	;GET FILE STATUS OF TEST JFN
	TXNE T1,ASTF		;IS IT PARSE ONLY?
	JRST WLJFD		;YES, THEN IT MATCHES
	HRRZ T1,FILDEV(Q1)	;GET DEVICE TYPE
	CAIE T1,DSKDTB		;IS IT A DISK? (ONLY WILD DEVICE IS DSK*:)
	TXO Q2,WL%DEV		;NO, SET DEVICES DIFFER FLAG
	JRST WLJFD		;GO ON TO DIRECTORIES

WLDEV:	HLRZ T1,FILDDN(JFN)	;GET DEVICE STRING OF WILD FILE
	HLRZ T2,FILDDN(Q1)	;AND OF TEST FILE
	CALL FLDCMP		;COMPARE THEM
	TXO Q2,WL%DEV		;NO MATCH, SET DEVICES DIFFER FLAG
WLJFD:	LOAD T2,FILDIR,(JFN)	;GET DIRECTORY STRING OF WILD FILE
	TXNN Q3,GJ%DIR		;WANT TO USE WILDCARDS INSTEAD?
	JRST WLJFD1		;NO, USE THIS STRING
	LOAD T2,FILDMS,(JFN)	;GET WILD STRING
	JUMPE T2,WLJFF		;IF NONE, ASSUME "*" AND MATCH
WLJFD1:	LOAD T1,FILDIR,(Q1)	;GET DIRECTORY STRING OF TEST FILE
	CALL FLDCMP		;DO THE COMPARISON
	TXO Q2,WL%DIR		;NO MATCH, SET DIRECTORIES DIFFER FLAG

WLJFF:	HLRZ T2,FILNEN(JFN)	;GET FILENAME STRING
	TXNN Q3,GJ%NAM		;WILDCARDING DESIRED?
	JRST WLJFF1		;NO, SO USE THIS STRING
	LOAD T2,FILNMS,(JFN)	;GET WILD STRING IF ANY
	JUMPE T2,WLJFE		;IF NONE, ASSUME "*" AND MATCH
WLJFF1:	HLRZ T1,FILNEN(Q1)	;GET FILENAME STRING OF TEST FILE
	CALL FLDCMP		;DO THE COMPARISON
	TXO Q2,WL%NAM		;NO MATCH, SET FILENAMES DIFFER FLAG


WLJFE:	HRRZ T2,FILNEN(JFN)	;GET EXTENSION STRING
	TXNN Q3,GJ%EXT		;SHOULD WE DO WILDCARDING?
	JRST WLJFE1		;NO, USE THIS STRING
	LOAD T2,FILEMS,(JFN)	;GET WILD MASK
	JUMPE T2,WLJFG		;IF NONE, MATCH THIS FIELD
WLJFE1:	HRRZ T1,FILNEN(Q1)	;GET EXTENSION STRING FOR TEST FILE
	CALL FLDCMP		;DO THE COMPARISON
	TXO Q2,WL%EXT		;NO MATCH, SET EXTENSIONS DIFFER FLAG


WLJFG:	TXNE Q3,GJ%VER		;WILD GENERATIONS DESIRED?
	JRST WLJFIN		;YES, THEN THEY MATCH
	HRRZ T1,FILVER(JFN)	;GET GENERATION OF WILD FILE
	HRRZ T2,FILVER(Q1)	;AND GENERATION OF TEST FILE
	CAME T1,T2		;ARE THEY THE SAME?
	TXO Q2,WL%GEN		;NO, SET GENERATIONS DIFFER FLAG


WLJFIN:	MOVE T1,JFN		;GET JFN OF WILD FILE
	CALL LUNLKF		;UNLOCK IT
WLJFN2:	MOVE T1,Q1		;GET JFN OF TEST FILE
	CALLRET LUNLKF		;UNLOCK IT TOO AND RETURN
;ROUTINE TO COMPARE STRINGS POINTED TO BY POINTERS IN T1 AND T2.
;IF NO POINTER EXISTS, THE STRING WILL BE DEFAULTED TO NULL.  SKIP
;RETURN IF STRINGS MATCH.


FLDCMP:	SKIPN T1		;ADDRESS OF TEST STRING MISSING?
	MOVEI T1,[EXP 0,0]	;YES, POINT TO A NULL STRING
	SKIPN T2		;ADDRESS OF WILD STRING MISSING?
	MOVEI T2,[EXP 0,0]	;YES, ALSO POINT TO NULL STRING
	HRLI T1,(POINT 7,0,35)	;FINISH BYTE POINTER
	CALLRET CHKWLD		;GO DO THE ACTUAL COMPARISON



;SUBROUTINE CALLED IF THE SECOND JFN IS BAD, TO UNLOCK THE FIRST
;JFN BEFORE GIVING THE ITRAP.


WLERR:	MOVE JFN,Q1		;GET FIRST JFN
	MOVE DEV,FILDEV(JFN)	;RESTORE STATUS ACS
	MOVE STS,FILSTS(JFN)	;THAT UNLCKF WANTS SET UP
	CALLRET UNLCKF		;GO UNLOCK THE JFN


;**;[1735] Change [1729] lines at TNXEND -0L	JGZ	10-JUN-80
;**;[1729] Add several lines at TNXEND -0L	ARS	6-JUN-80

ERULK:	CALL UNLCKF		;[1729]UNLOCK THE FILE
	POP P,DEV		;REST ACS
	POP P,JFN
	MOVE STS,FILSTS(JFN)	;GET THE STS
	JRST ERUNLD

ERULK1:	MOVEI A,DESX4
	JRST ERULK+1

ERULK2:	MOVEI A,DESX7
	JRST ERULK

ERULK3:	MOVEI A,OPNX1
	JRST ERULK

ERULK4:	PUSH P,A
	MOVEI A,RNAMX1
	JRST ERULK

ERULK5:	POP P,JFN			;RES PROPER JFN
	MOVE STS,FILSTS(JFN)		;GET STATUS
	CALL UNLCKF			;DO IT
	POP P,JFN			;AGAIN FOR THE OTHER JFN
	MOVE STS,FILSTS(JFN)
	JRST ERUNLD



	TNXEND
	END