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 Maybes ( Maybe012(..) )
39 import Panic ( panic )
42 import Maybe ( isJust, maybeToList )
47 Check if there is any real code in some Abstract~C. If so, return it
48 (@Just ...@); otherwise, return @Nothing@. Don't be too strict!
50 It returns the "reduced" code in the Just part so that the work of
51 discarding AbsCNops isn't lost, and so that if the caller uses
52 the reduced version there's less danger of a big tree of AbsCNops getting
53 materialised and causing a space leak.
56 nonemptyAbsC :: AbstractC -> Maybe AbstractC
57 nonemptyAbsC AbsCNop = Nothing
58 nonemptyAbsC (AbsCStmts s1 s2) = case (nonemptyAbsC s1) of
59 Nothing -> nonemptyAbsC s2
60 Just x -> Just (AbsCStmts x s2)
61 nonemptyAbsC s@(CSimultaneous c) = case (nonemptyAbsC c) of
64 nonemptyAbsC other = Just other
68 mkAbstractCs :: [AbstractC] -> AbstractC
69 mkAbstractCs [] = AbsCNop
70 mkAbstractCs cs = foldr1 mkAbsCStmts cs
72 -- for fiddling around w/ killing off AbsCNops ... (ToDo)
73 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
74 mkAbsCStmts AbsCNop c = c
75 mkAbsCStmts c AbsCNop = c
76 mkAbsCStmts c1 c2 = c1 `AbsCStmts` c2
78 {- Discarded SLPJ June 95; it calls nonemptyAbsC too much!
79 = case (case (nonemptyAbsC abc2) of
81 Just d2 -> d2) of { abc2b ->
83 case (nonemptyAbsC abc1) of {
85 Just d1 -> AbsCStmts d1 abc2b
90 Get the sho' 'nuff statements out of an @AbstractC@.
92 mkAbsCStmtList :: AbstractC -> [AbstractC]
94 mkAbsCStmtList absC = mkAbsCStmtList' absC []
96 -- Optimised a la foldr/build!
98 mkAbsCStmtList' AbsCNop r = r
100 mkAbsCStmtList' (AbsCStmts s1 s2) r
101 = mkAbsCStmtList' s1 (mkAbsCStmtList' s2 r)
103 mkAbsCStmtList' s@(CSimultaneous c) r
104 = if null (mkAbsCStmtList c) then r else s : r
106 mkAbsCStmtList' other r = other : r
110 mkAlgAltsCSwitch :: CAddrMode -> [(ConTag, AbstractC)] -> AbstractC -> AbstractC
112 mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc
113 | isJust (nonemptyAbsC deflt_absc)
114 = CSwitch scrutinee (adjust tagged_alts) deflt_absc
116 = CSwitch scrutinee (adjust rest) first_alt
118 -- it's ok to convert one of the alts into a default if we don't already have
119 -- one, because this is an algebraic case and we're guaranteed that the tag
120 -- will match one of the branches.
121 ((_,first_alt):rest) = tagged_alts
123 -- Adjust the tags in the switch to start at zero.
124 -- This is the convention used by primitive ops which return algebraic
125 -- data types. Why? Because for two-constructor types, zero is faster
126 -- to create and distinguish from 1 than are 1 and 2.
128 -- We also need to convert to Literals to keep the CSwitch happy
130 = [ (mkMachWord (toInteger (tag - fIRST_TAG)), abs_c)
131 | (tag, abs_c) <- tagged_alts ]
134 %************************************************************************
136 \subsubsection[AbsCUtils-kinds-from-MagicIds]{Kinds from MagicIds}
138 %************************************************************************
141 magicIdPrimRep BaseReg = PtrRep
142 magicIdPrimRep (VanillaReg kind _) = kind
143 magicIdPrimRep (FloatReg _) = FloatRep
144 magicIdPrimRep (DoubleReg _) = DoubleRep
145 magicIdPrimRep (LongReg kind _) = kind
146 magicIdPrimRep Sp = PtrRep
147 magicIdPrimRep Su = PtrRep
148 magicIdPrimRep SpLim = PtrRep
149 magicIdPrimRep Hp = PtrRep
150 magicIdPrimRep HpLim = PtrRep
151 magicIdPrimRep CurCostCentre = CostCentreRep
152 magicIdPrimRep VoidReg = VoidRep
153 magicIdPrimRep CurrentTSO = ThreadIdRep
154 magicIdPrimRep CurrentNursery = PtrRep
157 %************************************************************************
159 \subsection[AbsCUtils-amode-kinds]{Finding @PrimitiveKinds@ of amodes}
161 %************************************************************************
163 See also the return conventions for unboxed things; currently living
164 in @CgCon@ (next to the constructor return conventions).
166 ToDo: tiny tweaking may be in order
168 getAmodeRep :: CAddrMode -> PrimRep
170 getAmodeRep (CVal _ kind) = kind
171 getAmodeRep (CAddr _) = PtrRep
172 getAmodeRep (CReg magic_id) = magicIdPrimRep magic_id
173 getAmodeRep (CTemp uniq kind) = kind
174 getAmodeRep (CLbl _ kind) = kind
175 getAmodeRep (CCharLike _) = PtrRep
176 getAmodeRep (CIntLike _) = PtrRep
177 getAmodeRep (CLit lit) = literalPrimRep lit
178 getAmodeRep (CMacroExpr kind _ _) = kind
179 getAmodeRep (CJoinPoint _) = panic "getAmodeRep:CJoinPoint"
180 getAmodeRep (CMem rep addr) = rep
183 @mixedTypeLocn@ tells whether an amode identifies an ``StgWord''
184 location; that is, one which can contain values of various types.
187 mixedTypeLocn :: CAddrMode -> Bool
189 mixedTypeLocn (CVal (NodeRel _) _) = True
190 mixedTypeLocn (CVal (SpRel _) _) = True
191 mixedTypeLocn (CVal (HpRel _) _) = True
192 mixedTypeLocn other = False -- All the rest
195 @mixedPtrLocn@ tells whether an amode identifies a
196 location which can contain values of various pointer types.
199 mixedPtrLocn :: CAddrMode -> Bool
201 mixedPtrLocn (CVal (SpRel _) _) = True
202 mixedPtrLocn other = False -- All the rest
205 %************************************************************************
207 \subsection[AbsCUtils-flattening]{Flatten Abstract~C}
209 %************************************************************************
211 The following bits take ``raw'' Abstract~C, which may have all sorts of
212 nesting, and flattens it into one long @AbsCStmtList@. Mainly,
213 @CClosureInfos@ and code for switches are pulled out to the top level.
215 The various functions herein tend to produce
218 A {\em flattened} \tr{<something>} of interest for ``here'', and
220 Some {\em unflattened} Abstract~C statements to be carried up to the
221 top-level. The only real reason (now) that it is unflattened is
222 because it means the recursive flattening can be done in just one
223 place rather than having to remember lots of places.
226 Care is taken to reduce the occurrence of forward references, while still
227 keeping laziness a much as possible. Essentially, this means that:
230 {\em All} the top-level C statements resulting from flattening a
231 particular AbsC statement (whether the latter is nested or not) appear
232 before {\em any} of the code for a subsequent AbsC statement;
234 but stuff nested within any AbsC statement comes
235 out before the code for the statement itself.
238 The ``stuff to be carried up'' always includes a label: a
239 @CStaticClosure@, @CRetDirect@, @CFlatRetVector@, or
240 @CCodeBlock@. The latter turns into a C function, and is never
241 actually produced by the code generator. Rather it always starts life
242 as a @CCodeBlock@ addressing mode; when such an addr mode is
243 flattened, the ``tops'' stuff is a @CCodeBlock@.
246 flattenAbsC :: UniqSupply -> AbstractC -> AbstractC
249 = case (initFlt us (flatAbsC abs_C)) of { (here, tops) ->
250 here `mkAbsCStmts` tops }
253 %************************************************************************
255 \subsubsection{Flattening monadery}
257 %************************************************************************
259 The flattener is monadised. It's just a @UniqueSupply@.
262 type FlatM result = UniqSupply -> result
264 initFlt :: UniqSupply -> FlatM a -> a
266 initFlt init_us m = m init_us
268 {-# INLINE thenFlt #-}
269 {-# INLINE returnFlt #-}
271 thenFlt :: FlatM a -> (a -> FlatM b) -> FlatM b
274 = case (splitUniqSupply us) of { (s1, s2) ->
275 case (expr s1) of { result ->
278 returnFlt :: a -> FlatM a
279 returnFlt result us = result
281 mapFlt :: (a -> FlatM b) -> [a] -> FlatM [b]
283 mapFlt f [] = returnFlt []
285 = f x `thenFlt` \ r ->
286 mapFlt f xs `thenFlt` \ rs ->
289 mapAndUnzipFlt :: (a -> FlatM (b,c)) -> [a] -> FlatM ([b],[c])
291 mapAndUnzipFlt f [] = returnFlt ([],[])
292 mapAndUnzipFlt f (x:xs)
293 = f x `thenFlt` \ (r1, r2) ->
294 mapAndUnzipFlt f xs `thenFlt` \ (rs1, rs2) ->
295 returnFlt (r1:rs1, r2:rs2)
297 getUniqFlt :: FlatM Unique
298 getUniqFlt us = uniqFromSupply us
300 getUniqsFlt :: FlatM [Unique]
301 getUniqsFlt us = uniqsFromSupply us
304 %************************************************************************
306 \subsubsection{Flattening the top level}
308 %************************************************************************
311 flatAbsC :: AbstractC
312 -> FlatM (AbstractC, -- Stuff to put inline [Both are fully
313 AbstractC) -- Stuff to put at top level flattened]
315 flatAbsC AbsCNop = returnFlt (AbsCNop, AbsCNop)
317 flatAbsC (AbsCStmts s1 s2)
318 = flatAbsC s1 `thenFlt` \ (inline_s1, top_s1) ->
319 flatAbsC s2 `thenFlt` \ (inline_s2, top_s2) ->
320 returnFlt (mkAbsCStmts inline_s1 inline_s2,
321 mkAbsCStmts top_s1 top_s2)
323 flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
324 = flatAbsC slow `thenFlt` \ (slow_heres, slow_tops) ->
325 flat_maybe maybe_fast `thenFlt` \ (fast_heres, fast_tops) ->
326 returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
327 CClosureInfoAndCode cl_info slow_heres fast_heres descr]
330 flatAbsC (CCodeBlock lbl abs_C)
331 = flatAbsC abs_C `thenFlt` \ (absC_heres, absC_tops) ->
332 returnFlt (AbsCNop, absC_tops `mkAbsCStmts` CCodeBlock lbl absC_heres)
334 flatAbsC (CRetDirect uniq slow_code srt liveness)
335 = flatAbsC slow_code `thenFlt` \ (heres, tops) ->
337 mkAbstractCs [ tops, CRetDirect uniq heres srt liveness ])
339 flatAbsC (CSwitch discrim alts deflt)
340 = mapAndUnzipFlt flat_alt alts `thenFlt` \ (flat_alts, flat_alts_tops) ->
341 flatAbsC deflt `thenFlt` \ (flat_def_alt, def_tops) ->
343 CSwitch discrim flat_alts flat_def_alt,
344 mkAbstractCs (def_tops : flat_alts_tops)
348 = flatAbsC absC `thenFlt` \ (alt_heres, alt_tops) ->
349 returnFlt ( (tag, alt_heres), alt_tops )
351 flatAbsC stmt@(COpStmt results (StgFCallOp (CCall ccall@(CCallSpec target _ _)) uniq) args _)
352 | is_dynamic -- Emit a typedef if its a dynamic call
353 || (opt_EmitCExternDecls && not (isCasmTarget target)) -- or we want extern decls
354 = returnFlt (stmt, CCallTypedef is_dynamic ccall uniq results args)
356 is_dynamic = isDynamicTarget target
358 flatAbsC stmt@(CSimultaneous abs_c)
359 = flatAbsC abs_c `thenFlt` \ (stmts_here, tops) ->
360 doSimultaneously stmts_here `thenFlt` \ new_stmts_here ->
361 returnFlt (new_stmts_here, tops)
363 flatAbsC stmt@(CCheck macro amodes code)
364 = flatAbsC code `thenFlt` \ (code_here, code_tops) ->
365 returnFlt (CCheck macro amodes code_here, code_tops)
367 -- the TICKY_CTR macro always needs to be hoisted out to the top level.
369 flatAbsC stmt@(CCallProfCtrMacro str amodes)
370 | str == SLIT("TICK_CTR") = returnFlt (AbsCNop, stmt)
371 | otherwise = returnFlt (stmt, AbsCNop)
373 -- Some statements need no flattening at all:
374 flatAbsC stmt@(CMacroStmt macro amodes) = returnFlt (stmt, AbsCNop)
375 flatAbsC stmt@(CCallProfCCMacro str amodes) = returnFlt (stmt, AbsCNop)
376 flatAbsC stmt@(CAssign dest source) = returnFlt (stmt, AbsCNop)
377 flatAbsC stmt@(CJump target) = returnFlt (stmt, AbsCNop)
378 flatAbsC stmt@(CFallThrough target) = returnFlt (stmt, AbsCNop)
379 flatAbsC stmt@(CReturn target return_info) = returnFlt (stmt, AbsCNop)
380 flatAbsC stmt@(CInitHdr a b cc sz) = returnFlt (stmt, AbsCNop)
381 flatAbsC stmt@(CMachOpStmt res mop args m_vols) = returnFlt (stmt, AbsCNop)
382 flatAbsC stmt@(COpStmt results (StgFCallOp _ _) args vol_regs)
383 = returnFlt (stmt, AbsCNop)
384 flatAbsC stmt@(COpStmt results (StgPrimOp op) args vol_regs)
385 = dscCOpStmt (filter non_void_amode results) op
386 (filter non_void_amode args) vol_regs
389 COpStmt _ _ _ _ -> panic "flatAbsC - dscCOpStmt" -- make sure we don't loop!
390 other -> flatAbsC other
392 A gruesome hack for printing the names of inline primops when they
397 = getUniqFlt `thenFlt` \ uu ->
398 flatAbsC (CSequential [moo uu (showSDoc (ppr op)), xxx])
404 (CCall (CCallSpec (CasmTarget (_PK_ (mktxt op_str)))
405 defaultCCallConv PlaySafe))
411 = " asm(\"pushal;\"); printf(\"%%s\\n\",\"" ++ op_str ++ "\"); asm(\"popal\"); "
414 flatAbsC (CSequential abcs)
415 = mapAndUnzipFlt flatAbsC abcs `thenFlt` \ (inlines, tops) ->
416 returnFlt (CSequential inlines, foldr AbsCStmts AbsCNop tops)
419 -- Some statements only make sense at the top level, so we always float
420 -- them. This probably isn't necessary.
421 flatAbsC stmt@(CStaticClosure _ _ _ _) = returnFlt (AbsCNop, stmt)
422 flatAbsC stmt@(CClosureTbl _) = returnFlt (AbsCNop, stmt)
423 flatAbsC stmt@(CSRT _ _) = returnFlt (AbsCNop, stmt)
424 flatAbsC stmt@(CBitmap _ _) = returnFlt (AbsCNop, stmt)
425 flatAbsC stmt@(CCostCentreDecl _ _) = returnFlt (AbsCNop, stmt)
426 flatAbsC stmt@(CCostCentreStackDecl _) = returnFlt (AbsCNop, stmt)
427 flatAbsC stmt@(CSplitMarker) = returnFlt (AbsCNop, stmt)
428 flatAbsC stmt@(CRetVector _ _ _ _) = returnFlt (AbsCNop, stmt)
429 flatAbsC stmt@(CModuleInitBlock _ _) = returnFlt (AbsCNop, stmt)
433 flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
434 flat_maybe Nothing = returnFlt (Nothing, AbsCNop)
435 flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) ->
436 returnFlt (Just heres, tops)
439 %************************************************************************
441 \subsection[flat-simultaneous]{Doing things simultaneously}
443 %************************************************************************
446 doSimultaneously :: AbstractC -> FlatM AbstractC
449 Generate code to perform the @CAssign@s and @COpStmt@s in the
450 input simultaneously, using temporary variables when necessary.
452 We use the strongly-connected component algorithm, in which
453 * the vertices are the statements
454 * an edge goes from s1 to s2 iff
455 s1 assigns to something s2 uses
456 that is, if s1 should *follow* s2 in the final order
459 type CVertex = (Int, AbstractC) -- Give each vertex a unique number,
460 -- for fast comparison
462 doSimultaneously abs_c
464 enlisted = en_list abs_c
466 case enlisted of -- it's often just one stmt
467 [] -> returnFlt AbsCNop
469 _ -> doSimultaneously1 (zip [(1::Int)..] enlisted)
471 -- en_list puts all the assignments in a list, filtering out Nops and
472 -- assignments which do nothing
474 en_list (AbsCStmts a1 a2) = en_list a1 ++ en_list a2
475 en_list (CAssign am1 am2) | sameAmode am1 am2 = []
476 en_list other = [other]
478 sameAmode :: CAddrMode -> CAddrMode -> Bool
479 -- ToDo: Move this function, or make CAddrMode an instance of Eq
480 -- At the moment we put in just enough to catch the cases we want:
481 -- the second (destination) argument is always a CVal.
482 sameAmode (CReg r1) (CReg r2) = r1 == r2
483 sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _) = r1 ==# r2
484 sameAmode other1 other2 = False
486 doSimultaneously1 :: [CVertex] -> FlatM AbstractC
487 doSimultaneously1 vertices
489 edges = [ (vertex, key1, edges_from stmt1)
490 | vertex@(key1, stmt1) <- vertices
492 edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,
493 stmt1 `should_follow` stmt2
495 components = stronglyConnComp edges
497 -- do_components deal with one strongly-connected component
498 -- Not cyclic, or singleton? Just do it
499 do_component (AcyclicSCC (n,abs_c)) = returnFlt abs_c
500 do_component (CyclicSCC [(n,abs_c)]) = returnFlt abs_c
502 -- Cyclic? Then go via temporaries. Pick one to
503 -- break the loop and try again with the rest.
504 do_component (CyclicSCC ((n,first_stmt) : rest))
505 = doSimultaneously1 rest `thenFlt` \ abs_cs ->
506 go_via_temps first_stmt `thenFlt` \ (to_temps, from_temps) ->
507 returnFlt (mkAbstractCs [to_temps, abs_cs, from_temps])
509 go_via_temps (CAssign dest src)
510 = getUniqFlt `thenFlt` \ uniq ->
512 the_temp = CTemp uniq (getAmodeRep dest)
514 returnFlt (CAssign the_temp src, CAssign dest the_temp)
516 go_via_temps (COpStmt dests op srcs vol_regs)
517 = getUniqsFlt `thenFlt` \ uniqs ->
519 the_temps = zipWith (\ u d -> CTemp u (getAmodeRep d)) uniqs dests
521 returnFlt (COpStmt the_temps op srcs vol_regs,
522 mkAbstractCs (zipWith CAssign dests the_temps))
524 mapFlt do_component components `thenFlt` \ abs_cs ->
525 returnFlt (mkAbstractCs abs_cs)
528 should_follow :: AbstractC -> AbstractC -> Bool
529 (CAssign dest1 _) `should_follow` (CAssign _ src2)
530 = dest1 `conflictsWith` src2
531 (COpStmt dests1 _ _ _) `should_follow` (CAssign _ src2)
532 = or [dest1 `conflictsWith` src2 | dest1 <- dests1]
533 (CAssign dest1 _)`should_follow` (COpStmt _ _ srcs2 _)
534 = or [dest1 `conflictsWith` src2 | src2 <- srcs2]
535 (COpStmt dests1 _ _ _) `should_follow` (COpStmt _ _ srcs2 _)
536 = or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
539 @conflictsWith@ tells whether an assignment to its first argument will
540 screw up an access to its second.
543 conflictsWith :: CAddrMode -> CAddrMode -> Bool
544 (CReg reg1) `conflictsWith` (CReg reg2) = reg1 == reg2
545 (CReg reg) `conflictsWith` (CVal reg_rel _) = reg `regConflictsWithRR` reg_rel
546 (CReg reg) `conflictsWith` (CAddr reg_rel) = reg `regConflictsWithRR` reg_rel
547 (CTemp u1 _) `conflictsWith` (CTemp u2 _) = u1 == u2
548 (CVal reg_rel1 k1) `conflictsWith` (CVal reg_rel2 k2)
549 = rrConflictsWithRR (getPrimRepSize k1) (getPrimRepSize k2) reg_rel1 reg_rel2
551 other1 `conflictsWith` other2 = False
552 -- CAddr and literals are impossible on the LHS of an assignment
554 regConflictsWithRR :: MagicId -> RegRelative -> Bool
556 regConflictsWithRR (VanillaReg k n) (NodeRel _) | n ==# (_ILIT 1) = True
557 regConflictsWithRR Sp (SpRel _) = True
558 regConflictsWithRR Hp (HpRel _) = True
559 regConflictsWithRR _ _ = False
561 rrConflictsWithRR :: Int -> Int -- Sizes of two things
562 -> RegRelative -> RegRelative -- The two amodes
565 rrConflictsWithRR s1b s2b rr1 rr2 = rr rr1 rr2
570 rr (SpRel o1) (SpRel o2)
571 | s1 ==# (_ILIT 0) || s2 ==# (_ILIT 0) = False -- No conflict if either is size zero
572 | s1 ==# (_ILIT 1) && s2 ==# (_ILIT 1) = o1 ==# o2
573 | otherwise = (o1 +# s1) >=# o2 &&
576 rr (NodeRel o1) (NodeRel o2)
577 | s1 ==# (_ILIT 0) || s2 ==# (_ILIT 0) = False -- No conflict if either is size zero
578 | s1 ==# (_ILIT 1) && s2 ==# (_ILIT 1) = o1 ==# o2
579 | otherwise = True -- Give up
581 rr (HpRel _) (HpRel _) = True -- Give up (ToDo)
583 rr other1 other2 = False
586 %************************************************************************
588 \subsection[flat-primops]{Translating COpStmts to CMachOpStmts}
590 %************************************************************************
595 ------------------------------------------------------------------------------
597 -- Assumes no volatiles
599 -- res = arg >> (bits-per-word / 2) when little-endian
601 -- res = arg & ((1 << (bits-per-word / 2)) - 1) when big-endian
603 -- In other words, if arg had been stored in memory, makes res the
604 -- halfword of arg which would have had the higher address. This is
605 -- why it needs to take into account endianness.
607 mkHalfWord_HIADDR res arg
608 = mkTemp IntRep `thenFlt` \ t_hw_shift ->
609 mkTemp WordRep `thenFlt` \ t_hw_mask1 ->
610 mkTemp WordRep `thenFlt` \ t_hw_mask2 ->
612 = CMachOpStmt (Just1 t_hw_shift)
613 MO_Nat_Shl [CBytesPerWord, CLit (mkMachInt 2)] Nothing
615 = CMachOpStmt (Just1 t_hw_mask1)
616 MO_Nat_Shl [CLit (mkMachWord 1), t_hw_shift] Nothing
618 = CMachOpStmt (Just1 t_hw_mask2)
619 MO_Nat_Sub [t_hw_mask1, CLit (mkMachWord 1)] Nothing
622 = CSequential [ a_hw_shift, a_hw_mask1, a_hw_mask2,
623 CMachOpStmt (Just1 res) MO_Nat_And [arg, t_hw_mask2] Nothing
626 = CSequential [ a_hw_shift,
627 CMachOpStmt (Just1 res) MO_Nat_Shr [arg, t_hw_shift] Nothing
634 mkTemp :: PrimRep -> FlatM CAddrMode
636 = getUniqFlt `thenFlt` \ uniq -> returnFlt (CTemp uniq rep)
638 mkTemps = mapFlt mkTemp
640 mkDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
641 mkDerefOff rep base off
642 | off == 0 -- optimisation
645 = CMem rep (CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep))
647 mkNoDerefOff :: PrimRep -> CAddrMode -> Int -> CAddrMode
648 mkNoDerefOff rep base off
649 = CAddr (CIndex base (CLit (mkMachInt (toInteger off))) rep)
651 -- Sigh. This is done in 3 seperate places. Should be
652 -- commoned up (here, in pprAbsC of COpStmt, and presumably
653 -- somewhere in the NCG).
655 = case getAmodeRep amode of
659 doIndexOffForeignObjOp rep res addr idx
660 = Just (Just1 res, MO_ReadOSBI fixedHdrSize rep, [addr,idx])
662 doIndexOffAddrOp rep res addr idx
663 = Just (Just1 res, MO_ReadOSBI 0 rep, [addr,idx])
665 doIndexByteArrayOp rep res addr idx
666 = Just (Just1 res, MO_ReadOSBI arrWordsHdrSize rep, [addr,idx])
668 doWriteOffAddrOp rep addr idx val
669 = Just (Just0, MO_WriteOSBI 0 rep, [addr,idx,val])
671 doWriteByteArrayOp rep addr idx val
672 = Just (Just0, MO_WriteOSBI arrWordsHdrSize rep, [addr,idx,val])
674 -- Simple dyadic op but one for which we need to cast first arg to
675 -- be sure of correctness
676 translateOp_dyadic_cast1 mop res cast_arg1_to arg1 arg2 vols
677 = mkTemp cast_arg1_to `thenFlt` \ arg1casted ->
678 (returnFlt . CSequential) [
679 CAssign arg1casted arg1,
680 CMachOpStmt (Just1 res) mop [arg1casted,arg2]
681 (if isDefinitelyInlineMachOp mop then Nothing else Just vols)
684 ------------------------------------------------------------------------------
686 dscCOpStmt :: [CAddrMode] -- Results
688 -> [CAddrMode] -- Arguments
689 -> [MagicId] -- Potentially volatile/live registers
690 -- (to save/restore around the op)
693 -- #define parzh(r,node) r = 1
694 dscCOpStmt [res] ParOp [arg] vols
696 (CAssign res (CLit (mkMachInt 1)))
698 -- #define readMutVarzh(r,a) r=(P_)(((StgMutVar *)(a))->var)
699 dscCOpStmt [res] ReadMutVarOp [mutv] vols
701 (CAssign res (mkDerefOff PtrRep mutv fixedHdrSize))
703 -- #define writeMutVarzh(a,v) (P_)(((StgMutVar *)(a))->var)=(v)
704 dscCOpStmt [] WriteMutVarOp [mutv,var] vols
706 (CAssign (mkDerefOff PtrRep mutv fixedHdrSize) var)
709 -- #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data)
710 -- #define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo)
711 dscCOpStmt [res] ForeignObjToAddrOp [fo] vols
713 (CAssign res (mkDerefOff PtrRep fo fixedHdrSize))
715 -- #define writeForeignObjzh(res,datum) \
716 -- (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
717 dscCOpStmt [] WriteForeignObjOp [fo,addr] vols
719 (CAssign (mkDerefOff PtrRep fo fixedHdrSize) addr)
722 -- #define sizzeofByteArrayzh(r,a) \
723 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
724 dscCOpStmt [res] SizeofByteArrayOp [arg] vols
725 = mkTemp WordRep `thenFlt` \ w ->
726 (returnFlt . CSequential) [
727 CAssign w (mkDerefOff WordRep arg fixedHdrSize),
728 CMachOpStmt (Just1 w)
729 MO_NatU_Mul [w, CBytesPerWord] (Just vols),
733 -- #define sizzeofMutableByteArrayzh(r,a) \
734 -- r = (((StgArrWords *)(a))->words * sizeof(W_))
735 dscCOpStmt [res] SizeofMutableByteArrayOp [arg] vols
736 = dscCOpStmt [res] SizeofByteArrayOp [arg] vols
739 -- #define touchzh(o) /* nothing */
740 dscCOpStmt [] TouchOp [arg] vols
743 -- #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
744 dscCOpStmt [res] ByteArrayContents_Char [arg] vols
745 = mkTemp PtrRep `thenFlt` \ ptr ->
746 (returnFlt . CSequential) [
747 CMachOpStmt (Just1 ptr) MO_NatU_to_NatP [arg] Nothing,
748 CAssign ptr (mkNoDerefOff WordRep ptr arrWordsHdrSize),
752 -- #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn)
753 dscCOpStmt [res] StableNameToIntOp [arg] vols
755 (CAssign res (mkDerefOff WordRep arg fixedHdrSize))
757 -- #define eqStableNamezh(r,sn1,sn2) \
758 -- (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
759 dscCOpStmt [res] EqStableNameOp [arg1,arg2] vols
760 = mkTemps [WordRep, WordRep] `thenFlt` \ [sn1,sn2] ->
761 (returnFlt . CSequential) [
762 CAssign sn1 (mkDerefOff WordRep arg1 fixedHdrSize),
763 CAssign sn2 (mkDerefOff WordRep arg2 fixedHdrSize),
764 CMachOpStmt (Just1 res) MO_Nat_Eq [sn1,sn2] Nothing
767 -- #define addrToHValuezh(r,a) r=(P_)a
768 dscCOpStmt [res] AddrToHValueOp [arg] vols
772 -- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info))
773 dscCOpStmt [res] DataToTagOp [arg] vols
774 = mkTemps [PtrRep, WordRep] `thenFlt` \ [t_infoptr, t_theword] ->
775 mkHalfWord_HIADDR res t_theword `thenFlt` \ select_ops ->
776 (returnFlt . CSequential) [
777 CAssign t_infoptr (mkDerefOff PtrRep arg 0),
778 CAssign t_theword (mkDerefOff WordRep t_infoptr (-1)),
783 {- Freezing arrays-of-ptrs requires changing an info table, for the
784 benefit of the generational collector. It needs to scavenge mutable
785 objects, even if they are in old space. When they become immutable,
786 they can be removed from this scavenge list. -}
788 -- #define unsafeFreezzeArrayzh(r,a) \
790 -- SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_info); \
793 dscCOpStmt [res] UnsafeFreezeArrayOp [arg] vols
794 = (returnFlt . CSequential) [
795 CAssign (mkDerefOff PtrRep arg 0) (CLbl mkMAP_FROZEN_infoLabel PtrRep),
799 -- #define unsafeFreezzeByteArrayzh(r,a) r=(a)
800 dscCOpStmt [res] UnsafeFreezeByteArrayOp [arg] vols
804 -- This ought to be trivial, but it's difficult to insert the casts
805 -- required to keep the C compiler happy.
806 dscCOpStmt [r] AddrRemOp [a1,a2] vols
807 = mkTemp WordRep `thenFlt` \ a1casted ->
808 (returnFlt . CSequential) [
809 CMachOpStmt (Just1 a1casted) MO_NatP_to_NatU [a1] Nothing,
810 CMachOpStmt (Just1 r) MO_NatU_Rem [a1casted,a2] Nothing
813 -- not handled by translateOp because they need casts
814 dscCOpStmt [r] SllOp [a1,a2] vols
815 = translateOp_dyadic_cast1 MO_Nat_Shl r WordRep a1 a2 vols
816 dscCOpStmt [r] SrlOp [a1,a2] vols
817 = translateOp_dyadic_cast1 MO_Nat_Shr r WordRep a1 a2 vols
819 dscCOpStmt [r] ISllOp [a1,a2] vols
820 = translateOp_dyadic_cast1 MO_Nat_Shl r IntRep a1 a2 vols
821 dscCOpStmt [r] ISrlOp [a1,a2] vols
822 = translateOp_dyadic_cast1 MO_Nat_Shr r IntRep a1 a2 vols
823 dscCOpStmt [r] ISraOp [a1,a2] vols
824 = translateOp_dyadic_cast1 MO_Nat_Sar r IntRep a1 a2 vols
827 -- Handle all others as simply as possible.
828 dscCOpStmt ress op args vols
829 = case translateOp ress op args of
831 -> pprPanic "dscCOpStmt: can't translate PrimOp" (ppr op)
832 Just (maybe_res, mop, args)
834 CMachOpStmt maybe_res mop args
835 (if isDefinitelyInlineMachOp mop then Nothing else Just vols)
840 translateOp [r] ReadArrayOp [obj,ix]
841 = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix])
842 translateOp [r] IndexArrayOp [obj,ix]
843 = Just (Just1 r, MO_ReadOSBI arrPtrsHdrSize PtrRep, [obj,ix])
844 translateOp [] WriteArrayOp [obj,ix,v]
845 = Just (Just0, MO_WriteOSBI arrPtrsHdrSize PtrRep, [obj,ix,v])
847 -- IndexXXXoffForeignObj
849 translateOp [r] IndexOffForeignObjOp_Char [a,i] = doIndexOffForeignObjOp Word8Rep r a i
850 translateOp [r] IndexOffForeignObjOp_WideChar [a,i] = doIndexOffForeignObjOp Word32Rep r a i
851 translateOp [r] IndexOffForeignObjOp_Int [a,i] = doIndexOffForeignObjOp IntRep r a i
852 translateOp [r] IndexOffForeignObjOp_Word [a,i] = doIndexOffForeignObjOp WordRep r a i
853 translateOp [r] IndexOffForeignObjOp_Addr [a,i] = doIndexOffForeignObjOp AddrRep r a i
854 translateOp [r] IndexOffForeignObjOp_Float [a,i] = doIndexOffForeignObjOp FloatRep r a i
855 translateOp [r] IndexOffForeignObjOp_Double [a,i] = doIndexOffForeignObjOp DoubleRep r a i
856 translateOp [r] IndexOffForeignObjOp_StablePtr [a,i] = doIndexOffForeignObjOp StablePtrRep r a i
858 translateOp [r] IndexOffForeignObjOp_Int8 [a,i] = doIndexOffForeignObjOp Int8Rep r a i
859 translateOp [r] IndexOffForeignObjOp_Int16 [a,i] = doIndexOffForeignObjOp Int16Rep r a i
860 translateOp [r] IndexOffForeignObjOp_Int32 [a,i] = doIndexOffForeignObjOp Int32Rep r a i
861 translateOp [r] IndexOffForeignObjOp_Int64 [a,i] = doIndexOffForeignObjOp Int64Rep r a i
863 translateOp [r] IndexOffForeignObjOp_Word8 [a,i] = doIndexOffForeignObjOp Word8Rep r a i
864 translateOp [r] IndexOffForeignObjOp_Word16 [a,i] = doIndexOffForeignObjOp Word16Rep r a i
865 translateOp [r] IndexOffForeignObjOp_Word32 [a,i] = doIndexOffForeignObjOp Word32Rep r a i
866 translateOp [r] IndexOffForeignObjOp_Word64 [a,i] = doIndexOffForeignObjOp Word64Rep r a i
870 translateOp [r] IndexOffAddrOp_Char [a,i] = doIndexOffAddrOp Word8Rep r a i
871 translateOp [r] IndexOffAddrOp_WideChar [a,i] = doIndexOffAddrOp Word32Rep r a i
872 translateOp [r] IndexOffAddrOp_Int [a,i] = doIndexOffAddrOp IntRep r a i
873 translateOp [r] IndexOffAddrOp_Word [a,i] = doIndexOffAddrOp WordRep r a i
874 translateOp [r] IndexOffAddrOp_Addr [a,i] = doIndexOffAddrOp AddrRep r a i
875 translateOp [r] IndexOffAddrOp_Float [a,i] = doIndexOffAddrOp FloatRep r a i
876 translateOp [r] IndexOffAddrOp_Double [a,i] = doIndexOffAddrOp DoubleRep r a i
877 translateOp [r] IndexOffAddrOp_StablePtr [a,i] = doIndexOffAddrOp StablePtrRep r a i
879 translateOp [r] IndexOffAddrOp_Int8 [a,i] = doIndexOffAddrOp Int8Rep r a i
880 translateOp [r] IndexOffAddrOp_Int16 [a,i] = doIndexOffAddrOp Int16Rep r a i
881 translateOp [r] IndexOffAddrOp_Int32 [a,i] = doIndexOffAddrOp Int32Rep r a i
882 translateOp [r] IndexOffAddrOp_Int64 [a,i] = doIndexOffAddrOp Int64Rep r a i
884 translateOp [r] IndexOffAddrOp_Word8 [a,i] = doIndexOffAddrOp Word8Rep r a i
885 translateOp [r] IndexOffAddrOp_Word16 [a,i] = doIndexOffAddrOp Word16Rep r a i
886 translateOp [r] IndexOffAddrOp_Word32 [a,i] = doIndexOffAddrOp Word32Rep r a i
887 translateOp [r] IndexOffAddrOp_Word64 [a,i] = doIndexOffAddrOp Word64Rep r a i
889 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
891 translateOp [r] ReadOffAddrOp_Char [a,i] = doIndexOffAddrOp Word8Rep r a i
892 translateOp [r] ReadOffAddrOp_WideChar [a,i] = doIndexOffAddrOp Word32Rep r a i
893 translateOp [r] ReadOffAddrOp_Int [a,i] = doIndexOffAddrOp IntRep r a i
894 translateOp [r] ReadOffAddrOp_Word [a,i] = doIndexOffAddrOp WordRep r a i
895 translateOp [r] ReadOffAddrOp_Addr [a,i] = doIndexOffAddrOp AddrRep r a i
896 translateOp [r] ReadOffAddrOp_Float [a,i] = doIndexOffAddrOp FloatRep r a i
897 translateOp [r] ReadOffAddrOp_Double [a,i] = doIndexOffAddrOp DoubleRep r a i
898 translateOp [r] ReadOffAddrOp_StablePtr [a,i] = doIndexOffAddrOp StablePtrRep r a i
900 translateOp [r] ReadOffAddrOp_Int8 [a,i] = doIndexOffAddrOp Int8Rep r a i
901 translateOp [r] ReadOffAddrOp_Int16 [a,i] = doIndexOffAddrOp Int16Rep r a i
902 translateOp [r] ReadOffAddrOp_Int32 [a,i] = doIndexOffAddrOp Int32Rep r a i
903 translateOp [r] ReadOffAddrOp_Int64 [a,i] = doIndexOffAddrOp Int64Rep r a i
905 translateOp [r] ReadOffAddrOp_Word8 [a,i] = doIndexOffAddrOp Word8Rep r a i
906 translateOp [r] ReadOffAddrOp_Word16 [a,i] = doIndexOffAddrOp Word16Rep r a i
907 translateOp [r] ReadOffAddrOp_Word32 [a,i] = doIndexOffAddrOp Word32Rep r a i
908 translateOp [r] ReadOffAddrOp_Word64 [a,i] = doIndexOffAddrOp Word64Rep r a i
912 translateOp [] WriteOffAddrOp_Char [a,i,x] = doWriteOffAddrOp Word8Rep a i x
913 translateOp [] WriteOffAddrOp_WideChar [a,i,x] = doWriteOffAddrOp Word32Rep a i x
914 translateOp [] WriteOffAddrOp_Int [a,i,x] = doWriteOffAddrOp IntRep a i x
915 translateOp [] WriteOffAddrOp_Word [a,i,x] = doWriteOffAddrOp WordRep a i x
916 translateOp [] WriteOffAddrOp_Addr [a,i,x] = doWriteOffAddrOp AddrRep a i x
917 translateOp [] WriteOffAddrOp_Float [a,i,x] = doWriteOffAddrOp FloatRep a i x
918 translateOp [] WriteOffAddrOp_ForeignObj [a,i,x] = doWriteOffAddrOp ForeignObjRep a i x
919 translateOp [] WriteOffAddrOp_Double [a,i,x] = doWriteOffAddrOp DoubleRep a i x
920 translateOp [] WriteOffAddrOp_StablePtr [a,i,x] = doWriteOffAddrOp StablePtrRep a i x
922 translateOp [] WriteOffAddrOp_Int8 [a,i,x] = doWriteOffAddrOp Int8Rep a i x
923 translateOp [] WriteOffAddrOp_Int16 [a,i,x] = doWriteOffAddrOp Int16Rep a i x
924 translateOp [] WriteOffAddrOp_Int32 [a,i,x] = doWriteOffAddrOp Int32Rep a i x
925 translateOp [] WriteOffAddrOp_Int64 [a,i,x] = doWriteOffAddrOp Int64Rep a i x
927 translateOp [] WriteOffAddrOp_Word8 [a,i,x] = doWriteOffAddrOp Word8Rep a i x
928 translateOp [] WriteOffAddrOp_Word16 [a,i,x] = doWriteOffAddrOp Word16Rep a i x
929 translateOp [] WriteOffAddrOp_Word32 [a,i,x] = doWriteOffAddrOp Word32Rep a i x
930 translateOp [] WriteOffAddrOp_Word64 [a,i,x] = doWriteOffAddrOp Word64Rep a i x
934 translateOp [r] IndexByteArrayOp_Char [a,i] = doIndexByteArrayOp Word8Rep r a i
935 translateOp [r] IndexByteArrayOp_WideChar [a,i] = doIndexByteArrayOp Word32Rep r a i
936 translateOp [r] IndexByteArrayOp_Int [a,i] = doIndexByteArrayOp IntRep r a i
937 translateOp [r] IndexByteArrayOp_Word [a,i] = doIndexByteArrayOp WordRep r a i
938 translateOp [r] IndexByteArrayOp_Addr [a,i] = doIndexByteArrayOp AddrRep r a i
939 translateOp [r] IndexByteArrayOp_Float [a,i] = doIndexByteArrayOp FloatRep r a i
940 translateOp [r] IndexByteArrayOp_Double [a,i] = doIndexByteArrayOp DoubleRep r a i
941 translateOp [r] IndexByteArrayOp_StablePtr [a,i] = doIndexByteArrayOp StablePtrRep r a i
943 translateOp [r] IndexByteArrayOp_Int8 [a,i] = doIndexByteArrayOp Int8Rep r a i
944 translateOp [r] IndexByteArrayOp_Int16 [a,i] = doIndexByteArrayOp Int16Rep r a i
945 translateOp [r] IndexByteArrayOp_Int32 [a,i] = doIndexByteArrayOp Int32Rep r a i
946 translateOp [r] IndexByteArrayOp_Int64 [a,i] = doIndexByteArrayOp Int64Rep r a i
948 translateOp [r] IndexByteArrayOp_Word8 [a,i] = doIndexByteArrayOp Word8Rep r a i
949 translateOp [r] IndexByteArrayOp_Word16 [a,i] = doIndexByteArrayOp Word16Rep r a i
950 translateOp [r] IndexByteArrayOp_Word32 [a,i] = doIndexByteArrayOp Word32Rep r a i
951 translateOp [r] IndexByteArrayOp_Word64 [a,i] = doIndexByteArrayOp Word64Rep r a i
953 -- ReadXXXArray, identical to IndexXXXArray.
955 translateOp [r] ReadByteArrayOp_Char [a,i] = doIndexByteArrayOp Word8Rep r a i
956 translateOp [r] ReadByteArrayOp_WideChar [a,i] = doIndexByteArrayOp Word32Rep r a i
957 translateOp [r] ReadByteArrayOp_Int [a,i] = doIndexByteArrayOp IntRep r a i
958 translateOp [r] ReadByteArrayOp_Word [a,i] = doIndexByteArrayOp WordRep r a i
959 translateOp [r] ReadByteArrayOp_Addr [a,i] = doIndexByteArrayOp AddrRep r a i
960 translateOp [r] ReadByteArrayOp_Float [a,i] = doIndexByteArrayOp FloatRep r a i
961 translateOp [r] ReadByteArrayOp_Double [a,i] = doIndexByteArrayOp DoubleRep r a i
962 translateOp [r] ReadByteArrayOp_StablePtr [a,i] = doIndexByteArrayOp StablePtrRep r a i
964 translateOp [r] ReadByteArrayOp_Int8 [a,i] = doIndexByteArrayOp Int8Rep r a i
965 translateOp [r] ReadByteArrayOp_Int16 [a,i] = doIndexByteArrayOp Int16Rep r a i
966 translateOp [r] ReadByteArrayOp_Int32 [a,i] = doIndexByteArrayOp Int32Rep r a i
967 translateOp [r] ReadByteArrayOp_Int64 [a,i] = doIndexByteArrayOp Int64Rep r a i
969 translateOp [r] ReadByteArrayOp_Word8 [a,i] = doIndexByteArrayOp Word8Rep r a i
970 translateOp [r] ReadByteArrayOp_Word16 [a,i] = doIndexByteArrayOp Word16Rep r a i
971 translateOp [r] ReadByteArrayOp_Word32 [a,i] = doIndexByteArrayOp Word32Rep r a i
972 translateOp [r] ReadByteArrayOp_Word64 [a,i] = doIndexByteArrayOp Word64Rep r a i
976 translateOp [] WriteByteArrayOp_Char [a,i,x] = doWriteByteArrayOp Word8Rep a i x
977 translateOp [] WriteByteArrayOp_WideChar [a,i,x] = doWriteByteArrayOp Word32Rep a i x
978 translateOp [] WriteByteArrayOp_Int [a,i,x] = doWriteByteArrayOp IntRep a i x
979 translateOp [] WriteByteArrayOp_Word [a,i,x] = doWriteByteArrayOp WordRep a i x
980 translateOp [] WriteByteArrayOp_Addr [a,i,x] = doWriteByteArrayOp AddrRep a i x
981 translateOp [] WriteByteArrayOp_Float [a,i,x] = doWriteByteArrayOp FloatRep a i x
982 translateOp [] WriteByteArrayOp_Double [a,i,x] = doWriteByteArrayOp DoubleRep a i x
983 translateOp [] WriteByteArrayOp_StablePtr [a,i,x] = doWriteByteArrayOp StablePtrRep a i x
985 translateOp [] WriteByteArrayOp_Int8 [a,i,x] = doWriteByteArrayOp Int8Rep a i x
986 translateOp [] WriteByteArrayOp_Int16 [a,i,x] = doWriteByteArrayOp Int16Rep a i x
987 translateOp [] WriteByteArrayOp_Int32 [a,i,x] = doWriteByteArrayOp Int32Rep a i x
988 translateOp [] WriteByteArrayOp_Int64 [a,i,x] = doWriteByteArrayOp Int64Rep a i x
990 translateOp [] WriteByteArrayOp_Word8 [a,i,x] = doWriteByteArrayOp Word8Rep a i x
991 translateOp [] WriteByteArrayOp_Word16 [a,i,x] = doWriteByteArrayOp Word16Rep a i x
992 translateOp [] WriteByteArrayOp_Word32 [a,i,x] = doWriteByteArrayOp Word32Rep a i x
993 translateOp [] WriteByteArrayOp_Word64 [a,i,x] = doWriteByteArrayOp Word64Rep a i x
995 -- Native word signless ops
997 translateOp [r] IntAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2])
998 translateOp [r] IntSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2])
999 translateOp [r] WordAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2])
1000 translateOp [r] WordSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2])
1001 translateOp [r] AddrAddOp [a1,a2] = Just (Just1 r, MO_Nat_Add, [a1,a2])
1002 translateOp [r] AddrSubOp [a1,a2] = Just (Just1 r, MO_Nat_Sub, [a1,a2])
1004 translateOp [r] IntEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1005 translateOp [r] IntNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2])
1006 translateOp [r] WordEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1007 translateOp [r] WordNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2])
1008 translateOp [r] AddrEqOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1009 translateOp [r] AddrNeOp [a1,a2] = Just (Just1 r, MO_Nat_Ne, [a1,a2])
1011 translateOp [r] AndOp [a1,a2] = Just (Just1 r, MO_Nat_And, [a1,a2])
1012 translateOp [r] OrOp [a1,a2] = Just (Just1 r, MO_Nat_Or, [a1,a2])
1013 translateOp [r] XorOp [a1,a2] = Just (Just1 r, MO_Nat_Xor, [a1,a2])
1014 translateOp [r] NotOp [a1] = Just (Just1 r, MO_Nat_Not, [a1])
1016 -- Native word signed ops
1018 translateOp [r] IntMulOp [a1,a2] = Just (Just1 r, MO_NatS_Mul, [a1,a2])
1019 translateOp [r] IntQuotOp [a1,a2] = Just (Just1 r, MO_NatS_Quot, [a1,a2])
1020 translateOp [r] IntRemOp [a1,a2] = Just (Just1 r, MO_NatS_Rem, [a1,a2])
1021 translateOp [r] IntNegOp [a1] = Just (Just1 r, MO_NatS_Neg, [a1])
1023 translateOp [r,c] IntAddCOp [a1,a2] = Just (Just2 r c, MO_NatS_AddC, [a1,a2])
1024 translateOp [r,c] IntSubCOp [a1,a2] = Just (Just2 r c, MO_NatS_SubC, [a1,a2])
1025 translateOp [r,c] IntMulCOp [a1,a2] = Just (Just2 r c, MO_NatS_MulC, [a1,a2])
1027 translateOp [r] IntGeOp [a1,a2] = Just (Just1 r, MO_NatS_Ge, [a1,a2])
1028 translateOp [r] IntLeOp [a1,a2] = Just (Just1 r, MO_NatS_Le, [a1,a2])
1029 translateOp [r] IntGtOp [a1,a2] = Just (Just1 r, MO_NatS_Gt, [a1,a2])
1030 translateOp [r] IntLtOp [a1,a2] = Just (Just1 r, MO_NatS_Lt, [a1,a2])
1032 -- Native word unsigned ops
1034 translateOp [r] WordGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2])
1035 translateOp [r] WordLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2])
1036 translateOp [r] WordGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2])
1037 translateOp [r] WordLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2])
1039 translateOp [r] WordMulOp [a1,a2] = Just (Just1 r, MO_NatU_Mul, [a1,a2])
1040 translateOp [r] WordQuotOp [a1,a2] = Just (Just1 r, MO_NatU_Quot, [a1,a2])
1041 translateOp [r] WordRemOp [a1,a2] = Just (Just1 r, MO_NatU_Rem, [a1,a2])
1043 translateOp [r] AddrGeOp [a1,a2] = Just (Just1 r, MO_NatU_Ge, [a1,a2])
1044 translateOp [r] AddrLeOp [a1,a2] = Just (Just1 r, MO_NatU_Le, [a1,a2])
1045 translateOp [r] AddrGtOp [a1,a2] = Just (Just1 r, MO_NatU_Gt, [a1,a2])
1046 translateOp [r] AddrLtOp [a1,a2] = Just (Just1 r, MO_NatU_Lt, [a1,a2])
1048 -- 32-bit unsigned ops
1050 translateOp [r] CharEqOp [a1,a2] = Just (Just1 r, MO_32U_Eq, [a1,a2])
1051 translateOp [r] CharNeOp [a1,a2] = Just (Just1 r, MO_32U_Ne, [a1,a2])
1052 translateOp [r] CharGeOp [a1,a2] = Just (Just1 r, MO_32U_Ge, [a1,a2])
1053 translateOp [r] CharLeOp [a1,a2] = Just (Just1 r, MO_32U_Le, [a1,a2])
1054 translateOp [r] CharGtOp [a1,a2] = Just (Just1 r, MO_32U_Gt, [a1,a2])
1055 translateOp [r] CharLtOp [a1,a2] = Just (Just1 r, MO_32U_Lt, [a1,a2])
1059 translateOp [r] DoubleEqOp [a1,a2] = Just (Just1 r, MO_Dbl_Eq, [a1,a2])
1060 translateOp [r] DoubleNeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ne, [a1,a2])
1061 translateOp [r] DoubleGeOp [a1,a2] = Just (Just1 r, MO_Dbl_Ge, [a1,a2])
1062 translateOp [r] DoubleLeOp [a1,a2] = Just (Just1 r, MO_Dbl_Le, [a1,a2])
1063 translateOp [r] DoubleGtOp [a1,a2] = Just (Just1 r, MO_Dbl_Gt, [a1,a2])
1064 translateOp [r] DoubleLtOp [a1,a2] = Just (Just1 r, MO_Dbl_Lt, [a1,a2])
1066 translateOp [r] DoubleAddOp [a1,a2] = Just (Just1 r, MO_Dbl_Add, [a1,a2])
1067 translateOp [r] DoubleSubOp [a1,a2] = Just (Just1 r, MO_Dbl_Sub, [a1,a2])
1068 translateOp [r] DoubleMulOp [a1,a2] = Just (Just1 r, MO_Dbl_Mul, [a1,a2])
1069 translateOp [r] DoubleDivOp [a1,a2] = Just (Just1 r, MO_Dbl_Div, [a1,a2])
1070 translateOp [r] DoublePowerOp [a1,a2] = Just (Just1 r, MO_Dbl_Pwr, [a1,a2])
1072 translateOp [r] DoubleSinOp [a1] = Just (Just1 r, MO_Dbl_Sin, [a1])
1073 translateOp [r] DoubleCosOp [a1] = Just (Just1 r, MO_Dbl_Cos, [a1])
1074 translateOp [r] DoubleTanOp [a1] = Just (Just1 r, MO_Dbl_Tan, [a1])
1075 translateOp [r] DoubleSinhOp [a1] = Just (Just1 r, MO_Dbl_Sinh, [a1])
1076 translateOp [r] DoubleCoshOp [a1] = Just (Just1 r, MO_Dbl_Cosh, [a1])
1077 translateOp [r] DoubleTanhOp [a1] = Just (Just1 r, MO_Dbl_Tanh, [a1])
1078 translateOp [r] DoubleAsinOp [a1] = Just (Just1 r, MO_Dbl_Asin, [a1])
1079 translateOp [r] DoubleAcosOp [a1] = Just (Just1 r, MO_Dbl_Acos, [a1])
1080 translateOp [r] DoubleAtanOp [a1] = Just (Just1 r, MO_Dbl_Atan, [a1])
1081 translateOp [r] DoubleLogOp [a1] = Just (Just1 r, MO_Dbl_Log, [a1])
1082 translateOp [r] DoubleExpOp [a1] = Just (Just1 r, MO_Dbl_Exp, [a1])
1083 translateOp [r] DoubleSqrtOp [a1] = Just (Just1 r, MO_Dbl_Sqrt, [a1])
1084 translateOp [r] DoubleNegOp [a1] = Just (Just1 r, MO_Dbl_Neg, [a1])
1088 translateOp [r] FloatEqOp [a1,a2] = Just (Just1 r, MO_Flt_Eq, [a1,a2])
1089 translateOp [r] FloatNeOp [a1,a2] = Just (Just1 r, MO_Flt_Ne, [a1,a2])
1090 translateOp [r] FloatGeOp [a1,a2] = Just (Just1 r, MO_Flt_Ge, [a1,a2])
1091 translateOp [r] FloatLeOp [a1,a2] = Just (Just1 r, MO_Flt_Le, [a1,a2])
1092 translateOp [r] FloatGtOp [a1,a2] = Just (Just1 r, MO_Flt_Gt, [a1,a2])
1093 translateOp [r] FloatLtOp [a1,a2] = Just (Just1 r, MO_Flt_Lt, [a1,a2])
1095 translateOp [r] FloatAddOp [a1,a2] = Just (Just1 r, MO_Flt_Add, [a1,a2])
1096 translateOp [r] FloatSubOp [a1,a2] = Just (Just1 r, MO_Flt_Sub, [a1,a2])
1097 translateOp [r] FloatMulOp [a1,a2] = Just (Just1 r, MO_Flt_Mul, [a1,a2])
1098 translateOp [r] FloatDivOp [a1,a2] = Just (Just1 r, MO_Flt_Div, [a1,a2])
1099 translateOp [r] FloatPowerOp [a1,a2] = Just (Just1 r, MO_Flt_Pwr, [a1,a2])
1101 translateOp [r] FloatSinOp [a1] = Just (Just1 r, MO_Flt_Sin, [a1])
1102 translateOp [r] FloatCosOp [a1] = Just (Just1 r, MO_Flt_Cos, [a1])
1103 translateOp [r] FloatTanOp [a1] = Just (Just1 r, MO_Flt_Tan, [a1])
1104 translateOp [r] FloatSinhOp [a1] = Just (Just1 r, MO_Flt_Sinh, [a1])
1105 translateOp [r] FloatCoshOp [a1] = Just (Just1 r, MO_Flt_Cosh, [a1])
1106 translateOp [r] FloatTanhOp [a1] = Just (Just1 r, MO_Flt_Tanh, [a1])
1107 translateOp [r] FloatAsinOp [a1] = Just (Just1 r, MO_Flt_Asin, [a1])
1108 translateOp [r] FloatAcosOp [a1] = Just (Just1 r, MO_Flt_Acos, [a1])
1109 translateOp [r] FloatAtanOp [a1] = Just (Just1 r, MO_Flt_Atan, [a1])
1110 translateOp [r] FloatLogOp [a1] = Just (Just1 r, MO_Flt_Log, [a1])
1111 translateOp [r] FloatExpOp [a1] = Just (Just1 r, MO_Flt_Exp, [a1])
1112 translateOp [r] FloatSqrtOp [a1] = Just (Just1 r, MO_Flt_Sqrt, [a1])
1113 translateOp [r] FloatNegOp [a1] = Just (Just1 r, MO_Flt_Neg, [a1])
1117 translateOp [r] Int2DoubleOp [a1] = Just (Just1 r, MO_NatS_to_Dbl, [a1])
1118 translateOp [r] Double2IntOp [a1] = Just (Just1 r, MO_Dbl_to_NatS, [a1])
1120 translateOp [r] Int2FloatOp [a1] = Just (Just1 r, MO_NatS_to_Flt, [a1])
1121 translateOp [r] Float2IntOp [a1] = Just (Just1 r, MO_Flt_to_NatS, [a1])
1123 translateOp [r] Float2DoubleOp [a1] = Just (Just1 r, MO_Flt_to_Dbl, [a1])
1124 translateOp [r] Double2FloatOp [a1] = Just (Just1 r, MO_Dbl_to_Flt, [a1])
1126 translateOp [r] Int2WordOp [a1] = Just (Just1 r, MO_NatS_to_NatU, [a1])
1127 translateOp [r] Word2IntOp [a1] = Just (Just1 r, MO_NatU_to_NatS, [a1])
1129 translateOp [r] Int2AddrOp [a1] = Just (Just1 r, MO_NatS_to_NatP, [a1])
1130 translateOp [r] Addr2IntOp [a1] = Just (Just1 r, MO_NatP_to_NatS, [a1])
1132 translateOp [r] OrdOp [a1] = Just (Just1 r, MO_32U_to_NatS, [a1])
1133 translateOp [r] ChrOp [a1] = Just (Just1 r, MO_NatS_to_32U, [a1])
1135 translateOp [r] Narrow8IntOp [a1] = Just (Just1 r, MO_8S_to_NatS, [a1])
1136 translateOp [r] Narrow16IntOp [a1] = Just (Just1 r, MO_16S_to_NatS, [a1])
1137 translateOp [r] Narrow32IntOp [a1] = Just (Just1 r, MO_32S_to_NatS, [a1])
1139 translateOp [r] Narrow8WordOp [a1] = Just (Just1 r, MO_8U_to_NatU, [a1])
1140 translateOp [r] Narrow16WordOp [a1] = Just (Just1 r, MO_16U_to_NatU, [a1])
1141 translateOp [r] Narrow32WordOp [a1] = Just (Just1 r, MO_32U_to_NatU, [a1])
1143 translateOp [r] SameMutVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1144 translateOp [r] SameMVarOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1145 translateOp [r] SameMutableArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1146 translateOp [r] SameMutableByteArrayOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1147 translateOp [r] EqForeignObj [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1148 translateOp [r] EqStablePtrOp [a1,a2] = Just (Just1 r, MO_Nat_Eq, [a1,a2])
1150 translateOp _ _ _ = Nothing