Commit 423d477b authored by simonmar's avatar simonmar

[project @ 2004-08-13 13:04:50 by simonmar]

Merge backend-hacking-branch onto HEAD.  Yay!
parent 553e90d9
......@@ -66,10 +66,10 @@ name = Util.global (value) :: IORef (ty); \
#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg))
#define ASSERTM(e) ASSERT(e) do
#else
#define ASSERT(e)
#define ASSERT2(e,msg)
#define ASSERT(e) if False then error "ASSERT" else
#define ASSERT2(e,msg) if False then error "ASSERT2" else
#define ASSERTM(e)
#define WARN(e,msg)
#define WARN(e,msg) if False then error "WARN" else
#endif
-- temporary usage assertion control KSW 2000-10
......
......@@ -232,8 +232,8 @@ CLEAN_FILES += $(CONFIG_HS)
ALL_DIRS = \
utils basicTypes types hsSyn prelude rename typecheck deSugar coreSyn \
specialise simplCore stranal stgSyn simplStg codeGen absCSyn main \
profiling parser cprAnalysis compMan ndpFlatten cbits iface
specialise simplCore stranal stgSyn simplStg codeGen main \
profiling parser cprAnalysis compMan ndpFlatten cbits iface cmm
# Make sure we include Config.hs even if it doesn't exist yet...
ALL_SRCS += $(CONFIG_HS)
......@@ -410,9 +410,6 @@ ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
main/SysTools_HC_OPTS += '-\#include <windows.h>' '-\#include <process.h>'
endif
# Required due to use of Concurrent.myThreadId
utils/Panic_HC_OPTS += -fvia-C
parser/Lexer_HC_OPTS += -funbox-strict-fields
# ghc_strlen percolates through so many modules that it is easier to get its
......@@ -553,8 +550,6 @@ endif
# typecheck/TcTyDecls_HC_OPTS += -auto-all
# typecheck/TcType_HC_OPTS += -auto-all
# typecheck/TcUnify_HC_OPTS += -auto-all
#
# absCSyn/PprAbsC_HC_OPTS += -auto-all
coreSyn/CorePrep_HC_OPTS += -auto-all
......
* Can a scoped type variable denote a type scheme?
New back end thoughts
-----------------------------------------------------------------------------
Codegen notes
* jumps to ImpossibleBranch should be removed.
* Profiling:
- when updating a closure with an indirection to a function,
we should make a permanent indirection.
- check that we're bumping the scc count appropriately
* check perf & binary sizes against the HEAD
-----------------------------------------------------------------------------
C backend notes
* use STGCALL macros for foreign calls (doesn't look like volatile regs
are handled properly at the mo).
-----------------------------------------------------------------------------
Cmm parser notes
* switches
* need to cater for unexported procedures/info tables?
* We should be able to get rid of entry labels, use info labels only.
- we need a %ENTRY_LBL(info_lbl) macro, so that instead of
JMP_(foo_entry) we can write jump %ENTRY_LBL(foo_info).
-----------------------------------------------------------------------------
* Move arg-descr from LFInfo to ClosureInfo?
But: only needed for functions
* Move all of CgClosure.link_caf into NewCaf, and newDynCaf
* If the case binder is dead, and the constr is nullary,
do we need to assign to Node?
-------------------------
* Relation between separate type sigs and pattern type sigs
f :: forall a. a->a
f :: b->b = e -- No: monomorphic
......
This diff is collapsed.
This diff is collapsed.
This module deals with printing C string literals
\begin{code}
module CStrings(
CLabelString, isCLabelString, pprCLabelString,
pp_cSEP,
pprFSInCStyle, pprStringInCStyle
) where
#include "HsVersions.h"
import Char ( ord, chr, isAlphaNum )
import FastString
import Outputable
\end{code}
\begin{code}
type CLabelString = FastString -- A C label, completely unencoded
pprCLabelString :: CLabelString -> SDoc
pprCLabelString lbl = ftext lbl
isCLabelString :: CLabelString -> Bool -- Checks to see if this is a valid C label
isCLabelString lbl
= all ok (unpackFS lbl)
where
ok c = isAlphaNum c || c == '_' || c == '.'
-- The '.' appears in e.g. "foo.so" in the
-- module part of a ExtName. Maybe it should be separate
pp_cSEP = char '_'
\end{code}
\begin{code}
pprFSInCStyle :: FastString -> SDoc
-- Assumes it contains only characters '\0'..'\xFF'!
pprFSInCStyle fs = pprStringInCStyle (unpackFS fs)
pprStringInCStyle :: String -> SDoc
pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
charToC :: Char -> String
charToC '\"' = "\\\""
charToC '\'' = "\\\'"
charToC '\\' = "\\\\"
charToC c | c >= ' ' && c <= '~' = [c]
| c > '\xFF' = panic ("charToC "++show c)
| otherwise = ['\\',
chr (ord '0' + ord c `div` 64),
chr (ord '0' + ord c `div` 8 `mod` 8),
chr (ord '0' + ord c `mod` 8)]
\end{code}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -15,7 +15,7 @@ module Id (
-- Taking an Id apart
idName, idType, idUnique, idInfo,
idPrimRep, isId, globalIdDetails,
isId, globalIdDetails, idPrimRep,
recordSelectorFieldLabel,
-- Modifying an Id
......@@ -90,7 +90,8 @@ import Var ( Id, DictId,
globalIdDetails
)
import qualified Var ( mkLocalId, mkGlobalId, mkSpecPragmaId, mkExportedLocalId )
import Type ( Type, typePrimRep, addFreeTyVars, seqType, splitTyConApp_maybe )
import Type ( Type, typePrimRep, addFreeTyVars, seqType,
splitTyConApp_maybe, PrimRep )
import TysPrim ( statePrimTyCon )
import IdInfo
......@@ -105,7 +106,6 @@ import Name ( Name, OccName, nameIsLocalOrFrom,
)
import Module ( Module )
import OccName ( EncodedFS, mkWorkerOcc )
import PrimRep ( PrimRep )
import FieldLabel ( FieldLabel )
import Maybes ( orElse )
import SrcLoc ( SrcLoc )
......
......@@ -10,7 +10,7 @@ module Literal
, mkMachInt64, mkMachWord64
, litSize
, litIsDupable, litIsTrivial
, literalType, literalPrimRep
, literalType,
, hashLiteral
, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
......@@ -29,10 +29,7 @@ module Literal
import TysPrim ( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
)
import PrimRep ( PrimRep(..) )
import Type ( Type )
import CStrings ( pprFSInCStyle )
import Outputable
import FastTypes
import FastString
......@@ -298,31 +295,16 @@ litSize _other = 1
~~~~~
\begin{code}
literalType :: Literal -> Type
literalType (MachChar _) = charPrimTy
literalType (MachStr _) = addrPrimTy
literalType (MachNullAddr) = addrPrimTy
literalType (MachInt _) = intPrimTy
literalType (MachWord _) = wordPrimTy
literalType (MachInt64 _) = int64PrimTy
literalType (MachWord64 _) = word64PrimTy
literalType (MachFloat _) = floatPrimTy
literalType (MachDouble _) = doublePrimTy
literalType (MachLabel _ _) = addrPrimTy
\end{code}
\begin{code}
literalPrimRep :: Literal -> PrimRep
literalPrimRep (MachChar _) = CharRep
literalPrimRep (MachStr _) = AddrRep -- specifically: "char *"
literalPrimRep (MachNullAddr) = AddrRep
literalPrimRep (MachInt _) = IntRep
literalPrimRep (MachWord _) = WordRep
literalPrimRep (MachInt64 _) = Int64Rep
literalPrimRep (MachWord64 _) = Word64Rep
literalPrimRep (MachFloat _) = FloatRep
literalPrimRep (MachDouble _) = DoubleRep
literalPrimRep (MachLabel _ _) = AddrRep
literalType MachNullAddr = addrPrimTy
literalType (MachChar _) = charPrimTy
literalType (MachStr _) = addrPrimTy
literalType (MachInt _) = intPrimTy
literalType (MachWord _) = wordPrimTy
literalType (MachInt64 _) = int64PrimTy
literalType (MachWord64 _) = word64PrimTy
literalType (MachFloat _) = floatPrimTy
literalType (MachDouble _) = doublePrimTy
literalType (MachLabel _ _) = addrPrimTy
\end{code}
......@@ -360,71 +342,24 @@ litTag (MachLabel _ _) = _ILIT(10)
exceptions: MachFloat gets an initial keyword prefix.
\begin{code}
pprLit lit
= getPprStyle $ \ sty ->
let
code_style = codeStyle sty
in
case lit of
MachChar ch | code_style -> hcat [ptext SLIT("(C_)"), text (show (ord ch))]
| otherwise -> pprHsChar ch
MachStr s | code_style -> pprFSInCStyle s
| otherwise -> pprHsString s
-- Warning: printing MachStr in code_style assumes it contains
-- only characters '\0'..'\xFF'!
MachInt i | code_style && i == tARGET_MIN_INT -> parens (integer (i+1) <> text "-1")
-- Avoid a problem whereby gcc interprets
-- the constant minInt as unsigned.
| otherwise -> pprIntVal i
MachInt64 i | code_style -> pprIntVal i -- Same problem with gcc???
| otherwise -> ptext SLIT("__int64") <+> integer i
MachWord w | code_style -> pprHexVal w
| otherwise -> ptext SLIT("__word") <+> integer w
MachWord64 w | code_style -> pprHexVal w
| otherwise -> ptext SLIT("__word64") <+> integer w
MachFloat f | code_style -> ptext SLIT("(StgFloat)") <> code_rational f
| otherwise -> ptext SLIT("__float") <+> rational f
MachDouble d | code_style -> code_rational d
| otherwise -> rational d
MachNullAddr | code_style -> ptext SLIT("(void*)0")
| otherwise -> ptext SLIT("__NULL")
MachLabel l mb
| code_style -> ptext SLIT("(&") <> ftext l <> char ')'
| otherwise -> ptext SLIT("__label") <+>
case mb of
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
-- negative floating literals in code style need parentheses to avoid
-- interacting with surrounding syntax.
code_rational d | d < 0 = parens (rational d)
| otherwise = rational d
pprLit (MachChar ch) = pprHsChar ch
pprLit (MachStr s) = pprHsString s
pprLit (MachInt i) = pprIntVal i
pprLit (MachInt64 i) = ptext SLIT("__int64") <+> integer i
pprLit (MachWord w) = ptext SLIT("__word") <+> integer w
pprLit (MachWord64 w) = ptext SLIT("__word64") <+> integer w
pprLit (MachFloat f) = ptext SLIT("__float") <+> rational f
pprLit (MachDouble d) = rational d
pprLit (MachNullAddr) = ptext SLIT("__NULL")
pprLit (MachLabel l mb) = ptext SLIT("__label") <+>
case mb of
Nothing -> pprHsString l
Just x -> doubleQuotes (text (unpackFS l ++ '@':show x))
pprIntVal :: Integer -> SDoc
-- Print negative integers with parens to be sure it's unambiguous
pprIntVal i | i < 0 = parens (integer i)
| otherwise = integer i
pprHexVal :: Integer -> SDoc
-- Print in C hex format: 0x13fa
pprHexVal 0 = ptext SLIT("0x0")
pprHexVal w = ptext SLIT("0x") <> go w
where
go 0 = empty
go w = go quot <> dig
where
(quot,rem) = w `quotRem` 16
dig | rem < 10 = char (chr (fromInteger rem + ord '0'))
| otherwise = char (chr (fromInteger rem - 10 + ord 'a'))
\end{code}
......
......@@ -323,9 +323,7 @@ pprExternal sty name uniq mod occ mb_p is_wired
pprInternal sty uniq occ
| codeStyle sty = pprUnique uniq
| debugStyle sty = hsep [pprOccName occ, text "{-",
text (briefOccNameFlavour occ),
pprUnique uniq, text "-}"]
| debugStyle sty = pprOccName occ <> text "{-" <> pprUnique uniq <> text "-}"
| otherwise = pprOccName occ -- User style
-- Like Internal, except that we only omit the unique in Iface style
......
......@@ -41,7 +41,10 @@ module Unique (
mkPArrDataConUnique,
mkBuiltinUnique,
mkPseudoUnique3
mkPseudoUniqueC,
mkPseudoUniqueD,
mkPseudoUniqueE,
mkPseudoUniqueH
) where
#include "HsVersions.h"
......@@ -255,13 +258,22 @@ iToBase62 n@(I# n#)
Allocation of unique supply characters:
v,t,u : for renumbering value-, type- and usage- vars.
other a-z: lower case chars for unique supplies (see Main.lhs)
B: builtin
C-E: pseudo uniques (used in native-code generator)
X: uniques derived by deriveUnique
_: unifiable tyvars (above)
0-9: prelude things below
other a-z: lower case chars for unique supplies. Used so far:
d desugarer
f AbsC flattener
g SimplStg
l ndpFlatten
n Native codegen
r Hsc name cache
s simplifier
\begin{code}
mkAlphaTyVarUnique i = mkUnique '1' i
......@@ -303,15 +315,13 @@ mkPArrDataConUnique a = mkUnique ':' (2*a)
initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0
mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
mkBuiltinUnique :: Int -> Unique
builtinUniques :: [Unique]
builtinUniques = map mkBuiltinUnique [1..]
mkBuiltinUnique i = mkUnique 'B' i
mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs
mkPseudoUnique2 i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
mkPseudoUnique3 i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs
mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
\end{code}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
_interface_ CgRetConv 1
_exports_
CgRetConv CtrlReturnConvention(VectoredReturn UnvectoredReturn) ctrlReturnConvAlg;
_declarations_
1 data CtrlReturnConvention = VectoredReturn PrelBase.Int | UnvectoredReturn PrelBase.Int;
1 ctrlReturnConvAlg _:_ TyCon.TyCon -> CtrlReturnConvention ;;
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[CgUpdate]{Manipulating update frames}
\begin{code}
module CgUpdate ( pushUpdateFrame ) where
#include "HsVersions.h"
import CgMonad
import AbsCSyn
import CgStackery ( allocStackTop, updateFrameSize, setStackFrame )
import CgUsages ( getVirtSp )
import Panic ( assertPanic )
\end{code}
%********************************************************
%* *
%* Setting up update frames *
%* *
%********************************************************
\subsection[setting-update-frames]{Setting up update frames}
@pushUpdateFrame@ $updatee$ pushes a general update frame which
points to $updatee$ as the thing to be updated. It is only used
when a thunk has just been entered, so the (real) stack pointers
are guaranteed to be nicely aligned with the top of stack.
@pushUpdateFrame@ adjusts the virtual and tail stack pointers
to reflect the frame pushed.
\begin{code}
pushUpdateFrame :: CAddrMode -> Code -> Code
pushUpdateFrame updatee code
=
#ifdef DEBUG
getEndOfBlockInfo `thenFC` \ eob_info ->
ASSERT(case eob_info of { EndOfBlockInfo _ (OnStack _) -> True;
_ -> False})
#endif
allocStackTop updateFrameSize `thenFC` \ _ ->
getVirtSp `thenFC` \ vsp ->
setStackFrame vsp `thenC`
setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) (
-- Emit the push macro
absC (CMacroStmt PUSH_UPD_FRAME [
updatee,
int_CLit0 -- we just entered a closure, so must be zero
])
`thenC` code
)
int_CLit0 = mkIntCLit 0 -- out here to avoid pushUpdateFrame CAF (sigh)
\end{code}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -4,7 +4,6 @@
% The Compilation Manager
%
\begin{code}
{-# OPTIONS -fvia-C #-}
module CompManager (
ModuleGraph, ModSummary(..),
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -20,7 +20,7 @@ module Linker ( HValue, showLinkerState,
linkPackages,
) where
#include "../includes/config.h"
#include "../includes/ghcconfig.h"
#include "HsVersions.h"
import ObjLink ( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
__interface StixPrim 1 0 where
__export StixPrim amodeToStix;
1 amodeToStix :: AbsCSyn.CAddrMode -> Stix.StixExpr ;
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.