Google
 

Trailing-Edge - PDP-10 Archives - AP-4178E-RM - swskit-sources/jsysf.mac
There are 53 other files named jsysf.mac in the archive. Click here to see a list.
;<3A.MONITOR>JSYSF.MAC.341,  1-Aug-78 16:10:46, Edit by HELLIWELL
;REMOVE NOINT/OKINT AT DSM0 (ONLY DECTAPES CARE)
;<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
;<3A.MONITOR>JSYSF.MAC.336,  1-Mar-78 09:33:29, EDIT BY MILLER
;MAKE SURE CRDIR CODE DOES NOT DIDDLE QUOTA OF "ROOT-DIRECTORY"
;<3A.MONITOR>JSYSF.MAC.335, 29-Jan-78 17:12:10, Edit by BORCHEK
;FIX RFTAD NOT TO ZAP 2 WORDS WHEN ONLY 1 WAS ASKED FOR
;<3.SM10-RELEASE-3>JSYSF.MAC.334,  9-Dec-77 23:04:31, EDIT BY HELLIWELL
;FIX EXADR BUGS IN RDDIR
;<3-MONITOR>JSYSF.MAC.333,  5-Dec-77 01:12:36, EDIT BY BOSACK
;DISALLOW MTOPR UNLESS DEVICE IS OPEN - TEMP FIX UNTIL DEVICES FIXED
;<3-MONITOR>JSYSF.MAC.332,  7-Nov-77 13:03:17, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>JSYSF.MAC.331,  3-Nov-77 20:09:57, EDIT BY HURLEY
;FIX JFNS SO THAT THE FULL DUMPER RESTORE WORKS CORRECTLY
;<3-MONITOR>JSYSF.MAC.330, 18-Oct-77 16:38:58, EDIT BY KIRSCHEN
;REMOVE CODE IN SACTF JSYS TESTING DIRECTORY MODE WORD
;<3-MONITOR>JSYSF.MAC.329, 13-Oct-77 08:36:45, EDIT BY MILLER
;FIX GTSTS TO CHECK FOR PRIMARY I/O DESIGNATORS
;<3-MONITOR>JSYSF.MAC.328, 12-Oct-77 13:53:48, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>JSYSF.MAC.327, 11-Oct-77 14:05:13, EDIT BY HALL
;BUG FIX IN RCUSR - USED TXO INSTEAD OF TQO FOR <NREC>
;<3-MONITOR>JSYSF.MAC.326, 27-Sep-77 20:52:39, EDIT BY CROSSLAND
;CAUSE .CRDIR TO OPEN MAIL.TXT IN 7 BIT MODE
;<3-MONITOR>JSYSF.MAC.325, 22-Sep-77 10:27:57, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.324, 15-Sep-77 14:12:52, EDIT BY KIRSCHEN
;REMOVE DVCHR FROM RCDIR - NOT NEEDED
;<3-MONITOR>JSYSF.MAC.323, 14-Sep-77 09:26:07, EDIT BY HURLEY
;MAKE CHFDB UPDATE THE LENGTH OF A FILE WHEN FBSIZ IS CHANGED
;<3-MONITOR>JSYSF.MAC.322,  8-Sep-77 17:40:09, EDIT BY MILLER
;<3-MONITOR>JSYSF.MAC.321,  5-Sep-77 19:30:15, EDIT BY HURLEY
;FIX DEFAULT ACCOUNT STRING TYPE OUT BY JFNS
;<3-MONITOR>JSYSF.MAC.320, 31-Aug-77 12:45:44, EDIT BY HALL
;BUG FIX IN CRDIR - CHECK .CDSDQ FOR >18 BITS
;<3-MONITOR>JSYSF.MAC.319, 30-Aug-77 17:38:40, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.318, 30-Aug-77 15:43:15, EDIT BY HALL
;BUG FIX IN CRDIR - MAKE DELDIR CALL ADJALC
;<3-MONITOR>JSYSF.MAC.317, 30-Aug-77 14:38:37, EDIT BY MILLER
;BUG FIX IN RCUSR - NEEDED TRVAR EARILER
;<3-MONITOR>JSYSF.MAC.316, 28-Aug-77 01:42:04, EDIT BY HELLIWELL
;FIX BUG IN JFNS FOR NO DIRECTORY
;<3-MONITOR>JSYSF.MAC.315, 27-Aug-77 13:21:43, EDIT BY HALL
;MAKE RCUSR STEP USER NUMBERS
;<3-MONITOR>JSYSF.MAC.314, 25-Aug-77 14:42:20, EDIT BY HALL
;BUG FIX IN CRDIR - CHECK FOR INFINITE QUOTA BEFORE CALLING ADJALC
;<3-MONITOR>JSYSF.MAC.313, 25-Aug-77 13:51:09, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.312, 24-Aug-77 10:58:18, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.311, 23-Aug-77 15:40:42, EDIT BY HALL
;BUG FIXES IN CRDIR - CHECK FOR CHANGING PRIVILEGE BEFORE TESTING PRIVILEGES
;	CHANGE ERROR CODES WHEN GTJFN FAILS
;	HANDLE INFINITE QUOTA SPECIALLY
;<3-MONITOR>JSYSF.MAC.310, 22-Aug-77 13:22:17, EDIT BY HALL
;BUG FIX IN CRDIR - CHECK SUBDIRECTORY QUOTA AGAINST EXISTING SUBDIRECTORIES
;<3-MONITOR>JSYSF.MAC.309, 17-Aug-77 14:21:36, EDIT BY HURLEY
;FIX JFNS DEFAULT OUTPUT FOR DIRECTORIES
;<3-MONITOR>JSYSF.MAC.308, 17-Aug-77 10:50:47, EDIT BY HALL
;FIX TYPO IN PREVIOUS EDIT
;<3-MONITOR>JSYSF.MAC.307, 16-Aug-77 10:41:41, EDIT BY HALL
;MAKE RCDIR TURN OFF RECOGNITION WHEN IT FINDS A CLOSING BRACKET
;<3-MONITOR>JSYSF.MAC.306, 12-Aug-77 10:31:00, EDIT BY HALL
;MADE CRDIR ADJUST ALLOCATION TABLE ENTRY FOR DIRECTORY AND ITS
;	SUPERIOR
;<3-MONITOR>JSYSF.MAC.305, 11-Aug-77 15:29:49, EDIT BY MILLER
;MAKE ERBOUT SET UP TRVAR FOR CALLING BYTOUA
;<3-MONITOR>JSYSF.MAC.304,  9-Aug-77 16:58:11, EDIT BY HALL
;IN CRDIR, RETURN ERROR IF CALLER HASN'T ENABLED REQUESTED CAPABILITIES
;<3-MONITOR>JSYSF.MAC.303,  5-Aug-77 10:40:58, EDIT BY HALL
;BUG FIX IN CRDIR - SUBTRACT NUMBER OF SUBDIRS FROM SUPERIOR'S QUOTA
;	NEAR CRD3AA
;<3-MONITOR>JSYSF.MAC.302,  5-Aug-77 09:12:55, EDIT BY MILLER
;CHECK FOR ERRF RETURN FROM BYTOUA IN ERBOUT
;<3-MONITOR>JSYSF.MAC.301,  4-Aug-77 19:28:53, EDIT BY HURLEY
;MAKE SIBE WORK CORRECTLY IF GIVEN A BINARY JFN ON A TTY
;<3-MONITOR>JSYSF.MAC.300,  4-Aug-77 11:06:58, EDIT BY HALL
;CRDIR - CHANGE PROTECTION ON DIRECTORY FILE TO 020200, CHANGE JUMPL
;	TO JUMPLE WHEN CHECKING SUBDIRECTORY QUOTA NEAR CRD3AA
;<3-MONITOR>JSYSF.MAC.299,  3-Aug-77 17:13:34, EDIT BY HALL
;BUG FIX IN CRDIR- ADD A SETDIR AT CRDIAB
;<3-MONITOR>JSYSF.MAC.298, 29-Jul-77 10:11:58, EDIT BY HURLEY
;SPEED UP WILD CARD DIRECTORY LOOKUPS
;<3-MONITOR>JSYSF.MAC.297, 28-Jul-77 16:45:48, EDIT BY HALL
;MADE CRDIR RETURN CORRECT QUOTA ERROR CODES; BUG FIX IN CRDCUP
;<3-MONITOR>JSYSF.MAC.296, 28-Jul-77 11:44:34, EDIT BY HURLEY
;MORE DIRECTORY RECONSTRUCTION CODE
;<3-MONITOR>JSYSF.MAC.295, 27-Jul-77 17:30:12, EDIT BY HALL
;MAKE CRDIR DELETE FUNCTION CALL CPYBAK
;<3-MONITOR>JSYSF.MAC.294, 27-Jul-77 16:31:49, EDIT BY HALL
;MAKE CRDIR ALWAYS USE VERSION 1
;<3-MONITOR>JSYSF.MAC.293, 27-Jul-77 12:58:09, EDIT BY HALL
;DON'T ALLOW DELETION OF CONNECTED OR LOGGED-IN DIRECTORY
;<3-MONITOR>JSYSF.MAC.292, 26-Jul-77 15:25:23, Edit by MACK
;LET NON-PRIVILEGED USERS SET THEIR DEFAULT DIRECTORY ACCTS
;<3-MONITOR>JSYSF.MAC.291, 26-Jul-77 12:12:28, EDIT BY HALL
;BUG FIXES IN DELDIR
;<3-MONITOR>JSYSF.MAC.290, 25-Jul-77 17:18:29, Edit by MACK
;TCO 1822 - CRDIR ADDITION TO SET DEFAULT DIRECTORY ACCOUNT
;<3-MONITOR>JSYSF.MAC.289, 22-Jul-77 17:42:31, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.288, 22-Jul-77 14:28:29, EDIT BY HURLEY
;ALWAYS RETURN MD%SA ON RCDIR AND RCUSR JSYS'S
;<3-MONITOR>JSYSF.MAC.287, 21-Jul-77 16:39:46, EDIT BY HURLEY
;FIX STRING LENGTH PROBLEMS IN CRDIR AND RCDIR
;MAKE IT POSSSIBLE FOR USERS TO DELETE THEIR SUBDIRECTORIES
;<3-MONITOR>JSYSF.MAC.286, 21-Jul-77 12:16:25, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.285, 20-Jul-77 15:27:55, EDIT BY HURLEY
;ADD RECONSTRUCTION OF SUB-DIRECTORIES
;<3-MONITOR>JSYSF.MAC.284, 20-Jul-77 13:36:14, EDIT BY HALL
;FIX TYPOS IN TESTING USER GROUP NUMBERS
;<HURLEY>JSYSF.MAC.283, 19-Jul-77 16:56:03, EDIT BY HALL
;MAKE CRDIR DELETE RETURN CORRECT ERROR CODE
;<HURLEY>JSYSF.MAC.282, 19-Jul-77 16:07:42, EDIT BY HURLEY
;<HURLEY>JSYSF.MAC.281, 19-Jul-77 15:40:18, EDIT BY HURLEY
;<HURLEY>JSYSF.MAC.280, 19-Jul-77 14:37:12, EDIT BY HURLEY
;ADD SUPPORT FOR PUNCTUATING ATTRIBUTE STRINGS WITH JFNS
;<3-MONITOR>JSYSF.MAC.278, 15-Jul-77 10:12:21, EDIT BY HALL
;TCO 1813 - ALLOW PARTIAL RECOGNITION IN RCDIR AND RCUSR
;MOVE BEGINNING OF CRDIR FROM JSYSA
;<3-MONITOR>JSYSF.MAC.277, 13-Jul-77 17:12:33, Edit by MACK
;TCO 1822 - SACTF CHANGES TO SUPPORT ACCOUNT VALIDATION
;<3-MONITOR>JSYSF.MAC.275, 12-Jul-77 13:39:56, EDIT BY HALL
;MORE ON PREVIOUS EDIT
;<3-MONITOR>JSYSF.MAC.274, 12-Jul-77 12:58:31, EDIT BY HALL
;TCO 1740 - MADE SIBE RETURN +2 WHEN LCKTTY FAILS
;<3-MONITOR>JSYSF.MAC.273, 12-Jul-77 00:03:14, Edit by MCLEAN
;MAKE MXDIRN MEMORY LOCATION
;<3-MONITOR>JSYSF.MAC.272,  9-Jul-77 13:11:49, EDIT BY HALL
;TCO 1812 - MORE ON PREVIOUS EDIT
;<3-MONITOR>JSYSF.MAC.271,  8-Jul-77 17:15:19, EDIT BY HALL
;TCO 1812 - FIX BUG IN PREVIOUS EDIT
;<3-MONITOR>JSYSF.MAC.270,  7-Jul-77 17:28:46, EDIT BY HALL
;TCO 1812 - MAKE CRDIR DISALLOW CREATION OF LOGIN SUBDIRECTORY UNDER FILES-ONLY
;	SUPERIOR
;MADE CRDIR6 CHECK/INDICATE RELEASE OF FREE SPACE
;<3-MONITOR>JSYSF.MAC.269,  7-Jul-77 12:09:46, EDIT BY HURLEY
;FIX CHKENQ TO ONLY LOOK AT DSK JFNS
;<3-MONITOR>JSYSF.MAC.268,  5-Jul-77 14:26:56, EDIT BY HURLEY
;MAKE NON-EXISTENT MAGTAPE DRIVES ASSIGNED TO JOB 0
;<3-MONITOR>JSYSF.MAC.267,  1-Jul-77 17:00:24, EDIT BY BOSACK
;DONT INCREMENT ROOT-DIR QUOTAS ON DELETE OF A DIRECTORY
;<3-MONITOR>JSYSF.MAC.266,  1-Jul-77 14:22:54, EDIT BY OSMAN
;MAKE SURE RCDIR DOESN'T TRY TO LOOK UP DIR WHEN STR NOT MOUNTED
;<3-MONITOR>JSYSF.MAC.265, 23-Jun-77 10:26:09, EDIT BY HURLEY
;FIX CHFDB TO BE LEGAL FOR WRITER OF NEW FILE TO GET OWNER RIGHTS
;<3-MONITOR>JSYSF.MAC.264, 22-Jun-77 11:23:38, EDIT BY HALL
;TEMPORARY CHANGE TO CRDIR SO USERS CAN'T CREATE SUBDIRECTORIES
;<3-MONITOR>JSYSF.MAC.263, 14-Jun-77 14:35:49, EDIT BY OSMAN
;CHANGE RCDIR TO GIVE RC%NOM INSTEAD OF ITRAP ON STRUCTURE NOT MOUNTED
;<3-MONITOR>JSYSF.MAC.262, 13-Jun-77 16:54:28, EDIT BY HALL
;TCO 1813 - ADDED NEW ENTRY TO JFNSS FOR PRINTING DOT WITHOUT
;	CTRL/V WHEN PRINTING DIRECTORY NAME
;<3-MONITOR>JSYSF.MAC.261,  9-Jun-77 22:08:57, EDIT BY MURPHY
;PERFORMANCE ENHANCEMENTS
;<3-MONITOR>JSYSF.MAC.260,  6-Jun-77 23:22:40, EDIT BY BOSACK
;<3-MONITOR>JSYSF.MAC.259,  3-Jun-77 11:21:53, EDIT BY HALL
;FIX TYPO IN LEN'S EDIT
;<1BOSACK>JSYSF.MAC.258,  2-Jun-77 22:18:17, EDIT BY BOSACK
;CAUSE JFNS TO NOT RETURN LEADING TAB BEFORE FIRST FIELD
;<1BOSACK>JSYSF.MAC.257, 31-May-77 23:29:29, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.256, 31-May-77 23:16:43, EDIT BY BOSACK
;ADD CREATABLE USER GROUP CHECKING TO CRDIR
;<1BOSACK>JSYSF.MAC.255, 31-May-77 03:42:05, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.254, 31-May-77 03:05:16, EDIT BY BOSACK
;<3-MONITOR>JSYSF.MAC.250, 27-May-77 17:03:24, EDIT BY HALL
;FIX BUG IN PREVIOUS EDIT
;<3-MONITOR>JSYSF.MAC.249, 27-May-77 16:36:46, EDIT BY HALL
;CLEAN UP ERROR HANDLING IN RCDIR
;<3-MONITOR>JSYSF.MAC.248, 23-May-77 14:25:11, EDIT BY HALL
;CLEAN UP COMMENTS ON CKJFTT
;<1BOSACK>JSYSF.MAC.247, 15-May-77 19:10:37, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.246, 15-May-77 05:57:41, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.245, 15-May-77 05:41:29, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.244, 15-May-77 05:19:53, EDIT BY BOSACK
;ALLOW CRDIR TO CREATE SUBDIRECTORIES
;<3-MONITOR>JSYSF.MAC.243, 10-May-77 15:23:40, EDIT BY MILLER
;CHANGE SIBE TO CALL JFNID(P3) BEFORE LOOKING AT FILCNT
;<1BOSACK>JSYSF.MAC.253, 31-May-77 02:50:45, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.252, 31-May-77 00:30:54, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.251, 31-May-77 00:01:29, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.250, 30-May-77 23:05:25, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.249, 30-May-77 21:46:03, EDIT BY BOSACK
;ADD DIR/SUBDIR QUOTA SHARING LOGIC TO CRDIR
;<1BOSACK>JSYSF.MAC.248, 30-May-77 19:38:20, EDIT BY BOSACK
;CHANGE CRDIR ACCESS CHECKING FOR SUBDIRS
;<1BOSACK>JSYSF.MAC.247, 15-May-77 19:10:37, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.246, 15-May-77 05:57:41, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.245, 15-May-77 05:41:29, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.244, 15-May-77 05:19:53, EDIT BY BOSACK
;ALLOW CRDIR TO CREATE SUBDIRECTORIES
;<3-MONITOR>JSYSF.MAC.243, 10-May-77 15:23:40, EDIT BY MILLER
;CHANGE SIBE TO CALL JFNID(P3) BEFORE LOOKING AT FILCNT
;<3-MONITOR>JSYSF.MAC.242, 10-May-77 13:19:57, EDIT BY HURLEY
;TCO 1797 - ALLOW CHFDB TO WORK IF FILE IS BEING CREATED
;<3-MONITOR>JSYSF.MAC.241,  2-May-77 20:34:21, EDIT BY BOSACK
;<3-MONITOR>JSYSF.MAC.240,  2-May-77 13:59:13, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.239,  2-May-77 12:26:05, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.238,  2-May-77 12:15:39, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.237,  2-May-77 10:33:19, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.236,  2-May-77 10:27:10, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.235,  2-May-77 10:10:44, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.234,  2-May-77 08:59:22, EDIT BY MILLER
;CHECK FOR FE DEVICE IN SIBE
;<3-MONITOR>JSYSF.MAC.233, 29-Apr-77 17:07:56, EDIT BY HURLEY
;ADD ATTRIBUTES
;<3-MONITOR>JSYSF.MAC.232, 19-Apr-77 17:51:55, EDIT BY HELLIWELL
;REMOVE NOINT BEFORE DEVICE SERVICE ROUTINE CALL IN MOUNT JSYS
;<3-MONITOR>JSYSF.MAC.231,  6-Apr-77 20:57:00, Edit by HESS
; MORE TCO #1770 FOR CLOSF
;<3-MONITOR>JSYSF.MAC.230,  6-Apr-77 14:29:48, EDIT BY HALL
;TCO 1740 - MAKE OPENF NOT CHANGE DEVICE TABLES FOR 'TTY:'
;	MAKE OPENF SUCCEED WITHOUT DOING ANYTHING FOR JFN'S 100 AND 101
;	AND (0,,-1)
;<3-MONITOR>JSYSF.MAC.229,  6-Apr-77 11:25:57, Edit by HESS
;TCO #1770 - ADD BLOCK CO-ROUTINES TO OPENF & MTOPR
;<3-MONITOR>JSYSF.MAC.228, 31-Mar-77 18:32:37, EDIT BY HALL
;TCO 1740 - BUG FIX IN ASND JSYS WHEN ASSIGNING TERMINAL
;<1BOSACK>JSYSF.MAC.227, 30-Mar-77 15:13:58, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.226, 27-Mar-77 22:25:55, EDIT BY BOSACK
;<1BOSACK>JSYSF.MAC.225, 27-Mar-77 22:06:51, EDIT BY BOSACK
;ADD WILDCARD/STEP CODE TO RCDIR
;<1BOSACK>JSYSF.MAC.224, 27-Mar-77 20:10:35, EDIT BY BOSACK
;<3-MONITOR>JSYSF.MAC.223, 25-Mar-77 10:14:12, EDIT BY HALL
;TCO 1740 - BUG FIX IN CLOSF - WAS CALLING RELDEV WITH WRONG AC
;<3-MONITOR>JSYSF.MAC.222, 15-Mar-77 14:17:33, Edit by HESS
;ADD CODE TO OBEY <BLKF> IN OPENF
;<3-MONITOR>JSYSF.MAC.221,  9-Mar-77 16:03:38, EDIT BY HALL
;TCO 1740 - MAKE OPENF HANDLE FAILURE FROM RELDEV
;<3-MONITOR>JSYSF.MAC.220,  8-Mar-77 21:46:14, EDIT BY BOSACK
;FIX RCDIR REPEATING CHARS ON RECOGNITION
;<3-MONITOR>JSYSF.MAC.219,  2-Mar-77 18:58:18, EDIT BY HALL
;TCO 1740 - FURTHER BUG FIX IN ASND
;<3-MONITOR>JSYSF.MAC.218,  2-Mar-77 16:35:41, EDIT BY HALL
;TCO 1740 - BUG FIX TO ASND (WAS INDEXING INTO DEVICE TABLES INCORRECTLY)
;<3-MONITOR>JSYSF.MAC.217, 25-Feb-77 10:52:41, Edit by HESS
;TCO 1736 - CHANGE .MTOPR TO WORK IF DEVICE IS ASSIGNED.
;<3-MONITOR>JSYSF.MAC.216, 24-Feb-77 16:13:39, EDIT BY HALL
;TCO 1740 - MOVED ASND JSYS HERE FROM JSYSA BECAUSE IT NEEDS DEV
;<3-MONITOR>JSYSF.MAC.215, 23-Feb-77 20:18:39, EDIT BY HALL
;TCO 1740 - CHANGES TO BKJFN, DVCHR,OPENF, AND CLOSF RELATED TO
;TELETYPE REORGANIZATION
;<3-MONITOR>JSYSF.MAC.214,  7-Feb-77 21:06:18, Edit by HESS
;<3-MONITOR>JSYSF.MAC.213,  5-Feb-77 01:36:59, EDIT BY BOSACK
;CAUSE CRDIR TO INCREMENT/DECREMENT SUBDIR COUNT
;<3-MONITOR>JSYSF.MAC.212,  2-Feb-77 17:28:43, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.211, 31-Jan-77 16:49:18, Edit by HESS
;TCO 1724 - FIX RLJFN WITH -1 ARGUMENT
;<3-MONITOR>JSYSF.MAC.210, 31-Jan-77 00:57:19, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.209, 31-Jan-77 00:48:21, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.208, 22-Jan-77 20:25:49, EDIT BY BOSACK
;ADD SUPERIOR DIR NUMBER TO IDXTAB
;<3-MONITOR>JSYSF.MAC.207, 20-Jan-77 22:06:02, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.206, 20-Jan-77 20:15:50, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.205, 19-Jan-77 19:45:05, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.204, 15-Jan-77 19:42:37, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.203, 13-Jan-77 17:01:04, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.202, 13-Jan-77 16:57:15, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.201, 13-Jan-77 16:47:50, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.200, 13-Jan-77 13:10:34, EDIT BY HELLIWELL
;GIVE PROPER ERROR RETURN FOR DECTAP ASSIGNED TO OTHER JOB ON RDDIR
;<3-MONITOR>JSYSF.MAC.199, 11-Jan-77 00:17:00, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.198, 27-Dec-76 17:33:34, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.197, 14-Dec-76 12:21:43, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.196, 10-Dec-76 16:27:45, EDIT BY HURLEY
;<3-MONITOR>JSYSF.MAC.195,  9-Dec-76 03:49:13, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.194,  8-Dec-76 23:16:14, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.193,  8-Dec-76 21:12:16, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.192,  8-Dec-76 09:11:32, EDIT BY HURLEY
;MAKE MOUNT AND DSMNT ALWAYS CALL DEPENDENT SERVICE ROUTINES
;<3-MONITOR>JSYSF.MAC.191,  8-Dec-76 01:06:20, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.190,  6-Dec-76 01:31:04, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.189,  4-Dec-76 18:32:37, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.188,  4-Dec-76 03:02:29, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.187,  2-Dec-76 03:30:32, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.186,  1-Dec-76 19:00:57, Edit by MCLEAN
;<2-MONITOR>JSYSF.MAC.179,  1-Dec-76 11:54:48, EDIT BY HELLIWELL
;FIXUP MOUNT JSYS
;<3-MONITOR>JSYSF.MAC.184, 26-Nov-76 19:29:47, Edit by MCLEAN
;TCO 1669 EXTENDED ADDRESSING
;<3-MONITOR>JSYSF.MAC.183, 26-Nov-76 19:22:37, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.182, 26-Nov-76 19:21:17, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.181, 26-Nov-76 19:09:32, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.180, 26-Nov-76 17:57:33, Edit by MCLEAN
;<3-MONITOR>JSYSF.MAC.179, 26-Nov-76 17:53:23, Edit by MCLEAN
;<2-MONITOR>JSYSF.MAC.178, 24-Nov-76 19:39:48, EDIT BY HURLEY
;MAKE THE MOUNT JSYS BE A SKIPPING NOP
;<2-MONITOR>JSYSF.MAC.177, 17-Nov-76 14:56:20, EDIT BY HALL
;IN RCDIR CHANGED SOUT OF DIRECTORY STRING TO ILDB/IDPB LOOP
;<MACK>JSYSF.MAC.176, 11-Nov-76 14:31:49, Edit by MACK
;MAKE CRDIR USE JSVAR FOR TEMP STORAGE
;<2-MONITOR>JSYSF.MAC.175, 14-Nov-76 19:38:51, EDIT BY HURLEY
;REMOVED STDIR JSYS
;<2-MONITOR>JSYSF.MAC.174, 12-Nov-76 17:01:11, EDIT BY HALL
;FIXED CRDIR AND RCDIR TO GET ENOUGH FREE SPACE FOR THEIR STRINGS
;<2-MONITOR>JSYSF.MAC.173, 10-Nov-76 12:32:09, EDIT BY HALL
;IN RCDIR CHANGED SOUT OF DEVICE STRING TO ILDB/IDPB LOOP
;<2-MONITOR>JSYSF.MAC.172,  8-Nov-76 15:34:08, Edit by HESS
;<2-MONITOR>JSYSF.MAC.171,  8-Nov-76 13:28:54, EDIT BY KIRSCHEN
;FIX TYPO IN CRDIR
;<2-MONITOR>JSYSF.MAC.170,  8-Nov-76 13:18:58, EDIT BY KIRSCHEN
;MAKE RCDIR USE JSVAR INSTEAD OF TRVAR
;<2-MONITOR>JSYSF.MAC.169,  5-Nov-76 16:28:25, Edit by MACK
;STKVAR VARIABLES AT CHKNUM: NOW STORED IN JSB FREE SPACE
;<2-MONITOR>JSYSF.MAC.168,  4-Nov-76 18:41:59, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.167,  4-Nov-76 15:47:11, Edit by MACK
;GETDIR RETURNS ERROR IF DIRECTORY STRING ISN'T PUNCTUATED PROPERLY
; I.E. ONLY A VALID TERMINATOR ( > OR ] ) IS ACCEPTABLE
;<2-MONITOR>JSYSF.MAC.166,  4-Nov-76 15:19:10, EDIT BY HALL
;MADE RCDIR RETURN BETTER MESSAGE ON UNKNOWN STRUCTURE NAME
;<2-MONITOR>JSYSF.MAC.165,  4-Nov-76 14:49:38, Edit by MACK
;TCO 1648 - RCDIR GIVES AMBIGUOUS RETURN IF RECOGNITION IS ATTEMPTED ON A STR NAME
;<2-MONITOR>JSYSF.MAC.164,  4-Nov-76 12:45:48, Edit by MACK
;TCO 1647 - SUCCESSFUL CALL TO RCUSR RETURNS SAME BITS AS RCDIR
;<2-MONITOR>JSYSF.MAC.163,  2-Nov-76 13:50:43, Edit by MACK
;TCO 1641 - ALL RETURNS FROM CHKNUM: CALL ULKSTR
;<2-MONITOR>JSYSF.MAC.162, 29-Oct-76 11:29:19, EDIT BY HURLEY
;MAKE JFNS, RFBSZ, AND RFPTR WORK WITH A JFN ON A DISMOUNTED STR
;<2-MONITOR>JSYSF.MAC.161, 29-Oct-76 08:32:19, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.160, 27-Oct-76 15:23:38, Edit by MACK
;<2-MONITOR>JSYSF.MAC.159, 27-Oct-76 14:32:26, Edit by MACK
;TCO 1633 - CRDIR CLEANS UP AFTER LOSING DIRECTORY PROPERLY
;<2-MONITOR>JSYSF.MAC.158, 27-Oct-76 10:51:49, Edit by MACK
;TCO 1632 - GETDIR KEEPS CORRECT COUNT OF CHARACTERS MOVED IN ALL CASES
;<2-MONITOR>JSYSF.MAC.157, 26-Oct-76 17:40:32, EDIT BY HURLEY
;MAKE DVCHR RETURN -1 IN RH OF AC3 FOR STRUCTURES
;<2-MONITOR>JSYSF.MAC.156, 20-Oct-76 18:24:07, EDIT BY HURLEY
;MAKE RCDIR ACCEPT "DSK" AS AN ARGUMENT
;<2-MONITOR>JSYSF.MAC.155, 19-Oct-76 11:58:26, Edit by HESS
;TEST FOR STRX06 ERROR FROM DIRST IN GFUST
;<2-MONITOR>JSYSF.MAC.154, 14-Oct-76 19:32:33, EDIT BY HURLEY
;TCO 1598 - ADD OF%OFL BIT TO OPENF
;<2-MONITOR>JSYSF.MAC.153, 14-Oct-76 16:12:02, EDIT BY HURLEY
;MAKE RCDIR GIVE AMBIGUOUS RETURN IF NO STRING IS TYPED AFTER "<"
;<2-MONITOR>JSYSF.MAC.152, 13-Oct-76 16:21:08, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.151, 11-Oct-76 09:26:37, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.150, 11-Oct-76 08:15:03, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.149,  5-Oct-76 12:58:54, EDIT BY HALL
;MADE STDIR DO AN ITERR AND BUGCHK
;<2-MONITOR>JSYSF.MAC.148,  5-Oct-76 11:58:35, EDIT BY HURLEY
;FIX JFNS TO NOT TYPE OUT THE CONNECTED STR NAME
;<2-MONITOR>JSYSF.MAC.147,  4-Oct-76 11:02:37, EDIT BY MILLER
;TCO 1157. REPLCE FFUPIF BUGHLT WITH ERROR RETURN
;<2-MONITOR>JSYSF.MAC.146, 30-Sep-76 15:53:01, EDIT BY MILLER
;TCO 1555. PREVENT UFPGS FROM CREATING PT'S
;<2-MONITOR>JSYSF.MAC.145, 27-Sep-76 18:20:21, EDIT BY HALL
;MADE RCDIR TAKE DIRECTORY NUMBER, USER NUMBER, OR JFN
;<2-MONITOR>JSYSF.MAC.144, 24-Sep-76 16:28:23, Edit by HESS
;<2-MONITOR>JSYSF.MAC.143, 23-Sep-76 16:57:28, EDIT BY HALL
;MADE CRDIR NON-WHEEL FUNCTIONS FAIL IF DIRECTORY HAS NO PASSWORD
;<2-MONITOR>JSYSF.MAC.142, 23-Sep-76 16:49:16, Edit by HESS
;CHANGE STRUCTURE DEVICE DESIGNATORS TO STR UNIQUE CODE
;<2-MONITOR>JSYSF.MAC.141, 22-Sep-76 16:25:12, Edit by HESS
;<2-MONITOR>JSYSF.MAC.140, 21-Sep-76 12:55:51, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.139, 20-Sep-76 18:43:34, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.138, 20-Sep-76 15:42:46, EDIT BY HURLEY
;USE FILDIR(JFN) IN JFNS
;<2-MONITOR>JSYSF.MAC.137, 15-Sep-76 11:30:38, EDIT BY HALL
;MADE DELDIR PASS STRUCTURE NUMBER TO CHKOFN
;<2-MONITOR>JSYSF.MAC.136, 13-Sep-76 16:43:14, EDIT BY HALL
;MADE CRDIR ALLOW CERTAIN FUNCTIONS FOR NON-WHEEL USER
;<2-MONITOR>JSYSF.MAC.135,  7-Sep-76 13:50:40, Edit by HESS
;ADD MASK TO WOPR TO ALLOW CHANGING OF FBNPG IF WHEEL OR OPR
;<2-MONITOR>JSYSF.MAC.134,  1-Sep-76 15:05:59, Edit by HESS
;TCO 1506 - ADD STR NUMBER TO LDTAB / BUG FIXES TO GFUST/SFUST
;<2-MONITOR>JSYSF.MAC.133, 31-Aug-76 17:09:46, EDIT BY HALL
;MADE RCUSR USE RCUS0
;<2-MONITOR>JSYSF.MAC.132, 31-Aug-76 15:02:17, Edit by HESS
;<HESS>JSYSF.MAC.3, 25-Aug-76 13:50:54, Edit by HESS
;<HESS>JSYSF.MAC.1, 24-Aug-76 16:52:48, Edit by HESS
;TCO 1496 - ADD AUTHOR/LAST-WRITER STRINGS IN FDB
;<2-MONITOR>JSYSF.MAC.130, 31-Aug-76 11:35:57, EDIT BY HALL
;FIX TO NEW RCUSR CODE
;<2-MONITOR>JSYSF.MAC.129, 30-Aug-76 17:24:49, EDIT BY HALL
;FIXES TO NEW RCUSR CODE
;<2-MONITOR>JSYSF.MAC.128, 30-Aug-76 15:19:40, EDIT BY OSMAN
;<2-MONITOR>JSYSF.MAC.127, 30-Aug-76 15:07:35, EDIT BY OSMAN
;<2-MONITOR>JSYSF.MAC.126, 30-Aug-76 10:13:40, EDIT BY HALL
;CHANGES TO NEW RCUSR CODE
;<2-MONITOR>JSYSF.MAC.125, 27-Aug-76 16:52:12, EDIT BY HALL
;ADDED NEW ROUTINE TO DO RCUSR - NOT YET CALLED BY THE JSYS
;<2-MONITOR>JSYSF.MAC.124, 27-Aug-76 16:07:52, EDIT BY HALL
;MADE UPDATING OF USER'S BYTE POINTER MORE CONSISTENT IN RCDIR
;<2-MONITOR>JSYSF.MAC.123, 26-Aug-76 15:23:39, EDIT BY HALL
;MADE RCDIR RETURN UPDATED STRING POINTER AFTER CPYUSR 
;<2-MONITOR>JSYSF.MAC.122, 25-Aug-76 16:31:54, EDIT BY HALL
;FIXED RCDIR TO RECOGNIZE LOGICAL NAMES; ALSO TO DEFAULT TO CONNECTED
;DIRECTORY ON SPECIFIED STRUCTURE
;<2-MONITOR>JSYSF.MAC.121, 24-Aug-76 16:40:25, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.120, 24-Aug-76 15:18:34, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.119, 24-Aug-76 12:55:10, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.118, 23-Aug-76 17:13:32, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.117, 23-Aug-76 16:55:07, EDIT BY KIRSCHEN
;FIX CRDIR BUG- ONLY MOVE MAXLC CHARACTERS IN DIRECTORY NAME
;FIX CHKNUM IN CRDIR TO SUCCEED IF CREATING ROOT-DIRECTORY
;FIX GFUST TO RETURN NULL IF DIRECTORY NUMBER DOES NOT EXIST
;<2-MONITOR>JSYSF.MAC.116, 20-Aug-76 17:17:55, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.115, 20-Aug-76 15:56:40, EDIT BY KIRSCHEN
;MAKE CRDIR CHECK: CLOSING DIR BRACKET; DIR # IF NEW DIRECTORY;
;<2-MONITOR>JSYSF.MAC.114, 19-Aug-76 16:55:10, Edit by HESS
;<2-MONITOR>JSYSF.MAC.113, 19-Aug-76 14:24:13, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.112, 19-Aug-76 12:39:18, EDIT BY KIRSCHEN
;CHANGE CRDIR TO USE JSB FREE SPACE INSTEAD OF TRVAR
;<2-MONITOR>JSYSF.MAC.111, 18-Aug-76 15:29:26, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.110, 18-Aug-76 14:46:28, EDIT BY KIRSCHEN
;CHANGE FORMAT OF CRDIR JSYS PER MOUNTBALE STRUCTURES SPECIFICATION
;<2-MONITOR>JSYSF.MAC.109, 16-Aug-76 13:27:22, Edit by HESS
;REMOVE REFERENCES TO OLD FDB SYMBOLS (FDBXXX AND FD.XXX)
;<2-MONITOR>JSYSF.MAC.108, 13-Aug-76 17:54:12, Edit by HESS
;ADD STPPN JSYS
;<2-MONITOR>JSYSF.MAC.107, 12-Aug-76 11:15:33, EDIT BY KIRSCHEN
;TCO 1489 - MAKE GFUST RETURN A NULL IF THE AUTHOR/LAST-WRITER DOESN'T EXIST
;<2-MONITOR>JSYSF.MAC.106, 11-Aug-76 12:09:09, EDIT BY HURLEY
;FIX GFUST AND RCDIR WHEN STR IS DEFAULTED
;<2-MONITOR>JSYSF.MAC.105,  9-Aug-76 17:26:37, EDIT BY HALL
;FIXED CALLS TO ACCCHK AND DIRCHK TO USE NEW BITS
;<2-MONITOR>JSYSF.MAC.104,  8-Aug-76 17:12:21, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.103,  7-Aug-76 20:35:29, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.102,  5-Aug-76 15:45:15, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.101,  5-Aug-76 15:41:00, EDIT BY KIRSCHEN
;FIX RCDIR BUG - BAD LOOKUP POINTER BEING GIVEN TO DIRLUK
;<2-MONITOR>JSYSF.MAC.100,  5-Aug-76 10:51:34, EDIT BY KIRSCHEN
;MORE CRDIR FIXES
;<2-MONITOR>JSYSF.MAC.99,  4-Aug-76 14:34:23, EDIT BY HURLEY
;<2-MONITOR>JSYSF.MAC.98,  4-Aug-76 11:04:11, EDIT BY KIRSCHEN
;MAKE CRDIR USE 36-BIT DIRECTORY DESIGNATORS
;<2-MONITOR>JSYSF.MAC.97,  3-Aug-76 19:24:26, EDIT BY HURLEY
;EXPAND DIRECTORY NUMBERS TO 36 BITS
;<2-MONITOR>JSYSF.MAC.96,  3-Aug-76 16:30:44, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.95,  3-Aug-76 13:26:24, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.93,  2-Aug-76 09:15:06, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.92, 29-Jul-76 13:58:45, EDIT BY KIRSCHEN
;MAKE CRDIR WORK ON STRUCTURES OTHER THAN THE PUBLIC STRUCTURE
;<1MILLER>JSYSF.MAC.1, 26-Jul-76 15:46:08, EDIT BY MILLER
;REMOVE SETTING OF FILDUD TO DISC
;<2-MONITOR>JSYSF.MAC.90, 25-Jul-76 12:55:55, EDIT BY HALL
;FIXED ERROR IN JFNS FROM PREVIOUS EDIT
;<2-MONITOR>JSYSF.MAC.89, 24-Jul-76 14:23:09, EDIT BY HALL
;CHANGED REFERENCES TO JOBDNO TO CALL GTCSCD FOR CONNECTED DIRECTORY
;<2-MONITOR>JSYSF.MAC.88, 20-Jul-76 12:22:38, EDIT BY MILLER
;SET FILDUD BIT IS STS IF USER REQUESTS OF%DUD ON OPENF
;<2-MONITOR>JSYSF.MAC.87, 19-Jul-76 09:29:14, EDIT BY MILLER
;FIX RLJFN TO AVOID STR LOCK CODE ON GARBAGE JFN
;<2-MONITOR>JSYSF.MAC.85, 15-Jul-76 11:44:52, EDIT BY KIRSCHEN
;FIX COMMENT AT HEAD OF RCDIR
;<2-MONITOR>JSYSF.MAC.84,  8-Jul-76 19:24:13, EDIT BY HURLEY
;MORE OF TCO 1323 - FIX RCUSR TO GET STRING POINTER FROM AC 2
;<2-MONITOR>JSYSF.MAC.83,  7-Jul-76 14:40:52, EDIT BY KIRSCHEN
;MAKE RCDIR RETURN COMPLETE DIRECTORY DESIGNATOR
;<1MILLER>JSYSF.MAC.10, 15-Jul-76 18:44:31, EDIT BY MILLER
;<1MILLER>JSYSF.MAC.9, 15-Jul-76 18:33:43, EDIT BY MILLER
;<1MILLER>JSYSF.MAC.8, 15-Jul-76 18:23:50, EDIT BY MILLER
;<1MILLER>JSYSF.MAC.7, 15-Jul-76 18:16:13, EDIT BY MILLER
;<1MILLER>JSYSF.MAC.6, 13-Jul-76 13:40:41, EDIT BY MILLER
;ADD FILCOD TO SWJFNT TABLE
;<1MILLER>JSYSF.MAC.5,  8-Jul-76 19:44:35, EDIT BY MILLER
;FIX SWJFN TO CALL LUNLKF
;<1MILLER>JSYSF.MAC.4,  7-Jul-76 14:30:14, EDIT BY MILLER
;ADD SOME COMMENTS TO CHKENQ
;<1MILLER>JSYSF.MAC.3,  7-Jul-76 12:29:09, EDIT BY MILLER
;<1MILLER>JSYSF.MAC.2,  6-Jul-76 15:31:08, EDIT BY MILLER
;<1MILLER>JSYSF.MAC.1,  6-Jul-76 15:11:56, EDIT BY MILLER
;<2-MONITOR>JSYSF.MAC.82, 24-Jun-76 09:50:08, EDIT BY HURLEY
;TCO 1454 - ALLOW FB%DEL TO BE CHANGED IF USER HAS WRITE ACCESS
;<2-MONITOR>JSYSF.MAC.16, 21-Jun-76 17:08:24, EDIT BY MILLER
;MANULA EDIT TO REMOVE SJFN AT DELDI2
;<2-MONITOR>JSYSF.MAC.15, 21-Jun-76 16:49:55, EDIT BY MILLER
;MANUAL EDITS OF 1B
;<2-MONITOR>JSYSF.MAC.14, 21-Jun-76 15:48:10, EDIT BY OSMAN
;MORE OF TCO 1382
;<2-MONITOR>JSYSF.MAC.13, 21-Jun-76 13:56:54, EDIT BY KIRSCHEN
;MANUALLY FIX RCDIR JSYS FOR RELEASE 2
;<2-MONITOR>JSYSF.MAC.12, 21-Jun-76 13:13:51, EDIT BY MILLER
;PERFORM MANUAL MERGE OF DELDIR CHANGES FROM 1B
;<1B-MONITOR>JSYSF.MAC.78, 17-Jun-76 23:06:56, EDIT BY OSMAN
;STILL MORE OF TCO 1382
;<1B-MONITOR>JSYSF.MAC.77, 17-Jun-76 22:15:27, EDIT BY OSMAN
;MORE OF TCO 1382
;<1B-MONITOR>JSYSF.MAC.76, 17-Jun-76 21:59:24, EDIT BY OSMAN
;MORE OF TCO 1382
;<1B-MONITOR>JSYSF.MAC.75, 17-Jun-76 19:42:27, EDIT BY OSMAN
;MORE OF TCO 1382
;<1B-MONITOR>JSYSF.MAC.74, 17-Jun-76 19:33:02, EDIT BY OSMAN
;TCO 1382 FIX DVCHR TO RETURN ASSIGNER OF PTY IF CALLED WITH
;TTY WHICH IS UNAVAILABLE BECAUSE CONTROLLING PTY IS UNAVAILABLE
;<1B-MONITOR>JSYSF.MAC.73, 16-Jun-76 15:56:31, EDIT BY HURLEY
;MORE OF TCO 1386
;<1B-MONITOR>JSYSF.MAC.72, 16-Jun-76 15:04:34, EDIT BY HURLEY
;MORE OF TCO 1323
;<1B-MONITOR>JSYSF.MAC.71, 15-Jun-76 20:11:25, EDIT BY OSMAN
;MORE OF TCO 1382 (SEE DEVICE.MAC FOR BEGINNING OF TCO 1382)
;<1B-MONITOR>JSYSF.MAC.70, 15-JUN-76 13:45:43, EDIT BY KIRSCHEN
;MORE TCO 1323
;<1B-MONITOR>JSYSF.MAC.69, 14-JUN-76 15:03:56, EDIT BY OSMAN
;ADD "TCO 1413" TO COMMENT LINE ABOUT 10 LINES BELOW THIS...
;<1B-MONITOR>JSYSF.MAC.68, 11-JUN-76 18:59:50, EDIT BY HALL
;TCO 1388 - HANDLED FAILURE OF GTFDB IN DELDIR
;<1B-MONITOR>JSYSF.MAC.66, 11-JUN-76 18:19:35, EDIT BY OSMAN
;MORE OF TCO 1402
;<1B-MONITOR>JSYSF.MAC.65, 11-JUN-76 17:06:32, EDIT BY HALL
;TCO 1388 - MADE DELDIR FAIL IF DIRECTORY IS MAPPED BY ANYONE
;<1B-MONITOR>JSYSF.MAC.64, 11-JUN-76 16:23:20, EDIT BY OSMAN
;TCO 1402 - MAKE CHKTTR UNDERSTAND 600000+.DVTTY,,LINE #
;AND MAKE CHKTTY CHECK REAL JFN'S THAT REFER TO TERMINALS
;<1B-MONITOR>JSYSF.MAC.63, 11-JUN-76 13:33:41, EDIT BY OSMAN
;TCO 1413 - PREVENT OPENF FROM SETTING ANYTHING IF NO ACCESS IS REQUESTED
;<1B-MONITOR>JSYSF.MAC.62, 11-JUN-76 12:00:26, EDIT BY HALL
;TCO 1388 - ALLOW DELETING OF SICK  DIRECTORIES
;<1B-MONITOR>JSYSF.MAC.61, 11-JUN-76 10:42:32, EDIT BY JMCCARTHY
;TCO 1382 - DON'T ALLOW ASSIGN OF PTY ASSOCIATED WITH UNAVAILABLE
;TTY AND VICE VERSA
;<1B-MONITOR>JSYSF.MAC.60, 11-JUN-76 09:57:17, EDIT BY KIRSCHEN
;<1B-MONITOR>JSYSF.MAC.59, 10-JUN-76 21:29:36, EDIT BY KIRSCHEN
;<1B-MONITOR>JSYSF.MAC.58, 10-JUN-76 21:15:09, EDIT BY KIRSCHEN
;MORE TCO 1323
;<1B-MONITOR>JSYSF.MAC.57, 10-JUN-76 15:49:40, EDIT BY JMCCARTHY
;TCO 1386 - SWJFN ATTEMPTS TO SWAP SAME JFN AND GIVES INCORRECT
;ERROR MESSAGE, "JFN NOT ASSIGNED."
;<1B-MONITOR>JSYSF.MAC.56, 10-JUN-76 14:26:02, EDIT BY HURLEY
;TCO 1395 - MAKE OPENF FAIL FOR STRING POINTERS
;TCO 1392 - ALLOW CHFDB WORK IF FILE IS OPENED FOR WRITE
;<1B-MONITOR>JSYSF.MAC.55, 10-JUN-76 10:40:19, EDIT BY KIRSCHEN
;MORE TCO 1323
;<1B-MONITOR>JSYSF.MAC.54,  9-JUN-76 18:25:17, EDIT BY HALL
;TCO 1388 - FIXED CRDIR TO ALLOW KILL OF BAD DIRECTORY
;<1B-MONITOR>JSYSF.MAC.53,  9-JUN-76 15:39:04, EDIT BY HALL
;TCO 1379 - ADDED ANDX IN GTSTS TO CLEAR UNDOCUMENTED BITS
;<1B-MONITOR>JSYSF.MAC.52,  9-JUN-76 09:10:48, EDIT BY KIRSCHEN
;<1B-MONITOR>JSYSF.MAC.51,  8-JUN-76 14:56:02, EDIT BY KIRSCHEN
;TCO 1323 - ADD RCUSR JSYS
;<1B-MONITOR>JSYSF.MAC.50,  8-JUN-76 14:15:20, EDIT BY KIRSCHEN
;<1B-MONITOR>JSYSF.MAC.49,  8-JUN-76 13:46:14, EDIT BY KIRSCHEN
;TCO 1323 - ADD RCDIR JSYS (MOVED FROM JSYSA)
;<1B-MONITOR>JSYSF.MAC.48,  4-JUN-76 09:13:36, EDIT BY KIRSCHEN
;<1B-MONITOR>JSYSF.MAC.47,  3-JUN-76 08:58:59, EDIT BY KIRSCHEN
;TCO 1323 - ADD SFUST JSYS
;<1B-MONITOR>JSYSF.MAC.46,  2-JUN-76 10:44:09, EDIT BY KIRSCHEN
;TCO 1323 - ADD GFUST JSYS
;<1B-MONITOR>JSYSF.MAC.45, 14-MAY-76 12:45:03, EDIT BY MURPHY
;TCO #1291 - MAKE CZ%ABT WORK FOR SPOOLED FILES
;<1B-MONITOR>JSYSF.MAC.2, 10-MAY-76 13:00:17, EDIT BY MILLER
;TCO 1286. UNMAP FILE WINDOW PAGE EVEN IF WON'T CLOSE
;<2-MONITOR>JSYSF.MAC.11, 17-Jun-76 12:15:50, EDIT BY MILLER
;REMOVE SJFN. ADD MLJFN
;<2-MONITOR>JSYSF.MAC.10, 15-JUN-76 13:47:10, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.9, 11-JUN-76 10:44:36, EDIT BY KIRSCHEN
;<2-MONITOR>JSYSF.MAC.8, 11-JUN-76 10:36:57, EDIT BY KIRSCHEN
;TCO 1323 - ADD RCDIR JSYS
;<2-MONITOR>JSYSF.MAC.7, 20-MAY-76 11:06:36, EDIT BY KIRSCHEN
;ELIMINATE DOUBLE SKIP RETURN FROM CALL TO DIRLUK IN STDIR
;<2-MONITOR>JSYSF.MAC.6, 19-MAY-76 09:58:19, EDIT BY KIRSCHEN
;ADD STR NUMBER TO DIRLUK CALL IN STDIR; ABOLISH DUMMY JFN BLOCK
;<2-MONITOR>JSYSF.MAC.5, 13-MAY-76 08:35:38, EDIT BY KIRSCHEN
;FIX BUGS IN STDIR
;<2-MONITOR>JSYSF.MAC.4, 12-MAY-76 13:22:39, EDIT BY KIRSCHEN
;REWRITE STDIR JSYS TO PROVIDE FULL JFN BLOCK TO DIRLUK
;<2-MONITOR>JSYSF.MAC.3, 11-MAY-76 12:39:27, EDIT BY KIRSCHEN
;ASSUME STRUCTURE 0 IN ALL CALLS TO SETDIR
;<2-MONITOR>JSYSF.MAC.2,  8-MAY-76 13:42:57, EDIT BY HALL
;MADE CRDIR FAKE A STRUCTURE NUMBER OF 0 IN CALL TO CPYBAK
;<2-MONITOR>JSYSF.ORIGINAL.2,  7-MAY-76 11:37:03, EDIT BY KIRSCHEN
;ADD STRUCTURE NUMBER TO DIRINI
;<1B-MONITOR>JSYSF.MAC.1,  6-APR-76 11:35:36, EDIT BY KIRSCHEN
;TCO # 1241 - PERMIT CLOSING FILE ENQ'ED ON ANOTHER JFN
;<1A-MONITOR>JSYSF.MAC.43,  1-APR-76 16:33:53, EDIT BY HURLEY
;TCO # 1234 - IF DEVICE IS ALLOCATED TO A JOB, DONT RELEASE ON CLOSF
;<1MONITOR>JSYSF.MAC.42, 23-MAR-76 18:37:06, EDIT BY HURLEY
;TCO 1217 - ADD RETBAD AND ERROR CODE TO CHKTTY ROUTINE
;<1MONITOR>JSYSF.MAC.41, 23-MAR-76 14:54:05, EDIT BY HURLEY
;TCO 1203 - DONT UPDATE ACCESS TIME OF MAIL.TXT DURING CRDIR
;<1MONITOR>JSYSF.MAC.40,  1-MAR-76 18:02:25, EDIT BY HURLEY
;TCO #1136 - RETURN 5B2 IN ACCOUNT NUMBER FROM GACTF
;TCO #1135 - DONT LET DLUSER PUT OLD LOGIN DATES INTO DIRECTORY
;<2MONITOR>JSYSF.MAC.39,  3-FEB-76 11:22:39, EDIT BY CROSSLAND
;MCO 50  RESTORE STS IN .SWJFN AFTER IT WAS CLOBERED BY CHKJFN
;<2MONITOR>JSYSF.MAC.38, 27-JAN-76 18:31:30, EDIT BY HURLEY
;MCO 32 - DONT DELETE MAIL.TXT IF IT ALREADY EXISTS ON A CRDIR
;<2MONITOR>JSYSF.MAC.37, 16-JAN-76 17:49:53, EDIT BY MURPHY
;<2MONITOR>JSYSF.MAC.36,  9-JAN-76 11:03:40, EDIT BY HURLEY


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

	SEARCH PROLOG
	TTITLE 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
	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
   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
