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.10 $
  13  * $Date: 1999/11/11 16:27:30 $
  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             asmConstDouble(bco,floatOf(e));
 169             break;
 170     case STRCELL:
 171 #if USE_ADDR_FOR_STRINGS
 172             asmConstAddr(bco,textToStr(textOf(e)));
 173 #else
 174             asmClosure(bco,asmStringObj(textToStr(textOf(e))));
 175 #endif
 176             break;
 177     case CPTRCELL:
 178             asmGHCClosure(bco,cptrOf(e));
 179             break;
 180     case PTRCELL:
 181             asmConstAddr(bco,ptrOf(e));
 182             break;
 183     default:
 184             fprintf(stderr,"\nYoiks: "); printExp(stderr,e);
 185             internal("pushAtom");
 186     }
 187 }
 188
 189 static AsmBCO cgAlts( AsmSp root, AsmSp sp, List alts )
 190 {
 191 #ifdef CRUDE_PROFILING
 192     AsmBCO bco = asmBeginContinuation(sp, currentTop + 1000000000);
 193 #else
 194     AsmBCO bco = asmBeginContinuation(sp, alts);
 195 #endif
 196     /* ppStgAlts(alts); */
 197     for(; nonNull(alts); alts=tl(alts)) {
 198         StgCaseAlt alt  = hd(alts);
 199         if (isDefaultAlt(alt)) {
 200             cgBind(bco,stgDefaultVar(alt));
 201             cgExpr(bco,root,stgDefaultBody(alt));
 202             asmEndContinuation(bco);
 203             return bco; /* ignore any further alternatives */
 204         } else {
 205             StgDiscr con   = stgCaseAltCon(alt);
 206             List     vs    = stgCaseAltVars(alt);
 207             AsmSp    begin = asmBeginAlt(bco);
 208             AsmPc    fix   = asmTest(bco,stgDiscrTag(con));
 209                      /* ToDo: omit in single constructor types! */
 210             asmBind(bco,PTR_REP); /* Adjust simulated sp to acct for return value */
 211             if (isBoxingCon(con)) {
 212                 setPos(hd(vs),asmUnbox(bco,boxingConRep(con)));
 213             } else {
 214                 asmBeginUnpack(bco);
 215                 map1Proc(cgBind,bco,reverse(vs));
 216                 asmEndUnpack(bco);
 217             }
 218             cgExpr(bco,root,stgCaseAltBody(alt));
 219             asmEndAlt(bco,begin);
 220             asmFixBranch(bco,fix);
 221         }
 222     }
 223     /* if we got this far and didn't match, panic! */
 224     asmPanic(bco);
 225     asmEndContinuation(bco);
 226     return bco;
 227 }
 228
 229 static void testPrimPats( AsmBCO bco, AsmSp root, List pats, StgExpr e )
 230 {
 231     if (isNull(pats)) {
 232         cgExpr(bco,root,e);
 233     } else {
 234         StgVar pat = hd(pats);
 235         if (isInt(stgVarBody(pat))) {
 236             /* asmTestInt leaves stack unchanged - so no need to adjust it */
 237             AsmPc tst = asmTestInt(bco,getPos(pat),intOf(stgVarBody(pat)));
 238             assert(repOf(pat) == INT_REP);
 239             testPrimPats(bco,root,tl(pats),e);
 240             asmFixBranch(bco,tst);
 241         } else {
 242             testPrimPats(bco,root,tl(pats),e);
 243         }
 244     }
 245 }
 246
 247 #if 0  /* appears to be unused */
 248 static void cgPrimAlt( AsmBCO bco, AsmSp root, List vs, StgExpr e )
 249 {
 250     assert(0); /* ToDo: test for patterns */
 251     map1Proc(cgBind,bco,vs); /* ToDo: are these in right order? */
 252     cgExpr(bco,root,e);
 253 }
 254 #endif
 255
 256
 257 static AsmBCO cgLambda( StgExpr e )
 258 {
 259     AsmBCO bco = asmBeginBCO(e);
 260
 261     AsmSp root = asmBeginArgCheck(bco);
 262     map1Proc(cgBind,bco,reverse(stgLambdaArgs(e)));
 263     asmEndArgCheck(bco,root);
 264
 265     /* ppStgExpr(e); */
 266     cgExpr(bco,root,stgLambdaBody(e));
 267
 268     asmEndBCO(bco);
 269     return bco;
 270 }
 271
 272 static AsmBCO cgRhs( StgRhs rhs )
 273 {
 274     AsmBCO bco = asmBeginBCO(rhs );
 275
 276     AsmSp root = asmBeginArgCheck(bco);
 277     asmEndArgCheck(bco,root);
 278
 279     /* ppStgExpr(rhs); */
 280     cgExpr(bco,root,rhs);
 281
 282     asmEndBCO(bco);
 283     return bco;
 284 }
 285
 286
 287 static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e )
 288 {
 289   //printf("cgExpr:");ppStgExpr(e);printf("\n");
 290     switch (whatIs(e)) {
 291     case LETREC:
 292         {
 293             List binds = stgLetBinds(e);
 294             map1Proc(alloc,bco,binds);
 295             map1Proc(build,bco,binds);
 296             cgExpr(bco,root,stgLetBody(e));
 297             break;
 298         }
 299     case LAMBDA:
 300         {
 301             AsmSp begin = asmBeginEnter(bco);
 302             asmClosure(bco,cgLambda(e));
 303             asmEndEnter(bco,begin,root);
 304             break;
 305         }
 306     case CASE:
 307         {
 308             List  alts     = stgCaseAlts(e);
 309             AsmSp sp       = asmBeginCase(bco);
 310             AsmSp caseroot = asmContinuation(bco,cgAlts(root,sp,alts));
 311             cgExpr(bco,caseroot,stgCaseScrut(e));
 312             asmEndCase(bco);
 313             break;
 314         }
 315     case PRIMCASE:
 316         {
 317             StgExpr scrut = stgPrimCaseScrut(e);
 318             List alts = stgPrimCaseAlts(e);
 319             if (whatIs(scrut) == STGPRIM) {  /* this is an optimisation */
 320
 321                 /* No need to use return address or to Slide */
 322                 AsmSp beginPrim = asmBeginPrim(bco);
 323                 map1Proc(pushAtom,bco,reverse(stgPrimArgs(scrut)));
 324                 asmEndPrim(bco,(AsmPrim*)name(stgPrimOp(scrut)).primop,beginPrim);
 325
 326                 for(; nonNull(alts); alts=tl(alts)) {
 327                     StgPrimAlt alt = hd(alts);
 328                     List    pats = stgPrimAltVars(alt);
 329                     StgExpr body = stgPrimAltBody(alt);
 330                     AsmSp altBegin = asmBeginAlt(bco);
 331                     map1Proc(cgBind,bco,reverse(pats));
 332                     testPrimPats(bco,root,pats,body);
 333                     asmEndAlt(bco,altBegin);
 334                 }
 335                 /* if we got this far and didn't match, panic! */
 336                 asmPanic(bco);
 337
 338             } else if (whatIs(scrut) == STGVAR) { /* another optimisation */
 339
 340                 /* No need to use return address or to Slide */
 341
 342                 /* only part different from primop code... todo */
 343                 AsmSp beginCase = asmBeginCase(bco);
 344                 pushVar(bco,scrut);
 345                 asmEndAlt(bco,beginCase); /* hack, hack -  */
 346
 347                 for(; nonNull(alts); alts=tl(alts)) {
 348                     StgPrimAlt alt = hd(alts);
 349                     List    pats = stgPrimAltVars(alt);
 350                     StgExpr body = stgPrimAltBody(alt);
 351                     AsmSp altBegin = asmBeginAlt(bco);
 352                     map1Proc(cgBind,bco,pats);
 353                     testPrimPats(bco,root,pats,body);
 354                     asmEndAlt(bco,altBegin);
 355                 }
 356                 /* if we got this far and didn't match, panic! */
 357                 asmPanic(bco);
 358
 359             } else {
 360                 /* ToDo: implement this code...  */
 361                 assert(0);
 362                 /* asmPushRet(bco,delayPrimAlt( stgPrimCaseVars(e), stgPrimCaseBody(e))); */
 363                 /* cgExpr( bco,root,scrut ); */
 364             }
 365             break;
 366         }
 367     case STGAPP: /* Tail call */
 368         {
 369             AsmSp env = asmBeginEnter(bco);
 370             map1Proc(pushAtom,bco,reverse(stgAppArgs(e)));
 371             pushAtom(bco,stgAppFun(e));
 372             asmEndEnter(bco,env,root);
 373             break;
 374         }
 375     case NAME: /* Tail call (with no args) */
 376         {
 377             AsmSp env = asmBeginEnter(bco);
 378             pushVar(bco,name(e).stgVar);
 379             asmEndEnter(bco,env,root);
 380             break;
 381         }
 382     case STGVAR: /* Tail call (with no args), plus unboxed return */
 383             switch (repOf(e)) {
 384             case PTR_REP:
 385             case ALPHA_REP:
 386             case BETA_REP:
 387                 {
 388                     AsmSp env = asmBeginEnter(bco);
 389                     pushVar(bco,e);
 390                     asmEndEnter(bco,env,root);
 391                     break;
 392                 }
 393             case INT_REP:
 394                     assert(0);
 395                     /* cgTailCall(bco,singleton(e)); */
 396                     /* asmReturnInt(bco); */
 397                     break;
 398             default:
 399                     internal("cgExpr StgVar");
 400             }
 401             break;
 402     case STGPRIM: /* Tail call again */
 403         {
 404             AsmSp beginPrim = asmBeginPrim(bco);
 405             map1Proc(pushAtom,bco,reverse(stgPrimArgs(e)));
 406             asmEndPrim(bco,(AsmPrim*)name(e).primop,beginPrim);
 407             /* map1Proc(cgBind,bco,rs_vars); */
 408             assert(0); /* asmReturn_retty(); */
 409             break;
 410         }
 411     default:
 412             fprintf(stderr,"\nYoiks: "); printExp(stderr,e);
 413             internal("cgExpr");
 414     }
 415 }
 416
 417 #define M_ITBLNAMES 35000
 418
 419 void* itblNames[M_ITBLNAMES];
 420 int   nItblNames = 0;
 421
 422 /* allocate space for top level variable
 423  * any change requires a corresponding change in 'build'.
 424  */
 425 static Void alloc( AsmBCO bco, StgVar v )
 426 {
 427     StgRhs rhs = stgVarBody(v);
 428     assert(isStgVar(v));
 429     switch (whatIs(rhs)) {
 430     case STGCON:
 431         {
 432             StgDiscr con  = stgConCon(rhs);
 433             List     args = stgConArgs(rhs);
 434             if (isBoxingCon(con)) {
 435                 pushAtom(bco,hd(args));
 436                 setPos(v,asmBox(bco,boxingConRep(con)));
 437             } else {
 438
 439                 void* vv = stgConInfo(con);
 440                 if (!(nItblNames < (M_ITBLNAMES-2)))
 441                    internal("alloc -- M_ITBLNAMES too small");
 442                 if (isName(con)) {
 443                    itblNames[nItblNames++] = vv;
 444                    itblNames[nItblNames++] = textToStr(name(con).text);
 445                 } else
 446                 if (isTuple(con)) {
 447                    char* cc = malloc(10);
 448                    assert(cc);
 449                    sprintf(cc, "Tuple%d", tupleOf(con) );
 450                    itblNames[nItblNames++] = vv;
 451                    itblNames[nItblNames++] = cc;
 452                 } else
 453                 assert ( /* cant identify constructor name */ 0 );
 454
 455                 setPos(v,asmAllocCONSTR(bco, vv));
 456             }
 457             break;
 458         }
 459     case STGAPP: {
 460             Int  totSizeW = 0;
 461             List bs       = stgAppArgs(rhs);
 462             for (; nonNull(bs); bs=tl(bs)) {
 463                if (isName(hd(bs))) {
 464                   totSizeW += 1;
 465                } else {
 466                   ASSERT(whatIs(hd(bs))==STGVAR);
 467                   totSizeW += asmRepSizeW( charOf(stgVarRep(hd(bs))) );
 468                }
 469             }
 470             setPos(v,asmAllocAP(bco,totSizeW));
 471             //ORIGINALLY:setPos(v,asmAllocAP(bco,length(stgAppArgs(rhs))));
 472             break;
 473          }
 474     case LAMBDA: /* optimisation */
 475             setObj(v,cgLambda(rhs));
 476             break;
 477     default:
 478             setPos(v,asmAllocAP(bco,0));
 479             break;
 480     }
 481 }
 482
 483 static Void build( AsmBCO bco, StgVar v )
 484 {
 485     StgRhs rhs = stgVarBody(v);
 486     assert(isStgVar(v));
 487
 488     switch (whatIs(rhs)) {
 489     case STGCON:
 490         {
 491             StgDiscr con  = stgConCon(rhs);
 492             List     args = stgConArgs(rhs);
 493             if (isBoxingCon(con)) {
 494                 doNothing();  /* already done in alloc */
 495             } else {
 496                 AsmSp start = asmBeginPack(bco);
 497                 map1Proc(pushAtom,bco,reverse(args));
 498                 asmEndPack(bco,getPos(v),start,stgConInfo(con));
 499             }
 500             return;
 501         }
 502     case STGAPP:
 503         {
 504             Bool   itsaPAP;
 505             StgVar fun  = stgAppFun(rhs);
 506             StgVar fun0 = fun;
 507             List   args = stgAppArgs(rhs);
 508             if (isName(fun)) {
 509                 if (nonNull(name(fun).stgVar))
 510                    fun = name(fun).stgVar; else
 511                    fun = cptrFromName(fun);
 512             }
 513
 514             if (isCPtr(fun)) {
 515                assert(isName(fun0));
 516                itsaPAP = name(fun0).arity > length(args);
 517 fprintf ( stderr, "nativeCall: name %s, arity %d, args %d\n",
 518                nameFromOPtr(cptrOf(fun)), name(fun0).arity, length(args) );
 519             } else {
 520                itsaPAP = FALSE;
 521                if (nonNull(stgVarBody(fun))
 522                    && whatIs(stgVarBody(fun)) == LAMBDA
 523                    && length(stgLambdaArgs(stgVarBody(fun))) > length(args)
 524                   )
 525                   itsaPAP = TRUE;
 526             }
 527
 528             if (itsaPAP) {
 529                 AsmSp  start = asmBeginMkPAP(bco);
 530                 map1Proc(pushAtom,bco,reverse(args));
 531                 pushAtom(bco,fun);
 532                 asmEndMkPAP(bco,getPos(v),start); /* optimisation */
 533             } else {
 534                 AsmSp  start = asmBeginMkAP(bco);
 535                 map1Proc(pushAtom,bco,reverse(args));
 536                 pushAtom(bco,fun);
 537                 asmEndMkAP(bco,getPos(v),start);
 538             }
 539             return;
 540         }
 541     case LAMBDA: /* optimisation */
 542             doNothing(); /* already pushed in alloc */
 543             break;
 544
 545     /* These two cases look almost identical to the default but they're really
 546      * special cases of STGAPP.  The essential thing here is that we can't call
 547      * cgRhs(rhs) because that expects the rhs to have no free variables when,
 548      * in fact, the rhs is _always_ a free variable.
 549      *
 550      * ToDo: a simple optimiser would eliminate all examples
 551      * of this except "let x = x in ..."
 552      */
 553     case NAME:
 554             rhs = name(rhs).stgVar;
 555     case STGVAR:
 556         {
 557             AsmSp  start = asmBeginMkAP(bco);
 558             pushAtom(bco,rhs);
 559             asmEndMkAP(bco,getPos(v),start);
 560         }
 561         return;
 562     default:
 563         {
 564             AsmSp start = asmBeginMkAP(bco);   /* make it updateable! */
 565             asmClosure(bco,cgRhs(rhs));
 566             asmEndMkAP(bco,getPos(v),start);
 567             return;
 568         }
 569     }
 570 }
 571
 572 /* --------------------------------------------------------------------------
 573  * Top level variables
 574  *
 575  * ToDo: these should be handled by allocating a dynamic unentered CAF
 576  * for each top level variable - this should be simpler!
 577  * ------------------------------------------------------------------------*/
 578
 579 #if 0   /* appears to be unused */
 580 static void cgAddVar( AsmObject obj, StgAtom v )
 581 {
 582     if (isName(v)) {
 583         v = name(v).stgVar;
 584     }
 585     assert(isStgVar(v));
 586     asmAddPtr(obj,getObj(v));
 587 }
 588 #endif
 589
 590
 591 /* allocate AsmObject for top level variables
 592  * any change requires a corresponding change in endTop
 593  */
 594 static void beginTop( StgVar v )
 595 {
 596     StgRhs rhs;
 597     assert(isStgVar(v));
 598     currentTop = v;
 599     rhs = stgVarBody(v);
 600     switch (whatIs(rhs)) {
 601     case STGCON:
 602         {
 603             //List as = stgConArgs(rhs);
 604             setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs))));
 605             break;
 606         }
 607     case LAMBDA:
 608 #ifdef CRUDE_PROFILING
 609             setObj(v,asmBeginBCO(currentTop));
 610 #else
 611             setObj(v,asmBeginBCO(rhs));
 612 #endif
 613             break;
 614     default:
 615             setObj(v,asmBeginCAF());
 616             break;
 617     }
 618 }
 619
 620 static void endTop( StgVar v )
 621 {
 622     StgRhs rhs = stgVarBody(v);
 623     currentTop = v;
 624     switch (whatIs(rhs)) {
 625     case STGCON:
 626         {
 627             List as = stgConArgs(rhs);
 628             AsmCon con = (AsmCon)getObj(v);
 629             for( ; nonNull(as); as=tl(as)) {
 630                 StgAtom a = hd(as);
 631                 switch (whatIs(a)) {
 632                 case STGVAR:
 633                         /* should be a delayed combinator! */
 634                         asmAddPtr(con,(AsmObject)getObj(a));
 635                         break;
 636                 case NAME:
 637                     {
 638                         StgVar var = name(a).stgVar;
 639                         assert(var);
 640                         asmAddPtr(con,(AsmObject)getObj(a));
 641                         break;
 642                     }
 643 #if !USE_ADDR_FOR_STRINGS
 644                 case STRCELL:
 645                         asmAddPtr(con,asmStringObj(textToStr(textOf(a))));
 646                         break;
 647 #endif
 648                 default:
 649                         /* asmAddPtr(con,??); */
 650                         assert(0);
 651                         break;
 652                 }
 653             }
 654             asmEndCon(con);
 655             break;
 656         }
 657     case LAMBDA: /* optimisation */
 658         {
 659             /* ToDo: merge this code with cgLambda */
 660             AsmBCO bco = (AsmBCO)getObj(v);
 661             AsmSp root = asmBeginArgCheck(bco);
 662             map1Proc(cgBind,bco,reverse(stgLambdaArgs(rhs)));
 663             asmEndArgCheck(bco,root);
 664
 665             cgExpr(bco,root,stgLambdaBody(rhs));
 666
 667             asmEndBCO(bco);
 668             break;
 669         }
 670     default:   /* updateable caf */
 671         {
 672             AsmCAF caf = (AsmCAF)getObj(v);
 673             asmEndCAF(caf,cgRhs(rhs));
 674             break;
 675         }
 676     }
 677 }
 678
 679 static void zap( StgVar v )
 680 {
 681   // ToDo: reinstate
 682   //    stgVarBody(v) = NIL;
 683 }
 684
 685 /* external entry point */
 686 Void cgBinds( List binds )
 687 {
 688     List b;
 689     int i;
 690
 691 #if 0
 692     if (lastModule() != modulePrelude) {
 693         printf("\n\ncgBinds: before ll\n\n" );
 694         for (b=binds; nonNull(b); b=tl(b)) {
 695            printStg ( stdout, hd(b) ); printf("\n\n");
 696         }
 697     }
 698 #endif
 699
 700     binds = liftBinds(binds);
 701
 702 #if 0
 703     if (lastModule() != modulePrelude) {
 704         printf("\n\ncgBinds: after ll\n\n" );
 705         for (b=binds; nonNull(b); b=tl(b)) {
 706            printStg ( stdout, hd(b) ); printf("\n\n");
 707         }
 708     }
 709 #endif
 710
 711     for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
 712        beginTop(hd(b));
 713     }
 714
 715     for (b=binds,i=0; nonNull(b); b=tl(b),i++) {
 716       //printf("endTop %s\n", maybeName(hd(b)));
 717        endTop(hd(b));
 718     }
 719
 720     //mapProc(zap,binds);
 721 }
 722
 723 /* --------------------------------------------------------------------------
 724  * Code Generator control:
 725  * ------------------------------------------------------------------------*/
 726
 727 Void codegen(what)
 728 Int what; {
 729     switch (what) {
 730     case INSTALL:
 731             /* deliberate fall though */
 732     case RESET:
 733             break;
 734     case MARK:
 735             break;
 736     }
 737     liftControl(what);
 738 }
 739
 740 /*-------------------------------------------------------------------------*/