diff options
81 files changed, 264 insertions, 264 deletions
@@ -97,7 +97,7 @@ Shedding weight: OCaml 3.12.1: ----------------------- +------------- Bug fixes: - PR#4345, PR#4767: problems with camlp4 printing of float values @@ -47,7 +47,7 @@ The "configure" script accepts the following options: Directory where the binaries will be installed -libdir <dir> (default: /usr/local/lib/ocaml) - Directory where the Caml library will be installed + Directory where the OCaml library will be installed -mandir <dir> (default: /usr/local/man/man1) Directory where the manual pages will be installed @@ -237,9 +237,9 @@ autoconfiguration): ocamllex the lexer generator ocaml the interactive, toplevel-based system ocamlmktop a tool to make toplevel systems that integrate - user-defined C primitives and Caml code + user-defined C primitives and OCaml code ocamldebug the source-level replay debugger - ocamldep generator of "make" dependencies for Caml sources + ocamldep generator of "make" dependencies for OCaml sources ocamldoc documentation generator ocamlprof execution count profiler ocamlcp the bytecode compiler in profiling mode @@ -271,7 +271,7 @@ In the latter case, the destination directory defaults to the 9- After installation, do *not* strip the ocamldebug and ocamlbrowser executables. (These are mixed-mode executables, containing both -compiled C code and Caml bytecode; stripping erases the bytecode!) +compiled C code and OCaml bytecode; stripping erases the bytecode!) Other executables such as ocamlrun can safely be stripped. IF SOMETHING GOES WRONG: @@ -19,7 +19,7 @@ the generated programs deliver excellent performance, while retaining the moderate memory requirements of the bytecode compiler. The native-code compiler currently runs on the following platforms: -Tier 1 (actively used and maintained by the core Caml team): +Tier 1 (actively used and maintained by the core OCaml team): AMD64 (Opteron) Linux, MacOS X, MS Windows IA32 (Pentium) Linux, FreeBSD, MacOS X, MS Windows @@ -48,7 +48,7 @@ CONTENTS: LICENSE license and copyright notice Makefile main Makefile README this file - README.win32 infos on the MS Windows ports of O.Caml + README.win32 infos on the MS Windows ports of OCaml asmcomp/ native-code compiler and linker asmrun/ native-code runtime library boot/ bootstrap compiler @@ -58,7 +58,7 @@ CONTENTS: config/ autoconfiguration stuff debugger/ source-level replay debugger driver/ driver code for the compilers - emacs/ Caml editing mode and debugger interface for GNU Emacs + emacs/ OCaml editing mode and debugger interface for GNU Emacs lex/ lexer generator maccaml/ the Macintosh GUI ocamldoc/ documentation generator @@ -99,10 +99,10 @@ The complete OCaml distribution can be accessed at KEEPING IN TOUCH WITH THE CAML COMMUNITY: -There exists a mailing list of users of the Caml implementations +There exists a mailing list of users of the OCaml implementations developed at INRIA. The purpose of this list is to share experience, exchange ideas (and even code), and report on applications -of the Caml language. Messages can be written in English or in +of the OCaml language. Messages can be written in English or in French. The list has more than 1000 subscribers. Messages to the list should be sent to: @@ -117,7 +117,7 @@ Archives of the list are available on the Web site above. The Usenet news groups comp.lang.ml and comp.lang.functional also contains discussions about the ML family of programming languages, -including Caml. +including OCaml. BUG REPORTS AND USER FEEDBACK: diff --git a/README.win32 b/README.win32 index 627204406..78d32c804 100644 --- a/README.win32 +++ b/README.win32 @@ -59,7 +59,7 @@ runs without any additional tools. The native-code compiler (ocamlopt) requires the Microsoft Windows SDK (item [1]) and the flexdll tool (item [2]). -Statically linking Caml bytecode with C code (ocamlc -custom) also requires +Statically linking OCaml bytecode with C code (ocamlc -custom) also requires items [1] and [2]. The LablTk GUI requires Tcl/Tk 8.5 (item [3]). @@ -177,7 +177,7 @@ CREDITS: The initial port of Caml Special Light (the ancestor of OCaml) to Windows NT was done by Kevin Gallo at Microsoft Research, who kindly -contributed his changes to the Caml project. +contributed his changes to the OCaml project. The graphical user interface for the toplevel was initially developed by Jacob Navia, then significantly improved by Christopher A. Watford. @@ -195,7 +195,7 @@ The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) runs without any additional tools. The native-code compiler (ocamlopt), as well as static linking of -Caml bytecode with C code (ocamlc -custom), require +OCaml bytecode with C code (ocamlc -custom), require the Cygwin development tools, available at http://www.cygwin.com/ and the flexdll tool, available at @@ -344,7 +344,7 @@ Windows 7 64 on Intel64/AMD64 machines. The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) runs without any additional tools. -Statically linking Caml bytecode with C code (ocamlc -custom) requires the +Statically linking OCaml bytecode with C code (ocamlc -custom) requires the Microsoft Platform SDK compiler (item [1] in the section "third-party software" below) and the flexdll tool (item [2]). diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index 097c6cd2e..5e0d763ba 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -653,7 +653,7 @@ let emit_profile () = | "linux" | "gnu" -> (* mcount preserves rax, rcx, rdx, rsi, rdi, r8, r9 explicitly and rbx, rbp, r12-r15 like all C functions. - We need to preserve r10 and r11 ourselves, since Caml can + We need to preserve r10 and r11 ourselves, since OCaml can use them for argument passing. *) ` pushq %r10\n`; ` movq %rsp, %rbp\n`; diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml index fa0387bb6..01132e6cb 100644 --- a/asmcomp/amd64/proc.ml +++ b/asmcomp/amd64/proc.ml @@ -56,10 +56,10 @@ let masm = xmm0 - xmm15 100 - 115 *) (* Conventions: - rax - r11: Caml function arguments - rax: Caml and C function results - xmm0 - xmm9: Caml function arguments - xmm0: Caml and C function results + rax - r11: OCaml function arguments + rax: OCaml and C function results + xmm0 - xmm9: OCaml function arguments + xmm0: OCaml and C function results Under Unix: rdi, rsi, rdx, rcx, r8, r9: C function arguments xmm0 - xmm7: C function arguments diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index 47b334821..d6eba0ff4 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -824,7 +824,7 @@ method emit_fundecl f = end (* Tail call criterion (estimated). Assumes: -- all arguments are of type "int" (always the case for Caml function calls) +- all arguments are of type "int" (always the case for OCaml function calls) - one extra argument representing the closure environment (conservative). *) diff --git a/asmrun/amd64.S b/asmrun/amd64.S index 791b2f411..5208fa83f 100644 --- a/asmrun/amd64.S +++ b/asmrun/amd64.S @@ -210,7 +210,7 @@ #endif #ifdef SYS_mingw64 - /* Calls from Caml to C must reserve 32 bytes of extra stack space */ + /* Calls from OCaml to C must reserve 32 bytes of extra stack space */ # define PREPARE_FOR_C_CALL subq $32, %rsp # define CLEANUP_AFTER_C_CALL addq $32, %rsp #else @@ -355,7 +355,7 @@ LBL(103): popq %rax /* recover desired size */ jmp LBL(caml_allocN) -/* Call a C function from Caml */ +/* Call a C function from OCaml */ FUNCTION(G(caml_c_call)) LBL(caml_c_call): @@ -376,7 +376,7 @@ LBL(caml_c_call): pushq %r12 ret -/* Start the Caml program */ +/* Start the OCaml program */ FUNCTION(G(caml_start_program)) /* Save callee-save registers */ @@ -398,7 +398,7 @@ LBL(caml_start_program): pushq %r13 pushq %r14 movq %rsp, %r14 - /* Call the Caml code */ + /* Call the OCaml code */ call *%r12 LBL(107): /* Pop the exception handler */ @@ -437,7 +437,7 @@ LBL(108): #define C_ARG_4 %rcx #endif -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ FUNCTION(G(caml_raise_exn)) TESTL_VAR($1, caml_backtrace_active) @@ -482,7 +482,7 @@ LBL(111): LOAD_VAR(caml_young_ptr,%r15) /* Reload alloc ptr */ ret -/* Callback from C to Caml */ +/* Callback from C to OCaml */ FUNCTION(G(caml_callback_exn)) /* Save callee-save registers */ diff --git a/asmrun/amd64nt.asm b/asmrun/amd64nt.asm index 2a38fd9f3..7dfb31437 100644 --- a/asmrun/amd64nt.asm +++ b/asmrun/amd64nt.asm @@ -192,7 +192,7 @@ L103: pop rax ; recover desired size jmp caml_allocN -; Call a C function from Caml +; Call a C function from OCaml PUBLIC caml_c_call ALIGN 16 @@ -212,7 +212,7 @@ caml_c_call: push r12 ret -; Start the Caml program +; Start the OCaml program PUBLIC caml_start_program ALIGN 16 @@ -254,7 +254,7 @@ L106: push r13 push r14 mov r14, rsp - ; Call the Caml code + ; Call the OCaml code call r12 L107: ; Pop the exception handler @@ -297,7 +297,7 @@ L108: or rax, 2 jmp L109 -; Raise an exception from Caml +; Raise an exception from OCaml PUBLIC caml_raise_exn ALIGN 16 @@ -346,7 +346,7 @@ L111: mov r15, caml_young_ptr ; Reload alloc ptr ret -; Callback from C to Caml +; Callback from C to OCaml PUBLIC caml_callback_exn ALIGN 16 diff --git a/asmrun/arm.S b/asmrun/arm.S index c5953dcb7..ce32a40f1 100644 --- a/asmrun/arm.S +++ b/asmrun/arm.S @@ -183,7 +183,7 @@ caml_allocN: .type caml_allocN, %function .size caml_allocN, .-caml_allocN -/* Call a C function from Caml */ +/* Call a C function from OCaml */ /* Function to call is in r7 */ .align 2 @@ -213,7 +213,7 @@ caml_c_call: .type caml_c_call, %function .size caml_c_call, .-caml_c_call -/* Start the Caml program */ +/* Start the OCaml program */ .align 2 .globl caml_start_program @@ -222,8 +222,8 @@ caml_start_program: ldr r12, =caml_program /* Code shared with caml_callback* */ -/* Address of Caml code to call is in r12 */ -/* Arguments to the Caml code are in r0...r3 */ +/* Address of OCaml code to call is in r12 */ +/* Arguments to the OCaml code are in r0...r3 */ .Ljump_to_caml: /* Save return address and callee-save registers */ @@ -240,7 +240,7 @@ caml_start_program: str r4, [sp, 0] str r5, [sp, 4] str r6, [sp, 8] - /* Setup a trap frame to catch exceptions escaping the Caml code */ + /* Setup a trap frame to catch exceptions escaping the OCaml code */ sub sp, sp, 2*4 ldr r6, =caml_exception_pointer ldr r5, =.Ltrap_handler @@ -253,7 +253,7 @@ caml_start_program: ldr alloc_ptr, [r4] ldr r4, =caml_young_limit ldr alloc_limit, [r4] - /* Call the Caml code */ + /* Call the OCaml code */ blx r12 .Lcaml_retaddr: /* Pop the trap frame, restoring caml_exception_pointer */ @@ -299,7 +299,7 @@ caml_start_program: .type .Ltrap_handler, %function .size .Ltrap_handler, .-.Ltrap_handler -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ .align 2 .globl caml_raise_exn @@ -359,7 +359,7 @@ caml_raise_exception: .type caml_raise_exception, %function .size caml_raise_exception, .-caml_raise_exception -/* Callback from C to Caml */ +/* Callback from C to OCaml */ .align 2 .globl caml_callback_exn diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c index c9581dd27..7b47c0bfc 100644 --- a/asmrun/backtrace.c +++ b/asmrun/backtrace.c @@ -193,7 +193,7 @@ void caml_print_exception_backtrace(void) } } -/* Convert the backtrace to a data structure usable from Caml */ +/* Convert the backtrace to a data structure usable from OCaml */ CAMLprim value caml_get_exception_backtrace(value unit) { diff --git a/asmrun/i386.S b/asmrun/i386.S index fc91d393f..663d61753 100644 --- a/asmrun/i386.S +++ b/asmrun/i386.S @@ -200,7 +200,7 @@ LBL(103): popl %eax /* recover desired size */ jmp G(caml_allocN) -/* Call a C function from Caml */ +/* Call a C function from OCaml */ .globl G(caml_c_call) .align FUNCTION_ALIGN @@ -214,7 +214,7 @@ G(caml_c_call): /* Call the function (address in %eax) */ jmp *%eax -/* Start the Caml program */ +/* Start the OCaml program */ .globl G(caml_start_program) .align FUNCTION_ALIGN @@ -239,7 +239,7 @@ LBL(106): ALIGN_STACK(8) pushl G(caml_exception_pointer) movl %esp, G(caml_exception_pointer) - /* Call the Caml code */ + /* Call the OCaml code */ call *%esi LBL(107): /* Pop the exception handler */ @@ -267,7 +267,7 @@ LBL(108): orl $2, %eax jmp LBL(109) -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ .globl G(caml_raise_exn) .align FUNCTION_ALIGN @@ -322,7 +322,7 @@ LBL(111): UNDO_ALIGN_STACK(8) ret -/* Callback from C to Caml */ +/* Callback from C to OCaml */ .globl G(caml_callback_exn) .align FUNCTION_ALIGN diff --git a/asmrun/i386nt.asm b/asmrun/i386nt.asm index 02c6ff564..7649a8a41 100644 --- a/asmrun/i386nt.asm +++ b/asmrun/i386nt.asm @@ -134,7 +134,7 @@ L103: sub eax, _caml_young_ptr ; eax = - size pop eax ; recover desired size jmp _caml_allocN -; Call a C function from Caml +; Call a C function from OCaml PUBLIC _caml_c_call ALIGN 4 @@ -147,7 +147,7 @@ _caml_c_call: ; Call the function (address in %eax) jmp eax -; Start the Caml program +; Start the OCaml program PUBLIC _caml_start_program ALIGN 4 @@ -171,7 +171,7 @@ L106: push L108 push _caml_exception_pointer mov _caml_exception_pointer, esp - ; Call the Caml code + ; Call the OCaml code call esi L107: ; Pop the exception handler @@ -196,7 +196,7 @@ L108: or eax, 2 jmp L109 -; Raise an exception for Caml +; Raise an exception for OCaml PUBLIC _caml_raise_exn ALIGN 4 @@ -244,7 +244,7 @@ L111: pop _caml_exception_pointer ret -; Callback from C to Caml +; Callback from C to OCaml PUBLIC _caml_callback_exn ALIGN 4 diff --git a/asmrun/ia64.S b/asmrun/ia64.S index 4680aa932..f7bd90c5f 100644 --- a/asmrun/ia64.S +++ b/asmrun/ia64.S @@ -166,7 +166,7 @@ caml_call_gc: cmp.ltu p6, p0 = r4, r5 /* enough space? */ (p6) br.cond.spnt .L100 ;; /* no: call GC again */ - /* Reload return address and say that we are back into Caml code */ + /* Reload return address and say that we are back into OCaml code */ ADDRGLOBAL(r3, caml_last_return_address#) ;; ld8 r2 = [r3] st8 [r3] = r0 ;; @@ -178,7 +178,7 @@ caml_call_gc: .endp caml_call_gc# -/* Call a C function from Caml */ +/* Call a C function from OCaml */ /* Function to call is in r2 */ .global caml_c_call# @@ -186,7 +186,7 @@ caml_call_gc: .align 16 caml_c_call: - /* The Caml code that called us does not expect any + /* The OCaml code that called us does not expect any code-generator registers to be preserved */ /* Recover entry point from the function pointer in r2 */ @@ -218,7 +218,7 @@ caml_c_call: LOADGLOBAL(r4, caml_young_ptr#) LOADGLOBAL(r5, caml_young_limit#) - /* Reload return address and say that we are back into Caml code */ + /* Reload return address and say that we are back into OCaml code */ ADDRGLOBAL(r3, caml_last_return_address#) ;; ld8 r2 = [r3] st8 [r3] = r0 ;; @@ -229,7 +229,7 @@ caml_c_call: .endp caml_c_call# -/* Start the Caml program */ +/* Start the OCaml program */ .global caml_start_program# .proc caml_start_program# @@ -241,7 +241,7 @@ caml_start_program: /* Code shared with caml_callback* */ .L103: - /* Allocate 64 "out" registers (for the Caml code) and no locals */ + /* Allocate 64 "out" registers (for the OCaml code) and no locals */ alloc r3 = ar.pfs, 0, 0, 64, 0 add sp = -(56 * 8), sp ;; @@ -296,7 +296,7 @@ caml_start_program: LOADGLOBAL(r3, caml_saved_rnat#) ;; ST8OFF(r2, r3, 8) - /* Set up a trap frame to catch exceptions escaping the Caml code */ + /* Set up a trap frame to catch exceptions escaping the OCaml code */ mov r6 = sp add sp = -16, sp ;; LOADGLOBAL(r3, caml_exception_pointer#) @@ -321,10 +321,10 @@ caml_start_program: LOADGLOBAL(r4, caml_young_ptr#) LOADGLOBAL(r5, caml_young_limit#) - /* We are back into Caml code */ + /* We are back into OCaml code */ STOREGLOBAL(r0, caml_last_return_address#) - /* Call the Caml code */ + /* Call the OCaml code */ br.call.sptk b0 = b6 ;; .L102: @@ -408,11 +408,11 @@ caml_start_program: .proc caml_raise_exception# .align 16 caml_raise_exception: - /* Allocate 64 "out" registers (for the Caml code) and no locals */ + /* Allocate 64 "out" registers (for the OCaml code) and no locals */ /* Since we don't return, don't bother saving the PFS */ alloc r2 = ar.pfs, 0, 0, 64, 0 - /* Move exn bucket where Caml expects it */ + /* Move exn bucket where OCaml expects it */ mov r8 = r32 ;; /* Perform "context switch" as per the Software Conventions Guide, @@ -434,7 +434,7 @@ caml_raise_exception: LOADGLOBAL(r5, caml_young_limit#) LOADGLOBAL(r6, caml_exception_pointer#) - /* Say that we're back into Caml */ + /* Say that we're back into OCaml */ STOREGLOBAL(r0, caml_last_return_address#) /* Raise the exception proper */ @@ -450,7 +450,7 @@ caml_raise_exception: .endp caml_raise_exception -/* Callbacks from C to Caml */ +/* Callbacks from C to OCaml */ .global caml_callback_exn# .proc caml_callback_exn# diff --git a/asmrun/power-elf.S b/asmrun/power-elf.S index 34ef6cc21..0b3493688 100644 --- a/asmrun/power-elf.S +++ b/asmrun/power-elf.S @@ -33,7 +33,7 @@ caml_call_gc: /* Set up stack frame */ stwu 1, -0x1A0(1) /* 0x1A0 = 4*32 (int regs) + 8*32 (float regs) + 32 (space for C call) */ - /* Record return address into Caml code */ + /* Record return address into OCaml code */ mflr 0 Storeglobal(0, caml_last_return_address, 11) /* Record lowest stack address */ @@ -169,7 +169,7 @@ caml_call_gc: Loadglobal(0, caml_last_return_address, 11) addic 0, 0, -16 /* Restart the allocation (4 instructions) */ mtlr 0 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 12, 0 Storeglobal(12, caml_last_return_address, 11) /* Deallocate stack frame */ @@ -177,7 +177,7 @@ caml_call_gc: /* Return */ blr -/* Call a C function from Caml */ +/* Call a C function from OCaml */ .globl caml_c_call .type caml_c_call, @function @@ -199,7 +199,7 @@ caml_c_call: /* Reload allocation pointer and allocation limit*/ Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 12, 0 Storeglobal(12, caml_last_return_address, 11) /* Return to caller */ @@ -210,11 +210,11 @@ caml_c_call: .globl caml_raise_exception .type caml_raise_exception, @function caml_raise_exception: - /* Reload Caml global registers */ + /* Reload OCaml global registers */ Loadglobal(1, caml_exception_pointer, 11) Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 0, 0 Storeglobal(0, caml_last_return_address, 11) /* Pop trap frame */ @@ -225,7 +225,7 @@ caml_raise_exception: /* Branch to handler */ blr -/* Start the Caml program */ +/* Start the OCaml program */ .globl caml_start_program .type caml_start_program, @function @@ -287,7 +287,7 @@ caml_start_program: stw 9, 0(1) stw 10, 4(1) stw 11, 8(1) - /* Build an exception handler to catch exceptions escaping out of Caml */ + /* Build an exception handler to catch exceptions escaping out of OCaml */ bl .L103 b .L104 .L103: @@ -300,10 +300,10 @@ caml_start_program: /* Reload allocation pointers */ Loadglobal(31, caml_young_ptr, 11) Loadglobal(30, caml_young_limit, 11) - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li 0, 0 Storeglobal(0, caml_last_return_address, 11) - /* Call the Caml code */ + /* Call the OCaml code */ mtlr 12 .L105: blrl @@ -375,7 +375,7 @@ caml_start_program: ori 3, 3, 2 b .L106 -/* Callback from C to Caml */ +/* Callback from C to OCaml */ .globl caml_callback_exn .type caml_callback_exn, @function diff --git a/asmrun/power-rhapsody.S b/asmrun/power-rhapsody.S index ab7f5384c..334d6a31a 100644 --- a/asmrun/power-rhapsody.S +++ b/asmrun/power-rhapsody.S @@ -48,7 +48,7 @@ _caml_call_gc: /* Set up stack frame */ #define FRAMESIZE (32*WORD + 32*8 + 32) stwu r1, -FRAMESIZE(r1) - /* Record return address into Caml code */ + /* Record return address into OCaml code */ mflr r0 Storeglobal r0, _caml_last_return_address, r11 /* Record lowest stack address */ @@ -184,7 +184,7 @@ _caml_call_gc: Loadglobal r0, _caml_last_return_address, r11 addic r0, r0, -16 /* Restart the allocation (4 instructions) */ mtlr r0 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r12, 0 Storeglobal r12, _caml_last_return_address, r11 /* Deallocate stack frame */ @@ -193,7 +193,7 @@ _caml_call_gc: blr #undef FRAMESIZE -/* Call a C function from Caml */ +/* Call a C function from OCaml */ .globl _caml_c_call _caml_c_call: @@ -214,13 +214,13 @@ _caml_c_call: /* Reload allocation pointer and allocation limit*/ Loadglobal r31, _caml_young_ptr, r11 Loadglobal r30, _caml_young_limit, r11 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r12, 0 Storeglobal r12, _caml_last_return_address, r11 /* Return to caller */ blr -/* Raise an exception from Caml */ +/* Raise an exception from OCaml */ .globl _caml_raise_exn _caml_raise_exn: addis r11, 0, ha16(_caml_backtrace_active) @@ -257,11 +257,11 @@ _caml_raise_exception: cmpwi r11, 0 bne L112 L113: - /* Reload Caml global registers */ + /* Reload OCaml global registers */ Loadglobal r1, _caml_exception_pointer, r11 Loadglobal r31, _caml_young_ptr, r11 Loadglobal r30, _caml_young_limit, r11 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r0, 0 Storeglobal r0, _caml_last_return_address, r11 /* Pop trap frame */ @@ -282,7 +282,7 @@ L112: mr r3, r28 b L113 -/* Start the Caml program */ +/* Start the OCaml program */ .globl _caml_start_program _caml_start_program: @@ -343,7 +343,7 @@ L102: stg r9, 0(r1) stg r10, WORD(r1) stg r11, 2*WORD(r1) - /* Build an exception handler to catch exceptions escaping out of Caml */ + /* Build an exception handler to catch exceptions escaping out of OCaml */ bl L103 b L104 L103: @@ -356,10 +356,10 @@ L103: /* Reload allocation pointers */ Loadglobal r31, _caml_young_ptr, r11 Loadglobal r30, _caml_young_limit, r11 - /* Say we are back into Caml code */ + /* Say we are back into OCaml code */ li r0, 0 Storeglobal r0, _caml_last_return_address, r11 - /* Call the Caml code */ + /* Call the OCaml code */ mtctr r12 L105: bctrl @@ -432,7 +432,7 @@ L104: b L106 #undef FRAMESIZE -/* Callback from C to Caml */ +/* Callback from C to OCaml */ .globl _caml_callback_exn _caml_callback_exn: diff --git a/asmrun/roots.c b/asmrun/roots.c index 4a495e2c1..edb7429d7 100644 --- a/asmrun/roots.c +++ b/asmrun/roots.c @@ -129,7 +129,7 @@ void caml_init_frame_descriptors(void) char * caml_top_of_stack; char * caml_bottom_of_stack = NULL; /* no stack initially */ -uintnat caml_last_return_address = 1; /* not in Caml code initially */ +uintnat caml_last_return_address = 1; /* not in OCaml code initially */ value * caml_gc_regs; intnat caml_globals_inited = 0; static intnat caml_globals_scanned = 0; diff --git a/asmrun/signals_asm.c b/asmrun/signals_asm.c index 556bd945b..09bc8abc1 100644 --- a/asmrun/signals_asm.c +++ b/asmrun/signals_asm.c @@ -53,7 +53,7 @@ extern char * caml_code_area_start, * caml_code_area_end; || (Classify_addr(pc) & In_code_area) ) /* This routine is the common entry point for garbage collection - and signal handling. It can trigger a callback to Caml code. + and signal handling. It can trigger a callback to OCaml code. With system threads, this callback can cause a context switch. Hence [caml_garbage_collection] must not be called from regular C code (e.g. the [caml_alloc] function) because the context of the call @@ -83,7 +83,7 @@ DECLARE_SIGNAL_HANDLER(handle_signal) caml_record_signal(sig); /* Some ports cache [caml_young_limit] in a register. Use the signal context to modify that register too, but only if - we are inside Caml code (not inside C code). */ + we are inside OCaml code (not inside C code). */ #if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT) if (Is_in_code_area(CONTEXT_PC)) CONTEXT_YOUNG_LIMIT = (context_reg) caml_young_limit; @@ -193,7 +193,7 @@ DECLARE_SIGNAL_HANDLER(segv_handler) /* Sanity checks: - faulting address is word-aligned - faulting address is within the stack - - we are in Caml code */ + - we are in OCaml code */ fault_addr = CONTEXT_FAULTING_ADDRESS; if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0 && getrlimit(RLIMIT_STACK, &limit) == 0 diff --git a/asmrun/sparc.S b/asmrun/sparc.S index dd1e5844a..ed4e34987 100644 --- a/asmrun/sparc.S +++ b/asmrun/sparc.S @@ -217,7 +217,7 @@ L100: add %sp, 96 + 15*8, %g1 retl add %sp, 20*4 + 15*8, %sp /* in delay slot */ -/* Call a C function from Caml */ +/* Call a C function from OCaml */ .global Caml_c_call /* Function to call is in %g2 */ @@ -239,7 +239,7 @@ Caml_c_call: retl ld [%g1 + %lo(Caml_young_ptr)], Alloc_ptr /* in delay slot */ -/* Start the Caml program */ +/* Start the OCaml program */ .global Caml_start_program Caml_start_program: @@ -257,7 +257,7 @@ L108: Load(Caml_gc_regs, %l3) st %l0, [%sp + 96] st %l1, [%sp + 100] - /* Set up a trap frame to catch exceptions escaping the Caml code */ + /* Set up a trap frame to catch exceptions escaping the OCaml code */ call L111 st %l3, [%sp + 104] b L110 @@ -274,7 +274,7 @@ L111: sub %sp, 8, %sp #else Load(Caml_young_limit, Alloc_limit) #endif - /* Call the Caml code */ + /* Call the OCaml code */ L109: call %l2 nop /* Pop trap frame and restore caml_exception_pointer */ diff --git a/asmrun/stack.h b/asmrun/stack.h index 2609d391c..907d51c79 100644 --- a/asmrun/stack.h +++ b/asmrun/stack.h @@ -88,11 +88,11 @@ #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) #endif -/* Structure of Caml callback contexts */ +/* Structure of OCaml callback contexts */ struct caml_context { - char * bottom_of_stack; /* beginning of Caml stack chunk */ - uintnat last_retaddr; /* last return address in Caml code */ + char * bottom_of_stack; /* beginning of OCaml stack chunk */ + uintnat last_retaddr; /* last return address in OCaml code */ value * gc_regs; /* pointer to register block */ }; diff --git a/bytecomp/instruct.ml b/bytecomp/instruct.ml index a26c09458..7757c7d48 100644 --- a/bytecomp/instruct.ml +++ b/bytecomp/instruct.ml @@ -107,5 +107,5 @@ let immed_min = -0x40000000 and immed_max = 0x3FFFFFFF (* Actually the abstract machine accomodates -0x80000000 to 0x7FFFFFFF, - but these numbers overflow the Caml type int if the compiler runs on + but these numbers overflow the OCaml type int if the compiler runs on a 32-bit processor. *) diff --git a/byterun/backtrace.c b/byterun/backtrace.c index 7b8ddca88..b5efdc3db 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -118,7 +118,7 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp) } /* Read the debugging info contained in the current bytecode executable. - Return a Caml array of Caml lists of debug_event records in "events", + Return an OCaml array of OCaml lists of debug_event records in "events", or Val_false on failure. */ #ifndef O_BINARY @@ -274,7 +274,7 @@ CAMLexport void caml_print_exception_backtrace(void) } } -/* Convert the backtrace to a data structure usable from Caml */ +/* Convert the backtrace to a data structure usable from OCaml */ CAMLprim value caml_get_exception_backtrace(value unit) { diff --git a/byterun/callback.c b/byterun/callback.c index 0d781259a..c7fc77220 100644 --- a/byterun/callback.c +++ b/byterun/callback.c @@ -13,7 +13,7 @@ /* $Id$ */ -/* Callbacks from C to Caml */ +/* Callbacks from C to OCaml */ #include <string.h> #include "callback.h" @@ -195,7 +195,7 @@ CAMLexport value caml_callbackN (value closure, int narg, value args[]) return res; } -/* Naming of Caml values */ +/* Naming of OCaml values */ struct named_value { value val; diff --git a/byterun/callback.h b/byterun/callback.h index 829f6b884..dd094c4de 100644 --- a/byterun/callback.h +++ b/byterun/callback.h @@ -13,7 +13,7 @@ /* $Id$ */ -/* Callbacks from C to Caml */ +/* Callbacks from C to OCaml */ #ifndef CAML_CALLBACK_H #define CAML_CALLBACK_H diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index 287122043..b5c436679 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -133,7 +133,7 @@ static value heap_stats (int returnstats) header_t cur_hd; #ifdef DEBUG - caml_gc_message (-1, "### O'Caml runtime: heap check ###\n", 0); + caml_gc_message (-1, "### OCaml runtime: heap check ###\n", 0); #endif while (chunk != NULL){ diff --git a/byterun/hash.c b/byterun/hash.c index 903c648f2..26a1bf597 100644 --- a/byterun/hash.c +++ b/byterun/hash.c @@ -146,7 +146,7 @@ CAMLexport uint32 caml_hash_mix_float(uint32 hash, float d) return hash; } -/* Mix a Caml string */ +/* Mix an OCaml string */ CAMLexport uint32 caml_hash_mix_string(uint32 h, value s) { @@ -271,7 +271,7 @@ CAMLprim value caml_hash(value count, value limit, value seed, value obj) /* Final mixing of bits */ FINAL_MIX(h); /* Fold result to the range [0, 2^30-1] so that it is a nonnegative - Caml integer both on 32 and 64-bit platforms. */ + OCaml integer both on 32 and 64-bit platforms. */ return Val_int(h & 0x3FFFFFFFU); } diff --git a/byterun/intext.h b/byterun/intext.h index b771a34ad..0b1597666 100644 --- a/byterun/intext.h +++ b/byterun/intext.h @@ -104,7 +104,7 @@ value caml_input_val (struct channel * chan); /* </private> */ CAMLextern value caml_input_val_from_string (value str, intnat ofs); - /* Read a structured value from the Caml string [str], starting + /* Read a structured value from the OCaml string [str], starting at offset [ofs]. */ CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs); /* Read a structured value from a malloced buffer. [data] points diff --git a/byterun/ints.c b/byterun/ints.c index 4fa1657be..34b5db238 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -142,7 +142,7 @@ static char * parse_format(value fmt, char lastletter; mlsize_t len, len_suffix; - /* Copy Caml format fmt to format_string, + /* Copy OCaml format fmt to format_string, adding the suffix before the last letter of the format */ len = caml_string_length(fmt); len_suffix = strlen(suffix); diff --git a/byterun/io.c b/byterun/io.c index 90a399510..600887a88 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -117,7 +117,7 @@ CAMLexport file_offset caml_channel_size(struct channel *channel) file_offset end; int fd; - /* We extract data from [channel] before dropping the Caml lock, in case + /* We extract data from [channel] before dropping the OCaml lock, in case someone else touches the block. */ fd = channel->fd; offset = channel->offset; @@ -411,7 +411,7 @@ CAMLexport intnat caml_input_scan_line(struct channel *channel) return (p - channel->curr); } -/* Caml entry points for the I/O functions. Wrap struct channel * +/* OCaml entry points for the I/O functions. Wrap struct channel * objects into a heap-allocated object. Perform locking and unlocking around the I/O operations. */ /* FIXME CAMLexport, but not in io.h exported for Cash ? */ diff --git a/byterun/memory.h b/byterun/memory.h index cbeeb756f..dddf9a36b 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -181,7 +181,7 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ your function. Do NOT directly return a [value] with the [return] keyword. If your function returns void, use [CAMLreturn0]. - All the identifiers beginning with "caml__" are reserved by Caml. + All the identifiers beginning with "caml__" are reserved by OCaml. Do not use them for anything (local or global variables, struct or union tags, macros, etc.) */ @@ -346,7 +346,7 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ It must contain all values in C local variables and function parameters at the time the minor GC is called. Usage: - After initialising your local variables to legal Caml values, but before + After initialising your local variables to legal OCaml values, but before calling allocation functions, insert [Begin_roots_n(v1, ... vn)], where v1 ... vn are your variables of type [value] that you want to be updated across allocations. @@ -440,7 +440,7 @@ CAMLextern void caml_remove_global_root (value *); the value of this variable, it must do so by calling [caml_modify_generational_global_root]. The [value *] pointer passed to [caml_register_generational_global_root] must contain - a valid Caml value before the call. + a valid OCaml value before the call. In return for these constraints, scanning of memory roots during minor collection is made more efficient. */ diff --git a/byterun/obj.c b/byterun/obj.c index f095df5ae..7d09105b7 100644 --- a/byterun/obj.c +++ b/byterun/obj.c @@ -171,7 +171,7 @@ CAMLprim value caml_obj_add_offset (value v, value offset) } /* The following functions are used in stdlib/lazy.ml. - They are not written in O'Caml because they must be atomic with respect + They are not written in OCaml because they must be atomic with respect to the GC. */ diff --git a/emacs/README b/emacs/README index ea82a9fd4..9c30c8892 100644 --- a/emacs/README +++ b/emacs/README @@ -123,7 +123,7 @@ Version 1.07: Version 1.06: ------------ -* new keywords in O'Caml 1.06 +* new keywords in Objective Caml 1.06 * compatibility with GNU Emacs 20 @@ -153,7 +153,7 @@ Version 1.03b: (setq caml-quote-char "`") (setq inferior-caml-program "camllight") Literals will be correctly understood and highlighted. However, - indentation rules are still Objective Caml's: this just happens to + indentation rules are still OCaml's: this just happens to work well in most cases, but is only intended for occasional use. * as many people asked for it, application is now indented. This seems @@ -167,10 +167,10 @@ Version 1.03b: Version 1.03: ------------ -* support of Objective Caml and Objective Label. +* support of OCaml and Objective Label. * an indentation very close to mine, which happens to be the same as - Xavier's, since the sources of the Objective Caml compiler do not + Xavier's, since the sources of the OCaml compiler do not change if you indent them in this mode. * highlighting. @@ -178,7 +178,7 @@ Version 1.03: Some remarks about the style supported: -------------------------------------- -Since Objective Caml's syntax is very liberal (more than 100 +Since OCaml's syntax is very liberal (more than 100 shift-reduce conflicts with yacc), automatic indentation is far from easy. Moreover, you expect the indentation to be not purely syntactic, but also semantic: reflecting the meaning of your program. diff --git a/emacs/README.itz b/emacs/README.itz index 8e1366f47..7bcc7aa05 100644 --- a/emacs/README.itz +++ b/emacs/README.itz @@ -1,7 +1,7 @@ DESCRIPTION: -This directory contains files to help editing Caml code, running a -Caml toplevel, and running the Caml debugger under the Gnu Emacs editor. +This directory contains files to help editing OCaml code, running a +OCaml toplevel, and running the OCaml debugger under the Gnu Emacs editor. AUTHORS: @@ -13,10 +13,10 @@ camldebug.el is derived from FSF code. CONTENTS: - caml.el A major mode for editing Caml code in Gnu Emacs - inf-caml.el To run a Caml toplevel under Emacs, with input and + caml.el A major mode for editing OCaml code in Gnu Emacs + inf-caml.el To run a OCaml toplevel under Emacs, with input and output in an Emacs buffer. - camldebug.el To run the Caml debugger under Emacs. + camldebug.el To run the OCaml debugger under Emacs. NOTE FOR EMACS 18 USERS: @@ -29,13 +29,13 @@ USAGE: Add the following lines to your .emacs file: (setq auto-mode-alist (cons '("\\.ml[iylp]?" . caml-mode) auto-mode-alist)) -(autoload 'caml-mode "caml" "Major mode for editing Caml code." t) -(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t) -(autoload 'camldebug "camldebug" "Run the Caml debugger." t) +(autoload 'caml-mode "caml" "Major mode for editing OCaml code." t) +(autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) +(autoload 'camldebug "camldebug" "Run the OCaml debugger." t) The Caml major mode is triggered by visiting a file with extension .ml, .mli, .mly. .mll or .mlp, or manually by M-x caml-mode. It gives you the -correct syntax table for the Caml language. For a brief description of +correct syntax table for the OCaml language. For a brief description of the indentation capabilities, see below under NEWS. The Caml mode also allows you to run batch Caml compilations from @@ -44,16 +44,16 @@ sets the point at the beginning of the erroneous program fragment, and the mark at the end. Under Emacs 19, the program fragment is temporarily highlighted. -M-x run-caml starts a Caml toplevel with input and output in an Emacs +M-x run-caml starts an OCaml toplevel with input and output in an Emacs buffer named *inferior-caml*. This gives you the full power of Emacs -to edit the input to the Caml toplevel. This mode is based on comint +to edit the input to the OCaml toplevel. This mode is based on comint so you get all the usual comint features, including command history. After M-x run-caml, typing C-c C-e or M-C-x in a buffer in Caml mode -sends the current phrase (containing the point) to the Caml toplevel, +sends the current phrase (containing the point) to the OCaml toplevel, and evaluates it. -M-x camldebug FILE starts the Caml debugger camldebug on the executable +M-x camldebug FILE starts the OCaml debugger camldebug on the executable FILE, with input and output in an Emacs buffer named *camldebug-FILE*. For a brief description of the commands available in this buffer, see NEWS below. diff --git a/emacs/caml-hilit.el b/emacs/caml-hilit.el index 0d437c509..25376eb2a 100644 --- a/emacs/caml-hilit.el +++ b/emacs/caml-hilit.el @@ -53,7 +53,7 @@ "\\|\|\\|->\\|&\\|#") nil 'keyword) '(";" nil struct)) - "Hilit19 patterns used for Caml mode") + "Hilit19 patterns used for OCaml mode") (hilit-set-mode-patterns 'caml-mode caml-mode-patterns) (hilit-set-mode-patterns diff --git a/emacs/caml-types.el b/emacs/caml-types.el index bc4c82ba4..e42a0fc46 100644 --- a/emacs/caml-types.el +++ b/emacs/caml-types.el @@ -38,7 +38,7 @@ Their format is: <SP> is a space character (ASCII 0x20) <LF> is a line-feed character (ASCII 0x0A) num is a sequence of decimal digits - filename is a string with the lexical conventions of O'Caml + filename is a string with the lexical conventions of OCaml open-paren is an open parenthesis (ASCII 0x28) close-paren is a closed parenthesis (ASCII 0x29) data is any sequence of characters where <LF> is always followed by diff --git a/emacs/caml.el b/emacs/caml.el index 342305de9..10090d467 100644 --- a/emacs/caml.el +++ b/emacs/caml.el @@ -12,7 +12,7 @@ ;(* $Id$ *) -;;; caml.el --- O'Caml code editing commands for Emacs +;;; caml.el --- OCaml code editing commands for Emacs ;; Xavier Leroy, july 1993. @@ -484,7 +484,7 @@ have caml-electric-indent on, which see.") "Hook for caml-mode") (defun caml-mode () - "Major mode for editing Caml code. + "Major mode for editing OCaml code. \\{caml-mode-map}" @@ -588,7 +588,7 @@ have caml-electric-indent on, which see.") ;;; subshell support (defun caml-eval-region (start end) - "Send the current region to the inferior Caml process." + "Send the current region to the inferior OCaml process." (interactive"r") (require 'inf-caml) (inferior-caml-eval-region start end)) @@ -596,7 +596,7 @@ have caml-electric-indent on, which see.") ;; old version ---to be deleted later ; ; (defun caml-eval-phrase () -; "Send the current Caml phrase to the inferior Caml process." +; "Send the current OCaml phrase to the inferior Caml process." ; (interactive) ; (save-excursion ; (let ((bounds (caml-mark-phrase))) @@ -825,7 +825,7 @@ from an error message produced by camlc.") ;that way we get our effect even when we do \C-x` in compilation buffer (defadvice next-error (after caml-next-error activate) - "Reads the extra positional information provided by the Caml compiler. + "Reads the extra positional information provided by the OCaml compiler. Puts the point and the mark exactly around the erroneous program fragment. The erroneous fragment is also temporarily highlighted if @@ -903,7 +903,7 @@ whole string." ;; itz Thu Sep 24 19:02:42 PDT 1998 this is to have some level of ;; comfort when sending phrases to the toplevel and getting errors. (defun caml-goto-phrase-error () - "Find the error location in current Caml phrase." + "Find the error location in current OCaml phrase." (interactive) (require 'inf-caml) (let ((bounds (save-excursion (caml-mark-phrase)))) @@ -984,7 +984,7 @@ to the end. beg)) (defun caml-mark-phrase (&optional min-pos max-pos) - "Put mark at end of this Caml phrase, point at beginning. + "Put mark at end of this OCaml phrase, point at beginning. " (interactive) (let* ((beg (caml-find-phrase min-pos max-pos)) (end (point))) @@ -1912,7 +1912,7 @@ with prefix arg, indent that many phrases starting with the current phrase." (beginning-of-line 1) (backward-char 4))) -(autoload 'run-caml "inf-caml" "Run an inferior Caml process." t) +(autoload 'run-caml "inf-caml" "Run an inferior OCaml process." t) (autoload 'caml-types-show-type "caml-types" "Show the type of expression or pattern at point." t) diff --git a/emacs/camldebug.el b/emacs/camldebug.el index 199a6cc1a..0fd353aef 100644 --- a/emacs/camldebug.el +++ b/emacs/camldebug.el @@ -89,7 +89,7 @@ (define-derived-mode camldebug-mode comint-mode "Inferior CDB" - "Major mode for interacting with an inferior Camldebug process. + "Major mode for interacting with an inferior ocamldebug process. The following commands are available: diff --git a/emacs/inf-caml.el b/emacs/inf-caml.el index 77dd684af..5b864efcb 100644 --- a/emacs/inf-caml.el +++ b/emacs/inf-caml.el @@ -12,7 +12,7 @@ ;(* $Id$ *) -;;; inf-caml.el --- run the Caml toplevel in an Emacs buffer +;;; inf-caml.el --- run the OCaml toplevel in an Emacs buffer ;; Xavier Leroy, july 1993. @@ -37,14 +37,14 @@ (setq inferior-caml-mode-map (copy-keymap comint-mode-map))) -;; Augment Caml mode, so you can process Caml code in the source files. +;; Augment Caml mode, so you can process OCaml code in the source files. (defvar inferior-caml-program "ocaml" - "*Program name for invoking an inferior Caml from Emacs.") + "*Program name for invoking an inferior OCaml from Emacs.") (defun inferior-caml-mode () - "Major mode for interacting with an inferior Caml process. -Runs a Caml toplevel as a subprocess of Emacs, with I/O through an + "Major mode for interacting with an inferior OCaml process. +Runs an OCaml toplevel as a subprocess of Emacs, with I/O through an Emacs buffer. A history of input phrases is maintained. Phrases can be sent from another buffer in Caml mode. @@ -106,7 +106,7 @@ be sent from another buffer in Caml mode. (if (not cmd) (if (comint-check-proc inferior-caml-buffer-name) (setq cmd inferior-caml-program) - (setq cmd (read-from-minibuffer "Caml toplevel to run: " + (setq cmd (read-from-minibuffer "OCaml toplevel to run: " inferior-caml-program)))) (setq inferior-caml-program cmd) (let ((cmdlist (inferior-caml-args-to-list cmd)) @@ -124,11 +124,11 @@ be sent from another buffer in Caml mode. ;; caml-run-process-when-needed (defun run-caml (&optional cmd) - "Run an inferior Caml process. + "Run an inferior OCaml process. Input and output via buffer `*inferior-caml*'." (interactive (list (if (not (comint-check-proc inferior-caml-buffer-name)) - (read-from-minibuffer "Caml toplevel to run: " + (read-from-minibuffer "OCaml toplevel to run: " inferior-caml-program)))) (caml-run-process-if-needed cmd) (switch-to-buffer-other-window inferior-caml-buffer-name)) @@ -174,7 +174,7 @@ Input and output via buffer `*inferior-caml*'." ;; patched by Didier to move cursor after evaluation (defun inferior-caml-eval-region (start end) - "Send the current region to the inferior Caml process." + "Send the current region to the inferior OCaml process." (interactive "r") (save-excursion (caml-run-process-if-needed)) (save-excursion diff --git a/ocamlbuild/manual/manual.tex b/ocamlbuild/manual/manual.tex index 01d671eb7..bccdd9a6f 100644 --- a/ocamlbuild/manual/manual.tex +++ b/ocamlbuild/manual/manual.tex @@ -620,7 +620,7 @@ library. Just write a file with the \texttt{mltop} extension (like \subsection{Preprocessor options and tags} You can specify preprocessor options with \texttt{-pp} followed by the preprocessor string, for instance \texttt{ocamlbuild -pp "camlp4o.opt -unsafe"} -would run your sources thru CamlP4 with the \texttt{-unsafe} option. +would run your sources through CamlP4 with the \texttt{-unsafe} option. Another way is to use the tags file. \begin{center} \begin{tabular}{|l|l|l|} 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); diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli index 05cd86cac..09b6e4640 100644 --- a/stdlib/scanf.mli +++ b/stdlib/scanf.mli @@ -286,18 +286,18 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; Hence, this conversion always succeeds: it returns an empty string if the bounding condition holds when the scan begins. - [S]: reads a delimited string argument (delimiters and special - escaped characters follow the lexical conventions of Caml). + escaped characters follow the lexical conventions of OCaml). - [c]: reads a single character. To test the current input character without reading it, specify a null field width, i.e. use specification [%0c]. Raise [Invalid_argument], if the field width specification is greater than 1. - [C]: reads a single delimited character (delimiters and special - escaped characters follow the lexical conventions of Caml). + escaped characters follow the lexical conventions of OCaml). - [f], [e], [E], [g], [G]: reads an optionally signed floating-point number in decimal notation, in the style [dddd.ddd e/E+-dd]. - [F]: reads a floating point number according to the lexical - conventions of Caml (hence the decimal point is mandatory if the + conventions of OCaml (hence the decimal point is mandatory if the exponent part is not mentioned). - [B]: reads a boolean argument ([true] or [false]). - [b]: reads a boolean argument (for backward compatibility; do not use @@ -376,7 +376,7 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; nothing to read in the input: in this case, it simply returns [""]. - in addition to the relevant digits, ['_'] characters may appear - inside numbers (this is reminiscent to the usual Caml lexical + inside numbers (this is reminiscent to the usual OCaml lexical conventions). If stricter scanning is desired, use the range conversion facility instead of the number conversions. diff --git a/stdlib/string.mli b/stdlib/string.mli index efdecea48..8a7367ac3 100644 --- a/stdlib/string.mli +++ b/stdlib/string.mli @@ -27,10 +27,10 @@ substring of [s] if [len >= 0] and [start] and [start+len] are valid positions in [s]. - Caml strings can be modified in place, for instance via the + OCaml strings can be modified in place, for instance via the {!String.set} and {!String.blit} functions described below. This possibility should be used rarely and with much care, however, since - both the Caml compiler and most Caml libraries share strings as if + both the OCaml compiler and most OCaml libraries share strings as if they were immutable, rather than copying them. In particular, string literals are shared: a single copy of the string is created at program loading time and returned by all evaluations of the diff --git a/testsuite/interactive/lib-graph-2/graph_test.ml b/testsuite/interactive/lib-graph-2/graph_test.ml index 39b845675..6c9fd49ac 100644 --- a/testsuite/interactive/lib-graph-2/graph_test.ml +++ b/testsuite/interactive/lib-graph-2/graph_test.ml @@ -27,7 +27,7 @@ let sz = 450;; open_graph (Printf.sprintf " %ix%i" sz sz);; -(* To be defined for older versions of O'Caml +(* To be defined for older versions of OCaml Lineto, moveto and draw_rect. let rlineto x y = @@ -150,7 +150,7 @@ let x,y = current_point () in fill_rect x (y - 5) (8 * 20) 25;; set_color yellow;; go_legend ();; -draw_string "Graphics (Caml)";; +draw_string "Graphics (OCaml)";; (* Pie parts in different colors. *) let draw_green_string s = set_color green; draw_string s;; diff --git a/testsuite/tests/asmcomp/ia64.S b/testsuite/tests/asmcomp/ia64.S index 68d649b53..028c622f9 100644 --- a/testsuite/tests/asmcomp/ia64.S +++ b/testsuite/tests/asmcomp/ia64.S @@ -26,7 +26,7 @@ .proc call_gen_code# call_gen_code: - /* Allocate 64 "out" registers (for the Caml code) and no locals */ + /* Allocate 64 "out" registers (for the OCaml code) and no locals */ alloc r3 = ar.pfs, 0, 0, 64, 0 /* Save PFS, return address and GP on stack */ diff --git a/testsuite/tests/asmcomp/power-aix.S b/testsuite/tests/asmcomp/power-aix.S index ee8a09698..0752100f5 100644 --- a/testsuite/tests/asmcomp/power-aix.S +++ b/testsuite/tests/asmcomp/power-aix.S @@ -123,7 +123,7 @@ .globl .caml_c_call .caml_c_call: # Preserve RTOC and return address in callee-save registers -# The C function will preserve them, and the Caml code does not +# The C function will preserve them, and the OCaml code does not # expect them to be preserved # Return address is in 25, RTOC is in 26 mflr 25 diff --git a/testsuite/tests/embedded/cmcaml.ml b/testsuite/tests/embedded/cmcaml.ml index 4ebed1e7d..65c7a610e 100644 --- a/testsuite/tests/embedded/cmcaml.ml +++ b/testsuite/tests/embedded/cmcaml.ml @@ -1,4 +1,4 @@ -(* Caml part of the code *) +(* OCaml part of the code *) let rec fib n = if n < 2 then 1 else fib(n-1) + fib(n-2) diff --git a/testsuite/tests/embedded/cmmain.c b/testsuite/tests/embedded/cmmain.c index 87647ac50..6c27fe1e9 100644 --- a/testsuite/tests/embedded/cmmain.c +++ b/testsuite/tests/embedded/cmmain.c @@ -9,7 +9,7 @@ extern char * format_result(int n); int main(int argc, char ** argv) { - printf("Initializing Caml code...\n"); + printf("Initializing OCaml code...\n"); #ifdef NO_BYTECODE_FILE caml_startup(argv); #else diff --git a/testsuite/tests/embedded/program.reference b/testsuite/tests/embedded/program.reference index e2752b724..4f27810ca 100644 --- a/testsuite/tests/embedded/program.reference +++ b/testsuite/tests/embedded/program.reference @@ -1,4 +1,4 @@ -Initializing Caml code... +Initializing OCaml code... Back in C code... Computing fib(20)... Result = 10946 diff --git a/testsuite/tests/lib-digest/md5.ml b/testsuite/tests/lib-digest/md5.ml index 6d4e6e064..27aebf2a3 100644 --- a/testsuite/tests/lib-digest/md5.ml +++ b/testsuite/tests/lib-digest/md5.ml @@ -211,7 +211,7 @@ let _ = if (Array.length Sys.argv) > 1 && (Sys.argv.(1) = "-benchmark") then begin let s = String.make 50000 'a' in let num_iter = 1000 in - time "Caml implementation" num_iter + time "OCaml implementation" num_iter (fun () -> let ctx = init() in update ctx s 0 (String.length s); diff --git a/testsuite/tests/lib-dynlink-csharp/bytecode.reference b/testsuite/tests/lib-dynlink-csharp/bytecode.reference index 65592193a..a76daa230 100644 --- a/testsuite/tests/lib-dynlink-csharp/bytecode.reference +++ b/testsuite/tests/lib-dynlink-csharp/bytecode.reference @@ -1,4 +1,4 @@ -Now starting the Caml engine. +Now starting the OCaml engine. Main is running. Loading ../../../otherlibs/bigarray/bigarray.cma I'm the plugin. diff --git a/testsuite/tests/lib-dynlink-csharp/main.cs b/testsuite/tests/lib-dynlink-csharp/main.cs index a03bfd60a..5cbb8e868 100755 --- a/testsuite/tests/lib-dynlink-csharp/main.cs +++ b/testsuite/tests/lib-dynlink-csharp/main.cs @@ -5,7 +5,7 @@ public class M { public static extern void start_caml_engine(); public static void Main() { - System.Console.WriteLine("Now starting the Caml engine."); + System.Console.WriteLine("Now starting the OCaml engine."); start_caml_engine(); } } diff --git a/testsuite/tests/lib-dynlink-csharp/native.reference b/testsuite/tests/lib-dynlink-csharp/native.reference index b6c9e5c43..684f979a8 100644 --- a/testsuite/tests/lib-dynlink-csharp/native.reference +++ b/testsuite/tests/lib-dynlink-csharp/native.reference @@ -1,4 +1,4 @@ -Now starting the Caml engine. +Now starting the OCaml engine. Main is running. Loading ../../../otherlibs/bigarray/bigarray.cmxs I'm the plugin. diff --git a/testsuite/tests/lib-scanf/tscanf.ml b/testsuite/tests/lib-scanf/tscanf.ml index d929eb747..49afdb320 100644 --- a/testsuite/tests/lib-scanf/tscanf.ml +++ b/testsuite/tests/lib-scanf/tscanf.ml @@ -585,7 +585,7 @@ and test27 () = (test27 ()) ;; -(* To scan a Caml string: +(* To scan an OCaml string: the format is "\"%s@\"". A better way would be to add a %S (String.escaped), a %C (Char.escaped). This is now available. *) @@ -950,7 +950,7 @@ test (test340 () && test35 ()) (* The prefered reader functionnals. *) -(* To read a list as in Caml (elements are ``blank + semicolon + blank'' +(* To read a list as in OCaml (elements are ``blank + semicolon + blank'' separated, and the list is enclosed in brackets). *) let rec read_elems read_elem accu ib = kscanf ib (fun ib exc -> accu) diff --git a/testsuite/tests/misc/bdd.ml b/testsuite/tests/misc/bdd.ml index ddf99a729..b2a3d7059 100644 --- a/testsuite/tests/misc/bdd.ml +++ b/testsuite/tests/misc/bdd.ml @@ -12,7 +12,7 @@ (* $Id$ *) -(* Translated to Caml by Xavier Leroy *) +(* Translated to OCaml by Xavier Leroy *) (* Original code written in SML by ... *) type bdd = One | Zero | Node of bdd * int * int * bdd diff --git a/tools/Makefile.shared b/tools/Makefile.shared index ee3fa2831..02af98f0c 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -78,7 +78,7 @@ clean:: rm -f ocamlprof ocamlcp -# To help building mixed-mode libraries (Caml + C) +# To help building mixed-mode libraries (OCaml + C) ocamlmklib: myocamlbuild_config.cmo ocamlmklib.cmo $(CAMLC) $(LINKFLAGS) -o ocamlmklib myocamlbuild_config.cmo \ diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.mlp index 5beaae321..3b31201cc 100644 --- a/tools/ocamlmklib.mlp +++ b/tools/ocamlmklib.mlp @@ -32,7 +32,7 @@ and c_opts = ref [] (* options to pass to mksharedlib and ocamlc -ccopt *) and ld_opts = ref [] (* options to pass only to the linker *) and ocamlc = ref (compiler_path "ocamlc") and ocamlopt = ref (compiler_path "ocamlopt") -and output = ref "a" (* Output name for Caml part of library *) +and output = ref "a" (* Output name for OCaml part of library *) and output_c = ref "" (* Output name for C part of library *) and rpath = ref [] (* rpath options *) and verbose = ref false @@ -152,15 +152,15 @@ Usage: ocamlmklib [options] <.cmo|.cma|.cmx|.cmxa|.ml|.mli|.o|.a|.obj|.lib|.dll \n -help Print this help message and exit\ \n --help Same as -help\ \n -h Same as -help\ -\n -I <dir> Add <dir> to the path searched for Caml object files\ +\n -I <dir> Add <dir> to the path searched for OCaml object files\ \n -failsafe fall back to static linking if DLL construction failed\ \n -ldopt <opt> C option passed to the shared linker only\ -\n -linkall Build Caml archive with link-all behavior\ +\n -linkall Build OCaml archive with link-all behavior\ \n -l<lib> Specify a dependent C library\ \n -L<dir> Add <dir> to the path searched for C libraries\ \n -ocamlc <cmd> Use <cmd> in place of \"ocamlc\"\ \n -ocamlopt <cmd> Use <cmd> in place of \"ocamlopt\"\ -\n -o <name> Generated Caml library is named <name>.cma or <name>.cmxa\ +\n -o <name> Generated OCaml library is named <name>.cma or <name>.cmxa\ \n -oc <name> Generated C library is named dll<name>.so or lib<name>.a\ \n -rpath <dir> Same as -dllpath <dir>\ \n -R<dir> Same as -rpath\ diff --git a/win32caml/libgraph.h b/win32caml/libgraph.h index 1df232988..1202f178b 100644 --- a/win32caml/libgraph.h +++ b/win32caml/libgraph.h @@ -50,8 +50,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 DEFAULT_EVENT_MASK \ (ExposureMask | KeyPressMask | StructureNotifyMask) #define DEFAULT_FONT "fixed" diff --git a/win32caml/ocaml.c b/win32caml/ocaml.c index 04899473f..59ebd035b 100644 --- a/win32caml/ocaml.c +++ b/win32caml/ocaml.c @@ -1564,7 +1564,7 @@ int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine if (!Setup(&hAccelTable)) return 0; // Need to set up a console so that we can send ctrl-break signal - // to inferior Caml + // to inferior OCaml AllocConsole(); GetConsoleTitle(consoleTitle,sizeof(consoleTitle)); hwndConsole = FindWindow(NULL,consoleTitle); diff --git a/win32caml/startocaml.c b/win32caml/startocaml.c index d457dd41b..7180fc50e 100644 --- a/win32caml/startocaml.c +++ b/win32caml/startocaml.c @@ -151,7 +151,7 @@ int GetOcamlPath(void) || _access(path, 0) != 0) { /* Registry key doesn't exist or contains invalid path */ /* Ask user */ - if (!BrowseForFile("Ocaml interpreter|ocaml.exe", path)) { + if (!BrowseForFile("OCaml interpreter|ocaml.exe", path)) { ShowDbgMsg("Impossible to find ocaml.exe. I quit"); exit(0); } |