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