Merge remote-tracking branch 'upstream/trunk' into trunk
commit
c3f6cd7ff7
2
.depend
2
.depend
|
@ -2877,6 +2877,7 @@ asmcomp/spacetime_profiling.cmo : \
|
||||||
lambda/lambda.cmi \
|
lambda/lambda.cmi \
|
||||||
lambda/debuginfo.cmi \
|
lambda/debuginfo.cmi \
|
||||||
utils/config.cmi \
|
utils/config.cmi \
|
||||||
|
asmcomp/cmm_helpers.cmi \
|
||||||
asmcomp/cmm.cmi \
|
asmcomp/cmm.cmi \
|
||||||
middle_end/backend_var.cmi \
|
middle_end/backend_var.cmi \
|
||||||
parsing/asttypes.cmi \
|
parsing/asttypes.cmi \
|
||||||
|
@ -2890,6 +2891,7 @@ asmcomp/spacetime_profiling.cmx : \
|
||||||
lambda/lambda.cmx \
|
lambda/lambda.cmx \
|
||||||
lambda/debuginfo.cmx \
|
lambda/debuginfo.cmx \
|
||||||
utils/config.cmx \
|
utils/config.cmx \
|
||||||
|
asmcomp/cmm_helpers.cmx \
|
||||||
asmcomp/cmm.cmx \
|
asmcomp/cmm.cmx \
|
||||||
middle_end/backend_var.cmx \
|
middle_end/backend_var.cmx \
|
||||||
parsing/asttypes.cmi \
|
parsing/asttypes.cmi \
|
||||||
|
|
|
@ -29,9 +29,9 @@
|
||||||
|
|
||||||
/boot/menhir/parser.ml* -diff
|
/boot/menhir/parser.ml* -diff
|
||||||
|
|
||||||
# configure is declared as binary so that it doesn't get included in diffs.
|
# configure is a shell-script; the linguist-generated attribute suppresses
|
||||||
# This also means it will have the correct Unix line-endings, even on Windows.
|
# changes being displayed by default in pull requests.
|
||||||
/configure binary
|
/configure text eol=lf -diff linguist-generated
|
||||||
|
|
||||||
# 'union' merge driver just unions textual content in case of conflict
|
# 'union' merge driver just unions textual content in case of conflict
|
||||||
# http://krlmlr.github.io/using-gitattributes-to-avoid-merge-conflicts/
|
# http://krlmlr.github.io/using-gitattributes-to-avoid-merge-conflicts/
|
||||||
|
@ -119,6 +119,10 @@ testsuite/tests/**/*.reference typo.prune
|
||||||
# Expect tests with overly long lines of expected output
|
# Expect tests with overly long lines of expected output
|
||||||
testsuite/tests/parsing/docstrings.ml typo.very-long-line
|
testsuite/tests/parsing/docstrings.ml typo.very-long-line
|
||||||
|
|
||||||
|
# The normalisation tests have very specific line endings which mustn't be
|
||||||
|
# corrupted by git.
|
||||||
|
testsuite/tests/tool-ocamltest/norm*.reference binary
|
||||||
|
|
||||||
tools/magic typo.missing-header
|
tools/magic typo.missing-header
|
||||||
tools/eventlog_metadata.in typo.missing-header
|
tools/eventlog_metadata.in typo.missing-header
|
||||||
|
|
||||||
|
|
|
@ -118,6 +118,7 @@ _build
|
||||||
/ocamltest/ocamltest
|
/ocamltest/ocamltest
|
||||||
/ocamltest/ocamltest.opt
|
/ocamltest/ocamltest.opt
|
||||||
/ocamltest/ocamltest_config.ml
|
/ocamltest/ocamltest_config.ml
|
||||||
|
/ocamltest/ocamltest_unix.ml
|
||||||
/ocamltest/tsl_lexer.ml
|
/ocamltest/tsl_lexer.ml
|
||||||
/ocamltest/tsl_parser.ml
|
/ocamltest/tsl_parser.ml
|
||||||
/ocamltest/tsl_parser.mli
|
/ocamltest/tsl_parser.mli
|
||||||
|
@ -163,6 +164,7 @@ _build
|
||||||
/otherlibs/win32unix/time.c
|
/otherlibs/win32unix/time.c
|
||||||
/otherlibs/win32unix/unlink.c
|
/otherlibs/win32unix/unlink.c
|
||||||
/otherlibs/win32unix/fsync.c
|
/otherlibs/win32unix/fsync.c
|
||||||
|
/otherlibs/win32unix/mkdir.c
|
||||||
|
|
||||||
/parsing/parser.ml
|
/parsing/parser.ml
|
||||||
/parsing/parser.mli
|
/parsing/parser.mli
|
||||||
|
|
465
Changes
465
Changes
|
@ -16,6 +16,12 @@ Working version
|
||||||
type !'a t = 'a list
|
type !'a t = 'a list
|
||||||
(Jacques Garrigue, review by Jeremy Yallop and Leo White)
|
(Jacques Garrigue, review by Jeremy Yallop and Leo White)
|
||||||
|
|
||||||
|
### Supported platforms:
|
||||||
|
|
||||||
|
- #9699: add support for iOS and macOS on ARM 64 bits
|
||||||
|
(GitHub user @EduardoRFS, review by Xavier Leroy, Nicolás Ojeda Bär
|
||||||
|
and Anil Madhavapeddy, additional testing by Michael Schmidt)
|
||||||
|
|
||||||
### Runtime system:
|
### Runtime system:
|
||||||
|
|
||||||
- #1795, #9543: modernize signal handling on Linux i386, PowerPC, and s390x,
|
- #1795, #9543: modernize signal handling on Linux i386, PowerPC, and s390x,
|
||||||
|
@ -48,6 +54,9 @@ Working version
|
||||||
(Nicolás Ojeda Bär, review by Stephen Dolan, Gabriel Scherer, Mark Shinwell,
|
(Nicolás Ojeda Bär, review by Stephen Dolan, Gabriel Scherer, Mark Shinwell,
|
||||||
and Xavier Leroy)
|
and Xavier Leroy)
|
||||||
|
|
||||||
|
- #8807, #9503: Use different symbols for do_local_roots on bytecode and native
|
||||||
|
(Stephen Dolan, review by David Allsopp and Xavier Leroy)
|
||||||
|
|
||||||
- #9619: Change representation of function closures so that code pointers
|
- #9619: Change representation of function closures so that code pointers
|
||||||
can be easily distinguished from environment variables
|
can be easily distinguished from environment variables
|
||||||
(Xavier Leroy, review by Mark Shinwell and Damien Doligez)
|
(Xavier Leroy, review by Mark Shinwell and Damien Doligez)
|
||||||
|
@ -90,6 +99,25 @@ Working version
|
||||||
compaction algorithm and remove its dependence on the page table
|
compaction algorithm and remove its dependence on the page table
|
||||||
(Damien Doligez, review by Jacques-Henri Jourdan and Xavier Leroy)
|
(Damien Doligez, review by Jacques-Henri Jourdan and Xavier Leroy)
|
||||||
|
|
||||||
|
- #9742: Ephemerons are now compatible with infix pointers occurring
|
||||||
|
when using mutually recursive functions.
|
||||||
|
(Jacques-Henri Jourdan, review François Bobot)
|
||||||
|
|
||||||
|
* #1128, #7503, #9036, #9722: EINTR-based signal handling.
|
||||||
|
When a signal arrives, avoid running its OCaml handler in the middle
|
||||||
|
of a blocking section. Instead, allow control to return quickly to
|
||||||
|
a polling point where the signal handler can safely run, ensuring that
|
||||||
|
I/O locks are not held while it runs. A polling point was removed from
|
||||||
|
caml_leave_blocking_section, and one added to caml_raise.
|
||||||
|
(Stephen Dolan, review by Goswin von Brederlow, Xavier Leroy, Damien
|
||||||
|
Doligez, Anil Madhavapeddy, Guillaume Munch-Maccagnoni and Jacques-
|
||||||
|
Henri Jourdan)
|
||||||
|
|
||||||
|
- #9888, #9890: Fixes a bug in the `riscv` backend where register t0 was not
|
||||||
|
saved/restored when performing a GC. This could potentially lead to a
|
||||||
|
segfault.
|
||||||
|
(Nicolás Ojeda Bär, report by Xavier Leroy, review by Xavier Leroy)
|
||||||
|
|
||||||
### Code generation and optimizations:
|
### Code generation and optimizations:
|
||||||
|
|
||||||
- #9551: ocamlc no longer loads DLLs at link time to check that
|
- #9551: ocamlc no longer loads DLLs at link time to check that
|
||||||
|
@ -108,11 +136,19 @@ Working version
|
||||||
so that the ARM64 iOS/macOS calling conventions can be honored.
|
so that the ARM64 iOS/macOS calling conventions can be honored.
|
||||||
(Xavier Leroy, review by Mark Shinwell and Github user @EduardoRFS)
|
(Xavier Leroy, review by Mark Shinwell and Github user @EduardoRFS)
|
||||||
|
|
||||||
|
- #9838: Ensure that Cmm immediates are generated as Cconst_int where
|
||||||
|
possible, improving instruction selection.
|
||||||
|
(Stephen Dolan, review by Leo White and Xavier Leroy)
|
||||||
|
|
||||||
### Standard library:
|
### Standard library:
|
||||||
|
|
||||||
- #9781: add injectivity annotations to parameterized abstract types
|
- #9781: add injectivity annotations to parameterized abstract types
|
||||||
(Jeremy Yallop, review by Nicolás Ojeda Bär)
|
(Jeremy Yallop, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
* #9765: add init functions to Bigarray.
|
||||||
|
(Jeremy Yallop, review by Gabriel Scherer, Nicolás Ojeda Bär, and
|
||||||
|
Xavier Leroy)
|
||||||
|
|
||||||
* #9554: add primitive __FUNCTION__ that returns the name of the current method
|
* #9554: add primitive __FUNCTION__ that returns the name of the current method
|
||||||
or function, including any enclosing module or class.
|
or function, including any enclosing module or class.
|
||||||
(Nicolás Ojeda Bär, Stephen Dolan, review by Stephen Dolan)
|
(Nicolás Ojeda Bär, Stephen Dolan, review by Stephen Dolan)
|
||||||
|
@ -131,6 +167,14 @@ Working version
|
||||||
- #9571: Make at_exit and Printexc.register_printer thread-safe.
|
- #9571: Make at_exit and Printexc.register_printer thread-safe.
|
||||||
(Guillaume Munch-Maccagnoni, review by Gabriel Scherer and Xavier Leroy)
|
(Guillaume Munch-Maccagnoni, review by Gabriel Scherer and Xavier Leroy)
|
||||||
|
|
||||||
|
- #9066: a new Either module with
|
||||||
|
type 'a Either.t = Left of 'a | Right of 'b
|
||||||
|
(Gabriel Scherer, review by Daniel Bünzli, Thomas Refis, Jeremy Yallop)
|
||||||
|
|
||||||
|
- #9066: List.partition_map :
|
||||||
|
('a -> ('b, 'c) Either.t) -> 'a list -> 'b list * 'c list
|
||||||
|
(Gabriel Scherer, review by Jeremy Yallop)
|
||||||
|
|
||||||
- #9587: Arg: new Rest_all spec to get all rest arguments in a list
|
- #9587: Arg: new Rest_all spec to get all rest arguments in a list
|
||||||
(this is similar to Rest, but makes it possible to detect when there
|
(this is similar to Rest, but makes it possible to detect when there
|
||||||
are no arguments (an empty list) after the rest marker)
|
are no arguments (an empty list) after the rest marker)
|
||||||
|
@ -148,12 +192,21 @@ Working version
|
||||||
- #9663: Extend Printexc API for raw backtrace entries.
|
- #9663: Extend Printexc API for raw backtrace entries.
|
||||||
(Stephen Dolan, review by Nicolás Ojeda Bär and Gabriel Scherer)
|
(Stephen Dolan, review by Nicolás Ojeda Bär and Gabriel Scherer)
|
||||||
|
|
||||||
|
* #9668: List.equal, List.compare
|
||||||
|
(This could break code using "open List" by shadowing
|
||||||
|
Stdlib.{equal,compare}.)
|
||||||
|
(Gabriel Scherer, review by Nicolás Ojeda Bär, Daniel Bünzli and Alain Frisch)
|
||||||
|
|
||||||
- #9763: Add function Hashtbl.rebuild to convert from old hash table
|
- #9763: Add function Hashtbl.rebuild to convert from old hash table
|
||||||
formats (that may have been saved to persistent storage) to the
|
formats (that may have been saved to persistent storage) to the
|
||||||
current hash table format. Remove leftover support for the hash
|
current hash table format. Remove leftover support for the hash
|
||||||
table format and generic hash function that were in use before OCaml 4.00.
|
table format and generic hash function that were in use before OCaml 4.00.
|
||||||
(Xavier Leroy, review by Nicolás Ojeda Bär)
|
(Xavier Leroy, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
- #9797: Add Sys.mkdir and Sys.rmdir.
|
||||||
|
(David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and
|
||||||
|
Xavier Leroy)
|
||||||
|
|
||||||
### Other libraries:
|
### Other libraries:
|
||||||
|
|
||||||
* #9206, #9419: update documentation of the threads library;
|
* #9206, #9419: update documentation of the threads library;
|
||||||
|
@ -177,6 +230,16 @@ Working version
|
||||||
error handling when Unix.symlink is unavailable)
|
error handling when Unix.symlink is unavailable)
|
||||||
(David Allsopp, review by Xavier Leroy)
|
(David Allsopp, review by Xavier Leroy)
|
||||||
|
|
||||||
|
- #9338, #9790: Dynlink: make sure *_units () functions report accurate
|
||||||
|
information before the first load.
|
||||||
|
(Daniel Bünzli, review by Xavier Leroy and Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
- #9802: Ensure signals are handled before Unix.kill returns
|
||||||
|
(Stephen Dolan, review by Jacques-Henri Jourdan)
|
||||||
|
|
||||||
|
- #9869: Add Unix.SO_REUSEPORT
|
||||||
|
(Yishuai Li, review by Xavier Leroy)
|
||||||
|
|
||||||
### Tools:
|
### Tools:
|
||||||
|
|
||||||
- #9551: ocamlobjinfo is now able to display information on .cmxs shared
|
- #9551: ocamlobjinfo is now able to display information on .cmxs shared
|
||||||
|
@ -189,6 +252,10 @@ Working version
|
||||||
(Xavier Leroy, report by Jacques Garrigue and Virgile Prevosto,
|
(Xavier Leroy, report by Jacques Garrigue and Virgile Prevosto,
|
||||||
review by David Allsopp and Jacques-Henri Jourdan)
|
review by David Allsopp and Jacques-Henri Jourdan)
|
||||||
|
|
||||||
|
* #9299, #9795: ocamldep: do not process files during cli parsing. Fixes
|
||||||
|
various broken cli behaviours.
|
||||||
|
(Daniel Bünzli, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
### Manual and documentation:
|
### Manual and documentation:
|
||||||
|
|
||||||
- #9468: HACKING.adoc: using dune to get merlin's support
|
- #9468: HACKING.adoc: using dune to get merlin's support
|
||||||
|
@ -235,12 +302,19 @@ Working version
|
||||||
(Nicolás Ojeda Bär, review by Gabriel Scherer, Florian Angeletti and Leo
|
(Nicolás Ojeda Bär, review by Gabriel Scherer, Florian Angeletti and Leo
|
||||||
White)
|
White)
|
||||||
|
|
||||||
|
- #9751: Add warning 68. Pattern-matching depending on mutable state
|
||||||
|
prevents the remaining arguments from being uncurried.
|
||||||
|
(Hugo Heuzard, review by Leo White)
|
||||||
|
|
||||||
### Internal/compiler-libs changes:
|
### Internal/compiler-libs changes:
|
||||||
|
|
||||||
- #9216: add Lambda.duplicate which refreshes bound identifiers
|
- #9216: add Lambda.duplicate which refreshes bound identifiers
|
||||||
(Gabriel Scherer, review by Pierre Chambart and Vincent Laviron)
|
(Gabriel Scherer, review by Pierre Chambart and Vincent Laviron)
|
||||||
|
|
||||||
- #9493, #9520, #9563, #9599, #9608, #9647: refactor
|
- #9376: Remove spurious Ptop_defs from #use
|
||||||
|
(Leo White, review by Damien Doligez)
|
||||||
|
|
||||||
|
- #9464, #9493, #9520, #9563, #9599, #9608, #9647: refactor
|
||||||
the pattern-matching compiler
|
the pattern-matching compiler
|
||||||
(Thomas Refis and Gabriel Scherer, review by Florian Angeletti)
|
(Thomas Refis and Gabriel Scherer, review by Florian Angeletti)
|
||||||
|
|
||||||
|
@ -276,6 +350,25 @@ Working version
|
||||||
attributes are present.
|
attributes are present.
|
||||||
(Matthew Ryan, review by Nicolás Ojeda Bär)
|
(Matthew Ryan, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
- #9797, #9849: Eliminate the routine use of external commands in ocamltest.
|
||||||
|
ocamltest no longer calls the mkdir, rm and ln external commands (at present,
|
||||||
|
the only external command ocamltest uses is diff).
|
||||||
|
(David Allsopp, review by Nicolás Ojeda Bär, Sébastien Hinderer and
|
||||||
|
Xavier Leroy)
|
||||||
|
|
||||||
|
- #9801: Don't ignore EOL-at-EOF differences in ocamltest.
|
||||||
|
(David Allsopp, review by Damien Doligez, much input and thought from
|
||||||
|
Daniel Bünzli, Damien Doligez, Sébastien Hinderer, and Xavier Leroy)
|
||||||
|
|
||||||
|
- #9889: more caching when printing types with -short-path.
|
||||||
|
(Florian Angeletti, review by Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9591: fix pprint of polyvariants that start with a core_type, closed,
|
||||||
|
not low (Chet Murthy, review by Florian Angeletti)
|
||||||
|
|
||||||
|
- #9590: fix pprint of extension constructors (and exceptions) that rebind
|
||||||
|
(Chet Murthy, review by octachron@)
|
||||||
|
|
||||||
### Build system:
|
### Build system:
|
||||||
|
|
||||||
- #7121, #9558: Always the autoconf-discovered ld in PACKLD. For
|
- #7121, #9558: Always the autoconf-discovered ld in PACKLD. For
|
||||||
|
@ -292,6 +385,12 @@ Working version
|
||||||
to avoid C dependency recomputation.
|
to avoid C dependency recomputation.
|
||||||
(Gabriel Scherer, review by David Allsopp)
|
(Gabriel Scherer, review by David Allsopp)
|
||||||
|
|
||||||
|
- #9804: Build C stubs of libraries in otherlibs/ with debug info.
|
||||||
|
(Stephen Dolan, review by Sébastien Hinderer and David Allsopp)
|
||||||
|
|
||||||
|
- #9824, #9837: Honour the CFLAGS and CPPFLAGS variables.
|
||||||
|
(Sébastien Hinderer, review by David Allsopp)
|
||||||
|
|
||||||
### Bug fixes:
|
### Bug fixes:
|
||||||
|
|
||||||
- #7902, #9556: Type-checker infers recursive type, even though -rectypes is
|
- #7902, #9556: Type-checker infers recursive type, even though -rectypes is
|
||||||
|
@ -301,6 +400,13 @@ Working version
|
||||||
- #8747, #9709: incorrect principality warning on functional updates of records
|
- #8747, #9709: incorrect principality warning on functional updates of records
|
||||||
(Jacques Garrigue, report and review by Thomas Refis)
|
(Jacques Garrigue, report and review by Thomas Refis)
|
||||||
|
|
||||||
|
- #9421, #9427: fix printing of (::) in ocamldoc
|
||||||
|
(Florian Angeletti, report by Yawar Amin, review by Damien Doligez)
|
||||||
|
|
||||||
|
- #9440: for a type extension constructor with parameterised arguments,
|
||||||
|
REPL displayed <poly> for each as opposed to the concrete values used.
|
||||||
|
(Christian Quinn, review by Gabriel Scherer)
|
||||||
|
|
||||||
- #9469: Better backtraces for lazy values
|
- #9469: Better backtraces for lazy values
|
||||||
(Leo White, review by Nicolás Ojeda Bär)
|
(Leo White, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
@ -322,51 +428,72 @@ Working version
|
||||||
(Xavier Leroy, Sadiq Jaffer, Gabriel Scherer,
|
(Xavier Leroy, Sadiq Jaffer, Gabriel Scherer,
|
||||||
review by Xavier Leroy and Jacques-Henri Jourdan)
|
review by Xavier Leroy and Jacques-Henri Jourdan)
|
||||||
|
|
||||||
- #9714, #9724: Use the C++ alignas keyword when compiling in C++.
|
- #9759, #9767: Spurious GADT ambiguity without -principal
|
||||||
Fixes a bug with MSVC C++ 2015/2017. Add a terminator to the
|
(Jacques Garrigue, report by Thomas Refis,
|
||||||
`caml_domain_state` structure to better ensure that members are
|
review by Thomas Refis and Gabriel Scherer)
|
||||||
correctly spaced.
|
|
||||||
(Antonin Décimo, review by David Allsopp and Xavier Leroy)
|
|
||||||
|
|
||||||
OCaml 4.11
|
- #9825, #9830: the C global variable caml_fl_merge and the C function
|
||||||
----------
|
caml_spacetime_my_profinfo (bytecode version) were declared and
|
||||||
|
defined with different types. This is undefined behavior and
|
||||||
|
cancause link-time errors with link-time optimization (LTO).
|
||||||
|
(Xavier Leroy, report by Richard Jones, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
- #9753: fix build for Android
|
||||||
|
(Github user @EduardoRFS, review by Xavier Leroy)
|
||||||
|
|
||||||
|
- #9848, #9855: Fix double free of bytecode in toplevel
|
||||||
|
(Stephen Dolan, report by Sampsa Kiiskinen, review by Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9860: wrong range constraint for subtract immediate on zSystems / s390x
|
||||||
|
(Xavier Leroy, review by Stephen Dolan)
|
||||||
|
|
||||||
|
- #9868, #9872, #9892: bugs in {in,out}_channel_length and seek_in
|
||||||
|
for files opened in text mode under Windows
|
||||||
|
(Xavier Leroy, report by Alain Frisch, review by Nicolás Ojeda Bär
|
||||||
|
and Alain Frisch)
|
||||||
|
|
||||||
|
|
||||||
|
OCaml 4.11.1
|
||||||
|
------------
|
||||||
|
|
||||||
|
### Bug fixes:
|
||||||
|
|
||||||
|
- #9856, #9857: Prevent polymorphic type annotations from generalizing
|
||||||
|
weak polymorphic variables.
|
||||||
|
(Leo White, review by Jacques Garrigue)
|
||||||
|
|
||||||
|
- #9859, #9862: Remove an erroneous assertion when inferred function types
|
||||||
|
appear in the right hand side of an explicit :> coercion
|
||||||
|
(Florian Angeletti, review by Thomas Refis)
|
||||||
|
|
||||||
|
OCaml 4.11.0 (19 August 2020)
|
||||||
|
---------------------------
|
||||||
|
|
||||||
(Changes that can break existing programs are marked with a "*")
|
(Changes that can break existing programs are marked with a "*")
|
||||||
|
|
||||||
### Language features
|
|
||||||
|
|
||||||
- #8820, #9166: quoted extensions: {%foo|...|} is lighter syntax for
|
|
||||||
[%foo {||}], and {%foo bar|...|bar} for [%foo {bar|...|bar}].
|
|
||||||
(Gabriel Radanne, Leo White, Gabriel Scherer and Pieter Goetschalckx,
|
|
||||||
request by Bikal Lem)
|
|
||||||
|
|
||||||
- #6673, #1132, #9617: Relax the handling of explicit polymorphic types
|
|
||||||
(Leo White, review by Jacques Garrigue and Gabriel Scherer)
|
|
||||||
|
|
||||||
- #9232: allow any class type paths in #-types,
|
|
||||||
For instance, "val f: #F(X).t -> unit" is now allowed.
|
|
||||||
(Florian Angeletti, review by Gabriel Scherer, suggestion by Leo White)
|
|
||||||
|
|
||||||
- #7364, #2188, #9592, #9609: improvement of the unboxability check for types
|
|
||||||
with a single constructor. Mutually-recursive type declarations can
|
|
||||||
now contain unboxed types. This is based on the paper
|
|
||||||
https://arxiv.org/abs/1811.02300
|
|
||||||
(Gabriel Scherer and Rodolphe Lepigre,
|
|
||||||
review by Jeremy Yallop, Damien Doligez and Frédéric Bour)
|
|
||||||
|
|
||||||
- #1154, #1706: spellchecker hints and type-directed disambiguation
|
|
||||||
for extensible sum type constructors
|
|
||||||
(Florian Angeletti, review by Alain Frisch, Gabriel Radanne, Gabriel Scherer
|
|
||||||
and Leo White)
|
|
||||||
|
|
||||||
### Runtime system:
|
### Runtime system:
|
||||||
|
|
||||||
- #9096: Print function names in backtraces.
|
- #9096: Print function names in backtraces.
|
||||||
|
Old output:
|
||||||
|
> Called from file "foo.ml", line 16, characters 42-53
|
||||||
|
New output:
|
||||||
|
> Called from Foo.bar in file "foo.ml", line 16, characters 42-53
|
||||||
(Stephen Dolan, review by Leo White and Mark Shinwell)
|
(Stephen Dolan, review by Leo White and Mark Shinwell)
|
||||||
|
|
||||||
- #9119: Make [caml_stat_resize_noexc] compatible with the [realloc]
|
- #9082: The instrumented runtime now records logs in the CTF format.
|
||||||
API when the old block is NULL.
|
A new API is available in the runtime to collect runtime statistics,
|
||||||
(Jacques-Henri Jourdan, review by Xavier Leroy)
|
replacing the previous instrumented runtime macros.
|
||||||
|
Gc.eventlog_pause and Gc.eventlog_resume were added to allow user to control
|
||||||
|
instrumentation in a running program.
|
||||||
|
See the manual for more information on how to use this instrumentation mode.
|
||||||
|
(Enguerrand Decorne and Stephen Dolan, with help and review from
|
||||||
|
David Allsopp, Sébastien Hinderer, review by Anil Madhavapeddy,
|
||||||
|
Nicolás Ojeda Bär, Shakthi Kannan, KC Sivaramakrishnan, Gabriel Scherer,
|
||||||
|
Guillaume Munch-Maccagnoni, Damien Doligez, Leo White, Daniel Bünzli
|
||||||
|
and Xavier Leroy)
|
||||||
|
|
||||||
|
- #9230, #9362: Memprof support for native allocations.
|
||||||
|
(Jacques-Henri Jourdan and Stephen Dolan, review by Gabriel Scherer)
|
||||||
|
|
||||||
- #8920, #9238, #9239, #9254, #9458: New API for statistical memory profiling
|
- #8920, #9238, #9239, #9254, #9458: New API for statistical memory profiling
|
||||||
in Memprof.Gc. The new version does no longer use ephemerons and allows
|
in Memprof.Gc. The new version does no longer use ephemerons and allows
|
||||||
|
@ -376,12 +503,20 @@ OCaml 4.11
|
||||||
(Stephen Dolan and Jacques-Henri Jourdan, review by Damien Doligez
|
(Stephen Dolan and Jacques-Henri Jourdan, review by Damien Doligez
|
||||||
and Gabriel Scherer)
|
and Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9353: Reimplement `output_value` and the `Marshal.to_*` functions
|
||||||
|
using a hash table to detect sharing, instead of temporary in-place
|
||||||
|
modifications. This is a prerequisite for Multicore OCaml.
|
||||||
|
(Xavier Leroy and Basile Clément, review by Gabriel Scherer and
|
||||||
|
Stephen Dolan)
|
||||||
|
|
||||||
|
|
||||||
|
- #9119: Make [caml_stat_resize_noexc] compatible with the [realloc]
|
||||||
|
API when the old block is NULL.
|
||||||
|
(Jacques-Henri Jourdan, review by Xavier Leroy)
|
||||||
|
|
||||||
- #9233: Restore the bytecode stack after an allocation.
|
- #9233: Restore the bytecode stack after an allocation.
|
||||||
(Stephen Dolan, review by Gabriel Scherer and Jacques-Henri Jourdan)
|
(Stephen Dolan, review by Gabriel Scherer and Jacques-Henri Jourdan)
|
||||||
|
|
||||||
- #9230, #9362: Memprof support for native allocations.
|
|
||||||
(Jacques-Henri Jourdan and Stephen Dolan, review by Gabriel Scherer)
|
|
||||||
|
|
||||||
- #9249: restore definition of ARCH_ALIGN_INT64 in m.h if the architecture
|
- #9249: restore definition of ARCH_ALIGN_INT64 in m.h if the architecture
|
||||||
requires 64-bit integers to be double-word aligned (autoconf regression)
|
requires 64-bit integers to be double-word aligned (autoconf regression)
|
||||||
(David Allsopp, review by Sébastien Hinderer)
|
(David Allsopp, review by Sébastien Hinderer)
|
||||||
|
@ -398,11 +533,6 @@ OCaml 4.11
|
||||||
- #9280: Micro-optimise allocations on amd64 to save a register.
|
- #9280: Micro-optimise allocations on amd64 to save a register.
|
||||||
(Stephen Dolan, review by Xavier Leroy)
|
(Stephen Dolan, review by Xavier Leroy)
|
||||||
|
|
||||||
- #9316, #9443, #9463, #9782: Use typing information from Clambda
|
|
||||||
for mutable Cmm variables.
|
|
||||||
(Stephen Dolan, review by Vincent Laviron, Guillaume Bury, Xavier Leroy,
|
|
||||||
and Gabriel Scherer; temporary bug report by Richard Jones)
|
|
||||||
|
|
||||||
- #9426: build the Mingw ports with higher levels of GCC optimization
|
- #9426: build the Mingw ports with higher levels of GCC optimization
|
||||||
(Xavier Leroy, review by Sébastien Hinderer)
|
(Xavier Leroy, review by Sébastien Hinderer)
|
||||||
|
|
||||||
|
@ -410,12 +540,6 @@ OCaml 4.11
|
||||||
The only release with the inclusion of stdio.h has been 4.10.0
|
The only release with the inclusion of stdio.h has been 4.10.0
|
||||||
(Christopher Zimmermann, review by Xavier Leroy and David Allsopp)
|
(Christopher Zimmermann, review by Xavier Leroy and David Allsopp)
|
||||||
|
|
||||||
- #9353: Reimplement `output_value` and the `Marshal.to_*` functions
|
|
||||||
using a hash table to detect sharing, instead of temporary in-place
|
|
||||||
modifications. This is a prerequisite for Multicore OCaml.
|
|
||||||
(Xavier Leroy and Basile Clément, review by Gabriel Scherer and
|
|
||||||
Stephen Dolan)
|
|
||||||
|
|
||||||
- #9282: Make Cconst_symbol have typ_int to fix no-naked-pointers mode.
|
- #9282: Make Cconst_symbol have typ_int to fix no-naked-pointers mode.
|
||||||
(Stephen Dolan, review by Mark Shinwell, Xavier Leroy and Vincent Laviron)
|
(Stephen Dolan, review by Mark Shinwell, Xavier Leroy and Vincent Laviron)
|
||||||
|
|
||||||
|
@ -428,40 +552,66 @@ OCaml 4.11
|
||||||
avoiding overflow.
|
avoiding overflow.
|
||||||
(Jeremy Yallop, Stephen Dolan, review by Xavier Leroy)
|
(Jeremy Yallop, Stephen Dolan, review by Xavier Leroy)
|
||||||
|
|
||||||
- #9082: The instrumented runtime now records logs in the CTF format.
|
|
||||||
A new API is available in the runtime to collect runtime statistics,
|
|
||||||
replacing the previous instrumented runtime macros.
|
|
||||||
Gc.eventlog_pause and Gc.eventlog_resume were added to allow user to control
|
|
||||||
instrumentation in a running program.
|
|
||||||
(Enguerrand Decorne and Stephen Dolan, with help and review from
|
|
||||||
David Allsopp, Sébastien Hinderer, review by Anil Madhavapeddy,
|
|
||||||
Nicolás Ojeda Bär, Shakthi Kannan, KC Sivaramakrishnan, Gabriel Scherer,
|
|
||||||
Guillaume Munch-Maccagnoni, Damien Doligez, Leo White, Daniel Bünzli
|
|
||||||
and Xavier Leroy)
|
|
||||||
|
|
||||||
### Code generation and optimizations:
|
### Code generation and optimizations:
|
||||||
|
|
||||||
|
- #9441: Add RISC-V RV64G native-code backend.
|
||||||
|
(Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9316, #9443, #9463, #9782: Use typing information from Clambda
|
||||||
|
for mutable Cmm variables.
|
||||||
|
(Stephen Dolan, review by Vincent Laviron, Guillaume Bury, Xavier Leroy,
|
||||||
|
and Gabriel Scherer; temporary bug report by Richard Jones)
|
||||||
|
|
||||||
- #8637, #8805, #9247, #9296: Record debug info for each allocation.
|
- #8637, #8805, #9247, #9296: Record debug info for each allocation.
|
||||||
(Stephen Dolan and Jacques-Henri Jourdan, review by Damien Doligez,
|
(Stephen Dolan and Jacques-Henri Jourdan, review by Damien Doligez,
|
||||||
KC Sivaramakrishnan and Xavier Leroy)
|
KC Sivaramakrishnan and Xavier Leroy)
|
||||||
|
|
||||||
|
|
||||||
- #9193: Make tuple matching optimisation apply to Lswitch and Lstringswitch.
|
- #9193: Make tuple matching optimisation apply to Lswitch and Lstringswitch.
|
||||||
(Stephen Dolan, review by Thomas Refis and Gabriel Scherer)
|
(Stephen Dolan, review by Thomas Refis and Gabriel Scherer)
|
||||||
|
|
||||||
- #9392: Visit registers at most once in Coloring.iter_preferred.
|
- #9392: Visit registers at most once in Coloring.iter_preferred.
|
||||||
(Stephen Dolan, review by Pierre Chambart and Xavier Leroy)
|
(Stephen Dolan, review by Pierre Chambart and Xavier Leroy)
|
||||||
|
|
||||||
- #9441: Add RISC-V RV64G native-code backend.
|
- #9549, #9557: Make -flarge-toc the default for PowerPC and introduce
|
||||||
(Nicolás Ojeda Bär, review by Xavier Leroy and Gabriel Scherer)
|
-fsmall-toc to enable the previous behaviour.
|
||||||
|
(David Allsopp, report by Nathaniel Wesley Filardo, review by Xavier Leroy)
|
||||||
|
|
||||||
|
### Language features
|
||||||
|
|
||||||
|
- #8820, #9166: quoted extensions: {%foo|...|} is lighter syntax for
|
||||||
|
[%foo {||}], and {%foo bar|...|bar} for [%foo {bar|...|bar}].
|
||||||
|
(Gabriel Radanne, Leo White, Gabriel Scherer and Pieter Goetschalckx,
|
||||||
|
request by Bikal Lem)
|
||||||
|
|
||||||
|
- #7364, #2188, #9592, #9609: improvement of the unboxability check for types
|
||||||
|
with a single constructor. Mutually-recursive type declarations can
|
||||||
|
now contain unboxed types. This is based on the paper
|
||||||
|
https://arxiv.org/abs/1811.02300
|
||||||
|
(Gabriel Scherer and Rodolphe Lepigre,
|
||||||
|
review by Jeremy Yallop, Damien Doligez and Frédéric Bour)
|
||||||
|
|
||||||
|
- #1154, #1706: spellchecker hints and type-directed disambiguation
|
||||||
|
for extensible sum type constructors
|
||||||
|
(Florian Angeletti, review by Alain Frisch, Gabriel Radanne, Gabriel Scherer
|
||||||
|
and Leo White)
|
||||||
|
|
||||||
|
|
||||||
|
- #6673, #1132, #9617: Relax the handling of explicit polymorphic types.
|
||||||
|
This improves error messages in some polymorphic recursive definition,
|
||||||
|
and requires less polymorphic annotations in some cases of
|
||||||
|
mutually-recursive definitions involving polymorphic recursion.
|
||||||
|
(Leo White, review by Jacques Garrigue and Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9232: allow any class type paths in #-types,
|
||||||
|
For instance, "val f: #F(X).t -> unit" is now allowed.
|
||||||
|
(Florian Angeletti, review by Gabriel Scherer, suggestion by Leo White)
|
||||||
|
|
||||||
### Standard library:
|
### Standard library:
|
||||||
|
|
||||||
- #9077: Add Seq.cons and Seq.append
|
- #9077: Add Seq.cons and Seq.append
|
||||||
(Sébastien Briais, review by Yawar Amin and Florian Angeletti)
|
(Sébastien Briais, review by Yawar Amin and Florian Angeletti)
|
||||||
|
|
||||||
- #9248: Add Printexc.default_uncaught_exception_handler
|
|
||||||
(Raphael Sousa Santos, review by Daniel Bünzli)
|
|
||||||
|
|
||||||
- #9235: Add Array.exists2 and Array.for_all2
|
- #9235: Add Array.exists2 and Array.for_all2
|
||||||
(Bernhard Schommer, review by Armaël Guéneau)
|
(Bernhard Schommer, review by Armaël Guéneau)
|
||||||
|
|
||||||
|
@ -469,11 +619,6 @@ OCaml 4.11
|
||||||
(Jeremy Yallop, review by Hezekiah M. Carty, Gabriel Scherer and
|
(Jeremy Yallop, review by Hezekiah M. Carty, Gabriel Scherer and
|
||||||
Gabriel Radanne)
|
Gabriel Radanne)
|
||||||
|
|
||||||
- #8771: Lexing: add set_position and set_filename to change (fake)
|
|
||||||
the initial tracking position of the lexbuf.
|
|
||||||
(Konstantin Romanov, Miguel Lumapat, review by Gabriel Scherer,
|
|
||||||
Sébastien Hinderer, and David Allsopp)
|
|
||||||
|
|
||||||
- #9059: Added List.filteri function, same as List.filter but
|
- #9059: Added List.filteri function, same as List.filter but
|
||||||
with the index of the element.
|
with the index of the element.
|
||||||
(Léo Andrès, review by Alain Frisch)
|
(Léo Andrès, review by Alain Frisch)
|
||||||
|
@ -481,6 +626,18 @@ OCaml 4.11
|
||||||
- #8894: Added List.fold_left_map function combining map and fold.
|
- #8894: Added List.fold_left_map function combining map and fold.
|
||||||
(Bernhard Schommer, review by Alain Frisch and github user @cfcs)
|
(Bernhard Schommer, review by Alain Frisch and github user @cfcs)
|
||||||
|
|
||||||
|
- #9365: Set.filter_map and Map.filter_map
|
||||||
|
(Gabriel Scherer, review by Stephen Dolan and Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
|
||||||
|
- #9248: Add Printexc.default_uncaught_exception_handler
|
||||||
|
(Raphael Sousa Santos, review by Daniel Bünzli)
|
||||||
|
|
||||||
|
- #8771: Lexing: add set_position and set_filename to change (fake)
|
||||||
|
the initial tracking position of the lexbuf.
|
||||||
|
(Konstantin Romanov, Miguel Lumapat, review by Gabriel Scherer,
|
||||||
|
Sébastien Hinderer, and David Allsopp)
|
||||||
|
|
||||||
- #9237: `Format.pp_update_geometry ppf (fun geo -> {geo with ...})`
|
- #9237: `Format.pp_update_geometry ppf (fun geo -> {geo with ...})`
|
||||||
for formatter geometry changes that are robust to new geometry fields.
|
for formatter geometry changes that are robust to new geometry fields.
|
||||||
(Gabriel Scherer, review by Josh Berdine and Florian Angeletti)
|
(Gabriel Scherer, review by Josh Berdine and Florian Angeletti)
|
||||||
|
@ -488,23 +645,12 @@ OCaml 4.11
|
||||||
- #7110: Added Printf.ikbprintf and Printf.ibprintf
|
- #7110: Added Printf.ikbprintf and Printf.ibprintf
|
||||||
(Muskan Garg, review by Gabriel Scherer and Florian Angeletti)
|
(Muskan Garg, review by Gabriel Scherer and Florian Angeletti)
|
||||||
|
|
||||||
- #9365: Set.filter_map and Map.filter_map
|
|
||||||
(Gabriel Scherer, review by Stephen Dolan and Nicolás Ojeda Bär)
|
|
||||||
|
|
||||||
- #9266: Install pretty-printer for the exception Fun.Finally_raised.
|
- #9266: Install pretty-printer for the exception Fun.Finally_raised.
|
||||||
(Guillaume Munch-Maccagnoni, review by Daniel Bünzli, Gabriel Radanne,
|
(Guillaume Munch-Maccagnoni, review by Daniel Bünzli, Gabriel Radanne,
|
||||||
and Gabriel Scherer)
|
and Gabriel Scherer)
|
||||||
|
|
||||||
- #9549, #9557: Make -flarge-toc the default for PowerPC and introduce
|
|
||||||
-fsmall-toc to enable the previous behaviour.
|
|
||||||
(David Allsopp, report by Nathaniel Wesley Filardo, review by Xavier Leroy)
|
|
||||||
|
|
||||||
### Other libraries:
|
### Other libraries:
|
||||||
|
|
||||||
- #9338: Dynlink: make sure *_units () functions report accurate information
|
|
||||||
before the first load.
|
|
||||||
(Daniel Bünzli, review by Xavier Leroy and Nicolás Ojeda Bär)
|
|
||||||
|
|
||||||
- #9106: Register printer for Unix_error in win32unix, as in unix.
|
- #9106: Register printer for Unix_error in win32unix, as in unix.
|
||||||
(Christopher Zimmermann, review by David Allsopp)
|
(Christopher Zimmermann, review by David Allsopp)
|
||||||
|
|
||||||
|
@ -524,9 +670,10 @@ OCaml 4.11
|
||||||
|
|
||||||
### Tools:
|
### Tools:
|
||||||
|
|
||||||
* #9299: ocamldep: do not process files during cli parsing. Fixes
|
- #9283, #9455, #9457: add a new toplevel directive `#use_output "<command>"` to
|
||||||
various broken cli behaviours.
|
run a command and evaluate its output.
|
||||||
(Daniel Bünzli, review by Nicolás Ojeda Bär)
|
(Jérémie Dimino, review by David Allsopp)
|
||||||
|
|
||||||
|
|
||||||
- #6969: Argument -nocwd added to ocamldep
|
- #6969: Argument -nocwd added to ocamldep
|
||||||
(Muskan Garg, review by Florian Angeletti)
|
(Muskan Garg, review by Florian Angeletti)
|
||||||
|
@ -547,10 +694,6 @@ OCaml 4.11
|
||||||
from a different (older or newer), incompatible compiler version.
|
from a different (older or newer), incompatible compiler version.
|
||||||
(Gabriel Scherer, review by Gabriel Radanne and Damien Doligez)
|
(Gabriel Scherer, review by Gabriel Radanne and Damien Doligez)
|
||||||
|
|
||||||
- #9181: make objinfo work on Cygwin and look for the caml_plugin_header
|
|
||||||
symbol in both the static and the dynamic symbol tables.
|
|
||||||
(Sébastien Hinderer, review by Gabriel Scherer and David Allsopp)
|
|
||||||
|
|
||||||
* #9197: remove compatibility logic from #244 that was designed to
|
* #9197: remove compatibility logic from #244 that was designed to
|
||||||
synchronize toplevel printing margins with Format.std_formatter,
|
synchronize toplevel printing margins with Format.std_formatter,
|
||||||
but also resulted in unpredictable/fragile changes to formatter
|
but also resulted in unpredictable/fragile changes to formatter
|
||||||
|
@ -568,29 +711,12 @@ OCaml 4.11
|
||||||
points to the grammar.
|
points to the grammar.
|
||||||
(Andreas Abel, review by Xavier Leroy)
|
(Andreas Abel, review by Xavier Leroy)
|
||||||
|
|
||||||
- #9283, #9455, #9457: add a new toplevel directive `#use_output "<command>"` to
|
|
||||||
run a command and evaluate its output.
|
|
||||||
(Jérémie Dimino, review by David Allsopp)
|
|
||||||
|
|
||||||
- #9402: Remove `sudo:false` from .travis.yml
|
|
||||||
(Hikaru Yoshimura)
|
|
||||||
|
|
||||||
- #9414: testsuite, ocamltest: keep test artifacts only on failure.
|
|
||||||
Use KEEP_TEST_DIR_ON_SUCCESS=1 to keep all artifacts.
|
|
||||||
(Gabriel Scherer, review by Sébastien Hinderer)
|
|
||||||
|
|
||||||
- #9482, #9492: use diversions (@file) to work around OS limitations
|
- #9482, #9492: use diversions (@file) to work around OS limitations
|
||||||
on length of Sys.command argument.
|
on length of Sys.command argument.
|
||||||
(Xavier Leroy, report by Jérémie Dimino, review by David Allsopp)
|
(Xavier Leroy, report by Jérémie Dimino, review by David Allsopp)
|
||||||
|
|
||||||
- #9552: restore ocamloptp build and installation
|
|
||||||
(Florian Angeletti, review by David Allsopp and Xavier Leroy)
|
|
||||||
|
|
||||||
### Manual and documentation:
|
### Manual and documentation:
|
||||||
|
|
||||||
- #8644: fix formatting comment about @raise in stdlib's mli files
|
|
||||||
(Élie Brami, review by David Allsopp)
|
|
||||||
|
|
||||||
- #9141: beginning of the ocamltest reference manual
|
- #9141: beginning of the ocamltest reference manual
|
||||||
(Sébastien Hinderer, review by Gabriel Scherer and Thomas Refis)
|
(Sébastien Hinderer, review by Gabriel Scherer and Thomas Refis)
|
||||||
|
|
||||||
|
@ -605,12 +731,8 @@ OCaml 4.11
|
||||||
- #9325: documented base case for `List.for_all` and `List.exists`
|
- #9325: documented base case for `List.for_all` and `List.exists`
|
||||||
(Glenn Slotte, review by Florian Angeletti)
|
(Glenn Slotte, review by Florian Angeletti)
|
||||||
|
|
||||||
- #9403: added a description for warning 67 and added a "." at the end of
|
- #9410, #9422: replaced naive fibonacci example with gcd
|
||||||
warnings for consistency.
|
(Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès)
|
||||||
(Muskan Garg, review by Gabriel Scherer and Florian Angeletti)
|
|
||||||
|
|
||||||
- #7708, #9580: Ensure Stdlib documentation index refers to Stdlib.
|
|
||||||
(Stephen Dolan, review by Florian Angeletti, report by Hannes Mehnert)
|
|
||||||
|
|
||||||
- #9541: Add a documentation page for the instrumented runtime;
|
- #9541: Add a documentation page for the instrumented runtime;
|
||||||
additional changes to option names in the instrumented runtime.
|
additional changes to option names in the instrumented runtime.
|
||||||
|
@ -626,12 +748,41 @@ OCaml 4.11
|
||||||
limit
|
limit
|
||||||
(Florian Angeletti, review by Josh Berdine)
|
(Florian Angeletti, review by Josh Berdine)
|
||||||
|
|
||||||
|
|
||||||
|
- #8644: fix formatting comment about @raise in stdlib's mli files
|
||||||
|
(Élie Brami, review by David Allsopp)
|
||||||
|
|
||||||
|
- #9327, #9401: manual, fix infix attribute examples
|
||||||
|
(Florian Angeletti, report by David Cadé, review by Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9403: added a description for warning 67 and added a "." at the end of
|
||||||
|
warnings for consistency.
|
||||||
|
(Muskan Garg, review by Gabriel Scherer and Florian Angeletti)
|
||||||
|
|
||||||
|
- #7708, #9580: Ensure Stdlib documentation index refers to Stdlib.
|
||||||
|
(Stephen Dolan, review by Florian Angeletti, report by Hannes Mehnert)
|
||||||
|
|
||||||
### Compiler user-interface and warnings:
|
### Compiler user-interface and warnings:
|
||||||
|
|
||||||
- GPR#1664: make -output-complete-obj link the runtime native c libraries when
|
- #9712: Update the version format to allow "~".
|
||||||
|
The new format is "major.minor[.patchlevel][(+|~)additional-info]",
|
||||||
|
for instance "4.12.0~beta1+flambda".
|
||||||
|
This is a documentation-only change for the 4.11 branch, the new format
|
||||||
|
will be used starting with the 4.12 branch.
|
||||||
|
(Florian Angeletti, review by Damien Doligez and Xavier Leroy)
|
||||||
|
|
||||||
|
- #1664: make -output-complete-obj link the runtime native c libraries when
|
||||||
building shared libraries like `-output-obj`.
|
building shared libraries like `-output-obj`.
|
||||||
(Florian Angeletti, review by Nicolás Ojeda Bär)
|
(Florian Angeletti, review by Nicolás Ojeda Bär)
|
||||||
|
|
||||||
|
- #9349: Support [@inlined hint] attribute.
|
||||||
|
(Leo White, review by Stephen Dolan)
|
||||||
|
|
||||||
|
- #2141: generate .annot files from cmt data; deprecate -annot.
|
||||||
|
(Nicolás Ojeda Bär, review by Alain Frisch, Gabriel Scherer and Damien
|
||||||
|
Doligez)
|
||||||
|
|
||||||
|
|
||||||
* #7678, #8631: ocamlc -c and ocamlopt -c pass same switches to the C
|
* #7678, #8631: ocamlc -c and ocamlopt -c pass same switches to the C
|
||||||
compiler when compiling .c files (in particular, this means ocamlopt
|
compiler when compiling .c files (in particular, this means ocamlopt
|
||||||
passes -fPIC on systems requiring it for shared library support).
|
passes -fPIC on systems requiring it for shared library support).
|
||||||
|
@ -658,25 +809,21 @@ OCaml 4.11
|
||||||
- #9393: Improve recursive module usage warnings
|
- #9393: Improve recursive module usage warnings
|
||||||
(Leo White, review by Thomas Refis)
|
(Leo White, review by Thomas Refis)
|
||||||
|
|
||||||
- #2141: generate .annot files from cmt data; deprecate -annot.
|
|
||||||
(Nicolás Ojeda Bär, review by Alain Frisch, Gabriel Scherer and Damien
|
|
||||||
Doligez)
|
|
||||||
|
|
||||||
- #9486: Fix configuration for the Haiku operating system
|
- #9486: Fix configuration for the Haiku operating system
|
||||||
(Sylvain Kerjean, review by David Allsopp and Sébastien Hinderer)
|
(Sylvain Kerjean, review by David Allsopp and Sébastien Hinderer)
|
||||||
|
|
||||||
- #9712: Update the version format to allow "~".
|
|
||||||
The new format is "major.minor[.patchlevel][(+|~)additional-info]",
|
|
||||||
for instance "4.12.0~beta1+flambda".
|
|
||||||
This is a documentation-only change for the 4.11 branch, the new format
|
|
||||||
will be used starting with the 4.12 branch.
|
|
||||||
(Florian Angeletti, review by Damien Doligez and Xavier Leroy)
|
|
||||||
|
|
||||||
### Internal/compiler-libs changes:
|
### Internal/compiler-libs changes:
|
||||||
|
|
||||||
- #463: a new Misc.Magic_number module for user-friendly parsing
|
- #9021: expose compiler Longident.t parsers
|
||||||
and validation of OCaml magic numbers.
|
(Florian Angeletti, review by Gabriel Scherer)
|
||||||
(Gabriel Scherer, review by Gabriel Radanne and Damien Doligez)
|
|
||||||
|
- #9452: Add locations to docstring attributes
|
||||||
|
(Leo White, review by Gabriel Scherer)
|
||||||
|
|
||||||
|
|
||||||
|
- #463: a new Misc.Magic_number module for user-friendly parsing
|
||||||
|
and validation of OCaml magic numbers.
|
||||||
|
(Gabriel Scherer, review by Gabriel Radanne and Damien Doligez)
|
||||||
|
|
||||||
- #1176: encourage better compatibility with older Microsoft C compilers by
|
- #1176: encourage better compatibility with older Microsoft C compilers by
|
||||||
using GCC's -Wdeclaration-after-statement when available. Introduce
|
using GCC's -Wdeclaration-after-statement when available. Introduce
|
||||||
|
@ -695,9 +842,6 @@ OCaml 4.11
|
||||||
- #9060: ensure that Misc.protect_refs preserves backtraces
|
- #9060: ensure that Misc.protect_refs preserves backtraces
|
||||||
(Gabriel Scherer, review by Guillaume Munch-Maccagnoni and David Allsopp)
|
(Gabriel Scherer, review by Guillaume Munch-Maccagnoni and David Allsopp)
|
||||||
|
|
||||||
- #9021: expose compiler Longident.t parsers
|
|
||||||
(Florian Angeletti, review by Gabriel Scherer)
|
|
||||||
|
|
||||||
- #9078: make all compilerlibs/ available to ocamltest.
|
- #9078: make all compilerlibs/ available to ocamltest.
|
||||||
(Gabriel Scherer, review by Sébastien Hinderer)
|
(Gabriel Scherer, review by Sébastien Hinderer)
|
||||||
|
|
||||||
|
@ -713,7 +857,7 @@ OCaml 4.11
|
||||||
(Gabriel Scherer, Thomas Refis, Florian Angeletti and Jacques Garrigue,
|
(Gabriel Scherer, Thomas Refis, Florian Angeletti and Jacques Garrigue,
|
||||||
reviewing each other without self-loops)
|
reviewing each other without self-loops)
|
||||||
|
|
||||||
- #9321, #9322, #9359, #9361, #9417, #9447, #9464: refactor the
|
- #9321, #9322, #9359, #9361, #9417, #9447: refactor the
|
||||||
pattern-matching compiler
|
pattern-matching compiler
|
||||||
(Thomas Refis and Gabriel Scherer, review by Florian Angeletti)
|
(Thomas Refis and Gabriel Scherer, review by Florian Angeletti)
|
||||||
|
|
||||||
|
@ -721,6 +865,9 @@ OCaml 4.11
|
||||||
compilerlibs, dynlink, ocamltest.
|
compilerlibs, dynlink, ocamltest.
|
||||||
(Gabriel Scherer, review by Vincent Laviron and David Allsopp)
|
(Gabriel Scherer, review by Vincent Laviron and David Allsopp)
|
||||||
|
|
||||||
|
- #9275: Short circuit simple inclusion checks
|
||||||
|
(Leo White, review by Thomas Refis)
|
||||||
|
|
||||||
- #9305: Avoid polymorphic compare in Ident
|
- #9305: Avoid polymorphic compare in Ident
|
||||||
(Leo White, review by Xavier Leroy and Gabriel Scherer)
|
(Leo White, review by Xavier Leroy and Gabriel Scherer)
|
||||||
|
|
||||||
|
@ -734,11 +881,16 @@ OCaml 4.11
|
||||||
- #9246: Avoid rechecking functor applications
|
- #9246: Avoid rechecking functor applications
|
||||||
(Leo White, review by Jacques Garrigue)
|
(Leo White, review by Jacques Garrigue)
|
||||||
|
|
||||||
|
- #9402: Remove `sudo:false` from .travis.yml
|
||||||
|
(Hikaru Yoshimura)
|
||||||
|
|
||||||
* #9411: forbid optional arguments reordering with -nolabels
|
* #9411: forbid optional arguments reordering with -nolabels
|
||||||
(Thomas Refis, review by Frédéric Bour and Jacques Garrigue)
|
(Thomas Refis, review by Frédéric Bour and Jacques Garrigue)
|
||||||
|
|
||||||
- #9452: Add locations to docstring attributes
|
- #9414: testsuite, ocamltest: keep test artifacts only on failure.
|
||||||
(Leo White, review by Gabriel Scherer)
|
Use KEEP_TEST_DIR_ON_SUCCESS=1 to keep all artifacts.
|
||||||
|
(Gabriel Scherer, review by Sébastien Hinderer)
|
||||||
|
|
||||||
|
|
||||||
### Build system:
|
### Build system:
|
||||||
|
|
||||||
|
@ -839,6 +991,9 @@ OCaml 4.11
|
||||||
* #9388: Prohibit signature local types with constraints
|
* #9388: Prohibit signature local types with constraints
|
||||||
(Leo White, review by Jacques Garrigue)
|
(Leo White, review by Jacques Garrigue)
|
||||||
|
|
||||||
|
- #7141, #9389: returns exit_code for better user response on linking_error
|
||||||
|
(Anukriti Kumar, review by Gabriel Scherer and Valentin Gatien-Baron)
|
||||||
|
|
||||||
- #9406, #9409: fix an error with packed module types from missing
|
- #9406, #9409: fix an error with packed module types from missing
|
||||||
cmis.
|
cmis.
|
||||||
(Florian Angeletti, report by Thomas Leonard, review by Gabriel Radanne
|
(Florian Angeletti, report by Thomas Leonard, review by Gabriel Radanne
|
||||||
|
@ -864,6 +1019,10 @@ OCaml 4.11
|
||||||
- #9695, #9702: no error when opening an alias to a missing module
|
- #9695, #9702: no error when opening an alias to a missing module
|
||||||
(Jacques Garrigue, report and review by Gabriel Scherer)
|
(Jacques Garrigue, report and review by Gabriel Scherer)
|
||||||
|
|
||||||
|
- #9714, #9724: Add a terminator to the `caml_domain_state` structure
|
||||||
|
to better ensure that members are correctly spaced.
|
||||||
|
(Antonin Décimo, review by David Allsopp and Xavier Leroy)
|
||||||
|
|
||||||
OCaml 4.10 maintenance branch
|
OCaml 4.10 maintenance branch
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
||||||
|
@ -893,9 +1052,18 @@ OCaml 4.10 maintenance branch
|
||||||
output channels would not be flushed).
|
output channels would not be flushed).
|
||||||
(Nicolás Ojeda Bär, review by David Allsopp)
|
(Nicolás Ojeda Bär, review by David Allsopp)
|
||||||
|
|
||||||
|
- #9714, #9724: Use the C++ alignas keyword when compiling in C++ in MSVC.
|
||||||
|
Fixes a bug with MSVC C++ 2015 onwards.
|
||||||
|
(Antonin Décimo, review by David Allsopp and Xavier Leroy)
|
||||||
|
|
||||||
- #9736, #9749: Compaction must start in a heap where all free blocks are
|
- #9736, #9749: Compaction must start in a heap where all free blocks are
|
||||||
blue, which was not the case with the best-fit allocator.
|
blue, which was not the case with the best-fit allocator.
|
||||||
(Damien Doligez, report by Leo White, review by ???)
|
(Damien Doligez, report and review by Leo White)
|
||||||
|
|
||||||
|
### Tools:
|
||||||
|
|
||||||
|
- #9552: restore ocamloptp build and installation
|
||||||
|
(Florian Angeletti, review by David Allsopp and Xavier Leroy)
|
||||||
|
|
||||||
OCaml 4.10.0 (21 February 2020)
|
OCaml 4.10.0 (21 February 2020)
|
||||||
-------------------------------
|
-------------------------------
|
||||||
|
@ -1205,6 +1373,10 @@ OCaml 4.10.0 (21 February 2020)
|
||||||
- #9127, #9130: ocamldoc: fix the formatting of closing brace in record types.
|
- #9127, #9130: ocamldoc: fix the formatting of closing brace in record types.
|
||||||
(David Allsopp, report by San Vu Ngoc)
|
(David Allsopp, report by San Vu Ngoc)
|
||||||
|
|
||||||
|
- #9181: make objinfo work on Cygwin and look for the caml_plugin_header
|
||||||
|
symbol in both the static and the dynamic symbol tables.
|
||||||
|
(Sébastien Hinderer, review by Gabriel Scherer and David Allsopp)
|
||||||
|
|
||||||
### Build system:
|
### Build system:
|
||||||
|
|
||||||
- #8840: use ocaml{c,opt}.opt when available to build internal tools
|
- #8840: use ocaml{c,opt}.opt when available to build internal tools
|
||||||
|
@ -1405,9 +1577,6 @@ OCaml 4.10.0 (21 February 2020)
|
||||||
- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908)
|
- #9261: Fix a soundness bug in Rec_check, new in 4.10 (from #8908)
|
||||||
(Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer)
|
(Vincent Laviron, review by Jeremy Yallop and Gabriel Scherer)
|
||||||
|
|
||||||
- #9389: returns exit_code for better user response on linking_error
|
|
||||||
(Anukriti Kumar, review by Gabriel Scherer and sliquister)
|
|
||||||
|
|
||||||
OCaml 4.09 maintenance branch
|
OCaml 4.09 maintenance branch
|
||||||
-----------------------------
|
-----------------------------
|
||||||
|
|
||||||
|
@ -1438,15 +1607,15 @@ OCaml 4.09.1 (16 Mars 2020)
|
||||||
- #9050, #9076: install missing compilerlibs/ocamlmiddleend archives
|
- #9050, #9076: install missing compilerlibs/ocamlmiddleend archives
|
||||||
(Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering)
|
(Gabriel Scherer, review by Florian Angeletti, report by Olaf Hering)
|
||||||
|
|
||||||
- #9144, #9180: multiple definitions of global variables in the C runtime,
|
|
||||||
causing problems with GCC 10.0 and possibly with other C compilers
|
|
||||||
(Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell)
|
|
||||||
|
|
||||||
- #9180: pass -fno-common option to C compiler when available,
|
- #9180: pass -fno-common option to C compiler when available,
|
||||||
so as to detect problematic multiple definitions of global variables
|
so as to detect problematic multiple definitions of global variables
|
||||||
in the C runtime
|
in the C runtime
|
||||||
(Xavier Leroy, review by Mark Shinwell)
|
(Xavier Leroy, review by Mark Shinwell)
|
||||||
|
|
||||||
|
- #9144, #9180: multiple definitions of global variables in the C runtime,
|
||||||
|
causing problems with GCC 10.0 and possibly with other C compilers
|
||||||
|
(Xavier Leroy, report by Jürgen Reuter, review by Mark Shinwell)
|
||||||
|
|
||||||
- #9128: Fix a bug in bytecode mode which could lead to a segmentation
|
- #9128: Fix a bug in bytecode mode which could lead to a segmentation
|
||||||
fault. The bug was caused by the fact that the atom table shared a
|
fault. The bug was caused by the fact that the atom table shared a
|
||||||
page with some bytecode. The fix makes sure both the atom table and
|
page with some bytecode. The fix makes sure both the atom table and
|
||||||
|
@ -1594,9 +1763,6 @@ OCaml 4.09.0 (19 September 2019)
|
||||||
- #8515: manual, precise constraints on reexported types
|
- #8515: manual, precise constraints on reexported types
|
||||||
(Florian Angeletti, review by Gabriel Scherer)
|
(Florian Angeletti, review by Gabriel Scherer)
|
||||||
|
|
||||||
- #9327, #9401: manual, fix infix attribute examples
|
|
||||||
(Florian Angeletti, report by David Cadé, review by Gabriel Scherer)
|
|
||||||
|
|
||||||
### Tools:
|
### Tools:
|
||||||
|
|
||||||
- #2221: ocamldep will now correctly allow a .ml file in an include directory
|
- #2221: ocamldep will now correctly allow a .ml file in an include directory
|
||||||
|
@ -1668,9 +1834,6 @@ OCaml 4.09.0 (19 September 2019)
|
||||||
(Thomas Refis, review by David Allsopp, Florian Angeletti, Gabriel Radanne,
|
(Thomas Refis, review by David Allsopp, Florian Angeletti, Gabriel Radanne,
|
||||||
Gabriel Scherer and Xavier Leroy)
|
Gabriel Scherer and Xavier Leroy)
|
||||||
|
|
||||||
- #9275: Short circuit simple inclusion checks
|
|
||||||
(Leo White, review by Thomas Refis)
|
|
||||||
|
|
||||||
### Compiler distribution build system:
|
### Compiler distribution build system:
|
||||||
|
|
||||||
- #2267: merge generation of header programs, also fixing parallel build on
|
- #2267: merge generation of header programs, also fixing parallel build on
|
||||||
|
@ -2193,9 +2356,6 @@ OCaml 4.08.0 (13 June 2019)
|
||||||
- #8508: refresh \moduleref macro
|
- #8508: refresh \moduleref macro
|
||||||
(Florian Angeletti, review by Gabriel Scherer)
|
(Florian Angeletti, review by Gabriel Scherer)
|
||||||
|
|
||||||
- 9410: replaced fibonacci example with gcd of coreexamples manual
|
|
||||||
(Anukriti Kumar, review by San Vu Ngoc, Florian Angeletti, Léo Andrès)
|
|
||||||
|
|
||||||
### Code generation and optimizations:
|
### Code generation and optimizations:
|
||||||
|
|
||||||
- #7725, #1754: improve AFL instrumentation for objects and lazy values.
|
- #7725, #1754: improve AFL instrumentation for objects and lazy values.
|
||||||
|
@ -2922,9 +3082,6 @@ OCaml 4.07.0 (10 July 2018)
|
||||||
platforms, making this option unusable on platforms where it wasn't.
|
platforms, making this option unusable on platforms where it wasn't.
|
||||||
(Jérémie Dimino, review by Sébastien Hinderer and Xavier Leroy)
|
(Jérémie Dimino, review by Sébastien Hinderer and Xavier Leroy)
|
||||||
|
|
||||||
- #9349: Support [@inlined hint] attribute.
|
|
||||||
(Leo White, review by Stephen Dolan)
|
|
||||||
|
|
||||||
### Runtime system:
|
### Runtime system:
|
||||||
|
|
||||||
- #515 #676 #7173: Add a public C API for weak arrays and
|
- #515 #676 #7173: Add a public C API for weak arrays and
|
||||||
|
|
|
@ -330,16 +330,16 @@ file.
|
||||||
|
|
||||||
Merlin will be looking at the artefacts generated by dune (in `_build`), rather
|
Merlin will be looking at the artefacts generated by dune (in `_build`), rather
|
||||||
than trying to open the incompatible artefacts produced by a Makefile build. In
|
than trying to open the incompatible artefacts produced by a Makefile build. In
|
||||||
particular, you need to repeat the dune build everytime you change the interface
|
particular, you need to repeat the dune build every time you change the interface
|
||||||
of some compilation unit, so that merlin is aware of the new interface.
|
of some compilation unit, so that merlin is aware of the new interface.
|
||||||
|
|
||||||
You only need to run `configure` once, but you will need to run `make clean`
|
You only need to run `configure` once, but you will need to run `make clean`
|
||||||
everytime you want to run `dune` after you built something with `make`;
|
every time you want to run `dune` after you built something with `make`;
|
||||||
otherwise dune will complain that build artefacts are present among the sources.
|
otherwise dune will complain that build artefacts are present among the sources.
|
||||||
|
|
||||||
Finally, there will be times where the compiler simply cannot be built with an
|
Finally, there will be times where the compiler simply cannot be built with an
|
||||||
older version of itself. One example of this is when a new primitive is added to
|
older version of itself. One example of this is when a new primitive is added to
|
||||||
the runtime, and then used in the standard library straightaway, since the rest
|
the runtime, and then used in the standard library straight away, since the rest
|
||||||
of the compiler requires the `stdlib` library to build, nothing can be build. In
|
of the compiler requires the `stdlib` library to build, nothing can be build. In
|
||||||
such situations, you will have to either live without merlin, or develop on an
|
such situations, you will have to either live without merlin, or develop on an
|
||||||
older branch of the compiler, for example the maintenance branch of the last
|
older branch of the compiler, for example the maintenance branch of the last
|
||||||
|
|
20
Makefile
20
Makefile
|
@ -53,7 +53,6 @@ else
|
||||||
OCAML_NATDYNLINKOPTS = -ccopt "$(NATDYNLINKOPTS)"
|
OCAML_NATDYNLINKOPTS = -ccopt "$(NATDYNLINKOPTS)"
|
||||||
endif
|
endif
|
||||||
|
|
||||||
YACCFLAGS=-v --strict
|
|
||||||
CAMLLEX=$(CAMLRUN) boot/ocamllex
|
CAMLLEX=$(CAMLRUN) boot/ocamllex
|
||||||
CAMLDEP=$(CAMLRUN) boot/ocamlc -depend
|
CAMLDEP=$(CAMLRUN) boot/ocamlc -depend
|
||||||
DEPFLAGS=-slash
|
DEPFLAGS=-slash
|
||||||
|
@ -78,10 +77,10 @@ COMPLIBDIR=$(LIBDIR)/compiler-libs
|
||||||
|
|
||||||
TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES)))
|
TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES)))
|
||||||
RUNTOP=./runtime/ocamlrun$(EXE) ./ocaml$(EXE) \
|
RUNTOP=./runtime/ocamlrun$(EXE) ./ocaml$(EXE) \
|
||||||
-nostdlib -I stdlib \
|
-nostdlib -I stdlib -I toplevel \
|
||||||
-noinit $(TOPFLAGS) $(TOPINCLUDES)
|
-noinit $(TOPFLAGS) $(TOPINCLUDES)
|
||||||
NATRUNTOP=./ocamlnat$(EXE) \
|
NATRUNTOP=./ocamlnat$(EXE) \
|
||||||
-nostdlib -I stdlib \
|
-nostdlib -I stdlib -I toplevel \
|
||||||
-noinit $(TOPFLAGS) $(TOPINCLUDES)
|
-noinit $(TOPFLAGS) $(TOPINCLUDES)
|
||||||
ifeq "$(UNIX_OR_WIN32)" "unix"
|
ifeq "$(UNIX_OR_WIN32)" "unix"
|
||||||
EXTRAPATH=
|
EXTRAPATH=
|
||||||
|
@ -868,7 +867,7 @@ ocamldoc.opt: ocamlc.opt ocamlyacc ocamllex
|
||||||
$(MAKE) -C ocamldoc opt.opt
|
$(MAKE) -C ocamldoc opt.opt
|
||||||
|
|
||||||
# OCamltest
|
# OCamltest
|
||||||
ocamltest: ocamlc ocamlyacc ocamllex
|
ocamltest: ocamlc ocamlyacc ocamllex otherlibraries
|
||||||
$(MAKE) -C ocamltest all
|
$(MAKE) -C ocamltest all
|
||||||
|
|
||||||
ocamltest.opt: ocamlc.opt ocamlyacc ocamllex
|
ocamltest.opt: ocamlc.opt ocamlyacc ocamllex
|
||||||
|
@ -928,13 +927,16 @@ endif
|
||||||
|
|
||||||
# Check that the stack limit is reasonable (Unix-only)
|
# Check that the stack limit is reasonable (Unix-only)
|
||||||
.PHONY: checkstack
|
.PHONY: checkstack
|
||||||
checkstack:
|
|
||||||
ifeq "$(UNIX_OR_WIN32)" "unix"
|
ifeq "$(UNIX_OR_WIN32)" "unix"
|
||||||
if $(MKEXE) $(OUTPUTEXE)tools/checkstack$(EXE) tools/checkstack.c; \
|
checkstack := tools/checkstack
|
||||||
then tools/checkstack$(EXE); \
|
checkstack: $(checkstack)$(EXE)
|
||||||
fi
|
$<
|
||||||
rm -f tools/checkstack$(EXE)
|
|
||||||
|
.INTERMEDIATE: $(checkstack)$(EXE) $(checkstack).$(O)
|
||||||
|
$(checkstack)$(EXE): $(checkstack).$(O)
|
||||||
|
$(MKEXE) $(OUTPUTEXE)$@ $<
|
||||||
else
|
else
|
||||||
|
checkstack:
|
||||||
@
|
@
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|
|
@ -109,7 +109,8 @@ REQUIRED_HEADERS := $(RUNTIME_HEADERS) $(wildcard *.h)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
%.$(O): %.c $(REQUIRED_HEADERS)
|
%.$(O): %.c $(REQUIRED_HEADERS)
|
||||||
$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
|
$(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
|
||||||
|
$(OUTPUTOBJ)$@ $<
|
||||||
|
|
||||||
$(DEPDIR):
|
$(DEPDIR):
|
||||||
$(MKDIR) $@
|
$(MKDIR) $@
|
||||||
|
|
|
@ -129,7 +129,7 @@ ARCH=@arch@
|
||||||
# Whether the architecture has 64 bits
|
# Whether the architecture has 64 bits
|
||||||
ARCH64=@arch64@
|
ARCH64=@arch64@
|
||||||
|
|
||||||
# Endianess for this architecture
|
# Endianness for this architecture
|
||||||
ENDIANNESS=@endianness@
|
ENDIANNESS=@endianness@
|
||||||
|
|
||||||
### Name of architecture model for the native-code compiler.
|
### Name of architecture model for the native-code compiler.
|
||||||
|
@ -179,7 +179,9 @@ UNIXLIB=@unixlib@
|
||||||
INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@
|
INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@
|
||||||
|
|
||||||
OC_CFLAGS=@oc_cflags@
|
OC_CFLAGS=@oc_cflags@
|
||||||
|
CFLAGS?=@CFLAGS@
|
||||||
OC_CPPFLAGS=@oc_cppflags@
|
OC_CPPFLAGS=@oc_cppflags@
|
||||||
|
CPPFLAGS?=@CPPFLAGS@
|
||||||
OCAMLC_CFLAGS=@ocamlc_cflags@
|
OCAMLC_CFLAGS=@ocamlc_cflags@
|
||||||
|
|
||||||
OCAMLC_CPPFLAGS=@ocamlc_cppflags@
|
OCAMLC_CPPFLAGS=@ocamlc_cppflags@
|
||||||
|
@ -252,10 +254,10 @@ ifeq "$(TOOLCHAIN)" "msvc"
|
||||||
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|
||||||
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
|
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
|
||||||
&& rm -f $(1).manifest
|
&& rm -f $(1).manifest
|
||||||
MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OUTPUTEXE)$(1) $(2) \
|
MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) \
|
||||||
/link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE))
|
/link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE))
|
||||||
else
|
else
|
||||||
MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2)
|
MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2)
|
||||||
endif # ifeq "$(TOOLCHAIN)" "msvc"
|
endif # ifeq "$(TOOLCHAIN)" "msvc"
|
||||||
|
|
||||||
# The following variables were defined only in the Windows-specific makefiles.
|
# The following variables were defined only in the Windows-specific makefiles.
|
||||||
|
|
|
@ -76,11 +76,10 @@ the compiler may work under other operating systems with little work.
|
||||||
|
|
||||||
== Copyright
|
== Copyright
|
||||||
|
|
||||||
All files marked "Copyright INRIA" in this distribution are copyright 1996,
|
All files marked "Copyright INRIA" in this distribution are
|
||||||
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
|
Copyright (C) 1996-2020 Institut National de Recherche en Informatique et
|
||||||
2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019
|
en Automatique (INRIA) and distributed under the conditions stated in
|
||||||
Institut National de Recherche en Informatique et en Automatique (INRIA)
|
file LICENSE.
|
||||||
and distributed under the conditions stated in file LICENSE.
|
|
||||||
|
|
||||||
== Installation
|
== Installation
|
||||||
|
|
||||||
|
|
|
@ -10,3 +10,4 @@ Debian architecture name: `arm64`.
|
||||||
_ARM Architecture Reference Manual, ARMv8_, restricted to the AArch64 subset.
|
_ARM Architecture Reference Manual, ARMv8_, restricted to the AArch64 subset.
|
||||||
* Application binary interface:
|
* Application binary interface:
|
||||||
_Procedure Call Standard for the ARM 64-bit Architecture (AArch64)_
|
_Procedure Call Standard for the ARM 64-bit Architecture (AArch64)_
|
||||||
|
_Apple ARM64 Function Calling Conventions_
|
||||||
|
|
|
@ -38,18 +38,35 @@ let reg_trap_ptr = phys_reg 23
|
||||||
let reg_alloc_ptr = phys_reg 24
|
let reg_alloc_ptr = phys_reg 24
|
||||||
let reg_alloc_limit = phys_reg 25
|
let reg_alloc_limit = phys_reg 25
|
||||||
let reg_tmp1 = phys_reg 26
|
let reg_tmp1 = phys_reg 26
|
||||||
let reg_x15 = phys_reg 15
|
let reg_x8 = phys_reg 8
|
||||||
|
|
||||||
(* Output a label *)
|
(* Output a label *)
|
||||||
|
|
||||||
|
let label_prefix =
|
||||||
|
if macosx then "L" else ".L"
|
||||||
|
|
||||||
let emit_label lbl =
|
let emit_label lbl =
|
||||||
emit_string ".L"; emit_int lbl
|
emit_string label_prefix; emit_int lbl
|
||||||
|
|
||||||
(* Symbols *)
|
(* Symbols *)
|
||||||
|
|
||||||
let emit_symbol s =
|
let emit_symbol s =
|
||||||
|
if macosx then emit_string "_";
|
||||||
Emitaux.emit_symbol '$' s
|
Emitaux.emit_symbol '$' s
|
||||||
|
|
||||||
|
(* Object types *)
|
||||||
|
|
||||||
|
let emit_symbol_type emit_lbl_or_sym lbl_or_sym ty =
|
||||||
|
if not macosx then begin
|
||||||
|
` .type {emit_lbl_or_sym lbl_or_sym}, %{emit_string ty}\n`
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
let emit_symbol_size sym =
|
||||||
|
if not macosx then begin
|
||||||
|
` .size {emit_symbol sym}, .-{emit_symbol sym}\n`
|
||||||
|
end
|
||||||
|
|
||||||
(* Output a pseudo-register *)
|
(* Output a pseudo-register *)
|
||||||
|
|
||||||
let emit_reg = function
|
let emit_reg = function
|
||||||
|
@ -78,12 +95,15 @@ let prologue_required = ref false
|
||||||
|
|
||||||
let contains_calls = ref false
|
let contains_calls = ref false
|
||||||
|
|
||||||
let frame_size () =
|
let initial_stack_offset () =
|
||||||
let sz =
|
|
||||||
!stack_offset +
|
|
||||||
8 * num_stack_slots.(0) +
|
8 * num_stack_slots.(0) +
|
||||||
8 * num_stack_slots.(1) +
|
8 * num_stack_slots.(1) +
|
||||||
(if !contains_calls then 8 else 0)
|
(if !contains_calls then 8 else 0)
|
||||||
|
|
||||||
|
let frame_size () =
|
||||||
|
let sz =
|
||||||
|
!stack_offset +
|
||||||
|
initial_stack_offset ()
|
||||||
in Misc.align sz 16
|
in Misc.align sz 16
|
||||||
|
|
||||||
let slot_offset loc cl =
|
let slot_offset loc cl =
|
||||||
|
@ -320,6 +340,8 @@ let float_literal f =
|
||||||
(* Emit all pending literals *)
|
(* Emit all pending literals *)
|
||||||
let emit_literals() =
|
let emit_literals() =
|
||||||
if !float_literals <> [] then begin
|
if !float_literals <> [] then begin
|
||||||
|
if macosx then
|
||||||
|
` .section __TEXT,__literal8,8byte_literals\n`;
|
||||||
` .align 3\n`;
|
` .align 3\n`;
|
||||||
List.iter
|
List.iter
|
||||||
(fun (f, lbl) ->
|
(fun (f, lbl) ->
|
||||||
|
@ -331,7 +353,10 @@ let emit_literals() =
|
||||||
(* Emit code to load the address of a symbol *)
|
(* Emit code to load the address of a symbol *)
|
||||||
|
|
||||||
let emit_load_symbol_addr dst s =
|
let emit_load_symbol_addr dst s =
|
||||||
if not !Clflags.dlcode then begin
|
if macosx then begin
|
||||||
|
` adrp {emit_reg dst}, {emit_symbol s}@GOTPAGE\n`;
|
||||||
|
` ldr {emit_reg dst}, [{emit_reg dst}, {emit_symbol s}@GOTPAGEOFF]\n`
|
||||||
|
end else if not !Clflags.dlcode then begin
|
||||||
` adrp {emit_reg dst}, {emit_symbol s}\n`;
|
` adrp {emit_reg dst}, {emit_symbol s}\n`;
|
||||||
` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
|
` add {emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`
|
||||||
end else begin
|
end else begin
|
||||||
|
@ -427,7 +452,7 @@ module BR = Branch_relaxation.Make (struct
|
||||||
let offset_pc_at_branch = 0
|
let offset_pc_at_branch = 0
|
||||||
|
|
||||||
let prologue_size () =
|
let prologue_size () =
|
||||||
(if frame_size () > 0 then 2 else 0)
|
(if initial_stack_offset () > 0 then 2 else 0)
|
||||||
+ (if !contains_calls then 1 else 0)
|
+ (if !contains_calls then 1 else 0)
|
||||||
|
|
||||||
let epilogue_size () =
|
let epilogue_size () =
|
||||||
|
@ -562,7 +587,7 @@ let assembly_code_for_allocation ~label_after_call_gc i ~n ~far ~dbginfo =
|
||||||
| 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
|
| 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
|
||||||
| 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
|
| 24 -> ` bl {emit_symbol "caml_alloc2"}\n`
|
||||||
| 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
|
| 32 -> ` bl {emit_symbol "caml_alloc3"}\n`
|
||||||
| _ -> emit_intconst reg_x15 (Nativeint.of_int n);
|
| _ -> emit_intconst reg_x8 (Nativeint.of_int n);
|
||||||
` bl {emit_symbol "caml_allocN"}\n`
|
` bl {emit_symbol "caml_allocN"}\n`
|
||||||
end;
|
end;
|
||||||
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
|
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
|
||||||
|
@ -577,6 +602,17 @@ let emit_named_text_section func_name =
|
||||||
else
|
else
|
||||||
` .text\n`
|
` .text\n`
|
||||||
|
|
||||||
|
(* Emit code to load an emitted literal *)
|
||||||
|
|
||||||
|
let emit_load_literal dst lbl =
|
||||||
|
if macosx then begin
|
||||||
|
` adrp {emit_reg reg_tmp1}, {emit_label lbl}@PAGE\n`;
|
||||||
|
` ldr {emit_reg dst}, [{emit_reg reg_tmp1}, {emit_label lbl}@PAGEOFF]\n`
|
||||||
|
end else begin
|
||||||
|
` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
|
||||||
|
` ldr {emit_reg dst}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
|
||||||
|
end
|
||||||
|
|
||||||
(* Output the assembly code for an instruction *)
|
(* Output the assembly code for an instruction *)
|
||||||
|
|
||||||
let emit_instr i =
|
let emit_instr i =
|
||||||
|
@ -629,8 +665,7 @@ let emit_instr i =
|
||||||
` fmov {emit_reg i.res.(0)}, #{emit_printf "%.7f" (Int64.float_of_bits f)}\n`
|
` fmov {emit_reg i.res.(0)}, #{emit_printf "%.7f" (Int64.float_of_bits f)}\n`
|
||||||
else begin
|
else begin
|
||||||
let lbl = float_literal f in
|
let lbl = float_literal f in
|
||||||
` adrp {emit_reg reg_tmp1}, {emit_label lbl}\n`;
|
emit_load_literal i.res.(0) lbl
|
||||||
` ldr {emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]\n`
|
|
||||||
end
|
end
|
||||||
| Lop(Iconst_symbol s) ->
|
| Lop(Iconst_symbol s) ->
|
||||||
emit_load_symbol_addr i.res.(0) s
|
emit_load_symbol_addr i.res.(0) s
|
||||||
|
@ -650,7 +685,7 @@ let emit_instr i =
|
||||||
| Lop(Iextcall { func; alloc = false; label_after = _; }) ->
|
| Lop(Iextcall { func; alloc = false; label_after = _; }) ->
|
||||||
` bl {emit_symbol func}\n`
|
` bl {emit_symbol func}\n`
|
||||||
| Lop(Iextcall { func; alloc = true; label_after; }) ->
|
| Lop(Iextcall { func; alloc = true; label_after; }) ->
|
||||||
emit_load_symbol_addr reg_x15 func;
|
emit_load_symbol_addr reg_x8 func;
|
||||||
` bl {emit_symbol "caml_c_call"}\n`;
|
` bl {emit_symbol "caml_c_call"}\n`;
|
||||||
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
|
`{record_frame i.live (Dbg_other i.dbg) ~label:label_after}\n`
|
||||||
| Lop(Istackoffset n) ->
|
| Lop(Istackoffset n) ->
|
||||||
|
@ -950,7 +985,7 @@ let fundecl fundecl =
|
||||||
emit_named_text_section !function_name;
|
emit_named_text_section !function_name;
|
||||||
` .align 3\n`;
|
` .align 3\n`;
|
||||||
` .globl {emit_symbol fundecl.fun_name}\n`;
|
` .globl {emit_symbol fundecl.fun_name}\n`;
|
||||||
` .type {emit_symbol fundecl.fun_name}, %function\n`;
|
emit_symbol_type emit_symbol fundecl.fun_name "function";
|
||||||
`{emit_symbol fundecl.fun_name}:\n`;
|
`{emit_symbol fundecl.fun_name}:\n`;
|
||||||
emit_debug_info fundecl.fun_dbg;
|
emit_debug_info fundecl.fun_dbg;
|
||||||
cfi_startproc();
|
cfi_startproc();
|
||||||
|
@ -968,8 +1003,8 @@ let fundecl fundecl =
|
||||||
assert (List.length !call_gc_sites = num_call_gc);
|
assert (List.length !call_gc_sites = num_call_gc);
|
||||||
assert (List.length !bound_error_sites = num_check_bound);
|
assert (List.length !bound_error_sites = num_check_bound);
|
||||||
cfi_endproc();
|
cfi_endproc();
|
||||||
` .type {emit_symbol fundecl.fun_name}, %function\n`;
|
emit_symbol_type emit_symbol fundecl.fun_name "function";
|
||||||
` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
|
emit_symbol_size fundecl.fun_name;
|
||||||
emit_literals()
|
emit_literals()
|
||||||
|
|
||||||
(* Emission of data *)
|
(* Emission of data *)
|
||||||
|
@ -1032,10 +1067,10 @@ let end_assembly () =
|
||||||
`{emit_symbol lbl}:\n`;
|
`{emit_symbol lbl}:\n`;
|
||||||
emit_frames
|
emit_frames
|
||||||
{ efa_code_label = (fun lbl ->
|
{ efa_code_label = (fun lbl ->
|
||||||
` .type {emit_label lbl}, %function\n`;
|
emit_symbol_type emit_label lbl "function";
|
||||||
` .quad {emit_label lbl}\n`);
|
` .quad {emit_label lbl}\n`);
|
||||||
efa_data_label = (fun lbl ->
|
efa_data_label = (fun lbl ->
|
||||||
` .type {emit_label lbl}, %object\n`;
|
emit_symbol_type emit_label lbl "object";
|
||||||
` .quad {emit_label lbl}\n`);
|
` .quad {emit_label lbl}\n`);
|
||||||
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
|
efa_8 = (fun n -> ` .byte {emit_int n}\n`);
|
||||||
efa_16 = (fun n -> ` .short {emit_int n}\n`);
|
efa_16 = (fun n -> ` .short {emit_int n}\n`);
|
||||||
|
@ -1046,8 +1081,8 @@ let end_assembly () =
|
||||||
` .long {emit_label lbl} - . + {emit_int32 ofs}\n`);
|
` .long {emit_label lbl} - . + {emit_int32 ofs}\n`);
|
||||||
efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
|
efa_def_label = (fun lbl -> `{emit_label lbl}:\n`);
|
||||||
efa_string = (fun s -> emit_string_directive " .asciz " s) };
|
efa_string = (fun s -> emit_string_directive " .asciz " s) };
|
||||||
` .type {emit_symbol lbl}, %object\n`;
|
emit_symbol_type emit_symbol lbl "object";
|
||||||
` .size {emit_symbol lbl}, .-{emit_symbol lbl}\n`;
|
emit_symbol_size lbl;
|
||||||
begin match Config.system with
|
begin match Config.system with
|
||||||
| "linux" ->
|
| "linux" ->
|
||||||
(* Mark stack as non-executable *)
|
(* Mark stack as non-executable *)
|
||||||
|
|
|
@ -99,7 +99,7 @@ let all_phys_regs =
|
||||||
let phys_reg n =
|
let phys_reg n =
|
||||||
if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
|
if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
|
||||||
|
|
||||||
let reg_x15 = phys_reg 15
|
let reg_x8 = phys_reg 8
|
||||||
let reg_d7 = phys_reg 107
|
let reg_d7 = phys_reg 107
|
||||||
|
|
||||||
let stack_slot slot ty =
|
let stack_slot slot ty =
|
||||||
|
@ -165,13 +165,20 @@ let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
|
||||||
Return values in r0...r15 or d0...d15. *)
|
Return values in r0...r15 or d0...d15. *)
|
||||||
|
|
||||||
let max_arguments_for_tailcalls = 16
|
let max_arguments_for_tailcalls = 16
|
||||||
|
let last_int_register = if macosx then 7 else 15
|
||||||
|
|
||||||
let loc_arguments arg =
|
let loc_arguments arg =
|
||||||
calling_conventions 0 15 100 115 outgoing arg
|
calling_conventions 0 last_int_register 100 115 outgoing arg
|
||||||
let loc_parameters arg =
|
let loc_parameters arg =
|
||||||
let (loc, _) = calling_conventions 0 15 100 115 incoming arg in loc
|
let (loc, _) =
|
||||||
|
calling_conventions 0 last_int_register 100 115 incoming arg
|
||||||
|
in
|
||||||
|
loc
|
||||||
let loc_results res =
|
let loc_results res =
|
||||||
let (loc, _) = calling_conventions 0 15 100 115 not_supported res in loc
|
let (loc, _) =
|
||||||
|
calling_conventions 0 last_int_register 100 115 not_supported res
|
||||||
|
in
|
||||||
|
loc
|
||||||
|
|
||||||
(* C calling convention:
|
(* C calling convention:
|
||||||
first integer args in r0...r7
|
first integer args in r0...r7
|
||||||
|
@ -252,7 +259,7 @@ let destroyed_at_oper = function
|
||||||
| Iop(Iextcall { alloc = false; }) ->
|
| Iop(Iextcall { alloc = false; }) ->
|
||||||
destroyed_at_c_call
|
destroyed_at_c_call
|
||||||
| Iop(Ialloc _) ->
|
| Iop(Ialloc _) ->
|
||||||
[| reg_x15 |]
|
[| reg_x8 |]
|
||||||
| Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
|
| Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
|
||||||
[| reg_d7 |] (* d7 / s7 destroyed *)
|
[| reg_d7 |] (* d7 / s7 destroyed *)
|
||||||
| _ -> [||]
|
| _ -> [||]
|
||||||
|
|
|
@ -83,7 +83,7 @@ let inline_ops =
|
||||||
"caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
|
"caml_int64_direct_bswap"; "caml_nativeint_direct_bswap" ]
|
||||||
|
|
||||||
let use_direct_addressing _symb =
|
let use_direct_addressing _symb =
|
||||||
not !Clflags.dlcode
|
(not !Clflags.dlcode) && (not Arch.macosx)
|
||||||
|
|
||||||
let is_stack_slot rv =
|
let is_stack_slot rv =
|
||||||
Reg.(match rv with
|
Reg.(match rv with
|
||||||
|
|
|
@ -454,7 +454,7 @@ let rec div_int c1 c2 is_safe dbg =
|
||||||
res = t + sign-bit(c1)
|
res = t + sign-bit(c1)
|
||||||
*)
|
*)
|
||||||
bind "dividend" c1 (fun c1 ->
|
bind "dividend" c1 (fun c1 ->
|
||||||
let t = Cop(Cmulhi, [c1; Cconst_natint (m, dbg)], dbg) in
|
let t = Cop(Cmulhi, [c1; natint_const_untagged dbg m], dbg) in
|
||||||
let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in
|
let t = if m < 0n then Cop(Caddi, [t; c1], dbg) else t in
|
||||||
let t =
|
let t =
|
||||||
if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t
|
if p > 0 then Cop(Casr, [t; Cconst_int (p, dbg)], dbg) else t
|
||||||
|
@ -995,7 +995,7 @@ let sign_extend_32 dbg e =
|
||||||
(if the word size is 32, this is a no-op) *)
|
(if the word size is 32, this is a no-op) *)
|
||||||
let zero_extend_32 dbg e =
|
let zero_extend_32 dbg e =
|
||||||
if size_int = 4 then e else
|
if size_int = 4 then e else
|
||||||
Cop(Cand, [low_32 dbg e; Cconst_natint(0xFFFFFFFFn, dbg)], dbg)
|
Cop(Cand, [low_32 dbg e; natint_const_untagged dbg 0xFFFFFFFFn], dbg)
|
||||||
|
|
||||||
(* Boxed integers *)
|
(* Boxed integers *)
|
||||||
|
|
||||||
|
@ -1074,21 +1074,23 @@ let unbox_int dbg bi =
|
||||||
| Cconst_symbol (s, _dbg) as cmm ->
|
| Cconst_symbol (s, _dbg) as cmm ->
|
||||||
begin match Cmmgen_state.structured_constant_of_sym s, bi with
|
begin match Cmmgen_state.structured_constant_of_sym s, bi with
|
||||||
| Some (Uconst_nativeint n), Primitive.Pnativeint ->
|
| Some (Uconst_nativeint n), Primitive.Pnativeint ->
|
||||||
Cconst_natint (n, dbg)
|
natint_const_untagged dbg n
|
||||||
| Some (Uconst_int32 n), Primitive.Pint32 ->
|
| Some (Uconst_int32 n), Primitive.Pint32 ->
|
||||||
Cconst_natint (Nativeint.of_int32 n, dbg)
|
natint_const_untagged dbg (Nativeint.of_int32 n)
|
||||||
| Some (Uconst_int64 n), Primitive.Pint64 ->
|
| Some (Uconst_int64 n), Primitive.Pint64 ->
|
||||||
if size_int = 8 then
|
if size_int = 8 then
|
||||||
Cconst_natint (Int64.to_nativeint n, dbg)
|
natint_const_untagged dbg (Int64.to_nativeint n)
|
||||||
else
|
else
|
||||||
let low = Int64.to_nativeint n in
|
let low = Int64.to_nativeint n in
|
||||||
let high =
|
let high =
|
||||||
Int64.to_nativeint (Int64.shift_right_logical n 32)
|
Int64.to_nativeint (Int64.shift_right_logical n 32)
|
||||||
in
|
in
|
||||||
if big_endian then
|
if big_endian then
|
||||||
Ctuple [Cconst_natint (high, dbg); Cconst_natint (low, dbg)]
|
Ctuple [natint_const_untagged dbg high;
|
||||||
|
natint_const_untagged dbg low]
|
||||||
else
|
else
|
||||||
Ctuple [Cconst_natint (low, dbg); Cconst_natint (high, dbg)]
|
Ctuple [natint_const_untagged dbg low;
|
||||||
|
natint_const_untagged dbg high]
|
||||||
| _ ->
|
| _ ->
|
||||||
default cmm
|
default cmm
|
||||||
end
|
end
|
||||||
|
|
|
@ -42,14 +42,16 @@ let prologue_required = ref false
|
||||||
|
|
||||||
let contains_calls = ref false
|
let contains_calls = ref false
|
||||||
|
|
||||||
|
let initial_stack_offset () =
|
||||||
|
reserved_stack_space +
|
||||||
|
size_int * num_stack_slots.(0) + (* Local int variables *)
|
||||||
|
size_float * num_stack_slots.(1) + (* Local float variables *)
|
||||||
|
(if !contains_calls && abi = ELF32 then size_int else 0)
|
||||||
|
(* The return address *)
|
||||||
let frame_size () =
|
let frame_size () =
|
||||||
let size =
|
let size =
|
||||||
reserved_stack_space +
|
|
||||||
!stack_offset + (* Trap frame, outgoing parameters *)
|
!stack_offset + (* Trap frame, outgoing parameters *)
|
||||||
size_int * num_stack_slots.(0) + (* Local int variables *)
|
initial_stack_offset () in
|
||||||
size_float * num_stack_slots.(1) + (* Local float variables *)
|
|
||||||
(if !contains_calls && abi = ELF32 then size_int else 0) in
|
|
||||||
(* The return address *)
|
|
||||||
Misc.align size 16
|
Misc.align size 16
|
||||||
|
|
||||||
let slot_offset loc cls =
|
let slot_offset loc cls =
|
||||||
|
@ -439,7 +441,7 @@ module BR = Branch_relaxation.Make (struct
|
||||||
|
|
||||||
let prologue_size () =
|
let prologue_size () =
|
||||||
profiling_prologue_size ()
|
profiling_prologue_size ()
|
||||||
+ (if frame_size () > 0 then 1 else 0)
|
+ (if initial_stack_offset () > 0 then 1 else 0)
|
||||||
+ (if !contains_calls then
|
+ (if !contains_calls then
|
||||||
2 +
|
2 +
|
||||||
match abi with
|
match abi with
|
||||||
|
|
|
@ -36,7 +36,8 @@ let word_addressed = false
|
||||||
a0-a7 0-7 arguments/results
|
a0-a7 0-7 arguments/results
|
||||||
s2-s9 8-15 arguments/results (preserved by C)
|
s2-s9 8-15 arguments/results (preserved by C)
|
||||||
t2-t6 16-20 temporary
|
t2-t6 16-20 temporary
|
||||||
t0-t1 21-22 temporary (used by code generator)
|
t0 21 temporary
|
||||||
|
t1 22 temporary (used by code generator)
|
||||||
s0 23 domain pointer (preserved by C)
|
s0 23 domain pointer (preserved by C)
|
||||||
s1 24 trap pointer (preserved by C)
|
s1 24 trap pointer (preserved by C)
|
||||||
s10 25 allocation pointer (preserved by C)
|
s10 25 allocation pointer (preserved by C)
|
||||||
|
@ -55,8 +56,8 @@ let word_addressed = false
|
||||||
Additional notes
|
Additional notes
|
||||||
----------------
|
----------------
|
||||||
|
|
||||||
- t0-t1 are used by the assembler and code generator, so
|
- t1 is used by the code generator, so not available for register
|
||||||
not available for register allocation.
|
allocation.
|
||||||
|
|
||||||
- t0-t6 may be used by PLT stubs, so should not be used to pass
|
- t0-t6 may be used by PLT stubs, so should not be used to pass
|
||||||
arguments and may be clobbered by [Ialloc] in the presence of dynamic
|
arguments and may be clobbered by [Ialloc] in the presence of dynamic
|
||||||
|
|
|
@ -80,6 +80,12 @@ method! select_operation op args dbg =
|
||||||
match (op, args) with
|
match (op, args) with
|
||||||
(* Z does not support immediate operands for multiply high *)
|
(* Z does not support immediate operands for multiply high *)
|
||||||
(Cmulhi, _) -> (Iintop Imulh, args)
|
(Cmulhi, _) -> (Iintop Imulh, args)
|
||||||
|
(* sub immediate is turned into add immediate opposite,
|
||||||
|
hence the immediate range is special *)
|
||||||
|
| (Csubi, [arg; Cconst_int (n, _)]) when self#is_immediate (-n) ->
|
||||||
|
(Iintop_imm(Isub, n), [arg])
|
||||||
|
| (Csubi, _) ->
|
||||||
|
(Iintop Isub, args)
|
||||||
(* The and, or and xor instructions have a different range of immediate
|
(* The and, or and xor instructions have a different range of immediate
|
||||||
operands than the other instructions *)
|
operands than the other instructions *)
|
||||||
| (Cand, _) ->
|
| (Cand, _) ->
|
||||||
|
|
|
@ -1015,7 +1015,7 @@ method emit_extcall_args env ty_args args =
|
||||||
method insert_move_extcall_arg env _ty_arg src dst =
|
method insert_move_extcall_arg env _ty_arg src dst =
|
||||||
(* The default implementation is one or two ordinary moves.
|
(* The default implementation is one or two ordinary moves.
|
||||||
(Two in the case of an int64 argument on a 32-bit platform.)
|
(Two in the case of an int64 argument on a 32-bit platform.)
|
||||||
It can be overriden to use special move instructions,
|
It can be overridden to use special move instructions,
|
||||||
for example a "32-bit move" instruction for int32 arguments. *)
|
for example a "32-bit move" instruction for int32 arguments. *)
|
||||||
self#insert_moves env src dst
|
self#insert_moves env src dst
|
||||||
|
|
||||||
|
|
|
@ -99,7 +99,7 @@ class virtual selector_generic : object
|
||||||
or instructions with hardwired input/output registers *)
|
or instructions with hardwired input/output registers *)
|
||||||
method insert_move_extcall_arg :
|
method insert_move_extcall_arg :
|
||||||
environment -> Cmm.exttype -> Reg.t array -> Reg.t array -> unit
|
environment -> Cmm.exttype -> Reg.t array -> Reg.t array -> unit
|
||||||
(* Can be overriden to deal with unusual unboxed calling conventions,
|
(* Can be overridden to deal with unusual unboxed calling conventions,
|
||||||
e.g. on a 64-bit platform, passing unboxed 32-bit arguments
|
e.g. on a 64-bit platform, passing unboxed 32-bit arguments
|
||||||
in 32-bit stack slots. *)
|
in 32-bit stack slots. *)
|
||||||
method emit_extcall_args :
|
method emit_extcall_args :
|
||||||
|
|
|
@ -33,7 +33,7 @@ let reverse_shape = ref ([] : Mach.spacetime_shape)
|
||||||
(* CR-someday mshinwell: This code could be updated to use [placeholder_dbg] as
|
(* CR-someday mshinwell: This code could be updated to use [placeholder_dbg] as
|
||||||
in [Cmmgen]. *)
|
in [Cmmgen]. *)
|
||||||
let cconst_int i = Cmm.Cconst_int (i, Debuginfo.none)
|
let cconst_int i = Cmm.Cconst_int (i, Debuginfo.none)
|
||||||
let cconst_natint i = Cmm.Cconst_natint (i, Debuginfo.none)
|
let cconst_natint i = Cmm_helpers.natint_const_untagged Debuginfo.none i
|
||||||
let cconst_symbol s = Cmm.Cconst_symbol (s, Debuginfo.none)
|
let cconst_symbol s = Cmm.Cconst_symbol (s, Debuginfo.none)
|
||||||
|
|
||||||
let something_was_instrumented () =
|
let something_was_instrumented () =
|
||||||
|
|
13315
boot/menhir/parser.ml
13315
boot/menhir/parser.ml
File diff suppressed because it is too large
Load Diff
BIN
boot/ocamlc
BIN
boot/ocamlc
Binary file not shown.
BIN
boot/ocamllex
BIN
boot/ocamllex
Binary file not shown.
|
@ -2310,6 +2310,52 @@ rm -f conftest.val
|
||||||
|
|
||||||
} # ac_fn_c_compute_int
|
} # ac_fn_c_compute_int
|
||||||
|
|
||||||
|
# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
|
||||||
|
# ---------------------------------------------
|
||||||
|
# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
|
||||||
|
# accordingly.
|
||||||
|
ac_fn_c_check_decl ()
|
||||||
|
{
|
||||||
|
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
|
||||||
|
as_decl_name=`echo $2|sed 's/ *(.*//'`
|
||||||
|
as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
|
||||||
|
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
|
||||||
|
$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
|
||||||
|
if eval \${$3+:} false; then :
|
||||||
|
$as_echo_n "(cached) " >&6
|
||||||
|
else
|
||||||
|
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
|
||||||
|
/* end confdefs.h. */
|
||||||
|
$4
|
||||||
|
int
|
||||||
|
main ()
|
||||||
|
{
|
||||||
|
#ifndef $as_decl_name
|
||||||
|
#ifdef __cplusplus
|
||||||
|
(void) $as_decl_use;
|
||||||
|
#else
|
||||||
|
(void) $as_decl_name;
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
|
;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
_ACEOF
|
||||||
|
if ac_fn_c_try_compile "$LINENO"; then :
|
||||||
|
eval "$3=yes"
|
||||||
|
else
|
||||||
|
eval "$3=no"
|
||||||
|
fi
|
||||||
|
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
|
||||||
|
fi
|
||||||
|
eval ac_res=\$$3
|
||||||
|
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
|
||||||
|
$as_echo "$ac_res" >&6; }
|
||||||
|
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
|
||||||
|
|
||||||
|
} # ac_fn_c_check_decl
|
||||||
|
|
||||||
# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
|
# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
|
||||||
# ----------------------------------------------------
|
# ----------------------------------------------------
|
||||||
# Tries to find if the field MEMBER exists in type AGGR, after including
|
# Tries to find if the field MEMBER exists in type AGGR, after including
|
||||||
|
@ -2734,7 +2780,11 @@ programs_man_section=1
|
||||||
libraries_man_section=3
|
libraries_man_section=3
|
||||||
|
|
||||||
# Command to build executalbes
|
# Command to build executalbes
|
||||||
mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)"
|
# In general this command is supposed to use the CFLAGs-related variables
|
||||||
|
# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into
|
||||||
|
# account on Windows, because flexlink, which is used to build
|
||||||
|
# executables on this platform, can not handle them.
|
||||||
|
mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)"
|
||||||
|
|
||||||
# Flags for building executable files with debugging symbols
|
# Flags for building executable files with debugging symbols
|
||||||
mkexedebugflag="-g"
|
mkexedebugflag="-g"
|
||||||
|
@ -2761,7 +2811,7 @@ instrumented_runtime_ldlibs=""
|
||||||
## Source directory
|
## Source directory
|
||||||
|
|
||||||
|
|
||||||
## Directory containing auxiliary scripts used dugring build
|
## Directory containing auxiliary scripts used during build
|
||||||
ac_aux_dir=
|
ac_aux_dir=
|
||||||
for ac_dir in build-aux "$srcdir"/build-aux; do
|
for ac_dir in build-aux "$srcdir"/build-aux; do
|
||||||
if test -f "$ac_dir/install-sh"; then
|
if test -f "$ac_dir/install-sh"; then
|
||||||
|
@ -3414,10 +3464,14 @@ esac
|
||||||
fi
|
fi
|
||||||
|
|
||||||
# libtool expects host_os=mingw for native Windows
|
# libtool expects host_os=mingw for native Windows
|
||||||
|
# Also, it has been observed that, on some platforms (e.g. msvc) LT_INIT
|
||||||
|
# alters the CFLAGS variable, so we save its value before calling the macro
|
||||||
|
# and restore it after the call
|
||||||
old_host_os=$host_os
|
old_host_os=$host_os
|
||||||
if test x"$host_os" = "xwindows"; then :
|
if test x"$host_os" = "xwindows"; then :
|
||||||
host_os=mingw
|
host_os=mingw
|
||||||
fi
|
fi
|
||||||
|
saved_CFLAGS="$CFLAGS"
|
||||||
case `pwd` in
|
case `pwd` in
|
||||||
*\ * | *\ *)
|
*\ * | *\ *)
|
||||||
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5
|
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5
|
||||||
|
@ -12263,6 +12317,7 @@ CC=$lt_save_CC
|
||||||
# Only expand once:
|
# Only expand once:
|
||||||
|
|
||||||
|
|
||||||
|
CFLAGS="$saved_CFLAGS"
|
||||||
host_os=$old_host_os
|
host_os=$old_host_os
|
||||||
|
|
||||||
case $host in #(
|
case $host in #(
|
||||||
|
@ -12681,7 +12736,7 @@ $as_echo "$as_me: WARNING: Consider using GCC version 4.2 or above." >&2;};
|
||||||
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
|
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
|
||||||
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
|
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)" ;; #(
|
||||||
xlc-*) :
|
xlc-*) :
|
||||||
common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS";
|
common_cflags="-O5 -qtune=balanced -qnoipa -qinline";
|
||||||
internal_cflags="$cc_warnings" ;; #(
|
internal_cflags="$cc_warnings" ;; #(
|
||||||
*) :
|
*) :
|
||||||
common_cflags="-O" ;;
|
common_cflags="-O" ;;
|
||||||
|
@ -13668,6 +13723,10 @@ if test x"$enable_shared" != "xno"; then :
|
||||||
natdynlink=true ;; #(
|
natdynlink=true ;; #(
|
||||||
x86_64-*-linux*) :
|
x86_64-*-linux*) :
|
||||||
natdynlink=true ;; #(
|
natdynlink=true ;; #(
|
||||||
|
arm64-*-darwin*) :
|
||||||
|
natdynlink=true ;; #(
|
||||||
|
aarch64-*-darwin*) :
|
||||||
|
natdynlink=true ;; #(
|
||||||
x86_64-*-darwin*) :
|
x86_64-*-darwin*) :
|
||||||
natdynlink=true ;; #(
|
natdynlink=true ;; #(
|
||||||
s390x*-*-linux*) :
|
s390x*-*-linux*) :
|
||||||
|
@ -13865,6 +13924,10 @@ fi; system=elf ;; #(
|
||||||
arch=amd64; system=netbsd ;; #(
|
arch=amd64; system=netbsd ;; #(
|
||||||
x86_64-*-openbsd*) :
|
x86_64-*-openbsd*) :
|
||||||
arch=amd64; system=openbsd ;; #(
|
arch=amd64; system=openbsd ;; #(
|
||||||
|
arm64-*-darwin*) :
|
||||||
|
arch=arm64; system=macosx ;; #(
|
||||||
|
aarch64-*-darwin*) :
|
||||||
|
arch=arm64; system=macosx ;; #(
|
||||||
x86_64-*-darwin*) :
|
x86_64-*-darwin*) :
|
||||||
arch=amd64; system=macosx ;; #(
|
arch=amd64; system=macosx ;; #(
|
||||||
x86_64-*-mingw32) :
|
x86_64-*-mingw32) :
|
||||||
|
@ -14621,6 +14684,14 @@ if test "x$ac_cv_func_getcwd" = xyes; then :
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
|
ac_fn_c_check_decl "$LINENO" "system" "ac_cv_have_decl_system" "#include <stdlib.h>
|
||||||
|
"
|
||||||
|
if test "x$ac_cv_have_decl_system" = xyes; then :
|
||||||
|
$as_echo "#define HAS_SYSTEM 1" >>confdefs.h
|
||||||
|
|
||||||
|
fi
|
||||||
|
|
||||||
|
|
||||||
## utime
|
## utime
|
||||||
## Note: this was defined in config/s-nt.h but the autoconf macros do not
|
## Note: this was defined in config/s-nt.h but the autoconf macros do not
|
||||||
# seem to detect it properly on Windows so we hardcode the definition
|
# seem to detect it properly on Windows so we hardcode the definition
|
||||||
|
@ -16918,8 +16989,8 @@ fi
|
||||||
|
|
||||||
oc_cflags="$common_cflags $internal_cflags"
|
oc_cflags="$common_cflags $internal_cflags"
|
||||||
oc_cppflags="$common_cppflags $internal_cppflags"
|
oc_cppflags="$common_cppflags $internal_cppflags"
|
||||||
ocamlc_cflags="$common_cflags $sharedlib_cflags"
|
ocamlc_cflags="$common_cflags $sharedlib_cflags \$(CFLAGS)"
|
||||||
ocamlc_cppflags="$common_cppflags"
|
ocamlc_cppflags="$common_cppflags \$(CPPFLAGS)"
|
||||||
cclibs="$cclibs $mathlib"
|
cclibs="$cclibs $mathlib"
|
||||||
|
|
||||||
case $host in #(
|
case $host in #(
|
||||||
|
|
27
configure.ac
27
configure.ac
|
@ -37,7 +37,11 @@ programs_man_section=1
|
||||||
libraries_man_section=3
|
libraries_man_section=3
|
||||||
|
|
||||||
# Command to build executalbes
|
# Command to build executalbes
|
||||||
mkexe="\$(CC) \$(OC_CFLAGS) \$(OC_CPPFLAGS) \$(OC_LDFLAGS)"
|
# In general this command is supposed to use the CFLAGs-related variables
|
||||||
|
# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into
|
||||||
|
# account on Windows, because flexlink, which is used to build
|
||||||
|
# executables on this platform, can not handle them.
|
||||||
|
mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)"
|
||||||
|
|
||||||
# Flags for building executable files with debugging symbols
|
# Flags for building executable files with debugging symbols
|
||||||
mkexedebugflag="-g"
|
mkexedebugflag="-g"
|
||||||
|
@ -64,7 +68,7 @@ instrumented_runtime_ldlibs=""
|
||||||
## Source directory
|
## Source directory
|
||||||
AC_CONFIG_SRCDIR([runtime/interp.c])
|
AC_CONFIG_SRCDIR([runtime/interp.c])
|
||||||
|
|
||||||
## Directory containing auxiliary scripts used dugring build
|
## Directory containing auxiliary scripts used during build
|
||||||
AC_CONFIG_AUX_DIR([build-aux])
|
AC_CONFIG_AUX_DIR([build-aux])
|
||||||
|
|
||||||
## Output variables
|
## Output variables
|
||||||
|
@ -406,9 +410,14 @@ AS_IF([test x"$enable_unix_lib" = "xno" -o x"$enable_str_lib" = "xno"],
|
||||||
# User-specified LD still takes precedence.
|
# User-specified LD still takes precedence.
|
||||||
AC_CHECK_TOOLS([LD],[ld link])
|
AC_CHECK_TOOLS([LD],[ld link])
|
||||||
# libtool expects host_os=mingw for native Windows
|
# libtool expects host_os=mingw for native Windows
|
||||||
|
# Also, it has been observed that, on some platforms (e.g. msvc) LT_INIT
|
||||||
|
# alters the CFLAGS variable, so we save its value before calling the macro
|
||||||
|
# and restore it after the call
|
||||||
old_host_os=$host_os
|
old_host_os=$host_os
|
||||||
AS_IF([test x"$host_os" = "xwindows"],[host_os=mingw])
|
AS_IF([test x"$host_os" = "xwindows"],[host_os=mingw])
|
||||||
|
saved_CFLAGS="$CFLAGS"
|
||||||
LT_INIT
|
LT_INIT
|
||||||
|
CFLAGS="$saved_CFLAGS"
|
||||||
host_os=$old_host_os
|
host_os=$old_host_os
|
||||||
|
|
||||||
AS_CASE([$host],
|
AS_CASE([$host],
|
||||||
|
@ -628,7 +637,7 @@ AS_CASE([$host],
|
||||||
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
|
internal_cppflags="$internal_cppflags -DWINDOWS_UNICODE="
|
||||||
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
|
internal_cppflags="${internal_cppflags}\$(WINDOWS_UNICODE)"],
|
||||||
[xlc-*],
|
[xlc-*],
|
||||||
[common_cflags="-O5 -qtune=balanced -qnoipa -qinline $CFLAGS";
|
[common_cflags="-O5 -qtune=balanced -qnoipa -qinline";
|
||||||
internal_cflags="$cc_warnings"],
|
internal_cflags="$cc_warnings"],
|
||||||
[common_cflags="-O"])])
|
[common_cflags="-O"])])
|
||||||
|
|
||||||
|
@ -871,6 +880,8 @@ AS_IF([test x"$enable_shared" != "xno"],
|
||||||
[[i[3456]86-*-linux*]], [natdynlink=true],
|
[[i[3456]86-*-linux*]], [natdynlink=true],
|
||||||
[[i[3456]86-*-gnu*]], [natdynlink=true],
|
[[i[3456]86-*-gnu*]], [natdynlink=true],
|
||||||
[[x86_64-*-linux*]], [natdynlink=true],
|
[[x86_64-*-linux*]], [natdynlink=true],
|
||||||
|
[arm64-*-darwin*], [natdynlink=true],
|
||||||
|
[aarch64-*-darwin*], [natdynlink=true],
|
||||||
[x86_64-*-darwin*], [natdynlink=true],
|
[x86_64-*-darwin*], [natdynlink=true],
|
||||||
[s390x*-*-linux*], [natdynlink=true],
|
[s390x*-*-linux*], [natdynlink=true],
|
||||||
[powerpc*-*-linux*], [natdynlink=true],
|
[powerpc*-*-linux*], [natdynlink=true],
|
||||||
|
@ -977,6 +988,10 @@ AS_CASE([$host],
|
||||||
[arch=amd64; system=netbsd],
|
[arch=amd64; system=netbsd],
|
||||||
[x86_64-*-openbsd*],
|
[x86_64-*-openbsd*],
|
||||||
[arch=amd64; system=openbsd],
|
[arch=amd64; system=openbsd],
|
||||||
|
[arm64-*-darwin*],
|
||||||
|
[arch=arm64; system=macosx],
|
||||||
|
[aarch64-*-darwin*],
|
||||||
|
[arch=arm64; system=macosx],
|
||||||
[x86_64-*-darwin*],
|
[x86_64-*-darwin*],
|
||||||
[arch=amd64; system=macosx],
|
[arch=amd64; system=macosx],
|
||||||
[x86_64-*-mingw32],
|
[x86_64-*-mingw32],
|
||||||
|
@ -1314,6 +1329,8 @@ AC_CHECK_FUNC([mkfifo], [AC_DEFINE([HAS_MKFIFO])])
|
||||||
|
|
||||||
AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD])])
|
AC_CHECK_FUNC([getcwd], [AC_DEFINE([HAS_GETCWD])])
|
||||||
|
|
||||||
|
AC_CHECK_DECL([system], [AC_DEFINE([HAS_SYSTEM])], [], [[#include <stdlib.h>]])
|
||||||
|
|
||||||
## utime
|
## utime
|
||||||
## Note: this was defined in config/s-nt.h but the autoconf macros do not
|
## Note: this was defined in config/s-nt.h but the autoconf macros do not
|
||||||
# seem to detect it properly on Windows so we hardcode the definition
|
# seem to detect it properly on Windows so we hardcode the definition
|
||||||
|
@ -1843,8 +1860,8 @@ AS_IF([test x"$DEFAULT_STRING" = "xunsafe"],
|
||||||
|
|
||||||
oc_cflags="$common_cflags $internal_cflags"
|
oc_cflags="$common_cflags $internal_cflags"
|
||||||
oc_cppflags="$common_cppflags $internal_cppflags"
|
oc_cppflags="$common_cppflags $internal_cppflags"
|
||||||
ocamlc_cflags="$common_cflags $sharedlib_cflags"
|
ocamlc_cflags="$common_cflags $sharedlib_cflags \$(CFLAGS)"
|
||||||
ocamlc_cppflags="$common_cppflags"
|
ocamlc_cppflags="$common_cppflags \$(CPPFLAGS)"
|
||||||
cclibs="$cclibs $mathlib"
|
cclibs="$cclibs $mathlib"
|
||||||
|
|
||||||
AS_CASE([$host],
|
AS_CASE([$host],
|
||||||
|
|
|
@ -27,7 +27,6 @@ CAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
|
||||||
COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
|
COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
|
||||||
-safe-string -strict-sequence -strict-formats
|
-safe-string -strict-sequence -strict-formats
|
||||||
LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR)
|
LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR)
|
||||||
YACCFLAGS=
|
|
||||||
CAMLLEX=$(BEST_OCAMLLEX)
|
CAMLLEX=$(BEST_OCAMLLEX)
|
||||||
CAMLDEP=$(BEST_OCAMLDEP)
|
CAMLDEP=$(BEST_OCAMLDEP)
|
||||||
DEPFLAGS=-slash
|
DEPFLAGS=-slash
|
||||||
|
|
|
@ -181,7 +181,7 @@ let new_checkpoint_list checkpoint_count accepted rejected =
|
||||||
let (k, l) =
|
let (k, l) =
|
||||||
list_truncate2 (checkpoint_count - List.length accepted) rejected
|
list_truncate2 (checkpoint_count - List.length accepted) rejected
|
||||||
in
|
in
|
||||||
(List.merge (fun {c_time = t1} {c_time = t2} -> compare t2 t1) accepted k,
|
(List.merge (fun t1 t2 -> compare t2.c_time t1.c_time) accepted k,
|
||||||
l)
|
l)
|
||||||
|
|
||||||
(* Clean the checkpoint list. *)
|
(* Clean the checkpoint list. *)
|
||||||
|
|
|
@ -458,17 +458,18 @@ let read_one_param ppf position name v =
|
||||||
let read_OCAMLPARAM ppf position =
|
let read_OCAMLPARAM ppf position =
|
||||||
try
|
try
|
||||||
let s = Sys.getenv "OCAMLPARAM" in
|
let s = Sys.getenv "OCAMLPARAM" in
|
||||||
let (before, after) =
|
if s <> "" then
|
||||||
try
|
let (before, after) =
|
||||||
parse_args s
|
try
|
||||||
with SyntaxError s ->
|
parse_args s
|
||||||
print_error ppf s;
|
with SyntaxError s ->
|
||||||
[],[]
|
print_error ppf s;
|
||||||
in
|
[],[]
|
||||||
List.iter (fun (name, v) -> read_one_param ppf position name v)
|
in
|
||||||
(match position with
|
List.iter (fun (name, v) -> read_one_param ppf position name v)
|
||||||
Before_args -> before
|
(match position with
|
||||||
| Before_compile _ | Before_link -> after)
|
Before_args -> before
|
||||||
|
| Before_compile _ | Before_link -> after)
|
||||||
with Not_found -> ()
|
with Not_found -> ()
|
||||||
|
|
||||||
(* OCAMLPARAM passed as file *)
|
(* OCAMLPARAM passed as file *)
|
||||||
|
|
|
@ -615,7 +615,7 @@ let rec emit_tail_infos is_tail lambda =
|
||||||
| Default_tailcall -> ()
|
| Default_tailcall -> ()
|
||||||
| Should_be_tailcall ->
|
| Should_be_tailcall ->
|
||||||
(* Note: we may want to instead check the call_kind,
|
(* Note: we may want to instead check the call_kind,
|
||||||
which takes [is_tail_native_heuristic] into accout.
|
which takes [is_tail_native_heuristic] into account.
|
||||||
But then this means getting different warnings depending
|
But then this means getting different warnings depending
|
||||||
on whether the native or bytecode compiler is used. *)
|
on whether the native or bytecode compiler is used. *)
|
||||||
if not is_tail
|
if not is_tail
|
||||||
|
|
|
@ -733,25 +733,53 @@ and transl_apply ~scopes
|
||||||
sargs)
|
sargs)
|
||||||
: Lambda.lambda)
|
: Lambda.lambda)
|
||||||
|
|
||||||
and transl_function0
|
and transl_curried_function
|
||||||
~scopes loc return untuplify_fn max_arity
|
~scopes loc return
|
||||||
|
repr partial (param:Ident.t) cases =
|
||||||
|
let max_arity = Lambda.max_arity () in
|
||||||
|
let rec loop ~scopes loc return ~arity partial (param:Ident.t) cases =
|
||||||
|
match cases with
|
||||||
|
[{c_lhs=pat; c_guard=None;
|
||||||
|
c_rhs={exp_desc =
|
||||||
|
Texp_function
|
||||||
|
{ arg_label = _; param = param'; cases = cases';
|
||||||
|
partial = partial'; }; exp_env; exp_type;exp_loc}}]
|
||||||
|
when arity < max_arity ->
|
||||||
|
if Parmatch.inactive ~partial pat
|
||||||
|
then
|
||||||
|
let kind = value_kind pat.pat_env pat.pat_type in
|
||||||
|
let return_kind = function_return_value_kind exp_env exp_type in
|
||||||
|
let ((_, params, return), body) =
|
||||||
|
loop ~scopes exp_loc return_kind ~arity:(arity + 1)
|
||||||
|
partial' param' cases'
|
||||||
|
in
|
||||||
|
((Curried, (param, kind) :: params, return),
|
||||||
|
Matching.for_function ~scopes loc None (Lvar param)
|
||||||
|
[pat, body] partial)
|
||||||
|
else begin
|
||||||
|
begin match partial with
|
||||||
|
| Total ->
|
||||||
|
Location.prerr_warning pat.pat_loc
|
||||||
|
Match_on_mutable_state_prevent_uncurry
|
||||||
|
| Partial -> ()
|
||||||
|
end;
|
||||||
|
transl_tupled_function ~scopes ~arity
|
||||||
|
loc return repr partial param cases
|
||||||
|
end
|
||||||
|
| cases ->
|
||||||
|
transl_tupled_function ~scopes ~arity
|
||||||
|
loc return repr partial param cases
|
||||||
|
in
|
||||||
|
loop ~scopes loc return ~arity:1 partial param cases
|
||||||
|
|
||||||
|
and transl_tupled_function
|
||||||
|
~scopes ~arity loc return
|
||||||
repr partial (param:Ident.t) cases =
|
repr partial (param:Ident.t) cases =
|
||||||
match cases with
|
match cases with
|
||||||
[{c_lhs=pat; c_guard=None;
|
|
||||||
c_rhs={exp_desc = Texp_function { arg_label = _; param = param'; cases;
|
|
||||||
partial = partial'; }; exp_env; exp_type} as exp}]
|
|
||||||
when max_arity > 1 && Parmatch.inactive ~partial pat ->
|
|
||||||
let kind = value_kind pat.pat_env pat.pat_type in
|
|
||||||
let return_kind = function_return_value_kind exp_env exp_type in
|
|
||||||
let ((_, params, return), body) =
|
|
||||||
transl_function0 ~scopes exp.exp_loc return_kind false (max_arity - 1)
|
|
||||||
repr partial' param' cases
|
|
||||||
in
|
|
||||||
((Curried, (param, kind) :: params, return),
|
|
||||||
Matching.for_function ~scopes loc None (Lvar param)
|
|
||||||
[pat, body] partial)
|
|
||||||
| {c_lhs={pat_desc = Tpat_tuple pl}} :: _
|
| {c_lhs={pat_desc = Tpat_tuple pl}} :: _
|
||||||
when untuplify_fn && List.length pl <= max_arity ->
|
when !Clflags.native_code
|
||||||
|
&& arity = 1
|
||||||
|
&& List.length pl <= (Lambda.max_arity ()) ->
|
||||||
begin try
|
begin try
|
||||||
let size = List.length pl in
|
let size = List.length pl in
|
||||||
let pats_expr_list =
|
let pats_expr_list =
|
||||||
|
@ -783,28 +811,30 @@ and transl_function0
|
||||||
((Tupled, tparams, return),
|
((Tupled, tparams, return),
|
||||||
Matching.for_tupled_function ~scopes loc params
|
Matching.for_tupled_function ~scopes loc params
|
||||||
(transl_tupled_cases ~scopes pats_expr_list) partial)
|
(transl_tupled_cases ~scopes pats_expr_list) partial)
|
||||||
with Matching.Cannot_flatten ->
|
with Matching.Cannot_flatten ->
|
||||||
((Curried, [param, Pgenval], return),
|
transl_function0 ~scopes loc return repr partial param cases
|
||||||
Matching.for_function ~scopes loc repr (Lvar param)
|
|
||||||
(transl_cases ~scopes cases) partial)
|
|
||||||
end
|
end
|
||||||
| {c_lhs=pat} :: other_cases ->
|
| _ -> transl_function0 ~scopes loc return repr partial param cases
|
||||||
let kind =
|
|
||||||
|
and transl_function0
|
||||||
|
~scopes loc return
|
||||||
|
repr partial (param:Ident.t) cases =
|
||||||
|
let kind =
|
||||||
|
match cases with
|
||||||
|
| [] ->
|
||||||
|
(* With Camlp4, a pattern matching might be empty *)
|
||||||
|
Pgenval
|
||||||
|
| {c_lhs=pat} :: other_cases ->
|
||||||
(* All the patterns might not share the same types. We must take the
|
(* All the patterns might not share the same types. We must take the
|
||||||
union of the patterns types *)
|
union of the patterns types *)
|
||||||
List.fold_left (fun k {c_lhs=pat} ->
|
List.fold_left (fun k {c_lhs=pat} ->
|
||||||
Typeopt.value_kind_union k
|
Typeopt.value_kind_union k
|
||||||
(value_kind pat.pat_env pat.pat_type))
|
(value_kind pat.pat_env pat.pat_type))
|
||||||
(value_kind pat.pat_env pat.pat_type) other_cases
|
(value_kind pat.pat_env pat.pat_type) other_cases
|
||||||
in
|
in
|
||||||
((Curried, [param, kind], return),
|
((Curried, [param, kind], return),
|
||||||
Matching.for_function ~scopes loc repr (Lvar param)
|
Matching.for_function ~scopes loc repr (Lvar param)
|
||||||
(transl_cases ~scopes cases) partial)
|
(transl_cases ~scopes cases) partial)
|
||||||
| [] ->
|
|
||||||
(* With Camlp4, a pattern matching might be empty *)
|
|
||||||
((Curried, [param, Pgenval], return),
|
|
||||||
Matching.for_function ~scopes loc repr (Lvar param)
|
|
||||||
(transl_cases ~scopes cases) partial)
|
|
||||||
|
|
||||||
and transl_function ~scopes e param cases partial =
|
and transl_function ~scopes e param cases partial =
|
||||||
let ((kind, params, return), body) =
|
let ((kind, params, return), body) =
|
||||||
|
@ -812,8 +842,7 @@ and transl_function ~scopes e param cases partial =
|
||||||
(function repr ->
|
(function repr ->
|
||||||
let pl = push_defaults e.exp_loc [] cases partial in
|
let pl = push_defaults e.exp_loc [] cases partial in
|
||||||
let return_kind = function_return_value_kind e.exp_env e.exp_type in
|
let return_kind = function_return_value_kind e.exp_env e.exp_type in
|
||||||
transl_function0 ~scopes e.exp_loc return_kind
|
transl_curried_function ~scopes e.exp_loc return_kind
|
||||||
!Clflags.native_code (Lambda.max_arity())
|
|
||||||
repr partial param pl)
|
repr partial param pl)
|
||||||
in
|
in
|
||||||
let attr = default_function_attribute in
|
let attr = default_function_attribute in
|
||||||
|
@ -1107,8 +1136,7 @@ and transl_letop ~scopes loc env let_ ands param case partial =
|
||||||
let (kind, params, return), body =
|
let (kind, params, return), body =
|
||||||
event_function ~scopes case.c_rhs
|
event_function ~scopes case.c_rhs
|
||||||
(function repr ->
|
(function repr ->
|
||||||
transl_function0 ~scopes case.c_rhs.exp_loc return_kind
|
transl_curried_function ~scopes case.c_rhs.exp_loc return_kind
|
||||||
!Clflags.native_code (Lambda.max_arity())
|
|
||||||
repr partial param [case])
|
repr partial param [case])
|
||||||
in
|
in
|
||||||
let attr = default_function_attribute in
|
let attr = default_function_attribute in
|
||||||
|
|
|
@ -27,7 +27,6 @@ CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -nostdlib -I $(ROOTDIR)/stdlib
|
||||||
COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
|
COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
|
||||||
-safe-string -strict-sequence -strict-formats -bin-annot
|
-safe-string -strict-sequence -strict-formats -bin-annot
|
||||||
LINKFLAGS =
|
LINKFLAGS =
|
||||||
YACCFLAGS = -v
|
|
||||||
CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
|
CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
|
||||||
CAMLDEP = $(BOOT_OCAMLC) -depend
|
CAMLDEP = $(BOOT_OCAMLC) -depend
|
||||||
DEPFLAGS = -slash
|
DEPFLAGS = -slash
|
||||||
|
@ -56,7 +55,7 @@ clean::
|
||||||
rm -f *.cmo *.cmi *.cmx *.cmt *.cmti *.o *.obj
|
rm -f *.cmo *.cmi *.cmx *.cmt *.cmti *.o *.obj
|
||||||
|
|
||||||
parser.ml parser.mli: parser.mly
|
parser.ml parser.mli: parser.mly
|
||||||
$(CAMLYACC) $(YACCFLAGS) parser.mly
|
$(CAMLYACC) -v parser.mly
|
||||||
|
|
||||||
clean::
|
clean::
|
||||||
rm -f parser.ml parser.mli parser.output
|
rm -f parser.ml parser.mli parser.output
|
||||||
|
|
|
@ -960,6 +960,10 @@ mutually recursive types.
|
||||||
67
|
67
|
||||||
\ \ Unused functor parameter.
|
\ \ Unused functor parameter.
|
||||||
|
|
||||||
|
68
|
||||||
|
\ \ Pattern-matching depending on mutable state prevents the remaining
|
||||||
|
arguments from being uncurried.
|
||||||
|
|
||||||
The letters stand for the following sets of warnings. Any letter not
|
The letters stand for the following sets of warnings. Any letter not
|
||||||
mentioned here corresponds to the empty set.
|
mentioned here corresponds to the empty set.
|
||||||
|
|
||||||
|
@ -1013,7 +1017,7 @@ mentioned here corresponds to the empty set.
|
||||||
|
|
||||||
.IP
|
.IP
|
||||||
The default setting is
|
The default setting is
|
||||||
.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66 .
|
.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66\-67\-68 .
|
||||||
Note that warnings
|
Note that warnings
|
||||||
.BR 5 \ and \ 10
|
.BR 5 \ and \ 10
|
||||||
are not always triggered, depending on the internals of the type checker.
|
are not always triggered, depending on the internals of the type checker.
|
||||||
|
|
|
@ -46,6 +46,7 @@ the above 4 modules \\
|
||||||
"Int" & p.~\pageref{Int} & integer values \\
|
"Int" & p.~\pageref{Int} & integer values \\
|
||||||
"Option" & p.~\pageref{Option} & option values \\
|
"Option" & p.~\pageref{Option} & option values \\
|
||||||
"Result" & p.~\pageref{Result} & result values \\
|
"Result" & p.~\pageref{Result} & result values \\
|
||||||
|
"Either" & p.~\pageref{Either} & either values \\
|
||||||
"Hashtbl" & p.~\pageref{Hashtbl} & hash tables and hash functions \\
|
"Hashtbl" & p.~\pageref{Hashtbl} & hash tables and hash functions \\
|
||||||
"Random" & p.~\pageref{Random} & pseudo-random number generator \\
|
"Random" & p.~\pageref{Random} & pseudo-random number generator \\
|
||||||
"Set" & p.~\pageref{Set} & sets over ordered types \\
|
"Set" & p.~\pageref{Set} & sets over ordered types \\
|
||||||
|
|
|
@ -42,7 +42,7 @@ Labels obey the same rules as other identifiers in OCaml, that is you
|
||||||
cannot use a reserved keyword (like "in" or "to") as label.
|
cannot use a reserved keyword (like "in" or "to") as label.
|
||||||
|
|
||||||
Formal parameters and arguments are matched according to their
|
Formal parameters and arguments are matched according to their
|
||||||
respective labels\footnote{This correspond to the commuting label mode
|
respective labels\footnote{This corresponds to the commuting label mode
|
||||||
of Objective Caml 3.00 through 3.02, with some additional flexibility
|
of Objective Caml 3.00 through 3.02, with some additional flexibility
|
||||||
on total applications. The so-called classic mode ("-nolabels"
|
on total applications. The so-called classic mode ("-nolabels"
|
||||||
options) is now deprecated for normal use.}, the absence of label
|
options) is now deprecated for normal use.}, the absence of label
|
||||||
|
|
|
@ -388,8 +388,14 @@ module Analyser =
|
||||||
| Cstr_record l ->
|
| Cstr_record l ->
|
||||||
Cstr_record (List.map (get_field env name_comment_list) l)
|
Cstr_record (List.map (get_field env name_comment_list) l)
|
||||||
in
|
in
|
||||||
|
let vc_name = match constructor_name with
|
||||||
|
| "::" ->
|
||||||
|
(* The only infix constructor is always printed (::) *)
|
||||||
|
"(::)"
|
||||||
|
| s -> s
|
||||||
|
in
|
||||||
{
|
{
|
||||||
vc_name = constructor_name ;
|
vc_name;
|
||||||
vc_args;
|
vc_args;
|
||||||
vc_ret = Option.map (Odoc_env.subst_type env) ret_type;
|
vc_ret = Option.map (Odoc_env.subst_type env) ret_type;
|
||||||
vc_text = comment_opt
|
vc_text = comment_opt
|
||||||
|
|
|
@ -346,12 +346,20 @@ ocamltest_config.cmx : \
|
||||||
ocamltest_config.cmi
|
ocamltest_config.cmi
|
||||||
ocamltest_config.cmi :
|
ocamltest_config.cmi :
|
||||||
ocamltest_stdlib.cmo : \
|
ocamltest_stdlib.cmo : \
|
||||||
|
ocamltest_unix.cmi \
|
||||||
ocamltest_config.cmi \
|
ocamltest_config.cmi \
|
||||||
ocamltest_stdlib.cmi
|
ocamltest_stdlib.cmi
|
||||||
ocamltest_stdlib.cmx : \
|
ocamltest_stdlib.cmx : \
|
||||||
|
ocamltest_unix.cmx \
|
||||||
ocamltest_config.cmx \
|
ocamltest_config.cmx \
|
||||||
ocamltest_stdlib.cmi
|
ocamltest_stdlib.cmi
|
||||||
ocamltest_stdlib.cmi :
|
ocamltest_stdlib.cmi : \
|
||||||
|
ocamltest_unix.cmi
|
||||||
|
ocamltest_unix.cmo : \
|
||||||
|
ocamltest_unix.cmi
|
||||||
|
ocamltest_unix.cmx : \
|
||||||
|
ocamltest_unix.cmi
|
||||||
|
ocamltest_unix.cmi :
|
||||||
options.cmo : \
|
options.cmo : \
|
||||||
variables.cmi \
|
variables.cmi \
|
||||||
tests.cmi \
|
tests.cmi \
|
||||||
|
|
|
@ -33,8 +33,16 @@ else
|
||||||
endif
|
endif
|
||||||
|
|
||||||
ifeq "$(filter $(UNIXLIB),$(OTHERLIBRARIES))" ""
|
ifeq "$(filter $(UNIXLIB),$(OTHERLIBRARIES))" ""
|
||||||
|
ocamltest_unix := dummy
|
||||||
|
unix_name :=
|
||||||
|
unix_path :=
|
||||||
unix := None
|
unix := None
|
||||||
|
unix_include :=
|
||||||
else
|
else
|
||||||
|
ocamltest_unix := real
|
||||||
|
unix_name := unix
|
||||||
|
unix_path := $(ROOTDIR)/otherlibs/$(UNIXLIB)
|
||||||
|
unix_include := -I $(unix_path) $(EMPTY)
|
||||||
ifeq "$(UNIX_OR_WIN32)" "win32"
|
ifeq "$(UNIX_OR_WIN32)" "win32"
|
||||||
unix := Some false
|
unix := Some false
|
||||||
else
|
else
|
||||||
|
@ -97,8 +105,8 @@ endif
|
||||||
|
|
||||||
core := \
|
core := \
|
||||||
$(run_source) run_stubs.c \
|
$(run_source) run_stubs.c \
|
||||||
ocamltest_stdlib_stubs.c \
|
|
||||||
ocamltest_config.mli ocamltest_config.ml.in \
|
ocamltest_config.mli ocamltest_config.ml.in \
|
||||||
|
ocamltest_unix.mli ocamltest_unix.ml \
|
||||||
ocamltest_stdlib.mli ocamltest_stdlib.ml \
|
ocamltest_stdlib.mli ocamltest_stdlib.ml \
|
||||||
run_command.mli run_command.ml \
|
run_command.mli run_command.ml \
|
||||||
filecompare.mli filecompare.ml \
|
filecompare.mli filecompare.ml \
|
||||||
|
@ -166,6 +174,7 @@ parsers := $(filter %.mly,$(sources))
|
||||||
config_files := $(filter %.ml.in,$(sources))
|
config_files := $(filter %.ml.in,$(sources))
|
||||||
|
|
||||||
dependencies_generated_prereqs := \
|
dependencies_generated_prereqs := \
|
||||||
|
ocamltest_unix.ml \
|
||||||
$(config_files:.ml.in=.ml) \
|
$(config_files:.ml.in=.ml) \
|
||||||
$(lexers:.mll=.ml) \
|
$(lexers:.mll=.ml) \
|
||||||
$(parsers:.mly=.mli) $(parsers:.mly=.ml)
|
$(parsers:.mly=.mli) $(parsers:.mly=.ml)
|
||||||
|
@ -185,9 +194,9 @@ flags := -g -nostdlib $(include_directories) \
|
||||||
-strict-sequence -safe-string -strict-formats \
|
-strict-sequence -safe-string -strict-formats \
|
||||||
-w +a-4-9-41-42-44-45-48 -warn-error A
|
-w +a-4-9-41-42-44-45-48 -warn-error A
|
||||||
|
|
||||||
ocamlc := $(BEST_OCAMLC) $(flags)
|
ocamlc = $(BEST_OCAMLC) $(flags)
|
||||||
|
|
||||||
ocamlopt := $(BEST_OCAMLOPT) $(flags)
|
ocamlopt = $(BEST_OCAMLOPT) $(flags)
|
||||||
|
|
||||||
ocamldep := $(BEST_OCAMLDEP)
|
ocamldep := $(BEST_OCAMLDEP)
|
||||||
depflags := -slash
|
depflags := -slash
|
||||||
|
@ -210,26 +219,29 @@ opt.opt: allopt
|
||||||
|
|
||||||
compdeps_names=ocamlcommon ocamlbytecomp
|
compdeps_names=ocamlcommon ocamlbytecomp
|
||||||
compdeps_paths=$(addprefix $(ROOTDIR)/compilerlibs/,$(compdeps_names))
|
compdeps_paths=$(addprefix $(ROOTDIR)/compilerlibs/,$(compdeps_names))
|
||||||
compdeps_byte=$(addsuffix .cma,$(compdeps_paths))
|
deps_paths=$(compdeps_paths) $(addprefix $(unix_path)/,$(unix_name))
|
||||||
compdeps_opt=$(addsuffix .cmxa,$(compdeps_paths))
|
deps_byte=$(addsuffix .cma,$(deps_paths))
|
||||||
|
deps_opt=$(addsuffix .cmxa,$(deps_paths))
|
||||||
|
|
||||||
$(eval $(call PROGRAM_SYNONYM,ocamltest))
|
$(eval $(call PROGRAM_SYNONYM,ocamltest))
|
||||||
|
|
||||||
ocamltest$(EXE): $(compdeps_byte) $(bytecode_modules)
|
ocamltest_unix.%: flags+=$(unix_include) -opaque
|
||||||
$(ocamlc_cmd) -custom -o $@ $^
|
|
||||||
|
|
||||||
%.cmo: %.ml $(compdeps_byte)
|
ocamltest$(EXE): $(deps_byte) $(bytecode_modules)
|
||||||
|
$(ocamlc_cmd) $(unix_include)-custom -o $@ $^
|
||||||
|
|
||||||
|
%.cmo: %.ml $(deps_byte)
|
||||||
$(ocamlc) -c $<
|
$(ocamlc) -c $<
|
||||||
|
|
||||||
$(eval $(call PROGRAM_SYNONYM,ocamltest.opt))
|
$(eval $(call PROGRAM_SYNONYM,ocamltest.opt))
|
||||||
|
|
||||||
ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules)
|
ocamltest.opt$(EXE): $(deps_opt) $(native_modules)
|
||||||
$(ocamlopt_cmd) -o $@ $^
|
$(ocamlopt_cmd) $(unix_include)-o $@ $^
|
||||||
|
|
||||||
%.cmx: %.ml $(compdeps_opt)
|
%.cmx: %.ml $(deps_opt)
|
||||||
$(ocamlopt) -c $<
|
$(ocamlopt) -c $<
|
||||||
|
|
||||||
%.cmi: %.mli $(compdeps_byte)
|
%.cmi: %.mli $(deps_byte)
|
||||||
$(ocamlc) -c $<
|
$(ocamlc) -c $<
|
||||||
|
|
||||||
%.ml %.mli: %.mly
|
%.ml %.mli: %.mly
|
||||||
|
@ -238,6 +250,10 @@ ocamltest.opt$(EXE): $(compdeps_opt) $(native_modules)
|
||||||
%.ml: %.mll
|
%.ml: %.mll
|
||||||
$(ocamllex) $(OCAMLLEX_FLAGS) $<
|
$(ocamllex) $(OCAMLLEX_FLAGS) $<
|
||||||
|
|
||||||
|
ocamltest_unix.ml: ocamltest_unix_$(ocamltest_unix).ml
|
||||||
|
echo '# 1 "$^"' > $@
|
||||||
|
cat $^ >> $@
|
||||||
|
|
||||||
ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config
|
ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config
|
||||||
sed $(call SUBST,AFL_INSTRUMENT) \
|
sed $(call SUBST,AFL_INSTRUMENT) \
|
||||||
$(call SUBST,RUNTIMEI) \
|
$(call SUBST,RUNTIMEI) \
|
||||||
|
@ -304,7 +320,7 @@ include $(addprefix $(DEPDIR)/, $(c_files:.c=.$(D)))
|
||||||
endif
|
endif
|
||||||
|
|
||||||
$(DEPDIR)/%.$(D): %.c | $(DEPDIR)
|
$(DEPDIR)/%.$(D): %.c | $(DEPDIR)
|
||||||
$(DEP_CC) $(OC_CPPFLAGS) $< -MT '$*.$(O)' -MF $@
|
$(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@
|
||||||
|
|
||||||
.PHONY: depend
|
.PHONY: depend
|
||||||
depend: $(dependencies_generated_prereqs)
|
depend: $(dependencies_generated_prereqs)
|
||||||
|
|
|
@ -62,13 +62,25 @@ let files env = words_of_variable env Builtin_variables.files
|
||||||
|
|
||||||
let setup_symlinks test_source_directory build_directory files =
|
let setup_symlinks test_source_directory build_directory files =
|
||||||
let symlink filename =
|
let symlink filename =
|
||||||
|
(* Emulate ln -sfT *)
|
||||||
let src = Filename.concat test_source_directory filename in
|
let src = Filename.concat test_source_directory filename in
|
||||||
Sys.run_system_command "ln" ["-sf"; src; build_directory] in
|
let dst = Filename.concat build_directory filename in
|
||||||
|
let () =
|
||||||
|
if Sys.file_exists dst then
|
||||||
|
if Sys.win32 && Sys.is_directory dst then
|
||||||
|
(* Native symbolic links to directories don't disappear with unlink;
|
||||||
|
doing rmdir here is technically slightly more than ln -sfT would
|
||||||
|
do *)
|
||||||
|
Sys.rmdir dst
|
||||||
|
else
|
||||||
|
Sys.remove dst
|
||||||
|
in
|
||||||
|
Unix.symlink src dst in
|
||||||
let copy filename =
|
let copy filename =
|
||||||
let src = Filename.concat test_source_directory filename in
|
let src = Filename.concat test_source_directory filename in
|
||||||
let dst = Filename.concat build_directory filename in
|
let dst = Filename.concat build_directory filename in
|
||||||
Sys.copy_file src dst in
|
Sys.copy_file src dst in
|
||||||
let f = if Sys.win32 then copy else symlink in
|
let f = if Unix.has_symlink () then symlink else copy in
|
||||||
Sys.make_directory build_directory;
|
Sys.make_directory build_directory;
|
||||||
List.iter f files
|
List.iter f files
|
||||||
|
|
||||||
|
|
|
@ -195,7 +195,7 @@ let naked_pointers = make
|
||||||
|
|
||||||
let has_symlink = make
|
let has_symlink = make
|
||||||
"has_symlink"
|
"has_symlink"
|
||||||
(Actions_helpers.pass_or_skip (Sys.has_symlink () )
|
(Actions_helpers.pass_or_skip (Unix.has_symlink () )
|
||||||
"symlinks available"
|
"symlinks available"
|
||||||
"symlinks not available")
|
"symlinks not available")
|
||||||
|
|
||||||
|
|
|
@ -59,33 +59,103 @@ type files = {
|
||||||
output_filename : string;
|
output_filename : string;
|
||||||
}
|
}
|
||||||
|
|
||||||
let read_text_file lines_to_drop fn =
|
let last_is_cr s =
|
||||||
Sys.with_input_file ~bin:true fn @@ fun ic ->
|
let l = String.length s in
|
||||||
let drop_cr s =
|
l > 0 && s.[l - 1] = '\r'
|
||||||
let l = String.length s in
|
|
||||||
if l > 0 && s.[l - 1] = '\r' then String.sub s 0 (l - 1)
|
|
||||||
else raise Exit
|
|
||||||
in
|
|
||||||
let rec drop k =
|
|
||||||
if k = 0 then
|
|
||||||
loop []
|
|
||||||
else
|
|
||||||
let stop = try ignore (input_line ic); false with End_of_file -> true in
|
|
||||||
if stop then [] else drop (k-1)
|
|
||||||
and loop acc =
|
|
||||||
match input_line ic with
|
|
||||||
| s -> loop (s :: acc)
|
|
||||||
| exception End_of_file ->
|
|
||||||
try List.rev_map drop_cr acc
|
|
||||||
with Exit -> List.rev acc
|
|
||||||
in
|
|
||||||
drop lines_to_drop
|
|
||||||
|
|
||||||
let compare_text_files dropped_lines file1 file2 =
|
(* Returns last character of an input file. Fails for an empty file. *)
|
||||||
if read_text_file 0 file1 = read_text_file dropped_lines file2 then
|
let last_char ic =
|
||||||
Same
|
seek_in ic (in_channel_length ic - 1);
|
||||||
else
|
input_char ic
|
||||||
Different
|
|
||||||
|
(* [line_seq_of_in_channel ~normalise ic first_line] constructs a sequence of
|
||||||
|
the lines of [ic] where [first_line] is the already read first line of [ic].
|
||||||
|
Strings include the line terminator and CRLF is normalised to LF if
|
||||||
|
[normalise] is [true]. The sequence raises [Exit] if normalise is [true] and
|
||||||
|
a terminated line is encountered which does not end CRLF. The final line of
|
||||||
|
the sequence only includes a terminator if it is present in the file (and a
|
||||||
|
terminating CR is never normalised if not strictly followed by LF). *)
|
||||||
|
let line_seq_of_in_channel ~normalise ic =
|
||||||
|
let normalise =
|
||||||
|
if normalise then
|
||||||
|
fun s ->
|
||||||
|
if last_is_cr s then
|
||||||
|
String.sub s 0 (String.length s - 1)
|
||||||
|
else
|
||||||
|
raise Exit
|
||||||
|
else
|
||||||
|
Fun.id
|
||||||
|
in
|
||||||
|
let rec read_line last () =
|
||||||
|
(* Read the next line to determine if the last line ended with LF *)
|
||||||
|
match input_line ic with
|
||||||
|
| line ->
|
||||||
|
Seq.Cons (normalise last ^ "\n", read_line line)
|
||||||
|
| exception End_of_file ->
|
||||||
|
(* EOF reached - seek the last character to determine if the final
|
||||||
|
line ends in LF *)
|
||||||
|
let last =
|
||||||
|
if last_char ic = '\n' then
|
||||||
|
normalise last ^ "\n"
|
||||||
|
else
|
||||||
|
last
|
||||||
|
in
|
||||||
|
Seq.Cons (last, Seq.empty)
|
||||||
|
in
|
||||||
|
read_line
|
||||||
|
|
||||||
|
let compare_text_files ignored_lines file1 file2 =
|
||||||
|
Sys.with_input_file ~bin:true file2 @@ fun ic2 ->
|
||||||
|
(* Get the first non-dropped line of file2 and determine if could be
|
||||||
|
CRLF-normalised (it can't be in any of the dropped lines didn't end
|
||||||
|
CRLF. *)
|
||||||
|
let (crlf_endings2, line2, reached_end_file2) =
|
||||||
|
let rec loop crlf_endings2 k =
|
||||||
|
match input_line ic2 with
|
||||||
|
| line ->
|
||||||
|
let crlf_endings2 = crlf_endings2 && last_is_cr line in
|
||||||
|
if k = 0 then
|
||||||
|
(crlf_endings2, line, false)
|
||||||
|
else
|
||||||
|
loop crlf_endings2 (pred k)
|
||||||
|
| exception End_of_file ->
|
||||||
|
(false, "", true)
|
||||||
|
in
|
||||||
|
loop true ignored_lines
|
||||||
|
in
|
||||||
|
Sys.with_input_file ~bin:true file1 @@ fun ic1 ->
|
||||||
|
if reached_end_file2 then
|
||||||
|
(* We reached the end of file2 while ignoring lines, so only an empty
|
||||||
|
file can be identical, as in the binary comparison case. *)
|
||||||
|
if in_channel_length ic1 = 0 then
|
||||||
|
Same
|
||||||
|
else
|
||||||
|
Different
|
||||||
|
else
|
||||||
|
(* file2 has at least one non-ignored line *)
|
||||||
|
match input_line ic1 with
|
||||||
|
| exception End_of_file -> Different
|
||||||
|
| line1 ->
|
||||||
|
let crlf_endings1 = last_is_cr line1 in
|
||||||
|
(* If both files appear to have CRLF endings, then there's no need
|
||||||
|
to attempt to normalise either. *)
|
||||||
|
let seq1 =
|
||||||
|
let normalise = crlf_endings1 && not crlf_endings2 in
|
||||||
|
line_seq_of_in_channel ~normalise ic1 line1 in
|
||||||
|
let seq2 =
|
||||||
|
let normalise = crlf_endings2 && not crlf_endings1 in
|
||||||
|
line_seq_of_in_channel ~normalise ic2 line2 in
|
||||||
|
try
|
||||||
|
if Seq.equal seq1 seq2 then
|
||||||
|
Same
|
||||||
|
else
|
||||||
|
raise Exit
|
||||||
|
with Exit ->
|
||||||
|
(* Either the lines weren't equal, or the file which was being
|
||||||
|
normalised suddenly had a line which didn't end CRLF. In this
|
||||||
|
case, the files must differ since only one file is ever being
|
||||||
|
normalised, so the earlier lines differed too. *)
|
||||||
|
Different
|
||||||
|
|
||||||
(* Version of Stdlib.really_input which stops at EOF, rather than raising
|
(* Version of Stdlib.really_input which stops at EOF, rather than raising
|
||||||
an exception. *)
|
an exception. *)
|
||||||
|
@ -161,13 +231,15 @@ let diff files =
|
||||||
let temporary_file = Filename.temp_file "ocamltest" "diff" in
|
let temporary_file = Filename.temp_file "ocamltest" "diff" in
|
||||||
let diff_commandline =
|
let diff_commandline =
|
||||||
Filename.quote_command "diff" ~stdout:temporary_file
|
Filename.quote_command "diff" ~stdout:temporary_file
|
||||||
[ "-u";
|
[ "--strip-trailing-cr"; "-u";
|
||||||
files.reference_filename;
|
files.reference_filename;
|
||||||
files.output_filename ]
|
files.output_filename ]
|
||||||
in
|
in
|
||||||
let result =
|
let result =
|
||||||
if (Sys.command diff_commandline) = 2 then Stdlib.Error "diff"
|
match Sys.command diff_commandline with
|
||||||
else Ok (Sys.string_of_file temporary_file)
|
| 0 -> Ok "Inconsistent LF/CRLF line-endings"
|
||||||
|
| 2 -> Stdlib.Error "diff"
|
||||||
|
| _ -> Ok (Sys.string_of_file temporary_file)
|
||||||
in
|
in
|
||||||
Sys.force_remove temporary_file;
|
Sys.force_remove temporary_file;
|
||||||
result
|
result
|
||||||
|
|
|
@ -152,9 +152,9 @@ let test_file test_filename =
|
||||||
let test_build_directory_prefix =
|
let test_build_directory_prefix =
|
||||||
get_test_build_directory_prefix test_directory in
|
get_test_build_directory_prefix test_directory in
|
||||||
let clean_test_build_directory () =
|
let clean_test_build_directory () =
|
||||||
ignore
|
try
|
||||||
(Sys.command
|
Sys.rm_rf test_build_directory_prefix
|
||||||
(Filename.quote_command "rm" ["-rf"; test_build_directory_prefix]))
|
with Sys_error _ -> ()
|
||||||
in
|
in
|
||||||
clean_test_build_directory ();
|
clean_test_build_directory ();
|
||||||
Sys.make_directory test_build_directory_prefix;
|
Sys.make_directory test_build_directory_prefix;
|
||||||
|
@ -221,6 +221,8 @@ let is_test s =
|
||||||
let ignored s =
|
let ignored s =
|
||||||
s = "" || s.[0] = '_' || s.[0] = '.'
|
s = "" || s.[0] = '_' || s.[0] = '.'
|
||||||
|
|
||||||
|
let sort_strings = List.sort String.compare
|
||||||
|
|
||||||
let find_test_dirs dir =
|
let find_test_dirs dir =
|
||||||
let res = ref [] in
|
let res = ref [] in
|
||||||
let rec loop dir =
|
let rec loop dir =
|
||||||
|
@ -236,7 +238,7 @@ let find_test_dirs dir =
|
||||||
if !contains_tests then res := dir :: !res
|
if !contains_tests then res := dir :: !res
|
||||||
in
|
in
|
||||||
loop dir;
|
loop dir;
|
||||||
List.rev !res
|
sort_strings !res
|
||||||
|
|
||||||
let list_tests dir =
|
let list_tests dir =
|
||||||
let res = ref [] in
|
let res = ref [] in
|
||||||
|
@ -250,7 +252,7 @@ let list_tests dir =
|
||||||
end
|
end
|
||||||
) (Sys.readdir dir)
|
) (Sys.readdir dir)
|
||||||
end;
|
end;
|
||||||
List.rev !res
|
sort_strings !res
|
||||||
|
|
||||||
let () =
|
let () =
|
||||||
init_tests_to_skip()
|
init_tests_to_skip()
|
||||||
|
|
|
@ -977,83 +977,80 @@ let run_test_program_in_toplevel (toplevel : Ocaml_toplevels.toplevel) log env =
|
||||||
(* This is a sub-optimal check - skip the test if any libraries requiring
|
(* This is a sub-optimal check - skip the test if any libraries requiring
|
||||||
C stubs are loaded. It would be better at this point to build a custom
|
C stubs are loaded. It would be better at this point to build a custom
|
||||||
toplevel. *)
|
toplevel. *)
|
||||||
let toplevel_can_run =
|
let toplevel_supports_dynamic_loading =
|
||||||
Config.supports_shared_libraries || backend <> Ocaml_backends.Bytecode
|
Config.supports_shared_libraries || backend <> Ocaml_backends.Bytecode
|
||||||
in
|
in
|
||||||
if not toplevel_can_run then
|
match cmas_need_dynamic_loading (directories env) libraries with
|
||||||
(Result.skip, env)
|
| Some (Error reason) ->
|
||||||
else
|
(Result.fail_with_reason reason, env)
|
||||||
match cmas_need_dynamic_loading (directories env) libraries with
|
| Some (Ok ()) when not toplevel_supports_dynamic_loading ->
|
||||||
| Some (Error reason) ->
|
(Result.skip, env)
|
||||||
(Result.fail_with_reason reason, env)
|
| _ ->
|
||||||
| Some (Ok ()) ->
|
let testfile = Actions_helpers.testfile env in
|
||||||
(Result.skip, env)
|
let expected_exit_status =
|
||||||
| None ->
|
Ocaml_tools.expected_exit_status env (toplevel :> Ocaml_tools.tool) in
|
||||||
let testfile = Actions_helpers.testfile env in
|
let compiler_output_variable = toplevel#output_variable in
|
||||||
let expected_exit_status =
|
let compiler = toplevel#compiler in
|
||||||
Ocaml_tools.expected_exit_status env (toplevel :> Ocaml_tools.tool) in
|
let compiler_name = compiler#name in
|
||||||
let compiler_output_variable = toplevel#output_variable in
|
let modules_with_filetypes =
|
||||||
let compiler = toplevel#compiler in
|
List.map Ocaml_filetypes.filetype (modules env) in
|
||||||
let compiler_name = compiler#name in
|
let (result, env) = compile_modules
|
||||||
let modules_with_filetypes =
|
compiler compiler_name compiler_output_variable
|
||||||
List.map Ocaml_filetypes.filetype (modules env) in
|
modules_with_filetypes log env in
|
||||||
let (result, env) = compile_modules
|
if Result.is_pass result then begin
|
||||||
compiler compiler_name compiler_output_variable
|
let what =
|
||||||
modules_with_filetypes log env in
|
Printf.sprintf "Running %s in %s toplevel \
|
||||||
if Result.is_pass result then begin
|
(expected exit status: %d)"
|
||||||
let what =
|
testfile
|
||||||
Printf.sprintf "Running %s in %s toplevel \
|
(Ocaml_backends.string_of_backend backend)
|
||||||
(expected exit status: %d)"
|
expected_exit_status in
|
||||||
testfile
|
Printf.fprintf log "%s\n%!" what;
|
||||||
(Ocaml_backends.string_of_backend backend)
|
let toplevel_name = toplevel#name in
|
||||||
expected_exit_status in
|
let ocaml_script_as_argument =
|
||||||
Printf.fprintf log "%s\n%!" what;
|
match
|
||||||
let toplevel_name = toplevel#name in
|
Environments.lookup_as_bool
|
||||||
let ocaml_script_as_argument =
|
Ocaml_variables.ocaml_script_as_argument env
|
||||||
match
|
with
|
||||||
Environments.lookup_as_bool
|
| None -> false
|
||||||
Ocaml_variables.ocaml_script_as_argument env
|
| Some b -> b
|
||||||
with
|
in
|
||||||
| None -> false
|
let commandline =
|
||||||
| Some b -> b
|
[
|
||||||
in
|
toplevel_name;
|
||||||
let commandline =
|
Ocaml_flags.toplevel_default_flags;
|
||||||
[
|
toplevel#flags;
|
||||||
toplevel_name;
|
Ocaml_flags.stdlib;
|
||||||
Ocaml_flags.toplevel_default_flags;
|
directory_flags env;
|
||||||
toplevel#flags;
|
Ocaml_flags.include_toplevel_directory;
|
||||||
Ocaml_flags.stdlib;
|
flags env;
|
||||||
directory_flags env;
|
libraries;
|
||||||
Ocaml_flags.include_toplevel_directory;
|
binary_modules backend env;
|
||||||
flags env;
|
if ocaml_script_as_argument then testfile else "";
|
||||||
libraries;
|
Environments.safe_lookup Builtin_variables.arguments env
|
||||||
binary_modules backend env;
|
] in
|
||||||
if ocaml_script_as_argument then testfile else "";
|
let exit_status =
|
||||||
Environments.safe_lookup Builtin_variables.arguments env
|
if ocaml_script_as_argument
|
||||||
] in
|
then Actions_helpers.run_cmd
|
||||||
let exit_status =
|
~environment:default_ocaml_env
|
||||||
if ocaml_script_as_argument
|
~stdout_variable:compiler_output_variable
|
||||||
then Actions_helpers.run_cmd
|
~stderr_variable:compiler_output_variable
|
||||||
~environment:default_ocaml_env
|
log env commandline
|
||||||
~stdout_variable:compiler_output_variable
|
else Actions_helpers.run_cmd
|
||||||
~stderr_variable:compiler_output_variable
|
~environment:default_ocaml_env
|
||||||
log env commandline
|
~stdin_variable:Builtin_variables.test_file
|
||||||
else Actions_helpers.run_cmd
|
~stdout_variable:compiler_output_variable
|
||||||
~environment:default_ocaml_env
|
~stderr_variable:compiler_output_variable
|
||||||
~stdin_variable:Builtin_variables.test_file
|
log env commandline
|
||||||
~stdout_variable:compiler_output_variable
|
in
|
||||||
~stderr_variable:compiler_output_variable
|
if exit_status=expected_exit_status
|
||||||
log env commandline
|
then (Result.pass, env)
|
||||||
in
|
else begin
|
||||||
if exit_status=expected_exit_status
|
let reason =
|
||||||
then (Result.pass, env)
|
(Actions_helpers.mkreason
|
||||||
else begin
|
what (String.concat " " commandline) exit_status) in
|
||||||
let reason =
|
(Result.fail_with_reason reason, env)
|
||||||
(Actions_helpers.mkreason
|
end
|
||||||
what (String.concat " " commandline) exit_status) in
|
end else (result, env)
|
||||||
(Result.fail_with_reason reason, env)
|
|
||||||
end
|
|
||||||
end else (result, env)
|
|
||||||
|
|
||||||
let ocaml = Actions.make
|
let ocaml = Actions.make
|
||||||
"ocaml"
|
"ocaml"
|
||||||
|
|
|
@ -15,7 +15,7 @@
|
||||||
|
|
||||||
(* A few extensions to OCaml's standard library *)
|
(* A few extensions to OCaml's standard library *)
|
||||||
|
|
||||||
(* Pervaisive *)
|
module Unix = Ocamltest_unix
|
||||||
|
|
||||||
let input_line_opt ic =
|
let input_line_opt ic =
|
||||||
try Some (input_line ic) with End_of_file -> None
|
try Some (input_line ic) with End_of_file -> None
|
||||||
|
@ -84,22 +84,37 @@ end
|
||||||
module Sys = struct
|
module Sys = struct
|
||||||
include Sys
|
include Sys
|
||||||
|
|
||||||
let run_system_command prog args =
|
let erase_file path =
|
||||||
let command = Filename.quote_command prog args in
|
try Sys.remove path
|
||||||
match Sys.command command with
|
with Sys_error _ when Sys.win32 && Ocamltest_config.libunix <> None ->
|
||||||
| 0 -> ()
|
(* Deal with read-only attribute on Windows. Ignore any error from chmod
|
||||||
| _ as exitcode ->
|
so that the message always come from Sys.remove *)
|
||||||
Printf.eprintf "System command %s failed with status %d\n%!"
|
let () = try Unix.chmod path 0o666 with Sys_error _ -> () in
|
||||||
command exitcode;
|
Sys.remove path
|
||||||
exit 3
|
|
||||||
|
|
||||||
let mkdir dir =
|
let rm_rf path =
|
||||||
if not (Sys.file_exists dir) then
|
let rec erase path =
|
||||||
run_system_command "mkdir" [dir]
|
if Sys.is_directory path then begin
|
||||||
|
Array.iter (fun entry -> erase (Filename.concat path entry))
|
||||||
|
(Sys.readdir path);
|
||||||
|
Sys.rmdir path
|
||||||
|
end else erase_file path
|
||||||
|
in
|
||||||
|
try if Sys.file_exists path then erase path
|
||||||
|
with Sys_error err ->
|
||||||
|
raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err))
|
||||||
|
|
||||||
let rec make_directory dir =
|
let rec make_directory dir =
|
||||||
if Sys.file_exists dir then ()
|
if Sys.file_exists dir then ()
|
||||||
else (make_directory (Filename.dirname dir); mkdir dir)
|
else let () = make_directory (Filename.dirname dir) in
|
||||||
|
if not (Sys.file_exists dir) then
|
||||||
|
Sys.mkdir dir 0o777
|
||||||
|
else ()
|
||||||
|
|
||||||
|
let make_directory dir =
|
||||||
|
try make_directory dir
|
||||||
|
with Sys_error err ->
|
||||||
|
raise (Sys_error (Printf.sprintf "Failed to create %S (%s)" dir err))
|
||||||
|
|
||||||
let with_input_file ?(bin=false) x f =
|
let with_input_file ?(bin=false) x f =
|
||||||
let ic = (if bin then open_in_bin else open_in) x in
|
let ic = (if bin then open_in_bin else open_in) x in
|
||||||
|
@ -161,8 +176,6 @@ module Sys = struct
|
||||||
let force_remove file =
|
let force_remove file =
|
||||||
if file_exists file then remove file
|
if file_exists file then remove file
|
||||||
|
|
||||||
external has_symlink : unit -> bool = "caml_has_symlink"
|
|
||||||
|
|
||||||
let with_chdir path f =
|
let with_chdir path f =
|
||||||
let oldcwd = Sys.getcwd () in
|
let oldcwd = Sys.getcwd () in
|
||||||
Sys.chdir path;
|
Sys.chdir path;
|
||||||
|
@ -172,3 +185,13 @@ module Sys = struct
|
||||||
try Sys.getenv variable with Not_found -> default_value
|
try Sys.getenv variable with Not_found -> default_value
|
||||||
let safe_getenv variable = getenv_with_default_value variable ""
|
let safe_getenv variable = getenv_with_default_value variable ""
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Seq = struct
|
||||||
|
include Seq
|
||||||
|
|
||||||
|
let rec equal s1 s2 =
|
||||||
|
match s1 (), s2 () with
|
||||||
|
| Nil, Nil -> true
|
||||||
|
| Cons(e1, s1), Cons(e2, s2) -> e1 = e2 && equal s1 s2
|
||||||
|
| _, _ -> false
|
||||||
|
end
|
||||||
|
|
|
@ -46,18 +46,27 @@ end
|
||||||
module Sys : sig
|
module Sys : sig
|
||||||
include module type of Sys
|
include module type of Sys
|
||||||
val file_is_empty : string -> bool
|
val file_is_empty : string -> bool
|
||||||
val run_system_command : string -> string list -> unit
|
|
||||||
val make_directory : string -> unit
|
val make_directory : string -> unit
|
||||||
|
val rm_rf : string -> unit
|
||||||
val string_of_file : string -> string
|
val string_of_file : string -> string
|
||||||
val iter_lines_of_file : (string -> unit) -> string -> unit
|
val iter_lines_of_file : (string -> unit) -> string -> unit
|
||||||
val dump_file : out_channel -> ?prefix:string -> string -> unit
|
val dump_file : out_channel -> ?prefix:string -> string -> unit
|
||||||
val copy_chan : in_channel -> out_channel -> unit
|
val copy_chan : in_channel -> out_channel -> unit
|
||||||
val copy_file : string -> string -> unit
|
val copy_file : string -> string -> unit
|
||||||
val force_remove : string -> unit
|
val force_remove : string -> unit
|
||||||
val has_symlink : unit -> bool
|
|
||||||
val with_chdir : string -> (unit -> 'a) -> 'a
|
val with_chdir : string -> (unit -> 'a) -> 'a
|
||||||
val getenv_with_default_value : string -> string -> string
|
val getenv_with_default_value : string -> string -> string
|
||||||
val safe_getenv : string -> string
|
val safe_getenv : string -> string
|
||||||
val with_input_file : ?bin:bool -> string -> (in_channel -> 'a) -> 'a
|
val with_input_file : ?bin:bool -> string -> (in_channel -> 'a) -> 'a
|
||||||
val with_output_file : ?bin:bool -> string -> (out_channel -> 'a) -> 'a
|
val with_output_file : ?bin:bool -> string -> (out_channel -> 'a) -> 'a
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Seq : sig
|
||||||
|
include module type of struct include Seq end
|
||||||
|
|
||||||
|
val equal : 'a t -> 'a t -> bool
|
||||||
|
end
|
||||||
|
|
||||||
|
module Unix : sig
|
||||||
|
include module type of Ocamltest_unix
|
||||||
|
end
|
||||||
|
|
|
@ -1,154 +0,0 @@
|
||||||
/**************************************************************************/
|
|
||||||
/* */
|
|
||||||
/* OCaml */
|
|
||||||
/* */
|
|
||||||
/* Sebastien Hinderer, projet Gallium, INRIA Paris */
|
|
||||||
/* */
|
|
||||||
/* Copyright 2018 Institut National de Recherche en Informatique et */
|
|
||||||
/* en Automatique. */
|
|
||||||
/* */
|
|
||||||
/* All rights reserved. This file is distributed under the terms of */
|
|
||||||
/* the GNU Lesser General Public License version 2.1, with the */
|
|
||||||
/* special exception on linking described in the file LICENSE. */
|
|
||||||
/* */
|
|
||||||
/**************************************************************************/
|
|
||||||
|
|
||||||
/* Stubs for ocamltest's standard library */
|
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <stdlib.h>
|
|
||||||
|
|
||||||
#include <caml/config.h>
|
|
||||||
#include <caml/mlvalues.h>
|
|
||||||
#include <caml/memory.h>
|
|
||||||
#include <caml/alloc.h>
|
|
||||||
/*
|
|
||||||
#include <caml/fail.h>
|
|
||||||
*/
|
|
||||||
#include <caml/signals.h>
|
|
||||||
#include <caml/osdeps.h>
|
|
||||||
|
|
||||||
|
|
||||||
#ifdef _WIN32
|
|
||||||
|
|
||||||
/*
|
|
||||||
* Windows Vista functions enabled
|
|
||||||
*/
|
|
||||||
#undef _WIN32_WINNT
|
|
||||||
#define _WIN32_WINNT 0x0600
|
|
||||||
|
|
||||||
#include <wtypes.h>
|
|
||||||
#include <winbase.h>
|
|
||||||
#include <process.h>
|
|
||||||
#include <sys/types.h>
|
|
||||||
|
|
||||||
// Developer Mode allows the creation of symlinks without elevation - see
|
|
||||||
// https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-createsymboliclinkw
|
|
||||||
static BOOL IsDeveloperModeEnabled()
|
|
||||||
{
|
|
||||||
HKEY hKey;
|
|
||||||
LSTATUS status;
|
|
||||||
DWORD developerModeRegistryValue, dwordSize = sizeof(DWORD);
|
|
||||||
|
|
||||||
status = RegOpenKeyExW(
|
|
||||||
HKEY_LOCAL_MACHINE,
|
|
||||||
L"SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\AppModelUnlock",
|
|
||||||
0,
|
|
||||||
KEY_READ | KEY_WOW64_64KEY,
|
|
||||||
&hKey
|
|
||||||
);
|
|
||||||
if (status != ERROR_SUCCESS) {
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
|
|
||||||
status = RegQueryValueExW(
|
|
||||||
hKey,
|
|
||||||
L"AllowDevelopmentWithoutDevLicense",
|
|
||||||
NULL,
|
|
||||||
NULL,
|
|
||||||
(LPBYTE)&developerModeRegistryValue,
|
|
||||||
&dwordSize
|
|
||||||
);
|
|
||||||
RegCloseKey(hKey);
|
|
||||||
if (status != ERROR_SUCCESS) {
|
|
||||||
return FALSE;
|
|
||||||
}
|
|
||||||
return developerModeRegistryValue != 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
#define luid_eq(l, r) (l.LowPart == r.LowPart && l.HighPart == r.HighPart)
|
|
||||||
|
|
||||||
CAMLprim value caml_has_symlink(value unit)
|
|
||||||
{
|
|
||||||
CAMLparam1(unit);
|
|
||||||
HANDLE hProcess = GetCurrentProcess();
|
|
||||||
BOOL result = FALSE;
|
|
||||||
|
|
||||||
if (IsDeveloperModeEnabled()) {
|
|
||||||
CAMLreturn(Val_true);
|
|
||||||
}
|
|
||||||
|
|
||||||
if (OpenProcessToken(hProcess, TOKEN_READ, &hProcess)) {
|
|
||||||
LUID seCreateSymbolicLinkPrivilege;
|
|
||||||
|
|
||||||
if (LookupPrivilegeValue(NULL,
|
|
||||||
SE_CREATE_SYMBOLIC_LINK_NAME,
|
|
||||||
&seCreateSymbolicLinkPrivilege)) {
|
|
||||||
DWORD length;
|
|
||||||
|
|
||||||
if (!GetTokenInformation(hProcess, TokenPrivileges, NULL, 0, &length)) {
|
|
||||||
if (GetLastError() == ERROR_INSUFFICIENT_BUFFER) {
|
|
||||||
TOKEN_PRIVILEGES* privileges =
|
|
||||||
(TOKEN_PRIVILEGES*)caml_stat_alloc(length);
|
|
||||||
if (GetTokenInformation(hProcess,
|
|
||||||
TokenPrivileges,
|
|
||||||
privileges,
|
|
||||||
length,
|
|
||||||
&length)) {
|
|
||||||
DWORD count = privileges->PrivilegeCount;
|
|
||||||
|
|
||||||
if (count) {
|
|
||||||
LUID_AND_ATTRIBUTES* privs = privileges->Privileges;
|
|
||||||
while (count-- &&
|
|
||||||
!(result = luid_eq(privs->Luid,
|
|
||||||
seCreateSymbolicLinkPrivilege)))
|
|
||||||
privs++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
caml_stat_free(privileges);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
CloseHandle(hProcess);
|
|
||||||
}
|
|
||||||
|
|
||||||
CAMLreturn(Val_bool(result));
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
#else /* _WIN32 */
|
|
||||||
|
|
||||||
#ifdef HAS_SYMLINK
|
|
||||||
|
|
||||||
CAMLprim value caml_has_symlink(value unit)
|
|
||||||
{
|
|
||||||
CAMLparam0();
|
|
||||||
CAMLreturn(Val_true);
|
|
||||||
}
|
|
||||||
|
|
||||||
#else /* HAS_SYMLINK */
|
|
||||||
|
|
||||||
CAMLprim value unix_symlink(value to_dir, value path1, value path2)
|
|
||||||
{ caml_invalid_argument("symlink not implemented"); }
|
|
||||||
|
|
||||||
CAMLprim value caml_has_symlink(value unit)
|
|
||||||
{
|
|
||||||
CAMLparam0();
|
|
||||||
CAMLreturn(Val_false);
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#endif /* _WIN32 */
|
|
|
@ -0,0 +1,20 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* OCaml *)
|
||||||
|
(* *)
|
||||||
|
(* David Allsopp, OCaml Labs, Cambridge. *)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2020 David Allsopp Ltd. *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of *)
|
||||||
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||||
|
(* special exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
(** Functions imported from Unix. They are explicitly here to remove the
|
||||||
|
temptation to use the Unix module directly in ocamltest. *)
|
||||||
|
|
||||||
|
val has_symlink : unit -> bool
|
||||||
|
val symlink : ?to_dir:bool -> string -> string -> unit
|
||||||
|
val chmod : string -> int -> unit
|
|
@ -0,0 +1,18 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* OCaml *)
|
||||||
|
(* *)
|
||||||
|
(* David Allsopp, OCaml Labs, Cambridge. *)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2020 David Allsopp Ltd. *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of *)
|
||||||
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||||
|
(* special exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
(* Dummy implementations for when the Unix library isn't built *)
|
||||||
|
let has_symlink () = false
|
||||||
|
let symlink ?to_dir:_ _ _ = invalid_arg "symlink not available"
|
||||||
|
let chmod _ _ = invalid_arg "chmod not available"
|
|
@ -0,0 +1,29 @@
|
||||||
|
(**************************************************************************)
|
||||||
|
(* *)
|
||||||
|
(* OCaml *)
|
||||||
|
(* *)
|
||||||
|
(* David Allsopp, OCaml Labs, Cambridge. *)
|
||||||
|
(* *)
|
||||||
|
(* Copyright 2020 David Allsopp Ltd. *)
|
||||||
|
(* *)
|
||||||
|
(* All rights reserved. This file is distributed under the terms of *)
|
||||||
|
(* the GNU Lesser General Public License version 2.1, with the *)
|
||||||
|
(* special exception on linking described in the file LICENSE. *)
|
||||||
|
(* *)
|
||||||
|
(**************************************************************************)
|
||||||
|
|
||||||
|
(* Unix.has_symlink never raises *)
|
||||||
|
let has_symlink = Unix.has_symlink
|
||||||
|
|
||||||
|
(* Convert Unix_error to Sys_error *)
|
||||||
|
let wrap f x =
|
||||||
|
try f x
|
||||||
|
with Unix.Unix_error(err, fn_name, arg) ->
|
||||||
|
let msg =
|
||||||
|
Printf.sprintf "%s failed on %S with %s"
|
||||||
|
fn_name arg (Unix.error_message err)
|
||||||
|
in
|
||||||
|
raise (Sys_error msg)
|
||||||
|
|
||||||
|
let symlink ?to_dir source = wrap (Unix.symlink ?to_dir source)
|
||||||
|
let chmod file = wrap (Unix.chmod file)
|
|
@ -71,8 +71,10 @@ static void logToChannel(void *voidchannel, const char *fmt, va_list ap)
|
||||||
if (text == NULL) return;
|
if (text == NULL) return;
|
||||||
if (vsnprintf(text, length, fmt, ap) != length) goto end;
|
if (vsnprintf(text, length, fmt, ap) != length) goto end;
|
||||||
}
|
}
|
||||||
|
Lock(channel);
|
||||||
caml_putblock(channel, text, length);
|
caml_putblock(channel, text, length);
|
||||||
caml_flush(channel);
|
caml_flush(channel);
|
||||||
|
Unlock(channel);
|
||||||
end:
|
end:
|
||||||
free(text);
|
free(text);
|
||||||
}
|
}
|
||||||
|
|
|
@ -24,6 +24,10 @@ CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
|
||||||
CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
|
CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
|
||||||
CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
|
CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
|
||||||
|
|
||||||
|
ifneq "$(CCOMPTYPE)" "msvc"
|
||||||
|
OC_CFLAGS += -g
|
||||||
|
endif
|
||||||
|
|
||||||
OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS)
|
OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(EXTRACFLAGS)
|
||||||
OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(EXTRACPPFLAGS)
|
OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(EXTRACPPFLAGS)
|
||||||
|
|
||||||
|
@ -140,4 +144,4 @@ endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
$(DEPDIR)/%.$(D): %.c | $(DEPDIR)
|
$(DEPDIR)/%.$(D): %.c | $(DEPDIR)
|
||||||
$(DEP_CC) $(OC_CPPFLAGS) $< -MT '$*.$(O)' -MF $@
|
$(DEP_CC) $(OC_CPPFLAGS) $(CPPFLAGS) $< -MT '$*.$(O)' -MF $@
|
||||||
|
|
|
@ -18,6 +18,10 @@ ROOTDIR=../..
|
||||||
include $(ROOTDIR)/Makefile.common
|
include $(ROOTDIR)/Makefile.common
|
||||||
include $(ROOTDIR)/Makefile.best_binaries
|
include $(ROOTDIR)/Makefile.best_binaries
|
||||||
|
|
||||||
|
ifneq "$(CCOMPTYPE)" "msvc"
|
||||||
|
OC_CFLAGS += -g
|
||||||
|
endif
|
||||||
|
|
||||||
OC_CFLAGS += $(SHAREDLIB_CFLAGS)
|
OC_CFLAGS += $(SHAREDLIB_CFLAGS)
|
||||||
|
|
||||||
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
|
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
|
||||||
|
@ -96,7 +100,8 @@ st_stubs.%.$(O): st_stubs.c
|
||||||
else
|
else
|
||||||
st_stubs.%.$(O): st_stubs.c $(RUNTIME_HEADERS) $(wildcard *.h)
|
st_stubs.%.$(O): st_stubs.c $(RUNTIME_HEADERS) $(wildcard *.h)
|
||||||
endif
|
endif
|
||||||
$(CC) -c $(OC_CFLAGS) $(OC_CPPFLAGS) $(OUTPUTOBJ)$@ $<
|
$(CC) -c $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS) \
|
||||||
|
$(OUTPUTOBJ)$@ $<
|
||||||
|
|
||||||
partialclean:
|
partialclean:
|
||||||
rm -f *.cm*
|
rm -f *.cm*
|
||||||
|
@ -158,7 +163,7 @@ endif
|
||||||
|
|
||||||
define GEN_RULE
|
define GEN_RULE
|
||||||
$(DEPDIR)/%.$(1).$(D): %.c | $(DEPDIR)
|
$(DEPDIR)/%.$(1).$(D): %.c | $(DEPDIR)
|
||||||
$$(DEP_CC) $$(OC_CPPFLAGS) $$< -MT '$$*.$(1).$(O)' -MF $$@
|
$$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT '$$*.$(1).$(O)' -MF $$@
|
||||||
endef
|
endef
|
||||||
|
|
||||||
$(foreach object_type, b n, $(eval $(call GEN_RULE,$(object_type))))
|
$(foreach object_type, b n, $(eval $(call GEN_RULE,$(object_type))))
|
||||||
|
|
|
@ -437,6 +437,8 @@ value caml_thread_sigmask(value cmd, value sigs) /* ML */
|
||||||
retcode = pthread_sigmask(how, &set, &oldset);
|
retcode = pthread_sigmask(how, &set, &oldset);
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
st_check_error(retcode, "Thread.sigmask");
|
st_check_error(retcode, "Thread.sigmask");
|
||||||
|
/* Run any handlers for just-unmasked pending signals */
|
||||||
|
caml_process_pending_actions();
|
||||||
return st_encode_sigset(&oldset);
|
return st_encode_sigset(&oldset);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -253,15 +253,6 @@ static void caml_thread_leave_blocking_section(void)
|
||||||
caml_thread_restore_runtime_state();
|
caml_thread_restore_runtime_state();
|
||||||
}
|
}
|
||||||
|
|
||||||
static int caml_thread_try_leave_blocking_section(void)
|
|
||||||
{
|
|
||||||
/* Disable immediate processing of signals (PR#3659).
|
|
||||||
try_leave_blocking_section always fails, forcing the signal to be
|
|
||||||
recorded and processed at the next leave_blocking_section or
|
|
||||||
polling. */
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Hooks for I/O locking */
|
/* Hooks for I/O locking */
|
||||||
|
|
||||||
static void caml_io_mutex_free(struct channel *chan)
|
static void caml_io_mutex_free(struct channel *chan)
|
||||||
|
@ -496,7 +487,6 @@ CAMLprim value caml_thread_initialize(value unit) /* ML */
|
||||||
caml_scan_roots_hook = caml_thread_scan_roots;
|
caml_scan_roots_hook = caml_thread_scan_roots;
|
||||||
caml_enter_blocking_section_hook = caml_thread_enter_blocking_section;
|
caml_enter_blocking_section_hook = caml_thread_enter_blocking_section;
|
||||||
caml_leave_blocking_section_hook = caml_thread_leave_blocking_section;
|
caml_leave_blocking_section_hook = caml_thread_leave_blocking_section;
|
||||||
caml_try_leave_blocking_section_hook = caml_thread_try_leave_blocking_section;
|
|
||||||
#ifdef NATIVE_CODE
|
#ifdef NATIVE_CODE
|
||||||
caml_termination_hook = st_thread_exit;
|
caml_termination_hook = st_thread_exit;
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -64,10 +64,6 @@ static int unix_check_stream_semantics(int fd)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* From runtime/io.c. To be declared in <caml/io.h> ? */
|
|
||||||
extern value caml_ml_open_descriptor_in(value fd);
|
|
||||||
extern value caml_ml_open_descriptor_out(value fd);
|
|
||||||
|
|
||||||
CAMLprim value unix_inchannel_of_filedescr(value fd)
|
CAMLprim value unix_inchannel_of_filedescr(value fd)
|
||||||
{
|
{
|
||||||
int err;
|
int err;
|
||||||
|
|
|
@ -27,5 +27,6 @@ CAMLprim value unix_kill(value pid, value signal)
|
||||||
sig = caml_convert_signal_number(Int_val(signal));
|
sig = caml_convert_signal_number(Int_val(signal));
|
||||||
if (kill(Int_val(pid), sig) == -1)
|
if (kill(Int_val(pid), sig) == -1)
|
||||||
uerror("kill", Nothing);
|
uerror("kill", Nothing);
|
||||||
|
caml_process_pending_actions();
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
|
|
@ -13,9 +13,15 @@
|
||||||
/* */
|
/* */
|
||||||
/**************************************************************************/
|
/**************************************************************************/
|
||||||
|
|
||||||
|
#ifndef _WIN32
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <sys/stat.h>
|
#include <sys/stat.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#define CAML_INTERNALS
|
||||||
#include <caml/mlvalues.h>
|
#include <caml/mlvalues.h>
|
||||||
|
#include <caml/osdeps.h>
|
||||||
|
#include <caml/misc.h>
|
||||||
#include <caml/memory.h>
|
#include <caml/memory.h>
|
||||||
#include <caml/signals.h>
|
#include <caml/signals.h>
|
||||||
#include "unixsupport.h"
|
#include "unixsupport.h"
|
||||||
|
@ -23,12 +29,12 @@
|
||||||
CAMLprim value unix_mkdir(value path, value perm)
|
CAMLprim value unix_mkdir(value path, value perm)
|
||||||
{
|
{
|
||||||
CAMLparam2(path, perm);
|
CAMLparam2(path, perm);
|
||||||
char * p;
|
char_os * p;
|
||||||
int ret;
|
int ret;
|
||||||
caml_unix_check_path(path, "mkdir");
|
caml_unix_check_path(path, "mkdir");
|
||||||
p = caml_stat_strdup(String_val(path));
|
p = caml_stat_strdup_to_os(String_val(path));
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section();
|
||||||
ret = mkdir(p, Int_val(perm));
|
ret = mkdir_os(p, Int_val(perm));
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
caml_stat_free(p);
|
caml_stat_free(p);
|
||||||
if (ret == -1) uerror("mkdir", path);
|
if (ret == -1) uerror("mkdir", path);
|
||||||
|
|
|
@ -39,8 +39,7 @@
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Defined in [mmap_ba.c] */
|
/* Defined in [mmap_ba.c] */
|
||||||
CAMLextern value
|
extern value caml_unix_mapped_alloc(int, int, void *, intnat *);
|
||||||
caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim);
|
|
||||||
|
|
||||||
#if defined(HAS_MMAP)
|
#if defined(HAS_MMAP)
|
||||||
|
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
/* Allocation of bigarrays for memory-mapped files.
|
/* Allocation of bigarrays for memory-mapped files.
|
||||||
This is the OS-independent part of [mmap.c]. */
|
This is the OS-independent part of [mmap.c]. */
|
||||||
|
|
||||||
CAMLextern void caml_ba_unmap_file(void * addr, uintnat len);
|
extern void caml_ba_unmap_file(void *, uintnat);
|
||||||
|
|
||||||
static void caml_ba_mapped_finalize(value v)
|
static void caml_ba_mapped_finalize(value v)
|
||||||
{
|
{
|
||||||
|
|
|
@ -71,6 +71,8 @@ CAMLprim value unix_sigprocmask(value vaction, value vset)
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section();
|
||||||
retcode = caml_sigmask_hook(how, &set, &oldset);
|
retcode = caml_sigmask_hook(how, &set, &oldset);
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
|
/* Run any handlers for just-unmasked pending signals */
|
||||||
|
caml_process_pending_actions();
|
||||||
if (retcode != 0) unix_error(retcode, "sigprocmask", Nothing);
|
if (retcode != 0) unix_error(retcode, "sigprocmask", Nothing);
|
||||||
return encode_sigset(&oldset);
|
return encode_sigset(&oldset);
|
||||||
}
|
}
|
||||||
|
|
|
@ -38,6 +38,9 @@
|
||||||
#ifndef SO_REUSEADDR
|
#ifndef SO_REUSEADDR
|
||||||
#define SO_REUSEADDR (-1)
|
#define SO_REUSEADDR (-1)
|
||||||
#endif
|
#endif
|
||||||
|
#ifndef SO_REUSEPORT
|
||||||
|
#define SO_REUSEPORT (-1)
|
||||||
|
#endif
|
||||||
#ifndef SO_KEEPALIVE
|
#ifndef SO_KEEPALIVE
|
||||||
#define SO_KEEPALIVE (-1)
|
#define SO_KEEPALIVE (-1)
|
||||||
#endif
|
#endif
|
||||||
|
@ -109,6 +112,7 @@ static struct socket_option sockopt_bool[] = {
|
||||||
{ SOL_SOCKET, SO_DEBUG },
|
{ SOL_SOCKET, SO_DEBUG },
|
||||||
{ SOL_SOCKET, SO_BROADCAST },
|
{ SOL_SOCKET, SO_BROADCAST },
|
||||||
{ SOL_SOCKET, SO_REUSEADDR },
|
{ SOL_SOCKET, SO_REUSEADDR },
|
||||||
|
{ SOL_SOCKET, SO_REUSEPORT },
|
||||||
{ SOL_SOCKET, SO_KEEPALIVE },
|
{ SOL_SOCKET, SO_KEEPALIVE },
|
||||||
{ SOL_SOCKET, SO_DONTROUTE },
|
{ SOL_SOCKET, SO_DONTROUTE },
|
||||||
{ SOL_SOCKET, SO_OOBINLINE },
|
{ SOL_SOCKET, SO_OOBINLINE },
|
||||||
|
|
|
@ -597,6 +597,7 @@ type socket_bool_option =
|
||||||
SO_DEBUG
|
SO_DEBUG
|
||||||
| SO_BROADCAST
|
| SO_BROADCAST
|
||||||
| SO_REUSEADDR
|
| SO_REUSEADDR
|
||||||
|
| SO_REUSEPORT
|
||||||
| SO_KEEPALIVE
|
| SO_KEEPALIVE
|
||||||
| SO_DONTROUTE
|
| SO_DONTROUTE
|
||||||
| SO_OOBINLINE
|
| SO_OOBINLINE
|
||||||
|
|
|
@ -1477,6 +1477,7 @@ type socket_bool_option =
|
||||||
SO_DEBUG (** Record debugging information *)
|
SO_DEBUG (** Record debugging information *)
|
||||||
| SO_BROADCAST (** Permit sending of broadcast messages *)
|
| SO_BROADCAST (** Permit sending of broadcast messages *)
|
||||||
| SO_REUSEADDR (** Allow reuse of local addresses for bind *)
|
| SO_REUSEADDR (** Allow reuse of local addresses for bind *)
|
||||||
|
| SO_REUSEPORT (** Allow reuse of address and port bindings *)
|
||||||
| SO_KEEPALIVE (** Keep connection active *)
|
| SO_KEEPALIVE (** Keep connection active *)
|
||||||
| SO_DONTROUTE (** Bypass the standard routing algorithms *)
|
| SO_DONTROUTE (** Bypass the standard routing algorithms *)
|
||||||
| SO_OOBINLINE (** Leave out-of-band data in line *)
|
| SO_OOBINLINE (** Leave out-of-band data in line *)
|
||||||
|
|
|
@ -1477,6 +1477,7 @@ type socket_bool_option = Unix.socket_bool_option =
|
||||||
SO_DEBUG (** Record debugging information *)
|
SO_DEBUG (** Record debugging information *)
|
||||||
| SO_BROADCAST (** Permit sending of broadcast messages *)
|
| SO_BROADCAST (** Permit sending of broadcast messages *)
|
||||||
| SO_REUSEADDR (** Allow reuse of local addresses for bind *)
|
| SO_REUSEADDR (** Allow reuse of local addresses for bind *)
|
||||||
|
| SO_REUSEPORT (** Allow reuse of address and port bindings *)
|
||||||
| SO_KEEPALIVE (** Keep connection active *)
|
| SO_KEEPALIVE (** Keep connection active *)
|
||||||
| SO_DONTROUTE (** Bypass the standard routing algorithms *)
|
| SO_DONTROUTE (** Bypass the standard routing algorithms *)
|
||||||
| SO_OOBINLINE (** Leave out-of-band data in line *)
|
| SO_OOBINLINE (** Leave out-of-band data in line *)
|
||||||
|
|
|
@ -22,7 +22,7 @@ WIN_FILES = accept.c bind.c channels.c close.c \
|
||||||
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c envir.c \
|
close_on.c connect.c createprocess.c dup.c dup2.c errmsg.c envir.c \
|
||||||
getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
|
getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
|
||||||
link.c listen.c lockf.c lseek.c nonblock.c \
|
link.c listen.c lockf.c lseek.c nonblock.c \
|
||||||
mkdir.c mmap.c open.c pipe.c read.c readlink.c rename.c \
|
mmap.c open.c pipe.c read.c readlink.c rename.c \
|
||||||
select.c sendrecv.c \
|
select.c sendrecv.c \
|
||||||
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
|
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
|
||||||
symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
|
symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
|
||||||
|
@ -30,7 +30,7 @@ WIN_FILES = accept.c bind.c channels.c close.c \
|
||||||
|
|
||||||
# Files from the ../unix directory
|
# Files from the ../unix directory
|
||||||
UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
|
UNIX_FILES = access.c addrofstr.c chdir.c chmod.c cst2constr.c \
|
||||||
cstringv.c execv.c execve.c execvp.c \
|
cstringv.c execv.c execve.c execvp.c mkdir.c \
|
||||||
exit.c getaddrinfo.c getcwd.c gethost.c gethostname.c \
|
exit.c getaddrinfo.c getcwd.c gethost.c gethostname.c \
|
||||||
getnameinfo.c getproto.c \
|
getnameinfo.c getproto.c \
|
||||||
getserv.c gmtime.c mmap_ba.c putenv.c rmdir.c \
|
getserv.c gmtime.c mmap_ba.c putenv.c rmdir.c \
|
||||||
|
|
|
@ -30,8 +30,7 @@
|
||||||
do { win32_maperr(GetLastError()); uerror(func, arg); } while(0)
|
do { win32_maperr(GetLastError()); uerror(func, arg); } while(0)
|
||||||
|
|
||||||
/* Defined in [mmap_ba.c] */
|
/* Defined in [mmap_ba.c] */
|
||||||
CAMLextern value
|
extern value caml_unix_mapped_alloc(int, int, void *, intnat *);
|
||||||
caml_unix_mapped_alloc(int flags, int num_dims, void * data, intnat * dim);
|
|
||||||
|
|
||||||
#ifndef INVALID_SET_FILE_POINTER
|
#ifndef INVALID_SET_FILE_POINTER
|
||||||
#define INVALID_SET_FILE_POINTER (-1)
|
#define INVALID_SET_FILE_POINTER (-1)
|
||||||
|
|
|
@ -21,6 +21,9 @@
|
||||||
#include "unixsupport.h"
|
#include "unixsupport.h"
|
||||||
#include "socketaddr.h"
|
#include "socketaddr.h"
|
||||||
|
|
||||||
|
#ifndef SO_REUSEPORT
|
||||||
|
#define SO_REUSEPORT (-1)
|
||||||
|
#endif
|
||||||
#ifndef IPPROTO_IPV6
|
#ifndef IPPROTO_IPV6
|
||||||
#define IPPROTO_IPV6 (-1)
|
#define IPPROTO_IPV6 (-1)
|
||||||
#endif
|
#endif
|
||||||
|
@ -47,6 +50,7 @@ static struct socket_option sockopt_bool[] = {
|
||||||
{ SOL_SOCKET, SO_DEBUG },
|
{ SOL_SOCKET, SO_DEBUG },
|
||||||
{ SOL_SOCKET, SO_BROADCAST },
|
{ SOL_SOCKET, SO_BROADCAST },
|
||||||
{ SOL_SOCKET, SO_REUSEADDR },
|
{ SOL_SOCKET, SO_REUSEADDR },
|
||||||
|
{ SOL_SOCKET, SO_REUSEPORT },
|
||||||
{ SOL_SOCKET, SO_KEEPALIVE },
|
{ SOL_SOCKET, SO_KEEPALIVE },
|
||||||
{ SOL_SOCKET, SO_DONTROUTE },
|
{ SOL_SOCKET, SO_DONTROUTE },
|
||||||
{ SOL_SOCKET, SO_OOBINLINE },
|
{ SOL_SOCKET, SO_OOBINLINE },
|
||||||
|
|
|
@ -729,6 +729,7 @@ type socket_bool_option =
|
||||||
SO_DEBUG
|
SO_DEBUG
|
||||||
| SO_BROADCAST
|
| SO_BROADCAST
|
||||||
| SO_REUSEADDR
|
| SO_REUSEADDR
|
||||||
|
| SO_REUSEPORT
|
||||||
| SO_KEEPALIVE
|
| SO_KEEPALIVE
|
||||||
| SO_DONTROUTE
|
| SO_DONTROUTE
|
||||||
| SO_OOBINLINE
|
| SO_OOBINLINE
|
||||||
|
|
|
@ -32,7 +32,7 @@ val pattern : Lexing.lexbuf -> Parsetree.pattern
|
||||||
|
|
||||||
val longident: Lexing.lexbuf -> Longident.t
|
val longident: Lexing.lexbuf -> Longident.t
|
||||||
(**
|
(**
|
||||||
The function [longident] is guaranted to parse all subclasses
|
The function [longident] is guaranteed to parse all subclasses
|
||||||
of {!Longident.t} used in OCaml: values, constructors, simple or extended
|
of {!Longident.t} used in OCaml: values, constructors, simple or extended
|
||||||
module paths, and types or module types.
|
module paths, and types or module types.
|
||||||
|
|
||||||
|
|
|
@ -427,7 +427,8 @@ let text_str pos = Str.text (rhs_text pos)
|
||||||
let text_sig pos = Sig.text (rhs_text pos)
|
let text_sig pos = Sig.text (rhs_text pos)
|
||||||
let text_cstr pos = Cf.text (rhs_text pos)
|
let text_cstr pos = Cf.text (rhs_text pos)
|
||||||
let text_csig pos = Ctf.text (rhs_text pos)
|
let text_csig pos = Ctf.text (rhs_text pos)
|
||||||
let text_def pos = [Ptop_def (Str.text (rhs_text pos))]
|
let text_def pos =
|
||||||
|
List.map (fun def -> Ptop_def [def]) (Str.text (rhs_text pos))
|
||||||
|
|
||||||
let extra_text startpos endpos text items =
|
let extra_text startpos endpos text items =
|
||||||
match items with
|
match items with
|
||||||
|
@ -445,7 +446,9 @@ let extra_sig p1 p2 items = extra_text p1 p2 Sig.text items
|
||||||
let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
|
let extra_cstr p1 p2 items = extra_text p1 p2 Cf.text items
|
||||||
let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text items
|
let extra_csig p1 p2 items = extra_text p1 p2 Ctf.text items
|
||||||
let extra_def p1 p2 items =
|
let extra_def p1 p2 items =
|
||||||
extra_text p1 p2 (fun txt -> [Ptop_def (Str.text txt)]) items
|
extra_text p1 p2
|
||||||
|
(fun txt -> List.map (fun def -> Ptop_def [def]) (Str.text txt))
|
||||||
|
items
|
||||||
|
|
||||||
let extra_rhs_core_type ct ~pos =
|
let extra_rhs_core_type ct ~pos =
|
||||||
let docs = rhs_info pos in
|
let docs = rhs_info pos in
|
||||||
|
|
|
@ -174,7 +174,7 @@ and row_field_desc =
|
||||||
(see 4.2 in the manual)
|
(see 4.2 in the manual)
|
||||||
*)
|
*)
|
||||||
| Rinherit of core_type
|
| Rinherit of core_type
|
||||||
(* [ T ] *)
|
(* [ | t ] *)
|
||||||
|
|
||||||
and object_field = {
|
and object_field = {
|
||||||
pof_desc : object_field_desc;
|
pof_desc : object_field_desc;
|
||||||
|
|
|
@ -330,6 +330,9 @@ and core_type1 ctxt f x =
|
||||||
| _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
|
| _ -> list ~first:"(" ~last:")@;" (core_type ctxt) ~sep:",@;" f l)
|
||||||
l longident_loc li
|
l longident_loc li
|
||||||
| Ptyp_variant (l, closed, low) ->
|
| Ptyp_variant (l, closed, low) ->
|
||||||
|
let first_is_inherit = match l with
|
||||||
|
| {Parsetree.prf_desc = Rinherit _}::_ -> true
|
||||||
|
| _ -> false in
|
||||||
let type_variant_helper f x =
|
let type_variant_helper f x =
|
||||||
match x.prf_desc with
|
match x.prf_desc with
|
||||||
| Rtag (l, _, ctl) ->
|
| Rtag (l, _, ctl) ->
|
||||||
|
@ -348,7 +351,7 @@ and core_type1 ctxt f x =
|
||||||
| _ ->
|
| _ ->
|
||||||
pp f "%s@;%a"
|
pp f "%s@;%a"
|
||||||
(match (closed,low) with
|
(match (closed,low) with
|
||||||
| (Closed,None) -> ""
|
| (Closed,None) -> if first_is_inherit then " |" else ""
|
||||||
| (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
|
| (Closed,Some _) -> "<" (* FIXME desugar the syntax sugar*)
|
||||||
| (Open,_) -> ">")
|
| (Open,_) -> ">")
|
||||||
(list type_variant_helper ~sep:"@;<1 -2>| ") l) l
|
(list type_variant_helper ~sep:"@;<1 -2>| ") l) l
|
||||||
|
@ -1584,9 +1587,9 @@ and extension_constructor ctxt f x =
|
||||||
| Pext_decl(l, r) ->
|
| Pext_decl(l, r) ->
|
||||||
constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
|
constructor_declaration ctxt f (x.pext_name.txt, l, r, x.pext_attributes)
|
||||||
| Pext_rebind li ->
|
| Pext_rebind li ->
|
||||||
pp f "%s%a@;=@;%a" x.pext_name.txt
|
pp f "%s@;=@;%a%a" x.pext_name.txt
|
||||||
(attributes ctxt) x.pext_attributes
|
|
||||||
longident_loc li
|
longident_loc li
|
||||||
|
(attributes ctxt) x.pext_attributes
|
||||||
|
|
||||||
and case_list ctxt f l : unit =
|
and case_list ctxt f l : unit =
|
||||||
let aux f {pc_lhs; pc_guard; pc_rhs} =
|
let aux f {pc_lhs; pc_guard; pc_rhs} =
|
||||||
|
|
|
@ -234,6 +234,9 @@ opam switch create --repo=local,beta=git+https://github.com/ocaml/ocaml-beta-rep
|
||||||
```
|
```
|
||||||
The switch should build.
|
The switch should build.
|
||||||
|
|
||||||
|
For a production release, you also need to create new opam files for the ocaml-manual and
|
||||||
|
ocaml-src packages.
|
||||||
|
|
||||||
## 6.1 Update OPAM dev packages after branching
|
## 6.1 Update OPAM dev packages after branching
|
||||||
|
|
||||||
Create a new ocaml/ocaml.$NEXT/opam file.
|
Create a new ocaml/ocaml.$NEXT/opam file.
|
||||||
|
|
|
@ -349,13 +349,15 @@ ifneq "$(1)" "%"
|
||||||
# don't use -MG and instead include $(GENERATED_HEADERS) in the order only
|
# don't use -MG and instead include $(GENERATED_HEADERS) in the order only
|
||||||
# dependencies to ensure that they exist before dependencies are computed.
|
# dependencies to ensure that they exist before dependencies are computed.
|
||||||
$(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(GENERATED_HEADERS)
|
$(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(GENERATED_HEADERS)
|
||||||
$$(DEP_CC) $$(OC_CPPFLAGS) $$< -MT '$$*$(subst %,,$(1)).$(O)' -MF $$@
|
$$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT \
|
||||||
|
'$$*$(subst %,,$(1)).$(O)' -MF $$@
|
||||||
endif
|
endif
|
||||||
$(1).$(O): %.c
|
$(1).$(O): %.c
|
||||||
else
|
else
|
||||||
$(1).$(O): %.c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS)
|
$(1).$(O): %.c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS)
|
||||||
endif
|
endif
|
||||||
$$(CC) -c $$(OC_CFLAGS) $$(OC_CPPFLAGS) $$(OUTPUTOBJ)$$@ $$<
|
$$(CC) -c $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \
|
||||||
|
$$(OUTPUTOBJ)$$@ $$<
|
||||||
endef
|
endef
|
||||||
|
|
||||||
object_types := % %.b %.bd %.bi %.bpic
|
object_types := % %.b %.bd %.bi %.bpic
|
||||||
|
|
|
@ -289,6 +289,6 @@ CAMLexport value caml_alloc_some(value v)
|
||||||
{
|
{
|
||||||
CAMLparam1(v);
|
CAMLparam1(v);
|
||||||
value some = caml_alloc_small(1, 0);
|
value some = caml_alloc_small(1, 0);
|
||||||
Store_field(some, 0, v);
|
Field(some, 0) = v;
|
||||||
CAMLreturn(some);
|
CAMLreturn(some);
|
||||||
}
|
}
|
||||||
|
|
221
runtime/arm64.S
221
runtime/arm64.S
|
@ -24,10 +24,9 @@
|
||||||
#define TRAP_PTR x26
|
#define TRAP_PTR x26
|
||||||
#define ALLOC_PTR x27
|
#define ALLOC_PTR x27
|
||||||
#define ALLOC_LIMIT x28
|
#define ALLOC_LIMIT x28
|
||||||
#define ARG x15
|
#define ADDITIONAL_ARG x8
|
||||||
#define TMP x16
|
#define TMP x16
|
||||||
#define TMP2 x17
|
#define TMP2 x17
|
||||||
#define ARG_DOMAIN_STATE_PTR x18
|
|
||||||
|
|
||||||
#define C_ARG_1 x0
|
#define C_ARG_1 x0
|
||||||
#define C_ARG_2 x1
|
#define C_ARG_2 x1
|
||||||
|
@ -51,24 +50,47 @@
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
.set domain_curr_field, 0
|
.set domain_curr_field, 0
|
||||||
|
#if defined(SYS_macosx)
|
||||||
|
#define DOMAIN_STATE(c_type, name) DOMAIN_STATE c_type, name
|
||||||
|
.macro DOMAIN_STATE c_type, name
|
||||||
|
.equ domain_field_caml_\name, domain_curr_field
|
||||||
|
.set domain_curr_field, domain_curr_field + 1
|
||||||
|
.endm
|
||||||
|
#else
|
||||||
#define DOMAIN_STATE(c_type, name) \
|
#define DOMAIN_STATE(c_type, name) \
|
||||||
.equ domain_field_caml_##name, domain_curr_field ; \
|
.equ domain_field_caml_##name, domain_curr_field ; \
|
||||||
.set domain_curr_field, domain_curr_field + 1
|
.set domain_curr_field, domain_curr_field + 1
|
||||||
|
#endif
|
||||||
#include "../runtime/caml/domain_state.tbl"
|
#include "../runtime/caml/domain_state.tbl"
|
||||||
#undef DOMAIN_STATE
|
#undef DOMAIN_STATE
|
||||||
|
|
||||||
#define Caml_state(var) [x25, 8*domain_field_caml_##var]
|
#define Caml_state(var) [x25, 8*domain_field_caml_##var]
|
||||||
|
|
||||||
#if defined(__PIC__)
|
/* Globals and labels */
|
||||||
|
#if defined(SYS_macosx)
|
||||||
|
#define G(sym) _##sym
|
||||||
|
#define L(lbl) L##lbl
|
||||||
|
#else
|
||||||
|
#define G(sym) sym
|
||||||
|
#define L(lbl) .L##lbl
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#if defined(SYS_macosx)
|
||||||
|
|
||||||
|
#define ADDRGLOBAL(reg,symb) ADDRGLOBAL reg, symb
|
||||||
|
.macro ADDRGLOBAL reg, symb
|
||||||
|
adrp TMP2, G(\symb)@GOTPAGE
|
||||||
|
ldr \reg, [TMP2, G(\symb)@GOTPAGEOFF]
|
||||||
|
.endm
|
||||||
|
#elif defined(__PIC__)
|
||||||
#define ADDRGLOBAL(reg,symb) \
|
#define ADDRGLOBAL(reg,symb) \
|
||||||
adrp TMP2, :got:symb; \
|
adrp TMP2, :got:G(symb); \
|
||||||
ldr reg, [TMP2, #:got_lo12:symb]
|
ldr reg, [TMP2, #:got_lo12:G(symb)]
|
||||||
#else
|
#else
|
||||||
|
|
||||||
#define ADDRGLOBAL(reg,symb) \
|
#define ADDRGLOBAL(reg,symb) \
|
||||||
adrp reg, symb; \
|
adrp reg, G(symb); \
|
||||||
add reg, reg, #:lo12:symb
|
add reg, reg, #:lo12:G(symb)
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -80,28 +102,62 @@
|
||||||
|
|
||||||
#if defined(FUNCTION_SECTIONS)
|
#if defined(FUNCTION_SECTIONS)
|
||||||
TEXT_SECTION(caml_hot__code_begin)
|
TEXT_SECTION(caml_hot__code_begin)
|
||||||
.globl caml_hot__code_begin
|
.globl G(caml_hot__code_begin)
|
||||||
caml_hot__code_begin:
|
G(caml_hot__code_begin):
|
||||||
|
|
||||||
TEXT_SECTION(caml_hot__code_end)
|
TEXT_SECTION(caml_hot__code_end)
|
||||||
.globl caml_hot__code_end
|
.globl G(caml_hot__code_end)
|
||||||
caml_hot__code_end:
|
G(caml_hot__code_end):
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#if defined(SYS_macosx)
|
||||||
|
|
||||||
|
#define FUNCTION(name) FUNCTION name
|
||||||
|
.macro FUNCTION name
|
||||||
|
TEXT_SECTION(caml.##G(\name))
|
||||||
|
.align 2
|
||||||
|
.globl G(\name)
|
||||||
|
G(\name):
|
||||||
|
.endm
|
||||||
|
#define END_FUNCTION(name)
|
||||||
|
|
||||||
|
#define OBJECT(name) OBJECT name
|
||||||
|
.macro OBJECT name
|
||||||
|
.data
|
||||||
|
.align 3
|
||||||
|
.globl G(\name)
|
||||||
|
G(\name):
|
||||||
|
.endm
|
||||||
|
#define END_OBJECT(name)
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
#define FUNCTION(name) \
|
#define FUNCTION(name) \
|
||||||
TEXT_SECTION(caml.##name); \
|
TEXT_SECTION(caml.##name); \
|
||||||
.align 2; \
|
.align 2; \
|
||||||
.globl name; \
|
.globl G(name); \
|
||||||
.type name, %function; \
|
.type G(name), %function; \
|
||||||
name:
|
G(name):
|
||||||
|
#define END_FUNCTION(name) \
|
||||||
|
.size G(name), .-G(name)
|
||||||
|
|
||||||
|
#define OBJECT(name) \
|
||||||
|
.data; \
|
||||||
|
.align 3; \
|
||||||
|
.globl G(name); \
|
||||||
|
.type G(name), %object; \
|
||||||
|
G(name):
|
||||||
|
#define END_OBJECT(name) \
|
||||||
|
.size G(name), .-G(name)
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Allocation functions and GC interface */
|
/* Allocation functions and GC interface */
|
||||||
.globl caml_system__code_begin
|
.globl G(caml_system__code_begin)
|
||||||
caml_system__code_begin:
|
G(caml_system__code_begin):
|
||||||
|
|
||||||
FUNCTION(caml_call_gc)
|
FUNCTION(caml_call_gc)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
.Lcaml_call_gc:
|
L(caml_call_gc):
|
||||||
/* Record return address */
|
/* Record return address */
|
||||||
str x30, Caml_state(last_return_address)
|
str x30, Caml_state(last_return_address)
|
||||||
/* Record lowest stack address */
|
/* Record lowest stack address */
|
||||||
|
@ -150,7 +206,7 @@ FUNCTION(caml_call_gc)
|
||||||
/* Save trap pointer in case an exception is raised during GC */
|
/* Save trap pointer in case an exception is raised during GC */
|
||||||
str TRAP_PTR, Caml_state(exception_pointer)
|
str TRAP_PTR, Caml_state(exception_pointer)
|
||||||
/* Call the garbage collector */
|
/* Call the garbage collector */
|
||||||
bl caml_garbage_collection
|
bl G(caml_garbage_collection)
|
||||||
/* Restore registers */
|
/* Restore registers */
|
||||||
ldp x0, x1, [sp, 16]
|
ldp x0, x1, [sp, 16]
|
||||||
ldp x2, x3, [sp, 32]
|
ldp x2, x3, [sp, 32]
|
||||||
|
@ -183,46 +239,46 @@ FUNCTION(caml_call_gc)
|
||||||
ldp x29, x30, [sp], 400
|
ldp x29, x30, [sp], 400
|
||||||
ret
|
ret
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_call_gc, .-caml_call_gc
|
END_FUNCTION(caml_call_gc)
|
||||||
|
|
||||||
FUNCTION(caml_alloc1)
|
FUNCTION(caml_alloc1)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
sub ALLOC_PTR, ALLOC_PTR, #16
|
sub ALLOC_PTR, ALLOC_PTR, #16
|
||||||
cmp ALLOC_PTR, ALLOC_LIMIT
|
cmp ALLOC_PTR, ALLOC_LIMIT
|
||||||
b.lo .Lcaml_call_gc
|
b.lo L(caml_call_gc)
|
||||||
ret
|
ret
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_alloc1, .-caml_alloc1
|
END_FUNCTION(caml_alloc1)
|
||||||
|
|
||||||
FUNCTION(caml_alloc2)
|
FUNCTION(caml_alloc2)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
sub ALLOC_PTR, ALLOC_PTR, #24
|
sub ALLOC_PTR, ALLOC_PTR, #24
|
||||||
cmp ALLOC_PTR, ALLOC_LIMIT
|
cmp ALLOC_PTR, ALLOC_LIMIT
|
||||||
b.lo .Lcaml_call_gc
|
b.lo L(caml_call_gc)
|
||||||
ret
|
ret
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_alloc2, .-caml_alloc2
|
END_FUNCTION(caml_alloc2)
|
||||||
|
|
||||||
FUNCTION(caml_alloc3)
|
FUNCTION(caml_alloc3)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
sub ALLOC_PTR, ALLOC_PTR, #32
|
sub ALLOC_PTR, ALLOC_PTR, #32
|
||||||
cmp ALLOC_PTR, ALLOC_LIMIT
|
cmp ALLOC_PTR, ALLOC_LIMIT
|
||||||
b.lo .Lcaml_call_gc
|
b.lo L(caml_call_gc)
|
||||||
ret
|
ret
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_alloc3, .-caml_alloc3
|
END_FUNCTION(caml_alloc3)
|
||||||
|
|
||||||
FUNCTION(caml_allocN)
|
FUNCTION(caml_allocN)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
sub ALLOC_PTR, ALLOC_PTR, ARG
|
sub ALLOC_PTR, ALLOC_PTR, ADDITIONAL_ARG
|
||||||
cmp ALLOC_PTR, ALLOC_LIMIT
|
cmp ALLOC_PTR, ALLOC_LIMIT
|
||||||
b.lo .Lcaml_call_gc
|
b.lo L(caml_call_gc)
|
||||||
ret
|
ret
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_allocN, .-caml_allocN
|
END_FUNCTION(caml_allocN)
|
||||||
|
|
||||||
/* Call a C function from OCaml */
|
/* Call a C function from OCaml */
|
||||||
/* Function to call is in ARG */
|
/* Function to call is in ADDITIONAL_ARG */
|
||||||
|
|
||||||
FUNCTION(caml_c_call)
|
FUNCTION(caml_c_call)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
|
@ -237,27 +293,28 @@ FUNCTION(caml_c_call)
|
||||||
str ALLOC_PTR, Caml_state(young_ptr)
|
str ALLOC_PTR, Caml_state(young_ptr)
|
||||||
str TRAP_PTR, Caml_state(exception_pointer)
|
str TRAP_PTR, Caml_state(exception_pointer)
|
||||||
/* Call the function */
|
/* Call the function */
|
||||||
blr ARG
|
blr ADDITIONAL_ARG
|
||||||
/* Reload alloc ptr and alloc limit */
|
/* Reload alloc ptr and alloc limit */
|
||||||
ldr ALLOC_PTR, Caml_state(young_ptr)
|
ldr ALLOC_PTR, Caml_state(young_ptr)
|
||||||
ldr ALLOC_LIMIT, Caml_state(young_limit)
|
ldr ALLOC_LIMIT, Caml_state(young_limit)
|
||||||
/* Return */
|
/* Return */
|
||||||
ret x19
|
ret x19
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_c_call, .-caml_c_call
|
END_FUNCTION(caml_c_call)
|
||||||
|
|
||||||
/* Start the OCaml program */
|
/* Start the OCaml program */
|
||||||
|
|
||||||
FUNCTION(caml_start_program)
|
FUNCTION(caml_start_program)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
mov ARG_DOMAIN_STATE_PTR, C_ARG_1
|
mov TMP, C_ARG_1
|
||||||
ADDRGLOBAL(ARG, caml_program)
|
ADDRGLOBAL(TMP2, caml_program)
|
||||||
|
|
||||||
/* Code shared with caml_callback* */
|
/* Code shared with caml_callback* */
|
||||||
/* Address of OCaml code to call is in ARG */
|
/* Address of domain state is in TMP */
|
||||||
|
/* Address of OCaml code to call is in TMP2 */
|
||||||
/* Arguments to the OCaml code are in x0...x7 */
|
/* Arguments to the OCaml code are in x0...x7 */
|
||||||
|
|
||||||
.Ljump_to_caml:
|
L(jump_to_caml):
|
||||||
/* Set up stack frame and save callee-save registers */
|
/* Set up stack frame and save callee-save registers */
|
||||||
CFI_OFFSET(29, -160)
|
CFI_OFFSET(29, -160)
|
||||||
CFI_OFFSET(30, -152)
|
CFI_OFFSET(30, -152)
|
||||||
|
@ -274,7 +331,7 @@ FUNCTION(caml_start_program)
|
||||||
stp d12, d13, [sp, 128]
|
stp d12, d13, [sp, 128]
|
||||||
stp d14, d15, [sp, 144]
|
stp d14, d15, [sp, 144]
|
||||||
/* Load domain state pointer from argument */
|
/* Load domain state pointer from argument */
|
||||||
mov DOMAIN_STATE_PTR, ARG_DOMAIN_STATE_PTR
|
mov DOMAIN_STATE_PTR, TMP
|
||||||
/* Setup a callback link on the stack */
|
/* Setup a callback link on the stack */
|
||||||
ldr x8, Caml_state(bottom_of_stack)
|
ldr x8, Caml_state(bottom_of_stack)
|
||||||
ldr x9, Caml_state(last_return_address)
|
ldr x9, Caml_state(last_return_address)
|
||||||
|
@ -284,7 +341,7 @@ FUNCTION(caml_start_program)
|
||||||
str x10, [sp, 16]
|
str x10, [sp, 16]
|
||||||
/* Setup a trap frame to catch exceptions escaping the OCaml code */
|
/* Setup a trap frame to catch exceptions escaping the OCaml code */
|
||||||
ldr x8, Caml_state(exception_pointer)
|
ldr x8, Caml_state(exception_pointer)
|
||||||
adr x9, .Ltrap_handler
|
adr x9, L(trap_handler)
|
||||||
stp x8, x9, [sp, -16]!
|
stp x8, x9, [sp, -16]!
|
||||||
CFI_ADJUST(16)
|
CFI_ADJUST(16)
|
||||||
add TRAP_PTR, sp, #0
|
add TRAP_PTR, sp, #0
|
||||||
|
@ -292,14 +349,14 @@ FUNCTION(caml_start_program)
|
||||||
ldr ALLOC_PTR, Caml_state(young_ptr)
|
ldr ALLOC_PTR, Caml_state(young_ptr)
|
||||||
ldr ALLOC_LIMIT, Caml_state(young_limit)
|
ldr ALLOC_LIMIT, Caml_state(young_limit)
|
||||||
/* Call the OCaml code */
|
/* Call the OCaml code */
|
||||||
blr ARG
|
blr TMP2
|
||||||
.Lcaml_retaddr:
|
L(caml_retaddr):
|
||||||
/* Pop the trap frame, restoring caml_exception_pointer */
|
/* Pop the trap frame, restoring caml_exception_pointer */
|
||||||
ldr x8, [sp], 16
|
ldr x8, [sp], 16
|
||||||
CFI_ADJUST(-16)
|
CFI_ADJUST(-16)
|
||||||
str x8, Caml_state(exception_pointer)
|
str x8, Caml_state(exception_pointer)
|
||||||
/* Pop the callback link, restoring the global variables */
|
/* Pop the callback link, restoring the global variables */
|
||||||
.Lreturn_result:
|
L(return_result):
|
||||||
ldr x10, [sp, 16]
|
ldr x10, [sp, 16]
|
||||||
ldp x8, x9, [sp], 32
|
ldp x8, x9, [sp], 32
|
||||||
CFI_ADJUST(-32)
|
CFI_ADJUST(-32)
|
||||||
|
@ -323,24 +380,20 @@ FUNCTION(caml_start_program)
|
||||||
/* Return to C caller */
|
/* Return to C caller */
|
||||||
ret
|
ret
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.type .Lcaml_retaddr, %function
|
END_FUNCTION(caml_start_program)
|
||||||
.size .Lcaml_retaddr, .-.Lcaml_retaddr
|
|
||||||
.size caml_start_program, .-caml_start_program
|
|
||||||
|
|
||||||
/* The trap handler */
|
/* The trap handler */
|
||||||
|
|
||||||
.align 2
|
.align 2
|
||||||
.Ltrap_handler:
|
L(trap_handler):
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
/* Save exception pointer */
|
/* Save exception pointer */
|
||||||
str TRAP_PTR, Caml_state(exception_pointer)
|
str TRAP_PTR, Caml_state(exception_pointer)
|
||||||
/* Encode exception bucket as an exception result */
|
/* Encode exception bucket as an exception result */
|
||||||
orr x0, x0, #2
|
orr x0, x0, #2
|
||||||
/* Return it */
|
/* Return it */
|
||||||
b .Lreturn_result
|
b L(return_result)
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.type .Ltrap_handler, %function
|
|
||||||
.size .Ltrap_handler, .-.Ltrap_handler
|
|
||||||
|
|
||||||
/* Raise an exception from OCaml */
|
/* Raise an exception from OCaml */
|
||||||
|
|
||||||
|
@ -362,12 +415,12 @@ FUNCTION(caml_raise_exn)
|
||||||
mov x1, x30 /* arg2: pc of raise */
|
mov x1, x30 /* arg2: pc of raise */
|
||||||
add x2, sp, #0 /* arg3: sp of raise */
|
add x2, sp, #0 /* arg3: sp of raise */
|
||||||
mov x3, TRAP_PTR /* arg4: sp of handler */
|
mov x3, TRAP_PTR /* arg4: sp of handler */
|
||||||
bl caml_stash_backtrace
|
bl G(caml_stash_backtrace)
|
||||||
/* Restore exception bucket and raise */
|
/* Restore exception bucket and raise */
|
||||||
mov x0, x19
|
mov x0, x19
|
||||||
b 1b
|
b 1b
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_raise_exn, .-caml_raise_exn
|
END_FUNCTION(caml_raise_exn)
|
||||||
|
|
||||||
/* Raise an exception from C */
|
/* Raise an exception from C */
|
||||||
|
|
||||||
|
@ -397,12 +450,12 @@ FUNCTION(caml_raise_exception)
|
||||||
ldr x1, Caml_state(last_return_address) /* arg2: pc of raise */
|
ldr x1, Caml_state(last_return_address) /* arg2: pc of raise */
|
||||||
ldr x2, Caml_state(bottom_of_stack) /* arg3: sp of raise */
|
ldr x2, Caml_state(bottom_of_stack) /* arg3: sp of raise */
|
||||||
mov x3, TRAP_PTR /* arg4: sp of handler */
|
mov x3, TRAP_PTR /* arg4: sp of handler */
|
||||||
bl caml_stash_backtrace
|
bl G(caml_stash_backtrace)
|
||||||
/* Restore exception bucket and raise */
|
/* Restore exception bucket and raise */
|
||||||
mov x0, x19
|
mov x0, x19
|
||||||
b 1b
|
b 1b
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_raise_exception, .-caml_raise_exception
|
END_FUNCTION(caml_raise_exception)
|
||||||
|
|
||||||
/* Callback from C to OCaml */
|
/* Callback from C to OCaml */
|
||||||
|
|
||||||
|
@ -410,74 +463,64 @@ FUNCTION(caml_callback_asm)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
/* Initial shuffling of arguments */
|
/* Initial shuffling of arguments */
|
||||||
/* (x0 = Caml_state, x1 = closure, [x2] = first arg) */
|
/* (x0 = Caml_state, x1 = closure, [x2] = first arg) */
|
||||||
mov ARG_DOMAIN_STATE_PTR, x0
|
mov TMP, x0
|
||||||
ldr x0, [x2] /* x0 = first arg */
|
ldr x0, [x2] /* x0 = first arg */
|
||||||
/* x1 = closure environment */
|
/* x1 = closure environment */
|
||||||
ldr ARG, [x1] /* code pointer */
|
ldr TMP2, [x1] /* code pointer */
|
||||||
b .Ljump_to_caml
|
b L(jump_to_caml)
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.type caml_callback_asm, %function
|
END_FUNCTION(caml_callback_asm)
|
||||||
.size caml_callback_asm, .-caml_callback_asm
|
|
||||||
|
|
||||||
TEXT_SECTION(caml_callback2_asm)
|
FUNCTION(caml_callback2_asm)
|
||||||
.align 2
|
|
||||||
.globl caml_callback2_asm
|
|
||||||
caml_callback2_asm:
|
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
/* Initial shuffling of arguments */
|
/* Initial shuffling of arguments */
|
||||||
/* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2) */
|
/* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2) */
|
||||||
mov ARG_DOMAIN_STATE_PTR, x0
|
mov TMP, x0
|
||||||
mov TMP, x1
|
mov TMP2, x1
|
||||||
ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
|
ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
|
||||||
mov x2, TMP /* x2 = closure environment */
|
mov x2, TMP2 /* x2 = closure environment */
|
||||||
ADDRGLOBAL(ARG, caml_apply2)
|
ADDRGLOBAL(TMP2, caml_apply2)
|
||||||
b .Ljump_to_caml
|
b L(jump_to_caml)
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.type caml_callback2_asm, %function
|
END_FUNCTION(caml_callback2_asm)
|
||||||
.size caml_callback2_asm, .-caml_callback2_asm
|
|
||||||
|
|
||||||
TEXT_SECTION(caml_callback3_asm)
|
FUNCTION(caml_callback3_asm)
|
||||||
.align 2
|
|
||||||
.globl caml_callback3_asm
|
|
||||||
caml_callback3_asm:
|
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
/* Initial shuffling of arguments */
|
/* Initial shuffling of arguments */
|
||||||
/* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2,
|
/* (x0 = Caml_state, x1 = closure, [x2] = arg1, [x2,8] = arg2,
|
||||||
[x2,16] = arg3) */
|
[x2,16] = arg3) */
|
||||||
mov ARG_DOMAIN_STATE_PTR, x0
|
mov TMP, x0
|
||||||
mov x3, x1 /* x3 = closure environment */
|
mov x3, x1 /* x3 = closure environment */
|
||||||
ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
|
ldp x0, x1, [x2, 0] /* x0 = first arg, x1 = second arg */
|
||||||
ldr x2, [x2, 16] /* x2 = third arg */
|
ldr x2, [x2, 16] /* x2 = third arg */
|
||||||
ADDRGLOBAL(ARG, caml_apply3)
|
ADDRGLOBAL(TMP2, caml_apply3)
|
||||||
b .Ljump_to_caml
|
b L(jump_to_caml)
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_callback3_asm, .-caml_callback3_asm
|
END_FUNCTION(caml_callback3_asm)
|
||||||
|
|
||||||
FUNCTION(caml_ml_array_bound_error)
|
FUNCTION(caml_ml_array_bound_error)
|
||||||
CFI_STARTPROC
|
CFI_STARTPROC
|
||||||
/* Load address of [caml_array_bound_error] in ARG */
|
/* Load address of [caml_array_bound_error] in ADDITIONAL_ARG */
|
||||||
ADDRGLOBAL(ARG, caml_array_bound_error)
|
ADDRGLOBAL(ADDITIONAL_ARG, caml_array_bound_error)
|
||||||
/* Call that function */
|
/* Call that function */
|
||||||
b caml_c_call
|
b G(caml_c_call)
|
||||||
CFI_ENDPROC
|
CFI_ENDPROC
|
||||||
.size caml_ml_array_bound_error, .-caml_ml_array_bound_error
|
END_FUNCTION(caml_ml_array_bound_error)
|
||||||
|
|
||||||
.globl caml_system__code_end
|
.globl G(caml_system__code_end)
|
||||||
caml_system__code_end:
|
G(caml_system__code_end):
|
||||||
|
|
||||||
/* GC roots for callback */
|
/* GC roots for callback */
|
||||||
|
|
||||||
.data
|
OBJECT(caml_system__frametable)
|
||||||
.align 3
|
|
||||||
.globl caml_system__frametable
|
|
||||||
caml_system__frametable:
|
|
||||||
.quad 1 /* one descriptor */
|
.quad 1 /* one descriptor */
|
||||||
.quad .Lcaml_retaddr /* return address into callback */
|
.quad L(caml_retaddr) /* return address into callback */
|
||||||
.short -1 /* negative frame size => use callback link */
|
.short -1 /* negative frame size => use callback link */
|
||||||
.short 0 /* no roots */
|
.short 0 /* no roots */
|
||||||
.align 3
|
.align 3
|
||||||
.type caml_system__frametable, %object
|
END_OBJECT(caml_system__frametable)
|
||||||
.size caml_system__frametable, .-caml_system__frametable
|
|
||||||
|
|
||||||
|
#if !defined(SYS_macosx)
|
||||||
/* Mark stack as non-executable */
|
/* Mark stack as non-executable */
|
||||||
.section .note.GNU-stack,"",%progbits
|
.section .note.GNU-stack,"",%progbits
|
||||||
|
#endif
|
||||||
|
|
|
@ -386,6 +386,7 @@ static void read_main_debug_info(struct debug_info *di)
|
||||||
if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
|
if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
|
||||||
chan = caml_open_descriptor_in(fd);
|
chan = caml_open_descriptor_in(fd);
|
||||||
|
|
||||||
|
Lock(chan);
|
||||||
num_events = caml_getword(chan);
|
num_events = caml_getword(chan);
|
||||||
events = caml_alloc(num_events, 0);
|
events = caml_alloc(num_events, 0);
|
||||||
|
|
||||||
|
@ -401,6 +402,7 @@ static void read_main_debug_info(struct debug_info *di)
|
||||||
/* Record event list */
|
/* Record event list */
|
||||||
Store_field(events, i, evl);
|
Store_field(events, i, evl);
|
||||||
}
|
}
|
||||||
|
Unlock(chan);
|
||||||
|
|
||||||
caml_close_channel(chan);
|
caml_close_channel(chan);
|
||||||
|
|
||||||
|
|
|
@ -51,10 +51,8 @@ CAMLextern value caml_alloc_sprintf(const char * format, ...)
|
||||||
;
|
;
|
||||||
CAMLextern value caml_alloc_some(value);
|
CAMLextern value caml_alloc_some(value);
|
||||||
|
|
||||||
CAMLextern value caml_alloc_with_profinfo (mlsize_t, tag_t, intnat);
|
|
||||||
CAMLextern value caml_alloc_small_with_my_or_given_profinfo (
|
CAMLextern value caml_alloc_small_with_my_or_given_profinfo (
|
||||||
mlsize_t, tag_t, uintnat);
|
mlsize_t, tag_t, uintnat);
|
||||||
CAMLextern value caml_alloc_small_with_profinfo (mlsize_t, tag_t, intnat);
|
|
||||||
|
|
||||||
typedef void (*final_fun)(value);
|
typedef void (*final_fun)(value);
|
||||||
CAMLextern value caml_alloc_final (mlsize_t wosize,
|
CAMLextern value caml_alloc_final (mlsize_t wosize,
|
||||||
|
|
|
@ -96,7 +96,7 @@
|
||||||
* It might be called before GC initialization, so it shouldn't do OCaml
|
* It might be called before GC initialization, so it shouldn't do OCaml
|
||||||
* allocation.
|
* allocation.
|
||||||
*/
|
*/
|
||||||
CAMLprim value caml_record_backtrace(value vflag);
|
CAMLextern value caml_record_backtrace(value vflag);
|
||||||
|
|
||||||
|
|
||||||
#ifndef NATIVE_CODE
|
#ifndef NATIVE_CODE
|
||||||
|
@ -122,7 +122,7 @@ extern void caml_stash_backtrace(value exn, value * sp, int reraise);
|
||||||
CAMLextern void caml_print_exception_backtrace(void);
|
CAMLextern void caml_print_exception_backtrace(void);
|
||||||
|
|
||||||
void caml_init_backtrace(void);
|
void caml_init_backtrace(void);
|
||||||
CAMLexport void caml_init_debug_info(void);
|
CAMLextern void caml_init_debug_info(void);
|
||||||
|
|
||||||
#endif /* CAML_INTERNALS */
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
|
|
|
@ -264,7 +264,6 @@
|
||||||
#define something_to_do caml_something_to_do
|
#define something_to_do caml_something_to_do
|
||||||
#define enter_blocking_section_hook caml_enter_blocking_section_hook
|
#define enter_blocking_section_hook caml_enter_blocking_section_hook
|
||||||
#define leave_blocking_section_hook caml_leave_blocking_section_hook
|
#define leave_blocking_section_hook caml_leave_blocking_section_hook
|
||||||
#define try_leave_blocking_section_hook caml_try_leave_blocking_section_hook
|
|
||||||
#define enter_blocking_section caml_enter_blocking_section
|
#define enter_blocking_section caml_enter_blocking_section
|
||||||
#define leave_blocking_section caml_leave_blocking_section
|
#define leave_blocking_section caml_leave_blocking_section
|
||||||
#define convert_signal_number caml_convert_signal_number
|
#define convert_signal_number caml_convert_signal_number
|
||||||
|
|
|
@ -75,6 +75,11 @@ extern struct custom_operations *
|
||||||
caml_final_custom_operations(void (*fn)(value));
|
caml_final_custom_operations(void (*fn)(value));
|
||||||
|
|
||||||
extern void caml_init_custom_operations(void);
|
extern void caml_init_custom_operations(void);
|
||||||
|
|
||||||
|
extern struct custom_operations caml_nativeint_ops;
|
||||||
|
extern struct custom_operations caml_int32_ops;
|
||||||
|
extern struct custom_operations caml_int64_ops;
|
||||||
|
extern struct custom_operations caml_ba_ops;
|
||||||
#endif /* CAML_INTERNALS */
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
#ifdef __cplusplus
|
#ifdef __cplusplus
|
||||||
|
|
|
@ -56,6 +56,7 @@ enum {
|
||||||
CHANNEL_FLAG_BLOCKING_WRITE = 2, /* Don't release master lock when writing */
|
CHANNEL_FLAG_BLOCKING_WRITE = 2, /* Don't release master lock when writing */
|
||||||
#endif
|
#endif
|
||||||
CHANNEL_FLAG_MANAGED_BY_GC = 4, /* Free and close using GC finalization */
|
CHANNEL_FLAG_MANAGED_BY_GC = 4, /* Free and close using GC finalization */
|
||||||
|
CHANNEL_TEXT_MODE = 8, /* "Text mode" for Windows and Cygwin */
|
||||||
};
|
};
|
||||||
|
|
||||||
/* For an output channel:
|
/* For an output channel:
|
||||||
|
@ -64,8 +65,19 @@ enum {
|
||||||
[offset] is the absolute position of the logical end of the buffer, [max].
|
[offset] is the absolute position of the logical end of the buffer, [max].
|
||||||
*/
|
*/
|
||||||
|
|
||||||
/* Functions and macros that can be called from C. Take arguments of
|
/* Creating and closing channels from C */
|
||||||
type struct channel *. No locking is performed. */
|
|
||||||
|
CAMLextern struct channel * caml_open_descriptor_in (int);
|
||||||
|
CAMLextern struct channel * caml_open_descriptor_out (int);
|
||||||
|
CAMLextern void caml_close_channel (struct channel *);
|
||||||
|
CAMLextern file_offset caml_channel_size (struct channel *);
|
||||||
|
CAMLextern void caml_seek_in (struct channel *, file_offset);
|
||||||
|
CAMLextern void caml_seek_out (struct channel *, file_offset);
|
||||||
|
CAMLextern file_offset caml_pos_in (struct channel *);
|
||||||
|
CAMLextern file_offset caml_pos_out (struct channel *);
|
||||||
|
|
||||||
|
/* I/O on channels from C. The channel must be locked (see below) before
|
||||||
|
calling any of the functions and macros below */
|
||||||
|
|
||||||
#define caml_putch(channel, ch) do{ \
|
#define caml_putch(channel, ch) do{ \
|
||||||
if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
|
if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
|
||||||
|
@ -77,11 +89,8 @@ enum {
|
||||||
? caml_refill(channel) \
|
? caml_refill(channel) \
|
||||||
: (unsigned char) *((channel)->curr)++)
|
: (unsigned char) *((channel)->curr)++)
|
||||||
|
|
||||||
CAMLextern struct channel * caml_open_descriptor_in (int);
|
|
||||||
CAMLextern struct channel * caml_open_descriptor_out (int);
|
|
||||||
CAMLextern void caml_close_channel (struct channel *);
|
|
||||||
CAMLextern int caml_channel_binary_mode (struct channel *);
|
|
||||||
CAMLextern value caml_alloc_channel(struct channel *chan);
|
CAMLextern value caml_alloc_channel(struct channel *chan);
|
||||||
|
CAMLextern int caml_channel_binary_mode (struct channel *);
|
||||||
|
|
||||||
CAMLextern int caml_flush_partial (struct channel *);
|
CAMLextern int caml_flush_partial (struct channel *);
|
||||||
CAMLextern void caml_flush (struct channel *);
|
CAMLextern void caml_flush (struct channel *);
|
||||||
|
@ -119,6 +128,10 @@ CAMLextern struct channel * caml_all_opened_channels;
|
||||||
#define Val_file_offset(fofs) caml_copy_int64(fofs)
|
#define Val_file_offset(fofs) caml_copy_int64(fofs)
|
||||||
#define File_offset_val(v) ((file_offset) Int64_val(v))
|
#define File_offset_val(v) ((file_offset) Int64_val(v))
|
||||||
|
|
||||||
|
/* Primitives required by the Unix library */
|
||||||
|
CAMLextern value caml_ml_open_descriptor_in(value fd);
|
||||||
|
CAMLextern value caml_ml_open_descriptor_out(value fd);
|
||||||
|
|
||||||
#endif /* CAML_INTERNALS */
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
#endif /* CAML_IO_H */
|
#endif /* CAML_IO_H */
|
||||||
|
|
|
@ -57,11 +57,13 @@ CAMLextern void caml_free_dependent_memory (mlsize_t bsz);
|
||||||
CAMLextern void caml_modify (value *, value);
|
CAMLextern void caml_modify (value *, value);
|
||||||
CAMLextern void caml_initialize (value *, value);
|
CAMLextern void caml_initialize (value *, value);
|
||||||
CAMLextern value caml_check_urgent_gc (value);
|
CAMLextern value caml_check_urgent_gc (value);
|
||||||
|
CAMLextern color_t caml_allocation_color (void *hp);
|
||||||
|
#ifdef CAML_INTERNALS
|
||||||
CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
|
CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
|
||||||
CAMLextern void caml_free_for_heap (char *mem);
|
CAMLextern void caml_free_for_heap (char *mem);
|
||||||
CAMLextern void caml_disown_for_heap (char *mem);
|
CAMLextern void caml_disown_for_heap (char *mem);
|
||||||
CAMLextern int caml_add_to_heap (char *mem);
|
CAMLextern int caml_add_to_heap (char *mem);
|
||||||
CAMLextern color_t caml_allocation_color (void *hp);
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
CAMLextern int caml_huge_fallback_count;
|
CAMLextern int caml_huge_fallback_count;
|
||||||
|
|
||||||
|
|
|
@ -63,11 +63,13 @@ struct caml_custom_table CAML_TABLE_STRUCT(struct caml_custom_elt);
|
||||||
/* Table of custom blocks in the minor heap that contain finalizers
|
/* Table of custom blocks in the minor heap that contain finalizers
|
||||||
or GC speed parameters. */
|
or GC speed parameters. */
|
||||||
|
|
||||||
|
CAMLextern void caml_minor_collection (void);
|
||||||
|
|
||||||
|
#ifdef CAML_INTERNALS
|
||||||
extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
|
extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
|
||||||
extern void caml_empty_minor_heap (void);
|
extern void caml_empty_minor_heap (void);
|
||||||
CAMLextern void caml_gc_dispatch (void);
|
extern void caml_gc_dispatch (void);
|
||||||
CAMLextern void caml_minor_collection (void);
|
extern void caml_garbage_collection (void); /* runtime/signals_nat.c */
|
||||||
CAMLextern void garbage_collection (void); /* runtime/signals_nat.c */
|
|
||||||
extern void caml_oldify_one (value, value *);
|
extern void caml_oldify_one (value, value *);
|
||||||
extern void caml_oldify_mopup (void);
|
extern void caml_oldify_mopup (void);
|
||||||
|
|
||||||
|
@ -131,4 +133,6 @@ Caml_inline void add_to_custom_table (struct caml_custom_table *tbl, value v,
|
||||||
elt->max = max;
|
elt->max = max;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
#endif /* CAML_MINOR_GC_H */
|
#endif /* CAML_MINOR_GC_H */
|
||||||
|
|
|
@ -259,6 +259,7 @@ extern double caml_log1p(double);
|
||||||
#define unlink_os _wunlink
|
#define unlink_os _wunlink
|
||||||
#define rename_os caml_win32_rename
|
#define rename_os caml_win32_rename
|
||||||
#define chdir_os _wchdir
|
#define chdir_os _wchdir
|
||||||
|
#define mkdir_os(path, perm) _wmkdir(path)
|
||||||
#define getcwd_os _wgetcwd
|
#define getcwd_os _wgetcwd
|
||||||
#define system_os _wsystem
|
#define system_os _wsystem
|
||||||
#define rmdir_os _wrmdir
|
#define rmdir_os _wrmdir
|
||||||
|
@ -294,6 +295,7 @@ extern double caml_log1p(double);
|
||||||
#define unlink_os unlink
|
#define unlink_os unlink
|
||||||
#define rename_os rename
|
#define rename_os rename
|
||||||
#define chdir_os chdir
|
#define chdir_os chdir
|
||||||
|
#define mkdir_os mkdir
|
||||||
#define getcwd_os getcwd
|
#define getcwd_os getcwd
|
||||||
#define system_os system
|
#define system_os system
|
||||||
#define rmdir_os rmdir
|
#define rmdir_os rmdir
|
||||||
|
|
|
@ -30,12 +30,16 @@ extern unsigned short caml_win32_revision;
|
||||||
#include "misc.h"
|
#include "misc.h"
|
||||||
#include "memory.h"
|
#include "memory.h"
|
||||||
|
|
||||||
|
#define Io_interrupted (-1)
|
||||||
|
|
||||||
/* Read at most [n] bytes from file descriptor [fd] into buffer [buf].
|
/* Read at most [n] bytes from file descriptor [fd] into buffer [buf].
|
||||||
[flags] indicates whether [fd] is a socket
|
[flags] indicates whether [fd] is a socket
|
||||||
(bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
|
(bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
|
||||||
(This distinction matters for Win32, but not for Unix.)
|
(This distinction matters for Win32, but not for Unix.)
|
||||||
Return number of bytes read.
|
Return number of bytes read.
|
||||||
In case of error, raises [Sys_error] or [Sys_blocked_io]. */
|
In case of error, raises [Sys_error] or [Sys_blocked_io].
|
||||||
|
If interrupted by a signal and no bytes where read, returns
|
||||||
|
Io_interrupted without raising. */
|
||||||
extern int caml_read_fd(int fd, int flags, void * buf, int n);
|
extern int caml_read_fd(int fd, int flags, void * buf, int n);
|
||||||
|
|
||||||
/* Write at most [n] bytes from buffer [buf] onto file descriptor [fd].
|
/* Write at most [n] bytes from buffer [buf] onto file descriptor [fd].
|
||||||
|
@ -43,7 +47,9 @@ extern int caml_read_fd(int fd, int flags, void * buf, int n);
|
||||||
(bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
|
(bit [CHANNEL_FLAG_FROM_SOCKET] is set in this case, see [io.h]).
|
||||||
(This distinction matters for Win32, but not for Unix.)
|
(This distinction matters for Win32, but not for Unix.)
|
||||||
Return number of bytes written.
|
Return number of bytes written.
|
||||||
In case of error, raises [Sys_error] or [Sys_blocked_io]. */
|
In case of error, raises [Sys_error] or [Sys_blocked_io].
|
||||||
|
If interrupted by a signal and no bytes were written, returns
|
||||||
|
Io_interrupted without raising. */
|
||||||
extern int caml_write_fd(int fd, int flags, void * buf, int n);
|
extern int caml_write_fd(int fd, int flags, void * buf, int n);
|
||||||
|
|
||||||
/* Decompose the given path into a list of directories, and add them
|
/* Decompose the given path into a list of directories, and add them
|
||||||
|
@ -153,6 +159,8 @@ extern value caml_copy_string_of_utf16(const wchar_t *s);
|
||||||
|
|
||||||
extern int caml_win32_isatty(int fd);
|
extern int caml_win32_isatty(int fd);
|
||||||
|
|
||||||
|
CAMLextern void caml_expand_command_line (int *, wchar_t ***);
|
||||||
|
|
||||||
#endif /* _WIN32 */
|
#endif /* _WIN32 */
|
||||||
|
|
||||||
#endif /* CAML_INTERNALS */
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
|
@ -26,7 +26,9 @@ extern "C" {
|
||||||
|
|
||||||
|
|
||||||
CAMLextern char * caml_format_exception (value);
|
CAMLextern char * caml_format_exception (value);
|
||||||
|
#ifdef CAML_INTERNALS
|
||||||
CAMLnoreturn_start void caml_fatal_uncaught_exception (value) CAMLnoreturn_end;
|
CAMLnoreturn_start void caml_fatal_uncaught_exception (value) CAMLnoreturn_end;
|
||||||
|
#endif /* CAML_INTERNALS */
|
||||||
|
|
||||||
#ifdef __cplusplus
|
#ifdef __cplusplus
|
||||||
}
|
}
|
||||||
|
|
|
@ -29,12 +29,15 @@ intnat caml_darken_all_roots_slice (intnat);
|
||||||
void caml_do_roots (scanning_action, int);
|
void caml_do_roots (scanning_action, int);
|
||||||
extern uintnat caml_incremental_roots_count;
|
extern uintnat caml_incremental_roots_count;
|
||||||
#ifndef NATIVE_CODE
|
#ifndef NATIVE_CODE
|
||||||
CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
|
CAMLextern void caml_do_local_roots_byt (scanning_action, value *, value *,
|
||||||
struct caml__roots_block *);
|
struct caml__roots_block *);
|
||||||
|
#define caml_do_local_roots caml_do_local_roots_byt
|
||||||
#else
|
#else
|
||||||
CAMLextern void caml_do_local_roots(scanning_action f, char * c_bottom_of_stack,
|
CAMLextern void caml_do_local_roots_nat (
|
||||||
uintnat last_retaddr, value * v_gc_regs,
|
scanning_action f, char * c_bottom_of_stack,
|
||||||
struct caml__roots_block * gc_local_roots);
|
uintnat last_retaddr, value * v_gc_regs,
|
||||||
|
struct caml__roots_block * gc_local_roots);
|
||||||
|
#define caml_do_local_roots caml_do_local_roots_nat
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
CAMLextern void (*caml_scan_roots_hook) (scanning_action);
|
CAMLextern void (*caml_scan_roots_hook) (scanning_action);
|
||||||
|
|
|
@ -106,6 +106,10 @@
|
||||||
|
|
||||||
/* Define HAS_GETCWD if the library provides the getcwd() function. */
|
/* Define HAS_GETCWD if the library provides the getcwd() function. */
|
||||||
|
|
||||||
|
#undef HAS_SYSTEM
|
||||||
|
|
||||||
|
/* Define HAS_SYSTEM if the library provides the system() function. */
|
||||||
|
|
||||||
#undef HAS_UTIME
|
#undef HAS_UTIME
|
||||||
#undef HAS_UTIMES
|
#undef HAS_UTIMES
|
||||||
|
|
||||||
|
|
|
@ -31,6 +31,7 @@ extern "C" {
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
CAMLextern void caml_enter_blocking_section (void);
|
CAMLextern void caml_enter_blocking_section (void);
|
||||||
|
CAMLextern void caml_enter_blocking_section_no_pending (void);
|
||||||
CAMLextern void caml_leave_blocking_section (void);
|
CAMLextern void caml_leave_blocking_section (void);
|
||||||
|
|
||||||
CAMLextern void caml_process_pending_actions (void);
|
CAMLextern void caml_process_pending_actions (void);
|
||||||
|
@ -39,6 +40,9 @@ CAMLextern void caml_process_pending_actions (void);
|
||||||
Memprof callbacks. Assumes that the runtime lock is held. Can raise
|
Memprof callbacks. Assumes that the runtime lock is held. Can raise
|
||||||
exceptions asynchronously into OCaml code. */
|
exceptions asynchronously into OCaml code. */
|
||||||
|
|
||||||
|
CAMLextern int caml_check_pending_actions (void);
|
||||||
|
/* Returns 1 if there are pending actions, 0 otherwise. */
|
||||||
|
|
||||||
CAMLextern value caml_process_pending_actions_exn (void);
|
CAMLextern value caml_process_pending_actions_exn (void);
|
||||||
/* Same as [caml_process_pending_actions], but returns the exception
|
/* Same as [caml_process_pending_actions], but returns the exception
|
||||||
if any (otherwise returns [Val_unit]). */
|
if any (otherwise returns [Val_unit]). */
|
||||||
|
@ -86,7 +90,6 @@ void caml_setup_stack_overflow_detection(void);
|
||||||
|
|
||||||
CAMLextern void (*caml_enter_blocking_section_hook)(void);
|
CAMLextern void (*caml_enter_blocking_section_hook)(void);
|
||||||
CAMLextern void (*caml_leave_blocking_section_hook)(void);
|
CAMLextern void (*caml_leave_blocking_section_hook)(void);
|
||||||
CAMLextern int (*caml_try_leave_blocking_section_hook)(void);
|
|
||||||
#ifdef POSIX_SIGNALS
|
#ifdef POSIX_SIGNALS
|
||||||
CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
|
CAMLextern int (*caml_sigmask_hook)(int, const sigset_t *, sigset_t *);
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -21,8 +21,6 @@
|
||||||
#include "mlvalues.h"
|
#include "mlvalues.h"
|
||||||
#include "exec.h"
|
#include "exec.h"
|
||||||
|
|
||||||
CAMLextern void caml_main(char_os **argv);
|
|
||||||
|
|
||||||
CAMLextern void caml_startup_code(
|
CAMLextern void caml_startup_code(
|
||||||
code_t code, asize_t code_size,
|
code_t code, asize_t code_size,
|
||||||
char *data, asize_t data_size,
|
char *data, asize_t data_size,
|
||||||
|
|
|
@ -41,7 +41,6 @@ CAMLnoreturn_start
|
||||||
CAMLextern value caml_sys_exit (value)
|
CAMLextern value caml_sys_exit (value)
|
||||||
CAMLnoreturn_end;
|
CAMLnoreturn_end;
|
||||||
|
|
||||||
extern double caml_sys_time_unboxed(value);
|
|
||||||
CAMLextern value caml_sys_get_argv(value unit);
|
CAMLextern value caml_sys_get_argv(value unit);
|
||||||
|
|
||||||
extern char_os * caml_exe_name;
|
extern char_os * caml_exe_name;
|
||||||
|
|
|
@ -191,6 +191,7 @@ Caml_inline void caml_ephe_clean_partial (value v,
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child);
|
||||||
if (Is_white_val (child) && !Is_young (child)){
|
if (Is_white_val (child) && !Is_young (child)){
|
||||||
release_data = 1;
|
release_data = 1;
|
||||||
Field (v, i) = caml_ephe_none;
|
Field (v, i) = caml_ephe_none;
|
||||||
|
@ -200,15 +201,16 @@ Caml_inline void caml_ephe_clean_partial (value v,
|
||||||
|
|
||||||
child = Field (v, 1);
|
child = Field (v, 1);
|
||||||
if(child != caml_ephe_none){
|
if(child != caml_ephe_none){
|
||||||
if (release_data){
|
if (release_data) Field (v, 1) = caml_ephe_none;
|
||||||
Field (v, 1) = caml_ephe_none;
|
#ifdef DEBUG
|
||||||
} else {
|
else if (offset_start == 2 && offset_end == Wosize_hd (Hd_val(v)) &&
|
||||||
/* If we scanned all the keys and the data field remains filled,
|
Is_block (child) && Is_in_heap (child)) {
|
||||||
then the mark phase must have marked it */
|
if (Tag_val (child) == Infix_tag) child -= Infix_offset_val (child);
|
||||||
CAMLassert( !(offset_start == 2 && offset_end == Wosize_hd (Hd_val(v))
|
/* If we scanned all the keys and the data field remains filled,
|
||||||
&& Is_block (child) && Is_in_heap (child)
|
then the mark phase must have marked it */
|
||||||
&& Is_white_val (child)));
|
CAMLassert( !Is_white_val (child) );
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -155,11 +155,6 @@ struct custom_operations * caml_final_custom_operations(final_fun fn)
|
||||||
return ops;
|
return ops;
|
||||||
}
|
}
|
||||||
|
|
||||||
extern struct custom_operations caml_int32_ops,
|
|
||||||
caml_nativeint_ops,
|
|
||||||
caml_int64_ops,
|
|
||||||
caml_ba_ops;
|
|
||||||
|
|
||||||
void caml_init_custom_operations(void)
|
void caml_init_custom_operations(void)
|
||||||
{
|
{
|
||||||
caml_register_custom_operations(&caml_int32_ops);
|
caml_register_custom_operations(&caml_int32_ops);
|
||||||
|
|
|
@ -141,6 +141,12 @@ static void open_connection(void)
|
||||||
#endif
|
#endif
|
||||||
dbg_in = caml_open_descriptor_in(dbg_socket);
|
dbg_in = caml_open_descriptor_in(dbg_socket);
|
||||||
dbg_out = caml_open_descriptor_out(dbg_socket);
|
dbg_out = caml_open_descriptor_out(dbg_socket);
|
||||||
|
/* The code in this file does not bracket channel I/O operations with
|
||||||
|
Lock and Unlock, so fail if those are not no-ops. */
|
||||||
|
if (caml_channel_mutex_lock != NULL ||
|
||||||
|
caml_channel_mutex_unlock != NULL ||
|
||||||
|
caml_channel_mutex_unlock_exn != NULL)
|
||||||
|
caml_fatal_error("debugger does not support channel locks");
|
||||||
if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
|
if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
caml_putword(dbg_out, _getpid());
|
caml_putword(dbg_out, _getpid());
|
||||||
|
|
|
@ -34,6 +34,8 @@
|
||||||
CAMLexport void caml_raise(value v)
|
CAMLexport void caml_raise(value v)
|
||||||
{
|
{
|
||||||
Unlock_exn();
|
Unlock_exn();
|
||||||
|
CAMLassert(!Is_exception_result(v));
|
||||||
|
v = caml_process_pending_actions_with_root(v);
|
||||||
Caml_state->exn_bucket = v;
|
Caml_state->exn_bucket = v;
|
||||||
if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v);
|
if (Caml_state->external_raise == NULL) caml_fatal_uncaught_exception(v);
|
||||||
siglongjmp(Caml_state->external_raise->buf, 1);
|
siglongjmp(Caml_state->external_raise->buf, 1);
|
||||||
|
|
|
@ -62,6 +62,10 @@ CAMLno_asan
|
||||||
void caml_raise(value v)
|
void caml_raise(value v)
|
||||||
{
|
{
|
||||||
Unlock_exn();
|
Unlock_exn();
|
||||||
|
|
||||||
|
CAMLassert(!Is_exception_result(v));
|
||||||
|
v = caml_process_pending_actions_with_root(v);
|
||||||
|
|
||||||
if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
|
if (Caml_state->exception_pointer == NULL) caml_fatal_uncaught_exception(v);
|
||||||
|
|
||||||
while (Caml_state->local_roots != NULL &&
|
while (Caml_state->local_roots != NULL &&
|
||||||
|
|
133
runtime/io.c
133
runtime/io.c
|
@ -69,13 +69,35 @@ CAMLexport struct channel * caml_all_opened_channels = NULL;
|
||||||
|
|
||||||
/* Functions shared between input and output */
|
/* Functions shared between input and output */
|
||||||
|
|
||||||
|
static void check_pending(struct channel *channel)
|
||||||
|
{
|
||||||
|
if (caml_check_pending_actions()) {
|
||||||
|
/* Temporarily unlock the channel, to ensure locks are not held
|
||||||
|
while any signal handlers (or finalisers, etc) are running */
|
||||||
|
Unlock(channel);
|
||||||
|
caml_process_pending_actions();
|
||||||
|
Lock(channel);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
Caml_inline int descriptor_is_in_binary_mode(int fd)
|
||||||
|
{
|
||||||
|
#if defined(_WIN32) || defined(__CYGWIN__)
|
||||||
|
int oldmode = setmode(fd, O_TEXT);
|
||||||
|
if (oldmode != -1 && oldmode != O_TEXT) setmode(fd, oldmode);
|
||||||
|
return oldmode == O_BINARY;
|
||||||
|
#else
|
||||||
|
return 1;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
CAMLexport struct channel * caml_open_descriptor_in(int fd)
|
CAMLexport struct channel * caml_open_descriptor_in(int fd)
|
||||||
{
|
{
|
||||||
struct channel * channel;
|
struct channel * channel;
|
||||||
|
|
||||||
channel = (struct channel *) caml_stat_alloc(sizeof(struct channel));
|
channel = (struct channel *) caml_stat_alloc(sizeof(struct channel));
|
||||||
channel->fd = fd;
|
channel->fd = fd;
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section_no_pending();
|
||||||
channel->offset = lseek(fd, 0, SEEK_CUR);
|
channel->offset = lseek(fd, 0, SEEK_CUR);
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
channel->curr = channel->max = channel->buff;
|
channel->curr = channel->max = channel->buff;
|
||||||
|
@ -84,7 +106,7 @@ CAMLexport struct channel * caml_open_descriptor_in(int fd)
|
||||||
channel->revealed = 0;
|
channel->revealed = 0;
|
||||||
channel->old_revealed = 0;
|
channel->old_revealed = 0;
|
||||||
channel->refcount = 0;
|
channel->refcount = 0;
|
||||||
channel->flags = 0;
|
channel->flags = descriptor_is_in_binary_mode(fd) ? 0 : CHANNEL_TEXT_MODE;
|
||||||
channel->next = caml_all_opened_channels;
|
channel->next = caml_all_opened_channels;
|
||||||
channel->prev = NULL;
|
channel->prev = NULL;
|
||||||
channel->name = NULL;
|
channel->name = NULL;
|
||||||
|
@ -128,33 +150,32 @@ CAMLexport void caml_close_channel(struct channel *channel)
|
||||||
|
|
||||||
CAMLexport file_offset caml_channel_size(struct channel *channel)
|
CAMLexport file_offset caml_channel_size(struct channel *channel)
|
||||||
{
|
{
|
||||||
file_offset offset;
|
file_offset here, end;
|
||||||
file_offset end;
|
|
||||||
int fd;
|
int fd;
|
||||||
|
|
||||||
|
check_pending(channel);
|
||||||
/* We extract data from [channel] before dropping the OCaml lock, in case
|
/* We extract data from [channel] before dropping the OCaml lock, in case
|
||||||
someone else touches the block. */
|
someone else touches the block. */
|
||||||
fd = channel->fd;
|
fd = channel->fd;
|
||||||
offset = channel->offset;
|
here = channel->flags & CHANNEL_TEXT_MODE ? -1 : channel->offset;
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section_no_pending();
|
||||||
end = lseek(fd, 0, SEEK_END);
|
if (here == -1) {
|
||||||
if (end == -1 || lseek(fd, offset, SEEK_SET) != offset) {
|
here = lseek(fd, 0, SEEK_CUR);
|
||||||
caml_leave_blocking_section();
|
if (here == -1) goto error;
|
||||||
caml_sys_error(NO_ARG);
|
|
||||||
}
|
}
|
||||||
|
end = lseek(fd, 0, SEEK_END);
|
||||||
|
if (end == -1) goto error;
|
||||||
|
if (lseek(fd, here, SEEK_SET) != here) goto error;
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
return end;
|
return end;
|
||||||
|
error:
|
||||||
|
caml_leave_blocking_section();
|
||||||
|
caml_sys_error(NO_ARG);
|
||||||
}
|
}
|
||||||
|
|
||||||
CAMLexport int caml_channel_binary_mode(struct channel *channel)
|
CAMLexport int caml_channel_binary_mode(struct channel *channel)
|
||||||
{
|
{
|
||||||
#if defined(_WIN32) || defined(__CYGWIN__)
|
return channel->flags & CHANNEL_TEXT_MODE ? 0 : 1;
|
||||||
int oldmode = setmode(channel->fd, O_BINARY);
|
|
||||||
if (oldmode == O_TEXT) setmode(channel->fd, O_TEXT);
|
|
||||||
return oldmode == O_BINARY;
|
|
||||||
#else
|
|
||||||
return 1;
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Output */
|
/* Output */
|
||||||
|
@ -167,12 +188,15 @@ CAMLexport int caml_channel_binary_mode(struct channel *channel)
|
||||||
CAMLexport int caml_flush_partial(struct channel *channel)
|
CAMLexport int caml_flush_partial(struct channel *channel)
|
||||||
{
|
{
|
||||||
int towrite, written;
|
int towrite, written;
|
||||||
|
again:
|
||||||
|
check_pending(channel);
|
||||||
|
|
||||||
towrite = channel->curr - channel->buff;
|
towrite = channel->curr - channel->buff;
|
||||||
CAMLassert (towrite >= 0);
|
CAMLassert (towrite >= 0);
|
||||||
if (towrite > 0) {
|
if (towrite > 0) {
|
||||||
written = caml_write_fd(channel->fd, channel->flags,
|
written = caml_write_fd(channel->fd, channel->flags,
|
||||||
channel->buff, towrite);
|
channel->buff, towrite);
|
||||||
|
if (written == Io_interrupted) goto again;
|
||||||
channel->offset += written;
|
channel->offset += written;
|
||||||
if (written < towrite)
|
if (written < towrite)
|
||||||
memmove(channel->buff, channel->buff + written, towrite - written);
|
memmove(channel->buff, channel->buff + written, towrite - written);
|
||||||
|
@ -202,7 +226,7 @@ CAMLexport void caml_putword(struct channel *channel, uint32_t w)
|
||||||
|
|
||||||
CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
|
CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
|
||||||
{
|
{
|
||||||
int n, free, towrite, written;
|
int n, free;
|
||||||
|
|
||||||
n = len >= INT_MAX ? INT_MAX : (int) len;
|
n = len >= INT_MAX ? INT_MAX : (int) len;
|
||||||
free = channel->end - channel->curr;
|
free = channel->end - channel->curr;
|
||||||
|
@ -215,13 +239,8 @@ CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
|
||||||
/* Write request overflows buffer (or just fills it up): transfer whatever
|
/* Write request overflows buffer (or just fills it up): transfer whatever
|
||||||
fits to buffer and write the buffer */
|
fits to buffer and write the buffer */
|
||||||
memmove(channel->curr, p, free);
|
memmove(channel->curr, p, free);
|
||||||
towrite = channel->end - channel->buff;
|
channel->curr = channel->end;
|
||||||
written = caml_write_fd(channel->fd, channel->flags,
|
caml_flush_partial(channel);
|
||||||
channel->buff, towrite);
|
|
||||||
if (written < towrite)
|
|
||||||
memmove(channel->buff, channel->buff + written, towrite - written);
|
|
||||||
channel->offset += written;
|
|
||||||
channel->curr = channel->end - written;
|
|
||||||
return free;
|
return free;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -240,7 +259,7 @@ CAMLexport void caml_really_putblock(struct channel *channel,
|
||||||
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
|
CAMLexport void caml_seek_out(struct channel *channel, file_offset dest)
|
||||||
{
|
{
|
||||||
caml_flush(channel);
|
caml_flush(channel);
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section_no_pending();
|
||||||
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
|
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
caml_sys_error(NO_ARG);
|
caml_sys_error(NO_ARG);
|
||||||
|
@ -256,19 +275,24 @@ CAMLexport file_offset caml_pos_out(struct channel *channel)
|
||||||
|
|
||||||
/* Input */
|
/* Input */
|
||||||
|
|
||||||
/* caml_do_read is exported for Cash */
|
int caml_do_read(int fd, char *p, unsigned int n)
|
||||||
CAMLexport int caml_do_read(int fd, char *p, unsigned int n)
|
|
||||||
{
|
{
|
||||||
return caml_read_fd(fd, 0, p, n);
|
int r;
|
||||||
|
do {
|
||||||
|
r = caml_read_fd(fd, 0, p, n);
|
||||||
|
} while (r == Io_interrupted);
|
||||||
|
return r;
|
||||||
}
|
}
|
||||||
|
|
||||||
CAMLexport unsigned char caml_refill(struct channel *channel)
|
CAMLexport unsigned char caml_refill(struct channel *channel)
|
||||||
{
|
{
|
||||||
int n;
|
int n;
|
||||||
|
again:
|
||||||
|
check_pending(channel);
|
||||||
n = caml_read_fd(channel->fd, channel->flags,
|
n = caml_read_fd(channel->fd, channel->flags,
|
||||||
channel->buff, channel->end - channel->buff);
|
channel->buff, channel->end - channel->buff);
|
||||||
if (n == 0) caml_raise_end_of_file();
|
if (n == Io_interrupted) goto again;
|
||||||
|
else if (n == 0) caml_raise_end_of_file();
|
||||||
channel->offset += n;
|
channel->offset += n;
|
||||||
channel->max = channel->buff + n;
|
channel->max = channel->buff + n;
|
||||||
channel->curr = channel->buff + 1;
|
channel->curr = channel->buff + 1;
|
||||||
|
@ -292,7 +316,8 @@ CAMLexport uint32_t caml_getword(struct channel *channel)
|
||||||
CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
|
CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
|
||||||
{
|
{
|
||||||
int n, avail, nread;
|
int n, avail, nread;
|
||||||
|
again:
|
||||||
|
check_pending(channel);
|
||||||
n = len >= INT_MAX ? INT_MAX : (int) len;
|
n = len >= INT_MAX ? INT_MAX : (int) len;
|
||||||
avail = channel->max - channel->curr;
|
avail = channel->max - channel->curr;
|
||||||
if (n <= avail) {
|
if (n <= avail) {
|
||||||
|
@ -306,6 +331,7 @@ CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
|
||||||
} else {
|
} else {
|
||||||
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
|
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
|
||||||
channel->end - channel->buff);
|
channel->end - channel->buff);
|
||||||
|
if (nread == Io_interrupted) goto again;
|
||||||
channel->offset += nread;
|
channel->offset += nread;
|
||||||
channel->max = channel->buff + nread;
|
channel->max = channel->buff + nread;
|
||||||
if (n > nread) n = nread;
|
if (n > nread) n = nread;
|
||||||
|
@ -331,11 +357,12 @@ CAMLexport intnat caml_really_getblock(struct channel *chan, char *p, intnat n)
|
||||||
|
|
||||||
CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
|
CAMLexport void caml_seek_in(struct channel *channel, file_offset dest)
|
||||||
{
|
{
|
||||||
if (dest >= channel->offset - (channel->max - channel->buff) &&
|
if (dest >= channel->offset - (channel->max - channel->buff)
|
||||||
dest <= channel->offset) {
|
&& dest <= channel->offset
|
||||||
|
&& (channel->flags & CHANNEL_TEXT_MODE) == 0) {
|
||||||
channel->curr = channel->max - (channel->offset - dest);
|
channel->curr = channel->max - (channel->offset - dest);
|
||||||
} else {
|
} else {
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section_no_pending();
|
||||||
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
|
if (lseek(channel->fd, dest, SEEK_SET) != dest) {
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
caml_sys_error(NO_ARG);
|
caml_sys_error(NO_ARG);
|
||||||
|
@ -351,11 +378,12 @@ CAMLexport file_offset caml_pos_in(struct channel *channel)
|
||||||
return channel->offset - (file_offset)(channel->max - channel->curr);
|
return channel->offset - (file_offset)(channel->max - channel->curr);
|
||||||
}
|
}
|
||||||
|
|
||||||
CAMLexport intnat caml_input_scan_line(struct channel *channel)
|
intnat caml_input_scan_line(struct channel *channel)
|
||||||
{
|
{
|
||||||
char * p;
|
char * p;
|
||||||
int n;
|
int n;
|
||||||
|
again:
|
||||||
|
check_pending(channel);
|
||||||
p = channel->curr;
|
p = channel->curr;
|
||||||
do {
|
do {
|
||||||
if (p >= channel->max) {
|
if (p >= channel->max) {
|
||||||
|
@ -378,7 +406,8 @@ CAMLexport intnat caml_input_scan_line(struct channel *channel)
|
||||||
/* Fill the buffer as much as possible */
|
/* Fill the buffer as much as possible */
|
||||||
n = caml_read_fd(channel->fd, channel->flags,
|
n = caml_read_fd(channel->fd, channel->flags,
|
||||||
channel->max, channel->end - channel->max);
|
channel->max, channel->end - channel->max);
|
||||||
if (n == 0) {
|
if (n == Io_interrupted) goto again;
|
||||||
|
else if (n == 0) {
|
||||||
/* End-of-file encountered. Return the number of characters in the
|
/* End-of-file encountered. Return the number of characters in the
|
||||||
buffer, with negative sign since we haven't encountered
|
buffer, with negative sign since we haven't encountered
|
||||||
a newline. */
|
a newline. */
|
||||||
|
@ -396,8 +425,7 @@ CAMLexport intnat caml_input_scan_line(struct channel *channel)
|
||||||
objects into a heap-allocated object. Perform locking
|
objects into a heap-allocated object. Perform locking
|
||||||
and unlocking around the I/O operations. */
|
and unlocking around the I/O operations. */
|
||||||
|
|
||||||
/* FIXME CAMLexport, but not in io.h exported for Cash ? */
|
void caml_finalize_channel(value vchan)
|
||||||
CAMLexport void caml_finalize_channel(value vchan)
|
|
||||||
{
|
{
|
||||||
struct channel * chan = Channel(vchan);
|
struct channel * chan = Channel(vchan);
|
||||||
if ((chan->flags & CHANNEL_FLAG_MANAGED_BY_GC) == 0) return;
|
if ((chan->flags & CHANNEL_FLAG_MANAGED_BY_GC) == 0) return;
|
||||||
|
@ -545,7 +573,7 @@ CAMLprim value caml_ml_close_channel(value vchannel)
|
||||||
channel->curr = channel->max = channel->end;
|
channel->curr = channel->max = channel->end;
|
||||||
|
|
||||||
if (do_syscall) {
|
if (do_syscall) {
|
||||||
caml_enter_blocking_section();
|
caml_enter_blocking_section_no_pending();
|
||||||
result = close(fd);
|
result = close(fd);
|
||||||
caml_leave_blocking_section();
|
caml_leave_blocking_section();
|
||||||
}
|
}
|
||||||
|
@ -563,16 +591,28 @@ CAMLprim value caml_ml_close_channel(value vchannel)
|
||||||
#define EOVERFLOW ERANGE
|
#define EOVERFLOW ERANGE
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
static file_offset ml_channel_size(value vchannel)
|
||||||
|
{
|
||||||
|
CAMLparam1 (vchannel);
|
||||||
|
struct channel * channel = Channel(vchannel);
|
||||||
|
file_offset size;
|
||||||
|
|
||||||
|
Lock(channel);
|
||||||
|
size = caml_channel_size(Channel(vchannel));
|
||||||
|
Unlock(channel);
|
||||||
|
CAMLreturnT(file_offset, size);
|
||||||
|
}
|
||||||
|
|
||||||
CAMLprim value caml_ml_channel_size(value vchannel)
|
CAMLprim value caml_ml_channel_size(value vchannel)
|
||||||
{
|
{
|
||||||
file_offset size = caml_channel_size(Channel(vchannel));
|
file_offset size = ml_channel_size(vchannel);
|
||||||
if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
|
if (size > Max_long) { errno = EOVERFLOW; caml_sys_error(NO_ARG); }
|
||||||
return Val_long(size);
|
return Val_long(size);
|
||||||
}
|
}
|
||||||
|
|
||||||
CAMLprim value caml_ml_channel_size_64(value vchannel)
|
CAMLprim value caml_ml_channel_size_64(value vchannel)
|
||||||
{
|
{
|
||||||
return Val_file_offset(caml_channel_size(Channel(vchannel)));
|
return Val_file_offset(ml_channel_size(vchannel));
|
||||||
}
|
}
|
||||||
|
|
||||||
CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
|
CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
|
||||||
|
@ -590,6 +630,10 @@ CAMLprim value caml_ml_set_binary_mode(value vchannel, value mode)
|
||||||
#endif
|
#endif
|
||||||
if (setmode(channel->fd, Bool_val(mode) ? O_BINARY : O_TEXT) == -1)
|
if (setmode(channel->fd, Bool_val(mode) ? O_BINARY : O_TEXT) == -1)
|
||||||
caml_sys_error(NO_ARG);
|
caml_sys_error(NO_ARG);
|
||||||
|
if (Bool_val(mode))
|
||||||
|
channel->flags &= ~CHANNEL_TEXT_MODE;
|
||||||
|
else
|
||||||
|
channel->flags |= CHANNEL_TEXT_MODE;
|
||||||
#endif
|
#endif
|
||||||
return Val_unit;
|
return Val_unit;
|
||||||
}
|
}
|
||||||
|
@ -731,6 +775,8 @@ CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
|
||||||
int n, avail, nread;
|
int n, avail, nread;
|
||||||
|
|
||||||
Lock(channel);
|
Lock(channel);
|
||||||
|
again:
|
||||||
|
check_pending(channel);
|
||||||
/* We cannot call caml_getblock here because buff may move during
|
/* We cannot call caml_getblock here because buff may move during
|
||||||
caml_read_fd */
|
caml_read_fd */
|
||||||
start = Long_val(vstart);
|
start = Long_val(vstart);
|
||||||
|
@ -747,6 +793,7 @@ CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
|
||||||
} else {
|
} else {
|
||||||
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
|
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
|
||||||
channel->end - channel->buff);
|
channel->end - channel->buff);
|
||||||
|
if (nread == Io_interrupted) goto again;
|
||||||
channel->offset += nread;
|
channel->offset += nread;
|
||||||
channel->max = channel->buff + nread;
|
channel->max = channel->buff + nread;
|
||||||
if (n > nread) n = nread;
|
if (n > nread) n = nread;
|
||||||
|
|
|
@ -22,15 +22,12 @@
|
||||||
#include "caml/mlvalues.h"
|
#include "caml/mlvalues.h"
|
||||||
#include "caml/sys.h"
|
#include "caml/sys.h"
|
||||||
#include "caml/osdeps.h"
|
#include "caml/osdeps.h"
|
||||||
|
#include "caml/callback.h"
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
CAMLextern void caml_main (char_os **);
|
|
||||||
|
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
CAMLextern void caml_expand_command_line (int *, wchar_t ***);
|
|
||||||
|
|
||||||
int wmain(int argc, wchar_t **argv)
|
int wmain(int argc, wchar_t **argv)
|
||||||
#else
|
#else
|
||||||
int main(int argc, char **argv)
|
int main(int argc, char **argv)
|
||||||
|
|
|
@ -57,7 +57,7 @@ uintnat caml_dependent_size, caml_dependent_allocated;
|
||||||
double caml_extra_heap_resources;
|
double caml_extra_heap_resources;
|
||||||
uintnat caml_fl_wsz_at_phase_change = 0;
|
uintnat caml_fl_wsz_at_phase_change = 0;
|
||||||
|
|
||||||
extern char *caml_fl_merge; /* Defined in freelist.c. */
|
extern value caml_fl_merge; /* Defined in freelist.c. */
|
||||||
|
|
||||||
static char *markhp, *chunk, *limit;
|
static char *markhp, *chunk, *limit;
|
||||||
static double p_backlog = 0.0; /* backlog for the gc speedup parameter */
|
static double p_backlog = 0.0; /* backlog for the gc speedup parameter */
|
||||||
|
@ -586,7 +586,7 @@ static void sweep_slice (intnat work)
|
||||||
break;
|
break;
|
||||||
case Caml_blue:
|
case Caml_blue:
|
||||||
/* Only the blocks of the free-list are blue. See [freelist.c]. */
|
/* Only the blocks of the free-list are blue. See [freelist.c]. */
|
||||||
caml_fl_merge = Bp_hp (hp);
|
caml_fl_merge = (value) Bp_hp (hp);
|
||||||
break;
|
break;
|
||||||
default: /* gray or black */
|
default: /* gray or black */
|
||||||
CAMLassert (Color_hd (hd) == Caml_black);
|
CAMLassert (Color_hd (hd) == Caml_black);
|
||||||
|
|
|
@ -455,7 +455,7 @@ void caml_shrink_heap (char *chunk)
|
||||||
caml_free_for_heap (chunk);
|
caml_free_for_heap (chunk);
|
||||||
}
|
}
|
||||||
|
|
||||||
color_t caml_allocation_color (void *hp)
|
CAMLexport color_t caml_allocation_color (void *hp)
|
||||||
{
|
{
|
||||||
if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
|
if (caml_gc_phase == Phase_mark || caml_gc_phase == Phase_clean ||
|
||||||
(caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
|
(caml_gc_phase == Phase_sweep && (char *)hp >= (char *)caml_gc_sweep_hp)){
|
||||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue