[project @ 2000-04-27 16:35:29 by sewardj]

A total rewrite of the BCO assembler/linker, and rationalisation of
the code management and code generation phases of Hugs.

Problems with the old linker:

* Didn't have a clean way to insert a pointer to GHC code into a BCO.
  This meant CAF GC didn't work properly in combined mode.

* Leaked memory.  Each BCO, caf and constructor generated by Hugs had
  a corresponding malloc'd record used in its construction.  These
  records existed forever.  Pointers from the Hugs symbol tables into
  the runtime heap always went via these intermediates, for no apparent
  reason.

* A global variable holding a list of top-level stg trees was used
  during code generation.  It was hard to associate trees in this
  list with entries in the name/tycon tables.  Just too many
  mechanisms.

The New World Order is as follows:

* The global code list (stgGlobals) is gone.

* Each name in the name table has a .closure field.  This points
  to the top-level code for that name.  Before bytecode generation
  this points to a STG tree.  During bytecode generation but before
  bytecode linking it is a MPtr pointing to a malloc'd intermediate
  structure (an AsmObject).  After linking, it is a real live pointer
  into the execution heap (CPtr) which is treated as a root during GC.

  Because tuples do not have name table entries, tycons which are
  tuples also have a .closure field, which is treated identically
  to those of name table entries.

* Each module has a code list -- a list of names and tuples.  If you
  are a name or tuple and you have something (code, CAF or Con) which
  needs to wind up in the execution heap, you MUST be on your module's
  code list.  Otherwise you won't get code generated.

* Lambda lifting generates new name table entries, which of course
  also wind up on the code list.

* The initial phase of code generation for a module m traverses m's
  code list.  The stg trees referenced in the .closure fields are
  code generated, creating AsmObject (AsmBCO, AsmCAF, AsmCon) in
  mallocville.  The .closure fields then point to these AsmObjects.
  Since AsmObjects can be mutually recursive, they can contain
  references to:
     * Other AsmObjects            Asm_RefObject
     * Existing closures           Asm_RefNoOp
     * name/tycon table entries    Asm_RefHugs
  AsmObjects can also contain BCO insns and non-ptr words.

* A second copy-and-link phase copies the AsmObjects into the
  execution heap, resolves the Asm_Ref* items, and frees up
  the malloc'd entities.

* Minor cleanups in compile-time storage.  There are now 3 kinds of
  address-y things available:
     CPtr/mkCPtr/cptrOf    -- ptrs to Closures, probably in exec heap
                              ie anything which the exec GC knows about
     MPtr/mkMPtr/mptrOf    -- ptrs to mallocville, which the exec GC
                              knows nothing about
     Addr/mkAddr/addrOf    -- literal addresses (like literal ints)

* Many hacky cases removed from codegen.c.  Referencing code or
  data during code generation is a lot simpler, since an entity
  is either:
      a CPtr, in which case use it as is
      a MPtr -- stuff it into the AsmObject and the linker will fix it
      a name or tycon
             -- ditto

* I've checked, using Purify that, at least in standalone mode,
  no longer leaks mallocd memory.  Prior to this it would leak at
  the rate of about 300k per Prelude.

* Added this comment to the top of codegen.c.

Still to do:

* Reinstate peephole optimisation for BCOs.

* Nuke magic number headers in AsmObjects, used for debugging.

* Profile and accelerate.  Code generation is slower because linking
  is slower.  Evaluation GC is slower because markHugsObjects has
  slowed down.

* Make setCurrentModule ignore name table entries created by the
  lambda-lifter.

* Zap various #if 0's in codegen.c/Assembler.c.

* Zap CRUDE_PROFILING.

1 files changed, 357 insertions, 219 deletions

diff --git a/ghc/interpreter/codegen.c b/ghc/interpreter/codegen.c
index ef12398390..31a09a8046 100644
--- a/ghc/interpreter/codegen.c
+++ b/ghc/interpreter/codegen.c
@@ -9,8 +9,8 @@
  * included in the distribution.
  *
  * $RCSfile: codegen.c,v $
