1 -----------------------------------------------------------------------------
3 -- Code generation for PrimOps.
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
31 -- ---------------------------------------------------------------------------
32 -- Code generation for PrimOps
34 cgPrimOp :: CmmFormals -- where to put the results
36 -> [StgArg] -- arguments
37 -> StgLiveVars -- live vars, in case we need to save them
40 cgPrimOp results op args live
41 = do arg_exprs <- getArgAmodes args
42 let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
43 emitPrimOp results op non_void_args live
46 emitPrimOp :: CmmFormals -- where to put the results
48 -> [CmmExpr] -- arguments
49 -> StgLiveVars -- live vars, in case we need to save them
52 -- First we handle various awkward cases specially. The remaining
53 -- easy cases are then handled by translateOp, defined below.
55 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
57 With some bit-twiddling, we can define int{Add,Sub}Czh portably in
58 C, and without needing any comparisons. This may not be the
59 fastest way to do it - if you have better code, please send it! --SDM
61 Return : r = a + b, c = 0 if no overflow, 1 on overflow.
63 We currently don't make use of the r value if c is != 0 (i.e.
64 overflow), we just convert to big integers and try again. This
65 could be improved by making r and c the correct values for
66 plugging into a new J#.
68 { r = ((I_)(a)) + ((I_)(b)); \
69 c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
70 >> (BITS_IN (I_) - 1); \
72 Wading through the mass of bracketry, it seems to reduce to:
73 c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
77 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
78 CmmAssign (CmmLocal res_c) $
79 CmmMachOp mo_wordUShr [
80 CmmMachOp mo_wordAnd [
81 CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
82 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
84 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
89 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
91 #define subIntCzh(r,c,a,b) \
92 { r = ((I_)(a)) - ((I_)(b)); \
93 c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
94 >> (BITS_IN (I_) - 1); \
97 c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
100 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
101 CmmAssign (CmmLocal res_c) $
102 CmmMachOp mo_wordUShr [
103 CmmMachOp mo_wordAnd [
104 CmmMachOp mo_wordXor [aa,bb],
105 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
107 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
112 emitPrimOp [res] ParOp [arg] live
114 -- for now, just implement this in a C function
115 -- later, we might want to inline it.
116 vols <- getVolatileRegs live
117 emitForeignCall' PlayRisky
118 [CmmHinted res NoHint]
119 (CmmCallee newspark CCallConv)
120 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
121 , (CmmHinted arg AddrHint) ]
123 NoC_SRT -- No SRT b/c we do PlayRisky
126 newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
128 emitPrimOp [res] ReadMutVarOp [mutv] _
129 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord))
131 emitPrimOp [] WriteMutVarOp [mutv,var] live
133 stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
134 vols <- getVolatileRegs live
135 emitForeignCall' PlayRisky
137 (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
139 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
140 , (CmmHinted mutv AddrHint) ]
142 NoC_SRT -- No SRT b/c we do PlayRisky
145 -- #define sizzeofByteArrayzh(r,a) \
146 -- r = ((StgArrWords *)(a))->bytes
147 emitPrimOp [res] SizeofByteArrayOp [arg] _
149 CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
151 -- #define sizzeofMutableByteArrayzh(r,a) \
152 -- r = ((StgArrWords *)(a))->bytes
153 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
154 = emitPrimOp [res] SizeofByteArrayOp [arg] live
157 -- #define touchzh(o) /* nothing */
158 emitPrimOp [] TouchOp [_] _
161 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
162 emitPrimOp [res] ByteArrayContents_Char [arg] _
163 = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
165 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
166 emitPrimOp [res] StableNameToIntOp [arg] _
167 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
169 -- #define eqStableNamezh(r,sn1,sn2) \
170 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
171 emitPrimOp [res] EqStableNameOp [arg1,arg2] _
172 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
173 cmmLoadIndexW arg1 fixedHdrSize bWord,
174 cmmLoadIndexW arg2 fixedHdrSize bWord
178 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
179 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
181 -- #define addrToHValuezh(r,a) r=(P_)a
182 emitPrimOp [res] AddrToHValueOp [arg] _
183 = stmtC (CmmAssign (CmmLocal res) arg)
185 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
186 -- Note: argument may be tagged!
187 emitPrimOp [res] DataToTagOp [arg] _
188 = stmtC (CmmAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
190 {- Freezing arrays-of-ptrs requires changing an info table, for the
191 benefit of the generational collector. It needs to scavenge mutable
192 objects, even if they are in old space. When they become immutable,
193 they can be removed from this scavenge list. -}
195 -- #define unsafeFreezzeArrayzh(r,a)
197 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
200 emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
201 = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
202 CmmAssign (CmmLocal res) arg ]
204 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
205 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
206 = stmtC (CmmAssign (CmmLocal res) arg)
208 -- Reading/writing pointer arrays
210 emitPrimOp [r] ReadArrayOp [obj,ix] _ = doReadPtrArrayOp r obj ix
211 emitPrimOp [r] IndexArrayOp [obj,ix] _ = doReadPtrArrayOp r obj ix
212 emitPrimOp [] WriteArrayOp [obj,ix,v] _ = doWritePtrArrayOp obj ix v
214 emitPrimOp [res] SizeofArrayOp [arg] _
215 = stmtC $ CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
216 emitPrimOp [res] SizeofMutableArrayOp [arg] live
217 = emitPrimOp [res] SizeofArrayOp [arg] live
221 emitPrimOp res IndexOffAddrOp_Char args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
222 emitPrimOp res IndexOffAddrOp_WideChar args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
223 emitPrimOp res IndexOffAddrOp_Int args _ = doIndexOffAddrOp Nothing bWord res args
224 emitPrimOp res IndexOffAddrOp_Word args _ = doIndexOffAddrOp Nothing bWord res args
225 emitPrimOp res IndexOffAddrOp_Addr args _ = doIndexOffAddrOp Nothing bWord res args
226 emitPrimOp res IndexOffAddrOp_Float args _ = doIndexOffAddrOp Nothing f32 res args
227 emitPrimOp res IndexOffAddrOp_Double args _ = doIndexOffAddrOp Nothing f64 res args
228 emitPrimOp res IndexOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing bWord res args
229 emitPrimOp res IndexOffAddrOp_Int8 args _ = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
230 emitPrimOp res IndexOffAddrOp_Int16 args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
231 emitPrimOp res IndexOffAddrOp_Int32 args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
232 emitPrimOp res IndexOffAddrOp_Int64 args _ = doIndexOffAddrOp Nothing b64 res args
233 emitPrimOp res IndexOffAddrOp_Word8 args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
234 emitPrimOp res IndexOffAddrOp_Word16 args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
235 emitPrimOp res IndexOffAddrOp_Word32 args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
236 emitPrimOp res IndexOffAddrOp_Word64 args _ = doIndexOffAddrOp Nothing b64 res args
238 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
240 emitPrimOp res ReadOffAddrOp_Char args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
241 emitPrimOp res ReadOffAddrOp_WideChar args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
242 emitPrimOp res ReadOffAddrOp_Int args _ = doIndexOffAddrOp Nothing bWord res args
243 emitPrimOp res ReadOffAddrOp_Word args _ = doIndexOffAddrOp Nothing bWord res args
244 emitPrimOp res ReadOffAddrOp_Addr args _ = doIndexOffAddrOp Nothing bWord res args
245 emitPrimOp res ReadOffAddrOp_Float args _ = doIndexOffAddrOp Nothing f32 res args
246 emitPrimOp res ReadOffAddrOp_Double args _ = doIndexOffAddrOp Nothing f64 res args
247 emitPrimOp res ReadOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing bWord res args
248 emitPrimOp res ReadOffAddrOp_Int8 args _ = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
249 emitPrimOp res ReadOffAddrOp_Int16 args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
250 emitPrimOp res ReadOffAddrOp_Int32 args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
251 emitPrimOp res ReadOffAddrOp_Int64 args _ = doIndexOffAddrOp Nothing b64 res args
252 emitPrimOp res ReadOffAddrOp_Word8 args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
253 emitPrimOp res ReadOffAddrOp_Word16 args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
254 emitPrimOp res ReadOffAddrOp_Word32 args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
255 emitPrimOp res ReadOffAddrOp_Word64 args _ = doIndexOffAddrOp Nothing b64 res args
259 emitPrimOp res IndexByteArrayOp_Char args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
260 emitPrimOp res IndexByteArrayOp_WideChar args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
261 emitPrimOp res IndexByteArrayOp_Int args _ = doIndexByteArrayOp Nothing bWord res args
262 emitPrimOp res IndexByteArrayOp_Word args _ = doIndexByteArrayOp Nothing bWord res args
263 emitPrimOp res IndexByteArrayOp_Addr args _ = doIndexByteArrayOp Nothing bWord res args
264 emitPrimOp res IndexByteArrayOp_Float args _ = doIndexByteArrayOp Nothing f32 res args
265 emitPrimOp res IndexByteArrayOp_Double args _ = doIndexByteArrayOp Nothing f64 res args
266 emitPrimOp res IndexByteArrayOp_StablePtr args _ = doIndexByteArrayOp Nothing bWord res args
267 emitPrimOp res IndexByteArrayOp_Int8 args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
268 emitPrimOp res IndexByteArrayOp_Int16 args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
269 emitPrimOp res IndexByteArrayOp_Int32 args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
270 emitPrimOp res IndexByteArrayOp_Int64 args _ = doIndexByteArrayOp Nothing b64 res args
271 emitPrimOp res IndexByteArrayOp_Word8 args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
272 emitPrimOp res IndexByteArrayOp_Word16 args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
273 emitPrimOp res IndexByteArrayOp_Word32 args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
274 emitPrimOp res IndexByteArrayOp_Word64 args _ = doIndexByteArrayOp Nothing b64 res args
276 -- ReadXXXArray, identical to IndexXXXArray.
278 emitPrimOp res ReadByteArrayOp_Char args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
279 emitPrimOp res ReadByteArrayOp_WideChar args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
280 emitPrimOp res ReadByteArrayOp_Int args _ = doIndexByteArrayOp Nothing bWord res args
281 emitPrimOp res ReadByteArrayOp_Word args _ = doIndexByteArrayOp Nothing bWord res args
282 emitPrimOp res ReadByteArrayOp_Addr args _ = doIndexByteArrayOp Nothing bWord res args
283 emitPrimOp res ReadByteArrayOp_Float args _ = doIndexByteArrayOp Nothing f32 res args
284 emitPrimOp res ReadByteArrayOp_Double args _ = doIndexByteArrayOp Nothing f64 res args
285 emitPrimOp res ReadByteArrayOp_StablePtr args _ = doIndexByteArrayOp Nothing bWord res args
286 emitPrimOp res ReadByteArrayOp_Int8 args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
287 emitPrimOp res ReadByteArrayOp_Int16 args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
288 emitPrimOp res ReadByteArrayOp_Int32 args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
289 emitPrimOp res ReadByteArrayOp_Int64 args _ = doIndexByteArrayOp Nothing b64 res args
290 emitPrimOp res ReadByteArrayOp_Word8 args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
291 emitPrimOp res ReadByteArrayOp_Word16 args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
292 emitPrimOp res ReadByteArrayOp_Word32 args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
293 emitPrimOp res ReadByteArrayOp_Word64 args _ = doIndexByteArrayOp Nothing b64 res args
297 emitPrimOp res WriteOffAddrOp_Char args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
298 emitPrimOp res WriteOffAddrOp_WideChar args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
299 emitPrimOp res WriteOffAddrOp_Int args _ = doWriteOffAddrOp Nothing bWord res args
300 emitPrimOp res WriteOffAddrOp_Word args _ = doWriteOffAddrOp Nothing bWord res args
301 emitPrimOp res WriteOffAddrOp_Addr args _ = doWriteOffAddrOp Nothing bWord res args
302 emitPrimOp res WriteOffAddrOp_Float args _ = doWriteOffAddrOp Nothing f32 res args
303 emitPrimOp res WriteOffAddrOp_Double args _ = doWriteOffAddrOp Nothing f64 res args
304 emitPrimOp res WriteOffAddrOp_StablePtr args _ = doWriteOffAddrOp Nothing bWord res args
305 emitPrimOp res WriteOffAddrOp_Int8 args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
306 emitPrimOp res WriteOffAddrOp_Int16 args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
307 emitPrimOp res WriteOffAddrOp_Int32 args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
308 emitPrimOp res WriteOffAddrOp_Int64 args _ = doWriteOffAddrOp Nothing b64 res args
309 emitPrimOp res WriteOffAddrOp_Word8 args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
310 emitPrimOp res WriteOffAddrOp_Word16 args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
311 emitPrimOp res WriteOffAddrOp_Word32 args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
312 emitPrimOp res WriteOffAddrOp_Word64 args _ = doWriteOffAddrOp Nothing b64 res args
316 emitPrimOp res WriteByteArrayOp_Char args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
317 emitPrimOp res WriteByteArrayOp_WideChar args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
318 emitPrimOp res WriteByteArrayOp_Int args _ = doWriteByteArrayOp Nothing bWord res args
319 emitPrimOp res WriteByteArrayOp_Word args _ = doWriteByteArrayOp Nothing bWord res args
320 emitPrimOp res WriteByteArrayOp_Addr args _ = doWriteByteArrayOp Nothing bWord res args
321 emitPrimOp res WriteByteArrayOp_Float args _ = doWriteByteArrayOp Nothing f32 res args
322 emitPrimOp res WriteByteArrayOp_Double args _ = doWriteByteArrayOp Nothing f64 res args
323 emitPrimOp res WriteByteArrayOp_StablePtr args _ = doWriteByteArrayOp Nothing bWord res args
324 emitPrimOp res WriteByteArrayOp_Int8 args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
325 emitPrimOp res WriteByteArrayOp_Int16 args _ = doWriteByteArrayOp (Just mo_WordTo16) b16 res args
326 emitPrimOp res WriteByteArrayOp_Int32 args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
327 emitPrimOp res WriteByteArrayOp_Int64 args _ = doWriteByteArrayOp Nothing b64 res args
328 emitPrimOp res WriteByteArrayOp_Word8 args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
329 emitPrimOp res WriteByteArrayOp_Word16 args _ = doWriteByteArrayOp (Just mo_WordTo16) b16 res args
330 emitPrimOp res WriteByteArrayOp_Word32 args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
331 emitPrimOp res WriteByteArrayOp_Word64 args _ = doWriteByteArrayOp Nothing b64 res args
334 -- The rest just translate straightforwardly
335 emitPrimOp [res] op [arg] _
337 = stmtC (CmmAssign (CmmLocal res) arg)
339 | Just (mop,rep) <- narrowOp op
340 = stmtC (CmmAssign (CmmLocal res) $
341 CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
343 emitPrimOp [res] op args live
344 | Just prim <- callishOp op
345 = do vols <- getVolatileRegs live
346 emitForeignCall' PlayRisky
347 [CmmHinted res NoHint]
349 [CmmHinted a NoHint | a<-args] -- ToDo: hints?
351 NoC_SRT -- No SRT b/c we do PlayRisky
354 | Just mop <- translateOp op
355 = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
359 = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
362 -- These PrimOps are NOPs in Cmm
364 nopOp :: PrimOp -> Bool
365 nopOp Int2WordOp = True
366 nopOp Word2IntOp = True
367 nopOp Int2AddrOp = True
368 nopOp Addr2IntOp = True
369 nopOp ChrOp = True -- Int# and Char# are rep'd the same
373 -- These PrimOps turn into double casts
375 narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
376 narrowOp Narrow8IntOp = Just (MO_SS_Conv, W8)
377 narrowOp Narrow16IntOp = Just (MO_SS_Conv, W16)
378 narrowOp Narrow32IntOp = Just (MO_SS_Conv, W32)
379 narrowOp Narrow8WordOp = Just (MO_UU_Conv, W8)
380 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
381 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
384 -- Native word signless ops
386 translateOp :: PrimOp -> Maybe MachOp
387 translateOp IntAddOp = Just mo_wordAdd
388 translateOp IntSubOp = Just mo_wordSub
389 translateOp WordAddOp = Just mo_wordAdd
390 translateOp WordSubOp = Just mo_wordSub
391 translateOp AddrAddOp = Just mo_wordAdd
392 translateOp AddrSubOp = Just mo_wordSub
394 translateOp IntEqOp = Just mo_wordEq
395 translateOp IntNeOp = Just mo_wordNe
396 translateOp WordEqOp = Just mo_wordEq
397 translateOp WordNeOp = Just mo_wordNe
398 translateOp AddrEqOp = Just mo_wordEq
399 translateOp AddrNeOp = Just mo_wordNe
401 translateOp AndOp = Just mo_wordAnd
402 translateOp OrOp = Just mo_wordOr
403 translateOp XorOp = Just mo_wordXor
404 translateOp NotOp = Just mo_wordNot
405 translateOp SllOp = Just mo_wordShl
406 translateOp SrlOp = Just mo_wordUShr
408 translateOp AddrRemOp = Just mo_wordURem
410 -- Native word signed ops
412 translateOp IntMulOp = Just mo_wordMul
413 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
414 translateOp IntQuotOp = Just mo_wordSQuot
415 translateOp IntRemOp = Just mo_wordSRem
416 translateOp IntNegOp = Just mo_wordSNeg
419 translateOp IntGeOp = Just mo_wordSGe
420 translateOp IntLeOp = Just mo_wordSLe
421 translateOp IntGtOp = Just mo_wordSGt
422 translateOp IntLtOp = Just mo_wordSLt
424 translateOp ISllOp = Just mo_wordShl
425 translateOp ISraOp = Just mo_wordSShr
426 translateOp ISrlOp = Just mo_wordUShr
428 -- Native word unsigned ops
430 translateOp WordGeOp = Just mo_wordUGe
431 translateOp WordLeOp = Just mo_wordULe
432 translateOp WordGtOp = Just mo_wordUGt
433 translateOp WordLtOp = Just mo_wordULt
435 translateOp WordMulOp = Just mo_wordMul
436 translateOp WordQuotOp = Just mo_wordUQuot
437 translateOp WordRemOp = Just mo_wordURem
439 translateOp AddrGeOp = Just mo_wordUGe
440 translateOp AddrLeOp = Just mo_wordULe
441 translateOp AddrGtOp = Just mo_wordUGt
442 translateOp AddrLtOp = Just mo_wordULt
446 translateOp CharEqOp = Just (MO_Eq wordWidth)
447 translateOp CharNeOp = Just (MO_Ne wordWidth)
448 translateOp CharGeOp = Just (MO_U_Ge wordWidth)
449 translateOp CharLeOp = Just (MO_U_Le wordWidth)
450 translateOp CharGtOp = Just (MO_U_Gt wordWidth)
451 translateOp CharLtOp = Just (MO_U_Lt wordWidth)
455 translateOp DoubleEqOp = Just (MO_F_Eq W64)
456 translateOp DoubleNeOp = Just (MO_F_Ne W64)
457 translateOp DoubleGeOp = Just (MO_F_Ge W64)
458 translateOp DoubleLeOp = Just (MO_F_Le W64)
459 translateOp DoubleGtOp = Just (MO_F_Gt W64)
460 translateOp DoubleLtOp = Just (MO_F_Lt W64)
462 translateOp DoubleAddOp = Just (MO_F_Add W64)
463 translateOp DoubleSubOp = Just (MO_F_Sub W64)
464 translateOp DoubleMulOp = Just (MO_F_Mul W64)
465 translateOp DoubleDivOp = Just (MO_F_Quot W64)
466 translateOp DoubleNegOp = Just (MO_F_Neg W64)
470 translateOp FloatEqOp = Just (MO_F_Eq W32)
471 translateOp FloatNeOp = Just (MO_F_Ne W32)
472 translateOp FloatGeOp = Just (MO_F_Ge W32)
473 translateOp FloatLeOp = Just (MO_F_Le W32)
474 translateOp FloatGtOp = Just (MO_F_Gt W32)
475 translateOp FloatLtOp = Just (MO_F_Lt W32)
477 translateOp FloatAddOp = Just (MO_F_Add W32)
478 translateOp FloatSubOp = Just (MO_F_Sub W32)
479 translateOp FloatMulOp = Just (MO_F_Mul W32)
480 translateOp FloatDivOp = Just (MO_F_Quot W32)
481 translateOp FloatNegOp = Just (MO_F_Neg W32)
485 translateOp Int2DoubleOp = Just (MO_SF_Conv wordWidth W64)
486 translateOp Double2IntOp = Just (MO_FS_Conv W64 wordWidth)
488 translateOp Int2FloatOp = Just (MO_SF_Conv wordWidth W32)
489 translateOp Float2IntOp = Just (MO_FS_Conv W32 wordWidth)
491 translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
492 translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
494 -- Word comparisons masquerading as more exotic things.
496 translateOp SameMutVarOp = Just mo_wordEq
497 translateOp SameMVarOp = Just mo_wordEq
498 translateOp SameMutableArrayOp = Just mo_wordEq
499 translateOp SameMutableByteArrayOp = Just mo_wordEq
500 translateOp SameTVarOp = Just mo_wordEq
501 translateOp EqStablePtrOp = Just mo_wordEq
503 translateOp _ = Nothing
505 -- These primops are implemented by CallishMachOps, because they sometimes
506 -- turn into foreign calls depending on the backend.
508 callishOp :: PrimOp -> Maybe CallishMachOp
509 callishOp DoublePowerOp = Just MO_F64_Pwr
510 callishOp DoubleSinOp = Just MO_F64_Sin
511 callishOp DoubleCosOp = Just MO_F64_Cos
512 callishOp DoubleTanOp = Just MO_F64_Tan
513 callishOp DoubleSinhOp = Just MO_F64_Sinh
514 callishOp DoubleCoshOp = Just MO_F64_Cosh
515 callishOp DoubleTanhOp = Just MO_F64_Tanh
516 callishOp DoubleAsinOp = Just MO_F64_Asin
517 callishOp DoubleAcosOp = Just MO_F64_Acos
518 callishOp DoubleAtanOp = Just MO_F64_Atan
519 callishOp DoubleLogOp = Just MO_F64_Log
520 callishOp DoubleExpOp = Just MO_F64_Exp
521 callishOp DoubleSqrtOp = Just MO_F64_Sqrt
523 callishOp FloatPowerOp = Just MO_F32_Pwr
524 callishOp FloatSinOp = Just MO_F32_Sin
525 callishOp FloatCosOp = Just MO_F32_Cos
526 callishOp FloatTanOp = Just MO_F32_Tan
527 callishOp FloatSinhOp = Just MO_F32_Sinh
528 callishOp FloatCoshOp = Just MO_F32_Cosh
529 callishOp FloatTanhOp = Just MO_F32_Tanh
530 callishOp FloatAsinOp = Just MO_F32_Asin
531 callishOp FloatAcosOp = Just MO_F32_Acos
532 callishOp FloatAtanOp = Just MO_F32_Atan
533 callishOp FloatLogOp = Just MO_F32_Log
534 callishOp FloatExpOp = Just MO_F32_Exp
535 callishOp FloatSqrtOp = Just MO_F32_Sqrt
537 callishOp _ = Nothing
539 ------------------------------------------------------------------------------
540 -- Helpers for translating various minor variants of array indexing.
542 -- Bytearrays outside the heap; hence non-pointers
543 doIndexOffAddrOp, doIndexByteArrayOp
544 :: Maybe MachOp -> CmmType
545 -> [LocalReg] -> [CmmExpr] -> Code
546 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
547 = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
548 doIndexOffAddrOp _ _ _ _
549 = panic "CgPrimOp: doIndexOffAddrOp"
551 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
552 = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
553 doIndexByteArrayOp _ _ _ _
554 = panic "CgPrimOp: doIndexByteArrayOp"
556 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
557 doReadPtrArrayOp res addr idx
558 = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
561 doWriteOffAddrOp, doWriteByteArrayOp
562 :: Maybe MachOp -> CmmType
563 -> [LocalReg] -> [CmmExpr] -> Code
564 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
565 = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
566 doWriteOffAddrOp _ _ _ _
567 = panic "CgPrimOp: doWriteOffAddrOp"
569 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
570 = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
571 doWriteByteArrayOp _ _ _ _
572 = panic "CgPrimOp: doWriteByteArrayOp"
574 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> Code
575 doWritePtrArrayOp addr idx val
576 = do mkBasicIndexedWrite arrPtrsHdrSize Nothing bWord addr idx val
577 stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
578 -- the write barrier. We must write a byte into the mark table:
579 -- bits8[a + header_size + StgMutArrPtrs_size(a) + x >> N]
582 (cmmOffsetExprW (cmmOffsetB addr arrPtrsHdrSize)
583 (loadArrPtrsSize addr))
584 (CmmMachOp mo_wordUShr [idx,
585 CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)])
586 ) (CmmLit (CmmInt 1 W8))
588 loadArrPtrsSize :: CmmExpr -> CmmExpr
589 loadArrPtrsSize addr = CmmLoad (cmmOffsetB addr off) bWord
590 where off = fixedHdrSize*wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs
592 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
593 -> LocalReg -> CmmExpr -> CmmExpr -> Code
594 mkBasicIndexedRead off Nothing read_rep res base idx
595 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
596 mkBasicIndexedRead off (Just cast) read_rep res base idx
597 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
598 cmmLoadIndexOffExpr off read_rep base idx]))
600 mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType
601 -> CmmExpr -> CmmExpr -> CmmExpr -> Code
602 mkBasicIndexedWrite off Nothing write_rep base idx val
603 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
604 mkBasicIndexedWrite off (Just cast) write_rep base idx val
605 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
607 -- ----------------------------------------------------------------------------
610 cmmIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
611 cmmIndexOffExpr off rep base idx
612 = cmmIndexExpr (typeWidth rep) (cmmOffsetB base off) idx
614 cmmLoadIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
615 cmmLoadIndexOffExpr off rep base idx
616 = CmmLoad (cmmIndexOffExpr off rep base idx) rep
618 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
619 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr