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

clean up spaces and tabs 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@9547 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2010-01-22 12:48:24 +00:00
parent bdc0fadee2
commit 04b1656222
586 changed files with 3091 additions and 3475 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Changes
View File

@ -190,7 +190,7 @@ Compilers:
are tail calls.
- All compiler error messages now include a file name and location, for
better interaction with Emacs' compilation mode.
- Optimized compilation of "lazy e" when the argument "e" is
- Optimized compilation of "lazy e" when the argument "e" is
already evaluated.
- Optimized compilation of equality tests with a variant constant constructor.
- The -dllib options recorded in libraries are no longer ignored when
@ -243,7 +243,7 @@ Other libraries:
- Dynlink: on some platforms, the Dynlink library is now available in
native code. The boolean Dynlink.is_native allows the program to
know whether it has been compiled in bytecode or in native code.
- Bigarrays: added "unsafe_get" and "unsafe_set"
- Bigarrays: added "unsafe_get" and "unsafe_set"
(non-bound-checking versions of "get" and "set").
- Bigarrays: removed limitation "array dimension < 2^31".
- Labltk: added support for TK 8.5.
@ -274,7 +274,7 @@ Bug fixes:
out-of-heap pointers.
- PR#3915: updated most man pages.
- PR#4261: type-checking of recursive modules
- PR#4308: better stack backtraces for "spontaneous" exceptions such as
- PR#4308: better stack backtraces for "spontaneous" exceptions such as
Stack_overflow, Out_of_memory, etc.
- PR#4338: Str.global_substitute, Str.global_replace and the Str.*split*
functions are now tail-recursive.

2
INSTALL
View File

@ -78,7 +78,7 @@ The "configure" script accepts the following options:
LablTk. "-tkdefs" helps to find the headers, and "-tklibs"
the C libraries. "-tklibs" may contain either only -L/path and
-Wl,... flags, in which case the library names are determined
automatically, or the actual libraries, which are used as given.
automatically, or the actual libraries, which are used as given.
Example: for a Japanese tcl/tk whose headers are in specific
directories and libraries in /usr/local/lib, you can use
./configure -tklibs "-L/usr/local/lib -ltk8.0jp -ltcl8.0jp"

96
Makefile
View File

@ -32,7 +32,7 @@ SHELL=/bin/sh
MKDIR=mkdir -p
INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \
-I toplevel
-I toplevel
UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
@ -192,9 +192,9 @@ coldstart:
cd stdlib; $(MAKE) COMPILER=../boot/ocamlc all
cd stdlib; cp $(LIBFILES) ../boot
if test -f boot/libcamlrun.a; then :; else \
ln -s ../byterun/libcamlrun.a boot/libcamlrun.a; fi
ln -s ../byterun/libcamlrun.a boot/libcamlrun.a; fi
if test -d stdlib/caml; then :; else \
ln -s ../byterun stdlib/caml; fi
ln -s ../byterun stdlib/caml; fi
# Build the core system: the minimum needed to make depend and bootstrap
core: coldstart ocamlc ocamllex ocamlyacc ocamltools library
@ -240,7 +240,7 @@ compare:
@if cmp boot/ocamlc ocamlc && cmp boot/ocamllex lex/ocamllex \
&& cmp boot/ocamldep tools/ocamldep; \
then echo "Fixpoint reached, bootstrap succeeded."; \
else echo "Fixpoint not reached, try one more bootstrapping cycle."; \
else echo "Fixpoint not reached, try one more bootstrapping cycle."; \
fi
# Remove old bootstrap compilers
@ -262,9 +262,9 @@ opt:
# Native-code versions of the tools
opt.opt: checkstack runtime core ocaml opt-core ocamlc.opt otherlibraries \
ocamlbuild.byte camlp4out $(DEBUGGER) ocamldoc ocamlopt.opt \
otherlibrariesopt \
ocamllex.opt ocamltoolsopt.opt ocamlbuild.native camlp4opt ocamldoc.opt
ocamlbuild.byte camlp4out $(DEBUGGER) ocamldoc ocamlopt.opt \
otherlibrariesopt \
ocamllex.opt ocamltoolsopt.opt ocamlbuild.native camlp4opt ocamldoc.opt
# Installation
install:
@ -274,8 +274,8 @@ install:
if test -d $(MANDIR)/man$(MANEXT); then : ; \
else $(MKDIR) $(MANDIR)/man$(MANEXT); fi
cd $(LIBDIR); rm -f dllbigarray.so dlllabltk.so dllnums.so \
dllthreads.so dllunix.so dllgraphics.so dllmldbm.so dllstr.so \
dlltkanim.so
dllthreads.so dllunix.so dllgraphics.so dllmldbm.so dllstr.so \
dlltkanim.so
cd byterun; $(MAKE) install
cp ocamlc $(BINDIR)/ocamlc$(EXE)
cp ocaml $(BINDIR)/ocaml$(EXE)
@ -291,8 +291,8 @@ install:
cd tools; $(MAKE) install
-cd man; $(MAKE) install
for i in $(OTHERLIBRARIES); do \
(cd otherlibs/$$i; $(MAKE) install) || exit $$?; \
done
(cd otherlibs/$$i; $(MAKE) install) || exit $$?; \
done
cd ocamldoc; $(MAKE) install
if test -f ocamlopt; then $(MAKE) installopt; else :; fi
if test -f debugger/ocamldebug; then (cd debugger; $(MAKE) install); \
@ -355,7 +355,7 @@ partialclean::
# The native toplevel
ocamlnat: ocamlopt otherlibs/dynlink/dynlink.cmxa $(NATTOPOBJS:.cmo=.cmx)
ocamlnat: ocamlopt otherlibs/dynlink/dynlink.cmxa $(NATTOPOBJS:.cmo=.cmx)
$(CAMLOPT) $(LINKFLAGS) otherlibs/dynlink/dynlink.cmxa -o ocamlnat \
$(NATTOPOBJS:.cmo=.cmx) -linkall
@ -369,28 +369,28 @@ otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/natdynlink.ml
utils/config.ml: utils/config.mlp config/Makefile
@rm -f utils/config.ml
sed -e 's|%%LIBDIR%%|$(LIBDIR)|' \
-e 's|%%BYTERUN%%|$(BINDIR)/ocamlrun|' \
-e 's|%%CCOMPTYPE%%|cc|' \
-e 's|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)|' \
-e 's|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|' \
-e 's|%%PACKLD%%|$(PACKLD)|' \
-e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \
-e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \
-e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \
-e 's|%%CC_PROFILE%%|$(CC_PROFILE)|' \
-e 's|%%ARCH%%|$(ARCH)|' \
-e 's|%%MODEL%%|$(MODEL)|' \
-e 's|%%SYSTEM%%|$(SYSTEM)|' \
-e 's|%%EXT_OBJ%%|.o|' \
-e 's|%%EXT_ASM%%|.s|' \
-e 's|%%EXT_LIB%%|.a|' \
-e 's|%%EXT_DLL%%|.so|' \
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
utils/config.mlp > utils/config.ml
-e 's|%%BYTERUN%%|$(BINDIR)/ocamlrun|' \
-e 's|%%CCOMPTYPE%%|cc|' \
-e 's|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS)|' \
-e 's|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|' \
-e 's|%%PACKLD%%|$(PACKLD)|' \
-e 's|%%BYTECCLIBS%%|$(BYTECCLIBS)|' \
-e 's|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|' \
-e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \
-e 's|%%CC_PROFILE%%|$(CC_PROFILE)|' \
-e 's|%%ARCH%%|$(ARCH)|' \
-e 's|%%MODEL%%|$(MODEL)|' \
-e 's|%%SYSTEM%%|$(SYSTEM)|' \
-e 's|%%EXT_OBJ%%|.o|' \
-e 's|%%EXT_ASM%%|.s|' \
-e 's|%%EXT_LIB%%|.a|' \
-e 's|%%EXT_DLL%%|.so|' \
-e 's|%%SYSTHREAD_SUPPORT%%|$(SYSTHREAD_SUPPORT)|' \
-e 's|%%ASM%%|$(ASM)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
utils/config.mlp > utils/config.ml
@chmod -w utils/config.ml
partialclean::
@ -433,8 +433,8 @@ beforedepend:: parsing/linenum.ml
ocamlc.opt: $(COMPOBJS:.cmo=.cmx)
cd asmrun; $(MAKE) meta.o dynlink.o
$(CAMLOPT) $(LINKFLAGS) -ccopt "$(BYTECCLINKOPTS)" -o ocamlc.opt \
$(COMPOBJS:.cmo=.cmx) \
asmrun/meta.o asmrun/dynlink.o -cclib "$(BYTECCLIBS)"
$(COMPOBJS:.cmo=.cmx) \
asmrun/meta.o asmrun/dynlink.o -cclib "$(BYTECCLIBS)"
@sed -e 's|@compiler@|$$topdir/ocamlc.opt|' \
driver/ocamlcomp.sh.in > ocamlcomp.sh
@chmod +x ocamlcomp.sh
@ -459,7 +459,7 @@ $(OPTOBJS:.cmo=.cmx): ocamlopt
bytecomp/opcodes.ml: byterun/instruct.h
sed -n -e '/^enum/p' -e 's/,//g' -e '/^ /p' byterun/instruct.h | \
awk -f tools/make-opcodes > bytecomp/opcodes.ml
awk -f tools/make-opcodes > bytecomp/opcodes.ml
partialclean::
rm -f bytecomp/opcodes.ml
@ -475,9 +475,9 @@ bytecomp/runtimedef.ml: byterun/primitives byterun/fail.h
(echo 'let builtin_exceptions = [|'; \
sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$$| \1;|p' byterun/fail.h | \
sed -e '$$s/;$$//'; \
echo '|]'; \
echo 'let builtin_primitives = [|'; \
sed -e 's/.*/ "&";/' -e '$$s/;$$//' byterun/primitives; \
echo '|]'; \
echo 'let builtin_primitives = [|'; \
sed -e 's/.*/ "&";/' -e '$$s/;$$//' byterun/primitives; \
echo '|]') > bytecomp/runtimedef.ml
partialclean::
@ -531,7 +531,7 @@ beforedepend:: asmcomp/scheduling.ml
asmcomp/emit.ml: asmcomp/$(ARCH)/emit.mlp tools/cvt_emit
$(CAMLRUN) tools/cvt_emit < asmcomp/$(ARCH)/emit.mlp > asmcomp/emit.ml \
|| { rm -f asmcomp/emit.ml; exit 2; }
|| { rm -f asmcomp/emit.ml; exit 2; }
partialclean::
rm -f asmcomp/emit.ml
@ -555,7 +555,7 @@ partialclean::
runtime:
cd byterun; $(MAKE) all
if test -f stdlib/libcamlrun.a; then :; else \
ln -s ../byterun/libcamlrun.a stdlib/libcamlrun.a; fi
ln -s ../byterun/libcamlrun.a stdlib/libcamlrun.a; fi
clean::
cd byterun; $(MAKE) clean
@ -649,18 +649,18 @@ alldepend::
otherlibraries: ocamltools
for i in $(OTHERLIBRARIES); do \
(cd otherlibs/$$i; $(MAKE) RUNTIME=$(RUNTIME) all) || exit $$?; \
done
(cd otherlibs/$$i; $(MAKE) RUNTIME=$(RUNTIME) all) || exit $$?; \
done
otherlibrariesopt:
for i in $(OTHERLIBRARIES); do \
(cd otherlibs/$$i; $(MAKE) allopt) || exit $$?; \
done
(cd otherlibs/$$i; $(MAKE) allopt) || exit $$?; \
done
partialclean::
for i in $(OTHERLIBRARIES); do \
(cd otherlibs/$$i; $(MAKE) partialclean); \
done
(cd otherlibs/$$i; $(MAKE) partialclean); \
done
clean::
for i in $(OTHERLIBRARIES); do (cd otherlibs/$$i; $(MAKE) clean); done

66
Makefile.nt
View File

@ -29,7 +29,7 @@ DEPFLAGS=$(INCLUDES)
CAMLRUN=byterun/ocamlrun
INCLUDES=-I utils -I parsing -I typing -I bytecomp -I asmcomp -I driver \
-I toplevel
-I toplevel
UTILS=utils/misc.cmo utils/tbl.cmo utils/config.cmo \
utils/clflags.cmo utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
@ -295,7 +295,7 @@ partialclean::
# The native toplevel
ocamlnat: ocamlopt otherlibs/dynlink/dynlink.cmxa $(NATTOPOBJS:.cmo=.cmx)
ocamlnat: ocamlopt otherlibs/dynlink/dynlink.cmxa $(NATTOPOBJS:.cmo=.cmx)
$(CAMLOPT) $(LINKFLAGS) otherlibs/dynlink/dynlink.cmxa -o ocamlnat $(NATTOPOBJS:.cmo=.cmx) -linkall
toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa
@ -309,31 +309,31 @@ otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/natdynlink.ml
utils/config.ml: utils/config.mlp config/Makefile
@rm -f utils/config.ml
sed -e "s|%%LIBDIR%%|$(LIBDIR)|" \
-e "s|%%BYTERUN%%|ocamlrun|" \
-e 's|%%CCOMPTYPE%%|$(CCOMPTYPE)|' \
-e "s|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS)|" \
-e "s|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|" \
-e "s|%%PARTIALLD%%|$(PARTIALLD)|" \
-e "s|%%PACKLD%%|$(PACKLD)|" \
-e "s|%%BYTECCLIBS%%|$(BYTECCLIBS)|" \
-e "s|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|" \
-e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \
-e 's|%%BINUTILS_NM%%|$(BINUTILS_NM)|' \
-e 's|%%BINUTILS_OBJCOPY%%|$(BINUTILS_OBJCOPY)|' \
-e "s|%%ARCH%%|$(ARCH)|" \
-e "s|%%MODEL%%|$(MODEL)|" \
-e "s|%%SYSTEM%%|$(SYSTEM)|" \
-e "s|%%EXT_OBJ%%|.$(O)|" \
-e "s|%%EXT_ASM%%|.$(S)|" \
-e "s|%%EXT_LIB%%|.$(A)|" \
-e "s|%%EXT_DLL%%|.dll|" \
-e "s|%%SYSTHREAD_SUPPORT%%|true|" \
-e 's|%%ASM%%|$(ASM)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
-e 's|%%CC_PROFILE%%||' \
utils/config.mlp > utils/config.ml
-e "s|%%BYTERUN%%|ocamlrun|" \
-e 's|%%CCOMPTYPE%%|$(CCOMPTYPE)|' \
-e "s|%%BYTECC%%|$(BYTECC) $(BYTECCCOMPOPTS)|" \
-e "s|%%NATIVECC%%|$(NATIVECC) $(NATIVECCCOMPOPTS)|" \
-e "s|%%PARTIALLD%%|$(PARTIALLD)|" \
-e "s|%%PACKLD%%|$(PACKLD)|" \
-e "s|%%BYTECCLIBS%%|$(BYTECCLIBS)|" \
-e "s|%%NATIVECCLIBS%%|$(NATIVECCLIBS)|" \
-e 's|%%RANLIBCMD%%|$(RANLIBCMD)|' \
-e 's|%%BINUTILS_NM%%|$(BINUTILS_NM)|' \
-e 's|%%BINUTILS_OBJCOPY%%|$(BINUTILS_OBJCOPY)|' \
-e "s|%%ARCH%%|$(ARCH)|" \
-e "s|%%MODEL%%|$(MODEL)|" \
-e "s|%%SYSTEM%%|$(SYSTEM)|" \
-e "s|%%EXT_OBJ%%|.$(O)|" \
-e "s|%%EXT_ASM%%|.$(S)|" \
-e "s|%%EXT_LIB%%|.$(A)|" \
-e "s|%%EXT_DLL%%|.dll|" \
-e "s|%%SYSTHREAD_SUPPORT%%|true|" \
-e 's|%%ASM%%|$(ASM)|' \
-e 's|%%MKDLL%%|$(MKDLL)|' \
-e 's|%%MKEXE%%|$(MKEXE)|' \
-e 's|%%MKMAINDLL%%|$(MKMAINDLL)|' \
-e 's|%%CC_PROFILE%%||' \
utils/config.mlp > utils/config.ml
@chmod -w utils/config.ml
partialclean::
@ -394,7 +394,7 @@ $(OPTOBJS:.cmo=.cmx): ocamlopt
bytecomp/opcodes.ml: byterun/instruct.h
sed -n -e "/^enum/p" -e "s|,||g" -e "/^ /p" byterun/instruct.h | \
gawk -f tools/make-opcodes > bytecomp/opcodes.ml
gawk -f tools/make-opcodes > bytecomp/opcodes.ml
partialclean::
rm -f bytecomp/opcodes.ml
@ -410,9 +410,9 @@ bytecomp/runtimedef.ml: byterun/primitives byterun/fail.h
(echo 'let builtin_exceptions = [|'; \
sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$$| \1;|p' byterun/fail.h | \
sed -e '$$s/;$$//'; \
echo '|]'; \
echo 'let builtin_primitives = [|'; \
sed -e 's/.*/ "&";/' -e '$$s/;$$//' byterun/primitives; \
echo '|]'; \
echo 'let builtin_primitives = [|'; \
sed -e 's/.*/ "&";/' -e '$$s/;$$//' byterun/primitives; \
echo '|]') > bytecomp/runtimedef.ml
partialclean::
@ -561,9 +561,9 @@ alldepend::
# OCamldoc
ocamldoc.byte:
ocamldoc.byte:
cd ocamldoc ; $(MAKEREC) all
ocamldoc.opt:
ocamldoc.opt:
cd ocamldoc ; $(MAKEREC) opt.opt
partialclean::
cd ocamldoc ; $(MAKEREC) clean

