ghc/compiler/absCSyn/AbsCUtils.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[AbsCUtils]{Help functions for Abstract~C datatype}
   5
   6 \begin{code}
   7 module AbsCUtils (
   8         nonemptyAbsC,
   9         mkAbstractCs, mkAbsCStmts,
  10         mkAlgAltsCSwitch,
  11         magicIdPrimRep,
  12         getAmodeRep,
  13         mixedTypeLocn, mixedPtrLocn,
  14         flattenAbsC,
  15         mkAbsCStmtList
  16
  17         -- printing/forcing stuff comes from PprAbsC
  18     ) where
  19
  20 #include "HsVersions.h"
  21
  22 import AbsCSyn
  23 import Digraph          ( stronglyConnComp, SCC(..) )
  24 import DataCon          ( fIRST_TAG, ConTag )
  25 import Literal          ( literalPrimRep, mkMachWord )
  26 import PrimRep          ( getPrimRepSize, PrimRep(..) )
  27 import Unique           ( Unique{-instance Eq-} )
  28 import UniqSupply       ( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
  29                           UniqSupply )
  30 import CmdLineOpts      ( opt_OutputLanguage, opt_EmitCExternDecls )
  31 import PrimOp           ( PrimOp(..), CCall(..), isDynamicTarget )
  32 import Panic            ( panic )
  33
  34 import Maybe            ( isJust )
  35
  36 infixr 9 `thenFlt`
  37 \end{code}
  38
  39 Check if there is any real code in some Abstract~C.  If so, return it
  40 (@Just ...@); otherwise, return @Nothing@.  Don't be too strict!
  41
  42 It returns the "reduced" code in the Just part so that the work of
  43 discarding AbsCNops isn't lost, and so that if the caller uses
  44 the reduced version there's less danger of a big tree of AbsCNops getting
  45 materialised and causing a space leak.
  46
  47 \begin{code}
  48 nonemptyAbsC :: AbstractC -> Maybe AbstractC
  49 nonemptyAbsC  AbsCNop           = Nothing
  50 nonemptyAbsC (AbsCStmts s1 s2)  = case (nonemptyAbsC s1) of
  51                                     Nothing -> nonemptyAbsC s2
  52                                     Just x  -> Just (AbsCStmts x s2)
  53 nonemptyAbsC s@(CSimultaneous c) = case (nonemptyAbsC c) of
  54                                     Nothing -> Nothing
  55                                     Just x  -> Just s
  56 nonemptyAbsC other              = Just other
  57 \end{code}
  58
  59 \begin{code}
  60 mkAbstractCs :: [AbstractC] -> AbstractC
  61 mkAbstractCs [] = AbsCNop
  62 mkAbstractCs cs = foldr1 mkAbsCStmts cs
  63
  64 -- for fiddling around w/ killing off AbsCNops ... (ToDo)
  65 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
  66 mkAbsCStmts AbsCNop c = c
  67 mkAbsCStmts c AbsCNop = c
  68 mkAbsCStmts c1 c2     = c1 `AbsCStmts` c2
  69
  70 {- Discarded SLPJ June 95; it calls nonemptyAbsC too much!
  71   = case (case (nonemptyAbsC abc2) of
  72             Nothing -> AbsCNop
  73             Just d2 -> d2)      of { abc2b ->
  74
  75     case (nonemptyAbsC abc1) of {
  76       Nothing -> abc2b;
  77       Just d1 -> AbsCStmts d1 abc2b
  78     } }
  79 -}
  80 \end{code}
  81
  82 Get the sho' 'nuff statements out of an @AbstractC@.
  83 \begin{code}
  84 mkAbsCStmtList :: AbstractC -> [AbstractC]
  85
  86 mkAbsCStmtList absC = mkAbsCStmtList' absC []
  87
  88 -- Optimised a la foldr/build!
  89
  90 mkAbsCStmtList'  AbsCNop r = r
  91
  92 mkAbsCStmtList' (AbsCStmts s1 s2) r
  93   = mkAbsCStmtList' s1 (mkAbsCStmtList' s2 r)
  94
  95 mkAbsCStmtList' s@(CSimultaneous c) r
  96   = if null (mkAbsCStmtList c) then r else s : r
  97
  98 mkAbsCStmtList' other r = other : r
  99 \end{code}
 100
 101 \begin{code}
 102 mkAlgAltsCSwitch :: CAddrMode -> [(ConTag, AbstractC)] -> AbstractC -> AbstractC
 103
 104 mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc
 105  | isJust (nonemptyAbsC deflt_absc)
 106         = CSwitch scrutinee (adjust tagged_alts) deflt_absc
 107  | otherwise
 108         = CSwitch scrutinee (adjust rest) first_alt
 109  where
 110    -- it's ok to convert one of the alts into a default if we don't already have
 111    -- one, because this is an algebraic case and we're guaranteed that the tag
 112    -- will match one of the branches.
 113    ((tag,first_alt):rest) = tagged_alts
 114
 115    -- Adjust the tags in the switch to start at zero.
 116    -- This is the convention used by primitive ops which return algebraic
 117    -- data types.  Why?  Because for two-constructor types, zero is faster
 118    -- to create and distinguish from 1 than are 1 and 2.
 119
 120    -- We also need to convert to Literals to keep the CSwitch happy
 121    adjust tagged_alts
 122      = [ (mkMachWord (toInteger (tag - fIRST_TAG)), abs_c)
 123        | (tag, abs_c) <- tagged_alts ]
 124 \end{code}
 125
 126 %************************************************************************
 127 %*                                                                      *
 128 \subsubsection[AbsCUtils-kinds-from-MagicIds]{Kinds from MagicIds}
 129 %*                                                                      *
 130 %************************************************************************
 131
 132 \begin{code}
 133 magicIdPrimRep BaseReg              = PtrRep
 134 magicIdPrimRep (VanillaReg kind _) = kind
 135 magicIdPrimRep (FloatReg _)         = FloatRep
 136 magicIdPrimRep (DoubleReg _)        = DoubleRep
 137 magicIdPrimRep (LongReg kind _)     = kind
 138 magicIdPrimRep Sp                   = PtrRep
 139 magicIdPrimRep Su                   = PtrRep
 140 magicIdPrimRep SpLim                = PtrRep
 141 magicIdPrimRep Hp                   = PtrRep
 142 magicIdPrimRep HpLim                = PtrRep
 143 magicIdPrimRep CurCostCentre        = CostCentreRep
 144 magicIdPrimRep VoidReg              = VoidRep
 145 magicIdPrimRep CurrentTSO           = ThreadIdRep
 146 magicIdPrimRep CurrentNursery       = PtrRep
 147 \end{code}
 148
 149 %************************************************************************
 150 %*                                                                      *
 151 \subsection[AbsCUtils-amode-kinds]{Finding @PrimitiveKinds@ of amodes}
 152 %*                                                                      *
 153 %************************************************************************
 154
 155 See also the return conventions for unboxed things; currently living
 156 in @CgCon@ (next to the constructor return conventions).
 157
 158 ToDo: tiny tweaking may be in order
 159 \begin{code}
 160 getAmodeRep :: CAddrMode -> PrimRep
 161
 162 getAmodeRep (CVal _ kind)                   = kind
 163 getAmodeRep (CAddr _)                       = PtrRep
 164 getAmodeRep (CReg magic_id)                 = magicIdPrimRep magic_id
 165 getAmodeRep (CTemp uniq kind)               = kind
 166 getAmodeRep (CLbl _ kind)                   = kind
 167 getAmodeRep (CCharLike _)                   = PtrRep
 168 getAmodeRep (CIntLike _)                    = PtrRep
 169 getAmodeRep (CLit lit)                      = literalPrimRep lit
 170 getAmodeRep (CMacroExpr kind _ _)           = kind
 171 getAmodeRep (CJoinPoint _)                  = panic "getAmodeRep:CJoinPoint"
 172 \end{code}
 173
 174 @mixedTypeLocn@ tells whether an amode identifies an ``StgWord''
 175 location; that is, one which can contain values of various types.
 176
 177 \begin{code}
 178 mixedTypeLocn :: CAddrMode -> Bool
 179
 180 mixedTypeLocn (CVal (NodeRel _) _)      = True
 181 mixedTypeLocn (CVal (SpRel _)   _)      = True
 182 mixedTypeLocn (CVal (HpRel _)   _)      = True
 183 mixedTypeLocn other                     = False -- All the rest
 184 \end{code}
 185
 186 @mixedPtrLocn@ tells whether an amode identifies a
 187 location which can contain values of various pointer types.
 188
 189 \begin{code}
 190 mixedPtrLocn :: CAddrMode -> Bool
 191
 192 mixedPtrLocn (CVal (SpRel _)  _)        = True
 193 mixedPtrLocn other                      = False -- All the rest
 194 \end{code}
 195
 196 %************************************************************************
 197 %*                                                                      *
 198 \subsection[AbsCUtils-flattening]{Flatten Abstract~C}
 199 %*                                                                      *
 200 %************************************************************************
 201
 202 The following bits take ``raw'' Abstract~C, which may have all sorts of
 203 nesting, and flattens it into one long @AbsCStmtList@.  Mainly,
 204 @CClosureInfos@ and code for switches are pulled out to the top level.
 205
 206 The various functions herein tend to produce
 207 \begin{enumerate}
 208 \item
 209 A {\em flattened} \tr{<something>} of interest for ``here'', and
 210 \item
 211 Some {\em unflattened} Abstract~C statements to be carried up to the
 212 top-level.  The only real reason (now) that it is unflattened is
 213 because it means the recursive flattening can be done in just one
 214 place rather than having to remember lots of places.
 215 \end{enumerate}
 216
 217 Care is taken to reduce the occurrence of forward references, while still
 218 keeping laziness a much as possible.  Essentially, this means that:
 219 \begin{itemize}
 220 \item
 221 {\em All} the top-level C statements resulting from flattening a
 222 particular AbsC statement (whether the latter is nested or not) appear
 223 before {\em any} of the code for a subsequent AbsC statement;
 224 \item
 225 but stuff nested within any AbsC statement comes
 226 out before the code for the statement itself.
 227 \end{itemize}
 228
 229 The ``stuff to be carried up'' always includes a label: a
 230 @CStaticClosure@, @CRetDirect@, @CFlatRetVector@, or
 231 @CCodeBlock@.  The latter turns into a C function, and is never
 232 actually produced by the code generator.  Rather it always starts life
 233 as a @CCodeBlock@ addressing mode; when such an addr mode is
 234 flattened, the ``tops'' stuff is a @CCodeBlock@.
 235
 236 \begin{code}
 237 flattenAbsC :: UniqSupply -> AbstractC -> AbstractC
 238
 239 flattenAbsC us abs_C
 240   = case (initFlt us (flatAbsC abs_C)) of { (here, tops) ->
 241     here `mkAbsCStmts` tops }
 242 \end{code}
 243
 244 %************************************************************************
 245 %*                                                                      *
 246 \subsubsection{Flattening monadery}
 247 %*                                                                      *
 248 %************************************************************************
 249
 250 The flattener is monadised.  It's just a @UniqueSupply@.
 251
 252 \begin{code}
 253 type FlatM result =  UniqSupply -> result
 254
 255 initFlt :: UniqSupply -> FlatM a -> a
 256
 257 initFlt init_us m = m init_us
 258
 259 {-# INLINE thenFlt #-}
 260 {-# INLINE returnFlt #-}
 261
 262 thenFlt :: FlatM a -> (a -> FlatM b) -> FlatM b
 263
 264 thenFlt expr cont us
 265   = case (splitUniqSupply us)   of { (s1, s2) ->
 266     case (expr s1)              of { result ->
 267     cont result s2 }}
 268
 269 returnFlt :: a -> FlatM a
 270 returnFlt result us = result
 271
 272 mapFlt :: (a -> FlatM b) -> [a] -> FlatM [b]
 273
 274 mapFlt f []     = returnFlt []
 275 mapFlt f (x:xs)
 276   = f x         `thenFlt` \ r  ->
 277     mapFlt f xs `thenFlt` \ rs ->
 278     returnFlt (r:rs)
 279
 280 mapAndUnzipFlt  :: (a -> FlatM (b,c))   -> [a] -> FlatM ([b],[c])
 281
 282 mapAndUnzipFlt f [] = returnFlt ([],[])
 283 mapAndUnzipFlt f (x:xs)
 284   = f x                 `thenFlt` \ (r1,  r2)  ->
 285     mapAndUnzipFlt f xs `thenFlt` \ (rs1, rs2) ->
 286     returnFlt (r1:rs1, r2:rs2)
 287
 288 getUniqFlt :: FlatM Unique
 289 getUniqFlt us = uniqFromSupply us
 290
 291 getUniqsFlt :: Int -> FlatM [Unique]
 292 getUniqsFlt i us = uniqsFromSupply i us
 293 \end{code}
 294
 295 %************************************************************************
 296 %*                                                                      *
 297 \subsubsection{Flattening the top level}
 298 %*                                                                      *
 299 %************************************************************************
 300
 301 \begin{code}
 302 flatAbsC :: AbstractC
 303          -> FlatM (AbstractC,   -- Stuff to put inline          [Both are fully
 304                    AbstractC)   -- Stuff to put at top level     flattened]
 305
 306 flatAbsC AbsCNop = returnFlt (AbsCNop, AbsCNop)
 307
 308 flatAbsC (AbsCStmts s1 s2)
 309   = flatAbsC s1 `thenFlt` \ (inline_s1, top_s1) ->
 310     flatAbsC s2 `thenFlt` \ (inline_s2, top_s2) ->
 311     returnFlt (mkAbsCStmts inline_s1 inline_s2,
 312                mkAbsCStmts top_s1    top_s2)
 313
 314 flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
 315   = flatAbsC slow               `thenFlt` \ (slow_heres, slow_tops) ->
 316     flat_maybe maybe_fast       `thenFlt` \ (fast_heres, fast_tops) ->
 317     returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
 318        CClosureInfoAndCode cl_info slow_heres fast_heres descr]
 319     )
 320
 321 flatAbsC (CCodeBlock lbl abs_C)
 322   = flatAbsC abs_C          `thenFlt` \ (absC_heres, absC_tops) ->
 323     returnFlt (AbsCNop, absC_tops `mkAbsCStmts` CCodeBlock lbl absC_heres)
 324
 325 flatAbsC (CRetDirect uniq slow_code srt liveness)
 326   = flatAbsC slow_code          `thenFlt` \ (heres, tops) ->
 327     returnFlt (AbsCNop,
 328                 mkAbstractCs [ tops, CRetDirect uniq heres srt liveness ])
 329
 330 flatAbsC (CSwitch discrim alts deflt)
 331   = mapAndUnzipFlt flat_alt alts `thenFlt` \ (flat_alts, flat_alts_tops) ->
 332     flatAbsC deflt               `thenFlt` \ (flat_def_alt, def_tops) ->
 333     returnFlt (
 334       CSwitch discrim flat_alts flat_def_alt,
 335       mkAbstractCs (def_tops : flat_alts_tops)
 336     )
 337   where
 338     flat_alt (tag, absC)
 339       = flatAbsC absC   `thenFlt` \ (alt_heres, alt_tops) ->
 340         returnFlt ( (tag, alt_heres), alt_tops )
 341
 342 flatAbsC stmt@(COpStmt results (CCallOp ccall@(CCall target is_asm _ _)) args vol_regs)
 343   | isCandidate && opt_OutputLanguage == Just "C"       -- Urgh
 344   = returnFlt (stmt, tdef)
 345   | otherwise
 346   = returnFlt (stmt, AbsCNop)
 347   where
 348     isCandidate = is_dynamic || opt_EmitCExternDecls && not is_asm
 349     is_dynamic  = isDynamicTarget target
 350
 351     tdef = CCallTypedef is_dynamic ccall results args
 352
 353 flatAbsC stmt@(CSimultaneous abs_c)
 354   = flatAbsC abs_c              `thenFlt` \ (stmts_here, tops) ->
 355     doSimultaneously stmts_here `thenFlt` \ new_stmts_here ->
 356     returnFlt (new_stmts_here, tops)
 357
 358 flatAbsC stmt@(CCheck macro amodes code)
 359   = flatAbsC code               `thenFlt` \ (code_here, code_tops) ->
 360     returnFlt (CCheck macro amodes code_here, code_tops)
 361
 362 -- the TICKY_CTR macro always needs to be hoisted out to the top level.
 363 -- This is a HACK.
 364 flatAbsC stmt@(CCallProfCtrMacro str amodes)
 365   | str == SLIT("TICK_CTR")     = returnFlt (AbsCNop, stmt)
 366   | otherwise                   = returnFlt (stmt, AbsCNop)
 367
 368 -- Some statements need no flattening at all:
 369 flatAbsC stmt@(CMacroStmt macro amodes)         = returnFlt (stmt, AbsCNop)
 370 flatAbsC stmt@(CCallProfCCMacro str amodes)     = returnFlt (stmt, AbsCNop)
 371 flatAbsC stmt@(CAssign dest source)             = returnFlt (stmt, AbsCNop)
 372 flatAbsC stmt@(CJump target)                    = returnFlt (stmt, AbsCNop)
 373 flatAbsC stmt@(CFallThrough target)             = returnFlt (stmt, AbsCNop)
 374 flatAbsC stmt@(CReturn target return_info)      = returnFlt (stmt, AbsCNop)
 375 flatAbsC stmt@(CInitHdr a b cc)                 = returnFlt (stmt, AbsCNop)
 376 flatAbsC stmt@(COpStmt results op args vol_regs)= returnFlt (stmt, AbsCNop)
 377
 378 -- Some statements only make sense at the top level, so we always float
 379 -- them.  This probably isn't necessary.
 380 flatAbsC stmt@(CStaticClosure _ _ _ _)          = returnFlt (AbsCNop, stmt)
 381 flatAbsC stmt@(CClosureTbl _)                   = returnFlt (AbsCNop, stmt)
 382 flatAbsC stmt@(CSRT _ _)                        = returnFlt (AbsCNop, stmt)
 383 flatAbsC stmt@(CBitmap _ _)                     = returnFlt (AbsCNop, stmt)
 384 flatAbsC stmt@(CCostCentreDecl _ _)             = returnFlt (AbsCNop, stmt)
 385 flatAbsC stmt@(CCostCentreStackDecl _)          = returnFlt (AbsCNop, stmt)
 386 flatAbsC stmt@(CSplitMarker)                    = returnFlt (AbsCNop, stmt)
 387 flatAbsC stmt@(CRetVector _ _ _ _)              = returnFlt (AbsCNop, stmt)
 388 flatAbsC stmt@(CModuleInitBlock _ _)            = returnFlt (AbsCNop, stmt)
 389 \end{code}
 390
 391 \begin{code}
 392 flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
 393 flat_maybe Nothing      = returnFlt (Nothing, AbsCNop)
 394 flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) ->
 395                           returnFlt (Just heres, tops)
 396 \end{code}
 397
 398 %************************************************************************
 399 %*                                                                      *
 400 \subsection[flat-simultaneous]{Doing things simultaneously}
 401 %*                                                                      *
 402 %************************************************************************
 403
 404 \begin{code}
 405 doSimultaneously :: AbstractC -> FlatM AbstractC
 406 \end{code}
 407
 408 Generate code to perform the @CAssign@s and @COpStmt@s in the
 409 input simultaneously, using temporary variables when necessary.
 410
 411 We use the strongly-connected component algorithm, in which
 412         * the vertices are the statements
 413         * an edge goes from s1 to s2 iff
 414                 s1 assigns to something s2 uses
 415           that is, if s1 should *follow* s2 in the final order
 416
 417 \begin{code}
 418 type CVertex = (Int, AbstractC)  -- Give each vertex a unique number,
 419                                  -- for fast comparison
 420
 421 type CEdge = (CVertex, CVertex)
 422
 423 doSimultaneously abs_c
 424   = let
 425         enlisted = en_list abs_c
 426     in
 427     case enlisted of -- it's often just one stmt
 428       []  -> returnFlt AbsCNop
 429       [x] -> returnFlt x
 430       _   -> doSimultaneously1 (zip [(1::Int)..] enlisted)
 431
 432 -- en_list puts all the assignments in a list, filtering out Nops and
 433 -- assignments which do nothing
 434 en_list AbsCNop                               = []
 435 en_list (AbsCStmts a1 a2)                     = en_list a1 ++ en_list a2
 436 en_list (CAssign am1 am2) | sameAmode am1 am2 = []
 437 en_list other                                 = [other]
 438
 439 sameAmode :: CAddrMode -> CAddrMode -> Bool
 440 -- ToDo: Move this function, or make CAddrMode an instance of Eq
 441 -- At the moment we put in just enough to catch the cases we want:
 442 --      the second (destination) argument is always a CVal.
 443 sameAmode (CReg r1)                  (CReg r2)               = r1 == r2
 444 sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _)            = r1 ==# r2
 445 sameAmode other1                     other2                  = False
 446
 447 doSimultaneously1 :: [CVertex] -> FlatM AbstractC
 448 doSimultaneously1 vertices
 449   = let
 450         edges = [ (vertex, key1, edges_from stmt1)
 451                 | vertex@(key1, stmt1) <- vertices
 452                 ]
 453         edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,
 454                                     stmt1 `should_follow` stmt2
 455                            ]
 456         components = stronglyConnComp edges
 457
 458         -- do_components deal with one strongly-connected component
 459                 -- Not cyclic, or singleton?  Just do it
 460         do_component (AcyclicSCC (n,abs_c))  = returnFlt abs_c
 461         do_component (CyclicSCC [(n,abs_c)]) = returnFlt abs_c
 462
 463                 -- Cyclic?  Then go via temporaries.  Pick one to
 464                 -- break the loop and try again with the rest.
 465         do_component (CyclicSCC ((n,first_stmt) : rest))
 466           = doSimultaneously1 rest      `thenFlt` \ abs_cs ->
 467             go_via_temps first_stmt     `thenFlt` \ (to_temps, from_temps) ->
 468             returnFlt (mkAbstractCs [to_temps, abs_cs, from_temps])
 469
 470         go_via_temps (CAssign dest src)
 471           = getUniqFlt                  `thenFlt` \ uniq ->
 472             let
 473                 the_temp = CTemp uniq (getAmodeRep dest)
 474             in
 475             returnFlt (CAssign the_temp src, CAssign dest the_temp)
 476
 477         go_via_temps (COpStmt dests op srcs vol_regs)
 478           = getUniqsFlt (length dests)  `thenFlt` \ uniqs ->
 479             let
 480                 the_temps = zipWith (\ u d -> CTemp u (getAmodeRep d)) uniqs dests
 481             in
 482             returnFlt (COpStmt the_temps op srcs vol_regs,
 483                        mkAbstractCs (zipWith CAssign dests the_temps))
 484     in
 485     mapFlt do_component components `thenFlt` \ abs_cs ->
 486     returnFlt (mkAbstractCs abs_cs)
 487
 488   where
 489     should_follow :: AbstractC -> AbstractC -> Bool
 490     (CAssign dest1 _) `should_follow` (CAssign _ src2)
 491       = dest1 `conflictsWith` src2
 492     (COpStmt dests1 _ _ _) `should_follow` (CAssign _ src2)
 493       = or [dest1 `conflictsWith` src2 | dest1 <- dests1]
 494     (CAssign dest1 _)`should_follow` (COpStmt _ _ srcs2 _)
 495       = or [dest1 `conflictsWith` src2 | src2 <- srcs2]
 496     (COpStmt dests1 _ _ _) `should_follow` (COpStmt _ _ srcs2 _)
 497       = or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
 498
 499 --    (COpStmt _ _ _ _ _) `should_follow` (CCallProfCtrMacro _ _) = False
 500 --    (CCallProfCtrMacro _ _) `should_follow` (COpStmt _ _ _ _ _) = False
 501
 502
 503 \end{code}
 504
 505
 506 @conflictsWith@ tells whether an assignment to its first argument will
 507 screw up an access to its second.
 508
 509 \begin{code}
 510 conflictsWith :: CAddrMode -> CAddrMode -> Bool
 511 (CReg reg1)        `conflictsWith` (CReg reg2)          = reg1 == reg2
 512 (CReg reg)         `conflictsWith` (CVal reg_rel _)     = reg `regConflictsWithRR` reg_rel
 513 (CReg reg)         `conflictsWith` (CAddr reg_rel)      = reg `regConflictsWithRR` reg_rel
 514 (CTemp u1 _)       `conflictsWith` (CTemp u2 _)         = u1 == u2
 515 (CVal reg_rel1 k1) `conflictsWith` (CVal reg_rel2 k2)
 516   = rrConflictsWithRR (getPrimRepSize k1) (getPrimRepSize k2) reg_rel1 reg_rel2
 517
 518 other1            `conflictsWith` other2                = False
 519 -- CAddr and literals are impossible on the LHS of an assignment
 520
 521 regConflictsWithRR :: MagicId -> RegRelative -> Bool
 522
 523 regConflictsWithRR (VanillaReg k _ILIT(1)) (NodeRel _)  = True
 524
 525 regConflictsWithRR Sp   (SpRel _)       = True
 526 regConflictsWithRR Hp   (HpRel _)       = True
 527 regConflictsWithRR _    _               = False
 528
 529 rrConflictsWithRR :: Int -> Int                 -- Sizes of two things
 530                   -> RegRelative -> RegRelative -- The two amodes
 531                   -> Bool
 532
 533 rrConflictsWithRR (I# s1) (I# s2) rr1 rr2 = rr rr1 rr2
 534   where
 535     rr (SpRel o1)    (SpRel o2)
 536         | s1 ==# _ILIT(0) || s2 ==# _ILIT(0) = False -- No conflict if either is size zero
 537         | s1 ==# _ILIT(1)  && s2 ==# _ILIT(1) = o1 ==# o2
 538         | otherwise          = (o1 +# s1) >=# o2  &&
 539                                (o2 +# s2) >=# o1
 540
 541     rr (NodeRel o1)      (NodeRel o2)
 542         | s1 ==# _ILIT(0) || s2 ==# _ILIT(0) = False -- No conflict if either is size zero
 543         | s1 ==# _ILIT(1) && s2 ==# _ILIT(1) = o1 ==# o2
 544         | otherwise          = True             -- Give up
 545
 546     rr (HpRel _)         (HpRel _)    = True    -- Give up (ToDo)
 547
 548     rr other1            other2       = False
 549 \end{code}