1 -----------------------------------------------------------------------------
3 -- Stg to C--: primitive operations
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
13 #include "HsVersions.h"
24 import Type ( Type, tyConAppTyCon )
34 ------------------------------------------------------------------------
35 -- Primitive operations and foreign calls
36 ------------------------------------------------------------------------
38 {- Note [Foreign call results]
39 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
40 A foreign call always returns an unboxed tuple of results, one
41 of which is the state token. This seems to happen even for pure
44 Even if we returned a single result for pure calls, it'd still be
45 right to wrap it in a singleton unboxed tuple, because the result
46 might be a Haskell closure pointer, we don't want to evaluate it. -}
48 ----------------------------------
49 cgOpApp :: StgOp -- The op
50 -> [StgArg] -- Arguments
51 -> Type -- Result type (always an unboxed tuple)
55 cgOpApp (StgFCallOp fcall _) stg_args res_ty
56 = do { (res_regs, res_hints) <- newUnboxedTupleRegs res_ty
57 -- Choose result regs r1, r2
58 -- Note [Foreign call results]
59 ; cgForeignCall res_regs res_hints fcall stg_args
60 -- r1, r2 = foo( x, y )
61 ; emitReturn (map (CmmReg . CmmLocal) res_regs) }
64 -- tagToEnum# is special: we need to pull the constructor
65 -- out of the table, and perform an appropriate return.
67 cgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty
68 = ASSERT(isEnumerationTyCon tycon)
69 do { args' <- getNonVoidArgAmodes [arg]
70 ; let amode = case args' of [amode] -> amode
71 _ -> panic "TagToEnumOp had void arg"
72 ; emitReturn [tagToClosure tycon amode] }
74 -- If you're reading this code in the attempt to figure
75 -- out why the compiler panic'ed here, it is probably because
76 -- you used tagToEnum# in a non-monomorphic setting, e.g.,
77 -- intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
79 tycon = tyConAppTyCon res_ty
81 cgOpApp (StgPrimOp primop) args res_ty
82 | primOpOutOfLine primop
83 = do { cmm_args <- getNonVoidArgAmodes args
84 ; let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop))
85 ; emitCall (PrimOpCall, PrimOpReturn) fun cmm_args }
87 | ReturnsPrim VoidRep <- result_info
88 = do cgPrimOp [] primop args
91 | ReturnsPrim rep <- result_info
92 = do res <- newTemp (primRepCmmType rep)
93 cgPrimOp [res] primop args
94 emitReturn [CmmReg (CmmLocal res)]
96 | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
97 = do (regs, _hints) <- newUnboxedTupleRegs res_ty
98 cgPrimOp regs primop args
99 emitReturn (map (CmmReg . CmmLocal) regs)
101 | ReturnsAlg tycon <- result_info
102 , isEnumerationTyCon tycon
103 -- c.f. cgExpr (...TagToEnumOp...)
104 = do tag_reg <- newTemp bWord
105 cgPrimOp [tag_reg] primop args
106 emitReturn [tagToClosure tycon
107 (CmmReg (CmmLocal tag_reg))]
109 | otherwise = panic "cgPrimop"
111 result_info = getPrimOpResultInfo primop
113 ---------------------------------------------------
114 cgPrimOp :: [LocalReg] -- where to put the results
116 -> [StgArg] -- arguments
119 cgPrimOp results op args
120 = do arg_exprs <- getNonVoidArgAmodes args
121 emitPrimOp results op arg_exprs
124 ------------------------------------------------------------------------
125 -- Emitting code for a primop
126 ------------------------------------------------------------------------
128 emitPrimOp :: [LocalReg] -- where to put the results
130 -> [CmmExpr] -- arguments
133 -- First we handle various awkward cases specially. The remaining
134 -- easy cases are then handled by translateOp, defined below.
136 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb]
138 With some bit-twiddling, we can define int{Add,Sub}Czh portably in
139 C, and without needing any comparisons. This may not be the
140 fastest way to do it - if you have better code, please send it! --SDM
142 Return : r = a + b, c = 0 if no overflow, 1 on overflow.
144 We currently don't make use of the r value if c is != 0 (i.e.
145 overflow), we just convert to big integers and try again. This
146 could be improved by making r and c the correct values for
147 plugging into a new J#.
149 { r = ((I_)(a)) + ((I_)(b)); \
150 c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
151 >> (BITS_IN (I_) - 1); \
153 Wading through the mass of bracketry, it seems to reduce to:
154 c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
157 = emit $ catAGraphs [
158 mkAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
159 mkAssign (CmmLocal res_c) $
160 CmmMachOp mo_wordUShr [
161 CmmMachOp mo_wordAnd [
162 CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
163 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
165 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
170 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb]
172 #define subIntCzh(r,c,a,b) \
173 { r = ((I_)(a)) - ((I_)(b)); \
174 c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
175 >> (BITS_IN (I_) - 1); \
178 c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
180 = emit $ catAGraphs [
181 mkAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
182 mkAssign (CmmLocal res_c) $
183 CmmMachOp mo_wordUShr [
184 CmmMachOp mo_wordAnd [
185 CmmMachOp mo_wordXor [aa,bb],
186 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
188 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
193 emitPrimOp [res] ParOp [arg]
195 -- for now, just implement this in a C function
196 -- later, we might want to inline it.
199 (CmmLit (CmmLabel (mkRtsCodeLabel (sLit "newSpark"))))
200 [(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)]
202 emitPrimOp [res] ReadMutVarOp [mutv]
203 = emit (mkAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord))
205 emitPrimOp [] WriteMutVarOp [mutv,var]
207 emit (mkStore (cmmOffsetW mutv fixedHdrSize) var)
210 (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
211 [(CmmReg (CmmGlobal BaseReg), AddrHint), (mutv,AddrHint)]
213 -- #define sizzeofByteArrayzh(r,a) \
214 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
215 emitPrimOp [res] SizeofByteArrayOp [arg]
217 mkAssign (CmmLocal res) (CmmMachOp mo_wordMul [
218 cmmLoadIndexW arg fixedHdrSize bWord,
219 CmmLit (mkIntCLit wORD_SIZE)
222 -- #define sizzeofMutableByteArrayzh(r,a) \
223 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
224 emitPrimOp [res] SizeofMutableByteArrayOp [arg]
225 = emitPrimOp [res] SizeofByteArrayOp [arg]
228 -- #define touchzh(o) /* nothing */
229 emitPrimOp [] TouchOp [_arg]
232 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
233 emitPrimOp [res] ByteArrayContents_Char [arg]
234 = emit (mkAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
236 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
237 emitPrimOp [res] StableNameToIntOp [arg]
238 = emit (mkAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
240 -- #define eqStableNamezh(r,sn1,sn2) \
241 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
242 emitPrimOp [res] EqStableNameOp [arg1,arg2]
243 = emit (mkAssign (CmmLocal res) (CmmMachOp mo_wordEq [
244 cmmLoadIndexW arg1 fixedHdrSize bWord,
245 cmmLoadIndexW arg2 fixedHdrSize bWord
249 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2]
250 = emit (mkAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
252 -- #define addrToHValuezh(r,a) r=(P_)a
253 emitPrimOp [res] AddrToHValueOp [arg]
254 = emit (mkAssign (CmmLocal res) arg)
256 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
257 -- Note: argument may be tagged!
258 emitPrimOp [res] DataToTagOp [arg]
259 = emit (mkAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
261 {- Freezing arrays-of-ptrs requires changing an info table, for the
262 benefit of the generational collector. It needs to scavenge mutable
263 objects, even if they are in old space. When they become immutable,
264 they can be removed from this scavenge list. -}
266 -- #define unsafeFreezzeArrayzh(r,a)
268 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
271 emitPrimOp [res] UnsafeFreezeArrayOp [arg]
273 [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
274 mkAssign (CmmLocal res) arg ]
276 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
277 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg]
278 = emit (mkAssign (CmmLocal res) arg)
280 -- Reading/writing pointer arrays
282 emitPrimOp [r] ReadArrayOp [obj,ix] = doReadPtrArrayOp r obj ix
283 emitPrimOp [r] IndexArrayOp [obj,ix] = doReadPtrArrayOp r obj ix
284 emitPrimOp [] WriteArrayOp [obj,ix,v] = doWritePtrArrayOp obj ix v
288 emitPrimOp res IndexOffAddrOp_Char args = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
289 emitPrimOp res IndexOffAddrOp_WideChar args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
290 emitPrimOp res IndexOffAddrOp_Int args = doIndexOffAddrOp Nothing bWord res args
291 emitPrimOp res IndexOffAddrOp_Word args = doIndexOffAddrOp Nothing bWord res args
292 emitPrimOp res IndexOffAddrOp_Addr args = doIndexOffAddrOp Nothing bWord res args
293 emitPrimOp res IndexOffAddrOp_Float args = doIndexOffAddrOp Nothing f32 res args
294 emitPrimOp res IndexOffAddrOp_Double args = doIndexOffAddrOp Nothing f64 res args
295 emitPrimOp res IndexOffAddrOp_StablePtr args = doIndexOffAddrOp Nothing bWord res args
296 emitPrimOp res IndexOffAddrOp_Int8 args = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
297 emitPrimOp res IndexOffAddrOp_Int16 args = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
298 emitPrimOp res IndexOffAddrOp_Int32 args = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
299 emitPrimOp res IndexOffAddrOp_Int64 args = doIndexOffAddrOp Nothing b64 res args
300 emitPrimOp res IndexOffAddrOp_Word8 args = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
301 emitPrimOp res IndexOffAddrOp_Word16 args = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
302 emitPrimOp res IndexOffAddrOp_Word32 args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
303 emitPrimOp res IndexOffAddrOp_Word64 args = doIndexOffAddrOp Nothing b64 res args
305 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
307 emitPrimOp res ReadOffAddrOp_Char args = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
308 emitPrimOp res ReadOffAddrOp_WideChar args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
309 emitPrimOp res ReadOffAddrOp_Int args = doIndexOffAddrOp Nothing bWord res args
310 emitPrimOp res ReadOffAddrOp_Word args = doIndexOffAddrOp Nothing bWord res args
311 emitPrimOp res ReadOffAddrOp_Addr args = doIndexOffAddrOp Nothing bWord res args
312 emitPrimOp res ReadOffAddrOp_Float args = doIndexOffAddrOp Nothing f32 res args
313 emitPrimOp res ReadOffAddrOp_Double args = doIndexOffAddrOp Nothing f64 res args
314 emitPrimOp res ReadOffAddrOp_StablePtr args = doIndexOffAddrOp Nothing bWord res args
315 emitPrimOp res ReadOffAddrOp_Int8 args = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
316 emitPrimOp res ReadOffAddrOp_Int16 args = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
317 emitPrimOp res ReadOffAddrOp_Int32 args = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
318 emitPrimOp res ReadOffAddrOp_Int64 args = doIndexOffAddrOp Nothing b64 res args
319 emitPrimOp res ReadOffAddrOp_Word8 args = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
320 emitPrimOp res ReadOffAddrOp_Word16 args = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
321 emitPrimOp res ReadOffAddrOp_Word32 args = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
322 emitPrimOp res ReadOffAddrOp_Word64 args = doIndexOffAddrOp Nothing b64 res args
326 emitPrimOp res IndexByteArrayOp_Char args = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
327 emitPrimOp res IndexByteArrayOp_WideChar args = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
328 emitPrimOp res IndexByteArrayOp_Int args = doIndexByteArrayOp Nothing bWord res args
329 emitPrimOp res IndexByteArrayOp_Word args = doIndexByteArrayOp Nothing bWord res args
330 emitPrimOp res IndexByteArrayOp_Addr args = doIndexByteArrayOp Nothing bWord res args
331 emitPrimOp res IndexByteArrayOp_Float args = doIndexByteArrayOp Nothing f32 res args
332 emitPrimOp res IndexByteArrayOp_Double args = doIndexByteArrayOp Nothing f64 res args
333 emitPrimOp res IndexByteArrayOp_StablePtr args = doIndexByteArrayOp Nothing bWord res args
334 emitPrimOp res IndexByteArrayOp_Int8 args = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
335 emitPrimOp res IndexByteArrayOp_Int16 args = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
336 emitPrimOp res IndexByteArrayOp_Int32 args = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
337 emitPrimOp res IndexByteArrayOp_Int64 args = doIndexByteArrayOp Nothing b64 res args
338 emitPrimOp res IndexByteArrayOp_Word8 args = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
339 emitPrimOp res IndexByteArrayOp_Word16 args = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
340 emitPrimOp res IndexByteArrayOp_Word32 args = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
341 emitPrimOp res IndexByteArrayOp_Word64 args = doIndexByteArrayOp Nothing b64 res args
343 -- ReadXXXArray, identical to IndexXXXArray.
345 emitPrimOp res ReadByteArrayOp_Char args = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
346 emitPrimOp res ReadByteArrayOp_WideChar args = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
347 emitPrimOp res ReadByteArrayOp_Int args = doIndexByteArrayOp Nothing bWord res args
348 emitPrimOp res ReadByteArrayOp_Word args = doIndexByteArrayOp Nothing bWord res args
349 emitPrimOp res ReadByteArrayOp_Addr args = doIndexByteArrayOp Nothing bWord res args
350 emitPrimOp res ReadByteArrayOp_Float args = doIndexByteArrayOp Nothing f32 res args
351 emitPrimOp res ReadByteArrayOp_Double args = doIndexByteArrayOp Nothing f64 res args
352 emitPrimOp res ReadByteArrayOp_StablePtr args = doIndexByteArrayOp Nothing bWord res args
353 emitPrimOp res ReadByteArrayOp_Int8 args = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
354 emitPrimOp res ReadByteArrayOp_Int16 args = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
355 emitPrimOp res ReadByteArrayOp_Int32 args = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
356 emitPrimOp res ReadByteArrayOp_Int64 args = doIndexByteArrayOp Nothing b64 res args
357 emitPrimOp res ReadByteArrayOp_Word8 args = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
358 emitPrimOp res ReadByteArrayOp_Word16 args = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
359 emitPrimOp res ReadByteArrayOp_Word32 args = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
360 emitPrimOp res ReadByteArrayOp_Word64 args = doIndexByteArrayOp Nothing b64 res args
364 emitPrimOp res WriteOffAddrOp_Char args = doWriteOffAddrOp (Just mo_WordTo8) res args
365 emitPrimOp res WriteOffAddrOp_WideChar args = doWriteOffAddrOp (Just mo_WordTo32) res args
366 emitPrimOp res WriteOffAddrOp_Int args = doWriteOffAddrOp Nothing res args
367 emitPrimOp res WriteOffAddrOp_Word args = doWriteOffAddrOp Nothing res args
368 emitPrimOp res WriteOffAddrOp_Addr args = doWriteOffAddrOp Nothing res args
369 emitPrimOp res WriteOffAddrOp_Float args = doWriteOffAddrOp Nothing res args
370 emitPrimOp res WriteOffAddrOp_Double args = doWriteOffAddrOp Nothing res args
371 emitPrimOp res WriteOffAddrOp_StablePtr args = doWriteOffAddrOp Nothing res args
372 emitPrimOp res WriteOffAddrOp_Int8 args = doWriteOffAddrOp (Just mo_WordTo8) res args
373 emitPrimOp res WriteOffAddrOp_Int16 args = doWriteOffAddrOp (Just mo_WordTo16) res args
374 emitPrimOp res WriteOffAddrOp_Int32 args = doWriteOffAddrOp (Just mo_WordTo32) res args
375 emitPrimOp res WriteOffAddrOp_Int64 args = doWriteOffAddrOp Nothing res args
376 emitPrimOp res WriteOffAddrOp_Word8 args = doWriteOffAddrOp (Just mo_WordTo8) res args
377 emitPrimOp res WriteOffAddrOp_Word16 args = doWriteOffAddrOp (Just mo_WordTo16) res args
378 emitPrimOp res WriteOffAddrOp_Word32 args = doWriteOffAddrOp (Just mo_WordTo32) res args
379 emitPrimOp res WriteOffAddrOp_Word64 args = doWriteOffAddrOp Nothing res args
383 emitPrimOp res WriteByteArrayOp_Char args = doWriteByteArrayOp (Just mo_WordTo8) res args
384 emitPrimOp res WriteByteArrayOp_WideChar args = doWriteByteArrayOp (Just mo_WordTo32) res args
385 emitPrimOp res WriteByteArrayOp_Int args = doWriteByteArrayOp Nothing res args
386 emitPrimOp res WriteByteArrayOp_Word args = doWriteByteArrayOp Nothing res args
387 emitPrimOp res WriteByteArrayOp_Addr args = doWriteByteArrayOp Nothing res args
388 emitPrimOp res WriteByteArrayOp_Float args = doWriteByteArrayOp Nothing res args
389 emitPrimOp res WriteByteArrayOp_Double args = doWriteByteArrayOp Nothing res args
390 emitPrimOp res WriteByteArrayOp_StablePtr args = doWriteByteArrayOp Nothing res args
391 emitPrimOp res WriteByteArrayOp_Int8 args = doWriteByteArrayOp (Just mo_WordTo8) res args
392 emitPrimOp res WriteByteArrayOp_Int16 args = doWriteByteArrayOp (Just mo_WordTo16) res args
393 emitPrimOp res WriteByteArrayOp_Int32 args = doWriteByteArrayOp (Just mo_WordTo32) res args
394 emitPrimOp res WriteByteArrayOp_Int64 args = doWriteByteArrayOp Nothing res args
395 emitPrimOp res WriteByteArrayOp_Word8 args = doWriteByteArrayOp (Just mo_WordTo8) res args
396 emitPrimOp res WriteByteArrayOp_Word16 args = doWriteByteArrayOp (Just mo_WordTo16) res args
397 emitPrimOp res WriteByteArrayOp_Word32 args = doWriteByteArrayOp (Just mo_WordTo32) res args
398 emitPrimOp res WriteByteArrayOp_Word64 args = doWriteByteArrayOp Nothing res args
401 -- The rest just translate straightforwardly
402 emitPrimOp [res] op [arg]
404 = emit (mkAssign (CmmLocal res) arg)
406 | Just (mop,rep) <- narrowOp op
407 = emit (mkAssign (CmmLocal res) $
408 CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
410 emitPrimOp [res] op args
411 | Just prim <- callishOp op
412 = do emitPrimCall res prim args
414 | Just mop <- translateOp op
415 = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in
419 = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
422 -- These PrimOps are NOPs in Cmm
424 nopOp :: PrimOp -> Bool
425 nopOp Int2WordOp = True
426 nopOp Word2IntOp = True
427 nopOp Int2AddrOp = True
428 nopOp Addr2IntOp = True
429 nopOp ChrOp = True -- Int# and Char# are rep'd the same
433 -- These PrimOps turn into double casts
435 narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
436 narrowOp Narrow8IntOp = Just (MO_SS_Conv, W8)
437 narrowOp Narrow16IntOp = Just (MO_SS_Conv, W16)
438 narrowOp Narrow32IntOp = Just (MO_SS_Conv, W32)
439 narrowOp Narrow8WordOp = Just (MO_UU_Conv, W8)
440 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
441 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
444 -- Native word signless ops
446 translateOp :: PrimOp -> Maybe MachOp
447 translateOp IntAddOp = Just mo_wordAdd
448 translateOp IntSubOp = Just mo_wordSub
449 translateOp WordAddOp = Just mo_wordAdd
450 translateOp WordSubOp = Just mo_wordSub
451 translateOp AddrAddOp = Just mo_wordAdd
452 translateOp AddrSubOp = Just mo_wordSub
454 translateOp IntEqOp = Just mo_wordEq
455 translateOp IntNeOp = Just mo_wordNe
456 translateOp WordEqOp = Just mo_wordEq
457 translateOp WordNeOp = Just mo_wordNe
458 translateOp AddrEqOp = Just mo_wordEq
459 translateOp AddrNeOp = Just mo_wordNe
461 translateOp AndOp = Just mo_wordAnd
462 translateOp OrOp = Just mo_wordOr
463 translateOp XorOp = Just mo_wordXor
464 translateOp NotOp = Just mo_wordNot
465 translateOp SllOp = Just mo_wordShl
466 translateOp SrlOp = Just mo_wordUShr
468 translateOp AddrRemOp = Just mo_wordURem
470 -- Native word signed ops
472 translateOp IntMulOp = Just mo_wordMul
473 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
474 translateOp IntQuotOp = Just mo_wordSQuot
475 translateOp IntRemOp = Just mo_wordSRem
476 translateOp IntNegOp = Just mo_wordSNeg
479 translateOp IntGeOp = Just mo_wordSGe
480 translateOp IntLeOp = Just mo_wordSLe
481 translateOp IntGtOp = Just mo_wordSGt
482 translateOp IntLtOp = Just mo_wordSLt
484 translateOp ISllOp = Just mo_wordShl
485 translateOp ISraOp = Just mo_wordSShr
486 translateOp ISrlOp = Just mo_wordUShr
488 -- Native word unsigned ops
490 translateOp WordGeOp = Just mo_wordUGe
491 translateOp WordLeOp = Just mo_wordULe
492 translateOp WordGtOp = Just mo_wordUGt
493 translateOp WordLtOp = Just mo_wordULt
495 translateOp WordMulOp = Just mo_wordMul
496 translateOp WordQuotOp = Just mo_wordUQuot
497 translateOp WordRemOp = Just mo_wordURem
499 translateOp AddrGeOp = Just mo_wordUGe
500 translateOp AddrLeOp = Just mo_wordULe
501 translateOp AddrGtOp = Just mo_wordUGt
502 translateOp AddrLtOp = Just mo_wordULt
506 translateOp CharEqOp = Just (MO_Eq wordWidth)
507 translateOp CharNeOp = Just (MO_Ne wordWidth)
508 translateOp CharGeOp = Just (MO_U_Ge wordWidth)
509 translateOp CharLeOp = Just (MO_U_Le wordWidth)
510 translateOp CharGtOp = Just (MO_U_Gt wordWidth)
511 translateOp CharLtOp = Just (MO_U_Lt wordWidth)
515 translateOp DoubleEqOp = Just (MO_F_Eq W64)
516 translateOp DoubleNeOp = Just (MO_F_Ne W64)
517 translateOp DoubleGeOp = Just (MO_F_Ge W64)
518 translateOp DoubleLeOp = Just (MO_F_Le W64)
519 translateOp DoubleGtOp = Just (MO_F_Gt W64)
520 translateOp DoubleLtOp = Just (MO_F_Lt W64)
522 translateOp DoubleAddOp = Just (MO_F_Add W64)
523 translateOp DoubleSubOp = Just (MO_F_Sub W64)
524 translateOp DoubleMulOp = Just (MO_F_Mul W64)
525 translateOp DoubleDivOp = Just (MO_F_Quot W64)
526 translateOp DoubleNegOp = Just (MO_F_Neg W64)
530 translateOp FloatEqOp = Just (MO_F_Eq W32)
531 translateOp FloatNeOp = Just (MO_F_Ne W32)
532 translateOp FloatGeOp = Just (MO_F_Ge W32)
533 translateOp FloatLeOp = Just (MO_F_Le W32)
534 translateOp FloatGtOp = Just (MO_F_Gt W32)
535 translateOp FloatLtOp = Just (MO_F_Lt W32)
537 translateOp FloatAddOp = Just (MO_F_Add W32)
538 translateOp FloatSubOp = Just (MO_F_Sub W32)
539 translateOp FloatMulOp = Just (MO_F_Mul W32)
540 translateOp FloatDivOp = Just (MO_F_Quot W32)
541 translateOp FloatNegOp = Just (MO_F_Neg W32)
545 translateOp Int2DoubleOp = Just (MO_SF_Conv wordWidth W64)
546 translateOp Double2IntOp = Just (MO_FS_Conv W64 wordWidth)
548 translateOp Int2FloatOp = Just (MO_SF_Conv wordWidth W32)
549 translateOp Float2IntOp = Just (MO_FS_Conv W32 wordWidth)
551 translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
552 translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
554 -- Word comparisons masquerading as more exotic things.
556 translateOp SameMutVarOp = Just mo_wordEq
557 translateOp SameMVarOp = Just mo_wordEq
558 translateOp SameMutableArrayOp = Just mo_wordEq
559 translateOp SameMutableByteArrayOp = Just mo_wordEq
560 translateOp SameTVarOp = Just mo_wordEq
561 translateOp EqStablePtrOp = Just mo_wordEq
563 translateOp _ = Nothing
565 -- These primops are implemented by CallishMachOps, because they sometimes
566 -- turn into foreign calls depending on the backend.
568 callishOp :: PrimOp -> Maybe CallishMachOp
569 callishOp DoublePowerOp = Just MO_F64_Pwr
570 callishOp DoubleSinOp = Just MO_F64_Sin
571 callishOp DoubleCosOp = Just MO_F64_Cos
572 callishOp DoubleTanOp = Just MO_F64_Tan
573 callishOp DoubleSinhOp = Just MO_F64_Sinh
574 callishOp DoubleCoshOp = Just MO_F64_Cosh
575 callishOp DoubleTanhOp = Just MO_F64_Tanh
576 callishOp DoubleAsinOp = Just MO_F64_Asin
577 callishOp DoubleAcosOp = Just MO_F64_Acos
578 callishOp DoubleAtanOp = Just MO_F64_Atan
579 callishOp DoubleLogOp = Just MO_F64_Log
580 callishOp DoubleExpOp = Just MO_F64_Exp
581 callishOp DoubleSqrtOp = Just MO_F64_Sqrt
583 callishOp FloatPowerOp = Just MO_F32_Pwr
584 callishOp FloatSinOp = Just MO_F32_Sin
585 callishOp FloatCosOp = Just MO_F32_Cos
586 callishOp FloatTanOp = Just MO_F32_Tan
587 callishOp FloatSinhOp = Just MO_F32_Sinh
588 callishOp FloatCoshOp = Just MO_F32_Cosh
589 callishOp FloatTanhOp = Just MO_F32_Tanh
590 callishOp FloatAsinOp = Just MO_F32_Asin
591 callishOp FloatAcosOp = Just MO_F32_Acos
592 callishOp FloatAtanOp = Just MO_F32_Atan
593 callishOp FloatLogOp = Just MO_F32_Log
594 callishOp FloatExpOp = Just MO_F32_Exp
595 callishOp FloatSqrtOp = Just MO_F32_Sqrt
597 callishOp _ = Nothing
599 ------------------------------------------------------------------------------
600 -- Helpers for translating various minor variants of array indexing.
602 doIndexOffAddrOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
603 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
604 = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
605 doIndexOffAddrOp _ _ _ _
606 = panic "CgPrimOp: doIndexOffAddrOp"
608 doIndexByteArrayOp :: Maybe MachOp -> CmmType -> [LocalReg] -> [CmmExpr] -> FCode ()
609 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
610 = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
611 doIndexByteArrayOp _ _ _ _
612 = panic "CgPrimOp: doIndexByteArrayOp"
614 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> FCode ()
615 doReadPtrArrayOp res addr idx
616 = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
619 doWriteOffAddrOp :: Maybe MachOp -> [LocalReg] -> [CmmExpr] -> FCode ()
620 doWriteOffAddrOp maybe_pre_write_cast [] [addr,idx,val]
621 = mkBasicIndexedWrite 0 maybe_pre_write_cast addr idx val
622 doWriteOffAddrOp _ _ _
623 = panic "CgPrimOp: doWriteOffAddrOp"
625 doWriteByteArrayOp :: Maybe MachOp -> [LocalReg] -> [CmmExpr] -> FCode ()
626 doWriteByteArrayOp maybe_pre_write_cast [] [addr,idx,val]
627 = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast addr idx val
628 doWriteByteArrayOp _ _ _
629 = panic "CgPrimOp: doWriteByteArrayOp"
631 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
632 doWritePtrArrayOp addr idx val
633 = do emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
634 mkBasicIndexedWrite arrPtrsHdrSize Nothing addr idx val
636 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
637 -> LocalReg -> CmmExpr -> CmmExpr -> FCode ()
638 mkBasicIndexedRead off Nothing read_rep res base idx
639 = emit (mkAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
640 mkBasicIndexedRead off (Just cast) read_rep res base idx
641 = emit (mkAssign (CmmLocal res) (CmmMachOp cast [
642 cmmLoadIndexOffExpr off read_rep base idx]))
644 mkBasicIndexedWrite :: ByteOff -> Maybe MachOp
645 -> CmmExpr -> CmmExpr -> CmmExpr -> FCode ()
646 mkBasicIndexedWrite off Nothing base idx val
647 = emit (mkStore (cmmIndexOffExpr off (typeWidth (cmmExprType val)) base idx) val)
648 mkBasicIndexedWrite off (Just cast) base idx val
649 = mkBasicIndexedWrite off Nothing base idx (CmmMachOp cast [val])
651 -- ----------------------------------------------------------------------------
654 cmmIndexOffExpr :: ByteOff -> Width -> CmmExpr -> CmmExpr -> CmmExpr
655 cmmIndexOffExpr off width base idx
656 = cmmIndexExpr width (cmmOffsetB base off) idx
658 cmmLoadIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
659 cmmLoadIndexOffExpr off ty base idx
660 = CmmLoad (cmmIndexOffExpr off (typeWidth ty) base idx) ty
662 setInfo :: CmmExpr -> CmmExpr -> CmmAGraph
663 setInfo closure_ptr info_ptr = mkStore closure_ptr info_ptr