X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachCode.lhs;h=51e6197bedb69e3af78118b2df3e653a645d1d3b;hb=814e402f24569ca7a8a02e8b54a38abfd6b0b59e;hp=031c3ba038a058074dd8ce4eca6e7427f0674ec6;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 031c3ba..51e6197 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -12,7 +12,7 @@ structure should not be too overwhelming.
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
-module MachCode ( stmt2Instrs, asmVoid, InstrList(..) ) where
+module MachCode ( stmt2Instrs, asmVoid, SYN_IE(InstrList) ) where
 
 IMP_Ubiq(){-uitious-}
 
@@ -21,19 +21,19 @@ import MachRegs
 
 import AbsCSyn		( MagicId )
 import AbsCUtils	( magicIdPrimRep )
-import CLabel		( isAsmTemp )
+import CLabel		( isAsmTemp, CLabel )
 import Maybes		( maybeToBool, expectJust )
 import OrdList		-- quite a bit of it
-import Pretty		( prettyToUn, ppRational )
+import Outputable	( PprStyle(..) )
+import Pretty		( ptext, rational )
 import PrimRep		( isFloatingRep, PrimRep(..) )
-import PrimOp		( PrimOp(..) )
+import PrimOp		( PrimOp(..), showPrimOp )
 import Stix		( getUniqLabelNCG, StixTree(..),
 			  StixReg(..), CodeSegment(..)
 			)
 import UniqSupply	( returnUs, thenUs, mapUs, mapAndUnzipUs,
 			  mapAccumLUs, SYN_IE(UniqSM)
 			)
-import Unpretty		( uppPStr )
 import Util		( panic, assertPanic )
 \end{code}
 
@@ -128,6 +128,7 @@ 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
@@ -139,8 +140,17 @@ mangleIndexTree (StIndex pk base off)
 		   StPrim SllOp [off, StInt s]
     ]
   where
-    shift DoubleRep 	= 3
+    shift DoubleRep 	= 3::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}
@@ -274,7 +284,7 @@ getRegister (StDouble d)
     let code dst = mkSeqInstrs [
     	    SEGMENT DataSegment,
 	    LABEL lbl,
-	    DATA TF [ImmLab (prettyToUn (ppRational d))],
+	    DATA TF [ImmLab (rational d)],
 	    SEGMENT TextSegment,
 	    LDA tmp (AddrImm (ImmCLbl lbl)),
 	    LD TF dst (AddrReg tmp)]
@@ -334,46 +344,46 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
-      CharGtOp -> trivialCode (CMP LT) y x
+      CharGtOp -> trivialCode (CMP LTT) y x
       CharGeOp -> trivialCode (CMP LE) y x
-      CharEqOp -> trivialCode (CMP EQ) x y
+      CharEqOp -> trivialCode (CMP EQQ) x y
       CharNeOp -> int_NE_code x y
-      CharLtOp -> trivialCode (CMP LT) x y
+      CharLtOp -> trivialCode (CMP LTT) x y
       CharLeOp -> trivialCode (CMP LE) x y
 
-      IntGtOp  -> trivialCode (CMP LT) y x
+      IntGtOp  -> trivialCode (CMP LTT) y x
       IntGeOp  -> trivialCode (CMP LE) y x
-      IntEqOp  -> trivialCode (CMP EQ) x y
+      IntEqOp  -> trivialCode (CMP EQQ) x y
       IntNeOp  -> int_NE_code x y
-      IntLtOp  -> trivialCode (CMP LT) x y
+      IntLtOp  -> trivialCode (CMP LTT) x y
       IntLeOp  -> trivialCode (CMP LE) x y
 
       WordGtOp -> trivialCode (CMP ULT) y x
       WordGeOp -> trivialCode (CMP ULE) x y
-      WordEqOp -> trivialCode (CMP EQ)  x y
+      WordEqOp -> trivialCode (CMP EQQ)  x y
       WordNeOp -> int_NE_code x y
       WordLtOp -> trivialCode (CMP ULT) x y
       WordLeOp -> trivialCode (CMP ULE) x y
 
       AddrGtOp -> trivialCode (CMP ULT) y x
       AddrGeOp -> trivialCode (CMP ULE) y x
-      AddrEqOp -> trivialCode (CMP EQ)  x y
+      AddrEqOp -> trivialCode (CMP EQQ)  x y
       AddrNeOp -> int_NE_code x y
       AddrLtOp -> trivialCode (CMP ULT) x y
       AddrLeOp -> trivialCode (CMP ULE) x y
 
-      FloatGtOp -> cmpF_code (FCMP TF LE) EQ x y
-      FloatGeOp -> cmpF_code (FCMP TF LT) EQ x y
-      FloatEqOp -> cmpF_code (FCMP TF EQ) NE x y
-      FloatNeOp -> cmpF_code (FCMP TF EQ) EQ x y
-      FloatLtOp -> cmpF_code (FCMP TF LT) NE x y
+      FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
+      FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
+      FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
+      FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
+      FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y
       FloatLeOp -> cmpF_code (FCMP TF LE) NE x y
 
-      DoubleGtOp -> cmpF_code (FCMP TF LE) EQ x y
-      DoubleGeOp -> cmpF_code (FCMP TF LT) EQ x y
-      DoubleEqOp -> cmpF_code (FCMP TF EQ) NE x y
-      DoubleNeOp -> cmpF_code (FCMP TF EQ) EQ x y
-      DoubleLtOp -> cmpF_code (FCMP TF LT) NE x y
+      DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y
+      DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
+      DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y
+      DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
+      DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y
       DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y
 
       IntAddOp  -> trivialCode (ADD Q False) x y
@@ -382,6 +392,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       IntQuotOp -> trivialCode (DIV Q False) x y
       IntRemOp  -> trivialCode (REM Q False) x y
 
+      WordQuotOp -> trivialCode (DIV Q True) x y
+      WordRemOp  -> trivialCode (REM Q True) x y
+
       FloatAddOp -> trivialFCode  FloatRep (FADD TF) x y
       FloatSubOp -> trivialFCode  FloatRep (FSUB TF) x y
       FloatMulOp -> trivialFCode  FloatRep (FMUL TF) x y
