Trailing-Edge
-
PDP-10 Archives
-
BB-Y393Q-SM
-
monitor-sources/disc.mac
There are 53 other files named disc.mac in the archive. Click here to see a list.
; Edit= 8870 to DISC.MAC on 29-Jul-88 by LOMARTIRE, for SPR #21930
;Prevent OPNX9 when file goes long and PT0 access is incorrect
; *** 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
;[8870] Note: The write bit (FILWB) must be passed to RELOFN when PT0 is
;[8870] released to prevent OPNX9 errors from occurring. These can occur if
;[8870] the file once was short and was opened for read. Then, an append
;[8870] occurs which makes the file go long and causes FILWB to be set in the
;[8870] PTT and PT0. When the append is over, and the OFN is being closed,
;[8870] the PTT will be closed but the PT0 will not since there is still an
;[8870] opener; the one which opened the file for read when it was short. If
;[8870] FILWB is not passed in to RELOFN, then PT0 will still reflect that it
;[8870] is open for write. So, if another opener tries to open this file,
;[8870] which is now long, CHKLAC will believe that there is already a writer
;[8870] of PT0 and an OPNX9 will result.
CNTLNG: LOAD A,FILP0,(JFN) ;GET OFN OF PT0
TQNE <WRTF> ;[8870] File open for write?
TXO A,FILWB ;[8870] Yes, propagate bit
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