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         gmpCompareInt,
   9         gmpInteger2Int,
  10         gmpInteger2Word,
  11         gmpNegate
  12         ) where
  13
  14 #include "HsVersions.h"
  15
  16 import {-# SOURCE #-} StixPrim ( amodeToStix )
  17 import MachMisc
  18 import MachRegs
  19
  20 import AbsCSyn          hiding (spRel) -- bits and bobs..
  21 import Const            ( Literal(..) )
  22 import CallConv         ( cCallConv )
  23 import PrimOp           ( PrimOp(..) )
  24 import PrimRep          ( PrimRep(..) )
  25 import SMRep            ( arrWordsHdrSize )
  26 import Stix             ( sStLitLbl, StixTree(..), StixTreeList, arrWordsHS )
  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 stgArrWords__words        :: StixTree -> StixTree
  37 stgArrWords__BYTE_ARR_CTS :: StixTree -> StixTree
  38
  39 stgArrWords__BYTE_ARR_CTS arr
  40    = StIndex WordRep arr arrWordsHS
  41 stgArrWords__words        arr
  42    = case arrWordsHS of
  43         StInt i -> StInd WordRep (StIndex PtrRep arr (StInt (i-1)))
  44
  45 gmpCompare
  46     :: CAddrMode            -- result (boolean)
  47     -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode)
  48                             -- alloc hp + 2 arguments (2 parts each)
  49     -> UniqSM StixTreeList
  50
  51 gmpCompare res args@(csa1,cda1, csa2,cda2)
  52   = let
  53         result  = amodeToStix res
  54         sa1     = amodeToStix csa1
  55         sa2     = amodeToStix csa2
  56         aa1     = stgArrWords__words (amodeToStix cda1)
  57         aa2     = stgArrWords__words (amodeToStix cda2)
  58         da1     = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
  59         da2     = stgArrWords__BYTE_ARR_CTS (amodeToStix cda2)
  60
  61         (a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
  62         (a4,a5,a6) = toStruct scratch2 (aa2,sa2,da2)
  63         mpz_cmp = StCall SLIT("mpz_cmp") cCallConv IntRep [scratch1, scratch2]
  64         r1 = StAssign IntRep result mpz_cmp
  65     in
  66     returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
  67
  68
  69 gmpCompareInt
  70     :: CAddrMode            -- result (boolean)
  71     -> (CAddrMode,CAddrMode,CAddrMode)
  72     -> UniqSM StixTreeList  -- alloc hp + 1 arg (??)
  73
  74 gmpCompareInt res args@(csa1,cda1, cai)
  75   = let
  76         result   = amodeToStix res
  77         sa1      = amodeToStix csa1
  78         aa1      = stgArrWords__words (amodeToStix cda1)
  79         da1      = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
  80         ai       = amodeToStix cai
  81         (a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
  82         mpz_cmp_si = StCall SLIT("mpz_cmp_si") cCallConv IntRep [scratch1, ai]
  83         r1 = StAssign IntRep result mpz_cmp_si
  84     in
  85     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
  86 \end{code}
  87
  88 \begin{code}
  89 gmpInteger2Int
  90     :: CAddrMode            -- result
  91     -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
  92     -> UniqSM StixTreeList
  93
  94 gmpInteger2Int res args@(csa,cda)
  95   = let
  96         result  = amodeToStix res
  97         sa      = amodeToStix csa
  98         aa      = stgArrWords__words (amodeToStix cda)
  99         da      = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
 100
 101         (a1,a2,a3) = toStruct scratch1 (aa,sa,da)
 102         mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch1]
 103         r1 = StAssign IntRep result mpz_get_si
 104     in
 105     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 106
 107 gmpInteger2Word
 108     :: CAddrMode            -- result
 109     -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
 110     -> UniqSM StixTreeList
 111
 112 gmpInteger2Word res args@(csa,cda)
 113   = let
 114         result  = amodeToStix res
 115         sa      = amodeToStix csa
 116         aa      = stgArrWords__words (amodeToStix cda)
 117         da      = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
 118
 119         (a1,a2,a3) = toStruct scratch1 (aa,sa,da)
 120         mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch1]
 121         r1 = StAssign WordRep result mpz_get_ui
 122     in
 123     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 124
 125 gmpNegate
 126     :: (CAddrMode,CAddrMode) -- result
 127     -> (CAddrMode,CAddrMode) -- argument (2 parts)
 128     -> UniqSM StixTreeList
 129
 130 gmpNegate (rcs, rcd) args@(cs, cd)
 131   = let
 132         s       = amodeToStix cs
 133         a       = stgArrWords__words (amodeToStix cd)
 134         d       = stgArrWords__BYTE_ARR_CTS (amodeToStix cd)
 135         rs      = amodeToStix rcs
 136         ra      = stgArrWords__words (amodeToStix rcd)
 137         rd      = stgArrWords__BYTE_ARR_CTS (amodeToStix rcd)
 138         a1      = StAssign IntRep ra a
 139         a2      = StAssign IntRep rs (StPrim IntNegOp [s])
 140         a3      = StAssign PtrRep rd d
 141     in
 142     returnUs (\xs -> a1 : a2 : a3 : xs)
 143 \end{code}
 144
 145 Support for the Gnu GMP multi-precision package.
 146
 147 \begin{code}
 148 -- size (in words) of __MP_INT
 149 mpIntSize = 3 :: Int
 150
 151 mpAlloc, mpSize, mpData :: StixTree -> StixTree
 152 mpAlloc base = StInd IntRep base
 153 mpSize base = StInd IntRep (StIndex IntRep base (StInt 1))
 154 mpData base = StInd PtrRep (StIndex IntRep base (StInt 2))
 155 \end{code}
 156
 157 \begin{code}
 158 toStruct
 159     :: StixTree
 160     -> (StixTree, StixTree, StixTree)
 161     -> (StixTree, StixTree, StixTree)
 162
 163 toStruct str (alloc,size,arr)
 164   = let
 165         f1 = StAssign IntRep (mpAlloc str) alloc
 166         f2 = StAssign IntRep (mpSize str) size
 167         f3 = StAssign PtrRep (mpData str) arr
 168     in
 169     (f1, f2, f3)
 170
 171 scratch1 = StScratchWord 0
 172 scratch2 = StScratchWord mpIntSize
 173 \end{code}
 174