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"
11 import PrimRep ( PrimRep(..), getPrimRepSize, isFollowableRep )
12 import Bits ( Bits(..), shiftR )
13 import Word ( Word8, Word32 )
14 import Addr ( Addr(..), writeWord8OffAddr )
15 import Foreign ( Ptr(..), mallocBytes )
16 import IOExts ( unsafePerformIO, trace )
20 %************************************************************************
22 \subsection{The sizes of things. These are platform-independent.}
24 %************************************************************************
28 -- When I push one of these on the H stack, how much does Sp move by?
29 taggedSizeW :: PrimRep -> Int
31 | isFollowableRep pr = 1 {-it's a pointer, Jim-}
32 | otherwise = 1 {-the tag-} + getPrimRepSize pr
34 -- The plain size of something, without tag.
35 untaggedSizeW :: PrimRep -> Int
37 | isFollowableRep pr = 1
38 | otherwise = getPrimRepSize pr
40 -- How big is this thing's tag?
41 sizeOfTagW :: PrimRep -> Int
43 | isFollowableRep pr = 0
46 -- Blast a bunch of bytes into malloc'd memory and return the addr.
47 sendBytesToMallocville :: [Word8] -> IO Addr
48 sendBytesToMallocville bytes
49 = do let n = length bytes
50 (Ptr a#) <- mallocBytes n
51 mapM ( \(off,byte) -> writeWord8OffAddr (A# a#) off byte )
56 %************************************************************************
58 \subsection{The platform-dependent marshall-code-generator.}
60 %************************************************************************
65 Make a piece of code which expects to see the Haskell stack
66 looking like this. It is given a pointer to the lowest word in
67 the stack -- presumably the tag of the placeholder.
73 <placeholder-for-result#> (must be an unboxed type)
75 mkMarshalCode :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
77 mkMarshalCode (r_offW, r_rep) addr_offW arg_offs_n_reps
78 = let bytes = mkMarshalCode_wrk (r_offW, r_rep)
79 addr_offW arg_offs_n_reps
80 in unsafePerformIO (sendBytesToMallocville bytes)
83 mkMarshalCode_wrk :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
85 mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
87 = let -- Don't change this without first consulting Intel Corp :-)
90 -- addr and result bits offsetsW
91 offset_of_addr_bitsW = addr_offW + sizeOfTagW AddrRep
92 offset_of_res_bitsW = r_offW + sizeOfTagW r_rep
96 [ let -- where this arg's bits start
97 a_bits_offW = a_offW + sizeOfTagW a_rep
99 [a_bits_offW .. a_bits_offW + untaggedSizeW a_rep - 1]
101 | (a_offW, a_rep) <- reverse arg_offs_n_reps
104 -- some helpers to assemble x86 insns.
105 movl_offespmem_esi offB -- movl offB(%esp), %esi
106 = [0x8B, 0xB4, 0x24] ++ lit32 offB
107 movl_offesimem_ecx offB -- movl offB(%esi), %ecx
108 = [0x8B, 0x8E] ++ lit32 offB
109 save_regs -- pushl all intregs except %esp
110 = [0x50, 0x53, 0x51, 0x52, 0x56, 0x57, 0x55]
111 restore_regs -- popl ditto
112 = [0x5D, 0x5F, 0x5E, 0x5A, 0x59, 0x5B, 0x58]
113 pushl_ecx -- pushl %ecx
115 call_star_ecx -- call * %ecx
117 add_lit_esp lit -- addl $lit, %esp
118 = [0x81, 0xC4] ++ lit32 lit
119 movl_eax_offesimem offB -- movl %eax, offB(%esi)
120 = [0x89, 0x86] ++ lit32 offB
124 lit32 :: Int -> [Word8]
125 lit32 i = let w32 = (fromIntegral i) :: Word32
126 in map (fromIntegral . ( .&. 0xFF))
127 [w32, w32 `shiftR` 8,
128 w32 `shiftR` 16, w32 `shiftR` 24]
130 2 0000 8BB42478 movl 0x12345678(%esp), %esi
132 3 0007 8B8E7856 movl 0x12345678(%esi), %ecx
135 5 000d 50535152 pushl %eax ; pushl %ebx ; pushl %ecx ; pushl %edx
136 6 0011 565755 pushl %esi ; pushl %edi ; pushl %ebp
138 8 0014 5D5F5E popl %ebp ; popl %edi ; popl %esi
139 9 0017 5A595B58 popl %edx ; popl %ecx ; popl %ebx ; popl %eax
141 11 001b 51 pushl %ecx
142 12 001c FFD1 call * %ecx
144 14 001e 81C47856 addl $0x12345678, %esp
146 15 0024 89867856 movl %eax, 0x12345678(%esi)
148 16 002a 89967856 movl %edx, 0x12345678(%esi)
157 trace (show (map fst arg_offs_n_reps))
159 {- On entry, top of C stack 0(%esp) is the RA and 4(%esp) is
160 arg passed from the interpreter.
162 Push all callee saved regs. Push all of them anyway ...
173 {- Now 28+0(%esp) is RA and 28+4(%esp) is the arg (the H stack ptr).
174 We'll use %esi as a temporary to point at the H stack, and
175 %ecx as a temporary to copy via.
177 movl 28+4(%esp), %esi
179 ++ movl_offespmem_esi 32
181 {- For each arg in args_offs_n_reps, examine the associated PrimRep
182 to determine how many payload (non-tag) words there are, and
183 whether or not there is a tag. This gives a bunch of offsets on
184 the H stack to copy to the C stack:
186 movl off1(%esi), %ecx
189 ++ concatMap (\offW -> movl_offesimem_ecx (bytes_per_word * offW)
193 {- Get the addr to call into %ecx, bearing in mind that there's
194 an Addr# tag at the indicated location, and do the call:
196 movl 4*(1 /*tag*/ +addr_offW)(%esi), %ecx
199 ++ movl_offesimem_ecx (bytes_per_word * offset_of_addr_bitsW)
202 {- Nuke the args just pushed and re-establish %esi at the
205 addl $4*number_of_args_pushed, %esp (ccall only)
206 movl 28+4(%esp), %esi
208 ++ add_lit_esp (bytes_per_word * length offsets_to_pushW)
209 ++ movl_offespmem_esi 32
211 {- Depending on what the return type is, get the result
212 from %eax or %edx:%eax or %st(0).
214 movl %eax, 4(%esi) -- assuming tagged result
224 IntRep -> movl_eax_offesimem 4
226 {- Restore all the pushed regs and go home.