Trac #9878: Make the static form illegal in interpreted mode.
authorAlexander Vershilov <alexander.vershilov@tweag.io>
Wed, 14 Jan 2015 23:58:30 +0000 (17:58 -0600)
committerAustin Seipp <austin@well-typed.com>
Fri, 16 Jan 2015 16:15:45 +0000 (10:15 -0600)
Summary:
The entries of the static pointers table are expected to exist as
object code. Thus we have ghci complain with an intelligible error
message if the static form is used in interpreted mode.

It also includes a fix to keysHashTable in Hash.c which could cause a
crash. The iteration of the hashtable internals was incorrect. This
patch has the function keysHashTable imitate the iteration in
freeHashTable.

Finally, we submit here some minor edits to comments and
GHC.StaticPtr.StaticPtrInfo field names.

Authored-by: Alexander Vershilov <alexander.vershilov@tweag.
Authored-by: Facundo Domínguez <facundo.dominguez@tweag.io>
Test Plan: ./validate

Reviewers: simonpj, hvr, austin

Reviewed By: austin

Subscribers: carter, thomie, qnikst, mboes

Differential Revision: https://phabricator.haskell.org/D586

GHC Trac Issues: #9878

12 files changed:
compiler/deSugar/DsExpr.hs
compiler/rename/RnExpr.hs
includes/rts/StaticPtrTable.h
libraries/base/GHC/StaticPtr.hs
rts/Hash.c
testsuite/tests/deSugar/should_run/DsStaticPointers.stdout
testsuite/tests/ghci/scripts/T9878.hs [new file with mode: 0644]
testsuite/tests/ghci/scripts/T9878.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T9878.stderr [new file with mode: 0644]
testsuite/tests/ghci/scripts/T9878b.script [new file with mode: 0644]
testsuite/tests/ghci/scripts/T9878b.stdout [new file with mode: 0644]
testsuite/tests/ghci/scripts/all.T

index dbc9a76..4bffdbc 100644 (file)
@@ -403,8 +403,8 @@ dsExpr (PArrSeq _ _)
     g = ... static f ...
 ==>
     sptEntry:N = StaticPtr
-        (fingerprintString "pkgId:module.sptEntry:N")
-        (StaticPtrInfo "current pkg id" "current module" "sptEntry:0")
+        (fingerprintString "pkgKey:module.sptEntry:N")
+        (StaticPtrInfo "current pkg key" "current module" "sptEntry:0")
         f
     g = ... sptEntry:N
 \end{verbatim}
index cf5457e..f210b5a 100644 (file)
@@ -317,6 +317,15 @@ wired-in. See the Notes about the NameSorts in Name.hs.
 -}
 
 rnExpr e@(HsStatic expr) = do
+    target <- fmap hscTarget getDynFlags
+    case target of
+      -- SPT entries are expected to exist in object code so far, and this is
+      -- not the case in interpreted mode. See bug #9878.
+      HscInterpreted -> addErr $ sep
+        [ text "The static form is not supported in interpreted mode."
+        , text "Please use -fobject-code."
+        ]
+      _ -> return ()
     (expr',fvExpr) <- rnLExpr expr
     stage <- getStage
     case stage of
index d863160..9c03d05 100644 (file)
@@ -16,8 +16,8 @@
 
 /** Inserts an entry in the Static Pointer Table.
  *
- * The key is a fingerprint computed from the StaticName of a static pointer
- * and the spe_closure is a pointer to the closure defining the table entry.
+ * The key is a fingerprint computed from the static pointer and the spe_closure
+ * is a pointer to the closure defining the table entry.
  *
  * A stable pointer to the closure is made to prevent it from being garbage
  * collected while the entry exists on the table.
index efaabf2..ab79984 100644 (file)
@@ -85,8 +85,8 @@ foreign import ccall unsafe hs_spt_lookup :: Ptr () -> IO (Ptr a)
 
 -- | Miscelaneous information available for debugging purposes.
 data StaticPtrInfo = StaticPtrInfo
-    { -- | PackageId of the package where the static pointer is defined
-      spInfoPackageId  :: String
+    { -- | Package key of the package where the static pointer is defined
+      spInfoPackageKey  :: String
       -- | Name of the module where the static pointer is defined
     , spInfoModuleName :: String
       -- | An internal name that is distinct for every static pointer defined in
index 422c3d9..aab3b23 100644 (file)
@@ -212,19 +212,27 @@ lookupHashTable(HashTable *table, StgWord key)
 // If the table is modified concurrently, the function behavior is undefined.
 //
 int keysHashTable(HashTable *table, StgWord keys[], int szKeys) {
-    int segment;
+    int segment, index;
     int k = 0;
-    for(segment=0;segment<HDIRSIZE && table->dir[segment];segment+=1) {
-        int index;
-        for(index=0;index<HSEGSIZE;index+=1) {
-            HashList *hl;
-            for(hl=table->dir[segment][index];hl;hl=hl->next) {
-                if (k == szKeys)
-                  return k;
+    HashList *hl;
+
+
+    /* The last bucket with something in it is table->max + table->split - 1 */
+    segment = (table->max + table->split - 1) / HSEGSIZE;
+    index = (table->max + table->split - 1) % HSEGSIZE;
+
+    while (segment >= 0 && k < szKeys) {
+        while (index >= 0 && k < szKeys) {
+            hl = table->dir[segment][index];
+            while (hl && k < szKeys) {
                 keys[k] = hl->key;
                 k += 1;
+                hl = hl->next;
             }
+            index--;
         }
+        segment--;
+        index = HSEGSIZE - 1;
     }
     return k;
 }