- * $Revision: 1.22 $
- * $Date: 2000/04/12 09:37:19 $
+ * $Revision: 1.23 $
+ * $Date: 2000/04/27 16:35:29 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -18,36 +18,133 @@
 #include "connect.h"
 #include "errors.h"
 
+#include "Rts.h"       /* to make StgPtr visible in Assembler.h */
 #include "Assembler.h"
-#include "Rts.h"    /* IF_DEBUG */
 #include "RtsFlags.h"
 
 /*#define DEBUG_CODEGEN*/
 
+/*  (JRS, 27 Apr 2000):
+
+A total rewrite of the BCO assembler/linker, and rationalisation of
+the code management and code generation phases of Hugs.
+
+Problems with the old linker:
+
+* Didn't have a clean way to insert a pointer to GHC code into a BCO.
+  This meant CAF GC didn't work properly in combined mode.
+
+* Leaked memory.  Each BCO, caf and constructor generated by Hugs had
+  a corresponding malloc'd record used in its construction.  These
+  records existed forever.  Pointers from the Hugs symbol tables into
+  the runtime heap always went via these intermediates, for no apparent
+  reason.
+
+* A global variable holding a list of top-level stg trees was used
+  during code generation.  It was hard to associate trees in this
+  list with entries in the name/tycon tables.  Just too many
+  mechanisms.
+
+The New World Order is as follows:
+
+* The global code list (stgGlobals) is gone.
+
+* Each name in the name table has a .closure field.  This points
+  to the top-level code for that name.  Before bytecode generation
+  this points to a STG tree.  During bytecode generation but before
+  bytecode linking it is a MPtr pointing to a malloc'd intermediate
+  structure (an AsmObject).  After linking, it is a real live pointer
+  into the execution heap (CPtr) which is treated as a root during GC.
+
+  Because tuples do not have name table entries, tycons which are
+  tuples also have a .closure field, which is treated identically
+  to those of name table entries.
+
+* Each module has a code list -- a list of names and tuples.  If you
+  are a name or tuple and you have something (code, CAF or Con) which
+  needs to wind up in the execution heap, you MUST be on your module's
+  code list.  Otherwise you won't get code generated.
+
+* Lambda lifting generates new name table entries, which of course
+  also wind up on the code list.
+
+* The initial phase of code generation for a module m traverses m's
+  code list.  The stg trees referenced in the .closure fields are
+  code generated, creating AsmObject (AsmBCO, AsmCAF, AsmCon) in
+  mallocville.  The .closure fields then point to these AsmObjects.
+  Since AsmObjects can be mutually recursive, they can contain
+  references to:
+     * Other AsmObjects            Asm_RefObject
+     * Existing closures           Asm_RefNoOp
+     * name/tycon table entries    Asm_RefHugs
+  AsmObjects can also contain BCO insns and non-ptr words.
+
+* A second copy-and-link phase copies the AsmObjects into the
+  execution heap, resolves the Asm_Ref* items, and frees up
+  the malloc'd entities.
+
+* Minor cleanups in compile-time storage.  There are now 3 kinds of
+  address-y things available:
+     CPtr/mkCPtr/cptrOf    -- ptrs to Closures, probably in exec heap
+                              ie anything which the exec GC knows about
+     MPtr/mkMPtr/mptrOf    -- ptrs to mallocville, which the exec GC
+                              knows nothing about
+     Addr/mkAddr/addrOf    -- literal addresses (like literal ints)
+
+* Many hacky cases removed from codegen.c.  Referencing code or
+  data during code generation is a lot simpler, since an entity
+  is either:
+      a CPtr, in which case use it as is
+      a MPtr -- stuff it into the AsmObject and the linker will fix it
+      a name or tycon
+             -- ditto
+
+* I've checked, using Purify that, at least in standalone mode,
+  no longer leaks mallocd memory.  Prior to this it would leak at
+  the rate of about 300k per Prelude.
+
+Still to do:
+
+* Reinstate peephole optimisation for BCOs.
+
+* Nuke magic number headers in AsmObjects, used for debugging.
+
+* Profile and accelerate.  Code generation is slower because linking
+  is slower.  Evaluation GC is slower because markHugsObjects has
+  sloweed down.
+
+* Make setCurrentModule ignore name table entries created by the
+  lambda-lifter.
+
+* Zap various #if 0 in codegen.c/Assembler.c.
+
+* Zap CRUDE_PROFILING.
+*/
+
+
 /* --------------------------------------------------------------------------
  * Local function prototypes:
  * ------------------------------------------------------------------------*/
 
 #define getPos(v)     intOf(stgVarInfo(v))
 #define setPos(v,sp)  stgVarInfo(v) = mkInt(sp)
