Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393N-SM - monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
; *** Edit 7474 to DISC.MAC by EVANS on 1-May-87
; Make STKVAR at DSKSFT: a two-element entity, instead of two separate elements
; - much better for double-word moves.
; *** Edit 7472 to DISC.MAC by EVANS on 30-Apr-87, for SPR #21600
; Prevent stack trashing by changing STKVAR.
; *** Edit 7451 to DISC.MAC by THOUMIRE on 16-Apr-87, for SPR #21237
; Clear OFN in OFN block after RELOFN when a short file is closed 
; *** Edit 7439 to DISC.MAC by THOUMIRE on 7-Apr-87, for SPR #21463
; Prevent OPNX9 error when a file goes long 
; *** Edit 7364 to DISC.MAC by MCCOLLUM on 12-Sep-86, for SPR #20928
; Fix DELDEL and DELFIL to retry ARCMSG if free space is exhausted. 
; *** Edit 7324 to DISC.MAC by RASPUZZI on 17-Jun-86, for SPR #20058
; Fix the SFTAD% JSYS to work as the documentation says it will. Also, make
; sure that TPRCYC and ARRCYC are properly initialized in STG. 
; *** Edit 7266 to DISC.MAC by MCCOLLUM on 11-Mar-86
; Check for FB%NDL in DELFIL before clearing file's index block address 
; *** Edit 7265 to DISC.MAC by MCCOLLUM on 11-Mar-86, for SPR #47
; In DSKR9L, call DEDSK to remove index block instead of DELFL1 
; *** Edit 7246 to DISC.MAC by MCCOLLUM on 18-Feb-86, for SPR #20334
; Clear FB%BAT when deleting the contents of an archived/migrated file 
; *** Edit 7220 to DISC.MAC by MCCOLLUM on 3-Jan-86, for SPR #14826
; Don't clear file byte size when expunging file contents only 
; *** Edit 7207 to DISC.MAC by WAGNER on 9-Dec-85, for SPR #18886
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs. 
; Edit 7118 to DISC.MAC by PRATT on 8-Aug-85, for SPR #18505 (TCO 6-1-1510)
; Fix problems with special characters in filenames when doing spooled output. 
;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 - PRINT STRUCTURE NAME FOR FILBAT
;Edit 3117 to DISC.MAC by SHTIL on Thu 7-Jun-84, for SPR #20122
;		Don't allow a file opened with OF%RDU be expunged
;Edit 3018 to DISC.MAC by TBOYLE on Thu 22-Sep-83, for SPR #18747
;		Make deletions remove dirs from special cache if necc.
;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 Sat 30-Apr-83, for SPR #17841 - of%rtd needs write access
;EDIT 2955 MAKE OF%RTD REQUIRE WRITE ACCESS
; UPD ID= 235, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.11,   9-Nov-82 11:32:46 by MOSER
;EDIT 2865 - FIX A BUG CAUSING ILMNRF
; UPD ID= 196, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.9,   4-Oct-82 16:58:34 by MOSER
;EDIT 2829 - MORE OF 2825
; UPD ID= 190, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.8,   1-Oct-82 16:27:22 by MOSER
;EDIT 2825 - ADD ADDITIONAL INFO TO FILBAT
; UPD ID= 174, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.7,  27-Sep-82 14:29:34 by MOSER
;EDIT 2817 - NEW BUGINF FILBAT - FILE HAS POSSIBLE BAD PAGE BIT SET
; UPD ID= 122, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.5,   4-Aug-82 11:10:55 by MOSER
;EDIT 2642 - SEE IF A FILE HAS BECOME LONG AT CLOSE.
; UPD ID= 63, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.4,   9-Apr-82 08:12:15 by DONAHUE
;Edit 2607 - Add ENDAV.'s to ACVAR's
; UPD ID= 59, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.3,   5-Apr-82 15:27:31 by MOSER
;EDIT 2008 - Make sure a file hasn't become long before LNGFX1.
; UPD ID= 23, FARK:<4-1-WORKING-SOURCES.MONITOR>DISC.MAC.2,  23-Mar-82 09:10:54 by MOSER
;EDIT 2004 - Make OFNJFN look at structure number for long files.
;<4-1-FIELD-IMAGE.MONITOR>DISC.MAC.2, 25-Feb-82 20:18:33, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 895, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.8,  11-Nov-81 17:04:21 by DONAHUE
;Edit 1961 - return MONX02 error at BP$006: if JSB is full
; UPD ID= 709, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.7,  17-Aug-81 09:26:42 by ZIMA
;Edit 1923 - Fix one reference to .STDFE to force it to LH.
; UPD ID= 687, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.6,   4-Aug-81 11:21:39 by ZIMA
;Edit 1917 - Fix incorrect DELF error code in DSKDEL to be ARGX26.
; UPD ID= 410, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.5,   4-Mar-81 12:00:14 by ZIMA
;Edit 1835 - Fix ILMNRF crashes from bad AC use in DSKSF8, and fix uses of
; TPRCYC when a system value has not been set.
; UPD ID= 301, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.4,  24-Nov-80 11:59:47 by DONAHUE
;Edit 1811 - Remove edit 1805 and allow deleted, invisible files to be
;undeleted by the EXEC
; UPD ID= 283, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.3,  12-Nov-80 10:53:33 by DONAHUE
;Edit 1806 - Put edit 1805 in proper form
; UPD ID= 279, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.2,   6-Nov-80 11:29:47 by DONAHUE
;Edit 1805 - Don't delete superceded file if it is invisible
; UPD ID= 150, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.5,  27-Aug-80 11:08:38 by ZIMA
;Edit 1767 - use correct error code at DSKS12+1 for offline date expired.
; UPD ID= 57, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.4,  10-Jun-80 16:01:24 by ZIMA
;EDIT 1735 - FORCE EDITS 1727, 1728, 1729 INTO STANDARD FORM - NO CODE CHANGE
; UPD ID= 36, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.3,   6-Jun-80 07:42:14 by SANICHARA
; UPD ID= 34, FARK:<4-WORKING-SOURCES.MONITOR>DISC.MAC.2,   6-Jun-80 07:01:49 by SANICHARA
;<4.MONITOR>DISC.MAC.40,  3-Jan-80 08:08:32, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>DISC.MAC.39, 21-Nov-79 10:48:23, EDIT BY SANICHARA
;TCO 4.2576 - Return correct error message after call to CHKOFN
;<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,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG
	TTITLE DISC
	SWAPCD

