1 -----------------------------------------------------------------------------
3 -- Code generation for PrimOps.
5 -- (c) The University of Glasgow 2004-2006
7 -----------------------------------------------------------------------------
35 -- ---------------------------------------------------------------------------
36 -- Code generation for PrimOps
38 cgPrimOp :: CmmFormals -- where to put the results
40 -> [StgArg] -- arguments
41 -> StgLiveVars -- live vars, in case we need to save them
44 cgPrimOp results op args live
45 = do arg_exprs <- getArgAmodes args
46 let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
47 emitPrimOp results op non_void_args live
50 emitPrimOp :: CmmFormals -- where to put the results
52 -> [CmmExpr] -- arguments
53 -> StgLiveVars -- live vars, in case we need to save them
56 -- First we handle various awkward cases specially. The remaining
57 -- easy cases are then handled by translateOp, defined below.
59 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] _
61 With some bit-twiddling, we can define int{Add,Sub}Czh portably in
62 C, and without needing any comparisons. This may not be the
63 fastest way to do it - if you have better code, please send it! --SDM
65 Return : r = a + b, c = 0 if no overflow, 1 on overflow.
67 We currently don't make use of the r value if c is != 0 (i.e.
68 overflow), we just convert to big integers and try again. This
69 could be improved by making r and c the correct values for
70 plugging into a new J#.
72 { r = ((I_)(a)) + ((I_)(b)); \
73 c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
74 >> (BITS_IN (I_) - 1); \
76 Wading through the mass of bracketry, it seems to reduce to:
77 c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
81 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
82 CmmAssign (CmmLocal res_c) $
83 CmmMachOp mo_wordUShr [
84 CmmMachOp mo_wordAnd [
85 CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
86 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
88 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
93 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] _
95 #define subIntCzh(r,c,a,b) \
96 { r = ((I_)(a)) - ((I_)(b)); \
97 c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
98 >> (BITS_IN (I_) - 1); \
101 c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
104 CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
105 CmmAssign (CmmLocal res_c) $
106 CmmMachOp mo_wordUShr [
107 CmmMachOp mo_wordAnd [
108 CmmMachOp mo_wordXor [aa,bb],
109 CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
111 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
116 emitPrimOp [res] ParOp [arg] live
118 -- for now, just implement this in a C function
119 -- later, we might want to inline it.
120 vols <- getVolatileRegs live
121 emitForeignCall' PlayRisky
122 [CmmHinted res NoHint]
123 (CmmCallee newspark CCallConv)
124 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
125 , (CmmHinted arg AddrHint) ]
127 NoC_SRT -- No SRT b/c we do PlayRisky
130 newspark = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark")))
132 emitPrimOp [res] ReadMutVarOp [mutv] _
133 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize gcWord))
135 emitPrimOp [] WriteMutVarOp [mutv,var] live
137 stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
138 vols <- getVolatileRegs live
139 emitForeignCall' PlayRisky
141 (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
143 [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint)
144 , (CmmHinted mutv AddrHint) ]
146 NoC_SRT -- No SRT b/c we do PlayRisky
149 -- #define sizzeofByteArrayzh(r,a) \
150 -- r = ((StgArrWords *)(a))->bytes
151 emitPrimOp [res] SizeofByteArrayOp [arg] _
153 CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord)
155 -- #define sizzeofMutableByteArrayzh(r,a) \
156 -- r = ((StgArrWords *)(a))->bytes
157 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
158 = emitPrimOp [res] SizeofByteArrayOp [arg] live
161 -- #define touchzh(o) /* nothing */
162 emitPrimOp [] TouchOp [_] _
165 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
166 emitPrimOp [res] ByteArrayContents_Char [arg] _
167 = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
169 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
170 emitPrimOp [res] StableNameToIntOp [arg] _
171 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize bWord))
173 -- #define eqStableNamezh(r,sn1,sn2) \
174 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
175 emitPrimOp [res] EqStableNameOp [arg1,arg2] _
176 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
177 cmmLoadIndexW arg1 fixedHdrSize bWord,
178 cmmLoadIndexW arg2 fixedHdrSize bWord
182 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] _
183 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
185 -- #define addrToHValuezh(r,a) r=(P_)a
186 emitPrimOp [res] AddrToHValueOp [arg] _
187 = stmtC (CmmAssign (CmmLocal res) arg)
189 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
190 -- Note: argument may be tagged!
191 emitPrimOp [res] DataToTagOp [arg] _
192 = stmtC (CmmAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
194 {- Freezing arrays-of-ptrs requires changing an info table, for the
195 benefit of the generational collector. It needs to scavenge mutable
196 objects, even if they are in old space. When they become immutable,
197 they can be removed from this scavenge list. -}
199 -- #define unsafeFreezzeArrayzh(r,a)
201 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
204 emitPrimOp [res] UnsafeFreezeArrayOp [arg] _
205 = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
206 CmmAssign (CmmLocal res) arg ]
208 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
209 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] _
210 = stmtC (CmmAssign (CmmLocal res) arg)
212 emitPrimOp [] CopyArrayOp [src,src_off,dst,dst_off,n] live =
213 doCopyArrayOp src src_off dst dst_off n live
214 emitPrimOp [] CopyMutableArrayOp [src,src_off,dst,dst_off,n] live =
215 doCopyMutableArrayOp src src_off dst dst_off n live
216 emitPrimOp [res] CloneArrayOp [src,src_off,n] live =
217 emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n live
218 emitPrimOp [res] CloneMutableArrayOp [src,src_off,n] live =
219 emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n live
220 emitPrimOp [res] FreezeArrayOp [src,src_off,n] live =
221 emitCloneArray mkMAP_FROZEN_infoLabel res src src_off n live
222 emitPrimOp [res] ThawArrayOp [src,src_off,n] live =
223 emitCloneArray mkMAP_DIRTY_infoLabel res src src_off n live
225 -- Reading/writing pointer arrays
227 emitPrimOp [r] ReadArrayOp [obj,ix] _ = doReadPtrArrayOp r obj ix
228 emitPrimOp [r] IndexArrayOp [obj,ix] _ = doReadPtrArrayOp r obj ix
229 emitPrimOp [] WriteArrayOp [obj,ix,v] _ = doWritePtrArrayOp obj ix v
231 emitPrimOp [res] SizeofArrayOp [arg] _
232 = stmtC $ CmmAssign (CmmLocal res) (cmmLoadIndexW arg (fixedHdrSize + oFFSET_StgMutArrPtrs_ptrs) bWord)
233 emitPrimOp [res] SizeofMutableArrayOp [arg] live
234 = emitPrimOp [res] SizeofArrayOp [arg] live
238 emitPrimOp res IndexOffAddrOp_Char args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
239 emitPrimOp res IndexOffAddrOp_WideChar args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
240 emitPrimOp res IndexOffAddrOp_Int args _ = doIndexOffAddrOp Nothing bWord res args
241 emitPrimOp res IndexOffAddrOp_Word args _ = doIndexOffAddrOp Nothing bWord res args
242 emitPrimOp res IndexOffAddrOp_Addr args _ = doIndexOffAddrOp Nothing bWord res args
243 emitPrimOp res IndexOffAddrOp_Float args _ = doIndexOffAddrOp Nothing f32 res args
244 emitPrimOp res IndexOffAddrOp_Double args _ = doIndexOffAddrOp Nothing f64 res args
245 emitPrimOp res IndexOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing bWord res args
246 emitPrimOp res IndexOffAddrOp_Int8 args _ = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
247 emitPrimOp res IndexOffAddrOp_Int16 args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
248 emitPrimOp res IndexOffAddrOp_Int32 args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
249 emitPrimOp res IndexOffAddrOp_Int64 args _ = doIndexOffAddrOp Nothing b64 res args
250 emitPrimOp res IndexOffAddrOp_Word8 args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
251 emitPrimOp res IndexOffAddrOp_Word16 args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
252 emitPrimOp res IndexOffAddrOp_Word32 args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
253 emitPrimOp res IndexOffAddrOp_Word64 args _ = doIndexOffAddrOp Nothing b64 res args
255 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
257 emitPrimOp res ReadOffAddrOp_Char args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
258 emitPrimOp res ReadOffAddrOp_WideChar args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
259 emitPrimOp res ReadOffAddrOp_Int args _ = doIndexOffAddrOp Nothing bWord res args
260 emitPrimOp res ReadOffAddrOp_Word args _ = doIndexOffAddrOp Nothing bWord res args
261 emitPrimOp res ReadOffAddrOp_Addr args _ = doIndexOffAddrOp Nothing bWord res args
262 emitPrimOp res ReadOffAddrOp_Float args _ = doIndexOffAddrOp Nothing f32 res args
263 emitPrimOp res ReadOffAddrOp_Double args _ = doIndexOffAddrOp Nothing f64 res args
264 emitPrimOp res ReadOffAddrOp_StablePtr args _ = doIndexOffAddrOp Nothing bWord res args
265 emitPrimOp res ReadOffAddrOp_Int8 args _ = doIndexOffAddrOp (Just mo_s_8ToWord) b8 res args
266 emitPrimOp res ReadOffAddrOp_Int16 args _ = doIndexOffAddrOp (Just mo_s_16ToWord) b16 res args
267 emitPrimOp res ReadOffAddrOp_Int32 args _ = doIndexOffAddrOp (Just mo_s_32ToWord) b32 res args
268 emitPrimOp res ReadOffAddrOp_Int64 args _ = doIndexOffAddrOp Nothing b64 res args
269 emitPrimOp res ReadOffAddrOp_Word8 args _ = doIndexOffAddrOp (Just mo_u_8ToWord) b8 res args
270 emitPrimOp res ReadOffAddrOp_Word16 args _ = doIndexOffAddrOp (Just mo_u_16ToWord) b16 res args
271 emitPrimOp res ReadOffAddrOp_Word32 args _ = doIndexOffAddrOp (Just mo_u_32ToWord) b32 res args
272 emitPrimOp res ReadOffAddrOp_Word64 args _ = doIndexOffAddrOp Nothing b64 res args
276 emitPrimOp res IndexByteArrayOp_Char args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
277 emitPrimOp res IndexByteArrayOp_WideChar args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
278 emitPrimOp res IndexByteArrayOp_Int args _ = doIndexByteArrayOp Nothing bWord res args
279 emitPrimOp res IndexByteArrayOp_Word args _ = doIndexByteArrayOp Nothing bWord res args
280 emitPrimOp res IndexByteArrayOp_Addr args _ = doIndexByteArrayOp Nothing bWord res args
281 emitPrimOp res IndexByteArrayOp_Float args _ = doIndexByteArrayOp Nothing f32 res args
282 emitPrimOp res IndexByteArrayOp_Double args _ = doIndexByteArrayOp Nothing f64 res args
283 emitPrimOp res IndexByteArrayOp_StablePtr args _ = doIndexByteArrayOp Nothing bWord res args
284 emitPrimOp res IndexByteArrayOp_Int8 args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
285 emitPrimOp res IndexByteArrayOp_Int16 args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
286 emitPrimOp res IndexByteArrayOp_Int32 args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
287 emitPrimOp res IndexByteArrayOp_Int64 args _ = doIndexByteArrayOp Nothing b64 res args
288 emitPrimOp res IndexByteArrayOp_Word8 args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
289 emitPrimOp res IndexByteArrayOp_Word16 args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
290 emitPrimOp res IndexByteArrayOp_Word32 args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
291 emitPrimOp res IndexByteArrayOp_Word64 args _ = doIndexByteArrayOp Nothing b64 res args
293 -- ReadXXXArray, identical to IndexXXXArray.
295 emitPrimOp res ReadByteArrayOp_Char args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
296 emitPrimOp res ReadByteArrayOp_WideChar args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
297 emitPrimOp res ReadByteArrayOp_Int args _ = doIndexByteArrayOp Nothing bWord res args
298 emitPrimOp res ReadByteArrayOp_Word args _ = doIndexByteArrayOp Nothing bWord res args
299 emitPrimOp res ReadByteArrayOp_Addr args _ = doIndexByteArrayOp Nothing bWord res args
300 emitPrimOp res ReadByteArrayOp_Float args _ = doIndexByteArrayOp Nothing f32 res args
301 emitPrimOp res ReadByteArrayOp_Double args _ = doIndexByteArrayOp Nothing f64 res args
302 emitPrimOp res ReadByteArrayOp_StablePtr args _ = doIndexByteArrayOp Nothing bWord res args
303 emitPrimOp res ReadByteArrayOp_Int8 args _ = doIndexByteArrayOp (Just mo_s_8ToWord) b8 res args
304 emitPrimOp res ReadByteArrayOp_Int16 args _ = doIndexByteArrayOp (Just mo_s_16ToWord) b16 res args
305 emitPrimOp res ReadByteArrayOp_Int32 args _ = doIndexByteArrayOp (Just mo_s_32ToWord) b32 res args
306 emitPrimOp res ReadByteArrayOp_Int64 args _ = doIndexByteArrayOp Nothing b64 res args
307 emitPrimOp res ReadByteArrayOp_Word8 args _ = doIndexByteArrayOp (Just mo_u_8ToWord) b8 res args
308 emitPrimOp res ReadByteArrayOp_Word16 args _ = doIndexByteArrayOp (Just mo_u_16ToWord) b16 res args
309 emitPrimOp res ReadByteArrayOp_Word32 args _ = doIndexByteArrayOp (Just mo_u_32ToWord) b32 res args
310 emitPrimOp res ReadByteArrayOp_Word64 args _ = doIndexByteArrayOp Nothing b64 res args
314 emitPrimOp res WriteOffAddrOp_Char args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
315 emitPrimOp res WriteOffAddrOp_WideChar args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
316 emitPrimOp res WriteOffAddrOp_Int args _ = doWriteOffAddrOp Nothing bWord res args
317 emitPrimOp res WriteOffAddrOp_Word args _ = doWriteOffAddrOp Nothing bWord res args
318 emitPrimOp res WriteOffAddrOp_Addr args _ = doWriteOffAddrOp Nothing bWord res args
319 emitPrimOp res WriteOffAddrOp_Float args _ = doWriteOffAddrOp Nothing f32 res args
320 emitPrimOp res WriteOffAddrOp_Double args _ = doWriteOffAddrOp Nothing f64 res args
321 emitPrimOp res WriteOffAddrOp_StablePtr args _ = doWriteOffAddrOp Nothing bWord res args
322 emitPrimOp res WriteOffAddrOp_Int8 args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
323 emitPrimOp res WriteOffAddrOp_Int16 args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
324 emitPrimOp res WriteOffAddrOp_Int32 args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
325 emitPrimOp res WriteOffAddrOp_Int64 args _ = doWriteOffAddrOp Nothing b64 res args
326 emitPrimOp res WriteOffAddrOp_Word8 args _ = doWriteOffAddrOp (Just mo_WordTo8) b8 res args
327 emitPrimOp res WriteOffAddrOp_Word16 args _ = doWriteOffAddrOp (Just mo_WordTo16) b16 res args
328 emitPrimOp res WriteOffAddrOp_Word32 args _ = doWriteOffAddrOp (Just mo_WordTo32) b32 res args
329 emitPrimOp res WriteOffAddrOp_Word64 args _ = doWriteOffAddrOp Nothing b64 res args
333 emitPrimOp res WriteByteArrayOp_Char args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
334 emitPrimOp res WriteByteArrayOp_WideChar args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
335 emitPrimOp res WriteByteArrayOp_Int args _ = doWriteByteArrayOp Nothing bWord res args
336 emitPrimOp res WriteByteArrayOp_Word args _ = doWriteByteArrayOp Nothing bWord res args
337 emitPrimOp res WriteByteArrayOp_Addr args _ = doWriteByteArrayOp Nothing bWord res args
338 emitPrimOp res WriteByteArrayOp_Float args _ = doWriteByteArrayOp Nothing f32 res args
339 emitPrimOp res WriteByteArrayOp_Double args _ = doWriteByteArrayOp Nothing f64 res args
340 emitPrimOp res WriteByteArrayOp_StablePtr args _ = doWriteByteArrayOp Nothing bWord res args
341 emitPrimOp res WriteByteArrayOp_Int8 args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
342 emitPrimOp res WriteByteArrayOp_Int16 args _ = doWriteByteArrayOp (Just mo_WordTo16) b16 res args
343 emitPrimOp res WriteByteArrayOp_Int32 args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
344 emitPrimOp res WriteByteArrayOp_Int64 args _ = doWriteByteArrayOp Nothing b64 res args
345 emitPrimOp res WriteByteArrayOp_Word8 args _ = doWriteByteArrayOp (Just mo_WordTo8) b8 res args
346 emitPrimOp res WriteByteArrayOp_Word16 args _ = doWriteByteArrayOp (Just mo_WordTo16) b16 res args
347 emitPrimOp res WriteByteArrayOp_Word32 args _ = doWriteByteArrayOp (Just mo_WordTo32) b32 res args
348 emitPrimOp res WriteByteArrayOp_Word64 args _ = doWriteByteArrayOp Nothing b64 res args
351 -- The rest just translate straightforwardly
352 emitPrimOp [res] op [arg] _
354 = stmtC (CmmAssign (CmmLocal res) arg)
356 | Just (mop,rep) <- narrowOp op
357 = stmtC (CmmAssign (CmmLocal res) $
358 CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
360 emitPrimOp [res] op args live
361 | Just prim <- callishOp op
362 = do vols <- getVolatileRegs live
363 emitForeignCall' PlayRisky
364 [CmmHinted res NoHint]
366 [CmmHinted a NoHint | a<-args] -- ToDo: hints?
368 NoC_SRT -- No SRT b/c we do PlayRisky
371 | Just mop <- translateOp op
372 = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
376 = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
379 -- These PrimOps are NOPs in Cmm
381 nopOp :: PrimOp -> Bool
382 nopOp Int2WordOp = True
383 nopOp Word2IntOp = True
384 nopOp Int2AddrOp = True
385 nopOp Addr2IntOp = True
386 nopOp ChrOp = True -- Int# and Char# are rep'd the same
390 -- These PrimOps turn into double casts
392 narrowOp :: PrimOp -> Maybe (Width -> Width -> MachOp, Width)
393 narrowOp Narrow8IntOp = Just (MO_SS_Conv, W8)
394 narrowOp Narrow16IntOp = Just (MO_SS_Conv, W16)
395 narrowOp Narrow32IntOp = Just (MO_SS_Conv, W32)
396 narrowOp Narrow8WordOp = Just (MO_UU_Conv, W8)
397 narrowOp Narrow16WordOp = Just (MO_UU_Conv, W16)
398 narrowOp Narrow32WordOp = Just (MO_UU_Conv, W32)
401 -- Native word signless ops
403 translateOp :: PrimOp -> Maybe MachOp
404 translateOp IntAddOp = Just mo_wordAdd
405 translateOp IntSubOp = Just mo_wordSub
406 translateOp WordAddOp = Just mo_wordAdd
407 translateOp WordSubOp = Just mo_wordSub
408 translateOp AddrAddOp = Just mo_wordAdd
409 translateOp AddrSubOp = Just mo_wordSub
411 translateOp IntEqOp = Just mo_wordEq
412 translateOp IntNeOp = Just mo_wordNe
413 translateOp WordEqOp = Just mo_wordEq
414 translateOp WordNeOp = Just mo_wordNe
415 translateOp AddrEqOp = Just mo_wordEq
416 translateOp AddrNeOp = Just mo_wordNe
418 translateOp AndOp = Just mo_wordAnd
419 translateOp OrOp = Just mo_wordOr
420 translateOp XorOp = Just mo_wordXor
421 translateOp NotOp = Just mo_wordNot
422 translateOp SllOp = Just mo_wordShl
423 translateOp SrlOp = Just mo_wordUShr
425 translateOp AddrRemOp = Just mo_wordURem
427 -- Native word signed ops
429 translateOp IntMulOp = Just mo_wordMul
430 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordWidth)
431 translateOp IntQuotOp = Just mo_wordSQuot
432 translateOp IntRemOp = Just mo_wordSRem
433 translateOp IntNegOp = Just mo_wordSNeg
436 translateOp IntGeOp = Just mo_wordSGe
437 translateOp IntLeOp = Just mo_wordSLe
438 translateOp IntGtOp = Just mo_wordSGt
439 translateOp IntLtOp = Just mo_wordSLt
441 translateOp ISllOp = Just mo_wordShl
442 translateOp ISraOp = Just mo_wordSShr
443 translateOp ISrlOp = Just mo_wordUShr
445 -- Native word unsigned ops
447 translateOp WordGeOp = Just mo_wordUGe
448 translateOp WordLeOp = Just mo_wordULe
449 translateOp WordGtOp = Just mo_wordUGt
450 translateOp WordLtOp = Just mo_wordULt
452 translateOp WordMulOp = Just mo_wordMul
453 translateOp WordQuotOp = Just mo_wordUQuot
454 translateOp WordRemOp = Just mo_wordURem
456 translateOp AddrGeOp = Just mo_wordUGe
457 translateOp AddrLeOp = Just mo_wordULe
458 translateOp AddrGtOp = Just mo_wordUGt
459 translateOp AddrLtOp = Just mo_wordULt
463 translateOp CharEqOp = Just (MO_Eq wordWidth)
464 translateOp CharNeOp = Just (MO_Ne wordWidth)
465 translateOp CharGeOp = Just (MO_U_Ge wordWidth)
466 translateOp CharLeOp = Just (MO_U_Le wordWidth)
467 translateOp CharGtOp = Just (MO_U_Gt wordWidth)
468 translateOp CharLtOp = Just (MO_U_Lt wordWidth)
472 translateOp DoubleEqOp = Just (MO_F_Eq W64)
473 translateOp DoubleNeOp = Just (MO_F_Ne W64)
474 translateOp DoubleGeOp = Just (MO_F_Ge W64)
475 translateOp DoubleLeOp = Just (MO_F_Le W64)
476 translateOp DoubleGtOp = Just (MO_F_Gt W64)
477 translateOp DoubleLtOp = Just (MO_F_Lt W64)
479 translateOp DoubleAddOp = Just (MO_F_Add W64)
480 translateOp DoubleSubOp = Just (MO_F_Sub W64)
481 translateOp DoubleMulOp = Just (MO_F_Mul W64)
482 translateOp DoubleDivOp = Just (MO_F_Quot W64)
483 translateOp DoubleNegOp = Just (MO_F_Neg W64)
487 translateOp FloatEqOp = Just (MO_F_Eq W32)
488 translateOp FloatNeOp = Just (MO_F_Ne W32)
489 translateOp FloatGeOp = Just (MO_F_Ge W32)
490 translateOp FloatLeOp = Just (MO_F_Le W32)
491 translateOp FloatGtOp = Just (MO_F_Gt W32)
492 translateOp FloatLtOp = Just (MO_F_Lt W32)
494 translateOp FloatAddOp = Just (MO_F_Add W32)
495 translateOp FloatSubOp = Just (MO_F_Sub W32)
496 translateOp FloatMulOp = Just (MO_F_Mul W32)
497 translateOp FloatDivOp = Just (MO_F_Quot W32)
498 translateOp FloatNegOp = Just (MO_F_Neg W32)
502 translateOp Int2DoubleOp = Just (MO_SF_Conv wordWidth W64)
503 translateOp Double2IntOp = Just (MO_FS_Conv W64 wordWidth)
505 translateOp Int2FloatOp = Just (MO_SF_Conv wordWidth W32)
506 translateOp Float2IntOp = Just (MO_FS_Conv W32 wordWidth)
508 translateOp Float2DoubleOp = Just (MO_FF_Conv W32 W64)
509 translateOp Double2FloatOp = Just (MO_FF_Conv W64 W32)
511 -- Word comparisons masquerading as more exotic things.
513 translateOp SameMutVarOp = Just mo_wordEq
514 translateOp SameMVarOp = Just mo_wordEq
515 translateOp SameMutableArrayOp = Just mo_wordEq
516 translateOp SameMutableByteArrayOp = Just mo_wordEq
517 translateOp SameTVarOp = Just mo_wordEq
518 translateOp EqStablePtrOp = Just mo_wordEq
520 translateOp _ = Nothing
522 -- These primops are implemented by CallishMachOps, because they sometimes
523 -- turn into foreign calls depending on the backend.
525 callishOp :: PrimOp -> Maybe CallishMachOp
526 callishOp DoublePowerOp = Just MO_F64_Pwr
527 callishOp DoubleSinOp = Just MO_F64_Sin
528 callishOp DoubleCosOp = Just MO_F64_Cos
529 callishOp DoubleTanOp = Just MO_F64_Tan
530 callishOp DoubleSinhOp = Just MO_F64_Sinh
531 callishOp DoubleCoshOp = Just MO_F64_Cosh
532 callishOp DoubleTanhOp = Just MO_F64_Tanh
533 callishOp DoubleAsinOp = Just MO_F64_Asin
534 callishOp DoubleAcosOp = Just MO_F64_Acos
535 callishOp DoubleAtanOp = Just MO_F64_Atan
536 callishOp DoubleLogOp = Just MO_F64_Log
537 callishOp DoubleExpOp = Just MO_F64_Exp
538 callishOp DoubleSqrtOp = Just MO_F64_Sqrt
540 callishOp FloatPowerOp = Just MO_F32_Pwr
541 callishOp FloatSinOp = Just MO_F32_Sin
542 callishOp FloatCosOp = Just MO_F32_Cos
543 callishOp FloatTanOp = Just MO_F32_Tan
544 callishOp FloatSinhOp = Just MO_F32_Sinh
545 callishOp FloatCoshOp = Just MO_F32_Cosh
546 callishOp FloatTanhOp = Just MO_F32_Tanh
547 callishOp FloatAsinOp = Just MO_F32_Asin
548 callishOp FloatAcosOp = Just MO_F32_Acos
549 callishOp FloatAtanOp = Just MO_F32_Atan
550 callishOp FloatLogOp = Just MO_F32_Log
551 callishOp FloatExpOp = Just MO_F32_Exp
552 callishOp FloatSqrtOp = Just MO_F32_Sqrt
554 callishOp _ = Nothing
556 ------------------------------------------------------------------------------
557 -- Helpers for translating various minor variants of array indexing.
559 -- Bytearrays outside the heap; hence non-pointers
560 doIndexOffAddrOp, doIndexByteArrayOp
561 :: Maybe MachOp -> CmmType
562 -> [LocalReg] -> [CmmExpr] -> Code
563 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
564 = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
565 doIndexOffAddrOp _ _ _ _
566 = panic "CgPrimOp: doIndexOffAddrOp"
568 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
569 = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
570 doIndexByteArrayOp _ _ _ _
571 = panic "CgPrimOp: doIndexByteArrayOp"
573 doReadPtrArrayOp :: LocalReg -> CmmExpr -> CmmExpr -> Code
574 doReadPtrArrayOp res addr idx
575 = mkBasicIndexedRead arrPtrsHdrSize Nothing gcWord res addr idx
578 doWriteOffAddrOp, doWriteByteArrayOp
579 :: Maybe MachOp -> CmmType
580 -> [LocalReg] -> [CmmExpr] -> Code
581 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
582 = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
583 doWriteOffAddrOp _ _ _ _
584 = panic "CgPrimOp: doWriteOffAddrOp"
586 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
587 = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
588 doWriteByteArrayOp _ _ _ _
589 = panic "CgPrimOp: doWriteByteArrayOp"
591 doWritePtrArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> Code
592 doWritePtrArrayOp addr idx val
593 = do mkBasicIndexedWrite arrPtrsHdrSize Nothing bWord addr idx val
594 stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
595 -- the write barrier. We must write a byte into the mark table:
596 -- bits8[a + header_size + StgMutArrPtrs_size(a) + x >> N]
599 (cmmOffsetExprW (cmmOffsetB addr arrPtrsHdrSize)
600 (loadArrPtrsSize addr))
601 (CmmMachOp mo_wordUShr [idx,
602 CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)])
603 ) (CmmLit (CmmInt 1 W8))
605 loadArrPtrsSize :: CmmExpr -> CmmExpr
606 loadArrPtrsSize addr = CmmLoad (cmmOffsetB addr off) bWord
607 where off = fixedHdrSize*wORD_SIZE + oFFSET_StgMutArrPtrs_ptrs
609 mkBasicIndexedRead :: ByteOff -> Maybe MachOp -> CmmType
610 -> LocalReg -> CmmExpr -> CmmExpr -> Code
611 mkBasicIndexedRead off Nothing read_rep res base idx
612 = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
613 mkBasicIndexedRead off (Just cast) read_rep res base idx
614 = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
615 cmmLoadIndexOffExpr off read_rep base idx]))
617 mkBasicIndexedWrite :: ByteOff -> Maybe MachOp -> CmmType
618 -> CmmExpr -> CmmExpr -> CmmExpr -> Code
619 mkBasicIndexedWrite off Nothing write_rep base idx val
620 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
621 mkBasicIndexedWrite off (Just cast) write_rep base idx val
622 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
624 -- ----------------------------------------------------------------------------
627 cmmIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
628 cmmIndexOffExpr off rep base idx
629 = cmmIndexExpr (typeWidth rep) (cmmOffsetB base off) idx
631 cmmLoadIndexOffExpr :: ByteOff -> CmmType -> CmmExpr -> CmmExpr -> CmmExpr
632 cmmLoadIndexOffExpr off rep base idx
633 = CmmLoad (cmmIndexOffExpr off rep base idx) rep
635 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
636 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr
638 -- ----------------------------------------------------------------------------
639 -- Copying pointer arrays
641 -- | Takes a source 'Array#', an offset in the source array, a
642 -- destination 'MutableArray#', an offset into the destination array,
643 -- and the number of elements to copy. Copies the given number of
644 -- elements from the source array to the destination array.
645 doCopyArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
646 -> StgLiveVars -> Code
647 doCopyArrayOp = emitCopyArray copy
649 -- Copy data (we assume the arrays aren't overlapping since
650 -- they're of different types)
651 copy _src _dst = emitMemcpyCall
653 -- | Takes a source 'MutableArray#', an offset in the source array, a
654 -- destination 'MutableArray#', an offset into the destination array,
655 -- and the number of elements to copy. Copies the given number of
656 -- elements from the source array to the destination array.
657 doCopyMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
658 -> StgLiveVars -> Code
659 doCopyMutableArrayOp = emitCopyArray copy
661 -- The only time the memory might overlap is when the two arrays
662 -- we were provided are the same array!
663 -- TODO: Optimize branch for common case of no aliasing.
664 copy src dst dst_p src_p bytes live =
665 emitIfThenElse (cmmEqWord src dst)
666 (emitMemmoveCall dst_p src_p bytes live)
667 (emitMemcpyCall dst_p src_p bytes live)
669 emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
670 -> StgLiveVars -> Code)
671 -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
674 emitCopyArray copy src0 src_off0 dst0 dst_off0 n0 live = do
675 -- Assign the arguments to temporaries so the code generator can
676 -- calculate liveness for us.
677 src <- assignTemp_ src0
678 src_off <- assignTemp_ src_off0
679 dst <- assignTemp_ dst0
680 dst_off <- assignTemp_ dst_off0
683 -- Set the dirty bit in the header.
684 stmtC (setInfo dst (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
686 dst_elems_p <- assignTemp $ cmmOffsetB dst arrPtrsHdrSize
687 dst_p <- assignTemp $ cmmOffsetExprW dst_elems_p dst_off
688 src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize) src_off
689 bytes <- assignTemp $ cmmMulWord n (CmmLit (mkIntCLit wORD_SIZE))
691 copy src dst dst_p src_p bytes live
693 -- The base address of the destination card table
694 dst_cards_p <- assignTemp $ cmmOffsetExprW dst_elems_p (loadArrPtrsSize dst)
696 emitSetCards dst_off dst_cards_p n live
698 -- | Takes an info table label, a register to return the newly
699 -- allocated array in, a source array, an offset in the source array,
700 -- and the number of elements to copy. Allocates a new array and
701 -- initializes it form the source array.
702 emitCloneArray :: CLabel -> CmmFormal -> CmmExpr -> CmmExpr -> CmmExpr
703 -> StgLiveVars -> Code
704 emitCloneArray info_p res_r src0 src_off0 n0 live = do
705 -- Assign the arguments to temporaries so the code generator can
706 -- calculate liveness for us.
707 src <- assignTemp_ src0
708 src_off <- assignTemp_ src_off0
711 card_words <- assignTemp $ (n `cmmUShrWord`
712 (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS)))
713 `cmmAddWord` CmmLit (mkIntCLit 1)
714 size <- assignTemp $ n `cmmAddWord` card_words
715 words <- assignTemp $ arrPtrsHdrSizeW `cmmAddWord` size
717 arr_r <- newTemp bWord
718 emitAllocateCall arr_r myCapability words live
719 tickyAllocPrim (CmmLit (mkIntCLit arrPtrsHdrSize)) (n `cmmMulWord` wordSize)
720 (CmmLit $ mkIntCLit 0)
722 let arr = CmmReg (CmmLocal arr_r)
723 emitSetDynHdr arr (CmmLit (CmmLabel info_p)) curCCSAddr
724 stmtC $ CmmStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
725 oFFSET_StgMutArrPtrs_ptrs)) n
726 stmtC $ CmmStore (cmmOffsetB arr (fixedHdrSize * wORD_SIZE +
727 oFFSET_StgMutArrPtrs_size)) size
729 dst_p <- assignTemp $ cmmOffsetB arr arrPtrsHdrSize
730 src_p <- assignTemp $ cmmOffsetExprW (cmmOffsetB src arrPtrsHdrSize)
733 emitMemcpyCall dst_p src_p (n `cmmMulWord` wordSize) live
735 emitMemsetCall (cmmOffsetExprW dst_p n)
736 (CmmLit (CmmInt (toInteger (1 :: Int)) W8))
737 (card_words `cmmMulWord` wordSize)
739 stmtC $ CmmAssign (CmmLocal res_r) arr
741 arrPtrsHdrSizeW = CmmLit $ mkIntCLit $ fixedHdrSize +
742 (sIZEOF_StgMutArrPtrs_NoHdr `div` wORD_SIZE)
743 wordSize = CmmLit (mkIntCLit wORD_SIZE)
744 myCapability = CmmReg baseReg `cmmSubWord`
745 CmmLit (mkIntCLit oFFSET_Capability_r)
747 -- | Takes and offset in the destination array, the base address of
748 -- the card table, and the number of elements affected (*not* the
749 -- number of cards). Marks the relevant cards as dirty.
750 emitSetCards :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
751 emitSetCards dst_start dst_cards_start n live = do
752 start_card <- assignTemp $ card dst_start
753 emitMemsetCall (dst_cards_start `cmmAddWord` start_card)
754 (CmmLit (CmmInt (toInteger (1 :: Int)) W8))
755 ((card (dst_start `cmmAddWord` n) `cmmSubWord` start_card)
756 `cmmAddWord` CmmLit (mkIntCLit 1))
759 -- Convert an element index to a card index
760 card i = i `cmmUShrWord` (CmmLit (mkIntCLit mUT_ARR_PTRS_CARD_BITS))
762 -- | Emit a call to @memcpy@.
763 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
764 emitMemcpyCall dst src n live = do
765 vols <- getVolatileRegs live
766 emitForeignCall' PlayRisky
768 (CmmCallee memcpy CCallConv)
769 [ (CmmHinted dst AddrHint)
770 , (CmmHinted src AddrHint)
771 , (CmmHinted n NoHint)
774 NoC_SRT -- No SRT b/c we do PlayRisky
777 memcpy = CmmLit (CmmLabel (mkForeignLabel (fsLit "memcpy") Nothing
778 ForeignLabelInExternalPackage IsFunction))
780 -- | Emit a call to @memmove@.
781 emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
782 emitMemmoveCall dst src n live = do
783 vols <- getVolatileRegs live
784 emitForeignCall' PlayRisky
786 (CmmCallee memmove CCallConv)
787 [ (CmmHinted dst AddrHint)
788 , (CmmHinted src AddrHint)
789 , (CmmHinted n NoHint)
792 NoC_SRT -- No SRT b/c we do PlayRisky
795 memmove = CmmLit (CmmLabel (mkForeignLabel (fsLit "memmove") Nothing
796 ForeignLabelInExternalPackage IsFunction))
798 -- | Emit a call to @memset@. The second argument must be of type
800 emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
801 emitMemsetCall dst c n live = do
802 vols <- getVolatileRegs live
803 emitForeignCall' PlayRisky
805 (CmmCallee memset CCallConv)
806 [ (CmmHinted dst AddrHint)
807 , (CmmHinted c NoHint)
808 , (CmmHinted n NoHint)
811 NoC_SRT -- No SRT b/c we do PlayRisky
814 memset = CmmLit (CmmLabel (mkForeignLabel (fsLit "memset") Nothing
815 ForeignLabelInExternalPackage IsFunction))
817 -- | Emit a call to @allocate@.
818 emitAllocateCall :: LocalReg -> CmmExpr -> CmmExpr -> StgLiveVars -> Code
819 emitAllocateCall res cap n live = do
820 vols <- getVolatileRegs live
821 emitForeignCall' PlayRisky
822 [CmmHinted res AddrHint]
823 (CmmCallee allocate CCallConv)
824 [ (CmmHinted cap AddrHint)
825 , (CmmHinted n NoHint)
828 NoC_SRT -- No SRT b/c we do PlayRisky
831 allocate = CmmLit (CmmLabel (mkForeignLabel (fsLit "allocate") Nothing
832 ForeignLabelInExternalPackage IsFunction))