![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to generic.sml CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / sml / src / cps|
Return to generic.sml CVS log | Up to [Research Unix] / researchv10no / cmd / sml / src / cps |
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: functor CPSgen(M: CMACHINE) :
3: sig structure CPS : CPS
4: val codegen : (((CPS.lvar * CPS.lvar list * CPS.cexp) * bool) list
5: * (CPS.lvar -> CPS.const)
6: * (CPS.lvar -> bool))
7: -> unit
8: end =
9: struct
10:
11: structure CPS = CPS
12: open CPS M System.Tags Access
13:
14: datatype frag = STANDARD of (lvar * lvar list * cexp) option ref
15: | KNOWN of (lvar list * cexp) * EA list option ref
16: | CONSTfrag of const
17:
18: val standardformals2 = [standardcont, standardarg]
19: val standardformals3 = [standardclosure,standardarg,standardcont]
20: val notastandardformal::_ = miscregs
21: val any = notastandardformal
22:
23: fun isreg' r = case isreg r of NONE => false | _ => true
24:
25: val maxConceivableRegs = 50
26: val knowngen = System.Control.CG.knowngen
27: val stdgen = System.Control.CG.stdgen
28:
29: local
30: val allregs = standardformals3 @ miscregs
31: val num2reg = array(maxConceivableRegs, hd allregs)
32: val _ = app (fn r => case isreg r of SOME i => update(num2reg,i,r)) allregs
33: val allregs' = map (fn r => case isreg r of SOME i => i) allregs
34: val okreg = array(maxConceivableRegs, false)
35: fun mark b = (fn r => case isreg r of (SOME i) => update(okreg,i,b) | _ => ())
36: val _ = app (mark true) allregs
37:
38: in
39: exception Getscratch
40: fun getscratch(preferred, prohibited) =
41: let fun f(x::a) = if okreg sub x then num2reg sub x else f a
42: | f nil = raise Getscratch
43: in app (mark false) prohibited;
44: (case isreg preferred
45: of SOME i => (if okreg sub i then preferred else f allregs')
46: | _ => f allregs')
47: before app (mark true) prohibited
48: handle e => (app (mark true) prohibited; raise e)
49: end
50: end
51:
52: fun split pred nil = (nil,nil)
53: | split pred (a::r) = let val (x,y) = split pred r
54: in if pred a then (a::x, y) else (x, a::y)
55: end
56:
57: fun codegen(funs : ((lvar * lvar list * cexp) * bool) list,
58: ctable : lvar -> const, isconstant : lvar -> bool) =
59: (* isconstant means either constant or label *)
60: let
61: exception Regbind
62: val regbindtable : EA Intmap.intmap = Intmap.new(32, Regbind)
63: val addbinding = Intmap.add regbindtable
64:
65: exception Know
66: val knowtable : frag Intmap.intmap = Intmap.new(32, Know)
67: val addknow = Intmap.add knowtable
68: val know = Intmap.map knowtable
69:
70: exception Freemap
71: val freemaptable : lvar list Intmap.intmap = Intmap.new(32, Freemap)
72: val freemap = Intmap.map freemaptable
73:
74: fun makefrag ((f,vl,e),known) =
75: (addknow(f, if known then (inc knowngen; KNOWN((vl,e),ref NONE))
76: else (inc stdgen; STANDARD(ref(SOME(f,vl,e)))));
77: addbinding(f,newlabel());
78: FreeMap.freemap isconstant (Intmap.add freemaptable) e;
79: f)
80:
81: val frags = ref(map makefrag funs)
82: fun addfrag f = frags := f :: !frags
83:
84: fun regbind v =
85: Intmap.map regbindtable v
86: handle Regbind =>
87: (case ctable v of
88: INTconst i => (immed(i+i+1) handle Overflow =>
89: ErrorMsg.impossible "Overflow in cps/generic.sml")
90: | f => let val lab = newlabel()
91: in addbinding(v,lab); addknow(v, CONSTfrag f); addfrag v; lab
92: end)
93:
94: fun root(RECORD(_,_,e)) = root e
95: | root(SELECT(_,_,_,e)) = root e
96: | root(OFFSET(_,_,_,e)) = root e
97: | root(SWITCH(_,e::_)) = root e
98: | root(PRIMOP(_,_,_,e::_)) = root e
99: | root(e as APP _) = e
100:
101: val root1 = ref(APP(0,[]))
102:
103: fun alloc(v,cexp,default,continue) =
104: let val APP(f,wl) = !root1
105: val proh = map regbind (freemap v)
106: fun delete (z,nil) = nil
107: | delete (z, a::r) = if eqreg a z then r else a::delete(z,r)
108: fun get(good,bad) =
109: let val r = getscratch(good,bad@proh)
110: handle Getscratch => getscratch(default,proh)
111: in addbinding(v,r); continue r
112: end
113: fun find fmls =
114: let fun g(w::wl, r::rl) = if w=v then get(r, delete(r,fmls))
115: else g(wl,rl)
116: | g(nil,nil) = get(default, fmls)
117: | g _ = ErrorMsg.impossible "cps vax 33"
118: in g(wl,fmls)
119: end
120: in if v=f then get(default,standardformals3)
121: else
122: case (know f handle Know => STANDARD(ref NONE))
123: of KNOWN(_,ref(SOME fmls)) => find fmls
124: | KNOWN(_,ref NONE) => get(default,nil)
125: | STANDARD _ => case length wl
126: of 2 => find standardformals2
127: | 3 => find standardformals3
128: | _ => ErrorMsg.impossible "cps vax 44"
129: end
130:
131: fun shuffle(func, args,formals) =
132: let val (fv,used,args,formals) =
133: let val fv = regbind func
134: in if exists (eqreg fv) formals
135: then let val x = getscratch(any, args@formals)
136: in move(fv,x); addbinding(func,x);
137: (x,[x],args,formals)
138: end
139: handle Getscratch =>
140: (addbinding(func,notastandardformal);
141: (notastandardformal, nil, fv::args, notastandardformal::formals))
142: else (fv,[fv],args,formals)
143: end
144: fun mate(a::al, b::bl)= (a,b)::mate(al,bl)
145: | mate _ = nil
146: val (inreg,notinreg) = split (isreg' o #1) (mate(args,formals))
147: val (matched, notmatched) = split (fn(x,y)=>eqreg x y) inreg
148:
149: fun f(nil, used) = ()
150: | f (pairs,used) =
151: let val u' = map #1 pairs @ used
152: fun movable (a, b) = not (exists (eqreg b) u')
153: in case split movable pairs
154: of (nil,(a,b)::r) =>
155: let val x = getscratch(any,u')
156: in move(a,x); f((x,b)::r, used)
157: end
158: | (m,m') => (app move m; f(m', (map #2 m) @ used))
159: end
160: in f(notmatched, (map #1 matched) @ used);
161: app move notinreg;
162: jmp fv
163: end
164:
165: fun allocparams(args,formals) =
166: let fun f(already,a::ar,b::br) =
167: let val z = getscratch(a, already@ar)
168: in addbinding(b,z);
169: if eqreg a z then () else move(a,z);
170: f(z::already,ar,br)
171: end
172: | f(l,nil,nil) = rev l
173: in f(nil,args,formals)
174: end
175:
176: (* Compute the maximum amount of allocation done by this function (in bytes). *)
177: fun sumAlloc exp = let
178: fun sum (RECORD (fields, _, exp'), max) = sum (exp', max+(length fields)+1)
179: | sum (SELECT (_, _, _, exp'), max) = sum (exp', max)
180: | sum (OFFSET (_, _, _, exp'), max) = sum (exp', max)
181: | sum (APP _, max) = max
182: | sum (SWITCH (_, lst), max) = max + lstMax(lst, 0)
183: | sum (PRIMOP (P.makeref, _, _, [exp']), max) = sum (exp', max+2)
184: | sum (PRIMOP (P.delay, _, _, [exp']), max) = sum (exp', max+2)
185: | sum (PRIMOP (P.update, _, _, [exp']), max) = sum (exp', max+4)
186: | sum (PRIMOP (P.:=, _, _, [exp']), max) = sum (exp', max+4)
187: | sum (PRIMOP (P.fadd, _, _, [exp']), max) = sum (exp', max+3)
188: | sum (PRIMOP (P.fsub, _, _, [exp']), max) = sum (exp', max+3)
189: | sum (PRIMOP (P.fmul, _, _, [exp']), max) = sum (exp', max+3)
190: | sum (PRIMOP (P.fdiv, _, _, [exp']), max) = sum (exp', max+3)
191: | sum (PRIMOP (P.fneg, _, _, [exp']), max) = sum (exp', max+3)
192: | sum (PRIMOP (_, _, _, [exp']), max) = sum (exp', max)
193: | sum (PRIMOP (_, _, _, lst), max) = max + lstMax(lst, 0)
194: and lstMax (nil, max) = max
195: |lstMax (e::rest, max) = let val m = sum (e, 0)
196: in
197: if m > max then lstMax(rest, m) else lstMax(rest, max)
198: end
199: in
200: (sum (exp, 0)) * 4
201: end
202:
203: fun genfrag f = case (regbind f, know f)
204: of (_, STANDARD(ref NONE)) => ()
205: | (lab, STANDARD(r as ref (SOME(fname,[f,a,c],e)))) =>
206: (r := NONE;
207: List2.app2 addbinding ([f,a,c],standardformals3);
208: align(); mark();
209: comment(Access.lvarName fname ^ ":\n");
210: genFun(lab, e, SOME standardclosure))
211: | (lab, STANDARD(r as ref (SOME(fname,[f,a],e)))) =>
212: (r := NONE;
213: List2.app2 addbinding ([f,a],standardformals2);
214: align(); mark();
215: comment(Access.lvarName fname ^ ":\n");
216: genFun(lab, e, SOME standardcont))
217: | (_, STANDARD _) => ErrorMsg.impossible "standard with wrong args"
218: | (_, KNOWN _) => ()
219: | (lab, CONSTfrag(REALconst r)) =>
220: (align(); mark(); emitlong(8 * power_tags + tag_embedded);
221: define lab; comment("# real constant " ^ r ^ "\n");
222: realconst r)
223: | (lab, CONSTfrag(STRINGconst s)) =>
224: (align(); mark();
225: emitlong(size s * power_tags + tag_embedded);
226: define lab; emitstring s; align())
227:
228: (* generate a new code label *)
229: and genlab(lab, cexp) = (root1 := root cexp; define lab; gen cexp)
230:
231: (* generate a new function header *)
232: and genFun (lab, cexp, closure) = let
233: val maxAllocSz = sumAlloc cexp
234: in
235: root1 := root cexp;
236: define lab;
237: if (maxAllocSz > 0) (** Won't support "true" concurrency **)
238: then checkLimit (maxAllocSz) else ();
239: case closure of SOME reg => beginStdFn(reg, lab) | _ => ();
240: gen cexp
241: end
242:
243: and gen cexp =
244: case cexp
245: of RECORD(vl,w,e) =>
246: alloc(w, e,any, fn w' =>
247: (record((immed(16*(length vl)+1),OFFp 0) ::
248: map (fn(x,p)=>(regbind x, p)) vl,
249: w');
250: gen e))
251: | SELECT(i,v,w,e) =>
252: alloc(w, e,any, fn w' => (select(i,regbind v,w'); gen e))
253: | OFFSET(i,v,w,e) =>
254: let val v' = regbind v
255: in alloc(w, e,v', fn w' => (offset(i,v',w'); gen e))
256: end
257: | APP(f,args) =>
258: (case (map regbind args,
259: know f handle Know => STANDARD(ref NONE))
260: of (args',KNOWN(_,ref(SOME formals))) =>
261: shuffle(f, args', formals)
262: | (args', KNOWN((vl,cexp), r as ref(NONE))) => let
263: val lab = newlabel();
264: in
265: r := SOME(allocparams(args',vl));
266: (* replace fall-through with a jump to insure a mark
267: * at the beginning of every function.
268: *)
269: jmp lab; align(); mark(); define lab;
270: comment(Access.lvarName f ^ ":\n");
271: genFun (regbind f, cexp, NONE)
272: end
273: | (args' as [_,_], STANDARD (ref NONE)) =>
274: shuffle(f, args',standardformals2)
275: | (args' as [_,_,_], STANDARD (ref NONE)) =>
276: shuffle(f, args',standardformals3)
277: | (args' as [_,_], STANDARD(ref(SOME _))) =>
278: (shuffle(f, args',standardformals2); genfrag f)
279: | (args' as [_,_,_], STANDARD(ref(SOME _))) =>
280: (shuffle(f, args',standardformals3); genfrag f))
281: | SWITCH(v,l) =>
282: let val lab = newlabel()
283: val labs = map (fn _ => newlabel()) l;
284: fun f(i, s::r) = (emitlab(i, s); f(i+4, r))
285: | f(_, nil) = ()
286: fun h(lab::labs, e::es) = (genlab(lab, e); h(labs,es))
287: | h(nil,nil) = ()
288: in fetchindexl(lab, arithtemp, regbind v);
289: jmpindexb lab;
290: (* align(); temporarily removed so 68020 will work. *)
291: define lab;
292: f (0, labs);
293: h(labs,l)
294: end
295:
296: | PRIMOP (i,vl,wl,el) => primops i (vl,wl,el)
297:
298: (* warning: on three-address instructions, be careful about
299: non-pointers in registers. On some machines,
300: addl3(a,b,c) is translated to: mov(b,c); add(a,c);
301: and it's dangerous when b is a non-pointer. In such a case,
302: usually a is "safe", so that addl3(b,a,c) works better.
303: The rule is, therefore: if the destination is a pointer register,
304: then b must also be a tagged value *)
305:
306: and arithprof i = () (* profile(Profile.ARITHOVH+i,2) *)
307: and compare(branch,test) ([v,w],[],[d,e]) =
308: let val lab = newlabel()
309: in branch(test,regbind v, regbind w, lab);
310: gen d; genlab(lab, e)
311: end
312: and primops p =
313: case p of
314: P.+ => (fn ([v,w],[x],[e]) =>
315: let val v' = regbind v and w' = regbind w
316: in case (isimmed v', isimmed w') of
317: (SOME k, _) =>
318: (arithprof 0; alloc(x,e,w', fn x' => addl3t(immed(k-1),w',x')))
319: (* the next case must be done (by all machines) with v and x in
320: root registers (for offset computations in "boot") *)
321: | (_, SOME k) =>
322: (arithprof 0; alloc(x,e,v', fn x' => addl3t(immed(k-1),v',x')))
323: | _ => alloc(x,e,w',fn x' => (arithprof 1;
324: subl3(immed 1,v',arithtemp);
325: addl3t(arithtemp, w', x')));
326: gen e
327: end)
328: | P.orb => (fn ([v,w],[x],[e]) =>
329: let val w' = regbind w
330: in alloc(x,e,w', fn x' => (orb(regbind v, w', x'); gen e))
331: end)
332: | P.andb => (fn ([v,w],[x],[e]) =>
333: let val w' = regbind w
334: in alloc(x,e,w', fn x' => (andb(regbind v, w', x'); gen e))
335: end)
336: | P.xorb => (fn ([v,w],[x],[e]) =>
337: let val v' = regbind v and w' = regbind w
338: in alloc(x,e,any,fn x' => (case (isimmed v', isimmed w') of
339: (SOME k,_) => xorb(immed(k-1), w', arithtemp)
340: | (_,SOME k) => xorb(v', immed(k-1), arithtemp)
341: | _ => (xorb(v', w', arithtemp); orb(immed 1, arithtemp, x'));
342: gen e))
343: end)
344: | P.notb => (fn ([v],[x],[e]) =>
345: alloc(x,e,regbind v, fn x' =>
346: (notb(regbind v, x');
347: orb(immed 1, x', x');
348: gen e)))
349: | P.lshift => (fn ([v,w],[x],[e]) =>
350: let val v' = regbind v and w' = regbind w
351: in alloc(x,e,any, fn x' =>
352: (case (isimmed v', isimmed w') of
353: (SOME k,_) =>
354: (ashr(immed 1,w',arithtemp); ashl(arithtemp,immed(k-1), x'))
355: | (_,SOME k) =>
356: (addl3(immed(~1),v',arithtemp);
357: ashl(immed(Bits.rshift(k,1)), arithtemp, x'))
358: | _ =>
359: (ashr(immed 1, w',arithtemp);
360: addl3(immed(~1),v',arithtemp2);
361: ashl(arithtemp, arithtemp2, x'));
362: orb(immed 1, x', x');
363: gen e))
364: end)
365: | P.rshift => (fn ([v,w],[x],[e]) =>
366: let val v' = regbind v and w' = regbind w
367: in alloc(x,e,v', fn x' =>
368: (case isimmed w' of
369: SOME k => ashr(immed(Bits.rshift(k,1)), v', x')
370: | _ => (ashr(immed 1, w',arithtemp); ashr(arithtemp, v', x'));
371: orb(immed 1, x', x');
372: gen e))
373: end)
374: | P.- => (fn ([v,w],[x],[e]) =>
375: let val v' = regbind v and w' = regbind w
376: in case (isimmed v', isimmed w') of
377: (SOME k, _) => (arithprof 0; alloc(x,e,w', fn x' =>
378: subl3t(w', immed(k+1), x')))
379: | (_, SOME k) => (arithprof 0; alloc(x,e,v', fn x' =>
380: subl3t(immed(k-1),v',x')))
381: | _ => alloc(x, e,v',fn x' => (arithprof 1;
382: subl3(immed 1,w',arithtemp);
383: subl3t(arithtemp, v', x')));
384: gen e
385: end)
386: | P.* => (fn ([v,w],[x],[e]) =>
387: let val v' = regbind v and w' = regbind w
388: in alloc(x,e,any,fn x' =>
389: (arithprof 3;
390: case (isimmed v', isimmed w') of
391: (SOME k,_) => (ashr(immed 1, w', arithtemp);
392: mull2t(immed(k-1),arithtemp))
393: | (_,SOME k) => (ashr(immed 1, v', arithtemp);
394: mull2t(immed(k-1),arithtemp))
395: | _ => (ashr(immed 1, v', arithtemp);
396: subl3(immed 1, w', arithtemp2);
397: mull2t(arithtemp2,arithtemp));
398: orb(immed 1,arithtemp,x');
399: gen e))
400: end)
401: | P.div => (fn ([v,w],[x],[e]) =>
402: let val v' = regbind v and w' = regbind w
403: in alloc(x, e,any, fn x' =>
404: (arithprof 4;
405: case (isimmed v', isimmed w') of
406: (SOME k,_) =>
407: (move(immed(Bits.rshift(k,1)),arithtemp);
408: ashr(immed 1, w', arithtemp2);
409: divl2(arithtemp2,arithtemp))
410: | (_,SOME k) =>
411: (ashr(immed 1, v', arithtemp);
412: divl2(immed(Bits.rshift(k,1)),arithtemp))
413: | _ =>
414: (ashr(immed 1, v', arithtemp);
415: ashr(immed 1, w', arithtemp2);
416: divl2(arithtemp2,arithtemp));
417: addl3(arithtemp, arithtemp, arithtemp);
418: orb(immed 1, arithtemp,x');
419: gen e))
420: end)
421: | P.! => (fn ([v],[w],[e]) => gen(SELECT(0,v,w,e)))
422: | P.:= => (fn ([v,w],[],[e]) =>
423: let val v' = regbind v
424: in record([(immed(16*3+1),OFFp 0), (v', OFFp 0),
425: (immed 1, OFFp 0), (storeptr, OFFp 0)], storeptr);
426: storeindexl(regbind w, v', immed 1);
427: gen e
428: end)
429: | P.unboxedassign => (fn ([v,w],[],[e]) =>
430: (storeindexl(regbind w, regbind v, immed 1); gen e))
431: | P.~ => (fn ([v],[w],[e]) =>
432: alloc(w,e,any,fn w' => (arithprof 0;subl3t(regbind v,immed 2,w');gen e)))
433: | P.makeref =>
434: (fn ([v],[w],[e]) =>
435: alloc(w, e,any, fn w' =>
436: (if !CGoptions.profile then profile(Profile.REFCELLS,2) else ();
437: record([(immed(power_tags+tag_array),OFFp 0),
438: (regbind v, OFFp 0)], w');
439: gen e)))
440: | P.delay =>
441: (fn ([i,v],[w],[e]) =>
442: alloc(w, e,any, fn w' =>
443: (if !CGoptions.profile then profile(Profile.REFCELLS,2) else ();
444: record([(regbind i, OFFp 0),(regbind v, OFFp 0)], w');
445: gen e)))
446: | P.ieql => compare(ibranch,NEQ)
447: | P.ineq => compare(ibranch,EQL)
448: | P.> => compare(ibranch,LEQ)
449: | P.>= => compare(ibranch,LSS)
450: | P.< => compare(ibranch,GEQ)
451: | P.<= => compare(ibranch,GTR)
452: | P.subscript => (fn ([v,w],[x],[e]) =>
453: alloc(x, e,any, fn x' =>
454: (arithprof 1;
455: fetchindexl(regbind v, x', regbind w);
456: gen e)))
457: | P.update => (fn ([a, i, v], [], [e]) =>
458: let val a' = regbind a and i' = regbind i
459: in arithprof 1;
460: record([(immed(16*3+1),OFFp 0), (a',OFFp 0),
461: (i', OFFp 0), (storeptr, OFFp 0)], storeptr);
462: storeindexl(regbind v, a', i');
463: gen e
464: end)
465: | P.unboxedupdate => (fn ([a, i, v], [], [e]) =>
466: (arithprof 1;
467: storeindexl(regbind v, regbind a, regbind i);
468: gen e))
469: | P.alength => (fn ([a], [w], [e]) =>
470: alloc(w, e,any, fn w' =>
471: (arithprof 1;
472: select(~1, regbind a, arithtemp);
473: ashr(immed(width_tags-1),arithtemp, arithtemp);
474: (* orb(immed 1, arithtemp, w');
475: this didn't work on the mc68020, dammit! *)
476: orb(immed 1, arithtemp, arithtemp);
477: move(arithtemp,w');
478: gen e)))
479: | P.slength => (fn ([a], [w], [e]) =>
480: alloc(w, e,any, fn w' =>
481: let val a' = regbind a
482: in if isreg' a'
483: then select(~1,a',arithtemp)
484: else (move(a',w'); select(~1,w',arithtemp));
485: ashr(immed(width_tags-1), arithtemp, arithtemp);
486: (* orb(immed 1, arithtemp, w');
487: this didn't work on the mc68020, dammit! *)
488: arithprof 1;
489: orb(immed 1, arithtemp, arithtemp);
490: move(arithtemp,w');
491: gen e
492: end))
493: | P.store => (fn ([s,i,v], [], [e]) =>
494: (arithprof 2;
495: ashr(immed 1, regbind i, arithtemp);
496: ashr(immed 1, regbind v, arithtemp2);
497: storeindexb(arithtemp2, regbind s);
498: gen e))
499: | P.ordof => (fn ([s,i], [v], [e]) =>
500: alloc(v, e,any, fn v' =>
501: let val s' = regbind s
502: in arithprof 3;
503: ashr(immed 1, regbind i, arithtemp);
504: if isreg' s' then fetchindexb(s', arithtemp2)
505: else (move(s',v'); fetchindexb(v',arithtemp2));
506: addl3(arithtemp2,arithtemp2,arithtemp2);
507: orb(immed 1, arithtemp2, v');
508: gen e
509: end))
510: | P.fneg => (fn ([x], [y], [e]) =>
511: alloc(y, e,any, fn y' => (mnegg(regbind x, y'); gen e)))
512: | P.profile => (fn ([index,incr],[],[c]) =>
513: (case (isimmed(regbind index), isimmed(regbind incr))
514: of (SOME i, SOME v) => profile(i div 2,(v div 2)*2);
515: gen c))
516: | P.boxed => (fn ([x],[],[a,b]) =>
517: let val lab = newlabel()
518: in bbs(immed 0, regbind x, lab); gen a; genlab(lab, b)
519: end)
520: | P.gethdlr => (fn ([],[x],[e]) =>
521: alloc(x, e,any, fn x' => (move(exnptr,x'); gen e)))
522: | P.sethdlr => (fn ([x],[],[e]) => (move(regbind x, exnptr); gen e))
523: | P.fmul => (fn ([x,y], [z], [e]) =>
524: alloc(z, e,any, fn z' =>
525: (mulg3(regbind x, regbind y, z'); gen e)))
526: | P.fdiv => (fn ([x,y], [z], [e]) =>
527: alloc(z, e,any, fn z' =>
528: (divg3(regbind x, regbind y, z'); gen e)))
529: | P.fadd => (fn ([x,y], [z], [e]) =>
530: alloc(z, e,any, fn z' =>
531: (addg3(regbind x, regbind y, z'); gen e)))
532: | P.fsub => (fn ([x,y], [z], [e]) =>
533: alloc(z, e,any, fn z' =>
534: (subg3(regbind x, regbind y, z'); gen e)))
535: | P.feql => compare(gbranch,NEQ)
536: | P.fneq => compare(gbranch,EQL)
537: | P.fgt => compare(gbranch,LEQ)
538: | P.flt => compare(gbranch,GEQ)
539: | P.fge => compare(gbranch,LSS)
540: | P.fle => compare(gbranch,GTR)
541:
542: in emitlong 1; (* Bogus tag for spacing, boot_v. *)
543: let fun loop nil = ()
544: | loop (frag::r) = (frags := r; genfrag frag; loop(!frags))
545: in loop(!frags)
546: end
547: (* before print "Done!\n" *)
548: end
549:
550: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.