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

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

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 7583e1c..8df7812 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -19,11 +19,9 @@ 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, bLOCK_SIZE,
                          rESERVED_STACK_WORDS )
 import CLabel          ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
-                         mkMAP_FROZEN_infoLabel, 
                          mkForeignLabel )
 import ForeignCall     ( ForeignCall(..), CCallSpec(..), CCallTarget(..),
                          CCallConv(..), playSafe, playThreadSafe )
@@ -31,6 +29,7 @@ import Outputable
 import Util             ( notNull )
 import FastString
 import FastTypes
+import Char
 
 #include "NCG.h"
 \end{code}
@@ -51,14 +50,11 @@ foreignCallCode
 %*                                                                     *
 %************************************************************************
 
-First, the dreaded @ccall@.  We can't handle @casm@s.
+First, the dreaded @ccall@.
 
 Usually, this compiles to an assignment, but when the left-hand side
 is empty, we just perform the call and ignore the result.
 
-btw Why not let programmer use casm to provide assembly code instead
-of C code?  ADR
-
 ToDo: saving/restoring of volatile regs around ccalls.
 
 JRS, 001113: always do the call of suspendThread and resumeThread as a ccall
@@ -97,9 +93,6 @@ foreignCallCode lhs call@(CCall (CCallSpec ctarget cconv safety)) rhs
              StaticTarget nm -> (rhs, Left nm)
              DynamicTarget |  notNull rhs -- an assertion
                            -> (tail rhs, Right (amodeToStix (head rhs)))
-             CasmTarget _
-                -> ncgPrimopMoan "Native code generator can't handle foreign call" 
-                                 (ppr call)
 
     stix_args = map amodeToStix' cargs
 
@@ -168,7 +161,7 @@ amodeToStix (CLbl      lbl _) = StCLbl lbl
 amodeToStix (CCharLike (CLit (MachChar c)))
   = StIndex Word8Rep cHARLIKE_closure (StInt (toInteger off))
   where
-    off = charLikeSize * (c - mIN_CHARLIKE)
+    off = charLikeSize * (ord c - mIN_CHARLIKE)
 
 amodeToStix (CCharLike x)
   = panic "amodeToStix.CCharLike"
@@ -183,12 +176,11 @@ amodeToStix (CIntLike x)
 
 amodeToStix (CLit core)
   = case core of
-      MachChar c     -> StInt (toInteger c)
+      MachChar c     -> StInt (toInteger (ord c))
       MachStr s             -> StString s
       MachNullAddr   -> StInt 0
       MachInt i      -> StInt i
       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
-      MachLitLit s _ -> litLitErr
                                                        -- dreadful, but rare.
       MachLabel l (Just x) -> StCLbl (mkForeignLabel (mkFastString (unpackFS l ++ '@':show x)) False)
       MachLabel l _        -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
@@ -215,10 +207,6 @@ amodeToStix (CMacroExpr _ macro [arg])
                                                 (StInt (toInteger (-1)))),
                         StInt 16]
 #endif
-      UPD_FRAME_UPDATEE
-         -> StInd PtrRep (StIndex PtrRep arg_amode 
-                                         (StInt (toInteger uF_UPDATEE)))
-
       BYTE_ARR_CTS -> StIndex IntRep arg_amode arrWordsHS
       PTRS_ARR_CTS -> StIndex PtrRep arg_amode arrPtrsHS
       ForeignObj_CLOSURE_DATA -> StInd PtrRep (StIndex PtrRep arg_amode fixedHS)
@@ -226,9 +214,6 @@ amodeToStix (CMacroExpr _ macro [arg])
 
 amodeToStix other
    = pprPanic "StixPrim.amodeToStix" (pprAmode other)
-
-litLitErr 
-   = ncgPrimopMoan "native code generator can't handle lit-lits" empty
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays
@@ -245,8 +230,6 @@ iNTLIKE_closure = StCLbl mkIntlikeClosureLabel
 cHARLIKE_closure :: StixExpr
 cHARLIKE_closure = StCLbl mkCharlikeClosureLabel
 
-mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
-
 -- these are the sizes of charLike and intLike closures, in _bytes_.
 charLikeSize = (fixedHdrSize + 1) * (getPrimRepSizeInBytes PtrRep)
 intLikeSize  = (fixedHdrSize + 1) * (getPrimRepSizeInBytes PtrRep)