;SPECIAL AC DEFINITIONS USED HEREIN

;**;[7324] Add 1 line at DSKDTB:-13L 	MDR	17-JUN-86
DEFAC (DIR,Q2)			;[7324] Contains DIRORA
DEFAC (STS,P1)			;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)
;**;[7324] Add 1 line at DSKDTB:-8L	MDR	17-JUN-86
OFS==P3				;[7324] Offset into dir page 0

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

DSKDTB::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
;**;[7324] Modify 1 line at DSKSFT:+1L	MDR	17-JUN-86
;**;[7472] Modify 1 line at DSKSFT:+1L	DEE	30-APR-87
;**;[7474] Modify 1 line at DSKSFT:+1L	DEE	 1-MAY-87
	STKVAR <<FDBSAV,2>>	;[7324][7472][7474] For FDB address and date 
	TQNE <ASTF>
	RETBAD(DESX7)
	MOVNI A,1
	MOVN B,Q1
	HRLZ B,B
	HRR B,Q3
DSKSF0:	XCTU [CAMN A,(B)]
	AOBJN B,DSKSF0
	JUMPGE B,RSKP		;NOOP IF ALL -1
	CALL GETFDB		;GET FDB IN
	 RETBAD(DESX3)
	MOVEM A,FDBSAV
	MOVE B,CAPENB		;GET CAPABILITIES
	TQNN WRTF		;ALWAYS SUCCEED IF OPEN FOR WRITE
	TXNE B,SC%WHL!SC%OPR	; Wheels always win
	JRST DSKSF1		;CAN CHANGE ANYTHING
DSKSF4:	MOVX B,FC%WR		;B/WRITE ACCESS
	CALL ACCCHK		;CHECK FOR WRITE ACCESS TO THIS FILE
	 JRST DSKSF2		;CHECK FOR OWNER
	JRST DSKSF1

DSKSF2:	MOVX B,DC%CN		;B/CONNECT ACCESS
	CALL DIRCHK		;CHECK FOR ABILITY TO CONNECT TO
				; THIS DIRECTORY (AND THUS BECOME LIKE OWNER)
	 RETBAD (CFDBX2,<CALL USTDIR>)
DSKSF1:	MOVE A,FDBSAV
	CAIG Q1,.RSCRV
	JRST DSKSF5
	XCTU [MOVE B,.RSCRV(Q3)]
	CAME B,[-1]
	MOVEM B,.FBCRV(A)	;CREATION DATE AND TIME
