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