(FILECREATED "10-JUN-83 02:56:08" {INDIGO}<LOOPS>SOURCES>BLOCKLOOKUP.;2 8491
changes to: (FNS \FindEntryIndex)
(VARS BLOCKLOOKUPCOMS)
(MACROS \FindEntryIndex)
previous date: " 7-JUN-83 12:08:22" {INDIGO}<LOOPS>SOURCES>BLOCKLOOKUP.;1)
(PRETTYCOMPRINT BLOCKLOOKUPCOMS)
(RPAQQ BLOCKLOOKUPCOMS ((VARS \BlockIncrement \InitBlockSize)
(MACROS \FindEntryIndex \GetNthEntry \PutNthEntry \WordFromPtrIndex)
(FNS \AddBlockEntry \BlockFromList \BlockFull \ClearBlock \DeleteNthEntry \FindEntryIndex
\FreeEntryIndex \GetNthEntry \GrowBlock \ListFromBlock \MakeBlock \NextBlockSize
\PrintBlock \PutNthEntry)))
(RPAQQ \BlockIncrement 8)
(RPAQQ \InitBlockSize 8)
(DECLARE: EVAL@COMPILE
(PUTPROPS \FindEntryIndex MACRO [OPENLAMBDA (KEY BLOCK) (* dgb: "24-MAY-83 05:56")
(* Search BLOCK for KEY, returning its index, or NIL on
failure)
(DECLARE (LOCALVARS . T))
(AND BLOCK
(for I from 0 by 2 bind val
do (COND
((NULL (SETQ val (\GETBASEPTR BLOCK I)))
(* End is marked by NIL)
(RETURN NIL))
((EQ KEY val)
(RETURN I])
(PUTPROPS \GetNthEntry MACRO ((BLOCK WORDNUMBER) (* WORDNUMBER is used for position rather than the entry
number)
(\GETBASEPTR BLOCK WORDNUMBER)))
(PUTPROPS \PutNthEntry MACRO ((BLOCK NTHWORD VAL) (* Store VAL in position NTHWORD)
(\RPLPTR BLOCK NTHWORD VAL)))
(PUTPROPS \WordFromPtrIndex MACRO ((ptrIndex)
(LLSH ptrIndex 1)))
)
(DEFINEQ
(\AddBlockEntry
[LAMBDA (BLOCK ENTRY freeIndex) (* dgb: " 3-JUN-83 11:40")
(* Add an entry to this block. If it is full, then create a new block with same contents, and add entry to new
block. Return block containing new entry)
(OR freeIndex (SETQ freeIndex \FreeEntryIndex BLOCK))
[COND
((NULL BLOCK)
(SETQ BLOCK (\MakeBlock)))
((\BlockFull BLOCK freeIndex) (* New block has free index in same place, since there
are the same number of entries)
(SETQ BLOCK (\GrowBlock BLOCK freeIndex]
(\PUTBASEPTR BLOCK (IPLUS freeIndex 2)
NIL)
(\RPLPTR BLOCK freeIndex ENTRY)
BLOCK])
(\BlockFromList
[LAMBDA (lst extractFn block) (* dgb: " 3-JUN-83 11:44")
(* Fill in the block from a list.
Use extractFn to obtain part of lst which is relevant --
NIL means use it all.)
[COND
(block (\ClearBlock block))
(T (SETQ block (\MakeBlock (IPLUS 2 (LENGTH lst]
(for item in lst as freePos from 0 by 2 do (SETQ block (\AddBlockEntry block
(COND
(extractFn (APPLY*
extractFn
item))
(T item))
freePos)))
block])
(\BlockFull
[LAMBDA (BLOCK freeIndex) (* dgb: "24-MAY-83 05:39")
(* Block is full if pointer after freeIndex contains a
T)
(OR freeIndex (SETQ freeIndex (\FreeEntryIndex BLOCK)))
(EQ T (\GETBASEPTR BLOCK (IPLUS freeIndex 2])
(\ClearBlock
[LAMBDA (block) (* dgb: "25-MAY-83 11:06")
(* Clear the block up to the first free entry in the
block. It will contain a NIL.)
(for i from 0 by 2 do (COND
((NULL (\GETBASEPTR block i))
(RETURN block))
(T (\RPLPTR block i NIL])
(\DeleteNthEntry
[LAMBDA (BLOCK N freeEntryPos) (* dgb: " 2-JUN-83 19:05")
(* Delete the entry at word position N by moving all the entries down. Assumes there is NIL in freeEntry Pos.
Assumed not to be a frequent operation.)
(bind (I ← N)
(I2 ←(IPLUS N 2)) until (IGREATERP I2 freeEntryPos)
do (\RPLPTR BLOCK I (\GETBASEPTR BLOCK I2))
(SETQ I I2)
(SETQ I2 (IPLUS I 2])
(\FindEntryIndex
[LAMBDA (KEY BLOCK) (* dgb: "24-MAY-83 05:56")
(* Search BLOCK for KEY, returning its index, or NIL on
failure)
(DECLARE (LOCALVARS . T))
(AND BLOCK (for I from 0 by 2 bind val do (COND
((NULL (SETQ val (\GETBASEPTR BLOCK I)))
(* End is marked by NIL)
(RETURN NIL))
((EQ KEY val)
(RETURN I])
(\FreeEntryIndex
[LAMBDA (block) (* dgb: "24-MAY-83 05:36")
(* Find the index of the first free entry in the block. It will contain a NIL. It may not be usable, so it must be
checked by \BlockFull. Index is a word pointer)
(for i from 0 by 2 do (COND
((NULL (\GETBASEPTR block i))
(RETURN i])
(\GetNthEntry
[LAMBDA (BLOCK WORDNUMBER) (* dgb: "24-MAY-83 05:58")
(* WORDNUMBER is used for postion position rather than
the entry number)
(\GETBASEPTR BLOCK WORDNUMBER])
(\GrowBlock
[LAMBDA (BLOCK freeIndex) (* dgb: "24-MAY-83 06:32")
(* Copy contents of old block into new larger block.
Return new block)
(OR freeIndex (SETQ freeIndex (\FreeEntryIndex BLOCK)))
(PROG [(NEWBLOCK (\MakeBlock (IPLUS freeIndex \BlockIncrement]
(for I from 0 by 2 to freeIndex do (\RPLPTR NEWBLOCK I (\GETBASEPTR BLOCK I)))
(RETURN NEWBLOCK])
(\ListFromBlock
[LAMBDA (block freeIndex) (* dgb: "24-MAY-83 06:08")
(* create a list containing contents of block, up to but
not including freeIndex)
(OR freeIndex (SETQ freeIndex (\FreeEntryIndex block)))
(COND
((OR (NULL block)
(LISTP block))
block)
(T (for i from 0 by 2 to (IDIFFERENCE freeIndex 2) collect (\GetNthEntry block i])
(\MakeBlock
[LAMBDA (numPointers) (* dgb: "24-MAY-83 06:30")
(* Allocate a block of storage for a search table for pointers. In this implementation, search is assumed to be
done linearly. The last cell of the table contains a T -- The first free entry contains)
(PROG (BLOCK (size (\NextBlockSize numPointers)))
(SETQ BLOCK (\ALLOCBLOCK (\NextBlockSize numPointers)
T)) (* First free pointer in 0)
(\PUTBASEPTR BLOCK 0 NIL) (* Set last cell)
(\PUTBASEPTR BLOCK (\WordFromPtrIndex (SUB1 size))
T)
(RETURN BLOCK])
(\NextBlockSize
[LAMBDA (length) (* dgb: "29-APR-83 10:10")
(COND
((OR (NULL length)
(IGREATERP \InitBlockSize length))
\InitBlockSize)
(T (IPLUS \InitBlockSize (ITIMES \BlockIncrement (ADD1 (IQUOTIENT (IDIFFERENCE length
\InitBlockSize)
\BlockIncrement])
(\PrintBlock
[LAMBDA (BLOCK freeIndex) (* dgb: "24-MAY-83 06:04")
(* Print out contents of BLOCK up to freeIndex)
(OR freeIndex (SETQ freeIndex (\FreeEntryIndex BLOCK)))
(for I from 0 by 2 to (IDIFFERENCE freeIndex 2)
do (PRIN1 I)
(SPACES 1)
(PRINT (\GETBASEPTR BLOCK I])
(\PutNthEntry
[LAMBDA (BLOCK NTHWORD VAL) (* dgb: "24-MAY-83 06:05")
(* Store VAL in postion NTHWORD)
(\RPLPTR BLOCK NTHWORD VAL])
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1737 8469 (\AddBlockEntry 1747 . 2474) (\BlockFromList 2476 . 3168) (\BlockFull 3170 .
3531) (\ClearBlock 3533 . 3950) (\DeleteNthEntry 3952 . 4415) (\FindEntryIndex 4417 . 4981) (
\FreeEntryIndex 4983 . 5388) (\GetNthEntry 5390 . 5690) (\GrowBlock 5692 . 6224) (\ListFromBlock 6226
. 6738) (\MakeBlock 6740 . 7446) (\NextBlockSize 7448 . 7799) (\PrintBlock 7801 . 8225) (\PutNthEntry
8227 . 8467)))))
STOP