X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstorage.c;h=9fa88ddf00f9f2b77f335880e8548f073502526e;hb=f7f84ac7dab583cce112db5e4709fb42d63d3bd1;hp=a8318ca35ee4f1772a0408957c9cc65cba324bc0;hpb=0c97d6499a6df25503df68181a18507bff234514;p=ghc-hetmet.git diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c index a8318ca..9fa88dd 100644 --- a/ghc/interpreter/storage.c +++ b/ghc/interpreter/storage.c @@ -9,8 +9,8 @@ * included in the distribution. * * $RCSfile: storage.c,v $ - * $Revision: 1.26 $ - * $Date: 1999/12/16 16:34:43 $ + * $Revision: 1.37 $ + * $Date: 2000/01/11 14:51:43 $ * ------------------------------------------------------------------------*/ #include "prelude.h" @@ -18,6 +18,7 @@ #include "backend.h" #include "connect.h" #include "errors.h" +#include "object.h" #include /*#define DEBUG_SHOWUSE*/ @@ -487,7 +488,9 @@ Text t; { 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); @@ -498,7 +501,10 @@ Tycon tc; { 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); @@ -667,7 +673,9 @@ Text 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); @@ -795,10 +803,11 @@ Name addWiredInBoxingTycon 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; @@ -814,6 +823,13 @@ Tycon addTupleTycon ( Int n ) 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; } @@ -1046,7 +1062,9 @@ Text 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); @@ -1191,6 +1209,29 @@ Tycon findQualTyconWithoutConsultingExportList ( QualId q ) 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 ) @@ -1328,20 +1369,16 @@ Text t; { 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++; } @@ -1427,96 +1464,60 @@ Name jrsFindQualName ( Text mn, Text sn ) } -/* 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 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 ) +OSectionKind lookupSection ( void* ad ) { - int i; - Module m; - for (m=MODMIN; mnext) { + sect = ocLookupSection ( oc, ad ); + if (sect != HUGS_SECTIONKIND_NOINFOAVAIL) + return sect; + } + } + return HUGS_SECTIONKIND_OTHER; } @@ -3031,6 +3032,7 @@ Int what; { mark(module(i).classes); mark(module(i).exports); mark(module(i).qualImports); + mark(module(i).objectExtraNames); } end("Modules", moduleHw-MODMIN);