ghc/compiler/absCSyn/AbsCSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[AbstractC]{Abstract C: the last stop before machine code}
   5
   6 This ``Abstract C'' data type describes the raw Spineless Tagless
   7 machine model at a C-ish level; it is ``abstract'' in that it only
   8 includes C-like structures that we happen to need.  The conversion of
   9 programs from @StgSyntax@ (basically a functional language) to
  10 @AbstractC@ (basically imperative C) is the heart of code generation.
  11 From @AbstractC@, one may convert to real C (for portability) or to
  12 raw assembler/machine code.
  13
  14 \begin{code}
  15 #include "HsVersions.h"
  16
  17 module AbsCSyn (
  18         -- export everything
  19         AbstractC(..),
  20         CStmtMacro(..),
  21         CExprMacro(..),
  22         CAddrMode(..),
  23         ReturnInfo(..),
  24         mkAbstractCs, mkAbsCStmts, mkAlgAltsCSwitch,
  25         mkIntCLit,
  26         mkAbsCStmtList,
  27         mkCCostCentre,
  28
  29         -- HeapOffsets, plus some convenient synonyms...
  30         HeapOffset,
  31         zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize,
  32         maxOff, addOff, subOff, intOffsetIntoGoods,
  33         isZeroOff, possiblyEqualHeapOffset,
  34         pprHeapOffset,
  35         VirtualHeapOffset(..), HpRelOffset(..),
  36         VirtualSpAOffset(..), VirtualSpBOffset(..),
  37         SpARelOffset(..), SpBRelOffset(..),
  38
  39         -- RegRelatives
  40         RegRelative(..),
  41
  42         -- registers
  43         MagicId(..), node, infoptr,
  44         isVolatileReg,
  45
  46         -- closure info
  47         ClosureInfo, LambdaFormInfo, UpdateFlag, SMRep,
  48
  49         -- stuff from AbsCFuns and PprAbsC...
  50         nonemptyAbsC, flattenAbsC, getAmodeKind,
  51         mixedTypeLocn, mixedPtrLocn,
  52 #ifdef __GLASGOW_HASKELL__
  53         writeRealC,
  54 #endif
  55         dumpRealC,
  56         kindFromMagicId, -- UNUSED: getDestinationRegs,
  57         amodeCanSurviveGC,
  58
  59 #ifdef GRAN
  60         CostRes(Cost),
  61 #endif
  62
  63         -- and stuff to make the interface self-sufficient
  64         Outputable(..), NamedThing(..),
  65         PrettyRep, ExportFlag, SrcLoc, Unique,
  66         CSeq, PprStyle, Pretty(..), Unpretty(..),
  67         -- blargh...
  68         UniType,
  69
  70         PrimKind(..), -- re-exported NON-ABSTRACTLY
  71         BasicLit(..), mkMachInt, mkMachWord,   -- re-exported NON-ABSTRACTLY
  72         Id, ConTag(..), Maybe, PrimOp, SplitUniqSupply, TyCon,
  73         CLabel, GlobalSwitch, CostCentre,
  74         SimplifierSwitch, UniqSet(..), UniqFM, StgExpr, StgAtom
  75     ) where
  76
  77 import AbsCFuns         -- used, and re-exported
  78 import ClosureInfo      -- ditto
  79 import Costs
  80 import PprAbsC          -- ditto
  81 import HeapOffs         hiding ( hpRelToInt )
  82
  83 import AbsPrel          ( PrimOp
  84                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
  85                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
  86                         )
  87 import CLabelInfo
  88 import CmdLineOpts      ( GlobalSwitch(..), SimplifierSwitch )
  89 import BasicLit         ( mkMachInt, mkMachWord, BasicLit(..) )
  90 import Id               ( Id, ConTag(..), DataCon(..) )
  91 import Maybes           ( Maybe )
  92 import Outputable
  93 import Unpretty         -- ********** NOTE **********
  94 import PrimKind         ( PrimKind(..) )
  95 import CostCentre       -- for CostCentre type
  96 import StgSyn           ( StgExpr, StgAtom, StgBinderInfo )
  97 import UniqSet          ( UniqSet(..), UniqFM )
  98 import Unique           ( Unique )
  99 import Util
 100
 101 #ifndef DPH
 102 import CgCompInfo       ( mAX_Vanilla_REG, mAX_Float_REG, mAX_Double_REG )
 103 #else
 104 import CgCompInfo       ( spARelToInt, spBRelToInt )
 105 import DapInfo          ( virtualHeapOffsetToInt   )
 106 #endif {- Data Parallel Haskell -}
 107 \end{code}
 108
 109 @AbstractC@ is a list of Abstract~C statements, but the data structure
 110 is tree-ish, for easier and more efficient putting-together.
 111 \begin{code}
 112 data AbstractC
 113   = AbsCNop
 114   | AbsCStmts           AbstractC AbstractC
 115
 116   -- and the individual stmts...
 117 \end{code}
 118
 119 A note on @CAssign@: In general, the type associated with an assignment
 120 is the type of the lhs.  However, when the lhs is a pointer to mixed
 121 types (e.g. SpB relative), the type of the assignment is the type of
 122 the rhs for float types, or the generic StgWord for all other types.
 123 (In particular, a CharKind on the rhs is promoted to IntKind when
 124 stored in a mixed type location.)
 125
 126 \begin{code}
 127   | CAssign
 128         CAddrMode       -- target
 129         CAddrMode       -- source
 130
 131   | CJump
 132         CAddrMode       -- Put this in the program counter
 133                         -- eg `CJump (CReg (VanillaReg PtrKind 1))' puts Ret1 in PC
 134                         -- Enter can be done by:
 135                         --        CJump (CVal NodeRel zeroOff)
 136
 137   | CFallThrough
 138         CAddrMode       -- Fall through into this routine
 139                         -- (for the benefit of the native code generators)
 140                         -- Equivalent to CJump in C land
 141
 142   | CReturn             -- This used to be RetVecRegRel
 143         CAddrMode       -- Any base address mode
 144         ReturnInfo      -- How to get the return address from the base address
 145
 146   | CSwitch CAddrMode
 147         [(BasicLit, AbstractC)] -- alternatives
 148         AbstractC               -- default; if there is no real Abstract C in here
 149                                 -- (e.g., all comments; see function "nonemptyAbsC"),
 150                                 -- then that means the default _cannot_ occur.
 151                                 -- If there is only one alternative & no default code,
 152                                 -- then there is no need to check the tag.
 153                                 -- Therefore, e.g.:
 154                                 --  CSwitch m [(tag,code)] AbsCNop == code
 155
 156   | CCodeBlock CLabel AbstractC
 157                         -- [amode analog: CLabelledCode]
 158                         -- A labelled block of code; this "statement" is not
 159                         -- executed; rather, the labelled code will be hoisted
 160                         -- out to the top level (out of line) & it can be
 161                         -- jumped to.
 162
 163   | CInitHdr            -- to initialise the header of a closure (both fixed/var parts)
 164         ClosureInfo
 165         RegRelative     -- address of the info ptr
 166         CAddrMode       -- cost centre to place in closure
 167                         --   CReg CurCostCentre or CC_HDR(R1.p{-Node-})
 168         Bool            -- inplace update or allocate
 169
 170   | COpStmt
 171         [CAddrMode]     -- Results
 172         PrimOp
 173         [CAddrMode]     -- Arguments
 174         Int             -- Live registers (may be obtainable from volatility? ADR)
 175         [MagicId]       -- Potentially volatile/live registers
 176                         -- (to save/restore around the call/op)
 177
 178         -- INVARIANT: When a PrimOp which can cause GC is used, the
 179         -- only live data is tidily on the STG stacks or in the STG
 180         -- registers (the code generator ensures this).
 181         --
 182         -- Why this?  Because if the arguments were arbitrary
 183         -- addressing modes, they might be things like (Hp+6) which
 184         -- will get utterly spongled by GC.
 185
 186   | CSimultaneous       -- Perform simultaneously all the statements
 187         AbstractC       -- in the nested AbstractC.  They are only
 188                         -- allowed to be CAssigns, COpStmts and AbsCNops, so the
 189                         -- "simultaneous" part just concerns making
 190                         -- sure that permutations work.
 191                         -- For example { a := b, b := a }
 192                         --      needs to go via (at least one) temporary
 193
 194   -- see the notes about these next few; they follow below...
 195   | CMacroStmt          CStmtMacro      [CAddrMode]
 196   | CCallProfCtrMacro   FAST_STRING     [CAddrMode]
 197   | CCallProfCCMacro    FAST_STRING     [CAddrMode]
 198
 199   -- *** the next three [or so...] are DATA (those above are CODE) ***
 200
 201   | CStaticClosure
 202         CLabel  -- The (full, not base) label to use for labelling the closure.
 203         ClosureInfo
 204         CAddrMode       -- cost centre identifier to place in closure
 205         [CAddrMode]     -- free vars; ptrs, then non-ptrs
 206
 207
 208   | CClosureInfoAndCode
 209         ClosureInfo     -- Explains placement and layout of closure
 210         AbstractC       -- Slow entry point code
 211         (Maybe AbstractC)
 212                         -- Fast entry point code, if any
 213         CAddrMode       -- Address of update code; Nothing => should never be used
 214                         -- (which is the case for all except constructors)
 215         String          -- Closure description; NB we can't get this from
 216                         -- ClosureInfo, because the latter refers to the *right* hand
 217                         -- side of a defn, whereas the "description" refers to *left*
 218                         -- hand side
 219
 220   | CRetVector                  -- Return vector with "holes"
 221                                 -- (Nothings) for the default
 222         CLabel                  -- vector-table label
 223         [Maybe CAddrMode]
 224         AbstractC               -- (and what to put in a "hole" [when Nothing])
 225
 226   | CRetUnVector        -- Direct return
 227         CLabel          -- unvector-table label
 228         CAddrMode       -- return code
 229
 230   | CFlatRetVector      -- A labelled block of static data
 231         CLabel          -- This is the flattened version of CRetVector
 232         [CAddrMode]
 233
 234   | CCostCentreDecl     -- A cost centre *declaration*
 235         Bool            -- True  <=> local => full declaration
 236                         -- False <=> extern; just say so
 237         CostCentre
 238
 239 {-UNUSED:
 240   | CComment            -- to insert a comment into the output
 241         FAST_STRING
 242 -}
 243
 244   | CClosureUpdInfo
 245         AbstractC       -- InRegs Info Table (CClosureInfoTable)
 246                         --                    ^^^^^^^^^^^^^^^^^
 247                         --                                out of date -- HWL
 248
 249   | CSplitMarker        -- Split into separate object modules here
 250
 251 #ifdef DPH
 252   | CNativeInfoTableAndCode
 253         ClosureInfo     -- Explains placement and layout of closure
 254         String          -- closure description
 255         AbstractC       -- We want to apply the trick outlined in the STG
 256                         -- paper of putting the info table before the normal
 257                         -- entry point to a function (well a very similar
 258                         -- trick, see nativeDap/NOTES.static). By putting the
 259                         -- abstractC here we stop the info table
 260                         -- wandering off :-) (No post mangler hacking going
 261                         -- on here Will :-)
 262 #endif {- Data Parallel Haskell -}
 263 \end{code}
 264
 265 About @CMacroStmt@, etc.: notionally, they all just call some
 266 arbitrary C~macro or routine, passing the @CAddrModes@ as arguments.
 267 However, we distinguish between various flavours of these things,
 268 mostly just to keep things somewhat less wild and wooly.
 269
 270 \begin{description}
 271 \item[@CMacroStmt@:]
 272 Some {\em essential} bits of the STG execution model are done with C
 273 macros.  An example is @STK_CHK@, which checks for stack-space
 274 overflow.  This enumeration type lists all such macros:
 275 \begin{code}
 276 data CStmtMacro
 277   = ARGS_CHK_A_LOAD_NODE
 278   | ARGS_CHK_A
 279   | ARGS_CHK_B_LOAD_NODE
 280   | ARGS_CHK_B
 281   | HEAP_CHK
 282   | STK_CHK
 283   | UPD_CAF
 284   | UPD_IND
 285   | UPD_INPLACE_NOPTRS
 286   | UPD_INPLACE_PTRS
 287   | UPD_BH_UPDATABLE
 288   | UPD_BH_SINGLE_ENTRY
 289   | PUSH_STD_UPD_FRAME
 290   | POP_STD_UPD_FRAME
 291 --UNUSED:  | PUSH_CON_UPD_FRAME
 292   | SET_ARITY
 293   | CHK_ARITY
 294   | SET_TAG
 295 #ifdef GRAN
 296   | GRAN_FETCH                  -- for GrAnSim only  -- HWL
 297   | GRAN_RESCHEDULE             -- for GrAnSim only  -- HWL
 298   | GRAN_FETCH_AND_RESCHEDULE   -- for GrAnSim only  -- HWL
 299   | THREAD_CONTEXT_SWITCH       -- for GrAnSim only  -- HWL
 300 #endif
 301   deriving Text
 302
 303 \end{code}
 304
 305 \item[@CCallProfCtrMacro@:]
 306 The @String@ names a macro that, if \tr{#define}d, will bump one/some
 307 of the STG-event profiling counters.
 308
 309 \item[@CCallProfCCMacro@:]
 310 The @String@ names a macro that, if \tr{#define}d, will perform some
 311 cost-centre-profiling-related action.
 312 \end{description}
 313
 314 HERE ARE SOME OLD NOTES ABOUT HEAP-CHK ENTRY POINTS:
 315
 316 \item[@CCallStgC@:]
 317 Some parts of the system, {\em notably the storage manager}, are
 318 implemented by C~routines that must know something about the internals
 319 of the STG world, e.g., where the heap-pointer is.  (The
 320 ``C-as-assembler'' documents describes this stuff in detail.)
 321
 322 This is quite a tricky business, especially with ``optimised~C,'' so
 323 we keep close tabs on these fellows.  This enumeration type lists all
 324 such ``STG~C'' routines:
 325
 326 HERE ARE SOME *OLD* NOTES ABOUT HEAP-CHK ENTRY POINTS:
 327
 328 Heap overflow invokes the garbage collector (of your choice :-), and
 329 we have different entry points, to tell the GC the exact configuration
 330 before it.
 331 \begin{description}
 332 \item[Branch of a boxed case:]
 333 The @Node@ register points off to somewhere legitimate, the @TagReg@
 334 holds the tag, and the @RetReg@ points to the code for the
 335 alterative which should be resumed. (ToDo: update)
 336
 337 \item[Branch of an unboxed case:]
 338 The @Node@ register points nowhere of any particular interest, a
 339 kind-specific register (@IntReg@, @FloatReg@, etc.) holds the unboxed
 340 value, and the @RetReg@ points to the code for the alternative
 341 which should be resumed. (ToDo: update)
 342
 343 \item[Closure entry:]
 344 The @Node@ register points to the closure, and the @RetReg@ points
 345 to the code to be resumed. (ToDo: update)
 346 \end{description}
 347
 348 %************************************************************************
 349 %*                                                                      *
 350 \subsection[CAddrMode]{C addressing modes}
 351 %*                                                                      *
 352 %************************************************************************
 353
 354 Addressing modes: these have @PrimitiveKinds@ pinned on them.
 355 \begin{code}
 356 data CAddrMode
 357   = CVal  RegRelative PrimKind
 358                         -- On RHS of assign: Contents of Magic[n]
 359                         -- On LHS of assign: location Magic[n]
 360                         -- (ie at addr Magic+n)
 361
 362   | CAddr RegRelative
 363                         -- On RHS of assign: Address of Magic[n]; ie Magic+n
 364                         --      n=0 gets the Magic location itself
 365                         --      (NB: n=0 case superceded by CReg)
 366                         -- On LHS of assign: only sensible if n=0,
 367                         --      which gives the magic location itself
 368                         --      (NB: superceded by CReg)
 369
 370   | CReg MagicId        -- To replace (CAddr MagicId 0)
 371
 372   | CTableEntry             -- CVal should be generalized to allow this
 373                 CAddrMode   -- Base
 374                 CAddrMode   -- Offset
 375                 PrimKind    -- For casting
 376
 377   | CTemp Unique PrimKind       -- Temporary locations
 378         -- ``Temporaries'' correspond to local variables in C, and registers in
 379         -- native code.
 380         -- OLD: The kind (that used to be there) is redundant, but it's REALLY helpful for
 381         -- generating C declarations
 382
 383   | CLbl    CLabel      -- Labels in the runtime system, etc.
 384                         -- See comment under CLabelledData about (String,Name)
 385             PrimKind    -- the kind is so we can generate accurate C decls
 386
 387   | CUnVecLbl           -- A choice of labels left up to the back end
 388               CLabel    -- direct
 389               CLabel    -- vectored
 390
 391   | CCharLike CAddrMode -- The address of a static char-like closure for
 392                         -- the specified character.  It is guaranteed to be in
 393                         -- the range 0..255.
 394
 395   | CIntLike CAddrMode  -- The address of a static int-like closure for the
 396                         -- specified small integer.  It is guaranteed to be in the
 397                         -- range mIN_INTLIKE..mAX_INTLIKE
 398
 399   | CString FAST_STRING -- The address of the null-terminated string
 400   | CLit    BasicLit
 401   | CLitLit FAST_STRING -- completely literal literal: just spit this String
 402                         -- into the C output
 403             PrimKind
 404
 405   | COffset HeapOffset  -- A literal constant, not an offset *from* anything!
 406                         -- ToDo: this should really be CLitOffset
 407
 408   | CCode AbstractC     -- Some code.  Used mainly for return addresses.
 409
 410   | CLabelledCode CLabel AbstractC  -- Almost defunct? (ToDo?) --JSM
 411                         -- Some code that must have a particular label
 412                         -- (which is jumpable to)
 413
 414   | CJoinPoint          -- This is used as the amode of a let-no-escape-bound variable
 415         VirtualSpAOffset        -- SpA and SpB values after any volatile free vars
 416         VirtualSpBOffset        -- of the rhs have been saved on stack.
 417                                 -- Just before the code for the thing is jumped to,
 418                                 -- SpA/B will be set to these values,
 419                                 -- and then any stack-passed args pushed,
 420                                 -- then the code for this thing will be entered
 421
 422   | CMacroExpr
 423         PrimKind        -- the kind of the result
 424         CExprMacro      -- the macro to generate a value
 425         [CAddrMode]     -- and its arguments
 426
 427   | CCostCentre         -- If Bool is True ==> it to be printed as a String,
 428         CostCentre      -- (*not* as a C identifier or some such).
 429         Bool            -- (It's not just the double-quotes on either side;
 430                         -- spaces and other funny characters will have been
 431                         -- fiddled in the non-String variant.)
 432
 433 mkCCostCentre cc
 434   = --ASSERT(not (currentOrSubsumedCosts cc))
 435     --FALSE: We do put subsumedCC in static closures
 436     CCostCentre cc False
 437 \end{code}
 438
 439 Various C macros for values which are dependent on the back-end layout.
 440
 441 \begin{code}
 442
 443 data CExprMacro
 444   = INFO_PTR
 445   | ENTRY_CODE
 446   | INFO_TAG
 447   | EVAL_TAG
 448   deriving(Text)
 449
 450 \end{code}
 451
 452 A tiny convenience:
 453 \begin{code}
 454 mkIntCLit :: Int -> CAddrMode
 455 mkIntCLit i = CLit (mkMachInt (toInteger i))
 456 \end{code}
 457
 458 %************************************************************************
 459 %*                                                                      *
 460 \subsection[RegRelative]{@RegRelatives@: ???}
 461 %*                                                                      *
 462 %************************************************************************
 463
 464 \begin{code}
 465 data RegRelative
 466   = HpRel        VirtualHeapOffset      -- virtual offset of Hp
 467                  VirtualHeapOffset      -- virtual offset of The Thing
 468   | SpARel       VirtualSpAOffset       -- virtual offset of SpA
 469                  VirtualSpAOffset       -- virtual offset of The Thing
 470   | SpBRel       VirtualSpBOffset       -- virtual offset of SpB
 471                  VirtualSpBOffset       -- virtual offset of The Thing
 472   | NodeRel      VirtualHeapOffset
 473
 474 data ReturnInfo
 475   = DirectReturn                        -- Jump directly, if possible
 476   | StaticVectoredReturn Int            -- Fixed tag, starting at zero
 477   | DynamicVectoredReturn CAddrMode     -- Dynamic tag given by amode, starting at zero
 478
 479 \end{code}
 480
 481 %************************************************************************
 482 %*                                                                      *
 483 \subsection[MagicId]{@MagicIds@: registers and such}
 484 %*                                                                      *
 485 %************************************************************************
 486
 487 Much of what happens in Abstract-C is in terms of ``magic'' locations,
 488 such as the stack pointer, heap pointer, etc.  If possible, these will
 489 be held in registers.
 490
 491 Here are some notes about what's active when:
 492 \begin{description}
 493 \item[Always active:]
 494         Hp, HpLim, SpA, SpB, SuA, SuB
 495
 496 \item[Entry set:]
 497         ArgPtr1 (= Node)...
 498
 499 \item[Return set:]
 500 Ptr regs: RetPtr1 (= Node), RetPtr2...
 501 Int/char regs:  RetData1 (= TagReg = IntReg), RetData2...
 502 Float regs: RetFloat1, ...
 503 Double regs: RetDouble1, ...
 504 \end{description}
 505
 506 \begin{code}
 507 data MagicId
 508   = BaseReg     -- mentioned only in nativeGen
 509
 510   | StkOReg     -- mentioned only in nativeGen
 511
 512   -- Argument and return registers
 513   | VanillaReg          -- pointers, unboxed ints and chars
 514         PrimKind        -- PtrKind, IntKind, CharKind, StablePtrKind or MallocPtrKind
 515                         --      (in case we need to distinguish)
 516         FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
 517
 518   | FloatReg    -- single-precision floating-point registers
 519         FAST_INT        -- its number (1 .. mAX_Float_REG)
 520
 521   | DoubleReg   -- double-precision floating-point registers
 522         FAST_INT        -- its number (1 .. mAX_Double_REG)
 523
 524   | TagReg      -- to return constructor tags; as almost all returns are vectored,
 525                 -- this is rarely used.
 526
 527   | RetReg      -- topmost return address from the B stack
 528
 529   | SpA         -- Stack ptr; points to last occupied stack location.
 530                 -- Stack grows downward.
 531   | SuA         -- mentioned only in nativeGen
 532
 533   | SpB         -- Basic values, return addresses and update frames.
 534                 -- Grows upward.
 535   | SuB         -- mentioned only in nativeGen
 536
 537   | Hp          -- Heap ptr; points to last occupied heap location.
 538                 -- Free space at lower addresses.
 539
 540   | HpLim       -- Heap limit register: mentioned only in nativeGen
 541
 542   | LivenessReg -- (parallel only) used when we need to record explicitly
 543                 -- what registers are live
 544
 545   | ActivityReg         -- mentioned only in nativeGen
 546   | StdUpdRetVecReg     -- mentioned only in nativeGen
 547   | StkStubReg          -- register holding STK_STUB_closure (for stubbing dead stack slots)
 548
 549   | CurCostCentre -- current cost centre register.
 550
 551   | VoidReg -- see "VoidPrim" type; just a placeholder; no actual register
 552
 553 #ifdef DPH
 554 -- In DPH we use:
 555 --      (VanillaReg X)  for pointers, ints, chars floats
 556 --      (DataReg X)     for ints chars or floats
 557 --      (DoubleReg X)   first 32 bits of double in register X, second 32 in
 558 --                      register X+1; DoubleReg is a synonymn for
 559 --                      DataReg X; DataReg X+1
 560
 561   | DataReg
 562         PrimKind
 563         Int
 564 #endif {- Data Parallel Haskell -}
 565
 566 node    = VanillaReg PtrKind     ILIT(1) -- A convenient alias for Node
 567 infoptr = VanillaReg DataPtrKind ILIT(2) -- An alias for InfoPtr
 568 \end{code}
 569
 570 We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
 571
 572 \begin{code}
 573 instance Eq MagicId where
 574 #ifdef DPH
 575     (FloatReg  f1) == (FloatReg  f2) = f1 == f2
 576     (DoubleReg d1) == (DoubleReg d2) = d1 == d2
 577     (DataReg _ d1) == (DataReg _ d2) = d1 == d2
 578 #endif {- Data Parallel Haskell -}
 579     reg1           == reg2           = tagOf_MagicId reg1 _EQ_ tagOf_MagicId reg2
 580
 581 tagOf_MagicId BaseReg           = (ILIT(0) :: FAST_INT)
 582 tagOf_MagicId StkOReg           = ILIT(1)
 583 tagOf_MagicId TagReg            = ILIT(2)
 584 tagOf_MagicId RetReg            = ILIT(3)
 585 tagOf_MagicId SpA               = ILIT(4)
 586 tagOf_MagicId SuA               = ILIT(5)
 587 tagOf_MagicId SpB               = ILIT(6)
 588 tagOf_MagicId SuB               = ILIT(7)
 589 tagOf_MagicId Hp                = ILIT(8)
 590 tagOf_MagicId HpLim             = ILIT(9)
 591 tagOf_MagicId LivenessReg       = ILIT(10)
 592 tagOf_MagicId ActivityReg       = ILIT(11)
 593 tagOf_MagicId StdUpdRetVecReg   = ILIT(12)
 594 tagOf_MagicId StkStubReg        = ILIT(13)
 595 tagOf_MagicId CurCostCentre     = ILIT(14)
 596 tagOf_MagicId VoidReg           = ILIT(15)
 597
 598 tagOf_MagicId (VanillaReg _ i) = ILIT(15) _ADD_ i
 599
 600 #ifndef DPH
 601 tagOf_MagicId (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
 602   where
 603     maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
 604
 605 tagOf_MagicId (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i
 606   where
 607     maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
 608     maxf = case mAX_Float_REG   of { IBOX(x) -> x }
 609
 610 #else
 611 tagOf_MagicId (DoubleReg i)         = ILIT(1066) _ADD_ i -- Hacky, but we want disjoint
 612 tagOf_MagicId (DataReg _ IBOX(i))   = ILIT(1066) _ADD_ i -- range with Vanillas
 613 #endif {- Data Parallel Haskell -}
 614 \end{code}
 615
 616 Returns True for any register that {\em potentially} dies across
 617 C calls (or anything near equivalent).  We just say @True@ and
 618 let the (machine-specific) registering macros sort things out...
 619 \begin{code}
 620 isVolatileReg :: MagicId -> Bool
 621
 622 isVolatileReg any       = True
 623 --isVolatileReg (FloatReg _)    = True
 624 --isVolatileReg (DoubleReg _)   = True
 625 \end{code}
 626
 627 %************************************************************************
 628 %*                                                                      *
 629 \subsection[AbsCSyn-printing]{Pretty-printing Abstract~C}
 630 %*                                                                      *
 631 %************************************************************************
 632
 633 It's in \tr{PprAbsC.lhs}.
 634
 635 %************************************************************************
 636 %*                                                                      *
 637 \subsection[EqInstances]{Eq instance for RegRelative & CAddrMode}
 638 %*                                                                      *
 639 %************************************************************************
 640
 641 DPH requires CAddrMode to be in class Eq for its register allocation
 642 algorithm. The code for equality is rather conservative --- it doesnt
 643 matter if two things are determined to be not equal (even if they really are,
 644 i.e with CVal's), we just generate less efficient code.
 645
 646 NOTE(07/04/93) It does matter, its doing really bad with the reg relative
 647                stuff.
 648
 649 \begin{code}
 650 #ifdef DPH
 651 instance Eq CAddrMode where
 652   (CVal r _)          == (CVal r' _)        = r `eqRRel` r'
 653   (CAddr r)           == (CAddr r')         = r `eqRRel` r'
 654   (CReg reg)          == (CReg reg')        = reg == reg'
 655   (CTemp u _)         == (CTemp u' _)       = u == u'
 656   (CLbl l _)          == (CLbl l' _)        = l == l'
 657   (CUnVecLbl d v)     == (CUnVecLbl d' v')  = d == d' && v == v'
 658   (CCharLike c)       == (CCharLike c')     = c == c'
 659   (CIntLike c)        == (CIntLike c')      = c == c'
 660   (CString str)       == (CString str')     = str == str'
 661   (CLit lit)          == (CLit lit')        = lit == lit'
 662   (COffset off)       == (COffset off')     = possiblyEqualHeapOffset off off'
 663   (CCode _)           == (CCode _)          = panic "(==) Code in CAddrMode"
 664   (CLabelledCode _ _) == (CLabelledCode _ _)= panic "(==) LabCode in CAddrMode"
 665   _                   == _                  = False
 666
 667
 668 eqRRel :: RegRelative -> RegRelative -> Bool
 669 eqRRel (NodeRel x) (NodeRel y)
 670   = virtualHeapOffsetToInt x == virtualHeapOffsetToInt y
 671
 672 eqRRel l@(SpARel _ _) r@(SpARel _ _)
 673   = spARelToInt l == spARelToInt r
 674
 675 eqRRel l@(SpBRel _ _) r@(SpBRel _ _)
 676   = spBRelToInt l == spBRelToInt r
 677
 678 eqRRel (HpRel hp off) (HpRel hp' off')
 679   = (virtualHeapOffsetToInt (hp  `subOff` off)) ==
 680     (virtualHeapOffsetToInt (hp' `subOff` off'))
 681
 682 eqRRel _ _ = False
 683
 684 eqRetInfo:: ReturnInfo -> ReturnInfo -> Bool
 685 eqRetInfo DirectReturn              DirectReturn              = True
 686 eqRetInfo (StaticVectoredReturn x)  (StaticVectoredReturn x') = x == x'
 687 eqRetInfo _                         _                         = False
 688 #endif {- Data Parallel Haskell -}
 689 \end{code}