[project @ 2004-08-13 10:45:16 by simonmar]

[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,
 
-       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.
@@ -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 Su                   = text "Su"
 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}
-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
@@ -529,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) }
@@ -578,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.