@@ -394,6 +407,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 
       AndOp  -> trivialCode AND x y
       OrOp   -> trivialCode OR  x y
+      XorOp  -> trivialCode XOR x y
       SllOp  -> trivialCode SLL x y
       SraOp  -> trivialCode SRA x y
       SrlOp  -> trivialCode SRL x y
@@ -416,7 +430,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
     int_NE_code :: StixTree -> StixTree -> UniqSM Register
 
     int_NE_code x y
-      = trivialCode (CMP EQ) x y	`thenUs` \ register ->
+      = trivialCode (CMP EQQ) x y	`thenUs` \ register ->
 	getNewRegNCG IntRep		`thenUs` \ tmp ->
 	let
 	    code = registerCode register tmp
@@ -443,9 +457,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    result  = registerName register tmp
 
 	    code__2 dst = code . mkSeqInstrs [
-		OR zero (RIImm (ImmInt 1)) dst,
-		BF cond result (ImmCLbl lbl),
-		OR zero (RIReg zero) dst,
+		OR zeroh (RIImm (ImmInt 1)) dst,
+		BF cond  result (ImmCLbl lbl),
+		OR zeroh (RIReg zeroh) dst,
 		LABEL lbl]
 	in
 	returnUs (Any IntRep code__2)
@@ -466,7 +480,7 @@ getRegister (StInd pk mem)
 getRegister (StInt i)
   | fits8Bits i
   = let
-    	code dst = mkSeqInstr (OR zero (RIImm src) dst)
+    	code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
     in
     returnUs (Any IntRep code)
   | otherwise
@@ -584,46 +598,46 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
-      CharGtOp -> condIntReg GT x y
+      CharGtOp -> condIntReg GTT x y
       CharGeOp -> condIntReg GE x y
-      CharEqOp -> condIntReg EQ x y
+      CharEqOp -> condIntReg EQQ x y
       CharNeOp -> condIntReg NE x y
-      CharLtOp -> condIntReg LT x y
+      CharLtOp -> condIntReg LTT x y
       CharLeOp -> condIntReg LE x y
 
-      IntGtOp  -> condIntReg GT x y
+      IntGtOp  -> condIntReg GTT x y
       IntGeOp  -> condIntReg GE x y
-      IntEqOp  -> condIntReg EQ x y
+      IntEqOp  -> condIntReg EQQ x y
       IntNeOp  -> condIntReg NE x y
-      IntLtOp  -> condIntReg LT x y
+      IntLtOp  -> condIntReg LTT x y
       IntLeOp  -> condIntReg LE x y
 
       WordGtOp -> condIntReg GU  x y
       WordGeOp -> condIntReg GEU x y
-      WordEqOp -> condIntReg EQ  x y
+      WordEqOp -> condIntReg EQQ  x y
       WordNeOp -> condIntReg NE  x y
       WordLtOp -> condIntReg LU  x y
       WordLeOp -> condIntReg LEU x y
 
       AddrGtOp -> condIntReg GU  x y
       AddrGeOp -> condIntReg GEU x y
-      AddrEqOp -> condIntReg EQ  x y
+      AddrEqOp -> condIntReg EQQ  x y
       AddrNeOp -> condIntReg NE  x y
       AddrLtOp -> condIntReg LU  x y
       AddrLeOp -> condIntReg LEU x y
 
-      FloatGtOp -> condFltReg GT x y
+      FloatGtOp -> condFltReg GTT x y
       FloatGeOp -> condFltReg GE x y
-      FloatEqOp -> condFltReg EQ x y
+      FloatEqOp -> condFltReg EQQ x y
       FloatNeOp -> condFltReg NE x y
-      FloatLtOp -> condFltReg LT x y
+      FloatLtOp -> condFltReg LTT x y
       FloatLeOp -> condFltReg LE x y
 
-      DoubleGtOp -> condFltReg GT x y
+      DoubleGtOp -> condFltReg GTT x y
       DoubleGeOp -> condFltReg GE x y
-      DoubleEqOp -> condFltReg EQ x y
+      DoubleEqOp -> condFltReg EQQ x y
       DoubleNeOp -> condFltReg NE x y
