#include "HsVersions.h"
import ByteCodeInstr
+import ByteCodeItbls
import ByteCodeFFI
import ByteCodeAsm
import ByteCodeLink
import Data.List ( intersperse, sortBy, zip4, zip6, partition )
import Foreign ( Ptr, castPtr, mallocBytes, pokeByteOff, Word8,
- withForeignPtr )
+ withForeignPtr, castFunPtrToPtr )
import Foreign.C ( CInt )
import Control.Exception ( throwDyn )
-> Int
-> [StgWord]
-> Bool -- True <=> is a return point, rather than a function
- -> [Ptr ()]
+ -> [BcPtr]
-> ProtoBCO name
mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap
is_ret mallocd_blocks
-- don't do stack checks at return points;
-- everything is aggregated up to the top BCO
-- (which must be a function)
- | stack_overest >= 65535
- = pprPanic "mkProtoBCO: stack use won't fit in 16 bits"
- (int stack_overest)
| stack_overest >= iNTERP_STACK_CHECK_THRESH
= STKCHECK stack_overest : peep_d
| otherwise
= peep_d -- the supposedly common case
+ -- We assume that this sum doesn't wrap
stack_overest = sum (map bciStackUse peep_d)
-- Merge local pushes
ioToBc (mkMarshalCode cconv
(r_offW, r_rep) addr_offW
(zip args_offW a_reps)) `thenBc` \ addr_of_marshaller ->
- recordMallocBc addr_of_marshaller `thenBc_`
+ recordItblMallocBc (ItblPtr (castFunPtrToPtr addr_of_marshaller)) `thenBc_`
let
-- Offset of the next stack frame down the stack. The CCALL
-- instruction needs to describe the chunk of stack containing
stk_offset = d_after_r - s
-- do the call
- do_call = unitOL (CCALL stk_offset (castPtr addr_of_marshaller))
+ do_call = unitOL (CCALL stk_offset (castFunPtrToPtr addr_of_marshaller))
-- slide and return
wrapup = mkSLIDE r_sizeW (d_after_r - r_sizeW - s)
`snocOL` RETURN_UBX r_rep
NonPtrArg -> MachWord 0
DoubleArg -> MachDouble 0
FloatArg -> MachFloat 0
+ LongArg -> MachWord64 0
_ -> moan64 "mkDummyLiteral" (ppr pr)
-- to be on the safe side we copy the string into
-- a malloc'd area of memory.
ioToBc (mallocBytes (n+1)) `thenBc` \ ptr ->
- recordMallocBc ptr `thenBc_`
+ recordMallocBc ptr `thenBc_`
ioToBc (
withForeignPtr fp $ \p -> do
memcpy ptr p (fromIntegral n)
-- -----------------------------------------------------------------------------
-- The bytecode generator's monad
+type BcPtr = Either ItblPtr (Ptr ())
+
data BcM_State
= BcM_State {
nextlabel :: Int, -- for generating local labels
- malloced :: [Ptr ()] } -- ptrs malloced for current BCO
+ malloced :: [BcPtr] } -- thunks malloced for current BCO
-- Should be free()d when it is GCd
newtype BcM r = BcM (BcM_State -> IO (BcM_State, r))
(>>) = thenBc_
return = returnBc
-emitBc :: ([Ptr ()] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
+emitBc :: ([BcPtr] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
emitBc bco
= BcM $ \st -> return (st{malloced=[]}, bco (malloced st))
recordMallocBc :: Ptr a -> BcM ()
recordMallocBc a
- = BcM $ \st -> return (st{malloced = castPtr a : malloced st}, ())
+ = BcM $ \st -> return (st{malloced = Right (castPtr a) : malloced st}, ())
+
+recordItblMallocBc :: ItblPtr -> BcM ()
+recordItblMallocBc a
+ = BcM $ \st -> return (st{malloced = Left a : malloced st}, ())
getLabelBc :: BcM Int
getLabelBc