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