projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2003-09-11 14:18:38 by simonpj]
[ghc-hetmet.git]
/
ghc
/
compiler
/
nativeGen
/
Stix.lhs
diff --git
a/ghc/compiler/nativeGen/Stix.lhs
b/ghc/compiler/nativeGen/Stix.lhs
index
091107e
..
9f4a5ea
100644
(file)
--- a/
ghc/compiler/nativeGen/Stix.lhs
+++ b/
ghc/compiler/nativeGen/Stix.lhs
@@
-11,7
+11,7
@@
module Stix (
liftStrings, repOfStixExpr,
DestInfo(..), hasDestInfo,
liftStrings, repOfStixExpr,
DestInfo(..), hasDestInfo,
- stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
+ stgBaseReg, stgNode, stgSp, stgSpLim,
stgHp, stgHpLim, stgHpAlloc, stgTagReg, stgR9, stgR10,
stgCurrentTSO, stgCurrentNursery,
stgHp, stgHpLim, stgHpAlloc, stgTagReg, stgR9, stgR10,
stgCurrentTSO, stgCurrentNursery,
@@
-21,7
+21,8
@@
module Stix (
mapNat, mapAndUnzipNat, mapAccumLNat,
getUniqueNat, getDeltaNat, setDeltaNat,
NatM_State, mkNatM_State,
mapNat, mapAndUnzipNat, mapAccumLNat,
getUniqueNat, getDeltaNat, setDeltaNat,
NatM_State, mkNatM_State,
- uniqOfNatM_State, deltaOfNatM_State,
+ uniqOfNatM_State, deltaOfNatM_State, importsOfNatM_State,
+ addImportNat,
getUniqLabelNCG, getNatLabelNCG,
ncgPrimopMoan,
getUniqLabelNCG, getNatLabelNCG,
ncgPrimopMoan,
@@
-32,10
+33,6
@@
module Stix (
#include "HsVersions.h"
#include "HsVersions.h"
-import Ratio ( Rational )
-import IOExts ( unsafePerformIO )
-import IO ( hPutStrLn, stderr )
-
import AbsCSyn ( node, tagreg, MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
import ForeignCall ( CCallConv )
import AbsCSyn ( node, tagreg, MagicId(..) )
import AbsCUtils ( magicIdPrimRep )
import ForeignCall ( CCallConv )
@@
-50,6
+47,11
@@
import Constants ( wORD_SIZE )
import Outputable
import FastTypes
import FastString
import Outputable
import FastTypes
import FastString
+
+import UNSAFE_IO ( unsafePerformIO )
+
+import Ratio ( Rational )
+import IO ( hPutStrLn, stderr )
\end{code}
Two types, StixStmt and StixValue, define Stix.
\end{code}
Two types, StixStmt and StixValue, define Stix.
@@
-269,7
+271,6
@@
ppMId (DoubleReg n) = hcat [text "DblReg(", int (iBox n), char ')']
ppMId (LongReg kind n) = hcat [ppr kind, text "LongReg(",
int (iBox n), char ')']
ppMId Sp = text "Sp"
ppMId (LongReg kind n) = hcat [ppr kind, text "LongReg(",
int (iBox n), char ')']
ppMId Sp = text "Sp"
-ppMId Su = text "Su"
ppMId SpLim = text "SpLim"
ppMId Hp = text "Hp"
ppMId HpLim = text "HpLim"
ppMId SpLim = text "SpLim"
ppMId Hp = text "Hp"
ppMId HpLim = text "HpLim"
@@
-295,14
+296,12
@@
type StixStmtList = [StixStmt] -> [StixStmt]
Stix Trees for STG registers:
\begin{code}
Stix Trees for STG registers:
\begin{code}
-stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
- :: StixReg
+stgBaseReg, stgNode, stgSp, stgSpLim, stgHp, stgHpLim :: StixReg
stgBaseReg = StixMagicId BaseReg
stgNode = StixMagicId node
stgTagReg = StixMagicId tagreg
stgSp = StixMagicId Sp
stgBaseReg = StixMagicId BaseReg
stgNode = StixMagicId node
stgTagReg = StixMagicId tagreg
stgSp = StixMagicId Sp
-stgSu = StixMagicId Su
stgSpLim = StixMagicId SpLim
stgHp = StixMagicId Hp
stgHpLim = StixMagicId HpLim
stgSpLim = StixMagicId SpLim
stgHp = StixMagicId Hp
stgHpLim = StixMagicId HpLim
@@
-529,16
+528,20
@@
liftStrings_wrk [] acc_stix acc_strs
The NCG's monad.
The NCG's monad.
+The monad keeps a UniqSupply, the current stack delta and
+a list of imported entities, which is only used for
+Darwin (Mac OS X).
+
\begin{code}
\begin{code}
-data NatM_State = NatM_State UniqSupply Int
+data NatM_State = NatM_State UniqSupply Int [FastString]
type NatM result = NatM_State -> (result, NatM_State)
mkNatM_State :: UniqSupply -> Int -> NatM_State
type NatM result = NatM_State -> (result, NatM_State)
mkNatM_State :: UniqSupply -> Int -> NatM_State
-mkNatM_State = NatM_State
-
-uniqOfNatM_State (NatM_State us delta) = us
-deltaOfNatM_State (NatM_State us delta) = delta
+mkNatM_State us delta = NatM_State us delta []
+uniqOfNatM_State (NatM_State us delta imports) = us
+deltaOfNatM_State (NatM_State us delta imports) = delta
+importsOfNatM_State (NatM_State us delta imports) = imports
initNat :: NatM_State -> NatM a -> (a, NatM_State)
initNat init_st m = case m init_st of { (r,st) -> (r,st) }
initNat :: NatM_State -> NatM a -> (a, NatM_State)
initNat init_st m = case m init_st of { (r,st) -> (r,st) }
@@
-578,17
+581,21
@@
mapAccumLNat f b (x:xs)
getUniqueNat :: NatM Unique
getUniqueNat :: NatM Unique
-getUniqueNat (NatM_State us delta)
+getUniqueNat (NatM_State us delta imports)
= case splitUniqSupply us of
= case splitUniqSupply us of
- (us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta))
+ (us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports))
getDeltaNat :: NatM Int
getDeltaNat :: NatM Int
-getDeltaNat st@(NatM_State us delta)
+getDeltaNat st@(NatM_State us delta imports)
= (delta, st)
setDeltaNat :: Int -> NatM ()
= (delta, st)
setDeltaNat :: Int -> NatM ()
-setDeltaNat delta (NatM_State us _)
- = ((), NatM_State us delta)
+setDeltaNat delta (NatM_State us _ imports)
+ = ((), NatM_State us delta imports)
+
+addImportNat :: FastString -> NatM ()
+addImportNat imp (NatM_State us delta imports)
+ = ((), NatM_State us delta (imp:imports))
\end{code}
Giving up in a not-too-inelegant way.
\end{code}
Giving up in a not-too-inelegant way.