[project @ 2000-07-11 15:26:33 by sewardj]

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

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index e48e1f4..7576dd8 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -8,7 +8,6 @@ module StixPrim ( primCode, amodeToStix, amodeToStix' ) where
 #include "HsVersions.h"
 
 import MachMisc
-import MachRegs
 import Stix
 import StixInteger
 
@@ -16,17 +15,15 @@ import AbsCSyn              hiding ( spRel )
 import AbsCUtils       ( getAmodeRep, mixedTypeLocn )
 import SMRep           ( fixedHdrSize )
 import Literal         ( Literal(..), word2IntLit )
-import CallConv                ( cCallConv )
 import PrimOp          ( PrimOp(..), CCall(..), CCallTarget(..) )
 import PrimRep         ( PrimRep(..), isFloatingRep )
 import UniqSupply      ( returnUs, thenUs, getUniqueUs, UniqSM )
 import Constants       ( mIN_INTLIKE, uF_UPDATEE, bLOCK_SIZE )
 import CLabel          ( mkIntlikeClosureLabel, mkCharlikeClosureLabel,
-                         mkTopClosureLabel, mkErrorIO_innardsLabel,
                          mkMAP_FROZEN_infoLabel, mkForeignLabel )
 import Outputable
 
-import Char            ( ord, isAlphaNum )
+import Char            ( ord, isAlpha, isDigit )
 
 #include "NCG.h"
 \end{code}
@@ -273,7 +270,10 @@ primCode lhs (CCallOp (CCall (StaticTarget fn) is_asm may_gc cconv)) rhs
       [] -> StCall fn cconv VoidRep args
       [lhs] ->
          let lhs' = amodeToStix lhs
-             pk = if isFloatingRep (getAmodeRep lhs) then DoubleRep else IntRep
+             pk   = case getAmodeRep lhs of
+                        FloatRep  -> FloatRep
+                        DoubleRep -> DoubleRep
+                        other     -> IntRep
          in
              StAssign pk lhs' (StCall fn cconv pk args)
 \end{code}
@@ -433,14 +433,12 @@ amodeToStix (CLit core)
       MachAddr a     -> StInt a
       MachInt i      -> StInt i
       MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
-      MachLitLit s _ -> litLitToStix (_UNPK_ s)
-      MachFloat d    -> StDouble d
+      MachLitLit s _ -> litLitErr
+      MachLabel l    -> StCLbl (mkForeignLabel l False{-ToDo: dynamic-})
+      MachFloat d    -> StFloat d
       MachDouble d   -> StDouble d
       _ -> panic "amodeToStix:core literal"
 
-amodeToStix (CLitLit s _)
-   = litLitToStix (_UNPK_ s)
-
 amodeToStix (CMacroExpr _ macro [arg])
   = case macro of
       ENTRY_CODE -> amodeToStix arg
@@ -460,12 +458,9 @@ amodeToStix (CMacroExpr _ macro [arg])
       UPD_FRAME_UPDATEE
          -> StInd PtrRep (StIndex PtrRep (amodeToStix arg) 
                                          (StInt (toInteger uF_UPDATEE)))
-litLitToStix nm
-  | all is_id nm = StCLbl (mkForeignLabel (_PK_ nm) False{-ToDo: dynamic-})
-  | otherwise    = error ("\nlitLitToStix: can't handle `" ++ nm ++ "'\n" 
-                           ++ "suggested workaround: use flag -fvia-C\n")
 
-  where is_id c = isAlphaNum c || c == '_'
+litLitErr = 
+  panic "native code generator can't compile lit-lits, use -fvia-C"
 \end{code}
 
 Sizes of the CharLike and IntLike closures that are arranged as arrays
@@ -482,13 +477,6 @@ iNTLIKE_closure = StCLbl mkIntlikeClosureLabel
 cHARLIKE_closure :: StixTree
 cHARLIKE_closure = StCLbl mkCharlikeClosureLabel
 
--- Trees for the ErrorIOPrimOp
-
-topClosure, errorIO :: StixTree
-
-topClosure = StInd PtrRep (StCLbl mkTopClosureLabel)
-errorIO = StJump (StInd PtrRep (StCLbl mkErrorIO_innardsLabel))
-
 mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
 
 -- these are the sizes of charLike and intLike closures, in _bytes_.