-#define getObj(v)     ptrOf(stgVarInfo(v))
-#define setObj(v,obj) stgVarInfo(v) = mkPtr(obj)
+#define getObj(v)     mptrOf(stgVarInfo(v))
+#define setObj(v,obj) stgVarInfo(v) = mkMPtr(obj)
 
 #define repOf(x)      charOf(stgVarRep(x))
 
-static void  cgBind        ( AsmBCO bco, StgVar v );
-static Void  pushVar       ( AsmBCO bco, StgVar v );
-static Void  pushAtom      ( AsmBCO bco, StgAtom atom );
-static Void  alloc         ( AsmBCO bco, StgRhs rhs );
-static Void  build         ( AsmBCO bco, StgRhs rhs );
-static Void  cgExpr        ( AsmBCO bco, AsmSp root, StgExpr e );
+static void      cgBind       ( AsmBCO bco, StgVar v );
+static Void      pushAtom     ( AsmBCO bco, StgAtom atom );
+static Void      alloc        ( AsmBCO bco, StgRhs rhs );
+static Void      build        ( AsmBCO bco, StgRhs rhs );
+static Void      cgExpr       ( AsmBCO bco, AsmSp root, StgExpr e );
              
-static AsmBCO cgAlts       ( AsmSp root, AsmSp sp, List alts );
-static void   testPrimPats ( AsmBCO bco, AsmSp root, List pats, StgExpr e );
-static AsmBCO cgLambda     ( StgExpr e );
-static AsmBCO cgRhs        ( StgRhs rhs );
-static void   beginTop     ( StgVar v );
-static void   endTop       ( StgVar v );
+static AsmBCO    cgAlts       ( AsmSp root, AsmSp sp, List alts );
+static void      testPrimPats ( AsmBCO bco, AsmSp root, List pats, StgExpr e );
+static AsmBCO    cgLambda     ( StgExpr e );
+static AsmBCO    cgRhs        ( StgRhs rhs );
+static void      beginTop     ( StgVar v );
+static AsmObject endTop       ( StgVar v );
 
 static StgVar currentTop;
 
@@ -55,7 +152,7 @@ static StgVar currentTop;
  * 
  * ------------------------------------------------------------------------*/
 
-static Cell cptrFromName ( Name n )
+static void* /* StgClosure*/ cptrFromName ( Name n )
 {
    char  buf[1000];
    void* p;
@@ -70,18 +167,7 @@ static Cell cptrFromName ( Name n )
       ERRMSG(0) "Can't find object symbol %s", buf
       EEND;
    }
-   return mkCPtr(p);
-}
-
-static Bool varHasClosure( StgVar v )
-{
-    return asmObjectHasClosure((AsmClosure*)ptrOf(stgVarInfo(v)));
-}
-
-/* should be AsmClosure* */
-void* closureOfVar( StgVar v )
-{
-    return asmClosureOfObject((AsmClosure*)ptrOf(stgVarInfo(v)));
+   return p;
 }
 
 char* lookupHugsName( void* closure )
