Commit 6c381e87 authored by partain's avatar partain

[project @ 1996-03-19 08:58:34 by partain]

simonpj/sansom/partain/dnt 1.3 compiler stuff through 96/03/18
parent 8147a9f0
......@@ -53,8 +53,10 @@ you will screw up the layout where they are used in case expressions!
#ifdef DEBUG
#define ASSERT(e) if (not (e)) then (assertPanic __FILE__ __LINE__) else
#define CHK_Ubiq() import Ubiq
#else
#define ASSERT(e)
#define CHK_Ubiq()
#endif
-- ToDo: ghci needs to load far too many bits of the backend because
......
This diff is collapsed.
{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
interface AbsCFuns where
import AbsCSyn(AbstractC, CAddrMode, CExprMacro, CStmtMacro, MagicId, RegRelative, ReturnInfo)
import BasicLit(BasicLit)
import CLabelInfo(CLabel)
import ClosureInfo(ClosureInfo)
import CostCentre(CostCentre)
import HeapOffs(HeapOffset)
import Maybes(Labda)
import PreludePS(_PackedString)
import PrimKind(PrimKind)
import PrimOps(PrimOp)
import SplitUniq(SplitUniqSupply)
import Unique(Unique)
data AbstractC
data CAddrMode
data PrimKind
data SplitUniqSupply
amodeCanSurviveGC :: CAddrMode -> Bool
flattenAbsC :: SplitUniqSupply -> AbstractC -> AbstractC
getAmodeKind :: CAddrMode -> PrimKind
kindFromMagicId :: MagicId -> PrimKind
mixedPtrLocn :: CAddrMode -> Bool
mixedTypeLocn :: CAddrMode -> Bool
mkAbsCStmtList :: AbstractC -> [AbstractC]
mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
mkAbstractCs :: [AbstractC] -> AbstractC
mkAlgAltsCSwitch :: CAddrMode -> [(Int, AbstractC)] -> AbstractC -> AbstractC
nonemptyAbsC :: AbstractC -> Labda AbstractC
{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
interface AbsCSyn where
import AbsCFuns(amodeCanSurviveGC, flattenAbsC, getAmodeKind, kindFromMagicId, mixedPtrLocn, mixedTypeLocn, mkAbsCStmtList, mkAbsCStmts, mkAbstractCs, mkAlgAltsCSwitch, nonemptyAbsC)
import BasicLit(BasicLit(..), mkMachInt, mkMachWord)
import CLabelInfo(CLabel)
import CharSeq(CSeq)
import ClosureInfo(ClosureInfo, LambdaFormInfo)
import CmdLineOpts(GlobalSwitch, SimplifierSwitch)
import CostCentre(CostCentre)
import HeapOffs(HeapOffset, HpRelOffset(..), SpARelOffset(..), SpBRelOffset(..), VirtualHeapOffset(..), VirtualSpAOffset(..), VirtualSpBOffset(..), addOff, fixedHdrSize, intOff, intOffsetIntoGoods, isZeroOff, maxOff, possiblyEqualHeapOffset, pprHeapOffset, subOff, totHdrSize, varHdrSize, zeroOff)
import Id(ConTag(..), Id)
import Maybes(Labda)
import Outputable(ExportFlag, NamedThing(..), Outputable(..))
import PprAbsC(dumpRealC, writeRealC)
import PreludePS(_PackedString)
import PreludeRatio(Ratio(..))
import Pretty(PprStyle, Pretty(..), PrettyRep)
import PrimKind(PrimKind(..))
import PrimOps(PrimOp)
import SMRep(SMRep)
import SplitUniq(SplitUniqSupply)
import SrcLoc(SrcLoc)
import Stdio(_FILE)
import StgSyn(StgAtom, StgExpr, UpdateFlag)
import TyCon(TyCon)
import UniType(UniType)
import UniqFM(UniqFM)
import UniqSet(UniqSet(..))
import Unique(Unique)
import Unpretty(Unpretty(..))
class NamedThing a where
getExportFlag :: a -> ExportFlag
isLocallyDefined :: a -> Bool
getOrigName :: a -> (_PackedString, _PackedString)
getOccurrenceName :: a -> _PackedString
getInformingModules :: a -> [_PackedString]
getSrcLoc :: a -> SrcLoc
getTheUnique :: a -> Unique
hasType :: a -> Bool
getType :: a -> UniType
fromPreludeCore :: a -> Bool
class Outputable a where
ppr :: PprStyle -> a -> Int -> Bool -> PrettyRep
data AbstractC = AbsCNop | AbsCStmts AbstractC AbstractC | CAssign CAddrMode CAddrMode | CJump CAddrMode | CFallThrough CAddrMode | CReturn CAddrMode ReturnInfo | CSwitch CAddrMode [(BasicLit, AbstractC)] AbstractC | CCodeBlock CLabel AbstractC | CInitHdr ClosureInfo RegRelative CAddrMode Bool | COpStmt [CAddrMode] PrimOp [CAddrMode] Int [MagicId] | CSimultaneous AbstractC | CMacroStmt CStmtMacro [CAddrMode] | CCallProfCtrMacro _PackedString [CAddrMode] | CCallProfCCMacro _PackedString [CAddrMode] | CStaticClosure CLabel ClosureInfo CAddrMode [CAddrMode] | CClosureInfoAndCode ClosureInfo AbstractC (Labda AbstractC) CAddrMode [Char] Int | CRetVector CLabel [Labda CAddrMode] AbstractC | CRetUnVector CLabel CAddrMode | CFlatRetVector CLabel [CAddrMode] | CCostCentreDecl Bool CostCentre | CClosureUpdInfo AbstractC | CSplitMarker
data BasicLit = MachChar Char | MachStr _PackedString | MachAddr Integer | MachInt Integer Bool | MachFloat (Ratio Integer) | MachDouble (Ratio Integer) | MachLitLit _PackedString PrimKind | NoRepStr _PackedString | NoRepInteger Integer | NoRepRational (Ratio Integer)
data CAddrMode = CVal RegRelative PrimKind | CAddr RegRelative | CReg MagicId | CTableEntry CAddrMode CAddrMode PrimKind | CTemp Unique PrimKind | CLbl CLabel PrimKind | CUnVecLbl CLabel CLabel | CCharLike CAddrMode | CIntLike CAddrMode | CString _PackedString | CLit BasicLit | CLitLit _PackedString PrimKind | COffset HeapOffset | CCode AbstractC | CLabelledCode CLabel AbstractC | CJoinPoint Int Int | CMacroExpr PrimKind CExprMacro [CAddrMode] | CCostCentre CostCentre Bool
data CExprMacro = INFO_PTR | ENTRY_CODE | INFO_TAG | EVAL_TAG
data CLabel
data CSeq
data CStmtMacro = ARGS_CHK_A_LOAD_NODE | ARGS_CHK_A | ARGS_CHK_B_LOAD_NODE | ARGS_CHK_B | HEAP_CHK | STK_CHK | UPD_CAF | UPD_IND | UPD_INPLACE_NOPTRS | UPD_INPLACE_PTRS | UPD_BH_UPDATABLE | UPD_BH_SINGLE_ENTRY | PUSH_STD_UPD_FRAME | POP_STD_UPD_FRAME | SET_ARITY | CHK_ARITY | SET_TAG
data ClosureInfo
data LambdaFormInfo
data GlobalSwitch
data SimplifierSwitch
data CostCentre
data HeapOffset
type HpRelOffset = HeapOffset
data MagicId = BaseReg | StkOReg | VanillaReg PrimKind Int# | FloatReg Int# | DoubleReg Int# | TagReg | RetReg | SpA | SuA | SpB | SuB | Hp | HpLim | LivenessReg | ActivityReg | StdUpdRetVecReg | StkStubReg | CurCostCentre | VoidReg
data RegRelative = HpRel HeapOffset HeapOffset | SpARel Int Int | SpBRel Int Int | NodeRel HeapOffset
data ReturnInfo = DirectReturn | StaticVectoredReturn Int | DynamicVectoredReturn CAddrMode
type SpARelOffset = Int
type SpBRelOffset = Int
type VirtualHeapOffset = HeapOffset
type VirtualSpAOffset = Int
type VirtualSpBOffset = Int
type ConTag = Int
data Id
data Labda a
data ExportFlag
data PprStyle
type Pretty = Int -> Bool -> PrettyRep
data PrettyRep
data PrimKind = PtrKind | CodePtrKind | DataPtrKind | RetKind | InfoPtrKind | CostCentreKind | CharKind | IntKind | WordKind | AddrKind | FloatKind | DoubleKind | MallocPtrKind | StablePtrKind | ArrayKind | ByteArrayKind | VoidKind
data PrimOp
data SMRep
data SplitUniqSupply
data SrcLoc
data StgAtom a
data StgExpr a b
data UpdateFlag
data TyCon
data UniType
data UniqFM a
type UniqSet a = UniqFM a
data Unique
type Unpretty = CSeq
amodeCanSurviveGC :: CAddrMode -> Bool
flattenAbsC :: SplitUniqSupply -> AbstractC -> AbstractC
getAmodeKind :: CAddrMode -> PrimKind
kindFromMagicId :: MagicId -> PrimKind
mixedPtrLocn :: CAddrMode -> Bool
mixedTypeLocn :: CAddrMode -> Bool
mkAbsCStmtList :: AbstractC -> [AbstractC]
mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
mkAbstractCs :: [AbstractC] -> AbstractC
mkAlgAltsCSwitch :: CAddrMode -> [(Int, AbstractC)] -> AbstractC -> AbstractC
nonemptyAbsC :: AbstractC -> Labda AbstractC
mkMachInt :: Integer -> BasicLit
mkMachWord :: Integer -> BasicLit
addOff :: HeapOffset -> HeapOffset -> HeapOffset
fixedHdrSize :: HeapOffset
dumpRealC :: (GlobalSwitch -> Bool) -> AbstractC -> [Char]
infoptr :: MagicId
intOff :: Int -> HeapOffset
intOffsetIntoGoods :: HeapOffset -> Labda Int
isVolatileReg :: MagicId -> Bool
isZeroOff :: HeapOffset -> Bool
maxOff :: HeapOffset -> HeapOffset -> HeapOffset
mkCCostCentre :: CostCentre -> CAddrMode
mkIntCLit :: Int -> CAddrMode
node :: MagicId
possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
pprHeapOffset :: PprStyle -> HeapOffset -> CSeq
subOff :: HeapOffset -> HeapOffset -> HeapOffset
totHdrSize :: SMRep -> HeapOffset
varHdrSize :: SMRep -> HeapOffset
zeroOff :: HeapOffset
writeRealC :: (GlobalSwitch -> Bool) -> _FILE -> AbstractC -> _State _RealWorld -> ((), _State _RealWorld)
instance Eq MagicId
instance Eq BasicLit
instance Eq CLabel
instance Eq GlobalSwitch
instance Eq SimplifierSwitch
instance Eq Id
instance Eq PrimKind
instance Eq PrimOp
instance Eq Unique
instance Ord BasicLit
instance Ord CLabel
instance Ord GlobalSwitch
instance Ord SimplifierSwitch
instance Ord Id
instance Ord PrimKind
instance Ord Unique
instance NamedThing Id
instance (Outputable a, Outputable b) => Outputable (a, b)
instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c)
instance Outputable BasicLit
instance Outputable Bool
instance Outputable Id
instance Outputable PrimKind
instance Outputable PrimOp
instance Outputable a => Outputable (StgAtom a)
instance (Outputable a, Outputable b, Ord b) => Outputable (StgExpr a b)
instance Outputable a => Outputable [a]
instance Text CExprMacro
instance Text CStmtMacro
instance Text Unique
This diff is collapsed.
This module deals with printing (a) C string literals and (b) C labels.
\begin{code}
#include "HsVersions.h"
module CStrings(
cSEP,
pp_cSEP,
identToC, modnameToC,
stringToC, charToC,
charToEasyHaskell
) where
CHK_Ubiq() -- debugging consistency check
import Pretty
import Unpretty( uppChar )
\end{code}
\begin{verbatim}
_ is the main separator
orig becomes
**** *******
_ Zu
' Zq (etc for ops ??)
<funny char> Z[hex-digit][hex-digit]
Prelude<x> ZP<x>
<std class> ZC<?>
<std tycon> ZT<?>
\end{verbatim}
\begin{code}
cSEP = SLIT("_") -- official C separator
pp_cSEP = uppChar '_'
identToC :: FAST_STRING -> Pretty
modnameToC :: FAST_STRING -> FAST_STRING
stringToC :: String -> String
charToC, charToEasyHaskell :: Char -> String
-- stringToC: the hassle is what to do w/ strings like "ESC 0"...
stringToC "" = ""
stringToC [c] = charToC c
stringToC (c:cs)
-- if we have something "octifiable" in "c", we'd better "octify"
-- the rest of the string, too.
= if (c < ' ' || c > '~')
then (charToC c) ++ (concat (map char_to_C cs))
else (charToC c) ++ (stringToC cs)
where
char_to_C c | c == '\n' = "\\n" -- use C escapes when we can
| c == '\a' = "\\a"
| c == '\b' = "\\b" -- ToDo: chk some of these...
| c == '\r' = "\\r"
| c == '\t' = "\\t"
| c == '\f' = "\\f"
| c == '\v' = "\\v"
| otherwise = '\\' : (octify (ord c))
charToC c = if (c >= ' ' && c <= '~') -- non-portable...
then case c of
'\'' -> "\\'"
'\\' -> "\\\\"
'"' -> "\\\""
'\n' -> "\\n"
'\a' -> "\\a"
'\b' -> "\\b"
'\r' -> "\\r"
'\t' -> "\\t"
'\f' -> "\\f"
'\v' -> "\\v"
_ -> [c]
else '\\' : (octify (ord c))
-- really: charToSimpleHaskell
charToEasyHaskell c
= if (c >= 'a' && c <= 'z')
|| (c >= 'A' && c <= 'Z')
|| (c >= '0' && c <= '9')
then [c]
else case c of
_ -> '\\' : 'o' : (octify (ord c))
octify :: Int -> String
octify n
= if n < 8 then
[chr (n + ord '0')]
else
octify (n `quot` 8) ++ [chr (n `rem` 8 + ord '0')]
identToC ps
= let
str = _UNPK_ ps
in
ppBeside
(case str of
's':'t':'d':_ -> -- avoid "stdin", "stdout", and "stderr"...
ppChar 'Z'
_ -> ppNil)
(if (all isAlphanum str) -- we gamble that this test will succeed...
then ppPStr ps
else ppIntersperse ppNil (map char_to_c str))
where
char_to_c 'Z' = ppPStr SLIT("ZZ")
char_to_c '&' = ppPStr SLIT("Za")
char_to_c '|' = ppPStr SLIT("Zb")
char_to_c ':' = ppPStr SLIT("Zc")
char_to_c '/' = ppPStr SLIT("Zd")
char_to_c '=' = ppPStr SLIT("Ze")
char_to_c '>' = ppPStr SLIT("Zg")
char_to_c '#' = ppPStr SLIT("Zh")
char_to_c '<' = ppPStr SLIT("Zl")
char_to_c '-' = ppPStr SLIT("Zm")
char_to_c '!' = ppPStr SLIT("Zn")
char_to_c '.' = ppPStr SLIT("Zo")
char_to_c '+' = ppPStr SLIT("Zp")
char_to_c '\'' = ppPStr SLIT("Zq")
char_to_c '*' = ppPStr SLIT("Zt")
char_to_c '_' = ppPStr SLIT("Zu")
char_to_c c = if isAlphanum c
then ppChar c
else ppBeside (ppChar 'Z') (ppInt (ord c))
\end{code}
For \tr{modnameToC}, we really only have to worry about \tr{'}s (quote
chars) in the name. Rare.
\begin{code}
modnameToC ps
= let
str = _UNPK_ ps
in
if not (any quote_here str) then
ps
else
_PK_ (concat (map char_to_c str))
where
quote_here '\'' = True
quote_here _ = False
char_to_c c
= if isAlphanum c then [c] else 'Z' : (show (ord c))
\end{code}
{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
interface Costs where
import AbsCSyn(AbstractC, CAddrMode)
data CostRes = Cost (Int, Int, Int, Int, Int)
data Side = Lhs | Rhs
addrModeCosts :: CAddrMode -> Side -> CostRes
costs :: AbstractC -> CostRes
nullCosts :: CostRes
instance Eq CostRes
instance Num CostRes
instance Text CostRes
This diff is collapsed.
{-# GHC_PRAGMA INTERFACE VERSION 5 #-}
interface HeapOffs where
import CharSeq(CSeq)
import MachDesc(Target)
import Maybes(Labda)
import Pretty(PprStyle)
import SMRep(SMRep)
data HeapOffset
type HpRelOffset = HeapOffset
type SpARelOffset = Int
type SpBRelOffset = Int
type VirtualHeapOffset = HeapOffset
type VirtualSpAOffset = Int
type VirtualSpBOffset = Int
addOff :: HeapOffset -> HeapOffset -> HeapOffset
fixedHdrSize :: HeapOffset
hpRelToInt :: Target -> HeapOffset -> Int
intOff :: Int -> HeapOffset
intOffsetIntoGoods :: HeapOffset -> Labda Int
isZeroOff :: HeapOffset -> Bool
maxOff :: HeapOffset -> HeapOffset -> HeapOffset
possiblyEqualHeapOffset :: HeapOffset -> HeapOffset -> Bool
pprHeapOffset :: PprStyle -> HeapOffset -> CSeq
subOff :: HeapOffset -> HeapOffset -> HeapOffset
totHdrSize :: SMRep -> HeapOffset
varHdrSize :: SMRep -> HeapOffset
zeroOff :: HeapOffset
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[HeapOffs]{Abstract C: heap offsets}
......@@ -12,11 +12,7 @@ INTERNAL MODULE: should be accessed via @AbsCSyn.hi@.
#include "HsVersions.h"
module HeapOffs (
#ifndef DPH
HeapOffset,
#else
HeapOffset(..), -- DPH needs to do a little peaking inside this thing.
#endif {- Data Parallel Haskell -}
zeroOff, intOff, fixedHdrSize, totHdrSize, varHdrSize,
maxOff, addOff, subOff,
......@@ -26,24 +22,27 @@ module HeapOffs (
intOffsetIntoGoods,
#if 0
#if ! OMIT_NATIVE_CODEGEN
hpRelToInt,
hpRelToInt,
#endif
#endif
VirtualHeapOffset(..), HpRelOffset(..),
VirtualSpAOffset(..), VirtualSpBOffset(..),
SpARelOffset(..), SpBRelOffset(..)
) where
) where
import Ubiq{-uitous-}
import ClosureInfo -- esp. about SMReps
import SMRep
import ClosureInfo ( isSpecRep )
import Maybes ( catMaybes )
import SMRep
import Unpretty -- ********** NOTE **********
import Util ( panic )
#if ! OMIT_NATIVE_CODEGEN
import MachDesc
--import MachDesc ( Target )
#endif
import Maybes ( catMaybes, Maybe(..) )
import Outputable
import Unpretty -- ********** NOTE **********
import Util
\end{code}
%************************************************************************
......@@ -63,7 +62,7 @@ import Util
* Node, the ptr to the closure, pts at its info-ptr field
-}
data HeapOffset
= MkHeapOffset
= MkHeapOffset
FAST_INT -- this many words...
......@@ -88,13 +87,8 @@ data HeapOffset
deriving () -- but: see `eqOff` below
#if defined(__GLASGOW_HASKELL__)
data SMRep__Int = SMRI_ SMRep Int#
#define SMRI(a,b) (SMRI_ a b)
#else
type SMRep__Int = (SMRep, Int)
#define SMRI(a,b) (a, b)
#endif
type VirtualHeapOffset = HeapOffset
type VirtualSpAOffset = Int
......@@ -113,7 +107,7 @@ intOff IBOX(n) = MkHeapOffset n ILIT(0) [] []
fixedHdrSize = MkHeapOffset ILIT(0) ILIT(1) [] []
totHdrSize sm_rep
totHdrSize sm_rep
= if isSpecRep sm_rep -- Tot hdr size for a spec rep is just FixedHdrSize
then MkHeapOffset ILIT(0) ILIT(1) [] []
else MkHeapOffset ILIT(0) ILIT(0) [] [SMRI(sm_rep, ILIT(1))]
......@@ -150,7 +144,7 @@ maxOff off1@(MkHeapOffset int_offs1 fixhdr_offs1 varhdr_offs1 tothdr_offs1)
else
MaxHeapOffset off1 off2
where
-- Normalise, by realising that each tot-hdr is really a
-- Normalise, by realising that each tot-hdr is really a
-- var-hdr plus a fixed-hdr
n_tothdr1 = total_of tothdr_offs1
real_fixed1 = fixhdr_offs1 _ADD_ n_tothdr1
......@@ -215,7 +209,7 @@ add_HdrSizes offs1 [] = offs1
add_HdrSizes as@(off1@(SMRI(rep1,n1)) : offs1) bs@(off2@(SMRI(rep2,n2)) : offs2)
= if rep1 `ltSMRepHdr` rep2 then
off1 : (add_HdrSizes offs1 bs)
else
else
if rep2 `ltSMRepHdr` rep1 then
off2 : (add_HdrSizes as offs2)
else
......@@ -293,7 +287,7 @@ pprHeapOffset sty (MkHeapOffset int_offs fxdhdr_offs varhdr_offs tothdr_offs)
\end{code}
\begin{code}
pprHeapOffsetPieces :: PprStyle
pprHeapOffsetPieces :: PprStyle
-> FAST_INT -- Words
-> FAST_INT -- Fixed hdrs
-> [SMRep__Int] -- Var hdrs
......@@ -336,7 +330,7 @@ pprHeapOffsetPieces sty int_offs fxdhdr_offs varhdr_offs tothdr_offs
pp_hdr pp_str (SMRI(rep, n))
= if n _EQ_ ILIT(1) then
uppBeside (uppStr (show rep)) pp_str
else
else
uppBesides [uppInt IBOX(n), uppChar '*', uppStr (show rep), pp_str]
\end{code}
......@@ -366,6 +360,7 @@ intOffsetIntoGoods anything_else = Nothing
\end{code}
\begin{code}
#if 0
#if ! OMIT_NATIVE_CODEGEN
hpRelToInt :: Target -> HeapOffset -> Int
......@@ -399,4 +394,5 @@ hpRelToInt target (MkHeapOffset base fhs vhs ths)
vhs_size r = (varHeaderSize target r) :: Int
#endif