Google
 

Trailing-Edge - PDP-10 Archives - BB-M080K-SM - monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
; *** 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

DEFAC (STS,P1)			;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)

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

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

;RFTAD
DSKRFT:	EA.ENT
	TQNE <ASTF>		;OUTPUT STARS?
	RETBAD(DESX7)		;YES, LOSE
	CALL GETFDB		;GET FDB IN
	 RETBAD(DESX3)		;LOSE
	MOVE B,.FBCRV(A)	;GET CREATION DATE AND TIME
	CAILE Q1,.RSCRV		;DOES CREATION WORD EXIST?
	XCTU [MOVEM B,.RSCRV(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBWRT(A)	;GET WRITTEN DATE AND TIME
	CAILE Q1,.RSWRT		;DOES WRITTEN WORD EXIST?
	XCTU [MOVEM B,.RSWRT(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBREF(A)	;GET REFERENCE DATE AND TIME
	CAILE Q1,.RSREF		;DOES REFERENCE WORD EXIST?
	XCTU [MOVEM B,.RSREF(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBCRE(A)	;GET INTERNAL WRITTEN DATE AND TIME
	CAILE Q1,.RSCRE		;DOES INTERNAL SYSTEM WRITTEN WORD EXIST?
	XCTU [MOVEM B,.RSCRE(Q3)] ;YES, RETURN TO USER
	LOAD B,FBLEN,(A)	;GET LENGTH
	CAIGE B,.FBLXT		;IS ARCHIVE/VIRTUAL DISK STUFF THERE?
	JRST DSKRF1		;NO, JUST RETURN
	MOVE B,.FBTDT(A)	;GET TAPE DATE & TIME
	CAILE Q1,.RSTDT		;SPACE IN CALLER'S BLK EXIST?
	XCTU [MOVEM B,.RSTDT(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBNET(A)	;ONLINE EXPIRATION DATE/INTERVAL
	CAILE Q1,.RSNET		;SPACE EXISTS?
	XCTU [MOVEM B,.RSNET(Q3)] ;YES, RETURN TO USER
	MOVE B,.FBFET(A)	;GET OFFLINE EXPIRATION DATE/INTERVAL
	CAILE Q1,.RSFET		;SPACE FOR IT?
	XCTU [MOVEM B,.RSFET(Q3)] ;YES, RETURN TO USER
DSKRF1:	CALL USTDIR
	RETSKP

;SFTAD
DSKSFT:	EA.ENT
	STKVAR <FDBSAV>
	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?
	MOVEM B,.FBCRE(A)	;YES, STORE INTERNAL WRITE D&T
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
	MOVEM B,.FBTDT(A)
DSKSF9:	CAIG Q1,.RSNET
	JRST DSKS10
	XCTU [MOVE B,.RSNET(Q3)]
	CAME B,[-1]
	MOVEM B,.FBNET(A)
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
	SKIPN T3,TPRCYC		;RECYCLE/EXPIRATION PERIOD SET?
	MOVX T3,.STDFE		;NO, USE DEFAULT VALUE
	CAMLE T2,T3		;WITHIN SYSTEM LIMIT?
	JRST DSKS12		;NO, DON'T DO IT
DSK10B:	MOVEM B,.FBFET(A)	;SET IT
DSKS11:	CALL UPDDIR
	CALL USTDIR
	RETSKP

DSK10A:	PUSH P,A		;LGTAD WILL CLOBBER A & B
	PUSH P,B
	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
	POP P,B			;WHAT USER WANTED
	POP P,A			;FDB ADDR
	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

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

OFNJFX::TLO A,400000		;SAY ONLY JFN'S WITH MAPCOUNT .G. 0
OFNJFN:: EA.ENT
;	CALLRET OFNJF0		;DO THE WORK

OFNJF0:	SAVEAC <B,C,STS,JFN>	;PRESERVE THESE ACS (AMEN!!)
	TRVAR <ARGI,AOFN>
	MOVEM A,ARGI		;SAVE ORIGINAL ARGUMENT
	HLRZS A
	ANDI A,177777
	MOVEM A,AOFN		;SAVE THE OFN AS WELL
OFNJF7:	NOINT
	LOCK JFNLCK		;LOCK THE JFN STRUCTURE LOCK
	MOVE JFN,MAXJFN
	SOS JFN
	IMULI JFN,MLJFN		;CONVERT TO INTERNAL VALUE
OFNJF1:	MOVX STS,OPNF		;GET OPEN BIT
	HRRZ A,FILDEV(JFN)	;GET DEVICE CODE FOR THIS JFN
	TDNE STS,FILSTS(JFN)	;OPENED?
	CAIE A,DSKDTB		;YES. A DISK?
         JRST OFNJF2		;NO. CAN'T USE IT THEN
	CALL OFNJFT		;IS THIS THE OFN WE ARE LOOKING FOR?
         JRST OFNJF2		;THIS IS NOT OUR JFN
	AOSE FILLCK(JFN)	;YES AND YES. LOCK JFN. AND CHECK AGAIN
	JRST [	UNLOCK JFNLCK	;CAN'T!
		OKINT		;WAIT OKINT
		SKIPL FILLCK(JFN) ;FOR FILLCK TO FREE UP
		CBLK1
		JRST OFNJF7]	;START ANEW
	NOINT			;EXTRA NOINT FOR JFN LOCK
	CALL OFNJFT		;IS THIS STILL THE OFN WE ARE LOOKING FOR?
         JRST OFJF11		;THIS IS NOT OUR JFN
	MOVE A,FILLFW(JFN)
	TLNN A,777776		;IF PAGE MAP CNT .G. 0, CHECK OPNF
	SKIPL ARGI		;IF NO, SEE IF WE CARE
	CAIA			;OK TO USE IT
	JRST OFJF11		;CAN'T USE IT
	MOVEI A,0(JFN)		;GET THE JFN
	CALL STRDMO		;YES. MAKE SURE STILL MOUNTED THEN
	 JRST OFJF11
	; ..
;FOUND A JFN TO USE.

	MOVE T1,AOFN		;GET OFN BACK
	HRRZ T1,SPTO4(T2)	;GET XB2 DATA IF ANY
	LSH T1,PGSFT		;CONVERT TO PAGE OFFSET
	ADDM T1,ARGI		;AUGMENT THE PAGE #
	UNLOCK JFNLCK		;DON'T NEED THIS ANYMORE
	OKINT			;FREE LOCK
        MOVE A,JFN		;COPY JFN
	MOVE CX,ARGI		;GET ARG
	TXNE CX,1B1		;WANT TO LEAVE IT 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
	TMNN OFN2XB,SPTH(T1)	;ARE WE LOOKING FOR A 2XB?
	IFSKP.			;YES
	   JUMPLE T3,OFJBAD	;VALIDATE XB2DAT
	   HLRZ T1,T3		;REMEMBER SUPER XB OFN AS OFN OF SEARCH
	   SKIPG T2,SPTO4(T2)	;GET SUPER XB FOR FILES OFN IF ANY
	   RET			;NO FORGET FILE (OFN IS NOT LONG)
	   HLRZS T2		;GET SUPER ONLY
	ELSE.			;OFN DOES NOT BELONG TO A LONG FILE
	   JUMPN T3,OFJBAD	;VALIDATE XB2DAT
	ENDIF.
	CAME T1,T2		;SAME? SUPER=SUPER OR NORMAL=NORMAL
	RET			;NO
	MOVE T2,AOFN
	CALLRET CHKDMO		;FINAL CHECK IS DISMOUNTED
	  

OFJF22:	MOVEI A,0(JFN)		;GET THE JFN
	CALL LUNLKF		;FREE SDB LOCK
	OKINT			;UNDO NOINT FROM JFN LOCK
OFNJF2:	SUBI JFN,MLJFN		;TO NEXT JFN INDEX
	JUMPGE JFN,OFNJF1
	UNLOCK JFNLCK
	OKINT
	RET

;IF HERE, CAN'T USE JFN

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

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

Cause:	An OFN was found whose bits indicated that it was or was not a
	secondary index block. SPTO4 was found to disagree.
>)
;SPECIAL ENTRIES FOR OFNJFN AND OFNJFX TO LEAVE THE JFN LOCKED

OFNJXL::TXOA A,1B0!1B1		;SET BITS

OFNJFL::TXO A,1B1		;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
	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]
	OPSTR <SKIPN P3,>,FBADR,(D)	;GET INDEX BLOCK ADR
	JRST DELFI3		;WASN'T ONE
	SETZRO FBADR,(D)	;REMOVE XB ADR FROM DIR
	CALL UPDDIR		;UPDATE DIRECTORY, FILE IS EFFECTIVELY
	SETZM TBLTYP		;SET TO SHORT FILE INDICATION
;**;[7207] REPLACE 1 LINE AT DELFIL:+15.L	DSW	12/06/85
	MOVE A,SAVDD		;[7207] GET FDB ADDRESS
	MOVE A,.FBCTL(A)	;GET FILE BITS
	TXNE A,FB%LNG		;IS THE FILE LONG?
	SETOM TBLTYP		;YES - INDICATE
;#
	TXNE A,FB%NDL		;IS THIS FILE MARKED "NEVER DELETE"?
	 JRST [	MOVEI A,DELX13	;YES - RETURN AN ERROR
		JRST DELFIX]
	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)
	SKIPE DELFLG		;GONNA CLOBBER FDB?
	TXNN B,FB%ARC		;ARCHIVED FILE?
	 JRST DELF31		;NO, SKIP IPCF
	MOVE A,[.FLXP,,.NOTM]	;NOTIFICATION: FILE EXPUNGED
	MOVE B,D		;FDB OFFSET
	CALL ARCMSG
	 JRST	[MOVEI T1,ARCX13
		 JRST DELFIX]	;COULDN'T DO IT, IPCF MESSAGE FAILED
;**;[7207] INSERT 1 LINE AT DELF31:-2.L	DSW	12/06/85
	MOVE D,SAVDD		;[7207] RESTORE FDB ADDRESS
	MOVE B,.FBCTL(D)	;RECOVER CTL BITS
DELF31:	SKIPN DELFLG		;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
	HRRZ A,FILOFN(JFN)
	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]
	HRRZ T3,FILOFN(JFN)	;GET FILE SECTION NUMBER
	HRRZS T2
	SUB T2,T3
	HRRM T2,XB2INF
	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?
	CALL DELFL1		;YES, GET RID OF XB
	 JFCL

;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