@@ -91,15 +177,11 @@ char* lookupHugsName( void* closure )
     for( nm = NAME_BASE_ADDR; 
          nm < NAME_BASE_ADDR+tabNameSz; ++nm ) 
        if (tabName[nm-NAME_BASE_ADDR].inUse) {
-           StgVar v  = name(nm).stgVar;
-           if (isStgVar(v) 
-               && isPtr(stgVarInfo(v)) 
-               && varHasClosure(v)
-               && closureOfVar(v) == closure) {
+           Cell cl = name(nm).closure;
+           if (isCPtr(cl) && cptrOf(cl) == closure)
                return textToStr(name(nm).text);
-           }
     }
-    return 0;
+    return NULL;
 }
 
 static void cgBindRep( AsmBCO bco, StgVar v, AsmRep rep )
@@ -112,77 +194,119 @@ static void cgBind( AsmBCO bco, StgVar v )
     cgBindRep(bco,v,repOf(v));
 }
 
-static Void pushVar( AsmBCO bco, StgVar v )
+static void cgAddPtrToObject ( AsmObject obj, Cell ptrish )
 {
-    Cell info;
-#if 0
-printf ( "pushVar:  %d  ", v ); fflush(stdout);
-print(v,10);printf("\n");
-#endif
-    assert(isStgVar(v) || isCPtr(v));
-
-    if (isCPtr(v)) {
-       asmGHCClosure(bco, cptrOf(v));
-    } else {
-       info = stgVarInfo(v);
-       if (isPtr(info)) {
-           asmClosure(bco,ptrOf(info));
-       } else if (isInt(info)) {
-           asmVar(bco,intOf(info),repOf(v));
-       } else {
-           internal("pushVar");
-       }        
-    }
+   switch (whatIs(ptrish)) {
+      case CPTRCELL:
+         asmAddRefNoOp ( obj, (StgPtr)cptrOf(ptrish) ); break;
+      case MPTRCELL:
+         asmAddRefObject ( obj, mptrOf(ptrish) ); break;
+      default:
+         internal("cgAddPtrToObject");
+   }
 }
 
