Lisp Memory Management

The problem:

Every time a list is created when it is read or during function calls parts of the list may be discarded while other parts retained.

Examples:

You type (cdr'(a b c)) the system returns the list (b c) but neither this list or the rest of the tree is used any longer.

When you have the function foo defined by:

(defun foo (x y)
	(setq x '(a b c))
	(setq y '(e f g)))

The lists are all local and once the function completes its run neither list can be accessed again.

The problem with this is that lists use large amounts of memory quickly and without some way to reclaim the memory the program would use all of the memory available without doing much.

One other problem. All information connected with an atom (function definitions, property lists, and global values) must be maintained. If the following is executed:

(setq x '(a b c))

The list (a b c) is now attached to the atom node for x. Notice that that list is part of a larger list (setq x '(a b c)) which is translated to (setq x (quote (a b c)))). All of this list except for the (a b c) is garbage.

Garbage Collection

How do we collect garbage? First how can we allocate memory in such a way that we override the system and make garbage collection possible.

First we know that the hash table (or other global variable lookup table) has access to all permanent list nodes. This is because the atoms are held in the table and have pointers to lists that describe their various properties. This means that any list that is not garbage can be traversed from the hash table (demonstrate)

Now we only need to be able to search all of memory (that we are using) to see which nodes are marked and which aren't. Those that aren't are put back into the free memory list.

One other problem. Some systems only allow allocation of blocks of a specified maximum size. To overcome this problem you may want to create a linked list of memory blocks.

All list nodes are the same size, and consist of classification byte and two pointers

CLASSTYPE = (ATOM, ACTIVE, DOT, LIST, FULLWORD, NUMTYPE);
   SPTR = ^NODE;(* POINTER TO AN S-EXPRESSION*)
   NODE = record
         case CLASS : CLASSTYPE of
            ACTIVE, DOT, LIST: (
                  LEFT: SPTR; (* CAR OF NODE *)
                  RIGHT: SPTR
            ); (* CDR OF NODE *)
            ATOM: (
                  PLIST: SPTR; (* Plist of atom*)
                  LConst: SPTR; (* value of the atom *)
                  PName: SPTR; (* holds list of print name*)
                  FunVal: SPTR  (* holds pointer to functional value if any *)
            );
            FULLWORD: (
                  NAME: Pstring {This used to be a string}
            );
            NUMTYPE: (
                  VAL: INTEGER
            );
      end;(*NODE*)

The storage class
StorageArray = array[1..maxmem] of NODE;
   MemoryPtr = ^MemoryBlock;
   MemoryBlock = record
         Block: StorageArray;
         Next: MemoryPtr
      end;


Initialize the memory block and the FreeList
procedure MemInitialize;
var
   i: integer;
begin
   LispFree := 1;
   LispFreeList := nil;
   LispLastFree := nil;
   new(FirstBlock);
   CurrentBlock := FirstBlock;
   CurrentBlock^.Next := nil;
   NumberFree := MaxMem
end; (* MemInitialize *)


Mark all of the nodes in use.

procedure PlistCheck (p: SPTR);
   begin (* PlistCheck*)
      if (p <> nil) then
         if (p^.CLASS = LIST) or (p^.class = dot) then
            begin
               p^.CLASS := ACTIVE;
               PlistCheck(p^.LEFT);
               PlistCheck(p^.RIGHT)
            end
   end;(* PlistCheck *)


procedure Sweep;
      var
         I: integer;
         Temp: SPTR;
   begin (* Sweep*)
      for I := 0 to ONELESS do
         begin
            Temp := OBLIST[I];
            while Temp <> nil do
               begin
                  Temp^.CLASS := ACTIVE;
                  PlistCheck(Temp^.LEFT^.PLIST);
                  PlistCheck(Temp^.Left^.LConst);
                  PlistCheck(Temp^.Left^.FunVal);
                  {install if names become lists }
                  {PlistCheck(Temp^.Left^.PName);
                  Temp := Temp^.Right
               end
         end;
      PlistCheck(TRLIST);
   end; (* Sweep *)

Once all of the global nodes are marked active, Collect the rest into a linked list.
procedure Garbage;
   begin
      Sweep;
      Gather;
   end;(* Garbage *)



procedure CollectBlock (var B: StorageArray; BlockSize: Integer);
var
   i: integer;
begin (* CollectBlock*)
   for i := 1 to BlockSize do
      begin
         if B[i].class = Active then
            B[i].class := List
         else
            begin
               if LispFreeList = nil then
                  LispFreeList := @B[i]
               else
                  LispLastFree^.Right := @B[i];
               LispLastFree := @B[i];
               Inc(NumberFree)
            end
      end;
   LispLastFree^.Right := nil
end;(*CollectBlock *)

procedure Gather;
   var
      GatherBlock: MemoryPtr;
   begin (* Gather *)
      LispFreeList := nil;
      LispLastFree := nil;
      NumberFree := 0;
      GatherBlock := FirstBlock;
      while GatherBlock <> CurrentBlock do
         begin
            CollectBlock(GatherBlock^.Block, MaxMem);
            GatherBlock := GatherBlock^.Next
         end;
      CollectBlock(CurrentBlock^.Block, (LispFree - 1));
      NumberFree := NumberFree + (MaxMem - LispFree);
      if NumberFree < 2 * TooFewNodes then
         NewBlock
   end;(* Gather *)