X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachCode.lhs;h=cbfe9dc3448ddd9e960a8fb09e2e42b60cbd0ecc;hb=960223bfc3fd1c2ac4608b837fb83f3bc6b5fd16;hp=25d9be3f15ad9d9279aac8669b58edf6240325f0;hpb=7d61cb61daa5e433a0cb85b34b7f0c58b2f961ff;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs
index 25d9be3..cbfe9dc 100644
--- a/ghc/compiler/nativeGen/MachCode.lhs
+++ b/ghc/compiler/nativeGen/MachCode.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The AQUA Project, Glasgow University, 1996
+% (c) The AQUA Project, Glasgow University, 1996-1998
 %
 \section[MachCode]{Generating machine code}
 
@@ -9,32 +9,30 @@ This is a big module, but, if you pay attention to
 structure should not be too overwhelming.
 
 \begin{code}
+module MachCode ( stmt2Instrs, asmVoid, InstrList ) where
+
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
-module MachCode ( stmt2Instrs, asmVoid, InstrList(..) ) where
-
-import Ubiq{-uitious-}
-
 import MachMisc		-- may differ per-platform
 import MachRegs
 
 import AbsCSyn		( MagicId )
 import AbsCUtils	( magicIdPrimRep )
-import CLabel		( isAsmTemp )
+import CallConv		( CallConv )
+import CLabel		( isAsmTemp, CLabel )
 import Maybes		( maybeToBool, expectJust )
 import OrdList		-- quite a bit of it
-import Pretty		( prettyToUn, ppRational )
 import PrimRep		( isFloatingRep, PrimRep(..) )
 import PrimOp		( PrimOp(..) )
+import CallConv		( cCallConv )
 import Stix		( getUniqLabelNCG, StixTree(..),
 			  StixReg(..), CodeSegment(..)
 			)
 import UniqSupply	( returnUs, thenUs, mapUs, mapAndUnzipUs,
-			  mapAccumLUs, UniqSM(..)
+			  mapAccumLUs, UniqSM
 			)
-import Unpretty		( uppPStr )
-import Util		( panic, assertPanic )
+import Outputable
 \end{code}
 
 Code extractor for an entire stix tree---stix statement level.
@@ -51,7 +49,7 @@ stmt2Instrs stmt = case stmt of
 
     StJump arg		   -> genJump arg
     StCondJump lab arg	   -> genCondJump lab arg
-    StCall fn VoidRep args -> genCCall fn VoidRep args
+    StCall fn cconv VoidRep args -> genCCall fn cconv VoidRep args
 
     StAssign pk dst src
       | isFloatingRep pk -> assignFltCode pk dst src
@@ -80,6 +78,9 @@ stmt2Instrs stmt = case stmt of
 	    returnUs (mkSeqInstrs [LABEL lbl,
 				   ASCII True (_UNPK_ s)],
 				   ImmCLbl lbl)
+	-- the linker can handle simple arithmetic...
+	getData (StIndex rep (StCLbl lbl) (StInt off)) =
+		returnUs (id, ImmIndex lbl (fromInteger (off * sizeOf rep)))
 \end{code}
 
 %************************************************************************
@@ -128,6 +129,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 +141,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}
@@ -150,6 +161,9 @@ maybeImm (StLitLbl s) = Just (ImmLab s)
 maybeImm (StLitLit s) = Just (strImmLit (cvtLitLit (_UNPK_ s)))
 maybeImm (StCLbl   l) = Just (ImmCLbl l)
 
+maybeImm (StIndex rep (StCLbl l) (StInt off)) = 
+	Just (ImmIndex l (fromInteger (off * sizeOf rep)))
+
 maybeImm (StInt i)
   | i >= toInteger minInt && i <= toInteger maxInt
   = Just (ImmInt (fromInteger i))
@@ -206,8 +220,8 @@ getRegister (StReg (StixTemp u pk))
 
 getRegister tree@(StIndex _ _ _) = getRegister (mangleIndexTree tree)
 
-getRegister (StCall fn kind args)
-  = genCCall fn kind args   	    `thenUs` \ call ->
+getRegister (StCall fn cconv kind args)
+  = genCCall fn cconv kind args   	    `thenUs` \ call ->
     returnUs (Fixed kind reg call)
   where
     reg = if isFloatingRep kind
