From 31a740a4ca52b9fb70c34397642581216d78d0e1 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 6 Jul 2023 08:53:28 +0200 Subject: [PATCH] [hxb] export/load macro context too --- src/compiler/generate.ml | 54 ++++++++++++++++++++--------------- src/compiler/hxb/hxbWriter.ml | 34 +++++++++++++++------- src/typing/typeloadModule.ml | 4 ++- 3 files changed, 58 insertions(+), 34 deletions(-) diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml index f44af3db9f8..b00fbb2edd7 100644 --- a/src/compiler/generate.ml +++ b/src/compiler/generate.ml @@ -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 @@ -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 diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index cc5e57a8f50..d894596a4a3 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -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 | [] -> @@ -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 | [] -> () diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 2ba07da6a9e..004124937ee 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -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