Trailing-Edge
-
PDP-10 Archives
-
bb-m780d-sm
-
monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
; 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. There aren't any.
Action: 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.
>)
;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
MOVX T3,FB%BAT ;GET BAT BIT
TDNN T3,.FBCTL(T1) ;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 will be marked.
Data: DIRNUM - directory number
STR - structure name in SIXBIT
>,,<DB%NND>) ;[7.1210]
IORM T3,.FBCTL(T1) ;MARK FILE
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
CNTLNG: LOAD A,FLP0,(JFN) ;GET OFN OF PT0
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
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 will appear 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.
>)
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