Don't create a new infotable for every constructor application.
Amazingly, that's what the codegen.c used to do. It didn't generate
vast numbers of redundant infotables until recently, when I changed
translate.c to generate saturated constructor applications in line.
Prior to that, there was only ever one application of each constructor,
so the old scheme was ok.
Also, fix the assembler so that info table ptrs are commoned up.
Eg, for [1,2,3], store only one copy of the address of the (:) itbl,
rather than 3, in the BCO.
* included in the distribution.
*
* $RCSfile: stg.c,v $
* included in the distribution.
*
* $RCSfile: stg.c,v $
- * $Revision: 1.9 $
- * $Date: 1999/11/29 18:59:32 $
+ * $Revision: 1.10 $
+ * $Date: 1999/12/07 11:14:56 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
* ------------------------------------------------------------------------*/
#include "prelude.h"
void* stgConInfo( StgDiscr d )
{
switch (whatIs(d)) {
void* stgConInfo( StgDiscr d )
{
switch (whatIs(d)) {
- case NAME:
- return asmMkInfo(cfunOf(d),name(d).arity);
- case TUPLE:
- return asmMkInfo(0,tupleOf(d));
- default:
- internal("stgConInfo");
+ case NAME:
+ if (!name(d).itbl)
+ name(d).itbl = asmMkInfo(cfunOf(d),name(d).arity);
+ return name(d).itbl;
+ case TUPLE:
+ if (!tycon(d).itbl)
+ tycon(d).itbl = asmMkInfo(0,tupleOf(d));
+ return tycon(d).itbl;
+ default:
+ internal("stgConInfo");
* included in the distribution.
*
* $RCSfile: storage.c,v $
* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.23 $
- * $Date: 1999/12/06 16:47:07 $
+ * $Revision: 1.24 $
+ * $Date: 1999/12/07 11:14:57 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
* ------------------------------------------------------------------------*/
#include "prelude.h"
tycon(tyconHw).tagToCon = NIL;
tycon(tyconHw).tuple = -1;
tycon(tyconHw).mod = currentModule;
tycon(tyconHw).tagToCon = NIL;
tycon(tyconHw).tuple = -1;
tycon(tyconHw).mod = currentModule;
+ tycon(tyconHw).itbl = NULL;
module(currentModule).tycons = cons(tyconHw,module(currentModule).tycons);
tycon(tyconHw).nextTyconHash = tyconHash[h];
tyconHash[h] = tyconHw;
module(currentModule).tycons = cons(tyconHw,module(currentModule).tycons);
tycon(tyconHw).nextTyconHash = tyconHash[h];
tyconHash[h] = tyconHw;
name(nameHw).type = NIL;
name(nameHw).primop = 0;
name(nameHw).mod = currentModule;
name(nameHw).type = NIL;
name(nameHw).primop = 0;
name(nameHw).mod = currentModule;
+ name(nameHw).itbl = NULL;
module(currentModule).names=cons(nameHw,module(currentModule).names);
name(nameHw).nextNameHash = nameHash[h];
nameHash[h] = nameHw;
module(currentModule).names=cons(nameHw,module(currentModule).names);
name(nameHw).nextNameHash = nameHash[h];
nameHash[h] = nameHw;
* included in the distribution.
*
* $RCSfile: storage.h,v $
* included in the distribution.
*
* $RCSfile: storage.h,v $
- * $Revision: 1.18 $
- * $Date: 1999/12/06 16:47:09 $
+ * $Revision: 1.19 $
+ * $Date: 1999/12/07 11:14:58 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
Cell defn;
Name conToTag; /* used in derived code */
Name tagToCon;
Cell defn;
Name conToTag; /* used in derived code */
Name tagToCon;
+ void* itbl; /* For tuples, the info tbl pointer */
Int number;
Cell type;
Cell defn;
Int number;
Cell type;
Cell defn;
- Cell stgVar; /* really StgVar */
- Text callconv; /* for foreign import/export */
- void* primop; /* really StgPrim* */
+ Cell stgVar; /* really StgVar */
+ Text callconv; /* for foreign import/export */
+ void* primop; /* really StgPrim* */
+ void* itbl; /* For constructors, the info tbl pointer */
* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
* Copyright (c) 1994-1998.
*
* $RCSfile: Assembler.c,v $
- * $Revision: 1.19 $
- * $Date: 1999/11/29 18:59:40 $
+ * $Revision: 1.20 $
+ * $Date: 1999/12/07 11:15:00 $
*
* This module provides functions to construct BCOs and other closures
* required by the bytecode compiler.
*
* This module provides functions to construct BCOs and other closures
* required by the bytecode compiler.
#define Queue Instrs
#define Type StgWord8
#define Queue Instrs
#define Type StgWord8
#include "QueueTemplate.h"
#include "QueueTemplate.h"
#undef Type
#undef Queue
#define Queue Ptrs
#define Type AsmObject
#undef Type
#undef Queue
#define Queue Ptrs
#define Type AsmObject
#include "QueueTemplate.h"
#include "QueueTemplate.h"
#undef Type
#undef Queue
#define Queue Refs
#define Type AsmRef
#undef Type
#undef Queue
#define Queue Refs
#define Type AsmRef
#include "QueueTemplate.h"
#include "QueueTemplate.h"
#undef Type
#undef Queue
#define Queue NonPtrs
#define Type StgWord
#undef Type
#undef Queue
#define Queue NonPtrs
#define Type StgWord
#include "QueueTemplate.h"
#include "QueueTemplate.h"
insertNonPtrs( &bco->nps, i );
}
insertNonPtrs( &bco->nps, i );
}
+static int asmFindInNonPtrs ( AsmBCO bco, StgWord i )
+{
+ return findInNonPtrs ( &bco->nps, i );
+}
+
#define asmWords(bco,ty,x) \
{ \
union { ty a; AsmWord b[sizeofW(ty)]; } p; \
#define asmWords(bco,ty,x) \
{ \
union { ty a; AsmWord b[sizeofW(ty)]; } p; \
AsmVar asmAllocCONSTR ( AsmBCO bco, AsmInfo info )
{
AsmVar asmAllocCONSTR ( AsmBCO bco, AsmInfo info )
{
ASSERT( sizeW_fromITBL(info) >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
ASSERT( sizeW_fromITBL(info) >= MIN_NONUPD_SIZE + sizeofW(StgHeader) );
- emiti_8(bco,i_ALLOC_CONSTR,bco->nps.len);
- asmWords(bco,AsmInfo,info);
+
+ /* Look in this bco's collection of nonpointers (literals)
+ to see if the itbl pointer is already there. If so, re-use it. */
+ i = asmFindInNonPtrs ( bco, (StgWord)info );
+
+ if (i == -1) {
+ emiti_8(bco,i_ALLOC_CONSTR,bco->nps.len);
+ asmWords(bco,AsmInfo,info);
+ } else {
+ emiti_8(bco,i_ALLOC_CONSTR,i);
+ }
+
incSp(bco, sizeofW(StgClosurePtr));
grabHpNonUpd(bco,sizeW_fromITBL(info));
return bco->sp;
incSp(bco, sizeofW(StgClosurePtr));
grabHpNonUpd(bco,sizeW_fromITBL(info));
return bco->sp;
/* -----------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $Id: QueueTemplate.h,v 1.4 1999/04/27 10:07:19 sewardj Exp $
+ * $Id: QueueTemplate.h,v 1.5 1999/12/07 11:15:02 sewardj Exp $
*
* (c) The GHC Team, 1998
*
*
* (c) The GHC Team, 1998
*
* static void freeQueue ( Queue* q );
*
* $RCSfile: QueueTemplate.h,v $
* static void freeQueue ( Queue* q );
*
* $RCSfile: QueueTemplate.h,v $
- * $Revision: 1.4 $
- * $Date: 1999/04/27 10:07:19 $
+ * $Revision: 1.5 $
+ * $Date: 1999/12/07 11:15:02 $
*
* ------------------------------------------------------------------------*/
*
* ------------------------------------------------------------------------*/
+#if MAKE_findIn
+static int mycat2(findIn,Queue)( Queue* q, Type x )
+{
+ nat i;
+ for (i = 0; i < q->len; i++)
+ if (q->elems[i] == x) return i;
+ return -1;
+}
+#endif
+
static void mycat2(init,Queue)( Queue* q )
{
q->len = 0;
static void mycat2(init,Queue)( Queue* q )
{
q->len = 0;