DSKSF5:	CAIG Q1,.RSWRT
	JRST DSKSF6
	XCTU [MOVE B,.RSWRT(Q3)]
	CAME B,[-1]
	MOVEM B,.FBWRT(A)	;WRITE DATE AND TIME
DSKSF6:	CAIG Q1,.RSREF
	JRST DSKSF7
	XCTU [MOVE B,.RSREF(Q3)]
	CAME B,[-1]
	MOVEM B,.FBREF(A)	;READ DATE AND TIME
DSKSF7:	CAIG Q1,.RSCRE
	JRST DSKSF8
	XCTU [MOVE B,.RSCRE(Q3)]
	CAMN B,[-1]
	JRST DSKSF8		; Doesn't wish to change it
	MOVX C,SC%WHL!SC%OPR
	TDNE C,CAPENB		; Caller allowed?
;**;[7324] Replace 1 line with 5 lines at DSKSF7:+7L	MDR	17-JUN-86
	IFNSK.			;[7324]
	  MOVEM T2,.FBCRE(T1)	;[7324] Yes, store internal write D & T
	ELSE.			;[7324]
	  RETBAD (CAPX1,<CALL USTDIR>) ;[7324] Caller can't change say so
	ENDIF.			;[7324]
DSKSF8:	LOAD B,FBLEN,(A)	; See if other words exsist
	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
;**;[1835] Change two lines at DSKSF8: +8L	JGZ	4-MAR-81
	MOVX T3,SC%OPR!SC%WHL	;[1835] PRIVILEGES TO CHECK
	TDNE T3,CAPENB		;[1835]  Wheels win
;**;[7324] Replace 1 line with 5 lines at DSKSF8:+10L	MDR	17-JUN-86
	IFNSK.			;[7324]
	  MOVEM B,.FBTDT(A)	;[7324] Wheels can change this
	ELSE.			;[7324]
	  RETBAD (CAPX1,<CALL USTDIR>) ;[7324] Not enough privs
	ENDIF.			;[7324]
DSKSF9:	CAIG Q1,.RSNET
	JRST DSKS10
	XCTU [MOVE B,.RSNET(Q3)]
;**;[7324] Replace 1 line with 15 lines at DSKSF9:+3L	MDR	17-JUN-86
	CAMN T2,[-1]		;[7324] Want to change this word?
	JRST DSKS10		;[7324] Not changing this word
	TLNE T2,-1		;[7324] Interval or date and time?
	JRST DSKS9A		;[7324] Date and time, must check for legality
	MOVE DIR,DIRORA		;[7324] Get directory page 0
	LOAD OFS,DRDNE,(DIR)	;[7324] Directory's online expiration
	SKIPE OFS		;[7324] Did directory have a default?
	IFNSK.			;[7324] Yes, test it
	  CAMG T2,OFS		;[7324] Less than dir default?
	  JRST DSKS9B		;[7324] Yes, change it.
	ENDIF.			;[7324] No, check against system default
	MOVX OFS,.STDNE		;[7324] Get the system default for online exp.
	CAMLE T2,OFS		;[7324] Is this OK?
	JRST DSK12		;[7324] No, fail.
	JRST DSKS9B		;[7324] Yes, change it.

;**;[7324] Replace 1 line with 17 lines at DSKS9A:+0L	MDR	17-JUN-86
DSKS9A:	DMOVEM T1,FDBSAV	;[7324] LGTAD will clobber T1 & T2
	CALL LGTAD		;[7324] Get now
	MOVE DIR,DIRORA		;[7324] Directory is here
	LOAD T3,DRDNE,(DIR)	;[7324] Put dir default here
	MOVSS T3,		;[7324] Get days in the LH
	ADD T3,T1		;[7324] Maximum TAD allowed by dir default
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAML T3,T2		;[7324] OK if max geq than user's request
	JRST DSKS9B		;[7324] OK, store supplied D & T
	DMOVEM T1,FDBSAV	;[7324] Isn't legal, check against sys max
	CALL LGTAD		;[7324] Get now
	MOVSI T3,.STDNE		;[7324] get days from system in LH
	ADD T3,T1		;[7324] Maximum TAD allowed by system default
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAMGE T3,T2		;[7324] OK if max geq than user's request
	JRST DSK12		;[7324] Isn't then don't do it
DSKS9B:	MOVEM T2,.FBNET(T1)	;[7324] Change it.
DSKS10:	CAIG Q1,.RSFET
	JRST DSKS11
	XCTU [MOVE B,.RSFET(Q3)]
	CAMN B,[-1]
	JRST DSKS11		; No change desired
	TLNE B,-1		; Interval or date & time?
	JRST DSK10A		; Date and time, check that