2
README
View File

@ -84,7 +84,7 @@ All files marked "Copyright INRIA" in this distribution are copyright
INSTALLATION:
See the file INSTALL for installation instructions on Unix, Linux and
See the file INSTALL for installation instructions on Unix, Linux and
MacOS X machines. For MS Windows, see README.win32.
DOCUMENTATION:

20
README.win32
View File

@ -6,7 +6,7 @@ There are no less than four ports of Objective Caml for MS Windows available:
- a native Win32 port, built with the Cygwin/MinGW development tools;
- a port consisting of the Unix sources compiled under the Cygwin
Unix-like environment for Windows;
- a native Win64 port (64-bit Windows), built with the Microsoft
- a native Win64 port (64-bit Windows), built with the Microsoft
development tools.
Here is a summary of the main differences between these ports:
@ -95,7 +95,7 @@ THIRD-PARTY SOFTWARE:
2005 can download MASM version 8 from
http://www.microsoft.com/downloads/details.aspx?FamilyID=7A1C9DA0-0510-44A2-B042-7EF370530C64&displaylang=en
To obtain MASM version 6.11, see
http://users.easystreet.com/jkirwan/new/pctools.html.
http://users.easystreet.com/jkirwan/new/pctools.html.
[4] TCL/TK version 8.5. Windows binaries are available as part of the
ActiveTCL distribution at http://www.activestate.com/products/ActiveTcl/
@ -152,7 +152,7 @@ performance of bytecode programs is about 2/3 of that obtained under
Unix/GCC or Cygwin or Mingw on similar hardware.
* Libraries available in this port: "num", "str", "threads", "graphics",
"labltk", and large parts of "unix".
"labltk", and large parts of "unix".
* The replay debugger is partially supported (no reverse execution).
@ -178,7 +178,7 @@ The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...)
runs without any additional tools.
The native-code compiler (ocamlopt), as well as static linking of
Caml bytecode with C code (ocamlc -custom), require
Caml bytecode with C code (ocamlc -custom), require
the Cygwin development tools, available at
http://www.cygwin.com/
and the flexdll tool, available at
@ -191,7 +191,7 @@ Do *not* install the Mingw/MSYS development tools from www.mingw.org:
these are not compatible with this Caml port (@responsefile not
recognized on the command line).
The LablTk GUI requires Tcl/Tk 8.5. Windows binaries are available
The LablTk GUI requires Tcl/Tk 8.5. Windows binaries are available
as part of the ActiveTCL distribution at
http://www.activestate.com/products/ActiveTcl/
@ -216,7 +216,7 @@ RECOMPILATION FROM THE SOURCES:
You will need the following software components to perform the recompilation:
- Windows NT, 2000, XP, or Vista.
- Cygwin: http://sourceware.cygnus.com/cygwin/
Install at least the following packages: binutils, diffutils,
Install at least the following packages: binutils, diffutils,
gcc-core, gcc-mingw-core, make, mingw-runtime, ncurses, w32-api.
- TCL/TK version 8.5 (see above).
- The flexdll tool (see above).
@ -238,7 +238,7 @@ Normally, the only variables that need to be changed are
PREFIX where to install everything
TK_ROOT where TCL/TK was installed
Finally, use "make -f Makefile.nt" to build the system, e.g.
Finally, use "make -f Makefile.nt" to build the system, e.g.
make -f Makefile.nt world
make -f Makefile.nt bootstrap
@ -250,7 +250,7 @@ Finally, use "make -f Makefile.nt" to build the system, e.g.
NOTES:
* Libraries available in this port: "num", "str", "threads", "graphics",
"labltk", and large parts of "unix".
"labltk", and large parts of "unix".
* The replay debugger is partially supported (no reverse execution).
@ -357,7 +357,7 @@ compiler for AMD64 instead of the Platform SDK compiler, replace the line
by
EXTRALIBS=
Finally, use "make -f Makefile.nt" to build the system, e.g.
Finally, use "make -f Makefile.nt" to build the system, e.g.
make -f Makefile.nt world
make -f Makefile.nt bootstrap
@ -369,7 +369,7 @@ Finally, use "make -f Makefile.nt" to build the system, e.g.
NOTES:
* Libraries available in this port: "num", "str", "threads", "graphics",
and large parts of "unix".
and large parts of "unix".
* The replay debugger is partially supported (no reverse execution).

4
Upgrading
View File

@ -97,7 +97,7 @@ A8: The new default mode is more flexible than the original commuting
interface must also be present in the implementation.
The addlabels tool can help you to do that. Suppose that you have
mymod.ml and mymod.mli, where mymod.mli adds some labels. Then
doing
doing
$CAMLLIB/addlabels mymod.ml
will insert labels from the interface inside the implementation.
It also takes care of inserting them in recursive calls, as
@ -106,4 +106,4 @@ A8: The new default mode is more flexible than the original commuting
If you used labels from standard libraries, you will also have
problems with them. You can proceed as described in A6. Since you
used classic mode, you do not need to bother about changed
argument order.
argument order.

8
asmcomp/alpha/emit.mlp
View File

