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