Trailing-Edge
-
PDP-10 Archives
-
BB-M780C-SM
-
monitor-sources/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
; 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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985.
;ALL RIGHTS RESERVED.
SEARCH PROLOG
TTITLE 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
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
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
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
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
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: 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
DELDL3: 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
CALL DELFIL ;DELETE THE CURRENT FDB
CALL [ TXNN F,1B17 ;IF EXPUNGING ALL, GIVE ERROR
CAIE T1,DELFX2 ;EXPECTED FAILURE IF FILE OPENED
MOVE Q1,A ;NO, THEN REMEMBER FAILURE
RET]
JRST DELDL5 ;GO CONTINUE SCANNING
DELDL6: LOAD P3,FBEXL,(P3) ;STEP TO NEXT EXT
CALL DELFIL ;DELETE THE FDB IN D
CALL [ TXNN F,1B17 ;IF EXPUNGING ALL, GIVE ERROR
CAIE T1,DELFX2 ;EXPECTED FAILURE IF FILE OPENED
MOVE Q1,A ;NO, THEN REMEMBER FAILURE
RET]
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,SOFT,<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 and DIRECTORY subcommand.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
DELDL9: MOVEI A,DELFX6 ;DIR FORMAT IS SCREWED UP
CALLRET USTDIR ;UNLOCK THE DIR AND RETURN
;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
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
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
>)
OKINT
RETBAD (DELFX6)
;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.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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.
>)
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,DIRDNL,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.
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
UNLOCK DIRCLK ;UNLOCK DIRECTORY CACHE
MAPASO: CALL GETIDX
RETBAD
TXNE D,IDX%IV ;INVALID?
RETBAD (DIRX3) ;YES, FAIL
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 ;ASSIGN AN OFN FOR THIS FILE
RETBAD () ;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]
LOCK DIRCLK ;LOCK CACHE LOCK
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
;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,SOFT,<Long directory file in directory>,<<T3,DIRNUM>>,<
Cause: The subdirectory has an incorrect superior directory.
Action: Rebuild index table.
Data: DIRNUM - Directory number
>)
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: Rebuild symbol table.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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
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
UNIQUE: MOVEI A,GJFX18
TQNN <MTCHF> ; Non-deleted, visible match found?
JRST ERRET ; No
MOVE A,DRLOC ;NOW SEE IF LIST ACCESS NOT ALLOWED
LOAD A,DIRLA,(A) ;GET FDB ADR
ADD A,DIRORA
MOVX B,FC%DIR ;SINCE RECOGNITION BEING DONE, CHECK ACCESS
CALL ACCCHK ;DONT DO RECOGNITION ON NO LIST FILES
JRST [ MOVEI A,GJFX18
JRST AMBRET] ;RETURN AMBIGUOUS SO BELL WILL RING
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
MOVEM B,DRLOC ; For non-deleted visible file
TQON <MTCHF> ; Flag non-deleted visible file
JRST EXTNXT ; First found--keep looking
MOVEI A,GJFX19
JRST AMBRET
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
JRST UNIQU1 ;And copy tail to input
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: TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;STEPPING FILES?
TQNE <OLDNF> ;OR OLD FILE ONLY?
SKIPA ;YES
RETSKP ;NO, ALLOW CREATING OF NEW NAMES
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: 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
; 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
; 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,DIRSRC>
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: Rebuild symbol table.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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: ADDI B,.SYMLN ;STEP TO NEXT SYMBOL
STRFDD: MOVEM B,DRLOC
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: Rebuild the symbol table.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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.
Data: LSTERR - Error returned from ASGOFN
>,R)
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.
Data: LSTERR - Error returned from CPYBAK
>,R)
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 mappped.
>)
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,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
LOAD A,IDXFB,(A) ;GET THE FDB ADR
RETSKP ;GOOD RETURN
;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
CALL CNVIDX ;GET INDEX INTO IDXTAB
RET
SETZRO IDXFB,(A) ;CLEAR ALL ENTRIES
SETZRO IDXIB,(A)
SETZRO IDXSD,(A)
SETZRO IDXFG,(A)
CALLRET UPDIDX ;UPDATE IDXTAB
;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,SOFT,<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
>)
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,SOFT,<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
>)
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: Rebuild symbol table.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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,SOFT,<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
>)
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,SOFT,<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,SOFT,<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: Check SYSERR for file. Delete and expunge it,
then restore it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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: Check SYSERR for file. Delete and expunge it, then
restore the file.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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: Rebuild Directory.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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: Check SYSERR for file. Delete and expunge it,
then restore the file.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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.
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
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
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: Split directory into more directories.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
>)
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
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: Delete directory and rebuild it.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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: Run CHECKD to reclaim lost space.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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: Run CHECKD to reclaim lost pages.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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: Run CHECKD to reclaim lost pages.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
RETBAD (DIRX3)
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
>)
RETBAD (DIRX3)
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
>)
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.
Data: DIRNUM - Directory Number
STRNAM - Sixbit Structure Name
ADDR - Address in directory
>)
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
TNXEND
END