* included in the distribution.
*
* $RCSfile: storage.c,v $
- * $Revision: 1.26 $
- * $Date: 1999/12/16 16:34:43 $
+ * $Revision: 1.35 $
+ * $Date: 2000/01/10 17:06:41 $
* ------------------------------------------------------------------------*/
#include "prelude.h"
#include "backend.h"
#include "connect.h"
#include "errors.h"
+#include "object.h"
#include <setjmp.h>
/*#define DEBUG_SHOWUSE*/
Tycon addTycon(tc) /* Insert Tycon in tycon table - if no clash is caused */
Tycon tc; {
- Tycon oldtc = findTycon(tycon(tc).text);
+ Tycon oldtc;
+ assert(whatIs(tc)==TYCON || whatIs(tc)==TUPLE);
+ oldtc = findTycon(tycon(tc).text);
if (isNull(oldtc)) {
hashTycon(tc);
module(currentModule).tycons=cons(tc,module(currentModule).tycons);
static Void local hashTycon(tc) /* Insert Tycon into hash table */
Tycon tc; {
- assert(isTycon(tc) || isTuple(tc));
+ if (!(isTycon(tc) || isTuple(tc))) {
+ printf("\nbad stuff: " ); print(tc,10); printf("\n");
+ assert(isTycon(tc) || isTuple(tc));
+ }
if (1) {
Text t = tycon(tc).text;
Int h = tHash(t);
Name addName(nm) /* Insert Name in name table - if */
Name nm; { /* no clash is caused */
- Name oldnm = findName(name(nm).text);
+ Name oldnm;
+ assert(whatIs(nm)==NAME);
+ oldnm = findName(name(nm).text);
if (isNull(oldnm)) {
hashName(nm);
module(currentModule).names=cons(nm,module(currentModule).names);
Tycon addTupleTycon ( Int n )
{
- Int i;
- Kind k;
- Tycon t;
+ Int i;
+ Kind k;
+ Tycon t;
Module m;
+ Name nm;
for (i = TYCMIN; i < tyconHw; i++)
if (tycon(i).tuple == n) return i;
tycon(t).kind = k;
tycon(t).tuple = n;
tycon(t).what = DATATYPE;
+
+ if (n == 0) {
+ /* maybe we want to do this for all n ? */
+ nm = newName(ghcTupleText_n(n), t);
+ name(nm).type = t; /* ummm ... for n > 0 */
+ }
+
return t;
}
Class addClass(c) /* Insert Class in class list */
Class c; { /* - if no clash caused */
- Class oldc = findClass(cclass(c).text);
+ Class oldc;
+ assert(whatIs(c)==CLASS);
+ oldc = findClass(cclass(c).text);
if (isNull(oldc)) {
classes=cons(c,classes);
module(currentModule).classes=cons(c,module(currentModule).classes);
return NIL;
}
+Tycon findTyconInAnyModule ( Text t )
+{
+ Tycon tc;
+ for (tc = TYCMIN; tc < tyconHw; tc++)
+ if (tycon(tc).text == t) return tc;
+ return NIL;
+}
+
+Class findClassInAnyModule ( Text t )
+{
+ Class cc;
+ for (cc = CLASSMIN; cc < classHw; cc++)
+ if (cclass(cc).text == t) return cc;
+ return NIL;
+}
+
+Name findNameInAnyModule ( Text t )
+{
+ Name nm;
+ for (nm = NAMEMIN; nm < nameHw; nm++)
+ if (name(nm).text == t) return nm;
+ return NIL;
+}
/* Same deal, except for Names. */
Name findQualNameWithoutConsultingExportList ( QualId q )
ERRMSG(0) "Module storage space exhausted"
EEND;
}
- module(moduleHw).text = t; /* clear new module record */
- module(moduleHw).qualImports = NIL;
- module(moduleHw).fake = FALSE;
- module(moduleHw).exports = NIL;
- module(moduleHw).tycons = NIL;
- module(moduleHw).names = NIL;
- module(moduleHw).classes = NIL;
- module(moduleHw).oImage = NULL;
- module(moduleHw).oTab = NULL;
- module(moduleHw).sizeoTab = 0;
- module(moduleHw).usedoTab = 0;
- module(moduleHw).dlTab = NULL;
- module(moduleHw).sizedlTab = 0;
- module(moduleHw).useddlTab = 0;
+ module(moduleHw).text = t; /* clear new module record */
+ module(moduleHw).qualImports = NIL;
+ module(moduleHw).fake = FALSE;
+ module(moduleHw).exports = NIL;
+ module(moduleHw).tycons = NIL;
+ module(moduleHw).names = NIL;
+ module(moduleHw).classes = NIL;
+ module(moduleHw).object = NULL;
+ module(moduleHw).objectExtras = NULL;
+ module(moduleHw).objectExtraNames = NIL;
return moduleHw++;
}
}
-/* A bit tricky. Assumes that if tab==NULL, then
- currUsed and *currSize must be zero.
-*/
-static
-void* genericExpand ( void* tab,
- int* currSize, int currUsed,
- int initSize, int elemSize )
+char* nameFromOPtr ( void* p )
{
- int size2;
- void* tab2;
- if (currUsed < *currSize)
- return tab;
- size2 = (*currSize == 0) ? initSize : (2 * *currSize);
- tab2 = malloc ( size2 * elemSize );
- if (!tab2) {
- ERRMSG(0) "Can't allocate enough memory to resize a table"
- EEND;
+ int i;
+ Module m;
+ for (m=MODMIN; m<moduleHw; m++) {
+ char* nm = ocLookupAddr ( module(m).object, p );
+ if (nm) return nm;
}
- if (*currSize > 0)
- memcpy ( tab2, tab, elemSize * *currSize );
- *currSize = size2;
- if (tab) free ( tab );
- return tab2;
-}
-
-void addOTabName ( Module m, char* nm, void* ad )
-{
- module(m).oTab
- = genericExpand ( module(m).oTab,
- &module(m).sizeoTab,
- module(m).usedoTab,
- 8, sizeof(OSym) );
-
- module(m).oTab[ module(m).usedoTab ].nm = nm;
- module(m).oTab[ module(m).usedoTab ].ad = ad;
- module(m).usedoTab++;
+ return NULL;
}
-void addDLSect ( Module m, void* start, void* end, DLSect sect )
+void* lookupOTabName ( Module m, char* sym )
{
- module(m).dlTab
- = genericExpand ( module(m).dlTab,
- &module(m).sizedlTab,
- module(m).useddlTab,
- 4, sizeof(DLTabEnt) );
- module(m).dlTab[ module(m).useddlTab ].start = start;
- module(m).dlTab[ module(m).useddlTab ].end = end;
- module(m).dlTab[ module(m).useddlTab ].sect = sect;
- module(m).useddlTab++;
+ return ocLookupSym ( module(m).object, sym );
}
-void* lookupOTabName ( Module m, char* nm )
+void* lookupOExtraTabName ( char* sym )
{
- int i;
- for (i = 0; i < module(m).usedoTab; i++) {
- if (0)
- fprintf ( stderr,
- "lookupOTabName: request %s, table has %s\n",
- nm, module(m).oTab[i].nm );
- if (0==strcmp(nm,module(m).oTab[i].nm))
- return module(m).oTab[i].ad;
+ ObjectCode* oc;
+ Module m;
+ for (m = MODMIN; m < moduleHw; m++) {
+ for (oc = module(m).objectExtras; oc; oc=oc->next) {
+ void* ad = ocLookupSym ( oc, sym );
+ if (ad) return ad;
+ }
}
return NULL;
}
-char* nameFromOPtr ( void* p )
-{
- int i;
- Module m;
- for (m=MODMIN; m<moduleHw; m++)
- for (i = 0; i < module(m).usedoTab; i++)
- if (p == module(m).oTab[i].ad)
- return module(m).oTab[i].nm;
- return NULL;
-}
-
-
-DLSect lookupDLSect ( void* ad )
+OSectionKind lookupSection ( void* ad )
{
int i;
Module m;
- for (m=MODMIN; m<moduleHw; m++)
- for (i = 0; i < module(m).useddlTab; i++)
- if (module(m).dlTab[i].start <= ad &&
- ad <= module(m).dlTab[i].end)
- return module(m).dlTab[i].sect;
- return HUGS_DL_SECTION_OTHER;
+ for (m=MODMIN; m<moduleHw; m++) {
+ OSectionKind sect
+ = ocLookupSection ( module(m).object, ad );
+ if (sect != HUGS_SECTIONKIND_NOINFOAVAIL)
+ return sect;
+ }
+ return HUGS_SECTIONKIND_OTHER;
}
mark(module(i).classes);
mark(module(i).exports);
mark(module(i).qualImports);
+ mark(module(i).objectExtraNames);
}
end("Modules", moduleHw-MODMIN);
projects / ghc-hetmet.git / blobdiff