Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

merge changes from branch 4.02 from branching (rev 14852) to 4.02.0+rc1 (rev 15121) 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15125 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2014-08-22 13:45:02 +00:00
parent 09ad9c1abb
commit cbfe627f92
235 changed files with 2774 additions and 1155 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
.depend
View File

@ -623,8 +623,10 @@ asmcomp/split.cmi : asmcomp/mach.cmi
asmcomp/strmatch.cmi : asmcomp/cmm.cmi
asmcomp/CSE.cmo : asmcomp/mach.cmi asmcomp/CSEgen.cmi asmcomp/arch.cmo
asmcomp/CSE.cmx : asmcomp/mach.cmx asmcomp/CSEgen.cmx asmcomp/arch.cmx
asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/CSEgen.cmi
asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/mach.cmx asmcomp/CSEgen.cmi
asmcomp/CSEgen.cmo : asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/mach.cmi \
asmcomp/CSEgen.cmi
asmcomp/CSEgen.cmx : asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/mach.cmx \
asmcomp/CSEgen.cmi
asmcomp/arch.cmo :
asmcomp/arch.cmx :
asmcomp/asmgen.cmo : bytecomp/translmod.cmi asmcomp/split.cmi \
@ -864,8 +866,7 @@ driver/compile.cmo : utils/warnings.cmi typing/typemod.cmi \
parsing/printast.cmi parsing/pprintast.cmi driver/pparse.cmi \
utils/misc.cmi parsing/location.cmi typing/includemod.cmi typing/env.cmi \
bytecomp/emitcode.cmi driver/compmisc.cmi driver/compenv.cmi \
utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi \
parsing/ast_mapper.cmi driver/compile.cmi
utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi
driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \
@ -873,8 +874,7 @@ driver/compile.cmx : utils/warnings.cmx typing/typemod.cmx \
parsing/printast.cmx parsing/pprintast.cmx driver/pparse.cmx \
utils/misc.cmx parsing/location.cmx typing/includemod.cmx typing/env.cmx \
bytecomp/emitcode.cmx driver/compmisc.cmx driver/compenv.cmx \
utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx \
parsing/ast_mapper.cmx driver/compile.cmi
utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi
driver/compmisc.cmo : typing/typemod.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi typing/ident.cmi \
typing/env.cmi utils/config.cmi driver/compenv.cmi utils/clflags.cmi \
@ -904,8 +904,7 @@ driver/optcompile.cmo : utils/warnings.cmi typing/typemod.cmi \
parsing/pprintast.cmi driver/pparse.cmi utils/misc.cmi \
typing/includemod.cmi typing/env.cmi utils/config.cmi driver/compmisc.cmi \
asmcomp/compilenv.cmi driver/compenv.cmi utils/clflags.cmi \
utils/ccomp.cmi parsing/ast_mapper.cmi asmcomp/asmgen.cmi \
driver/optcompile.cmi
utils/ccomp.cmi asmcomp/asmgen.cmi driver/optcompile.cmi
driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
typing/typedtree.cmx typing/typecore.cmx bytecomp/translmod.cmx \
typing/stypes.cmx bytecomp/simplif.cmx typing/printtyped.cmx \
@ -913,8 +912,7 @@ driver/optcompile.cmx : utils/warnings.cmx typing/typemod.cmx \
parsing/pprintast.cmx driver/pparse.cmx utils/misc.cmx \
typing/includemod.cmx typing/env.cmx utils/config.cmx driver/compmisc.cmx \
asmcomp/compilenv.cmx driver/compenv.cmx utils/clflags.cmx \
utils/ccomp.cmx parsing/ast_mapper.cmx asmcomp/asmgen.cmx \
driver/optcompile.cmi
utils/ccomp.cmx asmcomp/asmgen.cmx driver/optcompile.cmi
driver/opterrors.cmo : parsing/location.cmi driver/opterrors.cmi
driver/opterrors.cmx : parsing/location.cmx driver/opterrors.cmi
driver/optmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \
@ -930,12 +928,10 @@ driver/optmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
asmcomp/asmlink.cmx asmcomp/asmlibrarian.cmx asmcomp/arch.cmx \
driver/optmain.cmi
driver/pparse.cmo : parsing/parsetree.cmi parsing/parse.cmi utils/misc.cmi \
parsing/longident.cmi parsing/location.cmi utils/config.cmi \
utils/clflags.cmi utils/ccomp.cmi parsing/asttypes.cmi \
parsing/location.cmi utils/config.cmi utils/clflags.cmi utils/ccomp.cmi \
parsing/ast_mapper.cmi parsing/ast_helper.cmi driver/pparse.cmi
driver/pparse.cmx : parsing/parsetree.cmi parsing/parse.cmx utils/misc.cmx \
parsing/longident.cmx parsing/location.cmx utils/config.cmx \
utils/clflags.cmx utils/ccomp.cmx parsing/asttypes.cmi \
parsing/location.cmx utils/config.cmx utils/clflags.cmx utils/ccomp.cmx \
parsing/ast_mapper.cmx parsing/ast_helper.cmx driver/pparse.cmi
toplevel/genprintval.cmi : typing/types.cmi typing/path.cmi \
typing/outcometree.cmi typing/env.cmi
@ -1000,13 +996,11 @@ toplevel/opttoploop.cmx : utils/warnings.cmx typing/types.cmx \
toplevel/opttopmain.cmo : utils/warnings.cmi asmcomp/printmach.cmi \
toplevel/opttoploop.cmi toplevel/opttopdirs.cmi utils/misc.cmi \
driver/main_args.cmi parsing/location.cmi utils/config.cmi \
driver/compenv.cmi utils/clflags.cmi parsing/ast_mapper.cmi \
toplevel/opttopmain.cmi
driver/compenv.cmi utils/clflags.cmi toplevel/opttopmain.cmi
toplevel/opttopmain.cmx : utils/warnings.cmx asmcomp/printmach.cmx \
toplevel/opttoploop.cmx toplevel/opttopdirs.cmx utils/misc.cmx \
driver/main_args.cmx parsing/location.cmx utils/config.cmx \
driver/compenv.cmx utils/clflags.cmx parsing/ast_mapper.cmx \
toplevel/opttopmain.cmi
driver/compenv.cmx utils/clflags.cmx toplevel/opttopmain.cmi
toplevel/opttopstart.cmo : toplevel/opttopmain.cmi
toplevel/opttopstart.cmx : toplevel/opttopmain.cmx
toplevel/topdirs.cmo : utils/warnings.cmi typing/typetexp.cmi \
@ -1056,11 +1050,11 @@ toplevel/toploop.cmx : utils/warnings.cmx typing/types.cmx \
toplevel/topmain.cmo : utils/warnings.cmi toplevel/toploop.cmi \
toplevel/topdirs.cmi utils/misc.cmi driver/main_args.cmi \
parsing/location.cmi utils/config.cmi driver/compenv.cmi \
utils/clflags.cmi parsing/ast_mapper.cmi toplevel/topmain.cmi
utils/clflags.cmi toplevel/topmain.cmi
toplevel/topmain.cmx : utils/warnings.cmx toplevel/toploop.cmx \
toplevel/topdirs.cmx utils/misc.cmx driver/main_args.cmx \
parsing/location.cmx utils/config.cmx driver/compenv.cmx \
utils/clflags.cmx parsing/ast_mapper.cmx toplevel/topmain.cmi
utils/clflags.cmx toplevel/topmain.cmi
toplevel/topstart.cmo : toplevel/topmain.cmi
toplevel/topstart.cmx : toplevel/topmain.cmx
toplevel/trace.cmo : typing/types.cmi toplevel/toploop.cmi \

123
.gitignore vendored
View File

