2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- Code generation for PrimOps.
12 -- (c) The University of Glasgow 2004-2006
14 -----------------------------------------------------------------------------
37 -- ---------------------------------------------------------------------------
38 -- Code generation for PrimOps
40 cgPrimOp :: CmmFormals -- where to put the results
42 -> [StgArg] -- arguments
43 -> StgLiveVars -- live vars, in case we need to save them
46 cgPrimOp results op args live
47 = do arg_exprs <- getArgAmodes args
48 let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
49 emitPrimOp results op non_void_args live
52 emitPrimOp :: CmmFormals -- where to put the results
54 -> [CmmExpr] -- arguments
55 -> StgLiveVars -- live vars, in case we need to save them
58 -- First we handle various awkward cases specially. The remaining
59 -- easy cases are then handled by translateOp, defined below.
61 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] live
63 With some bit-twiddling, we can define int{Add,Sub}Czh portably in
64 C, and without needing any comparisons. This may not be the
65 fastest way to do it - if you have better code, please send it! --SDM
67 Return : r = a + b, c = 0 if no overflow, 1 on overflow.
69 We currently don't make use of the r value if c is != 0 (i.e.
70 overflow), we just convert to big integers and try again. This
71 could be improved by making r and c the correct values for
72 plugging into a new J#.
74 { r = ((I_)(a)) + ((I_)(b)); \
75 c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
76 >> (BITS_IN (I_) - 1); \
78 Wading through the mass of bracketry, it seems to reduce to:
79 c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
83 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
84 CmmAssign (CmmLocal res_c) $
85 CmmMachOp mo_wordUShr [
86 CmmMachOp mo_wordAnd [
87 CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
88 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
90 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
95 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
97 #define subIntCzh(r,c,a,b) \
98 { r = ((I_)(a)) - ((I_)(b)); \
99 c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
100 >> (BITS_IN (I_) - 1); \
103 c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
106 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
107 CmmAssign (CmmLocal res_c) $
108 CmmMachOp mo_wordUShr [
109 CmmMachOp mo_wordAnd [
110 CmmMachOp mo_wordXor [aa,bb],
111 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
113 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
118 emitPrimOp [res] ParOp [arg] live
120 -- for now, just implement this in a C function
121 -- later, we might want to inline it.
122 vols <- getVolatileRegs live
123 emitForeignCall' PlayRisky
124 [CmmHinted res NoHint]
125 (CmmCallee newspark CCallConv)
126 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
127 , (CmmHinted arg AddrHint) ]
129 NoC_SRT -- No SRT b/c we do PlayRisky
132 newspark = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "newSpark")))
134 emitPrimOp [res] ReadMutVarOp [mutv] live
135 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord))
137 emitPrimOp [] WriteMutVarOp [mutv,var] live
139 stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
140 vols <- getVolatileRegs live
141 emitForeignCall' PlayRisky
143 (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
145 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
146 , (CmmHinted mutv AddrHint) ]
148 NoC_SRT -- No SRT b/c we do PlayRisky
151 -- #define sizzeofByteArrayzh(r,a) \
152 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
153 emitPrimOp [res] SizeofByteArrayOp [arg] live
155 CmmAssign (CmmLocal res) (CmmMachOp mo_wordMul [
156 cmmLoadIndexW arg fixedHdrSize bWord,
157 CmmLit (mkIntCLit wORD_SIZE)
160 -- #define sizzeofMutableByteArrayzh(r,a) \
161 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
162 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
163 = emitPrimOp [res] SizeofByteArrayOp [arg] live
166 -- #define touchzh(o) /* nothing */
167 emitPrimOp [] TouchOp [arg] live
170 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
171 emitPrimOp [res] ByteArrayContents_Char [arg] live
172 = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
174 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
175 emitPrimOp [res] StableNameToIntOp [arg] live
176 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
178 -- #define eqStableNamezh(r,sn1,sn2) \
179 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
180 emitPrimOp [res] EqStableNameOp [arg1,arg2] live
181 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
182 cmmLoadIndexW arg1 fixedHdrSize bWord,
183 cmmLoadIndexW arg2 fixedHdrSize bWord
187 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
188 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
190 -- #define addrToHValuezh(r,a) r=(P_)a
191 emitPrimOp [res] AddrToHValueOp [arg] live
192 = stmtC (CmmAssign (CmmLocal res) arg)
194 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
195 -- Note: argument may be tagged!
196 emitPrimOp [res] DataToTagOp [arg] live
197 = stmtC (CmmAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
199 {- Freezing arrays-of-ptrs requires changing an info table, for the
200 benefit of the generational collector. It needs to scavenge mutable
201 objects, even if they are in old space. When they become immutable,
202 they can be removed from this scavenge list. -}
204 -- #define unsafeFreezzeArrayzh(r,a)
206 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
209 emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
210 = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
211 CmmAssign (CmmLocal res) arg ]
213 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
214 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
215 = stmtC (CmmAssign (CmmLocal res) arg)
217 -- Reading/writing pointer arrays
219 emitPrimOp [r] ReadArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix
220 emitPrimOp [r] IndexArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix
221 emitPrimOp [] WriteArrayOp [obj,ix,v] live = doWritePtrArrayOp obj ix v
225 emitPrimOp res IndexOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
226 emitPrimOp res IndexOffAddrOp_WideChar args live = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
227 emitPrimOp res IndexOffAddrOp_Int args live = doIndexOffAddrOp Nothing bWord res args
228 emitPrimOp res IndexOffAddrOp_Word args live = doIndexOffAddrOp Nothing bWord res args
229 emitPrimOp res IndexOffAddrOp_Addr args live = doIndexOffAddrOp Nothing bWord res args
230 emitPrimOp res IndexOffAddrOp_Float args live = doIndexOffAddrOp Nothing f32 res args
231 emitPrimOp res IndexOffAddrOp_Double args live = doIndexOffAddrOp Nothing f64 res args
232 emitPrimOp res IndexOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing bWord res args
233 emitPrimOp res IndexOffAddrOp_Int8 args live = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
234 emitPrimOp res IndexOffAddrOp_Int16 args live = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
235 emitPrimOp res IndexOffAddrOp_Int32 args live = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
236 emitPrimOp res IndexOffAddrOp_Int64 args live = doIndexOffAddrOp Nothing b64 res args
237 emitPrimOp res IndexOffAddrOp_Word8 args live = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
238 emitPrimOp res IndexOffAddrOp_Word16 args live = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
239 emitPrimOp res IndexOffAddrOp_Word32 args live = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
240 emitPrimOp res IndexOffAddrOp_Word64 args live = doIndexOffAddrOp Nothing b64 res args
242 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
244 emitPrimOp res ReadOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
245 emitPrimOp res ReadOffAddrOp_WideChar args live = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
246 emitPrimOp res ReadOffAddrOp_Int args live = doIndexOffAddrOp Nothing bWord res args
247 emitPrimOp res ReadOffAddrOp_Word args live = doIndexOffAddrOp Nothing bWord res args
248 emitPrimOp res ReadOffAddrOp_Addr args live = doIndexOffAddrOp Nothing bWord res args
249 emitPrimOp res ReadOffAddrOp_Float args live = doIndexOffAddrOp Nothing f32 res args
250 emitPrimOp res ReadOffAddrOp_Double args live = doIndexOffAddrOp Nothing f64 res args
251 emitPrimOp res ReadOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing bWord res args
252 emitPrimOp res ReadOffAddrOp_Int8 args live = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
253 emitPrimOp res ReadOffAddrOp_Int16 args live = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
254 emitPrimOp res ReadOffAddrOp_Int32 args live = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
255 emitPrimOp res ReadOffAddrOp_Int64 args live = doIndexOffAddrOp Nothing b64 res args
256 emitPrimOp res ReadOffAddrOp_Word8 args live = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
257 emitPrimOp res ReadOffAddrOp_Word16 args live = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
258 emitPrimOp res ReadOffAddrOp_Word32 args live = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
259 emitPrimOp res ReadOffAddrOp_Word64 args live = doIndexOffAddrOp Nothing b64 res args
263 emitPrimOp res IndexByteArrayOp_Char args live = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
264 emitPrimOp res IndexByteArrayOp_WideChar args live = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
265 emitPrimOp res IndexByteArrayOp_Int args live = doIndexByteArrayOp Nothing bWord res args
266 emitPrimOp res IndexByteArrayOp_Word args live = doIndexByteArrayOp Nothing bWord res args
267 emitPrimOp res IndexByteArrayOp_Addr args live = doIndexByteArrayOp Nothing bWord res args
268 emitPrimOp res IndexByteArrayOp_Float args live = doIndexByteArrayOp Nothing f32 res args
269 emitPrimOp res IndexByteArrayOp_Double args live = doIndexByteArrayOp Nothing f64 res args
270 emitPrimOp res IndexByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing bWord res args
271 emitPrimOp res IndexByteArrayOp_Int8 args live = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
272 emitPrimOp res IndexByteArrayOp_Int16 args live = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
273 emitPrimOp res IndexByteArrayOp_Int32 args live = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
274 emitPrimOp res IndexByteArrayOp_Int64 args live = doIndexByteArrayOp Nothing b64 res args
275 emitPrimOp res IndexByteArrayOp_Word8 args live = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
276 emitPrimOp res IndexByteArrayOp_Word16 args live = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
277 emitPrimOp res IndexByteArrayOp_Word32 args live = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
278 emitPrimOp res IndexByteArrayOp_Word64 args live = doIndexByteArrayOp Nothing b64 res args
280 -- ReadXXXArray, identical to IndexXXXArray.
282 emitPrimOp res ReadByteArrayOp_Char args live = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
283 emitPrimOp res ReadByteArrayOp_WideChar args live = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
284 emitPrimOp res ReadByteArrayOp_Int args live = doIndexByteArrayOp Nothing bWord res args
285 emitPrimOp res ReadByteArrayOp_Word args live = doIndexByteArrayOp Nothing bWord res args
286 emitPrimOp res ReadByteArrayOp_Addr args live = doIndexByteArrayOp Nothing bWord res args
287 emitPrimOp res ReadByteArrayOp_Float args live = doIndexByteArrayOp Nothing f32 res args
288 emitPrimOp res ReadByteArrayOp_Double args live = doIndexByteArrayOp Nothing f64 res args
289 emitPrimOp res ReadByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing bWord res args
290 emitPrimOp res ReadByteArrayOp_Int8 args live = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
291 emitPrimOp res ReadByteArrayOp_Int16 args live = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
292 emitPrimOp res ReadByteArrayOp_Int32 args live = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
293 emitPrimOp res ReadByteArrayOp_Int64 args live = doIndexByteArrayOp Nothing b64 res args
294 emitPrimOp res ReadByteArrayOp_Word8 args live = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
295 emitPrimOp res ReadByteArrayOp_Word16 args live = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
296 emitPrimOp res ReadByteArrayOp_Word32 args live = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
297 emitPrimOp res ReadByteArrayOp_Word64 args live = doIndexByteArrayOp Nothing b64 res args
301 emitPrimOp res WriteOffAddrOp_Char args live = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
302 emitPrimOp res WriteOffAddrOp_WideChar args live = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
303 emitPrimOp res WriteOffAddrOp_Int args live = doWriteOffAddrOp Nothing bWord res args
304 emitPrimOp res WriteOffAddrOp_Word args live = doWriteOffAddrOp Nothing bWord res args
305 emitPrimOp res WriteOffAddrOp_Addr args live = doWriteOffAddrOp Nothing bWord res args
306 emitPrimOp res WriteOffAddrOp_Float args live = doWriteOffAddrOp Nothing f32 res args
307 emitPrimOp res WriteOffAddrOp_Double args live = doWriteOffAddrOp Nothing f64 res args
308 emitPrimOp res WriteOffAddrOp_StablePtr args live = doWriteOffAddrOp Nothing bWord res args
309 emitPrimOp res WriteOffAddrOp_Int8 args live = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
310 emitPrimOp res WriteOffAddrOp_Int16 args live = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
311 emitPrimOp res WriteOffAddrOp_Int32 args live = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
312 emitPrimOp res WriteOffAddrOp_Int64 args live = doWriteOffAddrOp Nothing b64 res args
313 emitPrimOp res WriteOffAddrOp_Word8 args live = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
314 emitPrimOp res WriteOffAddrOp_Word16 args live = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
315 emitPrimOp res WriteOffAddrOp_Word32 args live = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
316 emitPrimOp res WriteOffAddrOp_Word64 args live = doWriteOffAddrOp Nothing b64 res args
320 emitPrimOp res WriteByteArrayOp_Char args live = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
321 emitPrimOp res WriteByteArrayOp_WideChar args live = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
322 emitPrimOp res WriteByteArrayOp_Int args live = doWriteByteArrayOp Nothing bWord res args
323 emitPrimOp res WriteByteArrayOp_Word args live = doWriteByteArrayOp Nothing bWord res args
324 emitPrimOp res WriteByteArrayOp_Addr args live = doWriteByteArrayOp Nothing bWord res args
325 emitPrimOp res WriteByteArrayOp_Float args live = doWriteByteArrayOp Nothing f32 res args
326 emitPrimOp res WriteByteArrayOp_Double args live = doWriteByteArrayOp Nothing f64 res args
327 emitPrimOp res WriteByteArrayOp_StablePtr args live = doWriteByteArrayOp Nothing bWord res args
328 emitPrimOp res WriteByteArrayOp_Int8 args live = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
329 emitPrimOp res WriteByteArrayOp_Int16 args live = doWriteByteArrayOp (Just mo_WordTo16) b16 res args
330 emitPrimOp res WriteByteArrayOp_Int32 args live = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
331 emitPrimOp res WriteByteArrayOp_Int64 args live = doWriteByteArrayOp Nothing b64 res args
332 emitPrimOp res WriteByteArrayOp_Word8 args live = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
333 emitPrimOp res WriteByteArrayOp_Word16 args live = doWriteByteArrayOp (Just mo_WordTo16) b16 res args
334 emitPrimOp res WriteByteArrayOp_Word32 args live = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
335 emitPrimOp res WriteByteArrayOp_Word64 args live = doWriteByteArrayOp Nothing b64 res args
338 -- The rest just translate straightforwardly
339 emitPrimOp [res] op [arg] live
341 = stmtC (CmmAssign (CmmLocal res) arg)
343 | Just (mop,rep) <- narrowOp op
344 = stmtC (CmmAssign (CmmLocal res) $
345 CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
347 emitPrimOp [res] op args live
348 | Just prim <- callishOp op
349 = do vols <- getVolatileRegs live
350 emitForeignCall' PlayRisky
351 [CmmHinted res NoHint]
353 [CmmHinted a NoHint | a<-args] -- ToDo: hints?
355 NoC_SRT -- No SRT b/c we do PlayRisky
358 | Just mop <- translateOp op
359 = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
363 = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
366 -- These PrimOps are NOPs in Cmm
368 nopOp Int2WordOp = True
369 nopOp Word2IntOp = True
370 nopOp Int2AddrOp = True
371 nopOp Addr2IntOp = True
372 nopOp ChrOp = True -- Int# and Char# are rep'd the same
376 -- These PrimOps turn into double casts
378 narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
379 narrowOp Narrow8IntOp = Just (MO_SS_Conv, W8)
380 narrowOp Narrow16IntOp = Just (MO_SS_Conv, W16)
381 narrowOp Narrow32IntOp = Just (MO_SS_Conv, W32)
382 narrowOp Narrow8WordOp = Just (MO_UU_Conv, W8)
383 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
384 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
387 -- Native word signless ops
389 translateOp IntAddOp = Just mo_wordAdd
390 translateOp IntSubOp = Just mo_wordSub
391 translateOp WordAddOp = Just mo_wordAdd
392 translateOp WordSubOp = Just mo_wordSub
393 translateOp AddrAddOp = Just mo_wordAdd
394 translateOp AddrSubOp = Just mo_wordSub
396 translateOp IntEqOp = Just mo_wordEq
397 translateOp IntNeOp = Just mo_wordNe
398 translateOp WordEqOp = Just mo_wordEq
399 translateOp WordNeOp = Just mo_wordNe
400 translateOp AddrEqOp = Just mo_wordEq
401 translateOp AddrNeOp = Just mo_wordNe
403 translateOp AndOp = Just mo_wordAnd
404 translateOp OrOp = Just mo_wordOr
405 translateOp XorOp = Just mo_wordXor
406 translateOp NotOp = Just mo_wordNot
407 translateOp SllOp = Just mo_wordShl
408 translateOp SrlOp = Just mo_wordUShr
410 translateOp AddrRemOp = Just mo_wordURem
412 -- Native word signed ops
414 translateOp IntMulOp = Just mo_wordMul
415 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
416 translateOp IntQuotOp = Just mo_wordSQuot
417 translateOp IntRemOp = Just mo_wordSRem
418 translateOp IntNegOp = Just mo_wordSNeg
421 translateOp IntGeOp = Just mo_wordSGe
422 translateOp IntLeOp = Just mo_wordSLe
423 translateOp IntGtOp = Just mo_wordSGt
424 translateOp IntLtOp = Just mo_wordSLt
426 translateOp ISllOp = Just mo_wordShl
427 translateOp ISraOp = Just mo_wordSShr
428 translateOp ISrlOp = Just mo_wordUShr
430 -- Native word unsigned ops
432 translateOp WordGeOp = Just mo_wordUGe
433 translateOp WordLeOp = Just mo_wordULe
434 translateOp WordGtOp = Just mo_wordUGt
435 translateOp WordLtOp = Just mo_wordULt
437 translateOp WordMulOp = Just mo_wordMul
438 translateOp WordQuotOp = Just mo_wordUQuot
439 translateOp WordRemOp = Just mo_wordURem
441 translateOp AddrGeOp = Just mo_wordUGe
442 translateOp AddrLeOp = Just mo_wordULe
443 translateOp AddrGtOp = Just mo_wordUGt
444 translateOp AddrLtOp = Just mo_wordULt
448 translateOp CharEqOp = Just (MO_Eq wordWidth)
449 translateOp CharNeOp = Just (MO_Ne wordWidth)
450 translateOp CharGeOp = Just (MO_U_Ge wordWidth)
451 translateOp CharLeOp = Just (MO_U_Le wordWidth)
452 translateOp CharGtOp = Just (MO_U_Gt wordWidth)
453 translateOp CharLtOp = Just (MO_U_Lt wordWidth)
457 translateOp DoubleEqOp = Just (MO_F_Eq W64)
458 translateOp DoubleNeOp = Just (MO_F_Ne W64)
459 translateOp DoubleGeOp = Just (MO_F_Ge W64)
460 translateOp DoubleLeOp = Just (MO_F_Le W64)
461 translateOp DoubleGtOp = Just (MO_F_Gt W64)
462 translateOp DoubleLtOp = Just (MO_F_Lt W64)
464 translateOp DoubleAddOp = Just (MO_F_Add W64)
465 translateOp DoubleSubOp = Just (MO_F_Sub W64)
466 translateOp DoubleMulOp = Just (MO_F_Mul W64)
467 translateOp DoubleDivOp = Just (MO_F_Quot W64)
468 translateOp DoubleNegOp = Just (MO_F_Neg W64)
472 translateOp FloatEqOp = Just (MO_F_Eq W32)
473 translateOp FloatNeOp = Just (MO_F_Ne W32)
474 translateOp FloatGeOp = Just (MO_F_Ge W32)
475 translateOp FloatLeOp = Just (MO_F_Le W32)
476 translateOp FloatGtOp = Just (MO_F_Gt W32)
477 translateOp FloatLtOp = Just (MO_F_Lt W32)
479 translateOp FloatAddOp = Just (MO_F_Add W32)
480 translateOp FloatSubOp = Just (MO_F_Sub W32)
481 translateOp FloatMulOp = Just (MO_F_Mul W32)
482 translateOp FloatDivOp = Just (MO_F_Quot W32)
483 translateOp FloatNegOp = Just (MO_F_Neg W32)
487 translateOp Int2DoubleOp = Just (MO_SF_Conv wordWidth W64)
488 translateOp Double2IntOp = Just (MO_FS_Conv W64 wordWidth)
490 translateOp Int2FloatOp = Just (MO_SF_Conv wordWidth W32)
491 translateOp Float2IntOp = Just (MO_FS_Conv W32 wordWidth)
493 translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
494 translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
496 -- Word comparisons masquerading as more exotic things.
498 translateOp SameMutVarOp = Just mo_wordEq
499 translateOp SameMVarOp = Just mo_wordEq
500 translateOp SameMutableArrayOp = Just mo_wordEq
501 translateOp SameMutableByteArrayOp = Just mo_wordEq
502 translateOp SameTVarOp = Just mo_wordEq
503 translateOp EqStablePtrOp = Just mo_wordEq
505 translateOp _ = Nothing
507 -- These primops are implemented by CallishMachOps, because they sometimes
508 -- turn into foreign calls depending on the backend.
510 callishOp DoublePowerOp = Just MO_F64_Pwr
511 callishOp DoubleSinOp = Just MO_F64_Sin
512 callishOp DoubleCosOp = Just MO_F64_Cos
513 callishOp DoubleTanOp = Just MO_F64_Tan
514 callishOp DoubleSinhOp = Just MO_F64_Sinh
515 callishOp DoubleCoshOp = Just MO_F64_Cosh
516 callishOp DoubleTanhOp = Just MO_F64_Tanh
517 callishOp DoubleAsinOp = Just MO_F64_Asin
518 callishOp DoubleAcosOp = Just MO_F64_Acos
519 callishOp DoubleAtanOp = Just MO_F64_Atan
520 callishOp DoubleLogOp = Just MO_F64_Log
521 callishOp DoubleExpOp = Just MO_F64_Exp
522 callishOp DoubleSqrtOp = Just MO_F64_Sqrt
524 callishOp FloatPowerOp = Just MO_F32_Pwr
525 callishOp FloatSinOp = Just MO_F32_Sin
526 callishOp FloatCosOp = Just MO_F32_Cos
527 callishOp FloatTanOp = Just MO_F32_Tan
528 callishOp FloatSinhOp = Just MO_F32_Sinh
529 callishOp FloatCoshOp = Just MO_F32_Cosh
530 callishOp FloatTanhOp = Just MO_F32_Tanh
531 callishOp FloatAsinOp = Just MO_F32_Asin
532 callishOp FloatAcosOp = Just MO_F32_Acos
533 callishOp FloatAtanOp = Just MO_F32_Atan
534 callishOp FloatLogOp = Just MO_F32_Log
535 callishOp FloatExpOp = Just MO_F32_Exp
536 callishOp FloatSqrtOp = Just MO_F32_Sqrt
538 callishOp _ = Nothing
540 ------------------------------------------------------------------------------
541 -- Helpers for translating various minor variants of array indexing.
543 -- Bytearrays outside the heap; hence non-pointers
544 doIndexOffAddrOp, doIndexByteArrayOp
545 :: Maybe MachOp -> CmmType
546 -> [LocalReg] -> [CmmExpr] -> Code
547 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
548 = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
549 doIndexOffAddrOp _ _ _ _
550 = panic "CgPrimOp: doIndexOffAddrOp"
552 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
553 = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
554 doIndexByteArrayOp _ _ _ _
555 = panic "CgPrimOp: doIndexByteArrayOp"
557 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
558 doReadPtrArrayOp res addr idx
559 = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
562 doWriteOffAddrOp, doWriteByteArrayOp
563 :: Maybe MachOp -> CmmType
564 -> [LocalReg] -> [CmmExpr] -> Code
565 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
566 = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
567 doWriteOffAddrOp _ _ _ _
568 = panic "CgPrimOp: doWriteOffAddrOp"
570 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
571 = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
572 doWriteByteArrayOp _ _ _ _
573 = panic "CgPrimOp: doWriteByteArrayOp"
575 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> Code
576 doWritePtrArrayOp addr idx val
577 = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
578 mkBasicIndexedWrite arrPtrsHdrSize Nothing bWord addr idx val
581 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
582 -> LocalReg -> CmmExpr -> CmmExpr -> Code
583 mkBasicIndexedRead off Nothing read_rep res base idx
584 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
585 mkBasicIndexedRead off (Just cast) read_rep res base idx
586 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
587 cmmLoadIndexOffExpr off read_rep base idx]))
589 mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType
590 -> CmmExpr -> CmmExpr -> CmmExpr -> Code
591 mkBasicIndexedWrite off Nothing write_rep base idx val
592 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
593 mkBasicIndexedWrite off (Just cast) write_rep base idx val
594 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
596 -- ----------------------------------------------------------------------------
599 cmmIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
600 cmmIndexOffExpr off rep base idx
601 = cmmIndexExpr (typeWidth rep) (cmmOffsetB base off) idx
603 cmmLoadIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
604 cmmLoadIndexOffExpr off rep base idx
605 = CmmLoad (cmmIndexOffExpr off rep base idx) rep
607 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
608 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr