X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStix.lhs;h=9f4a5ea6600be821b49ef597eb1b77cf0e66e4f5;hb=553e90d9a32ee1b1809430f260c401cc4169c6c7;hp=bae8b64b4fce76350f903fd4a408cdbc61f92bc8;hpb=b085ee40c7f265a5977ea6ec1c415e573be5ff8c;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index bae8b64..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,10 +33,6 @@ 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 )
@@ -50,6 +47,11 @@ 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.
@@ -125,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.
@@ -270,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"
@@ -296,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
@@ -530,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) }
@@ -579,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.