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