summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/deSugar/DsExpr.hs4
-rw-r--r--compiler/rename/RnExpr.hs9
-rw-r--r--includes/rts/StaticPtrTable.h4
-rw-r--r--libraries/base/GHC/StaticPtr.hs4
-rw-r--r--rts/Hash.c24
-rw-r--r--testsuite/tests/deSugar/should_run/DsStaticPointers.stdout10
-rw-r--r--testsuite/tests/ghci/scripts/T9878.hs6
-rw-r--r--testsuite/tests/ghci/scripts/T9878.script1
-rw-r--r--testsuite/tests/ghci/scripts/T9878.stderr4
-rw-r--r--testsuite/tests/ghci/scripts/T9878b.script2
-rw-r--r--testsuite/tests/ghci/scripts/T9878b.stdout1
-rwxr-xr-xtestsuite/tests/ghci/scripts/all.T7
12 files changed, 57 insertions, 19 deletions
diff --git a/compiler/deSugar/DsExpr.hs b/compiler/deSugar/DsExpr.hs
index dbc9a76664..4bffdbc06a 100644
--- a/compiler/deSugar/DsExpr.hs
+++ b/compiler/deSugar/DsExpr.hs
@@ -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}
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index cf5457eca1..f210b5a929 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -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
diff --git a/includes/rts/StaticPtrTable.h b/includes/rts/StaticPtrTable.h
index d863160342..9c03d05ed3 100644
--- a/includes/rts/StaticPtrTable.h
+++ b/includes/rts/StaticPtrTable.h
@@ -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.
diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs
index efaabf2dd2..ab7998402f 100644
--- a/libraries/base/GHC/StaticPtr.hs
+++ b/libraries/base/GHC/StaticPtr.hs
@@ -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
diff --git a/rts/Hash.c b/rts/Hash.c
index 422c3d9182..aab3b2361b 100644
--- a/rts/Hash.c
+++ b/rts/Hash.c
@@ -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;
}
diff --git a/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout b/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout
index b9d683e712..962352684f 100644
--- a/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout
+++ b/testsuite/tests/deSugar/should_run/DsStaticPointers.stdout
@@ -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
index 0000000000..fcecedab20
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9878.hs
@@ -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
index 0000000000..498183fa60
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9878.script
@@ -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
index 0000000000..98a8edfe25
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9878.stderr
@@ -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
index 0000000000..a855858bd6
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9878b.script
@@ -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
index 0000000000..0ca95142bb
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T9878b.stdout
@@ -0,0 +1 @@
+True
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 3e2ea77d61..fbcdb259e0 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -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'])
View Lorry Controller Status