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 Bits ( Bits(..), shiftR )
14 import Word ( Word8, Word32 )
15 import Addr ( Addr(..), writeWord8OffAddr )
16 import Foreign ( Ptr(..), mallocBytes )
17 import IOExts ( unsafePerformIO, trace )
21 %************************************************************************
23 \subsection{The sizes of things. These are platform-independent.}
25 %************************************************************************
29 -- When I push one of these on the H stack, how much does Sp move by?
30 taggedSizeW :: PrimRep -> Int
32 | isFollowableRep pr = 1 {-it's a pointer, Jim-}
33 | otherwise = 1 {-the tag-} + getPrimRepSize pr
35 -- The plain size of something, without tag.
36 untaggedSizeW :: PrimRep -> Int
38 | isFollowableRep pr = 1
39 | otherwise = getPrimRepSize pr
41 -- How big is this thing's tag?
42 sizeOfTagW :: PrimRep -> Int
44 | isFollowableRep pr = 0
47 -- Blast a bunch of bytes into malloc'd memory and return the addr.
48 sendBytesToMallocville :: [Word8] -> IO Addr
49 sendBytesToMallocville bytes
50 = do let n = length bytes
51 (Ptr a#) <- mallocBytes n
52 mapM ( \(off,byte) -> writeWord8OffAddr (A# a#) off byte )
57 %************************************************************************
59 \subsection{The platform-dependent marshall-code-generator.}
61 %************************************************************************
66 Make a piece of code which expects to see the Haskell stack
67 looking like this. It is given a pointer to the lowest word in
68 the stack -- presumably the tag of the placeholder.
74 <placeholder-for-result#> (must be an unboxed type)
76 mkMarshalCode :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
78 mkMarshalCode (r_offW, r_rep) addr_offW arg_offs_n_reps
79 = let bytes = mkMarshalCode_wrk (r_offW, r_rep)
80 addr_offW arg_offs_n_reps
81 in unsafePerformIO (sendBytesToMallocville bytes)
84 mkMarshalCode_wrk :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
86 mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
88 = let -- Don't change this without first consulting Intel Corp :-)
91 -- addr and result bits offsetsW
92 offset_of_addr_bitsW = addr_offW + sizeOfTagW AddrRep
93 offset_of_res_bitsW = r_offW + sizeOfTagW r_rep
97 [ let -- where this arg's bits start
98 a_bits_offW = a_offW + sizeOfTagW a_rep
101 [a_bits_offW .. a_bits_offW + untaggedSizeW a_rep - 1]
103 | (a_offW, a_rep) <- reverse arg_offs_n_reps
106 -- some helpers to assemble x86 insns.
107 movl_offespmem_esi offB -- movl offB(%esp), %esi
108 = [0x8B, 0xB4, 0x24] ++ lit32 offB
109 movl_offesimem_ecx offB -- movl offB(%esi), %ecx
110 = [0x8B, 0x8E] ++ lit32 offB
111 save_regs -- pushl all intregs except %esp
112 = [0x50, 0x53, 0x51, 0x52, 0x56, 0x57, 0x55]
113 restore_regs -- popl ditto
114 = [0x5D, 0x5F, 0x5E, 0x5A, 0x59, 0x5B, 0x58]
115 pushl_ecx -- pushl %ecx
117 call_star_ecx -- call * %ecx
119 add_lit_esp lit -- addl $lit, %esp
120 = [0x81, 0xC4] ++ lit32 lit
121 movl_eax_offesimem offB -- movl %eax, offB(%esi)
122 = [0x89, 0x86] ++ lit32 offB
125 fstl_offesimem offB -- fstl offB(%esi)
126 = [0xDD, 0x96] ++ lit32 offB
127 fsts_offesimem offB -- fsts offB(%esi)
128 = [0xD9, 0x96] ++ lit32 offB
129 lit32 :: Int -> [Word8]
130 lit32 i = let w32 = (fromIntegral i) :: Word32
131 in map (fromIntegral . ( .&. 0xFF))
132 [w32, w32 `shiftR` 8,
133 w32 `shiftR` 16, w32 `shiftR` 24]
135 2 0000 8BB42478 movl 0x12345678(%esp), %esi
137 3 0007 8B8E7856 movl 0x12345678(%esi), %ecx
140 5 000d 50535152 pushl %eax ; pushl %ebx ; pushl %ecx ; pushl %edx
141 6 0011 565755 pushl %esi ; pushl %edi ; pushl %ebp
143 8 0014 5D5F5E popl %ebp ; popl %edi ; popl %esi
144 9 0017 5A595B58 popl %edx ; popl %ecx ; popl %ebx ; popl %eax
146 11 001b 51 pushl %ecx
147 12 001c FFD1 call * %ecx
149 14 001e 81C47856 addl $0x12345678, %esp
151 15 0024 89867856 movl %eax, 0x12345678(%esi)
153 16 002a 89967856 movl %edx, 0x12345678(%esi)
156 18 0030 DD967856 fstl 0x12345678(%esi)
158 19 0036 DD9E7856 fstpl 0x12345678(%esi)
160 20 003c D9967856 fsts 0x12345678(%esi)
162 21 0042 D99E7856 fstps 0x12345678(%esi)
170 --trace (show (map fst arg_offs_n_reps))
172 {- On entry, top of C stack 0(%esp) is the RA and 4(%esp) is
173 arg passed from the interpreter.
175 Push all callee saved regs. Push all of them anyway ...
186 {- Now 28+0(%esp) is RA and 28+4(%esp) is the arg (the H stack ptr).
187 We'll use %esi as a temporary to point at the H stack, and
188 %ecx as a temporary to copy via.
190 movl 28+4(%esp), %esi
192 ++ movl_offespmem_esi 32
194 {- For each arg in args_offs_n_reps, examine the associated PrimRep
195 to determine how many payload (non-tag) words there are, and
196 whether or not there is a tag. This gives a bunch of offsets on
197 the H stack to copy to the C stack:
199 movl off1(%esi), %ecx
202 ++ concatMap (\offW -> movl_offesimem_ecx (bytes_per_word * offW)
206 {- Get the addr to call into %ecx, bearing in mind that there's
207 an Addr# tag at the indicated location, and do the call:
209 movl 4*(1 /*tag*/ +addr_offW)(%esi), %ecx
212 ++ movl_offesimem_ecx (bytes_per_word * offset_of_addr_bitsW)
215 {- Nuke the args just pushed and re-establish %esi at the
218 addl $4*number_of_args_pushed, %esp (ccall only)
219 movl 28+4(%esp), %esi
221 ++ add_lit_esp (bytes_per_word * length offsets_to_pushW)
222 ++ movl_offespmem_esi 32
224 {- Depending on what the return type is, get the result
225 from %eax or %edx:%eax or %st(0).
227 movl %eax, 4(%esi) -- assuming tagged result
237 IntRep -> movl_eax_offesimem 4
238 WordRep -> movl_eax_offesimem 4
239 AddrRep -> movl_eax_offesimem 4
240 DoubleRep -> fstl_offesimem 4
241 FloatRep -> fsts_offesimem 4
242 other -> pprPanic "ByteCodeFFI.mkMarshalCode_wrk(x86)" (ppr r_rep)
244 {- Restore all the pushed regs and go home.