@ -1219,6 +1219,27 @@
/testsuite/tests/basic-manyargs/.depend.nt
/testsuite/tests/basic-manyargs/.DS_Store
# /testsuite/tests/basic-modules/
/testsuite/tests/basic-modules/*.o
/testsuite/tests/basic-modules/*.a
/testsuite/tests/basic-modules/*.so
/testsuite/tests/basic-modules/*.obj
/testsuite/tests/basic-modules/*.lib
/testsuite/tests/basic-modules/*.dll
/testsuite/tests/basic-modules/*.cm[ioxat]
/testsuite/tests/basic-modules/*.cmx[as]
/testsuite/tests/basic-modules/*.cmti
/testsuite/tests/basic-modules/*.annot
/testsuite/tests/basic-modules/*.result
/testsuite/tests/basic-modules/*.byte
/testsuite/tests/basic-modules/*.native
/testsuite/tests/basic-modules/program
/testsuite/tests/basic-modules/*.exe
/testsuite/tests/basic-modules/*.exe.manifest
/testsuite/tests/basic-modules/.depend
/testsuite/tests/basic-modules/.depend.nt
/testsuite/tests/basic-modules/.DS_Store
# /testsuite/tests/basic-more/
/testsuite/tests/basic-more/*.o
/testsuite/tests/basic-more/*.a
@ -1343,6 +1364,8 @@
/testsuite/tests/formats-transition/*.a
/testsuite/tests/formats-transition/*.so
/testsuite/tests/formats-transition/*.obj
/testsuite/tests/formats-transition/*.lib
/testsuite/tests/formats-transition/*.dll
/testsuite/tests/formats-transition/*.cm[ioxat]
/testsuite/tests/formats-transition/*.cmx[as]
/testsuite/tests/formats-transition/*.cmti
@ -1351,7 +1374,8 @@
/testsuite/tests/formats-transition/*.byte
/testsuite/tests/formats-transition/*.native
/testsuite/tests/formats-transition/program
/testsuite/tests/formats-transition/program.exe
/testsuite/tests/formats-transition/*.exe
/testsuite/tests/formats-transition/*.exe.manifest
/testsuite/tests/formats-transition/.depend
/testsuite/tests/formats-transition/.depend.nt
/testsuite/tests/formats-transition/.DS_Store
@ -1819,6 +1843,8 @@
/testsuite/tests/match-exception/*.a
/testsuite/tests/match-exception/*.so
/testsuite/tests/match-exception/*.obj
/testsuite/tests/match-exception/*.lib
/testsuite/tests/match-exception/*.dll
/testsuite/tests/match-exception/*.cm[ioxat]
/testsuite/tests/match-exception/*.cmx[as]
/testsuite/tests/match-exception/*.cmti
@ -1827,11 +1853,33 @@
/testsuite/tests/match-exception/*.byte
/testsuite/tests/match-exception/*.native
/testsuite/tests/match-exception/program
/testsuite/tests/match-exception/program.exe
/testsuite/tests/match-exception/*.exe
/testsuite/tests/match-exception/*.exe.manifest
/testsuite/tests/match-exception/.depend
/testsuite/tests/match-exception/.depend.nt
/testsuite/tests/match-exception/.DS_Store
# /testsuite/tests/match-exception-warnings/
/testsuite/tests/match-exception-warnings/*.o
/testsuite/tests/match-exception-warnings/*.a
/testsuite/tests/match-exception-warnings/*.so
/testsuite/tests/match-exception-warnings/*.obj
/testsuite/tests/match-exception-warnings/*.lib
/testsuite/tests/match-exception-warnings/*.dll
/testsuite/tests/match-exception-warnings/*.cm[ioxat]
/testsuite/tests/match-exception-warnings/*.cmx[as]
/testsuite/tests/match-exception-warnings/*.cmti
/testsuite/tests/match-exception-warnings/*.annot
/testsuite/tests/match-exception-warnings/*.result
/testsuite/tests/match-exception-warnings/*.byte
/testsuite/tests/match-exception-warnings/*.native
/testsuite/tests/match-exception-warnings/program
/testsuite/tests/match-exception-warnings/*.exe
/testsuite/tests/match-exception-warnings/*.exe.manifest
/testsuite/tests/match-exception-warnings/.depend
/testsuite/tests/match-exception-warnings/.depend.nt
/testsuite/tests/match-exception-warnings/.DS_Store
# /testsuite/tests/misc/
/testsuite/tests/misc/*.o
/testsuite/tests/misc/*.a
@ -2067,6 +2115,51 @@
/testsuite/tests/tool-debugger/.DS_Store
/testsuite/tests/tool-debugger/compiler-libs
# /testsuite/tests/tool-debugger/basic/
/testsuite/tests/tool-debugger/basic/*.o
/testsuite/tests/tool-debugger/basic/*.a
/testsuite/tests/tool-debugger/basic/*.so
/testsuite/tests/tool-debugger/basic/*.obj
/testsuite/tests/tool-debugger/basic/*.lib
/testsuite/tests/tool-debugger/basic/*.dll
/testsuite/tests/tool-debugger/basic/*.cm[ioxat]
/testsuite/tests/tool-debugger/basic/*.cmx[as]
/testsuite/tests/tool-debugger/basic/*.cmti
/testsuite/tests/tool-debugger/basic/*.annot
/testsuite/tests/tool-debugger/basic/*.result
/testsuite/tests/tool-debugger/basic/*.byte
/testsuite/tests/tool-debugger/basic/*.native
/testsuite/tests/tool-debugger/basic/program
/testsuite/tests/tool-debugger/basic/*.exe
/testsuite/tests/tool-debugger/basic/*.exe.manifest
/testsuite/tests/tool-debugger/basic/.depend
/testsuite/tests/tool-debugger/basic/.depend.nt
/testsuite/tests/tool-debugger/basic/.DS_Store
/testsuite/tests/tool-debugger/basic/compiler-libs
# /testsuite/tests/tool-debugger/find-artifacts/
/testsuite/tests/tool-debugger/find-artifacts/*.o
/testsuite/tests/tool-debugger/find-artifacts/*.a
/testsuite/tests/tool-debugger/find-artifacts/*.so
/testsuite/tests/tool-debugger/find-artifacts/*.obj
/testsuite/tests/tool-debugger/find-artifacts/*.lib
/testsuite/tests/tool-debugger/find-artifacts/*.dll
/testsuite/tests/tool-debugger/find-artifacts/*.cm[ioxat]
/testsuite/tests/tool-debugger/find-artifacts/*.cmx[as]
/testsuite/tests/tool-debugger/find-artifacts/*.cmti
/testsuite/tests/tool-debugger/find-artifacts/*.annot
/testsuite/tests/tool-debugger/find-artifacts/*.result
/testsuite/tests/tool-debugger/find-artifacts/*.byte
/testsuite/tests/tool-debugger/find-artifacts/*.native
/testsuite/tests/tool-debugger/find-artifacts/program
/testsuite/tests/tool-debugger/find-artifacts/*.exe
/testsuite/tests/tool-debugger/find-artifacts/*.exe.manifest
/testsuite/tests/tool-debugger/find-artifacts/.depend
/testsuite/tests/tool-debugger/find-artifacts/.depend.nt
/testsuite/tests/tool-debugger/find-artifacts/.DS_Store
/testsuite/tests/tool-debugger/find-artifacts/compiler-libs
/testsuite/tests/tool-debugger/find-artifacts/out
# /testsuite/tests/tool-lexyacc/
/testsuite/tests/tool-lexyacc/*.o
/testsuite/tests/tool-lexyacc/*.a
@ -2124,11 +2217,34 @@
/testsuite/tests/tool-ocamldoc/*.css
/testsuite/tests/tool-ocamldoc/ocamldoc.out
# /testsuite/tests/tool-toplevel/
/testsuite/tests/tool-toplevel/*.o
/testsuite/tests/tool-toplevel/*.a
/testsuite/tests/tool-toplevel/*.so
/testsuite/tests/tool-toplevel/*.obj
/testsuite/tests/tool-toplevel/*.lib
/testsuite/tests/tool-toplevel/*.dll
/testsuite/tests/tool-toplevel/*.cm[ioxat]
/testsuite/tests/tool-toplevel/*.cmx[as]
/testsuite/tests/tool-toplevel/*.cmti
/testsuite/tests/tool-toplevel/*.annot
/testsuite/tests/tool-toplevel/*.result
/testsuite/tests/tool-toplevel/*.byte
/testsuite/tests/tool-toplevel/*.native
/testsuite/tests/tool-toplevel/program
/testsuite/tests/tool-toplevel/*.exe
/testsuite/tests/tool-toplevel/*.exe.manifest
/testsuite/tests/tool-toplevel/.depend
/testsuite/tests/tool-toplevel/.depend.nt
/testsuite/tests/tool-toplevel/.DS_Store
# /testsuite/tests/typing-extensions/
/testsuite/tests/typing-extensions/*.o
/testsuite/tests/typing-extensions/*.a
/testsuite/tests/typing-extensions/*.so
/testsuite/tests/typing-extensions/*.obj
/testsuite/tests/typing-extensions/*.lib
/testsuite/tests/typing-extensions/*.dll
/testsuite/tests/typing-extensions/*.cm[ioxat]
/testsuite/tests/typing-extensions/*.cmx[as]
/testsuite/tests/typing-extensions/*.cmti
@ -2137,7 +2253,8 @@
/testsuite/tests/typing-extensions/*.byte
/testsuite/tests/typing-extensions/*.native
/testsuite/tests/typing-extensions/program
/testsuite/tests/typing-extensions/program.exe
/testsuite/tests/typing-extensions/*.exe
/testsuite/tests/typing-extensions/*.exe.manifest
/testsuite/tests/typing-extensions/.depend
/testsuite/tests/typing-extensions/.depend.nt
/testsuite/tests/typing-extensions/.DS_Store

41
Changes
View File

@ -1,4 +1,4 @@
Next version:
OCaml 4.03.0:
-------------
Compilers:
@ -31,6 +31,7 @@ Language features:
Build system for the OCaml distribution:
- Use -bin-annot when building.
- Use GNU make instead of portable makefiles.
- Updated build instructions for 32-bit Mac OS X on Intel hardware.
Shedding weight:
* Removed Camlp4 from the distribution, now available as third-party software.
@ -138,6 +139,8 @@ Runtime system:
Standard library:
* Add new modules: Bytes and BytesLabels.
(Damien Doligez)
- PR#6355: Improve documentation regarding finalisers and multithreading
(Daniel Bünzli, Mark Shinwell)
- PR#4986: add List.sort_uniq and Set.of_list
(Alain Frisch)
- PR#5935: a faster version of "raise" which does not maintain the backtrace
@ -148,11 +151,15 @@ Standard library:
(John Whitington)
- PR#6180: efficient creation of uninitialized float arrays
(Alain Frisch, request by Markus Mottl)
- Trigger warning 3 for all values marked as deprected in the documentation.
(Damien Doligez)
OCamldoc:
- PR#6257: handle full doc comments for variant constructors and
record fields
(Maxence Guesdon, request by ygrek)
- PR#6274: allow doc comments on object types
(Thomas Refis)
- PR#6310: fix ocamldoc's subscript/superscript CSS font size
(Anil Madhavapeddy)
- PR#6425: fix generation of man pages
@ -163,16 +170,28 @@ Bug fixes:
[caml_bottom_of_stack]. (Richard Jones, Mark Shinwell)
- PR#2719: wrong scheduling of bound checks within a
try...with Invalid_argument -> _ ... (Xavier Leroy)
- PR#4771: Clarify documentation of Dynlink.allow_only
(Damien Doligez, report by David Allsopp)
- PR#6232: Don't use [mktemp] on platforms where [mkstemp] is available
(Stéphane Glondu, Mark Shinwell)
- PR#6439: Don't use the deprecated [getpagesize] function
(John Whitington, Mark Shinwell)
- PR#4719: Sys.executable_name wrong if executable name contains dots (Windows)
(Alain Frisch, report by Bart Jacobs)
- PR#4855: 'camlp4 -I +dir' accepted, dir is relative to 'camlp4 -where'
(Jun Furuse and Hongbo Zhang, report by Dmitry Grebeniuk)
- PR#5201: ocamlbuild: add --norc to the bash invocation to help performances
(user 'daweil')
- PR#5406 ocamlbuild: "tag 'package' does not expect a parameter"
(Gabriel Scherer)
- PR#5598: follow-up fix related to PR#6165
(Damien Doligez)
- PR#5820: Fix camlp4 lexer roll back problem
(Hongbo Zhang)
- PR#5851: warn when -r is disabled because no _tags file is present
(Gabriel Scherer)
- PR#5946: CAMLprim taking (void) as argument
(Benoît Vaugon)
- PR#6038: on x86-32, enforce 16-byte stack alignment for compatibility
with recent GCC and Clang. Win32/MSVC keeps 4-byte stack alignment.
(Xavier Leroy)
@ -229,10 +248,14 @@ Bug fixes:
(Jacques Garrigue, report by Leo White)
- PR#6293: Assert_failure with invalid package type
(Jacques Garrigue, report by Elnatan Reisner)
- PR#6300: ocamlbuild -use-ocamlfind conflicts with -ocamlc
(Gabriel Scherer)
- PR#6302: bytecode debug information re-read from filesystem every time
(Jacques-Henri Jourdan)
- PR#6307: Behavior of 'module type of' w.r.t. module aliases
(Jacques Garrigue, report by Alain Frisch)
- PR#6332: Unix.open_process fails to pass empty arguments under Windows
(Damien Doligez, report Virgile Prevosto)
- PR#6346: Build failure with latest version of xcode on OSX
(Jérémie Dimino)
- PR#6348: Unification failure for GADT when original definition is hidden
@ -251,21 +274,33 @@ Bug fixes:
(Alain Frisch and Jacques Garrigue)
- PR#6405: unsound interaction of -rectypes and GADTs
(Jacques Garrigue, report by Gabriel Scherer and Benoît Vaugon)
- PR#6408: Optional arguments given as ~?arg instead of ?arg in message
(Michael O'Connor)
- PR#6418: reimplement parametrized Format tags/indentation with GADTs
(Benoît Vaugon)
- PR#6436: Typos in @deprecated text in stdlib/arrayLabels.mli
(John Whitington)
- PR#6443: ocaml segfault when List.fold_left is traced then executed
(Jacques Garrigue, report by Reventlov)
- PR#6460: runtime assertion failure with large [| e1;...eN |]
float array expressions
(Leo White)
- PR#6482: ocamlbuild fails when _tags file in unhygienic directory
(Gabriel Scherer)
- PR#6505: Missed Type-error leads to a segfault upon record access
(Jacques Garrigue, report by Christoph Höger)
- PR#6509: add -linkall flag to ocamlcommon.cma
(Frédéric Bour)
- PR#6513: Fatal error Ctype.Unify(_) in functor type
(Jacques Garrigue, report by Dario Teixeira)
- fix -dsource printing of "external _pipe = ..."
(Gabriel Scherer)
- bound-checking bug in caml_string_{get,set}{16,32,64}
(Pierre Chambart and Gabriel Scherer, report by Nicolas Trangez)
- sometimes wrong stack alignment at out-of-bounds array access
(Gabriel Scherer and Xavier Leroy, report by Pierre Chambart)
- make ocamldebug -I auto-detection work with ocamlbuild
(Josh Watzman)
Features wishes:
- PR#4243: make the Makefiles parallelizable
@ -287,6 +322,8 @@ Features wishes:
(Jeremy Yallop, review by Gabriel Scherer)
- PR#6071: Add a -noinit option to the toplevel
(David Sheets)
- PR#6087: ocamlbuild, improve _tags parsing of escaped newlines
(Gabriel Scherer, request by Daniel Bünzli)
- PR#6166: document -ocamldoc option of ocamlbuild
(Xavier Clerc)
- PR#6187: ocamlbuild: warn when using -plugin-tag(s) without myocamlbuild.ml
@ -299,6 +336,8 @@ Features wishes:
(Gabriel Scherer, request by François Berenger)
- PR#6406: Expose OCaml version in C headers
(Peter Zotov and Romain Calascibetta)
- PR#5899: a programmer-friendly access to backtrace information
(Jacques-Henri Jourdan and Gabriel Scherer)
- ocamllex: user-definable refill action
(Frédéric Bour, review by Gabriel Scherer and Luc Maranget)
- shorten syntax for functor signatures: "functor (M1:S1) (M2:S2) .. -> .."

6
README.win32
View File

@ -260,6 +260,12 @@ NOTES:
* The replay debugger is partially supported (no reverse execution).
* The default Makefile.mingw passes -static-libgcc to the linker.
For more information on this topic:
http://gcc.gnu.org/onlinedocs/gcc-4.9.1/gcc/Link-Options.html#Link-Options
http://caml.inria.fr/mantis/view.php?id=6411
------------------------------------------------------------------------------
The Cygwin port of OCaml

2
VERSION
View File

@ -1,4 +1,4 @@
4.03.0+dev1-2014-07-21
4.03.0+dev2-2014-08-22
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli

3
asmcomp/CSEgen.mli
View File

@ -33,6 +33,3 @@ class cse_generic : object
method fundecl: Mach.fundecl -> Mach.fundecl
end

1
asmcomp/amd64/CSE.ml
View File

@ -36,4 +36,3 @@ end
let fundecl f =
(new cse)#fundecl f

3
asmcomp/amd64/arch.ml
View File

@ -33,7 +33,8 @@ type addressing_mode =
type specific_operation =
Ilea of addressing_mode (* "lea" gives scaled adds *)
| Istore_int of nativeint * addressing_mode * bool (* Store an integer constant *)
| Istore_int of nativeint * addressing_mode * bool
(* Store an integer constant *)
| Istore_symbol of string * addressing_mode * bool (* Store a symbol *)
| Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
| Ifloatarithmem of float_operation * addressing_mode

8
asmcomp/amd64/proc.ml
View File

@ -117,12 +117,12 @@ let rotate_registers = false
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
let v = Array.create 13 Reg.dummy in
let v = Array.make 13 Reg.dummy in
for i = 0 to 12 do v.(i) <- Reg.at_location Int (Reg i) done;
v
let hard_float_reg =
let v = Array.create 16 Reg.dummy in
let v = Array.make 16 Reg.dummy in
for i = 0 to 15 do v.(i) <- Reg.at_location Float (Reg (100 + i)) done;
v
@ -149,7 +149,7 @@ let word_addressed = false
let calling_conventions first_int last_int first_float last_float make_stack
arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref 0 in
@ -210,7 +210,7 @@ let win64_float_external_arguments =
[| 100 (*xmm0*); 101 (*xmm1*); 102 (*xmm2*); 103 (*xmm3*) |]
let win64_loc_external_arguments arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let reg = ref 0
and ofs = ref 32 in
for i = 0 to Array.length arg - 1 do

1
asmcomp/arm/CSE.ml
View File

@ -35,4 +35,3 @@ end
let fundecl f =
(new cse)#fundecl f

2
asmcomp/arm/arch.ml
View File

@ -21,7 +21,7 @@ type fpu = Soft | VFPv2 | VFPv3_D16 | VFPv3
let abi =
match Config.system with
"linux_eabi" -> EABI
"linux_eabi" | "freebsd" -> EABI
| "linux_eabihf" -> EABI_HF
| _ -> assert false

6
asmcomp/arm/proc.ml
View File

@ -82,14 +82,14 @@ let rotate_registers = true
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
let v = Array.create 9 Reg.dummy in
let v = Array.make 9 Reg.dummy in
for i = 0 to 8 do
v.(i) <- Reg.at_location Int (Reg i)
done;
v
let hard_float_reg =
let v = Array.create 32 Reg.dummy in
let v = Array.make 32 Reg.dummy in
for i = 0 to 31 do
v.(i) <- Reg.at_location Float (Reg(100 + i))
done;
@ -108,7 +108,7 @@ let stack_slot slot ty =
let calling_conventions
first_int last_int first_float last_float make_stack arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref 0 in

1
asmcomp/arm64/CSE.ml
View File

@ -35,4 +35,3 @@ end
let fundecl f =
(new cse)#fundecl f

6
asmcomp/arm64/proc.ml
View File

@ -76,14 +76,14 @@ let rotate_registers = true
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
let v = Array.create 28 Reg.dummy in
let v = Array.make 28 Reg.dummy in
for i = 0 to 27 do
v.(i) <- Reg.at_location Int (Reg i)
done;
v
let hard_float_reg =
let v = Array.create 32 Reg.dummy in
let v = Array.make 32 Reg.dummy in
for i = 0 to 31 do
v.(i) <- Reg.at_location Float (Reg(100 + i))
done;
@ -105,7 +105,7 @@ let stack_slot slot ty =
let calling_conventions
first_int last_int first_float last_float make_stack arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref 0 in

3
asmcomp/asmlink.ml
View File

@ -412,6 +412,3 @@ let reset () =
cmx_required := [];
interfaces := [];
implementations := []

2
asmcomp/closure.ml
View File

@ -1177,7 +1177,7 @@ and close_one_function fenv cenv id funct =
and close_switch arg fenv cenv cases num_keys default =
let ncases = List.length cases in
let index = Array.create num_keys 0
let index = Array.make num_keys 0
and store = Storer.mk_store () in
(* First default case *)

5
asmcomp/cmmgen.ml
View File

@ -38,7 +38,8 @@ let bind_nonvar name arg fn =
| Cconst_blockheader _ -> fn arg
| _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id))
let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8 (* cf. byterun/gc.h *)
let caml_black = Nativeint.shift_left (Nativeint.of_int 3) 8
(* cf. byterun/gc.h *)
(* Block headers. Meaning of the tag field: see stdlib/obj.ml *)
@ -2409,7 +2410,7 @@ let cache_public_method meths tag cache =
*)
let apply_function_body arity =
let arg = Array.create arity (Ident.create "arg") in
let arg = Array.make arity (Ident.create "arg") in
for i = 1 to arity - 1 do arg.(i) <- Ident.create "arg" done;
let clos = Ident.create "clos" in
let rec app_fun clos n =

8
asmcomp/coloring.ml
View File

@ -47,7 +47,7 @@ let allocate_registers() =
if reg.spill then begin
(* Preallocate the registers in the stack *)
let nslots = Proc.num_stack_slots.(cl) in
let conflict = Array.create nslots false in
let conflict = Array.make nslots false in
List.iter
(fun r ->
match r.loc with
@ -84,14 +84,14 @@ let allocate_registers() =
(* Where to start the search for a suitable register.
Used to introduce some "randomness" in the choice between registers
with equal scores. This offers more opportunities for scheduling. *)
let start_register = Array.create Proc.num_register_classes 0 in
let start_register = Array.make Proc.num_register_classes 0 in
(* Assign a location to a register, the best we can. *)
let assign_location reg =
let cl = Proc.register_class reg in
let first_reg = Proc.first_available_register.(cl) in
let num_regs = Proc.num_available_registers.(cl) in
let score = Array.create num_regs 0 in
let score = Array.make num_regs 0 in
let best_score = ref (-1000000) and best_reg = ref (-1) in
let start = start_register.(cl) in
if num_regs <> 0 then begin
@ -161,7 +161,7 @@ let allocate_registers() =
end else begin
(* Sorry, we must put the pseudoreg in a stack location *)
let nslots = Proc.num_stack_slots.(cl) in
let score = Array.create nslots 0 in
let score = Array.make nslots 0 in
(* Compute the scores as for registers *)
List.iter
(fun (r, w) ->

1
asmcomp/i386/CSE.ml
View File

@ -45,4 +45,3 @@ end
let fundecl f =
(new cse)#fundecl f

5
asmcomp/i386/arch.ml
View File

@ -31,11 +31,12 @@ type addressing_mode =
type specific_operation =
Ilea of addressing_mode (* Lea gives scaled adds *)
| Istore_int of nativeint * addressing_mode * bool (* Store an integer constant *)
| Istore_int of nativeint * addressing_mode * bool
(* Store an integer constant *)
| Istore_symbol of string * addressing_mode * bool (* Store a symbol *)
| Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
| Ipush (* Push regs on stack *)
| Ipush_int of nativeint (* Push an integer constant *)
| Ipush_int of nativeint (* Push an integer constant *)
| Ipush_symbol of string (* Push a symbol *)
| Ipush_load of addressing_mode (* Load a scalar and push *)
| Ipush_load_float of addressing_mode (* Load a float and push *)

4
asmcomp/i386/proc.ml
View File

@ -72,7 +72,7 @@ let rotate_registers = false
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
let v = Array.create 7 Reg.dummy in
let v = Array.make 7 Reg.dummy in
for i = 0 to 6 do v.(i) <- Reg.at_location Int (Reg i) done;
v
@ -111,7 +111,7 @@ let word_addressed = false
let calling_conventions first_int last_int first_float last_float make_stack
arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref (-64) in

2
asmcomp/linearize.ml
View File

@ -224,7 +224,7 @@ let rec linear i n =
(linear ifso (add_branch lbl_end nelse))
end
| Iswitch(index, cases) ->
let lbl_cases = Array.create (Array.length cases) 0 in
let lbl_cases = Array.make (Array.length cases) 0 in
let (lbl_end, n1) = get_label(linear i.Mach.next n) in
let n2 = ref (discard_dead_code n1) in
for i = Array.length cases - 1 downto 0 do

1
asmcomp/power/CSE.ml
View File

@ -35,4 +35,3 @@ end
let fundecl f =
(new cse)#fundecl f

8
asmcomp/power/proc.ml
View File

@ -83,11 +83,11 @@ let rotate_registers = true
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
let v = Array.create 23 Reg.dummy in
let v = Array.make 23 Reg.dummy in
for i = 0 to 22 do v.(i) <- Reg.at_location Int (Reg i) done; v
let hard_float_reg =
let v = Array.create 31 Reg.dummy in
let v = Array.make 31 Reg.dummy in
for i = 0 to 30 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done; v
let all_phys_regs =
@ -103,7 +103,7 @@ let stack_slot slot ty =
let calling_conventions
first_int last_int first_float last_float make_stack stack_ofs arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref stack_ofs in
@ -157,7 +157,7 @@ let loc_results res =
let poweropen_external_conventions first_int last_int
first_float last_float arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref (14 * size_addr) in

4
asmcomp/reg.ml
View File

@ -73,13 +73,13 @@ let create ty =
let createv tyv =
let n = Array.length tyv in
let rv = Array.create n dummy in
let rv = Array.make n dummy in
for i = 0 to n-1 do rv.(i) <- create tyv.(i) done;
rv
let createv_like rv =
let n = Array.length rv in
let rv' = Array.create n dummy in
let rv' = Array.make n dummy in
for i = 0 to n-1 do rv'.(i) <- create rv.(i).typ done;
rv'

2
asmcomp/reloadgen.ml
View File

@ -54,7 +54,7 @@ method makereg r =
method private makeregs rv =
let n = Array.length rv in
let newv = Array.create n Reg.dummy in
let newv = Array.make n Reg.dummy in
for i = 0 to n-1 do newv.(i) <- self#makereg rv.(i) done;
newv

4
asmcomp/selectgen.ml
View File

@ -111,7 +111,7 @@ let join opt_r1 seq1 opt_r2 seq2 =
| (Some r1, Some r2) ->
let l1 = Array.length r1 in
assert (l1 = Array.length r2);
let r = Array.create l1 Reg.dummy in
let r = Array.make l1 Reg.dummy in
for i = 0 to l1-1 do
if Reg.anonymous r1.(i) then begin
r.(i) <- r1.(i);
@ -139,7 +139,7 @@ let join_array rs =
None -> None
| Some template ->
let size_res = Array.length template in
let res = Array.create size_res Reg.dummy in
let res = Array.make size_res Reg.dummy in
for i = 0 to size_res - 1 do
res.(i) <- Reg.create template.(i).typ
done;

1
asmcomp/sparc/CSE.ml
View File

@ -28,4 +28,3 @@ end
let fundecl f =
(new cse)#fundecl f

6
asmcomp/sparc/proc.ml
View File

@ -81,12 +81,12 @@ let rotate_registers = true
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
let v = Array.create 19 Reg.dummy in
let v = Array.make 19 Reg.dummy in
for i = 0 to 18 do v.(i) <- Reg.at_location Int (Reg i) done;
v
let hard_float_reg =
let v = Array.create 32 Reg.dummy in
let v = Array.make 32 Reg.dummy in
for i = 0 to 31 do v.(i) <- Reg.at_location Float (Reg(100 + i)) done;
v
@ -105,7 +105,7 @@ let stack_slot slot ty =
let calling_conventions first_int last_int first_float last_float make_stack
arg =
let loc = Array.create (Array.length arg) Reg.dummy in
let loc = Array.make (Array.length arg) Reg.dummy in
let int = ref first_int in
let float = ref first_float in
let ofs = ref 0 in

2
asmcomp/spill.ml
View File

@ -64,7 +64,7 @@ let add_superpressure_regs op live_regs res_regs spilled =
let max_pressure = Proc.max_register_pressure op in
let regs = Reg.add_set_array live_regs res_regs in
(* Compute the pressure in each register class *)
let pressure = Array.create Proc.num_register_classes 0 in
let pressure = Array.make Proc.num_register_classes 0 in
Reg.Set.iter
(fun r ->
if Reg.Set.mem r spilled then () else begin

2
asmcomp/split.ml
View File

@ -30,7 +30,7 @@ let subst_regs rv sub =
None -> rv
| Some s ->
let n = Array.length rv in
let nv = Array.create n Reg.dummy in
let nv = Array.make n Reg.dummy in
for i = 0 to n-1 do nv.(i) <- subst_reg rv.(i) s done;
nv

21
asmrun/.depend
View File

@ -98,7 +98,7 @@ hash.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
../byterun/minor_gc.h ../byterun/hash.h
intern.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
@ -111,7 +111,7 @@ ints.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
../byterun/misc.h ../byterun/mlvalues.h
io.o: io.c ../byterun/config.h ../byterun/../config/m.h \
../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
@ -227,8 +227,7 @@ startup.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \
../byterun/printexc.h stack.h ../byterun/sys.h
str.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
../byterun/int64_native.h
../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h
sys.o: sys.c ../byterun/config.h ../byterun/../config/m.h \
../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
@ -350,7 +349,7 @@ hash.d.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
../byterun/minor_gc.h ../byterun/hash.h
intern.d.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
@ -363,7 +362,7 @@ ints.d.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
../byterun/misc.h ../byterun/mlvalues.h
io.d.o: io.c ../byterun/config.h ../byterun/../config/m.h \
../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
@ -479,8 +478,7 @@ startup.d.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \
../byterun/printexc.h stack.h ../byterun/sys.h
str.d.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
../byterun/int64_native.h
../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h
sys.d.o: sys.c ../byterun/config.h ../byterun/../config/m.h \
../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \
@ -602,7 +600,7 @@ hash.p.o: hash.c ../byterun/mlvalues.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/misc.h \
../byterun/custom.h ../byterun/mlvalues.h ../byterun/memory.h \
../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
../byterun/minor_gc.h ../byterun/hash.h ../byterun/int64_native.h
../byterun/minor_gc.h ../byterun/hash.h
intern.p.o: intern.c ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \
../byterun/mlvalues.h ../byterun/callback.h ../byterun/custom.h \
@ -615,7 +613,7 @@ ints.p.o: ints.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/custom.h ../byterun/fail.h ../byterun/intext.h \
../byterun/io.h ../byterun/memory.h ../byterun/gc.h \
../byterun/major_gc.h ../byterun/freelist.h ../byterun/minor_gc.h \
../byterun/misc.h ../byterun/mlvalues.h ../byterun/int64_native.h
../byterun/misc.h ../byterun/mlvalues.h
io.p.o: io.c ../byterun/config.h ../byterun/../config/m.h \
../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/mlvalues.h ../byterun/custom.h \
@ -731,8 +729,7 @@ startup.p.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \
../byterun/printexc.h stack.h ../byterun/sys.h
str.p.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h \
../byterun/int64_native.h
../byterun/fail.h ../byterun/mlvalues.h ../byterun/misc.h
sys.p.o: sys.c ../byterun/config.h ../byterun/../config/m.h \
../byterun/../config/s.h ../byterun/alloc.h ../byterun/misc.h \
../byterun/config.h ../byterun/mlvalues.h ../byterun/debugger.h \

9
asmrun/arm.S
View File

@ -44,6 +44,15 @@
cmp \reg, #0
beq \lbl
.endm
#elif defined(SYS_freebsd)
.arch armv6
.arm
/* Compatibility macros */
.macro cbz reg, lbl
cmp \reg, #0
beq \lbl
.endm
#endif
trap_ptr .req r8

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamldep
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

