Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!usc!aero-c!jordan
From: jordan@aero.org (Larry M. Jordan)
Newsgroups: comp.lang.c++
Subject: Re: Implementing LISP in C++ (type discrimination)
Message-ID: <1991Mar19.205406.17684@aero.org>
Date: 19 Mar 91 20:54:06 GMT
References: <1991Mar13.145107.19724@linus.mitre.org> <1991Mar13.214542.13779@aero.org> <27E181D5.72D5@tct.uucp>
Sender: news@aero.org
Organization: The Aerospace Corporation, El Segundo, CA
Lines: 190

I'm implementing a simple LISP interpreter in C++...

I've succeeded in implementing a marking routine (for a mark and sweep
garbage collector) WITOUT type discrimination!

I'll present type-discrimating version first (which is implemented in Ada)
and follow with the C++ version.

--Ada

  type NodeKind is (Free, Cons, Fixnum, ...);
  type MarkSet is (Unmarked, Marked, MarkLeft);

  type NodePtr is access Node;
  type Node(kind: NodeKind) is
    record
      mark: MarkSet;
      case kind is
	when Free => null;
	when Cons => car, cdr: NodePtr;
	when Fixnum => fix: FixnumType;
	...
      end case;
    end record;
 
Here's the mark function, a tricky non-recursive, routine for marking
all active structures (alg. thanks to David Betz):

  procedure mark(p: NodePtr) is
    current: NodePtr := p;
    previous: NodePtr := null;
  begin
    --mark this node

    loop
	--descend as far as we can

	while not current.mark = Marked loop

	    --mark this node and trace its children
	    case current.kind is
	      when Cons =>
		current.mark := Marked;
		if car(current) /= null then
		  declare
		    down: NodePtr := car(current);
		  begin
		    current.mark := MarkLeft;
		    rplaca(current, previous);
		    previous = current;
		    current = down;
		  end;
		elsif cdr(current) /= null then
		  declare
		    down: NodePtr := car(current);
		  begin
		    rplacd(current, previous);
		    previous = current;
		    current = down;
		  end;
		end if;

	      -- mark other nodes that require tracing
	      when ...
	    
	      -- mark objects that don't contain pointers
	      when Fixnu =>
		current.mark := Marked;
	      when ...
	    end case;

        end loop;


	--backup to a point where we can continue descending
	loop

	    --make sure there is a previous node
	    if previous /= null then
	       if previous.mark = MarkLeft then  --came from left side
		 previous.mark := Marked;
		 declare
		   up: NodePtr := car(previous);
		 begin
		   rplaca(previous, current);
		   if cdr(previous) /= null then
		     rplacd(previous,  up);
		     exit;
		   else			
		     current := cdr(previous); 	--step back up the branch
		     previous := up;
		   end if;
		 end
	       else				--came from right side
		 declare
		   up: NodePtr := cdr(previous);
		 begin
		   rplacd(previous, current);
		   current := previous; 	--step back up the branch
		   previous := up;
		 end;
	       end if;
	    else
	      -- no previous node, must be done
		return;
    	    end if;
	 end loop;

    end loop;

end mark;


Granted this is tricky to follow and the logic of what is really
happening here is hard to follow.  Worse, every time I add a new kind of
object to the LISP system, say Symbols or Environments, I must
change this marking procedure (not to mention the many other places where
case analysis is going on).  

Here's the not-type-descriminating version implemented in C++!
I've made Node a base class and derive all Node kinds from this class.  
The mark routine is implemented entirely abstractly in terms of Nodes 
and the case anaysis is replaced with dynamic binding--virtual method calls.  

class Node;

typedef boolean int;
enum { FALSE, TRUE };

struct MarkState {
  Node *current;
  Node *previous;
};

class Node {
  enum MarkSet { Unmarked, Marked, MarkLeft };
  
  virtual boolean descend(MarkState &m) = 0;	--implementation deferred
  virtual boolean ascend(MarkState &m) = 0;	--implementation deferred
}


void mark(Node *p)
{
   MarkState m;
   m.previous = NIL;
   m.current = p;

   while (1) {

     while (m.current->descend(m))
       ;
     while (1) {
       if (m.previous == NIL)
	  return;
       if (!m.previous->ascend(m))
	  break;
     }
   }
}

// that's it!

class Cons : Node {

  ...
  virtual boolean descend(MarkState &m)
  {
    // mark and save back pointers
    // return TRUE if still descending else return FALSE
  }

  virtual boolean ascend(MarkState &m)
  {
    // ascend (restoring pointers) to a point where descending can continue
    //    and return TRUE
    // else return FALSE if cannot ascend
  }
}



Chip Salzenburg raised an interesting point: 'switch() is a table
lookup'.  Has anyone done a study to see just how much storage is
used in switch() jump tables for a large non-OOP implementation vs. an
OOP implementation?  I'm less concern about the storage occupied by vft's
than I earlier--I'd rather pay the price for the dispatch table once
(in the class) than many times (at each switch()!?).

--Larry