-      DoubleLtOp -> condFltReg LT x y
+      DoubleLtOp -> condFltReg LTT x y
       DoubleLeOp -> condFltReg LE x y
 
       IntAddOp  -> {- ToDo: fix this, whatever it is (WDP 96/04)...
@@ -652,10 +666,18 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 
       AndOp -> trivialCode (AND L) x y {-True-}
       OrOp  -> trivialCode (OR L)  x y {-True-}
-      SllOp -> trivialCode (SHL L) x y {-False-}
-      SraOp -> trivialCode (SAR L) x y {-False-}
-      SrlOp -> trivialCode (SHR L) x y {-False-}
-
+      XorOp -> trivialCode (XOR L) x y {-True-}
+
+	{- Shift ops on x86s have constraints on their source, it
+	   either has to be Imm, CL or 1
+	    => trivialCode's is not restrictive enough (sigh.)
+	-}
+	   
+      SllOp -> shift_code (SHL L) x y {-False-}
+      SraOp -> shift_code (SAR L) x y {-False-}
+      SrlOp -> shift_code (SHR L) x y {-False-}
+
+      {- ToDo: nuke? -}
       ISllOp -> panic "I386Gen:isll"
       ISraOp -> panic "I386Gen:isra"
       ISrlOp -> panic "I386Gen:isrl"
@@ -664,6 +686,65 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 		       where promote x = StPrim Float2DoubleOp [x]
       DoublePowerOp -> getRegister (StCall SLIT("pow") DoubleRep [x, y])
   where
+    shift_code :: (Operand -> Operand -> Instr)
+	       -> StixTree
+	       -> StixTree
+	       -> UniqSM Register
+      {- Case1: shift length as immediate -}
+      -- Code is the same as the first eq. for trivialCode -- sigh.
+    shift_code instr x y{-amount-}
+      | maybeToBool imm
+      = getRegister x		`thenUs` \ register ->
+	let
+	    op_imm = OpImm imm__2
+	    code__2 dst = 
+		let
+		 code  = registerCode  register dst
+		 src   = registerName  register dst
+	        in
+		mkSeqInstr (COMMENT SLIT("shift_code")) . 
+		code .
+		if isFixed register && src /= dst
+		then
+		   mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
+				instr op_imm  (OpReg dst)]
+		else
+		   mkSeqInstr (instr op_imm (OpReg src)) 
+	in
+        returnUs (Any IntRep code__2)
+      where
+       imm = maybeImm y
+       imm__2 = case imm of Just x -> x
+
+      {- Case2: shift length is complex (non-immediate) -}
+    shift_code instr x y{-amount-}
+     = getRegister y		`thenUs` \ register1 ->  
+       getRegister x		`thenUs` \ register2 ->
+--       getNewRegNCG IntRep	`thenUs` \ dst ->
+       let
+	-- Note: we force the shift length to be loaded
+	-- into ECX, so that we can use CL when shifting.
+	-- (only register location we are allowed
+	-- to put shift amounts.)
+	-- 
+	-- The shift instruction is fed ECX as src reg,
+	-- but we coerce this into CL when printing out.
+	src1	= registerName register1 ecx
+    	code1   = if src1 /= ecx then -- if it is not in ecx already, force it!
+    		    registerCode register1 ecx .
+		    mkSeqInstr (MOV L (OpReg src1) (OpReg ecx))
+		  else 
+    		    registerCode register1 ecx
+    	code__2 = 
+		      let
+	               code2 = registerCode register2 eax
+	               src2  = registerName register2 eax
+		      in
+		      code1 . code2 .
+		      mkSeqInstr (instr (OpReg ecx) (OpReg eax))
+       in
+       returnUs (Fixed IntRep eax code__2)
+
     add_code :: Size -> StixTree -> StixTree -> UniqSM Register
 
     add_code sz x (StInt y)
@@ -674,7 +755,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src1 = registerName register tmp
 	    src2 = ImmInt (fromInteger y)
 	    code__2 dst = code .
-			  mkSeqInstr (LEA sz (OpAddr (Addr (Just src1) Nothing src2)) (OpReg dst))
+			  mkSeqInstr (LEA sz (OpAddr (Address (Just src1) Nothing src2)) (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -687,7 +768,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code2 = amodeCode amode
 	    src2  = amodeAddr amode
 
-	    fixedname  = registerName register1 eax
+--	    fixedname  = registerName register1 eax
 	    code__2 dst = let code1 = registerCode register1 dst
 			      src1  = registerName register1 dst
 			  in asmParThen [code2 asmVoid,code1 asmVoid] .
@@ -708,7 +789,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code1 = amodeCode amode
 	    src1  = amodeAddr amode
 
-	    fixedname  = registerName register2 eax
+--	    fixedname  = registerName register2 eax
 	    code__2 dst = let code2 = registerCode register2 dst
 			      src2  = registerName register2 dst
 			  in asmParThen [code1 asmVoid,code2 asmVoid] .
@@ -731,7 +812,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code2 = registerCode register2 tmp2 asmVoid
 	    src2  = registerName register2 tmp2
 	    code__2 dst = asmParThen [code1, code2] .
-			  mkSeqInstr (LEA sz (OpAddr (Addr (Just src1) (Just (src2,1)) (ImmInt 0))) (OpReg dst))
+			  mkSeqInstr (LEA sz (OpAddr (Address (Just src1) (Just (src2,1)) (ImmInt 0))) (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -746,7 +827,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src1 = registerName register tmp
 	    src2 = ImmInt (-(fromInteger y))
 	    code__2 dst = code .
-			  mkSeqInstr (LEA sz (OpAddr (Addr (Just src1) Nothing src2)) (OpReg dst))
+			  mkSeqInstr (LEA sz (OpAddr (Address (Just src1) Nothing src2)) (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -789,10 +870,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    src2    = ImmInt (fromInteger i)
 	    code__2 = asmParThen [code1] .
 		      mkSeqInstrs [-- we put src2 in (ebx)
-				   MOV L (OpImm src2) (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))),
+				   MOV L (OpImm src2) (OpAddr (Address (Just ebx) Nothing (ImmInt OFFSET_R1))),
 				   MOV L (OpReg src1) (OpReg eax),
 				   CLTD,
-				   IDIV sz (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)))]
+				   IDIV sz (OpAddr (Address (Just ebx) Nothing (ImmInt OFFSET_R1)))]
 	in
 	returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
 
@@ -812,10 +893,10 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 					 CLTD,
 					 IDIV sz (OpReg src2)]
 		      else mkSeqInstrs [ -- we put src2 in (ebx)
-					 MOV L (OpReg src2) (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))),
+					 MOV L (OpReg src2) (OpAddr (Address (Just ebx) Nothing (ImmInt OFFSET_R1))),
 					 MOV L (OpReg src1) (OpReg eax),
 					 CLTD,
-					 IDIV sz (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)))]
+					 IDIV sz (OpAddr (Address (Just ebx) Nothing (ImmInt OFFSET_R1)))]
 	in
 	returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
 	-----------------------
@@ -872,10 +953,10 @@ getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
       IntNegOp -> trivialUCode (SUB False False g0) x
       IntAbsOp -> absIntCode x
-
       NotOp    -> trivialUCode (XNOR False g0) x
 
       FloatNegOp  -> trivialUFCode FloatRep (FNEG F) x
+
       DoubleNegOp -> trivialUFCode DoubleRep (FNEG DF) x
 
       Double2FloatOp -> trivialUFCode FloatRep  (FxTOy DF F) x
@@ -901,6 +982,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 	  = case primop of
 	      FloatExpOp    -> (True,  SLIT("exp"))
 	      FloatLogOp    -> (True,  SLIT("log"))
