From fffbf0627c2c2ee4bc49f9d26a226b39a066945e Mon Sep 17 00:00:00 2001 From: Alexander Vershilov Date: Wed, 14 Jan 2015 17:58:30 -0600 Subject: Trac #9878: Make the static form illegal in interpreted mode. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 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 --- compiler/deSugar/DsExpr.hs | 4 ++-- compiler/rename/RnExpr.hs | 9 ++++++++ includes/rts/StaticPtrTable.h | 4 ++-- libraries/base/GHC/StaticPtr.hs | 4 ++-- rts/Hash.c | 24 ++++++++++++++-------- .../deSugar/should_run/DsStaticPointers.stdout | 10 ++++----- testsuite/tests/ghci/scripts/T9878.hs | 6 ++++++ testsuite/tests/ghci/scripts/T9878.script | 1 + testsuite/tests/ghci/scripts/T9878.stderr | 4 ++++ testsuite/tests/ghci/scripts/T9878b.script | 2 ++ testsuite/tests/ghci/scripts/T9878b.stdout | 1 + testsuite/tests/ghci/scripts/all.T | 7 +++++++ 12 files changed, 57 insertions(+), 19 deletions(-) create mode 100644 testsuite/tests/ghci/scripts/T9878.hs create mode 100644 testsuite/tests/ghci/scripts/T9878.script create mode 100644 testsuite/tests/ghci/scripts/T9878.stderr create mode 100644 testsuite/tests/ghci/scripts/T9878b.script create mode 100644 testsuite/tests/ghci/scripts/T9878b.stdout 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;segmentdir[segment];segment+=1) { - int index; - for(index=0;indexdir[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']) -- cgit v1.2.1