index b9d683e..9623526 100644 (file)
@@ -1,5 +1,5 @@
-StaticPtrInfo {spInfoPackageId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:1", spInfoSrcLoc = (10,32)}
-StaticPtrInfo {spInfoPackageId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:2", spInfoSrcLoc = (11,33)}
-StaticPtrInfo {spInfoPackageId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:0", spInfoSrcLoc = (21,13)}
-StaticPtrInfo {spInfoPackageId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:3", spInfoSrcLoc = (13,33)}
-StaticPtrInfo {spInfoPackageId = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:4", spInfoSrcLoc = (14,33)}
+StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:1", spInfoSrcLoc = (10,32)}
+StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:2", spInfoSrcLoc = (11,33)}
+StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:0", spInfoSrcLoc = (21,13)}
+StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:3", spInfoSrcLoc = (13,33)}
+StaticPtrInfo {spInfoPackageKey = "main", spInfoModuleName = "Main", spInfoName = "sptEntry:4", spInfoSrcLoc = (14,33)}
diff --git a/testsuite/tests/ghci/scripts/T9878.hs b/testsuite/tests/ghci/scripts/T9878.hs
new file mode 100644 (file)
index 0000000..fceceda
--- /dev/null
@@ -0,0 +1,6 @@
+{-# LANGUAGE StaticPointers #-}
+module T9878 where
+
+import GHC.StaticPtr
+
+f = deRefStaticPtr (static True)
diff --git a/testsuite/tests/ghci/scripts/T9878.script b/testsuite/tests/ghci/scripts/T9878.script
new file mode 100644 (file)
index 0000000..498183f
--- /dev/null
@@ -0,0 +1 @@
+:l T9878.hs
diff --git a/testsuite/tests/ghci/scripts/T9878.stderr b/testsuite/tests/ghci/scripts/T9878.stderr
new file mode 100644 (file)
index 0000000..98a8edf
--- /dev/null
@@ -0,0 +1,4 @@
+
+T9878.hs:6:21:
+    The static form is not supported in interpreted mode.
+    Please use -fobject-code.
diff --git a/testsuite/tests/ghci/scripts/T9878b.script b/testsuite/tests/ghci/scripts/T9878b.script
new file mode 100644 (file)
index 0000000..a855858
--- /dev/null
@@ -0,0 +1,2 @@
+:l T9878.hs
+f
diff --git a/testsuite/tests/ghci/scripts/T9878b.stdout b/testsuite/tests/ghci/scripts/T9878b.stdout
new file mode 100644 (file)
index 0000000..0ca9514
--- /dev/null
@@ -0,0 +1 @@
+True
index 3e2ea77..fbcdb25 100755 (executable)
@@ -199,3 +199,10 @@ test('T9762',
  ],
  ghci_script, ['T9762.script'])
 test('T9881', normal, ghci_script, ['T9881.script'])
+test('T9878',
+    [extra_clean(['T9878.hi','T9878.o'])],
+    ghci_script, ['T9878.script'])
+test('T9878b',
+    [ extra_run_opts('-fobject-code'),
+      extra_clean(['T9878.hi','T9878.o'])],
+    ghci_script, ['T9878b.script'])