+	      FloatSqrtOp   -> (True,  SLIT("sqrt"))
 
 	      FloatSinOp    -> (True,  SLIT("sin"))
 	      FloatCosOp    -> (True,  SLIT("cos"))
@@ -916,6 +998,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 
 	      DoubleExpOp   -> (False, SLIT("exp"))
 	      DoubleLogOp   -> (False, SLIT("log"))
+	      DoubleSqrtOp  -> (True,  SLIT("sqrt"))
 
 	      DoubleSinOp   -> (False, SLIT("sin"))
 	      DoubleCosOp   -> (False, SLIT("cos"))
@@ -928,49 +1011,50 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 	      DoubleSinhOp  -> (False, SLIT("sinh"))
 	      DoubleCoshOp  -> (False, SLIT("cosh"))
 	      DoubleTanhOp  -> (False, SLIT("tanh"))
+	      _             -> panic ("Monadic PrimOp not handled: " ++ showPrimOp PprDebug primop)
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
-      CharGtOp -> condIntReg GT x y
+      CharGtOp -> condIntReg GTT x y
       CharGeOp -> condIntReg GE x y
-      CharEqOp -> condIntReg EQ x y
+      CharEqOp -> condIntReg EQQ x y
       CharNeOp -> condIntReg NE x y
-      CharLtOp -> condIntReg LT x y
+      CharLtOp -> condIntReg LTT x y
       CharLeOp -> condIntReg LE x y
 
-      IntGtOp  -> condIntReg GT x y
+      IntGtOp  -> condIntReg GTT x y
       IntGeOp  -> condIntReg GE x y
-      IntEqOp  -> condIntReg EQ x y
+      IntEqOp  -> condIntReg EQQ x y
       IntNeOp  -> condIntReg NE x y
-      IntLtOp  -> condIntReg LT x y
+      IntLtOp  -> condIntReg LTT x y
       IntLeOp  -> condIntReg LE x y
 
       WordGtOp -> condIntReg GU  x y
       WordGeOp -> condIntReg GEU x y
-      WordEqOp -> condIntReg EQ  x y
+      WordEqOp -> condIntReg EQQ  x y
       WordNeOp -> condIntReg NE  x y
       WordLtOp -> condIntReg LU  x y
       WordLeOp -> condIntReg LEU x y
 
       AddrGtOp -> condIntReg GU  x y
       AddrGeOp -> condIntReg GEU x y
-      AddrEqOp -> condIntReg EQ  x y
+      AddrEqOp -> condIntReg EQQ  x y
       AddrNeOp -> condIntReg NE  x y
       AddrLtOp -> condIntReg LU  x y
       AddrLeOp -> condIntReg LEU x y
 
-      FloatGtOp -> condFltReg GT x y
+      FloatGtOp -> condFltReg GTT x y
       FloatGeOp -> condFltReg GE x y
-      FloatEqOp -> condFltReg EQ x y
+      FloatEqOp -> condFltReg EQQ x y
       FloatNeOp -> condFltReg NE x y
-      FloatLtOp -> condFltReg LT x y
+      FloatLtOp -> condFltReg LTT x y
       FloatLeOp -> condFltReg LE x y
 
-      DoubleGtOp -> condFltReg GT x y
+      DoubleGtOp -> condFltReg GTT x y
       DoubleGeOp -> condFltReg GE x y
-      DoubleEqOp -> condFltReg EQ x y
+      DoubleEqOp -> condFltReg EQQ x y
       DoubleNeOp -> condFltReg NE x y
-      DoubleLtOp -> condFltReg LT x y
+      DoubleLtOp -> condFltReg LTT x y
       DoubleLeOp -> condFltReg LE x y
 
       IntAddOp -> trivialCode (ADD False False) x y
@@ -992,7 +1076,8 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoubleDivOp -> trivialFCode DoubleRep FDIV x y
 
       AndOp -> trivialCode (AND False) x y
-      OrOp  -> trivialCode (OR False) x y
+      OrOp  -> trivialCode (OR  False) x y
+      XorOp -> trivialCode (XOR False) x y
       SllOp -> trivialCode SLL x y
       SraOp -> trivialCode SRA x y
       SrlOp -> trivialCode SRL x y
@@ -1048,7 +1133,7 @@ getRegister leaf
 
 @Amode@s: Memory addressing modes passed up the tree.
 \begin{code}
-data Amode = Amode Addr InstrBlock
+data Amode = Amode Address InstrBlock
 
 amodeAddr (Amode addr _) = addr
 amodeCode (Amode _ code) = code
@@ -1112,7 +1197,7 @@ getAmode (StPrim IntSubOp [x, StInt i])
     	reg  = registerName register tmp
     	off  = ImmInt (-(fromInteger i))
     in
-    returnUs (Amode (Addr (Just reg) Nothing off) code)
+    returnUs (Amode (Address (Just reg) Nothing off) code)
 
 getAmode (StPrim IntAddOp [x, StInt i])
   | maybeToBool imm
@@ -1132,7 +1217,7 @@ getAmode (StPrim IntAddOp [x, StInt i])
     	reg  = registerName register tmp
     	off  = ImmInt (fromInteger i)
     in
-    returnUs (Amode (Addr (Just reg) Nothing off) code)
+    returnUs (Amode (Address (Just reg) Nothing off) code)
 
 getAmode (StPrim IntAddOp [x, y])
   = getNewRegNCG PtrRep		`thenUs` \ tmp1 ->
@@ -1146,7 +1231,7 @@ getAmode (StPrim IntAddOp [x, y])
     	reg2  = registerName register2 tmp2
     	code__2 = asmParThen [code1, code2]
     in
