clean up whitespace and cut long lines

master
Damien Doligez 2016-02-16 13:23:31 +01:00
parent 2a3e2176eb
commit ee8f71101b
284 changed files with 12307 additions and 12081 deletions

36
.gitattributes vendored
View File

@ -9,16 +9,22 @@ boot/ocamldep binary
*.png binary
*.tfm binary
.gitattributes ocaml-typo=missing-header
.gitignore ocaml-typo=missing-header
.merlin ocaml-typo=missing-header
.ocp-indent ocaml-typo=missing-header
Changes ocaml-typo=non-ascii,missing-header
CONTRIBUTING.md ocaml-typo=missing-header
INSTALL ocaml-typo=missing-header
LICENSE ocaml-typo=non-printing,missing-header
# No header for text files (would be too obtrusive).
*.md ocaml-typo=missing-header
README* ocaml-typo=missing-header
*.adoc ocaml-typo=missing-header,long-line,unused-prop
/.gitattributes ocaml-typo=missing-header
/.gitignore ocaml-typo=missing-header
/.merlin ocaml-typo=missing-header
/Changes ocaml-typo=non-ascii,missing-header
/INSTALL ocaml-typo=missing-header
/LICENSE ocaml-typo=non-printing,missing-header
/appveyor.yml ocaml-typo=long-line,very-long-line
asmcomp/*/emit.mlp ocaml-typo=tab,long-line,unused-prop
asmcomp/power/NOTES.md ocaml-typo=missing-header,long-line
asmrun/i386.S ocaml-typo=long-line
@ -27,10 +33,11 @@ config/gnu ocaml-typo=prune
emacs/*.el ocaml-typo=long-line,unused-prop
emacs/COPYING ocaml-typo=tab,non-printing,missing-header
emacs/ocamltags.in ocaml-typo=non-printing
emacs/README* ocaml-typo=missing-header
experimental ocaml-typo=prune
manual ocaml-typo=prune
ocamlbuild/* ocaml-typo=long-line
ocamlbuild/AUTHORS ocaml-typo=missing-header
ocamlbuild/ChangeLog ocaml-typo=tab,missing-header
@ -43,6 +50,17 @@ otherlibs/win32unix/readlink.c ocaml-typo=long-line
otherlibs/win32unix/stat.c ocaml-typo=long-line
otherlibs/win32unix/symlink.c ocaml-typo=long-line
stdlib/sharpbang ocaml-typo=white-at-eol,missing-lf
# FIXME remove headers in testsuite and remove unused-prop in next line:
testsuite/** ocaml-typo=missing-header,unused-prop
testsuite/tests/lib-bigarray-2/bigarrf.f ocaml-typo=missing-header,tab
testsuite/tests/misc-unsafe/almabench.ml ocaml-typo=missing-header,long-line
tools/magic ocaml-typo=missing-header
yacc/*.[ch] ocaml-typo=long-line,very-long-line,unused-prop
# Line-ending specifications, for Windows interoperability
*.sh text eol=lf
*.sh.in text eol=lf

2
.gitignore vendored
View File

@ -274,6 +274,8 @@
/testsuite/tests/unboxed-primitive-args/main.ml
/testsuite/tests/unboxed-primitive-args/stubs.c
/testsuite/tests/unwind/unwind_test
/testsuite/tests/warnings/w55.opt.opt_result
/testsuite/tests/warnings/w58.opt.opt_result

4
.gitmodules vendored
View File

@ -1,3 +1,3 @@
[submodule "flexdll"]
path = flexdll
url = https://github.com/alainfrisch/flexdll.git
path = flexdll
url = https://github.com/alainfrisch/flexdll.git

View File

@ -234,9 +234,9 @@ or:
make opt > log.opt 2>&1 # in sh
make opt >& log.opt # in csh
5. anchor:step-5[] Compile fast versions of the OCaml compilers, by compiling them
with the native-code compiler (you have only compiled them to bytecode
so far). Just do:
5. anchor:step-5[] Compile fast versions of the OCaml compilers, by
compiling them with the native-code compiler (you have only compiled
them to bytecode so far). Just do:
make opt.opt
+

View File

@ -367,7 +367,8 @@ partialclean::
rm -f compilerlibs/ocamlopttoplevel.cmxa
ocamlnat: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
otherlibs/dynlink/dynlink.cmxa compilerlibs/ocamlopttoplevel.cmxa $(OPTTOPLEVELSTART:.cmo=.cmx)
otherlibs/dynlink/dynlink.cmxa compilerlibs/ocamlopttoplevel.cmxa \
$(OPTTOPLEVELSTART:.cmo=.cmx)
$(CAMLOPT) $(LINKFLAGS) -linkall -o ocamlnat \
otherlibs/dynlink/dynlink.cmxa compilerlibs/ocamlcommon.cmxa \
compilerlibs/ocamloptcomp.cmxa compilerlibs/ocamlopttoplevel.cmxa \
@ -480,7 +481,8 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
partialclean::
rm -f ocamlopt.opt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) \
$(ASMCOMP:.cmo=.cmx): ocamlopt
# The numeric opcodes
@ -747,7 +749,8 @@ clean::
$(CAMLOPT) $(COMPFLAGS) -c $<
partialclean::
for d in utils parsing typing bytecomp asmcomp middle_end middle_end/base_types driver toplevel tools; \
for d in utils parsing typing bytecomp asmcomp middle_end \
middle_end/base_types driver toplevel tools; \
do rm -f $$d/*.cm[ioxt] $$d/*.cmti $$d/*.annot $$d/*.[so] $$d/*~; done
rm -f *~

View File

@ -16,48 +16,55 @@ include Makefile.shared
# For users who don't read the INSTALL file
defaultentry:
@echo "Please refer to the installation instructions in file README.win32.adoc."
@echo "Please refer to the instructions in file README.win32.adoc."
FLEXDLL_SUBMODULE_PRESENT:=$(wildcard flexdll/Makefile)
BOOT_FLEXLINK_CMD=$(if $(FLEXDLL_SUBMODULE_PRESENT),FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe")
CAMLOPT:=$(if $(FLEXDLL_SUBMODULE_PRESENT),OCAML_FLEXLINK="boot/ocamlrun flexdll/flexlink.exe") $(CAMLOPT)
ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
BOOT_FLEXLINK_CMD=
else
BOOT_FLEXLINK_CMD=FLEXLINK_CMD="../boot/ocamlrun ../flexdll/flexlink.exe"
CAMLOPT:=OCAML_FLEXLINK="boot/ocamlrun flexdll/flexlink.exe" $(CAMLOPT)
endif
# FlexDLL sources missing error messages
# Different git mechanism displayed depending on whether this source tree came
# from a git clone or a source tarball.
# Displayed in all cases
flexdll-common-err:
@echo In order to bootstrap FlexDLL, you need to place the sources in flexdll
flexdll/Makefile:
@echo In order to bootstrap FlexDLL, you need to place the sources in
@echo flexdll.
@echo This can either be done by downloading a source tarball from
@echo \ http://alain.frisch.fr/flexdll.html
flexdll/Makefile: $(if $(wildcard flexdll/Makefile),,$(if $(wildcard .git),flexdll-common-err,flexdll-repo))
@echo or by checking out the flexdll submodule with
@echo \ git submodule update --init
@false
flexdll-repo: flexdll-common-err
@echo or by cloning the git repository
@echo \ git clone https://github.com/alainfrisch/flexdll.git
@echo
@if [ -d .git ]; then \
echo or by checking out the flexdll submodule with; \
echo \ git submodule update --init; \
else \
echo or by cloning the git repository; \
echo \ git clone https://github.com/alainfrisch/flexdll.git; \
fi
@false
# Bootstrapping FlexDLL - leaves a bytecode image of flexlink.exe in flexdll/
flexdll: flexdll/Makefile
cd byterun ; $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
cd byterun && $(MAKEREC) BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
cp byterun/ocamlrun.exe boot/ocamlrun.exe
cd stdlib ; $(MAKEREC) COMPILER=../boot/ocamlc stdlib.cma std_exit.cmo
cd stdlib ; cp stdlib.cma std_exit.cmo *.cmi ../boot
cd flexdll ; $(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -I ../boot" flexlink.exe support
cd byterun ; $(MAKEREC) clean
cd stdlib && $(MAKEREC) COMPILER=../boot/ocamlc stdlib.cma std_exit.cmo
cd stdlib && cp stdlib.cma std_exit.cmo *.cmi ../boot
cd flexdll && \
$(MAKECMD) MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) \
CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false \
OCAMLOPT="../boot/ocamlrun ../boot/ocamlc -I ../boot" \
flexlink.exe support
cd byterun && $(MAKEREC) clean
$(MAKEREC) partialclean
flexlink.opt:
cd flexdll ; \
mv flexlink.exe flexlink ; \
$(MAKECMD) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe ; \
mv flexlink.exe flexlink.opt ; \
cd flexdll && \
mv flexlink.exe flexlink && \
$(MAKECMD) OCAML_FLEXLINK="../boot/ocamlrun ./flexlink" MSVC_DETECT=0 \
TOOLCHAIN=$(TOOLCHAIN) TOOLPREF=$(TOOLPREF) \
OCAMLOPT="../ocamlopt.opt -I ../stdlib" flexlink.exe && \
mv flexlink.exe flexlink.opt && \
mv flexlink flexlink.exe
# Recompile the system using the bootstrap compiler
@ -150,7 +157,7 @@ compare:
&& $(CAMLRUN) tools/cmpbyt boot/ocamldep tools/ocamldep; \
then echo "Fixpoint reached, bootstrap succeeded."; \
else echo "Fixpoint not reached, try one more bootstrapping cycle."; \
fi
fi
# Remove old bootstrap compilers
cleanboot:
@ -229,28 +236,36 @@ installbyt:
install-flexdll:
# The $(if ...) installs the correct .manifest file for MSVC and MSVC64
# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of filter-out)
cp flexdll/flexlink.exe $(if $(filter-out mingw,$(TOOLCHAIN)),flexdll/default$(filter-out _i386,_$(ARCH)).manifest) $(INSTALL_BINDIR)/
# (GNU make doesn't have ifeq as a function, hence slightly convoluted use of
# filter-out)
cp flexdll/flexlink.exe \
$(if $(filter-out mingw,$(TOOLCHAIN)),\
flexdll/default$(filter-out _i386,_$(ARCH)).manifest) \
$(INSTALL_BINDIR)/
cp flexdll/flexdll_*.$(O) $(INSTALL_LIBDIR)
# Installation of the native-code compiler
installopt:
cd asmrun ; $(MAKEREC) install
cd asmrun && $(MAKEREC) install
cp ocamlopt "$(INSTALL_BINDIR)/ocamlopt.exe"
cd stdlib ; $(MAKEREC) installopt
cd stdlib && $(MAKEREC) installopt
cp middle_end/*.cmi middle_end/*.cmt middle_end/*.cmti \
"$(INSTALL_COMPLIBDIR)"
cp middle_end/base_types/*.cmi middle_end/base_types/*.cmt \
middle_end/base_types/*.cmti "$(INSTALL_COMPLIBDIR)"
cp asmcomp/*.cmi asmcomp/*.cmt asmcomp/*.cmti "$(INSTALL_COMPLIBDIR)"
cp compilerlibs/ocamloptcomp.cma $(OPTSTART) "$(INSTALL_COMPLIBDIR)"
if test -n "$(WITH_OCAMLDOC)"; then (cd ocamldoc; $(MAKEREC) installopt); fi
if test -n "$(WITH_OCAMLDOC)"; then \
(cd ocamldoc && $(MAKEREC) installopt); \
fi
for i in $(OTHERLIBRARIES); do \
$(MAKEREC) -C otherlibs/$$i installopt || exit $$?; \
done
if test -f ocamlopt.opt ; then $(MAKEREC) installoptopt; fi
cd tools; $(MAKEREC) installopt
if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then cp -f flexdll/flexlink.opt $(INSTALL_BINDIR)/flexlink.exe ; fi
if test -f ocamlopt.opt -a -f flexdll/flexlink.opt ; then \
cp -f flexdll/flexlink.opt $(INSTALL_BINDIR)/flexlink.exe ; \
fi
installoptopt:
cp ocamlc.opt "$(INSTALL_BINDIR)/ocamlc.opt$(EXE)"
@ -441,7 +456,8 @@ ocamlopt.opt: compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
partialclean::
rm -f ocamlopt.opt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) $(ASMCOMP:.cmo=.cmx): ocamlopt
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(MIDDLE_END:.cmo=.cmx) \
$(ASMCOMP:.cmo=.cmx): ocamlopt
# The numeric opcodes

View File

@ -19,8 +19,8 @@ include stdlib/StdlibModules
CAMLC=$(CAMLRUN) boot/ocamlc -g -nostdlib -I boot
CAMLOPT=$(CAMLRUN) ./ocamlopt -g -nostdlib -I stdlib -I otherlibs/dynlink
COMPFLAGS=-strict-sequence -principal -w +33..39+48+50 -warn-error A -bin-annot \
-safe-string -strict-formats $(INCLUDES)
COMPFLAGS=-strict-sequence -principal -w +33..39+48+50 -warn-error A \
-bin-annot -safe-string -strict-formats $(INCLUDES)
LINKFLAGS=
YACCFLAGS=-v
@ -234,4 +234,3 @@ partialclean::
alldepend::
cd tools; $(MAKEREC) depend

View File

@ -60,7 +60,7 @@ renaming of standard library functions.
config/:: autoconfiguration stuff
debugger/:: source-level replay debugger
driver/:: driver code for the compilers
emacs/:: OCaml editing mode and debugger interface for GNU Emacs
emacs/:: editing mode and debugger interface for GNU Emacs
lex/:: lexer generator
maccaml/:: the Macintosh GUI
ocamldoc/:: documentation generator

View File

@ -87,15 +87,16 @@ for Windows.
You will need the following software components to perform the recompilation:
- Windows NT, 2000, XP, Vista, or 7 (32 or 64 bits).
- Items <<tps1,[1]>> and <<tps2,[2]>> from the list of recommended software above.
- Items <<tps1,[1]>> and <<tps2,[2]>> from the list of recommended software
above.
- The Cygwin port of GNU tools, available from http://www.cygwin.com/
Install at least the following packages (and their dependencies):
diffutils, dos2unix, gcc-core, make, ncurses.
First, you need to set up your cygwin environment for using the MS
tools. The following assumes that you have installed <<tps1,[1]>>, <<tps2,[2]>>, and [3]
in their default directories. If this is not the case, you will need
to adjust the paths accordingly.
tools. The following assumes that you have installed <<tps1,[1]>>,
<<tps2,[2]>>, and [3] in their default directories. If this is not
the case, you will need to adjust the paths accordingly.
. Open a Windows Command Prompt and enter the following command:
@ -408,14 +409,15 @@ for Windows.
You will need the following software components to perform the recompilation:
- Windows XP 64, Windows Server 64, or Windows 7 64.
- Items <<tps-native1,[1]>> and <<tps-native2,[2]>> from the list of recommended software above.
- Items <<tps-native1,[1]>> and <<tps-native2,[2]>> from the list of
recommended software above.
- The Cygwin port of GNU tools, available from http://www.cygwin.com/
Install at least the following packages: diffutils, make, ncurses.
First, you need to set up your cygwin environment for using the MS
tools. The following assumes that you have installed <<tps-native1,[1]>> and <<tps-native2,[2]>>
in their default directories. If this is not the case, you will need
to adjust the paths accordingly.
tools. The following assumes that you have installed <<tps-native1,[1]>>
and <<tps-native2,[2]>> in their default directories. If this is not
the case, you will need to adjust the paths accordingly.
. Open a Windows Command Prompt and enter the following commands:

View File

@ -19,4 +19,3 @@ Debian architecture name: `amd64`
_OS X ABI Function Call Guide: x86-64 Function Calling Conventions_
* Windows 64 application binary interface:
_x64 Software Conventions_ from MSDN

View File

@ -18,4 +18,3 @@ Debian architecture names: `armel` and `armhf`.
_ARM Architecture Reference Manual, ARMv8_, restricted to the AArch32 subset.
* Application binary interface:
_Procedure Call Standard for the ARM Architecture_

View File

@ -20,8 +20,3 @@ Debian architecture name: `i386`
Intel386 Architecture Processor Supplement_
* MacOS X application binary interface:
_OS X ABI Function Call Guide: IA-32 Function Calling Conventions_

View File

@ -10,13 +10,13 @@ No longer supported: AIX and MacOS X.
# Reference documents
* Instruction set architecture:
_PowerPC User Instruction Set Architecture_,
_PowerPC User Instruction Set Architecture_,
book 1 of _PowerPC Architecture Book_
(http://www.ibm.com/developerworks/systems/library/es-archguide-v2.html).
(http://www.ibm.com/developerworks/systems/library/es-archguide-v2.html).
* ELF ABI 32 bits:
_System V Application Binary Interface, PowerPC Processor Supplement_
_System V Application Binary Interface, PowerPC Processor Supplement_
* ELF ABI 64 bits version 1:
_64-bit PowerPC ELF Application Binary Interface Supplement_
_64-bit PowerPC ELF Application Binary Interface Supplement_
(http://refspecs.linuxfoundation.org/ELF/ppc64/PPC-elf64abi.html)
* ELF ABI 64 bits version 2:
_Power Architecture 64-bit ELF V2 ABI Specification,
@ -24,4 +24,3 @@ No longer supported: AIX and MacOS X.
(http://openpowerfoundation.org/technical/technical-resources/technical-specifications/)
* _The PowerPC Compiler Writer's Guide_, Warthman Associates, 1996.
(PDF available from various sources on the Web.)

View File

@ -6,7 +6,7 @@ running Linux (Debian architecture: `s390x`).
# Reference documents
* Instruction set architecture:
_z/Architecture Principles of Operation_,
_z/Architecture Principles of Operation_,
SA22-7832-07, eight edition (Feb 2009).
This is the version that corresponds to z10.
Newer versions of this manual include additional instructions
@ -14,6 +14,3 @@ running Linux (Debian architecture: `s390x`).
* ELF ABI:
_zSeries ELF Application Binary Interface Supplement_
(http://refspecs.linuxfoundation.org/ELF/zSeries/index.html)

View File

@ -15,7 +15,3 @@ Status of this port: nearly abandoned
* ELF application binary interface:
_System V Application Binary Interface,
SPARC Processor Supplement_

View File

@ -189,7 +189,8 @@
#define PUSH_CALLEE_SAVE_REGS \
pushq %rbx; CFI_ADJUST (8); CFI_OFFSET(rbx, -16); \
pushq %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); /* Allows debugger to walk the stack */ \
pushq %rbp; CFI_ADJUST (8); CFI_OFFSET(rbp, -24); \
/* Allows debugger to walk the stack */ \
pushq %rsi; CFI_ADJUST (8); CFI_OFFSET(rsi, -32); \
pushq %rdi; CFI_ADJUST (8); CFI_OFFSET(rdi, -40); \
pushq %r12; CFI_ADJUST (8); CFI_OFFSET(r12, -48); \

