The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #2279 from stedolan/deprecate-obj-truncate
Deprecate Obj.truncate.
authored by
Xavier Leroy
and committed by
GitHub
36d299b4
e350ebd7
+83
-56
+2
-2
Changes
+2
-2
Changes
···
100
100
101
101
### Runtime system:
102
102
103
-
- #1725: Deprecate Obj.set_tag
104
-
(Stephen Dolan, review by Gabriel Scherer and Damien Doligez)
103
+
- #1725, #2279: Deprecate Obj.set_tag and Obj.truncate
104
+
(Stephen Dolan, review by Gabriel Scherer, Damien Doligez and Xavier Leroy)
105
105
106
106
* #2240: Constify "identifier" in struct custom_operations
107
107
(Cedric Cellier, review by Xavier Leroy)
boot/ocamlc
boot/ocamlc
This is a binary file and will not be displayed.
boot/ocamllex
boot/ocamllex
This is a binary file and will not be displayed.
+6
bytecomp/translprim.ml
+6
bytecomp/translprim.ml
···
104
104
let gen_array_kind =
105
105
if Config.flat_float_array then Pgenarray else Paddrarray
106
106
107
+
let prim_sys_argv =
108
+
Primitive.simple ~name:"caml_sys_argv" ~arity:1 ~alloc:true
109
+
107
110
let primitives_table =
108
111
create_hashtable 57 [
109
112
"%identity", Primitive (Pidentity, 1);
···
341
344
"%bswap_native", Primitive ((Pbbswap(Pnativeint)), 1);
342
345
"%int_as_pointer", Primitive (Pint_as_pointer, 1);
343
346
"%opaque", Primitive (Popaque, 1);
347
+
"%sys_argv", External prim_sys_argv;
344
348
"%send", Send;
345
349
"%sendself", Send_self;
346
350
"%sendcache", Send_cache;
···
647
651
match prim, args with
648
652
| Primitive (prim, arity), args when arity = List.length args ->
649
653
Lprim(prim, args, loc)
654
+
| External prim, args when prim = prim_sys_argv ->
655
+
Lprim(Pccall prim, Lconst (Const_pointer 0) :: args, loc)
650
656
| External prim, args ->
651
657
Lprim(Pccall prim, args, loc)
652
658
| Comparison(comp, knd), ([_;_] as args) ->
+22
-7
runtime/sys.c
+22
-7
runtime/sys.c
···
371
371
}
372
372
373
373
char_os * caml_exe_name;
374
-
char_os ** caml_main_argv;
374
+
static value main_argv;
375
375
376
376
CAMLprim value caml_sys_get_argv(value unit)
377
377
{
378
378
CAMLparam0 (); /* unit is unused */
379
-
CAMLlocal3 (exe_name, argv, res);
379
+
CAMLlocal2 (exe_name, res);
380
380
exe_name = caml_copy_string_of_os(caml_exe_name);
381
-
argv =
382
-
caml_alloc_array((void *)caml_copy_string_of_os,
383
-
(char const **) caml_main_argv);
384
381
res = caml_alloc_small(2, 0);
385
382
Field(res, 0) = exe_name;
386
-
Field(res, 1) = argv;
383
+
Field(res, 1) = main_argv;
387
384
CAMLreturn(res);
388
385
}
389
386
387
+
CAMLprim value caml_sys_argv(value unit)
388
+
{
389
+
return main_argv;
390
+
}
391
+
392
+
CAMLprim value caml_sys_modify_argv(value new_argv)
393
+
{
394
+
caml_modify_generational_global_root(&main_argv, new_argv);
395
+
return Val_unit;
396
+
}
397
+
398
+
CAMLprim value caml_sys_executable_name(value unit)
399
+
{
400
+
return caml_copy_string_of_os(caml_exe_name);
401
+
}
402
+
390
403
void caml_sys_init(char_os * exe_name, char_os **argv)
391
404
{
392
405
#ifdef _WIN32
···
398
411
#endif
399
412
#endif
400
413
caml_exe_name = exe_name;
401
-
caml_main_argv = argv;
414
+
main_argv = caml_alloc_array((void *)caml_copy_string_of_os,
415
+
(char const **) argv);
416
+
caml_register_generational_global_root(&main_argv);
402
417
}
403
418
404
419
#ifdef _WIN32
+2
stdlib/.depend
+2
stdlib/.depend
···
132
132
camlinternalLazy.cmi
133
133
camlinternalLazy.cmi :
134
134
camlinternalMod.cmo : \
135
+
stdlib__sys.cmi \
135
136
stdlib__obj.cmi \
136
137
camlinternalOO.cmi \
137
138
stdlib__array.cmi \
138
139
camlinternalMod.cmi
139
140
camlinternalMod.cmx : \
141
+
stdlib__sys.cmx \
140
142
stdlib__obj.cmx \
141
143
camlinternalOO.cmx \
142
144
stdlib__array.cmx \
+7
-2
stdlib/camlinternalMod.ml
+7
-2
stdlib/camlinternalMod.ml
···
51
51
let rec update_mod shape o n =
52
52
match shape with
53
53
| Function ->
54
-
if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o
55
-
then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR#4008 *) end
54
+
(* The optimisation below is invalid on bytecode since
55
+
the RESTART instruction checks the length of closures.
56
+
See PR#4008 *)
57
+
if Sys.backend_type = Sys.Native
58
+
&& Obj.tag n = Obj.closure_tag
59
+
&& Obj.size n <= Obj.size o
60
+
then begin overwrite o n end
56
61
else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x))
57
62
| Lazy ->
58
63
if Obj.tag n = Obj.lazy_tag then
+1
stdlib/obj.mli
+1
stdlib/obj.mli
···
63
63
external new_block : int -> int -> t = "caml_obj_block"
64
64
external dup : t -> t = "caml_obj_dup"
65
65
external truncate : t -> int -> unit = "caml_obj_truncate"
66
+
[@@ocaml.deprecated]
66
67
external add_offset : t -> Int32.t -> t = "caml_obj_add_offset"
67
68
(* @since 3.12.0 *)
68
69
external with_tag : int -> t -> t = "caml_obj_with_tag"
+1
-1
stdlib/sys.mli
+1
-1
stdlib/sys.mli
···
20
20
an error.
21
21
*)
22
22
23
-
val argv : string array
23
+
external argv : string array = "%sys_argv"
24
24
(** The command line arguments given to the process.
25
25
The first element is the command name used to invoke the program.
26
26
The following elements are the command-line arguments
+3
-2
stdlib/sys.mlp
+3
-2
stdlib/sys.mlp
···
25
25
(* System interface *)
26
26
27
27
external get_config: unit -> string * int * bool = "caml_sys_get_config"
28
-
external get_argv: unit -> string * string array = "caml_sys_get_argv"
28
+
external get_executable_name : unit -> string = "caml_sys_executable_name"
29
+
external argv : string array = "%sys_argv"
29
30
external big_endian : unit -> bool = "%big_endian"
30
31
external word_size : unit -> int = "%word_size"
31
32
external int_size : unit -> int = "%int_size"
···
35
36
external cygwin : unit -> bool = "%ostype_cygwin"
36
37
external get_backend_type : unit -> backend_type = "%backend_type"
37
38
38
-
let (executable_name, argv) = get_argv()
39
+
let executable_name = get_executable_name()
39
40
let (os_type, _, _) = get_config()
40
41
let backend_type = get_backend_type ()
41
42
let big_endian = big_endian ()
+4
-2
stdlib/weak.ml
+4
-2
stdlib/weak.ml
···
200
200
t.table.(t.rover) <- emptybucket;
201
201
t.hashes.(t.rover) <- [| |];
202
202
end else begin
203
-
Obj.truncate (Obj.repr bucket) (prev_len + additional_values);
204
-
Obj.truncate (Obj.repr hbucket) prev_len;
203
+
let newbucket = weak_create prev_len in
204
+
blit bucket 0 newbucket 0 prev_len;
205
+
t.table.(t.rover) <- newbucket;
206
+
t.hashes.(t.rover) <- Array.sub hbucket 0 prev_len
205
207
end;
206
208
if len > t.limit && prev_len <= t.limit then t.oversize <- t.oversize - 1;
207
209
end;
+2
-1
testsuite/tests/basic-modules/main.ml
+2
-1
testsuite/tests/basic-modules/main.ml
+6
testsuite/tests/basic-modules/pr4008.ml
+6
testsuite/tests/basic-modules/pr4008.ml
+4
-22
testsuite/tests/misc/sorts.ml
+4
-22
testsuite/tests/misc/sorts.ml
···
4164
4164
done;
4165
4165
;;
4166
4166
4167
-
(************************************************************************)
4168
-
(* merge sort on lists via arrays *)
4169
-
4170
-
let array_to_list_in_place a =
4171
-
let l = Array.length a in
4172
-
let rec loop accu n p =
4173
-
if p <= 0 then accu else begin
4174
-
if p = n then begin
4175
-
Obj.truncate (Obj.repr a) p;
4176
-
loop (a.(p-1) :: accu) (n-1000) (p-1)
4177
-
end else begin
4178
-
loop (a.(p-1) :: accu) n (p-1)
4179
-
end
4180
-
end
4181
-
in
4182
-
loop [] l l
4183
-
;;
4184
-
4185
4167
let array_of_list l len =
4186
4168
match l with
4187
4169
| [] -> [| |]
···
4199
4181
let lmerge_0a cmp l =
4200
4182
let a = Array.of_list l in
4201
4183
amerge_1e cmp a;
4202
-
array_to_list_in_place a
4184
+
Array.to_list a
4203
4185
;;
4204
4186
4205
4187
let lmerge_0b cmp l =
···
4207
4189
if len > 256 then Gc.minor ();
4208
4190
let a = array_of_list l len in
4209
4191
amerge_1e cmp a;
4210
-
array_to_list_in_place a
4192
+
Array.to_list a
4211
4193
;;
4212
4194
4213
4195
let lshell_0 cmp l =
4214
4196
let a = Array.of_list l in
4215
4197
ashell_2 cmp a;
4216
-
array_to_list_in_place a
4198
+
Array.to_list a
4217
4199
;;
4218
4200
4219
4201
let lquick_0 cmp l =
4220
4202
let a = Array.of_list l in
4221
4203
aquick_3f cmp a;
4222
-
array_to_list_in_place a
4204
+
Array.to_list a
4223
4205
;;
4224
4206
4225
4207
(************************************************************************)
+1
testsuite/tests/tool-toplevel-invocation/print_args.ml
+1
testsuite/tests/tool-toplevel-invocation/print_args.ml
···
1
+
Array.iter (fun x -> print_endline (Filename.basename x)) Sys.argv;;
+3
testsuite/tests/tool-toplevel-invocation/print_args.reference
+3
testsuite/tests/tool-toplevel-invocation/print_args.reference
+6
testsuite/tests/tool-toplevel-invocation/test.ml
+6
testsuite/tests/tool-toplevel-invocation/test.ml
···
40
40
compiler_output = "${test_build_directory}/working_arg.output"
41
41
*** check-ocaml-output
42
42
43
+
** ocaml
44
+
flags = "${test_source_directory}/print_args.ml foo bar"
45
+
compiler_reference = "${test_source_directory}/print_args.reference"
46
+
compiler_output = "${test_build_directory}/print_args.output"
47
+
*** check-ocaml-output
48
+
43
49
*)
44
50
45
51
printf "Test succeeds\n";;
+7
-11
toplevel/opttoploop.ml
+7
-11
toplevel/opttoploop.ml
···
607
607
| x -> Location.report_exception ppf x; Btype.backtrack snap
608
608
done
609
609
610
-
(* Execute a script. If [name] is "", read the script from stdin. *)
610
+
external caml_sys_modify_argv : string array -> unit =
611
+
"caml_sys_modify_argv"
611
612
612
-
let override_sys_argv args =
613
-
let len = Array.length args in
614
-
if Array.length Sys.argv < len then invalid_arg "Toploop.override_sys_argv";
615
-
Array.blit args 0 Sys.argv 0 len;
616
-
Obj.truncate (Obj.repr Sys.argv) len;
613
+
let override_sys_argv new_argv =
614
+
caml_sys_modify_argv new_argv;
617
615
Arg.current := 0
616
+
617
+
(* Execute a script. If [name] is "", read the script from stdin. *)
618
618
619
619
let run_script ppf name args =
620
-
let len = Array.length args in
621
-
if Array.length Sys.argv < len then invalid_arg "Toploop.run_script";
622
-
Array.blit args 0 Sys.argv 0 len;
623
-
Obj.truncate (Obj.repr Sys.argv) len;
624
-
Arg.current := 0;
620
+
override_sys_argv args;
625
621
Compmisc.init_path ~dir:(Filename.dirname name) ();
626
622
(* Note: would use [Filename.abspath] here, if we had it. *)
627
623
toplevel_env := Compmisc.initial_env();
+6
-6
toplevel/toploop.ml
+6
-6
toplevel/toploop.ml
···
565
565
| x -> Location.report_exception ppf x; Btype.backtrack snap
566
566
done
567
567
568
-
(* Execute a script. If [name] is "", read the script from stdin. *)
568
+
external caml_sys_modify_argv : string array -> unit =
569
+
"caml_sys_modify_argv"
569
570
570
-
let override_sys_argv args =
571
-
let len = Array.length args in
572
-
if Array.length Sys.argv < len then invalid_arg "Toploop.override_sys_argv";
573
-
Array.blit args 0 Sys.argv 0 len;
574
-
Obj.truncate (Obj.repr Sys.argv) len;
571
+
let override_sys_argv new_argv =
572
+
caml_sys_modify_argv new_argv;
575
573
Arg.current := 0
574
+
575
+
(* Execute a script. If [name] is "", read the script from stdin. *)
576
576
577
577
let run_script ppf name args =
578
578
override_sys_argv args;