; 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 <ASNDIX>
	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>)
	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
	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
	ERRJMP CFDBX1,CHFDX	;NO FDB FOR NON MDD DEVICES
	CALL GETFDB		; Get the fdb
	ERRJMP DESX3,CHFDX
	MOVEM A,CHFDBA		; SAVE FDB ADDRESS
	MOVE D,CHFDBD		; GET OFFSET
	UMOVE B,2		; Mask
	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
	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
	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
	JRST CHFDB6
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
	MOVEM B,(A)
	MOVE C,CHFDBD		;GET THE OFFSET
	CAIE C,.FBSIZ		;SETTING THE SIZE
	CAIN C,.FBBYV		;OR BYTE SIZE
	TQNN <OPNF>		;YES, IS THE FILE OPEN?
	JRST CHFDB7		;NO, DONT SET UP THE NEW LENGTH
	MOVE C,CHFDBA		;GET THE ADR OF THE FDB
	LOAD A,FBBSZ,(C)	;GET BYTE SIZE
	LOAD B,FBSIZ,(C)	;GET LENGTH OF FILE
	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

; Access tables for chfdb

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

WRTR:	0			;FBTYP ,, FBLEN
	FB%NOD			;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			;FBBK3
	0			;FBBK4
	0			;FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
;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%FCF	;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
	310000,,000000		; BACKUP (ALLOW ARCHIVE FLAGS - BSYS)
	0
	0
	0
	0
	777777777777		;FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR

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