-static Void pushAtom( AsmBCO bco, StgAtom e )
-{
 #if 0
-printf ( "pushAtom: %d  ", e ); fflush(stdout);
-print(e,10);printf("\n");
+static void cgPushRef ( AsmBCO bco, Cell c )
+{
+   switch (whatIs(c)) {
+      case CPTRCELL:
+         asmPushRefNoOp(bco,(StgPtr)cptrOf(c)); break;
+      case PTRCELL:
+         asmPushRefObject(bco,ptrOf(c)); break;
+      case NAME:
+      case TUPLE:
+         asmPushRefHugs(bco,c); break;
+      default:
+         internal("cgPushRef");
+   }
+}
 #endif
+
+/* Get a pointer to atom e onto the stack. */
+static Void pushAtom ( AsmBCO bco, StgAtom e )
+{
+    Cell info;
+    Cell cl;
+#   if 0
+    printf ( "pushAtom: %d  ", e ); fflush(stdout);
+    print(e,10);printf("\n");
+#   endif
     switch (whatIs(e)) {
-    case STGVAR: 
-            pushVar(bco,e);
-            break;
-    case NAME: 
-            if (nonNull(name(e).stgVar)) {
-	       pushVar(bco,name(e).stgVar);
-            } else {
-               Cell /*CPtr*/ addr = cptrFromName(e);
+       case STGVAR:
+           info = stgVarInfo(e);
+           if (isInt(info)) {
+              asmVar(bco,intOf(info),repOf(e));
+           }
+           else
+           if (isCPtr(info)) { 
+              asmPushRefNoOp(bco,cptrOf(info));
+           }
+           else
+           if (isMPtr(info)) { 
+              asmPushRefObject(bco,mptrOf(info));
+           }
+           else {
+              internal("pushAtom: STGVAR");
+           }
+           break;
+       case NAME:
+       case TUPLE:
+            cl = getNameOrTupleClosure(e);
+            if (isStgVar(cl)) {
+               /* a stg tree which hasn't yet been translated */
+               asmPushRefHugs(bco,e);
+            }
+            else
+            if (isCPtr(cl)) {
+               /* a pointer to something in the heap */
+               asmPushRefNoOp(bco,(StgPtr)cptrOf(cl));
+            } 
+            else
+            if (isMPtr(cl)) {
+               /* a pointer to an AsmBCO/AsmCAF/AsmCon object */
+               asmPushRefObject(bco,mptrOf(cl));
+            }
+            else {
+               StgClosure* addr; 
+               ASSERT(isNull(cl));
+               addr = cptrFromName(e);
 #              if DEBUG_CODEGEN
                fprintf ( stderr, "nativeAtom: name %s\n", 
-                                 nameFromOPtr(cptrOf(addr)) );
+                                 nameFromOPtr(addr) );
 #              endif
-	       pushVar(bco,addr);
+	       asmPushRefNoOp(bco,(StgPtr)addr);
             }
             break;
-    case CHARCELL: 
+       case CHARCELL: 
             asmConstChar(bco,charOf(e));
             break;
-    case INTCELL: 
+       case INTCELL: 
             asmConstInt(bco,intOf(e));
             break;
-    case BIGCELL:
+       case ADDRCELL: 
+            asmConstAddr(bco,addrOf(e));
+            break;
+       case BIGCELL:
             asmConstInteger(bco,bignumToString(e)); 
             break;
-    case FLOATCELL: 
+       case FLOATCELL: 
             asmConstDouble(bco,floatOf(e));
             break;
-    case STRCELL: 
-#if USE_ADDR_FOR_STRINGS
+       case STRCELL: 
+#           if USE_ADDR_FOR_STRINGS
             asmConstAddr(bco,textToStr(textOf(e)));
-#else
+#           else
             asmClosure(bco,asmStringObj(textToStr(textOf(e))));
-#endif
+#           endif
             break;
-    case CPTRCELL:
-            asmGHCClosure(bco,cptrOf(e));
+       case CPTRCELL:
+            asmPushRefNoOp(bco,cptrOf(e));
             break;
-    case PTRCELL: 
-            asmConstAddr(bco,ptrOf(e));
+       case MPTRCELL: 
+            asmPushRefObject(bco,mptrOf(e));
             break;
-    default: 
+       default: 
             fprintf(stderr,"\nYoiks1: "); printExp(stderr,e);
             internal("pushAtom");
     }
@@ -324,7 +448,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e )
     case LAMBDA:
         {
             AsmSp begin = asmBeginEnter(bco);
-            asmClosure(bco,cgLambda(e));
+            asmPushRefObject(bco,cgLambda(e));
             asmEndEnter(bco,begin,root);
             break;
         }
@@ -366,7 +490,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e )
 
                 /* only part different from primop code... todo */
                 AsmSp beginCase = asmBeginCase(bco);
-                pushVar(bco,scrut);
+                pushAtom /*pushVar*/ (bco,scrut);
                 asmEndAlt(bco,beginCase); /* hack, hack -  */
 
                 for(; nonNull(alts); alts=tl(alts)) {
@@ -398,6 +522,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e )
             asmEndEnter(bco,env,root);
             break;
         }
+    case TUPLE:
     case NAME: /* Tail call (with no args) */
         {
             AsmSp env = asmBeginEnter(bco);
@@ -413,7 +538,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e )
             case BETA_REP:
                 {
                     AsmSp env = asmBeginEnter(bco);
-                    pushVar(bco,e);
+                    pushAtom /*pushVar*/ (bco,e);
                     asmEndEnter(bco,env,root);
                     break;
                 }