10
bytecomp/bytegen.ml
View File

@ -717,8 +717,8 @@ let rec comp_expr env exp sz cont =
(* Build indirection vectors *)
let store = Storer.mk_store () in
let act_consts = Array.create sw.sw_numconsts 0
and act_blocks = Array.create sw.sw_numblocks 0 in
let act_consts = Array.make sw.sw_numconsts 0
and act_blocks = Array.make sw.sw_numblocks 0 in
begin match sw.sw_failaction with (* default is index 0 *)
| Some fail -> ignore (store.act_store fail)
| None -> ()
@ -740,7 +740,7 @@ let rec comp_expr env exp sz cont =
| _ -> ())
a ;
*)
let lbls = Array.create (Array.length acts) 0 in
let lbls = Array.make (Array.length acts) 0 in
for i = Array.length acts-1 downto 0 do
let lbl,c1 = label_code (comp_expr env acts.(i) sz (branch :: !c)) in
lbls.(i) <- lbl ;
@ -748,11 +748,11 @@ let rec comp_expr env exp sz cont =
done ;
(* Build label vectors *)
let lbl_blocks = Array.create sw.sw_numblocks 0 in
let lbl_blocks = Array.make sw.sw_numblocks 0 in
for i = sw.sw_numblocks - 1 downto 0 do
lbl_blocks.(i) <- lbls.(act_blocks.(i))
done;
let lbl_consts = Array.create sw.sw_numconsts 0 in
let lbl_consts = Array.make sw.sw_numconsts 0 in
for i = sw.sw_numconsts - 1 downto 0 do
lbl_consts.(i) <- lbls.(act_consts.(i))
done;

9
bytecomp/emitcode.ml
View File

@ -82,7 +82,7 @@ let label_table = ref ([| |] : label_definition array)
let extend_label_table needed =
let new_size = ref(Array.length !label_table) in
while needed >= !new_size do new_size := 2 * !new_size done;
let new_table = Array.create !new_size (Label_undefined []) in
let new_table = Array.make !new_size (Label_undefined []) in
Array.blit !label_table 0 new_table 0 (Array.length !label_table);
label_table := new_table
@ -150,7 +150,7 @@ let record_event ev =
let init () =
out_position := 0;
label_table := Array.create 16 (Label_undefined []);
label_table := Array.make 16 (Label_undefined []);
reloc_info := [];
debug_dirs := StringSet.empty;
events := []
@ -360,7 +360,7 @@ let rec emit = function
(* Emission to a file *)
let to_file outchan unit_name code =
let to_file outchan unit_name objfile code =
init();
output_string outchan cmo_magic_number;
let pos_depl = pos_out outchan in
@ -370,6 +370,9 @@ let to_file outchan unit_name code =
LongString.output outchan !out_buffer 0 !out_position;
let (pos_debug, size_debug) =
if !Clflags.debug then begin
debug_dirs := StringSet.add
(Filename.dirname (Location.absolute_path objfile))
!debug_dirs;
let p = pos_out outchan in
output_value outchan !events;
output_value outchan (StringSet.elements !debug_dirs);

3
bytecomp/emitcode.mli
View File

@ -15,10 +15,11 @@
open Cmo_format
open Instruct
val to_file: out_channel -> string -> instruction list -> unit
val to_file: out_channel -> string -> string -> instruction list -> unit
(* Arguments:
channel on output file
name of compilation unit implemented
path of cmo file being written
list of instructions to emit *)
val to_memory: instruction list -> instruction list ->
bytes * int * (reloc_info * int) list

1
bytecomp/lambda.ml
View File

@ -548,4 +548,3 @@ let lam_of_loc kind loc =
let reset () =
raise_count := 0

7
bytecomp/lambda.mli
View File

@ -247,9 +247,10 @@ val negate_comparison : comparison -> comparison
(* Get a new static failure ident *)
val next_raise_count : unit -> int
val next_negative_raise_count : unit -> int
(* Negative raise counts are used to compile 'match ... with exception x -> ...'.
This disabled some simplifications performed by the Simplif module that assume
that static raises are in tail position in their handler. *)
(* Negative raise counts are used to compile 'match ... with
exception x -> ...'. This disabled some simplifications
performed by the Simplif module that assume that static raises
are in tail position in their handler. *)
val staticfail : lambda (* Anticipated static failure *)

4
bytecomp/matching.ml
View File

@ -1604,7 +1604,7 @@ let divide_tuple arity p ctx pm =
let record_matching_line num_fields lbl_pat_list =
let patv = Array.create num_fields omega in
let patv = Array.make num_fields omega in
List.iter (fun (_, lbl, pat) -> patv.(lbl.lbl_pos) <- pat) lbl_pat_list;
Array.to_list patv
@ -1892,7 +1892,7 @@ let rec explode_inter offset i j act k =
k
let max_vals cases acts =
let vals = Array.create (Array.length acts) 0 in
let vals = Array.make (Array.length acts) 0 in
for i=Array.length cases-1 downto 0 do
let l,h,act = cases.(i) in
vals.(act) <- h - l + 1 + vals.(act)

18
bytecomp/switch.ml
View File

@ -248,7 +248,7 @@ let case_append c1 c2 =
let l1,h1,act1 = c1.(Array.length c1-1)
and l2,h2,act2 = c2.(0) in
if act1 = act2 then
let r = Array.create (len1+len2-1) c1.(0) in
let r = Array.make (len1+len2-1) c1.(0) in
for i = 0 to len1-2 do
r.(i) <- c1.(i)
done ;
@ -277,7 +277,7 @@ let case_append c1 c2 =
done ;
r
else if h1 > l1 then
let r = Array.create (len1+len2) c1.(0) in
let r = Array.make (len1+len2) c1.(0) in
for i = 0 to len1-2 do
r.(i) <- c1.(i)
done ;
@ -287,7 +287,7 @@ let case_append c1 c2 =
done ;
r
else if h2 > l2 then
let r = Array.create (len1+len2) c1.(0) in
let r = Array.make (len1+len2) c1.(0) in
for i = 0 to len1-1 do
r.(i) <- c1.(i)
done ;
@ -728,8 +728,8 @@ let dense {cases=cases ; actions=actions} i j =
let comp_clusters ({cases=cases ; actions=actions} as s) =
let len = Array.length cases in
let min_clusters = Array.create len max_int
and k = Array.create len 0 in
let min_clusters = Array.make len max_int
and k = Array.make len 0 in
let get_min i = if i < 0 then 0 else min_clusters.(i) in
for i = 0 to len-1 do
@ -749,7 +749,7 @@ let comp_clusters ({cases=cases ; actions=actions} as s) =
let make_switch {cases=cases ; actions=actions} i j =
let ll,_,_ = cases.(i)
and _,hh,_ = cases.(j) in
let tbl = Array.create (hh-ll+1) 0
let tbl = Array.make (hh-ll+1) 0
and t = Hashtbl.create 17
and index = ref 0 in
let get_index act =
@ -769,7 +769,7 @@ let make_switch {cases=cases ; actions=actions} i j =
tbl.(kk) <- index
done
done ;
let acts = Array.create !index actions.(0) in
let acts = Array.make !index actions.(0) in
Hashtbl.iter
(fun act i -> acts.(i) <- actions.(act))
t ;
@ -784,7 +784,7 @@ let make_switch {cases=cases ; actions=actions} i j =
let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
let len = Array.length cases in
let r = Array.create n_clusters (0,0,0)
let r = Array.make n_clusters (0,0,0)
and t = Hashtbl.create 17
and index = ref 0
and bidon = ref (Array.length actions) in
@ -820,7 +820,7 @@ let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
if i > 0 then zyva (i-1) (ir-1) in
zyva (len-1) (n_clusters-1) ;
let acts = Array.create !index (fun _ -> assert false) in
let acts = Array.make !index (fun _ -> assert false) in
Hashtbl.iter (fun _ (i,act) -> acts.(i) <- act) t ;
{cases = r ; actions = acts}
;;

7
bytecomp/symtable.ml
View File