;**;[7324] Add 7 lines at DSKS10:+7L	MDR	17-JUN-86
	MOVE DIR,DIRORA		;[7324] Location of dir page 0
	LOAD OFS,DRDFE,(DIR)	;[7324] Directory offline expiration
	SKIPE OFS		;[7324] Is it set?
	IFNSK.			;[7324] Yes, test it
	  CAMG T2,OFS		;[7324] Less than dir default?
	  JRST DSK10B		;[7324] Yes, update it
	ENDIF.			;[7324] No, check against system default
;**;[1835] Change and add two lines at DSK10B: -2L	JGZ	4-MAR-81
	SKIPN T3,TPRCYC		;[1835] RECYCLE/EXPIRATION PERIOD SET?
	MOVX T3,.STDFE		;[1835]  NO, USE DEFAULT VALUE
	CAMLE T2,T3		;[1835] Within system limit?
	JRST DSKS12		; No, don't do it
DSK10B:	MOVEM B,.FBFET(A)	; Set it
DSKS11:	CALL UPDDIR
	CALL USTDIR
	RETSKP

;**;[7324] Add 10 lines at DSK10A:+0L	MDR	17-JUN-86
DSK10A:	DMOVEM T1,FDBSAV	;[7324] LGTAD will clobber T1 & T2
	CALL LGTAD		;[7324] Get the time
	MOVE DIR,DIRORA		;[7324] Dir page 0 is here
	LOAD T3,DRDFE,(DIR)	;[7324] Get expiration default for dir
	MOVSS T3,		;[7324] Put days in LH
	ADD T3,T1		;[7324] Max allowed by dir default
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAML T3,T2		;[7324] Are we legal?
	JRST DSK10B		;[7324] Yes, set it
	DMOVEM T1,FDBSAV	;[7324] No, check system default then
	CALL LGTAD		; Get now
	HRLZ C,TPRCYC		; # of days allowed
;**;[1835] Add two lines at DSK10A: +4L	JGZ	4-MAR-81
	SKIPN T3		;[1835] BUT IF EXPIRATION/RECYCLE NOT SET
;**;[1923] Change one 1835 line at DSK10A: +4L	JGZ	17-AUG-81
	MOVSI T3,.STDFE		;[1835][1923]  THEN USE DEFAULT (TO LEFT HALF)
	ADD C,A			; Maximum tad allowed
;**;[7324] Replace 2 lines with 1 at DSK12:-5L	MDR	17-JUN-86
	DMOVE T1,FDBSAV		;[7324] Restore FDB and what user wanted
	CAMGE C,B		; Ok if max geq than user's request
	JRST DSKS12		; Isn't so don't do it
	JRST DSK10B		; Ok, store supplied d & t

;**;[7324] Add 2 lines at DSK12:+0L	MDR	17-JUN-86
DSK12:	CALL USTDIR		;[7324] Unlock but do not update
	RETBAD(ARGX32)		;[7324] and return appropriate error

DSKS12:	CALL USTDIR		; Unlock, no update of directory
;**;[1767] Change one line at DSKS12: +1L	JGZ	28-AUG-80
	RETBAD(ARGX27)		;[1767] And fail
DSKDEL:	SE1CAL
	CALL GETFDB
	RETSKP
	UMOVE C,1		;GET USER FLAGS
	TXNE C,DF%DIR		;DELETING A DIRECTORY?
	JRST DSKDLD		;YES - SPECIAL
	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, DONT
		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
;**;[1917] Change one line at DSKDL1: -5L	JGZ	4-AUG-81
		JN FBOFF,(D),[ERRJMP (ARGX26,DSKDL1)] ;[1917] 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, DONT 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, GICVE 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 FO 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]	;CONTIUNE
	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, DONT SET TIME
	STOR B,FBWRT,(A)	;SET DATE OF LAST USER WRITE
OPENF0:	SKIPE B,.FBADR(A)	; Get disc address
	JRST [	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
		 JRST [	MOVEI A,OPNX9 ;NO, FILE BUSY
			CALLRET USTDIR]
		MOVE A,OPNFDB	;FILE NOT OPEN, MUST BE LEFT FROM CRASH
		SETZM .FBADR(A)	;FORGET IT
		JRST .+1]	;ASSIGN NEW ADDRESS
	MOVX B,FB%LNG		;MAKE SURE NO LEFT OVER LONGNESS
	ANDCAM B,.FBCTL(A)
	MOVEI A,0		; No disc address, must get one
	LOAD B,STR,(JFN)	;GET STRUCTURE NUMBER FROM JFN BLOCK
	CALL DSKASN		; Assign a disc address
	 JRST [	MOVEI A,OPNX10
		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]
	TQNE <WRTF>
	TLO A,(FILWB)
