[project @ 1998-08-14 11:44:17 by sof]

[ghc-hetmet.git] / ghc / compiler / nativeGen / StixInteger.lhs

diff --git a/ghc/compiler/nativeGen/StixInteger.lhs b/ghc/compiler/nativeGen/StixInteger.lhs
index 5c90139..23c6a07 100644 (file)
--- a/ghc/compiler/nativeGen/StixInteger.lhs
+++ b/ghc/compiler/nativeGen/StixInteger.lhs
@@ -3,33 +3,32 @@
 %
 
 \begin{code}
-#include "HsVersions.h"
-
 module StixInteger (
        gmpTake1Return1, gmpTake2Return1, gmpTake2Return2, gmpCompare,
-       gmpInteger2Int, gmpInt2Integer, gmpString2Integer,
+       gmpInteger2Int, gmpInteger2Word,
+       gmpInt2Integer, gmpString2Integer,
        encodeFloatingKind, decodeFloatingKind
     ) where
 
-IMP_Ubiq(){-uitous-}
-IMPORT_DELOOPER(NcgLoop)               ( amodeToStix )
+#include "HsVersions.h"
 
+import {-# SOURCE #-} StixPrim ( amodeToStix )
 import MachMisc
 import MachRegs
 
 import AbsCSyn         -- bits and bobs...
-import CgCompInfo      ( mIN_MP_INT_SIZE )
+import Constants       ( mIN_MP_INT_SIZE )
 import Literal         ( Literal(..) )
 import OrdList         ( OrdList )
 import PrimOp          ( PrimOp(..) )
 import PrimRep         ( PrimRep(..) )
 import SMRep           ( SMRep(..), SMSpecRepKind, SMUpdateKind )
 import Stix            ( getUniqLabelNCG, sStLitLbl, stgHp, stgHpLim,
-                         StixTree(..), StixTreeList(..),
+                         StixTree(..), StixTreeList,
                          CodeSegment, StixReg
                        )
 import StixMacro       ( macroCode, heapCheck )
-import UniqSupply      ( returnUs, thenUs, UniqSM(..) )
+import UniqSupply      ( returnUs, thenUs, UniqSM )
 import Util            ( panic )
 \end{code}
 
@@ -210,6 +209,25 @@ gmpInteger2Int res args@(chp, caa,csa,cda)
     in
     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 
+gmpInteger2Word
+    :: CAddrMode           -- result
+    -> (CAddrMode, CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
+    -> UniqSM StixTreeList
+
+gmpInteger2Word res args@(chp, caa,csa,cda)
+  = let
+       result  = amodeToStix res
+       hp      = amodeToStix chp
+       aa      = amodeToStix caa
+       sa      = amodeToStix csa
+       da      = amodeToStix cda
+
+       (a1,a2,a3) = toStruct hp (aa,sa,da)
+       mpz_get_ui = StCall SLIT("mpz_get_ui") IntRep [hp]
+       r1 = StAssign WordRep result mpz_get_ui
+    in
+    returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
+
 arrayOfData_info = sStLitLbl SLIT("ArrayOfData_info")
 
 --------------
@@ -371,6 +389,7 @@ mpData_mantissa = mpData mantissa
 Support for the Gnu GMP multi-precision package.
 
 \begin{code}
+-- size (in words) of __MP_INT
 mpIntSize = 3 :: Int
 
 mpAlloc, mpSize, mpData :: StixTree -> StixTree
@@ -388,6 +407,7 @@ mpSpace gmp res sizes
   = foldr sum (StPrim IntAddOp [fixed, hdrs]) sizes
   where
     sum x y = StPrim IntAddOp [StPrim IntAbsOp [x], y]
+    -- what's the magical 17 for?
     fixed = StInt (toInteger (17 * res + gmp * mpIntSize))
     hdrs = StPrim IntMulOp [dataHS, StInt (toInteger res)]
 \end{code}