@ -129,7 +129,7 @@ let emit_label lbl =
emit_string "$"; emit_int lbl
let emit_Llabel fallthrough lbl =
if (not fallthrough) then begin
if (not fallthrough) then begin
emit_string " .align 4\n"
end ;
emit_label lbl
@ -195,7 +195,7 @@ let int_reg_number = [|
0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12;
16; 17; 18; 19; 20; 21; 22
|]
let float_reg_number = [|
0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15;
16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 29; 30
@ -358,7 +358,7 @@ let emit_instr fallthrough i =
Lend -> ()
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
if src.loc <> dst.loc then begin
if src.loc <> dst.loc then begin
match (src.loc, dst.loc) with
(Reg rs, Reg rd) ->
if src.typ = Float then
@ -381,7 +381,7 @@ let emit_instr fallthrough i =
| Lop(Iconst_int n) ->
if n = 0n then
` clr {emit_reg i.res.(0)}\n`
else if digital_asm ||
else if digital_asm ||
(n >= Nativeint.of_int (-0x80000000) &&
n <= Nativeint.of_int 0x7FFFFFFF) then
` ldiq {emit_reg i.res.(0)}, {emit_nativeint n}\n`

4
asmcomp/alpha/proc.ml
View File

@ -49,7 +49,7 @@ let int_reg_name = [|
(* 8-12 *) "$8"; "$9"; "$10"; "$11"; "$12";
(* 13-19 *) "$16"; "$17"; "$18"; "$19"; "$20"; "$21"; "$22"
|]
let float_reg_name = [|
(* 100-107 *) "$f0"; "$f1"; "$f2"; "$f3"; "$f4"; "$f5"; "$f6"; "$f7";
(* 108-115 *) "$f8"; "$f9"; "$f10"; "$f11"; "$f12"; "$f13"; "$f14"; "$f15";
@ -210,7 +210,7 @@ let assemble_file infile outfile =
if digital_asm && !Clflags.gprofile
then Config.as ^ " -pg"
else Config.as in
Ccomp.command (as_cmd ^ " -o " ^
Ccomp.command (as_cmd ^ " -o " ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
open Clflags;;

3
asmcomp/amd64/emit.mlp
View File

@ -60,7 +60,7 @@ let slot_offset loc cl =
(* Symbols *)
let emit_symbol s =
if macosx then emit_string "_";
if macosx then emit_string "_";
Emitaux.emit_symbol '$' s
let emit_call s =
@ -791,4 +791,3 @@ let end_assembly() =
if Config.system = "linux" then
(* Mark stack as non-executable, PR#4564 *)
` .section .note.GNU-stack,\"\",%progbits\n`

20
asmcomp/amd64/emit_nt.mlp
View File

@ -39,10 +39,10 @@ let frame_required () =
let frame_size () = (* includes return address *)
if frame_required() then begin
let sz =
let sz =
(!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8)
in Misc.align sz 16
end else
end else
!stack_offset + 8
let slot_offset loc cl =
@ -63,7 +63,7 @@ let emit_int32 n = emit_printf "0%lxh" n
let emit_symbol s =
Emitaux.emit_symbol '$' s
(* Record symbols used and defined - at the end generate extern for those
(* Record symbols used and defined - at the end generate extern for those
used but not defined *)
let symbols_defined = ref StringSet.empty
@ -84,11 +84,11 @@ let emit_label lbl =
let emit_align n =
` ALIGN {emit_int n}\n`
let emit_Llabel fallthrough lbl =
if not fallthrough && !fastcode_flag then emit_align 4;
emit_label lbl
(* Output a pseudo-register *)
let emit_reg = function
@ -106,13 +106,13 @@ let emit_reg = function
(* Output a reference to the lower 8, 16 or 32 bits of a register *)
let reg_low_8_name =
[| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b";
[| "al"; "bl"; "dil"; "sil"; "dl"; "cl"; "r8b"; "r9b";
"r10b"; "r11b"; "bpl"; "r12b"; "r13b" |]
let reg_low_16_name =
[| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w";
[| "ax"; "bx"; "di"; "si"; "dx"; "cx"; "r8w"; "r9w";
"r10w"; "r11w"; "bp"; "r12w"; "r13w" |]
let reg_low_32_name =
[| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d";
[| "eax"; "ebx"; "edi"; "esi"; "edx"; "ecx"; "r8d"; "r9d";
"r10d"; "r11d"; "ebp"; "r12d"; "r13d" |]
let emit_subreg tbl pref r =
@ -253,7 +253,7 @@ let name_for_cond_branch = function
| Iunsigned Ceq -> "e" | Iunsigned Cne -> "ne"
| Iunsigned Cle -> "be" | Iunsigned Cgt -> "a"
| Iunsigned Clt -> "b" | Iunsigned Cge -> "ae"
(* Output an = 0 or <> 0 test. *)
let output_test_zero arg =
@ -544,7 +544,7 @@ let emit_instr fallthrough i =
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
let b = name_for_cond_branch cmp in
` j{emit_string b} {emit_label lbl}\n`
| Iinttest_imm((Isigned Ceq | Isigned Cne |
| Iinttest_imm((Isigned Ceq | Isigned Cne |
Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
output_test_zero i.arg.(0);
let b = name_for_cond_branch cmp in

14
asmcomp/amd64/proc.ml
View File

@ -31,24 +31,24 @@ open Mach
rcx 5
r8 6
r9 7
r10 8
r11 9
r10 8
r11 9
rbp 10
r12 11
r13 12
r12 11
r13 12
r14 trap pointer
r15 allocation pointer
xmm0 - xmm15 100 - 115 xmm0 - xmm9: Caml function arguments
xmm0 - xmm7: C function arguments
xmm0: Caml and C function results *)
let int_reg_name =
[| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
[| "%rax"; "%rbx"; "%rdi"; "%rsi"; "%rdx"; "%rcx"; "%r8"; "%r9";
"%r10"; "%r11"; "%rbp"; "%r12"; "%r13" |]
let float_reg_name =
[| "%xmm0"; "%xmm1"; "%xmm2"; "%xmm3"; "%xmm4"; "%xmm5"; "%xmm6"; "%xmm7";
[| "%xmm0"; "%xmm1"; "%xmm2"; "%xmm3"; "%xmm4"; "%xmm5"; "%xmm6"; "%xmm7";
"%xmm8"; "%xmm9"; "%xmm10"; "%xmm11";
"%xmm12"; "%xmm13"; "%xmm14"; "%xmm15" |]

16
asmcomp/amd64/proc_nt.ml
View File

@ -31,25 +31,25 @@ open Mach
rcx 5
r8 6
r9 7
r10 8
r11 9
r10 8
r11 9
rbp 10
r12 11
r13 12
r12 11
r13 12
r14 trap pointer
r15 allocation pointer
xmm0 - xmm15 100 - 115 xmm0 - xmm9: Caml function arguments
xmm0 - xmm3: C function arguments
xmm0: Caml and C function results
xmm6-xmm15 are preserved by C *)
let int_reg_name =
[| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
[| "rax"; "rbx"; "rdi"; "rsi"; "rdx"; "rcx"; "r8"; "r9";
"r10"; "r11"; "rbp"; "r12"; "r13" |]
let float_reg_name =
[| "xmm0"; "xmm1"; "xmm2"; "xmm3"; "xmm4"; "xmm5"; "xmm6"; "xmm7";
[| "xmm0"; "xmm1"; "xmm2"; "xmm3"; "xmm4"; "xmm5"; "xmm6"; "xmm7";
"xmm8"; "xmm9"; "xmm10"; "xmm11"; "xmm12"; "xmm13"; "xmm14"; "xmm15" |]
let num_register_classes = 2
@ -229,5 +229,5 @@ let contains_calls = ref false
let assemble_file infile outfile =
Ccomp.command (Config.asm ^
Filename.quote outfile ^ " " ^
Filename.quote outfile ^ " " ^
Filename.quote infile ^ "> NUL")

2
asmcomp/arm/emit.mlp
View File

@ -274,7 +274,7 @@ let emit_instr i =
` mov {emit_reg i.res.(0)}, #{emit_nativeint low_bits} @ {emit_string s}\n`;
` mov {emit_reg i.res.(1)}, #{emit_nativeint high_bits}\n`;
2
end else begin
end else begin
let lbl = label_constant float_constants s 2 in
` ldr {emit_reg i.res.(0)}, {emit_label lbl} @ {emit_string s}\n`;
` ldr {emit_reg i.res.(1)}, {emit_label lbl} + 4\n`;

3
asmcomp/arm/selection.ml
View File

@ -166,7 +166,7 @@ method select_operation op args =
method select_condition = function
| Cop(Ccmpf cmp, args) ->
(Iinttest_imm(Isigned cmp, 0),
Cop(Cextcall(float_comparison_function cmp,
Cop(Cextcall(float_comparison_function cmp,
typ_int, false, Debuginfo.none),
args))
| expr ->
@ -198,4 +198,3 @@ method insert_op_debug op dbg rs rd =
end
let fundecl f = (new selector)#emit_fundecl f

2
asmcomp/asmgen.ml
View File

@ -90,7 +90,7 @@ let compile_genfuns ppf f =
List.iter
(function
| (Cfunction {fun_name = name}) as ph when f name ->
compile_phrase ppf ph
compile_phrase ppf ph
| _ -> ())
(Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])

1
asmcomp/asmlibrarian.ml
View File

@ -71,4 +71,3 @@ let report_error ppf = function
fprintf ppf "Cannot find file %s" name
| Archiver_error name ->
fprintf ppf "Error while creating the library %s" name

6
asmcomp/asmpackager.ml
View File

@ -83,10 +83,10 @@ let make_package_object ppf members targetobj targetname coercion =
let objtemp =
if !Clflags.keep_asm_file
then chop_extension_if_any targetobj ^ ".pack" ^ Config.ext_obj
else
else
(* Put the full name of the module in the temporary file name
to avoid collisions with MSVC's link /lib in case of successive
packs *)
to avoid collisions with MSVC's link /lib in case of successive
packs *)
Filename.temp_file (Compilenv.make_symbol (Some "")) Config.ext_obj in
let components =
List.map

1
asmcomp/closure.mli
View File

@ -15,4 +15,3 @@
(* Introduction of closures, uncurrying, recognition of direct calls *)
val intro: int -> Lambda.lambda -> Clambda.ulambda

1
asmcomp/cmm.ml
View File

@ -129,4 +129,3 @@ type data_item =
type phrase =
Cfunction of fundecl
| Cdata of data_item list

1
asmcomp/cmm.mli
View File

@ -115,4 +115,3 @@ type data_item =
type phrase =
Cfunction of fundecl
| Cdata of data_item list

8
asmcomp/cmmgen.ml
View File

@ -1950,9 +1950,9 @@ let generic_functions shared units =
let (apply,send,curry) =
List.fold_left
(fun (apply,send,curry) ui ->
List.fold_right IntSet.add ui.Compilenv.ui_apply_fun apply,
List.fold_right IntSet.add ui.Compilenv.ui_send_fun send,
List.fold_right IntSet.add ui.Compilenv.ui_curry_fun curry)
List.fold_right IntSet.add ui.Compilenv.ui_apply_fun apply,
List.fold_right IntSet.add ui.Compilenv.ui_send_fun send,
List.fold_right IntSet.add ui.Compilenv.ui_curry_fun curry)
(IntSet.empty,IntSet.empty,IntSet.empty)
units in
let apply = if shared then apply else IntSet.union apply default_apply in
@ -2071,7 +2071,7 @@ let plugin_header units =
crc = crc;
imports_cmi = ui.Compilenv.ui_imports_cmi;
imports_cmx = ui.Compilenv.ui_imports_cmx;
defines = ui.Compilenv.ui_defines
defines = ui.Compilenv.ui_defines
} in
global_data "caml_plugin_header"
{ magic = dyn_magic_number; units = List.map mk units }

2
asmcomp/cmmgen.mli
View File

@ -23,7 +23,7 @@ val generic_functions: bool -> Compilenv.unit_infos list -> Cmm.phrase list
val entry_point: string list -> Cmm.phrase
val global_table: string list -> Cmm.phrase
val reference_symbols: string list -> Cmm.phrase
val globals_map: (string * Digest.t * Digest.t * string list) list ->
val globals_map: (string * Digest.t * Digest.t * string list) list ->
Cmm.phrase
val frame_table: string list -> Cmm.phrase
val data_segment_table: string list -> Cmm.phrase

6
asmcomp/codegen.ml
View File

@ -39,7 +39,7 @@ let rec regalloc fd =
let (newfd, redo_regalloc) = Reload.fundecl fd in
if !dump_reload then
Printmach.phase "After insertion of reloading code" newfd;
if redo_regalloc
if redo_regalloc
then begin Reg.reinit(); Liveness.fundecl newfd; regalloc newfd end
else newfd
@ -95,7 +95,3 @@ let file filename =
close_in ic; Parsecmmaux.report_error msg
| x ->
close_in ic; raise x

4
asmcomp/coloring.ml
View File

@ -50,7 +50,7 @@ let find_degree reg =
let cl = Proc.register_class reg in
let avail_regs = Proc.num_available_registers.(cl) in
if avail_regs = 0 then
(* Don't bother computing the degree if there are no regs
(* Don't bother computing the degree if there are no regs
in this class *)
unconstrained := Reg.Set.add reg !unconstrained
else begin
@ -131,7 +131,7 @@ let iter_preferred f reg =
List.iter (fun (r, w) -> walk r w) reg.prefer;
reg.visited <- false
(* Where to start the search for a suitable register.
(* Where to start the search for a suitable register.
Used to introduce some "randomness" in the choice between registers
with equal scores. This offers more opportunities for scheduling. *)

3
asmcomp/compilenv.ml
View File

@ -179,7 +179,7 @@ let record_global_approx_toplevel id =
let global_approx id =
if Ident.is_predef_exn id then Value_unknown
else try Hashtbl.find toplevel_approx (Ident.name id)
with Not_found ->
with Not_found ->
match get_global_info id with
| None -> Value_unknown
| Some ui -> ui.ui_approx
@ -240,4 +240,3 @@ let report_error ppf = function
fprintf ppf "Corrupted compilation unit description@ %s" filename
| Illegal_renaming(modname, filename) ->
fprintf ppf "%s@ contains the description for unit@ %s" filename modname

2
asmcomp/compilenv.mli
View File

@ -106,5 +106,3 @@ type error =
exception Error of error
val report_error: Format.formatter -> error -> unit

2
asmcomp/debuginfo.ml
View File

@ -33,7 +33,7 @@ let none = {
let to_string d =
if d == none
then ""
then ""
else Printf.sprintf "{%s:%d,%d-%d}"
d.dinfo_file d.dinfo_line d.dinfo_char_start d.dinfo_char_end

1
asmcomp/debuginfo.mli
View File

@ -28,4 +28,3 @@ val from_location: kind -> Location.t -> t
val from_call: Lambda.lambda_event -> t
val from_raise: Lambda.lambda_event -> t

5
asmcomp/emitaux.ml
View File

@ -138,7 +138,7 @@ let emit_frames a =
let filenames = Hashtbl.create 7 in
let lbl_filenames = ref 200000 in
let label_filename name =
try
try
Hashtbl.find filenames name
with Not_found ->
let lbl = !lbl_filenames in
@ -165,7 +165,7 @@ let emit_frames a =
Int64.add (Int64.shift_left (Int64.of_int char_end) 26)
(Int64.of_int kind))) in
a.efa_label_rel
(label_filename d.dinfo_file)
(label_filename d.dinfo_file)
(Int64.to_int32 info);
a.efa_32 (Int64.to_int32 (Int64.shift_right info 32))
end in
@ -189,4 +189,3 @@ let is_generic_function name =
List.exists
(fun p -> isprefix p name)
["caml_apply"; "caml_curry"; "caml_send"; "caml_tuplify"]

1
asmcomp/hppa/arch.ml
View File

@ -71,4 +71,3 @@ let print_specific_operation printreg op ppf arg =
| Ishift1add -> fprintf ppf "%a << 1 + %a" printreg arg.(0) printreg arg.(1)
| Ishift2add -> fprintf ppf "%a << 2 + %a" printreg arg.(0) printreg arg.(1)
| Ishift3add -> fprintf ppf "%a << 3 + %a" printreg arg.(0) printreg arg.(1)

2
asmcomp/hppa/emit.mlp
View File

@ -137,7 +137,7 @@ let emit_imports () =
let is_offset n = (n < 8192) && (n >= -8192) (* 14 bits *)
let is_offset_native n =
let is_offset_native n =
n < Nativeint.of_int 8192 && n >= Nativeint.of_int (-8192)
let emit_load instr addr arg dst =

12
asmcomp/hppa/proc.ml
View File

@ -40,18 +40,18 @@ open Mach
%fr31 temporary *)
let int_reg_name = [|
(* 0-4 *) "%r6"; "%r7"; "%r8"; "%r9"; "%r10";
(* 0-4 *) "%r6"; "%r7"; "%r8"; "%r9"; "%r10";
(* 5-10 *) "%r11"; "%r12"; "%r13"; "%r14"; "%r15"; "%r16";
(* 11-16 *) "%r17"; "%r18"; "%r19"; "%r20"; "%r21"; "%r22";
(* 11-16 *) "%r17"; "%r18"; "%r19"; "%r20"; "%r21"; "%r22";
(* 17-20 *) "%r23"; "%r24"; "%r25"; "%r26";
(* 21-22 *) "%r28"; "%r29"
|]
let float_reg_name = [|
(* 100-105 *) "%fr4"; "%fr5"; "%fr6"; "%fr7"; "%fr8"; "%fr9";
(* 106-111 *) "%fr10"; "%fr11"; "%fr12"; "%fr13"; "%fr14"; "%fr15";
(* 112-117 *) "%fr16"; "%fr17"; "%fr18"; "%fr19"; "%fr20"; "%fr21";
(* 118-123 *) "%fr22"; "%fr23"; "%fr24"; "%fr25"; "%fr26"; "%fr27";
(* 118-123 *) "%fr22"; "%fr23"; "%fr24"; "%fr25"; "%fr26"; "%fr27";
(* 124-127 *) "%fr28"; "%fr29"; "%fr30"; "%fr31"
|]
@ -141,7 +141,7 @@ let loc_results res =
let (loc, ofs) = calling_conventions 20 13 100 107 not_supported res in loc
(* Calling C functions:
when all arguments are integers, use %r26 - %r23,
when all arguments are integers, use %r26 - %r23,
then -52(%r30), -56(%r30), etc.
When some arguments are floats, we handle a couple of cases by hand
and fail otherwise. *)
@ -218,7 +218,7 @@ let contains_calls = ref false
let assemble_file infile outfile =
Ccomp.command (Config.asm ^ " -o " ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
Filename.quote outfile ^ " " ^ Filename.quote infile)
open Clflags;;
open Config;;

2
asmcomp/hppa/selection.ml
View File

@ -69,7 +69,7 @@ method select_operation op args =
Cand, Cor, Cxor : never *)
| (Cmuli, ([arg1; Cconst_int n] as args)) ->
let l = Misc.log2 n in
if n = 1 lsl l
if n = 1 lsl l
then (Iintop_imm(Ilsl, l), [arg1])
else (Iintop Imul, args)
| (Cmuli, ([Cconst_int n; arg1] as args)) ->

3
asmcomp/i386/arch.ml
View File

@ -144,11 +144,10 @@ let print_specific_operation printreg op ppf arg =
if i > 0 then fprintf ppf ", ";
printreg ppf arg.(i)
done
(* Stack alignment constraints *)
let stack_alignment =
match Config.system with
| "macosx" -> 16
| _ -> 4

8
asmcomp/i386/emit_nt.mlp
View File

@ -49,7 +49,7 @@ let slot_offset loc cl =
| Outgoing n ->
assert (n >= 0);
n
(* Record symbols used and defined - at the end generate extern for those
(* Record symbols used and defined - at the end generate extern for those
used but not defined *)
let symbols_defined = ref StringSet.empty
@ -74,7 +74,7 @@ let emit_label lbl =
(* Output an align directive. *)
let emit_align n = ` ALIGN {emit_int n}\n`
(* Output a pseudo-register *)
let emit_reg = function
@ -257,7 +257,7 @@ let name_for_cond_branch = function
| Iunsigned Ceq -> "e" | Iunsigned Cne -> "ne"
| Iunsigned Cle -> "be" | Iunsigned Cgt -> "a"
| Iunsigned Clt -> "b" | Iunsigned Cge -> "ae"
(* Output an = 0 or <> 0 test. *)
let output_test_zero arg =
@ -687,7 +687,7 @@ let emit_instr i =
` cmp {emit_reg i.arg.(0)},{emit_reg i.arg.(1)}\n`;
let b = name_for_cond_branch cmp in
` j{emit_string b} {emit_label lbl}\n`
| Iinttest_imm((Isigned Ceq | Isigned Cne |
| Iinttest_imm((Isigned Ceq | Isigned Cne |
Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
output_test_zero i.arg.(0);
let b = name_for_cond_branch cmp in

2
asmcomp/i386/proc_nt.ml
View File

@ -183,4 +183,4 @@ let contains_calls = ref false
let assemble_file infile outfile =
Ccomp.command (Config.asm ^
Filename.quote outfile ^ " " ^ Filename.quote infile ^
(if !Clflags.verbose then "" else ">NUL"))
(if !Clflags.verbose then "" else ">NUL"))

5
asmcomp/i386/selection.ml
View File

@ -72,7 +72,7 @@ let rec select_addr exp =
end
| arg ->
(Alinear arg, 0)
(* C functions to be turned into Ifloatspecial instructions if -ffast-math *)
let inline_float_ops =
@ -310,7 +310,7 @@ method emit_extcall_args env args =
let sz2 = Misc.align sz1 stack_alignment in
let rec emit_pushes = function
| [] ->
if sz2 > sz1 then
if sz2 > sz1 then
self#insert (Iop (Istackoffset (sz2 - sz1))) [||] [||]
| e :: el ->
emit_pushes el;
@ -324,4 +324,3 @@ method emit_extcall_args env args =
end
let fundecl f = (new selector)#emit_fundecl f

18
asmcomp/ia64/emit.mlp
View File

@ -347,7 +347,7 @@ let insimm opc arg imm res =
for i = 0 to Array.length arg - 1 do
Hashtbl.add code_uses arg.(i) node
done;
(* Insert in appropriate queue *)
(* Insert in appropriate queue *)
if node.instr.kind = KB
then add_branch node
else if node.ancestors = 0 then add_ready node
@ -359,7 +359,7 @@ let insert opc arg res =
let rec longest_path node =
if node.length < 0 then begin
node.length <-
node.length <-
List.fold_left
(fun len (son, delay) -> max len (longest_path son + delay))
0 node.sons
@ -447,10 +447,10 @@ let can_issue instr =
| KF ->
if !num_F < 2 then (incr num_F; true) else false
| KI ->
if !num_I < 2 && !num_A + !num_I + !num_M < 4
if !num_I < 2 && !num_A + !num_I + !num_M < 4
then (incr num_I; true) else false
| KM ->
if !num_M < 2 && !num_A + !num_I + !num_M < 4
if !num_M < 2 && !num_A + !num_I + !num_M < 4
then (incr num_M; true) else false
| _ (* KB | KB_exc *) ->
if !num_B < 3 then (incr num_B; true) else false
@ -481,7 +481,7 @@ let emit_node date node =
end)
node.sons
(* Emit all ready nodes that we can emit given the architectural
(* Emit all ready nodes that we can emit given the architectural
constraints. *)
let rec emit_ready_nodes filter date =
@ -561,7 +561,7 @@ let end_basic_block () =
(* Compute critical paths and rebuild ready queue sorted by
decreasing criticality *)
let r = !ready_queue in
ready_queue := [];
ready_queue := [];
let max_length =
List.fold_left (fun len node -> max len (longest_path node)) 0 r in
List.iter add_ready r;
@ -760,7 +760,7 @@ let is_immediate_adds n = n >= -0x2000 && n < 0x2000
let ones_pos n =
let rec ones p accu =
if p >= 63
if p >= 63
then accu
else ones (p+1) (if n land (1 lsl p) = 0 then accu else p :: accu) in
ones 0 []
@ -795,7 +795,7 @@ let emit_instr i =
Lend -> ()
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
if src.loc <> dst.loc then begin
if src.loc <> dst.loc then begin
match (src.loc, dst.loc) with
(Reg _, Reg _) ->
insert "mov" (regs i.arg) (regs i.res)
@ -1198,7 +1198,7 @@ let emit_instr i =
| Lpushtrap ->
end_basic_block();
stack_offset := !stack_offset + 16;
(* Store trap pointer at sp, handler addr at sp+8,
(* Store trap pointer at sp, handler addr at sp+8,
and decrement sp by 16. Remember, the bottom 16 bytes
of the stack must be left free. *)
` add r3 = 8, sp\n`;

4
asmcomp/ia64/proc.ml
View File

@ -71,10 +71,10 @@ let int_reg_name = [|
"r88"; "r89"; "r90"; "r91";
(* 80-81 *) "r14"; "r15"
|]
let float_reg_name = [|
(* 0-13 *) "f2"; "f3"; "f4"; "f5"; "f6"; "f7";
"f8"; "f9"; "f10"; "f11"; "f12"; "f13"; "f14"; "f15";
"f8"; "f9"; "f10"; "f11"; "f12"; "f13"; "f14"; "f15";
(* 14-29 *) "f16"; "f17"; "f18"; "f19"; "f20"; "f21"; "f22"; "f23";
"f24"; "f25"; "f26"; "f27"; "f28"; "f29"; "f30"; "f31";
(* 30-61 *) "f32"; "f33"; "f34"; "f35"; "f36"; "f37"; "f38"; "f39";

2
asmcomp/ia64/scheduling.ml
View File

@ -14,7 +14,7 @@
open Schedgen (* to create a dependency *)
(* We don't schedule here on the linearized code, but instead schedule the
(* We don't schedule here on the linearized code, but instead schedule the
assembly code generated in Emit. *)
let fundecl f = f

2
asmcomp/ia64/selection.ml
View File

@ -106,7 +106,7 @@ method select_operation op args =
Turn general division and modulus into calls to C library functions *)
| (Cdivi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Idiv, n), [arg])
| (Cdivi, _) ->
| (Cdivi, _) ->
(Iextcall("__divdi3", false), args)
| (Cmodi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) && n <> 1 ->
(Iintop_imm(Imod, n), [arg])

2
asmcomp/interf.ml
View File

@ -98,7 +98,7 @@ let build_graph fundecl =
| Iexit _ ->
()
| Itrywith(body, handler) ->
add_interf_set Proc.destroyed_at_raise handler.live;
add_interf_set Proc.destroyed_at_raise handler.live;
interf body; interf handler; interf i.next
| Iraise -> () in

10
asmcomp/linearize.ml
View File

@ -49,7 +49,7 @@ and instruction_desc =
let has_fallthrough = function
| Lreturn | Lbranch _ | Lswitch _ | Lraise
| Lop Itailcall_ind | Lop (Itailcall_imm _) -> false
| _ -> true
| _ -> true
type fundecl =
{ fun_name: string;
@ -84,13 +84,13 @@ let rec end_instr =
(* Cons an instruction (live, debug empty) *)
let instr_cons d a r n =
{ desc = d; next = n; arg = a; res = r;
{ desc = d; next = n; arg = a; res = r;
dbg = Debuginfo.none; live = Reg.Set.empty }
(* Cons a simple instruction (arg, res, live empty) *)
let cons_instr d n =
{ desc = d; next = n; arg = [||]; res = [||];
{ desc = d; next = n; arg = [||]; res = [||];
dbg = Debuginfo.none; live = Reg.Set.empty }
(* Build an instruction with arg, res, dbg, live taken from
@ -98,7 +98,7 @@ let cons_instr d n =
let copy_instr d i n =
{ desc = d; next = n;
arg = i.Mach.arg; res = i.Mach.res;
arg = i.Mach.arg; res = i.Mach.res;
dbg = i.Mach.dbg; live = i.Mach.live }
(*
@ -187,7 +187,7 @@ let rec linear i n =
copy_instr (Lcondbranch(test, lbl)) i (linear ifnot n1)
| _, Iend, Lbranch lbl ->
copy_instr (Lcondbranch(invert_test test, lbl)) i (linear ifso n1)
| Iexit nfail1, Iexit nfail2, _
| Iexit nfail1, Iexit nfail2, _
when is_next_catch nfail1 ->
let lbl2 = find_exit_label nfail2 in
copy_instr

3
asmcomp/linearize.mli
View File

@ -42,7 +42,7 @@ and instruction_desc =
val has_fallthrough : instruction_desc -> bool
val end_instr: instruction
val instr_cons:
val instr_cons:
instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction
val invert_test: Mach.test -> Mach.test
@ -52,4 +52,3 @@ type fundecl =
fun_fast: bool }
val fundecl: Mach.fundecl -> fundecl

13
asmcomp/mach.ml
View File

@ -82,23 +82,23 @@ type fundecl =
fun_fast: bool }
let rec dummy_instr =
{ desc = Iend;
{ desc = Iend;
next = dummy_instr;
arg = [||];
arg = [||];
res = [||];
dbg = Debuginfo.none;
live = Reg.Set.empty }
let end_instr () =
{ desc = Iend;
{ desc = Iend;
next = dummy_instr;
arg = [||];
arg = [||];
res = [||];
dbg = Debuginfo.none;
live = Reg.Set.empty }
let instr_cons d a r n =
{ desc = d; next = n; arg = a; res = r;
{ desc = d; next = n; arg = a; res = r;
dbg = Debuginfo.none; live = Reg.Set.empty }
let instr_cons_debug d a r dbg n =
@ -128,5 +128,4 @@ let rec instr_iter f i =
instr_iter f body; instr_iter f handler; instr_iter f i.next
| Iraise -> ()
| _ ->
instr_iter f i.next
instr_iter f i.next

7
asmcomp/mach.mli
View File

@ -71,7 +71,7 @@ and instruction_desc =
| Iswitch of int array * instruction array
| Iloop of instruction
| Icatch of int * instruction * instruction
| Iexit of int
| Iexit of int
| Itrywith of instruction * instruction
| Iraise
@ -83,11 +83,10 @@ type fundecl =
val dummy_instr: instruction
val end_instr: unit -> instruction
val instr_cons:
val instr_cons:
instruction_desc -> Reg.t array -> Reg.t array -> instruction ->
instruction
val instr_cons_debug:
val instr_cons_debug:
instruction_desc -> Reg.t array -> Reg.t array -> Debuginfo.t ->
instruction -> instruction
val instr_iter: (instruction -> unit) -> instruction -> unit

2
asmcomp/mips/emit.mlp
View File

@ -94,7 +94,7 @@ let emit_addressing addr r n =
let int_reg_number =
[| 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21 |]
let float_reg_number =
[| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19;
20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30 |]

4
asmcomp/mips/proc.ml
View File

@ -50,7 +50,7 @@ let int_reg_name = [|
(* 6-13 *) "$8"; "$9"; "$10"; "$11"; "$12"; "$13"; "$14"; "$15";
(* 14-19 *) "$16"; "$17"; "$18"; "$19"; "$20"; "$21"
|]
let float_reg_name = [|
"$f0"; "$f1"; "$f2"; "$f3"; "$f4";
"$f5"; "$f6"; "$f7"; "$f8"; "$f9";
@ -143,7 +143,7 @@ let loc_results res =
or float regs $f12...$f19. Each argument "consumes" both one slot
in the int register file and one slot in the float register file.
Extra arguments are passed on stack, in a 64-bits slot, right-justified
(i.e. at +4 from natural address). *)
(i.e. at +4 from natural address). *)
let loc_external_arguments arg =
let loc = Array.create (Array.length arg) Reg.dummy in

1
asmcomp/power/arch.ml
View File

@ -84,4 +84,3 @@ let print_specific_operation printreg op ppf arg =
printreg arg.(0) printreg arg.(1) printreg arg.(2)
| Ialloc_far n ->
fprintf ppf "alloc_far %d" n

6
asmcomp/power/emit.mlp
View File

@ -116,7 +116,7 @@ let emit_reg r =
Reg r -> emit_string (register_name r)
| _ -> fatal_error "Emit.emit_reg"
let use_full_regnames =
let use_full_regnames =
Config.system = "rhapsody"
let emit_gpr r =
@ -607,13 +607,13 @@ let rec emit_instr i dslot =
| Lop(Iintop_imm(Idiv, n)) -> (* n is guaranteed to be a power of 2 *)
let l = Misc.log2 n in
` {emit_string sragi} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int l}\n`;
` addze {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
` addze {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
| Lop(Iintop_imm(Imod, n)) -> (* n is guaranteed to be a power of 2 *)
let l = Misc.log2 n in
` {emit_string sragi} {emit_gpr 0}, {emit_reg i.arg.(0)}, {emit_int l}\n`;
` addze {emit_gpr 0}, {emit_gpr 0}\n`;
` {emit_string slgi} {emit_gpr 0}, {emit_gpr 0}, {emit_int l}\n`;
` subfc {emit_reg i.res.(0)}, {emit_gpr 0}, {emit_reg i.arg.(0)}\n`
` subfc {emit_reg i.res.(0)}, {emit_gpr 0}, {emit_reg i.arg.(0)}\n`
| Lop(Iintop_imm(Icomp cmp, n)) ->
begin match cmp with
Isigned c ->

6
asmcomp/power/proc.ml
View File

@ -45,14 +45,14 @@ let word_addressed = false
let int_reg_name =
if Config.system = "rhapsody" then
[| "r3"; "r4"; "r5"; "r6"; "r7"; "r8"; "r9"; "r10";
[| "r3"; "r4"; "r5"; "r6"; "r7"; "r8"; "r9"; "r10";
"r14"; "r15"; "r16"; "r17"; "r18"; "r19"; "r20"; "r21";
"r22"; "r23"; "r24"; "r25"; "r26"; "r27"; "r28" |]
else
[| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";
[| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";
"14"; "15"; "16"; "17"; "18"; "19"; "20"; "21";
"22"; "23"; "24"; "25"; "26"; "27"; "28" |]
let float_reg_name =
if Config.system = "rhapsody" then
[| "f1"; "f2"; "f3"; "f4"; "f5"; "f6"; "f7"; "f8";

1
asmcomp/power/scheduling.ml
View File

@ -63,4 +63,3 @@ method reload_retaddr_issue_cycles = 3
end
let fundecl f = (new scheduler)#schedule_fundecl f

2
asmcomp/power/selection.ml
View File

@ -69,7 +69,7 @@ method select_operation op args =
a power of 2, which do not correspond to an instruction. *)
(Cdivi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Idiv, n), [arg])
| (Cdivi, _) ->
| (Cdivi, _) ->
(Iintop Idiv, args)
| (Cmodi, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Imod, n), [arg])

6
asmcomp/printcmm.ml
View File

@ -108,7 +108,7 @@ let rec expr ppf = function
| Clet(id, def, body) ->
fprintf ppf
"@[<2>(let@ @[<2>%a@ %a@]@ %a)@]"
Ident.print id expr def sequence body
Ident.print id expr def sequence body
| Cassign(id, exp) ->
fprintf ppf "@[<2>(assign @[<2>%a@ %a@])@]" Ident.print id expr exp
| Ctuple el ->
@ -142,7 +142,7 @@ let rec expr ppf = function
for i = 0 to Array.length cases - 1 do
fprintf ppf "@ @[<2>%t@ %a@]" (print_case i) sequence cases.(i)
done in
fprintf ppf "@[<v 0>@[<2>(switch@ %a@ @]%t)@]" expr e1 print_cases
fprintf ppf "@[<v 0>@[<2>(switch@ %a@ @]%t)@]" expr e1 print_cases
| Cloop e ->
fprintf ppf "@[<2>(loop@ %a)@]" sequence e
| Ccatch(i, ids, e1, e2) ->
@ -172,7 +172,7 @@ let fundecl ppf f =
let print_cases ppf cases =
let first = ref true in
List.iter
(fun (id, ty) ->
(fun (id, ty) ->
if !first then first := false else fprintf ppf "@ ";
fprintf ppf "%a: %a" Ident.print id machtype ty)
cases in

2
asmcomp/printmach.ml
View File

@ -27,7 +27,7 @@ let reg ppf r =
fprintf ppf "/%i" r.stamp;
begin match r.loc with
| Unknown -> ()
| Reg r ->
| Reg r ->
fprintf ppf "[%s]" (Proc.register_name r)
| Stack(Local s) ->
fprintf ppf "[s%i]" s

2
asmcomp/reg.ml
View File

@ -82,7 +82,7 @@ let first_virtual_reg_stamp = ref (-1)
let reset() =
(* When reset() is called for the first time, the current stamp reflects
all hard pseudo-registers that have been allocated by Proc, so
remember it and use it as the base stamp for allocating
remember it and use it as the base stamp for allocating
soft pseudo-registers *)
if !first_virtual_reg_stamp = -1 then first_virtual_reg_stamp := !currstamp;
currstamp := !first_virtual_reg_stamp;

1
asmcomp/reload.mli
View File

@ -15,4 +15,3 @@
(* Insert load/stores for pseudoregs that got assigned to stack locations. *)
val fundecl: Mach.fundecl -> Mach.fundecl * bool

4
asmcomp/reloadgen.ml
View File

@ -109,13 +109,13 @@ method private reload i =
(self#reload i.next))}
| Iifthenelse(tst, ifso, ifnot) ->
let newarg = self#reload_test tst i.arg in
insert_moves i.arg newarg
insert_moves i.arg newarg
(instr_cons
(Iifthenelse(tst, self#reload ifso, self#reload ifnot)) newarg [||]
(self#reload i.next))
| Iswitch(index, cases) ->
let newarg = self#makeregs i.arg in
insert_moves i.arg newarg
insert_moves i.arg newarg
(instr_cons (Iswitch(index, Array.map (self#reload) cases)) newarg [||]
(self#reload i.next))
| Iloop body ->

4
asmcomp/schedgen.ml
View File

@ -91,7 +91,7 @@ let rec longest_path critical_outputs node =
then node.delay
else 0
| sons ->
node.length <-
node.length <-
List.fold_left
(fun len (son, delay) ->
max len (longest_path critical_outputs son + delay))
@ -287,7 +287,7 @@ method private ready_instruction date queue =
then instr else best in
extract new_best rem in
extract dummy_node queue
(* Schedule a basic block, adding its instructions in front of the given
instruction sequence *)

12
asmcomp/selectgen.ml
View File

@ -259,8 +259,8 @@ method select_operation op args =
| (Cnegf, _) -> (Inegf, args)
| (Cabsf, _) -> (Iabsf, args)
| (Caddf, _) -> (Iaddf, args)
| (Csubf, _) -> (Isubf, args)
| (Cmulf, _) -> (Imulf, args)
| (Csubf, _) -> (Isubf, args)
| (Cmulf, _) -> (Imulf, args)
| (Cdivf, _) -> (Idivf, args)
| (Cfloatofint, _) -> (Ifloatofint, args)
| (Cintoffloat, _) -> (Iintoffloat, args)
@ -381,7 +381,7 @@ method insert_move_results loc res stacksize =
self#insert_moves loc res
(* Add an Iop opcode. Can be overriden by processor description
to insert moves before and after the operation, i.e. for two-address
to insert moves before and after the operation, i.e. for two-address
instructions, or instructions using dedicated registers. *)
method insert_op_debug op dbg rs rd =
@ -506,7 +506,7 @@ method emit_expr env exp =
let r1 = self#emit_tuple env new_args in
let rd = self#regs_for ty in
Some (self#insert_op_debug op dbg r1 rd)
end
end
| Csequence(e1, e2) ->
begin match self#emit_expr env e1 with
None -> None
@ -545,7 +545,7 @@ method emit_expr env exp =
(fun id ->
let r = self#regs_for typ_addr in name_regs id r; r)
ids in
catch_regs := (nfail, Array.concat rs) :: !catch_regs ;
catch_regs := (nfail, Array.concat rs) :: !catch_regs ;
let (r1, s1) = self#emit_sequence env e1 in
catch_regs := List.tl !catch_regs ;
let new_env =
@ -768,7 +768,7 @@ method emit_tail env exp =
name_regs id r ;
r)
ids in
catch_regs := (nfail, Array.concat rs) :: !catch_regs ;
catch_regs := (nfail, Array.concat rs) :: !catch_regs ;
let s1 = self#emit_tail_sequence env e1 in
catch_regs := List.tl !catch_regs ;
let new_env =

2
asmcomp/selectgen.mli
View File

@ -62,7 +62,7 @@ class virtual selector_generic : object
(* The following method is the entry point and should not be overriden *)
method emit_fundecl : Cmm.fundecl -> Mach.fundecl
(* The following methods should not be overriden. They cannot be
declared "private" in the current implementation because they
are not always applied to "self", but ideally they should be private. *)

2
asmcomp/sparc/proc.ml
View File

@ -50,7 +50,7 @@ let int_reg_name = [|
(* 12-16 *) "%l0"; "%l1"; "%l2"; "%l3"; "%l4";
(* 17-18 *) "%g3"; "%g4"
|]
let float_reg_name = [|
(* 100-105 *) "%f0"; "%f2"; "%f4"; "%f6"; "%f8"; "%f10";
(* 106-109 *) "%f12"; "%f14"; "%f16"; "%f18";

1
asmcomp/sparc/scheduling.ml
View File

@ -62,4 +62,3 @@ method oper_issue_cycles = function
end
let fundecl f = (new scheduler)#schedule_fundecl f

5
asmcomp/spill.ml
View File

@ -12,7 +12,7 @@
(* $Id$ *)
(* Insertion of moves to suggest possible spilling / reloading points
(* Insertion of moves to suggest possible spilling / reloading points
before register allocation. *)
open Reg
@ -130,7 +130,7 @@ let find_reload_at_exit k =
List.assoc k !reload_at_exit
with
| Not_found -> Misc.fatal_error "Spill.find_reload_at_exit"
let reload_at_break = ref Reg.Set.empty
let rec reload i before =
@ -400,4 +400,3 @@ let fundecl f =
fun_args = f.fun_args;
fun_body = new_body;
fun_fast = f.fun_fast }

2
asmcomp/spill.mli
View File

@ -12,7 +12,7 @@
(* $Id$ *)
(* Insertion of moves to suggest possible spilling / reloading points
(* Insertion of moves to suggest possible spilling / reloading points
before register allocation. *)
val fundecl: Mach.fundecl -> Mach.fundecl

2
asmcomp/split.ml
View File

@ -189,7 +189,7 @@ let rec rename i sub =
| Iraise ->
(instr_cons_debug Iraise (subst_regs i.arg sub) [||] i.dbg i.next,
None)
(* Second pass: replace registers by their final representatives *)
let set_repres i =

2
asmrun/alpha.S
View File

@ -80,7 +80,7 @@ caml_allocN:
.set at
ret ($26)
.end caml_allocN
.globl caml_call_gc
.ent caml_call_gc
.align 3

2
asmrun/amd64.S
View File

@ -52,7 +52,7 @@ FUNCTION(G(caml_call_gc))
movq %rax, G(caml_last_return_address)(%rip)
leaq 8(%rsp), %rax
movq %rax, G(caml_bottom_of_stack)(%rip)
.L105:
.L105:
/* Save caml_young_ptr, caml_exception_pointer */
movq %r15, G(caml_young_ptr)(%rip)
movq %r14, G(caml_exception_pointer)(%rip)

126
asmrun/amd64nt.asm
View File

@ -1,13 +1,13 @@
;*********************************************************************
;
; Objective Caml
;
; Xavier Leroy, projet Gallium, INRIA Rocquencourt
; Objective Caml
;
; Copyright 2006 Institut National de Recherche en Informatique et
; en Automatique. All rights reserved. This file is distributed
; under the terms of the GNU Library General Public License, with
; the special exception on linking described in file ../LICENSE.
; Xavier Leroy, projet Gallium, INRIA Rocquencourt
;
; Copyright 2006 Institut National de Recherche en Informatique et
; en Automatique. All rights reserved. This file is distributed
; under the terms of the GNU Library General Public License, with
; the special exception on linking described in file ../LICENSE.
;
;*********************************************************************
@ -46,11 +46,11 @@ caml_call_gc:
mov caml_last_return_address, rax
lea rax, [rsp+8]
mov caml_bottom_of_stack, rax
L105:
L105:
; Save caml_young_ptr, caml_exception_pointer
mov caml_young_ptr, r15
mov caml_exception_pointer, r14
; Build array of registers, save it into caml_gc_regs
; Build array of registers, save it into caml_gc_regs
push r13
push r12
push rbp
@ -65,7 +65,7 @@ L105:
push rbx
push rax
mov caml_gc_regs, rsp
; Save floating-point registers
; Save floating-point registers
sub rsp, 16*8
movlpd QWORD PTR [rsp + 0*8], xmm0
movlpd QWORD PTR [rsp + 1*8], xmm1
@ -83,9 +83,9 @@ L105:
movlpd QWORD PTR [rsp + 13*8], xmm13
movlpd QWORD PTR [rsp + 14*8], xmm14
movlpd QWORD PTR [rsp + 15*8], xmm15
; Call the garbage collector
; Call the garbage collector
call caml_garbage_collection
; Restore all regs used by the code generator
; Restore all regs used by the code generator
movlpd xmm0, QWORD PTR [rsp + 0*8]
movlpd xmm1, QWORD PTR [rsp + 1*8]
movlpd xmm2, QWORD PTR [rsp + 2*8]
@ -116,10 +116,10 @@ L105:
pop rbp
pop r12
pop r13
; Restore caml_young_ptr, caml_exception_pointer
; Restore caml_young_ptr, caml_exception_pointer
mov r15, caml_young_ptr
mov r14, caml_exception_pointer
; Return to caller
; Return to caller
ret
PUBLIC caml_alloc1
@ -181,41 +181,41 @@ caml_allocN:
jb L103
ret
L103:
push rax ; save desired size
push rax ; save desired size
mov rax, [rsp + 8]
mov caml_last_return_address, rax
lea rax, [rsp + 16]
mov caml_bottom_of_stack, rax
call L105
pop rax ; recover desired size
pop rax ; recover desired size
jmp caml_allocN
; Call a C function from Caml
; Call a C function from Caml
PUBLIC caml_c_call
ALIGN 16
caml_c_call:
; Record lowest stack address and return address
; Record lowest stack address and return address
pop r12
mov caml_last_return_address, r12
mov caml_bottom_of_stack, rsp
; Make the exception handler and alloc ptr available to the C code
; Make the exception handler and alloc ptr available to the C code
mov caml_young_ptr, r15
mov caml_exception_pointer, r14
; Call the function (address in rax)
; Call the function (address in rax)
call rax
; Reload alloc ptr
; Reload alloc ptr
mov r15, caml_young_ptr
; Return to caller
; Return to caller
push r12
ret
; Start the Caml program
; Start the Caml program
PUBLIC caml_start_program
ALIGN 16
caml_start_program:
; Save callee-save registers
; Save callee-save registers
push rbx
push rbp
push rsi
@ -235,39 +235,39 @@ caml_start_program:
movapd OWORD PTR [rsp + 7*16], xmm13
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial entry point is caml_program
; Initial entry point is caml_program
lea r12, caml_program
; Common code for caml_start_program and caml_callback*
; Common code for caml_start_program and caml_callback*
L106:
; Build a callback link
sub rsp, 8 ; stack 16-aligned
; Build a callback link
sub rsp, 8 ; stack 16-aligned
push caml_gc_regs
push caml_last_return_address
push caml_bottom_of_stack
; Setup alloc ptr and exception ptr
; Setup alloc ptr and exception ptr
mov r15, caml_young_ptr
mov r14, caml_exception_pointer
; Build an exception handler
; Build an exception handler
lea r13, L108
push r13
push r14
mov r14, rsp
; Call the Caml code
; Call the Caml code
call r12
L107:
; Pop the exception handler
; Pop the exception handler
pop r14
pop r12 ; dummy register
pop r12 ; dummy register
L109:
; Update alloc ptr and exception ptr
; Update alloc ptr and exception ptr
mov caml_young_ptr, r15
mov caml_exception_pointer, r14
; Pop the callback restoring, link the global variables
; Pop the callback restoring, link the global variables
pop caml_bottom_of_stack
pop caml_last_return_address
pop caml_gc_regs
add rsp, 8
; Restore callee-save registers.
; Restore callee-save registers.
movapd xmm6, OWORD PTR [rsp + 0*16]
movapd xmm7, OWORD PTR [rsp + 1*16]
movapd xmm8, OWORD PTR [rsp + 2*16]
@ -291,7 +291,7 @@ L109:
ret
L108:
; Exception handler
; Mark the bucket as an exception result and return it
; Mark the bucket as an exception result and return it
or rax, 2
jmp L109
@ -318,7 +318,7 @@ L110:
pop r14 ; Recover previous exception handler
ret ; Branch to handler
; Raise an exception from C
; Raise an exception from C
PUBLIC caml_raise_exception
ALIGN 16
@ -327,8 +327,8 @@ caml_raise_exception:
jne L111
mov rax, rcx ; First argument is exn bucket
mov rsp, caml_exception_pointer
pop r14 ; Recover previous exception handler
mov r15, caml_young_ptr ; Reload alloc ptr
pop r14 ; Recover previous exception handler
mov r15, caml_young_ptr ; Reload alloc ptr
ret
L111:
mov r12, rcx ; Save exception bucket in r12
@ -340,16 +340,16 @@ L111:
call caml_stash_backtrace
mov rax, r12 ; Recover exception bucket
mov rsp, caml_exception_pointer
pop r14 ; Recover previous exception handler
mov r15, caml_young_ptr ; Reload alloc ptr
pop r14 ; Recover previous exception handler
mov r15, caml_young_ptr ; Reload alloc ptr
ret
; Callback from C to Caml
; Callback from C to Caml
PUBLIC caml_callback_exn
ALIGN 16
caml_callback_exn:
; Save callee-save registers
; Save callee-save registers
push rbx
push rbp
push rsi
@ -369,16 +369,16 @@ caml_callback_exn:
movapd OWORD PTR [rsp + 7*16], xmm13
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial loading of arguments
mov rbx, rcx ; closure
mov rax, rdx ; argument
mov r12, [rbx] ; code pointer
; Initial loading of arguments
mov rbx, rcx ; closure
mov rax, rdx ; argument
mov r12, [rbx] ; code pointer
jmp L106
PUBLIC caml_callback2_exn
ALIGN 16
caml_callback2_exn:
; Save callee-save registers
; Save callee-save registers
push rbx
push rbp
push rsi
@ -398,17 +398,17 @@ caml_callback2_exn:
movapd OWORD PTR [rsp + 7*16], xmm13
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial loading of arguments
; Initial loading of arguments
mov rdi, rcx ; closure
mov rax, rdx ; first argument
mov rbx, r8 ; second argument
lea r12, caml_apply2 ; code pointer
mov rax, rdx ; first argument
mov rbx, r8 ; second argument
lea r12, caml_apply2 ; code pointer
jmp L106
PUBLIC caml_callback3_exn
ALIGN 16
caml_callback3_exn:
; Save callee-save registers
; Save callee-save registers
push rbx
push rbp
push rsi
@ -428,12 +428,12 @@ caml_callback3_exn:
movapd OWORD PTR [rsp + 7*16], xmm13
movapd OWORD PTR [rsp + 8*16], xmm14
movapd OWORD PTR [rsp + 9*16], xmm15
; Initial loading of arguments
; Initial loading of arguments
mov rsi, rcx ; closure
mov rax, rdx ; first argument
mov rbx, r8 ; second argument
mov rdi, r9 ; third argument
lea r12, caml_apply3 ; code pointer
mov rax, rdx ; first argument
mov rbx, r8 ; second argument
mov rdi, r9 ; third argument
lea r12, caml_apply3 ; code pointer
jmp L106
PUBLIC caml_ml_array_bound_error
@ -445,10 +445,10 @@ caml_ml_array_bound_error:
.DATA
PUBLIC caml_system__frametable
caml_system__frametable LABEL QWORD
QWORD 1 ; one descriptor
QWORD L107 ; return address into callback
WORD -1 ; negative frame size => use callback link
WORD 0 ; no roots here
QWORD 1 ; one descriptor
QWORD L107 ; return address into callback
WORD -1 ; negative frame size => use callback link
WORD 0 ; no roots here
ALIGN 8
PUBLIC caml_negf_mask

5
asmrun/backtrace.c
View File

@ -131,7 +131,7 @@ static void extract_location_info(frame_descr * d,
uint32 info1, info2;
/* If no debugging information available, print nothing.
When everything is compiled with -g, this corresponds to
When everything is compiled with -g, this corresponds to
compiler-inserted re-raise operations. */
if ((d->frame_size & 1) == 0) {
li->loc_valid = 0;
@ -147,7 +147,7 @@ static void extract_location_info(frame_descr * d,
info2 = ((uint32 *)infoptr)[1];
/* Format of the two info words:
llllllllllllllllllll aaaaaaaa bbbbbbbbbb nnnnnnnnnnnnnnnnnnnnnnnn kk
44 36 26 2 0
44 36 26 2 0
(32+12) (32+4)
k ( 2 bits): 0 if it's a call, 1 if it's a raise
n (24 bits): offset (in 4-byte words) of file name relative to infoptr
@ -222,4 +222,3 @@ CAMLprim value caml_get_exception_backtrace(value unit)
res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
CAMLreturn(res);
}

2
asmrun/hppa.S
View File

@ -366,7 +366,7 @@ L102:
ldo LOW(G(caml_young_limit))(%r1), %r4
; Call the Caml code
ble 0(4, %r22)
copy %r31, %r2
copy %r31, %r2
L104:
; Pop the trap frame
ldw -8(%r30), %r31

109
asmrun/i386nt.asm
View File

@ -1,13 +1,13 @@
;*********************************************************************
;
; Objective Caml
;
; Xavier Leroy, projet Cristal, INRIA Rocquencourt
; Objective Caml
;
; Copyright 1996 Institut National de Recherche en Informatique et
; en Automatique. All rights reserved. This file is distributed
; under the terms of the GNU Library General Public License, with
; the special exception on linking described in file ../LICENSE.
; Xavier Leroy, projet Cristal, INRIA Rocquencourt
;
; Copyright 1996 Institut National de Recherche en Informatique et
; en Automatique. All rights reserved. This file is distributed
; under the terms of the GNU Library General Public License, with
; the special exception on linking described in file ../LICENSE.
;
;*********************************************************************
@ -32,7 +32,7 @@
EXTERN _caml_backtrace_active: DWORD
EXTERN _caml_stash_backtrace: PROC
; Allocation
; Allocation
.CODE
PUBLIC _caml_alloc1
@ -42,12 +42,12 @@
PUBLIC _caml_call_gc
_caml_call_gc:
; Record lowest stack address and return address
; Record lowest stack address and return address
mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
mov _caml_bottom_of_stack, eax
; Save all regs used by the code generator
; Save all regs used by the code generator
L105: push ebp
push edi
push esi
@ -56,9 +56,9 @@ L105: push ebp
push ebx
push eax
mov _caml_gc_regs, esp
; Call the garbage collector
; Call the garbage collector
call _caml_garbage_collection
; Restore all regs used by the code generator
; Restore all regs used by the code generator
pop eax
pop ebx
pop ecx
@ -66,8 +66,8 @@ L105: push ebp
pop esi
pop edi
pop ebp
; Return to caller
ret
; Return to caller
ret
ALIGN 4
_caml_alloc1:
@ -76,7 +76,7 @@ _caml_alloc1:
mov _caml_young_ptr, eax
cmp eax, _caml_young_limit
jb L100
ret
ret
L100: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
@ -91,7 +91,7 @@ _caml_alloc2:
mov _caml_young_ptr, eax
cmp eax, _caml_young_limit
jb L101
ret
ret
L101: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
@ -106,7 +106,7 @@ _caml_alloc3:
mov _caml_young_ptr, eax
cmp eax, _caml_young_limit
jb L102
ret
ret
L102: mov eax, [esp]
mov _caml_last_return_address, eax
lea eax, [esp+4]
@ -134,25 +134,25 @@ L103: sub eax, _caml_young_ptr ; eax = - size
pop eax ; recover desired size
jmp _caml_allocN
; Call a C function from Caml
; Call a C function from Caml
PUBLIC _caml_c_call
ALIGN 4
_caml_c_call:
; Record lowest stack address and return address
; Record lowest stack address and return address
mov edx, [esp]
mov _caml_last_return_address, edx
lea edx, [esp+4]
mov _caml_bottom_of_stack, edx
; Call the function (address in %eax)
; Call the function (address in %eax)
jmp eax
; Start the Caml program
; Start the Caml program
PUBLIC _caml_start_program
ALIGN 4
_caml_start_program:
; Save callee-save registers
; Save callee-save registers
push ebx
push esi
push edi
@ -163,20 +163,20 @@ _caml_start_program:
; Code shared between caml_start_program and callback*
L106:
; Build a callback link
; Build a callback link
push _caml_gc_regs
push _caml_last_return_address
push _caml_bottom_of_stack
; Build an exception handler
; Build an exception handler
push L108
push _caml_exception_pointer
mov _caml_exception_pointer, esp
; Call the Caml code
; Call the Caml code
call esi
L107:
; Pop the exception handler
; Pop the exception handler
pop _caml_exception_pointer
pop esi ; dummy register
pop esi ; dummy register
L109:
; Pop the callback link, restoring the global variables
; used by caml_c_call
@ -188,8 +188,8 @@ L109:
pop edi
pop esi
pop ebx
; Return to caller.
ret
; Return to caller.
ret
L108:
; Exception handler
; Mark the bucket as an exception result and return it
@ -205,7 +205,7 @@ _caml_raise_exn:
jne L110
mov esp, _caml_exception_pointer
pop _caml_exception_pointer
ret
ret
L110:
mov esi, eax ; Save exception bucket in esi
mov edi, _caml_exception_pointer ; SP of handler
@ -221,7 +221,7 @@ L110:
pop _caml_exception_pointer
ret
; Raise an exception from C
; Raise an exception from C
PUBLIC _caml_raise_exception
ALIGN 4
@ -231,7 +231,7 @@ _caml_raise_exception:
mov eax, [esp+4]
mov esp, _caml_exception_pointer
pop _caml_exception_pointer
ret
ret
L111:
mov esi, [esp+4] ; Save exception bucket in esi
push _caml_exception_pointer ; arg 4: SP of handler
@ -244,51 +244,51 @@ L111:
pop _caml_exception_pointer
ret
; Callback from C to Caml
; Callback from C to Caml
PUBLIC _caml_callback_exn
ALIGN 4
_caml_callback_exn:
; Save callee-save registers
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
mov ebx, [esp+20] ; closure
mov eax, [esp+24] ; argument
; Initial loading of arguments
mov ebx, [esp+20] ; closure
mov eax, [esp+24] ; argument
mov esi, [ebx] ; code pointer
jmp L106
PUBLIC _caml_callback2_exn
ALIGN 4
_caml_callback2_exn:
; Save callee-save registers
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
mov ecx, [esp+20] ; closure
mov eax, [esp+24] ; first argument
mov ebx, [esp+28] ; second argument
mov esi, offset _caml_apply2 ; code pointer
; Initial loading of arguments
mov ecx, [esp+20] ; closure
mov eax, [esp+24] ; first argument
mov ebx, [esp+28] ; second argument
mov esi, offset _caml_apply2 ; code pointer
jmp L106
PUBLIC _caml_callback3_exn
ALIGN 4
_caml_callback3_exn:
; Save callee-save registers
; Save callee-save registers
push ebx
push esi
push edi
push ebp
; Initial loading of arguments
mov edx, [esp+20] ; closure
mov eax, [esp+24] ; first argument
mov ebx, [esp+28] ; second argument
mov ecx, [esp+32] ; third argument
mov esi, offset _caml_apply3 ; code pointer
; Initial loading of arguments
mov edx, [esp+20] ; closure
mov eax, [esp+24] ; first argument
mov ebx, [esp+28] ; second argument
mov ecx, [esp+32] ; third argument
mov esi, offset _caml_apply3 ; code pointer
jmp L106
PUBLIC _caml_ml_array_bound_error
@ -310,14 +310,13 @@ _caml_ml_array_bound_error:
.DATA
PUBLIC _caml_system__frametable
_caml_system__frametable LABEL DWORD
DWORD 1 ; one descriptor
DWORD L107 ; return address into callback
WORD -1 ; negative frame size => use callback link
WORD 0 ; no roots here
DWORD 1 ; one descriptor
DWORD L107 ; return address into callback
WORD -1 ; negative frame size => use callback link
WORD 0 ; no roots here
PUBLIC _caml_extra_params
_caml_extra_params LABEL DWORD
BYTE 64 DUP (?)
END

4
asmrun/ia64.S
View File

@ -239,7 +239,7 @@ caml_start_program:
mov b6 = r2
/* Code shared with caml_callback* */
.L103:
.L103:
/* Allocate 64 "out" registers (for the Caml code) and no locals */
alloc r3 = ar.pfs, 0, 0, 64, 0
add sp = -(56 * 8), sp ;;
@ -503,7 +503,7 @@ caml_callback3_exn:
.align 16
caml_ml_array_bound_error:
ADDRGLOBAL(r2, @fptr(caml_array_bound_error#))
br.sptk caml_c_call /* never returns */
br.sptk caml_c_call /* never returns */
.rodata

13
asmrun/power-elf.S
View File

@ -204,7 +204,7 @@ caml_c_call:
Storeglobal(12, caml_last_return_address, 11)
/* Return to caller */
blr
/* Raise an exception from C */
.globl caml_raise_exception
@ -298,7 +298,7 @@ caml_start_program:
stw 11, 4(1)
mr 29, 1
/* Reload allocation pointers */
Loadglobal(31, caml_young_ptr, 11)
Loadglobal(31, caml_young_ptr, 11)
Loadglobal(30, caml_young_limit, 11)
/* Say we are back into Caml code */
li 0, 0
@ -316,9 +316,9 @@ caml_start_program:
lwz 9, 0(1)
lwz 10, 4(1)
lwz 11, 8(1)
Storeglobal(9, caml_bottom_of_stack, 12)
Storeglobal(10, caml_last_return_address, 12)
Storeglobal(11, caml_gc_regs, 12)
Storeglobal(9, caml_bottom_of_stack, 12)
Storeglobal(10, caml_last_return_address, 12)
Storeglobal(11, caml_gc_regs, 12)
addi 1, 1, 16
/* Update allocation pointer */
Storeglobal(31, caml_young_ptr, 11)
@ -396,7 +396,7 @@ caml_callback2_exn:
mr 5, 0
Addrglobal(12, caml_apply2)
b .L102
.globl caml_callback3_exn
.type caml_callback3_exn, @function
caml_callback3_exn:
@ -418,4 +418,3 @@ caml_system__frametable:
.long .L105 + 4 /* return address into callback */
.short -1 /* negative size count => use callback link */
.short 0 /* no roots here */

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamldep
View File

Binary file not shown.

2
build/buildbot
View File

@ -26,7 +26,7 @@ bad() {
}
finish_if_bad() {
if [ -f buildbot.failed ]; then
if [ -f buildbot.failed ]; then
finish
exit 2
fi

2
build/mkconfig.sh
View File

@ -8,5 +8,3 @@ sed -e 's/^\(.*\$([0-9]).*\)$/# \1/' \
-e 's/^FLEX.*$//g' \
-e 's/^\([^#=]*\)=\([^"]*\)$/if [ "x$\1" = "x" ]; then \1="\2"; fi/' \
config/Makefile > config/config.sh

4
build/myocamlbuild.sh
View File

@ -7,9 +7,9 @@ if [ ! -x _build/ocamlbuild/ocamlbuildlight.byte ]; then
(cd ocamlbuild && make)
fi
mkdir -p _build/ocamlbuild
for i in "light.cmo" "light.byte" "lightlib.cma" "_plugin.cmi" "_pack.cmi"
for i in "light.cmo" "light.byte" "lightlib.cma" "_plugin.cmi" "_pack.cmi"
do
cp ocamlbuild/_build/ocamlbuild$i _build/ocamlbuild
cp ocamlbuild/_build/ocamlbuild$i _build/ocamlbuild
done
fi
rm -f ocamlbuild/myocamlbuild_config.ml ocamlbuild/myocamlbuild_config.mli

3
bytecomp/bytelibrarian.ml
View File

@ -37,7 +37,7 @@ let copy_compunit ic oc compunit =
end
(* Add C objects and options and "custom" info from a library descriptor *)
let lib_sharedobjs = ref []
let lib_ccobjs = ref []
let lib_ccopts = ref []
@ -119,4 +119,3 @@ let report_error ppf = function
fprintf ppf "Cannot find file %s" name
| Not_an_object_file name ->
fprintf ppf "The file %s is not a bytecode object file" name

1
bytecomp/cmo_format.mli
View File

@ -58,4 +58,3 @@ type library =
...
object code for last library member
library descriptor *)

1
bytecomp/dll.ml
View File

@ -172,4 +172,3 @@ let init_toplevel dllpath =
opened_dlls := Array.to_list (get_current_dlls());
names_of_opened_dlls := [];
linking_in_core := true

1
bytecomp/dll.mli
View File

@ -58,4 +58,3 @@ val init_compile: bool -> unit
contents of ld.conf file). Take note of the DLLs that were opened
when starting the running program. *)
val init_toplevel: string -> unit

2
bytecomp/emitcode.ml
View File

@ -69,7 +69,7 @@ let out_const c =
out_int (const_as_int c)
with
| AsInt -> Misc.fatal_error "Emitcode.const_as_int"
(* Handling of local labels and backpatching *)

2
bytecomp/lambda.ml
View File

@ -423,5 +423,3 @@ and negate_comparison = function
| Ceq -> Cneq| Cneq -> Ceq
| Clt -> Cge | Cle -> Cgt
| Cgt -> Cle | Cge -> Clt

1
bytecomp/lambda.mli
View File

@ -205,4 +205,3 @@ val staticfail : lambda (* Anticipated static failure *)
(* Check anticipated failure, substitute its final value *)
val is_guarded: lambda -> bool
val patch_guarded : lambda -> lambda -> lambda

117
bytecomp/matching.ml
View File

@ -59,7 +59,7 @@ let pretty_ctx ctx =
let le_ctx c1 c2 =
le_pats c1.left c2.left &&
le_pats c1.right c2.right
let lshift {left=left ; right=right} = match right with
| x::xs -> {left=x::left ; right=xs}
| _ -> assert false
@ -77,7 +77,7 @@ let rec small_enough n = function
let ctx_lshift ctx =
if small_enough 31 ctx then
List.map lshift ctx
else (* Context pruning *) begin
else (* Context pruning *) begin
get_mins le_ctx (List.map lforget ctx)
end
@ -94,7 +94,7 @@ let rec nchars n ps =
let chars, cdrs = nchars (n-1) rem in
p::chars,cdrs
| _ -> assert false
let rshift_num n {left=left ; right=right} =
let shifted,left = nchars n left in
{left=left ; right = shifted@right}
@ -298,7 +298,7 @@ let rec jumps_extract i = function
let rec jumps_remove i = function
| [] -> []
| (j,_)::rem when i=j -> rem
| x::rem -> x::jumps_remove i rem
| x::rem -> x::jumps_remove i rem
let jumps_empty = []
and jumps_is_empty = function
@ -363,7 +363,7 @@ type pm_or_compiled =
or_matrix : matrix ; }
type pm_half_compiled =
| PmOr of pm_or_compiled
| PmOr of pm_or_compiled
| PmVar of pm_var_compiled
| Pm of pattern_matching
@ -507,7 +507,7 @@ exception Var of pattern
let simplify_or p =
let rec simpl_rec p = match p with
| {pat_desc = Tpat_any|Tpat_var _} -> raise (Var p)
| {pat_desc = Tpat_alias (q,id)} ->
| {pat_desc = Tpat_alias (q,id)} ->
begin try
{p with pat_desc = Tpat_alias (simpl_rec q,id)}
with
@ -515,15 +515,15 @@ let simplify_or p =
end
| {pat_desc = Tpat_or (p1,p2,o)} ->
let q1 = simpl_rec p1 in
begin try
begin try
let q2 = simpl_rec p2 in
{p with pat_desc = Tpat_or (q1, q2, o)}
with
with
| Var q2 -> raise (Var {p with pat_desc = Tpat_or (q1, q2, o)})
end
| {pat_desc = Tpat_record lbls} ->
let all_lbls = all_record_args lbls in
{p with pat_desc=Tpat_record all_lbls}
{p with pat_desc=Tpat_record all_lbls}
| _ -> p in
try
simpl_rec p
@ -577,7 +577,7 @@ let rec what_is_cases cases = match cases with
| (({pat_desc=(Tpat_var _|Tpat_or (_,_,_)|Tpat_alias (_,_))}::_),_)::_
-> assert false (* applies to simplified matchings only *)
| (p::_,_)::_ -> p
| [] -> omega
| [] -> omega
| _ -> assert false
@ -633,7 +633,7 @@ let mk_alpha_env arg aliases ids =
match arg with
| Some v -> v
| _ -> raise Cannot_flatten
else
else
Ident.create (Ident.name id))
ids
@ -646,10 +646,10 @@ let rec explode_or_pat arg patl mk_action rem vars aliases = function
| {pat_desc = Tpat_alias (p,id)} ->
explode_or_pat arg patl mk_action rem vars (id::aliases) p
| {pat_desc = Tpat_var x} ->
let env = mk_alpha_env arg (x::aliases) vars in
let env = mk_alpha_env arg (x::aliases) vars in
(omega::patl,mk_action (List.map snd env))::rem
| p ->
let env = mk_alpha_env arg aliases vars in
let env = mk_alpha_env arg aliases vars in
(alpha_pat env p::patl,mk_action (List.map snd env))::rem
let pm_free_variables {cases=cases} =
@ -758,7 +758,7 @@ let insert_or_append p ps act ors no =
else (* fail to insert or append *)
ors,(p::ps,act)::no
else if condb act_q ps qs then (* check condition (b) for append *)
attempt (cl::seen) rem
attempt (cl::seen) rem
else
ors,(p::ps,act)::no
else (* p # q, go on with append/insert *)
@ -781,7 +781,7 @@ let rec rebuild_default nexts def = match nexts with
| (e, pmh)::rem ->
(add_omega_column (rebuild_matrix pmh), e)::
rebuild_default rem def
let rebuild_nexts arg nexts k =
List.fold_right
(fun (e, pm) k -> (e, PmVar {inside=pm ; var_arg=arg})::k)
@ -840,7 +840,7 @@ let rec split_or argo cls args def =
| rem ->
let {me=next ; matrix=matrix ; top_default=def},nexts =
do_split [] [] [] rem in
let idef = next_raise_count () in
let idef = next_raise_count () in
precompile_or
argo yes yesor args
(cons_default matrix idef def)
@ -869,10 +869,10 @@ and split_constr cls args def k =
begin match yes with
| [] ->
(* Could not success in raising up a constr matching up *)
split_noex [cl] [] rem
split_noex [cl] [] rem
| _ ->
let {me=next ; matrix=matrix ; top_default=def}, nexts =
split_noex [cl] [] rem in
split_noex [cl] [] rem in
let idef = next_raise_count () in
let def = cons_default matrix idef def in
{me = Pm {cases=yes ; args=args ; default=def} ;
@ -936,7 +936,7 @@ and precompile_var args cls def k = match args with
and var_def = make_default (fun _ rem -> rem) def in
let {me=first ; matrix=matrix}, nexts =
split_or (Some v) var_cls (arg::rargs) var_def in
(* Compute top information *)
match nexts with
| [] -> (* If you need *)
@ -962,7 +962,7 @@ and precompile_or argo cls ors args def k = match ors with
| _ ->
let rec do_cases = function
| ({pat_desc=Tpat_or _} as orp::patl, action)::rem ->
let others,rem = get_equiv orp rem in
let others,rem = get_equiv orp rem in
let orpm =
{cases =
(patl, action)::
@ -1033,7 +1033,7 @@ let add make_matching_fun division key patl_action args =
cell.pm.cases <- [patl_action] ;
(key, cell) :: division
let divide make get_key get_args ctx pm =
let rec divide_rec = function
@ -1068,7 +1068,7 @@ let divide_line make_ctx make get_args pat ctx pm =
They may raise NoMatch or OrPat and perform the full
matching (selection + arguments).
- get_args and get_key are for the compiled matrices, note that
selection and geting arguments are separed.
@ -1103,7 +1103,7 @@ let make_constant_matching p def ctx = function
let def =
make_default
(matcher_const (get_key_constant "make" p)) def
and ctx =
and ctx =
filter_ctx p ctx in
{pm = {cases = []; args = argl ; default = def} ;
ctx = ctx ;
@ -1222,7 +1222,7 @@ let rec matcher_variant_const lab p rem = match p.pat_desc with
| Tpat_any -> rem
| _ -> raise NoMatch
let make_variant_matching_constant p lab def ctx = function
[] -> fatal_error "Matching.make_variant_matching_constant"
| ((arg, mut) :: argl) ->
@ -1269,7 +1269,7 @@ let divide_variant row ctx {cases = cl; args = al; default=def} =
match pato with
None ->
add (make_variant_matching_constant p lab def ctx) variants
(Cstr_constant tag) (patl, action) al
(Cstr_constant tag) (patl, action) al
| Some pat ->
add (make_variant_matching_nonconst p lab def ctx) variants
(Cstr_block tag) (pat :: patl, action) al
@ -1378,7 +1378,7 @@ let inline_lazy_force_switch arg loc =
Lprim(Pisint, [varg]), varg,
(Lswitch
(varg,
{ sw_numconsts = 0; sw_consts = [];
{ sw_numconsts = 0; sw_consts = [];
sw_numblocks = (max Obj.lazy_tag Obj.forward_tag) + 1;
sw_blocks =
[ (Obj.forward_tag, Lprim(Pfield 0, [varg]));
@ -1423,7 +1423,7 @@ let matcher_tuple arity p rem = match p.pat_desc with
| Tpat_or (_,_,_) -> raise OrPat
| Tpat_var _ -> get_args_tuple arity omega rem
| _ -> get_args_tuple arity p rem
let make_tuple_matching arity def = function
[] -> fatal_error "Matching.make_tuple_matching"
| (arg, mut) :: argl ->
@ -1525,7 +1525,7 @@ let divide_array kind ctx pm =
divide
(make_array_matching kind)
get_key_array get_args_array ctx pm
(* To combine sub-matchings together *)
let float_compare s1 s2 =
@ -1641,16 +1641,16 @@ let make_switch_switcher arg cases acts =
let l = ref [] in
for i = Array.length cases-1 downto 0 do
l := (i,acts.(cases.(i))) :: !l
done ;
done ;
Lswitch(arg,
{sw_numconsts = Array.length cases ; sw_consts = !l ;
sw_numblocks = 0 ; sw_blocks = [] ;
sw_failaction = None})
let full sw =
List.length sw.sw_consts = sw.sw_numconsts &&
List.length sw.sw_blocks = sw.sw_numblocks
let make_switch (arg,sw) = match sw.sw_failaction with
| None ->
let t = Hashtbl.create 17 in
@ -1685,7 +1685,7 @@ sw_failaction = Some (Lstaticraise (default,[]))})
else
Lswitch (arg,sw)
| _ -> Lswitch (arg,sw)
module SArg = struct
type primitive = Lambda.primitive
@ -1730,7 +1730,7 @@ let get_edges low high l = match l with
| [] -> low, high
| (x,_)::_ -> x, last high l
let as_interval_canfail fail low high l =
let store = mk_store equal_action in
let rec nofail_rec cur_low cur_high cur_act = function
@ -1897,12 +1897,12 @@ let mk_res get_key env last_choice idef cant_fail ctx =
let klist =
List.fold_right
(fun pat klist -> (get_key pat,act)::klist)
pats klist
pats klist
and ctx = if cant_fail then ctx else ctx_lub pat ctx in
klist,jumps_add i ctx jumps)
env ([],jumps_fail) in
fail, klist, jumps
(*
Following two ``failaction'' function compute n, the trap handler
@ -1923,8 +1923,8 @@ let mk_failaction_neg partial ctx def = match partial with
| Total ->
None, [], jumps_empty
(* Conforme a l'article et plus simple qu'avant *)
and mk_failaction_pos partial seen ctx defs =
let rec scan_def env to_test defs = match to_test,defs with
@ -1955,8 +1955,8 @@ and mk_failaction_pos partial seen ctx defs =
(complete_pats_constrs seen))
defs
let combine_constant arg cst partial ctx def
let combine_constant arg cst partial ctx def
(const_lambda_list, total, pats) =
let fail, to_add, local_jumps =
mk_failaction_neg partial ctx def in
@ -2016,12 +2016,12 @@ let split_cases tag_lambda_list =
let const, nonconst = split_rec tag_lambda_list in
sort_int_lambda_list const,
sort_int_lambda_list nonconst
let combine_constructor arg ex_pat cstr partial ctx def
(tag_lambda_list, total1, pats) =
if cstr.cstr_consts < 0 then begin
(* Special cases for exceptions *)
(* Special cases for exceptions *)
let fail, to_add, local_jumps =
mk_failaction_neg partial ctx def in
let tag_lambda_list = to_add@tag_lambda_list in
@ -2159,7 +2159,7 @@ let combine_variant row arg partial ctx def (tag_lambda_list, total1, pats) =
in
lambda1, jumps_union local_jumps total1
let combine_array arg kind partial ctx def
(len_lambda_list, total1, pats) =
let fail, to_add, local_jumps = mk_failaction_neg partial ctx def in
@ -2208,12 +2208,12 @@ let rec event_branch repr lam =
comp_match_handlers (for compililing splitted matches)
may reraise Unused
*)
exception Unused
exception Unused
let compile_list compile_fun division =
let compile_list compile_fun division =
let rec c_rec totals = function
| [] -> [], jumps_unions totals, []
@ -2222,7 +2222,7 @@ let compile_list compile_fun division =
| [] -> c_rec totals rem
| _ ->
try
let (lambda1, total1) = compile_fun cell.ctx cell.pm in
let (lambda1, total1) = compile_fun cell.ctx cell.pm in
let c_rem, total, new_pats =
c_rec
(jumps_map ctx_combine total1::totals) rem in
@ -2298,7 +2298,7 @@ let rec lower_bind v arg lam = match lam with
and pnot = approx_present v ifnot in
begin match pcond, pso, pnot with
| false, false, false -> lam
| false, true, false ->
| false, true, false ->
Lifthenelse (cond, lower_bind v arg ifso, ifnot)
| false, false, true ->
Lifthenelse (cond, ifso, lower_bind v arg ifnot)
@ -2315,19 +2315,19 @@ let rec lower_bind v arg lam = match lam with
bind Alias v arg lam
else
Llet (Alias, vv, lv, lower_bind v arg l)
| _ ->
| _ ->
bind Alias v arg lam
let bind_check str v arg lam = match str,arg with
| _, Lvar _ ->bind str v arg lam
| Alias,_ -> lower_bind v arg lam
| Alias,_ -> lower_bind v arg lam
| _,_ -> bind str v arg lam
let rec comp_exit ctx m = match m.default with
| (_,i)::_ -> Lstaticraise (i,[]), jumps_singleton i ctx
| _ -> fatal_error "Matching.comp_exit"
let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs = match next_matchs with
| [] -> comp_fun partial ctx arg first_match
@ -2336,7 +2336,7 @@ let rec comp_match_handlers comp_fun partial ctx arg first_match next_matchs = m
| [] -> body, total_body
(* Hum, -1 meant never taken
| (-1,pm)::rem -> c_rec body total_body rem *)
| (i,pm)::rem ->
| (i,pm)::rem ->
let ctx_i,total_rem = jumps_extract i total_body in
begin match ctx_i with
| [] -> c_rec body total_body rem
@ -2424,7 +2424,7 @@ and do_compile_matching_pr repr partial ctx arg x =
pretty_ctx ctx ;
let (_, jumps) as r = do_compile_matching repr partial ctx arg x in
prerr_endline "JUMPS" ;
pretty_jumps jumps ;
pretty_jumps jumps ;
r
*)
and do_compile_matching repr partial ctx arg pmh = match pmh with
@ -2432,7 +2432,7 @@ and do_compile_matching repr partial ctx arg pmh = match pmh with
let pat = what_is_cases pm.cases in
begin match pat.pat_desc with
| Tpat_any ->
compile_no_test
compile_no_test
divide_var ctx_rshift repr partial ctx pm
| Tpat_tuple patl ->
compile_no_test
@ -2453,7 +2453,7 @@ and do_compile_matching repr partial ctx arg pmh = match pmh with
(compile_match repr partial) partial
divide_constructor (combine_constructor arg pat cstr partial)
ctx pm
| Tpat_array _ ->
| Tpat_array _ ->
let kind = Typeopt.array_pattern_kind pat in
compile_test (compile_match repr partial) partial
(divide_array kind) (combine_array arg kind partial)
@ -2499,7 +2499,7 @@ let check_partial pat_act_list partial =
(fun (_,lam) -> is_guarded lam)
pat_act_list
then begin
Partial
Partial
end else
partial
@ -2590,7 +2590,7 @@ let for_tupled_function loc paraml pats_act_list partial =
let flatten_pattern size p = match p.pat_desc with
| Tpat_tuple args -> args
| Tpat_any -> omegas size
| Tpat_any -> omegas size
| _ -> raise Cannot_flatten
let rec flatten_pat_line size p k = match p.pat_desc with
@ -2666,7 +2666,7 @@ let do_for_multiple_match loc paraml pat_act_list partial =
{ cases = List.map (fun (pat, act) -> ([pat], act)) pat_act_list;
args = [Lprim(Pmakeblock(0, Immutable), paraml), Strict] ;
default = [] } in
try
try
(* Once for checking that compilation is possible *)
@ -2683,7 +2683,7 @@ let do_for_multiple_match loc paraml pat_act_list partial =
nexts in
let lam, total =
comp_match_handlers
comp_match_handlers
(compile_flattened repr)
partial (start_ctx size) () flat_next flat_nexts in
List.fold_right2 (bind Strict) idl paraml
@ -2728,4 +2728,3 @@ let for_multiple_match loc paraml pat_act_list partial =
let paraml = List.map (fun (v,_) -> Lvar v) v_paraml in
List.fold_right bind_opt v_paraml
(do_for_multiple_match loc paraml pat_act_list partial)

5
bytecomp/meta.ml
View File

@ -17,10 +17,11 @@ external realloc_global_data : int -> unit = "caml_realloc_global"
external static_alloc : int -> string = "caml_static_alloc"
external static_free : string -> unit = "caml_static_free"
external static_resize : string -> int -> string = "caml_static_resize"
external static_release_bytecode : string -> int -> unit = "caml_static_release_bytecode"
external static_release_bytecode : string -> int -> unit
= "caml_static_release_bytecode"
type closure = unit -> Obj.t
external reify_bytecode : string -> int -> closure = "caml_reify_bytecode"
external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
= "caml_invoke_traced_function"
external get_section_table : unit -> (string * Obj.t) list
= "caml_get_section_table"
= "caml_get_section_table"

5
bytecomp/meta.mli
View File

@ -18,11 +18,12 @@ external global_data : unit -> Obj.t array = "caml_get_global_data"
external realloc_global_data : int -> unit = "caml_realloc_global"
external static_alloc : int -> string = "caml_static_alloc"
external static_free : string -> unit = "caml_static_free"
external static_release_bytecode : string -> int -> unit = "caml_static_release_bytecode"
external static_release_bytecode : string -> int -> unit
= "caml_static_release_bytecode"
external static_resize : string -> int -> string = "caml_static_resize"
type closure = unit -> Obj.t
external reify_bytecode : string -> int -> closure = "caml_reify_bytecode"
external invoke_traced_function : Obj.t -> Obj.t -> Obj.t -> Obj.t
= "caml_invoke_traced_function"
external get_section_table : unit -> (string * Obj.t) list
= "caml_get_section_table"
= "caml_get_section_table"

10
bytecomp/simplif.ml
View File

@ -26,7 +26,7 @@ let rec eliminate_ref id = function
Lvar v as lam ->
if Ident.same v id then raise Real_reference else lam
| Lconst cst as lam -> lam
| Lapply(e1, el, loc) ->
| Lapply(e1, el, loc) ->
Lapply(eliminate_ref id e1, List.map (eliminate_ref id) el, loc)
| Lfunction(kind, params, body) as lam ->
if IdentSet.mem id (free_variables lam)
@ -85,7 +85,7 @@ let rec eliminate_ref id = function
(* Simplification of exits *)
let simplify_exits lam =
let simplify_exits lam =
(* Count occurrences of (exit n ...) statements *)
let exits = Hashtbl.create 17 in
@ -101,7 +101,7 @@ let simplify_exits lam =
incr (Hashtbl.find exits i)
with
| Not_found -> Hashtbl.add exits i (ref 1) in
let rec count = function
| (Lvar _| Lconst _) -> ()
| Lapply(l1, ll, _) -> count l1; List.iter count ll
@ -267,7 +267,7 @@ let simplify_lets lam =
!(Hashtbl.find occ v)
with Not_found ->
0
and incr_var v =
and incr_var v =
try
incr(Hashtbl.find occ v)
with Not_found ->
@ -388,7 +388,7 @@ let simplify_lets lam =
{sw with sw_consts = new_consts ; sw_blocks = new_blocks;
sw_failaction = new_fail})
| Lstaticraise (i,ls) ->
Lstaticraise (i, List.map simplif ls)
Lstaticraise (i, List.map simplif ls)
| Lstaticcatch(l1, (i,args), l2) ->
Lstaticcatch (simplif l1, (i,args), simplif l2)
| Ltrywith(l1, v, l2) -> Ltrywith(simplif l1, v, simplif l2)

72
bytecomp/switch.ml
View File

@ -20,7 +20,7 @@ let mk_store same =
let r_acts = ref [] in
let store act =
let rec store_rec i = function
| [] -> i,[act]
| [] -> i,[act]
| act0::rem ->
if same act0 act then raise (Found i)
else
@ -256,7 +256,7 @@ let coupe_inter i j cases =
Array.sub cases i (j-i+1),
case_append (Array.sub cases 0 i) (Array.sub cases (j+1) (lcases-(j+1)))
type kind = Kvalue of int | Kinter of int | Kempty
type kind = Kvalue of int | Kinter of int | Kempty
let pkind chan = function
| Kvalue i ->Printf.fprintf chan "V%d" i
@ -281,7 +281,7 @@ let make_key cases =
incr count ;
r
| (act0,index) :: rem ->
if act0 = act then
if act0 = act then
index
else
got_it act rem in
@ -291,7 +291,7 @@ let make_key cases =
Kvalue (got_it act !seen)
else
Kinter (got_it act !seen) in
let rec make_rec i pl =
if i < 0 then
[]
@ -303,8 +303,8 @@ let make_key cases =
Kempty::make_one l h act::make_rec (i-1) l in
let l,h,act = cases.(Array.length cases-1) in
make_one l h act::make_rec (Array.length cases-2) l
make_one l h act::make_rec (Array.length cases-2) l
let same_act t =
let len = Array.length t in
@ -330,7 +330,7 @@ let make_key cases =
This condition is checked by zyva
*)
let inter_limit = 1 lsl 16
let ok_inter = ref false
@ -356,7 +356,7 @@ let rec opt_count top cases =
divide top cases in
Hashtbl.add t key r ;
r
and divide top cases =
let lcases = Array.length cases in
let m = lcases/2 in
@ -372,12 +372,12 @@ and divide top cases =
else
add_test cm cml ;
Sep m,(cm, ci)
and heuristic top cases =
let lcases = Array.length cases in
let sep,csep = divide false cases
and inter,cinter =
if !ok_inter then begin
let _,_,act0 = cases.(0)
@ -398,18 +398,18 @@ and heuristic top cases =
end else
Inter (-1,-1),(too_much, too_much)
end else
Inter (-1,-1),(too_much, too_much) in
Inter (-1,-1),(too_much, too_much) in
if less2tests csep cinter then
sep,csep
else
inter,cinter
and enum top cases =
let lcases = Array.length cases in
let lim, with_sep =
let best = ref (-1) and best_cost = ref (too_much,too_much) in
for i = 1 to lcases-(1) do
let _,left,right = coupe cases i in
let ci = {n=1 ; ni=0}
@ -422,7 +422,7 @@ and enum top cases =
add_test cm cmr
else
add_test cm cml ;
if
less2tests (cm,ci) !best_cost
then begin
@ -488,45 +488,45 @@ and enum top cases =
r := Sep lim ; rc := with_sep
end ;
!r, !rc
let make_if_test konst test arg i ifso ifnot =
Arg.make_if
(Arg.make_prim test [arg ; konst i])
ifso ifnot
let make_if_lt konst arg i ifso ifnot = match i with
| 1 ->
make_if_test konst Arg.leint arg 0 ifso ifnot
| _ ->
make_if_test konst Arg.ltint arg i ifso ifnot
and make_if_le konst arg i ifso ifnot = match i with
| -1 ->
make_if_test konst Arg.ltint arg 0 ifso ifnot
| _ ->
make_if_test konst Arg.leint arg i ifso ifnot
and make_if_gt konst arg i ifso ifnot = match i with
| -1 ->
make_if_test konst Arg.geint arg 0 ifso ifnot
| _ ->
make_if_test konst Arg.gtint arg i ifso ifnot
and make_if_ge konst arg i ifso ifnot = match i with
| 1 ->
make_if_test konst Arg.gtint arg 0 ifso ifnot
| _ ->
make_if_test konst Arg.geint arg i ifso ifnot
and make_if_eq konst arg i ifso ifnot =
make_if_test konst Arg.eqint arg i ifso ifnot
and make_if_ne konst arg i ifso ifnot =
make_if_test konst Arg.neint arg i ifso ifnot
let do_make_if_out h arg ifso ifno =
Arg.make_if (Arg.make_isout h arg) ifso ifno
let make_if_out konst ctx l d mk_ifso mk_ifno = match l with
| 0 ->
do_make_if_out
@ -538,10 +538,10 @@ and enum top cases =
let ctx = {off= (-l+ctx.off) ; arg=arg} in
do_make_if_out
(konst d) arg (mk_ifso ctx) (mk_ifno ctx))
let do_make_if_in h arg ifso ifno =
Arg.make_if (Arg.make_isin h arg) ifso ifno
let make_if_in konst ctx l d mk_ifso mk_ifno = match l with
| 0 ->
do_make_if_in
@ -553,15 +553,15 @@ and enum top cases =
let ctx = {off= (-l+ctx.off) ; arg=arg} in
do_make_if_in
(konst d) arg (mk_ifso ctx) (mk_ifno ctx))
let rec c_test konst ctx ({cases=cases ; actions=actions} as s) =
let lcases = Array.length cases in
assert(lcases > 0) ;
if lcases = 1 then
actions.(get_act cases 0) ctx
else begin
let w,c = opt_count false cases in
(*
Printf.fprintf stderr
@ -624,7 +624,7 @@ and enum top cases =
make_if_ge konst
ctx.arg (lim+ctx.off)
(c_test konst ctx right) (c_test konst ctx left)
end
@ -687,7 +687,7 @@ let comp_clusters ({cases=cases ; actions=actions} as s) =
get_min (j-1) + 1 < min_clusters.(i)
then begin
k.(i) <- j ;
min_clusters.(i) <- get_min (j-1) + 1
min_clusters.(i) <- get_min (j-1) + 1
end
done ;
done ;
@ -766,15 +766,15 @@ let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
r.(ir) <- (l,h,add_index (make_switch s i j))
end ;
if i > 0 then zyva (i-1) (ir-1) in
zyva (len-1) (n_clusters-1) ;
let acts = Array.create !index (fun _ -> assert false) in
Hashtbl.iter (fun _ (i,act) -> acts.(i) <- act) t ;
{cases = r ; actions = acts}
;;
let zyva (low,high) konst arg cases actions =
let zyva (low,high) konst arg cases actions =
let old_ok = !ok_inter in
ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
if !ok_inter <> old_ok then Hashtbl.clear t ;
@ -793,7 +793,7 @@ let zyva (low,high) konst arg cases actions =
and test_sequence konst arg cases actions =
let old_ok = !ok_inter in
let old_ok = !ok_inter in
ok_inter := false ;
if !ok_inter <> old_ok then Hashtbl.clear t ;
let s =

2
bytecomp/switch.mli
View File

@ -67,7 +67,7 @@ module Make :
functor (Arg : S) ->
sig
val zyva :
(int * int) ->
(int * int) ->
(int -> Arg.act) ->
Arg.act ->
(int * int * int) array ->

10
bytecomp/symtable.ml
View File

@ -133,8 +133,8 @@ let output_primitive_table outchan =
let init () =
(* Enter the predefined exceptions *)
Array.iter
(fun name ->
Array.iter
(fun name ->
let id =
try List.assoc name Predef.builtin_values
with Not_found -> fatal_error "Symtable.init" in
@ -180,7 +180,7 @@ let patch_int buff pos n =
String.unsafe_set buff (pos + 2) (Char.unsafe_chr (n asr 16));
String.unsafe_set buff (pos + 3) (Char.unsafe_chr (n asr 24))
let patch_object buff patchlist =
let patch_object buff patchlist =
List.iter
(function
(Reloc_literal sc, pos) ->
@ -249,7 +249,7 @@ let update_global_table () =
(* Recover data for toplevel initialization. Data can come either from
executable file (normal case) or from linked-in data (-output-obj). *)
type section_reader = {
type section_reader = {
read_string: string -> string;
read_struct: string -> Obj.t;
close_reader: unit -> unit
@ -262,7 +262,7 @@ let read_sections () =
(fun name -> (Obj.magic(List.assoc name sections) : string));
read_struct =
(fun name -> List.assoc name sections);
close_reader =
close_reader =
(fun () -> ()) }
with Not_found ->
let ic = open_in_bin Sys.executable_name in

2
bytecomp/translmod.ml
View File

@ -84,7 +84,7 @@ let primitive_declarations = ref ([] : Primitive.description list)
let record_primitive = function
| {val_kind=Val_prim p} -> primitive_declarations := p :: !primitive_declarations
| _ -> ()
(* Keep track of the root path (from the root of the namespace to the
currently compiled module expression). Useful for naming exceptions. *)

2
bytecomp/translmod.mli
View File

@ -23,7 +23,7 @@ val transl_store_phrases: string -> structure -> int * lambda
val transl_store_implementation:
string -> structure * module_coercion -> int * lambda
val transl_toplevel_definition: structure -> lambda
val transl_package:
val transl_package:
Ident.t option list -> Ident.t -> module_coercion -> lambda
val transl_store_package:
Ident.t option list -> Ident.t -> module_coercion -> int * lambda

5
bytecomp/translobj.ml
View File

@ -112,8 +112,8 @@ let transl_store_label_init glob size f arg =
(size+1,
Lsequence(
Lprim(Psetfield(size, false),
[Lprim(Pgetglobal glob, []);
Lprim (Pccall prim_makearray, [int !method_count; int 0])]),
[Lprim(Pgetglobal glob, []);
Lprim (Pccall prim_makearray, [int !method_count; int 0])]),
expr))
in
(size, transl_label_init expr)
@ -157,4 +157,3 @@ let oo_wrap env req f x =
wrapping := false;
top_env := Env.empty;
raise exn

2
bytecomp/typeopt.ml
View File

@ -58,7 +58,7 @@ let array_element_kind env ty =
else if Path.same p Predef.path_float then
Pfloatarray
else if Path.same p Predef.path_string
|| Path.same p Predef.path_array
|| Path.same p Predef.path_array
|| Path.same p Predef.path_nativeint
|| Path.same p Predef.path_int32
|| Path.same p Predef.path_int64 then

2
byterun/Makefile.nt
View File

@ -22,7 +22,7 @@ OBJS=$(COMMONOBJS:.o=.$(O)) win32.$(O) main.$(O)
DOBJS=$(OBJS:.$(O)=.$(DBGO)) instrtrace.$(DBGO)
ocamlrun$(EXE): libcamlrun.$(A) prims.$(O)
$(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrun.$(A)
$(MKEXE) -o ocamlrun$(EXE) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrun.$(A)
ocamlrund$(EXE): libcamlrund.$(A) prims.$(O) main.$(O)
$(MKEXE) -o ocamlrun$(EXE) $(BYTECCDBGCOMPOPTS) prims.$(O) $(call SYSLIB,ws2_32) $(EXTRALIBS) libcamlrund.$(A)

2
byterun/array.c
View File

@ -34,7 +34,7 @@ CAMLprim value caml_array_get_float(value array, value index)
double d;
value res;
if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
caml_array_bound_error();
d = Double_field(array, idx);
#define Setup_for_gc

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