WOPR:	0			;FBTYP ,, FBLEN
	FB%PRM+FB%TMP+FB%DEL+FB%NOD+FB%FCF	;FBFLG
	0			;FBEXL
	0			;FBADR
	0			;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		;BACKUP WORDS
	777777777777
	777777777777
	777777777777
	777777777777
	0			;USER SETTABLE WORD
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
; 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
	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
	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
	HRRZS A
	CALL FLOCK		;LOCK THE FORK STRUCTURE
	CALL MAPFKH		; Call routine to map over the fork hdl
	 CALL CLZFF1		; Call this for each fork
	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
	CALL UNLCKF	;YES, 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(CHK,CLZABF,<CLZFFW: SERVICE ROUTINE BLOCKED ON AN ABORT CLOSE>)
	CALL UNLDIS		;NO, GO BLOCK
	POP P,A			;CLEAR OUT STACK
	POP P,JFN		;...
	JRST CLZFF2		;TRY AGAIN
;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(CHK,BLKF3,<CLZDO: BLKF SET BEFORE CALL TO SERVICE ROUTINE>)
	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
	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:	PUSH P,T2		;SAVE JFN
	CALL UNLDIS		;UNLOCK AND BLOCK
	POP P,JFN		;RESTORE JFN
	CALL CHKJFD
	 RETBAD ()
	 JFCL
	 RETBAD (DESX3)
	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