OPENA2:	TXNN A,FILNB		;A NEW FILE?
	TXNN F1,OF%DUD		;NO. DON'T WANT DUD ACTION?
	JRST OPENA1		;YES. 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
	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]
	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
	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
	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 - DONT 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
;**;[2008] DELETE 3 LINES AT NEWLFP:+6L	TAM	23-MAR-82
REPEAT 0,<
	SKIPE NLFLG		;[2008] ALLOWED TO CREATE PAGE TABLES?
	TQNN <WRTF>		;[2008] FILE OPEN FOR WRITE?
	RETBAD LNGFX1		;[2008] NO, WRONG
>
	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
;**;[2008] ADD 4 LINES AT NEWLFP:+14L	TAM	23-MAR-82
	SKIPE NLFLG		;[2008] ALLOWED TO CREATE PAGE TABLES?
	TQNN <WRTF>		;[2008] FILE OPEN FOR WRITE?
	JRST [	CALL USTDIR	;[2008] NO, UNLOCK DIRECTORY
		RETBAD LNGFX1]	;[2008] AND RETURN ERROR TO USER
	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	TAB	8-17-83
	TLO A,(FILNB)		; Mark as new --before saving it!! -TAB
	MOVEM A,NLFT2		;SAVE IT
	CALL NEWLFS		; Assign ofn etc
;**;[1961] Add 1 line at NEWLP1:+7L	PED	11-NOV-81
	 JRST [	PUSH P,A	;[1961] SAVE ERROR
		MOVE A,NLFT2	;GET DISK ADDRESS
		LOAD B,STR,(JFN) ;GET STRUCTURE NUMBER FROM JFN BLOCK
		CALL DEDSK	; RELEASE IT
		CALL USTDIR
;**;[1961] Add 1 line at NEWLP1:+13.L	PED	11-NOV-81
		POP P,A		;[1961] 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)	;REMEBER OFN OF PT0
	MOVE C,NLFT2		;GET DISK ADDRESS
	MOVE A,NLFT1		;GET FDB ADR
;**;[7439] Add 1 line at NEWLP1+23	MAT	7-APR-87
	TXZ C,FILNB		;[7439] Clear FILNB, not needed here
	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
;**;[1961] Add 1 line at BP$006:+7 L	PED	11-NOV-81
		MOVEI A,MONX02	;[1961] 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 OF 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
	PUSH P,JFN		;SAVE PRESERVED AC'S
	PUSH P,STS
	CALL OFNJF0		;DO THE ACTUAL WORK
	 SOS -2(P)		;HANDLE FAIL RETURN
	POP P,STS
	POP P,JFN		;RESTORE PRESERVED AC'S
	RETSKP			;DO SKIP RETURN UNLESS SOS ABOVE

OFNJF0:	PUSH P,A
	HLRZS A
	ANDI A,377777
	MOVE B,A		;GET OFN IN B
	CALL CHKDMO		;SEE IF THIS OFN HAS BEEN DISMOUNTED
	 JRST [	POP P,0(P)	;CLEAN UP STACK
		RETBAD (PMAPX7)] ;DISMOUNTED
	PUSH P,A
OFNJF7:	NOINT
	LOCK(JFNLCK,<JRST [
		OKINT
		MOVEI A,^D500
		DISMS
		JRST .-2]>)
	MOVE JFN,MAXJFN
	SOS JFN
	IMULI JFN,MLJFN		; CONVERT TO INTERNAL VALUE
OFNJF1:	MOVEI A,0(JFN)		;GET JFN
	CALL STRDMO		;CHECK IF DISMOUNTED AND BUMP SDB LOCK
	 JRST OFNJF2		;IT IS DISMOUNTED
	MOVE STS,FILSTS(JFN)
	HRRZ A,FILDEV(JFN)
	CAIE A,DSKDTB
	JRST OFJF22		;NOT USABLE
	MOVE A,FILLFW(JFN)
	TLNN A,777776		;IF PAGE MAP CNT .G. 0, CHECK OPNF
	SKIPL -1(P)		;OTHERWISE, CHECK OPNF ONLY IF B0=0
	TQNN <OPNF>
	JRST OFJF22		;NOT USABLE
	TQNE <LONGF>
	JRST OFNJF3
	HLRZ A,FILOFN(JFN)
	CAME A,(P)
	JRST OFJF22		;NOT USABLE
