diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/configure ocamlnet-4.1.9.patched/configure --- configure 2021-03-24 16:20:13 +++ configure 2026-05-29 06:32:02 @@ -615,7 +615,7 @@ ###################################################################### printf "Checking for immutable strings... " -if ocamlc -safe-string >/dev/null 2>/dev/null; then +if true || ocamlc -safe-string >/dev/null 2>/dev/null; then istring=1 echo "yes" else @@ -779,6 +779,18 @@ fi ###################################################################### +# Bigarray + +# Since OCaml-5.0.0 "bigarray" is part of the regular stdlib +v="$(ocamlc -version)" +case "$v" in + [56789]\.*) + true ;; + *) + requires="$requires bigarray" ;; +esac + +###################################################################### # Netsys ( cd src/netsys; ./configure ) @@ -1086,11 +1098,7 @@ may prevent the build\n of the apache module on platforms \ where PIC code differs from non-PIC\n such as x86_64, hppa,..." fi - # at some point libstr.a was renamed to libcamlstr.a - libstr="str" - if [ -f "$apache_ocamllibdir/libcamlstr.a" ]; then - libstr="camlstr" - fi + libstr="camlstr" else enable_apache=0 echo "apxs or apache not found" @@ -1295,7 +1303,7 @@ # For -enable-apache APACHE_MAJOR = $apache_major APACHE_LIBDIR = $apache_libdir -APACHE_OCAMLLIBS = -l$apache_camlrun -ltermcap -lunix -l$libstr +APACHE_OCAMLLIBS = -l$apache_camlrun -ltermcap -lunixbyt -l${libstr}byt APACHE_INCDIR = $apache_incdir APACHE_CONFDIR = $apache_confdir APACHE_LDFLAGS_SHLIB = $apache_ldflags_shlib diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/equeue/unixqueue_select.ml ocamlnet-4.1.9.patched/src/equeue/unixqueue_select.ml --- src/equeue/unixqueue_select.ml 2021-03-24 16:20:14 +++ src/equeue/unixqueue_select.ml 2026-05-29 06:31:43 @@ -35,7 +35,7 @@ module Fdescr = struct type t = Unix.file_descr - let compare (a:t) (b:t) = Pervasives.compare a b + let compare (a:t) (b:t) = compare a b end;; diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/equeue/unixqueue_util.ml ocamlnet-4.1.9.patched/src/equeue/unixqueue_util.ml --- src/equeue/unixqueue_util.ml 2021-03-24 16:20:14 +++ src/equeue/unixqueue_util.ml 2026-05-29 06:31:43 @@ -179,7 +179,7 @@ let fd_cmp = match Sys.os_type with | "Win32" -> - Pervasives.compare + compare | _ -> (fun (fd1:Unix.file_descr) fd2 -> (Obj.magic fd1 : int) - (Obj.magic fd2 : int) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/equeue/uq_engines.ml ocamlnet-4.1.9.patched/src/equeue/uq_engines.ml --- src/equeue/uq_engines.ml 2021-03-24 16:20:14 +++ src/equeue/uq_engines.ml 2026-05-29 06:31:43 @@ -121,7 +121,7 @@ Set.Make (struct type t = int - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = compare x y end ) @@ -593,57 +593,6 @@ e#abort(); self # set_state `Aborted end - - - -class ['a] stream_seq_engine x0 (s : ('a -> 'a #engine) Stream.t) esys = -object(self) - inherit ['a] engine_mixin (`Working 0) esys - - val mutable x = x0 - val mutable cur_e = aborted_engine esys - - initializer - self#next() - - method private next() = - match Stream.peek s with - | None -> - self # set_state (`Done x) - | Some f -> - let _ = Stream.next s in (* yep, it's "partial" *) - let e = - try (f x :> _ engine) - with error -> const_engine (`Error error) esys in - cur_e <- e; - if is_active e#state then - when_state - ~is_done:(fun x1 -> - x <- x1; - Unixqueue.epsilon esys self#next - (* avoids stack overflow *) - ) - ~is_error:(fun e -> self # set_state (`Error e)) - ~is_aborted:(fun () -> self # set_state `Aborted) - ~is_progressing:(fun _ -> self # sseq_count()) - e - else - self # set_state e#state - - method abort() = - cur_e # abort(); - self # set_state `Aborted - - method private sseq_count() = - match self#state with - `Working n -> - self # set_state (`Working (n+1)) - | _ -> - () -end - - -let stream_seq_engine = new stream_seq_engine diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/equeue/uq_engines.mli ocamlnet-4.1.9.patched/src/equeue/uq_engines.mli --- src/equeue/uq_engines.mli 2021-03-24 16:20:14 +++ src/equeue/uq_engines.mli 2026-05-29 06:31:43 @@ -354,25 +354,6 @@ [qseq_engine] should be preferred for recursive chains of engines. *) -class ['a] stream_seq_engine : 'a -> ('a -> 'a #engine) Stream.t -> - Unixqueue.event_system -> ['a] engine - (** [let se = new stream_seq_engine x0 s esys]: The constructed engine [se] - * fetches functions [f : 'a -> 'a #engine] from the stream [s], and - * runs the engines obtained by calling these functions [e = f x] one - * after the other. Each function call gets the result of the previous - * engine as argument. The first call gets [x0] as argument. - * - * If one of the engines [e] transitions into an error or aborted state, - * [se] will also do that. If [se] is aborted, this is passed down to - * the currently running engine [e]. - *) - - -val stream_seq_engine : 'a -> ('a -> 'a #engine) Stream.t -> - Unixqueue.event_system -> 'a engine - (** Same as function *) - - class ['a, 'b] sync_engine : 'a #engine -> 'b #engine -> ['a * 'b] engine (** This engine runs two engines in parallel, and waits until both * are [`Done] (synchronization). The product of the two [`Done] arguments diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/equeue/uq_engines_compat.mli ocamlnet-4.1.9.patched/src/equeue/uq_engines_compat.mli --- src/equeue/uq_engines_compat.mli 2021-03-24 16:20:14 +++ src/equeue/uq_engines_compat.mli 2026-05-29 06:31:43 @@ -105,12 +105,6 @@ class ['a, 'b] qseq_engine : 'a #engine -> ('a -> 'b #engine) -> ['b] engine val qseq_engine : 'a #engine -> ('a -> 'b #engine) -> 'b engine -class ['a] stream_seq_engine : 'a -> ('a -> 'a #engine) Stream.t -> - Unixqueue.event_system -> ['a] engine - -val stream_seq_engine : 'a -> ('a -> 'a #engine) Stream.t -> - Unixqueue.event_system -> 'a engine - class ['a, 'b] sync_engine : 'a #engine -> 'b #engine -> ['a * 'b] engine val sync_engine : 'a #engine -> 'b #engine -> ('a * 'b) engine diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netcgi2-apache/apache.c ocamlnet-4.1.9.patched/src/netcgi2-apache/apache.c --- src/netcgi2-apache/apache.c 2021-03-24 16:20:14 +++ src/netcgi2-apache/apache.c 2026-05-29 06:32:02 @@ -78,9 +78,9 @@ table *t = Table_val (tv); const char *res = apr_table_get(t, String_val (str)); if (res) - CAMLreturn (copy_string (res)); + CAMLreturn (caml_copy_string (res)); else - raise_not_found (); + caml_raise_not_found (); } static int @@ -88,8 +88,8 @@ { CAMLparam0(); CAMLlocal1(cons); /* head cell of new list */ - cons = alloc(2, 0); /* :: */ - Store_field(cons, 0, copy_string(val)); /* value :: */ + cons = caml_alloc(2, 0); /* :: */ + Store_field(cons, 0, caml_copy_string(val)); /* value :: */ Store_field(cons, 1, *((value *) res)); /* :: previous list */ *((value *) res) = cons; CAMLreturn(1); @@ -101,7 +101,7 @@ CAMLparam2(tv, str); CAMLlocal1(res); /* list */ table *t = Table_val(tv); - char *key = String_val(str); + char *key = Bytes_val(str); res = Val_int(0); /* empty list [] */ /* Only iterates over values associated with [key]. */ @@ -116,11 +116,11 @@ { CAMLparam0(); CAMLlocal2(cons, pair); - pair = alloc_tuple(2); /* (,) */ - Store_field(pair, 0, copy_string(key)); - Store_field(pair, 1, copy_string(val)); + pair = caml_alloc_tuple(2); /* (,) */ + Store_field(pair, 0, caml_copy_string(key)); + Store_field(pair, 1, caml_copy_string(val)); /* fprintf(stderr, "(%s, %s)\n", key, val); /\* DEBUG *\/ */ - cons = alloc(2, 0); /* :: */ + cons = caml_alloc(2, 0); /* :: */ Store_field(cons, 0, pair); /* pair :: */ Store_field(cons, 1, *((value *) res)); /* :: list */ *((value *) res) = cons; @@ -176,9 +176,9 @@ CAMLparam1(sv); server_rec *s = Server_rec_val(sv); if (s->server_hostname) - CAMLreturn(copy_string(s->server_hostname)); + CAMLreturn(caml_copy_string(s->server_hostname)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -187,9 +187,9 @@ CAMLparam1(sv); server_rec *s = Server_rec_val(sv); if (s->server_admin) - CAMLreturn(copy_string(s->server_admin)); + CAMLreturn(caml_copy_string(s->server_admin)); else - raise_not_found(); + caml_raise_not_found(); } CAMLprim value @@ -209,9 +209,9 @@ CAMLparam1 (cv); \ conn_rec *c = Conn_rec_val (cv); \ if (c->field) \ - CAMLreturn (copy_string (c->field)); \ + CAMLreturn (caml_copy_string (c->field)); \ else \ - raise_not_found (); \ + caml_raise_not_found (); \ } #if AP_SERVER_MAJORVERSION_NUMBER == 1 @@ -258,7 +258,7 @@ if (rr) CAMLreturn (Val_request_rec (rr)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -269,7 +269,7 @@ if (rr) CAMLreturn (Val_request_rec (rr)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -280,7 +280,7 @@ if (rr) CAMLreturn (Val_request_rec (rr)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -289,9 +289,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->the_request) - CAMLreturn (copy_string (r->the_request)); + CAMLreturn (caml_copy_string (r->the_request)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -316,9 +316,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->protocol) - CAMLreturn (copy_string (r->protocol)); + CAMLreturn (caml_copy_string (r->protocol)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -335,9 +335,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->hostname) - CAMLreturn (copy_string (r->hostname)); + CAMLreturn (caml_copy_string (r->hostname)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -345,7 +345,7 @@ { CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); - CAMLreturn (copy_double ((double) r->request_time)); + CAMLreturn (caml_copy_double ((double) r->request_time)); } CAMLprim value @@ -354,9 +354,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->status_line) - CAMLreturn (copy_string (r->status_line)); + CAMLreturn (caml_copy_string (r->status_line)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -390,7 +390,7 @@ { CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); - CAMLreturn (copy_string (r->method)); + CAMLreturn (caml_copy_string (r->method)); } CAMLprim value @@ -447,9 +447,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->content_type) - CAMLreturn (copy_string (r->content_type)); + CAMLreturn (caml_copy_string (r->content_type)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -468,13 +468,13 @@ request_rec *r = Request_rec_val (rv); #if APACHE2 if (r->user) - CAMLreturn (copy_string (r->user)); + CAMLreturn (caml_copy_string (r->user)); #else if (r->connection->user) - CAMLreturn (copy_string (r->connection->user)); + CAMLreturn (caml_copy_string (r->connection->user)); #endif else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -483,9 +483,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->uri) - CAMLreturn (copy_string (r->uri)); + CAMLreturn (caml_copy_string (r->uri)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -513,9 +513,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->filename) - CAMLreturn (copy_string (r->filename)); + CAMLreturn (caml_copy_string (r->filename)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -533,9 +533,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->path_info) - CAMLreturn (copy_string (r->path_info)); + CAMLreturn (caml_copy_string (r->path_info)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -553,9 +553,9 @@ CAMLparam1 (rv); request_rec *r = Request_rec_val (rv); if (r->args) - CAMLreturn (copy_string (r->args)); + CAMLreturn (caml_copy_string (r->args)); else - raise_not_found (); + caml_raise_not_found (); } CAMLprim value @@ -595,16 +595,16 @@ if (r->finfo.filetype != APR_NOFILE) /* Some statbuf */ { atime = (r->finfo.valid & APR_FINFO_ATIME) ? - copy_double ((double) apr_time_sec (r->finfo.atime)) : - copy_double (0.); + caml_copy_double ((double) apr_time_sec (r->finfo.atime)) : + caml_copy_double (0.); mtime = (r->finfo.valid & APR_FINFO_MTIME) ? - copy_double ((double) apr_time_sec (r->finfo.mtime)) : - copy_double (0.); + caml_copy_double ((double) apr_time_sec (r->finfo.mtime)) : + caml_copy_double (0.); ctime = (r->finfo.valid & APR_FINFO_CTIME) ? - copy_double ((double) apr_time_sec (r->finfo.ctime)) : - copy_double (0.); + caml_copy_double ((double) apr_time_sec (r->finfo.ctime)) : + caml_copy_double (0.); - sb = alloc_small (12, 0); + sb = caml_alloc_small (12, 0); Field (sb, 0) = Val_int (r->finfo.device); Field (sb, 1) = Val_int (r->finfo.inode); Field (sb, 2) = @@ -621,7 +621,7 @@ Field (sb, 10) = mtime; Field (sb, 11) = ctime; - v = alloc (1, 0); /* The "Some" block. */ + v = caml_alloc (1, 0); /* The "Some" block. */ Field (v, 0) = sb; } else @@ -632,11 +632,11 @@ if (r->finfo.st_mode) /* Some statbuf */ { /* This code copied and modified from otherlibs/unix/stat.c. */ - atime = copy_double ((double) r->finfo.st_atime); - mtime = copy_double ((double) r->finfo.st_mtime); - ctime = copy_double ((double) r->finfo.st_ctime); + atime = caml_copy_double ((double) r->finfo.st_atime); + mtime = caml_copy_double ((double) r->finfo.st_mtime); + ctime = caml_copy_double ((double) r->finfo.st_ctime); - sb = alloc_small (12, 0); + sb = caml_alloc_small (12, 0); Field (sb, 0) = Val_int (r->finfo.st_dev); Field (sb, 1) = Val_int (r->finfo.st_ino); Field (sb, 2) = @@ -652,7 +652,7 @@ Field (sb, 10) = mtime; Field (sb, 11) = ctime; - v = alloc (1, 0); /* The "Some" block. */ + v = caml_alloc (1, 0); /* The "Some" block. */ Field (v, 0) = sb; } else @@ -718,8 +718,8 @@ caml_failwith("ap_get_client_block"); } - str = alloc_string (i); - memcpy (String_val (str), buffer, i); + str = caml_alloc_string (i); + memcpy (Bytes_val (str), buffer, i); CAMLreturn (str); } @@ -734,7 +734,7 @@ int len = Int_val(lenv); int i; - i = ap_get_client_block (r, String_val(bufv) + ofs, len); + i = ap_get_client_block (r, Bytes_val(bufv) + ofs, len); /* Error dealt with on the Caml side. */ CAMLreturn(Val_int(i)); } @@ -755,13 +755,13 @@ request_rec *r = Request_rec_val(rv); #if APACHE2 if (r->ap_auth_type) - CAMLreturn(copy_string(r->ap_auth_type)); + CAMLreturn(caml_copy_string(r->ap_auth_type)); #else if (r->connection->ap_auth_type) - CAMLreturn(copy_string(r->connection->ap_auth_type)); + CAMLreturn(caml_copy_string(r->connection->ap_auth_type)); #endif else - raise_not_found(); + caml_raise_not_found(); } @@ -803,7 +803,7 @@ /* Return [i] as the first component of a couple so we can deal with * the possible errors on the Caml side. */ if (i == DECLINED) pw = NULL; /* FIXME */ - c = alloc_tuple (2); + c = caml_alloc_tuple (2); Store_field(c, 0, Val_int(i)); Store_field(c, 1, Val_optstring(pw)); CAMLreturn (c); @@ -834,7 +834,7 @@ request_rec *r = Request_rec_val (rv); int c = Int_val (cv); if (ap_rputc (c, r) == EOF) - raise_sys_error(copy_string("Netcgi_mod#out_channel#output_char")); + caml_raise_sys_error(caml_copy_string("Netcgi_mod#out_channel#output_char")); CAMLreturn (Val_unit); } @@ -855,8 +855,8 @@ { value f = *(value *) fv; - callback (f, Val_unit); - remove_global_root ((value *) fv); + caml_callback (f, Val_unit); + caml_remove_global_root ((value *) fv); return OK; } @@ -868,7 +868,7 @@ value *v = (value *) apr_palloc (r->pool, sizeof (value)); *v = f; - register_global_root (v); + caml_register_global_root (v); #if APACHE2 apr_pool_cleanup_register (r->pool, v, run_cleanup, apr_pool_cleanup_null); @@ -894,7 +894,7 @@ else goto not_found; } else not_found: - raise_not_found (); + caml_raise_not_found (); CAMLreturn (config); } @@ -910,6 +910,6 @@ else goto not_found; } else not_found: - raise_not_found (); + caml_raise_not_found (); CAMLreturn (config); } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netcgi2-apache/handler.c ocamlnet-4.1.9.patched/src/netcgi2-apache/handler.c --- src/netcgi2-apache/handler.c 2021-03-24 16:20:14 +++ src/netcgi2-apache/handler.c 2026-05-29 06:32:10 @@ -177,10 +177,10 @@ { value arg = Val_optstring (dirname); value *v = alloc_root_value (p); - static value *f = NULL; + static const value *f = NULL; if(f == NULL) f = caml_named_value("netcgi2_apache_create_dir_config"); - *v = callback(*f, arg); + *v = caml_callback(*f, arg); return v; } @@ -188,10 +188,10 @@ merge_dir_config (apr_pool_t *p, void *base, void *add) { value *v = alloc_root_value (p); - static value *f = NULL; + static const value *f = NULL; if(f == NULL) f = caml_named_value("netcgi2_apache_merge_dir_config"); - *v = callback2(*f, *(value *) base, *(value *) add); + *v = caml_callback2(*f, *(value *) base, *(value *) add); return v; } @@ -200,10 +200,10 @@ { value arg = Val_server_rec (s); value *v = alloc_root_value (p); - static value *f = NULL; + static const value *f = NULL; if(f == NULL) f = caml_named_value("netcgi2_apache_create_server_config"); - *v = callback(*f, arg); + *v = caml_callback(*f, arg); return v; } @@ -211,10 +211,10 @@ merge_server_config (apr_pool_t *p, void *base, void *add) { value *v = alloc_root_value (p); - static value *f = NULL; + static const value *f = NULL; if(f == NULL) f = caml_named_value("netcgi2_apache_merge_server_config"); - *v = callback2(*f, *(value *) base, *(value *) add); + *v = caml_callback2(*f, *(value *) base, *(value *) add); return v; } @@ -244,7 +244,7 @@ #define MAKE_HANDLER(name) \ static int name (request_rec *r) \ { \ - static value *f = NULL; \ + static const value *f = NULL; \ value rv, arg; \ if (f == NULL) f = caml_named_value("netcgi2_apache_" #name); \ assert(f); \ @@ -274,8 +274,8 @@ static const char * \ name (cmd_parms *parms, void *dummy, const char *strarg) \ { \ - static value *f = NULL; \ - value arg = copy_string (strarg); \ + static const value *f = NULL; \ + value arg = caml_copy_string (strarg); \ value exn; \ if (f == NULL) f = caml_named_value("netcgi2_apache_" #name); \ exn = callback_exn(*f, arg); \ @@ -296,11 +296,11 @@ { value *sconfig = (value *) ap_get_module_config (parms->server->module_config, &netcgi_module); - static value *f = NULL; - value arg = copy_string(name); + static const value *f = NULL; + value arg = caml_copy_string(name); value exn; if (f == NULL) f = caml_named_value("netcgi2_apache_cmd_translate_handler"); - exn = callback2_exn(*f, *sconfig, arg); + exn = caml_callback2_exn(*f, *sconfig, arg); if (Is_exception_result (exn)) /* FIXME: ap_pstrdup into pool? */ return caml_format_exception (Extract_exception (exn)); @@ -312,11 +312,11 @@ static const char * \ name (cmd_parms *parms, void *dconfig, const char *name) \ { \ - value *f = NULL; \ - value arg = copy_string(name); \ + const value *f = NULL; \ + value arg = caml_copy_string(name); \ value exn; \ if (f == NULL) f = caml_named_value("netcgi2_apache_" #name); \ - exn = callback2_exn(*f, *(value *) dconfig, arg); \ + exn = caml_callback2_exn(*f, *(value *) dconfig, arg); \ if (Is_exception_result (exn)) \ /* FIXME: ap_pstrdup into pool? */ \ return caml_format_exception (Extract_exception (exn)); \ diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netcgi2-apache/netcgi_apache_mod.ml.in ocamlnet-4.1.9.patched/src/netcgi2-apache/netcgi_apache_mod.ml.in --- src/netcgi2-apache/netcgi_apache_mod.ml.in 2021-03-24 16:20:14 +++ src/netcgi2-apache/netcgi_apache_mod.ml.in 2026-05-29 06:32:02 @@ -462,7 +462,7 @@ if Filename.is_relative filename then Filename.concat Conf.ocaml_libdir filename else filename in - reg_module_name := Some(String.capitalize(Filename.chop_extension + reg_module_name := Some(String.capitalize_ascii(Filename.chop_extension (Filename.basename filename))); try Dynlink.loadfile filename; with Dynlink.Error(e) -> @@ -520,7 +520,7 @@ (fun arch -> let arch' = Findlib.resolve_path ~base:d arch in reg_module_name := - Some(String.capitalize(Filename.chop_extension + Some(String.capitalize_ascii(Filename.chop_extension (Filename.basename arch'))); try Dynlink.loadfile arch'; with Dynlink.Error(e) -> @@ -624,4 +624,3 @@ let _lexing_lexeme_ = Lexing.lexeme let _queue_create_ = Queue.create let _stack_create_ = Stack.create -let _stream_sempty_ = Stream.sempty diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netcgi2-apache/wrappers.c ocamlnet-4.1.9.patched/src/netcgi2-apache/wrappers.c --- src/netcgi2-apache/wrappers.c 2021-03-24 16:20:14 +++ src/netcgi2-apache/wrappers.c 2026-05-29 06:32:02 @@ -28,7 +28,7 @@ value Val_voidptr (void *ptr) { - value rv = alloc (1, Abstract_tag); /* XXX Is this correct? */ + value rv = caml_alloc (1, Abstract_tag); /* XXX Is this correct? */ Field(rv, 0) = (value) ptr; return rv; } @@ -40,8 +40,8 @@ { CAMLparam0(); CAMLlocal2(rv, s); - s = copy_string (str); - rv = alloc_small (1, 0); + s = caml_copy_string (str); + rv = caml_alloc_small (1, 0); Field(rv, 0) = s; CAMLreturn(rv); } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netgss-system/META.in ocamlnet-4.1.9.patched/src/netgss-system/META.in --- src/netgss-system/META.in 2021-03-24 16:20:15 +++ src/netgss-system/META.in 2026-05-29 06:31:43 @@ -1,5 +1,5 @@ description = "Ocamlnet - GSSAPI bindings" -requires = "unix,bigarray,netsys,netstring" +requires = "unix,netsys,netstring" version = "@VERSION@" archive(byte) = "netgss-system.cma" archive(native) = "netgss-system.cmxa" diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netgss-system/gssapi.c ocamlnet-4.1.9.patched/src/netgss-system/gssapi.c --- src/netgss-system/gssapi.c 2021-03-24 16:20:15 +++ src/netgss-system/gssapi.c 2026-05-29 06:31:44 @@ -59,7 +59,7 @@ fprintf(stderr, "Netgss: error from gss_release_buffer\n"); } else { if (tag == 1) { - stat_free(buf->value); + caml_stat_free(buf->value); } } } @@ -71,13 +71,13 @@ static void netgss_free_buffer(long tag, gss_buffer_t buf) { netgss_free_buffer_contents(tag, buf); /* The descriptor is always allocated by us: */ - stat_free(buf); + caml_stat_free(buf); } static gss_buffer_t netgss_alloc_buffer(void) { gss_buffer_t buf; - buf = (gss_buffer_t) stat_alloc(sizeof(gss_buffer_desc)); + buf = (gss_buffer_t) caml_stat_alloc(sizeof(gss_buffer_desc)); buf->value = NULL; buf->length = 0; return buf; @@ -105,10 +105,10 @@ gss_buffer_t buf; if (Long_val(len) < 0 || Long_val(pos) < 0 || Long_val(pos) > caml_string_length(s) - Long_val(len)) - invalid_argument("buffer_of_string"); + caml_invalid_argument("buffer_of_string"); buf = netgss_alloc_buffer(); buf->length = Long_val(len); - buf->value = stat_alloc(buf->length); + buf->value = caml_stat_alloc(buf->length); memcpy(buf->value, String_val(s) + Long_val(pos), buf->length); return twrap_gss_buffer_t(1, buf); } @@ -155,14 +155,14 @@ if (tag == 0 || buf == GSS_C_NO_OID) { /* OIDs from the provider are to be considered as read-only */ } else { - stat_free(buf->elements); - stat_free(buf); + caml_stat_free(buf->elements); + caml_stat_free(buf); } } static gss_OID netgss_alloc_oid(void) { - return (gss_OID) stat_alloc(sizeof(gss_OID_desc)); + return (gss_OID) caml_stat_alloc(sizeof(gss_OID_desc)); } @@ -173,7 +173,7 @@ } else { out = netgss_alloc_oid(); out->length = buf->length; - out->elements = stat_alloc(buf->length); + out->elements = caml_stat_alloc(buf->length); memcpy(out->elements, buf->elements, buf->length); } return out; @@ -184,7 +184,7 @@ gss_OID buf; buf = netgss_alloc_oid(); buf->length = caml_string_length(s); - buf->elements = stat_alloc(buf->length); + buf->elements = caml_stat_alloc(buf->length); memcpy(buf->elements, String_val(s), buf->length); return twrap_gss_OID(1, buf); } @@ -213,14 +213,14 @@ for (k=0; k < set->count; k++) { netgss_free_oid(1, set->elements+k); } - stat_free(set->elements); - stat_free(set); + caml_stat_free(set->elements); + caml_stat_free(set); } } static gss_OID_set netgss_alloc_oid_set(void) { - return (gss_OID_set) stat_alloc(sizeof(gss_OID_set_desc)); + return (gss_OID_set) caml_stat_alloc(sizeof(gss_OID_set_desc)); } @@ -254,7 +254,7 @@ return twrap_gss_OID_set(1, GSS_C_NO_OID_SET); set = netgss_alloc_oid_set(); set->count = Wosize_val(varg); - set->elements = stat_alloc(sizeof(gss_OID) * set->count); + set->elements = caml_stat_alloc(sizeof(gss_OID) * set->count); for (k=0; kcount; k++) { v1 = Field(varg, k); buf = unwrap_gss_OID(v1); @@ -308,17 +308,17 @@ aaddr_len = caml_string_length(aaddr); data_len = caml_string_length(data); cb = (gss_channel_bindings_t) - stat_alloc(sizeof(struct gss_channel_bindings_struct)); + caml_stat_alloc(sizeof(struct gss_channel_bindings_struct)); cb->initiator_addrtype = Int_val(iaddrty); cb->initiator_address.length = iaddr_len; - cb->initiator_address.value = stat_alloc(iaddr_len); + cb->initiator_address.value = caml_stat_alloc(iaddr_len); memcpy(cb->initiator_address.value, String_val(iaddr), iaddr_len); cb->acceptor_addrtype = Int_val(aaddrty); cb->acceptor_address.length = aaddr_len; - cb->acceptor_address.value = stat_alloc(aaddr_len); + cb->acceptor_address.value = caml_stat_alloc(aaddr_len); memcpy(cb->acceptor_address.value, String_val(aaddr), aaddr_len); cb->application_data.length = data_len; - cb->application_data.value = stat_alloc(data_len); + cb->application_data.value = caml_stat_alloc(data_len); memcpy(cb->application_data.value, String_val(data), data_len); return wrap_gss_channel_bindings_t(cb); } @@ -364,8 +364,8 @@ static void netgss_free_cb(gss_channel_bindings_t x) { if (x != NULL) { - stat_free(x->initiator_address.value); - stat_free(x->acceptor_address.value); - stat_free(x->application_data.value); + caml_stat_free(x->initiator_address.value); + caml_stat_free(x->acceptor_address.value); + caml_stat_free(x->application_data.value); } } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netgss-system/reconfigure ocamlnet-4.1.9.patched/src/netgss-system/reconfigure --- src/netgss-system/reconfigure 2021-03-24 16:20:15 +++ src/netgss-system/reconfigure 2026-05-29 06:31:44 @@ -133,7 +133,7 @@ rm -f config_checks.sh echo "$ ocaml -I ../../tools gssapi.descr" >>$log -ocaml -I ../../tools gssapi.descr || exit 1 +ocaml -I +str -I ../../tools gssapi.descr || exit 1 . ./config_checks.sh diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nethttpd/nethttpd_services.ml ocamlnet-4.1.9.patched/src/nethttpd/nethttpd_services.ml --- src/nethttpd/nethttpd_services.ml 2021-03-24 16:20:14 +++ src/nethttpd/nethttpd_services.ml 2026-05-29 06:31:44 @@ -107,10 +107,10 @@ try let req_name = env # input_header_field "Host" in let (req_host, req_port_opt) = split_host_port req_name in - let req_host = String.lowercase req_host in + let req_host = String.lowercase_ascii req_host in let req_port = match req_port_opt with Some p -> p | None -> 80 in (* CHECK *) List.find - (fun (n,p) -> (n = "*" || String.lowercase n = req_host) && + (fun (n,p) -> (n = "*" || String.lowercase_ascii n = req_host) && (p = 0 || p = req_port)) host.server_names with diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netplex/Makefile ocamlnet-4.1.9.patched/src/netplex/Makefile --- src/netplex/Makefile 2021-03-24 16:20:15 +++ src/netplex/Makefile 2026-05-29 06:31:44 @@ -36,7 +36,7 @@ netplex-admin$(EXEC_SUFFIX): netplex.cma netplex_admin.cmo $(OCAMLC) -o netplex-admin -custom \ - -package "bytes unix bigarray str" -linkpkg \ + -package "bytes unix str" -linkpkg \ netsys_oothr.cma netsys.cma netstring.cma equeue.cma \ rpc.cma netplex.cma netplex_admin.cmo diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netplex/netplex_config.ml ocamlnet-4.1.9.patched/src/netplex/netplex_config.ml --- src/netplex/netplex_config.ml 2021-03-24 16:20:15 +++ src/netplex/netplex_config.ml 2026-05-29 06:31:44 @@ -1,5 +1,195 @@ (* $Id$ *) +module Stream = Netstring_stream +module Genlex = struct +type token = + Kwd of string + | Ident of string + | Int of int + | Float of float + | String of string + | Char of char + +(* The string buffering machinery *) + +let initial_buffer = Bytes.create 32 + +let buffer = ref initial_buffer +let bufpos = ref 0 + +let reset_buffer () = buffer := initial_buffer; bufpos := 0 + +let store c = + if !bufpos >= Bytes.length !buffer then begin + let newbuffer = Bytes.create (2 * !bufpos) in + Bytes.blit !buffer 0 newbuffer 0 !bufpos; + buffer := newbuffer + end; + Bytes.set !buffer !bufpos c; + incr bufpos + +let get_string () = + let s = Bytes.sub_string !buffer 0 !bufpos in buffer := initial_buffer; s + +(* The lexer *) + +let make_lexer keywords = + let kwd_table = Hashtbl.create 17 in + List.iter (fun s -> Hashtbl.add kwd_table s (Kwd s)) keywords; + let ident_or_keyword id = + try Hashtbl.find kwd_table id with + Not_found -> Ident id + and keyword_or_error c = + let s = String.make 1 c in + try Hashtbl.find kwd_table s with + Not_found -> raise (Stream.Error ("Illegal character " ^ s)) + in + let rec next_token (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some (' ' | '\010' | '\013' | '\009' | '\026' | '\012') -> + Stream.junk strm__; next_token strm__ + | Some ('A'..'Z' | 'a'..'z' | '_' | '\192'..'\255' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store c; ident s + | Some + ('!' | '%' | '&' | '$' | '#' | '+' | '/' | ':' | '<' | '=' | '>' | + '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store c; ident2 s + | Some ('0'..'9' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store c; number s + | Some '\'' -> + Stream.junk strm__; + let c = + try char strm__ with + Stream.Failure -> raise (Stream.Error "") + in + begin match Stream.peek strm__ with + Some '\'' -> Stream.junk strm__; Some (Char c) + | _ -> raise (Stream.Error "") + end + | Some '\"' -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); Some (String (string s)) + | Some '-' -> Stream.junk strm__; neg_number strm__ + | Some '(' -> Stream.junk strm__; maybe_comment strm__ + | Some c -> Stream.junk strm__; Some (keyword_or_error c) + | _ -> None + and ident (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some + ('A'..'Z' | 'a'..'z' | '\192'..'\255' | '0'..'9' | '_' | '\'' as c) -> + Stream.junk strm__; let s = strm__ in store c; ident s + | _ -> Some (ident_or_keyword (get_string ())) + and ident2 (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some + ('!' | '%' | '&' | '$' | '#' | '+' | '-' | '/' | ':' | '<' | '=' | + '>' | '?' | '@' | '\\' | '~' | '^' | '|' | '*' as c) -> + Stream.junk strm__; let s = strm__ in store c; ident2 s + | _ -> Some (ident_or_keyword (get_string ())) + and neg_number (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; + let s = strm__ in reset_buffer (); store '-'; store c; number s + | _ -> let s = strm__ in reset_buffer (); store '-'; ident2 s + and number (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; let s = strm__ in store c; number s + | Some '.' -> + Stream.junk strm__; let s = strm__ in store '.'; decimal_part s + | Some ('e' | 'E') -> + Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s + | _ -> Some (Int (int_of_string (get_string ()))) + and decimal_part (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; let s = strm__ in store c; decimal_part s + | Some ('e' | 'E') -> + Stream.junk strm__; let s = strm__ in store 'E'; exponent_part s + | _ -> Some (Float (float_of_string (get_string ()))) + and exponent_part (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('+' | '-' as c) -> + Stream.junk strm__; let s = strm__ in store c; end_exponent_part s + | _ -> end_exponent_part strm__ + and end_exponent_part (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ('0'..'9' as c) -> + Stream.junk strm__; let s = strm__ in store c; end_exponent_part s + | _ -> Some (Float (float_of_string (get_string ()))) + and string (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\"' -> Stream.junk strm__; get_string () + | Some '\\' -> + Stream.junk strm__; + let c = + try escape strm__ with + Stream.Failure -> raise (Stream.Error "") + in + let s = strm__ in store c; string s + | Some c -> Stream.junk strm__; let s = strm__ in store c; string s + | _ -> raise Stream.Failure + and char (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '\\' -> + Stream.junk strm__; + begin try escape strm__ with + Stream.Failure -> raise (Stream.Error "") + end + | Some c -> Stream.junk strm__; c + | _ -> raise Stream.Failure + and escape (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some 'n' -> Stream.junk strm__; '\n' + | Some 'r' -> Stream.junk strm__; '\r' + | Some 't' -> Stream.junk strm__; '\t' + | Some ('0'..'9' as c1) -> + Stream.junk strm__; + begin match Stream.peek strm__ with + Some ('0'..'9' as c2) -> + Stream.junk strm__; + begin match Stream.peek strm__ with + Some ('0'..'9' as c3) -> + Stream.junk strm__; + Char.chr + ((Char.code c1 - 48) * 100 + (Char.code c2 - 48) * 10 + + (Char.code c3 - 48)) + | _ -> raise (Stream.Error "") + end + | _ -> raise (Stream.Error "") + end + | Some c -> Stream.junk strm__; c + | _ -> raise Stream.Failure + and maybe_comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '*' -> + Stream.junk strm__; let s = strm__ in comment s; next_token s + | _ -> Some (keyword_or_error '(') + and comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '(' -> Stream.junk strm__; maybe_nested_comment strm__ + | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ + | Some _ -> Stream.junk strm__; comment strm__ + | _ -> raise Stream.Failure + and maybe_nested_comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some '*' -> Stream.junk strm__; let s = strm__ in comment s; comment s + | Some _ -> Stream.junk strm__; comment strm__ + | _ -> raise Stream.Failure + and maybe_end_comment (strm__ : _ Stream.t) = + match Stream.peek strm__ with + Some ')' -> Stream.junk strm__; () + | Some '*' -> Stream.junk strm__; maybe_end_comment strm__ + | Some _ -> Stream.junk strm__; comment strm__ + | _ -> raise Stream.Failure + in + fun input -> Stream.from (fun _count -> next_token input) +end + open Netplex_types open Genlex open Printf diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netplex/netplex_kit.ml ocamlnet-4.1.9.patched/src/netplex/netplex_kit.ml --- src/netplex/netplex_kit.ml 2021-03-24 16:20:15 +++ src/netplex/netplex_kit.ml 2026-05-29 06:31:44 @@ -89,7 +89,7 @@ module PTYPE = struct type t = parallelization_type - let compare (x:t) (y:t) = Pervasives.compare x y + let compare (x:t) (y:t) = compare x y end module PSet = Set.Make(PTYPE) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netplex/netplex_workload.ml ocamlnet-4.1.9.patched/src/netplex/netplex_workload.ml --- src/netplex/netplex_workload.ml 2021-03-24 16:20:15 +++ src/netplex/netplex_workload.ml 2026-05-29 06:31:44 @@ -119,7 +119,7 @@ module ContId = struct type t = container_id - let (compare : t -> t -> int) = Pervasives.compare + let (compare : t -> t -> int) = compare end diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netshm/META.in ocamlnet-4.1.9.patched/src/netshm/META.in --- src/netshm/META.in 2021-03-24 16:20:14 +++ src/netshm/META.in 2026-05-29 06:31:44 @@ -1,6 +1,6 @@ version = "@VERSION@" description = "Ocamlnet - Shared memory" -requires = "unix netsys bigarray" +requires = "unix netsys" archive(byte) = "netshm.cma" archive(native) = "netshm.cmxa" archive(native,gprof) = "netshm.p.cmxa" diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netshm/netshm.ml ocamlnet-4.1.9.patched/src/netshm/netshm.ml --- src/netshm/netshm.ml 2021-03-24 16:20:14 +++ src/netshm/netshm.ml 2026-05-29 06:31:44 @@ -133,7 +133,7 @@ module Int = struct type t = int - let compare = (Pervasives.compare : int -> int -> int) + let compare = (compare : int -> int -> int) end module IntMap = Map.Make(Int) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/Makefile ocamlnet-4.1.9.patched/src/netstring/Makefile --- src/netstring/Makefile 2021-03-24 16:20:13 +++ src/netstring/Makefile 2026-05-29 06:31:44 @@ -3,7 +3,7 @@ include $(TOP_DIR)/Makefile.conf OBJECTS = netconst.cmo netstring_str.cmo netbuffer.cmo netunichar.cmo \ - netaux.cmo netstring_tstring.cmo \ + netaux.cmo netstring_tstring.cmo netstring_stream.cmo \ netchannels.cmo netchannels_crypto.cmo netsockaddr.cmo \ netdb.cmo netmappings_asn1.cmo netmappings.cmo netconversion.cmo \ netulex.cmo netencoding.cmo netstream.cmo netdate.cmo \ @@ -28,7 +28,7 @@ PKGNAME = netstring -REQUIRES += $(REGEXP_PROVIDER_MAKE) bigarray +REQUIRES += $(REGEXP_PROVIDER_MAKE) INCLUDES += $(INC_NETSYS) INCLUDES += -I ../netstring-pcre diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/netaccel_c.c ocamlnet-4.1.9.patched/src/netstring/netaccel_c.c --- src/netstring/netaccel_c.c 2021-03-24 16:20:13 +++ src/netstring/netaccel_c.c 2026-05-29 06:31:44 @@ -25,7 +25,7 @@ srcpos_c+len_c > Wosize_val(src) || destpos_c < 0 || destpos_c+len_c > Wosize_val(dest)) - invalid_argument("Netaccel.int_blit"); + caml_invalid_argument("Netaccel.int_blit"); if (src != dest || destpos_c <= srcpos_c) { for (i=0; i Wosize_val(src) || destpos_c < 0 || destpos_c+len_c > Wosize_val(dest)) - invalid_argument("Netaccel.int_series"); + caml_invalid_argument("Netaccel.int_series"); s = n_c; for (i=0; i string_length(s_in)) - invalid_argument("Netaccel.read_iso88591"); + caml_invalid_argument("Netaccel.read_iso88591"); + if (p_in_c < 0 || l_in_c < 0 || p_in_c + l_in_c > caml_string_length(s_in)) + caml_invalid_argument("Netaccel.read_iso88591"); m = l_in_c; if (slice_char_len < m) m = slice_char_len; @@ -110,12 +110,12 @@ ch = Byte_u(s_in, p_in_c+k); if (ch > maxcode_c) { Field(slice_char, k) = Val_long(-1); - r = alloc_tuple(3); + r = caml_alloc_tuple(3); Store_field(r, 0, Val_long(k)); Store_field(r, 1, Val_long(k)); Store_field(r, 2, enc); - raise_with_arg(*caml_named_value("Netconversion.Malformed_code_read"), - r); + caml_raise_with_arg(*caml_named_value("Netconversion.Malformed_code_read"), + r); }; Field(slice_char, k) = Val_int((signed int) ch); }; @@ -124,7 +124,7 @@ Field(slice_char, m) = Val_long(-1); }; - r = alloc_tuple(3); + r = caml_alloc_tuple(3); Store_field(r, 0, Val_long(m)); Store_field(r, 1, Val_long(m)); Store_field(r, 2, enc); @@ -164,9 +164,9 @@ slice_char_len = Wosize_val(slice_char); if (slice_char_len != Wosize_val(slice_blen)) - invalid_argument("Netaccel.read_utf8"); - if (p_in_c < 0 || l_in_c < 0 || p_in_c + l_in_c > string_length(s_in)) - invalid_argument("Netaccel.read_utf8"); + caml_invalid_argument("Netaccel.read_utf8"); + if (p_in_c < 0 || l_in_c < 0 || p_in_c + l_in_c > caml_string_length(s_in)) + caml_invalid_argument("Netaccel.read_utf8"); p = p_in_c; p_max = p_in_c + l_in_c; @@ -249,21 +249,21 @@ Field(slice_char, n_ret) = Val_long(-1); } - r = alloc_tuple(3); + r = caml_alloc_tuple(3); Store_field(r, 0, Val_long(n_ret)); Store_field(r, 1, Val_long(p-p_in_c)); - Store_field(r, 2, hash_variant("Enc_utf8")); + Store_field(r, 2, caml_hash_variant("Enc_utf8")); CAMLreturn(r); malformed_code: Field(slice_char, n) = Val_long(-1); - r = alloc_tuple(3); + r = caml_alloc_tuple(3); Store_field(r, 0, Val_long(n)); Store_field(r, 1, Val_long(p-p_in_c)); - Store_field(r, 2, hash_variant("Enc_utf8")); - raise_with_arg(*caml_named_value("Netconversion.Malformed_code_read"), - r); + Store_field(r, 2, caml_hash_variant("Enc_utf8")); + caml_raise_with_arg(*caml_named_value("Netconversion.Malformed_code_read"), + r); /* Cannot reach this point! */ CAMLreturn(Val_unit); diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/netchannels.ml ocamlnet-4.1.9.patched/src/netstring/netchannels.ml --- src/netstring/netchannels.ml 2021-03-24 16:20:13 +++ src/netstring/netchannels.ml 2026-05-29 06:31:44 @@ -213,45 +213,45 @@ if closed then self # complain_closed(); try if len=0 then raise Sys_blocked_io; - let n = Pervasives.input ch buf pos len in + let n = input ch buf pos len in if n=0 then raise End_of_file else n with Sys_blocked_io -> 0 method really_input buf pos len = if closed then self # complain_closed(); - Pervasives.really_input ch buf pos len + really_input ch buf pos len method really_input_string len = if closed then self # complain_closed(); #ifdef HAVE_BYTES - Pervasives.really_input_string ch len + really_input_string ch len #else let buf = String.create len in - Pervasives.really_input ch buf 0 len; + really_input ch buf 0 len; buf #endif method input_char () = if closed then self # complain_closed(); - Pervasives.input_char ch + input_char ch method input_line () = if closed then self # complain_closed(); - Pervasives.input_line ch + input_line ch method input_byte () = if closed then self # complain_closed(); - Pervasives.input_byte ch + input_byte ch method close_in () = if not closed then ( - Pervasives.close_in ch; closed <- true; onclose() + close_in ch; closed <- true; onclose() ) method pos_in = if closed then self # complain_closed(); - Pervasives.pos_in ch + pos_in ch end ;; @@ -999,17 +999,17 @@ method output buf pos len = if closed then self # complain_closed(); - (* Pervasives.output does not support non-blocking I/O directly. + (* output does not support non-blocking I/O directly. * Work around it: *) - let p0 = Pervasives.pos_out ch in + let p0 = pos_out ch in try - Pervasives.output ch buf pos len; + output ch buf pos len; errflag := false; len with | Sys_blocked_io -> - let p1 = Pervasives.pos_out ch in + let p1 = pos_out ch in errflag := false; p1 - p0 | error -> @@ -1018,35 +1018,35 @@ method really_output buf pos len = if closed then self # complain_closed(); - monitored (Pervasives.output ch buf pos) len + monitored (output ch buf pos) len method really_output_string buf pos len = if closed then self # complain_closed(); #ifdef HAVE_BYTES - monitored (Pervasives.output_substring ch buf pos) len + monitored (output_substring ch buf pos) len #else - monitored (Pervasives.output ch buf pos) len + monitored (output ch buf pos) len #endif method output_char c = if closed then self # complain_closed(); - monitored (Pervasives.output_char ch) c + monitored (output_char ch) c method output_string s = if closed then self # complain_closed(); - monitored (Pervasives.output_string ch) s + monitored (output_string ch) s method output_bytes s = if closed then self # complain_closed(); #ifdef HAVE_BYTES - monitored (Pervasives.output_bytes ch) s + monitored (output_bytes ch) s #else - monitored (Pervasives.output_string ch) s + monitored (output_string ch) s #endif method output_byte b = if closed then self # complain_closed(); - monitored (Pervasives.output_byte ch) b + monitored (output_byte ch) b method output_buffer b = if closed then self # complain_closed(); @@ -1061,7 +1061,7 @@ method flush() = if closed then self # complain_closed(); - monitored Pervasives.flush ch + monitored flush ch method close_out() = if not closed then ( @@ -1071,9 +1071,9 @@ exception handler *) if !errflag then - Pervasives.close_out_noerr ch + close_out_noerr ch else - Pervasives.close_out ch; + close_out ch; closed <- true; with | error -> @@ -1082,7 +1082,7 @@ "Netchannels.output_channel: \ Suppressed error in close_out: %s - backtrace: %s" (Netexn.to_string error) bt; - Pervasives.close_out_noerr ch; + close_out_noerr ch; closed <- true; ); onclose() @@ -1090,7 +1090,7 @@ method pos_out = if closed then self # complain_closed(); - Pervasives.pos_out ch + pos_out ch end ;; @@ -1844,7 +1844,7 @@ Suppressed error in close_out: %s - backtrace: %s" (Netexn.to_string error) bt; ); - Pervasives.close_in transch_in; + close_in transch_in; trans # close_out(); (* closes transch_out *) out # close_out(); closed := true @@ -1859,7 +1859,7 @@ need_clear <- true; let len = trans # pos_out in trans # flush(); - Pervasives.seek_in transch_in 0; + seek_in transch_in 0; let trans' = new input_channel transch_in in ( try out # output_channel ~len trans'; @@ -1876,7 +1876,7 @@ method private clear() = (* delete the contents of the file *) (* First empty the file and reset the output channel: *) - Pervasives.seek_out transch_out 0; + seek_out transch_out 0; Unix.ftruncate (Unix.descr_of_out_channel transch_out) 0; (* Renew the input channel. We create a new channel to avoid problems * with the internal buffer of the channel. diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/netdate.ml ocamlnet-4.1.9.patched/src/netstring/netdate.ml --- src/netstring/netdate.ml 2021-03-24 16:20:13 +++ src/netstring/netdate.ml 2026-05-29 06:31:44 @@ -5,6 +5,7 @@ (* Thanks to Nicolas George for contributing the parsing and format code *) +module Stream = Netstring_stream open Printf (* Calculate local zone offset in minutes *) @@ -1035,11 +1036,11 @@ format ~fmt (create ?localzone ?zone ?nanos t) let mk_mail_date ?localzone ?zone t = - format "%a, %d %b %Y %H:%M:%S %z" (create ?localzone ?zone t) + format ~fmt:"%a, %d %b %Y %H:%M:%S %z" (create ?localzone ?zone t) ;; let mk_usenet_date ?localzone ?zone t = - format "%A, %d-%b-%y %H:%M:%S %z" (create ?localzone ?zone t) + format ~fmt:"%A, %d-%b-%y %H:%M:%S %z" (create ?localzone ?zone t) ;; let mk_internet_date ?localzone ?zone ?(digits=0) t = diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/nethtml.ml ocamlnet-4.1.9.patched/src/netstring/nethtml.ml --- src/netstring/nethtml.ml 2021-03-24 16:20:13 +++ src/netstring/nethtml.ml 2026-05-29 06:31:44 @@ -283,7 +283,7 @@ module S = struct type t = string - let compare = (Pervasives.compare : string -> string -> int) + let compare = (compare : string -> string -> int) end module Strset = Set.Make(S);; diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/nethttp.ml ocamlnet-4.1.9.patched/src/netstring/nethttp.ml --- src/netstring/nethttp.ml 2021-03-24 16:20:13 +++ src/netstring/nethttp.ml 2026-05-29 06:31:44 @@ -3,6 +3,8 @@ * Nethttp: Basic definitions for the HTTP protocol *) +module Stream = Netstring_stream + type protocol_version = int * int type protocol_attribute = @@ -1009,7 +1011,7 @@ snd (List.stable_sort (fun (q1, tok_param1) (q2, tok_param2) -> - Pervasives.compare q2 q1) + compare q2 q1) (List.filter (fun (q, tok_param) -> q > 0.0) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/netmime.ml ocamlnet-4.1.9.patched/src/netstring/netmime.ml --- src/netstring/netmime.ml 2021-03-24 16:20:13 +++ src/netstring/netmime.ml 2026-05-29 06:31:44 @@ -71,7 +71,7 @@ end = struct type t = string let compare (a_ci:t) (b_ci:t) = - Pervasives.compare a_ci b_ci + compare a_ci b_ci let make s = STRING_LOWERCASE s end diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/netmime_string.ml ocamlnet-4.1.9.patched/src/netstring/netmime_string.ml --- src/netstring/netmime_string.ml 2021-03-24 16:20:13 +++ src/netstring/netmime_string.ml 2026-05-29 06:31:44 @@ -979,7 +979,7 @@ | _, t -> t :: collect scn in - let scn = create_mime_scanner specials options s in + let scn = create_mime_scanner ~specials ~scan_options:options s in collect scn ;; @@ -995,7 +995,7 @@ let scan_encoded_text_value s = let specials = [ ' '; '\t'; '\r'; '\n'; '('; '['; '"' ] in let options = [ Recognize_encoded_words ] in - let scn = create_mime_scanner specials options s in + let scn = create_mime_scanner ~specials ~scan_options:options s in let rec collect () = match scan_token scn with @@ -1955,7 +1955,7 @@ let scan_multipart_body_and_decode s ~start_pos:i0 ~end_pos:i1 ~boundary = - let parts = scan_multipart_body s i0 i1 boundary in + let parts = scan_multipart_body s ~start_pos:i0 ~end_pos:i1 ~boundary in List.map (fun (params, value) -> let encoding = diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netstring/netstring_stream.ml ocamlnet-4.1.9.patched/src/netstring/netstring_stream.ml --- src/netstring/netstring_stream.ml 1970-01-01 01:00:00 +++ src/netstring/netstring_stream.ml 2026-05-29 06:31:44 @@ -0,0 +1,180 @@ +(* The Stream module from latest OCaml-4. It is no longer available in + OCaml-5. + *) +type 'a t = 'a cell option + and 'a cell = { mutable count : int; mutable data : 'a data } + and 'a data = + Sempty + | Scons of 'a * 'a data + | Sapp of 'a data * 'a data + | Slazy of 'a data Lazy.t + | Sgen of 'a gen + | Sbuffio : buffio -> char data + and 'a gen = { mutable curr : 'a option option; func : int -> 'a option } + and buffio = + { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int } + +exception Failure +exception Error of string + +let count = function + | None -> 0 + | Some { count } -> count +let data = function + | None -> Sempty + | Some { data } -> data + +let fill_buff b = + b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0 + +let rec get_data : type v. int -> v data -> v data = fun count d -> match d with + (* Returns either Sempty or Scons(a, _) even when d is a generator + or a buffer. In those cases, the item a is seen as extracted from + the generator/buffer. + The count parameter is used for calling `Sgen-functions'. *) + Sempty | Scons (_, _) -> d + | Sapp (d1, d2) -> + begin match get_data count d1 with + Scons (a, d11) -> Scons (a, Sapp (d11, d2)) + | Sempty -> get_data count d2 + | _ -> assert false + end + | Sgen {curr = Some None} -> Sempty + | Sgen ({curr = Some(Some a)} as g) -> + g.curr <- None; Scons(a, d) + | Sgen g -> + begin match g.func count with + None -> g.curr <- Some(None); Sempty + | Some a -> Scons(a, d) + (* Warning: anyone using g thinks that an item has been read *) + end + | Sbuffio b -> + if b.ind >= b.len then fill_buff b; + if b.len == 0 then Sempty else + let r = Bytes.unsafe_get b.buff b.ind in + (* Warning: anyone using g thinks that an item has been read *) + b.ind <- succ b.ind; Scons(r, d) + | Slazy f -> get_data count (Lazy.force f) + + +let rec peek_data : type v. v cell -> v option = fun s -> + (* consult the first item of s *) + match s.data with + Sempty -> None + | Scons (a, _) -> Some a + | Sapp (_, _) -> + begin match get_data s.count s.data with + Scons(a, _) as d -> s.data <- d; Some a + | Sempty -> None + | _ -> assert false + end + | Slazy f -> s.data <- (Lazy.force f); peek_data s + | Sgen {curr = Some a} -> a + | Sgen g -> let x = g.func s.count in g.curr <- Some x; x + | Sbuffio b -> + if b.ind >= b.len then fill_buff b; + if b.len == 0 then begin s.data <- Sempty; None end + else Some (Bytes.unsafe_get b.buff b.ind) + + +let peek = function + | None -> None + | Some s -> peek_data s + + +let rec junk_data : type v. v cell -> unit = fun s -> + match s.data with + Scons (_, d) -> s.count <- (succ s.count); s.data <- d + | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None + | Sbuffio b -> + if b.ind >= b.len then fill_buff b; + if b.len == 0 then s.data <- Sempty + else (s.count <- (succ s.count); b.ind <- succ b.ind) + | _ -> + match peek_data s with + None -> () + | Some _ -> junk_data s + + +let junk = function + | None -> () + | Some data -> junk_data data + +let rec nget_data n s = + if n <= 0 then [], s.data, 0 + else + match peek_data s with + Some a -> + junk_data s; + let (al, d, k) = nget_data (pred n) s in a :: al, Scons (a, d), succ k + | None -> [], s.data, 0 + + +let npeek_data n s = + let (al, d, len) = nget_data n s in + s.count <- (s.count - len); + s.data <- d; + al + + +let npeek n = function + | None -> [] + | Some d -> npeek_data n d + +let next s = + match peek s with + Some a -> junk s; a + | None -> raise Failure + + +let empty s = + match peek s with + Some _ -> raise Failure + | None -> () + + +let iter f strm = + let rec do_rec () = + match peek strm with + Some a -> junk strm; ignore(f a); do_rec () + | None -> () + in + do_rec () + + +(* Stream building functions *) + +let from f = Some {count = 0; data = Sgen {curr = None; func = f}} + +let of_list l = + Some {count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty} + + +let of_string s = + let count = ref 0 in + from (fun _ -> + (* We cannot use the index passed by the [from] function directly + because it returns the current stream count, with absolutely no + guarantee that it will start from 0. For example, in the case + of [Stream.icons 'c' (Stream.from_string "ab")], the first + access to the string will be made with count [1] already. + *) + let c = !count in + if c < String.length s + then (incr count; Some s.[c]) + else None) + + +let of_bytes s = + let count = ref 0 in + from (fun _ -> + let c = !count in + if c < Bytes.length s + then (incr count; Some (Bytes.get s c)) + else None) + + +let of_channel ic = + Some {count = 0; + data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}} + diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/META.in ocamlnet-4.1.9.patched/src/netsys/META.in --- src/netsys/META.in 2021-03-24 16:20:14 +++ src/netsys/META.in 2026-05-29 06:31:44 @@ -1,5 +1,5 @@ description = "Ocamlnet - OS-specific functions" -requires = "bytes,unix,bigarray" +requires = "bytes,unix" version = "@VERSION@" archive(byte) = "netsys_oothr.cma netsys.cma" archive(native) = "netsys_oothr.cmxa netsys.cmxa" diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netlog.ml ocamlnet-4.1.9.patched/src/netsys/netlog.ml --- src/netsys/netlog.ml 2021-03-24 16:20:14 +++ src/netsys/netlog.ml 2026-05-29 06:31:44 @@ -129,7 +129,7 @@ let current_logger = - ref(channel_logger Pervasives.stderr `Debug) + ref(channel_logger stderr `Debug) let log lev msg = diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c.c ocamlnet-4.1.9.patched/src/netsys/netsys_c.c --- src/netsys/netsys_c.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c.c 2026-05-29 06:31:59 @@ -12,13 +12,13 @@ #ifdef _WIN32 switch (Descr_kind_val(fd)) { case KIND_HANDLE: - return copy_int64((intnat) (Handle_val(fd))); + return caml_copy_int64((intnat) (Handle_val(fd))); case KIND_SOCKET: - return copy_int64((intnat) (Socket_val(fd))); + return caml_copy_int64((intnat) (Socket_val(fd))); } - return copy_int64(0); + return caml_copy_int64(0); #else - return copy_int64(Long_val(fd)); + return caml_copy_int64(Long_val(fd)); #endif } @@ -45,13 +45,13 @@ win32_maperr(e); e = errno; #endif - return(unix_error_of_code(e)); + return(caml_unix_error_of_code(e)); } CAMLprim value netsys_get_nonblock(value fd) { #ifdef _WIN32 - invalid_argument("Netsys_posix.get_nonblcok not avaiable"); + caml_invalid_argument("Netsys_posix.get_nonblcok not avaiable"); #else int r; @@ -67,7 +67,7 @@ _exit(Int_val(n)); return Val_int(0); #else - invalid_argument("Netsys._exit not available"); + caml_invalid_argument("Netsys._exit not available"); #endif } @@ -76,7 +76,7 @@ #ifdef HAVE_SYSCONF return Val_long(sysconf(_SC_OPEN_MAX)); #else - invalid_argument("Netsys.sysconf_open_max not available"); + caml_invalid_argument("Netsys.sysconf_open_max not available"); #endif } @@ -89,7 +89,7 @@ if (pgid == -1) uerror("getpgid", Nothing); return Val_int(pgid); #else - invalid_argument("Netsys.getpgid not available"); + caml_invalid_argument("Netsys.getpgid not available"); #endif } @@ -102,7 +102,7 @@ if (r == -1) uerror("setpgid", Nothing); return Val_int(0); #else - invalid_argument("Netsys.setpgid not available"); + caml_invalid_argument("Netsys.setpgid not available"); #endif } @@ -115,7 +115,7 @@ if (pgid == -1) uerror("tcgetpgrp", Nothing); return Val_int(pgid); #else - invalid_argument("Netsys.tcgetpgrp not available"); + caml_invalid_argument("Netsys.tcgetpgrp not available"); #endif } @@ -128,7 +128,7 @@ if (r == -1) uerror("tcsetpgrp", Nothing); return Val_int(0); #else - invalid_argument("Netsys.tcsetpgrp not available"); + caml_invalid_argument("Netsys.tcsetpgrp not available"); #endif } @@ -137,10 +137,10 @@ #ifdef HAVE_POSIX_TTY char *s; s = NULL; - return copy_string(ctermid(s)); + return caml_copy_string(ctermid(s)); /* ctermid is always successful; however it can return an empty string */ #else - invalid_argument("Netsys.ctermid not available"); + caml_invalid_argument("Netsys.ctermid not available"); #endif } @@ -151,9 +151,9 @@ s = ttyname(Int_val(fd)); if ( s == NULL ) uerror("ttyname", Nothing); - return copy_string(s); + return caml_copy_string(s); #else - invalid_argument("Netsys.ttyname not available"); + caml_invalid_argument("Netsys.ttyname not available"); #endif } @@ -166,7 +166,7 @@ if ( sid == -1 ) uerror("getsid", Nothing); return Val_int(sid); #else - invalid_argument("Netsys.getsid not available"); + caml_invalid_argument("Netsys.getsid not available"); #endif } @@ -179,7 +179,7 @@ if (r == -1) uerror("setreuid", Nothing); return Val_int(0); #else - invalid_argument("Netsys.setreuid not available"); + caml_invalid_argument("Netsys.setreuid not available"); #endif } @@ -192,7 +192,7 @@ if (r == -1) uerror("setregid", Nothing); return Val_int(0); #else - invalid_argument("Netsys.setregid not available"); + caml_invalid_argument("Netsys.setregid not available"); #endif } @@ -210,7 +210,7 @@ return Val_unit; #else - invalid_argument("Netsys_posix.initgroups not available"); + caml_invalid_argument("Netsys_posix.initgroups not available"); #endif } @@ -223,7 +223,7 @@ uerror("fsync", Nothing); return Val_unit; #else - invalid_argument("Netsys.fsync not available"); + caml_invalid_argument("Netsys.fsync not available"); #endif } @@ -240,7 +240,7 @@ uerror("fdatasync", Nothing); return Val_unit; #else - invalid_argument("Netsys.fdatasync not available"); + caml_invalid_argument("Netsys.fdatasync not available"); #endif } @@ -249,7 +249,7 @@ if (fchdir(Int_val(fd)) == -1) uerror("fchdir", Nothing); return Val_unit; #else - invalid_argument("Netsys_posix.fchdir not available"); + caml_invalid_argument("Netsys_posix.fchdir not available"); #endif } @@ -260,11 +260,11 @@ value res; d = fdopendir(Int_val(fd)); if (d == (DIR *) NULL) uerror("fdopendir", Nothing); - res = alloc_small(1, Abstract_tag); + res = caml_alloc_small(1, Abstract_tag); DIR_Val(res) = d; return res; #else - invalid_argument("Netsys_posix.fdopendir not available"); + caml_invalid_argument("Netsys_posix.fdopendir not available"); #endif } @@ -281,12 +281,12 @@ uerror("realpath", Nothing); } else { - name_out = copy_string(name_out_s); + name_out = caml_copy_string(name_out_s); free(name_out_s); } return name_out; #else - invalid_argument("Netsys_posix.realpath not available"); + caml_invalid_argument("Netsys_posix.realpath not available"); #endif } @@ -299,7 +299,7 @@ if ( e < 0 ) uerror("grantpt", Nothing); return Val_unit; #else - invalid_argument("Netsys_posix.granpt not available"); + caml_invalid_argument("Netsys_posix.granpt not available"); #endif } @@ -312,7 +312,7 @@ if ( e < 0 ) uerror("unlockpt", Nothing); return Val_unit; #else - invalid_argument("Netsys_posix.unlockpt not available"); + caml_invalid_argument("Netsys_posix.unlockpt not available"); #endif } @@ -324,9 +324,9 @@ s = ptsname(Int_val(fd)); if ( s == NULL ) uerror("ptsname", Nothing); - return copy_string(s); + return caml_copy_string(s); #else - invalid_argument("Netsys_posix.ptsname not available"); + caml_invalid_argument("Netsys_posix.ptsname not available"); #endif } @@ -348,7 +348,7 @@ if (fd == -1) uerror("openpt", Nothing); return Val_int(fd); #else - invalid_argument("Netsys_posix.posix_openpt not available"); + caml_invalid_argument("Netsys_posix.posix_openpt not available"); #endif } @@ -356,7 +356,7 @@ CAMLprim value netsys_mknod (value name, value perm, value nt) { #ifdef _WIN32 - invalid_argument("Netsys_posix.mknod not available"); + caml_invalid_argument("Netsys_posix.mknod not available"); #else mode_t m; dev_t d; @@ -473,8 +473,8 @@ char * p; /* shamelessly copied from ocaml distro */ - cv_flags = convert_flag_list(flags, open_flag_table); - clo_flags = convert_flag_list(flags, open_cloexec_table); + cv_flags = caml_convert_flag_list(flags, open_flag_table); + clo_flags = caml_convert_flag_list(flags, open_cloexec_table); if (clo_flags & CLOEXEC) cloexec = 1; else if (clo_flags & KEEPEXEC) @@ -484,12 +484,12 @@ #if defined(O_CLOEXEC) if (cloexec) cv_flags |= O_CLOEXEC; #endif - p = stat_alloc(string_length(path) + 1); + p = caml_stat_alloc(caml_string_length(path) + 1); strcpy(p, String_val(path)); - enter_blocking_section(); + caml_enter_blocking_section(); ret = openat(Int_val(dirfd), p, cv_flags, Int_val(perm)); - leave_blocking_section(); - stat_free(p); + caml_leave_blocking_section(); + caml_stat_free(p); if (ret == -1) uerror("openat", path); #if !defined(O_CLOEXEC) { @@ -500,7 +500,7 @@ #endif CAMLreturn (Val_int(ret)); #else - invalid_argument("Netsys_posix.openat not available"); + caml_invalid_argument("Netsys_posix.openat not available"); #endif } @@ -517,15 +517,15 @@ { #ifdef HAVE_AT int ret, cv_perms, cv_flags; - cv_perms = convert_flag_list(perms, access_permission_table); - cv_flags = convert_flag_list(flags, at_flags_table); + cv_perms = caml_convert_flag_list(perms, access_permission_table); + cv_flags = caml_convert_flag_list(flags, at_flags_table); cv_flags &= (AT_EACCESS | AT_SYMLINK_NOFOLLOW); ret = faccessat(Int_val(dirfd), String_val(path), cv_perms, cv_flags); if (ret == -1) uerror("faccessat", path); return Val_unit; #else - invalid_argument("Netsys_posix.faccessat not available"); + caml_invalid_argument("Netsys_posix.faccessat not available"); #endif } @@ -537,7 +537,7 @@ uerror("mkdirat", path); return Val_unit; #else - invalid_argument("Netsys_posix.mkdirat not available"); + caml_invalid_argument("Netsys_posix.mkdirat not available"); #endif } @@ -551,7 +551,7 @@ uerror("renameat", oldpath); return Val_unit; #else - invalid_argument("Netsys_posix.renameat not available"); + caml_invalid_argument("Netsys_posix.renameat not available"); #endif } @@ -561,14 +561,14 @@ { #ifdef HAVE_AT int cv_flags; - cv_flags = convert_flag_list(flags, at_flags_table); + cv_flags = caml_convert_flag_list(flags, at_flags_table); cv_flags &= AT_SYMLINK_FOLLOW; /* only allowed flag here */ if (linkat(Int_val(olddirfd), String_val(oldpath), Int_val(newdirfd), String_val(newpath), cv_flags) == -1) uerror("linkat", oldpath); return Val_unit; #else - invalid_argument("Netsys_posix.linkat not available"); + caml_invalid_argument("Netsys_posix.linkat not available"); #endif } @@ -577,13 +577,13 @@ { #ifdef HAVE_AT int cv_flags; - cv_flags = convert_flag_list(flags, at_flags_table); + cv_flags = caml_convert_flag_list(flags, at_flags_table); cv_flags &= AT_REMOVEDIR; /* only allowed flag here */ if (unlinkat(Int_val(dirfd), String_val(path), cv_flags) == -1) uerror("unlinkat", path); return Val_unit; #else - invalid_argument("Netsys_posix.unlinkat not available"); + caml_invalid_argument("Netsys_posix.unlinkat not available"); #endif } @@ -597,7 +597,7 @@ uerror("symlinkat", oldpath); return Val_unit; #else - invalid_argument("Netsys_posix.symlinkat not available"); + caml_invalid_argument("Netsys_posix.symlinkat not available"); #endif } @@ -609,7 +609,7 @@ uerror("mkfifoat", path); return Val_unit; #else - invalid_argument("Netsys_posix.mkfifoat not available"); + caml_invalid_argument("Netsys_posix.mkfifoat not available"); #endif } @@ -622,8 +622,8 @@ len = readlinkat(Int_val(dirfd), String_val(path), buffer, sizeof(buffer)-1); if (len == -1) uerror("readlinkat", path); buffer[len] = '\0'; - return copy_string(buffer); + return caml_copy_string(buffer); #else - invalid_argument("Netsys_posix.readlinkat not available"); + caml_invalid_argument("Netsys_posix.readlinkat not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c.h ocamlnet-4.1.9.patched/src/netsys/netsys_c.h --- src/netsys/netsys_c.h 2021-03-24 16:20:14 +++ src/netsys/netsys_c.h 2026-05-29 06:32:02 @@ -69,6 +69,7 @@ #include "caml/callback.h" #include "caml/bigarray.h" #include "caml/version.h" +#include "caml/unixsupport.h" #ifndef Bytes_val #define Bytes_val(x) String_val(x) @@ -103,7 +104,7 @@ int caml_page_table_add(int kind, void * start, void * end); int caml_page_table_remove(int kind, void * start, void * end); -#ifdef HAVE_NEW_MODIFY +#if defined(HAVE_NEW_MODIFY) && OCAML_VERSION < 50000 /* need full memory.h support */ @@ -171,25 +172,8 @@ /* From unixsupport.h */ /**********************************************************************/ -#define Nothing ((value) 0) - #ifdef _WIN32 -#include "caml/unixsupport.h" #define netsysw32_win_alloc_handle win_alloc_handle -#else - -/* POSIX */ - -/* Since OCaml 3.10 there is unixsupport.h, and we could also include - this file. -*/ - -extern value unix_error_of_code (int errcode); -extern void unix_error (int errcode, char * cmdname, value arg) Noreturn; -extern void uerror (char * cmdname, value arg) Noreturn; - -#define DIR_Val(v) *((DIR **) &Field(v, 0)) - #endif /**********************************************************************/ @@ -231,7 +215,9 @@ /* bigarrays */ /**********************************************************************/ +#if !defined(OCAML_VERSION) || OCAML_VERSION < 50400 extern int caml_ba_element_size[]; +#endif #endif diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_clock.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_clock.c --- src/netsys/netsys_c_clock.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_clock.c 2026-05-29 06:31:44 @@ -23,10 +23,10 @@ d = Double_val(Field(tspair,0)); if (!isfinite(d) || d < 0 || d > LONG_MAX-1) - failwith("Netsys_posix: time value out of range"); + caml_failwith("Netsys_posix: time value out of range"); n = Long_val(Field(tspair,1)); if (n < 0 || n > 999999999) - failwith("Netsys_posix: time value out of range"); + caml_failwith("Netsys_posix: time value out of range"); i = floor(d); r = floor((d - i) * 1E9); r = r + n; @@ -44,7 +44,7 @@ static value alloc_timespec_pair(double sec, long nsec) { CAMLparam0(); CAMLlocal1(tsout); - tsout = alloc(2,0); + tsout = caml_alloc(2,0); Store_field(tsout, 0, caml_copy_double(sec)); Store_field(tsout, 1, Val_long(nsec)); CAMLreturn(tsout); @@ -65,7 +65,7 @@ *out = CLOCK_MONOTONIC; break; #else - failwith("Netsys_posix: CLOCK_MONOTONIC is not supported"); + caml_failwith("Netsys_posix: CLOCK_MONOTONIC is not supported"); #endif } } @@ -98,11 +98,11 @@ tsout = alloc_timespec_pair(t_out.tv_sec, t_out.tv_nsec); Store_field(tsref, 0, tsout); - if (r == -1) unix_error(e, "nanosleep", Nothing); + if (r == -1) caml_unix_error(e, "nanosleep", Nothing); CAMLreturn(Val_unit); #else - invalid_argument("Netsys_posix.nanosleep not available"); + caml_invalid_argument("Netsys_posix.nanosleep not available"); #endif } @@ -118,13 +118,13 @@ clockid_val(clock, &c); r = clock_gettime(c, &ts); - if (r == -1) uerror("clock_gettime", Nothing); + if (r == -1) caml_uerror("clock_gettime", Nothing); tsout = alloc_timespec_pair(ts.tv_sec, ts.tv_nsec); CAMLreturn(tsout); #else - invalid_argument("Netsys_posix.clock_gettime not available"); + caml_invalid_argument("Netsys_posix.clock_gettime not available"); #endif } @@ -141,11 +141,11 @@ make_timespec(tspair, &ts); r = clock_settime(c, &ts); - if (r == -1) uerror("clock_settime", Nothing); + if (r == -1) caml_uerror("clock_settime", Nothing); CAMLreturn(Val_unit); #else - invalid_argument("Netsys_posix.clock_settime not available"); + caml_invalid_argument("Netsys_posix.clock_settime not available"); #endif } @@ -162,13 +162,13 @@ clockid_val(clock, &c); r = clock_getres(c, &ts); - if (r == -1) uerror("clock_getres", Nothing); + if (r == -1) caml_uerror("clock_getres", Nothing); tsout = alloc_timespec_pair(ts.tv_sec, ts.tv_nsec); CAMLreturn(tsout); #else - invalid_argument("Netsys_posix.clock_getres not available"); + caml_invalid_argument("Netsys_posix.clock_getres not available"); #endif } @@ -182,7 +182,7 @@ char *s; r = clock_getcpuclockid(Long_val(pid), &c); - if (r != 0) unix_error(r, "clock_getcpuclockid", Nothing); + if (r != 0) caml_unix_error(r, "clock_getcpuclockid", Nothing); v = caml_alloc_string(sizeof(clockid_t)); s = String_val(v); @@ -191,7 +191,7 @@ CAMLreturn(v); #else - invalid_argument("Netsys_posix.clock_getcpuclockid not available"); + caml_invalid_argument("Netsys_posix.clock_getcpuclockid not available"); #endif } @@ -263,7 +263,7 @@ sev.sigev_value.sival_ptr = ne; break; #else - failwith("Netsys_posix.timer_create: unsupported type of timer"); + caml_failwith("Netsys_posix.timer_create: unsupported type of timer"); #endif #endif } @@ -280,7 +280,7 @@ sev.sigev_value.sival_ptr = ne; break; #else - failwith("Netsys_posix.timer_create: unsupported type of timer"); + caml_failwith("Netsys_posix.timer_create: unsupported type of timer"); #endif case 1: /* TEXP_SIGNAL */ @@ -294,7 +294,7 @@ switch (tcase) { case 0: code = timer_create(c, &sev, &tm); - if (code == -1) uerror("timer_create", Nothing); + if (code == -1) caml_uerror("timer_create", Nothing); v = caml_alloc_string(sizeof(timer_t)); memcpy(Bytes_val(v), (char *) &tm, sizeof(timer_t)); v_timer = caml_alloc(1, 0); @@ -313,7 +313,7 @@ Store_field(v, 1, v_event); CAMLreturn(v); #else - invalid_argument("Netsys_posix.timer_create not available"); + caml_invalid_argument("Netsys_posix.timer_create not available"); #endif } @@ -346,7 +346,7 @@ Bool_val(abstime) ? TIMER_ABSTIME : 0, &it, NULL); - if (code == -1) uerror("timer_settime", Nothing); + if (code == -1) caml_uerror("timer_settime", Nothing); break; #ifdef HAVE_TIMERFD case 1: @@ -356,14 +356,14 @@ Bool_val(abstime) ? TFD_TIMER_ABSTIME : 0, &it, NULL); - if (code == -1) uerror("timerfd_settime", Nothing); + if (code == -1) caml_uerror("timerfd_settime", Nothing); break; #endif }; return Val_unit; #else - invalid_argument("Netsys_posix.timer_settime not available"); + caml_invalid_argument("Netsys_posix.timer_settime not available"); #endif } @@ -382,14 +382,14 @@ /* POSIX timer */ extract_timer(Field(Field(timer, 0), 0), &tm); code = timer_gettime(tm, &it); - if (code == -1) uerror("timer_gettime", Nothing); + if (code == -1) caml_uerror("timer_gettime", Nothing); break; #ifdef HAVE_TIMERFD case 1: /* TIMERFD */ fd = Int_val(Field(Field(timer, 0), 0)); code = timerfd_gettime(fd, &it); - if (code == -1) uerror("timerfd_gettime", Nothing); + if (code == -1) caml_uerror("timerfd_gettime", Nothing); break; #endif }; @@ -398,7 +398,7 @@ it.it_value.tv_nsec); return r; #else - invalid_argument("Netsys_posix.timer_gettime not available"); + caml_invalid_argument("Netsys_posix.timer_gettime not available"); #endif } @@ -413,7 +413,7 @@ /* POSIX timer */ extract_timer(Field(Field(timer, 0), 0), &tm); code = timer_delete(tm); - if (code == -1) uerror("timer_delete", Nothing); + if (code == -1) caml_uerror("timer_delete", Nothing); break; #ifdef HAVE_TIMERFD case 1: @@ -424,7 +424,7 @@ } return Val_unit; #else - invalid_argument("Netsys_posix.timer_delete not available"); + caml_invalid_argument("Netsys_posix.timer_delete not available"); #endif } @@ -435,9 +435,9 @@ return Field(timer,1); } else { - failwith("Netsys_posix.timer_event: timer is not connected with event"); + caml_failwith("Netsys_posix.timer_event: timer is not connected with event"); } #else - invalid_argument("Netsys_posix.timer_delete not available"); + caml_invalid_argument("Netsys_posix.timer_delete not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_event.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_event.c --- src/netsys/netsys_c_event.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_event.c 2026-05-29 06:31:44 @@ -187,24 +187,24 @@ p->allow_user_add = Bool_val(allow_user_add); #ifdef HAVE_PTHREAD x = pthread_mutex_init(&(p->mutex), NULL); - if (x != 0) unix_error(x, "pthread_mutex_init", Nothing); + if (x != 0) caml_unix_error(x, "pthread_mutex_init", Nothing); #endif #ifdef HAVE_EVENTFD p->type = NE_EVENTFD; x = eventfd(0, 0); - if (x == -1) uerror("eventfd", Nothing); + if (x == -1) caml_uerror("eventfd", Nothing); p->fd1 = x; x = fcntl(p->fd1, F_SETFD, FD_CLOEXEC); if (x == -1) { e = errno; close(p->fd1); - unix_error(e, "fcntl", Nothing); + caml_unix_error(e, "fcntl", Nothing); } #else p->type = NE_PIPE; x = pipe(pipefd); - if (x == -1) uerror("pipe", Nothing); + if (x == -1) caml_uerror("pipe", Nothing); p->fd1 = pipefd[0]; p->fd2 = pipefd[1]; x = fcntl(p->fd1, F_SETFD, FD_CLOEXEC); @@ -212,19 +212,19 @@ e = errno; close(p->fd1); close(p->fd2); - unix_error(e, "fcntl", Nothing); + caml_unix_error(e, "fcntl", Nothing); } x = fcntl(p->fd2, F_SETFD, FD_CLOEXEC); if (x == -1) { e = errno; close(p->fd1); close(p->fd2); - unix_error(e, "fcntl", Nothing); + caml_unix_error(e, "fcntl", Nothing); } #endif return r; #else - invalid_argument("Netsys_posix.create_event not available"); + caml_invalid_arggument("Netsys_posix.create_event not available"); #endif } @@ -246,13 +246,13 @@ p->type = NE_TIMERFD; x = timerfd_create(clockid, 0); - if (x == -1) uerror("timerfd_create", Nothing); + if (x == -1) caml_uerror("timerfd_create", Nothing); p->fd1 = x; x = fcntl(p->fd1, F_SETFD, FD_CLOEXEC); if (x == -1) { e = errno; close(p->fd1); - unix_error(e, "fcntl", Nothing); + caml_unix_error(e, "fcntl", Nothing); } return r; } @@ -268,17 +268,17 @@ ne = *(Not_event_val(nev)); if (ne->fd1 == -1) - failwith("Netsys_posix.set_nonblock_event: already destroyed"); + caml_failwith("Netsys_posix.set_nonblock_event: already destroyed"); x = fcntl(ne->fd1, F_GETFL, 0); - if (x == -1) uerror("fcntl", Nothing); + if (x == -1) caml_uerror("fcntl", Nothing); x = fcntl(ne->fd1, F_SETFL, x | O_NONBLOCK); - if (x == -1) uerror("fcntl", Nothing); + if (x == -1) caml_uerror("fcntl", Nothing); return Val_unit; #else - invalid_argument("Netsys_posix.set_nonblock_event not available"); + caml_invalid_argument("Netsys_posix.set_nonblock_event not available"); #endif } @@ -290,10 +290,10 @@ int fd, code; ne = *(Not_event_val(nev)); if (ne->fd1 == -1) - failwith("Netsys_posix.get_event_fd_nodup: already destroyed"); + caml_failwith("Netsys_posix.get_event_fd_nodup: already destroyed"); return Val_int(ne->fd1); #else - invalid_argument("Netsys_posix.get_event_fd not available"); + caml_invalid_argument("Netsys_posix.get_event_fd not available"); #endif } @@ -306,11 +306,11 @@ int fd; ne = *(Not_event_val(nev)); if (ne->fd1 == -1) - failwith("Netsys_posix.get_event_fd: already destroyed"); + caml_failwith("Netsys_posix.get_event_fd: already destroyed"); fd = ne->fd1; return fd; #else - invalid_argument("Netsys_posix.get_event_fd not available"); + caml_invalid_argument("Netsys_posix.get_event_fd not available"); #endif } @@ -350,15 +350,15 @@ CAMLparam1(nev); ne = *(Not_event_val(nev)); if (ne->fd1 == -1) - failwith("Netsys_posix.set_event: already destroyed"); + caml_failwith("Netsys_posix.set_event: already destroyed"); if (!ne->allow_user_add) - failwith("Netsys_posix.set_event: not allowed for this type of event"); + caml_failwith("Netsys_posix.set_event: not allowed for this type of event"); caml_enter_blocking_section(); netsys_not_event_signal(ne); caml_leave_blocking_section(); CAMLreturn(Val_unit); #else - invalid_argument("Netsys_posix.set_event not available"); + caml_invalid_argument("Netsys_posix.set_event not available"); #endif } @@ -373,7 +373,7 @@ ne = *(Not_event_val(nev)); if (ne->fd1 == -1) - failwith("Netsys_posix.wait_event: already destroyed"); + caml_failwith("Netsys_posix.wait_event: already destroyed"); caml_enter_blocking_section(); p.fd = ne->fd1; @@ -383,10 +383,10 @@ e = errno; caml_leave_blocking_section(); - if (code == -1) unix_error(e, "poll", Nothing); + if (code == -1) caml_unix_error(e, "poll", Nothing); CAMLreturn(Val_unit); #else - invalid_argument("Netsys_posix.wait_event not available"); + caml_invalid_argument("Netsys_posix.wait_event not available"); #endif } @@ -402,7 +402,7 @@ ne = *(Not_event_val(nev)); if (ne->fd1 == -1) - failwith("Netsys_posix.consume_event: already destroyed"); + caml_failwith("Netsys_posix.consume_event: already destroyed"); caml_enter_blocking_section(); @@ -426,8 +426,8 @@ caml_leave_blocking_section(); - if (code == -1) unix_error(e, "read", Nothing); - if (!ok) unix_error(EINVAL, "read (result invalid)", Nothing); + if (code == -1) caml_unix_error(e, "read", Nothing); + if (!ok) caml_unix_error(EINVAL, "read (result invalid)", Nothing); ne->state = 0; /* No need to block signals, or to use the mutex. The next signaller @@ -436,6 +436,6 @@ CAMLreturn(Val_unit); #else - invalid_argument("Netsys_posix.wait_event not available"); + caml_invalid_argument("Netsys_posix.wait_event not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_fadvise.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_fadvise.c --- src/netsys/netsys_c_fadvise.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_fadvise.c 2026-05-29 06:32:10 @@ -35,7 +35,7 @@ case 3: case 9: adv_int = POSIX_FADV_NOREUSE; break; case 4: case 10: adv_int = POSIX_FADV_WILLNEED; break; case 5: case 11: adv_int = POSIX_FADV_DONTNEED; break; - default: invalid_argument("Netsys.fadvise"); + default: caml_invalid_argument("Netsys.fadvise"); }; start_int = Int64_val(start); @@ -54,7 +54,7 @@ uerror("posix_fadvise64", Nothing); return Val_unit; #else - invalid_argument("Netsys.fadvise not available"); + caml_invalid_argument("Netsys.fadvise not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_fallocate.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_fallocate.c --- src/netsys/netsys_c_fallocate.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_fallocate.c 2026-05-29 06:31:44 @@ -28,9 +28,9 @@ len_int = Int64_val(len); if ( ((int64_t) ((off_t) start_int)) != start_int ) - failwith("Netsys.fadvise: large files not supported on this OS"); + caml_failwith("Netsys.fadvise: large files not supported on this OS"); if ( ((int64_t) ((off_t) len_int)) != len_int ) - failwith("Netsys.fadvise: large files not supported on this OS"); + caml_failwith("Netsys.fadvise: large files not supported on this OS"); start_off = start_int; len_off = len_int; @@ -38,10 +38,10 @@ r = posix_fallocate(Int_val(fd), start_off, len_off); /* does not set errno! */ if (r != 0) - unix_error(r, "posix_fallocate64", Nothing); + caml_unix_error(r, "posix_fallocate64", Nothing); return Val_unit; #else - invalid_argument("Netsys.fallocate not available"); + caml_invalid_argument("Netsys.fallocate not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_ioprio.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_ioprio.c --- src/netsys/netsys_c_ioprio.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_ioprio.c 2026-05-29 06:31:44 @@ -89,11 +89,11 @@ ioprio = ioprio_get(IOPRIO_WHO_USER, Int_val(Field(target, 0))); break; default: - failwith("netsys_ioprio_get: internal error"); + caml_failwith("netsys_ioprio_get: internal error"); } if (ioprio == -1) - uerror("ioprio_get", Nothing); + caml_uerror("ioprio_get", Nothing); ioprio_class = ioprio >> IOPRIO_CLASS_SHIFT; ioprio_data = ioprio & IOPRIO_PRIO_MASK; @@ -114,14 +114,14 @@ result = Val_long(1); break; default: - failwith("netsys_ioprio_get: Unexpected result"); + caml_failwith("netsys_ioprio_get: Unexpected result"); } return result; #else /* not ioprio_supported: */ - unix_error(ENOSYS, "ioprio_get", Nothing); + caml_unix_error(ENOSYS, "ioprio_get", Nothing); #endif /* ioprio_supported */ } @@ -145,7 +145,7 @@ ioprio_data = Int_val(Field(ioprio_arg, 0)); break; default: - failwith("netsys_ioprio_set: internal error"); + caml_failwith("netsys_ioprio_set: internal error"); } } else { switch (Long_val(ioprio_arg)) { @@ -159,7 +159,7 @@ ioprio_data = 7; break; default: - failwith("netsys_ioprio_set: internal error"); + caml_failwith("netsys_ioprio_set: internal error"); } }; @@ -176,16 +176,16 @@ sysres = ioprio_set(IOPRIO_WHO_USER, Int_val(Field(target, 0)), ioprio); break; default: - failwith("netsys_ioprio_set: internal error"); + caml_failwith("netsys_ioprio_set: internal error"); } if (sysres == -1) - uerror("ioprio_set", Nothing); + caml_uerror("ioprio_set", Nothing); return Val_unit; #else /* not ioprio_supported: */ - unix_error(ENOSYS, "ioprio_set", Nothing); + caml_unix_error(ENOSYS, "ioprio_set", Nothing); #endif /* ioprio_supported */ } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_locale.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_locale.c --- src/netsys/netsys_c_locale.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_locale.c 2026-05-29 06:31:44 @@ -39,28 +39,28 @@ old_locale = setlocale(LC_ALL, NULL); if (old_locale == NULL) - failwith("Netsys_posix.query_locale: no locale support"); - oldcopy_locale = stat_alloc(strlen(old_locale) + 1); + caml_failwith("Netsys_posix.query_locale: no locale support"); + oldcopy_locale = caml_stat_alloc(strlen(old_locale) + 1); strcpy(oldcopy_locale, old_locale); new_locale = setlocale(LC_ALL, String_val(locale)); if (new_locale == NULL) { - stat_free(oldcopy_locale); - failwith("Netsys_posix.query_locale: cannot set this locale"); + caml_stat_free(oldcopy_locale); + caml_failwith("Netsys_posix.query_locale: cannot set this locale"); } n = sizeof(locale_items_table) / sizeof(locale_items_table[0]); - s = alloc(n,0); + s = caml_alloc(n,0); for (k=0; kdata); } @@ -72,7 +72,7 @@ #ifdef HAVE_SYSCONF return Val_long(sysconf(_SC_PAGESIZE)); #else - invalid_argument("Netsys_mem.getpagesize not available"); + caml_invalid_argument("Netsys_mem.getpagesize not available"); #endif } @@ -83,8 +83,8 @@ start = (void *) Nativeint_val(addrv); length = Long_val(lenv); - return alloc_bigarray_dims(BIGARRAY_C_LAYOUT | BIGARRAY_UINT8, - 1, start, length); + return caml_ba_alloc_dims(CAML_BA_C_LAYOUT | CAML_BA_UINT8, + 1, start, length); } @@ -109,15 +109,15 @@ data = mmap(start, length, flags, MAP_PRIVATE | MAP_ANON, (-1), 0); - if (data == (void *) -1) uerror("mmap", Nothing); + if (data == (void *) -1) caml_uerror("mmap", Nothing); - r = alloc_bigarray_dims(BIGARRAY_C_LAYOUT | BIGARRAY_UINT8 | - BIGARRAY_MAPPED_FILE, - 1, data, length); + r = caml_ba_alloc_dims(CAML_BA_C_LAYOUT | CAML_BA_UINT8 | + CAML_BA_MAPPED_FILE, + 1, data, length); return r; #else - invalid_argument("Netsys_mem.alloc_memory_pages not available"); + caml_invalid_argument("Netsys_mem.alloc_memory_pages not available"); #endif } @@ -125,7 +125,7 @@ CAMLprim value netsys_zero_pages(value memv, value offsv, value lenv) { #if defined(HAVE_MMAP) && defined(HAVE_SYSCONF) && defined(MAP_ANON) && defined (MAP_FIXED) - struct caml_bigarray *mem = Bigarray_val(memv); + struct caml_ba_array *mem = Caml_ba_array_val(memv); long offs = Long_val(offsv); long len = Long_val(lenv); long pgsize = sysconf(_SC_PAGESIZE); @@ -137,17 +137,17 @@ data2 = mmap(data, len, PROT_READ|PROT_WRITE, MAP_PRIVATE | MAP_ANON | MAP_FIXED, (-1), 0); - if (data2 == (void *) -1) uerror("mmap", Nothing); + if (data2 == (void *) -1) caml_uerror("mmap", Nothing); if (((void *) data) != data2) - failwith("Netsys_mem.zero_pages assertion failed"); + caml_failwith("Netsys_mem.zero_pages assertion failed"); } } else - invalid_argument("Netsys_mem.zero_pages only for whole pages"); + caml_invalid_argument("Netsys_mem.zero_pages only for whole pages"); return Val_unit; #else - invalid_argument("Netsys_mem.zero_pages not available"); + caml_invalid_argument("Netsys_mem.zero_pages not available"); #endif } @@ -162,14 +162,14 @@ value r; e = posix_memalign(&addr, align, size); - if (e != 0) unix_error(e, "posix_memalign", Nothing); + if (e != 0) caml_unix_error(e, "posix_memalign", Nothing); - r = alloc_bigarray_dims(BIGARRAY_C_LAYOUT | BIGARRAY_UINT8 | - BIGARRAY_MANAGED, - 1, addr, size); + r = caml_ba_alloc_dims(CAML_BA_C_LAYOUT | CAML_BA_UINT8 | + CAML_BA_MANAGED, + 1, addr, size); return r; #else - invalid_argument("Netsys_mem.alloc_aligned_memory not available"); + caml_invalid_argument("Netsys_mem.alloc_aligned_memory not available"); #endif } @@ -197,7 +197,7 @@ fd = Int_val(fdv); pos0 = Int64_val(posv); if (((int64_t) ((off_t) pos0)) != pos0) - failwith("Netsys_mem: large files not supported on this OS"); + caml_failwith("Netsys_mem: large files not supported on this OS"); pos = pos0; addr = (void *) Nativeint_val(addrv); if (addr == 0) addr = NULL; @@ -206,36 +206,36 @@ pagesize = sysconf(_SC_PAGESIZE); - if (fstat(fd, &st) == -1) uerror("fstat", Nothing); + if (fstat(fd, &st) == -1) caml_uerror("fstat", Nothing); eofpos = st.st_size; if (size == -1) { if (eofpos < pos) - failwith("Netsys_mem: cannot mmap - file position exceeds file size"); + caml_failwith("Netsys_mem: cannot mmap - file position exceeds file size"); basize0 = eofpos - pos; if (((off_t) ((uintnat) basize0)) != basize0) - failwith("Netsys_mem: cannot mmap - file too large"); + caml_failwith("Netsys_mem: cannot mmap - file too large"); basize = (uintnat) basize0; } else { if (size < 0) - invalid_argument("netsys_map_file"); + caml_invalid_argument("netsys_map_file"); if (eofpos - pos < size) { if (ftruncate(fd, pos + size) == -1) - uerror("ftruncate", Nothing); + caml_uerror("ftruncate", Nothing); } basize = size; } delta = (uintnat) (pos % pagesize); eff_addr = mmap(addr, basize + delta, PROT_READ | PROT_WRITE, shared, fd, pos - delta); - if (eff_addr == (void*) MAP_FAILED) uerror("mmap", Nothing); + if (eff_addr == (void*) MAP_FAILED) caml_uerror("mmap", Nothing); eff_addr = (void *) ((uintnat) eff_addr + delta); - return alloc_bigarray_dims(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT | - BIGARRAY_MAPPED_FILE, 1, eff_addr, basize); + return caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT | + CAML_BA_MAPPED_FILE, 1, eff_addr, basize); #else - invalid_argument("Netsys_mem.memory_map_file not available"); + caml_invalid_argument("Netsys_mem.memory_map_file not available"); #endif } @@ -254,20 +254,20 @@ CAMLprim value netsys_memory_unmap_file(value memv) { - struct caml_bigarray *b = Bigarray_val(memv); - if ((b->flags & BIGARRAY_MANAGED_MASK) == BIGARRAY_MAPPED_FILE) { + struct caml_ba_array *b = Caml_ba_array_val(memv); + if ((b->flags & CAML_BA_MANAGED_MASK) == CAML_BA_MAPPED_FILE) { if (b->proxy == NULL) { ba_unmap_file(b->data, b->dim[0]); b->data = NULL; b->flags = - (b->flags & ~BIGARRAY_MANAGED_MASK) | BIGARRAY_EXTERNAL; + (b->flags & ~CAML_BA_MANAGED_MASK) | CAML_BA_EXTERNAL; } else if (b->proxy->refcount == 1) { ba_unmap_file(b->proxy->data, b->dim[0]); b->proxy->data = NULL; b->data = NULL; b->flags = - (b->flags & ~BIGARRAY_MANAGED_MASK) | BIGARRAY_EXTERNAL; + (b->flags & ~CAML_BA_MANAGED_MASK) | CAML_BA_EXTERNAL; } } return Val_unit; @@ -278,26 +278,26 @@ CAMLprim value netsys_reshape(value bv) { - struct caml_bigarray *b; - struct caml_bigarray *mem; + struct caml_ba_array *b; + struct caml_ba_array *mem; uintnat size; int i,k; CAMLparam1(bv); CAMLlocal2(memv,dimv); - b = Bigarray_val(bv); + b = Caml_ba_array_val(bv); /* We dont't have access to caml_ba_update_proxy. The workaround is to call caml_ba_reshape, and to fix the returned bigarray descriptor afterward. */ - dimv = alloc(b->num_dims,0); + dimv = caml_alloc(b->num_dims,0); for (k=0; k < b->num_dims; k++) { Store_field(dimv, k, Val_long(b->dim[k])); }; memv = caml_ba_reshape(bv, dimv); - mem = Bigarray_val(memv); + mem = Caml_ba_array_val(memv); /* Compute the size of the data area: */ size = caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; @@ -354,10 +354,14 @@ CAMLprim value netsys_set_color(value objv, value colv) { +#if OCAML_VERSION < 50000 int col; col = Int_val(colv); Hd_val(objv) = Whitehd_hd(Hd_val(objv)) | (col << 8); return Val_unit; +#else + caml_invalid_argument("Netsys_mem.set_color"); +#endif } /**********************************************************************/ @@ -375,20 +379,20 @@ #endif numbytes = Long_val(lenv); - data = ((char *) (Bigarray_val(memv)->data)) + Long_val(offv); + data = ((char *) (Caml_ba_array_val(memv)->data)) + Long_val(offv); #ifdef _WIN32 if (Descr_kind_val(fdv) == KIND_SOCKET) { SOCKET h = Socket_val(fdv); - enter_blocking_section(); + caml_enter_blocking_section(); ret = recv(h, data, numbytes, 0); if (ret == SOCKET_ERROR) err = WSAGetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); ret = n; } else { HANDLE h = Handle_val(fdv); - enter_blocking_section(); + caml_enter_blocking_section(); if (! ReadFile(h, data, numbytes, &n, NULL)) err = GetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); ret = n; } if (err) { @@ -396,11 +400,11 @@ ret = -1; } #else - enter_blocking_section(); + caml_enter_blocking_section(); ret = read(Int_val(fdv), data, (int) numbytes); - leave_blocking_section(); /* keeps errno intact */ + caml_leave_blocking_section(); /* keeps errno intact */ #endif - if (ret == -1) uerror("mem_read", Nothing); + if (ret == -1) caml_uerror("mem_read", Nothing); return Val_long(ret); } @@ -416,20 +420,20 @@ #endif numbytes = Long_val(lenv); - data = ((char *) (Bigarray_val(memv)->data)) + Long_val(offv); + data = ((char *) (Caml_ba_array_val(memv)->data)) + Long_val(offv); #ifdef _WIN32 if (Descr_kind_val(fdv) == KIND_SOCKET) { SOCKET h = Socket_val(fdv); - enter_blocking_section(); + caml_enter_blocking_section(); ret = send(h, data, numbytes, 0); if (ret == SOCKET_ERROR) err = WSAGetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); ret = n; } else { HANDLE h = Handle_val(fdv); - enter_blocking_section(); + caml_enter_blocking_section(); if (! WriteFile(h, data, numbytes, &n, NULL)) err = GetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); ret = n; } if (err) { @@ -437,11 +441,11 @@ ret = -1; } #else - enter_blocking_section(); + caml_enter_blocking_section(); ret = write(Int_val(fdv), data, (int) numbytes); - leave_blocking_section(); + caml_leave_blocking_section(); #endif - if (ret == -1) uerror("mem_write", Nothing); + if (ret == -1) caml_uerror("mem_write", Nothing); return Val_long(ret); } @@ -466,8 +470,8 @@ #endif numbytes = Long_val(lenv); - data = ((char *) (Bigarray_val(memv)->data)) + Long_val(offv); - flags = convert_flag_list(flagsv, msg_flag_table); + data = ((char *) (Caml_ba_array_val(memv)->data)) + Long_val(offv); + flags = caml_convert_flag_list(flagsv, msg_flag_table); #ifdef _WIN32 s = Socket_val(fdv); @@ -475,18 +479,18 @@ s = Int_val(fdv); #endif - enter_blocking_section(); + caml_enter_blocking_section(); ret = recv(s, data, (int) numbytes, flags); #ifdef _WIN32 if (ret == -1) err = WSAGetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); if (ret == -1) win32_maperr(err); #else - leave_blocking_section(); + caml_leave_blocking_section(); #endif - if (ret == -1) uerror("mem_recv", Nothing); + if (ret == -1) caml_uerror("mem_recv", Nothing); return Val_long(ret); } @@ -506,8 +510,8 @@ #endif numbytes = Long_val(lenv); - data = ((char *) (Bigarray_val(memv)->data)) + Long_val(offv); - flags = convert_flag_list(flagsv, msg_flag_table); + data = ((char *) (Caml_ba_array_val(memv)->data)) + Long_val(offv); + flags = caml_convert_flag_list(flagsv, msg_flag_table); #ifdef _WIN32 s = Socket_val(fdv); @@ -515,18 +519,18 @@ s = Int_val(fdv); #endif - enter_blocking_section(); + caml_enter_blocking_section(); ret = send(s, data, (int) numbytes, flags); #ifdef _WIN32 if (ret == -1) err = WSAGetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); if (ret == -1) win32_maperr(err); #else - leave_blocking_section(); + caml_leave_blocking_section(); #endif - if (ret == -1) uerror("mem_send", Nothing); + if (ret == -1) caml_uerror("mem_send", Nothing); return Val_long(ret); } @@ -537,44 +541,48 @@ CAMLprim value netsys_as_value(value memv, value offv) { - struct caml_bigarray *b = Bigarray_val(memv); +#if OCAML_VERSION < 50000 + struct caml_ba_array *b = Caml_ba_array_val(memv); return (value) (b->data + Long_val(offv)); +#else + caml_invalid_argument("Netsys_mem.as_value"); +#endif } CAMLprim value netsys_value_area_add(value memv) { -#ifdef FANCY_PAGE_TABLES - struct caml_bigarray *b = Bigarray_val(memv); +#if defined(FANCY_PAGE_TABLES) && OCAML_VERSION < 50000 + struct caml_ba_array *b = Caml_ba_array_val(memv); int code; code = caml_page_table_add(In_static_data, b->data, b->data + b->dim[0]); if (code != 0) - failwith("Netsys_mem.value_area: error"); + caml_failwith("Netsys_mem.value_area: error"); return Val_unit; #else - invalid_argument("Netsys_mem.value_area"); + caml_invalid_argument("Netsys_mem.value_area"); #endif } CAMLprim value netsys_value_area_remove(value memv) { -#ifdef FANCY_PAGE_TABLES - struct caml_bigarray *b = Bigarray_val(memv); +#if defined(FANCY_PAGE_TABLES) && OCAML_VERSION < 50000 + struct caml_ba_array *b = Caml_ba_array_val(memv); caml_page_table_remove(In_static_data, b->data, b->data + b->dim[0]); /* Silently ignore errors... */ return Val_unit; #else - invalid_argument("Netsys_mem.value_area"); + caml_invalid_argument("Netsys_mem.value_area"); #endif } CAMLprim value netsys_init_header(value memv, value offv, value tagv, value sizev) { - struct caml_bigarray *b = Bigarray_val(memv); + struct caml_ba_array *b = Caml_ba_array_val(memv); intnat off = Long_val(offv); intnat size = Long_val(sizev); int tag = Int_val(tagv); @@ -582,10 +590,10 @@ #ifdef ARCH_SIXTYFOUR if (off % 8 != 0) - invalid_argument("Netsys_mem.init_header"); + caml_invalid_argument("Netsys_mem.init_header"); #else if (off % 4 != 0) - invalid_argument("Netsys_mem.init_header"); + caml_invalid_argument("Netsys_mem.init_header"); #endif m = (value *) (((char *) b->data) + off); @@ -619,7 +627,7 @@ CAMLprim value netsys_init_string(value memv, value offv, value lenv) { - struct caml_bigarray *b = Bigarray_val(memv); + struct caml_ba_array *b = Caml_ba_array_val(memv); intnat off = Long_val(offv); intnat len = Long_val(lenv); value *m; @@ -629,10 +637,10 @@ #ifdef ARCH_SIXTYFOUR if (off % 8 != 0) - invalid_argument("Netsys_mem.init_string"); + caml_invalid_argument("Netsys_mem.init_string"); #else if (off % 4 != 0) - invalid_argument("Netsys_mem.init_string"); + caml_invalid_argument("Netsys_mem.init_string"); #endif m = (value *) (((char *) b->data) + off); @@ -650,6 +658,8 @@ } +#if OCAML_VERSION < 50000 + struct named_custom_ops { char *name; void *ops; @@ -999,14 +1009,14 @@ size_t size = 1; size_t size_aligned; size_t size_words; - b_work = Bigarray_val(work); - b_copy = Bigarray_val(copy); + b_work = Caml_ba_array_val(work); + b_copy = Caml_ba_array_val(copy); for (i = 0; i < b_work->num_dims; i++) { size = size * b_work->dim[i]; }; size = size * - caml_ba_element_size[b_work->flags & BIGARRAY_KIND_MASK]; + caml_ba_element_size[b_work->flags & CAML_BA_KIND_MASK]; size_aligned = size; if (size%sizeof(void *) != 0) @@ -1035,7 +1045,7 @@ dest_cur += size_aligned; } else if (!simulation) { data_header = NULL; - data_copy = stat_alloc(size_aligned); + data_copy = caml_stat_alloc(size_aligned); }; if (!simulation) { @@ -1197,8 +1207,8 @@ if (netsys_queue_size(stat_queue) > 256) netsys_queue_free(stat_queue); } +#endif - value netsys_init_value(value memv, value offv, value orig, @@ -1208,6 +1218,7 @@ value cc ) { +#if OCAML_VERSION < 50000 int code; value r; intnat start_offset, bytelen; @@ -1254,16 +1265,16 @@ old_ops = ops; pair = Field(target_custom_ops,0); ops = (struct named_custom_ops*) - stat_alloc(sizeof(struct named_custom_ops)); - ops->name = stat_alloc(caml_string_length(Field(pair,0))+1); + caml_stat_alloc(sizeof(struct named_custom_ops)); + ops->name = caml_stat_alloc(caml_string_length(Field(pair,0))+1); strcmp(ops->name, String_val(Field(pair,0))); ops->ops = (void *) Nativeint_val(Field(pair,1)); ops->next = old_ops; target_custom_ops = Field(target_custom_ops,1); }; - mem_data = ((char *) Bigarray_val(memv)->data) + off; - mem_end = mem_data + Bigarray_val(memv)->dim[0]; + mem_data = ((char *) Caml_ba_array_val(memv)->data) + off; + mem_end = mem_data + Caml_ba_array_val(memv)->dim[0]; /* note: the color of the new values does not matter because bigarrays are ignored by the GC. So we pass 0 (white). @@ -1287,8 +1298,8 @@ while (ops != NULL) { next_ops = ops->next; - stat_free(ops->name); - stat_free(ops); + caml_stat_free(ops->name); + caml_stat_free(ops); ops = next_ops; }; @@ -1304,17 +1315,20 @@ switch(code) { case (-1): - unix_error(errno, "netsys_init_value", Nothing); + caml_unix_error(errno, "netsys_init_value", Nothing); case (-2): #ifdef DEBUG fprintf(stderr, "Lib err\n"); #endif - failwith("Netsys_mem.init_value: Library error"); + caml_failwith("Netsys_mem.init_value: Library error"); case (-4): caml_raise_constant(*caml_named_value("Netsys_mem.Out_of_space")); default: - failwith("Netsys_mem.init_value: Unknown error"); + caml_failwith("Netsys_mem.init_value: Unknown error"); } +#else + caml_invalid_argument("Netsys_mem.init_value"); +#endif } @@ -1344,6 +1358,7 @@ value netsys_copy_value(value flags, value orig) { +#if OCAML_VERSION < 50000 int code; int cflags; intnat start_offset, bytelen; @@ -1389,8 +1404,8 @@ */ bigarray_ops.name = BIGARRAY_MARSHAL_ID; bigarray_ops.ops = - Custom_ops_val(alloc_bigarray_dims(CAML_BA_UINT8 | BIGARRAY_C_LAYOUT, - 1, NULL, 1)); + Custom_ops_val(caml_ba_alloc_dims(CAML_BA_UINT8 | CAML_BA_C_LAYOUT, + 1, NULL, 1)); bigarray_ops.next = &int32_ops; int32_ops.name = "_i"; @@ -1490,38 +1505,45 @@ switch(code) { case (-1): - unix_error(errno, "netsys_copy_value", Nothing); + caml_unix_error(errno, "netsys_copy_value", Nothing); case (-2): - failwith("Netsys_mem.copy_value: Library error"); + caml_failwith("Netsys_mem.copy_value: Library error"); case (-4): caml_raise_constant(*caml_named_value("Netsys_mem.Out_of_space")); default: - failwith("Netsys_mem.copy_value: Unknown error"); + caml_failwith("Netsys_mem.copy_value: Unknown error"); } +#else + caml_invalid_argument("Netsys_mem.copy_value"); +#endif } value netsys_get_custom_ops (value v) { +#if OCAML_VERSION < 50000 struct custom_operations *custom_ops; CAMLparam1(v); CAMLlocal1(r); if (Is_block(v) && Tag_val(v) == Custom_tag) { custom_ops = Custom_ops_val(v); - r = alloc_small(2,0); + r = caml_alloc_small(2,0); Field(r,0) = caml_copy_string(custom_ops->identifier); Field(r,1) = caml_copy_nativeint((intnat) custom_ops); } else - invalid_argument("Netsys_mem.get_custom_ops"); + caml_invalid_argument("Netsys_mem.get_custom_ops"); CAMLreturn(r); +#else + caml_invalid_argument("Netsys_mem.get_custom_ops"); +#endif } value netsys_is_bigarray(value v) { - struct custom_operations *custom_ops; + const struct custom_operations *custom_ops; CAMLparam1(v); CAMLlocal1(r); diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_multicast.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_multicast.c --- src/netsys/netsys_c_multicast.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_multicast.c 2026-05-29 06:31:44 @@ -43,7 +43,7 @@ return PF_INET6; #endif default: - invalid_argument("Not an Internet socket"); + caml_invalid_argument("Not an Internet socket"); } return 0; @@ -77,7 +77,7 @@ #endif #endif default: - invalid_argument("Netsys.mcast_set_loop"); + caml_invalid_argument("Netsys.mcast_set_loop"); }; if (r == -1) @@ -93,7 +93,7 @@ #ifdef _WIN32 if (Descr_kind_val(fd) != KIND_SOCKET) - invalid_argument("Netsys.mcast_set_ttl"); + caml_invalid_argument("Netsys.mcast_set_ttl"); fd_sock = Socket_val(fd); #else fd_sock = Int_val(fd); @@ -123,7 +123,7 @@ #endif #endif default: - invalid_argument("Netsys.mcast_set_ttl"); + caml_invalid_argument("Netsys.mcast_set_ttl"); }; if (r == -1) @@ -141,7 +141,7 @@ #ifdef _WIN32 if (Descr_kind_val(fd) != KIND_SOCKET) - invalid_argument("Netsys.mcast_add_membership"); + caml_invalid_argument("Netsys.mcast_add_membership"); fd_sock = Socket_val(fd); #else fd_sock = Int_val(fd); @@ -154,8 +154,8 @@ #ifdef IP_ADD_MEMBERSHIP case PF_INET: { struct ip_mreq mreq; - if (string_length(group_addr) != 4 || string_length(if_addr) != 4 ) - invalid_argument("Netsys.mcast_add_membership: Not an IPV4 address"); + if (caml_string_length(group_addr) != 4 || caml_string_length(if_addr) != 4 ) + caml_invalid_argument("Netsys.mcast_add_membership: Not an IPV4 address"); memcpy(&mreq.imr_multiaddr, &GET_INET_ADDR(group_addr), 4); @@ -173,8 +173,8 @@ #ifdef IPV6_ADD_MEMBERSHIP case PF_INET6: { struct ipv6_mreq mreq; - if (string_length(group_addr) != 16 || string_length(if_addr) != 16 ) - invalid_argument("Netsys.mcast_add_membership: Not an IPV6 address"); + if (caml_string_length(group_addr) != 16 || caml_string_length(if_addr) != 16 ) + caml_invalid_argument("Netsys.mcast_add_membership: Not an IPV6 address"); memcpy(&mreq.ipv6mr_multiaddr, &GET_INET6_ADDR(group_addr), 16); @@ -193,7 +193,7 @@ #endif #endif default: - invalid_argument("Netsys.mcast_add_membership"); + caml_invalid_argument("Netsys.mcast_add_membership"); }; if (r == -1) uerror("setsockopt",Nothing); @@ -210,7 +210,7 @@ #ifdef _WIN32 if (Descr_kind_val(fd) != KIND_SOCKET) - invalid_argument("Netsys.mcast_drop_membership"); + caml_invalid_argument("Netsys.mcast_drop_membership"); fd_sock = Socket_val(fd); #else fd_sock = Int_val(fd); @@ -223,8 +223,8 @@ #ifdef IP_DROP_MEMBERSHIP case PF_INET: { struct ip_mreq mreq; - if (string_length(group_addr) != 4 || string_length(if_addr) != 4 ) - invalid_argument("Netsys.mcast_drop_membership: Not an IPV4 address"); + if (caml_string_length(group_addr) != 4 || caml_string_length(if_addr) != 4 ) + caml_invalid_argument("Netsys.mcast_drop_membership: Not an IPV4 address"); memcpy(&mreq.imr_multiaddr, &GET_INET_ADDR(group_addr), 4); @@ -242,8 +242,8 @@ #ifdef IPV6_DROP_MEMBERSHIP case PF_INET6: { struct ipv6_mreq mreq; - if (string_length(group_addr) != 16 || string_length(if_addr) != 16 ) - invalid_argument("Netsys.mcast_drop_membership: Not an IPV6 address"); + if (caml_string_length(group_addr) != 16 || caml_string_length(if_addr) != 16 ) + caml_invalid_argument("Netsys.mcast_drop_membership: Not an IPV6 address"); memcpy(&mreq.ipv6mr_multiaddr, &GET_INET6_ADDR(group_addr), 16); @@ -262,7 +262,7 @@ #endif #endif default: - invalid_argument("Netsys.mcast_drop_membership"); + caml_invalid_argument("Netsys.mcast_drop_membership"); }; if (r == -1) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_outofheap.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_outofheap.c --- src/netsys/netsys_c_outofheap.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_outofheap.c 2026-05-29 06:31:44 @@ -9,7 +9,7 @@ #include "netsys_c.h" -#ifdef HAVE_NEW_MODIFY +#if defined(HAVE_NEW_MODIFY) && OCAML_VERSION < 50000 /* implies FANCY_PAGE_TABLES */ diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_poll.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_poll.c --- src/netsys/netsys_c_poll.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_poll.c 2026-05-29 06:31:44 @@ -75,7 +75,7 @@ }; return s; #else - invalid_argument("netsys_mk_poll_mem"); + caml_invalid_argument("netsys_mk_poll_mem"); #endif } @@ -89,7 +89,7 @@ (*(Poll_mem_val(s)))[Int_val(k)] = p; return Val_unit; #else - invalid_argument("netsys_set_poll_mem"); + caml_invalid_argument("netsys_set_poll_mem"); #endif } @@ -106,7 +106,7 @@ Store_field(triple, 2, Val_int(p.revents)); return triple; #else - invalid_argument("netsys_get_poll_mem"); + caml_invalid_argument("netsys_get_poll_mem"); #endif } @@ -120,7 +120,7 @@ memmove(p2 + Int_val(k2), p1 + Int_val(k1), l*sizeof(struct pollfd)); return Val_unit; #else - invalid_argument("netsys_blit_poll_mem"); + caml_invalid_argument("netsys_blit_poll_mem"); #endif }; @@ -148,15 +148,15 @@ n = Int_val(nv); tmo = Long_val(tv); - enter_blocking_section(); + caml_enter_blocking_section(); r = poll(p, n, tmo); - leave_blocking_section(); + caml_leave_blocking_section(); - if (r == -1) uerror("poll", Nothing); + if (r == -1) caml_uerror("poll", Nothing); return Val_int(r); #else - invalid_argument("netsys_poll"); + caml_invalid_argument("netsys_poll"); #endif } @@ -224,12 +224,12 @@ #ifdef USABLE_EPOLL fd = epoll_create(128); - if (fd == -1) uerror("epoll_create", Nothing); + if (fd == -1) caml_uerror("epoll_create", Nothing); code = fcntl(fd, F_SETFD, FD_CLOEXEC); if (code == -1) { e = errno; close(fd); - unix_error(e, "fcntl", Nothing); + caml_unix_error(e, "fcntl", Nothing); }; r = alloc_poll_aggreg(); pa = *(Poll_aggreg_val(r)); @@ -243,14 +243,14 @@ if (cancel_fd == -1) { e = errno; close(fd); - unix_error(e, "eventfd", Nothing); + caml_unix_error(e, "eventfd", Nothing); }; code = fcntl(cancel_fd, F_SETFD, FD_CLOEXEC); if (code == -1) { e = errno; close(fd); close(cancel_fd); - unix_error(e, "fcntl", Nothing); + caml_unix_error(e, "fcntl", Nothing); }; ee.events = EPOLLIN; /* not oneshot! */ ee.data.u64 = 1; /* reserved value */ @@ -259,14 +259,14 @@ e = errno; close(fd); close(cancel_fd); - unix_error(e, "epoll_ctl (ADD)", Nothing); + caml_unix_error(e, "epoll_ctl (ADD)", Nothing); }; pa->cancel_fd = cancel_fd; }; #endif return r; #else - invalid_argument("Netsys_posix.create_event_aggregator not available"); + caml_invalid_argument("Netsys_posix.create_event_aggregator not available"); #endif } @@ -279,14 +279,14 @@ pa = *(Poll_aggreg_val(pav)); code = close(pa->fd); - if (code == -1) uerror("close", Nothing); + if (code == -1) caml_uerror("close", Nothing); if (pa->cancel_fd >= 0) { code = close(pa->cancel_fd); - if (code == -1) uerror("close", Nothing); + if (code == -1) caml_uerror("close", Nothing); }; return Val_unit; #else - invalid_argument("Netsys_posix.destroy_event_aggregator not available"); + caml_invalid_argument("Netsys_posix.destroy_event_aggregator not available"); #endif } @@ -299,7 +299,7 @@ pa = *(Poll_aggreg_val(pav)); return Val_int(pa->fd); #else - invalid_argument("Netsys_posix.event_aggregator_fd not available"); + caml_invalid_argument("Netsys_posix.event_aggregator_fd not available"); #endif } @@ -348,12 +348,12 @@ translate_to_epoll_events(Int_val(Field(pushv, 2))) | EPOLLONESHOT; ee.data.u64 = Long_val(Field(pushv, 0)) << 1; code = epoll_ctl(pa->fd, EPOLL_CTL_ADD, fd, &ee); - if (code == -1) uerror("epoll_ctl (ADD)", Nothing); + if (code == -1) caml_uerror("epoll_ctl (ADD)", Nothing); #endif return Val_unit; #else - invalid_argument("Netsys_posix.add_event_source not available"); + caml_invalid_argument("Netsys_posix.add_event_source not available"); #endif } @@ -373,12 +373,12 @@ #ifdef USABLE_EPOLL code = epoll_ctl(pa->fd, EPOLL_CTL_DEL, fd, &ee); - if (code == -1) uerror("epoll_ctl (DEL)", Nothing); + if (code == -1) caml_uerror("epoll_ctl (DEL)", Nothing); #endif return Val_unit; #else - invalid_argument("Netsys_posix.del_event_source not available"); + caml_invalid_argument("Netsys_posix.del_event_source not available"); #endif } @@ -394,11 +394,11 @@ int n; buf = 1; n = write(pa->cancel_fd, (char *) &buf, 8); - if (n == -1) uerror("write", Nothing); + if (n == -1) caml_uerror("write", Nothing); }; return Val_unit; #else - invalid_argument("Netsys_posix.interrupt_event_aggregator not available"); + caml_invalid_argument("Netsys_posix.interrupt_event_aggregator not available"); #endif } @@ -427,12 +427,12 @@ EPOLLONESHOT; ee.data.u64 = Long_val(Field(v_pushlist_hd, 0)) << 1; code = epoll_ctl(pa->fd, EPOLL_CTL_MOD, fd, &ee); - if (code == -1) uerror("epoll_ctl (MOD)", Nothing); + if (code == -1) caml_uerror("epoll_ctl (MOD)", Nothing); #endif }; return Val_unit; #else - invalid_argument("Netsys_posix.push_event_sources not available"); + caml_invalid_argument("Netsys_posix.push_event_sources not available"); #endif } @@ -459,7 +459,7 @@ code = epoll_wait(pa->fd, ee, EPOLL_NUM, tmo); e = errno; caml_leave_blocking_section(); - if (code == -1) unix_error(e, "epoll_wait", Nothing); + if (code == -1) caml_unix_error(e, "epoll_wait", Nothing); r = Val_int(0); for (k=0; kcancel_fd, (char *) &buf, 8); - if (n == -1) unix_error(errno, "read", Nothing); + if (n == -1) caml_unix_error(errno, "read", Nothing); } else { r_item = caml_alloc(3,0); @@ -486,6 +486,6 @@ CAMLreturn(r); #else - invalid_argument("Netsys_posix.pull_event_sources not available"); + caml_invalid_argument("Netsys_posix.pull_event_sources not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_sem.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_sem.c --- src/netsys/netsys_c_sem.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_sem.c 2026-05-29 06:31:44 @@ -120,16 +120,16 @@ int flags; init = Long_val(initv); - flags = convert_flag_list(flagsv, sem_open_flag_table); + flags = caml_convert_flag_list(flagsv, sem_open_flag_table); s = sem_open(String_val(namev), flags, Int_val(modev), init); - if (s == (sem_t *) SEM_FAILED) uerror("sem_open", namev); + if (s == (sem_t *) SEM_FAILED) caml_uerror("sem_open", namev); r = alloc_sem_block(s, 1); return r; #else - invalid_argument("Netsys.sem_open not available"); + caml_invalid_argument("Netsys.sem_open not available"); #endif } @@ -141,13 +141,13 @@ sb = Sem_block_val(srv); if (sb->sem_ptr == NULL) - invalid_argument ("Netsys.sem_close: stale semaphore"); + caml_invalid_argument ("Netsys.sem_close: stale semaphore"); code = sem_close(sb->sem_ptr); - if (code == -1) uerror("sem_close", Nothing); + if (code == -1) caml_uerror("sem_close", Nothing); sb->sem_ptr = NULL; return Val_unit; #else - invalid_argument("Netsys.sem_close not available"); + caml_invalid_argument("Netsys.sem_close not available"); #endif } @@ -156,10 +156,10 @@ #ifdef HAVE_POSIX_SEM_NAMED int code; code = sem_unlink(String_val(namev)); - if (code == -1) uerror("sem_unlink", Nothing); + if (code == -1) caml_uerror("sem_unlink", Nothing); return Val_unit; #else - invalid_argument("Netsys.sem_unlink not available"); + caml_invalid_argument("Netsys.sem_unlink not available"); #endif } @@ -175,13 +175,13 @@ value r; init = Long_val(initv); - s = (sem_t *) (((char *) Bigarray_val(memv)->data) + Long_val(posv)); + s = (sem_t *) (((char *) Caml_ba_array_val(memv)->data) + Long_val(posv)); code = sem_init(s, Bool_val(psharedv), init); - if (code == -1) uerror("sem_init", Nothing); + if (code == -1) caml_uerror("sem_init", Nothing); r = alloc_sem_block(s, 0); return r; #else - invalid_argument("Netsys.sem_init not available"); + caml_invalid_argument("Netsys.sem_init not available"); #endif } @@ -192,11 +192,11 @@ sem_t *s; value r; - s = (sem_t *) (((char *) Bigarray_val(memv)->data) + Long_val(posv)); + s = (sem_t *) (((char *) Caml_ba_array_val(memv)->data) + Long_val(posv)); r = alloc_sem_block(s, 0); return r; #else - invalid_argument("Netsys.as_sem not available"); + caml_invalid_argument("Netsys.as_sem not available"); #endif } @@ -209,13 +209,13 @@ sb = Sem_block_val(srv); if (sb->sem_ptr == NULL) - invalid_argument ("Netsys.sem_destroy: stale semaphore"); + caml_invalid_argument ("Netsys.sem_destroy: stale semaphore"); code = sem_destroy(sb->sem_ptr); - if (code == -1) uerror("sem_destroy", Nothing); + if (code == -1) caml_uerror("sem_destroy", Nothing); sb->sem_ptr = NULL; return Val_unit; #else - invalid_argument("Netsys.sem_destroy not available"); + caml_invalid_argument("Netsys.sem_destroy not available"); #endif } @@ -229,16 +229,16 @@ sb = Sem_block_val(srv); if (sb->sem_ptr == NULL) - invalid_argument ("Netsys.sem_getvalue: stale semaphore"); + caml_invalid_argument ("Netsys.sem_getvalue: stale semaphore"); code = sem_getvalue(sb->sem_ptr, &sval); - if (code == -1) uerror("sem_getvalue", Nothing); + if (code == -1) caml_uerror("sem_getvalue", Nothing); if (sval < 0) sval = 0; #ifndef ARCH_SIXTYFOUR - if (sval > 1073741823) unix_error(EINVAL, "sem_getvalue", Nothing); + if (sval > 1073741823) caml_unix_error(EINVAL, "sem_getvalue", Nothing); #endif return Val_int(sval); #else - invalid_argument("Netsys.sem_getvalue not available"); + caml_invalid_argument("Netsys.sem_getvalue not available"); #endif } @@ -250,12 +250,12 @@ sb = Sem_block_val(srv); if (sb->sem_ptr == NULL) - invalid_argument ("Netsys.sem_post: stale semaphore"); + caml_invalid_argument ("Netsys.sem_post: stale semaphore"); code = sem_post(sb->sem_ptr); - if (code == -1) uerror("sem_post", Nothing); + if (code == -1) caml_uerror("sem_post", Nothing); return Val_unit; #else - invalid_argument("Netsys.sem_post not available"); + caml_invalid_argument("Netsys.sem_post not available"); #endif } @@ -270,19 +270,19 @@ sb = Sem_block_val(srv); if (sb->sem_ptr == NULL) - invalid_argument ("Netsys.sem_wait: stale semaphore"); + caml_invalid_argument ("Netsys.sem_wait: stale semaphore"); tag = Int_val(bv); s = sb->sem_ptr; - enter_blocking_section(); + caml_enter_blocking_section(); if (tag == 0) code = sem_wait(s); else code = sem_trywait(s); - leave_blocking_section(); - if (code == -1) uerror("sem_wait", Nothing); + caml_leave_blocking_section(); + if (code == -1) caml_uerror("sem_wait", Nothing); return Val_unit; #else - invalid_argument("Netsys.sem_wait not available"); + caml_invalid_argument("Netsys.sem_wait not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_shm.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_shm.c --- src/netsys/netsys_c_shm.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_shm.c 2026-05-29 06:31:44 @@ -36,15 +36,15 @@ int ret, cv_flags; char * p; - cv_flags = convert_flag_list(flags, shm_open_flag_table); - p = stat_alloc(string_length(path) + 1); + cv_flags = caml_convert_flag_list(flags, shm_open_flag_table); + p = caml_stat_alloc(caml_string_length(path) + 1); strcpy(p, String_val(path)); ret = shm_open(p, cv_flags, Int_val(perm)); - stat_free(p); + caml_stat_free(p); if (ret == -1) uerror("shm_open", path); CAMLreturn (Val_int(ret)); #else - invalid_argument("Netsys.shm_open not available"); + caml_invalid_argument("Netsys.shm_open not available"); #endif } @@ -58,7 +58,7 @@ if (ret == -1) uerror("shm_unlink", path); return Val_unit; #else - invalid_argument("Netsys.shm_unlink not available"); + caml_invalid_argument("Netsys.shm_unlink not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_spawn.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_spawn.c --- src/netsys/netsys_c_spawn.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_spawn.c 2026-05-29 06:31:44 @@ -112,15 +112,15 @@ In the calling process, the mask is reset below at [exit]. */ code = sigfillset(&mask); - if (code == -1) unix_error(EINVAL, "netsys_spawn/sigfillset [000]", + if (code == -1) caml_unix_error(EINVAL, "netsys_spawn/sigfillset [000]", Nothing); #ifdef HAVE_PTHREAD code = pthread_sigmask(SIG_SETMASK, &mask, &save_mask); - if (code != 0) unix_error(code, "netsys_spawn/pthread_sigmask [001]", + if (code != 0) caml_unix_error(code, "netsys_spawn/pthread_sigmask [001]", Nothing); #else code = sigprocmask(SIG_SETMASK, &mask, &save_mask); - if (code == -1) uerror("netsys_spawn/sigprocmask [002]", Nothing); + if (code == -1) caml_uerror("netsys_spawn/sigprocmask [002]", Nothing); #endif memcpy(&spawn_mask, &save_mask, sizeof(sigset_t)); @@ -357,8 +357,8 @@ /* exec the new program: */ code = execve(String_val(v_cmd), - sub_argv, - sub_env); + (char * const *) sub_argv, + (char * const *) sub_env); if (code == -1) SUB_ERROR(errno, "netsys_spawn/execve [290]"); SUB_ERROR(EINVAL, "netsys_spawn/assert_execve [291]"); @@ -473,11 +473,11 @@ } if (uerror_errno != 0) - unix_error(uerror_errno, uerror_function, Nothing); + caml_unix_error(uerror_errno, uerror_function, Nothing); return return_value; #else - invalid_argument("netsys_spawn"); + caml_invalid_argument("netsys_spawn"); #endif } @@ -614,7 +614,7 @@ flags |= POSIX_SPAWN_SETPGROUP; break; case 2: /* Pg_new_fg_group */ - invalid_argument + caml_invalid_argument ("Netsys_posix.posix_spawn: Pg_new_fg_group not supported"); break; default: @@ -638,7 +638,7 @@ flags |= POSIX_SPAWN_SETSIGDEF; break; case 1: /* Sig_ignore */ - invalid_argument + caml_invalid_argument ("Netsys_posix.posix_spawn: Sig_ignore not supported"); break; case 2: /* Sig_mask */ @@ -800,15 +800,15 @@ }; if (uerror_errno != 0) - unix_error(uerror_errno, uerror_function, Nothing); + caml_unix_error(uerror_errno, uerror_function, Nothing); if (use_fork_exec != 0) - failwith("USE_FORK_EXEC"); + caml_failwith("USE_FORK_EXEC"); return return_value; #else - invalid_argument("netsys_posix_spawn not available"); + caml_invalid_argument("netsys_posix_spawn not available"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_c_subprocess.c ocamlnet-4.1.9.patched/src/netsys/netsys_c_subprocess.c --- src/netsys/netsys_c_subprocess.c 2021-03-24 16:20:14 +++ src/netsys/netsys_c_subprocess.c 2026-05-29 06:31:44 @@ -282,7 +282,7 @@ (struct sigchld_atom *) malloc(sigchld_list_len * sizeof(struct sigchld_atom)); if (sigchld_list == NULL) - failwith("Cannot allocate memory"); + caml_failwith("Cannot allocate memory"); for (k=0; kauto_close = Bool_val(flag); return Val_unit; #else - invalid_argument("netsys_set_auto_close_event_proxy"); + caml_invalid_argument("netsys_set_auto_close_event_proxy"); #endif } @@ -276,7 +276,7 @@ return Val_unit; #else - invalid_argument("netsys_set_event"); + caml_invalid_argument("netsys_set_event"); #endif } @@ -292,7 +292,7 @@ return Val_unit; #else - invalid_argument("netsys_reset_event"); + caml_invalid_argument("netsys_reset_event"); #endif } @@ -312,7 +312,7 @@ return Val_bool(n == WAIT_OBJECT_0); #else - invalid_argument("netsys_test_event"); + caml_invalid_argument("netsys_test_event"); #endif } @@ -331,10 +331,10 @@ }; e = event_val(ev); - enter_blocking_section(); + caml_enter_blocking_section(); n = WaitForSingleObject(e->ev, wtmo); err = GetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); if (n == WAIT_FAILED) { win32_maperr(err); uerror("netsys_event_wait/WaitForSingleObject", Nothing); @@ -342,7 +342,7 @@ return Val_bool(n == WAIT_OBJECT_0); #else - invalid_argument("netsys_event_wait"); + caml_invalid_argument("netsys_event_wait"); #endif } @@ -353,7 +353,7 @@ e = event_val(ev); return netsysw32_win_alloc_handle(e->ev_proxy); #else - invalid_argument("netsys_event_descr"); + caml_invalid_argument("netsys_event_descr"); #endif } @@ -383,7 +383,7 @@ return Val_unit; #else - invalid_argument("netsys_wsa_event_select"); + caml_invalid_argument("netsys_wsa_event_select"); #endif } @@ -391,7 +391,7 @@ #ifdef _WIN32 return Val_int(WSA_MAXIMUM_WAIT_EVENTS); #else - invalid_argument("netsys_wsa_maximum_wait_events"); + caml_invalid_argument("netsys_wsa_maximum_wait_events"); #endif } @@ -428,9 +428,9 @@ tmo = tmo0; else tmo = INFINITE; - enter_blocking_section(); + caml_enter_blocking_section(); r = SleepEx(tmo, 1); - leave_blocking_section(); + caml_leave_blocking_section(); if (r == WAIT_IO_COMPLETION) { win32_maperr(EINTR); @@ -445,10 +445,10 @@ else tmo = INFINITE; dprintf("WSAWaitForMultipleEvents start tmo=%u\n", tmo); - enter_blocking_section(); + caml_enter_blocking_section(); r = WSAWaitForMultipleEvents(n, earray, 0, tmo, 1); err = WSAGetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); dprintf("WSAWaitForMultipleEvents end code=%u\n", r); if (r == WSA_WAIT_FAILED) { @@ -476,9 +476,9 @@ } } - invalid_argument("netsys_wsa_wait_for_multiple_events: bad return value from Win32"); + caml_invalid_argument("netsys_wsa_wait_for_multiple_events: bad return value from Win32"); #else - invalid_argument("netsys_wsa_wait_for_multiple_events"); + caml_invalid_argument("netsys_wsa_wait_for_multiple_events"); #endif } @@ -538,7 +538,7 @@ return Val_int(r); #else - invalid_argument("netsys_wsa_enum_network_events"); + caml_invalid_argument("netsys_wsa_enum_network_events"); #endif } @@ -626,20 +626,20 @@ uerror("alloc_pipe_helper/CreateEvent", Nothing); }; - rd_ovrlp = stat_alloc(sizeof(OVERLAPPED)); + rd_ovrlp = caml_stat_alloc(sizeof(OVERLAPPED)); ZeroMemory(rd_ovrlp, sizeof(OVERLAPPED)); rd_ovrlp->hEvent = rd_ev; - wr_ovrlp = stat_alloc(sizeof(OVERLAPPED)); + wr_ovrlp = caml_stat_alloc(sizeof(OVERLAPPED)); ZeroMemory(wr_ovrlp, sizeof(OVERLAPPED)); wr_ovrlp->hEvent = wr_ev; - cn_ovrlp = stat_alloc(sizeof(OVERLAPPED)); + cn_ovrlp = caml_stat_alloc(sizeof(OVERLAPPED)); ZeroMemory(cn_ovrlp, sizeof(OVERLAPPED)); if (cn_ev != INVALID_HANDLE_VALUE) cn_ovrlp->hEvent = cn_ev; - ph = stat_alloc(sizeof(struct pipe_helper)); + ph = caml_stat_alloc(sizeof(struct pipe_helper)); ph->pipe_handle = h; ph->pipe_is_open = 1; ph->pipe_is_server = 0; @@ -680,10 +680,10 @@ if (ph->pipe_cn_ev != INVALID_HANDLE_VALUE) CloseHandle(ph->pipe_cn_ev); /* do nothing about pipe_signal */ - stat_free(ph->pipe_rd_ovrlp); - stat_free(ph->pipe_wr_ovrlp); - stat_free(ph->pipe_cn_ovrlp); - stat_free(ph); + caml_stat_free(ph->pipe_rd_ovrlp); + caml_stat_free(ph->pipe_wr_ovrlp); + caml_stat_free(ph->pipe_cn_ovrlp); + caml_stat_free(ph); } @@ -1032,7 +1032,7 @@ ph->pipe_handle); return r; #else - invalid_argument("netsys_create_local_named_pipe"); + caml_invalid_argument("netsys_create_local_named_pipe"); #endif } @@ -1130,7 +1130,7 @@ return Val_unit; #else - invalid_argument("netsys_pipe_listen"); + caml_invalid_argument("netsys_pipe_listen"); #endif } @@ -1175,13 +1175,13 @@ /* Check whether the overlapped ops are done: */ check_for_pending_operations(ph); if (ph->pipe_cn_ovrlp_started) { - failwith("netsys_pipe_unlisten: cannot stop pending ConnectNamedPipe"); + caml_failwith("netsys_pipe_unlisten: cannot stop pending ConnectNamedPipe"); }; if (ph->pipe_rd_ovrlp_started) { - failwith("netsys_pipe_unlisten: cannot stop pending ReadFile"); + caml_failwith("netsys_pipe_unlisten: cannot stop pending ReadFile"); }; if (ph->pipe_wr_ovrlp_started) { - failwith("netsys_pipe_unlisten: cannot stop pending WriteFile"); + caml_failwith("netsys_pipe_unlisten: cannot stop pending WriteFile"); }; dprintf("PIPE deafen %u successful\n", @@ -1202,7 +1202,7 @@ return Val_unit; #else - invalid_argument("netsys_pipe_unlisten"); + caml_invalid_argument("netsys_pipe_unlisten"); #endif } @@ -1272,7 +1272,7 @@ return r; #else - invalid_argument("netsys_pipe_connect"); + caml_invalid_argument("netsys_pipe_connect"); #endif } @@ -1333,7 +1333,7 @@ return Val_int(l); #else - invalid_argument("netsys_pipe_read"); + caml_invalid_argument("netsys_pipe_read"); #endif } @@ -1400,7 +1400,7 @@ return Val_int(l); #else - invalid_argument("netsys_pipe_write"); + caml_invalid_argument("netsys_pipe_write"); #endif } @@ -1438,7 +1438,7 @@ return Val_unit; #else - invalid_argument("netsys_pipe_shutdown"); + caml_invalid_argument("netsys_pipe_shutdown"); #endif } @@ -1453,7 +1453,7 @@ return Val_unit; #else - invalid_argument("netsys_pipe_free"); + caml_invalid_argument("netsys_pipe_free"); #endif } @@ -1469,7 +1469,7 @@ return Val_int(ph->pipe_conn_state); #else - invalid_argument("netsys_pipe_conn_state"); + caml_invalid_argument("netsys_pipe_conn_state"); #endif } @@ -1487,7 +1487,7 @@ return alloc_event(ph->pipe_rd_ev); #else - invalid_argument("netsys_pipe_rd_event"); + caml_invalid_argument("netsys_pipe_rd_event"); #endif } @@ -1505,7 +1505,7 @@ return alloc_event(ph->pipe_wr_ev); #else - invalid_argument("netsys_pipe_wr_event"); + caml_invalid_argument("netsys_pipe_wr_event"); #endif } @@ -1518,7 +1518,7 @@ return netsysw32_win_alloc_handle(ph->pipe_descr); #else - invalid_argument("netsys_pipe_descr"); + caml_invalid_argument("netsys_pipe_descr"); #endif } @@ -1530,7 +1530,7 @@ ph->pipe_descr_auto_close = Bool_val(flag); return Val_unit; #else - invalid_argument("netsys_set_auto_close_pipe_proxy"); + caml_invalid_argument("netsys_set_auto_close_pipe_proxy"); #endif } @@ -1546,7 +1546,7 @@ return Val_unit; #else - invalid_argument("netsys_pipe_signal"); + caml_invalid_argument("netsys_pipe_signal"); #endif } @@ -1658,7 +1658,7 @@ pass_std_handles = 1; break; default: - invalid_argument("netsys_create_process [1]"); + caml_invalid_argument("netsys_create_process [1]"); } } else { @@ -1687,7 +1687,7 @@ pg_flags = 0; break; default: - invalid_argument("netsys_create_process [2]"); + caml_invalid_argument("netsys_create_process [2]"); } }; opts_hd = Field(opts_hd,1); @@ -1716,7 +1716,7 @@ pi.hProcess, pi.dwProcessId); return alloc_process(pi.hProcess, pi.dwProcessId); #else - invalid_argument("netsys_create_process"); + caml_invalid_argument("netsys_create_process"); #endif } @@ -1751,7 +1751,7 @@ if (pathlen < 256) pathlen = 256; cont = 1; while (cont) { - fullname = stat_alloc(pathlen); + fullname = caml_stat_alloc(pathlen); code = SearchPath(path, file, ext, @@ -1760,7 +1760,7 @@ NULL); cont = (code >= pathlen); if (cont) { - stat_free(fullname); + caml_stat_free(fullname); pathlen = code+1; /* space for NULL byte! */ } } @@ -1768,16 +1768,16 @@ caml_leave_blocking_section(); if (code == 0) { - stat_free(fullname); + caml_stat_free(fullname); errno = ENOENT; uerror("netsys_search_path", file_v); }; r = caml_copy_string(fullname); - stat_free(fullname); + caml_stat_free(fullname); return r; #else - invalid_argument("netsys_search_path"); + caml_invalid_argument("netsys_search_path"); #endif } @@ -1794,7 +1794,7 @@ } return Val_unit; #else - invalid_argument("netsys_terminate_process"); + caml_invalid_argument("netsys_terminate_process"); #endif } @@ -1807,7 +1807,7 @@ p0 = process_val(pv); return netsysw32_win_alloc_handle(p0->proc_proxy); #else - invalid_argument("netsys_process_descr"); + caml_invalid_argument("netsys_process_descr"); #endif } @@ -1819,7 +1819,7 @@ p0->auto_close = Bool_val(flag); return Val_unit; #else - invalid_argument("netsys_set_auto_close_process_proxy"); + caml_invalid_argument("netsys_set_auto_close_process_proxy"); #endif } @@ -1834,7 +1834,7 @@ }; return Val_unit; #else - invalid_argument("netsys_close_process"); + caml_invalid_argument("netsys_close_process"); #endif } @@ -1846,10 +1846,10 @@ CloseHandle(p0->proc); if (p0->auto_close) CloseHandle(p0->proc_proxy); - stat_free(p0); + caml_stat_free(p0); return Val_unit; #else - invalid_argument("netsys_close_process"); + caml_invalid_argument("netsys_close_process"); #endif } @@ -1870,7 +1870,7 @@ uerror("netsys_get_process_status/WaitForSingleObject", Nothing); }; if (code != WAIT_OBJECT_0) { - invalid_argument("netsys_get_process_status [1]"); + caml_invalid_argument("netsys_get_process_status [1]"); }; /* Now get the status: */ code = GetExitCodeProcess(p0->proc, &status); @@ -1882,7 +1882,7 @@ return Val_int(status); #else - invalid_argument("netsys_get_process_status"); + caml_invalid_argument("netsys_get_process_status"); #endif } @@ -1893,7 +1893,7 @@ p0 = process_val(pv); return alloc_event(p0->proc); #else - invalid_argument("netsys_as_process_event"); + caml_invalid_argument("netsys_as_process_event"); #endif } @@ -1915,7 +1915,7 @@ }; return Val_int(d); #else - invalid_argument("netsys_emulated_pid"); + caml_invalid_argument("netsys_emulated_pid"); #endif } @@ -1926,7 +1926,7 @@ p0 = process_val(pv); return Val_int(p0->win_pid); #else - invalid_argument("netsys_win_pid"); + caml_invalid_argument("netsys_win_pid"); #endif } @@ -1935,7 +1935,7 @@ #ifdef _WIN32 return Val_bool(has_console()); #else - invalid_argument("netsys_has_console"); + caml_invalid_argument("netsys_has_console"); #endif } @@ -1950,7 +1950,7 @@ else return Val_bool(1); #else - invalid_argument("netsys_is_console"); + caml_invalid_argument("netsys_is_console"); #endif } @@ -1962,7 +1962,7 @@ } return Val_unit; #else - invalid_argument("netsys_alloc_console"); + caml_invalid_argument("netsys_alloc_console"); #endif } @@ -2001,7 +2001,7 @@ return r; #else - invalid_argument("netsys_get_console_attr"); + caml_invalid_argument("netsys_get_console_attr"); #endif } @@ -2060,7 +2060,7 @@ return Val_unit; #else - invalid_argument("netsys_set_console_attr"); + caml_invalid_argument("netsys_set_console_attr"); #endif } @@ -2092,7 +2092,7 @@ return r; #else - invalid_argument("netsys_get_console_info"); + caml_invalid_argument("netsys_get_console_info"); #endif } @@ -2146,7 +2146,7 @@ return r; #else - invalid_argument("netsys_get_console_mode"); + caml_invalid_argument("netsys_get_console_mode"); #endif } @@ -2215,7 +2215,7 @@ CloseHandle(conout); return Val_unit; #else - invalid_argument("netsys_set_console_mode"); + caml_invalid_argument("netsys_set_console_mode"); #endif } @@ -2224,7 +2224,7 @@ #ifdef _WIN32 return Val_int(GetACP()); #else - invalid_argument("netsys_getacp"); + caml_invalid_argument("netsys_getacp"); #endif } @@ -2243,7 +2243,7 @@ } return Val_unit; #else - invalid_argument("netsys_init_console_codepage"); + caml_invalid_argument("netsys_init_console_codepage"); #endif } @@ -2338,7 +2338,7 @@ return Val_unit; #else - invalid_argument("netsys_clear_console"); + caml_invalid_argument("netsys_clear_console"); #endif } @@ -2347,7 +2347,7 @@ #ifdef _WIN32 return caml_copy_int32(GetCurrentThreadId()); #else - invalid_argument("netsys_get_current_thread_id"); + caml_invalid_argument("netsys_get_current_thread_id"); #endif } @@ -2394,7 +2394,7 @@ return Val_unit; #else - invalid_argument("netsys_cancel_synchronous_io"); + caml_invalid_argument("netsys_cancel_synchronous_io"); #endif } @@ -2439,7 +2439,7 @@ for (/*nothing*/; fdlist != Val_int(0); fdlist = Field(fdlist, 1)) { s = Field(fdlist, 0); if (FD_ISSET(Socket_val(s), fdset)) { - value newres = alloc_small(2, 0); + value newres = caml_alloc_small(2, 0); Field(newres, 0) = s; Field(newres, 1) = res; res = newres; @@ -2471,9 +2471,9 @@ && writefds == Val_int(0) && exceptfds == Val_int(0)) { if ( tm > 0.0 ) { - enter_blocking_section(); + caml_enter_blocking_section(); Sleep( (int)(tm * 1000)); - leave_blocking_section(); + caml_leave_blocking_section(); } read_list = write_list = except_list = Val_int(0); } else { @@ -2487,10 +2487,10 @@ tv.tv_usec = (int) (1e6 * (tm - (int) tm)); tvp = &tv; } - enter_blocking_section(); + caml_enter_blocking_section(); if (select(FD_SETSIZE, &read, &write, &except, tvp) == -1) err = WSAGetLastError(); - leave_blocking_section(); + caml_leave_blocking_section(); if (err) { win32_maperr(err); uerror("select", Nothing); @@ -2499,7 +2499,7 @@ write_list = fdset_to_fdlist(writefds, &write); except_list = fdset_to_fdlist(exceptfds, &except); } - res = alloc_small(3, 0); + res = caml_alloc_small(3, 0); Field(res, 0) = read_list; Field(res, 1) = write_list; Field(res, 2) = except_list; @@ -2507,6 +2507,6 @@ End_roots(); return res; #else - invalid_argument("netsys_real_select"); + caml_invalid_argument("netsys_real_select"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_impl_util.ml ocamlnet-4.1.9.patched/src/netsys/netsys_impl_util.ml --- src/netsys/netsys_impl_util.ml 2021-03-24 16:20:14 +++ src/netsys/netsys_impl_util.ml 2026-05-29 06:31:44 @@ -67,7 +67,7 @@ let rec search l h = if l < h then ( let m = (l+h) / 2 in - let r = Pervasives.compare x a.(m) in + let r = compare x a.(m) in if r = 0 then true else diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_pollset_win32.ml ocamlnet-4.1.9.patched/src/netsys/netsys_pollset_win32.ml --- src/netsys/netsys_pollset_win32.ml 2021-03-24 16:20:14 +++ src/netsys/netsys_pollset_win32.ml 2026-05-29 06:31:44 @@ -27,9 +27,9 @@ let in_arr = Array.of_list in_set in let out_arr = Array.of_list out_set in let pri_arr = Array.of_list pri_set in - Array.sort Pervasives.compare in_arr; - Array.sort Pervasives.compare out_arr; - Array.sort Pervasives.compare pri_arr; + Array.sort compare in_arr; + Array.sort compare out_arr; + Array.sort compare pri_arr; Hashtbl.fold (fun fd (ev,_) l -> let m_in = Netsys_impl_util.mem_sorted_array fd in_arr in diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/netsys/netsys_posix.ml ocamlnet-4.1.9.patched/src/netsys/netsys_posix.ml --- src/netsys/netsys_posix.ml 2021-03-24 16:20:14 +++ src/netsys/netsys_posix.ml 2026-05-29 06:31:44 @@ -337,9 +337,9 @@ let a_inp = Array.of_list o_inp in let a_out = Array.of_list o_out in let a_pri = Array.of_list o_pri in - Array.sort Pervasives.compare a_inp; - Array.sort Pervasives.compare a_out; - Array.sort Pervasives.compare a_pri; + Array.sort compare a_inp; + Array.sort compare a_out; + Array.sort compare a_pri; let n = ref 0 in for j = 0 to k-1 do let c = e.(j) in @@ -679,7 +679,7 @@ module PFH = struct type t = post_fork_handler - let compare = Pervasives.compare + let compare = compare end module PFH_Set = Set.Make(PFH) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nettls-gnutls/META.in ocamlnet-4.1.9.patched/src/nettls-gnutls/META.in --- src/nettls-gnutls/META.in 2021-03-24 16:20:15 +++ src/nettls-gnutls/META.in 2026-05-29 06:31:44 @@ -1,5 +1,5 @@ description = "Ocamlnet - GnuTLS bindings" -requires = "unix,bigarray,netsys,netstring" +requires = "unix,netsys,netstring" version = "@VERSION@" archive(byte) = "nettls-gnutls.cma" archive(native) = "nettls-gnutls.cmxa" diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nettls-gnutls/gnutls.c ocamlnet-4.1.9.patched/src/nettls-gnutls/gnutls.c --- src/nettls-gnutls/gnutls.c 2021-03-24 16:20:15 +++ src/nettls-gnutls/gnutls.c 2026-05-29 06:31:44 @@ -111,26 +111,26 @@ static gnutls_datum_t unwrap_str_datum(value v) { gnutls_datum_t d; d.size = caml_string_length(v); - d.data = stat_alloc(d.size); + d.data = caml_stat_alloc(d.size); memcpy(d.data, String_val(v), d.size); return d; } static gnutls_datum_t * unwrap_str_datum_p(value v) { gnutls_datum_t *d; - d = stat_alloc(sizeof(gnutls_datum_t)); + d = caml_stat_alloc(sizeof(gnutls_datum_t)); *d = unwrap_str_datum(v); return d; } static void free_str_datum(gnutls_datum_t d) { - if (d.data != NULL) { stat_free(d.data); d.data = NULL; }; + if (d.data != NULL) { caml_stat_free(d.data); d.data = NULL; }; } static void free_str_datum_p(gnutls_datum_t *d) { if (d != NULL) { - if (d->data != NULL) stat_free(d->data); - stat_free(d); + if (d->data != NULL) caml_stat_free(d->data); + caml_stat_free(d); } } @@ -405,7 +405,7 @@ b_session_callbacks_t cb; cb = (b_session_callbacks_t) - stat_alloc(sizeof(struct b_session_callbacks_st)); + caml_stat_alloc(sizeof(struct b_session_callbacks_st)); cb->session = s; cb->pull_fun = Val_int(0); cb->pull_timeout_fun = Val_int(0); @@ -458,7 +458,7 @@ caml_remove_generational_global_root(&(cb->db_store_fun)); caml_remove_generational_global_root(&(cb->db_remove_fun)); - stat_free(cb); + caml_stat_free(cb); gnutls_deinit(s); } @@ -484,7 +484,7 @@ caml_modify_generational_global_root(&(cb->pull_timeout_fun), fun); return Val_unit; #else - invalid_argument("b_set_pull_timeout_callback"); + caml_invalid_argument("b_set_pull_timeout_callback"); #endif } @@ -510,7 +510,7 @@ caml_modify_generational_global_root(&(cb->verify_fun), fun); return Val_unit; #else - invalid_argument("b_set_verify_callback"); + caml_invalid_argument("b_set_verify_callback"); #endif } @@ -602,7 +602,7 @@ ); break; default: - failwith("net_gnutls_credentials_set"); + caml_failwith("net_gnutls_credentials_set"); }; net_gnutls_error_check(error_code); attach_gnutls_session_t(sess, creds); @@ -633,7 +633,7 @@ code = gnutls_x509_crt_list_import(certs, &n, &data, format, flags | GNUTLS_X509_CRT_LIST_IMPORT_FAIL_IF_EXCEED); if (code == GNUTLS_E_SHORT_MEMORY_BUFFER) { - certs = (gnutls_x509_crt_t *) stat_alloc(n * sizeof(void *)); + certs = (gnutls_x509_crt_t *) caml_stat_alloc(n * sizeof(void *)); alloc_certs = 1; code = gnutls_x509_crt_list_import(certs, &n, &data, format, flags); @@ -646,7 +646,7 @@ }; }; if (alloc_certs) - stat_free(certs); + caml_stat_free(certs); net_gnutls_error_check(code); CAMLreturn(array); } @@ -676,7 +676,7 @@ code = gnutls_x509_crl_list_import(certs, &n, &data, format, flags | GNUTLS_X509_CRT_LIST_IMPORT_FAIL_IF_EXCEED); if (code == GNUTLS_E_SHORT_MEMORY_BUFFER) { - certs = (gnutls_x509_crl_t *) stat_alloc(n * sizeof(void *)); + certs = (gnutls_x509_crl_t *) caml_stat_alloc(n * sizeof(void *)); alloc_certs = 1; code = gnutls_x509_crl_list_import(certs, &n, &data, format, flags); @@ -689,11 +689,11 @@ }; }; if (alloc_certs) - stat_free(certs); + caml_stat_free(certs); net_gnutls_error_check(code); CAMLreturn(array); #else - invalid_argument("gnutls_x509_crl_list_import"); + caml_invalid_argument("gnutls_x509_crl_list_import"); #endif } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nettls-gnutls/gnutls.descr ocamlnet-4.1.9.patched/src/nettls-gnutls/gnutls.descr --- src/nettls-gnutls/gnutls.descr 2021-03-24 16:20:15 +++ src/nettls-gnutls/gnutls.descr 2026-05-29 06:31:44 @@ -560,7 +560,7 @@ ~options: [ `Pre("if (data_size__c < 0 || \ data_size__c > caml_ba_byte_size(Caml_ba_array_val(data))) \ - invalid_argument(\"gnutls_record_send\");" + caml_invalid_argument(\"gnutls_record_send\");" ) ] "error_code/uint gnutls_record_send \ diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nettls-gnutls/nettle.c ocamlnet-4.1.9.patched/src/nettls-gnutls/nettle.c --- src/nettls-gnutls/nettle.c 2021-03-24 16:20:15 +++ src/nettls-gnutls/nettle.c 2026-05-29 06:31:44 @@ -39,12 +39,12 @@ static net_nettle_cipher_ctx_t net_nettle_create_cipher_ctx(net_nettle_cipher_t cipher) { void *p; - p = stat_alloc(cipher->context_size); + p = caml_stat_alloc(cipher->context_size); return p; } static void net_nettle_free(void *ctx) { - stat_free(ctx); + caml_stat_free(ctx); } static void net_nettle_destroy_cipher(net_nettle_cipher_t cipher) { @@ -57,7 +57,7 @@ const uint8_t *key) { #ifdef HAVE_NETTLE_SET_KEY_WITH_TWO_ARGS if (length != cipher->key_size) - failwith("net_nettl_set_encrypt_key: key has wrong size"); + caml_failwith("net_nettl_set_encrypt_key: key has wrong size"); cipher->set_encrypt_key(ctx, key); #else cipher->set_encrypt_key(ctx, length, key); @@ -71,7 +71,7 @@ const uint8_t *key) { #ifdef HAVE_NETTLE_SET_KEY_WITH_TWO_ARGS if (length != cipher->key_size) - failwith("net_nettl_set_decrypt_key: key has wrong size"); + caml_failwith("net_nettl_set_decrypt_key: key has wrong size"); cipher->set_decrypt_key(ctx, key); #else cipher->set_decrypt_key(ctx, length, key); @@ -292,7 +292,7 @@ static net_nettle_gcm_aes_ctx_t net_nettle_gcm_aes_init(void) { #ifdef HAVE_NETTLE_GCM_H - return stat_alloc(sizeof(struct gcm_aes_ctx)); + return caml_stat_alloc(sizeof(struct gcm_aes_ctx)); #else return NULL; #endif @@ -321,7 +321,7 @@ static net_nettle_hash_ctx_t net_nettle_create_hash_ctx(net_nettle_hash_t hash) { void *p; - p = stat_alloc(hash->context_size); + p = caml_stat_alloc(hash->context_size); return p; } diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nettls-gnutls/nettls_gnutls.ml ocamlnet-4.1.9.patched/src/nettls-gnutls/nettls_gnutls.ml --- src/nettls-gnutls/nettls_gnutls.ml 2021-03-24 16:20:15 +++ src/nettls-gnutls/nettls_gnutls.ml 2026-05-29 06:31:44 @@ -4,7 +4,7 @@ module StrMap = Map.Make(String) module StrSet = Set.Make(String) -module OID = struct type t = Netoid.t let compare = Pervasives.compare end +module OID = struct type t = Netoid.t let compare = compare end module OIDMap = Map.Make(OID) module type GNUTLS_PROVIDER = diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/nettls-gnutls/reconfigure ocamlnet-4.1.9.patched/src/nettls-gnutls/reconfigure --- src/nettls-gnutls/reconfigure 2021-03-24 16:20:15 +++ src/nettls-gnutls/reconfigure 2026-05-29 06:31:44 @@ -216,10 +216,10 @@ rm -f config_checks.sh echo "$ ocaml -I ../../tools gnutls.descr" >>$log -ocaml -I ../../tools gnutls.descr || exit 1 +ocaml -I +str -I ../../tools gnutls.descr || exit 1 echo "$ ocaml -I ../../tools nettle.descr" >>$log -ocaml -I ../../tools nettle.descr || exit 1 +ocaml -I +str -I ../../tools nettle.descr || exit 1 init_checks . ./config_checks.sh diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/rpc/rpc_client.ml ocamlnet-4.1.9.patched/src/rpc/rpc_client.ml --- src/rpc/rpc_client.ml 2021-03-24 16:20:15 +++ src/rpc/rpc_client.ml 2026-05-29 06:31:44 @@ -49,7 +49,7 @@ module SessionUint4 = struct type t = uint4 - let compare = (Pervasives.compare : uint4 -> uint4 -> int) + let compare = (compare : uint4 -> uint4 -> int) end module SessionMap = diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/rpc/rpc_proxy.ml ocamlnet-4.1.9.patched/src/rpc/rpc_proxy.ml --- src/rpc/rpc_proxy.ml 2021-03-24 16:20:15 +++ src/rpc/rpc_proxy.ml 2026-05-29 06:31:44 @@ -414,7 +414,7 @@ | `Up up -> up.serial let compare mc1 mc2 = - Pervasives.compare mc1.id mc2.id + compare mc1.id mc2.id let pending_calls mc = mc.pending_calls @@ -1037,7 +1037,7 @@ (* Sort the services by total load first: *) Array.sort (fun j1 j2 -> - Pervasives.compare + compare mset.total_load.(j1) mset.total_load.(j2) ) diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/rpc-auth-local/rpclocal.c ocamlnet-4.1.9.patched/src/rpc-auth-local/rpclocal.c --- src/rpc-auth-local/rpclocal.c 2021-03-24 16:20:15 +++ src/rpc-auth-local/rpclocal.c 2026-05-29 06:31:44 @@ -12,6 +12,7 @@ #include "caml/alloc.h" #include "caml/memory.h" #include "caml/fail.h" +#include "caml/unixsupport.h" #ifndef _WIN32 #include @@ -30,16 +31,7 @@ /**********************************************************************/ -/* From unixsupport.h */ -/**********************************************************************/ -#define Nothing ((value) 0) - -extern void unix_error (int errcode, char * cmdname, value arg) Noreturn; -extern void uerror (char * cmdname, value arg) Noreturn; - -/**********************************************************************/ - /* Inspired by PostgreSQL's fe-connect.c */ value netsys_get_peer_credentials(value fd) { @@ -58,7 +50,7 @@ /* BSD, AIX, Cygwin */ /* http://cr.yp.to/docs/secureipc.html */ if (getpeereid(Int_val(fd), &uid, &gid) != 0) { - uerror("getpeereid", Nothing); + caml_uerror("getpeereid", Nothing); } #elif defined(SO_PEERCRED) @@ -73,7 +65,7 @@ SO_PEERCRED, &credentials, &len) == -1) { - uerror("getsockopt",Nothing); + caml_uerror("getsockopt",Nothing); }; uid = credentials.uid; /* Effective user ID */ gid = credentials.gid; /* Effective group ID */ @@ -84,24 +76,24 @@ ucred_t *ucred; ucred = NULL; /* must be initialized to NULL */ if (getpeerucred(Int_val(fd), &ucred) == -1) { - uerror("getpeerucred",Nothing); + caml_uerror("getpeerucred",Nothing); }; if ((uid = ucred_geteuid(ucred)) == -1) { - uerror("ucred_geteuid",Nothing); + caml_uerror("ucred_geteuid",Nothing); ucred_free(ucred); }; if ((gid = ucred_getegid(ucred)) == -1) { - uerror("ucred_getegid",Nothing); + caml_uerror("ucred_getegid",Nothing); ucred_free(ucred); }; ucred_free(ucred); } #else - invalid_argument("get_peer_credentials"); + caml_invalid_argument("get_peer_credentials"); #endif /* Allocate a pair, and put the result into it: */ - result = alloc_tuple(2); + result = caml_alloc_tuple(2); Store_field(result, 0, Val_int(uid)); Store_field(result, 1, Val_int(gid)); @@ -140,7 +132,7 @@ SO_PASSCRED, &one, sizeof(one)) < 0) { - uerror("setsockopt", Nothing); + caml_uerror("setsockopt", Nothing); }; memset(&msg, 0, sizeof msg); @@ -160,7 +152,7 @@ */ if (recvmsg(Int_val(fd), &msg, MSG_PEEK) < 0) { - uerror("recvmsg", Nothing); + caml_uerror("recvmsg", Nothing); }; if (msg.msg_controllen == 0 || @@ -201,12 +193,12 @@ LOCAL_CREDS, &one, sizeof(one)) < 0) { - uerror("setsockopt", Nothing); + caml_uerror("setsockopt", Nothing); }; memset(&msg, 0, sizeof msg); crmsgsize = CMSG_SPACE(SOCKCREDSIZE(NGROUPS_MAX)); - crmsg = stat_alloc(crmsgsize); + crmsg = caml_stat_alloc(crmsgsize); memset(crmsg, 0, crmsgsize); msg.msg_control = crmsg; @@ -218,19 +210,19 @@ iov.iov_len = 1; if (recvmsg(Int_val(fd), &msg, MSG_PEEK) < 0) { - stat_free(crmsg); - uerror("recvmsg", Nothing); + caml_stat_free(crmsg); + caml_uerror("recvmsg", Nothing); }; if (msg.msg_controllen == 0 || (msg.msg_flags & MSG_CTRUNC) != 0) { - stat_free(crmsg); + caml_stat_free(crmsg); raise_not_found(); }; cmp = CMSG_FIRSTHDR(&msg); if (cmp->cmsg_level != SOL_SOCKET || cmp->cmsg_type != SCM_CREDS) { - stat_free(crmsg); + caml_stat_free(crmsg); raise_not_found(); }; @@ -241,12 +233,12 @@ free(crmsg); } #else - invalid_argument("peek_peer_credentials"); + caml_invalid_argument("peek_peer_credentials"); #endif #endif /* Allocate a pair, and put the result into it: */ - result = alloc_tuple(2); + result = caml_alloc_tuple(2); Store_field(result, 0, Val_int(uid)); Store_field(result, 1, Val_int(gid)); diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/shell/shell.ml ocamlnet-4.1.9.patched/src/shell/shell.ml --- src/shell/shell.ml 2021-03-24 16:20:15 +++ src/shell/shell.ml 2026-05-29 06:31:44 @@ -111,8 +111,8 @@ let from_string ?pos ?len ?epipe s = P_fun (Shell_sys.from_string ?pos:pos ?len:len ?epipe:epipe s);; -let from_stream ?epipe s = - P_fun (Shell_sys.from_stream ?epipe:epipe s);; +let from_seq ?epipe s = + P_fun (Shell_sys.from_seq ?epipe:epipe s);; let from_function ~producer () = P_fun producer;; diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/shell/shell.mli ocamlnet-4.1.9.patched/src/shell/shell.mli --- src/shell/shell.mli 2021-03-24 16:20:15 +++ src/shell/shell.mli 2026-05-29 06:31:44 @@ -237,11 +237,11 @@ * always caught, and implicitly handled by closing the pipeline. *) -val from_stream : +val from_seq : ?epipe:(unit -> unit) -> (* default: empty function *) - string Stream.t -> + string Seq.t -> producer - (** Creates a producer taking the data from a stream of strings. + (** Creates a producer taking the data from a sequence of strings. * After the data are sent, the pipeline is closed. * * @param epipe This function is called when the pipeline breaks diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/shell/shell_sys.ml ocamlnet-4.1.9.patched/src/shell/shell_sys.ml --- src/shell/shell_sys.ml 2021-03-24 16:20:15 +++ src/shell/shell_sys.ml 2026-05-29 06:31:44 @@ -82,7 +82,7 @@ try let k = ref 0 in iter_env_vars - (fun v' x' -> + ~f:(fun v' x' -> if v' = v then begin !e.(!k) <- v ^ "=" ^ x; raise Exit @@ -100,7 +100,7 @@ let x = ref "" in try iter_env_vars - (fun v' x' -> + ~f:(fun v' x' -> if v' = v then begin x := x'; raise Exit @@ -335,7 +335,7 @@ ;; let dummy_process = - { p_command = command "XXX" (); + { p_command = command ~filename:"XXX" (); p_id = `Dummy; p_gid = 0; p_status = Some (Unix.WEXITED 0); @@ -1103,7 +1103,7 @@ from_tstring ?pos ?len ?epipe (`String s) -let from_stream +let from_seq ?(epipe = fun () -> ()) s = let current_el = ref None in @@ -1112,6 +1112,8 @@ let fd_style = ref `Read_write in let fd_style_set = ref false in + let stream = ref s in + function fd -> if not !fd_style_set then ( fd_style := Netsys.get_fd_style fd; @@ -1120,14 +1122,15 @@ (* If necessary, try to get the next stream element: *) begin match !current_el with None -> - begin try - let x = Stream.next s in - current_el := Some x; - current_pos := 0; - with - Stream.Failure -> - () - end + begin + match !stream() with + | Seq.Nil -> + () + | Cons(x, tail) -> + stream := tail; + current_el := Some x; + current_pos := 0; + end | _ -> () end; diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/src/shell/shell_sys.mli ocamlnet-4.1.9.patched/src/shell/shell_sys.mli --- src/shell/shell_sys.mli 2021-03-24 16:20:15 +++ src/shell/shell_sys.mli 2026-05-29 06:31:44 @@ -417,13 +417,13 @@ (Unix.file_descr -> bool) (** Same for tagged strings *) -val from_stream : +val from_seq : ?epipe:(unit -> unit) -> (* default: empty function *) - string Stream.t -> + string Seq.t -> (Unix.file_descr -> bool) - (** [from_stream ?epipe s] returns a function which can be + (** [from_seq ?epipe s] returns a function which can be * used as [producer] argument for [add_producer]. The data transferred - * to the subprocess is taken from the string stream [s]. After these data + * to the subprocess is taken from the string sequence [s]. After these data * are sent, the pipeline is closed. * * @param epipe This function is called when the pipeline breaks @@ -431,7 +431,7 @@ * always caught, and implicitly handled by closing the pipeline. *) -val add_consumer : +val add_consumer : ?descr:Unix.file_descr -> (* default: stdout *) consumer:(Unix.file_descr -> bool) -> command -> diff -ruN --no-dereference --exclude=*.rej --exclude=*.orig --exclude=*.c.orig ocamlnet-4.1.9.clean/tools/stubgen.ml ocamlnet-4.1.9.patched/tools/stubgen.ml --- tools/stubgen.ml 2021-03-24 16:20:13 +++ tools/stubgen.ml 2026-05-29 06:31:44 @@ -447,7 +447,7 @@ fprintf c " CAMLparam0();\n"; fprintf c " CAMLlocal2(v,r);\n"; if not abs.abs_nullok then - fprintf c " if (x == NULL) failwith(\"wrap_%s: NULL pointer\");\n" tyname; + fprintf c " if (x == NULL) caml_failwith(\"wrap_%s: NULL pointer\");\n" tyname; fprintf c " v = caml_alloc_custom(&abs_%s_ops, \ sizeof(struct absstruct_%s), 0, 1);\n" tyname tyname; @@ -503,10 +503,10 @@ try let l = String.length n in let p = String.index n '|' in - String.capitalize (String.lowercase (String.sub n (p+1) (l-p-1))) + String.capitalize_ascii (String.lowercase_ascii (String.sub n (p+1) (l-p-1))) with | Not_found -> - String.capitalize (String.lowercase n) + String.capitalize_ascii (String.lowercase_ascii n) let is_opt_case n = @@ -550,7 +550,7 @@ cases; fprintf c " default: break;\n"; fprintf c " };\n"; - fprintf c " failwith(\"wrap_%s: unexpected value\");\n" tyname; + fprintf c " caml_failwith(\"wrap_%s: unexpected value\");\n" tyname; fprintf c "}\n\n"; fprintf c "static %s unwrap_%s(value v) {\n" tyname tyname; @@ -568,9 +568,9 @@ fprintf c "#endif\n" ) cases; - fprintf c " default: invalid_argument(\"unwrap_%s\");\n" tyname; + fprintf c " default: caml_invalid_argument(\"unwrap_%s\");\n" tyname; fprintf c " };\n"; - fprintf c " failwith(\"unwrap_%s: unexpected value\");\n" tyname; + fprintf c " caml_failwith(\"unwrap_%s: unexpected value\");\n" tyname; fprintf c "}\n"; if optional then @@ -983,7 +983,7 @@ let i1 = new_local() in c_decls := sprintf "long %s;" i1 :: !c_decls; let code1 = - [ sprintf "%s = (%s) stat_alloc(Wosize_val(%s)*sizeof(%s));" + [ sprintf "%s = (%s) caml_stat_alloc(Wosize_val(%s)*sizeof(%s));" n1 c_ty n el_c_ty; sprintf "for (%s=0; %s < Wosize_val(%s); %s++) {" i1 i1 n i1; @@ -1000,7 +1000,7 @@ sprintf "};" ] else []) @ - [ sprintf "stat_free(%s);" n1 ] in + [ sprintf "caml_stat_free(%s);" n1 ] in c_code_post_prio := List.rev code2 @ !c_code_post_prio; | `Array_size(n_array, ty) -> let code = @@ -1358,14 +1358,14 @@ fprintf c " long n__stub;\n"; fprintf c " %s__c++;\n" n_strbuf_size; fprintf c " n__stub = %s__c;\n" n_strbuf_size; - fprintf c " %s__c = stat_alloc(%s__c+1);\n" n_strbuf n_strbuf_size; + fprintf c " %s__c = caml_stat_alloc(%s__c+1);\n" n_strbuf n_strbuf_size; fprintf c " "; emit_call(); fprintf c " if (%s == 0) {\n" ret_var; fprintf c " ((char *) %s__c)[n__stub] = 0;\n" n_strbuf; fprintf c " %s = caml_copy_string(%s__c);\n" n_strbuf n_strbuf; fprintf c " };\n"; - fprintf c " stat_free(%s__c);\n" n_strbuf; + fprintf c " caml_stat_free(%s__c);\n" n_strbuf; fprintf c " };\n"; ) else ( @@ -1414,7 +1414,7 @@ if optional then ( fprintf c "#else\n"; - fprintf c " invalid_argument(\"%s\");\n" name; + fprintf c " caml_invalid_argument(\"%s\");\n" name; fprintf c "#endif\n"; ); @@ -1483,7 +1483,7 @@ let gen_c_head2 c = fprintf c "static unsigned int uint_val(value v) {\n\ - \032 if (Int_val(v) < 0) invalid_argument(\"negative integer\");\n\ + \032 if (Int_val(v) < 0) caml_invalid_argument(\"negative integer\");\n\ \032 return (unsigned int) Int_val(v);\n\ }\n\ \n\