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