Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

506 lines (446 sloc) 19.232 kB
(*
* Copyright (c) 2010-2011 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2010-2011 Thomas Gazagnaire <thomas@gazagnaire.org>
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
open Ocamlbuild_plugin
open Command
open Ocamlbuild_pack.Ocaml_compiler
open Ocamlbuild_pack.Ocaml_utils
open Ocamlbuild_pack.Tools
open Printf
(* Points to the root of the installed Mirage stdlibs *)
let home = getenv ~default:"/usr/bin" "HOME"
let lib = getenv ~default:(home / "mir-inst") "MIRAGELIB"
let cc = getenv ~default:"cc" "CC"
let ld = getenv ~default:"ld" "LD"
let profiling = false
(** Utility functions (e.g. to execute a command and return lines read) *)
module Util = struct
let split s ch =
let x = ref [] in
let rec go s =
try
let pos = String.index s ch in
x := (String.before s pos)::!x;
go (String.after s (pos + 1))
with Not_found -> x := s :: !x
in
go s;
List.rev !x
let split_nl s = split s '\n'
let run_and_read x = List.hd (split_nl (Ocamlbuild_pack.My_unix.run_and_read x))
(* ocamlbuild does not mkdir before an Echo to a file, so force one here *)
let safe_echo lines file =
let buf = String.concat "\n" lines ^ "\n" in
Seq [ Cmd (S[A"mkdir"; A"-p"; Px (Pathname.dirname file)]); Echo ([buf], file) ]
end
(** Host OS detection *)
module OS = struct
type unix = Linux | Darwin | FreeBSD
type arch = X86_32 | X86_64
let host =
match String.lowercase (Util.run_and_read "uname -s") with
| "linux" -> Linux
| "darwin" -> Darwin
| "freebsd" -> FreeBSD
| os -> eprintf "`%s` is not a supported host OS\n" os; exit (-1)
let arch =
match String.lowercase (Util.run_and_read "uname -m") with
| "x86_32" | "i686" -> X86_32
| "i386" -> (match host with Linux | FreeBSD -> X86_32 | Darwin -> X86_64)
| "x86_64" | "amd64" -> X86_64
| arch -> eprintf "`%s` is not a supported arch\n" arch; exit (-1)
let js_of_ocaml_installed =
try
Ocamlbuild_pack.My_unix.run_and_read "which js_of_ocaml" <> ""
with _ -> false
end
(* Rules for building from a .mir build *)
module Mir = struct
(** Link to a UNIX executable binary *)
let cc_unix_link bc tags arg out env =
let ocamlc_libdir = "-L" ^ (Lazy.force stdlib_dir) in
let open OS in
let unixrun mode = lib / mode / "lib" / "libunixrun.a" in
let unixmain mode = lib / mode / "lib" / "main.o" in
let mode = sprintf "unix-%s" (env "%(mode)") in
let asmlib = match bc,profiling with
|true,_ -> A"-lcamlrun"
|false,true -> A"-lasmrunp"
|false,false -> A"-lasmrun"
in
let dl_libs = match host with
|Linux -> [A"-lm"; asmlib; A"-lcamlstr"; A"-ldl"; A"-ltermcap"]
|Darwin |FreeBSD -> [A"-lm"; asmlib; A"-lcamlstr"] in
let tags = tags++"cc"++"c" in
let prof = if profiling then [A"-pg"] else [] in
Cmd (S (A cc :: [ T(tags++"link"); A ocamlc_libdir; A"-o"; Px out;
A (unixmain mode); P arg; A (unixrun mode); ] @ prof @ dl_libs ))
let cc_unix_bytecode_link = cc_unix_link true
let cc_unix_native_link = cc_unix_link false
(** Link to a standalone Xen microkernel *)
let cc_xen_link bc tags arg out env =
let xenlib = lib / "xen" / "lib" in
let jmp_obj = Px (xenlib / "longjmp.o") in
let head_obj = Px (xenlib / "x86_64.o") in
let ocamllib = match bc with true -> "ocamlbc" |false -> "ocaml" in
let ldlibs = List.map (fun x -> Px (xenlib / ("lib" ^ x ^ ".a")))
[ocamllib; "xen"; "xencaml"; "diet"; "m"] in
Cmd (S ( A ld :: [ T(tags++"link"++"xen");
A"-d"; A"-nostdlib"; A"-m"; A"elf_x86_64"; A"-T";
Px (xenlib / "mirage-x86_64.lds"); head_obj; P arg ]
@ ldlibs @ [jmp_obj; A"-o"; Px out]))
let cc_xen_bc_link = cc_xen_link true
let cc_xen_nc_link = cc_xen_link false
(* Rewrite sections for Xen LDS layout *)
let xen_objcopy dst src env builder =
let dst = env dst in
let src = env src in
let cmd = ["objcopy";"--rename-section";".bss=.mlbss";"--rename-section";".data=.mldata";"--rename-section";".rodata=.mlrodata";"--rename-section";".text=.mltext"] in
let cmds = List.map (fun x -> A x) cmd in
Cmd (S (cmds @ [Px src; Px dst]))
(* ocamlclean a bytecode c into a smaller one *)
let ocamlclean dst src env builder =
let dst = env dst in
let src = env src in
let cmd = [A"ocamlclean"; A"-verbose"; A"-o"; Px dst; Px src] in
Cmd (S cmd)
(** Generic CC linking rule that wraps both Xen and C *)
let cc_link_c_implem ?tag fn c o env build =
let c = env c and o = env o in
fn (tags_of_pathname c++"implem"+++tag) c o env
(** Invoke js_of_ocaml from .byte file to Javascript *)
let js_of_ocaml ?tag byte js env build =
let byte = env byte and js = env js in
let libdir = lib / "node" / "lib" in
Cmd (S [ A"js_of_ocaml"; A "-noruntime";
P (libdir / "runtime.js"); P (libdir / "mirage.js") ; Px js; A"-o"; Px byte ])
(** Generate an ML entry point file that spins up the Mirage runtime *)
let ml_main mirfile mlprod env build =
let mirfile = env mirfile in
(* The first line is the function entry point, and subsequent ones are additional
modules to be linked in *)
match string_list_of_file mirfile with
|main::mods ->
let mlprod = env mlprod in
let acc = ref 0 in
let mods = List.map (fun m -> incr acc; sprintf "module ForceLink%d = %s" !acc m) mods in
let main = sprintf "let _ = OS.Main.run (%s ())" main in
Util.safe_echo (mods @ [main]) mlprod
|[] -> failwith "empty .mir file"
(** Copied from ocaml/ocamlbuild/ocaml_specific.ml and modified to add
the output_obj tag *)
let native_output_obj x =
link_gen "cmx" "cmxa" !Options.ext_lib [!Options.ext_obj; "cmi"]
ocamlopt_link_prog
(fun tags -> tags++"ocaml"++"link"++"native"++"output_obj") x
let bytecode_output_obj x =
link_gen "cmo" "cma" !Options.ext_lib [!Options.ext_obj; "cmi"]
ocamlc_link_prog
(fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj") x
(** Generate all the rules for mir *)
let rules () =
(* Copied from ocaml/ocamlbuild/ocaml_specific.ml *)
let ext_obj = !Options.ext_obj in
let x_o = "%"-.-ext_obj in
(* Generate the source stub that calls OS.Main.run *)
rule "exec_ml: %.mir -> %__.ml"
~prod:"%(backend)/%(file)__.ml"
~dep:"%(backend)/%(file).mir"
(ml_main "%(backend)/%(file).mir" "%(backend)/%(file)__.ml");
(* Rule to link a module and output a standalone native object file *)
rule "ocaml: cmx* & o* -> .m.o"
~prod:"%.m.o"
~deps:["%.cmx"; x_o]
(native_output_obj "%.cmx" "%.m.o");
(* Rule to link a module and output a standalone bytecode C file *)
rule "ocaml: cmo* & o* -> .mb.c"
~prod:"%.mb.c"
~deps:["%.cmo"; x_o]
(bytecode_output_obj "%.cmo" "%.mb.c");
(* Rule to ocamlclean a C file into a crunched version.
* Requires avsm/ocamlclean from github *)
rule "ocaml: .mb.c -> .mc.c"
~prod:"%.mc.c"
~dep:"%.mb.c"
(ocamlclean "%.mc.c" "%.mb.c");
(* Rule to rename module sections to ml* equivalents for the static vmem layout *)
rule "ocaml: .m.o -> .mx.o"
~prod:"%.mx.o"
~dep:"%.m.o"
(xen_objcopy "%.mx.o" "%.m.o");
(* Xen link rule *)
rule ("final link: xen/%__.mx.o -> xen/%.xen")
~prod:"xen/%(file).xen"
~dep:"xen/%(file)__.mx.o"
(cc_link_c_implem cc_xen_nc_link "xen/%(file)__.mx.o" "xen/%(file).xen");
(* Xen bytecode link rule *)
rule ("final link: xen/%__.mb.o -> xen/%.bcxen")
~prod:"xen/%(file).bcxen"
~dep:"xen/%(file)__.mc.o"
(cc_link_c_implem cc_xen_bc_link "xen/%(file)__.mc.o" "xen/%(file).bcxen");
(* UNIX link rule *)
rule ("final link: %__.m.o -> %.unix-%(mode).bin")
~prod:"unix-%(mode)/%(file).bin"
~dep:"unix-%(mode)/%(file)__.m.o"
(cc_link_c_implem cc_unix_native_link "unix-%(mode)/%(file)__.m.o" "unix-%(mode)/%(file).bin");
(* UNIX bytecode link rule with ocamlclean *)
rule ("final link: %__.mc.c -> %.unix-%(mode).bcxbin")
~prod:"unix-%(mode)/%(file).bcxbin"
~dep:"unix-%(mode)/%(file)__.mc.o"
(cc_link_c_implem cc_unix_bytecode_link "unix-%(mode)/%(file)__.mc.o" "unix-%(mode)/%(file).bcxbin");
(* UNIX bytecode link rule without ocamlclean *)
rule ("final link: %__.mb.c -> %.unix-%(mode).bcbin")
~prod:"unix-%(mode)/%(file).bcbin"
~dep:"unix-%(mode)/%(file)__.mb.o"
(cc_link_c_implem cc_unix_bytecode_link "unix-%(mode)/%(file)__.mb.o" "unix-%(mode)/%(file).bcbin");
(* Node link rule *)
rule ("final link: node/%__.byte -> node/%.js")
~prod:"node/%.js"
~dep:"node/%__.byte"
(js_of_ocaml "node/%.js" "node/%__.byte");
(* Generate a default %.mir if one doesnt exist *)
rule "default mir file"
~prod:"%(test).mir"
(fun env build ->
let mir = env "%(test).mir" in
let modu = String.capitalize (Pathname.basename (env "%(test)")) in
Util.safe_echo [modu-.-"main"] mir
)
end
(** Testing specifications module *)
module Spec = struct
(** Supported Mirage backends *)
type backend =
|Xen
|Node
|Unix_direct
|Unix_socket
|External
(** Spec file describing the test and dependencies *)
type t = {
target: string option; (* the name of the mirage target, defaults to the spec file root *)
backends: backend list; (* supported backends *)
expect: int; (* return code to expect from the script *)
vbds: string list;
kv_ros: string list;
}
let backend_of_string = function
|"xen" -> Xen
|"unix-direct" -> Unix_direct
|"node" -> Node
|"unix-socket" -> Unix_socket
|"external" -> External
|x -> failwith ("unknown backend: " ^ x)
let backend_to_string = function
|Xen -> "xen"
|Node -> "node"
|Unix_direct -> "unix-direct"
|Unix_socket -> "unix-socket"
|External -> "external"
(* List of all backends (not all need to be supported) *)
let all_backends =
[ Xen; Node; Unix_direct; Unix_socket ]
(* Check if a backend is supported on this host *)
let is_supported =
let open OS in
function
|Xen -> if (host,arch) = (Linux,X86_64) && Sys.file_exists "/proc/xen/capabilities" then `Yes else `No
|Node -> if js_of_ocaml_installed then `Yes else `No
|Unix_direct |Unix_socket -> `Yes
|External -> `External
let backends_iter fn spec = List.iter fn spec.backends
(* Map over backends, calling supported or unsupported on them appropriately *)
let backends_map supported unsupported spec =
let sup,unsup = List.partition (fun be ->
match is_supported be with |`Yes|`External->true |`No->false) spec.backends in
(List.map supported sup), (List.map unsupported unsup)
(* Get the build target of a given backend *)
let backend_target be name =
let dir = backend_to_string be in
match be with
|Xen -> sprintf "%s/%s.xen" dir name
|Node -> sprintf "%s/%s.js" dir name
|Unix_direct |Unix_socket -> sprintf "%s/%s.bin" dir name
|External -> assert false
(** Spec file contains key:value pairs:
backend:xen,node,unix-direct,unix-socket
backend:* (short form of above)
no backend key results in "backend:*" being default
*)
let parse file =
let lines = string_list_of_file file in
let kvs = List.map (fun line ->
match Util.split line ':' with
|[k;v] -> (String.lowercase k), (String.lowercase v)
|k::v -> (String.lowercase k), (String.lowercase (String.concat ":" v))
|[] -> failwith (sprintf "empty spec entry '%s'" line)
) lines in
let backends =
try (match List.assoc "backend" kvs with
|"*" -> all_backends
|backends -> List.map backend_of_string (Util.split backends ',')
) with Not_found -> all_backends
in
let expect =
try (int_of_string (List.assoc "expect" kvs))
with Not_found -> 0
in
let target =
try Some (List.assoc "name" kvs)
with Not_found -> None
in
let vbds =
List.fold_left (fun a (k,v) -> if k = "vbd" then v :: a else a) [] kvs in
let kv_ros =
List.fold_left (fun a (k,v) -> if k = "kv_ro" then v :: a else a) [] kvs in
{target; backends; expect; vbds; kv_ros}
(* Convert a list of Outcomes into a logging Echo command *)
let log_outcomes file ocs =
Util.safe_echo (List.map (function
|Outcome.Good o -> sprintf "ok %s" o
|Outcome.Bad exn -> sprintf "not ok %s" (Printexc.to_string exn)
) ocs) file
let rules () =
rule "build and execute spec backend target"
~prod:"%(test).%(backend).exec"
~dep:"%(test).spec"
(fun env build ->
let backend = backend_of_string (env "%(backend)") in
let spec = parse (env "%(test).spec") in
let root_target = match spec.target with
|None -> env "%(test)"
|Some x -> Pathname.dirname (env "%(test)") / x in
let test_sh = env "%(test).sh" in
let exec_cmd = match is_supported backend with
|`Yes ->
(* Build the target for this backend *)
let prod = env "%(test).%(backend).exec" in
let binary = backend_target backend root_target in
let _ = List.map Outcome.ignore_good (build [[ binary ]]) in
(* If a test is expected to fail, then we need to pass this to mir-run *)
let return = match spec.expect with
|0 -> [N] |e -> [A"-e"; A(string_of_int e)] in
(* Add -vbd command line. "*" will generate a new temporary vbd *)
let vbdnum = ref 0 in
let vbds = List.flatten (List.map (fun vbd ->
let name =
if vbd = "*" then
(incr vbdnum; env "%(test).%(backend).disk" ^ (string_of_int !vbdnum))
else
vbd
in
[A"-vbd";P name]) spec.vbds)
in
let kv_ros = List.flatten (List.map (fun kv_ro ->
[A"-kv_ro";P kv_ro]) spec.kv_ros) in
(* Execute the binary using the mir-run wrapper and log its output to prod *)
Cmd (S ([A "mir-run"; A"-m"; A"8192"; A"-b"; A (env "%(backend)"); A"-o"; P prod] @ vbds @ kv_ros @ return @[A binary]))
|`No ->
(* Unsupported backend for this test, so mark as skipped in the log *)
Util.safe_echo ["skipped"] (env "%(test).%(backend).exec")
|`External ->
(* Run a shell script to support external test *)
Cmd (S ([A "bash"; P test_sh; A"run"]))
in
(* If a support shell script exists, then run that to prepare the test and clean up after
Args: $1=[prerun|postrun] $2=backend
*)
match build [[test_sh]] with
|[Outcome.Good o] ->
Seq [ Cmd (S [A "bash"; P test_sh; A"prerun"; A (env "%(backend)")]);
exec_cmd;
Cmd (S [A "bash"; P test_sh; A"postrun"; A (env "%(backend)")])]
|[Outcome.Bad o] -> exec_cmd
|_ -> assert false
);
rule "build and execute all supported backend targets"
~prod:"%(test).exec"
~dep:"%(test).spec"
(fun env build ->
let test = env "%(test)" in
let spec = parse (env "%(test).spec") in
let sup, unsup = backends_map
(fun be -> [sprintf "%s.%s.exec" test (backend_to_string be)])
(fun be -> sprintf "skipped %s.%s.exec" test (backend_to_string be)) spec in
let sup_results = List.map (function
| Outcome.Good o -> sprintf "ok %s" o
| Outcome.Bad exn -> sprintf "not ok %s" (Printexc.to_string exn)
) (build sup) in
Util.safe_echo (sup_results @ unsup) (env "%(test).exec")
);
rule "execute a suite of tests"
~prod:"%(test).run"
~dep:"%(test).suite"
(fun env build ->
let suite = env "%(test).suite" in
let tests = List.map (fun x -> x-.-"exec") (string_list_of_file suite) in
let _ = build (List.map (fun x -> [x]) tests) in
(* concat all the sub-files into one *)
Cmd (S (A"cat" :: (List.map (fun x -> P x) tests) @ [ Sh ">"; P (env "%(test).run") ]))
);
(* If a default spec file does not exist, then just construct one with "backend:*" *)
rule "default spec file if one doesnt exist"
~prod:"%(test).spec"
(fun env build -> Util.safe_echo ["backend:*"] (env "%(test).spec"))
end
(* Alias source files into their repsective backend/ subdirs *)
let () =
let source_exts = [".ml"; ".mli"; ".mll"; ".mly"; ".mir"] in
List.iter (fun ext ->
let prod = "%(backend)/%(file)"^ext and dep = "%(file)"^ext in
rule (sprintf "alias from %%.%s -> <backend>/%%.%s" ext ext)
~prod ~dep (fun env build ->
Seq [ Cmd (S [A"mkdir";A"-p";P (Pathname.dirname (env prod))]);
cp (env dep) (env prod) ])
) source_exts
(* XXX tag_file in ocamlbuild forces quotes around the filename,
preventing globs such as <xen/**> from tagging subdirectories.
We define tag_glob as a workaround *)
let tag_glob glob tags =
Ocamlbuild_pack.Configuration.parse_string
(sprintf "<%s>: %s" glob (String.concat ", " tags))
let _ = dispatch begin function
| Before_hygiene ->
(* Flag all the backend subdirs with a "backend:" tag *)
List.iter (fun be ->
let be = Spec.backend_to_string be in
let betag = sprintf "backend:%s" be in
tag_glob (sprintf "%s/**" be) [betag];
) Spec.all_backends
| After_options ->
let syntaxdir = lib / "syntax" in
let pp_pa = sprintf "camlp4o.opt -I %s str.cmxs pa_mirage.cmxs"syntaxdir
in
Options.ocaml_ppflags := [pp_pa]
| After_rules -> begin
(* do not compile with the standard lib *)
let std_flags = S [ A"-nostdlib"; A"-annot" ] in
flag ["ocaml"; "compile"] & std_flags;
flag ["ocaml"; "pack"] & std_flags;
flag ["ocaml"; "link"] & std_flags;
if profiling then flag ["ocaml"; "compile"; "native" ] & S [A"-p"; A"-g"];
(* Include the correct stdlib depending on which backend is chosen *)
List.iter (fun be ->
let be = Spec.backend_to_string be in
let betag = sprintf "backend:%s" be in
flag ["ocaml"; "compile"; betag] & S [A"-I"; Px (lib / be / "lib")];
flag ["ocaml"; "pack"; betag] & S [A"-I"; Px (lib / be / "lib")];
flag ["ocaml"; "link"; betag] & S [A"-I"; Px (lib / be / "lib")];
) Spec.all_backends;
Mir.rules ();
Spec.rules ()
end
| _ -> ()
end
Jump to Line
Something went wrong with that request. Please try again.