X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStix.lhs;h=9f4a5ea6600be821b49ef597eb1b77cf0e66e4f5;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=199087d256a3b87a1ff7c4c02549631cacdb480f;hpb=ec269b1201dd73f6173d7d66ddbe2bbbc2244bf2;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index 199087d..9f4a5ea 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -11,7 +11,7 @@ module Stix ( liftStrings, repOfStixExpr, DestInfo(..), hasDestInfo, - stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, + stgBaseReg, stgNode, stgSp, stgSpLim, stgHp, stgHpLim, stgHpAlloc, stgTagReg, stgR9, stgR10, stgCurrentTSO, stgCurrentNursery, @@ -21,7 +21,8 @@ module Stix ( mapNat, mapAndUnzipNat, mapAccumLNat, getUniqueNat, getDeltaNat, setDeltaNat, NatM_State, mkNatM_State, - uniqOfNatM_State, deltaOfNatM_State, + uniqOfNatM_State, deltaOfNatM_State, importsOfNatM_State, + addImportNat, getUniqLabelNCG, getNatLabelNCG, ncgPrimopMoan, @@ -32,16 +33,12 @@ module Stix ( #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, @@ -49,6 +46,12 @@ 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. @@ -62,7 +65,7 @@ data StixStmt 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 @@ -98,7 +101,7 @@ data StixStmt -- 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 @@ -124,8 +127,7 @@ mkStAssign rep (StInd rep' addr) rhs 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. @@ -134,7 +136,7 @@ data StixExpr 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 @@ -150,7 +152,7 @@ data StixExpr | 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] @@ -165,10 +167,7 @@ repOfStixExpr (StReg reg) = repOfStixReg reg 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 @@ -200,7 +199,7 @@ pprStixExpr t 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 ']' @@ -213,14 +212,14 @@ pprStixExpr t 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 @@ -272,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 Su = text "Su" ppMId SpLim = text "SpLim" ppMId Hp = text "Hp" ppMId HpLim = text "HpLim" @@ -298,14 +296,12 @@ type StixStmtList = [StixStmt] -> [StixStmt] 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 @@ -496,7 +492,7 @@ liftStrings stmts 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. @@ -532,16 +528,20 @@ liftStrings_wrk [] acc_stix acc_strs 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) } @@ -581,17 +581,21 @@ mapAccumLNat f b (x:xs) 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. @@ -622,4 +626,4 @@ ncg_target_is_32bit :: Bool ncg_target_is_32bit | wORD_SIZE == 4 = True | wORD_SIZE == 8 = False -\end{code} \ No newline at end of file +\end{code}