diff options
Diffstat (limited to 'otherlibs')
23 files changed, 81 insertions, 81 deletions
diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h index 695306544..63ac1078e 100644 --- a/otherlibs/bigarray/bigarray.h +++ b/otherlibs/bigarray/bigarray.h @@ -42,7 +42,7 @@ enum caml_ba_kind { CAML_BA_UINT16, /* Unsigned 16-bit integers */ CAML_BA_INT32, /* Signed 32-bit integers */ CAML_BA_INT64, /* Signed 64-bit integers */ - CAML_BA_CAML_INT, /* Caml-style integers (signed 31 or 63 bits) */ + CAML_BA_CAML_INT, /* OCaml-style integers (signed 31 or 63 bits) */ CAML_BA_NATIVE_INT, /* Platform-native long integers (32 or 64 bits) */ CAML_BA_COMPLEX32, /* Single-precision complex */ CAML_BA_COMPLEX64, /* Double-precision complex */ @@ -56,8 +56,8 @@ enum caml_ba_layout { }; enum caml_ba_managed { - CAML_BA_EXTERNAL = 0, /* Data is not allocated by Caml */ - CAML_BA_MANAGED = 0x200, /* Data is allocated by Caml */ + CAML_BA_EXTERNAL = 0, /* Data is not allocated by OCaml */ + CAML_BA_MANAGED = 0x200, /* Data is allocated by OCaml */ CAML_BA_MAPPED_FILE = 0x400, /* Data is a memory mapped file */ CAML_BA_MANAGED_MASK = 0x600 /* Mask for "managed" bits in flags field */ }; diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index ed60976f7..8b260bf79 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -18,13 +18,13 @@ This module implements multi-dimensional arrays of integers and floating-point numbers, thereafter referred to as ``big arrays''. The implementation allows efficient sharing of large numerical - arrays between Caml code and C or Fortran numerical libraries. + arrays between OCaml code and C or Fortran numerical libraries. Concerning the naming conventions, users of this module are encouraged to do [open Bigarray] in their source, then refer to array types and operations via short dot notation, e.g. [Array1.t] or [Array2.sub]. - Big arrays support all the Caml ad-hoc polymorphic operations: + Big arrays support all the OCaml ad-hoc polymorphic operations: - comparisons ([=], [<>], [<=], etc, as well as {!Pervasives.compare}); - hashing (module [Hash]); - and structured input-output ({!Pervasives.output_value} @@ -47,7 +47,7 @@ ({!Bigarray.int8_signed_elt} or {!Bigarray.int8_unsigned_elt}), - 16-bit integers (signed or unsigned) ({!Bigarray.int16_signed_elt} or {!Bigarray.int16_unsigned_elt}), -- Caml integers (signed, 31 bits on 32-bit architectures, +- OCaml integers (signed, 31 bits on 32-bit architectures, 63 bits on 64-bit architectures) ({!Bigarray.int_elt}), - 32-bit signed integer ({!Bigarray.int32_elt}), - 64-bit signed integers ({!Bigarray.int64_elt}), @@ -72,20 +72,20 @@ type int64_elt type nativeint_elt type ('a, 'b) kind -(** To each element kind is associated a Caml type, which is - the type of Caml values that can be stored in the big array +(** To each element kind is associated an OCaml type, which is + the type of OCaml values that can be stored in the big array or read back from it. This type is not necessarily the same as the type of the array elements proper: for instance, a big array whose elements are of kind [float32_elt] contains 32-bit single precision floats, but reading or writing one of - its elements from Caml uses the Caml type [float], which is + its elements from OCaml uses the OCaml type [float], which is 64-bit double precision floats. The abstract type [('a, 'b) kind] captures this association - of a Caml type ['a] for values read or written in the big array, + of an OCaml type ['a] for values read or written in the big array, and of an element kind ['b] which represents the actual contents of the big array. The following predefined values of type - [kind] list all possible associations of Caml types with + [kind] list all possible associations of OCaml types with element kinds: *) val float32 : (float, float32_elt) kind @@ -127,12 +127,12 @@ val nativeint : (nativeint, nativeint_elt) kind val char : (char, int8_unsigned_elt) kind (** As shown by the types of the values above, big arrays of kind [float32_elt] and [float64_elt] are - accessed using the Caml type [float]. Big arrays of complex kinds - [complex32_elt], [complex64_elt] are accessed with the Caml type + accessed using the OCaml type [float]. Big arrays of complex kinds + [complex32_elt], [complex64_elt] are accessed with the OCaml type {!Complex.t}. Big arrays of - integer kinds are accessed using the smallest Caml integer + integer kinds are accessed using the smallest OCaml integer type large enough to represent the array elements: - [int] for 8- and 16-bit integer bigarrays, as well as Caml-integer + [int] for 8- and 16-bit integer bigarrays, as well as OCaml-integer bigarrays; [int32] for 32-bit integer bigarrays; [int64] for 64-bit integer bigarrays; and [nativeint] for platform-native integer bigarrays. Finally, big arrays of @@ -195,7 +195,7 @@ module Genarray : The three type parameters to [Genarray.t] identify the array element kind and layout, as follows: - - the first parameter, ['a], is the Caml type for accessing array + - the first parameter, ['a], is the OCaml type for accessing array elements ([float], [int], [int32], [int64], [nativeint]); - the second parameter, ['b], is the actual kind of array elements ([float32_elt], [float64_elt], [int8_signed_elt], [int8_unsigned_elt], @@ -206,7 +206,7 @@ module Genarray : For instance, [(float, float32_elt, fortran_layout) Genarray.t] is the type of generic big arrays containing 32-bit floats in Fortran layout; reads and writes in this array use the - Caml type [float]. *) + OCaml type [float]. *) external create: ('a, 'b) kind -> 'c layout -> int array -> ('a, 'b, 'c) t = "caml_ba_create" @@ -440,7 +440,7 @@ module Genarray : module Array1 : sig type ('a, 'b, 'c) t (** The type of one-dimensional big arrays whose elements have - Caml type ['a], representation kind ['b], and memory layout ['c]. *) + OCaml type ['a], representation kind ['b], and memory layout ['c]. *) val create: ('a, 'b) kind -> 'c layout -> int -> ('a, 'b, 'c) t (** [Array1.create kind layout dim] returns a new bigarray of @@ -519,7 +519,7 @@ module Array2 : sig type ('a, 'b, 'c) t (** The type of two-dimensional big arrays whose elements have - Caml type ['a], representation kind ['b], and memory layout ['c]. *) + OCaml type ['a], representation kind ['b], and memory layout ['c]. *) val create: ('a, 'b) kind -> 'c layout -> int -> int -> ('a, 'b, 'c) t (** [Array2.create kind layout dim1 dim2] returns a new bigarray of @@ -622,7 +622,7 @@ module Array3 : sig type ('a, 'b, 'c) t (** The type of three-dimensional big arrays whose elements have - Caml type ['a], representation kind ['b], and memory layout ['c]. *) + OCaml type ['a], representation kind ['b], and memory layout ['c]. *) val create: ('a, 'b) kind -> 'c layout -> int -> int -> int -> ('a, 'b, 'c) t (** [Array3.create kind layout dim1 dim2 dim3] returns a new bigarray of diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index 7c751b7cf..ae9f73f97 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -130,8 +130,8 @@ caml_ba_multov(uintnat a, uintnat b, int * overflow) /* [caml_ba_alloc] will allocate a new bigarray object in the heap. If [data] is NULL, the memory for the contents is also allocated (with [malloc]) by [caml_ba_alloc]. - [data] cannot point into the Caml heap. - [dim] may point into an object in the Caml heap. + [data] cannot point into the OCaml heap. + [dim] may point into an object in the OCaml heap. */ CAMLexport value caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim) @@ -190,7 +190,7 @@ CAMLexport value caml_ba_alloc_dims(int flags, int num_dims, void * data, ...) return res; } -/* Allocate a bigarray from Caml */ +/* Allocate a bigarray from OCaml */ CAMLprim value caml_ba_create(value vkind, value vlayout, value vdim) { @@ -773,7 +773,7 @@ static void caml_ba_serialize(value v, caml_ba_serialize_longarray(b->data, num_elts, -0x80000000, 0x7FFFFFFF); break; } - /* Compute required size in Caml heap. Assumes struct caml_ba_array + /* Compute required size in OCaml heap. Assumes struct caml_ba_array is exactly 4 + num_dims words */ Assert(sizeof(struct caml_ba_array) == 5 * sizeof(value)); *wsize_32 = (4 + b->num_dims) * 4; @@ -794,7 +794,7 @@ static void caml_ba_deserialize_longarray(void * dest, intnat num_elts) #else if (sixty) caml_deserialize_error("input_value: cannot read bigarray " - "with 64-bit Caml ints"); + "with 64-bit OCaml ints"); caml_deserialize_block_4(dest, num_elts); #endif } @@ -905,7 +905,7 @@ CAMLprim value caml_ba_slice(value vb, value vind) sub_data = (char *) b->data + offset * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; - /* Allocate a Caml bigarray to hold the result */ + /* Allocate an OCaml bigarray to hold the result */ res = caml_ba_alloc(b->flags, b->num_dims - num_inds, sub_data, sub_dims); /* Create or update proxy in case of managed bigarray */ caml_ba_update_proxy(b, Caml_ba_array_val(res)); @@ -946,7 +946,7 @@ CAMLprim value caml_ba_sub(value vb, value vofs, value vlen) sub_data = (char *) b->data + ofs * mul * caml_ba_element_size[b->flags & CAML_BA_KIND_MASK]; - /* Allocate a Caml bigarray to hold the result */ + /* Allocate an OCaml bigarray to hold the result */ res = caml_ba_alloc(b->flags, b->num_dims, sub_data, b->dim); /* Doctor the changed dimension */ Caml_ba_array_val(res)->dim[changed_dim] = len; diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index 4d77c2e54..8e71664ab 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -55,7 +55,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, startpos = File_offset_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; - /* Extract dimensions from Caml array */ + /* Extract dimensions from OCaml array */ num_dims = Wosize_val(vdim); if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS) caml_invalid_argument("Bigarray.mmap: bad number of dimensions"); @@ -122,7 +122,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, caml_leave_blocking_section(); if (addr == (void *) MAP_FAILED) caml_sys_error(NO_ARG); addr = (void *) ((uintnat) addr + delta); - /* Build and return the Caml bigarray */ + /* Build and return the OCaml bigarray */ return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim); } diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c index 067e3284a..ded2270ee 100644 --- a/otherlibs/bigarray/mmap_win32.c +++ b/otherlibs/bigarray/mmap_win32.c @@ -62,7 +62,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, startpos = Int64_val(vstart); num_dims = Wosize_val(vdim); major_dim = flags & CAML_BA_FORTRAN_LAYOUT ? num_dims - 1 : 0; - /* Extract dimensions from Caml array */ + /* Extract dimensions from OCaml array */ num_dims = Wosize_val(vdim); if (num_dims < 1 || num_dims > CAML_BA_MAX_NUM_DIMS) caml_invalid_argument("Bigarray.mmap: bad number of dimensions"); @@ -117,7 +117,7 @@ CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout, addr = (void *) ((uintnat) addr + delta); /* Close the file mapping */ CloseHandle(fmap); - /* Build and return the Caml bigarray */ + /* Build and return the OCaml bigarray */ return caml_ba_alloc(flags | CAML_BA_MAPPED_FILE, num_dims, addr, dim); } diff --git a/otherlibs/graph/graphicsX11.mli b/otherlibs/graph/graphicsX11.mli index f35f5a664..0210d9676 100644 --- a/otherlibs/graph/graphicsX11.mli +++ b/otherlibs/graph/graphicsX11.mli @@ -18,12 +18,12 @@ type window_id = string val window_id : unit -> window_id -(** Return the unique identifier of the Caml graphics window. +(** Return the unique identifier of the OCaml graphics window. The returned string is an unsigned 32 bits integer in decimal form. *) val open_subwindow : x:int -> y:int -> width:int -> height:int -> window_id -(** Create a sub-window of the current Caml graphics window +(** Create a sub-window of the current OCaml graphics window and return its identifier. *) val close_subwindow : window_id -> unit diff --git a/otherlibs/graph/libgraph.h b/otherlibs/graph/libgraph.h index db3fd71d8..c8192e05b 100644 --- a/otherlibs/graph/libgraph.h +++ b/otherlibs/graph/libgraph.h @@ -55,7 +55,7 @@ extern int caml_gr_bits_per_pixel; #define DEFAULT_SCREEN_WIDTH 600 #define DEFAULT_SCREEN_HEIGHT 450 #define BORDER_WIDTH 2 -#define DEFAULT_WINDOW_NAME "Caml graphics" +#define DEFAULT_WINDOW_NAME "OCaml graphics" #define DEFAULT_SELECTED_EVENTS \ (ExposureMask | KeyPressMask | StructureNotifyMask) #define DEFAULT_FONT "fixed" diff --git a/otherlibs/labltk/README b/otherlibs/labltk/README index 5d3e9d314..6815b6669 100644 --- a/otherlibs/labltk/README +++ b/otherlibs/labltk/README @@ -13,11 +13,11 @@ In addition to the basic interface with Tcl/Tk, this package contains mlTk = CamlTk + LablTk ====================== -There existed two parallel Tcl/Tk interfaces for O'Caml, CamlTk and LablTk. +There existed two parallel Tcl/Tk interfaces for OCaml, CamlTk and LablTk. CamlTk uses classical features only, therefore it is easy to understand for -the beginners of ML. It makes many conservative O'Caml gurus also happy. -LablTk, on the other hand, uses rather newer features of O'Caml, the labeled +the beginners of ML. It makes many conservative OCaml gurus also happy. +LablTk, on the other hand, uses rather newer features of OCaml, the labeled optional arguments and polymorphic variants. Its syntax has much more Tcl/Tk script flavor, but provides more powerful typing than CamlTk at the same time (i.e. less run time type checking of widgets). @@ -44,9 +44,9 @@ OSF/1 V4.0 (alpha), DGUX SVR4 (m88k) and Windows (VC++ and Cygwin). INSTALLATION ============ -0. Check-out the O'Caml CVS source code tree. +0. Check-out the OCaml CVS source code tree. -1. Compile O'Caml (= make world). If you want, also make opt. +1. Compile OCaml (= make world). If you want, also make opt. 2. Untar this mlTk distribution in the otherlibs directory, just like the labltk source tree. @@ -55,9 +55,9 @@ INSTALLATION 4. To install the library, make install (and make installopt) -To compile mlTk, you need the O'Caml source tree, since mltk/camlbrowser -requires some modules of O'Caml. If you are not interested in camlbrowser, -you can compile mlTk without the O'Caml source tree, but you have to modify +To compile mlTk, you need the OCaml source tree, since mltk/camlbrowser +requires some modules of OCaml. If you are not interested in camlbrowser, +you can compile mlTk without the OCaml source tree, but you have to modify support/Makefile.common. diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml index 2735deb87..029cce70f 100644 --- a/otherlibs/labltk/compiler/compile.ml +++ b/otherlibs/labltk/compiler/compile.ml @@ -548,7 +548,7 @@ let write_TKtoCAML ~w name ~def:typdef = (* Converters *) (******************************) -(* Produce an in-lined converter Caml -> Tk for simple types *) +(* Produce an in-lined converter OCaml -> Tk for simple types *) (* the converter is a function of type: <type> -> string *) let rec converterCAMLtoTK ~context_widget argname ty = match ty with diff --git a/otherlibs/labltk/examples_camltk/eyes.ml b/otherlibs/labltk/examples_camltk/eyes.ml index ba88af343..b7636de42 100644 --- a/otherlibs/labltk/examples_camltk/eyes.ml +++ b/otherlibs/labltk/examples_camltk/eyes.ml @@ -14,7 +14,7 @@ (* *) (***********************************************************************) -(* The eyes of Caml (CamlTk) *) +(* The eyes of OCaml (CamlTk) *) open Camltk;; diff --git a/otherlibs/labltk/frx/frx_mem.mli b/otherlibs/labltk/frx/frx_mem.mli index 4f17fa79d..190297b5e 100644 --- a/otherlibs/labltk/frx/frx_mem.mli +++ b/otherlibs/labltk/frx/frx_mem.mli @@ -13,7 +13,7 @@ (* described in file LICENSE found in the OCaml source tree. *) (* *) (***********************************************************************) -(* A Garbage Collector Gauge for Caml *) +(* A Garbage Collector Gauge for OCaml *) val init : unit -> unit (* [init ()] creates the gauge and its updater, but keeps it iconified *) diff --git a/otherlibs/labltk/support/camltk.h b/otherlibs/labltk/support/camltk.h index 54671a075..29452aacc 100644 --- a/otherlibs/labltk/support/camltk.h +++ b/otherlibs/labltk/support/camltk.h @@ -33,7 +33,7 @@ #endif /* cltkMisc.c */ -/* copy a Caml string to the C heap. Must be deallocated with stat_free */ +/* copy an OCaml string to the C heap. Must be deallocated with stat_free */ extern char *string_to_c(value s); /* cltkUtf.c */ @@ -45,7 +45,7 @@ CAMLTKextern Tcl_Interp *cltclinterp; /* The Tcl interpretor */ extern value copy_string_list(int argc, char **argv); /* cltkCaml.c */ -/* pointers to Caml values */ +/* pointers to OCaml values */ extern value *tkerror_exn; extern value *handler_code; extern int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp, diff --git a/otherlibs/labltk/support/cltkCaml.c b/otherlibs/labltk/support/cltkCaml.c index f0372f14b..9a3d38a55 100644 --- a/otherlibs/labltk/support/cltkCaml.c +++ b/otherlibs/labltk/support/cltkCaml.c @@ -27,7 +27,7 @@ value * tkerror_exn = NULL; value * handler_code = NULL; -/* The Tcl command for evaluating callback in Caml */ +/* The Tcl command for evaluating callback in OCaml */ int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp, int argc, CONST84 char **argv) { @@ -41,7 +41,7 @@ int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp, return TCL_ERROR; callback2(*handler_code,Val_int(id), copy_string_list(argc - 2,(char **)&argv[2])); - /* Never fails (Caml would have raised an exception) */ + /* Never fails (OCaml would have raised an exception) */ /* but result may have been set by callback */ return TCL_OK; } @@ -69,14 +69,14 @@ CAMLprim void tk_error(char *errmsg) } -/* The initialisation of the C global variables pointing to Caml values - must be made accessible from Caml, so that we are sure that it *always* +/* The initialisation of the C global variables pointing to OCaml values + must be made accessible from OCaml, so that we are sure that it *always* takes place during loading of the protocol module */ CAMLprim value camltk_init(value v) { - /* Initialize the Caml pointers */ + /* Initialize the OCaml pointers */ if (tkerror_exn == NULL) tkerror_exn = caml_named_value("tkerror"); if (handler_code == NULL) diff --git a/otherlibs/labltk/support/cltkDMain.c b/otherlibs/labltk/support/cltkDMain.c index 7edb92a98..04af209de 100644 --- a/otherlibs/labltk/support/cltkDMain.c +++ b/otherlibs/labltk/support/cltkDMain.c @@ -35,7 +35,7 @@ /* - * Dealing with signals: when a signal handler is defined in Caml, + * Dealing with signals: when a signal handler is defined in OCaml, * the actual execution of the signal handler upon reception of the * signal is delayed until we are sure we are out of the GC. * If a signal occurs during the MainLoop, we would have to wait diff --git a/otherlibs/labltk/support/cltkEval.c b/otherlibs/labltk/support/cltkEval.c index 9ec3f1476..69ba6d8a1 100644 --- a/otherlibs/labltk/support/cltkEval.c +++ b/otherlibs/labltk/support/cltkEval.c @@ -32,7 +32,7 @@ /* The Tcl interpretor */ Tcl_Interp *cltclinterp = NULL; -/* Copy a list of strings from the C heap to Caml */ +/* Copy a list of strings from the C heap to OCaml */ value copy_string_list(int argc, char **argv) { CAMLparam0(); @@ -53,7 +53,7 @@ value copy_string_list(int argc, char **argv) } /* - * Calling Tcl from Caml + * Calling Tcl from OCaml * this version works on an arbitrary Tcl command, * and does parsing and substitution */ @@ -65,7 +65,7 @@ CAMLprim value camltk_tcl_eval(value str) CheckInit(); /* Tcl_Eval may write to its argument, so we take a copy - * If the evaluation raises a Caml exception, we have a space + * If the evaluation raises an OCaml exception, we have a space * leak */ Tcl_ResetResult(cltclinterp); @@ -84,7 +84,7 @@ CAMLprim value camltk_tcl_eval(value str) } /* - * Calling Tcl from Caml + * Calling Tcl from OCaml * direct call, argument is TkArgs vect type TkArgs = TkToken of string diff --git a/otherlibs/labltk/support/cltkMain.c b/otherlibs/labltk/support/cltkMain.c index be9c907c4..8751334c5 100644 --- a/otherlibs/labltk/support/cltkMain.c +++ b/otherlibs/labltk/support/cltkMain.c @@ -35,7 +35,7 @@ #endif /* - * Dealing with signals: when a signal handler is defined in Caml, + * Dealing with signals: when a signal handler is defined in OCaml, * the actual execution of the signal handler upon reception of the * signal is delayed until we are sure we are out of the GC. * If a signal occurs during the MainLoop, we would have to wait diff --git a/otherlibs/labltk/support/cltkMisc.c b/otherlibs/labltk/support/cltkMisc.c index 0e14cde81..a89ea341f 100644 --- a/otherlibs/labltk/support/cltkMisc.c +++ b/otherlibs/labltk/support/cltkMisc.c @@ -51,7 +51,7 @@ CAMLprim value camltk_splitlist (value v) } } -/* Copy a Caml string to the C heap. Should deallocate with stat_free */ +/* Copy an OCaml string to the C heap. Should deallocate with stat_free */ char *string_to_c(value s) { int l = string_length(s); diff --git a/otherlibs/labltk/support/cltkVar.c b/otherlibs/labltk/support/cltkVar.c index a508d2288..dcda8a77c 100644 --- a/otherlibs/labltk/support/cltkVar.c +++ b/otherlibs/labltk/support/cltkVar.c @@ -39,7 +39,7 @@ CAMLprim value camltk_getvar(value var) if (s == NULL) tk_error(Tcl_GetStringResult(cltclinterp)); - else + else return(tcl_string_to_caml(s)); } @@ -51,7 +51,7 @@ CAMLprim value camltk_setvar(value var, value contents) CheckInit(); /* SetVar makes a copy of the contents. */ - /* In case we have write traces in Caml, it's better to make sure that + /* In case we have write traces in OCaml, it's better to make sure that var doesn't move... */ stable_var = string_to_c(var); utf_contents = caml_string_to_tcl(contents); diff --git a/otherlibs/systhreads/st_posix.h b/otherlibs/systhreads/st_posix.h index 68ac00ddf..107d2f913 100644 --- a/otherlibs/systhreads/st_posix.h +++ b/otherlibs/systhreads/st_posix.h @@ -321,7 +321,7 @@ static void * caml_thread_tick(void * arg) struct timeval timeout; sigset_t mask; - /* Block all signals so that we don't try to execute a Caml signal handler */ + /* Block all signals so that we don't try to execute an OCaml signal handler*/ sigfillset(&mask); pthread_sigmask(SIG_BLOCK, &mask, NULL); /* Allow async cancellation */ diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c index 747549ee8..ba10205eb 100644 --- a/otherlibs/systhreads/st_stubs.c +++ b/otherlibs/systhreads/st_stubs.c @@ -94,7 +94,7 @@ static caml_thread_t all_threads = NULL; /* The descriptor for the currently executing thread */ static caml_thread_t curr_thread = NULL; -/* The master lock protecting the Caml runtime system */ +/* The master lock protecting the OCaml runtime system */ static st_masterlock caml_master_lock; /* Whether the ``tick'' thread is already running */ @@ -344,7 +344,7 @@ static value caml_thread_new_descriptor(value clos) static void caml_thread_remove_info(caml_thread_t th) { - if (th->next == th) all_threads = NULL; /* last Caml thread exiting */ + if (th->next == th) all_threads = NULL; /* last OCaml thread exiting */ th->next->prev = th->prev; th->prev->next = th->next; #ifndef NATIVE_CODE @@ -646,7 +646,7 @@ CAMLprim value caml_thread_exit(value unit) /* ML */ #endif caml_thread_stop(); if (exit_buf != NULL) { - /* Native-code and (main thread or thread created by Caml) */ + /* Native-code and (main thread or thread created by OCaml) */ siglongjmp(exit_buf->buf, 1); } else { /* Bytecode, or thread created from C */ diff --git a/otherlibs/systhreads/threads.h b/otherlibs/systhreads/threads.h index a0a407835..e822b494e 100644 --- a/otherlibs/systhreads/threads.h +++ b/otherlibs/systhreads/threads.h @@ -21,22 +21,22 @@ CAMLextern void caml_leave_blocking_section (void); #define caml_acquire_runtime_system caml_leave_blocking_section #define caml_release_runtime_system caml_enter_blocking_section -/* Manage the master lock around the Caml run-time system. - Only one thread at a time can execute Caml compiled code or - Caml run-time system functions. +/* Manage the master lock around the OCaml run-time system. + Only one thread at a time can execute OCaml compiled code or + OCaml run-time system functions. - When Caml calls a C function, the current thread holds the master + When OCaml calls a C function, the current thread holds the master lock. The C function can release it by calling - [caml_release_runtime_system]. Then, another thread can execute Caml - code. However, the calling thread must not access any Caml data, - nor call any runtime system function, nor call back into Caml. + [caml_release_runtime_system]. Then, another thread can execute OCaml + code. However, the calling thread must not access any OCaml data, + nor call any runtime system function, nor call back into OCaml. - Before returning to its Caml caller, or accessing Caml data, + Before returning to its OCaml caller, or accessing OCaml data, or call runtime system functions, the current thread must re-acquire the master lock by calling [caml_acquire_runtime_system]. - Symmetrically, if a C function (not called from Caml) wishes to - call back into Caml code, it should invoke [caml_acquire_runtime_system] + Symmetrically, if a C function (not called from OCaml) wishes to + call back into OCaml code, it should invoke [caml_acquire_runtime_system] first, then do the callback, then invoke [caml_release_runtime_system]. For historical reasons, alternate names can be used: @@ -49,9 +49,9 @@ CAMLextern void caml_leave_blocking_section (void); CAMLextern int caml_c_thread_register(void); CAMLextern int caml_c_thread_unregister(void); -/* If a thread is created by C code (instead of by Caml itself), - it must be registered with the Caml runtime system before - being able to call back into Caml code or use other runtime system +/* If a thread is created by C code (instead of by OCaml itself), + it must be registered with the OCaml runtime system before + being able to call back into OCaml code or use other runtime system functions. Just call [caml_c_thread_register] once. Before the thread finishes, it must call [caml_c_thread_unregister]. Both functions return 1 on success, 0 on error. diff --git a/otherlibs/win32graph/libgraph.h b/otherlibs/win32graph/libgraph.h index 96ac954e7..bae4b1162 100644 --- a/otherlibs/win32graph/libgraph.h +++ b/otherlibs/win32graph/libgraph.h @@ -43,8 +43,8 @@ extern int bits_per_pixel; #define DEFAULT_SCREEN_WIDTH 1024 #define DEFAULT_SCREEN_HEIGHT 768 #define BORDER_WIDTH 2 -#define WINDOW_NAME "Caml graphics" -#define ICON_NAME "Caml graphics" +#define WINDOW_NAME "OCaml graphics" +#define ICON_NAME "OCaml graphics" #define SIZE_QUEUE 256 void gr_fail(char *fmt, char *arg); diff --git a/otherlibs/win32graph/open.c b/otherlibs/win32graph/open.c index 8ffe259e5..a6bc59d45 100644 --- a/otherlibs/win32graph/open.c +++ b/otherlibs/win32graph/open.c @@ -238,7 +238,7 @@ static DWORD WINAPI gr_open_graph_internal(value arg) caml_gr_init_event_queue(); /* The global data structures are now correctly initialized. - Restart the Caml main thread. */ + Restart the OCaml main thread. */ open_graph_errmsg = NULL; SetEvent(open_graph_event); |