[project @ 2000-01-28 09:40:05 by sewardj]

Commit all changes prior to addressing the x86 spilling situation in
the register allocator.

-- Fix nonsensical x86 addressing mode hacks in mangleIndexTree
   and getAmode.

-- Make char-sized loads work properly, using MOVZBL.

-- In assignIntCode, use primRep on the assign node to determine
   the size of data transfer, not the size of the source.

-- Redo Integer primitives to be in line with current representation
   of Integers.

8 files changed, 144 insertions, 136 deletions

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 7da3a0b884..aa5d4e485c 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -22,8 +22,9 @@ import AsmRegAlloc	( runRegAllocate )
 import OrdList		( OrdList )
 import PrimOp		( commutableOp, PrimOp(..) )
 import RegAllocInfo	( mkMRegsState, MRegsState )
-import Stix		( StixTree(..), StixReg(..), pprStixTrees )
-import PrimRep		( isFloatingRep )
+import Stix		( StixTree(..), StixReg(..), 
+                          pprStixTrees, CodeSegment(..) )
+import PrimRep		( isFloatingRep, PrimRep(..) )
 import UniqSupply	( returnUs, thenUs, mapUs, initUs, 
                           initUs_, UniqSM, UniqSupply )
 import UniqFM		( UniqFM, emptyUFM, addToUFM, lookupUFM )
diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index e3f3dcc37f..a4bd7772e1 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -27,12 +27,14 @@ import PrimRep		( isFloatingRep, PrimRep(..) )
 import PrimOp		( PrimOp(..) )
 import CallConv		( cCallConv )
 import Stix		( getUniqLabelNCG, StixTree(..),
-			  StixReg(..), CodeSegment(..), pprStixTrees
+			  StixReg(..), CodeSegment(..), 
+                          pprStixTrees, ppStixReg
 			)
 import UniqSupply	( returnUs, thenUs, mapUs, mapAndUnzipUs,
 			  mapAccumLUs, UniqSM
 			)
 import Outputable
+import PprMach 		( pprSize )
 \end{code}
 
 Code extractor for an entire stix tree---stix statement level.
@@ -44,30 +46,7 @@ stmt2Instrs stmt = case stmt of
     StComment s    -> returnInstr (COMMENT s)
     StSegment seg  -> returnInstr (SEGMENT seg)
 
-#if 1
-    -- StFunBegin, normal non-debugging code for all architectures
     StFunBegin lab -> returnInstr (IF_ARCH_alpha(FUNBEGIN lab,LABEL lab))
-#else
-    -- StFunBegin, special tracing code for x86-Linux only
-    -- requires you to supply
-    -- void native_trace ( char* str )
-    StFunBegin lab -> getUniqLabelNCG `thenUs` \ str_lbl ->
-                      returnUs (mkSeqInstrs [
-                         LABEL lab,
-                         COMMENT SLIT("begin trace sequence"),
-                         SEGMENT DataSegment,
-                         LABEL str_lbl,
-                         ASCII True (showSDoc (pprCLabel_asm lab)),
-                         SEGMENT TextSegment,
-                         PUSHA,
-                         PUSH L (OpImm (ImmCLbl str_lbl)),
-                         CALL (ImmLit (text "native_trace")),
-		         ADD L (OpImm (ImmInt 4)) (OpReg esp),
-                         POPA,
-                         COMMENT SLIT("end trace sequence")
-                      ])
-#endif
-
     StFunEnd lab   -> IF_ARCH_alpha(returnInstr (FUNEND lab),returnUs id)
     StLabel lab	   -> returnInstr (LABEL lab)
 
@@ -152,29 +131,17 @@ mangleIndexTree (StIndex pk base (StInt i))
   where
     off = StInt (i * sizeOf pk)
 
-#ifndef i386_TARGET_ARCH
 mangleIndexTree (StIndex pk base off)
