%
-% (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(..),
- sStLitLbl,
+ CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
+ sStLitLbl, pprStixTrees,
- 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, pprCallConv )
+import CLabel ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
+import PrimRep ( PrimRep, showPrimRep )
+import PrimOp ( PrimOp, pprPrimOp )
+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
+ StSegment CodeSegment
- -- We can tag the leaves with constants/immediates.
+ -- We can tag the leaves with constants/immediates.
- | 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
+ | StInt Integer -- ** add Kind at some point
+ | StDouble Rational
+ | StString FAST_STRING
+ | StLitLbl SDoc -- literal labels
+ -- (will be _-prefixed on some machines)
- -- Abstract registers of various kinds
+ | 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)
+
+
+pprStixTrees :: [StixTree] -> SDoc
+pprStixTrees ts
+ = vcat [
+ vcat (map ppStixTree ts),
+ char ' ',
+ char ' '
+ ]
+
+paren t = char '(' <> t <> char ')'
+
+ppStixTree :: StixTree -> SDoc
+ppStixTree t
+ = case t of
+ StSegment cseg -> paren (ppCodeSegment cseg)
+ StInt i -> paren (integer i)
+ StDouble rat -> paren (text "Double" <+> rational rat)
+ StString str -> paren (text "Str" <+> ptext str)
+ StComment str -> paren (text "Comment" <+> ptext str)
+ StLitLbl sd -> sd
+ StCLbl lbl -> pprCLabel lbl
+ StReg reg -> ppStixReg reg
+ StIndex k b o -> paren (ppStixTree b <+> char '+' <>
+ pprPrimRep k <+> ppStixTree o)
+ StInd k t -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']'
+ StAssign k d s -> ppStixTree d <> text " :=" <> pprPrimRep k
+ <> text " " <> ppStixTree s
+ StLabel ll -> pprCLabel ll <+> char ':'
+ StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
+ StFunEnd ll -> paren (text "FunEnd" <+> pprCLabel ll)
+ StJump t -> paren (text "Jump" <+> ppStixTree t)
+ StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
+ StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t)
+ StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
+ hsep (map ppStixTree ds))
+ StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts))
+ StCall nm cc k args
+ -> paren (text "Call" <+> ptext nm <+>
+ pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
+ where
+ pprPrimRep = text . showPrimRep
\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 ()
+ppStixReg (StixMagicId mid)
+ = ppMId mid
+ppStixReg (StixTemp u pr)
+ = hcat [text "Temp(", ppr u, ppr pr, char ')']
+
+
+ppMId BaseReg = text "BaseReg"
+ppMId (VanillaReg kind n) = hcat [text "IntReg(", int (I# n), char ')']
+ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')']
+ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')']
+ppMId (LongReg kind n) = hcat [text "LongReg(", int (I# n), char ')']
+ppMId Sp = text "Sp"
+ppMId Su = text "Su"
+ppMId SpLim = text "SpLim"
+ppMId Hp = text "Hp"
+ppMId HpLim = text "HpLim"
+ppMId CurCostCentre = text "CCC"
+ppMId VoidReg = text "VoidReg"
\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, Show)
+ppCodeSegment = text . show
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}