View File

@ -93,7 +93,9 @@ alloc_limit .req r11
/* Support for profiling with gprof */
#if defined(PROFILING) && (defined(SYS_linux_eabihf) || defined(SYS_linux_eabi) || defined(SYS_netbsd))
#if defined(PROFILING) && (defined(SYS_linux_eabihf) \
|| defined(SYS_linux_eabi) \
|| defined(SYS_netbsd))
#define PROFILE \
push {lr}; CFI_ADJUST(4); \
bl __gnu_mcount_nc; CFI_ADJUST(-4)

View File

@ -36,14 +36,14 @@ caml_system__code_begin:
caml_call_gc:
/* Set up stack frame */
#define FRAMESIZE (16*8 + 16*8)
lay %r15, -FRAMESIZE(%r15)
lay %r15, -FRAMESIZE(%r15)
/* Record return address into OCaml code */
Storeglobal(%r14, caml_last_return_address)
/* Record lowest stack address */
lay %r0, FRAMESIZE(%r15)
lay %r0, FRAMESIZE(%r15)
Storeglobal(%r0, caml_bottom_of_stack)
/* Record pointer to register array */
lay %r0, (8*16)(%r15)
lay %r0, (8*16)(%r15)
Storeglobal(%r0, caml_gc_regs)
/* Save current allocation pointer for debugging purposes */
Storeglobal(%r11, caml_young_ptr)
@ -51,7 +51,7 @@ caml_call_gc:
Storeglobal(%r13, caml_exception_pointer)
/* Save all registers used by the code generator */
stmg %r2,%r9, (8*16)(%r15)
stg %r12, (8*16 + 8*8)(%r15)
stg %r12, (8*16 + 8*8)(%r15)
std %f0, 0(%r15)
std %f1, 8(%r15)
std %f2, 16(%r15)
@ -78,7 +78,7 @@ caml_call_gc:
Loadglobal(%r10, caml_young_limit)
/* Restore all regs used by the code generator */
lmg %r2,%r9, (8*16)(%r15)
lg %r12, (8*16 + 8*8)(%r15)
lg %r12, (8*16 + 8*8)(%r15)
ld %f0, 0(%r15)
ld %f1, 8(%r15)
ld %f2, 16(%r15)
@ -98,7 +98,7 @@ caml_call_gc:
/* Return to caller */
Loadglobal(%r1, caml_last_return_address)
/* Deallocate stack frame */
lay %r15, FRAMESIZE(%r15)
lay %r15, FRAMESIZE(%r15)
/* Return */
br %r1
@ -109,7 +109,7 @@ caml_call_gc:
caml_c_call:
Storeglobal(%r15, caml_bottom_of_stack)
/* Save return address */
ldgr %f15, %r14
ldgr %f15, %r14
/* Get ready to call C function (address in r7) */
/* Record lowest stack address and return address */
Storeglobal(%r14, caml_last_return_address)
@ -119,7 +119,7 @@ caml_c_call:
/* Call the function */
basr %r14, %r7
/* restore return address */
lgdr %r14,%f15
lgdr %r14,%f15
/* Reload allocation pointer and allocation limit*/
Loadglobal(%r11, caml_young_ptr)
Loadglobal(%r10, caml_young_limit)
@ -135,36 +135,36 @@ caml_c_call:
.type caml_raise_exn, @function
caml_raise_exn:
Loadglobal32(%r0, caml_backtrace_active)
cgfi %r0, 0
cgfi %r0, 0
jne .L110
.L111:
/* Pop trap frame */
lg %r1, 0(%r13)
lg %r1, 0(%r13)
lgr %r15, %r13
lg %r13, 8(13)
agfi %r15, 16
/* Branch to handler */
br %r1
br %r1
.L110:
lgfi %r0, 0
Storeglobal32(%r0, caml_backtrace_pos)
.L114:
ldgr %f15, %r2 /* preserve exn bucket in callee-save reg */
ldgr %f15, %r2 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r3 */
lgr %r3,%r14 /* arg2: PC of raise */
lgr %r4, %r15 /* arg3: SP of raise */
lgr %r5, %r13 /* arg4: SP of handler */
agfi %r15, -160 /* reserve stack space for C call */
brasl %r14, caml_stash_backtrace@PLT
agfi %r15, 160
lgdr %r2,%f15 /* restore exn bucket */
agfi %r15, 160
lgdr %r2,%f15 /* restore exn bucket */
j .L111 /* raise the exn */
.globl caml_reraise_exn
.type caml_reraise_exn, @function
caml_reraise_exn:
Loadglobal32(%r0, caml_backtrace_active)
cgfi %r0, 0
cgfi %r0, 0
jne .L114
/* Pop trap frame */
lg %r1, 0(%r13)
@ -180,7 +180,7 @@ caml_reraise_exn:
.type caml_raise_exception, @function
caml_raise_exception:
Loadglobal32(0, caml_backtrace_active)
cgfi %r0, 0
cgfi %r0, 0
jne .L112
.L113:
/* Reload OCaml global registers */
@ -191,13 +191,13 @@ caml_raise_exception:
lgfi %r0, 0
Storeglobal(%r0, caml_last_return_address)
/* Pop trap frame */
lg %r1, 0(%r15)
lg %r13, 8(%r15)
agfi %r15, 16
lg %r1, 0(%r15)
lg %r13, 8(%r15)
agfi %r15, 16
/* Branch to handler */
br %r1;
br %r1;
.L112:
ldgr %f15,%r2 /* preserve exn bucket in callee-save reg */
ldgr %f15,%r2 /* preserve exn bucket in callee-save reg */
/* arg1: exception bucket, already in r2 */
Loadglobal(%r3, caml_last_return_address) /* arg2: PC of raise */
Loadglobal(%r4, caml_bottom_of_stack) /* arg3: SP of raise */
@ -206,7 +206,7 @@ caml_raise_exception:
lay %r15, -160(%r15)
brasl %r14, caml_stash_backtrace@PLT
lay %r15, 160(%r15)
lgdr %r2,%f15 /* restore exn bucket */ /* restore exn bucket */
lgdr %r2,%f15 /* restore exn bucket */
j .L113 /* raise the exn */
/* Start the OCaml program */
@ -219,7 +219,7 @@ caml_start_program:
/* Code shared between caml_start_program and caml_callback */
.L102:
/* Allocate stack frame */
lay %r15, -144(%r15)
lay %r15, -144(%r15)
/* Save all callee-save registers + return address */
/* GPR 6..14 at sp + 0 ... sp + 64
FPR 10..15 at sp + 72 ... sp + 128 */
@ -245,7 +245,7 @@ caml_start_program:
brasl %r14, .L103
j .L104
.L103:
lay %r15, -16(%r15)
lay %r15, -16(%r15)
stg %r14, 0(%r15)
Loadglobal(%r1, caml_exception_pointer)
stg %r1, 8(%r15)
@ -260,7 +260,7 @@ caml_start_program:
/* Pop the trap frame, restoring caml_exception_pointer */
lg %r0, 8(%r15)
Storeglobal(%r0, caml_exception_pointer)
la %r15, 16(%r15)
la %r15, 16(%r15)
/* Pop the callback link, restoring the global variables */
.L106:
lg %r5, 0(%r15)
@ -269,12 +269,12 @@ caml_start_program:
Storeglobal(%r5, caml_bottom_of_stack)
Storeglobal(%r6, caml_last_return_address)
Storeglobal(%r1, caml_gc_regs)
la %r15, 32(%r15)
la %r15, 32(%r15)
/* Update allocation pointer */
Storeglobal(%r11, caml_young_ptr)
/* Restore registers */
/* Restore registers */
lmg %r6,%r14, 0(%r15)
ld %f8, 72(%r15)
ld %f9, 80(%r15)
@ -286,8 +286,8 @@ caml_start_program:
ld %f15, 128(%r15)
/* Return */
lay %r15, 144(%r15)
br %r14
lay %r15, 144(%r15)
br %r14
/* The trap handler: */
.L104:
@ -330,12 +330,12 @@ caml_callback3_exn:
Addrglobal(%r0, caml_apply3)
j .L102
.globl caml_ml_array_bound_error
.type caml_ml_array_bound_error, @function
.globl caml_ml_array_bound_error
.type caml_ml_array_bound_error, @function
caml_ml_array_bound_error:
lay %r15, -160(%r15) /* Reserve stack space for C call */
larl %r7, caml_array_bound_error
j caml_c_call
lay %r15, -160(%r15) /* Reserve stack space for C call */
larl %r7, caml_array_bound_error
j caml_c_call
.globl caml_system__code_end
caml_system__code_end:
@ -350,7 +350,7 @@ caml_system__frametable:
.quad .L105 /* return address into callback */
.short -1 /* negative size count => use callback link */
.short 0 /* no roots here */
.align 8
.align 8
/* Mark stack as non-executable */
.section .note.GNU-stack,"",%progbits