@ -96,7 +96,7 @@ let require_primitive name =
if name.[0] <> '%' then ignore(num_of_prim name)
let all_primitives () =
let prim = Array.create !c_prim_table.num_cnt "" in
let prim = Array.make !c_prim_table.num_cnt "" in
Tbl.iter (fun name number -> prim.(number) <- name) !c_prim_table.num_tbl;
prim
@ -226,7 +226,7 @@ let rec transl_const = function
(* Build the initial table of globals *)
let initial_global_table () =
let glob = Array.create !global_table.num_cnt (Obj.repr 0) in
let glob = Array.make !global_table.num_cnt (Obj.repr 0) in
List.iter
(fun (slot, cst) -> glob.(slot) <- transl_const cst)
!literal_table;
@ -300,7 +300,8 @@ let init_toplevel () =
Dll.init_toplevel dllpath;
(* Recover CRC infos for interfaces *)
let crcintfs =
try (Obj.magic (sect.read_struct "CRCS") : (string * Digest.t option) list)
try
(Obj.magic (sect.read_struct "CRCS") : (string * Digest.t option) list)
with Not_found -> [] in
(* Done *)
sect.close_reader();

2
bytecomp/translclass.ml
View File

@ -145,7 +145,7 @@ let rec build_object_init cl_table obj params inh_init obj_init cl =
| Tcf_val (_, _, id, Tcfk_concrete (_, exp), _) ->
(inh_init, lsequence (set_inst_var obj id exp) obj_init,
has_init)
| Tcf_method _ | Tcf_val _ | Tcf_constraint _ | Tcf_attribute _ ->
| Tcf_method _ | Tcf_val _ | Tcf_constraint _ | Tcf_attribute _->
(inh_init, obj_init, has_init)
| Tcf_initializer _ ->
(inh_init, obj_init, true)

4
bytecomp/translcore.ml
View File

@ -1078,7 +1078,7 @@ and transl_record all_labels repres lbl_expr_list opt_init_expr =
then begin
(* Allocate new record with given fields (and remaining fields
taken from init_expr if any *)
let lv = Array.create (Array.length all_labels) staticfail in
let lv = Array.make (Array.length all_labels) staticfail in
let init_id = Ident.create "init" in
begin match opt_init_expr with
None -> ()
@ -1154,7 +1154,7 @@ and transl_match e arg pat_expr_list exn_pat_expr_list partial =
| {exp_desc = Texp_tuple argl}, _ :: _ ->
let val_ids = List.map (fun _ -> name_pattern "val" []) argl in
let lvars = List.map (fun id -> Lvar id) val_ids in
static_catch (transl_list argl) val_ids
static_catch (transl_list argl) val_ids
(Matching.for_multiple_match e.exp_loc lvars cases partial)
| arg, [] ->
Matching.for_function e.exp_loc None (transl_exp arg) cases partial

15
bytecomp/translmod.ml
View File

@ -145,6 +145,19 @@ let rec compose_coercions c1 c2 =
| (_, _) ->
fatal_error "Translmod.compose_coercions"
(*
let apply_coercion a b c =
Format.eprintf "@[<2>apply_coercion@ %a@]@." Includemod.print_coercion b;
apply_coercion a b c
let compose_coercions c1 c2 =
let c3 = compose_coercions c1 c2 in
let open Includemod in
Format.eprintf "@[<2>compose_coercions@ (%a)@ (%a) =@ %a@]@."
print_coercion c1 print_coercion c2 print_coercion c2;
c3
*)
(* Record the primitive declarations occuring in the module compiled *)
let primitive_declarations = ref ([] : Primitive.description list)
@ -225,7 +238,7 @@ let reorder_rec_bindings bindings =
and rhs = Array.of_list (List.map (fun (_,_,_,rhs) -> rhs) bindings) in
let fv = Array.map Lambda.free_variables rhs in
let num_bindings = Array.length id in
let status = Array.create num_bindings Undefined in
let status = Array.make num_bindings Undefined in
let res = ref [] in
let rec emit_binding i =
match status.(i) with

24
byterun/.depend
View File

@ -7,7 +7,7 @@ array.o: array.c alloc.h compatibility.h misc.h config.h ../config/m.h \
backtrace.o: backtrace.c config.h ../config/m.h ../config/s.h \
compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
startup.h stacks.h sys.h backtrace.h
startup.h stacks.h sys.h backtrace.h fail.h
callback.o: callback.c callback.h compatibility.h mlvalues.h config.h \
../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
@ -55,7 +55,7 @@ globroots.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
roots.h globroots.h
hash.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \
../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
minor_gc.h hash.h int64_native.h
minor_gc.h hash.h
instrtrace.o: instrtrace.c
intern.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
@ -66,7 +66,7 @@ interp.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \
memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h
ints.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
major_gc.h freelist.h minor_gc.h int64_native.h
major_gc.h freelist.h minor_gc.h
io.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
freelist.h minor_gc.h signals.h sys.h
@ -123,7 +123,7 @@ startup.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
version.h
str.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h fail.h int64_native.h
../config/s.h mlvalues.h fail.h
sys.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
@ -147,7 +147,7 @@ array.d.o: array.c alloc.h compatibility.h misc.h config.h ../config/m.h \
backtrace.d.o: backtrace.c config.h ../config/m.h ../config/s.h \
compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
startup.h stacks.h sys.h backtrace.h
startup.h stacks.h sys.h backtrace.h fail.h
callback.d.o: callback.c callback.h compatibility.h mlvalues.h config.h \
../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
@ -195,7 +195,7 @@ globroots.d.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
roots.h globroots.h
hash.d.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \
../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
minor_gc.h hash.h int64_native.h
minor_gc.h hash.h
instrtrace.d.o: instrtrace.c instruct.h misc.h compatibility.h config.h \
../config/m.h ../config/s.h mlvalues.h opnames.h prims.h stacks.h \
memory.h gc.h major_gc.h freelist.h minor_gc.h
@ -208,7 +208,7 @@ interp.d.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \
memory.h gc.h minor_gc.h prims.h signals.h stacks.h
ints.d.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
major_gc.h freelist.h minor_gc.h int64_native.h
major_gc.h freelist.h minor_gc.h
io.d.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
freelist.h minor_gc.h signals.h sys.h
@ -265,7 +265,7 @@ startup.d.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
version.h
str.d.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h fail.h int64_native.h
../config/s.h mlvalues.h fail.h
sys.d.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h
@ -289,7 +289,7 @@ array.pic.o: array.c alloc.h compatibility.h misc.h config.h ../config/m.h \
backtrace.pic.o: backtrace.c config.h ../config/m.h ../config/s.h \
compatibility.h mlvalues.h misc.h alloc.h io.h instruct.h intext.h \
exec.h fix_code.h memory.h gc.h major_gc.h freelist.h minor_gc.h \
startup.h stacks.h sys.h backtrace.h
startup.h stacks.h sys.h backtrace.h fail.h
callback.pic.o: callback.c callback.h compatibility.h mlvalues.h config.h \
../config/m.h ../config/s.h misc.h fail.h memory.h gc.h major_gc.h \
freelist.h minor_gc.h interp.h instruct.h fix_code.h stacks.h
@ -337,7 +337,7 @@ globroots.pic.o: globroots.c memory.h compatibility.h config.h ../config/m.h \
roots.h globroots.h
hash.pic.o: hash.c mlvalues.h compatibility.h config.h ../config/m.h \
../config/s.h misc.h custom.h memory.h gc.h major_gc.h freelist.h \
minor_gc.h hash.h int64_native.h
minor_gc.h hash.h
instrtrace.pic.o: instrtrace.c
intern.pic.o: intern.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h callback.h custom.h fail.h gc.h intext.h io.h \
@ -348,7 +348,7 @@ interp.pic.o: interp.c alloc.h compatibility.h misc.h config.h ../config/m.h \
memory.h gc.h minor_gc.h prims.h signals.h stacks.h jumptbl.h
ints.pic.o: ints.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h custom.h fail.h intext.h io.h memory.h gc.h \
major_gc.h freelist.h minor_gc.h int64_native.h
major_gc.h freelist.h minor_gc.h
io.pic.o: io.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
misc.h mlvalues.h custom.h fail.h io.h memory.h gc.h major_gc.h \
freelist.h minor_gc.h signals.h sys.h
@ -405,7 +405,7 @@ startup.pic.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
version.h
str.pic.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
../config/s.h mlvalues.h fail.h int64_native.h
../config/s.h mlvalues.h fail.h
sys.pic.o: sys.c config.h ../config/m.h ../config/s.h compatibility.h alloc.h \
misc.h mlvalues.h debugger.h fail.h instruct.h osdeps.h signals.h \
stacks.h memory.h gc.h major_gc.h freelist.h minor_gc.h sys.h

3
byterun/backtrace.c
View File

@ -298,7 +298,8 @@ static void read_debug_info(void)
read_debug_info_error = "out of memory";
CAMLreturn0;
}
memcpy(events[j].ev_filename, String_val (Field (ev_start, POS_FNAME)), fnsz);
memcpy(events[j].ev_filename, String_val (Field (ev_start, POS_FNAME)),
fnsz);
events[j].ev_lnum = Int_val (Field (ev_start, POS_LNUM));
events[j].ev_startchr =

2
byterun/intern.c
View File

@ -738,7 +738,7 @@ static char * intern_resolve_code_pointer(unsigned char digest[16],
static void intern_bad_code_pointer(unsigned char digest[16])
{
char msg[256];
snprintf(msg, sizeof(msg),
snprintf(msg, sizeof(msg),
"input_value: unknown code module "
"%02X%02X%02X%02X%02X%02X%02X%02X"
"%02X%02X%02X%02X%02X%02X%02X%02X",

2
byterun/ints.c
View File

@ -479,7 +479,7 @@ CAMLprim value caml_int64_bswap(value v)
((x & 0x000000FF00000000ULL) >> 8) |
((x & 0x0000FF0000000000ULL) >> 24) |
((x & 0x00FF000000000000ULL) >> 40) |
((x & 0xFF00000000000000ULL) >> 56));
((x & 0xFF00000000000000ULL) >> 56));
}
CAMLprim value caml_int64_of_int(value v)

3
byterun/printexc.c
View File

@ -131,7 +131,8 @@ void caml_fatal_uncaught_exception(value exn)
{
value *handle_uncaught_exception;
handle_uncaught_exception = caml_named_value("Printexc.handle_uncaught_exception");
handle_uncaught_exception =
caml_named_value("Printexc.handle_uncaught_exception");
if (handle_uncaught_exception != NULL)
/* [Printexc.handle_uncaught_exception] does not raise exception. */
caml_callback2(*handle_uncaught_exception, exn, Val_bool(DEBUGGER_IN_USE));

4
byterun/str.c
View File

@ -308,7 +308,7 @@ CAMLexport value caml_alloc_sprintf(const char * format, ...)
/* C99-compliant implementation */
va_start(args, format);
/* "vsnprintf(dest, sz, format, args)" writes at most "sz" characters
into "dest", including the terminating '\0'.
into "dest", including the terminating '\0'.
It returns the number of characters of the formatted string,
excluding the terminating '\0'. */
n = vsnprintf(buf, sizeof(buf), format, args);
@ -316,7 +316,7 @@ CAMLexport value caml_alloc_sprintf(const char * format, ...)
/* Allocate a Caml string with length "n" as computed by vsnprintf. */
res = caml_alloc_string(n);
if (n < sizeof(buf)) {
/* All output characters were written to buf, including the
/* All output characters were written to buf, including the
terminating '\0'. Just copy them to the result. */
memcpy(String_val(res), buf, n);
} else {

2
byterun/win32.c
View File

@ -103,7 +103,7 @@ CAMLexport char * caml_search_exe_in_path(char * name)
caml_stat_free(fullname);
return caml_strdup(name);
}
if (retcode < fullnamelen)
if (retcode < fullnamelen)
return fullname;
caml_stat_free(fullname);
fullnamelen = retcode + 1;

2
config/Makefile.mingw
View File

@ -109,7 +109,7 @@ NATIVECCLIBS=-lws2_32
CPP=$(BYTECC) -E
### Flexlink
FLEXLINK=flexlink -chain mingw -stack 16777216
FLEXLINK=flexlink -chain mingw -stack 16777216 -link -static-libgcc
FLEXDIR=$(shell $(FLEXLINK) -where)
IFLEXDIR=-I"$(FLEXDIR)"
MKDLL=$(FLEXLINK)

4
configure vendored
View File

@ -768,6 +768,7 @@ if test $with_sharedlibs = "yes"; then
x86_64-*-netbsd*) natdynlink=true;;
i386-*-gnu0.3) natdynlink=true;;
arm*-*-linux*) natdynlink=true;;
arm*-*-freebsd*) natdynlink=true;;
aarch64-*-linux*) natdynlink=true;;
esac
fi
@ -818,6 +819,7 @@ case "$target" in
armv7*-*-linux-gnueabi) arch=arm; model=armv7; system=linux_eabi;;
armv6t2*-*-linux-gnueabi) arch=arm; model=armv6t2; system=linux_eabi;;
armv6*-*-linux-gnueabi) arch=arm; model=armv6; system=linux_eabi;;
armv6*-*-freebsd*) arch=arm; model=armv6; system=freebsd;;
armv5te*-*-linux-gnueabi) arch=arm; model=armv5te; system=linux_eabi;;
armv5*-*-linux-gnueabi) arch=arm; model=armv5; system=linux_eabi;;
arm*-*-linux-gnueabi) arch=arm; system=linux_eabi;;
@ -893,6 +895,8 @@ case "$arch,$system" in
*gcc*) aspp="${TOOLPREF}gcc -c";;
*) aspp="${TOOLPREF}as -P";;
esac;;
arm,freebsd) as="${TOOLPREF}cc -c"
aspp="${TOOLPREF}cc -c";;
*,freebsd) as="${TOOLPREF}as"
aspp="${TOOLPREF}cc -c";;
amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*)

2
debugger/main.ml
View File

@ -193,7 +193,7 @@ let main () =
(Unix.string_of_inet_addr Unix.inet_addr_loopback)^
":"^
(string_of_int (10000 + ((Unix.getpid ()) mod 10000)))
| _ -> Filename.concat Filename.temp_dir_name
| _ -> Filename.concat (Filename.get_temp_dir_name ())
("camldebug" ^ (string_of_int (Unix.getpid ())))
);
begin try

2
driver/compile.ml
View File

@ -92,7 +92,7 @@ let implementation ppf sourcefile outputprefix =
++ 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;
++ Emitcode.to_file oc modulename objfile;
Warnings.check_fatal ();
close_out oc;
Stypes.dump (Some (outputprefix ^ ".annot"))

3
driver/main_args.ml
View File

@ -161,7 +161,8 @@ let mk_no_app_funct f =
;;
let mk_no_float_const_prop f =
"-no-float-const-prop", Arg.Unit f, " Deactivate constant propagation for floating-point operations"
"-no-float-const-prop", Arg.Unit f,
" Deactivate constant propagation for floating-point operations"
;;
let mk_noassert f =

149
experimental/doligez/check-bounds.diff Normal file
View File