OFNJF6:	PUSH P,B		;SAVE B
	MOVE A,JFN		; MOVE JFN
	CALL LUNLK0		;DECR SDB LOCK
	IDIVI A,MLJFN		;CONVERT TO EXTERNAL INDEX
	POP P,B			;RESTORE B
	SKIPN NSKED		;IS THIS PROCESS NOSKED?
	SKIPGE FILLCK(JFN)	;NO. IS JFN LOCK FREE?
	SKIPA			;OK TO DO IT
	JRST [	UNLOCK JFNLCK	;FREE UP JFN LOCK
		LOCK FILLCK(JFN) ;WAIT FOR JFN LOCK TO BE AVAIALBLE
		UNLOCK FILLCK(JFN) ;FREE IT
		OKINT		;ALLOW INTS JUST IN CASE
		JRST OFNJF7]	;AND TRY AGAIN
	MOVE JFN,A		;BACK TO JFN
	POP P,A			;CLEAN UP THE STACK
	POP P,A
	HRL A,JFN
	UNLOCK JFNLCK
	OKINT
	RETSKP
;THIS JFN HAS LONG FILE OPEN.  MUST SCAN PTT TO SEE IF IT CONTAINS
;SAME PT ADDRESS AS REQUESTED OFN

OFNJF3:	MOVE A,(P)		; Get ofn
	PUSH P,B
	PUSH P,C
;**;[2004] ADD 4 LINES AT OFNJF3:+3L	TAM	18-MAR-82
	LOAD B,STRX,(A)		;[2004] GET STRUCTURE NUMBER OF OFN
	LOAD C,STR,(JFN)	;[2004] AND STRUCTURE NUMBER OF JFN
	CAME B,C		;[2004] ON SAME STRUCTURE
	JRST OFNJ41		;[2004] NO, CAN'T BE RIGHT JFN
	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
;**;[2004] ADD LABEL AT OFNJF4:+4L	TAM	18-MAR-81
OFNJ41:	POP P,C			;[2004]
	POP P,B
	JRST OFJF22		;NOT USABLE

OFNJF5:	POP P,C
	SUB B,FILLFW(JFN)	; Get pt number
	HRRZS B
	LSH B,9			; Convert to page offset
	ADDM B,-2(P)		; Augment page number
	POP P,B
	JRST OFNJF6

OFJF22:	MOVEI A,0(JFN)		;GET THE JFN
	CALL LUNLK0		;FREE SDB LOCK
OFNJF2:	SUBI JFN,MLJFN		; To next jfn index
	JUMPGE JFN,OFNJF1
	POP P,A
	POP P,A
	UNLOCK JFNLCK
	OKINT
	RET
;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
	TRVAR <DMFLG,DSKCFD>	;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]
	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
	CALL RELOFN
;**;[7451] Add 1 line at DSKCL6+5	MAP	14-Apr-87
	SETZM FILOFN(JFN)	;[7451] Clear OFN in JFN block
	; ..
;DSKCLZ...

DSKCL0:	SKIPE DMFLG		;A DISMOUNTED STRUCTURE?
	JRST DSKCL1		;YES. ALL DONE THEN
	PUSH P,A		; Save page count
	CAMN A,[-1]		; DID IT GET CLOSED?
	SETZ B,			; NO. IGNORE THE FLAGS THEN
	SKIPN A,DSKCFD		;HAVE AN FDB?
	JRST [	SUB P,BHC+1	;NO. CLEAN UP STACK
		JRST DSKCL5]	;AND 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
	TQNN <WRTF>		;OPEN FOR WRITE?
	JRST DSKCL4		;NO
	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
DSKCL4:	POP P,B			;RECOVER PAGE COUNT
	SKIPL B
	JRST [	PUSH P,B
		PUSH P,C
		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 P,B
		STOR B,FBNPG,(A) ;SET PAGE COUNT FOR FILE
		JRST .+1]
	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
	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?
;**;[1811] Change 1 line at DSKCD3+3L	PED	24-NOV-80
;**;[1806] Change 1 line at DSKCD3:+3L	PED	12-NOV-80
;**;[1805] Change 1 line at DSKCD3:+3L	PED	6-NOV-80
	TXNE C,FB%TMP+FB%NXF+FB%DEL+FB%ARC ;[1805][1811] 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
	PUSH P,B		;SAVE AACUMULATED 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
	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 OCCURED 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
