------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 199x by International Computer Science Institute            --
-- This file is part of the GNU Sather package. It is free software; you may --
-- redistribute  and/or modify it under the terms of the  GNU General Public --
-- License (GPL)  as  published  by the  Free  Software  Foundation;  either --
-- version 2 of the license, or (at your option) any later version.          --
-- This  program  is distributed  in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/GPL for more details.        --
-- The license text is also available from:  Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA                     --
-------------->  Please email comments to <bug-sather@gnu.org>  <--------------

class CODE_FILE is
   -- This class controls C code generated by the compiler.
   -- For incremental compilation, files are built in memory
   -- as FSTRs and then conditionally written out only if their
   -- signature differs from what already exists.  There is one
   -- file per Sather class, although as an optimization these
   -- could be combined for classes that have the same checking
   -- modes.

   -- Code files have to big enough to make the amortised time of
   -- reading the big header file worth it.  This means that a
   -- separate file for every dinky class won't cut it; they have to
   -- be merged.  However, we have to only merge files with the same
   -- options settings because many of the checks are done in-line
   -- with macro calls in "runtime.h".

   -- This class is not re-entrant.

   private attr text:FLIST{FSTR};
   private attr ntext:FSTR;
   private attr length:INT;
   --private attr text:FSTR;
   attr name:STR;
    
   attr is_c_code:BOOL;		-- Header info for the flags below
   -- will only be emitted if it is a C file

   attr do_not_merge:BOOL;	-- True if should remain separate file

   attr chk_pre:BOOL;
   attr chk_post:BOOL;
   attr chk_invariant:BOOL;
   attr chk_assert:BOOL;
   attr chk_arith:BOOL;
   attr chk_bounds:BOOL;
   attr chk_void:BOOL;
   attr chk_when:BOOL;
   attr chk_return:BOOL;

   attr decs:FSET{SIG};		-- declarations have to be emitted
   -- for these signatures.

   readonly attr layouts:FSET{$LAYOUT}; -- typedefs have to be emitted for
   -- these layouts

   attr globals:FSET{AM_SHARED_EXPR}; -- declarations have to be emitted
   -- for these global const or shareds

   attr bnd_rout_creates:FSET{AM_BND_CREATE_EXPR};
   -- decls have to be emitted for these
   
   attr bnd_iter_creates:FLIST{AM_BND_CREATE_EXPR};
   -- decls have to be emitted for these

   attr unboxes:FSET{TUP{SIG,SIG}}; -- decls have to be emitted for these
   -- functions which unbox types on dispatching

   attr externs:FSET{STR};	-- Decls have to be emitted for these
   -- external calls

   attr iters:FSET{SIG};	-- These iters are used by this file

   shared all,todo:FLIST{SAME};
   shared dir:STR;
   shared thumbprints:FMAP{STR,STR};
   shared prog:PROG;
   shared cgen:CGEN;
   shared iter_sigs:FMAP{SIG,AM_ROUT_DEF};

   private same_options_as(s:SAME):BOOL is
      return chk_pre=s.chk_pre
	    and chk_post=s.chk_post
	    and chk_invariant=s.chk_invariant
	    and chk_assert=s.chk_assert
	    and chk_arith=s.chk_arith
	    and chk_bounds=s.chk_bounds
	    and chk_void=s.chk_void
	    and chk_when=s.chk_when
	    and chk_return=s.chk_return;
   end;

   set_directory(p:PROG,s:STR) is
      -- Set the target directory to be 's'.  If it doesn't exist,
      -- make it.  Otherwise, try to use what's already in it if the
      -- signatures match.

      -- This should be called before ever calling 'create'.

      -- At the moment, we always just start from scratch.

      prog:=p;
      cg::=prog.back_end;
      typecase cg when CGEN then cgen:=cg; end;
      dir:=s;
      iter_sigs:=#;
      FILE::create_directory(dir);
      th::=FILE::open_for_read(s+'/'+"THUMBPRINTS");
      if ~th.error then
	 loop
	    fn::="";
	    c::=th.get_char;
	    until!(th.eof or th.error);
	    loop 
	       until!(c=' ' or th.error);
	       fn:=fn+c;
	       c:=th.get_char;
	    end;
	    thumbprints:=thumbprints.insert(fn,th.get_str);
	    -- Notice trailing newline.
	 end;
      end;
   end;

   create(s:STR):SAME is
      -- Create a new CODE_FILE. 

      r::=new;
      r.text:=#FLIST{FSTR};
      r.ntext:=#FSTR;
      r.length:=0;
      --r.text:=#;
      r.name:=s;
      r.decs:=#;
      r.layouts:=#;
      r.globals:=#;
      r.bnd_rout_creates:=#;
      r.bnd_iter_creates:=#; 
      r.unboxes:=#;
      r.externs:=#;
      r.iters:=#;
      r.do_not_merge:=false;
      all:=all.push(r);
      return r;
   end;

   plus(s:$STR):SAME is
      -- Output some code

      if ~void(s) then
	 ntext:=ntext+s.str;
      end;
      return self;
   end;

   plus(s:$STR) is
      -- Output some code

      ntext:=ntext+s.str;
      --text:=text+s.str;
   end;

   good_place_to_split is
      text:=text.push(ntext);
      length:=length+ntext.length;
      ntext:=#FSTR;
      if length>cgen.threshold and is_c_code then
	 -- If it's too big, stop here and start a new file.
	 old::=#SAME(name);
	 old.text:=text;
	 old.ntext:=ntext;
	 old.length:=length;
	 old.chk_pre:=chk_pre;
	 old.chk_post:=chk_post;
	 old.chk_invariant:=chk_invariant;
	 old.chk_assert:=chk_assert;
	 old.chk_arith:=chk_arith;
	 old.chk_bounds:=chk_bounds;
	 old.chk_void:=chk_void;
	 old.chk_when:=chk_when;
	 old.chk_return:=chk_return;
	 old.is_c_code:=true;
	 old.do_not_merge:=do_not_merge;
	 old.decs:=decs;
	 old.layouts:=layouts;
	 old.globals:=globals;
	 old.bnd_rout_creates:=bnd_rout_creates;
	 old.bnd_iter_creates:=bnd_iter_creates;
	 old.unboxes:=unboxes;
	 old.externs:=externs;
	 old.iters:=iters;

	 text:=#FLIST{FSTR};
	 ntext:=#FSTR;		-- ("/* Continuation of "+name+" */\n\n");
	       length:=0;
	 --text:=#FSTR("/* Continuation of "+name+" */\n\n");
	 name:=name.replace_suffix(".c","x.c");
	 decs:=#;
	 layouts:=#;
	 globals:=#;
	 bnd_rout_creates:=#;
	 bnd_iter_creates:=#; 
	 unboxes:=#;
	 externs:=#;
	 iters:=#;
      end;
   end;

   -- Topological ordering and corresponding text for all typedefs
   shared layout_order:FLIST{$LAYOUT};
   shared layout_text:FLIST{STR};

   private generate_layouts is
      -- emit typedefs/structs

      -- C requires that typedefs only refer to types previously
      -- defined in the text.  This means we have to do a
      -- topological sort on all the layouts.  To do this, we make
      -- multiple passes, each time emitting only those typedefs for
      -- which all dependencies have already been emitted.  The
      -- technique used for this is quadratic but because the
      -- dependence graph is sparse, I suspect it won't matter in
      -- practice.

      -- Each generated C file must get its own transitive closure
      -- of struct reference.  To do this, each CODE_FILE keeps
      -- an FSET of those layouts it needs.  The outer loop computes
      -- a topological sort over the entire set, adding the the FSET
      -- of individual files as dependencies are found.  

      done::=#FSET{$LAYOUT};	-- those layouts which have been emitted
	
      layout_order:=#;		-- List in topo order should be generated
      layout_text:=#;		-- Text of each layout in layout_order

      -- at this point, we expect all $TP layouts to be in layout_tbl.

      stilltodo::=#FLIST{$LAYOUT}; 

      -- Make sure all iters will be generated
      loop
	 cc::=todo.elt!;
	 loop
	    sig::=cc.iters.elt!;
	    if ~sig.tp.is_abstract then
	       a:AM_ROUT_DEF:=iter_sigs.get(sig);
	       if ~void(a) then	-- builtin iters are not stored in iter_sigs
	          cc.uses_layout(#FRAME_LAYOUT(a,prog));
	       end;
	    else
	       cc.uses_layout(#ABSTRACT_FRAME_LAYOUT(sig,prog));
	    end;
	 end;
      end;

      -- Get a list of everything we could possibly need to generate
      loop stilltodo:=stilltodo.push(BUILTIN_LAYOUT::layouts.elt!); end;
      loop stilltodo:=stilltodo.push(EXTERNAL_LAYOUT::layouts.elt!); end;
      loop stilltodo:=stilltodo.push(ABSTRACT_LAYOUT::layouts.elt!); end;
      loop 
	 stilltodo:=stilltodo.push(ABSTRACT_FRAME_LAYOUT::layouts.targets!);
      end;
      loop stilltodo:=stilltodo.push(CLASS_LAYOUT::layouts.elt!); end;
      loop stilltodo:=stilltodo.push(IMMUTABLE_CLASS_LAYOUT::layouts.elt!); end;
      
      -- bound routines
      loop
	 stilltodo:=stilltodo.push(BOUND_OBJECT_LAYOUT::layouts.targets!);
      end;
      loop stilltodo:=stilltodo.push(BOUND_TYPE_LAYOUT::layouts.elt!); end;
      
      -- bound iters 
      loop
	 stilltodo:=stilltodo.push(BOUND_ITER_FRAME_LAYOUT::layouts.targets!);
      end;
      loop stilltodo:=stilltodo.push(BOUND_ITER_TYPE_LAYOUT::layouts.elt!);end;
      
	 loop stilltodo:=stilltodo.push(FRAME_LAYOUT::layouts.targets!); end;
	 loop stilltodo:=stilltodo.push(ARG_LAYOUT::layouts.targets!); end;

	 -- Try to make canonical 
	 stillarr::=#LAYOUT_ARRAY(stilltodo.size);
	 loop stillarr.set!(stilltodo.elt!); end;
	 stillarr.sort;
	 stilltodo:=#;
	 loop stilltodo:=stilltodo.push(stillarr.elt!); end;
	 SYS::destroy(stillarr);

	 loop until!(stilltodo.is_empty);
	    next_stilltodo::=#FLIST{$LAYOUT};
	    loop
	       l::=stilltodo.elt!;

	       -- find out if it is okay to emit yet
	       deps::=l.dependencies;
	       okay:BOOL:=true;
	       loop
		  while!(okay);
		  d::=deps.elt!;
		  if ~done.test(d) then
		     --#OUT+"Can't emit "+l.str+", waiting on "+d.str+'\n';
		     okay:=false;
		  end;
	       end;

	       if okay then 
		  layout_order:=layout_order.push(l);
		  layout_text:=layout_text.push(l.typedef(cgen));
		  --typedefs_h+l.typedef(self); 
		  done:=done.insert(l);
		  --#OUT+"Emitted "+l.str+'\n';
	       else
		  next_stilltodo:=next_stilltodo.push(l);
	       end;

	    end;
	    
	    -- Make sure progress occurs
	    if next_stilltodo.size=stilltodo.size then 
	       #OUT+"There appears to be cycle(s) in the layouts usage.\n";
	       #OUT+"Here's one cycle: \n\n";
	       e::=stilltodo[0];
	       seen::=#FSET{$LAYOUT};
	       loop 
		  #OUT+e.str+'\n';
		  seen:=seen.insert(e);
		  e2:$LAYOUT;
		  loop
		     e2:=e.dependencies.elt!;
		     until!(~done.test(e2));
		  end;
		  e:=e2;
		  until!(seen.test(e));
	       end;
	       #OUT+e.str+'\n';
	       cgen.barf("giving up.");
	    end;
	    stilltodo:=next_stilltodo;
	 end; -- loop

      end;

      header_info:FSTR is
      f::=#FSTR;
      if chk_pre then f:=f+"#define PRE_CHK\n"; end;
      if chk_post then f:=f+"#define POST_CHK\n"; end;
      if chk_invariant then f:=f+"#define INVARIANT_CHK\n"; end;
      if chk_assert then f:=f+"#define ASSERT_CHK\n"; end;
      if chk_arith then f:=f+"#define ARITH_CHK\n"; end;
      if chk_bounds then f:=f+"#define BOUNDS_CHK\n"; end;
      if chk_void then f:=f+"#define VOID_CHK\n"; end;
      if chk_when then f:=f+"#define WHEN_CHK\n"; end;
      if chk_return then f:=f+"#define RETURN_CHK\n"; end;
      f:=f+"#include \"sather.h\"\n\n";

      f:=f+"/* Layouts */\n\n";
      loop 
	 l::=layout_order.elt!;
	 t::=layout_text.elt!;
	 if layouts.test(l) then f:=f+t; end;
      end;

      f:=f+"#include \"tags.h\"\n";

      f:=f+"\n/* Globals */\n\n";
      globstr::=#ARRAY{STR}(globals.size);
      loop 
	 age::=globals.elt!;
	 globstr.set!("extern ".append(mang(age.tp)," ",mang(age),";\n"));
      end;
      globstr.sort;
      loop f:=f+globstr.elt!; end;
      SYS::destroy(globstr);

      f:=f+"\n/* Function declarations */\n\n";
      decstr::=#FLIST{STR}(decs.size);
      loop
	 d::=decs.elt!;
	 loop	
	    decstr:=decstr.push(declaration_for!(d))
	 end;
      end;

      decstrs::=#ARRAY{STR}(decstr.size);
      loop decstrs.set!(decstr.elt!); end;
      if ~void(decstr) then SYS::destroy(decstr); end;
      decstrs.sort;
      loop f:=f+decstrs.elt!; end;
      SYS::destroy(decstrs);

      f:=f+"\n/* Bound rout stubs decls */\n\n";
      f:=f+bnd_rout_declarations;
      
      f:=f+"\n/* Bound iter stubs decls */\n\n"; -- AJ-
      f:=f+bnd_iter_declarations;
      
      f:=f+"\n/* Unbox decls */\n\n";
      unstr::=#ARRAY{STR}(unboxes.size);
      loop
	 pair::=unboxes.elt!;
	 unstr.set!(unbox_dec(pair.t1,pair.t2));
      end;
      unstr.sort;
      loop f:=f+unstr.elt!; end;
      SYS::destroy(unstr);

      f:=f+"\n/* External calls */\n\n";
      exstr::=#ARRAY{STR}(externs.size);
      loop exstr.set!(externs.elt!); end;
      exstr.sort;
      --      loop
      --	 #OUT + exstr.elt! + "\n";
      --      end;
      loop f:=f+exstr.elt!; end;
      SYS::destroy(exstr);

      f:=f+"\n/* Code */\n\n";

      return f;
   end;

   private mang(ob:$OB):STR is
      return cgen.mangler.mangle(ob,void);
   end;

   uses_sig(s:SIG) is
      -- This also sees to it that all types in the signature
      -- are referenced; they don't need to be done separately.
      
      decs:=decs.insert(s);
      uses_tp(s.tp);
      if ~void(s.ret) then uses_tp(s.ret); end;
      loop
	 uses_tp(s.args.elt!.tp);
      end;
      -- dispatched iters need special handling.  Could be cleaned up.
      if s.is_iter and s.tp.is_abstract then uses_iter(s) end;
   end;

   uses_layout(l:$LAYOUT) is
      s::=layouts.size;		-- we want to know if the layout is added.
      -- We could check this with test, but then 
      -- we have to check it twice (once for test,
      -- and insert will test it too.). If the size
      -- changes, the element has been added
      layouts:=layouts.insert(l);
      if layouts.size/=s then	-- has been added, add all dependencies too
	 d::=l.dependencies;
	 loop uses_layout(d.elt!); end;
      end;
   end;

   uses_iter(s:SIG) is
      iters:=iters.insert(s);
   end;

   here_is_iter(a:AM_ROUT_DEF) is
      iter_sigs:=iter_sigs.insert(a.sig,a);
   end;

   uses_tp(t:$TP) is
      uses_layout(LAYOUT_TBL::layout(t));
   end;

   uses_global(age:AM_SHARED_EXPR) is
      globals:=globals.insert(age);
   end;

   uses_bnd_rout_create(brc:AM_BND_CREATE_EXPR) is
      bnd_rout_creates:=bnd_rout_creates.insert(brc);
   end;
   
   uses_bnd_iter_create(bic:AM_BND_CREATE_EXPR) is 
      bnd_iter_creates:=bnd_iter_creates.push(bic);
   end;

   uses_unbox(s,abs:SIG) is
      unboxes:=unboxes.insert(#(s,abs));
   end;

   uses_extern(dec:STR) is
      externs:=externs.insert(dec);
   end;

   fix_out_type(e:ARG, s:STR):STR is
      if (e.mode = MODES::out_mode or e.mode = MODES::inout_mode or
	  e.tp.kind = TP_KIND::ext_fortran_tp) then
	 return s + "*";
      end;
      return s;
   end;      
   
   private declaration_for!(sig:SIG):STR is
      -- emit ANSI header, and also struct to hold locals if an iter

      res:STR;
      if sig.is_ext_fortran_sig then 
	 res:=cgen.fortran_func_dec(sig)+"\n";
	 yield res;
	 quit;
      end;
	    
      res:="";

      if sig.tp.is_abstract then 
	 -- Have to emit dispatch table declarations
	 -- res:="extern const int "+mang(sig)+"_offset;\n";
	 decl::="RETURNED_CONST ";
	 -- iter dispatch tables differ from ordinary ones
	 if sig.is_iter then
	    decl := decl.append(mang(sig),"_entry *",mang(sig));
	 else
	    if ~void(sig.ret) then
	       decl:=decl+mang(sig.ret);
	    else
	       decl:=decl+"void";
	    end;
	    decl:=decl.append(" (**"+mang(sig),")(",mang(sig.tp));
	    if ~void(sig.args) then
	       loop 
		  e::=sig.args.elt!;
		  decl:=decl.append(", ",mang(e.tp));
		  decl := fix_out_type(e, decl);
	       end;
	    end;
	    if cgen.func_tables then
	       decl:=decl+",struct _func_frame *";
	    end;
	    decl:=decl+")";
	 end;
	 res:=res.append("\nextern ",decl,";\n");
	 yield res;
	 quit;
      end;

      if ~void(sig.ret) then res:=res.append(mang(sig.ret)," ");;
      else res:=res+"void ";
      end;
      res:=res.append(mang(sig));

      -- if an iter, just a pointer for frame struct
      -- otherwise, pass arguments the usual way
      if sig.is_iter then res:=res+"("+mang(sig)+"_frame";
	 if cgen.func_tables then
	    res:=res+", struct _func_frame *";
	 end;
	 --elsif sig.is_abstract then
	 --    res:=res+mang(sig.tp);
	 --    loop res:=res+", "+mang(sig.args.elt!); end;
	 --    -- The mangle was wrt ,sig.  WHY?
      elsif sig.tp.is_external then
	 -- an external routine with a body still doesn't have a self
	 res:=res+"(";
	 loop
	    e::= sig.args.elt!;
	    res:=res+", ".separate!(mang(e.tp)); 
	    res := fix_out_type(e, res);
	 end;
      elsif sig.is_forked then
	 res:=res+"(OB";
	 loop
	    e ::=sig.args.elt!;
	    res:=res.append(", ",mang(e.tp)); 
	    res := fix_out_type(e, res);		 
	 end;
      else
	 args::="("+mang(sig.tp);
	 loop 
	    e::= sig.args.elt!;
	    args:=args.append(", ",mang(e.tp)); 
	    args := fix_out_type(e, args);
	 end;
	 if cgen.func_tables then
	    args:=args+", struct _func_frame *";
	 end;
	 if ~void(sig.opt_info) and ~void(sig.opt_info.consider) then
	    loop 	
	       i::=1.upto!(sig.opt_info.near_local.asize-1);
	       suffix::="___";
	       loop
	          sig.opt_info.consider.size.times!;
		  if i.aelt! then
		     suffix:=suffix+"L";
		  else
		     suffix:=suffix+"f";
		  end;
	       end;
	       yield res+suffix+args+");\n";
	    end;      
	 end;
	 res:=res+args;
      end;
      res:=res+");\n";
      yield res;
   end;

   private bnd_rout_declarations:STR is
      -- Generate declarations for bound routine objects

      bstr::=#ARRAY{STR}(bnd_rout_creates.size);
      loop
	 s:STR;
	 e::=bnd_rout_creates.elt!;
	 name::=mang(e);
	 if ~e.is_remote and ~void(e.fun.ret) then s:=mang(e.fun.ret)+' ';
	 else s:="void ";
	 end;
	 s:=s+name+'('+name+"_ob";
	 --s:=s+name+"(void *"; 
	 loop
	    i::=e.unbnd_args.elt!;
	    num::=0.up!;
	    if i=0 then
	       if ~e.fun.tp.is_external then
		  s:=s.append(", ",mang(e.fun.tp));
	       end;
	    else
	       s:=s.append(", ",fix_out_type(e.fun.args[i-1], 
					     mang(e.fun.args[i-1].tp)));
	    end;
	 end;
	 if cgen.func_tables then
	    s:=s+",struct _func_frame *";
	 end;
	 s:=s+");\n";
	 bstr.set!(s);
      end;
      bstr.sort;
      res::="";
      loop res:=res+bstr.elt!; end;
      SYS::destroy(bstr);
      return res;
   end;

   private bnd_iter_declarations:STR is -- AJ-
      -- Generate declarations for bound iter objects
      
      bstr::=#ARRAY{STR}(bnd_iter_creates.size);
      loop
	 s:STR;
	 e::=bnd_iter_creates.elt!;
	 name::=mang(e);
	 if ~void(e.fun.ret) then s:=mang(e.fun.ret)+' '; -- generates RETTYPE
	 else s:="void "; end;
	 s:=s.append(name,"_call_function","(",name,"_iter_ob");
	 if cgen.func_tables then
	    s:=s+",struct _func_frame *";
	 end;
	 s := s + ");\n" ;
	 -- that is it unbnd args are passed in the frame by the caller
	 bstr.set!(s);
      end;
      bstr.sort; 
      res::="";
      loop res:=res+bstr.elt!+"\n"; end;
      SYS::destroy(bstr);
      return res; 
   end;

   private unbox_dec(s,abs:SIG):STR is

      res::="";

      -- until mangling is really correct, use func_unbox as name
      name::=mang(s)+"_unbox";
      if void(s.ret) then
	 res:=res+"void ";

	 -- DPS: These lines aren't right, so they've been commented out.
	 -- The unboxing function *never* returns a "_boxed" type.
	 --elsif abs.ret.is_abstract and s.ret.is_immutable then
	 --    res:=res+mang(abs.ret)+"_boxed ";
      else
	 res:=res+mang(abs.ret)+' ';      
      end;
      -- indentation screwed up here
      if s.is_iter then
	 res:=res+name+'('+mang(abs)+"_frame";
      else
	 if abs.tp.is_abstract and s.tp.is_immutable then
	    res:=res.append(name,"(",mang(s.tp),"_boxed");
	 else
	    res:=res.append(name,"(",mang(s.tp));
	 end;
	 loop
 	    sa::= s.args.elt!;
            se::=sa.tp;
	    abse::=abs.args.elt!.tp;
	    idx::=1.up!;
	    if abse.is_abstract and se.is_immutable then
	       res:=res.append(", ",cgen.boxed_arg_type_str(sa));
	    else
 	       res:=res.append(", ",fix_out_type(sa, mang(abse)));
	    end;
	 end;
      end;
      if cgen.func_tables then
	 res:=res+",struct _func_frame *";
      end;
      res:=res+");\n";
      if s.is_iter then
	 --emit the frame allocator decl
	 res := res.append("void* ",mang(s),"_frame_alloc();\n");
      end;
      return res;
   end;

   merge:STR is
      -- There is a tension between having lots of files to increase
      -- parallelism and having few to decrease overhead.  In addition,
      -- The mechanism used to decide what files routines' definitions
      -- should go to must be deterministic and attempt to cluster
      -- those routines likely to be changed together (in order to
      -- minimize the number of files that must be recompiled.)

      -- The heuristic used here is to always put routines belonging
      -- to the same class in the same file.  In addition, classes
      -- are grouped alphabetically as long as the result doesn't
      -- make the file size go over a threshold.  This means that
      -- the actual number of files to be output isn't known until
      -- after all code has been generated.  For this reason,
      -- 'merge' returns a list of code files actually output to
      -- be placed in the Makefile.

      -- 'finalize' must b called after 'merge'.  The text of the
      -- Makefile can't be known until 'merge' returns, which is
      -- why these two phases are split up.

      -- First, sort all classes alphabetically.  This improves the
      -- chance that changes will remain local, and also makes it
      -- easier to browse through the C code.
      sorted::=#CODE_FILE_ARRAY(all.size);

      loop sorted.set!(all.elt!); end;
      sorted.sort;

      todo:=#FLIST{CODE_FILE};
      last:CODE_FILE:=void;
      loop
	 next::=sorted.elt!;
	 next.text:=next.text.push(next.ntext);
	 next.length:=next.length+next.ntext.length;
	 next.ntext:=#FSTR;
	 if prog.prolix then
	    if ~void(next) then 
	       #OUT+"Considering:"+next.name+" size="+next.length;
	       if ~void(last) then #OUT+" Current length="+last.length; end;
	       #OUT+"\n";
	    end;
	 end;
	 if ~next.is_c_code or next.do_not_merge then
	    todo:=todo.push(next);
	 elsif void(last) then
	    last:=next;
	 elsif ~last.same_options_as(next)
	    or last.length+next.length>cgen.threshold then
	    todo:=todo.push(last);
	    last:=next;
	 else
	    -- Merge this C file with the last one.
	    last.text:=last.text.concat(next.text);
	    if prog.prolix then
	       #OUT+"Merging "+last.name+" with:"+next.name+"\n";
	    end;
	    last.length:=last.length+next.length;
	    --last.text:=last.text+next.text;
	    last.decs:=last.decs.union(next.decs);
	    last.layouts:=last.layouts.union(next.layouts);
	    last.globals:=last.globals.union(next.globals);
	    last.bnd_rout_creates:=
		  last.bnd_rout_creates.union(next.bnd_rout_creates);
	    last.bnd_iter_creates:=
		  last.bnd_iter_creates.union(next.bnd_iter_creates); -- AJ-
	    last.unboxes:=last.unboxes.union(next.unboxes);
	    last.externs:=last.externs.union(next.externs);
	    last.iters:=last.iters.union(next.iters);
	    SYS::destroy(next.text);
	    if ~void(next.layouts) then SYS::destroy(next.layouts); end;
	    if ~void(next.decs) then SYS::destroy(next.decs); end;
	 end;
      end;
      todo:=todo.push(last);

      res::="";
      loop
	 next::=todo.elt!;
	 if next.is_c_code then 
	    res:=res+' '+next.name.replace_suffix(prog.config.get_str("C_EXT",0),prog.config.get_str("OBJECT_EXT",0));
	 end;
      end;

      return res;
   end;

   finalize is
      -- Indicate done with all files.  This causes any files which
      -- have changed to be written out.

      generate_layouts;


      -- esc: Create list of all old files
      to_delete::=#FSET{STR};
      loop
	 to_delete:=to_delete.insert(thumbprints.keys!);
      end; -- loop
      
      total::=0;
      regen::=0;
      th:FILE;
      if ~prog.benchmark then
	 th:=FILE::open_for_write(dir+'/'+"THUMBPRINTS");
	 if th.error then prog.barf("Couldn't write thumbprints"); end;
      end;
      loop
	 cc::=todo.elt!;

	 to_delete:=to_delete.delete(cc.name); -- esc: Remove name from list
 
	 oldthp::=thumbprints.get(cc.name);
	 wholetext::=#FSTR;
	 if cc.is_c_code then
	    header::=cc.header_info;
	    wholetext:=wholetext+header;
	    SYS::destroy(header);
	 end;
	 textarr:ARRAY{FSTR}:=#(cc.text.size+1);
	 loop textarr.set!(cc.text.elt!); end;
	 textarr[textarr.size-1]:=cc.ntext;
	 textarr.sort;
	 loop
	    t::=textarr.elt!;
	    wholetext:=wholetext+t;
	    SYS::destroy(t);
	 end;
	 if ~void(cc.text) then SYS::destroy(cc.text); end;
	 if ~void(textarr) then SYS::destroy(textarr); end;
	 --wholetext:=wholetext+cc.text;
	 --wholetext:=wholetext+cc.ntext;
	 newthp::=wholetext.thumbprint;
	 if oldthp/=(newthp+'\n') then
	    if ~prog.benchmark then
	       f::=FILE::open_for_write(dir+'/'+cc.name);
	       if f.error then prog.barf("Couldn't write "+cc.name); end;
	       f+wholetext+'\n'; 
	       f.close;
	    end;
	    regen:=regen+1;
	 end;
	 if ~prog.benchmark then
	    th+cc.name+' '+newthp+'\n';
	 end;
	 SYS::destroy(wholetext);
	 total:=total+1;
      end;
      if ~prog.benchmark then
	 th.close;
      end;

      -- esc: Delete old files
      loop
	 name::=dir+'/'+to_delete.elt!;
	 FILE::delete(name);
	 FILE::delete(name.replace_suffix(prog.config.get_str("C_EXT",0),prog.config.get_str("OBJECT_EXT",0)));
      end; -- loop
 	
      if prog.verbose then
	 (#OUT+"Regenerated "+regen+" of "+total+" files... ").flush;
      end;
	   
   end;
end; -- class CODE_FILE

class CODE_FILE_ARRAY is
   -- This makes it easy to sort.

   include ARRAY{CODE_FILE};

   elt_lt(x,y:CODE_FILE):BOOL is
      return x.name<y.name;
   end;
end;

class LAYOUT_ARRAY is
   -- This makes it easy to sort.

   include ARRAY{$LAYOUT};

   elt_lt(x,y:$LAYOUT):BOOL is
      return x.str<y.str;
   end;
end;

-- vim:sw=3:nosmartindent












