Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/MLRISC/mltree/machine-int.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/mltree/machine-int.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1048 - (view) (download)

1 : leunga 744 (*
2 :     * How to evaluate constants for various widths.
3 :     *
4 :     * Internally, we represent machine_int as a signed integer.
5 :     * So when we do bit or unsigned operations we have to convert to
6 :     * the unsigned representation first.
7 : george 761 *
8 :     * Note: this implementation requires andb, orb, xorb etc in IntInf.
9 :     * You have to upgrade to the latest version of smlnj-lib if this
10 :     * fails to compile.
11 : leunga 744 *)
12 : george 761 local
13 :    
14 :     val maxSz = 65
15 :    
16 :     in
17 :    
18 : leunga 744 structure MachineInt : MACHINE_INT =
19 :     struct
20 :    
21 :     structure I = IntInf
22 :     structure S = String
23 :     type machine_int = I.int
24 : george 761 type sz = int
25 : leunga 744
26 : george 761 val itow = Word.fromInt
27 : leunga 744
28 :     (* Parse hex or binary, but not octal, that's for wussies *)
29 :     val hexToInt = StringCvt.scanString (I.scan StringCvt.HEX)
30 :     val binToInt = StringCvt.scanString (I.scan StringCvt.BIN)
31 :    
32 :     (* constants *)
33 :     val int_0 = I.fromInt 0
34 :     val int_1 = I.fromInt 1
35 :     val int_2 = I.fromInt 2
36 :     val int_3 = I.fromInt 3
37 :     val int_4 = I.fromInt 4
38 :     val int_7 = I.fromInt 7
39 :     val int_8 = I.fromInt 8
40 :     val int_15 = I.fromInt 15
41 :     val int_16 = I.fromInt 16
42 :     val int_31 = I.fromInt 31
43 :     val int_32 = I.fromInt 32
44 :     val int_63 = I.fromInt 63
45 :     val int_64 = I.fromInt 64
46 :     val int_m1 = I.fromInt ~1
47 :     val int_m2 = I.fromInt ~2
48 :     val int_m3 = I.fromInt ~3
49 :     val int_m4 = I.fromInt ~4
50 :     val int_0xff = I.fromInt 0xff
51 :     val int_0x100 = I.fromInt 0x100
52 :     val int_0xffff = I.fromInt 0xffff
53 :     val int_0x10000 = I.fromInt 0x10000
54 :    
55 :     (* Precompute some tables for faster arithmetic *)
56 : leunga 1048 local
57 : george 761 val pow2table = Array.tabulate(maxSz,fn n => I.<<(int_1,itow n)) (* 2^n *)
58 : leunga 1048 val masktable = Array.tabulate(maxSz,
59 : george 761 fn n => I.-(I.<<(int_1,itow n),int_1)) (* 2^n-1 *)
60 :     val maxtable = Array.tabulate(maxSz+1,
61 :     fn 0 => int_0
62 :     | n => I.-(I.<<(int_1,itow(n-1)),int_1)) (* 2^{n-1}-1 *)
63 :     val mintable = Array.tabulate(maxSz+1,
64 :     fn 0 => int_0
65 :     | n => I.~(I.<<(int_1,itow(n-1)))) (* -2^{n-1} *)
66 : leunga 1048 in
67 : leunga 744
68 : leunga 1048 fun pow2 i = if i < maxSz then Array.sub(pow2table, i)
69 :     else I.<<(int_1,itow i)
70 :     fun maskOf sz = if sz < maxSz then Array.sub(masktable, sz)
71 :     else I.-(I.<<(int_1,itow sz),int_1)
72 :     fun maxOfSize sz = if sz < maxSz then Array.sub(maxtable, sz)
73 :     else I.-(I.<<(int_1,itow(sz-1)),int_1)
74 :     fun minOfSize sz = if sz < maxSz then Array.sub(mintable, sz)
75 :     else I.~(I.<<(int_1,itow(sz-1)))
76 :     end
77 : leunga 744
78 :     (* queries *)
79 :     fun isNeg(i) = I.sign i < 0
80 :     fun isPos(i) = I.sign i > 0
81 :     fun isZero(i) = I.sign i = 0
82 :     fun isNonNeg(i) = I.sign i >= 0
83 :     fun isNonPos(i) = I.sign i <= 0
84 :     fun isEven(i) = isZero(I.rem(i,int_2))
85 :     fun isOdd(i) = not(isEven(i))
86 :    
87 :     (* to unsigned representation *)
88 : george 761 fun unsigned(sz, i) = if isNeg i then I.+(i, pow2 sz) else i
89 : leunga 744
90 :     (* to signed representation *)
91 : george 761 fun signed(sz, i) = if I.>(i, maxOfSize sz) then I.-(i, pow2 sz) else i
92 : leunga 744
93 :     (* Narrow to the representation of a given type *)
94 : leunga 1048 fun narrow(sz, i) = signed(sz, I.andb(i, maskOf sz))
95 : leunga 744
96 :     (* Recognize 0x and 0b prefix and do the right thing *)
97 : george 761 fun fromString(sz, s) =
98 : leunga 744 let val n = S.size s
99 : george 761 fun conv(i,negate) =
100 :     if n >= 2+i andalso S.sub(s, i) = #"0" then
101 :     (case S.sub(s, i+1) of
102 :     #"x" => (hexToInt (S.substring(s,2+i,n-2-i)), negate)
103 :     | #"b" => (binToInt (S.substring(s,2+i,n-2-i)), negate)
104 :     | _ => (I.fromString s, false)
105 : leunga 744 )
106 : george 761 else (I.fromString s, false)
107 :     val (result, negate) =
108 :     if s = "" then (NONE, false)
109 :     else if S.sub(s, 0) = #"~" then conv(1, true)
110 :     else conv(0, false)
111 :     in case (result, negate) of
112 : leunga 1048 (SOME n, true) => SOME(narrow(sz, I.~ n))
113 :     | (SOME n, false) => SOME(narrow(sz, n))
114 : george 761 | (NONE, _) => NONE
115 : leunga 744 end
116 :    
117 : george 761 (* Convert types into IntInf without losing precision. *)
118 :     structure Cvt =
119 :     struct
120 :     structure W = Word
121 :     structure W32 = Word32
122 :     val wtoi = W.toIntX
123 :     val w32toi = W32.toIntX
124 :     val fromInt = I.fromInt
125 :     val fromInt32 = I.fromLarge
126 :     fun fromWord w = I.fromLarge(Word.toLargeInt w)
127 :     fun fromWord32 w = I.+(I.<<(I.fromInt(w32toi(W32.>>(w,0w16))),0w16),
128 :     I.fromInt(w32toi(W32.andb(w,0wxffff))))
129 :     end
130 : leunga 744 (* machine_int <-> other types *)
131 : george 761 fun fromInt(sz,i) = narrow(sz,Cvt.fromInt i)
132 :     fun fromInt32(sz,i) = narrow(sz,Cvt.fromInt32 i)
133 :     fun fromWord(sz,w) = narrow(sz,Cvt.fromWord w)
134 :     fun fromWord32(sz,w) = narrow(sz,Cvt.fromWord32 w)
135 :     fun toString(sz,i) = I.toString i
136 : leunga 744 val toHex = I.fmt StringCvt.HEX
137 :     val toBin = I.fmt StringCvt.BIN
138 : george 761 fun toHexString(sz, i) = "0x"^toHex(unsigned(sz, i))
139 :     fun toBinString(sz, i) = "0b"^toBin(unsigned(sz, i))
140 :     fun toInt(sz, i) = I.toInt(narrow(sz, i))
141 :     fun toWord(sz, i) = Word.fromLargeInt(I.toLarge(unsigned(sz, i)))
142 :     fun toWord32(sz, i) =
143 :     let val i = unsigned(sz, i)
144 :     val lo = I.andb(i,int_0xffff)
145 :     val hi = I.~>>(i,0w16)
146 :     fun tow32 i = Word32.fromLargeInt(I.toLarge i)
147 :     in tow32 lo + Word32.<<(tow32 hi, 0w16) end
148 :     fun toInt32(sz, i) = I.toLarge(narrow(sz, i))
149 : leunga 744
150 : leunga 775 val int_0x1fffffff = fromWord(32,0wx1fffffff)
151 :     fun hash i = Word.fromInt(I.toInt(I.andb(i,int_0x1fffffff)))
152 :    
153 : leunga 744 (* constants *)
154 : george 761 val int_0xffffffff = Option.valOf(fromString(64, "0xffffffff"))
155 :     val int_0x100000000 = Option.valOf(fromString(64, "0x100000000"))
156 : leunga 744
157 : george 761 fun isInRange(sz, i) = I.<=(minOfSize sz,i) andalso I.<=(i,maxOfSize sz)
158 : leunga 744
159 : george 761 fun signedBinOp f (sz,i,j) = narrow(sz, f(i, j))
160 : leunga 744
161 : george 761 fun signedUnaryOp f (sz,i) = narrow(sz, f i)
162 : leunga 744
163 : george 761 fun unsignedBinOp f (sz,i,j) = narrow(sz, f(unsigned(sz,i), unsigned(sz,j)))
164 : leunga 744
165 : george 761 fun trappingUnaryOp f (sz,i) =
166 : leunga 744 let val x = f i
167 : george 761 in if isInRange(sz, x) then x else raise Overflow
168 : leunga 744 end
169 :    
170 : george 761 fun trappingBinOp f (sz,i,j) =
171 : leunga 744 let val x = f(i,j)
172 : george 761 in if isInRange(sz, x) then x else raise Overflow
173 : leunga 744 end
174 :    
175 :     (* two's complement operators *)
176 :     val NEG = signedUnaryOp I.~
177 :     val ABS = signedUnaryOp I.abs
178 :     val ADD = signedBinOp I.+
179 :     val SUB = signedBinOp I.-
180 :     val MULS = signedBinOp I.*
181 :     val DIVS = signedBinOp I.div
182 :     val QUOTS = signedBinOp I.quot
183 :     val REMS = signedBinOp I.rem
184 :     val MULU = unsignedBinOp I.*
185 :     val DIVU = unsignedBinOp I.div
186 :     val QUOTU = unsignedBinOp I.quot
187 :     val REMU = unsignedBinOp I.rem
188 :    
189 :     val NEGT = trappingUnaryOp I.~
190 :     val ABST = trappingUnaryOp I.abs
191 :     val ADDT = trappingBinOp I.+
192 :     val SUBT = trappingBinOp I.-
193 :     val MULT = trappingBinOp I.*
194 :     val DIVT = trappingBinOp I.div
195 :     val QUOTT = trappingBinOp I.quot
196 :     val REMT = trappingBinOp I.rem
197 :    
198 : george 761 fun NOTB(sz,x) = narrow(sz,I.notb x)
199 :     fun ANDB(sz,x,y) = narrow(sz,I.andb(x,y))
200 :     fun ORB(sz,x,y) = narrow(sz,I.orb(x,y))
201 :     fun XORB(sz,x,y) = narrow(sz,I.xorb(x,y))
202 :     fun EQVB(sz,x,y) = narrow(sz,I.xorb(I.notb x,y))
203 :     fun Sll(sz,x,y) = narrow(sz,I.<<(x, y))
204 :     fun Srl(sz,x,y) = narrow(sz,I.~>>(unsigned(sz, x), y))
205 :     fun Sra(sz,x,y) = narrow(sz,I.~>>(x, y))
206 :     fun SLL(sz,x,y) = Sll(sz,x,toWord(sz, y))
207 :     fun SRL(sz,x,y) = Srl(sz,x,toWord(sz, y))
208 :     fun SRA(sz,x,y) = Sra(sz,x,toWord(sz, y))
209 : leunga 744
210 : george 761 fun BITSLICE(sz,sl,x) =
211 : leunga 744 let fun slice([],n) = n
212 :     | slice((from,to)::sl,n) =
213 : george 761 slice(sl, ORB(sz, narrow(to-from+1,
214 :     Srl(sz, x, Word.fromInt from)), n))
215 : leunga 744 in slice(sl, int_0)
216 :     end
217 :    
218 : george 761 fun bitOf(sz, i, b) = toWord(1, narrow(1, Srl(sz, i, Word.fromInt b)))
219 :     fun byteOf(sz, i, b) = toWord(8, narrow(8, Srl(sz, i, Word.fromInt(b*8))))
220 :     fun halfOf(sz, i, h) = toWord(16, narrow(16, Srl(sz, i, Word.fromInt(h*16))))
221 :     fun wordOf(sz, i, w) = toWord32(32, narrow(32, Srl(sz, i, Word.fromInt(w*32))))
222 : leunga 744
223 :     (* type promotion *)
224 : george 761 fun SX(toSz,fromSz,i) = narrow(toSz, narrow(fromSz, i))
225 :     fun ZX(toSz,fromSz,i) = narrow(toSz, unsigned(fromSz, narrow(fromSz, i)))
226 : leunga 744
227 :     (* comparisions *)
228 : george 761 fun EQ(sz,i,j) = i = j
229 :     fun NE(sz,i,j) = i <> j
230 :     fun GT(sz,i,j) = I.>(i,j)
231 :     fun GE(sz,i,j) = I.>=(i,j)
232 :     fun LT(sz,i,j) = I.<(i,j)
233 :     fun LE(sz,i,j) = I.<=(i,j)
234 :     fun LTU(sz,i,j) = I.<(unsigned(sz, i),unsigned(sz, j))
235 :     fun GTU(sz,i,j) = I.>(unsigned(sz, i),unsigned(sz, j))
236 :     fun LEU(sz,i,j) = I.<=(unsigned(sz, i),unsigned(sz, j))
237 :     fun GEU(sz,i,j) = I.>=(unsigned(sz, i),unsigned(sz, j))
238 : leunga 1048
239 :     (*
240 :     * Split an integer "i" of size "sz" into words of size "wordSize"
241 :     *)
242 :     fun split{sz, wordSize, i} =
243 :     let fun loop(sz, i, ws) =
244 :     if sz <= 0 then rev ws
245 :     else
246 :     let val w = narrow(wordSize, i)
247 :     val i = IntInf.~>>(i, Word.fromInt wordSize)
248 :     in loop(sz - wordSize, i, w::ws)
249 :     end
250 :     in loop(sz, unsigned(sz, i), [])
251 :     end
252 :    
253 : leunga 744 end
254 : george 761
255 :     end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0