------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 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 CS is
   -- The Sather 1.1 compiler.
   
    attr only_parse:BOOL;	     -- Stop after parsing
    attr only_reachable:BOOL;	     -- Don't check unreachable code

    main(a:ARRAY{STR}):INT is
	-- Compile a program.  Here we go...
	-- if you want benchmarks (time/memory usage) uncomment the following lines
	-- don't forget the same lines at the end of this function.
	-- tm::=#TIMES;
	-- mm::=#MEMORY_USAGE;


	-- Allocate an object and fill it in with the standard
	-- compiler components.
	TIME::start;
	p::=#PROG; 
	
	p.parse:=#PARSE(p);
	p.find_types:=#FIND_TYPES(p);
	p.find_generics:=#FIND_GENERICS(p); -- *H*
	p.build_type_graph:=#BUILD_TYPE_GRAPH(p);
	p.check_ifc_conformance:=#CHECK_IFC_CONFORMANCE(p);
	p.get_main_sig:=#GET_MAIN_SIG(p);
	p.generate_am:=#GENERATE_AM(p);
	p.check_am:=#CHECK_AM(p);
	p.check_gen:=#CHECK_GENERICS(p); -- *H*
        p.inliner:=#INLINE(p);
	cgen:CGEN:=#CGEN(p);
	p.back_end:=cgen;
	p.get_options:=#CS_OPTIONS(p,self);

	-- p.show_tr := true;

	-- Handle the command line options and SATHER_COMMANDS
	p.get_options.read_env;
	common::=p.home+"/System/Common/Common.module";
	p.get_options.interpret(|"",common|); -- first element of array is ignored
	p.get_options.interpret(a);
	if ~void(UNIX::get_env("ZONES")) then -- Leave undocumented; for testing
	    p.get_options.interpret(|"","-zones"|);
	end;
	p.config:=#CONFIG_TBL(p.home+"/System/Common/CONFIG");
	if p.genuine_platforms=0 then
	    plt::=UNIX::get_env("SATHER_PLATFORM");
	    if void(plt) then
		plt:=p.config.get_str("DEFAULT_PLATFORM",0);
	    end;
	    plt:=p.home+"/System/Platforms/"+plt;
	    p.platforms:=p.platforms.push(plt);
	    p.get_options.interpret(|"",plt+"/Platform.module"|); -- first element of array is ignored
	elsif p.genuine_platforms/=1 then
	    #ERR+"More than one Platform specified, aborting.\n";
	    UNIX::exit(-1);
	end;

      loop p.config.read(p.platforms.elt!+"/CONFIG"); end;

      p.tp_tbl:=#(p);
      p.tp_graph:=#(p);
      p.tp_graph_abs_des:=#(p);
      p.as_tbl:=#;
      p.optimizer:=#OPTIMIZE(p);
      if p.verbose then (#OUT+"Initializing... ").flush; end;

      p.boot:=p.config.get_bool("BOOT");
      p.distributed:=p.config.get_bool("DISTRIBUTED");
      p.threads:=p.config.get_bool("THREADS");
      p.trace:=p.config.get_bool("TRACE");

      -- PROG::zones is only turned on if "-zones" is passed, since
      -- for the moment the default behavior should be the 1.1
      -- distributed semantics (flat integer-addressed clusters.)
      --
      -- If zones becomes the standard semantics, this should be
      -- uncommented.
      --p.zones:=p.config.get_bool("ZONES");
      if p.zones and ~p.config.get_bool("ZONES") then
	 #ERR+"Zones are not supported on this platform";
	 p.err_seen:=true;
      end;
      
      if p.print_version then
	 v::=p.config.get_str("VERSION",0);
	 #OUT +"ICSI Sather compiler version: " + v + "\n";
	 #OUT+"Default platform: "+p.config.get_str("DEFAULT_PLATFORM",0)+'\n';
	 #OUT + "Installed platforms:\n";
	 loop
	    strs::=  p.config.get_def("PLATFORMS").elt!;
	    loop
	       ps ::= strs.elt!;
	       #OUT + "\t" + ps + '\n';
	    end;
	 end;
	 #OUT + "Home directory: " + p.home + '\n';
      end;
      
      sl::=UNIX::get_env(p.config.get_str("LIBRARY",0));
      if void(sl) then
         p.get_options.interpret(|"",p.home+"/"+p.config.get_str("LIBRARY",1)|);
      else
         p.get_options.interpret(|"",sl|);
      end;
      if p.prolix then #OUT + p.get_options.str +"\n\n"; end;

      if p.prolix then p.stat:=#STAT; else p.stat:=#NULL_STAT; end;
      if p.verbose then #OUT+'('+TIME::elapsed+" seconds)"; end;
      TIME::start;
      if p.verbose then (#OUT+"\nParsing non-library files... ").flush; end;
      loop
	  fn::=p.sather_files.elt!;
	  p.parse.parse(fn);
      end;
      if p.verbose then
        #OUT+'('+TIME::elapsed+" seconds)"
      end;

      if p.err_seen then if p.verbose then #OUT+'\n'; end; return 1 end;
      if only_parse then if p.verbose then #OUT+'\n'; end; return 0; end;

      TIME::start;
      if p.verbose then (#OUT+"\nFinding types and parsing library... ").flush; end;
      p.find_types.find_types;
      if p.verbose then
        #OUT+'('+TIME::elapsed+" seconds)"
      end;
      if p.prolix then
          #OUT + '\n' + p.as_tbl.size.str + " Classes found:\n";
          p.as_tbl.dump;
      end;
      if p.err_seen then return 2 end;

      p.no_new_types := true;
      -- *H*
      if p.check_generics then
	  TIME::start;
	  if p.verbose then (#OUT+"\nGenerating generic classes... ").flush;
	  end;
	  p.find_generics.find_generics;
	  if p.verbose then #OUT+'('+TIME::elapsed+" seconds)"; end;
      end;
      -- end *H*
      
      TIME::start;
      if p.verbose then (#OUT+"\nType graph, conformance, main, init... ").flush; end;
      p.build_type_graph.build_graphs;
      if p.err_seen then
	 if p.verbose then #OUT+'('+TIME::elapsed+" seconds)\n"; end;
	 return 3
      end;
      p.check_ifc_conformance.check_ifc_conformance;
      if p.err_seen then
	  if p.verbose then #OUT+'('+TIME::elapsed+" seconds)\n"; end;
	  return 4
      end;
      p.get_main_sig.get_main_sig(p.main_class);
      if p.err_seen then
	  if p.verbose then #OUT+'('+TIME::elapsed+" seconds)\n"; end;
	  return 5
      end;
      if ~cgen.only_check then
          p.inliner.init;
	  p.optimizer.init;
	  if p.err_seen then
	     if p.verbose then #OUT+'('+TIME::elapsed+" seconds)\n"; end;
	     return 6
	  end;
      end;
      if p.verbose then #OUT+'('+TIME::elapsed+" seconds)"; end;

      TIME::start;
      if p.verbose then 
	  (#OUT+"\nType check, generate, inline, optimize, and make C... ")
	       .flush;
      end;
      p.generate_am.generate_am;
      if p.verbose then #OUT+'('+TIME::elapsed+" seconds)"; end;
      if p.show_tr then p.as_tbl.as_out(p) end;            
      if p.err_seen then if p.verbose then #OUT+'\n'; end; return 7 end;      
      if ~cgen.only_check then
	  TIME::start;
	  if p.verbose then
	     if cgen.only_C then (#OUT+"\nHeaders, writing C files... ").flush;
	     else (#OUT+"\nHeaders, compiling C... ").flush; end;
	  end;
	  p.optimizer.finalize;      
	  if p.verbose then #OUT+"("+TIME::elapsed+" seconds)"; end;
	  if p.err_seen then if p.verbose then #OUT+'\n'; end; return 8 end;
       end;

      -- *H*
      if p.check_generics then
	  TIME::start;
	  if p.verbose then 
	      (#OUT+"\nChecking generic code... ").flush;
	  end;
	  p.check_gen.check_code;
	  if p.verbose then #OUT+'('+TIME::elapsed+" seconds)"; end;
	  if p.err_seen then if p.verbose then #OUT+'\n'; end; return 11 end;
      end;
      -- end *H*
      
      if ~only_reachable then
	 TIME::start;
	 if p.verbose then 
	    (#OUT+"\nChecking unreachable code... ").flush;
	 end;
	 p.check_am.check_code;
	 if p.verbose then #OUT+'('+TIME::elapsed+" seconds)"; end;
	 if p.err_seen then if p.verbose then #OUT+'\n'; end; return 9 end;
      end;

      if p.verbose then 
	 #OUT + "\nCompilation complete.\n"; 
	 p.stat.print;
      end;

      -- the following line is only necessary for benchmarks
      -- #OUT+tm.elapsed.str+mm.elapsed.str;

      return 0;
   end;
end; 
   
-------------------------------------------------------------------   