.CRDIR::MCENT
	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%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
	JSVAR <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?
	AND B,[CD%NCE+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
	SETOM CRDIRD		;INITIALIZE DIR NUMBER
	SETZM CRDIRF		;ASSUME DIR NUMBER NEED NOT BE CHECKED LATER
	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

	MOVE B,A		;COPY POINTER TO NAME
	MOVX A,RC%EMO		;STRING MUST MATCH EXACTLY
	RCDIR			;RECOGNIZE DIRECTORY NAME
	 ERJMP [CALL CRDIR6	;FAILED, CLEAN UP
		RETBAD (CRDIX5)] ;RETURN ERROR CODE
	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
	MOVEM C,CRDIRD		;SAVE DIRECTORY NUMBER RETURNED
	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 A,[POINT 7,CRDIRS]
	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 ?
	JRST CRDI0D		;YES, GO PROCESS DIRECTORY STRING

;A DEVICE NAME WAS GIVEN. PUT THE DEVICE NAME IN THE GTJFN STRING,
;CONVERTING LOGICAL NAME TO CORRESPONDING DEVICE NAME

	MOVE A,CRDIRN		;CONVERT LOGICAL NAMES TO PHYSICAL
	STDEV			;...
	 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,CDI0B2		;AT END OF 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:	MOVEI D,.CHDT1		;ASSUME TYPE 1 PUNCTUATION (ANGLE BRACKETS)
	LDB C,B			;GET OPENING BRACKET
	CAIE C,.CHDI1		;TYPE 1 PUNCTUATION ?
	MOVEI D,.CHDT2		;NO, GET TYPE 2 CLOSING BRACKET (SQUARE BRACKET)
	MOVEM D,CRDIRB		;SAVE TERMINATING BRACKET
	MOVEM A,CRDIRT		;SAVE DESTINATION POINTER FOR NEXT SOUT

;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,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
	CAMLE B,C		; ...
	ERRJMP(CRDI14,CRDI0I)	;EXCEEDED SUPERIOR LOQ

;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
	CAMLE B,C		;WILL IT FIT?
	ERRJMP(CRDI13,CRDI0I)	;NO - SUPERIOR LIQ EXCEEDED

;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(HLT,GTFDB6,<CRDI0A: CANNOT DO GETFDB ON ROOT-DIRECTORY >)
		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		; ???
	JRST CRDR1B		;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

	MOVE A,CRDSUP		;DECREMENT QUOTAS BY DEFAULTS
	CALL SETDIR		;MAP SUPERIOR
	 JRST CRDIR4		;FAILED
	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
CRDIAC:	INCR DRSDC,(Q1)		;COUNT ANOTHER SUBDIRECTORY
	CALL UPDDIR		;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(CHK,CRDSDF,<CRDIR1: SETDIR FAILED ON NEW DIRECTORY>)
		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
	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

	LOAD A,DRLIQ,(Q1)	;GET CURRENT LIQ
	UMOVE B,.CDLIQ(Q2)	;GET USERS VALUE
	TXNN Q3,CD%LIQ		;BEING SET?
	MOVE B,A		;NO - NO CHANGE
	SUB A,B			;COMPUTE DELTA
	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
	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

	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

;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(CHK,CRDBAK,<CRDIR3: COULD NOT MAKE BACKUP COPY OF ROOT-DIRECTORY>)
		JRST .+1]
	;..