@@ -510,11 +635,26 @@ static Void build( AsmBCO bco, StgVar v )
         {
             Bool   itsaPAP;
             StgVar fun  = stgAppFun(rhs);
-            StgVar fun0 = fun;
             List   args = stgAppArgs(rhs);
+
+            if (isName(fun)) {
+               itsaPAP = name(fun).arity > length(args);
+            } else
+            if (isStgVar(fun)) {
+               itsaPAP = FALSE;
+               if (nonNull(stgVarBody(fun))
+                   && whatIs(stgVarBody(fun)) == LAMBDA 
+                   && length(stgLambdaArgs(stgVarBody(fun))) > length(args)
+                  )
+                  itsaPAP = TRUE;
+            }
+            else
+               internal("build: STGAPP");
+#if 0
+Looks like a hack to me.
             if (isName(fun)) {
-                if (nonNull(name(fun).stgVar))
-                   fun = name(fun).stgVar; else
+                if (nonNull(name(fun).closure))
+                   fun = name(fun).closure; else
                    fun = cptrFromName(fun);
             }
 
@@ -534,6 +674,7 @@ static Void build( AsmBCO bco, StgVar v )
                   )
                   itsaPAP = TRUE;
             }
+#endif
 
             if (itsaPAP) {
                 AsmSp  start = asmBeginMkPAP(bco);
@@ -561,10 +702,6 @@ static Void build( AsmBCO bco, StgVar v )
      * of this except "let x = x in ..."
      */
     case NAME:
-        if (nonNull(name(rhs).stgVar))
-           rhs = name(rhs).stgVar; else
-           rhs = cptrFromName(rhs);
-        /* fall thru */
     case STGVAR:
         {
             AsmSp  start = asmBeginMkAP(bco);
@@ -575,7 +712,7 @@ static Void build( AsmBCO bco, StgVar v )
     default:
         {
             AsmSp start = asmBeginMkAP(bco);   /* make it updateable! */
-            asmClosure(bco,cgRhs(rhs));
+            asmPushRefObject(bco,cgRhs(rhs));
             asmEndMkAP(bco,getPos(v),start);
             return;
         }
@@ -589,18 +726,6 @@ static Void build( AsmBCO bco, StgVar v )
  * for each top level variable - this should be simpler!
  * ------------------------------------------------------------------------*/
 
-#if 0   /* appears to be unused */
-static void cgAddVar( AsmObject obj, StgAtom v )
-{
-    if (isName(v)) {
-        v = name(v).stgVar;
-    }
-    assert(isStgVar(v));
-    asmAddPtr(obj,getObj(v));
-}
-#endif
-
-
 /* allocate AsmObject for top level variables
  * any change requires a corresponding change in endTop
  */
@@ -611,146 +736,159 @@ static void beginTop( StgVar v )
     currentTop = v;
     rhs = stgVarBody(v);
     switch (whatIs(rhs)) {
-    case STGCON:
-        {
-	    //List as = stgConArgs(rhs);
-            setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs))));
-            break;
-        }
-    case LAMBDA:
-#ifdef CRUDE_PROFILING
-            setObj(v,asmBeginBCO(currentTop));
-#else
-            setObj(v,asmBeginBCO(rhs));
-#endif
-            break;
-    default:
-            setObj(v,asmBeginCAF());
-            break;
+       case STGCON:
+          setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs))));
+          break;
+       case LAMBDA:
+#         ifdef CRUDE_PROFILING
+          setObj(v,asmBeginBCO(currentTop));
+#         else
+          setObj(v,asmBeginBCO(rhs));
+#         endif
+          break;
+       default:
+          setObj(v,asmBeginCAF());
+          break;
     }
 }
 