-  = StPrim IntAddOp [base,
-      case pk of
-    	CharRep -> off
-    	_	-> let
-			s = shift pk
-		   in
-		   ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
-		   StPrim SllOp [off, StInt s]
-    ]
+  = StPrim IntAddOp [
+       base,
+       let s = shift pk
+       in  ASSERT(toInteger s == expectJust "MachCode" (exactLog2 (sizeOf pk)))
+           if s == 0 then off else StPrim SllOp [off, StInt s]
+      ]
   where
     shift DoubleRep 	= 3::Integer
+    shift CharRep       = 0::Integer
     shift _ 	       	= IF_ARCH_alpha(3,2)
-#else
--- Hmm..this is an attempt at fixing Adress amodes (i.e., *[disp](base,index,<n>),
--- that do include the size of the primitive kind we're addressing. When StIndex
--- is expanded to actual code, the index (in units) is by the above code approp.
--- shifted to get the no. of bytes. Since Address amodes do contain size info
--- explicitly, we disable the shifting for x86s.
-mangleIndexTree (StIndex pk base off) = StPrim IntAddOp [base, off]
-#endif
-
 \end{code}
 
 \begin{code}
@@ -517,6 +484,9 @@ getRegister (StDouble d)
     in
     returnUs (Any DoubleRep code)
 
+getRegister (StScratchWord i)
+   = let code dst = mkSeqInstr (LEA L (OpAddr (spRel (-1000+i))) (OpReg dst))
+     in returnUs (Any PtrRep code)
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
@@ -580,6 +550,10 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 	      DoubleCoshOp  -> (False, SLIT("cosh"))
 	      DoubleTanhOp  -> (False, SLIT("tanh"))
 
+              other
+                 -> pprPanic "getRegister(x86,unary primop)" 
+                             (pprStixTrees [StPrim primop [x]])
+
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
       CharGtOp -> condIntReg GTT x y
@@ -624,15 +598,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoubleLtOp -> condFltReg LTT x y
       DoubleLeOp -> condFltReg LE x y
 
-      IntAddOp  -> {- ToDo: fix this, whatever it is (WDP 96/04)...
-		   -- this should be optimised by the generic Opts,
-		   -- I don't know why it is not (sometimes)!
-		   case args of
-		    [x, StInt 0] -> getRegister x
-		    _ -> add_code L x y
-		   -}
-		   add_code  L x y
-
+      IntAddOp  -> add_code  L x y
       IntSubOp  -> sub_code  L x y
       IntQuotOp -> quot_code L x y True{-division-}
       IntRemOp  -> quot_code L x y False{-remainder-}
@@ -669,6 +635,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 		       where promote x = StPrim Float2DoubleOp [x]
       DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
                                            [x, y])
+      other
+         -> pprPanic "getRegister(x86,dyadic primop)" 
+                     (pprStixTrees [StPrim primop [x, y]])
   where
 
     --------------------
@@ -743,7 +712,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src2 = ImmInt (fromInteger y)
 	    code__2 dst 
                = code .
-		 mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2)) 
+		 mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
                                     (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
@@ -891,7 +860,6 @@ getRegister leaf
     	returnUs (Any PtrRep code)
   | otherwise
   = pprPanic "getRegister(x86)" (pprStixTrees [leaf])
-
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
@@ -1182,7 +1150,8 @@ getAmode (StPrim IntAddOp [x, StInt i])
     in
     returnUs (Amode (AddrBaseIndex (Just reg) Nothing off) code)
 
-getAmode (StPrim IntAddOp [x, y])
+getAmode (StPrim IntAddOp [x, StPrim SllOp [y, StInt shift]])
+  | shift == 0 || shift == 1 || shift == 2 || shift == 3
   = getNewRegNCG PtrRep		`thenUs` \ tmp1 ->
     getNewRegNCG IntRep    	`thenUs` \ tmp2 ->
     getRegister x    	    	`thenUs` \ register1 ->
@@ -1193,8 +1162,10 @@ getAmode (StPrim IntAddOp [x, y])
     	code2 = registerCode register2 tmp2 asmVoid
     	reg2  = registerName register2 tmp2
     	code__2 = asmParThen [code1, code2]
+        base = case shift of 0 -> 1 ; 1 -> 2; 2 -> 4; 3 -> 8
     in
-    returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
+    returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,base)) (ImmInt 0))
+                    code__2)
 
 getAmode leaf
   | maybeToBool imm
