Commit 1222d1f1 authored by sewardj's avatar sewardj
Browse files

[project @ 2001-08-09 10:54:13 by sewardj]

Add support for passing ptr/byte arrays to C.
parent e8abb8d2
......@@ -43,6 +43,8 @@ import Unique ( mkPseudoUnique3 )
import FastString ( FastString(..) )
import Panic ( GhcException(..) )
import PprType ( pprType )
import SMRep ( arrWordsHdrSize, arrPtrsHdrSize )
import Constants ( wORD_SIZE )
import ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO, bciStackUse )
import ByteCodeItbls ( ItblEnv, mkITbls )
import ByteCodeLink ( UnlinkedBCO, UnlinkedBCOExpr, assembleBCO,
......@@ -660,11 +662,38 @@ generateCCall d0 s p ccall_spec@(CCallSpec target cconv safety) fn args_r_to_l
]
in pargs d_now az `thenBc` \ rest ->
returnBc ((code, AddrRep) : rest)
ArrayRep
-> pargs (d + addr_tsizeW) az `thenBc` \ rest ->
parg_ArrayishRep arrPtrsHdrSize d p a
`thenBc` \ code ->
returnBc ((code,AddrRep):rest)
ByteArrayRep
-> pargs (d + addr_tsizeW) az `thenBc` \ rest ->
parg_ArrayishRep arrWordsHdrSize d p a
`thenBc` \ code ->
returnBc ((code,AddrRep):rest)
-- Default case: push taggedly, but otherwise intact.
other
-> pushAtom True d p a `thenBc` \ (code_a, sz_a) ->
pargs (d+sz_a) az `thenBc` \ rest ->
returnBc ((code_a, rep_arg) : rest)
-- Do magic for Ptr/Byte arrays. Push a ptr to the array on
-- the stack but then advance it over the headers, so as to
-- point to the payload.
parg_ArrayishRep hdrSizeW d p a
= pushAtom False{-irrel-} d p a `thenBc` \ (push_fo, _) ->
-- The ptr points at the header. Advance it over the
-- header and then pretend this is an Addr# (push a tag).
returnBc (push_fo `snocOL`
SWIZZLE 0 (hdrSizeW * untaggedSizeW PtrRep
* wORD_SIZE)
`snocOL`
PUSH_TAG addr_usizeW)
in
pargs d0 args_r_to_l `thenBc` \ code_n_reps ->
let
......
......@@ -101,6 +101,8 @@ data BCInstr
-- For doing calls to C (via glue code generated by ByteCodeFFI)
| CCALL Addr -- of the glue code
| SWIZZLE Int Int -- to the ptr N words down the stack,
-- add M (interpreted as a signed 16-bit entity)
-- To Infinity And Beyond
| ENTER
......@@ -156,6 +158,8 @@ instance Outputable BCInstr where
ppr (RETURN pk) = text "RETURN " <+> ppr pk
ppr (CCALL marshall_addr) = text "CCALL " <+> text "marshall code at"
<+> text (show marshall_addr)
ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
<+> text "by" <+> int n
-- The stack use, in words, of each bytecode insn. These _must_ be
-- correct, or overestimates of reality, to be safe.
......@@ -186,6 +190,7 @@ bciStackUse (JMP lab) = 0
bciStackUse ENTER = 0
bciStackUse (RETURN pk) = 0
bciStackUse (CCALL marshall_addr) = 0
bciStackUse (SWIZZLE stkoff n) = 0
-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info. Not that it matters much.
......
......@@ -227,6 +227,7 @@ mkBits findLabel st proto_insns
doInstr :: AsmState -> BCInstr -> IO AsmState
doInstr st i
= case i of
SWIZZLE stkoff n -> instr3 st i_SWIZZLE stkoff n
ARGCHECK n -> instr2 st i_ARGCHECK n
STKCHECK n -> instr2 st i_STKCHECK n
PUSH_L o1 -> instr2 st i_PUSH_L o1
......@@ -617,8 +618,10 @@ i_STKCHECK = (bci_STKCHECK :: Int)
i_JMP = (bci_JMP :: Int)
#ifdef bci_CCALL
i_CCALL = (bci_CCALL :: Int)
i_SWIZZLE = (bci_SWIZZLE :: Int)
#else
i_CCALL = error "Sorry pal, you need to bootstrap to use i_CCALL."
i_SWIZZLE = error "Sorry pal, you need to bootstrap to use i_SWIZZLE."
#endif
iNTERP_STACK_CHECK_THRESH = (INTERP_STACK_CHECK_THRESH :: Int)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment