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 /MLRISC/trunk/mltree/mltree-mult.sml
ViewVC logotype

Annotation of /MLRISC/trunk/mltree/mltree-mult.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 429 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/mltree/mltree-mult.sml

1 : monnier 409 (*
2 :     * Generate multiplication/division by a constant.
3 :     * This module is mainly used for architectures without fast integer multiply.
4 :     *
5 :     * -- Allen
6 :     *)
7 :     functor MLTreeMult
8 :     (structure T : MLTREE
9 :     where type rounding_mode = MLTreeBasis.rounding_mode
10 :     structure I : INSTRUCTIONS
11 :     sharing I.Constant = T.Constant
12 :    
13 :     val intTy : int (* width of integer type *)
14 :    
15 : monnier 429 type argi = {r:I.C.cell, i:int, d:I.C.cell}
16 :     type arg = {r1:I.C.cell, r2:I.C.cell, d:I.C.cell}
17 : monnier 409
18 :     (* these are always non-overflow trapping *)
19 : monnier 429 val mov : {r:I.C.cell,d:I.C.cell} -> I.instruction
20 : monnier 409 val add : arg -> I.instruction
21 :     val slli : argi -> I.instruction list
22 :     val srli : argi -> I.instruction list
23 :     val srai : argi -> I.instruction list
24 :     )
25 :     (val trapping : bool (* trap on overflow? *)
26 :     val multCost : int ref (* cost of multiplication *)
27 :    
28 :     (* basic ops; these have to implemented by the architecture *)
29 :    
30 :     (* if trapping = true, then the following MUST trap on overflow *)
31 :     val addv : arg -> I.instruction list
32 :     val subv : arg -> I.instruction list
33 :    
34 :     (* some architectures, like the PA-RISC and the Alpha,
35 :     * have these types of special ops
36 :     * if trapping = true, then the following MUST also trap on overflow
37 :     *)
38 :     val sh1addv : (arg -> I.instruction list) option (* a*2 + b *)
39 :     val sh2addv : (arg -> I.instruction list) option (* a*4 + b *)
40 :     val sh3addv : (arg -> I.instruction list) option (* a*8 + b *)
41 : monnier 429 )
42 :     (val signed : bool (* signed? *)
43 :     ) : MLTREE_MULT_DIV =
44 : monnier 409 struct
45 :     structure T = T
46 :     structure I = I
47 :     structure C = I.C
48 :     structure W = Word
49 :     structure A = Array
50 :    
51 :     type arg = argi
52 :    
53 :     infix << >> ~>> || &&
54 :     val itow = W.fromInt
55 :     val wtoi = W.toIntX
56 :     val op << = W.<<
57 :     val op >> = W.>>
58 :     val op ~>> = W.~>>
59 :     val op || = W.orb
60 :     val op && = W.andb
61 :    
62 :     exception TooComplex
63 :    
64 :     fun error msg = MLRiscErrorMsg.error("MLTreeMult",msg)
65 :    
66 :     val zeroR = C.zeroReg C.GP
67 :     val shiftri = if signed then srai else srli
68 :    
69 :     fun isPowerOf2 w = ((w - 0w1) && w) = 0w0
70 :    
71 :     fun log2 n = (* n must be > 0!!! *)
72 :     let fun loop(0w1,pow) = pow
73 :     | loop(w,pow) = loop(w >> 0w1,pow+1)
74 :     in loop(n,0) end
75 :    
76 :     fun zeroBits(w,lowZeroBits) =
77 :     if (w && 0w1) = 0w1 then (w,lowZeroBits)
78 :     else zeroBits(w >> 0w1,lowZeroBits+0w1)
79 :    
80 :     (* Non overflow trapping version of multiply:
81 :     * We can use add, shadd, shift, sub to perform the multiplication
82 :     *)
83 :     fun multiplyNonTrap{r,i,d} =
84 :     let fun mult(r,w,maxCost,d) =
85 :     if maxCost <= 0 then raise TooComplex
86 :     else if isPowerOf2 w then slli{r=r,i=log2 w,d=d}
87 :     else
88 :     (case (w,sh1addv,sh2addv,sh3addv) of
89 :     (* some base cases *)
90 :     (0w3,SOME f,_,_) => f{r1=r,r2=r,d=d}
91 :     | (0w5,_,SOME f,_) => f{r1=r,r2=r,d=d}
92 :     | (0w9,_,_,SOME f) => f{r1=r,r2=r,d=d}
93 :     | _ => (* recurse on the bit patterns of w *)
94 :     let val tmp = C.newReg()
95 :     in if (w && 0w1) = 0w1 then (* low order bit is 1 *)
96 :     if (w && 0w2) = 0w2 then (* second bit is 1 *)
97 :     mult(r,w+0w1,maxCost-1,tmp) @
98 :     subv{r1=tmp,r2=r,d=d}
99 :     else (* second bit is 0 *)
100 :     mult(r,w-0w1,maxCost-1,tmp) @
101 :     addv{r1=tmp,r2=r,d=d}
102 :     else (* low order bit is 0 *)
103 :     let val (w,lowZeroBits) = zeroBits(w,0w0)
104 :     in mult(r,w,maxCost-1,tmp) @
105 :     slli{r=tmp,i=wtoi lowZeroBits,d=d}
106 :     end
107 :     end
108 :     )
109 :     in if i <= 0 then raise TooComplex
110 :     else if i = 1 then [mov{r=r,d=d}]
111 :     else mult(r,itow i,!multCost,d)
112 :     end
113 :    
114 :     (*
115 :     * Simulate rounding towards zero for signed division
116 :     *)
117 :     fun roundDiv{mode=T.TO_NEGINF,r,...} = ([],r) (* no rounding necessary *)
118 :     | roundDiv{mode=T.TO_ZERO,roundToZero,r,i} =
119 :     if signed then
120 :     let val d = C.newReg()
121 :     in if i = 2 then (* special case for division by 2 *)
122 :     let val tmpR = C.newReg()
123 :     in (srli{r=r,i=intTy - 1,d=tmpR}@[add{r1=r,r2=tmpR,d=d}], d)
124 :     end
125 :     else
126 :     (* invoke rounding callback *)
127 :     let val () = roundToZero{ty=intTy,r=r,i=i-1,d=d}
128 :     in ([],d) end
129 :     end
130 :     else ([],r) (* no rounding for unsigned division *)
131 :     | roundDiv{mode,...} =
132 :     error("Integer rounding mode "^
133 :     MLTreeUtil.roundingModeToString mode^" is not supported")
134 :    
135 :     fun divideNonTrap{mode,roundToZero}{r,i,d} =
136 :     if i > 0 andalso isPowerOf2(itow i)
137 :     then
138 :     let val (code,r) = roundDiv{mode=mode,roundToZero=roundToZero,r=r,i=i}
139 :     in code@shiftri{r=r,i=log2(itow i),d=d} end (* won't overflow *)
140 :     else raise TooComplex
141 :    
142 :     (* Overflow trapping version of multiply:
143 :     * We can use only add and shadd to perform the multiplication,
144 :     * because of overflow trapping problem.
145 :     *)
146 :     fun multiplyTrap{r,i,d} =
147 :     let fun mult(r,w,maxCost,d) =
148 :     if maxCost <= 0 then raise TooComplex
149 :     else
150 :     (case (w,sh1addv,sh2addv,sh3addv,zeroR) of
151 :     (* some simple base cases *)
152 :     (0w2,_,_,_,_) => addv{r1=r,r2=r,d=d}
153 :     | (0w3,SOME f,_,_,_) => f{r1=r,r2=r,d=d}
154 :     | (0w4,_,SOME f,_,SOME z) => f{r1=r,r2=z,d=d}
155 :     | (0w5,_,SOME f,_,_) => f{r1=r,r2=r,d=d}
156 :     | (0w8,_,_,SOME f,SOME z) => f{r1=r,r2=z,d=d}
157 :     | (0w9,_,_,SOME f,_) => f{r1=r,r2=r,d=d}
158 :     | _ => (* recurse on the bit patterns of w *)
159 :     let val tmp = C.newReg()
160 :     in if (w && 0w1) = 0w1 then
161 :     mult(r,w - 0w1,maxCost-1,tmp) @ addv{r1=tmp,r2=r,d=d}
162 :     else
163 :     case (w && 0w7, sh3addv, zeroR) of
164 :     (0w0, SOME f, SOME z) => (* times 8 *)
165 :     mult(r,w >> 0w3,maxCost-1,tmp) @ f{r1=tmp,r2=z,d=d}
166 :     | _ =>
167 :     case (w && 0w3, sh2addv, zeroR) of
168 :     (0w0, SOME f, SOME z) => (* times 4 *)
169 :     mult(r,w >> 0w2,maxCost-1,tmp) @ f{r1=tmp,r2=z,d=d}
170 :     | _ =>
171 :     mult(r,w >> 0w1,maxCost-1,tmp) @ addv{r1=tmp,r2=tmp,d=d}
172 :     end
173 :     )
174 :     in if i <= 0 then raise TooComplex
175 :     else if i = 1 then [mov{r=r,d=d}]
176 :     else mult(r,itow i,!multCost,d)
177 :     end
178 :    
179 :     fun divideTrap{mode,roundToZero}{r,i,d} =
180 :     if i > 0 andalso isPowerOf2(itow i)
181 :     then
182 :     let val (code,r) = roundDiv{mode=mode,roundToZero=roundToZero,r=r,i=i}
183 :     in code@shiftri{r=r,i=log2(itow i),d=d} end (* won't overflow *)
184 :     else raise TooComplex
185 :    
186 :     val multiply = if trapping then multiplyTrap else multiplyNonTrap
187 :     val divide = if trapping then divideTrap else divideNonTrap
188 :    
189 :     end

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