View File

@ -145,7 +145,9 @@ int caml_set_signal_action(int signo, int action)
/* Machine- and OS-dependent handling of bound check trap */
#if defined(TARGET_power) || defined(TARGET_s390x) || (defined(TARGET_sparc) && defined(SYS_solaris))
#if defined(TARGET_power) \
|| defined(TARGET_s390x) \
|| (defined(TARGET_sparc) && defined(SYS_solaris))
DECLARE_SIGNAL_HANDLER(trap_handler)
{
#if defined(SYS_solaris)

View File

@ -283,7 +283,7 @@
#define CONTEXT_YOUNG_LIMIT (context->regs->gpr[30])
#define CONTEXT_YOUNG_PTR (context->regs->gpr[31])
#define CONTEXT_SP (context->regs->gpr[1])
/****************** s390x, ELF (Linux) */
#elif defined(TARGET_s390x) && defined(SYS_elf)

View File

@ -647,7 +647,7 @@ let rec comp_expr env exp sz cont =
(Kmakeblock(List.length args, 0) ::
Kccall("caml_make_array", 1) :: cont)
end
| Lprim (Pduparray (kind, mutability), [Lprim (Pmakearray (kind', _), args)]) ->
| Lprim (Pduparray (kind, mutability), [Lprim (Pmakearray (kind',_),args)]) ->
assert (kind = kind');
comp_expr env (Lprim (Pmakearray (kind, mutability), args)) sz cont
| Lprim (Pduparray _, [arg]) ->

View File

@ -525,7 +525,8 @@ let subst_lambda s lam =
begin try Ident.find_same id s with Not_found -> l end
| Lconst sc as l -> l
| Lapply ap ->
Lapply{ap with ap_func = subst ap.ap_func; ap_args = List.map subst ap.ap_args}
Lapply{ap with ap_func = subst ap.ap_func;
ap_args = List.map subst ap.ap_args}
| Lfunction{kind; params; body; attr} ->
Lfunction{kind; params; body = subst body; attr}
| Llet(str, id, arg, body) -> Llet(str, id, subst arg, subst body)

View File

@ -2980,7 +2980,8 @@ let rec map_return f = function
| Lsequence (l1, l2) -> Lsequence (l1, map_return f l2)
| Levent (l, ev) -> Levent (map_return f l, ev)
| Ltrywith (l1, id, l2) -> Ltrywith (map_return f l1, id, map_return f l2)
| Lstaticcatch (l1, b, l2) -> Lstaticcatch (map_return f l1, b, map_return f l2)
| Lstaticcatch (l1, b, l2) ->
Lstaticcatch (map_return f l1, b, map_return f l2)
| Lstaticraise _ | Lprim(Praise _, _) as l -> l
| l -> f l

View File

@ -355,7 +355,8 @@ let simplify_lets lam =
| Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args}
when optimize && List.length params = List.length args ->
count bv (beta_reduce params body args)
| Lapply{ap_func = Lfunction{kind = Tupled; params; body}; ap_args = [Lprim(Pmakeblock _, args)]}
| Lapply{ap_func = Lfunction{kind = Tupled; params; body};
ap_args = [Lprim(Pmakeblock _, args)]}
when optimize && List.length params = List.length args ->
count bv (beta_reduce params body args)
| Lapply{ap_func = l1; ap_args = ll} ->
@ -447,10 +448,12 @@ let simplify_lets lam =
| Lapply{ap_func = Lfunction{kind = Curried; params; body}; ap_args = args}
when optimize && List.length params = List.length args ->
simplif (beta_reduce params body args)
| Lapply{ap_func = Lfunction{kind = Tupled; params; body}; ap_args = [Lprim(Pmakeblock _, args)]}
| Lapply{ap_func = Lfunction{kind = Tupled; params; body};
ap_args = [Lprim(Pmakeblock _, args)]}
when optimize && List.length params = List.length args ->
simplif (beta_reduce params body args)
| Lapply ap -> Lapply {ap with ap_func = simplif ap.ap_func; ap_args = List.map simplif ap.ap_args}
| Lapply ap -> Lapply {ap with ap_func = simplif ap.ap_func;
ap_args = List.map simplif ap.ap_args}
| Lfunction{kind; params; body = l; attr} ->
begin match simplif l with
Lfunction{kind=Curried; params=params'; body; attr}

View File

@ -29,7 +29,9 @@ let lfunction params body =
| Lfunction {kind = Curried; params = params'; body = body'; attr} ->
Lfunction {kind = Curried; params = params @ params'; body = body'; attr}
| _ ->
Lfunction {kind = Curried; params; body; attr = default_function_attribute}
Lfunction {kind = Curried; params;
body;
attr = default_function_attribute}
let lapply ap =
match ap.ap_func with
@ -601,7 +603,8 @@ open M
obj_init: creation function (unit -> obj)
class_init: inheritance function (table -> env_init)
(one by source code)
env_init: parameterisation by the local environment (env -> params -> obj_init)
env_init: parameterisation by the local environment
(env -> params -> obj_init)
(one for each combination of inherited class_init )
env: environnement local
If ids=0 (immediate object), then only env_init is conserved.

View File

@ -874,11 +874,12 @@ and transl_exp0 e =
because [caml_modify] might be called upon them (e.g. from
code operating on polymorphic arrays, or functions such as
[caml_array_blit].
To avoid having different Lambda code for bytecode/Closure vs.
Flambda, we always generate [Pduparray] here, and deal with it in
[Bytegen] (or in the case of Closure, in [Cmmgen], which already
has to handle [Pduparray Pmakearray Pfloatarray] in the case where
the array turned out to be inconstant).
To avoid having different Lambda code for
bytecode/Closure vs. Flambda, we always generate
[Pduparray] here, and deal with it in [Bytegen] (or in
the case of Closure, in [Cmmgen], which already has to
handle [Pduparray Pmakearray Pfloatarray] in the case
where the array turned out to be inconstant).
When not [Pfloatarray], the exception propagates to the handler
below. *)
let imm_array = Lprim (Pmakearray (kind, Immutable), ll) in
@ -891,7 +892,7 @@ and transl_exp0 e =
| Pfloatarray ->
Lconst(Const_float_array(List.map extract_float cl))
| Pgenarray ->
raise Not_constant (* can this really happen? *)
raise Not_constant (* can this really happen? *)
in
Lprim (Pduparray (kind, Mutable), [imm_array])
end
@ -1122,7 +1123,10 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline)
| [] ->
lapply lam (List.rev_map fst args)
in
(build_apply lam [] (List.map (fun (l, x) -> may_map transl_exp x, Btype.is_optional l) sargs) : Lambda.lambda)
(build_apply lam [] (List.map (fun (l, x) ->
may_map transl_exp x, Btype.is_optional l)
sargs)
: Lambda.lambda)
and transl_function loc untuplify_fn repr partial cases =
match cases with

View File

@ -98,7 +98,8 @@ let rec apply_coercion strict restr arg =
(Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=Lvar id;
ap_args=[apply_coercion Alias cc_arg (Lvar param)];
ap_args=[apply_coercion Alias cc_arg
(Lvar param)];
ap_inlined=Default_inline;
ap_specialised=Default_specialise})})
| Tcoerce_primitive { pc_loc; pc_desc; pc_env; pc_type; } ->
@ -383,7 +384,8 @@ let rec transl_module cc rootpath mexp =
specialise = Default_specialise;
is_a_functor = true };
body = Llet(Alias, param,
apply_coercion Alias ccarg (Lvar param'),
apply_coercion Alias ccarg
(Lvar param'),
transl_module ccres bodypath body)}
| _ ->
fatal_error "Translmod.transl_module")
@ -493,7 +495,8 @@ and transl_structure fields cc rootpath final_env = function
transl_module Tcoerce_none (field_path rootpath id) mb.mb_expr
in
let module_body =
Translattribute.add_inline_attribute module_body mb.mb_loc mb.mb_attributes
Translattribute.add_inline_attribute module_body mb.mb_loc
mb.mb_attributes
in
Llet(pure_module mb.mb_expr, id,
module_body,
@ -527,7 +530,9 @@ and transl_structure fields cc rootpath final_env = function
[] ->
transl_structure newfields cc rootpath final_env rem
| id :: ids ->
let body, size = rebind_idents (pos + 1) (id :: newfields) ids in
let body, size =
rebind_idents (pos + 1) (id :: newfields) ids
in
Llet(Alias, id, Lprim(Pfield pos, [Lvar mid]), body), size
in
let body, size = rebind_idents 0 fields ids in
@ -650,7 +655,9 @@ let rec more_idents = function
| Tstr_class_type cl_list -> more_idents rem
| Tstr_include _ -> more_idents rem
| Tstr_module {mb_expr={mod_desc = Tmod_structure str}}
| Tstr_module{mb_expr={mod_desc = Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
| Tstr_module{mb_expr={mod_desc =
Tmod_constraint ({mod_desc = Tmod_structure str},
_, _, _)}} ->
all_idents str.str_items @ more_idents rem
| Tstr_module _ -> more_idents rem
| Tstr_attribute _ -> more_idents rem
@ -678,7 +685,10 @@ and all_idents = function
| Tstr_include incl ->
bound_value_identifiers incl.incl_type @ all_idents rem
| Tstr_module {mb_id;mb_expr={mod_desc = Tmod_structure str}}
| Tstr_module{mb_id; mb_expr={mod_desc = Tmod_constraint ({mod_desc = Tmod_structure str}, _, _, _)}} ->
| Tstr_module{mb_id;
mb_expr={mod_desc =
Tmod_constraint ({mod_desc = Tmod_structure str},
_, _, _)}} ->
mb_id :: all_idents str.str_items @ all_idents rem
| Tstr_module mb -> mb.mb_id :: all_idents rem
| Tstr_attribute _ -> all_idents rem
@ -725,9 +735,12 @@ let transl_store_structure glob map prims str =
| Tstr_type(_, decls) ->
transl_store rootpath subst rem
| Tstr_typext(tyext) ->
let ids = List.map (fun ext -> ext.ext_id) tyext.tyext_constructors in
let ids =
List.map (fun ext -> ext.ext_id) tyext.tyext_constructors
in
let lam =
transl_type_extension item.str_env rootpath tyext (store_idents ids)
transl_type_extension item.str_env rootpath tyext
(store_idents ids)
in
Lsequence(subst_lambda subst lam,
transl_store rootpath (add_idents false ids subst) rem)
@ -742,7 +755,9 @@ let transl_store_structure glob map prims str =
mb_attributes} ->
List.iter (Translattribute.check_attribute_on_module mexp)
mb_attributes;
let lam = transl_store (field_path rootpath id) subst str.str_items in
let lam =
transl_store (field_path rootpath id) subst str.str_items
in
(* Careful: see next case *)
let subst = !transl_store_subst in
Lsequence(lam,
@ -752,8 +767,9 @@ let transl_store_structure glob map prims str =
List.map (fun id -> Lvar id)
(defined_idents str.str_items))),
Lsequence(store_ident id,
transl_store rootpath (add_ident true id subst)
rem)))
transl_store rootpath
(add_ident true id subst)
rem)))
| Tstr_module{
mb_id=id;
mb_expr= {
@ -762,10 +778,13 @@ let transl_store_structure glob map prims str =
(Tcoerce_structure (map, _) as _cc))};
mb_attributes
} ->
(* Format.printf "coerc id %s: %a@." (Ident.unique_name id) Includemod.print_coercion cc; *)
(* Format.printf "coerc id %s: %a@." (Ident.unique_name id)
Includemod.print_coercion cc; *)
List.iter (Translattribute.check_attribute_on_module mexp)
mb_attributes;
let lam = transl_store (field_path rootpath id) subst str.str_items in
let lam =
transl_store (field_path rootpath id) subst str.str_items
in
(* Careful: see next case *)
let subst = !transl_store_subst in
let ids = Array.of_list (defined_idents str.str_items) in
@ -781,8 +800,9 @@ let transl_store_structure glob map prims str =
(Lprim(Pmakeblock(0, Immutable),
List.map field map)),
Lsequence(store_ident id,
transl_store rootpath (add_ident true id subst)
rem)))
transl_store rootpath
(add_ident true id subst)
rem)))
| Tstr_module{mb_id=id; mb_expr=modl; mb_loc; mb_attributes} ->
let lam =
Translattribute.add_inline_attribute
@ -955,7 +975,8 @@ let toplevel_name id =
let toploop_getvalue id =
Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=Lprim(Pfield toploop_getvalue_pos, [Lprim(Pgetglobal toploop_ident, [])]);
ap_func=Lprim(Pfield toploop_getvalue_pos,
[Lprim(Pgetglobal toploop_ident, [])]);
ap_args=[Lconst(Const_base(Const_string (toplevel_name id, None)))];
ap_inlined=Default_inline;
ap_specialised=Default_specialise}
@ -963,8 +984,10 @@ let toploop_getvalue id =
let toploop_setvalue id lam =
Lapply{ap_should_be_tailcall=false;
ap_loc=Location.none;
ap_func=Lprim(Pfield toploop_setvalue_pos, [Lprim(Pgetglobal toploop_ident, [])]);
ap_args=[Lconst(Const_base(Const_string (toplevel_name id, None))); lam];
ap_func=Lprim(Pfield toploop_setvalue_pos,
[Lprim(Pgetglobal toploop_ident, [])]);
ap_args=[Lconst(Const_base(Const_string (toplevel_name id, None)));
lam];
ap_inlined=Default_inline;
ap_specialised=Default_specialise}