;**;[7364] CHANGE 1 LINE AT DELFIL: + 16L	JDM	12-SEP-86
	MOVE A,.FBCTL(D)	;[7364]GET FILE BITS
;**;[7266]Move 3 lines from DELFIL: + 26L to +24L	JDM	11-MAR-86
	TXNE A,FB%NDL		;[7266]IS THIS FILE MARKED "NEVER DELETE"?
	 JRST [	MOVEI A,DELX13	;[7266]YES - RETURN AN ERROR
		JRST DELFIX]
;**;[7266]Move 1 line from DELFIL: + 20L to +24L	JDM	11-MAR-86
	SETZM TBLTYP		;[7266]SET TO SHORT FILE INDICATION
	TXNE A,FB%LNG		;[7266]IS THE FILE LONG?
	SETOM TBLTYP		;[7266]YES - INDICATE
;**;[7364]ADD 11 LINES AT DELFIL: + 26 L	JDM	12-SEP-86
	SKIPE DELFLG		;[7364]GONNA CLOBBER FDB?
	TXNN A,FB%ARC		;[7364]ARCHIVED FILE?
	 JRST DELF31		;[7364]NO, SKIP IPCF
	MOVE A,[.FLXP,,.NOTM]	;[7364]NOTIFICATION: FILE EXPUNGED
	MOVE B,D		;[7364]FDB OFFSET
	CALL ARCMSG		;[7364]
	 JRST	[MOVEI T1,ARCX13 ;[7364]
		 JRST DELFIX]	;[7364]COULDN'T DO IT, IPCF MESSAGE FAILED
;**;[7207] INSERT 1 LINE AT DELF31:-2.L	DSW	12/06/85
	MOVE D,(P)		;[7364][7207] RESTORE FDB ADDRESS
	MOVE A,.FBCTL(D)	;[7364]RECOVER CTL BITS
;**;[7266]Move 2 lines from DELFIL: + 16L to 26L	JDM	11-MAR-86
;**;[7364] ADD A LABEL AT DELFIL: + 38 L		JDM	12-SEP-86
DELF31:	OPSTR <SKIPN P3,>,FBADR,(D) ;[7364][7266]GET INDEX BLOCK ADR
	JRST DELFI3		;[7266]WASN'T ONE
;**;[7266]Move 2 lines from DELFIL: + 18L to + 26L	JDM	11-MAR-86
	SETZRO FBADR,(D)	;[7266]REMOVE XB ADR FROM DIR
	CALL UPDDIR		;[7266]UPDATE DIRECTORY, FILE IS EFFECTIVELY
	MOVE A,P3		; GONE AFTER THIS POINT.
;**;[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)		;[3117]
	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)
;**;[7220] CHANGE 1 LINE AT DELFI3:+3L		JDM	12/24/85
	HRLOI B,77		;[7220]CLEAR DATA MODE AND PAGE COUNT
	ANDCAM B,.FBBYV(D)
;**;[7246] CHANGE 1 LINE AT DELFI3:+6L		JDM	2/18/86
	MOVX B,FB%LNG+FB%SHT+FB%BAT ;[7246]CLEAR THESE BITS IN .FBCTL
	ANDCAB B,.FBCTL(D)
;**;[7364] REMOVE 11 LINES FROM DELF31: + 9 L	JDM	12-SEP-86
;**;[7364] DELETE A LABEL FROM DELF31: + 9 L	JDM	12-SEP-86
	SKIPN DELFLG		;[7364] Clobber FDB?
	 JRST DELF32		; No
	SETZRO <FBARC,FBOFF>,(D)
	LOAD A,FBLEN,(D)	; Get the length
	CAIGE A,.FBLXT		; If we have archive stuff, do it
	JRST DELF33		; Is an old FDB
	SETZRO FBBBT,(D)	; Clobber any offline storage info
	SETZRO FBTDT,(D)
	SETZM .FBTP1(D)
	SETZM .FBSS1(D)
	SETZM .FBTP2(D)
	SETZM .FBSS2(D)
DELF33:	TXNN B,FB%PRM		;PERMANENT?
	JRST [	MOVE A,D	;GET FDB ADDRESS
		CALL DELFDB	;GO DELETE THIS FDB
		 SKIPA		;FAILED
		JRST .+1	; Ok, go on
		JRST DELFIX]	;GO DO RETURN
