X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fcodegen.c;h=c356c1b152319aa28c6758a1bb4e9596b8e83dd7;hb=7a80ff0bd4e771b012f4cae609f840ef30f76ae2;hp=add33649b33100a255c0174e10d57c9503a46275;hpb=ad9bc691f47d26c56fbea4d83d49468708438905;p=ghc-hetmet.git diff --git a/ghc/interpreter/codegen.c b/ghc/interpreter/codegen.c index add3364..c356c1b 100644 --- a/ghc/interpreter/codegen.c +++ b/ghc/interpreter/codegen.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: codegen.c,v $ - * $Revision: 1.21 $ - * $Date: 2000/04/05 10:25:08 $ + * $Revision: 1.25 $ + * $Date: 2000/05/10 16:53:35 $ * ------------------------------------------------------------------------*/ #include "hugsbasictypes.h" @@ -18,36 +18,129 @@ #include "connect.h" #include "errors.h" +#include "Rts.h" /* to make StgPtr visible in Assembler.h */ #include "Assembler.h" -#include "Rts.h" /* IF_DEBUG */ #include "RtsFlags.h" /*#define DEBUG_CODEGEN*/ +/* (JRS, 27 Apr 2000): + +A total rewrite of the BCO assembler/linker, and rationalisation of +the code management and code generation phases of Hugs. + +Problems with the old linker: + +* Didn't have a clean way to insert a pointer to GHC code into a BCO. + This meant CAF GC didn't work properly in combined mode. + +* Leaked memory. Each BCO, caf and constructor generated by Hugs had + a corresponding malloc'd record used in its construction. These + records existed forever. Pointers from the Hugs symbol tables into + the runtime heap always went via these intermediates, for no apparent + reason. + +* A global variable holding a list of top-level stg trees was used + during code generation. It was hard to associate trees in this + list with entries in the name/tycon tables. Just too many + mechanisms. + +The New World Order is as follows: + +* The global code list (stgGlobals) is gone. + +* Each name in the name table has a .closure field. This points + to the top-level code for that name. Before bytecode generation + this points to a STG tree. During bytecode generation but before + bytecode linking it is a MPtr pointing to a malloc'd intermediate + structure (an AsmObject). After linking, it is a real live pointer + into the execution heap (CPtr) which is treated as a root during GC. + + Because tuples do not have name table entries, tycons which are + tuples also have a .closure field, which is treated identically + to those of name table entries. + +* Each module has a code list -- a list of names and tuples. If you + are a name or tuple and you have something (code, CAF or Con) which + needs to wind up in the execution heap, you MUST be on your module's + code list. Otherwise you won't get code generated. + +* Lambda lifting generates new name table entries, which of course + also wind up on the code list. + +* The initial phase of code generation for a module m traverses m's + code list. The stg trees referenced in the .closure fields are + code generated, creating AsmObject (AsmBCO, AsmCAF, AsmCon) in + mallocville. The .closure fields then point to these AsmObjects. + Since AsmObjects can be mutually recursive, they can contain + references to: + * Other AsmObjects Asm_RefObject + * Existing closures Asm_RefNoOp + * name/tycon table entries Asm_RefHugs + AsmObjects can also contain BCO insns and non-ptr words. + +* A second copy-and-link phase copies the AsmObjects into the + execution heap, resolves the Asm_Ref* items, and frees up + the malloc'd entities. + +* Minor cleanups in compile-time storage. There are now 3 kinds of + address-y things available: + CPtr/mkCPtr/cptrOf -- ptrs to Closures, probably in exec heap + ie anything which the exec GC knows about + MPtr/mkMPtr/mptrOf -- ptrs to mallocville, which the exec GC + knows nothing about + Addr/mkAddr/addrOf -- literal addresses (like literal ints) + +* Many hacky cases removed from codegen.c. Referencing code or + data during code generation is a lot simpler, since an entity + is either: + a CPtr, in which case use it as is + a MPtr -- stuff it into the AsmObject and the linker will fix it + a name or tycon + -- ditto + +* I've checked, using Purify that, at least in standalone mode, + no longer leaks mallocd memory. Prior to this it would leak at + the rate of about 300k per Prelude. + +Still to do: + +* Reinstate peephole optimisation for BCOs. + +* Nuke magic number headers in AsmObjects, used for debugging. + +* Profile and accelerate. Code generation is slower because linking + is slower. Evaluation GC is slower because markHugsObjects has + slowed down. + +* Make setCurrentModule ignore name table entries created by the + lambda-lifter. +*/ + + /* -------------------------------------------------------------------------- * Local function prototypes: * ------------------------------------------------------------------------*/ #define getPos(v) intOf(stgVarInfo(v)) #define setPos(v,sp) stgVarInfo(v) = mkInt(sp) -#define getObj(v) ptrOf(stgVarInfo(v)) -#define setObj(v,obj) stgVarInfo(v) = mkPtr(obj) +#define getObj(v) mptrOf(stgVarInfo(v)) +#define setObj(v,obj) stgVarInfo(v) = mkMPtr(obj) #define repOf(x) charOf(stgVarRep(x)) -static void cgBind ( AsmBCO bco, StgVar v ); -static Void pushVar ( AsmBCO bco, StgVar v ); -static Void pushAtom ( AsmBCO bco, StgAtom atom ); -static Void alloc ( AsmBCO bco, StgRhs rhs ); -static Void build ( AsmBCO bco, StgRhs rhs ); -static Void cgExpr ( AsmBCO bco, AsmSp root, StgExpr e ); +static void cgBind ( AsmBCO bco, StgVar v ); +static Void pushAtom ( AsmBCO bco, StgAtom atom ); +static Void alloc ( AsmBCO bco, StgRhs rhs ); +static Void build ( AsmBCO bco, StgRhs rhs ); +static Void cgExpr ( AsmBCO bco, AsmSp root, StgExpr e ); -static AsmBCO cgAlts ( AsmSp root, AsmSp sp, List alts ); -static void testPrimPats ( AsmBCO bco, AsmSp root, List pats, StgExpr e ); -static AsmBCO cgLambda ( StgExpr e ); -static AsmBCO cgRhs ( StgRhs rhs ); -static void beginTop ( StgVar v ); -static void endTop ( StgVar v ); +static AsmBCO cgAlts ( AsmSp root, AsmSp sp, List alts ); +static void testPrimPats ( AsmBCO bco, AsmSp root, List pats, StgExpr e ); +static AsmBCO cgLambda ( StgExpr e ); +static AsmBCO cgRhs ( StgRhs rhs ); +static void beginTop ( StgVar v ); +static AsmObject endTop ( StgVar v ); static StgVar currentTop; @@ -55,7 +148,7 @@ static StgVar currentTop; * * ------------------------------------------------------------------------*/ -static Cell cptrFromName ( Name n ) +static void* /* StgClosure*/ cptrFromName ( Name n ) { char buf[1000]; void* p; @@ -70,18 +163,7 @@ static Cell cptrFromName ( Name n ) ERRMSG(0) "Can't find object symbol %s", buf EEND; } - return mkCPtr(p); -} - -static Bool varHasClosure( StgVar v ) -{ - return asmObjectHasClosure((AsmClosure*)ptrOf(stgVarInfo(v))); -} - -/* should be AsmClosure* */ -void* closureOfVar( StgVar v ) -{ - return asmClosureOfObject((AsmClosure*)ptrOf(stgVarInfo(v))); + return p; } char* lookupHugsName( void* closure ) @@ -91,15 +173,11 @@ char* lookupHugsName( void* closure ) for( nm = NAME_BASE_ADDR; nm < NAME_BASE_ADDR+tabNameSz; ++nm ) if (tabName[nm-NAME_BASE_ADDR].inUse) { - StgVar v = name(nm).stgVar; - if (isStgVar(v) - && isPtr(stgVarInfo(v)) - && varHasClosure(v) - && closureOfVar(v) == closure) { + Cell cl = name(nm).closure; + if (isCPtr(cl) && cptrOf(cl) == closure) return textToStr(name(nm).text); - } } - return 0; + return NULL; } static void cgBindRep( AsmBCO bco, StgVar v, AsmRep rep ) @@ -112,77 +190,102 @@ static void cgBind( AsmBCO bco, StgVar v ) cgBindRep(bco,v,repOf(v)); } -static Void pushVar( AsmBCO bco, StgVar v ) +static void cgAddPtrToObject ( AsmObject obj, Cell ptrish ) { - Cell info; -#if 0 -printf ( "pushVar: %d ", v ); fflush(stdout); -print(v,10);printf("\n"); -#endif - assert(isStgVar(v) || isCPtr(v)); - - if (isCPtr(v)) { - asmGHCClosure(bco, cptrOf(v)); - } else { - info = stgVarInfo(v); - if (isPtr(info)) { - asmClosure(bco,ptrOf(info)); - } else if (isInt(info)) { - asmVar(bco,intOf(info),repOf(v)); - } else { - internal("pushVar"); - } - } + switch (whatIs(ptrish)) { + case CPTRCELL: + asmAddRefNoOp ( obj, (StgPtr)cptrOf(ptrish) ); break; + case MPTRCELL: + asmAddRefObject ( obj, mptrOf(ptrish) ); break; + default: + internal("cgAddPtrToObject"); + } } -static Void pushAtom( AsmBCO bco, StgAtom e ) +/* Get a pointer to atom e onto the stack. */ +static Void pushAtom ( AsmBCO bco, StgAtom e ) { -#if 0 -printf ( "pushAtom: %d ", e ); fflush(stdout); -print(e,10);printf("\n"); -#endif + Cell info; + Cell cl; +# if 0 + printf ( "pushAtom: %d ", e ); fflush(stdout); + print(e,10);printf("\n"); +# endif switch (whatIs(e)) { - case STGVAR: - pushVar(bco,e); - break; - case NAME: - if (nonNull(name(e).stgVar)) { - pushVar(bco,name(e).stgVar); - } else { - Cell /*CPtr*/ addr = cptrFromName(e); + case STGVAR: + info = stgVarInfo(e); + if (isInt(info)) { + asmVar(bco,intOf(info),repOf(e)); + } + else + if (isCPtr(info)) { + asmPushRefNoOp(bco,cptrOf(info)); + } + else + if (isMPtr(info)) { + asmPushRefObject(bco,mptrOf(info)); + } + else { + internal("pushAtom: STGVAR"); + } + break; + case NAME: + case TUPLE: + cl = getNameOrTupleClosure(e); + if (isStgVar(cl)) { + /* a stg tree which hasn't yet been translated */ + asmPushRefHugs(bco,e); + } + else + if (isCPtr(cl)) { + /* a pointer to something in the heap */ + asmPushRefNoOp(bco,(StgPtr)cptrOf(cl)); + } + else + if (isMPtr(cl)) { + /* a pointer to an AsmBCO/AsmCAF/AsmCon object */ + asmPushRefObject(bco,mptrOf(cl)); + } + else { + StgClosure* addr; + ASSERT(isNull(cl)); + addr = cptrFromName(e); # if DEBUG_CODEGEN fprintf ( stderr, "nativeAtom: name %s\n", - nameFromOPtr(cptrOf(addr)) ); + nameFromOPtr(addr) ); # endif - pushVar(bco,addr); + asmPushRefNoOp(bco,(StgPtr)addr); } break; - case CHARCELL: + case CHARCELL: asmConstChar(bco,charOf(e)); break; - case INTCELL: + case INTCELL: asmConstInt(bco,intOf(e)); break; - case BIGCELL: + case ADDRCELL: + asmConstAddr(bco,addrOf(e)); + break; + case BIGCELL: asmConstInteger(bco,bignumToString(e)); break; - case FLOATCELL: + case FLOATCELL: asmConstDouble(bco,floatOf(e)); break; - case STRCELL: -#if USE_ADDR_FOR_STRINGS + case STRCELL: +# if USE_ADDR_FOR_STRINGS asmConstAddr(bco,textToStr(textOf(e))); -#else +# else asmClosure(bco,asmStringObj(textToStr(textOf(e)))); -#endif +# endif break; - case CPTRCELL: - asmGHCClosure(bco,cptrOf(e)); + case CPTRCELL: + asmPushRefNoOp(bco,cptrOf(e)); break; - case PTRCELL: - asmConstAddr(bco,ptrOf(e)); + case MPTRCELL: + asmPushRefObject(bco,mptrOf(e)); break; - default: + default: fprintf(stderr,"\nYoiks1: "); printExp(stderr,e); internal("pushAtom"); } @@ -190,11 +293,7 @@ print(e,10);printf("\n"); static AsmBCO cgAlts( AsmSp root, AsmSp sp, List alts ) { -#ifdef CRUDE_PROFILING - AsmBCO bco = asmBeginContinuation(sp, currentTop + 1000000000); -#else AsmBCO bco = asmBeginContinuation(sp, alts); -#endif Bool omit_test = length(alts) == 2 && isDefaultAlt(hd(tl(alts))) && @@ -324,7 +423,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) case LAMBDA: { AsmSp begin = asmBeginEnter(bco); - asmClosure(bco,cgLambda(e)); + asmPushRefObject(bco,cgLambda(e)); asmEndEnter(bco,begin,root); break; } @@ -366,7 +465,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) /* only part different from primop code... todo */ AsmSp beginCase = asmBeginCase(bco); - pushVar(bco,scrut); + pushAtom /*pushVar*/ (bco,scrut); asmEndAlt(bco,beginCase); /* hack, hack - */ for(; nonNull(alts); alts=tl(alts)) { @@ -398,6 +497,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) asmEndEnter(bco,env,root); break; } + case TUPLE: case NAME: /* Tail call (with no args) */ { AsmSp env = asmBeginEnter(bco); @@ -413,7 +513,7 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) case BETA_REP: { AsmSp env = asmBeginEnter(bco); - pushVar(bco,e); + pushAtom /*pushVar*/ (bco,e); asmEndEnter(bco,env,root); break; } @@ -441,11 +541,6 @@ static Void cgExpr( AsmBCO bco, AsmSp root, StgExpr e ) } } -#define M_ITBLNAMES 35000 - -void* itblNames[M_ITBLNAMES]; -int nItblNames = 0; - /* allocate space for top level variable * any change requires a corresponding change in 'build'. */ @@ -465,20 +560,7 @@ static Void alloc( AsmBCO bco, StgVar v ) pushAtom(bco,hd(args)); setPos(v,asmBox(bco,boxingConRep(con))); } else { - - void* vv = stgConInfo(con); - if (!(nItblNames < (M_ITBLNAMES-2))) - internal("alloc -- M_ITBLNAMES too small"); - if (isName(con)) { - itblNames[nItblNames++] = vv; - itblNames[nItblNames++] = textToStr(name(con).text); - } else - if (isTuple(con)) { - itblNames[nItblNames++] = vv; - itblNames[nItblNames++] = textToStr(ghcTupleText(con)); - } else - assert ( /* cant identify constructor name */ 0 ); - setPos(v,asmAllocCONSTR(bco, vv)); + setPos(v,asmAllocCONSTR(bco,stgConInfo(con))); } break; } @@ -494,7 +576,6 @@ static Void alloc( AsmBCO bco, StgVar v ) } } setPos(v,asmAllocAP(bco,totSizeW)); - //ORIGINALLY:setPos(v,asmAllocAP(bco,length(stgAppArgs(rhs)))); break; } case LAMBDA: /* optimisation */ @@ -529,23 +610,12 @@ static Void build( AsmBCO bco, StgVar v ) { Bool itsaPAP; StgVar fun = stgAppFun(rhs); - StgVar fun0 = fun; List args = stgAppArgs(rhs); - if (isName(fun)) { - if (nonNull(name(fun).stgVar)) - fun = name(fun).stgVar; else - fun = cptrFromName(fun); - } - if (isCPtr(fun)) { - assert(isName(fun0)); - itsaPAP = name(fun0).arity > length(args); -# if DEBUG_CODEGEN - fprintf ( stderr, "nativeCall: name %s, arity %d, args %d\n", - nameFromOPtr(cptrOf(fun)), name(fun0).arity, - length(args) ); -# endif - } else { + if (isName(fun)) { + itsaPAP = name(fun).arity > length(args); + } else + if (isStgVar(fun)) { itsaPAP = FALSE; if (nonNull(stgVarBody(fun)) && whatIs(stgVarBody(fun)) == LAMBDA @@ -553,6 +623,8 @@ static Void build( AsmBCO bco, StgVar v ) ) itsaPAP = TRUE; } + else + internal("build: STGAPP"); if (itsaPAP) { AsmSp start = asmBeginMkPAP(bco); @@ -580,10 +652,6 @@ static Void build( AsmBCO bco, StgVar v ) * of this except "let x = x in ..." */ case NAME: - if (nonNull(name(rhs).stgVar)) - rhs = name(rhs).stgVar; else - rhs = cptrFromName(rhs); - /* fall thru */ case STGVAR: { AsmSp start = asmBeginMkAP(bco); @@ -594,7 +662,7 @@ static Void build( AsmBCO bco, StgVar v ) default: { AsmSp start = asmBeginMkAP(bco); /* make it updateable! */ - asmClosure(bco,cgRhs(rhs)); + asmPushRefObject(bco,cgRhs(rhs)); asmEndMkAP(bco,getPos(v),start); return; } @@ -608,18 +676,6 @@ static Void build( AsmBCO bco, StgVar v ) * for each top level variable - this should be simpler! * ------------------------------------------------------------------------*/ -#if 0 /* appears to be unused */ -static void cgAddVar( AsmObject obj, StgAtom v ) -{ - if (isName(v)) { - v = name(v).stgVar; - } - assert(isStgVar(v)); - asmAddPtr(obj,getObj(v)); -} -#endif - - /* allocate AsmObject for top level variables * any change requires a corresponding change in endTop */ @@ -630,146 +686,155 @@ static void beginTop( StgVar v ) currentTop = v; rhs = stgVarBody(v); switch (whatIs(rhs)) { - case STGCON: - { - //List as = stgConArgs(rhs); - setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs)))); - break; - } - case LAMBDA: -#ifdef CRUDE_PROFILING - setObj(v,asmBeginBCO(currentTop)); -#else - setObj(v,asmBeginBCO(rhs)); -#endif - break; - default: - setObj(v,asmBeginCAF()); - break; + case STGCON: + setObj(v,asmBeginCon(stgConInfo(stgConCon(rhs)))); + break; + case LAMBDA: + setObj(v,asmBeginBCO(rhs)); + break; + default: + setObj(v,asmBeginCAF()); + break; } } -static void endTop( StgVar v ) +static AsmObject endTop( StgVar v ) { StgRhs rhs = stgVarBody(v); currentTop = v; switch (whatIs(rhs)) { - case STGCON: - { - List as = stgConArgs(rhs); - AsmCon con = (AsmCon)getObj(v); - for( ; nonNull(as); as=tl(as)) { - StgAtom a = hd(as); - switch (whatIs(a)) { + case STGCON: { + List as = stgConArgs(rhs); + AsmCon con = (AsmCon)getObj(v); + for ( ; nonNull(as); as=tl(as)) { + StgAtom a = hd(as); + switch (whatIs(a)) { case STGVAR: - /* should be a delayed combinator! */ - asmAddPtr(con,(AsmObject)getObj(a)); - break; - case NAME: - { - StgVar var = name(a).stgVar; - assert(var); - asmAddPtr(con,(AsmObject)getObj(a)); - break; - } -#if !USE_ADDR_FOR_STRINGS + /* should be a delayed combinator! */ + asmAddRefObject(con,(AsmObject)getObj(a)); + break; + case NAME: { + StgVar var = name(a).closure; + cgAddPtrToObject(con,var); + break; + } +# if !USE_ADDR_FOR_STRINGS case STRCELL: - asmAddPtr(con,asmStringObj(textToStr(textOf(a)))); - break; -#endif + asmAddPtr(con,asmStringObj(textToStr(textOf(a)))); + break; +# endif default: - /* asmAddPtr(con,??); */ - assert(0); - break; - } - } - asmEndCon(con); - break; - } - case LAMBDA: /* optimisation */ - { - /* ToDo: merge this code with cgLambda */ - AsmBCO bco = (AsmBCO)getObj(v); - AsmSp root = asmBeginArgCheck(bco); - map1Proc(cgBind,bco,reverse(stgLambdaArgs(rhs))); - asmEndArgCheck(bco,root); - - cgExpr(bco,root,stgLambdaBody(rhs)); + /* asmAddPtr(con,??); */ + assert(0); + break; + } + } + asmEndCon(con); + return con; + } + case LAMBDA: { /* optimisation */ + /* ToDo: merge this code with cgLambda */ + AsmBCO bco = (AsmBCO)getObj(v); + AsmSp root = asmBeginArgCheck(bco); + map1Proc(cgBind,bco,reverse(stgLambdaArgs(rhs))); + asmEndArgCheck(bco,root); - asmEndBCO(bco); - break; - } - default: /* updateable caf */ - { - AsmCAF caf = (AsmCAF)getObj(v); - asmEndCAF(caf,cgRhs(rhs)); - break; - } + cgExpr(bco,root,stgLambdaBody(rhs)); + + asmEndBCO(bco); + return bco; + } + default: { /* updateable caf */ + AsmCAF caf = (AsmCAF)getObj(v); + asmAddRefObject ( caf, cgRhs(rhs) ); + asmEndCAF(caf); + return caf; + } } } -static void zap( StgVar v ) -{ - // ToDo: reinstate - // stgVarBody(v) = NIL; -} -/* external entry point */ -Void cgBinds( List binds ) +/* -------------------------------------------------------------------------- + * The external entry points for the code generator. + * ------------------------------------------------------------------------*/ + +Void cgModule ( Module mod ) { - List b; + List cl; + Cell c; int i; -#if 0 - if (lastModule() != modulePrelude) { - printf("\n\ncgBinds: before ll\n\n" ); - for (b=binds; nonNull(b); b=tl(b)) { - printStg ( stdout, hd(b) ); printf("\n\n"); - } + /* Lambda-lift, by traversing the code list of this module. + This creates more name-table entries, which are duly added + to the module's code list. + */ + liftModule ( mod ); + + /* Initialise the BCO linker subsystem. */ + asmInitialise(); + + /* Generate BCOs, CAFs and Constructors into mallocville. + At this point, the .closure values of the names/tycons on + the codelist contain StgVars, ie trees. The call to beginTop + converts them to MPtrs to AsmObjects. + */ + for (cl=module(mod).codeList; nonNull(cl); cl=tl(cl)) { + c = getNameOrTupleClosure(hd(cl)); + if (isCPtr(c)) continue; +# if 0 + if (isName(hd(cl))) { + printStg( stdout, name(hd(cl)).closure ); printf( "\n\n"); + } +# endif + beginTop ( c ); } -#endif - binds = liftBinds(binds); - -#if 0 - if (lastModule() != modulePrelude) { - printf("\n\ncgBinds: after ll\n\n" ); - for (b=binds; nonNull(b); b=tl(b)) { - printStg ( stdout, hd(b) ); printf("\n\n"); - } + for (cl=module(mod).codeList; nonNull(cl); cl=tl(cl)) { + c = getNameOrTupleClosure(hd(cl)); + if (isCPtr(c)) continue; +# if 0 + if (isName(hd(cl))) { + printStg( stdout, name(hd(cl)).closure ); printf( "\n\n"); + } +# endif + setNameOrTupleClosure ( hd(cl), mkMPtr(endTop(c)) ); } -#endif - for (b=binds,i=0; nonNull(b); b=tl(b),i++) { - /* printStg( stdout, hd(b) ); printf( "\n\n"); */ - beginTop(hd(b)); + //fprintf ( stderr, "\nstarting sanity check\n" ); + for (cl = module(mod).codeList; nonNull(cl); cl=tl(cl)) { + Cell c = hd(cl); + ASSERT(isName(c) || isTuple(c)); + c = getNameOrTupleClosure(c); + ASSERT(isMPtr(c) || isCPtr(c)); } - - for (b=binds,i=0; nonNull(b); b=tl(b),i++) { - /* printStg( stdout, hd(b) ); printf( "\n\n"); */ - endTop(hd(b)); + //fprintf ( stderr, "completed sanity check\n" ); + + + /* Figure out how big each object will be in the evaluator's heap, + and allocate space to put each in, but don't copy yet. Record + the heap address in the object. Assumes that GC doesn't happen; + reasonable since we use allocate(). + */ + asmAllocateHeapSpace(); + + /* Update name/tycon table closure entries with these new heap addrs. */ + for (cl = module(mod).codeList; nonNull(cl); cl=tl(cl)) { + c = getNameOrTupleClosure(hd(cl)); + if (isMPtr(c)) + setNameOrTupleClosureCPtr ( + hd(cl), asmGetClosureOfObject(mptrOf(c)) ); } - /* mapProc(zap,binds); */ -} + /* Copy out of mallocville into the heap, resolving references on + the way. + */ + asmCopyAndLink(); -/* Called by the evaluator's GC to tell Hugs to mark stuff in the - run-time heap. -*/ -void markHugsObjects( void ) -{ - extern Name nameHw; - Name nm; - for ( nm = NAME_BASE_ADDR; - nm < NAME_BASE_ADDR+tabNameSz; ++nm ) - if (tabName[nm-NAME_BASE_ADDR].inUse) { - StgVar v = name(nm).stgVar; - if (isStgVar(v) && isPtr(stgVarInfo(v))) { - asmMarkObject(ptrOf(stgVarInfo(v))); - } - } + /* Free up the malloc'd memory. */ + asmShutdown(); } + /* -------------------------------------------------------------------------- * Code Generator control: * ------------------------------------------------------------------------*/ @@ -777,11 +842,10 @@ void markHugsObjects( void ) Void codegen(what) Int what; { switch (what) { - case PREPREL: - case RESET: - case MARK: - case POSTPREL: - break; + case PREPREL: break; + case RESET: break; + case MARK: break; + case POSTPREL: break; } liftControl(what); }