View File

@ -26,4 +26,3 @@ val array_kind : Typedtree.expression -> Lambda.array_kind
val array_pattern_kind : Typedtree.pattern -> Lambda.array_kind
val bigarray_type_kind_and_layout :
Env.t -> Types.type_expr -> Lambda.bigarray_kind * Lambda.bigarray_layout

View File

@ -710,14 +710,14 @@ CAMLexport intnat caml_output_value_to_block(value v, value flags,
char header[32];
int header_len;
intnat data_len;
/* At this point we don't know the size of the header.
/* At this point we don't know the size of the header.
Guess that it is small, and fix up later if not. */
extern_userprovided_output = buf + 20;
extern_ptr = extern_userprovided_output;
extern_limit = buf + len;
data_len = extern_value(v, flags, header, &header_len);
if (header_len != 20) {
/* Bad guess! Need to shift the output to make room for big header.
/* Bad guess! Need to shift the output to make room for big header.
Make sure there is room. */
if (header_len + data_len > len)
caml_failwith("Marshal.to_buffer: buffer overflow");
@ -739,7 +739,7 @@ CAMLprim value caml_output_value_to_buffer(value buf, value ofs, value len,
CAMLexport void caml_output_value_to_malloc(value v, value flags,
/*out*/ char ** buf,
/*out*/ intnat * len)
{
{
char header[32];
int header_len;
intnat data_len;

View File

@ -240,7 +240,7 @@ static int caml_float_of_hex(const char * s, double * res)
}
}
/* Convert mantissa to FP. We use a signed conversion because we can
(m has 60 bits at most) and because it is faster
(m has 60 bits at most) and because it is faster
on several architectures. */
f = (double) (int64_t) m;
/* Adjust exponent to take decimal point and extra digits into account */
@ -265,7 +265,7 @@ CAMLprim value caml_float_of_string(value vs)
src = String_val(vs);
sign = 1;
if (*src == '-') { sign = -1; src++; }
else if (*src == '+') { src++; };
else if (*src == '+') { src++; };
if (src[0] == '0' && (src[1] == 'x' || src[1] == 'X')) {
if (caml_float_of_hex(src + 2, &d) == -1)
caml_failwith("float_of_string");

View File

@ -671,7 +671,7 @@ static void caml_parse_header(char * fun_name,
h->whsize = read64u();
#else
errmsg[sizeof(errmsg) - 1] = 0;
snprintf(errmsg, sizeof(errmsg) - 1,
snprintf(errmsg, sizeof(errmsg) - 1,
"%s: object too large to be read back on a 32-bit platform",
fun_name);
caml_failwith(errmsg);
@ -679,7 +679,7 @@ static void caml_parse_header(char * fun_name,
break;
default:
errmsg[sizeof(errmsg) - 1] = 0;
snprintf(errmsg, sizeof(errmsg) - 1,
snprintf(errmsg, sizeof(errmsg) - 1,
"%s: bad object",
fun_name);
caml_failwith(errmsg);
@ -811,7 +811,7 @@ CAMLexport value caml_input_value_from_block(char * data, intnat len)
result is a [value] that represents a number of bytes
To handle both the small and the big format,
we assume 20 bytes are available at [buff + ofs],
and we return the data size + the length of the part of the header
and we return the data size + the length of the part of the header
that remains to be read. */
CAMLprim value caml_marshal_data_size(value buff, value ofs)

View File

@ -162,7 +162,7 @@ CAMLexport int caml_flush_partial(struct channel *channel)
CAMLassert (towrite >= 0);
if (towrite > 0) {
written = caml_write_fd(channel->fd, channel->flags,
channel->buff, towrite);
channel->buff, towrite);
channel->offset += written;
if (written < towrite)
memmove(channel->buff, channel->buff + written, towrite - written);
@ -207,7 +207,7 @@ CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len)
memmove(channel->curr, p, free);
towrite = channel->end - channel->buff;
written = caml_write_fd(channel->fd, channel->flags,
channel->buff, towrite);
channel->buff, towrite);
if (written < towrite)
memmove(channel->buff, channel->buff + written, towrite - written);
channel->offset += written;
@ -256,8 +256,8 @@ CAMLexport unsigned char caml_refill(struct channel *channel)
{
int n;
n = caml_read_fd(channel->fd, channel->flags,
channel->buff, channel->end - channel->buff);
n = caml_read_fd(channel->fd, channel->flags,
channel->buff, channel->end - channel->buff);
if (n == 0) caml_raise_end_of_file();
channel->offset += n;
channel->max = channel->buff + n;
@ -295,7 +295,7 @@ CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len)
return avail;
} else {
nread = caml_read_fd(channel->fd, channel->flags, channel->buff,
channel->end - channel->buff);
channel->end - channel->buff);
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
@ -364,8 +364,8 @@ CAMLexport intnat caml_input_scan_line(struct channel *channel)
return -(channel->max - channel->curr);
}
/* Fill the buffer as much as possible */
n = caml_read_fd(channel->fd, channel->flags,
channel->max, channel->end - channel->max);
n = caml_read_fd(channel->fd, channel->flags,
channel->max, channel->end - channel->max);
if (n == 0) {
/* End-of-file encountered. Return the number of characters in the
buffer, with negative sign since we haven't encountered

View File

@ -131,7 +131,9 @@ MKEXE_BOOT=$(BYTECC) -o $(1) $(2)
### How to build a static library
MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1)
#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;;
#ml let mklib out files opts =
#ml Printf.sprintf "rm -f %s && %sar rcs %s %s %s"
#ml out toolpref opts out files;;
### Canonicalize the name of a system library
SYSLIB=-l$(1)

View File

@ -131,7 +131,9 @@ MKEXE_BOOT=$(BYTECC) -o $(1) $(2)
### How to build a static library
MKLIB=rm -f $(1); $(TOOLPREF)ar rc $(1) $(2); $(RANLIB) $(1)
#ml let mklib out files opts = Printf.sprintf "rm -f %s && %sar rcs %s %s %s" out toolpref opts out files;;
#ml let mklib out files opts =
#ml Printf.sprintf "rm -f %s && %sar rcs %s %s %s"
#ml out toolpref opts out files;;
### Canonicalize the name of a system library
SYSLIB=-l$(1)

View File

@ -121,12 +121,16 @@ MKEXE=$(FLEXLINK) -exe
MKMAINDLL=$(FLEXLINK) -maindll
### Native command to build ocamlrun.exe without flexlink
MERGEMANIFESTEXE=test ! -f $(1).manifest || mt -nologo -outputresource:$(1) -manifest $(1).manifest && rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console && ($(MERGEMANIFESTEXE))
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
&& rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console \
&& ($(MERGEMANIFESTEXE))
### How to build a static library
MKLIB=link -lib -nologo -out:$(1) $(2)
#ml let mklib out files opts = Printf.sprintf "link -lib -nologo -out:%s %s %s" out opts files;;
#ml let mklib out files opts =
#ml Printf.sprintf "link -lib -nologo -out:%s %s %s" out opts files;;
MKSHAREDLIBRPATH=
### Canonicalize the name of a system library

View File

@ -125,12 +125,17 @@ MKEXE=$(FLEXLINK) -exe
MKMAINDLL=$(FLEXLINK) -maindll
### Native command to build ocamlrun.exe without flexlink
MERGEMANIFESTEXE=test ! -f $(1).manifest || mt -nologo -outputresource:$(1) -manifest $(1).manifest && rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console && ($(MERGEMANIFESTEXE))
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
&& rm -f $(1).manifest
MKEXE_BOOT=$(BYTECC) /Fe$(1) $(2) /link /subsystem:console \
&& ($(MERGEMANIFESTEXE))
### How to build a static library
MKLIB=link -lib -nologo -machine:AMD64 /out:$(1) $(2)
#ml let mklib out files opts = Printf.sprintf "link -lib -nologo -machine:AMD64 -out:%s %s %s" out opts files;;
#ml let mklib out files opts =
#ml Printf.sprintf "link -lib -nologo -machine:AMD64 -out:%s %s %s"
#ml out opts files;;
MKSHAREDLIBRPATH=
### Canonicalize the name of a system library

24
configure vendored
View File

@ -321,7 +321,7 @@ case "$ccfamily" in
gcc-[012]-*)
# Some versions known to miscompile OCaml, e,g, 2.7.2.1, some 2.96.
# Plus: C99 support unknown.
err "This version of GCC is too old. Please use GCC version 4.2 or above.";;
err "This version of GCC is too old. Please use GCC version 4.2 or above.";;
gcc-3-*|gcc-4-[01])
# No -fwrapv option before GCC 3.4.
# Known problems with -fwrapv fixed in 4.2 only.
@ -841,8 +841,8 @@ case "$target" in
armv6t2*-*-linux-gnueabi) arch=arm; model=armv6t2; system=linux_eabi;;
armv6*-*-linux-gnueabi) arch=arm; model=armv6; system=linux_eabi;;
armv6*-*-freebsd*) arch=arm; model=armv6; system=freebsd;;
earmv6*-*-netbsd*) arch=arm; model=armv6; system=netbsd;;
earmv7*-*-netbsd*) arch=arm; model=armv7; system=netbsd;;
earmv6*-*-netbsd*) arch=arm; model=armv6; system=netbsd;;
earmv7*-*-netbsd*) arch=arm; model=armv7; system=netbsd;;
armv5te*-*-linux-gnueabi) arch=arm; model=armv5te; system=linux_eabi;;
armv5*-*-linux-gnueabi) arch=arm; model=armv5; system=linux_eabi;;
arm*-*-linux-gnueabi) arch=arm; system=linux_eabi;;
@ -1074,7 +1074,8 @@ if $with_instrumented_runtime; then
fi
done
if ! $with_instrumented_runtime; then
err "clock_gettime functions not found. Instrumented runtime can't be built."
err "clock_gettime functions not found. " \
"Instrumented runtime can't be built."
fi
fi
@ -1362,7 +1363,10 @@ fi
nargs=none
for i in 5 6; do
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyname.c; then nargs=$i; break; fi
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyname.c; then
nargs=$i;
break;
fi
done
if test $nargs != "none"; then
inf "gethostbyname_r() found (with ${nargs} arguments)."
@ -1371,7 +1375,10 @@ fi
nargs=none
for i in 7 8; do
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyaddr.c; then nargs=$i; break; fi
if sh ./trycompile -DSYS_${system} -DNUM_ARGS=${i} gethostbyaddr.c; then
nargs=$i;
break;
fi
done
if test $nargs != "none"; then
inf "gethostbyaddr_r() found (with ${nargs} arguments)."
@ -1712,7 +1719,6 @@ if test "$with_frame_pointers" = "true"; then
;;
*) err "Unsupported architecture with frame pointers";;
esac
fi
if $no_naked_pointers; then
@ -1751,8 +1757,8 @@ SYSLIB=-l\$(1)
### How to build a static library
MKLIB=${TOOLPREF}ar rc \$(1) \$(2); ${TOOLPREF}ranlib \$(1)
#ml let mklib out files opts =
#ml Printf.sprintf "${TOOLPREF}ar rc %s %s %s;
#ml ${TOOLPREF}ranlib %s" out opts files out;;
#ml Printf.sprintf "${TOOLPREF}ar rc %s %s %s; ${TOOLPREF}ranlib %s"
#ml out opts files out;;
EOF
echo "ARCH=$arch" >> Makefile
echo "MODEL=$model" >> Makefile

View File

@ -17,7 +17,12 @@ CAMLRUN ?= ../boot/ocamlrun
CAMLYACC ?= ../boot/ocamlyacc
CAMLC=$(CAMLRUN) ../boot/ocamlc -I ../boot
CAMLOPT=$(if $(wildcard ../flexdll/Makefile),OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe") $(CAMLRUN) ../ocamlopt -I ../stdlib
ifeq "$(wildcard ../flexdll/Makefile)" ""
FLEXLINK_ENV=
else
FLEXLINK_ENV=OCAML_FLEXLINK="../boot/ocamlrun ../flexdll/flexlink.exe"
endif
CAMLOPT=$(FLEXLINK_ENV) $(CAMLRUN) ../ocamlopt -I ../stdlib
COMPFLAGS=-warn-error A
LINKFLAGS=
YACCFLAGS=-v

View File

@ -1,9 +1,20 @@
The present documentation is copyright Institut National de Recherche en Informatique et en Automatique (INRIA).
The present documentation is copyright Institut National de Recherche
en Informatique et en Automatique (INRIA).
The OCaml documentation and user's manual may be reproduced and distributed in whole or in part, subject to the following conditions:
The OCaml documentation and user's manual may be reproduced and
distributed in whole or in part, subject to the following conditions:
- The copyright notice above and this permission notice must be preserved complete on all complete or partial copies.
- Any translation or derivative work of the OCaml documentation and user's manual must be approved by the authors in writing before distribution.
- If you distribute the OCaml documentation and user's manual in part, instructions for obtaining the complete version of this manual must be included, and a means for obtaining a complete version provided.
- Small portions may be reproduced as illustrations for reviews or quotes in other works without this permission notice if proper citation is given.
- The copyright notice above and this permission notice must be
preserved complete on all complete or partial copies.
- Any translation or derivative work of the OCaml documentation and
user's manual must be approved by the authors in writing before
distribution.
- If you distribute the OCaml documentation and user's manual in part,
instructions for obtaining the complete version of this manual must
be included, and a means for obtaining a complete version provided.
- Small portions may be reproduced as illustrations for reviews or
quotes in other works without this permission notice if proper
citation is given.

View File

@ -46,7 +46,7 @@ close(ML);
open(TOPLEVEL, "$camllight 2>&1 < .input.ml |") ||
die("Cannot start camllight : $!");
<TOPLEVEL>; <TOPLEVEL>; # skip the banner
<TOPLEVEL>; <TOPLEVEL>; # skip the banner
$lastread = <TOPLEVEL>;
$lastread =~ s/^# //;

View File

@ -18,7 +18,13 @@ CAMLYACC ?= ../boot/ocamlyacc
##########################
ROOTDIR = ..
OCAMLC = $(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib
OCAMLOPT = $(if $(wildcard $(ROOTDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe") $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib -I $(ROOTDIR)/stdlib
ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile)" ""
FLEXLINK_ENV=
else
FLEXLINK_ENV=OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe"
endif
OCAMLOPT = $(FLEXLINK_ENV) $(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \
-I $(ROOTDIR)/stdlib
OCAMLDEP = $(CAMLRUN) $(ROOTDIR)/tools/ocamldep
OCAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
OCAMLLIB = $(LIBDIR)

View File

@ -78,7 +78,7 @@ let simpl_class_type t =
match t with
Types.Cty_constr (p,texp_list,ct) -> t
| Types.Cty_signature cs ->
(* we delete vals and methods in order to not print them when
(* we delete vals and methods in order to not print them when
displaying the type *)
let tnil = { Types.desc = Types.Tnil ; Types.level = 0; Types.id = 0 } in
Types.Cty_signature { Types.csig_self = { cs.Types.csig_self with

View File

@ -779,9 +779,23 @@ module Analyser =
pos_limit2
type_decl
in
print_DEBUG ("Type "^name.txt^" : "^(match assoc_com with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c));
let f_DEBUG (name, c_opt) = print_DEBUG ("constructor/field "^name^": "^(match c_opt with None -> "sans commentaire" | Some c -> Odoc_misc.string_of_info c)) in
List.iter f_DEBUG name_comment_list;
(* DEBUG *) begin
(* DEBUG *) let comm =
(* DEBUG *) match assoc_com with
(* DEBUG *) | None -> "sans commentaire"
(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
(* DEBUG *) in
(* DEBUG *) print_DEBUG ("Type "^name.txt^" : "^comm);
(* DEBUG *) let f_DEBUG (name, c_opt) =
(* DEBUG *) let comm =
(* DEBUG *) match c_opt with
(* DEBUG *) | None -> "sans commentaire"
(* DEBUG *) | Some c -> Odoc_misc.string_of_info c
(* DEBUG *) in
(* DEBUG *) print_DEBUG ("constructor/field "^name^": "^comm)
(* DEBUG *) in
(* DEBUG *) List.iter f_DEBUG name_comment_list;
(* DEBUG *) end
(* get the information for the type in the signature *)
let sig_type_decl =
try Signature_search.search_type table name.txt

View File

@ -15,9 +15,11 @@
include ../Makefile
export OCAML_FLEXLINK:=$(if $(wildcard $(ROOTDIR)/flexdll/Makefile),$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe)
# The Unix version now works fine under Windows
ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile" ""
export OCAML_FLEXLINK:=
else
export OCAML_FLEXLINK:=$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe
endif
# Note .. is the current directory (this makefile is included from
# a subdirectory)

View File

@ -11,8 +11,6 @@
# #
#########################################################################
# $Id$
# Makefile for the "num" (exact rational arithmetic) library
LIBNAME=nums

View File

@ -11,8 +11,6 @@
# #
#########################################################################
# $Id$
# Makefile for the "num" (exact rational arithmetic) library
LIBNAME=nums

View File

@ -438,9 +438,12 @@ let sys_big_int_of_string_base s ofs len sgn =
if len < 2 then sys_big_int_of_string_aux s ofs len sgn 10
else
match (s.[ofs], s.[ofs+1]) with
| ('0', 'x') | ('0', 'X') -> sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 16
| ('0', 'o') | ('0', 'O') -> sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 8
| ('0', 'b') | ('0', 'B') -> sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 2
| ('0', 'x') | ('0', 'X') ->
sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 16
| ('0', 'o') | ('0', 'O') ->
sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 8
| ('0', 'b') | ('0', 'B') ->
sys_big_int_of_string_aux s (ofs+2) (len-2) sgn 2
| _ -> sys_big_int_of_string_aux s ofs len sgn 10
;;
@ -722,7 +725,7 @@ let two_power_m1_big_int n =
let idx = n / length_of_digit in
let size_res = idx + 1 in
let res = make_nat size_res in
set_digit_nat_native res idx
set_digit_nat_native res idx
(Nativeint.shift_left 1n (n mod length_of_digit));
ignore (decr_nat res 0 size_res 0);
{ sign = 1; abs_value = res }
@ -733,7 +736,8 @@ let two_power_m1_big_int n =
let shift_right_big_int bi n =
if n < 0 then invalid_arg "shift_right_big_int"
else if bi.sign >= 0 then shift_right_towards_zero_big_int bi n
else shift_right_towards_zero_big_int (sub_big_int bi (two_power_m1_big_int n)) n
else
shift_right_towards_zero_big_int (sub_big_int bi (two_power_m1_big_int n)) n
(* Extract N bits starting at ofs.
Treats bi in two's complement.
@ -845,7 +849,7 @@ let xor_big_int a b =
(* Consider a real number [r] such that
- the integral part of [r] is the bigint [x]
- 2^54 <= |x| < 2^63
- the fractional part of [r] is 0 if [exact = true],
- the fractional part of [r] is 0 if [exact = true],
nonzero if [exact = false].
Then, the following function returns [r] correctly rounded to
the nearest double-precision floating-point number.
@ -875,4 +879,3 @@ let float_of_big_int x =
(* Round to float and apply exponent *)
ldexp (round_big_int_to_float top exact) n
end

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
#include "bng.h"
#include "caml/config.h"

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
#include <string.h>
#include "caml/config.h"

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the AMD x86_64 architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/**** Generic operations on digits ****/
/* These macros can be defined in the machine-specific include file.

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the Intel IA32 (x86) architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the PowerPC architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Code specific to the SPARC (V8 and above) architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
/* Nats are represented as unstructured blocks with tag Custom_tag. */
#define Digit_val(nat,pos) (((bng) Data_custom_val(nat))[pos])

View File

@ -20,28 +20,44 @@ external set_to_zero_nat: nat -> int -> int -> unit = "set_to_zero_nat"
external blit_nat: nat -> int -> nat -> int -> int -> unit = "blit_nat"
external set_digit_nat: nat -> int -> int -> unit = "set_digit_nat"
external nth_digit_nat: nat -> int -> int = "nth_digit_nat"
external set_digit_nat_native: nat -> int -> nativeint -> unit = "set_digit_nat_native"
external set_digit_nat_native: nat -> int -> nativeint -> unit
= "set_digit_nat_native"
external nth_digit_nat_native: nat -> int -> nativeint = "nth_digit_nat_native"
external num_digits_nat: nat -> int -> int -> int = "num_digits_nat"
external num_leading_zero_bits_in_digit: nat -> int -> int = "num_leading_zero_bits_in_digit"
external num_leading_zero_bits_in_digit: nat -> int -> int
= "num_leading_zero_bits_in_digit"
external is_digit_int: nat -> int -> bool = "is_digit_int"
external is_digit_zero: nat -> int -> bool = "is_digit_zero"
external is_digit_normalized: nat -> int -> bool = "is_digit_normalized"
external is_digit_odd: nat -> int -> bool = "is_digit_odd"
external incr_nat: nat -> int -> int -> int -> int = "incr_nat"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "add_nat" "add_nat_native"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "add_nat" "add_nat_native"
external complement_nat: nat -> int -> int -> unit = "complement_nat"
external decr_nat: nat -> int -> int -> int -> int = "decr_nat"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "sub_nat" "sub_nat_native"
external mult_digit_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int = "mult_digit_nat" "mult_digit_nat_native"
external mult_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int = "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int = "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_left_nat" "shift_left_nat_native"
external div_digit_nat: nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit = "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit = "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int = "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int = "compare_nat" "compare_nat_native"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "sub_nat" "sub_nat_native"
external mult_digit_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int
= "mult_digit_nat" "mult_digit_nat_native"
external mult_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int
= "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int
= "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_left_nat" "shift_left_nat_native"
external div_digit_nat:
nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit
= "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit
= "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int
= "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int
= "compare_nat" "compare_nat_native"
external land_digit_nat: nat -> int -> nat -> int -> unit = "land_digit_nat"
external lor_digit_nat: nat -> int -> nat -> int -> unit = "lor_digit_nat"
external lxor_digit_nat: nat -> int -> nat -> int -> unit = "lxor_digit_nat"

View File

@ -25,11 +25,13 @@ external blit_nat: nat -> int -> nat -> int -> int -> unit = "blit_nat"
val copy_nat: nat -> int -> int -> nat
external set_digit_nat: nat -> int -> int -> unit = "set_digit_nat"
external nth_digit_nat: nat -> int -> int = "nth_digit_nat"
external set_digit_nat_native: nat -> int -> nativeint -> unit = "set_digit_nat_native"
external set_digit_nat_native: nat -> int -> nativeint -> unit
= "set_digit_nat_native"
external nth_digit_nat_native: nat -> int -> nativeint = "nth_digit_nat_native"
val length_nat : nat -> int
external num_digits_nat: nat -> int -> int -> int = "num_digits_nat"
external num_leading_zero_bits_in_digit: nat -> int -> int = "num_leading_zero_bits_in_digit"
external num_leading_zero_bits_in_digit: nat -> int -> int
= "num_leading_zero_bits_in_digit"
external is_digit_int: nat -> int -> bool = "is_digit_int"
external is_digit_zero: nat -> int -> bool = "is_digit_zero"
external is_digit_normalized: nat -> int -> bool = "is_digit_normalized"
@ -39,19 +41,33 @@ val is_nat_int: nat -> int -> int -> bool
val int_of_nat: nat -> int
val nat_of_int: int -> nat
external incr_nat: nat -> int -> int -> int -> int = "incr_nat"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "add_nat" "add_nat_native"
external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "add_nat" "add_nat_native"
external complement_nat: nat -> int -> int -> unit = "complement_nat"
external decr_nat: nat -> int -> int -> int -> int = "decr_nat"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int = "sub_nat" "sub_nat_native"
external mult_digit_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int = "mult_digit_nat" "mult_digit_nat_native"
external mult_nat: nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int = "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int = "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_left_nat" "shift_left_nat_native"
external div_digit_nat: nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit = "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit = "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit = "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int = "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int = "compare_nat" "compare_nat_native"
external sub_nat: nat -> int -> int -> nat -> int -> int -> int -> int
= "sub_nat" "sub_nat_native"
external mult_digit_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int
= "mult_digit_nat" "mult_digit_nat_native"
external mult_nat:
nat -> int -> int -> nat -> int -> int -> nat -> int -> int -> int
= "mult_nat" "mult_nat_native"
external square_nat: nat -> int -> int -> nat -> int -> int -> int
= "square_nat" "square_nat_native"
external shift_left_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_left_nat" "shift_left_nat_native"
external div_digit_nat:
nat -> int -> nat -> int -> nat -> int -> int -> nat -> int -> unit
= "div_digit_nat" "div_digit_nat_native"
external div_nat: nat -> int -> int -> nat -> int -> int -> unit
= "div_nat" "div_nat_native"
external shift_right_nat: nat -> int -> int -> nat -> int -> int -> unit
= "shift_right_nat" "shift_right_nat_native"
external compare_digits_nat: nat -> int -> nat -> int -> int
= "compare_digits_nat"
external compare_nat: nat -> int -> int -> nat -> int -> int -> int
= "compare_nat" "compare_nat_native"
val eq_nat : nat -> int -> int -> nat -> int -> int -> bool
val le_nat : nat -> int -> int -> nat -> int -> int -> bool
val lt_nat : nat -> int -> int -> nat -> int -> int -> bool

View File

@ -11,8 +11,6 @@
/* */
/***********************************************************************/
/* $Id$ */
#include "caml/alloc.h"
#include "caml/config.h"
#include "caml/custom.h"
@ -123,7 +121,8 @@ CAMLprim value is_digit_zero(value nat, value ofs)
CAMLprim value is_digit_normalized(value nat, value ofs)
{
return
Val_bool(Digit_val(nat, Long_val(ofs)) & ((bngdigit)1 << (BNG_BITS_PER_DIGIT-1)));
Val_bool(Digit_val(nat, Long_val(ofs))
& ((bngdigit)1 << (BNG_BITS_PER_DIGIT-1)));
}
CAMLprim value is_digit_odd(value nat, value ofs)

View File

@ -179,7 +179,7 @@ A correct but slow implementation is:
if b >= 0 then floor_num (div_num a b)
else minus_num (floor_num (div_num a (minus_num b)))
mod_num a b =
mod_num a b =
sub_num a (mult_num b (quo_num a b))
However, this definition is vastly inefficient (cf PR #3473):
@ -197,7 +197,7 @@ let quo_num n1 n2 =
Int (if r >= 0 then q else if i2 > 0 then q - 1 else q + 1)
| Int i1, Big_int bi2 ->
num_of_big_int (div_big_int (big_int_of_int i1) bi2)
| Int i1, Ratio r2 ->
| Int i1, Ratio r2 ->
num_of_big_int (report_sign_ratio r2
(floor_ratio (div_int_ratio i1 (abs_ratio r2))))
| Big_int bi1, Int i2 ->

View File

@ -27,7 +27,11 @@ endif
MKLIB=$(CAMLRUN) ../../tools/ocamlmklib
CFLAGS=-I../../byterun $(EXTRACFLAGS)
export OCAML_FLEXLINK:=$(if $(wildcard ../../flexdll/Makefile),../../boot/ocamlrun ../../flexdll/flexlink.exe)
ifeq "$(wildcard ../../flexdll/Makefile)" ""
export OCAML_FLEXLINK:=
else
export OCAML_FLEXLINK:=../../boot/ocamlrun ../../flexdll/flexlink.exe
endif
CAMLOBJS=thread.cmo mutex.cmo condition.cmo event.cmo threadUnix.cmo
CMIFILES=$(CAMLOBJS:.cmo=.cmi)

View File

@ -28,7 +28,7 @@
CAMLprim value unix_initgroups(value user, value group)
{
if (! caml_string_is_c_safe(user))
if (! caml_string_is_c_safe(user))
unix_error(EINVAL, "initgroups", user);
if (initgroups(String_val(user), Int_val(group)) == -1) {
uerror("initgroups", Nothing);

View File

@ -312,4 +312,3 @@ void caml_unix_check_path(value path, char * cmdname)
{
if (! caml_string_is_c_safe(path)) unix_error(ENOENT, cmdname, path);
}

View File

@ -34,7 +34,7 @@ CAMLprim value unix_utimes(value path, value atime, value mtime)
mt = Double_val(mtime);
if (at == 0.0 && mt == 0.0) {
t = (struct timeval *) NULL;
} else {
} else {
tv[0].tv_sec = at;
tv[0].tv_usec = (at - tv[0].tv_sec) * 1000000;
tv[1].tv_sec = mt;
@ -71,7 +71,7 @@ CAMLprim value unix_utimes(value path, value atime, value mtime)
mt = Double_val(mtime);
if (at == 0.0 && mt == 0.0) {
t = (struct utimbuf *) NULL;
} else {
} else {
times.actime = at;
times.modtime = mt;
t = &times;
@ -91,4 +91,3 @@ CAMLprim value unix_utimes(value path, value atime, value mtime)
{ invalid_argument("utimes not implemented"); }
#endif

View File

@ -63,7 +63,8 @@ let check_deprecated loc attrs s =
match deprecated_of_attrs attrs with
| None -> ()
| Some "" -> Location.prerr_warning loc (Warnings.Deprecated s)
| Some txt -> Location.prerr_warning loc (Warnings.Deprecated (s ^ "\n" ^ txt))
| Some txt ->
Location.prerr_warning loc (Warnings.Deprecated (s ^ "\n" ^ txt))
let rec check_deprecated_mutable loc attrs s =
match attrs with
@ -173,7 +174,8 @@ let with_warning_attribute attrs f =
let warn_on_literal_pattern =
List.exists
(function
| ({txt="ocaml.warn_on_literal_pattern"|"warn_on_literal_pattern"; _}, _) -> true
| ({txt="ocaml.warn_on_literal_pattern"|"warn_on_literal_pattern"; _}, _)
-> true
| _ -> false
)

View File

@ -28,7 +28,8 @@ val deprecated_of_attrs: Parsetree.attributes -> string option
val deprecated_of_sig: Parsetree.signature -> string option
val deprecated_of_str: Parsetree.structure -> string option
val check_deprecated_mutable: Location.t -> Parsetree.attributes -> string -> unit
val check_deprecated_mutable:
Location.t -> Parsetree.attributes -> string -> unit
val error_of_extension: Parsetree.extension -> Location.error

View File

@ -775,7 +775,8 @@ module_expr:
{ mkmod ~attrs:$3
(Pmod_unpack(
ghexp(Pexp_constraint($4, ghtyp(Ptyp_package $6))))) }
| LPAREN VAL attributes expr COLON package_type COLONGREATER package_type RPAREN
| LPAREN VAL attributes expr COLON package_type COLONGREATER package_type
RPAREN
{ mkmod ~attrs:$3
(Pmod_unpack(
ghexp(Pexp_coerce($4, Some(ghtyp(Ptyp_package $6)),
@ -864,7 +865,8 @@ module_binding:
;
rec_module_bindings:
rec_module_binding { let (b, ext) = $1 in ([b], ext) }
| rec_module_bindings and_module_binding { let (l, ext) = $1 in ($2 :: l, ext) }
| rec_module_bindings and_module_binding
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
rec_module_binding:
MODULE ext_attributes REC UIDENT module_binding_body post_item_attributes
@ -989,8 +991,10 @@ module_alias:
, ext }
;
rec_module_declarations:
rec_module_declaration { let (body, ext) = $1 in ([body], ext) }
| rec_module_declarations and_module_declaration { let (l, ext) = $1 in ($2 :: l, ext) }
rec_module_declaration
{ let (body, ext) = $1 in ([body], ext) }
| rec_module_declarations and_module_declaration
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
rec_module_declaration:
MODULE ext_attributes REC UIDENT COLON module_type post_item_attributes
@ -1009,7 +1013,8 @@ module_type_declaration_body:
| EQUAL module_type { Some $2 }
;
module_type_declaration:
MODULE TYPE ext_attributes ident module_type_declaration_body post_item_attributes
MODULE TYPE ext_attributes ident module_type_declaration_body
post_item_attributes
{ let (ext, attrs) = $3 in
Mtd.mk (mkrhs $4 4) ?typ:$5 ~attrs:(attrs@$6)
~loc:(symbol_rloc()) ~docs:(symbol_docs ())
@ -1018,12 +1023,14 @@ module_type_declaration:
/* Class expressions */
class_declarations:
class_declaration { let (body, ext) = $1 in ([body], ext) }
| class_declarations and_class_declaration { let (l, ext) = $1 in ($2 :: l, ext) }
class_declaration
{ let (body, ext) = $1 in ([body], ext) }
| class_declarations and_class_declaration
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
class_declaration:
CLASS ext_attributes virtual_flag class_type_parameters LIDENT class_fun_binding
post_item_attributes
CLASS ext_attributes virtual_flag class_type_parameters LIDENT
class_fun_binding post_item_attributes
{ let (ext, attrs) = $2 in
Ci.mk (mkrhs $5 5) $6 ~virt:$3 ~params:$4 ~attrs:(attrs@$7)
~loc:(symbol_rloc ()) ~docs:(symbol_docs ())
@ -1105,7 +1112,8 @@ class_fields:
{ $2 :: (text_cstr 2) @ $1 }
;
class_field:
| INHERIT override_flag attributes class_expr parent_binder post_item_attributes
| INHERIT override_flag attributes class_expr parent_binder
post_item_attributes
{ mkcf (Pcf_inherit ($2, $4, $5)) ~attrs:($3@$6) ~docs:(symbol_docs ()) }
| VAL attributes value post_item_attributes
{ mkcf (Pcf_val $3) ~attrs:($2@$4) ~docs:(symbol_docs ()) }
@ -1240,12 +1248,14 @@ constrain_field:
core_type EQUAL core_type { $1, $3 }
;
class_descriptions:
class_description { let (body, ext) = $1 in ([body],ext) }
| class_descriptions and_class_description { let (l, ext) = $1 in ($2 :: l, ext) }
class_description
{ let (body, ext) = $1 in ([body],ext) }
| class_descriptions and_class_description
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
class_description:
CLASS ext_attributes virtual_flag class_type_parameters LIDENT COLON class_type
post_item_attributes
CLASS ext_attributes virtual_flag class_type_parameters LIDENT COLON
class_type post_item_attributes
{ let (ext, attrs) = $2 in
Ci.mk (mkrhs $5 5) $7 ~virt:$3 ~params:$4 ~attrs:$8
~loc:(symbol_rloc ()) ~docs:(symbol_docs ())
@ -1259,8 +1269,10 @@ and_class_description:
~text:(symbol_text ()) ~docs:(symbol_docs ()) }
;
class_type_declarations:
class_type_declaration { let (body, ext) = $1 in ([body],ext) }
| class_type_declarations and_class_type_declaration { let (l, ext) = $1 in ($2 :: l, ext) }
class_type_declaration
{ let (body, ext) = $1 in ([body],ext) }
| class_type_declarations and_class_type_declaration
{ let (l, ext) = $1 in ($2 :: l, ext) }
;
class_type_declaration:
CLASS TYPE ext_attributes virtual_flag class_type_parameters LIDENT EQUAL
@ -1547,7 +1559,8 @@ simple_expr:
$3 }
| LPAREN MODULE ext_attributes module_expr COLON error
{ unclosed "(" 1 ")" 6 }
| mod_longident DOT LPAREN MODULE ext_attributes module_expr COLON package_type RPAREN
| mod_longident DOT LPAREN MODULE ext_attributes module_expr COLON
package_type RPAREN
{ mkexp(Pexp_open(Fresh, mkrhs $1 1,
mkexp_attrs (Pexp_constraint (ghexp (Pexp_pack $6),
ghtyp (Ptyp_package $8)))
@ -1641,8 +1654,10 @@ match_case:
{ Exp.case $1 (Exp.unreachable ~loc:(rhs_loc 3) ())}
;
fun_def:
MINUSGREATER seq_expr { $2 }
| COLON simple_core_type MINUSGREATER seq_expr { mkexp (Pexp_constraint ($4, $2)) }
MINUSGREATER seq_expr
{ $2 }
| COLON simple_core_type MINUSGREATER seq_expr
{ mkexp (Pexp_constraint ($4, $2)) }
/* Cf #5939: we used to accept (fun p when e0 -> e) */
| labeled_simple_pattern fun_def
{
@ -1830,8 +1845,8 @@ primitive_declaration_body:
| STRING primitive_declaration_body { fst $1 :: $2 }
;
primitive_declaration:
EXTERNAL ext_attributes val_ident COLON core_type EQUAL primitive_declaration_body
post_item_attributes
EXTERNAL ext_attributes val_ident COLON core_type EQUAL
primitive_declaration_body post_item_attributes
{ let (ext, attrs) = $2 in
Val.mk (mkrhs $3 3) $5 ~prim:$7 ~attrs:(attrs@$8)
~loc:(symbol_rloc ()) ~docs:(symbol_docs ())
@ -1848,8 +1863,8 @@ type_declarations:
;
type_declaration:
TYPE ext_attributes nonrec_flag optional_type_parameters LIDENT type_kind constraints
post_item_attributes
TYPE ext_attributes nonrec_flag optional_type_parameters LIDENT
type_kind constraints post_item_attributes
{ let (kind, priv, manifest) = $6 in
let (ext, attrs) = $2 in
let ty =
@ -1962,8 +1977,8 @@ str_exception_declaration:
, ext }
;
sig_exception_declaration:
| EXCEPTION ext_attributes constr_ident generalized_constructor_arguments attributes
post_item_attributes
| EXCEPTION ext_attributes constr_ident generalized_constructor_arguments
attributes post_item_attributes
{ let args, res = $4 in
let (ext,attrs) = $2 in
Te.decl (mkrhs $3 3) ~args ?res ~attrs:($5 @ $6)
@ -2256,17 +2271,17 @@ label:
/* Constants */
constant:
| INT { let (n, m) = $1 in Pconst_integer (n, m) }
| CHAR { Pconst_char $1 }
| STRING { let (s, d) = $1 in Pconst_string (s, d) }
| FLOAT { let (f, m) = $1 in Pconst_float (f, m) }
| INT { let (n, m) = $1 in Pconst_integer (n, m) }
| CHAR { Pconst_char $1 }
| STRING { let (s, d) = $1 in Pconst_string (s, d) }
| FLOAT { let (f, m) = $1 in Pconst_float (f, m) }
;
signed_constant:
constant { $1 }
| MINUS INT { let (n, m) = $2 in Pconst_integer("-" ^ n, m) }
| MINUS FLOAT { let (f, m) = $2 in Pconst_float("-" ^ f, m) }
| PLUS INT { let (n, m) = $2 in Pconst_integer (n, m) }
| PLUS FLOAT { let (f, m) = $2 in Pconst_float(f, m) }
constant { $1 }
| MINUS INT { let (n, m) = $2 in Pconst_integer("-" ^ n, m) }
| MINUS FLOAT { let (f, m) = $2 in Pconst_float("-" ^ f, m) }
| PLUS INT { let (n, m) = $2 in Pconst_integer (n, m) }
| PLUS FLOAT { let (f, m) = $2 in Pconst_float(f, m) }
;
/* Identifiers and long identifiers */
@ -2363,7 +2378,8 @@ class_longident:
toplevel_directive:
SHARP ident { Ptop_dir($2, Pdir_none) }
| SHARP ident STRING { Ptop_dir($2, Pdir_string (fst $3)) }
| SHARP ident INT { let (n, m) = $3 in Ptop_dir($2, Pdir_int (n ,m)) }
| SHARP ident INT { let (n, m) = $3 in
Ptop_dir($2, Pdir_int (n ,m)) }
| SHARP ident val_longident { Ptop_dir($2, Pdir_ident $3) }
| SHARP ident mod_longident { Ptop_dir($2, Pdir_ident $3) }
| SHARP ident FALSE { Ptop_dir($2, Pdir_bool false) }

View File

@ -172,9 +172,11 @@ class printer ()= object(self:'self)
| Pconst_string (i, None) -> pp f "%S" i
| Pconst_string (i, Some delim) -> pp f "{%s|%s|%s}" delim i delim
| Pconst_integer (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i
| Pconst_integer (i,Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
| Pconst_integer (i,Some m) ->
self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
| Pconst_float (i,None) -> self#paren (i.[0]='-') (fun f -> pp f "%s") f i
| Pconst_float (i, Some m) -> self#paren (i.[0]='-') (fun f (i,m) -> pp f "%s%c" i m) f (i,m)
| Pconst_float (i, Some m) -> self#paren (i.[0]='-') (fun f (i,m) ->
pp f "%s%c" i m) f (i,m)
(* trailing space*)
method mutable_flag f = function

View File

@ -78,7 +78,8 @@ let iter f a =
for i = 0 to length a - 1 do f(unsafe_get a i) done
let iter2 f a b =
if length a <> length b then invalid_arg "Array.iter2: arrays must have the same length"
if length a <> length b then
invalid_arg "Array.iter2: arrays must have the same length"
else
for i = 0 to length a - 1 do f (unsafe_get a i) (unsafe_get b i) done
@ -95,7 +96,9 @@ let map f a =
let map2 f a b =
let la = length a in
let lb = length b in
if la <> lb then invalid_arg "Array.map2: arrays must have the same length" else begin
if la <> lb then
invalid_arg "Array.map2: arrays must have the same length"
else begin
if la = 0 then [||] else begin
let r = create la (f (unsafe_get a 0) (unsafe_get b 0)) in
for i = 1 to la - 1 do

View File

@ -941,7 +941,7 @@ let scan_caml_float width precision ib =
if width = 0 || Scanning.end_of_input ib then bad_float ();
scan_caml_float_rest width precision ib
(* Special case of nan and infinity:
| 'i' ->
| 'i' ->
| 'n' ->
*)
| _ -> bad_float ()

View File

@ -555,4 +555,3 @@ val kfscanf :
('a, 'b, 'c, 'd) scanner
[@@ocaml.deprecated "Use Scanning.from_channel then Scanf.kscanf."]
(** @deprecated [Scanf.kfscanf] is error prone and deprecated since 4.03.0. *)

View File

@ -119,7 +119,10 @@ let rec nget_data n s =
;;
let npeek_data n s =
let (al, d, len) = nget_data n s in s.count <- (s.count - len); s.data <- d; al
let (al, d, len) = nget_data n s in
s.count <- (s.count - len);
s.data <- d;
al
;;
let npeek n = function

View File

@ -23,7 +23,8 @@ default:
@echo " all launch all tests"
@echo " all-foo launch all tests beginning with foo"
@echo " parallel launch all tests using GNU parallel"
@echo " parallel-foo launch all tests beginning with foo using GNU parallel"
@echo " parallel-foo launch all tests beginning with foo using \
GNU parallel"
@echo " list FILE=f launch the tests listed in f (one per line)"
@echo " one DIR=p launch the tests located in path p"
@echo " promote DIR=p promote the reference files for the tests in p"
@ -31,8 +32,9 @@ default:
@echo " clean delete generated files"
@echo " report print the report for the last execution"
@echo
@echo "all*, parallel* and list can automatically re-run failed test directories if"
@echo "MAX_TESTSUITE_DIR_RETRIES permits (default value = $(MAX_TESTSUITE_DIR_RETRIES))"
@echo "all*, parallel* and list can automatically re-run failed test"
@echo "directories if MAX_TESTSUITE_DIR_RETRIES permits"
@echo "(default value = $(MAX_TESTSUITE_DIR_RETRIES))"
.PHONY: all
all: lib
@ -183,7 +185,8 @@ retry-list:
@$(MAKE) $(NO_PRINT) retries
retries:
@awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) -f makefiles/summarize.awk <_log >_retries
@awk -v retries=1 -v max_retries=$(MAX_TESTSUITE_DIR_RETRIES) \
-f makefiles/summarize.awk <_log >_retries
@test `cat _retries | wc -l` -eq 0 || $(MAKE) $(NO_PRINT) retry-list
@rm -f _retries

View File

@ -43,10 +43,12 @@ include $(TOPDIR)/config/Makefile
ifneq ($(USE_RUNTIME),)
#Check USE_RUNTIME value
ifeq ($(findstring $(USE_RUNTIME),d i),)
$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) or "i" (instrumented runtime))
$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) \
or "i" (instrumented runtime))
endif
RUNTIME_VARIANT=-I $(OTOPDIR)/asmrun -I $(OTOPDIR)/byterun -runtime-variant $(USE_RUNTIME)
RUNTIME_VARIANT=-I $(OTOPDIR)/asmrun -I $(OTOPDIR)/byterun \
-runtime-variant $(USE_RUNTIME)
export OCAMLRUNPARAM?=v=0
endif
@ -63,9 +65,20 @@ endif
OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml $(OCFLAGS) \
-init $(OTOPDIR)/testsuite/lib/empty
FLEXLINK_PREFIX=$(if $(FLEXLINK),$(if $(wildcard $(TOPDIR)/flexdll/Makefile),OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe" ))
OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) $(RUNTIME_VARIANT)
OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) $(RUNTIME_VARIANT)
ifeq "$(FLEXLINK)" ""
FLEXLINK_PREFIX=
else
ifeq "$(wildcard $(TOPDIR)/flexdll/Makefile)" ""
FLEXLINK_PREFIX=
else
FLEXLINK_PREFIX=OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun \
$(WINTOPDIR)/flexdll/flexlink.exe"
endif
endif
OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc $(CUSTOM) $(OCFLAGS) \
$(RUNTIME_VARIANT)
OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt $(OCFLAGS) \
$(RUNTIME_VARIANT)
OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc
OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex
OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib \
@ -130,7 +143,9 @@ defaultclean:
@$(ASM) -o $*.o $*.s
.cmm.obj:
@$(OCAMLRUN) ./codegen $*.cmm | grep -v "_caml_\(young_ptr\|young_limit\|extra_params\|allocN\|raise_exn\|reraise_exn\)" > $*.s
@$(OCAMLRUN) ./codegen $*.cmm \
| grep -v "_caml_\(young_ptr\|young_limit\|extra_params\
\|allocN\|raise_exn\|reraise_exn\)" > $*.s
@set -o pipefail ; \
$(ASM) $*.obj $*.s | tail -n +2

View File

@ -18,7 +18,7 @@ let f () =
let () = (f [@inlined never]) ()
(* Closed functions should be static *)
let closed_function x = x + 1 (* + is a primitive, it cannot be in the closure *)
let closed_function x = x + 1 (* + is a primitive, it cannot be in the closure*)
let () = assert(is_in_static_data closed_function)
(* And functions using closed functions *)

View File

@ -283,7 +283,7 @@ static intnat mulhs(intnat u, intnat v)
#define RAND_C 1442695040888963407ULL
#else
#define RAND_A 214013U
#define RAND_C 2531011U
#define RAND_C 2531011U
#endif
static intnat rnd(void)

View File

@ -210,11 +210,14 @@ expr:
| LPAREN FLOATAREF expr expr RPAREN
{ Cop(Cload Double_u, [access_array $3 $4 Arch.size_float]) }
| LPAREN ADDRASET expr expr expr RPAREN
{ Cop(Cstore (Word_val, Assignment), [access_array $3 $4 Arch.size_addr; $5]) }
{ Cop(Cstore (Word_val, Assignment),
[access_array $3 $4 Arch.size_addr; $5]) }
| LPAREN INTASET expr expr expr RPAREN
{ Cop(Cstore (Word_int, Assignment), [access_array $3 $4 Arch.size_int; $5]) }
{ Cop(Cstore (Word_int, Assignment),
[access_array $3 $4 Arch.size_int; $5]) }
| LPAREN FLOATASET expr expr expr RPAREN
{ Cop(Cstore (Double_u, Assignment), [access_array $3 $4 Arch.size_float; $5]) }
{ Cop(Cstore (Double_u, Assignment),
[access_array $3 $4 Arch.size_float; $5]) }
;
exprlist:
exprlist expr { $2 :: $1 }

View File

@ -5,15 +5,15 @@
#define CAML_NEGF_MASK caml_negf_mask
#define CAML_ABSF_MASK caml_absf_mask
.section ".text"
.globl CALL_GEN_CODE
.type CALL_GEN_CODE, @function
.align ALIGN
.section ".text"
.globl CALL_GEN_CODE
.type CALL_GEN_CODE, @function
.align ALIGN
CALL_GEN_CODE:
/* Stack space */
lay %r15, -144(%r15)
/* Save registers */
/* Stack space */
lay %r15, -144(%r15)
/* Save registers */
stmg %r6,%r14, 0(%r15)
std %f8, 72(%r15)
std %f9, 80(%r15)
@ -23,14 +23,14 @@ CALL_GEN_CODE:
std %f13, 112(%r15)
std %f14, 120(%r15)
std %f15, 128(%r15)
/* Shuffle args */
lgr %r1, %r2
lgr %r2, %r3
lgr %r3, %r4
lgr %r4, %r5
/* Function call */
basr %r14, %r1
/* Restore registers */
/* Shuffle args */
lgr %r1, %r2
lgr %r2, %r3
lgr %r3, %r4
lgr %r4, %r5
/* Function call */
basr %r14, %r1
/* Restore registers */
lmg %r6,%r14, 0(%r15)
ld %f8, 72(%r15)
ld %f9, 80(%r15)
@ -40,23 +40,23 @@ CALL_GEN_CODE:
ld %f13, 112(%r15)
ld %f14, 120(%r15)
ld %f15, 128(%r15)
/* Return */
lay %r15, 144(%r15)
br %r14
/* Return */
lay %r15, 144(%r15)
br %r14
.globl CAML_C_CALL
.type CAML_C_CALL, @function
.align ALIGN
.globl CAML_C_CALL
.type CAML_C_CALL, @function
.align ALIGN
CAML_C_CALL:
br %r7
.section ".rodata"
br %r7
.global CAML_NEGF_MASK
.align ALIGN
.section ".rodata"
.global CAML_NEGF_MASK
.align ALIGN
CAML_NEGF_MASK:
.quad 0x8000000000000000, 0
.global CAML_ABSF_MASK
.quad 0x8000000000000000, 0
.global CAML_ABSF_MASK
.align ALIGN
CAML_ABSF_MASK:
.quad 0x7FFFFFFFFFFFFFFF, 0

View File

@ -54,10 +54,12 @@ byte:
skip:
@for file in $(ABCDFILES); do \
for arg in a b c d ''; do \
echo " ... testing '$$file' with ocamlopt and argument '$$arg': => skipped"; \
echo " ... testing '$$file' with ocamlopt and argument '$$arg': \
=> skipped"; \
done; \
done
@for file in $(OTHERFILES) $(OTHERFILESNOINLINING) $(OTHERFILESNOINLINING_NATIVE); do \
@for file in $(OTHERFILES) $(OTHERFILESNOINLINING) \
$(OTHERFILESNOINLINING_NATIVE); do \
echo " ... testing '$$file' with ocamlopt: => skipped"; \
done

View File

@ -4,7 +4,7 @@
# localhost is used to configure the loopback interface
# when the system is booting. Do not change this entry.
##
127.0.0.1 localhost
255.255.255.255 broadcasthost
127.0.0.1 localhost
255.255.255.255 broadcasthost
::1 localhost
fe80::1%lo0 localhost
fe80::1%lo0 localhost

View File

@ -4,28 +4,32 @@ let sequor b1 b2 =
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then true else b2 && if b1 then true else b2) then "true" else "false"
if (if b1 then true else b2 && if b1 then true else b2)
then "true" else "false"
let sequand b1 b2 =
let b1 = ref b1 in
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then b2 else false && if b1 then b2 else false) then "true" else "false"
if (if b1 then b2 else false && if b1 then b2 else false)
then "true" else "false"
let sequor' b1 b2 =
let b1 = ref b1 in
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then true else b2 || if b1 then true else b2) then "true" else "false"
if (if b1 then true else b2 || if b1 then true else b2)
then "true" else "false"
let sequand' b1 b2 =
let b1 = ref b1 in
let b2 = ref b2 in
let b1 = !b1 in
let b2 = !b2 in
if (if b1 then b2 else false || if b1 then b2 else false) then "true" else "false"
if (if b1 then b2 else false || if b1 then b2 else false)
then "true" else "false"
let test b1 b2 =
assert(sequor b1 b2 = if b1 || b2 then "true" else "false");

View File

@ -116,7 +116,8 @@ let () =
(* test generation *)
(*
let values = ["true"; "false"; "true_effect ()"; "false_effect ()"; "unknown_true"; "unknown_false"]
let values = ["true"; "false"; "true_effect ()"; "false_effect ()";
"unknown_true"; "unknown_false"]
let ops = ["||"; "&&"]
let count = ref 0
let f op v1 v2 =

View File

@ -8,4 +8,3 @@ let f () =
let a = -0. in
let b = +0. in
assert(not (a == b))

View File

@ -21,9 +21,13 @@ type t += C
type t += D of int * string
let () =
assert (Obj.extension_constructor M.A == [%extension_constructor M.A]);
assert (Obj.extension_constructor (M.B 42) == [%extension_constructor M.B]);
assert (Obj.extension_constructor C == [%extension_constructor C ]);
assert (Obj.extension_constructor (D (42, "")) == [%extension_constructor D ])
assert (Obj.extension_constructor M.A
== [%extension_constructor M.A]);
assert (Obj.extension_constructor (M.B 42)
== [%extension_constructor M.B]);
assert (Obj.extension_constructor C
== [%extension_constructor C]);
assert (Obj.extension_constructor (D (42, ""))
== [%extension_constructor D])
let () = print_endline "OK"

View File

@ -13,7 +13,10 @@
module S = struct
include Stack
let to_list s = let l = ref [] in iter (fun x -> l := x :: !l) s; !l (* from bottom to top *)
let to_list s = (* from bottom to top *)
let l = ref [] in
iter (fun x -> l := x :: !l) s;
!l
end
let does_raise f s =

View File

@ -389,11 +389,11 @@ let automated_test() =
test_search_forward r n "ething"
[||];
start_test "Search for /^ÿ/";
let r = Str.regexp "^ÿ" in
start_test "Search for /^\255/";
let r = Str.regexp "^\255" in
let n = 0 in
test_search_forward r n "ÿ"
[|"ÿ"|];
test_search_forward r n "\255"
[|"\255"|];
start_test "Search for /^[0-9]+$/";
let r = Str.regexp "^[0-9]+$" in

View File

@ -67,4 +67,3 @@ let _ =
Thread.delay 0.5;
writer client "Client data\n";
Thread.join rd

View File

@ -47,6 +47,3 @@ let _ =
ignore (Thread.create client (addr, "Client #1\n"));
Thread.delay 0.5;
client (addr, "Client #2\n")

View File

@ -49,6 +49,3 @@ let _ =
ignore (Thread.create client (addr, "Client #1\n"));
Thread.delay 0.5;
client (addr, "Client #2\n")

View File

@ -54,4 +54,3 @@ let _ =
finished := true;
List.iter Thread.join [t1; t2; t3; t4; t5];
print_string "passed\n"

View File

@ -1,5 +1,7 @@
let int_with_custom_modifier = 1234567890_1234567890_1234567890_1234567890_1234567890z
let float_with_custom_modifier = 1234567890_1234567890_1234567890_1234567890_1234567890.z
let int_with_custom_modifier =
1234567890_1234567890_1234567890_1234567890_1234567890z
let float_with_custom_modifier =
1234567890_1234567890_1234567890_1234567890_1234567890.z
let int32 = 1234l
let int64 = 1234L

View File

@ -1,86 +1,86 @@
[
structure_item (int_and_float_with_modifier.ml[1,0+0]..[1,0+88])
structure_item (int_and_float_with_modifier.ml[1,0+0]..[2,31+57])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[1,0+4]..[1,0+28])
Ppat_var "int_with_custom_modifier" (int_and_float_with_modifier.ml[1,0+4]..[1,0+28])
expression (int_and_float_with_modifier.ml[1,0+33]..[1,0+88])
expression (int_and_float_with_modifier.ml[2,31+2]..[2,31+57])
Pexp_constant PConst_int (1234567890_1234567890_1234567890_1234567890_1234567890,Some z)
]
structure_item (int_and_float_with_modifier.ml[2,89+0]..[2,89+89])
structure_item (int_and_float_with_modifier.ml[3,89+0]..[4,122+58])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[2,89+4]..[2,89+30])
Ppat_var "float_with_custom_modifier" (int_and_float_with_modifier.ml[2,89+4]..[2,89+30])
expression (int_and_float_with_modifier.ml[2,89+33]..[2,89+89])
pattern (int_and_float_with_modifier.ml[3,89+4]..[3,89+30])
Ppat_var "float_with_custom_modifier" (int_and_float_with_modifier.ml[3,89+4]..[3,89+30])
expression (int_and_float_with_modifier.ml[4,122+2]..[4,122+58])
Pexp_constant PConst_float (1234567890_1234567890_1234567890_1234567890_1234567890.,Some z)
]
structure_item (int_and_float_with_modifier.ml[4,180+0]..[4,180+21])
structure_item (int_and_float_with_modifier.ml[6,182+0]..[6,182+21])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[4,180+4]..[4,180+9])
Ppat_var "int32" (int_and_float_with_modifier.ml[4,180+4]..[4,180+9])
expression (int_and_float_with_modifier.ml[4,180+16]..[4,180+21])
pattern (int_and_float_with_modifier.ml[6,182+4]..[6,182+9])
Ppat_var "int32" (int_and_float_with_modifier.ml[6,182+4]..[6,182+9])
expression (int_and_float_with_modifier.ml[6,182+16]..[6,182+21])
Pexp_constant PConst_int (1234,Some l)
]
structure_item (int_and_float_with_modifier.ml[5,202+0]..[5,202+21])
structure_item (int_and_float_with_modifier.ml[7,204+0]..[7,204+21])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[5,202+4]..[5,202+9])
Ppat_var "int64" (int_and_float_with_modifier.ml[5,202+4]..[5,202+9])
expression (int_and_float_with_modifier.ml[5,202+16]..[5,202+21])
pattern (int_and_float_with_modifier.ml[7,204+4]..[7,204+9])
Ppat_var "int64" (int_and_float_with_modifier.ml[7,204+4]..[7,204+9])
expression (int_and_float_with_modifier.ml[7,204+16]..[7,204+21])
Pexp_constant PConst_int (1234,Some L)
]
structure_item (int_and_float_with_modifier.ml[6,224+0]..[6,224+21])
structure_item (int_and_float_with_modifier.ml[8,226+0]..[8,226+21])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[6,224+4]..[6,224+13])
Ppat_var "nativeint" (int_and_float_with_modifier.ml[6,224+4]..[6,224+13])
expression (int_and_float_with_modifier.ml[6,224+16]..[6,224+21])
pattern (int_and_float_with_modifier.ml[8,226+4]..[8,226+13])
Ppat_var "nativeint" (int_and_float_with_modifier.ml[8,226+4]..[8,226+13])
expression (int_and_float_with_modifier.ml[8,226+16]..[8,226+21])
Pexp_constant PConst_int (1234,Some n)
]
structure_item (int_and_float_with_modifier.ml[8,247+0]..[8,247+32])
structure_item (int_and_float_with_modifier.ml[10,249+0]..[10,249+32])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[8,247+4]..[8,247+24])
Ppat_var "hex_without_modifier" (int_and_float_with_modifier.ml[8,247+4]..[8,247+24])
expression (int_and_float_with_modifier.ml[8,247+27]..[8,247+32])
pattern (int_and_float_with_modifier.ml[10,249+4]..[10,249+24])
Ppat_var "hex_without_modifier" (int_and_float_with_modifier.ml[10,249+4]..[10,249+24])
expression (int_and_float_with_modifier.ml[10,249+27]..[10,249+32])
Pexp_constant PConst_int (0x32f,None)
]
structure_item (int_and_float_with_modifier.ml[9,280+0]..[9,280+32])
structure_item (int_and_float_with_modifier.ml[11,282+0]..[11,282+32])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[9,280+4]..[9,280+21])
Ppat_var "hex_with_modifier" (int_and_float_with_modifier.ml[9,280+4]..[9,280+21])
expression (int_and_float_with_modifier.ml[9,280+27]..[9,280+32])
pattern (int_and_float_with_modifier.ml[11,282+4]..[11,282+21])
Ppat_var "hex_with_modifier" (int_and_float_with_modifier.ml[11,282+4]..[11,282+21])
expression (int_and_float_with_modifier.ml[11,282+27]..[11,282+32])
Pexp_constant PConst_int (0x32,Some g)
]
structure_item (int_and_float_with_modifier.ml[11,314+0]..[11,314+33])
structure_item (int_and_float_with_modifier.ml[13,316+0]..[13,316+33])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[11,314+4]..[11,314+25])
Ppat_var "float_without_modifer" (int_and_float_with_modifier.ml[11,314+4]..[11,314+25])
expression (int_and_float_with_modifier.ml[11,314+28]..[11,314+33])
pattern (int_and_float_with_modifier.ml[13,316+4]..[13,316+25])
Ppat_var "float_without_modifer" (int_and_float_with_modifier.ml[13,316+4]..[13,316+25])
expression (int_and_float_with_modifier.ml[13,316+28]..[13,316+33])
Pexp_constant PConst_float (1.2e3,None)
]
structure_item (int_and_float_with_modifier.ml[12,348+0]..[12,348+32])
structure_item (int_and_float_with_modifier.ml[14,350+0]..[14,350+32])
Pstr_value Nonrec
[
<def>
pattern (int_and_float_with_modifier.ml[12,348+4]..[12,348+22])
Ppat_var "float_with_modifer" (int_and_float_with_modifier.ml[12,348+4]..[12,348+22])
expression (int_and_float_with_modifier.ml[12,348+28]..[12,348+32])
pattern (int_and_float_with_modifier.ml[14,350+4]..[14,350+22])
Ppat_var "float_with_modifer" (int_and_float_with_modifier.ml[14,350+4]..[14,350+22])
expression (int_and_float_with_modifier.ml[14,350+28]..[14,350+32])
Pexp_constant PConst_float (1.2,Some g)
]
]
File "int_and_float_with_modifier.ml", line 1, characters 33-88:
File "int_and_float_with_modifier.ml", line 2, characters 2-57:
Error: Unknown modifier 'z' for literal 1234567890_1234567890_1234567890_1234567890_1234567890z

