(**********************************************************************)
(* (c) Greg Morrisett, Neal Glew,                                     *)
(*     June 1998, all rights reserved.                                *)
(**********************************************************************)

(* talout.mli
 * Useful functions for programs to write TAL modules out and call an
 * external verifier/assembler/linker.
 *
 *)

let object_file_suffix,library_suffix,default_executable =
  match Sys.os_type with
    "Unix" -> ".o",".a","a.out"
  | "Win32" -> ".obj",".lib","a.exe"
  | _ -> Printf.eprintf "Unknown operating system\n"; exit 1
;;

let runtime =
  ref (try Sys.getenv "TALCLIB" with Not_found -> "")
;;
let set_runtime s = runtime := s;;

let includes = ref [];;
let add_include p = includes := p :: !includes;;

let ri_options () =
  let aux s p = " -I "^p^s in
  " --runtime "^(!runtime)^(List.fold_left aux "" !includes)
;;

let write_options = ref Talpp.std_options (* TEMPORARY; CYCLONE/MASM *)

let write_int modname filename talint =
  Format.set_margin 9999;
  let oc = open_out filename in
  Format.set_formatter_out_channel oc;
  Talpp.print_tal_int Format.std_formatter
    (!write_options) (* TEMPORARY; CYCLONE/MASM *)
    modname talint;
  Format.print_flush ();
  Format.set_formatter_out_channel stdout;
  close_out oc;
  Format.set_margin 79;
  ()
;;

let write_imp modname filename talimp =
  Format.set_margin 9999;  (* JGM: too large a value causes stack overflow *)
  let oc = open_out filename in
  Format.set_formatter_out_channel oc;
  Talpp.print_tal_imp Format.std_formatter
    (!write_options) (* TEMPORARY; CYCLONE/MASM *)
    modname talimp;
  Format.print_flush ();
  Format.set_formatter_out_channel stdout;
  close_out oc;
  Format.set_margin 79;
  ()
;;

 (* NG: for development purposes this is on by default, probably should be
  *     off for production use.
  *)
let verbose_sys_commands = ref true;;
let sys_command s =
  if !verbose_sys_commands then begin Printf.printf "%s\n" s; flush stdout end;
  (Sys.command s)=0
;;

type bintool = MS | TALC;;

(* NG: Microsoft is more stable so is default *)
let asm_bintool = ref MS;;
let link_bintool = ref MS;;

type binformat = COFF | ELF;;

let objformat = ref COFF;;

let verify filename =
  let cmd = "talc"^(ri_options ())^" --elaborate-only "^filename in
  sys_command cmd
;;

exception Exit;;

let do_asm doverify talfn objfile =
  try
    let cmd =
      match !asm_bintool with
      	MS ->
	  if doverify then
	    if not (verify talfn) then raise Exit;
	  (match !objformat with
	    COFF -> 
	      let aux s p = " /I"^p^s in
	      let includes = aux (List.fold_left aux "" !includes) !runtime in
	      let objfile =
	      	match objfile with None -> "" | Some fn -> " /Fo"^fn in
	      "ml /nologo /coff"^includes^" /Fl /Sc /c"^objfile^" /Ta"^talfn
	  | ELF ->
	      Printf.eprintf "%s: masm cannot output ELF\n" talfn; raise Exit)
      | TALC ->
	  let objfile = match objfile with None -> "" | Some fn -> " -o "^fn in
	  let fmt =
	    match !objformat with COFF -> " --coff" | ELF -> " --elf" in
	  "talc"^(ri_options ())^objfile^" --TALC"^fmt^" -c "^talfn in
    sys_command cmd
  with
    Exit -> false
;;

let asm talfn objfile = do_asm false talfn objfile;;
let verify_and_asm talfn objfile = do_asm true talfn objfile;;
    
let link objfiles exename =
  let cmd =
    match !link_bintool with
      MS ->
    	"link /nologo /subsystem:console /libpath:" ^ !runtime ^
    	" /out:" ^ exename ^ " tal_start" ^ object_file_suffix ^ " " ^
    	(List.fold_right (fun fn s -> fn^" "^s) objfiles "") ^
    	"tal_util" ^ object_file_suffix ^ " gc" ^ library_suffix
    | TALC -> failwith "Talout.link - TALC linker unimplemented" in
  sys_command cmd
;;

(* EOF: talout.ml *)
