Skip to content

Commit

Permalink
[hxb] export/load macro context too
Browse files Browse the repository at this point in the history
  • Loading branch information
kLabz committed Jul 7, 2023
1 parent 9a5ec8b commit 31a740a
Show file tree
Hide file tree
Showing 3 changed files with 58 additions and 34 deletions.
54 changes: 31 additions & 23 deletions src/compiler/generate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -20,22 +20,24 @@ let check_auxiliary_output com actx =
Genjson.generate com.types file
end

let export_hxb com root m =
if m.m_extra.m_kind = MCode then begin
let anon_identification = new Genshared.tanon_identification ([],"") in
let writer = new HxbWriter.hxb_writer anon_identification in
writer#write_module m;
let ch = IO.output_bytes() in
let bytes_module = IO.close_out ch in
let ch = IO.output_bytes() in
writer#export ch;
let bytes_cp = IO.close_out ch in
let l = (root :: fst m.m_path @ [snd m.m_path]) in
let ch_file = Path.create_file true ".hxb" [] l in
output_bytes ch_file bytes_cp;
output_bytes ch_file bytes_module;
close_out ch_file
end
let export_hxb root m =
match m.m_extra.m_kind with
| MCode | MMacro -> begin
let anon_identification = new Genshared.tanon_identification ([],"") in
let writer = new HxbWriter.hxb_writer anon_identification in
writer#write_module m;
let ch = IO.output_bytes() in
let bytes_module = IO.close_out ch in
let ch = IO.output_bytes() in
writer#export ch;
let bytes_cp = IO.close_out ch in
let l = (root :: fst m.m_path @ [snd m.m_path]) in
let ch_file = Path.create_file true ".hxb" [] l in
output_bytes ch_file bytes_cp;
output_bytes ch_file bytes_module;
close_out ch_file
end
| _ -> ()

let check_hxb_output com actx =
begin match actx.hxb_out with
Expand Down Expand Up @@ -63,13 +65,19 @@ let check_hxb_output com actx =
iter_files [] (Unix.opendir path) path
in

let path = Path.add_trailing_slash path in
Common.log com ("Generating hxb to " ^ path);
Path.mkdir_from_path path;
clean_files path;
let t = Timer.timer ["generate";"hxb"] in
List.iter (export_hxb com path) com.modules;
t();
let export com =
let path = Path.add_trailing_slash (path ^ Path.path_sep ^ (Common.platform_name_macro com)) in
Common.log com ("Generating hxb to " ^ path);
Printf.eprintf "Generating hxb to %s\n" path;
Path.mkdir_from_path path;
clean_files path;
let t = Timer.timer ["generate";"hxb"] in
List.iter (export_hxb path) com.modules;
t();
in

export com;
Option.may export (com.get_macros());
end

let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
Expand Down
34 changes: 24 additions & 10 deletions src/compiler/hxb/hxbWriter.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1374,16 +1374,6 @@ class ['a] hxb_writer
chunk#write_list own_typedefs self#write_typedef;
end;

begin match anons#to_list with
| [] ->
()
| anons ->
self#start_chunk ANNR;
chunk#write_uleb128 (List.length anons);
self#start_chunk ANND;
chunk#write_list anons (fun an -> self#write_anon m an);
end;

let anon_fields = anon_fields#to_list in
begin match anon_fields with
| [] ->
Expand All @@ -1404,9 +1394,33 @@ class ['a] hxb_writer
chunk#write_list ttp self#write_type_parameter_forward;
chunk#write_list ttp self#write_type_parameter_data;
self#write_class_field { cf with cf_params = (cf.cf_params @ ftp#to_list) };
(* Printf.eprintf "Write anon field %s (done)\n" cf.cf_name; *)
);
end;

begin match anons#to_list with
| [] ->
()
| al ->
(* TODO clean this... currently loops until writing anons doesn't register any new anon *)
let rec loop written al =
let len = List.length al in
(* Printf.eprintf "Write ANND - %d anons registered for %s\n" len (s_type_path current_module.m_path); *)

self#start_chunk ANND;
(* TODO this is wasteful... *)
chunk#write_list al (fun an -> self#write_anon m an);

let al = anons#to_list in
let new_len = List.length al in
if len = new_len then begin
self#start_chunk ANNR;
chunk#write_uleb128 len;
end else loop len al;
in
loop 0 al
end;

begin match classes#to_list with
| [] ->
()
Expand Down
4 changes: 3 additions & 1 deletion src/typing/typeloadModule.ml
Original file line number Diff line number Diff line change
Expand Up @@ -823,7 +823,9 @@ and load_hxb_module ctx path p =
) ^ ".hxb"
in

let find_file = Common.find_file ctx.com ~class_path:ctx.com.binary_class_path in
let target = Common.platform_name_macro ctx.com in
let bcp = List.map (fun p -> p ^ target ^ Path.path_sep) ctx.com.binary_class_path in
let find_file = Common.find_file ctx.com ~class_path:bcp in
let file = try find_file (compose_path false) with Not_found -> find_file (compose_path true) in
let ch = try open_in_bin file with Sys_error _ -> raise Not_found in
let input = IO.input_channel ch in
Expand Down

0 comments on commit 31a740a

Please sign in to comment.