2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 \section[AbsCUtils]{Help functions for Abstract~C datatype}
9 mkAbstractCs, mkAbsCStmts,
13 mixedTypeLocn, mixedPtrLocn,
16 -- printing/forcing stuff comes from PprAbsC
19 #include "HsVersions.h"
22 import CLabel ( mkMAP_FROZEN_infoLabel )
23 import Digraph ( stronglyConnComp, SCC(..) )
24 import DataCon ( fIRST_TAG, ConTag )
25 import Literal ( literalPrimRep, mkMachWord, mkMachInt )
26 import PrimRep ( getPrimRepSize, PrimRep(..) )
27 import PrimOp ( PrimOp(..) )
28 import MachOp ( MachOp(..), isDefinitelyInlineMachOp )
29 import Unique ( Unique{-instance Eq-} )
30 import UniqSupply ( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
32 import CmdLineOpts ( opt_EmitCExternDecls )
33 import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety(..),
34 isDynamicTarget, isCasmTarget, defaultCCallConv )
35 import StgSyn ( StgOp(..) )
36 import SMRep ( arrPtrsHdrSize, arrWordsHdrSize, fixedHdrSize )
37 import Constants ( wORD_SIZE )
38 import Maybes ( Maybe012(..) )
40 import Panic ( panic )
43 import Maybe ( isJust, maybeToList )
48 Check if there is any real code in some Abstract~C. If so, return it
49 (@Just ...@); otherwise, return @Nothing@. Don't be too strict!
51 It returns the "reduced" code in the Just part so that the work of
52 discarding AbsCNops isn't lost, and so that if the caller uses
53 the reduced version there's less danger of a big tree of AbsCNops getting
54 materialised and causing a space leak.
57 nonemptyAbsC :: AbstractC -> Maybe AbstractC
58 nonemptyAbsC AbsCNop = Nothing
59 nonemptyAbsC (AbsCStmts s1 s2) = case (nonemptyAbsC s1) of
60 Nothing -> nonemptyAbsC s2
61 Just x -> Just (AbsCStmts x s2)
62 nonemptyAbsC s@(CSimultaneous c) = case (nonemptyAbsC c) of
65 nonemptyAbsC other = Just other
69 mkAbstractCs :: [AbstractC] -> AbstractC
70 mkAbstractCs [] = AbsCNop
71 mkAbstractCs cs = foldr1 mkAbsCStmts cs
73 -- for fiddling around w/ killing off AbsCNops ... (ToDo)
74 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
75 mkAbsCStmts AbsCNop c = c
76 mkAbsCStmts c AbsCNop = c
77 mkAbsCStmts c1 c2 = c1 `AbsCStmts` c2
79 {- Discarded SLPJ June 95; it calls nonemptyAbsC too much!
80 = case (case (nonemptyAbsC abc2) of
82 Just d2 -> d2) of { abc2b ->
84 case (nonemptyAbsC abc1) of {
86 Just d1 -> AbsCStmts d1 abc2b
91 Get the sho' 'nuff statements out of an @AbstractC@.
93 mkAbsCStmtList :: AbstractC -> [AbstractC]
95 mkAbsCStmtList absC = mkAbsCStmtList' absC []
97 -- Optimised a la foldr/build!
99 mkAbsCStmtList' AbsCNop r = r
101 mkAbsCStmtList' (AbsCStmts s1 s2) r
102 = mkAbsCStmtList' s1 (mkAbsCStmtList' s2 r)
104 mkAbsCStmtList' s@(CSimultaneous c) r
105 = if null (mkAbsCStmtList c) then r else s : r
107 mkAbsCStmtList' other r = other : r
111 mkAlgAltsCSwitch :: CAddrMode -> [(ConTag, AbstractC)] -> AbstractC -> AbstractC
113 mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc
114 | isJust (nonemptyAbsC deflt_absc)
115 = CSwitch scrutinee (adjust tagged_alts) deflt_absc
117 = CSwitch scrutinee (adjust rest) first_alt
119 -- it's ok to convert one of the alts into a default if we don't already have
120 -- one, because this is an algebraic case and we're guaranteed that the tag
121 -- will match one of the branches.
122 ((_,first_alt):rest) = tagged_alts
124 -- Adjust the tags in the switch to start at zero.
125 -- This is the convention used by primitive ops which return algebraic
126 -- data types. Why? Because for two-constructor types, zero is faster
127 -- to create and distinguish from 1 than are 1 and 2.
129 -- We also need to convert to Literals to keep the CSwitch happy
131 = [ (mkMachWord (toInteger (tag - fIRST_TAG)), abs_c)
132 | (tag, abs_c) <- tagged_alts ]
135 %************************************************************************
137 \subsubsection[AbsCUtils-kinds-from-MagicIds]{Kinds from MagicIds}
139 %************************************************************************
142 magicIdPrimRep BaseReg = PtrRep
143 magicIdPrimRep (VanillaReg kind _) = kind
144 magicIdPrimRep (FloatReg _) = FloatRep
145 magicIdPrimRep (DoubleReg _) = DoubleRep
146 magicIdPrimRep (LongReg kind _) = kind
147 magicIdPrimRep Sp = PtrRep
148 magicIdPrimRep Su = PtrRep
149 magicIdPrimRep SpLim = PtrRep
150 magicIdPrimRep Hp = PtrRep
151 magicIdPrimRep HpLim = PtrRep
152 magicIdPrimRep CurCostCentre = CostCentreRep
153 magicIdPrimRep VoidReg = VoidRep
154 magicIdPrimRep CurrentTSO = ThreadIdRep
155 magicIdPrimRep CurrentNursery = PtrRep
158 %************************************************************************
160 \subsection[AbsCUtils-amode-kinds]{Finding @PrimitiveKinds@ of amodes}
162 %************************************************************************
164 See also the return conventions for unboxed things; currently living
165 in @CgCon@ (next to the constructor return conventions).
167 ToDo: tiny tweaking may be in order
169 getAmodeRep :: CAddrMode -> PrimRep
171 getAmodeRep (CVal _ kind) = kind
172 getAmodeRep (CAddr _) = PtrRep
173 getAmodeRep (CReg magic_id) = magicIdPrimRep magic_id
174 getAmodeRep (CTemp uniq kind) = kind
175 getAmodeRep (CLbl _ kind) = kind
176 getAmodeRep (CCharLike _) = PtrRep
177 getAmodeRep (CIntLike _) = PtrRep
178 getAmodeRep (CLit lit) = literalPrimRep lit
179 getAmodeRep (CMacroExpr kind _ _) = kind
180 getAmodeRep (CJoinPoint _) = panic "getAmodeRep:CJoinPoint"
181 getAmodeRep (CMem rep addr) = rep
184 @mixedTypeLocn@ tells whether an amode identifies an ``StgWord''
185 location; that is, one which can contain values of various types.
188 mixedTypeLocn :: CAddrMode -> Bool
190 mixedTypeLocn (CVal (NodeRel _) _) = True
191 mixedTypeLocn (CVal (SpRel _) _) = True
192 mixedTypeLocn (CVal (HpRel _) _) = True
193 mixedTypeLocn other = False -- All the rest
196 @mixedPtrLocn@ tells whether an amode identifies a
197 location which can contain values of various pointer types.
200 mixedPtrLocn :: CAddrMode -> Bool
202 mixedPtrLocn (CVal (SpRel _) _) = True
203 mixedPtrLocn other = False -- All the rest
206 %************************************************************************
208 \subsection[AbsCUtils-flattening]{Flatten Abstract~C}
210 %************************************************************************
212 The following bits take ``raw'' Abstract~C, which may have all sorts of
213 nesting, and flattens it into one long @AbsCStmtList@. Mainly,
214 @CClosureInfos@ and code for switches are pulled out to the top level.
216 The various functions herein tend to produce
219 A {\em flattened} \tr{<something>} of interest for ``here'', and
221 Some {\em unflattened} Abstract~C statements to be carried up to the
222 top-level. The only real reason (now) that it is unflattened is
223 because it means the recursive flattening can be done in just one
224 place rather than having to remember lots of places.
227 Care is taken to reduce the occurrence of forward references, while still
228 keeping laziness a much as possible. Essentially, this means that:
231 {\em All} the top-level C statements resulting from flattening a
232 particular AbsC statement (whether the latter is nested or not) appear
233 before {\em any} of the code for a subsequent AbsC statement;
235 but stuff nested within any AbsC statement comes
236 out before the code for the statement itself.
239 The ``stuff to be carried up'' always includes a label: a
240 @CStaticClosure@, @CRetDirect@, @CFlatRetVector@, or
241 @CCodeBlock@. The latter turns into a C function, and is never
242 actually produced by the code generator. Rather it always starts life
243 as a @CCodeBlock@ addressing mode; when such an addr mode is
244 flattened, the ``tops'' stuff is a @CCodeBlock@.
247 flattenAbsC :: UniqSupply -> AbstractC -> AbstractC
250 = case (initFlt us (flatAbsC abs_C)) of { (here, tops) ->
251 here `mkAbsCStmts` tops }
254 %************************************************************************
256 \subsubsection{Flattening monadery}
258 %************************************************************************
260 The flattener is monadised. It's just a @UniqueSupply@.
263 type FlatM result = UniqSupply -> result
265 initFlt :: UniqSupply -> FlatM a -> a
267 initFlt init_us m = m init_us
269 {-# INLINE thenFlt #-}
270 {-# INLINE returnFlt #-}
272 thenFlt :: FlatM a -> (a -> FlatM b) -> FlatM b
275 = case (splitUniqSupply us) of { (s1, s2) ->
276 case (expr s1) of { result ->
279 returnFlt :: a -> FlatM a
280 returnFlt result us = result
282 mapFlt :: (a -> FlatM b) -> [a] -> FlatM [b]
284 mapFlt f [] = returnFlt []
286 = f x `thenFlt` \ r ->
287 mapFlt f xs `thenFlt` \ rs ->
290 mapAndUnzipFlt :: (a -> FlatM (b,c)) -> [a] -> FlatM ([b],[c])
292 mapAndUnzipFlt f [] = returnFlt ([],[])
293 mapAndUnzipFlt f (x:xs)
294 = f x `thenFlt` \ (r1, r2) ->
295 mapAndUnzipFlt f xs `thenFlt` \ (rs1, rs2) ->
296 returnFlt (r1:rs1, r2:rs2)
298 getUniqFlt :: FlatM Unique
299 getUniqFlt us = uniqFromSupply us
301 getUniqsFlt :: FlatM [Unique]
302 getUniqsFlt us = uniqsFromSupply us
305 %************************************************************************
307 \subsubsection{Flattening the top level}
309 %************************************************************************
312 flatAbsC :: AbstractC
313 -> FlatM (AbstractC, -- Stuff to put inline [Both are fully
314 AbstractC) -- Stuff to put at top level flattened]
316 flatAbsC AbsCNop = returnFlt (AbsCNop, AbsCNop)
318 flatAbsC (AbsCStmts s1 s2)
319 = flatAbsC s1 `thenFlt` \ (inline_s1, top_s1) ->
320 flatAbsC s2 `thenFlt` \ (inline_s2, top_s2) ->
321 returnFlt (mkAbsCStmts inline_s1 inline_s2,
322 mkAbsCStmts top_s1 top_s2)
324 flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
325 = flatAbsC slow `thenFlt` \ (slow_heres, slow_tops) ->
326 flat_maybe maybe_fast `thenFlt` \ (fast_heres, fast_tops) ->
327 returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
328 CClosureInfoAndCode cl_info slow_heres fast_heres descr]
331 flatAbsC (CCodeBlock lbl abs_C)
332 = flatAbsC abs_C `thenFlt` \ (absC_heres, absC_tops) ->
333 returnFlt (AbsCNop, absC_tops `mkAbsCStmts` CCodeBlock lbl absC_heres)
335 flatAbsC (CRetDirect uniq slow_code srt liveness)
336 = flatAbsC slow_code `thenFlt` \ (heres, tops) ->
338 mkAbstractCs [ tops, CRetDirect uniq heres srt liveness ])
340 flatAbsC (CSwitch discrim alts deflt)
341 = mapAndUnzipFlt flat_alt alts `thenFlt` \ (flat_alts, flat_alts_tops) ->
342 flatAbsC deflt `thenFlt` \ (flat_def_alt, def_tops) ->
344 CSwitch discrim flat_alts flat_def_alt,
345 mkAbstractCs (def_tops : flat_alts_tops)
349 = flatAbsC absC `thenFlt` \ (alt_heres, alt_tops) ->
350 returnFlt ( (tag, alt_heres), alt_tops )
352 flatAbsC stmt@(COpStmt results (StgFCallOp (CCall ccall@(CCallSpec target _ _)) uniq) args _)
353 | is_dynamic -- Emit a typedef if its a dynamic call
354 || (opt_EmitCExternDecls && not (isCasmTarget target)) -- or we want extern decls
355 = returnFlt (stmt, CCallTypedef is_dynamic ccall uniq results args)
357 is_dynamic = isDynamicTarget target
359 flatAbsC stmt@(CSimultaneous abs_c)
360 = flatAbsC abs_c `thenFlt` \ (stmts_here, tops) ->
361 doSimultaneously stmts_here `thenFlt` \ new_stmts_here ->
362 returnFlt (new_stmts_here, tops)
364 flatAbsC stmt@(CCheck macro amodes code)
365 = flatAbsC code `thenFlt` \ (code_here, code_tops) ->
366 returnFlt (CCheck macro amodes code_here, code_tops)
368 -- the TICKY_CTR macro always needs to be hoisted out to the top level.
370 flatAbsC stmt@(CCallProfCtrMacro str amodes)
371 | str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
372 | otherwise = returnFlt (stmt, AbsCNop)
374 -- Some statements need no flattening at all:
375 flatAbsC stmt@(CMacroStmt macro amodes) = returnFlt (stmt, AbsCNop)
376 flatAbsC stmt@(CCallProfCCMacro str amodes) = returnFlt (stmt, AbsCNop)
377 flatAbsC stmt@(CAssign dest source) = returnFlt (stmt, AbsCNop)
378 flatAbsC stmt@(CJump target) = returnFlt (stmt, AbsCNop)
379 flatAbsC stmt@(CFallThrough target) = returnFlt (stmt, AbsCNop)
380 flatAbsC stmt@(CReturn target return_info) = returnFlt (stmt, AbsCNop)
381 flatAbsC stmt@(CInitHdr a b cc sz) = returnFlt (stmt, AbsCNop)
382 flatAbsC stmt@(CMachOpStmt res mop args m_vols) = returnFlt (stmt, AbsCNop)
383 flatAbsC stmt@(COpStmt results (StgFCallOp _ _) args vol_regs)
384 = returnFlt (stmt, AbsCNop)
385 flatAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs)
386 = dscCOpStmt (filter non_void_amode results) op
387 (filter non_void_amode args) vol_regs
390 COpStmt _ _ _ _ -> panic "flatAbsC - dscCOpStmt" -- make sure we don't loop!
391 other -> flatAbsC other
393 A gruesome hack for printing the names of inline primops when they
398 = getUniqFlt `thenFlt` \ uu ->
399 flatAbsC (CSequential [moo uu (showSDoc (ppr op)), xxx])
405 (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str)))
406 defaultCCallConv PlaySafe))
412 = " asm(\"pushal;\"); printf(\"%%s\\n\",\"" ++ op_str ++ "\"); asm(\"popal\"); "
415 flatAbsC (CSequential abcs)
416 = mapAndUnzipFlt flatAbsC abcs `thenFlt` \ (inlines, tops) ->
417 returnFlt (CSequential inlines, foldr AbsCStmts AbsCNop tops)
420 -- Some statements only make sense at the top level, so we always float
421 -- them. This probably isn't necessary.
422 flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
423 flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
424 flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
425 flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt)
426 flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt)
427 flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt)
428 flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt)
429 flatAbsC stmt@(CRetVector _ _ _ _) = returnFlt (AbsCNop, stmt)
430 flatAbsC stmt@(CModuleInitBlock _ _) = returnFlt (AbsCNop, stmt)
434 flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
435 flat_maybe Nothing = returnFlt (Nothing, AbsCNop)
436 flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) ->
437 returnFlt (Just heres, tops)
440 %************************************************************************
442 \subsection[flat-simultaneous]{Doing things simultaneously}
444 %************************************************************************
447 doSimultaneously :: AbstractC -> FlatM AbstractC
450 Generate code to perform the @CAssign@s and @COpStmt@s in the
451 input simultaneously, using temporary variables when necessary.
453 We use the strongly-connected component algorithm, in which
454 * the vertices are the statements
455 * an edge goes from s1 to s2 iff
456 s1 assigns to something s2 uses
457 that is, if s1 should *follow* s2 in the final order
460 type CVertex = (Int, AbstractC) -- Give each vertex a unique number,
461 -- for fast comparison
463 doSimultaneously abs_c
465 enlisted = en_list abs_c
467 case enlisted of -- it's often just one stmt
468 [] -> returnFlt AbsCNop
470 _ -> doSimultaneously1 (zip [(1::Int)..] enlisted)
472 -- en_list puts all the assignments in a list, filtering out Nops and
473 -- assignments which do nothing
475 en_list (AbsCStmts a1 a2) = en_list a1 ++ en_list a2
476 en_list (CAssign am1 am2) | sameAmode am1 am2 = []
477 en_list other = [other]
479 sameAmode :: CAddrMode -> CAddrMode -> Bool
480 -- ToDo: Move this function, or make CAddrMode an instance of Eq
481 -- At the moment we put in just enough to catch the cases we want:
482 -- the second (destination) argument is always a CVal.
483 sameAmode (CReg r1) (CReg r2) = r1 == r2
484 sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _) = r1 ==# r2
485 sameAmode other1 other2 = False
487 doSimultaneously1 :: [CVertex] -> FlatM AbstractC
488 doSimultaneously1 vertices
490 edges = [ (vertex, key1, edges_from stmt1)
491 | vertex@(key1, stmt1) <- vertices
493 edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,
494 stmt1 `should_follow` stmt2
496 components = stronglyConnComp edges
498 -- do_components deal with one strongly-connected component
499 -- Not cyclic, or singleton? Just do it
500 do_component (AcyclicSCC (n,abs_c)) = returnFlt abs_c
501 do_component (CyclicSCC [(n,abs_c)]) = returnFlt abs_c
503 -- Cyclic? Then go via temporaries. Pick one to
504 -- break the loop and try again with the rest.
505 do_component (CyclicSCC ((n,first_stmt) : rest))
506 = doSimultaneously1 rest `thenFlt` \ abs_cs ->
507 go_via_temps first_stmt `thenFlt` \ (to_temps, from_temps) ->
508 returnFlt (mkAbstractCs [to_temps, abs_cs, from_temps])
510 go_via_temps (CAssign dest src)
511 = getUniqFlt `thenFlt` \ uniq ->
513 the_temp = CTemp uniq (getAmodeRep dest)
515 returnFlt (CAssign the_temp src, CAssign dest the_temp)
517 go_via_temps (COpStmt dests op srcs vol_regs)
518 = getUniqsFlt `thenFlt` \ uniqs ->
520 the_temps = zipWith (\ u d -> CTemp u (getAmodeRep d)) uniqs dests
522 returnFlt (COpStmt the_temps op srcs vol_regs,
523 mkAbstractCs (zipWith CAssign dests the_temps))
525 mapFlt do_component components `thenFlt` \ abs_cs ->
526 returnFlt (mkAbstractCs abs_cs)
529 should_follow :: AbstractC -> AbstractC -> Bool
530 (CAssign dest1 _) `should_follow` (CAssign _ src2)
531 = dest1 `conflictsWith` src2
532 (COpStmt dests1 _ _ _) `should_follow` (CAssign _ src2)
533 = or [dest1 `conflictsWith` src2 | dest1 <- dests1]
534 (CAssign dest1 _)`should_follow` (COpStmt _ _ srcs2 _)
535 = or [dest1 `conflictsWith` src2 | src2 <- srcs2]
536 (COpStmt dests1 _ _ _) `should_follow` (COpStmt _ _ srcs2 _)
537 = or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
540 @conflictsWith@ tells whether an assignment to its first argument will
541 screw up an access to its second.
544 conflictsWith :: CAddrMode -> CAddrMode -> Bool
545 (CReg reg1) `conflictsWith` (CReg reg2) = reg1 == reg2
546 (CReg reg) `conflictsWith` (CVal reg_rel _) = reg `regConflictsWithRR` reg_rel
547 (CReg reg) `conflictsWith` (CAddr reg_rel) = reg `regConflictsWithRR` reg_rel
548 (CTemp u1 _) `conflictsWith` (CTemp u2 _) = u1 == u2
549 (CVal reg_rel1 k1) `conflictsWith` (CVal reg_rel2 k2)
550 = rrConflictsWithRR (getPrimRepSize k1) (getPrimRepSize k2) reg_rel1 reg_rel2
552 other1 `conflictsWith` other2 = False
553 -- CAddr and literals are impossible on the LHS of an assignment
555 regConflictsWithRR :: MagicId -> RegRelative -> Bool
557 regConflictsWithRR (VanillaReg k n) (NodeRel _) | n ==# (_ILIT 1) = True
558 regConflictsWithRR Sp (SpRel _) = True
559 regConflictsWithRR Hp (HpRel _) = True
560 regConflictsWithRR _ _ = False
562 rrConflictsWithRR :: Int -> Int -- Sizes of two things
563 -> RegRelative -> RegRelative -- The two amodes
566 rrConflictsWithRR s1b s2b rr1 rr2 = rr rr1 rr2
571 rr (SpRel o1) (SpRel o2)
572 | s1 ==# (_ILIT 0) || s2 ==# (_ILIT 0) = False -- No conflict if either is size zero
573 | s1 ==# (_ILIT 1) && s2 ==# (_ILIT 1) = o1 ==# o2
574 | otherwise = (o1 +# s1) >=# o2 &&
577 rr (NodeRel o1) (NodeRel o2)
578 | s1 ==# (_ILIT 0) || s2 ==# (_ILIT 0) = False -- No conflict if either is size zero
579 | s1 ==# (_ILIT 1) && s2 ==# (_ILIT 1) = o1 ==# o2
580 | otherwise = True -- Give up
582 rr (HpRel _) (HpRel _) = True -- Give up (ToDo)
584 rr other1 other2 = False
587 %************************************************************************
589 \subsection[flat-primops]{Translating COpStmts to CMachOpStmts}
591 %************************************************************************
596 ------------------------------------------------------------------------------
598 -- Assumes no volatiles
599 mkHalfWord_HIADDR res arg
601 = CMachOpStmt (Just1 res) MO_Nat_And [arg, CLit (mkMachWord halfword_mask)] Nothing
603 = CMachOpStmt (Just1 res) MO_Nat_Shr [arg, CLit (mkMachWord halfword_shift)] Nothing
606 (halfword_mask, halfword_shift)
607 | wORD_SIZE == 4 = (65535, 16)
608 | wORD_SIZE == 8 = (4294967295::Integer, 32)
611 mkTemp :: PrimRep -> FlatM CAddrMode
613 = getUniqFlt `thenFlt` \ uniq -> returnFlt (CTemp uniq rep)
615 mkTemps = mapFlt mkTemp
617 mkDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
618 mkDerefOff rep base off
619 | off == 0 -- optimisation
622 = CMem rep (CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep))
624 mkNoDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
625 mkNoDerefOff rep base off
626 = CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep)
628 -- Sigh. This is done in 3 seperate places. Should be
629 -- commoned up (here, in pprAbsC of COpStmt, and presumably
630 -- somewhere in the NCG).
632 = case getAmodeRep amode of
636 doIndexOffForeignObjOp rep res addr idx
637 = Just (Just1 res, MO_ReadOSBI fixedHdrSize rep, [addr,idx])
639 doIndexOffAddrOp rep res addr idx
640 = Just (Just1 res, MO_ReadOSBI 0 rep, [addr,idx])
642 doIndexByteArrayOp rep res addr idx
643 = Just (Just1 res, MO_ReadOSBI arrWordsHdrSize rep, [addr,idx])
645 doWriteOffAddrOp rep addr idx val
646 = Just (Just0, MO_WriteOSBI 0 rep, [addr,idx,val])
648 doWriteByteArrayOp rep addr idx val
649 = Just (Just0, MO_WriteOSBI arrWordsHdrSize rep, [addr,idx,val])
651 -- Simple dyadic op but one for which we need to cast first arg to
652 -- be sure of correctness
653 translateOp_dyadic_cast1 mop res cast_arg1_to arg1 arg2 vols
654 = mkTemp cast_arg1_to `thenFlt` \ arg1casted ->
655 (returnFlt . CSequential) [
656 CAssign arg1casted arg1,
657 CMachOpStmt (Just1 res) mop [arg1casted,arg2]
658 (if isDefinitelyInlineMachOp mop then Nothing else Just vols)
661 ------------------------------------------------------------------------------
663 dscCOpStmt :: [CAddrMode] -- Results
665 -> [CAddrMode] -- Arguments
666 -> [MagicId] -- Potentially volatile/live registers
667 -- (to save/restore around the op)
670 -- #define parzh(r,node) r = 1
671 dscCOpStmt [res] ParOp [arg] vols
673 (CAssign res (CLit (mkMachInt 1)))
675 -- #define readMutVarzh(r,a) r=(P_)(((StgMutVar *)(a))->var)
676 dscCOpStmt [res] ReadMutVarOp [mutv] vols
678 (CAssign res (mkDerefOff PtrRep mutv fixedHdrSize))
680 -- #define writeMutVarzh(a,v) (P_)(((StgMutVar *)(a))->var)=(v)
681 dscCOpStmt [] WriteMutVarOp [mutv,var] vols
683 (CAssign (mkDerefOff PtrRep mutv fixedHdrSize) var)
686 -- #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
687 -- #define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo)
688 dscCOpStmt [res] ForeignObjToAddrOp [fo] vols
690 (CAssign res (mkDerefOff PtrRep fo fixedHdrSize))
692 -- #define writeForeignObjzh(res,datum) \
693 -- (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
694 dscCOpStmt [] WriteForeignObjOp [fo,addr] vols
696 (CAssign (mkDerefOff PtrRep fo fixedHdrSize) addr)
699 -- #define sizzeofByteArrayzh(r,a) \
700 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
701 dscCOpStmt [res] SizeofByteArrayOp [arg] vols
702 = mkTemp WordRep `thenFlt` \ w ->
703 (returnFlt . CSequential) [
704 CAssign w (mkDerefOff WordRep arg fixedHdrSize),
705 CMachOpStmt (Just1 w)
706 MO_NatU_Mul [w, CLit (mkMachInt (toInteger wORD_SIZE))] (Just vols),
710 -- #define sizzeofMutableByteArrayzh(r,a) \
711 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
712 dscCOpStmt [res] SizeofMutableByteArrayOp [arg] vols
713 = dscCOpStmt [res] SizeofByteArrayOp [arg] vols
716 -- #define touchzh(o) /* nothing */
717 dscCOpStmt [] TouchOp [arg] vols
720 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
721 dscCOpStmt [res] ByteArrayContents_Char [arg] vols
722 = mkTemp PtrRep `thenFlt` \ ptr ->
723 (returnFlt . CSequential) [
724 CMachOpStmt (Just1 ptr) MO_NatU_to_NatP [arg] Nothing,
725 CAssign ptr (mkNoDerefOff WordRep ptr arrWordsHdrSize),
729 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
730 dscCOpStmt [res] StableNameToIntOp [arg] vols
732 (CAssign res (mkDerefOff WordRep arg fixedHdrSize))
734 -- #define eqStableNamezh(r,sn1,sn2) \
735 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
736 dscCOpStmt [res] EqStableNameOp [arg1,arg2] vols
737 = mkTemps [WordRep, WordRep] `thenFlt` \ [sn1,sn2] ->
738 (returnFlt . CSequential) [
739 CAssign sn1 (mkDerefOff WordRep arg1 fixedHdrSize),
740 CAssign sn2 (mkDerefOff WordRep arg2 fixedHdrSize),
741 CMachOpStmt (Just1 res) MO_Nat_Eq [sn1,sn2] Nothing
744 -- #define addrToHValuezh(r,a) r=(P_)a
745 dscCOpStmt [res] AddrToHValueOp [arg] vols
749 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
750 dscCOpStmt [res] DataToTagOp [arg] vols
751 = mkTemps [PtrRep, WordRep] `thenFlt` \ [t_infoptr, t_theword] ->
752 (returnFlt . CSequential) [
753 CAssign t_infoptr (mkDerefOff PtrRep arg 0),
754 CAssign t_theword (mkDerefOff WordRep t_infoptr (-1)),
755 mkHalfWord_HIADDR res t_theword
759 {- Freezing arrays-of-ptrs requires changing an info table, for the
760 benefit of the generational collector. It needs to scavenge mutable
761 objects, even if they are in old space. When they become immutable,
762 they can be removed from this scavenge list. -}
764 -- #define unsafeFreezzeArrayzh(r,a) \
766 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_info); \
769 dscCOpStmt [res] UnsafeFreezeArrayOp [arg] vols
770 = (returnFlt . CSequential) [
771 CAssign (mkDerefOff PtrRep arg 0) (CLbl mkMAP_FROZEN_infoLabel PtrRep),
775 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
776 dscCOpStmt [res] UnsafeFreezeByteArrayOp [arg] vols
780 -- This ought to be trivial, but it's difficult to insert the casts
781 -- required to keep the C compiler happy.
782 dscCOpStmt [r] AddrRemOp [a1,a2] vols
783 = mkTemp WordRep `thenFlt` \ a1casted ->
784 (returnFlt . CSequential) [
785 CMachOpStmt (Just1 a1casted) MO_NatP_to_NatU [a1] Nothing,
786 CMachOpStmt (Just1 r) MO_NatU_Rem [a1casted,a2] Nothing
789 -- not handled by translateOp because they need casts
790 dscCOpStmt [r] SllOp [a1,a2] vols
791 = translateOp_dyadic_cast1 MO_Nat_Shl r WordRep a1 a2 vols
792 dscCOpStmt [r] SrlOp [a1,a2] vols
793 = translateOp_dyadic_cast1 MO_Nat_Shr r WordRep a1 a2 vols
795 dscCOpStmt [r] ISllOp [a1,a2] vols
796 = translateOp_dyadic_cast1 MO_Nat_Shl r IntRep a1 a2 vols
797 dscCOpStmt [r] ISrlOp [a1,a2] vols
798 = translateOp_dyadic_cast1 MO_Nat_Shr r IntRep a1 a2 vols
799 dscCOpStmt [r] ISraOp [a1,a2] vols
800 = translateOp_dyadic_cast1 MO_Nat_Sar r IntRep a1 a2 vols
803 -- Handle all others as simply as possible.
804 dscCOpStmt ress op args vols
805 = case translateOp ress op args of
807 -> pprPanic "dscCOpStmt: can't translate PrimOp" (ppr op)
808 Just (maybe_res, mop, args)
810 CMachOpStmt maybe_res mop args
811 (if isDefinitelyInlineMachOp mop then Nothing else Just vols)
816 translateOp [r] ReadArrayOp [obj,ix]
817 = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix])
818 translateOp [r] IndexArrayOp [obj,ix]
819 = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix])
820 translateOp [] WriteArrayOp [obj,ix,v]
821 = Just (Just0, MO_WriteOSBI arrPtrsHdrSize PtrRep, [obj,ix,v])
823 -- IndexXXXoffForeignObj
825 translateOp [r] IndexOffForeignObjOp_Char [a,i] = doIndexOffForeignObjOp Word8Rep r a i
826 translateOp [r] IndexOffForeignObjOp_WideChar [a,i] = doIndexOffForeignObjOp Word32Rep r a i
827 translateOp [r] IndexOffForeignObjOp_Int [a,i] = doIndexOffForeignObjOp IntRep r a i
828 translateOp [r] IndexOffForeignObjOp_Word [a,i] = doIndexOffForeignObjOp WordRep r a i
829 translateOp [r] IndexOffForeignObjOp_Addr [a,i] = doIndexOffForeignObjOp AddrRep r a i
830 translateOp [r] IndexOffForeignObjOp_Float [a,i] = doIndexOffForeignObjOp FloatRep r a i
831 translateOp [r] IndexOffForeignObjOp_Double [a,i] = doIndexOffForeignObjOp DoubleRep r a i
832 translateOp [r] IndexOffForeignObjOp_StablePtr [a,i] = doIndexOffForeignObjOp StablePtrRep r a i
834 translateOp [r] IndexOffForeignObjOp_Int8 [a,i] = doIndexOffForeignObjOp Int8Rep r a i
835 translateOp [r] IndexOffForeignObjOp_Int16 [a,i] = doIndexOffForeignObjOp Int16Rep r a i
836 translateOp [r] IndexOffForeignObjOp_Int32 [a,i] = doIndexOffForeignObjOp Int32Rep r a i
837 translateOp [r] IndexOffForeignObjOp_Int64 [a,i] = doIndexOffForeignObjOp Int64Rep r a i
839 translateOp [r] IndexOffForeignObjOp_Word8 [a,i] = doIndexOffForeignObjOp Word8Rep r a i
840 translateOp [r] IndexOffForeignObjOp_Word16 [a,i] = doIndexOffForeignObjOp Word16Rep r a i
841 translateOp [r] IndexOffForeignObjOp_Word32 [a,i] = doIndexOffForeignObjOp Word32Rep r a i
842 translateOp [r] IndexOffForeignObjOp_Word64 [a,i] = doIndexOffForeignObjOp Word64Rep r a i
846 translateOp [r] IndexOffAddrOp_Char [a,i] = doIndexOffAddrOp Word8Rep r a i
847 translateOp [r] IndexOffAddrOp_WideChar [a,i] = doIndexOffAddrOp Word32Rep r a i
848 translateOp [r] IndexOffAddrOp_Int [a,i] = doIndexOffAddrOp IntRep r a i
849 translateOp [r] IndexOffAddrOp_Word [a,i] = doIndexOffAddrOp WordRep r a i
850 translateOp [r] IndexOffAddrOp_Addr [a,i] = doIndexOffAddrOp AddrRep r a i
851 translateOp [r] IndexOffAddrOp_Float [a,i] = doIndexOffAddrOp FloatRep r a i
852 translateOp [r] IndexOffAddrOp_Double [a,i] = doIndexOffAddrOp DoubleRep r a i
853 translateOp [r] IndexOffAddrOp_StablePtr [a,i] = doIndexOffAddrOp StablePtrRep r a i
855 translateOp [r] IndexOffAddrOp_Int8 [a,i] = doIndexOffAddrOp Int8Rep r a i
856 translateOp [r] IndexOffAddrOp_Int16 [a,i] = doIndexOffAddrOp Int16Rep r a i
857 translateOp [r] IndexOffAddrOp_Int32 [a,i] = doIndexOffAddrOp Int32Rep r a i
858 translateOp [r] IndexOffAddrOp_Int64 [a,i] = doIndexOffAddrOp Int64Rep r a i
860 translateOp [r] IndexOffAddrOp_Word8 [a,i] = doIndexOffAddrOp Word8Rep r a i
861 translateOp [r] IndexOffAddrOp_Word16 [a,i] = doIndexOffAddrOp Word16Rep r a i
862 translateOp [r] IndexOffAddrOp_Word32 [a,i] = doIndexOffAddrOp Word32Rep r a i
863 translateOp [r] IndexOffAddrOp_Word64 [a,i] = doIndexOffAddrOp Word64Rep r a i
865 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
867 translateOp [r] ReadOffAddrOp_Char [a,i] = doIndexOffAddrOp Word8Rep r a i
868 translateOp [r] ReadOffAddrOp_WideChar [a,i] = doIndexOffAddrOp Word32Rep r a i
869 translateOp [r] ReadOffAddrOp_Int [a,i] = doIndexOffAddrOp IntRep r a i
870 translateOp [r] ReadOffAddrOp_Word [a,i] = doIndexOffAddrOp WordRep r a i
871 translateOp [r] ReadOffAddrOp_Addr [a,i] = doIndexOffAddrOp AddrRep r a i
872 translateOp [r] ReadOffAddrOp_Float [a,i] = doIndexOffAddrOp FloatRep r a i
873 translateOp [r] ReadOffAddrOp_Double [a,i] = doIndexOffAddrOp DoubleRep r a i
874 translateOp [r] ReadOffAddrOp_StablePtr [a,i] = doIndexOffAddrOp StablePtrRep r a i
876 translateOp [r] ReadOffAddrOp_Int8 [a,i] = doIndexOffAddrOp Int8Rep r a i
877 translateOp [r] ReadOffAddrOp_Int16 [a,i] = doIndexOffAddrOp Int16Rep r a i
878 translateOp [r] ReadOffAddrOp_Int32 [a,i] = doIndexOffAddrOp Int32Rep r a i
879 translateOp [r] ReadOffAddrOp_Int64 [a,i] = doIndexOffAddrOp Int64Rep r a i
881 translateOp [r] ReadOffAddrOp_Word8 [a,i] = doIndexOffAddrOp Word8Rep r a i
882 translateOp [r] ReadOffAddrOp_Word16 [a,i] = doIndexOffAddrOp Word16Rep r a i
883 translateOp [r] ReadOffAddrOp_Word32 [a,i] = doIndexOffAddrOp Word32Rep r a i
884 translateOp [r] ReadOffAddrOp_Word64 [a,i] = doIndexOffAddrOp Word64Rep r a i
888 translateOp [] WriteOffAddrOp_Char [a,i,x] = doWriteOffAddrOp Word8Rep a i x
889 translateOp [] WriteOffAddrOp_WideChar [a,i,x] = doWriteOffAddrOp Word32Rep a i x
890 translateOp [] WriteOffAddrOp_Int [a,i,x] = doWriteOffAddrOp IntRep a i x
891 translateOp [] WriteOffAddrOp_Word [a,i,x] = doWriteOffAddrOp WordRep a i x
892 translateOp [] WriteOffAddrOp_Addr [a,i,x] = doWriteOffAddrOp AddrRep a i x
893 translateOp [] WriteOffAddrOp_Float [a,i,x] = doWriteOffAddrOp FloatRep a i x
894 translateOp [] WriteOffAddrOp_ForeignObj [a,i,x] = doWriteOffAddrOp ForeignObjRep a i x
895 translateOp [] WriteOffAddrOp_Double [a,i,x] = doWriteOffAddrOp DoubleRep a i x
896 translateOp [] WriteOffAddrOp_StablePtr [a,i,x] = doWriteOffAddrOp StablePtrRep a i x
898 translateOp [] WriteOffAddrOp_Int8 [a,i,x] = doWriteOffAddrOp Int8Rep a i x
899 translateOp [] WriteOffAddrOp_Int16 [a,i,x] = doWriteOffAddrOp Int16Rep a i x
900 translateOp [] WriteOffAddrOp_Int32 [a,i,x] = doWriteOffAddrOp Int32Rep a i x
901 translateOp [] WriteOffAddrOp_Int64 [a,i,x] = doWriteOffAddrOp Int64Rep a i x
903 translateOp [] WriteOffAddrOp_Word8 [a,i,x] = doWriteOffAddrOp Word8Rep a i x
904 translateOp [] WriteOffAddrOp_Word16 [a,i,x] = doWriteOffAddrOp Word16Rep a i x
905 translateOp [] WriteOffAddrOp_Word32 [a,i,x] = doWriteOffAddrOp Word32Rep a i x
906 translateOp [] WriteOffAddrOp_Word64 [a,i,x] = doWriteOffAddrOp Word64Rep a i x
910 translateOp [r] IndexByteArrayOp_Char [a,i] = doIndexByteArrayOp Word8Rep r a i
911 translateOp [r] IndexByteArrayOp_WideChar [a,i] = doIndexByteArrayOp Word32Rep r a i
912 translateOp [r] IndexByteArrayOp_Int [a,i] = doIndexByteArrayOp IntRep r a i
913 translateOp [r] IndexByteArrayOp_Word [a,i] = doIndexByteArrayOp WordRep r a i
914 translateOp [r] IndexByteArrayOp_Addr [a,i] = doIndexByteArrayOp AddrRep r a i
915 translateOp [r] IndexByteArrayOp_Float [a,i] = doIndexByteArrayOp FloatRep r a i
916 translateOp [r] IndexByteArrayOp_Double [a,i] = doIndexByteArrayOp DoubleRep r a i
917 translateOp [r] IndexByteArrayOp_StablePtr [a,i] = doIndexByteArrayOp StablePtrRep r a i
919 translateOp [r] IndexByteArrayOp_Int8 [a,i] = doIndexByteArrayOp Int8Rep r a i
920 translateOp [r] IndexByteArrayOp_Int16 [a,i] = doIndexByteArrayOp Int16Rep r a i
921 translateOp [r] IndexByteArrayOp_Int32 [a,i] = doIndexByteArrayOp Int32Rep r a i
922 translateOp [r] IndexByteArrayOp_Int64 [a,i] = doIndexByteArrayOp Int64Rep r a i
924 translateOp [r] IndexByteArrayOp_Word8 [a,i] = doIndexByteArrayOp Word8Rep r a i
925 translateOp [r] IndexByteArrayOp_Word16 [a,i] = doIndexByteArrayOp Word16Rep r a i
926 translateOp [r] IndexByteArrayOp_Word32 [a,i] = doIndexByteArrayOp Word32Rep r a i
927 translateOp [r] IndexByteArrayOp_Word64 [a,i] = doIndexByteArrayOp Word64Rep r a i
929 -- ReadXXXArray, identical to IndexXXXArray.
931 translateOp [r] ReadByteArrayOp_Char [a,i] = doIndexByteArrayOp Word8Rep r a i
932 translateOp [r] ReadByteArrayOp_WideChar [a,i] = doIndexByteArrayOp Word32Rep r a i
933 translateOp [r] ReadByteArrayOp_Int [a,i] = doIndexByteArrayOp IntRep r a i
934 translateOp [r] ReadByteArrayOp_Word [a,i] = doIndexByteArrayOp WordRep r a i
935 translateOp [r] ReadByteArrayOp_Addr [a,i] = doIndexByteArrayOp AddrRep r a i
936 translateOp [r] ReadByteArrayOp_Float [a,i] = doIndexByteArrayOp FloatRep r a i
937 translateOp [r] ReadByteArrayOp_Double [a,i] = doIndexByteArrayOp DoubleRep r a i
938 translateOp [r] ReadByteArrayOp_StablePtr [a,i] = doIndexByteArrayOp StablePtrRep r a i
940 translateOp [r] ReadByteArrayOp_Int8 [a,i] = doIndexByteArrayOp Int8Rep r a i
941 translateOp [r] ReadByteArrayOp_Int16 [a,i] = doIndexByteArrayOp Int16Rep r a i
942 translateOp [r] ReadByteArrayOp_Int32 [a,i] = doIndexByteArrayOp Int32Rep r a i
943 translateOp [r] ReadByteArrayOp_Int64 [a,i] = doIndexByteArrayOp Int64Rep r a i
945 translateOp [r] ReadByteArrayOp_Word8 [a,i] = doIndexByteArrayOp Word8Rep r a i
946 translateOp [r] ReadByteArrayOp_Word16 [a,i] = doIndexByteArrayOp Word16Rep r a i
947 translateOp [r] ReadByteArrayOp_Word32 [a,i] = doIndexByteArrayOp Word32Rep r a i
948 translateOp [r] ReadByteArrayOp_Word64 [a,i] = doIndexByteArrayOp Word64Rep r a i
952 translateOp [] WriteByteArrayOp_Char [a,i,x] = doWriteByteArrayOp Word8Rep a i x
953 translateOp [] WriteByteArrayOp_WideChar [a,i,x] = doWriteByteArrayOp Word32Rep a i x
954 translateOp [] WriteByteArrayOp_Int [a,i,x] = doWriteByteArrayOp IntRep a i x
955 translateOp [] WriteByteArrayOp_Word [a,i,x] = doWriteByteArrayOp WordRep a i x
956 translateOp [] WriteByteArrayOp_Addr [a,i,x] = doWriteByteArrayOp AddrRep a i x
957 translateOp [] WriteByteArrayOp_Float [a,i,x] = doWriteByteArrayOp FloatRep a i x
958 translateOp [] WriteByteArrayOp_Double [a,i,x] = doWriteByteArrayOp DoubleRep a i x
959 translateOp [] WriteByteArrayOp_StablePtr [a,i,x] = doWriteByteArrayOp StablePtrRep a i x
961 translateOp [] WriteByteArrayOp_Int8 [a,i,x] = doWriteByteArrayOp Int8Rep a i x
962 translateOp [] WriteByteArrayOp_Int16 [a,i,x] = doWriteByteArrayOp Int16Rep a i x
963 translateOp [] WriteByteArrayOp_Int32 [a,i,x] = doWriteByteArrayOp Int32Rep a i x
964 translateOp [] WriteByteArrayOp_Int64 [a,i,x] = doWriteByteArrayOp Int64Rep a i x
966 translateOp [] WriteByteArrayOp_Word8 [a,i,x] = doWriteByteArrayOp Word8Rep a i x
967 translateOp [] WriteByteArrayOp_Word16 [a,i,x] = doWriteByteArrayOp Word16Rep a i x
968 translateOp [] WriteByteArrayOp_Word32 [a,i,x] = doWriteByteArrayOp Word32Rep a i x
969 translateOp [] WriteByteArrayOp_Word64 [a,i,x] = doWriteByteArrayOp Word64Rep a i x
971 -- Native word signless ops
973 translateOp [r] IntAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2])
974 translateOp [r] IntSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2])
975 translateOp [r] WordAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2])
976 translateOp [r] WordSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2])
977 translateOp [r] AddrAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2])
978 translateOp [r] AddrSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2])
980 translateOp [r] IntEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
981 translateOp [r] IntNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2])
982 translateOp [r] WordEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
983 translateOp [r] WordNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2])
984 translateOp [r] AddrEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
985 translateOp [r] AddrNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2])
987 translateOp [r] AndOp [a1,a2] = Just (Just1 r, MO_Nat_And, [a1,a2])
988 translateOp [r] OrOp [a1,a2] = Just (Just1 r, MO_Nat_Or, [a1,a2])
989 translateOp [r] XorOp [a1,a2] = Just (Just1 r, MO_Nat_Xor, [a1,a2])
990 translateOp [r] NotOp [a1] = Just (Just1 r, MO_Nat_Not, [a1])
992 -- Native word signed ops
994 translateOp [r] IntMulOp [a1,a2] = Just (Just1 r, MO_NatS_Mul, [a1,a2])
995 translateOp [r] IntQuotOp [a1,a2] = Just (Just1 r, MO_NatS_Quot, [a1,a2])
996 translateOp [r] IntRemOp [a1,a2] = Just (Just1 r, MO_NatS_Rem, [a1,a2])
997 translateOp [r] IntNegOp [a1] = Just (Just1 r, MO_NatS_Neg, [a1])
999 translateOp [r,c] IntAddCOp [a1,a2] = Just (Just2 r c, MO_NatS_AddC, [a1,a2])
1000 translateOp [r,c] IntSubCOp [a1,a2] = Just (Just2 r c, MO_NatS_SubC, [a1,a2])
1001 translateOp [r,c] IntMulCOp [a1,a2] = Just (Just2 r c, MO_NatS_MulC, [a1,a2])
1003 translateOp [r] IntGeOp [a1,a2] = Just (Just1 r, MO_NatS_Ge, [a1,a2])
1004 translateOp [r] IntLeOp [a1,a2] = Just (Just1 r, MO_NatS_Le, [a1,a2])
1005 translateOp [r] IntGtOp [a1,a2] = Just (Just1 r, MO_NatS_Gt, [a1,a2])
1006 translateOp [r] IntLtOp [a1,a2] = Just (Just1 r, MO_NatS_Lt, [a1,a2])
1008 -- Native word unsigned ops
1010 translateOp [r] WordGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2])
1011 translateOp [r] WordLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2])
1012 translateOp [r] WordGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2])
1013 translateOp [r] WordLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2])
1015 translateOp [r] WordMulOp [a1,a2] = Just (Just1 r, MO_NatU_Mul, [a1,a2])
1016 translateOp [r] WordQuotOp [a1,a2] = Just (Just1 r, MO_NatU_Quot, [a1,a2])
1017 translateOp [r] WordRemOp [a1,a2] = Just (Just1 r, MO_NatU_Rem, [a1,a2])
1019 translateOp [r] AddrGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2])
1020 translateOp [r] AddrLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2])
1021 translateOp [r] AddrGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2])
1022 translateOp [r] AddrLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2])
1024 -- 32-bit unsigned ops
1026 translateOp [r] CharEqOp [a1,a2] = Just (Just1 r, MO_32U_Eq, [a1,a2])
1027 translateOp [r] CharNeOp [a1,a2] = Just (Just1 r, MO_32U_Ne, [a1,a2])
1028 translateOp [r] CharGeOp [a1,a2] = Just (Just1 r, MO_32U_Ge, [a1,a2])
1029 translateOp [r] CharLeOp [a1,a2] = Just (Just1 r, MO_32U_Le, [a1,a2])
1030 translateOp [r] CharGtOp [a1,a2] = Just (Just1 r, MO_32U_Gt, [a1,a2])
1031 translateOp [r] CharLtOp [a1,a2] = Just (Just1 r, MO_32U_Lt, [a1,a2])
1035 translateOp [r] DoubleEqOp [a1,a2] = Just (Just1 r, MO_Dbl_Eq, [a1,a2])
1036 translateOp [r] DoubleNeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ne, [a1,a2])
1037 translateOp [r] DoubleGeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ge, [a1,a2])
1038 translateOp [r] DoubleLeOp [a1,a2] = Just (Just1 r, MO_Dbl_Le, [a1,a2])
1039 translateOp [r] DoubleGtOp [a1,a2] = Just (Just1 r, MO_Dbl_Gt, [a1,a2])
1040 translateOp [r] DoubleLtOp [a1,a2] = Just (Just1 r, MO_Dbl_Lt, [a1,a2])
1042 translateOp [r] DoubleAddOp [a1,a2] = Just (Just1 r, MO_Dbl_Add, [a1,a2])
1043 translateOp [r] DoubleSubOp [a1,a2] = Just (Just1 r, MO_Dbl_Sub, [a1,a2])
1044 translateOp [r] DoubleMulOp [a1,a2] = Just (Just1 r, MO_Dbl_Mul, [a1,a2])
1045 translateOp [r] DoubleDivOp [a1,a2] = Just (Just1 r, MO_Dbl_Div, [a1,a2])
1046 translateOp [r] DoublePowerOp [a1,a2] = Just (Just1 r, MO_Dbl_Pwr, [a1,a2])
1048 translateOp [r] DoubleSinOp [a1] = Just (Just1 r, MO_Dbl_Sin, [a1])
1049 translateOp [r] DoubleCosOp [a1] = Just (Just1 r, MO_Dbl_Cos, [a1])
1050 translateOp [r] DoubleTanOp [a1] = Just (Just1 r, MO_Dbl_Tan, [a1])
1051 translateOp [r] DoubleSinhOp [a1] = Just (Just1 r, MO_Dbl_Sinh, [a1])
1052 translateOp [r] DoubleCoshOp [a1] = Just (Just1 r, MO_Dbl_Cosh, [a1])
1053 translateOp [r] DoubleTanhOp [a1] = Just (Just1 r, MO_Dbl_Tanh, [a1])
1054 translateOp [r] DoubleAsinOp [a1] = Just (Just1 r, MO_Dbl_Asin, [a1])
1055 translateOp [r] DoubleAcosOp [a1] = Just (Just1 r, MO_Dbl_Acos, [a1])
1056 translateOp [r] DoubleAtanOp [a1] = Just (Just1 r, MO_Dbl_Atan, [a1])
1057 translateOp [r] DoubleLogOp [a1] = Just (Just1 r, MO_Dbl_Log, [a1])
1058 translateOp [r] DoubleExpOp [a1] = Just (Just1 r, MO_Dbl_Exp, [a1])
1059 translateOp [r] DoubleSqrtOp [a1] = Just (Just1 r, MO_Dbl_Sqrt, [a1])
1060 translateOp [r] DoubleNegOp [a1] = Just (Just1 r, MO_Dbl_Neg, [a1])
1064 translateOp [r] FloatEqOp [a1,a2] = Just (Just1 r, MO_Flt_Eq, [a1,a2])
1065 translateOp [r] FloatNeOp [a1,a2] = Just (Just1 r, MO_Flt_Ne, [a1,a2])
1066 translateOp [r] FloatGeOp [a1,a2] = Just (Just1 r, MO_Flt_Ge, [a1,a2])
1067 translateOp [r] FloatLeOp [a1,a2] = Just (Just1 r, MO_Flt_Le, [a1,a2])
1068 translateOp [r] FloatGtOp [a1,a2] = Just (Just1 r, MO_Flt_Gt, [a1,a2])
1069 translateOp [r] FloatLtOp [a1,a2] = Just (Just1 r, MO_Flt_Lt, [a1,a2])
1071 translateOp [r] FloatAddOp [a1,a2] = Just (Just1 r, MO_Flt_Add, [a1,a2])
1072 translateOp [r] FloatSubOp [a1,a2] = Just (Just1 r, MO_Flt_Sub, [a1,a2])
1073 translateOp [r] FloatMulOp [a1,a2] = Just (Just1 r, MO_Flt_Mul, [a1,a2])
1074 translateOp [r] FloatDivOp [a1,a2] = Just (Just1 r, MO_Flt_Div, [a1,a2])
1075 translateOp [r] FloatPowerOp [a1,a2] = Just (Just1 r, MO_Flt_Pwr, [a1,a2])
1077 translateOp [r] FloatSinOp [a1] = Just (Just1 r, MO_Flt_Sin, [a1])
1078 translateOp [r] FloatCosOp [a1] = Just (Just1 r, MO_Flt_Cos, [a1])
1079 translateOp [r] FloatTanOp [a1] = Just (Just1 r, MO_Flt_Tan, [a1])
1080 translateOp [r] FloatSinhOp [a1] = Just (Just1 r, MO_Flt_Sinh, [a1])
1081 translateOp [r] FloatCoshOp [a1] = Just (Just1 r, MO_Flt_Cosh, [a1])
1082 translateOp [r] FloatTanhOp [a1] = Just (Just1 r, MO_Flt_Tanh, [a1])
1083 translateOp [r] FloatAsinOp [a1] = Just (Just1 r, MO_Flt_Asin, [a1])
1084 translateOp [r] FloatAcosOp [a1] = Just (Just1 r, MO_Flt_Acos, [a1])
1085 translateOp [r] FloatAtanOp [a1] = Just (Just1 r, MO_Flt_Atan, [a1])
1086 translateOp [r] FloatLogOp [a1] = Just (Just1 r, MO_Flt_Log, [a1])
1087 translateOp [r] FloatExpOp [a1] = Just (Just1 r, MO_Flt_Exp, [a1])
1088 translateOp [r] FloatSqrtOp [a1] = Just (Just1 r, MO_Flt_Sqrt, [a1])
1089 translateOp [r] FloatNegOp [a1] = Just (Just1 r, MO_Flt_Neg, [a1])
1093 translateOp [r] Int2DoubleOp [a1] = Just (Just1 r, MO_NatS_to_Dbl, [a1])
1094 translateOp [r] Double2IntOp [a1] = Just (Just1 r, MO_Dbl_to_NatS, [a1])
1096 translateOp [r] Int2FloatOp [a1] = Just (Just1 r, MO_NatS_to_Flt, [a1])
1097 translateOp [r] Float2IntOp [a1] = Just (Just1 r, MO_Flt_to_NatS, [a1])
1099 translateOp [r] Float2DoubleOp [a1] = Just (Just1 r, MO_Flt_to_Dbl, [a1])
1100 translateOp [r] Double2FloatOp [a1] = Just (Just1 r, MO_Dbl_to_Flt, [a1])
1102 translateOp [r] Int2WordOp [a1] = Just (Just1 r, MO_NatS_to_NatU, [a1])
1103 translateOp [r] Word2IntOp [a1] = Just (Just1 r, MO_NatU_to_NatS, [a1])
1105 translateOp [r] Int2AddrOp [a1] = Just (Just1 r, MO_NatS_to_NatP, [a1])
1106 translateOp [r] Addr2IntOp [a1] = Just (Just1 r, MO_NatP_to_NatS, [a1])
1108 translateOp [r] OrdOp [a1] = Just (Just1 r, MO_32U_to_NatS, [a1])
1109 translateOp [r] ChrOp [a1] = Just (Just1 r, MO_NatS_to_32U, [a1])
1111 translateOp [r] Narrow8IntOp [a1] = Just (Just1 r, MO_8S_to_NatS, [a1])
1112 translateOp [r] Narrow16IntOp [a1] = Just (Just1 r, MO_16S_to_NatS, [a1])
1113 translateOp [r] Narrow32IntOp [a1] = Just (Just1 r, MO_32S_to_NatS, [a1])
1115 translateOp [r] Narrow8WordOp [a1] = Just (Just1 r, MO_8U_to_NatU, [a1])
1116 translateOp [r] Narrow16WordOp [a1] = Just (Just1 r, MO_16U_to_NatU, [a1])
1117 translateOp [r] Narrow32WordOp [a1] = Just (Just1 r, MO_32U_to_NatU, [a1])
1119 translateOp [r] SameMutVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1120 translateOp [r] SameMVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1121 translateOp [r] SameMutableArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1122 translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1123 translateOp [r] EqForeignObj [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1124 translateOp [r] EqStablePtrOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1126 translateOp _ _ _ = Nothing