ghc/compiler/ghci/ByteCodeFFI.lhs

   1 %
   2 % (c) The University of Glasgow 2000
   3 %
   4 \section[ByteCodeGen]{Generate bytecode from Core}
   5
   6 \begin{code}
   7 module ByteCodeFFI ( taggedSizeW, untaggedSizeW, mkMarshalCode ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Outputable
  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 )
  18
  19 \end{code}
  20
  21 %************************************************************************
  22 %*                                                                      *
  23 \subsection{The sizes of things.  These are platform-independent.}
  24 %*                                                                      *
  25 %************************************************************************
  26
  27 \begin{code}
  28
  29 -- When I push one of these on the H stack, how much does Sp move by?
  30 taggedSizeW :: PrimRep -> Int
  31 taggedSizeW pr
  32    | isFollowableRep pr = 1 {-it's a pointer, Jim-}
  33    | otherwise          = 1 {-the tag-} + getPrimRepSize pr
  34
  35 -- The plain size of something, without tag.
  36 untaggedSizeW :: PrimRep -> Int
  37 untaggedSizeW pr
  38    | isFollowableRep pr = 1
  39    | otherwise          = getPrimRepSize pr
  40
  41 -- How big is this thing's tag?
  42 sizeOfTagW :: PrimRep -> Int
  43 sizeOfTagW pr
  44    | isFollowableRep pr = 0
  45    | otherwise          = 1
  46
  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 )
  53              (zip [0 ..] bytes)
  54         return (A# a#)
  55 \end{code}
  56
  57 %************************************************************************
  58 %*                                                                      *
  59 \subsection{The platform-dependent marshall-code-generator.}
  60 %*                                                                      *
  61 %************************************************************************
  62
  63 \begin{code}
  64
  65 {-
  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.
  69
  70                   <arg_n>
  71                   ...
  72                   <arg_1>
  73                   Addr# address_of_C_fn
  74                   <placeholder-for-result#> (must be an unboxed type)
  75 -}
  76 mkMarshalCode :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
  77               -> Addr
  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)
  82
  83
  84 mkMarshalCode_wrk :: (Int, PrimRep) -> Int -> [(Int, PrimRep)]
  85                   -> [Word8]
  86 mkMarshalCode_wrk (r_offW, r_rep) addr_offW arg_offs_n_reps
  87
  88    = let -- Don't change this without first consulting Intel Corp :-)
  89          bytes_per_word = 4
  90
  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
  94
  95          offsets_to_pushW
  96             = concat
  97               [ let -- where this arg's bits start
  98                     a_bits_offW = a_offW + sizeOfTagW a_rep
  99                 in
 100                     reverse
 101                     [a_bits_offW .. a_bits_offW + untaggedSizeW a_rep - 1]
 102
 103                 | (a_offW, a_rep) <- reverse arg_offs_n_reps
 104               ]
 105
 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
 116             = [0x51]
 117          call_star_ecx                  -- call   * %ecx
 118             = [0xFF, 0xD1]
 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
 123          ret                            -- ret
 124             = [0xC3]
 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]
 134          {-
 135              2 0000 8BB42478    movl    0x12345678(%esp), %esi
 136              2      563412
 137              3 0007 8B8E7856    movl    0x12345678(%esi), %ecx
 138              3      3412
 139              4
 140              5 000d 50535152    pushl %eax ; pushl %ebx ; pushl %ecx ; pushl  %edx
 141              6 0011 565755      pushl %esi ; pushl %edi ; pushl %ebp
 142              7
 143              8 0014 5D5F5E      popl %ebp ; popl %edi ; popl %esi
 144              9 0017 5A595B58    popl %edx ; popl %ecx ; popl %ebx ; popl %eax
 145             10
 146             11 001b 51          pushl %ecx
 147             12 001c FFD1        call * %ecx
 148             13
 149             14 001e 81C47856    addl $0x12345678, %esp
 150             14      3412
 151             15 0024 89867856    movl %eax, 0x12345678(%esi)
 152             15      3412
 153             16 002a 89967856    movl %edx, 0x12345678(%esi)
 154             16      3412
 155             17
 156             18 0030 DD967856    fstl    0x12345678(%esi)
 157             18      3412
 158             19 0036 DD9E7856    fstpl   0x12345678(%esi)
 159             19      3412
 160             20 003c D9967856    fsts    0x12345678(%esi)
 161             20      3412
 162             21 0042 D99E7856    fstps   0x12345678(%esi)
 163             18
 164             19 0030 C3          ret
 165             20
 166
 167          -}
 168
 169      in
 170      --trace (show (map fst arg_offs_n_reps))
 171      (
 172      {- On entry, top of C stack 0(%esp) is the RA and 4(%esp) is
 173         arg passed from the interpreter.
 174
 175         Push all callee saved regs.  Push all of them anyway ...
 176            pushl       %eax
 177            pushl       %ebx
 178            pushl       %ecx
 179            pushl       %edx
 180            pushl       %esi
 181            pushl       %edi
 182            pushl       %ebp
 183      -}
 184      save_regs
 185
 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.
 189
 190            movl        28+4(%esp), %esi
 191      -}
 192      ++ movl_offespmem_esi 32
 193
 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:
 198
 199            movl        off1(%esi), %ecx
 200            pushl       %ecx
 201      -}
 202      ++ concatMap (\offW -> movl_offesimem_ecx (bytes_per_word * offW)
 203                             ++ pushl_ecx)
 204                   offsets_to_pushW
 205
 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:
 208
 209            movl        4*(1 /*tag*/ +addr_offW)(%esi), %ecx
 210            call        * %ecx
 211      -}
 212      ++ movl_offesimem_ecx (bytes_per_word * offset_of_addr_bitsW)
 213      ++ call_star_ecx
 214
 215      {- Nuke the args just pushed and re-establish %esi at the
 216         H-stack ptr:
 217
 218            addl        $4*number_of_args_pushed, %esp (ccall only)
 219            movl        28+4(%esp), %esi
 220      -}
 221      ++ add_lit_esp (bytes_per_word * length offsets_to_pushW)
 222      ++ movl_offespmem_esi 32
 223
 224      {- Depending on what the return type is, get the result
 225         from %eax or %edx:%eax or %st(0).
 226
 227            movl        %eax, 4(%esi)        -- assuming tagged result
 228         or
 229            movl        %edx, 4(%esi)
 230            movl        %eax, 8(%esi)
 231         or
 232            fstl        4(%esi)
 233         or
 234            fsts        4(%esi)
 235      -}
 236      ++ case r_rep of
 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)
 243
 244      {- Restore all the pushed regs and go home.
 245
 246            pushl        %ebp
 247            pushl        %edi
 248            pushl        %esi
 249            pushl        %edx
 250            pushl        %ecx
 251            pushl        %ebx
 252            pushl        %eax
 253
 254            ret
 255      -}
 256      ++ restore_regs
 257      ++ ret
 258      )
 259 \end{code}
 260