@@ -1609,24 +1580,24 @@ assignIntCode pk dst src
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-assignIntCode pk (StInd _ dst) src
+assignIntCode pk dd@(StInd _ dst) src
   = getAmode dst		`thenUs` \ amode ->
-    get_op_RI src		`thenUs` \ (codesrc, opsrc, sz) ->
+    get_op_RI src		`thenUs` \ (codesrc, opsrc) ->
     let
     	code1   = amodeCode amode asmVoid
     	dst__2  = amodeAddr amode
     	code__2 = asmParThen [code1, codesrc asmVoid] .
-		  mkSeqInstr (MOV sz opsrc (OpAddr dst__2))
+		  mkSeqInstr (MOV (primRepToSize pk) opsrc (OpAddr dst__2))
     in
     returnUs code__2
   where
     get_op_RI
 	:: StixTree
-	-> UniqSM (InstrBlock,Operand, Size)	-- code, operator, size
+	-> UniqSM (InstrBlock,Operand)	-- code, operator
 
     get_op_RI op
       | maybeToBool imm
-      = returnUs (asmParThen [], OpImm imm_op, L)
+      = returnUs (asmParThen [], OpImm imm_op)
       where
 	imm    = maybeImm op
 	imm_op = case imm of Just x -> x
@@ -1638,12 +1609,10 @@ assignIntCode pk (StInd _ dst) src
 	let
 	    code = registerCode register tmp
 	    reg  = registerName register tmp
-	    pk   = registerRep  register
-	    sz   = primRepToSize pk
 	in
-	returnUs (code, OpReg reg, sz)
+	returnUs (code, OpReg reg)
 
-assignIntCode pk dst (StInd _ src)
+assignIntCode pk dst (StInd pks src)
   = getNewRegNCG IntRep    	    `thenUs` \ tmp ->
     getAmode src    	    	    `thenUs` \ amode ->
     getRegister dst	    	    	    `thenUs` \ register ->
@@ -1652,9 +1621,11 @@ assignIntCode pk dst (StInd _ src)
     	src__2  = amodeAddr amode
     	code2   = registerCode register tmp asmVoid
     	dst__2  = registerName register tmp
-    	sz      = primRepToSize pk
+    	szs     = primRepToSize pks
     	code__2 = asmParThen [code1, code2] .
-		  mkSeqInstr (MOV sz (OpAddr src__2) (OpReg dst__2))
+                  case szs of
+                     L -> mkSeqInstr (MOV L (OpAddr src__2) (OpReg dst__2))
+                     B -> mkSeqInstr (MOVZxL B (OpAddr src__2) (OpReg dst__2))
     in
     returnUs code__2
 
@@ -3056,7 +3027,6 @@ chrCode x
 
 chrCode x
   = getRegister x		`thenUs` \ register ->