@@ -274,7 +288,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)]
@@ -302,7 +316,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
       Double2FloatOp -> coerceFltCode x
       Float2DoubleOp -> coerceFltCode x
 
-      other_op -> getRegister (StCall fn DoubleRep [x])
+      other_op -> getRegister (StCall fn cCallConv DoubleRep [x])
 	where
 	  fn = case other_op of
 		 FloatExpOp    -> SLIT("exp")
@@ -334,46 +348,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 +396,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,16 +411,16 @@ 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
 
-      ISllOp -> panic "AlphaGen:isll"
-      ISraOp -> panic "AlphaGen:isra"
-      ISrlOp -> panic "AlphaGen:isrl"
+      ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
+      ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
+      ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
 
-      FloatPowerOp  -> getRegister (StCall SLIT("pow") DoubleRep [x,y])
-      DoublePowerOp -> getRegister (StCall SLIT("pow") DoubleRep [x,y])
+      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
+      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x,y])
   where
     {- ------------------------------------------------------------
 	Some bizarre special code for getting condition codes into
@@ -416,7 +433,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 +460,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 +483,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
@@ -491,8 +508,6 @@ getRegister leaf
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-getRegister (StReg (StixTemp u pk)) = returnUs (Fixed pk (UnmappedReg u pk) id)
-
 getRegister (StDouble 0.0)
   = let
     	code dst = mkSeqInstrs [FLDZ]
@@ -548,7 +563,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 			  then StPrim Float2DoubleOp [x]
 			  else x
 	in
-	getRegister (StCall fn DoubleRep [x])
+	getRegister (StCall fn cCallConv DoubleRep [x])
        where
 	(is_float_op, fn)
 	  = case primop of
@@ -584,46 +599,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,18 +667,83 @@ 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-}
+      SrlOp -> shift_code (SHR L) x y {-False-}
 
-      ISllOp -> panic "I386Gen:isll"
-      ISraOp -> panic "I386Gen:isra"
-      ISrlOp -> panic "I386Gen:isrl"
+      ISllOp -> shift_code (SHL L) x y {-False-}  --was:panic "I386Gen:isll"
+      ISraOp -> shift_code (SAR L) x y {-False-}  --was:panic "I386Gen:isra"
+      ISrlOp -> shift_code (SHR L) x y {-False-}  --was:panic "I386Gen:isrl"
 
-      FloatPowerOp  -> getRegister (StCall SLIT("pow") DoubleRep [promote x, promote y])
+      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
 		       where promote x = StPrim Float2DoubleOp [x]
-      DoublePowerOp -> getRegister (StCall SLIT("pow") DoubleRep [x, y])
+      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv 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,10 +754,10 @@ 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 (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
-
+{-
     add_code sz x (StInd _ mem)
       = getRegister x		`thenUs` \ register1 ->
 	--getNewRegNCG (registerRep register1)
@@ -687,7 +767,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code2 = amodeCode amode
 	    src2  = amodeAddr amode
 
-	    fixedname  = registerName register1 eax
 	    code__2 dst = let code1 = registerCode register1 dst
 			      src1  = registerName register1 dst
 			  in asmParThen [code2 asmVoid,code1 asmVoid] .
@@ -708,7 +787,6 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 	    code1 = amodeCode amode
 	    src1  = amodeAddr amode
 
-	    fixedname  = registerName register2 eax
 	    code__2 dst = let code2 = registerCode register2 dst
 			      src2  = registerName register2 dst
 			  in asmParThen [code1 asmVoid,code2 asmVoid] .
@@ -719,7 +797,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
 				    mkSeqInstrs [ADD sz (OpAddr src1) (OpReg src2)]
 	in
 	returnUs (Any IntRep code__2)
-
+-}
     add_code sz x y
       = getRegister x		`thenUs` \ register1 ->
 	getRegister y		`thenUs` \ register2 ->
@@ -731,7 +809,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 (AddrBaseIndex (Just src1) (Just (src2,1)) (ImmInt 0))) (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -746,7 +824,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 (AddrBaseIndex (Just src1) Nothing src2)) (OpReg dst))
 	in
 	returnUs (Any IntRep code__2)
 
