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 761 - (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 : george 761 val pow2table = Array.tabulate(maxSz,fn n => I.<<(int_1,itow n)) (* 2^n *)
57 :     val maskTable = Array.tabulate(maxSz,
58 :     fn n => I.-(I.<<(int_1,itow n),int_1)) (* 2^n-1 *)
59 :     val maxtable = Array.tabulate(maxSz+1,
60 :     fn 0 => int_0
61 :     | n => I.-(I.<<(int_1,itow(n-1)),int_1)) (* 2^{n-1}-1 *)
62 :     val mintable = Array.tabulate(maxSz+1,
63 :     fn 0 => int_0
64 :     | n => I.~(I.<<(int_1,itow(n-1)))) (* -2^{n-1} *)
65 : leunga 744
66 :     fun pow2 i = Array.sub(pow2table, i)
67 : george 761 fun maxOfSize sz = Array.sub(maxtable, sz)
68 :     fun minOfSize sz = Array.sub(mintable, sz)
69 : leunga 744
70 :     (* queries *)
71 :     fun isNeg(i) = I.sign i < 0
72 :     fun isPos(i) = I.sign i > 0
73 :     fun isZero(i) = I.sign i = 0
74 :     fun isNonNeg(i) = I.sign i >= 0
75 :     fun isNonPos(i) = I.sign i <= 0
76 :     fun isEven(i) = isZero(I.rem(i,int_2))
77 :     fun isOdd(i) = not(isEven(i))
78 :    
79 :     (* to unsigned representation *)
80 : george 761 fun unsigned(sz, i) = if isNeg i then I.+(i, pow2 sz) else i
81 : leunga 744
82 :     (* to signed representation *)
83 : george 761 fun signed(sz, i) = if I.>(i, maxOfSize sz) then I.-(i, pow2 sz) else i
84 : leunga 744
85 :     (* Narrow to the representation of a given type *)
86 : george 761 fun narrow(sz, i) = signed(sz, I.andb(i, Array.sub(maskTable,sz)))
87 : leunga 744
88 :     (* Recognize 0x and 0b prefix and do the right thing *)
89 : george 761 fun fromString(sz, s) =
90 : leunga 744 let val n = S.size s
91 : george 761 fun conv(i,negate) =
92 :     if n >= 2+i andalso S.sub(s, i) = #"0" then
93 :     (case S.sub(s, i+1) of
94 :     #"x" => (hexToInt (S.substring(s,2+i,n-2-i)), negate)
95 :     | #"b" => (binToInt (S.substring(s,2+i,n-2-i)), negate)
96 :     | _ => (I.fromString s, false)
97 : leunga 744 )
98 : george 761 else (I.fromString s, false)
99 :     val (result, negate) =
100 :     if s = "" then (NONE, false)
101 :     else if S.sub(s, 0) = #"~" then conv(1, true)
102 :     else conv(0, false)
103 :     in case (result, negate) of
104 :     (SOME n, true) => SOME(narrow(sz, n))
105 :     | (SOME n, false) => SOME(narrow(sz, I.~ n))
106 :     | (NONE, _) => NONE
107 : leunga 744 end
108 :    
109 : george 761 (* Convert types into IntInf without losing precision. *)
110 :     structure Cvt =
111 :     struct
112 :     structure W = Word
113 :     structure W32 = Word32
114 :     val wtoi = W.toIntX
115 :     val w32toi = W32.toIntX
116 :     val fromInt = I.fromInt
117 :     val fromInt32 = I.fromLarge
118 :     fun fromWord w = I.fromLarge(Word.toLargeInt w)
119 :     fun fromWord32 w = I.+(I.<<(I.fromInt(w32toi(W32.>>(w,0w16))),0w16),
120 :     I.fromInt(w32toi(W32.andb(w,0wxffff))))
121 :     end
122 : leunga 744 (* machine_int <-> other types *)
123 : george 761 fun fromInt(sz,i) = narrow(sz,Cvt.fromInt i)
124 :     fun fromInt32(sz,i) = narrow(sz,Cvt.fromInt32 i)
125 :     fun fromWord(sz,w) = narrow(sz,Cvt.fromWord w)
126 :     fun fromWord32(sz,w) = narrow(sz,Cvt.fromWord32 w)
127 :     fun toString(sz,i) = I.toString i
128 : leunga 744 val toHex = I.fmt StringCvt.HEX
129 :     val toBin = I.fmt StringCvt.BIN
130 : george 761 fun toHexString(sz, i) = "0x"^toHex(unsigned(sz, i))
131 :     fun toBinString(sz, i) = "0b"^toBin(unsigned(sz, i))
132 :     fun toInt(sz, i) = I.toInt(narrow(sz, i))
133 :     fun toWord(sz, i) = Word.fromLargeInt(I.toLarge(unsigned(sz, i)))
134 :     fun toWord32(sz, i) =
135 :     let val i = unsigned(sz, i)
136 :     val lo = I.andb(i,int_0xffff)
137 :     val hi = I.~>>(i,0w16)
138 :     fun tow32 i = Word32.fromLargeInt(I.toLarge i)
139 :     in tow32 lo + Word32.<<(tow32 hi, 0w16) end
140 :     fun toInt32(sz, i) = I.toLarge(narrow(sz, i))
141 : leunga 744
142 :     (* constants *)
143 : george 761 val int_0xffffffff = Option.valOf(fromString(64, "0xffffffff"))
144 :     val int_0x100000000 = Option.valOf(fromString(64, "0x100000000"))
145 : leunga 744
146 : george 761 fun isInRange(sz, i) = I.<=(minOfSize sz,i) andalso I.<=(i,maxOfSize sz)
147 : leunga 744
148 : george 761 fun signedBinOp f (sz,i,j) = narrow(sz, f(i, j))
149 : leunga 744
150 : george 761 fun signedUnaryOp f (sz,i) = narrow(sz, f i)
151 : leunga 744
152 : george 761 fun unsignedBinOp f (sz,i,j) = narrow(sz, f(unsigned(sz,i), unsigned(sz,j)))
153 : leunga 744
154 : george 761 fun trappingUnaryOp f (sz,i) =
155 : leunga 744 let val x = f i
156 : george 761 in if isInRange(sz, x) then x else raise Overflow
157 : leunga 744 end
158 :    
159 : george 761 fun trappingBinOp f (sz,i,j) =
160 : leunga 744 let val x = f(i,j)
161 : george 761 in if isInRange(sz, x) then x else raise Overflow
162 : leunga 744 end
163 :    
164 :     (* two's complement operators *)
165 :     val NEG = signedUnaryOp I.~
166 :     val ABS = signedUnaryOp I.abs
167 :     val ADD = signedBinOp I.+
168 :     val SUB = signedBinOp I.-
169 :     val MULS = signedBinOp I.*
170 :     val DIVS = signedBinOp I.div
171 :     val QUOTS = signedBinOp I.quot
172 :     val REMS = signedBinOp I.rem
173 :     val MULU = unsignedBinOp I.*
174 :     val DIVU = unsignedBinOp I.div
175 :     val QUOTU = unsignedBinOp I.quot
176 :     val REMU = unsignedBinOp I.rem
177 :    
178 :     val NEGT = trappingUnaryOp I.~
179 :     val ABST = trappingUnaryOp I.abs
180 :     val ADDT = trappingBinOp I.+
181 :     val SUBT = trappingBinOp I.-
182 :     val MULT = trappingBinOp I.*
183 :     val DIVT = trappingBinOp I.div
184 :     val QUOTT = trappingBinOp I.quot
185 :     val REMT = trappingBinOp I.rem
186 :    
187 : george 761 fun NOTB(sz,x) = narrow(sz,I.notb x)
188 :     fun ANDB(sz,x,y) = narrow(sz,I.andb(x,y))
189 :     fun ORB(sz,x,y) = narrow(sz,I.orb(x,y))
190 :     fun XORB(sz,x,y) = narrow(sz,I.xorb(x,y))
191 :     fun EQVB(sz,x,y) = narrow(sz,I.xorb(I.notb x,y))
192 :     fun Sll(sz,x,y) = narrow(sz,I.<<(x, y))
193 :     fun Srl(sz,x,y) = narrow(sz,I.~>>(unsigned(sz, x), y))
194 :     fun Sra(sz,x,y) = narrow(sz,I.~>>(x, y))
195 :     fun SLL(sz,x,y) = Sll(sz,x,toWord(sz, y))
196 :     fun SRL(sz,x,y) = Srl(sz,x,toWord(sz, y))
197 :     fun SRA(sz,x,y) = Sra(sz,x,toWord(sz, y))
198 : leunga 744
199 : george 761 fun BITSLICE(sz,sl,x) =
200 : leunga 744 let fun slice([],n) = n
201 :     | slice((from,to)::sl,n) =
202 : george 761 slice(sl, ORB(sz, narrow(to-from+1,
203 :     Srl(sz, x, Word.fromInt from)), n))
204 : leunga 744 in slice(sl, int_0)
205 :     end
206 :    
207 : george 761 fun bitOf(sz, i, b) = toWord(1, narrow(1, Srl(sz, i, Word.fromInt b)))
208 :     fun byteOf(sz, i, b) = toWord(8, narrow(8, Srl(sz, i, Word.fromInt(b*8))))
209 :     fun halfOf(sz, i, h) = toWord(16, narrow(16, Srl(sz, i, Word.fromInt(h*16))))
210 :     fun wordOf(sz, i, w) = toWord32(32, narrow(32, Srl(sz, i, Word.fromInt(w*32))))
211 : leunga 744
212 :     (* type promotion *)
213 : george 761 fun SX(toSz,fromSz,i) = narrow(toSz, narrow(fromSz, i))
214 :     fun ZX(toSz,fromSz,i) = narrow(toSz, unsigned(fromSz, narrow(fromSz, i)))
215 : leunga 744
216 :     (* comparisions *)
217 : george 761 fun EQ(sz,i,j) = i = j
218 :     fun NE(sz,i,j) = i <> j
219 :     fun GT(sz,i,j) = I.>(i,j)
220 :     fun GE(sz,i,j) = I.>=(i,j)
221 :     fun LT(sz,i,j) = I.<(i,j)
222 :     fun LE(sz,i,j) = I.<=(i,j)
223 :     fun LTU(sz,i,j) = I.<(unsigned(sz, i),unsigned(sz, j))
224 :     fun GTU(sz,i,j) = I.>(unsigned(sz, i),unsigned(sz, j))
225 :     fun LEU(sz,i,j) = I.<=(unsigned(sz, i),unsigned(sz, j))
226 :     fun GEU(sz,i,j) = I.>=(unsigned(sz, i),unsigned(sz, j))
227 : leunga 744 end
228 : george 761
229 :     end

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