File:  [Research Unix] / researchv10no / cmd / sml / src / cps / generic.sml
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 17:21:34 2018 UTC (8 years, 1 month ago) by root
Branches: belllabs, MAIN
CVS tags: researchv10, HEAD
researchv10 Norman

(* Copyright 1989 by AT&T Bell Laboratories *)
functor CPSgen(M: CMACHINE) :
  sig structure CPS : CPS
    val codegen : (((CPS.lvar * CPS.lvar list * CPS.cexp) * bool) list
		   * (CPS.lvar -> CPS.const)
		   * (CPS.lvar -> bool))
		   -> unit
  end =
struct

structure CPS = CPS
open CPS M System.Tags Access

datatype frag = STANDARD of (lvar * lvar list * cexp) option ref
	      | KNOWN of (lvar list * cexp) * EA list option ref
	      | CONSTfrag of const

val standardformals2 = [standardcont, standardarg]
val standardformals3 = [standardclosure,standardarg,standardcont]
val notastandardformal::_ = miscregs
val any = notastandardformal

fun isreg' r = case isreg r of NONE => false | _ => true

val maxConceivableRegs = 50
val knowngen = System.Control.CG.knowngen
val stdgen = System.Control.CG.stdgen

local
  val allregs = standardformals3 @ miscregs
  val num2reg = array(maxConceivableRegs, hd allregs)
  val _ = app (fn r => case isreg r of SOME i => update(num2reg,i,r)) allregs
  val allregs' = map (fn r => case isreg r of SOME i => i) allregs
  val okreg = array(maxConceivableRegs, false)
  fun mark b = (fn r => case isreg r of (SOME i) => update(okreg,i,b) | _ => ())
  val _ = app (mark true) allregs

 in
    exception Getscratch
    fun getscratch(preferred, prohibited) =
        let fun f(x::a) = if okreg sub x then num2reg sub x else f a
              | f nil = raise Getscratch
         in app (mark false) prohibited;
	    (case isreg preferred
	     of SOME i => (if okreg sub i then preferred else f allregs')
	      | _ => f allregs')
	     before app (mark true) prohibited
	    handle e => (app (mark true) prohibited; raise e)
        end
end

fun split pred nil = (nil,nil)
  | split pred (a::r) = let val (x,y) = split pred r
			 in if pred a then (a::x, y) else (x, a::y)
		        end

fun codegen(funs : ((lvar * lvar list * cexp) * bool) list,
	    ctable : lvar -> const, isconstant : lvar -> bool) =
(* isconstant means either constant or label *)
let 
    exception Regbind
    val regbindtable : EA Intmap.intmap = Intmap.new(32, Regbind)
    val addbinding = Intmap.add regbindtable

    exception Know
    val knowtable : frag Intmap.intmap = Intmap.new(32, Know)
    val addknow = Intmap.add knowtable
    val know = Intmap.map knowtable

    exception Freemap
    val freemaptable : lvar list Intmap.intmap = Intmap.new(32, Freemap)
    val freemap = Intmap.map freemaptable

    fun makefrag ((f,vl,e),known) = 
	(addknow(f, if known then (inc knowngen; KNOWN((vl,e),ref NONE))
			     else (inc stdgen; STANDARD(ref(SOME(f,vl,e)))));
	 addbinding(f,newlabel());
	 FreeMap.freemap isconstant (Intmap.add freemaptable) e;
	 f)

    val frags = ref(map makefrag funs)
    fun addfrag f = frags := f :: !frags

    fun regbind v =
      Intmap.map regbindtable v
      handle Regbind =>
      (case ctable v of
	 INTconst i => (immed(i+i+1) handle Overflow =>
		        ErrorMsg.impossible "Overflow in cps/generic.sml")
       | f => let val lab = newlabel()
	      in addbinding(v,lab); addknow(v, CONSTfrag f); addfrag v; lab
	      end)

    fun root(RECORD(_,_,e)) = root e
      | root(SELECT(_,_,_,e)) = root e
      | root(OFFSET(_,_,_,e)) = root e
      | root(SWITCH(_,e::_)) = root e
      | root(PRIMOP(_,_,_,e::_)) = root e
      | root(e as APP _) = e

    val root1 = ref(APP(0,[]))

    fun alloc(v,cexp,default,continue) =
	let val APP(f,wl) = !root1
	    val proh = map regbind (freemap v)
	    fun delete (z,nil) = nil
	      | delete (z, a::r) = if eqreg a z then r else a::delete(z,r)
	    fun get(good,bad) =
		let val r = getscratch(good,bad@proh)
		            handle Getscratch => getscratch(default,proh)
	         in addbinding(v,r); continue r
		end
	    fun find fmls = 
               let fun g(w::wl, r::rl) = if w=v then get(r, delete(r,fmls))
					        else g(wl,rl)
		     | g(nil,nil) = get(default, fmls)
		     | g _ = ErrorMsg.impossible "cps vax 33"
		in g(wl,fmls)
	       end
         in if v=f then get(default,standardformals3)
	    else
	    case (know f handle Know => STANDARD(ref NONE))
	     of KNOWN(_,ref(SOME fmls)) => find fmls
	      | KNOWN(_,ref NONE) => get(default,nil)
	      | STANDARD _ => case length wl
		 	       of 2 => find standardformals2
				| 3 => find standardformals3
			        | _ => ErrorMsg.impossible "cps vax 44"
        end

    fun shuffle(func, args,formals) =
      let val (fv,used,args,formals) =
	    let val fv = regbind func
	     in if exists (eqreg fv) formals
		  then let val x = getscratch(any, args@formals)
			in move(fv,x); addbinding(func,x);
			   (x,[x],args,formals)
		       end
		    handle Getscratch =>
		     (addbinding(func,notastandardformal);
		      (notastandardformal, nil, fv::args, notastandardformal::formals))
		  else (fv,[fv],args,formals)
	    end
	  fun mate(a::al, b::bl)= (a,b)::mate(al,bl) 
	    | mate _ = nil
	  val (inreg,notinreg) = split (isreg' o #1) (mate(args,formals))
	  val (matched, notmatched) = split (fn(x,y)=>eqreg x y) inreg

	  fun f(nil, used) = ()
	    | f (pairs,used) = 
	    let val u' = map #1 pairs @ used
	        fun movable (a, b) = not (exists (eqreg b) u')
	     in case split movable pairs
	         of (nil,(a,b)::r) => 
			    let val x = getscratch(any,u')
			      in move(a,x); f((x,b)::r, used)
			    end
	          | (m,m') => (app move m; f(m', (map #2 m) @ used))
	    end
      in f(notmatched, (map #1 matched) @ used);
         app move notinreg;
	 jmp fv
     end

    fun allocparams(args,formals) =
       let fun f(already,a::ar,b::br) =
		let val z = getscratch(a, already@ar)
		 in addbinding(b,z); 
		    if eqreg a z then () else move(a,z);
		       f(z::already,ar,br)
		end
	     | f(l,nil,nil) = rev l
	in f(nil,args,formals)
       end

  (* Compute the maximum amount of allocation done by this function (in bytes). *)
    fun sumAlloc exp = let
	  fun sum (RECORD (fields, _, exp'), max) = sum (exp', max+(length fields)+1)
	    | sum (SELECT (_, _, _, exp'), max) = sum (exp', max)
	    | sum (OFFSET (_, _, _, exp'), max) = sum (exp', max)
	    | sum (APP _, max) = max
	    | sum (SWITCH (_, lst), max) = max + lstMax(lst, 0)
	    | sum (PRIMOP (P.makeref, _, _, [exp']), max) = sum (exp', max+2)
	    | sum (PRIMOP (P.delay, _, _, [exp']), max) = sum (exp', max+2)
	    | sum (PRIMOP (P.update, _, _, [exp']), max) = sum (exp', max+4)
	    | sum (PRIMOP (P.:=, _, _, [exp']), max) = sum (exp', max+4)
	    | sum (PRIMOP (P.fadd, _, _, [exp']), max) = sum (exp', max+3)
	    | sum (PRIMOP (P.fsub, _, _, [exp']), max) = sum (exp', max+3)
	    | sum (PRIMOP (P.fmul, _, _, [exp']), max) = sum (exp', max+3)
	    | sum (PRIMOP (P.fdiv, _, _, [exp']), max) = sum (exp', max+3)
	    | sum (PRIMOP (P.fneg, _, _, [exp']), max) = sum (exp', max+3)
	    | sum (PRIMOP (_, _, _, [exp']), max) = sum (exp', max)
	    | sum (PRIMOP (_, _, _, lst), max) = max + lstMax(lst, 0)
	  and lstMax (nil, max) = max
	    |lstMax (e::rest, max) = let val m = sum (e, 0)
		in
		  if m > max then lstMax(rest, m) else lstMax(rest, max)
		end
	  in
	    (sum (exp, 0)) * 4
	  end

    fun genfrag f = case (regbind f, know f)
	    of (_, STANDARD(ref NONE)) => ()
	     | (lab, STANDARD(r as ref (SOME(fname,[f,a,c],e)))) =>
		    (r := NONE;
		     List2.app2 addbinding ([f,a,c],standardformals3);
		     align(); mark();
		     comment(Access.lvarName fname ^ ":\n");
		     genFun(lab, e, SOME standardclosure))
	     | (lab, STANDARD(r as ref (SOME(fname,[f,a],e)))) =>
		    (r := NONE;
		     List2.app2 addbinding ([f,a],standardformals2);
		     align(); mark();
		     comment(Access.lvarName fname ^ ":\n");
		     genFun(lab, e, SOME standardcont))
	     | (_, STANDARD _) => ErrorMsg.impossible "standard with wrong args"
	     | (_, KNOWN _) => ()
	     | (lab, CONSTfrag(REALconst r)) =>
		    (align(); mark(); emitlong(8 * power_tags + tag_embedded);
		     define lab; comment("# real constant " ^ r ^ "\n");
		     realconst r)
	     | (lab, CONSTfrag(STRINGconst s)) =>
		    (align(); mark();
		     emitlong(size s * power_tags + tag_embedded);
		     define lab; emitstring s; align())

  (* generate a new code label *)
    and genlab(lab, cexp) = (root1 := root cexp; define lab; gen cexp)

  (* generate a new function header *)
    and genFun (lab, cexp, closure) = let
	  val maxAllocSz = sumAlloc cexp
	  in
	    root1 := root cexp;
	    define lab;
	    if (maxAllocSz > 0)  (** Won't support "true" concurrency **)
	      then checkLimit (maxAllocSz) else ();
	    case closure of SOME reg => beginStdFn(reg, lab) | _ => ();
	    gen cexp
	  end

    and gen cexp =
	case cexp
	 of RECORD(vl,w,e) =>
		 alloc(w, e,any,  fn w' => 
			   (record((immed(16*(length vl)+1),OFFp 0) ::
				      map (fn(x,p)=>(regbind x, p)) vl,
			           w');
			    gen e))
	  | SELECT(i,v,w,e) =>
	    alloc(w, e,any,  fn w' => (select(i,regbind v,w'); gen e))
	  | OFFSET(i,v,w,e) =>
	    let val v' = regbind v
	    in alloc(w, e,v', fn w' => (offset(i,v',w'); gen e))
	    end
	  | APP(f,args) =>
	    (case (map regbind args,
		   know f handle Know => STANDARD(ref NONE))
	      of (args',KNOWN(_,ref(SOME formals))) =>
			  shuffle(f, args', formals)
	       | (args', KNOWN((vl,cexp), r as ref(NONE))) => let
			  val lab = newlabel();
			  in
		    	    r := SOME(allocparams(args',vl));
			  (* replace fall-through with a jump to insure a mark
			   * at the beginning of every function.
			   *)
			    jmp lab; align(); mark(); define lab;
		    	    comment(Access.lvarName f ^ ":\n");
			    genFun (regbind f, cexp, NONE)
			  end
	       | (args' as [_,_], STANDARD (ref NONE)) =>
			  shuffle(f, args',standardformals2)
	       | (args' as [_,_,_], STANDARD (ref NONE)) =>
			  shuffle(f, args',standardformals3)
	       | (args' as [_,_], STANDARD(ref(SOME _))) =>
		          (shuffle(f, args',standardformals2); genfrag f)
	       | (args' as [_,_,_], STANDARD(ref(SOME _))) =>
		          (shuffle(f, args',standardformals3); genfrag f))
	  | SWITCH(v,l) => 
		let val lab = newlabel()
		    val labs = map (fn _ => newlabel()) l;
		    fun f(i, s::r) = (emitlab(i, s); f(i+4, r))
		      | f(_, nil) = ()
		    fun h(lab::labs, e::es) = (genlab(lab, e); h(labs,es))
		      | h(nil,nil) = ()
		 in fetchindexl(lab, arithtemp, regbind v);
		    jmpindexb lab;
(*		    align();   temporarily removed so 68020 will work. *)
		    define lab;
		    f (0, labs);
		    h(labs,l)
		end

	  | PRIMOP (i,vl,wl,el) => primops i (vl,wl,el)

(* warning:  on three-address instructions, be careful about 
   non-pointers in registers.  On some machines,
    addl3(a,b,c) is translated to:   mov(b,c); add(a,c);
   and it's dangerous when b is a non-pointer.  In such a case,
   usually a is "safe", so that addl3(b,a,c) works better.
  The rule is, therefore:  if the destination is a pointer register,
    then b must also be a tagged value *)

    and arithprof i = () (* profile(Profile.ARITHOVH+i,2) *)
    and compare(branch,test) ([v,w],[],[d,e]) =
		let val lab = newlabel()
		 in branch(test,regbind v, regbind w, lab); 
		    gen d; genlab(lab, e)
		end
    and primops p =
        case p of
          P.+ => (fn ([v,w],[x],[e]) =>
	  let val v' = regbind v and w' = regbind w
	  in case (isimmed v', isimmed w') of
	       (SOME k, _) =>
                 (arithprof 0; alloc(x,e,w', fn x' => addl3t(immed(k-1),w',x')))
(* the next case must be done (by all machines) with v and x in
   root registers (for offset computations in "boot") *)
	     | (_, SOME k) =>
                 (arithprof 0; alloc(x,e,v', fn x' => addl3t(immed(k-1),v',x')))
	     | _ => alloc(x,e,w',fn x' => (arithprof 1;
					   subl3(immed 1,v',arithtemp);
					   addl3t(arithtemp, w', x')));
	     gen e
	  end)
       | P.orb => (fn ([v,w],[x],[e]) =>
        let val w' =  regbind w
         in alloc(x,e,w', fn x' => (orb(regbind v, w', x'); gen e))
        end)
       | P.andb => (fn ([v,w],[x],[e]) =>
        let val w' =  regbind w
         in alloc(x,e,w', fn x' => (andb(regbind v, w', x'); gen e))
        end)
       | P.xorb => (fn ([v,w],[x],[e]) =>
         let val v' = regbind v and w' = regbind w
	 in alloc(x,e,any,fn x' => (case (isimmed v', isimmed w') of
	      (SOME k,_) => xorb(immed(k-1), w', arithtemp)
	    | (_,SOME k) => xorb(v', immed(k-1), arithtemp)
	    | _ => (xorb(v', w', arithtemp); orb(immed 1, arithtemp, x'));
				    gen e))
	 end)
       | P.notb => (fn ([v],[x],[e]) =>
          alloc(x,e,regbind v, fn x' =>
	     (notb(regbind v, x');
	      orb(immed 1, x', x');
	      gen e)))
       | P.lshift => (fn ([v,w],[x],[e]) =>
         let val v' = regbind v and w' = regbind w
	 in alloc(x,e,any, fn x' => 
		  (case (isimmed v', isimmed w') of
		     (SOME k,_) =>
          (ashr(immed 1,w',arithtemp); ashl(arithtemp,immed(k-1), x'))
		   | (_,SOME k) => 
	  (addl3(immed(~1),v',arithtemp);
	   ashl(immed(Bits.rshift(k,1)), arithtemp, x'))
		   | _ => 
          (ashr(immed 1, w',arithtemp);
	   addl3(immed(~1),v',arithtemp2);
           ashl(arithtemp, arithtemp2, x'));
		   orb(immed 1, x', x');
		   gen e))
	 end)
       | P.rshift => (fn ([v,w],[x],[e]) =>
         let val v' = regbind v and w' = regbind w
         in alloc(x,e,v', fn x' => 
            (case isimmed w' of
	       SOME k => ashr(immed(Bits.rshift(k,1)), v', x')
	     | _ => (ashr(immed 1, w',arithtemp); ashr(arithtemp, v', x'));
	     orb(immed 1, x', x');
	     gen e))
         end)
       | P.- => (fn ([v,w],[x],[e]) =>
	 let val v' = regbind v and w' = regbind w
	 in case (isimmed v', isimmed w') of
	      (SOME k, _) => (arithprof 0; alloc(x,e,w', fn x' => 
			      subl3t(w', immed(k+1), x')))
	    | (_, SOME k) => (arithprof 0; alloc(x,e,v', fn x' =>
				     subl3t(immed(k-1),v',x')))
	    | _ => alloc(x, e,v',fn x' => (arithprof 1;
					   subl3(immed 1,w',arithtemp);
					   subl3t(arithtemp, v', x')));
	    gen e
	 end)
       | P.* => (fn ([v,w],[x],[e]) =>
         let val v' = regbind v and w' = regbind w
         in alloc(x,e,any,fn x' =>
            (arithprof 3;
	     case (isimmed v', isimmed w') of
               (SOME k,_) => (ashr(immed 1, w', arithtemp);
			      mull2t(immed(k-1),arithtemp))
	     | (_,SOME k) => (ashr(immed 1, v', arithtemp);
			      mull2t(immed(k-1),arithtemp))
	     | _ => (ashr(immed 1, v', arithtemp);
		     subl3(immed 1, w', arithtemp2);
		     mull2t(arithtemp2,arithtemp));
	     orb(immed 1,arithtemp,x');
	     gen e))
         end)				  
       | P.div => (fn ([v,w],[x],[e]) =>
         let val v' = regbind v and w' = regbind w
         in alloc(x, e,any, fn x' =>
		  (arithprof 4;
		   case (isimmed v', isimmed w') of
		      (SOME k,_) =>
			(move(immed(Bits.rshift(k,1)),arithtemp);
			 ashr(immed 1, w', arithtemp2);
			 divl2(arithtemp2,arithtemp))
		    | (_,SOME k) => 
			(ashr(immed 1, v', arithtemp);
			 divl2(immed(Bits.rshift(k,1)),arithtemp))
		    | _ => 
			(ashr(immed 1, v', arithtemp);
			 ashr(immed 1, w', arithtemp2);
			 divl2(arithtemp2,arithtemp));
		    addl3(arithtemp, arithtemp, arithtemp);
		    orb(immed 1, arithtemp,x');
		    gen e))
         end)
       | P.! => (fn ([v],[w],[e]) => gen(SELECT(0,v,w,e)))
       | P.:= => (fn ([v,w],[],[e]) =>
	    let val v' = regbind v
	     in record([(immed(16*3+1),OFFp 0), (v', OFFp 0),
		       (immed 1, OFFp 0), (storeptr, OFFp 0)], storeptr);
	        storeindexl(regbind w, v', immed 1);
	        gen e
	    end)
       | P.unboxedassign => (fn ([v,w],[],[e]) =>
              (storeindexl(regbind w, regbind v, immed 1); gen e))
       | P.~ => (fn ([v],[w],[e]) =>
	 alloc(w,e,any,fn w' => (arithprof 0;subl3t(regbind v,immed 2,w');gen e)))
       | P.makeref =>
	 (fn ([v],[w],[e]) =>
	    alloc(w, e,any, fn w' =>
		(if !CGoptions.profile then profile(Profile.REFCELLS,2) else ();
		 record([(immed(power_tags+tag_array),OFFp 0),
			 (regbind v, OFFp 0)], w');
		 gen e)))
       | P.delay =>
	 (fn ([i,v],[w],[e]) =>
	    alloc(w, e,any, fn w' =>
		(if !CGoptions.profile then profile(Profile.REFCELLS,2) else ();
		 record([(regbind i, OFFp 0),(regbind v, OFFp 0)], w');
		 gen e)))
       | P.ieql => compare(ibranch,NEQ)
       | P.ineq => compare(ibranch,EQL)
       | P.> => compare(ibranch,LEQ)
       | P.>= => compare(ibranch,LSS)
       | P.< => compare(ibranch,GEQ)
       | P.<= => compare(ibranch,GTR)
       | P.subscript => (fn ([v,w],[x],[e]) =>
			alloc(x, e,any, fn x' =>
			    (arithprof 1;
			     fetchindexl(regbind v, x', regbind w);
			     gen e)))
       | P.update => (fn ([a, i, v], [], [e]) =>
	    let val a' = regbind a and i' = regbind i
	     in arithprof 1;
	        record([(immed(16*3+1),OFFp 0), (a',OFFp 0),
		        (i', OFFp 0), (storeptr, OFFp 0)], storeptr);
	        storeindexl(regbind v, a', i');
	        gen e
	    end)
       | P.unboxedupdate => (fn ([a, i, v], [], [e]) =>
	(arithprof 1;
	 storeindexl(regbind v, regbind a, regbind i);
	 gen e))
       | P.alength => (fn ([a], [w], [e]) =>
	alloc(w,  e,any,  fn w' =>
	    (arithprof 1;
	     select(~1, regbind a, arithtemp);
	     ashr(immed(width_tags-1),arithtemp, arithtemp);
(*	     orb(immed 1, arithtemp, w');
	this didn't work on the mc68020, dammit! *)
	     orb(immed 1, arithtemp, arithtemp);
	     move(arithtemp,w');
	     gen e)))
       | P.slength => (fn ([a], [w], [e]) =>
	  alloc(w, e,any, fn w' =>
	    let val a' = regbind a
	     in if isreg' a'
		   then select(~1,a',arithtemp)
		   else (move(a',w'); select(~1,w',arithtemp));
	        ashr(immed(width_tags-1), arithtemp, arithtemp);
(*	     orb(immed 1, arithtemp, w');
	this didn't work on the mc68020, dammit! *)
	     arithprof 1;
	     orb(immed 1, arithtemp, arithtemp);
	     move(arithtemp,w');
	        gen e
	    end))
       | P.store => (fn ([s,i,v], [], [e])  =>
	       (arithprof 2;
	        ashr(immed 1, regbind i, arithtemp);
		ashr(immed 1, regbind v, arithtemp2);
		storeindexb(arithtemp2, regbind s);
	        gen e))
       | P.ordof => (fn ([s,i], [v], [e]) =>
	    alloc(v, e,any, fn v' =>
	    let val s' = regbind s
	     in arithprof 3;
	        ashr(immed 1, regbind i, arithtemp);
	        if isreg' s' then fetchindexb(s', arithtemp2)
		 else (move(s',v'); fetchindexb(v',arithtemp2));
		addl3(arithtemp2,arithtemp2,arithtemp2);
		orb(immed 1, arithtemp2, v');
	        gen e
	    end))
       | P.fneg => (fn ([x], [y], [e]) =>
	    alloc(y, e,any, fn y' => (mnegg(regbind x, y'); gen e)))
       | P.profile => (fn ([index,incr],[],[c]) =>
			(case (isimmed(regbind index), isimmed(regbind incr))
			  of (SOME i, SOME v) => profile(i div 2,(v div 2)*2);
			 gen c))
       | P.boxed => (fn ([x],[],[a,b]) =>
		    let val lab = newlabel()
		     in bbs(immed 0, regbind x, lab); gen a; genlab(lab, b)
		    end)
       | P.gethdlr => (fn ([],[x],[e]) =>
		  alloc(x, e,any, fn x' => (move(exnptr,x'); gen e)))
       | P.sethdlr => (fn ([x],[],[e]) => (move(regbind x, exnptr); gen e))
       | P.fmul =>  (fn ([x,y], [z], [e]) =>
		alloc(z,  e,any, fn z' =>
		 (mulg3(regbind x, regbind y, z'); gen e)))
       | P.fdiv =>  (fn ([x,y], [z], [e]) =>
		alloc(z,  e,any, fn z' =>
		 (divg3(regbind x, regbind y, z'); gen e)))
       | P.fadd => (fn ([x,y], [z], [e]) =>
		alloc(z,  e,any, fn z' =>
		 (addg3(regbind x, regbind y, z'); gen e)))
       | P.fsub => (fn ([x,y], [z], [e]) =>
		alloc(z,  e,any, fn z' =>
		 (subg3(regbind x, regbind y, z'); gen e)))
       | P.feql => compare(gbranch,NEQ)
       | P.fneq => compare(gbranch,EQL)
       | P.fgt => compare(gbranch,LEQ)
       | P.flt => compare(gbranch,GEQ)
       | P.fge => compare(gbranch,LSS)
       | P.fle => compare(gbranch,GTR)
       
in  emitlong 1; (* Bogus tag for spacing, boot_v. *)
    let fun loop nil = ()
          | loop (frag::r) = (frags := r; genfrag frag; loop(!frags))
    in loop(!frags)
    end
(*    before print "Done!\n" *)
end

end

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.