aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/be/abi.ml34
-rw-r--r--src/boot/be/elf.ml100
-rw-r--r--src/boot/be/x86.ml2
-rw-r--r--src/boot/driver/lib.ml4
-rw-r--r--src/boot/driver/main.ml29
-rw-r--r--src/boot/fe/cexp.ml1
-rw-r--r--src/boot/me/trans.ml4
-rw-r--r--src/boot/me/typestate.ml357
-rw-r--r--src/boot/util/common.ml1
9 files changed, 247 insertions, 285 deletions
diff --git a/src/boot/be/abi.ml b/src/boot/be/abi.ml
index 035d1f05..89e308bf 100644
--- a/src/boot/be/abi.ml
+++ b/src/boot/be/abi.ml
@@ -110,23 +110,33 @@ let indirect_args_elt_closure = 0;;
(* Current worst case is by vec grow glue *)
let worst_case_glue_call_args = 8;;
+(*
+ * ABI tags used to inform the runtime which sort of frame to set up for new
+ * spawned functions. FIXME: There is almost certainly a better abstraction to
+ * use.
+ *)
+let abi_x86_rustboot_cdecl = 1;;
+let abi_x86_rustc_fastcall = 2;;
+
type abi =
- {
- abi_word_sz: int64;
- abi_word_bits: Il.bits;
- abi_word_ty: Common.ty_mach;
+ {
+ abi_word_sz: int64;
+ abi_word_bits: Il.bits;
+ abi_word_ty: Common.ty_mach;
+
+ abi_tag: int;
- abi_has_pcrel_data: bool;
- abi_has_pcrel_code: bool;
+ abi_has_pcrel_data: bool;
+ abi_has_pcrel_code: bool;
- abi_n_hardregs: int;
- abi_str_of_hardreg: (int -> string);
+ abi_n_hardregs: int;
+ abi_str_of_hardreg: (int -> string);
- abi_emit_target_specific: (Il.emitter -> Il.quad -> unit);
- abi_constrain_vregs: (Il.quad -> (Il.vreg,Bits.t) Hashtbl.t -> unit);
+ abi_emit_target_specific: (Il.emitter -> Il.quad -> unit);
+ abi_constrain_vregs: (Il.quad -> (Il.vreg,Bits.t) Hashtbl.t -> unit);
- abi_emit_fn_prologue: (Il.emitter
- -> Common.size (* framesz *)
+ abi_emit_fn_prologue: (Il.emitter
+ -> Common.size (* framesz *)
-> Common.size (* callsz *)
-> Common.nabi
-> Common.fixup (* grow_task *)
diff --git a/src/boot/be/elf.ml b/src/boot/be/elf.ml
index 406508e4..99b68042 100644
--- a/src/boot/be/elf.ml
+++ b/src/boot/be/elf.ml
@@ -44,7 +44,7 @@ type ei_data =
;;
-let elf_identification ei_class ei_data =
+let elf_identification sess ei_class ei_data =
SEQ
[|
STRING "\x7fELF";
@@ -58,9 +58,16 @@ let elf_identification ei_class ei_data =
ELFDATANONE -> 0
| ELFDATA2LSB -> 1
| ELFDATA2MSB -> 2);
+
1; (* EI_VERSION = EV_CURRENT *)
- 0; (* EI_PAD #7 *)
- 0; (* EI_PAD #8 *)
+
+ (* EI_OSABI *)
+ (match sess.Session.sess_targ with
+ FreeBSD_x86_elf -> 9
+ | _ -> 0);
+
+ 0; (* EI_ABIVERSION *)
+
0; (* EI_PAD #9 *)
0; (* EI_PAD #A *)
0; (* EI_PAD #B *)
@@ -117,7 +124,7 @@ let elf32_header
in
DEF
(elf_header_fixup,
- SEQ [| elf_identification ELFCLASS32 ei_data;
+ SEQ [| elf_identification sess ELFCLASS32 ei_data;
WORD (TY_u16, (IMM (match e_type with
ET_NONE -> 0L
| ET_REL -> 1L
@@ -480,6 +487,7 @@ let elf32_linux_x86_file
~(entry_name:string)
~(text_frags:(string option, frag) Hashtbl.t)
~(data_frags:(string option, frag) Hashtbl.t)
+ ~(bss_frags:(string option, frag) Hashtbl.t)
~(rodata_frags:(string option, frag) Hashtbl.t)
~(required_fixups:(string, fixup) Hashtbl.t)
~(dwarf:Dwarf.debug_records)
@@ -644,7 +652,7 @@ let elf32_linux_x86_file
(* let gotpltndx = 8L in *) (* Section index of .got.plt *)
(* let relapltndx = 9L in *) (* Section index of .rela.plt *)
let datandx = 10L in (* Section index of .data *)
- (* let bssndx = 11L in *) (* Section index of .bss *)
+ let bssndx = 11L in (* Section index of .bss *)
(* let dynamicndx = 12L in *) (* Section index of .dynamic *)
let shstrtabndx = 13L in (* Section index of .shstrtab *)
@@ -991,6 +999,22 @@ let elf32_linux_x86_file
(strtab_entry, symtab_entry)
in
+ let bss_sym name st_bind fixup =
+ let name_fixup = new_fixup ("bss symbol name fixup: '" ^ name ^ "'") in
+ let strtab_entry = DEF (name_fixup, ZSTRING name) in
+ let symtab_entry =
+ symbol
+ ~string_table_fixup: dynstr_section_fixup
+ ~name_string_fixup: name_fixup
+ ~sym_target_fixup: (Some fixup)
+ ~st_bind
+ ~st_type: STT_OBJECT
+ ~st_shndx: bssndx
+ in
+ incr n_syms;
+ (strtab_entry, symtab_entry)
+ in
+
let rodata_sym name st_bind fixup =
let name_fixup = new_fixup ("rodata symbol name fixup: '" ^ name ^ "'") in
let strtab_entry = DEF (name_fixup, ZSTRING name) in
@@ -1212,6 +1236,12 @@ let elf32_linux_x86_file
Hashtbl.fold (frags_of_symbol data_sym STB_GLOBAL) data_frags ([],[],[])
in
+ let (bss_strtab_frags,
+ bss_symtab_frags,
+ bss_body_frags) =
+ Hashtbl.fold (frags_of_symbol bss_sym STB_GLOBAL) bss_frags ([],[],[])
+ in
+
let (_,
require_strtab_frags,
require_symtab_frags,
@@ -1277,7 +1307,8 @@ let elf32_linux_x86_file
global_text_symtab_frags @
local_text_symtab_frags @
rodata_symtab_frags @
- data_symtab_frags))
+ data_symtab_frags @
+ bss_symtab_frags))
in
let dynstr_frags = (null_strtab_frag ::
@@ -1286,11 +1317,16 @@ let elf32_linux_x86_file
local_text_strtab_frags @
rodata_strtab_frags @
data_strtab_frags @
+ bss_strtab_frags @
(Array.to_list dynamic_needed_strtab_frags)))
in
let interp_section =
- DEF (interp_section_fixup, ZSTRING "/lib/ld-linux.so.2")
+
+ DEF (interp_section_fixup, ZSTRING
+ (if sess.Session.sess_targ = FreeBSD_x86_elf
+ then "/libexec/ld-elf.so.1"
+ else "/lib/ld-linux.so.2"))
in
let text_section =
@@ -1307,7 +1343,7 @@ let elf32_linux_x86_file
in
let bss_section =
DEF (bss_section_fixup,
- SEQ [| |])
+ SEQ (Array.of_list bss_body_frags))
in
let dynsym_section =
DEF (dynsym_section_fixup,
@@ -1486,6 +1522,7 @@ let emit_file
let text_frags = Hashtbl.create 4 in
let rodata_frags = Hashtbl.create 4 in
let data_frags = Hashtbl.create 4 in
+ let bss_frags = Hashtbl.create 4 in
let required_fixups = Hashtbl.create 4 in
(*
@@ -1584,7 +1621,9 @@ let emit_file
let needed_libs =
[|
- "libc.so.6";
+ if sess.Session.sess_targ = FreeBSD_x86_elf
+ then "libc.so.7"
+ else "libc.so.6";
"librustrt.so"
|]
in
@@ -1604,6 +1643,27 @@ let emit_file
htab_put text_frags None code;
htab_put rodata_frags None data;
+ if sess.Session.sess_targ = FreeBSD_x86_elf
+ then
+ (*
+ * FreeBSD wants some extra symbols in .bss so its libc can fill
+ * them in, I think.
+ *)
+ List.iter
+ (fun x -> htab_put bss_frags (Some x) (WORD (TY_u32, (IMM 0L))))
+ [
+ "environ";
+ "optind";
+ "optarg";
+ "_CurrentRuneLocale";
+ "__stack_chk_guard";
+ "__mb_sb_limit";
+ "__isthreaded";
+ "__stdinp";
+ "__stderrp";
+ "__stdoutp";
+ ];
+
Hashtbl.iter
begin
fun _ tab ->
@@ -1616,6 +1676,7 @@ let emit_file
end
sem.Semant.ctxt_native_required
in
+
let all_frags =
elf32_linux_x86_file
~sess
@@ -1623,6 +1684,7 @@ let emit_file
~entry_name: "_start"
~text_frags
~data_frags
+ ~bss_frags
~dwarf
~sem
~rodata_frags
@@ -1640,16 +1702,16 @@ let sniff
: asm_reader option =
try
let stat = Unix.stat filename in
- if (stat.Unix.st_kind = Unix.S_REG) &&
- (stat.Unix.st_size > 4)
- then
- let ar = new_asm_reader sess filename in
- let _ = log sess "sniffing ELF file" in
- if (ar.asm_get_zstr_padded 4) = elf_magic
- then (ar.asm_seek 0; Some ar)
- else None
- else
- None
+ if (stat.Unix.st_kind = Unix.S_REG) &&
+ (stat.Unix.st_size > 4)
+ then
+ let ar = new_asm_reader sess filename in
+ let _ = log sess "sniffing ELF file" in
+ if (ar.asm_get_zstr_padded 4) = elf_magic
+ then (ar.asm_seek 0; Some ar)
+ else None
+ else
+ None
with
_ -> None
;;
diff --git a/src/boot/be/x86.ml b/src/boot/be/x86.ml
index 30b49ed1..49b660be 100644
--- a/src/boot/be/x86.ml
+++ b/src/boot/be/x86.ml
@@ -1851,6 +1851,8 @@ let (abi:Abi.abi) =
Abi.abi_word_bits = word_bits;
Abi.abi_word_ty = word_ty;
+ Abi.abi_tag = Abi.abi_x86_rustboot_cdecl;
+
Abi.abi_has_pcrel_data = false;
Abi.abi_has_pcrel_code = true;
diff --git a/src/boot/driver/lib.ml b/src/boot/driver/lib.ml
index a4769e83..00b1b834 100644
--- a/src/boot/driver/lib.ml
+++ b/src/boot/driver/lib.ml
@@ -249,6 +249,7 @@ let get_ar
Win32_x86_pe -> Pe.sniff
| MacOS_x86_macho -> Macho.sniff
| Linux_x86_elf -> Elf.sniff
+ | FreeBSD_x86_elf -> Elf.sniff
in
sniff sess filename
end
@@ -270,6 +271,7 @@ let get_sects
Win32_x86_pe -> Pe.get_sections
| MacOS_x86_macho -> Macho.get_sections
| Linux_x86_elf -> Elf.get_sections
+ | FreeBSD_x86_elf -> Elf.get_sections
in
Some (ar, (get_sections sess ar))
end
@@ -350,6 +352,7 @@ let get_mod
Win32_x86_pe -> ".dll"
| MacOS_x86_macho -> ".dylib"
| Linux_x86_elf -> ".so"
+ | FreeBSD_x86_elf -> ".so"
in
let rec meta_matches i f_meta =
if i >= (Array.length meta)
@@ -447,6 +450,7 @@ let infer_lib_name
Win32_x86_pe -> ident ^ ".dll"
| MacOS_x86_macho -> "lib" ^ ident ^ ".dylib"
| Linux_x86_elf -> "lib" ^ ident ^ ".so"
+ | FreeBSD_x86_elf -> "lib" ^ ident ^ ".so"
;;
diff --git a/src/boot/driver/main.ml b/src/boot/driver/main.ml
index 2bbc832b..9705f1ee 100644
--- a/src/boot/driver/main.ml
+++ b/src/boot/driver/main.ml
@@ -8,12 +8,21 @@ let _ =
let (targ:Common.target) =
match Sys.os_type with
- "Unix" when Unix.system "test `uname -s` = 'Darwin'" = Unix.WEXITED 0 ->
- MacOS_x86_macho
- | "Unix" -> Linux_x86_elf
- | "Win32" -> Win32_x86_pe
+
+ | "Win32"
| "Cygwin" -> Win32_x86_pe
- | _ -> Linux_x86_elf
+
+ | "Unix"
+ when Unix.system "test `uname -s` = 'Linux'" = Unix.WEXITED 0 ->
+ Linux_x86_elf
+ | "Unix"
+ when Unix.system "test `uname -s` = 'Darwin'" = Unix.WEXITED 0 ->
+ MacOS_x86_macho
+ | "Unix"
+ when Unix.system "test `uname -s` = 'FreeBSD'" = Unix.WEXITED 0 ->
+ FreeBSD_x86_elf
+ | _ ->
+ Linux_x86_elf
;;
let (abi:Abi.abi) = X86.abi;;
@@ -96,6 +105,7 @@ let default_output_filename (sess:Session.sess) : filename option =
else
base ^ (match sess.Session.sess_targ with
Linux_x86_elf -> ""
+ | FreeBSD_x86_elf -> ""
| MacOS_x86_macho -> ""
| Win32_x86_pe -> ".exe")
in
@@ -144,16 +154,21 @@ let flag f opt desc =
let argspecs =
[
- ("-t", Arg.Symbol (["linux-x86-elf"; "win32-x86-pe"; "macos-x86-macho"],
+ ("-t", Arg.Symbol (["linux-x86-elf";
+ "win32-x86-pe";
+ "macos-x86-macho";
+ "freebsd-x86-elf"],
fun s -> (sess.Session.sess_targ <-
(match s with
"win32-x86-pe" -> Win32_x86_pe
| "macos-x86-macho" -> MacOS_x86_macho
+ | "freebsd-x86-elf" -> FreeBSD_x86_elf
| _ -> Linux_x86_elf))),
(" target (default: " ^ (match sess.Session.sess_targ with
Win32_x86_pe -> "win32-x86-pe"
| Linux_x86_elf -> "linux-x86-elf"
| MacOS_x86_macho -> "macos-x86-macho"
+ | FreeBSD_x86_elf -> "freebsd-x86-elf"
) ^ ")"));
("-o", Arg.String (fun s -> sess.Session.sess_out <- Some s),
"file to output (default: "
@@ -320,6 +335,7 @@ let parse_input_crate
let depfile =
match sess.Session.sess_targ with
Linux_x86_elf
+ | FreeBSD_x86_elf
| MacOS_x86_macho -> outfile ^ ".d"
| Win32_x86_pe -> (Filename.chop_extension outfile) ^ ".d"
in
@@ -473,6 +489,7 @@ let main_pipeline _ =
Win32_x86_pe -> Pe.emit_file
| MacOS_x86_macho -> Macho.emit_file
| Linux_x86_elf -> Elf.emit_file
+ | FreeBSD_x86_elf -> Elf.emit_file
in
Session.time_inner "emit" sess
(fun _ -> emitter sess crate code data sem_cx dwarf);
diff --git a/src/boot/fe/cexp.ml b/src/boot/fe/cexp.ml
index 56f3e878..0f216fc2 100644
--- a/src/boot/fe/cexp.ml
+++ b/src/boot/fe/cexp.ml
@@ -628,6 +628,7 @@ let parse_crate_file
let (os, arch, libc) =
match sess.Session.sess_targ with
Linux_x86_elf -> ("linux", "x86", "libc.so.6")
+ | FreeBSD_x86_elf -> ("freebsd", "x86", "libc.so.7")
| Win32_x86_pe -> ("win32", "x86", "msvcrt.dll")
| MacOS_x86_macho -> ("macos", "x86", "libc.dylib")
in
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index 4f717219..bbf49e83 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -2727,6 +2727,7 @@ let trans_visitor
[|
Il.Cell new_task;
exit_task_glue_fptr;
+ (imm (Int64.of_int abi.Abi.abi_tag));
fptr_operand;
callsz
|];
@@ -2739,6 +2740,7 @@ let trans_visitor
[|
Il.Cell new_task;
exit_task_glue_fptr;
+ (imm (Int64.of_int abi.Abi.abi_tag));
fptr_operand;
callsz
|];
@@ -6183,6 +6185,8 @@ let trans_visitor
tab_sz cx.ctxt_required_rust_sym_num;
tab_sz cx.ctxt_required_c_sym_num;
tab_sz cx.ctxt_required_lib_num;
+
+ Asm.WORD (word_ty_mach, Asm.IMM (Int64.of_int abi.Abi.abi_tag));
|]))
in
diff --git a/src/boot/me/typestate.ml b/src/boot/me/typestate.ml
index ea0204f3..8b7840a2 100644
--- a/src/boot/me/typestate.ml
+++ b/src/boot/me/typestate.ml
@@ -24,7 +24,6 @@ type typestate_tables =
ts_prestates: (node_id,Bits.t) Hashtbl.t;
ts_poststates: (node_id,Bits.t) Hashtbl.t;
ts_graph: node_graph;
- ts_siblings: sibling_map;
ts_stmts: Ast.stmt Stack.t;
ts_maxid: int ref;
}
@@ -38,7 +37,6 @@ let new_tables _ =
ts_poststates = Hashtbl.create 0;
ts_prestates = Hashtbl.create 0;
ts_graph = Hashtbl.create 0;
- ts_siblings = Hashtbl.create 0;
ts_stmts = Stack.create ();
ts_maxid = ref 0 }
;;
@@ -790,279 +788,148 @@ let show_node cx graph s i =
s (int_of_node i) (lset_fmt (Hashtbl.find graph i)))
;;
-let graph_sequence_building_visitor
- (cx:ctxt)
- (tables_stack:typestate_tables Stack.t)
- (inner:Walk.visitor)
- : Walk.visitor =
+let add_flow_edges (graph:node_graph) (n:node_id) (dsts:node_id list) : unit =
+ if Hashtbl.mem graph n
+ then
+ let existing = Hashtbl.find graph n in
+ Hashtbl.replace graph n (lset_union existing dsts)
+ else
+ Hashtbl.add graph n dsts
+;;
- let tables _ = Stack.top tables_stack in
+let rec build_flow_graph_for_stmt
+ (graph:node_graph)
+ (predecessors:node_id list)
+ (s:Ast.stmt)
+ : node_id list =
- (* Flow each stmt to its sequence-successor. *)
- let visit_stmts stmts =
- let ts = tables () in
- let graph = ts.ts_graph in
- let sibs = ts.ts_siblings in
- let len = Array.length stmts in
- for i = 0 to len - 2
- do
- let stmt = stmts.(i) in
- let next = stmts.(i+1) in
- log cx "sequential stmt edge %d -> %d"
- (int_of_node stmt.id) (int_of_node next.id);
- htab_put graph stmt.id [next.id];
- htab_put sibs stmt.id next.id;
- done;
- (* Flow last node to nowhere. *)
- if len > 0
- then htab_put graph stmts.(len-1).id []
+ let connect ps qs =
+ List.iter
+ (fun pred -> add_flow_edges graph pred qs)
+ ps
in
- let visit_stmt_pre s =
- (* Sequence the prelude nodes on special stmts. *)
- begin
- match s.node with
- Ast.STMT_while sw ->
- let (stmts, _) = sw.Ast.while_lval in
- visit_stmts stmts
- | _ -> ()
- end;
- inner.Walk.visit_stmt_pre s
+ let seq ps (ss:Ast.stmt array) =
+ build_flow_graph_for_stmts graph ps ss
in
- let visit_block_pre b =
- visit_stmts b.node;
- inner.Walk.visit_block_pre b
+ let blk ps b =
+ connect ps [b.id];
+ seq [b.id] b.node
in
- { inner with
- Walk.visit_stmt_pre = visit_stmt_pre;
- Walk.visit_block_pre = visit_block_pre }
-;;
-
-let add_flow_edges (graph:node_graph) (n:node_id) (dsts:node_id list) : unit =
- let existing = Hashtbl.find graph n in
- Hashtbl.replace graph n (lset_union existing dsts)
-;;
+ let first ss =
+ if Array.length ss = 0
+ then []
+ else [ss.(0).id]
+ in
-let remove_flow_edges
- (graph:node_graph)
- (n:node_id)
- (dsts:node_id list)
- : unit =
- let existing = Hashtbl.find graph n in
- Hashtbl.replace graph n (lset_diff existing dsts)
-;;
+ connect [s.id] [];
+ let outs =
+ match s.node with
+ | Ast.STMT_while sw ->
+ let (pre_loop_stmts, _) = sw.Ast.while_lval in
+ let body = sw.Ast.while_body in
+ let preloop_end = seq [s.id] pre_loop_stmts in
+ connect predecessors [s.id];
+ connect (blk preloop_end body) (first pre_loop_stmts);
+ preloop_end
+
+ | Ast.STMT_for sf ->
+ let body_end = blk [s.id] sf.Ast.for_body in
+ connect predecessors [s.id];
+ connect body_end (first sf.Ast.for_body.node);
+ body_end
+
+ | Ast.STMT_for_each sfe ->
+ let head_end = blk [s.id] sfe.Ast.for_each_head in
+ let body_end = blk head_end sfe.Ast.for_each_body in
+ connect predecessors [s.id];
+ connect body_end (first sfe.Ast.for_each_head.node);
+ body_end
+
+ | Ast.STMT_if sif ->
+ connect predecessors [s.id];
+ (blk [s.id] sif.Ast.if_then) @
+ (match sif.Ast.if_else with
+ None -> [s.id]
+ | Some els -> blk [s.id] els)
+
+ | Ast.STMT_alt_tag sat ->
+ connect predecessors [s.id];
+ Array.fold_left
+ (fun ends {node=(_, b); id=_} -> (blk [s.id] b) @ ends)
+ [] sat.Ast.alt_tag_arms
+
+ | Ast.STMT_block b ->
+ blk predecessors b
+
+ | Ast.STMT_fail
+ | Ast.STMT_ret _ ->
+ connect predecessors [s.id];
+ []
+
+ | _ ->
+ connect predecessors [s.id];
+ [s.id]
+ in
+ connect outs [];
+ outs
-let last_id (nodes:('a identified) array) : node_id =
- let len = Array.length nodes in
- nodes.(len-1).id
+and build_flow_graph_for_stmts
+ (graph:node_graph)
+ (predecessors:node_id list)
+ (ss:Ast.stmt array)
+ : node_id list =
+ Array.fold_left (build_flow_graph_for_stmt graph) predecessors ss
;;
-let last_id_or_block_id (block:Ast.block) : node_id =
- let len = Array.length block.node in
- if len = 0
- then block.id
- else last_id block.node
-;;
-let graph_general_block_structure_building_visitor
+let graph_building_visitor
(cx:ctxt)
(tables_stack:typestate_tables Stack.t)
(inner:Walk.visitor)
: Walk.visitor =
let tables _ = Stack.top tables_stack in
+ let graph _ = (tables()).ts_graph in
+ let blk b =
+ add_flow_edges (graph()) b.id [];
+ ignore (build_flow_graph_for_stmts (graph()) [b.id] b.node)
+ in
- let visit_stmt_pre s =
- let ts = tables () in
- let stmts = ts.ts_stmts in
- Stack.push s stmts;
- inner.Walk.visit_stmt_pre s
+ let visit_mod_item_pre n p i =
+ begin
+ match i.node.Ast.decl_item with
+ Ast.MOD_ITEM_fn fn -> blk fn.Ast.fn_body
+ | _ -> ()
+ end;
+ inner.Walk.visit_mod_item_pre n p i
in
- let visit_stmt_post s =
- let ts = tables () in
- let stmts = ts.ts_stmts in
- inner.Walk.visit_stmt_post s;
- ignore (Stack.pop stmts)
+ let visit_obj_fn_pre obj ident fn =
+ blk fn.node.Ast.fn_body;
+ inner.Walk.visit_obj_fn_pre obj ident fn
in
- let show_node =
- fun n id -> show_node cx (tables()).ts_graph n id
+ let visit_obj_drop_pre obj b =
+ blk b;
+ inner.Walk.visit_obj_drop_pre obj b
in
let visit_block_pre b =
- begin
- let ts = tables () in
- let graph = ts.ts_graph in
- let sibs = ts.ts_siblings in
- let stmts = ts.ts_stmts in
- let len = Array.length b.node in
- let _ = htab_put graph b.id
- (if len > 0 then [b.node.(0).id] else [])
- in
-
- (*
- * If block has len,
- * then flow block to block.node.(0) and block.node.(len-1) to dsts
- * else flow block to dsts
- *
- * so AST:
- *
- * block#n{ stmt#0 ... stmt#k };
- * stmt#j;
- *
- * turns into graph:
- *
- * block#n -> stmt#0 -> ... -> stmt#k -> stmt#j
- *
- *)
- if Stack.is_empty stmts
- then ()
- else
- let s = Stack.top stmts in
- add_flow_edges graph s.id [b.id];
- match htab_search sibs s.id with
- None -> ()
- | Some sib_id ->
- if len > 0
- then
- add_flow_edges graph (last_id b.node) [sib_id]
- else
- add_flow_edges graph b.id [sib_id]
- end;
- show_node "block" b.id;
+ if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
+ then blk b;
inner.Walk.visit_block_pre b
in
{ inner with
- Walk.visit_stmt_pre = visit_stmt_pre;
- Walk.visit_stmt_post = visit_stmt_post;
+ Walk.visit_mod_item_pre = visit_mod_item_pre;
+ Walk.visit_obj_fn_pre = visit_obj_fn_pre;
+ Walk.visit_obj_drop_pre = visit_obj_drop_pre;
Walk.visit_block_pre = visit_block_pre }
-;;
-
-
-let graph_special_block_structure_building_visitor
- (cx:ctxt)
- (tables_stack:typestate_tables Stack.t)
- (inner:Walk.visitor)
- : Walk.visitor =
- let tables _ = Stack.top tables_stack in
-
- let visit_stmt_pre s =
- begin
- match s.node with
-
- Ast.STMT_if sif ->
- let ts = tables () in
- let graph = ts.ts_graph in
- let cond_id = s.id in
- let succ = Hashtbl.find graph cond_id in
- let then_id = sif.Ast.if_then.id in
- let then_end_id = last_id_or_block_id sif.Ast.if_then in
- let show_node = show_node cx graph in
- let succ = List.filter (fun x -> not (x = then_id)) succ in
- show_node "initial cond" cond_id;
- show_node "initial then" then_id;
- show_node "initial then_end" then_end_id;
- begin
- match sif.Ast.if_else with
- None ->
- Hashtbl.replace graph cond_id (then_id :: succ);
- (* Kill residual messed-up block wiring.*)
- remove_flow_edges graph then_end_id [then_id];
- show_node "cond" cond_id;
- show_node "then" then_id;
- show_node "then_end" then_end_id;
-
- | Some e ->
- let else_id = e.id in
- let succ =
- List.filter (fun x -> not (x = else_id)) succ
- in
- let else_end_id = last_id_or_block_id e in
- show_node "initial else" else_id;
- show_node "initial else_end" else_end_id;
- Hashtbl.replace graph cond_id [then_id; else_id];
- Hashtbl.replace graph then_end_id succ;
- Hashtbl.replace graph else_end_id succ;
-
- (* Kill residual messed-up block wiring.*)
- remove_flow_edges graph then_end_id [then_id];
- remove_flow_edges graph else_id [then_id];
- remove_flow_edges graph else_end_id [then_id];
- show_node "cond" cond_id;
- show_node "then" then_id;
- show_node "then_end" then_end_id;
- show_node "else" else_id;
- show_node "else_end" else_end_id;
- end;
-
- | Ast.STMT_while sw ->
- (* There are a bunch of rewirings to do on 'while' nodes. *)
-
- begin
- let ts = tables () in
- let graph = ts.ts_graph in
- let dsts = Hashtbl.find graph s.id in
- let body = sw.Ast.while_body in
- let succ_stmts =
- List.filter (fun x -> not (x = body.id)) dsts
- in
-
- let (pre_loop_stmts, _) = sw.Ast.while_lval in
- let loop_head_id =
- (* Splice loop prelude into flow graph, save loop-head
- * node.
- *)
- let slen = Array.length pre_loop_stmts in
- if slen > 0
- then
- begin
- let pre_loop_begin = pre_loop_stmts.(0).id in
- let pre_loop_end = last_id pre_loop_stmts in
- remove_flow_edges graph s.id [body.id];
- add_flow_edges graph s.id [pre_loop_begin];
- add_flow_edges graph pre_loop_end [body.id];
- pre_loop_end
- end
- else
- body.id
- in
-
- (* Always flow s into the loop prelude; prelude may end
- * loop.
- *)
- remove_flow_edges graph s.id succ_stmts;
- add_flow_edges graph loop_head_id succ_stmts;
-
- (* Flow loop-end to loop-head. *)
- let loop_end = last_id_or_block_id body in
- add_flow_edges graph loop_end [loop_head_id]
- end
-
- | Ast.STMT_alt_tag at ->
- let ts = tables () in
- let graph = ts.ts_graph in
- let dsts = Hashtbl.find graph s.id in
- let arm_blocks =
- let arm_block_id { node = (_, block); id = _ } = block.id in
- Array.to_list (Array.map arm_block_id at.Ast.alt_tag_arms)
- in
- let succ_stmts =
- List.filter (fun x -> not (List.mem x arm_blocks)) dsts
- in
- remove_flow_edges graph s.id succ_stmts
-
- | _ -> ()
- end;
- inner.Walk.visit_stmt_post s
- in
- { inner with
- Walk.visit_stmt_pre = visit_stmt_pre }
;;
let find_roots
@@ -1631,13 +1498,7 @@ let process_crate
(condition_assigning_visitor cx tables_stack scopes
Walk.empty_visitor)));
(table_managed
- (graph_sequence_building_visitor cx tables_stack
- Walk.empty_visitor));
- (table_managed
- (graph_general_block_structure_building_visitor cx tables_stack
- Walk.empty_visitor));
- (table_managed
- (graph_special_block_structure_building_visitor cx tables_stack
+ (graph_building_visitor cx tables_stack
Walk.empty_visitor));
|]
in
diff --git a/src/boot/util/common.ml b/src/boot/util/common.ml
index f9b18246..c76da0de 100644
--- a/src/boot/util/common.ml
+++ b/src/boot/util/common.ml
@@ -56,6 +56,7 @@ type target =
Linux_x86_elf
| Win32_x86_pe
| MacOS_x86_macho
+ | FreeBSD_x86_elf
;;
type ty_mach =
generated by cgit v1.2.3 (git 2.25.1) at 2026-03-11 18:19:14 +0000