ghc/interpreter/codegen.c

   1
   2 /* --------------------------------------------------------------------------
   3  * Code generator
   4  *
   5  * The Hugs 98 system is Copyright (c) Mark P Jones, Alastair Reid, the
   6  * Yale Haskell Group, and the Oregon Graduate Institute of Science and
   7  * Technology, 1994-1999, All rights reserved.  It is distributed as
   8  * free software under the license in the file "License", which is
   9  * included in the distribution.
  10  *
  11  * $RCSfile: codegen.c,v $
  12  * $Revision: 1.9 $
  13  * $Date: 1999/10/15 21:41:02 $
  14  * ------------------------------------------------------------------------*/
  15
  16 #include "prelude.h"
  17 #include "storage.h"
  18 #include "backend.h"
  19 #include "connect.h"
  20 #include "errors.h"
  21 #include "Assembler.h"
  22 #include "link.h"
  23
  24 #include "Rts.h"    /* IF_DEBUG */
  25 #include "RtsFlags.h"
  26
  27 /* --------------------------------------------------------------------------
  28  * Local function prototypes:
  29  * ------------------------------------------------------------------------*/
  30
  31 #define getPos(v)     intOf(stgVarInfo(v))
  32 #define setPos(v,sp)  stgVarInfo(v) = mkInt(sp)
  33 #define getObj(v)     ptrOf(stgVarInfo(v))
  34 #define setObj(v,obj) stgVarInfo(v) = mkPtr(obj)
  35
  36 #define repOf(x)      charOf(stgVarRep(x))
  37
  38 static void  cgBind        ( AsmBCO bco, StgVar v );
  39 static Void  pushVar       ( AsmBCO bco, StgVar v );
  40 static Void  pushAtom      ( AsmBCO bco, StgAtom atom );
  41 static Void  alloc         ( AsmBCO bco, StgRhs rhs );
  42 static Void  build         ( AsmBCO bco, StgRhs rhs );
  43 static Void  cgExpr        ( AsmBCO bco, AsmSp root, StgExpr e );
  44
  45 static AsmBCO cgAlts       ( AsmSp root, AsmSp sp, List alts );
  46 static void   testPrimPats ( AsmBCO bco, AsmSp root, List pats, StgExpr e );
  47 //static void   cgPrimAlt    ( AsmBCO bco, AsmSp root, List vs, StgExpr e );
  48 static AsmBCO cgLambda     ( StgExpr e );
  49 static AsmBCO cgRhs        ( StgRhs rhs );
  50 static void   beginTop     ( StgVar v );
  51 static void   endTop       ( StgVar v );
  52
  53 static StgVar currentTop;
  54
  55 /* --------------------------------------------------------------------------
  56  *
  57  * ------------------------------------------------------------------------*/
  58
  59 static Cell cptrFromName ( Name n )
  60 {
  61    char  buf[1000];
  62    void* p;
  63    Module m = name(n).mod;
  64    Text  mt = module(m).text;
  65    sprintf(buf,"%s_%s_closure",
  66                textToStr(mt), textToStr(name(n).text) );
  67    p = lookupOTabName ( m, buf );
  68    if (!p) {
  69       ERRMSG(0) "Can't find object symbol %s", buf
  70       EEND;
  71    }
  72    return mkCPtr(p);
  73 }
  74
  75 static Bool varHasClosure( StgVar v )
  76 {
  77     return asmObjectHasClosure((AsmClosure*)ptrOf(stgVarInfo(v)));
  78 }
  79
  80 /* should be AsmClosure* */
  81 void* closureOfVar( StgVar v )
  82 {
  83     return asmClosureOfObject((AsmClosure*)ptrOf(stgVarInfo(v)));
  84 }
  85
  86 char* lookupHugsName( void* closure )
  87 {
  88     extern Name nameHw;
  89     Name nm;
  90     for( nm=NAMEMIN; nm<nameHw; ++nm ) {
  91         StgVar v  = name(nm).stgVar;
  92         if (isStgVar(v)
  93             && isPtr(stgVarInfo(v))
  94             && varHasClosure(v)
  95             && closureOfVar(v) == closure) {
  96             return textToStr(name(nm).text);
  97         }
  98     }
  99     return 0;
 100 }
 101
 102 /* called at the start of GC */
 103 void markHugsObjects( void )
 104 {
 105     extern Name nameHw;
 106     Name nm;
 107     for( nm=NAMEMIN; nm<nameHw; ++nm ) {
 108         StgVar v  = name(nm).stgVar;
 109         if (isStgVar(v) && isPtr(stgVarInfo(v))) {
 110             asmMarkObject((AsmClosure*)ptrOf(stgVarInfo(v)));
 111         }
 112     }
 113 }
 114
 115 static void cgBindRep( AsmBCO bco, StgVar v, AsmRep rep )
 116 {
 117     setPos(v,asmBind(bco,rep));
 118 }
 119
 120 static void cgBind( AsmBCO bco, StgVar v )
 121 {
 122     cgBindRep(bco,v,repOf(v));
 123 }
 124
 125 static Void pushVar( AsmBCO bco, StgVar v )
 126 {
 127     Cell info;
 128
 129     if (!(isStgVar(v) || isCPtr(v))) {
 130     assert(isStgVar(v) || isCPtr(v));
 131     }
 132
 133     if (isCPtr(v)) {
 134        asmGHCClosure(bco, cptrOf(v));
 135     } else {
 136        info = stgVarInfo(v);
 137        if (isPtr(info)) {
 138            asmClosure(bco,ptrOf(info));
 139        } else if (isInt(info)) {
 140            asmVar(bco,intOf(info),repOf(v));
 141        } else {
 142            internal("pushVar");
 143        }
 144     }
 145 }
 146
 147 static Void pushAtom( AsmBCO bco, StgAtom e )
 148 {
 149     switch (whatIs(e)) {
 150     case STGVAR:
 151             pushVar(bco,e);
 152             break;
 153     case NAME:
 154             if (nonNull(name(e).stgVar))
 155                pushVar(bco,name(e).stgVar); else
 156                pushVar(bco,cptrFromName(e));
 157             break;
 158     case CHARCELL:
 159             asmConstChar(bco,charOf(e));
 160             break;
 161     case INTCELL:
 162             asmConstInt(bco,intOf(e));
 163             break;
 164     case BIGCELL:
 165             asmConstInteger(bco,bignumToString(e));
 166             break;
 167     case FLOATCELL:
 168 #if 0
 169             asmConstFloat(bco,e); /* ToDo: support both float and double! */
 170 #else
 171             asmConstDouble(bco,floatOf(e));
 172 #endif
 173             break;
 174 #if DOUBLES
 175     case DOUBLECELL:
 176             asmConstDouble(bco,doubleOf(e));
 177             break;
 178 #endif
 179     case STRCELL:
 180 #if USE_ADDR_FOR_STRINGS
 181             asmConstAddr(bco,textToStr(textOf(e)));
 182 #else
 183             asmClosure(bco,asmStringObj(textToStr(textOf(e))));
 184 #endif
 185             break;
 186     case CPTRCELL:
 187             asmGHCClosure(bco,cptrOf(e));
 188             break;
 189     case PTRCELL:
 190             asmConstAddr(bco,ptrOf(e));
 191             break;
 192     default:
 193             fprintf(stderr,"\nYoiks: "); printExp(stderr,e);
 194             internal("pushAtom");
 195     }
 196 }
 197
 198 static AsmBCO cgAlts( AsmSp root, AsmSp sp, List alts )
 199 {
 200 #ifdef CRUDE_PROFILING
 201     AsmBCO bco = asmBeginContinuation(sp, currentTop + 1000000000);
 202 #else
 203     AsmBCO bco = asmBeginContinuation(sp, alts);
 204 #endif
 205     /* ppStgAlts(alts); */
 206     for(; nonNull(alts); alts=tl(alts)) {
 207         StgCaseAlt alt  = hd(alts);
 208         if (isDefaultAlt(alt)) {
 209             cgBind(bco,stgDefaultVar(alt));
 210             cgExpr(bco,root,stgDefaultBody(alt));
 211             asmEndContinuation(bco);
 212             return bco; /* ignore any further alternatives */
 213         } else {
 214             StgDiscr con   = stgCaseAltCon(alt);
 215             List     vs    = stgCaseAltVars(alt);
 216             AsmSp    begin = asmBeginAlt(bco);
 217             AsmPc    fix   = asmTest(bco,stgDiscrTag(con));
 218                      /* ToDo: omit in single constructor types! */
 219             asmBind(bco,PTR_REP); /* Adjust simulated sp to acct for return value */
 220             if (isBoxingCon(con)) {
 221                 setPos(hd(vs),asmUnbox(bco,boxingConRep(con)));
 222             } else {
 223                 asmBeginUnpack(bco);
 224                 map1Proc(cgBind,bco,reverse(vs));
 225                 asmEndUnpack(bco);
 226             }
 227             cgExpr(bco,root,stgCaseAltBody(alt));
 228             asmEndAlt(bco,begin);
 229             asmFixBranch(bco,fix);
 230         }
 231     }
 232     /* if we got this far and didn't match, panic! */
 233     asmPanic(bco);
 234     asmEndContinuation(bco);
 235     return bco;
 236 }
 237
 238 static void testPrimPats( AsmBCO bco, AsmSp root, List pats, StgExpr e )
 239 {
 240     if (isNull(pats)) {
 241         cgExpr(bco,root,e);
 242     } else {
 243         StgVar pat = hd(pats);
 244         if (isInt(stgVarBody(pat))) {
 245             /* asmTestInt leaves stack unchanged - so no need to adjust it */
 246             AsmPc tst = asmTestInt(bco,getPos(pat),intOf(stgVarBody(pat)));
 247             assert(repOf(pat) == INT_REP);
 248             testPrimPats(bco,root,tl(pats),e);
 249             asmFixBranch(bco,tst);
 250         } else {
 251             testPrimPats(bco,root,tl(pats),e);
 252         }
 253     }
 254 }
 255
 256 #if 0  /* appears to be unused */
 257 static void cgPrimAlt( AsmBCO bco, AsmSp root, List vs, StgExpr e )
 258 {
 259     assert(0); /* ToDo: test for patterns */
 260     map1Proc(cgBind,bco,vs); /* ToDo: are these in right order? */
 261     cgExpr(bco,root,e);
 262 }
 263 #endif
 264
 265
 266 static AsmBCO cgLambda( StgExpr e )
 267 {
 268     AsmBCO bco = asmBeginBCO(e);
 269
 270     AsmSp root = asmBeginArgCheck(bco);
 271     map1Proc(cgBind,bco,reverse(stgLambdaArgs(e)));
 272     asmEndArgCheck(bco,root);
 273
 274     /* ppStgExpr(e); */
 275     cgExpr(bco,root,stgLambdaBody(e));
 276
 277     asmEndBCO(bco);
 278     return bco;
 279 }
 280
 281 static AsmBCO cgRhs( StgRhs rhs )
 282 {
 283     AsmBCO bco = asmBeginBCO(rhs );
 284
 285     AsmSp root = asmBeginArgCheck(bco);
 286     asmEndArgCheck(bco,root);
 287
 288     /* ppStgExpr(rhs); */
 289     cgExpr(bco,root,rhs);
 290
 291     asmEndBCO(bco);
 292     return bco;
 293 }
 294
 295
 296 static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e )
 297 {
 298   //printf("cgExpr:");ppStgExpr(e);printf("\n");
 299     switch (whatIs(e)) {
 300     case LETREC:
 301         {
 302             List binds = stgLetBinds(e);
 303             map1Proc(alloc,bco,binds);
 304             map1Proc(build,bco,binds);
 305             cgExpr(bco,root,stgLetBody(e));
 306             break;
 307         }
 308     case LAMBDA:
 309         {
 310             AsmSp begin = asmBeginEnter(bco);
 311             asmClosure(bco,cgLambda(e));
 312             asmEndEnter(bco,begin,root);
 313             break;
 314         }
 315     case CASE:
 316         {
 317             List  alts     = stgCaseAlts(e);
 318             AsmSp sp       = asmBeginCase(bco);
 319             AsmSp caseroot = asmContinuation(bco,cgAlts(root,sp,alts));
 320             cgExpr(bco,caseroot,stgCaseScrut(e));
 321             asmEndCase(bco);
 322             break;
 323         }
 324     case PRIMCASE:
 325         {
 326             StgExpr scrut = stgPrimCaseScrut(e);
 327             List alts = stgPrimCaseAlts(e);
 328             if (whatIs(scrut) == STGPRIM) {  /* this is an optimisation */
 329
 330                 /* No need to use return address or to Slide */
 331                 AsmSp beginPrim = asmBeginPrim(bco);
 332                 map1Proc(pushAtom,bco,reverse(stgPrimArgs(scrut)));
 333                 asmEndPrim(bco,(AsmPrim*)name(stgPrimOp(scrut)).primop,beginPrim);
 334
 335                 for(; nonNull(alts); alts=tl(alts)) {
 336                     StgPrimAlt alt = hd(alts);
 337                     List    pats = stgPrimAltVars(alt);
 338                     StgExpr body = stgPrimAltBody(alt);
 339                     AsmSp altBegin = asmBeginAlt(bco);
 340                     map1Proc(cgBind,bco,reverse(pats));
 341                     testPrimPats(bco,root,pats,body);
 342                     asmEndAlt(bco,altBegin);
 343                 }
 344                 /* if we got this far and didn't match, panic! */
 345                 asmPanic(bco);
 346
 347             } else if (whatIs(scrut) == STGVAR) { /* another optimisation */
 348
 349                 /* No need to use return address or to Slide */
 350
 351                 /* only part different from primop code... todo */
 352                 AsmSp beginCase = asmBeginCase(bco);
 353                 pushVar(bco,scrut);
 354                 asmEndAlt(bco,beginCase); /* hack, hack -  */
 355
 356                 for(; nonNull(alts); alts=tl(alts)) {
 357                     StgPrimAlt alt = hd(alts);
 358                     List    pats = stgPrimAltVars(alt);
 359                     StgExpr body = stgPrimAltBody(alt);
 360                     AsmSp altBegin = asmBeginAlt(bco);
 361                     map1Proc(cgBind,bco,pats);
 362                     testPrimPats(bco,root,pats,body);
 363                     asmEndAlt(bco,altBegin);
 364                 }
 365                 /* if we got this far and didn't match, panic! */
 366                 asmPanic(bco);
 367
 368             } else {
 369                 /* ToDo: implement this code...  */
 370                 assert(0);
 371                 /* asmPushRet(bco,delayPrimAlt( stgPrimCaseVars(e), stgPrimCaseBody(e))); */
 372                 /* cgExpr( bco,root,scrut ); */
 373             }
 374             break;
 375         }
 376     case STGAPP: /* Tail call */
 377         {
 378             AsmSp env = asmBeginEnter(bco);
 379             map1Proc(pushAtom,bco,reverse(stgAppArgs(e)));
 380             pushAtom(bco,stgAppFun(e));
 381             asmEndEnter(bco,env,root);
 382             break;
 383         }
 384     case NAME: /* Tail call (with no args) */
 385         {
 386             AsmSp env = asmBeginEnter(bco);
 387             pushVar(bco,name(e).stgVar);
 388             asmEndEnter(bco,env,root);
 389             break;
 390         }
 391     case STGVAR: /* Tail call (with no args), plus unboxed return */
 392             switch (repOf(e)) {
 393             case PTR_REP:
 394             case ALPHA_REP:
 395             case BETA_REP:
 396                 {
 397                     AsmSp env = asmBeginEnter(bco);
 398                     pushVar(bco,e);
 399                     asmEndEnter(bco,env,root);
 400                     break;
 401                 }
 402             case INT_REP:
 403                     assert(0);
 404                     /* cgTailCall(bco,singleton(e)); */
 405                     /* asmReturnInt(bco); */
 406                     break;
 407             default:
 408                     internal("cgExpr StgVar");
 409             }
 410             break;
 411     case STGPRIM: /* Tail call again */
 412         {
 413             AsmSp beginPrim = asmBeginPrim(bco);
 414             map1Proc(pushAtom,bco,reverse(stgPrimArgs(e)));
 415             asmEndPrim(bco,(AsmPrim*)name(e).primop,beginPrim);
 416             /* map1Proc(cgBind,bco,rs_vars); */
 417             assert(0); /* asmReturn_retty(); */
 418             break;
 419         }
 420     default:
 421             fprintf(stderr,"\nYoiks: "); printExp(stderr,e);
 422             internal("cgExpr");
 423     }
 424 }
 425
 426 #define M_ITBLNAMES 35000
 427
 428 void* itblNames[M_ITBLNAMES];
 429 int   nItblNames = 0;
 430
 431 /* allocate space for top level variable
 432  * any change requires a corresponding change in 'build'.
 433  */
 434 static Void alloc( AsmBCO bco, StgVar v )
 435 {
 436     StgRhs rhs = stgVarBody(v);
 437     assert(isStgVar(v));
 438     switch (whatIs(rhs)) {
 439     case STGCON:
 440         {
 441             StgDiscr con  = stgConCon(rhs);
 442             List     args = stgConArgs(rhs);
 443             if (isBoxingCon(con)) {
 444                 pushAtom(bco,hd(args));
 445                 setPos(v,asmBox(bco,boxingConRep(con)));
 446             } else {
 447
 448                 void* vv = stgConInfo(con);
 449                 if (!(nItblNames < (M_ITBLNAMES-2)))
 450                    internal("alloc -- M_ITBLNAMES too small");
 451                 if (isName(con)) {
 452                    itblNames[nItblNames++] = vv;
 453                    itblNames[nItblNames++] = textToStr(name(con).text);
 454                 } else
 455                 if (isTuple(con)) {
 456                    char* cc = malloc(10);
 457                    assert(cc);
 458                    sprintf(cc, "Tuple%d", tupleOf(con) );
 459                    itblNames[nItblNames++] = vv;
 460                    itblNames[nItblNames++] = cc;
 461                 } else
 462                 assert ( /* cant identify constructor name */ 0 );
 463
 464                 setPos(v,asmAllocCONSTR(bco, vv));
 465             }
 466             break;
 467         }
 468     case STGAPP: {
 469             Int  totSizeW = 0;
 470             List bs       = stgAppArgs(rhs);
 471             for (; nonNull(bs); bs=tl(bs)) {
 472                if (isName(hd(bs))) {
 473                   totSizeW += 1;
 474                } else {
 475                   ASSERT(whatIs(hd(bs))==STGVAR);
 476                   totSizeW += asmRepSizeW( charOf(stgVarRep(hd(bs))) );
 477                }
 478             }
 479             setPos(v,asmAllocAP(bco,totSizeW));
 480             //ORIGINALLY:setPos(v,asmAllocAP(bco,length(stgAppArgs(rhs))));
 481             break;
 482          }
 483     case LAMBDA: /* optimisation */
 484             setObj(v,cgLambda(rhs));
 485             break;
 486     default:
 487             setPos(v,asmAllocAP(bco,0));
 488             break;
 489     }
 490 }
 491
 492 static Void build( AsmBCO bco, StgVar v )
 493 {
 494     StgRhs rhs = stgVarBody(v);
 495     assert(isStgVar(v));
 496
 497     switch (whatIs(rhs)) {
 498     case STGCON:
 499         {
 500             StgDiscr con  = stgConCon(rhs);
 501             List     args = stgConArgs(rhs);
 502             if (isBoxingCon(con)) {
 503                 doNothing();  /* already done in alloc */
 504             } else {
 505                 AsmSp start = asmBeginPack(bco);
 506                 map1Proc(pushAtom,bco,reverse(args));
 507                 asmEndPack(bco,getPos(v),start,stgConInfo(con));
 508             }
 509             return;
 510         }
 511     case STGAPP:
 512         {
 513             Bool   itsaPAP;
 514             StgVar fun  = stgAppFun(rhs);
 515             StgVar fun0 = fun;
 516             List   args = stgAppArgs(rhs);
 517             if (isName(fun)) {
 518                 if (nonNull(name(fun).stgVar))
 519                    fun = name(fun).stgVar; else
 520                    fun = cptrFromName(fun);
 521             }
 522
 523             if (isCPtr(fun)) {
 524                assert(isName(fun0));
 525                itsaPAP = name(fun0).arity > length(args);
 526 fprintf ( stderr, "nativeCall: name %s, arity %d, args %d\n",
 527                nameFromOPtr(cptrOf(fun)), name(fun0).arity, length(args) );
 528             } else {
 529                itsaPAP = FALSE;
 530                if (nonNull(stgVarBody(fun))
 531                    && whatIs(stgVarBody(fun)) == LAMBDA
 532                    && length(stgLambdaArgs(stgVarBody(fun))) > length(args)
 533                   )
 534                   itsaPAP = TRUE;
 535             }
 536
 537             if (itsaPAP) {
 538                 AsmSp  start = asmBeginMkPAP(bco);
 539                 map1Proc(pushAtom,bco,reverse(args));
 540                 pushAtom(bco,fun);
 541                 asmEndMkPAP(bco,getPos(v),start); /* optimisation */
 542             } else {
 543                 AsmSp  start = asmBeginMkAP(bco);
 544                 map1Proc(pushAtom,bco,reverse(args));
 545                 pushAtom(bco,fun);
 546                 asmEndMkAP(bco,getPos(v),start);
 547             }
 548             return;
 549         }
 550     case LAMBDA: /* optimisation */
 551             doNothing(); /* already pushed in alloc */
 552             break;
 553
 554     /* These two cases look almost identical to the default but they're really
 555      * special cases of STGAPP.  The essential thing here is that we can't call
 556      * cgRhs(rhs) because that expects the rhs to have no free variables when,
 557      * in fact, the rhs is _always_ a free variable.
 558      *
 559      * ToDo: a simple optimiser would eliminate all examples
 560      * of this except "let x = x in ..."
 561      */
 562     case NAME:
 563             rhs = name(rhs).stgVar;
 564     case STGVAR:
 565         {
 566             AsmSp  start = asmBeginMkAP(bco);
 567             pushAtom(bco,rhs);
 568             asmEndMkAP(bco,getPos(v),start);
 569         }
 570         return;
 571     default:
 572         {
 573             AsmSp start = asmBeginMkAP(bco);   /* make it updateable! */
 574             asmClosure(bco,cgRhs(rhs));
 575             asmEndMkAP(bco,getPos(v),start);
 576             return;
 577         }
 578     }
 579 }
 580
 581 /* --------------------------------------------------------------------------
 582  * Top level variables
 583  *
 584  * ToDo: these should be handled by allocating a dynamic unentered CAF
 585  * for each top level variable - this should be simpler!
 586  * ------------------------------------------------------------------------*/
 587
 588 #if 0   /* appears to be unused */
 589 static void cgAddVar( AsmObject obj, StgAtom v )
 590 {
 591     if (isName(v)) {
 592         v = name(v).stgVar;
 593     }
 594     assert(isStgVar(v));
 595     asmAddPtr(obj,getObj(v));
 596 }
 597 #endif
 598
 599
 600 /* allocate AsmObject for top level variables
 601  * any change requires a corresponding change in endTop
 602  */
 603 static void beginTop( StgVar v )
 604 {
 605     StgRhs rhs;
 606     assert(isStgVar(v));
 607     currentTop = v;
 608     rhs = stgVarBody(v);
 609     switch (whatIs(rhs)) {
 610     case STGCON:
 611         {
 612             //List as = stgConArgs(rhs);
 613             setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs))));
 614             break;
 615         }
 616     case LAMBDA:
 617 #ifdef CRUDE_PROFILING
 618             setObj(v,asmBeginBCO(currentTop));
 619 #else
 620             setObj(v,asmBeginBCO(rhs));
 621 #endif
 622             break;
 623     default:
 624             setObj(v,asmBeginCAF());
 625             break;
 626     }
 627 }
 628
 629 static void endTop( StgVar v )
 630 {
 631     StgRhs rhs = stgVarBody(v);
 632     currentTop = v;
 633     switch (whatIs(rhs)) {
 634     case STGCON:
 635         {
 636             List as = stgConArgs(rhs);
 637             AsmCon con = (AsmCon)getObj(v);
 638             for( ; nonNull(as); as=tl(as)) {
 639                 StgAtom a = hd(as);
 640                 switch (whatIs(a)) {
 641                 case STGVAR:
 642                         /* should be a delayed combinator! */
 643                         asmAddPtr(con,(AsmObject)getObj(a));
 644                         break;
 645                 case NAME:
 646                     {
 647                         StgVar var = name(a).stgVar;
 648                         assert(var);
 649                         asmAddPtr(con,(AsmObject)getObj(a));
 650                         break;
 651                     }
 652 #if !USE_ADDR_FOR_STRINGS
 653                 case STRCELL:
 654                         asmAddPtr(con,asmStringObj(textToStr(textOf(a))));
 655                         break;
 656 #endif
 657                 default:
 658                         /* asmAddPtr(con,??); */
 659                         assert(0);
 660                         break;
 661                 }
 662             }
 663             asmEndCon(con);
 664             break;
 665         }
 666     case LAMBDA: /* optimisation */
 667         {
 668             /* ToDo: merge this code with cgLambda */
 669             AsmBCO bco = (AsmBCO)getObj(v);
 670             AsmSp root = asmBeginArgCheck(bco);
 671             map1Proc(cgBind,bco,reverse(stgLambdaArgs(rhs)));
 672             asmEndArgCheck(bco,root);
 673
 674             cgExpr(bco,root,stgLambdaBody(rhs));
 675
 676             asmEndBCO(bco);
 677             break;
 678         }
 679     default:   /* updateable caf */
 680         {
 681             AsmCAF caf = (AsmCAF)getObj(v);
 682             asmEndCAF(caf,cgRhs(rhs));
 683             break;
 684         }
 685     }
 686 }
 687
 688 static void zap( StgVar v )
 689 {
 690   // ToDo: reinstate
 691   //    stgVarBody(v) = NIL;
 692 }
 693
 694 /* external entry point */
 695 Void cgBinds( List binds )
 696 {
 697     List b;
 698     int i;
 699
 700 #if 0
 701     if (lastModule() != modulePrelude) {
 702         printf("\n\ncgBinds: before ll\n\n" );
 703         for (b=binds; nonNull(b); b=tl(b)) {
 704            printStg ( stdout, hd(b) ); printf("\n\n");
 705         }
 706     }
 707 #endif
 708
 709     binds = liftBinds(binds);
 710
 711 #if 0
 712     if (lastModule() != modulePrelude) {
 713         printf("\n\ncgBinds: after ll\n\n" );
 714         for (b=binds; nonNull(b); b=tl(b)) {
 715            printStg ( stdout, hd(b) ); printf("\n\n");
 716         }
 717     }
 718 #endif
 719
 720     for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
 721        beginTop(hd(b));
 722     }
 723
 724     for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
 725       //printf("endTop %s\n", maybeName(hd(b)));
 726        endTop(hd(b));
 727     }
 728
 729     //mapProc(zap,binds);
 730 }
 731
 732 /* --------------------------------------------------------------------------
 733  * Code Generator control:
 734  * ------------------------------------------------------------------------*/
 735
 736 Void codegen(what)
 737 Int what; {
 738     switch (what) {
 739     case INSTALL:
 740             /* deliberate fall though */
 741     case RESET:
 742             break;
 743     case MARK:
 744             break;
 745     }
 746     liftControl(what);
 747 }
 748
 749 /*-------------------------------------------------------------------------*/