X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Finterpreter%2Fstorage.c;h=2bc407baa7039cbec4a832999de99b91137fd48b;hb=810bbf81f6446cf6770a1de6a8b2e970fb69fec8;hp=1ee4eb80a1cc215877d8df99e41b3a07d16ee220;hpb=391358678567341041284d0062ea606552460a14;p=ghc-hetmet.git

diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 1ee4eb8..2bc407b 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.22 $
- * $Date: 1999/12/06 16:25:25 $
+ * $Revision: 1.35 $
+ * $Date: 2000/01/10 17:06:41 $
  * ------------------------------------------------------------------------*/
 
 #include "prelude.h"
@@ -18,6 +18,7 @@
 #include "backend.h"
 #include "connect.h"
 #include "errors.h"
+#include "object.h"
 #include <setjmp.h>
 
 /*#define DEBUG_SHOWUSE*/
@@ -468,6 +469,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;
@@ -486,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);
@@ -497,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);
@@ -577,20 +584,27 @@ List   ts; {                            /* Null pattern matches every tycon*/
     return ts;
 }
 
-Text ghcTupleText(tup)
-Tycon tup; {
+Text ghcTupleText_n ( Int n )
+{
     Int  i;
-    char buf[103];
-    assert(isTuple(tup));
-    tup = tupleOf(tup);
-    if (tup >= 100) internal("ghcTupleText");
+    char buf[104];
+    if (n < 0 || n >= 100) internal("ghcTupleText_n");
     buf[0] = '(';
-    for (i = 1; i <= tup; i++) buf[i] = ',';
-    buf[i] = ')';
-    buf[i+1] = 0;
+    for (i = 1; i <= n; i++) buf[i] = ',';
+    buf[n+1] = ')';
+    buf[n+2] = 0;
     return findText(buf);
 }
 
+Text ghcTupleText(tup)
+Tycon tup; {
+    if (!isTuple(tup)) {
+       assert(isTuple(tup));
+    }
+    return ghcTupleText_n ( tupleOf(tup) );
+}
+
+
 Tycon mkTuple ( Int n )
 {
    Int i;
@@ -601,24 +615,6 @@ Tycon mkTuple ( Int n )
    internal("mkTuple: request for non-existent tuple");
 }
 
-Void allocTupleTycon ( Int n )
-{
-   Int   i;
-   char  buf[20];
-   Kind  k;
-   Tycon t;
-   for (i = TYCMIN; i < tyconHw; i++)
-      if (tycon(i).tuple == n) return;
-   sprintf(buf,"Tuple%d",n);
-   //t = addPrimTycon(findText(buf),simpleKind(n),n, DATATYPE,NIL);
-
-   k = STAR;
-   for (i = 0; i < n; i++) k = ap(STAR,k);
-   t = newTycon(findText(buf));
-   tycon(t).kind = k;
-   tycon(t).tuple = n;
-   tycon(t).what = DATATYPE;
-}
 
 /* --------------------------------------------------------------------------
  * Name storage:
@@ -659,6 +655,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;
@@ -676,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);
@@ -765,6 +764,103 @@ void* getHugs_AsmObject_for ( char* s )
  * Primitive functions:
  * ------------------------------------------------------------------------*/
 
+Module findFakeModule ( Text t )
+{
+   Module m = findModule(t);
+   if (nonNull(m)) {
+      if (!module(m).fake) internal("findFakeModule");
+   } else {
+      m = newModule(t);
+      module(m).fake = TRUE;
+   }
+   return m;
+}
+
+
+Name addWiredInBoxingTycon
+        ( String modNm, String typeNm, String constrNm,
+          Int arity, Int no, Int rep )
+{
+   Name  n;
+   Tycon t;
+   Text modT  = findText(modNm);
+   Text typeT = findText(typeNm);
+   Text conT  = findText(constrNm);
+   Module m = findFakeModule(modT);
+   setCurrModule(m);
+   
+   n = newName(conT,NIL);
+   name(n).arity = arity;
+   name(n).number = cfunNo(no);
+   name(n).type = NIL;
+   name(n).primop = (void*)rep;
+
+   t = newTycon(typeT);
+   tycon(t).what = DATATYPE;
+   return n;
+}
+
+
+Tycon addTupleTycon ( Int n )
+{
+   Int    i;
+   Kind   k;
+   Tycon  t;
+   Module m;
+   Name   nm;
+
+   for (i = TYCMIN; i < tyconHw; i++)
+      if (tycon(i).tuple == n) return i;
+
+   if (combined)
+      m = findFakeModule(findText(n==0 ? "PrelBase" : "PrelTup")); else
+      m = findModule(findText("Prelude"));
+
+   setCurrModule(m);
+   k = STAR;
+   for (i = 0; i < n; i++) k = ap(STAR,k);
+   t = newTycon(ghcTupleText_n(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;
+}
+
+
+Tycon addWiredInEnumTycon ( String modNm, String typeNm, 
+                            List /*of Text*/ constrs )
+{
+   Int    i;
+   Tycon  t;
+   Text   modT  = findText(modNm);
+   Text   typeT = findText(typeNm);
+   Module m     = findFakeModule(modT);
+   setCurrModule(m);
+
+   t             = newTycon(typeT);
+   tycon(t).kind = STAR;
+   tycon(t).what = DATATYPE;
+   
+   constrs = reverse(constrs);
+   i       = length(constrs);
+   for (; nonNull(constrs); constrs=tl(constrs),i--) {
+      Text conT        = hd(constrs);
+      Name con         = newName(conT,t);
+      name(con).number = cfunNo(i);
+      name(con).type   = t;
+      tycon(t).defn    = cons(con, tycon(t).defn);      
+   }
+   return t;
+}
+
+
 Name addPrimCfunREP(t,arity,no,rep)     /* add primitive constructor func  */
 Text t;                                 /* sets rep, not type              */
 Int  arity;
@@ -966,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);
@@ -1046,6 +1144,146 @@ Type tc; {
                          || typeInvolves(arg(ty),tc)));
 }
 
