[commit: ghc] master: Revert "Implement shortcuts for slow calls that would require PAPs (#6084)" (d34f1c8)
git at git.haskell.org
git at git.haskell.org
Sat Oct 26 16:09:06 UTC 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/d34f1c851d6ef01aef109dd3515db17b795056aa/ghc
>---------------------------------------------------------------
commit d34f1c851d6ef01aef109dd3515db17b795056aa
Author: Austin Seipp <austin at well-typed.com>
Date: Fri Oct 25 22:33:56 2013 -0500
Revert "Implement shortcuts for slow calls that would require PAPs (#6084)"
This reverts commit 2f5db98e90cf0cff1a11971c85f108a7480528ed.
>---------------------------------------------------------------
d34f1c851d6ef01aef109dd3515db17b795056aa
compiler/cmm/CmmInfo.hs | 17 ----------
compiler/cmm/CmmUtils.hs | 9 ------
compiler/codeGen/StgCmmLayout.hs | 50 +++++-------------------------
utils/deriveConstants/DeriveConstants.hs | 4 +--
4 files changed, 9 insertions(+), 71 deletions(-)
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 641f29b..2851a47 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -23,7 +23,6 @@ module CmmInfo (
infoTablePtrs,
infoTableNonPtrs,
funInfoTable,
- funInfoArity,
-- info table sizes and offsets
stdInfoTableSizeW,
@@ -493,22 +492,6 @@ funInfoTable dflags info_ptr
= cmmOffsetW dflags info_ptr (1 + stdInfoTableSizeW dflags)
-- Past the entry code pointer
--- Takes the info pointer of a function, returns the function's arity
-funInfoArity :: DynFlags -> CmmExpr -> CmmExpr
-funInfoArity dflags iptr
- = cmmToWord dflags (cmmLoadIndex dflags rep fun_info offset)
- where
- fun_info = funInfoTable dflags iptr
- rep = cmmBits (widthFromBytes rep_bytes)
-
- (rep_bytes, offset)
- | tablesNextToCode dflags = ( pc_REP_StgFunInfoExtraFwd_arity pc
- , oFFSET_StgFunInfoExtraFwd_arity dflags )
- | otherwise = ( pc_REP_StgFunInfoExtraRev_arity pc
- , oFFSET_StgFunInfoExtraRev_arity dflags )
-
- pc = sPlatformConstants (settings dflags)
-
-----------------------------------------------------------------------------
--
-- Info table sizes & offsets
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index f6d1ddd..a5acffb 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -31,7 +31,6 @@ module CmmUtils(
cmmULtWord, cmmUGeWord, cmmUGtWord, cmmSubWord,
cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord,
cmmUShrWord, cmmAddWord, cmmMulWord, cmmQuotWord,
- cmmToWord,
isTrivialCmmExpr, hasNoGlobalRegs,
@@ -332,14 +331,6 @@ cmmNegate dflags e = CmmMachOp (MO_S_Neg (cmmExprWidth dfl
blankWord :: DynFlags -> CmmStatic
blankWord dflags = CmmUninitialised (wORD_SIZE dflags)
-cmmToWord :: DynFlags -> CmmExpr -> CmmExpr
-cmmToWord dflags e
- | w == word = e
- | otherwise = CmmMachOp (MO_UU_Conv w word) [e]
- where
- w = cmmExprWidth dflags e
- word = wordWidth dflags
-
---------------------------------------------------
--
-- CmmExpr predicates
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 8473642..84ff21b 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -176,52 +176,16 @@ directCall conv lbl arity stg_args
slowCall :: CmmExpr -> [StgArg] -> FCode ReturnKind
-- (slowCall fun args) applies fun to args, returning the results to Sequel
slowCall fun stg_args
- = do dflags <- getDynFlags
- argsreps <- getArgRepsAmodes stg_args
- let (rts_fun, arity) = slowCallPattern (map fst argsreps)
-
- (r, slow_code) <- getCodeR $ do
- r <- direct_call "slow_call" NativeNodeCall
+ = do { dflags <- getDynFlags
+ ; argsreps <- getArgRepsAmodes stg_args
+ ; let (rts_fun, arity) = slowCallPattern (map fst argsreps)
+ ; r <- direct_call "slow_call" NativeNodeCall
(mkRtsApFastLabel rts_fun) arity ((P,Just fun):argsreps)
- emitComment $ mkFastString ("slow_call for " ++
+ ; emitComment $ mkFastString ("slow_call for " ++
showSDoc dflags (ppr fun) ++
" with pat " ++ unpackFS rts_fun)
- return r
-
- let n_args = length stg_args
- if n_args > arity && optLevel dflags >= 2
- then do
- fast_code <- getCode $
- emitCall (NativeNodeCall, NativeReturn)
- (entryCode dflags (closureInfoPtr dflags fun))
- (nonVArgs ((P,Just fun):argsreps))
-
- slow_lbl <- newLabelC
- fast_lbl <- newLabelC
- is_tagged_lbl <- newLabelC
- end_lbl <- newLabelC
-
- funv <- (CmmReg . CmmLocal) `fmap` assignTemp fun
-
- let correct_arity = cmmEqWord dflags (funInfoArity dflags funv)
- (mkIntExpr dflags n_args)
-
- pprTrace "fast call" (int n_args) $ return ()
-
- emit (mkCbranch (cmmIsTagged dflags funv) is_tagged_lbl slow_lbl
- <*> mkLabel is_tagged_lbl
- <*> mkCbranch correct_arity fast_lbl slow_lbl
- <*> mkLabel fast_lbl
- <*> fast_code
- <*> mkBranch end_lbl
- <*> mkLabel slow_lbl
- <*> slow_code
- <*> mkLabel end_lbl)
- return r
-
- else do
- emit slow_code
- return r
+ ; return r
+ }
--------------
diff --git a/utils/deriveConstants/DeriveConstants.hs b/utils/deriveConstants/DeriveConstants.hs
index 10df61c..5b9b7c0 100644
--- a/utils/deriveConstants/DeriveConstants.hs
+++ b/utils/deriveConstants/DeriveConstants.hs
@@ -538,13 +538,13 @@ wanteds = concat
,structSize C "StgFunInfoExtraFwd"
,structField C "StgFunInfoExtraFwd" "slow_apply"
,structField C "StgFunInfoExtraFwd" "fun_type"
- ,structFieldH Both "StgFunInfoExtraFwd" "arity"
+ ,structField C "StgFunInfoExtraFwd" "arity"
,structField_ C "StgFunInfoExtraFwd_bitmap" "StgFunInfoExtraFwd" "b.bitmap"
,structSize Both "StgFunInfoExtraRev"
,structField C "StgFunInfoExtraRev" "slow_apply_offset"
,structField C "StgFunInfoExtraRev" "fun_type"
- ,structFieldH Both "StgFunInfoExtraRev" "arity"
+ ,structField C "StgFunInfoExtraRev" "arity"
,structField_ C "StgFunInfoExtraRev_bitmap" "StgFunInfoExtraRev" "b.bitmap"
,structField C "StgLargeBitmap" "size"
More information about the ghc-commits
mailing list