@ -0,0 +1,149 @@
Patch taken from:
https://github.com/mshinwell/ocaml/commits/4.02-block-bounds
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 01eff9c..b498b58 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -22,6 +22,13 @@ open Clambda
open Cmm
open Cmx_format
+let do_check_field_access = true
+(*
+ match try Some (Sys.getenv "BOUNDS") with Not_found -> None with
+ | None | Some "" -> false
+ | Some _ -> true
+*)
+
(* Local binding of complex expressions *)
let bind name arg fn =
@@ -494,6 +501,35 @@ let get_tag ptr =
let get_size ptr =
Cop(Clsr, [header ptr; Cconst_int 10])
+(* Bounds checks upon field access, for debugging the compiler *)
+
+let check_field_access ptr field_index if_success =
+ if not do_check_field_access then
+ if_success
+ else
+ let field_index = Cconst_int field_index in
+ (* If [ptr] points at an infix header, we need to move it back to the "main"
+ [Closure_tag] header. *)
+ let ptr =
+ Cifthenelse (Cop (Ccmpi Cne, [get_tag ptr; Cconst_int Obj.infix_tag]),
+ ptr,
+ Cop (Csuba, [ptr;
+ Cop (Cmuli, [get_size ptr (* == Infix_offset_val(ptr) *);
+ Cconst_int size_addr])]))
+ in
+ let not_too_small = Cop (Ccmpi Cge, [field_index; Cconst_int 0]) in
+ let not_too_big = Cop (Ccmpi Clt, [field_index; get_size ptr]) in
+ let failure =
+ Cop (Cextcall ("caml_field_access_out_of_bounds_error", typ_addr, false,
+ Debuginfo.none),
+ [ptr; field_index])
+ in
+ Cifthenelse (not_too_small,
+ Cifthenelse (not_too_big,
+ if_success,
+ failure),
+ failure)
+
(* Array indexing *)
let log2_size_addr = Misc.log2 size_addr
@@ -1550,13 +1586,18 @@ and transl_prim_1 p arg dbg =
return_unit(remove_unit (transl arg))
(* Heap operations *)
| Pfield n ->
- get_field (transl arg) n
+ let ptr = transl arg in
+ let body = get_field ptr n in
+ check_field_access ptr n body
| Pfloatfield n ->
let ptr = transl arg in
- box_float(
- Cop(Cload Double_u,
- [if n = 0 then ptr
- else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
+ let body =
+ box_float(
+ Cop(Cload Double_u,
+ [if n = 0 then ptr
+ else Cop(Cadda, [ptr; Cconst_int(n * size_float)])]))
+ in
+ check_field_access ptr n body
| Pint_as_pointer ->
Cop(Cadda, [transl arg; Cconst_int (-1)])
(* Exceptions *)
@@ -1649,20 +1690,25 @@ and transl_prim_1 p arg dbg =
and transl_prim_2 p arg1 arg2 dbg =
match p with
(* Heap operations *)
- Psetfield(n, ptr) ->
- if ptr then
- return_unit(Cop(Cextcall("caml_modify", typ_void, false,Debuginfo.none),
- [field_address (transl arg1) n; transl arg2]))
- else
- return_unit(set_field (transl arg1) n (transl arg2))
+ Psetfield(n, is_ptr) ->
+ let ptr = transl arg1 in
+ let body =
+ if is_ptr then
+ Cop(Cextcall("caml_modify", typ_void, false,Debuginfo.none),
+ [field_address ptr n; transl arg2])
+ else
+ set_field ptr n (transl arg2)
+ in
+ check_field_access ptr n (return_unit body)
| Psetfloatfield n ->
let ptr = transl arg1 in
- return_unit(
+ let body =
Cop(Cstore Double_u,
[if n = 0 then ptr
else Cop(Cadda, [ptr; Cconst_int(n * size_float)]);
- transl_unbox_float arg2]))
-
+ transl_unbox_float arg2])
+ in
+ check_field_access ptr n (return_unit body)
(* Boolean operations *)
| Psequand ->
Cifthenelse(test_bool(transl arg1), transl arg2, Cconst_int 1)
diff --git a/asmrun/fail.c b/asmrun/fail.c
index cb2c1cb..4f67c74 100644
--- a/asmrun/fail.c
+++ b/asmrun/fail.c
@@ -15,6 +15,7 @@
#include <stdio.h>
#include <signal.h>
+#include <assert.h>
#include "alloc.h"
#include "fail.h"
#include "io.h"
@@ -180,3 +181,20 @@ int caml_is_special_exception(value exn) {
|| exn == (value) caml_exn_Assert_failure
|| exn == (value) caml_exn_Undefined_recursive_module;
}
+
+void caml_field_access_out_of_bounds_error(value v_block, intnat index)
+{
+ assert(Is_block(v_block));
+ fprintf(stderr, "Fatal error: out-of-bounds access to field %ld ", index);
+ fprintf(stderr, "of block at %p (%s, size %ld, tag %d)\n",
+ (void*) v_block,
+ Is_young(v_block) ? "in minor heap"
+ : Is_in_heap(v_block) ? "in major heap"
+ : Is_in_value_area(v_block) ? "in static data"
+ : "out-of-heap",
+ (long) Wosize_val(v_block), (int) Tag_val(v_block));
+ fflush(stderr);
+ /* This error may have occurred in places where it is not reasonable to
+ attempt to continue. */
+ abort();
+}

28
lex/compact.ml
View File

@ -92,13 +92,13 @@ type t_compact =
mutable c_last_used : int ; }
let create_compact () =
{ c_trans = Array.create 1024 0 ;
c_check = Array.create 1024 (-1) ;
{ c_trans = Array.make 1024 0 ;
c_check = Array.make 1024 (-1) ;
c_last_used = 0 ; }
let reset_compact c =
c.c_trans <- Array.create 1024 0 ;
c.c_check <- Array.create 1024 (-1) ;
c.c_trans <- Array.make 1024 0 ;
c.c_check <- Array.make 1024 (-1) ;
c.c_last_used <- 0
(* One compacted table for transitions, one other for memory actions *)
@ -110,9 +110,9 @@ let grow_compact c =
let old_trans = c.c_trans
and old_check = c.c_check in
let n = Array.length old_trans in
c.c_trans <- Array.create (2*n) 0;
c.c_trans <- Array.make (2*n) 0;
Array.blit old_trans 0 c.c_trans 0 c.c_last_used;
c.c_check <- Array.create (2*n) (-1);
c.c_check <- Array.make (2*n) (-1);
Array.blit old_check 0 c.c_check 0 c.c_last_used
let do_pack state_num orig compact =
@ -142,8 +142,8 @@ let do_pack state_num orig compact =
(base, default)
let pack_moves state_num move_t =
let move_v = Array.create 257 0
and move_m = Array.create 257 0 in
let move_v = Array.make 257 0
and move_m = Array.make 257 0 in
for i = 0 to 256 do
let act,c = move_t.(i) in
move_v.(i) <- (match act with Backtrack -> -1 | Goto n -> n) ;
@ -175,12 +175,12 @@ type lex_tables =
let compact_tables state_v =
let n = Array.length state_v in
let base = Array.create n 0
and backtrk = Array.create n (-1)
and default = Array.create n 0
and base_code = Array.create n 0
and backtrk_code = Array.create n 0
and default_code = Array.create n 0 in
let base = Array.make n 0
and backtrk = Array.make n (-1)
and default = Array.make n 0
and base_code = Array.make n 0
and backtrk_code = Array.make n 0
and default_code = Array.make n 0 in
for i = 0 to n - 1 do
match state_v.(i) with
| Perform (n,c) ->

2
lex/cset.ml
View File

@ -81,7 +81,7 @@ let complement s = diff all_chars s
let env_to_array env = match env with
| [] -> assert false
| (_,x)::rem ->
let res = Array.create 257 x in
let res = Array.make 257 x in
List.iter
(fun (c,y) ->
List.iter

6
lex/lexgen.ml
View File

@ -589,7 +589,7 @@ let rec firstpos = function
(* Berry-sethi followpos *)
let followpos size entry_list =
let v = Array.create size TransSet.empty in
let v = Array.make size TransSet.empty in
let rec fill s = function
| Empty|Action _|Tag _ -> ()
| Chars (n,_) -> v.(n) <- s
@ -1132,7 +1132,7 @@ let make_tag_entry id start act a r = match a with
| _ -> r
let extract_tags l =
let envs = Array.create (List.length l) TagMap.empty in
let envs = Array.make (List.length l) TagMap.empty in
List.iter
(fun (act,m,_) ->
envs.(act) <-
@ -1186,7 +1186,7 @@ let make_dfa lexdef =
done ;
eprintf "%d states\n" !next_state_num ;
*)
let actions = Array.create !next_state_num (Perform (0,[])) in
let actions = Array.make !next_state_num (Perform (0,[])) in
List.iter (fun (act, i) -> actions.(i) <- act) states;
(* Useless state reset, so as to restrict GC roots *)
reset_state () ;

2
lex/output.ml
View File

@ -77,7 +77,7 @@ let output_entry sourcefile ic oc has_refill oci e =
output_args e.auto_args
(fun oc x ->
if x > 0 then
fprintf oc "lexbuf.Lexing.lex_mem <- Array.create %d (-1) ; " x)
fprintf oc "lexbuf.Lexing.lex_mem <- Array.make %d (-1) ; " x)
e.auto_mem_size
(output_memory_actions " ") init_moves
e.auto_name

2
lex/outputbis.ml
View File

@ -20,7 +20,7 @@ let output_auto_defs oc has_refill =
output_string oc
"let __ocaml_lex_init_lexbuf lexbuf mem_size =\
\n let pos = lexbuf.Lexing.lex_curr_pos in\
\n lexbuf.Lexing.lex_mem <- Array.create mem_size (-1) ;\
\n lexbuf.Lexing.lex_mem <- Array.make mem_size (-1) ;\
\n lexbuf.Lexing.lex_start_pos <- pos ;\
\n lexbuf.Lexing.lex_last_pos <- pos ;\
\n lexbuf.Lexing.lex_last_action <- -1\

4
lex/table.ml
View File

@ -15,12 +15,12 @@ type 'a t = {mutable next : int ; mutable data : 'a array}
let default_size = 32
;;
let create x = {next = 0 ; data = Array.create default_size x}
let create x = {next = 0 ; data = Array.make default_size x}
and reset t = t.next <- 0
;;
let incr_table table new_size =
let t = Array.create new_size table.data.(0) in
let t = Array.make new_size table.data.(0) in
Array.blit table.data 0 t 0 (Array.length table.data) ;
table.data <- t

6
man/ocamldoc.m
View File

@ -181,7 +181,7 @@ Several
.B -load
options can be given.
.TP
.BI \-m flags
.BI \-m \ flags
Specify merge options between interfaces and implementations.
.I flags
can be one or several of the following characters:
@ -442,11 +442,11 @@ option:
Generate man pages only for modules, module types, classes and class types,
instead of pages for all elements.
.TP
.BI \-man\-suffix suffix
.BI \-man\-suffix \ suffix
Set the suffix used for generated man filenames. Default is o, as in
.IR List.o .
.TP
.BI \-man\-section section
.BI \-man\-section \ section
Set the section number used for generated man filenames. Default is 3.

12
man/ocamlopt.m
View File

@ -682,17 +682,13 @@ Disable Thumb/Thumb-2 code generation
.P
The default values for target architecture, floating-point hardware
and thumb usage were selected at configure-time when building
.BR ocamlopt
itself. This configuration can be inspected using
.BR ocamlopt
.BR \-config .
.B ocamlopt
itself. This configuration can be inspected using
.BR ocamlopt\ \-config .
Target architecture depends on the "model" setting, while
floating-point hardware and thumb support are determined from the ABI
setting in "system" (
.BR linux_eabi
or
.BR linux_eabihf
).
.BR linux_eabi or linux_eabihf ).
.SH SEE ALSO
.BR ocamlc (1).

55
ocamlbuild/.depend
View File

@ -1,6 +1,6 @@
bool.cmi :
command.cmi : tags.cmi signatures.cmi
configuration.cmi : tags.cmi pathname.cmi
configuration.cmi : tags.cmi pathname.cmi loc.cmi
digest_cache.cmi :
discard_printf.cmi :
display.cmi : tags.cmi
@ -27,10 +27,10 @@ ocaml_tools.cmi : tags.cmi rule.cmi pathname.cmi command.cmi
ocaml_utils.cmi : tags.cmi pathname.cmi command.cmi
ocamlbuild.cmi :
ocamlbuild_executor.cmi :
ocamlbuild_plugin.cmi : ocamlbuild_pack.cmi
ocamlbuild_unix_plugin.cmi : ocamlbuild_pack.cmi
ocamlbuild_plugin.cmi :
ocamlbuild_unix_plugin.cmi :
ocamlbuild_where.cmi :
ocamlbuildlight.cmi : ocamlbuild_pack.cmi
ocamlbuildlight.cmi :
options.cmi : slurp.cmi signatures.cmi command.cmi
param_tags.cmi : tags.cmi loc.cmi
pathname.cmi : signatures.cmi
@ -48,13 +48,15 @@ tools.cmi : tags.cmi pathname.cmi
bool.cmo : bool.cmi
bool.cmx : bool.cmi
command.cmo : tags.cmi shell.cmi param_tags.cmi my_unix.cmi my_std.cmi \
log.cmi lexers.cmi command.cmi
log.cmi lexers.cmi const.cmo command.cmi
command.cmx : tags.cmx shell.cmx param_tags.cmx my_unix.cmx my_std.cmx \
log.cmx lexers.cmx command.cmi
log.cmx lexers.cmx const.cmx command.cmi
configuration.cmo : tags.cmi param_tags.cmi my_std.cmi log.cmi loc.cmi \
lexers.cmi glob.cmi configuration.cmi
lexers.cmi glob.cmi const.cmo configuration.cmi
configuration.cmx : tags.cmx param_tags.cmx my_std.cmx log.cmx loc.cmx \
lexers.cmx glob.cmx configuration.cmi
lexers.cmx glob.cmx const.cmx configuration.cmi
const.cmo :
const.cmx :
digest_cache.cmo : shell.cmi pathname.cmi options.cmi my_unix.cmi my_std.cmi \
digest_cache.cmi
digest_cache.cmx : shell.cmx pathname.cmx options.cmx my_unix.cmx my_std.cmx \
@ -67,8 +69,10 @@ exit_codes.cmo : exit_codes.cmi
exit_codes.cmx : exit_codes.cmi
fda.cmo : pathname.cmi options.cmi log.cmi hygiene.cmi fda.cmi
fda.cmx : pathname.cmx options.cmx log.cmx hygiene.cmx fda.cmi
findlib.cmo : my_unix.cmi my_std.cmi lexers.cmi command.cmi findlib.cmi
findlib.cmx : my_unix.cmx my_std.cmx lexers.cmx command.cmx findlib.cmi
findlib.cmo : my_unix.cmi my_std.cmi lexers.cmi const.cmo command.cmi \
findlib.cmi
findlib.cmx : my_unix.cmx my_std.cmx lexers.cmx const.cmx command.cmx \
findlib.cmi
flags.cmo : tags.cmi param_tags.cmi log.cmi command.cmi bool.cmi flags.cmi
flags.cmx : tags.cmx param_tags.cmx log.cmx command.cmx bool.cmx flags.cmi
glob.cmo : my_std.cmi glob_lexer.cmi glob_ast.cmi bool.cmi glob.cmi
@ -93,14 +97,14 @@ main.cmo : tools.cmi tags.cmi solver.cmi slurp.cmi shell.cmi rule.cmi \
resource.cmi report.cmi plugin.cmi pathname.cmi param_tags.cmi \
options.cmi ocaml_utils.cmi ocaml_specific.cmi ocaml_dependencies.cmi \
my_unix.cmi my_std.cmi log.cmi loc.cmi lexers.cmi hooks.cmi flags.cmi \
fda.cmi exit_codes.cmi digest_cache.cmi configuration.cmi command.cmi \
main.cmi
fda.cmi exit_codes.cmi digest_cache.cmi const.cmo configuration.cmi \
command.cmi main.cmi
main.cmx : tools.cmx tags.cmx solver.cmx slurp.cmx shell.cmx rule.cmx \
resource.cmx report.cmx plugin.cmx pathname.cmx param_tags.cmx \
options.cmx ocaml_utils.cmx ocaml_specific.cmx ocaml_dependencies.cmx \
my_unix.cmx my_std.cmx log.cmx loc.cmx lexers.cmx hooks.cmx flags.cmx \
fda.cmx exit_codes.cmx digest_cache.cmx configuration.cmx command.cmx \
main.cmi
fda.cmx exit_codes.cmx digest_cache.cmx const.cmx configuration.cmx \
command.cmx main.cmi
my_std.cmo : my_std.cmi
my_std.cmx : my_std.cmi
my_unix.cmo : my_std.cmi my_unix.cmi
@ -132,18 +136,19 @@ ocaml_tools.cmx : tools.cmx tags.cmx rule.cmx pathname.cmx options.cmx \
ocaml_utils.cmx ocaml_compiler.cmx my_std.cmx flags.cmx command.cmx \
ocaml_tools.cmi
ocaml_utils.cmo : tools.cmi tags.cmi pathname.cmi param_tags.cmi options.cmi \
my_std.cmi log.cmi lexers.cmi flags.cmi command.cmi ocaml_utils.cmi
my_std.cmi log.cmi lexers.cmi flags.cmi const.cmo command.cmi \
ocaml_utils.cmi
ocaml_utils.cmx : tools.cmx tags.cmx pathname.cmx param_tags.cmx options.cmx \
my_std.cmx log.cmx lexers.cmx flags.cmx command.cmx ocaml_utils.cmi
my_std.cmx log.cmx lexers.cmx flags.cmx const.cmx command.cmx \
ocaml_utils.cmi
ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi
ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi
ocamlbuild_config.cmo :
ocamlbuild_config.cmx :
ocamlbuild_executor.cmo : ocamlbuild_executor.cmi
ocamlbuild_executor.cmx : ocamlbuild_executor.cmi
ocamlbuild_pack.cmo : ocamlbuild_pack.cmi
ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi ocamlbuild_pack.cmo
ocamlbuild_plugin.cmx : ocamlbuild_plugin.cmi ocamlbuild_pack.cmx
ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi
ocamlbuild_plugin.cmx : ocamlbuild_plugin.cmi
ocamlbuild_unix_plugin.cmo : ocamlbuild_executor.cmi my_unix.cmi my_std.cmi \
exit_codes.cmi ocamlbuild_unix_plugin.cmi
ocamlbuild_unix_plugin.cmx : ocamlbuild_executor.cmx my_unix.cmx my_std.cmx \
@ -153,9 +158,9 @@ ocamlbuild_where.cmx : ocamlbuild_config.cmx ocamlbuild_where.cmi
ocamlbuildlight.cmo : ocamlbuildlight.cmi
ocamlbuildlight.cmx : ocamlbuildlight.cmi
options.cmo : shell.cmi ocamlbuild_where.cmi ocamlbuild_config.cmo \
my_std.cmi log.cmi lexers.cmi command.cmi options.cmi
my_std.cmi log.cmi lexers.cmi const.cmo command.cmi options.cmi
options.cmx : shell.cmx ocamlbuild_where.cmx ocamlbuild_config.cmx \
my_std.cmx log.cmx lexers.cmx command.cmx options.cmi
my_std.cmx log.cmx lexers.cmx const.cmx command.cmx options.cmi
param_tags.cmo : tags.cmi my_std.cmi log.cmi loc.cmi lexers.cmi \
param_tags.cmi
param_tags.cmx : tags.cmx my_std.cmx log.cmx loc.cmx lexers.cmx \
@ -166,10 +171,10 @@ pathname.cmx : shell.cmx options.cmx my_unix.cmx my_std.cmx log.cmx glob.cmx \
pathname.cmi
plugin.cmo : tools.cmi tags.cmi shell.cmi rule.cmi pathname.cmi \
param_tags.cmi options.cmi ocamlbuild_where.cmi my_unix.cmi my_std.cmi \
log.cmi command.cmi plugin.cmi
log.cmi const.cmo command.cmi plugin.cmi
plugin.cmx : tools.cmx tags.cmx shell.cmx rule.cmx pathname.cmx \
param_tags.cmx options.cmx ocamlbuild_where.cmx my_unix.cmx my_std.cmx \
log.cmx command.cmx plugin.cmi
log.cmx const.cmx command.cmx plugin.cmi
ppcache.cmo : shell.cmi pathname.cmi my_std.cmi log.cmi command.cmi \
ppcache.cmi
ppcache.cmx : shell.cmx pathname.cmx my_std.cmx log.cmx command.cmx \
@ -178,10 +183,10 @@ report.cmo : solver.cmi resource.cmi my_std.cmi log.cmi glob.cmi report.cmi
report.cmx : solver.cmx resource.cmx my_std.cmx log.cmx glob.cmx report.cmi
resource.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_unix.cmi \
my_std.cmi log.cmi lexers.cmi glob_ast.cmi glob.cmi digest_cache.cmi \
command.cmi resource.cmi
const.cmo command.cmi resource.cmi
resource.cmx : slurp.cmx shell.cmx pathname.cmx options.cmx my_unix.cmx \
my_std.cmx log.cmx lexers.cmx glob_ast.cmx glob.cmx digest_cache.cmx \
command.cmx resource.cmi
const.cmx command.cmx resource.cmi
rule.cmo : shell.cmi resource.cmi pathname.cmi options.cmi my_std.cmi \
log.cmi digest_cache.cmi command.cmi rule.cmi
rule.cmx : shell.cmx resource.cmx pathname.cmx options.cmx my_std.cmx \

