diff options
-rw-r--r-- | compiler/GHC/ByteCode/Asm.hs | 72 | ||||
-rw-r--r-- | compiler/GHC/ByteCode/Types.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Cmm/CallConv.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Parser.y | 3 | ||||
-rw-r--r-- | compiler/GHC/StgToByteCode.hs | 36 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Foreign.hs | 59 | ||||
-rw-r--r-- | rts/Interpreter.c | 2 | ||||
-rw-r--r-- | rts/StgMiscClosures.cmm | 100 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs | 2 |
9 files changed, 136 insertions, 165 deletions
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs index 24b055fe6c..6b9d4a9223 100644 --- a/compiler/GHC/ByteCode/Asm.hs +++ b/compiler/GHC/ByteCode/Asm.hs @@ -39,6 +39,8 @@ import GHC.Data.FastString import GHC.Data.SizedSeq import GHC.StgToCmm.Layout ( ArgRep(..) ) +import GHC.Cmm.Expr +import GHC.Cmm.CallConv ( tupleRegsCover ) import GHC.Platform import GHC.Platform.Profile @@ -392,7 +394,7 @@ assembleI platform i = case i of p <- ioptr (liftM BCOPtrBCO ul_bco) p_tup <- ioptr (liftM BCOPtrBCO ul_tuple_bco) info <- int (fromIntegral $ - mkTupleInfoSig tuple_info) + mkTupleInfoSig platform tuple_info) emit bci_PUSH_ALTS_T [Op p, Op info, Op p_tup] PUSH_PAD8 -> emit bci_PUSH_PAD8 [] @@ -551,69 +553,35 @@ maxTupleNativeStackSize :: WordOff maxTupleNativeStackSize = 62 {- - Maximum number of supported registers for returning tuples. - - If GHC uses more more than these (because of a change in the calling - convention or a new platform) mkTupleInfoSig will panic. - - You can raise the limits after modifying stg_ctoi_t and stg_ret_t - (StgMiscClosures.cmm) to save and restore the additional registers. - -} -maxTupleVanillaRegs, maxTupleFloatRegs, maxTupleDoubleRegs, - maxTupleLongRegs :: Int -maxTupleVanillaRegs = 6 -maxTupleFloatRegs = 6 -maxTupleDoubleRegs = 6 -maxTupleLongRegs = 1 - -{- Construct the tuple_info word that stg_ctoi_t and stg_ret_t use to convert a tuple between the native calling convention and the interpreter. See Note [GHCi tuple layout] for more information. -} -mkTupleInfoSig :: TupleInfo -> Word32 -mkTupleInfoSig ti@TupleInfo{..} - | tupleNativeStackSize > maxTupleNativeStackSize = - pprPanic "mkTupleInfoSig: tuple too big for the bytecode compiler" +mkTupleInfoSig :: Platform -> TupleInfo -> Word32 +mkTupleInfoSig platform TupleInfo{..} + | tupleNativeStackSize > maxTupleNativeStackSize + = pprPanic "mkTupleInfoSig: tuple too big for the bytecode compiler" (ppr tupleNativeStackSize <+> text "stack words." <+> text "Use -fobject-code to get around this limit" ) - | tupleVanillaRegs `shiftR` maxTupleVanillaRegs /= 0 = - pprPanic "mkTupleInfoSig: too many vanilla registers" (ppr tupleVanillaRegs) - | tupleLongRegs `shiftR` maxTupleLongRegs /= 0 = - pprPanic "mkTupleInfoSig: too many long registers" (ppr tupleLongRegs) - | tupleFloatRegs `shiftR` maxTupleFloatRegs /= 0 = - pprPanic "mkTupleInfoSig: too many float registers" (ppr tupleFloatRegs) - | tupleDoubleRegs `shiftR` maxTupleDoubleRegs /= 0 = - pprPanic "mkTupleInfoSig: too many double registers" (ppr tupleDoubleRegs) - {- - Check that we can pack the register counts/bitmaps and stack size - in the information word. In particular we check that each component - fits in the bits we have reserved for it. - - This overlaps with some of the above checks. It's likely that if the - number of registers changes, the number of bits will also need to be - updated. - -} - | tupleNativeStackSize < 16384 && -- 14 bits stack usage - tupleDoubleRegs < 64 && -- 6 bit bitmap (these can be shared with float) - tupleFloatRegs < 64 && -- 6 bit bitmap (these can be shared with double) - tupleLongRegs < 4 && -- 2 bit bitmap - tupleVanillaRegs < 65536 && -- 4 bit count (tupleVanillaRegs is still a bitmap) - -- check that there are no "holes", i.e. that R1..Rn are all in use - tupleVanillaRegs .&. (tupleVanillaRegs + 1) == 0 - = fromIntegral tupleNativeStackSize .|. - unRegBitmap (tupleLongRegs `shiftL` 14) .|. - unRegBitmap (tupleDoubleRegs `shiftL` 16) .|. - unRegBitmap (tupleFloatRegs `shiftL` 22) .|. - fromIntegral (countTrailingZeros (1 + tupleVanillaRegs) `shiftL` 28) - | otherwise = pprPanic "mkTupleInfoSig: unsupported tuple shape" (ppr ti) + | otherwise + = assert (length regs <= 24) {- 24 bits for bitmap -} + assert (tupleNativeStackSize < 255) {- 8 bits for stack size -} + assert (all (`elem` regs) (regSetToList tupleRegs)) {- all regs accounted for -} + foldl' reg_bit 0 (zip regs [0..]) .|. + (fromIntegral tupleNativeStackSize `shiftL` 24) + where + reg_bit :: Word32 -> (GlobalReg, Int) -> Word32 + reg_bit x (r, n) + | r `elemRegSet` tupleRegs = x .|. 1 `shiftL` n + | otherwise = x + regs = tupleRegsCover platform mkTupleInfoLit :: Platform -> TupleInfo -> Literal mkTupleInfoLit platform tuple_info = - mkLitWord platform . fromIntegral $ mkTupleInfoSig tuple_info + mkLitWord platform . fromIntegral $ mkTupleInfoSig platform tuple_info -- Make lists of host-sized words for literals, so that when the -- words are placed in memory at increasing addresses, the diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs index 02c117d716..673838654d 100644 --- a/compiler/GHC/ByteCode/Types.hs +++ b/compiler/GHC/ByteCode/Types.hs @@ -43,6 +43,7 @@ import qualified Data.IntMap as IntMap import Data.Maybe (catMaybes) import qualified GHC.Exts.Heap as Heap import GHC.Stack.CCS +import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList ) -- ----------------------------------------------------------------------------- -- Compiled Byte Code @@ -106,10 +107,7 @@ newtype RegBitmap = RegBitmap { unRegBitmap :: Word32 } -} data TupleInfo = TupleInfo { tupleSize :: !WordOff -- total size of tuple in words - , tupleVanillaRegs :: !RegBitmap -- vanilla registers used - , tupleLongRegs :: !RegBitmap -- long registers used - , tupleFloatRegs :: !RegBitmap -- float registers used - , tupleDoubleRegs :: !RegBitmap -- double registers used + , tupleRegs :: !GlobalRegSet , tupleNativeStackSize :: !WordOff {- words spilled on the stack by GHCs native calling convention -} } deriving (Show) @@ -118,14 +116,11 @@ instance Outputable TupleInfo where ppr TupleInfo{..} = text "<size" <+> ppr tupleSize <+> text "stack" <+> ppr tupleNativeStackSize <+> text "regs" <+> - char 'R' <> ppr tupleVanillaRegs <+> - char 'L' <> ppr tupleLongRegs <+> - char 'F' <> ppr tupleFloatRegs <+> - char 'D' <> ppr tupleDoubleRegs <> + ppr (map (text.show) $ regSetToList tupleRegs) <> char '>' voidTupleInfo :: TupleInfo -voidTupleInfo = TupleInfo 0 0 0 0 0 0 +voidTupleInfo = TupleInfo 0 emptyRegSet 0 type ItblEnv = NameEnv (Name, ItblPtr) -- We need the Name in the range so we know which diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs index f4b46a03f2..f376e598bf 100644 --- a/compiler/GHC/Cmm/CallConv.hs +++ b/compiler/GHC/Cmm/CallConv.hs @@ -2,10 +2,12 @@ module GHC.Cmm.CallConv ( ParamLocation(..), assignArgumentsPos, assignStack, - realArgRegsCover + realArgRegsCover, + tupleRegsCover ) where import GHC.Prelude +import Data.List (nub) import GHC.Cmm.Expr import GHC.Runtime.Heap.Layout @@ -219,3 +221,13 @@ realArgRegsCover platform realDoubleRegs platform ++ realLongRegs platform -- we don't save XMM registers if they are not used for parameter passing + +-- Like realArgRegsCover but always includes the node. This covers the real +-- and virtual registers used for unboxed tuples. +-- +-- Note: if anything changes in how registers for unboxed tuples overlap, +-- make sure to also update GHC.StgToByteCode.layoutTuple. + +tupleRegsCover :: Platform -> [GlobalReg] +tupleRegsCover platform = + nub (VanillaReg 1 VGcPtr : realArgRegsCover platform) diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y index d182a6f714..490a3c4976 100644 --- a/compiler/GHC/Cmm/Parser.y +++ b/compiler/GHC/Cmm/Parser.y @@ -1151,6 +1151,9 @@ stmtMacros = listToUFM [ ( fsLit "SAVE_REGS", \[] -> emitSaveRegs ), ( fsLit "RESTORE_REGS", \[] -> emitRestoreRegs ), + ( fsLit "PUSH_TUPLE_REGS", \[live_regs] -> emitPushTupleRegs live_regs ), + ( fsLit "POP_TUPLE_REGS", \[live_regs] -> emitPopTupleRegs live_regs ), + ( fsLit "LDV_ENTER", \[e] -> ldvEnter e ), ( fsLit "LDV_RECORD_CREATE", \[e] -> ldvRecordCreate e ), diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs index e2f48390e5..f7bb270e16 100644 --- a/compiler/GHC/StgToByteCode.hs +++ b/compiler/GHC/StgToByteCode.hs @@ -1262,28 +1262,31 @@ layoutTuple profile start_off arg_ty reps = orig_stk_params = [(x, fromIntegral off) | (x, StackParam off) <- pos] -- sort the register parameters by register and add them to the stack + regs_order :: Map.Map GlobalReg Int + regs_order = Map.fromList $ zip (tupleRegsCover platform) [0..] + + reg_order :: GlobalReg -> (Int, GlobalReg) + reg_order reg | Just n <- Map.lookup reg regs_order = (n, reg) + -- a VanillaReg goes to the same place regardless of whether it + -- contains a pointer + reg_order (VanillaReg n VNonGcPtr) = reg_order (VanillaReg n VGcPtr) + -- if we don't have a position for a FloatReg then they must be passed + -- in the equivalent DoubleReg + reg_order (FloatReg n) = reg_order (DoubleReg n) + -- one-tuples can be passed in other registers, but then we don't need + -- to care about the order + reg_order reg = (0, reg) + (regs, reg_params) = unzip $ sortBy (comparing fst) - [(reg, x) | (x, RegisterParam reg) <- pos] + [(reg_order reg, x) | (x, RegisterParam reg) <- pos] (new_stk_bytes, new_stk_params) = assignStack platform orig_stk_bytes arg_ty reg_params - -- make live register bitmaps - bmp_reg r ~(v, f, d, l) - = case r of VanillaReg n _ -> (a v n, f, d, l ) - FloatReg n -> (v, a f n, d, l ) - DoubleReg n -> (v, f, a d n, l ) - LongReg n -> (v, f, d, a l n) - _ -> - pprPanic "GHC.StgToByteCode.layoutTuple unsupported register type" - (ppr r) - where a bmp n = bmp .|. (1 `shiftL` (n-1)) - - (vanilla_regs, float_regs, double_regs, long_regs) - = foldr bmp_reg (0, 0, 0, 0) regs + regs_set = mkRegSet (map snd regs) get_byte_off (x, StackParam y) = (x, fromIntegral y) get_byte_off _ = @@ -1291,10 +1294,7 @@ layoutTuple profile start_off arg_ty reps = in ( TupleInfo { tupleSize = bytesToWords platform (ByteOff new_stk_bytes) - , tupleVanillaRegs = vanilla_regs - , tupleLongRegs = long_regs - , tupleFloatRegs = float_regs - , tupleDoubleRegs = double_regs + , tupleRegs = regs_set , tupleNativeStackSize = bytesToWords platform (ByteOff orig_stk_bytes) } diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs index 95fa21d648..39f25a7b86 100644 --- a/compiler/GHC/StgToCmm/Foreign.hs +++ b/compiler/GHC/StgToCmm/Foreign.hs @@ -15,6 +15,8 @@ module GHC.StgToCmm.Foreign ( emitLoadThreadState, emitSaveRegs, emitRestoreRegs, + emitPushTupleRegs, + emitPopTupleRegs, loadThreadState, emitOpenNursery, emitCloseNursery, @@ -340,6 +342,63 @@ emitRestoreRegs = do restore = catAGraphs (map (callerRestoreGlobalReg platform) regs) emit restore +-- | Push a subset of STG registers onto the stack, specified by the bitmap +-- +-- Sometimes, a "live" subset of the STG registers needs to be saved on the +-- stack, for example when storing an unboxed tuple to be used in the GHCi +-- bytecode interpreter. +-- +-- The "live registers" bitmap corresponds to the list of registers given by +-- 'tupleRegsCover', with the least significant bit indicating liveness of +-- the first register in the list. +-- +-- Each register is saved to a stack slot of one or more machine words, even +-- if the register size itself is smaller. +-- +-- The resulting Cmm code looks like this, with a line for each real or +-- virtual register used for returning tuples: +-- +-- ... +-- if((mask & 2) != 0) { Sp_adj(-1); Sp(0) = R2; } +-- if((mask & 1) != 0) { Sp_adj(-1); Sp(0) = R1; } +-- +-- See Note [GHCi tuple layout] + +emitPushTupleRegs :: CmmExpr -> FCode () +emitPushTupleRegs regs_live = do + platform <- getPlatform + let regs = zip (tupleRegsCover platform) [0..] + save_arg (reg, n) = + let mask = CmmLit (CmmInt (1 `shiftL` n) (wordWidth platform)) + live = cmmAndWord platform regs_live mask + cond = cmmNeWord platform live (zeroExpr platform) + reg_ty = cmmRegType platform (CmmGlobal reg) + width = roundUpToWords platform + (widthInBytes $ typeWidth reg_ty) + adj_sp = mkAssign spReg + (cmmOffset platform spExpr (negate width)) + save_reg = mkStore spExpr (CmmReg $ CmmGlobal reg) + in mkCmmIfThen cond $ catAGraphs [adj_sp, save_reg] + emit . catAGraphs =<< mapM save_arg (reverse regs) + +-- | Pop a subset of STG registers from the stack (see 'emitPushTupleRegs') +emitPopTupleRegs :: CmmExpr -> FCode () +emitPopTupleRegs regs_live = do + platform <- getPlatform + let regs = zip (tupleRegsCover platform) [0..] + save_arg (reg, n) = + let mask = CmmLit (CmmInt (1 `shiftL` n) (wordWidth platform)) + live = cmmAndWord platform regs_live mask + cond = cmmNeWord platform live (zeroExpr platform) + reg_ty = cmmRegType platform (CmmGlobal reg) + width = roundUpToWords platform + (widthInBytes $ typeWidth reg_ty) + adj_sp = mkAssign spReg + (cmmOffset platform spExpr width) + restore_reg = mkAssign (CmmGlobal reg) (CmmLoad spExpr reg_ty) + in mkCmmIfThen cond $ catAGraphs [restore_reg, adj_sp] + emit . catAGraphs =<< mapM save_arg regs + emitCloseNursery :: FCode () emitCloseNursery = do diff --git a/rts/Interpreter.c b/rts/Interpreter.c index efbfd091d8..b2aa5e1e6c 100644 --- a/rts/Interpreter.c +++ b/rts/Interpreter.c @@ -1382,7 +1382,7 @@ run_BCO: SpW(-2) = tuple_info; SpW(-3) = BCO_PTR(o_bco); W_ ctoi_t_offset; - int tuple_stack_words = tuple_info & 0x3fff; + int tuple_stack_words = (tuple_info >> 24) & 0xff; switch(tuple_stack_words) { case 0: ctoi_t_offset = (W_)&stg_ctoi_t0_info; break; case 1: ctoi_t_offset = (W_)&stg_ctoi_t1_info; break; diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm index b9379ab3e6..244f55d67a 100644 --- a/rts/StgMiscClosures.cmm +++ b/rts/StgMiscClosures.cmm @@ -110,9 +110,6 @@ stg_interp_constr7_entry (P_ ret) { return (ret + 7); } which is just what we want -- the "standard" return layout for the interpreter. Hurrah! - - Don't ask me how unboxed tuple returns are supposed to work. We - haven't got a good story about that yet. */ INFO_TABLE_RET( stg_ctoi_R1p, RET_BCO) @@ -221,7 +218,7 @@ INFO_TABLE_RET( stg_ctoi_V, RET_BCO ) spilled_1 spilled_2 spilled_3 <- Sp - + When stg_ctoi_t is called, the stack looks like: ... @@ -340,26 +337,23 @@ MK_STG_CTOI_T(62) the tuple_info word describes the register and stack usage of the tuple: - [ rrrr ffff ffdd dddd llss ssss ssss ssss ] + [ ssss ssss rrrr rrrr rrrr rrrr rrrr rrrr ] - - r: number of vanilla registers R1..Rn - - f: bitmap of float registers F1..F6 - - d: bitmap of double registers D1..D6 - - l: bitmap of long registers L1..Ln + - r: bitmap of live registers, corresponding to the list of registers + returned by GHC.Cmm.CallConv.tupleRegsCover (the least significant + bit corresponds to the first element in the list) - s: number of words on stack (in addition to registers) - The order in which the registers are pushed on the stack is determined by - the Ord instance of GHC.Cmm.Expr.GlobalReg. If you change the Ord instance, - the order in stg_ctoi_t and stg_ret_t needs to be adjusted accordingly. - + The order of the live registers in the bitmap is the same as the list + given by GHC.Cmm.CallConv.tupleRegsCover, with the least significant + bit corresponding to the first register in the list. */ stg_ctoi_t /* explicit stack */ { - W_ tuple_info, tuple_stack, tuple_regs_R, - tuple_regs_F, tuple_regs_D, tuple_regs_L; + W_ tuple_info, tuple_stack; P_ tuple_BCO; tuple_info = Sp(2); /* tuple information word */ @@ -370,41 +364,12 @@ stg_ctoi_t CCCS = Sp(4); #endif - tuple_stack = tuple_info & 0x3fff; /* number of words spilled on stack */ - tuple_regs_R = (tuple_info >> 28) & 0xf; /* number of R1..Rn */ - tuple_regs_F = (tuple_info >> 22) & 0x3f; /* 6 bits bitmap */ - tuple_regs_D = (tuple_info >> 16) & 0x3f; /* 6 bits bitmap */ - tuple_regs_L = (tuple_info >> 14) & 0x3; /* 2 bits bitmap */ + /* number of words spilled on stack */ + tuple_stack = (tuple_info >> 24) & 0xff; Sp = Sp - WDS(tuple_stack); - /* save long registers */ - /* fixme L2 ? */ - if((tuple_regs_L & 1) != 0) { Sp = Sp - 8; L_[Sp] = L1; } - - /* save double registers */ - if((tuple_regs_D & 32) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D6; } - if((tuple_regs_D & 16) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D5; } - if((tuple_regs_D & 8) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D4; } - if((tuple_regs_D & 4) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D3; } - if((tuple_regs_D & 2) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D2; } - if((tuple_regs_D & 1) != 0) { Sp = Sp - SIZEOF_DOUBLE; D_[Sp] = D1; } - - /* save float registers */ - if((tuple_regs_F & 32) != 0) { Sp_adj(-1); F_[Sp] = F6; } - if((tuple_regs_F & 16) != 0) { Sp_adj(-1); F_[Sp] = F5; } - if((tuple_regs_F & 8) != 0) { Sp_adj(-1); F_[Sp] = F4; } - if((tuple_regs_F & 4) != 0) { Sp_adj(-1); F_[Sp] = F3; } - if((tuple_regs_F & 2) != 0) { Sp_adj(-1); F_[Sp] = F2; } - if((tuple_regs_F & 1) != 0) { Sp_adj(-1); F_[Sp] = F1; } - - /* save vanilla registers */ - if(tuple_regs_R >= 6) { Sp_adj(-1); Sp(0) = R6; } - if(tuple_regs_R >= 5) { Sp_adj(-1); Sp(0) = R5; } - if(tuple_regs_R >= 4) { Sp_adj(-1); Sp(0) = R4; } - if(tuple_regs_R >= 3) { Sp_adj(-1); Sp(0) = R3; } - if(tuple_regs_R >= 2) { Sp_adj(-1); Sp(0) = R2; } - if(tuple_regs_R >= 1) { Sp_adj(-1); Sp(0) = R1; } + PUSH_TUPLE_REGS(tuple_info); /* jump to the BCO that will finish the return of the tuple */ Sp_adj(-3); @@ -417,46 +382,15 @@ stg_ctoi_t INFO_TABLE_RET( stg_ret_t, RET_BCO ) { - W_ tuple_info, tuple_stack, tuple_regs_R, tuple_regs_F, - tuple_regs_D, tuple_regs_L; + W_ tuple_info, tuple_stack; tuple_info = Sp(2); Sp_adj(3); - tuple_stack = tuple_info & 0x3fff; /* number of words spilled on stack */ - tuple_regs_R = (tuple_info >> 28) & 0xf; /* number of R1..Rn */ - tuple_regs_F = (tuple_info >> 22) & 0x3f; /* 6 bits bitmap */ - tuple_regs_D = (tuple_info >> 16) & 0x3f; /* 6 bits bitmap */ - tuple_regs_L = (tuple_info >> 14) & 0x3; /* 2 bits bitmap */ - - /* restore everything in the reverse order of stg_ctoi_t */ - - /* restore vanilla registers */ - if(tuple_regs_R >= 1) { R1 = Sp(0); Sp_adj(1); } - if(tuple_regs_R >= 2) { R2 = Sp(0); Sp_adj(1); } - if(tuple_regs_R >= 3) { R3 = Sp(0); Sp_adj(1); } - if(tuple_regs_R >= 4) { R4 = Sp(0); Sp_adj(1); } - if(tuple_regs_R >= 5) { R5 = Sp(0); Sp_adj(1); } - if(tuple_regs_R >= 6) { R6 = Sp(0); Sp_adj(1); } - - /* restore float registers */ - if((tuple_regs_F & 1) != 0) { F1 = F_[Sp]; Sp_adj(1); } - if((tuple_regs_F & 2) != 0) { F2 = F_[Sp]; Sp_adj(1); } - if((tuple_regs_F & 4) != 0) { F3 = F_[Sp]; Sp_adj(1); } - if((tuple_regs_F & 8) != 0) { F4 = F_[Sp]; Sp_adj(1); } - if((tuple_regs_F & 16) != 0) { F5 = F_[Sp]; Sp_adj(1); } - if((tuple_regs_F & 32) != 0) { F6 = F_[Sp]; Sp_adj(1); } - - /* restore double registers */ - if((tuple_regs_D & 1) != 0) { D1 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } - if((tuple_regs_D & 2) != 0) { D2 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } - if((tuple_regs_D & 4) != 0) { D3 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } - if((tuple_regs_D & 8) != 0) { D4 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } - if((tuple_regs_D & 16) != 0) { D5 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } - if((tuple_regs_D & 32) != 0) { D6 = D_[Sp]; Sp = Sp + SIZEOF_DOUBLE; } - - /* restore long registers */ - if((tuple_regs_L & 1) != 0) { L1 = L_[Sp]; Sp = Sp + 8; } + /* number of words spilled on stack */ + tuple_stack = (tuple_info >> 24) & 0xff; + + POP_TUPLE_REGS(tuple_info); /* Sp points to the topmost argument now */ jump %ENTRY_CODE(Sp(tuple_stack)) [*]; // NB. all registers live! diff --git a/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs b/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs index 1daec7f207..1bbaf39837 100644 --- a/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs +++ b/testsuite/tests/ghci/should_run/UnboxedTuples/UnboxedTuples.hs @@ -179,4 +179,4 @@ testX :: (Eq a, Show a) => String -> (p -> t) -> (p -> t) -> p -> p -> (t -> a) -> IO () testX msg a1 a2 b1 b2 ap = let (r:rs) = [ap (f g) | f <- [a1,a2], g <- [b1,b2]] - in putStrLn (msg ++ " " ++ (show $ all (==r) rs) ++ " " ++ show r) + in putStrLn (msg ++ " " ++ show (all (==r) rs) ++ " " ++ show r) |