;MAKE THE MESSAGE FILE IF DIRECTORY IS NOT FILES-ONLY

	;..
CRDR3C:	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,A		;CLEAR DELF FLAGS
	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(CHK,CRDOLD,<CRGDGB: OLD FORMAT CRDIR IS ILLEGAL>)
		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(CHK,CRDNOM,<CRDIR-FAILED TO MAKE MAIL.TXT FILE>)
	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		; ...

;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?
	JRST [	MOVEI D,CRDI19	;YES. DON'T ALLOW IT
		JRST DELDI3]	;GO CLEAN UP AND FAIL
	MOVE A,B		;A/(UNIQUE CODE,,DIRECTORY) TO DELETE
	CALL SETDIR		;MAP THIS DIRECTORY
	 JRST [	SETOM CRDIRF	;ASSUME DIR IS BAD AND BLUNDER ON
		JRST DELDI2]	; ...

;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

;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)
	 RETBAD(CRDIX6)		;YES. CAN'T DELETE THE FILE, THEN

;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

DELDI4:	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?
	BUG(INF,DELBDD,<DELDIR: BAD DIRECTORY DELETED. REBUILD BIT TABLE>)
	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(CHK,CRDBK1,<CRDIR4:COULD NOT MAKE BACKUP COPY OF ROOT-DIRECTORY>)
		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

