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/library/word64.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/library/word64.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 410 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/library/word64.sml

1 : monnier 409 (*
2 :     * 64-bit word datatype.
3 :     * Word64.word is implemented as Word32.word * Word32.word
4 :     * A constant of this type can be specified as a pair of 32-bit words.
5 :     * Also pattern matching can also be applied in the same manner.
6 :     *
7 :     * -- Allen
8 :     *)
9 :    
10 :     structure Word64 : WORD =
11 :     struct
12 :     structure W = Word32
13 :    
14 :     type word = W.word * W.word (* high, low *)
15 :    
16 :     val wordSize = 64
17 :    
18 :     fun isNeg w = W.>>(w,0w31) = 0w1 (* test the sign bit *)
19 :    
20 :     fun toLargeWord(x,y) = y (* strip high order bits *)
21 :     fun toLargeWordX(x,y) = y (* strip high order bits *)
22 :     fun fromLargeWord w = (0w0 : W.word,w)
23 :    
24 :     fun toLargeInt(x:W.word,y) =
25 :     if x <> 0w0 orelse isNeg y then raise Overflow
26 :     else W.toLargeInt y
27 :    
28 :     fun toLargeIntX(x,y) =
29 :     if x = 0w0 then
30 :     if isNeg y then raise Overflow else W.toLargeInt y
31 :     else if (W.notb x) = 0w0 then
32 :     if isNeg y then W.toLargeIntX y else raise Overflow
33 :     else raise Overflow
34 :    
35 :     fun fromLargeInt i = (if i >= 0 then 0w0 else W.notb 0w0,W.fromLargeInt i)
36 :    
37 :     fun toInt(x:W.word,y) =
38 :     if x <> 0w0 orelse isNeg y then raise Overflow else W.toInt y
39 :    
40 :     fun toIntX(x,y) =
41 :     if x = 0w0 then
42 :     if isNeg y then raise Overflow else W.toInt y
43 :     else if (W.notb x) = 0w0 then
44 :     if isNeg y then W.toIntX y else raise Overflow
45 :     else raise Overflow
46 :    
47 :     fun fromInt i = if i >= 0 then (0w0:W.word,W.fromInt i)
48 :     else (W.notb 0w0,W.fromInt i)
49 :    
50 :     fun orb((a,b),(c,d)) = (W.orb(a,c),W.orb(b,d))
51 :    
52 :     fun xorb((a,b),(c,d)) = (W.xorb(a,c),W.xorb(b,d))
53 :    
54 :     fun andb((a,b),(c,d)) = (W.andb(a,c),W.andb(b,d))
55 :    
56 :     fun notb(a,b) = (W.notb a,W.notb b)
57 :    
58 :     fun plus((a,b),(c,d)) =
59 :     let val y = W.+(b,d)
60 :     val x = W.+(a,c)
61 :     val x = if y < b then W.+(x,0w1) else x (* carry *)
62 :     in (x,y) end
63 :    
64 :     fun minus((a,b),(c,d)) =
65 :     let val x = W.-(a,c)
66 :     val y = W.-(b,d)
67 :     val x = if b < d then W.-(x,0w1) else x (* borrow *)
68 :     in (x,y) end
69 :    
70 :     fun mult((a,b),(c,d)) =
71 :     let (* multiply 32x32 -> 64.
72 :     * Split them into two pairs of 16 bit words in order to deal
73 :     * with carries in a portable manner. This is really annoying.
74 :     *)
75 :     fun multiply(u,v) =
76 :     let val a = W.>>(u,0w16)
77 :     val b = W.andb(u,0wxffff)
78 :     val c = W.>>(v,0w16)
79 :     val d = W.andb(v,0wxffff)
80 :     val ac = a*c
81 :     val bc = b*c
82 :     val ad = a*d
83 :     val bd = b*d
84 :     val bc_hi = W.>>(bc,0w16)
85 :     val bc_lo = W.<<(bc,0w16)
86 :     val ad_hi = W.>>(ad,0w16)
87 :     val ad_lo = W.<<(ad,0w16)
88 :     val AC = (ac,0w0:W.word)
89 :     val BC = (bc_hi,bc_lo)
90 :     val AD = (ad_hi,ad_lo)
91 :     val BD = (0w0:W.word,bd)
92 :     in plus(AC,plus(BC,plus(AD,BD))) end
93 :     fun shift32(a,b) = (b,0w0)
94 :     val ad = multiply(a,d)
95 :     val bc = multiply(b,c)
96 :     val bd = multiply(b,d)
97 :     in plus(plus(shift32(ad),shift32(bc)),bd) end
98 :    
99 :     fun gt((a,b):word,(c,d):word) = a > c orelse a=c andalso b > d
100 :     fun ge((a,b):word,(c,d):word) = a > c orelse a=c andalso b >= d
101 :     fun lt((a,b):word,(c,d):word) = a < b orelse a=c andalso b < d
102 :     fun le((a,b):word,(c,d):word) = a < b orelse a=c andalso b <= d
103 :    
104 :     fun compare ((a,b):word, (c,d):word) =
105 :     if a < c then LESS
106 :     else if a > c then GREATER
107 :     else if b < d then LESS
108 :     else if b > d then GREATER
109 :     else EQUAL
110 :    
111 :     fun sll((a,b),c) =
112 :     if c >= 0w32 then
113 :     let val x = W.<<(b,c-0w32)
114 :     in (x,0w0) end
115 :     else let val x = W.<<(a,c)
116 :     val y = W.<<(b,c)
117 :     val z = W.>>(b,0w32-c)
118 :     in (W.orb(x,z),y) end
119 :    
120 :     fun srl((a,b),c) =
121 :     if c >= 0w32 then
122 :     let val y = W.>>(a,c-0w32)
123 :     in (0w0,y) end
124 :     else let val x = W.>>(a,c)
125 :     val y = W.>>(b,c)
126 :     val z = W.<<(W.andb(a,W.<<(0w1,c)-0w1),0w32-c)
127 :     in (x,W.orb(y,z)) end
128 :    
129 :     fun sra((a,b),c) =
130 :     if c >= 0w32 then
131 :     let val y = W.~>>(a,c-0w32)
132 :     val x = if isNeg a then W.notb 0w0 else 0w0
133 :     in (x,y) end
134 :     else let val x = W.~>>(a,c)
135 :     val y = W.>>(b,c)
136 :     val z = W.<<(W.andb(a,W.<<(0w1,c)-0w1),0w32-c)
137 :     in (x,W.orb(y,z)) end
138 :    
139 :     fun min (w1, w2) = if lt(w1,w2) then w1 else w2
140 :    
141 :     fun max (w1, w2) = if gt(w1,w2) then w1 else w2
142 :    
143 :     fun divide((a,b),(0w0,0w0):word) = raise Div
144 :     | divide((a,b),(c,d)) = raise Match
145 :     (* okay, not yet supported, I'm lazy *)
146 :    
147 :     fun padZero(b,0) = b
148 :     | padZero(b,n) = padZero("0"^b,n-1)
149 :    
150 :     fun hex(0w0,y) = W.toString y
151 :     | hex(x,y) =
152 :     let val a = W.toString x
153 :     val b = W.toString y
154 :     in a^padZero(b,8-size b) end
155 :    
156 :     fun bin(0w0,y) = W.fmt StringCvt.BIN y
157 :     | bin(x,y) =
158 :     let val a = W.fmt StringCvt.BIN x
159 :     val b = W.fmt StringCvt.BIN y
160 :     in a^padZero(b,32-size b) end
161 :    
162 :     fun fmt StringCvt.BIN = bin
163 :     | fmt StringCvt.DEC = raise Match
164 :     | fmt StringCvt.HEX = hex
165 :     | fmt StringCvt.OCT = raise Match
166 :    
167 :     val toString = hex
168 :    
169 :     val scan = fn _ => raise Match
170 :     fun fromString s =
171 :     case W.fromString s of
172 :     SOME w => SOME(0w0:W.word,w)
173 :     | NONE => NONE
174 :    
175 :     val op < = lt
176 :     val op <= = le
177 :     val op > = gt
178 :     val op >= = ge
179 :     val op * = mult
180 :     val op + = plus
181 :     val op - = minus
182 :     val op << = sll
183 :     val op >> = srl
184 :     val op ~>> = sra
185 :     val op div = divide
186 :     fun op mod(a:word,b:word):word = a-(a div b)*b
187 :    
188 :     end

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