X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fcodegen.c;h=ca9b482d3d3c6cf4960cf53479ff1b31183e90f3;hb=b9ad54f9b2bb99d2d3d62c61e2da71e076938f18;hp=42059511cf86e0a20da904673975b19ed9e0effe;hpb=9da01c710daee2cd5038afb8fad761cdaf343033;p=ghc-hetmet.git diff --git a/ghc/interpreter/codegen.c b/ghc/interpreter/codegen.c index 4205951..ca9b482 100644 --- a/ghc/interpreter/codegen.c +++ b/ghc/interpreter/codegen.c @@ -7,8 +7,8 @@ * Hugs version 1.4, December 1997 * * $RCSfile: codegen.c,v $ - * $Revision: 1.5 $ - * $Date: 1999/03/09 14:51:04 $ + * $Revision: 1.6 $ + * $Date: 1999/04/27 10:06:48 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -48,6 +48,8 @@ static AsmBCO cgRhs ( StgRhs rhs ); static void beginTop ( StgVar v ); static void endTop ( StgVar v ); +static StgVar currentTop; + /* -------------------------------------------------------------------------- * * ------------------------------------------------------------------------*/ @@ -105,11 +107,7 @@ static void cgBind( AsmBCO bco, StgVar v ) static Void pushVar( AsmBCO bco, StgVar v ) { Cell info = stgVarInfo(v); - // if (!isStgVar(v)) { - //printf("\n\nprefail\n"); - //print(v,1000); - assert(isStgVar(v)); - //} + assert(isStgVar(v)); if (isPtr(info)) { asmClosure(bco,ptrOf(info)); } else if (isInt(info)) { @@ -134,17 +132,9 @@ static Void pushAtom( AsmBCO bco, StgAtom e ) case INTCELL: asmConstInt(bco,intOf(e)); break; -#if BIGNUM_IS_INTEGER case BIGCELL: asmConstInteger(bco,bignumToString(e)); break; -#elif BIGNUM_IS_INT64 - case BIGCELL: - asmConstInt64(bco,bignumOf(e)); - break; -#else -#warning What is BIGNUM? -#endif case FLOATCELL: #if 0 asmConstFloat(bco,e); /* ToDo: support both float and double! */ @@ -175,24 +165,26 @@ static Void pushAtom( AsmBCO bco, StgAtom e ) static AsmBCO cgAlts( AsmSp root, AsmSp sp, List alts ) { - AsmBCO bco = asmBeginContinuation(sp,alts); +#ifdef CRUDE_PROFILING + AsmBCO bco = asmBeginContinuation(sp, currentTop + 1000000000); +#else + AsmBCO bco = asmBeginContinuation(sp, alts); +#endif /* ppStgAlts(alts); */ for(; nonNull(alts); alts=tl(alts)) { StgCaseAlt alt = hd(alts); - StgPat pat = stgCaseAltPat(alt); - StgExpr body = stgCaseAltBody(alt); - if (isDefaultPat(pat)) { - //AsmSp begin = asmBeginAlt(bco); - cgBind(bco,pat); - cgExpr(bco,root,body); + if (isDefaultAlt(alt)) { + cgBind(bco,stgDefaultVar(alt)); + cgExpr(bco,root,stgDefaultBody(alt)); asmEndContinuation(bco); return bco; /* ignore any further alternatives */ } else { - StgDiscr con = stgPatDiscr(pat); - List vs = stgPatVars(pat); + StgDiscr con = stgCaseAltCon(alt); + List vs = stgCaseAltVars(alt); AsmSp begin = asmBeginAlt(bco); - AsmPc fix = asmTest(bco,stgDiscrTag(con)); /* ToDo: omit in single constructor types! */ - cgBind(bco,pat); + AsmPc fix = asmTest(bco,stgDiscrTag(con)); + /* ToDo: omit in single constructor types! */ + asmBind(bco,PTR_REP); /* Adjust simulated sp to acct for return value */ if (isBoxingCon(con)) { setPos(hd(vs),asmUnbox(bco,boxingConRep(con))); } else { @@ -200,7 +192,7 @@ static AsmBCO cgAlts( AsmSp root, AsmSp sp, List alts ) map1Proc(cgBind,bco,reverse(vs)); asmEndUnpack(bco); } - cgExpr(bco,root,body); + cgExpr(bco,root,stgCaseAltBody(alt)); asmEndAlt(bco,begin); asmFixBranch(bco,fix); } @@ -216,7 +208,7 @@ static void testPrimPats( AsmBCO bco, AsmSp root, List pats, StgExpr e ) if (isNull(pats)) { cgExpr(bco,root,e); } else { - StgPrimPat pat = hd(pats); + StgVar pat = hd(pats); if (isInt(stgVarBody(pat))) { /* asmTestInt leaves stack unchanged - so no need to adjust it */ AsmPc tst = asmTestInt(bco,getPos(pat),intOf(stgVarBody(pat))); @@ -310,7 +302,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) for(; nonNull(alts); alts=tl(alts)) { StgPrimAlt alt = hd(alts); - List pats = stgPrimAltPats(alt); + List pats = stgPrimAltVars(alt); StgExpr body = stgPrimAltBody(alt); AsmSp altBegin = asmBeginAlt(bco); map1Proc(cgBind,bco,reverse(pats)); @@ -331,7 +323,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) for(; nonNull(alts); alts=tl(alts)) { StgPrimAlt alt = hd(alts); - List pats = stgPrimAltPats(alt); + List pats = stgPrimAltVars(alt); StgExpr body = stgPrimAltBody(alt); AsmSp altBegin = asmBeginAlt(bco); map1Proc(cgBind,bco,pats); @@ -399,7 +391,9 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) } } -void* itblNames[1000]; +#define M_ITBLNAMES 35000 + +void* itblNames[M_ITBLNAMES]; int nItblNames = 0; /* allocate space for top level variable @@ -420,7 +414,8 @@ static Void alloc( AsmBCO bco, StgVar v ) } else { void* vv = stgConInfo(con); - assert (nItblNames < (1000-2)); + if (!(nItblNames < (M_ITBLNAMES-2))) + internal("alloc -- M_ITBLNAMES too small"); if (isName(con)) { itblNames[nItblNames++] = vv; itblNames[nItblNames++] = textToStr(name(con).text); @@ -438,9 +433,21 @@ static Void alloc( AsmBCO bco, StgVar v ) } break; } - case STGAPP: - setPos(v,asmAllocAP(bco,length(stgAppArgs(rhs)))); + case STGAPP: { + Int totSizeW = 0; + List bs = stgAppArgs(rhs); + for (; nonNull(bs); bs=tl(bs)) { + if (isName(hd(bs))) { + totSizeW += 1; + } else { + ASSERT(whatIs(hd(bs))==STGVAR); + totSizeW += asmRepSizeW( charOf(stgVarRep(hd(bs))) ); + } + } + setPos(v,asmAllocAP(bco,totSizeW)); + //ORIGINALLY:setPos(v,asmAllocAP(bco,length(stgAppArgs(rhs)))); break; + } case LAMBDA: /* optimisation */ setObj(v,cgLambda(rhs)); break; @@ -548,6 +555,7 @@ static void beginTop( StgVar v ) { StgRhs rhs; assert(isStgVar(v)); + currentTop = v; rhs = stgVarBody(v); switch (whatIs(rhs)) { case STGCON: @@ -557,7 +565,11 @@ static void beginTop( StgVar v ) break; } case LAMBDA: +#ifdef CRUDE_PROFILING + setObj(v,asmBeginBCO(currentTop)); +#else setObj(v,asmBeginBCO(rhs)); +#endif break; default: setObj(v,asmBeginCAF()); @@ -568,7 +580,7 @@ static void beginTop( StgVar v ) static void endTop( StgVar v ) { StgRhs rhs = stgVarBody(v); - //ppStgRhs(rhs); + currentTop = v; switch (whatIs(rhs)) { case STGCON: { @@ -656,18 +668,13 @@ Void cgBinds( List binds ) } #endif - //mapProc(beginTop,binds); for (b=binds,i=0; nonNull(b); b=tl(b),i++) { - //printf("beginTop %d\n", i); beginTop(hd(b)); } - //mapProc(endTop,binds); for (b=binds,i=0; nonNull(b); b=tl(b),i++) { + //printf("endTop %s\n", maybeName(hd(b))); endTop(hd(b)); - //if (lastModule() != modulePrelude) { - // printStg ( stdout, hd(b) ); printf("\n\n"); - //} } //mapProc(zap,binds);