diff options
148 files changed, 1934 insertions, 929 deletions
@@ -28,12 +28,13 @@ parsing/ast_helper.cmi : parsing/parsetree.cmi parsing/longident.cmi \ parsing/location.cmi parsing/docstrings.cmi parsing/asttypes.cmi parsing/ast_mapper.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/asttypes.cmi : parsing/location.cmi -parsing/docstrings.cmi : parsing/location.cmi parsing/parsetree.cmi +parsing/docstrings.cmi : parsing/parsetree.cmi parsing/location.cmi parsing/lexer.cmi : parsing/parser.cmi parsing/location.cmi parsing/location.cmi : utils/warnings.cmi parsing/longident.cmi : parsing/parse.cmi : parsing/parsetree.cmi -parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi +parsing/parser.cmi : parsing/parsetree.cmi parsing/location.cmi \ + parsing/docstrings.cmi parsing/parsetree.cmi : parsing/longident.cmi parsing/location.cmi \ parsing/asttypes.cmi parsing/pprintast.cmi : parsing/parsetree.cmi parsing/longident.cmi \ @@ -54,10 +55,10 @@ parsing/ast_mapper.cmx : parsing/parsetree.cmi utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx utils/config.cmx \ utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \ parsing/ast_mapper.cmi -parsing/docstrings.cmo : utils/warnings.cmi parsing/location.cmi \ - parsing/docstrings.cmi -parsing/docstrings.cmx : utils/warnings.cmx parsing/location.cmx \ - parsing/docstrings.cmi +parsing/docstrings.cmo : utils/warnings.cmi parsing/parsetree.cmi \ + parsing/location.cmi parsing/asttypes.cmi parsing/docstrings.cmi +parsing/docstrings.cmx : utils/warnings.cmx parsing/parsetree.cmi \ + parsing/location.cmx parsing/asttypes.cmi parsing/docstrings.cmi parsing/lexer.cmo : utils/warnings.cmi parsing/parser.cmi utils/misc.cmi \ parsing/location.cmi parsing/docstrings.cmi parsing/lexer.cmi parsing/lexer.cmx : utils/warnings.cmx parsing/parser.cmx utils/misc.cmx \ @@ -75,11 +76,13 @@ parsing/parse.cmx : parsing/syntaxerr.cmx parsing/parser.cmx \ parsing/location.cmx parsing/lexer.cmx parsing/docstrings.cmx \ parsing/parse.cmi parsing/parser.cmo : parsing/syntaxerr.cmi parsing/parsetree.cmi \ - parsing/longident.cmi parsing/location.cmi utils/clflags.cmi \ - parsing/asttypes.cmi parsing/ast_helper.cmi parsing/parser.cmi + parsing/longident.cmi parsing/location.cmi parsing/docstrings.cmi \ + utils/clflags.cmi parsing/asttypes.cmi parsing/ast_helper.cmi \ + parsing/parser.cmi parsing/parser.cmx : parsing/syntaxerr.cmx parsing/parsetree.cmi \ - parsing/longident.cmx parsing/location.cmx utils/clflags.cmx \ - parsing/asttypes.cmi parsing/ast_helper.cmx parsing/parser.cmi + parsing/longident.cmx parsing/location.cmx parsing/docstrings.cmx \ + utils/clflags.cmx parsing/asttypes.cmi parsing/ast_helper.cmx \ + parsing/parser.cmi parsing/pprintast.cmo : parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \ parsing/pprintast.cmi @@ -458,15 +461,17 @@ bytecomp/bytelibrarian.cmx : utils/misc.cmx parsing/location.cmx \ utils/config.cmx bytecomp/cmo_format.cmi utils/clflags.cmx \ bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmi bytecomp/bytelink.cmo : utils/warnings.cmi bytecomp/symtable.cmi \ - bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi typing/ident.cmi \ - bytecomp/dll.cmi utils/consistbl.cmi utils/config.cmi \ - bytecomp/cmo_format.cmi utils/clflags.cmi utils/ccomp.cmi \ - bytecomp/bytesections.cmi bytecomp/bytelink.cmi + bytecomp/opcodes.cmo utils/misc.cmi parsing/location.cmi \ + bytecomp/instruct.cmi typing/ident.cmi bytecomp/dll.cmi \ + utils/consistbl.cmi utils/config.cmi bytecomp/cmo_format.cmi \ + utils/clflags.cmi utils/ccomp.cmi bytecomp/bytesections.cmi \ + bytecomp/bytelink.cmi bytecomp/bytelink.cmx : utils/warnings.cmx bytecomp/symtable.cmx \ - bytecomp/opcodes.cmx utils/misc.cmx parsing/location.cmx typing/ident.cmx \ - bytecomp/dll.cmx utils/consistbl.cmx utils/config.cmx \ - bytecomp/cmo_format.cmi utils/clflags.cmx utils/ccomp.cmx \ - bytecomp/bytesections.cmx bytecomp/bytelink.cmi + bytecomp/opcodes.cmx utils/misc.cmx parsing/location.cmx \ + bytecomp/instruct.cmx typing/ident.cmx bytecomp/dll.cmx \ + utils/consistbl.cmx utils/config.cmx bytecomp/cmo_format.cmi \ + utils/clflags.cmx utils/ccomp.cmx bytecomp/bytesections.cmx \ + bytecomp/bytelink.cmi bytecomp/bytepackager.cmo : typing/typemod.cmi bytecomp/translmod.cmi \ typing/subst.cmi bytecomp/printlambda.cmi typing/path.cmi utils/misc.cmi \ parsing/location.cmi bytecomp/instruct.cmi typing/ident.cmi \ @@ -549,12 +554,12 @@ bytecomp/switch.cmo : bytecomp/switch.cmi bytecomp/switch.cmx : bytecomp/switch.cmi bytecomp/symtable.cmo : utils/tbl.cmi bytecomp/runtimedef.cmi \ typing/predef.cmi utils/misc.cmi bytecomp/meta.cmi parsing/location.cmi \ - bytecomp/lambda.cmi typing/ident.cmi bytecomp/dll.cmi \ + bytecomp/lambda.cmi typing/ident.cmi bytecomp/dll.cmi utils/config.cmi \ bytecomp/cmo_format.cmi utils/clflags.cmi bytecomp/bytesections.cmi \ parsing/asttypes.cmi bytecomp/symtable.cmi bytecomp/symtable.cmx : utils/tbl.cmx bytecomp/runtimedef.cmx \ typing/predef.cmx utils/misc.cmx bytecomp/meta.cmx parsing/location.cmx \ - bytecomp/lambda.cmx typing/ident.cmx bytecomp/dll.cmx \ + bytecomp/lambda.cmx typing/ident.cmx bytecomp/dll.cmx utils/config.cmx \ bytecomp/cmo_format.cmi utils/clflags.cmx bytecomp/bytesections.cmx \ parsing/asttypes.cmi bytecomp/symtable.cmi bytecomp/translclass.cmo : typing/types.cmi bytecomp/typeopt.cmi \ @@ -611,6 +616,8 @@ asmcomp/asmgen.cmi : bytecomp/lambda.cmi asmcomp/cmm.cmi asmcomp/asmlibrarian.cmi : asmcomp/asmlink.cmi : asmcomp/cmx_format.cmi asmcomp/asmpackager.cmi : typing/env.cmi +asmcomp/branch_relaxation.cmi : asmcomp/linearize.cmi \ + asmcomp/branch_relaxation_intf.cmo asmcomp/clambda.cmi : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/closure.cmi : bytecomp/lambda.cmi asmcomp/clambda.cmi @@ -705,6 +712,14 @@ asmcomp/asmpackager.cmx : typing/typemod.cmx bytecomp/translmod.cmx \ utils/config.cmx asmcomp/compilenv.cmx asmcomp/cmx_format.cmi \ utils/clflags.cmx utils/ccomp.cmx asmcomp/asmlink.cmx asmcomp/asmgen.cmx \ asmcomp/asmpackager.cmi +asmcomp/branch_relaxation_intf.cmo : asmcomp/linearize.cmi asmcomp/arch.cmo +asmcomp/branch_relaxation_intf.cmx : asmcomp/linearize.cmx asmcomp/arch.cmx +asmcomp/branch_relaxation.cmo : utils/misc.cmi asmcomp/mach.cmi \ + asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/branch_relaxation_intf.cmo \ + asmcomp/branch_relaxation.cmi +asmcomp/branch_relaxation.cmx : utils/misc.cmx asmcomp/mach.cmx \ + asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/branch_relaxation_intf.cmx \ + asmcomp/branch_relaxation.cmi asmcomp/clambda.cmo : bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/clambda.cmi asmcomp/clambda.cmx : bytecomp/lambda.cmx typing/ident.cmx \ @@ -778,13 +793,15 @@ asmcomp/emit.cmo : asmcomp/x86_proc.cmi asmcomp/x86_masm.cmi \ asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi bytecomp/lambda.cmi asmcomp/emitaux.cmi \ asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ - asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi + asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi \ + asmcomp/branch_relaxation.cmi asmcomp/emit.cmx : asmcomp/x86_proc.cmx asmcomp/x86_masm.cmx \ asmcomp/x86_gas.cmx asmcomp/x86_dsl.cmx asmcomp/x86_ast.cmi \ asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx bytecomp/lambda.cmx asmcomp/emitaux.cmx \ asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ - asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi + asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi \ + asmcomp/branch_relaxation.cmi asmcomp/interf.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \ asmcomp/interf.cmi asmcomp/interf.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \ diff --git a/.travis-ci.sh b/.travis-ci.sh index da39f62f4e..ab5b3bf204 100644 --- a/.travis-ci.sh +++ b/.travis-ci.sh @@ -3,13 +3,13 @@ i386) ./configure make world.opt sudo make install - cd testsuite && make all && cd .. + (cd testsuite && make all) mkdir external-packages cd external-packages git clone git://github.com/ocaml/camlp4 - cd camlp4 && ./configure && make && sudo make install && cd .. + (cd camlp4 && ./configure && make && sudo make install) git clone git://github.com/ocaml/opam - cd opam && ./configure && make lib-ext && make && sudo make install && cd .. + (cd opam && ./configure && make lib-ext && make && sudo make install) git config --global user.email "some@name.com" git config --global user.name "Some Name" opam init -y -a git://github.com/ocaml/opam-repository @@ -1,5 +1,6 @@ OCaml 4.03.0: ------------- + (Changes that can break existing programs are marked with a "*") Language features: @@ -22,8 +23,6 @@ Language features: - PR#5528: inline records for constructor arguments (Alain Frisch) Compilers: -- PR#6475: accept -o in ocamlc when compiling C files - (Vincent Laporte, Peter Zotov) - PR#6501: harden the native-code generator against certain uses of "%identity" (Xavier Leroy, report by Antoine Miné). - PR#6636: add --version option @@ -156,9 +155,18 @@ Features wishes: - GPR#191: Making gc.h and some part of memory.h public (Thomas Refis) -OCaml 4.02.2: +OCaml 4.02.3: ------------- +Bug fixes: +- PR#6919: corrupted final_table + (ygrek) +- PR#6930: Aliased result type of GADT constructor results in assertion failure + (Jacques Garrigue) + +OCaml 4.02.2 (17 Jun 2015): +--------------------------- + (Changes that can break existing programs are marked with a "*") Language features: @@ -178,11 +186,15 @@ Compilers: (Jacques Garrigue) - PR#6642: replace $CAMLORIGIN in -ccopt with the path to cma or cmxa (Peter Zotov, Gabriel Scherer, review by Damien Doligez) +- PR#6797: new option -output-complete-obj + to output an object file with included runtime and autolink libraries + (Peter Zotov) - PR#6845: -no-check-prims to tell ocamlc not to check primitives in runtime (Alain Frisch) +- GPR#149: Attach documentation comments to parse tree + (Leo White) - GPR#159: Better locations for structure/signature items (Leo White) -- GPR#149: Attach documentation comments to parse tree (Leo White) Toplevel and debugger: - PR#5958: generalized polymorphic #install_printer @@ -210,21 +222,54 @@ OCamlbuild: Libraries: - PR#6285: Add support for nanosecond precision in Unix.stat() (Jérémie Dimino, report by user 'gfxmonk') +- PR#6781: Add higher baud rates to Unix termios + (Damien Doligez, report by Berke Durak) +- PR#6834: Add Obj.{first,last}_non_constant_constructor_tag + (Mark Shinwell, request by Gabriel Scherer) + +Libraries: +- PR#6285: Add support for nanosecond precision in Unix.stat() + (Jérémie Dimino, report by user 'gfxmonk') Runtime: - PR#6078: Release the runtime system when calling caml_dlopen (Jérémie Dimino) +- PR#6675: GC hooks + (Damien Doligez and Roshan James) + +Build system: +- PR#5418 (comments) : generate dependencies with $(CC) instead of gcc + (Damien Doligez and Michael Grünewald) +- PR#6266: Cross compilation for iOs, Android etc + (Peter Zotov, review by Damien Doligez and Mark Shinwell) + +Installation procedure: +- Update instructions for x86-64 PIC mode and POWER architecture builds + (Mark Shinwell) Bug fixes: +- PR#5271: Location.prerr_warning is hard-coded to use Format.err_formatter + (Damien Doligez, report by Rolf Rolles) +- PR#5395: OCamlbuild mishandles relative symlinks and include paths + (Damien Doligez, report by Didier Le Botlan) +- PR#5822: wrong value of Options.ext_dll on windows + (Damien Doligez and Daniel Weil) - PR#5836, PR#6684: printing lazy values in ocamldebug may segfault (Gabriel Scherer, request by the Coq team) - PR#5887: move the byterun/*.h headers to byterun/caml/*.h to avoid header name clashes (Jérôme Vouillon and Adrien Nader and Peter Zotov) +- PR#6281: Graphics window does not acknowledge second click (double click) + (Kyle Headley) +- PR#6490: incorrect backtraces in gdb on AArch64. Also fixes incorrect + backtraces on 32-bit ARM. + (Mark Shinwell) - PR#6573: extern "C" for systhreads/threads.h (Mickaël Delahaye) - PR#6575: Array.init evaluates callback although it should not do so (Alain Frisch, report by Gerd Stolpmann) +- PR#6607: The manual doesn't mention 0x200 flag for OCAMLRUNPARAM=v + (Alain Frisch) - PR#6616: allow meaningful use of -use-runtime without -custom. (Peter Zotov) - PR#6617: allow android build with pthreads support (since SDK r10c) @@ -233,12 +278,23 @@ Bug fixes: (Gergely Szilvasy) - PR#6628: Configure script rejects legitimate arguments (Michael Grünewald, Damien Doligez) +- PR#6630: Failure of tests/prim-bigstring/{big,}string.ml on big-endian + architectures + (Pierre Chambart, testing by Mark Shinwell) - PR#6640: ocamlbuild: wrong "unused tag" warning on "precious" (report by user 'william') +- PR#6652: ocamlbuild -clean does not print a newline after output + (Damien Doligez, report by Andi McClure) +- PR#6658: cross-compiler: version check not working on OS X + (Gerd Stolpmann) - PR#6665: Failure of tests/asmcomp on sparc (Stéphane Glondu) +- PR#6667: wrong implementation of %bswap16 on ARM64 + (Xavier Leroy) - PR#6669: fix 4.02 regression in toplevel printing of lazy values (Leo White, review by Gabriel Scherer) +- PR#6671: Windows: environment variable 'TZ' affects Unix.gettimeofday + (Mickael Delahaye and Damien Doligez) - PR#6680: Missing parentheses in warning about polymorphic variant value (Jacques Garrigue and Gabriel Scherer, report by Philippe Veber) - PR#6686: Bug in [subst_boxed_number] @@ -252,46 +308,89 @@ Bug fixes: (Gabriel Scherer, report by Peter Zotov) - PR#6727: Printf.sprintf "%F" misbehavior (Benoît Vaugon, report by Vassili Karpov) +- PR#6747: ocamlobjinfo: missing symbol caml_plugin_header due to underscore + (Damien Doligez, Maverick Woo) - PR#6749: ocamlopt returns n for (n mod 1) instead of 0 (Mark Shinwell and Jérémie Dimino) +- PR#6753: Num.quo_num and Num.mod_num incorrect for some negative arguments + (Xavier Leroy) +- PR#6758: Ocamldoc "analyse_module: parsetree and typedtree don't match" + (Damien Doligez, report by user 'maro') +- PR#6759: big_int_of_string incorrectly parses some hexa literals + (Damien Doligez, report by Pierre-yves Strub) - PR#6763: #show with -short-paths doesn't select shortest type paths (Jacques Garrigue, report by David Sheets) - PR#6768: Typechecker overflow the stack on cyclic type (Jacques Garrigue, report by user 'darktenaibre') +- PR#6770: (duplicate of PR#6686) +- PR#6772: asmrun/signals_asm.c doesn't compile on NetBSD/i386 + (Kenji Tokudome) - PR#6775: Digest.file leaks file descriptor on error (Valentin Gatien-Baron) +- PR#6779: Cross-compilers cannot link bytecode using custom primitives + (Damien Doligez, request by Peter Zotov) - PR#6787: Soundness bug with polymorphic variants (Jacques Garrigue, with help from Leo White and Grégoire Henry, report by Michael O'Connor) +- PR#6790: otherlibs should be built with -g + (Damien Doligez, report by Peter Zotov) - PR#6791: "%s@[", "%s@{" regression in Scanf (Benoît Vaugon) - PR#6793: ocamlbuild passes nonsensical "-ocamlc ..." commands to menhir (Gabriel Scherer, report by Damien Doligez) +- PR#6799: include guards missing for unixsupport.h and other files + (Andreas Hauptmann) +- PR#6810: Improve documentation of Bigarray.Genarray.map_file + (Mark Shinwell and Daniel Bünzli) - PR#6812: -short-paths and -no-alias-deps can create inconsistent assumptions (Jacques Garrigue, report by Valentin Gatien-Baron) - PR#6817: GADT exhaustiveness breakage with modules (Leo White, report by Pierre Chambart) - PR#6824: fix buffer sharing on partial application of Format.asprintf (Gabriel Scherer, report by Alain Frisch) +- PR#6831: Build breaks for -aspp gcc on solaris-like OSs + (John Tibble) - PR#6836: Assertion failure using -short-paths (Jacques Garrigue, report by David Sheets) +- PR#6837: Build profiling libraries on FreeBSD and NetBSD x86-64 + (Mark Shinwell, report by Michael Grünewald) - PR#6841: Changing compilation unit name with -o breaks ocamldebug (Jacques Garrigue, report by Jordan Walke) +- PR#6842: export Typemod.modtype_of_package - PR#6843: record weak dependencies even when the .cmi is missing (Leo White, Gabriel Scherer) - PR#6849: Inverted pattern unification error (Jacques Garrigue, report by Leo White) +- PR#6857: __MODULE__ doesn't give the current module with -o + (Jacques Garrigue, report by Valentin Gatien-Baron) - PR#6862: Exhaustiveness check wrong for class constructor arguments (Jacques Garrigue) +- PR#6869: Improve comment on [Hashtbl.hash_param] + (Mark Shinwell, report by Jun Furuse) - PR#6870: Unsoundness when -rectypes fails to detect non-contractive type (Jacques Garrigue, report by Stephen Dolan) - PR#6872: Type-directed propagation fails to disambiguate variants that are also exception constructors (Jacques Garrigue, report by Romain Beauxis) +- PR#6878: AArch64 backend generates invalid asm: conditional branch + out of range (Mark Shinwell, report by Richard Jones, testing by Richard + Jones and Xavier Leroy, code review by Xavier Leroy and Thomas Refis) +- PR#6879: Wrong optimization of 1 mod n + (Mark Shinwell, report by Jean-Christophe Filliâtre) +- PR#6884: The __CYGWIN32__ #define should be replaced with __CYGWIN__ + (Adrien Nader) - PR#6886: -no-alias-deps allows to build self-referential compilation units - (Jacques Garrigue, report by sliquister) + (Jacques Garrigue, report by Valentin Gatien-Baron) +- PR#6889: ast_mapper fails to rewrite class attributes + (Sébastien Briais) +- PR#6893: ocamlbuild: "tag not used" warning when using (p)dep + (Gabriel Scherer, report by Christiano Haesbaert) - GPR#143: fix getsockopt behaviour for boolean socket options (Anil Madhavapeddy and Andrew Ray) +- GPR#190: typo in pervasives + (Guillaume Bury) +- Misplaced assertion in major_gc.c for no-naked-pointers mode + (Stephen Dolan, Mark Shinwell) Feature wishes: - PR#6452, GPR#140: add internal suport for custom printing formats @@ -302,6 +401,14 @@ Feature wishes: (Peter Zotov, review by Mark Shinwell) - PR#6842: export Typemod.modtype_of_package (Jacques Garrigue, request by Jun Furuse) +- GPR#139: more versatile specification of locations of .annot + (Christophe Troestler, review by Damien Doligez) +- GPR#171: allow custom warning printers / catchers + (Benjamin Canou, review by Damien Doligez) +- Misplaced assertion in major_gc.c for no-naked-pointers mode + (Stephen Dolan, Mark Shinwell) +- GPR#191: Making gc.h and some part of memory.h public + (Thomas Refis) OCaml 4.02.1 (14 Oct 2014): --------------------------- @@ -140,15 +140,24 @@ Examples: or: ./configure -prefix /usr -mandir '$(PREFIX)/man/manl' - On a Linux x86/64 bits host, to build a 32-bit version of OCaml: + On a Linux x86-64 host, to build a 32-bit version of OCaml: ./configure -cc "gcc -m32" -as "as --32" -aspp "gcc -m32 -c" \ -host i386-linux -partialld "ld -r -melf_i386" - On a Linux x86/64 bits host, to build the run-time system in PIC mode - (enables putting the runtime in a shared library, - at a small performance cost): + On a Linux x86-64 host, to build the run-time system in PIC mode, + no special options should be required---the libraries should be built + automatically. The old instructions were: ./configure -cc "gcc -fPIC" -aspp "gcc -c -fPIC" + On a 64-bit POWER architecture host running Linux, OCaml only operates + in a 32-bit environment. If your system compiler is configured as 32-bit, + e.g. Red Hat 5.9, you don't need to do anything special. If that is + not the case (e.g. Red Hat 6.4), then IBM's "Advance Toolchain" can + be used. For example: + export PATH=/opt/at7.0/bin:$PATH + ./configure -cc "gcc -m32" -as "as -a32" -aspp "gcc -m32 -c" \ + -partialld "ld -r -m elf32ppc" + 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" @@ -13,20 +13,20 @@ # The main Makefile include config/Makefile +CAMLRUN ?= boot/ocamlrun +CAMLYACC ?= boot/ocamlyacc include stdlib/StdlibModules -CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot -CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink +CAMLC=$(CAMLRUN) boot/ocamlc -nostdlib -I boot +CAMLOPT=$(CAMLRUN) ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink COMPFLAGS=-strict-sequence -w +33..39+48+50 -warn-error A -bin-annot \ -safe-string $(INCLUDES) LINKFLAGS= -CAMLYACC=boot/ocamlyacc YACCFLAGS=-v -CAMLLEX=boot/ocamlrun boot/ocamllex -CAMLDEP=boot/ocamlrun tools/ocamldep +CAMLLEX=$(CAMLRUN) boot/ocamllex +CAMLDEP=$(CAMLRUN) tools/ocamldep DEPFLAGS=$(INCLUDES) -CAMLRUN=byterun/ocamlrun SHELL=/bin/sh MKDIR=mkdir -p @@ -112,6 +112,8 @@ ASMCOMP=\ asmcomp/deadcode.cmo \ asmcomp/printlinear.cmo asmcomp/linearize.cmo \ asmcomp/schedgen.cmo asmcomp/scheduling.cmo \ + asmcomp/branch_relaxation_intf.cmo \ + asmcomp/branch_relaxation.cmo \ asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \ asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \ driver/opterrors.cmo driver/optcompile.cmo @@ -335,7 +337,7 @@ install: cp ocaml $(INSTALL_BINDIR)/ocaml$(EXE) cd stdlib; $(MAKE) install cp lex/ocamllex $(INSTALL_BINDIR)/ocamllex$(EXE) - cp yacc/ocamlyacc$(EXE) $(INSTALL_BINDIR)/ocamlyacc$(EXE) + cp $(CAMLYACC)$(EXE) $(INSTALL_BINDIR)/ocamlyacc$(EXE) cp utils/*.cmi utils/*.cmt utils/*.cmti \ parsing/*.cmi parsing/*.cmt parsing/*.cmti \ typing/*.cmi typing/*.cmt typing/*.cmti \ @@ -651,8 +653,7 @@ partialclean:: beforedepend:: asmcomp/emit.ml tools/cvt_emit: tools/cvt_emit.mll - cd tools; \ - $(MAKE) CAMLC="../$(CAMLRUN) ../boot/ocamlc -I ../stdlib" cvt_emit + cd tools && $(MAKE) cvt_emit # The "expunge" utility @@ -700,7 +701,7 @@ library: ocamlc cd stdlib; $(MAKE) all library-cross: - cd stdlib; $(MAKE) RUNTIME=../byterun/ocamlrun all + cd stdlib; $(MAKE) CAMLRUN=../byterun/ocamlrun all libraryopt: cd stdlib; $(MAKE) allopt @@ -774,7 +775,7 @@ alldepend:: otherlibraries: ocamltools for i in $(OTHERLIBRARIES); do \ - (cd otherlibs/$$i; $(MAKE) RUNTIME=$(RUNTIME) all) || exit $$?; \ + (cd otherlibs/$$i; $(MAKE) all) || exit $$?; \ done otherlibrariesopt: diff --git a/Makefile.nt b/Makefile.nt index 20728baa9b..398fb83365 100644 --- a/Makefile.nt +++ b/Makefile.nt @@ -13,18 +13,18 @@ # The main Makefile include config/Makefile +CAMLRUN ?= boot/ocamlrun +CAMLYACC ?= boot/ocamlyacc include stdlib/StdlibModules -CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot -CAMLOPT=boot/ocamlrun ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink +CAMLC=$(CAMLRUN) boot/ocamlc -nostdlib -I boot +CAMLOPT=$(CAMLRUN) ./ocamlopt -nostdlib -I stdlib -I otherlibs/dynlink COMPFLAGS=-strict-sequence -w +33..39+48 -warn-error A -bin-annot $(INCLUDES) LINKFLAGS= -CAMLYACC=boot/ocamlyacc YACCFLAGS= -CAMLLEX=boot/ocamlrun boot/ocamllex -CAMLDEP=boot/ocamlrun tools/ocamldep +CAMLLEX=$(CAMLRUN) boot/ocamllex +CAMLDEP=$(CAMLRUN) tools/ocamldep DEPFLAGS=$(INCLUDES) -CAMLRUN=byterun/ocamlrun OCAMLBUILDBYTE=$(WITH_OCAMLBUILD:=.byte) OCAMLBUILDNATIVE=$(WITH_OCAMLBUILD:=.native) @@ -299,7 +299,9 @@ installopt: if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKEREC) installopt); fi if test -n "$(WITH_OCAMLBUILD)"; then (cd ocamlbuild; $(MAKE) installopt); \ else :; fi - for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i installopt; done + for i in $(OTHERLIBRARIES); do \ + $(MAKEREC) -C otherlibs/$$i installopt || exit $$?; \ + done if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi cd tools; $(MAKE) installopt @@ -566,7 +568,7 @@ beforedepend:: asmcomp/scheduling.ml # Preprocess the code emitters asmcomp/emit.ml: asmcomp/$(ARCH)/emit.mlp tools/cvt_emit - boot/ocamlrun tools/cvt_emit < asmcomp/$(ARCH)/emit.mlp > asmcomp/emit.ml + $(CAMLRUN) tools/cvt_emit < asmcomp/$(ARCH)/emit.mlp > asmcomp/emit.ml partialclean:: rm -f asmcomp/emit.ml @@ -619,7 +621,7 @@ alldepend:: library: cd stdlib ; $(MAKEREC) all library-cross: - cd stdlib ; $(MAKEREC) RUNTIME=../byterun/ocamlrun all + cd stdlib ; $(MAKEREC) CAMLRUN=../byterun/ocamlrun all libraryopt: cd stdlib ; $(MAKEREC) allopt partialclean:: @@ -675,15 +677,25 @@ alldepend:: # The extra libraries otherlibraries: - for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i all; done + for i in $(OTHERLIBRARIES); do \ + $(MAKEREC) -C otherlibs/$$i all || exit $$?; \ + done otherlibrariesopt: - for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i allopt; done + for i in $(OTHERLIBRARIES); \ + do $(MAKEREC) -C otherlibs/$$i allopt || exit $$?; \ + done partialclean:: - for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i partialclean; done + for i in $(OTHERLIBRARIES); \ + do $(MAKEREC) -C otherlibs/$$i partialclean || exit $$?; \ + done clean:: - for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i clean; done + for i in $(OTHERLIBRARIES); do \ + $(MAKEREC) -C otherlibs/$$i clean || exit $$?; \ + done alldepend:: - for i in $(OTHERLIBRARIES); do $(MAKEREC) -C otherlibs/$$i depend; done + for i in $(OTHERLIBRARIES); do \ + $(MAKEREC) -C otherlibs/$$i depend || exit $$?; \ + done # The replay debugger @@ -745,6 +757,7 @@ alldepend:: depend distclean: $(MAKE) clean + rm -f asmrun/.depend.nt byterun/.depend.nt rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader boot/ocamlyacc \ boot/*.cm* boot/libcamlrun.a rm -f config/Makefile config/m.h config/s.h @@ -1,4 +1,4 @@ -4.03.0+dev7-2015-02-08 +4.03.0+dev8-2015-07-15 # The version string is the first line of this file. # It must be in the format described in stdlib/sys.mli diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index edf7dc2023..bef3af22e0 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -26,6 +26,12 @@ open X86_ast open X86_proc open X86_dsl +(* [Branch_relaxation] is not used in this file, but is required by + emit.mlp files for certain other targets; the reference here ensures + that when releases are being prepared the .depend files are correct + for all targets. *) +open! Branch_relaxation + let _label s = D.label ~typ:QWORD s (* Override proc.ml *) diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 222c39fa8a..c8378a554f 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -852,8 +852,10 @@ let fundecl fundecl = let n = frame_size() in if n > 0 then begin ignore(emit_stack_adjustment (-n)); - if !contains_calls then + if !contains_calls then begin + cfi_offset ~reg:14 (* lr *) ~offset:(-4); ` str lr, [sp, #{emit_int(n - 4)}]\n` + end end; `{emit_label !tailrec_entry_point}:\n`; emit_all 0 fundecl.fun_body; diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml index bfbe183fbd..3e62da89ff 100644 --- a/asmcomp/arm64/arch.ml +++ b/asmcomp/arm64/arch.ml @@ -34,8 +34,12 @@ type addressing_mode = (* Specific operations *) type specific_operation = + | Ifar_alloc of int + | Ifar_intop_checkbound + | Ifar_intop_imm_checkbound of int | Ishiftarith of arith_operation * int | Ishiftcheckbound of int + | Ifar_shiftcheckbound of int | Imuladd (* multiply and add *) | Imulsub (* multiply and subtract *) | Inegmulf (* floating-point negate and multiply *) @@ -91,6 +95,12 @@ let print_addressing printreg addr ppf arg = let print_specific_operation printreg op ppf arg = match op with + | Ifar_alloc n -> + fprintf ppf "(far) alloc %i" n + | Ifar_intop_checkbound -> + fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1) + | Ifar_intop_imm_checkbound n -> + fprintf ppf "%a (far) check > %i" printreg arg.(0) n | Ishiftarith(op, shift) -> let op_name = function | Ishiftadd -> "+" @@ -103,6 +113,9 @@ let print_specific_operation printreg op ppf arg = printreg arg.(0) (op_name op) printreg arg.(1) shift_mark | Ishiftcheckbound n -> fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1) + | Ifar_shiftcheckbound n -> + fprintf ppf + "(far) check %a >> %i > %a" printreg arg.(0) n printreg arg.(1) | Imuladd -> fprintf ppf "(%a * %a) + %a" printreg arg.(0) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 734bd23e15..750c2b2379 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -231,6 +231,32 @@ let emit_intconst dst n = in if n < 0n then emit_neg true 48 else emit_pos true 48 +let num_instructions_for_intconst n = + let num_instructions = ref 0 in + let rec count_pos first shift = + if shift < 0 then begin + if first then incr num_instructions + end else begin + let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in + if s = 0n then count_pos first (shift - 16) else begin + incr num_instructions; + count_pos false (shift - 16) + end + end + and count_neg first shift = + if shift < 0 then begin + if first then incr num_instructions + end else begin + let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in + if s = 0xFFFFn then count_neg first (shift - 16) else begin + incr num_instructions; + count_neg false (shift - 16) + end + end + in + if n < 0n then count_neg true 48 else count_pos true 48; + !num_instructions + (* Recognize float constants appropriate for FMOV dst, #fpimm instruction: "a normalized binary floating point encoding with 1 sign bit, 4 bits of fraction and a 3-bit exponent" *) @@ -302,6 +328,217 @@ let emit_load_symbol_addr dst s = ` ldr {emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n` end +(* The following functions are used for calculating the sizes of the + call GC and bounds check points emitted out-of-line from the function + body. See branch_relaxation.mli. *) + +let num_call_gc_and_check_bound_points instr = + let rec loop instr ((call_gc, check_bound) as totals) = + match instr.desc with + | Lend -> totals + | Lop (Ialloc _) when !fastcode_flag -> + loop instr.next (call_gc + 1, check_bound) + | Lop (Iintop Icheckbound) + | Lop (Iintop_imm (Icheckbound, _)) + | Lop (Ispecific (Ishiftcheckbound _)) -> + let check_bound = + (* When not in debug mode, there is at most one check-bound point. *) + if not !Clflags.debug then 1 + else check_bound + 1 + in + loop instr.next (call_gc, check_bound) + (* The following four should never be seen, since this function is run + before branch relaxation. *) + | Lop (Ispecific (Ifar_alloc _)) + | Lop (Ispecific Ifar_intop_checkbound) + | Lop (Ispecific (Ifar_intop_imm_checkbound _)) + | Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false + | _ -> loop instr.next totals + in + loop instr (0, 0) + +let max_out_of_line_code_offset instr ~num_call_gc ~num_check_bound = + if num_call_gc < 1 && num_check_bound < 1 then 0 + else begin + let size_of_call_gc = 2 in + let size_of_check_bound = 1 in + let size_of_last_thing = + (* Call-GC points come before check-bound points. *) + if num_check_bound >= 1 then size_of_check_bound else size_of_call_gc + in + let total_size = + size_of_call_gc*num_call_gc + size_of_check_bound*num_check_bound + in + let max_offset = total_size - size_of_last_thing in + assert (max_offset >= 0); + max_offset + end + +module BR = Branch_relaxation.Make (struct + (* CR-someday mshinwell: B and BL have +/- 128Mb ranges; for the moment we + assume we will never exceed this. It would seem to be most likely to + occur for branches between functions; in this case, the linker should be + able to insert veneers anyway. (See section 4.6.7 of the document + "ELF for the ARM 64-bit architecture (AArch64)".) *) + + type distance = int + + module Cond_branch = struct + type t = TB | CB | Bcc + + let all = [TB; CB; Bcc] + + (* AArch64 instructions are 32 bits wide, so [distance] in this module + means units of 32-bit words. *) + let max_displacement = function + | TB -> 32 * 1024 / 4 (* +/- 32Kb *) + | CB | Bcc -> 1 * 1024 * 1024 / 4 (* +/- 1Mb *) + + let classify_instr = function + | Lop (Ialloc _) + | Lop (Iintop Icheckbound) + | Lop (Iintop_imm (Icheckbound, _)) + | Lop (Ispecific (Ishiftcheckbound _)) -> Some Bcc + (* The various "far" variants in [specific_operation] don't need to + return [Some] here, since their code sequences never contain any + conditional branches that might need relaxing. *) + | Lcondbranch (Itruetest, _) + | Lcondbranch (Ifalsetest, _) -> Some CB + | Lcondbranch (Iinttest _, _) + | Lcondbranch (Iinttest_imm _, _) + | Lcondbranch (Ifloattest _, _) -> Some Bcc + | Lcondbranch (Ioddtest, _) + | Lcondbranch (Ieventest, _) -> Some TB + | Lcondbranch3 _ -> Some Bcc + | _ -> None + end + + let offset_pc_at_branch = 0 + + let epilogue_size () = + if !contains_calls then 3 else 2 + + let instr_size = function + | Lend -> 0 + | Lop (Imove | Ispill | Ireload) -> 1 + | Lop (Iconst_int n | Iconst_blockheader n) -> + num_instructions_for_intconst n + | Lop (Iconst_float _) -> 2 + | Lop (Iconst_symbol _) -> 2 + | Lop (Icall_ind) -> 1 + | Lop (Icall_imm _) -> 1 + | Lop (Itailcall_ind) -> epilogue_size () + | Lop (Itailcall_imm s) -> + if s = !function_name then 1 else epilogue_size () + | Lop (Iextcall (_, false)) -> 1 + | Lop (Iextcall (_, true)) -> 3 + | Lop (Istackoffset _) -> 2 + | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) -> + let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in + based + begin match size with Single -> 2 | _ -> 1 end + | Lop (Ialloc _) when !fastcode_flag -> 4 + | Lop (Ispecific (Ifar_alloc _)) when !fastcode_flag -> 5 + | Lop (Ialloc num_words) | Lop (Ispecific (Ifar_alloc num_words)) -> + begin match num_words with + | 16 | 24 | 32 -> 1 + | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_words) + end + | Lop (Iintop (Icomp _)) -> 2 + | Lop (Iintop_imm (Icomp _, _)) -> 2 + | Lop (Iintop Icheckbound) -> 2 + | Lop (Ispecific Ifar_intop_checkbound) -> 3 + | Lop (Iintop_imm (Icheckbound, _)) -> 2 + | Lop (Ispecific (Ifar_intop_imm_checkbound _)) -> 3 + | Lop (Ispecific (Ishiftcheckbound _)) -> 2 + | Lop (Ispecific (Ifar_shiftcheckbound _)) -> 3 + | Lop (Iintop Imod) -> 2 + | Lop (Iintop Imulh) -> 1 + | Lop (Iintop _) -> 1 + | Lop (Iintop_imm _) -> 1 + | Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1 + | Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1 + | Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1 + | Lop (Ispecific (Ishiftarith _)) -> 1 + | Lop (Ispecific (Imuladd | Imulsub)) -> 1 + | Lop (Ispecific (Ibswap 16)) -> 2 + | Lop (Ispecific (Ibswap _)) -> 1 + | Lreloadretaddr -> 0 + | Lreturn -> epilogue_size () + | Llabel _ -> 0 + | Lbranch _ -> 1 + | Lcondbranch (tst, _) -> + begin match tst with + | Itruetest -> 1 + | Ifalsetest -> 1 + | Iinttest _ -> 2 + | Iinttest_imm _ -> 2 + | Ifloattest _ -> 2 + | Ioddtest -> 1 + | Ieventest -> 1 + end + | Lcondbranch3 (lbl0, lbl1, lbl2) -> + 1 + begin match lbl0 with None -> 0 | Some _ -> 1 end + + begin match lbl1 with None -> 0 | Some _ -> 1 end + + begin match lbl2 with None -> 0 | Some _ -> 1 end + | Lswitch jumptbl -> 3 + Array.length jumptbl + | Lsetuptrap _ -> 2 + | Lpushtrap -> 3 + | Lpoptrap -> 1 + | Lraise k -> + begin match !Clflags.debug, k with + | true, (Lambda.Raise_regular | Lambda.Raise_reraise) -> 1 + | false, _ + | true, Lambda.Raise_notrace -> 4 + end + + let relax_allocation ~num_words = + Lop (Ispecific (Ifar_alloc num_words)) + + let relax_intop_checkbound () = + Lop (Ispecific Ifar_intop_checkbound) + + let relax_intop_imm_checkbound ~bound = + Lop (Ispecific (Ifar_intop_imm_checkbound bound)) + + let relax_specific_op = function + | Ishiftcheckbound shift -> Lop (Ispecific (Ifar_shiftcheckbound shift)) + | _ -> assert false +end) + +(* Output the assembly code for allocation. *) + +let assembly_code_for_allocation i ~n ~far = + let lbl_frame = record_frame_label i.live i.dbg in + if !fastcode_flag then begin + let lbl_redo = new_label() in + let lbl_call_gc = new_label() in + `{emit_label lbl_redo}:`; + ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`; + ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`; + ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`; + if not far then begin + ` b.lo {emit_label lbl_call_gc}\n` + end else begin + let lbl = new_label () in + ` b.cs {emit_label lbl}\n`; + ` b {emit_label lbl_call_gc}\n`; + `{emit_label lbl}:\n` + end; + call_gc_sites := + { gc_lbl = lbl_call_gc; + gc_return_lbl = lbl_redo; + gc_frame_lbl = lbl_frame } :: !call_gc_sites + end else begin + begin match n with + | 16 -> ` bl {emit_symbol "caml_alloc1"}\n` + | 24 -> ` bl {emit_symbol "caml_alloc2"}\n` + | 32 -> ` bl {emit_symbol "caml_alloc3"}\n` + | _ -> emit_intconst reg_x15 (Nativeint.of_int n); + ` bl {emit_symbol "caml_allocN"}\n` + end; + `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n` + end + (* Output the assembly code for an instruction *) let emit_instr i = @@ -410,29 +647,9 @@ let emit_instr i = ` str {emit_reg src}, {emit_addressing addr base}\n` end | Lop(Ialloc n) -> - let lbl_frame = record_frame_label i.live i.dbg in - if !fastcode_flag then begin - let lbl_redo = new_label() in - let lbl_call_gc = new_label() in - `{emit_label lbl_redo}:`; - ` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`; - ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`; - ` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`; - ` b.lo {emit_label lbl_call_gc}\n`; - call_gc_sites := - { gc_lbl = lbl_call_gc; - gc_return_lbl = lbl_redo; - gc_frame_lbl = lbl_frame } :: !call_gc_sites - end else begin - begin match n with - | 16 -> ` bl {emit_symbol "caml_alloc1"}\n` - | 24 -> ` bl {emit_symbol "caml_alloc2"}\n` - | 32 -> ` bl {emit_symbol "caml_alloc3"}\n` - | _ -> emit_intconst reg_x15 (Nativeint.of_int n); - ` bl {emit_symbol "caml_allocN"}\n` - end; - `{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n` - end + assembly_code_for_allocation i ~n ~far:false + | Lop(Ispecific (Ifar_alloc n)) -> + assembly_code_for_allocation i ~n ~far:true | Lop(Iintop(Icomp cmp)) -> ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n` @@ -443,14 +660,35 @@ let emit_instr i = let lbl = bound_error_label i.dbg in ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` b.ls {emit_label lbl}\n` + | Lop(Ispecific Ifar_intop_checkbound) -> + let lbl = bound_error_label i.dbg in + let lbl2 = new_label () in + ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; + ` b.hi {emit_label lbl2}\n`; + ` b {emit_label lbl}\n`; + `{emit_label lbl2}:\n`; | Lop(Iintop_imm(Icheckbound, n)) -> let lbl = bound_error_label i.dbg in ` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`; ` b.ls {emit_label lbl}\n` + | Lop(Ispecific(Ifar_intop_imm_checkbound bound)) -> + let lbl = bound_error_label i.dbg in + let lbl2 = new_label () in + ` cmp {emit_reg i.arg.(0)}, #{emit_int bound}\n`; + ` b.hi {emit_label lbl2}\n`; + ` b {emit_label lbl}\n`; + `{emit_label lbl2}:\n`; | Lop(Ispecific(Ishiftcheckbound shift)) -> let lbl = bound_error_label i.dbg in ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; ` b.cs {emit_label lbl}\n` + | Lop(Ispecific(Ifar_shiftcheckbound shift)) -> + let lbl = bound_error_label i.dbg in + let lbl2 = new_label () in + ` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`; + ` b.lo {emit_label lbl2}\n`; + ` b {emit_label lbl}\n`; + `{emit_label lbl2}:\n`; | Lop(Iintop Imod) -> ` sdiv {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ` msub {emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` @@ -506,7 +744,7 @@ let emit_instr i = begin match size with | 16 -> ` rev16 {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`; - ` ubfm {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #16\n` + ` ubfm {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #15\n` | 32 -> ` rev {emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n` | 64 -> @@ -654,12 +892,24 @@ let fundecl fundecl = let n = frame_size() in if n > 0 then emit_stack_adjustment (-n); - if !contains_calls then - ` str x30, [sp, #{emit_int (n-8)}]\n`; + if !contains_calls then begin + cfi_offset ~reg:30 (* return address *) ~offset:(-8); + ` str x30, [sp, #{emit_int (n-8)}]\n` + end; `{emit_label !tailrec_entry_point}:\n`; + let num_call_gc, num_check_bound = + num_call_gc_and_check_bound_points fundecl.fun_body + in + let max_out_of_line_code_offset = + max_out_of_line_code_offset fundecl.fun_body ~num_call_gc + ~num_check_bound + in + BR.relax fundecl.fun_body ~max_out_of_line_code_offset; emit_all fundecl.fun_body; List.iter emit_call_gc !call_gc_sites; List.iter emit_call_bound_error !bound_error_sites; + assert (List.length !call_gc_sites = num_call_gc); + assert (List.length !bound_error_sites = num_check_bound); cfi_endproc(); ` .type {emit_symbol fundecl.fun_name}, %function\n`; ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 2b7c1a2afe..2be5fdf835 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -277,12 +277,13 @@ let link_shared ppf objfiles output_name = let call_linker file_list startup_file output_name = let main_dll = !Clflags.output_c_object && Filename.check_suffix output_name Config.ext_dll + and main_obj_runtime = !Clflags.output_complete_object in let files = startup_file :: (List.rev file_list) in let files, c_lib = - if (not !Clflags.output_c_object) || main_dll then + if (not !Clflags.output_c_object) || main_dll || main_obj_runtime then files @ (List.rev !Clflags.ccobjs) @ runtime_lib (), - (if !Clflags.nopervasives then "" else Config.native_c_libraries) + (if !Clflags.nopervasives || main_obj_runtime then "" else Config.native_c_libraries) else files, "" in diff --git a/asmcomp/branch_relaxation.ml b/asmcomp/branch_relaxation.ml new file mode 100644 index 0000000000..d4609e4a8e --- /dev/null +++ b/asmcomp/branch_relaxation.ml @@ -0,0 +1,138 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Mark Shinwell, Jane Street Europe *) +(* *) +(* Copyright 1996 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +open Mach +open Linearize + +module Make (T : Branch_relaxation_intf.S) = struct + let label_map code = + let map = Hashtbl.create 37 in + let rec fill_map pc instr = + match instr.desc with + | Lend -> (pc, map) + | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next + | op -> fill_map (pc + T.instr_size op) instr.next + in + fill_map 0 code + + let branch_overflows map pc_branch lbl_dest max_branch_offset = + let pc_dest = Hashtbl.find map lbl_dest in + let delta = pc_dest - (pc_branch + T.offset_pc_at_branch) in + delta <= -max_branch_offset || delta >= max_branch_offset + + let opt_branch_overflows map pc_branch opt_lbl_dest max_branch_offset = + match opt_lbl_dest with + | None -> false + | Some lbl_dest -> + branch_overflows map pc_branch lbl_dest max_branch_offset + + let instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc = + match T.Cond_branch.classify_instr instr.desc with + | None -> false + | Some branch -> + let max_branch_offset = + (* Remember to cut some slack for multi-word instructions (in the + [Linearize] sense of the word) where the branch can be anywhere in + the middle. 12 words of slack is plenty. *) + T.Cond_branch.max_displacement branch - 12 + in + match instr.desc with + | Lop (Ialloc _) + | Lop (Iintop Icheckbound) + | Lop (Iintop_imm (Icheckbound, _)) + | Lop (Ispecific _) -> + (* We assume that any branches eligible for relaxation generated + by these instructions only branch forward. We further assume + that any of these may branch to an out-of-line code block. *) + code_size + max_out_of_line_code_offset - pc >= max_branch_offset + | Lcondbranch (_, lbl) -> + branch_overflows map pc lbl max_branch_offset + | Lcondbranch3 (lbl0, lbl1, lbl2) -> + opt_branch_overflows map pc lbl0 max_branch_offset + || opt_branch_overflows map pc lbl1 max_branch_offset + || opt_branch_overflows map pc lbl2 max_branch_offset + | _ -> + Misc.fatal_error "Unsupported instruction for branch relaxation" + + let fixup_branches ~code_size ~max_out_of_line_code_offset map code = + let expand_optbranch lbl n arg next = + match lbl with + | None -> next + | Some l -> + instr_cons (Lcondbranch (Iinttest_imm (Isigned Cmm.Ceq, n), l)) + arg [||] next + in + let rec fixup did_fix pc instr = + match instr.desc with + | Lend -> did_fix + | _ -> + let overflows = + instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc + in + if not overflows then + fixup did_fix (pc + T.instr_size instr.desc) instr.next + else + match instr.desc with + | Lop (Ialloc num_words) -> + instr.desc <- T.relax_allocation ~num_words; + fixup true (pc + T.instr_size instr.desc) instr.next + | Lop (Iintop Icheckbound) -> + instr.desc <- T.relax_intop_checkbound (); + fixup true (pc + T.instr_size instr.desc) instr.next + | Lop (Iintop_imm (Icheckbound, bound)) -> + instr.desc <- T.relax_intop_imm_checkbound ~bound; + fixup true (pc + T.instr_size instr.desc) instr.next + | Lop (Ispecific specific) -> + instr.desc <- T.relax_specific_op specific; + fixup true (pc + T.instr_size instr.desc) instr.next + | Lcondbranch (test, lbl) -> + let lbl2 = new_label() in + let cont = + instr_cons (Lbranch lbl) [||] [||] + (instr_cons (Llabel lbl2) [||] [||] instr.next) + in + instr.desc <- Lcondbranch (invert_test test, lbl2); + instr.next <- cont; + fixup true (pc + T.instr_size instr.desc) instr.next + | Lcondbranch3 (lbl0, lbl1, lbl2) -> + let cont = + expand_optbranch lbl0 0 instr.arg + (expand_optbranch lbl1 1 instr.arg + (expand_optbranch lbl2 2 instr.arg instr.next)) + in + instr.desc <- cont.desc; + instr.next <- cont.next; + fixup true pc instr + | _ -> + (* Any other instruction has already been rejected in + [instr_overflows] above. + We can *never* get here. *) + assert false + in + fixup false 0 code + + (* Iterate branch expansion till all conditional branches are OK *) + + let rec relax code ~max_out_of_line_code_offset = + let min_of_max_branch_offsets = + List.fold_left (fun min_of_max_branch_offsets branch -> + min min_of_max_branch_offsets + (T.Cond_branch.max_displacement branch)) + max_int T.Cond_branch.all + in + let (code_size, map) = label_map code in + if code_size >= min_of_max_branch_offsets + && fixup_branches ~code_size ~max_out_of_line_code_offset map code + then relax code ~max_out_of_line_code_offset + else () +end diff --git a/asmcomp/branch_relaxation.mli b/asmcomp/branch_relaxation.mli new file mode 100644 index 0000000000..e2a93f83d1 --- /dev/null +++ b/asmcomp/branch_relaxation.mli @@ -0,0 +1,26 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Mark Shinwell, Jane Street Europe *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +(* Fix up conditional branches that exceed hardware-allowed ranges. *) + +module Make (T : Branch_relaxation_intf.S) : sig + val relax + : Linearize.instruction + (* [max_offset_of_out_of_line_code] specifies the furthest distance, + measured from the first address immediately after the last instruction + of the function, that may be branched to from within the function in + order to execute "out of line" code blocks such as call GC and + bounds check points. *) + -> max_out_of_line_code_offset:T.distance + -> unit +end diff --git a/asmcomp/branch_relaxation_intf.ml b/asmcomp/branch_relaxation_intf.ml new file mode 100644 index 0000000000..0812c7c1b8 --- /dev/null +++ b/asmcomp/branch_relaxation_intf.ml @@ -0,0 +1,64 @@ +(***********************************************************************) +(* *) +(* OCaml *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* Mark Shinwell, Jane Street Europe *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(***********************************************************************) + +module type S = sig + (* The distance between two instructions, in arbitrary units (typically + the natural word size of instructions). *) + type distance = int + + module Cond_branch : sig + (* The various types of conditional branches for a given target that + may require relaxation. *) + type t + + (* All values of type [t] that the emitter may produce. *) + val all : t list + + (* If [max_displacement branch] is [n] then [branch] is assumed to + reach any address in the range [pc - n, pc + n] (inclusive), after + the [pc] of the branch has been adjusted by [offset_pc_at_branch] + (see below). *) + val max_displacement : t -> distance + + (* Which variety of conditional branch may be produced by the emitter for a + given instruction description. For the moment we assume that only one + such variety per instruction description is needed. + + N.B. The only instructions supported are the following: + - Lop (Ialloc _) + - Lop (Iintop Icheckbound) + - Lop (Iintop_imm (Icheckbound, _)) + - Lop (Ispecific _) + - Lcondbranch (_, _) + - Lcondbranch3 (_, _, _) + [classify_instr] is expected to return [None] when called on any + instruction not in this list. *) + val classify_instr : Linearize.instruction_desc -> t option + end + + (* The value to be added to the program counter (in [distance] units) + when it is at a branch instruction, prior to calculating the distance + to a branch target. *) + val offset_pc_at_branch : distance + + (* The maximum size of a given instruction. *) + val instr_size : Linearize.instruction_desc -> distance + + (* Insertion of target-specific code to relax operations that cannot be + relaxed generically. It is assumed that these rewrites do not change + the size of out-of-line code (cf. branch_relaxation.mli). *) + val relax_allocation : num_words:int -> Linearize.instruction_desc + val relax_intop_checkbound : unit -> Linearize.instruction_desc + val relax_intop_imm_checkbound : bound:int -> Linearize.instruction_desc + val relax_specific_op : Arch.specific_operation -> Linearize.instruction_desc +end diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index e3c723ad39..ac51bb189c 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -349,8 +349,8 @@ let mod_int c1 c2 dbg = [Cconst_symbol "caml_exn_Division_by_zero"])) | (c1, Cconst_int (1 | (-1))) -> Csequence(c1, Cconst_int 0) - | (Cconst_int(0 | 1 | (-1)) as c1, c2) -> - Csequence(c2, c1) + | (Cconst_int 0, c2) -> + Csequence(c2, Cconst_int 0) | (Cconst_int n1, Cconst_int n2) -> Cconst_int (n1 mod n2) | (c1, (Cconst_int n as c2)) when n <> min_int -> diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml index 917d2cb780..1e5ed0b5f3 100644 --- a/asmcomp/emitaux.ml +++ b/asmcomp/emitaux.ml @@ -195,6 +195,15 @@ let cfi_adjust_cfa_offset n = emit_string "\t.cfi_adjust_cfa_offset\t"; emit_int n; emit_string "\n"; end +let cfi_offset ~reg ~offset = + if is_cfi_enabled () then begin + emit_string "\t.cfi_offset "; + emit_int reg; + emit_string ", "; + emit_int offset; + emit_string "\n" + end + (* Emit debug information *) (* This assoc list is expected to be very short *) diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli index df9e66a553..290967c5d4 100644 --- a/asmcomp/emitaux.mli +++ b/asmcomp/emitaux.mli @@ -60,6 +60,7 @@ val is_generic_function: string -> bool val cfi_startproc : unit -> unit val cfi_endproc : unit -> unit val cfi_adjust_cfa_offset : int -> unit +val cfi_offset : reg:int -> offset:int -> unit val binary_backend_available: bool ref diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index 0a26ed1479..434408524d 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -308,126 +308,87 @@ let defined_functions = ref StringSet.empty (* Label of glue code for calling the GC *) let call_gc_label = ref 0 -(* Fixup conditional branches that exceed hardware allowed range *) - -let load_store_size = function - Ibased(s, d) -> 2 - | Iindexed ofs -> if is_immediate ofs then 1 else 3 - | Iindexed2 -> 1 - -let instr_size = function - Lend -> 0 - | Lop(Imove | Ispill | Ireload) -> 1 - | Lop(Iconst_int n | Iconst_blockheader n) -> - if is_native_immediate n then 1 else 2 - | Lop(Iconst_float s) -> 2 - | Lop(Iconst_symbol s) -> 2 - | Lop(Icall_ind) -> 2 - | Lop(Icall_imm s) -> 1 - | Lop(Itailcall_ind) -> 5 - | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 4 - | Lop(Iextcall(s, true)) -> 3 - | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1 - | Lop(Istackoffset n) -> 1 - | Lop(Iload(chunk, addr)) -> +module BR = Branch_relaxation.Make (struct + type distance = int + + module Cond_branch = struct + type t = Branch + + let all = [Branch] + + let max_displacement = function + (* 14-bit signed offset in words. *) + | Branch -> 8192 + + let classify_instr = function + | Lop (Ialloc _) + (* [Ialloc_far] does not need to be here, since its code sequence + never involves any conditional branches that might need relaxing. *) + | Lcondbranch _ + | Lcondbranch3 _ -> Some Branch + | _ -> None + end + + let offset_pc_at_branch = 1 + + let load_store_size = function + | Ibased(s, d) -> 2 + | Iindexed ofs -> if is_immediate ofs then 1 else 3 + | Iindexed2 -> 1 + + let instr_size = function + | Lend -> 0 + | Lop(Imove | Ispill | Ireload) -> 1 + | Lop(Iconst_int n | Iconst_blockheader n) -> + if is_native_immediate n then 1 else 2 + | Lop(Iconst_float s) -> 2 + | Lop(Iconst_symbol s) -> 2 + | Lop(Icall_ind) -> 2 + | Lop(Icall_imm s) -> 1 + | Lop(Itailcall_ind) -> 5 + | Lop(Itailcall_imm s) -> if s = !function_name then 1 else 4 + | Lop(Iextcall(s, true)) -> 3 + | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1 + | Lop(Istackoffset n) -> 1 + | Lop(Iload(chunk, addr)) -> if chunk = Byte_signed then load_store_size addr + 1 else load_store_size addr - | Lop(Istore(chunk, addr, _)) -> load_store_size addr - | Lop(Ialloc n) -> 4 - | Lop(Ispecific(Ialloc_far n)) -> 5 - | Lop(Iintop Imod) -> 3 - | Lop(Iintop(Icomp cmp)) -> 4 - | Lop(Iintop op) -> 1 - | Lop(Iintop_imm(Icomp cmp, n)) -> 4 - | Lop(Iintop_imm(op, n)) -> 1 - | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 - | Lop(Ifloatofint) -> 9 - | Lop(Iintoffloat) -> 4 - | Lop(Ispecific sop) -> 1 - | Lreloadretaddr -> 2 - | Lreturn -> 2 - | Llabel lbl -> 0 - | Lbranch lbl -> 1 - | Lcondbranch(tst, lbl) -> 2 - | Lcondbranch3(lbl0, lbl1, lbl2) -> + | Lop(Istore(chunk, addr, _)) -> load_store_size addr + | Lop(Ialloc n) -> 4 + | Lop(Ispecific(Ialloc_far n)) -> 5 + | Lop(Iintop Imod) -> 3 + | Lop(Iintop(Icomp cmp)) -> 4 + | Lop(Iintop op) -> 1 + | Lop(Iintop_imm(Icomp cmp, n)) -> 4 + | Lop(Iintop_imm(op, n)) -> 1 + | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 + | Lop(Ifloatofint) -> 9 + | Lop(Iintoffloat) -> 4 + | Lop(Ispecific sop) -> 1 + | Lreloadretaddr -> 2 + | Lreturn -> 2 + | Llabel lbl -> 0 + | Lbranch lbl -> 1 + | Lcondbranch(tst, lbl) -> 2 + | Lcondbranch3(lbl0, lbl1, lbl2) -> 1 + (if lbl0 = None then 0 else 1) + (if lbl1 = None then 0 else 1) + (if lbl2 = None then 0 else 1) - | Lswitch jumptbl -> 8 - | Lsetuptrap lbl -> 1 - | Lpushtrap -> 4 - | Lpoptrap -> 2 - | Lraise _ -> 6 - -let label_map code = - let map = Hashtbl.create 37 in - let rec fill_map pc instr = - match instr.desc with - Lend -> (pc, map) - | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next - | op -> fill_map (pc + instr_size op) instr.next - in fill_map 0 code - -let max_branch_offset = 8180 -(* 14-bit signed offset in words. Remember to cut some slack - for multi-word instructions where the branch can be anywhere in - the middle. 12 words of slack is plenty. *) - -let branch_overflows map pc_branch lbl_dest = - let pc_dest = Hashtbl.find map lbl_dest in - let delta = pc_dest - (pc_branch + 1) in - delta <= -max_branch_offset || delta >= max_branch_offset - -let opt_branch_overflows map pc_branch opt_lbl_dest = - match opt_lbl_dest with - None -> false - | Some lbl_dest -> branch_overflows map pc_branch lbl_dest - -let fixup_branches codesize map code = - let expand_optbranch lbl n arg next = - match lbl with - None -> next - | Some l -> - instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l)) - arg [||] next in - let rec fixup did_fix pc instr = - match instr.desc with - Lend -> did_fix - | Lcondbranch(test, lbl) when branch_overflows map pc lbl -> - let lbl2 = new_label() in - let cont = - instr_cons (Lbranch lbl) [||] [||] - (instr_cons (Llabel lbl2) [||] [||] instr.next) in - instr.desc <- Lcondbranch(invert_test test, lbl2); - instr.next <- cont; - fixup true (pc + 2) instr.next - | Lcondbranch3(lbl0, lbl1, lbl2) - when opt_branch_overflows map pc lbl0 - || opt_branch_overflows map pc lbl1 - || opt_branch_overflows map pc lbl2 -> - let cont = - expand_optbranch lbl0 0 instr.arg - (expand_optbranch lbl1 1 instr.arg - (expand_optbranch lbl2 2 instr.arg instr.next)) in - instr.desc <- cont.desc; - instr.next <- cont.next; - fixup true pc instr - | Lop(Ialloc n) when codesize - pc >= max_branch_offset -> - instr.desc <- Lop(Ispecific(Ialloc_far n)); - fixup true (pc + 4) instr.next - | op -> - fixup did_fix (pc + instr_size op) instr.next - in fixup false 0 code - -(* Iterate branch expansion till all conditional branches are OK *) - -let rec branch_normalization code = - let (codesize, map) = label_map code in - if codesize >= max_branch_offset && fixup_branches codesize map code - then branch_normalization code - else () + | Lswitch jumptbl -> 8 + | Lsetuptrap lbl -> 1 + | Lpushtrap -> 4 + | Lpoptrap -> 2 + | Lraise _ -> 6 + + let relax_allocation ~num_words = Lop (Ispecific (Ialloc_far num_words)) + (* [classify_addr], above, never identifies these instructions as needing + relaxing. As such, these functions should never be called. *) + let relax_specific_op _ = assert false + let relax_intop_checkbound () = assert false + let relax_intop_imm_checkbound ~bound:_ = assert false +end) (* Output the assembly code for an instruction *) @@ -848,7 +809,10 @@ let fundecl fundecl = ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n` end; `{emit_label !tailrec_entry_point}:\n`; - branch_normalization fundecl.fun_body; + (* On this target, there is at most one "out of line" code block per + function: a single "call GC" point. It comes immediately after the + function's body. *) + BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0; emit_all fundecl.fun_body; (* Emit the glue code to call the GC *) if !call_gc_label > 0 then begin diff --git a/asmrun/.depend b/asmrun/.depend index 922274fa46..4e273887b6 100644 --- a/asmrun/.depend +++ b/asmrun/.depend @@ -283,6 +283,11 @@ roots.o: roots.c ../byterun/caml/finalise.h ../byterun/caml/roots.h \ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h \ ../byterun/caml/roots.h signals_asm.o: signals_asm.c ../byterun/caml/fail.h \ + ../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \ + ../byterun/caml/globroots.h ../byterun/caml/memory.h \ + ../byterun/caml/major_gc.h ../byterun/caml/minor_gc.h \ + ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h \ + ../byterun/caml/roots.h ../byterun/caml/address_class.h \ ../byterun/caml/misc.h ../byterun/caml/config.h \ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \ @@ -641,6 +646,7 @@ roots.d.o: roots.c ../byterun/caml/finalise.h ../byterun/caml/roots.h \ ../byterun/caml/misc.h ../byterun/caml/mlvalues.h stack.h \ ../byterun/caml/roots.h signals_asm.d.o: signals_asm.c ../byterun/caml/fail.h \ + ../byterun/caml/address_class.h \ ../byterun/caml/misc.h ../byterun/caml/config.h \ ../byterun/caml/../../config/m.h ../byterun/caml/../../config/s.h \ ../byterun/caml/mlvalues.h ../byterun/caml/memory.h ../byterun/caml/gc.h \ diff --git a/asmrun/Makefile b/asmrun/Makefile index 33c54446b8..e53628b4f9 100644 --- a/asmrun/Makefile +++ b/asmrun/Makefile @@ -16,7 +16,7 @@ include ../config/Makefile CC=$(NATIVECC) FLAGS=-I../byterun -DCAML_NAME_SPACE -DNATIVE_CODE \ -DTARGET_$(ARCH) -DSYS_$(SYSTEM) $(IFLEXDIR) -CFLAGS=$(FLAGS) -O $(NATIVECCCOMPOPTS) +CFLAGS=$(FLAGS) $(NATIVECCCOMPOPTS) DFLAGS=$(FLAGS) -g -DDEBUG $(NATIVECCCOMPOPTS) PFLAGS=$(FLAGS) -pg -O -DPROFILING $(NATIVECCPROFOPTS) PICFLAGS=$(FLAGS) -O $(SHAREDCCCOMPOPTS) $(NATIVECCCOMPOPTS) @@ -120,6 +120,9 @@ power.o: power-$(SYSTEM).o power.p.o: power-$(SYSTEM).o cp power-$(SYSTEM).o power.p.o +power.pic.o: power-$(SYSTEM).pic.o + cp power-$(SYSTEM).pic.o power.pic.o + main.c: ../byterun/main.c ln -s ../byterun/main.c main.c startup_aux.c: ../byterun/startup_aux.c diff --git a/asmrun/Makefile.nt b/asmrun/Makefile.nt index c62e8c9feb..2e994d298d 100644 --- a/asmrun/Makefile.nt +++ b/asmrun/Makefile.nt @@ -70,7 +70,7 @@ win32.$(O): ../byterun/win32.c $(CC) -c $(NATIVECCCOMPOPTS) -DNATIVE_CODE $(IFLEXDIR) ../byterun/win32.c %.$(O): %.c - $(CC) $(CFLAGS) -c -o $@ $< + $(CC) $(CFLAGS) -c $< clean:: rm -f $(LINKEDFILES) diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c index fe2830cc27..6f370da223 100644 --- a/asmrun/backtrace.c +++ b/asmrun/backtrace.c @@ -205,17 +205,8 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) { /* Extract location information for the given frame descriptor */ -struct loc_info { - int loc_valid; - int loc_is_raise; - char * loc_filename; - int loc_lnum; - int loc_startchr; - int loc_endchr; -}; - -static void extract_location_info(frame_descr * d, - /*out*/ struct loc_info * li) +CAMLexport void extract_location_info(frame_descr * d, + /*out*/ struct caml_loc_info * li) { uintnat infoptr; uint32_t info1, info2; @@ -261,7 +252,7 @@ static void extract_location_info(frame_descr * d, useless. We kept it to keep code identical to the byterun/ implementation. */ -static void print_location(struct loc_info * li, int index) +static void print_location(struct caml_loc_info * li, int index) { char * info; @@ -294,7 +285,7 @@ static void print_location(struct loc_info * li, int index) void caml_print_exception_backtrace(void) { int i; - struct loc_info li; + struct caml_loc_info li; for (i = 0; i < caml_backtrace_pos; i++) { extract_location_info((frame_descr *) (caml_backtrace_buffer[i]), &li); @@ -307,7 +298,7 @@ void caml_print_exception_backtrace(void) CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot) { CAMLparam1(backtrace_slot); CAMLlocal2(p, fname); - struct loc_info li; + struct caml_loc_info li; extract_location_info(Descrptr_Val(backtrace_slot), &li); diff --git a/asmrun/i386.S b/asmrun/i386.S index 347e967c14..e55969ee97 100644 --- a/asmrun/i386.S +++ b/asmrun/i386.S @@ -19,7 +19,7 @@ /* Linux/BSD with ELF binaries and Solaris do not prefix identifiers with _. Linux/BSD with a.out binaries and NextStep do. */ -#if defined(SYS_solaris) +#if (defined(SYS_solaris) && !defined(__GNUC__)) #define CONCAT(a,b) a/**/b #else #define CONCAT(a,b) a##b diff --git a/asmrun/signals_osdep.h b/asmrun/signals_osdep.h index 8dd651f6c5..627e3b727e 100644 --- a/asmrun/signals_osdep.h +++ b/asmrun/signals_osdep.h @@ -152,14 +152,24 @@ #elif defined(TARGET_i386) && defined(SYS_bsd_elf) - #define DECLARE_SIGNAL_HANDLER(name) \ - static void name(int sig, siginfo_t * info, struct sigcontext * context) + #if defined (__NetBSD__) + #include <ucontext.h> + #define DECLARE_SIGNAL_HANDLER(name) \ + static void name(int sig, siginfo_t * info, ucontext_t * context) + #else + #define DECLARE_SIGNAL_HANDLER(name) \ + static void name(int sig, siginfo_t * info, struct sigcontext * context) + #endif #define SET_SIGACT(sigact,name) \ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \ sigact.sa_flags = SA_SIGINFO - #define CONTEXT_PC (context->sc_eip) + #if defined (__NetBSD__) + #define CONTEXT_PC (_UC_MACHINE_PC(context)) + #else + #define CONTEXT_PC (context->sc_eip) + #endif #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr) /****************** I386, BSD */ diff --git a/asmrun/stack.h b/asmrun/stack.h index 92b3c28a35..6e55942926 100644 --- a/asmrun/stack.h +++ b/asmrun/stack.h @@ -78,6 +78,15 @@ typedef struct { unsigned short live_ofs[1]; } frame_descr; +struct caml_loc_info { + int loc_valid; + int loc_is_raise; + char * loc_filename; + int loc_lnum; + int loc_startchr; + int loc_endchr; +}; + /* Hash table of frame descriptors */ extern frame_descr ** caml_frame_descriptors; @@ -90,6 +99,10 @@ extern void caml_init_frame_descriptors(void); extern void caml_register_frametable(intnat *); extern void caml_register_dyn_global(void *); +CAMLextern void extract_location_info(frame_descr * d, + /*out*/ struct caml_loc_info * li); + + extern uintnat caml_stack_usage (void); extern uintnat (*caml_stack_usage_hook)(void); diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index c4c35bf954..422dbd552b 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -197,7 +197,7 @@ let clear_crc_interfaces () = (* Record compilation events *) -let debug_info = ref ([] : (int * LongString.t) list) +let debug_info = ref ([] : (int * Instruct.debug_event list * string list) list) (* Link in a compilation unit *) @@ -208,8 +208,14 @@ let link_compunit ppf output_fun currpos_fun inchan file_name compunit = Symtable.ls_patch_object code_block compunit.cu_reloc; if !Clflags.debug && compunit.cu_debug > 0 then begin seek_in inchan compunit.cu_debug; - let buffer = LongString.input_bytes inchan compunit.cu_debugsize in - debug_info := (currpos_fun(), buffer) :: !debug_info + let debug_event_list : Instruct.debug_event list = input_value inchan in + let debug_dirs : string list = input_value inchan in + let file_path = Filename.dirname (Location.absolute_path file_name) in + let debug_dirs = + if List.mem file_path debug_dirs + then debug_dirs + else file_path :: debug_dirs in + debug_info := (currpos_fun(), debug_event_list, debug_dirs) :: !debug_info end; Array.iter output_fun code_block; if !Clflags.link_everything then @@ -264,9 +270,10 @@ let link_file ppf output_fun currpos_fun = function let output_debug_info oc = output_binary_int oc (List.length !debug_info); List.iter - (fun (ofs, evl) -> + (fun (ofs, evl, debug_dirs) -> output_binary_int oc ofs; - Array.iter (output_bytes oc) evl) + output_value oc evl; + output_value oc debug_dirs) !debug_info; debug_info := [] @@ -573,8 +580,15 @@ let link ppf objfiles output_name = raise x end else begin let basename = Filename.chop_extension output_name in - let c_file = basename ^ ".c" - and obj_file = basename ^ Config.ext_obj in + let c_file = + if !Clflags.output_complete_object + then Filename.temp_file "camlobj" ".c" + else basename ^ ".c" + and obj_file = + if !Clflags.output_complete_object + then Filename.temp_file "camlobj" Config.ext_obj + else basename ^ Config.ext_obj + in if Sys.file_exists c_file then raise(Error(File_exists c_file)); let temps = ref [] in try @@ -583,13 +597,19 @@ let link ppf objfiles output_name = temps := c_file :: !temps; if Ccomp.compile_file ~output_name:(Some obj_file) c_file <> 0 then raise(Error Custom_runtime); - if not (Filename.check_suffix output_name Config.ext_obj) then begin + if not (Filename.check_suffix output_name Config.ext_obj) || + !Clflags.output_complete_object then begin temps := obj_file :: !temps; + let mode, c_libs = + if Filename.check_suffix output_name Config.ext_obj + then Ccomp.Partial, "" + else Ccomp.MainDll, Config.bytecomp_c_libraries + in if not ( let runtime_lib = "-lcamlrun" ^ !Clflags.runtime_variant in - Ccomp.call_linker Ccomp.MainDll output_name + Ccomp.call_linker mode output_name ([obj_file] @ List.rev !Clflags.ccobjs @ [runtime_lib]) - Config.bytecomp_c_libraries + c_libs ) then raise (Error Custom_runtime); end end; diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 70f22ed9a6..7783368828 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -558,10 +558,9 @@ let lam_of_loc kind loc = | Loc_FILE -> Lconst (Const_immstring file) | Loc_MODULE -> let filename = Filename.basename file in - let module_name = - try String.capitalize_ascii (Filename.chop_extension filename) - with Invalid_argument _ -> "//"^filename^"//" - in Lconst (Const_immstring module_name) + let name = Env.get_unit_name () in + let module_name = if name = "" then "//"^filename^"//" else name in + Lconst (Const_immstring module_name) | Loc_LOC -> let loc = Printf.sprintf "File %S, line %d, characters %d-%d" file lnum cnum enum in diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 8d4f82de3b..a0ce27373e 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -81,7 +81,9 @@ let num_of_prim name = try find_numtable !c_prim_table name with Not_found -> - if !Clflags.custom_runtime || !Clflags.no_check_prims then + if !Clflags.custom_runtime || Config.host <> Config.target + || !Clflags.no_check_prims + then enter_numtable c_prim_table name else begin let symb = diff --git a/byterun/Makefile b/byterun/Makefile index 6872fe612b..ae57e2a7aa 100644 --- a/byterun/Makefile +++ b/byterun/Makefile @@ -13,7 +13,7 @@ include Makefile.common -CFLAGS=-DCAML_NAME_SPACE -O $(BYTECCCOMPOPTS) $(IFLEXDIR) +CFLAGS=-DCAML_NAME_SPACE $(BYTECCCOMPOPTS) $(IFLEXDIR) DFLAGS=-DCAML_NAME_SPACE -g -DDEBUG $(BYTECCCOMPOPTS) $(IFLEXDIR) OBJS=$(COMMONOBJS) $(UNIX_OR_WIN32).o main.o diff --git a/byterun/Makefile.common b/byterun/Makefile.common index d942251491..36e93325a7 100644 --- a/byterun/Makefile.common +++ b/byterun/Makefile.common @@ -12,6 +12,8 @@ ######################################################################### include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc CC=$(BYTECC) @@ -57,7 +59,7 @@ INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR) install:: - cp ocamlrun$(EXE) $(INSTALL_BINDIR)/ocamlrun$(EXE) + cp $(CAMLRUN)$(EXE) $(INSTALL_BINDIR)/ocamlrun$(EXE) cp libcamlrun.$(A) $(INSTALL_LIBDIR)/libcamlrun.$(A) cd $(INSTALL_LIBDIR); $(RANLIB) libcamlrun.$(A) if test -d $(INSTALL_LIBDIR)/caml; then : ; \ @@ -73,6 +75,10 @@ install:: install-$(RUNTIMED) install-noruntimed: .PHONY: install-noruntimed +# TODO: when cross-compiling, do not install ocamlrund +# it doesn't hurt to install it, but it's useless and might be confusing +# because it's an executable for the target machine, while we're installing +# binaries for the host. install-runtimed: cp ocamlrund$(EXE) $(INSTALL_BINDIR)/ocamlrund$(EXE) cp libcamlrund.$(A) $(INSTALL_LIBDIR)/libcamlrund.$(A) diff --git a/byterun/Makefile.nt b/byterun/Makefile.nt index 5043d45617..257e364416 100644 --- a/byterun/Makefile.nt +++ b/byterun/Makefile.nt @@ -24,7 +24,7 @@ ocamlrun$(EXE): libcamlrun.$(A) prims.$(O) $(EXTRALIBS) libcamlrun.$(A) ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O) - $(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) \ + $(MKEXE) -o ocamlrund$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) \ $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrund.$(A) libcamlrun.$(A): $(OBJS) @@ -34,7 +34,7 @@ libcamlrund.$(A): $(DOBJS) $(call MKLIB,libcamlrund.$(A),$(DOBJS)) %.$(O): %.c - $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) -c -o $@ $< + $(CC) $(CFLAGS) $(BYTECCCOMPOPTS) -c $< %.$(DBGO): %.c $(CC) $(CFLAGS) $(BYTECCDBGCOMPOPTS) -c -o $@ $< diff --git a/byterun/alloc.c b/byterun/alloc.c index 96a21bf1f5..8afc5b7859 100644 --- a/byterun/alloc.c +++ b/byterun/alloc.c @@ -198,3 +198,7 @@ CAMLprim value caml_update_dummy(value dummy, value newval) } return Val_unit; } + + + + diff --git a/byterun/backtrace.c b/byterun/backtrace.c index de658891d9..82a3eed30c 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -306,15 +306,15 @@ void caml_stash_backtrace(value exn, code_t pc, value * sp, int reraise) #define Codet_Val(v) ((code_t)(Long_val(v)<<1)) /* returns the next frame pointer (or NULL if none is available); - updates *sp to point to the following one, and *trapsp to the next + updates *sp to point to the following one, and *trsp to the next trap frame, which we will skip when we reach it */ -code_t caml_next_frame_pointer(value ** sp, value ** trapsp) +code_t caml_next_frame_pointer(value ** sp, value ** trsp) { while (*sp < caml_stack_high) { code_t *p = (code_t*) (*sp)++; - if(&Trap_pc(*trapsp) == p) { - *trapsp = Trap_link(*trapsp); + if(&Trap_pc(*trsp) == p) { + *trsp = Trap_link(*trsp); continue; } @@ -343,10 +343,10 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) { /* first compute the size of the trace */ { value * sp = caml_extern_sp; - value * trapsp = caml_trapsp; + value * trsp = caml_trapsp; for (trace_size = 0; trace_size < max_frames; trace_size++) { - code_t p = caml_next_frame_pointer(&sp, &trapsp); + code_t p = caml_next_frame_pointer(&sp, &trsp); if (p == NULL) break; } } @@ -356,11 +356,11 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) { /* then collect the trace */ { value * sp = caml_extern_sp; - value * trapsp = caml_trapsp; + value * trsp = caml_trapsp; uintnat trace_pos; for (trace_pos = 0; trace_pos < trace_size; trace_pos++) { - code_t p = caml_next_frame_pointer(&sp, &trapsp); + code_t p = caml_next_frame_pointer(&sp, &trsp); Assert(p != NULL); Field(trace, trace_pos) = Val_Codet(p); } diff --git a/byterun/callback.c b/byterun/callback.c index bb149d7019..3010985162 100644 --- a/byterun/callback.c +++ b/byterun/callback.c @@ -245,3 +245,14 @@ CAMLexport value * caml_named_value(char const *name) } return NULL; } + +CAMLexport void caml_iterate_named_values(caml_named_action f) +{ + int i; + for(i = 0; i < Named_value_size; i++){ + struct named_value * nv; + for (nv = named_value_table[i]; nv != NULL; nv = nv->next) { + f( &nv->val, nv->name ); + } + } +} diff --git a/byterun/caml/callback.h b/byterun/caml/callback.h index ded0b9801c..ef50945cfc 100644 --- a/byterun/caml/callback.h +++ b/byterun/caml/callback.h @@ -42,6 +42,8 @@ CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]); #define Extract_exception(v) ((v) & ~3) CAMLextern value * caml_named_value (char const * name); +typedef void (*caml_named_action) (value*, char *); +CAMLextern void caml_iterate_named_values(caml_named_action f); CAMLextern void caml_main (char ** argv); CAMLextern void caml_startup (char ** argv); diff --git a/byterun/caml/hash.h b/byterun/caml/hash.h index 65613975b8..d130068c48 100644 --- a/byterun/caml/hash.h +++ b/byterun/caml/hash.h @@ -18,6 +18,10 @@ #include "mlvalues.h" +#ifdef __cplusplus +extern "C" { +#endif + CAMLextern uint32_t caml_hash_mix_uint32(uint32_t h, uint32_t d); CAMLextern uint32_t caml_hash_mix_intnat(uint32_t h, intnat d); CAMLextern uint32_t caml_hash_mix_int64(uint32_t h, int64_t d); @@ -25,5 +29,9 @@ CAMLextern uint32_t caml_hash_mix_double(uint32_t h, double d); CAMLextern uint32_t caml_hash_mix_float(uint32_t h, float d); CAMLextern uint32_t caml_hash_mix_string(uint32_t h, value s); - +#ifdef __cplusplus +extern "C" { #endif + + +#endif /* CAML_HASH_H */ diff --git a/byterun/caml/misc.h b/byterun/caml/misc.h index b2d44252aa..a7441dbc94 100644 --- a/byterun/caml/misc.h +++ b/byterun/caml/misc.h @@ -59,6 +59,17 @@ typedef char * addr; #define CAMLweakdef #endif +#ifdef __cplusplus +extern "C" { +#endif + +/* GC timing hooks. These can be assigned by the user. The hook functions + must not allocate or change the heap in any way. */ +typedef void (*caml_timing_hook) (void); +extern caml_timing_hook caml_major_slice_begin_hook, caml_major_slice_end_hook; +extern caml_timing_hook caml_minor_gc_begin_hook, caml_minor_gc_end_hook; +extern caml_timing_hook caml_finalise_begin_hook, caml_finalise_end_hook; + /* Assertions */ #ifdef DEBUG @@ -156,4 +167,8 @@ extern int caml_snprintf(char * buf, size_t size, const char * format, ...); /* </private> */ +#ifdef __cplusplus +} +#endif + #endif /* CAML_MISC_H */ diff --git a/byterun/caml/mlvalues.h b/byterun/caml/mlvalues.h index 96c18aae3d..3b94d010c6 100644 --- a/byterun/caml/mlvalues.h +++ b/byterun/caml/mlvalues.h @@ -296,10 +296,10 @@ CAMLextern header_t caml_atom_table[]; extern value caml_global_data; +CAMLextern value caml_set_oo_id(value obj); + #ifdef __cplusplus } #endif -CAMLextern value caml_set_oo_id(value obj); - #endif /* CAML_MLVALUES_H */ diff --git a/byterun/fix_code.c b/byterun/fix_code.c index 1efb7b15ed..e605290615 100644 --- a/byterun/fix_code.c +++ b/byterun/fix_code.c @@ -95,33 +95,44 @@ void caml_fixup_endianness(code_t code, asize_t len) char ** caml_instr_table; char * caml_instr_base; -void caml_thread_code (code_t code, asize_t len) +static int* opcode_nargs = NULL; +int* caml_init_opcode_nargs() { - code_t p; - int l [FIRST_UNIMPLEMENTED_OP]; - int i; + if( opcode_nargs == NULL ){ + int* l = (int*)caml_stat_alloc(sizeof(int) * FIRST_UNIMPLEMENTED_OP); + int i; - for (i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) { - l [i] = 0; + for (i = 0; i < FIRST_UNIMPLEMENTED_OP; i++) { + l [i] = 0; + } + /* Instructions with one operand */ + l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] = + l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] = + l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] = + l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] = + l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] = + l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] = + l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] = + l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] = + l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] = + l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] = + l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1; + + /* Instructions with two operands */ + l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] = + l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] = + l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] = + l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2; + + opcode_nargs = l; } - /* Instructions with one operand */ - l[PUSHACC] = l[ACC] = l[POP] = l[ASSIGN] = - l[PUSHENVACC] = l[ENVACC] = l[PUSH_RETADDR] = l[APPLY] = - l[APPTERM1] = l[APPTERM2] = l[APPTERM3] = l[RETURN] = - l[GRAB] = l[PUSHGETGLOBAL] = l[GETGLOBAL] = l[SETGLOBAL] = - l[PUSHATOM] = l[ATOM] = l[MAKEBLOCK1] = l[MAKEBLOCK2] = - l[MAKEBLOCK3] = l[MAKEFLOATBLOCK] = l[GETFIELD] = - l[GETFLOATFIELD] = l[SETFIELD] = l[SETFLOATFIELD] = - l[BRANCH] = l[BRANCHIF] = l[BRANCHIFNOT] = l[PUSHTRAP] = - l[C_CALL1] = l[C_CALL2] = l[C_CALL3] = l[C_CALL4] = l[C_CALL5] = - l[CONSTINT] = l[PUSHCONSTINT] = l[OFFSETINT] = - l[OFFSETREF] = l[OFFSETCLOSURE] = l[PUSHOFFSETCLOSURE] = 1; - - /* Instructions with two operands */ - l[APPTERM] = l[CLOSURE] = l[PUSHGETGLOBALFIELD] = - l[GETGLOBALFIELD] = l[MAKEBLOCK] = l[C_CALLN] = - l[BEQ] = l[BNEQ] = l[BLTINT] = l[BLEINT] = l[BGTINT] = l[BGEINT] = - l[BULTINT] = l[BUGEINT] = l[GETPUBMET] = 2; + return opcode_nargs; +} + +void caml_thread_code (code_t code, asize_t len) +{ + code_t p; + int* l = caml_init_opcode_nargs(); len /= sizeof(opcode_t); for (p = code; p < code + len; /*nothing*/) { opcode_t instr = *p; @@ -149,6 +160,13 @@ void caml_thread_code (code_t code, asize_t len) Assert(p == code + len); } +#else + +int* caml_init_opcode_nargs() +{ + return NULL; +} + #endif /* THREADED_CODE */ void caml_set_instruction(code_t pos, opcode_t instr) diff --git a/byterun/floats.c b/byterun/floats.c index 69c5328510..544dc06efd 100644 --- a/byterun/floats.c +++ b/byterun/floats.c @@ -150,6 +150,7 @@ CAMLprim value caml_float_of_string(value vs) error: if (buf != parse_buffer) caml_stat_free(buf); caml_failwith("float_of_string"); + return Val_unit; /* not reached */ } CAMLprim value caml_int_of_float(value f) @@ -452,7 +453,8 @@ enum { FP_normal, FP_subnormal, FP_zero, FP_infinite, FP_nan }; CAMLprim value caml_classify_float(value vd) { /* Cygwin 1.3 has problems with fpclassify (PR#1293), so don't use it */ -#if defined(fpclassify) && !defined(__CYGWIN32__) && !defined(__MINGW32__) + /* FIXME Cygwin 1.3 is ancient! Revisit this decision. */ +#if defined(fpclassify) && !defined(__CYGWIN__) && !defined(__MINGW32__) switch (fpclassify(Double_val(vd))) { case FP_NAN: return Val_int(FP_nan); diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 5c50c8980d..41eb4215db 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -59,6 +59,8 @@ static value *weak_prev; static unsigned long major_gc_counter = 0; #endif +void (*caml_major_gc_hook)(void) = NULL; + static void realloc_gray_vals (void) { value *new; @@ -90,13 +92,6 @@ void caml_darken (value v, value *p /* not used */) { #ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS if (Is_block (v) && Wosize_val (v) > 0) { - /* We insist that naked pointers to outside the heap point to things that - look like values with headers coloured black. This isn't always - strictly necessary but is essential in certain cases---in particular - when the value is allocated in a read-only section. (For the values - where it would be safe it is a performance improvement since we avoid - putting them on the grey list.) */ - CAMLassert (Is_in_heap (v) || Is_black_hd (Hd_val (v))); #else if (Is_block (v) && Is_in_heap (v)) { #endif @@ -107,6 +102,15 @@ void caml_darken (value v, value *p /* not used */) h = Hd_val (v); t = Tag_hd (h); } +#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS + /* We insist that naked pointers to outside the heap point to things that + look like values with headers coloured black. This isn't always + strictly necessary but is essential in certain cases---in particular + when the value is allocated in a read-only section. (For the values + where it would be safe it is a performance improvement since we avoid + putting them on the grey list.) */ + CAMLassert (Is_in_heap (v) || Is_black_hd (h)); +#endif CAMLassert (!Is_blue_hd (h)); if (Is_white_hd (h)){ if (t < No_scan_tag){ @@ -145,6 +149,7 @@ static void mark_slice (intnat work) int marking_closure = 0; #endif + if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) (); caml_gc_message (0x40, "Marking %ld words\n", work); caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); gray_vals_ptr = gray_vals_cur; @@ -169,8 +174,6 @@ static void mark_slice (intnat work) be reliably determined, so we always use the page table when marking such values. */ && (!marking_closure || Is_in_heap (child))) { - /* See [caml_darken] for a description of this assertion. */ - CAMLassert (Is_in_heap (child) || Is_black_hd (Hd_val (child))); #else if (Is_block (child) && Is_in_heap (child)) { #endif @@ -189,6 +192,10 @@ static void mark_slice (intnat work) child -= Infix_offset_val(child); hd = Hd_val(child); } +#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS + /* See [caml_darken] for a description of this assertion. */ + CAMLassert (Is_in_heap (child) || Is_black_hd (hd)); +#endif if (Is_white_hd (hd)){ Hd_val (child) = Grayhd_hd (hd); *gray_vals_ptr++ = child; @@ -307,6 +314,7 @@ static void mark_slice (intnat work) limit = chunk + Chunk_size (chunk); work = 0; caml_fl_wsz_at_phase_change = caml_fl_cur_wsz; + if (caml_major_gc_hook) (*caml_major_gc_hook)(); } break; default: Assert (0); @@ -314,6 +322,7 @@ static void mark_slice (intnat work) } } gray_vals_cur = gray_vals_ptr; + if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) (); } static void sweep_slice (intnat work) @@ -321,6 +330,7 @@ static void sweep_slice (intnat work) char *hp; header_t hd; + if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) (); caml_gc_message (0x40, "Sweeping %ld words\n", work); while (work > 0){ if (caml_gc_sweep_hp < limit){ @@ -359,6 +369,7 @@ static void sweep_slice (intnat work) } } } + if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) (); } /* The main entry point for the GC. Called after each minor GC. diff --git a/byterun/md5.c b/byterun/md5.c index cc6d31a0c3..7a996b6b9f 100644 --- a/byterun/md5.c +++ b/byterun/md5.c @@ -33,18 +33,16 @@ CAMLprim value caml_md5_string(value str, value ofs, value len) return res; } -CAMLprim value caml_md5_chan(value vchan, value len) +CAMLexport value caml_md5_channel(struct channel *chan, intnat toread) { - CAMLparam2 (vchan, len); - struct channel * chan = Channel(vchan); + CAMLparam0(); struct MD5Context ctx; value res; - intnat toread, read; + intnat read; char buffer[4096]; Lock(chan); caml_MD5Init(&ctx); - toread = Long_val(len); if (toread < 0){ while (1){ read = caml_getblock (chan, buffer, sizeof(buffer)); @@ -66,6 +64,12 @@ CAMLprim value caml_md5_chan(value vchan, value len) CAMLreturn (res); } +CAMLprim value caml_md5_chan(value vchan, value len) +{ + CAMLparam2 (vchan, len); + CAMLreturn (caml_md5_channel(Channel(vchan), Long_val(len))); +} + CAMLexport void caml_md5_block(unsigned char digest[16], void * data, uintnat len) { diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index ec468560e1..079e686683 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -227,8 +227,11 @@ void caml_oldify_mopup (void) void caml_empty_minor_heap (void) { value **r; + uintnat prev_alloc_words; if (caml_young_ptr != caml_young_end){ + if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) (); + prev_alloc_words = caml_allocated_words; caml_in_minor_collection = 1; caml_gc_message (0x02, "<", 0); caml_oldify_local_roots(); @@ -253,8 +256,13 @@ void caml_empty_minor_heap (void) clear_table (&caml_weak_ref_table); caml_gc_message (0x02, ">", 0); caml_in_minor_collection = 0; + caml_stat_promoted_words += caml_allocated_words - prev_alloc_words; + ++ caml_stat_minor_collections; + caml_final_empty_young (); + if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) (); + }else{ + caml_final_empty_young (); } - caml_final_empty_young (); #ifdef DEBUG { value *p; @@ -272,16 +280,14 @@ void caml_empty_minor_heap (void) */ CAMLexport void caml_minor_collection (void) { - intnat prev_alloc_words = caml_allocated_words; - caml_empty_minor_heap (); - caml_stat_promoted_words += caml_allocated_words - prev_alloc_words; - ++ caml_stat_minor_collections; caml_major_collection_slice (0); caml_force_major_slice = 0; + if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) (); caml_final_do_calls (); + if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) (); caml_empty_minor_heap (); } diff --git a/byterun/misc.c b/byterun/misc.c index 03e5f57d1e..09b2d85dbb 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -18,6 +18,13 @@ #include "caml/misc.h" #include "caml/memory.h" +caml_timing_hook caml_major_slice_begin_hook = NULL; +caml_timing_hook caml_major_slice_end_hook = NULL; +caml_timing_hook caml_minor_gc_begin_hook = NULL; +caml_timing_hook caml_minor_gc_end_hook = NULL; +caml_timing_hook caml_finalise_begin_hook = NULL; +caml_timing_hook caml_finalise_end_hook = NULL; + #ifdef DEBUG int caml_failed_assert (char * expr, char * file, int line) diff --git a/byterun/sys.c b/byterun/sys.c index f54c92ab10..97c576dd59 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -280,7 +280,7 @@ CAMLprim value caml_sys_getenv(value var) } char * caml_exe_name; -static char ** caml_main_argv; +char ** caml_main_argv; CAMLprim value caml_sys_get_argv(value unit) { diff --git a/byterun/unix.c b/byterun/unix.c index a76ab22f72..38ddee0056 100644 --- a/byterun/unix.c +++ b/byterun/unix.c @@ -24,7 +24,7 @@ #include <fcntl.h> #include "caml/config.h" #ifdef SUPPORT_DYNAMIC_LINKING -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ #include "flexdll.h" #else #include <dlfcn.h> @@ -86,7 +86,7 @@ char * caml_search_in_path(struct ext_table * path, char * name) return caml_strdup(name); } -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ /* Cygwin needs special treatment because of the implicit ".exe" at the end of executable file names */ @@ -137,7 +137,7 @@ char * caml_search_exe_in_path(char * name) caml_ext_table_init(&path, 8); tofree = caml_decompose_path(&path, getenv("PATH")); -#ifndef __CYGWIN32__ +#ifndef __CYGWIN__ res = caml_search_in_path(&path, name); #else res = cygwin_search_exe_in_path(&path, name); @@ -159,7 +159,7 @@ char * caml_search_dll_in_path(struct ext_table * path, char * name) } #ifdef SUPPORT_DYNAMIC_LINKING -#ifdef __CYGWIN32__ +#ifdef __CYGWIN__ /* Use flexdll */ void * caml_dlopen(char * libname, int for_execution, int global) diff --git a/config/Makefile.mingw b/config/Makefile.mingw index c204980367..5b4658f71b 100644 --- a/config/Makefile.mingw +++ b/config/Makefile.mingw @@ -68,7 +68,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-O MKSHAREDLIBRPATH= NATIVECCPROFOPTS= NATIVECCRPATH= diff --git a/config/Makefile.mingw64 b/config/Makefile.mingw64 index 0a3bdfbd09..19a9b94376 100644 --- a/config/Makefile.mingw64 +++ b/config/Makefile.mingw64 @@ -68,7 +68,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-O MKSHAREDLIBRPATH= NATIVECCPROFOPTS= NATIVECCRPATH= diff --git a/config/Makefile.msvc b/config/Makefile.msvc index abe37bf324..4d399cf49b 100644 --- a/config/Makefile.msvc +++ b/config/Makefile.msvc @@ -60,7 +60,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-Ox NATIVECCPROFOPTS= NATIVECCRPATH= ASM=ml -nologo -coff -Cp -c -Fo diff --git a/config/Makefile.msvc64 b/config/Makefile.msvc64 index c33ba1fb70..6a9650ba5e 100644 --- a/config/Makefile.msvc64 +++ b/config/Makefile.msvc64 @@ -60,7 +60,7 @@ X11_INCLUDES= X11_LINK= BYTECCRPATH= SUPPORTS_SHARED_LIBRARIES=true -SHAREDCCCOMPOPTS= +SHAREDCCCOMPOPTS=-Ox NATIVECCPROFOPTS= NATIVECCRPATH= ASM=ml64 -nologo -Cp -c -Fo diff --git a/config/auto-aux/searchpath b/config/auto-aux/searchpath index 79d7fcaebc..e229ac921b 100755 --- a/config/auto-aux/searchpath +++ b/config/auto-aux/searchpath @@ -15,9 +15,18 @@ # Find a program in the path +doprint=false +case $1 in + -p) shift; doprint=true;; + *) ;; +esac + IFS=':' for dir in $PATH; do if test -z "$dir"; then dir=.; fi - if test -f $dir/$1; then exit 0; fi + if test -f $dir/$1 -a -x $dir/$1; then + if $doprint; then echo "$dir/$1"; fi + exit 0 + fi done exit 1 @@ -18,6 +18,7 @@ echo Configuring OCaml version `head -1 VERSION` configure_options="$*" prefix=/usr/local bindir='' +target_bindir='' libdir='' mandir='' manext=1 @@ -94,6 +95,8 @@ while : ; do prefix=$2; shift;; -bindir|--bindir) bindir=$2; shift;; + -target-bindir|--target-bindir) + target_bindir="$2"; shift;; -libdir|--libdir) libdir=$2; shift;; -mandir|--mandir) @@ -239,17 +242,23 @@ else fi inf "Configuring for target $target ..." +if [ x"$host" = x"$target" ]; then + cross_compiler=false +else + cross_compiler=true +fi + # Do we have gcc? if test -z "$ccoption"; then if sh ./searchpath "${TOOLPREF}gcc"; then cc="${TOOLPREF}gcc" else - if test x"$host" = x"$target"; then - cc="cc" - else + if $cross_compiler; then err "No cross-compiler found for ${target}.\n" \ "It should be named ${TOOLPREF}gcc and be in the PATH." + else + cc="cc" fi fi else @@ -450,7 +459,7 @@ case $? in 1) err "The C compiler $cc is not ANSI-compliant.\n" \ "You need an ANSI C compiler to build OCaml.";; *) - if test x"$host" != x"$target"; then + if $cross_compiler; then wrn "Unable to compile the test program.\n" \ "This failure is expected for cross-compilation:\n" \ "we will assume the C compiler is ANSI-compliant." @@ -460,29 +469,43 @@ case $? in fi;; esac -# Determine which ocamlrun executable to use; for cross-compilation, a native -# "ocamlrun" executable must be available on the system. -if test x"$target" != x"$host"; then +# For cross-compilation, we need a host-based ocamlrun and ocamlyacc, +# and the user must specify the target BINDIR +if $cross_compiler; then if ! sh ./searchpath ocamlrun; then err "Cross-compilation requires an ocaml runtime environment\n" \ "(the ocamlrun binary). Moreover, its version must be the same\n" \ "as the one you're trying to build (`cut -f1 -d+ < ../../VERSION`)." else - ocaml_system_version=`ocamlrun -version | sed 's/[^0-9]*\([0-9.]\+\).*/\1/'` - ocaml_source_version=`sed -n '1 s/\([0-9\.]\+\).*/\1/ p' < ../../VERSION` + ocaml_system_version=`ocamlrun -version | sed 's/[^0-9]*\([0-9.]*\).*/\1/'` + ocaml_source_version=`sed -n '1 s/\([0-9\.]*\).*/\1/ p' < ../../VERSION` if test x"$ocaml_system_version" != x"$ocaml_source_version"; then err "While you have an ocaml runtime environment, its version\n" \ "($ocaml_system_version) doesn't match the version of these sources\n" \ "($ocaml_source_version)." else - CAMLRUN="ocamlrun" + echo "CAMLRUN=`./searchpath -p ocamlrun`" >> Makefile fi fi -else - CAMLRUN=`cd ../.. && pwd`/boot/ocamlrun -fi -echo "CAMLRUN=$CAMLRUN" >> Makefile + if ! sh ./searchpath ocamlyacc; then + err "Cross-compilation requires an ocamlyacc binary." + else + ocamlyacc 2>/dev/null + if test "$?" -ne 1; then + err "While you have an ocamlyacc binary, it cannot be executed successfully." + else + echo "CAMLYACC=`./searchpath -p ocamlyacc`" >> Makefile + fi + fi + + if [ -z "$target_bindir" ]; then + err "Cross-compilation requires -target-bindir." + else + echo "TARGET_BINDIR=$target_bindir" >> Makefile + fi +fi # cross-compiler + # Check the sizes of data types # OCaml needs a 32 or 64 bit architecture, a 32-bit integer type and @@ -914,6 +937,8 @@ case "$arch,$system" in case "$nativecc" in gcc*) ;; *) cc_profile='-xpg';; esac;; amd64,linux) profiling='prof';; amd64,openbsd) profiling='prof';; + amd64,freebsd) profiling='prof';; + amd64,netbsd) profiling='prof';; amd64,gnu) profiling='prof';; arm,linux*) profiling='prof';; power,elf) profiling='prof';; @@ -955,7 +980,8 @@ if (SHELL=/bin/sh; export SHELL; (./sharpbang || ./sharpbang2) >/dev/null); then "under Cygwin" echo "SHARPBANGSCRIPTS=false" >> Makefile;; *-*-mingw*) - inf "We won't use it, though, because it's on the target platform it would be used and windows doesn't support it." + inf "We won't use it, though, because it's on the target platform " \ + "it would be used and windows doesn't support it." echo "SHARPBANGSCRIPTS=false" >> Makefile;; *) echo "SHARPBANGSCRIPTS=true" >> Makefile;; @@ -1659,6 +1685,12 @@ if $no_naked_pointers; then echo "#define NO_NAKED_POINTERS" >> m.h fi +# Add Unix-style optimization flag +bytecccompopts="-O $bytecccompopts" +dllcccompopts="-O $dllcccompopts" +nativecccompopts="-O $nativecccompopts" +sharedcccompopts="-O $sharedcccompopts" + # Final twiddling of compiler options to work around known bugs nativeccprofopts="$nativecccompopts" diff --git a/debugger/Makefile.shared b/debugger/Makefile.shared index 645c3e1dd4..f3859c63d2 100644 --- a/debugger/Makefile.shared +++ b/debugger/Makefile.shared @@ -11,15 +11,15 @@ ######################################################################### include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc -ROOTDIR=.. -CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib +CAMLC=$(CAMLRUN) ../ocamlc -nostdlib -I ../stdlib COMPFLAGS=-warn-error A -safe-string $(INCLUDES) LINKFLAGS=-linkall -I $(UNIXDIR) -CAMLYACC=../boot/ocamlyacc YACCFLAGS= -CAMLLEX=../boot/ocamlrun ../boot/ocamllex -CAMLDEP=../boot/ocamlrun ../tools/ocamldep +CAMLLEX=$(CAMLRUN) ../boot/ocamllex +CAMLDEP=$(CAMLRUN) ../tools/ocamldep DEPFLAGS=$(INCLUDES) INSTALL_BINDIR=$(DESTDIR)$(BINDIR) diff --git a/driver/compenv.ml b/driver/compenv.ml index 68a4e05042..6f3567e882 100644 --- a/driver/compenv.ml +++ b/driver/compenv.ml @@ -56,26 +56,28 @@ let first_objfiles = ref [] let last_objfiles = ref [] (* Check validity of module name *) -let check_unit_name ppf filename name = +let is_unit_name name = try begin match name.[0] with | 'A'..'Z' -> () | _ -> - Location.print_warning (Location.in_file filename) ppf - (Warnings.Bad_module_name name); raise Exit; end; for i = 1 to String.length name - 1 do match name.[i] with | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> () | _ -> - Location.print_warning (Location.in_file filename) ppf - (Warnings.Bad_module_name name); raise Exit; done; - with Exit -> () + true + with Exit -> false ;; +let check_unit_name ppf filename name = + if not (is_unit_name name) then + Location.print_warning (Location.in_file filename) ppf + (Warnings.Bad_module_name name);; + (* Compute name of module from output file name *) let module_of_filename ppf inputfile outputprefix = let basename = Filename.basename outputprefix in diff --git a/driver/compenv.mli b/driver/compenv.mli index 85d588ef6e..59cd10124f 100644 --- a/driver/compenv.mli +++ b/driver/compenv.mli @@ -10,7 +10,6 @@ (* *) (***********************************************************************) -(* val check_unit_name : Format.formatter -> string -> string -> unit *) val module_of_filename : Format.formatter -> string -> string -> string val output_prefix : string -> string @@ -35,3 +34,10 @@ type readenv_position = Before_args | Before_compile | Before_link val readenv : Format.formatter -> readenv_position -> unit + +(* [is_unit_name name] returns true only if [name] can be used as a + correct module name *) +val is_unit_name : string -> bool +(* [check_unit_name ppf filename name] prints a warning in [filename] + on [ppf] if [name] should not be used as a module name. *) +val check_unit_name : Format.formatter -> string -> string -> unit diff --git a/driver/compile.ml b/driver/compile.ml index 7ce751ec70..b18e611a00 100644 --- a/driver/compile.ml +++ b/driver/compile.ml @@ -60,50 +60,44 @@ let implementation ppf sourcefile outputprefix = let modulename = module_of_filename ppf sourcefile outputprefix in Env.set_unit_name modulename; let env = Compmisc.initial_env() in - if !Clflags.print_types then begin - let comp ast = - ast + try + let (typedtree, coercion) = + Pparse.parse_implementation ~tool_name ppf sourcefile ++ print_if ppf Clflags.dump_parsetree Printast.implementation ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env ++ print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion - ++ (fun _ -> ()); - Warnings.check_fatal (); - Stypes.dump (Some (outputprefix ^ ".annot")) + Printtyped.implementation_with_coercion in - try comp (Pparse.parse_implementation ~tool_name ppf sourcefile) - with x -> - Stypes.dump (Some (outputprefix ^ ".annot")); - raise x - end else begin - let objfile = outputprefix ^ ".cmo" in - let oc = open_out_bin objfile in - let comp ast = - ast - ++ print_if ppf Clflags.dump_parsetree Printast.implementation - ++ print_if ppf Clflags.dump_source Pprintast.structure - ++ Typemod.type_implementation sourcefile outputprefix modulename env - ++ print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion - ++ Translmod.transl_implementation modulename - ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda - ++ Simplif.simplify_lambda - ++ print_if ppf Clflags.dump_lambda Printlambda.lambda - ++ Bytegen.compile_implementation modulename - ++ print_if ppf Clflags.dump_instr Printinstr.instrlist - ++ Emitcode.to_file oc modulename objfile; + if !Clflags.print_types then begin Warnings.check_fatal (); - close_out oc; Stypes.dump (Some (outputprefix ^ ".annot")) - in - try comp (Pparse.parse_implementation ~tool_name ppf sourcefile) - with x -> - close_out oc; - remove_file objfile; - Stypes.dump (Some (outputprefix ^ ".annot")); - raise x - end + end else begin + let bytecode = + (typedtree, coercion) + ++ Translmod.transl_implementation modulename + ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda + ++ Simplif.simplify_lambda + ++ print_if ppf Clflags.dump_lambda Printlambda.lambda + ++ Bytegen.compile_implementation modulename + ++ print_if ppf Clflags.dump_instr Printinstr.instrlist + in + let objfile = outputprefix ^ ".cmo" in + let oc = open_out_bin objfile in + try + bytecode + ++ Emitcode.to_file oc modulename objfile; + Warnings.check_fatal (); + close_out oc; + Stypes.dump (Some (outputprefix ^ ".annot")) + with x -> + close_out oc; + remove_file objfile; + raise x + end + with x -> + Stypes.dump (Some (outputprefix ^ ".annot")); + raise x let c_file name = Location.input_name := name; diff --git a/driver/main.ml b/driver/main.ml index fae7343b42..9835284989 100644 --- a/driver/main.ml +++ b/driver/main.ml @@ -104,6 +104,8 @@ module Options = Main_args.Make_bytecomp_options (struct let _o s = output_name := Some s let _open s = open_modules := s :: !open_modules let _output_obj () = output_c_object := true; custom_runtime := true + let _output_complete_obj () = + output_c_object := true; output_complete_object := true; custom_runtime := true let _pack = set make_package let _pp s = preprocessor := Some s let _ppx s = first_ppx := s :: !first_ppx @@ -194,3 +196,7 @@ let main () = exit 2 let _ = main () + + + + diff --git a/driver/main_args.ml b/driver/main_args.ml index d37d23c923..d288c9b57a 100644 --- a/driver/main_args.ml +++ b/driver/main_args.ml @@ -222,7 +222,12 @@ let mk_open f = "-open", Arg.String f, "<module> Opens the module <module> before typing" let mk_output_obj f = - "-output-obj", Arg.Unit f, " Output a C object file instead of an executable" + "-output-obj", Arg.Unit f, " Output an object file instead of an executable" +;; + +let mk_output_complete_obj f = + "-output-complete-obj", Arg.Unit f, + " Output an object file, including runtime, instead of an executable" ;; let mk_p f = @@ -534,6 +539,7 @@ module type Compiler_options = sig val _noautolink : unit -> unit val _o : string -> unit val _output_obj : unit -> unit + val _output_complete_obj : unit -> unit val _pack : unit -> unit val _pp : string -> unit val _principal : unit -> unit @@ -685,6 +691,7 @@ struct mk_o F._o; mk_open F._open; mk_output_obj F._output_obj; + mk_output_complete_obj F._output_complete_obj; mk_pack_byt F._pack; mk_pp F._pp; mk_ppx F._ppx; @@ -803,6 +810,7 @@ struct mk_o F._o; mk_open F._open; mk_output_obj F._output_obj; + mk_output_complete_obj F._output_complete_obj; mk_p F._p; mk_pack_opt F._pack; mk_pp F._pp; diff --git a/driver/main_args.mli b/driver/main_args.mli index 0f55a0fd0c..ddee921d4b 100644 --- a/driver/main_args.mli +++ b/driver/main_args.mli @@ -68,6 +68,7 @@ module type Compiler_options = sig val _noautolink : unit -> unit val _o : string -> unit val _output_obj : unit -> unit + val _output_complete_obj : unit -> unit val _pack : unit -> unit val _pp : string -> unit val _principal : unit -> unit diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 7ce3d86870..b4265c0bff 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -66,22 +66,16 @@ let implementation ppf sourcefile outputprefix = let cmxfile = outputprefix ^ ".cmx" in let objfile = outputprefix ^ ext_obj in let comp ast = - if !Clflags.print_types - then + let (typedtree, coercion) = ast ++ print_if ppf Clflags.dump_parsetree Printast.implementation ++ print_if ppf Clflags.dump_source Pprintast.structure ++ Typemod.type_implementation sourcefile outputprefix modulename env ++ print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion - ++ (fun _ -> ()) - else begin - ast - ++ print_if ppf Clflags.dump_parsetree Printast.implementation - ++ print_if ppf Clflags.dump_source Pprintast.structure - ++ Typemod.type_implementation sourcefile outputprefix modulename env - ++ print_if ppf Clflags.dump_typedtree - Printtyped.implementation_with_coercion + Printtyped.implementation_with_coercion + in + if not !Clflags.print_types then begin + (typedtree, coercion) ++ Translmod.transl_store_implementation modulename +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda +++ Simplif.simplify_lambda diff --git a/driver/optmain.ml b/driver/optmain.ml index 7cab9d1bb3..84c27b7866 100644 --- a/driver/optmain.ml +++ b/driver/optmain.ml @@ -104,6 +104,8 @@ module Options = Main_args.Make_optcomp_options (struct let _o s = output_name := Some s let _open s = open_modules := s :: !open_modules let _output_obj = set output_c_object + let _output_complete_obj s = + set output_c_object s; set output_complete_object s let _p = set gprofile let _pack = set make_package let _pp s = preprocessor := Some s diff --git a/driver/pparse.ml b/driver/pparse.ml index 4b2553f272..b67c1805d3 100644 --- a/driver/pparse.ml +++ b/driver/pparse.ml @@ -20,10 +20,7 @@ exception Error of error (* Optionally preprocess a source file *) -let preprocess sourcefile = - match !Clflags.preprocessor with - None -> sourcefile - | Some pp -> +let call_external_preprocessor sourcefile pp = let tmpfile = Filename.temp_file "ocamlpp" "" in let comm = Printf.sprintf "%s %s > %s" pp (Filename.quote sourcefile) tmpfile @@ -34,6 +31,12 @@ let preprocess sourcefile = end; tmpfile +let preprocess sourcefile = + match !Clflags.preprocessor with + None -> sourcefile + | Some pp -> call_external_preprocessor sourcefile pp + + let remove_preprocessed inputfile = match !Clflags.preprocessor with None -> () @@ -124,7 +127,7 @@ let apply_rewriters ?restore ~tool_name magic ast = exception Outdated_version -let file ppf ~tool_name inputfile parse_fun ast_magic = +let open_and_check_magic inputfile ast_magic = let ic = open_in_bin inputfile in let is_ast_file = try @@ -138,6 +141,10 @@ let file ppf ~tool_name inputfile parse_fun ast_magic = Misc.fatal_error "OCaml and preprocessor have incompatible versions" | _ -> false in + (ic, is_ast_file) + +let file ppf ~tool_name inputfile parse_fun ast_magic = + let (ic, is_ast_file) = open_and_check_magic inputfile ast_magic in let ast = try if is_ast_file then begin @@ -159,6 +166,7 @@ let file ppf ~tool_name inputfile parse_fun ast_magic = close_in ic; apply_rewriters ~restore:false ~tool_name ast_magic ast + let report_error ppf = function | CannotRun cmd -> fprintf ppf "Error while running external preprocessor@.\ diff --git a/driver/pparse.mli b/driver/pparse.mli index bcff4e7815..6497698939 100644 --- a/driver/pparse.mli +++ b/driver/pparse.mli @@ -34,3 +34,8 @@ val report_error : formatter -> error -> unit val parse_implementation: formatter -> tool_name:string -> string -> Parsetree.structure val parse_interface: formatter -> tool_name:string -> string -> Parsetree.signature + +(* [call_external_preprocessor sourcefile pp] *) +val call_external_preprocessor : string -> string -> string +val open_and_check_magic : string -> string -> in_channel * bool +val read_ast : string -> string -> 'a diff --git a/emacs/caml-types.el b/emacs/caml-types.el index 4bc2266557..0af667bdd2 100644 --- a/emacs/caml-types.el +++ b/emacs/caml-types.el @@ -20,6 +20,18 @@ (require 'caml-emacs))) +(defvar caml-types-build-dirs '("_build" "_obuild") + "List of possible compilation directories created by build systems. +It is expected that the files under `caml-types-build-dir' preserve +the paths relative to the parent directory of `caml-types-build-dir'.") +(make-variable-buffer-local 'caml-types-build-dir) + +(defvar caml-annot-dir nil + "A directory, generally relative to the file location, containing the +.annot file. Intended to be set as a local variable in the .ml file. +See \"Specifying File Variables\" in the Emacs info manual.") +(make-variable-buffer-local 'caml-annot-dir) +(put 'caml-annot-dir 'safe-local-variable #'stringp) (defvar caml-types-location-re nil "Regexp to parse *.annot files. @@ -349,21 +361,36 @@ See `caml-types-location-re' for annotation file format. (defun caml-types-parent-dir (d) (file-name-directory (directory-file-name d))) (defun caml-types-locate-type-file (target-path) - (let ((sibling (concat (file-name-sans-extension target-path) ".annot"))) - (if (file-exists-p sibling) - sibling - (let ((project-dir (file-name-directory sibling)) - type-path) - (while (not (file-exists-p - (setq type-path - (expand-file-name - (file-relative-name sibling project-dir) - (expand-file-name "_build" project-dir))))) - (if (equal project-dir (caml-types-parent-dir project-dir)) - (error (concat "No annotation file. " - "You should compile with option \"-annot\"."))) - (setq project-dir (caml-types-parent-dir project-dir))) - type-path)))) + "Given the path to an OCaml file, this function tries to locate +and return the corresponding .annot file." + (let ((sibling (concat (file-name-sans-extension target-path) ".annot"))) + (if (file-exists-p sibling) + sibling + (let* ((dir (file-name-directory sibling))) + (if caml-annot-dir + ;; Use the relative path set by the user + (let* ((annot-dir (expand-file-name caml-annot-dir dir)) + (fname (file-name-nondirectory sibling)) + (path-fname (expand-file-name fname annot-dir))) + (if (file-exists-p path-fname) + path-fname + (error (concat "No annotation file in " caml-annot-dir + ". Compile with option \"-annot\".")))) + ;; Else, try to get the .annot from one of build dirs. + (let* ((is-build (regexp-opt caml-types-build-dirs)) + (project-dir (locate-dominating-file + dir + (lambda(d) (directory-files d nil is-build)))) + (annot + (if project-dir + (locate-file + (file-relative-name sibling project-dir) + (mapcar (lambda(d) (expand-file-name d project-dir)) + caml-types-build-dirs))))) + (if annot + annot + (error (concat "No annotation file. Compile with option " + "\"-annot\" or set `caml-annot-dir'."))))))))) (defun caml-types-date< (date1 date2) (or (< (car date1) (car date2)) diff --git a/lex/Makefile b/lex/Makefile index cb5df8b41c..3691cb2b3f 100644 --- a/lex/Makefile +++ b/lex/Makefile @@ -11,13 +11,17 @@ ######################################################################### # The lexer generator -CAMLC=../boot/ocamlrun ../boot/ocamlc -strict-sequence -nostdlib -I ../boot -CAMLOPT=../boot/ocamlrun ../ocamlopt -nostdlib -I ../stdlib +include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc + +CAMLC=$(CAMLRUN) ../boot/ocamlc -strict-sequence -nostdlib -I ../boot +CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string -CAMLYACC=../boot/ocamlyacc +LINKFLAGS= YACCFLAGS=-v -CAMLLEX=../boot/ocamlrun ../boot/ocamllex -CAMLDEP=../boot/ocamlrun ../tools/ocamldep +CAMLLEX=$(CAMLRUN) ../boot/ocamllex +CAMLDEP=$(CAMLRUN) ../tools/ocamldep OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \ diff --git a/lex/Makefile.nt b/lex/Makefile.nt index 38c71f2e8a..6bd8560406 100644 --- a/lex/Makefile.nt +++ b/lex/Makefile.nt @@ -13,15 +13,16 @@ # The lexer generator include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc -CAMLC=../boot/ocamlrun ../boot/ocamlc -I ../boot -CAMLOPT=../boot/ocamlrun ../ocamlopt -I ../stdlib +CAMLC=$(CAMLRUN) ../boot/ocamlc -I ../boot +CAMLOPT=$(CAMLRUN) ../ocamlopt -I ../stdlib COMPFLAGS=-warn-error A LINKFLAGS= -CAMLYACC=../boot/ocamlyacc YACCFLAGS=-v -CAMLLEX=../boot/ocamlrun ../boot/ocamllex -CAMLDEP=../boot/ocamlrun ../tools/ocamldep +CAMLLEX=$(CAMLRUN) ../boot/ocamllex +CAMLDEP=$(CAMLRUN) ../tools/ocamldep DEPFLAGS= OBJS=cset.cmo syntax.cmo parser.cmo lexer.cmo table.cmo lexgen.cmo \ diff --git a/man/ocamlc.m b/man/ocamlc.m index 3cd4e7447d..adb280927f 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -929,7 +929,8 @@ compiling your program with later versions of OCaml when they add new warnings or modify existing warnings. The default setting is -.B \-warn\-error\ -a (all warnings are non-fatal). +.B \-warn\-error \-a +(all warnings are non-fatal). .TP .B \-warn\-help Show the description of all available warning numbers. diff --git a/man/ocamlopt.m b/man/ocamlopt.m index 9a3a9b3bd3..a541e598d4 100644 --- a/man/ocamlopt.m +++ b/man/ocamlopt.m @@ -603,7 +603,8 @@ compiling your program with later versions of OCaml when they add new warnings or modify existing warnings. The default setting is -.B \-warn\-error\ -a (all warnings are non-fatal). +.B \-warn\-error \-a +(all warnings are non-fatal). .TP .B \-warn\-help Show the description of all available warning numbers. diff --git a/man/ocamlrun.m b/man/ocamlrun.m index 166e71ed62..2882395e5a 100644 --- a/man/ocamlrun.m +++ b/man/ocamlrun.m @@ -197,6 +197,9 @@ Calling of finalisation functions. Startup messages (loading the bytecode executable file, resolving shared libraries). +.BR 0x200 +Computation of compaction-triggering condition. + The multiplier is .BR k , .BR M ,\ or diff --git a/ocamlbuild/Makefile b/ocamlbuild/Makefile index 0a4054ddbd..d302d20687 100644 --- a/ocamlbuild/Makefile +++ b/ocamlbuild/Makefile @@ -11,13 +11,14 @@ ######################################################################### include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc ROOTDIR = .. -OCAMLRUN = $(ROOTDIR)/boot/ocamlrun -OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib -OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep -OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex +OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib +OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib +OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep +OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex CP = cp COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB) -safe-string LINKFLAGS= -I ../otherlibs/$(UNIXLIB) @@ -137,13 +138,14 @@ ocamlbuild_pack.cmx: $(PACK_CMX) ocamlbuild_config.ml: ../config/Makefile (echo 'let bindir = "$(BINDIR)"'; \ - echo 'let libdir = "$(LIBDIR)"'; \ - echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ - echo 'let a = "$(A)"'; \ - echo 'let o = "$(O)"'; \ - echo 'let so = "$(SO)"'; \ - echo 'let exe = "$(EXE)"'; \ - ) > ocamlbuild_config.ml + echo 'let libdir = "$(LIBDIR)"'; \ + echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\ + echo 'let a = "$(A)"'; \ + echo 'let o = "$(O)"'; \ + echo 'let so = "$(SO)"'; \ + echo 'let ext_dll = "$(EXT_DLL)"'; \ + echo 'let exe = "$(EXE)"'; \ + ) > ocamlbuild_config.ml clean:: rm -f ocamlbuild_config.ml beforedepend:: ocamlbuild_config.ml diff --git a/ocamlbuild/Makefile.noboot b/ocamlbuild/Makefile.noboot deleted file mode 100644 index 313e56891c..0000000000 --- a/ocamlbuild/Makefile.noboot +++ /dev/null @@ -1,227 +0,0 @@ -#(***********************************************************************) -#(* *) -#(* ocamlbuild *) -#(* *) -#(* Wojciech Meyer *) -#(* *) -#(* Copyright 2012 Institut National de Recherche en Informatique et *) -#(* en Automatique. All rights reserved. This file is distributed *) -#(* under the terms of the Q Public License version 1.0. *) -#(* *) -#(***********************************************************************) - -# This file removes the dependency on ocamlbuild itself, thus removes need -# for bootstrap. The base for this Makefile was ocamldoc Makefile. - -include ../config/Makefile - -# Various commands and dir -########################## - -ROOTDIR = .. -OCAMLRUN = $(ROOTDIR)/boot/ocamlrun -OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib -OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep -OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex -OCAMLLIB = $(LIBDIR) -OCAMLBIN = $(BINDIR) - -# For installation -############## -MKDIR=mkdir -p -CP=cp -f -OCAMLBUILD=ocamlbuild -OCAMLBUILD_OPT=$(OCAMLBUILD).opt -OCAMLBUILD_LIBCMA=ocamlbuildlib.cma -OCAMLBUILD_LIBCMI=ocamlbuildlib.cmi -OCAMLBUILD_LIBCMXA=ocamlbuild.cmxa -OCAMLBUILD_LIBA=ocamlbuild.$(A) -INSTALL_LIBDIR=$(DESTDIR)$(OCAMLLIB)/ocamlbuild -INSTALL_CUSTOMDIR=$(INSTALL_LIBDIR)/custom -INSTALL_BINDIR=$(DESTDIR)$(OCAMLBIN) - -INSTALL_MLIS= -INSTALL_CMIS=$(INSTALL_MLIS:.mli=.cmi) - -# Compilation -############# -OCAMLSRCDIR=.. -INCLUDES_DEP= - -INCLUDES_NODEP= -I $(OCAMLSRCDIR)/stdlib \ - -I $(OCAMLSRCDIR)/otherlibs/str \ - -I $(OCAMLSRCDIR)/otherlibs/dynlink \ - -I $(OCAMLSRCDIR)/otherlibs/$(UNIXLIB) - -INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP) - -COMPFLAGS=$(INCLUDES) -warn-error A -safe-string -LINKFLAGS=$(INCLUDES) - -CMOFILES_PACK= \ - ocamlbuild_Myocamlbuild_config.cmo \ - discard_printf.cmo \ - my_std.cmo \ - bool.cmo \ - glob_ast.cmo \ - glob_lexer.cmo \ - glob.cmo \ - lexers.cmo \ - my_unix.cmo \ - tags.cmo \ - display.cmo \ - log.cmo \ - param_tags.cmo \ - shell.cmo \ - slurp.cmo \ - ocamlbuild_where.cmo \ - command.cmo \ - options.cmo \ - pathname.cmo \ - digest_cache.cmo \ - resource.cmo \ - rule.cmo \ - flags.cmo \ - solver.cmo \ - report.cmo \ - ocaml_arch.cmo \ - hygiene.cmo \ - configuration.cmo \ - tools.cmo \ - fda.cmo \ - plugin.cmo \ - ocaml_utils.cmo \ - ocaml_dependencies.cmo \ - ocaml_compiler.cmo \ - ocaml_tools.cmo \ - hooks.cmo \ - findlib.cmo \ - ocaml_specific.cmo \ - exit_codes.cmo \ - main.cmo - -BASE_CMOFILES= ocamlbuild_executor.cmo \ - ocamlbuild_unix_plugin.cmo - -INSTALL_LIBFILES = $(BASE_CMOFILES) \ - $(BASE_CMOFILES:.cmo=.cmi) \ - $(OCAMLBUILD_LIBCMA) \ - $(OCAMLBUILD).cmo \ - $(OCAMLBUILD)_pack.cmi - -INSTALL_BINFILES = $(OCAMLBUILD) - -CMXFILES= $(CMOFILES:.cmo=.cmx) - -CMXFILES_PACK= $(CMOFILES_PACK:.cmo=.cmx) -CMIFILES_PACK= $(CMOFILES_PACK:.cmo=.cmi) signatures.cmi - -EXECMOFILES_PACK= $(CMOFILES_PACK) -EXECMXFILES_PACK= $(EXECMOFILES_PACK:.cmo=.cmx) -EXECMIFILES_PACK= $(EXECMOFILES_PACK:.cmo=.cmi) - -LIBCMOFILES_PACK= $(CMOFILES_PACK) -LIBCMXFILES_PACK= $(LIBCMOFILES_PACK:.cmo=.cmx) -LIBCMIFILES_PACK= $(LIBCMOFILES_PACK:.cmo=.cmi) - -# Les cmo et cmx de la distrib OCAML -OCAMLCMOFILES= -OCAMLCMXFILES=$(OCAMLCMOFILES_PACK:.cmo=.cmx) - -all: exe lib -opt: $(OCAMLBUILD).native -exe: $(OCAMLBUILD) -lib: $(OCAMLBUILD_LIBCMA) - -opt.opt: exeopt libopt -exeopt: $(OCAMLBUILD_OPT) -libopt: $(OCAMLBUILD_LIBCMXA) $(OCAMLBUILD_LIBCMI) - -debug: - $(MAKE) OCAMLPP="" - -$(OCAMLBUILD)_pack.cmo: $(CMOFILES_PACK) $(CMIFILES_PACK) - $(OCAMLC) -pack -o $@ $(LINKFLAGS) $(OCAMLCMOFILES_PACK) $(EXECMOFILES_PACK) signatures.mli - -$(OCAMLBUILD)_pack.cmx: $(EXECMXFILES_PACK) - $(OCAMLOPT) -pack -o $@ $(LINKFLAGS) $(OCAMLCMOFILES_PACK) $(EXECMXFILES_PACK) - -$(OCAMLBUILD): $(OCAMLBUILD)_pack.cmo $(CMOFILES) $(OCAMLBUILD).cmo $(BASE_CMOFILES) - $(OCAMLC) -o $@ unix.cma $(LINKFLAGS) $(OCAMLBUILD)_pack.cmo $(CMOFILES) - -$(OCAMLBUILD).native: $(OCAMLBUILD)_pack.cmx $(CMXFILES) - $(OCAMLOPT) -o $@ $(LINKFLAGS) $(CMXFILES) - -$(OCAMLBUILD_LIBCMA): $(LIBCMOFILES_PACK) - $(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo $(LIBCMOFILES_PACK) -$(OCAMLBUILD_LIBCMXA): $(LIBCMXFILES) - $(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx $(LIBCMXFILES) - -# generic rules : -################# - -.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs - -.ml.cmo: - $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< - -.mli.cmi: - $(OCAMLC) $(OCAMLPP) $(COMPFLAGS) -c $< - -.ml.cmx: - $(OCAMLOPT) $(OCAMLPP) $(COMPFLAGS) -c $< - -.ml.cmxs: - $(OCAMLOPT) -shared -o $@ $(OCAMLPP) $(COMPFLAGS) $< - -.mll.ml: - $(OCAMLLEX) $< - -.mly.ml: - $(OCAMLYACC) -v $< - -.mly.mli: - $(OCAMLYACC) -v $< - -# Installation targets -###################### -install: dummy - if test -d $(INSTALL_BINDIR); then : ; else $(MKDIR) $(INSTALL_BINDIR); fi - if test -d $(INSTALL_LIBDIR); then : ; else $(MKDIR) $(INSTALL_LIBDIR); fi - if test -d $(INSTALL_CUSTOMDIR); then : ; else $(MKDIR) $(INSTALL_CUSTOMDIR); fi - $(CP) $(OCAMLBUILD) $(INSTALL_BINDIR)/$(OCAMLBUILD)$(EXE) - $(CP) $(INSTALL_LIBFILES) $(INSTALL_LIBDIR) - $(CP) $(INSTALL_BINFILES) $(INSTALL_BINDIR) - -installopt: - if test -f $(OCAMLBUILD_OPT) ; then $(MAKE) installopt_really ; fi - -installopt_really: - if test -d $(INSTALL_BINDIR); then : ; else $(MKDIR) $(INSTALL_BINDIR); fi - if test -d $(INSTALL_LIBDIR); then : ; else $(MKDIR) $(INSTALL_LIBDIR); fi - $(CP) ocamlbuild.hva $(OCAMLBUILD_LIBA) $(OCAMLBUILD_LIBCMXA) $(INSTALL_LIBDIR) - $(CP) $(INSTALL_MLIS) $(INSTALL_CMIS) $(INSTALL_LIBDIR) - - -# backup, clean and depend : -############################ - -clean:: dummy - @rm -f *~ \#*\# - @rm -f $(OCAMLBUILD) $(OCAMLBUILD_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.$(A) *.$(O) - @rm -f glob_lexer.ml lexers.ml - -depend:: - $(OCAMLDEP) $(INCLUDES_DEP) *.mli *.mll *.mly *.ml > .depend - -dummy: - -include .depend - -# Additional rules -glob_lexer.cmo: glob_lexer.cmi -lexers.cmo: lexers.cmi - -glob_lexer.cmx: glob_lexer.cmi -lexers.cmx: lexers.cmi diff --git a/ocamlbuild/command.ml b/ocamlbuild/command.ml index 3bb2614b9f..79e2a1dc4a 100644 --- a/ocamlbuild/command.ml +++ b/ocamlbuild/command.ml @@ -393,6 +393,9 @@ let pdep tags ptag deps = Param_tags.declare ptag (fun param -> dep (Param_tags.make ptag param :: tags) (deps param)) +let list_all_deps () = + !all_deps_of_tags + (* let to_string_for_digest x = let rec cmd_of_spec = diff --git a/ocamlbuild/command.mli b/ocamlbuild/command.mli index 18547a459c..a28c75190b 100644 --- a/ocamlbuild/command.mli +++ b/ocamlbuild/command.mli @@ -46,4 +46,6 @@ val dep : Tags.elt list -> pathname list -> unit val pdep : Tags.elt list -> Tags.elt -> (string -> pathname list) -> unit +val list_all_deps : unit -> (Tags.t * pathname list) list + val file_or_exe_exists: string -> bool diff --git a/ocamlbuild/configuration.ml b/ocamlbuild/configuration.ml index 6290e60a95..bc50a0105e 100644 --- a/ocamlbuild/configuration.ml +++ b/ocamlbuild/configuration.ml @@ -81,10 +81,11 @@ let tag_any tags = let check_tags_usage useful_tags = let check_tag (tag, loc) = if not (Tags.mem tag useful_tags) then - Log.eprintf "%aWarning: the tag %S is not used in any flag declaration, \ - so it will have no effect; it may be a typo. Otherwise use \ - `mark_tag_used` in your myocamlbuild.ml to disable \ - this warning." + + Log.eprintf "%aWarning: the tag %S is not used in any flag or dependency \ + declaration, so it will have no effect; it may be a typo. \ + Otherwise you can use `mark_tag_used` in your myocamlbuild.ml \ + to disable this warning." Loc.print_loc loc tag in let check_conf (_, values) = diff --git a/ocamlbuild/main.ml b/ocamlbuild/main.ml index 8f7d6f76e0..d59a450b20 100644 --- a/ocamlbuild/main.ml +++ b/ocamlbuild/main.ml @@ -25,7 +25,6 @@ exception Exit_build_error of string exception Exit_silently let clean () = - Log.finish (); Shell.rm_rf !Options.build_dir; if !Options.make_links then begin let entry = @@ -34,6 +33,7 @@ let clean () = in Slurp.force (Resource.clean_up_links entry) end; + Log.finish (); raise Exit_silently ;; @@ -67,6 +67,8 @@ let builtin_useful_tags = let proceed () = Hooks.call_hook Hooks.Before_options; Options.init (); + Options.include_dirs := List.map Pathname.normalize !Options.include_dirs; + Options.exclude_dirs := List.map Pathname.normalize !Options.exclude_dirs; if !Options.must_clean then clean (); Hooks.call_hook Hooks.After_options; let options_wd = Sys.getcwd () in @@ -203,7 +205,14 @@ let proceed () = raise Exit_silently end; - let all_tags = Tags.union builtin_useful_tags (Flags.get_used_tags ()) in + let all_tags = + let builtin = builtin_useful_tags in + let used_in_flags = Flags.get_used_tags () in + let used_in_deps = + List.fold_left (fun acc (tags, _deps) -> Tags.union acc tags) + Tags.empty (Command.list_all_deps ()) + in + Tags.union builtin (Tags.union used_in_flags used_in_deps) in Configuration.check_tags_usage all_tags; Digest_cache.init (); diff --git a/ocamlbuild/my_unix.ml b/ocamlbuild/my_unix.ml index fa1c5d45f4..5bfbee01af 100644 --- a/ocamlbuild/my_unix.ml +++ b/ocamlbuild/my_unix.ml @@ -84,6 +84,12 @@ let rec readlink x = if sys_file_exists x then try let y = readlinkcmd x in + let y = + if Filename.is_relative y then + Filename.concat (Filename.dirname x) y + else + y + in if (lstat y).stat_file_kind = FK_dir then raise Link_to_directories_not_supported else y with Failure(_) -> raise Not_a_link else raise No_such_file diff --git a/ocamlbuild/ocamlbuild_unix_plugin.ml b/ocamlbuild/ocamlbuild_unix_plugin.ml index 9966c4dc0f..2ed88b99d9 100644 --- a/ocamlbuild/ocamlbuild_unix_plugin.ml +++ b/ocamlbuild/ocamlbuild_unix_plugin.ml @@ -72,13 +72,22 @@ let execute_many = in Ocamlbuild_executor.execute ~exit +(* Ocamlbuild code assumes throughout that [readlink] will return a file name + relative to the current directory. Let's make it so. *) +let myunixreadlink x = + let y = Unix.readlink x in + if Filename.is_relative y then + Filename.concat (Filename.dirname x) y + else + y + let setup () = implem.is_degraded <- false; implem.stdout_isatty <- stdout_isatty; implem.gettimeofday <- Unix.gettimeofday; implem.report_error <- report_error; implem.execute_many <- execute_many; - implem.readlink <- Unix.readlink; + implem.readlink <- myunixreadlink; implem.run_and_open <- run_and_open; implem.at_exit_once <- at_exit_once; implem.is_link <- is_link; diff --git a/ocamlbuild/options.ml b/ocamlbuild/options.ml index ffef6a9b47..32c518694d 100644 --- a/ocamlbuild/options.ml +++ b/ocamlbuild/options.ml @@ -101,7 +101,9 @@ let show_documentation = ref false let recursive = ref false let ext_lib = ref Ocamlbuild_config.a let ext_obj = ref Ocamlbuild_config.o -let ext_dll = ref Ocamlbuild_config.so +let ext_dll = + let s = Ocamlbuild_config.ext_dll in + ref (String.sub s 1 (String.length s - 1)) let exe = ref Ocamlbuild_config.exe let targets_internal = ref [] diff --git a/ocamlbuild/testsuite/internal.ml b/ocamlbuild/testsuite/internal.ml index 26421f0855..9b48af5273 100644 --- a/ocamlbuild/testsuite/internal.ml +++ b/ocamlbuild/testsuite/internal.ml @@ -321,11 +321,4 @@ let () = test "OpenDependencies" ~matching:[M.f "b.byte"] ~targets:("b.byte",[]) ();; -let () = test "OCamlcC" - ~options:[`no_ocamlfind] - ~description:"Build a C file using ocamlc (PR#6475)" - ~tree:[T.d "nested" [T.f "foo.c" ~content:"void f(){}"]] - ~matching:[_build [M.d "nested" [M.f "foo.o"]]] - ~targets:("nested/foo.o",[]) ();; - run ~root:"_test_internal";; diff --git a/ocamldoc/Makefile b/ocamldoc/Makefile index 7a487c6ca0..7c6d9885d7 100644 --- a/ocamldoc/Makefile +++ b/ocamldoc/Makefile @@ -11,16 +11,16 @@ #(***********************************************************************) include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc # Various commands and dir ########################## ROOTDIR = .. -OCAMLRUN = $(ROOTDIR)/boot/ocamlrun -OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib -OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep -OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex -OCAMLYACC = $(ROOTDIR)/yacc/ocamlyacc +OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib +OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib +OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep +OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex OCAMLLIB = $(LIBDIR) OCAMLBIN = $(BINDIR) @@ -233,10 +233,10 @@ odoc_see_lexer.ml: odoc_see_lexer.mll $(OCAMLLEX) $< .mly.ml: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< .mly.mli: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< # Installation targets ###################### @@ -343,8 +343,8 @@ clean:: dummy @rm -f generators/*.cm[aiox] generators/*.$(A) generators/*.$(O) generators/*.cmx[as] depend:: - $(OCAMLYACC) odoc_text_parser.mly - $(OCAMLYACC) odoc_parser.mly + $(CAMLYACC) odoc_text_parser.mly + $(CAMLYACC) odoc_parser.mly $(OCAMLLEX) odoc_text_lexer.mll $(OCAMLLEX) odoc_lexer.mll $(OCAMLLEX) odoc_ocamlhtml.mll diff --git a/ocamldoc/Makefile.nt b/ocamldoc/Makefile.nt index 22cd36eb03..9c009596be 100644 --- a/ocamldoc/Makefile.nt +++ b/ocamldoc/Makefile.nt @@ -11,16 +11,16 @@ #(***********************************************************************) include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc # Various commands and dir ########################## ROOTDIR = .. -OCAMLRUN = $(ROOTDIR)/boot/ocamlrun -OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib -OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep -OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex -OCAMLYACC = $(ROOTDIR)/yacc/ocamlyacc +OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib +OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib +OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep +OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex OCAMLLIB = $(LIBDIR) OCAMLBIN = $(BINDIR) @@ -202,10 +202,10 @@ odoc_see_lexer.ml: odoc_see_lexer.mll $(OCAMLLEX) $< .mly.ml: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< .mly.mli: - $(OCAMLYACC) -v $< + $(CAMLYACC) -v $< # Installation targets ###################### @@ -240,8 +240,8 @@ clean:: dummy @rm -f generators/*.cm[aiox] generators/*.$(A) generators/*.$(O) generators/*.cmx[as] depend:: - $(OCAMLYACC) odoc_text_parser.mly - $(OCAMLYACC) odoc_parser.mly + $(CAMLYACC) odoc_text_parser.mly + $(CAMLYACC) odoc_parser.mly $(OCAMLLEX) odoc_text_lexer.mll $(OCAMLLEX) odoc_lexer.mll $(OCAMLLEX) odoc_ocamlhtml.mll diff --git a/ocamldoc/odoc_ast.ml b/ocamldoc/odoc_ast.ml index a93e2c2e4a..3ccdce5cb9 100644 --- a/ocamldoc/odoc_ast.ml +++ b/ocamldoc/odoc_ast.ml @@ -1719,7 +1719,11 @@ module Analyser = } in match (p_module_expr.Parsetree.pmod_desc, tt_module_expr.Typedtree.mod_desc) with - (Parsetree.Pmod_ident longident, Typedtree.Tmod_ident (path, _)) -> + (Parsetree.Pmod_ident longident, Typedtree.Tmod_ident (path, _)) + | (Parsetree.Pmod_ident longident, + Typedtree.Tmod_constraint + ({Typedtree.mod_desc = Typedtree.Tmod_ident (path, _)}, _, _, _)) + -> let alias_name = Odoc_env.full_module_name env (Name.from_path path) in { m_base with m_kind = Module_alias { ma_name = alias_name ; ma_module = None ; } } @@ -1869,6 +1873,7 @@ module Analyser = (*DEBUG*) | Parsetree.Pmod_apply _ -> "Pmod_apply" (*DEBUG*) | Parsetree.Pmod_constraint _ -> "Pmod_constraint" (*DEBUG*) | Parsetree.Pmod_unpack _ -> "Pmod_unpack" + (*DEBUG*) | Parsetree.Pmod_extension _ -> "Pmod_extension" (*DEBUG*)in (*DEBUG*)let s_typed = (*DEBUG*) match typedtree with diff --git a/otherlibs/Makefile b/otherlibs/Makefile index 8516173b1f..ff4dbb09ef 100644 --- a/otherlibs/Makefile +++ b/otherlibs/Makefile @@ -13,8 +13,8 @@ # Common Makefile for otherlibs on the Unix ports -CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -CAMLOPT=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlopt -nostdlib \ +CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib +CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \ -I $(ROOTDIR)/stdlib COPTFLAG=-O CFLAGS=-I$(ROOTDIR)/byterun $(COPTFLAG) $(SHAREDCCCOMPOPTS) $(EXTRACFLAGS) diff --git a/otherlibs/Makefile.shared b/otherlibs/Makefile.shared index 9bed5f7604..cb8bf1748c 100644 --- a/otherlibs/Makefile.shared +++ b/otherlibs/Makefile.shared @@ -15,10 +15,11 @@ ROOTDIR=../.. include $(ROOTDIR)/config/Makefile +CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun +CAMLYACC ?= $(ROOTDIR)/boot/ocamlyacc # Compilation options CC=$(BYTECC) -CAMLRUN=$(ROOTDIR)/boot/ocamlrun COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string $(EXTRACAMLFLAGS) MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib diff --git a/otherlibs/bigarray/.depend b/otherlibs/bigarray/.depend index 4c11eb9bb9..62fc33293a 100644 --- a/otherlibs/bigarray/.depend +++ b/otherlibs/bigarray/.depend @@ -7,7 +7,8 @@ bigarray_stubs.o: bigarray_stubs.c ../../byterun/caml/alloc.h \ ../../byterun/caml/io.h ../../byterun/caml/hash.h \ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \ - ../../byterun/caml/minor_gc.h ../../byterun/caml/signals.h + ../../byterun/caml/minor_gc.h ../../byterun/caml/signals.h \ + ../../byterun/caml/address_class.h mmap_unix.o: mmap_unix.c bigarray.h ../../byterun/caml/config.h \ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \ ../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \ diff --git a/otherlibs/bigarray/Makefile b/otherlibs/bigarray/Makefile index 3f9afd5fdb..3bcc7a4022 100644 --- a/otherlibs/bigarray/Makefile +++ b/otherlibs/bigarray/Makefile @@ -22,6 +22,6 @@ include ../Makefile depend: $(CC) -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/bigarray/Makefile.nt b/otherlibs/bigarray/Makefile.nt index 32642e107f..baeaa7a160 100644 --- a/otherlibs/bigarray/Makefile.nt +++ b/otherlibs/bigarray/Makefile.nt @@ -22,6 +22,6 @@ include ../Makefile.nt depend: $(CC) -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h index 9b84b018a3..23bde23336 100644 --- a/otherlibs/bigarray/bigarray.h +++ b/otherlibs/bigarray/bigarray.h @@ -106,10 +106,18 @@ struct caml_ba_array { #define CAMLBAextern CAMLextern #endif +#ifdef __cplusplus +extern "C" { +#endif + CAMLBAextern value caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim); CAMLBAextern value caml_ba_alloc_dims(int flags, int num_dims, void * data, ... /*dimensions, with type intnat */); CAMLBAextern uintnat caml_ba_byte_size(struct caml_ba_array * b); +#ifdef __cplusplus +} #endif + +#endif /* CAML_BIGARRAY_H */ diff --git a/otherlibs/bigarray/bigarray.mli b/otherlibs/bigarray/bigarray.mli index ed32c94e84..da044ab141 100644 --- a/otherlibs/bigarray/bigarray.mli +++ b/otherlibs/bigarray/bigarray.mli @@ -452,7 +452,11 @@ module Genarray : the initial call to [map_file]. Therefore, you should make sure no other process modifies the mapped file while you're accessing it, or a SIGBUS signal may be raised. This happens, for instance, if the - file is shrinked. *) + file is shrunk. + + This function raises [Sys_error] in the case of any errors from the + underlying system calls. [Invalid_argument] or [Failure] may be + raised in cases where argument validation fails. *) end diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index 3e7e9b590e..acff7a7a68 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -13,15 +13,18 @@ # Makefile for the dynamic link library +# FIXME reduce redundancy by including ../Makefile + include ../../config/Makefile +CAMLRUN ?= ../../boot/ocamlrun +CAMLYACC ?= ../../boot/ocamlyacc ROOTDIR = ../.. -OCAMLRUN = $(ROOTDIR)/boot/ocamlrun -OCAMLC = $(OCAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib +OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib +OCAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib INCLUDES=-I ../../utils -I ../../typing -I ../../bytecomp -I ../../asmcomp -COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string \ +COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string \ -I ../../stdlib $(INCLUDES) OBJS=dynlinkaux.cmo dynlink.cmo @@ -69,7 +72,7 @@ dynlink.cmx: dynlink.cmi natdynlink.ml rm -f dynlink.mlopt extract_crc: dynlink.cma extract_crc.cmo - $(OCAMLC) $(COMPFLAGS) -o extract_crc dynlink.cma extract_crc.cmo + $(OCAMLC) -o extract_crc dynlink.cma extract_crc.cmo INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR) diff --git a/otherlibs/graph/.depend b/otherlibs/graph/.depend index 5be56faeda..30f3dac330 100644 --- a/otherlibs/graph/.depend +++ b/otherlibs/graph/.depend @@ -14,7 +14,7 @@ dump_img.o: dump_img.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \ - ../../byterun/caml/minor_gc.h + ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h events.o: events.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \ @@ -27,7 +27,8 @@ fill.o: fill.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/misc.h ../../byterun/caml/misc.h \ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \ ../../byterun/caml/mlvalues.h ../../byterun/caml/major_gc.h \ - ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h + ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \ + ../../byterun/caml/address_class.h image.o: image.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \ @@ -40,7 +41,8 @@ make_img.o: make_img.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/misc.h ../../byterun/caml/misc.h image.h \ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \ ../../byterun/caml/mlvalues.h ../../byterun/caml/major_gc.h \ - ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h + ../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \ + ../../byterun/caml/address_class.h open.o: open.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \ @@ -49,7 +51,7 @@ open.o: open.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/callback.h ../../byterun/caml/fail.h \ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \ - ../../byterun/caml/minor_gc.h + ../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h point_col.o: point_col.c libgraph.h ../../byterun/caml/mlvalues.h \ ../../byterun/caml/compatibility.h ../../byterun/caml/config.h \ ../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \ diff --git a/otherlibs/graph/Makefile b/otherlibs/graph/Makefile index 2fb45807f2..850e02513e 100644 --- a/otherlibs/graph/Makefile +++ b/otherlibs/graph/Makefile @@ -27,6 +27,6 @@ include ../Makefile depend: $(CC) -MM $(CFLAGS) *.c | sed -e 's, /[^ ]*\.h,,g' > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/num/Makefile b/otherlibs/num/Makefile index c867b2cd26..e08e02943f 100644 --- a/otherlibs/num/Makefile +++ b/otherlibs/num/Makefile @@ -32,6 +32,6 @@ bng.$(O): bng.h bng_digit.c \ depend: $(CC) -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/num/nat.ml b/otherlibs/num/nat.ml index 90cb471c1b..5ea5fda751 100644 --- a/otherlibs/num/nat.ml +++ b/otherlibs/num/nat.ml @@ -318,6 +318,12 @@ let digits = "0123456789ABCDEF" A la fin de la boucle i-1 est la plus grande puissance de la base qui tient sur un seul digit et j est la plus grande puissance de la base qui tient sur un int. + + This function returns [(pmax, pint)] where: + [pmax] is the index of the digit of [power_base] that contains the + the maximum power of [base] that fits in a digit. This is also one + less than the exponent of that power. + [pint] is the exponent of the maximum power of [base] that fits in an [int]. *) let make_power_base base power_base = let i = ref 0 @@ -329,7 +335,7 @@ let make_power_base base power_base = power_base (pred !i) 1 power_base 0) done; - while !j <= !i && is_digit_int power_base !j do incr j done; + while !j < !i - 1 && is_digit_int power_base !j do incr j done; (!i - 2, !j) (* diff --git a/otherlibs/num/num.ml b/otherlibs/num/num.ml index 67499e2674..924e9eab6c 100644 --- a/otherlibs/num/num.ml +++ b/otherlibs/num/num.ml @@ -160,57 +160,71 @@ let floor_num = function | Big_int bi as n -> n | Ratio r -> num_of_big_int (floor_ratio r) -(* The function [quo_num] is equivalent to - - let quo_num x y = floor_num (div_num x y);; +(* Coercion with ratio type *) +let ratio_of_num = function + Int i -> ratio_of_int i +| Big_int bi -> ratio_of_big_int bi +| Ratio r -> r +;; - However, this definition is vastly inefficient (cf PR #3473): - we define here a better way of computing the same thing. - *) -let quo_num n1 n2 = - match n1 with - | Int i1 -> - begin match n2 with - | Int i2 -> Int (i1 / i2) - | Big_int bi2 -> num_of_big_int (div_big_int (big_int_of_int i1) bi2) - | Ratio r2 -> num_of_big_int (floor_ratio (div_int_ratio i1 r2)) end +(* Euclidean division and remainder. The specification is: - | Big_int bi1 -> - begin match n2 with - | Int i2 -> num_of_big_int (div_big_int bi1 (big_int_of_int i2)) - | Big_int bi2 -> num_of_big_int (div_big_int bi1 bi2) - | Ratio r2 -> num_of_big_int (floor_ratio (div_big_int_ratio bi1 r2)) end + a = b * quo_num a b + mod_num a b + quo_num a b is an integer (Z) + 0 <= mod_num a b < |b| - | Ratio r1 -> - begin match n2 with - | Int i2 -> num_of_big_int (floor_ratio (div_ratio_int r1 i2)) - | Big_int bi2 -> num_of_big_int (floor_ratio (div_ratio_big_int r1 bi2)) - | Ratio r2 -> num_of_big_int (floor_ratio (div_ratio r1 r2)) end -;; +A correct but slow implementation is: -(* The function [mod_num] is equivalent to: + quo_num a b = + if b >= 0 then floor_num (div_num a b) + else minus_num (floor_num (div_num a (minus_num b))) - let mod_num x y = sub_num x (mult_num y (quo_num x y));; + mod_num a b = + sub_num a (mult_num b (quo_num a b)) - However, as for [quo_num] above, this definition is inefficient: + However, this definition is vastly inefficient (cf PR #3473): we define here a better way of computing the same thing. - *) -let mod_num n1 n2 = - match n1 with - | Int i1 -> - begin match n2 with - | Int i2 -> Int (i1 mod i2) - | Big_int bi2 -> num_of_big_int (mod_big_int (big_int_of_int i1) bi2) - | Ratio _r2 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) end - | Big_int bi1 -> - begin match n2 with - | Int i2 -> num_of_big_int (mod_big_int bi1 (big_int_of_int i2)) - | Big_int bi2 -> num_of_big_int (mod_big_int bi1 bi2) - | Ratio _r2 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) end + PR#6753: the previous implementation was based on + quo_num a b = floor_num (div_num a b) + which is incorrect for negative b. +*) - | Ratio _r1 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) -;; +let quo_num n1 n2 = + match n1, n2 with + | Int i1, Int i2 -> + let q = i1 / i2 and r = i1 mod i2 in + Int (if r >= 0 then q else if i2 > 0 then q - 1 else q + 1) + | Int i1, Big_int bi2 -> + num_of_big_int (div_big_int (big_int_of_int i1) bi2) + | Int i1, Ratio r2 -> + num_of_big_int (report_sign_ratio r2 + (floor_ratio (div_int_ratio i1 (abs_ratio r2)))) + | Big_int bi1, Int i2 -> + num_of_big_int (div_big_int bi1 (big_int_of_int i2)) + | Big_int bi1, Big_int bi2 -> + num_of_big_int (div_big_int bi1 bi2) + | Big_int bi1, Ratio r2 -> + num_of_big_int (report_sign_ratio r2 + (floor_ratio (div_big_int_ratio bi1 (abs_ratio r2)))) + | Ratio r1, _ -> + let r2 = ratio_of_num n2 in + num_of_big_int (report_sign_ratio r2 + (floor_ratio (div_ratio r1 (abs_ratio r2)))) + +let mod_num n1 n2 = + match n1, n2 with + | Int i1, Int i2 -> + let r = i1 mod i2 in + Int (if r >= 0 then r else if i2 > 0 then r + i2 else r - i2) + | Int i1, Big_int bi2 -> + num_of_big_int (mod_big_int (big_int_of_int i1) bi2) + | Big_int bi1, Int i2 -> + num_of_big_int (mod_big_int bi1 (big_int_of_int i2)) + | Big_int bi1, Big_int bi2 -> + num_of_big_int (mod_big_int bi1 bi2) + | _, _ -> + sub_num n1 (mult_num n2 (quo_num n1 n2)) let power_num_int a b = match (a,b) with ((Int i), n) -> @@ -368,13 +382,6 @@ let big_int_of_num = function | Big_int bi -> bi | Ratio r -> big_int_of_ratio r -(* Coercion with ratio type *) -let ratio_of_num = function - Int i -> ratio_of_int i -| Big_int bi -> ratio_of_big_int bi -| Ratio r -> r -;; - let string_of_big_int_for_num bi = if !approx_printing_flag then approx_big_int !floating_precision bi diff --git a/otherlibs/str/Makefile b/otherlibs/str/Makefile index 4a58d46744..93b2bf9539 100644 --- a/otherlibs/str/Makefile +++ b/otherlibs/str/Makefile @@ -28,6 +28,6 @@ str.cmx: str.cmi depend: $(CC) -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/systhreads/Makefile b/otherlibs/systhreads/Makefile index c5b4e10b8f..942a7b7869 100644 --- a/otherlibs/systhreads/Makefile +++ b/otherlibs/systhreads/Makefile @@ -12,13 +12,15 @@ ######################################################################### include ../../config/Makefile +CAMLRUN ?= ../../boot/ocamlrun +CAMLYACC ?= ../../boot/ocamlyacc ROOTDIR=../.. -CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \ +CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib \ -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix -CAMLOPT=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlopt -nostdlib \ +CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \ -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix -MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib +MKLIB=$(CAMLRUN) ../../tools/ocamlmklib COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string BYTECODE_C_OBJS=st_stubs_b.o @@ -34,7 +36,7 @@ libthreads.a: $(BYTECODE_C_OBJS) $(MKLIB) -o threads $(BYTECODE_C_OBJS) $(PTHREAD_LINK) st_stubs_b.o: st_stubs.c st_posix.h - $(BYTECC) -O -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \ + $(BYTECC) -I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) \ -c st_stubs.c mv st_stubs.o st_stubs_b.o @@ -44,7 +46,7 @@ libthreadsnat.a: $(NATIVECODE_C_OBJS) $(AR) rc libthreadsnat.a $(NATIVECODE_C_OBJS) st_stubs_n.o: st_stubs.c st_posix.h - $(NATIVECC) -O -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) \ + $(NATIVECC) -I../../asmrun -I../../byterun $(NATIVECCCOMPOPTS) \ $(SHAREDCCCOMPOPTS) -DNATIVE_CODE -DTARGET_$(ARCH) \ -DSYS_$(SYSTEM) -c st_stubs.c mv st_stubs.o st_stubs_n.o @@ -107,6 +109,6 @@ installopt: depend: $(GENFILES) -$(CC) -MM -I../../byterun *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/systhreads/Makefile.nt b/otherlibs/systhreads/Makefile.nt index 341176146f..22fb1c7179 100644 --- a/otherlibs/systhreads/Makefile.nt +++ b/otherlibs/systhreads/Makefile.nt @@ -12,12 +12,14 @@ ######################################################################### include ../../config/Makefile +CAMLRUN ?= ../../boot/ocamlrun +CAMLYACC ?= ../../boot/ocamlyacc # Compilation options -CAMLC=../../boot/ocamlrun ../../ocamlc -I ../../stdlib -I ../win32unix -CAMLOPT=../../boot/ocamlrun ../../ocamlopt -I ../../stdlib -I ../win32unix +CAMLC=$(CAMLRUN) ../../ocamlc -I ../../stdlib -I ../win32unix +CAMLOPT=$(CAMLRUN) ../../ocamlopt -I ../../stdlib -I ../win32unix COMPFLAGS=-w +33 -warn-error A -g -MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib +MKLIB=$(CAMLRUN) ../../tools/ocamlmklib CFLAGS=-I../../byterun $(EXTRACFLAGS) CAMLOBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo @@ -32,7 +34,7 @@ all: lib$(LIBNAME).$(A) $(LIBNAME).cma $(CMIFILES) allopt: lib$(LIBNAME).$(A) $(LIBNAME).cmxa $(LIBNAME).cmxs $(CMIFILES) $(LIBNAME).cma: $(CAMLOBJS) - $(MKLIB) -o $(LIBNAME) -ocamlc "../../boot/ocamlrun ../../ocamlc" \ + $(MKLIB) -o $(LIBNAME) -ocamlc "$(CAMLRUN) ../../ocamlc" \ -linkall $(CAMLOBJS) $(LINKOPTS) lib$(LIBNAME).$(A): $(COBJS) @@ -46,7 +48,7 @@ st_stubs_b.$(O): st_stubs.c st_win32.h $(LIBNAME).cmxa: $(CAMLOBJS:.cmo=.cmx) $(MKLIB) -o $(LIBNAME)nat \ - -ocamlopt "../../boot/ocamlrun ../../ocamlopt" -linkall \ + -ocamlopt "$(CAMLRUN) ../../ocamlopt" -linkall \ $(CAMLOBJS:.cmo=.cmx) $(LINKOPTS) mv $(LIBNAME)nat.cmxa $(LIBNAME).cmxa mv $(LIBNAME)nat.$(A) $(LIBNAME).$(A) diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend index 0706d06ac6..7fdc010f5a 100644 --- a/otherlibs/threads/.depend +++ b/otherlibs/threads/.depend @@ -8,18 +8,16 @@ scheduler.o: scheduler.c ../../byterun/caml/alloc.h \ ../../byterun/caml/memory.h ../../byterun/caml/gc.h \ ../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \ ../../byterun/caml/minor_gc.h ../../byterun/caml/misc.h \ + ../../byterun/caml/address_class.h \ ../../byterun/caml/mlvalues.h ../../byterun/caml/printexc.h \ ../../byterun/caml/roots.h ../../byterun/caml/memory.h \ ../../byterun/caml/signals.h ../../byterun/caml/stacks.h \ ../../byterun/caml/sys.h condition.cmi : mutex.cmi event.cmi : -marshal.cmi : mutex.cmi : -pervasives.cmi : -thread.cmi : unix.cmi -threadUnix.cmi : unix.cmi -unix.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 @@ -28,11 +26,11 @@ marshal.cmo : marshal.cmx : mutex.cmo : thread.cmi mutex.cmi mutex.cmx : thread.cmx mutex.cmi -pervasives.cmo : unix.cmi pervasives.cmi -pervasives.cmx : unix.cmx pervasives.cmi -thread.cmo : unix.cmi thread.cmi +pervasives.cmo : unix.cmo +pervasives.cmx : unix.cmx +thread.cmo : unix.cmo thread.cmi thread.cmx : unix.cmx thread.cmi -threadUnix.cmo : unix.cmi thread.cmi threadUnix.cmi +threadUnix.cmo : unix.cmo thread.cmi threadUnix.cmi threadUnix.cmx : unix.cmx thread.cmx threadUnix.cmi -unix.cmo : unix.cmi -unix.cmx : unix.cmi +unix.cmo : +unix.cmx : diff --git a/otherlibs/threads/Makefile b/otherlibs/threads/Makefile index d141815bee..b7851d0b71 100644 --- a/otherlibs/threads/Makefile +++ b/otherlibs/threads/Makefile @@ -11,15 +11,19 @@ # # ######################################################################### +# FIXME reduce redundancy by including ../Makefile + include ../../config/Makefile +CAMLRUN ?= ../../boot/ocamlrun +CAMLYACC ?= ../../boot/ocamlyacc CC=$(BYTECC) -CFLAGS=-I../../byterun -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g +CFLAGS=-I../../byterun $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -g ROOTDIR=../.. -CAMLC=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/ocamlc -nostdlib \ +CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib \ -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/unix -MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib -COMPFLAGS=-w +33..39 -warn-error A -bin-annot -safe-string +MKLIB=$(CAMLRUN) ../../tools/ocamlmklib +COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string C_OBJS=scheduler.o @@ -122,6 +126,6 @@ installopt: depend: $(CC) -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/unix/Makefile b/otherlibs/unix/Makefile index e41a1e1ddd..faebd3f5c8 100644 --- a/otherlibs/unix/Makefile +++ b/otherlibs/unix/Makefile @@ -42,6 +42,6 @@ include ../Makefile depend: $(CC) -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend + $(CAMLRUN) ../../tools/ocamldep *.mli *.ml >> .depend include .depend diff --git a/otherlibs/unix/socketaddr.h b/otherlibs/unix/socketaddr.h index c2957af098..0077daeaad 100644 --- a/otherlibs/unix/socketaddr.h +++ b/otherlibs/unix/socketaddr.h @@ -11,6 +11,9 @@ /* */ /***********************************************************************/ +#ifndef CAML_SOCKETADDR_H +#define CAML_SOCKETADDR_H + #include "caml/misc.h" #include <sys/types.h> #include <sys/socket.h> @@ -33,6 +36,10 @@ typedef socklen_t socklen_param_type; typedef int socklen_param_type; #endif +#ifdef __cplusplus +extern "C" { +#endif + extern void get_sockaddr (value mladdr, union sock_addr_union * addr /*out*/, socklen_param_type * addr_len /*out*/); @@ -45,3 +52,9 @@ CAMLexport value alloc_inet_addr (struct in_addr * inaddr); CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr); #define GET_INET6_ADDR(v) (*((struct in6_addr *) (v))) #endif + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_SOCKETADDR_H */ diff --git a/otherlibs/unix/termios.c b/otherlibs/unix/termios.c index d3d2db882a..40173737dd 100644 --- a/otherlibs/unix/termios.c +++ b/otherlibs/unix/termios.c @@ -90,17 +90,22 @@ static long terminal_io_descr[] = { #undef cflags #undef lflags -struct speedtable_entry ; - static struct { speed_t speed; int baud; } speedtable[] = { + + /* standard speeds */ + {B0, 0}, {B50, 50}, {B75, 75}, {B110, 110}, {B134, 134}, {B150, 150}, +#ifdef B200 + /* Shouldn't need to be ifdef'd but I'm not sure it's available everywhere. */ + {B200, 200}, +#endif {B300, 300}, {B600, 600}, {B1200, 1200}, @@ -110,6 +115,8 @@ static struct { {B9600, 9600}, {B19200, 19200}, {B38400, 38400}, + + /* usual extensions */ #ifdef B57600 {B57600, 57600}, #endif @@ -119,7 +126,66 @@ static struct { #ifdef B230400 {B230400, 230400}, #endif - {B0, 0} + + /* Linux extensions */ +#ifdef B460800 + {B460800, 460800}, +#endif +#ifdef B500000 + {B500000, 500000}, +#endif +#ifdef B576000 + {B576000, 576000}, +#endif +#ifdef B921600 + {B921600, 921600}, +#endif +#ifdef B1000000 + {B1000000, 1000000}, +#endif +#ifdef B1152000 + {B1152000, 1152000}, +#endif +#ifdef B1500000 + {B1500000, 1500000}, +#endif +#ifdef B2000000 + {B2000000, 2000000}, +#endif +#ifdef B2500000 + {B2500000, 2500000}, +#endif +#ifdef B3000000 + {B3000000, 3000000}, +#endif +#ifdef B3500000 + {B3500000, 3500000}, +#endif +#ifdef B4000000 + {B4000000, 4000000}, +#endif + + /* MacOS extensions */ +#ifdef B7200 + {B7200, 7200}, +#endif +#ifdef B14400 + {B14400, 14400}, +#endif +#ifdef B28800 + {B28800, 28800}, +#endif +#ifdef B76800 + {B76800, 76800}, +#endif + + /* Cygwin extensions (in addition to the Linux ones) */ +#ifdef B128000 + {B128000, 128000}, +#endif +#ifdef B256000 + {B256000, 256000}, +#endif }; #define NSPEEDS (sizeof(speedtable) / sizeof(speedtable[0])) diff --git a/otherlibs/unix/unixsupport.h b/otherlibs/unix/unixsupport.h index a8065d973a..d4312ab4fd 100644 --- a/otherlibs/unix/unixsupport.h +++ b/otherlibs/unix/unixsupport.h @@ -11,10 +11,17 @@ /* */ /***********************************************************************/ +#ifndef CAML_UNIXSUPPORT_H +#define CAML_UNIXSUPPORT_H + #ifdef HAS_UNISTD #include <unistd.h> #endif +#ifdef __cplusplus +extern "C" { +#endif + #define Nothing ((value) 0) extern value unix_error_of_code (int errcode); @@ -25,3 +32,9 @@ extern void uerror (char * cmdname, value arg) Noreturn; #define UNIX_BUFFER_SIZE 65536 #define DIR_Val(v) *((DIR **) &Field(v, 0)) + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_UNIXSUPPORT_H */ diff --git a/otherlibs/win32graph/open.c b/otherlibs/win32graph/open.c index d3a61a5da1..e9d10cad00 100644 --- a/otherlibs/win32graph/open.c +++ b/otherlibs/win32graph/open.c @@ -112,7 +112,7 @@ int DoRegisterClass(void) WNDCLASS wc; memset(&wc,0,sizeof(WNDCLASS)); - wc.style = CS_HREDRAW|CS_VREDRAW |CS_DBLCLKS|CS_OWNDC ; + wc.style = CS_HREDRAW|CS_VREDRAW|CS_OWNDC ; wc.lpfnWndProc = (WNDPROC)GraphicsWndProc; wc.hInstance = hInst; wc.hbrBackground = (HBRUSH)(COLOR_WINDOW+1); diff --git a/otherlibs/win32unix/gettimeofday.c b/otherlibs/win32unix/gettimeofday.c index e018c340a0..f4e25b5ff0 100644 --- a/otherlibs/win32unix/gettimeofday.c +++ b/otherlibs/win32unix/gettimeofday.c @@ -17,38 +17,14 @@ #include "unixsupport.h" -#ifdef HAS_MKTIME -static double initial_time = 0; /* 0 means uninitialized */ -#else -static time_t initial_time = 0; /* 0 means uninitialized */ -#endif -static DWORD initial_tickcount; +/* Unix epoch as a Windows timestamp in hundreds of ns */ +#define epoch_ft 116444736000000000.0; CAMLprim value unix_gettimeofday(value unit) { - DWORD tickcount = GetTickCount(); - SYSTEMTIME st; - struct tm tm; - if (initial_time == 0 || tickcount < initial_tickcount) { - initial_tickcount = tickcount; -#ifdef HAS_MKTIME - GetLocalTime(&st); - tm.tm_sec = st.wSecond; - tm.tm_min = st.wMinute; - tm.tm_hour = st.wHour; - tm.tm_mday = st.wDay; - tm.tm_mon = st.wMonth - 1; - tm.tm_year = st.wYear - 1900; - tm.tm_wday = 0; - tm.tm_yday = 0; - tm.tm_isdst = -1; - initial_time = ((double) mktime(&tm) + (double) st.wMilliseconds * 1e-3); -#else - initial_time = time(NULL); -#endif - return copy_double((double) initial_time); - } else { - return copy_double((double) initial_time + - (double) (tickcount - initial_tickcount) * 1e-3); - } + FILETIME ft; + double tm; + GetSystemTimeAsFileTime(&ft); + tm = *(uint64 *)&ft - epoch_ft; /* shift to Epoch-relative time */ + return copy_double(tm * 1e-7); /* tm is in 100ns */ } diff --git a/otherlibs/win32unix/socketaddr.h b/otherlibs/win32unix/socketaddr.h index 9c36380a08..f3b6caf0fd 100644 --- a/otherlibs/win32unix/socketaddr.h +++ b/otherlibs/win32unix/socketaddr.h @@ -11,6 +11,9 @@ /* */ /***********************************************************************/ +#ifndef CAML_SOCKETADDR_H +#define CAML_SOCKETADDR_H + #include "caml/misc.h" union sock_addr_union { @@ -29,6 +32,10 @@ typedef socklen_t socklen_param_type; typedef int socklen_param_type; #endif +#ifdef __cplusplus +extern "C" { +#endif + extern void get_sockaddr (value mladdr, union sock_addr_union * addr /*out*/, socklen_param_type * addr_len /*out*/); @@ -41,3 +48,9 @@ CAMLprim value alloc_inet_addr (struct in_addr * inaddr); CAMLexport value alloc_inet6_addr (struct in6_addr * inaddr); #define GET_INET6_ADDR(v) (*((struct in6_addr *) (v))) #endif + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_SOCKETADDR_H */ diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h index b8f8acad5c..b8efb27806 100644 --- a/otherlibs/win32unix/unixsupport.h +++ b/otherlibs/win32unix/unixsupport.h @@ -11,6 +11,9 @@ /* */ /***********************************************************************/ +#ifndef CAML_UNIXSUPPORT_H +#define CAML_UNIXSUPPORT_H + #define WIN32_LEAN_AND_MEAN #include <wtypes.h> #include <winbase.h> @@ -24,6 +27,10 @@ #include <wspiapi.h> #endif +#ifdef __cplusplus +extern "C" { +#endif + struct filedescr { union { HANDLE handle; @@ -62,3 +69,9 @@ extern value unix_freeze_buffer (value); #define FLAGS_FD_IS_BLOCKING (1<<0) #define UNIX_BUFFER_SIZE 65536 + +#ifdef __cplusplus +} +#endif + +#endif /* CAML_UNIXSUPPORT_H */ diff --git a/parsing/ast_helper.ml b/parsing/ast_helper.ml index 7a01f101e8..db3b029a86 100644 --- a/parsing/ast_helper.ml +++ b/parsing/ast_helper.ml @@ -480,3 +480,4 @@ module Cstr = struct pcstr_fields = fields; } end + diff --git a/parsing/ast_mapper.ml b/parsing/ast_mapper.ml index a22dbfec96..945375525b 100644 --- a/parsing/ast_mapper.ml +++ b/parsing/ast_mapper.ml @@ -179,6 +179,7 @@ module CT = struct let map sub {pcty_loc = loc; pcty_desc = desc; pcty_attributes = attrs} = let open Cty in let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in match desc with | Pcty_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) @@ -191,6 +192,7 @@ module CT = struct = let open Ctf in let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in match desc with | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct) | Pctf_val (s, m, v, t) -> val_ ~loc ~attrs s m v (sub.typ sub t) @@ -415,6 +417,7 @@ module CE = struct let map sub {pcl_loc = loc; pcl_desc = desc; pcl_attributes = attrs} = let open Cl in let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in match desc with | Pcl_constr (lid, tys) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tys) @@ -442,6 +445,7 @@ module CE = struct let map_field sub {pcf_desc = desc; pcf_loc = loc; pcf_attributes = attrs} = let open Cf in let loc = sub.location sub loc in + let attrs = sub.attributes sub attrs in match desc with | Pcf_inherit (o, ce, s) -> inherit_ ~loc ~attrs o (sub.class_expr sub ce) s | Pcf_val (s, m, k) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k) diff --git a/parsing/location.ml b/parsing/location.ml index 7734aeab7e..a4910bdc2f 100644 --- a/parsing/location.ml +++ b/parsing/location.ml @@ -290,7 +290,8 @@ let print_warning loc ppf w = print_updating_num_loc_lines ppf (!warning_printer loc) w ;; -let prerr_warning loc w = print_warning loc err_formatter w;; +let formatter_for_warnings = ref err_formatter;; +let prerr_warning loc w = print_warning loc !formatter_for_warnings w;; let echo_eof () = print_newline (); diff --git a/parsing/location.mli b/parsing/location.mli index 902bc1a3f5..77b754f731 100644 --- a/parsing/location.mli +++ b/parsing/location.mli @@ -55,6 +55,7 @@ val print_loc: formatter -> t -> unit val print_error: formatter -> t -> unit val print_error_cur_file: formatter -> unit val print_warning: t -> formatter -> Warnings.t -> unit +val formatter_for_warnings : formatter ref val prerr_warning: t -> Warnings.t -> unit val echo_eof: unit -> unit val reset: unit -> unit diff --git a/parsing/parser.mly b/parsing/parser.mly index 257d461dc4..da4c36d83f 100644 --- a/parsing/parser.mly +++ b/parsing/parser.mly @@ -578,7 +578,7 @@ The precedences must be listed from low to high. %nonassoc prec_constant_constructor /* cf. simple_expr (C versus C x) */ %nonassoc prec_constr_appl /* above AS BAR COLONCOLON COMMA */ %nonassoc below_SHARP -%nonassoc SHARP /* simple_expr/toplevel_directive */ +%nonassoc SHARP SHARPOP /* simple_expr/toplevel_directive */ %left SHARPOP %nonassoc below_DOT %nonassoc DOT diff --git a/parsing/pprintast.ml b/parsing/pprintast.ml index fd663e1c38..4090fe3fc1 100644 --- a/parsing/pprintast.ml +++ b/parsing/pprintast.ml @@ -1266,7 +1266,8 @@ class printer ()= object(self:'self) in let constructor_declaration f pcd = pp f "|@;"; - self#constructor_declaration f (pcd.pcd_name.txt, pcd.pcd_args, pcd.pcd_res, pcd.pcd_attributes) + self#constructor_declaration f (pcd.pcd_name.txt, pcd.pcd_args, + pcd.pcd_res, pcd.pcd_attributes) in let repr f = let intro f = @@ -1298,7 +1299,9 @@ class printer ()= object(self:'self) pp f "@[<2>type %a%a +=%a@]%a" (fun f -> function | [] -> () - | l -> pp f "%a@;" (self#list self#type_param ~first:"(" ~last:")" ~sep:",") l) + | l -> pp f "%a@;" (self#list self#type_param ~first:"(" + ~last:")" ~sep:",") + l) x.ptyext_params self#longident_loc x.ptyext_path (self#list ~sep:"" extension_constructor) diff --git a/parsing/pprintast.mli b/parsing/pprintast.mli index 41808c8526..98105928dd 100644 --- a/parsing/pprintast.mli +++ b/parsing/pprintast.mli @@ -82,7 +82,8 @@ class printer : method private_flag : Format.formatter -> Asttypes.private_flag -> unit method rec_flag : Format.formatter -> Asttypes.rec_flag -> unit method nonrec_flag : Format.formatter -> Asttypes.rec_flag -> unit - method record_declaration : Format.formatter -> Parsetree.label_declaration list -> unit + method record_declaration : + Format.formatter -> Parsetree.label_declaration list -> unit method reset : 'b method reset_semi : 'b diff --git a/parsing/printast.ml b/parsing/printast.ml index d8218e937d..a0bff6e9ad 100644 --- a/parsing/printast.ml +++ b/parsing/printast.ml @@ -887,7 +887,7 @@ and directive_argument i ppf x = match x with | Pdir_none -> line i ppf "Pdir_none\n" | Pdir_string (s) -> line i ppf "Pdir_string \"%s\"\n" s; - | Pdir_int (i) -> line i ppf "Pdir_int %d\n" i; + | Pdir_int (n) -> line i ppf "Pdir_int %d\n" n; | Pdir_ident (li) -> line i ppf "Pdir_ident %a\n" fmt_longident li; | Pdir_bool (b) -> line i ppf "Pdir_bool %s\n" (string_of_bool b); ;; diff --git a/stdlib/.ignore b/stdlib/.ignore index ad1b04e137..20d8653fe9 100644 --- a/stdlib/.ignore +++ b/stdlib/.ignore @@ -1,5 +1,7 @@ camlheader +target_camlheader camlheaderd +target_camlheaderd camlheader_ur labelled-* caml diff --git a/stdlib/Makefile b/stdlib/Makefile index 37f9a5f0bf..92fa3740ea 100644 --- a/stdlib/Makefile +++ b/stdlib/Makefile @@ -45,23 +45,28 @@ installopt-prof: stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx) $(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx) -camlheader camlheaderd camlheader_ur: header.c ../config/Makefile +camlheader target_camlheader camlheaderd target_camlheaderd camlheader_ur: \ + header.c ../config/Makefile if $(SHARPBANGSCRIPTS); then \ echo '#!$(BINDIR)/ocamlrun' > camlheader && \ + echo '#!$(TARGET_BINDIR)/ocamlrun' > target_camlheader && \ echo '#!$(BINDIR)/ocamlrund' > camlheaderd && \ + echo '#!$(TARGET_BINDIR)/ocamlrund' > target_camlheaderd && \ echo '#!' | tr -d '\012' > camlheader_ur; \ else \ - $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \ - -DRUNTIME_NAME='"$(BINDIR)/ocamlrun"' \ - header.c -o tmpheader$(EXE) && \ - strip tmpheader$(EXE) && \ - mv tmpheader$(EXE) camlheader && \ - cp camlheader camlheader_ur && \ - $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \ - -DRUNTIME_NAME='"$(BINDIR)/ocamlrund"' \ - header.c -o tmpheader$(EXE) && \ - strip tmpheader$(EXE) && \ - mv tmpheader$(EXE) camlheaderd; \ + for suff in '' d; do \ + $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \ + -DRUNTIME_NAME='"$(BINDIR)/ocamlrun'$$suff'"' \ + header.c -o tmpheader$(EXE) && \ + strip tmpheader$(EXE) && \ + mv tmpheader$(EXE) camlheader$$suff && \ + $(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \ + -DRUNTIME_NAME='"$(TARGET_BINDIR)/ocamlrun'$$suff'"' \ + header.c -o tmpheader$(EXE) && \ + strip tmpheader$(EXE) && \ + mv tmpheader$(EXE) target_camlheader$$suff; \ + done && \ + cp camlheader camlheader_ur; \ fi .PHONY: all allopt allopt-noprof allopt-prof install installopt diff --git a/stdlib/Makefile.nt b/stdlib/Makefile.nt index 590701bf92..5bc2e0edfa 100644 --- a/stdlib/Makefile.nt +++ b/stdlib/Makefile.nt @@ -18,19 +18,21 @@ allopt: stdlib.cmxa std_exit.cmx installopt: cp stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx $(INSTALL_LIBDIR) -camlheader camlheader_ur: headernt.c ../config/Makefile +camlheader target_camlheader camlheader_ur: headernt.c ../config/Makefile $(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \ -DRUNTIME_NAME='"ocamlrun"' headernt.c $(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS) rm -f camlheader.exe mv tmpheader.exe camlheader + cp camlheader target_camlheader cp camlheader camlheader_ur -camlheaderd: headernt.c ../config/Makefile +camlheaderd target_camlheaderd: headernt.c ../config/Makefile $(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \ -DRUNTIME_NAME='"ocamlrund"' headernt.c $(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS) mv tmpheader.exe camlheaderd + cp camlheaderd target_camlheaderd # TODO: do not call flexlink to build tmpheader.exe (we don't need # the export table) diff --git a/stdlib/Makefile.shared b/stdlib/Makefile.shared index 5f5761f921..b97ca21c6f 100755 --- a/stdlib/Makefile.shared +++ b/stdlib/Makefile.shared @@ -12,14 +12,17 @@ ######################################################################### include ../config/Makefile -RUNTIME=../boot/ocamlrun +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc +TARGET_BINDIR ?= $(BINDIR) + COMPILER=../ocamlc -CAMLC=$(RUNTIME) $(COMPILER) +CAMLC=$(CAMLRUN) $(COMPILER) COMPFLAGS=-strict-sequence -w +33..39 -g -warn-error A -bin-annot -nostdlib \ -safe-string OPTCOMPILER=../ocamlopt -CAMLOPT=$(RUNTIME) $(OPTCOMPILER) -CAMLDEP=../boot/ocamlrun ../tools/ocamldep +CAMLOPT=$(CAMLRUN) $(OPTCOMPILER) +CAMLDEP=$(CAMLRUN) ../tools/ocamldep OBJS=camlinternalFormatBasics.cmo pervasives.cmo $(OTHERS) OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.cmo \ @@ -37,20 +40,21 @@ OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.cmo \ arrayLabels.cmo listLabels.cmo bytesLabels.cmo \ stringLabels.cmo moreLabels.cmo stdLabels.cmo -all: stdlib.cma std_exit.cmo camlheader camlheader_ur +all: stdlib.cma std_exit.cmo camlheader target_camlheader camlheader_ur INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR) install: install-$(RUNTIMED) cp stdlib.cma std_exit.cmo *.cmi *.cmt *.cmti *.mli *.ml \ - camlheader camlheader_ur \ + camlheader_ur \ $(INSTALL_LIBDIR) + cp target_camlheader $(INSTALL_LIBDIR)/camlheader install-noruntimed: .PHONY: install-noruntimed -install-runtimed: camlheaderd - cp camlheaderd $(INSTALL_LIBDIR) +install-runtimed: target_camlheaderd + cp target_camlheaderd $(INSTALL_LIBDIR)/camlheaderd .PHONY: install-runtimed stdlib.cma: $(OBJS) @@ -66,7 +70,7 @@ clean:: rm -f sys.ml clean:: - rm -f camlheader camlheader_ur camlheaderd + rm -f camlheader target_camlheader camlheader_ur target_camlheaderd .SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx diff --git a/stdlib/gc.mli b/stdlib/gc.mli index 432deeedd0..d07b3c1fbe 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -113,8 +113,8 @@ type control = - [0x020] Change of GC parameters. - [0x040] Computation of major GC slice size. - [0x080] Calling of finalisation functions. - - [0x100] Bytecode executable search at start-up. - - [0x200] Computation of compaction triggering condition. + - [0x100] Bytecode executable and shared library search at start-up. + - [0x200] Computation of compaction-triggering condition. Default: 0. *) mutable max_overhead : int; @@ -224,7 +224,8 @@ val finalise : ('a -> unit) -> 'a -> unit as expected: - [ let v = ... in Gc.finalise (fun _ -> ...v...) v ] - Instead you should write: + Instead you should make sure that [v] is not in the closure of + the finalisation function by writing: - [ let f = fun x -> ... ;; let v = ... in Gc.finalise f v ] diff --git a/stdlib/hashtbl.mli b/stdlib/hashtbl.mli index 0c3e4999f3..386f5a6cc9 100644 --- a/stdlib/hashtbl.mli +++ b/stdlib/hashtbl.mli @@ -345,7 +345,9 @@ val hash_param : int -> int -> 'a -> int hashing. Hashing performs a breadth-first, left-to-right traversal of the structure [x], stopping after [meaningful] meaningful nodes were encountered, or [total] nodes (meaningful or not) were - encountered. Meaningful nodes are: integers; floating-point + encountered. If [total] as specified by the user exceeds a certain + value, currently 256, then it is capped to that value. + Meaningful nodes are: integers; floating-point numbers; strings; characters; booleans; and constant constructors. Larger values of [meaningful] and [total] means that more nodes are taken into account to compute the final hash value, diff --git a/stdlib/header.c b/stdlib/header.c index fba8280ad9..6f3dc5496a 100644 --- a/stdlib/header.c +++ b/stdlib/header.c @@ -40,7 +40,7 @@ char * default_runtime_path = RUNTIME_NAME; #define SEEK_END 2 #endif -#ifndef __CYGWIN32__ +#ifndef __CYGWIN__ /* Normal Unix search path function */ diff --git a/stdlib/obj.ml b/stdlib/obj.ml index ac9695cdb8..5cb970b8e4 100644 --- a/stdlib/obj.ml +++ b/stdlib/obj.ml @@ -37,6 +37,9 @@ let marshal (obj : t) = let unmarshal str pos = (Marshal.from_bytes str pos, pos + Marshal.total_size str pos) +let first_non_constant_constructor_tag = 0 +let last_non_constant_constructor_tag = 245 + let lazy_tag = 246 let closure_tag = 247 let object_tag = 248 diff --git a/stdlib/obj.mli b/stdlib/obj.mli index 3395fa86f5..6d06312b4d 100644 --- a/stdlib/obj.mli +++ b/stdlib/obj.mli @@ -36,6 +36,9 @@ external truncate : t -> int -> unit = "caml_obj_truncate" external add_offset : t -> Int32.t -> t = "caml_obj_add_offset" (* @since 3.12.0 *) +val first_non_constant_constructor_tag : int +val last_non_constant_constructor_tag : int + val lazy_tag : int val closure_tag : int val object_tag : int diff --git a/stdlib/pervasives.mli b/stdlib/pervasives.mli index 64d87cd4be..e5182a8ee7 100644 --- a/stdlib/pervasives.mli +++ b/stdlib/pervasives.mli @@ -147,39 +147,55 @@ external ( or ) : bool -> bool -> bool = "%sequor" external __LOC__ : string = "%loc_LOC" (** [__LOC__] returns the location at which this expression appears in the file currently being parsed by the compiler, with the standard - error format of OCaml: "File %S, line %d, characters %d-%d" *) + error format of OCaml: "File %S, line %d, characters %d-%d". + @since 4.02.0 + *) external __FILE__ : string = "%loc_FILE" (** [__FILE__] returns the name of the file currently being - parsed by the compiler. *) + parsed by the compiler. + @since 4.02.0 +*) external __LINE__ : int = "%loc_LINE" (** [__LINE__] returns the line number at which this expression - appears in the file currently being parsed by the compiler. *) + appears in the file currently being parsed by the compiler. + @since 4.02.0 + *) external __MODULE__ : string = "%loc_MODULE" (** [__MODULE__] returns the module name of the file being - parsed by the compiler. *) + parsed by the compiler. + @since 4.02.0 + *) external __POS__ : string * int * int * int = "%loc_POS" (** [__POS__] returns a tuple [(file,lnum,cnum,enum)], corresponding to the location at which this expression appears in the file currently being parsed by the compiler. [file] is the current filename, [lnum] the line number, [cnum] the character position in - the line and [enum] the last character position in the line. *) + the line and [enum] the last character position in the line. + @since 4.02.0 + *) external __LOC_OF__ : 'a -> string * 'a = "%loc_LOC" (** [__LOC_OF__ expr] returns a pair [(loc, expr)] where [loc] is the location of [expr] in the file currently being parsed by the compiler, with the standard error format of OCaml: "File %S, line - %d, characters %d-%d" *) + %d, characters %d-%d". + @since 4.02.0 + *) external __LINE_OF__ : 'a -> int * 'a = "%loc_LINE" (** [__LINE__ expr] returns a pair [(line, expr)], where [line] is the line number at which the expression [expr] appears in the file - currently being parsed by the compiler. *) + currently being parsed by the compiler. + @since 4.02.0 + *) external __POS_OF__ : 'a -> (string * int * int * int) * 'a = "%loc_POS" -(** [__POS_OF__ expr] returns a pair [(expr,loc)], where [loc] is a +(** [__POS_OF__ expr] returns a pair [(loc,expr)], where [loc] is a tuple [(file,lnum,cnum,enum)] corresponding to the location at which the expression [expr] appears in the file currently being parsed by the compiler. [file] is the current filename, [lnum] the line number, [cnum] the character position in the line and [enum] - the last character position in the line. *) + the last character position in the line. + @since 4.02.0 + *) (** {6 Composition operators} *) diff --git a/testsuite/tests/basic/divint.ml b/testsuite/tests/basic/divint.ml index fea32631e2..60f09962ff 100644 --- a/testsuite/tests/basic/divint.ml +++ b/testsuite/tests/basic/divint.ml @@ -114,3 +114,6 @@ let _ = if !error then printf "TEST FAILED.\n" else printf "Test passed.\n" +(* PR#6879 *) +let f n = assert (1 mod n = 0) +let () = f 1 diff --git a/testsuite/tests/misc/weaklifetime.ml b/testsuite/tests/misc/weaklifetime.ml new file mode 100644 index 0000000000..d6b23f3d22 --- /dev/null +++ b/testsuite/tests/misc/weaklifetime.ml @@ -0,0 +1,74 @@ +(*************************************************************************) +(* *) +(* OCaml *) +(* *) +(* Damien Doligez, Jane Street Group, LLC *) +(* *) +(* Copyright 2015 Institut National de Recherche en Informatique et *) +(* en Automatique. All rights reserved. This file is distributed *) +(* under the terms of the Q Public License version 1.0. *) +(* *) +(*************************************************************************) + +Random.init 12345;; + +let size = 1000;; + +type block = int array;; + +type objdata = + | Present of block + | Absent of int (* GC count at time of erase *) +;; + +type bunch = { + objs : objdata array; + wp : block Weak.t; +};; + +let data = + Array.init size (fun i -> + let n = 1 + Random.int size in + { + objs = Array.make n (Absent 0); + wp = Weak.create n; + } + ) +;; + +let gccount () = (Gc.quick_stat ()).Gc.major_collections;; + +(* Check the correctness condition on the data at (i,j): + 1. if the block is present, the weak pointer must be full + 2. if the block was removed at GC n, and the weak pointer is still + full, then the current GC must be at most n+1. + + Then modify the data in one of the following ways: + 1. if the block and weak pointer are absent, fill them + 2. if the block and weak pointer are present, randomly erase the block +*) +let check_and_change i j = + let gc1 = gccount () in + match data.(i).objs.(j), Weak.check data.(i).wp j with + | Present x, false -> assert false + | Absent n, true -> assert (gc1 <= n+1) + | Absent _, false -> + let x = Array.make (1 + Random.int 10) 42 in + data.(i).objs.(j) <- Present x; + Weak.set data.(i).wp j (Some x); + | Present _, true -> + if Random.int 10 = 0 then begin + data.(i).objs.(j) <- Absent gc1; + let gc2 = gccount () in + if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2; + end +;; + +let dummy = ref [||];; + +while gccount () < 20 do + dummy := Array.make (Random.int 300) 0; + let i = Random.int size in + let j = Random.int (Array.length data.(i).objs) in + check_and_change i j; +done diff --git a/testsuite/tests/misc/weaklifetime.reference b/testsuite/tests/misc/weaklifetime.reference new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/misc/weaklifetime.reference diff --git a/testsuite/tests/prim-bigstring/bigstring_access.ml b/testsuite/tests/prim-bigstring/bigstring_access.ml index 8fad87b151..512181f088 100644 --- a/testsuite/tests/prim-bigstring/bigstring_access.ml +++ b/testsuite/tests/prim-bigstring/bigstring_access.ml @@ -63,40 +63,57 @@ let () = assert_bound_check3 caml_bigstring_set_32 empty_s 0 0l; assert_bound_check3 caml_bigstring_set_64 empty_s 0 0L +external bswap16: int -> int = "%bswap16" +external bswap32: int32 -> int32 = "%bswap_int32" +external bswap64: int64 -> int64 = "%bswap_int64" +let swap16 x = + if Sys.big_endian + then bswap16 x + else x + +let swap32 x = + if Sys.big_endian + then bswap32 x + else x + +let swap64 x = + if Sys.big_endian + then bswap64 x + else x let () = - caml_bigstring_set_16 s 0 0x1234; + caml_bigstring_set_16 s 0 (swap16 0x1234); Printf.printf "%x %x %x\n%!" - (caml_bigstring_get_16 s 0) - (caml_bigstring_get_16 s 1) - (caml_bigstring_get_16 s 2); - caml_bigstring_set_16 s 0 0xFEDC; + (swap16 (caml_bigstring_get_16 s 0)) + (swap16 (caml_bigstring_get_16 s 1)) + (swap16 (caml_bigstring_get_16 s 2)); + caml_bigstring_set_16 s 0 (swap16 0xFEDC); Printf.printf "%x %x %x\n%!" - (caml_bigstring_get_16 s 0) - (caml_bigstring_get_16 s 1) - (caml_bigstring_get_16 s 2) + (swap16 (caml_bigstring_get_16 s 0)) + (swap16 (caml_bigstring_get_16 s 1)) + (swap16 (caml_bigstring_get_16 s 2)) let () = - caml_bigstring_set_32 s 0 0x12345678l; + caml_bigstring_set_32 s 0 (swap32 0x12345678l); Printf.printf "%lx %lx %lx\n%!" - (caml_bigstring_get_32 s 0) - (caml_bigstring_get_32 s 1) - (caml_bigstring_get_32 s 2); - caml_bigstring_set_32 s 0 0xFEDCBA09l; + (swap32 (caml_bigstring_get_32 s 0)) + (swap32 (caml_bigstring_get_32 s 1)) + (swap32 (caml_bigstring_get_32 s 2)); + caml_bigstring_set_32 s 0 (swap32 0xFEDCBA09l); Printf.printf "%lx %lx %lx\n%!" - (caml_bigstring_get_32 s 0) - (caml_bigstring_get_32 s 1) - (caml_bigstring_get_32 s 2) + (swap32 (caml_bigstring_get_32 s 0)) + (swap32 (caml_bigstring_get_32 s 1)) + (swap32 (caml_bigstring_get_32 s 2)) let () = - caml_bigstring_set_64 s 0 0x1234567890ABCDEFL; + caml_bigstring_set_64 s 0 (swap64 0x1234567890ABCDEFL); Printf.printf "%Lx %Lx %Lx\n%!" - (caml_bigstring_get_64 s 0) - (caml_bigstring_get_64 s 1) - (caml_bigstring_get_64 s 2); - caml_bigstring_set_64 s 0 0xFEDCBA0987654321L; + (swap64 (caml_bigstring_get_64 s 0)) + (swap64 (caml_bigstring_get_64 s 1)) + (swap64 (caml_bigstring_get_64 s 2)); + caml_bigstring_set_64 s 0 (swap64 0xFEDCBA0987654321L); Printf.printf "%Lx %Lx %Lx\n%!" - (caml_bigstring_get_64 s 0) - (caml_bigstring_get_64 s 1) - (caml_bigstring_get_64 s 2) + (swap64 (caml_bigstring_get_64 s 0)) + (swap64 (caml_bigstring_get_64 s 1)) + (swap64 (caml_bigstring_get_64 s 2)) diff --git a/testsuite/tests/prim-bigstring/string_access.ml b/testsuite/tests/prim-bigstring/string_access.ml index 3afcc6c552..48964c0b33 100644 --- a/testsuite/tests/prim-bigstring/string_access.ml +++ b/testsuite/tests/prim-bigstring/string_access.ml @@ -50,40 +50,57 @@ let () = assert_bound_check3 caml_string_set_32 empty_s 0 0l; assert_bound_check3 caml_string_set_64 empty_s 0 0L +external bswap16: int -> int = "%bswap16" +external bswap32: int32 -> int32 = "%bswap_int32" +external bswap64: int64 -> int64 = "%bswap_int64" +let swap16 x = + if Sys.big_endian + then bswap16 x + else x + +let swap32 x = + if Sys.big_endian + then bswap32 x + else x + +let swap64 x = + if Sys.big_endian + then bswap64 x + else x let () = - caml_string_set_16 s 0 0x1234; + caml_string_set_16 s 0 (swap16 0x1234); Printf.printf "%x %x %x\n%!" - (caml_string_get_16 s 0) - (caml_string_get_16 s 1) - (caml_string_get_16 s 2); - caml_string_set_16 s 0 0xFEDC; + (swap16 (caml_string_get_16 s 0)) + (swap16 (caml_string_get_16 s 1)) + (swap16 (caml_string_get_16 s 2)); + caml_string_set_16 s 0 (swap16 0xFEDC); Printf.printf "%x %x %x\n%!" - (caml_string_get_16 s 0) - (caml_string_get_16 s 1) - (caml_string_get_16 s 2) + (swap16 (caml_string_get_16 s 0)) + (swap16 (caml_string_get_16 s 1)) + (swap16 (caml_string_get_16 s 2)) let () = - caml_string_set_32 s 0 0x12345678l; + caml_string_set_32 s 0 (swap32 0x12345678l); Printf.printf "%lx %lx %lx\n%!" - (caml_string_get_32 s 0) - (caml_string_get_32 s 1) - (caml_string_get_32 s 2); - caml_string_set_32 s 0 0xFEDCBA09l; + (swap32 (caml_string_get_32 s 0)) + (swap32 (caml_string_get_32 s 1)) + (swap32 (caml_string_get_32 s 2)); + caml_string_set_32 s 0 (swap32 0xFEDCBA09l); Printf.printf "%lx %lx %lx\n%!" - (caml_string_get_32 s 0) - (caml_string_get_32 s 1) - (caml_string_get_32 s 2) + (swap32 (caml_string_get_32 s 0)) + (swap32 (caml_string_get_32 s 1)) + (swap32 (caml_string_get_32 s 2)) let () = - caml_string_set_64 s 0 0x1234567890ABCDEFL; + caml_string_set_64 s 0 (swap64 0x1234567890ABCDEFL); Printf.printf "%Lx %Lx %Lx\n%!" - (caml_string_get_64 s 0) - (caml_string_get_64 s 1) - (caml_string_get_64 s 2); - caml_string_set_64 s 0 0xFEDCBA0987654321L; + (swap64 (caml_string_get_64 s 0)) + (swap64 (caml_string_get_64 s 1)) + (swap64 (caml_string_get_64 s 2)); + caml_string_set_64 s 0 (swap64 0xFEDCBA0987654321L); Printf.printf "%Lx %Lx %Lx\n%!" - (caml_string_get_64 s 0) - (caml_string_get_64 s 1) - (caml_string_get_64 s 2) + (swap64 (caml_string_get_64 s 0)) + (swap64 (caml_string_get_64 s 1)) + (swap64 (caml_string_get_64 s 2)) diff --git a/tools/Makefile.shared b/tools/Makefile.shared index 9a76b75e7b..3a6dfbc855 100644 --- a/tools/Makefile.shared +++ b/tools/Makefile.shared @@ -11,8 +11,9 @@ ######################################################################### include ../config/Makefile +CAMLRUN ?= ../boot/ocamlrun +CAMLYACC ?= ../boot/ocamlyacc -CAMLRUN=../boot/ocamlrun CAMLC=$(CAMLRUN) ../boot/ocamlc -nostdlib -I ../boot CAMLOPT=$(CAMLRUN) ../ocamlopt -nostdlib -I ../stdlib CAMLLEX=$(CAMLRUN) ../boot/ocamllex @@ -279,8 +280,15 @@ else DEF_SYMBOL_PREFIX = '-Dsymbol_prefix=""' endif +ifeq "$(CCOMPTYPE)" "msvc" +CCOUT = -Fe +else +EMPTY = +CCOUT = -o $(EMPTY) +endif + objinfo_helper$(EXE): objinfo_helper.c ../config/s.h - $(BYTECC) -o objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \ + $(BYTECC) $(CCOUT)objinfo_helper$(EXE) $(BYTECCCOMPOPTS) \ $(DEF_SYMBOL_PREFIX) $(LIBBFD_INCLUDE) objinfo_helper.c $(LIBBFD_LINK) OBJINFO=../compilerlibs/ocamlcommon.cma \ diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index e5db84a3d4..26ced6c567 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -76,6 +76,7 @@ module Options = Main_args.Make_bytecomp_options (struct let _o s = option_with_arg "-o" s let _open s = option_with_arg "-open" s let _output_obj = option "-output-obj" + let _output_complete_obj = option "-output-complete-obj" let _pack = option "-pack" let _pp _s = incompatible "-pp" let _ppx _s = incompatible "-ppx" diff --git a/tools/ocamloptp.ml b/tools/ocamloptp.ml index 2b93f48122..fd15fe5968 100644 --- a/tools/ocamloptp.ml +++ b/tools/ocamloptp.ml @@ -76,6 +76,7 @@ module Options = Main_args.Make_optcomp_options (struct let _o s = option_with_arg "-o" s let _open s = option_with_arg "-open" s let _output_obj = option "-output-obj" + let _output_complete_obj = option "-output-complete-obj" let _p = option "-p" let _pack = option "-pack" let _pp _s = incompatible "-pp" diff --git a/toplevel/toploop.ml b/toplevel/toploop.ml index ec72b53793..296e1cc430 100644 --- a/toplevel/toploop.ml +++ b/toplevel/toploop.ml @@ -465,6 +465,7 @@ let initialize_toplevel_env () = exception PPerror let loop ppf = + Location.formatter_for_warnings := ppf; fprintf ppf " OCaml version %s@.@." Config.version; initialize_toplevel_env (); let lb = Lexing.from_function refill_lexbuf in diff --git a/typing/env.ml b/typing/env.ml index b8040afa3a..e0b3462298 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -432,6 +432,9 @@ let reset_cache_toplevel () = let set_unit_name name = current_unit := name +let get_unit_name () = + !current_unit + (* Lookup by identifier *) let rec find_module_descr path env = diff --git a/typing/env.mli b/typing/env.mli index 8723185258..06a1e2beb3 100644 --- a/typing/env.mli +++ b/typing/env.mli @@ -148,6 +148,7 @@ val reset_cache_toplevel: unit -> unit (* Remember the name of the current compilation unit. *) val set_unit_name: string -> unit +val get_unit_name: unit -> string (* Read, save a signature to/from a file *) diff --git a/typing/subst.mli b/typing/subst.mli index a197f82f48..7f6870e939 100644 --- a/typing/subst.mli +++ b/typing/subst.mli @@ -51,6 +51,8 @@ val modtype: t -> module_type -> module_type val signature: t -> signature -> signature val modtype_declaration: t -> modtype_declaration -> modtype_declaration val module_declaration: t -> module_declaration -> module_declaration +val typexp : t -> Types.type_expr -> Types.type_expr +val class_signature: t -> class_signature -> class_signature (* Composition of substitutions: apply (compose s1 s2) x = apply s2 (apply s1 x) *) diff --git a/typing/typecore.ml b/typing/typecore.ml index 09afcd8a39..593ba78ace 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -614,7 +614,7 @@ end) = struct open Name let get_type_path env d = - match (get_type d).desc with + match (repr (get_type d)).desc with | Tconstr(p, _, _) -> p | _ -> assert false diff --git a/typing/typemod.ml b/typing/typemod.ml index aa49cc9ab2..0dd60fe195 100644 --- a/typing/typemod.ml +++ b/typing/typemod.ml @@ -311,6 +311,16 @@ let rec map_rec_type_with_row_types ~rec_flag fn decls rem = else map_rec_type ~rec_flag fn decls rem +let rec_flag_of_ptype_declarations tds = + let is_nonrec = + List.exists + (fun td -> + List.exists (fun (n, _) -> n.txt = "nonrec") + td.ptype_attributes) + tds + in + if is_nonrec then Nonrecursive else Recursive + (* Add type extension flags to extension contructors *) let map_ext fn exts rem = match exts with @@ -360,6 +370,7 @@ and approx_sig env ssg = | item :: srem -> match item.psig_desc with | Psig_type (rec_flag, sdecls) -> + let rec_flag = rec_flag_of_ptype_declarations sdecls in let decls = Typedecl.approx_type_decl env sdecls in let rem = approx_sig env srem in map_rec_type ~rec_flag @@ -586,6 +597,7 @@ and transl_signature env sg = Sig_value(tdesc.val_id, tdesc.val_val) :: rem, final_env | Psig_type (rec_flag, sdecls) -> + let rec_flag = rec_flag_of_ptype_declarations sdecls in List.iter (fun decl -> check_name check_type names decl.ptype_name) sdecls; @@ -843,6 +855,9 @@ let rec path_of_module mexp = path_of_module mexp | _ -> raise Not_a_path +let path_of_module mexp = + try Some (path_of_module mexp) with Not_a_path -> None + (* Check that all core type schemes in a structure are closed *) let rec closed_modtype env = function @@ -1110,7 +1125,7 @@ let rec type_module ?(alias=false) sttn funct_body anchor env smod = mod_loc = smod.pmod_loc } | Pmod_apply(sfunct, sarg) -> let arg = type_module true funct_body None env sarg in - let path = try Some (path_of_module arg) with Not_a_path -> None in + let path = path_of_module arg in let funct = type_module (sttn && path <> None) funct_body None env sfunct in begin match Env.scrape_alias env funct.mod_type with @@ -1231,6 +1246,7 @@ and type_structure ?(toplevel = false) funct_body anchor env sstr scope = let (desc, newenv) = Typedecl.transl_value_decl env loc sdesc in Tstr_primitive desc, [Sig_value(desc.val_id, desc.val_val)], newenv | Pstr_type (rec_flag, sdecls) -> + let rec_flag = rec_flag_of_ptype_declarations sdecls in List.iter (fun decl -> check_name check_type names decl.ptype_name) sdecls; diff --git a/typing/typemod.mli b/typing/typemod.mli index 0d0ebecabb..25c1110006 100644 --- a/typing/typemod.mli +++ b/typing/typemod.mli @@ -40,6 +40,8 @@ val modtype_of_package: Path.t -> Longident.t list -> type_expr list -> module_type val simplify_signature: signature -> signature +val path_of_module : Typedtree.module_expr -> Path.t option + val save_signature: string -> Typedtree.signature -> string -> string -> Env.t -> Types.signature_item list -> unit diff --git a/utils/ccomp.ml b/utils/ccomp.ml index 4bea26866b..a897ddc0d9 100644 --- a/utils/ccomp.ml +++ b/utils/ccomp.ml @@ -101,14 +101,22 @@ type link_mode = | MainDll | Partial +let remove_Wl cclibs = + cclibs |> List.map (fun cclib -> + (* -Wl,-foo,bar -> -foo bar *) + if String.length cclib >= 4 && "-Wl," = String.sub cclib 0 4 then + String.map (function ',' -> ' ' | c -> c) + (String.sub cclib 4 (String.length cclib - 4)) + else cclib) + let call_linker mode output_name files extra = - let files = quote_files files in let cmd = if mode = Partial then - Printf.sprintf "%s%s %s %s" + Printf.sprintf "%s%s %s %s %s" Config.native_pack_linker (Filename.quote output_name) - files + (quote_prefixed "-L" !Config.load_path) + (quote_files (remove_Wl files)) extra else Printf.sprintf "%s -o %s %s %s %s %s %s %s" @@ -124,7 +132,7 @@ let call_linker mode output_name files extra = "" (*(Clflags.std_include_flag "-I")*) (quote_prefixed "-L" !Config.load_path) (String.concat " " (List.rev !Clflags.all_ccopts)) - files + (quote_files files) extra in command cmd = 0 diff --git a/utils/clflags.ml b/utils/clflags.ml index fb31d450f1..4d2010af77 100644 --- a/utils/clflags.ml +++ b/utils/clflags.ml @@ -29,6 +29,7 @@ and custom_runtime = ref false (* -custom *) and no_check_prims = ref false (* -no-check-prims *) and bytecode_compatible_32 = ref false (* -compat-32 *) and output_c_object = ref false (* -output-obj *) +and output_complete_object = ref false (* -output-complete-obj *) and all_ccopts = ref ([] : string list) (* -ccopt *) and classic = ref false (* -nolabels *) and nopervasives = ref false (* -nopervasives *) diff --git a/utils/clflags.mli b/utils/clflags.mli index 1b1b01c8a7..e62dc8b848 100644 --- a/utils/clflags.mli +++ b/utils/clflags.mli @@ -26,6 +26,7 @@ val custom_runtime : bool ref val no_check_prims : bool ref val bytecode_compatible_32 : bool ref val output_c_object : bool ref +val output_complete_object : bool ref val all_ccopts : string list ref val classic : bool ref val nopervasives : bool ref diff --git a/utils/warnings.ml b/utils/warnings.ml index e0e8b91fa6..b2d5e573cc 100644 --- a/utils/warnings.ml +++ b/utils/warnings.ml @@ -477,7 +477,7 @@ let descriptions = 43, "Nonoptional label applied as optional."; 44, "Open statement shadows an already defined identifier."; 45, "Open statement shadows an already defined label or constructor."; - 46, "Illegal environment variable."; + 46, "Error in environment variable."; 47, "Illegal attribute payload."; 48, "Implicit elimination of optional arguments."; 49, "Missing cmi file when looking up module alias."; @@ -488,15 +488,15 @@ let descriptions = let help_warnings () = List.iter (fun (i, s) -> Printf.printf "%3i %s\n" i s) descriptions; - print_endline " A All warnings."; + print_endline " A all warnings"; for i = Char.code 'b' to Char.code 'z' do let c = Char.chr i in match letter c with | [] -> () | [n] -> - Printf.printf " %c Synonym for warning %i.\n" (Char.uppercase_ascii c) n + Printf.printf " %c Alias for warning %i.\n" (Char.uppercase_ascii c) n | l -> - Printf.printf " %c Set of warnings %s.\n" + Printf.printf " %c warnings %s.\n" (Char.uppercase_ascii c) (String.concat ", " (List.map string_of_int l)) done; diff --git a/yacc/Makefile b/yacc/Makefile index f5b37e0008..e7acf86908 100644 --- a/yacc/Makefile +++ b/yacc/Makefile @@ -15,7 +15,7 @@ include ../config/Makefile CC=$(BYTECC) -CFLAGS=-O -DNDEBUG $(BYTECCCOMPOPTS) +CFLAGS=-DNDEBUG $(BYTECCCOMPOPTS) OBJS= closure.o error.o lalr.o lr0.o main.o mkpar.o output.o reader.o \ skeleton.o symtab.o verbose.o warshall.o diff --git a/yacc/Makefile.nt b/yacc/Makefile.nt index b7284055aa..9537365a5f 100644 --- a/yacc/Makefile.nt +++ b/yacc/Makefile.nt @@ -30,7 +30,7 @@ clean: rm -f *.$(O) ocamlyacc.exe *~ version.h %.$(O): %.c - $(BYTECC) -DNDEBUG -DNO_UNIX $(BYTECCCOMPOPTS) -c -o $@ $< + $(BYTECC) -DNDEBUG -DNO_UNIX $(BYTECCCOMPOPTS) -c $< depend: |