1
ocamlbuild/Makefile
View File

@ -23,6 +23,7 @@ COMPFLAGS= -warn-error A -w L -w R -w Z -I ../otherlibs/$(UNIXLIB) -safe-string
LINKFLAGS= -I ../otherlibs/$(UNIXLIB)
PACK_CMO=\
const.cmo \
loc.cmo \
discard_printf.cmo \
signatures.cmi \

5
ocamlbuild/command.ml
View File

@ -99,10 +99,7 @@ let env_path = lazy begin
Lexers.parse_environment_path
in
let paths =
try
parse_path (Lexing.from_string path_var)
with Lexers.Error (msg,pos) -> raise (Lexers.Error ("$PATH: " ^ msg, pos))
in
parse_path Const.Source.path (Lexing.from_string path_var) in
let norm_current_dir_name path =
if path = "" then Filename.current_dir_name else path
in

26
ocamlbuild/configuration.ml
View File

@ -18,31 +18,35 @@ open Lexers
type t = Lexers.conf
let acknowledge_config config =
let ack (tag, loc) = Param_tags.acknowledge (Some loc) tag in
let acknowledge_config source config =
let ack (tag, loc) = Param_tags.acknowledge source (Some loc) tag in
List.iter (fun (_, config) -> List.iter ack config.plus_tags) config
let cache = Hashtbl.create 107
let (configs, add_config) =
let configs = ref [] in
(fun () -> !configs),
(fun config ->
acknowledge_config config;
(fun source config ->
acknowledge_config source config;
configs := config :: !configs;
Hashtbl.clear cache)
let parse_lexbuf ?dir source lexbuf =
lexbuf.Lexing.lex_curr_p <-
{ lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = source };
let conf = Lexers.conf_lines dir lexbuf in
add_config conf
let conf = Lexers.conf_lines dir source lexbuf in
add_config source conf
let parse_string s =
parse_lexbuf (Printf.sprintf "STRING(%s)" s) (Lexing.from_string s)
let parse_string ?source s =
let source = match source with
| Some source -> source
| None -> Const.Source.configuration
in
parse_lexbuf source (lexbuf_of_string s)
let parse_file ?dir file =
with_input_file file begin fun ic ->
parse_lexbuf ?dir file (Lexing.from_channel ic)
let lexbuf = Lexing.from_channel ic in
set_lexbuf_fname file lexbuf;
parse_lexbuf ?dir Const.Source.file lexbuf
end
let key_match = Glob.eval

2
ocamlbuild/configuration.mli
View File

@ -18,7 +18,7 @@
(** Incorporate a newline-separated configuration string into the current configuration.
Will usually raising an [Invalid_arg] with an appropriately explicit message in case of error. *)
val parse_string : string -> unit
val parse_string : ?source:Loc.source -> string -> unit
(** [parse_file ?dir fn] incorporates the configuration file named [fn], prefixing its glob patterns
with [dir] if given. *)

11
ocamlbuild/const.ml Normal file
View File

@ -0,0 +1,11 @@
module Source = struct
let file = "file"
let command_line = "command-line"
let path = "path"
let ocamlfind_query = "ocamlfind query"
let ocamldep = "ocamldep"
let target_pattern = "target pattern"
let builtin = "builtin configuration"
let configuration = "configuration"
let plugin_tag = "plugin tag"
end

10
ocamlbuild/findlib.ml
View File

@ -74,15 +74,19 @@ let rec query name =
with Not_found ->
try
let n, d, v, a_byte, lo, l =
run_and_parse Lexers.ocamlfind_query
run_and_parse
(Lexers.ocamlfind_query Const.Source.ocamlfind_query)
"%s query -l -predicates byte %s" ocamlfind name
in
let a_native =
run_and_parse Lexers.trim_blanks
run_and_parse
(Lexers.trim_blanks Const.Source.ocamlfind_query)
"%s query -a-format -predicates native %s" ocamlfind name
in
let deps =
run_and_parse Lexers.blank_sep_strings "%s query -r -p-format %s" ocamlfind name
run_and_parse
(Lexers.blank_sep_strings Const.Source.ocamlfind_query)
"%s query -r -p-format %s" ocamlfind name
in
let deps = List.filter ((<>) n) deps in
let deps =

24
ocamlbuild/lexers.mli
View File

@ -20,29 +20,29 @@ type conf_values =
type conf = (Glob.globber * conf_values) list
val ocamldep_output : Lexing.lexbuf -> (string * string list) list
val space_sep_strings : Lexing.lexbuf -> string list
val blank_sep_strings : Lexing.lexbuf -> string list
val comma_sep_strings : Lexing.lexbuf -> string list
val comma_or_blank_sep_strings : Lexing.lexbuf -> string list
val trim_blanks : Lexing.lexbuf -> string
val ocamldep_output : Loc.source -> Lexing.lexbuf -> (string * string list) list
val space_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val blank_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val comma_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val comma_or_blank_sep_strings : Loc.source -> Lexing.lexbuf -> string list
val trim_blanks : Loc.source -> Lexing.lexbuf -> string
(* Parse an environment path (i.e. $PATH).
This is a colon separated string.
Note: successive colons means an empty string.
Example:
":aaa:bbb:::ccc:" -> [""; "aaa"; "bbb"; ""; ""; "ccc"; ""] *)
val parse_environment_path : Lexing.lexbuf -> string list
val parse_environment_path : Loc.source -> Lexing.lexbuf -> string list
(* Same one, for Windows (PATH is ;-separated) *)
val parse_environment_path_w : Lexing.lexbuf -> string list
val parse_environment_path_w : Loc.source -> Lexing.lexbuf -> string list
val conf_lines : string option -> Lexing.lexbuf -> conf
val path_scheme : bool -> Lexing.lexbuf ->
val conf_lines : string option -> Loc.source -> Lexing.lexbuf -> conf
val path_scheme : bool -> Loc.source -> Lexing.lexbuf ->
[ `Word of string
| `Var of (string * Glob.globber)
] list
val ocamlfind_query : Lexing.lexbuf ->
val ocamlfind_query : Loc.source -> Lexing.lexbuf ->
string * string * string * string * string * string
val tag_gen : Lexing.lexbuf -> string * string option
val tag_gen : Loc.source -> Lexing.lexbuf -> string * string option

159
ocamlbuild/lexers.mll
View File

@ -15,8 +15,10 @@
{
exception Error of (string * Loc.location)
let error lexbuf fmt =
Printf.ksprintf (fun s -> raise (Error (s, Loc.of_lexbuf lexbuf))) fmt
let error source lexbuf fmt =
Printf.ksprintf (fun s ->
raise (Error (s, Loc.of_lexbuf source lexbuf))
) fmt
open Glob_ast
@ -28,13 +30,16 @@ type conf = (Glob.globber * conf_values) list
let empty = { plus_tags = []; minus_tags = [] }
let locate lexbuf txt =
(txt, Loc.of_lexbuf lexbuf)
let locate source lexbuf txt =
(txt, Loc.of_lexbuf source lexbuf)
let sublex lexer s = lexer (Lexing.from_string s)
}
let newline = ('\n' | '\r' | "\r\n")
let space = [' ' '\t' '\012']
let space_or_esc_nl = (space | '\\' newline)
let sp = space_or_esc_nl
let blank = newline | space
let not_blank = [^' ' '\t' '\012' '\n' '\r']
let not_space_nor_comma = [^' ' '\t' '\012' ',']
@ -46,118 +51,122 @@ let tag = normal+ | ( normal+ ':' normal+ ) | normal+ '(' [^ ')' ]* ')'
let variable = [ 'a'-'z' 'A'-'Z' '_' '-' '0'-'9' ]*
let pattern = ([^ '(' ')' '\\' ] | '\\' [ '(' ')' ])*
rule ocamldep_output = parse
| ([^ ':' '\n' '\r' ]+ as k) ':' { let x = (k, space_sep_strings_nl lexbuf) in x :: ocamldep_output lexbuf }
rule ocamldep_output source = parse
| ([^ ':' '\n' '\r' ]+ as k) ':' { let x = (k, space_sep_strings_nl source lexbuf) in x :: ocamldep_output source lexbuf }
| eof { [] }
| _ { error lexbuf "Expecting colon followed by space-separated module name list" }
| _ { error source lexbuf "Expecting colon followed by space-separated module name list" }
and space_sep_strings_nl = parse
| space* (not_blank+ as word) { word :: space_sep_strings_nl lexbuf }
and space_sep_strings_nl source = parse
| space* (not_blank+ as word) { word :: space_sep_strings_nl source lexbuf }
| space* newline { Lexing.new_line lexbuf; [] }
| _ { error lexbuf "Expecting space-separated strings terminated with newline" }
| _ { error source lexbuf "Expecting space-separated strings terminated with newline" }
and space_sep_strings = parse
| space* (not_blank+ as word) { word :: space_sep_strings lexbuf }
and space_sep_strings source = parse
| space* (not_blank+ as word) { word :: space_sep_strings source lexbuf }
| space* newline? eof { [] }
| _ { error lexbuf "Expecting space-separated strings" }
| _ { error source lexbuf "Expecting space-separated strings" }
and blank_sep_strings = parse
| blank* '#' not_newline* newline { blank_sep_strings lexbuf }
and blank_sep_strings source = parse
| blank* '#' not_newline* newline { blank_sep_strings source lexbuf }
| blank* '#' not_newline* eof { [] }
| blank* (not_blank+ as word) { word :: blank_sep_strings lexbuf }
| blank* (not_blank+ as word) { word :: blank_sep_strings source lexbuf }
| blank* eof { [] }
| _ { error lexbuf "Expecting blank-separated strings" }
| _ { error source lexbuf "Expecting blank-separated strings" }
and comma_sep_strings = parse
and comma_sep_strings source = parse
| space* (not_space_nor_comma+ as word) space* eof { [word] }
| space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux lexbuf }
| space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error lexbuf "Expecting comma-separated strings (1)" }
and comma_sep_strings_aux = parse
| space* ',' space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux lexbuf }
| _ { error source lexbuf "Expecting comma-separated strings (1)" }
and comma_sep_strings_aux source = parse
| space* ',' space* (not_space_nor_comma+ as word) { word :: comma_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error lexbuf "Expecting comma-separated strings (2)" }
| _ { error source lexbuf "Expecting comma-separated strings (2)" }
and comma_or_blank_sep_strings = parse
and comma_or_blank_sep_strings source = parse
| space* (not_space_nor_comma+ as word) space* eof { [word] }
| space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf }
| space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error lexbuf "Expecting (comma|blank)-separated strings (1)" }
and comma_or_blank_sep_strings_aux = parse
| space* ',' space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf }
| space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux lexbuf }
| _ { error source lexbuf "Expecting (comma|blank)-separated strings (1)" }
and comma_or_blank_sep_strings_aux source = parse
| space* ',' space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux source lexbuf }
| space* (not_space_nor_comma+ as word) { word :: comma_or_blank_sep_strings_aux source lexbuf }
| space* eof { [] }
| _ { error lexbuf "Expecting (comma|blank)-separated strings (2)" }
| _ { error source lexbuf "Expecting (comma|blank)-separated strings (2)" }
and parse_environment_path_w = parse
| ([^ ';']* as word) { word :: parse_environment_path_aux_w lexbuf }
| ';' ([^ ';']* as word) { "" :: word :: parse_environment_path_aux_w lexbuf }
and parse_environment_path_w source = parse
| ([^ ';']* as word) { word :: parse_environment_path_aux_w source lexbuf }
| ';' ([^ ';']* as word) { "" :: word :: parse_environment_path_aux_w source lexbuf }
| eof { [] }
and parse_environment_path_aux_w = parse
| ';' ([^ ';']* as word) { word :: parse_environment_path_aux_w lexbuf }
and parse_environment_path_aux_w source = parse
| ';' ([^ ';']* as word) { word :: parse_environment_path_aux_w source lexbuf }
| eof { [] }
| _ { error lexbuf "Impossible: expecting colon-separated strings" }
| _ { error source lexbuf "Impossible: expecting colon-separated strings" }
and parse_environment_path = parse
| ([^ ':']* as word) { word :: parse_environment_path_aux lexbuf }
| ':' ([^ ':']* as word) { "" :: word :: parse_environment_path_aux lexbuf }
and parse_environment_path source = parse
| ([^ ':']* as word) { word :: parse_environment_path_aux source lexbuf }
| ':' ([^ ':']* as word) { "" :: word :: parse_environment_path_aux source lexbuf }
| eof { [] }
and parse_environment_path_aux = parse
| ':' ([^ ':']* as word) { word :: parse_environment_path_aux lexbuf }
and parse_environment_path_aux source = parse
| ':' ([^ ':']* as word) { word :: parse_environment_path_aux source lexbuf }
| eof { [] }
| _ { error lexbuf "Impossible: expecting colon-separated strings" }
| _ { error source lexbuf "Impossible: expecting colon-separated strings" }
and conf_lines dir = parse
| space* '#' not_newline* newline { Lexing.new_line lexbuf; conf_lines dir lexbuf }
and conf_lines dir source = parse
| space* '#' not_newline* newline { Lexing.new_line lexbuf; conf_lines dir source lexbuf }
| space* '#' not_newline* eof { [] }
| space* newline { Lexing.new_line lexbuf; conf_lines dir lexbuf }
| space* newline { Lexing.new_line lexbuf; conf_lines dir source lexbuf }
| space* eof { [] }
| space* (not_newline_nor_colon+ as k) space* ':' space*
| space* (not_newline_nor_colon+ as k) (sp* as s1) ':' (sp* as s2)
{
let bexpr =
try Glob.parse ?dir k
with exn -> error lexbuf "Invalid globbing pattern %S" k (Printexc.to_string exn)
with exn -> error source lexbuf "Invalid globbing pattern %S" k (Printexc.to_string exn)
in
let v1 = conf_value empty lexbuf in
let v2 = conf_values v1 lexbuf in
Lexing.new_line lexbuf; (* FIXME values may have escaped newlines *)
let rest = conf_lines dir lexbuf in (bexpr,v2) :: rest
sublex (count_lines lexbuf) s1; sublex (count_lines lexbuf) s2;
let v1 = conf_value empty source lexbuf in
let v2 = conf_values v1 source lexbuf in
let rest = conf_lines dir source lexbuf in (bexpr,v2) :: rest
}
| _ { error lexbuf "Invalid line syntax" }
| _ { error source lexbuf "Invalid line syntax" }
and conf_value x = parse
| '-' (tag as tag) { { (x) with minus_tags = locate lexbuf tag :: x.minus_tags } }
| '+'? (tag as tag) { { (x) with plus_tags = locate lexbuf tag :: x.plus_tags } }
| (_ | eof) { error lexbuf "Invalid tag modifier only '+ or '-' are allowed as prefix for tag" }
and conf_value x source = parse
| '-' (tag as tag) { { (x) with minus_tags = locate source lexbuf tag :: x.minus_tags } }
| '+'? (tag as tag) { { (x) with plus_tags = locate source lexbuf tag :: x.plus_tags } }
| (_ | eof) { error source lexbuf "Invalid tag modifier only '+ or '-' are allowed as prefix for tag" }
and conf_values x = parse
| space_or_esc_nl* ',' space_or_esc_nl* { conf_values (conf_value x lexbuf) lexbuf }
| (newline | eof) { x }
| (_ | eof) { error lexbuf "Only ',' separated tags are alllowed" }
and conf_values x source = parse
| (sp* as s1) ',' (sp* as s2) {
sublex (count_lines lexbuf) s1; sublex (count_lines lexbuf) s2;
conf_values (conf_value x source lexbuf) source lexbuf
}
| newline { Lexing.new_line lexbuf; x }
| eof { x }
| _ { error source lexbuf "Only ',' separated tags are alllowed" }
and path_scheme patt_allowed = parse
and path_scheme patt_allowed source = parse
| ([^ '%' ]+ as prefix)
{ `Word prefix :: path_scheme patt_allowed lexbuf }
{ `Word prefix :: path_scheme patt_allowed source lexbuf }
| "%(" (variable as var) ')'
{ `Var (var, Bool.True) :: path_scheme patt_allowed lexbuf }
{ `Var (var, Bool.True) :: path_scheme patt_allowed source lexbuf }
| "%(" (variable as var) ':' (pattern as patt) ')'
{ if patt_allowed then
let patt = My_std.String.implode (unescape (Lexing.from_string patt)) in
`Var (var, Glob.parse patt) :: path_scheme patt_allowed lexbuf
`Var (var, Glob.parse patt) :: path_scheme patt_allowed source lexbuf
else
error lexbuf "Patterns are not allowed in this pathname (%%(%s:%s) only in ~prod)" var patt }
error source lexbuf "Patterns are not allowed in this pathname (%%(%s:%s) only in ~prod)" var patt }
| '%'
{ `Var ("", Bool.True) :: path_scheme patt_allowed lexbuf }
{ `Var ("", Bool.True) :: path_scheme patt_allowed source lexbuf }
| eof
{ [] }
| _ { error lexbuf "Bad pathanme scheme" }
| _ { error source lexbuf "Bad pathanme scheme" }
and unescape = parse
| '\\' (['(' ')'] as c) { c :: unescape lexbuf }
| _ as c { c :: unescape lexbuf }
| eof { [] }
and ocamlfind_query = parse
and ocamlfind_query source = parse
| newline*
"package:" space* (not_newline* as n) newline+
"description:" space* (not_newline* as d) newline+
@ -166,11 +175,17 @@ and ocamlfind_query = parse
"linkopts:" space* (not_newline* as lo) newline+
"location:" space* (not_newline* as l) newline+
{ n, d, v, a, lo, l }
| _ { error lexbuf "Bad ocamlfind query" }
| _ { error source lexbuf "Bad ocamlfind query" }
and trim_blanks = parse
and trim_blanks source = parse
| blank* (not_blank* as word) blank* { word }
| _ { error lexbuf "Bad input for trim_blanks" }
| _ { error source lexbuf "Bad input for trim_blanks" }
and tag_gen = parse
and tag_gen source = parse
| (normal+ as name) ('(' ([^')']* as param) ')')? { name, param }
| _ { error source lexbuf "Not a valid parametrized tag" }
and count_lines lb = parse
| space* { count_lines lb lexbuf }
| '\\' newline { Lexing.new_line lb; count_lines lb lexbuf }
| eof { () }