View File

@ -14,4 +14,3 @@ let _ =
let a = [| 0.0; -. 0.0 |] in
Printf.printf "%Lx %Lx\n"
(Int64.bits_of_float a.(0)) (Int64.bits_of_float a.(1))

View File

@ -52,7 +52,9 @@ run:
echo " => unexpected error"; \
fi; \
fn=`basename $$f bytecode`native; \
if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then echo " ... testing '$$fn': => skipped" ; else \
if $(BYTECODE_ONLY) || [ ! -f "$${fn}$(EXE)" ] ; then \
echo " ... testing '$$fn': => skipped" ; \
else \
printf " ... testing '$$fn':"; \
if [ $$ul -eq 1 ] ; then \
./$${fn}$(EXE) >$$fn.result 2>&1 || true; \

View File

@ -1,7 +1,7 @@
(* empty file *)
(**
0 ATOM0
0 ATOM0
1 SETGLOBAL T000
3 STOP
3 STOP
**)

View File

@ -1,8 +1,8 @@
0;;
(**
0 CONST0
1 ATOM0
0 CONST0
1 ATOM0
2 SETGLOBAL T010-const0
4 STOP
4 STOP
**)

View File

@ -1,8 +1,8 @@
1;;
(**
0 CONST1
1 ATOM0
0 CONST1
1 ATOM0
2 SETGLOBAL T010-const1
4 STOP
4 STOP
**)

View File

@ -1,8 +1,8 @@
2;;
(**
0 CONST2
1 ATOM0
0 CONST2
1 ATOM0
2 SETGLOBAL T010-const2
4 STOP
4 STOP
**)

View File

@ -1,8 +1,8 @@
3;;
(**
0 CONST3
1 ATOM0
0 CONST3
1 ATOM0
2 SETGLOBAL T010-const3
4 STOP
4 STOP
**)

View File

@ -2,7 +2,7 @@
(**
0 CONSTINT 4
2 ATOM0
2 ATOM0
3 SETGLOBAL T011-constint
5 STOP
5 STOP
**)

View File

@ -1,10 +1,10 @@
let _ = () in ();;
(**
0 CONST0
1 PUSHCONST0
0 CONST0
1 PUSHCONST0
2 POP 1
4 ATOM0
4 ATOM0
5 SETGLOBAL T020
7 STOP
7 STOP
**)

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