@@ -789,10 +867,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 (AddrBaseIndex (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 (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)))]
 	in
 	returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
 
@@ -812,10 +890,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 (AddrBaseIndex (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 (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)))]
 	in
 	returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
 	-----------------------
@@ -872,10 +950,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
@@ -895,12 +973,13 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 			  then StPrim Float2DoubleOp [x]
 			  else x
 	in
-	getRegister (StCall fn DoubleRep [x])
+	getRegister (StCall fn cCallConv DoubleRep [x])
        where
 	(is_float_op, fn)
 	  = 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 +995,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 +1008,50 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 	      DoubleSinhOp  -> (False, SLIT("sinh"))
 	      DoubleCoshOp  -> (False, SLIT("cosh"))
 	      DoubleTanhOp  -> (False, SLIT("tanh"))
+	      _             -> panic ("Monadic PrimOp not handled: " ++ show 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,20 +1073,21 @@ 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
 
-      ISllOp -> panic "SparcGen:isll"
-      ISraOp -> panic "SparcGen:isra"
-      ISrlOp -> panic "SparcGen:isrl"
+      ISllOp -> trivialCode SLL x y  --was: panic "SparcGen:isll"
+      ISraOp -> trivialCode SRA x y  --was: panic "SparcGen:isra"
+      ISrlOp -> trivialCode SRL x y  --was: panic "SparcGen:isrl"
 
-      FloatPowerOp  -> getRegister (StCall SLIT("pow") DoubleRep [promote x, promote y])
+      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
 		       where promote x = StPrim Float2DoubleOp [x]
-      DoublePowerOp -> getRegister (StCall SLIT("pow") DoubleRep [x, y])
+      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x, y])
+--      _ -> panic "Prim op " ++ (showPrimOp primop) ++ " not handled!"
   where
-    imul_div fn x y = getRegister (StCall fn IntRep [x, y])
+    imul_div fn x y = getRegister (StCall fn cCallConv IntRep [x, y])
 
 getRegister (StInd pk mem)
   = getAmode mem    	    	    `thenUs` \ amode ->
@@ -1048,7 +1130,7 @@ getRegister leaf
 
 @Amode@s: Memory addressing modes passed up the tree.
 \begin{code}
-data Amode = Amode Addr InstrBlock
+data Amode = Amode MachRegsAddr InstrBlock
 
 amodeAddr (Amode addr _) = addr
 amodeCode (Amode _ code) = code
@@ -1112,7 +1194,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 (AddrBaseIndex (Just reg) Nothing off) code)
 
 getAmode (StPrim IntAddOp [x, StInt i])
   | maybeToBool imm
@@ -1132,7 +1214,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 (AddrBaseIndex (Just reg) Nothing off) code)
 
 getAmode (StPrim IntAddOp [x, y])
   = getNewRegNCG PtrRep		`thenUs` \ tmp1 ->
@@ -1146,7 +1228,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 (AddrBaseIndex (Just reg1) (Just (reg2,4)) (ImmInt 0)) code__2)
 
 getAmode leaf
   | maybeToBool imm
@@ -1166,7 +1248,7 @@ getAmode other
     	reg  = registerName register tmp
     	off  = Nothing
     in
-    returnUs (Amode (Addr (Just reg) Nothing (ImmInt 0)) code)
+    returnUs (Amode (AddrBaseIndex (Just reg) Nothing (ImmInt 0)) code)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1263,46 +1345,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 +1542,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 +1637,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 +1652,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 +1786,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 +1864,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 +1939,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 +1952,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 +2059,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 +2096,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 +2137,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 +2161,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)
 
@@ -2150,13 +2236,14 @@ register allocator.
 \begin{code}
 genCCall
     :: FAST_STRING	-- function to call
+    -> CallConv
     -> PrimRep		-- type of the result
     -> [StixTree]	-- arguments (of mixed type)
     -> UniqSM InstrBlock
 
 #if alpha_TARGET_ARCH
 
-genCCall fn kind args
+genCCall fn cconv kind args
   = mapAccumLUs get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
     	    	    	    	    `thenUs` \ ((unused,_), argCode) ->
     let
