Google
 

Trailing-Edge - PDP-10 Archives - BB-M080I-SM - monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
;Edit 3136 to DISC.MAC by SHTIL on Mon 9-Jul-84, for SPR #20122
;		FIX ANOTHER SMALL BUG FOR 3117
;Edit 3126 to DISC.MAC by SHTIL on Mon 18-Jun-84, for SPR #20122
;		Fix second small bug for edit 3117
;Edit 3124 to DISC.MAC by SHTIL on Mon 18-Jun-84, for SPR #20122
;		Fix a small bug for edit 3117
;Edit 3121 to DISC.MAC by MOSER on Tue 12-Jun-84, for SPR #1 - IMPROVE FILBAT
;EDIT 3121 - REPORT STR NAME FOR FILBAT
;Edit 3117 to DISC.MAC by SHTIL on Thu 7-Jun-84, for SPR #20122
;		Don't alow to a file opened with OF%RDU  be expunged
;Edit 3051 to DISC.MAC by CJOHNSON on Tue 6-Dec-83, for SPR #18823
;		Make dump mode disk I/O apply previous context section
;Edit 3018 to DISC.MAC by TBOYLE on Thu 22-Sep-83, for SPR #18747
;		DSKDLD made to call routine to remove dir from special cache.
;Edit 2998 to DISC.MAC by TBOYLE on Wed 17-Aug-83, for SPR #18897
;		mark index block as new in fdb when file goes long.
;Edit 2955 by MCLEAN on Thu 28-Apr-83, for SPR #17841 - REQUIRE WRITE ACCESS FOR OF%RTD
;EDIT 2955 MAKE OF%RTD REQUIRE WRITE ACCESS
;Edit 2944 by MOSER on Tue 5-Apr-83 - FIX A BUG IN 2840
;EDIT 2944 - FIX A BUG IN 2840
; UPD ID= 229, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.11,  16-Nov-82 10:12:44 by COBB
;EDIT 2869 - GET 2840 RIGHT, MORE ON DIRECTORY PAGE COUNTS
; UPD ID= 217, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.10,   9-Nov-82 11:28:12 by MOSER
;EDIT 2865 - FIX A BUG CAUSING ILMNRF
; UPD ID= 180, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.9,  25-Oct-82 21:23:01 by COBB
;EDIT 2840 - Do not update page counts for directory files
; UPD ID= 161, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.8,   4-Oct-82 16:47:51 by MOSER
;EDIT 2829 - MORE OF 2825
; UPD ID= 159, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.7,   4-Oct-82 15:06:21 by MOSER
;EDIT 2828 - PREVENT HUNG JOBS IN OFNJFN FOR LONG FILE ACCESS
; UPD ID= 153, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.6,   1-Oct-82 12:00:26 by MOSER
;EDIT 2825 - ADD ADDITIONAL INFO TO FILBAT
; UPD ID= 139, FARK:<5-1-WORKING-SOURCES.MONITOR>DISC.MAC.4,  27-Sep-82 13:24:00 by MOSER
;EDIT 2817 - NEW BUGINF FILBAT - FILE HAS POSSIBLE BAD PAGE BIT SET
; UPD ID= 84, FARK:<5-WORKING-SOURCES.MONITOR>DISC.MAC.2,   4-Aug-82 11:16:23 by MOSER
;EDIT 2642 - CHECK FOR A FILE HAVING BECOME LONG AT CLOSE.
; UPD ID= 495, SNARK:<5.MONITOR>DISC.MAC.25,   3-Mar-82 15:32:07 by PAETZOLD
;TCO 5.1742 - Make OFNJFN check structure code of OFN against JFNs
; UPD ID= 482, SNARK:<5.MONITOR>DISC.MAC.24,  23-Feb-82 23:42:18 by PAETZOLD
;Documentation of this edit on behalf of MILLER
;TCO 6.1053. Speed up closing long files.
; UPD ID= 318, SNARK:<5.MONITOR>DISC.MAC.23,  13-Nov-81 11:52:56 by DONAHUE
;TCO 5.1612 - return MONX02 error when ASGPAG fails in NEWLFS
; 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
;<OSMAN.MON>DISC.MAC.1, 10-Sep-79 15:26:06, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>DISC.MAC.37, 29-Aug-79 15:06:50, EDIT BY MILLER
;<4.MONITOR>DISC.MAC.36, 29-Aug-79 15:00:53, EDIT BY MILLER
;SET OFN2XB IN CNTLNG
;<4.MONITOR>DISC.MAC.35, 23-Aug-79 23:07:37, EDIT BY MILLER
;set ofn2xb in call to asfofn @delfi6
;<4.MONITOR>DISC.MAC.34, 13-Jun-79 18:10:52, EDIT BY MURPHY
;BUGS IN DSKREN
;<4.MONITOR>DISC.MAC.33, 28-Mar-79 11:09:57, EDIT BY ENGEL
;ADD OFN2XB FLAG AT OPNLN4
;<4.MONITOR>DISC.MAC.32, 19-Mar-79 10:42:18, Edit by LCAMPBELL
; TCO 4.2219 - Don't expunge permanent files when deleting them
;<4.MONITOR>DISC.MAC.31, 12-Mar-79 15:12:45, EDIT BY HURLEY.CALVIN
; USE MIN OF SOURCE AND DESTINATION FDB LENGTHS IN DSKREN
;<4.MONITOR>DISC.MAC.30, 11-Mar-79 13:21:09, EDIT BY MILLER
;LOAD STRUCTURE NUMBER AT DSKREF BEFORE CALLING DSKASN
;<4.MONITOR>DISC.MAC.29,  4-Mar-79 15:10:37, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>DISC.MAC.28, 20-Feb-79 15:59:53, EDIT BY ENGEL
;FIX ERROR CHECKING AT DSKR1 (CHANGE THE "B" TO "A")
;<4.MONITOR>DISC.MAC.27,  7-Feb-79 16:43:13, EDIT BY ENGEL
;CHANGE INCORRECT COMMENTS AT NEWLFS (CHANGED WITH EDIT #26
;<4.MONITOR>DISC.MAC.26, 31-Jan-79 13:20:22, EDIT BY ENGEL
;LONG FILE FIX - GIVE EACH OFN (I.E. NON-PTT) ACCESS BITS
;<4.MONITOR>DISC.MAC.25, 31-Jan-79 10:38:28, EDIT BY ENGEL
;FIX OPENX9 DECISION PROBLEMS AT DSKR1:
;<4.MONITOR>DISC.MAC.24, 25-Jan-79 17:16:01, EDIT BY HEMPHILL
;TCO 4.2171 Clear FB%LNG when creating new file with old FDB
;<4.MONITOR>DISC.MAC.23, 24-Jan-79 14:06:44, EDIT BY HURLEY.CALVIN
; cause dskren to use only what fdb is there when copying the
; source fdb to jsb storage
;<4.MONITOR>DISC.MAC.22, 24-Jan-79 10:10:48, EDIT BY ENGEL
;ADD LONG FILE BUG FIX
;<4.MONITOR>DISC.MAC.21,  4-Jan-79 16:30:09, EDIT BY HURLEY.CALVIN
; Cause DSKDV to consider files with AR%RAR set in .FBBBT as "BAD"
;<4.MONITOR>DISC.MAC.14, 21-Dec-78 10:54:19, EDIT BY ENGEL
;TCO #4.2129 DON'T CLEAR OFN STATUS BITS AT NEWLP1
;<4.MONITOR>DISC.MAC.13,  6-Nov-78 19:13:35, Edit by CALVIN
; CHANGE ERRJMP'S TO RETBAD'S IN DSKREF
;<4.MONITOR>DISC.MAC.12, 25-Oct-78 14:46:44, EDIT BY MILLER
;FIX BUG IN DSKDEL WHERE ARACCK IS CALLED WITH GARBAGE IN T1
;<ARC-DEC>DISC.MAC.38, 12-Oct-78 11:13:01, EDIT BY CALVIN
; Move call to ARACCK in DSKREN to AFTER access checks
; Fix bugs in DSKOPN
;[BBN-TENEXD]<3A-EONEIL>DISC.MAC.25, 30-Aug-78 15:13:14, Ed: CRDAVIS
; Changed DELF to call ARCMSG properly.
;<ARC-DEC>DISC.MAC.4, 24-Aug-78 07:08:58, EDIT BY CALVIN
; Make call to DELFL1 for contents only delete a small routine called FSHFIL
;[BBN-TENEXD]<3A-EONEIL>DISC.MAC.21, 23-Aug-78 15:53:59, Ed: EONEIL
; Put in virtual disk/archive requirements checks to DSKDEL, DSKOPN
;<CALVIN>DISC.MAC.7, 18-Aug-78 07:06:52, EDIT BY CALVIN
; Bug fixes (DELF31 typos, lack of FDB length check)
;<CALV; Make RENAME fixup only what FDB there is (Get length from actual FDB)
;<CALVIN>DISC.MAC.2, 15-Aug-78 11:43:52, EDIT BY CALVIN
; Add new FDB entries in RENMSK
;[BBN-TENEXD]<3-EONEIL>DISC.MAC.3,  1-Jun-78 11:08:40, Ed: EONEIL
; Installed archive sytem modifications
;<4.MONITOR>DISC.MAC.10, 11-Oct-78 08:09:11, EDIT BY R.ACE
;TCO 4.2038 - UPDATE PGLFT COUNTS IN SOURCE AND DESTINATION
;DIRECTORIES WHEN DOING FILE RENAME
;<4.MONITOR>DISC.MAC.9, 14-Sep-78 17:00:55, EDIT BY DBELL
;TCO 4.2007 - CLEAR .FBBKn WORDS ON A RENAME SO THAT THE NEWLY NAMED
;FILE WILL BE SAVED ON A NEW /INCREMENTAL BACKUP.
;<2MCLEAN>DISC.MAC.8, 11-Aug-78 00:16:25, Edit by MCLEAN
;FIX SO DIRCTORY CACHE IS FLUSHED BEFORE DELETING DIRECTORY
;<4.MONITOR>DISC.MAC.7, 27-Jul-78 14:33:31, Edit by PORCHER
;TCO 1956 - REMOVE EXTRANEOUS OKINT IN DSKREN
;<4.MONITOR>DISC.MAC.6, 21-Jul-78 03:10:52, Edit by MCLEAN
;TCO 1949 ADD OF%FDT (FORCE UPDATE ON READ FLAG TO OPENF)
;<4.MONITOR>DISC.MAC.5, 21-Jul-78 03:10:25, Edit by MCLEAN
;<2MCLEAN>DISC.MAC.5, 16-Jul-78 01:14:20, Edit by MCLEAN
;<2MCLEAN>DISC.MAC.4, 16-Jul-78 00:57:57, Edit by MCLEAN
;TCO 1946 DO READ UPDATE TIME DEPENDENT ON MASK NOT ALWAYS
;<4.MONITOR>DISC.MAC.3, 14-Jul-78 02:09:58, Edit by MCLEAN
;<4.MONITOR>DISC.MAC.2, 12-Jul-78 18:08:30, Edit by MCLEAN
;REMOVE UNNECESSARY DIRECTORY WRITES
;<4.MONITOR>DISC.MAC.1,  9-Jul-78 14:52:53, EDIT BY MILLER
;MOVE CALL TO GETLEN IS DSKCLZ UNTIL AFTER FDB IS MAPPED
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	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::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

	DTBLEN==:.-DSKDTB	;GLOBAL LENGTH OF DISPATCH TABLE
;RFTAD/SFTAD DEVICE ROUTINES FOR DISK

;RFTAD
DSKRFT:	SE1CAL
	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:	SE1CAL
	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:	SE1CAL
	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
;**;[3018]Add 4 lines at DSKDLD: + 16L	21-SEP-83	TAB
	MOVE A,0(P)		;[3018]GET FDB ADDRS BACK
	LOAD C,FBDRN,(A)	;[3018]T3/ DIR NUMBER FOR FILE
	LOAD D,CURSTR		;[3018]T4/ STRUCTURE NUMBER
	CALL REMSDR		;[3018]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:	SE1CAL
	CALL GETFDB
	 JRST DSKINB		;GETFDB FAILURE, GO COMPLAIN
	MOVX B,FB%TMP
	IORM B,.FBCTL(A)
	CALL USTDIR
	RET

DSKINB:	BUG(GTFDB1)
	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:	SE1CAL
	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		;RESTRICTED ACCESS?
	TXO B,<WRTF>		;MUST HAVE WRITE ACCESS
	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		;IS DIR FILE. OPEN FOR THAW?
	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
	LDB B,PBYTSZ
	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:
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL ASPOFN		;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(NOPGT0)
	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
	TXO A,OFN2XB		;FLAG AS A LONG FILE
	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,FILP0,(JFN)	;SAVE IT IN THE JFN BLOCK
	CALL UPSHR		;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:	SE1CAL
	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:	SE1CAL
	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:	LDB A,PBYTSZ		;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
	SE1CAL
	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
;	HRRZ B,SVIOW1		;GET CORE LOC
;	HRRZI B,1(B)		;ADD 1 TO POINTER ;MUST BE HLLI WHEN AVAILABLE
;**;[3051] Replace 2 lines at DMPLP:+25L	CRJ	6-Dec-83
	XSFM T2			;[3051] Get previous context section
	TXNN T2,PCU		;[3051] Called from user mode?
	 BUG(DMPIOM)		;[3051] Bad news, no dump mode in TOPS-20
	ANDI T2,EXPCS		;[3051] Strip other data off
	HRLZS T2		;[3051] Move section field to the right spot
	HRR T2,SVIOW1		;[3051] Get right half from command list
	AOS T2			;[3051] 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
	SE1CAL
	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
	LDB A,PBYTSZ		;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
	DPB C,PBYTPO		;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:	SE1CAL
	TRVAR <NLFPN,NLFT1,NLFT2,NLFLG> ;PAGE NO, TEMPS
	MOVEM A,NLFLG		;SAVE ENTRY FLAG
	MOVEM C,NLFPN
	TQNE <LONGF>		;IS THIS FILE ALREADY LONG?
	JRST NEWLFT		;YES, NO SWEAT
	CALL GETFDB		;NO, LET'S GET THE FDB
	BUG(GTFDB2)
	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
	TXNE C,FB%DIR		;IS THIS A DIRECTORY FILE?
	JRST [	CALL USTDIR	;YES, DO NOT ALLOW IT TO BECOME LONG
		RET]
	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
	 JRST [	CALLRET USTDIR]	;NO ROOM
;**;[2998] Reverse 2 lines at NEWLP1+3L	8-17-83	TAB
	TLO A,(FILNB)		;[2998] MARK AS NEW --BEFORE SAVING IT!! TAB
	MOVEM A,NLFT2		;[2998] SAVE IT
	CALL NEWLFS		;ASSIGN OFN ETC
	 JRST [	PUSH P,A	;SAVE ERROR
		MOVE A,NLFT2	;GET DISK ADDRESS
		LOAD B,STR,(JFN) ;GET STRUCTURE NUMBER FROM JFN BLOCK
		CALL DEDSK	;RELEASE IT
		CALL USTDIR
		POP P,A		;RESTORE ERROR
		RET]		; 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 PT
	CALL UPSHR		;DO THE EXTRA COUNT ON PT0
	STOR A,FILP0,(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
	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 ASLOFN		;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
		MOVEI A,MONX02	;RETURN THE ERROR
		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 UPSHR
	STOR A,FILP0,(JFN)	;REMEMBER PT0
NEWLF1:	CALL USTDIR		;FINISHED WITH DIRECTORY
	TQO <LONGF>

;HERE IF PTT EXISTS

NEWLFT:	HRRZ B,FILLFW(JFN)	;GET LOCATION OF PT TABLE
	ADD B,NLFPN		;OFFSET BY PT # TO GET DISC ADDR
	NOSKED			;TO PREVENT OTHERS FROM TAMPERING
	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,<OKSKED>) ;NO. PREVENT PAGE TABLE CREATION
	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 [	OKSKED
		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
	CALL ASFOFN		;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
		OKSKED
		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
	CALL RELOFN
	MOVE A,NLFT1		;GET DISK ADDRESS
	MOVE B,NLFT2		;GET PTR ADDRESS
	IOR A,IMMPTR		;CONSTRUCT STANDARD PTR
	MOVEM A,(B)
	MOVEM A,NLFT1		;SAVE PTR
	HRRZ A,FILOFN(JFN)	;GET PTT OFN
	MOVX B,OFNWRB
	IORM B,SPTH(A)		;NOTE IT CHANGED
	OKSKED			;INCASE PTT IS LOCK AND WE HAVE TO WAIT
	CALL UPDOFN		;UPDATE PTT FOR NEW PT WITHIN IT
	MOVE A,NLFT1		;GET PTR
	JRST NEWLFB		;SKIP OKSKED

;HERE IF NEW PT EXISTS

NEWLFA:	OKSKED
NEWLFB:	MOVEM A,NLFT1		;SAVE DSK ADR
	HLRZ A,FILOFN(JFN)	;GET OFN OF OLD PT
	CALL UPDOFN		;WRITE IT TO DISK BEFORE RELEASING
	MOVE A,NLFT1		;GET DISK ADR
	ANDX A,STGADM		;EXTRACT STG ADDRESS
	CALL CHKDUD		;CHECK IF DDMP BEING SUPPRESSED
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	TXO A,OFN2XB		;FLAG AS SECOND LEVEL XB (TEMP)
	CALL ASLOFN		;ASSIGN LONG PT OFN
	 RET			;FAIL
	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
; 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
	SE1CAL
	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
	SE1CAL
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 [	SUB P,BHC+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 [	SUB P,BHC+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:: SE1CAL
;	CALLRET OFNJF0		;DO THE WORK

OFNJF0:	SAVEAC <B,C,STS,JFN>	;PRESERVE THESE ACS (AMEN!!)
;**;[2828]CHANGE 1 LINE AT OFNJF0:+1L	TAM	4-OCT-82
	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
;**;[2828]REPLACE 5 LINES WITH 1 AT OFNJF1:+5L	TAM	4-OCT-82
;[2828]	MOVE STS,FILSTS(JFN)	;GET STATUS BITS
;[2828]	HLRZ B,FILOFN(JFN)	;GET THE OFN
;[2828]	TQNN <LONGF>		;LONG FILE?
;[2828]	 CAMN B,AOFN		;NO. THEN OFN MUST MATCH
;[2828]	  TQNN <OPNF>		; AND FILE MUST BE OPENED
	CALL OFNJFT		;[2828]THIS JFN?
	   JRST OFNJF2		;NOT...CAN NOT USE THIS JFN
	AOSE FILLCK(JFN)	;YES AND YES. LOCK JFN. AND CHECK AGAIN
	JRST [	UNLOCK JFNLCK	;CAN'T!
		LOCK FILLCK(JFN) ;WAIT UNITL WE CAN
		UNLOCK FILLCK(JFN) ;GOT IT.
		OKINT
		JRST OFNJF7]	;START ANEW
	NOINT			;EXTRA NOINT FOR JFN LOCK
;**;[2828]REPLACE 5 LINES WITH 1 AT OFNJF1:+14L	TAM	4-OCT-82
;[2828]	MOVE STS,FILSTS(JFN)	;GET STATUS BITS
;[2828]	HLRZ B,FILOFN(JFN)	;GET THE OFN
;[2828]	TQNN <LONGF>		;LONG FILE?
;[2828]	CAMN B,AOFN		;NO. THEN OFN MUST MATCH
;[2828]	TQNN <OPNF>		; AND FILE MUST BE OPENED
	CALL OFNJFT		;[2828]STILL THIS ONE?
	JRST OFJF11		;NOT. CAN'T USE THIS JFN THEN
	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 [	UNLOCK FILLCK(JFN) ;NOT TO ONE OF THEM
		OKINT		;UNDO THE NOINT
		JRST OFNJF2]	;SKIP THIS JFN
	TQNE <LONGF>
	JRST OFNJF3
	; ..
;FOUND A JFN TO USE.

OFNJF6:	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

;**;[2828] ADD 25 LINES AT OFNJF6:+12L	TAM	4-OCT-82
OFNJFT:				;[2828] ROUTINE TO TEST JFN FOR OUR OFN
	MOVE STS,FILSTS(JFN)	;[2828] GET STATUS BITS
	HLRZ B,FILOFN(JFN)	;[2828] GET THE JFN'S OFN
	TQNN <LONGF>		;[2828] IS THIS FILE LONG?
        CAMN B,AOFN		;[2828] NO...DOES JFN'S OFN MATCH THE OFN WE WANT?
        TQNN <OPNF>		;[2828] AND IS THE FILE OPEN?
        RET        		;[2828] NOT OPEN OR NOT OUR OFN AND NOT LONG
       	MOVE A,AOFN		;[2828] GET THE TARGET OFN
	HLRZ B,FILDEV(JFN)	;[2828] GET THE STRUCTURE CODE FOR THE JFN
	LOAD C,STRX,(A)		;[2828] GET THE STRUCTURE CODE FOR THE OFN
	CAME B,C		;[2828] DO THEY MATCH?
	RET			;[2828] NO SO THIS IS NOT THE JFN WE WANT
	TQNN <LONGF>		;[2828] IS THIS JFN LONG?
	RETSKP			;[2828] NOT LONG SO THIS MUST BE OUR OFN
	MOVE C,SPTH(A)		;[2828] GET SPTH ENTRY FOR DISMOUNTED STR CHECK
	TXNE C,OFNDMO		;[2828] CHECK FOR DISMOUNTED STRUCTURE
	RET			;[2828] STRUCTURE DISMOUNTED
	LOAD C,STGADR,SPTH(A)	;[2828] GET DISK ADR OF XB FOR OFN
	MOVSI B,-PGSIZ		;[2828] SETUP AOBJN POINTER FOR THE WHOLE PAGE
	HRR B,FILLFW(JFN)	;[2828] GET THE PAGE TABLE NUMBER
OFNJT1:	LOAD A,STGADR,0(B)	;[2828] GET XB ADR FOR PT
	CAMN A,C		;[2828] SAME AS REQUESTED OFN?
	RETSKP      		;[2828] YES...SO THIS IS OUR JFN
	AOBJN B,OFNJT1		;[2828] NOT OUR JFN SO KEEP LOOKING
        RET        		;[2828] THIS IS NOT OUR JFN
;THIS JFN HAS LONG FILE OPEN.  MUST SCAN PTT TO SEE IF IT CONTAINS
;SAME PT ADDRESS AS REQUESTED OFN

OFNJF3:	MOVE A,AOFN		;GET OFN
	HLRZ B,FILDEV(JFN)	;GET THE STRUCTURE CODE FOR THE JFN
	LOAD C,STRX,(A)		;GET THE STRUCTURE CODE FOR THE OFN
	CAME B,C		;DO THEY MATCH?
	 JRST OFJF22		;NO...SO THIS IS NOT THE JFN WE WANT
	LOAD C,STGADR,SPTH(A)	;GET DISK ADR OF XB FOR OFN
	MOVSI B,-PGSIZ
	HRR B,FILLFW(JFN)
OFNJF4:	LOAD A,STGADR,0(B)	;GET XB ADR FOR PT
	CAMN A,C		;SAME AS REQUESTED OFN?
	JRST OFNJF5
	AOBJN B,OFNJF4
	JRST OFJF22		;NOT USABLE

OFNJF5:	SUB B,FILLFW(JFN)	;GET PT NUMBER
	HRRZS B
	LSH B,9			;CONVERT TO PAGE OFFSET
	ADDM B,ARGI		;AUGMENT THE PAGE #
	JRST OFNJF6

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
;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::SE1CAL
	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:	SE1CAL
;**;[2840]CHANGE 1 LINE AT DSKCLZ+1L	DSC	25-SEP-82
	TRVAR <DMFLG,DSKCFD,DSKPAG> ;[2840]REMEMBER OF STRUCTURE IS DISMOUNTED
	PUSH P,F		;PRESERVE 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
		POP P,F		;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
;**;[2642]ADD 12 LINES AT DSKCL2:+6L	TAM	3-AUG-82
	MOVE T2,.FBCTL(T1)	;[2642]GET BITS
	TQNN <LONGF>		;[2642]LONG FILE ALREADY?
	TXNN T2,FB%LNG		;[2642]HAS IT BECOME LONG?
	JRST DSKCL7		;[2642]NOT LONG OR ALREADY LONG
	MOVE 1,.FBADR(T1)	;[2642]GET FDB ADDR
	CALL NEWLFS		;[2642]MAKE THIS FILE LONG FOR US TOO
	 JRST DSKCL7		;[2642]CAN'T JUST CONTINUE
	HLRZ 1,FILOFN(JFN)	;[2642]GET OFN
	CALL UPSHR		;[2642]UP SHARE COUNT FOR PT0
	STOR A,FILP0,(JFN)	;[2642]REMEMBER PT0
	TQO <LONGF>		;[2642]SAY WE TOO HAVE A LONG FILE
DSKCL7:				;[2642]
	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
	LDB B,PBYTSZ		;GET OPEN BYTE SIZE
	STOR B,FBBSZ,(A)	;SAVE IT IN FDB
	LDB B,PFLMOD		;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
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
;**;[2840] CHANGE 1 LINE AT DSKCL0:+2L	DSC	25-OCT-82
	MOVEM A,DSKPAG	      ;[2840] SAVE PAGE COUNT
	CAMN A,[-1]		;DID IT GET CLOSED?
	SETZ B,			;NO. IGNORE THE FLAGS THEN
	SKIPN A,DSKCFD		;HAVE AN FDB?
;**;[2944]REPLACE 2 LINES WITH 1 AT DSKCL0:+8L	TAM	5-APR-83
	 JRST DSKCL5		;[2944] GO FINISH UP
;**;[3121] MAKE CHANGES AND CLEAN UP AT DSKCL0:+8L	TAM	11-JUN-84
	TXNE B,OFNBAT!OFNERR	;AN ERROR IN THIS FILE?
	JRST [HRRZ T4,FILDDN(JFN) ;[3121][2825] DIRECTORY NUMBER
	      LOAD T2,STR,(JFN)	;[2825] STRUCTURE NUMBER
	      MOVE T2,@STRTAB(T2) ;[3121] GET STR NAME
	      MOVX T3,FB%BAT	;[3121] THE BIT FOR A BAD FILE
	      TDNN T3,.FBCTL(T1) ;[3121] REPORT IF NOT SET
	      BUG (FILBAT,<<T4,DIRNUM>,<T2,STR>>) ;[3121][2817][2829] NOTE PROBLEM
	      IORM T3,.FBCTL(T1) ;[3121] NOTE PROBLEM
	      JRST .+1]		;[2817] CONTINUE
;**;[2840]ADD 2 LINES AT DSKCL0:+15L	DSC	25-OCT-82
;**;[2869]DELETE 2 LINES FROM EDIT 2840, PUT AT DSKCL4	DSC	16-NOV-82
	TQNN <WRTF>		;OPEN FOR NON-WRITE?
	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
;**;[2840]REPLACE 3 LINES WITH 2 LINES AT DSKCL0:+24	DSC	25-OCT-82
;**;[2869]REPLACE 2 LINES WITH 4 LINES AT DSKCL4:	DSC	16-NOV-82

;[2869]UPDATE FILE PAGE COUNT IF NECESSARY

DSKCL4: MOVE D,.FBCTL(A)	;[2869]GET FLAGS FROM THE FDB
	TXNN D,FB%DIR		;[2869]IS THIS A DIRECTORY FILE?
	SKIPGE B,DSKPAG	        ;[2840][2869]POSITIVE PAGE COUNT?
	JRST DSKCL8	        ;[2840][2869]NO, OR THIS IS A DIRECTORY
	PUSH P,C		;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
	POP P,C			;POP 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
;**;[2840]REPLACE 2 LINES WITH 1 LINE AT DSKL4:	DSC	25-OCT-82
;**;[2869]CHANGE 1 LINE AT DSKCL8:	DSC	16-NOV-82
DSKCL8:	MOVX B,FILNB	        ;[2840][2869]
	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
	POP P,F
	RETSKP			;YES, GIVE SUCCESS RETURN
;DELETE EXCESS VERSIONS AFTER CLOSE OR RENAME
; 1/ PTR TO FDB

DSKDV:	SAVEQ
	SE1CAL
	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,FILP0,(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(DNOPT0)
   >				;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
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	TXO A,OFN2XB		;INDICATE INNER XB
	CALL ASFOFN		;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
	SE1CAL
	JN FBDIR,(D),[RETBAD (DLFX11)]	;CAN'T DELETE DIRECTORY FILE
	JN FBARC,(D),[ MOVX B,AR%NDL	;CAN'T IF PROHIBITED
			TDNN B,.FBBBT(D)
			 JRST .+1	;OK, PROCEED
			MOVX A,DELX11
			RET]
	TRVAR <DELFLG,TBLTYP>	;REMEMBER ENTRY
	MOVEM A,DELFLG		;STORE ENTRY FLAG
	PUSH P,P3
	PUSH P,F
	PUSH P,Q3
	PUSH P,D
	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
	MOVE A,(P)		;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.
;**;[3117] REPLACE 8 LINES AT DELFIL+29  (SPR #20122)
 	LOAD B,CURSTR		;[3117] GET STRUCTURE NUMBER FROM PSB
 	CALL CHKOFN		;[3117] IS FILE  BUSY?
  	SKIPA D,0(P)		;[3117] YES, CAN'T EXPUNGE IT. RECOVER FDB ADR
	JRST DELFI2		;[3117] NO,GO TEST MORE
	STOR P3,FBADR,(D)	;[3117] PUT ADR BACK INTO FDB
	MOVEI A,DELFX2		;[3117]
	JRST DELFIX		;[3117] ERROR
DELFI2: MOVE A,P3		;[3117] RESTORE A CLOBBERED BY CHKOFN
	TXNE A,FILNB 		;[3117] WAS IT A NEW FILE ?
	JRST DELFI3  		;[3117] 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
	 JRST [	CALL ASGOFP	;GET SUPER INDEX BLOCK OFN
		 JRST DELFL3	;FAILED
		JRST DELFL4]	;GOT IT - JOIN COMMON CODE
	CALL ASGOFN		;OPEN SO NO OTHER ACCESS
DELFL3:	 JRST [	UNLOCK DIRCLK	;UNLOCK DIRECTORY CACHE
		CAIN A,OPNX16
		JRST DELFI3	;BAD INDEX BLOCK, FORGET IT
		MOVE D,0(P)	;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
DELFL4:	UNLOCK DIRCLK		;UNLOCK DIRECTORY CACHE
	MOVE D,(P)
	PUSH P,A
	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
	POP P,A
	MOVE Q3,.FBCTL(D)
	TXNE Q3,FB%LNG
	JRST DELFI4		;LONG FILE
	CALL DELPT
DELFI3:	MOVE D,(P)
	SETZM .FBADR(D)
	SETZM .FBSIZ(D)
	HRLOI B,7777
	ANDCAM B,.FBBYV(D)
	MOVX B,FB%LNG+FB%SHT
	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 A,ARCX13
		JRST DELFIX]	;COULDN'T DO IT, IPCF MSG FAILED
	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
DELFIX:	POP P,D
	POP P,Q3
	POP P,F
	POP P,P3
	JUMPE A,RSKP		;DO SUCCESSFUL RETURN IF A NON-0
	RET			;OTHERWISE FAIL RETURN
;DELETE LONG FILE

DELFI4:	PUSH P,A
	CALL ASGPAG
	 JRST [	POP P,A
		CALL RELOFN
		MOVEI A,DELFX3	;NO ROOM IN JSB
		JRST DELFIX]
	PUSH P,A
	MOVE B,A
	HRLI B,(PTRW)
	MOVE A,-1(P)
	CALL SETMPG
	HRLI B,-PGSIZ
DELFI6:	LOAD A,STGADR,0(B)	;GET PT ADR
	JUMPE A,DELFI5		;JUMP IF NONE
	PUSH P,B
	CALL GASOG		;GET ARGS FOR ASGOFN
	TXO A,OFN2XB		;SAY IS AN INNER OFN
	CALL ASGOFN
	 JRST DELFI8
	CALL DELPT
DELFI7:	POP P,B
	SETZM (B)
DELFI5:	AOBJN B,DELFI6
	MOVE B,(P)
	MOVEI A,0
	CALL SETMPG
	POP P,A
	CALL RELPAG
	POP P,A
	CALL DELPT		;DELETE THE PTT
	JRST DELFI3

DELFI8:	CAIN A,OPNX16		;BAD INDEX BLOCK?
	JRST DELFI7		;YES, TREAT AS IF DELETED
	BUG(ASOFNF)
;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
	LDB A,PBYTSZ		;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
	SKIPN OFNLEN(D)		;SET UP YET?
	BUG (NOLEN)
	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
	LDB A,PBYTSZ		; 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
	SKIPN OFNLEN(D)		;ONE SETUP YET?
	CALL OFNSET		;NO - SET UP THEN
	LOAD A,OFNBSZ,(D)	;GET OFN BYTE SIZE
	LDB B,PBYTSZ		;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:	SE1CAL
	TRVAR <SRCJFN,SRCOFN,SRCFDB,DSTJFN,DSTOFN,DSTFDB,RENFDA,RENPCT,DSKTYP>
	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
	SKIPE DSKTYP		;SKIP IF SHORT FILE
	JRST [	CALL ASLOFN	;GO ASSIGN SUPER INDEX BLOCK OFN
		 JRST DSKR1	;FAILED
		JRST DSKR2]	;GO IT
	CALL ASFOFN		;OPEN DEST WITH RESTRICTED ACCESS
DSKR1:	 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]
DSKR2:	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
	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
	RETBAD (RNAMX4,<CALL DSKRE8>) ;OVER QUOTA RETURN
DSKREO:	SE1CAL
	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
	TXNE C,FB%LNG		;IS THE FILE LONG?
	JRST [	CALL ASPOFN	;YES - CALL PT TABLE TABLE ASSIGNER
		 JRST DSKRE2	;NOT ACCESSIBLE - CHECK IT OUT
		JRST DSKRE1]	;ACCESS OK - CONTINUE
	CALL ASFOFN		;OPEN SOURCE WITH RESTRICTED ACCESS
DSKRE2:	 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(GTFDB3)
	MOVEM A,DSTFDB		;SAVE DESTINATION FDB LOC
	SKIPL A,SRCOFN		;HAVE SOURCE OFN?
	CALL [	LOAD B,ALOCX,(A) ;YES, GET INDEX INTO QUOTA TABLES
		MOVE C,RENPCT	;GET # OF PAGES IN FILE
		OPSTRM <ADDM C,>,PGLFT,(B) ;CREDIT PAGES TO SOURCE DIR
		CALLRET RELOFN]	;DISCARD SOURCE OFN
	SKIPL A,DSTOFN		;HAVE DESTINATION OFN?
	CALL [	LOAD B,ALOCX,(A) ;YES, GET INDEX INTO QUOTA TABLES
		MOVN C,RENPCT	;GET NEGATIVE # OF PAGES IN FILE
		OPSTRM <ADDM C,>,PGLFT,(B) ;CHARGE PAGES TO DEST DIR
		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
	TXNE C,FB%LNG		;IS THE FILE LONG?
	JRST [	CALL ASPOFN	;YES  - CALL PT TABLE TABLE ASSIGNER
		 JRST DSKRF7	;NOT ACCESSIBLE - CHECK IT OUT
		JRST DSKRF2]	;ACCESS OK - CONTINUE
	CALL ASFOFN
DSKRF7:	 JRST [	MOVE B,A
		SETO A,
		CAIE B,OPNX9	;FILE BUSY?
		 JRST .+1	;NO, CONTINUE
		RETBAD (RNAMX10,<CALL DSKRE8>)]
DSKRF2:	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::
	DTBBAD(GJFX32)		;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

	DTBLEN==:.-SPLDTB	;GLOBAL LENGTH OF DISPATCH TABLE
;ROUTINE TO OPEN THE SPOOLED DISK FILE AND SWAP THE JFNS

SPLOPN:	NOINT
	SE1CAL
	MOVEI A,SC%WHL		;TURN THIS JOB INTO A WHEEL FOR THE OPEN
	PUSH P,CAPENB		;SAVE CURRENT CAPENB
	IORM A,CAPENB		;GIVE OURSELVES WHEEL STATUS
	MOVEI B,^D13		;GET WORDS FOR <SPOOL>DEVN-DIR#-0-
	HLRZ A,FILNEN(JFN)	;GET LENGTH OF NAME STRING
	SKIPE A			;IF ANY NAME WAS GIVEN
	HRRZ A,0(A)		;SIZE OF STRING IS IN RH OF 1ST WORD
	ADD B,A			;UPDATE COUNT OF WORDS NEEDED
	HRRZ A,FILNEN(JFN)	;GET LENGTH OF EXTENSION STRING
	SKIPE A			;IF ANY
	HRRZ A,0(A)
	ADD B,A			;NOW HAVE # OF WORDS TO HOLD GTJFN STRING
	CALL ASGJFR		;GET SOME JOB STORAGE
	 RETBAD (,<POP P,CAPENB>) ;GIVE ERROR BACK TO USER
	PUSH P,A		;SAVE ADDRESS OF STRING
	HRLI A,(<POINT 7,0,35>)
	HRRZ B,FILIDX(JFN)	;GET DIRECTORY TO SPOOL INTO
	MOVE B,DEVCH2(B)	;...
	SKIPE B			;IF ZERO, USE DEFAULT DIRECTORY
	DIRST			;ADD IN NEW SPOOLING DIRECTORY
	 TDZA C,C		;NO SUCH DIRECTORY, USE DEFAULT
	JRST SPLOP1		;DONE
	HRROI B,[ASCIZ/PS:<SPOOL>/]	;USE DEFAULT DIRECTORY
	SOUT			;ADD IT INTO STRING
SPLOP1:	MOVE D,A		;REMEMBER BYTE POINTER
	ADDI D,MAXLW		;GET MAXIMUM SIZE OF NAME FIELD
	HLRZ B,FILDDN(JFN)	;GET DEVICE NAME STRING
	HRLI B,(POINT 7,0,35)	;MAKE IT A STRING POINTER
	SETZ C,
	SOUT			;PUT "DEV" ONTO NAME STRING
	MOVEI B,"-"		;FOLLOWED BY A "-"
	IDPB B,A
	MOVE B,JOBNO		;NOW GET LOGGED IN DIR #
	HRRZ B,JOBDIR(B)
	MOVEI C,10		;AND ADD IT IN OCTAL
	NOUT
	 BUG(NOUTF1)
	HRRZ B,FILIDX(JFN)	;GET INDEX INTO DEVICE TABLES
	LDB B,[POINT 9,DEVCHR(B),17] ;GET DEVICE TYPE
	CAIN B,.DVCDR		;IS THIS A CARD READER?
	JRST SPLCDR		;YES, HANDLE IT DIFFERENTLY
	HRROI B,[ASCIZ/-0-/]	;ADD IN STATION NUMBER
	SETZ C,
	SOUT
	HLRZ B,FILNEN(JFN)	;NOW ADD ON THE NAME
	HRLI B,(POINT 7,0,35)
	TRNE B,-1		;UNLESS THERE WASNT A NAME
	SOUT
	MOVEI B,0(D)		;GET MAX END OF NAME STRING
	CAILE B,0(A)		;IS THE NAME SHORT ENOUGH?
	JRST SPLOP3		;YES
	CAIE B,0(A)		;IS THE BYTE POINTER IN LAST WORD?
	JRST SPLOP2		;NO, THE STRING IS TOO LONG, TRUNCATE
	CAMLE D,A		;IS THE NAME STRING SHORT ENOUGH
SPLOP2:	MOVE A,D		;NO, TRUNCATE THE NAME TO 39 CHARS
SPLOP3:	MOVEI B,"."		;PUT SEPARATOR BETWEEN NAME AND EXT
	IDPB B,A
	HRRZ B,FILNEN(JFN)	;GET POINTER TO EXTENSION STRING
	HRLI B,(POINT 7,0,35)
	TRNE B,-1		;DON'T ADD EXT IF NONE
	SOUT
	MOVEI B,PNCATT		;NOW SET UP THE PROTECTION OF THE FILE
	IDPB B,A		;PUT IN PUNCTUATION
	HRROI B,[ASCIZ/P777700/] ;DON'T ALLOW USERS ANY RIGHTS
	SOUT
	MOVEI B,0		;ADD A NUL BYTE
	IDPB B,A
	;..
	;..
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,0(P)		;GET BACK STRING POINTER
	HRLI B,(POINT 7,0,35)	;TURN IT INTO A STRING POINTER
SPLGTJ:	GTJFN			;OPEN THIS FILE
	 JRST [	CAIN A,GJFX27	;FILE ALREADY EXISTS?
		JRST SPLGTL	;YES, TRY AGAIN
		HRRZ B,FILIDX(JFN)
		LDB B,[POINT 9,DEVCHR(B),17]
		CAIN B,.DVCDR	;IS THIS A CDR?
		JRST [	MOVEI A,JSBFRE	;YES, GO RELEASE SPACE IN JSB
			HRRZ B,JSCDR	;FOR NAME STRING
			CALL RELFRE
			SETZM JSCDR	;YES, NO MORE FILES TO BE READ
			JRST SPLCDR]	;GO OPEN THE NUL: DEVICE
		EXCH A,0(P)	;SAVE ERROR CODE, AND GET BACK STRING
		MOVE B,A	;GET ADDRESS OF STRING
		MOVEI A,JSBFRE
		CALL RELFRE	;GIVE BACK SPACE
		POP P,A		;GET BACK ERROR CODE
		RETBAD (,<POP P,CAPENB>)]
	POP P,B			;GET BACK STRING POINTER
	PUSH P,A		;SAVE JFN
	MOVEI A,JSBFRE
	CALL RELFRE		;RETURN STRING TO FREE POOL
	MOVE A,0(P)		;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
	LDB C,PBYTSZ		;GET THE BYTE SIZE
	DPB C,[POINT 6,B,5]	;KEEP THE SAME BYTE SIZE IN FILE
	LDB C,PFLMOD		;DO THE SAME WITH THE MODE
	DPB C,[POINT 4,B,9]
	OPENF			;OPEN THE SPOOLED FILE
	 JRST [	EXCH A,0(P)	;FAILED, SAVE ERROR CODE AND GET JFN
		RLJFN		;RELEASE THE JFN OF THE DSK FILE
		 JFCL
		POP P,A		;GET BACK ERROR CODE
		RETBAD (,<POP P,CAPENB>)]
	CALL UNLCKF		;UNLOCK THE FILE LOCK
	POP P,A			;GET BACK THE JFN
	POP P,CAPENB		;RESTORE CORRECT CAPABILITIES
	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
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
	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
	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.

ASPOFN::MOVEI T3,2		;HERE TO OPEN THE PAGE TABLE TABE FOR LONG FILES
	JRST ASFOF1		;JOIN COMMON CODE
ASLOFN::HRRZ T3,FILOFN(JFN)	;INDEX BLOCKS ARE GOTTEN WITH PTT ACCESS
	MOVE T3,SPTH(T3)	;GET THE PAGE TABLE TABLE ACCESS BITS
	ANDX T3,FILWB+THAWB	; ISLOATED
	IOR T1,T3		;MERGE. PASS TO PAGEM
	TDZA T3,T3		;REMEMBER THIS ENTRY

ASFOFN::MOVEI T3,1		;REMEMBER THIS ENTRY
ASFOF1:	ACVAR <W1>		;GET A WORK REG
	MOVE W1,T3		;SAVE ENTRY FLAG
	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
	XCT [	CALLRET ASGOFL
		CALLRET ASGOFN
		CALLRET ASGOFP](W1) ;CALL PROPER ROUTINE

	ENDAV.			;END ACVAR


;ASSIGN AN OFN FOR A FILE IN THE ROOT-DIRECTORY

ASROFN::MOVEI T3,ROOTDN		;DIRECTORY NUMBER
	HRLZI T4,377777		;INFINITE ALLOCATION
	CALLRET ASGOFN		;ENTER MAIN ROUTINE
;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,A		;GET JFN
	CALL DSKJFN		;VERIFY JFN
	 RET			;ERROR
	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

	TNXEND
	END