ghc/interpreter/codegen.c

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