+
+/* Needed by finishGHCInstance to find classes, before the
+   export list has been built -- so we can't use 
+   findQualClass.
+*/
+Class findQualClassWithoutConsultingExportList ( QualId q )
+{
+   Class cl;
+   Text t_mod;
+   Text t_class;
+
+   assert(isQCon(q));
+
+   if (isCon(q)) {
+      t_mod   = NIL;
+      t_class = textOf(q);
+   } else {
+      t_mod   = qmodOf(q);
+      t_class = qtextOf(q);
+   }
+
+   for (cl = CLASSMIN; cl < classHw; cl++) {
+      if (cclass(cl).text == t_class) {
+         /* Class name is ok, but is this the right module? */
+         if (isNull(t_mod)   /* no module name specified */
+             || (nonNull(t_mod) 
+                 && t_mod == module(cclass(cl).mod).text)
+            )
+            return cl;
+      }
+   }
+   return NIL;
+}
+
+
+/* Same deal, except for Tycons. */
+Tycon findQualTyconWithoutConsultingExportList ( QualId q )
+{
+   Tycon tc;
+   Text t_mod;
+   Text t_tycon;
+
+   assert(isQCon(q));
+
+   if (isCon(q)) {
+      t_mod   = NIL;
+      t_tycon = textOf(q);
+   } else {
+      t_mod   = qmodOf(q);
+      t_tycon = qtextOf(q);
+   }
+
+   for (tc = TYCMIN; tc < tyconHw; tc++) {
+      if (tycon(tc).text == t_tycon) {
+         /* Tycon name is ok, but is this the right module? */
+         if (isNull(t_mod)   /* no module name specified */
+             || (nonNull(t_mod) 
+                 && t_mod == module(tycon(tc).mod).text)
+            )
+            return tc;
+      }
+   }
+   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 )
+{
+   Name nm;
+   Text t_mod;
+   Text t_name;
+
+   assert(isQVar(q) || isQCon(q));
+
+   if (isCon(q) || isVar(q)) {
+      t_mod  = NIL;
+      t_name = textOf(q);
+   } else {
+      t_mod  = qmodOf(q);
+      t_name = qtextOf(q);
+   }
+
+   for (nm = NAMEMIN; nm < nameHw; nm++) {
+      if (name(nm).text == t_name) {
+         /* Name is ok, but is this the right module? */
+         if (isNull(t_mod)   /* no module name specified */
+             || (nonNull(t_mod) 
+                 && t_mod == module(name(nm).mod).text)
+            )
+            return nm;
+      }
+   }
+   return NIL;
+}
+
+
+/* returns List of QualId */
+List getAllKnownTyconsAndClasses ( void )
+{
+   Tycon tc;
+   Class nw;
+   List  xs = NIL;
+   for (tc = TYCMIN; tc < tyconHw; tc++) {
+      /* almost certainly undue paranoia about duplicate avoidance, but .. */
+      QualId q = mkQCon( module(tycon(tc).mod).text, tycon(tc).text );
+      if (!qualidIsMember(q,xs))
+         xs = cons ( q, xs );
+   }
+   for (nw = CLASSMIN; nw < classHw; nw++) {
+      QualId q = mkQCon( module(cclass(nw).mod).text, cclass(nw).text );
+      if (!qualidIsMember(q,xs))
+         xs = cons ( q, xs );
+   }
+   return xs;
+}
+
 /* --------------------------------------------------------------------------
  * Control stack:
  *
@@ -1131,19 +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).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++;
 }
 
@@ -1229,96 +1464,49 @@ 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<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 (1)
-         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;
 }
 
 
@@ -1841,7 +2029,10 @@ register Cell c; {
         register Cell fstc = fst(c);
         return isTag(fstc) ? fstc : AP;
     }
-    if (c<TUPMIN)    return c;
+    if (c<OFFMIN)    return c;
+#if TREX
+    if (isExt(c))    return EXT;
+#endif
     if (c>=INTMIN)   return INTCELL;
 
     if (c>=NAMEMIN){if (c>=CLASSMIN)   {if (c>=CHARMIN) return CHARCELL;
@@ -1946,7 +2137,7 @@ Int  depth; {
                 Printf("Offset %d", offsetOf(c));
                 break;
         case TUPLE:
-                Printf("Tuple %d", tupleOf(c));
+                Printf("%s", textToStr(ghcTupleText(c)));
                 break;
         case POLYTYPE:
                 Printf("Polytype");
@@ -2078,6 +2269,22 @@ Int  depth; {
                 print(snd(c),depth-1);
                 Putchar(')');
                 break;
+        case ZTUP2:
+                Printf("<ZPair ");
+                print(zfst(c),depth-1);
+                Putchar(' ');
+                print(zsnd(c),depth-1);
+                Putchar('>');
+                break;
+        case ZTUP3:
+                Printf("<ZTriple ");
+                print(zfst3(c),depth-1);
+                Putchar(' ');
+                print(zsnd3(c),depth-1);
+                Putchar(' ');
+                print(zthd3(c),depth-1);
+                Putchar('>');
+                break;
         case BANG:
                 Printf("(BANG,");
                 print(snd(c),depth-1);
@@ -2145,6 +2352,16 @@ Cell c; {
     return isPair(c) && (fst(c)==QUALIDENT);
 }
 
+Bool eqQualIdent ( QualId c1, QualId c2 )
+{
+   assert(isQualIdent(c1));
+   if (!isQualIdent(c2)) {
+   assert(isQualIdent(c2));
+   }
+   return qmodOf(c1)==qmodOf(c2) &&
+          qtextOf(c1)==qtextOf(c2);
+}
+
 Bool isIdent(c)                        /* is cell an identifier?           */
 Cell c; {
     if (!isPair(c)) return FALSE;
@@ -2322,6 +2539,15 @@ List xs, ys; {                         /* list xs onto list ys...          */
     return ys;
 }
 
+QualId qualidIsMember ( QualId q, List xs )
+{
+   for (; nonNull(xs); xs=tl(xs)) {
+      if (eqQualIdent(q, hd(xs)))
+         return hd(xs);
+   }
+   return NIL;
+}  
+
 Cell varIsMember(t,xs)                 /* Test if variable is a member of  */
 Text t;                                /* given list of variables          */
 List xs; {
@@ -2475,6 +2701,133 @@ List xs; {                              /* non destructive                 */
    return outs;
 }
 
+
+/* --------------------------------------------------------------------------
+ * Strongly-typed lists (z-lists) and tuples (experimental)
+ * ------------------------------------------------------------------------*/
+
+static void z_tag_check ( Cell x, int tag, char* caller )
+{
+   char buf[100];
+   if (isNull(x)) {
+      sprintf(buf,"z_tag_check(%s): null\n", caller);
+      internal(buf);
+   }
+   if (whatIs(x) != tag) {
+      sprintf(buf, 
+          "z_tag_check(%s): tag was %d, expected %d\n",
+          caller, whatIs(x), tag );
+      internal(buf);
+   }  
+}
+
+#if 0
+Cell zcons ( Cell x, Cell xs )
+{
+   if (!(isNull(xs) || whatIs(xs)==ZCONS)) 
+      internal("zcons: ill typed tail");
+   return ap(ZCONS,ap(x,xs));
+}
+
+Cell zhd ( Cell xs )
+{
+   if (isNull(xs)) internal("zhd: empty list");
+   z_tag_check(xs,ZCONS,"zhd");
+   return fst( snd(xs) );
+}
+
+Cell ztl ( Cell xs )
+{
+   if (isNull(xs)) internal("ztl: empty list");
+   z_tag_check(xs,ZCONS,"zhd");
+   return snd( snd(xs) );
+}
+
+Int zlength ( ZList xs )
+{
+   Int n = 0;
+   while (nonNull(xs)) {
+      z_tag_check(xs,ZCONS,"zlength");
+      n++;
+      xs = snd( snd(xs) );
+   }
+   return n;
+}
+
+ZList zreverse ( ZList xs )
+{
+   ZList rev = NIL;
+   while (nonNull(xs)) {
+      z_tag_check(xs,ZCONS,"zreverse");
+      rev = zcons(zhd(xs),rev);
+      xs = ztl(xs);
+   }
+   return rev;
+}
+
+Cell zsingleton ( Cell x )
+{
+   return zcons (x,NIL);
+}
+
+Cell zdoubleton ( Cell x, Cell y )
+{
+   return zcons(x,zcons(y,NIL));
+}
+#endif
+
+Cell zpair ( Cell x1, Cell x2 )
+{ return ap(ZTUP2,ap(x1,x2)); }
+Cell zfst ( Cell zpair )
+{ z_tag_check(zpair,ZTUP2,"zfst"); return fst( snd(zpair) ); }
+Cell zsnd ( Cell zpair )
+{ z_tag_check(zpair,ZTUP2,"zsnd"); return snd( snd(zpair) ); }
+
+Cell ztriple ( Cell x1, Cell x2, Cell x3 )
+{ return ap(ZTUP3,ap(x1,ap(x2,x3))); }
+Cell zfst3 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP3,"zfst3"); return fst( snd(zpair) ); }
+Cell zsnd3 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP3,"zsnd3"); return fst(snd( snd(zpair) )); }
+Cell zthd3 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP3,"zthd3"); return snd(snd( snd(zpair) )); }
+
+Cell z4ble ( Cell x1, Cell x2, Cell x3, Cell x4 )
+{ return ap(ZTUP4,ap(x1,ap(x2,ap(x3,x4)))); }
+Cell zsel14 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP4,"zsel14"); return fst( snd(zpair) ); }
+Cell zsel24 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP4,"zsel24"); return fst(snd( snd(zpair) )); }
+Cell zsel34 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP4,"zsel34"); return fst(snd(snd( snd(zpair) ))); }
+Cell zsel44 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP4,"zsel44"); return snd(snd(snd( snd(zpair) ))); }
+
+Cell z5ble ( Cell x1, Cell x2, Cell x3, Cell x4, Cell x5 )
+{ return ap(ZTUP5,ap(x1,ap(x2,ap(x3,ap(x4,x5))))); }
+Cell zsel15 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP5,"zsel15"); return fst( snd(zpair) ); }
+Cell zsel25 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP5,"zsel25"); return fst(snd( snd(zpair) )); }
+Cell zsel35 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP5,"zsel35"); return fst(snd(snd( snd(zpair) ))); }
+Cell zsel45 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP5,"zsel45"); return fst(snd(snd(snd( snd(zpair) )))); }
+Cell zsel55 ( Cell zpair )
+{ z_tag_check(zpair,ZTUP5,"zsel55"); return snd(snd(snd(snd( snd(zpair) )))); }
+
+
+Cell unap ( int tag, Cell c )
+{
+   char buf[100];
+   if (whatIs(c) != tag) {
+      sprintf(buf, "unap: specified %d, actual %d\n",
+                   tag, whatIs(c) );
+      internal(buf);
+   }
+   return snd(c);
+}
+
 /* --------------------------------------------------------------------------
  * Operations on applications:
  * ------------------------------------------------------------------------*/
@@ -2633,6 +2986,8 @@ Int what; {
     Int i;
 
     switch (what) {
+        case POSTPREL: break;
+
         case RESET   : clearStack();
 
                        /* the next 2 statements are particularly important
@@ -2666,6 +3021,7 @@ Int what; {
                            mark(module(i).classes);
                            mark(module(i).exports);
                            mark(module(i).qualImports);
+                           mark(module(i).objectExtraNames);
                        }
                        end("Modules", moduleHw-MODMIN);
 
@@ -2720,7 +3076,7 @@ Int what; {
 
                        break;
 
-        case INSTALL : heapFst = heapAlloc(heapSize);
+        case PREPREL : heapFst = heapAlloc(heapSize);
                        heapSnd = heapAlloc(heapSize);
 
                        if (heapFst==(Heap)0 || heapSnd==(Heap)0) {