CKLIQ:	ACVAR <W1>
	LOAD W1,DRLIQ,(Q1)
	JRST CKLQ1

CKLOQ:	ACVAR <W1>
	LOAD W1,DRLOQ,(Q1)
CKLQ1:	TXNN W1,1B0
	TXNN W1,1B1
	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
	HRLI T2,0(T4)		;ZERO THE FIRST PAGE OF THE DIR
	HRRI T2,1(T4)		;THIS WORKS EVEN IF IN ANOTHER SECT.
	SKIPGE EXADDR		;WANNA BET *****MICROCODE BUG*****
	JRST [	MOVEI 1,1000	;TRY XBLT HERE
		HRLZI 2,2
		MOVE 3,2
		CALL XBLTA
		JRST .+2]
	BLT T2,PGSIZ-1(T4)	; BECAUSE OF EFFECTIVE ADR OF THE BLT
	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
	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/	JFN
; 2/	NUMBER OF VERSIONS TO KEEP
;
;RETURNS +1 - ERROR
;	+2 - SUCCESS, NUMBER OF VERSIONS DELETED IN 2

.DELNF:: MCENT
	UMOVE JFN,1
	CALL CHKJFN		;CHECK THE JFN
	 JRST GBGJFN
	 JFCL
	 ERUNLK DESX4		;TTY OF BYTE ILLEGAL
	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
	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		;*****TEMP FIX (BUGS)
	CALL @DSMD(P3)		;CALL P3ICE 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
	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 [	UMOVEM JFN,1
		JRST DVCHR1]
	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>)
	CALL UNLCKF
	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
	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(CHK,DVCHRX,<DVCHR1 - UNEXPECTED CHKDES FAILURE WITHIN .DVCHR>)
	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 #
	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
	JFCL
	 JFCL
	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:	1	; Jfn
