Google
 

Trailing-Edge - PDP-10 Archives - bb-m080u-sm_t20_v7_0_23_mon_src_mod - monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
; Edit= 9101 to DISC.MAC on 8-Jun-89 by GSCOTT
;Prevent looping with FILBATs if ERROR.SYS is damaged. 
; Edit= 9094 to DISC.MAC on 30-May-89 by WONG, for SPR #22065 (TCO none)
;Don't allow RNAMF% JSYS if file is set never delete (FB%NDL). 
; Edit= 8995 to DISC.MAC on 2-Nov-88 by LOMARTIRE
;Merge Production changes to BUG text
; Edit= 8886 to DISC.MAC on 12-Aug-88 by RASPUZZI
;Update BUG. documentation.
; Edit= 8870 to DISC.MAC on 29-Jul-88 by LOMARTIRE, for SPR #21930
;Prevent OPNX9 when file goes long and PT0 access is incorrect 
; UPD ID= 8642, RIP:<7.MONITOR>DISC.MAC.11,  16-Feb-88 13:46:07 by GSCOTT
;TCO 7.1225 - Prevent OFNLEN from going to 770000,,0 in UPDLEN
; UPD ID= 8504, RIP:<7.MONITOR>DISC.MAC.10,   9-Feb-88 14:54:04 by GSCOTT
;TCO 7.1218 - Update copyright notice.
; UPD ID= 8457, RIP:<7.MONITOR>DISC.MAC.9,   5-Feb-88 09:20:30 by GSCOTT
;More of TCO 7.1210 - Fix spelling in XTRAPT
; UPD ID= 8409, RIP:<7.MONITOR>DISC.MAC.8,   4-Feb-88 10:49:49 by GSCOTT
;TCO 7.1210 - Set FILBAT to be not normally dumpable.
; UPD ID= 243, RIP:<7.MONITOR>DISC.MAC.7,   4-Nov-87 16:39:53 by MCCOLLUM
;TCO 7.1112 - Write spooled files to SPOOL: instead of PS:<SPOOL>.
; UPD ID= 145, RIP:<7.MONITOR>DISC.MAC.6,  29-Sep-87 15:40:30 by SHREFFLER
;TCO 7.1067 - Uncache source OFN after renaming a file
; UPD ID= 123, RIP:<7.MONITOR>DISC.MAC.5,  23-Sep-87 15:42:37 by MCCOLLUM
;TCO 7.1063 - Check for STRX10 in DSKDEL and DSKOPN
; UPD ID= 117, RIP:<7.MONITOR>DISC.MAC.4,  17-Sep-87 17:53:18 by GSCOTT
;TCO 7.1059 - Preserve byte counts of 34359738367(36) used by COBOL
; UPD ID= 110, RIP:<7.MONITOR>DISC.MAC.3,  15-Sep-87 16:09:19 by RASPUZZI
;TCO 7.1055 - Before destroying a directory, call INVDIR to uncache all
;OFNs that are using its ALOC2 entry.
; *** Edit 7474 to DISC.MAC by EVANS on 1-May-87
; Make STKVAR at DSKSFT: a two-element entity, instead of two separate elements
; - much better for double-word moves.
; *** Edit 7472 to DISC.MAC by EVANS on 30-Apr-87, for SPR #21600
; Prevent stack trashing by changing STKVAR.
; *** Edit 7451 to DISC.MAC by THOUMIRE on 16-Apr-87, for SPR #21237
; Clear OFN in OFN block after RELOFN when a short file is closed 
; *** Edit 7439 to DISC.MAC by THOUMIRE on 7-Apr-87, for SPR #21463
; Prevent OPNX9 error when a file goes long 
; *** Edit 7403 to DISC.MAC by RASPUZZI on 16-Dec-86
; Prevent NEWLFP from returning disk address to PMAP by reinstalling lost edit
; 1961
; *** Edit 7364 to DISC.MAC by MCCOLLUM on 12-Sep-86, for SPR #20928
; Fix DELDEL and DELFIL to retry ARCMSG if free space is exhausted. 
; *** Edit 7338 to DISC.MAC by LOMARTIRE on 23-Jul-86
; Prevent CFEQSF BUGHLT by bug in edit 7315 
; *** Edit 7329 to DISC.MAC by LOMARTIRE on 27-Jun-86, for SPR #21124
; Prevent OFJFBD BUGHLTs 
; *** Edit 7324 to DISC.MAC by RASPUZZI on 17-Jun-86, for SPR #20058
; Fix the SFTAD% JSYS to work as the documentation says it will. Also, make
; sure that TPRCYC and ARRCYC are properly initialized in STG. 
; *** Edit 7315 to DISC.MAC by LOMARTIRE on 11-Jun-86, for SPR #21144
; Prevent OPNX9 from ENQ tokens remaining after STRTAB is zeroed - for SPR
; 21144A 
; *** Edit 7308 to DISC.MAC by LOMARTIRE on 2-Jun-86, for SPR #21188
; Prevent ILMNRF and calculate correct section number at DELFI6 
; *** Edit 7283 to DISC.MAC by LOMARTIRE on 4-Apr-86, for SPR #21144
; Prevent OPNX9 errors from OF%RDU opens and bug in CHKLAC 
; *** Edit 7266 to DISC.MAC by MCCOLLUM on 11-Mar-86
; Check for FB%NDL in DELFIL before clearing file's index block address 
; *** Edit 7265 to DISC.MAC by MCCOLLUM on 11-Mar-86, for SPR #47
; In DSKR9L, call DEDSK to remove index block instead of DELFL1 
; *** Edit 7246 to DISC.MAC by MCCOLLUM on 18-Feb-86, for SPR #20334
; Clear FB%BAT when deleting the contents of an archived/migrated file 
; *** Edit 7220 to DISC.MAC by MCCOLLUM on 3-Jan-86, for SPR #14826
; Don't clear file byte size when expunging contents only 
; *** Edit 7207 to DISC.MAC by WAGNER on 9-Dec-85
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs. 
; Edit 7118 to DISC.MAC by PRATT on 8-Aug-85, for SPR #18505 (TCO 6-1-1510)
; Fix problems with special characters in filenames when doing spooled output. 
; UPD ID= 2242, SNARK:<6.1.MONITOR>DISC.MAC.79,  19-Jun-85 14:42:23 by MOSER
;TCO 6.1.1460 - MAKE JSR BUGHLT XTRAPT
; UPD ID= 2240, SNARK:<6.1.MONITOR>DISC.MAC.78,  19-Jun-85 11:18:35 by LOMARTIRE
;TCO 6.1.1426 - Call GASOG at OPNLNG before call to ASNOFN
; UPD ID= 2065, SNARK:<6.1.MONITOR>DISC.MAC.77,   3-Jun-85 14:30:23 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1894, SNARK:<6.1.MONITOR>DISC.MAC.76,   4-May-85 15:42:59 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1873, SNARK:<6.1.MONITOR>DISC.MAC.75,   4-May-85 11:45:04 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1818, SNARK:<6.1.MONITOR>DISC.MAC.74,  24-Apr-85 16:24:40 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1756, SNARK:<6.1.MONITOR>DISC.MAC.73,  14-Apr-85 17:29:45 by LEACHE
;Remove TCO 6.1.1134. The cure is worse than the disease
; UPD ID= 1628, SNARK:<6.1.MONITOR>DISC.MAC.72,  13-Mar-85 14:29:01 by MCCOLLUM
;TCO 6.1.1253 - Fix RNAMF% to return RNMX10 when renaming a file to itself.
; UPD ID= 1627, SNARK:<6.1.MONITOR>DISC.MAC.71,  13-Mar-85 12:50:40 by LEACHE
;Temporarily disable some of new ASROFN code for next Field-Test tape
; UPD ID= 1560, SNARK:<6.1.MONITOR>DISC.MAC.70,  21-Feb-85 14:29:38 by MOSER
;STILL MORE 6.1.1166 - ALWAYS GET THE RIGHT OFN
; UPD ID= 1542, SNARK:<6.1.MONITOR>DISC.MAC.69,  20-Feb-85 12:44:02 by MOSER
;MORE 6.1.1166 - FIX A BUG WHEN FILE GOES LONG
; UPD ID= 1445, SNARK:<6.1.MONITOR>DISC.MAC.67,  31-Jan-85 16:28:37 by MOSER
;TCO 6.1.1166 - *PERFORMANCE* - OFN MANAGEMENT
; UPD ID= 1390, SNARK:<6.1.MONITOR>DISC.MAC.66,  22-Jan-85 14:10:41 by LEACHE
;More of previous at ASSOFN
; UPD ID= 1376, SNARK:<6.1.MONITOR>DISC.MAC.65,  21-Jan-85 14:46:32 by LEACHE
;TCO 6.1.1133 & 6.1.1134 Add ASSOFN and fix ASROFN
; UPD ID= 4930, SNARK:<6.MONITOR>DISC.MAC.64,  15-Oct-84 13:00:44 by GRANT
;The assembly switch CFSCOD has been eliminated
; UPD ID= 4805, SNARK:<6.MONITOR>DISC.MAC.63,  17-Sep-84 09:54:41 by PURRETTA
;Update copyright notice
; UPD ID= 4357, SNARK:<6.MONITOR>DISC.MAC.62,  18-Jun-84 14:40:40 by SHTIL
;FIX the same bug for UPD 4309
; UPD ID= 4353, SNARK:<6.MONITOR>DISC.MAC.61,  18-Jun-84 09:47:14 by SHTIL
;Fix a bug for UPD 4309
; UPD ID= 4342, SNARK:<6.MONITOR>DISC.MAC.60,  14-Jun-84 16:24:55 by SHTIL
;CANCEL upd 4309
; UPD ID= 4326, SNARK:<6.MONITOR>DISC.MAC.59,  12-Jun-84 15:13:07 by MOSER
;TCO 6.2095 - FIX UP FILBAT
; UPD ID= 4309, SNARK:<6.MONITOR>DISC.MAC.58,   8-Jun-84 13:25:26 by SHTIL
;Don't alow to a file opened with OF%RDU  be expunged.(SPR #20122)
; UPD ID= 4152, SNARK:<6.MONITOR>DISC.MAC.56,  30-Apr-84 13:33:03 by TBOYLE
;Remove 6.2045... We are stuck with the way .FBREF works.....
; UPD ID= 4119, SNARK:<6.MONITOR>DISC.MAC.55,  24-Apr-84 16:40:00 by TBOYLE
;TCO TCO 6.2045 Update read date if file opened for read and write.
; UPD ID= 4014, SNARK:<6.MONITOR>DISC.MAC.54,  31-Mar-84 16:14:07 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3260, SNARK:<6.MONITOR>DISC.MAC.53,   6-Dec-83 14:12:41 by CJOHNSON
;TCO 6.1861 Make dump mode disk I/O use previous context section by default
; UPD ID= 3009, SNARK:<6.MONITOR>DISC.MAC.52,   7-Oct-83 22:40:34 by MILLER
;TCO 6.1820. CPJFNV needs to check if JFN is opern
; UPD ID= 2981, SNARK:<6.MONITOR>DISC.MAC.51,   4-Oct-83 15:58:07 by TBOYLE
;TCO 6.1803 DSKDLD to call REMSDR for special dirs.
; UPD ID= 2918, SNARK:<6.MONITOR>DISC.MAC.50,  21-Sep-83 09:53:22 by MILLER
;Use FRECFL instead of FRECFS
; UPD ID= 2911, SNARK:<6.MONITOR>DISC.MAC.49,  20-Sep-83 13:33:48 by MILLER
;Fix typeo at NEWLP1
; UPD ID= 2910, SNARK:<6.MONITOR>DISC.MAC.48,  20-Sep-83 11:38:13 by MILLER
;TCO 6.1094. Use UP0SHR instead of UPSHR
; UPD ID= 2907, SNARK:<6.MONITOR>DISC.MAC.47,  20-Sep-83 10:24:41 by MILLER
;TCO 6.1094. Must call FRECFS for old PT and CFSGTL for new when file goes long
; UPD ID= 2869, SNARK:<6.MONITOR>DISC.MAC.46,  29-Aug-83 12:58:03 by TGRADY
;REMOVE TCO 6.1763 UNTIL PROBLEM IS BETTER DEFINED
; UPD ID= 2847, SNARK:<6.MONITOR>DISC.MAC.45,  19-Aug-83 12:21:38 by TBOYLE
;TCO 6.1782 - Mark superindex-block new in FDB when file goes long.
; UPD ID= 2846, SNARK:<6.MONITOR>DISC.MAC.44,  19-Aug-83 08:07:55 by MCINTEE
;Mor TCO 6.1763 - Sigh. Yet another try.
; UPD ID= 2838, SNARK:<6.MONITOR>DISC.MAC.43,  17-Aug-83 11:41:16 by MCINTEE
;TCO 6.1763 - Make it work.
; UPD ID= 2823, SNARK:<6.MONITOR>DISC.MAC.42,  11-Aug-83 12:15:21 by MURPHY
;Remove previous until it works.
; UPD ID= 2816, SNARK:<6.MONITOR>DISC.MAC.41,   9-Aug-83 12:16:46 by MURPHY
;Fix typo in previous.
; UPD ID= 2813, SNARK:<6.MONITOR>DISC.MAC.40,   9-Aug-83 11:52:52 by MCINTEE
;TCO 6.1763 - Fix CPJFNV to map and lock the directory.
; UPD ID= 2690, SNARK:<6.MONITOR>DISC.MAC.39,  11-Jul-83 14:06:28 by MILLER
;Fix DSKREN for CFS (TCO 6.1094)
; UPD ID= 2390, SNARK:<6.MONITOR>DISC.MAC.38,  30-Apr-83 20:10:53 by MCLEAN
;FIX TYPO IN PREVIOUS EDIT
; UPD ID= 2342, SNARK:<6.MONITOR>DISC.MAC.37,  25-Apr-83 20:35:00 by MCLEAN
; TCO 6.1625 CHECK FOR OF%RTD AND REQUIRE WRITE ACCESS
; UPD ID= 2075, SNARK:<6.MONITOR>DISC.MAC.36,  24-Mar-83 13:22:52 by MILLER
;TCO 6.1094. Fix code at NEWLFT to not be NOSKED over call to ASFOFN
; UPD ID= 2045, SNARK:<6.MONITOR>DISC.MAC.35,  21-Mar-83 06:31:51 by MOSER
;STILL MORE TCO 6.1238
; UPD ID= 1978, SNARK:<6.MONITOR>DISC.MAC.33,  11-Mar-83 12:52:54 by MOSER
;MORE TCO 6.1238 - ONLY REPORT ONCE PER FILE
; UPD ID= 1751, SNARK:<6.MONITOR>DISC.MAC.32,   3-Feb-83 11:01:28 by MILLER
;TCO 6.1094. GETLEN should not require "write access"
; UPD ID= 1523, SNARK:<6.MONITOR>DISC.MAC.31,   9-Dec-82 09:43:03 by COBB
;MORE TCO 6.1206 - FIX TYPO IN UPD 1500  FILP0 => FLP0
; UPD ID= 1521, SNARK:<6.MONITOR>DISC.MAC.30,   8-Dec-82 17:17:12 by MOSER
;MORE TCO 6.1381 MOVE CGROFN TO CPYBAK IN DIRECT
; UPD ID= 1500, SNARK:<6.MONITOR>DISC.MAC.29,   1-Dec-82 12:09:05 by MOSER
;TCO 6.1206 -  CHECK FOR A FILE HAVING BECOME LONG AT CLOSE.
; UPD ID= 1467, SNARK:<6.MONITOR>DISC.MAC.28,  18-Nov-82 14:11:21 by MOSER
;TCO 6.1381 - ADD CGROFN BUGINF
; UPD ID= 1412, SNARK:<6.MONITOR>DISC.MAC.26,   3-Nov-82 17:27:25 by MURPHY
;Straighten out 6.1094 and 6.1238 - update .FBCRE only on write close.
; UPD ID= 1406, SNARK:<6.MONITOR>DISC.MAC.25,   3-Nov-82 16:27:04 by MILLER
;TCO 6.1094. Cooperate with CFSSRV to manage EOF pointers
; UPD ID= 1369, SNARK:<6.MONITOR>DISC.MAC.24,  22-Oct-82 11:20:34 by LEACHE
;TCO 6.1324 Make sure directory allocation is updated when necessary
; UPD ID= 1343, SNARK:<6.MONITOR>DISC.MAC.23,  15-Oct-82 08:54:52 by MCINTEE
;TCO 6.1317 - Clean up DSKCLZ
; UPD ID= 1325, SNARK:<6.MONITOR>DISC.MAC.22,  12-Oct-82 10:30:25 by MOSER
;MORE TCO 6.1283 - FIX A BUG
; UPD ID= 1307, SNARK:<6.MONITOR>DISC.MAC.21,   8-Oct-82 16:06:02 by MOSER
;TCO 6.1283 - ADD FILBAT BUGINF
; UPD ID= 1214, SNARK:<6.MONITOR>DISC.MAC.20,  22-Sep-82 20:18:16 by MILLER
;TCO 6.1094. Add CFS code for extending long files
; UPD ID= 1122, SNARK:<6.MONITOR>DISC.MAC.19,  31-Aug-82 08:57:03 by MCINTEE
;More TCO 6.1238 - define DSKPAG as a TRVAR in routine DSKCLZ
; UPD ID= 1119, SNARK:<6.MONITOR>DISC.MAC.18,  27-Aug-82 15:31:53 by LEACHE
;TCO 6.1238 - Do not update page counts for directory files.
; UPD ID= 1072, SNARK:<6.MONITOR>DISC.MAC.17,  10-Aug-82 10:52:03 by HAUDEL
;TCO 6.1224 - OFNJFN long file test for dismounted structure.
; UPD ID= 1056, SNARK:<6.MONITOR>DISC.MAC.16,   9-Aug-82 15:39:43 by PAETZOLD
;TCO 6.1219 - Extend DSKDTB and SPLDTB for RLJFD
; UPD ID= 985, SNARK:<6.MONITOR>DISC.MAC.15,  12-Jul-82 15:08:40 by LEACHE
;Make OF%RDU work for directory files - TCO 6.1185
; UPD ID= 863, SNARK:<6.MONITOR>DISC.MAC.14,   7-Jun-82 10:43:05 by PAETZOLD
;One More Time TCO 6.1152 - OFNJFN long file testing
; UPD ID= 853, SNARK:<6.MONITOR>DISC.MAC.13,   6-Jun-82 14:49:40 by PAETZOLD
;Yet More TCO 6.1152 - OFNJFN long file testing
; UPD ID= 838, SNARK:<6.MONITOR>DISC.MAC.12,   4-Jun-82 22:02:19 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 827, SNARK:<6.MONITOR>DISC.MAC.11,   3-Jun-82 18:07:11 by PAETZOLD
; UPD ID= 826, SNARK:<6.MONITOR>DISC.MAC.10,   3-Jun-82 18:01:06 by PAETZOLD
; UPD ID= 825, SNARK:<6.MONITOR>DISC.MAC.9,   3-Jun-82 16:07:18 by PAETZOLD
;Yet More TCO 6.1152 - OFNJFN long file testing
; UPD ID= 817, SNARK:<6.MONITOR>DISC.MAC.8,   2-Jun-82 20:03:14 by PAETZOLD
;More TCO 6.1152 - OFNJFN long file testing
; UPD ID= 816, SNARK:<6.MONITOR>DISC.MAC.7,   2-Jun-82 19:54:05 by PAETZOLD
;TCO 6.1152 - Make OFNJFN test OFN against long file index block OFN
; UPD ID= 432, SNARK:<6.MONITOR>DISC.MAC.6,   3-Mar-82 15:35:59 by PAETZOLD
;TCO 5.1742 - Make OFNJFN check structure code of OFN against JFNs
;More of TCO 6.1053
; UPD ID= 276, SNARK:<6.MONITOR>DISC.MAC.4,   5-Jan-82 14:16:01 by MILLER
;TCO 6.1053. Speed up closing long files.
; UPD ID= 134, SNARK:<6.MONITOR>DISC.MAC.3,  19-Oct-81 15:43:06 by COBB
;TCO 6.1019 - Change SE1CAL to EA.ENT
; UPD ID= 118, SNARK:<6.MONITOR>DISC.MAC.2,  16-Oct-81 17:53:08 by MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
;REPLACE PFLMOD, ETC. REFS WITH LOAD, STOR REFS
; UPD ID= 102, SNARK:<5.MONITOR>DISC.MAC.22,  17-Aug-81 09:43:35 by ZIMA
;TCO 5.1457 - Fix .STDFE reference in DSK10A to force to LH.
; UPD ID= 89, SNARK:<5.MONITOR>DISC.MAC.21,   4-Aug-81 11:04:27 by ZIMA
;TCO 5.1442 - correct bad DELF error code in DSKDEL to be ARGX26.
; UPD ID= 17, SNARK:<5.MONITOR>DISC.MAC.20,  10-Jul-81 12:07:09 by MURPHY
;Conform trivial differences with M60:
; UPD ID= 14, SNARK:<5.MONITOR>DISC.MAC.19,  10-Jul-81 08:23:26 by PAETZOLD
; UPD ID= 13, SNARK:<5.MONITOR>DISC.MAC.18,   9-Jul-81 18:24:03 by PAETZOLD
;TCO 5.1402 - Change OFNJFN not to lock FILLCK until some checks are made
; UPD ID= 10, SNARK:<5.MONITOR>DISC.MAC.17,   9-Jul-81 17:13:57 by MURPHY
;TCO 5.1398 - HANDLE ERROR CODES RETURNED FROM DSKASN
; UPD ID= 2159, SNARK:<5.MONITOR>DISC.MAC.15,   9-Jun-81 16:40:02 by CHALL
;DSKDV: Don't delete a FB%NDL file which is written or renamed over
; UPD ID= 1914, SNARK:<5.MONITOR>DISC.MAC.11,  30-Apr-81 16:50:43 by CHALL
;DSKDEL: Give error message if file is flagged "never delete" (FB%NDL)
; UPD ID= 1662, SNARK:<5.MONITOR>DISC.MAC.10,  11-Mar-81 11:17:41 by ZIMA
;TCO 5.1271 - Fix ILMNRF crashes from SFTAD, handle TPRCYC properly also.
; UPD ID= 1610, SNARK:<5.MONITOR>DISC.MAC.9,  27-Feb-81 18:19:17 by MURPHY
;FIX OF%RDU
; UPD ID= 1586, SNARK:<5.MONITOR>DISC.MAC.8,  25-Feb-81 17:12:04 by MURPHY
;TCO 5.1263 - Check CZ%ABT before updating FDB on CLOSF.
; UPD ID= 1560, SNARK:<5.MONITOR>DISC.MAC.7,  13-Feb-81 16:43:57 by MURPHY
;NEW OPENF MODE - OF%RDU, READ-UNRESTRICTED
; UPD ID= 1308, SNARK:<5.MONITOR>DISC.MAC.6,  24-Nov-80 12:14:04 by DONAHUE
;Move TCO 5.1191 to EXEC - allow deleted,invisible files to be undeleted
; UPD ID= 1235, SNARK:<5.MONITOR>DISC.MAC.5,   6-Nov-80 11:51:00 by DONAHUE
;TCO 5.1191 - Don't delete invisible files when superceding
; UPD ID= 1083, SNARK:<5.MONITOR>DISC.MAC.4,   1-Oct-80 11:56:40 by MURPHY
;FIX ACVAR
; UPD ID= 1000, SNARK:<5.MONITOR>DISC.MAC.3,  11-Sep-80 16:25:08 by ENGEL
;UNLOCK DIRECTORY BEFORE RETERR
; UPD ID= 986, SNARK:<5.MONITOR>DISC.MAC.2,   4-Sep-80 09:45:02 by ENGEL
;fix lngfx1 when file is already long for a reader
; UPD ID= 150, SNARK:<4.1.MONITOR>DISC.MAC.45,  18-Dec-79 09:28:32 by OSMAN
;Fix comment on OFNJFN: "OF USER" => "IF USER"
; UPD ID= 76, SNARK:<4.1.MONITOR>DISC.MAC.44,  30-Nov-79 15:45:50 by SANICHARA
;TCO 4.1.1039 - def DSKRE7 and fix BUGCHKS after GETFDB in rename proc
; UPD ID= 44, SNARK:<4.1.MONITOR>DISC.MAC.43,  28-Nov-79 15:59:20 by MILLER
;UPDATE STS IN CPJFNV SO LONGF IS CURRENT
; UPD ID= 21, SNARK:<4.1.MONITOR>DISC.MAC.42,  27-Nov-79 14:08:01 by DBELL
;TCO 4.1.1031 - CHANGE ARGX26 TO ARGX27 AT DSKS12
;<4.1.MONITOR>DISC.MAC.41, 26-Nov-79 11:12:32, EDIT BY MILLER
;TCO 4.1.1026. FIX OFNJFN TO LEAVE JFN LOCKED
; UPD ID= 6, SNARK:<4.1.MONITOR>DISC.MAC.40,  20-Nov-79 16:14:40 by SANICHARA
;TCO 4.1.1024 - Make RNAMF return correct error message
;<4.1.MONITOR>DISC.MAC.39, 16-Nov-79 09:08:20, EDIT BY R.ACE
;TCO 4.1.1020 - MAKE .RNAMF UPDATE THE .FBCRE WORD OF THE FDB

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	SEARCH PROLOG
	TTITLE DISC
	SWAPCD

