[project @ 2003-07-21 15:14:18 by ross]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixPrim.lhs

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 3086383..64932e3 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -19,8 +19,7 @@ import Literal                ( Literal(..), word2IntLit )
 import MachOp          ( MachOp(..) )
 import PrimRep         ( PrimRep(..), getPrimRepSizeInBytes )
 import UniqSupply      ( returnUs, thenUs, getUniqueUs, UniqSM )
-import Constants       ( wORD_SIZE,
-                         mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
+import Constants       ( mIN_INTLIKE, mIN_CHARLIKE, uF_UPDATEE, bLOCK_SIZE,
                          rESERVED_STACK_WORDS )
 import CLabel          ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
                          mkMAP_FROZEN_infoLabel, 
@@ -29,6 +28,7 @@ import ForeignCall    ( ForeignCall(..), CCallSpec(..), CCallTarget(..),
                          CCallConv(..), playSafe, playThreadSafe )
 import Outputable
 import Util             ( notNull )
+import FastString
 import FastTypes
 
 #include "NCG.h"
@@ -113,6 +113,10 @@ foreignCallCode lhs call@(CCall (CCallSpec ctarget cconv safety)) rhs
                         Int64Rep  -> Int64Rep
                         Word64Rep -> Word64Rep
                         other     -> IntRep
+
+-- a bit late to catch this here..
+foreignCallCode _ DNCall{} _
+ = panic "foreignCallCode: .NET interop not supported via NCG; compile with -fvia-C"
 \end{code}
 
 %************************************************************************
@@ -141,9 +145,6 @@ amodeToStix am@(CVal rr CharRep)
 
 amodeToStix (CVal rr pk) = StInd pk (amodeToStix (CAddr rr))
 
-amodeToStix CBytesPerWord
-  = StInt (toInteger wORD_SIZE)
-
 amodeToStix (CAddr (SpRel off))
   = StIndex PtrRep (StReg stgSp) (StInt (toInteger (iBox off)))
 
@@ -183,11 +184,13 @@ amodeToStix (CLit core)
   = case core of
       MachChar c     -> StInt (toInteger c)
       MachStr s             -> StString s
-      MachAddr a     -> StInt a
+      MachNullAddr   -> StInt 0
       MachInt i      -> StInt i
       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
       MachLitLit s _ -> litLitErr
-      MachLabel l    -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
+                                                       -- dreadful, but rare.
+      MachLabel l (Just x) -> StCLbl (mkForeignLabel (mkFastString (unpackFS l ++ '@':show x)) False)
+      MachLabel l _        -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
       MachFloat d    -> StFloat d
       MachDouble d   -> StDouble d
       _ -> panic "amodeToStix:core literal"
@@ -259,10 +262,6 @@ save_thread_state
              (StMachOp MO_Nat_Add
                       [StReg tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))])
             (StReg stgSp)
-        : StAssignMem PtrRep 
-            (StMachOp MO_Nat_Add
-                      [StReg tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))])
-            (StReg stgSu)
         : StAssignMem PtrRep
             (StMachOp MO_Nat_Add
                       [StReg stgCurrentNursery, 
@@ -283,11 +282,6 @@ load_thread_state
                   (StMachOp MO_Nat_Add
                             [StReg tso, StInt (toInteger (TSO_SP*BYTES_PER_WORD))]))
        : StAssignReg PtrRep 
-             stgSu
-            (StInd PtrRep 
-                  (StMachOp MO_Nat_Add
-                           [StReg tso, StInt (toInteger (TSO_SU*BYTES_PER_WORD))]))
-       : StAssignReg PtrRep 
              stgSpLim
             (StMachOp MO_Nat_Add 
                        [StReg tso,