;	FFFFP
; Return
;	+1
;	1	; Jfn.pn of first free page

.FFFFP::MCENT
	HRLZS A
FFFFPL:	RPACS
	JUMPE B,FFFFP1
	AOJA A,FFFFPL

FFFFP1:	UMOVEM A,1
	JRST MRETN
; 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:	UMOVE JFN,1
	CALL CHKJFN
	 ITERR()
	 JFCL
	 ITERR(DESX4)
	MOVE A,STS
	ANDI A,17
	TQZE <BLKF>		;BLKF MUST BE ZERO BEFORE CALL
	BUG(CHK,BLKF4,<.GDSTS: BLKF SET BEFORE CALL TO DEVICE ROUTINE>)
	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
; Get fdb entry
; Call:	1	JFN
;	LH(2)	; Number of words to read
;	RH(2)	; First word to read
;	3	; Location to store words
;	GTFDB

.GTFDB::MCENT
	UMOVE A,2
	HLRZ B,A		; Get count
	HRRZS A			; Offset
	CAIL A,.FBLEN
	ITERR(GFDBX1)		; Offset too big
	ADD A,B
	CAIE B,0		; 0 words illegal
	CAILE A,.FBLEN
	ITERR(GFDBX2)		; Count too big
	UMOVE C,3		;GET AREA TO STORE RESULT
	XCTU [MOVES 0(C)]	;MAKE SURE IT WRITTABLE
	ADDI C,-1(B)		;GET LAST WORD
	XCTU [MOVES 0(C)]	;AND THIS ONE AS WELL
	UMOVE JFN,1
	CALL CHKJFN		; Check the jfn
	 ITERR()		; Garbage
	 JFCL
	 ITERR(DESX4)		; Tty or byte illegal
	TQNE <ASTF>
	 ITERR(DESX7,<CALL UNLCKF>)
	HRRZ A,NLUKD(P3)	; Get name lookup dispatch
	CAIE A,MDDNAM		; Must be mddnam
	ITERR(GFDBX1,<CALL UNLCKF>) ; Cannot read fdb for device
	CALL GETFDB		; Get pointer to the fdb
	 ITERR(DESX3,<CALL UNLCKF>)
	EXCH A,B		; SET UP FROM ADDRESS
	UMOVE A,2		; FIND OFFSET
	ADDI B,0(A)		; ADD OFFSET POINTER TO FDB
	UMOVE C,3		; To address
	HLRZS A			; Count
	CALL BLTMU		; BLT FROM MONITOR TO USER
	CALL USTDIR
	CALL UNLCKF
	JRST MRETN