;SPECIAL AC DEFINITIONS USED HEREIN

DEFAC (DIR,Q2)			;[7324] Contains DIRORA
DEFAC (STS,P1)			;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)

OFS==P3				;[7324] Offset into dir page 0
;DEVICE DEPENDENT ROUTINES. TO DO CERTAIN FUNCTIONS, THE RH OF DEV
;CONTAINS THE NAME OF A TABLE SUCH AS DSKDTB, AND A ROUTINE IS CALLED
;VIA 'CALL @FOO(DEV)', WHERE FOO IS A SYMBOL FOR AN OFFSET INTO THE
;TABLE. THE SYMBOLS ARE DEFINED IN PROLOG. IN THE COMMENTS BELOW,
;THE OFFSET IS INDICATED ALONG WITH THE PURPOSE OF THE ROUTINE

DSKDTB::DSKDTL			;LENGTH
	DTBDSP (MDDDIR)		;DLUKD - DIRECTORY SETUP
	DTBDSP (MDDNAM)		;NLUKD - NAME LOOKUP
	DTBDSP (MDDEXT)		;ELUKD - EXTENSION LOOKUP
	DTBDSP (MDDVER)		;VLUKD - VERSION LOOKUP
	DTBDSP (INSPRT)		;PLUKD - PROTECTION INSERTION
	DTBDSP (INSACT)		;ALUKD - ACCOUNT INSERTION
	DTBDSP (DSKINS)		;SLUKD - STATUS INSERTION
	DTBDSP (DSKOPN)		;OPEND - OPEN FILE
	DTBDSP (DSKSQI)		;BIND - BYTE INPUT
	DTBDSP (DSKSQO)		;BOUTD - BYTE OUTPUT
	DTBDSP (DSKCLZ)		;CLOSD - CLOSE FILE
	DTBDSP (DSKREN)		;REND - RENAME
	DTBDSP (DSKDEL)		;DELD - DELETE FILE
	DTBDSP (DSKDMI)		;DMPID - DUMP MODE INPUT
	DTBDSP (DSKDMO)		;DMPOD - DUMP MODE OUTPUT
	DTBBAD (DESX9)		;MNTD - MOUNT DEVICE
	DTBBAD (DESX9)		;DSMD - DISMOUNT DEVICE
	DTBBAD (DESX9)		;INDD - INITIALIZE DIRECTORY OF DEVICE
	DTBBAD (MTOX1)		;MTPD - DO MTAPE OPERATION
	DTBBAD (DESX9)		;GDSTD - GET DEVICE STATUS
	DTBBAD (DESX9)		;SDSTD - SET DEVICE STATUS
	DTBSKP			;RECOUT - FORCE RECORD OUT (SOUTR)
	DTBDSP (DSKRFT)		;RFTADD - READ FILE TIME AND DATE
	DTBDSP (DSKSFT)		;SFTADD - SET FILE TIME AND DATE
	DTBDSP (BIOINP)		;SET JFN FOR INPUT
	DTBDSP (BIOOUT)		;SET JFN FOR OUTPUT
	DTBBAD (GJFX49)		;CHECK ATTRIBUTE
	DTBSKP			;RELEASE JFN
	DSKDTL==:.-DSKDTB	;GLOBAL LENGTH OF DISPATCH TABLE
;RFTAD/SFTAD DEVICE ROUTINES FOR DISK

