1 : |
macqueen |
1976 |
(* Copyright 2006 by the Standard ML Fellowship *)
|
2 : |
|
|
(* primopmap.sml *)
|
3 : |
|
|
|
4 : |
|
|
(* The module PrimOpTypeMap provides a table mapping all the primops formerly
|
5 : |
|
|
* defined in the InLine structure to their intrinsic types. The table is
|
6 : |
|
|
* indexed by the primop names defined used in InLine.
|
7 : |
|
|
* The table is given in the form of the primopTypeMap function, which maps
|
8 : |
|
|
* a primop name to the "intrinsic" type (the type formerly used for
|
9 : |
|
|
* the primop in InLine).
|
10 : |
|
|
*
|
11 : |
|
|
* The translate phase will use this table to lookup names in the primId field
|
12 : |
|
|
* of variables when translating variables.
|
13 : |
|
|
*)
|
14 : |
|
|
|
15 : |
|
|
signature PRIMOP_TYPE_MAP =
|
16 : |
|
|
sig
|
17 : |
|
|
val primopTypeMap : string -> Types.ty option
|
18 : |
|
|
end (* signature PRIMOP_MAP *)
|
19 : |
|
|
|
20 : |
|
|
|
21 : |
|
|
structure PrimOpTypeMap : PRIMOP_TYPE_MAP =
|
22 : |
|
|
struct
|
23 : |
|
|
|
24 : |
|
|
structure T = Types
|
25 : |
|
|
structure BT = BasicTypes
|
26 : |
|
|
|
27 : |
|
|
structure StringKey : ORD_KEY =
|
28 : |
|
|
struct
|
29 : |
|
|
type ord_key = string
|
30 : |
|
|
val compare = String.compare
|
31 : |
|
|
end
|
32 : |
|
|
|
33 : |
|
|
structure RBMap = RedBlackMapFn(StringKey)
|
34 : |
|
|
|
35 : |
|
|
fun bug msg = ErrorMsg.impossible("PrimOpMap: " ^ msg)
|
36 : |
|
|
|
37 : |
|
|
(**************************************************************************
|
38 : |
|
|
* BUILDING A COMPLETE LIST OF PRIMOPS *
|
39 : |
|
|
**************************************************************************)
|
40 : |
|
|
|
41 : |
|
|
|
42 : |
|
|
fun bits size oper = P.ARITH{oper=oper, overflow=false, kind=P.INT size}
|
43 : |
|
|
val bits31 = bits 31
|
44 : |
|
|
val bits32 = bits 32
|
45 : |
|
|
|
46 : |
|
|
fun int size oper = P.ARITH{oper=oper, overflow=true, kind=P.INT size}
|
47 : |
|
|
val int31 = int 31
|
48 : |
|
|
val int32 = int 32
|
49 : |
|
|
|
50 : |
|
|
fun word size oper = P.ARITH{oper=oper, overflow=false, kind=P.UINT size}
|
51 : |
|
|
val word32 = word 32
|
52 : |
|
|
val word31 = word 31
|
53 : |
|
|
val word8 = word 8
|
54 : |
|
|
|
55 : |
|
|
fun purefloat size oper = P.ARITH{oper=oper,overflow=false,kind=P.FLOAT size}
|
56 : |
|
|
val purefloat64 = purefloat 64
|
57 : |
|
|
|
58 : |
|
|
fun cmp kind oper = P.CMP{oper=oper, kind=kind}
|
59 : |
|
|
val int31cmp = cmp (P.INT 31)
|
60 : |
|
|
val int32cmp = cmp (P.INT 32)
|
61 : |
|
|
|
62 : |
|
|
val word32cmp = cmp (P.UINT 32)
|
63 : |
|
|
val word31cmp = cmp (P.UINT 31)
|
64 : |
|
|
val word8cmp = cmp (P.UINT 8)
|
65 : |
|
|
|
66 : |
|
|
val float64cmp = cmp (P.FLOAT 64)
|
67 : |
|
|
|
68 : |
|
|
val v1 = T.IBOUND 0
|
69 : |
|
|
val v2 = T.IBOUND 1
|
70 : |
|
|
val v3 = T.IBOUND 2
|
71 : |
|
|
|
72 : |
|
|
val tu = BT.tupleTy
|
73 : |
|
|
fun ar(t1,t2) = BT.--> (t1, t2)
|
74 : |
|
|
|
75 : |
|
|
fun ap(tc,l) = T.CONty(tc, l)
|
76 : |
|
|
fun cnt t = T.CONty(BT.contTycon,[t])
|
77 : |
|
|
fun ccnt t = T.CONty(BT.ccontTycon,[t])
|
78 : |
|
|
fun rf t = T.CONty(BT.refTycon,[t])
|
79 : |
|
|
fun ay t = T.CONty(BT.arrayTycon,[t])
|
80 : |
|
|
fun vct t = T.CONty(BT.vectorTycon,[t])
|
81 : |
|
|
|
82 : |
|
|
val u = BT.unitTy
|
83 : |
|
|
val bo = BT.boolTy
|
84 : |
|
|
val i = BT.intTy
|
85 : |
|
|
val i32 = BT.int32Ty
|
86 : |
|
|
val i64 = BT.int64Ty
|
87 : |
|
|
val inf = BT.intinfTy
|
88 : |
|
|
val w8 = BT.word8Ty
|
89 : |
|
|
val w = BT.wordTy
|
90 : |
|
|
val w32 = BT.word32Ty
|
91 : |
|
|
val w64 = BT.word64Ty
|
92 : |
|
|
val f64 = BT.realTy
|
93 : |
|
|
val s = BT.stringTy
|
94 : |
|
|
|
95 : |
|
|
fun p0 t = t
|
96 : |
|
|
fun p1 t = T.POLYty {sign=[false], tyfun=T.TYFUN {arity=1, body=t}}
|
97 : |
|
|
fun ep1 t = T.POLYty {sign=[true], tyfun=T.TYFUN {arity=1, body=t}}
|
98 : |
|
|
fun p2 t = T.POLYty {sign=[false,false], tyfun=T.TYFUN {arity=2, body=t}}
|
99 : |
|
|
fun p3 t = T.POLYty {sign=[false,false,false], tyfun=T.TYFUN {arity=3, body=t}}
|
100 : |
|
|
|
101 : |
|
|
fun sub kind = P.NUMSUBSCRIPT{kind=kind, checked=false, immutable=false}
|
102 : |
|
|
fun chkSub kind = P.NUMSUBSCRIPT{kind=kind, checked=true, immutable=false}
|
103 : |
|
|
|
104 : |
|
|
fun subv kind = P.NUMSUBSCRIPT{kind=kind, checked=false, immutable=true}
|
105 : |
|
|
fun chkSubv kind = P.NUMSUBSCRIPT{kind=kind, checked=true, immutable=true}
|
106 : |
|
|
|
107 : |
|
|
fun update kind = P.NUMUPDATE {kind=kind, checked=false}
|
108 : |
|
|
fun chkUpdate kind = P.NUMUPDATE {kind=kind, checked=true}
|
109 : |
|
|
|
110 : |
|
|
val numSubTy = p2(ar(tu[v1,i],v2))
|
111 : |
|
|
val numUpdTy = p2(ar(tu[v1,i,v2],u))
|
112 : |
|
|
|
113 : |
|
|
fun unf t = p0(ar(t,t))
|
114 : |
|
|
fun binf t = p0(ar(tu[t,t],t))
|
115 : |
|
|
fun binp t = p0(ar(tu[t,t],bo))
|
116 : |
|
|
fun shifter t = p0(ar(tu[t,w],t))
|
117 : |
|
|
|
118 : |
|
|
val w32_i32 = p0(ar(w32,i32))
|
119 : |
|
|
val w32_f64 = p0(ar(w32,f64))
|
120 : |
|
|
val w32w32_u = p0(ar(tu[w32,w32],u))
|
121 : |
|
|
val w32i32_u = p0(ar(tu[w32,i32],u))
|
122 : |
|
|
val w32f64_u = p0(ar(tu[w32,f64],u))
|
123 : |
|
|
|
124 : |
|
|
val i_x = p1(ar(i,v1))
|
125 : |
|
|
val xw32_w32 = p1(ar(tu[v1,w32],w32))
|
126 : |
|
|
val xw32_i32 = p1(ar(tu[v1,w32],i32))
|
127 : |
|
|
val xw32_f64 = p1(ar(tu[v1,w32],f64))
|
128 : |
|
|
val xw32w32_u = p1(ar(tu[v1,w32,w32],u))
|
129 : |
|
|
val xw32i32_u = p1(ar(tu[v1,w32,i32],u))
|
130 : |
|
|
val xw32f64_u = p1(ar(tu[v1,w32,f64],u))
|
131 : |
|
|
|
132 : |
|
|
val b_b = unf bo
|
133 : |
|
|
|
134 : |
|
|
val f64_i = p0(ar(f64,i))
|
135 : |
|
|
val i_f64 = p0(ar(i,f64))
|
136 : |
|
|
val i32_f64 = p0(ar(i32,f64))
|
137 : |
|
|
|
138 : |
|
|
val w32_i = p0(ar(w32,i))
|
139 : |
|
|
val i32_i = p0(ar(i32,i))
|
140 : |
|
|
|
141 : |
|
|
val i_i32 = p0(ar(i,i32))
|
142 : |
|
|
val i_w32 = p0(ar(i,w32))
|
143 : |
|
|
|
144 : |
|
|
val w32_w = p0(ar(w32,w))
|
145 : |
|
|
val i32_w = p0(ar(i32,w))
|
146 : |
|
|
|
147 : |
|
|
val w_w32 = p0(ar(w,w32))
|
148 : |
|
|
val w_i32 = p0(ar(w,i32))
|
149 : |
|
|
|
150 : |
|
|
val w_i = p0(ar(w,i))
|
151 : |
|
|
val i_w = p0(ar(i,w))
|
152 : |
|
|
|
153 : |
|
|
val w32_i32 = p0(ar(w32,i32))
|
154 : |
|
|
val i32_w32 = p0(ar(i32,w32))
|
155 : |
|
|
|
156 : |
|
|
val i_i = unf i
|
157 : |
|
|
val ii_i = binf i
|
158 : |
|
|
val ii_b = binp i
|
159 : |
|
|
val iw_i = shifter i
|
160 : |
|
|
|
161 : |
|
|
val w_w = unf w
|
162 : |
|
|
val ww_w = binf w
|
163 : |
|
|
val ww_b = binp w
|
164 : |
|
|
|
165 : |
|
|
val i32_i32 = unf i32
|
166 : |
|
|
val i32i32_i32 = binf i32
|
167 : |
|
|
val i32i32_b = binp i32
|
168 : |
|
|
|
169 : |
|
|
val w32_w32 = unf w32
|
170 : |
|
|
val w32w32_w32 = binf w32
|
171 : |
|
|
val w32w32_b = binp w32
|
172 : |
|
|
val w32w_w32 = shifter w32
|
173 : |
|
|
|
174 : |
|
|
val w8_w8 = unf w8
|
175 : |
|
|
val w8w8_w8 = binf w8
|
176 : |
|
|
val w8w8_b = binp w8
|
177 : |
|
|
val w8w_w8 = shifter w8
|
178 : |
|
|
|
179 : |
|
|
val f64_f64 = unf f64
|
180 : |
|
|
val f64f64_f64 = binf f64
|
181 : |
|
|
val f64f64_b = binp f64
|
182 : |
|
|
|
183 : |
|
|
val w8_i = p0(ar(w8,i))
|
184 : |
|
|
val w8_i32 = p0(ar(w8,i32))
|
185 : |
|
|
val w8_w32 = p0(ar(w8,w32))
|
186 : |
|
|
val i_w8 = p0(ar(i,w8))
|
187 : |
|
|
val i32_w8 = p0(ar(i32,w8))
|
188 : |
|
|
val w32_w8 = p0(ar(w32,w8))
|
189 : |
|
|
|
190 : |
|
|
val inf_i = p0(ar(inf,i))
|
191 : |
|
|
val inf_i32 = p0(ar(inf,i32))
|
192 : |
|
|
val inf_i64 = p0(ar(inf,i64))
|
193 : |
|
|
val inf_w8 = p0(ar(inf,w8))
|
194 : |
|
|
val inf_w = p0(ar(inf,w))
|
195 : |
|
|
val inf_w32 = p0(ar(inf,w32))
|
196 : |
|
|
val inf_w64 = p0(ar(inf,w64))
|
197 : |
|
|
val i_inf = p0(ar(i,inf))
|
198 : |
|
|
val i32_inf = p0(ar(i32,inf))
|
199 : |
|
|
val i64_inf = p0(ar(i64,inf))
|
200 : |
|
|
val w8_inf = p0(ar(w8,inf))
|
201 : |
|
|
val w_inf = p0(ar(w,inf))
|
202 : |
|
|
val w32_inf = p0(ar(w32,inf))
|
203 : |
|
|
val w64_inf = p0(ar(w64,inf))
|
204 : |
|
|
|
205 : |
|
|
val w64_pw32 = p0(ar(w64,tu[w32,w32]))
|
206 : |
|
|
val pw32_w64 = p0(ar(tu[w32,w32],w64))
|
207 : |
|
|
val i64_pw32 = p0(ar(i64,tu[w32,w32]))
|
208 : |
|
|
val pw32_i64 = p0(ar(tu[w32,w32],i64))
|
209 : |
|
|
|
210 : |
|
|
val cc_b = binp BT.charTy
|
211 : |
|
|
|
212 : |
|
|
(* The type of the RAW_CCALL primop (as far as the type checker is concerned)
|
213 : |
|
|
* is:
|
214 : |
|
|
* word32 * 'a * 'b -> 'd
|
215 : |
|
|
* However, the primop cannot be used without having 'a, 'b, and 'c
|
216 : |
|
|
* monomorphically instantiated. In particular, 'a will be the type of the
|
217 : |
|
|
* ML argument list, 'c will be the type of the result, and 'b
|
218 : |
|
|
* will be a type of a fake arguments. The idea is that 'b will be
|
219 : |
|
|
* instantiated with some ML type that encodes the type of the actual
|
220 : |
|
|
* C function in order to be able to generate code according to the C
|
221 : |
|
|
* calling convention.
|
222 : |
|
|
* (In other words, 'b will be a completely ad-hoc encoding of a CTypes.c_proto
|
223 : |
|
|
* value in ML types. The encoding also contains information about
|
224 : |
|
|
* calling conventions and reentrancy.)
|
225 : |
|
|
*)
|
226 : |
|
|
val rccType = p3(ar(tu[w32,v1,v2],v3))
|
227 : |
|
|
|
228 : |
|
|
(*
|
229 : |
|
|
* I made an effort to eliminate the cases where type info for primops
|
230 : |
|
|
* is left NONE because this is, in fact, incorrect. (As long as they
|
231 : |
|
|
* are left at NONE, there are correct ML programs that trigger internal
|
232 : |
|
|
* compiler errors.)
|
233 : |
|
|
* - M.Blume (1/2001)
|
234 : |
|
|
*)
|
235 : |
|
|
|
236 : |
|
|
|
237 : |
|
|
val empty = RBMap.empty
|
238 : |
|
|
|
239 : |
|
|
(* Below there is a bunch of very long list literals which would create
|
240 : |
|
|
* huge register pressure on the compiler. We construct them backwards
|
241 : |
|
|
* using an alternative "cons" that takes its two arguments in opposite
|
242 : |
|
|
* order. This effectively puts the lists' ends to the left and alleviates
|
243 : |
|
|
* this effect. (Stupid ML trick No. 21b) (Blume, 1/2001) *)
|
244 : |
|
|
infix :-:
|
245 : |
|
|
fun m :-: (name,entry) = RBMap.insert(m,name,entry)
|
246 : |
|
|
|
247 : |
|
|
val primopTypes =
|
248 : |
|
|
empty :-:
|
249 : |
|
|
("callcc", (p1(ar(ar(cnt(v1),v1),v1)))) :-:
|
250 : |
|
|
("throw", (p2(ar(cnt(v1),ar(v1,v2))))) :-:
|
251 : |
|
|
("capture", (p1(ar(ar(ccnt(v1),v1),v1)))) :-:
|
252 : |
|
|
("isolate", (p1(ar(ar(v1,u),cnt(v1))))) :-:
|
253 : |
|
|
("cthrow", (p2(ar(ccnt(v1),ar(v1,v2))))) :-:
|
254 : |
|
|
("!", (p1(ar(rf(v1),v1)))) :-:
|
255 : |
|
|
(":=", (p1(ar(tu[rf(v1),v1],u)))) :-:
|
256 : |
|
|
("makeref", (p1(ar(v1,rf(v1))))) :-:
|
257 : |
|
|
("boxed", (p1(ar(v1,bo)))) :-:
|
258 : |
|
|
("unboxed", (p1(ar(v1,bo)))) :-:
|
259 : |
|
|
("cast", (p2(ar(v1,v2)))) :-:
|
260 : |
|
|
("=", (ep1(ar(tu[v1,v1],bo)))) :-:
|
261 : |
|
|
("<>", (ep1(ar(tu[v1,v1],bo)))) :-:
|
262 : |
|
|
("ptreql", (p1(ar(tu[v1,v1],bo)))) :-:
|
263 : |
|
|
("ptrneq", (p1(ar(tu[v1,v1],bo)))) :-:
|
264 : |
|
|
("getvar", (p1(ar(u,v1)))) :-:
|
265 : |
|
|
("setvar", (p1(ar(v1,u)))) :-:
|
266 : |
|
|
("setpseudo", (p1(ar(tu[v1,i],u)))) :-:
|
267 : |
|
|
("getpseudo", (p1(ar(i,v1)))) :-:
|
268 : |
|
|
("mkspecial", (p2(ar(tu[i,v1],v2)))) :-:
|
269 : |
|
|
("getspecial", (p1(ar(v1,i)))) :-:
|
270 : |
|
|
("setspecial", (p1(ar(tu[v1,i],u)))) :-:
|
271 : |
|
|
("gethdlr", (p1(ar(u,cnt(v1))))) :-:
|
272 : |
|
|
("sethdlr", (p1(ar(cnt(v1),u)))) :-:
|
273 : |
|
|
("gettag", (p1(ar(v1,i)))) :-:
|
274 : |
|
|
("setmark", (p1(ar(v1,u)))) :-:
|
275 : |
|
|
("dispose", (p1(ar(v1,u)))) :-:
|
276 : |
|
|
("compose", (p3(ar(tu[ar(v2,v3),ar(v1,v2)],ar(v1,v3))))) :-:
|
277 : |
|
|
("before", (p2(ar(tu[v1,v2],v1)))) :-:
|
278 : |
|
|
("ignore", (p1(ar(v1,u)))) :-:
|
279 : |
|
|
("identity", (p1(ar(v1,v1)))) :-:
|
280 : |
|
|
|
281 : |
|
|
|
282 : |
|
|
("length", (p1(ar(v1,i)))) :-:
|
283 : |
|
|
("objlength", (p1(ar(v1,i)))) :-:
|
284 : |
|
|
|
285 : |
|
|
(*
|
286 : |
|
|
* I believe the following five primops should not be exported into
|
287 : |
|
|
* the InLine structure. (ZHONG)
|
288 : |
|
|
*)
|
289 : |
|
|
(* So we take them out... (Matthias)
|
290 : |
|
|
("boxedupdate", P.BOXEDUPDATE, ?) :-:
|
291 : |
|
|
("getrunvec", P.GETRUNVEC, ?) :-:
|
292 : |
|
|
("uselvar", P.USELVAR, ?) :-:
|
293 : |
|
|
("deflvar", P.DEFLVAR, ?) :-:
|
294 : |
|
|
*)
|
295 : |
|
|
|
296 : |
|
|
(* I put this one back in so tprof can find it in _Core
|
297 : |
|
|
* instead of having to construct it ... (Matthias) *)
|
298 : |
|
|
("unboxedupdate", (p1(ar(tu[ay(v1),i,v1],u)))) :-:
|
299 : |
|
|
|
300 : |
|
|
("inlnot", (b_b)) :-:
|
301 : |
|
|
("floor", (f64_i)) :-:
|
302 : |
|
|
("round", (f64_i)) :-:
|
303 : |
|
|
("real", (i_f64)) :-:
|
304 : |
|
|
("real32", (i32_f64)) :-:
|
305 : |
|
|
|
306 : |
|
|
("ordof", (numSubTy)) :-:
|
307 : |
|
|
("store", (numUpdTy)) :-:
|
308 : |
|
|
("inlbyteof", (numSubTy)) :-:
|
309 : |
|
|
("inlstore", (numUpdTy)) :-:
|
310 : |
|
|
("inlordof", (numSubTy)) :-:
|
311 : |
|
|
|
312 : |
|
|
(*** polymorphic array and vector ***)
|
313 : |
|
|
("mkarray", (p1(ar(tu[i,v1],ay(v1))))) :-:
|
314 : |
|
|
("arrSub", (p1(ar(tu[ay(v1),i],v1)))) :-:
|
315 : |
|
|
("arrChkSub", (p1(ar(tu[ay(v1),i],v1)))) :-:
|
316 : |
|
|
("vecSub", (p1(ar(tu[vct(v1),i],v1)))) :-:
|
317 : |
|
|
("vecChkSub", (p1(ar(tu[vct(v1),i],v1)))) :-:
|
318 : |
|
|
("arrUpdate", (p1(ar(tu[ay(v1),i,v1],u)))) :-:
|
319 : |
|
|
("arrChkUpdate", (p1(ar(tu[ay(v1),i,v1],u)))) :-:
|
320 : |
|
|
|
321 : |
|
|
(* new array representations *)
|
322 : |
|
|
("newArray0", (p1(ar(u,v1)))) :-:
|
323 : |
|
|
("getSeqData", (p2(ar(v1, v2)))) :-:
|
324 : |
|
|
("recordSub", (p2(ar(tu[v1,i],v2)))) :-:
|
325 : |
|
|
("raw64Sub", (p1(ar(tu[v1,i],f64)))) :-:
|
326 : |
|
|
|
327 : |
|
|
(* *** conversion primops ***
|
328 : |
|
|
* There are certain duplicates for the same primop (but with
|
329 : |
|
|
* different types). In such a case, the "canonical" name
|
330 : |
|
|
* of the primop has been extended using a simple suffix
|
331 : |
|
|
* scheme. *)
|
332 : |
|
|
("test_32_31_w", (w32_i)) :-:
|
333 : |
|
|
("test_32_31_i", (i32_i)) :-:
|
334 : |
|
|
|
335 : |
|
|
("testu_31_31", (w_i)) :-:
|
336 : |
|
|
|
337 : |
|
|
("testu_32_31", (w32_i)) :-:
|
338 : |
|
|
|
339 : |
|
|
("testu_32_32", (w32_i32)) :-:
|
340 : |
|
|
|
341 : |
|
|
("copy_32_32_ii", (i32_i32)) :-:
|
342 : |
|
|
("copy_32_32_wi", (w32_i32)) :-:
|
343 : |
|
|
("copy_32_32_iw", (i32_w32)) :-:
|
344 : |
|
|
("copy_32_32_ww", (w32_w32)) :-:
|
345 : |
|
|
|
346 : |
|
|
("copy_31_31_ii", (i_i)) :-:
|
347 : |
|
|
("copy_31_31_wi", (w_i)) :-:
|
348 : |
|
|
("copy_31_31_iw", (i_w)) :-:
|
349 : |
|
|
|
350 : |
|
|
("copy_31_32_i", (w_i32)) :-:
|
351 : |
|
|
("copy_31_32_w", (w_w32)) :-:
|
352 : |
|
|
|
353 : |
|
|
("copy_8_32_i", (w8_i32)) :-:
|
354 : |
|
|
("copy_8_32_w", (w8_w32)) :-:
|
355 : |
|
|
|
356 : |
|
|
("copy_8_31", (w8_i)) :-:
|
357 : |
|
|
|
358 : |
|
|
("extend_31_32_ii", (i_i32)) :-:
|
359 : |
|
|
("extend_31_32_iw", (i_w32)) :-:
|
360 : |
|
|
("extend_31_32_wi", (w_i32)) :-:
|
361 : |
|
|
("extend_31_32_ww", (w_w32)) :-:
|
362 : |
|
|
|
363 : |
|
|
("extend_8_31", (w8_i)) :-:
|
364 : |
|
|
|
365 : |
|
|
("extend_8_32_i", (w8_i32)) :-:
|
366 : |
|
|
("extend_8_32_w", (w8_w32)) :-:
|
367 : |
|
|
|
368 : |
|
|
("trunc_32_31_i", (i32_w)) :-:
|
369 : |
|
|
("trunc_32_31_w", (w32_w)) :-:
|
370 : |
|
|
|
371 : |
|
|
("trunc_31_8", (i_w8)) :-:
|
372 : |
|
|
|
373 : |
|
|
("trunc_32_8_i", (i32_w8)) :-:
|
374 : |
|
|
("trunc_32_8_w", (w32_w8)) :-:
|
375 : |
|
|
|
376 : |
|
|
(* conversion primops involving intinf *)
|
377 : |
|
|
("test_inf_31", (inf_i)) :-:
|
378 : |
|
|
("test_inf_32", (inf_i32)) :-:
|
379 : |
|
|
("test_inf_64", (inf_i64)) :-:
|
380 : |
|
|
("copy_8_inf", (w8_inf)) :-:
|
381 : |
|
|
("copy_8_inf_w", (w8_inf)) :-:
|
382 : |
|
|
("copy_31_inf_w", (w_inf)) :-:
|
383 : |
|
|
("copy_32_inf_w", (w32_inf)) :-:
|
384 : |
|
|
("copy_64_inf_w", (w64_inf)) :-:
|
385 : |
|
|
("copy_31_inf_i", (i_inf)) :-:
|
386 : |
|
|
("copy_32_inf_i", (i32_inf)) :-:
|
387 : |
|
|
("copy_64_inf_i", (i64_inf)) :-:
|
388 : |
|
|
("extend_8_inf", (w8_inf)) :-:
|
389 : |
|
|
("extend_8_inf_w", (w8_inf)) :-:
|
390 : |
|
|
("extend_31_inf_w", (w_inf)) :-:
|
391 : |
|
|
("extend_32_inf_w", (w32_inf)) :-:
|
392 : |
|
|
("extend_64_inf_w", (w64_inf)) :-:
|
393 : |
|
|
("extend_31_inf_i", (i_inf)) :-:
|
394 : |
|
|
("extend_32_inf_i", (i32_inf)) :-:
|
395 : |
|
|
("extend_64_inf_i", (i64_inf)) :-:
|
396 : |
|
|
("trunc_inf_8", (inf_w8)) :-:
|
397 : |
|
|
("trunc_inf_31", (inf_w)) :-:
|
398 : |
|
|
("trunc_inf_32", (inf_w32)) :-:
|
399 : |
|
|
("trunc_inf_64", (inf_w64)) :-:
|
400 : |
|
|
|
401 : |
|
|
(* primops to go between abstract and concrete representation of
|
402 : |
|
|
* 64-bit ints and words *)
|
403 : |
|
|
("w64p", (w64_pw32)) :-:
|
404 : |
|
|
("p64w", (pw32_w64)) :-:
|
405 : |
|
|
("i64p", (i64_pw32)) :-:
|
406 : |
|
|
("p64i", (pw32_i64)) :-:
|
407 : |
|
|
|
408 : |
|
|
(* *** integer 31 primops ***
|
409 : |
|
|
* Many of the i31 primops are being abused for different types
|
410 : |
|
|
* (mostly Word8.word and also for char). In these cases
|
411 : |
|
|
* there are suffixed alternative versions of the primop
|
412 : |
|
|
* (i.e., same primop, different type). *)
|
413 : |
|
|
("i31add", (ii_i)) :-:
|
414 : |
|
|
("i31add_8", (w8w8_w8)) :-:
|
415 : |
|
|
|
416 : |
|
|
("i31sub", (ii_i)) :-:
|
417 : |
|
|
("i31sub_8", (w8w8_w8)) :-:
|
418 : |
|
|
|
419 : |
|
|
("i31mul", (ii_i)) :-:
|
420 : |
|
|
("i31mul_8", (w8w8_w8)) :-:
|
421 : |
|
|
|
422 : |
|
|
("i31div", (ii_i)) :-:
|
423 : |
|
|
("i31div_8", (w8w8_w8)) :-:
|
424 : |
|
|
|
425 : |
|
|
("i31mod", (ii_i)) :-:
|
426 : |
|
|
("i31mod_8", (w8w8_w8)) :-:
|
427 : |
|
|
|
428 : |
|
|
("i31quot", (ii_i)) :-:
|
429 : |
|
|
|
430 : |
|
|
("i31rem", (ii_i)) :-:
|
431 : |
|
|
|
432 : |
|
|
("i31orb", (ii_i)) :-:
|
433 : |
|
|
("i31orb_8", (w8w8_w8)) :-:
|
434 : |
|
|
|
435 : |
|
|
("i31andb", (ii_i)) :-:
|
436 : |
|
|
("i31andb_8", (w8w8_w8)) :-:
|
437 : |
|
|
|
438 : |
|
|
("i31xorb", (ii_i)) :-:
|
439 : |
|
|
("i31xorb_8", (w8w8_w8)) :-:
|
440 : |
|
|
|
441 : |
|
|
("i31notb", (i_i)) :-:
|
442 : |
|
|
("i31notb_8", (w8_w8)) :-:
|
443 : |
|
|
|
444 : |
|
|
("i31neg", (i_i)) :-:
|
445 : |
|
|
("i31neg_8", (w8_w8)) :-:
|
446 : |
|
|
|
447 : |
|
|
("i31lshift", (ii_i)) :-:
|
448 : |
|
|
("i31lshift_8", (w8w_w8)) :-:
|
449 : |
|
|
|
450 : |
|
|
("i31rshift", (ii_i)) :-:
|
451 : |
|
|
("i31rshift_8", (w8w_w8)) :-:
|
452 : |
|
|
|
453 : |
|
|
("i31lt", (ii_b)) :-:
|
454 : |
|
|
("i31lt_8", (w8w8_b)) :-:
|
455 : |
|
|
("i31lt_c", (cc_b)) :-:
|
456 : |
|
|
|
457 : |
|
|
("i31le", (ii_b)) :-:
|
458 : |
|
|
("i31le_8", (w8w8_b)) :-:
|
459 : |
|
|
("i31le_c", (cc_b)) :-:
|
460 : |
|
|
|
461 : |
|
|
("i31gt", (ii_b)) :-:
|
462 : |
|
|
("i31gt_8", (w8w8_b)) :-:
|
463 : |
|
|
("i31gt_c", (cc_b)) :-:
|
464 : |
|
|
|
465 : |
|
|
("i31ge", (ii_b)) :-:
|
466 : |
|
|
("i31ge_8", (w8w8_b)) :-:
|
467 : |
|
|
("i31ge_c", (cc_b)) :-:
|
468 : |
|
|
|
469 : |
|
|
("i31ltu", (ii_b)) :-:
|
470 : |
|
|
("i31geu", (ii_b)) :-:
|
471 : |
|
|
("i31eq", (ii_b)) :-:
|
472 : |
|
|
("i31ne", (ii_b)) :-:
|
473 : |
|
|
|
474 : |
|
|
("i31min", (ii_i)) :-:
|
475 : |
|
|
("i31min_8", (w8w8_w8)) :-:
|
476 : |
|
|
("i31max", (ii_i)) :-:
|
477 : |
|
|
("i31max_8", (w8w8_w8)) :-:
|
478 : |
|
|
|
479 : |
|
|
("i31abs", (i_i)) :-:
|
480 : |
|
|
|
481 : |
|
|
(*** integer 32 primops ***)
|
482 : |
|
|
("i32mul", (i32i32_i32)) :-:
|
483 : |
|
|
("i32div", (i32i32_i32)) :-:
|
484 : |
|
|
("i32mod", (i32i32_i32)) :-:
|
485 : |
|
|
("i32quot", (i32i32_i32)) :-:
|
486 : |
|
|
("i32rem", (i32i32_i32)) :-:
|
487 : |
|
|
("i32add", (i32i32_i32)) :-:
|
488 : |
|
|
("i32sub", (i32i32_i32)) :-:
|
489 : |
|
|
("i32orb", (i32i32_i32)) :-:
|
490 : |
|
|
("i32andb", (i32i32_i32)) :-:
|
491 : |
|
|
("i32xorb", (i32i32_i32)) :-:
|
492 : |
|
|
("i32lshift", (i32i32_i32)) :-:
|
493 : |
|
|
("i32rshift", (i32i32_i32)) :-:
|
494 : |
|
|
("i32neg", (i32_i32)) :-:
|
495 : |
|
|
("i32lt", (i32i32_b)) :-:
|
496 : |
|
|
("i32le", (i32i32_b)) :-:
|
497 : |
|
|
("i32gt", (i32i32_b)) :-:
|
498 : |
|
|
("i32ge", (i32i32_b)) :-:
|
499 : |
|
|
("i32eq", (i32i32_b)) :-:
|
500 : |
|
|
("i32ne", (i32i32_b)) :-:
|
501 : |
|
|
|
502 : |
|
|
("i32min", (i32i32_i32)) :-:
|
503 : |
|
|
("i32max", (i32i32_i32)) :-:
|
504 : |
|
|
("i32abs", (i32_i32)) :-:
|
505 : |
|
|
|
506 : |
|
|
(*** float 64 primops ***)
|
507 : |
|
|
("f64add", (f64f64_f64)) :-:
|
508 : |
|
|
("f64sub", (f64f64_f64)) :-:
|
509 : |
|
|
("f64div", (f64f64_f64)) :-:
|
510 : |
|
|
("f64mul", (f64f64_f64)) :-:
|
511 : |
|
|
("f64neg", (f64_f64)) :-:
|
512 : |
|
|
("f64ge", (f64f64_b)) :-:
|
513 : |
|
|
("f64gt", (f64f64_b)) :-:
|
514 : |
|
|
("f64le", (f64f64_b)) :-:
|
515 : |
|
|
("f64lt", (f64f64_b)) :-:
|
516 : |
|
|
("f64eq", (f64f64_b)) :-:
|
517 : |
|
|
("f64ne", (f64f64_b)) :-:
|
518 : |
|
|
("f64abs", (f64_f64)) :-:
|
519 : |
|
|
|
520 : |
|
|
("f64sin", (f64_f64)) :-:
|
521 : |
|
|
("f64cos", (f64_f64)) :-:
|
522 : |
|
|
("f64tan", (f64_f64)) :-:
|
523 : |
|
|
("f64sqrt", (f64_f64)) :-:
|
524 : |
|
|
|
525 : |
|
|
("f64min", (f64f64_f64)) :-:
|
526 : |
|
|
("f64max", (f64f64_f64)) :-:
|
527 : |
|
|
|
528 : |
|
|
(*** float64 array ***)
|
529 : |
|
|
("f64Sub", (numSubTy)) :-:
|
530 : |
|
|
("f64chkSub", (numSubTy)) :-:
|
531 : |
|
|
("f64Update", (numUpdTy)) :-:
|
532 : |
|
|
("f64chkUpdate", (numUpdTy)) :-:
|
533 : |
|
|
|
534 : |
|
|
(*** word8 primops ***)
|
535 : |
|
|
(*
|
536 : |
|
|
* In the long run, we plan to represent WRAPPED word8 tagged, and
|
537 : |
|
|
* UNWRAPPED untagged. But right now, we represent both of them
|
538 : |
|
|
* tagged, with 23 high-order zero bits and 1 low-order 1 bit.
|
539 : |
|
|
* In this representation, we can use the comparison and (some of
|
540 : |
|
|
* the) bitwise operators of word31; but we cannot use the shift
|
541 : |
|
|
* and arithmetic operators.
|
542 : |
|
|
*
|
543 : |
|
|
* WARNING: THIS IS A TEMPORARY HACKJOB until all the word8 primops
|
544 : |
|
|
* are correctly implemented.
|
545 : |
|
|
*
|
546 : |
|
|
* ("w8mul", word8 (P.* ), w8w8_w8)) :-:
|
547 : |
|
|
* ("w8div", word8 (P./), w8w8_w8)) :-:
|
548 : |
|
|
* ("w8add", word8 (P.+), w8w8_w8)) :-:
|
549 : |
|
|
* ("w8sub", word8 (P.-), w8w8_w8)) :-:
|
550 : |
|
|
*
|
551 : |
|
|
* ("w8notb", word31 P.NOTB, w8_w8)) :-:
|
552 : |
|
|
* ("w8rshift", word8 P.RSHIFT, w8w_w8)) :-:
|
553 : |
|
|
* ("w8rshiftl", word8 P.RSHIFTL, w8w_w8)) :-:
|
554 : |
|
|
* ("w8lshift", word8 P.LSHIFT, w8w_w8)) :-:
|
555 : |
|
|
*
|
556 : |
|
|
* ("w8toint", P.ROUND{floor=true,
|
557 : |
|
|
* fromkind=P.UINT 8,
|
558 : |
|
|
* tokind=P.INT 31}, w8_i)) :-:
|
559 : |
|
|
* ("w8fromint", P.REAL{fromkind=P.INT 31,
|
560 : |
|
|
* tokind=P.UINT 8}, i_w8)) :-:
|
561 : |
|
|
*)
|
562 : |
|
|
|
563 : |
|
|
("w8orb", (w8w8_w8)) :-:
|
564 : |
|
|
("w8xorb", (w8w8_w8)) :-:
|
565 : |
|
|
("w8andb", (w8w8_w8)) :-:
|
566 : |
|
|
|
567 : |
|
|
("w8gt", (w8w8_b)) :-:
|
568 : |
|
|
("w8ge", (w8w8_b)) :-:
|
569 : |
|
|
("w8lt", (w8w8_b)) :-:
|
570 : |
|
|
("w8le", (w8w8_b)) :-:
|
571 : |
|
|
("w8eq", (w8w8_b)) :-:
|
572 : |
|
|
("w8ne", (w8w8_b)) :-:
|
573 : |
|
|
|
574 : |
|
|
(*** word8 array and vector ***)
|
575 : |
|
|
("w8Sub", (numSubTy)) :-:
|
576 : |
|
|
("w8chkSub", (numSubTy)) :-:
|
577 : |
|
|
("w8subv", (numSubTy)) :-:
|
578 : |
|
|
("w8chkSubv", (numSubTy)) :-:
|
579 : |
|
|
("w8update", (numUpdTy)) :-:
|
580 : |
|
|
("w8chkUpdate", (numUpdTy)) :-:
|
581 : |
|
|
|
582 : |
|
|
(* word31 primops *)
|
583 : |
|
|
("w31mul", (ww_w)) :-:
|
584 : |
|
|
("w31div", (ww_w)) :-:
|
585 : |
|
|
("w31mod", (ww_w)) :-:
|
586 : |
|
|
("w31add", (ww_w)) :-:
|
587 : |
|
|
("w31sub", (ww_w)) :-:
|
588 : |
|
|
("w31orb", (ww_w)) :-:
|
589 : |
|
|
("w31xorb", (ww_w)) :-:
|
590 : |
|
|
("w31andb", (ww_w)) :-:
|
591 : |
|
|
("w31notb", (w_w)) :-:
|
592 : |
|
|
("w31neg", (w_w)) :-:
|
593 : |
|
|
("w31rshift", (ww_w)) :-:
|
594 : |
|
|
("w31rshiftl", (ww_w)) :-:
|
595 : |
|
|
("w31lshift", (ww_w)) :-:
|
596 : |
|
|
("w31gt", (ww_b)) :-:
|
597 : |
|
|
("w31ge", (ww_b)) :-:
|
598 : |
|
|
("w31lt", (ww_b)) :-:
|
599 : |
|
|
("w31le", (ww_b)) :-:
|
600 : |
|
|
("w31eq", (ww_b)) :-:
|
601 : |
|
|
("w31ne", (ww_b)) :-:
|
602 : |
|
|
("w31ChkRshift", (ww_w)) :-:
|
603 : |
|
|
("w31ChkRshiftl",(ww_w)) :-:
|
604 : |
|
|
("w31ChkLshift", (ww_w)) :-:
|
605 : |
|
|
|
606 : |
|
|
("w31min", (ww_w)) :-:
|
607 : |
|
|
("w31max", (ww_w)) :-:
|
608 : |
|
|
|
609 : |
|
|
(* (pseudo-)word8 primops *)
|
610 : |
|
|
("w31mul_8", (w8w8_w8)) :-:
|
611 : |
|
|
("w31div_8", (w8w8_w8)) :-:
|
612 : |
|
|
("w31mod_8", (w8w8_w8)) :-:
|
613 : |
|
|
("w31add_8", (w8w8_w8)) :-:
|
614 : |
|
|
("w31sub_8", (w8w8_w8)) :-:
|
615 : |
|
|
("w31orb_8", (w8w8_w8)) :-:
|
616 : |
|
|
("w31xorb_8", (w8w8_w8)) :-:
|
617 : |
|
|
("w31andb_8", (w8w8_w8)) :-:
|
618 : |
|
|
("w31notb_8", (w8_w8)) :-:
|
619 : |
|
|
("w31neg_8", (w8_w8)) :-:
|
620 : |
|
|
("w31rshift_8", (w8w_w8)) :-:
|
621 : |
|
|
("w31rshiftl_8", (w8w_w8)) :-:
|
622 : |
|
|
("w31lshift_8", (w8w_w8)) :-:
|
623 : |
|
|
("w31gt_8", (w8w8_b)) :-:
|
624 : |
|
|
("w31ge_8", (w8w8_b)) :-:
|
625 : |
|
|
("w31lt_8", (w8w8_b)) :-:
|
626 : |
|
|
("w31le_8", (w8w8_b)) :-:
|
627 : |
|
|
("w31eq_8", (w8w8_b)) :-:
|
628 : |
|
|
("w31ne_8", (w8w8_b)) :-:
|
629 : |
|
|
("w31ChkRshift_8", (w8w_w8)) :-:
|
630 : |
|
|
("w31ChkRshiftl_8",(w8w_w8)) :-:
|
631 : |
|
|
("w31ChkLshift_8", (w8w_w8)) :-:
|
632 : |
|
|
|
633 : |
|
|
("w31min_8", (w8w8_w8)) :-:
|
634 : |
|
|
("w31max_8", (w8w8_w8)) :-:
|
635 : |
|
|
|
636 : |
|
|
(*** word32 primops ***)
|
637 : |
|
|
("w32mul", (w32w32_w32)) :-:
|
638 : |
|
|
("w32div", (w32w32_w32)) :-:
|
639 : |
|
|
("w32mod", (w32w32_w32)) :-:
|
640 : |
|
|
("w32add", (w32w32_w32)) :-:
|
641 : |
|
|
("w32sub", (w32w32_w32)) :-:
|
642 : |
|
|
("w32orb", (w32w32_w32)) :-:
|
643 : |
|
|
("w32xorb", (w32w32_w32)) :-:
|
644 : |
|
|
("w32andb", (w32w32_w32)) :-:
|
645 : |
|
|
("w32notb", (w32_w32)) :-:
|
646 : |
|
|
("w32neg", (w32_w32)) :-:
|
647 : |
|
|
("w32rshift", (w32w_w32)) :-:
|
648 : |
|
|
("w32rshiftl", (w32w_w32)) :-:
|
649 : |
|
|
("w32lshift", (w32w_w32)) :-:
|
650 : |
|
|
("w32gt", (w32w32_b)) :-:
|
651 : |
|
|
("w32ge", (w32w32_b)) :-:
|
652 : |
|
|
("w32lt", (w32w32_b)) :-:
|
653 : |
|
|
("w32le", (w32w32_b)) :-:
|
654 : |
|
|
("w32eq", (w32w32_b)) :-:
|
655 : |
|
|
("w32ne", (w32w32_b)) :-:
|
656 : |
|
|
("w32ChkRshift", (w32w_w32)) :-:
|
657 : |
|
|
("w32ChkRshiftl",(w32w_w32)) :-:
|
658 : |
|
|
("w32ChkLshift", (w32w_w32)) :-:
|
659 : |
|
|
|
660 : |
|
|
("w32min", (w32w32_w32)) :-:
|
661 : |
|
|
("w32max", (w32w32_w32)) :-:
|
662 : |
|
|
|
663 : |
|
|
(* experimental C FFI primops *)
|
664 : |
|
|
("raww8l", (w32_w32)) :-:
|
665 : |
|
|
("rawi8l", (w32_i32)) :-:
|
666 : |
|
|
("raww16l", (w32_w32)) :-:
|
667 : |
|
|
("rawi16l", (w32_i32)) :-:
|
668 : |
|
|
("raww32l", (w32_w32)) :-:
|
669 : |
|
|
("rawi32l", (w32_i32)) :-:
|
670 : |
|
|
("rawf32l", (w32_f64)) :-:
|
671 : |
|
|
("rawf64l", (w32_f64)) :-:
|
672 : |
|
|
("raww8s", (w32w32_u)) :-:
|
673 : |
|
|
("rawi8s", (w32i32_u)) :-:
|
674 : |
|
|
("raww16s", (w32w32_u)) :-:
|
675 : |
|
|
("rawi16s", (w32i32_u)) :-:
|
676 : |
|
|
("raww32s", (w32w32_u)) :-:
|
677 : |
|
|
("rawi32s", (w32i32_u)) :-:
|
678 : |
|
|
("rawf32s", (w32f64_u)) :-:
|
679 : |
|
|
("rawf64s", (w32f64_u)) :-:
|
680 : |
|
|
("rawccall", (rccType)) :-:
|
681 : |
|
|
|
682 : |
|
|
(* Support for direct construction of C objects on ML heap.
|
683 : |
|
|
* rawrecord builds a record holding C objects on the heap.
|
684 : |
|
|
* rawselectxxx index on this record. They are of type:
|
685 : |
|
|
* 'a * Word32.word -> Word32.word
|
686 : |
|
|
* The 'a is to guarantee that the compiler will treat
|
687 : |
|
|
* the record as a ML object, in case it passes thru a gc boundary.
|
688 : |
|
|
* rawupdatexxx writes to the record.
|
689 : |
|
|
*)
|
690 : |
|
|
|
691 : |
|
|
("rawrecord", (i_x)) :-:
|
692 : |
|
|
("rawrecord64", (i_x)) :-:
|
693 : |
|
|
|
694 : |
|
|
("rawselectw8", (xw32_w32)) :-:
|
695 : |
|
|
("rawselecti8", (xw32_i32)) :-:
|
696 : |
|
|
("rawselectw16", (xw32_w32)) :-:
|
697 : |
|
|
("rawselecti16", (xw32_i32)) :-:
|
698 : |
|
|
("rawselectw32", (xw32_w32)) :-:
|
699 : |
|
|
("rawselecti32", (xw32_i32)) :-:
|
700 : |
|
|
("rawselectf32", (xw32_f64)) :-:
|
701 : |
|
|
("rawselectf64", (xw32_f64)) :-:
|
702 : |
|
|
|
703 : |
|
|
("rawupdatew8", (xw32w32_u)) :-:
|
704 : |
|
|
("rawupdatei8", (xw32i32_u)) :-:
|
705 : |
|
|
("rawupdatew16", (xw32w32_u)) :-:
|
706 : |
|
|
("rawupdatei16", (xw32i32_u)) :-:
|
707 : |
|
|
("rawupdatew32", (xw32w32_u)) :-:
|
708 : |
|
|
("rawupdatei32", (xw32i32_u)) :-:
|
709 : |
|
|
("rawupdatef32", (xw32f64_u)) :-:
|
710 : |
|
|
("rawupdatef64", (xw32f64_u))
|
711 : |
|
|
|
712 : |
|
|
fun primopTypeMap name = RBMap.find(primopTypes,name)
|
713 : |
|
|
|
714 : |
|
|
end (* structure PrimOpTypeMap *)
|