ghc/compiler/nativeGen/StixInteger.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module StixInteger (
   7         gmpCompare,
   8         gmpInteger2Int,
   9         gmpInteger2Word,
  10         gmpNegate
  11         ) where
  12
  13 #include "HsVersions.h"
  14
  15 import {-# SOURCE #-} StixPrim ( amodeToStix )
  16 import MachMisc
  17 import MachRegs
  18
  19 import AbsCSyn          hiding (spRel) -- bits and bobs..
  20 import Const            ( Literal(..) )
  21 import CallConv         ( cCallConv )
  22 import OrdList          ( OrdList )
  23 import PrimOp           ( PrimOp(..) )
  24 import PrimRep          ( PrimRep(..) )
  25 import SMRep            ( arrHdrSize )
  26 import Stix             ( sStLitLbl, StixTree(..), StixTreeList )
  27 import UniqSupply       ( returnUs, thenUs, UniqSM )
  28 \end{code}
  29
  30 Although gmpCompare doesn't allocate space, it does temporarily use
  31 some space just beyond the heap pointer.  This is safe, because the
  32 enclosing routine has already guaranteed that this space will be
  33 available.  (See ``primOpHeapRequired.'')
  34
  35 \begin{code}
  36 gmpCompare
  37     :: CAddrMode            -- result (boolean)
  38     -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
  39                             -- alloc hp + 2 arguments (3 parts each)
  40     -> UniqSM StixTreeList
  41
  42 gmpCompare res args@(caa1,csa1,cda1, caa2,csa2,cda2)
  43   = let
  44         result  = amodeToStix res
  45         scratch1 = scratch_space
  46         scratch2 = StIndex IntRep scratch_space (StInt (toInteger mpIntSize))
  47         aa1     = amodeToStix caa1
  48         sa1     = amodeToStix csa1
  49         da1     = amodeToStix cda1
  50         aa2     = amodeToStix caa2
  51         sa2     = amodeToStix csa2
  52         da2     = amodeToStix cda2
  53
  54         (a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
  55         (a4,a5,a6) = toStruct scratch2 (aa2,sa2,da2)
  56         mpz_cmp = StCall SLIT("mpz_cmp") cCallConv IntRep [scratch1, scratch2]
  57         r1 = StAssign IntRep result mpz_cmp
  58     in
  59     returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
  60 \end{code}
  61
  62 \begin{code}
  63 gmpInteger2Int
  64     :: CAddrMode            -- result
  65     -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
  66     -> UniqSM StixTreeList
  67
  68 gmpInteger2Int res args@(caa,csa,cda)
  69   = let
  70         result  = amodeToStix res
  71         aa      = amodeToStix caa
  72         sa      = amodeToStix csa
  73         da      = amodeToStix cda
  74
  75         (a1,a2,a3) = toStruct scratch_space (aa,sa,da)
  76         mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch_space]
  77         r1 = StAssign IntRep result mpz_get_si
  78     in
  79     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
  80
  81 gmpInteger2Word
  82     :: CAddrMode            -- result
  83     -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
  84     -> UniqSM StixTreeList
  85
  86 gmpInteger2Word res args@(caa,csa,cda)
  87   = let
  88         result  = amodeToStix res
  89         aa      = amodeToStix caa
  90         sa      = amodeToStix csa
  91         da      = amodeToStix cda
  92
  93         (a1,a2,a3) = toStruct scratch_space (aa,sa,da)
  94         mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch_space]
  95         r1 = StAssign WordRep result mpz_get_ui
  96     in
  97     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
  98
  99 gmpNegate
 100     :: (CAddrMode,CAddrMode,CAddrMode) -- result
 101     -> (CAddrMode,CAddrMode,CAddrMode) -- argument (3 parts)
 102     -> UniqSM StixTreeList
 103
 104 gmpNegate (rca, rcs, rcd) args@(ca, cs, cd)
 105   = let
 106         a       = amodeToStix ca
 107         s       = amodeToStix cs
 108         d       = amodeToStix cd
 109         ra      = amodeToStix rca
 110         rs      = amodeToStix rcs
 111         rd      = amodeToStix rcd
 112         a1      = StAssign IntRep ra a
 113         a2      = StAssign IntRep rs (StPrim IntNegOp [s])
 114         a3      = StAssign PtrRep rd d
 115     in
 116     returnUs (\xs -> a1 : a2 : a3 : xs)
 117 \end{code}
 118
 119 Support for the Gnu GMP multi-precision package.
 120
 121 \begin{code}
 122 -- size (in words) of __MP_INT
 123 mpIntSize = 3 :: Int
 124
 125 mpAlloc, mpSize, mpData :: StixTree -> StixTree
 126 mpAlloc base = StInd IntRep base
 127 mpSize base = StInd IntRep (StIndex IntRep base (StInt 1))
 128 mpData base = StInd PtrRep (StIndex IntRep base (StInt 2))
 129 \end{code}
 130
 131 \begin{code}
 132 toStruct
 133     :: StixTree
 134     -> (StixTree, StixTree, StixTree)
 135     -> (StixTree, StixTree, StixTree)
 136
 137 toStruct str (alloc,size,arr)
 138   = let
 139         f1 = StAssign IntRep (mpAlloc str) alloc
 140         f2 = StAssign IntRep (mpSize str) size
 141         f3 = StAssign PtrRep (mpData str)
 142                 (StIndex PtrRep arr (StInt (toInteger arrHdrSize)))
 143     in
 144     (f1, f2, f3)
 145
 146 scratch_space = sStLitLbl SLIT("stg_scratch_space")
 147 \end{code}
 148