liftStrings, repOfStixExpr,
DestInfo(..), hasDestInfo,
- stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
+ stgBaseReg, stgNode, stgSp, stgSpLim,
stgHp, stgHpLim, stgHpAlloc, stgTagReg, stgR9, stgR10,
stgCurrentTSO, stgCurrentNursery,
mapNat, mapAndUnzipNat, mapAccumLNat,
getUniqueNat, getDeltaNat, setDeltaNat,
NatM_State, mkNatM_State,
- uniqOfNatM_State, deltaOfNatM_State,
+ uniqOfNatM_State, deltaOfNatM_State, importsOfNatM_State,
+ addImportNat,
getUniqLabelNCG, getNatLabelNCG,
ncgPrimopMoan,
#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 CLabel ( mkAsmTempLabel, CLabel, pprCLabel )
import PrimRep ( PrimRep(..) )
-import MachOp ( MachOp(..), pprMachOp, resultRepsOfMachOp )
+import MachOp ( MachOp(..), pprMachOp, resultRepOfMachOp )
import Unique ( Unique )
import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply,
import Constants ( wORD_SIZE )
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.
StSegment CodeSegment
-- Assembly-language comments
- | StComment FAST_STRING
+ | StComment FastString
-- Assignments are typed to determine size and register placement.
-- Assign a value to a StixReg
-- Raw data (as in an info table).
| StData PrimRep [StixExpr]
-- String which has been lifted to the top level (sigh).
- | StDataString FAST_STRING
+ | StDataString FastString
-- A value computed only for its side effects; result is discarded
-- (A handy trapdoor to allow CCalls with no results to appear as
isCloseEnoughTo r1 r2
= r1 == r2 || (wordIsh r1 && wordIsh r2)
wordIsh rep
- = rep `elem` [IntRep, WordRep, PtrRep, AddrRep, CodePtrRep,
- RetRep, ArrayRep, PrimPtrRep, StableNameRep, BCORep]
+ = rep `elem` [IntRep, WordRep, PtrRep, AddrRep, CodePtrRep, RetRep ]
-- determined by looking at PrimRep.showPrimRep
-- Stix trees which denote a value.
StInt Integer -- ** add Kind at some point
| StFloat Rational
| StDouble Rational
- | StString FAST_STRING
+ | StString FastString
| StCLbl CLabel -- labels that we might index into
-- Abstract registers of various kinds
| StMachOp MachOp [StixExpr]
-- Calls to C functions
- | StCall (Either FAST_STRING StixExpr) -- Left: static, Right: dynamic
+ | StCall (Either FastString StixExpr) -- Left: static, Right: dynamic
CCallConv PrimRep [StixExpr]
repOfStixExpr (StIndex _ _ _) = PtrRep
repOfStixExpr (StInd rep _) = rep
repOfStixExpr (StCall target conv retrep args) = retrep
-repOfStixExpr (StMachOp mop args)
- = case resultRepsOfMachOp mop of
- Just rep -> rep
- Nothing -> pprPanic "repOfStixExpr:StMachOp" (pprMachOp mop)
+repOfStixExpr (StMachOp mop args) = resultRepOfMachOp mop
-- used by insnFuture in RegAllocInfo.lhs
StInt i -> (if i < 0 then parens else id) (integer i)
StFloat rat -> parens (text "Float" <+> rational rat)
StDouble rat -> parens (text "Double" <+> rational rat)
- StString str -> parens (text "Str `" <> ptext str <> char '\'')
+ StString str -> parens (text "Str `" <> ftext str <> char '\'')
StIndex k b o -> parens (pprStixExpr b <+> char '+' <>
ppr k <+> pprStixExpr o)
StInd k t -> ppr k <> char '[' <> pprStixExpr t <> char ']'
hsep (map pprStixExpr args))
where
targ = case fn of
- Left t_static -> ptext t_static
+ Left t_static -> ftext t_static
Right t_dyn -> parens (pprStixExpr t_dyn)
pprStixStmt :: StixStmt -> SDoc
pprStixStmt t
= case t of
StSegment cseg -> parens (ppCodeSegment cseg)
- StComment str -> parens (text "Comment" <+> ptext str)
+ StComment str -> parens (text "Comment" <+> ftext str)
StAssignReg pr reg rhs
-> pprStixReg reg <> text " :=" <> ppr pr
<> text " " <> pprStixExpr rhs
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"
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
-stgSu = StixMagicId Su
stgSpLim = StixMagicId SpLim
stgHp = StixMagicId Hp
stgHpLim = StixMagicId HpLim
liftStrings_wrk :: [StixStmt] -- originals
-> [StixStmt] -- (reverse) originals with strings lifted out
- -> [(CLabel, FAST_STRING)] -- lifted strs, and their new labels
+ -> [(CLabel, FastString)] -- lifted strs, and their new labels
-> UniqSM [StixStmt]
-- First, examine the original trees and lift out strings in top-level StDatas.
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}
-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
-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) }
getUniqueNat :: NatM Unique
-getUniqueNat (NatM_State us delta)
+getUniqueNat (NatM_State us delta imports)
= 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 st@(NatM_State us delta)
+getDeltaNat st@(NatM_State us delta imports)
= (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.
ncg_target_is_32bit | wORD_SIZE == 4 = True
| wORD_SIZE == 8 = False
-\end{code}
\ No newline at end of file
+\end{code}
projects / ghc-hetmet.git / blobdiff