-    --getNewRegNCG IntRep	`thenUs` \ reg ->
     let
     	code__2 dst = let
     	                  code = registerCode register dst
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 867495b9b8..d31af20307 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -320,7 +320,7 @@ primRepToSize CodePtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc(
 primRepToSize DataPtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize RetRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize CostCentreRep = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CharRep	    = IF_ARCH_alpha( BU, IF_ARCH_i386( L, IF_ARCH_sparc( BU,)))
+primRepToSize CharRep	    = IF_ARCH_alpha( BU, IF_ARCH_i386( B, IF_ARCH_sparc( BU,)))
 primRepToSize IntRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize WordRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize AddrRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
@@ -478,8 +478,8 @@ current translation.
 -- Moves.
 
 	      |	MOV	      Size Operand Operand
-	      | MOVZX	      Size Operand Operand -- size is the size of operand 2
-	      | MOVSX	      Size Operand Operand -- size is the size of operand 2
+	      | MOVZxL	      Size Operand Operand -- size is the size of operand 1
+	      | MOVSxL	      Size Operand Operand -- size is the size of operand 1
 
 -- Load effective address (also a very useful three-operand add instruction :-)
 
diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs
index 7f72f4d0ca..e35e22cc9a 100644
--- a/ghc/compiler/nativeGen/PprMach.lhs
+++ b/ghc/compiler/nativeGen/PprMach.lhs
@@ -10,7 +10,7 @@ We start with the @pprXXX@s with some cross-platform commonality
 \begin{code}
 #include "nativeGen/NCG.h"
 
-module PprMach ( pprInstr ) where
+module PprMach ( pprInstr, pprSize ) where
 
 #include "HsVersions.h"
 
@@ -398,11 +398,10 @@ pprInstr (COMMENT s)
      ,)))
 
 pprInstr (SEGMENT TextSegment)
-    = ptext
-	 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
-	,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
-	,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
-	,)))
+    =  IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
+      ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
+      ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
+      ,)))
 
 pprInstr (SEGMENT DataSegment)
     = ptext
@@ -946,8 +945,8 @@ pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
 #endif
 pprInstr (MOV size src dst)
   = pprSizeOpOp SLIT("mov") size src dst
-pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
-pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
+pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
+pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
 
 -- here we do some patching, since the physical registers are only set late
 -- in the code generation.
@@ -1084,6 +1083,7 @@ gtab  = char '\t'
 gsp   = char ' '
 gregno (FixedReg i) = I# i
 gregno (MappedReg i) = I# i
+gregno other = pprPanic "gregno" (text (show other))
 
 pprG :: Instr -> SDoc -> SDoc
 pprG fake actual
@@ -1255,7 +1255,7 @@ pprOpOp name size op1 op2
 
 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
 pprSizeOpOpCoerce name size1 size2 op1 op2
