The unpac monorepo manager self-hosting as a monorepo using unpac
Add %standard_library_default
%standard_library_default allows Config.standard_library_default to be
converted to a compile-time derived value, as with existing compile-time
constants such as %backend_type, etc. This paves the way for allowing
Config.standard_library_default to be changed at link-time, rather than
fixed when the Config module itself is compiled.
+267
-100
+2
.depend
+2
.depend
···
5230
5230
lambda/debuginfo.cmi \
5231
5231
middle_end/convert_primitives.cmi \
5232
5232
utils/config.cmi \
5233
+
middle_end/compilenv.cmi \
5233
5234
middle_end/compilation_unit.cmi \
5234
5235
middle_end/flambda/base_types/closure_origin.cmi \
5235
5236
middle_end/flambda/base_types/closure_id.cmi \
···
5259
5260
lambda/debuginfo.cmx \
5260
5261
middle_end/convert_primitives.cmx \
5261
5262
utils/config.cmx \
5263
+
middle_end/compilenv.cmx \
5262
5264
middle_end/compilation_unit.cmx \
5263
5265
middle_end/flambda/base_types/closure_origin.cmx \
5264
5266
middle_end/flambda/base_types/closure_id.cmx \
+2
Makefile
+2
Makefile
+9
asmcomp/asmlink.ml
+9
asmcomp/asmlink.ml
···
198
198
crc_interfaces defined
199
199
200
200
let make_startup_file ~ppf_dump units_list ~crc_interfaces =
201
+
let need_stdlib =
202
+
let needs_stdlib ({ui_need_stdlib; _}, _, _) = ui_need_stdlib in
203
+
List.exists needs_stdlib units_list
204
+
in
201
205
let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in
202
206
Location.input_name := "caml_startup"; (* set name of "current" input *)
203
207
Compilenv.reset "_startup";
···
224
228
Array.iteri
225
229
(fun i name -> compile_phrase (Cmm_helpers.predef_exception i name))
226
230
Runtimedef.builtin_exceptions;
231
+
if need_stdlib then begin
232
+
compile_phrase
233
+
(Cmm_helpers.emit_global_string_constant
234
+
"caml_standard_library_nat" Config.standard_library_default)
235
+
end;
227
236
compile_phrase (Cmm_helpers.global_table name_list);
228
237
let globals_map = make_globals_map units_list ~crc_interfaces in
229
238
compile_phrase (Cmm_helpers.globals_map globals_map);
+4
asmcomp/asmpackager.ml
+4
asmcomp/asmpackager.ml
···
217
217
else
218
218
Clambda (get_approx ui)
219
219
in
220
+
let ui_need_stdlib =
221
+
List.exists (function {ui_need_stdlib; _} -> ui_need_stdlib) units
222
+
in
220
223
Export_info_for_pack.clear_import_state ();
221
224
let pkg_infos =
222
225
{ ui_name = ui.ui_name;
···
239
242
List.exists (fun info -> info.ui_force_link) units;
240
243
ui_export_info;
241
244
ui_for_pack = None;
245
+
ui_need_stdlib;
242
246
} in
243
247
Compilenv.write_unit_info pkg_infos cmxfile
244
248
+3
asmcomp/cmm_helpers.ml
+3
asmcomp/cmm_helpers.ml
+3
asmcomp/cmm_helpers.mli
+3
asmcomp/cmm_helpers.mli
···
628
628
(** Generate data for a predefined exception *)
629
629
val predef_exception: int -> string -> phrase
630
630
631
+
(** Generate data for a global string constant *)
632
+
val emit_global_string_constant: string -> string -> phrase
633
+
631
634
val plugin_header: (Cmx_format.unit_infos * Digest.BLAKE128.t) list -> phrase
632
635
633
636
(** Emit constant symbols *)
+2
-1
bytecomp/bytegen.ml
+2
-1
bytecomp/bytegen.ml
···
439
439
| Ostype_unix -> "ostype_unix"
440
440
| Ostype_win32 -> "ostype_win32"
441
441
| Ostype_cygwin -> "ostype_cygwin"
442
-
| Backend_type -> "backend_type" in
442
+
| Backend_type -> "backend_type"
443
+
| Standard_library_default -> "standard_library_default" in
443
444
Kccall(Printf.sprintf "caml_sys_const_%s" const_name, 1)
444
445
| Pisint -> Kisint
445
446
| Pisout -> Kisout
+77
-27
bytecomp/bytelink.ml
+77
-27
bytecomp/bytelink.ml
···
19
19
open Config
20
20
open Cmo_format
21
21
22
+
module String = Misc.Stdlib.String
22
23
module Compunit = Symtable.Compunit
23
24
24
25
module Dep = struct
···
201
202
202
203
(* Link in a compilation unit *)
203
204
204
-
let link_compunit output_fun currpos_fun inchan file_name compunit =
205
+
let link_compunit accu output_fun currpos_fun inchan file_name compunit =
205
206
check_consistency file_name compunit;
206
207
seek_in inchan compunit.cu_pos;
207
208
let code_block =
···
227
228
debug_info := (currpos_fun(), debug_event_list, debug_dirs) :: !debug_info
228
229
end;
229
230
output_fun code_block;
230
-
if !Clflags.link_everything then
231
-
List.iter Symtable.require_primitive compunit.cu_primitives
231
+
let fold_primitive needs_stdlib name =
232
+
if !Clflags.link_everything then
233
+
Symtable.require_primitive name;
234
+
(needs_stdlib || name = "%standard_library_default")
235
+
in
236
+
List.fold_left fold_primitive accu compunit.cu_primitives
232
237
233
238
(* Link in a .cmo file *)
234
239
235
-
let link_object output_fun currpos_fun file_name compunit =
236
-
let inchan = open_in_bin file_name in
237
-
try
238
-
link_compunit output_fun currpos_fun inchan file_name compunit;
239
-
close_in inchan
240
-
with
241
-
Symtable.Error msg ->
242
-
close_in inchan; raise(Error(Symbol_error(file_name, msg)))
243
-
| x ->
244
-
close_in inchan; raise x
240
+
let link_object accu output_fun currpos_fun file_name compunit =
241
+
In_channel.with_open_bin file_name @@ fun inchan ->
242
+
try link_compunit accu output_fun currpos_fun inchan file_name compunit
243
+
with Symtable.Error msg -> raise(Error(Symbol_error(file_name, msg)))
245
244
246
245
(* Link in a .cma file *)
247
246
248
-
let link_archive output_fun currpos_fun file_name units_required =
249
-
let inchan = open_in_bin file_name in
250
-
try
251
-
List.iter
252
-
(fun cu ->
247
+
let link_archive accu output_fun currpos_fun file_name units_required =
248
+
In_channel.with_open_bin file_name @@ fun inchan ->
249
+
List.fold_left
250
+
(fun accu cu ->
253
251
let n = Compunit.name cu.cu_name in
254
252
let name = file_name ^ "(" ^ n ^ ")" in
255
253
try
256
-
link_compunit output_fun currpos_fun inchan name cu
254
+
link_compunit accu output_fun currpos_fun inchan name cu
257
255
with Symtable.Error msg ->
258
256
raise(Error(Symbol_error(name, msg))))
259
-
units_required;
260
-
close_in inchan
261
-
with x -> close_in inchan; raise x
257
+
accu units_required
262
258
263
259
(* Link in a .cmo or .cma file *)
264
260
265
-
let link_file output_fun currpos_fun = function
261
+
let link_file output_fun currpos_fun accu = function
266
262
Link_object(file_name, unit) ->
267
-
link_object output_fun currpos_fun file_name unit
263
+
link_object accu output_fun currpos_fun file_name unit
268
264
| Link_archive(file_name, units) ->
269
-
link_archive output_fun currpos_fun file_name units
265
+
link_archive accu output_fun currpos_fun file_name units
266
+
267
+
let link_files output_fun currpos_fun =
268
+
List.fold_left (link_file output_fun currpos_fun) false
270
269
271
270
(* Output the debugging information *)
272
271
(* Format is:
···
501
500
let output_fun buf =
502
501
Out_channel.output_bigarray outchan buf 0 (Bigarray.Array1.dim buf)
503
502
and currpos_fun () = pos_out outchan - start_code in
504
-
List.iter (link_file output_fun currpos_fun) tolink;
503
+
let needs_stdlib =
504
+
link_files output_fun currpos_fun tolink
505
+
in
505
506
if check_dlls then Dll.close_all_dlls();
506
507
(* The final STOP instruction *)
507
508
output_byte outchan Opcodes.opSTOP;
···
524
525
~filename:final_name ~kind:"bytecode executable"
525
526
outchan (Symtable.initial_global_table());
526
527
Bytesections.record toc_writer DATA;
528
+
(* -custom executables don't need OSLD sections - the correct value is
529
+
already included in the runtime. *)
530
+
if standalone && needs_stdlib then begin
531
+
(* OCaml Standard Library Default location *)
532
+
output_string outchan Config.standard_library_default;
533
+
Bytesections.record toc_writer OSLD
534
+
end;
527
535
(* The map of global identifiers *)
528
536
Symtable.output_global_map outchan;
529
537
Bytesections.record toc_writer SYMB;
···
595
603
Bytesections.write_toc_and_trailer toc_writer;
596
604
)
597
605
606
+
(* [c_string_literal_of_string s] returns the C literal string representation of
607
+
[s], suitable for embedding in a C source file with type [char_os *]. The
608
+
result includes the quote markers. *)
609
+
let c_string_literal_of_string s =
610
+
let b = Buffer.create (String.length s * 2) in
611
+
let utf16le = Bytes.create 4 in
612
+
let escape u =
613
+
match Uchar.to_int u with
614
+
(* Characters with C escape sequences *)
615
+
| 000 (* '\0' *) -> Buffer.add_string b "\\000"
616
+
| 009 (* '\t' *) -> Buffer.add_string b "\\t"
617
+
| 010 (* '\n' *) -> Buffer.add_string b "\\n"
618
+
| 013 (* '\r' *) -> Buffer.add_string b "\\r"
619
+
| 034 (* '\"' *) -> Buffer.add_string b "\\\""
620
+
| 092 (* '\\' *) -> Buffer.add_string b "\\\\"
621
+
(* Most C compilers will have no problem processing UTF-8 in the strings
622
+
with the characters above converted to their C representations. On
623
+
Windows, where the string is [wchar_t *], all characters for which
624
+
iswprint returns 0 are escaped using the extended [\x] notation. *)
625
+
| c when Config.target_win32 && (c < 32 (* ' ' *) || c >= 127) ->
626
+
(* Convert u to UTF-16LE, allowing for surrogate pairs *)
627
+
let len = Bytes.set_utf_16le_uchar utf16le 0 u in
628
+
for i = 1 to len / 2 do
629
+
Printf.bprintf b "\\x%04x" (Bytes.get_uint16_le utf16le ((i - 1) * 2))
630
+
done
631
+
| _ ->
632
+
Buffer.add_utf_8_uchar b u
633
+
in
634
+
if Config.target_win32 then
635
+
Buffer.add_char b 'L';
636
+
Buffer.add_char b '"';
637
+
Seq.iter escape (String.to_utf_8_seq s);
638
+
Buffer.add_char b '"';
639
+
Buffer.contents b
640
+
641
+
let emit_runtime_standard_library_default outchan =
642
+
let literal = c_string_literal_of_string Config.standard_library_default in
643
+
Printf.fprintf outchan
644
+
"const char_os * caml_runtime_standard_library_default = %s;\n" literal
645
+
598
646
(* Output a bytecode executable as a C file *)
599
647
600
648
let link_bytecode_as_c tolink outfile with_main =
···
629
677
output_code_string outchan code;
630
678
currpos := !currpos + (Bigarray.Array1.dim code)
631
679
and currpos_fun () = !currpos in
632
-
List.iter (link_file output_fun currpos_fun) tolink;
680
+
ignore (link_files output_fun currpos_fun tolink);
633
681
(* The final STOP instruction *)
634
682
Printf.fprintf outchan "\n0x%x};\n" Opcodes.opSTOP;
635
683
(* The table of global data *)
···
657
705
};
658
706
659
707
|};
708
+
emit_runtime_standard_library_default outchan;
660
709
(* The table of primitives *)
661
710
Symtable.output_primitive_table outchan;
662
711
(* The entry point *)
···
815
864
816
865
|};
817
866
Symtable.output_primitive_table poc;
867
+
emit_runtime_standard_library_default poc;
818
868
output_string poc {|
819
869
#ifdef __cplusplus
820
870
}
+3
bytecomp/bytesections.ml
+3
bytecomp/bytesections.ml
···
26
26
| DBUG (** debug info *)
27
27
| DLLS (** dll names *)
28
28
| DLPT (** dll paths *)
29
+
| OSLD (** OCaml Standard Library Default location *)
29
30
| PRIM (** primitives names *)
30
31
| RNTM (** The path to the bytecode interpreter (use_runtime mode) *)
31
32
| SYMB (** global identifiers *)
···
37
38
| "DLPT" -> DLPT
38
39
| "DLLS" -> DLLS
39
40
| "DATA" -> DATA
41
+
| "OSLD" -> OSLD
40
42
| "PRIM" -> PRIM
41
43
| "SYMB" -> SYMB
42
44
| "DBUG" -> DBUG
···
52
54
| DLPT -> "DLPT"
53
55
| DLLS -> "DLLS"
54
56
| DATA -> "DATA"
57
+
| OSLD -> "OSLD"
55
58
| PRIM -> "PRIM"
56
59
| SYMB -> "SYMB"
57
60
| DBUG -> "DBUG"
+1
bytecomp/bytesections.mli
+1
bytecomp/bytesections.mli
···
27
27
| DBUG (** debug info *)
28
28
| DLLS (** dll names *)
29
29
| DLPT (** dll paths *)
30
+
| OSLD (** OCaml Standard Library Default location *)
30
31
| PRIM (** primitives names *)
31
32
| RNTM (** The path to the bytecode interpreter (use_runtime mode) *)
32
33
| SYMB (** global identifiers *)
+2
-1
file_formats/cmx_format.mli
+2
-1
file_formats/cmx_format.mli
···
46
46
mutable ui_send_fun: int list; (* Send functions needed *)
47
47
mutable ui_export_info: export_info;
48
48
mutable ui_force_link: bool; (* Always linked *)
49
-
mutable ui_for_pack: string option } (* Part of a pack *)
49
+
mutable ui_for_pack: string option; (* Part of a pack *)
50
+
mutable ui_need_stdlib: bool} (* caml_standard_library_nat needed *)
50
51
51
52
(* Each .a library has a matching .cmxa file that provides the following
52
53
infos on the library: *)
+1
lambda/lambda.ml
+1
lambda/lambda.ml
+1
lambda/lambda.mli
+1
lambda/lambda.mli
+2
-1
lambda/printlambda.ml
+2
-1
lambda/printlambda.ml
···
269
269
| Ostype_unix -> "ostype_unix"
270
270
| Ostype_win32 -> "ostype_win32"
271
271
| Ostype_cygwin -> "ostype_cygwin"
272
-
| Backend_type -> "backend_type" in
272
+
| Backend_type -> "backend_type"
273
+
| Standard_library_default -> "standard_library_default" in
273
274
fprintf ppf "sys.constant_%s" const_name
274
275
| Pisint -> fprintf ppf "isint"
275
276
| Pisout -> fprintf ppf "isout"
+2
lambda/translprim.ml
+2
lambda/translprim.ml
···
167
167
"%ostype_unix", Primitive ((Pctconst Ostype_unix), 1);
168
168
"%ostype_win32", Primitive ((Pctconst Ostype_win32), 1);
169
169
"%ostype_cygwin", Primitive ((Pctconst Ostype_cygwin), 1);
170
+
"%standard_library_default",
171
+
Primitive ((Pctconst Standard_library_default), 1);
170
172
"%frame_pointers", Frame_pointers;
171
173
"%negint", Primitive (Pnegint, 1);
172
174
"%succint", Primitive ((Poffsetint 1), 1);
+25
-16
middle_end/closure/closure.ml
+25
-16
middle_end/closure/closure.ml
···
1056
1056
None ubody),
1057
1057
approx)
1058
1058
(* Compile-time constants *)
1059
-
| Lprim(Pctconst c, [arg], _loc) ->
1060
-
let cst, approx =
1061
-
match c with
1062
-
| Big_endian -> make_const_bool B.big_endian
1063
-
| Word_size -> make_const_int (8*B.size_int)
1064
-
| Int_size -> make_const_int (8*B.size_int - 1)
1065
-
| Max_wosize -> make_const_int ((1 lsl ((8*B.size_int) - 10)) - 1 )
1066
-
| Ostype_unix -> make_const_bool (Config.target_os_type = "Unix")
1067
-
| Ostype_win32 -> make_const_bool (Config.target_os_type = "Win32")
1068
-
| Ostype_cygwin -> make_const_bool (Config.target_os_type = "Cygwin")
1069
-
| Backend_type ->
1070
-
make_const_int 0 (* tag 0 is the same as Native here *)
1059
+
| Lprim(Pctconst c, [arg], loc) ->
1060
+
let cst f v =
1061
+
let cst, approx = f v in
1062
+
let arg, _approx = close env arg in
1063
+
let id = Ident.create_local "dummy" in
1064
+
Ulet(Immutable, Pgenval, VP.create id, arg, cst), approx
1071
1065
in
1072
-
let arg, _approx = close env arg in
1073
-
let id = Ident.create_local "dummy" in
1074
-
Ulet(Immutable, Pgenval, VP.create id, arg, cst), approx
1066
+
begin match c with
1067
+
| Big_endian -> cst make_const_bool B.big_endian
1068
+
| Word_size -> cst make_const_int (8*B.size_int)
1069
+
| Int_size -> cst make_const_int (8*B.size_int - 1)
1070
+
| Max_wosize -> cst make_const_int ((1 lsl ((8*B.size_int) - 10)) - 1)
1071
+
| Ostype_unix -> cst make_const_bool (Config.target_os_type = "Unix")
1072
+
| Ostype_win32 -> cst make_const_bool (Config.target_os_type = "Win32")
1073
+
| Ostype_cygwin -> cst make_const_bool (Config.target_os_type = "Cygwin")
1074
+
| Backend_type ->
1075
+
cst make_const_int 0 (* tag 0 is the same as Native here *)
1076
+
| Standard_library_default ->
1077
+
Compilenv.need_stdlib_location ();
1078
+
let dbg = Debuginfo.from_location loc in
1079
+
let id = Ident.name Compilenv.stdlib_symbol_name in
1080
+
Uprim(P.Pread_symbol id, [], dbg), Value_const (Uconst_ref (id, None))
1081
+
end
1075
1082
| Lprim(Pignore, [arg], _loc) ->
1076
1083
let expr, approx = make_const_int 0 in
1077
1084
Usequence(fst (close env arg), expr), approx
···
1463
1470
| Uconst_ref (s, (Some c)) ->
1464
1471
Compilenv.add_exported_constant s;
1465
1472
structured_constant c
1466
-
| Uconst_ref (_s, None) -> assert false (* Cannot be generated *)
1473
+
| Uconst_ref (s, None) ->
1474
+
(* Only generated in one context *)
1475
+
assert (s = Ident.name Compilenv.stdlib_symbol_name)
1467
1476
| Uconst_int _ -> ()
1468
1477
and structured_constant = function
1469
1478
| Uconst_block (_, ul) -> List.iter const ul
+14
-2
middle_end/compilenv.ml
+14
-2
middle_end/compilenv.ml
···
88
88
ui_send_fun = [];
89
89
ui_force_link = false;
90
90
ui_export_info = default_ui_export_info;
91
-
ui_for_pack = None }
91
+
ui_for_pack = None;
92
+
ui_need_stdlib = false }
92
93
93
94
let linuxlike_mangling = match Config.system with
94
95
| "macosx"
···
131
132
current_unit.ui_send_fun <- [];
132
133
current_unit.ui_force_link <- !Clflags.link_everything;
133
134
current_unit.ui_for_pack <- packname;
135
+
current_unit.ui_need_stdlib <- false;
134
136
Hashtbl.clear exported_constants;
135
137
structured_constants := structured_constants_empty;
136
138
current_unit.ui_export_info <- default_ui_export_info;
···
261
263
| None -> Clambda.Value_unknown
262
264
| Some ui -> get_clambda_approx ui
263
265
266
+
(* The name of the symbol defined globally for %standard_library_default *)
267
+
let stdlib_symbol_name = Ident.create_persistent "caml_standard_library_nat"
268
+
264
269
(* Return the symbol used to refer to a global identifier *)
265
270
266
271
let symbol_for_global id =
267
272
if Ident.is_predef id then
268
273
"caml_exn_" ^ Ident.name id
274
+
else if Ident.same stdlib_symbol_name id then
275
+
Ident.name id
269
276
else begin
270
277
let unitname = Ident.name id in
271
278
match
···
293
300
294
301
let symbol_for_global' id =
295
302
let sym_label = Linkage_name.create (symbol_for_global id) in
296
-
if Ident.is_predef id then
303
+
if Ident.is_predef id || Ident.same stdlib_symbol_name id then
297
304
Symbol.of_global_linkage predefined_exception_compilation_unit sym_label
298
305
else
299
306
Symbol.of_global_linkage (unit_for_global id) sym_label
···
350
357
let need_send_fun n =
351
358
if not (List.mem n current_unit.ui_send_fun) then
352
359
current_unit.ui_send_fun <- n :: current_unit.ui_send_fun
360
+
361
+
(* Record that caml_standard_library_nat is needed *)
362
+
363
+
let need_stdlib_location () =
364
+
current_unit.ui_need_stdlib <- true
353
365
354
366
(* Write the description of the current unit *)
355
367
+8
middle_end/compilenv.mli
+8
middle_end/compilenv.mli
···
108
108
(* Record the need of a currying (resp. application,
109
109
message sending) function with the given arity *)
110
110
111
+
val need_stdlib_location: unit -> unit
112
+
(* Record that caml_standard_library_nat needs to be initialised if this
113
+
unit is linked. *)
114
+
115
+
val stdlib_symbol_name: Ident.t
116
+
(* The name of the symbol defined globally for
117
+
%standard_library_default *)
118
+
111
119
val new_const_symbol : unit -> string
112
120
val closure_symbol : Closure_id.t -> Symbol.t
113
121
(* Symbol of a function if the function is
+23
-19
middle_end/flambda/closure_conversion.ml
+23
-19
middle_end/flambda/closure_conversion.ml
···
384
384
~name:Names.raise)
385
385
| Lprim (Pctconst c, [arg], _loc) ->
386
386
let module Backend = (val t.backend) in
387
-
let const =
388
-
begin match c with
389
-
| Big_endian -> lambda_const_bool Backend.big_endian
390
-
| Word_size -> lambda_const_int (8*Backend.size_int)
391
-
| Int_size -> lambda_const_int (8*Backend.size_int - 1)
392
-
| Max_wosize ->
393
-
lambda_const_int ((1 lsl ((8*Backend.size_int) - 10)) - 1)
394
-
| Ostype_unix ->
395
-
lambda_const_bool (String.equal Config.target_os_type "Unix")
396
-
| Ostype_win32 ->
397
-
lambda_const_bool (String.equal Config.target_os_type "Win32")
398
-
| Ostype_cygwin ->
399
-
lambda_const_bool (String.equal Config.target_os_type "Cygwin")
400
-
| Backend_type ->
401
-
Lambda.const_int 0 (* tag 0 is the same as Native *)
402
-
end
403
-
in
404
-
close t env
405
-
(Lambda.Llet(Strict, Pgenval, Ident.create_local "dummy",
387
+
let cst f v =
388
+
let const = f v in
389
+
close t env (Lambda.Llet(Strict, Pgenval, Ident.create_local "dummy",
406
390
arg, Lconst const))
391
+
in
392
+
begin match c with
393
+
| Big_endian -> cst lambda_const_bool Backend.big_endian
394
+
| Word_size -> cst lambda_const_int (8*Backend.size_int)
395
+
| Int_size -> cst lambda_const_int (8*Backend.size_int - 1)
396
+
| Max_wosize ->
397
+
cst lambda_const_int ((1 lsl ((8*Backend.size_int) - 10)) - 1)
398
+
| Ostype_unix ->
399
+
cst lambda_const_bool (String.equal Config.target_os_type "Unix")
400
+
| Ostype_win32 ->
401
+
cst lambda_const_bool (String.equal Config.target_os_type "Win32")
402
+
| Ostype_cygwin ->
403
+
cst lambda_const_bool (String.equal Config.target_os_type "Cygwin")
404
+
| Backend_type -> cst Lambda.const_int 0 (* tag 0 is the same as Native *)
405
+
| Standard_library_default ->
406
+
Compilenv.need_stdlib_location ();
407
+
let symbol = t.symbol_for_global' Compilenv.stdlib_symbol_name in
408
+
t.imported_symbols <- Symbol.Set.add symbol t.imported_symbols;
409
+
name_expr (Symbol symbol) ~name:Names.pgetglobal
410
+
end
407
411
| Lprim (Pfield _, [Lprim (Pgetglobal id, [],_)], _)
408
412
when Ident.same id t.current_unit_id ->
409
413
Misc.fatal_errorf "[Pfield (Pgetglobal ...)] for the current compilation \
-4
runtime/caml/dynlink.h
-4
runtime/caml/dynlink.h
···
46
46
extern char_os * caml_parse_ld_conf(const char_os * stdlib,
47
47
struct ext_table * table);
48
48
49
-
/* The default location of the Standard Library as used by the runtime to find
50
-
ld.conf */
51
-
extern const char_os *caml_runtime_standard_library_default;
52
-
53
49
#endif /* CAML_INTERNALS */
54
50
55
51
#endif /* CAML_DYNLINK_H */
+4
runtime/caml/startup.h
+4
runtime/caml/startup.h
···
56
56
57
57
extern const enum caml_byte_program_mode caml_byte_program_mode;
58
58
59
+
/* The default location of the Standard Library as used by the runtime to find
60
+
ld.conf */
61
+
extern const char_os *caml_runtime_standard_library_default;
62
+
59
63
#endif /* CAML_INTERNALS */
60
64
61
65
#endif /* CAML_STARTUP_H */
+4
runtime/caml/sys.h
+4
runtime/caml/sys.h
···
35
35
36
36
CAMLnoret CAMLextern void caml_do_exit (int);
37
37
38
+
/* The default location of the Standard Library as used by the
39
+
%standard_library_default primitive */
40
+
extern char_os *caml_standard_library_default;
41
+
38
42
#endif /* CAML_INTERNALS */
39
43
40
44
#endif /* CAML_SYS_H */
-4
runtime/dynlink.c
-4
runtime/dynlink.c
···
58
58
/* The table of shared libraries currently opened */
59
59
static struct ext_table shared_libs;
60
60
61
-
/* The default location of the Standard Library as used by the runtime to find
62
-
ld.conf */
63
-
const char_os *caml_runtime_standard_library_default = OCAML_STDLIB_DIR;
64
-
65
61
/* The search path for shared libraries */
66
62
struct ext_table caml_shared_libs_path;
67
63
+5
-1
runtime/gen_primsc.sh
+5
-1
runtime/gen_primsc.sh
···
32
32
#include "caml/mlvalues.h"
33
33
#include "caml/prims.h"
34
34
#include "caml/startup.h"
35
+
#include "build_config.h"
35
36
36
37
EOF
37
38
···
63
64
sed -e 's/.*/ "&",/' "$primitives"
64
65
echo ' 0 };'
65
66
66
-
# ocamlrun is able to use any of the mechanisms to load the bytecode
67
+
# ocamlrun values for symbols which are provided by the bytecode linker
68
+
# - ocamlrun is able to use any of the mechanisms to load the bytecode
69
+
# - caml_runtime_standard_library_default for bytecode images on this runtime
67
70
cat <<'EOF'
68
71
69
72
const enum caml_byte_program_mode caml_byte_program_mode = STANDARD;
73
+
const char_os *caml_runtime_standard_library_default = OCAML_STDLIB_DIR;
70
74
EOF
+10
runtime/startup_byt.c
+10
runtime/startup_byt.c
···
575
575
req_prims = read_section(fd, &trail, "PRIM");
576
576
if (req_prims == NULL) caml_fatal_error("no PRIM section");
577
577
caml_build_primitive_table(shared_lib_path, shared_libs, req_prims);
578
+
/* Load the embedded overridden caml_standard_library_default value, if one is
579
+
available. Note that although -custom executables come through this
580
+
mechanism, they don't define OSLD sections because
581
+
caml_runtime_standard_library_default and caml_standard_library_default are
582
+
fundamentally equal and caml_runtime_standard_library_default is set when
583
+
the -custom executable is linked. */
584
+
char_os *image_standard_library_default =
585
+
read_section_to_os(fd, &trail, "OSLD");
586
+
if (image_standard_library_default != NULL)
587
+
caml_standard_library_default = image_standard_library_default;
578
588
caml_stat_free(shared_lib_path);
579
589
caml_stat_free(shared_libs);
580
590
caml_stat_free(req_prims);
+18
runtime/sys.c
+18
runtime/sys.c
···
736
736
{
737
737
return Val_int(1); /* Bytecode backed */
738
738
}
739
+
740
+
/* The native code linker doesn't synthesise calls to this primitive, instead
741
+
putting the required string statically in caml_standard_library_nat if any of
742
+
the compilation units use %standard_library_default. The primitive is omitted
743
+
completely in libasmrun as there are no other existing instances in the
744
+
native runtime where OCAML_STDLIB_DIR ends up being embedded. */
745
+
#ifndef NATIVE_CODE
746
+
/* If this remains unset then caml_runtime_standard_library_default is used */
747
+
char_os *caml_standard_library_default = NULL;
748
+
749
+
CAMLprim value caml_sys_const_standard_library_default(value unit)
750
+
{
751
+
return caml_copy_string_of_os(
752
+
caml_standard_library_default ? caml_standard_library_default
753
+
: caml_runtime_standard_library_default);
754
+
}
755
+
#endif
756
+
739
757
CAMLprim value caml_sys_get_config(value unit)
740
758
{
741
759
CAMLparam0 (); /* unit is unused */
+2
-15
testsuite/tools/testRelocation.ml
+2
-15
testsuite/tools/testRelocation.ml
···
185
185
not (is_ocaml || String.starts_with ~prefix:"flexdll_" basename) in
186
186
(~stdlib:false, ~ocaml_debug:false, ~c_debug, ~s:is_ocaml)
187
187
else if ext = Config.ext_lib || ext = Config.ext_dll then
188
-
(* Based on the filename, is this one of the bytecode runtime libraries
189
-
(libcamlrun.a, libcamlrund.a, libcamlrun_shared.so, etc.
190
-
Note that these properties are _not_ used for libasmrun* (see
191
-
below) *)
192
-
let is_camlrun =
193
-
let dir = Filename.basename (Filename.dirname file) in
194
-
dir <> "stublibs"
195
-
&& String.starts_with ~prefix:"libcamlrun" basename
196
-
&& not (String.starts_with ~prefix:"libcamlruntime" basename)
197
-
in
198
188
if ext = Config.ext_lib then
199
189
(* Any archive produced by ocamlopt will have a .cmxa file with it *)
200
190
let is_ocaml =
201
191
Sys.file_exists (Filename.remove_extension file ^ ".cmxa") in
202
192
(* Config.standard_library is in ocamlcommon and the bytecode runtime
203
193
embeds the Standard Library location *)
204
-
let stdlib =
205
-
is_camlrun
206
-
|| Filename.remove_extension basename = "ocamlcommon"
207
-
in
194
+
let stdlib = Filename.remove_extension basename = "ocamlcommon" in
208
195
(~stdlib, ~ocaml_debug:false, ~c_debug:(not is_ocaml), ~s:is_ocaml)
209
196
else
210
197
(* DLLs are either the shared versions of the runtime libraries or
211
198
C stubs. All of these are compiled with -g *)
212
-
(~stdlib:is_camlrun, ~ocaml_debug:false, ~c_debug:true, ~s:false)
199
+
(~stdlib:false, ~ocaml_debug:false, ~c_debug:true, ~s:false)
213
200
else
214
201
(~stdlib:false, ~ocaml_debug:false, ~c_debug:false, ~s:false)
215
202
in
+13
-4
tools/objinfo.ml
+13
-4
tools/objinfo.ml
···
35
35
36
36
module Magic_number = Misc.Magic_number
37
37
38
+
let yesno_of_bool oc b = output_string oc (if b then "YES" else "no")
39
+
38
40
let dummy_crc = String.make 32 '-'
39
41
let null_crc = String.make 32 '0'
40
42
···
67
69
printf "YES\n";
68
70
printf "Primitives declared in this module:\n";
69
71
List.iter print_line l);
70
-
printf "Force link: %s\n" (if cu.cu_force_link then "YES" else "no")
72
+
printf "Force link: %a\n" yesno_of_bool cu.cu_force_link
71
73
72
74
let print_spaced_string s =
73
75
printf " %s" s
74
76
75
77
let print_cma_infos (lib : Cmo_format.library) =
76
-
printf "Force custom: %s\n" (if lib.lib_custom then "YES" else "no");
78
+
printf "Force custom: %a\n" yesno_of_bool lib.lib_custom;
77
79
printf "Extra C object files:";
78
80
(* PR#4949: print in linking order *)
79
81
List.iter print_spaced_string (List.rev lib.lib_ccobjs);
···
249
251
printf "Currying functions:%a\n" pr_funs ui.ui_curry_fun;
250
252
printf "Apply functions:%a\n" pr_funs ui.ui_apply_fun;
251
253
printf "Send functions:%a\n" pr_funs ui.ui_send_fun;
252
-
printf "Force link: %s\n" (if ui.ui_force_link then "YES" else "no");
254
+
printf "Force link: %a\n" yesno_of_bool ui.ui_force_link;
253
255
printf "For pack: %s\n"
254
256
(match ui.ui_for_pack with
255
257
| None -> "no"
256
-
| Some pack -> "YES: " ^ pack)
258
+
| Some pack -> "YES: " ^ pack);
259
+
printf
260
+
"Requires caml_standard_library_nat: %a\n" yesno_of_bool ui.ui_need_stdlib
257
261
258
262
let print_cmxa_infos (lib : Cmx_format.library_infos) =
259
263
printf "Extra C object files:";
···
317
321
| SYMB ->
318
322
let symb = Bytesections.read_section_struct toc ic section in
319
323
print_global_table symb
324
+
| OSLD ->
325
+
let caml_standard_library_default =
326
+
Bytesections.read_section_string toc ic section in
327
+
printf "caml_standard_library_default: %s\n"
328
+
caml_standard_library_default
320
329
| _ -> ()
321
330
with _ -> ()
322
331
)
+9
-4
utils/config.common.ml.in
+9
-4
utils/config.common.ml.in
···
57
57
let max_young_wosize = 256
58
58
let stack_threshold = 32 (* see runtime/caml/config.h *)
59
59
let stack_safety_margin = 6
60
+
let target_unix = (target_os_type = "Unix")
61
+
let target_win32 = (target_os_type = "Win32")
62
+
let target_cygwin = (target_os_type = "Cygwin")
60
63
let default_executable_name =
61
-
match target_os_type with
62
-
"Unix" -> "a.out"
63
-
| "Win32" | "Cygwin" -> "camlprog.exe"
64
-
| _ -> "camlprog"
64
+
if target_unix then
65
+
"a.out"
66
+
else if target_win32 || target_cygwin then
67
+
"camlprog.exe"
68
+
else
69
+
"camlprog"
65
70
type configuration_value =
66
71
| String of string
67
72
| Int of int
+18
-1
utils/config.mli
+18
-1
utils/config.mli
···
207
207
(** Operating system targeted by the native-code compiler. One of
208
208
- ["Unix"] (for all Unix versions, including Linux and macOS),
209
209
- ["Win32"] (for MS-Windows, OCaml compiled with MSVC++ or MinGW-w64),
210
-
- ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin). *)
210
+
- ["Cygwin"] (for MS-Windows, OCaml compiled with Cygwin).
211
+
212
+
@since 5.4 *)
213
+
214
+
val target_unix: bool
215
+
(** True if [target_os_type = "Unix"]
216
+
217
+
@since 5.5 *)
218
+
219
+
val target_win32: bool
220
+
(** True if [target_os_type = "Win32"]
221
+
222
+
@since 5.5 *)
223
+
224
+
val target_cygwin: bool
225
+
(** True if [target_os_type = "Cygwin"]
226
+
227
+
@since 5.5 *)
211
228
212
229
val asm: string
213
230
(** The assembler (and flags) to use for assembling