Trailing-Edge
-
PDP-10 Archives
-
BB-M081R-SM
-
monitor-sources/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
; Edit= 8946 to DIRECT.MAC on 25-Aug-88 by GSCOTT
;Update BUG. documentation, change repeat 0ed DIRDNL to DIRDNX.
; Edit= 8884 to DIRECT.MAC on 12-Aug-88 by RASPUZZI
;Update BUG. documentation.
; Edit= 8823 to DIRECT.MAC on 8-Apr-88 by RASPUZZI, for SPR #21883
;Prevent OFNBDB BUGHLTs when the INDEX-TABLE.BIN is damaged. Have GETIDX be
;defensive about what it finds.
; UPD ID= 8503, RIP:<7.MONITOR>DIRECT.MAC.7, 9-Feb-88 14:52:51 by GSCOTT
;TCO 7.1218 - Update copyright notice.
; UPD ID= 8456, RIP:<7.MONITOR>DIRECT.MAC.6, 5-Feb-88 09:20:16 by GSCOTT
;More of TCOP 7.1210 - Fix spelling in DIREXT.
; UPD ID= 8408, RIP:<7.MONITOR>DIRECT.MAC.5, 4-Feb-88 10:48:30 by GSCOTT
;TCO 7.1210 - Set CCBROT, CGROFN, DIRACT, DIRB2L, DIRB2S, DIRBAD, DIRBAF,
; DIRBCB, DIRBLK, DIREXT, DIRFDB, DIRFRE, DIRIFB, DIRNAM, DIRPG0, DIRPG1,
; DIRRHB, DIRSY1, DIRSY2, DIRSY3, DIRSY4, DIRSY5, DIRSY6, DIRULK, DIRUNS, and
; LNGDIR to be not normally dumpable.
; UPD ID= 8399, RIP:<7.MONITOR>DIRECT.MAC.4, 2-Feb-88 14:52:33 by RASPUZZI
;TCO 7.1204 - Prevent ILMNRFs when STRFND is called to recognize a directory
; UPD ID= 28, RIP:<7.MONITOR>DIRECT.MAC.3, 29-Jun-87 16:37:34 by RASPUZZI
;TCO 7.1014 - Implement partial file recognition.
; *** Edit 7398 to DIRECT.MAC by LOMARTIRE on 20-Nov-86, for SPR #21362
; Prevent SHROFD and TCSOFN BUGHLTs
; *** Edit 7364 to DIRECT.MAC by MCCOLLUM on 12-Sep-86, for SPR #20928
; Fix DELDEL and DELFIL to retry ARCMSG if free space is exhausted.
; *** Edit 7360 to DIRECT.MAC by RASPUZZI on 3-Sep-86
; Remove edit 7335 because it does not work with structures that have large
; directories disabled
; *** Edit 7335 to DIRECT.MAC by RASPUZZI on 15-Jul-86, for SPR #20399
; Don't allow a directory to grow so big as to allow a byte pointer to access
; an FDB to exceed 400000 as this may cause problems.
; *** Edit 7218 to DIRECT.MAC by WAGNER on 31-Dec-85, for SPR #20996
; Clear PPN entry from INDEX TABLE when killing directories to allow subsequent
; directories to use that same PPN.
; UPD ID= 2064, SNARK:<6.1.MONITOR>DIRECT.MAC.49, 3-Jun-85 14:29:45 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1942, SNARK:<6.1.MONITOR>DIRECT.MAC.48, 9-May-85 17:02:12 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1938, SNARK:<6.1.MONITOR>DIRECT.MAC.47, 8-May-85 09:38:37 by LOMARTIRE
;TCO 6.1.1295 - Install TCO 6.2005 which fixes directory recognition
; UPD ID= 1893, SNARK:<6.1.MONITOR>DIRECT.MAC.46, 4-May-85 15:39:25 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1872, SNARK:<6.1.MONITOR>DIRECT.MAC.45, 4-May-85 11:21:31 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1817, SNARK:<6.1.MONITOR>DIRECT.MAC.44, 24-Apr-85 16:14:57 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1725, SNARK:<6.1.MONITOR>DIRECT.MAC.43, 8-Apr-85 12:39:38 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 4929, SNARK:<6.MONITOR>DIRECT.MAC.42, 15-Oct-84 12:59:47 by GRANT
;The assembly switch CFSCOD has been eliminated
; UPD ID= 4804, SNARK:<6.MONITOR>DIRECT.MAC.41, 17-Sep-84 09:54:20 by PURRETTA
;Update copyright notice
; UPD ID= 4784, SNARK:<6.MONITOR>DIRECT.MAC.40, 31-Aug-84 13:01:16 by LOMARTIRE
;Remove TCO 6.2178 since the problem is not solved fully and has side effects
; UPD ID= 4781, SNARK:<6.MONITOR>DIRECT.MAC.39, 30-Aug-84 15:53:47 by LOMARTIRE
;Still more TCO 6.2178 - Handle deleted files better at EXTSCN
;Also, handle the case of old files (GJ%OLD or OLDNF) only.
; UPD ID= 4759, SNARK:<6.MONITOR>DIRECT.MAC.38, 27-Aug-84 12:40:22 by LOMARTIRE
;More TCO 6.2178 - Do NOT smash ACs at VERLK1
; UPD ID= 4749, SNARK:<6.MONITOR>DIRECT.MAC.37, 24-Aug-84 13:54:34 by LOMARTIRE
;TCO 6.2178 - Do not allow directory access to files without FC%DIR set
; UPD ID= 4669, SNARK:<6.MONITOR>DIRECT.MAC.36, 8-Aug-84 15:30:17 by LOMARTIRE
;TCO 6.2124 - Check access when setting deleted file non-existant in VERLKH
; UPD ID= 4305, SNARK:<6.MONITOR>DIRECT.MAC.35, 7-Jun-84 16:33:44 by MOSER
;TCO 6.2086 - MAKE UNMIDX GLOBAL
; UPD ID= 4060, SNARK:<6.MONITOR>DIRECT.MAC.34, 11-Apr-84 14:45:57 by GRANT
;In UPDIDX, don't call UPDPGS with OFN 0
; UPD ID= 3795, SNARK:<6.MONITOR>DIRECT.MAC.33, 29-Feb-84 01:41:30 by TGRADY
; Implement Global Job Numbers
; - In DELTS1, check temp file generation number against global job number,
; instead of local index (JOBNO)
; UPD ID= 2983, SNARK:<6.MONITOR>DIRECT.MAC.32, 4-Oct-83 15:59:20 by TBOYLE
;TCO 6.1803 Add REMSDR to remove special dirs on dir removals.
; UPD ID= 2704, SNARK:<6.MONITOR>DIRECT.MAC.31, 18-Jul-83 16:14:46 by JCAMPBELL
;TCO 6.1729 - Make sure FB%FOR in .FBCTL (FORTRAN data file) not propogated.
; UPD ID= 2694, SNARK:<6.MONITOR>DIRECT.MAC.30, 12-Jul-83 16:28:24 by PRATT
;TCO 6.1710 - Check for stepping versions in VRLKH1 if FB%NXF is set.
; UPD ID= 2689, SNARK:<6.MONITOR>DIRECT.MAC.29, 11-Jul-83 13:51:02 by TSANG
;TCO 6.1717 - Insert subroutine ADRCHK in MDDDC1 to check the address of next
; extension.
; UPD ID= 2594, SNARK:<6.MONITOR>DIRECT.MAC.28, 20-Jun-83 10:33:14 by HALL
;TCO 6.1689 - Move fork tables to extended section
; Reference FKSTAT via DEFSTR
; UPD ID= 2549, SNARK:<6.MONITOR>DIRECT.MAC.27, 31-May-83 23:57:28 by PAETZOLD
;Delete very old edit history and update copyright
; UPD ID= 2539, SNARK:<6.MONITOR>DIRECT.MAC.26, 31-May-83 13:58:24 by MILLER
;Fix UPDIDX to detect non-ex IDX table
; UPD ID= 2173, SNARK:<6.MONITOR>DIRECT.MAC.25, 6-Apr-83 07:13:37 by FLEMMING
; UPD ID= 2121, SNARK:<6.MONITOR>DIRECT.MAC.24, 29-Mar-83 20:07:16 by MILLER
;TCO 6.1579. Have RBLDST call ADJALC when fixing allocations
; UPD ID= 1792, SNARK:<6.MONITOR>DIRECT.MAC.23, 12-Feb-83 18:50:31 by MILLER
;TCO 6.1094. Free directroy allocation resource in INVIDX
; UPD ID= 1638, SNARK:<6.MONITOR>DIRECT.MAC.22, 11-Jan-83 14:55:23 by MOSER
;MORE TCO 6.1408
; UPD ID= 1610, SNARK:<6.MONITOR>DIRECT.MAC.20, 3-Jan-83 14:54:38 by MILLER
;TCO 6.1434. Set FILUB in calls to RELOFN
; UPD ID= 1520, SNARK:<6.MONITOR>DIRECT.MAC.19, 8-Dec-82 17:15:31 by MOSER
;TCO 6.1408 - BUGINF CCBROT IN CHKBAK
; UPD ID= 1519, SNARK:<6.MONITOR>DIRECT.MAC.18, 8-Dec-82 17:08:42 by MOSER
;TCO 6.1381 - MOVE CGROFN TO THIS MODULE
; UPD ID= 1416, SNARK:<6.MONITOR>DIRECT.MAC.17, 5-Nov-82 09:52:27 by MILLER
;TCO 6.1094. Set OFNDU0 in call to ASROFN
; UPD ID= 1260, SNARK:<6.MONITOR>DIRECT.MAC.16, 30-Sep-82 15:26:34 by MCINTEE
;TCO 6.1230 - Teach DR0CHK about remote alias blocks
; Add comments to SETDIR and GDIRST about unlocking.
; UPD ID= 1217, SNARK:<6.MONITOR>DIRECT.MAC.15, 23-Sep-82 09:18:33 by MCINTEE
;previous edit's TCO number is really 6.1258
; UPD ID= 1166, SNARK:<6.MONITOR>DIRECT.MAC.14, 13-Sep-82 12:51:05 by MOSER
;TCO 6.1256 - PREVENT REINITIALIZATION OF FDBs IN USE
; UPD ID= 1140, SNARK:<6.MONITOR>DIRECT.MAC.13, 3-Sep-82 16:08:47 by MOSER
;TCO 6.1239 - DON'T PROPAGATE FB%TMP TO NEW GENERATIONS.
; UPD ID= 883, SNARK:<6.MONITOR>DIRECT.MAC.12, 9-Jun-82 15:56:54 by MCINTEE
;TCO 6.1030 - change a MDDOK to DSKOK
; UPD ID= 837, SNARK:<6.MONITOR>DIRECT.MAC.11, 4-Jun-82 22:01:29 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 646, SNARK:<6.MONITOR>DIRECT.MAC.10, 14-Apr-82 17:19:50 by MILLER
;TCO 6.1094. Add code for CFS directory locking
; UPD ID= 385, SNARK:<6.MONITOR>DIRECT.MAC.9, 5-Feb-82 16:01:18 by HALL
;TCO 6.1000 - Support the 2080. Remove extended addressing checks
; SETDIR - Don't check EXADDR before testing DRMAP
; MAPDIR and CHKBAK - always map into non-zero section
; MAPIDX and UNMIDX - always map index table into non-zero section
; UNMAPD - Always unmap from non-zero section
; UPD ID= 354, SNARK:<6.MONITOR>DIRECT.MAC.8, 27-Jan-82 13:30:36 by MCINTEE
;More TCO 6.1051
; UPD ID= 265, SNARK:<6.MONITOR>DIRECT.MAC.7, 21-Dec-81 10:11:12 by MCINTEE
; UPD ID= 255, SNARK:<6.MONITOR>DIRECT.MAC.6, 15-Dec-81 15:02:34 by MCINTEE
;TCO 6.1051 - Put ambiguity back in recognition of extension field
; UPD ID= 166, SNARK:<6.MONITOR>DIRECT.MAC.5, 24-Oct-81 19:21:23 by PAETZOLD
;More TCO 5.1581
; UPD ID= 132, SNARK:<6.MONITOR>DIRECT.MAC.4, 19-Oct-81 15:11:53 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 122, SNARK:<6.MONITOR>DIRECT.MAC.3, 18-Oct-81 15:49:17 by PAETZOLD
;TCO 5.1581 - Fix problem where OFN's do not get deassigned
;<6.MONITOR>DIRECT.MAC.2, 16-Oct-81 17:50:26, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
; UPD ID= 133, SNARK:<5.MONITOR>DIRECT.MAC.7, 1-Sep-81 10:07:42 by GROUT
;TCO 5.1479 - Fix possible section changes between MDDDIR and SETDIR/SETDRR
; UPD ID= 55, SNARK:<5.MONITOR>DIRECT.MAC.6, 21-Jul-81 11:40:42 by GROUT
;TCO 5.1425 - Make MDDDIR not check privs if called from .RCUSR
; UPD ID= 2003, SNARK:<5.MONITOR>DIRECT.MAC.5, 14-May-81 23:17:56 by ZIMA
;TCO 5.1327 - fix GJ%FOU and exact generation case for invisible files.
; UPD ID= 1931, SNARK:<5.MONITOR>DIRECT.MAC.4, 4-May-81 10:41:31 by SCHMITT
;TCO 5.1304 - Correct pointer construction at DIRUNQ
; UPD ID= 1426, SNARK:<5.MONITOR>DIRECT.MAC.3, 8-Jan-81 17:02:51 by HALL
;TCO 5.1229 - ADD SOME CALLS TO FDBCHK IN NAMSCN AND EXTSCN
; UPD ID= 695, SNARK:<5.MONITOR>DIRECT.MAC.2, 25-Jun-80 15:13:24 by DBELL
;TCO 5.1078 - TYPE OFFSET INTO DIRECTORIES FOR LOTS OF BUGCHKS
; UPD ID= 332, SNARK:<4.1.MONITOR>DIRECT.MAC.30, 14-Mar-80 10:59:31 by KONEN
; UPD ID= 328, SNARK:<4.1.MONITOR>DIRECT.MAC.29, 13-Mar-80 13:35:03 by KONEN
; UPD ID= 323, SNARK:<4.1.MONITOR>DIRECT.MAC.28, 12-Mar-80 12:25:32 by KONEN
;Add descriptors to optional data for BUGs
; UPD ID= 13, SNARK:<4.1.MONITOR>DIRECT.MAC.27, 26-Nov-79 13:46:43 by KONEN
;TCO 4.1.1028 -- Don't propagate FB%BAT through different versions of FDB's
;<OSMAN.MON>DIRECT.MAC.1, 10-Sep-79 15:25:27, EDIT BY OSMAN
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG
TTITLE DIRECT
SWAPCD
;SPECIAL AC DEFINITIONS
DEFAC (STS,P1)
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)
INTERN NSDIR0
;THIS IS A LIST OF FREQUENTLY USED DIRECTORIES WHICH HAVE THEIR
;DIRECTORY NUMBERS SETUP IN AN IN-CORE TABLE. THIS SAVES
;THE PROBE OF THE INDEX AND SUBINDEX WHEN THESE DIRECTORIES ARE
;BEING LOOKED UP.
DEFINE SDIR (NAM)<
XWD 0,[ASCIZ /NAM/]>
SDIRT0:: SDIR (SUBSYS) ;TABLE SEARCHED LINEARLY, SO ORDER
SDIR (SYSTEM) ; IS IN DECREASING FREQUENCY OF USE
SDIR (SPOOL)
SDIR (ACCOUNTS)
NSDIR0==.-SDIRT0
RS SDIRTB,NSDIR0 ;TABLE WITH DIRNUMS FILLED IN
RS NSDIRT,1 ;NUMBER OF ENTRIES IN RUNTIME TABLE
RESCD
LIT
SWAPCD
; Check protection of file/directory
; Call: A ; LOCATION OF THE FDB (FOR ACCCHK)
; LH(B) ; BITS TO INDICATE ACCESS DESIRED
;THESE BITS ARE DEFINED IN MONSYM AND ARE OF THE FORM DC%XXX AND FC%XXX.
; CALL DIRCHK ; To check access to a directory
; Or
; CALL ACCCHK ; To check access to a file
; Return
; +1 ; Error, access not allowed
; +2 ; Ok
;THIS ROUTINE CHECKS WHETHER THE USER CAN ACCESS A FILE (IF ACCCHK IS
;CALLED) OR DIRECTORY (DIRCHK) AS REQUESTED. THE BITS IN AC 2 INDICATE
;THE ACCESS DESIRED. THEY ARE CHECKED AGAINST THE APPROPRIATE FIELD
;IN THE FILE (OR DIRECTORY) PROTECTION, AS FOLLOWS:
; OWNER IF USER IS ACCESSING LOGGED-IN DIRECTORY ON PS,
; ACCESSED DIRECTORY ELSEWHERE, OR CONNECTED DIRECTORY
; GROUP IF USER BELONGS TO A USER GROUP MATCHING THE
; DIRECTORY'S GROUP NUMBER
; WORLD OTHERWISE
;NOTE: NO ACCESS IS ALLOWED TO DIRECTORY FILES UNLESS THE USER IS
; AN ENABLED WHEEL OR OPERATOR. IN THOSE CASES, ONLY READ AND LIST
; ARE ALLOWED.
;THIS IS CALLED AFTER A CALL TO SETDIR FOR THE DIRECTORY TO BE CHECKED.
;THUS THE DIRECTORY AND STRUCTURE ARE LOCKED
DIRCHK::EA.ENT
MOVE C,DIRORA ;GET THE PROTECTION OF THE MAPPED DIR
LOAD C,DRPRT,(C) ;...
JRST ACCCH1 ;ENTER COMMON CODE
ACCCHK::EA.ENT
JE FBDIR,(A),ACCCH0 ;IS THIS A DIRECTORY FILE?
MOVX D,SC%WHL!SC%OPR ;YES - CHECK SPECIAL CAPABILITIES
MOVE C,B ;GET A COPY OF DESIRED ACCESS
AND C,[FC%MSK] ;ONLY LOOK AT THE ACCESS BITS
TXZ C,FC%DIR ;ALWAYS ALLOW DIR LISTING
TDNE D,CAPENB ;WHEEL OR OPERATOR?
TXZ C,FC%RD ;YES, ALLOW READ
JUMPE C,ACCCH0 ;IF NOT ASKING FOR OTHER ACCESS, OK
RETBAD(OPNX13) ;INVALID ACCESS
ACCCH0: LOAD C,FBPRT,(A) ;Get protection of this file
ACCCH1: SAVEQ ;GET SOME WORKING ACS
STKVAR<ACCCHB,ACCBTS>
MOVE D,CAPENB ;CHECK ENABLED CAPABILITIES
TRNE D,SC%WHL!SC%OPR
RETSKP ;WHEEL OR OPERATOR HAVE ALL PRIVILEGES
MOVEM B,ACCCHB ;SAVE ACCESS REQUEST
MOVE Q1,DIRORA ;GET BASE OF DIRECTORY
LOAD Q2,DRNUM,(Q1) ;GET DIR NUMBER OF MAPPED DIR
;INITIALLY ASSUME OWNER+GROUP+WORLD ACCESS RIGHTS
MOVE D,C ;MAKE OWNER SUPERSET OF GROUP AND WORLD
LSH D,6 ;AND GROUP SUPERSET OF WORLD
IORM D,C ;OR GROUP INTO OWNER AND WORLD INTO GROUP
LSH D,6 ;AND OR WORLD FIELD INTO OWNER FIELD
IORM D,C
MOVEM C,ACCBTS ;PRESERVE C OVER SUBROUTINES
;IF TRYING TO ACCESS LOGGED IN DIRECTORY ON PUBLIC STRUCTURE, HAVE OWNERSHIP RIGHTS
MOVE D,JOBNO ;GET THIS JOB'S NUMBER
HRRZ D,JOBDIR(D) ;GET LOGGED IN DIR OF THIS USER
CAME D,Q2 ;REFERENCE TO LOGGED IN DIR?
IFSKP.
JE CURSTR,,ACCCH9 ;IF ON PUBLIC STRUCTURE, THIS IS THE
; LOGGED IN DIRECTORY
ENDIF.
;IF TRYING TO ACCESS 'ACCESSED' DIRECTORY, HAVE OWNER RIGHTS
LOAD A,CURUC ;A/STRUCTURE UNIQUE CODE FOR MAPPED DIRECTORY
SETZ Q3, ;INITIALIZE OFFSET
CALL FNDSTO ;GET OFFSET IN JSB FOR THIS STRUCTURE
JRST ACCCH3 ;NO. GO SEE IF CONNECTED TO THIS DIRECTORY
MOVE C,ACCBTS ;GET THE ACCESS BIT AGAIN
HRRZM B,Q3 ;SAVE OFFSET IN JSB
LOAD B,JSADN,(Q3) ;GET ACCESSED DIRECTORY NUMBER ON THIS STRUCTURE
CAMN B,Q2 ;IS IT THE DIRECTORY BEING ACCESSED?
JRST ACCCH9 ;YES. HAVE OWNER RIGHTS
;IF TRYING TO ACCESS CONNECTED DIRECTORY, HAVE OWNERSHIP ACCESS
ACCCH3: CALL GTCSCD ;GET CONNECTED STR CODE,,DIRECTORY FOR THIS JOB
MOVE C,ACCBTS ;RESTORE ACCESS BITS
HLRZ D,A ;GET CONNECTED STRUCTURE UNIQUE CODE
HRRZS A ;GET CONNECTED DIRECTORY
CAME A,Q2 ;REFERENCE TO CONNECTED DIRECTORY?
IFSKP.
LOAD A,CURUC ;YES. GET STRUCTURE FOR MAPPED DIRECTORY
CAMN D,A ;IS IT THE CONNECTED STRUCTURE?
JRST ACCCH9 ;YES. GIVE OWNER ACCESS
ENDIF.
;DON'T HAVE OWNERSHIP. SEE IF GROUP OR WORLD
LOAD A,CURUC ;A/STRUCTURE CODE FOR MAPPED DIRECTORY
JUMPE Q3,ACCCH4 ;IF NO GROUPS, SKIP CALL TO CHKGRP
HRRZS Q3
TMNE JSGRP,(Q3) ;IF NO GROUPS, DON'T CALL CHKGRP
CALL CHKGRP ;SEE IF DIR AND USER ARE IN SAME GROUP
ACCCH4: LSH C,6 ;NO, HAVE WORLD ACCESS
LSH C,6 ;YES. HAVE GROUP ACCESS
;BITS 18-23 OF C CONTAIN THE MAXIMUM ACCESS TO BE APPLIED TO THIS
;DIRECTORY. B CONTAINS THE ACCESS DESIRED. SEE IF THEY AGREE
ACCCH9: ANDCAI C,770000 ;Mask off 6 bits and complement
LSH C,^D18-1 ;SHIFT TO LINE UP BITS BETWEEN B AND C
HLLZ B,ACCCHB ;GET BACK ACCESS REQUESTED
AND B,C ;Get bad bits
JFFO B,ACCCH2 ;If any ones, access not permitted
RETSKP
;ACCESS NOT ALLOWED
ACCCH2: SOS C ;Get bit number
ROT C,-1 ;Divide by 2
HRRZ A,ACCERT(C) ;Get error number
SKIPL C
HLRZ A,ACCERT(C)
RET
ACCERT: XWD OPNX3,OPNX4
XWD OPNX5,OPNX6
XWD OPNX12,OPNX13
;ROUTINE TO CHECK USER GROUPS FOR A MATCH WITH DIR GROUPS
;ASSUMES DIR IS MAPPED
;ACCEPTS:
; T1/STRUCTURE UNIQUE CODE
; CALL CHKGRP
;RETURNS +1: NO MATCH
; +2: GROUPS MATCH
;DESTROYS NO ACS
CHKGRP: SAVET
SAVEQ
CALL FNDSTO ;GET ADDRESS OF BLOCK IN JSB FOR THIS STRUCTURE
RETBAD
OPSTR <SKIPN Q1,>,JSGRP,(B) ;ARE THERE ANY USER GROUPS?
RETBAD ;NO
CHKGR1: HLRZ A,0(Q1) ;GET FIRST GROUP NUMBER IN LIST
CALL CHKDGP ;CHECK IT AGAINST DIR GROUP LIST
SKIPA ;NO MATCH
RETSKP ;MATCHED!
HRRZ A,0(Q1) ;GET NEXT GROUP NUMBER
CALL CHKDGP ;CHECK IT
SKIPA ;NO MATCH
RETSKP
AOBJN Q1,CHKGR1 ;LOOP BACK UNTIL LIST EXHAUSTED
RETBAD ;NO MATCH WAS FOUND
;ROUTINE TO CHECK A GROUP NUMBER AGAINST LIST IN DIR
;ACCEPTS IN A/ GROUP NUMBER
; CALL CHKDGP OR CALL CHKUGP
;RETURNS +1: NO MATCH
; +2: MATCH
CHKDGP::EA.ENT
JUMPE A,R ;0 IS NOT MACTHED
MOVE D,DIRORA ;GET BASE OF DIR
LOAD D,DRDGP,(D) ;GET POINTER TO DIR GROUP LIST
JRST CHKUG0 ;ENTER COMMON CODE
CHKUGP::EA.ENT
JUMPE A,R ;0 IS NOT MATCHED
MOVE D,DIRORA ;GET BASE OF DIR
LOAD D,DRUGP,(D) ;GET POINTER TO USER GROUP LIST
CHKUG0: JUMPE D,R ;0 MEANS NOT A MEMBER OF A GROUP
ADD D,DIRORA ;GET ABS ADR OF LIST
LOAD C,BLKTYP,(D) ;GET TYPE OF BLOCK
CAIE C,.TYGDB ;IS THIS A DIR GROUP BLOCK?
RET ;NO, DIR SCREWED UP
LOAD C,BLKLEN,(D) ;GET NUMBER OF WORDS IN LIST
SOS C ;SKIP OVER HEADER
CHKDG1: HLRZ B,1(D) ;GET FIRST ELEMENT IN LIST
CAMN A,B ;DO THEY MATCH?
RETSKP ;YES
HRRZ B,1(D) ;GET NEXT ELEMENT IN LIST
CAMN A,B ;MATCH?
RETSKP ;YES
AOS D ;STEP TO NEXT WORD IN LIST
SOJG C,CHKDG1 ;LOOP THROUGH LIST
RET ;NO MATCH FOUND
;SUPCHK - CHECK ACCESS TO SUPERIOR
;ACCEPTS:
; T1/ (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
; T2/ BITS INDICATING ACCESS REQUIRED
;CALL SUPCHK
;RETURNS +1: ACCESS NOT ALLOWED OR OTHER FAILURE
; T1/ ERROR CODE
; +2: ACCESS ALLOWED
;THIS ROUTINE CHECKS TO SEE IF THE CALLER CAN ACCESS THE
;SUPERIOR OF THE GIVEN DIRECTORY IN THE REQUESTED MANNER. IT IS
;ANALOGOUS TO DIRCHK, AND IN FACT CALLS DIRCHK ON THE DIRECTORY'S
;SUPERIOR
SUPCHK::
STKVAR <SUPCDN,SUPCBT,SUPCSN,SUPCSP>
MOVEM T1,SUPCDN ;SAVE DIRECTORY NUMBER
MOVEM T2,SUPCBT ;SAVE BITS
HLRZS T1 ;T1/ STRUCTURE UNIQUE CODE
CALL CNVSTR ;CONVERT TO STRUCTURE NUMBER
RETBAD ;FAILURE
MOVEM T1,SUPCSN ;SAVE STRUCTURE NUMBER
CALL MAPIDX ;MAP INDEX TABLE FOR THIS STRUCTURE
JRST SUPCH2 ;FAILED. GO UNLOCK STRUCTURE AND RETURN
HRRZ T1,SUPCDN ;T1/ DIRECTORY NUMBER
CALL GETIDX ;GET DATA ON THIS DIRECTORY
JRST SUPCH2
HLL T3,SUPCDN ;FORM 36-BIT NUMBER OF SUPERIOR
MOVEM T3,SUPCSP ;SAVE SUPERIOR NUMBER
MOVE T1,SUPCSN ;GET STRUCTURE NUMBER
CALL ULKSTR ;UNLOCK THE STRUCTURE
MOVE T1,SUPCSP ;T1/ DIRECTORY OF SUPERIOR
CALL SETDIR ;MAP IN THE SUPERIOR
RETBAD
MOVE T2,SUPCBT ;T2/ DESIRED PRIVILEGE
CALL DIRCHK ;SEE IF WE CAN DO IT
JRST SUPCH1 ;NO.
CALL USTDIR ;UNLOCK THE SUPERIOR
RETSKP ;RETURN SUCCESS
;HERE ON FAILURE WHEN DIRECTORY IS MAPPED. UNMAP IT AND FAIL
SUPCH1: CALL USTDIR ;UNLOCK THE SUPERIOR
RETBAD ;RETURN FAILURE
;HERE ON FAILURE WHEN STRUCTURE IS LOCKED. UNLOCK AND FAIL
SUPCH2: EXCH T1,SUPCSN ;SAVE ERROR CODE, GET STRUCTURE NUMBER
CALL ULKSTR ;UNLOCK STRUCTURE AND GO OKINT
MOVE T1,SUPCSN ;T1/ ERROR CODE
RETBAD () ;RETURN FAILURE
; Directory lookup
; Call: A ; -<NWORDS-1>,,FIRSTWORD OF STRING-1
; B ; STRUCTURE UNIQUE CODE
; C ; LOCATION OF LAST BYTE IF RECOGNITION
; CALL DIRLUK ; For recognition
; Or
; CALL DIRLKX ; For no recognition
; Returns
; +1 A/ 0 NO MATCH
; -1 AMBIGUOUS
; +2 OK, WITH: A/ DIRECTORY NUMBER
; B/ UPDATED POINTER
; Clobbers a,b,c,d, and bits mtchf, ambgf, norec1
DIRLUK::TQZA <NREC1> ;ALLOW RECOGNITION
DIRLKX::TQO <NREC1> ;DONT ALLOW RECOGNITION
EA.ENT
STKVAR <DIRLKS,DIRLKP,DIRLKI,DIRLKC,DIRLKT,<DIRLKB,MAXLW>> ;ALLOCATE LOCAL STORAGE
JUMPE B,RETZ ;IF NO UNIQUE CODE, RETURN FAILURE
AOS A ;BUILD BYTE POINTER TO INPUT
HRLI A,(<POINT 7,.-.>) ; ...
MOVEM A,DIRLKI ;SAVE INPUT POINTER
MOVEM B,DIRLKS ;SAVE STRUCTURE NUMBER
MOVEM C,DIRLKP ;SAVE LOCATION OF LAST BYTE
SETZM DIRLKT ;ZERO TOTAL LENGTH OF INPUT STRING
TQZ <UNLKF> ;UNLOCK THE DIRECTORY ON EXIT
TQNN <NREC,NREC1> ;RECOGNITION WANTED?
JRST DRLK0B ;YES
MOVE A,DIRLKS ;GET STRUCTURE UNIQUE CODE
CALL CNVSTR ;CONVERT UNIQUE CODE TO STRUCTURE NUMBER
JRST RETZ ;NOT MOUNTED.
MOVEM A,DIRLKC ;SAVE STRUCTURE NUMBER
MOVE C,STRTAB(A) ;GET ADDRESS OF STRUCTURE DATA BLOCK
JN STCRD,(C),[ CALL ULKSTR ;UNLOCK AND OKINT
MOVEI A,ROOTDN ;IF CREATING ROOT-DIR, USE THAT #
MOVE B,DIRLKP ;RETURN POINTER
RETSKP] ;RETURN
LOAD A,CURUC ;CHECK IF FOR DIR FROM CURRENT STR
CAME A,DIRLKS ;SAME?
JRST DRLK0A ;NO - UNLOCK STR AND CONTINUE
MOVE A,DIRORA ;CHECK WHAT MAY BE A DIR MAPPED
CALL MRMAP ;GET IDENT
JRST DRLK0A ;NOT A FILE PAGE
CALL MRPACS ;DOES THE PAGE EXIST?
TLNN A,(PA%PEX) ; ???
JRST DRLK0A ;NO - MUST DO FULL LOOKUP
MOVE A,DIRORA ;GET DIR BASE ADDR
LOAD A,DRNAM,(A) ;GET DIR NAME STRING
JUMPE A,DRLK0A ;PROTECT AGAINST BAD DIR
HRLI A,(<POINT 7,.-.(Q1),35>) ;BUILD BYTE POINTER
MOVE B,DIRLKI ;GET INPUT STRING
PUSH P,Q1 ;SAVE INDEX AC
MOVE Q1,DIRORA ;GET DIR BASE
CALL STRCMP ;COMPARE THE STRINGS
JRST [ POP P,Q1 ;RESTORE INDEX AC
JRST DRLK0A] ;NOT EQUAL
POP P,Q1 ;RESTORE INDEX AC
MOVE A,DIRORA ;GET DIRECTORY ORIGIN
LOAD B,DRNUM,(A) ;GET DIR NUMBER
MOVE A,DIRLKC ;GET STR NUMBER
CALL ULKSTR ;UNLOCK STR
MOVE A,B ;COPY DIR NUMBER
MOVE B,DIRLKP ;RETURN POINTER
RETSKP ;RETURN SUCCESS
DRLK0A: MOVE A,DIRLKC ;GET STR NUMBER
CALL ULKSTR ;UNLOCK STR AND OKINT
MOVE A,DIRLKC ;GET STR NUM AGAIN
CAIE A,PSNUM ;IS THIS THE PUBLIC STRUCTURE?
JRST DRLK0B ;NO - DO LOOKUP
MOVE A,DIRLKI ;GET INPUT POINTER
CALL DIRSLK ;GO TRY TO FIND IT IN SPECIAL TABLE
JRST DRLK0B ;WAS NOT IN TABLE
MOVE B,DIRLKP ;FOUND - RETURN POINTER AND
RETSKP ;DIR
DRLK0B: TQZ <MTCHF,AMBGF>
MOVEI A,ROOTDN ;GET DIR # OF ROOT DIRECTORY
DIRLK1: HRL A,DIRLKS ;GET STRUCTURE NUMBER
CALL SETDIR ;Map IN ROOT DIRECTORY
JRST RFALSE ;INDICATE NO MATCH
MOVEI A,DIRLKB ;CLEAR TEMP STRING BLOCK
HRL A,A ; BUILD BLT POINTER
AOS A ; ...
SETZM DIRLKB ; CLEAR FIRST WORD
BLT A,<MAXLW-1>+DIRLKB ; UNTIL END OF BLOCK
SETZM DIRLKC ;CLEAR COUNT OF CHARS IN TEMP STRING
MOVSI A,(<POINT 7,.-.>) ;BUILD BYTE POINTER TO TEMP STRING BLOCK
HRRI A,DIRLKB ; ...
DIRLK2: ILDB B,DIRLKI ;GET NEXT INPUT CHARACTER
JUMPE B,DIRLK4 ;END OF INPUT
CAIN B,"." ;SEPARATOR CHARACTER?
JRST DIRLK3 ;YES - LOOKUP THIS LEVEL
IDPB B,A ;NO - STORE IN TEMP STRING
AOS DIRLKC ;COUNT THIS CHAR
JRST DIRLK2 ;LOOP FOR THIS LEVEL
;HERE TO LOOKUP AN INTERMEDIATE LEVEL DIR FROM INPUT STRING. NO
;RECOGNITION IS DONE, SEARCH FAILURE MEANS DIRLUK FAILURE.
DIRLK3: MOVEI A,1 ;GET COUNT FOR THIS SEGMENT OF INPUT STRING
ADD A,DIRLKC ; ...
ADDM A,DIRLKT ;UPDATE TOTAL LENGTH
MOVEI A,DIRLKB ;GET POINTER TO TEMP STRING BLOCK
MOVE B,DIRLKC ;GET CHAR COUNT
CALL DSLUK ;FIND DIR FDB
JRST DIRLER ;FAILED - RETURN NO MATCH
CALL USTDIR ;FOUND THIS LEVEL, DIR NUM IN A
JRST DIRLK1 ;UNLOCK AND SEARCH AT NEXT LEVEL
;HERE TO LOOKUP LOWEST LEVEL IN INPUT STRING. RECOGNITION WILL BE
;DONE IF REQUESTED
DIRLK4: MOVE A,DIRLKC ;GET LENGTH OF THIS INPUT SEGMENT
ADDM A,DIRLKT ;PRODUCE GRAND TOTAL INPUT LENGTH
MOVEI A,DIRLKB ;SETUP TO FIND DIR FDB FOR THIS STRING
MOVE B,DIRLKC ;COUNT OF CHARS IN STRING
CALL DSLUK ;FIND DIRECTORY FDB
JRST DIRFND ;FAILED - SEE IF AMBIGUOUS
CALL USTDIR ;SUCCESS - UNLOCK DIR
MOVE B,DIRLKP ;RETURN DIRNUM IN A, END POINTER IN B
RETSKP
;LOCAL ROUTINE TO LOOKUP A STRING AND RETURN A FDB THAT IS
;A DIRECTORY
;A/ WORD ADDRESS OF START OF STRING
;B/ NUMBER OF CHARACTERS IN STRING
; CALL DSLUK ;DIRECTORY STRING LOOKUP
;RETURNS+1:
; FAILURE - LOOKUP FAILED, NO DIR FDB OR FDBCHK FAILED
;RETURNS+2:
; SUCCESS - DIR NUM IN A, FDB ADDRESS(ABSOLUTE) IN B
DSLUK: IDIVI B,5 ;GET NUMBER OF WORDS IN STRING
MOVEI C,.ETNAM ;DIRS ARE ENTRY TYPE NAME
CALL LOOKP1 ;Search SYMTAB
RET ;FAILED
CALLRET DRLKFD ;FIND DIR FDB IF PRESENT
;LOCAL ROUTINE TO SCAN EXTENSION AND GENERATION CHAINS LOOKING FOR
;A DIR FDB.
;ASSUMES DRLOC SETUP
; CALL DRLKFD
;RETURNS+1:
; FAILURE - NO GOOD FDB FOUND
;RETURNS+2:
; SUCCESS - DIR NUM IN A, ABSOLUTE FDB ADDRESS IN B
DRLKFD: MOVE C,DRLOC ;GET SYMTAB POINTER
LOAD C,SYMAD,(C) ;GET START OF FDB CHAINS
ADD C,DIRORA ;AS AN ABSOLUTE ADDRESS
DRLKF1: MOVE A,C ;COPY POINTER FOR GENERATION SEARCH
DRLKF2: CALL FDBCHK ;BLESS THIS FDB
RET ;FAILED
JE FBDIR,(A),DRLKF3 ;IS THIS A DIRECTORY?
LOAD B,FBDRN,(A) ;YES - GET ITS NUMBER
JUMPE B,DRLKF3 ;IF ZERO, IGNORE IT
EXCH A,B ;PUT DIRNUM AND FDB IN PROMISE PLACES
RETSKP ;SUCCESS
DRLKF3: LOAD A,FBGNL,(A) ;GET FDB OF NEXT GENERATION
ADD A,DIRORA ;AS AN ABSOLUTE ADDRESS
CAME A,DIRORA ;WAS IT ZERO?
JRST DRLKF2 ;NO - EXAMINE THIS FDB
LOAD C,FBEXL,(C) ;YES - GET NEXT EXTENSION
ADD C,DIRORA ;AS ABSOLUTE ADDRESS
CAME C,DIRORA ;WAS THERE ONE?
JRST DRLKF1 ;YES - EXAMINE THIS EXTENSIONS GENERATIONS
RET ;NO - FAILURE
;HERE WHEN A LOOKUP FAILS, PERFORM RECOGNITION IF NEEDED.
DIRFND: TQNE <MTCHF>
TQNE <NREC,NREC1> ;Since we do not have an exact match
JRST DIRLER ;TAKE ERROR RETURN WHEN NO RECGNITION
TQNE <AMBGF>
JRST DIRAMB ;Ambiguous
MOVE B,DRLOC ;GET POINTER TO SYMBOL
ADDI B,.SYMLN ;Ok so far, make sure not ambiguous
MOVE A,DIRORA ;GET BASE ADDRESS OF MAPPED DIR
LOAD A,DRSTP,(A) ;GET POINTER TO TOP OF SYMBOL TABLE
ADD A,DIRORA ;MAKE ADDRESS ABSOLUTE
CAML B,A ;examinE the next entry IN TABLE
JRST DIRUNQ ;ABOVE END OF SYMBOL TABLE
LOAD A,SYMVL,(B) ;GET SYMBOL TABLE VALUE
CAMN A,[-1] ;SEE IF SYMBOL TABLE SCREWED UP
JRST DIRLER ;YES - GIVE ERROR RETURN
LOAD A,SYMET,(B) ;GET THE SYMBOL TYPE
CAIE A,.ETNAM ;STILL IN THE NAME REGION?
JRST DIRUNQ ;NO
CALL NAMCMM ;SEE IF NEXT SYMBOL IS STILL SUBSET
JUMPN A,DIRUNQ ;NOT EQUAL AND NOT SUBSET
JRST DIRAMB ;SUBSET is ambiguous
DIRUNQ: CALL DRLKFD ;FIND DIR FDB FROM SYMTAM POINTER
JRST DIRLER ;FDB IS BAD, GIVE UP
MOVEI C,MAXLC ;COMPUTE MAX RESIDUAL TO RECOGNISE
SUBM C,DIRLKT ; ...
LOAD D,FBNAM,(B) ;GET NAME STRING ADDRESS
ADD D,DIRORA ;GET VIRTUAL ADDRESS OF NAME STRING
ADDI D,1 ;SKIP STRING BLOCK HEADER
HRLZI C,(<POINT 7,(D)>) ;BUILD BYTE POINTER TO START
MOVE A,DIRLKC ;GET COUNT OF INPUT CHARS AT THIS LEVEL
ADJBP A,C ;ADJUST POINTER TO FIRST NEW CHAR
DIRUN1: ILDB C,A ;GET NEXT INPUT CHARACTER
JUMPE C,DIRUN2 ;END OF STRING?
SOSGE DIRLKT ;DECREMENT/CHECK RESIDUAL
JRST DIRAMB ;RETURN AMBIGUOUS
IDPB C,DIRLKP ;NO - COPY TO OUTPUT
JRST DIRUN1 ;LOOP
DIRUN2: MOVE A,DIRLKP ;STORE NULL WITHOUT CHANGEING OUTPUT PTR
IDPB C,A ; ...
MOVX A,FB%SDR ;DOES THIS DIR HAVE ANY SUBDIRS
TDNE A,.FBCTL(B) ; ???
JRST DIRAMB ;YES - RETURN AMBIGUOUS
LOAD A,FBDRN,(B) ;NO - GET DIR NUMBER FROM FDB
MOVE B,DIRLKP ;RETURN UPDATED OUTPUT POINTER
CALL USTDIR ;UNLOCK DIR
RETSKP ;SUCCESS
DIRAMB: CALL USTDIR ;UNLOCK THE DIRECTORY
SETOM A ;INDICATE AMBIGUOUS
MOVE B,DIRLKP ;RETURN ANY POSSIBLE OUTPUT
RET ;RETURN
DIRLER: CALL USTDIR ;UNLOCK THE DIRECTORY
SETZM A ;INDICATE NO MATCH
RET ;RETURN
;LOOKUP ROUTINE FOR SPECIAL DIRECTORIES. THESE DIRECTORIES ARE
;ASSUMED TO BE USED FREQUENTLY AND SO ARE KEPT IN A RESIDENT
;TABLE ALONG WITH THEIR DIRECTORY NUMBERS.
; A/ BYTE POINTER TO INPUT STRING
; CALL DIRSLK
; RETURNS +1: NOT FOUND, A PRESERVED
; RETURNS +2: FOUND, DIRNUM IN A
DIRSLK: PUSH P,Q1
PUSH P,A
HRLZ Q1,NSDIRT ;GET NEG NUMBER OF SPECIAL DIRS
JUMPE Q1,DIRSL0 ;IT COULD BE 0
DIRSL1: HRRZ A,SDIRTB(Q1) ;GET PTR TO THIS DIR
HRLI A,(POINT 7,0) ;CONSTRUCT ILDB PTR
MOVE B,0(P) ;GET PTR TO REQUESTED DIR
CALL STRCMP ;COMPARE STRINGS
JRST [ AOBJN Q1,DIRSL1 ;NOT EQUAL, KEEP LOOKING
JRST DIRSL0] ;SEARCH DONE, DIR NOT FOUND
HLRZ A,SDIRTB(Q1) ;DIR FOUND, GET ITS DIRNUM
POP P,(P) ;FLUSH INPUT POINTER
POP P,Q1
RETSKP
DIRSL0: POP P,A ;RESTORE ORIG PTR FOR CONTINUING LOOKUP
POP P,Q1
RET
; Removal routine for special directories. If the structure is PS: and
; the directory number is present in the special table, it is removed.
; Call: T3 ; The directory number to remove
; T4 ; The structure number
; CALL DIRSLK
; Return:
; +1 ; Always
; Clobbers T1,T2
REMSDR::MOVEI T1,PSNUM
CAME T1,T4 ;IS THE DIRECTORY ON PS:?
RET ;NO, RETURN
HRLZ T1,NSDIRT ;YES, NOW GET NEG NUMBER OF DIRS
JUMPE T1,R ;RETURN IF ZERO
REMSDL: HLRZ T2,SDIRTB(T1) ;DIR NUMBER FROM TABLE ENTRY
CAMN T2,T3 ;IS IT THE DIR WE ARE LOOKING FOR?
SETZM SDIRTB(T1) ;YES, ZERO THE TABLE ENTRY
AOBJN T1,REMSDL ;SEARCH THE WHOLE TABLE
RET ;DONE
; Directory number to string conversion
; Call: A ; The directory number
; CALL GDIRST
; Return
; +1 ; Error, no such directory number (error code in A)
; +2 ; Ok, in a, pointer to string block holding the name
; The directory AND STR ARE locked upon exit, and must be unlocked
; after the string is used
; To unlock, CALL USTDIR
; Clobbers a,b,c,d
GDIRST::EA.ENT
STKVAR <GDRSTN,GDRSTR,GDRSDR>
HRRZM A,GDRSTN ;SAVE DIRECTORY NUMBER
CALL CNVDIR ;GET A DIR NUMBER FROM THE USER NUMBER
MOVEM A,GDRSDR ;SAVE WHOLE DIRECTORY NUMBER
HLRZS A ;GET JUST THE UNIQUE CODE
CALL CNVSTR ;GET A STR NUMBER
RETBAD () ;NONE
MOVEM A,GDRSTR ;SAVE THE STR INDEX
JE IDXFLG,,GDRST2 ;NO IDXTAB
LOAD A,CURUC ;GET UNIQUE CODE FOR STR THAT IS MAPPED
HLRZ B,GDRSDR ;GET UNIQUE CODE FROM DIRECTORY NUMBER
CAME A,B ;IS THIS OURS?
JRST GDRST2 ;NO
MOVE A,DIRORA
CALL MRMAP ;GET HANDLE ON PAGE 0 OF DIR
JRST GDRST3 ;NO DIR MAPPED
CALL MRPACS ;GET PAGE ACCESS
TLNN A,(PA%PEX) ;DOES PAGE EXIST?
JRST GDRST3 ;NO, GO MAP IN ROOT- DIR
MOVE B,DIRORA ;SET UP BASE OF DIR AREA
LOAD C,DRTYP,(B) ;CHECK FOR A LEGAL DIR TYPE
CAIE C,.TYDIR
JRST GDRST3 ;NOT A LEGAL DIR MAPPED
LOAD A,DRNUM,(B) ;GET DIR NUMBER OF MAPPED DIR
CAME A,GDRSTN ;IS THIS THE DIR WE WANT
JRST GDRST3 ;NO, - CONSIDER WHAT TO MAP
CALL DR0CHK ;MAKE SURE THIS IS A GOOD DIR
JRST GDRST6 ;IT ISNT
MOVE A,GDRSTN ;GET DIR NUMBER
LOAD B,CURSTR ;GET CURRENT STR #
CALL LCKDNM ;LOCK IT
GDRST1: MOVE A,DIRORA ;GET BASE ADDRESS OF DIR
LOAD A,DRNAM,(A) ;GET ADDRESS OF NAME STRING
ADD A,DIRORA ;MAKE IT A VIRTUAL ADDRESS
LOAD B,NMTYP,(A) ;GET TYPE OF BLOCK
CAIE B,.TYNAM ;IS IT A NAME BLOCK?
RETBAD (DIRX3,<CALL USTDIR>) ;NO RETURN FAILURE
RETSKP ;RETURN WITH ADR OF NAME STRING IN A
GDRST2: MOVE A,GDRSTR ;GET STR NUMBER TO MAP IDXTAB
CALL MAPIDX ;MAP INDEX
JRST GDRST7 ;FAILED - UNLOCK STR AND ERROR
GDRST3: MOVE A,GDRSTN ;GET DIR NUMBER
CALL GETIDX ;GET INDEX INFORMATION IN A - C
JRST GDRST7 ;FAILED
TXNE D,IDX%IV ;IS THIS ENTRY VALID?
RETBAD (DIRX3,<MOVE A,GDRSTR
CALL ULKSTR>) ;NO. UNLOCK STURUCTURE AND GIVE ERROR
CAIE C,ROOTDN ;IS ROOT DIR SUPERIOR?
JRST GDRST5 ;NO - MUST MAP DIR ITSELF
GDRST4: MOVE A,GDRSTR ;GET STR NUMBER TO UNLOCK
CALL ULKSTR ;MUST MAP IN NEW DIRECTORY NOW
MOVEI A,ROOTDN ;GET ROOT-DIR NUMBER
HLL A,GDRSDR ;GET STR NUMBER TO BE MAPPED
CALL SETDIR ;MAP IN THE APPROPRIATE DIR
RETBAD () ;None
MOVE A,GDRSTN ;GET DIR NUMBER AGAIN
CALL GETIDX ;GET FDB ADDRESS OF THIS DIR FILE
RETBAD (,<CALL USTDIR>) ;FAILED
TXNE D,IDX%IV ;VALID IDX ENTRY?
RETBAD (DIRX3) ;NO. ERROR
ADD A,DIRORA ;GET ABS ADR OF FDB
CALL FDBCHK ;MAKE SURE FDB IS GOOD
RETBAD (,<CALL USTDIR>) ;IT ISNT
LOAD A,FBNAM,(A) ;GET POINTER TO NAME STRING
ADD A,DIRORA ;MAKE IT ABSOLUTE
RETSKP ;RETURN WITH DIR LOCKED AND ADR IN A
;HERE WHEN ROOT IS NOT SUPERIOR - MUST MAP SUBJECT DIR
GDRST5: MOVE A,GDRSTR ;FIRST UNLOCK STR
CALL ULKSTR ; ...
MOVE A,GDRSDR ;GET FULLWORD DIR NUMBER
CALL SETDIR ;MAP IT
RETBAD() ;FAILED - NO RECOURSE
JRST GDRST1 ;CHECK DIR AND RETURN STRING
;HERE WHEN THE SUBJECT DIR APPEARS BAD. CHECK IF NAME CAN COME FROM
;ROOT DIR
GDRST6: MOVE A,GDRSTN ;GET HALFWORD DIR NUMBER
CALL GETIDX ;GET INDEX INFO IN A-C
JRST GDRST7 ;FAILED
CAIN C,ROOTDN ;ROOT SUPERIOR?
JRST GDRST4 ;YES - TRY FOR IT
GDRST7: EXCH A,GDRSTR ;NO - SAVE ERR CODE AND GET STR NUM
CALL ULKSTR ;UNLOCK STR
MOVE A,GDRSTR ;RESTORE ERROR CODE
RETBAD() ; FAIL
;INSERT AUTHOR/LAST-WRITER STRING IN FDB
; A/ FDB ADDRESS
; B/ POINTER TO STRING
; C/ FDB OFFSET (.FBAUT OR .FBLWR)
; CALL INSUNS
; RETURNS +1 ALWAYS
INSUNS::EA.ENT
STKVAR <INSUST,INSUNL>
MOVEM B,INSUST ;SAVE USER NAME STRING
ADD C,A ;ADDRESS OF WORD TO MODIFY
MOVEM C,INSUNL ;LOCATION OF AUTHOR/LAST-WRITER STR
CALL DELUNS ;DELETE USER NAME STRING
AOS A,INSUST ;START OF STRING
HRRZ B,-1(A) ;LENGTH OF STRING
JUMPE B,INSUNX ;INSERT NULL IF ZERO
SUBI B,2 ;GET NUMBER OF FULL WORDS
MOVEI C,.ETUNS ;USER NAME STRING TYPE
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;SEE IF THERE
JRST INSUN2 ;NO - MUST ADD IT
MOVE B,DRLOC ;GET POINTER TO SYMBOL ENTRY
LOAD B,DIRLA,(B) ;GET ADDRS OF USER NAME STRING
INSUN1: MOVE A,B ;PUT ADDRS IN A
CALL UNSCHK ;GRNTEE VALID BLOCK
JRST [ MOVEI B,0 ;NO - RETURN A ZERO
JRST INSUNX]
ADD A,DIRORA ;RELOCATE ADDRESS OF STRING
INCR UNSHR,(A) ;INCREMENT SHARE COUNT
INSUNX: MOVE A,INSUNL ;LOCATION TO STORE RESULT
MOVEM B,0(A) ;STORE POINTER OR 0
RET ;RETURN
INSUN2: MOVE B,DRINL ;LENGTH OF STRING
ADDI B,3 ;ALLOW FOR HEADER AND PARTIAL WD
CALL ASGDFR ;ALLOCATE SPACE IN DIRECTORY
JRST [ MOVEI B,0 ;STORE 0 IF NO ROOM
JRST INSUNX]
MOVEI B,.TYUNS ;TYPE USER NAME STRING
STOR B,UNTYP,(A) ;SET UP BLOCK
XMOVEI C,2(A) ;DESTINATION
PUSH P,A ;SAVE ADDRESS
MOVE A,DRINL ;LENGTH
AOS A ;+1
HRRZ B,DRINP ;START OF SOURBE STRING
CALL XBLTA
POP P,A ;RESTORE A
MOVE D,DRINL ;LENGTH OF TRANSFER
ADD D,A ;FINAL ADDRESS OF XFER
MOVE C,DRMSK ;CLEAR UNUSED CHARS
ANDM C,2(D) ;...
SETZRO UNSHR,(A) ;INIT SHARE COUNT
LOAD B,UNVAL,(A) ;GET FIRST 5 CHARS OF STRING
SUB A,DIRORA ;CONVERT TO RELATIVE ADDRS
MOVEM A,INSUST ;SAVE FOR A WHILE
MOVEI C,.ETUNS ;USER NAME STRING TYPE
CALL INSSYM ;INSERT INTO SYMBOL TABLE
JFCL ;IGNORE ERROR
MOVE B,INSUST ;RESTORE BLOCK ADDRS
JRST INSUN1 ;CHECK AND STORE
;ROUTINE TO DELETE A USER NAME STRING FROM AN FDB
; A/ FDB ADDRESS
; C/ ADDRESS OF AUTHOR OR LAST-WRITE STRING
; CALL DELUNS
;RETURNS +1
DELUNS: CALL FDBCHK ;VALIDATE FDB
RETBAD ()
MOVE A,0(C) ;FETCH NAME STRING PNTR
SETZM 0(C) ;CLEAR OUT PNTR
JUMPE A,R ;DONE IF NONE
ADD A,DIRORA ;RELOCATE BLOCK ADDRS
LOAD C,UNSHR,(A) ;GET SHARE COUNT
SOJG C,[STOR C,UNSHR,(A) ;UPDATE COUNT
RET] ;RETURN OF .GT. 0
PUSH P,A ;SAVE BLOCK ADDRS
LOAD B,UNLEN,(A) ;GET BLOCK LENGTH
SUBI B,3 ;GET # OF FULL WORDS
ADDI A,2 ;POINT TO STRING BEG
MOVEI C,.ETUNS ;TYPE USER NAME STRING
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;FIND STRING IN SYMBOL TABLE
SKIPA ;NOT FOUND
CALL DELSYM ;FOUND - DELETE IT
POP P,B ;RESTORE PNTR TO B
CALLRET RELDFA ; AND RELEASE STORAGE
; INSERT ACCOUNT STRING/NUMBER IN FDB
INSACT::EA.ENT
ASUBR <INSAC1>
MOVEM B,INSAC1 ;SAVE THE POINTER
CALL GETFDB ;GET THE ADDRESS OF THE FDB INTO A
RET ;NOT FOUND
MOVE B,INSAC1
CALL INSAC0 ;GO DO THE WORK
RETBAD ( ,<CALL USTDIR>) ;UNLOCK DIR AND GIVE ERROR RETURN
CALL USTDIR
RETSKP ;SUCCESS RETURN
; Insert account string/number in fdb
; Call: A ; Location of fdb
; B ; LOOKUP POINTER TO ACCOUNT
; CALL INSAC0
; RETURNS +1 FAILED, ERROR CODE IN A
; +2 SUCCESS
; Clobbers b,c
INSAC0: STKVAR <INSACF,INSACA>
MOVEM A,INSACF ;SAVE ADDRESS OF FDB
MOVEM B,INSACA ;SAVE POINTER TO ACCOUNT
HRRZ A,FILDDN(JFN) ;GET DIRECTORY NUMBER
LOAD B,FLUC,(JFN) ;GET STRUCTURE UNIQUE CODE
HRL A,B ;36-BIT DIRECTORY NUMBER
MOVE B,INSACA
SKIPN 0(B) ;NULL STRING?
BUG.(HLT,BADDAC,DIRECT,SOFT,<INSACT - Null account string seen>,,<
Cause: A null account string was given for insertion into the FDB by the
monitor during the creation of a file or while executing a SACTF JSYS.
>)
CPYAC3: CALL VERACT ;VALID ACCOUNT?
RETBAD () ;NO, ERROR RETURN
MOVE A,INSACF ;ACCOUNT VALID, GET BACK ADDRESS OF FDB
CALL DELACT ;DELETE THE PRESENT ACCOUNT
HRRZ A,INSACA
ADDI A,1 ;GET START OF TEXT STRING IN A
HLRE B,INSACA
MOVNS B ;NUMBER OF FULL WORDS
MOVEI C,.ETACT ;LOOKING FOR AN ACCOUNT STRING ENTRY
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;SEE IF ACCOUNT STRING EXISTS ALREADY
JRST CPYAC1 ;IT DOESNT, GO ADD IT TO SYMBOL TABLE
MOVE B,DRLOC ;GET POINTER TO SYMBOL ENTRY
LOAD B,DIRLA,(B) ;GET ADDRESS OF ACCOUNT BLOCK
CPYAC0: MOVE A,B ;GET ADDRESS OF ACCOUNT STRING BLOCK
CALL ACTCHK ;MAKE SURE THIS IS A GOOD ACCOUNT BLOCK
RETBAD () ;IT ISN'T, RETURN ERROR
ADD A,DIRORA ;GET VIRTUAL ADDRESS OF BLOCK
INCR ACSHR,(A) ;INCREMENT SHARE COUNT FOR STRING
CPYACG: MOVE A,INSACF ;GET BACK FDB ADDRESS
STOR B,FBACT,(A) ;Store as account
RETSKP
CPYACF: MOVE B,[XWD 500000,.DFACT] ;GET DEFAULT #
JRST CPYACG
CPYAC1: MOVE B,DRINL ;GET LENGTH OF STRING
ADDI B,3 ;ADD IN HEADER LENGTH PLUS PARTIAL WORD
CALL ASGDFR ;ASSIGN SPACE FOR ACCOUNT BLOCK
RETBAD () ;NO ROOM IN DIR
MOVEI B,.TYACT ;MARK IT AS AN ACCOUNT STRING BLOCK
STOR B,ACTYP,(A) ;...
PUSH P,A
MOVE B,DRINP ;GET START OF SOURCE STRING
XMOVEI C,2(A) ;GET START OF DESTINATION STRING
MOVE A,DRINL ;GET LENGTH OF STRING -1
AOS A
CALL XBLTA ;DO BLT
POP P,A ;RESTORE ADDRESS
MOVE D,DRINL ;FIND END ADDRESS
ADD D,A
MOVE C,DRMSK ;ZERO UNUSED CHARACTERS IN PARTIAL WORD
ANDM C,2(D) ;...
SETZRO ACSHR,(A) ;INITIALIZE SHARE COUNT
LOAD B,ACVAL,(A) ;GET FIRST 5 CHARACTERS OF STRING
SUB A,DIRORA ;GET RELATIVE ADDRESS OF STRING BLOCK
MOVEM A,INSACA ;SAVE ADDRESS OF BLOCK
MOVEI C,.ETACT ;GET ENTRY TYPE
CALL INSSYM ;INSERT THIS ENTRY INTO SYMBOL TABLE
JFCL ;IGNORE FAILURE
MOVE B,INSACA ;GET BACK ADR OF BLOCK
JRST CPYAC0
;ROUTINE TO DELETE AN ACCOUNT FROM AN FDB
;ACCEPTS IN A/ ADR OF FDB (ABSOLUTE)
; CALL DELACT
;RETURNS +1: ALWAYS
DELACT: CALL FDBCHK ;MAKE SURE WE HAVE A GOOD FDB
RETBAD ;NO
LOAD B,FBACT,(A) ;GET THE CURRENT ACCOUNT
SETZRO FBACT,(A) ;CLEAR THE ACCOUNT FIELD
JUMPLE B,R ;NUMERIC ACCOUNTS REQUIRE NO WORK
MOVE A,B ;GET ADDRESS OF ACCOUNT BLOCK
CALL ACTCHK ;MAKE SURE THIS IS AN ACCOUNT STRING
RET ;NO, DONT TRY TO DELETE IT
ADD A,DIRORA ;GET ABS ADR OF ACCOUNT STRING
LOAD C,ACSHR,(A) ;GET SHARE COUNT OF THIS ACCOUNT STRING
SOJG C,[STOR C,ACSHR,(A) ;STORE UPDATED COUNT
RET] ;STRING IS BEING SHARED
PUSH P,A ;SAVE ADR OF BLOCK
LOAD B,ACLEN,(A) ;GET # OF WORDS IN BLOCK
SUBI B,3 ;GET # OF FULL WORDS IN STRING
ADDI A,2 ;GET POINTER TO START OF STRING
MOVEI C,.ETACT ;THIS IS AN ACCOUNT TYPE
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;LOOKUP THIS ACCOUNT STRING
SKIPA ;COULD NOT FIND IT IN SYM TAB
CALL DELSYM ;DELETE THIS SYMBOL
POP P,B ;GET BACK POINTER TO STRING BLOCK
CALLRET RELDFA ;RELEASE THE STORAGE SPACE
;ROUTINE TO DELETE A SYMBOL FROM THE SYMBOL TABLE
;ASSUMES: DRLOC SET UP BY LOOKUP
; CALL DELSYM
;RETURNS +1: ALWAYS
DELSYM: CALL SYMCHK ;CHECK THAT THE SYMBOL TABLE IS OK
RET ;NOT LEGAL FORMAT
MOVE D,DIRORA ;GET BASE ADR OF MAPPED DIR
LOAD A,DRSBT,(D) ;GET BOTTOM OF SYMBOL TABLE
ADD A,DIRORA ;MAKE IT ABSOLUTE
AOS A ;SET UP FOR END TEST
MOVE B,DRLOC ;GET ADR OF SYMBOL BEING DELETED
DELSY1: MOVE C,-1(B) ;GET A WORD
MOVEM C,.SYMLN-1(B) ;MOVE IT UP BY ONE SYMBOL
CAMLE B,A ;FINISHED YET?
SOJA B,DELSY1 ;NO, LOOP BACK UNTIL DONE
LOAD A,DRSBT,(D) ;GET OLD BOTTOM
ADDI A,.SYMLN ;UPDATE IT
STOR A,DRSBT,(D)
RET ;AND RETURN
;EXPUNGE FILES FROM DIRECTORY
; F/ DD%DTF ;DELETE ;T FILES
; DD%DNF ;DELETE NON-EXISTENT FILES
; DD%RST ;REBUILD SYMBOL TABLE
; B17 = DELETE ALL FILES
; A/ DIRECTORY NUMBER
; CALL DELDEL
;RETURNS +1: AN ERROR OCCURED DURING THE DELETING
; +2: THE OPERATION WAS SUCCESSFUL
DELDEL::EA.ENT
TRVAR <SAVDNO,PASS2F,SAVFDB,RFLAG> ;[7364] CALLED DIRECTORY NUMBER, 2ND PASS FLAG
MOVEM T1,SAVDNO ;[7364] SAVE DIRECTORY NUMBER FOR DELWAT
SAVEPQ ;SAVE THE PERMANENT ACS
CALL SETDIR ;MAP IN THE DIRECTORY NUMBER
RETBAD () ;COULD NOT MAP THE DIRECTORY
TXNN F,1B17 ;DELETE ALL?
IFSKP.
MOVE A,DIRORA ;YES - CHECK FOR SUBDIRS
LOAD A,DRSDC,(A) ;GET COUNT
ANDN. A
RETBAD(DELF10,<CALL USTDIR>) ;CANNOT DELETE WITH SUBDIRS
ENDIF.
TXNN F,DD%CHK ;CHECKING ONLY?
IFSKP.
MOVEI A,0 ;YES
CALL RBLDST ;DO THE CHECK
RETBAD (,<CALL USTDIR>) ;DIRECTORY IS NOT CONSISTENT
CALL USTDIR ;DIR IS GOOD
RETSKP
ENDIF.
TXNN F,DD%RST ;REBUILD SYMBOL TABLE?
IFSKP.
SETO A, ;YES, GO REBUILD IT
CALL RBLDST ;...
RETBAD (DELFX4,<CALL USTDIR>) ;REBUILD FAILED
ENDIF.
CALL SYMCHK ;MAKE SURE SYMBOL TABLE IS OK
RETBAD (DELFX5,<CALL USTDIR>) ;IT ISNT, GIVE ERROR RETURN
;..
;..
MOVE A,DIRORA ;GET BASE ADDRESS OF MAPPED DIR
SETZ Q1, ;INITIALIZE RETURN VALUE TO TRUE
LOAD Q2,DRSBT,(A) ;GET BOTTOM OF SYMBOL TABLE
ADD Q2,DIRORA ;MAKE IT BE ABSOLUTE
DELDL1: ADDI Q2,.SYMLN ;STEP TO NEXT SYMBOL IN TABLE
MOVE A,DIRORA ;GET BASE ADDRESS OF MAPPED DIR
LOAD B,DRSBT,(A) ;GET BOTTOM OF SYMBOL TABLE
ADD B,DIRORA ;MAKE IT ABSOLUTE
CAMG Q2,B ;DID SYMBOL TABLE CONTRACT PAST Q2?
JRST DELDL1 ;YES, GO INCREMENT Q2
LOAD A,DRSTP,(A) ;GET THE TOP OF THE SYMBOL TABLE
ADD A,DIRORA ;MAKE IT ABSOLUTE
CAML Q2,A ;AT THE TOP OF THE SYMBOL TABLE?
JRST [ CALL UPDDIR ;UPDATE DIR PAGES
CALL USTDIR ;YES, UNLOCK THE DIR
SKIPE A,Q1 ;ANY ERRORS?
RETBAD() ;YES
RETSKP] ;GIVE OK RETURN
LOAD A,SYMVL,(Q2) ;GET VALUE OF THIS SYMBOL
CAMN A,[-1] ;IS IT THE SYMBOL TABLE HEADER?
JRST DELDL8 ;YES, GO COMPLAIN
LOAD A,SYMET,(Q2) ;GET SYMBOL TYPE
CAIE A,.ETNAM ;IS THIS STILL A NAME TYPE?
JRST [ CALL UPDDIR ;UPDATE DIR PAGES
CALL USTDIR ;NO, UNLOCK THE DIR
SKIPE A,Q1 ;ANY ERRORS?
RETBAD() ;YES
RETSKP] ;GIVE OK RETURN
LOAD P3,DIRLA,(Q2) ;GET ADR OF FIRST NAME FDB
;..
;..
DELDL2: JUMPE P3,DELDL1 ;AT END OF CHAIN?
ADD P3,DIRORA ;NO, GET ABS ADR OF THIS TOP EXT FDB
MOVE Q3,P3 ;GET ADDRESS OF CURRENT FDB
DELDL5: SETZM PASS2F ;[7364]RESET PASS 2 FLAG
MOVE A,Q3 ;GO CHECK THE FDB OUT
CALL FDBCHK ;MAKE SURE IT IS REASONABLE
JRST DELDL9 ;NO, GO BOMB OUT
CALL DELTST ;SEE IF THIS FILE SHOULD BE DELETED
JRST DELDL4 ;NO, DONT DELETE IT
MOVE D,Q3 ;GET FDB ADR OF CURRENT FILE
LOAD Q3,FBGNL,(Q3) ;STEP TO NEXT FDB IN GEN CHAIN
JUMPE Q3,DELDL6 ;NO MORE GEN'S, GO STEP TO NEXT EXT
ADD Q3,DIRORA ;GET ABS ADR OF NEXT FDB IN CHAIN
CAMN P3,D ;IS THE DELETED FDB SAME AS TOP ONE?
MOVE P3,Q3 ;YES, NEXT FDB IS NOW TOP EXT FDB
DELD51: CALL DELFIL ;[7364]DELETE THE CURRENT FDB
JRST DELFS1 ;[7364] COULDN'T, CHECK IF RECOVERABLE
JRST DELDL5 ;GO CONTINUE SCANNING
DELDL6: LOAD P3,FBEXL,(P3) ;STEP TO NEXT EXT
DELD61: CALL DELFIL ;[7364]DELETE THE FDB IN D
JRST DELFS2 ;[7364] COULDN'T, CHECK IF RECOVERABLE
JRST DELDL2 ;GO SCAN DOWN THIS GEN CHAIN
DELDL4: LOAD Q3,FBGNL,(Q3) ;NOT DELETING, GET NEXT GEN IN CHAIN
JUMPE Q3,DELDL7 ;IF END OF CHAIN, GO STEP TO NEXT EXT
ADD Q3,DIRORA ;GET ABS ADR OF FDB
JRST DELDL5 ;GO SEE IF THIS ONE NEEDS DELETING
DELDL7: LOAD P3,FBEXL,(P3) ;STEP TO NEXT EXT
JRST DELDL2 ;GO SCAN DOWN THIS GEN CHAIN
DELDL8: MOVE A,DIRORA ;SET UP DIR OFFSET
LOAD A,DRNUM,(A) ;GET DIRECTORY NUMBER FOR SYSERR BLK
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRSY1,DIRECT,HARD,<DELDL8 - Directory symbol table fouled up for directory>,<<A,DIRNUM>,<B,STRNAM>>,<
Cause: A disordered directory symbol table was found while expunging a
directory or rebuilding a symbol table.
Action: Rebuild the symbol table. If that fails, delete directory with DELETE
command using the DIRECTORY subcommand and rebuild the directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
DELDL9: MOVEI A,DELFX6 ;DIR FORMAT IS SCREWED UP
CALLRET USTDIR ;UNLOCK THE DIR AND RETURN
;[7364] HERE IF A CALL TO DELFIL FAILED. IF THE PROBLEM IS THAT THERE WAS NO
;[7364] FREE SPACE AVAILABLE TO SEND AN ARCHIVE MESSAGE, THEN LET'S WAIT A
;[7364] LITTLE WHILE AND TRY AGAIN, BUT ONLY ONE RETRY IS ALLOWED. THIS CODE
;[7364] MUST PRESERVE THE CONTENTS OF AC D IF IT INTENDS TO RETRY THE CALL
;[7364] TO DELFIL.
DELFS1: SETZM RFLAG ;[7364]CLEAR RFLAG
SKIPA ;[7364]
DELFS2: SETOM RFLAG ;[7364]REMEMBER ENTRY POINT
CAIN T1,ARCX13 ;[7364]ARCMSG FAIL?
IFSKP. ;[7364]NO.
TXNN F,1B17 ;[7364]IF EXPUNGING ALL, GIVE ERROR
CAIE T1,DELFX2 ;[7364]EXPECTED ERROR IF FILE OPENED
MOVE Q1,A ;[7364]NO, THEN REMEMBER FAILURE
SKIPE RFLAG ;[7364]CONTINUE
JRST DELDL2 ;[7364] FROM THE APPROPRIATE
JRST DELDL5 ;[7364] PLACE
ENDIF. ;[7364]
SKIPN PASS2F ;[7364]ALREADY TRIED WAITING?
IFSKP. ;[7364]YES. GIVE UP
CALL UPDDIR ;[7364]()UPDATE WHAT'S BEEN DONE
CALL USTDIR ;[7364]()UNLOCK THE DIRECTORY
RETBAD() ;[7364]RETURN THE ERROR IN A
ENDIF. ;[7364]
MOVEM D,SAVFDB ;[7364]SAVE THE FDB ADDRESS
CALL DELWAT ;[7364]()NO. GO WAIT FOR FREE SPACE
RETBAD() ;[7364]FAILED. RETURN THE ERROR
MOVE D,SAVFDB ;[7364]GET BACK FDB ADDRESS
SETOM PASS2F ;[7364]FLAG THAT WE HAD TO WAIT FOR RETRY
SKIPE RFLAG ;[7364]GO BACK TO CORRECT PLACE
JRST DELD61 ;[7364]RETRY DELFIL
JRST DELD51 ;[7364] AT APPROPRIATE SPOT
DELWAT: CALL UPDDIR ;[7364]()UPDATE DIR TO SAVE THOSE ALREADY DONE
CALL USTDIR ;[7364]()AND UNLOCK TO AVOID CONTENTION
SETOM IPPKFR ;[7364]SET FLAG FOR FREESPACE CLEAR
MOVEI T1,IPPKFR ;[7364]ADDRESS
CALL DISE ;[7364](T1/)WAIT UNTIL HAVE CLEARED FREESPACE
MOVEI T1,^D45000 ;[7364]45 SECONDS
DISMS% ;[7364]WAIT
MOVE T1,SAVDNO ;[7364]GET BACK DIRECTORY NUMBER
CALL SETDIR ;[7364](T1/)MAP IT AND LOCK IT AGAIN
RETBAD() ;[7364]COULDN'T
RETSKP ;[7364] RESUME
;ROUTINE TO SEE IF A FILE SHOULD BE DELETED
;ACCEPTS IN A/ FDB ADDRESS
; CALL DELTST
;RETURNS +1: DO NOT DELETE THE FILE
; +2: DELETE THIS FILE
DELTST: TXNE F,1B17 ;DELETE ALL FILES?
JRST [ SETZRO FBPRM,(A) ;YES, GUARANTEE THAT THIS GOES AWAY
RETSKP]
JN FBDEL,(A),RSKP ;IF DELETED, ALWAYS DELETE IT
TXNN F,DD%DNF ;DELETE NON-EXISTENT FILES?
JRST DELTS1 ;NO
JN <FBNXF,FBNEX>,(A),RSKP ;IF NON-EXISTENT OR NO EXT, DELETE IT
DELTS1: JE FBTMP,(A),R ;IF NOT TEMPORARY, DO NOT DELETE IT
TXNN F,DD%DTF ;DELETE TEMPORARY FILES?
RET ;NO, DONT DELETE IT
LOAD B,FBGEN,(A) ;GET GENERATION NUMBER OF FILE
CAIGE B,^D100000 ;IS THIS BELOW JOB RELATED FILES
RETSKP ;YES. DELETE THIS FILE
SUBI B,^D100000 ;NO. EXTRACT JOB NUMBER FROM GENERATION
CAME B,GBLJNO ;YES, IS THIS FILE OURS?(Same Global Job Number)
RET ;NO, DONT DELETE IT
RETSKP ;DELETE THIS FILE
;ROUTINE TO DELETE AN FDB OF A NON-X FILE ON A RLJFN
;ASSUMES JFN AND STS ARE SET UP AS PER CHKJFN
; CALL DELJFB
;RETURNS +1: ALWAYS
DELJFB::EA.ENT
HLRZ A,FILNEN(JFN) ;WAS THERE A NAME SET UP YET?
JUMPE A,R ;IF 0, FDB COULD NOT HAVE BEEN MADE
BLCAL. DSKOK,<DEV> ;THIS A DSK?
RET ;NO, RETURN NOW
CALL GETFDB ;MAP IN FDB
JRST DELJF2 ;FAILED, MUST BE NON-EXISTENT FILE
DELJF0: CALL FDBCHK ;MAKE SURE THAT FDB IS GOOD
JRST DELJF1 ;NOT GOOD
JE FBNXF,(A),DELJF1 ;IF FILE EXISTS, DONT DELETE IT
MOVE D,A ;SET UP TO DELETE FDB
CALL DELFIL ;DELETE FILE AND FDB
JFCL ;COULD GET HERE ON PERMANENT FILES
DELJF1: CALLRET USTDIR ;UNLOCK DIR AND RETURN
DELJF2: CAMGE A,DIRORA ;ADR MUST BE REASONABLE
RET ;NO, IGNORE THIS FDB
PUSH P,A ;SAVE FDB ADR
HRRZ A,FILDDN(JFN) ;GET DIR NUMBER
LOAD B,FLUC,(JFN) ;GET STRUCTURE NUMBER
HRL A,B ;GET 36 BIT DIR NUMBER
CALL SETDIR ;MAP IN THIS DIR
JRST PA1 ;FAILED
POP P,A ;GET BACK FDB ADDRESS
JRST DELJF0 ;GO DELETE FDB IF NON-EXISTENT
;ROUTINE TO DELETE AN FDB (DIR SPACE ONLY)
;ACCEPTS IN A/ FDB ADDRESS (ABSOLUTE)
; CALL DELFDB
;RETURNS +1: ERROR OCCURED, FDB NOT DELETED
; +2: OK, ALL SPACE RETURNED
DELFDB::EA.ENT
STKVAR <DELFBA,DELFBT>
MOVEM A,DELFBA ;SAVE THE ADR OF THE FDB
CALL FDBCHK ;GUARANTEE THAT FDB IS GOOD
RETBAD (DELFX7) ;IT ISNT, SO BOMB OUT
LOAD A,FBNAM,(A) ;GET THE ADDRESS OF THE NAME BLOCK
ADD A,DIRORA ;MAKE IT ABSOLUTE
LOAD B,NMLEN,(A) ;GET LENGTH OF NAME BLOCK
ADDI A,1 ;GET ADDRESS OF FIRST WORD IN STRING
SUBI B,2 ;GET # OF FULL WORDS
MOVEI C,.ETNAM ;THIS IS A NAME SYMBOL
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;GO LOOK THIS NAME UP IN SYMBOL TABLE
RETBAD (DELFX8) ;COULD NOT FIND IT, ERROR RETURN
MOVE B,DRLOC ;GET ADDRESS OF SYMBOL
LOAD A,DIRLA,(B) ;GET FDB ADR OF FIRST FDB IN CHAIN
ADD A,DIRORA ;MAKE IT ABSOLUTE
CAME A,DELFBA ;IS THIS THE FDB WE ARE LOOKING FOR?
JRST DELFB1 ;NO
LOAD C,FBGNL,(A) ;YES, SEE IF IT HAS ANY GENERATIONS
JUMPE C,DELFB0 ;NO
MOVEM A,DELFBT ;CHECK THAT WE HAVE A GOOD FDB
MOVE A,C
CALL FDBCHR ;RELATIVE CHECK
RETBAD (DELFX7) ;BAD FDB
MOVE A,DELFBT ;GET BACK ADR OF FIRST FDB IN CHAIN
STOR C,DIRLA,(B) ;YES, MAKE SYMTAB POINT TO THIS VERSION
ADD C,DIRORA ;GET ABSOLUTE ADR OF NEXT FDB
LOAD A,FBEXL,(A) ;GET THE EXTENSION CHAIN POINTER
CALL FDBCHR ;CHECK IF THIS IS A GOOD VALUE
MOVEI A,0 ;NO, END CHAIN HERE
STOR A,FBEXL,(C) ;PRESERVE CHAIN
JRST DELFBF ;GO DELETE THIS FDB
DELFB0: LOAD A,FBEXL,(A) ;FDB HAS NO GEN'S, CHECK FOR EXT'S
CALL FDBCHR ;CHECK THIS FOR GOODNESS
MOVEI A,0 ;END THIS CHAIN IF BAD
STOR A,DIRLA,(B) ;FIX UP SYMTAB POINTER ALWAYS
JUMPE A,DELFBN ;IF NO EXT'S, DELETE NAME, EXT, AND FDB
JRST DELFBE ;OTHERWISE DELETE EXT AND FDB BLOCKS
DELFB1: LOAD C,FBGNL,(A) ;GET NEXT GENERATION FDB
JUMPE C,DELFB2 ;IF NO MORE, STEP TO NEXT EXT
ADD C,DIRORA ;GET ABS ADR OF FDB
CAMN C,DELFBA ;IS THIS THE DESIRED FDB
JRST DELFB3 ;YES, GO DELETE IT
MOVE A,C ;REMEMBER LAST FDB ADR
JRST DELFB1 ;GO CHECK NEXT GENERATION
DELFB2: LOAD A,DIRLA,(B) ;GET POINTER TO TOP FDB IN GEN CHAIN
ADD A,DIRORA ;MAKE IT ABSOLUTE
LOAD C,FBEXL,(A) ;GET POINTER TO NEXT EXT FDB
JUMPE C,[RETBAD (DELFX8)] ;IF NO MORE, FDB WAS NOT FOUND
MOVE B,A ;STEP POINTER TO EXTENSION FDB
ADDI B,.FBEXL ;THIS IS A DIRLA POINTER
ADD C,DIRORA ;GET ABS ADR OF THIS FDB
CAMN C,DELFBA ;IS THIS THE DESIRED ONE?
JRST DELFB4 ;YES
MOVE A,C ;REMEMBER THIS FDB AS LAST ONE SEEN
JRST DELFB1 ;GO CONTINUE LOOKING
DELFB3: LOAD D,FBGNL,(C) ;GET POINTER TO NEXT GEN FDB
EXCH A,D ;GET NEXT GEN FDB INTO A
CALL FDBCHR ;GO CHECK IT OUT
MOVEI A,0 ;END THE CHAIN
STOR A,FBGNL,(D) ;MAKE LAST FDB POINT TO NEXT FDB
JRST DELFBF ;GO DELETE JUST THE FDB BLOCK
DELFB4: LOAD D,FBGNL,(C) ;SEE IF THERE IS ANOTHER GENERATION FDB
JUMPN D,DELFB5 ;YES, GO SET UP LINKS TO IT
LOAD A,FBEXL,(C) ;NO, DELETING LAST GEN OF AN EXT
CALL EFIXUP ;SET UP POINTERS TO NEXT EXT
JRST DELFBE ;GO DELETE EXT AND FDB BLOCKS
DELFB5: MOVE A,D ;REMEMBER NEW FDB ADR
ADD D,DIRORA ;GET ABS ADR OF TOP FDB FOR THIS EXT
LOAD C,FBEXL,(C) ;GET EXT CHAIN FROM FDB BEING DELETED
EXCH C,A ;CHECK IT OUT
CALL FDBCHR
MOVEI A,0 ;END CHAIN
EXCH C,A
STOR C,FBEXL,(D) ;SET UP CHAIN POINTER
CALL EFIXUP ;GO SET UP NEW EXT POINTERS
JRST DELFBF ;GO DELETE JUST THE FDB BLOCK
DELFBN: CALL DELSYM ;DELETE THE SYMBOL TABLE ENTRY
MOVE A,DELFBA ;GET ADR OF FDB BEING DELETED
LOAD B,FBNAM,(A) ;GET NAME BLOCK
SETZRO FBNAM,(A) ;CLEAR OUT POINTER TO BLOCK
SKIPE A,B ;DONT RELEASE BLOCK IF NONE THERE
CALL NAMCHK ;MAKE SURE THIS IS A LEGAL BLOCK
JRST DELFBE ;IT ISNT, DONT RELEASE IT
CALL RELDFR ;RELEASE THE NAME BLOCK
DELFBE: MOVE A,DELFBA ;GET ADR OF FDB AGAIN
LOAD B,FBEXT,(A) ;GET ADR OF EXT BLOCK
SETZRO FBEXT,(A) ;CLEAR OUT POINTER TO BLOCK
SKIPE A,B ;DONT RELEASE BLOCK IF NONE THERE
CALL EXTCHK ;MAKE SURE IT IS AN EXT BLOCK
JRST DELFBF ;IT ISNT, DONT DELETE IT
CALL RELDFR ;GO RELEASE SPACE
DELFBF: MOVE A,DELFBA ;GET FDB ADR
CALL DELACT ;DELETE THE ACCOUNT STRING IF ANY
MOVE A,DELFBA ;GET FDB ADDRS
LOAD B,FBVER,(A) ;GET VERSION #
CAIGE B,1 ;CHECK VER #0
JRST DELFBG ;OLD FDB - SKIP THIS
MOVE C,A ;COPY FDB ADDRS
ADDI C,.FBAUT ;POINT TO AUTHOR STRING
CALL DELUNS ;DELETE USER NAME STRING
MOVE A,DELFBA ;FDB ADDR
MOVE C,A ;COPY IT
ADDI C,.FBLWR ;POINT TO LAST WRITER
CALL DELUNS ;DELETE USER NAME STRING
DELFBG: MOVE B,DELFBA ;GET FDB ADR FOR LAST TIME
CALL RELDFA ;RELEASE THE SPACE HELD BY THE FDB
RETSKP ;AND GIVE SUCCESSFUL RETURN
;ROUTINE TO DO A FAST GTFDB
;ASSUMES JFN IS SET UP POINTING TO THE APPROPRIATE JFN BLOCK
; CALL FSTGFB
;RETURNS +1: FAST GTFDB FAILED, A LOOKUP MUST BE DONE
; +2: FDB FOUND, ADDRESS OF FDB IN A
; DIRECTORY IS LOCKED AND FORK IS NOINT
FSTGFB::EA.ENT
HRRZ A,FILDDN(JFN) ;GET DIRECTORY NUMBER
JUMPE A,R ;IF NONE, GIVE ERROR RETURN
LOAD B,FLUC,(JFN) ;GET STRUCTURE NUMBER
HRL A,B ;GET 36 BIT DIRECTORY NUMBER
CALL SETDIR ;MAP IN THE DIRECTORY
RET ;FAILED
SKIPN A,FILFDB(JFN) ;GET THE ADDRESS OF THE FDB
JRST FSTGFE ;IF NONE, GO UNLOCK AND GIVE ERROR RET
CALL FDBCHQ ;CHECK IT (WITHOUT BUG-CHECKING)
JRST FSTGFE ;NOT AN FDB ANYMORE
LOAD B,FBNAM,(A) ;GET POINTER TO NAME STRING
HLRZ A,FILNEN(JFN) ;GET POINTER TO NAME STRING IN JFN
JUMPE A,FSTGFE ;IF NO NAME IN JFN, GIVE ERROR RETURN
CALL DIRSTC ;GO COMPARE THE TWO STRINGS
JRST FSTGFE ;NOT A MATCH, NOT RIGHT FDB
MOVE A,FILFDB(JFN) ;GET ADR OF FDB AGAIN
LOAD B,FBEXT,(A) ;GET POINTER TO EXTENSION STRING
HRRZ A,FILNEN(JFN) ;GET POINTER TO EXT IN JFN BLOCK
JUMPE A,FSTGFD ;IF NO EXT YET, THIS IS OK
CALL DIRSTC ;GO COMPARE STRINGS
JRST FSTGFE ;ERROR, GO UNLOCK DIR
MOVE A,FILFDB(JFN) ;GET ADR OF FDB AGAIN
LOAD B,FBGEN,(A) ;GET GENERATION OF THIS FDB
HRRZ C,FILVER(JFN) ;GET GEN FROM JFN BLOCK
JUMPE C,FSTGFD ;IF GEN NOT SET YET, THIS IS OK
CAME B,C ;GENERATIONS MATCH
JRST FSTGFE ;NO, GO UNLOCK AND BOMB OUT
FSTGFD: MOVE A,FILFDB(JFN) ;GET THE FDB ADDRESS INTO A
RETSKP ;EXIT LEAVING DIR LOCKED
FSTGFE: CALLRET USTDIR ;UNLOCK THE DIR
;ROUTINE TO COMPARE A STRING IN THE JSB WITH A DIR STRING
;ACCEPTS IN A/ ADDRESS OF STRING IN JSB
; B/ RELATIVE ADDRESS OF STRING IN DIRECTORY
; CALL DIRSTC
;RETURNS +1: NO MATCH
; +2: STRINGS MATCH
DIRSTC::EA.ENT
STKVAR <DIRSTP>
JUMPE B,R ;IF NO STRING IN DIR, GIVE ERROR RET
ADD B,DIRORA ;GET ABSOLUTE ADR OF STRING
HRLI A,(POINT 7,0,35) ;SET UP BYTE POINTER
MOVSI C,(POINT 7,0(B),35)
MOVEM C,DIRSTP ;SAVE BYTE POINTER TO DIR STRING
DIRSTL: ILDB C,A ;GET A BYTE FROM JFN BLOCK STRING
ILDB D,DIRSTP ;GET A BYTE FROM THE DIR STRING
CAME C,D ;MATCH?
RET ;NO, GIVE ERROR RETURN
JUMPN C,DIRSTL ;REACHED THE NULL YET?
RETSKP ;YES, STRINGS MATCH
; Insert protection into fdb
; Call: FILPTR(JFN) ; Protection number
; A ; Location of fdb
; CALL INSPRT
; Returns +1
; Clobbers b
INSPRT::EA.ENT
CALL GETFDB ;GET THE ADDRESS OF THE FDB
RET
PUSH P,A ;SAVE VIRTUAL ADDRESS OF FDB
MOVX B,DC%CN ;B/CONNECT ACCESS
CALL DIRCHK ;SEE IF WE CAN CONNECT (AND THUS BECOME
; LIKE OWNER)
JRST [ POP P,A ;NOT LEGAL ACCESS
JRST ERRET]
POP P,A
MOVE B,FILPRT(JFN) ;GET THE NEW PROTECTION SETTING
STOR B,FBPRT,(A) ;STORE IT IN THE DIRECTORY
JRST ERRET ;EXIT UNLOCKING THE DIRECTORY
;SET UP DEFAULT AUTHOR AND LAST-WRITER STRINGS IN NEW FDB
;CALL: FILFDB(JFN) ;FDB ADDRESS
; CALL FDBINU
;RETURNS +1
;CLOBBERS A,B,C,D
FDBINU::EA.ENT
CALL GETFDB ;MAP IN FDB AND DIRECTORY
RET
LOAD B,FBVER,(A) ;GET VERSION #
CAIGE B,1 ;VERSION 1 OR LATER
JRST [ CALL FV0FIX ;FIXUP V0 FDB
JRST ERRET] ;EXIT AND UNLOCK DIRECTORY
PUSH P,A ;SAVE FDB ADDRESS
MOVEI B,USRNAM ;POINT TO USER NAME
MOVEI C,.FBAUT ;SET UP AUTHOR FIELD
CALL INSUNS ;INSERT USER NAME STRING
POP P,A ;GET FDB ADDRS BACK
MOVEI B,USRNAM ;THIS USER
MOVEI C,.FBLWR ;SET LAST WRITER
CALL INSUNS ;INSERT STRING
JRST ERRET ;EXIT UNLOCKING DIRECTORY
; Initialize fdb
; Call: A ; Location of fdb
; CALL FDBINI
; Return +1 always
; Initializes the fdb as follows:
; FDBCTL ; Fdbnxf (non-existent)
; FDBCRE ; Date and time of now
; FDBCRV ; Date and time of now
; All else is zeroed including fdbext, fdbver, etc.
; Clobbers b,c,d
; Preserves a
FDBINI: LOAD C,FBLEN,(A) ;GET THE LENGTH OF THE FDB
MOVSI B,0(A) ;ZERO THE FDB AREA
HRRI B,1(A) ;SET UP BLT POINTER
SETZM 0(A) ;ZERO FIRST WORD
ADD A,C ; End of FDB
BLT B,-1(A) ;Clear the entire fdb
SUB A,C ; Back to top of FDB
STOR C,FBLEN,(A) ;RESTORE LENGTH
MOVEI B,.TYFDB ;SET UP THE TYPE FIELD
STOR B,FBTYP,(A) ;...
MOVEI B,1 ;INIT VERSION # OF FDB
STOR B,FBVER,(A) ;...
CALL FDBIN0 ;GO INITIALIZE REST OF FDB
MOVE C,DIRORA ;GET BASE ADDRESS OF DIR
LOAD B,DRDPW,(C) ;GET DEFAULT FILE PROTECTION
STOR B,FBPRT,(A) ;PUT DEF PROT IN DIRECTORY
LOAD B,DRDBK,(C) ;GET DEFAULT NUMBER VERSIONS
STOR B,FBGNR,(A) ;PUT IN FDB
MOVE B,[500000,,.DFACT] ;SET ACCOUNT TO DEFAULT
STOR B,FBACT,(A) ;...
LOAD B,DRDNE,(C) ; Get default online expiration
CAIN B,0 ; Is it 0? (not set up for directory)
MOVX B,.STDNE ; Yes, use system default then
STOR B,FBNET,(A) ; Put in FDB
LOAD B,FBLEN,(A) ; Get FDB length
CAIGE B,.FBLXT ; Long enough for offline exp?
RET ; No, done then
LOAD B,DRDFE,(C) ; Get default offline expiration
CAIN B,0 ; Is it 0? (not setup for dir)
SKIPE B,TPRCYC ; USE TAPE-RECYCLE-PERIOD IF SPEC'D
SKIPA
MOVX B,.STDFE ; USE SYSTEM DEFAULT AS LAST DITCH
STOR B,FBFET,(A) ; Put in FDB
RET
;ENTRY TO INIT FIELDS NOT COPIED FROM PREVIOUS VERSIONS
FDBIN0: PUSH P,A ;SAVE ADDRESS OF FDB
CALL LGTAD ;Get today
MOVE B,0(P) ;GET FDB ADDRS BACK
STOR A,FBCRE,(B) ;Set LAST WRITE DATE
STOR A,FBCRV,(B) ;CREATION DATE
POP P,A ;RESTORE FDB ADR IN A
MOVX B,FB%NXF ;MARK FILE NON-EXISTENT
MOVEM B,.FBCTL(A) ;AND IMPLCITELY CLEAR ALL OTHER BITS
LOAD B,FBVER,(A) ;GET FDB VERSION #
CAIGE B,1 ;NEW ?
CALLRET FV0FIX ;OLD - SET DEFAULTS
RET
FV0FIX: MOVE B,JOBNO ;GET JOB #
HRRZ B,JOBDIR(B) ;LOGGED IN DIRECTORY #
HRLS B ;COPY TO LHS ALSO
MOVEM B,.FBUSE(A) ;STORE IN FDB USE WORD
RET ;RETURN
; MAP A DIRECTORY INTO PROCESS VIRTUAL ADDRESS SPACE
; Call: A ; 36 BIT Directory number
; CALL SETDIR ; For mapping a directory
; Return
; +1 ; Non-existent directory, OR COULD NOT MAP INDEX TABLE
; +2 ; Normal, the DIR IS MAPPED IN AT DIRORG
; ; LEAVES STR AND DIR LOCKED AND FORK NOINT
; To unlock, CALL USTDIR.
; Clobbers a,b,c,d
SETDIR::EA.ENT
STKVAR <SETDIN,SETDIS,SETDIE,SETDNM>
MOVEM A,SETDIN ;SAVE DIR #
HLRZS A ;GET THE UNIQUE STR NUMBER
CALL CNVSTR ;CONVERT IT TO STR INDEX
RETBAD () ;NO SUCH STR
MOVEM A,SETDIS ;SAVE THE STR INDEX
MOVE B,STRTAB(A) ;GET POINTER TO SDB
LOAD B,STRNAM,(B) ;GET SIXBIT NAME
MOVEM B,SETDNM ;SAVE IT IN CASE OF AN ERROR
HLRZ A,SETDIN ;GET UNIQUE CODE FOR REQUESTED STRUCTURE
LOAD B,CURUC ;GET UNIQUE CODE FOR CURRENTLY MAPPED STRUCTURE
CAME A,B ;REQUESTED STRUCTURE ALREADY MAPPED ?
JRST SETDI1 ;NO, GO MAP DESIRED DIRECTORY ON THAT STRUCTURE
MOVE A,DIRORA ;YES, GET STARTING ADDRESS OF MAP AREA
SKIPN DRMAP ;CHECK FOR MAPPED
JRST SETDI1 ;NO -- GO MAP IT
SETDIB: CALL FPTA ;GET IDENT OF FIRST PAGE
JUMPE T1,SETDI1 ;IF NO SECTION, NOT MAPPED
CALL MRPACS ;Read access of page
TLNN A,(1B5) ;PAGE EXIST?
JRST SETDI1 ;NO, NO DIR MAPPED IN
HRRZ A,SETDIN ;GET DIRECTORY NUMBER BACK
MOVE B,DIRORA ;GET START OF MAPPED AREA
LOAD C,DRTYP,(B) ;GET DIRECTORY BLOCK TYPE
CAIE C,.TYDIR ;VERIFY THAT WE HAVE A GOOD DIR MAPPED
JRST SETDI1 ;DIRECTORY IS BAD, MAP IN DESIRED DIR
LOAD B,DRNUM,(B) ;GET DIR NUMBER OF MAPPED DIR
CAMN A,B ;different?
JRST SETDI2 ;NO, REQUESTED DIRECTORY ALREADY MAPPED
SETDI1: HRRZ A,SETDIN ;GET DIR NUMBER TO MAP
MOVE B,SETDIS ;GET STRUCTURE NUMBER
CALL MAPDIR ;Must map it first
JRST SETDI6 ;COULD NOT MAP THE DIR
SETDI2: HRRZ A,SETDIN ;GET DESIRED DIR NUMBER
CALL DR0CHK ;MAKE SURE DIRECTORY HEADER IS GOOD
JRST SETDI6 ;HEADER NOT GOOD, BOMB OUT
CALL FBTINI ;CHECK FOR A GOOD FREE BIT TABLE
HRRZ A,SETDIN ;GET BACK DIR NUMBER
MOVE B,SETDIS ; AND STR NUMBER
CALL LCKDNM ;LOCK THE DIRECTORY
HRRZ A,SETDIN ;GET BACK DIR NUMBER
RETSKP
SETDI6: MOVEM A,SETDIE ;SAVE THE ERROR CODE
MOVE A,SETDIS ;GET STRUCTURE NUMBER
CALL ULKSTR ;UNLOCK THE STR
MOVE A,SETDIE ;GET ERROR CODE AGAIN
RET ;AND RETURN NON-SKIP
REPEAT 0,< ;[8946] Not used!
SETDI4: HRRZ A,SETDIN ;GET DIR NUMBER (RH ONLY)
MOVE D,SETDNM ;GET THE SIXBIT STRUCTURE NAME
BUG.(CHK,DIRBAD,DIRECT,HARD,<SETDI4 - Smashed directory number>,<<A,DIRNUM>,<D,STRNUM>>,<
Cause: No path to this bugchk.
Data: DIRNUM - Directory number
STRNAM - Sixbit structure number
>,,<DB%NND>) ;[7.1210]
OKINT
RETBAD (DELFX6)
> ;[8946] End of repeat 0
;ROUTINE TO INITIALIZE THE FREE BIT TABLE IF NECESSARY
; CALL FBTINI
;RETURNS +1: ALWAYS
FBTINI: MOVE D,DIRORA ;GET BASE ADR OF DIR AREA
LOAD C,DRFBT,(D) ;GET ADR OF FREE BIT TABLE
JUMPE C,FBTIN0 ;IF NONE, TRY TO CREATE ONE
ADD C,DIRORA ;GET ABS ADR OF TABLE
LOAD B,BLKTYP,(C) ;CHECK FOR LEGAL BLOCK TYPE
CAIE B,.TYFBT ;MUST BE THE FREE BIT TABLE
JRST FBTIN1 ;ILLEGAL, GO CREATE ONE
LOAD B,BLKLEN,(C) ;GET LENGTH OF FREE TABLE
CAML B,FBTSIZ ;IS IT BIG ENOUGH?
RET ;YES, THE FREE BLOCK IS OK
FBTIN0: LOAD B,DRFBT,(D) ;FIRST, RELEASE OLD TABLE
JUMPE B,FBTIN1 ;IF ANY
CALL RELDFR ;RELATIVE POINTER
FBTIN1: MOVE D,DIRORA ;SET UP OFFSET AGAIN
SETZRO DRFBT,(D) ;CLEAR OUT POINTER TO OLD TABLE
MOVE B,FBTSIZ ;GET A BLOCK FOR THE FREE BIT TABLE
CALL ASGDFR
RET ;NO ROOM FOR TABLE, ALWAYS LOOK AT PAGE
MOVE D,DIRORA ;GET BASE ADR OF DIR
MOVEI B,.TYFBT ;SET UP BLOCK TYPE
STOR B,BLKTYP,(A) ;IN NEW FREE BIT TABLE
LOAD B,BLKLEN,(A) ;GET LENGTH OF BLOCK
MOVE C,A ;SET UP TO INITIALIZE TABLE
FBTIN2: SOJLE B,FBTIN3 ;INITIALIZED TABLE YET?
SETOM 1(C) ;NO, SET ALL BITS TO 1
AOJA C,FBTIN2 ;LOOP BACK TILL ALL WORDS SET
FBTIN3: SUB A,DIRORA ;GET RELATIVE ADR OF TABLE
STOR A,DRFBT,(D) ;SAVE ADR OF TABLE IN DIR HEADER
RET
;UPDATE DIRECTORY -- GET PAGES COPIED TO DSK
; DIRECTORY MAPPED AS USUAL
; CALL UPDDIR
; RETURNS +1 ALWAYS
UPDDRR::EA.ENT
SAVET ;ENTRY POINT FOR NOT UPDATING DRUDT
JRST UPDDR1
UPDDIR::EA.ENT
SAVET ;PRESERVE TEMPORARIES
CALL UPDDTM ;UPDATE THE LAST DIR WRITE TIME
UPDDR1: OPSTR <HRLZ A,>,DIROFN ;GET THE OFN,,0 OF THE MAPPED DIR
MOVE B,NDIRPG ;GET LENGTH OF DIRECTORY
CALL UPDPGS ;UPDATE DIRECTORY PAGES
LOAD A,DIROFN ;GET THE OFN
CALL UPDOFN ;UPDATE IT TOO
RET
;ROUTINE TO SET TIME AND DATE INTO DRUDT (DIR UPDATE TIME)
;ASSUMES DIR IS MAPPED
; CALL UPDDTM
;RETURNS +1: ALWAYS, WITH DATE AND TIME IN A
UPDDTM::EA.ENT
CALL LGTAD ;GET CURRENT DATE AND TIME
MOVE B,DIRORA ;NOW GET BASE ADDRESS INTO DIR
CAME A,[-1] ;TIME BEEN SET YET?
STOR A,DRUDT,(B) ;YES, UPDATE TIME OF LAST DIR CHANGE
RET ;RETURN WITH TIME IN A
; Unlock directory
USTDIR::EA.ENT
ULKDIR ;UNLOCK THE DIRECTORY
OKINT
RET
;UNLOCK MAPPED DIRECTORY -- INVOKED VIA ULKDIR MACRO
;CLOBBERS NO ACS
ULKMD0::EA.ENT
PUSH P,T1 ;SAVE AN AC
PUSH P,T2
MOVE T1,DIRORA ;FIRST VERIFY THAT A DIR IS MAPPED
LOAD T1,DRTYP,(T1) ;THE DIRECTORY BLOCK TYPE MUST BE GOOD
CAIE T1,.TYDIR ;...
JRST ULKMD2 ;DONT UNLOCK GARBAGE
MOVE T1,DIRORA ;GET BASE ADDRESS OF DIR
LOAD T1,DRNUM,(T1) ;GET DIR # OF MAPPED DIR
CALL ULKDNM ;UNLOCK DIR
ULKMD1: LOAD T1,CURSTR ;GET THE STRUCTURE NUMBER
CALL ULKST1 ;UNLOCK THE STR ALSO
JRST PA2 ;AND RETURN
ULKMD2: MOVE T1,DIRORA ;GET DIR NUMBER
LOAD T1,DRNUM,(T1) ; FOR SYSERR REPORT
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRULK,DIRECT,HARD,<ULKMD2 - Attempt to unlock illegally formatted directory>,<<T1,DIRNUM>,<T2,STRNAM>>,<
Cause: Either there was an attempt to unlock a directory that is disordered,
or a bad argument was given to a subroutine to unlock directory.
Action: Use the DOB% facility to take a dump of this BUGCHK. If you have a
reliable case for reproducing this problem, please include this
procedure when you submit the dump as an SPR.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
JRST ULKMD1
;DIRECTORY LOCK/UNLOCK
;DIRECTORY IS LOCKED IF ITS NUMBER APPEARS IN TABLE LDTAB.
;FORKS WHICH ARE WAITING FOR A DIRECTORY TO BE UNLOCKED ARE
;MARKED IN BIT TABLE LCKDBT. WHEN A DIRECTORY IS UNLOCKED,
;THIS BIT TABLE IS SCANNED, AND THE FIRST FORK FOUND
;WAITING FOR THE DIRECTORY IS UNBLOCKED.
;STORAGE IN STG.MAC
EXTN <LCKDBT,LCKDBN>
EXTN <LKDTST,LKDSPT> ;RESIDENT SCHED TESTS
;STORAGE
NLDTAB==:20 ;LENGTH OF LOCK TABLE
NR LDTAB,NLDTAB ; STRNUM,,DIRNUM
NR LDTBF,NLDTAB ; FLAGS,,FORKX
RS MLDTAB,1 ;HIGHEST ENTRY IN USE IN LDTAB
NR LDTLCK,1 ;LOCK ON LDTAB
;FLAGS IN LDTAB
LCKDFF==1B0 ;ENTRY IS FREE
LKDWTF==1B1 ;ANOTHER FORK IS WAITING
DEFSTR (LDTFK,LDTBF,35,18) ;FORK INDEX IN LDTBF
;ROUTINE TO SEARCH TABLE FOR GIVEN DIRECTORY NUMBER
; T1/ DIRECTORY NUMBER
; T2/ STRUCTURE NUMBER
; CALL LCKDSC
; RETURN +1, NOT FOUND, Q1/ FIRST FREE ENTRY OR -1
; RETURN +2, FOUND, Q1/ INDEX OF ENTRY
; T1/ STRNUM,,DIRNUM
LCKDSC: HRL T1,T2 ;FORM FULL TABLE ENTRY
SETO Q1, ;INIT PLACE TO REMEMBER FREE ENTRY
HRLZ Q2,MLDTAB ;GET LIMIT OF TABLE
MOVN Q2,Q2 ;INIT AOBJN PTR
JUMPGE Q2,R ;QUIT NOW IF TABLE EMPTY
LCKDS2: SKIPG Q3,LDTAB(Q2) ;SKIP IF ENTRY IS INUSE
JRST [ SKIPGE Q1 ;FREE ENTRY, HAVE ONE ALREADY?
HRRZ Q1,Q2 ;NO, REMEMBER THIS ONE
JRST LCKDS1]
CAMN T1,Q3 ;WANT THIS ONE?
JRST [ HRRZ Q1,Q2 ;YES, RETURN INDEX
RETSKP]
LCKDS1: AOBJN Q2,LCKDS2 ;SCAN TABLE
RET ;NOT FOUND
;LOCK DIRECTORY
; A/ DIRECTORY NUMBER
; B/ STR #
; CALL LCKDNM
; RETURN +1 ALWAYS, DIRECTORY LOCKED, AND CSKED.
;BLOCK UNTIL ABLE TO LOCK
;FORK MUST BE NOINT WHILE DIRECTORY LOCKED.
REPEAT 0,< ;CFSCOD NO LONGER USED
IFE CFSCOD,<
LCKDNM::EA.ENT
SAVEQ
STKVAR <LCKSV>
LCKDI0: CSKED ;BE SURE WE GET REASONABLE SCHEDULING
LOCK LDTLCK ;LOCK TABLE
CALL LCKDSC ;SEARCH FOR GIVEN DIRNUM
JRST LCKDI3 ;NOT FOUND, ENTER IT
MOVX Q2,LCKDFF ;ALREADY IN TABLE
TDNE Q2,LDTBF(Q1) ;ENTRY NOW FREE?
JRST [ ANDCAM Q2,LDTBF(Q1) ;YES, GRAB IT
JRST LCKDI5]
LOAD Q2,LDTFK,(Q1) ;FORK OWNING LOCK
CAMN Q2,FORKX ;THIS FORK?
BUG.(HLT,LCKDIR,DIRECT,SOFT,<Attempt to lock directory twice for same fork>,,<
Cause: A fork is trying to lock a directory it has already locked. This
BUGHLT does not occur since the code is not in the monitor any more.
>)
MOVX Q2,LKDWTF ;DIRECTORY ALREADY LOCKED
IORM Q2,LDTBF(Q1) ;NOTE THIS FORK WAITING FOR IT
MOVEM T1,LCKSV ;SAVE ARGS
HRLZ T1,Q1 ;INDEX INTO LDTAB TO WAIT FOR
HRRZ Q1,FORKX ;SET BIT IN FORK BIT TABLE
IDIVI Q1,^D36
MOVE Q2,BITS(Q2)
IORM Q2,LCKDBT(Q1)
UNLOCK LDTLCK ;UNLOCK TABLE
ECSKED ;NO LONGER NEED SPECIAL SCHEDULING
HRRI T1,LKDTST ;ROUTINE FOR SCHEDULER
MDISMS ;BLOCK UNTIL DIR UNLOCKED
LCKDI1: HRRZ T1,LCKSV ;RESTORE ARGS (DIRECTORY NUMBER)
HLRZ T2,LCKSV ; STRUCTURE NUMBER
JRST LCKDI0 ;TRY AGAIN
;ASSIGN NEW ENTRY FOR DIR NUM
LCKDI3: IFL. Q1 ;FREE ENTRY TO REUSE?
MOVE Q1,MLDTAB ;NO, USE NEXT ONE AT END
CAIL Q1,NLDTAB ;TABLE FULL?
JRST LCKDI4 ;YES, BLOCK UNTIL ROOM
AOS MLDTAB ;INCREMENT END
ENDIF.
MOVEM T1,LDTAB(Q1) ;SETUP ENTRY
MOVX Q2,LCKDFF!LKDWTF ;CLEAR THESE
ANDCAM Q2,LDTBF(Q1) ;...
LCKDI5: MOVE Q2,FORKX ;NOTE FORK OWNING LOCK
STOR Q2,LDTFK,(Q1)
UNLOCK LDTLCK ;UNLOCK TABLE
RET
;TABLE FULL (SHOULD HAPPEN VERY RARELY)
LCKDI4: UNLOCK LDTLCK ;UNLOCK TABLE
ECSKED ;NO LONGER CRITICLA
MOVEM T1,LCKSV ;SAVE ARGS
MOVEI T1,LKDSPT ;SETUP SCHED TEST
MDISMS ;DISMISS UNTIL ROOM IN TABLE
JRST LCKDI1 ;TRY AGAIN
;UNLOCK DIRECTORY
; T1/ DIRECTORY NUMBER
; CALL ULKDIR
; RETURN +1 ALWAYS, DIRECTORY UNLOCKED
;PRESERVES T3,T4
ULKDNM::SAVEQ
EA.ENT
LOCK LDTLCK ;LOCK TABLE
LOAD T2,CURSTR ;CURRENT STRUCTURE
CALL LCKDSC ;SEARCH TABLE FOR DIRNUM
JRST ULKDI7 ;NOT FOUND, SOMEBODY CONFUSED
MOVX Q2,LKDWTF
TDNE Q2,LDTBF(Q1) ;ANOTHER FORK WAITING FOR THIS?
JRST ULKDI1 ;YES
ULKDI5: SETOM LDTAB(Q1) ;RELEASE ENTRY
MOVE Q2,MLDTAB ;CHECK END OF TABLE
SKIPGE LDTAB-1(Q2) ;LAST ENTRY DELETED?
JRST [ SOSE Q2,MLDTAB ;YES, LOWER END
JRST .-1 ;CHECK NEW LAST ENTRY
JRST .+1] ;TABLE EMPTY
ULKDI8: UNLOCK LDTLCK ;UNLOCK TABLE
ECSKED ;NO LONGER CRITICAL
RET
ULKDI7: CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRDNX,DIRECT,SOFT,<ULKDIR - Directory not locked or directory number wrong>,<<T1,DIRNUM>,<T2,STRNAM>>,<
Cause: There has been an attempt to unlock a directory that was never locked.
Or a directory number is wrong. This BUG will not appear in the field
since it is under REPEAT 0 because CFS handles this now.
Action: Use the DOB% facility to produce a dump. Also, if you can reproduce
this case reliably, indicate the procedure on the SPR.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
UNLOCK LDTLCK
ECSKED ;NO LONGER CRITICAL
RET
;OTHER FORK(S) WAITING FOR DIR JUST UNLOCKED - TRY TO FIND ONE
;AND WAKE IT UP.
ULKDI1: SAVET ;NEED MORE AC'S HERE
STKVAR <SAVSTS> ;SAVE FORK'S STATUS HERE
MOVSI T4,-LCKDBN ;SETUP TO SCAN BIT TABLE
ULKDI2: SKIPE Q2,LCKDBT(T4) ;ANY BITS HERE?
ULKDI3: JFFO Q2,ULKDI6 ;YES, FIND ONE
ULKDI4: AOBJN T4,ULKDI2 ;SCAN BIT TABLE
JRST ULKDI5 ;FOUND NO FORK, DELETE TABLE ENTRY
ULKDI6: TDZ Q2,BITS(Q3) ;REMOVE BIT JUST FOUND
HRRZ T3,T4 ;COMPUTE FORK NUMBER
IMULI T3,^D36
ADD T3,Q3
LOAD T2,FKSTX,(T3) ;GET BLOCK TEST WORD FOR FORK
MOVEM T2,SAVSTS ;SAVE IT AWAY
HRRZS T2 ;GET ROUTINE NAME
CAIE T2,LKDTST ;STILL WAITING FOR DIRECTORY?
JRST [ MOVE T2,BITS(Q3) ;NO, REMOVE IT FROM BIT TABLE
ANDCAM T2,LCKDBT(T4)
JRST ULKDI3] ;SEE IF OTHER BITS IN THIS WORD
HLRZ T2,SAVSTS ;GET DIR NUMBER
CAME T2,Q1 ;THIS ENTRY?
JRST ULKDI3 ;NO, BYPASS BIT
MOVX T2,LCKDFF ;YES, MARK TABLE WORD AS FREE
IORM T2,LDTBF(Q1) ;BUT LEAVE ENTRY IN TABLE
MOVE T2,BITS(Q3) ;WAKE FORK UP
ANDCAM T2,LCKDBT(T4)
MOVE T1,T3 ;FORK INDEX
CALL UNBLKF ;UNBLOCK IT
JRST ULKDI8 ;UNLOCK TABLE AND RETURN
> ;IFE CFSCOD
> ;END REPEAT 0
;Code to lock/unlock directories
;This code uses a separate CFS lock so that read/only sharing
;works efficiently. That is, by not using the file token, the
;locker of the directory determines implicitly what kind of
;file access in needed.
;Same args and conditions as above
; IFN CFSCOD,<
LCKDNM::EXCH T1,T2 ;PUT ARGS IN RIGHT ORDER
CALLRET CFSLDR ;LOCK 'ER UP AND RETURN
ULKDNM::SAVET
MOVE T2,T1 ;COPY NUMBER
LOAD T1,CURSTR ;GET STRUCTURE NUMBER
CALLRET CFSRDR ;RELEASE IT
; > ;IFN CFSCOD
;MAP DIRECTORY INTO USUAL AREA AT DIRORG
;ACCEPTS IN A/ DIRECTORY NUMBER
; B/ STRUCTURE NUMBER
; CALL MAPDIR
;RETURNS +1: ERROR, NON-EXISTANT DIR OR DIR SCREWED UP
; +2: DIRECTORY IS MAPPED (BUT NOT LOCKED)
MAPDIR::EA.ENT
STKVAR <MAPDIN,MAPDIS,MAPCSH>
MOVEM A,MAPDIN ;SAVE DIR # TO BE MAPPED
MOVEM B,MAPDIS ;SAVE STRUCTURE NUMBER
CAIGE B,STRN ;STRUCTURE NUMBER TOO HIGH ?
SKIPGE B ; OR NEGATIVE ?
RETBAD (DIRX1) ;INVALID STRUCTURE #
SKIPLE A ;ZERO OR NEGATIVE IS FATAL
CAML A,MXDIRN ;IS THIS A LEGAL DIR #?
RETBAD (DIRX1) ;NO, GIVE ERROR RETURN
CALL UNMAPD ;UNMAP PREVIOUS DIR
MOVE A,MAPDIS ;GET STRUCTURE NUMBER
CALL MAPIDX ;GO MAP INDEX TABLE FOR THIS STRUCTURE
RETBAD ;COULD NOT MAP INDEX TABLE
MOVE A,MAPDIN ;GET DESIRED DIR #
CAIN A,ROOTDN ;IS THIS THE ROOT DIR BEING ASKED FOR
JRST [ MOVE A,MAPDIS ;GET STRUCTURE NUMBER
MOVE A,STRTAB(A) ;GET SDB ADDRESS
LOAD A,STRRDO,(A) ;GET OFN OF ROOT-DIRECTORY
SETZRO DRROF ;INDICATE UNMAPD SHOULD NOT RELEASE OFN
JRST MAPDI2] ;SKIP DOING AN ASOFN FOR ROOT DIR
MOVEI D,DIRCSZ ;CHECK FOR CACHE SIZE
JUMPE D,MAPASO ;NO CACHE
MOVEI B,DIRCSH ;GET CACHE TABLE
MOVE C,MAPDIS ;GET STRUCTURE NUMBER
MOVE C,STRTAB(C) ;GET TABLE POINTER
HLL C,SDBFLK(C) ;GET UNIQUE CODE
HRR C,MAPDIS
LOCK DIRCLK ;LOCK CACHE TABLE
MAPDL: CAME A,DCDIRN(B) ;CHECK FOR DIRECTORY MATCH
JRST MAPNOF ;NOT THIS ONE
CAME C,DCSTRN(B) ;CHECK STRUCTURE NUMBER
JRST MAPNOF ;NOPE HERE EITHER
AOS DCSHRC(B) ;UPDATE OFN IN USE COUNT
MOVE C,TODCLK ;SET TIME LAST USED
MOVEM C,DCSTIM(B)
SETZRO DRROF ;INSURE WE DON'T RELEASE THIS ONE
MOVEM B,MAPCSH ;SAVE CACHE ENTRY ADDRESS
CALL GETIDX ;SEE IF THERE IS AN IDX ENTRY
JRST [ MOVE B,MAPCSH ;GET ENTRY BACK
CALL MAPFGX ;AND RELEASE IT
UNLOCK DIRCLK
RET] ;RETURN
MOVE B,MAPCSH ;GET CACHE ENTRY
MOVE A,DCSOFN(B) ;GET OFN
TXNE D,IDX%IV ;CHECK TO SEE IF LEGAL
JRST [ MOVEI A,DIRX3 ;ILLEGAL FOR DELETED DIRECTORY
CALL MAPFGX ;RELEASE OFN
UNLOCK DIRCLK
RET] ;RETURN
UNLOCK DIRCLK ;UNLOCK CACHE
JRST MAPDI0
MAPNOF: ADDI B,DCSIZE ;LOOK AT NEXT ENTRY
SOJG D,MAPDL
MAPASO: CALL GETIDX ;[7398] (T1/T1,T2,T3,T4)
JRST MAPAER ;[7398] (T1/)Error - unlock cache and return
TXNN D,IDX%IV ;[7398] Directory entry marked invalid?
IFSKP. ;[7398] Yes
MOVX T1,DIRX3 ;[7398] Get appropriate error code
JRST MAPAER ;[7398] (T1/)Unlock cache and return error
ENDIF. ;[7398]
MOVE A,B ;GET ADDRESS OF INDEX BLOCK
TXO A,FILWB+THAWB+OFNDUD+OFNDU0 ;WRITE, THAWED, AND NO AUTO-UPDATE
MOVE B,MAPDIS ;GET STRUCTURE NUMBER
CALL ASROFN ;[7398] (T1,T2/T1)Assign an OFN for file
JRST MAPAER ;[7398] (T1/)Error, none available
MOVEI B,DIRCSH ;GET CACHE ADDRESS
MOVEI C,DIRCSZ ;GET SIZE OF CACHE
JUMPE C,[ SETONE DRROF ;INDICATE UNMAP SHOULD RELEASE OFN
JRST MAPDI2]
MOVE D,TODCLK ;START WITH CURRENT TIME
SETZM MAPCSH ;INDICATE NONE FOUND YET
MAPELP: SKIPN DCDIRN(B) ;QUICK CHECK FOR FREE ENTRY
JRST [ MOVEM B,MAPCSH ;SAVE CACHE ENTRY ADDRESS
JRST MAPFIN] ;AND QUIT
SKIPN DCSHRC(B) ;CHECK TO SEE IF DORMANT ENTRY
IFSKP.
SOSE DCSHRC(B) ;CHECK TO SEE IF ENTRY IS 1 SINCE WE CAN RELEASE THIS CASE
AOSA DCSHRC(B) ;NO GET IT BACK TO THE OLD STATE
AOSA DCSHRC(B)
JRST MAPELN ;TRY NEXT ENTRY THIS ONE CAN'T BE BOTHERED
ENDIF.
CAMGE D,DCSTIM(B) ;CHECK TIME
JRST MAPELN ;NOT OLDEST TRY NEXT ONE
MOVE D,DCSTIM(B) ;SET NEW OLDEST
MOVEM B,MAPCSH ;SAVE POINTER TO THIS ONE
MAPELN: ADDI B,DCSIZE ;GO TO NEXT ENTRY
SOJG C,MAPELP ;GO ON TO NEXT ONE
SKIPN B,MAPCSH ;CHECK TO SEE IF ENTRY FOUND
JRST [ SETONE DRROF ;INDICATE TO RELEASE THIS
UNLOCK DIRCLK ;RELEASE LOCK
JRST MAPDI2]
MAPFIN: EXCH A,DCSOFN(B) ;SET NEW OFN
MOVE C,TODCLK ;SET NEW TIME
MOVEM C,DCSTIM(B) ;STORE NEW TIME
JUMPE A,MAPDRO ;DON'T RELEASE IF THERE IS NONE
SKIPN DCSHRC(B) ;DON'T RELEASE IT IF IT WAS 1 (NOTE
;HERE IT IS EITHER 0 OR 1)
CALL RELOFN ;RELEASE OFN
MAPDRO: MOVE B,MAPCSH ;GET CACHE ENTRY
MOVEI C,1 ;SET SHARE COUNT TO 1
MOVEM C,DCSHRC(B)
MOVE C,MAPDIN ;GET DIRECTORY ENTRY
MOVEM C,DCDIRN(B) ;SAVE IT
MOVE C,MAPDIS ;GET DIRECTORY NUMBER
MOVE C,STRTAB(C) ;NEED UNIQUE CODE
MOVE C,SDBFLK(C)
HRR C,MAPDIS ;GET FULL UNIQUE CODE
MOVEM C,DCSTRN(B) ;SAVE STRUCTURE UNIQUE CODE
MOVE A,DCSOFN(B) ;GET OFN
UNLOCK DIRCLK ;UNLOCK CACHE
MAPDI0: MOVEM B,DIRCAD ;STORE CACHE ADDRESS
MAPDI2: STOR A,DIROFN ;SAVE THIS OFN
CALL MAPDRP ;MAP DIRECTORY PAGE
MOVE A,MAPDIN ;RESTORE DIRECTORY NUMBER
BP$022: ;BREAKPOINT FOR ASOFN FOR DIRECTORIES
;ASSUMES T1 HAS DIRECTORY# AND OFN IS
;IN DIROFN USUALLY, IN RDOFN IF T1=ROOTDN
RETSKP ;AND EXIT
;[7398] MAPAER - Routine called from MAPASO upon error
;[7398]
;[7398] Accepts: T1/ Error code to return, if any
;[7398]
;[7398] Usage: JRST MAPAER
;[7398]
;[7398] This code checks to see if there is a directory cache in use.
;[7398] If not, then it simply returns with the error code in T1.
;[7398] If there is a directory cache, then the cache is unlocked and
;[7398] the error code is returned in T1.
;[7398]
;[7398] NOTE: This routine expects to be called when either there is no
;[7398] directory cache in use, or with the directory cache in use and locked.
MAPAER: MOVEI B,DIRCSZ ;[7398] Check for cache size
JUMPE B,R ;[7398] No cache, just return
UNLOCK DIRCLK ;[7398] Unlock directory cache
RET ;[7398] Return error to caller
;ROUTINE TO CLEAR CACHE OF A SPECIF ENTRY IF SHARE COUNT IS 0 OR 1
MAPFGX: SAVET ;SAVE ACS
MOVE A,DCSHRC(B) ;GET SHARE COUNT
SOJG A,R ;DON'T RELEASE UNLESS SHARE COUNT IS 0 OR 1
JRST MAPFGC ;DO COMMON STUFF
;ROUTINE TO CLEAR CACHE OF A SPECIFIC ENTRY IF IT'S SHARE COUNT IS 0
MAPFGA: SAVET ;SAVE AC'S
SKIPE A,DCSHRC(B) ;GET SHARE COUNT
RET ;DON'T RELEASE UNLESS SHARE COUNT IS 0
MAPFGC: SETZ A,0 ;ZERO OFN
EXCH A,DCSOFN(B) ;GET OLD OFN
JUMPE A,R ;IF NO OFN QUIT
SETZM DCDIRN(B) ;CLEAR CACHE ENTRIES
SETZM DCSTRN(B)
SETZM DCSHRC(B)
SETZM DCSTIM(B)
CALL RELOFN ;RELEASE THE OFN
RET ;GO BACK TO CALLER
;ROUTINE TO CLEAR CACHE OF NULL ENTRIES
DIRCFL::SAVET ;SAVE TEMPS
MOVEI D,DIRCSZ ;CHECK CACHE SIZE
JUMPE D,R ;QUIT NO CACHE
MOVEI B,DIRCSH ;GET POINTER TO CACHE
DRFL1: CALL MAPFGA ;RELEASE IT IF 0
ADDI B,DCSIZE ;LOOK AT NEXT ENTRY
SOJG D,DRFL1 ;NO TRY NEXT ONE
RET ;RETURN
;MAPDRP -- DOES REAL MAP OF DIRECTORY PAGE TO SECTION 2
;ACCEPTS OFN IN A
MAPDRP: MOVE B,SHRPTR ;MAKE A SHARE POINTER
HRR B,A ;POINT TO OFN
MOVEM B,DRMAP ;SET SHARE POINTER IN PSB
CALL UPSHR ;INCREMENT OFN SHARE COUNT
CALLRET MONCLA ;CLEAR HARDWARE PAGE TABLE AND RETURN
;ROUTINE TO UNMAP A DIRECTORY FOR A FORK
; CALL UNMAPD
;RETURNS +1: ALWAYS
UNMAPD::EA.ENT
HRRZ A,DRMAP ;GET OFN
IFN. A ;If we have one
TXO A,FILUB ;Don't decrement open count
CALL RELOFN ;DECREMENT OFN SHARE COUNT
ENDIF.
SETZM DRMAP ;CLEAR MAP SHARE POINTER
CALL MONCLA ;CLEAR HARDWARE PAGE TABLE
UNMAP1: LOAD A,DIROFN ;GET THE LAST OFN
JUMPE A,R ;IF NONE, RETURN NOW
SETZ B,0 ;FREE DIRCAD ALWAYS
EXCH B,DIRCAD ;GET OLD CACHE POINTER
JUMPE B,UNMAP2 ;NONE ALL DONE
LOCK DIRCLK ;LOCK CACHE
CAME A,DCSOFN(B) ;IS THIS THE SAME OFN?
JRST [ UNLOCK DIRCLK ;NO -- UNLOCK CACHE
JRST UNMAP3] ;RELEASE THE OFN
SOS DCSHRC(B) ;UPDATE THE LOCK COUNT
UNLOCK DIRCLK ;RELEASE LOCK
RET ;QUIT
UNMAP2: JE DRROF,,R ;IF NOT RELEASING OFN, RETURN
UNMAP3: SETZRO DIROFN ;CLEAR OUT OFN FROM PSB
SETZRO DRROF ; AND FLAG FOR RELEASING OFN
CALL RELOFN ;RELEASE THE OFN
RET ;AND RETURN
;ROUTINE TO SET THE NONX BIT IN STS AND FILSTS
; CALL SETNXF
;RETURNS +1: ALWAYS
SETNXF: PUSH P,T1 ;SAVE ALL ACS USED
MOVX T1,NONXF ;GET BIT TO SET
IORM T1,FILSTS(JFN) ;SET BIT
TQO <NONXF> ;SET BIT IN STS ALSO
JRST PA1 ;RETURN RESTORING T1
; Multiple directory device directory lookup routine
; Call: A ;FULLWORD Directory number
; B ;UNIT NUMBER (NOT USED FOR DISK) OR .RCUSR (IF FROM THERE)
; C ;ADR OF BLOCK CONTAINING A WILD MASK (OR 0 IF NONE)
; CALL MDDDIR
; Returns
; +1 ; No such directory
; +2 ; Ok, the directory is mapped and locked
;THE ALGORITHIM USED IS A PREORDER TRANSITION WHOSE STACK USAGE
;IS INDEPENDENT OF TREE HEIGHT. THE ALGORITHM IS NOT RECURSIVE IN
;THE CONVENTIONAL SENSE. BY USING A PREORDER TRANSITION AND BY HAVING
;UPWARD LINKS AVAILABLE FROM EACH NODE AND BY KNOWING THAT THERE IS
;A CONSTANT ORDERING FUNCTION AVAILABLE FOR THE SUBDIRECTORIES OF
;EACH DIRECTORY IT IS POSSIBLE TO WALK THE TREE WITH CONSTANT STACK
;CONSUMPTION. NOTE THAT IF DIRECTORIES ARE CREATED DURING A TRANSITION
;BY THIS CODE NO MALFUNCTION (LOOP) OCCURS. THE NEW DIRECTORY WILL
;EITHER BE TOUCHED OR NOT - NO CONFUSION RESULTS AS WOULD HAPPEN WITH
;MOST COMMON RECURSIVE ALGORITHMS.
MDDDIR::EA.ENT
SAVEQ
STKVAR <MDDDNO,MDDFLG,MDDDWS,MDDDPT,<MDDDNM,MAXLW>>
MOVEM T1,MDDDNO ;SAVE ARGUMENT
CAIN T2,.RCUSR ;CALL FROM .RCUSR?
TDZA T2,T2 ;YES
MOVEI T2,1 ;NO
MOVEM T2,MDDFLG ;SAVE FLAG
MOVEM T3,MDDDWS ;SAVE POINTER TO WILD MASK IF ANY
TQNE <STEPF> ;STEPPING ANYTHING?
TQNN <DIRSF> ;STEPPING DIRS?
SKIPA ;NO TO EITHER QUESTION
JRST MDDDI1 ;YES TO BOTH QUESTIONS
TXNN F1,DIRSF!NAMSF!EXTSF!VERSF ;NOTHING BEING STEPPED?
TXNN F1,GNJFF ;AND DOING A GNJFN?
SKIPA ;NO
ERRJMP (GJFX32,MDDERT) ;YES, SAY NO MORE DIRECTORIES
CALL SETDRR ;JUST SETUP REQUESTED DIRECTORY
JRST MDDERT ;COULDNT - GIVE ERROR
MDDDRT: MOVE T1,MDDDNO ;RESTORE ARGUMENT
RETSKP ;SUCCESS RETURN
MDDERT: RETBAD() ;ERROR RETURN
;HERE WHEN STEPPING DIRECTORIES.
;FOR THE DIRECTORY SEARCHES BELOW, THE Q REGISTERS ARE USED AS FOLLOWS:
;Q1/ SYMBOL TABLE POINTER
;Q2/ POINTER TO CURRENT EXTENSION FDB
;Q3/ POINTER TO CURRENT GENERATION FDB
;ALL POINTERS ARE ABSOLUTE
MDDDI1: TRNE T1,-1 ;FIRST TIME?
JRST MDDDI2 ;NO
HRRI T1,ROOTDN ;YES - BEGIN WITH THE ROOT
MOVEM T1,MDDDNO ;SAVE CURRENT DIR
MOVE T2,MDDFLG ;GET .RCUSR FLAG
CALL @[IFIW!SETDIR
IFIW!SETDRR](T2) ;TRY TO MAP IT
JRST MDDDI2 ;COULDNT - TRY REST OF TREE
JRST MDDDRT ;SUCCESS
MDDDI2: MOVE T1,MDDDNO ;GET CURRENT DIR
CALL SETDIR ;MAP IT
JRST MDDERT ;ERROR - RETURN CODE IN T1
MOVE T1,DIRORA ;GET DIR ORIGIN
LOAD T1,DRSDC,(T1) ;GET COUNT OF SUBDIRECTORIES
JUMPN T1,MDDDI8 ;IF ANY EXIST, FIND ONE TO RETURN
MDDDI3: CALL USTDIR ;NO SUBDIRECTORIES - FREE THIS ONE
MDDDI4: HRRZ T1,MDDDNO ;ARE WE BACK UP TO THE ROOT?
CAIN T1,ROOTDN ; ???
ERRJMP (GJFX32,MDDERT) ;YES - GIVE NO MORE DIRECTORIES RETURN
IMULI T1,.IDXLN ;NO - GET FDB AND SUPERIOR
SKIPN T2,FKXORA ;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
MOVE T2,IDXORA
ADD T1,T2 ; ...
LOAD Q1,IDXFB,(T1) ;GET FDB OF CURRENT DIR
ADD Q1,DIRORA ;AS ABSOLUTE ADDRESS
LOAD T1,IDXSD,(T1) ;GET SUPERIOR
HLL T1,MDDDNO ;BUILD FULLWORD DIR NUMBER
MOVEM T1,MDDDNO ;SAVE AS SOON TO BE CURRENT DIR
CALL SETDIR ;MAP SUPERIOR
JRST MDDERT ;ERROR - RETURN CODE IN T1
MOVE T4,DIRORA ;COPY DIR NAME TO MDDDNM
LOAD T4,DRNAM,(T4) ;GET POINTER TO NAME STRING IN DIR
ADD T4,DIRORA ;GET ABS ADR
MOVSI T3,(POINT 7,(T4),35) ;T3 IS POINTER TO NAME STRING
MOVEI T2,MDDDNM ;GET ADR OF STRING BLOCK
HRLI T2,(POINT 7,0) ;SET UP BYTE POINTER
HRRZ T1,MDDDNO ;GET DIR NUMBER OF DIRECTORY
CAIN T1,ROOTDN ;IS THIS THE ROOT DIRECTORY
JRST MDDI4B ;YES, DONT PUT ITS NAME IN THE STRING
MDDI4A: ILDB T1,T3 ;COPY NAME TO MDDDNM STRING
JUMPE T1,MDDI4B ;DONT COPY THE NULL
IDPB T1,T2 ;PUT CHAR IN STRING
JRST MDDI4A ;LOOP BACK FOR REST OF THE STRING
MDDI4B: MOVEM T2,MDDDPT ;SAVE POINTER TO END OF STRING
MOVE T1,Q1 ;COPY FDB ADDRESS
CALL FDBCHK ;BLESS THIS FDB
JRST MDDDI3 ;BAD FDB - GO UP A LEVEL AND RETRY
LOAD T1,FBNAM,(Q1) ;GET CURRENT DIRECTORY RELATIVE NAME
ADD T1,DIRORA ;AS ABSOLUTE ADDRESS
LOAD T2,NMLEN,(T1) ;GET LENGTH OF BLOCK
ADDI T1,1 ;SKIP HEADER
SUBI T2,2 ;CORRECT FOR HEADER
MOVEI T3,.ETNAM ;SEARCHING FOR A NAME BLOCK
CALL LOOKUP ;FIND CURRENT DIRS NAME
JRST MDDDI3 ;COULDNT - TRY UP ONE LEVEL
MOVE T4,DRLOC ;GET POINTER INTO SYMBOL TABLE
EXCH T4,Q1 ;INTO Q1 AND GET CURRENT DIR FDB IN T4
MDDDI5: LOAD Q2,SYMAD,(Q1) ;GET FIRST FDB OF THIS NAME
ADD Q2,DIRORA ;AS AN ABSOLUTE ADDRESS
MDDDI6: MOVE Q3,Q2 ;START GENERATION SEARCH HERE
MDDDI7: CAMN T4,Q3 ;FDB WE ARE LOOKING FOR?
JRST MDDDIC ;YES - NOW CONTINUE SCAN FOR OTHER DIRS
LOAD Q3,FBGNL,(Q3) ;NO - GET NEXT GENERATION FDB
ADD Q3,DIRORA ;ABSOLUTE ADDRESS
CAME Q3,DIRORA ;ANY MORE?
JRST MDDDI7 ;YES
LOAD Q2,FBEXL,(Q2) ;NO - TRY NEXT EXTENSION
ADD Q2,DIRORA ;ABSOLUTE ADDRESS
CAME Q2,DIRORA ;WAS THERE ONE?
JRST MDDDI6 ;YES
ADDI Q1,.SYMLN ;NO - TRY NEXT ENTRY IN SYMBOL TABLE
MOVE T1,DIRORA ;IS THIS
LOAD T1,DRSTP,(T1) ;THE TOP OF THE
ADD T1,DIRORA ;SYMBOL TABLE?
CAML Q1,T1 ; ???
JRST MDDDI3 ;YES - TRY UP A LEVEL
LOAD T1,SYMET,(Q1) ;STILL IN NAME PORTION
CAIE T1,.ETNAM ;OF SYMBOL TABLE?
JRST MDDDI3 ;NO
JRST MDDDI5 ;YES - LOOK IN THIS SET OF FDBS
;HERE WHEN THE CURRENT DIRECTORY HAS SUBDIRECTORIES. START LOOKING
;FOR THEM IN THE SYMBOL TABLE.
MDDDI8:
;COPY THE DIRECTORY STRING TO THE STACK FOR CHKWLD
MOVE T4,DIRORA ;COPY DIR NAME TO MDDDNM
LOAD T4,DRNAM,(T4) ;GET POINTER TO NAME STRING IN DIR
ADD T4,DIRORA ;GET ABS ADR
MOVSI T3,(POINT 7,(T4),35) ;T3 IS POINTER TO NAME STRING
MOVEI T2,MDDDNM ;GET ADR OF STRING BLOCK
HRLI T2,(POINT 7,0) ;SET UP BYTE POINTER
HRRZ T1,MDDDNO ;GET DIR NUMBER OF DIRECTORY
CAIN T1,ROOTDN ;IS THIS THE ROOT DIRECTORY
JRST MDDI8B ;YES, DONT PUT ITS NAME IN THE STRING
MDDI8A: ILDB T1,T3 ;COPY NAME TO MDDDNM STRING
JUMPE T1,MDDI8B ;DONT COPY THE NULL
IDPB T1,T2 ;PUT CHAR IN STRING
JRST MDDI8A ;LOOP BACK FOR REST OF THE STRING
MDDI8B: MOVEM T2,MDDDPT ;SAVE POINTER TO END OF STRING
MOVE Q1,DIRORA ;GET BOTTOM OF
LOAD Q1,DRSBT,(Q1) ;SYMBOL TABLE
ADD Q1,DIRORA ;AS AN ABSOLUTE ADDRESS
ADDI Q1,.SYMLN ;SKIP HEADER ENTRY
MDDDI9: LOAD Q2,SYMAD,(Q1) ;GET FDB FOR THIS SYMTAB ENTRY
ADD Q2,DIRORA ;ABSOLUTE ADDRESS
MOVE T1,Q2 ;GET FDB ADDRESS
CALL FDBCHK ;MAKE SURE THIS FDB IS VALID
JRST MDDDC0 ;NOT. SKIP IT
MDDDIA: MOVE Q3,Q2 ;START GENERATION SEARCH HERE
MDDDIB: MOVE T1,Q3 ;GET FDB ADDRESS
CALL FDBCHK ;VALIDATE IT
JRST MDDDC1 ;NOT VALID. SKIP IT
JN FBDIR,(Q3),MDDDID ;IS THIS FDB A DIRECTORY?
MDDDIC: LOAD Q3,FBGNL,(Q3) ;NO - TRY NEXT
ADD Q3,DIRORA ;GET ABSOLUTE ADDRESS
CAME Q3,DIRORA ;IS THERE ANOTHER?
JRST MDDDIB ;YES - EXAMINE IT
MDDDC1: LOAD Q2,FBEXL,(Q2) ;NO - TRY NEXT EXTENSION
ADD Q2,DIRORA ;ABSOLUTE ADDRESS
MOVE T1,Q2
CALL ADRCHK
JRST MDDDC0
CAME Q2,DIRORA ;YET ANOTHER EXTENSION?
JRST MDDDIA ;YES
MDDDC0: ADDI Q1,.SYMLN ;NO - TRY NEXT SYMTAB ENTRY
MOVE T1,DIRORA ;CHECK IF
LOAD T1,DRSTP,(T1) ;PAST THE END
ADD T1,DIRORA ;OF THE SYMBOL TABLE
CAML Q1,T1 ; ???
JRST MDDDI3 ;YES - NO MORE SUBDIRS OF THIS DIR
LOAD T1,SYMET,(Q1) ;STILL WITHIN BOUND,
CAIE T1,.ETNAM ;STILL IN NAME PORTION OF SYMTAB?
JRST MDDDI3 ;NO - HENCE UP A LEVEL
JRST MDDDI9 ;YES - EXAMINE THESE FILES
;HERE WHEN A FDB WITH FB%DIR IS FOUND. SEE IF IT CAN BE RETURNED.
MDDDID: LOAD T1,FBDRN,(Q3) ;GET DIR NUMBER OF POSSIBLE SUBDIR
JUMPE T1,MDDDIC ;IF NONE, KEEP LOOKING
MOVE T2,T1 ;GET IDXTAB ENTRY
IMULI T2,.IDXLN ; ...
SKIPN T4,FKXORA ;GET SPECIAL FORK IDXORA IF STR CREATION
MOVE T4,IDXORA
ADD T2,T4 ; ...
LOAD T2,IDXSD,(T2) ;GET SUPERIOR DIRECTORY
HRRZ T3,MDDDNO ;CHECK AGAINST CURRENT DIR
CAME T2,T3 ;SAME?
JRST MDDDIF ;NO
MDDDIE: CAIN T1,ROOTDN ;ROOT DIR?
JRST MDDDIC ;IGNORE LOOP IN DIR STRUCTURE
LOAD T4,FBNAM,(Q3) ;GET POINTER TO NAME BLOCK
ADD T4,DIRORA ;GET ABS ADR OF NAME BLOCK
MOVSI T3,(POINT 7,(T4),35) ;T3 IS BYTE POINTER TO NAME
MOVE T2,MDDDPT ;GET POINTER TO END OF NAME STRING
;DON'T COPY A DOT IF ROOT-DIRECTORY BECAUSE ITS NAME WASN'T COPIED
MOVE T1,DIRORA
LOAD T1,DRNUM,(T1)
CAIE T1,ROOTDN
SKIPA T1,["."] ;PUT IN A "DOT"
MDDIE1: ILDB T1,T3 ;GET NEXT CHAR OF NAME
IDPB T1,T2 ;STORE NEXT CHAR INTO STRING
JUMPN T1,MDDIE1 ;LOOP BACK TIL STRING IS COMPLETE
MOVE T2,MDDDWS ;GET ADR OF WILD STRING
JUMPE T2,MDDIE2 ;IF NONE, DONT CALL CHKWLD
MOVEI T1,MDDDNM ;GET BYTE POINTER TO NAME BLOCK
HRLI T1,(POINT 7,0) ;...
CALL CHKWLD ;GO SEE THIS DIRECTORY IS A MATCH
JRST [ JUMPE T1,MDDDIC ;NOT A MATCH, GO STEP TO NEXT DIR
LOAD T1,FBDRN,(Q3) ;STRING IS A SUBSET
HRRM T1,MDDDNO ;GO MAP THIS DIR AND LOOK DOWN THE TREE
CALL USTDIR ;UNLOCK THE SUPERIOR
JRST MDDDI2] ;GO LOOK DOWN THE TREE
MDDIE2: LOAD T1,FBDRN,(Q3) ;GET DIRECTORY NUMBER AGAIN
HRRM T1,MDDDNO ;MAKE CURRENT
CALL USTDIR ;RELEASE SUPERIOR
MOVE T1,MDDDNO ;ATTEMPT TO MAP NEW CURRENT DIR
MOVE T2,MDDFLG ;GET .RCUSR FLAG
CALL @[IFIW!SETDIR
IFIW!SETDRR](T2)
JRST MDDDI2 ;COULDNT
JRST MDDDRT ;ALL OK, RETURN THIS DIR
;HERE WHEN IDXTAB DOES NOT HAVE A CORRECT BACK POINTER
MDDDIF: JUMPN T2,MDDDIC ;NULL ENTRY?
MOVX T4,FB%LNG ;IS THIS A LONG FILE?
TDNE T4,.FBCTL(Q3) ; ???
JRST [ BUG.(CHK,LNGDIR,DIRECT,HARD,<Long directory file in directory>,<<T3,DIRNUM>>,<
Cause: The subdirectory has an incorrect superior directory.
Action: Use the EXPUNGE command with subcommand REBUILD to rebuild index table
of the directory listed in the additional data. If this doesn't cure
the problem, delete the directory and rebuild it.
Data: DIRNUM - Directory number
>,,<DB%NND>) ;[7.1210]
JRST MDDDIC] ;IGNORE IT
MOVE T4,T3 ;COPY SUPERIOR
LOAD T3,FBADR,(Q3) ;GET XB ADDRESS
MOVE T2,Q3 ;GET FDB ADDRESS
SUB T2,DIRORA ;AS A RELATIVE ADDRESS
CALL SETIDX ;ATTEMPT TO SETUP INDEX
JRST MDDDIC ;FAILED
LOAD T1,FBDRN,(Q3) ;GET DIRNUM BACK
CALL USTDIR ;UNLOCK CURRENT DIRECTORY
HLL T1,MDDDNO ;STR UNIQUE CODE
CALL SETDIR ;MAP DIRECTORY
JRST MDDDIC ;FAILED
MOVE T2,DIRORA ;DIRECTORY ORGIN
LOAD T1,DRNUM,(T2) ;GET DIRECTORY NUMBER
CAILE T1,HSDPPN ;SYSTEM DEFINED PPN?
JRST MDDIE3 ;NO
MOVE T3,CRDPTB-1(T1) ;PPN CORRESPONDING TO THIS SYSTEM DEFINED DIR
STOR T3,DRPPN,(T2) ;STORE THE PPN IN THE DIRECTORY
MDDIE3: CALL SETPPN ;STORE PPN IN IDXTAB EXTENSION
CALL USTDIR ;UNLOCK
MOVE T1,MDDDNO ;SUPERIOR
CALL SETDIR ;GET IT BACK AGAIN
JRST MDDDIC ;FAILED
LOAD T1,FBDRN,(Q3) ;GET DIRNUM BACK
JRST MDDDIE ;AND RETURN IT
;SETUP DIRECTORY AND CHECK FOR LEGAL READ ACCESS
;ACCEPTS: 1/FULLWORD DIR NUMBER
;RETURNS: +1 NO ACCESS. DIRECTORY NOT LOCKED
; +2 ACCESS ALLOWED. DIR LOCKED
SETDRR::EA.ENT
CALL SETDIR ;SET DIRECTORY
RETBAD (GJFX36) ;PROBABLY SICK
MOVX B,DC%RD ;B/READ ACCESS
CALL DIRCHK ;CHECK FOR READ ACCESS TO THIS DIRECTORY
JRST [ CALL USTDIR ;NOT LEGAL
MOVEI A,GJFX35
RET]
RETSKP
; Multiple directory device name lookup routine
; Call: A ; Lookup pointer
; DIRORG ; The correct subdirectory, locked and psi off
; JRST MDDNAM
; Return
; +1 ; Match is impossible or ambiguous (AMBGF)
; +2 ; Success, if nrec&nrec1 are 0, the remainder if any
; ; Is appended to the string addressed by filopt(jfn)
MDDNAM::EA.ENT
JUMPE A,MDDSTP ;ZERO MEANS GET FIRST NAME IN DIR
HLRE B,A ;GET # OF WORDS IN STRING
MOVNS B
MOVEI A,1(A) ;GET STARTING ADR OF STRING
MOVEI C,.ETNAM ;LOOKUP A NAME
CALL LOOKUP
JRST NAMFND ;EXACT MATCH NOT FOUND
TQNE <STEPF> ;STEPPING?
TQNN <NAMSF> ;YES, STEPPING NAME FIELD?
JRST NAMLK9 ;NO
MDDSN1: AOS DRLOC ;STEP TO NEXT SYMBOL
AOS B,DRLOC ;Location in symtab of next after match
MOVE D,DIRORA ;GET BASE OF DIRECTORY
LOAD A,DRSTP,(D) ;GET TOP OF SYMBOL TABLE
ADD A,DIRORA
CAML B,A ;ARE WE AT TOP OF SYMBOL TABLE?
JRST [ MOVEI A,GJFX18 ;NO, NONE LEFT
JRST ERRET]
LOAD C,SYMVL,(B) ;GET THE VALUE
CAMN C,[-1] ;IS THIS THE SYMBOL TABLE HEADER
JRST MDDNA1 ;YES, SYMBOL TABLE IS FOULED UP
LOAD C,SYMET,(B) ;GET ENTRY TYPE OF NEXT SYMBOL
CAIE C,.ETNAM ;STILL LOOKING AT NAME SYMBOLS?
JRST [ MOVEI A,GJFX18 ;NO, Then fail
JRST ERRET] ;None left
LOAD C,SYMAD,(B) ;GET POINTER TO FDB
ADD C,DIRORA ;MAKE IT ABSOLUTE
MOVE A,C ;SEE IF THERE IS AN EXISTING FILE
CALL FDBCHK ;SEE IF THIS FDB IS GOOD
JRST ERRET ;NO GOOD. QUIT THE SCAN
CALL NAMSCN ; WITH THIS NAME
JRST MDDSN1 ;THERE ISNT, GO STEP NAME AGAIN
LOAD D,FBNAM,(C) ;GET POINTER TO NAME STRING
ADD D,DIRORA
MOVSI A,(POINT 7,0(D),35)
JRST UNIQL1 ;Copy new name to filopt
MDDNA1: MOVE A,DIRORA ;GET DIR NUMBER
LOAD A,DRNUM,(A) ; FOR SYSERR BLOCK
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRSY2,DIRECT,SOFT,<MDDNAM - Symbol table fouled up in directory>,<<A,DIRNUM>,<B,STRNAM>>,<
Cause: A bad symbol table format was found when looking up a directory.
Action: Use the EXPUNGE command with subcommand REBUILD to rebuild index table
of the directory listed in the additional data. If this doesn't cure
the problem, delete the directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
MDDNA2: MOVEI A,GJFX36 ;SMASHED DIR
JRST ERRET ;BOMB OUT
NAMLK9: MOVE B,DRLOC ;GET POINTER TO SYMBOL
LOAD A,DIRLA,(B) ;GET ADDRESS OF FDB
ADD A,DIRORA ;MAKE ABSOLUTE ADDRESS
NAMLKM: CALL FDBCHK ;MAKE SURE THIS IS A GOOD FDB
JRST MDDNA2 ;NO
CALL NAMSCN ;SEE IF THERE IS A NON-DELETED FILE
JRST [ MOVEI A,GJFX18 ;NO, DONT FIND THIS NAME
TQNE <NREC,NREC1> ; DOING RECOGNITION?
JRST ERRET ; NO, DON'T FIND THIS NAME
JRST NAMFN1] ; YES, LOOK FOR LONGER PARTIAL MATCH
NAMLK1: TQNN <UNLKF>
CALL USTDIR
RETSKP
MDDSTP: MOVE D,DIRORA ;GET POINTER TO JUST BELOW FIRST SYMBOL
LOAD B,DRSBT,(D) ;...
ADD B,DIRORA ;MAKE ADDRESS BE ABSOLUTE
MOVEM B,DRLOC
JRST MDDSN1 ;GO STEP DRLOC
NAMFND: TQNE <NREC,NREC1> ;Is recognition being performed
JRST NEWNAM ;No. try to insert a new name
MOVEI A,GJFX18
TQNN <MTCHF> ;Yes, did at least one string match?
JRST ERRET ;Error return, no match possible
NAMFN1: TQZ <MTCHF> ; Redetermine flags, checking
TQZ <AMBGF> ; invisible status
MOVE B,DRLOC ; Now check file name
MOVEM B,DRSCN ; Initial symbol in scan of subsets
NAMTST: LOAD A,SYMAD,(B) ; Get FDB address
ADD A,DIRORA ; Make it absolute
CALL FDBCHK ;IS THE FDB GOOD?
JRST ERRET ;NO. QUIT THE SCAN
CALL NAMSCN ; Check FDB chain
JRST NAMNXT ; Only del./ invis. files--keep looking
MOVEM B,DRLOC ; For non-deleted visible file
TQON <MTCHF> ; Flag non-deleted visible file
JRST NAMNXT ; First found--keep looking
TQO <AMBGF> ; Second found--ambiguous
CALL UPDSTR ;[7.1014] (/) Some match, update string accordingly
MOVE B,DRREC ;[7.1014] Get number of characters matching
JUMPE B,NAMLK9 ;[7.1014] If unique, give success return
MOVEI A,GJFX18
JRST AMBRET
NAMNXT: ADDI B,.SYMLN ;Point b to following entry
MOVEM B,DRSCN ; New scan symbol pointer
MOVE A,DIRORA ;GET SYMTOP TO SEE IF ANY MORE SYMBOLS
LOAD A,DRSTP,(A)
ADD A,DIRORA ;GET ABS ADR
CAML B,A ;If above top,
JRST UNIQUE ; Have found at most one FDB
CALL NAMCMM ;Compare strings
JUMPN A,UNIQUE ; Out of subsets
MOVE B,DRSCN ; Pointer to current symbol
JRST NAMTST ; Subset: check it out
AMBRET: TQOA AMBGF ;NOTE AMBIGUOUS RETURN
ERRET: TQZ AMBGF ;PLAIN FAILURE
CALL USTDIR
RET
;[7.1014]
;UPDSTR - Routine to update a string to recognize as much as possible.
;
; Call with:
; DRINP/ pointer to input string
; DRREC/ # of characters matching + 1 (0 if all)
; DRLOC/ Address of symbol table entry for string
; CALL UPDSTR
;
; Returns:
; +1 - Always, FILOPT/FILCNT updated
UPDSTR: EA.ENT ;Enter here from NAMFND
MOVE B,DRLOC ;Location in symtab of matching entry
LOAD C,DIRLA,(B) ;FDB address
ADD C,DIRORA ;Make it absolute
LOAD D,FBNAM,(C) ;Get pointer to name string
ADD D,DIRORA ;Get it out of directory
SKIPA ;Already in section 1
UPDSTF: EA.ENT ;Enter here from EXTFND
MOVN A,DRINP ;Start of input string
ADD A,FILOPT(JFN) ;End of input relative to beginning
; At this point A has byte ptr info in the LH, and a word offset in the RH
; Use 18-bit arithmetic to add in the word offset
ADDI D,1(A) ;Add word offset to 30-bit address
; The following snippit of code converts the P field of the (presumed)
; 7-bit byte pointer in A into P&S bits 0-5 corresponding to a one-word
; global pointer in A. See processor reference manual, Sec 2.11, page 2-85
LSH A,-^D30 ;Slide the P field over for arithmetic
IDIVI A,7 ;Compute (4 - byte # within word)
MOVNI A,-66(A) ;-1,,(66 - (byte # - 4))
LSH A,^D30 ;Slide back over to bits 0-5
IOR D,A ;Or in the P&S bits with 30-bit address
MOVE B,DRREC ;Get # chars agreeing
IFE. B
LOAD B,BLKLEN,(C) ;If none, use the block length
SUBI B,1
IMULI B,5
ELSE.
SUBI B,1 ;Account for extra count if substring
ENDIF.
JUMPLE B,R ;If still non-positive, quit
UPDSTC: ILDB A,D ;Copy tail to input
JUMPE A,UPDSTE ;Quit if encountered null
SOSGE FILCNT(JFN) ;Update buffer char count
JRST UPDSTE ;If overflow, quit
IDPB A,FILOPT(JFN) ;Also update FILOPT
SOJG B,UPDSTC ;Do up to maximum count
UPDSTE: MOVEI A,.CHNUL ;Tack on a trailing null
MOVE B,FILOPT(JFN) ;Get FILOPT pointer
IDPB A,B ;And stick the NUL in
RET
UNIQUE: MOVEI A,GJFX18
TQNN <MTCHF> ; Non-deleted, visible match found?
JRST ERRET ; No
MOVE B,DRLOC ;Location in symtab of matching entry
LOAD C,DIRLA,(B) ;GET FDB ADDRESS
ADD C,DIRORA ;MAKE IT ABSOLUTE
LOAD D,FBNAM,(C) ;GET POINTER TO NAME STRING
ADD D,DIRORA
UNIQU1: MOVN A,DRINP ;Start of input string
ADD A,FILOPT(JFN) ;End of input rELATIVE to beginning
AOS A ;POINT TO FIRST WORD IN STRING
TLO A,D ;ADD INDEX REGISTER TO BYTE POINTER
LDB C,A ;GET FIRST CHAR TO BE COPIED
DPB C,FILOPT(JFN) ;STORE IN JFN BLOCK
UNIQL1: ILDB C,A ;Copy tail to input string
JUMPE C,[MOVE A,FILOPT(JFN)
IDPB C,A
JRST NAMLK9] ;Terminate with null
IDPB C,FILOPT(JFN)
JRST UNIQL1 ;LOOP UNTIL TAIL IS COPIED
NEWNAM: SKIPG DRINL ;ANY FULL WORDS
SKIPE DRMSK ;NO, IS THIS A NULL NAME?
JRST NEWNA1 ;NO
MOVEI A,GJFX33 ;YES
JRST ERRET ;Null names not allowed
NEWNA1: MOVEI A,GJFX24
TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
TQNE <OLDNF> ;Are new names ok?
JRST NEWNA2 ;No new names, error return
MOVX B,DC%CF ;B/CREATE-FILE ACCESS
CALL DIRCHK ;CHECK FOR ABILITY TO ADD FILES TO DIRECTORY
JRST [ MOVEI A,GJFX35 ;NO, GIVE ERROR RETURN
JRST ERRET]
TQO <NEWF> ;Remember we entered a new file name
MOVEI B,.FBLEN
CALL ASGDFR ;Assign space for fdb
JRST [ MOVEI A,GJFX23 ;NO ROOM IN DIR FOR FDB
JRST ERRET]
CALL FDBINI ;Initialize fdb
SETONE <FBNEX,FBNXF>,(A) ;SET NON-EXISTENT AND NO-EXTENSION
PUSH P,A ;Save loc of fdb
CALL CPYDIR ;Copy the input string into directory
JRST [ POP P,B ;FAILED, GIVE BACK FDB SPACE
CALL RELDFA
MOVEI A,GJFX23 ;AND GIVE ERROR RETURN TO CALLER
JRST ERRET]
MOVEI C,.TYNAM
STOR C,NMTYP,(A) ;Mark as string block for name
MOVE C,0(P) ;GET FDB LOCATION
LOAD B,NMVAL,(A) ;GET FIRST 5 CHARACTERS FOR SYMBOL TAB
SUB A,DIRORA ;GET RELATIVE ADDRESS OF NAME STRING
STOR A,FBNAM,(C) ;Store location of name string in fdb
MOVE A,C ;GET ADDRESS OF FDB
SUB A,DIRORA ;MAKE IT RELATIVE
MOVEI C,.ETNAM ;THE ENTRY TYPE IS "NAME"
CALL INSSYM ;INSERT THE NAME
JRST [ MOVE B,0(P) ;GET BACK THE FDB ADDRESS
LOAD B,FBNAM,(B)
SKIPE B ;DONT RELEASE IF NO NAME STRING
CALL RELDFR ;RELEASE NAME STRING
POP P,B
CALL RELDFA ;RELEASE FDB AREA
MOVEI A,GJFX23 ;NO ROOM IN DIR
JRST ERRET]
POP P,(P) ;CLEAN UP THE STACK
CALL SETNXF ;SET NONXF BIT IN STS AND FILSTS
JRST NAMLK9 ;GO GIVE SUCCESS RETURN
NEWNA2: JRST ERRET ;NO, GIVE ERROR
;ROUTINE TO INSERT A SYMBOL INTO THE SYMBOL TABLE
;ACCEPTS IN A/ RELATIVE ADDRESS OF THE FDB OR STRING
; B/ VALUE OF THE SYMBOL (FIRST 5 CHARACTERS)
; C/ ENTRY TYPE
; DRLOC POINTING AT LOCATION IN SYMBOL TABLE
; CALL INSSYM
;RETURNS +1: COULD NOT EXPAND THE SYMBOL TABLE
; +2: OK
INSSYM: STKVAR <INSSYV,INSSYT,INSSYA>
MOVEM A,INSSYA ;SAVE ADR
MOVEM B,INSSYV ;SAVE VALUE
MOVEM C,INSSYT ;SAVE ENTRY TYPE
INSSY0: MOVE D,DIRORA ;SET UP BASE ADDRESS
LOAD A,DRSBT,(D) ;GET SYMBOT
SUBI A,.SYMLN ;SEE IF THERE IS ROOM
LOAD B,DRFTP,(D) ;GET FREE TOP
CAMGE A,B ;IS THERE ROOM?
JRST [ CALL XPAND ;NO, TRY TO EXPAND
RETBAD (GJFX23) ;NO ROOM
JRST INSSY0]
STOR A,DRSBT,(D) ;UPDATE NEW BOTTOM OF SYMBOL TABLE
MOVE B,DRLOC ;GET PLACE IN SYMBOL TABLE
SUBI B,.SYMLN ;PUT SYMBOL BELOW THIS
MOVEM B,DRLOC ;STORE UPDATED DRLOC
PUSH P,B ;SAVE B
LOAD C,DRSBT,(D) ;GET DESTINATION OF BLT
ADD C,DIRORA ;MAKE IT ABSOLUTE
MOVE A,B ;START COMPUTING LENGTH
XMOVEI B,.SYMLN(C) ;SET UP SOURCE ADDRESS
SUB A,C
CALL XBLTA ;DO BLT
POP P,B
INSSY1: MOVE A,INSSYV ;GET VALUE
STOR A,SYMVL,(B) ;STORE VALUE
MOVE A,INSSYT ;GET ENTRY TYPE
STOR A,SYMET,(B)
MOVE A,INSSYA ;GET ADR
STOR A,SYMAD,(B) ;SYMBOL IS NOW SET UP
RETSKP ;RETURN SUCCESSFUL
; Multiple directory device extension lookup
; Call: A ; Lookup pointer
; B ; Pointer to start pointer (as left by mddnam)
; JRST MDDEXT
; Return
; +1 ; No match or ambiguous (AMBGF)
; +2 ; Ok, the remaining string is appended to filopt(jfn)
MDDEXT::EA.ENT
JUMPE A,MDDSTE ;Set to first extension
MOVEM B,DRSCN ;Save loc of pointer
CALL SETMSK ;Set up mask etc
MOVE A,DRSCN ;Save location of pointer
MOVEM A,DRLOC ;INITIALIZE POINTER TO FDB CHAIN
LOAD A,DIRLA,(A) ;GET ADDRESS OF FIRST FDB IN CHAIN
ADD A,DIRORA ;As absolute address
EXTLK1: CALL FDBCHK ;CHECK THE FDB FOR CONSISTENCY
JRST MDDEXB ;NOT GOOD
JN FBNEX,(A),NEWEXT ;NO EXTENSION YET?
LOAD A,FBEXT,(A) ;GET POINTER TO EXTENSION STRING
ADD A,DIRORA ;GET ABS ADR
LOAD D,EXLEN,(A) ;GET LENGTH OF BLOCK
MOVEI D,-2(D) ;GET # OF FULL WORDS
AOS C,A ;POINT TO FIRST WORD OF STRING
MOVE A,DRINP ;Get pointer to input
MOVE B,DRINL ;GET NUMBER OF WORDS IN STRING
CALL STWCMP ;Compare strings
JRST [ JUMPN A,EXTNEQ ;OTHER THAN SUBSTRING?
JRST EXTSUB] ;NO, SUBSTRING
TQNE <STEPF> ;EXACT MATCH
TQNN <EXTSF>
JRST EXTLKL
EXTLK2: MOVE B,DRSCN ;Get loc of pointer
LOAD B,DIRLA,(B) ;GET ADR OF NEXT FDB IN CHAIN
ADD B,DIRORA ;MAKE IT ABSOLUTE
ADDI B,.FBEXL ;POINT TO THE LINK ITSELF
;..
;..
MDDSTE: MOVEM B,DRSCN ;STORE POINTER TO LINK WORD
MOVEM B,DRLOC ;UPDATE DRLOC ALSO
LOAD A,DIRLA,(B) ;GET ADDRESS OF NEXT FDB
JUMPE A,[MOVEI A,GJFX19 ;END OF CHAIN?
JRST ERRET] ;YES, None left
ADD A,DIRORA ;GET ACTUAL ADR OF FDB
CALL FDBCHK ;CHECK THE CONSISTENCY OF FDB
JRST MDDEXB ;NO GOOD
JN FBNEX,(A),EXTLK2 ;IF NO EXT, GO STEP TO NEXT FDB
CALL EXTSCN ;MAKE SURE THERE IS A NON-DELETED FILE
JRST EXTLK2 ;THERE ISNT, GO STEP TO NEXT EXT
LOAD D,FBEXT,(A) ;GET ADDRESS OF EXTENSION STRING
ADD D,DIRORA ;MAKE IT ABSOLUTE
MOVSI A,(POINT 7,0(D),35)
JRST UNIQL1 ;GO COPY TAIL
MDDEXB: MOVEI A,GJFX36 ;SMASHED DIR
JRST ERRET
EXTLKL: MOVE B,DRSCN ;Exact match. get loc of pointer
LOAD A,DIRLA,(B) ;GET FDB ADR OF EXTENSION
ADD A,DIRORA ;MAKE IT ABSOLUTE
CALL EXTSCN ; CHECK FOR NON-DEL, VISIBLE FILES
JRST [ MOVEI A,GJFX19 ; NONE THERE
TQNE <NREC,NREC1> ; DOING RECOGNITION?
JRST ERRET ; NO
JRST EXTSUB] ; YES, LOOK FOR LONGER PARTIAL MATCH
CALL FDBCHK ; MAKE SURE OF GOOD FDB
JRST MDDNA2
JRST NAMLK1 ; SKIP RETURN & UNLOCK DIRECTORY
EXTSUB: TQNE <NREC,NREC1> ;DOING RECOGNITION?
JRST EXTNEQ ;NO
MOVE B,DRSCN
LOAD A,DIRLA,(B) ; Get FDB address
ADD A,DIRORA ; Make it absolute
CALL EXTSCN ; Check FDB chain
JRST EXTNXT ; Only del./invis. files--keep looking
TQON <MTCHF> ; Flag non-deleted visible file
IFNSK. ;[7.1014] First match
MOVE C,DRSCN ;[7.1014] Note this is the first match
MOVEM C,DRLOC ;[7.1014] Keep this up to date
SETZM DRREC ;[7.1014] Zap count of matching characters
ELSE. ;[7.1014] Subsequent matches
MOVE A,DRSCN ;[7.1014] Compute address of current string block
LOAD A,DIRLA,(A) ;[7.1014] And put it in A
ADD A,DIRORA ;[7.1014] Make it absolute
LOAD A,FBEXT,(A) ;[7.1014] Address of extension string
MOVE B,DRLOC ;[7.1014] Compute address of first string block
LOAD B,DIRLA,(B) ;[7.1014] And it will go in B
ADD B,DIRORA ;[7.1014] Make it absolute
LOAD B,FBEXT,(B) ;[7.1014] Address of extension string
MOVE C,DRREC ;[7.1014] Count of previous matching characters
CALL SUBSTR ;[7.1014] (A,B,C/A) Get new substring count
MOVEM A,DRREC ;[7.1014] And save it
ENDIF. ;[7.1014]
JRST EXTNXT ; Next
EXTNEQ: JUMPL A,EXTFND ;GONE TOO FAR IN CHAIN?
TQNE <NREC,NREC1> ;NO, DOING RECOGNITION?
JUMPE A,EXTFND ;NO, STOP AT FIRST SUBSET
EXTNXT: MOVE B,DRSCN ;GET POINTER TO FDB
LOAD B,DIRLA,(B) ;GET ADDRESS OF FDB
ADD B,DIRORA ;MAKE IT ABSOLUTE
ADDI B,.FBEXL ;POINT TO LINK WORD
MOVEM B,DRSCN ;STORE NEW POINTER
LOAD A,DIRLA,(B) ;GET ADDRESS OF NEXT FDB
JUMPN A,[ADD A,DIRORA ;ANOTHER EXTENSION IS PRESENT
JRST EXTLK1]
EXTFND: TQNE <NREC,NREC1>
JRST NEWEX1 ;New extension
MOVEI A,GJFX19
TQNN <MTCHF> ; Non-deleted visible file found?
JRST AMBRET ; No
MOVE B,DRLOC ; Yes
LOAD C,DIRLA,(B) ;GET FDB ADDRESS
ADD C,DIRORA ;MAKE IT ABSOLUTE
LOAD D,FBEXT,(C) ;GET ADDRESS OF EXTENSION STRING
ADD D,DIRORA ;MAKE IT ABSOLUTE
CALL UPDSTF ;[7.1014] (D/) Copy tail to the input
MOVE C,DRREC ;[7.1014] Count of matching characters
JUMPE C,NAMLK9 ;[7.1014] No multiple matches, return successfully
TQO <AMBGF> ;[7.1014] Else, ambiguous
MOVEI A,GJFX19 ;[7.1014] And pass error back
JRST AMBRET ;[7.1014] Pass it back
NEWEX1: MOVEI A,GJFX24
TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
TQNE <OLDNF> ;Are new files allowed?
JRST NEWEX3
MOVX B,DC%CF ;CREATE-FILE ACCESS
CALL DIRCHK ;CHECK FOR ABILITY TO CREATE FILES
JRST [ MOVEI A,GJFX35
JRST ERRET]
MOVEI B,.FBLEN
CALL ASGDFR ;Get space for new fdb
JRST [ MOVEI A,GJFX23
JRST ERRET]
CALL FDBINI ;Initialize the fdb
MOVE B,DRLOC ;GET POINTER TO NEXT FDB
LOAD B,DIRLA,(B) ;GET FDB ADR
ADD B,DIRORA ;MAKE IT ABSOLUTE
EXCH A,B ;CHECK THIS FDB
CALL FDBCHK ;TO AVOID PICKING UP GARBAGE
JRST [ MOVEI A,GJFX36 ;DIR BAD
JRST ERRET] ;BOMB OUT
LOAD C,FBNAM,(A) ;GET POINTER TO NAME STRING
STOR C,FBNAM,(B) ;MAKE NEW FDB POINT TO NAME STRING TOO
PUSH P,B ;Save fdb location
CALL CPYDIR ;Copy extension string to directory
JRST [ POP P,B ;NO ROOM TO PUT STRING INTO DIR
CALL RELDFA ;RELEASE FDB STORAGE
MOVEI A,GJFX23
JRST ERRET] ;BOMB OUT WITH NO ROOM ERROR
MOVEI C,.TYEXT
STOR C,EXTYP,(A) ;MarK as string block for extension
EXCH A,0(P) ;SAVE EXT STRING ADR AND GET FDB ADR
MOVE B,DRSCN ;Location of last extension pointer
LOAD C,DIRLA,(B) ;GET FDB ADR POINTED TO BY LAST EXT
EXCH A,C ;CHECK THIS FDB ADR
CALL FDBCHR
JRST [ MOVEI A,GJFX36 ;DIR IS SCREWED UP
JRST ERRET]
EXCH A,C
STOR C,FBEXL,(A) ;MAKE NEW FDB POINT DOWN THE CHAIN
SUB A,DIRORA ;GET RELATIVE ADR OF NEW FDB
CALL EFIXUP ;GO SET UP POINTERS TO NEW EXT
CALL SETNXF ;GO SET NONXF IN STS AND FILSTS
POP P,A
JRST NEWEX2
NEWEX3: JRST ERRET ;NO, GIVE ERROR RETURN
;ROUTINE TO FIX UP POINTERS TO A NEW EXT IN FDB CHAIN
;ACCEPTS IN A/ RELATIVE ADR OF NEW FDB
; B/ DIRLA POINTER TO TOP FDB OF EXT CHAIN
; CALL EFIXUP
;RETURNS +1: ALWAYS
EFIXUP: CALL FDBCHR ;CHECK OUT FDB BEING STORED
RET ;DONT DO ANYTHING
STOR A,DIRLA,(B) ;STORE TOP LEVEL POINTER ALWAYS
VFIXUP: MOVE C,DIRORA ;GET BASE ADR OF MAPPED AREA
LOAD C,DRSBT,(C) ;GET SYMBOT
ADD C,DIRORA ;GET ABS ADR OF BOTTOM OF SYMBOL TABLE
CAML B,C ;IS DIRLA POINTER WITHIN AN FDB?
RET ;NO, IT IS IN THE SYMBOL TABLE
SUBI B,.FBEXL ;GET ADDRESS OF FDB
EXCH B,A ;PUT NEW FDB ADR INTO A
EFIXU1: LOAD A,FBGNL,(A) ;GET POINTER TO NEXT GENERATION IN CHAIN
JUMPE A,R ;IF 0, AT END OF CHAIN
CALL FDBCHR ;SEE IF THIS IS A GOOD FDB
RET ;IT ISNT, RETURN
ADD A,DIRORA ;GET ABSOLUTE ADR OF THIS FDB
STOR B,FBEXL,(A) ;UPDATE POINTER TO NEXT EXTENSION
JRST EFIXU1 ;LOOP FOR ALL GENERATIONS ON CHAIN
NEWEXT: TQNN <NREC,NREC1>
JRST [ MOVEI A,GJFX19
JRST AMBRET] ;Recognition wanted
TQNE <OLDNF>
JRST [ MOVEI A,GJFX24
JRST ERRET] ;No new files
PUSH P,A
CALL CPYDIR ;Copy string block into directory
JRST [ MOVEI A,GJFX23
JRST ERRET]
MOVEI C,.TYEXT
STOR C,EXTYP,(A) ;Mark as string block for extension
POP P,C ;GET BACK ADR OF FDB BLOCK
SETZRO FBNEX,(C) ;MARK THAT FILE HAS AN EXTENSION
NEWEX2: MOVE B,DRSCN ;NOW PUT IN POINTER TO EXT STRING
LOAD C,DIRLA,(B) ;GET FDB ADDRESS
ADD C,DIRORA ;MAKE IT ABSOLUTE
SUB A,DIRORA ;MAKE POINTER TO EXT STRING RELATIVE
STOR A,FBEXT,(C) ;STORE POINTER TO EXT INTO FDB
TQO <NEWF> ;Remember this is a new file
MOVE A,C ;LEAVE ABS ADR OF FDB IN A
JRST NAMLK1 ;Double skip return
;ROUTINE TO SCAN A FDB CHAIN LOOKING FOR A FILE THAT IS NOT DELETED
;ACCEPTS IN A/ ABSOLUT FDB ADR
; CALL NAMSCN
;RETURNS +1: NO VISIBLE, NON-DELETED FILE FOUND
; +2: THERE IS AT LEAST ONE VISIBLE, NON-DELETED FILE WITH
; THIS NAME
;NOTE: CALLER SHOULD HAVE CALLED FDBCHK ON THIS FDB. THIS ROUTINE WILL
;CHECK ANY NEW FDB'S THAT IT FINDS
NAMSCN: SAVET ;THIS ROUTINE CLOBBERS NO ACS
NAMSC1: CALL EXTSCN ;SCAN THIS VERSION CHAIN
SKIPA A,.FBEXL(A) ;NONE ON THIS CHAIN, STEP TO NEXT EXT
RETSKP ;A FILE WAS FOUND, RETURN OK
JUMPE A,R ;IF AT END OF CHAIN, RETURN +1
ADD A,DIRORA ;GET ABS ADR OF FDB
CALL FDBCHK ;IS THIS A GOOD FDB?
RETBAD () ;NO. RETURN ERROR CODE
JRST NAMSC1 ;LOOP BACK TILL ONE FOUND
;ROUTINE TO SCAN A VERSION CHAIN LOOKING FOR A NON-DELETED FILE
;ACCEPTS IN A/ ABS FDB ADR
; CALL EXTSCN
;RETURNS +1: NO FILE FOUND
; +2: AT LEAST ONE FILE WITH THIS NAME AND EXT IS VISIBLE
; AND NOT DELETED
EXTSCN: IFQN. <NREC,NREC1> ;[7.1014] Always see what is visible if doing recognition
TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;[7.1014] Stepping anything?
TQNE <OLDNF> ;[7.1014] Or old file only?
SKIPA ;[7.1014] Yez'm
RETSKP ;[7.1014] No, allow creating of new names
ENDIF. ;[7.1014]
SAVET ;CLOBBERS NO ACS
EXTSC1: JN FBNXF,(A),EXTSC2 ;IF NON-EXISTANT, STEP TO NEXT FDB
TQNE <IGIVF> ; Finding invisible?
JRST EXTSC3 ; Yes
JN FBINV,(A),EXTSC2 ; No, if invis., step to next FDB
EXTSC3: CALL EXTPRT ;[7.1014] (A/) See if this file can be seen
JRST EXTSC2 ;[7.1014] It can't, so ignore it
TQNE <IGDLF> ;IF IGNORING DELETED BIT,
RETSKP ; THEN GIVE OK RETURN
JE FBDEL,(A),RSKP ;IF FILE NOT DELETED AND EXISTS, RSKP
EXTSC2: SKIPN A,.FBGNL(A) ;AT END OF CHAIN YET?
RET ;YES, RETURN UNSUCCESSFUL
ADD A,DIRORA ;GET ABS ADR OF FDB
CALL FDBCHK ;IS THIS A GOOD FDB?
RETBAD () ;NO. RETURN ERROR CODE
JRST EXTSC1 ;LOOP BACK FOR NEXT VERSION IN CHAIN
;[7.1014]
;EXTPRT - Routine to check to see if this file can be seen because
;of its protection.
;
; Called with:
; A/ FDB
; CALL EXTPRT
;
; Returns:
; +1 - This FDB cannot be seen due to its protection
; +2 - This FDB can be seen
EXTPRT: TQNE <NREC,NREC1> ;Protection only affects recognition
RETSKP ;File can be seen
SAVET ;Recognition being done
MOVX B,FC%DIR ;Access code
CALLRET ACCCHK ;(A,B/) Check access (ala protection)
; Multiple directory device version lookup routine
; Call: A ; Desired version
; B ; STARTING POINTER
; DIRORG- ; The appropriate directory locked and psi off
; JRST MDDVER
; Return
; +1 ; Version not found
; +2 ; Success version in a if unlkf=1
; ; Fdb address in a if unlkf=0
; ; FDB ADR IN B ALWAYS
MDDVER::EA.ENT
STKVAR <MDDVRA,MDDVRT,MDDVRL,MDDVRF,MDDVFB>
MDDVR1: HRRES A ;Extend sign
MOVEM A,DRINP
MOVEM B,MDDVRA ;SAVE POINTER TO TOP FDB IN GEN CHAIN
MOVEM B,DRLOC
SETZM MDDVRL ;INIT LAST VERSION NUMBER SEEN
IFL. A
CAME A,[-2] ;LOWEST?
CAMN A,[-1] ;OR A NEW ONE?
ANSKP.
MOVEI A,GJFX20 ;NO. RETURN WITH ERROR
JRST ERRET ;ALL DONE
ENDIF.
LOAD D,DIRLA,(B) ;GET ADDRESS OF FDB OF FIRST GEN
ADD D,DIRORA ;MAKE IT ABSOULTE
EXCH A,D ;CHECK THE FDB
CALL FDBCHK
JRST MDDVRB ;FDB IS BAD
EXCH A,D
CAMN A,[-2] ;WANT LOWEST VERSION?
MOVEM D,DRLOC ;YES, SAVE STEPPED ADDRESS
LOAD C,FBGEN,(D) ;GET GENERATION NUMBER FROM FDB
JUMPE C,VERLK7 ;This is first version of this file
JRST VRLK0A
VERLK0: EXCH D,A ;CHECK THIS FDB
CALL FDBCHK
JRST MDDVRB ;FDB IS BAD
EXCH D,A
VRLK0A: MOVEM B,DRSCN ;Save scan pointer
JUMPG A,VERLK1 ;JUMP IF Specific version wanted
CAMN A,[-2] ;OLDEST VERSION WANTED?
JRST VERLKC ;YES
JUMPL A,VERLK2 ;GO DO A NEW ONE THEN
IFQN. FBDEL,(D)
TQNN <IGDLF> ;YES, USER WANTS 'IGNORE DELETED'?
JRST VERLK1 ;NO, GO TO NEXT VERSION
ENDIF.
IFQN. FBINV,(D)
TQNN <IGIVF> ; User want to find invisible?
JRST VERLK1 ; No, go to next one
ENDIF.
IFQN. FBNXF,(D)
TQNE <OLDNF> ;NO, USER REQUIRES OLD FILE?
JRST VERLK1 ;YES, GO TO NEXT VERSION
JRST VERLK2 ;NEW VERSION OK
ENDIF.
;..
;..
VERLK3: MOVE A,D ;Found
VERLK8: TQNE <NEWVF,NEWF> ;NEW VERSION
JRST VERLKB ;YES
TQNE <NEWNF> ;NO NEW FILES
JRST [ MOVEI A,GJFX27 ;YES, GIVE ERROR RETURN
JRST ERRET]
VERLKB: TQNE <STEPF> ;STEPPING?
TQNN <VERSF> ;YES, STEPPING VERSION?
JRST VERLKE ;NO
SKIPG DRINP ;HAVE A POINTER TO A VERSION?
JRST VERLKE ;NO
MOVEI A,GJFX20
SKIPG MDDVRL ;ANY PREVIOUS VERSIONS SEEN
JRST ERRET ;NO, END OF LIST
MOVE A,MDDVRF ;GET POINTER TO FDB
LOAD A,DIRLA,(A) ;GET ADR OF FDB
ADD A,DIRORA ;MAKE IT ABSOLUTE
CALL FDBCHK ;CHECK THE FDB
JRST MDDVRB ;FDB IS BAD
TQNE <IGDLF> ;IGNORE DELETED FILES?
JRST VERLKG ;NO
JN FBDEL,(A),VERLKF ;SEE IF FILE IS DELETED
VERLKG: TQNE <IGIVF> ; Find invisible files?
JRST VERLG1 ; Yes
JN FBINV,(A),VERLKF ; File invisible?
VERLG1: JN FBNXF,(A),VERLKF ;FILE EXIST?
JN FBNEX,(A),VERLKF ;YES, ALSO HAVE EXTENSION?
VERLKE: CALL FDBCHK ;CHECK THAT WE HAVE A GOOD FDB
JRST MDDVRB ;IT IS BAD
MOVE B,A ;GET FDB ADR INTO B
TQNE <UNLKF>
RETSKP ;Return without unlocking directory
LOAD A,FBGEN,(B) ;GET GENERATION NUMBER
CALL USTDIR
RETSKP
VERLKF: MOVE A,MDDVRL ;SCAN LOOKING FOR THIS VERSION NOW
MOVE B,MDDVRA ;GET POINTER BACK TO THE TOP FDB
JRST MDDVR1 ;GO DO SCAN AGAIN
VERLK7: SKIPG A
MOVEI A,1 ;However it can be most recent+1
STOR A,FBGEN,(D) ;Or specific version
JRST VERLK3
VRLK2A: PUSH P,T4 ;SAVE T4
SKIPN T1,.FBADR(T4) ;ANY ADDRESS
JRST VRLK2B ;NO, OK TO REINIT
LOAD T2,DIROFN ;GET OFN OF DIRECTORY
LOAD T2,STRX,(T2) ;GET STRUCTURE FOR DIRECTORY
CALL CHKOFN ;OPEN FILES FOR THIS FDB?
JRST [POP P,T4 ;YES, GET T4 BACK
JRST VRLK5A] ;USE DON'T CHANGE THIS FDB
VRLK2B: POP P,T1 ;NOT IN USE. FDB ADDR IN T1
CALL FDBIN0 ;UPDATE STUFF IN FDB
SETZRO FBSIZ,(A)
JRST VERLK8
;HERE IF NEW VERSION WANTED
VERLK2: TQO <NEWVF>
TQZ <NEWF>
JN FBNXF,(D),VRLK2A ;NONEXISTANT, CHECK FOR OPEN FILE
MOVE C,DRINP ;GET INPUT ARG
CAME C,[-1] ;WANT NEXT VERSION?
JRST VERLK6 ;NO. USE CURRENT
LOAD D,FBGEN,(D) ;GET VERSION OF THIS FILE
CAIN D,377777 ;IS IT ALREADY AT MAX VALUE?
JRST [ MOVEI A,GJFX20 ;YES. GIVE ERROR THEN
JRST ERRET] ;""
VERLK6: MOVEI A,GJFX24
TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;NO NEW FDB'S IF STEPPING
TQNE <OLDNF>
TQNE <OUTPF> ;IF USER WANTS NEXT HIGHER VERSION,
SKIPA ; THEN ALLOW NEW FDB SINCE NAME.EXT EXISTS
JRST VERLK9 ;Old files only
MOVX B,DC%CF ;B/CREATE-FILES ACCESS
CALL DIRCHK ;CHECK FOR ABILITY TO CREATE FILES
JRST [ MOVEI A,GJFX35
JRST ERRET]
MOVE B,DIRORA ;MAKE MODVRA RELATIVE TO START OF DIR
LOAD B,DRSBT,(B) ;GET START ADR OF SYMBOL TABLE
ADD B,DIRORA ;GET ABSOLUTE ADR OF SYMBOL TAB START
CAMGE B,MDDVRA ;IS POINTER INTO SYMBOL TABLE
SUBM B,MDDVRA ;YES, MAKE IT NOT BE RELATIVE TO SYMTAB
MOVEI B,.FBLEN
CALL ASGDFR ;Assign space for a new fdb
JRST [ MOVEI A,GJFX23
JRST ERRET]
SKIPL MDDVRA ;WAS THIS POINTER IN THE SYMBOL TABLE?
JRST VRLK6A ;NO
MOVE C,DIRORA ;YES, MAKE IT POINT INTO SYMTAB AGAIN
LOAD C,DRSBT,(C) ;GET ADR OF START OF SYMTAB
ADD C,DIRORA ;MAKE IT ABSOLUTE
SUBM C,MDDVRA ;MAKE POINTER CORRECT AGAIN
VRLK6A: CALL FDBINI ;Initialize the fdb
MOVE C,DRLOC ;GET POINTER TO NEXT FDB
LOAD C,DIRLA,(C) ;GET ADDRESS OF FDB
ADD C,DIRORA ;MAKE IT ABSOLUTE
EXCH A,C
CALL FDBCHK ;CHECK VALIDITY OF NEXT FDB
JRST MDDVRB ;DIR IS BAD
EXCH A,C
LOAD D,FBFLG,(C) ; Get previous flag bits
TXZ D,FB%DEL!FB%LNG!FB%PRM!FB%SHT!FB%DIR!FB%INV!FB%OFF!FB%ARC!FB%FCF!FB%BAT!FB%TMP!FB%FOR ; Don't propagate these
TXO D,FB%NXF ; Mark as non-exstent
STOR D,FBFLG,(A) ; Into new FDB
LOAD D,FBBK0,(C) ; Get some other bits
ANDX D,AR%NAR+AR%EXM ; Propagate resist & exempt
STOR D,FBBK0,(A) ; Into new FDB
CALL SETNXF ;GO SET NONXF IN STS AND FILSTS
LOAD D,FBNAM,(C) ;GET POINTER TO NAME STRING
STOR D,FBNAM,(A) ;MAKE THIS FDB POINT TO SAME NAME
LOAD D,FBEXT,(C) ;GET POINTER TO EXTENSION STRING
STOR D,FBEXT,(A)
LOAD D,FBEXL,(C) ;SET UP SAME EXTENSION LINK
STOR D,FBEXL,(A)
LOAD D,FBGNR,(C) ;SET UP RETENTION COUNT
STOR D,FBGNR,(A)
LOAD D,FBPRT,(C) ;SET UP PROTECTION
STOR D,FBPRT,(A)
LOAD D,FBNET,(C) ; Set up same online expiration
STOR D,FBNET,(A)
LOAD D,FBLEN,(A) ; See if new FDB large enough
CAIGE D,.FBLXT
JRST VRLK6Z ; No, skip offline exp altogether
LOAD D,FBLEN,(C) ; Old FDB have off exp?
CAIGE D,.FBLXT
JRST [ MOVE D,DIRORA ; Old FDB doesn't have it, use directory
LOAD D,DRDFE,(D) ; Get default for the directory
JRST VRLK6Y]
LOAD D,FBFET,(C) ; Get previous guy's off exp
VRLK6Y: STOR D,FBFET,(A) ; Put into new FDB
VRLK6Z: LOAD D,FBFET,(C) ; Set up same offline expiration
STOR D,FBFET,(A)
SOSGE D,DRINP ;VERSION SPECIFIED?
LOAD D,FBGEN,(C) ;NO, GET VERSION OF OLD HIGHEST FILE
AOS D ;MAKE VERSION BE ONE HIGHER
STOR D,FBGEN,(A) ;STORE NEW VERSION #
MOVE B,DRSCN ;GET POINTER TO LIST
LOAD D,DIRLA,(B) ;GET ADR OF NEXT FDB ON LIST
EXCH A,D
CALL FDBCHR ;MAKE SURE IT IS A VALID FDB ADR
JRST MDDVRB ;DIR IS BAD
STOR A,FBGNL,(D) ;MAKE NEW FDB POINT DOWN THE LIST
MOVEM D,MDDVRT ;SAVE FDB ADR
SUB D,DIRORA ;GET RELATIVE ADR OF NEW FDB
STOR D,DIRLA,(B) ;MAKE LIST POINT TO NEW FDB
TQO <NEWVF> ;Remember we created a new version
MOVE B,MDDVRA ;GET POINTER TO FIRST FDB IN CHAIN
LOAD A,DIRLA,(B) ;GET FDB ADR
CALL VFIXUP ;MAKE ALL PREVIOUS EXT'S POINT RIGHT
MOVE A,MDDVRT ;GET BACK FDB ADR
JRST VERLK8 ;LEAVE FDB ADR IN A
VERLKC: JN FBDEL,(D),<[TQNN IGDLF ;IGNORING DELETED FILES
JRST VERLK1 ;NO
JRST VRLKC1]> ;YES, SEE IF FILE EXISTS
VRLKC1: JN FBINV,(D),<[TQNN <IGIVF> ; Find invisible files?
JRST VERLK1 ; No, bypass this one then
JRST VRLKC3]>
VRLKC3: JN FBNXF,(D),VERLK1 ;IF FILE DOESNT EXIST, USE THIS FDB
MOVEM D,DRLOC ;Save FDB ADR for later
VERLK1: LOAD C,FBGEN,(D) ;Get version number of this fdb
CAMG C,A ;Below desired version?
JRST VERLK5 ;Yes, we have found where it belongs
MOVE B,DRSCN ;GET POINTER TO NEXT FDB
MOVEM B,MDDVRF ;SAVE LAST POINTER TO FDB
LOAD B,DIRLA,(B) ;GET ADDRESS OF FDB
ADD B,DIRORA ;MAKE IT ABSOLUTE
ADDI B,.FBGNL ;MAKE IT POINT TO LINK TO NEXT GEN
LOAD D,DIRLA,(B) ;GET ADR OF NEXT FDB
JUMPN D,[ADD D,DIRORA ;IF ONE EXISTS, GET ITS ABSOLUTE ADR
MOVEM C,MDDVRL ;UPDATE LAST VERSION NUMBER SEEN
JRST VERLK0]
JUMPE A,[MOVEI A,GJFX20 ;WANT HIGHEST VERSION?
TQNE <OLDNF> ;WANT OLD FILES
JRST ERRET ;YES. HE GETS AN ERROR THEN
SETO A, ;NO. ASK FOR NEXT HIGHEST
MOVE B,MDDVRA ;GET BACK STARTING FDB ADDRESS
JRST MDDVR1] ;AND GO CREATE A NEW FILE
CAMN A,[-2] ;OLDEST VERSION WANTED?
JRST VERLKD ;YES
MOVEM B,DRSCN
JRST VERLK6 ;Insert new version here
VERLK9: JRST ERRET ;ERROR
;HERE IF USER WANTS OLDEST VERSION
VERLKD: TQZ <NEWF,NEWVF>
MOVEI A,GJFX20
MOVE D,DRLOC
JN FBDEL,(D),<[TQNN IGDLF ;DELETED, IGNORING DELETED?
JRST VERLKF ;NO, SCAN UP THE FDB CHAIN TO PREVIOUS
JRST VRLKD1]> ;YES
VRLKD1: JN FBINV,(D),<[TQNN <IGIVF> ; Find invisible files?
JRST VERLKF ; No
JRST VRLKD2]> ; Yes, go on
VRLKD2: JN FBNXF,(D),VERLKF ;IF NON-EXISTENT, SCAN UP CHAIN
JRST VERLK3
VERLK5: CAME C,A ;Exactly the right one?
JRST VERLK6 ;Insert a new one
VRLK5A: MOVE B,DRSCN
LOAD A,DIRLA,(B) ;GET ADR OF POINTER TO FDB
ADD A,DIRORA ;MAKE IT ABSOLUTE
CALL FDBCHK ;CHECK THIS FDB
JRST MDDVRB ;FDB IS BAD
TQNE <OUTPF> ;IF FILE IS FOR OUTPUT,
JRST VERLKH ; THEN WE HAVE FOUND IT.
TQNE <IGIVF> ; Find invisible?
JRST VERL51 ; Yes
JN FBINV,(A),VERL52 ; File invisible?
VERL51: JE FBDEL,(A),VERLKH ;IF NOT DELETED, GO TO VERLKH
TQNE <OUTPF,IGDLF> ;IGNORE DELETED?
JRST VERLKH ;YES
VERL52: MOVEI A,GJFX20 ;NO, GIVE ERROR RETURN
JRST ERRET
VERLKH: TQNE <OUTPF>
JRST [ JE FBDEL,(A),VRLKH1 ;DELETED?
MOVEM A,MDDVFB ;Yes, save pointer to FDB
MOVX B,DC%CF ;Get access required
CALL DIRCHK ;(B/) Check for create file access
IFNSK.
MOVEI A,GJFX35 ;Access denied
JRST ERRET ;Return error
ENDIF.
MOVE A,MDDVFB ;Restore pointer to FDB
SETZRO FBDEL,(A) ;CLEAR DELETED BIT
SETONE FBNXF,(A) ;AND SET NON-EXISTENT
JRST VRLKH1]
VRLKH1: JE FBNXF,(A),VERLK8 ;FILES EXIST?
TQNE <STEPF> ;NO - STEPPING ?
TQNN <VERSF> ; AND VERSION STEPPING ?
TQNN <OLDNF> ;NO - OLD FILE ONLY?
JRST [TQO <NEWVF> ;SET NEW VERSION FLAG
JRST VERLK8] ;FOUND
MOVEI A,GJFX24 ;YES, THEN GIVE AN ERROR RETURN
JRST ERRET
MDDVRB: MOVEI A,GJFX36 ;DIR IS SMASHED
JRST ERRET
; Lookup of string in a directory
; Call: A ; ADR OF FIRST WORD IN STRING
; B ; # OF FULL WORDS IN STRING
; C ; ENTRY TYPE
; NREC on in F1 if no recognition allowed per [7.1014]
; CALL LOOKUP to indicate a file lookup
; or
; CALL LOOKP1 to indicate a directory lookup
; Return
; +1 ; No exact match found
; +2 ; Exact match found
LOOKUP: TDZA D,D ;Clear flag: normal entry
LOOKP1: SETO D, ;Set flag: directory lookup
STKVAR <LOOKUE,LOOKUI,LOOKUB,LOOKUD,DIRSRC> ;[7.1014]
TQZ <MTCHF,AMBGF> ;CLEAR RESULT FLAGS
MOVEM C,LOOKUE ;SAVE ENTRY TYPE
MOVEM D,DIRSRC ;Setup internal flag
CALL SETMSB ;Set up input pointer and mask
MOVE D,DIRORA ;GET BASE OF MAPPED DIR
LOAD A,DRSTP,(D) ;GET TOP OF DIRECTORY
LOAD B,DRSBT,(D) ;GET BOTTOM OF SYMBOL TABLE
ADDI B,.SYMLN ;MAKE IT POINT TO FIRST SYMBOL
SUB A,B ;GET LENGTH OF SYMBOL TABLE
JFFO A,.+2 ;Get top 1 bit
MOVEI B,^D34
MOVNS B
MOVSI A,400000
LSH A,(B) ;Largest power of 2 <= length
LOAD B,DRSBT,(D) ;GET BOTTOM OF SYMBOL TABLE
ADD B,DIRORA ;MAKE IT ABSOULTE
MOVUP: JUMPE A,STRFND ;And move up
CAIG A,1 ;DONT SPLIT A SYMBOL ENTRY
JRST STRFND ;ALL DONE
ADD B,A
ASH A,-1 ;Halve increment
MOVE C,DIRORA ;GET BASE ADR
LOAD C,DRSTP,(C) ;GET TOP OF SYMBOL TABLE
ADD C,DIRORA ;MAKE IT RELATIVE
CAMGE B,C ;TOO BIG?
JRST SYMCMP ;No, compare strings
MOVDN: JUMPE A,STRFDD
CAIG A,1 ;DONT SPLIT A SYMBOL ENTRY
JRST STRFDD
SUB B,A
ASH A,-1
MOVE D,DIRORA ;GET BASE ADR
LOAD C,DRSTP,(D) ;GET TOP OF SYMBOL TABLE
ADD C,DIRORA ;MAKE IT RELATIVE
CAML B,C ;STILL BELOW TOP?
JRST MOVDN ;NO, MOVE DOWN
LOAD C,DRSBT,(D) ;ABOVE BOTTOM?
ADDI C,.SYMLN
ADD C,DIRORA ;MAKE IT RELATIVE
CAML B,C
IFSKP.
MOVE C,DIRORA ;GET DIR #
LOAD C,DRNUM,(C)
MOVEM B,LOOKUB ;SAVE B
CALL GETSNM ;GET STR NAME
BUG.(CHK,DIRSY3,DIRECT,HARD,<LOOKUP - Symbol search fouled up in directory>,<<C,DIRNUM>,<B,STRNAM>>,<
Cause: A disordered symbol table was found while looking for string in a
directory.
Action: Use the EXPUNGE command with subcommand REBUILD to rebuild index table
of the directory listed in the additional data. If this doesn't cure
the problem, delete the directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
MOVE B,LOOKUB ;RESTORE B
ENDIF.
;..
;..
SYMCMP: MOVEM A,LOOKUI ;Save increment
MOVEM B,DRLOC ;And symtab loc
MOVE A,LOOKUE ;GET ENTRY TYPE
CALL NAMCM1
JRST SYMCM0 ;No exact match
SKIPN DIRSRC ;Looking up a directory?
IFSKP. ;Yes
CALL DRLKFD ;Scan types and gens for a directory
JRST SYMCM1 ;No dir, treat as a partial match
ENDIF.
RETSKP ;SYMBOL FOUND
SYMCM0: MOVE C,A ;Keep NAMCM1 result
MOVE A,LOOKUI ;GET INCREMENT
MOVE B,DRLOC ;AND POINTER
JUMPL C,MOVDN ; A<B
JUMPG C,MOVUP ; A>B
;Here if a subset match occurred
SKIPN DIRSRC ;Looking for directories or files?
JRST SYMCM1 ;If files, normal subset action
CALL DRLKFD ;If dirs, scan types and generations
IFNSK. ;No directory file found?
TQO <MTCHF,AMBGF> ;Nope, treat as ambiguous
JRST SYMCM2
ENDIF.
;Here on a subset match
SYMCM1: TQOE <MTCHF> ; A IS SUBSET OF B
TQO <AMBGF>
SYMCM2: MOVE A,LOOKUI ;If not found, restore variables
MOVE B,DRLOC
JRST MOVDN
;STRFND - Routine to compare the user's input string with a found
;file to see if the two match. Also updates DRREC for partial
;recognition.
;
; Call with:
; no arguments
; CALL STRFND
;
; Returns:
; +1 - Always, with DRREC updated
STRFND: ADDI B,.SYMLN ;STEP TO NEXT SYMBOL
STRFDD: MOVEM B,DRLOC
SKIPL DIRSRC ;[7.1204] Are looking up directory?
TQNE <NREC,NREC1> ;Skip if recognition allowed
RET ;[7.1204] No symbol found or looking for directory
MOVEM B,LOOKUD ;Save this hit location
SETZM DRREC ;Blast count of matching characters
STRFD0: MOVEI B,.SYMLN ;Examine next entry
ADDB B,DRLOC ;Update this too
MOVE A,DIRORA ;Check for top of symbol table
LOAD A,DRSTP,(A)
ADD A,DIRORA ;Make it absolute
CAML B,A ;Entry index .LT. top?
JRST STRFD2 ;No
MOVE A,LOOKUE ;Entry type
CALL NAMCM1 ;(A,B/A,B) Still substring?
JUMPE A,STRFD1 ;A=0; A is subset of B
JRST STRFD2 ;Else A .LT. B, A .GT. B; or A=B, done in any case
STRFD1: MOVE B,DRLOC ;Recover clobbered ptr
LOAD A,SYMAD,(B) ;Relative pointer to FDB
ADD A,DIRORA ;Make absolute
CALL FDBCHK ;(A/) Check FDB for OKness
JRST STRFD2 ;Go no further
CALL NAMSCN ;(A/) Ensure at least 1 non-deleted, visible
JRST STRFD0 ;You can't recognize what you can't see
MOVE A,LOOKUD ;Get string block of first candidate
LOAD A,SYMAD,(A) ;Ptr to FDB
ADD A,DIRORA ;Make absolute
LOAD A,FBNAM,(A) ;Address of name string
MOVE B,DRLOC ;And that of the current candidate
LOAD B,SYMAD,(B) ;Pointer to FDB
ADD B,DIRORA ;Make it absolute
LOAD B,FBNAM,(B) ;Address of name string
MOVE C,DRREC ;Count of currently matching characters
CALL SUBSTR ;(A,B,C/A) Get new substring length
MOVEM A,DRREC ;And save it here
JRST STRFD0 ;Make sure to do them all
STRFD2: MOVE A,LOOKUD ;Restore initial hit location
MOVEM A,DRLOC ;Put it here
RET
;[7.1014]
;SUBSTR - This routine finds the largest common substring between 2
;inputs and less that or equal to some a priori limit
;
; Call with:
; A/ Rel address of first string block
; B/ Rel address of second string block
; C/ Max substring size + 1 (0 = infinite)
; CALL SUBSTR
;
; Returns:
; +1 - Always, with number of common characters + 1 in A
SUBSTR: SAVEQ ;Save these
EA.ENT ;In section 1
ADD A,DIRORA ;Form 30-bit virtual address
ADD B,DIRORA ;Same here
IFG. C ;Test count
SOJE C,SUBST2 ;Remove +1 part; If 0, quit
JRST SUBST0 ;Otherwise, measure strings
ENDIF.
LOAD C,BLKLEN,(A) ;Length of A string here
LOAD D,BLKLEN,(B) ;Length of B string here
CAILE C,0(D)
MOVEI C,0(D) ;C now has MIN (C,D)
SOS C ;Account for header
IMULI C,5 ;Max number of characters that can match
SUBST0: MOVNI C,0(C) ;Make AOBJN pointer
HRLZS C
MOVN Q1,DRINP ;Negative word address of 1st byte of input
ADD Q1,FILOPT(JFN) ;Plus current byte pointer
;At this point, Q1 has byte pointer info in LH and a word offset in RH.
;Use 18 bit arithmetic to add in the word offset of the 2 byte pointers
ADDI A,1(Q1) ;Add word offset + 1 to 30-bit address
ADDI B,1(Q1) ;Same here
;The following code converts the P field of the (presumed) 7-bit
;byte pointer in Q1 into P&S bits 0-5 corresponding to a one-word
;global byte pointer in Q1. See processor reference manual, sec 2.11
;page 2-85.
LSH Q1,-^D30 ;Slide P field over for arithmetic
IDIVI Q1,7 ;Compute (4 - byte # within word)
MOVNI Q1,-66(Q1) ;-1,,(66 - (byte # - 4))
LSH Q1,^D30 ;Move back to bits 0-5
IOR A,Q1 ;Or in P&S bits with 30-bit address
IOR B,Q1 ;Or in P&S bits with 30-bit address
SUBST1: ILDB Q1,A ;Input character from 1st string
ILDB Q2,B ;Input character from 2nd string
CAIE Q1,0(Q2) ;Same?
JRST SUBST2 ;No
JUMPE Q1,SUBST2 ;Yes, but if NUL then still quit
AOBJN C,SUBST1 ;Count it and do the rest
SUBST2: MOVEI A,1(C) ;Count of compares + 1
RET
;ROUTINE TO COMPARE NAME STRINGS
;ACCEPTS IN A/ ENTRY TYPE (IF CALLING NAMCM1)
; B/ ADR IN SYMBOL TABLE
; DRINP AND DRINL MUST BE SET UP
; CALL NAMCMM
;RETURNS +1: A=-1 => A<B, A=0 => A IS SUBSET OF B, A=1 => A>B
; +2: A=B
NAMCMM: MOVEI A,.ETNAM ;ASSUME NAME ENTRY TYPE
NAMCM1: LOAD C,SYMVL,(B) ;CHECK THE VALUE
CAMN C,[-1]
JRST NAMCM4 ;SYMBOL TABLE IS MESSED UP
LOAD C,SYMET,(B) ;GET ENTRY TYPE OF SYMBOL
CAMGE C,A ;Less than that being sought?
JRST STWAGB ;YES, A>B
CAMLE C,A ;Greater than entry type being sought?
JRST RETO ;YES, A<B
MOVE A,DRINP ;GET INPUT POINTER
MOVE D,(A) ;GET FIRST WORD
SKIPG DRINL ;ANY WORDS THERE?
AND D,DRMSK ;NO, MASK PARTIAL WORD
LOAD A,SYMVL,(B) ;GET VALUE OF SYMBOL
LSH A,-1 ;GET RID OF LOW ORDER BIT
LSH D,-1 ; AND GUARANTEE WORD IS POSITIVE
CAMGE A,D ;LESS THAN ONE SOUGHT?
JRST STWAGB ;YES, A>B
CAMLE A,D ;GREATER THAN ONE BEING SOUGHT
JRST NAMCM3 ;YES, A<B - GO SEE IF SUBSET
LOAD A,SYMAD,(B) ;GET ADDRESS OF FDB
ADD A,DIRORA ;MAKE IT ABSOLUTE
CAIE C,.ETNAM ;IS THIS A NAME SYMBOL
JRST NAMCMA ;NO, DONT GO TO FDB FOR NAME STRING
CALL FDBCHK ;VERIFY THAT THIS IS A GOOD FDB
JRST RETO ;NO, BOMB OUT
LOAD A,FBNAM,(A) ;GET ADDRESS OF NAME STRING
ADD A,DIRORA ;MAKE IT ABSOLUTE
LOAD D,NMLEN,(A) ;GET LENGTH OF STRING
JRST NAMCM2 ;GO COMPARE THE STRINGS
NAMCMA: LOAD D,ACLEN,(A) ;GET LENGTH OF ACCOUNT STRING
AOS A ;YES, STEP OVER SHARE COUNT
SOS D
NAMCM2: MOVEI D,-2(D) ;GET NEGATIVE LENGTH OF WORDS IN STRING
AOS C,A ;STEP TO FIRST WORD
MOVE A,DRINP ;GET POINTER TO INPUT STRING
MOVE B,DRINL ;GET # OF WORDS IN STRING
CALLRET STWCMP ;GO COMPARE THE STRINGS
NAMCM3: SKIPE DRINL ;IS THIS STRING ONLY ONE WORD LONG?
JRST RETO ;NO, RETURN A<B
LSH A,1 ;GET BACK CORRECT WORD
LSH D,1
AND A,DRMSK ;MASK OUT UNWANTED BITS
CAME A,D ;IS D A SUBSET OF A
JRST RETO ;NO, RETURN A<B
JRST RETZ ;YES, A IS A SUBSET OF B
NAMCM4: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRSY4,DIRECT,SOFT,<NAMCM4 - Directory symbol table fouled up in directory>,<<A,DIRNUM>,<B,STRNAM>>,<
Cause: A disordered symbol table was found while comparing name strings.
Action: Use the EXPUNGE command with subcommand REBUILD to rebuild index table
of the directory listed in the additional data. If this doesn't cure
the problem, delete the directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
JRST RETO
;String compare routine
;ACCEPTS IN A/ ADR OF FIRST WORD OF STRING A
; B/ # OF FULL WORDS IN STRING A
; C/ ADR OF FIRST WORD OF STRING B
; D/ # OF FULL WORDS IN STRING B
; CALL STWCMP
;ReturnS +1: A = -1 ;STRING A < STRING B
; A = 0 ;STRING A IS SUBSET OF STRING B
; A = 1 ;STRING A > STRING B
; +2: ;STRING A = STRING B
;Clobbers a,b,c,d
STWCMP: SAVEQ
STRCM0: JUMPLE B,STRCM1 ;Down to last word of string a?
MOVE Q2,(C) ;Get word of string b
MOVE Q1,(A) ;And word of string a
LSH Q1,-1 ;GET RID OF BIT 35
LSH Q2,-1 ;MAKE SURE THESE WORDS ARE POSITIVE
CAMGE Q2,Q1 ;A > B?
STRCM3: JRST STWAGB ;YES
CAMLE Q2,Q1 ;A < B?
JRST RETO ;YES
SOJL D,STRCM3 ;IS B GONE?
AOS C ;NO, STEP TO NEXT WORD
AOS A ;STEP A ALSO
SOJA B,STRCM0
STRCM1: MOVE Q2,(A) ;Get last word of string a
AND Q2,DRMSK ;Get rid of garbage
SKIPG D ;If string b is also down to last word,
CAME Q2,(C) ; Check for exact match
JRST STRCM4 ;Not exact match
RETSKP ;EXACT MATCH
STRCM4: MOVE Q1,DRMSK ;GET MASK FOR LAST WORD
AND Q1,(C) ;Truncate string b to same length as a
LSH Q1,-1 ;GET RID OF BIT 35
LSH Q2,-1
CAMGE Q1,Q2 ;A > B?
JRST STWAGB ;YES
CAMLE Q1,Q2 ;A < B?
JRST RETO ;YES
JRST RETZ ;NO, A IS SUBSET OF B
STWAGB: MOVEI A,1 ;RETURN A 1 IN A
RET
; Setup mask and input pointer for directory looks
; Call: A ; ADDRESS OF FIRST WORD (OR LOOKUP POINTER FOR SETMSK)
; B ; # OF FULL WORDS IN STRING (FOR SETMSB)
; CALL SETMSB OR CALL SETMSK
; Return
; +1 ; In DRINP, a string compare pointer to input
; ; IN DRINL, THE LENGTH OF THE STRING
; In DRMSK, a mask of ones for masking last word of input string
; Clobbers a,b,c,d
SETMSK::EA.ENT
HLRE B,A ; Get size of the string block
MOVNS B ; GET POSITIVE # OF WORDS
MOVEI A,1(A) ; GET ADR OF FIRST WORD
SETMSB::EA.ENT
MOVEM A,DRINP ; SAVE ADR OF STRING
MOVEM B,DRINL ; SAVE LENGTH OF STRING
ADD A,B ; GET ADR OF END OF STRING
MOVSI B,774000 ; 7 bit mask left justified
MOVNI C,1 ; Mask of bits to ignore
SETMS0: TDNN B,0(A) ; Look for the terminating null
JRST SETMS1 ; There it is, c has 1's for ignoration
LSH B,-7 ; Not there, shift to next bit
LSH C,-7
JRST SETMS0
SETMS1: SETCAM C,DRMSK ; Get mask of bits to test in last word
RET
; Copy the DRINP string to a new string block in directory
; Call: DRINP ; The input pointer
; DRINL ; LENGTH OF INPUT STRING (AS SET UP BY SETMSK)
; CALL CPYDIR
; Return
; +1 ; No room
; +2 ; Ok, in a, the location of the string block
; Clobbers a,b,c,d
CPYDIR::EA.ENT
MOVE B,DRINL ; Get length of input
ADDI B,2 ; for header and partial word
PUSH P,B ; Save for below
CALL ASGDFR ; Assign space for name string
JRST [ POP P,B ; No room
RET]
HRRZ B,DRINP ; GET LOC OF INPUT STRING BLOCK
XMOVEI C,1(A) ; AND STRING BLOCK IN DIRECTORY
PUSH P,A ;SAVE ADDRESS FOR RETURN
MOVE A,-1(P) ;GET LENGTH OF BLOCK
SOS A
CALL XBLTA ; DO BLT
POP P,A ; RESTORE
POP P,D
ADD D,A
MOVE C,DRMSK ; Get mask
ANDM C,-1(D) ; Zero low part of last word of string
RETSKP
;ROUTINE TO VERIFY THAT THE BACKUP COPY OF THE ROOT DIR IS GOOD
;ACCEPTS:
; A/STRUCTURE NUMBER
; CALL CHKBAK
;RETURNS +1: BACKUP FILE COULD NOT BE MADE
; +2: BACKUP FILE IS NOW GOOD
CHKBAK::EA.ENT
STKVAR <CKBSTR>
MOVEM A,CKBSTR ;SAVE STRUCTURE NUMBER
MOVE A,STRTAB(A) ;GET ADDRESS OF SDB
LOAD A,STRBXB,(A) ;GET ADDRESS OF XB OF BACKUP FILE
TLO A,(FILWB+THAWB) ;OPEN IT FOR WRITE THAWED
MOVE B,CKBSTR ;B/STRUCTURE NUMBER
CALL ASROFN ;GET AN OFN ON BACKUP FILE
BUG.(INF,CGROFN,DIRECT,SOFT,<CHKBAK - Can't get root-directory OFN>,<<T1,LSTERR>>,<
Cause: An OFN cannot be assigned for the backup Root-Directory of a file.
Action: There may be insufficient OFNs on your system. If this problem
persists, increase NOFN and rebuild your monitor. If this does not
help, then use the DOB% facility to take a dump and submit an SPR.
Data: LSTERR - Error returned from ASGOFN
>,R,<DB%NND>) ;[7.1210]
STOR A,DIROFN ;SAVE THIS OFN
SETONE DRROF ;INDICATE UNMAPD SHOULD RELEASE OFN
CALL MAPDRP ;MAP DIRECTORY PAGE
MOVEI A,ROOTDN ;CHECK THAT IT IS LIKE THE ROOT-DIR
CALL DR0CHK ;CHECK PAGE 0
JRST CHKBK1 ;NOT VALID, GO COPY IT
CALL SYMCHK ;MAKE SURE SYMBOL TABLE OK
JRST CHKBK1 ;NOT OK, GO COPY ROOT DIR
CALL BLKSCN ;SCAN ENTIRE FILE
JRST CHKBK1 ;SOMETHING WAS BAD
CALL UNMAPD ;UNMAP THE FILE AND RELEASE THE OFN
RETSKP ;BACKUP FILE IS GOOD
CHKBK1: CALL UNMAPD ;UNMAP THE FILE AND RELEASE THE OFN
MOVE A,CKBSTR ;A/STRUCTURE NUMBER
CALL CPYBAK ;GO MAKE A COPY OF THE FILE
BUG.(INF,CCBROT,DIRECT,HARD,<CPYBAK - Can't copy backup root-directory>,<<T1,LSTERR>>,<
Cause: The monitor has detected a problem with the backup root-directory and
is attempting to copy the primary root-directory to the backup. The
copy failed.
Action: Determine which disk was being used at the time and have Field Service
check the device to see if it is working properly.
Data: LSTERR - Error returned from CPYBAK
>,R,<DB%NND>) ;[7.1210]
RETSKP ;OK
;ROUTINES TO REFERENCE THE INDEX TABLE
; ROUTINE TO MAP AN INDEX TABLE FILE INTO THE PER-PROCESS AREA
;
; CALL: ACCEPTS IN T1/ STRUCTURE NUMBER
; CALL MAPIDX
; RETURNS: +1 ERROR
; +2 SUCCESS, INDEX TABLE MAPPED
MAPIDX: STKVAR <MPIDXS,MPIDXC>
MOVEM T1,MPIDXS ;SAVE STRUCTURE NUMBER
CALL STRCNV ;GO GET THE UNIQUE CODE FOR THIS STRUCTURE
RET ;FAILED, RETURN FAILURE
MOVEM T1,MPIDXC ;SAVE UNIQUE CODE FOR THIS STRUCTURE
JE IDXFLG,,MPIDX2 ;OMIT CHECK IF NO INDEX FILE MAPPED
LOAD T2,CURUC ;GET UNIQUE CODE OF CURRENTLY MAPPED INDEX FILE
CAMN T2,MPIDXC ;SAME AS DESIRED STRUCTURE ?
RETSKP ;YES, NO MORE WORK REQUIRED
MPIDX2: CALL UNMIDX ;NO, GO UNMAP CURRENTLY MAPPED INDEX FILE
; GET OFN OF INDEX TABLE FILE FOR DESIRED STRUCTURE
MOVE T1,MPIDXS ;GET DESIRED STRUCTURE #
MOVE T1,STRTAB(T1) ;GET ADDRESS OF SDB FOR THIS STRUCTURE
LOAD T2,STRIDX,(T1) ;GET OFN OF INDEX TABLE FILE FOR THIS STR
JUMPN T2,MPIDX4 ;IF OFN EXISTS, GO MAP INDEX TABLE
JE STIDX,(T1),MPIDX5 ;GO ON IF OFN OF INDEX TABLE FILE NOT YET SET UP
BUG.(CHK,MPIDXO,DIRECT,SOFT,<MAPIDX - No OFN for Index Table File>,,<
Cause: There is no open file number for the structure index table. The
structure index table file cannot be mapped.
Action: If this BUGCHK can be reproduced, set it dumpable and submit an SPR
with the dump and instructions on reproducing the problem.
>)
RETBAD(DELFX6) ;GIVE FAILURE RETURN
; MAP THE DESIRED INDEX TABLE FILE
MPIDX4: HLL T2,SHRPTR ;SET UP THE SHARE POINTER FOR THE OFN
MOVEM T2,IDXMAP ;SET UP THE MAP POINTER
HRRZ T1,T2 ;GET OFN IN T1
CALL UPSHR ;INCREMENT SHARE COUNT FOR INDEX TABLE
CALL MONCLA ;RESET THE MONITOR MAP
; STASH AWAY STR # AND UNIQUE CODE OF CURRENTLY MAPPED INDEX FILE, AND RETURN
MPIDX5: MOVE T1,MPIDXS ;GET STRUCTURE NUMBER
STOR T1,CURSTR ;SAVE STRUCTURE # IN PSB
MOVE T1,MPIDXC ;GET UNIQUE CODE
STOR T1,CURUC ;STORE UNIQUE CODE IN PSB
SETONE IDXFLG ;MARK THAT AN INDEX TABLE FILE IS NOW MAPPED
RETSKP ;RETURN SUCCESS
; ROUTINE TO UNMAP AN INDEX TABLE FILE
;
; CALL: CALL UNMIDX
; RETURNS: +1 ALWAYS, INDEX TABLE FILE NO LONGER MAPPED
UNMIDX::CALL UNMAPD ;UNMAP ANY DIR
JE IDXFLG,,R ;IF NO INDEX TABLE FILE MAPPED, JUST RETURN
SKIPN B,FKXORA ;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
MOVE B,IDXORA ;GET STARTING ADDRESS OF INDEX TABLE
MOVE C,MXDIRN ;MAX NUMBER OF DIRECTORIES
IMULI C,.IDXLN+.PPNLN ;NUMBER OF WORDS IN IDXTAB
LSH C,-PGSFT ;NUMBER OF PAGE IN INDEX + PPN EXTENSION
HRRZ A,IDXMAP ;GET OFN
IFN. A ;If we have an OFN
TXO A,FILUB ;Don't decrement the open count
CALL RELOFN ;RELEASE OFN
ENDIF.
SETZM IDXMAP ;CLEAR MAP FOR EXTENDED ADDRESSING
CALL MONCLA ;AND TELL HARDWARE ABOUT IT
SETZRO IDXFLG ;MARK THAT INDEX TABLE IS NO LONGER MAPPED
RET ;RETURN
;ROUTINE TO INITIALIZE IDXTAB
; CALL CLRIDX ;MUST HAVE IDXTAB MAPPED
;RETURNS +1: ALWAYS
CLRIDX::EA.ENT
SKIPN A,FKXORA ;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
MOVE A,IDXORA ;GET START OF THE IDXTAB
MOVE B,MXDIRN ;GET MAX SIZE OF IDXTAB
IMULI B,.IDXLN+.PPNLN ;GET TIMES LENGTH OF EACH ENTRY
CLRID1: SETZM 0(A) ;CLEAR THIS WORD
AOS A ;STEP TO NEXT WORD
SOJG B,CLRID1 ;ZERO THE WHOLE TABLE
CALL UPDIDX ;UPDATE THE IDX PAGES
RET ;DONE
;ROUTINE TO SET VALUES INTO THE TABLE
;ACCEPTS IN A/ DIR #
; B/ RELATIVE ADR OF FDB IN ROOT DIRECTORY FILE
; C/ DISK ADR OF INDEX BLOCK FOR DIRECTORY FILE
; D/ DIRECTORY NUMBER OF SUPERIOR DIRECTORY
; * * * ASSUMES THAT THE INDEX TABLE IS ALREADY MAPPED * * *
; CALL SETIDX
;RETURNS +1: ILLEGAL DIR # OR INDEX ALREADY SET FOR THIS #
; +2: INDEX VALUE SET UP
SETIDX::EA.ENT
SKIPLE A ;ZERO OR NEGATIVE IS BAD
CAML A,MXDIRN ;IS THIS A LEGAL DIRECTORY NUMBER
RETBAD (DIRX1) ;NO
SKIPLE D ;CHECK SUPERIOR DIR NUMBER
CAML D,MXDIRN ;WITHIN RANGE?
RETBAD (DIRX1) ;NO.
PUSH P,D ;SAVE SUPERIOR DIR NUMBER
IMULI A,.IDXLN ;GET RELATIVE INDEX INTO TABLE
SKIPN D,FKXORA ;GET SPECIAL IDXORA IF STR CREATION
MOVE D,IDXORA
ADD A,D ;MAKE ABSOLUTE ADDRESS OF INDEX ENTRY
LOAD D,IDXIB,(A) ;MAKE SURE THE ENTRY IS NOT ALREADY SET
CAME D,C ;IF IT IS SET, IT MUST BE THE SAME
JUMPN D,[ POP P,(P) ;SCRAP STACK
RETBAD (DIRX1)]
STOR B,IDXFB,(A) ;SET UP ADDRESS OF FDB
STOR C,IDXIB,(A) ;SET UP DISK ADR OF INDEX BLOCK
POP P,D ;GET SUPERIOR DIR NUMBER BACK
STOR D,IDXSD,(A) ;STORE SUPERIOR DIR NUMBER
SETZRO IDXFG,(A) ;ZERO THE FLAGS
CALL UPDIDX ;UPDATE THE IDX FILE
RETSKP ;AND EXIT
;ROUTINE TO GET THE FDB ADR AND INDEX BLOCK ADR FOR A DIRECTORY
;ACCEPTS IN A/ DIR #
; CALL GETIDX
;RETURNS +1: ILLEGAL DIR #
; +2: A/ FDB ADR
; B/ INDEX BLOCK DISK ADR
; C/ SUPERIOR DIR NUMBER
; D/ FLAGS FROM IDXFG
GETIDX::EA.ENT
CALL CNVIDX ;CONVERT DIR # TO IDXTAB INDEX
RETBAD ;ILLEGAL #
LOAD B,IDXMB,(A) ;[8823] Load the non-storage address bits
JUMPN B,GETID1 ;[8823] If not 0, index table trashed
LOAD B,IDXIB,(A) ;GET THE DISK ADR OF INDEX BLOCK
JUMPE B,[RETBAD(DIRX1)] ;IF 0, NOT SET UP YET
LOAD C,IDXSD,(A) ;GET SUPERIOR DIR NUMBER
LOAD D,IDXFG,(A) ;GET FLAGS INTO D
CAILE D,IDX%MX ;[8823] Valid flags?
JRST GETID1 ;[8823] No, the INDEX-TABLE is munged
LOAD A,IDXFB,(A) ;GET THE FDB ADR
RETSKP ;GOOD RETURN
GETID1: LOAD A,CURSTR ;[8823] Get current structure
MOVE A,STRTAB(A) ;[8823] Now get SDB address
MOVE A,SDBNAM(A) ;[8823] Finally, get structure name
BUG.(CHK,DIRITD,DIRECT,HARD,<GETIDX - Structure INDEX-TABLE has been damged>,<<A,STRNAM>>,<
Cause: The non-storage related bits in the INDEX-TABLE are not 0. The
structure's INDEX-TABLE is damaged.
Action: Determine the structure name (it's in SIXBIT in the additional data)
and RECONSTRUCT the INDEX-TABLE of this structure with CHECKD.
Data: STRNAM - SIXBIT structure name
>,,<DB%NND>) ;[8823] Let everyone know we found a bad one
RETBAD (DIRX6) ;[8823] And return to the user
;ROUTINE TO CONVERT A DIR # TO AN IDXTAB INDEX
;ACCEPTS IN T1/ 18-BIT DIR #
; CALL CNVIDX
;RETURNS +1: ILLEGAL DIR NUMBER
; +2: A/ INDEX INTO IDXTAB
CNVIDX: SKIPLE A ;ZERO OR NEGATIVE IS BAD
CAML A,MXDIRN ;IS NUMBER TOO HIGH?
RETBAD (DIRX1) ;YES, ILLEGAL DIR NUMBER
IMULI A,.IDXLN ;GET RELATIVE INDEX
SKIPN B,FKXORA ;GET SPECIAL IDXORA IF STR CREATION
MOVE B,IDXORA
ADD A,B ;MAKE ABSOLUTE INDEX INTO TABLE
RETSKP
;ROUTINE TO GET NEXT FREE DIRECTORY NUMBER
; ACCEPTS IN A/ STRUCTURE NUMBER
; CALL GETNDN
;RETURNS +1: NO MORE DIRECTORY NUMBERS AVAILABLE
; +2: DIRECTORY NUMBER IN A
GETNDN::EA.ENT
MOVE A,STRTAB(A) ;GET SDB
LOAD B,STRLDN,(A) ;GET CURRENT LAST DIRNUM
MOVE C,B ;COPY TO START LOOP
GTNDN1: ADDI C,1 ;STEP TO NEXT
CAML C,MXDIRN ;OVERFLOW?
MOVEI C,NRESDN ;YES - WRAPAROUND
CAMN C,B ;BACK TO ORIGINAL?
RETBAD(GJFX32) ;YES - NO MORE DIR NUMBERS
MOVE D,C ;CHECK INDEX
IMULI D,.IDXLN ;TO SEE IF THIS
SKIPN B,FKXORA ;GET SPECIAL FORK IDXORA IF STR CREATION
MOVE B,IDXORA
ADD D,B ;NUMBER IS FREE
JN IDXIV,(D),GTNDN1 ;SKIP ANY INVALID ENTRIES
LOAD D,IDXIB,(D) ;CHECK IF INDEX BLOCK
JUMPN D,GTNDN1 ;IS KNOWN
STOR C,STRLDN,(A) ;SAVE NEW LAST DIR
MOVE A,C ;DIRNUM IS FREE, RETURN IT
RETSKP
;ROUTINE TO DELETE AN ENTRY FROM THE INDEX TABLE
;ACCEPTS IN A/ DIR NUMBER
; CALL DELIDX
;RETURNS +1: ALWAYS
DELIDX::EA.ENT
STKVAR <SVDNUM> ;[7218]STORAGE TO HOLD DIRECTORY NUMBER
MOVEM A,SVDNUM ;[7218]SAVE DIR #
CALL CNVIDX ;GET INDEX INTO IDXTAB
RET
SETZRO IDXFB,(A) ;CLEAR ALL ENTRIES
SETZRO IDXIB,(A)
SETZRO IDXSD,(A)
SETZRO IDXFG,(A)
MOVE A,SVDNUM ;[7218] GET BACK DIRECTORY NUMBER
CALL ADRPPN ;[7218] CALCULATE PPN OFFSET
CALLRET UPDIDX ;[7218] NO PPNS, SO UPDATE IDXTAB
SKIPE (A) ;[7218] PREVENT WRITING OUT UNCHANGED PAGE
SETZM (A) ;[7218] ENTRY EXISTS, SO CLEAR IT
CALLRET UPDIDX ;UPDATE IDXTAB
ENDSV. ;[7218] END STORAGE
;ROUTINE TO INVALIDATE AN IDXTAB ENTRY
;ACCEPTS IN A/ 18-BIT DIR NUMBER
; CALL INVIDX
;RETURNS +1: ALWAYS
INVIDX::EA.ENT
ASUBR <DIRNO>
; IFN CFSCOD,< ;for CFS
MOVE T2,T1 ;Copy directory number
LOAD T1,CURSTR ;Get structure number
CALL REMALC ;Release CFS resource
MOVE T1,DIRNO ;Dir number again
; > ;IFN CFSCOD
CALL CNVIDX ;GET INDEX INTO IDXTAB
RET
SETONE IDXIV,(A) ;MARK IT INVALID
CALLRET UPDIDX ;GO UPDATE THE IDX FILE
ENDAS.
;ROUTINE TO PUSH BACK THE PAGES TO IDXFIL
; CALL UPDIDX
;RETURNS +1: ALWAYS - IDXFIL IS NOW GOOD ON DISK
UPDIDX: LOAD T1,CURSTR ;GET STR NUMBER
SKIPN FKXORA ;Real IDX?
SKIPN T1,STRTAB(T1) ;GET POINTER TO SDB
RET ;NONE? DONT DO ANYTHING
LOAD T1,STRIDX,(T1) ;GET THE OFN OF IDXFIL
SKIPN T1 ;IS THERE ONE?
RET ;NO, THEN NOTHING TO DO
HRLZS T1 ;GET OFN,,PN FOR PAGE 0
MOVE T2,MXDIRN ;MAX NUMBER OF DIRECTORIES
IMULI T2,.IDXLN+.PPNLN ;NUMBER OF WORDS IN IDXTAB
LSH T2,-PGSFT ;NUMBER OF PAGE IN INDEX + PPN EXTENSION
CALLRET UPDPGS ;GO UPDATE THEM
;ROUTINE TO MOVE PPN FROM DIRECTORY TO PPN EXTENSION OF IDXTAB
;ACCEPTS IN A/ DIR #
; CALL SETPPN
;RETURNS +1: ALWAYS - PPN STORED, IDXTAB UPDATED ON DISK
;DIRECTORY AND IDXTAB MUST BE MAPPED
SETPPN::EA.ENT
CALL ADRPPN ;COMPUTE ADDRESS TO STORE PPN
RET ;CAN'T STORE PPN IF NO IDXTAB EXTENSION
MOVE B,DIRORA ;DIRECTORY ORIGIN
LOAD B,DRPPN,(B) ;PPN FROM DIRECTORY
MOVEM B,(A) ;STORE IT IN IDXTAB EXTENSION
CALLRET UPDIDX ;REWRITE TABLE AND RETURN
;ROUTINE TO COMPUTE THE ADDRESS OF A PPN IN THE IDXTAB EXTENSION
;ACCEPTS IN A/ DIR #
; CALL ADRPPN
;RETURNS +1: IF FKXORA.NE.0
;RETURNS +2: (A) = ADDRESS OF PPN ENTRY IN IDXTAB EXTENSION
ADRPPN: SKIPE FKXORA ;SPECIAL FORK IDXORA IF STR CREATION
RET ;YES, NO EXTENSION TO IDXTAB EXISTS
MOVE B,MXDIRN ;MAX NUMBER OF DIRECTORIES
IMULI B,.IDXLN ;NUMBER OF WORDS FOR OLD IDXTAB
MOVE C,IDXORA ;NO, GET IDXTAB ORIGIN
ADD B,C ;ADDRESS OF BEGINNING OF PPN EXTENSION
ADD A,B ;LOC OF PPN FOR THIS DIR
RETSKP
;ROUTINE TO MAP A PPN INTO A DIRECTORY NUMBER
;ACCEPTS IN A/ PPN
; CALL FNDPPN
;RETURNS +1: NO MATCH ON PPN
;RETURNS +2: (A) = DIR # CORRESPONDING TO PPN
; (B) = PPN
;IDXTAB MUST BE MAPPED
FNDPPN::JUMPE A,R ;ZERO IS NOT A PPN
EA.ENT
STKVAR <SAVPPN> ;TEMP
MOVEM A,SAVPPN ;SAVE PPN
MOVEI A,0 ;START AT THE BEGINNING OF THE PPN EXTENSION
CALL ADRPPN ;GET ADDRESS OF PPNS
RET ;NO PPN IF NO IDXTAB EXTENSION
MOVE C,A ;ADDRESS TO C
SETZ A, ;INITIALIZE DIRECTORY NUMBER
MOVE B,SAVPPN ;CALLER SUPPLIED PPN
FNDPP1: CAMN B,(C) ;MATCH?
RETSKP ;YES, FOUND THE PPN
AOS C ;NEXT LOC
CAMGE A,MXDIRN ;LOOKED THROUGH THE ENTIRE TABLE?
AOJA A,FNDPP1 ;NO, LOOK AT THE NEXT ENTRY
RET ;NOT FOUND RETURN
;ROUTINES TO CHECK THE CONSISTENCY OF THE DIRECTORY
;ROUTINE TO CHECK THE CONSISTENCY OF THE HEADER ON THE FIRST DIR PAGE
;ASSUMES DIR IS MAPPED
;ACCEPTS IN A/ DIR NUMBER
; CALL DR0CHK
;RETURNS +1: HEADER IS SCREWED UP
; +2: OK
;DOES NOT SAVE TEMPORARY ACS
DR0CHK: MOVE D,DIRORA ;GET BASE ADR OF MAPPED DIR AREA
LOAD B,DRNUM,(D) ;GET DIR NUMBER
CAME A,B ;DO THE DIRECTORY NUMBERS MATCH?
JRST DR0CHB ;NO
LOAD B,DRTYP,(D) ;GET BLOCK TYPE
CAIE B,.TYDIR ;IS BLOCK TYPE CORRECT?
JRST DR0CHB ;NO
LOAD B,DRRPN,(D) ;GET RELATIVE PAGE #
JUMPN B,DR0CHB ;MUST BE 0
LOAD B,DRSTP,(D) ;GET TOP OF SYMBOL TABLE
SOS B ;GET LAST WORD USED
LSH B,-PGSFT ;TURN IT INTO PAGE #
CAML B,NDIRPG ;WITHIN BOUNDS?
RETBAD (DIRX5) ;NO, PROBABLY CAME FROM EXTENDED SYSTEM
LOAD B,DRFFB,(D) ;GET ADR OF FIRST FREE BLOCK
TRZ B,777 ;IT MUST POINT ONTO THIS PAGE
JUMPN B,DR0CHB
LOAD A,DRNAM,(D) ;NOW CHECK NAME BLOCK
JUMPE A,DR0CH1 ;DONT WORRY IF NO NAME
CALL NAMCHK ;MAKE SURE THIS IS A NAME BLOCK
RET ;NO
DR0CH1: LOAD A,DRPSW,(D) ;GET PASSWORD POINTER
JUMPE A,DR0CH2 ;COULD BE 0
CALL NAMCHK ;CHECK BLOCK TYPE
RET ;FAILED CHECK
DR0CH2: LOAD A,DRACT,(D) ;GET PTR TO DEFAULT DIR ACCOUNT
JUMPE A,DR0CH3 ;COULD BE 0
CALL NAMCHK ;CHECK THE BLOCK TYPE
RET ;FAILED
DR0CH3: LOAD A,DRRNA,(D) ;GET REMOTE ALIAS POINTER
JUMPE A,DR0CH4 ;COULD BE ZERO
CALL RNACHK ;CHECK IT OUT
RET ;FAILED
DR0CH4: RETSKP ;EVERYTHING IS IN ORDER
DR0CHB: CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRPG0,DIRECT,HARD,<DR0CHK - Illegal format for directory page 0 in directory>,<<A,DIRNUM>,<B,STRNAM>>,<
Cause: The directory header contains incorrect information.
Action: Delete directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK HEADERS OF PAGES OTHER THAN 0
;ACCEPTS IN A/ PAGE #
; CALL DRHCHK
;RETURNS +1: HEADER IS BAD
; +2: OK
DRHCHK: JUMPE A,RSKP ;IF PAGE 0, ASSUME GOOD
MOVE D,DIRORA ;GET BASE ADR
LOAD B,DRNUM,(D) ;GET DIR NUMBER FROM PAGE 0
MOVE C,A ;GET PAGE NUMBER
LSH C,PGSFT ;TURN IT INTO RELATIVE ADDRESS
ADD C,DIRORA ;MAKE IT ABSOLUTE
LOAD D,DRRPN,(C) ;GET RELATIVE PAGE #
CAME A,D ;MUST MATCH ARGUMENT
JRST DRHCHB ;FAILURE
LOAD D,DRFFB,(C) ;GET ADR OF FIRST FREE BLOCK ON PAGE
JUMPE D,DRHCH1 ;COULD BE 0 IF NONE
LSH D,-PGSFT ;GET PAGE # OF ADDRESS
CAME A,D ;MUST MATCH PAGE # OF THIS PAGE
JRST DRHCHB
DRHCH1: LOAD A,DRNUM,(C) ;GET DIR # OF THIS PAGE
CAME A,B ;MUST BE SAME AS PAGE 0 DIR #
JRST DRHCHB
LOAD A,DRTYP,(C) ;GET HEADER TYPE CODE
CAIE A,.TYDIR ;IS THIS A HEADER BLOCK?
JRST DRHCHB ;NO
RETSKP ;HEADER IS OK
DRHCHB: MOVE A,C ;MOVE BLOCK ADDRESS TO RIGHT AC
CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRPG1,DIRECT,HARD,<DRHCHK - Directory header block is bad in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The directory header contains incorrect information.
Action: Delete the directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK THE SYMBOL TABLE HEADER
; CALL SYMCHK
;RETURNS +1: BAD
; +2: OK
SYMCHK::EA.ENT
SAVET ;SAVE ALL ACS
MOVE D,DIRORA ;GET BASE ADDRESS
LOAD A,DRSBT,(D) ;GET ADDRESS OF SYMBOL TABLE
ADD A,DIRORA ;MAKE IT ABSOLUTE
LOAD B,SYMTY,(A) ;GET HEADER TYPE
CAIE B,.TYSYM ;IS THIS A SYMBOL TABLE?
JRST SYMBAD ;NO
LOAD B,SYMDN,(A) ;GET DIRECTORY NUMBER
LOAD C,DRNUM,(D) ;GET DIR # FROM PAGE 0
CAME B,C ;THEY MUST MATCH
JRST SYMBAD
LOAD B,SYMVL,(A) ;GET SECOND WORD
CAMN B,[-1] ;MUST BE -1
RETSKP ;SYMBOL TABLE HEADER OK
SYMBAD: LOAD A,DRNUM,(D) ;GET DIR # FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRSY5,DIRECT,HARD,<SYMBAD - Illegal format for directory symbol table in directory>,<<A,DIRNUM>,<B,STRNAM>>,<
Cause: A symbol table header contains incorrect information.
Action: Use the EXPUNGE command with subcommand REBUILD to rebuild index table
of the directory listed in the additional data. If this doesn't cure
the problem, delete the directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK AN FDB
;ACCEPTS IN A/ ABSOLUTE ADR OF FDB
; CALL FDBCHK
;RETURNS +1: BAD FDB
; +2: FDB OK
;ALL ACS ARE SAVED AND RESTORED
FDBCHQ: SAVET ;ENTRY POINT FOR NO BUGCHK ON FAILURE
STKVAR <FDBCHA,FDBCHF>
SETZM FDBCHF ;MARK THAT BUGCHK NOT WANTED
JRST FDBCH0 ;GO ENTER COMMON CODE
;ROUTINE TO CHECK A RELATIVE FDB ADR
FDBCHR: JUMPE A,RSKP ;0 IS ALRIGHT
SAVET ;SAVE ALL ACS
ADD A,DIRORA ;GET ABSOLUTE ADR
JRST FDBCH4 ;ENTER COMMON CODE
FDBCHK: SAVET ;SAVE ALL ACS USED
FDBCH4: STKVAR <FDBCHA,FDBCHF>
SETOM FDBCHF ;MARK THAT BUGCHK TO BE DONE ON FAILURE
FDBCH0: MOVEM A,FDBCHA ;SAVE ADR OF FDB
LOAD B,DRLFDB ;GET THE ADR OF THE LAST FDB CHECKED
HRRZS B ;ONLY CHECK 18 BITS
CAIN B,0(A) ;IF DIFFERENT, THEN MUST DO THE CHECK
RETSKP ;OTHERWISE, SKIP THE CHECK
CALL ADRCHK ;CHECK THIS ADDRESS
JRST FDBBAD ;NOT GOOD
LOAD B,FBTYP,(A) ;GET BLOCK TYPE
LOAD C,FBLEN,(A) ;GET LENGTH OF BLOCK
CAIL C,.FBLN0 ;MUST BE GREATER THAN GROUND 0 LENGTH
CAIE B,.TYFDB ;BLOCK TYPE MUST BE "FDB"
JRST FDBBAD ;BAD FDB
LOAD A,FBNAM,(A) ;GET POINTER TO NAME STRING
JUMPE A,FDBCH1 ;NAME NOT SET UP YET
CALL NAMCHK ;CHECK NAME
RET ;BAD
FDBCH1: MOVE A,FDBCHA ;GET BACK FDB ADR
LOAD A,FBEXT,(A) ;GET POINTER TO EXT STRING
JUMPE A,FDBCH2 ;MIGHT NOT BE SET UP YET
CALL EXTCHK ;CHECK EXT BLOCK
RET ;BAD
FDBCH2: MOVE A,FDBCHA ;GET FDB ADR AGAIN
LOAD A,FBACT,(A) ;GET POINTER TO ACCOUNT STRING
JUMPLE A,FDBCH3 ;SEE IF THERE IS AN ACCOUNT STRING
CALL ACTCHK ;YES, CHECK ITS BLOCK TYPE
RET ;BAD
; ..
; ..
FDBCH3: MOVE A,FDBCHA ;GET BACK FDB ADDR
LOAD B,FBVER,(A) ;GET VERSION #
CAIGE B,1 ;VER #1 OR LATER?
JRST FDBCH6 ;OLDER - JUST EXIT
LOAD A,FBLWR,(A) ;GET LAST WRITER STRING
JUMPE A,FDBCH5 ;IGNORE OF NONE
CALL UNSCHK ;CHECK ITS BLOCK TYPE
RET ;BAD
FDBCH5: MOVE A,FDBCHA ;FDB ADDRS AGAIN
LOAD A,FBAUT,(A) ;GET AUTHOR STRING
JUMPE A,FDBCH6 ;ALL DONE IF NONE
CALL UNSCHK ;CHECK ITS BLOCK TYPE
RET ;BAD
FDBCH6: MOVE A,FDBCHA ;GET ADR OF FDB
STOR A,DRLFDB ;SAVE IT FOR NEXT TIME
RETSKP ;FDB LOOKS OK
FDBBAD: MOVE A,FDBCHA ;GET BACK FDB ADDRESS
CALL GETDSA ;COLLECT INFORMATION FOR BUGCHK
SKIPE FDBCHF ;BUG CHECK MESSAGE WANTED?
BUG.(CHK,DIRFDB,DIRECT,HARD,<Illegal format for FDB in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The format for a FDB in a directory is incorrect.
Action: The directory should be rebuilt.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - The FDB address within the directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK A NAME BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF NAME BLOCK
; CALL NAMCHK
;RETURNS +1: BAD BLOCK TYPE
; +2: OK
;ALL ACS SAVED AND RESTORED
NAMCHK: SAVET ;SAVE ALL ACS
ADD A,DIRORA ;MAKE ADDRESS ABSOLUTE
CALL ADRCHK ;CHECK THIS ADDRESS
JRST NAMBAD ;NO GOOD
LOAD B,NMTYP,(A) ;GET BLOCK TYPE
LOAD C,NMLEN,(A) ;GET LENGTH
CAIL C,2 ;MUST BE AT LEAST 2 WORDS LONG
CAIE B,.TYNAM ;AND MUST BE A NAME BLOCK
JRST NAMBAD ;LOSE
RETSKP ;NAME BLOCK OK
NAMBAD: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRNAM,DIRECT,HARD,<NAMBAD - Illegal format for directory name block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The file name block is not correct in the symbol table.
Action: Delete and expunge file, then restore it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
RETBAD (DIRX3)
;ROUTINE TO CHECK AN EXTENSION BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF EXTENSION BLOCK
; CALL EXTCHK
;RETURNS +1: BAD BLOCK
; +2: OK
;SAVES AND RESTORES ALL ACS
EXTCHK: SAVET
ADD A,DIRORA ;MAKE ADDRESS ABSOLTE
CALL ADRCHK ;SEE IF ADR IS GOOD
JRST EXTBAD ;NO GOOD
LOAD B,EXTYP,(A) ;GET TYPE
LOAD C,EXLEN,(A) ;AND LENGTH
CAIL C,2 ;LENGTH MUST BE AT LEAST 2
CAIE B,.TYEXT ;EXTENSION TYPE OK?
JRST EXTBAD ;NO GOOD
RETSKP ;OK
EXTBAD: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIREXT,DIRECT,HARD,<EXTBAD - Illegal format for directory extension block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The file extension block is not correct in symbol table.
Action: Delete and expunge file, then restore it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK AN ACCOUNT STRING BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF ACCOUNT STRING BLOCK
; CALL ACTCHK
;RETURNS +1: BAD ACCOUNT BLOCK
; +2: OK
;SAVES AND RESTORES ALL ACS
ACTCHK: SAVET
ADD A,DIRORA ;GET ABS ADR
CALL ADRCHK ;CHECK ADR
JRST ACTBAD ;BAD ADR
LOAD B,ACTYP,(A) ;GET BLOCK TYPE
LOAD C,ACLEN,(A) ;AND LENGTH
CAIL C,3 ;MUST BE AT LEAST 3 WORDS LONG
CAIE B,.TYACT ;ACCOUNT BLOCK TYPE?
JRST ACTBAD ;NO
RETSKP ;OK
ACTBAD: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRACT,DIRECT,SOFT,<ACTBAD - Illegal format for directory account block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The file account string block is not correct in the symbol table.
Action: Delete and expunge file, then restore it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK A FREE BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF FREE BLOCK
; CALL FRECHK
;RETURNS +1: BAD
; +2: OK
;SAVES AND RESTORES ALL ACS
FRECHK: SAVET
ADD A,DIRORA ;GET ABSOLUTE ADDRESS OF BLOCK
CALL ADRCHK ;CHECK THE ADDRESS
JRST FREBAD ;BAD
LOAD B,FRTYP,(A) ;GET BLOCK TYPE
LOAD C,FRLEN,(A) ;AND LENGTH
CAIL C,2 ;LENGTH MUST BE AT LEAST 2
CAIE B,.TYFRE ;MUST BE A FREE BLOCK
JRST FREBAD
LOAD B,FRNFB,(A) ;GET NEXT BLOCK ON CHAIN
JUMPE B,FRECH1 ;0 IS ALWAYS OK
MOVE C,A ;COPY ADDRESS
SUB C,DIRORA ;GET RELATIVE ADR OF THIS BLOCK
XOR C,B ;SEE IF THE BLOCKS ARE ON THE SAME PAGE
TRZ C,PGSIZ-1 ;MASK OFF LOW ORDER BITS
JUMPN C,FREBAD ;IF NOT ON SAME PAGE, GO COMPLAIN
FRECH1: RETSKP ;BLOCK IS OK
FREBAD: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRFRE,DIRECT,SOFT,<FREBAD - Illegal format for directory free block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The directory free block is not correct.
Action: Use the DELETE command with subcommand DIRECTORY to delete the
directory file, then rebuild the directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINE TO CHECK A USER NAME STRING BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF NAME STRING BLOCK
; CALL UNSCHK
;RETURNS +1: BAD USER NAME BLOCK
; +2: OK
;SAVES AND RESTORES ALL ACS
UNSCHK: SAVET
ADD A,DIRORA ;GET ABS ADDR
CALL ADRCHK ;CHECK ADDR
JRST UNSBAD ;BAD ADDRS
LOAD B,UNTYP,(A) ;GET BLOCK TYPE
LOAD C,UNLEN,(A) ; AND LENGTH
CAIL C,3 ;MUST BE AT LEAST 3
CAIE B,.TYUNS ;USER NAME BLOCK TYPE?
JRST UNSBAD ;SOMETHING WRONG
RETSKP ;GIVE GOOD RETURN
UNSBAD: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR MESSAGE
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRUNS,DIRECT,HARD,<UNSBAD - Illegal format for directory user name block in directory>,<<A,DIRNUM>,<B,STRNAM>>,<
Cause: The user name string block is incorrect in the symbol table.
Action: Use the DELETE command with subcommand DIRECTORY to delete the
directory file, then rebuild the directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;check validity of remote alias block
;CALL RNACHK
;A/ relative address of remote alias block
;returns +2 on success
;returns +1 on failure, with BUGCHK
RNACHK: SAVEAC <T1,T2,T3,T4,Q1>
ADD A,DIRORA ;make address absolute
CALL ADRCHK ;see if valid
JRST RNABAD ;it isn't
LOAD B,RNTYP,(A) ;get block type
LOAD C,RNLEN,(A) ;and length
CAIL C,2 ;length must be at least 2
CAIE B,.TYRNA ;and type must be remote alias
JRST RNABAD ;failed
MOVE D,A ;get working copy of block address
MOVE Q1,A ;get permanent copy of block address
SKIPN A,RN.NXT(D) ;is there a real next pointer ?
IFSKP.
ADD A,DIRORA ;there is one, make address absolute
LOAD B,RNTYP,(A) ;check
CAIN B,.TYRNA ; type
CALL ADRCHK ; and address
JRST RNABAD ;failed
ENDIF.
LOAD C,RNLEN,(D) ;get count of
SUBI C,RN.NOD ; name block slots.
JUMPE C,RSKP ;if none, then done
ADDI D,RN.NOD ;get to name blocks (node, userid, password)
RNACH1: SKIPN A,(D) ;get (relative) address of name block
IFSKP.
CALL NAMCHK ;there really is one, check it out.
JRST RNABAD ;failed.
ENDIF.
AOS D ;step to
SOJG C,RNACH1 ; next entry
RETSKP ;done. success
;here on failure
RNABAD: MOVE A,Q1 ;get address of remote alias block
CALL GETDSA ;(A/A,B,C) directory #, structure name, addr
BUG.(CHK,DRXRNA,DIRECT,SOFT,<DIRRNA - Illegal formatted remote alias block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: Illegal formatted remote alias block.
Action: Use the DELETE command with subcommand DIRECTORY to delete the
directory file, then rebuild the directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
RETBAD (DIRX3)
;ROUTINE TO CHECK THAT AN ADR IS WITHIN THE DIR BOUNDS
;ACCEPTS IN A/ ABS ADR TO BE CHECKED
; CALL ADRCHK
;RETURNS +1: ILLEGAL ADR
; +2: OK
;PRESERVES A, USES ONLY B
ADRCHK: MOVE B,DIRORA ;GET UPPER BOUNDS
LOAD B,DRSBT,(B) ;MUST BE BELOW SYMBOL TABLE
ADD B,DIRORA ;GET ABSOLUTE ADR
CAML A,DIRORA ;ABOVE LOWER LIMIT?
CAML A,B ;AND BELOW UPPER LIMIT?
RET ;NO
RETSKP ;YES, ADR IS OK
;ROUTINE TO REBUILD THE SYMBOL TABLE (ON DELDF JSYS)
;ASSUMES DIRECTORY IS MAPPED
;ACCEPTS IN A/ 0 - CHECK DIRECTORY
; -1 - REBUILD DIRECTORY SYMBOL TABLE
; CALL RBLDST
;RETURNS +1: DIR IS SCREWED UP AND NOTHING WAS DONE
; +2: SYMBOL TABLE WAS REBUILT
RBLDST: SAVEPQ ;SAVE PERMANENT ACS USED
STKVAR <RBLDSP,RBLDSC>
MOVEM A,P3 ;STORE REBUILD FLAG
SETZM RBLDSC ;CLEAR SUBDIR COUNT
SETZM RBLDSP ;INITIALIZE POINTER WORD
CALL BLKSCN ;SCAN THE DIR FOR CONSISTENCY IN BLOCKS
RETBAD () ;DIR IS NOT CONSISTENT, DONT REBUILD
JUMPN P3,RBLD0A ;REBUILDING?
CALL SYMSCN ;NO, SCAN SYMBOL TABLE FOR VALIDITY
RETBAD () ;NEEDS REBUILDING
RBLD0A: MOVE Q1,DIRORA ;GET BASE ADR OF MAPPED AREA
JUMPE P3,RBLDS0 ;IF CHECKING, DONT ZERO SYMBOL TABLE
LOAD A,DRSTP,(Q1) ;GET TOP OF SYMBOL TABLE
SUBI A,.SYMLN ;GET NEW BOTTOM OF SYMBOL TABLE
STOR A,DRSBT,(Q1) ;SYMBOL TABLE IS NOW EMPTY
ADD A,DIRORA ;GET ABS ADR OF NEW BOTTOM
MOVEI B,.TYSYM ;SET UP SYMBOL TABLE HEADER
STOR B,SYMTY,(A) ;BLOCK TYPE
LOAD B,DRNUM,(Q1) ;DIR NUMBER
STOR B,SYMDN,(A) ;...
OPSTRM <SETOM >,SYMVL,(A) ;VALUE = -1
RBLDS0: LOAD Q2,DRFTP,(Q1) ;GET TOP OF FREE AREA
ADD Q2,DIRORA ;GET ABS ADR OF TOP OF FREE AREA
RBLDS1: LOAD A,BLKTYP,(Q1) ;SCAN FOR FDB'S
CAIN A,.TYFDB ;FOUND AN FDB YET?
JRST RBLDS3 ;YES, GO PROCESS IT
RBLDS2: LOAD A,BLKLEN,(Q1) ;GET LENGTH OF THIS BLOCK
ADD Q1,A ;STEP TO NEXT BLOCK IN DIR
CAMGE Q1,Q2 ;REACHED TOP OF DIR YET?
JRST RBLDS1 ;NO, CONTINUE LOOKING FOR FDB'S
MOVE Q1,DIRORA ;GET BASE ADR
LOAD A,DRSDC,(Q1) ;GET SUBDIR COUNT FROM DIR
CAMN A,RBLDSC ;SAME AS LOCAL COUNT?
IFSKP.
JUMPE P3,[RETBAD(DIRX3)] ;NO - ERROR IF JUST CHECKING
MOVE A,RBLDSC ;GET CORRECT COUNT
STOR A,DRSDC,(Q1) ;STORE CORRECTED COUNT IN DIR
ENDIF.
LOAD A,DRDCA,(Q1) ;GET QUOTA COUNT
CAMN A,RBLDSP ;DO THEY MATCH?
RETSKP ;YES, ALL IS OK
JUMPE P3,[RETBAD (DIRX3)] ;NO, GIVE ERROR IF CHECKING
MOVE A,RBLDSP ;GET CORRECT COUNT
MOVE T3,A ;Get it back
OPSTR <SUB T3,>,DRDCA,(Q1) ;Compute the difference
STOR A,DRDCA,(Q1) ;STORE CORRECT USAGE COUNT
LOAD A,DRNUM,(Q1) ;Get # of this dir
LOAD B,CURSTR ;Get STR # as well
CALL ADJALC ;Update any local copies (T1,T2,T3)
NOP
RETSKP
RBLDS3: LOAD A,FBNPG,(Q1) ;GET PAGE COUNT OF THIS FILE
ADDM A,RBLDSP ;KEEP THIS COUNT
MOVX A,FB%DIR ;CHECK IF THIS IS A DIRECTORY
TDNE A,.FBCTL(Q1) ; ??
AOS RBLDSC ;IT IS - COUNT IT
LOAD A,FBNAM,(Q1) ;GET POINTER TO NAME STRING
JUMPE A,RBLDS2 ;IF NO NAME, DONT ACCOUNT FOR THIS FDB
ADD A,DIRORA ;SET UP INDEX REG POINTING TO NAME BLK
LOAD Q3,NMVAL,(A) ;GET FIRST 5 CHARACTERS OF STRING
LOAD B,NMLEN,(A) ;GET LENGTH OF STRING
SUBI B,2 ;GET # OF FULL WORDS IN STRING
AOS A ;MAKE A POINT TO FIRST WORD OF STRING
MOVEI C,.ETNAM ;LOOKING FOR NAME ENTRY
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;SEE IF THIS NAME IS IN TABLE ALREADY
JRST RBLDS4 ;IT ISNT, GO PUT IT INTO SYMBOL TABLE
MOVE A,DRLOC ;GET POINTER SYMBOL IN TABLE
LOAD A,SYMAD,(A) ;GET FDB ADR OF FIRST NAME ON CHAIN
MOVE B,Q1 ;GET FDB ADR OF THE BLOCK WE JUST FOUND
SUB B,DIRORA ;NEED THE RELATIVE ADR FOR FDBSCN
CALL FDBSCN ;SEE IF THIS FDB IS ON CHAIN ALREADY
JRST RBLDS2 ;ILLEGAL FORMAT ENCOUNTERED
JUMPN A,RBLDS5 ;IF A=-1, FDB IS ON CHAIN ALREADY
JUMPE P3,[RETBAD (DIRX3)] ;IF CHECKING, THEN THIS IS AN ERROR
MOVE A,Q1 ;GET FDB ADDRESS
SUB A,DIRORA ;GET RELATIVE ADR OF FDB
MOVE B,DRLOC ;GET POINTER TO SYMBOL TABLE ENTRY
STOR A,SYMAD,(B) ;PUT NEW FDB ADDRESS IN SYMBOL TABLE
JRST RBLDS5 ;NO NEED TO INSERT THE SYMBOL
RBLDS4: JUMPE P3,[RETBAD (DIRX3)] ;IF CHECKING, THEN THIS IS AN ERROR
MOVE A,Q1 ;GET FDB ADDRESS
SUB A,DIRORA ;MAKE IT RELATIVE
MOVE B,Q3 ;GET FIRST 5 CHARS OF NAME STRING
MOVEI C,.ETNAM ;THIS IS A NAME SYMBOL
CALL INSSYM ;PUT THIS SYMBOL INTO THE TABLE
JRST RBLDS7 ;RAN OF OF ROOM, GO COMPLAIN
RBLDS5: LOAD A,FBACT,(Q1) ;GET POINTER TO ACCOUNT STRING IF ANY
JUMPLE A,RBLDUN ;IF A NUMBERED ACCOUNT, GO CHECK MORE
ADD A,DIRORA ;GET ABS POINTER TO ACCOUNT STRING
MOVE Q3,A ;SAVE POINTER TO ACCOUNT STRING
ADDI A,2 ;STEP OVER HEADER AND SHARE COUNT
LOAD B,ACLEN,(Q3) ;GET LENGTH OF BLOCK
SUBI B,3 ;GET # OF FULL WORDS IN ACCOUNT STRING
MOVEI C,.ETACT ;LOOKING UP AN ACCOUNT SYMBOL
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;SEE IF THIS IS ALREADY IN TABLE
JRST RBLDS6 ;IT ISNT, GO ADD IT TO TABLE
JUMPE P3,RBLDUN ;IF CHECKING - DON'T INCREMENT
INCR ACSHR,(Q3) ;INCREMENT SHARE COUNT
JRST RBLDUN ;CONTINUE
RBLDS6: JUMPE P3,[RETBAD (DIRX3)] ;IF CHECKING, THEN THIS IS AN ERROR
LOAD A,FBACT,(Q1) ;GET ADR OF ACCOUNT STRING
LOAD B,ACVAL,(Q3) ;GET FIRST 5 CHARS OF STRING
MOVEI C,.ETACT ;MAKE IT BE AN ACCOUNT SYMBOL
CALL INSSYM ;INSERT SYMBOL INTO TABLE
JRST RBLDS7 ;NO MORE ROOM IN SYMBOL TABLE
MOVEI A,1 ;SET THE SHARE COUNT TO 1
STOR A,ACSHR,(Q3) ;...
JRST RBLDUN ;GO CONTINUE CHECKING
RBLDS7: CALL RBLDS9 ;REPORT ERROR
RETBAD (DIRX3)
RBLDS9: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG.(CHK,DIRSY6,DIRECT,SOFT,<RBLDST - Prematurely ran out of room in symbol table in directory>,<<A,DIRNAM>,<B,STRNAM>>,<
Cause: Symbol table space was exhausted while rebuilding symbol table on a
DELDF JSYS.
Action: Move some files out of the directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>,,<DB%NND>) ;[7.1210]
RET
RBLDUN: LOAD A,FBVER,(Q1) ;GET FDB VERSION NUMBER
CAIGE A,1 ;VER #1 OR LATER
JRST RBLDS2 ;OLD VERSION - IGNORE USER NAMES
LOAD A,FBAUT,(Q1) ;GET AUTHOR STRING
JUMPE A,RBDUN1 ;IGNORE IF NONE
CALL UNSRBD ;DO USER NAME ROUTINE
RETBAD (DIRX3) ;ERROR
RBDUN1: LOAD A,FBLWR,(Q1) ;DO LAST WRITER
JUMPE A,RBLDS2 ;DONE IF ZERO
CALL UNSRBD ;COMMON SUBR
RETBAD (DIRX3) ;BAD
JRST RBLDS2 ;CONTINUE SCAN
;COMMON ROUTINE TO CHECK/RE-BUILD A USER NAME STRING
; A/ RELATIVE ADDRS OF STRING
; Q1/ FDB ADDRESS
; P3/ CHECK/RE-BUILD FLAG
; CALL UNSRBD
;RETURNS +1 IF ERROR
;RETURNS +2 IF OK
UNSRBD: STKVAR <PTUNS> ;POINTER TO USER NAME
MOVEM A,PTUNS ;SAVE PNTR
ADD A,DIRORA ;GET ABS POINTER TO NAME STRING
MOVE Q3,A ;SAVE POINTER
ADDI A,2 ;ADVANCE OVER HEADER
LOAD B,UNLEN,(Q3) ;GET LENGTH OF BLOCK
SUBI B,3 ;# OF FULL WORDS
MOVEI C,.ETUNS ;USER NAME TYPE
TQO <NREC> ;[7.1014] No recognition here
CALL LOOKUP ;SEE IF IN TABLE
JRST UNSRB1 ;NOT THERE, ENTER IT
JUMPE P3,RSKP ;RETURN OK IF JUST CHECKING
INCR UNSHR,(Q3) ;INCREMENT SHARE COUNT
RETSKP ;GOOD RETURN
UNSRB1: JUMPE P3,R ;RETURN ERROR IF CHECKING
MOVE A,PTUNS ;RESTORE POINTER
LOAD B,UNVAL,(Q3) ;GET FIRST 5 CHARS OF STRING
MOVEI C,.ETUNS ;USER NAME TYPE
CALL INSSYM ;INSERT SYMBOL
CALLRET RBLDS9 ;REPORT ERROR AND RETURN
MOVEI A,1 ;SET SHARE COUNT TO 1
STOR A,UNSHR,(Q3) ;...
RETSKP ;GOOD RETURN
;ROUTINE TO SCAN SYMBOL TABLE FOR VALIDITY
; CALL SYMSCN
;RETURNS +1: SYMBOL TABLE IS INCONSISTENT
; +2: OK
SYMSCN: SAVEQ
CALL SYMCHK ;CHECK THE HEADER
RETBAD () ;BAD
MOVE D,DIRORA ;GET BASE ADDRESS
LOAD C,DRSBT,(D) ;GET BASE OF SYMBOL TABLE
LOAD D,DRSTP,(D) ;GET TOP OF SYMBOL TABLE
ADD C,DIRORA ;MAKE IT ABSOLUTE
ADD D,DIRORA
SETZB Q1,Q2 ;INITIALIZE PREVIOUS SYMBOL VALUE
SYMSCL: ADDI C,.SYMLN ;STEP TO NEXT SYMBOL
CAML C,D ;AT END OF SYMBOL TABLE YET?
RETSKP ;YES, ALL DONE
LOAD A,SYMET,(C) ;GET SYMBOL TYPE
CAIE A,.ETNAM ;NAME TYPE?
RETSKP ;NO, ALL DONE
LOAD A,SYMAD,(C) ;GET FDB ADDRESS
ADD A,DIRORA ;GET ABSOLUTE ADR OF FDB
LOAD A,FBNAM,(A) ;GET ADDRESS OF NAME STRING
ADD A,DIRORA
CAMN A,Q2 ;SAME ADDRESS OF LAST NAME STRING?
RETBAD (DIRX3) ;YES, THIS IS AN ERROR
MOVE Q2,A ;SAVE ADR OF LAST NAME STRING
LOAD B,SYMVL,(C) ;GET FIRST 5 CHARACTERS
CAME B,1(A) ;IS THIS A MATCH?
RETBAD (DIRX3) ;NO, SYMBOL TAABLE IS BAD
LSH B,-1 ;CLEAR OUT BIT 35
CAMGE B,Q1 ;IS THIS SYMBOL GREATER THAN LAST ONE?
RETBAD (DIRX3) ;NO, NEED TO REBUILD
MOVE Q1,B ;SAVE LAST SYMBOL VALUE
JRST SYMSCL ;LOOP BACK FOR ALL SYMBOLS
;ROUTINE TO SCAN ALL BLOCKS IN A DIR TO SEE IF DIR IS CONSISTENT
;ASSUMES DIR IS MAPPED
; CALL BLKSCN
;RETURNS +1: DIR IS NOT IN A CONSISTENT STATE
; +2: DIR IS OK
BLKSCN::EA.ENT
SAVEQ
MOVE Q1,DIRORA ;GET BASE ADR OF DIR AREA
LOAD Q2,DRFTP,(Q1) ;GET TOP OF FREE AREA
ADD Q2,DIRORA ;MAKE IT ABSOLUTE
BLKSC1: LOAD A,BLKTYP,(Q1) ;GET TYPE OF THIS BLOCK
MOVSI B,-BLKTBL ;SET UP AOBJN POINTER TO BLOCK TABLE
BLKSC2: HLRZ C,BLKTAB(B) ;GET BLOCK TYPE FROM TABLE
CAME A,C ;FOUND THIS BLOCK TYPE?
AOBJN B,BLKSC2 ;NO, KEEP LOOKING
JUMPGE B,BLKSCE ;IF NOT FOUND, BOMB OUT
HRRZ B,BLKTAB(B) ;GET DISPATCH ADDRESS
MOVE A,Q1 ;GET ADR OF BLOCK
SUB A,DIRORA ;MAKE IT RELATIVE
CALL 0(B) ;CHECK THIS BLOCK TYPE
RETBAD () ;BLOCK IS BAD
LOAD A,BLKLEN,(Q1) ;GET LENGTH OF BLOCK
ADD Q1,A ;STEP TO NEXT BLOCK IN DIR
CAMGE Q1,Q2 ;REACHED END YET?
JRST BLKSC1 ;NO, GO CONTINUE CHECKING
CAME Q1,Q2 ;LAST BLOCK MUST END AT FRETOP
RETBAD (DIRX3) ;IT DIDNT
RETSKP ;DIRECTORY IS IN GOOD SHAPE
BLKSCE: MOVE A,Q1 ;GET ADDRESS OF BLOCK
CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRBLK,DIRECT,SOFT,<BLKSCN - Illegal block type in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: There is an unknown code in a directory block.
Action: Use the DELETE command with subcommand DIRECTORY to delete the
directory file, then rebuild the directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
BLKTAB: .TYNAM,,NAMCHK ;NAME BLOCK
.TYEXT,,EXTCHK ;EXTENSION BLOCK
.TYACT,,ACTCHK ;ACCOUNT BLOCK
.TYUNS,,UNSCHK ;USER NAME BLOCK
.TYFDB,,FDBSCN ;FDB BLOCK
.TYDIR,,DRCHK ;DIR HEADER BLOCK
.TYFRE,,FRECHK ;FREE BLOCK
.TYGDB,,RSKP ;GROUP DESCRIPTOR BLOCK
.TYFBT,,RSKP ;FREE BIT TABLE
.TYRNA,,RNACHK ;REMOTE ALIAS BLOCK
BLKTBL==.-BLKTAB
;ROUTINE TO SCAN AN FDB CHAIN FOR LEGALITY
;ACCEPTS IN A/ RELATIVE ADR OF STARTING FDB
; B/ RELATIVE ADR OF ANOTHER FDB (OPTIONAL)
; CALL FDBSCN
;RETURNS +1: FDB CHAIN IS MESSED UP
; +2: FDB CHAIN IS OK
; A/ 0 MEANS SECOND FDB IS NOT ON THE CHAIN
; -1 MEANS SECOND FDB IS ON THE CHAIN
FDBSCN: STKVAR <FDBSCA,FDBSCB,FDBSCV>
MOVEM B,FDBSCB ;SAVE ADR OF SECOND FDB
SETZM FDBSCV ;INITIALIZE RETURN VALUE
FDBSC1: CAMN A,FDBSCB ;FOUND THE SECOND FDB?
SETOM FDBSCV ;YES, RETURN TRUE
ADD A,DIRORA ;GET ABS ADR OF FDB
MOVEM A,FDBSCA ;SAVE ADDRESS OF FDB
FDBSC2: CALL FDBCHK ;CHECK THE LEGALITY OF THIS FDB
RET ;BAD
LOAD A,FBGNL,(A) ;GET POINTER TO NEXT GENERATION FDB
JUMPE A,FDBSC3 ;END OF GENERATION CHAIN?
CAMN A,FDBSCB ;IS THIS THE FDB BEING LOOKED FOR
SETOM FDBSCV ;YES, MARK THAT IT IS ON CHAIN
ADD A,DIRORA ;NO, GET ABS ADR OF THIS FDB
JRST FDBSC2 ;GO CONTINUE DOWN GENERATION CHAIN
FDBSC3: MOVE A,FDBSCA ;GET ADR OF TOP FDB ON EXT CHAIN
LOAD A,FBEXL,(A) ;STEP TO NEXT EXTENSION IN CHAIN
JUMPN A,FDBSC1 ;IF MORE FDB'S, GO LOOK AT THEM
MOVE A,FDBSCV ;GET RETURN VALUE
RETSKP ;FDB CHAIN IS OK
;ROUTINE TO CHECK A DIRECTORY HEADER BLOCK
;ACCEPTS IN A/ RELATIVE ADR OF BLOCK
; CALL DRCHK
;RETURNS +1: BAD FORMAT FOR HEADER
; +2: OK
DRCHK: TRNE A,777 ;MUST BE ON A PAGE BOUNDARY
RETBAD (DIRX3) ;OTHERWISE BLOCK IS BAD
LSH A,-PGSFT ;GET PAGE #
JUMPE A,RSKP ;HEADER ON PAGE 0 WAS CHECKED BY SETDIR
CALLRET DRHCHK ;GO CHECK HEADER
;ROUTINE TO ASSIGN SPACE IN THE DIRECTORY
;ASSUMES THE APPROPRIATE DIRECTORY IS MAPPED
;ACCEPTS IN B/ NUMBER OF WORDS DESIRED
; CALL ASGDFR
;RETURNS +1: NO ROOM
; +2: ABSOLUTE ADDRESS OF BLOCK
ASGDFR::EA.ENT
SAVEQ ;SAVE ANY PERMANENT ACS USED
TRVAR <ASGDFN,ASGDFM,ASGDFA,ASGDFS,ASGDFP,ASGDFL>
MOVEM B,ASGDFN ;SAVE THE DESIRED BLOCK SIZE
ADDI B,.FRHLN ;GET MINIMUM SIZE IF NOT EXACTLY EQUAL
MOVEM B,ASGDFM ;THIS QUARANTEES NO BLK SMALLER THAN 2
MOVE Q1,DIRORA ;SET UP BASE ADDRESS OF DIRECTORY
CALL ASGDF ;SEE IF ROOM CAN BE FOUND
SKIPA ;NO
RETSKP ;YES, RETURN TO CALLER
LOAD A,DRFBT,(Q1) ;GET POINTER TO FREE BIT TABLE
JUMPE A,R ;IF NO TABLE, THEN THERE IS NO ROOM
ADD A,DIRORA ;GET ABS ADR OF TABLE
LOAD B,BLKTYP,(A) ;CHECK BLOCK TYPE
CAIE B,.TYFBT ;MUST BE THE FREE BIT TABLE
RET ;IF NOT, THEN THERE IS NO ROOM
LOAD B,BLKLEN,(A) ;GET LENGTH OF TABLE
ASGDF7: SOJLE B,ASGDF ;INITIALIZED TABLE YET?
SETOM 1(A) ;MARK ALL PAGES AS HAVING ROOM
AOJA A,ASGDF7 ;STEP TO NEXT TABLE ELEMENT
ASGDF: SETZM ASGDFP ;START AT PAGE 0 OF DIRECTORY
ASGDF1: CALL ASDFRP ;GO LOOK AT CURRENT PAGE IN ASGDFP
JRST ASGDF4 ;NO ROOM ON THAT PAGE
ASGDF0: MOVE A,ASGDFA ;GET ADDRESS OF FREE BLOCK CHOSEN
LOAD B,FRLEN,(A) ;GET ITS LENGTH
SUB B,ASGDFN ;GET LENGTH OF REMAINDER OF FREE BLOCK
JUMPE B,ASGDF2 ;TAKING WHOLE BLOCK?
ADD A,ASGDFN ;GET START OF REMAINDER OF THIS BLOCK
STOR B,FRLEN,(A) ;SET UP NEW LENGTH OF THIS BLOCK
MOVE C,ASGDFA ;GET ADDRESS OF BLOCK AGAIN
LOAD C,FRNFB,(C) ;GET FORWARD LINK FROM OLD BLOCK
STOR C,FRNFB,(A) ;MAKE SHORTENED BLOCK POINT DOWN CHAIN
MOVEI C,.TYFRE ;SET UP BLOCK TYPE
STOR C,FRTYP,(A)
SUB A,DIRORA ;GET RELATIVE ADDRESS OF SHORTENED BLK
MOVE C,ASGDFL ;GET POINTER TO LAST BLOCK
STOR A,FRNFB,(C) ;FIX UP FREE CHAIN
MOVE A,ASGDFA ;GET ADDRESS OF BLOCK FOR CALLER
JRST ASGDF3 ;GO RETURN ADDRESS OF BLOCK
ASGDF2: LOAD B,FRNFB,(A) ;USING WHOLE BLOCK, CHANGE LINKS
MOVE C,ASGDFL ;GET ADDRESS OF LAST FREE BLOCK
STOR B,FRNFB,(C) ;ELIMINATE THIS BLOCK FROM CHAIN
ASGDF3: MOVE B,ASGDFN ;GET SIZE OF BLOCK
STOR B,FRLEN,(A) ;SET UP LENGTH OF BLOCK
SETZRO FRVER,(A) ;CLEAR VERSION #
RETSKP ;GIVE SUCCESSFUL RETURN WITH ADR IN A
ASGDF4: AOS A,ASGDFP ;STEP TO NEXT PAGE IN THE DIRECTORY
CAML A,NDIRPG ;ABOVE LIMIT OF DIR?
RET ;YES, NO MORE ROOM
LOAD B,DRFTP,(Q1) ;GET THE ADDRESS OF THE LAST PAGE USED
SOS B ;START WITH ADR OF LAST WORD USED
LSH B,-PGSFT ;GET PAGE NUMBER
CAMG A,B ;ARE WE NOW ABOVE LAST USED PAGE?
JRST ASGDF1 ;NO, LOOP BACK AND LOOK AT NEXT PAGE
SOS ASGDFP ;YES, GO BACK TO THAT PAGE
LOAD A,DRFTP,(Q1) ;GET CURRENT FREE TOP
MOVE B,A ;...
ADDI B,PGSIZ-1 ;STEP TO NEXT PAGE
TRZ B,777 ;GET ADDRESS OF FIRST WORD OF NEXT PAGE
LOAD C,DRSBT,(Q1) ;GET ADDRESS OF START OF SYMBOL TABLE
CAMLE B,C ;GET LOWEST UPPER LIMIT FOR FREE TOP
MOVE B,C ;...
SUB B,A ;GET FREE SPACE FROM FREE TOP TO LIMIT
CAIGE B,.FRHLN ;ENOUGH TO GET A LEGAL SIZE FREE BLOCK?
JRST ASGDF5 ;NO, GO EXPAND BY ONE PAGE
ADD A,DIRORA ;GET ABSOLUTE ADDRESS OF FREE TOP
STOR B,FRLEN,(A) ;MAKE THIS INTO A FREE BLOCK
SETZRO FRVER,(A)
ADD B,A ;GET NEW FREE TOP
SUB B,DIRORA ;MAKE IT RELATIVE
STOR B,DRFTP,(Q1) ;STORE NEW FREE TOP
MOVE B,A ;GET ADDRESS OF THIS BLOCK
CALL RELDFA ;RELEASE THIS BLOCK TO THE FREE POOL
CALL ASDFRP ;GO SEE IF THERE IS ENOUGH ROOM NOW
JRST ASGDF5 ;NO, TRY MOVING SYMBOL TABLE UP
JRST ASGDF0 ;FOUND ROOM, GO RETURN IT
ASGDF5: LOAD A,DRSBT,(Q1) ;NOW SEE IF ENOUGH ROOM TO INITIALIZE
OPSTR <SUB A,>,DRFTP,(Q1) ; HEADER ON NEXT PAGE
CAIGE A,.DIHL1 ;ENOUGH ROOM FOR HEADER?
JRST ASGDF6 ;NO, MOVE SYMBOL TABLE UP ONE PAGE
LOAD A,DRFTP,(Q1) ;GET FREE TOP
TRNE A,777 ;MAKE SURE IT IS ON A PAGE BOUNDARY
JRST ASGDF6 ;SHOULD HAVE BEEN, GO FIX THIS MESS
ADD A,DIRORA ;MAKE ADDRESS ABSOLUTE
MOVEI B,.TYDIR ;SET UP HEADER FOR THIS PAGE
STOR B,DRTYP,(A) ;SET UP TYPE
LOAD B,DRNUM,(Q1) ;DIR NUMBER
STOR B,DRNUM,(A) ;FOR THIS PAGE
MOVE B,A ;GET RELATIVE PAGE NUMBER OF THIS PAGE
SUB B,DIRORA ;MAKE IT RELATIVE
LSH B,-PGSFT ;...
STOR B,DRRPN,(A) ;SAVE THIS FOR CONSISTENCY CHECK
MOVEI B,.DIHL1 ;GET LENGTH OF THIS HEADER AREA
STOR B,DRHLN,(A) ;GUARANTEED TO BE OTHER THAN PAGE 0
SETZRO DRFFB,(A) ;NO SPACE ON FREE LIST
ADD B,A ;GET NEW FREE TOP ADDRESS
SUB B,DIRORA ;GET RELATIVE ADDRESS
STOR B,DRFTP,(Q1) ;SET UP NEW FREE TOP
JRST ASGDF4 ;GO TRY TO GET SPACE NOW
ASGDF6: CALL XPANDP ;MOVE THE SYMBOL TABLE UP ONE PAGE
RET ;CANNOT GROW DIR ANY MORE
JRST ASGDF4 ;LOOP BACK AND LOOK AT THIS PAGE AGAIN
;ROUTINE TO LOOK FOR SPACE ON A PARTICULAR PAGE
;ASSUMES THAT ASGDFN, ASGDFM, AND ASGDFP ARE SET UP.
; CALL ASDFRP ;CAN ONLY BE CALLED BY ASGDFR
;RETURNS +1: NO BLOCK LARGE ENOUGH ON THIS PAGE
; +2: ASGDFS, ASGDFL, AND ASGDFA SET UP
ASDFRP: MOVE A,ASGDFP ;GET THE PAGE #
CALL FBTCHK ;IS THERE ROOM ON THIS PAGE?
RET ;NO, DONT TOUCH THIS PAGE
MOVE A,ASGDFP ;GET THE PAGE #
CALL DRHCHK ;CHECK THE HEADER
RET ;HEADER BAD, SKIP THIS PAGE
MOVE A,ASGDFP ;GET THE PAGE NUMBER
LSH A,PGSFT ;TURN IT INTO AN ADDRESS
ADD A,DIRORA ;GET ABS ADR OF START OF THIS PAGE
LOAD D,DRFFB,(A) ;GET ADDRESS OF FIRST FREE BLOCK
JUMPE D,ASDFR4 ;IF NONE, RETURN NOW
MOVSI C,1 ;START WITH LARGE NUMBER
MOVEM C,ASGDFS ;IN SIZE WORD
MOVE B,A ;GET ADDRESS OF DRFFB FOR THIS PAGE
ADD B,[.DRFFB-.FRNFB]
ASDFR1: EXCH A,D ;CHECK THIS FREE BLOCK
CALL FRECHK ;...
RET ;BAD, SKIP THIS PAGE
EXCH A,D
ADD D,DIRORA ;MAKE ADDRESS BE ABSOLUTE
EXCH B,D ;SAVE ADR OF LAST ONE IN D
LOAD C,FRLEN,(B) ;GET LENGTH OF THIS FREE BLOCK
CAMN C,ASGDFN ;EXACTLY THE RIGHT SIZE?
JRST ASDFR2 ;YES, USE IT
CAMGE C,ASGDFM ;IS IT BIGGER THAN MINIMUM?
JRST ASDFR3 ;NO, GO LOOK DOWN REST OF CHAIN
CAML C,ASGDFS ;LESS THAN THE BEST ONE YET?
JRST ASDFR3 ;NO, IGNORE IT
ASDFR2: MOVEM C,ASGDFS ;SAVE THIS SIZE
MOVEM B,ASGDFA ;SAVE ADR OF THIS BLOCK
MOVEM D,ASGDFL ;AND ADDRESS OF LAST BLOCK
CAMN C,ASGDFN ;EXACT MATCH?
RETSKP ;YES, EXIT PROMPTLY
ASDFR3: LOAD D,FRNFB,(B) ;GET ADDRESS OF NEXT FREE BLOCK
JUMPN D,ASDFR1 ;LOOP BACK TIL END OF CHAIN
MOVE C,ASGDFS ;GET SIZE OF BEST ONE SEEN
TLNN C,-1 ;DID WE FIND ANY THAT WERE LARGE ENOUGH
RETSKP ;YES, RETURN SUCCESSFUL
ASDFR4: MOVE A,ASGDFP ;NO, GET PAGE NUMBER
CALLRET FBTCLR ;MARK THAT THERE IS NO ROOM ON PAGE
;ROUTINE TO RETURN SPACE TO THE DIRECTORY FREE POOL
;ACCEPTS IN B/ ADDRESS OF THE BLOCK TO BE RETURNED
; THE LENGTH FIELD OF THE BLOCK MUST BE CORRECT
; CALL RELDFR OR CALL RELDFA
;RETURNS +1: ALWAYS
RELDFR::ADD B,DIRORA ;RELATIVE ADDRESS ENTRY POINT
RELDFA::EA.ENT
STKVAR <RELDFB> ;ABSOLUTE ADDRESS ENTRY POINT
MOVE A,B ;GET ADDRESS IN AC A
MOVEM A,RELDFB ;SAVE ADDRESS OF BLOCK
TRZ B,777 ;GET ADR OF START OF PAGE
OPSTR <ADD B,>,DRHLN,(B) ;GET END OF HEADER AREA
CAMLE B,RELDFB ;ADR CANNOT BE IN HEADER AREA
JRST RLDFB6 ;ERROR
LOAD B,FRLEN,(A) ;GET LENGTH OF THE BLOCK
CAIGE B,.FRHLN ;IS THIS A LEGAL SIZE BLOCK?
JRST RLDFB1 ;BLOCK TOO SMALL
ADD B,A ;GET END OF THIS BLOCK
MOVE C,DIRORA ;GET BASE OF DIRECTORY
LOAD C,DRFTP,(C) ;GET TOP OF FREE SPACE
ADD C,DIRORA ;MAKE IT ABSOLUTE
CAMLE B,C ;IS THIS BLOCK TOO LARGE?
JRST RLDFB2 ;BLOCK TOO LARGE
SOS B ;GET LAST WORD OF THIS BLOCK
TDZ B,A ;SEE IF BLOCK CROSES PAGE BOUNDARY
TRNE B,777000 ;HIGH ORDER BITS OF ADR'S MUST MATCH
JRST RLDFB3 ;BLOCK CROSSES PAGE BOUNDARY
MOVEI C,.TYFRE ;TURN IT INTO A FREE BLOCK
STOR C,FRTYP,(A) ;...
SETZRO FRVER,(A) ;...
TRZ A,777 ;GET ADDRESS OF START OF THIS PAGE
ADD A,[.DRFFB-.FRNFB] ;GET ADDRESS OF START OF CHAIN
MOVE C,A ;REMEMBER STARTING ADR
RELDF1: LOAD B,FRNFB,(A) ;GET NEXT BLOCK ON THE CHAIN
JUMPE B,RELDF5 ;REACHED THE END OF CHAIN?
CAMN C,A ;IS THIS FIRST BLOCK
JRST RLDF1A ;YES, DONT NEED TO CHECK BLOCK TYPE
EXCH A,B ;CHECK THE FREE BLOCK
CALL FRECHK ;...
RET ;BAD, RETURN
EXCH A,B
RLDF1A: ADD B,DIRORA ;NO, MAKE ADR ABSOLUTE
CAMN B,RELDFB ;THE SAME AS BLOCK BEING RETURNED?
JRST RLDFB5 ;BLOCK ALREADY ON FREE LIST
CAML B,RELDFB ;PAST THE BLOCK BEING RETURNED?
JRST RELDF2 ;YES, FOUND WHERE TO PUT BLOCK
MOVEM B,A ;REMEMBER ADR OF LAST BLOCK
JRST RELDF1 ;LOOP BACK TIL RIGHT PLACE IS FOUND
RELDF2: CAMN C,A ;DID WE GET PAST FIRST ONE?
JRST RELDF4 ;NO, HANDLE THIS SPECIALLY
MOVE C,RELDFB ;GET ADDRESS OF BLOCK BEING RETURNED
LOAD D,FRLEN,(A) ;GET LENGTH OF THIS FREE BLOCK
ADD D,A ;GET ADR OF WORD AFTER BLOCK
CAMGE C,D ;IS BLOCK BEING RETURNED ABOVE THIS
JRST RLDFB5 ;NO, BLOCK ON FREE LIST ALREADY
LOAD D,FRNFB,(A) ;GET LAST LINK
STOR D,FRNFB,(C) ;MAKE THIS BLOCK POINT DOWN THE LIST
SUB C,DIRORA ;GET RELATIVE ADR OF THIS BLOCK
STOR C,FRNFB,(A) ;MAKE LAST BLOCK POINT TO THIS ONE
RELDF6: LOAD C,FRLEN,(A) ;NOW COMPACT THE BLOCKS
ADD C,A ;GET END OF PREVIOUS BLOCK
CAME C,RELDFB ;IS THIS SAME AS BLOCK RETURNED?
JRST RELDF3 ;NO
LOAD D,FRLEN,(C) ;YES, GET LENGTH OF THIS BLOCK
OPSTR <ADD D,>,FRLEN,(A) ;GET NEW LENGTH OF PREVIOUS BLOCK
STOR D,FRLEN,(A) ;STORE NEW LENGTH
LOAD D,FRNFB,(C) ;GET LINK FROM BLOCK
STOR D,FRNFB,(A) ;MAKE PREVIOUS BLOCK POINT DOWN CHAIN
MOVEM A,RELDFB ;UPDATE ADDRESS OF BLOCK BEING RETURNED
RELDF3: MOVE A,RELDFB ;GET ADDRESS OF BLOCK BEING RETURNED
LOAD C,FRLEN,(A) ;GET LENGTH OF THIS BLOCK
ADD C,A ;GET END OF THIS BLOCK
CAME C,B ;DOES IT BOUND ON NEXT BLOCK
JRST RELDF7 ;NO
LOAD C,FRLEN,(B) ;YES, MERGE THE BLOCKS
OPSTR <ADD C,>,FRLEN,(A) ;GET LENGTH OF COMBINED BLOCKS
STOR C,FRLEN,(A) ;STORE NEW LENGTH
SETZRO FRVER,(A) ;CLEAR VERSION FIELD
LOAD C,FRNFB,(B) ;GET LINK
STOR C,FRNFB,(A) ;UPDATE LINK TO NEXT BLOCK
RELDF7: LOAD B,FRLEN,(A) ;GET LENGTH OF FREE BLOCK BEING RET'D
CAIG B,.FRHLN ;IS THIS LONGER THAN THE MINIMUM
JRST RELDF8 ;NO, DONT ZERO ANY WORDS
SETZM .FRHLN(A) ;YES, ZERO THE REMAINDER OF THE FREE BLK
CAIN B,.FRHLN+1 ;IS THIS BLOCK ALREADY ZEROED NOW?
JRST RELDF8 ;YES, DONT DO THE BLT
ADD B,A ;GET END OF BLOCK
HRLI A,.FRHLN(A) ;SET UP SOURCE FOR BLT
HRRI A,.FRHLN+1(A) ;SET UP DESTINATION
BLT A,-1(B) ;ZERO THE BLOCK
RELDF8: MOVE A,RELDFB ;GET ADDRESS OF BLOCK
SUB A,DIRORA ;MAKE IT RELATIVE
LSH A,-PGSFT ;GET PAGE NUMBER
CALLRET FBTSET ;MARK THAT THERE IS ROOM ON THIS PAGE
RELDF4: SUB B,DIRORA ;MAKE ADDRESS OF NEXT BLOCK RELATIVE
RELDF5: MOVE D,RELDFB ;GET ADDRESS OF BLOCK BEING RETURNED
STOR B,FRNFB,(D) ;MAKE THIS BLOCK POINT DOWN THE CHAIN
SUB D,DIRORA ;MAKE ADR OF THIS BLOCK RELATIVE
STOR D,FRNFB,(A) ;SET UP POINTER TO THIS BLOCK
ADD B,DIRORA ;GET ABSOLUTE ADDRESS AGAIN
CAMN C,A ;IS THIS THE FIRST BLOCK ON THE CHAIN
JRST RELDF3 ;YES, ONLY COMPAT WITH NEXT BLOCK
JRST RELDF6 ;TRY TO COLAPSE IN BOTH DIRECTIONS
RLDFB1: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRB2S,DIRECT,SOFT,<RLDFB1 - Directory free block too small in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: A bad directory block is being returned. Disk space will be lost until
CHECKD is run on the structure.
Action: No immediate action is required. Run CHECKD to reclaim lost space.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
RLDFB2: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRB2L,DIRECT,SOFT,<RLDFB2 - Directory free block too large in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: A bad directory block is being returned.
Action: No immediate action is required. Run CHECKD to reclaim lost pages.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
RLDFB3: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRBCB,DIRECT,SOFT,<RLDFB3 - Directory free block crosses page boundary in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: A bad directory block is being returned.
Action: No immediate action is required. Run CHECKD to reclaim lost pages.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
REPEAT 0,< ;[8946]
RLDFB4: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRIFB,DIRECT,SOFT,<RLDFB4 - Illegal block type on directory free list in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: No path to the BUGCHK.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in Directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
> ;[8946] End of repeat 0
RLDFB5: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRBAF,DIRECT,SOFT,<RLDFB5 - Block already on directory free list in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The directory block returned already.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
RLDFB6: CALL GETDSA ;COLLECT INFORMATION
BUG.(CHK,DIRRHB,DIRECT,SOFT,<RLDFB6 - Attempting to return a header block in directory>,<<A,DIRNUM>,<B,STRNAM>,<C,ADDR>>,<
Cause: The address of a block being returned is illegal.
Action: There is an inconsistancy in either the monitor's data structure or on
the file structure. Dismount the structure and run CHECKD on it. If
this does not fix the problem, and this BUGCHK is reproducible on a
healthy file structure, set this bug dumpable and submit an SPR along
with the dump and instructions on reproducing it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>,,<DB%NND>) ;[7.1210]
RETBAD (DIRX3)
;ROUTINES TO COLLECT INFORMATION FOR BUGCHKS. GETSNM ONLY
;CLOBBERS AC B. GETDSA CLOBBERS A, B, AND C. GETDSA ASSUMES
;THE ABSOLUTE ADDRESS OF A BLOCK IS IN A.
GETDSA: MOVE C,A ;MOVE BLOCK ADDRESS
SUB C,DIRORA ;CONVERT IT TO A RELATIVE ADDRESS
MOVE A,DIRORA ;GET FIRST ADDRESS OF DIRECTORY
LOAD A,DRNUM,(A) ;AND GET THE DIRECTORY NUMBER
GETSNM: LOAD B,CURSTR ;GET STRUCTURE NUMBER
MOVE B,STRTAB(B) ;GET INDEX INTO STRTAB
LOAD B,STRNAM,(B) ;GET SIXBIT STR NAME
RET ;AND RETURN
;ROUTINES TO MANIPULATE THE FREE POOL BIT TABLE
;THE FREE BIT TABLE IS USED TO AVOID UNNECESSARY PAGING ACTIVITY
;DURING THE CREATION OF NEW FILES IN A DIRECTORY. THERE IS A BIT PER
;DIRECTORY PAGE. THE BIT SET MEANS THE LAST TIME A REQUEST FOR SPACE
;ON THIS PAGE WAS MADE, THERE WAS ROOM TO SATISFY THAT REQUEST.
;ASGDFR WILL ONLY LOOK ON A PAGE IF THE BIT IN THE FREE BIT TABLE IS
;SET. IF NO FREE SPACE CANN BE FOUND, ASGDFR WILL THEN TRY ALL PAGES.
;BITS GET CLEARED WHEN A REQUEST FOR SPACE ON A PAGE FAILS, AND THEY
;GET SET WHEN ROOM IS RELEASED ON A PAGE.
;THIS MECHANISM SHOULD HELP KEEP FDB'S AND THE CORRESPONDING NAME OR
;EXTENSION STRINGS ALL ON THE SAME PAGE.
;ROUTINES TO SET AND CLEAR BITS IN FREE BIT TABLE
;ACCEPTS IN A/ PAGE NUMBER
; CALL FBTSET OR CALL FBTCLR
;RETURNS +1: ALWAYS
FBTSET: TDZA C,C ;SET BIT
FBTCLR: SETO C, ;CLEAR BIT
MOVE D,DIRORA ;GET BASE ADR OF DIR AREA
LOAD D,DRFBT,(D) ;GET ADR OF FREE BIT TABLE
JUMPE D,R ;IF NO TABLE, IGNORE REQUEST
ADD D,DIRORA ;GET ABS ADR OF TABLE
LOAD B,BLKTYP,(D) ;CHECK BLOCK TYPE OF TABLE
CAIE B,.TYFBT ;MUST BE FREE BIT TABLE
RET ;IF NOT, IGNORE REQUEST
IDIVI A,^D36 ;GET BIT POSITION IN TABLE
PUSH P,C ;SAVE REQUEST FLAG
LOAD C,BLKLEN,(D) ;MAKE SURE PAGE IS WITHIN TABLE
CAIG C,1(A) ;...
JRST PA1 ;BEYOND END OF TABLE, IGNORE REQUEST
POP P,C ;GET BACK FLAG
MOVE B,BITS(B) ;GET MASK
ADD A,D ;GET ADR OF TABLE ENTRY
JUMPE C,FBTST1 ;C=0 MEANS SET BIT
ANDCAM B,1(A) ;CLEAR BIT IN TABLE
RET
FBTST1: IORM B,1(A) ;SET BIT IN TABLE
RET ;AND RETURN
;ROUTINE TO CHECK IF THERE IS ROOM ON A PAGE
;ACCEPTS IN A/ PAGE #
; CALL FBTCHK
;RETURNS +1: NO ROOM ON THIS PAGE
; +2: THE BIT IS SET, MEANING THAT THERE MAY BE ROOM ON PAGE
FBTCHK: STKVAR <FBTCHP>
MOVEM A,FBTCHP ;SAVE PAGE NUMBER
FBTCH0: MOVE D,DIRORA ;GET BASE OF DIR AREA
LOAD D,DRFBT,(D) ;GET POINTER TO FREE BIT TABLE
JUMPE D,RSKP ;IF NONE, GO LOOK ON THIS PAGE ALWAYS
ADD D,DIRORA ;GET ABS ADR OF FREE BIT TABLE
LOAD B,BLKTYP,(D) ;CHECK IT FOR LEGALITY
CAIE B,.TYFBT ;MUST BE FREE BIT TABLE TYPE
RETSKP ;PRETEND THERE IS ROOM ON PAGE
LOAD B,BLKLEN,(D) ;GET LENGTH OF FREE TABLE
CAMGE B,FBTSIZ ;IS IT BIG ENOUGH?
RETSKP ;PRETEND THERE IS ROOM ON THIS PAGE
IDIVI A,^D36 ;GET INDEX INTO BIT TABLE AND BIT POS
MOVE C,BITS(B) ;GET BIT MASK
ADD A,D ;GET ADR OF WORD IN TABLE -1
TDNN C,1(A) ;IS BIT SET?
RET ;NO, GIVE NON-SKIP RETURN
RETSKP ;YES, SKIP RETURN
;Expand symbol table region of a directory
; CALL XPAND
;RETURNS +1: DIRECTORY FULL AND CANNOT BE EXPANDED
; +2: SUCCESSFUL
; DRLOC IS UPDATED TO POINT TO NEW SYMBOL TABLE LOC
XPAND: SAVET ;SAVE ALL ACS USED
MOVE D,DIRORA ;SET UP BASE ADDRESS OF MAPPED DIR
LOAD B,DRFTP,(D) ;GET TOP OF FREE POOL
SOS B ;GET ADR OF LAST USED WORD
TRZ B,777 ;GET PAGE NUMBER OF LAST PAGE USED
ADD B,DIRORA ;MAKE IT ABSOLUTE
MOVE A,B ;SAVE ADDRESS OF BASE
ADD A,[.DRFFB-.FRNFB] ;GET ADDRESS OF POINTER TO FIRST BLOCK
LOAD C,DRFFB,(B) ;GET FREE LIST POINTER FOR THIS PAGE
JUMPE C,XPAND2 ;IF NO FREE BLOCKS, TRY TO USE HEADER
XPAND0: EXCH A,C ;CHECK THE FREE BLOCK
CALL FRECHK ;...
JRST XPANDP ;BAD, GO EXPAND BY A PAGE
ADD A,DIRORA ;GET ABSOLUTE ADR OF BLOCK
LOAD B,FRNFB,(A) ;GET POINTER TO NEXT FREE BLOCK
JUMPE B,XPAND1 ;ZERO MEANS AT END OF LIST
MOVE C,B ;SEARCH FOR THE END OF THE FREE LIST
JRST XPAND0 ; TO SEE IF WE CAN SHORTEN LAST BLK
XPAND1: LOAD B,FRLEN,(A) ;GET THE LENGTH OF THIS BLOCK
ADD B,A ;GET END OF THIS BLOCK
LOAD D,DRFTP,(D) ;GET ACTUAL END OF DIR
ADD D,DIRORA ;MAKE IT ABSOLUTE
CAME B,D ;IS THIS FREE BLK AT END OF FREE SPACE?
JRST XPANDP ;NO, GO EXPAND AN ENTIRE PAGE
MOVE D,DIRORA ;GET BACK BASE ADDRESS
LOAD B,FRLEN,(A) ;GET LENGTH OF LAST BLOCK AGAIN
CAIN B,.SYMLN ;IS THIS EXACTLY THE RIGHT SIZE?
JRST XPAND3 ;YES, USE THE WHOLE BLOCK
CAIGE B,.SYMLN+.FRHLN ;BIG ENOUGH TO SPLIT UP INTO 2 BLOCKS?
JRST XPANDP ;NO, GO XPAND BY A PAGE
MOVE C,B ;NOW GET AMOUNT TO SHORTEN BY
ASH C,-3 ;TAKE 1/8 OF THIS BLOCK
ADDI C,.SYMLN ;PLUS ONE SYMBOL
SUB B,C ;GET NEW LENGTH OF LAST BLOCK
STOR B,FRLEN,(A) ;SHORTEN THE BLOCK
SETZRO FRVER,(A) ;SET VERSION #
LOAD B,DRFTP,(D) ;GET TOP OF FREE SPACE
SUB B,C ;SHORTEN IT ALSO
STOR B,DRFTP,(D) ;...
RETSKP ;AND EXIT SUCCESSFUL
XPAND2: SUB B,DIRORA ;MAKE RELATIVE ADDRESS OF FREE TOP
JUMPE B,XPANDP ;DONT DELETE PAGE 0 HEADER
LOAD C,DRFTP,(D) ;GET CURRENT FREE TOP
SUB C,B ;GET # OF WORDS USED ON THIS PAGE
CAIE C,.DIHL1 ;IF NOT JUST A HEADER ON THIS PAGE,
JRST XPANDP ; GO GET ANOTHER PAGE
STOR B,DRFTP,(D) ;OTHERWISE, USE HEADER AREA FOR SYMBOLS
RETSKP ;AND RETURN SUCCESSFUL
XPAND3: SETZRO FRNFB,(C) ;MARK LAST BLOCK AS LAST IN CHAIN
SUB A,DIRORA ;GET RELATIVE ADR OF NEW FREE TOP
STOR A,DRFTP,(D) ;SAVE NEW FREE TOP
RETSKP ;AND RETURN SUCCESSFUL
;ROUTINE TO EXPAND THE DIR BY MOVING THE SYMBOL TABLE UP ONE PAGE
; CALL XPANDP
;RETURNS +1: COULD NOT EXPAND ANY MORE
; +2: SUCCESSFUL
XPANDP: MOVE D,DIRORA ;SET UP BASE ADDRESS OF MAPPED DIR
LOAD A,DRSTP,(D) ;GET ADD OF TOP OF CURRENT SYMBOL TABLE
ADDI A,1777
ANDCMI A,777 ;Move to NEXT page boundary
MOVE C,A
LSH C,-PGSFT ;SHIFT SIZE
LOAD B,CURSTR ;GET STRUCTURE # OF DIR
MOVE B,STRTAB(B) ;GET SDB ADDRESS
JN MS%LIM,SDBSTS(B),[ CAILE C,DRSMDA ;LIMITED. SEE IF OKAY
RETBAD() ;NOT
JRST XPNDP1] ;IS
CAMLE C,NDIRPG ;Absolute end of directory?
RETBAD ;YES, Fail
XPNDP1: SKIPN SDBBTB(B) ;IS THE STRUCTURE'S BIT TABLE INITED?
RETBAD() ;NO. CAN'T EXPAND THEN
MOVE B,A ;GET NEW END OF SYMBOL TABLE
ADD B,DIRORA ;GET THE VIRTUAL ADDRESS
MOVES -1(B) ;TOUCH PAGE THAT SYMBOL TABLE WILL GROW INTO
ERJMP [RETBAD] ;CAN'T CREATE THE PAGE. FAIL
LOAD B,DRSTP,(D) ;GET OLD TOP OF SYMBOL TABLE
SUB A,B ;GET DELTA INCREASE
LOAD C,DRFTP,(D) ;GET TOP OF FREE AREA
ADD C,DIRORA ;GET ABS ADR
CAMGE C,DRLOC ;IS DRLOC POINTING WITHIN SYMBOL TABLE?
ADDM A,DRLOC ;YES, Adjust DRLOC for symtab movement
CAMGE C,DRSCN ;IS DRSCN WITHIN SYMBOL TABLE?
ADDM A,DRSCN ;YES, DITTO FOR DRSCN
LOAD B,DRSTP,(D) ;GET TOP OF SYMBOL TABLE
LOAD C,DRSBT,(D) ;AND BOTTOM OF SYMBOL TABLE
SUB B,C ;CALCULATE NUMBER OF WORDS TO BE MOVED
PUSH P,A ;SAVE GROWTH INCREMENT
LOAD C,DRSTP,(D) ;GET ADR OF TOP OF SYMBOL TABLE
ADD C,DIRORA ;MAKE IT ABSOLUTE
MOVE D,C ;NOW CALCULATE NEW TOP
ADD D,A ;OLD TOP PLUS INCREMENT
XPAND4: MOVE A,-1(C) ;GET AN ELEMENT FROM OLD SYMBOL TABLE
MOVEM A,-1(D) ;PUT IT IN THE NEW SYMBOL TABLE
SOS C ;STEP TO NEXT WORD
SOS D
SOJG B,XPAND4 ;LOOP UNTIL SYMBOL TABLE IS COPIED
POP P,A ;GET BACK LENGTH
MOVE D,DIRORA ;GET BASE ADDRESS OF MAPPED DIR AGAIN
LOAD B,DRSTP,(D) ;GET TOP OF OLD SYMBOL TABLE
ADD B,A ;UPDATE IT
STOR B,DRSTP,(D)
LOAD B,DRSBT,(D) ;GET BOTTOM OF SYMBOL TABLE
ADD B,A ;UPDATE IT
STOR B,DRSBT,(D)
RETSKP ;AND RETURN
SUBTTL End of DIRECT
TNXEND
END