Trailing-Edge
-
PDP-10 Archives
-
BB-M080M-SM
-
monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
; *** 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
;------------------------- Autopatch Tape # 13 -------------------------
; *** 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.
;------------------------- Autopatch Tape # 12 -------------------------
; 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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985.
;ALL RIGHTS RESERVED.
SEARCH PROLOG
TTITLE DISC
SWAPCD
;SPECIAL AC DEFINITIONS USED HEREIN
;**;[7324] Add 1 line at DSKDTB:-13L MDR 17-JUN-86
DEFAC (DIR,Q2) ;[7324] Contains DIRORA
DEFAC (STS,P1) ;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)
;**;[7324] Add 1 line at DSKDTB:-8L MDR 17-JUN-86
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
;**;[7324] Modify 1 line at DSKSFT:+1L MDR 17-JUN-86
STKVAR <FDBSAV,DATSAV> ;[7324]
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?
;**;[7324] Replace 1 line with 5 lines at DSKSF7:+7L MDR 17-JUN-86
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
;**;[7324] Replace 1 line with 5 lines at DSKSF8:+10L MDR 17-JUN-86
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)]
;**;[7324] Replace 1 line with 15 lines at DSKSF9:+3L MDR 17-JUN-86
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.
;**;[7324] Replace 1 line with 17 lines at DSKS9A:+0L MDR 17-JUN-86
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
;**;[7324] Add 7 lines at DSKS10:+7L MDR 17-JUN-86
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
;**;[7324] Add 10 lines at DSK10A:+0L MDR 17-JUN-86
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
;**;[7324] Replace 2 lines with 1 at DSK12:-5L MDR 17-JUN-86
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
;**;[7324] Add 2 lines at DSK12:+0L MDR 17-JUN-86
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
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 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
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
JRST [ MOVE A,NLFT2 ;GET DISK ADDRESS
LOAD B,STR,(JFN) ;GET STRUCTURE NUMBER FROM JFN BLOCK
CALL DEDSK ;RELEASE IT
CALLRET USTDIR] ; AND GIVE FAIL RETURN
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
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
JRST [ HRRZ A,FILOFN(JFN)
HLLZS FILOFN(JFN)
CALL RELOFN
RET]
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] Replace 1 line wiht 15 at OFNJFX:: DML 5-Jun-86
;[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
;**;[7315] Change 1 line at OFNJF0:+4 DML 5-Jun-86
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
;**;[7338] Add 1 line after OFNJF1:+15 DML 23-Jul-86
MOVE B,ARGI ;[7338] Get flags
MOVE A,FILLFW(JFN)
TLNN A,777776 ;IF PAGE MAP CNT .G. 0, CHECK OPNF
;**;[7338][7315] Change 1 line at OFNJF1:+18 DML 5-Jun-86
SKIPL B ;[7338][7315] If no, see if we care
CAIA ;OK TO USE IT
JRST OFJF11 ;CAN'T USE IT
;**;[7338][7315] Add 2 lines after OFNJF1:+20 DML 5-Jun-86
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.
;**;[7315] Change 1 line at OFNJF1:+28 DML 5-Jun-86
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
;**;[7315] Change 1 line at OFNJF3:+8 DML 5-Jun-86
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
;**;[7329] Add 1 line after OFNJFT:+3 DML 16-Jun-86
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
;**;[7315] Add 3 lines after OFNJFT:+15 DML 5-Jun-86
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
;**;[7315] Change 2 lines at OFNJXL:: DML 5-Jun-86
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
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
; ..
;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
>)
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
;**;[7283] Add 2 lines after CNTLN5:+0 DML 4-APR-86
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
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]
;**;[7207] CHANGE 1 LINE AT DELFIL:+4.L DSW 12/06/85
TRVAR <DELFLG,TBLTYP,XB2INF,SAVDP3,SAVDF,SAVDQ3,SAVDD,SAVDA,SAVDA1,SAVDA2,SAVDB> ;[7207] ADD NEW TEMP STORAGE
MOVEM A,DELFLG ;STORE ENTRY FLAG
;**;[7207] REPLACE 4 LINES AT DELFIL:+7.L DSW 12/06/85
MOVEM P3,SAVDP3 ;[7207]
MOVEM F,SAVDF ;[7207]
MOVEM Q3,SAVDQ3 ;[7207]
MOVEM D,SAVDD ;[7207]
;**;[7364] CHANGE 1 LINE AT DELFIL: + 16L JDM 12-SEP-86
MOVE A,.FBCTL(D) ;[7364]GET FILE BITS
;**;[7266]Move 3 lines from DELFIL: + 26L to +24L JDM 11-MAR-86
TXNE A,FB%NDL ;[7266]IS THIS FILE MARKED "NEVER DELETE"?
JRST [ MOVEI A,DELX13 ;[7266]YES - RETURN AN ERROR
JRST DELFIX]
;**;[7266]Move 1 line from DELFIL: + 20L to +24L JDM 11-MAR-86
SETZM TBLTYP ;[7266]SET TO SHORT FILE INDICATION
TXNE A,FB%LNG ;[7266]IS THE FILE LONG?
SETOM TBLTYP ;[7266]YES - INDICATE
;**;[7364]ADD 11 LINES AT DELFIL: + 26 L JDM 12-SEP-86
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
;**;[7207] INSERT 1 LINE AT DELF31:-2.L DSW 12/06/85
MOVE D,SAVDD ;[7364][7207] RESTORE FDB ADDRESS
MOVE A,.FBCTL(D) ;[7364]RECOVER CTL BITS
;**;[7266]Move 2 lines from DELFIL: + 16L to 26L JDM 11-MAR-86
;**;[7364] ADD A LABEL AT DELFIL: + 38 L JDM 12-SEP-86
DELF31: OPSTR <SKIPN P3,>,FBADR,(D) ;[7364][7266]GET INDEX BLOCK ADR
JRST DELFI3 ;[7266]WASN'T ONE
;**;[7266]Move 2 lines from DELFIL: + 18L to + 26L JDM 11-MAR-86
SETZRO FBADR,(D) ;[7266]REMOVE XB ADR FROM DIR
CALL UPDDIR ;[7266]UPDATE DIRECTORY, FILE IS EFFECTIVELY
MOVE A,P3 ; GONE AFTER THIS POINT.
;**; REPLACE 8 LINES AT DELFIL+29 (SPR #20122)
LOAD B,CURSTR ;GET STRUCTURE NUMBER FROM PSB
CALL CHKOFN ;IS FILE BUSY?
;**;[7207] REPLACE 1 LINE AT DELFI2:-5.L DSW 12/06/85
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
;**;[7207] REPLACE 1 LINE IN LITERAL AT DELFI2:+13.L DSW 12/06/85
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
;**;[7207] REPLACE 2 LINES AT DELFI2:+18.L DSW 12/06/85
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
;**;[7207] REPLACE 1 LINE AT DELFI2:+27.L DSW 12/06/85
MOVE A,SAVDA ;[7207]
MOVE Q3,.FBCTL(D)
TXNE Q3,FB%LNG
JRST DELFI4 ;LONG FILE
CALL DELPT
;**;[7207] REPLACE 1 LINE AT DELFI3:+0.L DSW 12/06/85
DELFI3: MOVE D,SAVDD ;[7207] GET FDB ADDRESS
SETZM .FBADR(D)
SETZM .FBSIZ(D)
;**;[7220] CHANGE 1 LINE AT DELFI3:+3L JDM 12/24/85
HRLOI B,77 ;[7220]CLEAR DATA MODE AND PAGE COUNT
ANDCAM B,.FBBYV(D)
;**;[7246] CHANGE 1 LINE AT DELFI3:+6L JDM 2/18/86
MOVX B,FB%LNG+FB%SHT+FB%BAT ;[7246]CLEAR THESE BITS IN .FBCTL
ANDCAB B,.FBCTL(D)
;**;[7364] REMOVE 11 LINES FROM DELF31: + 9 L JDM 12-SEP-86
;**;[7364] DELETE A LABEL FROM DELF31: + 9 L JDM 12-SEP-86
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
;**;[7207] REPLACE 4 LINES AT DELFIX:+0.L DSW 12/06/85
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
;**;[7207] REPLACE 1 LINE AT DELFI4:+2.L DSW 12/06/85
MOVEM A,SAVDA1 ;[7207]
CALL ASGPAG
;**;[7207] CHANGE CODE IN LITERAL AT DELFI4:+4.L DSW 12/06/85
JRST [ MOVE A,SAVDA1 ;[7207]
CALL RELOFN
MOVEI A,DELFX3 ;NO ROOM IN JSB
JRST DELFIX]
;**;[7207] CHANGE 1 LINE AT DELFI4:+8.L DSW 12/06/85
MOVEM A,SAVDA2 ;[7207]
MOVE B,A
HRLI B,(PTRW)
;**;[7207] REPLACE 1 LINE AT DELFI4:+10.L DSW 12/06/85
MOVE A,SAVDA1 ;[7207]
CALL SETMPG
;**;[7308] Remove 1 line at DELFI6:-2 DML 30-May-86
HRLI B,-PGSIZ
DELFI6: LOAD A,STGADR,0(B) ;GET PT ADR
JUMPE A,DELFI5 ;JUMP IF NONE
;**;[7207] REPLACE 1 LINE AT DELFI6:+2.L DSW 12/06/85
MOVEM B,SAVDB ;[7207]
;**;[7308] Replace 4 lines with 3 at DELFI6:+3 DML 30-May-86
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
;**;[7207] REPLACE 1 LINE AT DELFI7:+0.L DSW 12/06/85
DELFI7: MOVE B,SAVDB ;[7207]
SETZM (B)
DELFI5: AOBJN B,DELFI6
;**;[7207] REPLACE 1 LINE AT DELFI5:+1.L DSW 12/06/85
MOVE B,SAVDA2 ;[7207]
MOVEI A,0
CALL SETMPG
;**;[7207] REPLACE 1 LINE AT DELFI5:+4.L DSW 12/06/85
MOVE A,SAVDA2 ;[7207]
CALL RELPAG
;**;[7207] REPLACE 1 LINE AT DELFI5:+6.L DSW 12/06/85
MOVE A,SAVDA1 ;[7207]
CALL DELPT ;DELETE THE PTT
JRST DELFI3
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.
>)
;**;[7207] INSERT 1 LINE BEFORE GASOG: DSW 12/06/85
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.
>)
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: LOAD B,OFNBC,(D) ;GET CURRENT VALUE
SKIPN UPDFLF ;ALWAYS STORE THE NEW LENGTH?
CAMGE B,C ;NO, DON'T MAKE SMALLER
STOR C,OFNBC,(D) ;STORE VALUE
RET ;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 A,FBBSZ,(C) ;GET FILE BYTE SIZE
SKIPN A ;IF ZERO
LOAD A,FLBSZ,(JFN) ; THEN USE JFN BYTE SIZE
STOR A,OFNBSZ,(D) ;SAVE IT ALSO
RET
;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
LOAD A,OFNBSZ,(D) ;GET OFN BYTE SIZE
LOAD B,FLBSZ,(JFN) ;GET JFN BYTE SIZE
CAMN A,B ;FAST IF SAME
JRST [ LOAD A,OFNBC,(D)
MOVEM A,FILLEN(JFN)
RET] ;SETUP FILLEN AND RETURN
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
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.
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
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
CALLRET RELOFN] ;DISCARD SOURCE OFN
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?
;**;[7265] Change 2 lines to 7 line at DSKR9L: + 9L JDM 11-MAR-86
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
;**;[7118] Rewrite most of SPLOPN JMP Aug-7-85
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)
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] New routine SPLGTF JMP Aug-7-85
;[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] New routine SPLBP1 JMP Aug-7-85
;[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/PS:<SPOOL>/] ;[7118] 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] New routine SPLBP2 JMP Aug-7-85
;[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] New routine SPLMVC JMP Aug-7-85
;[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
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