diff options
132 files changed, 1400 insertions, 864 deletions
@@ -22,8 +22,10 @@ Language features: "let [rec] <ident> : 'a1 ... 'an. <typexp> = ..." - First-class packages modules. New kind of type expression, for packaged modules: (module PT). - New kind of expression, to pack a module as a first-class value: (module MODEXPR : PT). - New kind of module expression, to unpack a first-class value as a module: (val EXPR : PT). + New kind of expression, to pack a module as a first-class value: + (module MODEXPR : PT). + New kind of module expression, to unpack a first-class value as a module: + (val EXPR : PT). PT is a package type of the form "S" or "S with type t1 = ... and ... and type tn = ..." (S refers to a module type). - Local opening of modules in a subexpression. @@ -58,6 +60,55 @@ Bug Fixes: - PR#4775: compiler crash on crazy types (temporary fix) +Objective Caml 3.11.2: +---------------------- + +Bug fixes: +- PR#4151: better documentation for min and max w.r.t. NaN +- PR#4421: ocamlbuild uses wrong compiler for C files +- PR#4710, PR#4720: ocamlbuild does not use properly configuration information +- PR#4750: under some Windows installations, high start-up times for Unix lib +- PR#4777: problem with scanf and CRLF +- PR#4783: ocamlmklib problem under Windows +- PR#4810: BSD problem with socket addresses, e.g. in Unix.getnameinfo +- PR#4813: issue with parsing of float literals by the GNU assembler +- PR#4816: problem with modules and private types +- PR#4818: missed opportunity for type-based optimization of bigarray accesses +- PR#4821: check for duplicate method names in classes +- PR#4823: build problem on Mac OS X +- PR#4836: spurious errors raised by Unix.single_write under Windows +- PR#4841, PR#4860, PR#4930: problem with ocamlopt -output-obj under Mac OS X +- PR#4847: C compiler error with ocamlc -output-obj under Win64 +- PR#4856: ocamlbuild uses ocamlrun to execute a native plugin +- PR#4867, PR#4760: ocamlopt -shared fails on Mac OS X 64bit +- PR#4873: ocamlbuild ignores "thread" tag when building a custom toplevel +- PR#4890: ocamlbuild tries to use native plugin on bytecode-only arch +- PR#4896: ocamlbuild should always pass -I to tools for external libraries +- PR#4900: small bug triggering automatic compaction even if max_overhead = 1M +- PR#4902: bug in %.0F printf format +- PR#4910: problem with format concatenation +- PR#4922: ocamlbuild recompiles too many files +- PR#4923: missing \xff for scanf %S +- PR#4933: functors not handling private types correctly +- PR#4940: problem with end-of-line in DOS text mode, tentative fix +- PR#4953: problem compiling bytecode interpreter on ARM in Thumb mode. +- PR#4955: compiler crash when typing recursive type expression with constraint +- Module Printf: the simple conversion %F (without width indication) was not + treated properly. +- Makefile: problem with cygwin, flexdll, and symbolic links +- Various build problems with ocamlbuild under Windows with msvc + +Feature wishes: +- PR#9: (tentative implementation) make ocamldebug use #linenum annotations +- PR#123, PR#4477: custom exception printers +- PR#3456: Obj.double_field and Obj.set_double_field functions +- PR#4003: destination directory can be given to Filename.[open_]temp_file +- PR#4647: Buffer.blit function +- PR#4685: access to Filename.dir_sep +- PR#4703: support for debugging embedded applications +- PR#4723: "clear_rules" function to empty the set of ocamlbuild rules +- PR#4921: configure option to help cross-compilers + Objective Caml 3.11.1: ---------------------- @@ -113,6 +164,7 @@ Other changes: (contributed by Jonathan Davies, Citrix). - Support for 64-bit mode in Solaris/x86 (PR#4670). + Objective Caml 3.11.0: ---------------------- @@ -261,6 +313,7 @@ Bug fixes: - Small bugs in the make-package-macosx script - Bug in typing of polymorphic variants (reported on caml-list) + Objective Caml 3.10.1: ---------------------- @@ -109,7 +109,7 @@ The "configure" script accepts the following options: -as <assembler and options> (default: determined automatically) The assembler to use for assembling ocamlopt-generated code. --aspp <assembler and options> (default: determined automatically> +-aspp <assembler and options> (default: determined automatically) The assembler to use for assembling the parts of the run-time system manually written in assembly language. This assembler must preprocess its input with the C preprocessor. @@ -126,10 +126,13 @@ Examples: Installation in /usr, man pages in section "l": ./configure -bindir /usr/bin -libdir /usr/lib/ocaml -mandir /usr/man/manl - On a MacOSX/Intel Core 2 or MacOSX/PowerPC host, to build a 64-bit version - of OCaml: + On a MacOSX 10.5/Intel Core 2 or MacOSX 10.5/PowerPC host, + to build a 64-bit version of OCaml: ./configure -cc "gcc -m64" + On a MacOSX 10.6/Intel Core 2, to build a 32-bit version of OCaml: + ./configure -cc "gcc -m32" -as "as -arch i386" -aspp "gcc -m32 -c" + On a Linux x86/64 bits host, to build a 32-bit version of OCaml: ./configure -cc "gcc -m32" -as "as --32" -aspp "gcc -m32 -c" @@ -188,9 +191,9 @@ or: make opt > log.opt 2>&1 # in sh make opt >& log.opt # in csh -5- (Optional) If you want to compile fast versions of the Objective -Caml compilers, you can compile them with the native-code compiler -(they are compiled to bytecode by default). Just do: +5- Compile fast versions of the Objective Caml compilers, by +compiling them with the native-code compiler (you have only compiled +them to bytecode so far). Just do: make opt.opt @@ -567,10 +567,11 @@ alldepend:: # The runtime system for the native-code compiler -runtimeopt: +runtimeopt: makeruntimeopt + cp asmrun/libasmrun.a stdlib/libasmrun.a + +makeruntimeopt: cd asmrun; $(MAKE) all - if test -f stdlib/libasmrun.a; then :; else \ - ln -s ../asmrun/libasmrun.a stdlib/libasmrun.a; fi clean:: cd asmrun; $(MAKE) clean @@ -762,6 +763,6 @@ distclean: .PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltools.opt .PHONY: ocamlyacc opt-core opt opt.opt otherlibraries .PHONY: otherlibrariesopt package-macosx promote promote-cross -.PHONY: restore runtime runtimeopt world world.opt +.PHONY: restore runtime runtimeopt makeruntimeopt world world.opt include .depend diff --git a/README.win32 b/README.win32 index 7eac6f262..bb6b31d90 100644 --- a/README.win32 +++ b/README.win32 @@ -61,7 +61,7 @@ Microsoft Visual C++ compiler (items [1] and [2] in the section The native-code compiler (ocamlopt) requires Visual C++ (items [1], [2]), the Microsoft assembler MASM (item [3]) and the flexdll tool (item [5]). -The LablTk GUI requires Tcl/Tk 8.4 (item [4]). +The LablTk GUI requires Tcl/Tk 8.5 (item [4]). INSTALLATION: @@ -70,33 +70,34 @@ The binary distribution is a self-installing executable archive. Just run it and it should install OCaml automatically. To run programs that use the LablTK GUI, the directory where the -DLLs tk84.dll and tcl84.dll were installed (by the Tcl/Tk +DLLs tk85.dll and tcl85.dll were installed (by the Tcl/Tk installer) must be added to the PATH environment variable. To compile programs that use the LablTK GUI, the directory where the -libraries tk84.lib and tcl84.lib were installed (by the Tcl/Tk +libraries tk85.lib and tcl85.lib were installed (by the Tcl/Tk installer) must be added to the library search path in the LIB environment variable. E.g. if Tcl/Tk was installed in C:\tcl, add "C:\tcl\lib" to the LIB environment variable. THIRD-PARTY SOFTWARE: -[1] Visual C++ version 2005, 2003, or 6. - We use Visual C++ 2005 Express Edition, which can be downloaded for free +[1] Visual C++ version 2008, 2005, 2003, or 6. + We use Visual C++ 2008 Express Edition, which can be downloaded for free from http://www.microsoft.com. -[2] Windows header files and development libraries. We found them in - the Microsoft Windows Server 2003 SP1 Platform SDK, which can - be downloaded for free from http://www.microsoft.com/. +[2] Windows header files and development libraries. They are included + in the Visual C++ 2008 Express Edition distribution. + Otherwise, you can find them in the Windows Platform SDK, + which can be downloaded for free from http://www.microsoft.com/. [3] MASM version 6.11 or later. The full distribution of Visual C++ 2005 - contains MASM version 8. Users of the Express Edition of Visual C++ + or 2008 contains MASM version 8. Users of the Express Edition of Visual C++ 2005 can download MASM version 8 from http://www.microsoft.com/downloads/details.aspx?FamilyID=7A1C9DA0-0510-44A2-B042-7EF370530C64&displaylang=en To obtain MASM version 6.11, see http://users.easystreet.com/jkirwan/new/pctools.html. -[4] TCL/TK version 8.4. Windows binaries are available as part of the +[4] TCL/TK version 8.5. Windows binaries are available as part of the ActiveTCL distribution at http://www.activestate.com/products/ActiveTcl/ [5] flexdll. @@ -190,7 +191,7 @@ Do *not* install the Mingw/MSYS development tools from www.mingw.org: these are not compatible with this Caml port (@responsefile not recognized on the command line). -The LablTk GUI requires Tcl/Tk 8.4. Windows binaries are available +The LablTk GUI requires Tcl/Tk 8.5. Windows binaries are available as part of the ActiveTCL distribution at http://www.activestate.com/products/ActiveTcl/ @@ -200,11 +201,11 @@ The binary distribution is a self-installing executable archive. Just run it and it should install OCaml automatically. To run programs that use the LablTK GUI, the directory where the -DLLs tk84.dll and tcl84.dll were installed (by the Tcl/Tk +DLLs tk85.dll and tcl85.dll were installed (by the Tcl/Tk installer) must be added to the PATH environment variable. To compile programs that use the LablTK GUI, the directory where the -libraries tk84.lib and tcl84.lib were installed (by the Tcl/Tk +libraries tk85.lib and tcl85.lib were installed (by the Tcl/Tk installer) must be added to the library search path in the LIB environment variable. E.g. if Tcl/Tk was installed in C:\tcl, add "C:\tcl\lib" to the LIB environment variable. @@ -217,7 +218,7 @@ You will need the following software components to perform the recompilation: - Cygwin: http://sourceware.cygnus.com/cygwin/ Install at least the following packages: binutils, diffutils, gcc-core, gcc-mingw-core, make, mingw-runtime, ncurses, w32-api. -- TCL/TK version 8.4 (see above). +- TCL/TK version 8.5 (see above). - The flexdll tool (see above). Do *not* install the standalone distribution of MinGW, nor the @@ -1,4 +1,4 @@ -3.12.0+dev16 (2010-01-07) +3.12.0+dev17 (2010-01-20) # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli @@ -55,6 +55,7 @@ true: use_stdlib <otherlibs/num/nums.cm{,x}a> or <otherlibs/dbm/dbm.cm{,x}a>: ocamlmklib <otherlibs/{,win32}graph/graphics.cm{,x}a>: ocamlmklib <otherlibs/threads/threads.cm{,x}a>: ocamlmklib +"otherlibs/threads/unix.cma": ocamlmklib <otherlibs/bigarray/bigarray.cm{,x}a>: ocamlmklib <otherlibs/{bigarray,systhreads}/**.ml*>: include_unix @@ -70,6 +71,7 @@ true: use_stdlib <otherlibs/bigarray/**>: otherlibs_bigarray <otherlibs/num/**>: otherlibs_num <otherlibs/threads/**>: otherlibs_threads +"otherlibs/threads/unix.cma": -otherlibs_threads <otherlibs/systhreads/**>: otherlibs_systhreads <otherlibs/dbm/**>: otherlibs_dbm <otherlibs/graph/**>: otherlibs_graph diff --git a/asmcomp/alpha/emit.mlp b/asmcomp/alpha/emit.mlp index b3890a448..3c04b7a47 100644 --- a/asmcomp/alpha/emit.mlp +++ b/asmcomp/alpha/emit.mlp @@ -793,9 +793,9 @@ let emit_item = function long decimal constants *) ` .quad 0x{emit_string(Nativeint.format "%x" n)}\n` | Csingle f -> - ` .float {emit_string f}\n` + emit_float32_directive ".long" f | Cdouble f -> - ` .double {emit_string f}\n` + emit_float64_directive ".quad" f | Csymbol_address s -> ` .quad {emit_symbol s}\n` | Clabel_address lbl -> diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index 11bf78224..950748d6e 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -575,33 +575,26 @@ let emit_instr fallthrough i = end | Lswitch jumptbl -> let lbl = new_label() in - if !pic_code || !Clflags.dlcode then begin - (* PR#4424: r11 is known to be clobbered by the Lswitch, - meaning that no variable that is live across the Lswitch - is assigned to r11. However, the argument to Lswitch - can still be assigned to r11, so we need to special-case - this situation. *) - if i.arg.(0).loc = Reg 9 (* ie r11, cf amd64/proc.ml *) then begin - ` salq $3, %r11\n`; - ` pushq %r11\n`; - ` leaq {emit_label lbl}(%rip), %r11\n`; - ` addq 0(%rsp), %r11\n`; - ` addq $8, %rsp\n`; - ` jmp *(%r11)\n` - end else begin - ` leaq {emit_label lbl}(%rip), %r11\n`; - ` jmp *(%r11, {emit_reg i.arg.(0)}, 8)\n` - end - end else begin - ` jmp *{emit_label lbl}(, {emit_reg i.arg.(0)}, 8)\n` - end; + (* rax and rdx are clobbered by the Lswitch, + meaning that no variable that is live across the Lswitch + is assigned to rax or rdx. However, the argument to Lswitch + can still be assigned to one of these two registers, so + we must be careful not to clobber it before use. *) + let (tmp1, tmp2) = + if i.arg.(0).loc = Reg 0 (* rax *) + then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*)) + else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in + ` leaq {emit_label lbl}(%rip), {emit_reg tmp1}\n`; + ` movslq ({emit_reg tmp1}, {emit_reg i.arg.(0)}, 4), {emit_reg tmp2}\n`; + ` addq {emit_reg tmp2}, {emit_reg tmp1}\n`; + ` jmp *{emit_reg tmp1}\n`; if macosx then ` .const\n` else ` .section .rodata\n`; - emit_align 8; + emit_align 4; `{emit_label lbl}:`; for i = 0 to Array.length jumptbl - 1 do - ` .quad {emit_label jumptbl.(i)}\n` + ` .long {emit_label jumptbl.(i)} - {emit_label lbl}\n` done; ` .text\n` | Lsetuptrap lbl -> @@ -634,7 +627,8 @@ let rec emit_all fallthrough i = (* Emission of the floating-point constants *) let emit_float_constant (lbl, cst) = - `{emit_label lbl}: .double {emit_string cst}\n` + `{emit_label lbl}:`; + emit_float64_directive ".quad" cst (* Emission of the profiling prelude *) @@ -667,7 +661,9 @@ let fundecl fundecl = bound_error_call := 0; ` .text\n`; emit_align 16; - if macosx && is_generic_function fundecl.fun_name + if macosx + && not !Clflags.output_c_object + && is_generic_function fundecl.fun_name then (* PR#4690 *) ` .private_extern {emit_symbol fundecl.fun_name}\n` else @@ -712,9 +708,9 @@ let emit_item = function | Cint n -> ` .quad {emit_nativeint n}\n` | Csingle f -> - ` .float {emit_string f}\n` + emit_float32_directive ".long" f | Cdouble f -> - ` .double {emit_string f}\n` + emit_float64_directive ".quad" f | Csymbol_address s -> ` .quad {emit_symbol s}\n` | Clabel_address lbl -> diff --git a/asmcomp/amd64/proc.ml b/asmcomp/amd64/proc.ml index da2f886bb..c0807b88d 100644 --- a/asmcomp/amd64/proc.ml +++ b/asmcomp/amd64/proc.ml @@ -92,7 +92,6 @@ let phys_reg n = let rax = phys_reg 0 let rcx = phys_reg 5 let rdx = phys_reg 4 -let r11 = phys_reg 9 let rxmm15 = phys_reg 115 let stack_slot slot ty = @@ -170,7 +169,7 @@ let destroyed_at_oper = function | Iop(Istore(Single, _)) -> [| rxmm15 |] | Iop(Ialloc _ | Iintop(Icomp _) | Iintop_imm((Idiv|Imod|Icomp _), _)) -> [| rax |] - | Iswitch(_, _) when !pic_code || !Clflags.dlcode -> [| r11 |] + | Iswitch(_, _) -> [| rax; rdx |] | _ -> [||] let destroyed_at_raise = all_phys_regs diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 5d9e5cf7c..a2a6b4dad 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -585,6 +585,9 @@ let emit_item = function | Csingle f -> ` .float {emit_string f}\n` | Cdouble f -> + (* FIXME: this version of the ARM port is mixed-endian, so we + use .double instead of emit_float64_directive. The next + version is little-endian, so we'll use emit_float64 then. *) ` .align 0\n`; ` .double {emit_string f}\n` | Csymbol_address s -> diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index c7b9ec87e..c1b03106a 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -259,6 +259,7 @@ let link_shared ppf objfiles output_name = (fun (info, file_name, crc) -> check_consistency file_name info crc) units_tolink; Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; + Clflags.ccopts := !lib_ccopts @ !Clflags.ccopts; let objfiles = List.rev (List.map object_file_name objfiles) @ !Clflags.ccobjs in diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml index e851c8187..35338eed9 100644 --- a/asmcomp/emitaux.ml +++ b/asmcomp/emitaux.ml @@ -93,6 +93,27 @@ let emit_bytes_directive directive s = done; if !pos > 0 then emit_char '\n' +(* PR#4813: assemblers do strange things with float literals indeed, + so we convert to IEEE representation ourselves and emit float + literals as 32- or 64-bit integers. *) + +let emit_float64_directive directive f = + let x = Int64.bits_of_float (float_of_string f) in + emit_printf "\t%s\t0x%Lx\n" directive x + +let emit_float64_split_directive directive f = + let x = Int64.bits_of_float (float_of_string f) in + let lo = Int64.logand x 0xFFFF_FFFFL + and hi = Int64.shift_right_logical x 32 in + emit_printf "\t%s\t0x%Lx, 0x%Lx\n" + directive + (if Arch.big_endian then hi else lo) + (if Arch.big_endian then lo else hi) + +let emit_float32_directive directive f = + let x = Int32.bits_of_float (float_of_string f) in + emit_printf "\t%s\t0x%lx\n" directive x + (* Record live pointers at call points *) type frame_descr = diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli index 112e276a1..4f666be73 100644 --- a/asmcomp/emitaux.mli +++ b/asmcomp/emitaux.mli @@ -25,6 +25,9 @@ val emit_char: char -> unit val emit_string_literal: string -> unit val emit_string_directive: string -> string -> unit val emit_bytes_directive: string -> string -> unit +val emit_float64_directive: string -> string -> unit +val emit_float64_split_directive: string -> string -> unit +val emit_float32_directive: string -> string -> unit type frame_descr = { fd_lbl: int; (* Return address *) diff --git a/asmcomp/hppa/emit.mlp b/asmcomp/hppa/emit.mlp index b8880fc4f..2c81b7892 100644 --- a/asmcomp/hppa/emit.mlp +++ b/asmcomp/hppa/emit.mlp @@ -299,7 +299,9 @@ let emit_float_constants () = ` .text\n`; emit_align 8; List.iter - (fun (lbl, cst) -> `{emit_label lbl}: .double {emit_string cst}\n`) + (fun (lbl, cst) -> + `{emit_label lbl}:`; + emit_float64_split_directive ".long" cst) !float_constants; float_constants := [] @@ -972,9 +974,9 @@ let emit_item = function | Cint n -> ` .long {emit_nativeint n}\n` | Csingle f -> - ` .float {emit_string f}\n` + emit_float32_directive ".long" f | Cdouble f -> - ` .double {emit_string f}\n` + emit_float64_split_directive ".long" f | Csymbol_address s -> use_symbol s; ` .long {emit_symbol s}\n` diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index 9f4315561..5d4802faa 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -815,7 +815,8 @@ let rec emit_all fallthrough i = let emit_float_constant (lbl, cst) = ` .data\n`; - `{emit_label lbl}: .double {emit_string cst}\n` + `{emit_label lbl}:`; + emit_float64_split_directive ".long" cst (* Emission of external symbol references (for MacOSX) *) @@ -888,7 +889,9 @@ let fundecl fundecl = bound_error_call := 0; ` .text\n`; emit_align 16; - if macosx && is_generic_function fundecl.fun_name + if macosx + && not !Clflags.output_c_object + && is_generic_function fundecl.fun_name then (* PR#4690 *) ` .private_extern {emit_symbol fundecl.fun_name}\n` else @@ -928,9 +931,9 @@ let emit_item = function | Cint n -> ` .long {emit_nativeint n}\n` | Csingle f -> - ` .float {emit_string f}\n` + emit_float32_directive ".long" f | Cdouble f -> - ` .double {emit_string f}\n` + emit_float64_split_directive ".long" f | Csymbol_address s -> ` .long {emit_symbol s}\n` | Clabel_address lbl -> diff --git a/asmcomp/ia64/emit.mlp b/asmcomp/ia64/emit.mlp index e59f711bc..fb84e9e08 100644 --- a/asmcomp/ia64/emit.mlp +++ b/asmcomp/ia64/emit.mlp @@ -1287,9 +1287,9 @@ let emit_item = function | Cint n -> ` data8 {emit_nativeint n}\n` | Csingle f -> - ` real4 {emit_string f}\n` + emit_float32_directive "data4" f | Cdouble f -> - ` real8 {emit_string f}\n` + emit_float64_directive "data8" f | Csymbol_address s -> ` data8 {emit_symbol s}#\n` | Clabel_address lbl -> diff --git a/asmcomp/mips/emit.mlp b/asmcomp/mips/emit.mlp index 198f6265d..6908ccfd4 100644 --- a/asmcomp/mips/emit.mlp +++ b/asmcomp/mips/emit.mlp @@ -527,10 +527,9 @@ let emit_item = function | Cint n -> ` .word {emit_nativeint n}\n` | Csingle f -> - ` .float {emit_string f}\n` + emit_float32_directive ".word" f | Cdouble f -> - ` .align 0\n`; (* Prevent alignment on 8-byte boundary *) - ` .double {emit_string f}\n` + emit_float64_split_directive ".word" f | Csymbol_address s -> ` .word {emit_symbol s}\n` | Clabel_address lbl -> diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index baab697ae..ec3abbde4 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -835,7 +835,9 @@ let fundecl fundecl = call_gc_label := 0; float_literals := []; int_literals := []; - if Config.system = "rhapsody" && is_generic_function fundecl.fun_name + if Config.system = "rhapsody" + && not !Clflags.output_c_object + && is_generic_function fundecl.fun_name then (* PR#4690 *) ` .private_extern {emit_symbol fundecl.fun_name}\n` else @@ -871,7 +873,10 @@ let fundecl fundecl = ` .align 3\n`; List.iter (fun (f, lbl) -> - `{emit_label lbl}: .double 0d{emit_string f}\n`) + `{emit_label lbl}:`; + if ppc64 + then emit_float64_directive ".quad" f + else emit_float64_split_directive ".long" f) !float_literals; List.iter (fun (n, lbl) -> @@ -902,9 +907,11 @@ let emit_item = function | Cint n -> ` {emit_string datag} {emit_nativeint n}\n` | Csingle f -> - ` .float 0d{emit_string f}\n` + emit_float32_directive ".long" f | Cdouble f -> - ` .double 0d{emit_string f}\n` + if ppc64 + then emit_float64_directive ".quad" f + else emit_float64_split_directive ".long" f | Csymbol_address s -> ` {emit_string datag} {emit_symbol s}\n` | Clabel_address lbl -> diff --git a/asmcomp/sparc/emit.mlp b/asmcomp/sparc/emit.mlp index 7393d9084..f44f813e5 100644 --- a/asmcomp/sparc/emit.mlp +++ b/asmcomp/sparc/emit.mlp @@ -195,7 +195,8 @@ let float_constants = ref ([] : (int * string) list) let emit_float_constant (lbl, cst) = rodata (); ` .align 8\n`; - `{emit_label lbl}: .double 0r{emit_string cst}\n` + `{emit_label lbl}:`; + emit_float64_split_directive ".word" cst (* Emission of the profiling prelude *) let emit_profile () = @@ -723,9 +724,9 @@ let emit_item = function | Cint n -> ` .word {emit_nativeint n}\n` | Csingle f -> - ` .single 0r{emit_string f}\n` + emit_float32_directive ".word" f | Cdouble f -> - ` .double 0r{emit_string f}\n` + emit_float64_split_directive ".word" f | Csymbol_address s -> ` .word {emit_symbol s}\n` | Clabel_address lbl -> diff --git a/asmrun/ia64.S b/asmrun/ia64.S index 876526f2f..025e064a5 100644 --- a/asmrun/ia64.S +++ b/asmrun/ia64.S @@ -12,7 +12,7 @@ /* $Id$ */ -/* Asm part of the runtime system, Alpha processor */ +/* Asm part of the runtime system, IA64 processor */ #undef BROKEN_POSTINCREMENT @@ -68,15 +68,8 @@ caml_allocN: sub r4 = r4, r2 ;; cmp.ltu p0, p6 = r4, r5 (p6) br.ret.sptk b0 ;; - /* Stash return address at sp (in stack scratch area) */ - mov r3 = b0 ;; - st8 [sp] = r3 - /* Call GC */ - br.call.sptk b0 = caml_call_gc# ;; - /* Return to caller */ - ld8 r3 = [sp] ;; - mov b0 = r3 ;; - br.ret.sptk b0 + /* Fall through caml_call_gc */ + br.sptk.many caml_call_gc# .endp caml_allocN# diff --git a/boot/.cvsignore b/boot/.cvsignore index a0a2356c9..5eeaef32e 100644 --- a/boot/.cvsignore +++ b/boot/.cvsignore @@ -4,3 +4,4 @@ ocamlyacc camlheader myocamlbuild myocamlbuild.native +libcamlrun.a diff --git a/boot/ocamlc b/boot/ocamlc Binary files differindex 472f42289..a4a8b667e 100755 --- a/boot/ocamlc +++ b/boot/ocamlc diff --git a/boot/ocamldep b/boot/ocamldep Binary files differindex b461c62a1..cbf203cfd 100755 --- a/boot/ocamldep +++ b/boot/ocamldep diff --git a/boot/ocamllex b/boot/ocamllex Binary files differindex 28162e0c5..b5baf9d60 100755 --- a/boot/ocamllex +++ b/boot/ocamllex diff --git a/build/boot-c-parts-windows.sh b/build/boot-c-parts-windows.sh index 45193d338..3e2ca3dc8 100755 --- a/build/boot-c-parts-windows.sh +++ b/build/boot-c-parts-windows.sh @@ -13,7 +13,6 @@ set -ex mkdir -p _build/boot cp -f byterun/ocamlrun.exe \ byterun/libcamlrun.$A \ - byterun/ocamlrun.dll \ asmrun/libasmrun.$A \ yacc/ocamlyacc.exe \ boot/ocamlc \ @@ -21,5 +20,4 @@ cp -f byterun/ocamlrun.exe \ boot/ocamldep \ _build/boot mkdir -p _build/byterun -cp -f byterun/ocamlrun.exe byterun/ocamlrun.dll boot -cp -f byterun/ocamlrun.$A _build/byterun +cp -f byterun/ocamlrun.exe boot diff --git a/build/install.sh b/build/install.sh index 4c38740c5..2197069c5 100755 --- a/build/install.sh +++ b/build/install.sh @@ -132,7 +132,6 @@ cd .. WIN32="" if [ "x$EXE" = "x.exe" ]; then installbin win32caml/ocamlwin.exe $PREFIX/OCamlWin.exe - installdir byterun/ocamlrun.dll $BINDIR WIN32=win32 fi @@ -140,7 +139,7 @@ installdir otherlibs/"$WIN32"unix/unixsupport.h \ otherlibs/bigarray/bigarray.h \ $LIBDIR/caml -installdir yacc/ocamlyacc byterun/ocamlrun $BINDIR +installdir yacc/ocamlyacc$EXE byterun/ocamlrun$EXE $BINDIR installdir config/Makefile $LIBDIR/Makefile.config installdir byterun/ld.conf $LIBDIR diff --git a/build/mkmyocamlbuild_config.sh b/build/mkmyocamlbuild_config.sh index e48f5b0e0..9c7eebd3c 100755 --- a/build/mkmyocamlbuild_config.sh +++ b/build/mkmyocamlbuild_config.sh @@ -19,6 +19,7 @@ cd `dirname $0`/.. sed \ -e 's/^.*FLEXDIR.*$//g' \ -e 's/^#ml \(.*\)/\1/' \ + -e 's/^\([^"][^"]*\("[^"]*"[^"]*\)*\)#.*$/\1/' \ -e 's/^\(#.*\)$/(* \1 *)/' \ -e 's/^\(.*\$([0-9]).*\)$/(* \1 *)/' \ -e 's/^\([^(=]*\)=\([^"]*\)$/let <:lower<\1>> = "\2";;/' \ diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 19a2c5268..ede7bb977 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -377,14 +377,40 @@ let output_data_string outchan data = end done +(* Output a debug stub *) + +let output_cds_file outfile = + Misc.remove_file outfile; + let outchan = + open_out_gen [Open_wronly; Open_trunc; Open_creat; Open_binary] + 0o777 outfile in + try + Bytesections.init_record outchan; + (* The map of global identifiers *) + Symtable.output_global_map outchan; + Bytesections.record outchan "SYMB"; + (* Debug info *) + output_debug_info outchan; + Bytesections.record outchan "DBUG"; + (* The table of contents and the trailer *) + Bytesections.write_toc_and_trailer outchan; + close_out outchan + with x -> + close_out outchan; + remove_file outfile; + raise x + (* Output a bytecode executable as a C file *) let link_bytecode_as_c tolink outfile = let outchan = open_out outfile in - try + begin try (* The bytecode *) - output_string outchan "#include <caml/mlvalues.h>\n"; output_string outchan "\ +#ifdef __cplusplus\n\ +extern \"C\" {\n\ +#endif\n\ +#include <caml/mlvalues.h>\n\ CAMLextern void caml_startup_code(\n\ code_t code, asize_t code_size,\n\ char *data, asize_t data_size,\n\ @@ -393,8 +419,11 @@ CAMLextern void caml_startup_code(\n\ output_string outchan "static int caml_code[] = {\n"; Symtable.init(); Consistbl.clear crc_interfaces; - let output_fun = output_code_string outchan - and currpos_fun () = 0 in + let currpos = ref 0 in + let output_fun code = + output_code_string outchan code; + currpos := !currpos + String.length code + and currpos_fun () = !currpos in List.iter (link_file output_fun currpos_fun) tolink; (* The final STOP instruction *) Printf.fprintf outchan "\n0x%x};\n\n" Opcodes.opSTOP; @@ -422,18 +451,24 @@ void caml_startup(char ** argv)\n\ caml_data, sizeof(caml_data),\n\ caml_sections, sizeof(caml_sections),\n\ argv);\n\ -}\n"; +}\n\ +#ifdef __cplusplus\n\ +}\n\ +#endif\n"; close_out outchan with x -> close_out outchan; raise x + end; + if !Clflags.debug then + output_cds_file ((Filename.chop_extension outfile) ^ ".cds") (* Build a custom runtime *) let build_custom_runtime prim_name exec_name = Ccomp.call_linker Ccomp.Exe exec_name ([prim_name] @ List.rev !Clflags.ccobjs @ ["-lcamlrun"]) - Config.bytecomp_c_libraries + (Clflags.std_include_flag "-I" ^ " " ^ Config.bytecomp_c_libraries) let append_bytecode_and_cleanup bytecode_name exec_name prim_name = let oc = open_out_gen [Open_wronly; Open_append; Open_binary] 0 exec_name in @@ -472,7 +507,20 @@ let link objfiles output_name = try link_bytecode tolink bytecode_name false; let poc = open_out prim_name in + output_string poc "\ + #ifdef __cplusplus\n\ + extern \"C\" {\n\ + #endif\n\ + #ifdef _WIN64\n\ + typedef __int64 value;\n\ + #else\n\ + typedef long value;\n\ + #endif\n"; Symtable.output_primitive_table poc; + output_string poc "\ + #ifdef __cplusplus\n\ + }\n\ + #endif\n"; close_out poc; let exec_name = fix_exec_name output_name in if not (build_custom_runtime prim_name exec_name) diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 153845163..bad39a213 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -114,14 +114,10 @@ open Printf let output_primitive_table outchan = let prim = all_primitives() in - fprintf outchan "\ - #ifdef __cplusplus\n\ - extern \"C\" {\n\ - #endif\n"; for i = 0 to Array.length prim - 1 do - fprintf outchan "extern long %s();\n" prim.(i) + fprintf outchan "extern value %s();\n" prim.(i) done; - fprintf outchan "typedef long (*primitive)();\n"; + fprintf outchan "typedef value (*primitive)();\n"; fprintf outchan "primitive caml_builtin_cprim[] = {\n"; for i = 0 to Array.length prim - 1 do fprintf outchan " %s,\n" prim.(i) @@ -131,11 +127,7 @@ let output_primitive_table outchan = for i = 0 to Array.length prim - 1 do fprintf outchan " \"%s\",\n" prim.(i) done; - fprintf outchan " (char *) 0 };\n"; - fprintf outchan "\ - #ifdef __cplusplus\n\ - }\n\ - #endif\n" + fprintf outchan " (char *) 0 };\n" (* Initialization for batch linking *) diff --git a/bytecomp/typeopt.ml b/bytecomp/typeopt.ml index f905cc26d..ebcfb20a9 100644 --- a/bytecomp/typeopt.ml +++ b/bytecomp/typeopt.ml @@ -22,18 +22,17 @@ open Types open Typedtree open Lambda +let scrape env ty = + (Ctype.repr (Ctype.expand_head_opt env (Ctype.correct_levels ty))).desc + let has_base_type exp base_ty_path = - let exp_ty = - Ctype.expand_head_opt exp.exp_env (Ctype.correct_levels exp.exp_type) in - match Ctype.repr exp_ty with - {desc = Tconstr(p, _, _)} -> Path.same p base_ty_path + match scrape exp.exp_env exp.exp_type with + | Tconstr(p, _, _) -> Path.same p base_ty_path | _ -> false let maybe_pointer exp = - let exp_ty = - Ctype.expand_head_opt exp.exp_env (Ctype.correct_levels exp.exp_type) in - match (Ctype.repr exp_ty).desc with - Tconstr(p, args, abbrev) -> + match scrape exp.exp_env exp.exp_type with + | Tconstr(p, args, abbrev) -> not (Path.same p Predef.path_int) && not (Path.same p Predef.path_char) && begin try @@ -50,9 +49,8 @@ let maybe_pointer exp = | _ -> true let array_element_kind env ty = - let ty = Ctype.repr (Ctype.expand_head_opt env ty) in - match ty.desc with - Tvar | Tunivar -> + match scrape env ty with + | Tvar | Tunivar -> Pgenarray | Tconstr(p, args, abbrev) -> if Path.same p Predef.path_int || Path.same p Predef.path_char then @@ -85,9 +83,8 @@ let array_element_kind env ty = Paddrarray let array_kind_gen ty env = - let array_ty = Ctype.expand_head_opt env (Ctype.correct_levels ty) in - match (Ctype.repr array_ty).desc with - Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _) + match scrape env ty with + | Tconstr(p, [elt_ty], _) | Tpoly({desc = Tconstr(p, [elt_ty], _)}, _) when Path.same p Predef.path_array -> array_element_kind env elt_ty | _ -> @@ -98,9 +95,9 @@ let array_kind exp = array_kind_gen exp.exp_type exp.exp_env let array_pattern_kind pat = array_kind_gen pat.pat_type pat.pat_env -let bigarray_decode_type ty tbl dfl = - match (Ctype.repr ty).desc with - Tconstr(Pdot(Pident mod_id, type_name, _), [], _) +let bigarray_decode_type env ty tbl dfl = + match scrape env ty with + | Tconstr(Pdot(Pident mod_id, type_name, _), [], _) when Ident.name mod_id = "Bigarray" -> begin try List.assoc type_name tbl with Not_found -> dfl end | _ -> @@ -125,10 +122,9 @@ let layout_table = "fortran_layout", Pbigarray_fortran_layout] let bigarray_kind_and_layout exp = - let ty = Ctype.repr (Ctype.expand_head_opt exp.exp_env exp.exp_type) in - match ty.desc with - Tconstr(p, [caml_type; elt_type; layout_type], abbrev) -> - (bigarray_decode_type elt_type kind_table Pbigarray_unknown, - bigarray_decode_type layout_type layout_table Pbigarray_unknown_layout) + match scrape exp.exp_env exp.exp_type with + | Tconstr(p, [caml_type; elt_type; layout_type], abbrev) -> + (bigarray_decode_type exp.exp_env elt_type kind_table Pbigarray_unknown, + bigarray_decode_type exp.exp_env layout_type layout_table Pbigarray_unknown_layout) | _ -> (Pbigarray_unknown, Pbigarray_unknown_layout) diff --git a/byterun/.cvsignore b/byterun/.cvsignore index 9020f408e..b4714b050 100644 --- a/byterun/.cvsignore +++ b/byterun/.cvsignore @@ -15,3 +15,5 @@ interp.a.lst *.[sd]obj *.lib .gdb_history +*.so +*.a diff --git a/byterun/.depend b/byterun/.depend index 6366bde5c..b92cc6de2 100644 --- a/byterun/.depend +++ b/byterun/.depend @@ -105,13 +105,13 @@ printexc.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \ roots.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \ ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \ freelist.h minor_gc.h globroots.h stacks.h -signals_byt.o: signals_byt.c config.h ../config/m.h ../config/s.h \ - compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \ - minor_gc.h osdeps.h signals.h signals_machdep.h signals.o: signals.c alloc.h compatibility.h misc.h config.h \ ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \ major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \ sys.h +signals_byt.o: signals_byt.c config.h ../config/m.h ../config/s.h \ + compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \ + minor_gc.h osdeps.h signals.h signals_machdep.h stacks.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \ fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h @@ -243,13 +243,13 @@ printexc.d.o: printexc.c backtrace.h mlvalues.h compatibility.h config.h \ roots.d.o: roots.c finalise.h roots.h misc.h compatibility.h config.h \ ../config/m.h ../config/s.h memory.h gc.h mlvalues.h major_gc.h \ freelist.h minor_gc.h globroots.h stacks.h -signals_byt.d.o: signals_byt.c config.h ../config/m.h ../config/s.h \ - compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \ - minor_gc.h osdeps.h signals.h signals_machdep.h signals.d.o: signals.c alloc.h compatibility.h misc.h config.h \ ../config/m.h ../config/s.h mlvalues.h callback.h fail.h memory.h gc.h \ major_gc.h freelist.h minor_gc.h roots.h signals.h signals_machdep.h \ sys.h +signals_byt.d.o: signals_byt.c config.h ../config/m.h ../config/s.h \ + compatibility.h memory.h gc.h mlvalues.h misc.h major_gc.h freelist.h \ + minor_gc.h osdeps.h signals.h signals_machdep.h stacks.d.o: stacks.c config.h ../config/m.h ../config/s.h compatibility.h \ fail.h misc.h mlvalues.h stacks.h memory.h gc.h major_gc.h freelist.h \ minor_gc.h diff --git a/byterun/backtrace.c b/byterun/backtrace.c index 2e645ab51..1afce8ae2 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -39,6 +39,7 @@ CAMLexport int caml_backtrace_active = 0; CAMLexport int caml_backtrace_pos = 0; CAMLexport code_t * caml_backtrace_buffer = NULL; CAMLexport value caml_backtrace_last_exn = Val_unit; +CAMLexport char * caml_cds_file = NULL; #define BACKTRACE_BUFFER_SIZE 1024 /* Location of fields in the Instruct.debug_event record */ @@ -135,7 +136,11 @@ static value read_debug_info(void) uint32 num_events, orig, i; value evl, l; - exec_name = caml_exe_name; + if (caml_cds_file != NULL) { + exec_name = caml_cds_file; + } else { + exec_name = caml_exe_name; + } fd = caml_attempt_open(&exec_name, &trail, 1); if (fd < 0) CAMLreturn(Val_false); caml_read_section_descriptors(fd, &trail); diff --git a/byterun/backtrace.h b/byterun/backtrace.h index c2a21c208..2d9c202ea 100644 --- a/byterun/backtrace.h +++ b/byterun/backtrace.h @@ -22,6 +22,7 @@ CAMLextern int caml_backtrace_active; CAMLextern int caml_backtrace_pos; CAMLextern code_t * caml_backtrace_buffer; CAMLextern value caml_backtrace_last_exn; +CAMLextern char * caml_cds_file; CAMLprim value caml_record_backtrace(value vflag); #ifndef NATIVE_CODE diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index af89b5301..0083f3673 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -419,7 +419,7 @@ static void test_and_compact (void) fp = 100.0 * caml_fl_cur_size / (Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size); - if (fp > 1000000.0) fp = 1000000.0; + if (fp > 999999.0) fp = 999999.0; caml_gc_message (0x200, "Estimated overhead (lower bound) = %" ARCH_INTNAT_PRINTF_FORMAT "u%%\n", (uintnat) fp); diff --git a/byterun/interp.c b/byterun/interp.c index feea1fbd6..254441e6e 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -157,7 +157,8 @@ sp is a local copy of the global variable caml_extern_sp. */ #define SP_REG asm("a4") #define ACCU_REG asm("d7") #endif -#ifdef __arm__ +/* PR#4953: these specific registers not available in Thumb mode */ +#if defined (__arm__) && !defined(__thumb__) #define PC_REG asm("r6") #define SP_REG asm("r8") #define ACCU_REG asm("r7") diff --git a/byterun/obj.c b/byterun/obj.c index ded8416b1..5e15c47da 100644 --- a/byterun/obj.c +++ b/byterun/obj.c @@ -165,6 +165,10 @@ CAMLprim value caml_obj_truncate (value v, value newsize) return Val_unit; } +CAMLprim value caml_obj_add_offset (value v, value offset) +{ + return v + Int32_val (offset); +} /* The following functions are used in stdlib/lazy.ml. They are not written in O'Caml because they must be atomic with respect diff --git a/byterun/startup.c b/byterun/startup.c index 34d6f315c..419d49be6 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -439,12 +439,18 @@ CAMLexport void caml_startup_code( char **argv) { value res; + char* cds_file; caml_init_ieee_floats(); caml_init_custom_operations(); #ifdef DEBUG caml_verb_gc = 63; #endif + cds_file = getenv("CAML_DEBUG_FILE"); + if (cds_file != NULL) { + caml_cds_file = caml_stat_alloc(strlen(cds_file) + 1); + strcpy(caml_cds_file, cds_file); + } parse_camlrunparam(); caml_external_raise = NULL; /* Initialize the abstract machine */ @@ -454,8 +460,17 @@ CAMLexport void caml_startup_code( init_atoms(); /* Initialize the interpreter */ caml_interprete(NULL, 0); + /* Initialize the debugger, if needed */ + caml_debugger_init(); /* Load the code */ caml_start_code = code; + caml_code_size = code_size; + if (caml_debugger_in_use) { + int len, i; + len = code_size / sizeof(opcode_t); + caml_saved_code = (unsigned char *) caml_stat_alloc(len); + for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i]; + } #ifdef THREADED_CODE caml_thread_code(caml_start_code, code_size); #endif @@ -469,10 +484,19 @@ CAMLexport void caml_startup_code( /* Record the sections (for caml_get_section_table in meta.c) */ caml_section_table = section_table; caml_section_table_size = section_table_size; - /* Run the code */ + /* Initialize system libraries */ caml_init_exceptions(); caml_sys_init("", argv); - res = caml_interprete(caml_start_code, code_size); - if (Is_exception_result(res)) - caml_fatal_uncaught_exception(Extract_exception(res)); + /* Execute the program */ + caml_debugger(PROGRAM_START); + res = caml_interprete(caml_start_code, caml_code_size); + if (Is_exception_result(res)) { + caml_exn_bucket = Extract_exception(res); + if (caml_debugger_in_use) { + caml_extern_sp = &caml_exn_bucket; /* The debugger needs the + exception value.*/ + caml_debugger(UNCAUGHT_EXC); + } + caml_fatal_uncaught_exception(caml_exn_bucket); + } } diff --git a/camlp4/Makefile.ml b/camlp4/Makefile.ml index 751f3aebf..681f35bd2 100644 --- a/camlp4/Makefile.ml +++ b/camlp4/Makefile.ml @@ -90,7 +90,7 @@ let may_define_unix = if windows then [] else ["-D UNIX"] let () = !options.ocaml_Flags ^= "-w Aler -warn-error Aler"^^ - (if getenv "DTYPES" "" <> "" then "-dtypes" + (if getenv "DTYPES" "" <> "" then "-annot" else ""); !options.ocaml_P4 := camlp4boot_may_debug may_define_unix; !options.ocaml_P4_opt := camlp4boot_may_debug ("-D OPT" :: may_define_unix); diff --git a/config/Makefile-templ b/config/Makefile-templ index 1fe248ac8..9889767bb 100644 --- a/config/Makefile-templ +++ b/config/Makefile-templ @@ -78,10 +78,14 @@ SHARPBANGSCRIPTS=true # Under FreeBSD: #CPP=cpp -P +### Magic declarations for ocamlbuild -- leave unchanged +#ml let syslib x = "-l"^x;; +#ml let mklib out files opts = Printf.sprintf "ar rc %s %s %s; ranlib %s" out opts files out;; + ### How to invoke ranlib -# BSD-style: -#RANLIB=ranlib -#RANLIBCMD=ranlib +RANLIB=ranlib +RANLIBCMD=ranlib + # If ranlib is not needed: #RANLIB=ar rs #RANLIBCMD= diff --git a/config/Makefile.mingw b/config/Makefile.mingw index da9330b35..e5a743e00 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -145,11 +145,11 @@ BNG_ARCH=ia32 BNG_ASM_LEVEL=1 ### Configuration for LablTk -# Set TK_ROOT to the directory where you installed TCL/TK 8.4 +# Set TK_ROOT to the directory where you installed TCL/TK 8.5 # There must be no spaces or special characters in $(TK_ROOT) TK_ROOT=c:/tcl TK_DEFS=-I$(TK_ROOT)/include -TK_LINK=$(TK_ROOT)/bin/tk84.dll $(TK_ROOT)/bin/tcl84.dll -lws2_32 +TK_LINK=$(TK_ROOT)/bin/tk85.dll $(TK_ROOT)/bin/tcl85.dll -lws2_32 ############# Aliases for common commands diff --git a/config/Makefile.msvc b/config/Makefile.msvc index 183ba2d84..67e4ad716 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -80,7 +80,7 @@ BYTECC=cl /nologo -D_CRT_SECURE_NO_DEPRECATE BYTECCCOMPOPTS=/Ox /MD ### Additional link-time options for $(BYTECC). (For static linking.) -BYTECCLINKOPTS=/MD /F16777216 +BYTECCLINKOPTS= ### Additional compile-time options for $(BYTECC). (For building a DLL.) DLLCCCOMPOPTS=/Ox /MD @@ -131,7 +131,7 @@ NATIVECC=cl /nologo -D_CRT_SECURE_NO_DEPRECATE NATIVECCCOMPOPTS=/Ox /MD ### Additional link-time options for $(NATIVECC) -NATIVECCLINKOPTS=/MD /F16777216 +NATIVECCLINKOPTS= ### Build partially-linked object file PACKLD=link /lib /nologo /out:# there must be no space after this '/out:' @@ -145,17 +145,17 @@ BNG_ARCH=generic BNG_ASM_LEVEL=0 ### Configuration for LablTk -# Set TK_ROOT to the directory where you installed TCL/TK 8.3 +# Set TK_ROOT to the directory where you installed TCL/TK 8.5 TK_ROOT=c:/tcl TK_DEFS=-I$(TK_ROOT)/include # The following definition avoids hard-wiring $(TK_ROOT) in the libraries # produced by OCaml, and is therefore required for binary distribution # of these libraries. However, $(TK_ROOT)/lib must be added to the LIB # environment variable, as described in README.win32. -TK_LINK=tk84.lib tcl84.lib ws2_32.lib +TK_LINK=tk85.lib tcl85.lib ws2_32.lib # An alternative definition that avoids mucking with the LIB variable, # but hard-wires the Tcl/Tk location in the binaries -# TK_LINK=$(TK_ROOT)/tk84.lib $(TK_ROOT)/tcl84.lib ws2_32.lib +# TK_LINK=$(TK_ROOT)/tk85.lib $(TK_ROOT)/tcl85.lib ws2_32.lib ############# Aliases for common commands diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index a067fd065..a9f2309b6 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -83,7 +83,7 @@ BYTECCCOMPOPTS=/Ox /MD BYTECCDBGCOMPOPTS=-DDEBUG /Zi /W3 /Wp64 ### Additional link-time options for $(BYTECC). (For static linking.) -BYTECCLINKOPTS=/MD /F33554432 +BYTECCLINKOPTS= ### Additional compile-time options for $(BYTECC). (For building a DLL.) DLLCCCOMPOPTS=/Ox /MD @@ -135,7 +135,7 @@ NATIVECC=cl /nologo NATIVECCCOMPOPTS=/Ox /MD ### Additional link-time options for $(NATIVECC) -NATIVECCLINKOPTS=/MD /F33554432 +NATIVECCLINKOPTS= ### Build partially-linked object file PACKLD=link /lib /nologo /machine:AMD64 /out:# there must be no space after this '/out:' @@ -95,6 +95,8 @@ while : ; do pthread_wanted=no;; -no-tk|--no-tk) tk_wanted=no;; + -partialld|--partialld) + partialld="$2"; shift;; -tkdefs*|--tkdefs*) tk_defs=$2; shift;; -tklibs*|--tklibs*) @@ -303,14 +305,16 @@ case "$bytecc,$host" in gcc*,*-*-cygwin*) bytecccompopts="-fno-defer-pop $gcc_warnings -U_WIN32" dllccompopts="-D_WIN32 -DCAML_DLL" - flexlink="flexlink -chain cygwin -merge-manifest" - flexdir=`$flexlink -where | dos2unix` - if test -z "$flexdir"; then - echo "flexlink not found: native shared libraries won't be available" - withsharedlibs=no - else - iflexdir="-I\"$flexdir\"" - mkexe="$flexlink -exe" + if test $withsharedlibs = yes; then + flexlink="flexlink -chain cygwin -merge-manifest" + flexdir=`$flexlink -where | dos2unix` + if test -z "$flexdir"; then + echo "flexlink not found: native shared libraries won't be available" + withsharedlibs=no + else + iflexdir="-I\"$flexdir\"" + mkexe="$flexlink -exe" + fi fi exe=".exe" ostype="Cygwin";; diff --git a/debugger/.depend b/debugger/.depend index f71fcbef3..1a04b1eaa 100644 --- a/debugger/.depend +++ b/debugger/.depend @@ -1,46 +1,46 @@ -breakpoints.cmi: primitives.cmi ../bytecomp/instruct.cmi -checkpoints.cmi: primitives.cmi debugcom.cmi -command_line.cmi: -debugcom.cmi: primitives.cmi -debugger_config.cmi: -dynlink.cmi: -envaux.cmi: ../typing/path.cmi ../bytecomp/instruct.cmi ../typing/env.cmi +breakpoints.cmi: primitives.cmi ../bytecomp/instruct.cmi +checkpoints.cmi: primitives.cmi debugcom.cmi +command_line.cmi: +debugcom.cmi: primitives.cmi +debugger_config.cmi: +dynlink.cmi: +envaux.cmi: ../typing/path.cmi ../bytecomp/instruct.cmi ../typing/env.cmi eval.cmi: ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \ ../parsing/longident.cmi ../bytecomp/instruct.cmi ../typing/ident.cmi \ - ../typing/env.cmi debugcom.cmi -events.cmi: ../bytecomp/instruct.cmi -exec.cmi: -frames.cmi: primitives.cmi ../bytecomp/instruct.cmi -history.cmi: -input_handling.cmi: primitives.cmi -int64ops.cmi: -lexer.cmi: parser.cmi -loadprinter.cmi: ../parsing/longident.cmi dynlink.cmi -parameters.cmi: -parser.cmi: parser_aux.cmi ../parsing/longident.cmi -parser_aux.cmi: primitives.cmi ../parsing/longident.cmi -pattern_matching.cmi: ../typing/typedtree.cmi parser_aux.cmi debugcom.cmi -pos.cmi: ../bytecomp/instruct.cmi -primitives.cmi: ../otherlibs/unix/unix.cmi + ../typing/env.cmi debugcom.cmi +events.cmi: ../bytecomp/instruct.cmi +exec.cmi: +frames.cmi: primitives.cmi ../bytecomp/instruct.cmi +history.cmi: +input_handling.cmi: primitives.cmi +int64ops.cmi: +lexer.cmi: parser.cmi +loadprinter.cmi: ../parsing/longident.cmi dynlink.cmi +parameters.cmi: +parser.cmi: parser_aux.cmi ../parsing/longident.cmi +parser_aux.cmi: primitives.cmi ../parsing/longident.cmi +pattern_matching.cmi: ../typing/typedtree.cmi parser_aux.cmi debugcom.cmi +pos.cmi: ../bytecomp/instruct.cmi +primitives.cmi: $(UNIXDIR)/unix.cmi printval.cmi: ../typing/types.cmi ../typing/path.cmi parser_aux.cmi \ - ../typing/env.cmi debugcom.cmi -program_loading.cmi: primitives.cmi -program_management.cmi: -question.cmi: -show_information.cmi: ../bytecomp/instruct.cmi -show_source.cmi: ../bytecomp/instruct.cmi -source.cmi: -symbols.cmi: ../bytecomp/instruct.cmi -time_travel.cmi: primitives.cmi -trap_barrier.cmi: -unix_tools.cmi: ../otherlibs/unix/unix.cmi + ../typing/env.cmi debugcom.cmi +program_loading.cmi: primitives.cmi +program_management.cmi: +question.cmi: +show_information.cmi: ../bytecomp/instruct.cmi +show_source.cmi: ../bytecomp/instruct.cmi +source.cmi: +symbols.cmi: ../bytecomp/instruct.cmi +time_travel.cmi: primitives.cmi +trap_barrier.cmi: +unix_tools.cmi: $(UNIXDIR)/unix.cmi breakpoints.cmo: symbols.cmi primitives.cmi pos.cmi ../bytecomp/instruct.cmi \ - exec.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi + exec.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi breakpoints.cmx: symbols.cmx primitives.cmx pos.cmx ../bytecomp/instruct.cmx \ - exec.cmx debugcom.cmx checkpoints.cmx breakpoints.cmi -checkpoints.cmo: primitives.cmi int64ops.cmi debugcom.cmi checkpoints.cmi -checkpoints.cmx: primitives.cmx int64ops.cmx debugcom.cmx checkpoints.cmi -command_line.cmo: unix_tools.cmi ../otherlibs/unix/unix.cmi \ + exec.cmx debugcom.cmx checkpoints.cmx breakpoints.cmi +checkpoints.cmo: primitives.cmi int64ops.cmi debugcom.cmi checkpoints.cmi +checkpoints.cmx: primitives.cmx int64ops.cmx debugcom.cmx checkpoints.cmi +command_line.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi \ ../typing/types.cmi time_travel.cmi symbols.cmi source.cmi \ show_source.cmi show_information.cmi question.cmi program_management.cmi \ program_loading.cmi printval.cmi primitives.cmi pos.cmi parser_aux.cmi \ @@ -49,8 +49,8 @@ command_line.cmo: unix_tools.cmi ../otherlibs/unix/unix.cmi \ ../bytecomp/instruct.cmi input_handling.cmi history.cmi frames.cmi \ events.cmi eval.cmi envaux.cmi debugger_config.cmi debugcom.cmi \ ../typing/ctype.cmi ../utils/config.cmi checkpoints.cmi breakpoints.cmi \ - command_line.cmi -command_line.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx \ + command_line.cmi +command_line.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx \ ../typing/types.cmx time_travel.cmx symbols.cmx source.cmx \ show_source.cmx show_information.cmx question.cmx program_management.cmx \ program_loading.cmx printval.cmx primitives.cmx pos.cmx parser_aux.cmi \ @@ -59,154 +59,154 @@ command_line.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx \ ../bytecomp/instruct.cmx input_handling.cmx history.cmx frames.cmx \ events.cmx eval.cmx envaux.cmx debugger_config.cmx debugcom.cmx \ ../typing/ctype.cmx ../utils/config.cmx checkpoints.cmx breakpoints.cmx \ - command_line.cmi + command_line.cmi debugcom.cmo: primitives.cmi ../utils/misc.cmi int64ops.cmi \ - input_handling.cmi debugcom.cmi + input_handling.cmi debugcom.cmi debugcom.cmx: primitives.cmx ../utils/misc.cmx int64ops.cmx \ - input_handling.cmx debugcom.cmi -debugger_config.cmo: int64ops.cmi debugger_config.cmi -debugger_config.cmx: int64ops.cmx debugger_config.cmi + input_handling.cmx debugcom.cmi +debugger_config.cmo: int64ops.cmi debugger_config.cmi +debugger_config.cmx: int64ops.cmx debugger_config.cmi dynlink.cmo: ../bytecomp/symtable.cmi ../bytecomp/opcodes.cmo \ ../utils/misc.cmi ../bytecomp/meta.cmi ../bytecomp/dll.cmi \ ../utils/consistbl.cmi ../utils/config.cmi ../bytecomp/cmo_format.cmi \ - dynlink.cmi + dynlink.cmi dynlink.cmx: ../bytecomp/symtable.cmx ../bytecomp/opcodes.cmx \ ../utils/misc.cmx ../bytecomp/meta.cmx ../bytecomp/dll.cmx \ ../utils/consistbl.cmx ../utils/config.cmx ../bytecomp/cmo_format.cmi \ - dynlink.cmi + dynlink.cmi envaux.cmo: ../typing/types.cmi ../typing/subst.cmi ../typing/printtyp.cmi \ ../typing/path.cmi ../typing/mtype.cmi ../utils/misc.cmi \ - ../bytecomp/instruct.cmi ../typing/env.cmi envaux.cmi + ../bytecomp/instruct.cmi ../typing/env.cmi envaux.cmi envaux.cmx: ../typing/types.cmx ../typing/subst.cmx ../typing/printtyp.cmx \ ../typing/path.cmx ../typing/mtype.cmx ../utils/misc.cmx \ - ../bytecomp/instruct.cmx ../typing/env.cmx envaux.cmi + ../bytecomp/instruct.cmx ../typing/env.cmx envaux.cmi eval.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi ../typing/subst.cmi \ printval.cmi ../typing/printtyp.cmi ../typing/predef.cmi \ ../typing/path.cmi parser_aux.cmi ../utils/misc.cmi \ ../parsing/longident.cmi ../bytecomp/instruct.cmi ../typing/ident.cmi \ frames.cmi ../typing/env.cmi debugcom.cmi ../typing/ctype.cmi \ - ../typing/btype.cmi eval.cmi + ../typing/btype.cmi eval.cmi eval.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx ../typing/subst.cmx \ printval.cmx ../typing/printtyp.cmx ../typing/predef.cmx \ ../typing/path.cmx parser_aux.cmi ../utils/misc.cmx \ ../parsing/longident.cmx ../bytecomp/instruct.cmx ../typing/ident.cmx \ frames.cmx ../typing/env.cmx debugcom.cmx ../typing/ctype.cmx \ - ../typing/btype.cmx eval.cmi -events.cmo: ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi -events.cmx: ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmi -exec.cmo: exec.cmi -exec.cmx: exec.cmi + ../typing/btype.cmx eval.cmi +events.cmo: ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi +events.cmx: ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmi +exec.cmo: exec.cmi +exec.cmx: exec.cmi frames.cmo: symbols.cmi ../utils/misc.cmi ../bytecomp/instruct.cmi events.cmi \ - debugcom.cmi frames.cmi + debugcom.cmi frames.cmi frames.cmx: symbols.cmx ../utils/misc.cmx ../bytecomp/instruct.cmx events.cmx \ - debugcom.cmx frames.cmi + debugcom.cmx frames.cmi history.cmo: primitives.cmi int64ops.cmi debugger_config.cmi checkpoints.cmi \ - history.cmi + history.cmi history.cmx: primitives.cmx int64ops.cmx debugger_config.cmx checkpoints.cmx \ - history.cmi -input_handling.cmo: ../otherlibs/unix/unix.cmi primitives.cmi \ - input_handling.cmi -input_handling.cmx: ../otherlibs/unix/unix.cmx primitives.cmx \ - input_handling.cmi -int64ops.cmo: int64ops.cmi -int64ops.cmx: int64ops.cmi -lexer.cmo: parser.cmi lexer.cmi -lexer.cmx: parser.cmx lexer.cmi + history.cmi +input_handling.cmo: $(UNIXDIR)/unix.cmi primitives.cmi \ + input_handling.cmi +input_handling.cmx: $(UNIXDIR)/unix.cmx primitives.cmx \ + input_handling.cmi +int64ops.cmo: int64ops.cmi +int64ops.cmx: int64ops.cmi +lexer.cmo: parser.cmi lexer.cmi +lexer.cmx: parser.cmx lexer.cmi loadprinter.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi printval.cmi \ ../typing/printtyp.cmi ../typing/path.cmi ../utils/misc.cmi \ ../parsing/longident.cmi ../typing/ident.cmi ../typing/env.cmi \ - dynlink.cmi ../typing/ctype.cmi ../utils/config.cmi loadprinter.cmi + dynlink.cmi ../typing/ctype.cmi ../utils/config.cmi loadprinter.cmi loadprinter.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx printval.cmx \ ../typing/printtyp.cmx ../typing/path.cmx ../utils/misc.cmx \ ../parsing/longident.cmx ../typing/ident.cmx ../typing/env.cmx \ - dynlink.cmx ../typing/ctype.cmx ../utils/config.cmx loadprinter.cmi -main.cmo: unix_tools.cmi ../otherlibs/unix/unix.cmi time_travel.cmi \ - show_information.cmi question.cmi program_management.cmi parameters.cmi \ - ../utils/misc.cmi input_handling.cmi frames.cmi exec.cmi \ + dynlink.cmx ../typing/ctype.cmx ../utils/config.cmx loadprinter.cmi +main.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi time_travel.cmi \ + show_information.cmi question.cmi program_management.cmi primitives.cmi \ + parameters.cmi ../utils/misc.cmi input_handling.cmi frames.cmi exec.cmi \ ../typing/env.cmi debugger_config.cmi ../utils/config.cmi \ - command_line.cmi ../utils/clflags.cmi checkpoints.cmi -main.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx time_travel.cmx \ - show_information.cmx question.cmx program_management.cmx parameters.cmx \ - ../utils/misc.cmx input_handling.cmx frames.cmx exec.cmx \ + command_line.cmi ../utils/clflags.cmi checkpoints.cmi +main.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx time_travel.cmx \ + show_information.cmx question.cmx program_management.cmx primitives.cmx \ + parameters.cmx ../utils/misc.cmx input_handling.cmx frames.cmx exec.cmx \ ../typing/env.cmx debugger_config.cmx ../utils/config.cmx \ - command_line.cmx ../utils/clflags.cmx checkpoints.cmx + command_line.cmx ../utils/clflags.cmx checkpoints.cmx parameters.cmo: primitives.cmi envaux.cmi debugger_config.cmi \ - ../utils/config.cmi parameters.cmi + ../utils/config.cmi parameters.cmi parameters.cmx: primitives.cmx envaux.cmx debugger_config.cmx \ - ../utils/config.cmx parameters.cmi + ../utils/config.cmx parameters.cmi parser.cmo: parser_aux.cmi ../parsing/longident.cmi int64ops.cmi \ - input_handling.cmi parser.cmi + input_handling.cmi parser.cmi parser.cmx: parser_aux.cmi ../parsing/longident.cmx int64ops.cmx \ - input_handling.cmx parser.cmi + input_handling.cmx parser.cmi pattern_matching.cmo: ../typing/typedtree.cmi parser_aux.cmi \ ../utils/misc.cmi debugger_config.cmi debugcom.cmi ../typing/ctype.cmi \ - pattern_matching.cmi + pattern_matching.cmi pattern_matching.cmx: ../typing/typedtree.cmx parser_aux.cmi \ ../utils/misc.cmx debugger_config.cmx debugcom.cmx ../typing/ctype.cmx \ - pattern_matching.cmi + pattern_matching.cmi pos.cmo: source.cmi primitives.cmi ../parsing/location.cmi \ - ../bytecomp/instruct.cmi pos.cmi + ../bytecomp/instruct.cmi pos.cmi pos.cmx: source.cmx primitives.cmx ../parsing/location.cmx \ - ../bytecomp/instruct.cmx pos.cmi -primitives.cmo: ../otherlibs/unix/unix.cmi primitives.cmi -primitives.cmx: ../otherlibs/unix/unix.cmx primitives.cmi + ../bytecomp/instruct.cmx pos.cmi +primitives.cmo: $(UNIXDIR)/unix.cmi primitives.cmi +primitives.cmx: $(UNIXDIR)/unix.cmx primitives.cmi printval.cmo: ../typing/types.cmi ../bytecomp/symtable.cmi \ ../typing/printtyp.cmi ../typing/path.cmi parser_aux.cmi \ ../typing/outcometree.cmi ../typing/oprint.cmi \ - ../toplevel/genprintval.cmi debugcom.cmi printval.cmi + ../toplevel/genprintval.cmi debugcom.cmi printval.cmi printval.cmx: ../typing/types.cmx ../bytecomp/symtable.cmx \ ../typing/printtyp.cmx ../typing/path.cmx parser_aux.cmi \ ../typing/outcometree.cmi ../typing/oprint.cmx \ - ../toplevel/genprintval.cmx debugcom.cmx printval.cmi -program_loading.cmo: unix_tools.cmi ../otherlibs/unix/unix.cmi primitives.cmi \ - parameters.cmi input_handling.cmi debugger_config.cmi program_loading.cmi -program_loading.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx primitives.cmx \ - parameters.cmx input_handling.cmx debugger_config.cmx program_loading.cmi -program_management.cmo: unix_tools.cmi ../otherlibs/unix/unix.cmi \ + ../toplevel/genprintval.cmx debugcom.cmx printval.cmi +program_loading.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi primitives.cmi \ + parameters.cmi input_handling.cmi debugger_config.cmi program_loading.cmi +program_loading.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx primitives.cmx \ + parameters.cmx input_handling.cmx debugger_config.cmx program_loading.cmi +program_management.cmo: unix_tools.cmi $(UNIXDIR)/unix.cmi \ time_travel.cmi symbols.cmi question.cmi program_loading.cmi \ primitives.cmi parameters.cmi int64ops.cmi input_handling.cmi history.cmi \ - debugger_config.cmi breakpoints.cmi program_management.cmi -program_management.cmx: unix_tools.cmx ../otherlibs/unix/unix.cmx \ + debugger_config.cmi breakpoints.cmi program_management.cmi +program_management.cmx: unix_tools.cmx $(UNIXDIR)/unix.cmx \ time_travel.cmx symbols.cmx question.cmx program_loading.cmx \ primitives.cmx parameters.cmx int64ops.cmx input_handling.cmx history.cmx \ - debugger_config.cmx breakpoints.cmx program_management.cmi -question.cmo: primitives.cmi lexer.cmi input_handling.cmi question.cmi -question.cmx: primitives.cmx lexer.cmx input_handling.cmx question.cmi -show_information.cmo: symbols.cmi show_source.cmi printval.cmi \ + debugger_config.cmx breakpoints.cmx program_management.cmi +question.cmo: primitives.cmi lexer.cmi input_handling.cmi question.cmi +question.cmx: primitives.cmx lexer.cmx input_handling.cmx question.cmi +show_information.cmo: symbols.cmi source.cmi show_source.cmi printval.cmi \ ../utils/misc.cmi ../bytecomp/instruct.cmi frames.cmi events.cmi \ - debugcom.cmi checkpoints.cmi breakpoints.cmi show_information.cmi -show_information.cmx: symbols.cmx show_source.cmx printval.cmx \ + debugcom.cmi checkpoints.cmi breakpoints.cmi show_information.cmi +show_information.cmx: symbols.cmx source.cmx show_source.cmx printval.cmx \ ../utils/misc.cmx ../bytecomp/instruct.cmx frames.cmx events.cmx \ - debugcom.cmx checkpoints.cmx breakpoints.cmx show_information.cmi + debugcom.cmx checkpoints.cmx breakpoints.cmx show_information.cmi show_source.cmo: source.cmi primitives.cmi parameters.cmi \ ../parsing/location.cmi ../bytecomp/instruct.cmi events.cmi \ - debugger_config.cmi show_source.cmi + debugger_config.cmi show_source.cmi show_source.cmx: source.cmx primitives.cmx parameters.cmx \ ../parsing/location.cmx ../bytecomp/instruct.cmx events.cmx \ - debugger_config.cmx show_source.cmi + debugger_config.cmx show_source.cmi source.cmo: primitives.cmi ../utils/misc.cmi debugger_config.cmi \ - ../utils/config.cmi source.cmi + ../utils/config.cmi source.cmi source.cmx: primitives.cmx ../utils/misc.cmx debugger_config.cmx \ - ../utils/config.cmx source.cmi -symbols.cmo: ../bytecomp/symtable.cmi ../bytecomp/instruct.cmi events.cmi \ - debugger_config.cmi debugcom.cmi checkpoints.cmi \ - ../bytecomp/bytesections.cmi symbols.cmi -symbols.cmx: ../bytecomp/symtable.cmx ../bytecomp/instruct.cmx events.cmx \ - debugger_config.cmx debugcom.cmx checkpoints.cmx \ - ../bytecomp/bytesections.cmx symbols.cmi + ../utils/config.cmx source.cmi +symbols.cmo: ../bytecomp/symtable.cmi program_loading.cmi \ + ../bytecomp/instruct.cmi events.cmi debugger_config.cmi debugcom.cmi \ + checkpoints.cmi ../bytecomp/bytesections.cmi symbols.cmi +symbols.cmx: ../bytecomp/symtable.cmx program_loading.cmx \ + ../bytecomp/instruct.cmx events.cmx debugger_config.cmx debugcom.cmx \ + checkpoints.cmx ../bytecomp/bytesections.cmx symbols.cmi time_travel.cmo: trap_barrier.cmi symbols.cmi question.cmi \ program_loading.cmi primitives.cmi ../utils/misc.cmi int64ops.cmi \ ../bytecomp/instruct.cmi input_handling.cmi exec.cmi events.cmi \ debugger_config.cmi debugcom.cmi checkpoints.cmi breakpoints.cmi \ - time_travel.cmi + time_travel.cmi time_travel.cmx: trap_barrier.cmx symbols.cmx question.cmx \ program_loading.cmx primitives.cmx ../utils/misc.cmx int64ops.cmx \ ../bytecomp/instruct.cmx input_handling.cmx exec.cmx events.cmx \ debugger_config.cmx debugcom.cmx checkpoints.cmx breakpoints.cmx \ - time_travel.cmi -trap_barrier.cmo: exec.cmi debugcom.cmi checkpoints.cmi trap_barrier.cmi -trap_barrier.cmx: exec.cmx debugcom.cmx checkpoints.cmx trap_barrier.cmi -unix_tools.cmo: ../otherlibs/unix/unix.cmi primitives.cmi ../utils/misc.cmi \ - unix_tools.cmi -unix_tools.cmx: ../otherlibs/unix/unix.cmx primitives.cmx ../utils/misc.cmx \ - unix_tools.cmi + time_travel.cmi +trap_barrier.cmo: exec.cmi debugcom.cmi checkpoints.cmi trap_barrier.cmi +trap_barrier.cmx: exec.cmx debugcom.cmx checkpoints.cmx trap_barrier.cmi +unix_tools.cmo: $(UNIXDIR)/unix.cmi primitives.cmi ../utils/misc.cmi \ + unix_tools.cmi +unix_tools.cmx: $(UNIXDIR)/unix.cmx primitives.cmx ../utils/misc.cmx \ + unix_tools.cmi diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared index 4ed986a54..1e16f32ef 100644 --- a/debugger/Makefile.shared +++ b/debugger/Makefile.shared @@ -60,11 +60,11 @@ OBJS=\ pos.cmo \ checkpoints.cmo \ events.cmo \ + program_loading.cmo \ symbols.cmo \ breakpoints.cmo \ trap_barrier.cmo \ history.cmo \ - program_loading.cmo \ printval.cmo \ show_source.cmo \ time_travel.cmo \ @@ -72,7 +72,7 @@ OBJS=\ frames.cmo \ eval.cmo \ show_information.cmo \ - loadprinter.cmo \ + loadprinter.cmo \ parser.cmo \ command_line.cmo \ main.cmo @@ -99,7 +99,8 @@ clean:: $(CAMLC) -c $(COMPFLAGS) $< depend: beforedepend - $(CAMLDEP) $(DEPFLAGS) *.mli *.ml > .depend + $(CAMLDEP) $(DEPFLAGS) *.mli *.ml \ + | sed -e 's,$(UNIXDIR)/,$$(UNIXDIR)/,' > .depend lexer.ml: lexer.mll $(CAMLLEX) lexer.mll diff --git a/debugger/command_line.ml b/debugger/command_line.ml index 8a1a61136..2bdd8afaa 100644 --- a/debugger/command_line.ml +++ b/debugger/command_line.ml @@ -705,26 +705,30 @@ let instr_last ppf lexbuf = let instr_list ppf lexbuf = let (mo, beg, e) = list_arguments_eol Lexer.lexeme lexbuf in - let (curr_mod, point) = + let (curr_mod, line, column) = try selected_point () with | Not_found -> - ("", -1) + ("", -1, -1) in let mdle = convert_module (module_of_longident mo) in let pos = Lexing.dummy_pos in + let buffer = + try get_buffer pos mdle with + | Not_found -> error ("No source file for " ^ mdle ^ ".") in + let point = + if column <> -1 then + (point_of_coord buffer line 1) + column + else + -1 in let beginning = match beg with - | None when (mo <> None) || (point = -1) -> + | None when (mo <> None) || (line = -1) -> 1 | None -> - let buffer = - try get_buffer pos mdle with - | Not_found -> error ("No source file for " ^ mdle ^ ".") - in begin try - max 1 ((snd (line_of_pos buffer point)) - 10) + max 1 (line - 10) with Out_of_range -> 1 end @@ -861,11 +865,19 @@ let info_events ppf lexbuf = print_endline " Address Characters Kind Repr."; List.iter (function ev -> - Printf.printf + let start_char, end_char = + try + let buffer = get_buffer (Events.get_pos ev) ev.ev_module in + (snd (start_and_cnum buffer ev.ev_loc.Location.loc_start)), + (snd (start_and_cnum buffer ev.ev_loc.Location.loc_end)) + with _ -> + ev.ev_loc.Location.loc_start.Lexing.pos_cnum, + ev.ev_loc.Location.loc_end.Lexing.pos_cnum in + Printf.printf "%10d %6d-%-6d %10s %10s\n" ev.ev_pos - ev.ev_loc.Location.loc_start.Lexing.pos_cnum - ev.ev_loc.Location.loc_end.Lexing.pos_cnum + start_char + end_char ((match ev.ev_kind with Event_before -> "before" | Event_after _ -> "after" diff --git a/debugger/frames.ml b/debugger/frames.ml index 7260f89d5..2dcff988d 100644 --- a/debugger/frames.ml +++ b/debugger/frames.ml @@ -33,7 +33,9 @@ let selected_point () = None -> raise Not_found | Some ev -> - (ev.ev_module, (Events.get_pos ev).Lexing.pos_cnum) + (ev.ev_module, + (Events.get_pos ev).Lexing.pos_lnum, + (Events.get_pos ev).Lexing.pos_cnum - (Events.get_pos ev).Lexing.pos_bol) let selected_event_is_before () = match !selected_event with diff --git a/debugger/frames.mli b/debugger/frames.mli index 0906171f2..b4863433d 100644 --- a/debugger/frames.mli +++ b/debugger/frames.mli @@ -24,9 +24,9 @@ val current_frame : int ref (* Event at selected position. *) val selected_event : debug_event option ref -(* Selected position in source. *) +(* Selected position in source (module, line, column). *) (* Raise `Not_found' if not on an event. *) -val selected_point : unit -> string * int +val selected_point : unit -> string * int * int val selected_event_is_before : unit -> bool diff --git a/debugger/main.ml b/debugger/main.ml index 9cfcf447f..8d430c0ac 100644 --- a/debugger/main.ml +++ b/debugger/main.ml @@ -24,6 +24,7 @@ open Program_management open Frames open Show_information open Format +open Primitives let line_buffer = Lexing.from_function read_user_input @@ -107,7 +108,39 @@ let rec protect ppf restart loop = kill_program (); raise x -let toplevel_loop () = protect Format.std_formatter loop loop +let execute_file_if_any () = + let buffer = Buffer.create 128 in + begin + try + let base = ".ocamldebug" in + let file = + if Sys.file_exists base then + base + else + Filename.concat (Sys.getenv "HOME") base in + let ch = open_in file in + fprintf Format.std_formatter "Executing file %s@." file; + while true do + let line = string_trim (input_line ch) in + if line <> "" && line.[0] <> '#' then begin + Buffer.add_string buffer line; + Buffer.add_char buffer '\n' + end + done; + with _ -> () + end; + let len = Buffer.length buffer in + if len > 0 then + let commands = Buffer.sub buffer 0 (pred len) in + line_loop Format.std_formatter (Lexing.from_string commands) + +let toplevel_loop () = + interactif := false; + current_prompt := ""; + execute_file_if_any (); + interactif := true; + current_prompt := debugger_prompt; + protect Format.std_formatter loop loop (* Parsing of command-line arguments *) @@ -167,7 +200,6 @@ let main () = arguments := !arguments ^ " " ^ (Filename.quote Sys.argv.(j)) done end; - current_prompt := debugger_prompt; printf "\tObjective Caml Debugger version %s@.@." Config.version; Config.load_path := !default_load_path; Clflags.recursive_types := true; (* Allow recursive types. *) diff --git a/debugger/show_information.ml b/debugger/show_information.ml index 15176a1f2..bd746eb7f 100644 --- a/debugger/show_information.ml +++ b/debugger/show_information.ml @@ -20,6 +20,7 @@ open Checkpoints open Events open Symbols open Frames +open Source open Show_source open Breakpoints @@ -68,9 +69,15 @@ let show_current_event ppf = (* Display short information about one frame. *) let show_one_frame framenum ppf event = + let pos = Events.get_pos event in + let cnum = + try + let buffer = get_buffer pos event.ev_module in + snd (start_and_cnum buffer pos) + with _ -> pos.Lexing.pos_cnum in fprintf ppf "#%i Pc : %i %s char %i@." framenum event.ev_pos event.ev_module - (Events.get_pos event).Lexing.pos_cnum + cnum (* Display information about the current frame. *) (* --- `select frame' must have succeded before calling this function. *) diff --git a/debugger/show_source.ml b/debugger/show_source.ml index 3b7a133fe..2826c9e68 100644 --- a/debugger/show_source.ml +++ b/debugger/show_source.ml @@ -45,13 +45,16 @@ let show_point ev selected = let before = (ev.ev_kind = Event_before) in if !emacs && selected then begin try + let buffer = get_buffer (Events.get_pos ev) mdle in let source = source_of_module ev.ev_loc.Location.loc_start mdle in printf "\026\026M%s:%i:%i" source - ev.ev_loc.Location.loc_start.Lexing.pos_cnum - ev.ev_loc.Location.loc_end.Lexing.pos_cnum; + (snd (start_and_cnum buffer ev.ev_loc.Location.loc_start)) + (snd (start_and_cnum buffer ev.ev_loc.Location.loc_end)); printf "%s\n" (if before then ":before" else ":after") with - Not_found -> (* get_buffer *) + Out_of_range -> (* point_of_coord *) + prerr_endline "Position out of range." + | Not_found -> (* Events.get_pos || get_buffer *) prerr_endline ("No source file for " ^ mdle ^ "."); show_no_point () end @@ -59,11 +62,10 @@ let show_point ev selected = begin try let pos = Events.get_pos ev in let buffer = get_buffer pos mdle in - let point = pos.Lexing.pos_cnum in - let (start, line_number) = line_of_pos buffer point in - ignore(print_line buffer line_number start point before) + let start, point = start_and_cnum buffer pos in + ignore(print_line buffer pos.Lexing.pos_lnum start point before) with - Out_of_range -> (* line_of_pos *) + Out_of_range -> (* point_of_coord *) prerr_endline "Position out of range." | Not_found -> (* Events.get_pos || get_buffer *) prerr_endline ("No source file for " ^ mdle ^ ".") diff --git a/debugger/source.ml b/debugger/source.ml index 8975134ff..f0d3d48fb 100644 --- a/debugger/source.ml +++ b/debugger/source.ml @@ -185,3 +185,8 @@ let pos_of_line buffer line = (* --- The first line and column are line 1 and column 1. *) let point_of_coord buffer line column = fst (pos_of_line buffer line) + (pred column) + +let start_and_cnum buffer pos = + let line_number = pos.Lexing.pos_lnum in + let start = point_of_coord buffer line_number 1 in + start, start + (pos.Lexing.pos_cnum - pos.Lexing.pos_bol) diff --git a/debugger/source.mli b/debugger/source.mli index 5bcbb74d8..273cb517b 100644 --- a/debugger/source.mli +++ b/debugger/source.mli @@ -56,3 +56,6 @@ val pos_of_line : buffer -> int -> position (* Convert a coordinate (line / column) into a position. *) (* --- The first line and column are line 1 and column 1. *) val point_of_coord : buffer -> int -> int -> int + +(* Return the offsets of both line start and cnum for the passed position. *) +val start_and_cnum : buffer -> Lexing.position -> (int * int) diff --git a/debugger/symbols.ml b/debugger/symbols.ml index 235e2af34..392da976a 100644 --- a/debugger/symbols.ml +++ b/debugger/symbols.ml @@ -17,6 +17,7 @@ open Instruct open Debugger_config (* Toplevel *) +open Program_loading let modules = ref ([] : string list) @@ -61,6 +62,12 @@ let read_symbols' bytecode_file = List.iter (relocate_event orig) evl; eventlists := evl :: !eventlists done; + begin try + ignore (Bytesections.seek_section ic "CODE") + with Not_found -> + (* The file contains only debugging info, loading mode is forced to "manual" *) + set_launching_function (List.assoc "manual" loading_modes) + end; close_in_noerr ic; !eventlists diff --git a/driver/main_args.ml b/driver/main_args.ml index 7256c3583..fb6263f1d 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -144,7 +144,7 @@ struct \032 -<letter> disable set <letter>\n\ \032 @<num> enable warning <num> and treat it as an error\n\ \032 @<letter> enable set <letter> and treat them as errors\n\ - \032 default setting is \"+a-4-6-9-27-28\""; + \032 default setting is \"+a-4-6-9-27-28-29\""; "-warn-error" , Arg.String F._warn_error, "<list> Enable or disable error status for warnings according\n\ \ to <list>. See option -w for the syntax of <list>.\n\ diff --git a/driver/optmain.ml b/driver/optmain.ml index 7a6a03859..307bc2ade 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -179,7 +179,7 @@ let main () = \032 -<letter> disable set <letter>\n\ \032 @<num> enable warning <num> and treat it as an error\n\ \032 @<letter> enable set <letter> and treat them as errors\n\ - \032 default setting is \"+a-4-6-9-27\""; + \032 default setting is \"+a-4-6-9-27-28-29\""; "-warn-error" , Arg.String (Warnings.parse_options true), "<list> Enable or disable error status for warnings according\n\ \ to <list>. See option -w for the syntax of <list>.\n\ diff --git a/emacs/caml-types.el b/emacs/caml-types.el index 44f09a031..05b1a2c0a 100644 --- a/emacs/caml-types.el +++ b/emacs/caml-types.el @@ -256,9 +256,9 @@ See `caml-types-location-re' for annotation file format. (let* ((loc-re (concat caml-types-position-re " " caml-types-position-re)) (end-re (concat caml-types-position-re " --")) - (def-re (concat "def \\([^ ]\\)* " loc-re)) - (def-end-re (concat "def \\([^ ]\\)* " end-re)) - (internal-re (concat "int_ref \\([^ ]\\)* " loc-re)) + (def-re (concat "def \\([^ ]*\\) " loc-re)) + (def-end-re (concat "def \\([^ ]*\\) " end-re)) + (internal-re (concat "int_ref \\([^ ]*\\) " loc-re)) (external-re "ext_ref \\(.*\\)")) (cond ((string-match def-re kind) @@ -359,7 +359,7 @@ See `caml-types-location-re' for annotation file format. (expand-file-name "_build" project-dir))))) (if (equal project-dir (parent-dir project-dir)) (error (concat "No annotation file. " - "You should compile with option \"-dtypes\"."))) + "You should compile with option \"-annot\"."))) (setq project-dir (parent-dir project-dir))) type-path)))) diff --git a/lex/.depend b/lex/.depend index df03846a1..b51dbd3bd 100644 --- a/lex/.depend +++ b/lex/.depend @@ -1,34 +1,34 @@ -common.cmi: syntax.cmi lexgen.cmi -compact.cmi: lexgen.cmi -cset.cmi: -lexer.cmi: parser.cmi -lexgen.cmi: syntax.cmi -output.cmi: syntax.cmi lexgen.cmi compact.cmi common.cmi -outputbis.cmi: syntax.cmi lexgen.cmi common.cmi -parser.cmi: syntax.cmi -syntax.cmi: cset.cmi -table.cmi: -common.cmo: syntax.cmi lexgen.cmi common.cmi -common.cmx: syntax.cmx lexgen.cmx common.cmi -compact.cmo: table.cmi lexgen.cmi compact.cmi -compact.cmx: table.cmx lexgen.cmx compact.cmi -cset.cmo: cset.cmi -cset.cmx: cset.cmi -lexer.cmo: syntax.cmi parser.cmi lexer.cmi -lexer.cmx: syntax.cmx parser.cmx lexer.cmi -lexgen.cmo: table.cmi syntax.cmi cset.cmi lexgen.cmi -lexgen.cmx: table.cmx syntax.cmx cset.cmx lexgen.cmi +common.cmi: syntax.cmi lexgen.cmi +compact.cmi: lexgen.cmi +cset.cmi: +lexer.cmi: parser.cmi +lexgen.cmi: syntax.cmi +output.cmi: syntax.cmi lexgen.cmi compact.cmi common.cmi +outputbis.cmi: syntax.cmi lexgen.cmi common.cmi +parser.cmi: syntax.cmi +syntax.cmi: cset.cmi +table.cmi: +common.cmo: syntax.cmi lexgen.cmi common.cmi +common.cmx: syntax.cmx lexgen.cmx common.cmi +compact.cmo: table.cmi lexgen.cmi compact.cmi +compact.cmx: table.cmx lexgen.cmx compact.cmi +cset.cmo: cset.cmi +cset.cmx: cset.cmi +lexer.cmo: syntax.cmi parser.cmi lexer.cmi +lexer.cmx: syntax.cmx parser.cmx lexer.cmi +lexgen.cmo: table.cmi syntax.cmi cset.cmi lexgen.cmi +lexgen.cmx: table.cmx syntax.cmx cset.cmx lexgen.cmi main.cmo: syntax.cmi parser.cmi outputbis.cmi output.cmi lexgen.cmi lexer.cmi \ - cset.cmi compact.cmi common.cmi + cset.cmi compact.cmi common.cmi main.cmx: syntax.cmx parser.cmx outputbis.cmx output.cmx lexgen.cmx lexer.cmx \ - cset.cmx compact.cmx common.cmx -output.cmo: syntax.cmi lexgen.cmi compact.cmi common.cmi output.cmi -output.cmx: syntax.cmx lexgen.cmx compact.cmx common.cmx output.cmi -outputbis.cmo: syntax.cmi lexgen.cmi common.cmi outputbis.cmi -outputbis.cmx: syntax.cmx lexgen.cmx common.cmx outputbis.cmi -parser.cmo: syntax.cmi cset.cmi parser.cmi -parser.cmx: syntax.cmx cset.cmx parser.cmi -syntax.cmo: cset.cmi syntax.cmi -syntax.cmx: cset.cmx syntax.cmi -table.cmo: table.cmi -table.cmx: table.cmi + cset.cmx compact.cmx common.cmx +output.cmo: syntax.cmi lexgen.cmi compact.cmi common.cmi output.cmi +output.cmx: syntax.cmx lexgen.cmx compact.cmx common.cmx output.cmi +outputbis.cmo: syntax.cmi lexgen.cmi common.cmi outputbis.cmi +outputbis.cmx: syntax.cmx lexgen.cmx common.cmx outputbis.cmi +parser.cmo: syntax.cmi cset.cmi parser.cmi +parser.cmx: syntax.cmx cset.cmx parser.cmi +syntax.cmo: cset.cmi syntax.cmi +syntax.cmx: cset.cmx syntax.cmi +table.cmo: table.cmi +table.cmx: table.cmi diff --git a/lex/Makefile.nt b/lex/Makefile.nt index ab2a42a10..cb1ef94a5 100644 --- a/lex/Makefile.nt +++ b/lex/Makefile.nt @@ -14,6 +14,8 @@ # The lexer generator +include ../config/Makefile + CAMLC=../boot/ocamlrun ../boot/ocamlc -I ../boot CAMLOPT=../boot/ocamlrun ../ocamlopt -I ../stdlib COMPFLAGS=-warn-error A diff --git a/myocamlbuild.ml b/myocamlbuild.ml index db2e377fd..b1ec1eb4d 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -469,7 +469,7 @@ rule "Standard library manual" Seq[Cmd(S[A"mkdir"; A"-p"; P"ocamldoc/stdlib_man"]); Cmd(S[ocamldoc; A"-man"; A"-d"; P"ocamldoc/stdlib_man"; A"-I"; P "stdlib"; A"-I"; P"otherlibs/unix"; A"-I"; P"otherlibs/num"; - A"-t"; A"Ocaml library"; A"-man-mini"; atomize stdlib_mlis])] + A"-t"; A"OCaml library"; A"-man-mini"; atomize stdlib_mlis])] end;; flag ["ocaml"; "compile"; "bootstrap_thread"] @@ -643,7 +643,7 @@ rule "camlheader" rule "ocaml C stubs on windows: dlib & d.o* -> dll" ~prod:"%.dll" - ~deps:["%.dlib"(*; "byterun/ocamlrun"-.-C.a*)] + ~deps:["%.dlib"(*; "byterun/libcamlrun"-.-C.a*)] ~insert:`top begin fun env build -> let dlib = env "%.dlib" in @@ -659,7 +659,7 @@ rule "ocaml C stubs on windows: dlib & d.o* -> dll" | Outcome.Good d_o -> d_o | Outcome.Bad exn -> raise exn end resluts in - mkdll dll (S[atomize objs; P("byterun/ocamlrun"-.-C.a)]) + mkdll dll (S[atomize objs; P("byterun/libcamlrun"-.-C.a)]) (T(tags_of_pathname dll++"dll"++"link"++"c")) end;; diff --git a/myocamlbuild_config.mli b/myocamlbuild_config.mli index ce82607f6..28b226177 100644 --- a/myocamlbuild_config.mli +++ b/myocamlbuild_config.mli @@ -53,6 +53,7 @@ val ext_asm : string val ext_dll : string val o : string val a : string +val so : string val toolchain : string val ccomptype : string val extralibs : string diff --git a/ocamlbuild/_tags b/ocamlbuild/_tags index 215d11275..d0d8028ae 100644 --- a/ocamlbuild/_tags +++ b/ocamlbuild/_tags @@ -1,6 +1,6 @@ # OCamlbuild tags file true: debug -<*.ml> or <*.mli>: warn_A, warn_error_A, warn_e, dtypes +<*.ml> or <*.mli>: warn_A, warn_error_A, warn_e, annot "discard_printf.ml": rectypes "ocamlbuildlib.cma" or "ocamlbuildlightlib.cma": linkall <*.byte> or <*.native> or <*.top>: use_unix diff --git a/ocamlbuild/command.ml b/ocamlbuild/command.ml index 40f4022a9..2653116ec 100644 --- a/ocamlbuild/command.ml +++ b/ocamlbuild/command.ml @@ -278,7 +278,7 @@ let execute_many ?(quiet=false) ?(pretend=false) cmds = | Some _ -> false :: acc_res, acc_exn end ([], None) konts in match opt_exn with - | Some(exn) -> Some(res, exn) + | Some(exn) -> Some(List.rev res, exn) | None -> None else My_unix.execute_many ~ticker ?max_jobs ~display konts diff --git a/ocamlbuild/ocaml_specific.ml b/ocamlbuild/ocaml_specific.ml index fe5f48273..f37f52cac 100644 --- a/ocamlbuild/ocaml_specific.ml +++ b/ocamlbuild/ocaml_specific.ml @@ -305,7 +305,8 @@ rule "ocaml C stubs: c -> o" begin fun env _build -> let c = env "%.c" in let o = env x_o in - let cc = Cmd(S[!Options.ocamlc; T(tags_of_pathname c++"c"++"compile"); A"-c"; Px c]) in + let comp = if Tags.mem "native" (tags_of_pathname c) then !Options.ocamlopt else !Options.ocamlc in + let cc = Cmd(S[comp; T(tags_of_pathname c++"c"++"compile"); A"-c"; Px c]) in if Pathname.dirname o = Pathname.current_dir_name then cc else Seq[cc; mv (Pathname.basename o) o] end;; @@ -416,6 +417,8 @@ flag ["ocaml"; "compile"; "thread"] (A "-thread");; flag ["ocaml"; "doc"; "thread"] (S[A"-I"; A"+threads"]);; flag ["ocaml"; "link"; "thread"; "native"; "program"] (S[A "threads.cmxa"; A "-thread"]);; flag ["ocaml"; "link"; "thread"; "byte"; "program"] (S[A "threads.cma"; A "-thread"]);; +flag ["ocaml"; "link"; "thread"; "native"; "toplevel"] (S[A "threads.cmxa"; A "-thread"]);; +flag ["ocaml"; "link"; "thread"; "byte"; "toplevel"] (S[A "threads.cma"; A "-thread"]);; flag ["ocaml"; "compile"; "nopervasives"] (A"-nopervasives");; flag ["ocaml"; "compile"; "nolabels"] (A"-nolabels");; diff --git a/ocamlbuild/ocaml_utils.ml b/ocamlbuild/ocaml_utils.ml index d42c884b7..bbfe60e31 100644 --- a/ocamlbuild/ocaml_utils.ml +++ b/ocamlbuild/ocaml_utils.ml @@ -123,7 +123,10 @@ let ocaml_lib ?(extern=false) ?(byte=true) ?(native=true) ?dir ?tag_name libpath end; match dir with | None -> () - | Some dir -> flag ["ocaml"; tag_name; "compile"] (S[A"-I"; P dir]) + | Some dir -> + List.iter + (fun x -> flag ["ocaml"; tag_name; x] (S[A"-I"; P dir])) + ["compile"; "doc"; "infer_interface"] let cmi_of = Pathname.update_extensions "cmi" diff --git a/ocamlbuild/ocamlbuild-presentation.rslide b/ocamlbuild/ocamlbuild-presentation.rslide index 7fdec39f9..30ba657b3 100644 --- a/ocamlbuild/ocamlbuild-presentation.rslide +++ b/ocamlbuild/ocamlbuild-presentation.rslide @@ -166,7 +166,7 @@ slide "The tags, our way to specify exceptions", 'fragile=singleslide' do end code_tags do : "funny.ml": rectypes - ~<**/*.ml*>~: warn_A, warn_error_A, debug, dtypes + ~<**/*.ml*>~: warn_A, warn_error_A, debug, annot "foo.ml" or "bar.ml": warn_v, warn_error_v "vendor.ml": -warn_A, -warn_error_A <main.{byte,native}>: use_unix diff --git a/ocamlbuild/ocamlbuild_plugin.ml b/ocamlbuild/ocamlbuild_plugin.ml index 930ba17c2..2aadca173 100644 --- a/ocamlbuild/ocamlbuild_plugin.ml +++ b/ocamlbuild/ocamlbuild_plugin.ml @@ -31,6 +31,7 @@ type env = Pathname.t -> Pathname.t type builder = Pathname.t list list -> (Pathname.t, exn) Ocamlbuild_pack.My_std.Outcome.t list type action = env -> builder -> Command.t let rule = Rule.rule +let clear_rules = Rule.clear_rules let dep = Command.dep let copy_rule = Rule.copy_rule let ocaml_lib = Ocamlbuild_pack.Ocaml_utils.ocaml_lib diff --git a/ocamlbuild/ocamlbuild_unix_plugin.ml b/ocamlbuild/ocamlbuild_unix_plugin.ml index 1e4efff4f..c562d4288 100644 --- a/ocamlbuild/ocamlbuild_unix_plugin.ml +++ b/ocamlbuild/ocamlbuild_unix_plugin.ml @@ -61,6 +61,7 @@ let stdout_isatty () = Unix.isatty Unix.stdout let execute_many = + let exit i = raise (My_std.Exit_with_code i) in let exit = function | Ocamlbuild_executor.Subcommand_failed -> exit Exit_codes.rc_executor_subcommand_failed | Ocamlbuild_executor.Subcommand_got_signal -> exit Exit_codes.rc_executor_subcommand_got_signal diff --git a/ocamlbuild/options.ml b/ocamlbuild/options.ml index 7e9bd5b37..11839c61f 100644 --- a/ocamlbuild/options.ml +++ b/ocamlbuild/options.ml @@ -76,9 +76,10 @@ let program_to_execute = ref false let must_clean = ref false let show_documentation = ref false let recursive = ref false -let ext_lib = ref "a" -let ext_obj = ref "o" -let ext_dll = ref "so" +let ext_lib = ref Ocamlbuild_Myocamlbuild_config.a +let ext_obj = ref Ocamlbuild_Myocamlbuild_config.o +let ext_dll = ref Ocamlbuild_Myocamlbuild_config.so +let exe = ref Ocamlbuild_Myocamlbuild_config.exe let targets_internal = ref [] let ocaml_libs_internal = ref [] diff --git a/ocamlbuild/plugin.ml b/ocamlbuild/plugin.ml index b85e849eb..0786b4799 100644 --- a/ocamlbuild/plugin.ml +++ b/ocamlbuild/plugin.ml @@ -30,7 +30,7 @@ module Make(U:sig end) = let we_have_a_config_file = sys_file_exists plugin_config_file let we_need_a_plugin = !Options.plugin && sys_file_exists plugin_file - let we_have_a_plugin = sys_file_exists (!Options.build_dir/plugin) + let we_have_a_plugin = sys_file_exists ((!Options.build_dir/plugin)^(!Options.exe)) let we_have_a_config_file_interface = sys_file_exists plugin_config_file_interface let up_to_date_or_copy fn = @@ -56,6 +56,12 @@ module Make(U:sig end) = () (* Up to date *) (* FIXME: remove ocamlbuild_config.ml in _build/ if removed in parent *) else begin + if !Options.native_plugin + && not (sys_file_exists ((!Ocamlbuild_where.libdir)/"ocamlbuildlib.cmxa")) then + begin + Options.native_plugin := false; + eprintf "Warning: Won't be able to compile a native plugin" + end; let plugin_config = if we_have_a_config_file then if we_have_a_config_file_interface then @@ -83,10 +89,10 @@ module Make(U:sig end) = let cmd = Cmd(S[compiler; A"-I"; P dir; libs; more_options; P(dir/ocamlbuildlib); plugin_config; P plugin_file; - P(dir/ocamlbuild); A"-o"; Px plugin]) + P(dir/ocamlbuild); A"-o"; Px (plugin^(!Options.exe))]) in Shell.chdir !Options.build_dir; - Shell.rm_f plugin; + Shell.rm_f (plugin^(!Options.exe)); Command.execute cmd end @@ -96,7 +102,8 @@ module Make(U:sig end) = rebuild_plugin_if_needed (); Shell.chdir Pathname.pwd; if not !Options.just_plugin then - let spec = S[!Options.ocamlrun; P(!Options.build_dir/plugin); + let runner = if !Options.native_plugin then N else !Options.ocamlrun in + let spec = S[runner; P(!Options.build_dir/plugin^(!Options.exe)); A"-no-plugin"; atomize (List.tl (Array.to_list Sys.argv))] in let () = Log.finish () in raise (Exit_silently_with_code (sys_command (Command.string_of_command_spec spec))) diff --git a/ocamlbuild/rule.ml b/ocamlbuild/rule.ml index bf217e7d5..ac0f0c8bd 100644 --- a/ocamlbuild/rule.ml +++ b/ocamlbuild/rule.ml @@ -227,7 +227,7 @@ let call builder r = then thunk () else List.iter (fun x -> Resource.Cache.suspend_resource x action.command thunk r.prods) r.prods -let (get_rules, add_rule) = +let (get_rules, add_rule, clear_rules) = let rules = ref [] in (fun () -> !rules), begin fun pos r -> @@ -248,7 +248,8 @@ let (get_rules, add_rule) = List.fold_right begin fun x acc -> if x.name = s then r :: x :: acc else x :: acc end !rules [] - end + end, + (fun () -> rules := []) let rule name ?(tags=[]) ?(prods=[]) ?(deps=[]) ?prod ?dep ?stamp ?(insert = `bottom) code = let res_add import xs xopt = diff --git a/ocamlbuild/rule.mli b/ocamlbuild/rule.mli index 9be718e2b..16af0f6fe 100644 --- a/ocamlbuild/rule.mli +++ b/ocamlbuild/rule.mli @@ -73,6 +73,7 @@ val print_rule_name : Format.formatter -> 'a gen_rule -> unit val print_rule_contents : 'a rule_printer val get_rules : unit -> rule_scheme list +val clear_rules : unit -> unit val call : builder -> rule -> unit diff --git a/ocamlbuild/signatures.mli b/ocamlbuild/signatures.mli index 4304d749f..40923b699 100644 --- a/ocamlbuild/signatures.mli +++ b/ocamlbuild/signatures.mli @@ -397,6 +397,7 @@ module type OPTIONS = sig val ext_obj : string ref val ext_lib : string ref val ext_dll : string ref + val exe : string ref end module type ARCH = sig @@ -520,6 +521,9 @@ module type PLUGIN = sig ?insert:[`top | `before of string | `after of string | `bottom] -> string -> string -> unit + (** Empties the list of rules of the ocamlbuild engine. *) + val clear_rules : unit -> unit + (** [dep tags deps] Will build [deps] when all [tags] will be activated. *) val dep : Tags.elt list -> Pathname.t list -> unit diff --git a/ocamldoc/.cvsignore b/ocamldoc/.cvsignore index 720ee641a..0372a0982 100644 --- a/ocamldoc/.cvsignore +++ b/ocamldoc/.cvsignore @@ -14,3 +14,4 @@ stdlib_man test_stdlib test_latex test +*.a diff --git a/ocamldoc/.depend b/ocamldoc/.depend index afd704066..b0aba86c7 100644 --- a/ocamldoc/.depend +++ b/ocamldoc/.depend @@ -1,11 +1,11 @@ odoc.cmo: ../typing/typedtree.cmi odoc_texi.cmo odoc_messages.cmo \ odoc_man.cmo odoc_latex.cmo odoc_info.cmi odoc_html.cmo odoc_global.cmi \ odoc_dot.cmo odoc_config.cmi odoc_args.cmi odoc_analyse.cmi \ - ../utils/misc.cmi ../utils/config.cmi ../utils/clflags.cmi + ../utils/misc.cmi ../utils/config.cmi ../utils/clflags.cmi odoc.cmx: ../typing/typedtree.cmx odoc_texi.cmx odoc_messages.cmx \ odoc_man.cmx odoc_latex.cmx odoc_info.cmx odoc_html.cmx odoc_global.cmx \ odoc_dot.cmx odoc_config.cmx odoc_args.cmx odoc_analyse.cmx \ - ../utils/misc.cmx ../utils/config.cmx ../utils/clflags.cmx + ../utils/misc.cmx ../utils/config.cmx ../utils/clflags.cmx odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ ../typing/types.cmi ../typing/typemod.cmi ../typing/typedtree.cmi \ ../typing/typedecl.cmi ../typing/typecore.cmi ../typing/typeclass.cmi \ @@ -17,7 +17,7 @@ odoc_analyse.cmo: ../utils/warnings.cmi ../typing/typetexp.cmi \ odoc_args.cmi ../utils/misc.cmi ../parsing/location.cmi \ ../parsing/lexer.cmi ../typing/includemod.cmi ../typing/env.cmi \ ../typing/ctype.cmi ../utils/config.cmi ../utils/clflags.cmi \ - ../utils/ccomp.cmi odoc_analyse.cmi + ../utils/ccomp.cmi odoc_analyse.cmi odoc_analyse.cmx: ../utils/warnings.cmx ../typing/typetexp.cmx \ ../typing/types.cmx ../typing/typemod.cmx ../typing/typedtree.cmx \ ../typing/typedecl.cmx ../typing/typecore.cmx ../typing/typeclass.cmx \ @@ -29,215 +29,215 @@ odoc_analyse.cmx: ../utils/warnings.cmx ../typing/typetexp.cmx \ odoc_args.cmx ../utils/misc.cmx ../parsing/location.cmx \ ../parsing/lexer.cmx ../typing/includemod.cmx ../typing/env.cmx \ ../typing/ctype.cmx ../utils/config.cmx ../utils/clflags.cmx \ - ../utils/ccomp.cmx odoc_analyse.cmi + ../utils/ccomp.cmx odoc_analyse.cmi odoc_args.cmo: odoc_types.cmi odoc_module.cmo odoc_messages.cmo \ odoc_global.cmi odoc_config.cmi ../utils/misc.cmi ../utils/config.cmi \ - ../utils/clflags.cmi odoc_args.cmi + ../utils/clflags.cmi odoc_args.cmi odoc_args.cmx: odoc_types.cmx odoc_module.cmx odoc_messages.cmx \ odoc_global.cmx odoc_config.cmx ../utils/misc.cmx ../utils/config.cmx \ - ../utils/clflags.cmx odoc_args.cmi + ../utils/clflags.cmx odoc_args.cmi odoc_ast.cmo: ../typing/types.cmi ../typing/typedtree.cmi \ ../typing/predef.cmi ../typing/path.cmi ../parsing/parsetree.cmi \ odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_sig.cmi \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ odoc_global.cmi odoc_exception.cmo odoc_env.cmi odoc_class.cmo \ odoc_args.cmi ../utils/misc.cmi ../parsing/location.cmi \ - ../typing/ident.cmi ../parsing/asttypes.cmi odoc_ast.cmi + ../typing/ident.cmi ../parsing/asttypes.cmi odoc_ast.cmi odoc_ast.cmx: ../typing/types.cmx ../typing/typedtree.cmx \ ../typing/predef.cmx ../typing/path.cmx ../parsing/parsetree.cmi \ odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_sig.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \ odoc_global.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \ odoc_args.cmx ../utils/misc.cmx ../parsing/location.cmx \ - ../typing/ident.cmx ../parsing/asttypes.cmi odoc_ast.cmi + ../typing/ident.cmx ../parsing/asttypes.cmi odoc_ast.cmi odoc_class.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ - odoc_parameter.cmo odoc_name.cmi + odoc_parameter.cmo odoc_name.cmi odoc_class.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ - odoc_parameter.cmx odoc_name.cmx + odoc_parameter.cmx odoc_name.cmx odoc_comments.cmo: odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \ odoc_parser.cmi odoc_misc.cmi odoc_messages.cmo odoc_lexer.cmo \ - odoc_global.cmi odoc_cross.cmi odoc_comments_global.cmi odoc_comments.cmi + odoc_global.cmi odoc_cross.cmi odoc_comments_global.cmi odoc_comments.cmi odoc_comments.cmx: odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \ odoc_parser.cmx odoc_misc.cmx odoc_messages.cmx odoc_lexer.cmx \ - odoc_global.cmx odoc_cross.cmx odoc_comments_global.cmx odoc_comments.cmi -odoc_comments_global.cmo: odoc_comments_global.cmi -odoc_comments_global.cmx: odoc_comments_global.cmi -odoc_config.cmo: ../utils/config.cmi odoc_config.cmi -odoc_config.cmx: ../utils/config.cmx odoc_config.cmi -odoc_control.cmo: -odoc_control.cmx: + odoc_global.cmx odoc_cross.cmx odoc_comments_global.cmx odoc_comments.cmi +odoc_comments_global.cmo: odoc_comments_global.cmi +odoc_comments_global.cmx: odoc_comments_global.cmi +odoc_config.cmo: ../utils/config.cmi odoc_config.cmi +odoc_config.cmx: ../utils/config.cmx odoc_config.cmi +odoc_control.cmo: +odoc_control.cmx: odoc_cross.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_search.cmi \ odoc_scan.cmo odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ odoc_misc.cmi odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \ - odoc_cross.cmi + odoc_cross.cmi odoc_cross.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_search.cmx \ odoc_scan.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ odoc_misc.cmx odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \ - odoc_cross.cmi -odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi -odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi + odoc_cross.cmi +odoc_dag2html.cmo: odoc_info.cmi odoc_dag2html.cmi +odoc_dag2html.cmx: odoc_info.cmx odoc_dag2html.cmi odoc_dep.cmo: ../parsing/parsetree.cmi odoc_type.cmo odoc_print.cmi \ - odoc_module.cmo ../tools/depend.cmi + odoc_module.cmo ../tools/depend.cmi odoc_dep.cmx: ../parsing/parsetree.cmi odoc_type.cmx odoc_print.cmx \ - odoc_module.cmx ../tools/depend.cmx -odoc_dot.cmo: odoc_info.cmi -odoc_dot.cmx: odoc_info.cmx + odoc_module.cmx ../tools/depend.cmx +odoc_dot.cmo: odoc_info.cmi +odoc_dot.cmx: odoc_info.cmx odoc_env.cmo: ../typing/types.cmi ../typing/printtyp.cmi ../typing/predef.cmi \ - ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi odoc_env.cmi + ../typing/path.cmi odoc_name.cmi ../typing/btype.cmi odoc_env.cmi odoc_env.cmx: ../typing/types.cmx ../typing/printtyp.cmx ../typing/predef.cmx \ - ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx odoc_env.cmi -odoc_exception.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi -odoc_exception.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx -odoc_global.cmo: ../utils/clflags.cmi odoc_global.cmi -odoc_global.cmx: ../utils/clflags.cmx odoc_global.cmi + ../typing/path.cmx odoc_name.cmx ../typing/btype.cmx odoc_env.cmi +odoc_exception.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi +odoc_exception.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx +odoc_global.cmo: ../utils/clflags.cmi odoc_global.cmi +odoc_global.cmx: ../utils/clflags.cmx odoc_global.cmi odoc_html.cmo: odoc_text.cmi odoc_ocamlhtml.cmo odoc_messages.cmo \ - odoc_info.cmi odoc_dag2html.cmi odoc_args.cmi ../parsing/asttypes.cmi + odoc_info.cmi odoc_dag2html.cmi odoc_args.cmi ../parsing/asttypes.cmi odoc_html.cmx: odoc_text.cmx odoc_ocamlhtml.cmx odoc_messages.cmx \ - odoc_info.cmx odoc_dag2html.cmx odoc_args.cmx ../parsing/asttypes.cmi + odoc_info.cmx odoc_dag2html.cmx odoc_args.cmx ../parsing/asttypes.cmi odoc_info.cmo: ../typing/printtyp.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_text.cmi odoc_str.cmi odoc_search.cmi odoc_scan.cmo \ odoc_print.cmi odoc_parameter.cmo odoc_name.cmi odoc_module.cmo \ odoc_misc.cmi odoc_messages.cmo odoc_global.cmi odoc_exception.cmo \ odoc_dep.cmo odoc_config.cmi odoc_comments.cmi odoc_class.cmo \ - odoc_args.cmi odoc_analyse.cmi odoc_info.cmi + odoc_args.cmi odoc_analyse.cmi odoc_info.cmi odoc_info.cmx: ../typing/printtyp.cmx odoc_value.cmx odoc_types.cmx \ odoc_type.cmx odoc_text.cmx odoc_str.cmx odoc_search.cmx odoc_scan.cmx \ odoc_print.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \ odoc_misc.cmx odoc_messages.cmx odoc_global.cmx odoc_exception.cmx \ odoc_dep.cmx odoc_config.cmx odoc_comments.cmx odoc_class.cmx \ - odoc_args.cmx odoc_analyse.cmx odoc_info.cmi -odoc_inherit.cmo: -odoc_inherit.cmx: + odoc_args.cmx odoc_analyse.cmx odoc_info.cmi +odoc_inherit.cmo: +odoc_inherit.cmx: odoc_latex.cmo: odoc_to_text.cmo odoc_messages.cmo odoc_latex_style.cmo \ - odoc_info.cmi ../parsing/asttypes.cmi + odoc_info.cmi ../parsing/asttypes.cmi odoc_latex.cmx: odoc_to_text.cmx odoc_messages.cmx odoc_latex_style.cmx \ - odoc_info.cmx ../parsing/asttypes.cmi -odoc_latex_style.cmo: -odoc_latex_style.cmx: + odoc_info.cmx ../parsing/asttypes.cmi +odoc_latex_style.cmo: +odoc_latex_style.cmx: odoc_lexer.cmo: odoc_parser.cmi odoc_messages.cmo odoc_comments_global.cmi \ - odoc_args.cmi + odoc_args.cmi odoc_lexer.cmx: odoc_parser.cmx odoc_messages.cmx odoc_comments_global.cmx \ - odoc_args.cmx + odoc_args.cmx odoc_man.cmo: odoc_str.cmi odoc_print.cmi odoc_misc.cmi odoc_messages.cmo \ - odoc_info.cmi odoc_args.cmi ../parsing/asttypes.cmi + odoc_info.cmi odoc_args.cmi ../parsing/asttypes.cmi odoc_man.cmx: odoc_str.cmx odoc_print.cmx odoc_misc.cmx odoc_messages.cmx \ - odoc_info.cmx odoc_args.cmx ../parsing/asttypes.cmi + odoc_info.cmx odoc_args.cmx ../parsing/asttypes.cmi odoc_merge.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_messages.cmo \ - odoc_exception.cmo odoc_class.cmo odoc_args.cmi odoc_merge.cmi + odoc_exception.cmo odoc_class.cmo odoc_args.cmi odoc_merge.cmi odoc_merge.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_messages.cmx \ - odoc_exception.cmx odoc_class.cmx odoc_args.cmx odoc_merge.cmi -odoc_messages.cmo: odoc_global.cmi odoc_config.cmi ../utils/config.cmi -odoc_messages.cmx: odoc_global.cmx odoc_config.cmx ../utils/config.cmx + odoc_exception.cmx odoc_class.cmx odoc_args.cmx odoc_merge.cmi +odoc_messages.cmo: odoc_global.cmi odoc_config.cmi ../utils/config.cmi +odoc_messages.cmx: odoc_global.cmx odoc_config.cmx ../utils/config.cmx odoc_misc.cmo: ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \ odoc_types.cmi odoc_messages.cmo ../parsing/longident.cmi \ - ../typing/ctype.cmi ../typing/btype.cmi odoc_misc.cmi + ../typing/ctype.cmi ../typing/btype.cmi odoc_misc.cmi odoc_misc.cmx: ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \ odoc_types.cmx odoc_messages.cmx ../parsing/longident.cmx \ - ../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi + ../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi odoc_module.cmo: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ - odoc_type.cmo odoc_name.cmi odoc_exception.cmo odoc_class.cmo + odoc_type.cmo odoc_name.cmi odoc_exception.cmo odoc_class.cmo odoc_module.cmx: ../typing/types.cmx odoc_value.cmx odoc_types.cmx \ - odoc_type.cmx odoc_name.cmx odoc_exception.cmx odoc_class.cmx + odoc_type.cmx odoc_name.cmx odoc_exception.cmx odoc_class.cmx odoc_name.cmo: ../typing/path.cmi odoc_misc.cmi ../typing/ident.cmi \ - odoc_name.cmi + odoc_name.cmi odoc_name.cmx: ../typing/path.cmx odoc_misc.cmx ../typing/ident.cmx \ - odoc_name.cmi -odoc_ocamlhtml.cmo: -odoc_ocamlhtml.cmx: -odoc_parameter.cmo: ../typing/types.cmi odoc_types.cmi -odoc_parameter.cmx: ../typing/types.cmx odoc_types.cmx -odoc_parser.cmo: odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi -odoc_parser.cmx: odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi -odoc_print.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi -odoc_print.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi + odoc_name.cmi +odoc_ocamlhtml.cmo: +odoc_ocamlhtml.cmx: +odoc_parameter.cmo: ../typing/types.cmi odoc_types.cmi +odoc_parameter.cmx: ../typing/types.cmx odoc_types.cmx +odoc_parser.cmo: odoc_types.cmi odoc_comments_global.cmi odoc_parser.cmi +odoc_parser.cmx: odoc_types.cmx odoc_comments_global.cmx odoc_parser.cmi +odoc_print.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_print.cmi +odoc_print.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_print.cmi odoc_scan.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ - odoc_exception.cmo odoc_class.cmo + odoc_exception.cmo odoc_class.cmo odoc_scan.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx odoc_module.cmx \ - odoc_exception.cmx odoc_class.cmx + odoc_exception.cmx odoc_class.cmx odoc_search.cmo: odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_exception.cmo \ - odoc_class.cmo odoc_search.cmi + odoc_class.cmo odoc_search.cmi odoc_search.cmx: odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_exception.cmx \ - odoc_class.cmx odoc_search.cmi -odoc_see_lexer.cmo: odoc_parser.cmi -odoc_see_lexer.cmx: odoc_parser.cmx + odoc_class.cmx odoc_search.cmi +odoc_see_lexer.cmo: odoc_parser.cmi +odoc_see_lexer.cmx: odoc_parser.cmx odoc_sig.cmo: ../typing/types.cmi ../typing/typedtree.cmi ../typing/path.cmi \ ../parsing/parsetree.cmi odoc_value.cmo odoc_types.cmi odoc_type.cmo \ odoc_parameter.cmo odoc_name.cmi odoc_module.cmo odoc_misc.cmi \ odoc_messages.cmo odoc_merge.cmi odoc_global.cmi odoc_exception.cmo \ odoc_env.cmi odoc_class.cmo odoc_args.cmi ../utils/misc.cmi \ ../parsing/location.cmi ../typing/btype.cmi ../parsing/asttypes.cmi \ - odoc_sig.cmi + odoc_sig.cmi odoc_sig.cmx: ../typing/types.cmx ../typing/typedtree.cmx ../typing/path.cmx \ ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx odoc_type.cmx \ odoc_parameter.cmx odoc_name.cmx odoc_module.cmx odoc_misc.cmx \ odoc_messages.cmx odoc_merge.cmx odoc_global.cmx odoc_exception.cmx \ odoc_env.cmx odoc_class.cmx odoc_args.cmx ../utils/misc.cmx \ ../parsing/location.cmx ../typing/btype.cmx ../parsing/asttypes.cmi \ - odoc_sig.cmi + odoc_sig.cmi odoc_str.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \ odoc_type.cmo odoc_print.cmi odoc_name.cmi odoc_misc.cmi \ odoc_messages.cmo odoc_exception.cmo odoc_class.cmo \ - ../parsing/asttypes.cmi odoc_str.cmi + ../parsing/asttypes.cmi odoc_str.cmi odoc_str.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_value.cmx \ odoc_type.cmx odoc_print.cmx odoc_name.cmx odoc_misc.cmx \ odoc_messages.cmx odoc_exception.cmx odoc_class.cmx \ - ../parsing/asttypes.cmi odoc_str.cmi -odoc_test.cmo: odoc_info.cmi -odoc_test.cmx: odoc_info.cmx + ../parsing/asttypes.cmi odoc_str.cmi +odoc_test.cmo: odoc_info.cmi +odoc_test.cmx: odoc_info.cmx odoc_texi.cmo: odoc_to_text.cmo odoc_messages.cmo odoc_info.cmi \ - ../parsing/asttypes.cmi + ../parsing/asttypes.cmi odoc_texi.cmx: odoc_to_text.cmx odoc_messages.cmx odoc_info.cmx \ - ../parsing/asttypes.cmi + ../parsing/asttypes.cmi odoc_text.cmo: odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \ - odoc_text.cmi + odoc_text.cmi odoc_text.cmx: odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \ - odoc_text.cmi -odoc_text_lexer.cmo: odoc_text_parser.cmi odoc_misc.cmi -odoc_text_lexer.cmx: odoc_text_parser.cmx odoc_misc.cmx -odoc_text_parser.cmo: odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi -odoc_text_parser.cmx: odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi -odoc_to_text.cmo: odoc_messages.cmo odoc_info.cmi -odoc_to_text.cmx: odoc_messages.cmx odoc_info.cmx + odoc_text.cmi +odoc_text_lexer.cmo: odoc_text_parser.cmi odoc_misc.cmi +odoc_text_lexer.cmx: odoc_text_parser.cmx odoc_misc.cmx +odoc_text_parser.cmo: odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi +odoc_text_parser.cmx: odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi +odoc_to_text.cmo: odoc_messages.cmo odoc_info.cmi +odoc_to_text.cmx: odoc_messages.cmx odoc_info.cmx odoc_type.cmo: ../typing/types.cmi odoc_types.cmi odoc_name.cmi \ - ../parsing/asttypes.cmi + ../parsing/asttypes.cmi odoc_type.cmx: ../typing/types.cmx odoc_types.cmx odoc_name.cmx \ - ../parsing/asttypes.cmi -odoc_types.cmo: odoc_messages.cmo odoc_types.cmi -odoc_types.cmx: odoc_messages.cmx odoc_types.cmi + ../parsing/asttypes.cmi +odoc_types.cmo: odoc_messages.cmo odoc_types.cmi +odoc_types.cmx: odoc_messages.cmx odoc_types.cmi odoc_value.cmo: ../typing/types.cmi ../typing/printtyp.cmi odoc_types.cmi \ - odoc_parameter.cmo odoc_name.cmi + odoc_parameter.cmo odoc_name.cmi odoc_value.cmx: ../typing/types.cmx ../typing/printtyp.cmx odoc_types.cmx \ - odoc_parameter.cmx odoc_name.cmx -odoc_analyse.cmi: odoc_module.cmo odoc_args.cmi -odoc_args.cmi: odoc_types.cmi odoc_module.cmo + odoc_parameter.cmx odoc_name.cmx +odoc_analyse.cmi: odoc_module.cmo odoc_args.cmi +odoc_args.cmi: odoc_types.cmi odoc_module.cmo odoc_ast.cmi: ../typing/types.cmi ../typing/typedtree.cmi ../typing/path.cmi \ - ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo -odoc_comments.cmi: odoc_types.cmi odoc_module.cmo -odoc_comments_global.cmi: -odoc_config.cmi: -odoc_cross.cmi: odoc_types.cmi odoc_module.cmo -odoc_dag2html.cmi: odoc_info.cmi -odoc_env.cmi: ../typing/types.cmi odoc_name.cmi -odoc_global.cmi: + ../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo +odoc_comments.cmi: odoc_types.cmi odoc_module.cmo +odoc_comments_global.cmi: +odoc_config.cmi: +odoc_cross.cmi: odoc_types.cmi odoc_module.cmo +odoc_dag2html.cmi: odoc_info.cmi +odoc_env.cmi: ../typing/types.cmi odoc_name.cmi +odoc_global.cmi: odoc_info.cmi: ../typing/types.cmi odoc_value.cmo odoc_types.cmi \ odoc_type.cmo odoc_search.cmi odoc_parameter.cmo odoc_module.cmo \ - odoc_exception.cmo odoc_class.cmo ../parsing/asttypes.cmi -odoc_merge.cmi: odoc_types.cmi odoc_module.cmo -odoc_misc.cmi: ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi + odoc_exception.cmo odoc_class.cmo +odoc_merge.cmi: odoc_types.cmi odoc_module.cmo +odoc_misc.cmi: ../typing/types.cmi odoc_types.cmi ../parsing/longident.cmi odoc_name.cmi: ../typing/path.cmi ../parsing/longident.cmi \ - ../typing/ident.cmi -odoc_parser.cmi: odoc_types.cmi -odoc_print.cmi: ../typing/types.cmi + ../typing/ident.cmi +odoc_parser.cmi: odoc_types.cmi +odoc_print.cmi: ../typing/types.cmi odoc_search.cmi: odoc_value.cmo odoc_types.cmi odoc_type.cmo odoc_module.cmo \ - odoc_exception.cmo odoc_class.cmo + odoc_exception.cmo odoc_class.cmo odoc_sig.cmi: ../typing/types.cmi ../parsing/parsetree.cmi odoc_types.cmi \ - odoc_type.cmo odoc_name.cmi odoc_module.cmo odoc_env.cmi odoc_class.cmo + odoc_type.cmo odoc_name.cmi odoc_module.cmo odoc_env.cmi odoc_class.cmo odoc_str.cmi: ../typing/types.cmi odoc_value.cmo odoc_type.cmo \ - odoc_exception.cmo odoc_class.cmo -odoc_text.cmi: odoc_types.cmi -odoc_text_parser.cmi: odoc_types.cmi -odoc_types.cmi: + odoc_exception.cmo odoc_class.cmo +odoc_text.cmi: odoc_types.cmi +odoc_text_parser.cmi: odoc_types.cmi +odoc_types.cmi: diff --git a/ocamldoc/odoc.ml b/ocamldoc/odoc.ml index cdaf451ef..44bf366e6 100644 --- a/ocamldoc/odoc.ml +++ b/ocamldoc/odoc.ml @@ -81,11 +81,11 @@ let _ = prerr_endline (Odoc_messages.load_file_error file "Not_found"); exit 1 | Sys_error s - | Failure s -> + | Failure s -> prerr_endline (Odoc_messages.load_file_error file s); exit 1 -let _ = print_DEBUG "Fin du chargement dynamique éventuel" +let _ = print_DEBUG "Fin du chargement dynamique eventuel" let default_html_generator = new Odoc_html.html let default_latex_generator = new Odoc_latex.latex diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index ec10277a1..57143d0d5 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -332,7 +332,7 @@ module Analyser = in (new_param, func_body2) | _ -> - print_DEBUG3 "Pas le bon filtre pour le paramètre optionnel avec valeur par défaut."; + print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut."; (parameter, func_body) ) ) @@ -477,7 +477,7 @@ module Analyser = in (new_param, body2) | _ -> - print_DEBUG3 "Pas le bon filtre pour le paramètre optionnel avec valeur par défaut."; + print_DEBUG3 "Pas le bon filtre pour le parametre optionnel avec valeur par defaut."; (parameter, body) ) ) diff --git a/ocamldoc/remove_DEBUG b/ocamldoc/remove_DEBUG index 7233afbac..78b11e612 100755 --- a/ocamldoc/remove_DEBUG +++ b/ocamldoc/remove_DEBUG @@ -18,4 +18,5 @@ # respecting the cpp # line annotation conventions echo "# 1 \"$1\"" -LC_ALL=C sed -e '/DEBUG/s/.*//' "$1" +LC_ALL=C sed -e '/DEBUG/c\ +(* DEBUG statement removed *)' "$1" diff --git a/otherlibs/bigarray/.cvsignore b/otherlibs/bigarray/.cvsignore index c54b3a358..52db225e5 100644 --- a/otherlibs/bigarray/.cvsignore +++ b/otherlibs/bigarray/.cvsignore @@ -1,3 +1,5 @@ *.o *.x so_locations +*.so +*.a diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend index eb76fc5f3..11e339d33 100644 --- a/otherlibs/bigarray/.depend +++ b/otherlibs/bigarray/.depend @@ -27,6 +27,6 @@ mmap_win32.o: mmap_win32.c bigarray.h ../../byterun/config.h \ ../../byterun/mlvalues.h ../../byterun/fail.h ../../byterun/misc.h \ ../../byterun/mlvalues.h ../../byterun/sys.h ../../byterun/misc.h \ ../unix/unixsupport.h -bigarray.cmi: -bigarray.cmo: bigarray.cmi -bigarray.cmx: bigarray.cmi +bigarray.cmi: +bigarray.cmo: bigarray.cmi +bigarray.cmx: bigarray.cmi diff --git a/otherlibs/dbm/.cvsignore b/otherlibs/dbm/.cvsignore index 074dd28a4..29fea4726 100644 --- a/otherlibs/dbm/.cvsignore +++ b/otherlibs/dbm/.cvsignore @@ -1 +1,3 @@ so_locations +*.so +*.a diff --git a/otherlibs/dbm/.depend b/otherlibs/dbm/.depend index 2092fbac6..4e5750fa4 100644 --- a/otherlibs/dbm/.depend +++ b/otherlibs/dbm/.depend @@ -1,3 +1,3 @@ -dbm.cmi: -dbm.cmo: dbm.cmi -dbm.cmx: dbm.cmi +dbm.cmi: +dbm.cmo: dbm.cmi +dbm.cmx: dbm.cmi diff --git a/otherlibs/dynlink/.cvsignore b/otherlibs/dynlink/.cvsignore index 5ea9775e1..29b3102d1 100644 --- a/otherlibs/dynlink/.cvsignore +++ b/otherlibs/dynlink/.cvsignore @@ -1 +1,2 @@ extract_crc +*.a diff --git a/otherlibs/graph/.cvsignore b/otherlibs/graph/.cvsignore index 074dd28a4..29fea4726 100644 --- a/otherlibs/graph/.cvsignore +++ b/otherlibs/graph/.cvsignore @@ -1 +1,3 @@ so_locations +*.so +*.a diff --git a/otherlibs/graph/.depend b/otherlibs/graph/.depend index d89051536..31398124f 100644 --- a/otherlibs/graph/.depend +++ b/otherlibs/graph/.depend @@ -144,9 +144,9 @@ text.o: text.c libgraph.h \ ../../byterun/config.h ../../byterun/alloc.h \ ../../byterun/compatibility.h ../../byterun/misc.h \ ../../byterun/mlvalues.h -graphics.cmi: -graphicsX11.cmi: -graphics.cmo: graphics.cmi -graphics.cmx: graphics.cmi -graphicsX11.cmo: graphics.cmi graphicsX11.cmi -graphicsX11.cmx: graphics.cmx graphicsX11.cmi +graphics.cmi: +graphicsX11.cmi: +graphics.cmo: graphics.cmi +graphics.cmx: graphics.cmi +graphicsX11.cmo: graphics.cmi graphicsX11.cmi +graphicsX11.cmx: graphics.cmx graphicsX11.cmi diff --git a/otherlibs/labltk/frx/.cvsignore b/otherlibs/labltk/frx/.cvsignore new file mode 100644 index 000000000..10301e28b --- /dev/null +++ b/otherlibs/labltk/frx/.cvsignore @@ -0,0 +1 @@ +*.a diff --git a/otherlibs/labltk/jpf/.cvsignore b/otherlibs/labltk/jpf/.cvsignore new file mode 100644 index 000000000..10301e28b --- /dev/null +++ b/otherlibs/labltk/jpf/.cvsignore @@ -0,0 +1 @@ +*.a diff --git a/otherlibs/labltk/lib/.cvsignore b/otherlibs/labltk/lib/.cvsignore index 80df4415f..02d049a4c 100644 --- a/otherlibs/labltk/lib/.cvsignore +++ b/otherlibs/labltk/lib/.cvsignore @@ -5,4 +5,4 @@ labltktop labltk mltktop mltk modules labltk.cma labltk.cmxa - +*.a diff --git a/otherlibs/labltk/support/.cvsignore b/otherlibs/labltk/support/.cvsignore new file mode 100644 index 000000000..56d9c77a8 --- /dev/null +++ b/otherlibs/labltk/support/.cvsignore @@ -0,0 +1,2 @@ +*.so +*.a diff --git a/otherlibs/labltk/tkanim/.cvsignore b/otherlibs/labltk/tkanim/.cvsignore index e1c70145f..387840984 100644 --- a/otherlibs/labltk/tkanim/.cvsignore +++ b/otherlibs/labltk/tkanim/.cvsignore @@ -1,2 +1,4 @@ gifanimtest gifanimtest-static +*.so +*.a diff --git a/otherlibs/num/.cvsignore b/otherlibs/num/.cvsignore index 7786c62f9..02023cba9 100644 --- a/otherlibs/num/.cvsignore +++ b/otherlibs/num/.cvsignore @@ -1,3 +1,5 @@ libnums.x *.c.x so_locations +*.so +*.a diff --git a/otherlibs/num/.depend b/otherlibs/num/.depend index 51dcc1cfa..5530c4bc3 100644 --- a/otherlibs/num/.depend +++ b/otherlibs/num/.depend @@ -27,24 +27,24 @@ nat_stubs.o: nat_stubs.c ../../byterun/alloc.h \ ../../byterun/freelist.h ../../byterun/misc.h ../../byterun/mlvalues.h \ ../../byterun/misc.h ../../byterun/minor_gc.h ../../byterun/misc.h \ ../../byterun/misc.h ../../byterun/mlvalues.h bng.h nat.h -arith_flags.cmi: -arith_status.cmi: -big_int.cmi: nat.cmi -int_misc.cmi: -nat.cmi: -num.cmi: ratio.cmi nat.cmi big_int.cmi -ratio.cmi: nat.cmi big_int.cmi -arith_flags.cmo: arith_flags.cmi -arith_flags.cmx: arith_flags.cmi -arith_status.cmo: arith_flags.cmi arith_status.cmi -arith_status.cmx: arith_flags.cmx arith_status.cmi -big_int.cmo: nat.cmi int_misc.cmi big_int.cmi -big_int.cmx: nat.cmx int_misc.cmx big_int.cmi -int_misc.cmo: int_misc.cmi -int_misc.cmx: int_misc.cmi -nat.cmo: int_misc.cmi nat.cmi -nat.cmx: int_misc.cmx nat.cmi -num.cmo: ratio.cmi nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi num.cmi -num.cmx: ratio.cmx nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx num.cmi -ratio.cmo: nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi ratio.cmi -ratio.cmx: nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx ratio.cmi +arith_flags.cmi: +arith_status.cmi: +big_int.cmi: nat.cmi +int_misc.cmi: +nat.cmi: +num.cmi: ratio.cmi nat.cmi big_int.cmi +ratio.cmi: nat.cmi big_int.cmi +arith_flags.cmo: arith_flags.cmi +arith_flags.cmx: arith_flags.cmi +arith_status.cmo: arith_flags.cmi arith_status.cmi +arith_status.cmx: arith_flags.cmx arith_status.cmi +big_int.cmo: nat.cmi int_misc.cmi big_int.cmi +big_int.cmx: nat.cmx int_misc.cmx big_int.cmi +int_misc.cmo: int_misc.cmi +int_misc.cmx: int_misc.cmi +nat.cmo: int_misc.cmi nat.cmi +nat.cmx: int_misc.cmx nat.cmi +num.cmo: ratio.cmi nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi num.cmi +num.cmx: ratio.cmx nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx num.cmi +ratio.cmo: nat.cmi int_misc.cmi big_int.cmi arith_flags.cmi ratio.cmi +ratio.cmx: nat.cmx int_misc.cmx big_int.cmx arith_flags.cmx ratio.cmi diff --git a/otherlibs/num/nat_stubs.c b/otherlibs/num/nat_stubs.c index e41abff17..45f4521ca 100644 --- a/otherlibs/num/nat_stubs.c +++ b/otherlibs/num/nat_stubs.c @@ -368,14 +368,24 @@ static uintnat deserialize_nat(void * dst) #if defined(ARCH_SIXTYFOUR) && defined(ARCH_BIG_ENDIAN) { uint32 * p; mlsize_t i; - for (i = len, p = dst; i > 0; i -= 2, p += 2) { + for (i = len, p = dst; i > 1; i -= 2, p += 2) { p[1] = deserialize_uint_4(); /* low 32 bits of 64-bit digit */ p[0] = deserialize_uint_4(); /* high 32 bits of 64-bit digit */ } + if (i > 0){ + p[1] = deserialize_uint_4(); /* low 32 bits of 64-bit digit */ + p[0] = 0; /* high 32 bits of 64-bit digit */ + ++ len; + } } #else deserialize_block_4(dst, len); +#if defined(ARCH_SIXTYFOUR) + if (len & 1){ + ((uint32 *) dst)[len] = 0; + ++ len; + } +#endif #endif return len * 4; } - diff --git a/otherlibs/str/.cvsignore b/otherlibs/str/.cvsignore index a37b133d0..49c78e582 100644 --- a/otherlibs/str/.cvsignore +++ b/otherlibs/str/.cvsignore @@ -1,3 +1,5 @@ libstr.x *.c.x so_locations +*.so +*.a diff --git a/otherlibs/str/.depend b/otherlibs/str/.depend index bafddbd70..83d700985 100644 --- a/otherlibs/str/.depend +++ b/otherlibs/str/.depend @@ -12,6 +12,6 @@ strstubs.o: strstubs.c ../../byterun/mlvalues.h \ ../../byterun/misc.h ../../byterun/mlvalues.h ../../byterun/fail.h \ ../../byterun/compatibility.h ../../byterun/misc.h \ ../../byterun/mlvalues.h -str.cmi: -str.cmo: str.cmi -str.cmx: str.cmi +str.cmi: +str.cmo: str.cmi +str.cmx: str.cmi diff --git a/otherlibs/systhreads/.cvsignore b/otherlibs/systhreads/.cvsignore index b175e39d6..1f1e6a387 100644 --- a/otherlibs/systhreads/.cvsignore +++ b/otherlibs/systhreads/.cvsignore @@ -1,3 +1,5 @@ *.x thread.ml so_locations +*.so +*.a diff --git a/otherlibs/systhreads/.depend b/otherlibs/systhreads/.depend index fa6bbbda3..43ac57818 100644 --- a/otherlibs/systhreads/.depend +++ b/otherlibs/systhreads/.depend @@ -22,22 +22,22 @@ posix.o: posix.c ../../byterun/alloc.h ../../byterun/compatibility.h \ ../../byterun/mlvalues.h ../../byterun/stacks.h ../../byterun/misc.h \ ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/sys.h \ ../../byterun/misc.h -condition.cmi: mutex.cmi -event.cmi: -mutex.cmi: -thread.cmi: -threadUnix.cmi: -condition.cmo: mutex.cmi condition.cmi -condition.cmx: mutex.cmx condition.cmi -event.cmo: mutex.cmi condition.cmi event.cmi -event.cmx: mutex.cmx condition.cmx event.cmi -mutex.cmo: mutex.cmi -mutex.cmx: mutex.cmi -thread.cmo: thread.cmi -thread.cmx: thread.cmi -threadUnix.cmo: thread.cmi threadUnix.cmi -threadUnix.cmx: thread.cmx threadUnix.cmi -thread_posix.cmo: -thread_posix.cmx: -thread_win32.cmo: -thread_win32.cmx: +condition.cmi: mutex.cmi +event.cmi: +mutex.cmi: +thread.cmi: +threadUnix.cmi: +condition.cmo: mutex.cmi condition.cmi +condition.cmx: mutex.cmx condition.cmi +event.cmo: mutex.cmi condition.cmi event.cmi +event.cmx: mutex.cmx condition.cmx event.cmi +mutex.cmo: mutex.cmi +mutex.cmx: mutex.cmi +thread.cmo: thread.cmi +thread.cmx: thread.cmi +threadUnix.cmo: thread.cmi threadUnix.cmi +threadUnix.cmx: thread.cmx threadUnix.cmi +thread_posix.cmo: +thread_posix.cmx: +thread_win32.cmo: +thread_win32.cmx: diff --git a/otherlibs/threads/.cvsignore b/otherlibs/threads/.cvsignore index fb2df562d..c17596c7d 100644 --- a/otherlibs/threads/.cvsignore +++ b/otherlibs/threads/.cvsignore @@ -1,3 +1,5 @@ marshal.mli pervasives.mli unix.mli +*.so +*.a diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend index 919e09221..df97763a6 100644 --- a/otherlibs/threads/.depend +++ b/otherlibs/threads/.depend @@ -21,24 +21,24 @@ scheduler.o: scheduler.c ../../byterun/alloc.h \ ../../byterun/mlvalues.h ../../byterun/stacks.h ../../byterun/misc.h \ ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/sys.h \ ../../byterun/misc.h -condition.cmi: mutex.cmi -event.cmi: -mutex.cmi: -thread.cmi: unix.cmo -threadUnix.cmi: unix.cmo -condition.cmo: thread.cmi mutex.cmi condition.cmi -condition.cmx: thread.cmx mutex.cmx condition.cmi -event.cmo: mutex.cmi condition.cmi event.cmi -event.cmx: mutex.cmx condition.cmx event.cmi -marshal.cmo: pervasives.cmo -marshal.cmx: pervasives.cmx -mutex.cmo: thread.cmi mutex.cmi -mutex.cmx: thread.cmx mutex.cmi -pervasives.cmo: unix.cmo -pervasives.cmx: unix.cmx -thread.cmo: unix.cmo thread.cmi -thread.cmx: unix.cmx thread.cmi -threadUnix.cmo: unix.cmo thread.cmi threadUnix.cmi -threadUnix.cmx: unix.cmx thread.cmx threadUnix.cmi -unix.cmo: -unix.cmx: +condition.cmi: mutex.cmi +event.cmi: +mutex.cmi: +thread.cmi: unix.cmo +threadUnix.cmi: unix.cmo +condition.cmo: thread.cmi mutex.cmi condition.cmi +condition.cmx: thread.cmx mutex.cmx condition.cmi +event.cmo: mutex.cmi condition.cmi event.cmi +event.cmx: mutex.cmx condition.cmx event.cmi +marshal.cmo: pervasives.cmo +marshal.cmx: pervasives.cmx +mutex.cmo: thread.cmi mutex.cmi +mutex.cmx: thread.cmx mutex.cmi +pervasives.cmo: unix.cmo +pervasives.cmx: unix.cmx +thread.cmo: unix.cmo thread.cmi +thread.cmx: unix.cmx thread.cmi +threadUnix.cmo: unix.cmo thread.cmi threadUnix.cmi +threadUnix.cmx: unix.cmx thread.cmx threadUnix.cmi +unix.cmo: +unix.cmx: diff --git a/otherlibs/unix/.cvsignore b/otherlibs/unix/.cvsignore index 074dd28a4..29fea4726 100644 --- a/otherlibs/unix/.cvsignore +++ b/otherlibs/unix/.cvsignore @@ -1 +1,3 @@ so_locations +*.so +*.a diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index 2c589e92b..22ddf3e7b 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -390,6 +390,15 @@ gmtime.o: gmtime.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ ../../byterun/freelist.h ../../byterun/misc.h ../../byterun/mlvalues.h \ ../../byterun/misc.h ../../byterun/minor_gc.h ../../byterun/misc.h \ ../../byterun/misc.h ../../byterun/mlvalues.h unixsupport.h +initgroups.o: initgroups.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/alloc.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/mlvalues.h ../../byterun/fail.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/mlvalues.h unixsupport.h isatty.o: isatty.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ ../../byterun/config.h ../../byterun/../config/m.h \ ../../byterun/../config/s.h ../../byterun/compatibility.h \ @@ -584,6 +593,20 @@ setgid.o: setgid.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ ../../byterun/../config/s.h ../../byterun/compatibility.h \ ../../byterun/misc.h ../../byterun/compatibility.h \ ../../byterun/config.h unixsupport.h +setgroups.o: setgroups.c ../../byterun/mlvalues.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/../config/m.h ../../byterun/../config/s.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/compatibility.h ../../byterun/config.h \ + ../../byterun/alloc.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/mlvalues.h ../../byterun/fail.h \ + ../../byterun/compatibility.h ../../byterun/misc.h \ + ../../byterun/mlvalues.h ../../byterun/memory.h \ + ../../byterun/compatibility.h ../../byterun/config.h ../../byterun/gc.h \ + ../../byterun/mlvalues.h ../../byterun/major_gc.h \ + ../../byterun/freelist.h ../../byterun/misc.h ../../byterun/mlvalues.h \ + ../../byterun/misc.h ../../byterun/minor_gc.h ../../byterun/misc.h \ + ../../byterun/misc.h ../../byterun/mlvalues.h unixsupport.h setsid.o: setsid.c ../../byterun/fail.h ../../byterun/compatibility.h \ ../../byterun/misc.h ../../byterun/compatibility.h \ ../../byterun/config.h ../../byterun/../config/m.h \ @@ -788,9 +811,9 @@ write.o: write.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ ../../byterun/misc.h ../../byterun/mlvalues.h ../../byterun/signals.h \ ../../byterun/compatibility.h ../../byterun/misc.h \ ../../byterun/mlvalues.h unixsupport.h -unix.cmi: -unixLabels.cmi: unix.cmi -unix.cmo: unix.cmi -unix.cmx: unix.cmi -unixLabels.cmo: unix.cmi unixLabels.cmi -unixLabels.cmx: unix.cmx unixLabels.cmi +unix.cmi: +unixLabels.cmi: unix.cmi +unix.cmo: unix.cmi +unix.cmx: unix.cmi +unixLabels.cmo: unix.cmi unixLabels.cmi +unixLabels.cmx: unix.cmx unixLabels.cmi diff --git a/otherlibs/unix/socketaddr.c b/otherlibs/unix/socketaddr.c index 0ee1cf5ee..f285d15a7 100644 --- a/otherlibs/unix/socketaddr.c +++ b/otherlibs/unix/socketaddr.c @@ -80,6 +80,9 @@ void get_sockaddr(value mladr, adr->s_inet6.sin6_family = AF_INET6; adr->s_inet6.sin6_addr = GET_INET6_ADDR(Field(mladr, 0)); adr->s_inet6.sin6_port = htons(Int_val(Field(mladr, 1))); +#ifdef SIN6_LEN + adr->s_inet6.sin6_len = sizeof(struct sockaddr_in6); +#endif *adr_len = sizeof(struct sockaddr_in6); break; } @@ -88,6 +91,9 @@ void get_sockaddr(value mladr, adr->s_inet.sin_family = AF_INET; adr->s_inet.sin_addr = GET_INET_ADDR(Field(mladr, 0)); adr->s_inet.sin_port = htons(Int_val(Field(mladr, 1))); +#ifdef SIN6_LEN + adr->s_inet.sin_len = sizeof(struct sockaddr_in); +#endif *adr_len = sizeof(struct sockaddr_in); break; } diff --git a/otherlibs/win32unix/channels.c b/otherlibs/win32unix/channels.c index ed961910b..6e6b10139 100644 --- a/otherlibs/win32unix/channels.c +++ b/otherlibs/win32unix/channels.c @@ -82,7 +82,10 @@ CAMLprim value win_filedescr_of_channel(value vchan) CAMLprim value win_handle_fd(value vfd) { int crt_fd = Int_val(vfd); - value res = win_alloc_handle_or_socket((HANDLE) _get_osfhandle(crt_fd)); + /* PR#4750: do not use the _or_socket variant as it can cause performance + degradation and this function is only used with the standard + handles 0, 1, 2, which are not sockets. */ + value res = win_alloc_handle((HANDLE) _get_osfhandle(crt_fd)); CRT_fd_val(res) = crt_fd; return res; } diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c index 24c4a9e45..6e32a39e7 100644 --- a/otherlibs/win32unix/unixsupport.c +++ b/otherlibs/win32unix/unixsupport.c @@ -65,6 +65,8 @@ value win_alloc_socket(SOCKET s) return res; } +#if 0 +/* PR#4750: this function is no longer used */ value win_alloc_handle_or_socket(HANDLE h) { value res = win_alloc_handle(h); @@ -74,6 +76,7 @@ value win_alloc_handle_or_socket(HANDLE h) Descr_kind_val(res) = KIND_SOCKET; return res; } +#endif /* Mapping of Windows error codes to POSIX error codes */ diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h index 57f4caa68..bf71ac6dc 100644 --- a/otherlibs/win32unix/unixsupport.h +++ b/otherlibs/win32unix/unixsupport.h @@ -36,7 +36,7 @@ struct filedescr { #define Descr_kind_val(v) (((struct filedescr *) Data_custom_val(v))->kind) #define CRT_fd_val(v) (((struct filedescr *) Data_custom_val(v))->crt_fd) -extern value win_alloc_handle_or_socket(HANDLE); +/* extern value win_alloc_handle_or_socket(HANDLE); */ extern value win_alloc_handle(HANDLE); extern value win_alloc_socket(SOCKET); extern int win_CRT_fd_of_filedescr(value handle); diff --git a/stdlib/.cvsignore b/stdlib/.cvsignore index 343f6abd6..6aa0cd421 100644 --- a/stdlib/.cvsignore +++ b/stdlib/.cvsignore @@ -4,3 +4,4 @@ labelled-* caml *.annot sys.ml +*.a diff --git a/stdlib/.depend b/stdlib/.depend index faa338218..5aae75f71 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -1,144 +1,146 @@ -arg.cmi: -array.cmi: -arrayLabels.cmi: -buffer.cmi: -callback.cmi: -camlinternalLazy.cmi: -camlinternalMod.cmi: obj.cmi -camlinternalOO.cmi: obj.cmi -char.cmi: -complex.cmi: -digest.cmi: -filename.cmi: -format.cmi: buffer.cmi -gc.cmi: -genlex.cmi: stream.cmi -hashtbl.cmi: -int32.cmi: -int64.cmi: -lazy.cmi: -lexing.cmi: -list.cmi: -listLabels.cmi: -map.cmi: -marshal.cmi: -moreLabels.cmi: set.cmi map.cmi hashtbl.cmi -nativeint.cmi: -obj.cmi: -oo.cmi: camlinternalOO.cmi -parsing.cmi: obj.cmi lexing.cmi -pervasives.cmi: -printexc.cmi: -printf.cmi: obj.cmi buffer.cmi -queue.cmi: -random.cmi: nativeint.cmi int64.cmi int32.cmi -scanf.cmi: -set.cmi: -sort.cmi: -stack.cmi: -stdLabels.cmi: -stream.cmi: -string.cmi: -stringLabels.cmi: -sys.cmi: -weak.cmi: hashtbl.cmi -arg.cmo: sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi arg.cmi -arg.cmx: sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx arg.cmi -array.cmo: array.cmi -array.cmx: array.cmi -arrayLabels.cmo: array.cmi arrayLabels.cmi -arrayLabels.cmx: array.cmx arrayLabels.cmi -buffer.cmo: sys.cmi string.cmi buffer.cmi -buffer.cmx: sys.cmx string.cmx buffer.cmi -callback.cmo: obj.cmi callback.cmi -callback.cmx: obj.cmx callback.cmi -camlinternalLazy.cmo: obj.cmi camlinternalLazy.cmi -camlinternalLazy.cmx: obj.cmx camlinternalLazy.cmi -camlinternalMod.cmo: obj.cmi camlinternalOO.cmi array.cmi camlinternalMod.cmi -camlinternalMod.cmx: obj.cmx camlinternalOO.cmx array.cmx camlinternalMod.cmi +arg.cmi: +array.cmi: +arrayLabels.cmi: +buffer.cmi: +callback.cmi: +camlinternalLazy.cmi: +camlinternalMod.cmi: obj.cmi +camlinternalOO.cmi: obj.cmi +char.cmi: +complex.cmi: +digest.cmi: +filename.cmi: +format.cmi: pervasives.cmi buffer.cmi +gc.cmi: +genlex.cmi: stream.cmi +hashtbl.cmi: +int32.cmi: +int64.cmi: +lazy.cmi: +lexing.cmi: +list.cmi: +listLabels.cmi: +map.cmi: +marshal.cmi: +moreLabels.cmi: set.cmi map.cmi hashtbl.cmi +nativeint.cmi: +obj.cmi: +oo.cmi: camlinternalOO.cmi +parsing.cmi: obj.cmi lexing.cmi +pervasives.cmi: +printexc.cmi: +printf.cmi: obj.cmi buffer.cmi +queue.cmi: +random.cmi: nativeint.cmi int64.cmi int32.cmi +scanf.cmi: pervasives.cmi +set.cmi: +sort.cmi: +stack.cmi: +stdLabels.cmi: +stream.cmi: +string.cmi: +stringLabels.cmi: +sys.cmi: +weak.cmi: hashtbl.cmi +arg.cmo: sys.cmi string.cmi printf.cmi list.cmi buffer.cmi array.cmi arg.cmi +arg.cmx: sys.cmx string.cmx printf.cmx list.cmx buffer.cmx array.cmx arg.cmi +array.cmo: array.cmi +array.cmx: array.cmi +arrayLabels.cmo: array.cmi arrayLabels.cmi +arrayLabels.cmx: array.cmx arrayLabels.cmi +buffer.cmo: sys.cmi string.cmi buffer.cmi +buffer.cmx: sys.cmx string.cmx buffer.cmi +callback.cmo: obj.cmi callback.cmi +callback.cmx: obj.cmx callback.cmi +camlinternalLazy.cmo: obj.cmi camlinternalLazy.cmi +camlinternalLazy.cmx: obj.cmx camlinternalLazy.cmi +camlinternalMod.cmo: obj.cmi camlinternalOO.cmi array.cmi camlinternalMod.cmi +camlinternalMod.cmx: obj.cmx camlinternalOO.cmx array.cmx camlinternalMod.cmi camlinternalOO.cmo: sys.cmi string.cmi obj.cmi map.cmi list.cmi char.cmi \ - array.cmi camlinternalOO.cmi + array.cmi camlinternalOO.cmi camlinternalOO.cmx: sys.cmx string.cmx obj.cmx map.cmx list.cmx char.cmx \ - array.cmx camlinternalOO.cmi -char.cmo: char.cmi -char.cmx: char.cmi -complex.cmo: complex.cmi -complex.cmx: complex.cmi -digest.cmo: string.cmi printf.cmi digest.cmi -digest.cmx: string.cmx printf.cmx digest.cmi + array.cmx camlinternalOO.cmi +char.cmo: char.cmi +char.cmx: char.cmi +complex.cmo: complex.cmi +complex.cmx: complex.cmi +digest.cmo: string.cmi printf.cmi digest.cmi +digest.cmx: string.cmx printf.cmx digest.cmi filename.cmo: sys.cmi string.cmi random.cmi printf.cmi buffer.cmi \ - filename.cmi + filename.cmi filename.cmx: sys.cmx string.cmx random.cmx printf.cmx buffer.cmx \ - filename.cmi -format.cmo: string.cmi printf.cmi obj.cmi list.cmi buffer.cmi format.cmi -format.cmx: string.cmx printf.cmx obj.cmx list.cmx buffer.cmx format.cmi -gc.cmo: sys.cmi printf.cmi gc.cmi -gc.cmx: sys.cmx printf.cmx gc.cmi -genlex.cmo: string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi -genlex.cmx: string.cmx stream.cmx list.cmx hashtbl.cmx char.cmx genlex.cmi -hashtbl.cmo: sys.cmi array.cmi hashtbl.cmi -hashtbl.cmx: sys.cmx array.cmx hashtbl.cmi -int32.cmo: pervasives.cmi int32.cmi -int32.cmx: pervasives.cmx int32.cmi -int64.cmo: pervasives.cmi int64.cmi -int64.cmx: pervasives.cmx int64.cmi -lazy.cmo: obj.cmi camlinternalLazy.cmi lazy.cmi -lazy.cmx: obj.cmx camlinternalLazy.cmx lazy.cmi -lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi -lexing.cmx: sys.cmx string.cmx array.cmx lexing.cmi -list.cmo: list.cmi -list.cmx: list.cmi -listLabels.cmo: list.cmi listLabels.cmi -listLabels.cmx: list.cmx listLabels.cmi -map.cmo: map.cmi -map.cmx: map.cmi -marshal.cmo: string.cmi marshal.cmi -marshal.cmx: string.cmx marshal.cmi -moreLabels.cmo: set.cmi map.cmi hashtbl.cmi moreLabels.cmi -moreLabels.cmx: set.cmx map.cmx hashtbl.cmx moreLabels.cmi -nativeint.cmo: sys.cmi pervasives.cmi nativeint.cmi -nativeint.cmx: sys.cmx pervasives.cmx nativeint.cmi -obj.cmo: marshal.cmi obj.cmi -obj.cmx: marshal.cmx obj.cmi -oo.cmo: camlinternalOO.cmi oo.cmi -oo.cmx: camlinternalOO.cmx oo.cmi -parsing.cmo: obj.cmi lexing.cmi array.cmi parsing.cmi -parsing.cmx: obj.cmx lexing.cmx array.cmx parsing.cmi -pervasives.cmo: pervasives.cmi -pervasives.cmx: pervasives.cmi -printexc.cmo: printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi -printexc.cmx: printf.cmx obj.cmx buffer.cmx array.cmx printexc.cmi -printf.cmo: string.cmi obj.cmi list.cmi char.cmi buffer.cmi array.cmi \ - printf.cmi -printf.cmx: string.cmx obj.cmx list.cmx char.cmx buffer.cmx array.cmx \ - printf.cmi -queue.cmo: obj.cmi queue.cmi -queue.cmx: obj.cmx queue.cmi + filename.cmi +format.cmo: string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi buffer.cmi \ + format.cmi +format.cmx: string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx buffer.cmx \ + format.cmi +gc.cmo: sys.cmi printf.cmi gc.cmi +gc.cmx: sys.cmx printf.cmx gc.cmi +genlex.cmo: string.cmi stream.cmi list.cmi hashtbl.cmi char.cmi genlex.cmi +genlex.cmx: string.cmx stream.cmx list.cmx hashtbl.cmx char.cmx genlex.cmi +hashtbl.cmo: sys.cmi array.cmi hashtbl.cmi +hashtbl.cmx: sys.cmx array.cmx hashtbl.cmi +int32.cmo: pervasives.cmi int32.cmi +int32.cmx: pervasives.cmx int32.cmi +int64.cmo: pervasives.cmi int64.cmi +int64.cmx: pervasives.cmx int64.cmi +lazy.cmo: obj.cmi camlinternalLazy.cmi lazy.cmi +lazy.cmx: obj.cmx camlinternalLazy.cmx lazy.cmi +lexing.cmo: sys.cmi string.cmi array.cmi lexing.cmi +lexing.cmx: sys.cmx string.cmx array.cmx lexing.cmi +list.cmo: list.cmi +list.cmx: list.cmi +listLabels.cmo: list.cmi listLabels.cmi +listLabels.cmx: list.cmx listLabels.cmi +map.cmo: map.cmi +map.cmx: map.cmi +marshal.cmo: string.cmi marshal.cmi +marshal.cmx: string.cmx marshal.cmi +moreLabels.cmo: set.cmi map.cmi hashtbl.cmi moreLabels.cmi +moreLabels.cmx: set.cmx map.cmx hashtbl.cmx moreLabels.cmi +nativeint.cmo: sys.cmi pervasives.cmi nativeint.cmi +nativeint.cmx: sys.cmx pervasives.cmx nativeint.cmi +obj.cmo: marshal.cmi array.cmi obj.cmi +obj.cmx: marshal.cmx array.cmx obj.cmi +oo.cmo: camlinternalOO.cmi oo.cmi +oo.cmx: camlinternalOO.cmx oo.cmi +parsing.cmo: obj.cmi lexing.cmi array.cmi parsing.cmi +parsing.cmx: obj.cmx lexing.cmx array.cmx parsing.cmi +pervasives.cmo: pervasives.cmi +pervasives.cmx: pervasives.cmi +printexc.cmo: printf.cmi obj.cmi buffer.cmi array.cmi printexc.cmi +printexc.cmx: printf.cmx obj.cmx buffer.cmx array.cmx printexc.cmi +printf.cmo: string.cmi pervasives.cmi obj.cmi list.cmi char.cmi buffer.cmi \ + array.cmi printf.cmi +printf.cmx: string.cmx pervasives.cmx obj.cmx list.cmx char.cmx buffer.cmx \ + array.cmx printf.cmi +queue.cmo: obj.cmi queue.cmi +queue.cmx: obj.cmx queue.cmi random.cmo: string.cmi pervasives.cmi nativeint.cmi int64.cmi int32.cmi \ - digest.cmi char.cmi array.cmi random.cmi + digest.cmi char.cmi array.cmi random.cmi random.cmx: string.cmx pervasives.cmx nativeint.cmx int64.cmx int32.cmx \ - digest.cmx char.cmx array.cmx random.cmi -scanf.cmo: string.cmi printf.cmi obj.cmi list.cmi hashtbl.cmi buffer.cmi \ - array.cmi scanf.cmi -scanf.cmx: string.cmx printf.cmx obj.cmx list.cmx hashtbl.cmx buffer.cmx \ - array.cmx scanf.cmi -set.cmo: set.cmi -set.cmx: set.cmi -sort.cmo: array.cmi sort.cmi -sort.cmx: array.cmx sort.cmi -stack.cmo: list.cmi stack.cmi -stack.cmx: list.cmx stack.cmi -stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi -stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi -std_exit.cmo: -std_exit.cmx: -stream.cmo: string.cmi obj.cmi list.cmi lazy.cmi stream.cmi -stream.cmx: string.cmx obj.cmx list.cmx lazy.cmx stream.cmi -string.cmo: pervasives.cmi list.cmi char.cmi string.cmi -string.cmx: pervasives.cmx list.cmx char.cmx string.cmi -stringLabels.cmo: string.cmi stringLabels.cmi -stringLabels.cmx: string.cmx stringLabels.cmi -sys.cmo: sys.cmi -sys.cmx: sys.cmi -weak.cmo: sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi -weak.cmx: sys.cmx obj.cmx hashtbl.cmx array.cmx weak.cmi + digest.cmx char.cmx array.cmx random.cmi +scanf.cmo: string.cmi printf.cmi pervasives.cmi obj.cmi list.cmi hashtbl.cmi \ + buffer.cmi array.cmi scanf.cmi +scanf.cmx: string.cmx printf.cmx pervasives.cmx obj.cmx list.cmx hashtbl.cmx \ + buffer.cmx array.cmx scanf.cmi +set.cmo: set.cmi +set.cmx: set.cmi +sort.cmo: array.cmi sort.cmi +sort.cmx: array.cmx sort.cmi +stack.cmo: list.cmi stack.cmi +stack.cmx: list.cmx stack.cmi +stdLabels.cmo: stringLabels.cmi listLabels.cmi arrayLabels.cmi stdLabels.cmi +stdLabels.cmx: stringLabels.cmx listLabels.cmx arrayLabels.cmx stdLabels.cmi +std_exit.cmo: +std_exit.cmx: +stream.cmo: string.cmi obj.cmi list.cmi lazy.cmi stream.cmi +stream.cmx: string.cmx obj.cmx list.cmx lazy.cmx stream.cmi +string.cmo: pervasives.cmi list.cmi char.cmi string.cmi +string.cmx: pervasives.cmx list.cmx char.cmx string.cmi +stringLabels.cmo: string.cmi stringLabels.cmi +stringLabels.cmx: string.cmx stringLabels.cmi +sys.cmo: sys.cmi +sys.cmx: sys.cmi +weak.cmo: sys.cmi obj.cmi hashtbl.cmi array.cmi weak.cmi +weak.cmx: sys.cmx obj.cmx hashtbl.cmx array.cmx weak.cmi diff --git a/stdlib/buffer.ml b/stdlib/buffer.ml index 8dfe87599..088840981 100644 --- a/stdlib/buffer.ml +++ b/stdlib/buffer.ml @@ -39,6 +39,14 @@ let sub b ofs len = end ;; +let blit src srcoff dst dstoff len = + if len < 0 || srcoff < 0 || srcoff > src.position - len + || dstoff < 0 || dstoff > (String.length dst) - len + then invalid_arg "Buffer.blit" + else + String.blit src.buffer srcoff dst dstoff len +;; + let nth b ofs = if ofs < 0 || ofs >= b.position then invalid_arg "Buffer.nth" diff --git a/stdlib/buffer.mli b/stdlib/buffer.mli index d7afbb183..32d15349e 100644 --- a/stdlib/buffer.mli +++ b/stdlib/buffer.mli @@ -48,6 +48,15 @@ current contents of the buffer [b] starting at offset [off] of length [len] bytes. May raise [Invalid_argument] if out of bounds request. The buffer itself is unaffected. *) +val blit : t -> int -> string -> int -> int -> unit +(** [Buffer.blit src srcoff dst dstoff len] copies [len] characters from + the current contents of the buffer [src], starting at offset [srcoff] + to string [dst], starting at character [dstoff]. + + Raise [Invalid_argument] if [srcoff] and [len] do not designate a valid + substring of [src], or if [dstoff] and [len] do not designate a valid + substring of [dst]. *) + val nth : t -> int -> char (** get the n-th character of the buffer. Raise [Invalid_argument] if index out of bounds *) diff --git a/stdlib/filename.ml b/stdlib/filename.ml index d3a68cf63..e11f1e330 100644 --- a/stdlib/filename.ml +++ b/stdlib/filename.ml @@ -194,14 +194,14 @@ external close_desc: int -> unit = "caml_sys_close" let prng = Random.State.make_self_init ();; -let temp_file_name prefix suffix = +let temp_file_name temp_dir prefix suffix = let rnd = (Random.State.bits prng) land 0xFFFFFF in - concat temp_dir_name (Printf.sprintf "%s%06x%s" prefix rnd suffix) + concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix) ;; -let temp_file prefix suffix = +let temp_file ?(temp_dir=temp_dir_name) prefix suffix = let rec try_name counter = - let name = temp_file_name prefix suffix in + let name = temp_file_name temp_dir prefix suffix in try close_desc(open_desc name [Open_wronly; Open_creat; Open_excl] 0o600); name @@ -209,9 +209,9 @@ let temp_file prefix suffix = if counter >= 1000 then raise e else try_name (counter + 1) in try_name 0 -let open_temp_file ?(mode = [Open_text]) prefix suffix = +let open_temp_file ?(mode = [Open_text]) ?(temp_dir=temp_dir_name) prefix suffix = let rec try_name counter = - let name = temp_file_name prefix suffix in + let name = temp_file_name temp_dir prefix suffix in try (name, open_out_gen (Open_wronly::Open_creat::Open_excl::mode) 0o600 name) diff --git a/stdlib/filename.mli b/stdlib/filename.mli index 3a968e0a1..e01660952 100644 --- a/stdlib/filename.mli +++ b/stdlib/filename.mli @@ -22,6 +22,9 @@ val parent_dir_name : string (** The conventional name for the parent of the current directory (e.g. [..] in Unix). *) +val dir_sep : string +(** The directory separator (e.g. [/] in Unix). *) + val concat : string -> string -> string (** [concat dir file] returns a file name that designates file [file] in directory [dir]. *) @@ -68,11 +71,13 @@ val basename : string -> string val dirname : string -> string (** See {!Filename.basename}. *) -val temp_file : string -> string -> string +val temp_file : ?temp_dir: string -> string -> string -> string (** [temp_file prefix suffix] returns the name of a fresh temporary file in the temporary directory. The base name of the temporary file is formed by concatenating [prefix], then a suitably chosen integer number, then [suffix]. + The optional argument [temp_dir] indicates the temporary directory + to use, defaulting to {!Filename.temp_dir_name}. The temporary file is created empty, with permissions [0o600] (readable and writable only by the file owner). The file is guaranteed to be different from any other file that existed when @@ -80,7 +85,7 @@ val temp_file : string -> string -> string *) val open_temp_file : - ?mode: open_flag list -> string -> string -> string * out_channel + ?mode: open_flag list -> ?temp_dir: string -> string -> string -> string * out_channel (** Same as {!Filename.temp_file}, but returns both the name of a fresh temporary file, and an output channel opened (atomically) on this file. This function is more secure than [temp_file]: there diff --git a/stdlib/format.mli b/stdlib/format.mli index 897ebb3ef..58cb29e24 100644 --- a/stdlib/format.mli +++ b/stdlib/format.mli @@ -359,7 +359,45 @@ val get_formatter_output_functions : unit -> (string -> int -> int -> unit) * (unit -> unit);; (** Return the current output functions of the pretty-printer. *) -(** {6 Changing the meaning of printing tags} *) +(** {6 Changing the meaning of standard formatter pretty printing} *) + +(** The [Format] module is versatile enough to let you completely redefine + the meaning of pretty printing: you may provide your own functions to define + how to handle indentation, line breaking, and even printing of all the + characters that have to be printed! *) + +val set_all_formatter_output_functions : + out:(string -> int -> int -> unit) -> + flush:(unit -> unit) -> + newline:(unit -> unit) -> + spaces:(int -> unit) -> + unit;; +(** [set_all_formatter_output_functions out flush outnewline outspace] + redirects the pretty-printer output to the functions [out] and + [flush] as described in [set_formatter_output_functions]. In + addition, the pretty-printer function that outputs a newline is set + to the function [outnewline] and the function that outputs + indentation spaces is set to the function [outspace]. + + This way, you can change the meaning of indentation (which can be + something else than just printing space characters) and the + meaning of new lines opening (which can be connected to any other + action needed by the application at hand). The two functions + [outspace] and [outnewline] are normally connected to [out] and + [flush]: respective default values for [outspace] and [outnewline] + are [out (String.make n ' ') 0 n] and [out "\n" 0 1]. *) + +val get_all_formatter_output_functions : + unit -> + (string -> int -> int -> unit) * + (unit -> unit) * + (unit -> unit) * + (int -> unit);; +(** Return the current output functions of the pretty-printer, + including line breaking and indentation functions. Useful to record the + current setting and restore it afterwards. *) + +(** {6 Changing the meaning of printing semantics tags} *) type formatter_tag_functions = { mark_open_tag : tag -> string; @@ -429,10 +467,10 @@ type formatter_output_meaning = { (** {6 Changing the meaning of the standard output pretty printer} *) val set_formatter_output_meaning : formatter_output_meaning -> unit - (** Set the output functions according to the given meaning. *) + (** Set the output functions according to the given meaning. *) ;; val get_formatter_output_meaning : formatter_output_meaning - (** Get the current meaning of the output functions. *) + (** Get the current meaning of the output functions. *) ;; (** An alternative way to modify the behaviour of output functions in an diff --git a/stdlib/obj.ml b/stdlib/obj.ml index 9685be38f..922febd65 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -27,9 +27,12 @@ external set_tag : t -> int -> unit = "caml_obj_set_tag" external size : t -> int = "%obj_size" external field : t -> int -> t = "%obj_field" external set_field : t -> int -> t -> unit = "%obj_set_field" +let double_field x i = Array.get (obj x : float array) i +let set_double_field x i v = Array.set (obj x : float array) i v external new_block : int -> int -> t = "caml_obj_block" external dup : t -> t = "caml_obj_dup" external truncate : t -> int -> unit = "caml_obj_truncate" +external add_offset : t -> int -> t = "caml_obj_add_offset" let marshal (obj : t) = Marshal.to_string obj [] diff --git a/stdlib/obj.mli b/stdlib/obj.mli index a35b119bd..34b78fdb4 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -28,11 +28,14 @@ external is_int : t -> bool = "%obj_is_int" external tag : t -> int = "caml_obj_tag" external set_tag : t -> int -> unit = "caml_obj_set_tag" external size : t -> int = "%obj_size" -external truncate : t -> int -> unit = "caml_obj_truncate" external field : t -> int -> t = "%obj_field" external set_field : t -> int -> t -> unit = "%obj_set_field" +val double_field : t -> int -> float +val set_double_field : t -> int -> float -> unit external new_block : int -> int -> t = "caml_obj_block" external dup : t -> t = "caml_obj_dup" +external truncate : t -> int -> unit = "caml_obj_truncate" +external add_offset : t -> int -> t = "caml_obj_add_offset" val lazy_tag : int val closure_tag : int diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 47282e360..7a1e68dd9 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -71,7 +71,7 @@ external ( >= ) : 'a -> 'a -> bool = "%greaterequal" The ordering is compatible with [(=)]. As in the case of [(=)], mutable structures are compared by contents. Comparison between functional values raises [Invalid_argument]. - Comparison between cyclic structures does not terminate. *) + Comparison between cyclic structures may not terminate. *) external compare : 'a -> 'a -> int = "%compare" (** [compare x y] returns [0] if [x] is equal to [y], @@ -93,10 +93,14 @@ external compare : 'a -> 'a -> int = "%compare" the {!List.sort} and {!Array.sort} functions. *) val min : 'a -> 'a -> 'a -(** Return the smaller of the two arguments. *) +(** Return the smaller of the two arguments. + The result is unspecified if one of the arguments contains + the float value [nan]. *) val max : 'a -> 'a -> 'a -(** Return the greater of the two arguments. *) +(** Return the greater of the two arguments. + The result is unspecified if one of the arguments contains + the float value [nan]. *) external ( == ) : 'a -> 'a -> bool = "%eq" (** [e1 == e2] tests for physical equality of [e1] and [e2]. @@ -228,8 +232,8 @@ external ( asr ) : int -> int -> int = "%asrint" [neg_infinity] for [-1.0 /. 0.0], and [nan] (``not a number'') for [0.0 /. 0.0]. These special numbers then propagate through floating-point computations as expected: for instance, - [1.0 /. infinity] is [0.0], and any operation with [nan] as - argument returns [nan] as result. + [1.0 /. infinity] is [0.0], and any arithmetic operation with [nan] + as argument returns [nan] as result. *) external ( ~-. ) : float -> float = "%negfloat" diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml index f06717c27..11e7d4fd6 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -15,6 +15,8 @@ open Printf;; +let printers = ref [] + let locfmt = format_of_string "File \"%s\", line %d, characters %d-%d: %s";; let field x i = @@ -48,9 +50,16 @@ let to_string = function | Assert_failure(file, line, char) -> sprintf locfmt file line char (char+6) "Assertion failed" | x -> - let x = Obj.repr x in - let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in - constructor ^ (fields x) + let rec conv = function + | hd :: tl -> + (match try hd x with _ -> None with + | Some s -> s + | None -> conv tl) + | [] -> + let x = Obj.repr x in + let constructor = (Obj.magic(Obj.field (Obj.field x 0) 0) : string) in + constructor ^ (fields x) in + conv !printers ;; let print fct arg = @@ -125,3 +134,5 @@ let get_backtrace () = external record_backtrace: bool -> unit = "caml_record_backtrace" external backtrace_status: unit -> bool = "caml_backtrace_status" +let register_printer fn = + printers := fn :: !printers diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index a3ae6ba7b..99729e10f 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -57,3 +57,13 @@ val record_backtrace: bool -> unit val backtrace_status: unit -> bool (** [Printexc.backtrace_status()] returns [true] if exception backtraces are currently recorded, [false] if not. *) + +val register_printer : (exn -> string option) -> unit +(** [Printexc.register_printer fn] registers [fn] as an exception printer. + The printer should return [None] if it does not know how to convert + the passed exception, and [Some s] with [s] the resulting string if + it can convert the passed exception. + When converting an exception into a string, the printers will be invoked + in the reverse order of their registrations, until a printer returns + a [Some s] value (if no such printer exists, the runtime will use a + generic printer). *) diff --git a/stdlib/scanf.mli b/stdlib/scanf.mli index 21861b66a..d3033f028 100644 --- a/stdlib/scanf.mli +++ b/stdlib/scanf.mli @@ -215,12 +215,15 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; (** {7 The space character in format strings} *) (** As mentioned above, a plain character in the format string is just - matched with the characters of the input; however, one character is a - special exception to this simple rule: the space character (ASCII code - 32) does not match a single space character, but any amount of + matched with the next character of the input; however, two characters are + special exceptions to this rule: the space character ([' '] or ASCII code + 32) and the line feed character (['\n'] or ASCII code 10). + A space does not match a single space character, but any amount of ``whitespace'' in the input. More precisely, a space inside the format string matches {e any number} of tab, space, line feed and carriage - return characters. + return characters. Similarly, a line feed character in the format string + matches either a single line feed or a carriage return followed by a line + feed. Matching {e any} amount of whitespace, a space in the format string also matches no amount of whitespace at all; hence, the call [bscanf ib @@ -305,6 +308,7 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; - [N] or [L]: returns the number of tokens read so far. - [!]: matches the end of input condition. - [%]: matches one [%] character in the input. + - [,]: the no-op delimiter for conversion specifications. Following the [%] character that introduces a conversion, there may be the special flag [_]: the conversion that follows occurs as usual, @@ -379,7 +383,7 @@ val bscanf : Scanning.in_channel -> ('a, 'b, 'c, 'd) scanner;; [End_of_file]: if the end of input is reached the conversion succeeds and simply returns the characters read so far, or [""] if none were ever read. *) -(** {6 Specialized formatted input functions} *) +(** {6 Specialised formatted input functions} *) val fscanf : Pervasives.in_channel -> ('a, 'b, 'c, 'd) scanner;; (** Same as {!Scanf.bscanf}, but reads from the given regular input channel. @@ -416,8 +420,8 @@ val bscanf_format : Scanning.in_channel -> ('a, 'b, 'c, 'd, 'e, 'f) format6 -> (('a, 'b, 'c, 'd, 'e, 'f) format6 -> 'g) -> 'g;; (** [bscanf_format ic fmt f] reads a format string token from the formatted - input channel [ic], according to the given format string [fmt], and applies [f] to - the resulting format string value. + input channel [ic], according to the given format string [fmt], and + applies [f] to the resulting format string value. Raise [Scan_failure] if the format string value read does not have the same type as [fmt]. *) diff --git a/stdlib/stdlib.mllib b/stdlib/stdlib.mllib index 9f835c6fa..91265e5da 100644 --- a/stdlib/stdlib.mllib +++ b/stdlib/stdlib.mllib @@ -1,48 +1,49 @@ -# This file lists all standard library modules. +# This file lists all standard library modules +# (in the same order as Makefile.shared). # It is used in particular to know what to expunge in toplevels. # $Id$ Pervasives -Arg Array -ArrayLabels -Buffer -Callback -CamlinternalLazy -CamlinternalMod -CamlinternalOO +List Char -Complex -Digest -Filename -Format -Gc -Genlex +String +Sys Hashtbl +Sort +Marshal +Obj Int32 Int64 -Lazy -Lexing -List -ListLabels -Map -Marshal -MoreLabels Nativeint -Obj -Oo +Lexing Parsing -Printexc -Printf -Queue -Random -Scanf Set -Sort +Map Stack -StdLabels +Queue +CamlinternalLazy +Lazy Stream -String -StringLabels -Sys +Buffer +Printf +Format +Scanf +Arg +Printexc +Gc +Digest +Random +Callback +CamlinternalOO +Oo +CamlinternalMod +Genlex Weak +Filename +Complex +ArrayLabels +ListLabels +StringLabels +MoreLabels +StdLabels diff --git a/test/Moretest/tscanf.ml b/test/Moretest/tscanf.ml index 3a0d01a85..73aa0e267 100644 --- a/test/Moretest/tscanf.ml +++ b/test/Moretest/tscanf.ml @@ -202,7 +202,21 @@ let test9 () = \\\n\ b \\\n\ c\010\\\n\ - b" + b" && + test_S "\xef" && + test_S "\\xef" && + Scanf.sscanf "\"\\xef\"" "%S" (fun s -> s) = + "\xef" && + Scanf.sscanf "\"\\xef\\xbb\\xbf\"" "%S" (fun s -> s) = + "" && + Scanf.sscanf "\"\\xef\\xbb\\xbf\"" "%S" (fun s -> s) = + "\239\187\191" && + Scanf.sscanf "\"\xef\xbb\xbf\"" "%S" (fun s -> s) = + "" && + Scanf.sscanf "\"\\\\xef\\\\xbb\\\\xbf\"" "%S" (fun s -> s) = + "\\xef\\xbb\\xbf" && + Scanf.sscanf "\"\ \"" "%S" (fun s -> s) = + "\ " ;; test (test9 ()) diff --git a/testlabl/bugs/pr4933.ml b/testlabl/bugs/pr4933.ml new file mode 100644 index 000000000..b486290c5 --- /dev/null +++ b/testlabl/bugs/pr4933.ml @@ -0,0 +1,15 @@ +module type Priv = sig + type t = private int +end + +module Make (Unit:sig end): Priv = struct type t = int end + +module A = Make (struct end) + +module type Priv' = sig + type t = private [> `A] +end + +module Make' (Unit:sig end): Priv' = struct type t = [`A] end + +module A' = Make' (struct end) diff --git a/testlabl/private.ml b/testlabl/private.ml index f865163e2..636f231ba 100644 --- a/testlabl/private.ml +++ b/testlabl/private.ml @@ -29,3 +29,61 @@ module M6 : sig type t = private < n:int; .. > end = M1;; (* fails *) module Bar : sig type t = private Foobar.t val f : int -> t end = struct type t = int let f (x : int) = (x : t) end;; (* must fail *) +module M : sig + type t = private T of int + val mk : int -> t +end = struct + type t = T of int + let mk x = T(x) +end;; + +module M1 : sig + type t = M.t + val mk : int -> t +end = struct + type t = M.t + let mk = M.mk +end;; + +module M2 : sig + type t = M.t + val mk : int -> t +end = struct + include M +end;; + +module M3 : sig + type t = M.t + val mk : int -> t +end = M;; + +module M4 : sig + type t = M.t = T of int + val mk : int -> t + end = M;; +(* Error: The variant or record definition does not match that of type M.t *) + +module M5 : sig + type t = M.t = private T of int + val mk : int -> t +end = M;; + +module M6 : sig + type t = private T of int + val mk : int -> t +end = M;; + +module M' : sig + type t_priv = private T of int + type t = t_priv + val mk : int -> t +end = struct + type t_priv = T of int + type t = t_priv + let mk x = T(x) +end;; + +module M3' : sig + type t = M'.t + val mk : int -> t +end = M';; diff --git a/tools/.cvsignore b/tools/.cvsignore index da394be95..6adfbf20f 100644 --- a/tools/.cvsignore +++ b/tools/.cvsignore @@ -6,6 +6,7 @@ dumpobj dumpapprox objinfo cvt_emit +cvt_emit.bak cvt_emit.ml ocamlcp ocamlmktop diff --git a/tools/.depend b/tools/.depend index b51459b67..9a5ab8be1 100644 --- a/tools/.depend +++ b/tools/.depend @@ -1,64 +1,64 @@ -depend.cmi: ../parsing/parsetree.cmi -profiling.cmi: +depend.cmi: ../parsing/parsetree.cmi +profiling.cmi: addlabels.cmo: ../parsing/parsetree.cmi ../parsing/parse.cmi \ - ../parsing/longident.cmi ../parsing/location.cmi ../parsing/asttypes.cmi + ../parsing/longident.cmi ../parsing/location.cmi ../parsing/asttypes.cmi addlabels.cmx: ../parsing/parsetree.cmi ../parsing/parse.cmx \ - ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi -cvt_emit.cmo: -cvt_emit.cmx: + ../parsing/longident.cmx ../parsing/location.cmx ../parsing/asttypes.cmi +cvt_emit.cmo: +cvt_emit.cmx: depend.cmo: ../parsing/parsetree.cmi ../parsing/longident.cmi \ - ../parsing/location.cmi depend.cmi + ../parsing/location.cmi depend.cmi depend.cmx: ../parsing/parsetree.cmi ../parsing/longident.cmx \ - ../parsing/location.cmx depend.cmi + ../parsing/location.cmx depend.cmi dumpapprox.cmo: ../utils/config.cmi ../asmcomp/compilenv.cmi \ - ../asmcomp/clambda.cmi + ../asmcomp/clambda.cmi dumpapprox.cmx: ../utils/config.cmx ../asmcomp/compilenv.cmx \ - ../asmcomp/clambda.cmx + ../asmcomp/clambda.cmx dumpobj.cmo: ../utils/tbl.cmi opnames.cmo ../bytecomp/opcodes.cmo \ ../parsing/location.cmi ../bytecomp/lambda.cmi ../bytecomp/instruct.cmi \ ../typing/ident.cmi ../bytecomp/emitcode.cmi ../utils/config.cmi \ ../bytecomp/cmo_format.cmi ../bytecomp/bytesections.cmi \ - ../parsing/asttypes.cmi + ../parsing/asttypes.cmi dumpobj.cmx: ../utils/tbl.cmx opnames.cmx ../bytecomp/opcodes.cmx \ ../parsing/location.cmx ../bytecomp/lambda.cmx ../bytecomp/instruct.cmx \ ../typing/ident.cmx ../bytecomp/emitcode.cmx ../utils/config.cmx \ ../bytecomp/cmo_format.cmi ../bytecomp/bytesections.cmx \ - ../parsing/asttypes.cmi -lexer301.cmo: ../utils/warnings.cmi ../utils/misc.cmi ../parsing/location.cmi -lexer301.cmx: ../utils/warnings.cmx ../utils/misc.cmx ../parsing/location.cmx -myocamlbuild_config.cmo: -myocamlbuild_config.cmx: -objinfo.cmo: ../utils/config.cmi ../bytecomp/cmo_format.cmi -objinfo.cmx: ../utils/config.cmx ../bytecomp/cmo_format.cmi -ocaml299to3.cmo: -ocaml299to3.cmx: -ocamlcp.cmo: ../driver/main_args.cmi -ocamlcp.cmx: ../driver/main_args.cmx + ../parsing/asttypes.cmi +lexer301.cmo: ../utils/warnings.cmi ../utils/misc.cmi ../parsing/location.cmi +lexer301.cmx: ../utils/warnings.cmx ../utils/misc.cmx ../parsing/location.cmx +myocamlbuild_config.cmo: +myocamlbuild_config.cmx: +objinfo.cmo: ../utils/config.cmi ../bytecomp/cmo_format.cmi +objinfo.cmx: ../utils/config.cmx ../bytecomp/cmo_format.cmi +ocaml299to3.cmo: +ocaml299to3.cmx: +ocamlcp.cmo: ../driver/main_args.cmi +ocamlcp.cmx: ../driver/main_args.cmx ocamldep.cmo: ../parsing/syntaxerr.cmi ../parsing/parsetree.cmi \ ../parsing/parse.cmi ../utils/misc.cmi ../parsing/longident.cmi \ ../parsing/location.cmi ../parsing/lexer.cmi depend.cmi \ - ../utils/config.cmi ../utils/clflags.cmi + ../utils/config.cmi ../utils/clflags.cmi ocamldep.cmx: ../parsing/syntaxerr.cmx ../parsing/parsetree.cmi \ ../parsing/parse.cmx ../utils/misc.cmx ../parsing/longident.cmx \ ../parsing/location.cmx ../parsing/lexer.cmx depend.cmx \ - ../utils/config.cmx ../utils/clflags.cmx -ocamlmklib.cmo: myocamlbuild_config.cmo -ocamlmklib.cmx: myocamlbuild_config.cmx -ocamlmktop.cmo: ../utils/ccomp.cmi -ocamlmktop.cmx: ../utils/ccomp.cmx + ../utils/config.cmx ../utils/clflags.cmx +ocamlmklib.cmo: myocamlbuild_config.cmo +ocamlmklib.cmx: myocamlbuild_config.cmx +ocamlmktop.cmo: ../utils/ccomp.cmi +ocamlmktop.cmx: ../utils/ccomp.cmx ocamlprof.cmo: ../utils/warnings.cmi ../parsing/syntaxerr.cmi \ ../parsing/parsetree.cmi ../parsing/parse.cmi ../utils/misc.cmi \ ../parsing/location.cmi ../parsing/lexer.cmi ../utils/config.cmi \ - ../utils/clflags.cmi + ../utils/clflags.cmi ocamlprof.cmx: ../utils/warnings.cmx ../parsing/syntaxerr.cmx \ ../parsing/parsetree.cmi ../parsing/parse.cmx ../utils/misc.cmx \ ../parsing/location.cmx ../parsing/lexer.cmx ../utils/config.cmx \ - ../utils/clflags.cmx -opnames.cmo: -opnames.cmx: -primreq.cmo: ../utils/config.cmi ../bytecomp/cmo_format.cmi -primreq.cmx: ../utils/config.cmx ../bytecomp/cmo_format.cmi -profiling.cmo: profiling.cmi -profiling.cmx: profiling.cmi -scrapelabels.cmo: lexer301.cmo -scrapelabels.cmx: lexer301.cmx + ../utils/clflags.cmx +opnames.cmo: +opnames.cmx: +primreq.cmo: ../utils/config.cmi ../bytecomp/cmo_format.cmi +primreq.cmx: ../utils/config.cmx ../bytecomp/cmo_format.cmi +profiling.cmo: profiling.cmi +profiling.cmx: profiling.cmi +scrapelabels.cmo: lexer301.cmo +scrapelabels.cmx: lexer301.cmx diff --git a/tools/ocamlmklib.mlp b/tools/ocamlmklib.mlp index 3c9f78a1b..80c1d9f4a 100644 --- a/tools/ocamlmklib.mlp +++ b/tools/ocamlmklib.mlp @@ -15,6 +15,11 @@ open Printf open Myocamlbuild_config +(* PR#4783: under Windows, don't use absolute paths because we do + not know where the binary distribution will be installed. *) +let compiler_path name = + if Sys.os_type = "Win32" then name else Filename.concat bindir name + let bytecode_objs = ref [] (* .cmo,.cma,.ml,.mli files to pass to ocamlc *) and native_objs = ref [] (* .cmx,.cmxa,.ml,.mli files to pass to ocamlopt *) and c_objs = ref [] (* .o, .a, .obj, .lib, .dll files to pass to mksharedlib and ar *) @@ -25,8 +30,8 @@ and failsafe = ref false (* whether to fall back on static build only *) and c_libs = ref [] (* libs to pass to mksharedlib and ocamlc -cclib *) 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 (Filename.concat bindir "ocamlc") -and ocamlopt = ref (Filename.concat bindir "ocamlopt") +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_c = ref "" (* Output name for C part of library *) and rpath = ref [] (* rpath options *) @@ -123,9 +128,8 @@ let parse_arguments argv = done; List.iter (fun r -> r := List.rev !r) - [ bytecode_objs; native_objs; c_objs; caml_libs; caml_opts; + [ bytecode_objs; native_objs; caml_libs; caml_opts; c_libs; c_objs; c_opts; ld_opts; rpath ]; - (* On retourne deux fois c_objs ?? -- AF *) if !output_c = "" then output_c := !output @@ -184,7 +188,7 @@ let make_rpath flag = else flag ^ String.concat ":" (make_set !rpath) let make_rpath_ccopt flag = - if !rpath = [] || flag = "" + if !rpath = [] || flag = "" then "" else "-ccopt " ^ flag ^ String.concat ":" (make_set !rpath) @@ -200,10 +204,10 @@ let prepostfix pre name post = let transl_path s = match Sys.os_type with | "Win32" -> - let rec aux i = - if i = String.length s || s.[i] = ' ' then s - else (if s.[i] = '/' then s.[i] <- '\\'; aux (i + 1)) - in aux 0 + let rec aux i = + if i = String.length s || s.[i] = ' ' then s + else (if s.[i] = '/' then s.[i] <- '\\'; aux (i + 1)) + in aux 0 | _ -> s let build_libs () = diff --git a/typing/ctype.ml b/typing/ctype.ml index 441b777af..316a8d942 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -3343,42 +3343,43 @@ let nondep_type env id ty = let nondep_type_decl env mid id is_covariant decl = try let params = List.map (nondep_type_rec env mid) decl.type_params in - let decl = - { type_params = params; - type_arity = decl.type_arity; - type_kind = - begin try - match decl.type_kind with - Type_abstract -> - Type_abstract - | Type_variant cstrs -> - Type_variant(List.map - (fun (c, tl) -> (c, List.map (nondep_type_rec env mid) tl)) - cstrs) - | Type_record(lbls, rep) -> - Type_record( - List.map - (fun (c, mut, t) -> (c, mut, nondep_type_rec env mid t)) - lbls, - rep) - with Not_found when is_covariant -> - Type_abstract - end; - type_manifest = - begin try - match decl.type_manifest with - None -> None - | Some ty -> - Some (unroll_abbrev id params (nondep_type_rec env mid ty)) - with Not_found when is_covariant -> - None - end; - type_private = decl.type_private; - type_variance = decl.type_variance; - } + let tk = + try match decl.type_kind with + Type_abstract -> + Type_abstract + | Type_variant cstrs -> + Type_variant + (List.map + (fun (c, tl) -> (c, List.map (nondep_type_rec env mid) tl)) + cstrs) + | Type_record(lbls, rep) -> + Type_record + (List.map + (fun (c, mut, t) -> (c, mut, nondep_type_rec env mid t)) + lbls, + rep) + with Not_found when is_covariant -> Type_abstract + and tm = + try match decl.type_manifest with + None -> None + | Some ty -> + Some (unroll_abbrev id params (nondep_type_rec env mid ty)) + with Not_found when is_covariant -> + None in clear_hash (); - decl + let priv = + match tm with + | Some ty when Btype.has_constr_row ty -> Private + | _ -> decl.type_private + in + { type_params = params; + type_arity = decl.type_arity; + type_kind = tk; + type_manifest = tm; + type_private = priv; + type_variance = decl.type_variance; + } with Not_found -> clear_hash (); raise Not_found diff --git a/typing/includecore.ml b/typing/includecore.ml index 155048872..16c048b5c 100644 --- a/typing/includecore.ml +++ b/typing/includecore.ml @@ -40,7 +40,8 @@ let value_descriptions env vd1 vd2 = let private_flags decl1 decl2 = match decl1.type_private, decl2.type_private with | Private, Public -> - decl2.type_kind = Type_abstract && decl2.type_manifest = None + decl2.type_kind = Type_abstract && + (decl2.type_manifest = None || decl1.type_kind <> Type_abstract) | _, _ -> true (* Inclusion between manifest types (particularly for private row types) *) diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 016a2a226..6ee97aa60 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -184,11 +184,7 @@ let transl_declaration env (name, sdecl) id = None -> None | Some sty -> let no_row = not (is_fixed_type sdecl) in - let ty = - transl_simple_type env no_row sty in - if Ctype.cyclic_abbrev env id ty then - raise(Error(sdecl.ptype_loc, Recursive_abbrev name)); - Some ty + Some (transl_simple_type env no_row sty) end; type_variance = List.map (fun _ -> true, true, true) params; } in @@ -200,12 +196,19 @@ let transl_declaration env (name, sdecl) id = raise(Error(loc, Unconsistent_constraint tr))) cstrs; Ctype.end_def (); + (* Add abstract row *) if is_fixed_type sdecl then begin let (p, _) = try Env.lookup_type (Longident.Lident(Ident.name id ^ "#row")) env with Not_found -> assert false in set_fixed_row env sdecl.ptype_loc p decl end; + (* Check for cyclic abbreviations *) + begin match decl.type_manifest with None -> () + | Some ty -> + if Ctype.cyclic_abbrev env id ty then + raise(Error(sdecl.ptype_loc, Recursive_abbrev name)); + end; (id, decl) (* Generalize a type declaration *) diff --git a/typing/typetexp.ml b/typing/typetexp.ml index 60b24c382..e9f0c2eda 100644 --- a/typing/typetexp.ml +++ b/typing/typetexp.ml @@ -40,6 +40,7 @@ type error = | Invalid_variable_name of string | Cannot_quantify of string * type_expr | Multiple_constraints_on_type of string + | Repeated_method_label of string exception Error of Location.t * error @@ -185,7 +186,7 @@ let rec transl_type env policy styp = end; constr | Ptyp_object fields -> - newobj (transl_fields env policy fields) + newobj (transl_fields env policy [] fields) | Ptyp_class(lid, stl, present) -> let (path, decl, is_variant) = try @@ -421,15 +422,16 @@ let rec transl_type env policy styp = List.map fst l, List.map (transl_type env policy) (List.map snd l))) -and transl_fields env policy = +and transl_fields env policy seen = function [] -> newty Tnil | {pfield_desc = Pfield_var}::_ -> if policy = Univars then new_pre_univar () else newvar () - | {pfield_desc = Pfield(s, e)}::l -> + | {pfield_desc = Pfield(s, e); pfield_loc = loc}::l -> + if List.mem s seen then raise (Error (loc, Repeated_method_label s)); let ty1 = transl_type env policy e in - let ty2 = transl_fields env policy l in + let ty2 = transl_fields env policy (s::seen) l in newty (Tfield (s, Fpresent, ty1, ty2)) @@ -599,3 +601,6 @@ let report_error ppf = function else "it is not a variable") | Multiple_constraints_on_type s -> fprintf ppf "Multiple constraints for type %s" s + | Repeated_method_label s -> + fprintf ppf "@[This is the second method `%s' of this object type.@ %s@]" + s "Multiple occurences are not allowed." diff --git a/typing/typetexp.mli b/typing/typetexp.mli index 47b6fef26..5687b955d 100644 --- a/typing/typetexp.mli +++ b/typing/typetexp.mli @@ -55,6 +55,7 @@ type error = | Invalid_variable_name of string | Cannot_quantify of string * Types.type_expr | Multiple_constraints_on_type of string + | Repeated_method_label of string exception Error of Location.t * error diff --git a/utils/warnings.ml b/utils/warnings.ml index 58a878214..c827858b7 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -178,7 +178,7 @@ let parse_opt flags s = let parse_options errflag s = parse_opt (if errflag then error else active) s;; -let defaults_w = "+a-4-6-9-27-28";; +let defaults_w = "+a-4-6-9-27-28-29";; let defaults_warn_error = "-a";; let () = parse_options false defaults_w;; |