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