2 % (c) The AQUA Project, Glasgow University, 1993-1998
13 #include "HsVersions.h"
15 import {-# SOURCE #-} StixPrim ( amodeToStix )
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 )
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.'')
37 :: CAddrMode -- result (boolean)
38 -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode,CAddrMode)
39 -- alloc hp + 2 arguments (3 parts each)
40 -> UniqSM StixTreeList
42 gmpCompare res args@(caa1,csa1,cda1, caa2,csa2,cda2)
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
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
59 returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
64 :: CAddrMode -- result
65 -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
66 -> UniqSM StixTreeList
68 gmpInteger2Int res args@(caa,csa,cda)
70 result = amodeToStix res
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
79 returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
82 :: CAddrMode -- result
83 -> (CAddrMode,CAddrMode,CAddrMode) -- alloc hp + argument (3 parts)
84 -> UniqSM StixTreeList
86 gmpInteger2Word res args@(caa,csa,cda)
88 result = amodeToStix res
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
97 returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
100 :: (CAddrMode,CAddrMode,CAddrMode) -- result
101 -> (CAddrMode,CAddrMode,CAddrMode) -- argument (3 parts)
102 -> UniqSM StixTreeList
104 gmpNegate (rca, rcs, rcd) args@(ca, cs, cd)
112 a1 = StAssign IntRep ra a
113 a2 = StAssign IntRep rs (StPrim IntNegOp [s])
114 a3 = StAssign PtrRep rd d
116 returnUs (\xs -> a1 : a2 : a3 : xs)
119 Support for the Gnu GMP multi-precision package.
122 -- size (in words) of __MP_INT
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))
134 -> (StixTree, StixTree, StixTree)
135 -> (StixTree, StixTree, StixTree)
137 toStruct str (alloc,size,arr)
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)))
146 scratch_space = sStLitLbl SLIT("stg_scratch_space")