DELF32:	SETZ A,			;SAY SKIP RETURN
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		;DONT 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
; Mutlitple 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
;**;[1735] Change and delete [1727] lines at DSKREN:+3L	JGZ	10-JUN-80
;**;[1727] Delete 6 lines at DSKREN: +3L	ARS	6-JUN-80
	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]  ; Postive no. is error code
	JUMPL A,[MOVE D,DSTFDB	;-1 mandates discard
		LOAD B,FBLEN,(D) ; Get length of FDB
		CAIGE B,.FBLXT	; Includes tape info words?
		JRST .+1	; 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
		JRST .+1]
	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
	SKIPE A,.FBADR(A)	;DEST HAS XB ADR?
	JRST [	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
		JRST .+1]	;NONX, FLUSH IT
	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
	 RETBAD (RNAMX4,<CALL USTDIR>) ;NO SPACE ON DISK
	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
;**;[1735] Change 2 lines for [1728] at DSKR2: +9L	JGZ	10-JUN-80
;**;[1728] Change 1 line at DSKR2: +9L	ARS	6-JUN-80
	 RETBAD (RNAMX7,<CALL DSKRE7>) ;[1728]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		;DONT 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, DONT LEAVE IT PERMANENT
	;..
; NOW READY TO PLANT THE OLD FDB INTO THE NEW

	;..
DSKRE9:	MOVE A,DSTFDB		;POINT TO NEW FDB
	LOAD D,FBLEN,(A)	; Get length of dest FDB
	MOVE B,RENFDA		; GET PTR TO OLD SOURCE (IN JSB)
	AOS B			; POINT TO ACTUAL FDB COPY
	LOAD B,FBLEN,(B)	; GET ITS LENGTH
	CAIGE B,(D)		; IS SOURCE SHORTER?
	MOVE D,B		; YES, USE MIN OF THE TWO
	MOVNS D			; Make an AOBJN ptr
	HRLZS D
	LOAD B,FBNPG,(A)	;GET PAGES JUST FLUSHED
	MOVNS B
	MOVE C,DIRORA		;GET BASE ADR OF MAPPED DIR AREA
	OPSTRM <ADDM B,>,DRDCA,(C) ;REDUCE DIRECTORY PAGE COUNT
	HRRZ B,RENFDA		;ADDRESS OF SOURCE FDB
	AOS B			;...
	HRLI B,D+(IFIW)
DSKR9L:	MOVE C,@B		; GET SOURCE
	XOR C,0(A)		; BIT DIFFERENCE
	ANDCM C,RENMSK(D)	; BITS TO RETAIN FROM DESTINATION
	XORM C,0(A)
	AOS A			; STEP TO NEXT WORD IN FDB
	AOBJN D,DSKR9L		; DO ALL WORDS IN FDB
	MOVE D,DSTFDB		; GET BACK ADDRESS OF FDB
	LOAD B,FBFLG,(D)
	TXNE B,FB%OFF		; Was it offline to start with?
;**;[7265] Change 2 lines to 7 line at DSKR9L: + 9L	JDM	11-MAR-86
	IFNSK.			;[7265]YES
	 MOVE A,.FBADR(D)	;[7265]GET THE INDEX BLOCK ADDRESS
	 SETZM .FBADR(D)	;[7265]AND CLEAR IT
	 LOAD B,STR,(JFN)	;[7265]GET THE STRUCTURE NUMBER
	 CALL DEDSK		;[7265](A,B)RELEASE THE PAGE
	 NOP			;[7265]
	ENDIF.
	MOVE A,DSTFDB		; GET BACK ADDRESS OF 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

DSKREF:	MOVE A,SRCFDB		; FDB
	LOAD A,FBFLG,(A)
	TXNN A,FB%OFF		; Offline?
	RETBAD (RNAMX9,<CALL DSKRE8>) ; No, bomb
	MOVEI A,0		; Kludge 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
;**;[1735] Change 3 lines of [1728] at DSKRE8: +1L	JGZ	10-JUN-80
;**;[1728] Change 1 line at DSKRE8: +1L	ARS	6-Jun-80
DSKRE7:	SKIPL A,DSTOFN		;[1728]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
	0			; .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
;
; 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
	SE1CAL
	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
	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
	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(NOUTF1)		;[7118]
	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.

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

;**;[2607] Add 1 line at ASROFN:-3L	PED	9-APR-82
	ENDAV.			;[2607] 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

	TNXEND
	END