Commit 6478af6d authored by sewardj's avatar sewardj
Browse files

[project @ 1999-12-07 11:14:56 by sewardj]

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.
parent e03c0dd3
......@@ -9,8 +9,8 @@
* 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"
......@@ -28,12 +28,16 @@
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");
}
}
......
......@@ -9,8 +9,8 @@
* 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"
......@@ -468,6 +468,7 @@ Text t; {
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;
......@@ -659,6 +660,7 @@ Cell parent; {
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;
......
......@@ -10,8 +10,8 @@
* 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 $
* ------------------------------------------------------------------------*/
/* --------------------------------------------------------------------------
......@@ -500,6 +500,7 @@ struct strTycon {
Cell defn;
Name conToTag; /* used in derived code */
Name tagToCon;
void* itbl; /* For tuples, the info tbl pointer */
Tycon nextTyconHash;
};
......@@ -540,9 +541,10 @@ struct strName {
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;
};
......
......@@ -5,8 +5,8 @@
* 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.
......@@ -79,25 +79,33 @@ typedef struct {
#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
......@@ -467,6 +475,11 @@ static void asmWord( AsmBCO bco, StgWord 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; \
......@@ -1560,9 +1573,20 @@ AsmBCO asm_BCO_takeMVar ( void )
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
*
......@@ -16,8 +16,8 @@
* 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 $
*
* ------------------------------------------------------------------------*/
......@@ -37,6 +37,16 @@ typedef struct {
} 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;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment