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 OrdList          ( OrdList )
  24 import PrimOp           ( PrimOp(..) )
  25 import PrimRep          ( PrimRep(..) )
  26 import SMRep            ( arrWordsHdrSize )
  27 import Stix             ( sStLitLbl, StixTree(..), StixTreeList, arrWordsHS )
  28 import UniqSupply       ( returnUs, thenUs, UniqSM )
  29 \end{code}
  30
  31 Although gmpCompare doesn't allocate space, it does temporarily use
  32 some space just beyond the heap pointer.  This is safe, because the
  33 enclosing routine has already guaranteed that this space will be
  34 available.  (See ``primOpHeapRequired.'')
  35
  36 \begin{code}
  37 stgArrWords__words        :: StixTree -> StixTree
  38 stgArrWords__BYTE_ARR_CTS :: StixTree -> StixTree
  39
  40 stgArrWords__BYTE_ARR_CTS arr
  41    = StIndex WordRep arr arrWordsHS
  42 stgArrWords__words        arr
  43    = case arrWordsHS of
  44         StInt i -> StInd WordRep (StIndex PtrRep arr (StInt (i-1)))
  45
  46 gmpCompare
  47     :: CAddrMode            -- result (boolean)
  48     -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode)
  49                             -- alloc hp + 2 arguments (2 parts each)
  50     -> UniqSM StixTreeList
  51
  52 gmpCompare res args@(csa1,cda1, csa2,cda2)
  53   = let
  54         result  = amodeToStix res
  55         sa1     = amodeToStix csa1
  56         sa2     = amodeToStix csa2
  57         aa1     = stgArrWords__words (amodeToStix cda1)
  58         aa2     = stgArrWords__words (amodeToStix cda2)
  59         da1     = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
  60         da2     = stgArrWords__BYTE_ARR_CTS (amodeToStix cda2)
  61
  62         (a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
  63         (a4,a5,a6) = toStruct scratch2 (aa2,sa2,da2)
  64         mpz_cmp = StCall SLIT("mpz_cmp") cCallConv IntRep [scratch1, scratch2]
  65         r1 = StAssign IntRep result mpz_cmp
  66     in
  67     returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
  68
  69
  70 gmpCompareInt
  71     :: CAddrMode            -- result (boolean)
  72     -> (CAddrMode,CAddrMode,CAddrMode)
  73     -> UniqSM StixTreeList  -- alloc hp + 1 arg (??)
  74
  75 gmpCompareInt res args@(csa1,cda1, cai)
  76   = let
  77         result   = amodeToStix res
  78         sa1      = amodeToStix csa1
  79         aa1      = stgArrWords__words (amodeToStix cda1)
  80         da1      = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
  81         ai       = amodeToStix cai
  82         (a1,a2,a3) = toStruct scratch1 (aa1,sa1,da1)
  83         mpz_cmp_si = StCall SLIT("mpz_cmp_si") cCallConv IntRep [scratch1, ai]
  84         r1 = StAssign IntRep result mpz_cmp_si
  85     in
  86     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
  87 \end{code}
  88
  89 \begin{code}
  90 gmpInteger2Int
  91     :: CAddrMode            -- result
  92     -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
  93     -> UniqSM StixTreeList
  94
  95 gmpInteger2Int res args@(csa,cda)
  96   = let
  97         result  = amodeToStix res
  98         sa      = amodeToStix csa
  99         aa      = stgArrWords__words (amodeToStix cda)
 100         da      = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
 101
 102         (a1,a2,a3) = toStruct scratch1 (aa,sa,da)
 103         mpz_get_si = StCall SLIT("mpz_get_si") cCallConv IntRep [scratch1]
 104         r1 = StAssign IntRep result mpz_get_si
 105     in
 106     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 107
 108 gmpInteger2Word
 109     :: CAddrMode            -- result
 110     -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
 111     -> UniqSM StixTreeList
 112
 113 gmpInteger2Word res args@(csa,cda)
 114   = let
 115         result  = amodeToStix res
 116         sa      = amodeToStix csa
 117         aa      = stgArrWords__words (amodeToStix cda)
 118         da      = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
 119
 120         (a1,a2,a3) = toStruct scratch1 (aa,sa,da)
 121         mpz_get_ui = StCall SLIT("mpz_get_ui") cCallConv IntRep [scratch1]
 122         r1 = StAssign WordRep result mpz_get_ui
 123     in
 124     returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
 125
 126 gmpNegate
 127     :: (CAddrMode,CAddrMode) -- result
 128     -> (CAddrMode,CAddrMode) -- argument (2 parts)
 129     -> UniqSM StixTreeList
 130
 131 gmpNegate (rcs, rcd) args@(cs, cd)
 132   = let
 133         s       = amodeToStix cs
 134         a       = stgArrWords__words (amodeToStix cd)
 135         d       = stgArrWords__BYTE_ARR_CTS (amodeToStix cd)
 136         rs      = amodeToStix rcs
 137         ra      = stgArrWords__words (amodeToStix rcd)
 138         rd      = stgArrWords__BYTE_ARR_CTS (amodeToStix rcd)
 139         a1      = StAssign IntRep ra a
 140         a2      = StAssign IntRep rs (StPrim IntNegOp [s])
 141         a3      = StAssign PtrRep rd d
 142     in
 143     returnUs (\xs -> a1 : a2 : a3 : xs)
 144 \end{code}
 145
 146 Support for the Gnu GMP multi-precision package.
 147
 148 \begin{code}
 149 -- size (in words) of __MP_INT
 150 mpIntSize = 3 :: Int
 151
 152 mpAlloc, mpSize, mpData :: StixTree -> StixTree
 153 mpAlloc base = StInd IntRep base
 154 mpSize base = StInd IntRep (StIndex IntRep base (StInt 1))
 155 mpData base = StInd PtrRep (StIndex IntRep base (StInt 2))
 156 \end{code}
 157
 158 \begin{code}
 159 toStruct
 160     :: StixTree
 161     -> (StixTree, StixTree, StixTree)
 162     -> (StixTree, StixTree, StixTree)
 163
 164 toStruct str (alloc,size,arr)
 165   = let
 166         f1 = StAssign IntRep (mpAlloc str) alloc
 167         f2 = StAssign IntRep (mpSize str) size
 168         f3 = StAssign PtrRep (mpData str) arr
 169     in
 170     (f1, f2, f3)
 171
 172 scratch1 = StScratchWord 0
 173 scratch2 = StScratchWord mpIntSize
 174 \end{code}
 175