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         Int             -- Liveness info; this is here because it is
 220                         -- easy to produce w/in the CgMonad; hard
 221                         -- thereafter.  (WDP 95/11)
 222
 223   | CRetVector                  -- Return vector with "holes"
 224                                 -- (Nothings) for the default
 225         CLabel                  -- vector-table label
 226         [Maybe CAddrMode]
 227         AbstractC               -- (and what to put in a "hole" [when Nothing])
 228
 229   | CRetUnVector        -- Direct return
 230         CLabel          -- unvector-table label
 231         CAddrMode       -- return code
 232
 233   | CFlatRetVector      -- A labelled block of static data
 234         CLabel          -- This is the flattened version of CRetVector
 235         [CAddrMode]
 236
 237   | CCostCentreDecl     -- A cost centre *declaration*
 238         Bool            -- True  <=> local => full declaration
 239                         -- False <=> extern; just say so
 240         CostCentre
 241
 242 {-UNUSED:
 243   | CComment            -- to insert a comment into the output
 244         FAST_STRING
 245 -}
 246
 247   | CClosureUpdInfo
 248         AbstractC       -- InRegs Info Table (CClosureInfoTable)
 249                         --                    ^^^^^^^^^^^^^^^^^
 250                         --                                out of date -- HWL
 251
 252   | CSplitMarker        -- Split into separate object modules here
 253
 254 #ifdef DPH
 255   | CNativeInfoTableAndCode
 256         ClosureInfo     -- Explains placement and layout of closure
 257         String          -- closure description
 258         AbstractC       -- We want to apply the trick outlined in the STG
 259                         -- paper of putting the info table before the normal
 260                         -- entry point to a function (well a very similar
 261                         -- trick, see nativeDap/NOTES.static). By putting the
 262                         -- abstractC here we stop the info table
 263                         -- wandering off :-) (No post mangler hacking going
 264                         -- on here Will :-)
 265 #endif {- Data Parallel Haskell -}
 266 \end{code}
 267
 268 About @CMacroStmt@, etc.: notionally, they all just call some
 269 arbitrary C~macro or routine, passing the @CAddrModes@ as arguments.
 270 However, we distinguish between various flavours of these things,
 271 mostly just to keep things somewhat less wild and wooly.
 272
 273 \begin{description}
 274 \item[@CMacroStmt@:]
 275 Some {\em essential} bits of the STG execution model are done with C
 276 macros.  An example is @STK_CHK@, which checks for stack-space
 277 overflow.  This enumeration type lists all such macros:
 278 \begin{code}
 279 data CStmtMacro
 280   = ARGS_CHK_A_LOAD_NODE
 281   | ARGS_CHK_A
 282   | ARGS_CHK_B_LOAD_NODE
 283   | ARGS_CHK_B
 284   | HEAP_CHK
 285   | STK_CHK
 286   | UPD_CAF
 287   | UPD_IND
 288   | UPD_INPLACE_NOPTRS
 289   | UPD_INPLACE_PTRS
 290   | UPD_BH_UPDATABLE
 291   | UPD_BH_SINGLE_ENTRY
 292   | PUSH_STD_UPD_FRAME
 293   | POP_STD_UPD_FRAME
 294 --UNUSED:  | PUSH_CON_UPD_FRAME
 295   | SET_ARITY
 296   | CHK_ARITY
 297   | SET_TAG
 298 #ifdef GRAN
 299   | GRAN_FETCH                  -- for GrAnSim only  -- HWL
 300   | GRAN_RESCHEDULE             -- for GrAnSim only  -- HWL
 301   | GRAN_FETCH_AND_RESCHEDULE   -- for GrAnSim only  -- HWL
 302   | THREAD_CONTEXT_SWITCH       -- for GrAnSim only  -- HWL
 303 #endif
 304   deriving Text
 305
 306 \end{code}
 307
 308 \item[@CCallProfCtrMacro@:]
 309 The @String@ names a macro that, if \tr{#define}d, will bump one/some
 310 of the STG-event profiling counters.
 311
 312 \item[@CCallProfCCMacro@:]
 313 The @String@ names a macro that, if \tr{#define}d, will perform some
 314 cost-centre-profiling-related action.
 315 \end{description}
 316
 317 HERE ARE SOME OLD NOTES ABOUT HEAP-CHK ENTRY POINTS:
 318
 319 \item[@CCallStgC@:]
 320 Some parts of the system, {\em notably the storage manager}, are
 321 implemented by C~routines that must know something about the internals
 322 of the STG world, e.g., where the heap-pointer is.  (The
 323 ``C-as-assembler'' documents describes this stuff in detail.)
 324
 325 This is quite a tricky business, especially with ``optimised~C,'' so
 326 we keep close tabs on these fellows.  This enumeration type lists all
 327 such ``STG~C'' routines:
 328
 329 HERE ARE SOME *OLD* NOTES ABOUT HEAP-CHK ENTRY POINTS:
 330
 331 Heap overflow invokes the garbage collector (of your choice :-), and
 332 we have different entry points, to tell the GC the exact configuration
 333 before it.
 334 \begin{description}
 335 \item[Branch of a boxed case:]
 336 The @Node@ register points off to somewhere legitimate, the @TagReg@
 337 holds the tag, and the @RetReg@ points to the code for the
 338 alterative which should be resumed. (ToDo: update)
 339
 340 \item[Branch of an unboxed case:]
 341 The @Node@ register points nowhere of any particular interest, a
 342 kind-specific register (@IntReg@, @FloatReg@, etc.) holds the unboxed
 343 value, and the @RetReg@ points to the code for the alternative
 344 which should be resumed. (ToDo: update)
 345
 346 \item[Closure entry:]
 347 The @Node@ register points to the closure, and the @RetReg@ points
 348 to the code to be resumed. (ToDo: update)
 349 \end{description}
 350
 351 %************************************************************************
 352 %*                                                                      *
 353 \subsection[CAddrMode]{C addressing modes}
 354 %*                                                                      *
 355 %************************************************************************
 356
 357 Addressing modes: these have @PrimitiveKinds@ pinned on them.
 358 \begin{code}
 359 data CAddrMode
 360   = CVal  RegRelative PrimKind
 361                         -- On RHS of assign: Contents of Magic[n]
 362                         -- On LHS of assign: location Magic[n]
 363                         -- (ie at addr Magic+n)
 364
 365   | CAddr RegRelative
 366                         -- On RHS of assign: Address of Magic[n]; ie Magic+n
 367                         --      n=0 gets the Magic location itself
 368                         --      (NB: n=0 case superceded by CReg)
 369                         -- On LHS of assign: only sensible if n=0,
 370                         --      which gives the magic location itself
 371                         --      (NB: superceded by CReg)
 372
 373   | CReg MagicId        -- To replace (CAddr MagicId 0)
 374
 375   | CTableEntry             -- CVal should be generalized to allow this
 376                 CAddrMode   -- Base
 377                 CAddrMode   -- Offset
 378                 PrimKind    -- For casting
 379
 380   | CTemp Unique PrimKind       -- Temporary locations
 381         -- ``Temporaries'' correspond to local variables in C, and registers in
 382         -- native code.
 383         -- OLD: The kind (that used to be there) is redundant, but it's REALLY helpful for
 384         -- generating C declarations
 385
 386   | CLbl    CLabel      -- Labels in the runtime system, etc.
 387                         -- See comment under CLabelledData about (String,Name)
 388             PrimKind    -- the kind is so we can generate accurate C decls
 389
 390   | CUnVecLbl           -- A choice of labels left up to the back end
 391               CLabel    -- direct
 392               CLabel    -- vectored
 393
 394   | CCharLike CAddrMode -- The address of a static char-like closure for
 395                         -- the specified character.  It is guaranteed to be in
 396                         -- the range 0..255.
 397
 398   | CIntLike CAddrMode  -- The address of a static int-like closure for the
 399                         -- specified small integer.  It is guaranteed to be in the
 400                         -- range mIN_INTLIKE..mAX_INTLIKE
 401
 402   | CString FAST_STRING -- The address of the null-terminated string
 403   | CLit    BasicLit
 404   | CLitLit FAST_STRING -- completely literal literal: just spit this String
 405                         -- into the C output
 406             PrimKind
 407
 408   | COffset HeapOffset  -- A literal constant, not an offset *from* anything!
 409                         -- ToDo: this should really be CLitOffset
 410
 411   | CCode AbstractC     -- Some code.  Used mainly for return addresses.
 412
 413   | CLabelledCode CLabel AbstractC  -- Almost defunct? (ToDo?) --JSM
 414                         -- Some code that must have a particular label
 415                         -- (which is jumpable to)
 416
 417   | CJoinPoint          -- This is used as the amode of a let-no-escape-bound variable
 418         VirtualSpAOffset        -- SpA and SpB values after any volatile free vars
 419         VirtualSpBOffset        -- of the rhs have been saved on stack.
 420                                 -- Just before the code for the thing is jumped to,
 421                                 -- SpA/B will be set to these values,
 422                                 -- and then any stack-passed args pushed,
 423                                 -- then the code for this thing will be entered
 424
 425   | CMacroExpr
 426         PrimKind        -- the kind of the result
 427         CExprMacro      -- the macro to generate a value
 428         [CAddrMode]     -- and its arguments
 429
 430   | CCostCentre         -- If Bool is True ==> it to be printed as a String,
 431         CostCentre      -- (*not* as a C identifier or some such).
 432         Bool            -- (It's not just the double-quotes on either side;
 433                         -- spaces and other funny characters will have been
 434                         -- fiddled in the non-String variant.)
 435
 436 mkCCostCentre cc
 437   = --ASSERT(not (currentOrSubsumedCosts cc))
 438     --FALSE: We do put subsumedCC in static closures
 439     CCostCentre cc False
 440 \end{code}
 441
 442 Various C macros for values which are dependent on the back-end layout.
 443
 444 \begin{code}
 445
 446 data CExprMacro
 447   = INFO_PTR
 448   | ENTRY_CODE
 449   | INFO_TAG
 450   | EVAL_TAG
 451   deriving(Text)
 452
 453 \end{code}
 454
 455 A tiny convenience:
 456 \begin{code}
 457 mkIntCLit :: Int -> CAddrMode
 458 mkIntCLit i = CLit (mkMachInt (toInteger i))
 459 \end{code}
 460
 461 %************************************************************************
 462 %*                                                                      *
 463 \subsection[RegRelative]{@RegRelatives@: ???}
 464 %*                                                                      *
 465 %************************************************************************
 466
 467 \begin{code}
 468 data RegRelative
 469   = HpRel        VirtualHeapOffset      -- virtual offset of Hp
 470                  VirtualHeapOffset      -- virtual offset of The Thing
 471   | SpARel       VirtualSpAOffset       -- virtual offset of SpA
 472                  VirtualSpAOffset       -- virtual offset of The Thing
 473   | SpBRel       VirtualSpBOffset       -- virtual offset of SpB
 474                  VirtualSpBOffset       -- virtual offset of The Thing
 475   | NodeRel      VirtualHeapOffset
 476
 477 data ReturnInfo
 478   = DirectReturn                        -- Jump directly, if possible
 479   | StaticVectoredReturn Int            -- Fixed tag, starting at zero
 480   | DynamicVectoredReturn CAddrMode     -- Dynamic tag given by amode, starting at zero
 481
 482 \end{code}
 483
 484 %************************************************************************
 485 %*                                                                      *
 486 \subsection[MagicId]{@MagicIds@: registers and such}
 487 %*                                                                      *
 488 %************************************************************************
 489
 490 Much of what happens in Abstract-C is in terms of ``magic'' locations,
 491 such as the stack pointer, heap pointer, etc.  If possible, these will
 492 be held in registers.
 493
 494 Here are some notes about what's active when:
 495 \begin{description}
 496 \item[Always active:]
 497         Hp, HpLim, SpA, SpB, SuA, SuB
 498
 499 \item[Entry set:]
 500         ArgPtr1 (= Node)...
 501
 502 \item[Return set:]
 503 Ptr regs: RetPtr1 (= Node), RetPtr2...
 504 Int/char regs:  RetData1 (= TagReg = IntReg), RetData2...
 505 Float regs: RetFloat1, ...
 506 Double regs: RetDouble1, ...
 507 \end{description}
 508
 509 \begin{code}
 510 data MagicId
 511   = BaseReg     -- mentioned only in nativeGen
 512
 513   | StkOReg     -- mentioned only in nativeGen
 514
 515   -- Argument and return registers
 516   | VanillaReg          -- pointers, unboxed ints and chars
 517         PrimKind        -- PtrKind, IntKind, CharKind, StablePtrKind or MallocPtrKind
 518                         --      (in case we need to distinguish)
 519         FAST_INT        -- its number (1 .. mAX_Vanilla_REG)
 520
 521   | FloatReg    -- single-precision floating-point registers
 522         FAST_INT        -- its number (1 .. mAX_Float_REG)
 523
 524   | DoubleReg   -- double-precision floating-point registers
 525         FAST_INT        -- its number (1 .. mAX_Double_REG)
 526
 527   | TagReg      -- to return constructor tags; as almost all returns are vectored,
 528                 -- this is rarely used.
 529
 530   | RetReg      -- topmost return address from the B stack
 531
 532   | SpA         -- Stack ptr; points to last occupied stack location.
 533                 -- Stack grows downward.
 534   | SuA         -- mentioned only in nativeGen
 535
 536   | SpB         -- Basic values, return addresses and update frames.
 537                 -- Grows upward.
 538   | SuB         -- mentioned only in nativeGen
 539
 540   | Hp          -- Heap ptr; points to last occupied heap location.
 541                 -- Free space at lower addresses.
 542
 543   | HpLim       -- Heap limit register: mentioned only in nativeGen
 544
 545   | LivenessReg -- (parallel only) used when we need to record explicitly
 546                 -- what registers are live
 547
 548   | ActivityReg         -- mentioned only in nativeGen (UNUSED)
 549   | StdUpdRetVecReg     -- mentioned only in nativeGen
 550   | StkStubReg          -- register holding STK_STUB_closure (for stubbing dead stack slots)
 551
 552   | CurCostCentre -- current cost centre register.
 553
 554   | VoidReg -- see "VoidPrim" type; just a placeholder; no actual register
 555
 556 #ifdef DPH
 557 -- In DPH we use:
 558 --      (VanillaReg X)  for pointers, ints, chars floats
 559 --      (DataReg X)     for ints chars or floats
 560 --      (DoubleReg X)   first 32 bits of double in register X, second 32 in
 561 --                      register X+1; DoubleReg is a synonymn for
 562 --                      DataReg X; DataReg X+1
 563
 564   | DataReg
 565         PrimKind
 566         Int
 567 #endif {- Data Parallel Haskell -}
 568
 569 node    = VanillaReg PtrKind     ILIT(1) -- A convenient alias for Node
 570 infoptr = VanillaReg DataPtrKind ILIT(2) -- An alias for InfoPtr
 571 \end{code}
 572
 573 We need magical @Eq@ because @VanillaReg@s come in multiple flavors.
 574
 575 \begin{code}
 576 instance Eq MagicId where
 577 #ifdef DPH
 578     (FloatReg  f1) == (FloatReg  f2) = f1 == f2
 579     (DoubleReg d1) == (DoubleReg d2) = d1 == d2
 580     (DataReg _ d1) == (DataReg _ d2) = d1 == d2
 581 #endif {- Data Parallel Haskell -}
 582     reg1           == reg2           = tagOf_MagicId reg1 _EQ_ tagOf_MagicId reg2
 583
 584 tagOf_MagicId BaseReg           = (ILIT(0) :: FAST_INT)
 585 tagOf_MagicId StkOReg           = ILIT(1)
 586 tagOf_MagicId TagReg            = ILIT(2)
 587 tagOf_MagicId RetReg            = ILIT(3)
 588 tagOf_MagicId SpA               = ILIT(4)
 589 tagOf_MagicId SuA               = ILIT(5)
 590 tagOf_MagicId SpB               = ILIT(6)
 591 tagOf_MagicId SuB               = ILIT(7)
 592 tagOf_MagicId Hp                = ILIT(8)
 593 tagOf_MagicId HpLim             = ILIT(9)
 594 tagOf_MagicId LivenessReg       = ILIT(10)
 595 --tagOf_MagicId ActivityReg     = ILIT(11) -- UNUSED
 596 tagOf_MagicId StdUpdRetVecReg   = ILIT(12)
 597 tagOf_MagicId StkStubReg        = ILIT(13)
 598 tagOf_MagicId CurCostCentre     = ILIT(14)
 599 tagOf_MagicId VoidReg           = ILIT(15)
 600
 601 tagOf_MagicId (VanillaReg _ i) = ILIT(15) _ADD_ i
 602
 603 #ifndef DPH
 604 tagOf_MagicId (FloatReg i) = ILIT(15) _ADD_ maxv _ADD_ i
 605   where
 606     maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
 607
 608 tagOf_MagicId (DoubleReg i) = ILIT(15) _ADD_ maxv _ADD_ maxf _ADD_ i
 609   where
 610     maxv = case mAX_Vanilla_REG of { IBOX(x) -> x }
 611     maxf = case mAX_Float_REG   of { IBOX(x) -> x }
 612
 613 #else
 614 tagOf_MagicId (DoubleReg i)         = ILIT(1066) _ADD_ i -- Hacky, but we want disjoint
 615 tagOf_MagicId (DataReg _ IBOX(i))   = ILIT(1066) _ADD_ i -- range with Vanillas
 616 #endif {- Data Parallel Haskell -}
 617 \end{code}
 618
 619 Returns True for any register that {\em potentially} dies across
 620 C calls (or anything near equivalent).  We just say @True@ and
 621 let the (machine-specific) registering macros sort things out...
 622 \begin{code}
 623 isVolatileReg :: MagicId -> Bool
 624
 625 isVolatileReg any       = True
 626 --isVolatileReg (FloatReg _)    = True
 627 --isVolatileReg (DoubleReg _)   = True
 628 \end{code}
 629
 630 %************************************************************************
 631 %*                                                                      *
 632 \subsection[AbsCSyn-printing]{Pretty-printing Abstract~C}
 633 %*                                                                      *
 634 %************************************************************************
 635
 636 It's in \tr{PprAbsC.lhs}.
 637
 638 %************************************************************************
 639 %*                                                                      *
 640 \subsection[EqInstances]{Eq instance for RegRelative & CAddrMode}
 641 %*                                                                      *
 642 %************************************************************************
 643
 644 DPH requires CAddrMode to be in class Eq for its register allocation
 645 algorithm. The code for equality is rather conservative --- it doesnt
 646 matter if two things are determined to be not equal (even if they really are,
 647 i.e with CVal's), we just generate less efficient code.
 648
 649 NOTE(07/04/93) It does matter, its doing really bad with the reg relative
 650                stuff.
 651
 652 \begin{code}
 653 #ifdef DPH
 654 instance Eq CAddrMode where
 655   (CVal r _)          == (CVal r' _)        = r `eqRRel` r'
 656   (CAddr r)           == (CAddr r')         = r `eqRRel` r'
 657   (CReg reg)          == (CReg reg')        = reg == reg'
 658   (CTemp u _)         == (CTemp u' _)       = u == u'
 659   (CLbl l _)          == (CLbl l' _)        = l == l'
 660   (CUnVecLbl d v)     == (CUnVecLbl d' v')  = d == d' && v == v'
 661   (CCharLike c)       == (CCharLike c')     = c == c'
 662   (CIntLike c)        == (CIntLike c')      = c == c'
 663   (CString str)       == (CString str')     = str == str'
 664   (CLit lit)          == (CLit lit')        = lit == lit'
 665   (COffset off)       == (COffset off')     = possiblyEqualHeapOffset off off'
 666   (CCode _)           == (CCode _)          = panic "(==) Code in CAddrMode"
 667   (CLabelledCode _ _) == (CLabelledCode _ _)= panic "(==) LabCode in CAddrMode"
 668   _                   == _                  = False
 669
 670
 671 eqRRel :: RegRelative -> RegRelative -> Bool
 672 eqRRel (NodeRel x) (NodeRel y)
 673   = virtualHeapOffsetToInt x == virtualHeapOffsetToInt y
 674
 675 eqRRel l@(SpARel _ _) r@(SpARel _ _)
 676   = spARelToInt l == spARelToInt r
 677
 678 eqRRel l@(SpBRel _ _) r@(SpBRel _ _)
 679   = spBRelToInt l == spBRelToInt r
 680
 681 eqRRel (HpRel hp off) (HpRel hp' off')
 682   = (virtualHeapOffsetToInt (hp  `subOff` off)) ==
 683     (virtualHeapOffsetToInt (hp' `subOff` off'))
 684
 685 eqRRel _ _ = False
 686
 687 eqRetInfo:: ReturnInfo -> ReturnInfo -> Bool
 688 eqRetInfo DirectReturn              DirectReturn              = True
 689 eqRetInfo (StaticVectoredReturn x)  (StaticVectoredReturn x') = x == x'
 690 eqRetInfo _                         _                         = False
 691 #endif {- Data Parallel Haskell -}
 692 \end{code}