2 % (c) The University of Glasgow 2000
4 \section[ByteCodeGen]{Generate bytecode from Core}
7 module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode ) where
9 #include "HsVersions.h"
12 import PrimRep ( PrimRep(..), getPrimRepSize, isFollowableRep )
13 import ForeignCall ( CCallConv(..) )
14 import Bits ( Bits(..), shiftR )
15 import Word ( Word8, Word32 )
16 import Addr ( Addr(..), writeWord8OffAddr )
17 import Foreign ( Ptr(..), mallocBytes )
18 import IOExts ( unsafePerformIO, trace )
22 %************************************************************************
24 \subsection{The sizes of things. These are platform-independent.}
26 %************************************************************************
30 -- When I push one of these on the H stack, how much does Sp move by?
31 taggedSizeW :: PrimRep -> Int
33 | isFollowableRep pr = 1 {-it's a pointer, Jim-}
34 | otherwise = 1 {-the tag-} + getPrimRepSize pr
36 -- The plain size of something, without tag.
37 untaggedSizeW :: PrimRep -> Int
39 | isFollowableRep pr = 1
40 | otherwise = getPrimRepSize pr
42 -- How big is this thing's tag?
43 sizeOfTagW :: PrimRep -> Int
45 | isFollowableRep pr = 0
48 -- Blast a bunch of bytes into malloc'd memory and return the addr.
49 sendBytesToMallocville :: [Word8] -> IO Addr
50 sendBytesToMallocville bytes
51 = do let n = length bytes
52 (Ptr a#) <- mallocBytes n
53 mapM ( \(off,byte) -> writeWord8OffAddr (A# a#) off byte )
58 %************************************************************************
60 \subsection{The platform-dependent marshall-code-generator.}
62 %************************************************************************
66 -- For sparc_TARGET_ARCH, i386_TARGET_ARCH, etc.
67 #include "nativeGen/NCG.h"
70 Make a piece of code which expects to see the Haskell stack
71 looking like this. It is given a pointer to the lowest word in
72 the stack -- presumably the tag of the placeholder.
78 <placeholder-for-result#> (must be an unboxed type)
80 We cope with both ccall and stdcall for the C fn. However, this code
81 itself expects only to be called using the ccall convention -- that is,
82 we don't clear our own (single) arg off the C stack.
84 mkMarshalCode :: CCallConv
85 -> (Int, PrimRep) -> Int -> [(Int, PrimRep)]
87 mkMarshalCode cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
88 = let bytes = mkMarshalCode_wrk cconv (r_offW, r_rep)
89 addr_offW arg_offs_n_reps
90 in unsafePerformIO (sendBytesToMallocville bytes)
95 mkMarshalCode_wrk :: CCallConv
96 -> (Int, PrimRep) -> Int -> [(Int, PrimRep)]
101 mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
103 = let -- Don't change this without first consulting Intel Corp :-)
106 -- addr and result bits offsetsW
107 offset_of_addr_bitsW = addr_offW + sizeOfTagW AddrRep
108 offset_of_res_bitsW = r_offW + sizeOfTagW r_rep
112 [ let -- where this arg's bits start
113 a_bits_offW = a_offW + sizeOfTagW a_rep
116 [a_bits_offW .. a_bits_offW + untaggedSizeW a_rep - 1]
118 | (a_offW, a_rep) <- reverse arg_offs_n_reps
121 -- some helpers to assemble x86 insns.
122 movl_offespmem_esi offB -- movl offB(%esp), %esi
123 = [0x8B, 0xB4, 0x24] ++ lit32 offB
124 movl_offesimem_ecx offB -- movl offB(%esi), %ecx
125 = [0x8B, 0x8E] ++ lit32 offB
126 save_regs -- pushl all intregs except %esp
127 = [0x50, 0x53, 0x51, 0x52, 0x56, 0x57, 0x55]
128 restore_regs -- popl ditto
129 = [0x5D, 0x5F, 0x5E, 0x5A, 0x59, 0x5B, 0x58]
130 pushl_ecx -- pushl %ecx
132 call_star_ecx -- call * %ecx
134 add_lit_esp lit -- addl $lit, %esp
135 = [0x81, 0xC4] ++ lit32 lit
136 movl_eax_offesimem offB -- movl %eax, offB(%esi)
137 = [0x89, 0x86] ++ lit32 offB
140 fstpl_offesimem offB -- fstpl offB(%esi)
141 = [0xDD, 0x9E] ++ lit32 offB
142 fstps_offesimem offB -- fstps offB(%esi)
143 = [0xD9, 0x9E] ++ lit32 offB
144 lit32 :: Int -> [Word8]
145 lit32 i = let w32 = (fromIntegral i) :: Word32
146 in map (fromIntegral . ( .&. 0xFF))
147 [w32, w32 `shiftR` 8,
148 w32 `shiftR` 16, w32 `shiftR` 24]
150 2 0000 8BB42478 movl 0x12345678(%esp), %esi
152 3 0007 8B8E7856 movl 0x12345678(%esi), %ecx
155 5 000d 50535152 pushl %eax ; pushl %ebx ; pushl %ecx ; pushl %edx
156 6 0011 565755 pushl %esi ; pushl %edi ; pushl %ebp
158 8 0014 5D5F5E popl %ebp ; popl %edi ; popl %esi
159 9 0017 5A595B58 popl %edx ; popl %ecx ; popl %ebx ; popl %eax
161 11 001b 51 pushl %ecx
162 12 001c FFD1 call * %ecx
164 14 001e 81C47856 addl $0x12345678, %esp
166 15 0024 89867856 movl %eax, 0x12345678(%esi)
168 16 002a 89967856 movl %edx, 0x12345678(%esi)
171 18 0030 DD967856 fstl 0x12345678(%esi)
173 19 0036 DD9E7856 fstpl 0x12345678(%esi)
175 20 003c D9967856 fsts 0x12345678(%esi)
177 21 0042 D99E7856 fstps 0x12345678(%esi)
185 --trace (show (map fst arg_offs_n_reps))
187 {- On entry, top of C stack 0(%esp) is the RA and 4(%esp) is
188 arg passed from the interpreter.
190 Push all callee saved regs. Push all of them anyway ...
201 {- Now 28+0(%esp) is RA and 28+4(%esp) is the arg (the H stack ptr).
202 We'll use %esi as a temporary to point at the H stack, and
203 %ecx as a temporary to copy via.
205 movl 28+4(%esp), %esi
207 ++ movl_offespmem_esi 32
209 {- For each arg in args_offs_n_reps, examine the associated PrimRep
210 to determine how many payload (non-tag) words there are, and
211 whether or not there is a tag. This gives a bunch of offsets on
212 the H stack to copy to the C stack:
214 movl off1(%esi), %ecx
217 ++ concatMap (\offW -> movl_offesimem_ecx (bytes_per_word * offW)
221 {- Get the addr to call into %ecx, bearing in mind that there's
222 an Addr# tag at the indicated location, and do the call:
224 movl 4*(1 /*tag*/ +addr_offW)(%esi), %ecx
227 ++ movl_offesimem_ecx (bytes_per_word * offset_of_addr_bitsW)
230 {- Nuke the args just pushed and re-establish %esi at the
233 addl $4*number_of_args_pushed, %esp (ccall only)
234 movl 28+4(%esp), %esi
236 ++ (if cconv /= StdCallConv
237 then add_lit_esp (bytes_per_word * length offsets_to_pushW)
239 ++ movl_offespmem_esi 32
241 {- Depending on what the return type is, get the result
242 from %eax or %edx:%eax or %st(0).
244 movl %eax, 4(%esi) -- assuming tagged result
254 IntRep -> movl_eax_offesimem 4
255 WordRep -> movl_eax_offesimem 4
256 AddrRep -> movl_eax_offesimem 4
257 DoubleRep -> fstpl_offesimem 4
258 FloatRep -> fstps_offesimem 4
260 other -> pprPanic "ByteCodeFFI.mkMarshalCode_wrk(x86)" (ppr r_rep)
262 {- Restore all the pushed regs and go home.
278 #else /* i386_TARGET_ARCH */
280 mkMarshalCode_wrk = undefined
282 #endif /* i386_TARGET_ARCH */