; Get open file status
; Call:	1	; Jfn
;	GTSTS
; Return
;	+1
;	2	; Status word as in filsts

.GTSTS:: MCENT
	NOINT
	UMOVE 1,1
	JUMPLE 1,GTST1
	CAIE 1,.PRIIN		;PRIMARY I/O?
	CAIN 1,.PRIOU		;OR THE OUTPUT FORM?
	JRST GTST1		;YES. DO IT THE SLOW WAY
	CAML 1,MAXJFN
	 JRST GTST1
	IMULI 1,MLJFN		;CONVERT TO INTERNAL INDEX
	AOSE FILLCK(1)
	JRST GTST2
	MOVE 2,FILSTS(1)
	TXNN 2,NAMEF
	SETZ 2,
	ANDX 2,DOCSTS		;CLEAR ALL UNDOCUMENTED BITS
	SETOM FILLCK(1)
	UMOVEM 2,2
	OKINT
	JRST MRETN

GTST2:	UMOVE 1,1		;GET BACK ORIGINAL JFN
GTST1:	OKINT
	MOVE JFN,1
	CALL CHKJFD
	 JRST GTSTS1		; Illegal, return 0
	 JRST GTSTS2		; Illegal, return 0
	 JRST GTSTS2		; Illegal, return 0
	CALL UNLCKF
	UMOVEM STS,2
	JRST MRETN

GTSTS2:	CALL UNLCKF
GTSTS1:	XCTU [SETZM 2]
	JRST MRETN
; 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==100		;TEMP FLAG FOR DIRECTORY DEVICE
	JS%TM2==20		;TEMP FLAG FOR MULTIPLE DIR DEV
	JS%TM3==40		;TEMP FLAG 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,
	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]
	HLRZ A,FILDDN(JFN)	; Get pointer to device block
	MOVN B,(A)
	HRLI A,-2(B)
	CALL DEVLUX
	 SETZ A,
	TLNE A,(DV%DIR)
	TROA Q3,JS%TM1
	TRZ Q3,JS%TM1
	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
	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
	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 [	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 [	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:	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"P"
	CALL PUNCT
	TQNE <ASTF>		; PARSE ONLY?
	SKIPA A,FILPRT(JFN)	; YES. GET IT
	MOVE A,0(P)		; Get protection
	MOVEI C,10
	CALL JFNSN

;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?
	JRST MRETN		;YES. ALL DONE THEN
	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 JFNS7
	MOVEI B,PNCATT
	CALL PUNCT
	MOVEI B,"T"
	CALL BOUTA
	; ..
;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
;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
	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
;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

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