From: sewardj <unknown>
Date: Fri, 7 Apr 2000 16:25:20 +0000 (+0000)
Subject: [project @ 2000-04-07 16:25:19 by sewardj]
X-Git-Tag: Approximately_9120_patches~4766
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8024af4b826b99febe00cd566c409087687b5ea7;p=ghc-hetmet.git

[project @ 2000-04-07 16:25:19 by sewardj]
If an object symbol is not found via the usual methods, search absolutely
every object symbol table in the system before giving up on it.
Motivation: searching for Arch_x86_foobar_closure generates a search for
x86_foobar_closure in module Arch, whereas we really want to search for
foobar_closure in module Arch_x86.  Sigh.
---

diff --git a/ghc/interpreter/interface.c b/ghc/interpreter/interface.c
index e2459a9..8e3b9e7 100644
--- a/ghc/interpreter/interface.c
+++ b/ghc/interpreter/interface.c
@@ -7,8 +7,8 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: interface.c,v $
- * $Revision: 1.48 $
- * $Date: 2000/04/07 09:59:36 $
+ * $Revision: 1.49 $
+ * $Date: 2000/04/07 16:25:19 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -2626,7 +2626,8 @@ Type type; {
       SymX(chdir)                    \
       SymX(execl)                    \
       Sym(waitpid)                   \
-      SymX(getenv)
+      SymX(getenv)                   \
+      Sym(chmod)
 
 #define EXTERN_SYMS_cygwin32         \
       SymX(GetCurrentProcess)        \
@@ -2764,30 +2765,34 @@ void* lookupObjName ( char* nm )
       t = unZcodeThenFindText(nm2+first_real_char+7);
       if (t == findText("PrelGHC")) return (4+NULL); /* kludge */
       m = findModule(t);
-      if (isNull(m)) goto not_found;
+      if (isNull(m)) goto dire_straits;
       a = lookupOTabName ( m, nm );
       if (a) return a;
-      goto not_found;
+      goto dire_straits;
    }
 
    /* if not an RTS name, look in the 
       relevant module's object symbol table
    */
    pp = strchr(nm2+first_real_char, '_');
-   if (!pp || !isupper(nm2[first_real_char])) goto not_found;
+   if (!pp || !isupper(nm2[first_real_char])) goto dire_straits;
    *pp = 0;
    t = unZcodeThenFindText(nm2+first_real_char);
    m = findModule(t);
-   if (isNull(m)) goto not_found;
+   if (isNull(m)) goto dire_straits;
 
    a = lookupOTabName ( m, nm );  /* RATIONALISE */
    if (a) return a;
 
-  not_found:
+  dire_straits:
+   /* make a desperate, last-ditch attempt to find it */
+   a = lookupOTabNameAbsolutelyEverywhere ( nm );
+   if (a) return a;
+
    fprintf ( stderr, 
              "lookupObjName: can't resolve name `%s'\n", 
              nm );
-   assert(4-4);
+   assert(0);
    return NULL;
 }
 
diff --git a/ghc/interpreter/storage.c b/ghc/interpreter/storage.c
index 06037e4..401168f 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.67 $
- * $Date: 2000/04/07 09:58:34 $
+ * $Revision: 1.68 $
+ * $Date: 2000/04/07 16:25:19 $
  * ------------------------------------------------------------------------*/
 
 #include "hugsbasictypes.h"
@@ -1828,6 +1828,31 @@ void* lookupOExtraTabName ( char* sym )
 }
 
 
+/* Only call this if in dire straits; searches every object symtab
+   in the system -- so is therefore slow.
+*/
+void* lookupOTabNameAbsolutelyEverywhere ( char* sym )
+{
+   ObjectCode* oc;
+   Module      m;
+   void*       ad;
+   for (m = MODULE_BASE_ADDR; 
+        m < MODULE_BASE_ADDR+tabModuleSz; m++) {
+      if (tabModule[m-MODULE_BASE_ADDR].inUse) {
+         if (module(m).object) {
+            ad = ocLookupSym ( module(m).object, sym );
+            if (ad) return ad;
+         }
+         for (oc = module(m).objectExtras; oc; oc=oc->next) {
+            ad = ocLookupSym ( oc, sym );
+            if (ad) return ad;
+         }
+      }
+   }
+   return NULL;
+}
+
+
 OSectionKind lookupSection ( void* ad )
 {
    int          i;
diff --git a/ghc/interpreter/storage.h b/ghc/interpreter/storage.h
index e05bfb2..4949a40 100644
--- a/ghc/interpreter/storage.h
+++ b/ghc/interpreter/storage.h
@@ -10,8 +10,8 @@
  * included in the distribution.
  *
  * $RCSfile: storage.h,v $
- * $Revision: 1.41 $
- * $Date: 2000/04/06 14:23:55 $
+ * $Revision: 1.42 $
+ * $Date: 2000/04/07 16:25:20 $
  * ------------------------------------------------------------------------*/
 
 #define DEBUG_STORAGE               /* a moderate level of sanity checking */
@@ -634,7 +634,8 @@ extern char*        nameFromOPtr    ( void* );
 
 extern void         addSection      ( Module,void*,void*,OSectionKind );
 extern OSectionKind lookupSection   ( void* );
-extern void*    lookupOExtraTabName ( char* sym );
+extern void*    lookupOExtraTabName                ( char* sym );
+extern void*    lookupOTabNameAbsolutelyEverywhere ( char* sym );
 
 #define isPrelude(m) (m==modulePrelude)