(**********************************************************************)
(* (c) Greg Morrisett, Neal Glew, Chris Hawblitzel, Dan Grossman,     *)
(*     Frederick Smith                                                *)
(*     June 1998, all rights reserved.                                *)
(**********************************************************************)

open Talout;;
open Gcd;;

type code_gen = CgStack | CgReg
let code_gen = ref CgStack

(* Cyclone *)
(* TEMPORARY; CYCLONE/MASM *)
let unsafemasm = ref false
(* End Cyclone *)

let compile_pop_file filename basename modname =
  try
    let talfile = basename ^ ".tal" in
    let impfile     = modname  ^ "_i.tali" in 
    let expfile     = modname  ^ "_e.tali" in 
    let impfileabs  = basename ^ "_i.tali" in 
    let expfileabs  = basename ^ "_e.tali" in
    let objectfile  = basename ^ object_file_suffix in
    let preprocfile = basename ^ ".ppop" in
    let rm_ppop () = Sys.remove preprocfile in
    let abort_on_error () =
      if Gcdfec.error_p () then (rm_ppop (); raise Gcdfec.Exit) in
    Printf.printf "Compiling file: %s\n" basename; flush stdout;
    Sys.command (Printf.sprintf "cl /nologo /E %s > %s" filename preprocfile); 
    let decls = 
      try Gcdfe.fe Poplex.token Popparse.top preprocfile 
      with e -> rm_ppop (); raise e in
    abort_on_error ();
    let popmod = Poptype.type_check decls in
    abort_on_error ();
    let (implementation,imports,exports) =
      match !code_gen with
	CgStack ->
	  Popcompile.code_gen    modname impfile expfile popmod 
      |	CgReg ->
	  Printf.eprintf "%s: register allocator currently broken :-(\n"
	    basename; flush stderr; raise Gcdfec.Exit
(*          Popcompilereg.code_gen modname impfile expfile popmod*) in
    rm_ppop ();
(* Cyclone *)
(* TEMPORARY; CYCLONE/MASM *)
    if !unsafemasm
    then Talout.write_options :=                  
       { Talpp.style=Talpp.MASM;                  
         Talpp.kinds=false;                       
         Talpp.cons=false}                        
    else Talout.write_options := Talpp.std_options;
(* End Cyclone *)
    Talout.write_int (modname^"_i") impfileabs imports;
    Talout.write_int (modname^"_e") expfileabs exports;
    Talout.write_imp modname talfile implementation;
(* Cyclone *)
    if !unsafemasm & assemble_p() then
      begin
        Talout.asm talfile (Some objectfile);
        add_object_file objectfile;
        true
      end
    else if !unsafemasm then true
    else
(* End Cyclone *)
    if assemble_p () then begin
      (Talout.verify_and_asm talfile (Some objectfile)) &
      (add_object_file objectfile; true)
    end else
      Talout.verify talfile
  with Gcdfec.Exit -> false
;;

let middle () =
  add_object_file ("stdlib"^object_file_suffix);
  add_object_file ("pop_runtime"^object_file_suffix);
(* Cyclone *)
  add_object_file ("cyclonelib"^object_file_suffix);
(* End Cyclone *)
  true
;;

let do_link objfiles libraries executable =
  Talout.link objfiles executable
;;

let toolname = "popcorn";;
set_tooldesc "popcorn: A safe C subset compiler";;

let options =
  std_options @ 
  [(*"--no-opt",     Arg.Clear Popcompilereg.optimize, "don't optimize";
   "--no-regalloc",Arg.Clear Popcompilereg.allocateregs,
                                            "don't register allocate";*)
(* Cyclone *)
   (* TEMPORARY; CYCLONE/MASM *)
   "--unsafemasm", Arg.Set unsafemasm, "don't type check, truncate types";
(* End Cyclone *)
   "--stack-codegen", Arg.Unit (fun () -> code_gen := CgStack), 
    "use stack-based code generator";
   "--reg-codegen",   Arg.Unit (fun () -> code_gen := CgReg),
    "use register allocator"]
;;

let file_types = [".pop",compile_pop_file] @ std_file_types;;

let main () = driver toolname options file_types middle do_link;;

Printexc.catch main () ;;

(* EOF: popcorn.ml *)
