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/compiler/FLINT/cps/convert.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/FLINT/cps/convert.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 17 - (view) (download)
Original Path: sml/branches/SMLNJ/src/compiler/FLINT/cps/convert.sml

1 : monnier 16 (* Copyright 1996 by Bell Laboratories *)
2 :     (* convert.sml *)
3 :    
4 :     (***************************************************************************
5 :     * IMPORTANT NOTES *
6 :     * *
7 :     * OFFSET and RECORD accesspath SELp should not be *
8 :     * generated by this module. *
9 :     ***************************************************************************)
10 :    
11 :     signature CONVERT = sig
12 :     val convert : Lambda.lexp -> CPS.function * LtyDef.lty Intmap.intmap
13 :     end (* signature CONVERT *)
14 :    
15 :     functor Convert(MachSpec : MACH_SPEC) : CONVERT = struct
16 :    
17 :     local open CPS
18 :     structure DA = Access
19 :     structure LT = LtyExtern
20 :     structure LV = LambdaVar
21 :     structure AP = PrimOp
22 :     in
23 :    
24 :     fun bug s = ErrorMsg.impossible ("Convert: " ^ s)
25 :     val say = Control.Print.say
26 :    
27 :     val ident = fn le => le
28 :     fun split(Lambda.SVAL v) = (v, ident)
29 :     | split x = let val v = LV.mkLvar()
30 :     in (Lambda.VAR v, fn z => Lambda.LET(v, x, z))
31 :     end
32 :    
33 :     fun APPg(e1, e2) =
34 :     let val (v1, h1) = split e1
35 :     val (v2, h2) = split e2
36 :     in h1(h2(Lambda.APP(v1, v2)))
37 :     end
38 :    
39 :     val rep_flag = MachSpec.representations
40 :     fun which (a,b) = if rep_flag then a else fn x => b
41 :    
42 :     val arrowLty = which(LT.lt_arrow, (LT.ltc_void, LT.ltc_void))
43 :     val selectLty = which(LT.lt_select, LT.ltc_void)
44 :    
45 :     val ltc_cont = LT.ltc_cont
46 :     val lt_vcont = ltc_cont [LT.ltc_void]
47 :     val lt_scont = LT.ltc_arw (LT.ltc_void, LT.ltc_void)
48 :    
49 :    
50 :     (***************************************************************************
51 :     * CONSTANTS AND UTILITY FUNCTIONS *
52 :     ***************************************************************************)
53 :     val OFFp0 = OFFp 0
54 :     val id = fn x => x
55 :    
56 :     val IntOpTy = LT.ltc_arw(LT.ltc_tuple[LT.ltc_int,LT.ltc_int],LT.ltc_int)
57 :     val seqTy = LT.ltc_arw(LT.ltc_tuple[LT.ltc_void,LT.ltc_void],LT.ltc_bool)
58 :    
59 :     fun numkind (AP.INT bits) = P.INT bits
60 :     | numkind (AP.UINT bits) = P.UINT bits
61 :     | numkind (AP.FLOAT bits) = P.FLOAT bits
62 :    
63 :     fun cmpop(stuff,argt) =
64 :     (case stuff
65 :     of {oper=AP.EQL,kind=AP.INT 31} =>
66 :     if LT.lt_eqv(argt,LT.ltc_tuple[LT.ltc_void,LT.ltc_void])
67 :     then (say "int-equality used for ptr-equality\n"; P.peql)
68 :     else P.ieql
69 :     | {oper=AP.NEQ,kind=AP.INT 31} =>
70 :     if LT.lt_eqv(argt,LT.ltc_tuple[LT.ltc_void,LT.ltc_void])
71 :     then (say "int-equality used for ptr-equality\n"; P.pneq)
72 :     else P.ineq
73 :     | {oper,kind=AP.FLOAT size} =>
74 :     let fun c AP.> = P.fGT
75 :     | c AP.>= = P.fGE
76 :     | c AP.< = P.fLT
77 :     | c AP.<= = P.fLE
78 :     | c AP.EQL = P.fEQ
79 :     | c AP.NEQ = P.fLG
80 :     | c _ = bug "cmpop:kind=AP.FLOAT"
81 :     in P.fcmp{oper= c oper, size=size}
82 :     end
83 :     | {oper, kind} =>
84 :     let fun check (_, AP.UINT _) = ()
85 :     | check (oper, _) = bug ("check" ^ oper)
86 :     fun c AP.> = P.>
87 :     | c AP.>= = P.>=
88 :     | c AP.< = P.<
89 :     | c AP.<= = P.<=
90 :     | c AP.LEU = (check ("leu", kind); P.<= )
91 :     | c AP.LTU = (check ("ltu", kind); P.< )
92 :     | c AP.GEU = (check ("geu", kind); P.>= )
93 :     | c AP.GTU = (check ("gtu", kind); P.> )
94 :     | c AP.EQL = P.eql
95 :     | c AP.NEQ = P.neq
96 :     in P.cmp{oper=c oper, kind=numkind kind}
97 :     end)
98 :    
99 :     fun arity AP.~ = 1
100 :     | arity AP.ABS = 1
101 :     | arity AP.NOTB = 1
102 :     | arity AP.+ = 2
103 :     | arity AP.- = 2
104 :     | arity AP.* = 2
105 :     | arity AP./ = 2
106 :     | arity AP.LSHIFT = 2
107 :     | arity AP.RSHIFT = 2
108 :     | arity AP.RSHIFTL = 2
109 :     | arity AP.ANDB = 2
110 :     | arity AP.ORB = 2
111 :     | arity AP.XORB = 2
112 :    
113 :     fun arithop AP.~ = P.~
114 :     | arithop AP.ABS = P.abs
115 :     | arithop AP.NOTB = P.notb
116 :     | arithop AP.+ = P.+
117 :     | arithop AP.- = P.-
118 :     | arithop AP.* = P.*
119 :     | arithop AP./ = P./
120 :     | arithop AP.LSHIFT = P.lshift
121 :     | arithop AP.RSHIFT = P.rshift
122 :     | arithop AP.RSHIFTL = P.rshiftl
123 :     | arithop AP.ANDB = P.andb
124 :     | arithop AP.ORB = P.orb
125 :     | arithop AP.XORB = P.xorb
126 :    
127 :     (***************************************************************************
128 :     * THE MAIN FUNCTION *
129 :     * convert : Lambda.lexp -> CPS.cexp * CPS.lty Intmap.intmap *
130 :     ***************************************************************************)
131 :     fun convert lexp =
132 :     let
133 :    
134 :     (**** We are not supporting unrolled lists right now *********************
135 :     val cvtrfty = if (MachSpec.newListRep) then TransList.cvtrfty
136 :     else (fn x => x)
137 :     val selectLty = if (MachSpec.newListRep) then TransList.selectLty
138 :     else selectLty
139 :     ****)
140 :     fun cvtrfty x = x
141 :    
142 :     (* the following should be reconfigured in the future *)
143 :     (** (* replaced with below to avoid infinite loop in spill when #fpregs=7 *)
144 :     val maxrepregs1 = if not rep_flag then 0
145 :     else (let val k = MachSpec.numRegs - MachSpec.numCalleeSaves
146 :     in Int.min(k-2,MachSpec.numArgRegs)
147 :     end)
148 :    
149 :     val maxrepregs2 = if not rep_flag then 0
150 :     else (let val k = MachSpec.numRegs - MachSpec.numCalleeSaves
151 :     in Int.min(k-2,MachSpec.maxRepRegs)
152 :     end)
153 :     **)
154 :    
155 :     val maxrepregs1 =
156 :     if not rep_flag then 0
157 :     else (let val k = MachSpec.numRegs - MachSpec.numCalleeSaves
158 :     in Int.min(Int.min(k-2,MachSpec.numFloatRegs-1),MachSpec.numArgRegs)
159 :     end)
160 :    
161 :     val maxrepregs2 =
162 :     if not rep_flag then 0
163 :     else (let val k = MachSpec.numRegs - MachSpec.numCalleeSaves
164 :     in Int.min(Int.min(k-2,MachSpec.numFloatRegs-1),MachSpec.maxRepRegs)
165 :     end)
166 :    
167 :     local open Intmap
168 :     exception Rename
169 :     val m : value intmap = new(32, Rename)
170 :     val rename = map m
171 :    
172 :     in fun ren v = rename v handle Rename => VAR v
173 :     val newname = add m
174 :     end
175 :    
176 :     local open Intmap
177 :     in
178 :    
179 :     exception TypeInfo
180 :     val typtable : LT.lty intmap = new(32, TypeInfo)
181 :     val mapty =
182 :     if rep_flag then
183 :     (fn v => (map typtable v)
184 :     handle TypeInfo =>
185 :     (List.app say
186 :     ["The lvar ", LV.lvarName v,
187 :     " is not in the current hashtable!\n"];
188 :     bug "TypeInfo hash table in convert.sml"))
189 :     else (fn v => LT.ltc_void)
190 :     val addty = if rep_flag then (add typtable) else (fn v => ())
191 :     val rmvty = if rep_flag then (rmv typtable) else (fn v => ())
192 :     val nthty = if rep_flag then List.nth else (fn _ => LT.ltc_void)
193 :     fun grabty(VAR v) = mapty v
194 :     | grabty(LABEL v) = mapty v
195 :     | grabty(INT _) = LT.ltc_int
196 :     | grabty(INT32 _) = LT.ltc_int32
197 :     | grabty(REAL _) = LT.ltc_real
198 :     | grabty _ = LT.ltc_void
199 :    
200 :     end (* end of local open Intmap *)
201 :    
202 :     val mkLvar = LV.mkLvar
203 :    
204 :     fun mkfn(f,t) =
205 :     let val v = mkLvar()
206 :     in addty(v,t); f v
207 :     end
208 :    
209 :     fun mkv(t) =
210 :     let val v = mkLvar()
211 :     in addty(v,t); v
212 :     end
213 :    
214 :     val bogus_cont = mkv(lt_vcont)
215 :    
216 :     val unboxedfloat = MachSpec.unboxedFloats
217 :     val untaggedint = MachSpec.untaggedInt
218 :     val flatfblock = (!Control.CG.flatfblock) andalso unboxedfloat
219 :    
220 :     fun unwrapfloat(u,x,ce) = PURE(P.funwrap,[u],x,FLTt,ce)
221 :     fun wrapfloat(u,x,ce) = PURE(P.fwrap,[u],x,BOGt,ce)
222 :     fun unwrapint(u,x,ce) = PURE(P.iunwrap,[u],x,INTt,ce)
223 :     fun wrapint(u,x,ce) = PURE(P.iwrap,[u],x,BOGt,ce)
224 :     fun unwrapi32(u,x,ce) = PURE(P.i32unwrap,[u],x,INT32t,ce)
225 :     fun wrapi32(u,x,ce) = PURE(P.i32wrap,[u],x,BOGt,ce)
226 :    
227 :     fun primwrap(INTt) = P.iwrap
228 :     | primwrap(INT32t) = P.i32wrap
229 :     | primwrap(FLTt) = P.fwrap
230 :     | primwrap _ = P.wrap
231 :    
232 :     fun primunwrap(INTt) = P.iunwrap
233 :     | primunwrap(INT32t) = P.i32unwrap
234 :     | primunwrap(FLTt) = P.funwrap
235 :     | primunwrap _ = P.unwrap
236 :    
237 :     (* check if a record contains only reals *)
238 :     fun isFloatRec lt =
239 :     if (LT.ltp_tyc lt) then
240 :     (let val tc = LT.ltd_tyc lt
241 :     in if (LT.tcp_tuple tc) then
242 :     (let val l = LT.tcd_tuple tc
243 :     fun h [] = flatfblock
244 :     | h (x::r) =
245 :     if LT.tc_eqv(x, LT.tcc_real) then h r else false
246 :     in case l of [] => false | _ => h l
247 :     end)
248 :     else false
249 :     end)
250 :     else false
251 :    
252 :     fun selectFL(i,u,x,ct,ce) = SELECT(i,u,x,ct,ce)
253 :     fun selectNM(i,u,x,ct,ce) =
254 :     (case (ct,unboxedfloat,untaggedint)
255 :     of (FLTt,true,_) => let val v = mkLvar()
256 :     in SELECT(i,u,v,BOGt,unwrapfloat(VAR v,x,ce))
257 :     end
258 :     | (INTt,_,true) => let val v = mkLvar()
259 :     in SELECT(i,u,v,BOGt,unwrapint(VAR v,x,ce))
260 :     end
261 :     | (INT32t,_,_) => let val v = mkLvar()
262 :     in SELECT(i,u,v,BOGt,unwrapi32(VAR v,x,ce))
263 :     end
264 :     | _ => SELECT(i,u,x,ct,ce))
265 :    
266 :     fun recordFL(ul,_,w,ce) =
267 :     let val nul = map (fn u => (u,OFFp 0)) ul
268 :     in RECORD(RK_FBLOCK,nul,w,ce)
269 :     end
270 :    
271 :     fun recordNM(ul,tyl,w,ce) =
272 :     let fun g(FLTt::r,u::z,l,h) =
273 :     if unboxedfloat then
274 :     (let val v = mkLvar()
275 :     in g(r, z, (VAR v,OFFp 0)::l, fn ce => h(wrapfloat(u,v,ce)))
276 :     end)
277 :     else g(r, z, (u,OFFp 0)::l, h)
278 :     | g(INTt::r,u::z,l,h) =
279 :     if untaggedint then
280 :     (let val v = mkLvar()
281 :     in g(r, z, (VAR v,OFFp 0)::l, fn ce => h(wrapint(u,v,ce)))
282 :     end)
283 :     else g(r, z, (u,OFFp 0)::l, h)
284 :     | g(INT32t::r,u::z,l,h) =
285 :     let val v = mkLvar()
286 :     in g(r, z, (VAR v,OFFp 0)::l, fn ce => h(wrapi32(u,v,ce)))
287 :     end
288 :     | g(_::r,u::z,l,h) = g(r, z, (u,OFFp0)::l, h)
289 :     | g([],[],l,h) = (rev l, h)
290 :     | g _ = bug "unexpected in recordNM in convert"
291 :    
292 :     val (nul,header) =
293 :     if rep_flag then g(map ctype tyl,ul,[],fn x => x)
294 :     else (map (fn u => (u,OFFp 0)) ul, fn x => x)
295 :     in header(RECORD(RK_RECORD,nul,w,ce))
296 :     end
297 :    
298 :     fun convpath(DA.LVAR v, k) = k(ren v)
299 :     | convpath(DA.PATH(p, i), k) =
300 :     let fun kont(v) =
301 :     let val t = selectLty(grabty(v),i)
302 :     val w = mkv(t)
303 :     in SELECT(i, v, w, ctype t, k(VAR w))
304 :     end
305 :     in convpath(p,kont)
306 :     end
307 :     | convpath _ = bug "unexpected path in convpath"
308 :    
309 :     (* BUG: The defintion of E_word is clearly incorrect since it can raise
310 :     * an overflow at code generation time. A clean solution would be
311 :     * to add a WORD constructor into the CPS language -- daunting! The
312 :     * revolting hack solution would be to put the right int constant
313 :     * that gets converted to the right set of bits for the word constant.
314 :     *)
315 :     val do_switch = Switch.switch {
316 :     E_int = fn i => if i < ~0x20000000 orelse i >= 0x20000000
317 :     then raise Switch.TooBig else INT i,
318 :     E_word = fn w => if w >= 0wx20000000
319 :     then raise Switch.TooBig else INT (Word.toIntX w),
320 :     E_real = fn s => REAL s,
321 :     E_switchlimit = 4,
322 :     E_neq = P.ineq,
323 :     E_w32neq = P.cmp{oper=P.neq,kind=P.UINT 32},
324 :     E_i32neq = P.cmp{oper=P.neq,kind=P.INT 32},
325 :     E_word32 = INT32,
326 :     E_int32 = INT32,
327 :     E_wneq = P.cmp{oper=P.neq, kind=P.UINT 31},
328 :     E_pneq = P.pneq,
329 :     E_fneq = P.fneq,
330 :     E_less = P.ilt,
331 :     E_branch= fn(cmp,x,y,a,b) => BRANCH(cmp,[x,y],mkv(LT.ltc_int),a,b),
332 :     E_strneq= fn(w,str,a,b) => BRANCH(P.strneq, [INT(size str),w,STRING str],
333 :     mkv(LT.ltc_int), a, b),
334 :     E_switch= fn(v,list) => SWITCH(v, mkv(LT.ltc_int), list),
335 :     E_add= fn(x,y,c) => let val v = mkv(LT.ltc_int) in ARITH(P.iadd,[x,y],v,INTt,c(VAR v))
336 :     end,
337 :     E_gettag= fn(x,c) => let val v = mkv(LT.ltc_int)
338 :     in PURE(P.getcon,[x],v,INTt,c(VAR v))
339 :     end,
340 :     E_unwrap= fn(x,c) => let val v = mkv(LT.ltc_int)
341 :     in PURE(P.unwrap,[x],v,INTt,c(VAR v))
342 :     end,
343 :     E_getexn= fn(x,c) => let val v = mkv(LT.ltc_void)
344 :     in PURE(P.getexn,[x],v,BOGt,c(VAR v))
345 :     end,
346 :     E_length= fn(x,c) => let val v = mkv(LT.ltc_int)
347 :     in PURE(P.length,[x],v,INTt,c(VAR v))
348 :     end,
349 :     E_boxed= fn(x,a,b) => BRANCH(P.boxed,[x],mkv(LT.ltc_int),a,b),
350 :     E_path= convpath}
351 :    
352 :    
353 :     (***************************************************************************
354 :     * mkArgIn : lty * lvar -> lvar list * cty list * (cexp -> cexp) *
355 :     * mkArgOut : lty * value -> value list * (cexp -> cexp) *
356 :     * *
357 :     * When the type of the argument x of a function f(x) is an "small" *
358 :     * unboxed record, f will be transformed to a multi-argument function *
359 :     * with #1(mkArgIn(...,x)) as its list of arguments. *
360 :     * *
361 :     * When a function f is applied to a argument x, and x is of a "small" *
362 :     * unboxed record type, x will be flattened. #1(mkArgOut(...,x)) will *
363 :     * become the actual arguments of the function call f. *
364 :     * *
365 :     * When the Control.CG.representations flag is turned off, all *
366 :     * these effects are gone. (l >> 0) *
367 :     ***************************************************************************)
368 :    
369 :     fun tc_size t =
370 :     LT.tcw_tuple(t,
371 :     fn ts => case ts of [] => 1
372 :     | _ =>foldr (op +) 0 (map tc_size ts),
373 :     fn _ => 1)
374 :    
375 :     fun lt_size t = LT.ltw_tyc (t, fn tc => tc_size tc, fn _ => 1)
376 :    
377 :     fun tc_length t =
378 :     LT.tcw_tuple(t,
379 :     fn ts => case ts of [] => 1
380 :     | _ => length ts,
381 :     fn _ => 1)
382 :    
383 :     fun lt_length t = LT.ltw_tyc (t, fn tc => tc_length tc, fn _ => 1)
384 :    
385 :     fun mkArgIn0(t,v) =
386 :     let val l = lt_size(t)
387 :     fun megl((vl1,cl1,f1),(vl2,cl2,f2)) = (vl1 @ vl2, cl1 @ cl2, f1 o f2)
388 :    
389 :     (* recFlat: recursive flatten *)
390 :     fun recFlat(tt,p) =
391 :     LT.ltw_tuple (tt,
392 :     fn args => (case args
393 :     of [] => ([p],[INTt],id)
394 :     | _ =>
395 :     let val args = map LT.ltc_tyc args
396 :     val ul = map (fn t => mkv(t)) args
397 :     val recordCE =
398 :     if isFloatRec tt then recordFL else recordNM
399 :     val header =
400 :     fn ce => recordCE(map VAR ul,args,p,ce)
401 :     in foldr megl ([], [], header)
402 :     (ListPair.map recFlat (args,ul))
403 :     end),
404 :     fn tt => ([p],[ctype tt],id))
405 :    
406 :     (* oneFlat: flatten only one level *)
407 :     fun oneFlat (tt,p) =
408 :     LT.ltw_tuple (tt,
409 :     fn args => let val args = map LT.ltc_tyc args
410 :     val wl = map (fn t => mkv(t)) args
411 :     val cl = map ctype args
412 :     val recordCE =
413 :     if isFloatRec tt then recordFL else recordNM
414 :     val header = fn ce => recordCE(map VAR wl,args,p,ce)
415 :     in (wl,cl,header)
416 :     end,
417 :     fn tt => ([p],[ctype(tt)],id))
418 :    
419 :     in if l < maxrepregs1 then recFlat(t,v)
420 :     else (let val s = lt_length(t)
421 :     in if s < maxrepregs2 then oneFlat(t,v)
422 :     else ([v],[ctype(t)],id)
423 :     end)
424 :     end
425 :    
426 :     fun mkArgIn(t,v) = mkArgIn0(cvtrfty t,v)
427 :    
428 :     fun mkArgOut0(t,z as VAR v) =
429 :     let val l = lt_size(t)
430 :     fun megr((vl1,f1),(vl2,f2)) = ((vl1 @ vl2), f2 o f1)
431 :    
432 :     fun recFlat (tt,p) =
433 :     LT.ltw_tuple (tt,
434 :     fn args =>
435 :     (case args
436 :     of [] => ([VAR p],id)
437 :     | _ =>
438 :     let val args = map LT.ltc_tyc args
439 :     val wl = map (fn t => (t, mkv(t))) args
440 :     val selectCE =
441 :     if isFloatRec tt then selectFL else selectNM
442 :    
443 :     fun sel((t,x)::tl,i) =
444 :     let val header = sel(tl,i+1)
445 :     in fn ce => selectCE(i, VAR p, x, ctype(t),
446 :     header(ce))
447 :     end
448 :     | sel(nil,i) = id
449 :    
450 :     val header = sel(wl,0)
451 :     in foldr megr ([], header) (map recFlat wl)
452 :     end),
453 :     fn _ => ([VAR p],id))
454 :    
455 :     fun oneFlat (tt,p) =
456 :     LT.ltw_tuple (tt,
457 :     fn args =>
458 :     let val args = map LT.ltc_tyc args
459 :     val wl = map (fn t => (mkv(t), ctype(t))) args
460 :     val selectCE =
461 :     if isFloatRec tt then selectFL else selectNM
462 :     fun sel((x,ct)::tl,i) =
463 :     let val header = sel(tl,i+1)
464 :     in fn ce => selectCE(i, VAR p, x, ct,
465 :     header(ce))
466 :     end
467 :     | sel(nil,i) = id
468 :     val header = sel(wl,0)
469 :     in (map (VAR o #1) wl,header)
470 :     end,
471 :     fn _ => ([VAR p],id))
472 :    
473 :     in if l < maxrepregs1 then recFlat(t,v)
474 :     else (let val s = lt_length(t)
475 :     in if s < maxrepregs2 then oneFlat(t,v)
476 :     else ([z],id)
477 :     end)
478 :     end
479 :     | mkArgOut0(t,z) = ([z],id)
480 :    
481 :     fun mkArgOut(t,v) = mkArgOut0(cvtrfty t,v)
482 :    
483 :    
484 :     (***************************************************************************
485 :     * preventEta : cexp * lty -> cexp * value *
486 :     ***************************************************************************)
487 :     fun preventEta(c,argt) =
488 :     let val f = mkv(ltc_cont [argt]) and v = mkv(argt)
489 :     val (vl,cl,header) = mkArgIn(argt,v)
490 :     val b = header(c(VAR v))
491 :     in case b
492 :     of APP(w as VAR w', [VAR v']) =>
493 :     if v=v' andalso v<>w'
494 :     (* The case v=w' never turns up in practice,
495 :     but v<>v' does turn up. *)
496 :     then (id,w)
497 :     else (fn x => FIX([(CONT,f,vl,cl,b)],x),VAR f)
498 :     | _ => (fn x => FIX([(CONT,f,vl,cl,b)],x),VAR f)
499 :     end
500 :    
501 :     (***************************************************************************
502 :     * convlist : Lambda.lexp list * (value list -> cexp) -> cexp *
503 :     ***************************************************************************)
504 :     fun convlist (el,c) =
505 :     let fun f(le::r, vl) = convle(le, fn v => f(r,v::vl))
506 :     | f(nil, vl) = c (rev vl)
507 :     in f (el,nil)
508 :     end
509 :    
510 :     (***************************************************************************
511 :     * getargs : int * Lambda.lexp * (value list -> cexp) -> cexp *
512 :     ***************************************************************************)
513 :     and getargs(1,a,g) = convle(a, fn z => g[z])
514 :     | getargs(n,Lambda.RECORD l,g) = g (map convsv l)
515 :     | getargs(n,Lambda.VECTOR(l, _), g) = g(map convsv l)
516 :     | getargs(0,a,g) = g(nil)
517 :     | getargs(n,a,g) =
518 :     let fun kont(v) =
519 :     let val lt = grabty(v)
520 :     val selectCE = if (isFloatRec lt) then selectFL else selectNM
521 :     fun f(j,wl) =
522 :     if j = n then g(rev wl)
523 :     else (let val tt = selectLty(lt,j)
524 :     fun h(w) =
525 :     selectCE(j,v,w,ctype(tt),f(j+1,VAR w :: wl))
526 :     in mkfn(h,tt)
527 :     end)
528 :     in f(0,nil)
529 :     end
530 :     in convle(a,kont)
531 :     end
532 :    
533 :     (***************************************************************************
534 :     * convsv : Lambda.value -> value *
535 :     * convle : Lambda.lexp * (value list -> cexp) -> cexp *
536 :     ***************************************************************************)
537 :     and convsv sv =
538 :     (case sv
539 :     of Lambda.VAR v => ren v
540 :     | Lambda.INT i => INT i
541 :     (*
542 :     ((i+i+2; c(INT i)) handle Overflow =>
543 :     let open Lambda
544 :     in convle(APPg(SVAL(PRIM(AP.IADD,IntOpTy,[])),
545 :     RECORD([INT(i div 2),INT(i - i div 2)])),c)
546 :     end)
547 :     *)
548 :     | Lambda.INT32 i32 =>
549 :     let val int32ToWord32 = Word32.fromLargeInt o Int32.toLarge
550 :     in INT32 (int32ToWord32 i32)
551 :     end
552 :     | Lambda.WORD w => INT(Word.toIntX w)
553 :     (*
554 :     let val maxWord = 0wx20000000
555 :     in if Word.<(w, maxWord) then c(INT(Word.toIntX w))
556 :     else let open Lambda
557 :     val addu =
558 :     AP.ARITH{oper=AP.+, overflow=false, kind=AP.UINT 31}
559 :     val x1 = Word.div(w, 0w2)
560 :     val x2 = Word.-(w, x1)
561 :     in convle(APPg(SVAL(PRIM(addu, IntOpTy,[])),
562 :     RECORD([WORD x1, WORD x2])), c)
563 :     end
564 :     end
565 :     *)
566 :     | Lambda.WORD32 w => INT32 w
567 :     | Lambda.REAL i => REAL i
568 :     | Lambda.STRING s => STRING s
569 :     | Lambda.PRIM(i,lt,_) => bug "unexpected primop in convsv"
570 :     (*
571 :     let (* val _ = print ("prim chkarrow "^(AP.prPrimop i)^"\n") *)
572 :     val (t,_) = arrowLty(lt)
573 :     val v = mkLvar()
574 :     val e = Lambda.FN(v,t,Lambda.APP(sv, Lambda.VAR v))
575 :     in convle(e,c)
576 :     end
577 :     *)
578 :     | _ => bug "unexpected case in convsv")
579 :    
580 :     and convle (le, c : value -> cexp) =
581 :     case le
582 :     of Lambda.SVAL sv => c(convsv(sv))
583 :     | Lambda.APP(Lambda.PRIM(AP.CALLCC,_,_), f) =>
584 :     let val vf = convsv f
585 :     val (t1,t2) = arrowLty(grabty(vf))
586 :     val h = mkv(lt_scont)
587 :     (* t1 must be SRCONTty here *)
588 :     val k' = mkv(t1) and x' = mkv(t2)
589 :     val (header,F) = preventEta(c,t2)
590 :     val (vl,cl,_) = mkArgIn(t2,x')
591 :     val z = mkv(lt_vcont) (* bogus cont *)
592 :     in header(LOOKER(P.gethdlr, [], h, FUNt,
593 :     FIX([(ESCAPE, k', z::vl, CNTt::cl,
594 :     SETTER(P.sethdlr, [VAR h],
595 :     APP(F, map VAR vl)))],
596 :     APP(vf,[F, VAR k']))))
597 :     end
598 :     | Lambda.APP(Lambda.PRIM(AP.CAPTURE,_,_), f) =>
599 :     let val vf = convsv f
600 :     val (t1,t2) = arrowLty(grabty(vf))
601 :     val k' = mkv(t1) and x' = mkv(t2)
602 :     val (header,F) = preventEta(c,t2)
603 :     val (vl,cl,_) = mkArgIn(t2,x')
604 :     val z = mkv(lt_vcont) (* bogus cont *)
605 :     (* this k' is one kind of eta redexes that optimizer
606 :     * should not reduce! The type of k' and F is different.
607 :     *)
608 :     in header(FIX([(ESCAPE, k', z::vl, CNTt::cl,
609 :     APP(F, map VAR vl))],
610 :     APP(vf,[F, VAR k'])))
611 :     end
612 :    
613 :     | Lambda.APP(Lambda.PRIM(AP.ISOLATE,_,_), f) =>
614 :     let val vf = convsv f
615 :     val k = mkv(lt_scont)
616 :     val z = mkv(lt_vcont)
617 :     val x = mkv(LT.ltc_void)
618 :     val h = mkv(lt_scont)
619 :     val z' = mkv(lt_vcont)
620 :     val x' = mkv(LT.ltc_void)
621 :     in FIX([(ESCAPE, h, [z', x'], [CNTt, BOGt],
622 :     APP(VAR bogus_cont, [VAR x']))],
623 :     FIX([(ESCAPE, k, [z, x], [CNTt, BOGt],
624 :     SETTER(P.sethdlr, [VAR h],
625 :     APP(vf, [VAR bogus_cont, VAR x])))],
626 :     c(VAR k)))
627 :     end
628 :    
629 :     (* We can't do this because the of representation type problems:
630 :     | Lambda.APP(Lambda.PRIM(AP.THROW,_,_), v) => convle(v,c)
631 :     *)
632 :     | Lambda.APP(Lambda.PRIM(AP.THROW,_,_), v) =>
633 :     let val kv = convsv v
634 :     val t = LT.ltc_arw(LT.ltc_void,LT.ltc_void)
635 :     val f = mkv(t)
636 :     in PURE(P.cast,[kv],f,ctype(t),c(VAR f))
637 :     end
638 :     | Lambda.APP(Lambda.PRIM(AP.CAST,lt,_), x) =>
639 :     let val vx = convsv x
640 :     val (_,t) = arrowLty(lt)
641 :     in mkfn(fn u => PURE(P.cast,[vx],u,ctype(t),c(VAR u)), t)
642 :     end
643 :     | Lambda.APP(Lambda.PRIM(i,lt,_), a) =>
644 :     let val (argt,t) = arrowLty(lt)
645 :     val ct = ctype t
646 :    
647 :     fun arith(n,i) =
648 :     let fun kont(vl) = mkfn(fn w => ARITH(i,vl,w,ct,c(VAR w)),t)
649 :     in getargs(n, Lambda.SVAL a,kont)
650 :     end
651 :    
652 :     fun setter(n,i) =
653 :     let fun kont(vl) = SETTER(i,vl,c(INT 0))
654 :     in getargs(n, Lambda.SVAL a,kont)
655 :     end
656 :    
657 :     fun looker(n,i) =
658 :     let fun kont(vl) = mkfn(fn w => LOOKER(i,vl,w,ct,c(VAR w)),t)
659 :     in getargs(n, Lambda.SVAL a,kont)
660 :     end
661 :    
662 :     fun pure(n,i) =
663 :     let fun kont(vl) = mkfn(fn w => PURE(i,vl,w,ct,c(VAR w)),t)
664 :     in getargs(n, Lambda.SVAL a,kont)
665 :     end
666 :    
667 :     fun branch(n,i)=
668 :     let val (header,F) = preventEta(c,t)
669 :     fun kont(vl) = header(BRANCH(i,vl,mkv(LT.ltc_int),
670 :     APP(F,[INT 1]),APP(F,[INT 0])))
671 :     in getargs(n, Lambda.SVAL a,kont)
672 :     end
673 :    
674 :     in case i
675 :     of AP.BOXED => branch(1,P.boxed)
676 :     | AP.UNBOXED => branch(1,P.unboxed)
677 :     | AP.CMP stuff => branch(2,cmpop(stuff,argt))
678 :     | AP.PTREQL => branch(2,P.peql)
679 :     | AP.PTRNEQ => branch(2,P.pneq)
680 :    
681 :     | AP.TEST(from,to) => arith(1, P.test(from, to))
682 :     | AP.TESTU(from,to) => arith(1, P.testu(from, to))
683 :     | AP.COPY(from,to) => pure(1, P.copy(from,to))
684 :     | AP.EXTEND(from,to) => pure(1, P.extend(from, to))
685 :     | AP.TRUNC(from,to) => pure(1, P.trunc(from, to))
686 :     | AP.ARITH{oper,kind,overflow=true} =>
687 :     arith(arity oper,
688 :     P.arith{oper=arithop oper,kind=numkind kind})
689 :     | AP.ARITH{oper,kind,overflow=false} =>
690 :     pure(arity oper,
691 :     P.pure_arith{oper=arithop oper,kind=numkind kind})
692 :    
693 :     | AP.ROUND{floor,fromkind,tokind} =>
694 :     arith(1,P.round{floor=floor,
695 :     fromkind=numkind fromkind,
696 :     tokind=numkind tokind})
697 :    
698 :     | AP.REAL{fromkind,tokind} =>
699 :     pure(1,P.real{tokind=numkind tokind,
700 :     fromkind=numkind fromkind})
701 :    
702 :     | AP.SUBSCRIPTV => pure(2,P.subscriptv)
703 :     | AP.MAKEREF => pure(1,P.makeref)
704 :     | AP.LENGTH => pure(1,P.length)
705 :     | AP.OBJLENGTH => pure(1,P.objlength)
706 :     | AP.GETTAG => pure(1, P.gettag)
707 :     | AP.MKSPECIAL => pure(2, P.mkspecial)
708 :    
709 :     | AP.SUBSCRIPT => looker(2,P.subscript)
710 :     | AP.NUMSUBSCRIPT{kind,immutable=false,checked=false} =>
711 :     looker(2,P.numsubscript{kind=numkind kind})
712 :     | AP.NUMSUBSCRIPT{kind,immutable=true,checked=false} =>
713 :     pure(2,P.pure_numsubscript{kind=numkind kind})
714 :     | AP.DEREF => looker(1,P.!)
715 :     | AP.GETRUNVEC => looker(0, P.getrunvec)
716 :     | AP.GETHDLR => looker(0,P.gethdlr)
717 :     | AP.GETVAR => looker(0,P.getvar)
718 :     | AP.GETPSEUDO => looker(1,P.getpseudo)
719 :     | AP.GETSPECIAL => looker(1, P.getspecial)
720 :     | AP.DEFLVAR => looker(0,P.deflvar)
721 :    
722 :     | AP.SETHDLR => setter(1,P.sethdlr)
723 :     | AP.NUMUPDATE{kind,checked=false} =>
724 :     setter(3,P.numupdate{kind=numkind kind})
725 :     | AP.UNBOXEDUPDATE => setter(3,P.unboxedupdate)
726 :     | AP.BOXEDUPDATE => setter(3,P.boxedupdate)
727 :     | AP.UPDATE => setter(3,P.update)
728 :     | AP.SETVAR => setter(1,P.setvar)
729 :     | AP.SETPSEUDO => setter(2,P.setpseudo)
730 :     | AP.SETMARK => setter(1,P.setmark)
731 :     | AP.DISPOSE => setter(1,P.free)
732 :     | AP.SETSPECIAL => setter(2, P.setspecial)
733 :     | AP.USELVAR => setter(1,P.uselvar)
734 :     | AP.MARKEXN => getargs(2, Lambda.SVAL a,fn[x,m']=>
735 :     let val bty = LT.ltc_void
736 :     val ety = LT.ltc_tuple[bty,bty,bty]
737 :    
738 :     val xx = mkv ety
739 :     val x0 = mkv bty
740 :     val x1 = mkv bty
741 :     val x2 = mkv bty
742 :    
743 :     val y = mkv ety
744 :     val y' = mkv bty
745 :    
746 :     val z = mkv(LT.ltc_tuple[bty,bty])
747 :     val z' = mkv bty
748 :    
749 :     in PURE(P.unwrap,[x],xx,ctype(ety),
750 :     SELECT(0,VAR xx,x0,BOGt,
751 :     SELECT(1,VAR xx,x1,BOGt,
752 :     SELECT(2,VAR xx,x2,BOGt,
753 :     RECORD(RK_RECORD,[(m',OFFp0),(VAR x2,OFFp0)],z,
754 :     PURE(P.wrap,[VAR z],z',BOGt,
755 :     RECORD(RK_RECORD,[(VAR x0,OFFp0),
756 :     (VAR x1,OFFp0),
757 :     (VAR z', OFFp0)], y,
758 :     PURE(P.wrap,[VAR y], y', BOGt,c(VAR y')))))))))
759 :     end)
760 :    
761 :     | _ => bug ("calling with bad primop \""
762 :     ^ (AP.prPrimop i) ^ "\"")
763 :     end
764 :     | Lambda.ETAG(v,_) =>
765 :     let val u = convsv v
766 :     val x = mkv(LT.ltc_void)
767 :     in PURE(P.makeref,[u],x,BOGt,c(VAR x))
768 :     end
769 :     | Lambda.FN(v,t,e) => (* using "save" the reference cell is
770 :     dirty, but i can't find better way *)
771 :     let val _ = addty(v,t)
772 :     val save = ref LT.ltc_void and k = mkLvar()
773 :     fun kont(vb) =
774 :     let val t = grabty(vb)
775 :     val _ = (save := t)
776 :     val (ul,header) = mkArgOut(t,vb)
777 :     in header(APP(VAR k,ul))
778 :     end
779 :     val ce = convle(e,kont)
780 :     val t1 = !save
781 :     val f = mkv(LT.ltc_fun(t,t1))
782 :     val _ = (addty(k, ltc_cont [t1]))
783 :     val (vl,cl,header) = mkArgIn(t,v)
784 :     in FIX([(ESCAPE,f,k::vl,CNTt::cl,header(ce))],c(VAR f))
785 :     end
786 :     | Lambda.APP(f,a) => (* different from the old version in
787 :     that header is now put in the middle
788 :     of evaluations between f and a, a bit odd *)
789 :     let val vf = convsv f
790 :     val (t1,t2) = arrowLty(grabty(vf))
791 :     val (header,F) = preventEta(c,t2)
792 :     val va = convsv a
793 :     val (ul,header') = mkArgOut(t1,va)
794 :     in header(header'(APP(vf,F::ul)))
795 :     end
796 :     | Lambda.FIX(fl, tl, el, body) =>
797 :     let fun g(f::fl, t::tl, Lambda.FN(v,_,b)::el) =
798 :     let val (t1,t2) = arrowLty(t)
799 :     val _ = addty(v,t1)
800 :     val k = mkv(ltc_cont [t2])
801 :     val (vl,cl,header) = mkArgIn(t1,v)
802 :     fun kont(vb) =
803 :     let val (ul,header') = mkArgOut(t2,vb)
804 :     in header'(APP(VAR k,ul))
805 :     end
806 :     val be = convle(b,kont)
807 :     in (ESCAPE,f,k::vl,CNTt::cl,header(be))::g(fl,tl,el)
808 :     end
809 :     | g(nil, nil, nil) = nil
810 :     | g _ = bug "convert.conv.FIX1"
811 :    
812 :     fun h(f::fl,t::tl) = (addty(f,t);h(fl,tl))
813 :     | h(nil,nil) = ()
814 :     | h _ = bug "convert.conv.FIX2"
815 :    
816 :     val _ = h(fl,tl)
817 :     in FIX(g(fl,tl,el),convle(body,c))
818 :     end
819 :     | Lambda.RECORD [] => c(INT 0)
820 :     (* bug "zero length records in convert" *)
821 :     | Lambda.SRECORD [] => c(INT 0)
822 :     (* bug "zero length records in convert" *)
823 :     | Lambda.VECTOR ([], _) => bug "zero length vectors in convert"
824 :     | Lambda.RECORD l =>
825 :     let val vl = map convsv l
826 :     val tyl = map grabty vl
827 :     val lt = LT.ltc_tuple tyl
828 :     val recordCE =
829 :     if (isFloatRec lt) then recordFL else recordNM
830 :     val w = mkv(lt)
831 :     in recordCE(vl,tyl,w,c(VAR w))
832 :     end
833 :     | Lambda.SRECORD l =>
834 :     let val vl = map convsv l
835 :     val ts = map grabty vl
836 :     val w = mkv(LT.ltc_str ts)
837 :     in recordNM(vl,ts,w,c(VAR w))
838 :     end
839 :     | Lambda.VECTOR (l, _) =>
840 :     let val vl = map convsv l
841 :     val w = mkv(LT.ltc_void)
842 :     in RECORD(RK_VECTOR, map (fn v => (v, OFFp0)) vl, w, c(VAR w))
843 :     end
844 :     | Lambda.SELECT(i, v) =>
845 :     let val v = convsv v
846 :     val lt = grabty(v)
847 :     val t = selectLty(lt,i)
848 :     val w = mkv(t)
849 :     val selectCE = if (isFloatRec lt) then selectFL else selectNM
850 :     in selectCE(i, v, w, ctype t, c(VAR w))
851 :     end
852 :     | Lambda.SWITCH(e,l,[a as (Lambda.DATAcon(_,DA.CONSTANT 0,_),_),
853 :     b as (Lambda.DATAcon(_,DA.CONSTANT 1,_),_)],
854 :     NONE) =>
855 :     convle(Lambda.SWITCH(e,l,[b,a],NONE),c)
856 :     (*
857 :     | Lambda.LET(v, x as Lambda.APP(oper, args),
858 :     Lambda.SWITCH(VAR z, _,
859 :     [(Lambda.DATAcon(_,DA.CONSTANT 1,_),e1),
860 :     (Lambda.DATAcon(_,DA.CONSTANT 0,_),e2)],NONE)) =>
861 :     let fun g i' =
862 :     let val k = mkLvar() and save = ref LT.ltc_void
863 :     fun kont(w) =
864 :     let val t = grabty(w)
865 :     val _ = (save := t)
866 :     val (ul,header1) = mkArgOut(t,w)
867 :     in header1(APP(VAR k,ul))
868 :     end
869 :     val ce1 = convle(e1,kont) and ce2 = convle(e2,kont)
870 :     val t = !save
871 :     val _ = addty(k, ltc_cont [t]) and v = mkv(t)
872 :     val (vl,cl,header) = mkArgIn(t,v)
873 :     in FIX([(CONT,k,vl,cl,header(c(VAR v)))],
874 :     getargs(2,args,
875 :     fn vl => BRANCH(i',vl,mkv(LT.ltc_int),ce1,ce2)))
876 :     end
877 :     in case oper
878 :     of Lambda.PRIM(AP.CMP stuff,lt,_) =>
879 :     g(cmpop(stuff,#1(arrowLty lt)))
880 :     | Lambda.PRIM(AP.PTREQL,_,_) => g(P.peql)
881 :     | Lambda.PRIM(AP.PTRNEQ,_,_) => g(P.pneq)
882 :     | _ => genswitch(x,c)
883 :     end
884 :     *)
885 :     | Lambda.SWITCH x => genswitch(x,c)
886 :     | Lambda.LET(v,a,e) =>
887 :     let fun kont(w) =
888 :     let val _ = newname(v,w)
889 :     val _ = addty(v,grabty(w))
890 :     val _ = case w of VAR w' => LV.sameName(v,w')
891 :     | _ => ()
892 :     in convle(e,c)
893 :     end
894 :     in convle(a,kont)
895 :     end
896 :     | Lambda.RAISE(v,t) =>
897 :     let val w = convsv v
898 :     val h = mkv(lt_scont)
899 :     val _ = mkfn(fn u => c(VAR u), t)
900 :     in LOOKER(P.gethdlr,[],h,FUNt,APP(VAR h,[VAR bogus_cont,w]))
901 :     end
902 :     | Lambda.HANDLE(a,b) =>
903 :     let val vb = convsv b
904 :     val (_,t) = arrowLty(grabty(vb))
905 :     val h = mkv(lt_scont)
906 :     val v = mkv(LT.ltc_void)
907 :     val k = mkv(lt_scont)
908 :     val (header,F) = preventEta(c,t)
909 :     fun kont1(va) =
910 :     let val (ul,header1) = mkArgOut(t,va)
911 :     in SETTER(P.sethdlr,[VAR h],
912 :     header1(APP(F,ul)))
913 :     end
914 :     in LOOKER(P.gethdlr,[],h,FUNt,
915 :     header(FIX([(ESCAPE,k,[mkv(lt_vcont),v],
916 :     [CNTt,BOGt],
917 :     SETTER(P.sethdlr,[VAR h],APP(vb,[F,VAR v])))],
918 :     SETTER(P.sethdlr,[VAR k],convle(a,kont1)))))
919 :    
920 :     end
921 :     | Lambda.WRAP(t,_,sv) =>
922 :     let val w = convsv sv
923 :     val t = grabty(w)
924 :     val ct = ctype t
925 :     val x = mkv(LT.ltc_void)
926 :     in PURE(primwrap ct,[w],x,BOGt,c(VAR x))
927 :     end
928 :     | Lambda.UNWRAP(t,_,sv) =>
929 :     let val t = LT.ltc_tyc t
930 :     val ct = ctype t
931 :     val w = convsv sv
932 :     val x = mkv(t)
933 :     in PURE(primunwrap ct,[w],x,ct,c(VAR x))
934 :     end
935 :     | _ => bug "convert.sml 7432894"
936 :    
937 :    
938 :     (***************************************************************************
939 :     * genswitch : (Lambda.lexp * Access.conrep list * (Lambda.con * *
940 :     * Lambda.lexp) list * Lambda.lexp option) * *
941 :     * (value -> cexp) -> cexp *
942 :     ***************************************************************************)
943 :     and genswitch ((sv, sign, l: (Lambda.con * Lambda.lexp) list, d),c) =
944 :     let val df = mkv(ltc_cont [LT.ltc_int])
945 :     val save = ref LT.ltc_void
946 :     val k = mkLvar()
947 :     fun kont1(z) =
948 :     let val t = grabty z
949 :     val _ = (save := t)
950 :     val (ul,header) = mkArgOut(t,z)
951 :     in header(APP(VAR k,ul))
952 :     end
953 :    
954 :     val l' = map (fn(c,e)=>(c,convle(e,kont1))) l
955 :    
956 :     val body=
957 :     do_switch{sign=sign,exp=convsv sv,cases=l',default=APP(VAR df,[INT 0])}
958 :    
959 :     val body' = case d
960 :     of NONE => body
961 :     | SOME d' => FIX([(CONT,df,[mkv(LT.ltc_int)],[INTt],
962 :     convle(d',kont1))], body)
963 :    
964 :     val t = !save
965 :     val v = mkv(t)
966 :     val _ = (addty(k, ltc_cont [t]))
967 :     val (vl,cl,header) = mkArgIn(t,v)
968 :     in FIX([(CONT,k,vl,cl,header(c(VAR v)))],body')
969 :     end
970 :    
971 :     val save = ref LT.ltc_void and k = mkLvar() and f = mkLvar() and v = mkLvar()
972 :     fun kont(w) =
973 :     let val t = grabty(w)
974 :     val (t1,t2) = arrowLty(t)
975 :     val _ = (addty(k, ltc_cont [t2]); addty(f,t); addty(v,t1); save := t1)
976 :     val (ul,header) = mkArgOut(t1,VAR v)
977 :     in header(APP(w,(VAR k)::ul))
978 :     end
979 :    
980 :     (**** We don't support unrolled lists for the time being ****
981 :     val lexp =
982 :     if (MachSpec.newListRep)
983 :     then (TransList.translist(MachSpec.listCellSz,lexp))
984 :     else lexp
985 :     ****)
986 :    
987 :     (* val _ = MCprint.printLexp lexp *)
988 :     val body = convle(lexp,kont)
989 :     val (vl,cl,header) = mkArgIn(!save,v)
990 :    
991 :     val bogus_knownf = mkv(lt_vcont)
992 :     val bogushead =
993 :     fn ce => FIX([(KNOWN,bogus_knownf,[mkv(LT.ltc_void)],[BOGt],
994 :     APP(VAR bogus_knownf,[STRING "bogus"]))],
995 :     FIX([(CONT,bogus_cont,[mkv(LT.ltc_void)],[BOGt],
996 :     APP(VAR bogus_knownf,[STRING "bogus"]))],ce))
997 :    
998 :     in ((ESCAPE,f,k::vl,CNTt::cl,header(bogushead(body))),typtable)
999 :     end
1000 :    
1001 :     end (* toplevel local *)
1002 :     end (* functor Convert *)
1003 :    
1004 :    

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