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 $
- * $Revision: 1.9 $
- * $Date: 1999/11/29 18:59:32 $
+ * $Revision: 1.10 $
+ * $Date: 1999/12/07 11:14:56 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
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 $
- * $Revision: 1.23 $
- * $Date: 1999/12/06 16:47:07 $
+ * $Revision: 1.24 $
+ * $Date: 1999/12/07 11:14:57 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
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;
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;
* 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;
+ void* itbl; /* For tuples, the info tbl pointer */
Tycon nextTyconHash;
};
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 */
Name nextNameHash;
};
* 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.
#define Queue Instrs
#define Type StgWord8
+#define MAKE_findIn 0
#include "QueueTemplate.h"
+#undef MAKE_findIn
#undef Type
#undef Queue
#define Queue Ptrs
#define Type AsmObject
+#define MAKE_findIn 0
#include "QueueTemplate.h"
+#undef MAKE_findIn
#undef Type
#undef Queue
#define Queue Refs
#define Type AsmRef
+#define MAKE_findIn 0
#include "QueueTemplate.h"
+#undef MAKE_findIn
#undef Type
#undef Queue
#define Queue NonPtrs
#define Type StgWord
+#define MAKE_findIn 1
#include "QueueTemplate.h"
+#undef MAKE_findIn
#undef Type
#undef Queue
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; \
AsmVar asmAllocCONSTR ( AsmBCO bco, AsmInfo info )
{
+ int i;
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;
/* -----------------------------------------------------------------------------
- * $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
*
* 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 $
*
* ------------------------------------------------------------------------*/
} Queue;
+#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;