diff options
| -rw-r--r-- | compiler/cmm/CmmInfo.hs | 17 | ||||
| -rw-r--r-- | compiler/cmm/CmmUtils.hs | 9 | ||||
| -rw-r--r-- | compiler/codeGen/StgCmmLayout.hs | 50 | ||||
| -rw-r--r-- | 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 641f29b880..2851a471b4 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 f6d1ddde58..a5acffb2f7 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 84736429bc..84ff21b3d0 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 10df61ca7d..5b9b7c0bd9 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" |