;"***************************************************************************** This file defines library update primitives for use with a resident library file. Both the server and LUP use these procedures (spliced in at compile time). See LIBRARY.FORMAT for definition of binary formats of record and library. LUP-BASE.MUD: EDIT HISTORY Machine Independent COMPILATION: Spliced in at compile time. JUN84 [Shane] - Created. 18OCT84 [Shane] - Commented, cleaned up. 28OCT84 [Shane] - Add LUPI-INSTALL. 9OCT84 [Shane] - Add LUPI-ADD-FILE, LUPI-FILE-EXISTS?, LUPI-DEL-FILE ****************************************************************************" > )> ;"See L-DEFS." ;"LUPI-KEY -- Is the LIBLOCK when an update is in progress." '>> ;"LUPI-ABORT -- Effect: Aborts an update in progress. Deletes all temporary files generated, writes message to log file, and unlocks library. Modifies: K." ,LUPI-KEY) NAME:STRING CH:) ,DELFILE > >> )> >> > ) (T >)> >> ,UNLOCK-FILE>)>)> > T)>> ;"LUPI-GENTEMP -- Effect: Generate a unique file name for the library directory: LIBTMPnnn.TEMP if the library is locked. Returns: Filename. Modifies: K." ,LUPI-KEY)) :DSK DEV>) (SNM: :DSK SNM>) (NM2: "TEMP") (SUFFIX:FIX ) (NAME:STRING >) FN:) ;"Increment the suffix. I2S returns NAME rested to digits." > 6>>> > > >)>> ;"LUPI-LOCK -- Effect: Locks library corresponding to LIB. Creates the LIBLOCK and writes message to LOG. The contents of the library is copied and all update actions affect the copy. Returns: The locked active library. Modifies: LOG. Note: The default for the log file is NM1.LOG where NM1 is first name of library file in library directory." "OPT" (LOG: FALSE> %<>) "AUX" (NEW: FALSE> %<>)) ) (SNM: ) (NM1: ) (NM2: ) (NAME:STRING ) FN:) ;"Check to see if user already has library locked." ,LUPI-KEY> )> ,LOCK-FILE>> )>) ("TOPS20" ;"Thawed under TOPS20." > ) (T )>)> ;"Open the log file if we were not given one. Recreate if needed." > > > >) (> > .LOG> )>)> ;"Copy the library to temporary file." > > > >) N:FIX) 0>> > )>> ;"Make the key and say library is locked." > .LOG> .LIB)>>> ;"LUPI-COMMIT -- Effect: Deletes files that have been deleted from library. Renames temporary files to destinations for files that have been added to library. Renames temporary library to library and releases lock. All accompanied by messages to log file. Modifies: K, LOG." ,LUPI-KEY) LOG:) > ;"Delete files." > > ;"Rename temporary files." > > ;"Rename temporary library, flushing old library." :DSK NAME>) (NEW:STRING :DSK NAME>)) > > )> > T>)>> ;"LUPI-INSTALL -- Effect: Deletes files that have been deleted from library. Renames temporary files to destinations for files that have been added to library. Renames temporary library to library but retains lock. All accompanied by messages to log file. Modifies: K, LOG." ,LUPI-KEY) LOG:) > ;"Delete files." > > ;"Rename temporary files." > > ;"Rename temporary library, flushing old library, locking new." :DSK NAME>) (NEW:STRING :DSK NAME>) CH: FALSE>) > > )> > ;"Small window here where someone else could grab library." > >) (T > %<>)>>)>> ;"LUPI-CREATE -- Effect: Create a library named NAME with default second name LIBMIM. Creates associated log file. Returns: Full library name." FALSE> %<>) (LOG: FALSE> %<>)) > 0>>) (NM2: "LBIN") (FN: )) > ;"If it exists, ask user what to do." > > LUPI-CREATE> ) (T >)>)> ;"Create library directory and log file." > ) (DEV: )) >> > >> ;"Hash table size and end of file pointer." .NBKTS> > > .LOG> .NAME) (T .LIB)>>> ;"LUPI-ADD-PACK -- Effect: Adds RECORD to shadow library. The names in TMP are the names of the temporary files involved in the transaction. The names in ADD are the destination file names. The order MUST be the same. Writes message to log file. Modifies: K." ADD:LIST TMP:LIST "AUX" (K: ,LUPI-KEY)) > ;"Just in case." >> ) (LLTMP:LIST ) (LLSIZE:FIX ) (LOG: ) (NAME:STRING >)) ;"Splice file names onto existing lists." ) (> > .TMP> > .ADD>)> .NAME >>> >)>> ;"LUPI-ADD-FILE -- Effect: Adds an auxiliary file to the library directory (such as a runtime help file). TMP is the name of the temporary file obtained from LUPI-GENTEMP and ADD is the name the file should be renamed to when the library is installed. Modifies: K." ,LUPI-KEY)) )> )> T)>> ;"LUPI-DEL-FILE -- Effect: Adds the name of an auxiliary file (in the library directory) to the list of files to be deleted when the modified library is installed. Modifies: K." ,LUPI-KEY)) ) (DEV: ) (SNM: ) (FN: ) (NM2: )) > > )> T>)>> ;"LUPI-DEL-PACK -- Effect: Deletes record named PACKAGE from shadow library and adds the file names in record to delete list (if they correspond to files in the library directory. Modifies: K." ,LUPI-KEY)) >>) (LLDEL:LIST ) (LOG: ) (NEW: ) (DEV: ) (SNM: ) FN:) ;"Map over the files REMOVE-RECORD found, adding them to delete list if they are in the library directory. This will always happen unless the library contains explicit path name (those without paths must be in the library directory and will be parsed as such)." ) > :STRING .DEV> <=? :STRING .SNM>> !.LLDEL)>)> )>> .FILES> T)>>)>> ;"LUPI-GC -- Effect: Compact shadow library, reclaiming any holes in the file. The old shadow library is closed and the garbage collected shadow library becomes the shadow library. Writes message to log file. NBKTS suggests the number of buckets to use. Modifies: K." ,LUPI-KEY)) ) (NAME:STRING ) (LOG: ) NNEW:>) > > > T) (.NNEW %<>)>>)>> ;"NPRIME? -- Returns T iff N is not prime." >:FLOAT 1.0>>)) >) (<==? 0> )> >>> ;"NEXT-PRIME -- Returns next prime larger than X." >>> )>>> ;"ALLOCATE -- Effect: Allocates AMT storage in LIB. The storage is taken from the free list if possible otherwise storage is allocated at the end of the file. Modifies: LIB Returns: Address of allocated storage block." AMT:FIX "AUX" BSIZE:FIX BADDR:FIX BPRED:FIX BSUCC:FIX SIZE:FIX ADDR:FIX SUCC:FIX PRED:FIX) > ;"Move to free list." > ;"Address of first block." > ;"Best address initially EOF." ;"Best size initially max." ;"No predecessor." ;"No successor." ;"Not end of list?" ;"Go to block descriptor." > ;"Its size." > ;"Its cdr." ;"Better tnan best so far?" ;"Must be at least 2 words bigger." > >> ;"Yep, set best variables." )> ;"If end of list or exact, we can do no better." <==? .BSIZE .AMT>> ) (T > ;"Move to next block." > > >)>>)> ;"0 -- eof, bump eof pointer." >) (T ;"Got a block from list." ;"Exact, just splice out." ) (T ;"Carve out a piece." >> ;"Splice in reduced block." > )>)> *77777777*> ;"File address < 24 bits." %<>) (T .BADDR)>> ;"FREE -- Effect: Deallocate AMT storage beginning at address START. The block is spliced into the FREE list in storage order. Modifies: LIB." START:FIX AMT:FIX "AUX" (END:FIX <+ .START .AMT>) (PAIR >) PRED:FIX SUCC:FIX) > ;"Move to free list." > 0> ;"If none, its easy." ) (T ;"Find where block belongs." ;"Move to successor." ;"Get descriptor." >>> ;"Block is adjacent to end of SUCC, compact." > ;"Block exactly fills hole between SUCC and and its successor, compact all three." > ;"Add block to SUCC." > ;"Move to SUCC's cdr." ;"Get its size." >)> ;"and its successor." <1 .PAIR <+ .SIZE .AMT>> ;"Add the words we are freeing." ;"Move to SUCC." ;"And mung in the new descriptor." ) (<==? .END .SUCC> ;"SUCC is adjacent to end of block, compact." ;"SUCC's successor becomes block's successor, add SUCC's size to block's size, mung in new descriptor and mung SUCC's predecessor.." >> ) ( ;"Block belongs before SUCC, mung SUCC's predecessor and point block at SUCC." .AMT>> ) (<==? <2 .PAIR> 0> ;"Block belongs after SUCC, point SUCC at block." > .AMT>> ) (T ;"Keep looking." > >)>>)> T> ;"ADD-RECORD -- Effect: Adds RECORD to LIB. The directory is pointed at RECORD and all of its entrys. Modifies: LIB Requires: RECORD is a properly formatted library record as defined in LIBRARY.FORMAT." LIB: "NAME" ADD-RECORD "AUX" TMP:FIX RECADDR:FIX ADDR:FIX ERCNT:FIX DELTA:FIX NBKTS:FIX (STATS: >)) >> > ADD-RECORD> .ADD-RECORD>)> > ;"Get some space." ;"Move to allocated address." ;"Write the record." ;"Get size of hash table." > ;"Get entry, package counts." >> ;"Length of record name." .NBKTS .TMP>> ;"Point bucket at RECORD." >> ;"Entry count, distance to list." > > <2 <1 .STATS <+ <1 .STATS> .ERCNT>> <+ <2 .STATS> 1>> ;"Update statistics." )> >>> > .NBKTS .TMP>> ,BKT-E> > > > ADD-RECORD> >)>>> ;"ADD-POINTER -- Effect: Points the bucket FROM at address TO with MASK bits set in bucket pointer (either BKT-P or BKT-E). Modifies: LIB Requires: FROM is address of BUCKET that was obtained from hasher, TO is the address of a package or entry record, MASK is a legal bucket mask." FROM:FIX TO:FIX MASK:FIX "AUX" TMP:FIX) >> ;"Empty bucket." >) (T ;"Single or list." >) ADDR:FIX) > ;"Get cons cell." > ;"It was single item. We have to get a cons cell for existing pointer and link FROM to the list of two items." <2 <1 .PAIR .TMP> >> ;"Point to list." > ;"Old pointer." <2 <1 .PAIR > 0> ;"New pointer." ) (T ;"Cons onto existing list." > <2 <1 .PAIR >
> )>>)>> ;"REMOVE-RECORD -- Effect: Removes record named PACKAGE from LIB. Removes all pointers to record from directory, freeing the space. Gets names of files associated with record. Modifies: LIB, FILES Returns: Vector of file names associated with record." "OPT" (FILES:VECTOR >) "AUX" (BUFFER: >) (PDNLEN:FIX ) (STATS: >) RECADDR:FIX NBKTS:FIX RINFO:FIX "NAME" REMOVE-RECORD) .PDNLEN>>> ;"Get size of hash table." > ;"Get package, entry count." >) (BKT:FIX )) ;"Look for pointer to record." > ;"Single package pointer. Move to record and compare names." >> > ;"Contains name length." .PDNLEN> ;"Same length, is it the name?" .REMOVE-RECORD>)>) (T .REMOVE-RECORD>)>) ( ;"List, move through list examining package records." > >) CDR:FIX) > ;"Package?" >> > .PDNLEN> ;"Same name?" )>)>)> > 0> ;"Empty list?" .REMOVE-RECORD>) (T )>>) (T .REMOVE-RECORD>)> > ;"Get the record." > ;"We got record info above." ;"Flush package pointer." >> ;"Free the record space." >> ;"Get sizes of file names." ;"Is there a doc file?" >) (T ;"No, mask out doc length." >>)> >> ;"Count of entries." >> ;"Distance to entries." > ;"Get the file names." )) > <1 .FV > >) (T <1 .FV %<>>)>> .FILES> ;"Update library package, entry counts." <2 <1 .STATS <- <1 .STATS> .ERCNT>> <- <2 .STATS> 1>> .DELTA>> )> > >>> >> .NBKTS .ERLEN>> > >>>>> ;"REMOVE-POINTER -- Effect: Deletes pointer to ADDR found in BKT. If the pointer is in cons, its storage is freed. Modifies: LIB Requires: BKT is the address of a bucket in the hash table, ADDR is present in BKT." BKT:FIX ADDR:FIX "AUX" LAST:FIX) >> .ADDR> ;"ADDR was only thing in bucket" ) ( ;"List?" > ;"Cruise the list." >) (PRED:FIX .BKT)) ;"Get a cons." ;"And check its car for ADDR." > .ADDR> ;"Give away the cons." > ;"Check out the cdr." ;"Nil?" ;"Predecessor gets nil." ;"If this was last in list of two items, move car of remaining cons to bucket." >> >> ;"Yep, bucket points to this cons." > )>)>) (<==? .PRED .BKT> ;"If this was first in list of two items, move car of remaining cons to bucket." 0> ;"Yep, ADDR's successor is last in list." > ) (T >)>) (T ;"Just splice the cons out." )> ) (T > ;"Cdr is second word." >>)>>) (T )>> ;"GC-LIB -- Effect: Copies contents of LIB to NEW in bucket order, rehashing if need. NNBKTS suggests the number of buckets to use. Modifies: NEW Requires: LIB is properly formatted library as defined in LIBRARY.FORMAT" NEW: "OPT" (NNBKTS:FIX ,INITIAL-BUCKETS) "NAME" GC-LIB "AUX" NBKTS:FIX TMP:FIX (PAIR: >)) > ;"Get table size." > ;"Get package, entry counts." <2 .PAIR>>> > 1.5> <2 .PAIR>>>>>>>>)> ;"Construct and write new directory." 0>>)) ;"Initialize table size, end of file pointer for new directory." .NNBKTS> > .GC-LIB>>> > ;"Find all the records and copy them to NEW." >) (NPKGS:FIX <2 .PAIR>) (BKT:FIX ,DIR-HDRLEN)) > )> ;"Get current bucket." > ;"Package?" > ;"Record info." <- > 1>> .GC-LIB>> >) ( ;"List?" > ;"Get cons." ,BKT-P> ;"Package?" >> ;"Record info." <- > 1>> .GC-LIB>> >)> > 0> )>>)> >>> ;"LUPI-RECORD-EXISTS? -- Effect: Returns T if record named NAME exists in shadow library." ,LUPI-KEY) (JUNK: >)) .JUNK>>> ;"LUPI-FILE-EXISTS? -- Effect: Returns T if file named NAME is found in the library directory." ,LUPI-KEY)) ) (DEV: : DEV>) (SNM: : SNM>) (NM2: )) > >>)>> ;"I2S -- Effect: Convert I to string representation. Modifies: S Returns: S rested to the first digit. Requires: S is large enough to hold the representation of I." ) "AUX" (NEG: )) >)> ) D:FIX) > > CHARACTER>> > > 0> >)> >)>>>