\begin{code}
module StixInteger (
gmpCompare,
+ gmpCompareInt,
gmpInteger2Int,
gmpInteger2Word,
- gmpNegate
+ gmpNegate
) where
#include "HsVersions.h"
import MachRegs
import AbsCSyn hiding (spRel) -- bits and bobs..
-import Const ( Literal(..) )
+import Literal ( Literal(..) )
import CallConv ( cCallConv )
-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}
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)
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
= 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}