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