-static void endTop( StgVar v )
+static AsmObject endTop( StgVar v )
 {
     StgRhs rhs = stgVarBody(v);
     currentTop = v;
     switch (whatIs(rhs)) {
-    case STGCON:
-        {
-            List as = stgConArgs(rhs);
-            AsmCon con = (AsmCon)getObj(v);
-            for( ; nonNull(as); as=tl(as)) {
-                StgAtom a = hd(as);
-                switch (whatIs(a)) {
+       case STGCON: {
+          List as = stgConArgs(rhs);
+          AsmCon con = (AsmCon)getObj(v);
+          for ( ; nonNull(as); as=tl(as)) {
+             StgAtom a = hd(as);
+             switch (whatIs(a)) {
                 case STGVAR: 
-                        /* should be a delayed combinator! */
-                        asmAddPtr(con,(AsmObject)getObj(a));
-                        break;
-                case NAME: 
-                    {
-                        StgVar var = name(a).stgVar;
-                        assert(var);
-                        asmAddPtr(con,(AsmObject)getObj(a));
-                        break;
-                    }
-#if !USE_ADDR_FOR_STRINGS
+                   /* should be a delayed combinator! */
+                   asmAddRefObject(con,(AsmObject)getObj(a));
+                   break;
+                case NAME: {
+                   StgVar var = name(a).closure;
+                   cgAddPtrToObject(con,var);
+                   break;
+                }
+#               if !USE_ADDR_FOR_STRINGS
                 case STRCELL:
-                        asmAddPtr(con,asmStringObj(textToStr(textOf(a))));
-                        break;
-#endif
+                   asmAddPtr(con,asmStringObj(textToStr(textOf(a))));
+                   break;
+#               endif
                 default: 
-                        /* asmAddPtr(con,??); */
-                        assert(0);
-                        break;
-                }
-            }
-            asmEndCon(con);
-            break;
-        }
-    case LAMBDA: /* optimisation */
-        {
-            /* ToDo: merge this code with cgLambda */
-            AsmBCO bco = (AsmBCO)getObj(v);
-            AsmSp root = asmBeginArgCheck(bco);
-            map1Proc(cgBind,bco,reverse(stgLambdaArgs(rhs)));
-            asmEndArgCheck(bco,root);
-            
-            cgExpr(bco,root,stgLambdaBody(rhs));
+                   /* asmAddPtr(con,??); */
+                   assert(0);
+                   break;
+             }
+          }
+          asmEndCon(con);
+          return con;
+       }
+       case LAMBDA: { /* optimisation */
+          /* ToDo: merge this code with cgLambda */
+          AsmBCO bco = (AsmBCO)getObj(v);
+          AsmSp root = asmBeginArgCheck(bco);
+          map1Proc(cgBind,bco,reverse(stgLambdaArgs(rhs)));
+          asmEndArgCheck(bco,root);
             
-            asmEndBCO(bco);
-            break;
-        }
-    default:   /* updateable caf */
-        {
-            AsmCAF caf = (AsmCAF)getObj(v);
-            asmEndCAF(caf,cgRhs(rhs));
-            break;
-        }
+          cgExpr(bco,root,stgLambdaBody(rhs));
+         
+          asmEndBCO(bco);
+          return bco;
+       }
+       default: {  /* updateable caf */
+          AsmCAF caf = (AsmCAF)getObj(v);
+          asmAddRefObject ( caf, cgRhs(rhs) );
+          asmEndCAF(caf);
+          return caf;
+       }
     }
 }
 
-static void zap( StgVar v )
-{
-  // ToDo: reinstate
-  //    stgVarBody(v) = NIL;
-}
 
