\section[ByteCodeGen]{Generate machine-code sequences for foreign import}
\begin{code}
-module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode, moan64 ) where
+module ByteCodeFFI ( mkMarshalCode, moan64 ) where
#include "HsVersions.h"
import Outputable
-import PrimRep ( PrimRep(..), getPrimRepSize, isFollowableRep )
+import SMRep ( CgRep(..), cgRepSizeW )
import ForeignCall ( CCallConv(..) )
--- DON'T remove apparently unused imports here .. there is ifdeffery
--- below
-import Bits ( Bits(..), shiftR, shiftL )
+-- DON'T remove apparently unused imports here ..
+-- there is ifdeffery below
+import DATA_BITS ( Bits(..), shiftR, shiftL )
import Foreign ( newArray )
-import Data.Word ( Word8, Word32 )
-import Foreign ( Ptr, mallocBytes )
-import Debug.Trace ( trace )
+import DATA_WORD ( Word8, Word32 )
+import Foreign ( Ptr )
import System.IO.Unsafe ( unsafePerformIO )
import IO ( hPutStrLn, stderr )
-\end{code}
-
-%************************************************************************
-%* *
-\subsection{The sizes of things. These are platform-independent.}
-%* *
-%************************************************************************
-
-\begin{code}
-
--- When I push one of these on the H stack, how much does Sp move by?
-taggedSizeW :: PrimRep -> Int
-taggedSizeW pr
- | isFollowableRep pr = 1 {-it's a pointer, Jim-}
- | otherwise = 1 {-the tag-} + getPrimRepSize pr
-
--- The plain size of something, without tag.
-untaggedSizeW :: PrimRep -> Int
-untaggedSizeW pr
- | isFollowableRep pr = 1
- | otherwise = getPrimRepSize pr
-
--- How big is this thing's tag?
-sizeOfTagW :: PrimRep -> Int
-sizeOfTagW pr
- | isFollowableRep pr = 0
- | otherwise = 1
+-- import Debug.Trace ( trace )
\end{code}
%************************************************************************
we don't clear our own (single) arg off the C stack.
-}
mkMarshalCode :: CCallConv
- -> (Int, PrimRep) -> Int -> [(Int, PrimRep)]
+ -> (Int, CgRep) -> Int -> [(Int, CgRep)]
-> IO (Ptr Word8)
mkMarshalCode cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
= let bytes = mkMarshalCode_wrk cconv (r_offW, r_rep)
mkMarshalCode_wrk :: CCallConv
- -> (Int, PrimRep) -> Int -> [(Int, PrimRep)]
+ -> (Int, CgRep) -> Int -> [(Int, CgRep)]
-> [Word8]
mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
= let -- Don't change this without first consulting Intel Corp :-)
bytes_per_word = 4
- -- addr and result bits offsetsW
- offset_of_addr_bitsW = addr_offW + sizeOfTagW AddrRep
- offset_of_res_bitsW = r_offW + sizeOfTagW r_rep
-
offsets_to_pushW
= concat
- [ let -- where this arg's bits start
- a_bits_offW = a_offW + sizeOfTagW a_rep
- in
- -- reversed because x86 is little-endian
- reverse
- [a_bits_offW .. a_bits_offW + untaggedSizeW a_rep - 1]
+ [ -- reversed because x86 is little-endian
+ reverse [a_offW .. a_offW + cgRepSizeW a_rep - 1]
-- reversed because args are pushed L -> R onto C stack
| (a_offW, a_rep) <- reverse arg_offs_n_reps
-}
++ movl_offespmem_esi 32
- {- For each arg in args_offs_n_reps, examine the associated PrimRep
- to determine how many payload (non-tag) words there are, and
- whether or not there is a tag. This gives a bunch of offsets on
- the H stack to copy to the C stack:
+ {- For each arg in args_offs_n_reps, examine the associated
+ CgRep to determine how many words there are. This gives a
+ bunch of offsets on the H stack to copy to the C stack:
movl off1(%esi), %ecx
pushl %ecx
movl 4*(1 /*tag*/ +addr_offW)(%esi), %ecx
call * %ecx
-}
- ++ movl_offesimem_ecx (bytes_per_word * offset_of_addr_bitsW)
+ ++ movl_offesimem_ecx (bytes_per_word * addr_offW)
++ call_star_ecx
{- Nuke the args just pushed and re-establish %esi at the
or
fstps 4(%esi)
-}
- ++ let i32 = movl_eax_offesimem 4
- i64 = movl_eax_offesimem 4 ++ movl_edx_offesimem 8
- f32 = fstps_offesimem 4
- f64 = fstpl_offesimem 4
+ ++ let i32 = movl_eax_offesimem 0
+ i64 = movl_eax_offesimem 0 ++ movl_edx_offesimem 4
+ f32 = fstps_offesimem 0
+ f64 = fstpl_offesimem 0
in
case r_rep of
- CharRep -> i32
- IntRep -> i32
- WordRep -> i32
- AddrRep -> i32
- DoubleRep -> f64
- FloatRep -> f32
- -- Word64Rep -> i64
- -- Int64Rep -> i64
- VoidRep -> []
+ NonPtrArg -> i32
+ DoubleArg -> f64
+ FloatArg -> f32
+ -- LongArg -> i64
+ VoidArg -> []
other -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(x86)"
(ppr r_rep)
fromIntegral (0xFF .&. (w `shiftR` 8)),
fromIntegral (0xFF .&. w)]
- -- addr and result bits offsetsW
- offset_of_addr_bitsW = addr_offW + sizeOfTagW AddrRep
- offset_of_res_bitsW = r_offW + sizeOfTagW r_rep
-
offsets_to_pushW
= concat
- [ let -- where this arg's bits start
- a_bits_offW = a_offW + sizeOfTagW a_rep
- in
- [a_bits_offW .. a_bits_offW + untaggedSizeW a_rep - 1]
+ [ [a_offW .. a_offW + cgRepSizeW a_rep - 1]
| (a_offW, a_rep) <- arg_offs_n_reps
]
-}
[mkSAVE sp (- ({-92-}112 + 4*argWs_on_stack_ROUNDED_UP)) sp]
- {- For each arg in args_offs_n_reps, examine the associated PrimRep
- to determine how many payload (non-tag) words there are, and
- whether or not there is a tag. This gives a bunch of offsets on
- the H stack. Move the first 6 words into %o0 .. %o5 and the
- rest on the stack, starting at [%sp+92]. Use %g1 as a temp.
+ {- For each arg in args_offs_n_reps, examine the associated
+ CgRep to determine how many words there are. This gives a
+ bunch of offsets on the H stack. Move the first 6 words into
+ %o0 .. %o5 and the rest on the stack, starting at [%sp+92].
+ Use %g1 as a temp.
-}
++ let doArgW (offW, wordNo)
| wordNo < 6
ld [4*(1 /*tag*/ +addr_offW) + %i0], %g1
call %g1
-}
- ++ [mkLD i0 (bytes_per_word * offset_of_addr_bitsW) g1,
+ ++ [mkLD i0 (bytes_per_word * addr_offW) g1,
mkCALL g1,
mkNOP]
st %f1, [%i0 + 8] -- or the other way round?
-}
- ++ let i32 = [mkST o0 i0 4]
- i64 = [mkST o0 i0 4, mkST o1 i0 8]
- f32 = [mkSTF f0 i0 4]
- f64 = [mkSTF f0 i0 4, mkSTF f1 i0 8]
+ ++ let i32 = [mkST o0 i0 0]
+ i64 = [mkST o0 i0 0, mkST o1 i0 4]
+ f32 = [mkSTF f0 i0 0]
+ f64 = [mkSTF f0 i0 0, mkSTF f1 i0 4]
in
case r_rep of
- CharRep -> i32
- IntRep -> i32
- WordRep -> i32
- AddrRep -> i32
- DoubleRep -> f64
- FloatRep -> f32
- VoidRep -> []
+ NonPtrArg -> i32
+ DoubleArg -> f64
+ FloatArg -> f32
+ VoidArg -> []
other -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(sparc)"
(ppr r_rep)
fromIntegral (0xFF .&. w)]
-- addr and result bits offsetsW
- a_off = (addr_offW + sizeOfTagW AddrRep) * bytes_per_word
- result_off = (r_offW + sizeOfTagW r_rep) * bytes_per_word
+ a_off = addr_offW * bytes_per_word
+ result_off = r_offW * bytes_per_word
linkageArea = 24
- parameterArea = sum [ untaggedSizeW a_rep * bytes_per_word
+ parameterArea = sum [ cgRepSizeW a_rep * bytes_per_word
| (_, a_rep) <- arg_offs_n_reps ]
savedRegisterArea = 4
- frameSize = padTo16 (linkageArea + min parameterArea 32 + savedRegisterArea)
+ frameSize = padTo16 (linkageArea + max parameterArea 32 + savedRegisterArea)
padTo16 x = case x `mod` 16 of
0 -> x
y -> x - y + 16
pass_parameters [] _ _ = []
pass_parameters ((a_offW, a_rep):args) nextFPR offsetW =
let
- haskellArgOffset = (a_offW + sizeOfTagW a_rep)
- * bytes_per_word
- offsetW' = offsetW + untaggedSizeW a_rep
+ haskellArgOffset = a_offW * bytes_per_word
+ offsetW' = offsetW + cgRepSizeW a_rep
pass_word w
- | w < 8 =
+ | offsetW + w < 8 =
[0x801f0000 -- lwz rX, src(r31)
.|. (fromIntegral src .&. 0xFFFF)
.|. (fromIntegral (offsetW+w+3) `shiftL` 21)]
dst = linkageArea + (offsetW+w) * bytes_per_word
in
case a_rep of
- FloatRep | nextFPR < 14 ->
+ FloatArg | nextFPR < 14 ->
(0xc01f0000 -- lfs fX, haskellArgOffset(r31)
.|. (fromIntegral haskellArgOffset .&. 0xFFFF)
.|. (fromIntegral nextFPR `shiftL` 21))
: pass_parameters args (nextFPR+1) offsetW'
- DoubleRep | nextFPR < 14 ->
+ DoubleArg | nextFPR < 14 ->
(0xc81f0000 -- lfd fX, haskellArgOffset(r31)
.|. (fromIntegral haskellArgOffset .&. 0xFFFF)
.|. (fromIntegral nextFPR `shiftL` 21))
: pass_parameters args (nextFPR+1) offsetW'
_ ->
- concatMap pass_word [0 .. untaggedSizeW a_rep - 1]
+ concatMap pass_word [0 .. cgRepSizeW a_rep - 1]
++ pass_parameters args nextFPR offsetW'
gather_result = case r_rep of
- VoidRep -> []
- FloatRep ->
+ VoidArg -> []
+ FloatArg ->
[0xd03f0000 .|. (fromIntegral result_off .&. 0xFFFF)]
-- stfs f1, result_off(r31)
- DoubleRep ->
+ DoubleArg ->
[0xd83f0000 .|. (fromIntegral result_off .&. 0xFFFF)]
-- stfs f1, result_off(r31)
- _ | untaggedSizeW r_rep == 2 ->
+ _ | cgRepSizeW r_rep == 2 ->
[0x907f0000 .|. (fromIntegral result_off .&. 0xFFFF),
0x909f0000 .|. (fromIntegral (result_off+4) .&. 0xFFFF)]
-- stw r3, result_off(r31)
-- stw r4, result_off+4(r31)
- _ | untaggedSizeW r_rep == 1 ->
+ _ | cgRepSizeW r_rep == 1 ->
[0x907f0000 .|. (fromIntegral result_off .&. 0xFFFF)]
-- stw r3, result_off(r31)
in
projects / ghc-hetmet.git / blobdiff