%
-% (c) The AQUA Project, Glasgow University, 1993-1996
+% (c) The AQUA Project, Glasgow University, 1993-1998
%
\begin{code}
-#include "HsVersions.h"
-
module Stix (
- CodeSegment(..), StixReg(..), StixTree(..), SYN_IE(StixTreeList),
- sStLitLbl,
+ CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
+ sStLitLbl, pprStixTrees,
+
+ stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg,
+ getUniqLabelNCG,
- stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg,
- stgSpA, stgSuA, stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg,
- stgStdUpdRetVecReg, stgStkStubReg,
- getUniqLabelNCG
+ fixedHS, arrHS
) where
-IMP_Ubiq(){-uitous-}
-IMPORT_1_3(Ratio(Rational))
+#include "HsVersions.h"
+
+import Ratio ( Rational )
-import AbsCSyn ( node, infoptr, MagicId(..) )
+import AbsCSyn ( node, tagreg, MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
-import CLabel ( mkAsmTempLabel, CLabel )
-import PrimRep ( PrimRep )
-import PrimOp ( PrimOp )
+import CallConv ( CallConv, pprCallConv )
+import CLabel ( mkAsmTempLabel, CLabel, pprCLabel )
+import PrimRep ( PrimRep, showPrimRep )
+import PrimOp ( PrimOp, pprPrimOp )
import Unique ( Unique )
-import UniqSupply ( returnUs, thenUs, getUnique, SYN_IE(UniqSM) )
-import Pretty ( ptext, Doc )
+import SMRep ( fixedHdrSize, arrHdrSize )
+import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
+import Outputable
\end{code}
Here is the tag at the nodes of our @StixTree@. Notice its
| StInt Integer -- ** add Kind at some point
| StDouble Rational
| StString FAST_STRING
- | StLitLbl Doc -- literal labels
+ | StLitLbl SDoc -- literal labels
-- (will be _-prefixed on some machines)
- | StLitLit FAST_STRING -- innards from CLitLit
+
| StCLbl CLabel -- labels that we might index into
-- Abstract registers of various kinds
-- Calls to C functions
- | StCall FAST_STRING PrimRep [StixTree]
+ | StCall FAST_STRING CallConv PrimRep [StixTree]
-- Assembly-language comments
sStLitLbl :: FAST_STRING -> StixTree
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}
| StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
-- the abstract C.
+
+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
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:
\begin{code}
-stgBaseReg, stgStkOReg, stgNode, stgTagReg, stgRetReg, stgSpA,
- stgSuA, stgSpB, stgSuB, stgHp, stgHpLim, stgLivenessReg,
- stgStdUpdRetVecReg, stgStkStubReg :: StixTree
+stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
+ :: 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)
+stgTagReg = StReg (StixMagicId tagreg)
+stgSp = StReg (StixMagicId Sp)
+stgSu = StReg (StixMagicId Su)
+stgSpLim = StReg (StixMagicId SpLim)
stgHp = StReg (StixMagicId Hp)
stgHpLim = StReg (StixMagicId HpLim)
-stgLivenessReg = StReg (StixMagicId LivenessReg)
-stgStdUpdRetVecReg = StReg (StixMagicId StdUpdRetVecReg)
-stgStkStubReg = StReg (StixMagicId StkStubReg)
getUniqLabelNCG :: UniqSM CLabel
getUniqLabelNCG
- = getUnique `thenUs` \ u ->
+ = getUniqueUs `thenUs` \ u ->
returnUs (mkAsmTempLabel u)
+
+fixedHS = StInt (toInteger fixedHdrSize)
+arrHS = StInt (toInteger arrHdrSize)
\end{code}
projects / ghc-hetmet.git / blobdiff