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