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