From d8b4de2312721efcf7d6ecc02f672d0aa6a95817 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Mon, 18 Feb 2008 11:57:48 +0000 Subject: [PATCH] attempt to fix #2098 (PPC pepple please test & fix) --- compiler/ghci/ByteCodeFFI.lhs | 40 ++++++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/compiler/ghci/ByteCodeFFI.lhs b/compiler/ghci/ByteCodeFFI.lhs index a17386f..d72f1ac 100644 --- a/compiler/ghci/ByteCodeFFI.lhs +++ b/compiler/ghci/ByteCodeFFI.lhs @@ -687,12 +687,12 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps dst = linkageArea + (offsetW+w) * bytes_per_word in case a_rep of - FloatArg | nextFPR < 14 -> + FloatRep | nextFPR < 14 -> (0xc01f0000 -- lfs fX, haskellArgOffset(r31) .|. (fromIntegral haskellArgOffset .&. 0xFFFF) .|. (fromIntegral nextFPR `shiftL` 21)) : pass_parameters args (nextFPR+1) offsetW' - DoubleArg | nextFPR < 14 -> + DoubleRep | nextFPR < 14 -> (0xc81f0000 -- lfd fX, haskellArgOffset(r31) .|. (fromIntegral haskellArgOffset .&. 0xFFFF) .|. (fromIntegral nextFPR `shiftL` 21)) @@ -702,11 +702,11 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps ++ pass_parameters args nextFPR offsetW' gather_result = case r_rep of - VoidArg -> [] - FloatArg -> + VoidRep -> [] + FloatRep -> [0xd03f0000 .|. (fromIntegral result_off .&. 0xFFFF)] -- stfs f1, result_off(r31) - DoubleArg -> + DoubleRep -> [0xd83f0000 .|. (fromIntegral result_off .&. 0xFFFF)] -- stfd f1, result_off(r31) _ | primRepSizeW r_rep == 2 -> @@ -765,10 +765,11 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps where gather_result :: [Word32] gather_result = case r_rep of - VoidArg -> [] - FloatArg -> storeFloat 1 r_offW - DoubleArg -> storeDouble 1 r_offW - LongArg -> storeLong 3 r_offW + VoidRep -> [] + FloatRep -> storeFloat 1 r_offW + DoubleRep -> storeDouble 1 r_offW + Int64Rep -> storeLong 3 r_offW + Word64Rep -> storeLong 3 r_offW _ -> storeWord 3 r_offW pass_parameters :: [Word32] @@ -780,24 +781,27 @@ mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps ((_,_,argsize), params) = mapAccumL loadparam (3,1,2) arg_offs_n_reps -- handle one argument, returning machine code and the updated state - loadparam :: (Int, Int, Int) -> (Int, CgRep) -> + loadparam :: (Int, Int, Int) -> (Int, PrimRep) -> ((Int, Int, Int), [Word32]) loadparam (gpr, fpr, stack) (ofs, rep) = case rep of - FloatArg | fpr <= 8 -> ( (gpr, fpr + 1, stack), loadFloat fpr ofs ) - FloatArg -> ( (gpr, fpr, stack + 1), stackWord stack ofs ) + FloatRep | fpr <= 8 -> ( (gpr, fpr + 1, stack), loadFloat fpr ofs ) + FloatRep -> ( (gpr, fpr, stack + 1), stackWord stack ofs ) - DoubleArg | fpr <= 8 -> ( (gpr, fpr + 1, stack), loadDouble fpr ofs ) - DoubleArg -> ( (gpr, fpr, astack + 2), stackLong astack ofs ) - - LongArg | even gpr -> loadparam (gpr + 1, fpr, stack) (ofs, rep) - LongArg | gpr <= 9 -> ( (gpr + 2, fpr, stack), loadLong gpr ofs ) - LongArg -> ( (gpr, fpr, astack + 2), stackLong astack ofs ) + DoubleRep | fpr <= 8 -> ( (gpr, fpr + 1, stack), loadDouble fpr ofs ) + DoubleRep -> ( (gpr, fpr, astack + 2), stackLong astack ofs ) + r | is64 r && even gpr -> loadparam (gpr + 1, fpr, stack) (ofs, rep) + r | is64 r && gpr <= 9 -> ( (gpr + 2, fpr, stack), loadLong gpr ofs ) + r | is64 r -> ( (gpr, fpr, astack + 2), stackLong astack ofs ) _ | gpr <= 10 -> ( (gpr + 1, fpr, stack), loadWord gpr ofs ) _ -> ( (gpr, fpr, stack + 1), stackWord stack ofs ) where astack = alignedTo 2 stack + is64 Int64Rep = True + is64 Word64Rep = True + is64 _ = False + alignedTo :: Int -> Int -> Int alignedTo alignment x = case x `mod` alignment of 0 -> x -- 1.7.10.4