;RFTAD
DSKRFT:	EA.ENT
	TQNE <ASTF>		;OUTPUT STARS?
	RETBAD(DESX7)		;YES, LOSE
	CALL GETFDB		;GET FDB IN
	 RETBAD(DESX3)		;LOSE
	MOVE B,.FBCRV(A)	;GET CREATION DATE AND TIME
	CAILE Q1,.RSCRV		;DOES CREATION WORD EXIST?
	XCTU [MOVEM B,.RSCRV(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBWRT(A)	;GET WRITTEN DATE AND TIME
	CAILE Q1,.RSWRT		;DOES WRITTEN WORD EXIST?
	XCTU [MOVEM B,.RSWRT(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBREF(A)	;GET REFERENCE DATE AND TIME
	CAILE Q1,.RSREF		;DOES REFERENCE WORD EXIST?
	XCTU [MOVEM B,.RSREF(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBCRE(A)	;GET INTERNAL WRITTEN DATE AND TIME
	CAILE Q1,.RSCRE		;DOES INTERNAL SYSTEM WRITTEN WORD EXIST?
	XCTU [MOVEM B,.RSCRE(Q3)] ;YES, RETURN TO USER
	LOAD B,FBLEN,(A)	;GET LENGTH
	CAIGE B,.FBLXT		;IS ARCHIVE/VIRTUAL DISK STUFF THERE?
	JRST DSKRF1		;NO, JUST RETURN
	MOVE B,.FBTDT(A)	;GET TAPE DATE & TIME
	CAILE Q1,.RSTDT		;SPACE IN CALLER'S BLK EXIST?
	XCTU [MOVEM B,.RSTDT(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBNET(A)	;ONLINE EXPIRATION DATE/INTERVAL
	CAILE Q1,.RSNET		;SPACE EXISTS?
	XCTU [MOVEM B,.RSNET(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBFET(A)	;GET OFFLINE EXPIRATION DATE/INTERVAL
	CAILE Q1,.RSFET		;SPACE FOR IT?
	XCTU [MOVEM B,.RSFET(Q3)] ;YES, RETURN TO USER
DSKRF1:	CALL USTDIR
	RETSKP
;SFTAD
DSKSFT:	EA.ENT
	STKVAR <<FDBSAV,2>>	;[7474] For FDB address and date
	TQNE <ASTF>
	RETBAD(DESX7)
	MOVNI A,1
	MOVN B,Q1
	HRLZ B,B
	HRR B,Q3
DSKSF0:	XCTU [CAMN A,(B)]
	AOBJN B,DSKSF0
	JUMPGE B,RSKP		;NOOP IF ALL -1
	CALL GETFDB		;GET FDB IN
	 RETBAD(DESX3)
	MOVEM A,FDBSAV
	MOVE B,CAPENB		;GET CAPABILITIES
	TQNN WRTF		;ALWAYS SUCCEED IF OPEN FOR WRITE
	TXNE B,SC%WHL!SC%OPR	;WHEELS ALWAYS WIN
	JRST DSKSF1		;CAN CHANGE ANYTHING
DSKSF4:	MOVX B,FC%WR		;B/WRITE ACCESS
	CALL ACCCHK		;CHECK FOR WRITE ACCESS TO THIS FILE
	 JRST DSKSF2		;CHECK FOR OWNER
	JRST DSKSF1

DSKSF2:	MOVX B,DC%CN		;B/CONNECT ACCESS
	CALL DIRCHK		;CHECK FOR ABILITY TO CONNECT TO
				; THIS DIRECTORY (AND THUS BECOME LIKE OWNER)
	 RETBAD (CFDBX2,<CALL USTDIR>)
DSKSF1:	MOVE A,FDBSAV
	CAIG Q1,.RSCRV
	JRST DSKSF5
	XCTU [MOVE B,.RSCRV(Q3)]
	CAME B,[-1]
	MOVEM B,.FBCRV(A)	;CREATION DATE AND TIME
DSKSF5:	CAIG Q1,.RSWRT
	JRST DSKSF6
	XCTU [MOVE B,.RSWRT(Q3)]
	CAME B,[-1]
	MOVEM B,.FBWRT(A)	;WRITE DATE AND TIME
DSKSF6:	CAIG Q1,.RSREF
	JRST DSKSF7
	XCTU [MOVE B,.RSREF(Q3)]
	CAME B,[-1]
	MOVEM B,.FBREF(A)	;READ DATE AND TIME
DSKSF7:	CAIG Q1,.RSCRE
	JRST DSKSF8
	XCTU [MOVE B,.RSCRE(Q3)]
	CAMN B,[-1]
	JRST DSKSF8		;DOESN'T WISH TO CHANGE IT
	MOVX C,SC%WHL!SC%OPR
	TDNE C,CAPENB		;CALLER ALLOWED?
	IFNSK.			;[7324]
	  MOVEM T2,.FBCRE(T1)	;[7324] Yes, store internal write D & T
	ELSE.			;[7324]
	  RETBAD (CAPX1,<CALL USTDIR>) ;[7324] Caller can't change say so
	ENDIF.			;[7324]
DSKSF8:	LOAD B,FBLEN,(A)	;SEE IF OTHER WORDS EXIST
	CAIGE B,.FBLXT		;FDB LONG ENOUGH FOR THEM TO BE THERE?
	JRST DSKS11		;NO, GET OUT NOW
	CAIG Q1,.RSTDT
	JRST DSKSF9
	XCTU [MOVE B,.RSTDT(Q3)]
	CAMN B,[-1]
	JRST DSKSF9		;NO CHANGE DESIRED
	MOVX T3,SC%OPR!SC%WHL
	TDNE T3,CAPENB		;WHEELS WIN
	IFNSK.			;[7324]
	  MOVEM B,.FBTDT(A)	;[7324] Wheels can change this
	ELSE.			;[7324]
	  RETBAD (CAPX1,<CALL USTDIR>) ;[7324] Not enough privs
	ENDIF.			;[7324]
DSKSF9:	CAIG Q1,.RSNET
	JRST DSKS10
	XCTU [MOVE B,.RSNET(Q3)]
	CAMN T2,[-1]		;[7324] Want to change this word?
	JRST DSKS10		;[7324] Not changing this word
	TLNE T2,-1		;[7324] Interval or date and time?
	JRST DSKS9A		;[7324] Date and time, must check for legality
	MOVE DIR,DIRORA		;[7324] Get directory page 0
	LOAD OFS,DRDNE,(DIR)	;[7324] Directory's online expiration
	SKIPE OFS		;[7324] Did directory have a default?
	IFNSK.			;[7324] Yes, test it
	  CAMG T2,OFS		;[7324] Less than dir default?
	  JRST DSKS9B		;[7324] Yes, change it.
	ENDIF.			;[7324] No, check against system default
	MOVX OFS,.STDNE		;[7324] Get the system default for online exp.
	CAMLE T2,OFS		;[7324] Is this OK?
	JRST DSK12		;[7324] No, fail.
	JRST DSKS9B		;[7324] Yes, change it.
DSKS9A:	DMOVEM T1,FDBSAV	;[7324] LGTAD will clobber T1 & T2
	CALL LGTAD		;[7324] Get now
	MOVE DIR,DIRORA		;[7324] Directory is here
	LOAD T3,DRDNE,(DIR)	;[7324] Put dir default here
	MOVSS T3,		;[7324] Get days in the LH
	ADD T3,T1		;[7324] Maximum TAD allowed by dir default
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAML T3,T2		;[7324] OK if max geq than user's request
	JRST DSKS9B		;[7324] OK, store supplied D & T
	DMOVEM T1,FDBSAV	;[7324] Isn't legal, check against sys max
	CALL LGTAD		;[7324] Get now
	MOVSI T3,.STDNE		;[7324] get days from system in LH
	ADD T3,T1		;[7324] Maximum TAD allowed by system default
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAMGE T3,T2		;[7324] OK if max geq than user's request
	JRST DSK12		;[7324] Isn't then don't do it
DSKS9B:	MOVEM T2,.FBNET(T1)	;[7324] Change it.
DSKS10:	CAIG Q1,.RSFET
	JRST DSKS11
	XCTU [MOVE B,.RSFET(Q3)]
	CAMN B,[-1]
	JRST DSKS11		;NO CHANGE DESIRED
	TLNE B,-1		;INTERVAL OR DATE & TIME?
	JRST DSK10A		;DATE AND TIME, CHECK THAT
	MOVE DIR,DIRORA		;[7324] Location of dir page 0
	LOAD OFS,DRDFE,(DIR)	;[7324] Directory offline expiration
	SKIPE OFS		;[7324] Is it set?
	IFNSK.			;[7324] Yes, test it
	  CAMG T2,OFS		;[7324] Less than dir default?
	  JRST DSK10B		;[7324] Yes, update it
	ENDIF.			;[7324] No, check against system default
	SKIPN T3,TPRCYC		;RECYCLE/EXPIRATION PERIOD SET?
	MOVX T3,.STDFE		;NO, USE DEFAULT VALUE
	CAMLE T2,T3		;WITHIN SYSTEM LIMIT?
	JRST DSKS12		;NO, DON'T DO IT
DSK10B:	MOVEM B,.FBFET(A)	;SET IT
DSKS11:	CALL UPDDIR
	CALL USTDIR
	RETSKP
DSK10A:	DMOVEM T1,FDBSAV	;[7324] LGTAD will clobber T1 & T2
	CALL LGTAD		;[7324] Get the time
	MOVE DIR,DIRORA		;[7324] Dir page 0 is here
	LOAD T3,DRDFE,(DIR)	;[7324] Get expiration default for dir
	MOVSS T3,		;[7324] Put days in LH
	ADD T3,T1		;[7324] Max allowed by dir default
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAML T3,T2		;[7324] Are we legal?
	JRST DSK10B		;[7324] Yes, set it
	DMOVEM T1,FDBSAV	;[7324] No, check system default then
	CALL LGTAD		;GET NOW
	HRLZ C,TPRCYC		;# OF DAYS ALLOWED
	SKIPN T3		;BUT IF EXPIRATION/RECYCLE NOT SET
	MOVSI T3,.STDFE		; THEN USE THE DEFAULT (TO LH)
	ADD C,A			;MAXIMUM TAD ALLOWED
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAMGE C,B		;OK IF MAX GEQ THAN USER'S REQUEST
	JRST DSKS12		;ISN'T SO DON'T DO IT
	JRST DSK10B		;OK, STORE SUPPLIED D & T

DSK12:	CALL USTDIR		;[7324] Unlock but do not update
	RETBAD(ARGX32)		;[7324] and return appropriate error

DSKS12:	CALL USTDIR		;UNLOCK, NO UPDATE OF DIRECTORY
	RETBAD(ARGX27)		;AND FAIL
DSKDEL:	EA.ENT
	LOAD A,STR,(JFN)	;[7.1063]Get the structure number
	CALL CKSTOF		;[7.1063](T1/T1)Is the structure offline?
	 RETBAD ()		;[7.1063]Return "Structure is offline"
	CALL GETFDB
	RETSKP
	UMOVE C,1		;GET USER FLAGS
	TXNE C,DF%DIR		;DELETING A DIRECTORY?
	JRST DSKDLD		;YES - SPECIAL
	MOVE B,.FBCTL(A)	;GET FDB'S FLAG WORDS
	TXNE B,FB%NDL		;IS THIS FILE MARKED "NEVER DELETE"?
	RETBAD (DELX13,<CALL USTDIR>)
	PUSH P,A
	MOVX B,FC%WR		;B/WRITE ACCESS
	CALL ACCCHK		;CHECK FOR ABILITY TO WRITE THIS FILE
				; (NEEDED FOR DELETING)
	JRST [	ADJSP P,-1
		CALL USTDIR
		MOVEI A,DELFX1
		RET]
	UMOVE C,1		;GET USER FLAGS
	TXNE C,DF%ARC!DF%CNO	;DELETE ARCHIVED ALLOWED? CONTENTS ONLY?
	 JRST DSKDL2		;ONE OF THEM, SKIP CHECK
	MOVX B,FC%WR		;WRITE ACCESS NEC. FOR DELETE
	MOVE A,0(P)		;RESTORE FDB ADDRESS
	CALL ARACCK		;CHECK ARCHIVE/VIR. DISK REQUIREMENTS
	JUMPG A,[ADJSP P,-1	;ADJUST STACK
		CAIN A,ARCX11	;MODIFICATION PROHIB. MSG.
		MOVEI A,ARCX12	;REPLACE BY DELETE PROHIB. MSG.
		CAIN A,OPNX30	;MODIFICATION PROHIB. MSG
		MOVEI A,DELX11	;CORRESP. DELETE PROHIB. MSG.
		CALLRET USTDIR]
DSKDL2:	POP P,A			;RESTORE FDB ADDRS
	JN FBDIR,(A),[RETBAD (DLFX11,<CALL USTDIR>)]
	UMOVE C,1		;GET USER FLAGS
	MOVX B,FB%DEL
	TXNN C,DF%CNO		;CONTENTS ONLY?
	IORB B,.FBCTL(A)	;NO, MARK AS DELETED
	TXNE C,DF%FGT		;FORGET FILE?
	JRST [	MOVE C,CAPENB	;YES, CHECK FOR REQUIRED CAPABILITIES
		TXNN C,SC%WHL+SC%OPR+SC%MNT
		RETBAD (WHELX1,<CALL USTDIR>)
		JN FBDIR,(A),.+1 ;IF THIS IS A DIRECTORY FILE, DON'T
		SETZM .FBADR(A)	;FLUSH XB ADR
		JRST .+1]
	MOVE D,A		;GET FDB ADR FOR DELFIL
	UMOVE A,A
	TLNE A,(DF%EXP)		;EXPUNGE CONTENTS WANTED?
	JRST [	CALL DELFIL	;YES, DO IT
		 JRST DSKDL1	;FAILED, LEAVE ERROR IN A
		JRST .+1]
	UMOVE A,A
	TXNE A,DF%CNO		;DELETE DISK-CONTENTS ONLY?
	JRST [	LOAD B,FBLEN,(D) ;NO OF WORDS IN THIS FDB
		CAIGE B,.FBLXT	;INCLUDES TAPE INFO. WORDS?
		ERRJMP (DELX12,DSKDL1) ;NO, SO DON'T DELETE FROM DISK
		SKIPE .FBTP1(D)	;TAPE NO. THERE?
		SKIPN .FBTP2(D)	;OTHER TOO?
		ERRJMP (DELX12,DSKDL1) ;NO, REFUSE TO DELETE FROM DISK
		JN FBOFF,(D),[ERRJMP (ARGX26,DSKDL1)] ;ALSO IF OFFLINE
		CALL FSHFIL	;FLUSH CONTENTS, MARK OFFLINE ETC.
		 JRST DSKDL1	;FAILED, ERROR IN A
		JRST .+1]
	SETZ A,			;NO ERRORS
DSKDL1:	PUSH P,A		;SAVE ERROR CODE
	CALL UPDDIR		;UPDATE DIR ON DSK
	CALL USTDIR
	POP P,A
	JUMPE A,RSKP		;IF NO ERROR, TAKE SKIP RETURN
	RETBAD ()
FSHFIL::PUSH P,.FBSIZ(D)	;SAVE SIZE
	LOAD A,FBNPG,(D)	;AND # OF PAGES
	PUSH P,A
	CALL DELFL1		;OK--DELETE DISK CONTENTS
	 JRST [ ADJSP P,-2	;FAILED, ERROR IN A
		RET]
	SETONE <FBOFF>,(D)	;MARK FILE OFFLINE
	POP P,B
	STOR B,ARPSZ,(D)	;AND REMEMBER HOW LARGE IT WAS
	POP P,.FBSIZ(D)		;RESTORE THE LENGTH
	RETSKP
;DELETE A DIRECTORY FILE.  (SHOULD ONLY BE DONE IF DIR IS SICK)

DSKDLD:	MOVE C,CAPENB		;MAKE SURE THIS JOB IS PRIVILEGED
	TXNN C,SC%WHL!SC%OPR
	RETBAD (WHELX1,<CALL USTDIR>)	;NO, DON'T ALLOW THIS
	JE FBDIR,(A),<[RETBAD (DELFX9,<CALL USTDIR>)]>
	PUSH P,A		;SAVE THE FDB ADDRESS
	MOVE A,.FBADR(A)	;GET INDEX BLOCK ADDRS
	LOAD B,CURSTR		; AND STR #
	CALL CHKOFN		;SEE IF FILE OPEN
	 RETBAD (DLFX10,<POP P,A
			 CALL USTDIR>)
	MOVE A,0(P)		;NO - GET FDB ADDRS BACK
	SETZRO <FBPRM,FBDIR>,(A) ;TURN OFF DIRECTORY FLAG
	SETONE FBDEL,(A)	;MARK FILE DELETED
	SETZM .FBADR(A)		;FORGET FILE SPACE
	LOAD A,FBDRN,(A)	;GET THE DIRECTORY NUMBER OF THE FILE
	CALL INVDIR		;[7.1055](T1/) Anyone using directory?
	 RETBAD (DLFX10,<POP P,A
			 CALL USTDIR>) ;[7.1055] Yes, can't delete it then
	CALL INVIDX		;DELETE IDXTAB ENTRY
	MOVE A,0(P)		;GET FDB ADDRS BACK
	LOAD C,FBDRN,(A)	;T3/ DIR NUMBER FOR FILE
	LOAD D,CURSTR		;T4/ STRUCTURE NUMBER
	CALL REMSDR		;REMOVE FROM CACHE IF NECC.
	POP P,D			;GET BACK ADR OF FDB
	CALL DELFIL		;DELETE THE FILE
	 SKIPA			;FAILED TO DELETE IT (CODE IN A)
	SETZ A,			;MARK THAT IT WAS SUCCESSFUL
	JRST DSKDL1		;RETURN

DSKINS:	EA.ENT
	CALL GETFDB
	 JRST DSKINB		;GETFDB FAILURE, GO COMPLAIN
	MOVX B,FB%TMP
	IORM B,.FBCTL(A)
	CALL USTDIR
	RET

DSKINB:	BUG.(CHK,GTFDB1,DISC,SOFT,<DSKINS - GETFDB failure.>,,<

Cause:	The newly created file data block to mark file as being temporary
	cannot be found.
>)
	RET
; Disk open routine
; Call:	LH(STS)	; Access desired
;	F1	; DEVICE DEPENDENT ACCESS BITS FROM USER
;	JFN	; Job file number
;	CALL DSKOPN
; Return
;	+1	; Cannot open, reason in a
;	+2	; Success

DSKOPN:	EA.ENT
	TRVAR <OPNFDB,OPNDCD>	;FDB ADDRESS, DISCARD-TAPE-INFO FLAG
	LOAD A,STR,(JFN)	;[7.1063]Get the structure number
	CALL CKSTOF		;[7.1063](T1/T1)Is the structure offline?
	 RETBAD ()		;[7.1063]Return "Structure is offline"
	SETZM OPNDCD		;INITIALIZE AS NO DISCARD
	CALL GETFDB		;GET POINTER TO FDB
	 JRST [	MOVEI A,OPNX2
		RET]		;FILE HAS BEEN DELETED
	MOVEM A,OPNFDB		;SAVE FDB ADDRESS
	SAVEQ			;SAVE PERMANENT REGISTERS
	MOVE Q1,STS		;AND SAVE ORIGINAL USER REQUEST
	CALL NFACHK		;ACCESS OK BECAUSE NEW FILE?
	 SKIPA			;NO
	JRST [	TQNN <READF>	;YES. WANT READ?
		TQNN <WRTF>	;NO. WANT WRITE
		JRST DSKOPA	;ALL IS GOOD AS IS
		TQO <READF>	;IF WANT WRITE, GIVE READ ALSO
		JRST DSKOPA]	;AND DONE
	TQNN <READF>		;WANT READ?
	TQNN <WRTF>		;NO. WANT WRITE?
	SKIPA			;OK AS IS
	JRST [	HLLZ B,STS	;REQUESTED ACCESS
		TXO B,FC%RD	;PLUS READ IF POSSIBLE
		CALL ACCCHK	;WILL IT GO?
		 SKIPA		;NO. DON'T ASK FOR IT THEN
		TQO <READF>	;YES. SO DO IT
		MOVE A,OPNFDB	;GET BACK IDENTIFIER
		JRST .+1]	;AND GO ON
	HLLZ B,STS
	TRNE F1,OF%RTD		;CHECK FOR RESTRICTED ACCESS
	TXO B,<WRTF>		;WRITE REQUIRED IF RESTRICTED
	CALL ACCCHK		;CHECK ACCESS
	JRST [	CALL USTDIR	;ACCESS NOT ALLOWED
		RET]
	MOVE A,OPNFDB
	HLLZ B,Q1		;ORIGINAL ACCESS BITS
	CALL ARACCK		;CHECK ARCHIVE/VIR. DISK REQUIREMENTS
	JUMPG A,[CALLRET USTDIR] ;POSITIVE NO. IS ERROR CODE
	JUMPN A,[MOVEM A,OPNDCD	;SAVE DISCARD FLAG (-1 OR -2)
		JRST .+1]
	MOVE A,OPNFDB
	JE FBDIR,(A),DSKOPA	;IF NOT DIR FILE, OKAY
	TXNN F1,OF%THW!OF%RDU	;IS DIR FILE. OPEN FOR THAW OR UNRESTRICTED?
	RETBAD (OPNX13,<CALL USTDIR>) ;NO. ERROR
DSKOPA:	TQCE <RNDF>		;CHANGE FLAG FROM "APPEND" TO "RANDOM"
	TQO <WRTF>		;AND IF APPEND, ALLOW WRITING
	TQNN <WRTF>
	JRST OPENF1		;NOT WRITE
	TRNE F1,OF%PDT		;SUPPRESS REFERENCE UPDATE?
	JRST OPENF0		;YES

;DSKOPN, WRITE...

	LOAD B,FBVER,(A)	;CHECK FDB VERSION
	CAIGE B,1		;LATER THAN VER #1
	JRST [	MOVE B,JOBNO	;VER 0 - SET DIR #
		HRRZ B,JOBDIR(B)
		STOR B,FBLW0,(A) ;INTO FDB
		JRST DSKOPB]	;CONTINUE
	MOVEI B,USRNAM		;POINT TO USER NAME
	MOVEI C,.FBLWR		;UPDATE LAST-WRITER
	CALL INSUNS		;INSERT NAME STRING
	MOVE A,OPNFDB		;RESTORE FDB ADDRS
DSKOPB:	MOVSI B,1
	ADDM B,.FBCNT(A)	;COUNT NUMBER OF WRITES
	CALL UPDDTM		;GET TIME OF DAY AND UPDATE DIR TIME
	MOVE B,A		;SAVE TIME
	MOVE A,OPNFDB		;GET BACK FDB ADR
	CAMN B,[-1]		;TIME SET YET?
	JRST OPENF0		;NO, DON'T SET TIME
	STOR B,FBWRT,(A)	;SET DATE OF LAST USER WRITE
OPENF0:	SKIPN B,.FBADR(A)	;GET DISK ADDRESS
	IFSKP.
	  TXNN B,FILNB		;NEW FILE?
	  JRST DSKOP3		;NO. GO SEE IF DELETE NEEDED FIRST
	  MOVE A,B		; LEFT OVER FROM A CRASH
	  LOAD B,STR,(JFN) 	;GET STRUCTURE NUMBER FROM JFN BLOCK
	  CALL CHKOFN		;SEE IF ASOFN WOULD WORK
	  IFNSK.
	    MOVEI A,OPNX9 	;NO, FILE BUSY
	    CALLRET USTDIR
	  ENDIF.
	  MOVE A,OPNFDB		;FILE NOT OPEN, MUST BE LEFT FROM CRASH
	  SETZM .FBADR(A)	;FORGET IT
	ENDIF.
	MOVX B,FB%LNG		;MAKE SURE NO LEFT OVER LONGNESS
	ANDCAM B,.FBCTL(A)
	MOVEI A,0		;NO DISK ADDRESS, MUST GET ONE
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL DSKASN		;ASSIGN A DISK ADDRESS
	 JRST [	CALL USTDIR
		RET]
	PUSH P,A
	MOVE A,OPNFDB
	SETZRO FBOFF,(A)	;NOT OFFLINE IF HAS NEW FILE STATUS
	SKIPE B,OPNDCD		;DISCARD FLAG (-1 OR -2)
	CALL DISCRD		;DO THE DISCARD OF TAPE POINTER
	LOAD A,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL UPDBTB		;UPDATE BIT TABLE BEFORE STORING ADDRESS
	POP P,A
	TXO A,FILNB		;NOTE NEW FILE
	MOVE B,A
	MOVE A,OPNFDB
	MOVEM B,.FBADR(A)
	JRST OPENF4		;CONTINUE WITH WRITE
;OPENING OLD FILE FOR WRITE. SEE IF DELETE CONTENTS IS NEEDED

DSKOP3:	MOVX B,FB%DEL		;DELETED BIT
	TDNE B,.FBCTL(A)	;IS THIS FILE NOW DELETED?
	JRST DSKOP4		;YES. MUST DO DELETE THEN
	SKIPE B,OPNDCD		;DISCARD FLAG (-1 OR -2)
	CALL DISCRD		;DO THE DISCARD OF TAPE POINTER
	TQNE <RNDF>		;OPENED FOR APPEND ONLY?
	TXNE Q1,READF		;NO. ORIGINAL ACCESS INCLUDE READ?
	JRST OPENF4		;YES. NO DELETE THEN
DSKOP4:	MOVE D,A		;MOVE FDB ADDRESS
	CALL DELFL1		;GO EXPUNGE CONTENTS
	 CALLRET USTDIR		;A CONTAINS APPROPRIATE CODE
	SETZM OPNDCD		;DISCARD DONE IN DELFL1
	MOVE A,OPNFDB		;GET BACK FDB ADDRESS
	JRST OPENF0		;DONE. GO ASSIGN NEW XB

;ROUTINE TO DISCARD TAPE POINTER, DISCARD FLAG SUPPLIED IN B
;(-1 FOR DISCARD OF TAPE INFO, -2 FOR DISCARD OF MIGRATE BIT AS WELL)

DISCRD:	CAME B,[-2]		;DISCARD MIGRATE BIT?
	JRST DISCR1		;NO
	SETZRO K0RIV,(A)	;YES
DISCR1:	PUSH P,P3
	MOVE P3,A		;CLRBOT TAKES FDB ADDR. IN P3
	CALL CLRBOT		;CLEAR INFO ON BOTH TAPES
	 JRST [	POP P,P3	;CLEAN UP STACK
		CALLRET USTDIR] ;ERROR CODE IN A
	SETZRO K0RSN,(A)	;CLEAR THE REASON FILE WOULD BE OFFLINE
	POP P,P3
	RET
;HERE ON NOT WRITE

OPENF1:	TXZ F1,OF%DUD		;DISALLOW DUD IF NOT WRITING
	MOVE B,.FBCTL(A)
	TXNE B,FB%NXF		;DOES THIS FILE EXIST?
	ERRJMP(OPNX2,USTDIR)	;NO, CANNOT OPEN
	SKIPE B,.FBADR(A)	;HAVE GOOD ADDRESS?
	TXNE B,FILNB
	ERRJMP(OPNX2,USTDIR)	;NO, CANNOT OPEN
	TRNE F1,OF%PDT		;SUPPRESS REFERENCE UPDATE?
	JRST OPENF4		;YES
	PUSH P,A
	CALL LGTAD		;GET NOW
	MOVE B,A
	POP P,A
	JUMPL B,OPENF4		;SYSTEM HAS TOD SET?
	MOVE C,.FBREF(A)	;GET REF DATE
	AND C,DIRRDU		;MASK CORRECT BITS
	MOVE D,B		;GET NEW TIME
	AND D,DIRRDU		;MASK HERE ALSO
	TRNN F1,OF%FDT		;FORCE UPDATE?
	CAME C,D		;IF NOT EQUAL DO UPDATE
	SKIPA			;YES DO UPDATE
	JRST OPENF4		;NO UPDATE
	MOVEM B,.FBREF(A)	;YES, UPDATE LAST READ DATE
	AOS .FBCNT(A)
	; ..
;DSKOPN, READ AND WRITE CASES JOIN HERE

OPENF4:	MOVEI B,0
	TQNE <RNDF>
	TQNE <READF,XCTF>
	MOVE B,.FBSIZ(A)	;GET SIZE OF FILE
	MOVEM B,FILLEN(JFN)	;TO OPEN FILE LENGTH
	MOVEM B,FILBYN(JFN)
	TQNE <RNDF>
	SETZM FILBYN(JFN)
	SETZM FILWND(JFN)	;CLEAR THE WINDOW
	PUSH P,A
	LOAD A,FBBSZ,(A)	;GET BYTE SIZE
	SKIPN A
	MOVEI A,^D36
	LDB B,[POINT 4,STS,35]
	CAIN B,17
	SKIPA B,[^D36]		;DUMP MODE ALWAYS 36 BIT BYTES
	LOAD B,FLBSZ,(JFN)
	CAILE B,^D36
	JRST [	POP P,A
		MOVEI A,SFBSX2
		JRST OPENF6]
	CALL NFBSZ
	POP P,B
OPENF9:	MOVE A,.FBADR(B)	;GET XB ADR
	MOVE C,.FBCTL(B)
	TRNE F1,OF%RTD		;RESTRICTED ACCESS REQUESTED?
	JRST [	TXO A,THAWB	;YES, MEANS THAWB ON, FILWB OFF
		JRST OPENA2]
	TRNE F1,OF%THW		;THAWED ACCESS?
	JRST [	TXO A,THAWB+FILWB ;YES, MEANS BOTH ON
		JRST OPENA2]
	TXNE F1,OF%RDU		;UNRESTRICTED?
	JRST [	TXO A,FILUB	;YES, NOT FOR ASGOFN
		TQO JFNUB	;REMEMBER FOR CLOSE
		JRST OPENA2]
	TQNE <WRTF>
	TLO A,(FILWB)
OPENA2:	TXNN F1,OF%DUD		;WANT DUD ACTION?
	JRST OPENA1		;NO. GO DO THE OPEN
	TXO A,OFNDUD		;SET DUD ACTION IN THE OFN
	TQO <FILDUD>		;SET DUD IN FILSTS FOR LATER
OPENA1:	TXNE C,FB%LNG
	JRST OPNLNG		;LONG FILES ARE OPENED PECULIARLY
	TLNN A,(FILNB)		;NEW FILE
	JRST OPENF2		;NO
	; ..
;HERE TO OPEN A NEW FILE

	PUSH P,B		;SAVE FDB ADR
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL ASFOFN		;GET AN OFN FOR THE FILE
	 JRST OPENF5
BP$003:				;BREAKPOINT FOR OPEN NEW FILE
				;ASSUMPTIONS: JOB CONTEXT, STACK, OFN IN T1
				;OFFSET FOR JOB'S OFN TABLE IN  11
				;THESE ASSUMPTIONS HOLD FOR BP$003-BP$009
	HRLM A,FILOFN(JFN)
	TRNN F1,OF%THW		;THAWED OPEN?
	JRST [	POP P,B		;NO, RECOVER FDB ADR
		JRST OPENF3]
	CALL UPDOFN		;YES, MUST WRITE NEW XB ON DISK
	POP P,B			;RECOVER FDB ADR
	MOVX C,FILNB
	ANDCAM C,.FBADR(B)	;CLEAR NEW FILE AND NONX BITS
	MOVX C,FB%NXF
	ANDCAM C,.FBCTL(B)
	TQZ <NONXF>		;REMEMBER IN STS THAT FILE EXISTS
	JRST OPENF3

;HERE TO OPEN AN EXISTING FILE

OPENF2:
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL ASFOFN		;GET AN OFN FOR THIS FILE
	 JRST OPENF6
BP$004:				;BREAKPOINT FOR OPEN EXISTING FILE
				;SEE ASSUMPTIONS FOR BP$003
	HRLM A,FILOFN(JFN)
OPENF3:	TQO <WNDF>		;NO WINDOWS YET, AND ALLOW SIZE CHANGE
	TQNN <WRTF>		;OPENING FOR WRITE?
	IFSKP.			;IF SO
	 MOVE B,OPNFDB		;GET FDB ADDRESS
	 SETONE FB%WNC,.FBCTL(B) ;AND SET WRITE IN PROGRESS BIT
	ENDIF.
	LOAD B,STR,(JFN)	;GET INDEX INTO STRTAB
	MOVE B,STRTAB(B)	;GET POINTER TO SDB
	INCR STROF,(B)		;INCREMENT OPEN FILE COUNT
	CALL GETLEN		;SETUP FILLEN FROM OFN
	CALL USTDIR
	RETSKP

OPENF5:	POP P,B
OPENF6:	CALL USTDIR
	RET
;HERE TO OPEN A LONG FILE

OPNLNG:
	CALL GASOG		;Get ASOFN args
	TXO A,OFNPTT
	BLCAL. ASNOFN,<T1,T2,T3,T4,[0]>	;ASSIGN OFN FOR PT TABLE
	 JRST OPENF6		;BUSY
BP$005:				;BREAKPOINT FOR  GET EXISTING PTT
				;SEE ASSUMPTIONS FOR BP$003
	HRRM A,FILOFN(JFN)	;SAVE OFN
	CALL ASGPAG		;ASSIGN A PAGE TO MAP THE PT TABLE
	 JRST OPNLN1		;NONE AVAILABLE
	HRRM A,FILLFW(JFN)	;SAVE LONG FILE PT LOCATION
	MOVE B,A
	HRLI B,(PTRW)
	HRRZ A,FILOFN(JFN)
	CALL SETMPG		;MAP THE PT TABLE
	MOVE C,A
	HRRZS B			;REMOVE HIGH ORDER JUNK
	LOAD A,STGADR,0(B)	;GET PT 0 ADDRESS
	SKIPN A			;BE SURE THERE IS ONE
	BUG.(HLT,NOPGT0,DISC,SOFT,<OPNLNG - No page table 0 in long file.>,,<

Cause:	There is no page 0 for long file being opened.
>)
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	TRNE F1,OF%RTD		;RESTRICTED ACCESS REQUESTED?
	JRST [	TXO A,THAWB	;YES, MEANS THAWB ON, FILWB OFF
		JRST OPNLN4]
	TRNE F1,OF%THW		;THAWED ACCESS?
	JRST [	TXO A,THAWB+FILWB ;YES, MEANS BOTH ON
		JRST OPNLN4]
	TXNE F1,OF%RDU		;UNRESTRICTED?
	JRST [	TXO A,FILUB	;YES, NOTE FOR ASGOFN
		TQO JFNUB	;REMEMBER FOR CLOSE
		JRST OPNLN4]
	TQNE <WRTF>
	TLO A,(FILWB)
OPNLN4:	TXNE F1,OF%DUD		;WANT TO SUPPRESS DDMP?
	TXO A,OFNDUD		;YES. REQUEST IT THEN
	SETZ T4,		;SECTION 0
	CALL ASLOFN		;ASSIGN AN OFN FOR IT
	 JRST OPNLN2		;HAPPENS ONLY IF DATA ERROR IN PT
BP$007:				;BREAKPOINT FOR PT-0 OF LONG FILE
				;SEE ASSUMPTIONS FOR BP$003
	HRLM A,FILOFN(JFN)	;SAVE AS OFN OF CURRENT PT
	STOR A,FLP0,(JFN)	;SAVE IT IN THE JFN BLOCK
	CALL UP0SHR		;EXTRA COUNT ON PT0 TO PREVENT RELEASE
	TQO <LONGF>
	JRST OPENF3		;SET BITS AND EXIT

OPNLN2:	PUSH P,A		;SAVE ERROR CODE
	HRRZ B,FILLFW(JFN)
	MOVEI A,0
	CALL SETMPG
	HRRZ A,B
	CALL RELPAG
	JRST OPNLN3

OPNLN1:	PUSH P,[OPNX17]
OPNLN3:	HRRZ A,FILOFN(JFN)
	TQNE <WRTF>		;FILE OPEN FOR WRITE?
	TXO A,FILWB		;YES, PROPAGATE BIT
	TQNE JFNUB		;DITTO UNRESTRICTED
	TXO A,FILUB
	CALL RELOFN
	POP P,A
	JRST OPENF6
; Disc sequential input
; Call:	JFN	; Job file number
;	STS	; File status
;	FILBYT ETC. SETUP PROPERLY FOR NEXT BYTE
;	CALL DSKSQI
; Returns +1 with a byte in a

DSKSQI:	EA.ENT
	MOVE B,FILBYN(JFN)
	CAML B,FILLEN(JFN)
	JRST DSKSEI		;CHECK FOR EOF
	TQNE <WNDF>		;HAS WINDOW BEEN SET UP YET?
	CALL SETWND		;NO, SET IT UP
	SOSGE FILCNT(JFN)
	 JRST DSKSI1		;TRY FOR NEW WINDOW
	ILDB A,FILBYT(JFN)	;GET NEXT BYTE
	AOS FILBYN(JFN)		;COUNT BYTES
	RET

; Disc sequential output
; Call:	JFN	; Job file number
;	STS	; File status
;	FIL BYT ETC SET UP
;	A	; A byte
;	CALL DSKSQO

DSKSQO:	EA.ENT
	TQNE <WNDF>		;HAS A WINDOW BEEN SET UP?
	CALL SETWND		;NO, SET IT UP
	SOSGE FILCNT(JFN)
	JRST [	CALL NEWWND	;SETUP NEW WINDOW
		 RET		;LOST - RETURN ERROR INFO
		SOS FILCNT(JFN)	;COUNT THIS BYTE
		JRST .+1]
	IDPB A,FILBYT(JFN)	;DEPOSIT THE BYTE
	AOS B,FILBYN(JFN)	;COUNT BYTES
	CAMGE B,FILLEN(JFN)	;BEYOND THE END?
	RET			;NO, DONE.
	TQO <EOFF>		;YES, SET EOFF
	MOVEM B,FILLEN(JFN)	;UPDATE NEW LENGTH
	CALLRET UPDLEN		;UPDATE OFN LENGTH
;DISK SEQUENTIAL INPUT EOF CHECK
;C(B) := FILBYN

DSKSEI:	CALL GETLEN		;GET ACTUAL LENGTH
	CAML B,FILLEN(JFN)	;OVER REAL EOF?
	JRST [	TQO <EOFF>	;YEP, RETURN FLAG
		RET]
	SETZM FILCNT(JFN)	;CLEAR COUNT
	JRST DSKSQI		;AND TRY AGAIN

DSKSI1:	CALL NEWWND		;GET NEW WINDOW
	 RET			;LOST, ERROR ALREADY SET
	MOVE B,FILLEN(JFN)
	SUB B,FILBYN(JFN)	;COMPUTE BYTES LEFT IN FILE
	CAMGE B,FILCNT(JFN)	;THIS BUFFER PASSES EOF?
	MOVEM B,FILCNT(JFN)	;YES, REDUCE BUFFER COUNT
	JRST DSKSQI		;TRY AGAIN

;ROUTINE TO CALCULATE CORRECT # OF BYTES IN THIS PAGE

ADJCNT:	LOAD A,FLBSZ,(JFN)	;GET CURRENT BYTE SIZE
	MOVEI C,^D36
	IDIV C,A		;GET BYTES PER WORD
	IMULI C,1000		;GET BYTES PER PAGE
	MOVEM C,FILCNT(JFN)	;SAVE AS COUNT
	MOVN B,FILBYN(JFN)	;GET BYTE NUMBER
	IDIV B,C		;REMAINDER IS NEGATIVE
	ADDM C,FILCNT(JFN)	;ADJUST IF NOT AT BEGINNING OF PAGE
	RET
; Disk dump io
; A/ IOWD FOR XFER

DSKDMI:	TDZA B,B
DSKDMO:	MOVEI B,1
	EA.ENT
	STKVAR <SVIOWD,SVFLGS,SVIOW1>
	TQNE <NWTF>		;NO-WAIT REQUESTED?
	JRST [	TQO <ERRF>	;NOT SUPPORTED, ERROR
		RETBAD (DUMPX5)] ;ILLEGAL MODE
	MOVEM A,SVIOWD		;SAVE ORIGINAL IOWD
	MOVEM A,SVIOW1		;WORK WORD
	MOVEM B,SVFLGS		;SAVE FLAG
	TQNE <WNDF>
	 CALL SETWND
DMPLP:	SKIPL SVIOW1
	JRST [	MOVE A,SVIOWD	;RECOVER ORIGINAL WORD
		RETSKP]
	MOVE B,FILBYN(JFN)
	SKIPN SVFLGS		;WRITING?
	CAMGE B,FILLEN(JFN)	;OR NOT PAST EOF
	SKIPA			;IS OK
	 JRST DSKDEI		;CHECK REAL EOF
	SOSGE FILCNT(JFN)
	 JRST DSKDI1		;NEW WINDOW
	AOS FILCNT(JFN)
	HLRE A,SVIOW1		;IOWD COUNT
	MOVMS A			;MAGNITUDE
	CAML A,FILCNT(JFN)
	 MOVE A,FILCNT(JFN)	;KEEP LESSER OF THE TWO
	MOVE C,A		;KEEP COPY OF COUNT
	ADDB A,FILBYN(JFN)	;UPDATE FILBYN
	CAML A,FILLEN(JFN)
	 CALL [	MOVEM A,FILLEN(JFN)
		CALLRET UPDLEN]	;UPDATE LENGTH
	MOVN A,C		;NEG OF COUNT
	ADDM A,FILCNT(JFN)	;DECREASE FILCNT
	MOVE A,FILBYT(JFN)	;GET COPY OF BYTE POINTER
	ADDM C,FILBYT(JFN)	;UPDATE BYTE POINTER
	IBP A			;GETS LOC OF FIRST WORD OF FILE
	XSFM T2			;Get previous context section
	TXNN T2,PCU		;User mode?
	BUG.(CHK,DMPIOM,DISC,SOFT,<DSKDM - I/O disk dump mode I/O called from monitor>,,<

Cause:	DSKDMI or DSKDMO called and the previous context indicates
	an exec mode DUMPI% or DUMPO% JSYS, where there aren't any.

Action:	If this becomes persistent, change this to a BUGHLT and submit
	an SPR. Look at the code because something is broken.
	It is also possible that some code has been changed to
	do dump mode I/O.
>)
	ANDI T2,EXPCS		;Keep previous context section only
	HRLZS T2		;Put in proper place
	HRR T2,SVIOW1		;Get command list address
	AOS T2			;Add one to pointer
	HRRZS A			;GET RID OF HIGH ORDER BYTE POINTER
	EXCH A,C		;PUT COUNT IN A AND END ADDRESS IN C
	HLRE D,SVIOW1		;GET COUNT
	ADD D,A			;UPDATE THE COUNT
	ADDM A,SVIOW1		;UPDATE IOWD
	HRLM D,SVIOW1		;UPDATE THE COUNT
	SKIPN SVFLGS		;WRITE?
	JRST DMPRED		;NO
	CALL BLTUM
	JRST DMPLP

DMPRED:	EXCH B,C		;GET SOURCE/DEST CORRECT
	CALL BLTMU
	JRST DMPLP
;CHECK ACTUAL EOF FOR DUMP INPUT
;C(B) := FILBYN

DSKDEI:	CALL GETLEN		;GET ACTUAL OFN LEN
	CAML B,FILLEN(JFN)	;OVER EOF
	JRST [	TQO <EOFF>
		RETBAD (IOX4)]	;YES, RETURN EOF
	SETZM FILCNT(JFN)	;CLEAR COUNT
	JRST DMPLP

DSKDI1:	CALL NEWWND		;NEED NEW WINDOW
	 RET			;LOST, RETURN ERROR
	SKIPE SVFLGS		;WRITING?
	JRST DMPLP		;YES, PROCEED
	MOVE B,FILLEN(JFN)
	SUB B,FILBYN(JFN)	;COMPUTE BYTES LEFT IN FILE
	CAMGE B,FILCNT(JFN)	;THIS BUFFER PASSES EOF?
	MOVEM B,FILCNT(JFN)	;YES, REDUCE BUFFER COUNT
	JRST DMPLP		;NO TRY AGAIN
; Set up a window for a file
; Call:	CALL SETWND

SETWND:	PUSH P,A
	CALL ASGPAG		;ASSIGN A JOB PAGE
	JRST [	TQO <ERRF>
		POP P,A
		POP P,0(P)	;POP RETURN OFF STACK
		RET]		;AND RETURN ONE LEVEL BACK
	HRRM A,FILWND(JFN)
	TQZ <WNDF>
	SETZM FILCNT(JFN)	;FORCE NEW WINDOW NEXT OPERATION
	POP P,A
	RET
; Set up pointers to a file , PRESERVES AC(A)
; Call:	FILBYN(JFN)	; File byte number
;	FILBYT(JFN)	; Byte size bits
;	LH(FILWND(JFN))	; Current page number
;	RH(FILWND(JFN))	; File window location
;	ETC.
;	CALL NEWWND	;WILL CREATE LONG FILE PT IF NECESSARY
;OR	CALL NEWWNB	;WILL GIVE ERROR IF LONG FILE PT MUST BE CREATED
;RETURNS +1 ERROR - ENDF OR XQTAF ON
;RETURNS +2 OK

NEWWNB:	TDZA B,B		;NO PT CREATES
NEWWND:	SETO B,			;ALLOW PT CREATES
	EA.ENT
	TQNE <WNDF>
	RETSKP			;DO NOTHING IF NO WINDOW YET
	STKVAR <NWSAVA,NWSAVB,NWSAVW,NWSAVI>
	MOVEM A,NWSAVA		;PRESERVE A
	MOVEM B,NWSAVB		;SAVE PT FLAG
	LOAD A,FLBSZ,(JFN)	;GET CURRENT BYTE SIZE
	MOVEI C,^D36
	IDIV C,A		;GET BYTES PER WORD
	MOVE B,FILBYN(JFN)	;GET CURRENT BYTE NUMBER
	CAMLE B,FILLEN(JFN)
	 CALL [	MOVEM B,FILLEN(JFN)
		CALLRET UPDLEN]	;UPDATE OFN LENGTH
	IDIV B,C		;CURRENT WORD IN B, OFFSET IN B+1
	IMUL C,A		;OFFSET TIMES BYTE SIZE
	MOVN C,C
	ADDI C,^D36
	STOR C,FLBPO,(JFN)	;YIELDS BYTE POINTER POSITION
	MOVE C,B
	MOVEM C,NWSAVW		;SAVE FOR LATER
	LSH C,-9		;GET PAGE NUMBER
	HLRZ B,FILWND(JFN)	;GET CURRENT PAGE NUMBER
	TRNE B,777
	CAME B,C
	JRST NEWWNA		;NEED TO SET UP A NEW WINDOW
	; ..
NEWWNZ:	MOVE C,NWSAVW		;RESTORE WORD NUMBER
	ANDI C,777		;GET RELATIVE TO PAGE ORIGIN
	HRRZ B,FILWND(JFN)
	IOR B,C			;GET ABSOLUTE ADDRESS
	HRRM B,FILBYT(JFN)	;PUT INTO BYTE POINTER
	CALL ADJCNT		;ADJUST FILCNT
	MOVE A,NWSAVA		;RESTORE A
	RETSKP

NEWWNA:	HRRZ B,FILWND(JFN)	;UNMAP WINDOW BEFORE POSSIBLY RELEASING OFN
	SETZ A,
	CALL SETMPG
	HRRZ A,C
	MOVE B,NWSAVB		;GET PT CREATE FLAG
	CALL JFNOF5		;GET OFN.PN FOR THIS PAGE
	 JRST [	TQNE <WRTF>	;HAVE WRITE ACCESS?
		SKIPN NWSAVB	;ALLOWING PT CREATES?
		CAIE A,LNGFX1	;NO. OTHER THAN PT CREATE?
		TQOA <ERRF>	;YES. GIVE ERROR
		JRST [	HRRZ B,FILWND(JFN) ;NO.
			SETZM 0(B) ;INVENT A PAGE OF ZEROES
			JRST NEWWNZ] ;AND GO ON, BUT DON'T CHNAGE PN
		MOVE C,NWSAVW	;GET WORD
		MOVE A,NWSAVA	;RESTORE A
		RET]
	MOVEM A,NWSAVI		;SAVE IDENT
	TQNN <WRTF>		;HAVE WRITE ACCESS?
	JRST [	CALL MRPT	;GET ACCESS INFO
		 JFCL		;DON'T CARE YET
		TXNE B,PA%PEX	;DOES THIS PAGE EXIST?
		JRST .+1	;YES. ALLOW MAPPING THEN
		HRRZ B,FILWND(JFN) ;NO. GET WINDOW ADDRESS
		SETZM 0(B)	;CREATE A PAGE OF ZEROES
		JRST NEWNA1]	;AND PROCEED
	HRRZ B,FILWND(JFN)
	HRLI B,(PTRW)
	MOVE A,NWSAVI		;GET IDENT
	CALL SETMPG		;MAP THE THE PAGE
	TQNN <WRTF>		;WRITING?
	JRST NEWNA1		;NO - PROCEED
	HRRZ A,FILWND(JFN)	;YES - CHECK EXISTENT PAGE
;TCO 1855 - DON'T WRITE THE FILE PAGE AT NEWWNA
	SKIP 0(A)		;TOUCH IT
	ERJMP NEWWNQ		;JUMP IF ACCESS ERROR
NEWNA1:	MOVE C,NWSAVW		;GET DESIRED WORD
	LSH C,-9		;MAKE INTO PAGE #
	HRLM C,FILWND(JFN)
	JRST NEWWNZ		;AND FINISH UP
;HERE ON ERROR - CHECK REASON

NEWWNQ:	MOVE A,NWSAVI		;GET IDENT
	CALL MRPACS		;GET ACCESS INFO
	MOVE C,NWSAVW		;RESTORE WORD NUMBER
	TXNE A,PA%PEX		;DOES PAGE EXIST
	TQOA <ERRF>		;YES - ILLEGAL WRITE THEN
	TQO <XQTAF>		;NO - QUOTA EXCEEDED
	HRRZI A,JSKP		;SCHEDULER NO-OP
	RET			;RETURN
; New page table for long file
; C/ DESIRED PT NUMBER
;A/ PT CREATE FLAG

NEWLFP:	EA.ENT
	TRVAR <NLFPN,NLFT1,NLFT2,NLFLG> ;PAGE NO, TEMPS
	MOVEM A,NLFLG		;SAVE ENTRY FLAG
	MOVEM C,NLFPN
	SETZM NLFT2		;SAY NO SPECIAL OFN HANDLING
	TQNE <LONGF>		;IS THIS FILE ALREADY LONG?
	JRST NEWLFT		;YES, NO SWEAT
	CALL GETFDB		;NO, LET'S GET THE FDB
	BUG.(HLT,GTFDB2,DISC,SOFT,<NEWLFP - GETFDB failure for open file>,,<

Cause:	The FDB for a long file cannot be found, even though the FDB for
	that file was found previously.  The file is opened, but the FDB is
	gone.
>)
	MOVE C,.FBCTL(A)	;AND SEE IF IT'S BECOME LONG
	TXNE C,FB%LNG		;SINCE WE OPENED IT
	JRST NEWFLL		;YES, IT HAS
	SKIPE NLFLG		;ALLOWED TO CREATE PAGE TABLES?
	TQNN <WRTF>		;FILE OPEN FOR WRITE?
	JRST [	CALL USTDIR	;UNLOCK DIRECTORY
		RETBAD LNGFX1]	;NO, WRONG
	TMNE FB%DIR,.FBCTL(A)	;IS THIS A DIRECTORY FILE?
	 CALLRET USTDIR		;YES THIS IS ILLEGAL
	MOVEM A,NLFT1		;SAVE FDB LOCATION
	MOVE A,.FBADR(A)	;GET DISC ADDRESS OF PT 0
	TXNN A,FILNB		;NEW FILE?
	JRST NEWLP1		;NO
	HLRZ A,FILOFN(JFN)	;YES, FIX ON DISK BEFORE MAKING LONG
	CALL UPDOFN
	MOVE B,NLFT1		;RECOVER FDB ADR
	MOVX A,FILNB
	ANDCAB A,.FBADR(B)	;CLEAR NEW FILE STATUS
NEWLP1:
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL DSKASN		;ASSIGN A PAGE FOR THE PT TABLE
	 CALLRET USTDIR		;NO ROOM
	TLO A,(FILNB)		;MARK AS NEW
	MOVEM A,NLFT2		;SAVE IT
	CALL NEWLFS		;ASSIGN OFN ETC
	IFNSK.			;[7403] Failed
	  EXCH A,NLFT2		;[7403] Save error code temporarily & get disk address
	  LOAD B,STR,(JFN)	;[7403] Get structure number from JFN block
	  CALL DEDSK		;[7403] Release it
	  EXCH A,NLFT2		;[7403] Get error code back
	  CALLRET USTDIR	;[7403] Now give fail return
	ENDIF.			;[7403]
	HRRZ A,FILOFN(JFN)	;GET OFN JUST ASSIGNED
	CALL UPDOFN		;WRITE IT TO DISK
	HLRZ A,FILOFN(JFN)	; GET OFN OF PT0
	HRLZ T2,FILOFN(JFN)	;GET XB2DAT (PTT OFN,,0)
	EXCH T2,SPTO4(T1) ;SAVE IT
	SKIPE T2		;OK. CHECK FOR STRANGE RACES
	BUG.(HLT,LNGLNG,DISC,SOFT,<NEWLFP - File going long is already long>,,<

Cause:	A file is becoming long for the first time. This BUG indicates that
	the file is already long.
>)	
	CALL UP0SHR		;DO THE EXTRA COUNT ON PT0
	STOR A,FLP0,(JFN)	;REMEMBER OFN OF PT0
	MOVE C,NLFT2		;GET DISK ADDRESS
	MOVE A,NLFT1		;GET FDB ADR
	TXZ C,FILNB		;[7439] Clear FILNB, not needed in FDB
	EXCH C,.FBADR(A)	;STORE NEW DISC ADDRESS, GET OLD
	HRRZ B,FILLFW(JFN)	;GET PTT WINDOW ADDRESS
	ANDX C,STGADM		;EXTRACT STG ADDRESS
	IOR C,IMMPTR		;CONSTRUCT STANDARD PTR
	MOVEM C,0(B)		;STORE OLD DISC ADDRESS AS PT 0
	HRRZ C,FILOFN(JFN)	;GET PTT OFN
	MOVX D,OFNWRB
	IORM D,SPTH(C)		;NOTE OFN MODIFIED
	MOVX D,FB%LNG
	IORM D,.FBCTL(A)	;MARK .FB AS LONG FILE
;   IFN CFSCOD,<
	LOAD A,FLP0,(JFN)	;Get old XB
	CALL FRECFL		;Free the open file resources
	HRRZ A,FILOFN(JFN)	;Get PTT OFN
	CALL GETCFL		;And assign CFS resources to it
	 NOP			;Will work
;   >	;IFN CFSCOD
;
; NOTE: THIS SETTING OF OFN2XB MUST OCCUR AFTER THE FRECFL CALL ABOVE
;	THIS IS BECAUSE FRECFL OPERATES DIFFERENTLY ON SECOND LEVEL OFNS
;	AND THIS OFN WAS PREVIOUSLY A NORMAL AND NOT A 2XB SO IT
;	SHOULD BE TREATED LIKE A NORMAL OFN BY FRECFL
;
	LOAD T1,FLP0,(JFN)	;GET XB FOR SECTION 0
	SETONE OFN2XB,SPTH(T1)	;NOW A 2XB
	JRST NEWLF1		;CONTINUE WITH REST


NEWLFS:
	CALL CHKDUD		;CHECK IF DDMP BEING SUPPRESSED
	HLRZ B,FILOFN(JFN)	;GET OLD OFN
	MOVE B,SPTH(B)		;GET SPTH ENTRY (FOR FLAGS)
	ANDX B,THAWB+FILWB	;PRESERVE THESE
	IOR A,B			;IN NEW OFN
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL ASPOFN		;ASSIGN OFN FOR NEW DISC ADDRESS
	 RET			;FAIL
BP$006:				;BREAKPOINT FOR  MAKE NEW PTT FOR LONG FILE
				;SEE ASSUMPTIONS FOR BP$003
	HRRM A,FILOFN(JFN)	;SAVE
	CALL ASGPAG		;GET A PAGE TO MAP THE PT TABLE
	IFNSK.			;[7403] Failed, JSB full
	  HRRZ A,FILOFN(JFN)	;[7403] Get OFN for this file
	  HLLZS FILOFN(JFN)	;[7403]
	  CALL RELOFN		;[7403] (T1/) Release this OFN
	  RETBAD(MONX02)	;[7403] Tell caller we have no more JSB space
	ENDIF.			;[7403]
	HRRM A,FILLFW(JFN)	;STORE LOCATION OF PT TABLE
	MOVE B,A
	HRLI B,(PTRW)
	HRRZ A,FILOFN(JFN)
	CALL SETMPG
	HLRZ B,FILOFN(JFN)	;OLD JFN
	MOVE B,OFNLEN(B)	;COPY OFN LENGTH ENTRY
	MOVEM B,OFNLEN(A)	; TO PTT ENTRY
	RETSKP

NEWFLL:	MOVE A,.FBADR(A)	;FILE BECAME LONG SINCE WE OPENED
	CALL NEWLFS		;MAP THE PT TABLE
	 CALLRET USTDIR		;FAILED
	HLRZ T1,FILOFN(JFN)	;DO THE EXTRA COUNT ON PT0
	CALL UP0SHR
	STOR A,FLP0,(JFN)	;REMEMBER PT0
NEWLF1:	CALL USTDIR		;FINISHED WITH DIRECTORY
	TQO <LONGF>
;HERE IF PTT EXISTS

NEWLFT:
;   IFN CFSCOD,<
	HRRZ A,FILOFN(JFN)	;Get OFN of PTT
	TQNN <WRTF>		;Writing?
	TDZA B,B		;No
	MOVEI B,1		;Access needed
	CALL CFSAWP		;Get the token here
;   >	;IFN CFSCOD
	HRRZ B,FILLFW(JFN)	;GET LOCATION OF PT TABLE
	ADD B,NLFPN		;OFFSET BY PT # TO GET DISC ADDR
	LOAD A,STGADR,0(B)	;GET ADR OF DESIRED PT
	JUMPN A,NEWLFA		;JUMP IF EXISTENT
	SKIPE NLFLG		;ALLOWED TO CREATE PT'S?
	TQNN <WRTF>		;FILE OPEN FOR WRITE?
	RETBAD (LNGFX1,<	;NO. PREVENT PAGE TABLE CREATION
;   IFN CFSCOD,<
		CALL FRETOK
;   >
				>)
	MOVEM B,NLFT2		;SAVE PTR ADDRESS
	HLRZ A,FILOFN(JFN)	;GET OFN OF PT TABLE
	MOVE A,SPTH(A)		;GET DISC ADDRESS OF PT TABLE
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL DSKASN		;GET A NEW DISC ADDRESS
	 JRST [
;   IFN CFSCOD,<
		CALL FRETOK
;   >
		RET]
	MOVEM A,NLFT1		;SAVE DISK ADR
	TXO A,FILNB		;NOTE NEW XB
	CALL CHKDUD		;CHECK IF DDMP BEING SUPPRESSED
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	MOVE T4,NLFPN		;GET FILE SECTION NUMBER
	CALL ASLOFN		;ASSIGN OFN FOR NEW IB
	 JRST [	MOVE A,NLFT1	;GET DISK ADDRESS
		LOAD B,STR,(JFN) ;GET STRUCTURE NUMBER FROM JFN BLOCK
		CALL DEDSK	;GIVE IT BACK
;   IFN CFSCOD,<
		CALL FRETOK
;   >
		RET]
	; ..
;NEWLFT...
BP$008:				;BREAKPOINT FOR MAKE NEW PT IN LONG FILE
				;ASSUMES PT-# IN  -2(P)
				;SEE ASSUMPTIONS FOR BP$003
	CALL UPDOFN		;WRITE IT TO DISK
	EXCH A,NLFT1		;GET DISK ADDRESS SAVE OFN
	MOVE B,NLFT2		;GET PTR ADDRESS
	IOR A,IMMPTR		;CONSTRUCT STANDARD PTR
	EXCH A,(B)		;CHECK FOR IMPOSSIBLE? RACES
	SKIPE A			;SHOULD BE NEW
	BUG.(HLT,XTRAPT,DISC,SOFT,<NEWLFT - Extra page table in long file>,,<

Cause:	The monitor is attempting to create a new file section in a long
	file. This BUGHLT indicates that the page table slot in the super PT
	already contains a pointer to a second level PT. This indicates a race
	of some kind when a a new page table is created.
>)
	MOVE A,(B)		;GET POINTER AGAIN
	EXCH A,NLFT1		;SAVE PTR GET OFN BACK

	MOVNM 1,NLFT2		;NEGATIVE MEANS OFN
	HRRZ A,FILOFN(JFN)	;GET PTT OFN
	MOVX B,OFNWRB
	IORM B,SPTH(A)		;NOTE IT CHANGED
	CALL UPDOFN		;UPDATE PTT FOR NEW PT WITHIN IT
	SKIPA A,NLFT1		;GET PTR SKIP USLESS MOVEM
NEWLFA:	MOVEM A,NLFT1		;SAVE DSK ADR
;   IFN CFSCOD,<			;Free up access token
	CALL FRETOK
;   >	;IFN CFSCOD
	HLRZ A,FILOFN(JFN)	;GET OFN OF OLD PT
	CALL UPDOFN		;WRITE IT TO DISK BEFORE RELEASING
	SKIPGE A,NLFT2		;GET OFN IF NEGATIVE
	IFSKP.			;NOT NEGATIVE REALLY ASSIGN OLD ONE
	   MOVE T1,NLFT1	;GET STGADR
	   ANDX T1,STGADM	;ONLY
	   CALL CHKDUD		;CHECK IF DDMP BEING SUPPRESSED
	   LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	   MOVE T4,NLFPN	;GET PN
	   CALL ASLOFN		;ASSIGN LONG PT OFN
	    RET			;FAIL
	ELSE.
	   MOVNS A		;GET TRUE NEW OFN
	ENDIF.
	HLRZ B,FILOFN(JFN)	;GET OFN FOR OLD PAGE
BP$009:				;BREAKPOINT FOR GET EXISTING PT IN LONG FILE
				;ASSUMES  PT-# IN 0(P)
				;SEE ASSUMPTIONS FOR BP$003
	HRLM A,FILOFN(JFN)	;SET NEW OFN
	MOVE A,B		;RELEASE OLD OFN
	CALL RELOFN
	MOVE C,NLFPN		;RESTORE PN TO C
	RETSKP
;ROUTINE TO CHECK IF THIS FILE OPENING IS SUPPRESSING DDMP. WILL
;SET OFNDUD BIT IN A IF SO

CHKDUD:	TQNE <FILDUD>		;WAS OF%DUD SET ON OPEN?
	TXO A,OFNDUD		;YES. REQUEST IT IN THE ASOFN CALL
	RET			;AND DONE

;Routine to release access token after munging PTT

;   IFN CFSCOD,<
FRETOK:	HRRZ T1,FILOFN(JFN)	;Get PTT OFN
	CALLRET CFSFWT		;Free it
;   >	;IFN CFSCOD
; Convert jfn.pn to ofn.pn
; Call:	LH(A)	; Jfn
;	RH(A)	; Page number
;	B	; PT CREATE FLAG IF ENTRY IS AT JFNOF4
;	CALL JFNOFN
;OR	CALL JFNOF4
; Return
;	+1	; Error, illegal jfn or page number too big
;	+2	; Ok
;	LH(A)	; Ofn
;	RH(A)	; Page number
;	B/ JFN STATUS

JFNOFN::SETO B,			;ASSUME CAN CREATE PT IF USER HAS WRITE ACCESS
JFNOF4::SAVEP
	EA.ENT
	CALL JFNOF0		;DO THE ACTUAL WORK
	 RET			;FAILED
	MOVE B,STS		;RETURN STS IN B
	RETSKP			;DO SKIP RETURN UNLESS SOS ABOVE

JFNOF0:	HLRZ JFN,A
	PUSH P,B		;SAVE PT CREATE FLAG
	PUSH P,A
	CALL DSKJFN		;CHECK FOR A DISK JFN
	 JRST [	POP P,ERRSAV	;WASN'T
		POP P,0(P)	;CLEAN UP THE STACK
		RETBAD()]
	POP P,A
	POP P,B			;GET BACK PT CREATE FLAG
	TQNN <OPNF>
	JRST [	MOVEI A,DESX5
		JRST UNLCKF]
	HRRZS A
	CALL JFNOF5
	 JRST .+2
	AOS (P)
	JRST UNLCKF
;ROUTINES TO CONVERT FROM JFN.PN TO OFN.PN AS FOLLOWS:
;	JFNOF3		;ERROR IF LONG FILE PT MUST BE CREATED
;	JFNOF1		;WILL CREATE LONG FILE PT IF NECESSARY
;	JFNOF5		;B= 0 IF LONG FILE PT SHOULD BE AN ERROR
			;B=NON-ZERO IF LONG FILE PAGE TABLE MAY BE
			; CREATED

JFNOF3::TDZA B,B		;REMEBER NO PAGE TABLE CREATE
JFNOF1::SETO B,			;CAN CREATE PAGE TABLE
	EA.ENT
JFNOF5:	TLNE A,777777
	RET
	PUSH P,B		;SAVE ENTRY FLAG
	PUSH P,A
	MOVEI A,0(JFN)		;GET JFN
	CALL DMOCHK		;MAKE SURE STILL MOUNTED
	 JRST [	ADJSP P,-2	;CLEAN UP STACK
		RET]		;AND GIVE ERROR
	MOVE A,0(P)		;RESTORE ARG
	HLRZ B,FILWND(JFN)	;GET CURRENT PAGE NUMBER
	XOR B,A
	TRNN B,777000		;IF DIFFERENT PAGE TABLES
	JRST JFNOF2
	LSH A,-9		;NEED SPECIAL ACTION
	MOVE C,A
	MOVE A,-1(P)		;GET ENTRY FLAG
	CALL NEWLFP		;CHANGE CURRENT PAGE
	 JRST [	ADJSP P,-2
		RET]
	SETZM FILCNT(JFN)	;FORCE ANY SEQUENTIAL IO TO REMAP
JFNOF2:	MOVE A,(P)
	TRZ A,777
	HRLM A,FILWND(JFN)
	POP P,A
	POP P,0(P)		;CLEAN UP STACK
	HLL A,FILOFN(JFN)
	ANDCMI A,777000		;MASK OUT PT NUMBER
	RETSKP
; Convert ofn.pn to jfn.pn
; Call:	LH(A)	; Ofn, 1B0 SAYS FIND ONLY JFN WITH PAGES MAPPED
;	RH(A)	; Pn
;	CALL OFNJFN
; Return
;	+1	; No jfn found
;	+2	; Ok
;	A	; Jfn.pn
; CALL OFNJFX  TO FIND ONLY JFN WITH PAGES MAPPED
;[7315] 
;[7315] OFNJFD is the same as OFNJFN except that dismounted OFNs and dismounted 
;[7315] structures are considered in the search.  This routine is only called 
;[7315] from ENQSET in CFSSRV when trying to find the structure name for a 
;[7315] dismounted OFN.
;[7315] 
;[7315]  Flag bit definitions - flags are in the left half of ARGI TRVAR word:
;[7315] 
          	MPGT0B==1B0	;[7315]  JFN's with mapcount greater than 0
		JFLOKB==1B1	;[7315]  Leave JFN locked upon exit
		OFDMOB==1B2	;[7315]  Match dismounted OFNs and structures
		ARGMSK==77777	;[7315]  Mask to use to mask off flag bits

OFNJFD::TXOA T1,OFDMOB		;[7315] Set bit to allow dismounted OFNs match
OFNJFX::TXO T1,MPGT0B		;[7315] Only JFN'S with mapcount greater than 0
OFNJFN:: EA.ENT
;	CALLRET OFNJF0		;DO THE WORK

OFNJF0:	SAVEAC <B,C,STS,JFN>	;PRESERVE THESE ACS (AMEN!!)
	TRVAR <ARGI,AOFN>
	MOVEM A,ARGI		;SAVE ORIGINAL ARGUMENT
	HLRZS A
	ANDI A,ARGMSK		;[7315] Mask off flag bits and just keep OFN
	MOVEM A,AOFN		;SAVE THE OFN AS WELL
	; ..
OFNJF7:	NOINT
	LOCK JFNLCK		;LOCK THE JFN STRUCTURE LOCK
	MOVE JFN,MAXJFN
	SOS JFN
	IMULI JFN,MLJFN		;CONVERT TO INTERNAL VALUE
OFNJF1:	MOVX STS,OPNF		;GET OPEN BIT
	HRRZ A,FILDEV(JFN)	;GET DEVICE CODE FOR THIS JFN
	TDNE STS,FILSTS(JFN)	;OPENED?
	CAIE A,DSKDTB		;YES. A DISK?
         JRST OFNJF2		;NO. CAN'T USE IT THEN
	CALL OFNJFT		;IS THIS THE OFN WE ARE LOOKING FOR?
         JRST OFNJF2		;THIS IS NOT OUR JFN
	AOSE FILLCK(JFN)	;YES AND YES. LOCK JFN. AND CHECK AGAIN
	JRST [	UNLOCK JFNLCK	;CAN'T!
		OKINT		;WAIT OKINT
		SKIPL FILLCK(JFN) ;FOR FILLCK TO FREE UP
		CBLK1
		JRST OFNJF7]	;START ANEW
	NOINT			;EXTRA NOINT FOR JFN LOCK
	CALL OFNJFT		;IS THIS STILL THE OFN WE ARE LOOKING FOR?
         JRST OFJF11		;THIS IS NOT OUR JFN
	MOVE B,ARGI		;[7338] Get flags
	MOVE A,FILLFW(JFN)
	TLNN A,777776		;IF PAGE MAP CNT .G. 0, CHECK OPNF
	SKIPL B			;[7338][7315] If no, see if we care
	CAIA			;OK TO USE IT
	JRST OFJF11		;CAN'T USE IT
	TXNE B,OFDMOB		;[7338][7315] Check for dismounted structure?
	JRST OFNJF3		;[7315] No, so this is our matching JFN
	MOVEI A,0(JFN)		;GET THE JFN
	CALL STRDMO		;YES. MAKE SURE STILL MOUNTED THEN
	 JRST OFJF11
	; ..
;FOUND A JFN TO USE.

OFNJF3:	MOVE T2,AOFN		;[7315] Get OFN back
	HRRZ T1,SPTO4(T2)	;GET XB2 DATA IF ANY
	LSH T1,PGSFT		;CONVERT TO PAGE OFFSET
	ADDM T1,ARGI		;AUGMENT THE PAGE #
	UNLOCK JFNLCK		;DON'T NEED THIS ANYMORE
	OKINT			;FREE LOCK
        MOVE A,JFN		;COPY JFN
	MOVE CX,ARGI		;GET ARG
	TXNE CX,JFLOKB		;[7315] Want to leave JFN locked?
	RETSKP			;YES. ALL DONE THEN
	CALL LUNLKF		;NO. UNLOCK JFN AND STRUCTURE
	OKINT			;FREE JFN LOCK OKINT
	MOVSI A,0(JFN)		;GET JFN,,0
	IDIVI A,MLJFN
	HRR A,ARGI		;GET PAGE #
	RETSKP			;AND DONE

OFNJFT:	MOVE T1,AOFN		;GET THE OFN
	MOVE T3,SPTO4(T1)	;GET AND VALIDATE DATA
	HLRZ T2,FILOFN(JFN)	;GET FILES "CURRENT" OFN
	JUMPE T2,R		;*** TEMP
	JUMPL T3,R		;[7329] Just return if OFN is now gone
	TMNN OFN2XB,SPTH(T1)	;ARE WE LOOKING FOR A 2XB?
	IFSKP.			;YES
	  JUMPLE T3,OFJBAD	;VALIDATE XB2DAT
	  HLRZ T1,T3		;REMEMBER SUPER XB OFN AS OFN OF SEARCH
	  SKIPG T2,SPTO4(T2)	;GET SUPER XB FOR FILES OFN IF ANY
	  RET			;NO FORGET FILE (OFN IS NOT LONG)
	  HLRZS T2		;GET SUPER ONLY
	ELSE.			;OFN DOES NOT BELONG TO A LONG FILE
	  JUMPN T3,OFJBAD	;VALIDATE XB2DAT
	ENDIF.
	CAME T1,T2		;SAME? SUPER=SUPER OR NORMAL=NORMAL
	RET			;NO
	MOVE T2,ARGI		;[7315] Get flag bits
	TXNE T2,OFDMOB		;[7315] Should the dismounted check be done?
	RETSKP			;[7315] No, consider this one the match
	MOVE T2,AOFN
	CALLRET CHKDMO		;FINAL CHECK IS DISMOUNTED
OFJF22:	MOVEI A,0(JFN)		;GET THE JFN
	CALL LUNLKF		;FREE SDB LOCK
	OKINT			;UNDO NOINT FROM JFN LOCK
OFNJF2:	SUBI JFN,MLJFN		;TO NEXT JFN INDEX
	JUMPGE JFN,OFNJF1
	UNLOCK JFNLCK
	OKINT
	RET

;IF HERE, CAN'T USE JFN

OFJF11:	UNLOCK FILLCK(JFN)	;FREE THE JFN LOCK
	OKINT			;AND THIS PART AS WELL
	JRST OFNJF2		;AND PROCEED

OFJBAD:	BUG.(HLT,OFJFBD,DISC,SOFT,<OFNJFN - OFNJFN found bad data>,,<

Cause:	An OFN was found whose bits indicated that it was or was not a
	secondary index block. SPTO4 was found to disagree.

Action:	One already discovered cause of this BUGHLT is the accidental
	clearing of the OFN2XB bit by CHKLAC. There may be other spots
	in the monitor where this bit is handled incorrectly.
>)
;SPECIAL ENTRIES FOR OFNJFN AND OFNJFX TO LEAVE THE JFN LOCKED

OFNJXL::TXOA A,MPGT0B+JFLOKB	;[7315] Set bits

OFNJFL::TXO A,JFLOKB		;[7315] Mark it
	CALLRET OFNJFN		;AND GO TO IT
;SPECIAL ROUTINE CALLED FROM CLOSF LOGIC TO UNMAP WINDOW PAGES OF
;A FILE IF IT WON'T CLOSE PROPERLY. SPECIFICALLY AIMED AT PREVENTING
;EXE FILES FROM TYING UP SWAPPING SPACE WHEN THEY CAN'T BE CLOSED
;BECAUSE PAGES ARE STILL MAPPED.
;ACCEPTS:	JFN/ THE JFN

DEWNDW::EA.ENT
	TQOE <WNDF>		;THIS FILE HAVE A WINDOW PAGE?
	RET			;NO
	HRRZ A,FILWND(JFN)	;YES. GET THE ADDRESS
	HLLZS FILWND(JFN)	;CLEAR WINDOW PAGE INDICATION
	CALLRET RELPAG		;RELEASE IT AND RETURN
; Disk close
; Call:	A/ CZ%ABT - DELETE NONX FILE
;	JFN	; Job file number
;	CALL DSKCLZ

DSKCLZ:	EA.ENT
	TRVAR <DMFLG,DSKCFD,DSKPAG,FLAGS,STSFLG> ;REMEMBER IF STRUCTURE IS DISMOUNTED
	MOVEM F,FLAGS		;SAVE F
	MOVEM A,F		;SAVE FLAG ARG
	SETZM DMFLG		;ASSUME NOT DISMOUNTED
	MOVEI A,0(JFN)
	CALL DMOCHK		;SEE IF DISMOUNTED
	 JRST [	SETOM DMFLG	;IT IS. REMEBER THIS
		TXNE F,CZ%ABT	;WANT AN ABORT CLOSE?
		JRST .+1	;YES. PROCEED
		MOVE A,F	;NO
		MOVE F,FLAGS	;RESTORE FLAGS
		RETBAD (DESX10)] ;AND GIVE ERROR
DSKCL9:	HRRZ A,FILWND(JFN)	;IF WINDOW PAGE EXISTS
	JUMPE A,DSKCL2
	CALL RELPAG		;RETURN PAGE TO FREE LIST
DSKCL2:	SKIPE DMFLG		;DISMOUNTED STRUCTURE?
	JRST DSKCL6		;YES. GO AROUND UPDATE
	CALL GETFDB		;NO. FIND THE FDB
	 JRST [	SETZM DSKCFD	;FDB IS GONE.
		JRST DSKCL6]
	MOVEM A,DSKCFD		;SAVE FDB ADDRESS FOR LATER
	MOVE T2,.FBCTL(T1)	;GET BITS
	TQNN <LONGF>		;LONG FILE ALREADY?
	TXNN T2,FB%LNG		;HAS IT BECOME LONG?
	JRST DSKCL8		;NOT LONG OR ALREADY LONG
	MOVE 1,.FBADR(T1)	;GET FDB ADDR
	CALL NEWLFS		;MAKE THIS FILE LONG FOR US TOO
	 JRST DSKCL8		;CAN'T, JUST CONTINUE AND HOPE IT'S OK
	HLRZ 1,FILOFN(JFN)	;GET OFN
	CALL UP0SHR		;UP SHARE COUNT FOR PT0
	STOR A,FLP0,(JFN)	;REMEMBER PT0
	TQO <LONGF>		;SAY WE TOO HAVE A LONG FILE
;DSKCLZ...

DSKCL8:	TXNE F,CZ%ABT		;ABORT CLOSE?
	JRST DSKCL6		;YES, NO UPDATE OF EOF
	TQNN <WNDF>		;HAVE A WINDOW YET?
	TQNN <WRTF>		;OPEN FOR WRITE?
	JRST DSKCL6		;NO. NO UPDATE OF EOF THEN
	CALL GETLEN		;UPDATE FILLEN BEFORE CLOSE
	MOVE A,DSKCFD		;RESTORE FDB ADDRESS
	LOAD B,FLBSZ,(JFN)	;GET OPEN BYTE SIZE
	STOR B,FBBSZ,(A)	;SAVE IT IN FDB
	LOAD B,FLMOD,(JFN)	;GET MODE
	STOR B,FBMOD,(A)	;SAVE IN THE FDB
	SKIPE B,FILLEN(JFN)	;HAVE SOME BYTES?
	MOVEM B,.FBSIZ(A)	;YES. COPY IT TO THE FDB
;   IFN CFSCOD,<			;If CFS
	HLRZ A,FILOFN(JFN)	;Get the OFN
	TQNE <LONGF>		;Long file?
	HRRZ A,FILOFN(JFN)	;Yes. Get PT0 OFN
	CALL CFSBEF		;Boradcast EOF
;   >	;IFN CFSCOD
DSKCL6:	TQNE <LONGF>		;THIS A LONG FILE?
	JRST CNTLNG		;YES
	HLRZ A,FILOFN(JFN)	;GET OFN
	TQNE <WRTF>		;WAS FILE OPEN FOR WRITE?
	TXO A,FILWB		;YES, PROPAGATE BIT
	TQNE JFNUB		;DITTO UNRESTRICTED
	TXO A,FILUB
	CALL RELOFN
	SETZM FILOFN(JFN)	;[7451] Clear OFN in JFN block
	; ..
;DSKCLZ...

DSKCL0:	SKIPE DMFLG		;A DISMOUNTED STRUCTURE?
	JRST DSKCL1		;YES. ALL DONE THEN
	MOVEM A,DSKPAG		;SAVE PAGE COUNT
	CAMN A,[-1]		;DID IT GET CLOSED?
	SETZ B,			;NO. IGNORE THE FLAGS THEN
	SKIPN A,DSKCFD		;HAVE AN FDB?
	JRST DSKCL5        	;NO. GO FINISH UP
	TXNE B,OFNBAT!OFNERR	;AN ERROR IN THIS FILE?
	JRST [HRRZ T4,FILDDN(JFN) ;DIRECTORY NUMBER
	      LOAD T2,STR,(JFN)	;STRUCTURE NUMBER
	      MOVE T2,@STRTAB(T2) ;GET STRUCTURE NAME
	      MOVE T3,.FBCTL(T1) ;[9101] Get old copy of .FBCTL
	      SETONE FB%BAT,.FBCTL(T1) ;[9101] Turn on the BAT bit now
	      TXNE T3,FB%BAT	;[9101] Skip if the bit already set
	      BUG.(INF,FILBAT,DISC,HARD,<DSKCLZ - File marked as possibly bad>,<<T4,DIRNUM>,<T2,STR>>,<

Cause:	A file is being closed and the OFN for the file contains a bit 
	indicating a possible error. The file's FDB is marked.

Data:	DIRNUM - directory number
	STR - structure name in SIXBIT
>,,<DB%NND>)			;[7.1210]
	      JRST .+1]		;CONTINUE
	TQNN <WRTF>		;NON-WRITE ACCESS?
	JRST DSKCL4		;YES
	CALL UPDDTM		;UPDATE THE LAST DIR CHANGE TIME
	MOVE B,A		;SAVE TIME
	MOVE A,DSKCFD		;GET BACK FDB ADDRESS
	CAME B,[-1]		;DATE SET YET?
	STOR B,FBCRE,(A)	;YES, SET WRITE DATE
;UPDATE PAGE COUNT IF NECESSARY

DSKCL4:	MOVE D,.FBCTL(A)	;GET FLAGS FROM FDB
	TXNN D,FB%DIR		;DIRECTORY FILE?
	SKIPGE B,DSKPAG		;POSITIVE PAGE COUNT?
	JRST DSKCL7		;YES, NO - DON'T UPDATE PAGE COUNT
	MOVEM C,STSFLG		;SAVE STATUS FLAGS
	MOVE D,DIRORA		;GET BASE ADR OF DIRECTORY
	LOAD C,FBNPG,(A)	;GET OLD PAGE COUNT FOR THIS FILE
	SUB B,C			;COMPUTE NET CHANGE
	LOAD C,DRDCA,(D)	;GET CURRENT PAGE COUNT FOR DIR
	ADD B,C			;COMPUTE NEW PAGE COUNT FOR DIRECTORY
	STOR B,DRDCA,(D)	;STORE UPDATED COUNT
	MOVE C,STSFLG		;RESTORE FLAGS
	MOVE B,DSKPAG		;GET PAGE COUNT
	STOR B,FBNPG,(A)	;SET PAGE COUNT FOR FILE
	SETZRO FB%WNC,.FBCTL(A) ;IF HERE, WE DID THIS
DSKCL7:	MOVX B,FILNB
	TDNE B,.FBADR(A)	;DON'T WRITE PAGE IF ALREADY CLEAR
	ANDCAM B,.FBADR(A)	;NOTE XB ADDRESS NOW VALID
	MOVX B,FB%NXF
	TDNN B,.FBCTL(A)	;DOES FILE ALREADY EXIST?
	JRST DSKCD2		;YES, NO FLUSH OR VERSIONS CHECK
	TXNE F,CZ%ABT		;CALLER WANTS FLUSH NONX FILES?
	JRST [	MOVE D,A	;YES, SET UP CALL DELFIL
		CALL DELFIL	;DELETE CONTENTS OF FILE
		 JFCL		;COULDN'T, IGNORE
		CALL USTDIR	;UNLOCK DIRECTORY
		JRST DSKCL5]	;FILE DELETED, NOTHING FURTHER TO DO
	TDNE B,.FBCTL(A)	;DON'T WRITE PAGE IF ALREADY CLEAR
	ANDCAM B,.FBCTL(A)	;MAKE FILE EXISTENT
	TQZ <NONXF>		;MARK THAT THE FILE IS NOW EXISTENT
DSKCD2:	TQNE <WRTF>		;IF FILE WAS OPEN FOR WRITE,
	CALL DSKDV		;DELETE ANY EXCESS VERSIONS
DSKCL3:	TXNN F,CZ%NUD		;NO UPDATE DIR?
	CALL UPDDRR		;UPDATE DIRECTORY
	CALL USTDIR
DSKCL5:	LOAD B,STR,(JFN)	;GET INDEX INTO STRTAB
	MOVE B,STRTAB(B)	;GET POINTER TO SDB
	DECR STROF,(B)		;DECREMENT OPEN FILE COUNT
DSKCL1:	MOVE A,F		;GET BACK THE FLAGS
	RETSKP			;YES, GIVE SUCCESS RETURN
;DELETE EXCESS VERSIONS AFTER CLOSE OR RENAME
; 1/ PTR TO FDB

DSKDV:	SAVEQ
	EA.ENT
	STKVAR <DSKDVA,DSKDVJ>
	LOAD Q1,FBGNR,(A)	;GET NUMBER OF VERSIONS TO RETAIN
	JUMPE Q1,R		;0 MEANS INFINITY
	MOVEM A,DSKDVA		;SAVE THE ORIGINAL FDB POINTER
DSKCD3:	MOVE C,.FBCTL(A)	;LOOK AT THIS VERSION
	MOVE D,.FBBBT(A)	;GET ARCHIVE/VIRTUAL DISK BITS
	TXNN D,AR%RAR		;ARCHIVE PENDING?
	TXNE C,FB%TMP+FB%NXF+FB%DEL+FB%ARC+FB%NDL ;THIS A 'GOOD' VERSION?
	JRST DSKCD1		;NO, DON'T COUNT IT
	SOJGE Q1,DSKCD1		;PASSED N GOOD VERSIONS?
	MOVEM A,DSKDVJ		;YES, SAVE THIS FDB ADR
	MOVX B,FC%WR		;B/WRITE ACCESS
	CALL ACCCHK		;CHECK FOR WRITE ACCESS ON THIS FILE
				; (NEEDED FOR DELETING)
	 JRST DSKCD4		;NOT PRIVILEGED TO DELETE THIS FILE
	MOVE A,DSKDVJ		;GET FDB ADR BACK AGAIN
	MOVX C,FB%DEL		;DELETE THIS ONE
	IORM C,.FBCTL(A)
DSKCD1:	LOAD A,FBGNL,(A)	;GET NEXT VERSION IN LIST
	JUMPE A,DSKCD4		;0 MEANS END OF LIST, RECOVER ORIG FDB
	ADD A,DIRORA		;INCLUDE OFFSET
	JRST DSKCD3		;LOOP OVER VERSIONS

DSKCD4:	MOVE A,DSKDVA		;GET ORIGINAL FDB ADR AGAIN
	RET			;AND EXIT
;CHECK IF ACCESS TO FILE IS LEGAL BECAUSE FILE IS NEW
; A/ PTR TO FDB
;RETURNS +1:	NO ACCESS
;	 +2:	ACCESS IS LEGAL

NFACHK::JN FBNXF,(A),NFACK0	;IF FILE NON-EXISTENT, ALLOW OWNERSHIP
	SKIPE .FBADR(A)		;FILE EXISTS?
	RET			;YES - USE ACCESS BITS
NFACK0:	JN FBOFF,(A),R		;IF OFFLINE, IS NOT A NEW FILE
	LOAD B,FBVER,(A)	;NO - CHECK FDB VERSION
	CAIGE B,1		;...
	JRST [	MOVE B,JOBNO	;OLD FDB - USE DIR #
		HRRZ B,JOBDIR(B)
		LOAD C,FBAT0,(A) ;VERSION #0 AUTHOR
		CAME B,C	;ARE WE THE CREATOR
		RET		;NO - USE ACCESS BITS
		RETSKP]		;YES - ACCESS ALLOWED
	LOAD B,FBLWR,(A)	;VER #1 OR LATER - USE LAST-WRITER
	JUMPE B,R		;USE ACCESS BITS IF NONE
	ADD B,DIRORA		;RELOCATE STRING PNTR
	LOAD C,UNLEN,(B)	;GET BLOCK LENGTH
	HRRZ D,USRNAM		;USER NAME STRING LENGTH
	CAIE C,1(D)		;SAME LENGTH?
	RET			;NO - NO FURTHER CHECKING REQ'D
	ADDI B,2		;POINT TO STRING BEG
	MOVNI C,-2(C)		;LENGTH OF STRING TO COMPARE
	HRLZS C			;MOVE TO LHS
	HRRI C,USRNAM+1		;FORM AOBJN PNTR
NFACK1:	MOVE D,0(C)		;FETCH A WORD
	CAME D,0(B)		;COMPARE
	RET			;FAIL IF NO MATCH
	AOS B			;STEP TO NEXT WORD
	AOBJN C,NFACK1		;LOOP TILL DONE
	RETSKP			;SUCCESS RETURN
;HERE TO CLOSE LONG FILE--FIRST COUNT PAGES
;
;[8870] Note:  The  write  bit  (FILWB)  must be passed to RELOFN when PT0 is
;[8870] released to prevent OPNX9 errors from occurring. These can  occur  if
;[8870] the  file  once  was  short  and was opened for read. Then, an append
;[8870] occurs which makes the file go long and causes FILWB to be set in the
;[8870] PTT and PT0. When the append is over, and the OFN  is  being  closed,
;[8870] the  PTT  will be cached but the PT0 will not since there is still an
;[8870] opener; the one which opened the file for read when it was short.  If
;[8870] FILWB is not passed in to RELOFN, then PT0 will still reflect that it
;[8870] is  open  for  write.  So, if another opener tries to open this file,
;[8870] which is now long, CHKLAC will believe that there is already a writer
;[8870] of PT0 and an OPNX9 will result.

CNTLNG:	LOAD A,FLP0,(JFN)	;GET OFN OF PT0
	TQNE <WRTF>		;[8870] File open for write?
	TXO A,FILWB		;[8870] Yes, propagate bit
	CALL RELOFN		;UNDO EXTRA COUNT
   REPEAT 0,<			;UNNEEDED INSTRUCTIONS FOLLOW
	SKIPE DMFLG		;A DISMOUNTED STRUCTURE?
	JRST CNTLN5		;YES
	SETZ A,			;GET BACK TO PT0
	CALL JFNOF1
	 BUG.(HLT,DNOPT0,DISC,HARD,<DSKCLZ - JFNOFN failed for page 0>,,<

Cause:	There is no path to this BUGHLT.  It is not assembled into the monitor.

>)
   >				;END OF REPEAT 0
CNTLN5:	HLRZ A,FILOFN(JFN)	;GET PT0 OFN
	TQNE JFNUB		;[7283] Is this open unrestricted?
	TXO T1,FILUB		;[7283] Yes, indicate it
	CALL RELOFN		;RELEASE
	HRRZS FILOFN(JFN)
	SKIPE DMFLG		;A DISMOUNTED STRUCTURE?
	JRST CNTLN4		;YES
	JUMPL A,CNTLN4		;IF STILL IN USE, SKIP COUNTING
	MOVSI C,-PGSIZ		;COUNT THRU 1000 PAGE TABLES
	HRR C,FILLFW(JFN)	;AT FILLFW
	SETZ Q3,		;TOTAL COUNT
	SETZ B,			;NO FLAGS TO START
	SKIPN A,DSKCFD		;GET FDB
	JRST CNTLN4		;IF NO FDB, NO SCAN!
	TMNN FB%WNC,.FBCTL(A)	;NEED TO DO SCAN?
	JRST CNTLN4		;NO.
	PUSH P,B		;SAVE ACCUMULATED FLAGS
CNTLNL:	LOAD A,STGADR,0(C)	;GET PT ADR
	JUMPE A,CNTLN1		;JUMP IF NO PT HERE
	PUSH P,C
	HRRZ T4,T3		;GET PAGE NUMBER IN XB
	HRRZ T2,FILLFW(JFN)	;BY SUBTRACTING THE ADDRESS OF THE SUPER XB
	SUB T4,T2		;FROM THE AOBJN WORD
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL ASLOFN		;HAVE TO ASSIGN OFN FOR IT TO MAP
	 JRST CNTLN2		;IF FAILURE, SKIP REST OF COUNTING
	CALL RELOFN		;NOW RELEASE WHICH WILL COUNT PAGES
	JUMPL A,CNTLN2		;IF ANY PAGE TABLE BUSY, STOP
	ADD Q3,A		;ADD INTO SUM
	POP P,C
	IORM B,0(P)		;INCLUDE THESE FLAGS
CNTLN1:	AOBJN C,CNTLNL
	POP P,B			;THE FLAGS
	JRST CNTLN3
;CNTLNG...

CNTLN2:	POP P,C
	POP P,B			;FLAGS
CNTLN4:	SETO Q3,		;REMEMBER WE HAVE NO VALID PAGE COUNT
	SETZ B,			;NO FLAGS IF HERE
CNTLN3:	PUSH P,Q3		;SAVE
	PUSH P,B		;SAVE THE FLAGS
	HRRZ B,FILLFW(JFN)
	SETZ A,
	CALL SETMPG		;REMOVE PTT FROM MAP
	HRRZ A,FILLFW(JFN)
	CALL RELPAG		;AND RELEASE STORAGE
	HLLZS FILLFW(JFN)
	HRRZ A,FILOFN(JFN)
	TQNE <WRTF>		;WAS FILE OPEN FOR WRITE?
	TXO A,FILWB		;YES, PROPAGATE BIT
	TQNE JFNUB		;DITTO UNRESTRICTED
	TXO A,FILUB
	CALL RELOFN		;RELEASE OFN OF PTT
	HLLZS FILOFN(JFN)
	POP P,B			;THE FLAGS
	POP P,A
	JRST DSKCL0
;DELETE PARTICULAR FILE
; D/ PTR TO FDB OF FILE (ABSOLUTE ADDRESS)
;	CALL DELFIL
;RETURNS +1:	AN ERROR OCCURRED AND THE FDB WAS NOT DELETED
;	 +2:	SUCCESSFUL

DELFL1::TDZA A,A		;ENTRY IS HERE
DELFIL::SETO A,			;ENTRY AT DELFIL
	EA.ENT
	JN FBDIR,(D),[RETBAD (DLFX11)]	;CAN'T DELETE DIRECTORY FILE
	JN FBARC,(D),[ MOVX B,AR%NDL	;CAN'T IF PROHIBITED
			TDNN B,.FBBBT(D)
			 JRST .+1	;OK, PROCEED
			MOVX A,DELX11
			RET]
	TRVAR <DELFLG,TBLTYP,XB2INF,SAVDP3,SAVDF,SAVDQ3,SAVDD,SAVDA,SAVDA1,SAVDA2,SAVDB>	;[7207] ADD NEW TEMP STORAGE
	MOVEM A,DELFLG		;STORE ENTRY FLAG
	MOVEM P3,SAVDP3		;[7207]
	MOVEM F,SAVDF		;[7207]
	MOVEM Q3,SAVDQ3		;[7207]
	MOVEM D,SAVDD		;[7207]
	MOVE A,.FBCTL(D)	;[7364]GET FILE BITS
	TXNE A,FB%NDL		;[7266]IS THIS FILE MARKED "NEVER DELETE"?
	 JRST [	MOVEI A,DELX13	;[7266]YES - RETURN AN ERROR
		JRST DELFIX]
	SETZM TBLTYP		;[7266]SET TO SHORT FILE INDICATION
	TXNE A,FB%LNG		;[7266]IS THE FILE LONG?
	SETOM TBLTYP		;[7266]YES - INDICATE
	SKIPE DELFLG		;[7364]GONNA CLOBBER FDB?
	TXNN A,FB%ARC		;[7364]ARCHIVED FILE?
	 JRST DELF31		;[7364]NO, SKIP IPCF
	MOVE A,[.FLXP,,.NOTM]	;[7364]NOTIFICATION: FILE EXPUNGED
	MOVE B,D		;[7364]FDB OFFSET
	CALL ARCMSG		;[7364]
	 JRST	[MOVEI T1,ARCX13 ;[7364]
		 JRST DELFIX]	;[7364]COULDN'T DO IT, IPCF MESSAGE FAILED
	MOVE D,SAVDD		;[7364][7207] RESTORE FDB ADDRESS
	MOVE A,.FBCTL(D)	;[7364]RECOVER CTL BITS
;DELFIL...

DELF31:	OPSTR <SKIPN P3,>,FBADR,(D) ;[7364][7266]GET INDEX BLOCK ADR
	JRST DELFI3		;[7266]WASN'T ONE
	SETZRO FBADR,(D)	;[7266]REMOVE XB ADR FROM DIR
	CALL UPDDIR		;[7266]UPDATE DIRECTORY, FILE IS EFFECTIVELY
	MOVE A,P3		; GONE AFTER THIS POINT.
 	LOAD B,CURSTR		;GET STRUCTURE NUMBER FROM PSB
 	CALL CHKOFN		;IS FILE  BUSY?
	SKIPA D,SAVDD		;[7207]YES, CAN'T EXPUNGE IT. RECOVER FDB ADR
	JRST DELFI2		;NO,GO TEST MORE
	STOR P3,FBADR,(D)	;PUT ADR BACK INTO FDB
	MOVEI A,DELFX2		;
	JRST DELFIX		;ERROR
DELFI2: MOVE A,P3 		;RESTORE A CLOBBERED BY CHKOFN
	TXNE A,FILNB 		;WAS IT A NEW FILE ?
	JRST DELFI3  		;NEW,LEFT FROM CRASH
       	TLO A,(THAWB)
	CALL GASOG		;GET ASOFN ARGS
	LOCK DIRCLK		;LOCK DIRECTORY CACHE
	CALL DIRCFL		;FLUSH CACHE
	SKIPE TBLTYP		;SKIP IF FILE IS SHORT
	TXO T1,OFNPTT		;OR FLAG SUPER XB
	BLCAL. ASNOFN,<T1,T2,T3,T4,[0]>	;GET SUPER INDEX BLOCK OFN
	JRST [	UNLOCK DIRCLK	;UNLOCK DIRECTORY CACHE
		CAIN A,OPNX16
		JRST DELFI3	;BAD INDEX BLOCK, FORGET IT
		MOVE D,SAVDD	;[7207]FILE IS OPEN, CANNOT EXP. GET FDB ADR.
		STOR P3,FBADR,(D) ;PUT ADR BACK INTO FDB
		MOVEI A,DELFX2	;FILE OPEN
		JRST DELFIX]	;SKIP THIS FILE
	UNLOCK DIRCLK		;UNLOCK DIRECTORY CACHE
	MOVE D,SAVDD		;[7207] GET FDB ADDRESS
	MOVEM A,SAVDA		;[7207]
	MOVE A,D		;GET ADR OF FDB
	LOAD Q3,FBNPG,(A)	;GET PAGE COUNT OF FILE
	MOVE A,DIRORA		;GET BASE ADR OF DIR
	LOAD F,DRDCA,(A)	;GET CURRENT ALLOCATION
	SUB F,Q3		;REDUCE DIR COUNT BY FILE BEING DELETED
	STOR F,DRDCA,(A)	;UPDATE COUNT
	MOVE A,SAVDA		;[7207]
	MOVE Q3,.FBCTL(D)
	TXNE Q3,FB%LNG
	JRST DELFI4		;LONG FILE
	CALL DELPT
;DELFIL...

DELFI3:	MOVE D,SAVDD		;[7207] GET FDB ADDRESS
	SETZM .FBADR(D)
	SETZM .FBSIZ(D)
	HRLOI B,77		;[7220]CLEAR DATA MODE AND PAGE COUNT
	ANDCAM B,.FBBYV(D)
	MOVX B,FB%LNG+FB%SHT+FB%BAT ;[7246]CLEAR THESE BITS IN .FBCTL
	ANDCAB B,.FBCTL(D)
	SKIPN DELFLG		;[7364]CLOBBER FDB?
	 JRST DELF32		;NO
	SETZRO <FBARC,FBOFF>,(D)
	LOAD A,FBLEN,(D)	;GET THE LENGTH
	CAIGE A,.FBLXT		;IF WE HAVE ARCHIVE STUFF, DO IT
	JRST DELF33		;IS AN OLD FDB
	SETZRO FBBBT,(D)	;CLOBBER ANY OFFLINE STORAGE INFO
	SETZRO FBTDT,(D)
	SETZM .FBTP1(D)
	SETZM .FBSS1(D)
	SETZM .FBTP2(D)
	SETZM .FBSS2(D)
DELF33:	TXNN B,FB%PRM		;PERMANENT?
	JRST [	MOVE A,D	;GET FDB ADDRESS
		CALL DELFDB	;GO DELETE THIS FDB
		 SKIPA		;FAILED
		JRST .+1	;OK, GO ON
		JRST DELFIX]	;GO DO RETURN
DELF32:	SETZ A,			;SAY SKIP RETURN
DELFIX:	MOVE P3,SAVDP3		;[7207]
	MOVE F,SAVDF		;[7207]
	MOVE Q3,SAVDQ3		;[7207]
	MOVE D,SAVDD		;[7207]
	JUMPE A,RSKP		;DO SUCCESSFUL RETURN IF A NON-0
	RET			;OTHERWISE FAIL RETURN
;DELETE LONG FILE

DELFI4:	HRLM A,XB2INF		;SAVE PTT OFN FOR XB2 STUFF
	MOVEM A,SAVDA1		;[7207]
	CALL ASGPAG
	 JRST [	MOVE A,SAVDA1	;[7207]
		CALL RELOFN
		MOVEI A,DELFX3	;NO ROOM IN JSB
		JRST DELFIX]
	MOVEM A,SAVDA2		;[7207]
	MOVE B,A
	HRLI B,(PTRW)
	MOVE A,SAVDA1		;[7207]
	CALL SETMPG
	HRLI B,-PGSIZ
DELFI6:	LOAD A,STGADR,0(B)	;GET PT ADR
	JUMPE A,DELFI5		;JUMP IF NONE
	MOVEM B,SAVDB		;[7207]
	HLRZ T3,T2		;[7308] Compute section number by ...
	ADDI T3,PGSIZ		;[7308] ... adding PGSIZ to AOBJN count ...
	HRRM T3,XB2INF		;[7308] ... and store it for ASNOFN
	CALL GASOG		;GET ARGS FOR ASNOFN
	TXO A,OFN2XB		;SECOND LEVEL XB
	BLCAL. ASNOFN,<T1,T2,T3,T4,XB2INF>
	 JRST DELFI8
	CALL DELPT
DELFI7:	MOVE B,SAVDB		;[7207]
	SETZM (B)
DELFI5:	AOBJN B,DELFI6
	MOVE B,SAVDA2		;[7207]
	MOVEI A,0
	CALL SETMPG
	MOVE A,SAVDA2		;[7207]
	CALL RELPAG
	MOVE A,SAVDA1		;[7207]
	CALL DELPT		;DELETE THE PTT
	JRST DELFI3
;DELFIL...

DELFI8:	CAIN A,OPNX16		;BAD INDEX BLOCK?
	JRST DELFI7		;YES, TREAT AS IF DELETED
	BUG.(HLT,ASOFNF,DISC,SOFT,<DELFIL - ASGOFN gave fail return for long file XB>,,<

Cause:	A long file was being deleted and ASGOFN could not assign a system file
	number (OFN).  This usually happens because there were not enough OFN
	slots.

Action:	If this happens frequently, rebuild the monitor with more OFN slots.
>)
	ENDTV.			;[7207] END TEMP STORAGE
;ROUTINE TO SETUP A-D FOR ASGOFN
;ASSUMES A ALREADY HAS INDEX BLOCK ADDRS AND DIRECTORY MAPPED

GASOG:	PUSH P,A		;SAVE INDX BLOCK
	MOVE A,DIRORA		;DIRECTORY BASE ADDRS
	LOAD A,DRNUM,(A)	;DIRECTORY NUMBER
	LOAD B,CURSTR		;STR NUMBER
	CALL GETCAL		;GET ALLOCATION INFO
	 JRST [	MOVE C,DIRORA	;NO OPEN FILES - GET INFO FROM
		LOAD A,DRLIQ,(C) ; DIRECTORY
		OPSTR <SUB A,>,DRDCA,(C)
		JRST .+1]
	MOVE D,A		;PLACE PAGES LEFT IN D
	LOAD B,CURSTR		;STRUCTURE NUMBER INTO B
	MOVE C,DIRORA
	LOAD C,DRNUM,(C)	;DIRECTORY NUMBER INTO C
	POP P,A			;INDEX BLOCK ADDRS TO A
	RET			;RETURN
;UPDATE FILE LENGTH INFO IN SPT RELATED TABLE
;PRESERVES ALL AC'S, JFN MUST BE SETUP, ETC.

;UPDFLN - ROUTINE TO UPDATE THE LENGTH OF A FILE
;	ACCEPTS IN T1/	BYTE SIZE
;		   T2/	LENGTH
;		CALL UPDFLN
;	RETURNS +1:	ALWAYS - CLOBBERS T1-T4

UPDLEN::SAVET			;SAVE T1-T4
	LOAD A,FLBSZ,(JFN)	;GET THE BYTE SIZE OF THE OPEN
	MOVE B,FILLEN(JFN)	;GET THE LENGTH
	TDZA C,C		;DON'T SHRINK THE FILE SIZE

UPDFLN::SETO C,			;SET THIS LENGTH ALWAYS
	STKVAR <UPDFLB,UPDFLL,UPDFLF,UPDFLT>
	SKIPN A			;BYTE SIZE = 0?
	MOVEI A,^D36		;YES, MAKE IT BE 36 BIT BYTES
	MOVEM A,UPDFLB		;SAVE THE BYTE SIZE
	MOVEM B,UPDFLL		;SAVE LENGTH
	MOVEM C,UPDFLF		;SAVE FLAG
	HRRZ A,DEV		;GET DEVICE DISPATCH
	CAIE A,DSKDTB		;IS IT DISK
	 RET			;NO - JUST RETURN
	HLRZ D,FILOFN(JFN)	;GET OFN
	TQNE <LONGF>		;LONG FILE?
	HRRZ D,FILOFN(JFN)	;YES, USE THIS ONE

;   IFN CFSCOD,<			;If the CFS monitor
	MOVE A,D		;Copy OFN
	MOVEI B,1		;Get write permission
	PUSH P,D
	CALL CFSAWT		;Do it
	POP P,D
;   >	;IFN CFSCOD
	SKIPN OFNLEN(D)		;SET UP YET?
	BUG.(HLT,NOLEN,DISC,SOFT,<UPDLEN - No length info for OFN>,,<

Cause:	The table OFNLEN, which gives the file length for each OFN, has
	an invalid entry for the OFN in question.
>)
;UPDLEN...

;[7.1225] Note: Since (due to a bad design Arnie) OFNLEN holds the byte size in
;the first six bits, and since COBOL depends on a +infinity byte count to tell
;that a file is an ISAM file.  This is not a problem with the FDB since the
;byte count is kept in a word by itself.  So, if OFNLEN is -1 that means that
;the file's byte size and count is really 34359738367(36).  The OFNLEN word is
;transferred whole from system to system by CFS.  (See also TCO 7.1059).

	MOVE A,OFNLEN(D)	;[7.1225] Get current OFNLEN entry for file
	CAMN A,[-1]		;[7.1225] Is it code for 34359738367(36)?
	SKIPA A,[^D36]		;[7.1225] Yes, get the proper size
	LOAD A,OFNBSZ,(D)	;GET FILE BYTE SIZE (AT FIRST OPEN)
	MOVE B,UPDFLB		;GET THE BYTE SIZE
	CAMN A,B		;SAME SIZE CAN BE HANDLED FAST
	JRST [	MOVE C,UPDFLL	;GET NEW LENGTH
		JRST UPDLN1]	;STORE IF LARGER
	MOVEM D,UPDFLT		;SAVE THE OFN
	MOVEI C,^D36
	IDIVM C,B		;JFN BYTES/WD
	MOVEI C,^D36
	IDIV C,A		;OFN BYTES/WD
	IMUL C,UPDFLL		;CALC NEW OFN LENGTH
	IDIV C,B
	SKIPE D			;ROUND IF RESIDUE
	ADDI C,1
	MOVE D,UPDFLT		;RESTORE OFN
UPDLN1:	MOVE B,OFNLEN(D)	;[7.1225] Get current OFNLEN entry
	CAMN B,[-1]		;[7.1225] Is it 34359738367(36)?
	SKIPA B,[.INFIN]	;[7.1225] Yes, get the proper byte count
	LOAD B,OFNBC,(D)	;GET CURRENT VALUE
	SKIPE UPDFLF		;[7.1225] Always update the new length?
	IFSKP.			;[7.1225] Nope
	  CAML B,C		;[7.1225] Is the new count smaller than old?
	  RET			;[7.1225] Yes, return without updating it
	ENDIF.			;[7.1225] 
	STOR C,OFNBC,(D)	;[7.1225] Store the new byte count
	CAME C,[.INFIN]		;[7.1225] Is the new byte count 34359738367?
	RET			;[7.1225] Return if not goofy byte count
	LOAD B,OFNBSZ,(D)	;[7.1225] Count is infinity, get the byte size
	CAIN B,^D36		;[7.1225] Is this file now 34359738367(36)?
	SETOM OFNLEN(D)		;[7.1225] Yes, set to special OFNLEN value 
	RET			;[7.1225]  and return
;ROUTINE TO SET UP NEW OFN LENGTH ENTRY (FDB MUST BE MAPPED)
;C(D) := OFN

OFNSET:	MOVE C,FILFDB(JFN)	;GET FDB ADDRS
	MOVE A,.FBSIZ(C)	;GET LENGTH
	STOR A,OFNBC,(D)	;SAVE IT
	LOAD B,FBBSZ,(C)	;[7.1059] Get file byte size
	SKIPN B			;[7.1059] If zero,
	LOAD B,FLBSZ,(JFN)	;[7.1059]  then use JFN byte size
	STOR B,OFNBSZ,(D)	;[7.1059] Save byte size also
	CAIN B,^D36		;[7.1059] Is it 36 bit bytes and
	CAME A,[.INFIN]		;[7.1059]  was the length +infin?
	RET			;[7.1059] No, return OK now
	SETOM OFNLEN(D)		;[7.1059] Specify -1 for 34359738367(36)
	RET			;[7.1059]  and return
;ROUTINE TO GET ACTUAL FILE LENGTH (IF DISK)

GETLEN::SAVET
	HRRZ A,DEV		;SEE IF DISK
	CAIE A,DSKDTB		;?
	 RET			;NO, RETURN
	HLRZ D,FILOFN(JFN)	;GET OFN
	TQNE <LONGF>		;LONG FILE?
	HRRZ D,FILOFN(JFN)	;YES, USE THIS INSTEAD
;   IFN CFSCOD,<			;If the CFS monitor
	PUSH P,D
	MOVE A,D		;Copy the OFN
	MOVEI B,0		;Get exclusive use for now
	CALL CFSAWT		;Make sure we get up-to-date info
	POP P,D
;   >	;IFN CFSCOD
	SKIPN OFNLEN(D)		;ONE SETUP YET?
	CALL OFNSET		;NO - SET UP THEN
	MOVE C,OFNLEN(D)	;[7.1059] Get OFNLEN back 
	CAMN C,[-1]		;[7.1059] Is it code for 34359738367(36)?
	SKIPA A,[^D36]		;[7.1059] Yes, load 36 bit byte size
	LOAD A,OFNBSZ,(D)	;GET OFN BYTE SIZE
	LOAD B,FLBSZ,(JFN)	;GET JFN BYTE SIZE
	CAME A,B		;[7.1059] Are they the same?
	IFSKP.			;[7.1059] Yes
	  CAMN C,[-1]		;[7.1059] Was OFNLEN code for 34359738367(36)?
	  SKIPA A,[.INFIN]	;[7.1059] Yes, load that count
	  LOAD A,OFNBC,(D)	;[7.1059] Load byte count
	  MOVEM A,FILLEN(JFN)	;[7.1059] Store it
	  RET			;[7.1059]  and return
	ENDIF.			;[7.1059] 
	PUSH P,D		;SAVE OFN INDEX
	MOVEI C,^D36
	IDIVM C,A		;OFN BYTES/WD
	MOVEI C,^D36
	IDIV C,B		;JFN BYTES/WD
	POP P,D			;RESTORE OFN
	MOVE B,OFNLEN(D)	;[7.1059] Get OFNLEN back
	CAMN B,[-1]		;[7.1059] Was it a code for 34359738367(36)?
	SKIPA D,[.INFIN]	;[7.1059] Yes, load +infin code
	LOAD D,OFNBC,(D)	;GET FILE SIZE
	IMUL C,D		;CALC NEW FILE LENGTH
	IDIV C,A
	SKIPE D			;ROUND
	ADDI C,1
	MOVEM C,FILLEN(JFN)	;STORE IN JFN BLOCK
	RET			;RETURN
; Multiple directory rename
; Call:	JFN	; Jfn of new name
;	A	; Jfn of existing file
;	CALL DSKREN

DSKREN:	EA.ENT
	TRVAR <SRCJFN,SRCOFN,SRCFDB,DSTJFN,DSTOFN,DSTFDB,RENFDA,RENPCT,DSKTYP,ALLDSK>
	MOVEM A,SRCJFN		;SAVE SOURCE JFN
	CALL GETFDB		;GET FDB
	 RETBAD (RNAMX2)	;NAME GONE
	MOVEM A,DSTFDB		;SAVE DESTINATION FDB
	CALL NFACHK		;ACCESS ALLOWED BECAUSE NEW FILE?
	 SKIPA			;NO
	JRST DSKREA		;YES
	MOVX B,FC%WR		;B/WRITE ACCESS
	CALL ACCCHK		;CHECK FOR WRITE ACCESS TO THIS FILE
	 RETBAD (RNAMX3,<CALL USTDIR>)
DSKREA:	MOVE A,DSTFDB		;GET BACK FDB LOCATION
	MOVX B,FC%WR		;WRITE ACCESS NECESSARY FOR DELETE
	CALL ARACCK		;CHECK ARCHIVE/ VIR. DISC REQUIREMENTS
	JUMPG A,[CALLRET USTDIR]  ;POSITIVE NO. IS ERROR CODE
	IFL. A
	  MOVE D,DSTFDB		;-1 MANDATES DISCARD
	  LOAD B,FBLEN,(D) 	;GET LENGTH OF FDB
	  CAIGE B,.FBLXT	;INCLUDES TAPE INFO WORDS?
	ANSKP.			;NO, PRE-ARCHIVE/VIR. DISK FDB
	  SETZRO <FBOFF>,(D)
	  EXCH P3,D		;FDB ADDRESS IN P3 FOR CLRBOT
	  CALL CLRBOT		;DISCARD TAPE INFO
	   RETBAD (,<CALL USTDIR>) ;FAILED
	  EXCH P3,D		;RESTORE P3
	ENDIF.
	MOVE A,DSTFDB		;LOC OF FDB
	SETZM DSKTYP		;SET LONG FILE INDICATOR
	MOVE B,.FBCTL(A)	;GET CONTROL WORD
	TXNE B,FB%LNG		;IS IT A LONG FILE
	SETOM DSKTYP		;YES - INDICATE
	SKIPN A,.FBADR(A)	;DEST HAS XB ADR?
	IFSKP.
	  TXNN A,FILNB		;YES, UPDATED?
	  JRST DSKR3		;YES
	  TXO A,THAWB		;NO, SEE IF NOW IN USE
	  LOAD B,STR,(JFN)
	  CALL CHKOFN
	   RETBAD (RNAMX5,<CALL USTDIR>)   ;BUSY, FAIL
	ENDIF.
;DSKREN...

	MOVEI A,0		;NO, WE'LL HAVE TO ASSIGN ONE
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL DSKASN		;TO SERVE AS A PLACE HOLDER
	IFNSK.
	  MOVEI T1,RNAMX4	;RETURN CODE
	  CALLRET USTDIR	;UNLOCK AND FAIL
	ENDIF.
	MOVE B,DSTFDB		;RECOVER FDB ADR
	TXO A,FILNB
	MOVEM A,.FBADR(B)
DSKR3:	TXO A,THAWB
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	SETZ T3,		;CLEAR FLAG
	SKIPE DSKTYP		;SKIP IF SHORT FILE
	TXO T3,FB%LNG		;LONG
	CALL ASKOFN		;DO LONG OR REG
	 JRST [	CAIN A,OPNX9	;BUSY?
		RETBAD (RNAMX5,<CALL USTDIR>) ;YES - CAN'T CONTINUE
		CAIN A,OPNX16	;PAGE TABLE BAD?
		RETBAD (RNAMX6,<CALL USTDIR>) ;YES - CAN'T CONTINUE
		MOVEM A,DSKTYP	;SAVE ERROR CODE
		CALL USTDIR	;FIX DIRECTORY
		MOVE A,DSKTYP	;GET ERROR CODE
		RET]
	MOVEM A,DSTOFN		;SAVE OFN JUST ASSIGNED
	CALL UPDOFN		;FIX OFN ON DISK
	MOVE B,DSTFDB		;GET FDB LOCATION
	MOVX A,FILNB		;MAKE XB ADR VALID
	ANDCAM A,.FBADR(B)
	CALL USTDIR		;THRU WITH DEST FOR NOW
	MOVEM JFN,DSTJFN	;SAVE DESTINATION JFN
	MOVE JFN,SRCJFN		;GET SOURCE JFN
	CALL GETFDB		;GET SOURCE FDB
	 RETBAD (RNAMX7,<CALL DSKRE7>) ;SOURCE WENT AWAY
	MOVEM A,SRCFDB		;SAVE SOURCE FDB
	JN FBNDL,(A),[RETBAD (DELX13,<CALL DSKRE8>)] ;[9094]Don't allow rename
	MOVE B,CAPENB		;ENABLED CAPS
	TXNN B,SC%WHL!SC%OPR	;CHECK IF OK
	SKIPN USRSPC		; OR JUST NO CHECKING
	JRST DSKREO		;NO NEED TO CHECK FURTHER
	MOVE B,DSTJFN		;GET JFN OF DESTINATION
	HRRZ B,FILDDN(B)	;GET DIR # OF DESTINATION
	HRRZ C,FILDDN(JFN)	;GET DIR # OF SOURCE
	CAME C,B		;SAME DIRECTORIES?
	SKIPGE C,DSTOFN		;NO - GET OFN IF ANY
	JRST DSKREO		;DON'T CHECK QUOTA IF SAME DIR
;DSKREN...

	LOAD B,FBNPG,(A)	;GET PAGE COUNT OF FILE
   REPEAT 0,<			;CFSCOD NO LONGER USED
   IFE CFSCOD,<			;If not  CFS
	LOAD C,ALOCX,(C)	;OFN QUOTA INDEX
	LOAD C,PGLFT,(C)	;COUNT OF REMAINING PAGES
	SUB C,B			;WILL FILE FIT?
	JUMPGE C,DSKREO		;JUMP IF OK
   >	;IFE CFSCOD
   >				;END REPEAT 0

;   IFN CFSCOD,<			;If CFS
	MOVEM B,ALLDSK		;Save the allocation
	MOVE A,C		;Copy the OFN
	CALL QCHK		;Check quota
	IFSKP.			;If now OK
	 SUB A,ALLDSK		;COmpute new allocation
	 JUMPGE A,DSKREO	;If still OK, proceed
	ENDIF.
;   >	;IFN CFSCOD

	RETBAD (RNAMX4,<CALL DSKRE8>) ;OVER QUOTA RETURN
DSKREO:	EA.ENT
	MOVE A,SRCFDB		;RESTORE SOURCE FDB
	MOVX B,FC%WR		;B/WRITE ACCESS
	CALL ACCCHK		;CHECK FOR WRITE ACCESS TO THIS FILE
				; (NEEDED TO DELETE)
	 RETBAD (RNAMX8,<CALL DSKRE8>) ;CANT RENAME
	MOVE A,SRCFDB		;GET BACK FDB LOC
	SKIPN A,.FBADR(A)
	JRST DSKREF		;NO XB, POSSIBLY OFFLINE?
	TXNE A,FILNB		;CHECK NEW OR NO XB ADR
	RETBAD (RNAMX9,<CALL DSKRE8>) ;NO DISK ADDRESS (SOURCE)
	TXO A,THAWB
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	MOVE C,SRCFDB		;GET ADDRESS OF FDB - CHECK FOR LONG FILES
	MOVE C,.FBCTL(C)	;GET THE FLAGS
	CALL ASKOFN		;OPEN SOURCE WITH RESTRICTED ACCESS
	 JRST [	MOVE B,A	;BUSY OR BAD PT
		SETO A,
		CAIN B,OPNX9	;BUSY?
		RETBAD (RNMX10,<CALL DSKRE8>)
		JRST .+1]	;NO, CONTINUE WITH RENAME
DSKRE1:	CAMN A,DSTOFN		;RENAME TO SELF?
	JRST [	SKIPL A
		CALL RELOFN	;RENAME TO SELF
		RETBAD (RNMX12,<CALL DSKRE8>)]
	MOVEM A,SRCOFN		;SAVE SOURCE OFN
	;..
;NOW GET ALL INFO FROM SOURCE FDB INTO TEMP BLOCK IN JSB

	;..
	MOVE JFN,DSTJFN		;GET DESTINATION JFN BACK
	MOVE B,SRCFDB		;WERE THE SOURCE FDB IS
	LOAD B,FBLEN,(B)	;ONLY GET AS MUCH SPACE AS NEEDED
	AOJ B,			;PLUS ONE FOR THE HEADER
	CALL ASGJFR		;IN THE JSB
	 JRST [	SKIPL A,SRCOFN	;NO ROOM - RELEASE STUFF
		CALL RELOFN
		RETBAD (RNMX13,<CALL DSKRE8>)]
	MOVEM A,RENFDA		;SAVE ADDRS OF FDB COPY
	XMOVEI C,1(A)		;TARGET OF XFER
	MOVE B,SRCFDB		;SOURCE FDB ADDRS
	LOAD A,FBLEN,(B)	;GET ACTUAL LENGTH TO COPY
	CALL XBLTA		;MOVE FDB
	MOVE A,SRCFDB		;RESTORE SOURCE FDB
	MOVX B,FB%PRM
	AND B,.FBCTL(A)		;RETAIN PERM BIT
	TXO B,FB%NXF+FB%DEL	;AND DELETE AND NON-EX IT
	HLLM B,.FBCTL(A)	;NEW CONTROL BITS
	SETZM .FBADR(A)		;NO DISC ADDRESS
	LOAD B,FBNPG,(A)	;GET PAGE COUNT OF SOURCE
	MOVEM B,RENPCT		;SAVE PAGE COUNT TO UPDATE ALOC TABLES
	MOVNS B
	MOVE C,DIRORA		;GET BASE OF DIR AREA
	OPSTRM <ADDM B,>,DRDCA,(C) ;REDUCE SOURCE DIRECTORY PAGE COUNT
	SETZ B,
	STOR B,FBNPG,(A)	;RESET SOURCE FILE PAGE COUNT
	SETZRO FBSIZ,(A)	;CLEAR BYTE COUNT
	MOVE D,A		;NOW DELETE THE SOURCE FDB FROM DIR
	CALL DELFIL		;...
	 JFCL			;MIGHT COME HERE IF PERMANENT
	MOVE A,RENFDA		;(OLD FDB COPY)
	AOS A			;POINT TO FDB
	JN FBPRM,(A),<[MOVE A,SRCFDB	;POINTER TO FDB (STILL EXISTS)
			SETZRO FBNXF,(A) ;CLEAR NXF FLAG
			JRST .+1]>
	CALL UPDDIR		;UPDATE SOURCE DIRECTORY
	CALL USTDIR		;FINISHED WITH SOURCE
	; ..
	; ..
	CALL GETFDB		;GET DESTINATION FDB
	 BUG.(HLT,GTFDB3,DISC,SOFT,<DSKREN - GETFDB failure for open file>,,<

Cause:	The RNAMF JSYS has detected a monitor internal error. It has created
	an FDB for the destination file, and an internal routine that
	finds an FBD in a directory has returned with a failure,
	indicating an inconsistency in the newly-created FDB.
>)
	MOVEM A,DSTFDB		;SAVE DESTINATION FDB LOC
	SKIPL A,SRCOFN		;HAVE SOURCE OFN?
	CALL [	LOAD B,STRX,(A)	;Get STR #
		LOAD A,ALOCX,(A) ;YES, GET INDEX INTO QUOTA TABLES
		LOAD A,ADIRN,(A) ;Get DIR #
		MOVE C,RENPCT	;GET # OF PAGES IN FILE
		CALL ADJALC	;Do ADJUST
		MOVE A,SRCOFN	;Recover OFN
		CALL RELOFN	;[7.1067] (A/A)DISCARD SOURCE OFN
		NOSKED		;[7.1067] Go NOSKED  and uncache the OFN in order
		MOVE A,SRCOFN	;[7.1067] Get the OFN again
		CALL OC.UNC	;[7.1067] (A/A)to force clearing of the disk alloc entry
		 BUG.(CHK,UCLOFN,DISC,SOFT,<DSKREN - Attempt to uncache locked OFN>,,<
Cause:	The RNAMF jsys has just renamed a file and then tried to uncache the
	OFN.  This is to prevent a situation where directories appears to
	have the wrong number of pages in use.  Somehow the file was locked
	by another process.  This should not be possible.  If this persists
	please change this to a BUGHLT and submit an SPR with a dump.
>)				;[7.1067]
		OKSKED		;[7.1067]
		RET]		;[7.1067]
	SKIPL A,DSTOFN		;HAVE DESTINATION OFN?
	CALL [	LOAD B,STRX,(A)	;Get STR #
		LOAD A,ALOCX,(A) ;YES, GET INDEX INTO QUOTA TABLES
		LOAD A,ADIRN,(A) ;Get DIT #
		MOVN C,RENPCT	;GET NEGATIVE # OF PAGES IN FILE
		CALL ADJALC	;Do the adjust
		MOVE A,DSTOFN	;Recover the  OFN
		CALLRET RELOFN]	;DISCARD DESTINATION OFN
	MOVE D,DSTFDB		;GET BACK TO FDB LOC
	PUSH P,.FBCTL(D)	;SAVE FLAGS
	SETONE FBPRM,(D)	;MAKE FDB PERMANENT TEMPORARILY
	CALL DELFIL		;DELETE OLD CONTENT OF DESTINATION
	 JFCL			;ALWAYS FAILS SINCE PERMANENT BIT SET
	POP P,A			;GET BACK OLD FLAGS
	MOVX B,FB%PRM		;GET PERMANENT BIT
	TXNN A,FB%PRM		;WAS FILE PERMANENT BEFORE?
	ANDCAM B,.FBCTL(D)	;NO, DON'T LEAVE IT PERMANENT
	;..
;NOW READY TO PLANT THE OLD FDB INTO THE NEW

	;..
DSKRE9:	MOVE A,DSTFDB		;POINT TO NEW FDB
	LOAD D,FBLEN,(A)	;GET LENGTH OF DEST FDB
	MOVE B,RENFDA		;GET PTR TO OLD SOURCE (IN JSB)
	AOS B			;POINT TO ACTUAL FDB COPY
	LOAD B,FBLEN,(B)	;GET ITS LENGTH
	CAIGE B,(D)		;IS SOURCE SHORTER?
	MOVE D,B		;YES, USE MIN OF THE TWO
	MOVNS D			;MAKE AN AOBJN PTR
	HRLZS D
	LOAD B,FBNPG,(A)	;GET PAGES JUST FLUSHED
	MOVNS B
	MOVE C,DIRORA		;GET BASE ADR OF MAPPED DIR AREA
	OPSTRM <ADDM B,>,DRDCA,(C) ;REDUCE DIRECTORY PAGE COUNT
	HRRZ B,RENFDA		;ADDRESS OF SOURCE FDB
	AOS B			;...
	HRLI B,D+(IFIW)
DSKR9L:	MOVE C,@B		;GET SOURCE
	XOR C,0(A)		;BIT DIFFERENCE
	ANDCM C,RENMSK(D)	;BITS TO RETAIN FROM DESTINATION
	XORM C,0(A)
	AOS A			;STEP TO NEXT WORD IN FDB
	AOBJN D,DSKR9L		;DO ALL WORDS IN FDB
	MOVE D,DSTFDB		;GET BACK ADDRESS OF FDB
	LOAD B,FBFLG,(D)
	TXNE B,FB%OFF		;WAS IT OFFLINE TO START WITH?
	IFNSK.			;[7265]YES
	  MOVE A,.FBADR(D)	;[7265]GET THE INDEX BLOCK ADDRESS
	  SETZM .FBADR(D)	;[7265]AND CLEAR IT
	  LOAD B,STR,(JFN)	;[7265]GET THE STRUCTURE NUMBER
	  CALL DEDSK		;[7265](A,B)RELEASE THE PAGE
	   NOP			;[7265]
	ENDIF.
;UPDATE .FBCRE WORD IN FDB

	CALL UPDDTM		;GET CURRENT TIME IN A
	MOVE B,A		;COPY TO B
	MOVE A,DSTFDB		;GET DESTINATION FDB ADDRESS
	SKIPL B			;CURRENT DATE AND TIME KNOWN?
	STOR B,FBCRE,(A)	;YES, STORE INTO FDB

	MOVE D,DIRORA		;GET ADR OF DIR AREA
	LOAD B,FBNPG,(A)	;UPDATE DIRECTORY PAGE COUNT NOW THAT
	OPSTRM <ADDM B,>,DRDCA,(D) ;FILE HAS REACHED DESTINATION
	CALL DSKDV		;DELETE EXCESS VERSIONS
	MOVEI A,JSBFRE		;RETURN JSB STORAGE
	MOVE B,RENFDA
	CALL RELFRE		;...
	CALL UPDDIR		;UPDATE DEST DIRECTORY
	CALL USTDIR
	RETSKP
;HERE IF FILE HAS NO INDEX BLOCK (.FBADR WORD CONTAINS 0)

DSKREF:	MOVE A,SRCFDB		;FDB
	LOAD A,FBFLG,(A)
	TXNN A,FB%OFF		;OFFLINE?
	RETBAD (RNAMX9,<CALL DSKRE8>) ;NO, BOMB
	MOVEI A,0		;KLUGE UP AN XB
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER
	CALL DSKASN
	 RETBAD (RNAMX4,<CALL DSKRE8>)
	MOVE B,SRCFDB		;FDB OFFSET AGAIN
	TLO A,(FILNB)
	MOVEM A,.FBADR(B)	;MAKE IT HAVE ONE
	TLO A,(THAWB)		;LIMIT ACCESS
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	MOVE C,SRCFDB		;GET ADDRESS OF FDB - CHECK FOR LONG FILES
	MOVE C,.FBCTL(C)	;GET THE FLAGS
	CALL ASKOFN		;ASSIGN OFN ASK AC3
	 JRST [	MOVE B,A
		SETO A,
		CAIE B,OPNX9	;FILE BUSY?
		 JRST .+1	;NO, CONTINUE
		RETBAD (RNAMX10,<CALL DSKRE8>)]
	MOVE B,SRCFDB		;FDB OFFSET
	CALL UPDOFN		;UPDATE
	MOVE B,SRCFDB		;FDB OFFSET
	MOVX C,FILNB
	ANDCAM C,.FBADR(B)	;CLEAR THAT
	JRST DSKRE1		;REJOIN MAINLINE
;COMMON ERROR ROUTINE

DSKRE8:	CALL USTDIR		;UNLOCK STR & DIRECTORY
DSKRE7:	SKIPL A,DSTOFN		;RELEASE OFN IF ANY
	CALL RELOFN
	RET			;EXIT

; MASKS OF BITS TO NOT COPY FROM SOURCE FILE
;		   ---

RENMSK:	-1			;.FBHDR
	FB%TMP+FB%PRM		;FLAGS
	-1			;POINTER TO NEXT EXT FDB
	0			;.FBADR
	-1			;.FBPRT
	-1			;.FBCRE
	-1			;POINTER TO AUTHOR STRING
	-1,,0			;GENERATION # ,, DIR # (IF DIR FILE)
	-1			;.FBACT
	770000,,0		;.FBBYV
	0			;.FBSIZ
	0			;.FBCRV
	0			;.FBWRT
	0			;.FBREF
	0			;.FBCNT
	REPEAT 3,<-1>		;.FBBK0-2
	0			;.FBBBT
	0			;.FBNET
	0			;.FBUSW
	-1			;POINTER TO NEXT GENERATION FDB
	-1			;POINTER TO NAME STRING
	-1			;POINTER TO EXTENSION STRING
	-1			;POINTER TO LAST-WRITER STRING
	0			;FBTDT
	0			;FBFET
	0			;FBTP1
	0			;FBSS1
	0			;FBTP2
	0			;FBSS2
;THE SPOOLED DEVICE HANDLER

	SWAPCD

RS SPLVER,1			;VERSION NUMBER TO USE ON GTJFN

SPLDTB::SPLDTL			;LENGTH
	DTBDSP SPLDIR		;SET DIRECTORY
	DTBBAD (DESX9)		;NAME LOOKUP
	DTBBAD (DESX9)		;EXTENSION
	DTBBAD (DESX9)		;VERSION
	DTBBAD (DESX9)		;PROTECTION INSERTION
	DTBBAD (DESX9)		;ACCOUNT
	DTBBAD (DESX9)		;STATUS INSERTION
	DTBDSP (SPLOPN)		;OPEN
	DTBBAD (DESX9)		;INPUT
	DTBBAD (DESX9)		;OUTPUT
	DTBBAD (DESX9)		;CLOSE
	DTBBAD (DESX9)		;RENAME
	DTBBAD (DESX9)		;DELETE
	DTBBAD (DESX9)		;DUMPI
	DTBBAD (DESX9)		;DUMPO
	DTBBAD (DESX9)		;MOUNT
	DTBBAD (DESX9)		;DISMOUNT
	DTBBAD (DESX9)		;INITIALIZE DIRECTORY
	DTBBAD (DESX9)		;MTAPE
	DTBBAD (DESX9)		;GET STATUS
	DTBBAD (DESX9)		;SET STATUS
	DTBSKP			;RECOUT - FORCE RECORD OUT (SOUTR)
	DTBDSP (RFTADN)		;READ TAD
	DTBDSP (SFTADN)		;SET TAD
	DTBDSP (BIOINP)		;SET JFN FOR INPUT
	DTBDSP (BIOOUT)		;SET JFN FOR OUTPUT
	DTBBAD (GJFX49)		;CHECK ATTRIBUTE
	DTBSKP			;RELEASE JFN
	SPLDTL==:.-SPLDTB	;GLOBAL LENGTH OF DISPATCH TABLE

SPLDIR:	TQO NNAMF		;NO NAME DEVICE
	MOVEI A,GJFX32
	RET
;ROUTINE TO OPEN THE SPOOLED DISK FILE AND SWAP THE JFNS
;
; OPENS SPOOL FILE IN THE FORM OF:
;
;	PS:<SPOOL>DEVICE-DIR#-0-GTAD#..;P777700

SPLOPN:	NOINT
	EA.ENT
	TRVAR <SPLCAP,SPLBGN,SPLCUR,SPLJFN,SPLERR> ;[7118] TEMP STORAGE
	MOVE A,CAPENB		;[7118] GET CURRENT CAPENB
	MOVEM A,SPLCAP		;[7118] SAVE THEM
	MOVEI B,^D30		;[7118] MORE THEN ENOUGH SPACE FOR FILESPEC
	CALL ASGJFR		;GET SOME JOB STORAGE
	 RETBAD 		;GIVE ERROR BACK TO USER
	MOVEM A,SPLBGN		;[7118] SAVE ADDRESS OF STRING
	HRLI A,(<POINT 7,0,35>)	;[7118] MAKE POINTER TO AREA
	MOVEM A,SPLCUR		;[7118] SAVE IT
	CALL SPLBP1		;[7118] GO BUILD 1ST PORTION OF FILE SPEC
	HRRZ B,FILIDX(JFN)	;[7118] GET INDEX INTO DEVICE TABLES
	LDB B,[POINT 9,DEVCHR(B),17] ;[7118] GET DEVICE TYPE
	CAIN B,.DVCDR		;[7118] IS THIS A CARD READER?
	 JRST SPLCDR		;[7118] YES, HANDLE IT DIFFERENTLY
	CALL SPLBP2		;[7118] GO BUILD 2ND PORTION OF FILESPEC
	MOVX A,SC%WHL		;[7118] TURN THIS JOB INTO A WHEEL FOR THE OPEN
	IORM A,CAPENB		;[7118] GIVE OURSELVES WHEEL STATUS
SPLGTL: AOS A,SPLVER		;GET NEXT VERSION # TO USE
	ANDI A,377777		;DON'T LET IT GET TOO BIG
	HRLI A,(GJ%FOU!GJ%NEW!GJ%DEL!GJ%PHY!GJ%SHT)
;SPLOPN...

SPLGTA:	MOVE B,SPLBGN		;[7118] GET BACK STRING POINTER
	HRLI B,(POINT 7,0,35)	;TURN IT INTO A STRING POINTER
SPLGTJ:	GTJFN			;OPEN THIS FILE
	 JRST SPLGTF	        ;[7118] COULDN'T
	MOVEM A,SPLJFN		;[7118] SAVE JFN
	MOVEI A,JSBFRE
	MOVE B,SPLBGN		;GET BACK ADDRESS OF FILESPEC
	CALL RELFRE		;RETURN STRING TO FREE POOL
	MOVE A,SPLJFN		;[7118] GET JFN OF DSK FILE
	MOVEI B,100000		;ASSUME WRITE
	HRRZ C,FILIDX(JFN)	;GET POINTER INTO DEVICE TABLES
	MOVE C,DEVCHR(C)	;GET CHARACTERISTICS
	TLNE C,(DV%IN)		;AN INPUT DEVICE?
	MOVEI B,200000		;YES, CHANGE MODE OF OPEN TO READ
	LOAD C,FLBSZ,(JFN)	;GET THE BYTE SIZE
	DPB C,[POINT 6,B,5]	;KEEP THE SAME BYTE SIZE IN FILE
	LOAD C,FLMOD,(JFN)	;DO THE SAME WITH THE MODE
	DPB C,[POINT 4,B,9]
	OPENF			;OPEN THE SPOOLED FILE
	IFNSK.			;[7118] 
	 MOVEM A,SPLERR		;[7118] FAILED, SAVE ERROR CODE 
	 MOVE A,SPLJFN		;[7118] GET JFN BACK
	 RLJFN			;[7118] RELEASE THE JFN OF THE DSK FILE
	  JFCL			;[7118] 
	 JRST SPLFAL		;[7118] GO FINISH UP AFTER ERROR
	ENDIF.			;[7118] 
	CALL UNLCKF		;UNLOCK THE FILE LOCK
	MOVE A,SPLCAP		;[7118] GET OLD CAPS
	MOVEM A,CAPENB		;[7118] PUT THEM BACK
	MOVE A,SPLJFN		;[7118] GET BACK THE JFN
	PUSH P,FILIDX(JFN)	;SAVE INDEX INTO DEVICE TABLES
	MOVE B,JFN		;GET JFN OF SPOOLED DEVICE
	IDIVI B,MLJFN		;CONVERT TO EXTERNAL INDEX
	SWJFN			;MAKE JFN POINT TO DISK FILE
	RLJFN			;RELEASE THE OTHER JFN
	 JFCL
	POP P,A			;GET BACK INDEX
	HRRM A,FILIDX(JFN)	;KEEP ORIGINAL INDEX ACCROS SPOOLING
	MOVE P,MPP		;RESTORE STACK TO LEVEL AT JSYS ENTRY
	SMRETN			;RETURN TO USER

;[7118] HERE WHEN GTJFN FAILED FOR THE SPOOL FILE

SPLGTF: CAIN A,GJFX27		;[7118] FILE ALREADY EXISTS?
         JRST SPLGTL	        ;[7118] YES, TRY AGAIN
	HRRZ B,FILIDX(JFN)	;[7118] 
	LDB B,[POINT 9,DEVCHR(B),17] ;[7118] 
	CAIE B,.DVCDR	        ;[7118] IS THIS A CDR?
	IFSKP.			;[7118] 
	  MOVEI A,JSBFRE		;[7118] YES, GO RELEASE SPACE IN JSB
	  HRRZ B,JSCDR		;[7118] FOR NAME STRING
	  CALL RELFRE		;[7118] 
	  SETZM JSCDR		;[7118] YES, NO MORE FILES TO BE READ
	  JRST SPLCDR		;[7118] GO OPEN THE NUL: DEVICE
	ENDIF.			;[7118] 
	MOVEM A,SPLERR		;[7118] SAVE ERROR CODE
	MOVEI A,JSBFRE		;[7118] 
	MOVE B,SPLBGN		;[7118] GET ADDRESS OF STRING
	CALL RELFRE		;[7118] GIVE BACK SPACE
SPLFAL:	MOVE B,SPLCAP		;[7118] GET OLD CAPS BACK
	MOVEM B,CAPENB		;[7118] AND RESTORE THEM
	MOVE A,SPLERR		;[7118] GET BACK ERROR CODE
	RETBAD			;[7118] 

;[7118] HERE TO BUILD THE 1ST PORTION OF THE NEW FILESPEC

SPLBP1:	MOVE A,SPLCUR		;[7118] GET POINTER TO BEGINNING OF STRING
	HRRZ B,FILIDX(JFN)	;[7118] GET DIRECTORY TO SPOOL INTO
	MOVE B,DEVCH2(B)	;[7118] ...
	SKIPE B			;[7118] IF ZERO, USE DEFAULT DIRECTORY
	DIRST			;[7118] ADD IN NEW SPOOLING DIRECTORY
	IFNSK.			;[7118] 
	  HRROI B,[ASCIZ/SPOOL:/] ;[7.1112]NO SUCH DIRECTORY, USE DEFAULT 
	  SETZ C,		;[7118] 
	  SOUT			;[7118] ADD IT INTO STRING
	ENDIF.			;[7118] 
SPLOP1:	HLRZ B,FILDDN(JFN)	;[7118] GET DEVICE NAME STRING
	HRLI B,(POINT 7,0,35)	;[7118] MAKE IT A STRING POINTER
	SETZ C,			;[7118] 
	SOUT			;[7118] PUT "DEV" ONTO NAME STRING
	MOVEI B,"-"		;[7118] FOLLOWED BY A "-"
	IDPB B,A		;[7118] 
	MOVE B,JOBNO		;[7118] NOW GET LOGGED IN DIR #
	HRRZ B,JOBDIR(B)	;[7118] 
	MOVEI C,10		;[7118] AND ADD IT IN OCTAL
	NOUT			;[7118] 
	 BUG.(CHK,NOUTF1,DISC,SOFT,<SPLOPN - NOUT of directory number failed>,,<

Cause:	The NOUT JSYS failed in trying to open the spooled disk file.

Action:	See what the JSYS error from NOUT% was and try to determine what
	may be wrong. It is possible that the destination disk may be
	having problems.
>)
	MOVEM A,SPLCUR		;[7118] SAVE POINTER AS CURRENT
	RET		       	;[7118]       
;[7118] HERE TO BUILD 2ND PORTION OF FILESPEC

SPLBP2:	MOVE A,SPLCUR		;[7118] GET CURRENT POINTER
	HRROI B,[ASCIZ/-0-/]	;[7118] ADD IN STATION NUMBER
	SETZ C,			;[7118] 
	SOUT			;[7118] 
	HLRZ B,FILNEN(JFN)	;[7118] NOW ADD ON THE NAME
	HRLI B,(POINT 7,0,35)	;[7118] 
	MOVEI C,^D20		;[7118] DON'T ALLOW FILENAME TO GET TO BIG
	TRNE B,-1		;[7118] ANY NAME ?
	CALL SPLMVC		;[7118] YES - THERE WAS - MOVE VALID CHARACTERS
	MOVEI B,"."		;[7118] PUT SEPARATOR BETWEEN NAME AND EXT
	IDPB B,A		;[7118] 
	HRRZ B,FILNEN(JFN)	;[7118] GET POINTER TO EXTENSION STRING
	HRLI B,(POINT 7,0,35)	;[7118] 
	MOVEI C,^D39		;[7118] ALLOW FULL SIZE EXTENSION
	TRNE B,-1		;[7118] DON'T ADD EXT IF NONE
	CALL SPLMVC		;[7118] 
	HRROI B,[ASCIZ/;P777700/] ;[7118] NO EXT/GEN, PROTECT THE FILE
	SETZ C,			;[7118] 
	SOUT			;[7118] 
	MOVEI B,0		;[7118] ADD A NUL BYTE
	IDPB B,A		;[7118] 
	MOVEM A,SPLCUR		;[7118] UPDATE THE POINTER
	RET			;[7118] 
;[7118] HERE TO MOVE ONLY VALID FILENAME CHARACTERS. WE DO THIS 
;[7118] INSTEAD OF SOUTING DIRECTLY FROM THE JFN BLOCK BECAUSE 
;[7118] THE JFN BLOCK STRINGS DO NOT HAVE "^V" QUOTE CHARS STORED 
;[7118] BEFORE INVALID CHARACTERS. NOT MOVING THE INVALID CHARACTERS 
;[7118] SAVES US FROM ALSO FIXING IPCF.MAC 
;[7118] 
;[7118]  CALL WITH   A/ BYTE POINTER TO FILESPEC STRING WE ARE BUILDING
;[7118] 	     B/ BYTE POINTER TO STRING IN THE JFN BLOCK
;[7118] 
;[7118]  RETURNS + 1 ALWAYS    A/ UPDATED POINTER

SPLMVC:	SOJE C,R		;[7118] DONE IF COUNT EXHAUSTED
SPLMV0:	ILDB D,B		;[7118] GET SOURCE CHAR
	JUMPE D,R		;[7118] IF NULL, THEN ALL DONE
	CAIL D,"A"		;[7118] BETWEEN A-Z ?
	CAILE D,"Z"		;[7118] 
	SKIPA			;[7118] 
	JRST SPLMV1		;[7118] YES
	CAIL D,"0"		;[7118] NO - HOW ABOUT 0-9 ?
	CAILE D,"9"		;[7118] 
	JRST SPLMV0		;[7118] NO - GO AFTER NEXT SOURCE CHAR
SPLMV1:	IDPB D,A		;[7118] STORE SOURCE CHAR INTO NEW STRING
	JRST SPLMVC		;[7118] AND TRY ANOTHER
SPLCDR:	SKIPN B,JSCDR		;IS A SPOOL SET SET UP?
	JRST [	MOVSI A,(GJ%PHY!GJ%SHT)	;NO, USE NUL:
		HRROI B,[ASCIZ/NUL:/]
		JRST SPLGTJ]	;GO DO GTJFN
	MOVE A,SPLCUR		;[7118] GET CURRENT POINTER
	MOVEI C,"."		;PUT IN PUNCTUATION AFTER NAME
	IDPB C,A
	HRLI B,(POINT 7,0,35)	;SET UP POINTER TO CDR NAME
	SETZ C,
	SOUT			;APPEND SPOOL SET NAME TO STRING
	MOVEM A,SPLCUR		;[7118] SAVE CURRENT POINTER
	HLRZ A,JSCDR		;NOW GET GENERATION NUMBER TO USE
	MOVEI A,1(A)		;INCREMENT IT
	ANDI A,377777		;DON'T LET IT GET TOO LARGE
	HRLM A,JSCDR		;STORE UPDATED NUMBER
	HRLI A,(GJ%OLD!GJ%PHY!GJ%SHT) ;ACCEPT OLD FILES ONLY
	JRST SPLGTA		;GO DO GTJFN AND OPENF
;FILE SPECIFIC ENTRY POINTS FOR ASGOFN.
;MUST HAVE JFN SET UP AND THE CURRENT DIRECTORY MAPPED.
;   AC1/ FDB ADDRESS
;   AC2/ STR #

;ASSIGN OFN FOR LONG FILE PAGE TABLE - FAILS AT LOWER LEVEL OF OFN
;USAGE TO PREVENT ALL OFNS BEING TIED UP BY HEAVILY MAPPED LONG FILE.

ASLOFN::HRRZ T3,FILOFN(JFN)	;INDEX BLOCKS ARE GOTTEN WITH PTT ACCESS
	HRL T4,T3		;GET ADDR OF SUPER
	MOVE T3,SPTH(T3)	;GET THE PAGE TABLE TABLE ACCESS BITS
	ANDX T3,FILWB+THAWB	; ISLOATED
	IOR T1,T3		;MERGE. PASS TO PAGEM
	TXO T1,OFN2XB		;FOR SUB XB
	JRST ASFOFN

ASKOFN:	TXNE T3,FB%LNG		;SPECIAL ENTRY DO ASP OR ASF .FBCTL IN T3
ASPOFN::TXO T1,OFNPTT		;FOR SUPER XB

ASFOFN::ACVAR <W1>		;GET A WORK REG
	MOVE W1,T4		;SAVE ENTRY FLAG
	TXNN T1,OFN2XB		;REALLY A 2XB?
	SETZ W1,		;NO.
	PUSH P,T1		;SAVE T1,T2
	PUSH P,T2		;HAS STR #
	HRRZ T1,FILDDN(JFN)	;GET DIRECTORY NUMBER
	CALL GETCAL		;GET CURRENT ALLOCATION
	 JRST [	MOVE T3,DIRORA	;DIRECTORY NOT OPENED,
		LOAD T1,DRLIQ,(T3) ;  SO CALCULATE CURRENT
		OPSTR <SUB T1,>,DRDCA,(T3)  ;  ALLOCTION FROM DIR.
		JRST .+1]
	MOVE T4,T1		;SET UP ALLOCATION ARG
	HRRZ T3,FILDDN(JFN)	;SET UP DIR #
	POP P,T2		;RESTORE STR #
	POP P,T1		; AND FDB ADDRESS
	BLCAL. ASNOFN,<T1,T2,T3,T4,W1>
	RET
	RETSKP

	ENDAV.			;END ACVAR
;ASSIGN AN OFN FOR A FILE IN SYSTEM DIRECTORY

ASSOFN::STKVAR <<SAV2,2>>
	DMOVEM T1,SAV2		;Save T1 - T2
	MOVE T1,[540000,,SYSTDN];Get system-directory number
	CALL IGTDAL		;Get disk allocation
	  RET			;Failed
	MOVE T4,T1		;Logged-in quota (in T4)
	SUB T4,T2		; minus current usage is quota remaining
	DMOVE T1,SAV2		;Recover T1 - T2
	BLCAL. ASNOFN,<T1,T2,[SYSTDN],T4,[0]> ;Enter main routine
	RET
	RETSKP
	ENDSV.

;ASSIGN AN OFN FOR A FILE IN THE ROOT-DIRECTORY
	QTINF==377777,,0	;Infinite directory quota
ASROFN::MOVE T4,[QTINF]		;Get infinite quota
	BLCAL. ASNOFN,<T1,T2,[ROOTDN],T4,[0]> ;Do the work
	RET
	RETSKP
;CODE CALLED BY CPMAP IN JSYSA TO VERIFY A JFN ARGUMENT
;	A/ JFN,,PAGE
;	B/ ACCESS DESIRED
;RETURNS:
;	+1 ERROR OF SOME SORT.
;	+2 A NON-ZERO => VERIFIED
;	   A=0 LONG FILE ERROR

CPJFNV::SAVEP			;SAVE FILE REGISTERS
	STKVAR <ACCESS,JFNW>
	MOVEM A,JFNW		;SAVE ARG
	MOVEM B,ACCESS		;SAVE ACCESS BITS AS WELL
	HLRZ JFN,JFNW		;GET JFN
	CALL DSKJFN		;VERIFY JFN
	 RETBAD ()   		;ERROR
	TQNN <OPNF>		;Is it open?
	IFNSK.			;If not
	 CALL UNLCKF		;Unlock it
	 RETBAD(DESX5)		;And return an error
	ENDIF.
;	HRRZ A,FILDDN(JFN)	;GET 36 BIT
;	LOAD B,FLUC,(JFN)	; DIRECTORY
;	HRL A,B			;  NUMBER
;	CALL SETDIR		;MAP AND LOCK DIRECTORY
;	 RETBAD ()		;FAILURE.
	TQNN <RNDF>		;OPENED FOR APPEND?
	JRST [	CALL UNLCKF	;YES. ERROR THEN
		MOVEI A,PMAPX2	;GET PROPER ERROR CODE
		RET]		;ERROR
;CPJFNV...

	MOVE B,ACCESS		;GET ACCESS BITS
	TXNN B,PM%WT		;WANT WRITE
	TDZA B,B		;NO
	MOVEI B,1		;YES
	HRRZ A,JFNW		;GET PAGE NUMBER AS WELL
	CALL @[	IFIW!JFNOF3
		IFIW!JFNOF1](B)	;VERIFY PAGE TABLE, ETC.
	 JRST [	MOVEM A,ACCESS	;SAVE ERROR CODE
		CALL UNLCKF	;UNLOCK JFN
		MOVE A,ACCESS	;RESTORE ERROR CODE
		CAIE A,LNGFX1	;COULDN'T CREATE PT?
		RET		;NO. GENERAL ERROR
		MOVE D,A	;COPY ERROR CODE
		SETZ A,		;YES. RETURN CONDITION
		RETSKP]		;SAYING IT IS A PROCESS
	MOVE B,STS		;COPY STATUS
	MOVSI C,(PM%RWX)	;GIVE ALL ACCESS
	TXNN B,WRTF		;UNLESS FILE NOT OPEN FOR WRITE
	TLZ C,(PM%WT)		;IN WHICH CASE DISALLOW WRITE
	MOVE D,JFN		;GET JFN
	MOVEM STS,FILSTS(JFN)	;UPDATE STATUS NOW
	RETSKP			;GOOD STUFF

REPEAT 0,<			;REMOVE THESE EXITS..

;Here on success
CPJFNG:	CALL USTDIR		;UNLOCK DIRECTORY (PRESERVES ALL ACS)
	RETSKP			;GOOD STUFF

;Here on failure, AC1 contains error code.
CPJFNB:	CALLRET USTDIR		;UNLOCK DIRECTORY (PRESERVES ALL ACS)
>				;END OF REPEAT 0
	TNXEND
	END