-  = hcat [ char '\t', ptext name, space,
+  = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
 	pprOperand size1 op1,
 	comma,
 	pprOperand size2 op2
diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs
index ac015fe225..eab566ca3e 100644
--- a/ghc/compiler/nativeGen/RegAllocInfo.lhs
+++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs
@@ -355,8 +355,8 @@ regUsage instr = case instr of
 
 regUsage instr = case instr of
     MOV  sz src dst	-> usage2 src dst
-    MOVZX sz src dst	-> usage2 src dst
-    MOVSX sz src dst	-> usage2 src dst
+    MOVZxL sz src dst	-> usage2 src dst
+    MOVSxL sz src dst	-> usage2 src dst
     LEA  sz src dst	-> usage2 src dst
     ADD  sz src dst	-> usage2 src dst
     SUB  sz src dst	-> usage2 src dst
@@ -409,7 +409,7 @@ regUsage instr = case instr of
     LABEL _		-> noUsage
     ASCII _ _		-> noUsage
     DATA _ _		-> noUsage
-    _			-> error ("regUsage: " ++ showSDoc (pprInstr instr)) --noUsage
+    _			-> error ("regUsage(x86): " ++ showSDoc (pprInstr instr))
  where
     usage2 :: Operand -> Operand -> RegUsage
     usage2 op (OpReg reg) = usage (opToReg op) [reg]
@@ -640,8 +640,8 @@ patchRegs instr env = case instr of
 
 patchRegs instr env = case instr of
     MOV  sz src dst	-> patch2 (MOV  sz) src dst
-    MOVZX sz src dst	-> patch2 (MOVZX sz) src dst
-    MOVSX sz src dst	-> patch2 (MOVSX sz) src dst
+    MOVZxL sz src dst	-> patch2 (MOVZxL sz) src dst
+    MOVSxL sz src dst	-> patch2 (MOVSxL sz) src dst
     LEA  sz src dst	-> patch2 (LEA  sz) src dst
     ADD  sz src dst	-> patch2 (ADD  sz) src dst
     SUB  sz src dst	-> patch2 (SUB  sz) src dst
diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index e5dd49d835..3b297a80ef 100644
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -5,7 +5,7 @@
 \begin{code}
 module Stix (
 	CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
-	sStLitLbl, pprStixTrees,
+	sStLitLbl, pprStixTrees, ppStixReg,
 
 	stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, 
         stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
@@ -100,6 +100,14 @@ data StixTree
 
   | StCall FAST_STRING CallConv PrimRep [StixTree]
 
+    -- A volatile memory scratch array, which is allocated
+    -- relative to the stack pointer.  It is an array of
+    -- ptr/word/int sized things.  Do not expect to be preserved
+    -- beyond basic blocks or over a ccall.  Current max size
+    -- is 6, used in StixInteger.
+
+  | StScratchWord Int
+
     -- Assembly-language comments
 
   | StComment FAST_STRING
@@ -146,8 +154,9 @@ ppStixTree t
        StCall nm cc k args
           -> paren (text "Call" <+> ptext nm <+>
                pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
-     where 
-        pprPrimRep = text . showPrimRep
+       StScratchWord i -> text "ScratchWord" <> paren (int i)
+
+pprPrimRep = text . showPrimRep
 \end{code}
 
 Stix registers can have two forms.  They {\em may} or {\em may not}
@@ -167,10 +176,10 @@ ppStixReg (StixTemp u pr)
 
 
 ppMId BaseReg              = text "BaseReg"
-ppMId (VanillaReg kind n)  = hcat [text "IntReg(", int (I# n), char ')']
+ppMId (VanillaReg kind n)  = hcat [pprPrimRep kind, text "IntReg(", int (I# n), char ')']
 ppMId (FloatReg n)         = hcat [text "FltReg(", int (I# n), char ')']
 ppMId (DoubleReg n)        = hcat [text "DblReg(", int (I# n), char ')']
-ppMId (LongReg kind n)     = hcat [text "LongReg(", int (I# n), char ')']
+ppMId (LongReg kind n)     = hcat [pprPrimRep kind, text "LongReg(", int (I# n), char ')']
 ppMId Sp                   = text "Sp"
 ppMId Su                   = text "Su"
 ppMId SpLim                = text "SpLim"
diff --git a/ghc/compiler/nativeGen/StixInteger.lhs b/ghc/compiler/nativeGen/StixInteger.lhs
index 044548c8c4..fbd96cf1a7 100644
--- a/ghc/compiler/nativeGen/StixInteger.lhs
+++ b/ghc/compiler/nativeGen/StixInteger.lhs
@@ -5,9 +5,10 @@
 \begin{code}
 module StixInteger ( 
 	gmpCompare, 
+        gmpCompareInt,
 	gmpInteger2Int, 
 	gmpInteger2Word,
-	gmpNegate 
+	gmpNegate
 	) where
 
 #include "HsVersions.h"
@@ -23,7 +24,7 @@ import OrdList		( OrdList )
 import PrimOp		( PrimOp(..) )
 import PrimRep		( PrimRep(..) )
 import SMRep		( arrWordsHdrSize )
-import Stix		( sStLitLbl, StixTree(..), StixTreeList )
+import Stix		( sStLitLbl, StixTree(..), StixTreeList, arrWordsHS )
 import UniqSupply	( returnUs, thenUs, UniqSM )
 \end{code}
 
@@ -33,23 +34,30 @@ enclosing routine has already guaranteed that this space will be
 available.  (See ``primOpHeapRequired.'')
 
 \begin{code}
+stgArrWords__words        :: StixTree -> StixTree
+stgArrWords__BYTE_ARR_CTS :: StixTree -> StixTree
+
+stgArrWords__BYTE_ARR_CTS arr 
+   = StIndex WordRep arr arrWordsHS
+stgArrWords__words        arr 
+   = case arrWordsHS of 
+        StInt i -> StInd WordRep (StIndex PtrRep arr (StInt (i-1)))
+
 gmpCompare
     :: CAddrMode    	    -- result (boolean)
-    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
-    		  	    -- alloc hp + 2 arguments (3 parts each)
+    -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode)
+    		  	    -- alloc hp + 2 arguments (2 parts each)
     -> UniqSM StixTreeList
 
-gmpCompare res args@(caa1,csa1,cda1, caa2,csa2,cda2)
+gmpCompare res args@(csa1,cda1, csa2,cda2)
   = let
 	result	= amodeToStix res
-	scratch1 = scratch_space
-	scratch2 = StIndex IntRep scratch_space (StInt (toInteger mpIntSize))
-	aa1	= amodeToStix caa1
 	sa1	= amodeToStix csa1
-	da1	= amodeToStix cda1
-	aa2	= amodeToStix caa2
 	sa2	= amodeToStix csa2
-	da2	= amodeToStix cda2
+	aa1	= stgArrWords__words (amodeToStix cda1)
+	aa2	= stgArrWords__words (amodeToStix cda2)
+	da1	= stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
+	da2	= stgArrWords__BYTE_ARR_CTS (amodeToStix cda2)
 
     	(a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
     	(a4,a5,a6) = toStruct scratch2 (aa2,sa2,da2)
@@ -57,58 +65,77 @@ gmpCompare res args@(caa1,csa1,cda1, caa2,csa2,cda2)
     	r1 = StAssign IntRep result mpz_cmp
     in
     returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
+
+
+gmpCompareInt
+    :: CAddrMode    	    -- result (boolean)
+    -> (CAddrMode,CAddrMode,CAddrMode)
+    -> UniqSM StixTreeList  -- alloc hp + 1 arg (??)
+
+gmpCompareInt res args@(csa1,cda1, cai)
+  = let
+	result	 = amodeToStix res
+	sa1	 = amodeToStix csa1
+	aa1	 = stgArrWords__words (amodeToStix cda1)
+	da1	 = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
+        ai       = amodeToStix cai
+    	(a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
+    	mpz_cmp_si = StCall SLIT("mpz_cmp_si") cCallConv IntRep [scratch1, ai]
+    	r1 = StAssign IntRep result mpz_cmp_si
+    in
+    returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 \end{code}
 
 \begin{code}
 gmpInteger2Int
     :: CAddrMode    	    -- result
-    -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
+    -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
     -> UniqSM StixTreeList
 
-gmpInteger2Int res args@(caa,csa,cda)
+gmpInteger2Int res args@(csa,cda)
   = let
 	result	= amodeToStix res
-	aa	= amodeToStix caa
 	sa	= amodeToStix csa
-	da	= amodeToStix cda
+	aa	= stgArrWords__words (amodeToStix cda)
+	da	= stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
 
-    	(a1,a2,a3) = toStruct scratch_space (aa,sa,da)
-    	mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch_space]
+    	(a1,a2,a3) = toStruct scratch1 (aa,sa,da)
+    	mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch1]
     	r1 = StAssign IntRep result mpz_get_si
     in
     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 
 gmpInteger2Word
     :: CAddrMode    	    -- result
-    -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
+    -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
     -> UniqSM StixTreeList
 
-gmpInteger2Word res args@(caa,csa,cda)
+gmpInteger2Word res args@(csa,cda)
   = let
 	result	= amodeToStix res
-	aa	= amodeToStix caa
 	sa	= amodeToStix csa
-	da	= amodeToStix cda
+	aa	= stgArrWords__words (amodeToStix cda)
+	da	= stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
 
-    	(a1,a2,a3) = toStruct scratch_space (aa,sa,da)
-    	mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch_space]
+    	(a1,a2,a3) = toStruct scratch1 (aa,sa,da)
+    	mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch1]
     	r1 = StAssign WordRep result mpz_get_ui
     in
     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 
 gmpNegate
-    :: (CAddrMode,CAddrMode,CAddrMode) -- result
-    -> (CAddrMode,CAddrMode,CAddrMode) -- argument (3 parts)
+    :: (CAddrMode,CAddrMode) -- result
+    -> (CAddrMode,CAddrMode) -- argument (2 parts)
     -> UniqSM StixTreeList
 
-gmpNegate (rca, rcs, rcd) args@(ca, cs, cd)
+gmpNegate (rcs, rcd) args@(cs, cd)
   = let
-	a	= amodeToStix ca
 	s	= amodeToStix cs
-	d	= amodeToStix cd
-	ra	= amodeToStix rca
+	a	= stgArrWords__words (amodeToStix cd)
+	d	= stgArrWords__BYTE_ARR_CTS (amodeToStix cd)
 	rs	= amodeToStix rcs
-	rd	= amodeToStix rcd
+	ra	= stgArrWords__words (amodeToStix rcd)
+	rd	= stgArrWords__BYTE_ARR_CTS (amodeToStix rcd)
 	a1      = StAssign IntRep ra a
 	a2      = StAssign IntRep rs (StPrim IntNegOp [s])
 	a3	= StAssign PtrRep rd d
@@ -138,11 +165,11 @@ toStruct str (alloc,size,arr)
   = let
     	f1 = StAssign IntRep (mpAlloc str) alloc
     	f2 = StAssign IntRep (mpSize str) size
-    	f3 = StAssign PtrRep (mpData str) 
-		(StIndex PtrRep arr (StInt (toInteger arrWordsHdrSize)))
+    	f3 = StAssign PtrRep (mpData str) arr
     in
     (f1, f2, f3)
 
-scratch_space = sStLitLbl SLIT("stg_scratch_space")
+scratch1 = StScratchWord 0
+scratch2 = StScratchWord mpIntSize
 \end{code}
 
diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 8cb3594e14..2d86439692 100644
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -53,19 +53,20 @@ and modify our heap check accordingly.
 \begin{code}
 -- NB: ordering of clauses somewhere driven by
 -- the desire to getting sane patt-matching behavior
-primCode res@[ar,sr,dr] IntegerNegOp arg@[aa,sa,da]
-  = gmpNegate (ar,sr,dr) (aa,sa,da)
-\end{code}
+primCode res@[sr,dr] IntegerNegOp arg@[sa,da]
+  = gmpNegate (sr,dr) (sa,da)
 
-\begin{code}
-primCode [res] IntegerCmpOp args@[aa1,sa1,da1, aa2,sa2,da2]
-  = gmpCompare res (aa1,sa1,da1, aa2,sa2,da2)
+primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2]
+  = gmpCompare res (sa1,da1, sa2,da2)
+
+primCode [res] IntegerCmpIntOp args@[sa1,da1,ai]
+  = gmpCompareInt res (sa1,da1,ai)
 
-primCode [res] Integer2IntOp arg@[aa,sa,da]
-  = gmpInteger2Int res (aa,sa,da)
+primCode [res] Integer2IntOp arg@[sa,da]
+  = gmpInteger2Int res (sa,da)
 
-primCode [res] Integer2WordOp arg@[aa,sa,da]
-  = gmpInteger2Word res (aa,sa,da)
+primCode [res] Integer2WordOp arg@[sa,da]
+  = gmpInteger2Word res (sa,da)
 
 primCode [res] Int2AddrOp [arg]
   = simpleCoercion AddrRep res arg
@@ -350,7 +351,7 @@ amodeToStix (CCharLike (CLit (MachChar c)))
     off = charLikeSize * ord c
 
 amodeToStix (CCharLike x)
-  = StIndex PtrRep charLike off
+  = StIndex CharRep charLike off
   where
     off = StPrim IntMulOp [amodeToStix x, StInt (toInteger charLikeSize)]