15
ocamlbuild/loc.ml
View File

@ -4,26 +4,31 @@
open Lexing
type location = position * position
(* We use a loosely structural type so that this bit of code can be
easily reused by project that would wish it, without introducing
any type-compatibility burden. *)
type source = string (* "file", "environment variable", "command-line option" ... *)
type location = source * position * position
let file loc = loc.pos_fname
let line loc = loc.pos_lnum
let char loc = loc.pos_cnum - loc.pos_bol
let print_loc ppf (start, end_) =
let print_loc ppf (source, start, end_) =
let open Format in
let print one_or_two ppf (start_num, end_num) =
if one_or_two then fprintf ppf " %d" start_num
else fprintf ppf "s %d-%d" start_num end_num in
fprintf ppf "File %S, line%a, character%a:@."
fprintf ppf "%s %S, line%a, character%a:@."
(String.capitalize source)
(file start)
(print (line start = line end_))
(line start, line end_)
(print (line start = line end_ && char start = char end_))
(char start, char end_)
let of_lexbuf lexbuf =
(lexbuf.lex_start_p, lexbuf.lex_curr_p)
let of_lexbuf source lexbuf =
(source, lexbuf.lex_start_p, lexbuf.lex_curr_p)
let print_loc_option ppf = function
| None -> ()

5
ocamlbuild/loc.mli
View File

@ -1,6 +1,7 @@
type location = Lexing.position * Lexing.position
type source = string
type location = source * Lexing.position * Lexing.position
val print_loc : Format.formatter -> location -> unit
val print_loc_option : Format.formatter -> location option -> unit
val of_lexbuf : Lexing.lexbuf -> location
val of_lexbuf : source -> Lexing.lexbuf -> location

13
ocamlbuild/log.ml
View File

