[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.

1 files changed, 60 insertions, 33 deletions

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}