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 -----------------------------------------------------------------------------
20 #include "HsVersions.h"
40 -- ---------------------------------------------------------------------------
41 -- Code generation for PrimOps
43 cgPrimOp :: CmmFormalsWithoutKinds -- where to put the results
45 -> [StgArg] -- arguments
46 -> StgLiveVars -- live vars, in case we need to save them
49 cgPrimOp results op args live
50 = do arg_exprs <- getArgAmodes args
51 let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
52 emitPrimOp results op non_void_args live
55 emitPrimOp :: CmmFormalsWithoutKinds -- where to put the results
57 -> [CmmExpr] -- arguments
58 -> StgLiveVars -- live vars, in case we need to save them
61 -- First we handle various awkward cases specially. The remaining
62 -- easy cases are then handled by translateOp, defined below.
64 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] live
66 With some bit-twiddling, we can define int{Add,Sub}Czh portably in
67 C, and without needing any comparisons. This may not be the
68 fastest way to do it - if you have better code, please send it! --SDM
70 Return : r = a + b, c = 0 if no overflow, 1 on overflow.
72 We currently don't make use of the r value if c is != 0 (i.e.
73 overflow), we just convert to big integers and try again. This
74 could be improved by making r and c the correct values for
75 plugging into a new J#.
77 { r = ((I_)(a)) + ((I_)(b)); \
78 c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
79 >> (BITS_IN (I_) - 1); \
81 Wading through the mass of bracketry, it seems to reduce to:
82 c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
86 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
87 CmmAssign (CmmLocal res_c) $
88 CmmMachOp mo_wordUShr [
89 CmmMachOp mo_wordAnd [
90 CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
91 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
93 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
98 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
100 #define subIntCzh(r,c,a,b) \
101 { r = ((I_)(a)) - ((I_)(b)); \
102 c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
103 >> (BITS_IN (I_) - 1); \
106 c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
109 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
110 CmmAssign (CmmLocal res_c) $
111 CmmMachOp mo_wordUShr [
112 CmmMachOp mo_wordAnd [
113 CmmMachOp mo_wordXor [aa,bb],
114 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
116 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
121 emitPrimOp [res] ParOp [arg] live
123 -- for now, just implement this in a C function
124 -- later, we might want to inline it.
125 vols <- getVolatileRegs live
126 emitForeignCall' PlayRisky
127 [CmmHinted res NoHint]
128 (CmmCallee newspark CCallConv)
129 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
130 , (CmmHinted arg PtrHint) ]
132 NoC_SRT -- No SRT b/c we do PlayRisky
135 newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
137 emitPrimOp [res] ReadMutVarOp [mutv] live
138 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize))
140 emitPrimOp [] WriteMutVarOp [mutv,var] live
142 stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
143 vols <- getVolatileRegs live
144 emitForeignCall' PlayRisky
146 (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
148 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
149 , (CmmHinted mutv PtrHint) ]
151 NoC_SRT -- No SRT b/c we do PlayRisky
154 -- #define sizzeofByteArrayzh(r,a) \
155 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
156 emitPrimOp [res] SizeofByteArrayOp [arg] live
158 CmmAssign (CmmLocal res) (CmmMachOp mo_wordMul [
159 cmmLoadIndexW arg fixedHdrSize,
160 CmmLit (mkIntCLit wORD_SIZE)
163 -- #define sizzeofMutableByteArrayzh(r,a) \
164 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
165 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
166 = emitPrimOp [res] SizeofByteArrayOp [arg] live
169 -- #define touchzh(o) /* nothing */
170 emitPrimOp [] TouchOp [arg] live
173 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
174 emitPrimOp [res] ByteArrayContents_Char [arg] live
175 = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
177 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
178 emitPrimOp [res] StableNameToIntOp [arg] live
179 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize))
181 -- #define eqStableNamezh(r,sn1,sn2) \
182 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
183 emitPrimOp [res] EqStableNameOp [arg1,arg2] live
184 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
185 cmmLoadIndexW arg1 fixedHdrSize,
186 cmmLoadIndexW arg2 fixedHdrSize
190 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
191 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
193 -- #define addrToHValuezh(r,a) r=(P_)a
194 emitPrimOp [res] AddrToHValueOp [arg] live
195 = stmtC (CmmAssign (CmmLocal res) arg)
197 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
198 -- Note: argument may be tagged!
199 emitPrimOp [res] DataToTagOp [arg] live
200 = stmtC (CmmAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
202 {- Freezing arrays-of-ptrs requires changing an info table, for the
203 benefit of the generational collector. It needs to scavenge mutable
204 objects, even if they are in old space. When they become immutable,
205 they can be removed from this scavenge list. -}
207 -- #define unsafeFreezzeArrayzh(r,a)
209 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
212 emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
213 = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
214 CmmAssign (CmmLocal res) arg ]
216 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
217 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
218 = stmtC (CmmAssign (CmmLocal res) arg)
220 -- Reading/writing pointer arrays
222 emitPrimOp [r] ReadArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix
223 emitPrimOp [r] IndexArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix
224 emitPrimOp [] WriteArrayOp [obj,ix,v] live = doWritePtrArrayOp obj ix v
228 emitPrimOp res IndexOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
229 emitPrimOp res IndexOffAddrOp_WideChar args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
230 emitPrimOp res IndexOffAddrOp_Int args live = doIndexOffAddrOp Nothing wordRep res args
231 emitPrimOp res IndexOffAddrOp_Word args live = doIndexOffAddrOp Nothing wordRep res args
232 emitPrimOp res IndexOffAddrOp_Addr args live = doIndexOffAddrOp Nothing wordRep res args
233 emitPrimOp res IndexOffAddrOp_Float args live = doIndexOffAddrOp Nothing F32 res args
234 emitPrimOp res IndexOffAddrOp_Double args live = doIndexOffAddrOp Nothing F64 res args
235 emitPrimOp res IndexOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
236 emitPrimOp res IndexOffAddrOp_Int8 args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8 res args
237 emitPrimOp res IndexOffAddrOp_Int16 args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
238 emitPrimOp res IndexOffAddrOp_Int32 args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
239 emitPrimOp res IndexOffAddrOp_Int64 args live = doIndexOffAddrOp Nothing I64 res args
240 emitPrimOp res IndexOffAddrOp_Word8 args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
241 emitPrimOp res IndexOffAddrOp_Word16 args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
242 emitPrimOp res IndexOffAddrOp_Word32 args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
243 emitPrimOp res IndexOffAddrOp_Word64 args live = doIndexOffAddrOp Nothing I64 res args
245 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
247 emitPrimOp res ReadOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
248 emitPrimOp res ReadOffAddrOp_WideChar args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
249 emitPrimOp res ReadOffAddrOp_Int args live = doIndexOffAddrOp Nothing wordRep res args
250 emitPrimOp res ReadOffAddrOp_Word args live = doIndexOffAddrOp Nothing wordRep res args
251 emitPrimOp res ReadOffAddrOp_Addr args live = doIndexOffAddrOp Nothing wordRep res args
252 emitPrimOp res ReadOffAddrOp_Float args live = doIndexOffAddrOp Nothing F32 res args
253 emitPrimOp res ReadOffAddrOp_Double args live = doIndexOffAddrOp Nothing F64 res args
254 emitPrimOp res ReadOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
255 emitPrimOp res ReadOffAddrOp_Int8 args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8 res args
256 emitPrimOp res ReadOffAddrOp_Int16 args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
257 emitPrimOp res ReadOffAddrOp_Int32 args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
258 emitPrimOp res ReadOffAddrOp_Int64 args live = doIndexOffAddrOp Nothing I64 res args
259 emitPrimOp res ReadOffAddrOp_Word8 args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
260 emitPrimOp res ReadOffAddrOp_Word16 args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
261 emitPrimOp res ReadOffAddrOp_Word32 args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
262 emitPrimOp res ReadOffAddrOp_Word64 args live = doIndexOffAddrOp Nothing I64 res args
266 emitPrimOp res IndexByteArrayOp_Char args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
267 emitPrimOp res IndexByteArrayOp_WideChar args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
268 emitPrimOp res IndexByteArrayOp_Int args live = doIndexByteArrayOp Nothing wordRep res args
269 emitPrimOp res IndexByteArrayOp_Word args live = doIndexByteArrayOp Nothing wordRep res args
270 emitPrimOp res IndexByteArrayOp_Addr args live = doIndexByteArrayOp Nothing wordRep res args
271 emitPrimOp res IndexByteArrayOp_Float args live = doIndexByteArrayOp Nothing F32 res args
272 emitPrimOp res IndexByteArrayOp_Double args live = doIndexByteArrayOp Nothing F64 res args
273 emitPrimOp res IndexByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing wordRep res args
274 emitPrimOp res IndexByteArrayOp_Int8 args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8 res args
275 emitPrimOp res IndexByteArrayOp_Int16 args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16 res args
276 emitPrimOp res IndexByteArrayOp_Int32 args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32 res args
277 emitPrimOp res IndexByteArrayOp_Int64 args live = doIndexByteArrayOp Nothing I64 res args
278 emitPrimOp res IndexByteArrayOp_Word8 args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
279 emitPrimOp res IndexByteArrayOp_Word16 args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16 res args
280 emitPrimOp res IndexByteArrayOp_Word32 args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
281 emitPrimOp res IndexByteArrayOp_Word64 args live = doIndexByteArrayOp Nothing I64 res args
283 -- ReadXXXArray, identical to IndexXXXArray.
285 emitPrimOp res ReadByteArrayOp_Char args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
286 emitPrimOp res ReadByteArrayOp_WideChar args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
287 emitPrimOp res ReadByteArrayOp_Int args live = doIndexByteArrayOp Nothing wordRep res args
288 emitPrimOp res ReadByteArrayOp_Word args live = doIndexByteArrayOp Nothing wordRep res args
289 emitPrimOp res ReadByteArrayOp_Addr args live = doIndexByteArrayOp Nothing wordRep res args
290 emitPrimOp res ReadByteArrayOp_Float args live = doIndexByteArrayOp Nothing F32 res args
291 emitPrimOp res ReadByteArrayOp_Double args live = doIndexByteArrayOp Nothing F64 res args
292 emitPrimOp res ReadByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing wordRep res args
293 emitPrimOp res ReadByteArrayOp_Int8 args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8 res args
294 emitPrimOp res ReadByteArrayOp_Int16 args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16 res args
295 emitPrimOp res ReadByteArrayOp_Int32 args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32 res args
296 emitPrimOp res ReadByteArrayOp_Int64 args live = doIndexByteArrayOp Nothing I64 res args
297 emitPrimOp res ReadByteArrayOp_Word8 args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
298 emitPrimOp res ReadByteArrayOp_Word16 args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16 res args
299 emitPrimOp res ReadByteArrayOp_Word32 args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
300 emitPrimOp res ReadByteArrayOp_Word64 args live = doIndexByteArrayOp Nothing I64 res args
304 emitPrimOp res WriteOffAddrOp_Char args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
305 emitPrimOp res WriteOffAddrOp_WideChar args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
306 emitPrimOp res WriteOffAddrOp_Int args live = doWriteOffAddrOp Nothing wordRep res args
307 emitPrimOp res WriteOffAddrOp_Word args live = doWriteOffAddrOp Nothing wordRep res args
308 emitPrimOp res WriteOffAddrOp_Addr args live = doWriteOffAddrOp Nothing wordRep res args
309 emitPrimOp res WriteOffAddrOp_Float args live = doWriteOffAddrOp Nothing F32 res args
310 emitPrimOp res WriteOffAddrOp_Double args live = doWriteOffAddrOp Nothing F64 res args
311 emitPrimOp res WriteOffAddrOp_StablePtr args live = doWriteOffAddrOp Nothing wordRep res args
312 emitPrimOp res WriteOffAddrOp_Int8 args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
313 emitPrimOp res WriteOffAddrOp_Int16 args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
314 emitPrimOp res WriteOffAddrOp_Int32 args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
315 emitPrimOp res WriteOffAddrOp_Int64 args live = doWriteOffAddrOp Nothing I64 res args
316 emitPrimOp res WriteOffAddrOp_Word8 args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
317 emitPrimOp res WriteOffAddrOp_Word16 args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
318 emitPrimOp res WriteOffAddrOp_Word32 args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
319 emitPrimOp res WriteOffAddrOp_Word64 args live = doWriteOffAddrOp Nothing I64 res args
323 emitPrimOp res WriteByteArrayOp_Char args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
324 emitPrimOp res WriteByteArrayOp_WideChar args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
325 emitPrimOp res WriteByteArrayOp_Int args live = doWriteByteArrayOp Nothing wordRep res args
326 emitPrimOp res WriteByteArrayOp_Word args live = doWriteByteArrayOp Nothing wordRep res args
327 emitPrimOp res WriteByteArrayOp_Addr args live = doWriteByteArrayOp Nothing wordRep res args
328 emitPrimOp res WriteByteArrayOp_Float args live = doWriteByteArrayOp Nothing F32 res args
329 emitPrimOp res WriteByteArrayOp_Double args live = doWriteByteArrayOp Nothing F64 res args
330 emitPrimOp res WriteByteArrayOp_StablePtr args live = doWriteByteArrayOp Nothing wordRep res args
331 emitPrimOp res WriteByteArrayOp_Int8 args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
332 emitPrimOp res WriteByteArrayOp_Int16 args live = doWriteByteArrayOp (Just mo_WordTo16) I16 res args
333 emitPrimOp res WriteByteArrayOp_Int32 args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
334 emitPrimOp res WriteByteArrayOp_Int64 args live = doWriteByteArrayOp Nothing I64 res args
335 emitPrimOp res WriteByteArrayOp_Word8 args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
336 emitPrimOp res WriteByteArrayOp_Word16 args live = doWriteByteArrayOp (Just mo_WordTo16) I16 res args
337 emitPrimOp res WriteByteArrayOp_Word32 args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
338 emitPrimOp res WriteByteArrayOp_Word64 args live = doWriteByteArrayOp Nothing I64 res args
341 -- The rest just translate straightforwardly
342 emitPrimOp [res] op [arg] live
344 = stmtC (CmmAssign (CmmLocal res) arg)
346 | Just (mop,rep) <- narrowOp op
347 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (mop rep wordRep) [
348 CmmMachOp (mop wordRep rep) [arg]]))
350 emitPrimOp [res] op args live
351 | Just prim <- callishOp op
352 = do vols <- getVolatileRegs live
353 emitForeignCall' PlayRisky
354 [CmmHinted res NoHint]
356 [CmmHinted a NoHint | a<-args] -- ToDo: hints?
358 NoC_SRT -- No SRT b/c we do PlayRisky
361 | Just mop <- translateOp op
362 = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
366 = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
369 -- These PrimOps are NOPs in Cmm
371 nopOp Int2WordOp = True
372 nopOp Word2IntOp = True
373 nopOp Int2AddrOp = True
374 nopOp Addr2IntOp = True
375 nopOp ChrOp = True -- Int# and Char# are rep'd the same
379 -- These PrimOps turn into double casts
381 narrowOp Narrow8IntOp = Just (MO_S_Conv, I8)
382 narrowOp Narrow16IntOp = Just (MO_S_Conv, I16)
383 narrowOp Narrow32IntOp = Just (MO_S_Conv, I32)
384 narrowOp Narrow8WordOp = Just (MO_U_Conv, I8)
385 narrowOp Narrow16WordOp = Just (MO_U_Conv, I16)
386 narrowOp Narrow32WordOp = Just (MO_U_Conv, I32)
389 -- Native word signless ops
391 translateOp IntAddOp = Just mo_wordAdd
392 translateOp IntSubOp = Just mo_wordSub
393 translateOp WordAddOp = Just mo_wordAdd
394 translateOp WordSubOp = Just mo_wordSub
395 translateOp AddrAddOp = Just mo_wordAdd
396 translateOp AddrSubOp = Just mo_wordSub
398 translateOp IntEqOp = Just mo_wordEq
399 translateOp IntNeOp = Just mo_wordNe
400 translateOp WordEqOp = Just mo_wordEq
401 translateOp WordNeOp = Just mo_wordNe
402 translateOp AddrEqOp = Just mo_wordEq
403 translateOp AddrNeOp = Just mo_wordNe
405 translateOp AndOp = Just mo_wordAnd
406 translateOp OrOp = Just mo_wordOr
407 translateOp XorOp = Just mo_wordXor
408 translateOp NotOp = Just mo_wordNot
409 translateOp SllOp = Just mo_wordShl
410 translateOp SrlOp = Just mo_wordUShr
412 translateOp AddrRemOp = Just mo_wordURem
414 -- Native word signed ops
416 translateOp IntMulOp = Just mo_wordMul
417 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordRep)
418 translateOp IntQuotOp = Just mo_wordSQuot
419 translateOp IntRemOp = Just mo_wordSRem
420 translateOp IntNegOp = Just mo_wordSNeg
423 translateOp IntGeOp = Just mo_wordSGe
424 translateOp IntLeOp = Just mo_wordSLe
425 translateOp IntGtOp = Just mo_wordSGt
426 translateOp IntLtOp = Just mo_wordSLt
428 translateOp ISllOp = Just mo_wordShl
429 translateOp ISraOp = Just mo_wordSShr
430 translateOp ISrlOp = Just mo_wordUShr
432 -- Native word unsigned ops
434 translateOp WordGeOp = Just mo_wordUGe
435 translateOp WordLeOp = Just mo_wordULe
436 translateOp WordGtOp = Just mo_wordUGt
437 translateOp WordLtOp = Just mo_wordULt
439 translateOp WordMulOp = Just mo_wordMul
440 translateOp WordQuotOp = Just mo_wordUQuot
441 translateOp WordRemOp = Just mo_wordURem
443 translateOp AddrGeOp = Just mo_wordUGe
444 translateOp AddrLeOp = Just mo_wordULe
445 translateOp AddrGtOp = Just mo_wordUGt
446 translateOp AddrLtOp = Just mo_wordULt
450 translateOp CharEqOp = Just (MO_Eq wordRep)
451 translateOp CharNeOp = Just (MO_Ne wordRep)
452 translateOp CharGeOp = Just (MO_U_Ge wordRep)
453 translateOp CharLeOp = Just (MO_U_Le wordRep)
454 translateOp CharGtOp = Just (MO_U_Gt wordRep)
455 translateOp CharLtOp = Just (MO_U_Lt wordRep)
459 translateOp DoubleEqOp = Just (MO_Eq F64)
460 translateOp DoubleNeOp = Just (MO_Ne F64)
461 translateOp DoubleGeOp = Just (MO_S_Ge F64)
462 translateOp DoubleLeOp = Just (MO_S_Le F64)
463 translateOp DoubleGtOp = Just (MO_S_Gt F64)
464 translateOp DoubleLtOp = Just (MO_S_Lt F64)
466 translateOp DoubleAddOp = Just (MO_Add F64)
467 translateOp DoubleSubOp = Just (MO_Sub F64)
468 translateOp DoubleMulOp = Just (MO_Mul F64)
469 translateOp DoubleDivOp = Just (MO_S_Quot F64)
470 translateOp DoubleNegOp = Just (MO_S_Neg F64)
474 translateOp FloatEqOp = Just (MO_Eq F32)
475 translateOp FloatNeOp = Just (MO_Ne F32)
476 translateOp FloatGeOp = Just (MO_S_Ge F32)
477 translateOp FloatLeOp = Just (MO_S_Le F32)
478 translateOp FloatGtOp = Just (MO_S_Gt F32)
479 translateOp FloatLtOp = Just (MO_S_Lt F32)
481 translateOp FloatAddOp = Just (MO_Add F32)
482 translateOp FloatSubOp = Just (MO_Sub F32)
483 translateOp FloatMulOp = Just (MO_Mul F32)
484 translateOp FloatDivOp = Just (MO_S_Quot F32)
485 translateOp FloatNegOp = Just (MO_S_Neg F32)
489 translateOp Int2DoubleOp = Just (MO_S_Conv wordRep F64)
490 translateOp Double2IntOp = Just (MO_S_Conv F64 wordRep)
492 translateOp Int2FloatOp = Just (MO_S_Conv wordRep F32)
493 translateOp Float2IntOp = Just (MO_S_Conv F32 wordRep)
495 translateOp Float2DoubleOp = Just (MO_S_Conv F32 F64)
496 translateOp Double2FloatOp = Just (MO_S_Conv F64 F32)
498 -- Word comparisons masquerading as more exotic things.
500 translateOp SameMutVarOp = Just mo_wordEq
501 translateOp SameMVarOp = Just mo_wordEq
502 translateOp SameMutableArrayOp = Just mo_wordEq
503 translateOp SameMutableByteArrayOp = Just mo_wordEq
504 translateOp SameTVarOp = Just mo_wordEq
505 translateOp EqStablePtrOp = Just mo_wordEq
507 translateOp _ = Nothing
509 -- These primops are implemented by CallishMachOps, because they sometimes
510 -- turn into foreign calls depending on the backend.
512 callishOp DoublePowerOp = Just MO_F64_Pwr
513 callishOp DoubleSinOp = Just MO_F64_Sin
514 callishOp DoubleCosOp = Just MO_F64_Cos
515 callishOp DoubleTanOp = Just MO_F64_Tan
516 callishOp DoubleSinhOp = Just MO_F64_Sinh
517 callishOp DoubleCoshOp = Just MO_F64_Cosh
518 callishOp DoubleTanhOp = Just MO_F64_Tanh
519 callishOp DoubleAsinOp = Just MO_F64_Asin
520 callishOp DoubleAcosOp = Just MO_F64_Acos
521 callishOp DoubleAtanOp = Just MO_F64_Atan
522 callishOp DoubleLogOp = Just MO_F64_Log
523 callishOp DoubleExpOp = Just MO_F64_Exp
524 callishOp DoubleSqrtOp = Just MO_F64_Sqrt
526 callishOp FloatPowerOp = Just MO_F32_Pwr
527 callishOp FloatSinOp = Just MO_F32_Sin
528 callishOp FloatCosOp = Just MO_F32_Cos
529 callishOp FloatTanOp = Just MO_F32_Tan
530 callishOp FloatSinhOp = Just MO_F32_Sinh
531 callishOp FloatCoshOp = Just MO_F32_Cosh
532 callishOp FloatTanhOp = Just MO_F32_Tanh
533 callishOp FloatAsinOp = Just MO_F32_Asin
534 callishOp FloatAcosOp = Just MO_F32_Acos
535 callishOp FloatAtanOp = Just MO_F32_Atan
536 callishOp FloatLogOp = Just MO_F32_Log
537 callishOp FloatExpOp = Just MO_F32_Exp
538 callishOp FloatSqrtOp = Just MO_F32_Sqrt
540 callishOp _ = Nothing
542 ------------------------------------------------------------------------------
543 -- Helpers for translating various minor variants of array indexing.
545 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
546 = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
547 doIndexOffAddrOp _ _ _ _
548 = panic "CgPrimOp: doIndexOffAddrOp"
550 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
551 = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
552 doIndexByteArrayOp _ _ _ _
553 = panic "CgPrimOp: doIndexByteArrayOp"
555 doReadPtrArrayOp res addr idx
556 = mkBasicIndexedRead arrPtrsHdrSize Nothing wordRep res addr idx
559 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
560 = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
561 doWriteOffAddrOp _ _ _ _
562 = panic "CgPrimOp: doWriteOffAddrOp"
564 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
565 = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
566 doWriteByteArrayOp _ _ _ _
567 = panic "CgPrimOp: doWriteByteArrayOp"
569 doWritePtrArrayOp addr idx val
570 = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
571 mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
574 mkBasicIndexedRead off Nothing read_rep res base idx
575 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
576 mkBasicIndexedRead off (Just cast) read_rep res base idx
577 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
578 cmmLoadIndexOffExpr off read_rep base idx]))
580 mkBasicIndexedWrite off Nothing write_rep base idx val
581 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
582 mkBasicIndexedWrite off (Just cast) write_rep base idx val
583 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
585 -- ----------------------------------------------------------------------------
588 cmmIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
589 cmmIndexOffExpr off rep base idx
590 = cmmIndexExpr rep (cmmOffsetB base off) idx
592 cmmLoadIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
593 cmmLoadIndexOffExpr off rep base idx
594 = CmmLoad (cmmIndexOffExpr off rep base idx) rep
596 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
597 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr