Trailing-Edge
-
PDP-10 Archives
-
tops20v41_monitor_sources
-
monitor-sources/direct.mac
There are 64 other files named direct.mac in the archive. Click here to see a list.
;Edit 3161 to DIRECT.MAC by LOMARTIRE on Fri 7-Sep-84
; Revoke edits 3151, 3152, and 3154 due to bad side effects
;Edit 3154 to DIRECT.MAC by LOMARTIRE on Tue 28-Aug-84
; Fix another bug in 3151 with deleted files at EXTSC1
;Edit 3152 to DIRECT.MAC by LOMARTIRE on Mon 27-Aug-84
; Fix an AC smashing bug in edit 3151
;Edit 3151 to DIRECT.MAC by LOMARTIRE on Thu 23-Aug-84, for SPR #18475
; Make the use of FC%DIR work correctly for DIR and GTJFN
;Edit 3140 to DIRECT.MAC by LOMARTIRE on Tue 24-Jul-84, for SPR #15114
; Check access when setting deleted file non-existant in VERLKH
;Edit 3123 to DIRECT.MAC by MOSER on Wed 13-Jun-84
; MAKE UNMIDX GLOBAL FOR EDIT 3120
;Edit 3114 to DIRECT.MAC by CJOHNSON on Thu 31-May-84, for SPR #17074
; Make lookups discriminate between files and directories
;; so directory lookups finding exact match filenames work
;Edit 3018 to DIRECT.MAC by TBOYLE on Thu 22-Sep-83, for SPR #18747
; Make deletions remove dirs from special cache if necc.
;Edit 2988 to DIRECT.MAC by PRATT on Tue 12-Jul-83, for SPR #17020
; Scan next FDB when doing version lookup and FB%NXF is set
;Edit 2986 to DIRECT.MAC by TSANG on Wed 6-Jul-83, for SPR #18697
; Subroutine ADRCHK is used in MDDDC1 to validate FBEXL field.
;Edit 2981 to DIRECT.MAC by JCAMPBELL on Tue 5-Jul-83
; Add FB%FOR for FORTRAN carriage control files
;Edit 2981 - Add FB%FOR to flags not to propogate
;Edit 2980 to DIRECT.MAC by LOMARTIRE on Thu 30-Jun-83 - Remove edit 2977
;Edit 2977 to DIRECT.MAC by LOMARTIRE on Mon 27-Jun-83, for SPR #19196
; Require write access to create higher generation
; UPD ID= 286, FARK:<4-1-WORKING-SOURCES.MONITOR>DIRECT.MAC.5, 13-Jan-83 16:25:37 by MOSER
;EDIT 2896 - ADD CCBROT AND CGROFN
; UPD ID= 157, FARK:<4-1-WORKING-SOURCES.MONITOR>DIRECT.MAC.4, 10-Sep-82 13:47:24 by MOSER
;EDIT 2808 - DON'T TRASH FDBS BELONGING TO OPEN FILES
; UPD ID= 143, FARK:<4-1-WORKING-SOURCES.MONITOR>DIRECT.MAC.2, 3-Sep-82 15:59:14 by MOSER
;EDIT 2801 - DON;T PROPAGETE FB%TMP TO NEW FDBS.
;<4-1-FIELD-IMAGE.MONITOR>DIRECT.MAC.2, 25-Feb-82 20:17:16, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 920, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.10, 10-Dec-81 13:42:07 by DONAHUE
;Edit 1966 - Unmap current directory at CHKBAK:
; UPD ID= 859, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.9, 13-Oct-81 09:35:09 by DONAHUE
;Edit 1955 - Set flag to release directory at MAPELN:
; UPD ID= 757, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.7, 28-Aug-81 10:03:02 by GROUT
;Edit 1934 - Fix indirect words in SETDIR/SETDRR call from MDDDIR
; UPD ID= 737, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.6, 21-Aug-81 10:11:57 by ZIMA
;Edit 1927 - put edit 1909 in standard form. No code changes.
; UPD ID= 659, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.4, 16-Jul-81 15:28:43 by GROUT
;Edit 1909 - Make MDDDIR not check privs if called from .RCUSR
; UPD ID= 492, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.3, 4-May-81 10:08:49 by SCHMITT
;Edit 1862 - Fix byte pointer construction at DIRUNQ
; UPD ID= 435, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.2, 7-Apr-81 17:35:44 by ZIMA
;Edit 1842 - fix GJ%FOU and exact generation case for invisible files.
; UPD ID= 152, FARK:<4-WORKING-SOURCES.MONITOR>DIRECT.MAC.2, 27-Aug-80 15:01:13 by ZIMA
;Edit 1768 - clear FB%BAT for new file generations in VRLK6A.
;<4.MONITOR>DIRECT.MAC.27, 3-Jan-80 08:08:30, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<OSMAN.MON>DIRECT.MAC.1, 10-Sep-79 15:25:27, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>DIRECT.MAC.25, 5-Sep-79 14:58:09, Edit by LCAMPBELL
; Remove useless JRST at ASGDF7
;<4.MONITOR>DIRECT.MAC.24, 28-Aug-79 15:55:46, Edit by KONEN
;ADD FB%FCF TO FLAGS THAT ARE ZEROED IN FDB OF NEW VERSIONS OF FILES
;<4.MONITOR>DIRECT.MAC.1, 13-Aug-79 17:08:43, EDIT BY WILSON
;TCO 4.2394 INCLUDE STRUCTURE NAME FOR DIRBLK BUGCHK
;<4.MONITOR>DIRECT.MAC.22, 19-Jul-79 15:54:02, Edit by KONEN
;CHECK IF THERE IS AN OFN BEFORE CALLING RELOFN
;<4.MONITOR>DIRECT.MAC.21, 17-Jul-79 09:00:37, Edit by KONEN
;CALL RELOFN, INSTEAD OF DWNSHR, TO DECREMENT COUNTS
;<4.MONITOR>DIRECT.MAC.20, 16-Jul-79 16:08:34, Edit by KONEN
;INCREMENT/DECREMENT INDEX TABLE AND DIRECTORY SHARE COUNTS
;<4.MONITOR>DIRECT.MAC.19, 7-Jul-79 18:45:51, Edit by KONEN
;ALLOW FOR FORK IDXORA WHEN CREATING STRUCTURE
;<4.MONITOR>DIRECT.MAC.18, 31-May-79 12:26:04, Edit by LCAMPBELL
; Use good error code at MDDDIR
;<4.MONITOR>DIRECT.MAC.17, 30-May-79 12:01:24, EDIT BY DBELL
;TCO 4.2262 - FAIL IN MDDDIR IF NOTHING BEING STEPPED AND GNJFF SET
;<4.MONITOR>DIRECT.MAC.16, 10-May-79 18:33:44, EDIT BY HALL
;IN SETDIR, REPLACE STKVAR IN OPTIONAL DATA WITH AN AC
;<4.MONITOR>DIRECT.MAC.15, 9-Mar-79 17:33:27, EDIT BY MILLER
;FIX MDDDID SO ALL DIRECTORIES ARE FOUND
;<4.MONITOR>DIRECT.MAC.14, 4-Mar-79 15:07:49, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>DIRECT.MAC.13, 12-Jan-79 20:53:29, EDIT BY DBELL
;TCO 4.2160 - FIX EXTSCN TO NOT CHECK OLDNF IF STEPPING FILES
;<4.MONITOR>DIRECT.MAC.12, 12-Jan-79 15:05:15, EDIT BY HURLEY.CALVIN
; CAUSE FDBINI TO USE DIRECTORY'S OFFLINE-EXPIRATION IF THERE, THEN
; TAPE-RECYCLE-PERIOD (IF SET) AND SYSTEM DEFAULT (.STDFE) AS LAST
; RESORT
;<4.MONITOR>DIRECT.MAC.11, 6-Jan-79 16:27:55, EDIT BY MILLER
;FIX GDIRST TO CHECK IDX%IV AFTER CALLING GETIDX
;<4.MONITOR>DIRECT.MAC.10, 7-Nov-78 12:15:39, EDIT BY HALL
;FIX BUGS IN CALVIN'S EDITS
;<4.MONITOR>DIRECT.MAC.9, 6-Nov-78 21:07:44, Edit by CALVIN
; FIX TREATMENT OF EXACT MATCH OF FIELD IN CASE OF RECOGNITION
;<4.MONITOR>DIRECT.MAC.7, 24-Oct-78 16:04:09, EDIT BY MURPHY
;ADD DIRX5 TO DR0CHK FOR DIRECTORY TOO LARGE
;<4.MONITOR>DIRECT.MAC.6, 23-Oct-78 19:27:58, EDIT BY MILLER
;<4.MONITOR>DIRECT.MAC.5, 23-Oct-78 15:01:15, EDIT BY MILLER
;<4.MONITOR>DIRECT.MAC.4, 23-Oct-78 14:58:06, EDIT BY MILLER
;MAKE SURE PROCESS WITH DIRECTORY LOCKED IS CSKED
;<ARC-DEC>DIRECT.MAC.3, 21-Aug-78 10:42:29, EDIT BY CALVIN
; Default online and offline expiration dates/intervals into new files,
; and new versions
;<CALVIN>DIRECT.MAC.1, 17-Aug-78 05:51:25, EDIT BY CALVIN
; Make FDBINI use length in FDB length of BLT to clear FDB
;[BBN-TENEXD]<3-EONEIL>DIRECT.MAC.1, 7-Jun-78 11:38:21, Ed: EONEIL
; Implemented invisible files, nonrecognition of del./invis. files
;<2MCLEAN>DIRECT.MAC.16, 10-Aug-78 17:39:00, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.15, 10-Aug-78 00:21:50, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.14, 10-Aug-78 00:01:39, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.13, 10-Aug-78 00:00:33, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.12, 16-Jul-78 14:39:35, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.11, 15-Jul-78 16:18:33, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.10, 15-Jul-78 16:15:53, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.9, 15-Jul-78 15:30:00, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.8, 14-Jul-78 00:38:56, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.7, 14-Jul-78 00:33:56, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.6, 13-Jul-78 17:50:44, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.5, 12-Jul-78 16:54:21, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.4, 12-Jul-78 16:39:28, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.3, 12-Jul-78 04:40:32, Edit by MCLEAN
;MORE CACHE FIXES
;<4.MONITOR>DIRECT.MAC.2, 11-Jul-78 15:25:57, Edit by MILLER
;<2MCLEAN>DIRECT.MAC.13, 9-Jul-78 01:56:29, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.12, 9-Jul-78 01:50:52, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.11, 7-Jul-78 14:59:41, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.10, 7-Jul-78 13:10:29, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.9, 7-Jul-78 01:03:56, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.8, 7-Jul-78 00:50:57, Edit by MCLEAN
;<2MCLEAN>DIRECT.MAC.6, 6-Jul-78 02:44:09, Edit by MCLEAN
;MAPDIR CACHE
;<2MCLEAN>DIRECT.MAC.5, 6-Jul-78 02:30:29, Edit by MCLEAN
;<4.MONITOR>DIRECT.MAC.1, 28-Jul-78 09:37:30, EDIT BY MILLER
;TCO 1961. ADD CALLS TO FDBCHK IN SUBDIRECTORY LOGIC
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE 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::SE1CAL
MOVE C,DIRORA ;GET THE PROTECTION OF THE MAPPED DIR
LOAD C,DRPRT,(C) ;...
JRST ACCCH1 ;ENTER COMMON CODE
ACCCHK::SE1CAL
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
CAMN D,Q2 ;REFERENCE TO LOGGED IN DIR?
JRST [ JE CURSTR,,ACCCH9 ;IF ON PUBLIC STRUCTURE, THIS IS THE
; LOGGED IN DIRECTORY
JRST .+1] ;NOT THE PUBLIC STRUCTURE.
;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
CAMN A,Q2 ;REFERENCE TO CONNECTED DIRECTORY?
JRST [ LOAD A,CURUC ;YES. GET STRUCTURE FOR MAPPED DIRECTORY
CAMN D,A ;IS IT THE CONNECTED STRUCTURE?
JRST ACCCH9 ;YES. GIVE OWNER ACCESS
JRST .+1] ;NO. TRY FOR GROUP
;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
OPSTR <SKIPE>,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::SE1CAL
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::SE1CAL
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
SE1CAL
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
;**;[3114] Change 1 line at DSLUK:+2L 1-Mar-84 CRJ
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 ; ...
;**;[1862] Replace 4 lines with 4 lines at DIRUNQ: +4L RAS 4-MAY-81
LOAD D,FBNAM,(B) ;[1862] GET ADDRESS OF NAME STRING
ADD D,DIRORA ;[1862] GET ABSOLUTE ADDRESS INTO DIR
ADDI T4,1 ;[1862] SKIP STRING BLOCK HEADER
HRLZI C,(<POINT 7,(D)>) ;[1862] BUILD BYTE POINTER TO STRING
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
;**;[3018]Add 20 lines at DIRSL0: + 4L 21-SEP-83 TAB
;[3018] Removal routine for special directories. If the structure is PS: and
;[3018] the directory number is present in the special table, it is removed.
;[3018] Call: T3 ; The directory number to remove
;[3018] T4 ; The structure number
;[3018] CALL DIRSLK
;[3018] Return:
;[3018] +1 ; Always
;[3018] Clobbers T1,T2
REMSDR::MOVEI T1,PSNUM ;[3018]
CAME T1,T4 ;[3018]IS THE DIRECTORY ON PS:?
RET ;[3018]NO, RETURN
HRLZ T1,NSDIRT ;[3018]YES, NOW GET NEG NUMBER OF DIRS
JUMPE T1,R ;[3018]RETURN IF ZERO
REMSDL: HLRZ T2,SDIRTB(T1) ;[3018]DIR NUMBER FROM TABLE ENTRY
CAMN T2,T3 ;[3018]IS IT THE DIR WE ARE LOOKING FOR?
SETZM SDIRTB(T1) ;[3018]YES, ZERO THE TABLE ENTRY
AOBJN T1,REMSDL ;[3018]SEARCH THE WHOLE TABLE
RET ;[3018]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
; Clobbers a,b,c,d
GDIRST::SE1CAL
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::SE1CAL
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::SE1CAL
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,FILUC,(JFN) ;GET STRUCTURE UNIQUE CODE
HRL A,B ;36-BIT DIRECTORY NUMBER
MOVE B,INSACA
SKIPN 0(B) ;NULL STRING?
BUG(BADDAC)
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::SE1CAL
SAVEPQ ;SAVE THE PERMANENT ACS
CALL SETDIR ;MAP IN THE DIRECTORY NUMBER
RETBAD () ;COULD NOT MAP THE DIRECTORY
TXNE F,1B17 ;DELETE ALL?
JRST [ MOVE A,DIRORA ;YES - CHECK FOR SUBDIRS
LOAD A,DRSDC,(A) ;GET COUNT
JUMPN A,[RETBAD(DELF10,<CALL USTDIR>)] ;CANNOT DELETE WITH SUBDIRS
JRST .+1] ;NO - OK TO DELETE ALL
TXNE F,DD%CHK ;CHECKING ONLY?
JRST [ MOVEI A,0 ;YES
CALL RBLDST ;DO THE CHECK
RETBAD (,<CALL USTDIR>) ;DIRECTORY IS NOT CONSISTENT
CALL USTDIR ;DIR IS GOOD
RETSKP]
TXNE F,DD%RST ;REBUILD SYMBOL TABLE?
JRST [ SETO A, ;YES, GO REBUILD IT
CALL RBLDST ;...
RETBAD (DELFX4,<CALL USTDIR>) ;REBUILD FAILED
JRST .+1]
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(DIRSY1,<<A,D>,<B,D>>)
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,JOBNO ;YES, IS THIS FILE OURS?
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::SE1CAL
HLRZ A,FILNEN(JFN) ;WAS THERE A NAME SET UP YET?
JUMPE A,R ;IF 0, FDB COULD NOT HAVE BEEN MADE
HRRZ A,DEV ;GET ADDRESS ONLY
HRRZ A,NLUKD(A) ;SEE IF THIS IS A DIRECTORY DEV
CAIE A,MDDNAM
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,FILUC,(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::SE1CAL
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::SE1CAL
HRRZ A,FILDDN(JFN) ;GET DIRECTORY NUMBER
JUMPE A,R ;IF NONE, GIVE ERROR RETURN
LOAD B,FILUC,(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::SE1CAL
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::SE1CAL
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::SE1CAL
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
; Clobbers a,b,c,d
SETDIR::SE1CAL
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 EXADDR ;CHECK FOR EXTENDED ADDRESSING
JRST SETDIB ;YES -- SKIP OVER THIS CHECK
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(DIRBAD,<<A,D>,<D,D>>)
OKINT
RETBAD (DELFX6)
SETDI5: HRRZ B,SETDIN ;GET STR RELATIVE DIR NUMBER
SKIPE A ;NONX PAGE?
BUG(DIRFKP,<<B,D>,<SETDNM,D>>)
JRST SETDI1
;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::SE1CAL
SAVET ;ENTRY POINT FOR NOT UPDATING DRUDT
JRST UPDDR1
UPDDIR::SE1CAL
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::SE1CAL
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::SE1CAL
ULKDIR ;UNLOCK THE DIRECTORY
OKINT
RET
;UNLOCK MAPPED DIRECTORY -- INVOKED VIA ULKDIR MACRO
;CLOBBERS NO ACS
ULKMD0::SE1CAL
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(DIRULK,<<T1,D>,<T2,D>>)
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 LCKDIR
; RETURN +1 ALWAYS, DIRECTORY LOCKED. BLOCK UNTIL ABLE TO LOCK
;FORK MUST BE NOINT WHILE DIRECTORY LOCKED.
LCKDNM::SE1CAL
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 (LCKDIR)
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: SKIPGE Q1 ;FREE ENTRY TO REUSE?
JRST [ MOVE Q1,MLDTAB ;NO, USE NEXT ONE AT END
CAIL Q1,NLDTAB ;TABLE FULL?
JRST LCKDI4 ;YES, BLOCK UNTIL ROOM
AOS MLDTAB ;INCREMENT END
JRST .+1]
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
SE1CAL
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(DIRDNL,<<T1,D>,<T2,D>>)
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
MOVE T2,FKSTAT(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
;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::SE1CAL
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 ;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
SKIPE DCSHRC(B) ;CHECK TO SEE IF DORMANT ENTRY
JRST [ 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
JRST .+1] ;WORK ON THIS ENTRY
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
;**;[1955] Change 1 line at MAPELN:+4L PED 13-OCT-81
JRST [ SETONE DRROF ;[1955] 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
SKIPE EXADDR ;CHECK FOR EXTENDED ADDRESSING
JRST [ CALL MAPDRP ;MAP DIRECTORY PAGE
JRST MAPDI1]
HRLZS A ;SET UP OFN.PN
MOVX B,PTRW+PM%IND ;READ WRITE ACCESS, INDIRECT PTRS
IOR B,DIRORA ;ADD IN BASE ADDRESS FOR MAPPING INTO
MOVE C,NDIRPG ;GET # OF PAGES IN DIRECTORY
CALL MSETMP ;MAP IN THE DIR
MAPDI1: 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::SE1CAL
SKIPE EXADDR ;CHECK FOR EXTENDED ADDRESSING (SEC2)
JRST [ HRRZ A,DRMAP ;GET OFN
SKIPE A ;SKIP IF NO OFN
CALL RELOFN ;DECREMENT OFN SHARE COUNT
SETZM DRMAP ;CLEAR MAP SHARE POINTER
CALL MONCLA ;CLEAR HARDWARE PAGE TABLE
JRST UNMAP1] ;AND CONTINUE
MOVEI A,0 ;CLEAR OUT PREVIOUS DIRECTORY PAGES
MOVE B,DIRORA ;GET STARTING ADDRESS OF MAPPED DIR
MOVE C,NDIRPG ;GET NUMBER OF PAGES IN DIR
CALL MSETMP ;UNMAP THE OLD PAGES (IF ANY)
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
;**;[1927] Change 1909 lines at SETNXF: +6L JGZ 21-AUG-81
; Multiple directory device directory lookup routine
; Call: A ;FULLWORD Directory number
;**;[1909] Change 1 line at SETNXF: +8L JRG 16-JUL-81
;[1909] 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 ; Not used here, means non-directory device
; +2 ; No such directory
; +3 ; 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::SE1CAL
AOS 0(P) ;ALWAYS SKIPS AT LEAST ONCE
SAVEQ
;**;[1909] Change 1 line at MDDDIR:+3L JRG 16-JUL-81
STKVAR <MDDDNO,MDDFLG,MDDDWS,MDDDPT,<MDDDNM,MAXLW>> ;[1909]
MOVEM T1,MDDDNO ;SAVE ARGUMENT
;**;[1909] Add 4 lines at MDDDIR:+5L JRG 16-JUL-81
CAIN T2,.RCUSR ;[1909] CALL FROM .RCUSR?
TDZA T2,T2 ;[1909] YES
MOVEI T2,1 ;[1909] NO
MOVEM T2,MDDFLG ;[1909] 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
;**;[1927] Change 1909 lines at MDDDI1: +4L JGZ 21-AUG-81
;**;[1909] Revamp code at MDDDI1:+4L JRG 16-JUL-81
MOVE T2,MDDFLG ;[1909] GET .RCUSR FLAG
;**;[1934] Change 2 lines at MDDDI1:+5L JRG 28-AUG-81
CALL @[IFIW!SETDIR ;[1909][1934]
IFIW!SETDRR](T2) ;[1909][1934] 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
LSH T1,1 ;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
;**;[2986] Add 3 lines at MDDDC1+2 YKT JUL-06-83
MOVE T1,Q2 ;[2986] GET THE ADDRESS
CALL ADRCHK ;[2986] MAKE SURE THE ADDRESS IS VALID
JRST MDDDC0 ;[2986] NO, NOT VALID. SKIP THIS FILE
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
LSH T2,1 ; ...
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
;**;[1927] Change 1909 lines at MDDIE2: +4L JGZ 21-AUG-81
;**;[1909] Revamp code at MDDIE2:+4L JRG 16-JUL-81
MOVE T2,MDDFLG ;[1909] GET .RCUSR FLAG
;**;[1934] Change 2 lines at MDDIE2:+5L JRG 28-AUG-81
CALL @[IFIW!SETDIR ;[1909][1934]
IFIW!SETDRR](T2) ;[1909][1934]
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(LNGDIR,<<T3,D>>)
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
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::SE1CAL
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
; +2 ; Ambiguous
; +3 ; Success, if nrec&nrec1 are 0, the remainder if any
; ; Is appended to the string addressed by filopt(jfn)
MDDNAM::SE1CAL
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 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(DIRSY2,<<A,D>,<B,D>>)
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: TQNE <UNLKF>
JRST SK2RET ;Do not unlock directory
CALL USTDIR
JRST SK2RET
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 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: TQNN <UNLKF> ;Ambiguity is failure if unlkf
AOS (P)
ERRET: CALL USTDIR
RET
UNIQUE: MOVEI A,GJFX18
TQNN <MTCHF> ; Non-deleted, visible match found?
JRST ERRET ; No
;**;[3161] Replace the 7 lines removed by 3151 DML 7-Sep-84
;**;[3151] Remove 7 lines at UNIQUE:+3 DML 23-Aug-84
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
; +2 ; Ambiguous
; +3 ; Ok, the remaining string is appended to filopt(jfn)
MDDEXT::SE1CAL
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 ; DOUBLE 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
TQO <AMBGF> ; Second found--ambiguous
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 ERRET ; 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 ERRET] ;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
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
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
;**;[3161] Remove all parts of edits 3151 and 3154 DML 7-Sep-84
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
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::SE1CAL
;**;[3161] Remove all parts of edits 3151 and 3152 DML 7-Sep-84
;**;[3152] Change 1 line of edit 3151 DML 27-Aug-84
;**;[3151] Change 1 line at MDDVER:+1 DML 23-Aug-84
;**;[3140] Change 1 line at MDDVER:+1 DML 24-JUL-84
STKVAR <MDDVRA,MDDVRT,MDDVRL,MDDVRF,MDDVFB> ;[3161][3152][3151][3140]
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
JUMPL A,[CAME A,[-2] ;LOWEST?
CAMN A,[-1] ;OR A NEW ONE?
JRST .+1 ;YES. IS A GOOD VALUE
MOVEI A,GJFX20 ;NO. RETURN WITH ERROR
JRST ERRET] ;ALL DONE
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
JN FBDEL,(D),<[TQNN <IGDLF> ;YES, USER WANTS 'IGNORE DELETED'?
JRST VERLK1 ;NO, GO TO NEXT VERSION
JRST .+1]> ;YES, THIS VERSION POTENTIALLY OK
JN FBINV,(D),<[TQNN <IGIVF> ; User want to find invisible?
JRST VERLK1 ; No, go to next one
JRST .+1]>
JN FBNXF,(D),<[ TQNE <OLDNF> ;NO, USER REQUIRES OLD FILE?
JRST VERLK1 ;YES, GO TO NEXT VERSION
JRST VERLK2]> ;NEW VERSION OK
;..
;..
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
;**;[2808]ADD 12 LINES AT VERLK7:+5L TAM 10-SEP-82
VRLK2A: PUSH P,T4 ;[2808] SAVE T4
SKIPN T1,.FBADR(T4) ;[2808] ANY ADDRESS
JRST VRLK2B ;[2808] NO, OK TO REINIT
LOAD T2,DIROFN ;[2808] GET OFN OF DIRECTORY
LOAD T2,STRX,(T2) ;[2808] GET STRUCTURE FOR DIRECTORY
CALL CHKOFN ;[2808] OPEN FILES FOR THIS FDB?
JRST [POP P,T4 ;[2808] YES, GET T4 BACK
JRST VRLK5A] ;[2808] USE DON'T CHANGE THIS FDB
VRLK2B: POP P,T1 ;[2808] NOT IN USE. FDB ADDR IN T1
CALL FDBIN0 ;[2808] UPDATE STUFF IN FDB
SETZRO FBSIZ,(A) ;[2808]
JRST VERLK8 ;[2808]
;HERE IF NEW VERSION WANTED
VERLK2: TQO <NEWVF>
TQZ <NEWF>
;**;[2808]MAKE CHANGES AT VERLK2:+2L TAM 10-SEP-82
JN FBNXF,(D),VRLK2A ;[2808] 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]
;**;[2980] Remove all 11 lines of edit 2977 DML 30-JUN-83
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
;**;[2801] CHANGE 1 LINE AT VRLK6A:+9L TAM 3-SEP-82
;**;[1768] Change one line at VRLK6A: +9L JGZ 27-AUG-80
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 ;[1768][2801][2981] 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?
;**;[3161] Remove all parts of edits 3151 and 3152 DML 7-Sep-84
;**;[3152] Add 3 lines to edit 3151 DML 27-Aug-84
;**;[3151] Replace 1 line with 24 at VERLK1:+2 DML 23-Aug-84
JRST VERLK5 ;[3161] 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
;**;[2808]ADD A LABEL AT VERLK5:+2L TAM 10-SEP-82
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
;**;[1842] Add 2 lines at VERLK5: +7L JGZ 7-APR-81
TQNE <OUTPF> ;[1842] IF FILE IS FOR OUTPUT,
JRST VERLKH ;[1842] 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?
;**;[3140] Add 8 lines after VERLKH:+1 DML 24-JUL-84
MOVEM A,MDDVFB ;[3140] Yes, save pointer to FDB
MOVX B,DC%CF ;[3140] Get access required
CALL DIRCHK ;[3140] (B/) Check for create file access
IFNSK. ;[3140]
MOVEI A,GJFX35 ;[3140] Access denied
JRST ERRET ;[3140] Return error
ENDIF. ;[3140]
MOVE A,MDDVFB ;[3140] Restore pointer to FDB
SETZRO FBDEL,(A) ;CLEAR DELETED BIT
SETONE FBNXF,(A) ;AND SET NON-EXISTENT
JRST VRLKH1]
;**;[2988] Replace 5 lines with 7 lines at VRLKH1+1 JMP 8-Jul-83
VRLKH1: JE FBNXF,(A),VERLK8 ;FILES EXIST?
;**;[3161] Remove the label added by edit 3151 DML 7-Sep-84
;**;[3151] Add a label at VRLKH1:+1 DML 23-Aug-84
TQNE <STEPF> ;[3161][3151][2988] NO - STEPPING ?
TQNN <VERSF> ;[2988] AND VERSION STEPPING ?
TQNN <OLDNF> ;[2988] NO - OLD FILE ONLY?
JRST [TQO <NEWVF> ;[2988] NEW FILE - SET NEW VERSION FLAG
JRST VERLK8] ;[2988] SCAN NEXT FDB
MOVEI A,GJFX24 ;[2988] YES, THEN GIVE AN ERROR RETURN
JRST ERRET ;[2988]
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 file lookup
; Return
; +1 ; No exact match found
; +2 ; Exact match found
;**;[3114] Add 2 lines at LOOKUP: 16-May-84 CRJ
LOOKUP: TDZA D,D ;Clear flag: normal entry
LOOKP1: SETO D, ;Set flag: directory lookup
;**;[3114] Change 1 line at LOOKUP:+0L 16-May-84 CRJ
STKVAR <LOOKUE,LOOKUI,LOOKUB,DIRSRC>
TQZ <MTCHF,AMBGF> ;CLEAR RESULT FLAGS
MOVEM C,LOOKUE ;SAVE ENTRY TYPE
;**;[3114] Add 1 line at LOOKUP:+4L 16-May-84 CRJ
MOVEM D,DIRSRC ;[3114] 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
CAMGE B,C
JRST [ MOVE C,DIRORA ;GET DIR #
LOAD C,DRNUM,(C)
MOVEM B,LOOKUB ;SAVE B
CALL GETSNM ;GET STR NAME
BUG(DIRSY3,<<C,D>,<B,D>>)
MOVE B,LOOKUB ;RESTORE B
JRST .+1]
;..
;..
SYMCMP: MOVEM A,LOOKUI ;Save increment
MOVEM B,DRLOC ;And symtab loc
MOVE A,LOOKUE ;GET ENTRY TYPE
CALL NAMCM1
;**;[3114] Replace 1 line with 6 at SYMCMP:+4L 16-May-84 CRJ
JRST SYMCM0 ;[3114] No exact match
SKIPN DIRSRC ;[3114] Looking up a directory?
IFSKP. ;[3114] Yes
CALL DRLKFD ;[3114] Scan types and gens for a directory
JRST SYMCM1 ;[3114] No dir, treat as a partial match
ENDIF. ;[3114]
RETSKP ;SYMBOL FOUND
;**;[3114] Add 2 lines at SYMCMP:+11L 16-May-84 CRJ
SYMCM0: MOVE C,A ;[3114] Keep NAMCM1 result
MOVE A,LOOKUI ;GET INCREMENT
MOVE B,DRLOC ;AND POINTER
JUMPL C,MOVDN ; A<B
JUMPG C,MOVUP ; A>B
;**;[3114] Add 15 lines at 16-May-84 CRJ
;Here if a subset match occurred
SKIPN DIRSRC ;[3114] Looking for directories or files?
JRST SYMCM1 ;[3114] If files, normal subset action
CALL DRLKFD ;[3114] If dirs, scan types and generations
IFNSK. ;[3114] No directory file found?
TQO <MTCHF,AMBGF> ;[3114] Nope, treat as ambiguous
JRST SYMCM2 ;[3114]
ENDIF. ;[3114]
;Here on a subset match
SYMCM1:
TQOE <MTCHF> ; A IS SUBSET OF B
TQO <AMBGF>
;**;[3114] Add 3 lines at 16-May-84 CRJ
SYMCM2: MOVE A,LOOKUI ;[3114] If not found, restore variables
MOVE B,DRLOC ;[3114]
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(DIRSY4,<<A,D>,<B,D>>)
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::SE1CAL
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::SE1CAL
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::SE1CAL
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::SE1CAL
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
;**;[2896]REPLACE 1 LINE WITH 2 AT CHKBAK:+8L TAM 11-JAN-83
JRST [ BUG(CGROFN,<<T1,LSTERR>>) ;[2896]CAN'T, COMPLAIN
RET] ;[2896] FAIL
STOR A,DIROFN ;SAVE THIS OFN
SETONE DRROF ;INDICATE UNMAPD SHOULD RELEASE OFN
SKIPE EXADDR ;CHECK FOR SEC 2
;**;[1966] Add 4 lines at CHKBAK:+12.L PED 10-DEC-81
JRST [ HRRZ A,DRMAP ;[1966] GET CURRENT MAPPED DIRECTORY
SKIPE A ;[1966] IS THERE ONE?
CALL RELOFN ;[1966] YES
LOAD A,DIROFN ;[1966] GET NEW OFN
CALL MAPDRP ;MAP DIRECTORY PAGE
JRST CHKBKA] ;AND CONTINUE
HRLZS A ;GET OFN.PN FOR MAPPING THIS FILE
MOVX B,PTRW ;MAP FILE IN AS READ WRITE ALLOWED
IOR B,DIRORA ;GET ADDRESS OF AREA TO MAP INTO
MOVE C,NDIRPG ;MAP IN WHOLE FILE
CALL MSETMP ;THIS FILE SHOULD LOOK LIKE A DIRECTORY
CHKBKA: 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
;**;[2896] MAKE CHANGES AT CHKBK1:+2L TAM 11-JAN-83
CALL CPYBAK ;[2896] GO MAKE A COPY OF THE FILE
JRST [ BUG (CCBROT,<<T1,LSTERR>>) ;[2896] COULDN'T, COMPLAIN
RET] ;[2896] AND FAIL
RETSKP ;[2896] 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(MPIDXO)
RETBAD(DELFX6) ;GIVE FAILURE RETURN
; MAP THE DESIRED INDEX TABLE FILE
MPIDX4: SKIPE EXADDR ;CHECK FOR EXTENDED ADDRESSING
JRST MPIDX3 ;YES PUT IDXTAB IN 3,,0
HRLZ T1,T2 ;GET OFN.PN FOR FIRST PAGE OF INDEX TABLE FILE
SKIPN T2,FKXORA ;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
MOVE T2,IDXORA ;GET BASE ADDRESS OF INDEX TABLE
TXO T2,PTRW ;GET ACCESS BITS
MOVX T3,NIDXPG ;GET # OF PAGES TO MAP
CALL MSETMP ;MAP INDEX TABLE FILE
JRST MPIDX5
MPIDX3: 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
MOVEI A,0 ;CLEAR OUT PREVIOUS INDEX PAGES
SKIPN B,FKXORA ;GET SPECIAL FORK IDXORA IF STRUCTURE CREATION
MOVE B,IDXORA ;GET STARTING ADDRESS OF INDEX TABLE
MOVX C,NIDXPG ;GET # OF PAGES IN INDEX
SKIPN EXADDR ;CHECK FOR EXTENDED ADDRESSING
JRST [CALL MSETMP ;UNMAP THE OLD PAGES
SETZRO IDXFLG ;MARK THAT INDEX TABLE IS NO LONGER MAPPED
RET] ;RETURN
HRRZ A,IDXMAP ;GET OFN
SKIPE A ;SKIP IF NO OFN
CALL RELOFN ;RELEASE OFN
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::SE1CAL
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 ;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::SE1CAL
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
LSH A,1 ;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::SE1CAL
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
LSH A,1 ;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::SE1CAL
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
LSH D,1 ;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::SE1CAL
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::SE1CAL
CALL CNVIDX ;GET INDEX INTO IDXTAB
RET
SETONE IDXIV,(A) ;MARK IT INVALID
CALLRET UPDIDX ;GO UPDATE THE IDX FILE
;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 T1,STRTAB(T1) ;GET POINTER TO SDB
RET ;NONE? DONT DO ANYTHING
LOAD T1,STRIDX,(T1) ;GET THE OFN OF IDXFIL
HRLZS T1 ;GET OFN,,PN FOR PAGE 0
MOVEI T2,NIDXPG ;GET # OF IDX FILE PAGES
CALLRET UPDPGS ;GO UPDATE THEM
;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: RETSKP ;EVERYTHING IS IN ORDER
DR0CHB: CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRPG0,<<A,D>,<B,D>>)
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,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRPG1,<<A,D>,<B,D>>)
RETBAD (DIRX3)
;ROUTINE TO CHECK THE SYMBOL TABLE HEADER
; CALL SYMCHK
;RETURNS +1: BAD
; +2: OK
SYMCHK::SE1CAL
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(DIRSY5,<<A,D>,<B,D>>)
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,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
SKIPE FDBCHF ;BUG CHECK MESSAGE WANTED?
BUG(DIRFDB,<<A,D>,<B,D>>)
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: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRNAM,<<A,D>,<B,D>>)
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: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIREXT,<<A,D>,<B,D>>)
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: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRACT,<<A,D>,<B,D>>)
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
SUB A,DIRORA ;GET RELATIVE ADR OF THIS BLOCK
XOR A,B ;SEE IF THE BLOCKS ARE ON THE SAME PAGE
TRZ A,777 ;MASK OFF LOW ORDER BITS
JUMPN A,FREBAD ;IF NOT ON SAME PAGE, GO COMPLAIN
FRECH1: RETSKP ;BLOCK IS OK
FREBAD: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRFRE,<<A,D>,<B,D>>)
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 (DIRUNS,<<A,D>,<B,D>>)
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
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?
RETBAD (DIRX3) ;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
CAME A,RBLDSC ;SAME AS LOCAL COUNT?
JRST [ JUMPE P3,[RETBAD(DIRX3)] ;NO - ERROR IF JUST CHECKING
MOVE A,RBLDSC ;GET CORRECT COUNT
STOR A,DRSDC,(Q1) ;STORE CORRECTED COUNT IN DIR
JRST .+1] ;AND CONTINUE
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
STOR A,DRDCA,(Q1) ;STORE CORRECT USAGE COUNT
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(DIRSY6,<<A,D>,<B,D>>)
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::SE1CAL
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,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET STRUCTURE NAME FOR CONNECTED STRUCTURE
BUG(DIRBLK,<<A,D>,<B,D>>)
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
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::SE1CAL
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::SE1CAL
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: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRB2S,<<A,D>,<B,D>>)
RETBAD (DIRX3)
RLDFB2: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRB2L,<<A,D>,<B,D>>)
RETBAD (DIRX3)
RLDFB3: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRBCB,<<A,D>,<B,D>>)
RETBAD (DIRX3)
RLDFB4: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRIFB,<<A,D>,<B,D>>)
RETBAD (DIRX3)
RLDFB5: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRBAF,<<A,D>,<B,D>>)
RETBAD (DIRX3)
RLDFB6: MOVE A,DIRORA ;GET DIR #
LOAD A,DRNUM,(A) ;FOR SYSERR
CALL GETSNM ;GET THE SIXBIT STRUCTURE NAME INTO B
BUG(DIRRHB,<<A,D>,<B,D>>)
RETBAD (DIRX3)
;ROUTINE TO GET SIXBIT STRUCTURE NUMBER INTO AC B
; THIS ROUTINE DOES NOT CLOBBER ANYTHING EXCEPT B
; IT ASSUMES THAT THE DIRECTORY IS LOCKED
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