[commit: ghc] master: BC-breaking changes to C-- CLOSURE syntax. (3b5a840)
git at git.haskell.org
git at git.haskell.org
Thu Oct 2 06:10:56 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/3b5a840bba375c4c4c11ccfeb283f84c3a1ef22c/ghc
>---------------------------------------------------------------
commit 3b5a840bba375c4c4c11ccfeb283f84c3a1ef22c
Author: Edward Z. Yang <ezyang at mit.edu>
Date: Mon Aug 26 14:52:37 2013 -0700
BC-breaking changes to C-- CLOSURE syntax.
Summary:
Previously, there were two variants of CLOSURE in C--:
- Top-level CLOSURE(foo_closure, foo, lits...), which defines a new
static closure and gives it a name, and
- Array CLOSURE(foo, lits...), which was used for the static char
and integer arrays.
They used the same name, were confusing, and didn't even generate
the correct internal label representation! So now, we have two
new forms:
- Top-level CLOSURE(foo, lits...) which automatically generates
foo_closure (along with foo_info, which we were doing already)
- Array ANONYMOUS_CLOSURE(foo, lits...) which doesn't generate
a foo_closure identifier.
Part of remove HEAP_ALLOCED patch set (#8199)
Signed-off-by: Edward Z. Yang <ezyang at mit.edu>
Test Plan: validate
Reviewers: simonmar, austin
Subscribers: simonmar, ezyang, carter, thomie
Differential Revision: https://phabricator.haskell.org/D264
GHC Trac Issues: #8199
>---------------------------------------------------------------
3b5a840bba375c4c4c11ccfeb283f84c3a1ef22c
compiler/cmm/CLabel.hs | 4 ++--
compiler/cmm/CmmLex.x | 2 ++
compiler/cmm/CmmParse.y | 17 +++++++++--------
rts/StgMiscClosures.cmm | 20 ++++++++++----------
4 files changed, 23 insertions(+), 20 deletions(-)
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 0f2c0ae..c5afa09 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -333,9 +333,9 @@ data CmmLabelInfo
| CmmEntry -- ^ misc rts entry points, suffix _entry
| CmmRetInfo -- ^ misc rts ret info tables, suffix _info
| CmmRet -- ^ misc rts return points, suffix _ret
- | CmmData -- ^ misc rts data bits, eg CHARLIKE_closure
+ | CmmData -- ^ misc rts data bits
| CmmCode -- ^ misc rts code
- | CmmClosure -- ^ closures eg CHARLIKE_closure
+ | CmmClosure -- ^ misc rts closures, suffix _closure
| CmmPrimCall -- ^ a prim call to some hand written Cmm code
deriving (Eq, Ord)
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index f56db7b..dfbb751 100644
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -135,6 +135,7 @@ data CmmToken
| CmmT_Ne
| CmmT_BoolAnd
| CmmT_BoolOr
+ | CmmT_ANONYMOUS_CLOSURE
| CmmT_CLOSURE
| CmmT_INFO_TABLE
| CmmT_INFO_TABLE_RET
@@ -218,6 +219,7 @@ name span buf len =
reservedWordsFM = listToUFM $
map (\(x, y) -> (mkFastString x, y)) [
+ ( "ANONYMOUS_CLOSURE", CmmT_ANONYMOUS_CLOSURE ),
( "CLOSURE", CmmT_CLOSURE ),
( "INFO_TABLE", CmmT_INFO_TABLE ),
( "INFO_TABLE_RET", CmmT_INFO_TABLE_RET ),
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index db6cc49..3bd0053 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -300,6 +300,7 @@ import Data.Maybe
'||' { L _ (CmmT_BoolOr) }
'CLOSURE' { L _ (CmmT_CLOSURE) }
+ 'ANONYMOUS_CLOSURE'{ L _ (CmmT_ANONYMOUS_CLOSURE) }
'INFO_TABLE' { L _ (CmmT_INFO_TABLE) }
'INFO_TABLE_RET'{ L _ (CmmT_INFO_TABLE_RET) }
'INFO_TABLE_FUN'{ L _ (CmmT_INFO_TABLE_FUN) }
@@ -369,10 +370,10 @@ cmmtop :: { CmmParse () }
: cmmproc { $1 }
| cmmdata { $1 }
| decl { $1 }
- | 'CLOSURE' '(' NAME ',' NAME lits ')' ';'
+ | 'CLOSURE' '(' NAME lits ')' ';'
{% withThisPackage $ \pkg ->
- do lits <- sequence $6;
- staticClosure pkg $3 $5 (map getLit lits) }
+ do lits <- sequence $4;
+ staticClosure pkg $3 (map getLit lits) }
-- The only static closures in the RTS are dummy closures like
-- stg_END_TSO_QUEUE_closure and stg_dummy_ret. We don't need
@@ -411,7 +412,7 @@ static :: { CmmParse [CmmStatic] }
| typenot8 '[' INT ']' ';' { return [CmmUninitialised
(widthInBytes (typeWidth $1) *
fromIntegral $3)] }
- | 'CLOSURE' '(' NAME lits ')'
+ | 'ANONYMOUS_CLOSURE' '(' NAME lits ')'
{ do { lits <- sequence $4
; dflags <- getDynFlags
; return $ map CmmStaticLit $
@@ -1101,11 +1102,11 @@ profilingInfo dflags desc_str ty_str
else ProfilingInfo (stringToWord8s desc_str)
(stringToWord8s ty_str)
-staticClosure :: PackageKey -> FastString -> FastString -> [CmmLit] -> CmmParse ()
-staticClosure pkg cl_label info payload
+staticClosure :: PackageKey -> FastString -> [CmmLit] -> CmmParse ()
+staticClosure pkg label payload
= do dflags <- getDynFlags
- let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg info) dontCareCCS payload [] [] []
- code $ emitStaticClosure (mkCmmDataLabel pkg cl_label) lits
+ let lits = mkStaticClosure dflags (mkCmmInfoLabel pkg label) dontCareCCS payload [] [] []
+ code $ emitStaticClosure (mkCmmClosureLabel pkg label) lits
foreignCall
:: String
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index 42ef39e..85ecb5e 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -457,7 +457,7 @@ INFO_TABLE_CONSTR(stg_C_FINALIZER_LIST,1,4,0,CONSTR,"C_FINALIZER_LIST","C_FINALI
INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")
{ foreign "C" barf("NO_FINALIZER object entered!") never returns; }
-CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
+CLOSURE(stg_NO_FINALIZER);
/* ----------------------------------------------------------------------------
Stable Names are unlifted too.
@@ -516,13 +516,13 @@ INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUN
INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
{ foreign "C" barf("NO_TREC object entered!") never returns; }
-CLOSURE(stg_END_STM_WATCH_QUEUE_closure,stg_END_STM_WATCH_QUEUE);
+CLOSURE(stg_END_STM_WATCH_QUEUE);
-CLOSURE(stg_END_INVARIANT_CHECK_QUEUE_closure,stg_END_INVARIANT_CHECK_QUEUE);
+CLOSURE(stg_END_INVARIANT_CHECK_QUEUE);
-CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
+CLOSURE(stg_END_STM_CHUNK_LIST);
-CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
+CLOSURE(stg_NO_TREC);
/* ----------------------------------------------------------------------------
Messages
@@ -553,7 +553,7 @@ INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL")
INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")
{ foreign "C" barf("END_TSO_QUEUE object entered!") never returns; }
-CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
+CLOSURE(stg_END_TSO_QUEUE);
/* ----------------------------------------------------------------------------
GCD_CAF
@@ -572,7 +572,7 @@ INFO_TABLE_CONSTR(stg_GCD_CAF,0,0,0,CONSTR_NOCAF_STATIC,"GCD_CAF","GCD_CAF")
INFO_TABLE_CONSTR(stg_STM_AWOKEN,0,0,0,CONSTR_NOCAF_STATIC,"STM_AWOKEN","STM_AWOKEN")
{ foreign "C" barf("STM_AWOKEN object entered!") never returns; }
-CLOSURE(stg_STM_AWOKEN_closure,stg_STM_AWOKEN);
+CLOSURE(stg_STM_AWOKEN);
/* ----------------------------------------------------------------------------
Arrays
@@ -638,7 +638,7 @@ INFO_TABLE( stg_dummy_ret, 0, 0, CONSTR_NOCAF_STATIC, "DUMMY_RET", "DUMMY_RET")
{
return ();
}
-CLOSURE(stg_dummy_ret_closure,stg_dummy_ret);
+CLOSURE(stg_dummy_ret);
/* ----------------------------------------------------------------------------
MVAR_TSO_QUEUE
@@ -673,8 +673,8 @@ INFO_TABLE_CONSTR(stg_MVAR_TSO_QUEUE,2,0,0,PRIM,"MVAR_TSO_QUEUE","MVAR_TSO_QUEUE
#endif
-#define CHARLIKE_HDR(n) CLOSURE(Char_hash_static_info, n)
-#define INTLIKE_HDR(n) CLOSURE(Int_hash_static_info, n)
+#define CHARLIKE_HDR(n) ANONYMOUS_CLOSURE(Char_hash_static_info, n)
+#define INTLIKE_HDR(n) ANONYMOUS_CLOSURE(Int_hash_static_info, n)
/* put these in the *data* section, since the garbage collector relies
* on the fact that static closures live in the data section.
More information about the ghc-commits
mailing list