summaryrefslogtreecommitdiffstats
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rwxr-xr-xstdlib/Compflags5
-rwxr-xr-xstdlib/Makefile.shared13
-rw-r--r--stdlib/arg.mli4
-rw-r--r--stdlib/callback.ml4
-rw-r--r--stdlib/camlinternalOO.ml17
-rw-r--r--stdlib/pervasives.ml13
-rw-r--r--stdlib/pervasives.mli5
-rw-r--r--stdlib/printexc.ml22
-rw-r--r--stdlib/printexc.mli26
9 files changed, 78 insertions, 31 deletions
diff --git a/stdlib/Compflags b/stdlib/Compflags
index 707487fd0..d0938af89 100755
--- a/stdlib/Compflags
+++ b/stdlib/Compflags
@@ -20,9 +20,6 @@ case $1 in
# make sure add_char is inlined (PR#5872)
buffer.cm[io]|printf.cm[io]|format.cm[io]|scanf.cm[io]) echo ' -w A';;
scanf.cmx|scanf.p.cmx) echo ' -inline 9';;
- arrayLabels.cm[ox]|arrayLabels.p.cmx) echo ' -nolabels';;
- listLabels.cm[ox]|listLabels.p.cmx) echo ' -nolabels';;
- stringLabels.cm[ox]|stringLabels.p.cmx) echo ' -nolabels';;
- moreLabels.cm[ox]|moreLabels.p.cmx) echo ' -nolabels';;
+ *Labels.cm[ox]|*Labels.p.cmx) echo ' -nolabels -trans-mod';;
*) echo ' ';;
esac
diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared
index bb2ef88fd..e9d5940a9 100755
--- a/stdlib/Makefile.shared
+++ b/stdlib/Makefile.shared
@@ -12,9 +12,12 @@
#########################################################################
include ../config/Makefile
-CAMLC=$(CAMLC_BIN)
+RUNTIME=../boot/ocamlrun
+COMPILER=../ocamlc
+CAMLC=$(RUNTIME) $(COMPILER)
COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -nostdlib
-CAMLOPT=$(CAMLOPT_BIN)
+OPTCOMPILER=../ocamlopt
+CAMLOPT=$(RUNTIME) $(OPTCOMPILER)
OPTCOMPFLAGS=-warn-error A -nostdlib -g
CAMLDEP=../boot/ocamlrun ../tools/ocamldep
@@ -75,6 +78,12 @@ clean::
.ml.p.cmx:
$(CAMLOPT) $(OPTCOMPFLAGS) `./Compflags $@` -p -c -o $*.p.cmx $<
+# Dependencies on the compiler
+$(OBJS) std_exit.cmo: $(COMPILER)
+$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER)
+$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
+$(OBJS:.cmo=.p.cmx) std_exit.p.cmx: $(OPTCOMPILER)
+
# Dependencies on Pervasives (not tracked by ocamldep)
$(OBJS) std_exit.cmo: pervasives.cmi
$(OTHERS:.cmo=.cmi) std_exit.cmi: pervasives.cmi
diff --git a/stdlib/arg.mli b/stdlib/arg.mli
index 869d030e2..e6e07316d 100644
--- a/stdlib/arg.mli
+++ b/stdlib/arg.mli
@@ -94,7 +94,7 @@ val parse :
*)
val parse_dynamic :
- (string * spec * string) list ref -> anon_fun -> string -> unit
+ (key * spec * doc) list ref -> anon_fun -> string -> unit
(** Same as {!Arg.parse}, except that the [speclist] argument is a reference
and may be updated during the parsing. A typical use for this feature
is to parse command lines of the form:
@@ -116,7 +116,7 @@ val parse_argv : ?current: int ref -> string array ->
*)
val parse_argv_dynamic : ?current:int ref -> string array ->
- (string * spec * string) list ref -> anon_fun -> string -> unit
+ (key * spec * doc) list ref -> anon_fun -> string -> unit
(** Same as {!Arg.parse_argv}, except that the [speclist] argument is a
reference and may be updated during the parsing.
See {!Arg.parse_dynamic}.
diff --git a/stdlib/callback.ml b/stdlib/callback.ml
index 34e7304f7..6e4f9481e 100644
--- a/stdlib/callback.ml
+++ b/stdlib/callback.ml
@@ -20,4 +20,6 @@ let register name v =
register_named_value name (Obj.repr v)
let register_exception name (exn : exn) =
- register_named_value name (Obj.field (Obj.repr exn) 0)
+ let exn = Obj.repr exn in
+ let slot = if Obj.tag exn = Obj.object_tag then exn else Obj.field exn 0 in
+ register_named_value name slot
diff --git a/stdlib/camlinternalOO.ml b/stdlib/camlinternalOO.ml
index 78e02fd4d..c08509666 100644
--- a/stdlib/camlinternalOO.ml
+++ b/stdlib/camlinternalOO.ml
@@ -15,20 +15,13 @@ open Obj
(**** Object representation ****)
-let last_id = ref 0
-let () = Callback.register "CamlinternalOO.last_id" last_id
-
-let set_id o id =
- let id0 = !id in
- Array.unsafe_set (Obj.magic o : int array) 1 id0;
- id := id0 + 1
+external set_id: 'a -> 'a = "caml_set_oo_id" "noalloc"
(**** Object copy ****)
let copy o =
let o = (Obj.obj (Obj.dup (Obj.repr o))) in
- set_id o last_id;
- o
+ set_id o
(**** Compression options ****)
(* Parameters *)
@@ -359,8 +352,7 @@ let create_object table =
let obj = Obj.new_block Obj.object_tag table.size in
(* XXX Appel de [caml_modify] *)
Obj.set_field obj 0 (Obj.repr table.methods);
- set_id obj last_id;
- (Obj.obj obj)
+ Obj.obj (set_id obj)
let create_object_opt obj_0 table =
if (Obj.magic obj_0 : bool) then obj_0 else begin
@@ -368,8 +360,7 @@ let create_object_opt obj_0 table =
let obj = Obj.new_block Obj.object_tag table.size in
(* XXX Appel de [caml_modify] *)
Obj.set_field obj 0 (Obj.repr table.methods);
- set_id obj last_id;
- (Obj.obj obj)
+ Obj.obj (set_id obj)
end
let rec iter_f obj =
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
index 61fab1e0f..43e23cc52 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
@@ -15,7 +15,17 @@
(* Exceptions *)
+external register_named_value : string -> 'a -> unit
+ = "caml_register_named_value"
+
+let () =
+ (* for asmrun/fail.c *)
+ register_named_value "Pervasives.array_bound_error"
+ (Invalid_argument "index out of bounds")
+
+
external raise : exn -> 'a = "%raise"
+external raise_notrace : exn -> 'a = "%raise_notrace"
let failwith s = raise(Failure s)
let invalid_arg s = raise(Invalid_argument s)
@@ -454,7 +464,4 @@ let exit retcode =
do_at_exit ();
sys_exit retcode
-external register_named_value : string -> 'a -> unit
- = "caml_register_named_value"
-
let _ = register_named_value "Pervasives.do_at_exit" do_at_exit
diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli
index bab296a46..0a2e4af6a 100644
--- a/stdlib/pervasives.mli
+++ b/stdlib/pervasives.mli
@@ -28,6 +28,11 @@
external raise : exn -> 'a = "%raise"
(** Raise the given exception value *)
+external raise_notrace : exn -> 'a = "%raise_notrace"
+(** A faster version [raise] which does not record the backtrace.
+ @since 4.02.0
+*)
+
val invalid_arg : string -> 'a
(** Raise exception [Invalid_argument] with the given string. *)
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index 3324f6c4f..9f20c7b46 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -58,9 +58,12 @@ let to_string x =
sprintf locfmt file line char (char+6) "Undefined recursive module"
| _ ->
let x = Obj.repr x in
- let constructor =
- (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
- constructor ^ (fields x) in
+ if Obj.tag x <> 0 then
+ (Obj.magic (Obj.field x 0) : string)
+ else
+ let constructor =
+ (Obj.magic (Obj.field (Obj.field x 0) 0) : string) in
+ constructor ^ (fields x) in
conv !printers
let print fct arg =
@@ -168,3 +171,16 @@ let register_printer fn =
external get_callstack: int -> raw_backtrace = "caml_get_current_callstack"
+
+
+let exn_slot x =
+ let x = Obj.repr x in
+ if Obj.tag x = 0 then Obj.field x 0 else x
+
+let exn_slot_id x =
+ let slot = exn_slot x in
+ (Obj.obj (Obj.field slot 1) : int)
+
+let exn_slot_name x =
+ let slot = exn_slot x in
+ (Obj.obj (Obj.field slot 0) : string)
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index 773fed814..c378d9cb3 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -91,9 +91,9 @@ type raw_backtrace
a low-level format, instead of directly exposing them as string as
the [get_backtrace()] function does.
- This allows to pay the performance overhead of representation
- conversion and formatting only at printing time, which is useful
- if you want to record more backtrace than you actually print.
+ This allows delaying the formatting of backtraces to when they are
+ actually printed, which might be useful if you record more
+ backtraces than you print.
*)
val get_raw_backtrace: unit -> raw_backtrace
@@ -112,3 +112,23 @@ val get_callstack: int -> raw_backtrace
@since 4.01.0
*)
+
+
+(** {6 Exception slots} *)
+
+val exn_slot_id: exn -> int
+(** [Printexc.exn_slot_id] returns an integer which uniquely identifies
+ the constructor used to create the exception value [exn]
+ (in the current runtime).
+
+ @since 4.02.0
+*)
+
+val exn_slot_name: exn -> string
+(** [Printexc.exn_slot_id exn] returns the internal name of the constructor
+ used to create the exception value [exn].
+
+ @since 4.02.0
+*)
+
+
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-21 04:00:33 +0000