-/* external entry point */
-Void cgBinds( List binds )
+/* --------------------------------------------------------------------------
+ * The external entry points for the code generator.
+ * ------------------------------------------------------------------------*/
+
+Void cgModule ( Module mod )
 {
-    List b;
+    List cl;
+    Cell c;
     int i;
 
-#if 0
-    if (lastModule() != modulePrelude) {
-        printf("\n\ncgBinds: before ll\n\n" );
-        for (b=binds; nonNull(b); b=tl(b)) {
-           printStg ( stdout, hd(b) ); printf("\n\n");
-        }
+    /* Lambda-lift, by traversing the code list of this module.  
+       This creates more name-table entries, which are duly added
+       to the module's code list.
+    */
+    liftModule ( mod );
+
+    /* Initialise the BCO linker subsystem. */
+    asmInitialise();
+
+    /* Generate BCOs, CAFs and Constructors into mallocville.  
+       At this point, the .closure values of the names/tycons on
+       the codelist contain StgVars, ie trees.  The call to beginTop
+       converts them to MPtrs to AsmObjects.
+    */
+    for (cl=module(mod).codeList; nonNull(cl); cl=tl(cl)) {
+       c = getNameOrTupleClosure(hd(cl));
+       if (isCPtr(c)) continue;
+#      if 0
+       if (isName(hd(cl))) {
+          printStg( stdout, name(hd(cl)).closure ); printf( "\n\n"); 
+       }
+#      endif
+       beginTop ( c );
     }
-#endif
-
-    binds = liftBinds(binds);
 
-#if 0
-    if (lastModule() != modulePrelude) {
-        printf("\n\ncgBinds: after ll\n\n" );
-        for (b=binds; nonNull(b); b=tl(b)) {
-           printStg ( stdout, hd(b) ); printf("\n\n");
-        }
+    for (cl=module(mod).codeList; nonNull(cl); cl=tl(cl)) {
+       c = getNameOrTupleClosure(hd(cl));
+       if (isCPtr(c)) continue;
+#      if 0
+       if (isName(hd(cl))) {
+          printStg( stdout, name(hd(cl)).closure ); printf( "\n\n"); 
+       }
+#      endif
+       setNameOrTupleClosure ( hd(cl), mkMPtr(endTop(c)) );
     }
-#endif
 
-    for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
-       /* printStg( stdout, hd(b) ); printf( "\n\n"); */
-       beginTop(hd(b));
+    //fprintf ( stderr, "\nstarting sanity check\n" );
+    for (cl = module(mod).codeList; nonNull(cl); cl=tl(cl)) {
+       Cell c = hd(cl);
+       ASSERT(isName(c) || isTuple(c));
+       c = getNameOrTupleClosure(c);
+       ASSERT(isMPtr(c) || isCPtr(c));
     }
-
-    for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
-       /* printStg( stdout, hd(b) ); printf( "\n\n"); */
-       endTop(hd(b));
+    //fprintf ( stderr, "completed sanity check\n" );
+
+
+    /* Figure out how big each object will be in the evaluator's heap,
+       and allocate space to put each in, but don't copy yet.  Record
+       the heap address in the object.  Assumes that GC doesn't happen;
+       reasonable since we use allocate().
+    */
+    asmAllocateHeapSpace();
+
+    /* Update name/tycon table closure entries with these new heap addrs. */
+    for (cl = module(mod).codeList; nonNull(cl); cl=tl(cl)) {
+       c = getNameOrTupleClosure(hd(cl));
+       if (isMPtr(c))
+          setNameOrTupleClosureCPtr ( 
+             hd(cl), asmGetClosureOfObject(mptrOf(c)) );
     }
 
-    /* mapProc(zap,binds); */
-}
+    /* Copy out of mallocville into the heap, resolving references on
+       the way.
+    */
+    asmCopyAndLink();
 
-/* Called by the evaluator's GC to tell Hugs to mark stuff in the
-   run-time heap.
-*/
-void markHugsObjects( void )
-{
-    extern Name nameHw;
-    Name nm;
-    for ( nm = NAME_BASE_ADDR; 
-          nm < NAME_BASE_ADDR+tabNameSz; ++nm )
-       if (tabName[nm-NAME_BASE_ADDR].inUse) {
-           StgVar v  = name(nm).stgVar;
-           if (isStgVar(v) && isPtr(stgVarInfo(v))) {
-               asmMarkObject(ptrOf(stgVarInfo(v)));
-           }
-       }
+    /* Free up the malloc'd memory. */
+    asmShutdown();
 }
 
+
 /* --------------------------------------------------------------------------
  * Code Generator control:
  * ------------------------------------------------------------------------*/