@ -48,7 +48,20 @@ let update () = Display.update !-internal_display
let event ?pretend x = Display.event !-internal_display ?pretend x
let display x = Display.display !-internal_display x
let do_at_end = Queue.create ()
let at_end_always thunk = Queue.add thunk do_at_end
let at_end thunk = at_end_always (function
| `Quiet -> ()
| `Success | `Error -> thunk `Error)
let at_failure thunk = at_end_always (function
| `Success | `Quiet -> ()
| `Error -> thunk `Error)
let finish ?how () =
Queue.iter (fun thunk ->
thunk (match how with None -> `Quiet | Some how -> how)
) do_at_end;
match !internal_display with
| None -> ()
| Some d -> Display.finish ?how d

5
ocamlbuild/log.mli
View File

@ -32,3 +32,8 @@ val finish : ?how:[`Success|`Error|`Quiet] -> unit -> unit
val display : (out_channel -> unit) -> unit
val update : unit -> unit
val mode : string -> bool
(** Wrap logging event so that only fire at the end of the compilation
process, possibly depending on the termination status. *)
val at_end : ([> `Error | `Quiet ] -> unit) -> unit
val at_failure : ([> `Error ] -> unit) -> unit

21
ocamlbuild/main.ml
View File

@ -81,7 +81,7 @@ let proceed () =
let target_dirs = List.union [] (List.map Pathname.dirname !Options.targets) in
Configuration.parse_string
Configuration.parse_string ~source:Const.Source.builtin
"<**/*.ml> or <**/*.mli> or <**/*.mlpack> or <**/*.ml.depends>: ocaml\n\
<**/*.byte>: ocaml, byte, program\n\
<**/*.odoc>: ocaml, doc\n\
@ -93,16 +93,21 @@ let proceed () =
<**/*.cmx>: ocaml, native\n\
";
List.iter
(Configuration.parse_string ~source:Const.Source.command_line)
!Options.tag_lines;
Configuration.tag_any !Options.tags;
if !Options.recursive
|| Sys.file_exists (* authorized since we're not in build *) "_tags"
|| Sys.file_exists (* authorized since we're not in build *) "myocamlbuild.ml"
if !Options.recursive || Options.ocamlbuild_project_heuristic ()
then Configuration.tag_any ["traverse"];
(* options related to findlib *)
List.iter
(fun pkg -> Configuration.tag_any [Param_tags.make "package" pkg])
!Options.ocaml_pkgs;
if !Options.use_ocamlfind then
List.iter
(fun pkg ->
let tag = Param_tags.make "package" pkg in
Configuration.tag_any [tag])
!Options.ocaml_pkgs;
begin match !Options.ocaml_syntax with
| Some syntax -> Configuration.tag_any [Param_tags.make "syntax" syntax]
@ -173,8 +178,6 @@ let proceed () =
dprintf 3 "include directories are:@ %a" print_string_list !Options.include_dirs;
Options.entry := Some entry;
List.iter Configuration.parse_string !Options.tag_lines;
Hooks.call_hook Hooks.Before_rules;
Ocaml_specific.init ();
Hooks.call_hook Hooks.After_rules;

19
ocamlbuild/my_std.ml
View File

@ -410,3 +410,22 @@ let memo3 f =
with Not_found ->
let res = f x y z in
(Hashtbl.add cache (x,y,z) res; res)
let set_lexbuf_fname fname lexbuf =
let open Lexing in
lexbuf.lex_start_p <- { lexbuf.lex_start_p with pos_fname = fname };
lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = fname };
()
let lexbuf_of_string ?name content =
let lexbuf = Lexing.from_string content in
let fname = match name with
| Some name -> name
| None ->
(* 40: hope the location will fit one line of 80 chars *)
if String.length content < 40 && not (String.contains content '\n') then
String.escaped content
else ""
in
set_lexbuf_fname fname lexbuf;
lexbuf

3
ocamlbuild/my_std.mli
View File

@ -62,3 +62,6 @@ val filename_concat : string -> string -> string
val invalid_arg' : ('a, Format.formatter, unit, 'b) format4 -> 'a
include Signatures.MISC
val set_lexbuf_fname : string -> Lexing.lexbuf -> unit
val lexbuf_of_string : ?name:string -> string -> Lexing.lexbuf

23
ocamlbuild/ocaml_compiler.ml
View File

@ -116,10 +116,25 @@ let prepare_compile build ml =
match mandatory, res with
| _, Good _ -> ()
| `mandatory, Bad exn ->
if !Options.ignore_auto then
dprintf 3 "Warning: Failed to build the module \
%s requested by ocamldep" name
else raise exn
if not !Options.ignore_auto then raise exn
else dprintf 3
"Warning: Failed to build the module %s requested by ocamldep."
name;
Log.at_failure (fun `Error ->
eprintf "Hint:@ Recursive@ traversal@ of@ subdirectories@ \
was@ not@ enabled@ for@ this@ build,@ as@ the@ working@ \
directory does@ not@ look@ like@ an@ ocamlbuild@ project@ \
(no@ '_tags'@ or@ 'myocamlbuild.ml'@ file).@ \
If@ you@ have@ modules@ in@ subdirectories,@ you@ should@ add@ \
the@ option@ \"-r\"@ or@ create@ an@ empty@ '_tags'@ file.@\n\
@\n\
To@ enable@ recursive@ traversal@ for@ some@ subdirectories@ \
only,@ you@ can@ use@ the@ following@ '_tags'@ file:@\n\
@[<v 4>@,\
true: -traverse@,\
<dir1> or <dir2>: traverse@,\
@]"
);
| `just_try, Bad _ -> ()
end modules results

6
ocamlbuild/ocaml_utils.ml
View File

@ -80,7 +80,8 @@ let expand_module =
let string_list_of_file file =
with_input_file file begin fun ic ->
Lexers.blank_sep_strings (Lexing.from_channel ic)
Lexers.blank_sep_strings
Const.Source.file (Lexing.from_channel ic)
end
let print_path_list = Pathname.print_path_list
@ -149,7 +150,8 @@ let read_path_dependencies =
let depends = path-.-"depends" in
with_input_file depends begin fun ic ->
let ocamldep_output =
try Lexers.ocamldep_output (Lexing.from_channel ic)
try Lexers.ocamldep_output
Const.Source.ocamldep (Lexing.from_channel ic)
with Lexers.Error (msg,_) -> raise (Ocamldep_error(Printf.sprintf "Ocamldep.ocamldep: bad output (%s)" msg)) in
let deps =
List.fold_right begin fun (path, deps) acc ->

1
ocamlbuild/ocamlbuild_pack.mlpack
View File

@ -1,3 +1,4 @@
Const
Loc
Log
My_unix

61
ocamlbuild/options.ml
View File

@ -23,6 +23,7 @@ open Format
open Command
let entry = ref None
let project_root_dir = ref None
let build_dir = ref (Filename.concat (Sys.getcwd ()) "_build")
let include_dirs = ref []
let exclude_dirs = ref []
@ -141,7 +142,8 @@ let use_jocaml () =
;;
let add_to rxs x =
let xs = Lexers.comma_or_blank_sep_strings (Lexing.from_string x) in
let xs = Lexers.comma_or_blank_sep_strings
Const.Source.command_line (Lexing.from_string x) in
rxs := xs :: !rxs
let add_to' rxs x =
if x <> dummy then
@ -217,8 +219,10 @@ let spec = ref (
"-classic-display", Set Log.classic_display, " Display executed commands the old-fashioned way";
"-use-menhir", Set use_menhir, " Use menhir instead of ocamlyacc";
"-use-jocaml", Unit use_jocaml, " Use jocaml compilers instead of ocaml ones";
"-use-ocamlfind", Set use_ocamlfind, " Option deprecated. Now enabled by default. Use -no-ocamlfind to disable";
"-no-ocamlfind", Clear use_ocamlfind, " Don't use ocamlfind";
"-use-ocamlfind", Set use_ocamlfind, " Use the 'ocamlfind' wrapper instead of \
using Findlib directly to determine command-line arguments. \
Use -no-ocamlfind to disable.";
"-no-ocamlfind", Clear use_ocamlfind, " Don't use ocamlfind.";
"-j", Set_int Command.jobs, "<N> Allow N jobs at once (0 for unlimited)";
@ -270,6 +274,8 @@ let init () =
parse_argv argv' !spec anon_fun usage_msg;
Shell.mkdir_p !build_dir;
project_root_dir := Some (Sys.getcwd ());
let () =
let log = !log_file_internal in
if log = "" then Log.init None
@ -285,18 +291,33 @@ let init () =
in
if !use_ocamlfind then begin
ocamlfind_cmd := A "ocamlfind";
let cmd = Command.string_of_command_spec !ocamlfind_cmd in
begin try ignore(Command.search_in_path cmd)
with Not_found -> failwith "ocamlfind not found on path, but -no-ocamlfind not used" end;
(* TODO: warning message when using an option such as -ocamlc *)
begin try ignore(Command.search_in_path "ocamlfind")
with Not_found ->
failwith "ocamlfind not found on path, but -no-ocamlfind not used"
end;
let with_ocamlfind (command_name, command_ref) =
command_ref := match !command_ref with
| Sh user_command ->
(* this command has been set by the user
using an -ocamlc, -ocamlopt, etc. flag;
not all such combinations make sense (eg. "ocamlfind
/my/special/path/to/ocamlc" will make ocamlfind choke),
but the user will see the error and hopefully fix the
flags. *)
ocamlfind & (Sh user_command);
| _ -> ocamlfind & A command_name
in
(* Note that plugins can still modify these variables After_options.
This design decision can easily be changed. *)
ocamlc := ocamlfind & A"ocamlc";
ocamlopt := ocamlfind & A"ocamlopt";
ocamldep := ocamlfind & A"ocamldep";
ocamldoc := ocamlfind & A"ocamldoc";
ocamlmktop := ocamlfind & A"ocamlmktop";
List.iter with_ocamlfind [
"ocamlc", ocamlc;
"ocamlopt", ocamlopt;
"ocamldep", ocamldep;
"ocamldoc", ocamldoc;
"ocamlmktop", ocamlmktop;
]
end;
let reorder x y = x := !x @ (List.concat (List.rev !y)) in
@ -334,3 +355,17 @@ let init () =
ignore_list := List.map String.capitalize !ignore_list
;;
(* The current heuristic: we know we are in an ocamlbuild project if
either _tags or myocamlbuild.ml are present at the root. This
heuristic has been documented and explained to users, so it should
not be changed. *)
let ocamlbuild_project_heuristic () =
let root_dir = match !project_root_dir with
| None -> Sys.getcwd ()
| Some dir -> dir in
let at_root file = Filename.concat root_dir file in
Sys.file_exists (* authorized since we're not in build *)
(at_root "_tags")
|| Sys.file_exists (* authorized since we're not in build *)
(at_root "myocamlbuild.ml")

10
ocamlbuild/options.mli
View File

@ -15,12 +15,20 @@
include Signatures.OPTIONS with type command_spec = Command.spec
(* this option is not in Signatures.OPTIONS yet because adding tags to
(* This option is not in Signatures.OPTIONS yet because adding tags to
the compilation of the plugin is a recent feature that may still be
subject to change, so the interface may not be stable; besides,
there is obviously little to gain from tweaking that option from
inside the plugin itself... *)
val plugin_tags : string list ref
(* Returns 'true' if we heuristically infer that we are run from an
ocamlbuild projet (either _tags or myocamlbuild.ml are present).
This information is used to decide whether to enable recursive
traversal of subdirectories by default.
*)
val ocamlbuild_project_heuristic : unit -> bool
val entry : bool Slurp.entry option ref
val init : unit -> unit

12
ocamlbuild/param_tags.ml
View File

@ -10,6 +10,7 @@
(* *)
(***********************************************************************)
open My_std
(* Original author: Romain Bardou *)
@ -32,10 +33,10 @@ let only_once f =
let declare name action =
Hashtbl.add declared_tags name (only_once action)
let parse tag = Lexers.tag_gen (Lexing.from_string tag)
let parse source tag = Lexers.tag_gen source (lexbuf_of_string tag)
let acknowledge maybe_loc tag =
acknowledged_tags := (parse tag, maybe_loc) :: !acknowledged_tags
let acknowledge source maybe_loc tag =
acknowledged_tags := (parse source tag, maybe_loc) :: !acknowledged_tags
let really_acknowledge ?(quiet=false) ((name, param), maybe_loc) =
match param with
@ -51,8 +52,9 @@ let really_acknowledge ?(quiet=false) ((name, param), maybe_loc) =
Loc.print_loc_option maybe_loc name param;
List.iter (fun f -> f param) actions
let partial_init ?quiet tags =
Tags.iter (fun tag -> really_acknowledge ?quiet (parse tag, None)) tags
let partial_init ?quiet source tags =
let parse_noloc tag = (parse source tag, None) in
Tags.iter (fun tag -> really_acknowledge ?quiet (parse_noloc tag)) tags
let init () =
List.iter really_acknowledge (My_std.List.ordered_unique !acknowledged_tags)

4
ocamlbuild/param_tags.mli
View File

@ -22,7 +22,7 @@ if a tag of the form [name(param)] is [acknowledge]d.
A given tag may be declared several times with different actions. All actions
will be executed, in the order they were declared. *)
val acknowledge: Loc.location option -> string -> unit
val acknowledge: Loc.source -> Loc.location option -> string -> unit
(** Acknowledge a tag.
If the tag is of the form [X(Y)], and have been declared using [declare],
@ -37,7 +37,7 @@ This will make effective all instantiations [foo(bar)] such that the
parametrized tag [foo] has been [declare]d and [foo(bar)] has been
[acknowledge]d after the last [init] call. *)
val partial_init: ?quiet:bool -> Tags.t -> unit
val partial_init: ?quiet:bool -> Loc.source -> Tags.t -> unit
(** Initialize a list of tags
This will make effective the instances [foo(bar)] appearing

2
ocamlbuild/plugin.ml
View File

@ -202,7 +202,7 @@ module Make(U:sig end) =
precisely those that will be used during the compilation of
the plugin, and no more.
*)
Param_tags.partial_init plugin_tags;
Param_tags.partial_init Const.Source.plugin_tag plugin_tags;
let cmd =
(* The argument order is important: we carefully put the

5
ocamlbuild/resource.ml
View File

@ -17,6 +17,8 @@ open Format
open Log
open Pathname.Operators
type t = Pathname.t
module Resources = Set.Make(Pathname)
let print = Pathname.print
@ -312,7 +314,8 @@ end = struct
let mk (pattern_allowed, s) = List.map begin function
| `Var(var_name, globber) -> V(var_name, globber)
| `Word s -> A s
end (Lexers.path_scheme pattern_allowed (Lexing.from_string s))
end (Lexers.path_scheme pattern_allowed
Const.Source.target_pattern (lexbuf_of_string s))
let mk = memo mk

1
ocamlbuild/resource.mli
View File

@ -18,6 +18,7 @@ open Pathname
type resource_pattern
type env
type t = Pathname.t
module Resources : Set.S with type elt = t
module Cache :

7
ocamlbuild/testsuite/findlibonly.ml
View File

@ -32,4 +32,11 @@ let () = test "PredicateFlag"
~matching:[_build [M.f "test.ml.depends"]]
~targets:("test.ml.depends", []) ();;
let () = test "ToolsFlagsConflict"
~description:"PR#6300: conflicts between -ocamlc and -use-ocamlfind options"
~options:[`use_ocamlfind; `ocamlc "\"ocamlc -annot\""]
~tree:[T.f "test.ml" ~content:"let x = 1"]
~matching:[_build [M.f "test.annot"; M.f "test.byte"]]
~targets:("test.byte", []) ();;
run ~root:"_test_findlibonly";;

19
ocamlbuild/testsuite/internal.ml
View File

@ -264,4 +264,23 @@ let () = test "TagsInNonHygienic"
~matching:[M.f "main.byte"]
~targets:("main.byte",[]) ();;
let () = test "TagsNewlines"
~description:"Regression test for PR#6087 about placement \
of newline-escaping backslashes"
~options:[`no_ocamlfind]
~tree:[
T.f "main.ml" ~content:"";
T.f "_tags" ~content:
"<foo>: debug,\\
rectypes
<bar>: \\
debug, rectypes
<baz>\\
: debug, rectypes
";
]
~matching:[M.f "main.byte"]
~targets:("main.byte",[]) ();;
run ~root:"_test_internal";;

6
ocamldoc/.depend
View File

@ -182,14 +182,16 @@ odoc_sig.cmo : ../typing/types.cmi ../typing/typedtree.cmi \
odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi odoc_global.cmi \
odoc_extension.cmo odoc_exception.cmo odoc_env.cmi odoc_class.cmo \
../utils/misc.cmi ../parsing/location.cmi ../typing/ident.cmi \
../typing/btype.cmi ../parsing/asttypes.cmi odoc_sig.cmi
../typing/ctype.cmi ../typing/btype.cmi ../parsing/asttypes.cmi \
odoc_sig.cmi
odoc_sig.cmx : ../typing/types.cmx ../typing/typedtree.cmx \
../typing/path.cmx ../parsing/parsetree.cmi odoc_value.cmx odoc_types.cmx \
odoc_type.cmx odoc_parameter.cmx odoc_name.cmx odoc_module.cmx \
odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx odoc_global.cmx \
odoc_extension.cmx odoc_exception.cmx odoc_env.cmx odoc_class.cmx \
../utils/misc.cmx ../parsing/location.cmx ../typing/ident.cmx \
../typing/btype.cmx ../parsing/asttypes.cmi odoc_sig.cmi
../typing/ctype.cmx ../typing/btype.cmx ../parsing/asttypes.cmi \
odoc_sig.cmi
odoc_str.cmo : ../typing/types.cmi ../typing/printtyp.cmi odoc_value.cmo \
odoc_type.cmo odoc_print.cmi odoc_name.cmi odoc_misc.cmi \
odoc_messages.cmo odoc_extension.cmo odoc_exception.cmo odoc_class.cmo \

16
ocamldoc/Makefile
View File

@ -172,14 +172,20 @@ debug:
$(MAKE) OCAMLPP=""
$(OCAMLDOC): $(EXECMOFILES)
$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES)
$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma \
$(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cma \
$(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES)
$(OCAMLDOC_OPT): $(EXECMXFILES)
$(OCAMLOPT) -o $@ -linkall unix.cmxa str.cmxa dynlink.cmxa $(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES)
$(OCAMLOPT) -o $@ -linkall unix.cmxa str.cmxa dynlink.cmxa \
$(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cmxa \
$(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES)
$(OCAMLDOC_LIBCMA): $(LIBCMOFILES)
$(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo $(LIBCMOFILES)
$(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo \
$(LIBCMOFILES)
$(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx $(LIBCMXFILES)
$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx \
$(LIBCMXFILES)
manpages: stdlib_man/Pervasives.3o
html_doc: stdlib_html/Pervasives.html
@ -244,7 +250,7 @@ install: dummy
if test -d stdlib_man; then $(CP) stdlib_man/* $(INSTALL_MANODIR); else : ; fi
installopt:
if test -f $(OCAMLDOC_OPT) ; then $(MAKE) installopt_really ; fi
if test -f $(OCAMLDOC_OPT); then $(MAKE) installopt_really ; fi
installopt_really:
if test -d $(INSTALL_BINDIR); then : ; else $(MKDIR) $(INSTALL_BINDIR); fi

35
ocamldoc/Makefile.nt
View File

@ -21,8 +21,8 @@ OCAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
OCAMLDEP = $(OCAMLRUN) $(ROOTDIR)/tools/ocamldep
OCAMLLEX = $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
OCAMLYACC = $(ROOTDIR)/yacc/ocamlyacc
OCAMLLIB = $(LIBDIR)
OCAMLBIN = $(BINDIR)
OCAMLLIB = $(LIBDIR)
OCAMLBIN = $(BINDIR)
OCAMLPP=-pp "grep -v DEBUG"
@ -58,13 +58,13 @@ INCLUDES_DEP=-I $(OCAMLSRCDIR)/parsing \
INCLUDES_NODEP= -I $(OCAMLSRCDIR)/stdlib \
-I $(OCAMLSRCDIR)/otherlibs/str \
-I $(OCAMLSRCDIR)/otherlibs/dynlink \
-I $(OCAMLSRCDIR)/otherlibs/win32unix \
-I $(OCAMLSRCDIR)/otherlibs/$(UNIXLIB) \
-I $(OCAMLSRCDIR)/otherlibs/num \
-I $(OCAMLSRCDIR)/otherlibs/win32graph
-I $(OCAMLSRCDIR)/otherlibs/$(GRAPHLIB)
INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
COMPFLAGS=$(INCLUDES) -warn-error A
COMPFLAGS=$(INCLUDES) -warn-error A -safe-string
LINKFLAGS=$(INCLUDES) -nostdlib
CMOFILES= odoc_config.cmo \
@ -121,7 +121,6 @@ EXECMOFILES=$(CMOFILES) \
odoc_args.cmo \
odoc.cmo
EXECMXFILES= $(EXECMOFILES:.cmo=.cmx)
EXECMIFILES= $(EXECMOFILES:.cmo=.cmi)
@ -135,25 +134,35 @@ OCAMLCMOFILES= \
OCAMLCMXFILES=$(OCAMLCMOFILES:.cmo=.cmx)
all: exe lib
all:
$(MAKEREC) exe
$(MAKEREC) lib
exe: $(OCAMLDOC)
lib: $(OCAMLDOC_LIBCMA) $(OCAMLDOC_LIBCMI)
opt.opt: exeopt libopt
exeopt: $(OCAMLDOC_OPT)
libopt: $(OCAMLDOC_LIBCMXA) $(OCAMLDOC_LIBCMI)
debug:
$(MAKE) OCAMLPP=""
$(MAKEREC) OCAMLPP=""
$(OCAMLDOC): $(EXECMOFILES)
$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma $(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cma $(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES)
$(OCAMLC) -o $@ -linkall unix.cma str.cma dynlink.cma \
$(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cma \
$(LINKFLAGS) $(OCAMLCMOFILES) $(EXECMOFILES)
$(OCAMLDOC_OPT): $(EXECMXFILES)
$(OCAMLOPT) -o $@ unix.cmxa str.cmxa dynlink.cmxa $(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cmxa $(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES)
$(OCAMLOPT) -o $@ -linkall unix.cmxa str.cmxa dynlink.cmxa \
$(OCAMLSRCDIR)/compilerlibs/ocamlcommon.cmxa \
$(LINKFLAGS) $(OCAMLCMXFILES) $(EXECMXFILES)
$(OCAMLDOC_LIBCMA): $(LIBCMOFILES)
$(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLCMOFILES) $(LIBCMOFILES)
$(OCAMLC) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmo \
$(LIBCMOFILES)
$(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLCMXFILES) $(LIBCMXFILES)
$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $(OCAMLSRCDIR)/tools/depend.cmx \
$(LIBCMXFILES)
# Parsers and lexers dependencies :
###################################
@ -222,7 +231,7 @@ installopt_really:
############################
clean:: dummy
@rm -f *~ /#*/#
@rm -f *~ \#*\#
@rm -f $(OCAMLDOC) $(OCAMLDOC_OPT) *.cma *.cmxa *.cmo *.cmi *.cmx *.$(A) *.$(O)
@rm -f odoc_parser.output odoc_text_parser.output
@rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml

2
ocamldoc/odoc_analyse.ml
View File

@ -440,7 +440,7 @@ let analyse_files ?(init=[]) files =
);
if !Odoc_global.sort_modules then
Sort.list (fun m1 -> fun m2 -> m1.Odoc_module.m_name < m2.Odoc_module.m_name) merged_modules
List.sort (fun m1 m2 -> compare m1.Odoc_module.m_name m2.Odoc_module.m_name) merged_modules
else
merged_modules

Some files were not shown because too many files have changed in this diff Show More