%
-% (c) The AQUA Project, Glasgow University, 1993-1995
+% (c) The AQUA Project, Glasgow University, 1993-1998
%
\begin{code}
-#include "HsVersions.h"
-
module Stix (
- CodeSegment(..), StixReg(..), StixTree(..), StixTreeList(..),
+ CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
sStLitLbl,
- stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg,
- stgSpA, stgSuA, stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg,
--- stgActivityReg,
- stgStdUpdRetVecReg, stgStkStubReg,
+ stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg,
getUniqLabelNCG,
- -- And for self-sufficiency, by golly...
- MagicId, CLabel, PrimKind, PrimOp, Unique,
- SplitUniqSupply, SUniqSM(..)
+ fixedHS, arrHS
) where
-import AbsCSyn ( MagicId(..), kindFromMagicId, node, infoptr )
-import AbsPrel ( showPrimOp, PrimOp
- IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
- IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
- )
-import CLabelInfo ( CLabel, mkAsmTempLabel )
+#include "HsVersions.h"
+
+import Ratio ( Rational )
+
+import AbsCSyn ( node, tagreg, MagicId(..) )
+import AbsCUtils ( magicIdPrimRep )
+import CallConv ( CallConv )
+import CLabel ( mkAsmTempLabel, CLabel )
+import PrimRep ( PrimRep )
+import PrimOp ( PrimOp )
+import Unique ( Unique )
+import SMRep ( fixedHdrSize, arrHdrSize )
+import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
import Outputable
-import PrimKind ( PrimKind(..) )
-import SplitUniq
-import Unique
-import Unpretty
-import Util
\end{code}
Here is the tag at the nodes of our @StixTree@. Notice its
-relationship with @PrimOp@ in prelude/PrimOps.
+relationship with @PrimOp@ in prelude/PrimOp.
\begin{code}
+data StixTree
+ = -- Segment (text or data)
-data StixTree =
-
- -- Segment (text or data)
-
- StSegment CodeSegment
-
- -- We can tag the leaves with constants/immediates.
+ StSegment CodeSegment
- | StInt Integer -- ** add Kind at some point
-#if __GLASGOW_HASKELL__ <= 22
- | StDouble Double
-#else
- | StDouble Rational
-#endif
- | StString FAST_STRING
- | StLitLbl Unpretty -- literal labels (will be _-prefixed on some machines)
- | StLitLit FAST_STRING -- innards from CLitLit
- | StCLbl CLabel -- labels that we might index into
+ -- We can tag the leaves with constants/immediates.
- -- Abstract registers of various kinds
+ | StInt Integer -- ** add Kind at some point
+ | StDouble Rational
+ | StString FAST_STRING
+ | StLitLbl SDoc -- literal labels
+ -- (will be _-prefixed on some machines)
+ | StLitLit FAST_STRING -- innards from CLitLit
+ | StCLbl CLabel -- labels that we might index into
- | StReg StixReg
+ -- Abstract registers of various kinds
- -- A typed offset from a base location
+ | StReg StixReg
- | StIndex PrimKind StixTree StixTree -- kind, base, offset
+ -- A typed offset from a base location
- -- An indirection from an address to its contents.
+ | StIndex PrimRep StixTree StixTree -- kind, base, offset
- | StInd PrimKind StixTree
+ -- An indirection from an address to its contents.
- -- Assignment is typed to determine size and register placement
+ | StInd PrimRep StixTree
- | StAssign PrimKind StixTree StixTree -- dst, src
+ -- Assignment is typed to determine size and register placement
- -- A simple assembly label that we might jump to.
+ | StAssign PrimRep StixTree StixTree -- dst, src
- | StLabel CLabel
+ -- A simple assembly label that we might jump to.
- -- A function header and footer
+ | StLabel CLabel
- | StFunBegin CLabel
- | StFunEnd CLabel
+ -- A function header and footer
- -- An unconditional jump. This instruction is terminal.
- -- Dynamic targets are allowed
+ | StFunBegin CLabel
+ | StFunEnd CLabel
- | StJump StixTree
+ -- An unconditional jump. This instruction is terminal.
+ -- Dynamic targets are allowed
- -- A fall-through, from slow to fast
+ | StJump StixTree
- | StFallThrough CLabel
+ -- A fall-through, from slow to fast
- -- A conditional jump. This instruction can be non-terminal :-)
- -- Only static, local, forward labels are allowed
+ | StFallThrough CLabel
- | StCondJump CLabel StixTree
+ -- A conditional jump. This instruction can be non-terminal :-)
+ -- Only static, local, forward labels are allowed
- -- Raw data (as in an info table).
+ | StCondJump CLabel StixTree
- | StData PrimKind [StixTree]
+ -- Raw data (as in an info table).
- -- Primitive Operations
+ | StData PrimRep [StixTree]
- | StPrim PrimOp [StixTree]
+ -- Primitive Operations
- -- Calls to C functions
+ | StPrim PrimOp [StixTree]
- | StCall FAST_STRING PrimKind [StixTree]
+ -- Calls to C functions
- -- Comments, of course
+ | StCall FAST_STRING CallConv PrimRep [StixTree]
- | StComment FAST_STRING -- For assembly comments
+ -- Assembly-language comments
- deriving ()
+ | StComment FAST_STRING
sStLitLbl :: FAST_STRING -> StixTree
-sStLitLbl s = StLitLbl (uppPStr s)
+sStLitLbl s = StLitLbl (ptext s)
\end{code}
Stix registers can have two forms. They {\em may} or {\em may not}
-map to real, machine level registers.
+map to real, machine-level registers.
\begin{code}
+data StixReg
+ = StixMagicId MagicId -- Regs which are part of the abstract machine model
-data StixReg = StixMagicId MagicId -- Regs which are part of the abstract machine model
-
- | StixTemp Unique PrimKind -- "Regs" which model local variables (CTemps) in
+ | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
-- the abstract C.
- deriving ()
-
\end{code}
We hope that every machine supports the idea of data segment and text
-segment (or that it has no segments at all, and we can lump these together).
+segment (or that it has no segments at all, and we can lump these
+together).
\begin{code}
-
-data CodeSegment = DataSegment | TextSegment deriving (Eq)
+data CodeSegment = DataSegment | TextSegment deriving Eq
type StixTreeList = [StixTree] -> [StixTree]
-
\end{code}
--- Stix Trees for STG registers
-
+Stix Trees for STG registers:
\begin{code}
-
-stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg, stgSpA, stgSuA,
- stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg{-, stgActivityReg-}, stgStdUpdRetVecReg,
- stgStkStubReg :: StixTree
-
-stgBaseReg = StReg (StixMagicId BaseReg)
-stgStkOReg = StReg (StixMagicId StkOReg)
-stgNode = StReg (StixMagicId node)
-stgInfoPtr = StReg (StixMagicId infoptr)
-stgTagReg = StReg (StixMagicId TagReg)
-stgRetReg = StReg (StixMagicId RetReg)
-stgSpA = StReg (StixMagicId SpA)
-stgSuA = StReg (StixMagicId SuA)
-stgSpB = StReg (StixMagicId SpB)
-stgSuB = StReg (StixMagicId SuB)
-stgHp = StReg (StixMagicId Hp)
-stgHpLim = StReg (StixMagicId HpLim)
-stgLivenessReg = StReg (StixMagicId LivenessReg)
---stgActivityReg = StReg (StixMagicId ActivityReg)
-stgStdUpdRetVecReg = StReg (StixMagicId StdUpdRetVecReg)
-stgStkStubReg = StReg (StixMagicId StkStubReg)
-
-getUniqLabelNCG :: SUniqSM CLabel
-getUniqLabelNCG =
- getSUnique `thenSUs` \ u ->
- returnSUs (mkAsmTempLabel u)
-
+stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
+ :: StixTree
+
+stgBaseReg = StReg (StixMagicId BaseReg)
+stgNode = StReg (StixMagicId node)
+stgTagReg = StReg (StixMagicId tagreg)
+stgSp = StReg (StixMagicId Sp)
+stgSu = StReg (StixMagicId Su)
+stgSpLim = StReg (StixMagicId SpLim)
+stgHp = StReg (StixMagicId Hp)
+stgHpLim = StReg (StixMagicId HpLim)
+
+getUniqLabelNCG :: UniqSM CLabel
+getUniqLabelNCG
+ = getUniqueUs `thenUs` \ u ->
+ returnUs (mkAsmTempLabel u)
+
+fixedHS = StInt (toInteger fixedHdrSize)
+arrHS = StInt (toInteger arrHdrSize)
\end{code}
projects / ghc-hetmet.git / blobdiff