From: sewardj <unknown>
Date: Mon, 3 Apr 2000 13:48:37 +0000 (+0000)
Subject: [project @ 2000-04-03 13:48:37 by sewardj]
X-Git-Tag: Approximately_9120_patches~4857
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=27c9fa7828e2005dee577dfd3aa0e6aa16409ea7;p=ghc-hetmet.git

[project @ 2000-04-03 13:48:37 by sewardj]
Deal with MachWords, which recently have started appearing for unknown reasons.
---

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index e5aa5f6..b42f0b7 100644
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -29,14 +29,14 @@ import ClosureInfo	( infoTableLabelFromCI, entryLabelFromCI,
 			  fastLabelFromCI, closureUpdReqd,
 			  staticClosureNeedsLink
 			)
-import Literal		( Literal(..) )
+import Literal		( Literal(..), word2IntLit )
 import Maybes	    	( maybeToBool )
 import PrimOp		( primOpNeedsWrapper, PrimOp(..) )
 import PrimRep	    	( isFloatingRep, PrimRep(..) )
 import StixInfo	    	( genCodeInfoTable, genBitmapInfoTable )
 import StixMacro	( macroCode, checkCode )
 import StixPrim		( primCode, amodeToStix, amodeToStix' )
-import Outputable       ( pprPanic )
+import Outputable       ( pprPanic, ppr )
 import UniqSupply	( returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
 import Util		( naturalMergeSortLe )
 import Panic		( panic )
@@ -449,14 +449,15 @@ be tuned.)
 
  intTag :: Literal -> Integer
  intTag (MachChar c)  = toInteger (ord c)
- intTag (MachInt i) = i
- intTag _ = panic "intTag"
+ intTag (MachInt i)   = i
+ intTag (MachWord w)  = intTag (word2IntLit (MachWord w))
+ intTag _             = panic "intTag"
 
  fltTag :: Literal -> Rational
 
- fltTag (MachFloat f) = f
+ fltTag (MachFloat f)  = f
  fltTag (MachDouble d) = d
- fltTag _ = panic "fltTag"
+ fltTag x              = pprPanic "fltTag" (ppr x)
 
  {-
  mkSimpleSwitches
@@ -493,9 +494,10 @@ be tuned.)
     	floating = isFloatingRep (getAmodeRep am)
     	choices = length alts
 
-    	(x@(MachChar _),_) `leAlt` (y,_) = intTag x <= intTag y
-    	(x@(MachInt _), _) `leAlt` (y,_) = intTag x <= intTag y
-    	(x,_)              `leAlt` (y,_) = fltTag x <= fltTag y
+    	(x@(MachChar _),_)  `leAlt` (y,_) = intTag x <= intTag y
+    	(x@(MachInt _), _)  `leAlt` (y,_) = intTag x <= intTag y
+    	(x@(MachWord _), _) `leAlt` (y,_) = intTag x <= intTag y
+    	(x,_)               `leAlt` (y,_) = fltTag x <= fltTag y
 
 \end{code}
 
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 26d7bd1..f32bb99 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -16,7 +16,7 @@ import AbsCSyn 		hiding ( spRel )
 import AbsCUtils	( getAmodeRep, mixedTypeLocn )
 import Constants	( uF_UPDATEE )
 import SMRep		( fixedHdrSize )
-import Literal		( Literal(..) )
+import Literal		( Literal(..), word2IntLit )
 import CallConv		( cCallConv )
 import PrimOp		( PrimOp(..), CCall(..), CCallTarget(..) )
 import PrimRep		( PrimRep(..), isFloatingRep )
@@ -390,8 +390,9 @@ amodeToStix (CLit core)
       MachChar c     -> StInt (toInteger (ord c))
       MachStr s	     -> StString s
       MachAddr a     -> StInt a
-      MachInt i      -> StInt (toInteger i)
-      MachLitLit s _ -> {-trace (_UNPK_ s ++ "\n")-} (litLitToStix (_UNPK_ s))
+      MachInt i      -> StInt i
+      MachWord w     -> case word2IntLit core of MachInt iw -> StInt iw
+      MachLitLit s _ -> litLitToStix (_UNPK_ s)
       MachFloat d    -> StDouble d
       MachDouble d   -> StDouble d
       _ -> panic "amodeToStix:core literal"