2 % (c) The AQUA Project, Glasgow University, 1993-1998
14 #include "HsVersions.h"
16 import {-# SOURCE #-} StixPrim ( amodeToStix )
20 import AbsCSyn hiding (spRel) -- bits and bobs..
21 import Literal ( Literal(..) )
22 import CallConv ( cCallConv )
23 import PrimOp ( PrimOp(..) )
24 import PrimRep ( PrimRep(..) )
25 import SMRep ( arrWordsHdrSize )
26 import Stix ( StixTree(..), StixTreeList, arrWordsHS )
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.'')
36 stgArrWords__words :: StixTree -> StixTree
37 stgArrWords__BYTE_ARR_CTS :: StixTree -> StixTree
39 stgArrWords__BYTE_ARR_CTS arr
40 = StIndex WordRep arr arrWordsHS
41 stgArrWords__words arr
43 StInt i -> StInd WordRep (StIndex PtrRep arr (StInt (i-1)))
46 :: CAddrMode -- result (boolean)
47 -> (CAddrMode,CAddrMode,CAddrMode,CAddrMode)
48 -- alloc hp + 2 arguments (2 parts each)
49 -> UniqSM StixTreeList
51 gmpCompare res args@(csa1,cda1, csa2,cda2)
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)
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
66 returnUs (\xs -> a1 : a2 : a3 : a4 : a5 : a6 : r1 : xs)
70 :: CAddrMode -- result (boolean)
71 -> (CAddrMode,CAddrMode,CAddrMode)
72 -> UniqSM StixTreeList -- alloc hp + 1 arg (??)
74 gmpCompareInt res args@(csa1,cda1, cai)
76 result = amodeToStix res
77 sa1 = amodeToStix csa1
78 aa1 = stgArrWords__words (amodeToStix cda1)
79 da1 = stgArrWords__BYTE_ARR_CTS (amodeToStix cda1)
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
85 returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
90 :: CAddrMode -- result
91 -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
92 -> UniqSM StixTreeList
94 gmpInteger2Int res args@(csa,cda)
96 result = amodeToStix res
98 aa = stgArrWords__words (amodeToStix cda)
99 da = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
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
105 returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
108 :: CAddrMode -- result
109 -> (CAddrMode,CAddrMode) -- alloc hp + argument (2 parts)
110 -> UniqSM StixTreeList
112 gmpInteger2Word res args@(csa,cda)
114 result = amodeToStix res
116 aa = stgArrWords__words (amodeToStix cda)
117 da = stgArrWords__BYTE_ARR_CTS (amodeToStix cda)
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
123 returnUs (\xs -> a1 : a2 : a3 : r1 : xs)
126 :: (CAddrMode,CAddrMode) -- result
127 -> (CAddrMode,CAddrMode) -- argument (2 parts)
128 -> UniqSM StixTreeList
130 gmpNegate (rcs, rcd) args@(cs, cd)
133 a = stgArrWords__words (amodeToStix cd)
134 d = stgArrWords__BYTE_ARR_CTS (amodeToStix cd)
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
142 returnUs (\xs -> a1 : a2 : a3 : xs)
145 Support for the Gnu GMP multi-precision package.
148 -- size (in words) of __MP_INT
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))
160 -> (StixTree, StixTree, StixTree)
161 -> (StixTree, StixTree, StixTree)
163 toStruct str (alloc,size,arr)
165 f1 = StAssign IntRep (mpAlloc str) alloc
166 f2 = StAssign IntRep (mpSize str) size
167 f3 = StAssign PtrRep (mpData str) arr
171 scratch1 = StScratchWord 0
172 scratch2 = StScratchWord mpIntSize