@@ -2164,7 +2251,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
@@ -2224,42 +2311,58 @@ genCCall fn kind args
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-genCCall fn kind [StInt i]
+genCCall fn cconv 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 (AddrBaseIndex (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
+genCCall fn cconv 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 (AddrBaseIndex (Just ebx) Nothing (ImmInt 80))),
+			MOV L (OpAddr (AddrBaseIndex (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 (AddrBaseIndex (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
@@ -2301,7 +2404,7 @@ genCCall fn kind args
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
-genCCall fn kind args
+genCCall fn cconv kind args
   = mapAccumLUs get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
     	    	    	    	    `thenUs` \ ((unused,_), argCode) ->
     let
@@ -2316,8 +2419,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 +2556,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 +2568,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 +2784,6 @@ trivialCode instr x y
   = getRegister x		`thenUs` \ register1 ->
     --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     let
-    	fixedname  = registerName register1 eax
     	code__2 dst = let code1 = registerCode register1 dst
     	                  src1  = registerName register1 dst
 		      in code1 .
@@ -2701,7 +2803,6 @@ trivialCode instr x y
   = getRegister y		`thenUs` \ register1 ->
     --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     let
-    	fixedname  = registerName register1 eax
     	code__2 dst = let code1 = registerCode register1 dst
 			  src1  = registerName register1 dst
 		      in code1 .
@@ -2715,13 +2816,12 @@ trivialCode instr x y
   where
     imm = maybeImm x
     imm__2 = case imm of Just x -> x
-
+{-
 trivialCode instr x (StInd pk mem)
   = getRegister x		`thenUs` \ register ->
     --getNewRegNCG IntRep	`thenUs` \ tmp ->
     getAmode mem		`thenUs` \ amode ->
     let
-    	fixedname  = registerName register eax
     	code2 = amodeCode amode asmVoid
     	src2  = amodeAddr amode
     	code__2 dst = let code1 = registerCode register dst asmVoid
@@ -2740,7 +2840,6 @@ trivialCode instr (StInd pk mem) y
     --getNewRegNCG IntRep	`thenUs` \ tmp ->
     getAmode mem		`thenUs` \ amode ->
     let
-    	fixedname  = registerName register eax
     	code2 = amodeCode amode asmVoid
     	src2  = amodeAddr amode
     	code__2 dst = let
@@ -2754,14 +2853,13 @@ trivialCode instr (StInd pk mem) y
 				mkSeqInstr (instr (OpAddr src2) (OpReg src1))
     in
     returnUs (Any pk code__2)
-
+-}
 trivialCode instr x y
   = getRegister x		`thenUs` \ register1 ->
     getRegister y		`thenUs` \ register2 ->
     --getNewRegNCG IntRep	`thenUs` \ tmp1 ->
     getNewRegNCG IntRep		`thenUs` \ tmp2 ->
     let
-    	fixedname  = registerName register1 eax
     	code2 = registerCode register2 tmp2 asmVoid
     	src2  = registerName register2 tmp2
     	code__2 dst = let
@@ -2781,7 +2879,6 @@ trivialUCode instr x
   = getRegister x		`thenUs` \ register ->
 --    getNewRegNCG IntRep	`thenUs` \ tmp ->
     let
---    	fixedname = registerName register eax
     	code__2 dst = let
     	                  code = registerCode register dst
 		      	  src  = registerName register dst
@@ -3045,8 +3142,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 (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1))),
+    	              FILD (primRepToSize pk) (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)) dst]
     in
     returnUs (Any pk code__2)
 
@@ -3059,11 +3156,10 @@ coerceFP2Int x
     	src  = registerName register tmp
     	pk   = registerRep register
 
-    	code__2 dst = let
-		      in code . mkSeqInstrs [
+    	code__2 dst = 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 (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1)),
+    	                        MOV L (OpAddr (AddrBaseIndex (Just ebx) Nothing (ImmInt OFFSET_R1))) (OpReg dst)]
     in
     returnUs (Any IntRep code__2)
 
@@ -3137,7 +3233,6 @@ chrCode x
   = getRegister x		`thenUs` \ register ->
     --getNewRegNCG IntRep	`thenUs` \ reg ->
     let
-    	fixedname = registerName register eax
     	code__2 dst = let
     	                  code = registerCode register dst
     	                  src  = registerName register dst
@@ -3246,3 +3341,4 @@ absIntCode x
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
+