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

(* Talbe
 * TAL backend functions.
 *
 *)

open Tal;;
open Talctxt;;

let read_int = Gcdfe.fe Tallex.main Talparser.tal_int;;
let read_imp = Gcdfe.fe Tallex.main Talparser.tal_imp;;

let find_interface s =
  if Sys.file_exists s then
    s
  else
    let rec loop dirs =
      match dirs with
	[] ->
	  let s1 = Filename.concat !Talout.runtime s in
	  if Sys.file_exists s1 then s1 else begin
	    Printf.eprintf "%s: no such interface\n" s; flush stderr;
	    raise Talfail
	  end
      |	dir::dirs ->
	  let s1 = Filename.concat dir s in
	  if Sys.file_exists s1 then s1 else loop dirs in
    loop (List.rev !Talout.includes)
;;

let talintcache = Hashtbl.create 13;;

let rec get_tali intref =
  try Hashtbl.find talintcache intref
  with Not_found ->
    let tali = read_tali intref in
    Hashtbl.add talintcache intref tali;
    tali
and read_tali intref =
  let fn = find_interface intref in
  try
    let tali = read_int fn in
    if Gcdfec.error_p () then raise Gcdfec.Exit;
    tali
  with
    Gcdfec.Exit -> raise Talfail
;;

let multiple_errors = ref true;;
let silent_verify = ref false;;
let print_interfaces = ref false;;

let print_verify_error ctxt ve =
  let fmt = Format.err_formatter in
  Talpp.print_Talverify fmt Talpp.std_options (ctxt,ve);
  Format.pp_print_newline fmt ()
;;

let errors = ref false;;
let mult_handler c e = errors:=true; print_verify_error c e;;

let mult_ctxt = error_handler empty_ctxt mult_handler;;
let sing_ctxt = error_handler empty_ctxt (fun c e -> raise (Talverify (c,e)));;

let verify talfn talimp =
  try
    errors := false;
    let imex =
      Talverify.verify_imp
      	get_tali
      	(if !multiple_errors then mult_ctxt else sing_ctxt)
      	talimp in
    if !errors then raise Talfail;
    if not !silent_verify then
      begin Printf.printf "%s: TAL verified\n" talfn; flush stdout end;
    if !print_interfaces then begin
      let (it,et) = imex in
      Printf.printf "%s: import interface:\n" talfn; flush stdout;
      Talpp.print_tal_int_type Format.std_formatter Talpp.std_options it;
      Format.print_newline ();
      Printf.printf "%s: export interface:\n" talfn; flush stdout;
      Talpp.print_tal_int_type Format.std_formatter Talpp.std_options et;
      Format.print_newline ()
    end;
    imex
  with
    Talverify (c,e) -> print_verify_error c e; raise Talfail
  | Failure s ->
      Printf.eprintf "%s: TAL verify failure: %s\n" talfn s; flush stderr;
      raise Talfail
;;

let silent_asm = ref false;;

let asm talfn talimp imex objname =
  let suc =
    match !Talout.asm_bintool with
      Talout.MS ->
      	(match !Talout.objformat with
	  Talout.COFF -> Talout.asm talfn (Some objname)
      	| Talout.ELF ->
	    Printf.eprintf "%s: masm cannot output ELF\n" talfn; flush stderr;
	    false)
    | Talout.TALC ->
      	try
      	  let objfile = Talasm.assemble talimp imex in
      	  (match !Talout.objformat with
    	    Talout.COFF -> Coff.create_coff talfn objname objfile
      	  | Talout.ELF -> Elf.create_elf talfn objname objfile);
	  true
	with x ->
	  Printf.eprintf "%s: TALC assembler raised %s\n" talfn
	    (Printexc.to_string x);
	  flush stderr;
	  false in
  if not !silent_asm then
    if suc then begin
      Printf.printf "%s: object file created\n" talfn; flush stdout
    end else begin
      Printf.eprintf "%s: object file not created\n" talfn; flush stdout
    end;
  suc
;;

(* EOF: talbe.ml *)