-    returnUs (Amode (Addr (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
+    returnUs (Amode (Address (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
 
 getAmode leaf
   | maybeToBool imm
@@ -1166,7 +1251,7 @@ getAmode other
     	reg  = registerName register tmp
     	off  = Nothing
     in
-    returnUs (Amode (Addr (Just reg) Nothing (ImmInt 0)) code)
+    returnUs (Amode (Address (Just reg) Nothing (ImmInt 0)) code)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1263,46 +1348,46 @@ getCondCode = panic "MachCode.getCondCode: not on Alphas"
 
 getCondCode (StPrim primop [x, y])
   = case primop of
-      CharGtOp -> condIntCode GT  x y
+      CharGtOp -> condIntCode GTT  x y
       CharGeOp -> condIntCode GE  x y
-      CharEqOp -> condIntCode EQ  x y
+      CharEqOp -> condIntCode EQQ  x y
       CharNeOp -> condIntCode NE  x y
-      CharLtOp -> condIntCode LT  x y
+      CharLtOp -> condIntCode LTT  x y
       CharLeOp -> condIntCode LE  x y
  
-      IntGtOp  -> condIntCode GT  x y
+      IntGtOp  -> condIntCode GTT  x y
       IntGeOp  -> condIntCode GE  x y
-      IntEqOp  -> condIntCode EQ  x y
+      IntEqOp  -> condIntCode EQQ  x y
       IntNeOp  -> condIntCode NE  x y
-      IntLtOp  -> condIntCode LT  x y
+      IntLtOp  -> condIntCode LTT  x y
       IntLeOp  -> condIntCode LE  x y
 
       WordGtOp -> condIntCode GU  x y
       WordGeOp -> condIntCode GEU x y
-      WordEqOp -> condIntCode EQ  x y
+      WordEqOp -> condIntCode EQQ  x y
       WordNeOp -> condIntCode NE  x y
       WordLtOp -> condIntCode LU  x y
       WordLeOp -> condIntCode LEU x y
 
       AddrGtOp -> condIntCode GU  x y
       AddrGeOp -> condIntCode GEU x y
-      AddrEqOp -> condIntCode EQ  x y
+      AddrEqOp -> condIntCode EQQ  x y
       AddrNeOp -> condIntCode NE  x y
       AddrLtOp -> condIntCode LU  x y
       AddrLeOp -> condIntCode LEU x y
 
-      FloatGtOp -> condFltCode GT x y
+      FloatGtOp -> condFltCode GTT x y
       FloatGeOp -> condFltCode GE x y
-      FloatEqOp -> condFltCode EQ x y
+      FloatEqOp -> condFltCode EQQ x y
       FloatNeOp -> condFltCode NE x y
-      FloatLtOp -> condFltCode LT x y
+      FloatLtOp -> condFltCode LTT x y
       FloatLeOp -> condFltCode LE x y
 
-      DoubleGtOp -> condFltCode GT x y
+      DoubleGtOp -> condFltCode GTT x y
       DoubleGeOp -> condFltCode GE x y
-      DoubleEqOp -> condFltCode EQ x y
+      DoubleEqOp -> condFltCode EQQ x y
       DoubleNeOp -> condFltCode NE x y
-      DoubleLtOp -> condFltCode LT x y
+      DoubleLtOp -> condFltCode LTT x y
       DoubleLeOp -> condFltCode LE x y
 
 #endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH -}
@@ -1460,8 +1545,8 @@ condFltCode cond x y
 fix_FP_cond :: Cond -> Cond
 
 fix_FP_cond GE  = GEU
-fix_FP_cond GT  = GU
-fix_FP_cond LT  = LU
+fix_FP_cond GTT  = GU
+fix_FP_cond LTT  = LU
 fix_FP_cond LE  = LEU
 fix_FP_cond any = any
 
@@ -1555,7 +1640,7 @@ assignIntCode, assignFltCode
 assignIntCode pk (StInd _ dst) src
   = getNewRegNCG IntRep    	    `thenUs` \ tmp ->
     getAmode dst    	    	    `thenUs` \ amode ->
-    getRegister src	    	    	    `thenUs` \ register ->
+    getRegister src	     	    `thenUs` \ register ->
     let
     	code1   = amodeCode amode asmVoid
     	dst__2  = amodeAddr amode
@@ -1570,7 +1655,7 @@ assignIntCode pk dst src
   = getRegister dst	    	    	    `thenUs` \ register1 ->
     getRegister src	    	    	    `thenUs` \ register2 ->
     let
-    	dst__2  = registerName register1 zero
+    	dst__2  = registerName register1 zeroh
     	code    = registerCode register2 dst__2
     	src__2  = registerName register2 dst__2
     	code__2 = if isFixed register2
@@ -1704,7 +1789,7 @@ assignFltCode pk dst src
   = getRegister dst	    	    	    `thenUs` \ register1 ->
     getRegister src	    	    	    `thenUs` \ register2 ->
     let
-    	dst__2  = registerName register1 zero
+    	dst__2  = registerName register1 zeroh
     	code    = registerCode register2 dst__2
     	src__2  = registerName register2 dst__2
     	code__2 = if isFixed register2
@@ -1782,45 +1867,49 @@ assignFltCode pk dst src
 #if sparc_TARGET_ARCH
 
 assignFltCode pk (StInd _ dst) src
-  = getNewRegNCG pk        	    `thenUs` \ tmp ->
+  = getNewRegNCG pk        	    `thenUs` \ tmp1 ->
     getAmode dst    	    	    `thenUs` \ amode ->
-    getRegister src	    	    	    `thenUs` \ register ->
+    getRegister src	      	    `thenUs` \ register ->
     let
     	sz      = primRepToSize pk
     	dst__2  = amodeAddr amode
 
     	code1   = amodeCode amode asmVoid
-    	code2   = registerCode register tmp asmVoid
+    	code2   = registerCode register tmp1 asmVoid
 
-    	src__2  = registerName register tmp
+    	src__2  = registerName register tmp1
     	pk__2   = registerRep register
     	sz__2   = primRepToSize pk__2
 
     	code__2 = asmParThen [code1, code2] .
 	    if pk == pk__2 then
-		mkSeqInstr (ST sz src__2 dst__2)
+		    mkSeqInstr (ST sz src__2 dst__2)
 	    else
-		mkSeqInstrs [FxTOy sz__2 sz src__2 tmp, ST sz tmp dst__2]
+		mkSeqInstrs [FxTOy sz__2 sz src__2 tmp1, ST sz tmp1 dst__2]
     in
     returnUs code__2
 
 assignFltCode pk dst src
   = getRegister dst	    	    	    `thenUs` \ register1 ->
     getRegister src	    	    	    `thenUs` \ register2 ->
-    getNewRegNCG (registerRep register2)
-    	    	        	    `thenUs` \ tmp ->
+    let 
+        pk__2   = registerRep register2 
+        sz__2   = primRepToSize pk__2
+    in
+    getNewRegNCG pk__2                      `thenUs` \ tmp ->
     let
     	sz     	= primRepToSize pk
     	dst__2 	= registerName register1 g0    -- must be Fixed
  
+
     	reg__2 	= if pk /= pk__2 then tmp else dst__2
  
     	code   	= registerCode register2 reg__2
+
     	src__2 	= registerName register2 reg__2
-    	pk__2  	= registerRep register2
-    	sz__2  	= primRepToSize pk__2
 
-	code__2 = if pk /= pk__2 then
+	code__2 = 
+	        if pk /= pk__2 then
 		     code . mkSeqInstr (FxTOy sz__2 sz src__2 dst__2)
     	    	else if isFixed register2 then
 		     code . mkSeqInstr (FMOV sz src__2 dst__2)
@@ -1853,7 +1942,7 @@ genJump :: StixTree{-the branch target-} -> UniqSM InstrBlock
 
 genJump (StCLbl lbl)
   | isAsmTemp lbl = returnInstr (BR target)
-  | otherwise     = returnInstrs [LDA pv (AddrImm target), JMP zero (AddrReg pv) 0]
+  | otherwise     = returnInstrs [LDA pv (AddrImm target), JMP zeroh (AddrReg pv) 0]
   where
     target = ImmCLbl lbl
 
@@ -1866,9 +1955,9 @@ genJump tree
     	target = registerName register pv
     in
     if isFixed register then
-	returnSeq code [OR dst (RIReg dst) pv, JMP zero (AddrReg pv) 0]
+	returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
     else
-    returnUs (code . mkSeqInstr (JMP zero (AddrReg pv) 0))
+    returnUs (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1973,30 +2062,30 @@ genCondJump lbl (StPrim op [x, StInt 0])
     in
     returnSeq code [BI (cmpOp op) value target]
   where
-    cmpOp CharGtOp = GT
+    cmpOp CharGtOp = GTT
     cmpOp CharGeOp = GE
-    cmpOp CharEqOp = EQ
+    cmpOp CharEqOp = EQQ
     cmpOp CharNeOp = NE
-    cmpOp CharLtOp = LT
+    cmpOp CharLtOp = LTT
     cmpOp CharLeOp = LE
-    cmpOp IntGtOp = GT
+    cmpOp IntGtOp = GTT
     cmpOp IntGeOp = GE
-    cmpOp IntEqOp = EQ
+    cmpOp IntEqOp = EQQ
     cmpOp IntNeOp = NE
-    cmpOp IntLtOp = LT
+    cmpOp IntLtOp = LTT
     cmpOp IntLeOp = LE
     cmpOp WordGtOp = NE
     cmpOp WordGeOp = ALWAYS
-    cmpOp WordEqOp = EQ
+    cmpOp WordEqOp = EQQ
     cmpOp WordNeOp = NE
     cmpOp WordLtOp = NEVER
-    cmpOp WordLeOp = EQ
+    cmpOp WordLeOp = EQQ
     cmpOp AddrGtOp = NE
     cmpOp AddrGeOp = ALWAYS
-    cmpOp AddrEqOp = EQ
+    cmpOp AddrEqOp = EQQ
     cmpOp AddrNeOp = NE
     cmpOp AddrLtOp = NEVER
-    cmpOp AddrLeOp = EQ
+    cmpOp AddrLeOp = EQQ
 
 genCondJump lbl (StPrim op [x, StDouble 0.0])
   = getRegister x	  	    	    `thenUs` \ register ->
@@ -2010,17 +2099,17 @@ genCondJump lbl (StPrim op [x, StDouble 0.0])
     in
     returnUs (code . mkSeqInstr (BF (cmpOp op) value target))
   where
-    cmpOp FloatGtOp = GT
+    cmpOp FloatGtOp = GTT
     cmpOp FloatGeOp = GE
-    cmpOp FloatEqOp = EQ
+    cmpOp FloatEqOp = EQQ
     cmpOp FloatNeOp = NE
-    cmpOp FloatLtOp = LT
+    cmpOp FloatLtOp = LTT
     cmpOp FloatLeOp = LE
-    cmpOp DoubleGtOp = GT
+    cmpOp DoubleGtOp = GTT
     cmpOp DoubleGeOp = GE
-    cmpOp DoubleEqOp = EQ
+    cmpOp DoubleEqOp = EQQ
     cmpOp DoubleNeOp = NE
-    cmpOp DoubleLtOp = LT
+    cmpOp DoubleLtOp = LTT
     cmpOp DoubleLeOp = LE
 
 genCondJump lbl (StPrim op [x, y])
@@ -2051,17 +2140,17 @@ genCondJump lbl (StPrim op [x, y])
 	DoubleLeOp -> True
 	_ -> False
     (instr, cond) = case op of
-	FloatGtOp -> (FCMP TF LE, EQ)
-	FloatGeOp -> (FCMP TF LT, EQ)
-	FloatEqOp -> (FCMP TF EQ, NE)
-	FloatNeOp -> (FCMP TF EQ, EQ)
-	FloatLtOp -> (FCMP TF LT, NE)
+	FloatGtOp -> (FCMP TF LE, EQQ)
+	FloatGeOp -> (FCMP TF LTT, EQQ)
+	FloatEqOp -> (FCMP TF EQQ, NE)
+	FloatNeOp -> (FCMP TF EQQ, EQQ)
+	FloatLtOp -> (FCMP TF LTT, NE)
 	FloatLeOp -> (FCMP TF LE, NE)
-	DoubleGtOp -> (FCMP TF LE, EQ)
-	DoubleGeOp -> (FCMP TF LT, EQ)
-	DoubleEqOp -> (FCMP TF EQ, NE)
-	DoubleNeOp -> (FCMP TF EQ, EQ)
-	DoubleLtOp -> (FCMP TF LT, NE)
+	DoubleGtOp -> (FCMP TF LE, EQQ)
+	DoubleGeOp -> (FCMP TF LTT, EQQ)
+	DoubleEqOp -> (FCMP TF EQQ, NE)
+	DoubleNeOp -> (FCMP TF EQQ, EQQ)
+	DoubleLtOp -> (FCMP TF LTT, NE)
 	DoubleLeOp -> (FCMP TF LE, NE)
 
 genCondJump lbl (StPrim op [x, y])
@@ -2075,28 +2164,28 @@ genCondJump lbl (StPrim op [x, y])
     returnUs (code . mkSeqInstr (BI cond result target))
   where
     (instr, cond) = case op of
-	CharGtOp -> (CMP LE, EQ)
-	CharGeOp -> (CMP LT, EQ)
-	CharEqOp -> (CMP EQ, NE)
-	CharNeOp -> (CMP EQ, EQ)
-	CharLtOp -> (CMP LT, NE)
+	CharGtOp -> (CMP LE, EQQ)
+	CharGeOp -> (CMP LTT, EQQ)
+	CharEqOp -> (CMP EQQ, NE)
+	CharNeOp -> (CMP EQQ, EQQ)
+	CharLtOp -> (CMP LTT, NE)
 	CharLeOp -> (CMP LE, NE)
-	IntGtOp -> (CMP LE, EQ)
-	IntGeOp -> (CMP LT, EQ)
-	IntEqOp -> (CMP EQ, NE)
-	IntNeOp -> (CMP EQ, EQ)
-	IntLtOp -> (CMP LT, NE)
+	IntGtOp -> (CMP LE, EQQ)
+	IntGeOp -> (CMP LTT, EQQ)
+	IntEqOp -> (CMP EQQ, NE)
+	IntNeOp -> (CMP EQQ, EQQ)
+	IntLtOp -> (CMP LTT, NE)
 	IntLeOp -> (CMP LE, NE)
-	WordGtOp -> (CMP ULE, EQ)
-	WordGeOp -> (CMP ULT, EQ)
-	WordEqOp -> (CMP EQ, NE)
-	WordNeOp -> (CMP EQ, EQ)
+	WordGtOp -> (CMP ULE, EQQ)
+	WordGeOp -> (CMP ULT, EQQ)
+	WordEqOp -> (CMP EQQ, NE)
+	WordNeOp -> (CMP EQQ, EQQ)
 	WordLtOp -> (CMP ULT, NE)
 	WordLeOp -> (CMP ULE, NE)
-	AddrGtOp -> (CMP ULE, EQ)
-	AddrGeOp -> (CMP ULT, EQ)
-	AddrEqOp -> (CMP EQ, NE)
-	AddrNeOp -> (CMP EQ, EQ)
+	AddrGtOp -> (CMP ULE, EQQ)
+	AddrGeOp -> (CMP ULT, EQQ)
+	AddrEqOp -> (CMP EQQ, NE)
+	AddrNeOp -> (CMP EQQ, EQQ)
 	AddrLtOp -> (CMP ULT, NE)
 	AddrLeOp -> (CMP ULE, NE)
 
@@ -2164,7 +2253,7 @@ genCCall fn kind args
     	code = asmParThen (map ($ asmVoid) argCode)
     in
     	returnSeq code [
-    	    LDA pv (AddrImm (ImmLab (uppPStr fn))),
+    	    LDA pv (AddrImm (ImmLab (ptext fn))),
     	    JSR ra (AddrReg pv) nRegs,
     	    LDGP gp (AddrReg ra)]
   where
@@ -2226,40 +2315,55 @@ genCCall fn kind args
 
 genCCall fn kind [StInt i]
   | fn == SLIT ("PerformGC_wrapper")
+  = let
+     call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
+	     CALL (ImmLit (ptext (if underscorePrefix then (SLIT ("_PerformGC_wrapper")) else (SLIT ("PerformGC_wrapper")))))]
+    in
+    returnInstrs call
+
+{- OLD:
   = getUniqLabelNCG    	    	    `thenUs` \ lbl ->
     let
 	call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
 		MOV L (OpImm (ImmCLbl lbl))
 		      -- this is hardwired
-		      (OpAddr (Addr (Just ebx) Nothing (ImmInt 104))),
-		JMP (OpImm (ImmLit (uppPStr (SLIT ("_PerformGC_wrapper"))))),
+		      (OpAddr (Address (Just ebx) Nothing (ImmInt 104))),
+		JMP (OpImm (ImmLit (ptext (if underscorePrefix then (SLIT ("_PerformGC_wrapper")) else (SLIT ("PerformGC_wrapper")))))),
 		LABEL lbl]
     in
     returnInstrs call
+-}
 
 genCCall fn kind args
   = mapUs get_call_arg args `thenUs` \ argCode ->
     let
 	nargs = length args
-	code1 = asmParThen [asmSeq [ -- MOV L (OpReg esp) (OpAddr (Addr (Just ebx) Nothing (ImmInt 80))),
-			MOV L (OpAddr (Addr (Just ebx) Nothing (ImmInt 100))) (OpReg esp)
+{- OLD: Since there's no attempt at stealing %esp at the moment, 
+   restoring %esp from MainRegTable.rCstkptr is not done.  -- SOF 97/09
+   (ditto for saving away old-esp in MainRegTable.Hp (!!) )
+	code1 = asmParThen [asmSeq [ -- MOV L (OpReg esp) (OpAddr (Address (Just ebx) Nothing (ImmInt 80))),
+			MOV L (OpAddr (Address (Just ebx) Nothing (ImmInt 100))) (OpReg esp)
 				   ]
 			   ]
+-}
 	code2 = asmParThen (map ($ asmVoid) (reverse argCode))
-	call = [CALL fn__2 -- ,
-		-- ADD L (OpImm (ImmInt (nargs * 4))) (OpReg esp),
-		-- MOV L (OpAddr (Addr (Just ebx) Nothing (ImmInt 80))) (OpReg esp)
+	call = [CALL fn__2 ,
+		-- pop args; all args word sized?
+		ADD L (OpImm (ImmInt (nargs * 4))) (OpReg esp) --,
+		
+		-- Don't restore %esp (see above)
+		-- MOV L (OpAddr (Address (Just ebx) Nothing (ImmInt 80))) (OpReg esp)
 		]
     in
-    returnSeq (code1 . code2) call
+    returnSeq (code2) call
   where
     -- function names that begin with '.' are assumed to be special
     -- internally generated names like '.mul,' which don't get an
     -- underscore prefix
     -- ToDo:needed (WDP 96/03) ???
     fn__2 = case (_HEAD_ fn) of
-	      '.' -> ImmLit (uppPStr fn)
-	      _   -> ImmLab (uppPStr fn)
+	      '.' -> ImmLit (ptext fn)
+	      _   -> ImmLab (ptext fn)
 
     ------------
     get_call_arg :: StixTree{-current argument-} -> UniqSM InstrBlock	-- code
@@ -2316,8 +2420,8 @@ genCCall fn kind args
     -- underscore prefix
     -- ToDo:needed (WDP 96/03) ???
     fn__2 = case (_HEAD_ fn) of
-	      '.' -> ImmLit (uppPStr fn)
-	      _   -> ImmLab (uppPStr fn)
+	      '.' -> ImmLit (ptext fn)
+	      _   -> ImmLab (ptext fn)
 
     ------------------------------------
     {-  Try to get a value into a specific register (or registers) for
@@ -2453,7 +2557,7 @@ condFltReg cond x y
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
-condIntReg EQ x (StInt 0)
+condIntReg EQQ x (StInt 0)
   = getRegister x		`thenUs` \ register ->
     getNewRegNCG IntRep		`thenUs` \ tmp ->
     let
@@ -2465,7 +2569,7 @@ condIntReg EQ x (StInt 0)
     in
     returnUs (Any IntRep code__2)
 
-condIntReg EQ x y
+condIntReg EQQ x y
   = getRegister x		`thenUs` \ register1 ->
     getRegister y		`thenUs` \ register2 ->
     getNewRegNCG IntRep		`thenUs` \ tmp1 ->
@@ -2681,7 +2785,7 @@ trivialCode instr x y
   = getRegister x		`thenUs` \ register1 ->
     --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     let
-    	fixedname  = registerName register1 eax
+--    	fixedname  = registerName register1 eax
     	code__2 dst = let code1 = registerCode register1 dst
     	                  src1  = registerName register1 dst
 		      in code1 .
@@ -2701,7 +2805,7 @@ trivialCode instr x y
   = getRegister y		`thenUs` \ register1 ->
     --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     let
-    	fixedname  = registerName register1 eax
+--    	fixedname  = registerName register1 eax
     	code__2 dst = let code1 = registerCode register1 dst
 			  src1  = registerName register1 dst
 		      in code1 .
@@ -2721,7 +2825,7 @@ trivialCode instr x (StInd pk mem)
     --getNewRegNCG IntRep	`thenUs` \ tmp ->
     getAmode mem		`thenUs` \ amode ->
     let
-    	fixedname  = registerName register eax
+--    	fixedname  = registerName register eax
     	code2 = amodeCode amode asmVoid
     	src2  = amodeAddr amode
     	code__2 dst = let code1 = registerCode register dst asmVoid
@@ -2740,7 +2844,7 @@ trivialCode instr (StInd pk mem) y
     --getNewRegNCG IntRep	`thenUs` \ tmp ->
     getAmode mem		`thenUs` \ amode ->
     let
-    	fixedname  = registerName register eax
+--    	fixedname  = registerName register eax
     	code2 = amodeCode amode asmVoid
     	src2  = amodeAddr amode
     	code__2 dst = let
@@ -2761,7 +2865,7 @@ trivialCode instr x y
     --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     getNewRegNCG IntRep		`thenUs` \ tmp2 ->
     let
-    	fixedname  = registerName register1 eax
+--    	fixedname  = registerName register1 eax
     	code2 = registerCode register2 tmp2 asmVoid
     	src2  = registerName register2 tmp2
     	code__2 dst = let
@@ -3045,8 +3149,8 @@ coerceInt2FP pk x
 
     	code__2 dst = code . mkSeqInstrs [
 	-- to fix: should spill instead of using R1
-    	              MOV L (OpReg src) (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))),
-    	              FILD (primRepToSize pk) (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)) dst]
+    	              MOV L (OpReg src) (OpAddr (Address (Just ebx) Nothing (ImmInt OFFSET_R1))),
+    	              FILD (primRepToSize pk) (Address (Just ebx) Nothing (ImmInt OFFSET_R1)) dst]
     in
     returnUs (Any pk code__2)
 
@@ -3062,8 +3166,8 @@ coerceFP2Int x
     	code__2 dst = let
 		      in code . mkSeqInstrs [
     	                        FRNDINT,
-    	                        FIST L (Addr (Just ebx) Nothing (ImmInt OFFSET_R1)),
-    	                        MOV L (OpAddr (Addr (Just ebx) Nothing (ImmInt OFFSET_R1))) (OpReg dst)]
+    	                        FIST L (Address (Just ebx) Nothing (ImmInt OFFSET_R1)),
+    	                        MOV L (OpAddr (Address (Just ebx) Nothing (ImmInt OFFSET_R1))) (OpReg dst)]
     in
     returnUs (Any IntRep code__2)
 
@@ -3137,7 +3241,7 @@ chrCode x
   = getRegister x		`thenUs` \ register ->
     --getNewRegNCG IntRep	`thenUs` \ reg ->
     let
-    	fixedname = registerName register eax
+--    	fixedname = registerName register eax
     	code__2 dst = let
     	                  code = registerCode register dst
     	                  src  = registerName register dst
@@ -3246,3 +3350,4 @@ absIntCode x
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
+