1 -----------------------------------------------------------------------------
3 -- Code generation for PrimOps.
5 -- (c) The University of Glasgow 2004
7 -----------------------------------------------------------------------------
13 import ForeignCall ( CCallConv(CCallConv) )
14 import StgSyn ( StgLiveVars, StgArg )
15 import CgBindery ( getVolatileRegs, getArgAmodes )
17 import CgInfoTbls ( getConstrTag )
18 import CgUtils ( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
20 import CLabel ( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
21 mkDirty_MUT_VAR_Label )
25 import PrimOp ( PrimOp(..) )
26 import SMRep ( tablesNextToCode )
27 import Constants ( wORD_SIZE, wORD_SIZE_IN_BITS )
30 -- ---------------------------------------------------------------------------
31 -- Code generation for PrimOps
33 cgPrimOp :: [CmmReg] -- where to put the results
35 -> [StgArg] -- arguments
36 -> StgLiveVars -- live vars, in case we need to save them
39 cgPrimOp results op args live
40 = do arg_exprs <- getArgAmodes args
41 let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ]
42 emitPrimOp results op non_void_args live
45 emitPrimOp :: [CmmReg] -- where to put the results
47 -> [CmmExpr] -- arguments
48 -> StgLiveVars -- live vars, in case we need to save them
51 -- First we handle various awkward cases specially. The remaining
52 -- easy cases are then handled by translateOp, defined below.
54 emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] live
56 With some bit-twiddling, we can define int{Add,Sub}Czh portably in
57 C, and without needing any comparisons. This may not be the
58 fastest way to do it - if you have better code, please send it! --SDM
60 Return : r = a + b, c = 0 if no overflow, 1 on overflow.
62 We currently don't make use of the r value if c is != 0 (i.e.
63 overflow), we just convert to big integers and try again. This
64 could be improved by making r and c the correct values for
65 plugging into a new J#.
67 { r = ((I_)(a)) + ((I_)(b)); \
68 c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
69 >> (BITS_IN (I_) - 1); \
71 Wading through the mass of bracketry, it seems to reduce to:
72 c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
76 CmmAssign res_r (CmmMachOp mo_wordAdd [aa,bb]),
78 CmmMachOp mo_wordUShr [
79 CmmMachOp mo_wordAnd [
80 CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
81 CmmMachOp mo_wordXor [aa, CmmReg res_r]
83 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
88 emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
90 #define subIntCzh(r,c,a,b) \
91 { r = ((I_)(a)) - ((I_)(b)); \
92 c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r))) \
93 >> (BITS_IN (I_) - 1); \
96 c = ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
99 CmmAssign res_r (CmmMachOp mo_wordSub [aa,bb]),
101 CmmMachOp mo_wordUShr [
102 CmmMachOp mo_wordAnd [
103 CmmMachOp mo_wordXor [aa,bb],
104 CmmMachOp mo_wordXor [aa, CmmReg res_r]
106 CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
111 emitPrimOp [res] ParOp [arg] live
112 = stmtC (CmmAssign res (CmmLit (mkIntCLit 1)))
114 emitPrimOp [res] ReadMutVarOp [mutv] live
115 = stmtC (CmmAssign res (cmmLoadIndexW mutv fixedHdrSize))
117 emitPrimOp [] WriteMutVarOp [mutv,var] live
119 stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
120 vols <- getVolatileRegs live
121 stmtC (CmmCall (CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
127 -- #define sizzeofByteArrayzh(r,a) \
128 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
129 emitPrimOp [res] SizeofByteArrayOp [arg] live
131 CmmAssign res (CmmMachOp mo_wordMul [
132 cmmLoadIndexW arg fixedHdrSize,
133 CmmLit (mkIntCLit wORD_SIZE)
136 -- #define sizzeofMutableByteArrayzh(r,a) \
137 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
138 emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
139 = emitPrimOp [res] SizeofByteArrayOp [arg] live
142 -- #define touchzh(o) /* nothing */
143 emitPrimOp [] TouchOp [arg] live
146 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
147 emitPrimOp [res] ByteArrayContents_Char [arg] live
148 = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize))
150 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
151 emitPrimOp [res] StableNameToIntOp [arg] live
152 = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize))
154 -- #define eqStableNamezh(r,sn1,sn2) \
155 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
156 emitPrimOp [res] EqStableNameOp [arg1,arg2] live
157 = stmtC (CmmAssign res (CmmMachOp mo_wordEq [
158 cmmLoadIndexW arg1 fixedHdrSize,
159 cmmLoadIndexW arg2 fixedHdrSize
163 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
164 = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2]))
166 -- #define addrToHValuezh(r,a) r=(P_)a
167 emitPrimOp [res] AddrToHValueOp [arg] live
168 = stmtC (CmmAssign res arg)
170 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
171 emitPrimOp [res] DataToTagOp [arg] live
172 = stmtC (CmmAssign res (getConstrTag arg))
174 {- Freezing arrays-of-ptrs requires changing an info table, for the
175 benefit of the generational collector. It needs to scavenge mutable
176 objects, even if they are in old space. When they become immutable,
177 they can be removed from this scavenge list. -}
179 -- #define unsafeFreezzeArrayzh(r,a)
181 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
184 emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
185 = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
188 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
189 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
190 = stmtC (CmmAssign res arg)
192 -- Reading/writing pointer arrays
194 emitPrimOp [r] ReadArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix
195 emitPrimOp [r] IndexArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix
196 emitPrimOp [] WriteArrayOp [obj,ix,v] live = doWritePtrArrayOp obj ix v
200 emitPrimOp res IndexOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
201 emitPrimOp res IndexOffAddrOp_WideChar args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
202 emitPrimOp res IndexOffAddrOp_Int args live = doIndexOffAddrOp Nothing wordRep res args
203 emitPrimOp res IndexOffAddrOp_Word args live = doIndexOffAddrOp Nothing wordRep res args
204 emitPrimOp res IndexOffAddrOp_Addr args live = doIndexOffAddrOp Nothing wordRep res args
205 emitPrimOp res IndexOffAddrOp_Float args live = doIndexOffAddrOp Nothing F32 res args
206 emitPrimOp res IndexOffAddrOp_Double args live = doIndexOffAddrOp Nothing F64 res args
207 emitPrimOp res IndexOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
208 emitPrimOp res IndexOffAddrOp_Int8 args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8 res args
209 emitPrimOp res IndexOffAddrOp_Int16 args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
210 emitPrimOp res IndexOffAddrOp_Int32 args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
211 emitPrimOp res IndexOffAddrOp_Int64 args live = doIndexOffAddrOp Nothing I64 res args
212 emitPrimOp res IndexOffAddrOp_Word8 args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
213 emitPrimOp res IndexOffAddrOp_Word16 args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
214 emitPrimOp res IndexOffAddrOp_Word32 args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
215 emitPrimOp res IndexOffAddrOp_Word64 args live = doIndexOffAddrOp Nothing I64 res args
217 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
219 emitPrimOp res ReadOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
220 emitPrimOp res ReadOffAddrOp_WideChar args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
221 emitPrimOp res ReadOffAddrOp_Int args live = doIndexOffAddrOp Nothing wordRep res args
222 emitPrimOp res ReadOffAddrOp_Word args live = doIndexOffAddrOp Nothing wordRep res args
223 emitPrimOp res ReadOffAddrOp_Addr args live = doIndexOffAddrOp Nothing wordRep res args
224 emitPrimOp res ReadOffAddrOp_Float args live = doIndexOffAddrOp Nothing F32 res args
225 emitPrimOp res ReadOffAddrOp_Double args live = doIndexOffAddrOp Nothing F64 res args
226 emitPrimOp res ReadOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
227 emitPrimOp res ReadOffAddrOp_Int8 args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8 res args
228 emitPrimOp res ReadOffAddrOp_Int16 args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
229 emitPrimOp res ReadOffAddrOp_Int32 args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
230 emitPrimOp res ReadOffAddrOp_Int64 args live = doIndexOffAddrOp Nothing I64 res args
231 emitPrimOp res ReadOffAddrOp_Word8 args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
232 emitPrimOp res ReadOffAddrOp_Word16 args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
233 emitPrimOp res ReadOffAddrOp_Word32 args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
234 emitPrimOp res ReadOffAddrOp_Word64 args live = doIndexOffAddrOp Nothing I64 res args
238 emitPrimOp res IndexByteArrayOp_Char args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
239 emitPrimOp res IndexByteArrayOp_WideChar args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
240 emitPrimOp res IndexByteArrayOp_Int args live = doIndexByteArrayOp Nothing wordRep res args
241 emitPrimOp res IndexByteArrayOp_Word args live = doIndexByteArrayOp Nothing wordRep res args
242 emitPrimOp res IndexByteArrayOp_Addr args live = doIndexByteArrayOp Nothing wordRep res args
243 emitPrimOp res IndexByteArrayOp_Float args live = doIndexByteArrayOp Nothing F32 res args
244 emitPrimOp res IndexByteArrayOp_Double args live = doIndexByteArrayOp Nothing F64 res args
245 emitPrimOp res IndexByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing wordRep res args
246 emitPrimOp res IndexByteArrayOp_Int8 args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8 res args
247 emitPrimOp res IndexByteArrayOp_Int16 args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16 res args
248 emitPrimOp res IndexByteArrayOp_Int32 args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32 res args
249 emitPrimOp res IndexByteArrayOp_Int64 args live = doIndexByteArrayOp Nothing I64 res args
250 emitPrimOp res IndexByteArrayOp_Word8 args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
251 emitPrimOp res IndexByteArrayOp_Word16 args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16 res args
252 emitPrimOp res IndexByteArrayOp_Word32 args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
253 emitPrimOp res IndexByteArrayOp_Word64 args live = doIndexByteArrayOp Nothing I64 res args
255 -- ReadXXXArray, identical to IndexXXXArray.
257 emitPrimOp res ReadByteArrayOp_Char args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
258 emitPrimOp res ReadByteArrayOp_WideChar args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
259 emitPrimOp res ReadByteArrayOp_Int args live = doIndexByteArrayOp Nothing wordRep res args
260 emitPrimOp res ReadByteArrayOp_Word args live = doIndexByteArrayOp Nothing wordRep res args
261 emitPrimOp res ReadByteArrayOp_Addr args live = doIndexByteArrayOp Nothing wordRep res args
262 emitPrimOp res ReadByteArrayOp_Float args live = doIndexByteArrayOp Nothing F32 res args
263 emitPrimOp res ReadByteArrayOp_Double args live = doIndexByteArrayOp Nothing F64 res args
264 emitPrimOp res ReadByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing wordRep res args
265 emitPrimOp res ReadByteArrayOp_Int8 args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8 res args
266 emitPrimOp res ReadByteArrayOp_Int16 args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16 res args
267 emitPrimOp res ReadByteArrayOp_Int32 args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32 res args
268 emitPrimOp res ReadByteArrayOp_Int64 args live = doIndexByteArrayOp Nothing I64 res args
269 emitPrimOp res ReadByteArrayOp_Word8 args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
270 emitPrimOp res ReadByteArrayOp_Word16 args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16 res args
271 emitPrimOp res ReadByteArrayOp_Word32 args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
272 emitPrimOp res ReadByteArrayOp_Word64 args live = doIndexByteArrayOp Nothing I64 res args
276 emitPrimOp res WriteOffAddrOp_Char args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
277 emitPrimOp res WriteOffAddrOp_WideChar args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
278 emitPrimOp res WriteOffAddrOp_Int args live = doWriteOffAddrOp Nothing wordRep res args
279 emitPrimOp res WriteOffAddrOp_Word args live = doWriteOffAddrOp Nothing wordRep res args
280 emitPrimOp res WriteOffAddrOp_Addr args live = doWriteOffAddrOp Nothing wordRep res args
281 emitPrimOp res WriteOffAddrOp_Float args live = doWriteOffAddrOp Nothing F32 res args
282 emitPrimOp res WriteOffAddrOp_Double args live = doWriteOffAddrOp Nothing F64 res args
283 emitPrimOp res WriteOffAddrOp_StablePtr args live = doWriteOffAddrOp Nothing wordRep res args
284 emitPrimOp res WriteOffAddrOp_Int8 args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
285 emitPrimOp res WriteOffAddrOp_Int16 args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
286 emitPrimOp res WriteOffAddrOp_Int32 args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
287 emitPrimOp res WriteOffAddrOp_Int64 args live = doWriteOffAddrOp Nothing I64 res args
288 emitPrimOp res WriteOffAddrOp_Word8 args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
289 emitPrimOp res WriteOffAddrOp_Word16 args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
290 emitPrimOp res WriteOffAddrOp_Word32 args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
291 emitPrimOp res WriteOffAddrOp_Word64 args live = doWriteOffAddrOp Nothing I64 res args
295 emitPrimOp res WriteByteArrayOp_Char args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
296 emitPrimOp res WriteByteArrayOp_WideChar args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
297 emitPrimOp res WriteByteArrayOp_Int args live = doWriteByteArrayOp Nothing wordRep res args
298 emitPrimOp res WriteByteArrayOp_Word args live = doWriteByteArrayOp Nothing wordRep res args
299 emitPrimOp res WriteByteArrayOp_Addr args live = doWriteByteArrayOp Nothing wordRep res args
300 emitPrimOp res WriteByteArrayOp_Float args live = doWriteByteArrayOp Nothing F32 res args
301 emitPrimOp res WriteByteArrayOp_Double args live = doWriteByteArrayOp Nothing F64 res args
302 emitPrimOp res WriteByteArrayOp_StablePtr args live = doWriteByteArrayOp Nothing wordRep res args
303 emitPrimOp res WriteByteArrayOp_Int8 args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
304 emitPrimOp res WriteByteArrayOp_Int16 args live = doWriteByteArrayOp (Just mo_WordTo16) I16 res args
305 emitPrimOp res WriteByteArrayOp_Int32 args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
306 emitPrimOp res WriteByteArrayOp_Int64 args live = doWriteByteArrayOp Nothing I64 res args
307 emitPrimOp res WriteByteArrayOp_Word8 args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
308 emitPrimOp res WriteByteArrayOp_Word16 args live = doWriteByteArrayOp (Just mo_WordTo16) I16 res args
309 emitPrimOp res WriteByteArrayOp_Word32 args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
310 emitPrimOp res WriteByteArrayOp_Word64 args live = doWriteByteArrayOp Nothing I64 res args
313 -- The rest just translate straightforwardly
314 emitPrimOp [res] op [arg] live
316 = stmtC (CmmAssign res arg)
318 | Just (mop,rep) <- narrowOp op
319 = stmtC (CmmAssign res (CmmMachOp (mop rep wordRep) [
320 CmmMachOp (mop wordRep rep) [arg]]))
322 emitPrimOp [res] op args live
323 | Just prim <- callishOp op
324 = do vols <- getVolatileRegs live
325 stmtC (CmmCall (CmmPrim prim) [(res,NoHint)]
326 [(a,NoHint) | a<-args] (Just vols)) -- ToDo: hints?
328 | Just mop <- translateOp op
329 = let stmt = CmmAssign res (CmmMachOp mop args) in
333 = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
336 -- These PrimOps are NOPs in Cmm
338 nopOp Int2WordOp = True
339 nopOp Word2IntOp = True
340 nopOp Int2AddrOp = True
341 nopOp Addr2IntOp = True
342 nopOp ChrOp = True -- Int# and Char# are rep'd the same
346 -- These PrimOps turn into double casts
348 narrowOp Narrow8IntOp = Just (MO_S_Conv, I8)
349 narrowOp Narrow16IntOp = Just (MO_S_Conv, I16)
350 narrowOp Narrow32IntOp = Just (MO_S_Conv, I32)
351 narrowOp Narrow8WordOp = Just (MO_U_Conv, I8)
352 narrowOp Narrow16WordOp = Just (MO_U_Conv, I16)
353 narrowOp Narrow32WordOp = Just (MO_U_Conv, I32)
356 -- Native word signless ops
358 translateOp IntAddOp = Just mo_wordAdd
359 translateOp IntSubOp = Just mo_wordSub
360 translateOp WordAddOp = Just mo_wordAdd
361 translateOp WordSubOp = Just mo_wordSub
362 translateOp AddrAddOp = Just mo_wordAdd
363 translateOp AddrSubOp = Just mo_wordSub
365 translateOp IntEqOp = Just mo_wordEq
366 translateOp IntNeOp = Just mo_wordNe
367 translateOp WordEqOp = Just mo_wordEq
368 translateOp WordNeOp = Just mo_wordNe
369 translateOp AddrEqOp = Just mo_wordEq
370 translateOp AddrNeOp = Just mo_wordNe
372 translateOp AndOp = Just mo_wordAnd
373 translateOp OrOp = Just mo_wordOr
374 translateOp XorOp = Just mo_wordXor
375 translateOp NotOp = Just mo_wordNot
376 translateOp SllOp = Just mo_wordShl
377 translateOp SrlOp = Just mo_wordUShr
379 translateOp AddrRemOp = Just mo_wordURem
381 -- Native word signed ops
383 translateOp IntMulOp = Just mo_wordMul
384 translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordRep)
385 translateOp IntQuotOp = Just mo_wordSQuot
386 translateOp IntRemOp = Just mo_wordSRem
387 translateOp IntNegOp = Just mo_wordSNeg
390 translateOp IntGeOp = Just mo_wordSGe
391 translateOp IntLeOp = Just mo_wordSLe
392 translateOp IntGtOp = Just mo_wordSGt
393 translateOp IntLtOp = Just mo_wordSLt
395 translateOp ISllOp = Just mo_wordShl
396 translateOp ISraOp = Just mo_wordSShr
397 translateOp ISrlOp = Just mo_wordUShr
399 -- Native word unsigned ops
401 translateOp WordGeOp = Just mo_wordUGe
402 translateOp WordLeOp = Just mo_wordULe
403 translateOp WordGtOp = Just mo_wordUGt
404 translateOp WordLtOp = Just mo_wordULt
406 translateOp WordMulOp = Just mo_wordMul
407 translateOp WordQuotOp = Just mo_wordUQuot
408 translateOp WordRemOp = Just mo_wordURem
410 translateOp AddrGeOp = Just mo_wordUGe
411 translateOp AddrLeOp = Just mo_wordULe
412 translateOp AddrGtOp = Just mo_wordUGt
413 translateOp AddrLtOp = Just mo_wordULt
417 translateOp CharEqOp = Just (MO_Eq wordRep)
418 translateOp CharNeOp = Just (MO_Ne wordRep)
419 translateOp CharGeOp = Just (MO_U_Ge wordRep)
420 translateOp CharLeOp = Just (MO_U_Le wordRep)
421 translateOp CharGtOp = Just (MO_U_Gt wordRep)
422 translateOp CharLtOp = Just (MO_U_Lt wordRep)
426 translateOp DoubleEqOp = Just (MO_Eq F64)
427 translateOp DoubleNeOp = Just (MO_Ne F64)
428 translateOp DoubleGeOp = Just (MO_S_Ge F64)
429 translateOp DoubleLeOp = Just (MO_S_Le F64)
430 translateOp DoubleGtOp = Just (MO_S_Gt F64)
431 translateOp DoubleLtOp = Just (MO_S_Lt F64)
433 translateOp DoubleAddOp = Just (MO_Add F64)
434 translateOp DoubleSubOp = Just (MO_Sub F64)
435 translateOp DoubleMulOp = Just (MO_Mul F64)
436 translateOp DoubleDivOp = Just (MO_S_Quot F64)
437 translateOp DoubleNegOp = Just (MO_S_Neg F64)
441 translateOp FloatEqOp = Just (MO_Eq F32)
442 translateOp FloatNeOp = Just (MO_Ne F32)
443 translateOp FloatGeOp = Just (MO_S_Ge F32)
444 translateOp FloatLeOp = Just (MO_S_Le F32)
445 translateOp FloatGtOp = Just (MO_S_Gt F32)
446 translateOp FloatLtOp = Just (MO_S_Lt F32)
448 translateOp FloatAddOp = Just (MO_Add F32)
449 translateOp FloatSubOp = Just (MO_Sub F32)
450 translateOp FloatMulOp = Just (MO_Mul F32)
451 translateOp FloatDivOp = Just (MO_S_Quot F32)
452 translateOp FloatNegOp = Just (MO_S_Neg F32)
456 translateOp Int2DoubleOp = Just (MO_S_Conv wordRep F64)
457 translateOp Double2IntOp = Just (MO_S_Conv F64 wordRep)
459 translateOp Int2FloatOp = Just (MO_S_Conv wordRep F32)
460 translateOp Float2IntOp = Just (MO_S_Conv F32 wordRep)
462 translateOp Float2DoubleOp = Just (MO_S_Conv F32 F64)
463 translateOp Double2FloatOp = Just (MO_S_Conv F64 F32)
465 -- Word comparisons masquerading as more exotic things.
467 translateOp SameMutVarOp = Just mo_wordEq
468 translateOp SameMVarOp = Just mo_wordEq
469 translateOp SameMutableArrayOp = Just mo_wordEq
470 translateOp SameMutableByteArrayOp = Just mo_wordEq
471 translateOp SameTVarOp = Just mo_wordEq
472 translateOp EqStablePtrOp = Just mo_wordEq
474 translateOp _ = Nothing
476 -- These primops are implemented by CallishMachOps, because they sometimes
477 -- turn into foreign calls depending on the backend.
479 callishOp DoublePowerOp = Just MO_F64_Pwr
480 callishOp DoubleSinOp = Just MO_F64_Sin
481 callishOp DoubleCosOp = Just MO_F64_Cos
482 callishOp DoubleTanOp = Just MO_F64_Tan
483 callishOp DoubleSinhOp = Just MO_F64_Sinh
484 callishOp DoubleCoshOp = Just MO_F64_Cosh
485 callishOp DoubleTanhOp = Just MO_F64_Tanh
486 callishOp DoubleAsinOp = Just MO_F64_Asin
487 callishOp DoubleAcosOp = Just MO_F64_Acos
488 callishOp DoubleAtanOp = Just MO_F64_Atan
489 callishOp DoubleLogOp = Just MO_F64_Log
490 callishOp DoubleExpOp = Just MO_F64_Exp
491 callishOp DoubleSqrtOp = Just MO_F64_Sqrt
493 callishOp FloatPowerOp = Just MO_F32_Pwr
494 callishOp FloatSinOp = Just MO_F32_Sin
495 callishOp FloatCosOp = Just MO_F32_Cos
496 callishOp FloatTanOp = Just MO_F32_Tan
497 callishOp FloatSinhOp = Just MO_F32_Sinh
498 callishOp FloatCoshOp = Just MO_F32_Cosh
499 callishOp FloatTanhOp = Just MO_F32_Tanh
500 callishOp FloatAsinOp = Just MO_F32_Asin
501 callishOp FloatAcosOp = Just MO_F32_Acos
502 callishOp FloatAtanOp = Just MO_F32_Atan
503 callishOp FloatLogOp = Just MO_F32_Log
504 callishOp FloatExpOp = Just MO_F32_Exp
505 callishOp FloatSqrtOp = Just MO_F32_Sqrt
507 callishOp _ = Nothing
509 ------------------------------------------------------------------------------
510 -- Helpers for translating various minor variants of array indexing.
512 doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
513 = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
514 doIndexOffAddrOp _ _ _ _
515 = panic "CgPrimOp: doIndexOffAddrOp"
517 doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
518 = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
519 doIndexByteArrayOp _ _ _ _
520 = panic "CgPrimOp: doIndexByteArrayOp"
522 doReadPtrArrayOp res addr idx
523 = mkBasicIndexedRead arrPtrsHdrSize Nothing wordRep res addr idx
526 doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
527 = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
528 doWriteOffAddrOp _ _ _ _
529 = panic "CgPrimOp: doWriteOffAddrOp"
531 doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
532 = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
533 doWriteByteArrayOp _ _ _ _
534 = panic "CgPrimOp: doWriteByteArrayOp"
536 doWritePtrArrayOp addr idx val
537 = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
538 mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
541 mkBasicIndexedRead off Nothing read_rep res base idx
542 = stmtC (CmmAssign res (cmmLoadIndexOffExpr off read_rep base idx))
543 mkBasicIndexedRead off (Just cast) read_rep res base idx
544 = stmtC (CmmAssign res (CmmMachOp cast [
545 cmmLoadIndexOffExpr off read_rep base idx]))
547 mkBasicIndexedWrite off Nothing write_rep base idx val
548 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
549 mkBasicIndexedWrite off (Just cast) write_rep base idx val
550 = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
552 -- ----------------------------------------------------------------------------
555 cmmIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
556 cmmIndexOffExpr off rep base idx
557 = cmmIndexExpr rep (cmmOffsetB base off) idx
559 cmmLoadIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
560 cmmLoadIndexOffExpr off rep base idx
561 = CmmLoad (cmmIndexOffExpr off rep base idx) rep
563 setInfo :: CmmExpr -> CmmExpr -> CmmStmt
564 setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr