1 -----------------------------------------------------------------------------
3 -- Code generation for foreign calls.
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
14 emitSaveThreadState, -- will be needed by the Cmm parser
15 emitLoadThreadState, -- ditto
41 -- -----------------------------------------------------------------------------
42 -- Code generation for Foreign Calls
45 :: HintedCmmFormals -- where to put the results
46 -> ForeignCall -- the op
47 -> [StgArg] -- arguments
48 -> StgLiveVars -- live vars, in case we need to save them
50 cgForeignCall results fcall stg_args live
52 reps_n_amodes <- getArgAmodes stg_args
54 -- Get the *non-void* args, and jiggle them with shimForeignCall
55 arg_exprs = [ shimForeignCallArg stg_arg expr
56 | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes,
59 arg_hints = zipWith CmmHinted
60 arg_exprs (map (typeForeignHint.stgArgType) stg_args)
62 emitForeignCall results fcall arg_hints live
66 :: HintedCmmFormals -- where to put the results
67 -> ForeignCall -- the op
68 -> [CmmHinted CmmExpr] -- arguments
69 -> StgLiveVars -- live vars, in case we need to save them
72 emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
73 = do vols <- getVolatileRegs live
75 emitForeignCall' safety results
76 (CmmCallee cmm_target cconv) call_args (Just vols) srt CmmMayReturn
78 (call_args, cmm_target)
80 StaticTarget lbl -> (args, CmmLit (CmmLabel
81 (mkForeignLabel lbl call_size False IsFunction)))
82 DynamicTarget -> case args of
83 (CmmHinted fn _):rest -> (rest, fn)
84 [] -> panic "emitForeignCall: DynamicTarget []"
86 -- in the stdcall calling convention, the symbol needs @size appended
87 -- to it, where size is the total number of bytes of arguments. We
88 -- attach this info to the CLabel here, and the CLabel pretty printer
89 -- will generate the suffix when the label is printed.
91 | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprType.hintlessCmm) args))
94 -- ToDo: this might not be correct for 64-bit API
95 arg_size rep = max (widthInBytes (typeWidth rep)) wORD_SIZE
98 -- alternative entry point, used by CmmParse
101 -> HintedCmmFormals -- where to put the results
102 -> CmmCallTarget -- the op
103 -> [CmmHinted CmmExpr] -- arguments
104 -> Maybe [GlobalReg] -- live vars, in case we need to save them
105 -> C_SRT -- the SRT of the calls continuation
108 emitForeignCall' safety results target args vols _srt ret
109 | not (playSafe safety) = do
110 temp_args <- load_args_into_temps args
111 let (caller_save, caller_load) = callerSaveVolatileRegs vols
113 stmtC (CmmCall target results temp_args CmmUnsafe ret)
117 -- Both 'id' and 'new_base' are GCKindNonPtr because they're
118 -- RTS only objects and are not subject to garbage collection
120 new_base <- newTemp (cmmRegType (CmmGlobal BaseReg))
121 temp_args <- load_args_into_temps args
122 temp_target <- load_target_into_temp target
123 let (caller_save, caller_load) = callerSaveVolatileRegs vols
126 -- The CmmUnsafe arguments are only correct because this part
127 -- of the code hasn't been moved into the CPS pass yet.
128 -- Once that happens, this function will just emit a (CmmSafe srt) call,
129 -- and the CPS will be the one to convert that
130 -- to this sequence of three CmmUnsafe calls.
131 stmtC (CmmCall (CmmCallee suspendThread CCallConv)
132 [ CmmHinted id AddrHint ]
133 [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint ]
135 stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
136 stmtC (CmmCall (CmmCallee resumeThread CCallConv)
137 [ CmmHinted new_base AddrHint ]
138 [ CmmHinted (CmmReg (CmmLocal id)) AddrHint ]
140 -- Assign the result to BaseReg: we
141 -- might now have a different Capability!
142 stmtC (CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base)))
146 suspendThread, resumeThread :: CmmExpr
147 suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread")))
148 resumeThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread")))
151 -- we might need to load arguments into temporaries before
152 -- making the call, because certain global registers might
153 -- overlap with registers that the C calling convention uses
154 -- for passing arguments.
156 -- This is a HACK; really it should be done in the back end, but
157 -- it's easier to generate the temporaries here.
158 load_args_into_temps :: [CmmHinted CmmExpr] -> FCode [CmmHinted CmmExpr]
159 load_args_into_temps = mapM arg_assign_temp
160 where arg_assign_temp (CmmHinted e hint) = do
161 tmp <- maybe_assign_temp e
162 return (CmmHinted tmp hint)
164 load_target_into_temp :: CmmCallTarget -> FCode CmmCallTarget
165 load_target_into_temp (CmmCallee expr conv) = do
166 tmp <- maybe_assign_temp expr
167 return (CmmCallee tmp conv)
168 load_target_into_temp other_target =
171 maybe_assign_temp :: CmmExpr -> FCode CmmExpr
173 | hasNoGlobalRegs e = return e
175 -- don't use assignTemp, it uses its own notion of "trivial"
176 -- expressions, which are wrong here.
177 -- this is a NonPtr because it only duplicates an existing
178 reg <- newTemp (cmmExprType e) --TODO FIXME NOW
179 stmtC (CmmAssign (CmmLocal reg) e)
180 return (CmmReg (CmmLocal reg))
182 -- -----------------------------------------------------------------------------
183 -- Save/restore the thread state in the TSO
185 -- This stuff can't be done in suspendThread/resumeThread, because it
186 -- refers to global registers which aren't available in the C world.
188 emitSaveThreadState :: Code
189 emitSaveThreadState = do
190 -- CurrentTSO->sp = Sp;
191 stmtC $ CmmStore (cmmOffset stgCurrentTSO tso_SP) stgSp
193 -- and save the current cost centre stack in the TSO when profiling:
194 when opt_SccProfilingOn $
195 stmtC (CmmStore (cmmOffset stgCurrentTSO tso_CCCS) curCCS)
197 -- CurrentNursery->free = Hp+1;
198 emitCloseNursery :: Code
199 emitCloseNursery = stmtC $ CmmStore nursery_bdescr_free (cmmOffsetW stgHp 1)
201 emitLoadThreadState :: Code
202 emitLoadThreadState = do
203 tso <- newTemp bWord -- TODO FIXME NOW
206 CmmAssign (CmmLocal tso) stgCurrentTSO,
208 CmmAssign sp (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_SP)
210 -- SpLim = tso->stack + RESERVED_STACK_WORDS;
211 CmmAssign spLim (cmmOffsetW (cmmOffset (CmmReg (CmmLocal tso)) tso_STACK)
212 rESERVED_STACK_WORDS),
214 -- HpAlloc is assumed to be set to non-zero only by a failed
215 -- a heap check, see HeapStackCheck.cmm:GC_GENERIC
216 CmmAssign hpAlloc (CmmLit zeroCLit)
219 -- and load the current cost centre stack from the TSO when profiling:
220 when opt_SccProfilingOn $
221 stmtC (CmmStore curCCSAddr
222 (CmmLoad (cmmOffset (CmmReg (CmmLocal tso)) tso_CCCS) bWord))
224 emitOpenNursery :: Code
225 emitOpenNursery = stmtsC [
226 -- Hp = CurrentNursery->free - 1;
227 CmmAssign hp (cmmOffsetW (CmmLoad nursery_bdescr_free gcWord) (-1)),
229 -- HpLim = CurrentNursery->start +
230 -- CurrentNursery->blocks*BLOCK_SIZE_W - 1;
233 (CmmLoad nursery_bdescr_start bWord)
235 (CmmMachOp mo_wordMul [
236 CmmMachOp (MO_SS_Conv W32 wordWidth)
237 [CmmLoad nursery_bdescr_blocks b32],
238 CmmLit (mkIntCLit bLOCK_SIZE)
245 nursery_bdescr_free, nursery_bdescr_start, nursery_bdescr_blocks :: CmmExpr
246 nursery_bdescr_free = cmmOffset stgCurrentNursery oFFSET_bdescr_free
247 nursery_bdescr_start = cmmOffset stgCurrentNursery oFFSET_bdescr_start
248 nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
250 tso_SP, tso_STACK, tso_CCCS :: ByteOff
251 tso_SP = tsoFieldB oFFSET_StgTSO_sp
252 tso_STACK = tsoFieldB oFFSET_StgTSO_stack
253 tso_CCCS = tsoProfFieldB oFFSET_StgTSO_CCCS
255 -- The TSO struct has a variable header, and an optional StgTSOProfInfo in
256 -- the middle. The fields we're interested in are after the StgTSOProfInfo.
257 tsoFieldB :: ByteOff -> ByteOff
259 | opt_SccProfilingOn = off + sIZEOF_StgTSOProfInfo + fixedHdrSize * wORD_SIZE
260 | otherwise = off + fixedHdrSize * wORD_SIZE
262 tsoProfFieldB :: ByteOff -> ByteOff
263 tsoProfFieldB off = off + fixedHdrSize * wORD_SIZE
265 stgSp, stgHp, stgCurrentTSO, stgCurrentNursery :: CmmExpr
268 stgCurrentTSO = CmmReg currentTSO
269 stgCurrentNursery = CmmReg currentNursery
271 sp, spLim, hp, hpLim, currentTSO, currentNursery, hpAlloc :: CmmReg
273 spLim = CmmGlobal SpLim
275 hpLim = CmmGlobal HpLim
276 currentTSO = CmmGlobal CurrentTSO
277 currentNursery = CmmGlobal CurrentNursery
278 hpAlloc = CmmGlobal HpAlloc
280 -- -----------------------------------------------------------------------------
281 -- For certain types passed to foreign calls, we adjust the actual
282 -- value passed to the call. For ByteArray#/Array# we pass the
283 -- address of the actual array, not the address of the heap object.
285 shimForeignCallArg :: StgArg -> CmmExpr -> CmmExpr
286 shimForeignCallArg arg expr
287 | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
288 = cmmOffsetB expr arrPtrsHdrSize
290 | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
291 = cmmOffsetB expr arrWordsHdrSize
295 -- should be a tycon app, since this is a foreign call
296 tycon = tyConAppTyCon (repType (stgArgType arg))