after forcing, match the pattern <pat>.
- Introduction of private abbreviation types "type t = private <type-expr>",
for abstracting the actual manifest type in type abbreviations.
+- Subtyping is now allowed between a private abbreviation and its definition,
+ and between a polymorphic method and its monomorphic instance.
Compilers:
- The file name for a compilation unit should correspond to a valid
float fields).
Native-code compiler:
+- New port: Mac OS X / Intel in 64-bit mode (configure with -cc "gcc -m64").
- A new option "-shared" to produce a plugin that can be dynamically
loaded with the native version of Dynlink.
- A new option "-nodynlink" to enable optimizations valid only for code
- Can select which assembler and asm options to use at configuration time.
Run-time system:
-- Changes in freelist management to reduce fragmentation.
-- New implementation of the page table describing the heap (a sparse
- hashtable replaces a dense bitvector), fixes issues with address
+- New implementation of the page table describing the heap (two-level
+ array in 32 bits, sparse hashtable in 64 bits), fixes issues with address
space randomization on 64-bit OS (PR#4448).
- New "generational" API for registering global memory roots with the GC,
enables faster scanning of global roots.
- Changes in implementation of dynamic linking of C code:
under Win32, use Alain Frisch's flexdll implementation of the dlopen
API; under MacOSX, use dlopen API instead of MacOSX bundle API.
+- Programs may now choose a first-fit allocation policy instead of
+ the default next-fit. First-fit reduces fragmentation but is
+ slightly slower in some cases.
Standard library:
- Parsing library: new function "set_trace" to programmatically turn
Tools:
- ocamldebug now supported under Windows (MSVC and Mingw ports),
- but without the replay feature. (Contributed by Sylvain Le Gall
- at OCamlCore with support from Lexifi.)
+ but without the replay feature. (Contributed by Dmitry Bely
+ and Sylvain Le Gall at OCamlCore with support from Lexifi.)
- ocamldoc: new option -no-module-constraint-filter to include functions
hidden by signature constraint in documentation.
- ocamlmklib and ocamldep.opt now available under Windows ports.
- PR#4564: add note "stack is not executable" to object files generated by
ocamlopt (Linux/x86, Linux/AMD64).
- PR#4566: bug in Ratio.approx_ratio_fix and Num.approx_num_fix.
-- PR#4582: weird behaviour of String.index_from and String.rindex_from.
+- PR#4582: clarified the documentation of functions in the String module.
- PR#4583: stack overflow in "ocamlopt -g" during closure conversion pass.
- PR#4585: ocamldoc and "val virtual" declarations.
- PR#4587: ocamldoc and escaped @ characters.
-- PR#4605: Buffer.add_substitute was sometime wrong when target string had backslashes.
+- PR#4605: Buffer.add_substitute was sometime wrong when target string had
+ backslashes.
- PR#4614: Inconsistent declaration of CamlCBCmd in LablTk library.
* First public release.
-<<<<<<< Changes
-<<<<<<< Changes
-$Id: Changes,v 1.183.2.1 2008/10/15 13:12:58 doligez Exp $
-=======
-$Id: Changes,v 1.183.2.1 2008/10/15 13:12:58 doligez Exp $
->>>>>>> 1.168.2.7
-=======
-$Id: Changes,v 1.183.2.1 2008/10/15 13:12:58 doligez Exp $
->>>>>>> 1.168.2.13
+$Id: Changes,v 1.183.2.7 2008/11/18 10:24:31 doligez Exp $
* The GNU C compiler gcc is recommended, as the bytecode
interpreter takes advantage of gcc-specific features to enhance
- performance.
+ performance. gcc is the standard compiler under Linux, MacOS X,
+ and many other systems.
-* Under HP/UX, the GNU C compiler gcc, the GNU assembler gas, and GNU make
- are all *required*. The vendor-provided compiler, assembler and make
- have major problems.
+* Under MacOS X 10.5, you need version 3.1 or later of the XCode
+ development tools. The version of XCode found on MacOS X 10.5
+ installation media causes linking problems. XCode updates
+ are available free of charge at http://developer.apple.com/tools/xcode/
* Under MacOS X up to version 10.2.8, you must raise the limit on the
stack size with one of the following commands:
* If you do not have write access to /tmp, you should set the environment
variable TMPDIR to the name of some other temporary directory.
+* Under HP/UX, the GNU C compiler gcc, the GNU assembler gas, and GNU make
+ are all *required*. The vendor-provided compiler, assembler and make
+ have major problems.
+
INSTALLATION INSTRUCTIONS
Installation in /usr, man pages in section "l":
./configure -bindir /usr/bin -libdir /usr/lib/ocaml -mandir /usr/man/manl
- On a MacOSX/PowerPC host, to build a 64-bit version of OCaml:
+ On a MacOSX/Intel Core 2 or MacOSX/PowerPC host, to build a 64-bit version
+ of OCaml:
./configure -cc "gcc -m64"
On a Linux x86/64 bits host, to build a 32-bit version of OCaml:
# #
#########################################################################
-# $Id: Makefile,v 1.222 2008/07/14 12:59:21 weis Exp $
+# $Id: Makefile,v 1.222.2.2 2008/10/23 15:29:11 ertai Exp $
# The main Makefile
cp toplevel/toploop.cmi toplevel/topdirs.cmi toplevel/topmain.cmi \
$(LIBDIR)
cd tools; $(MAKE) install
- -cd man; $(MAKE) install
+ -$(MAKE) -C man install
for i in $(OTHERLIBRARIES); do \
(cd otherlibs/$$i; $(MAKE) install) || exit $$?; \
done
# Camlp4
-camlp4out: ocamlc otherlibraries ocamlbuild-partial-boot ocamlbuild.byte
+camlp4out: ocamlc otherlibraries ocamlbuild-mixed-boot ocamlbuild.byte
./build/camlp4-byte-only.sh
-camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-partial-boot ocamlbuild.native
+camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot ocamlbuild.native
./build/camlp4-native-only.sh
# Ocamlbuild
-ocamlbuild.byte: ocamlc otherlibraries ocamlbuild-partial-boot
+ocamlbuild.byte: ocamlc otherlibraries ocamlbuild-mixed-boot
./build/ocamlbuild-byte-only.sh
-ocamlbuild.native: ocamlopt otherlibrariesopt ocamlbuild-partial-boot
+ocamlbuild.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot
./build/ocamlbuild-native-only.sh
-ocamlbuildlib.native: ocamlopt otherlibrariesopt ocamlbuild-partial-boot
+ocamlbuildlib.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot
./build/ocamlbuildlib-native-only.sh
-ocamlbuild-partial-boot: ocamlc otherlibraries
- ./build/partial-boot.sh
+ocamlbuild-mixed-boot: ocamlc otherlibraries
+ ./build/mixed-boot.sh
partialclean::
rm -rf _build
.PHONY: partialclean beforedepend alldepend cleanboot coldstart
.PHONY: compare core coreall
.PHONY: coreboot defaultentry depend distclean install installopt
-.PHONY: library library-cross libraryopt ocamlbuild-partial-boot
+.PHONY: library library-cross libraryopt ocamlbuild-mixed-boot
.PHONY: ocamlbuild.byte ocamlbuild.native ocamldebugger ocamldoc
.PHONY: ocamldoc.opt ocamllex ocamllex.opt ocamltools ocamltools.opt
.PHONY: ocamlyacc opt-core opt opt.opt otherlibraries
# #
#########################################################################
-# $Id: Makefile.nt,v 1.113 2008/07/29 08:31:41 xleroy Exp $
+# $Id: Makefile.nt,v 1.113.2.1 2008/11/10 16:13:20 ertai Exp $
# The main Makefile
# Camlp4
-camlp4out: ocamlc otherlibraries ocamlbuild-partial-boot ocamlbuild.byte
+camlp4out: ocamlc otherlibraries ocamlbuild-mixed-boot ocamlbuild.byte
./build/camlp4-byte-only.sh
-camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-partial-boot ocamlbuild.native
+camlp4opt: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot ocamlbuild.native
./build/camlp4-native-only.sh
# Ocamlbuild
-ocamlbuild.byte: ocamlc otherlibraries ocamlbuild-partial-boot
+ocamlbuild.byte: ocamlc otherlibraries ocamlbuild-mixed-boot
./build/ocamlbuild-byte-only.sh
-ocamlbuild.native: ocamlopt otherlibrariesopt ocamlbuild-partial-boot
+ocamlbuild.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot
./build/ocamlbuild-native-only.sh
-ocamlbuildlib.native: ocamlopt otherlibrariesopt ocamlbuild-partial-boot
+ocamlbuildlib.native: ocamlopt otherlibrariesopt ocamlbuild-mixed-boot
./build/ocamlbuildlib-native-only.sh
-.PHONY: ocamlbuild-partial-boot
-ocamlbuild-partial-boot:
- ./build/partial-boot.sh
+.PHONY: ocamlbuild-mixed-boot
+ocamlbuild-mixed-boot:
+ ./build/mixed-boot.sh
partialclean::
rm -rf _build
-3.11.0+beta1
+3.11.0+rc1
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
-# $Id: VERSION,v 1.26.2.2 2008/10/15 13:12:58 doligez Exp $
+# $Id: VERSION,v 1.26.2.6 2008/11/24 16:30:40 doligez Exp $
<camlp4/Camlp4_{config,import}.ml*>: -camlp4boot
"camlp4/Camlp4_import.ml": -warn_Ale
<camlp4/build/*> or <camlp4/boot/*> or "camlp4/Camlp4/Struct/Lexer.ml": -camlp4boot, -warn_Ale, warn_a
-<camlp4/Camlp4Bin.{byte,native}> or "camlp4/camlp4lib.cma" or <camlp4/{mkcamlp4,boot/camlp4boot}.byte>: use_dynlink
+<camlp4/Camlp4Bin.{byte,native}> or <camlp4/{mkcamlp4,boot/camlp4boot}.byte>: use_dynlink
"camlp4/Camlp4/Printers/OCaml.ml" or "camlp4/Camlp4/Printers/OCamlr.ml": warn_Alezv
<camlp4/Camlp4Printers/**.ml>: include_unix
"camlp4/Camlp4/Struct/DynLoader.ml" or "camlp4/boot/Camlp4.ml": include_dynlink
(* *)
(***********************************************************************)
-(* $Id: emit.mlp,v 1.16 2008/08/01 08:04:57 xleroy Exp $ *)
+(* $Id: emit.mlp,v 1.16.2.2 2008/11/08 16:08:09 xleroy Exp $ *)
(* Emission of x86-64 (AMD 64) assembly code *)
open Linearize
open Emitaux
+let macosx =
+ match Config.system with
+ | "macosx" -> true
+ | _ -> false
+
+
(* Tradeoff between code size and code speed *)
let fastcode_flag = ref true
(* Symbols *)
let emit_symbol s =
- Emitaux.emit_symbol '$' s
+ if macosx then emit_string "_";
+ Emitaux.emit_symbol '$' s
let emit_call s =
- if !Clflags.dlcode
+ if !Clflags.dlcode && not macosx
then `call {emit_symbol s}@PLT`
else `call {emit_symbol s}`
let emit_jump s =
- if !Clflags.dlcode
+ if !Clflags.dlcode && not macosx
then `jmp {emit_symbol s}@PLT`
else `jmp {emit_symbol s}`
(* Output a .align directive. *)
let emit_align n =
+ let n = if macosx then Misc.log2 n else n in
` .align {emit_int n}\n`
let emit_Llabel fallthrough lbl =
end else begin
` jmp *{emit_label lbl}(, {emit_reg i.arg.(0)}, 8)\n`
end;
- ` .section .rodata\n`;
+ if macosx
+ then ` .const\n`
+ else ` .section .rodata\n`;
emit_align 8;
`{emit_label lbl}:`;
for i = 0 to Array.length jumptbl - 1 do
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
if !float_constants <> [] then begin
- ` .section .rodata.cst8,\"a\",@progbits\n`;
+ if macosx
+ then ` .literal8\n`
+ else ` .section .rodata.cst8,\"a\",@progbits\n`;
List.iter emit_float_constant !float_constants
- end
+ end;
+ match Config.system with
+ "linux" | "gnu" ->
+ ` .type {emit_symbol fundecl.fun_name},@function\n`;
+ ` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n`
+ | _ -> ()
(* Emission of data *)
let begin_assembly() =
if !Clflags.dlcode then begin
(* from amd64.S; could emit these constants on demand *)
- ` .section .rodata.cst8,\"a\",@progbits\n`;
- ` .align 16\n`;
- `caml_negf_mask: .quad 0x8000000000000000, 0\n`;
- ` .align 16\n`;
- `caml_absf_mask: .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+ if macosx then begin
+ ` .literal16\n`;
+ ` .align 4\n`;
+ `caml_negf_mask: .quad 0x8000000000000000, 0\n`;
+ ` .align 4\n`;
+ `caml_absf_mask: .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+ end else begin
+ ` .section .rodata.cst8,\"a\",@progbits\n`;
+ ` .align 16\n`;
+ `caml_negf_mask: .quad 0x8000000000000000, 0\n`;
+ ` .align 16\n`;
+ `caml_absf_mask: .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n`;
+ end;
end;
let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
` .data\n`;
let end_assembly() =
let lbl_end = Compilenv.make_symbol (Some "code_end") in
` .text\n`;
+ if macosx then ` NOP\n`; (* suppress "ld warning: atom sorting error" *)
` .globl {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
` .data\n`;
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
efa_word = (fun n -> ` .quad {emit_int n}\n`);
efa_align = emit_align;
- efa_label_rel = (fun lbl ofs ->
- ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`);
+ efa_label_rel =
+ if macosx then begin
+ let setcnt = ref 0 in
+ fun lbl ofs ->
+ incr setcnt;
+ ` .set L$set${emit_int !setcnt}, ({emit_label lbl} - .) + {emit_int32 ofs}\n`;
+ ` .long L$set${emit_int !setcnt}\n`
+ end else begin
+ fun lbl ofs ->
+ ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`
+ end;
efa_def_label = (fun l -> `{emit_label l}:\n`);
efa_string = (fun s -> emit_string_directive " .asciz " s) };
if Config.system = "linux" then
(* *)
(***********************************************************************)
-(* $Id: selection.ml,v 1.7 2007/11/06 15:16:55 frisch Exp $ *)
+(* $Id: selection.ml,v 1.7.4.1 2008/10/29 14:32:01 xleroy Exp $ *)
(* Instruction selection for the AMD64 *)
method is_immediate_natint n = n <= 0x7FFFFFFFn && n >= -0x80000000n
method select_addressing exp =
- match select_addr exp with
- (Asymbol s, d) ->
- (Ibased(s, d), Ctuple [])
- | (Alinear e, d) ->
- (Iindexed d, e)
- | (Aadd(e1, e2), d) ->
- (Iindexed2 d, Ctuple[e1; e2])
- | (Ascale(e, scale), d) ->
- (Iscaled(scale, d), e)
- | (Ascaledadd(e1, e2, scale), d) ->
- (Iindexed2scaled(scale, d), Ctuple[e1; e2])
+ let (a, d) = select_addr exp in
+ (* PR#4625: displacement must be a signed 32-bit immediate *)
+ if d < -0x8000_0000 || d > 0x7FFF_FFFF
+ then (Iindexed 0, exp)
+ else match a with
+ | Asymbol s ->
+ (Ibased(s, d), Ctuple [])
+ | Alinear e ->
+ (Iindexed d, e)
+ | Aadd(e1, e2) ->
+ (Iindexed2 d, Ctuple[e1; e2])
+ | Ascale(e, scale) ->
+ (Iscaled(scale, d), e)
+ | Ascaledadd(e1, e2, scale) ->
+ (Iindexed2scaled(scale, d), Ctuple[e1; e2])
method select_store addr exp =
match exp with
(* *)
(***********************************************************************)
-(* $Id: emit.mlp,v 1.41 2008/08/01 08:04:57 xleroy Exp $ *)
+(* $Id: emit.mlp,v 1.41.2.2 2008/11/08 16:08:09 xleroy Exp $ *)
(* Emission of Intel 386 assembly code *)
` popl %eax\n`
| _ -> () (*unsupported yet*)
-(* Declare a global function symbol *)
-
-let declare_function_symbol name =
- ` .globl {emit_symbol name}\n`;
- match Config.system with
- "linux_elf" | "bsd_elf" | "gnu" ->
- ` .type {emit_symbol name},@function\n`
- | _ -> ()
-
(* Emission of a function declaration *)
let fundecl fundecl =
bound_error_call := 0;
` .text\n`;
emit_align 16;
- declare_function_symbol fundecl.fun_name;
+ ` .globl {emit_symbol fundecl.fun_name}\n`;
`{emit_symbol fundecl.fun_name}:\n`;
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
emit_call_bound_errors ();
- List.iter emit_float_constant !float_constants
+ List.iter emit_float_constant !float_constants;
+ match Config.system with
+ "linux_elf" | "bsd_elf" | "gnu" ->
+ ` .type {emit_symbol fundecl.fun_name},@function\n`;
+ ` .size {emit_symbol fundecl.fun_name},.-{emit_symbol fundecl.fun_name}\n`
+ | _ -> ()
+
(* Emission of data *)
let end_assembly() =
let lbl_end = Compilenv.make_symbol (Some "code_end") in
` .text\n`;
+ if macosx then ` NOP\n`; (* suppress "ld warning: atom sorting error" *)
` .globl {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
` .data\n`;
../byterun/misc.h ../byterun/config.h ../byterun/backtrace.h \
../byterun/mlvalues.h ../byterun/custom.h ../byterun/mlvalues.h \
../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
+ ../byterun/freelist.h ../byterun/misc.h ../byterun/mlvalues.h \
../byterun/gc.h ../byterun/mlvalues.h ../byterun/gc_ctrl.h \
../byterun/misc.h ../byterun/memory.h ../byterun/config.h \
../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/osdeps.h ../byterun/misc.h \
- ../byterun/printexc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/sys.h ../byterun/misc.h natdynlink.h
+ ../byterun/misc.h ../byterun/minor_gc.h ../byterun/misc.h \
+ ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \
+ ../byterun/misc.h ../byterun/printexc.h ../byterun/misc.h \
+ ../byterun/mlvalues.h ../byterun/sys.h ../byterun/misc.h natdynlink.h
str.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
../byterun/config.h ../byterun/misc.h ../byterun/fail.h \
../byterun/misc.h ../byterun/config.h ../byterun/backtrace.h \
../byterun/mlvalues.h ../byterun/custom.h ../byterun/mlvalues.h \
../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
+ ../byterun/freelist.h ../byterun/misc.h ../byterun/mlvalues.h \
../byterun/gc.h ../byterun/mlvalues.h ../byterun/gc_ctrl.h \
../byterun/misc.h ../byterun/memory.h ../byterun/config.h \
../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/osdeps.h ../byterun/misc.h \
- ../byterun/printexc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/sys.h ../byterun/misc.h natdynlink.h
+ ../byterun/misc.h ../byterun/minor_gc.h ../byterun/misc.h \
+ ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \
+ ../byterun/misc.h ../byterun/printexc.h ../byterun/misc.h \
+ ../byterun/mlvalues.h ../byterun/sys.h ../byterun/misc.h natdynlink.h
str.d.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
../byterun/config.h ../byterun/misc.h ../byterun/fail.h \
../byterun/misc.h ../byterun/config.h ../byterun/backtrace.h \
../byterun/mlvalues.h ../byterun/custom.h ../byterun/mlvalues.h \
../byterun/fail.h ../byterun/misc.h ../byterun/mlvalues.h \
+ ../byterun/freelist.h ../byterun/misc.h ../byterun/mlvalues.h \
../byterun/gc.h ../byterun/mlvalues.h ../byterun/gc_ctrl.h \
../byterun/misc.h ../byterun/memory.h ../byterun/config.h \
../byterun/gc.h ../byterun/major_gc.h ../byterun/freelist.h \
- ../byterun/misc.h ../byterun/mlvalues.h ../byterun/misc.h \
- ../byterun/minor_gc.h ../byterun/misc.h ../byterun/misc.h \
- ../byterun/mlvalues.h ../byterun/osdeps.h ../byterun/misc.h \
- ../byterun/printexc.h ../byterun/misc.h ../byterun/mlvalues.h \
- ../byterun/sys.h ../byterun/misc.h natdynlink.h
+ ../byterun/misc.h ../byterun/minor_gc.h ../byterun/misc.h \
+ ../byterun/misc.h ../byterun/mlvalues.h ../byterun/osdeps.h \
+ ../byterun/misc.h ../byterun/printexc.h ../byterun/misc.h \
+ ../byterun/mlvalues.h ../byterun/sys.h ../byterun/misc.h natdynlink.h
str.p.o: str.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.h \
../byterun/../config/m.h ../byterun/../config/s.h ../byterun/mlvalues.h \
../byterun/config.h ../byterun/misc.h ../byterun/fail.h \
/* */
/***********************************************************************/
-/* $Id: amd64.S,v 1.12 2008/08/01 08:04:57 xleroy Exp $ */
+/* $Id: amd64.S,v 1.12.2.1 2008/11/07 10:34:16 xleroy Exp $ */
/* Asm part of the runtime system, AMD64 processor */
/* Must be preprocessed by cpp */
-#define FUNCTION_ALIGN 4
+#ifdef SYS_macosx
+
+#define G(r) _##r
+#define FUNCTION_ALIGN 2
+#define EIGHT_ALIGN 3
+#define SIXTEEN_ALIGN 4
+#define FUNCTION(name) \
+ .globl name; \
+ .align FUNCTION_ALIGN; \
+ name:
+#else
+
+#define G(r) r
+#define FUNCTION_ALIGN 4
+#define EIGHT_ALIGN 8
+#define SIXTEEN_ALIGN 16
#define FUNCTION(name) \
.globl name; \
- .type name,@function; \
+ .type name,@function; \
.align FUNCTION_ALIGN; \
name:
+#endif
+
+
.text
/* Allocation */
-FUNCTION(caml_call_gc)
+FUNCTION(G(caml_call_gc))
/* Record lowest stack address and return address */
movq 0(%rsp), %rax
- movq %rax, caml_last_return_address(%rip)
+ movq %rax, G(caml_last_return_address)(%rip)
leaq 8(%rsp), %rax
- movq %rax, caml_bottom_of_stack(%rip)
+ movq %rax, G(caml_bottom_of_stack)(%rip)
.L105:
/* Save caml_young_ptr, caml_exception_pointer */
- movq %r15, caml_young_ptr(%rip)
- movq %r14, caml_exception_pointer(%rip)
+ movq %r15, G(caml_young_ptr)(%rip)
+ movq %r14, G(caml_exception_pointer)(%rip)
/* Build array of registers, save it into caml_gc_regs */
pushq %r13
pushq %r12
pushq %rdi
pushq %rbx
pushq %rax
- movq %rsp, caml_gc_regs(%rip)
+ movq %rsp, G(caml_gc_regs)(%rip)
/* Save floating-point registers */
subq $(16*8), %rsp
movlpd %xmm0, 0*8(%rsp)
movlpd %xmm14, 14*8(%rsp)
movlpd %xmm15, 15*8(%rsp)
/* Call the garbage collector */
- call caml_garbage_collection
+ call G(caml_garbage_collection)
/* Restore all regs used by the code generator */
movlpd 0*8(%rsp), %xmm0
movlpd 1*8(%rsp), %xmm1
popq %r12
popq %r13
/* Restore caml_young_ptr, caml_exception_pointer */
- movq caml_young_ptr(%rip), %r15
- movq caml_exception_pointer(%rip), %r14
+ movq G(caml_young_ptr)(%rip), %r15
+ movq G(caml_exception_pointer)(%rip), %r14
/* Return to caller */
ret
-FUNCTION(caml_alloc1)
+FUNCTION(G(caml_alloc1))
subq $16, %r15
- cmpq caml_young_limit(%rip), %r15
+ cmpq G(caml_young_limit)(%rip), %r15
jb .L100
ret
.L100:
movq 0(%rsp), %rax
- movq %rax, caml_last_return_address(%rip)
+ movq %rax, G(caml_last_return_address)(%rip)
leaq 8(%rsp), %rax
- movq %rax, caml_bottom_of_stack(%rip)
+ movq %rax, G(caml_bottom_of_stack)(%rip)
subq $8, %rsp
call .L105
addq $8, %rsp
- jmp caml_alloc1
+ jmp G(caml_alloc1)
-FUNCTION(caml_alloc2)
+FUNCTION(G(caml_alloc2))
subq $24, %r15
- cmpq caml_young_limit(%rip), %r15
+ cmpq G(caml_young_limit)(%rip), %r15
jb .L101
ret
.L101:
movq 0(%rsp), %rax
- movq %rax, caml_last_return_address(%rip)
+ movq %rax, G(caml_last_return_address)(%rip)
leaq 8(%rsp), %rax
- movq %rax, caml_bottom_of_stack(%rip)
+ movq %rax, G(caml_bottom_of_stack)(%rip)
subq $8, %rsp
call .L105
addq $8, %rsp
- jmp caml_alloc2
+ jmp G(caml_alloc2)
-FUNCTION(caml_alloc3)
+FUNCTION(G(caml_alloc3))
subq $32, %r15
- cmpq caml_young_limit(%rip), %r15
+ cmpq G(caml_young_limit)(%rip), %r15
jb .L102
ret
.L102:
movq 0(%rsp), %rax
- movq %rax, caml_last_return_address(%rip)
+ movq %rax, G(caml_last_return_address)(%rip)
leaq 8(%rsp), %rax
- movq %rax, caml_bottom_of_stack(%rip)
+ movq %rax, G(caml_bottom_of_stack)(%rip)
subq $8, %rsp
call .L105
addq $8, %rsp
- jmp caml_alloc3
+ jmp G(caml_alloc3)
-FUNCTION(caml_allocN)
+FUNCTION(G(caml_allocN))
subq %rax, %r15
- cmpq caml_young_limit(%rip), %r15
+ cmpq G(caml_young_limit)(%rip), %r15
jb .L103
ret
.L103:
pushq %rax /* save desired size */
movq 8(%rsp), %rax
- movq %rax, caml_last_return_address(%rip)
+ movq %rax, G(caml_last_return_address)(%rip)
leaq 16(%rsp), %rax
- movq %rax, caml_bottom_of_stack(%rip)
+ movq %rax, G(caml_bottom_of_stack)(%rip)
call .L105
popq %rax /* recover desired size */
- jmp caml_allocN
+ jmp G(caml_allocN)
/* Call a C function from Caml */
-FUNCTION(caml_c_call)
+FUNCTION(G(caml_c_call))
/* Record lowest stack address and return address */
popq %r12
- movq %r12, caml_last_return_address(%rip)
- movq %rsp, caml_bottom_of_stack(%rip)
+ movq %r12, G(caml_last_return_address)(%rip)
+ movq %rsp, G(caml_bottom_of_stack)(%rip)
/* Make the exception handler and alloc ptr available to the C code */
- movq %r15, caml_young_ptr(%rip)
- movq %r14, caml_exception_pointer(%rip)
+ movq %r15, G(caml_young_ptr)(%rip)
+ movq %r14, G(caml_exception_pointer)(%rip)
/* Call the function (address in %rax) */
call *%rax
/* Reload alloc ptr */
- movq caml_young_ptr(%rip), %r15
+ movq G(caml_young_ptr)(%rip), %r15
/* Return to caller */
pushq %r12
ret
/* Start the Caml program */
-FUNCTION(caml_start_program)
+FUNCTION(G(caml_start_program))
/* Save callee-save registers */
pushq %rbx
pushq %rbp
pushq %r14
pushq %r15
subq $8, %rsp /* stack 16-aligned */
- /* Initial entry point is caml_program */
- leaq caml_program(%rip), %r12
+ /* Initial entry point is G(caml_program) */
+ leaq G(caml_program)(%rip), %r12
/* Common code for caml_start_program and caml_callback* */
.L106:
/* Build a callback link */
subq $8, %rsp /* stack 16-aligned */
- pushq caml_gc_regs(%rip)
- pushq caml_last_return_address(%rip)
- pushq caml_bottom_of_stack(%rip)
+ pushq G(caml_gc_regs)(%rip)
+ pushq G(caml_last_return_address)(%rip)
+ pushq G(caml_bottom_of_stack)(%rip)
/* Setup alloc ptr and exception ptr */
- movq caml_young_ptr(%rip), %r15
- movq caml_exception_pointer(%rip), %r14
+ movq G(caml_young_ptr)(%rip), %r15
+ movq G(caml_exception_pointer)(%rip), %r14
/* Build an exception handler */
lea .L108(%rip), %r13
pushq %r13
popq %r12 /* dummy register */
.L109:
/* Update alloc ptr and exception ptr */
- movq %r15, caml_young_ptr(%rip)
- movq %r14, caml_exception_pointer(%rip)
+ movq %r15, G(caml_young_ptr)(%rip)
+ movq %r14, G(caml_exception_pointer)(%rip)
/* Pop the callback link, restoring the global variables */
- popq caml_bottom_of_stack(%rip)
- popq caml_last_return_address(%rip)
- popq caml_gc_regs(%rip)
+ popq G(caml_bottom_of_stack)(%rip)
+ popq G(caml_last_return_address)(%rip)
+ popq G(caml_gc_regs)(%rip)
addq $8, %rsp
/* Restore callee-save registers. */
addq $8, %rsp
/* Raise an exception from Caml */
-FUNCTION(caml_raise_exn)
- testl $1, caml_backtrace_active(%rip)
+FUNCTION(G(caml_raise_exn))
+ testl $1, G(caml_backtrace_active)(%rip)
jne .L110
movq %r14, %rsp
popq %r14
movq 0(%rsp), %rsi /* arg 2: pc of raise */
leaq 8(%rsp), %rdx /* arg 3: sp of raise */
movq %r14, %rcx /* arg 4: sp of handler */
- call caml_stash_backtrace
+ call G(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
movq %r14, %rsp
popq %r14
/* Raise an exception from C */
-FUNCTION(caml_raise_exception)
- testl $1, caml_backtrace_active(%rip)
+FUNCTION(G(caml_raise_exception))
+ testl $1, G(caml_backtrace_active)(%rip)
jne .L111
movq %rdi, %rax
- movq caml_exception_pointer(%rip), %rsp
+ movq G(caml_exception_pointer)(%rip), %rsp
popq %r14 /* Recover previous exception handler */
- movq caml_young_ptr(%rip), %r15 /* Reload alloc ptr */
+ movq G(caml_young_ptr)(%rip), %r15 /* Reload alloc ptr */
ret
.L111:
movq %rdi, %r12 /* Save exception bucket */
/* arg 1: exception bucket */
- movq caml_last_return_address(%rip), %rsi /* arg 2: pc of raise */
- movq caml_bottom_of_stack(%rip), %rdx /* arg 3: sp of raise */
- movq caml_exception_pointer(%rip), %rcx /* arg 4: sp of handler */
- call caml_stash_backtrace
+ movq G(caml_last_return_address)(%rip), %rsi /* arg 2: pc of raise */
+ movq G(caml_bottom_of_stack)(%rip), %rdx /* arg 3: sp of raise */
+ movq G(caml_exception_pointer)(%rip), %rcx /* arg 4: sp of handler */
+ call G(caml_stash_backtrace)
movq %r12, %rax /* Recover exception bucket */
- movq caml_exception_pointer(%rip), %rsp
+ movq G(caml_exception_pointer)(%rip), %rsp
popq %r14 /* Recover previous exception handler */
- movq caml_young_ptr(%rip), %r15 /* Reload alloc ptr */
+ movq G(caml_young_ptr)(%rip), %r15 /* Reload alloc ptr */
ret
/* Callback from C to Caml */
-FUNCTION(caml_callback_exn)
+FUNCTION(G(caml_callback_exn))
/* Save callee-save registers */
pushq %rbx
pushq %rbp
movq 0(%rbx), %r12 /* code pointer */
jmp .L106
-FUNCTION(caml_callback2_exn)
+FUNCTION(G(caml_callback2_exn))
/* Save callee-save registers */
pushq %rbx
pushq %rbp
/* closure stays in %rdi */
movq %rsi, %rax /* first argument */
movq %rdx, %rbx /* second argument */
- leaq caml_apply2(%rip), %r12 /* code pointer */
+ leaq G(caml_apply2)(%rip), %r12 /* code pointer */
jmp .L106
-FUNCTION(caml_callback3_exn)
+FUNCTION(G(caml_callback3_exn))
/* Save callee-save registers */
pushq %rbx
pushq %rbp
movq %rdx, %rbx /* second argument */
movq %rdi, %rsi /* closure */
movq %rcx, %rdi /* third argument */
- leaq caml_apply3(%rip), %r12 /* code pointer */
+ leaq G(caml_apply3)(%rip), %r12 /* code pointer */
jmp .L106
-FUNCTION(caml_ml_array_bound_error)
- leaq caml_array_bound_error(%rip), %rax
- jmp caml_c_call
+FUNCTION(G(caml_ml_array_bound_error))
+ leaq G(caml_array_bound_error)(%rip), %rax
+ jmp G(caml_c_call)
.data
- .globl caml_system__frametable
- .type caml_system__frametable,@object
- .align 8
-caml_system__frametable:
+ .globl G(caml_system__frametable)
+ .align EIGHT_ALIGN
+G(caml_system__frametable):
.quad 1 /* one descriptor */
.quad .L107 /* return address into callback */
.value -1 /* negative frame size => use callback link */
.value 0 /* no roots here */
- .align 8
+ .align EIGHT_ALIGN
- .section .rodata.cst8,"a",@progbits
- .globl caml_negf_mask
- .type caml_negf_mask,@object
- .align 16
-caml_negf_mask:
+#ifdef SYS_macosx
+ .literal16
+#else
+ .section .rodata.cst8,"a",@progbits
+#endif
+ .globl G(caml_negf_mask)
+ .align SIXTEEN_ALIGN
+G(caml_negf_mask):
.quad 0x8000000000000000, 0
- .globl caml_absf_mask
- .type caml_absf_mask,@object
- .align 16
-caml_absf_mask:
+ .globl G(caml_absf_mask)
+ .align SIXTEEN_ALIGN
+G(caml_absf_mask):
.quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF
#if defined(SYS_linux)
/* */
/***********************************************************************/
-/* $Id: signals_osdep.h,v 1.11 2008/01/11 16:13:11 doligez Exp $ */
+/* $Id: signals_osdep.h,v 1.11.4.1 2008/11/07 10:34:16 xleroy Exp $ */
/* Processor- and OS-dependent signal interface */
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
#define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.gregs[REG_CR2])
+/****************** AMD64, MacOSX */
+
+#elif defined(TARGET_amd64) && defined (SYS_macosx)
+
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, void * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (name); \
+ sigact.sa_flags = SA_SIGINFO | SA_64REGSET
+
+ #include <sys/ucontext.h>
+ #include <AvailabilityMacros.h>
+
+#if !defined(MAC_OS_X_VERSION_10_5) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_5
+ #define CONTEXT_REG(r) r
+ #else
+ #define CONTEXT_REG(r) __##r
+ #endif
+
+ #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->CONTEXT_REG(ss))
+ #define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(rip))
+ #define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.CONTEXT_REG(r14))
+ #define CONTEXT_YOUNG_PTR (CONTEXT_STATE.CONTEXT_REG(r15))
+ #define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(rsp))
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
/****************** I386, Linux */
#elif defined(TARGET_i386) && defined(SYS_linux_elf)
/* */
/***********************************************************************/
-/* $Id: startup.c,v 1.36 2008/03/14 13:47:13 xleroy Exp $ */
+/* $Id: startup.c,v 1.36.2.1 2008/11/18 10:24:31 doligez Exp $ */
/* Start-up code */
#include "backtrace.h"
#include "custom.h"
#include "fail.h"
+#include "freelist.h"
#include "gc.h"
#include "gc_ctrl.h"
#include "memory.h"
caml_fatal_error("Fatal error: not enough memory for the initial page table");
for (i = 0; caml_data_segments[i].begin != 0; i++) {
- if (caml_page_table_add(In_static_data,
+ if (caml_page_table_add(In_static_data,
caml_data_segments[i].begin,
caml_data_segments[i].end) != 0)
caml_fatal_error("Fatal error: not enough memory for the initial page table");
static void parse_camlrunparam(void)
{
char *opt = getenv ("OCAMLRUNPARAM");
+ uintnat p;
if (opt == NULL) opt = getenv ("CAMLRUNPARAM");
case 'v': scanmult (opt, &caml_verb_gc); break;
case 'b': caml_record_backtrace(Val_true); break;
case 'p': caml_parser_trace = 1; break;
+ case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
}
}
}
--- /dev/null
+ocamlbuild_mixed_mode
( ./build/distclean.sh || : ) 2>&1 | log distclean
-(cvs -q up -dP -r release310 || bad) 2>&1 | log cvs up
+(cvs -q up -dP -r release311 || bad) 2>&1 | log cvs up
finish_if_bad
case "$opt_win" in
#!/bin/sh
-# $Id: camlp4-byte-only.sh,v 1.3 2007/10/08 14:19:34 doligez Exp $
+# $Id: camlp4-byte-only.sh,v 1.3.4.1 2008/10/23 15:29:11 ertai Exp $
set -e
-OCAMLBUILD_PARTIAL="true"
-export OCAMLBUILD_PARTIAL
cd `dirname $0`/..
. build/targets.sh
set -x
-$OCAMLBUILD $@ byte_stdlib_partial_mode $OCAMLC_BYTE $OCAMLLEX_BYTE $CAMLP4_BYTE
+$OCAMLBUILD $@ byte_stdlib_mixed_mode $OCAMLC_BYTE $OCAMLLEX_BYTE $CAMLP4_BYTE
#!/bin/sh
-# $Id: camlp4-native-only.sh,v 1.3 2007/10/08 14:19:34 doligez Exp $
+# $Id: camlp4-native-only.sh,v 1.3.4.1 2008/10/23 15:29:11 ertai Exp $
set -e
-OCAMLBUILD_PARTIAL="true"
-export OCAMLBUILD_PARTIAL
cd `dirname $0`/..
. build/targets.sh
set -x
-$OCAMLBUILD $@ native_stdlib_partial_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $CAMLP4_NATIVE
+$OCAMLBUILD $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $CAMLP4_NATIVE
# #
#########################################################################
-# $Id: distclean.sh,v 1.7 2008/01/11 16:13:16 doligez Exp $
+# $Id: distclean.sh,v 1.7.4.1 2008/10/23 15:29:11 ertai Exp $
cd `dirname $0`/..
set -ex
(cd byterun && make clean) || :
(cd asmrun && make clean) || :
(cd yacc && make clean) || :
+rm -f build/ocamlbuild_mixed_mode
rm -rf _build
rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader \
boot/myocamlbuild boot/myocamlbuild.native boot/myocamlbuild.native.exe \
#!/bin/sh
-# $Id: fastworld.sh,v 1.3 2007/10/08 14:19:34 doligez Exp $
+# $Id: fastworld.sh,v 1.3.4.1 2008/10/23 15:29:11 ertai Exp $
cd `dirname $0`
set -e
+if [ -e ocamlbuild_mixed_mode ]; then
+ echo ocamlbuild mixed mode detected
+ echo 'please cleanup and re-launch (make clean ; ./build/distclean.sh)'
+ exit 1
+fi
./mkconfig.sh
./mkmyocamlbuild_config.sh
. ../config/config.sh
--- /dev/null
+#!/bin/sh
+
+#########################################################################
+# #
+# Objective Caml #
+# #
+# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt #
+# #
+# Copyright 2007 Institut National de Recherche en Informatique et #
+# en Automatique. All rights reserved. This file is distributed #
+# under the terms of the Q Public License version 1.0. #
+# #
+#########################################################################
+
+set -ex
+cd `dirname $0`/..
+touch build/ocamlbuild_mixed_mode
+mkdir -p _build
+cp -rf boot _build/
+./build/mkconfig.sh
+./build/mkmyocamlbuild_config.sh
+./build/boot.sh
#!/bin/sh
-# $Id: ocamlbuild-byte-only.sh,v 1.3 2007/10/08 14:19:34 doligez Exp $
+# $Id: ocamlbuild-byte-only.sh,v 1.3.4.1 2008/10/23 15:29:11 ertai Exp $
set -e
-OCAMLBUILD_PARTIAL="true"
-export OCAMLBUILD_PARTIAL
cd `dirname $0`/..
. build/targets.sh
set -x
-$OCAMLBUILD $@ byte_stdlib_partial_mode $OCAMLC_BYTE $OCAMLLEX_BYTE $OCAMLBUILD_BYTE
+$OCAMLBUILD $@ byte_stdlib_mixed_mode $OCAMLC_BYTE $OCAMLLEX_BYTE $OCAMLBUILD_BYTE
#!/bin/sh
-# $Id: ocamlbuild-native-only.sh,v 1.3 2007/10/08 14:19:34 doligez Exp $
+# $Id: ocamlbuild-native-only.sh,v 1.3.4.1 2008/10/23 15:29:11 ertai Exp $
set -e
-OCAMLBUILD_PARTIAL="true"
-export OCAMLBUILD_PARTIAL
cd `dirname $0`/..
. build/targets.sh
set -x
-$OCAMLBUILD $@ native_stdlib_partial_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $OCAMLBUILD_NATIVE
+$OCAMLBUILD $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $OCAMLBUILD_NATIVE
#!/bin/sh
-# $Id: ocamlbuildlib-native-only.sh,v 1.2 2007/11/27 12:21:53 ertai Exp $
+# $Id: ocamlbuildlib-native-only.sh,v 1.2.4.1 2008/10/23 15:29:11 ertai Exp $
set -e
-OCAMLBUILD_PARTIAL="true"
-export OCAMLBUILD_PARTIAL
cd `dirname $0`/..
. build/targets.sh
set -x
-$OCAMLBUILD $@ native_stdlib_partial_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $OCAMLBUILDLIB_NATIVE
+$OCAMLBUILD $@ native_stdlib_mixed_mode $OCAMLOPT_BYTE $OCAMLLEX_BYTE $OCAMLBUILDLIB_NATIVE
+++ /dev/null
-#!/bin/sh
-
-#########################################################################
-# #
-# Objective Caml #
-# #
-# Nicolas Pouillard, projet Gallium, INRIA Rocquencourt #
-# #
-# Copyright 2007 Institut National de Recherche en Informatique et #
-# en Automatique. All rights reserved. This file is distributed #
-# under the terms of the Q Public License version 1.0. #
-# #
-#########################################################################
-
-# $Id: partial-boot.sh,v 1.5 2008/01/11 16:13:16 doligez Exp $
-
-set -ex
-cd `dirname $0`/..
-OCAMLBUILD_PARTIAL="true"
-export OCAMLBUILD_PARTIAL
-mkdir -p _build
-cp -rf boot _build/
-./build/mkconfig.sh
-./build/mkmyocamlbuild_config.sh
-./build/boot.sh
#!/bin/sh
-# $Id: world.sh,v 1.3 2007/10/08 14:19:34 doligez Exp $
+# $Id: world.sh,v 1.3.4.1 2008/10/23 15:29:11 ertai Exp $
cd `dirname $0`
-set -ex
+set -e
+if [ -e ocamlbuild_mixed_mode ]; then
+ echo ocamlbuild mixed mode detected
+ echo 'please cleanup and re-launch (make clean ; ./build/distclean.sh)'
+ exit 1
+fi
./mkconfig.sh
./mkmyocamlbuild_config.sh
. ../config/config.sh
minor_gc.h
startup.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \
- intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \
+ dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
+ interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
version.h
str.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
minor_gc.h
startup.d.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \
- intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \
+ dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
+ interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
version.h
str.d.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
minor_gc.h
startup.pic.o: startup.c config.h ../config/m.h ../config/s.h compatibility.h \
alloc.h misc.h mlvalues.h backtrace.h callback.h custom.h debugger.h \
- dynlink.h exec.h fail.h fix_code.h gc_ctrl.h instrtrace.h interp.h \
- intext.h io.h memory.h gc.h major_gc.h freelist.h minor_gc.h osdeps.h \
+ dynlink.h exec.h fail.h fix_code.h freelist.h gc_ctrl.h instrtrace.h \
+ interp.h intext.h io.h memory.h gc.h major_gc.h minor_gc.h osdeps.h \
prims.h printexc.h reverse.h signals.h stacks.h sys.h startup.h \
version.h
str.pic.o: str.c alloc.h compatibility.h misc.h config.h ../config/m.h \
# #
#########################################################################
-# $Id: Makefile,v 1.64 2008/09/10 05:51:11 weis Exp $
+# $Id: Makefile,v 1.64.2.1 2008/11/08 16:29:02 xleroy Exp $
include Makefile.common
$(RANLIB) libcamlrund.a
libcamlrun_shared.so: $(PICOBJS)
- $(MKDLL) -o libcamlrun_shared.so $(PICOBJS)
+ $(MKDLL) -o libcamlrun_shared.so $(PICOBJS) $(BYTECCLIBS)
.SUFFIXES: .d.o .pic.o
/* */
/***********************************************************************/
-/* $Id: config.h,v 1.42 2008/01/03 09:37:09 xleroy Exp $ */
+/* $Id: config.h,v 1.42.4.1 2008/11/02 14:30:05 xleroy Exp $ */
#ifndef CAML_CONFIG_H
#define CAML_CONFIG_H
/* Memory model parameters */
/* The size of a page for memory management (in bytes) is [1 << Page_log].
- It must be a multiple of [sizeof (value)] and >= 8. */
+ It must be a multiple of [sizeof (value)] and >= 8 and <= 20. */
#define Page_log 12 /* A page is 4 kilobytes. */
/* Initial size of stack (bytes). */
/* */
/***********************************************************************/
-/* $Id: freelist.c,v 1.20 2008/02/29 14:21:22 doligez Exp $ */
+/* $Id: freelist.c,v 1.20.4.1 2008/11/18 10:24:42 doligez Exp $ */
+
+#define FREELIST_DEBUG 0
+#if FREELIST_DEBUG
+#include <stdio.h>
+#endif
#include <string.h>
} sentinel = {0, Make_header (0, 0, Caml_blue), 0, 0};
#define Fl_head ((char *) (&(sentinel.first_bp)))
+static char *fl_prev = Fl_head; /* Current allocation pointer. */
static char *fl_last = NULL; /* Last block in the list. Only valid
just after [caml_fl_allocate] returns NULL. */
char *caml_fl_merge = Fl_head; /* Current insertion pointer. Managed
#define Next(b) (((block *) (b))->next_bp)
+#define Policy_next_fit 0
+#define Policy_first_fit 1
+uintnat caml_allocation_policy = Policy_next_fit;
+#define policy caml_allocation_policy
+
#ifdef DEBUG
static void fl_check (void)
{
char *cur, *prev;
- int merge_found = 0;
+ int prev_found = 0, flp_found = 0, merge_found = 0;
uintnat size_found = 0;
- int flp_found = 0;
int sz = 0;
prev = Fl_head;
while (cur != NULL){
size_found += Whsize_bp (cur);
Assert (Is_in_heap (cur));
- if (Wosize_bp (cur) > sz){
+ if (cur == fl_prev) prev_found = 1;
+ if (policy == Policy_first_fit && Wosize_bp (cur) > sz){
sz = Wosize_bp (cur);
if (flp_found < flp_size){
Assert (Next (flp[flp_found]) == cur);
prev = cur;
cur = Next (prev);
}
- Assert (flp_found == flp_size);
+ if (policy == Policy_next_fit) Assert (prev_found || fl_prev == Fl_head);
+ if (policy == Policy_first_fit) Assert (flp_found == flp_size);
Assert (merge_found || caml_fl_merge == Fl_head);
Assert (size_found == caml_fl_cur_size);
}
In case 0, it gives an invalid header to the block. The function
calling [caml_fl_allocate] will overwrite it. */
Hd_op (cur) = Make_header (0, 0, Caml_white);
- if (flpi + 1 < flp_size && flp[flpi + 1] == cur){
- flp[flpi + 1] = prev;
- }else if (flpi == flp_size - 1){
- beyond = (prev == Fl_head) ? NULL : prev;
- -- flp_size;
+ if (policy == Policy_first_fit){
+ if (flpi + 1 < flp_size && flp[flpi + 1] == cur){
+ flp[flpi + 1] = prev;
+ }else if (flpi == flp_size - 1){
+ beyond = (prev == Fl_head) ? NULL : prev;
+ -- flp_size;
+ }
}
}else{ /* Case 2. */
caml_fl_cur_size -= wh_sz;
Hd_op (cur) = Make_header (Wosize_hd (h) - wh_sz, 0, Caml_blue);
}
+ if (policy == Policy_next_fit) fl_prev = prev;
return cur + Bosize_hd (h) - Bsize_wsize (wh_sz);
}
mlsize_t sz, prevsz;
Assert (sizeof (char *) == sizeof (value));
Assert (wo_sz >= 1);
- /* Search in the flp array. */
- for (i = 0; i < flp_size; i++){
- sz = Wosize_bp (Next (flp[i]));
- if (sz >= wo_sz){
- result = allocate_block (Whsize_wosize (wo_sz), i, flp[i], Next (flp[i]));
- goto update_flp;
+ switch (policy){
+ case Policy_next_fit:
+ Assert (fl_prev != NULL);
+ /* Search from [fl_prev] to the end of the list. */
+ prev = fl_prev;
+ cur = Next (prev);
+ while (cur != NULL){ Assert (Is_in_heap (cur));
+ if (Wosize_bp (cur) >= wo_sz){
+ return allocate_block (Whsize_wosize (wo_sz), 0, prev, cur);
+ }
+ prev = cur;
+ cur = Next (prev);
}
- }
- /* Extend the flp array. */
- if (flp_size == 0){
+ fl_last = prev;
+ /* Search from the start of the list to [fl_prev]. */
prev = Fl_head;
- prevsz = 0;
- }else{
- prev = Next (flp[flp_size - 1]);
- prevsz = Wosize_bp (prev);
- if (beyond != NULL) prev = beyond;
- }
- while (flp_size < FLP_MAX){
cur = Next (prev);
- if (cur == NULL){
- fl_last = prev;
- beyond = (prev == Fl_head) ? NULL : prev;
- return NULL;
- }else{
- sz = Wosize_bp (cur);
- if (sz > prevsz){
- flp[flp_size] = prev;
- ++ flp_size;
- if (sz >= wo_sz){
- beyond = cur;
- i = flp_size - 1;
- result = allocate_block (Whsize_wosize (wo_sz), flp_size - 1, prev,
- cur);
- goto update_flp;
- }
- prevsz = sz;
+ while (prev != fl_prev){
+ if (Wosize_bp (cur) >= wo_sz){
+ return allocate_block (Whsize_wosize (wo_sz), 0, prev, cur);
}
+ prev = cur;
+ cur = Next (prev);
}
- prev = cur;
- }
- beyond = cur;
-
- /* The flp table is full. Do a slow first-fit search. */
-
- if (beyond != NULL){
- prev = beyond;
- }else{
- prev = flp[flp_size - 1];
- }
- prevsz = Wosize_bp (Next (flp[FLP_MAX-1]));
- Assert (prevsz < wo_sz);
- cur = Next (prev);
- while (cur != NULL){
- Assert (Is_in_heap (cur));
- sz = Wosize_bp (cur);
- if (sz < prevsz){
- beyond = cur;
- }else if (sz >= wo_sz){
- return allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur);
+ /* No suitable block was found. */
+ return NULL;
+ break;
+
+ case Policy_first_fit: {
+ /* Search in the flp array. */
+ for (i = 0; i < flp_size; i++){
+ sz = Wosize_bp (Next (flp[i]));
+ if (sz >= wo_sz){
+#if FREELIST_DEBUG
+ if (i > 5) fprintf (stderr, "FLP: found at %d size=%d\n", i, wo_sz);
+#endif
+ result = allocate_block (Whsize_wosize (wo_sz), i, flp[i], Next(flp[i]));
+ goto update_flp;
+ }
}
- prev = cur;
- cur = Next (prev);
- }
- fl_last = prev;
- return NULL;
-
- update_flp: /* (i, sz) */
- /* The block at [i] was removed or reduced. Update the table. */
- Assert (0 <= i && i < flp_size + 1);
- if (i < flp_size){
- if (i > 0){
- prevsz = Wosize_bp (Next (flp[i-1]));
- }else{
+ /* Extend the flp array. */
+ if (flp_size == 0){
+ prev = Fl_head;
prevsz = 0;
+ }else{
+ prev = Next (flp[flp_size - 1]);
+ prevsz = Wosize_bp (prev);
+ if (beyond != NULL) prev = beyond;
}
- if (i == flp_size - 1){
- if (Wosize_bp (Next (flp[i])) <= prevsz){
- beyond = Next (flp[i]);
- -- flp_size;
+ while (flp_size < FLP_MAX){
+ cur = Next (prev);
+ if (cur == NULL){
+ fl_last = prev;
+ beyond = (prev == Fl_head) ? NULL : prev;
+ return NULL;
}else{
- beyond = NULL;
- }
- }else{
- char *buf [FLP_MAX];
- int j = 0;
- mlsize_t oldsz = sz;
-
- prev = flp[i];
- while (prev != flp[i+1]){
- cur = Next (prev);
sz = Wosize_bp (cur);
if (sz > prevsz){
- buf[j++] = prev;
- prevsz = sz;
- if (sz >= oldsz){
- Assert (sz == oldsz);
- break;
+ flp[flp_size] = prev;
+ ++ flp_size;
+ if (sz >= wo_sz){
+ beyond = cur;
+ i = flp_size - 1;
+#if FREELIST_DEBUG
+ if (flp_size > 5){
+ fprintf (stderr, "FLP: extended to %d\n", flp_size);
+ }
+#endif
+ result = allocate_block (Whsize_wosize (wo_sz), flp_size - 1, prev,
+ cur);
+ goto update_flp;
}
+ prevsz = sz;
}
- prev = cur;
}
- if (FLP_MAX >= flp_size + j - 1){
- memmove (&flp[i+j], &flp[i+1], sizeof (block *) * (flp_size - i - 1));
- memmove (&flp[i], &buf[0], sizeof (block *) * j);
- flp_size += j - 1;
+ prev = cur;
+ }
+ beyond = cur;
+
+ /* The flp table is full. Do a slow first-fit search. */
+#if FREELIST_DEBUG
+ fprintf (stderr, "FLP: table is full -- slow first-fit\n");
+#endif
+ if (beyond != NULL){
+ prev = beyond;
+ }else{
+ prev = flp[flp_size - 1];
+ }
+ prevsz = Wosize_bp (Next (flp[FLP_MAX-1]));
+ Assert (prevsz < wo_sz);
+ cur = Next (prev);
+ while (cur != NULL){
+ Assert (Is_in_heap (cur));
+ sz = Wosize_bp (cur);
+ if (sz < prevsz){
+ beyond = cur;
+ }else if (sz >= wo_sz){
+ return allocate_block (Whsize_wosize (wo_sz), flp_size, prev, cur);
+ }
+ prev = cur;
+ cur = Next (prev);
+ }
+ fl_last = prev;
+ return NULL;
+
+ update_flp: /* (i, sz) */
+ /* The block at [i] was removed or reduced. Update the table. */
+ Assert (0 <= i && i < flp_size + 1);
+ if (i < flp_size){
+ if (i > 0){
+ prevsz = Wosize_bp (Next (flp[i-1]));
+ }else{
+ prevsz = 0;
+ }
+ if (i == flp_size - 1){
+ if (Wosize_bp (Next (flp[i])) <= prevsz){
+ beyond = Next (flp[i]);
+ -- flp_size;
+ }else{
+ beyond = NULL;
+ }
}else{
- if (FLP_MAX > i + j){
- memmove (&flp[i+j], &flp[i+1], sizeof (block *) * (FLP_MAX - i - j));
- memmove (&flp[i], &buf[0], sizeof (block *) * j);
+ char *buf [FLP_MAX];
+ int j = 0;
+ mlsize_t oldsz = sz;
+
+ prev = flp[i];
+ while (prev != flp[i+1]){
+ cur = Next (prev);
+ sz = Wosize_bp (cur);
+ if (sz > prevsz){
+ buf[j++] = prev;
+ prevsz = sz;
+ if (sz >= oldsz){
+ Assert (sz == oldsz);
+ break;
+ }
+ }
+ prev = cur;
+ }
+#if FREELIST_DEBUG
+ if (j > 2) fprintf (stderr, "FLP: update; buf size = %d\n", j);
+#endif
+ if (FLP_MAX >= flp_size + j - 1){
+ if (j != 1){
+ memmove (&flp[i+j], &flp[i+1], sizeof (block *) * (flp_size-i-1));
+ }
+ if (j > 0) memmove (&flp[i], &buf[0], sizeof (block *) * j);
+ flp_size += j - 1;
}else{
- memmove (&flp[i], &buf[0], sizeof (block *) * (FLP_MAX - i));
+ if (FLP_MAX > i + j){
+ if (j != 1){
+ memmove (&flp[i+j], &flp[i+1], sizeof (block *) * (FLP_MAX-i-j));
+ }
+ if (j > 0) memmove (&flp[i], &buf[0], sizeof (block *) * j);
+ }else{
+ if (i != FLP_MAX){
+ memmove (&flp[i], &buf[0], sizeof (block *) * (FLP_MAX - i));
+ }
+ }
+ flp_size = FLP_MAX - 1;
+ beyond = Next (flp[FLP_MAX - 1]);
}
- flp_size = FLP_MAX - 1;
- beyond = Next (flp[FLP_MAX - 1]);
}
}
+ return result;
+ }
+ break;
+
+ default:
+ Assert (0); /* unknown policy */
+ break;
}
- return result;
+ return NULL; /* NOT REACHED */
}
static char *last_fragment;
void caml_fl_reset (void)
{
Next (Fl_head) = NULL;
- truncate_flp (Fl_head);
+ switch (policy){
+ case Policy_next_fit:
+ fl_prev = Fl_head;
+ break;
+ case Policy_first_fit:
+ truncate_flp (Fl_head);
+ break;
+ default:
+ Assert (0);
+ break;
+ }
caml_fl_cur_size = 0;
caml_fl_init_merge ();
}
Assert (prev < bp || prev == Fl_head);
Assert (cur > bp || cur == NULL);
- truncate_flp (prev);
+ if (policy == Policy_first_fit) truncate_flp (prev);
/* If [last_fragment] and [bp] are adjacent, merge them. */
if (last_fragment == Hp_bp (bp)){
if (Wosize_hd (hd) + cur_whsz <= Max_wosize){
Next (prev) = next_cur;
+ if (policy == Policy_next_fit && fl_prev == cur) fl_prev = prev;
hd = Make_header (Wosize_hd (hd) + cur_whsz, 0, Caml_blue);
Hd_bp (bp) = hd;
adj = bp + Bosize_hd (hd);
if (fl_last == caml_fl_merge && bp < caml_gc_sweep_hp){
caml_fl_merge = (char *) Field (bp, 1);
}
- if (flp_size < FLP_MAX) flp [flp_size++] = fl_last;
+ if (policy == Policy_first_fit && flp_size < FLP_MAX){
+ flp [flp_size++] = fl_last;
+ }
}else{
char *cur, *prev;
if (prev == caml_fl_merge && bp < caml_gc_sweep_hp){
caml_fl_merge = (char *) Field (bp, 1);
}
- truncate_flp (bp);
+ if (policy == Policy_first_fit) truncate_flp (bp);
}
}
p += sz;
}
}
+
+void caml_set_allocation_policy (uintnat p)
+{
+ switch (p){
+ case Policy_next_fit:
+ fl_prev = Fl_head;
+ break;
+ case Policy_first_fit:
+ flp_size = 0;
+ beyond = NULL;
+ break;
+ default:
+ Assert (0);
+ break;
+ }
+ policy = p;
+}
/* */
/***********************************************************************/
-/* $Id: freelist.h,v 1.13 2008/02/29 12:56:15 doligez Exp $ */
+/* $Id: freelist.h,v 1.13.4.1 2008/11/18 10:24:43 doligez Exp $ */
/* Free lists of heap blocks. */
char *caml_fl_merge_block (char *);
void caml_fl_add_blocks (char *);
void caml_make_free_blocks (value *, mlsize_t, int);
+void caml_set_allocation_policy (uintnat);
#endif /* CAML_FREELIST_H */
/* */
/***********************************************************************/
-/* $Id: gc_ctrl.c,v 1.53 2008/02/29 12:56:15 doligez Exp $ */
+/* $Id: gc_ctrl.c,v 1.53.4.2 2008/11/20 18:33:13 doligez Exp $ */
#include "alloc.h"
#include "compact.h"
#include "custom.h"
#include "finalise.h"
+#include "freelist.h"
#include "gc.h"
#include "gc_ctrl.h"
#include "major_gc.h"
caml_stat_heap_chunks = 0;
extern asize_t caml_major_heap_increment; /* bytes; see major_gc.c */
-extern uintnat caml_percent_free; /* see major_gc.c */
-extern uintnat caml_percent_max; /* see compact.c */
+extern uintnat caml_percent_free; /* see major_gc.c */
+extern uintnat caml_percent_max; /* see compact.c */
+extern uintnat caml_allocation_policy; /* see freelist.c */
#define Next(hp) ((hp) + Bhsize_hp (hp))
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
- res = caml_alloc_tuple (6);
+ res = caml_alloc_tuple (7);
Store_field (res, 0, Val_long (Wsize_bsize (caml_minor_heap_size))); /* s */
Store_field (res, 1,Val_long(Wsize_bsize(caml_major_heap_increment)));/* i */
Store_field (res, 2, Val_long (caml_percent_free)); /* o */
#else
Store_field (res, 5, Val_long (0));
#endif
+ Store_field (res, 6, Val_long (caml_allocation_policy)); /* a */
CAMLreturn (res);
}
return s;
}
+static intnat norm_policy (intnat p)
+{
+ if (p >= 0 && p <= 1){
+ return p;
+ }else{
+ return 1;
+ }
+}
+
CAMLprim value caml_gc_set(value v)
{
uintnat newpf, newpm;
asize_t newheapincr;
asize_t newminsize;
+ uintnat newpolicy;
caml_verb_gc = Long_val (Field (v, 3));
caml_gc_message (0x20, "New heap increment size: %luk bytes\n",
caml_major_heap_increment/1024);
}
+ newpolicy = norm_policy (Long_val (Field (v, 6)));
+ if (newpolicy != caml_allocation_policy){
+ caml_gc_message (0x20, "New allocation policy: %d\n", newpolicy);
+ caml_set_allocation_policy (newpolicy);
+ }
/* Minor heap size comes last because it will trigger a minor collection
(thus invalidating [v]) and it can raise [Out_of_memory]. */
caml_gc_message (0x20, "Initial max overhead: %lu%%\n", caml_percent_max);
caml_gc_message (0x20, "Initial heap increment: %luk bytes\n",
caml_major_heap_increment / 1024);
+ caml_gc_message (0x20, "Initial allocation policy: %d\n",
+ caml_allocation_policy);
}
/* */
/***********************************************************************/
-/* $Id: major_gc.c,v 1.62 2008/07/28 12:03:55 doligez Exp $ */
+/* $Id: major_gc.c,v 1.62.2.1 2008/11/12 12:53:07 doligez Exp $ */
#include <limits.h>
MW = caml_stat_heap_size * 100 / (100 + caml_percent_free)
Amount of sweeping work for the GC cycle:
SW = caml_stat_heap_size
- Amount of marking work for this slice:
- MS = P * MW
- MS = P * caml_stat_heap_size * 100 / (100 + caml_percent_free)
- Amount of sweeping work for this slice:
- SS = P * SW
- SS = P * caml_stat_heap_size
- This slice will either mark 2*MS words or sweep 2*SS words.
+
+ In order to finish marking with a non-empty free list, we will
+ use 40% of the time for marking, and 60% for sweeping.
+
+ If TW is the total work for this cycle,
+ MW = 40/100 * TW
+ SW = 60/100 * TW
+
+ Amount of work to do for this slice:
+ W = P * TW
+
+ Amount of marking work for a marking slice:
+ MS = P * MW / (40/100)
+ MS = P * caml_stat_heap_size * 250 / (100 + caml_percent_free)
+ Amount of sweeping work for a sweeping slice:
+ SS = P * SW / (60/100)
+ SS = P * caml_stat_heap_size * 5 / 3
+
+ This slice will either mark MS words or sweep SS words.
*/
if (caml_gc_phase == Phase_idle) start_cycle ();
(uintnat) (p * 1000000));
if (caml_gc_phase == Phase_mark){
- computed_work = 2 * (intnat) (p * Wsize_bsize (caml_stat_heap_size) * 100
- / (100 + caml_percent_free));
+ computed_work = (intnat) (p * Wsize_bsize (caml_stat_heap_size) * 250
+ / (100 + caml_percent_free));
}else{
- computed_work = 2 * (intnat) (p * Wsize_bsize (caml_stat_heap_size));
+ computed_work = (intnat) (p * Wsize_bsize (caml_stat_heap_size) * 5 / 3);
}
caml_gc_message (0x40, "ordered work = %ld words\n", howmuch);
caml_gc_message (0x40, "computed work = %ld words\n", computed_work);
/* */
/***********************************************************************/
-/* $Id: memory.c,v 1.46 2008/02/29 12:56:15 doligez Exp $ */
+/* $Id: memory.c,v 1.46.4.1 2008/11/02 14:30:05 xleroy Exp $ */
#include <stdlib.h>
#include <string.h>
#define Page(p) ((uintnat) (p) >> Page_log)
#define Page_mask ((uintnat) -1 << Page_log)
-/* The page table is represented sparsely as a hash table
+#ifdef ARCH_SIXTYFOUR
+
+/* 64-bit implementation:
+ The page table is represented sparsely as a hash table
with linear probing */
struct page_table {
return 0;
}
+#else
+
+/* 32-bit implementation:
+ The page table is represented as a 2-level array of unsigned char */
+
+CAMLexport unsigned char * caml_page_table[Pagetable1_size];
+static unsigned char caml_page_table_empty[Pagetable2_size] = { 0, };
+
+int caml_page_table_initialize(mlsize_t bytesize)
+{
+ int i;
+ for (i = 0; i < Pagetable1_size; i++)
+ caml_page_table[i] = caml_page_table_empty;
+ return 0;
+}
+
+static int caml_page_table_modify(uintnat page, int toclear, int toset)
+{
+ uintnat i = Pagetable_index1(page);
+ uintnat j = Pagetable_index2(page);
+
+ if (caml_page_table[i] == caml_page_table_empty) {
+ unsigned char * new_tbl = calloc(Pagetable2_size, 1);
+ if (new_tbl == 0) return -1;
+ caml_page_table[i] = new_tbl;
+ }
+ caml_page_table[i][j] = (caml_page_table[i][j] & ~toclear) | toset;
+ return 0;
+}
+
+#endif
+
int caml_page_table_add(int kind, void * start, void * end)
{
uintnat pstart = (uintnat) start & Page_mask;
/* */
/***********************************************************************/
-/* $Id: memory.h,v 1.59 2008/03/10 19:56:39 xleroy Exp $ */
+/* $Id: memory.h,v 1.59.4.1 2008/11/02 14:30:05 xleroy Exp $ */
/* Allocation macros and functions */
#define In_static_data 4
#define In_code_area 8
+#ifdef ARCH_SIXTYFOUR
+
+/* 64 bits: Represent page table as a sparse hash table */
+int caml_page_table_lookup(void * addr);
#define Classify_addr(a) (caml_page_table_lookup((void *)(a)))
+
+#else
+
+/* 32 bits: Represent page table as a 2-level array */
+#define Pagetable2_log 11
+#define Pagetable2_size (1 << Pagetable2_log)
+#define Pagetable1_log (Page_log + Pagetable2_log)
+#define Pagetable1_size (1 << (32 - Pagetable1_log))
+CAMLextern unsigned char * caml_page_table[Pagetable1_size];
+
+#define Pagetable_index1(a) (((uintnat)(a)) >> Pagetable1_log)
+#define Pagetable_index2(a) \
+ ((((uintnat)(a)) >> Page_log) & (Pagetable2_size - 1))
+#define Classify_addr(a) \
+ caml_page_table[Pagetable_index1(a)][Pagetable_index2(a)]
+
+#endif
+
#define Is_in_value_area(a) \
(Classify_addr(a) & (In_heap | In_young | In_static_data))
#define Is_in_heap(a) (Classify_addr(a) & In_heap)
#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
-int caml_page_table_lookup(void * addr);
int caml_page_table_add(int kind, void * start, void * end);
int caml_page_table_remove(int kind, void * start, void * end);
int caml_page_table_initialize(mlsize_t bytesize);
/* */
/***********************************************************************/
-/* $Id: startup.c,v 1.70 2008/03/14 13:47:24 xleroy Exp $ */
+/* $Id: startup.c,v 1.70.2.1 2008/11/18 10:24:43 doligez Exp $ */
/* Start-up code */
#include "exec.h"
#include "fail.h"
#include "fix_code.h"
+#include "freelist.h"
#include "gc_ctrl.h"
#include "instrtrace.h"
#include "interp.h"
static void parse_camlrunparam(void)
{
char *opt = getenv ("OCAMLRUNPARAM");
+ uintnat p;
if (opt == NULL) opt = getenv ("CAMLRUNPARAM");
case 'v': scanmult (opt, &caml_verb_gc); break;
case 'b': caml_record_backtrace(Val_true); break;
case 'p': caml_parser_trace = 1; break;
+ case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
}
}
}
if (Is_exception_result(res))
caml_fatal_uncaught_exception(Extract_exception(res));
}
-
module Id = struct
value name = "Camlp4.PreCast";
- value version = "$Id: PreCast.ml,v 1.5 2007/10/08 14:19:34 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
type camlp4_token = Sig.camlp4_token ==
module Id = struct
value name = "Camlp4Printers.DumpCamlp4Ast";
- value version = "$Id: DumpCamlp4Ast.ml,v 1.7 2007/11/21 17:53:10 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Syntax)
module Id : Sig.Id = struct
value name = "Camlp4Printers.DumpOCamlAst";
- value version = "$Id: DumpOCamlAst.ml,v 1.7 2007/11/21 17:53:10 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax)
module Id = struct
value name = "Camlp4.Printers.Null";
- value version = "$Id: Null.ml,v 1.2 2007/02/07 10:09:21 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Syntax) = struct
module Id = struct
value name = "Camlp4.Printers.OCaml";
- value version = "$Id: OCaml.ml,v 1.39 2008/10/05 16:25:28 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4.Printers.OCamlr";
- value version = "$Id: OCamlr.ml,v 1.23 2008/10/05 16:30:55 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Sig.ml,v 1.7 2008/10/04 10:47:56 ertai Exp $ *)
+
(** Camlp4 signature repository *)
value register_sig_item_filter : (filter Ast.sig_item) -> unit;
value register_str_item_filter : (filter Ast.str_item) -> unit;
+ value register_topphrase_filter : (filter Ast.str_item) -> unit;
value fold_interf_filters : ('a -> filter Ast.sig_item -> 'a) -> 'a -> 'a;
value fold_implem_filters : ('a -> filter Ast.str_item -> 'a) -> 'a -> 'a;
+ value fold_topphrase_filters : ('a -> filter Ast.str_item -> 'a) -> 'a -> 'a;
end;
value fold_interf_filters f i = Queue.fold f i interf_filters;
value implem_filters = Queue.create ();
value fold_implem_filters f i = Queue.fold f i implem_filters;
+ value topphrase_filters = Queue.create ();
+ value fold_topphrase_filters f i = Queue.fold f i topphrase_filters;
value register_sig_item_filter f = Queue.add f interf_filters;
value register_str_item_filter f = Queue.add f implem_filters;
+ value register_topphrase_filter f = Queue.add f topphrase_filters;
end;
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Camlp4Ast2OCamlAst.ml,v 1.22 2008/10/04 11:11:09 ertai Exp $ *)
+
module Make (Ast : Sig.Camlp4Ast) = struct
open Format;
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Camlp4Ast2OCamlAst.mli,v 1.5 2008/01/11 16:13:16 doligez Exp $ *)
+
module Make (Camlp4Ast : Sig.Camlp4Ast) : sig
open Camlp4Ast;
*)
-(* $Id: DynLoader.ml,v 1.4 2007/11/06 15:16:56 frisch Exp $ *)
+
type t = Queue.t string;
(* *)
(****************************************************************************)
-(* $Id: Fold.ml,v 1.3 2007/02/07 10:09:21 ertai Exp $ *)
+
(* Authors:
* - Daniel de Rauglaudre: initial version
(* *)
(****************************************************************************)
-(* $Id: Fold.mli,v 1.2 2006/07/08 17:21:32 pouillar Exp $ *)
+
(* Authors:
* - Daniel de Rauglaudre: initial version
(* *)
(****************************************************************************)
-(* $Id: Parser.mli,v 1.3 2008/10/03 15:18:37 ertai Exp $ *)
+
(* Authors:
* - Daniel de Rauglaudre: initial version
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Lexer.mll,v 1.10 2008/01/11 16:13:16 doligez Exp $ *)
+
(* The lexer definition *)
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Quotation.ml,v 1.6 2007/11/21 17:57:54 ertai Exp $ *)
+
module Make (Ast : Sig.Camlp4Ast)
: Sig.Quotation with module Ast = Ast
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Camlp4Bin.ml,v 1.19 2008/10/03 15:41:24 ertai Exp $ *)
+
open Camlp4;
open PreCast.Syntax;
module Id = struct
value name = "Camlp4AstLifter";
- value version = "$Id: Camlp4AstLifter.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (AstFilters : Camlp4.Sig.AstFilters) = struct
module Id = struct
value name = "Camlp4ExceptionTracer";
- value version = "$Id: Camlp4ExceptionTracer.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (AstFilters : Camlp4.Sig.AstFilters) = struct
module Id = struct
value name = "Camlp4FoldGenerator";
- value version = "$Id: Camlp4FoldGenerator.ml,v 1.3 2007/11/21 17:51:39 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (AstFilters : Camlp4.Sig.AstFilters) = struct
module Id = struct
value name = "Camlp4LocationStripper";
- value version = "$Id: Camlp4LocationStripper.ml,v 1.2 2007/10/08 14:19:34 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (AstFilters : Camlp4.Sig.AstFilters) = struct
(* This module is useless now. Camlp4FoldGenerator handles map too. *)
module Id = struct
value name = "Camlp4MapGenerator";
- value version = "$Id: Camlp4MapGenerator.ml,v 1.4 2008/01/11 16:13:16 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Id = struct
value name = "Camlp4Profiler";
- value version = "$Id: Camlp4Profiler.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (AstFilters : Camlp4.Sig.AstFilters) = struct
module Id = struct
value name = "Camlp4TrashRemover";
- value version = "$Id: Camlp4TrashRemover.ml,v 1.2 2007/10/08 14:19:34 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (AstFilters : Camlp4.Sig.AstFilters) = struct
module Id = struct
value name = "Camlp4AstLoader";
- value version = "$Id: Camlp4AstLoader.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Ast : Camlp4.Sig.Ast) = struct
module Id = struct
value name = "Camlp4DebugParser";
- value version = "$Id: Camlp4DebugParser.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4GrammarParser";
- value version = "$Id: Camlp4GrammarParser.ml,v 1.5 2008/01/11 16:13:16 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4ListComprenhsion";
- value version = "$Id: Camlp4ListComprehension.ml,v 1.2 2007/11/21 17:51:16 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4MacroParser";
- value version = "$Id: Camlp4MacroParser.ml,v 1.5 2008/10/03 14:19:19 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
(*
module Id : Sig.Id = struct
value name = "Camlp4OCamlParser";
- value version = "$Id: Camlp4OCamlParser.ml,v 1.14 2008/10/05 15:26:54 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id : Sig.Id = struct
value name = "Camlp4OCamlParserParser";
- value version = "$Id: Camlp4OCamlParserParser.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4Reloaded";
- value version = "$Id: Camlp4OCamlReloadedParser.ml,v 1.2 2007/10/08 14:19:34 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4OCamlRevisedParser";
- value version = "$Id: Camlp4OCamlRevisedParser.ml,v 1.15 2008/10/05 15:26:54 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id : Sig.Id = struct
value name = "Camlp4OCamlRevisedParserParser";
- value version = "$Id: Camlp4OCamlRevisedParserParser.ml,v 1.4 2008/01/11 16:13:16 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax) = struct
module Id = struct
value name = "Camlp4QuotationCommon";
- value version = "$Id: Camlp4QuotationCommon.ml,v 1.5 2008/01/11 16:13:16 doligez Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax)
module Id = struct
value name = "Camlp4QuotationExpander";
- value version = "$Id: Camlp4QuotationExpander.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $";
+ value version = Sys.ocaml_version;
end;
module Make (Syntax : Sig.Camlp4Syntax)
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Rprint.ml,v 1.5 2008/01/11 16:13:16 doligez Exp $ *)
+
(* There is a few Obj.magic due to the fact that we no longer have compiler
files like Parsetree, Location, Longident but Camlp4_import that wrap them to
* - Nicolas Pouillard: refactoring
*)
-(* $Id: Top.ml,v 1.4.4.1 2008/10/13 13:34:06 ertai Exp $ *)
+
(* There is a few Obj.magic due to the fact that we no longer have compiler
files like Parsetree, Location, Longident but Camlp4_import that wrap them to
value toplevel_phrase token_stream =
match Gram.parse_tokens_after_filter Syntax.top_phrase token_stream with
- [ Some phr -> Ast2pt.phrase phr
- | None -> raise End_of_file ];
+ [ Some str_item ->
+ let str_item =
+ AstFilters.fold_topphrase_filters (fun t filter -> filter t) str_item
+ in
+ Ast2pt.phrase str_item
+
+ | None -> raise End_of_file ];
value use_file token_stream =
let (pl0, eoi) =
# #
#########################################################################
-# $Id: Makefile,v 1.40 2007/02/07 10:09:21 ertai Exp $
+
# RELEASE NOTE:
# Do not forget to call make genclean to update Makefile.clean before a
* - Daniel de Rauglaudre: initial version
* - Nicolas Pouillard: refactoring
*)
- (* $Id$ *)
+
(** Camlp4 signature repository *)
(** {6 Basic signatures} *)
(** Signature with just a type. *)
struct
let name = "Camlp4Printers.DumpCamlp4Ast"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
struct
let name = "Camlp4Printers.DumpOCamlAst"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
struct
module Id =
struct let name = "Camlp4.Printers.Null"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Syntax) =
module Id =
struct let name = "Camlp4.Printers.OCaml"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
module Id =
struct let name = "Camlp4.Printers.OCamlr"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
end =
struct
module Id = struct let name = "Camlp4.PreCast"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
type camlp4_token =
-# $Id: Makefile,v 1.2 2006/11/15 14:49:26 doligez Exp $
+
MAX_SAVE = 10
*)
module Id =
struct let name = "Camlp4OCamlRevisedParser"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
*)
module Id =
struct let name = "Camlp4QuotationCommon"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make
*)
module Id =
struct let name = "Camlp4QuotationExpander"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
*)
module Id : Sig.Id =
struct let name = "Camlp4OCamlRevisedParserParser"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
*)
module Id =
struct let name = "Camlp4GrammarParser"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
*)
module Id =
struct let name = "Camlp4MacroParser"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
(*
*)
module Id =
struct let name = "Camlp4DebugParser"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
*)
module Id =
struct let name = "Camlp4ListComprenhsion"
- let version = "$Id$"
+ let version = Sys.ocaml_version
end
module Make (Syntax : Sig.Camlp4Syntax) =
* - Daniel de Rauglaudre: initial version
* - Nicolas Pouillard: refactoring
*)
- (* $Id$ *)
+
open Camlp4
open PreCast.Syntax
-# $Id: Makefile,v 1.7 2006/06/29 08:12:44 pouillar Exp $
+
include ../config/Makefile.cnf
* - Nicolas Pouillard: rewriting in OCaml
*)
-(* $Id: mkcamlp4.ml,v 1.4 2008/10/03 15:50:09 ertai Exp $ *)
+
open Camlp4;
open Camlp4_config;
# #
#########################################################################
-# $Id: Makefile.mingw,v 1.27 2008/07/29 08:31:41 xleroy Exp $
+# $Id: Makefile.mingw,v 1.27.2.1 2008/11/09 09:44:24 xleroy Exp $
# Configuration for Windows, Mingw compiler
# There must be no spaces or special characters in $(TK_ROOT)
TK_ROOT=c:/tcl
TK_DEFS=-I$(TK_ROOT)/include
-TK_LINK=$(TK_ROOT)/bin/tk83.dll $(TK_ROOT)/bin/tcl83.dll -lws2_32
-#TK_LINK=$(TK_ROOT)/lib/tk84.lib $(TK_ROOT)/lib/tcl84.lib -lws2_32
+TK_LINK=$(TK_ROOT)/bin/tk84.dll $(TK_ROOT)/bin/tcl84.dll -lws2_32
############# Aliases for common commands
# #
#########################################################################
-# $Id: Makefile.msvc,v 1.30 2008/07/29 08:31:41 xleroy Exp $
+# $Id: Makefile.msvc,v 1.30.2.1 2008/11/10 15:24:51 xleroy Exp $
# Configuration for Windows, Visual C++ compiler
TK_DEFS=-I$(TK_ROOT)/include
# The following definition avoids hard-wiring $(TK_ROOT) in the libraries
# produced by OCaml, and is therefore required for binary distribution
-# of these libraries. However, $(TK_ROOT) must be added to the LIB
+# of these libraries. However, $(TK_ROOT)/lib must be added to the LIB
# environment variable, as described in README.win32.
-#TK_LINK=tk84.lib tcl84.lib ws2_32.lib
-TK_LINK=tk83.lib tcl83.lib ws2_32.lib
+TK_LINK=tk84.lib tcl84.lib ws2_32.lib
# An alternative definition that avoids mucking with the LIB variable,
# but hard-wires the Tcl/Tk location in the binaries
-# TK_LINK=$(TK_ROOT)/tk83.lib $(TK_ROOT)/tcl83.lib ws2_32.lib
+# TK_LINK=$(TK_ROOT)/tk84.lib $(TK_ROOT)/tcl84.lib ws2_32.lib
############# Aliases for common commands
# #
#########################################################################
-# $Id: configure,v 1.266 2008/10/06 13:31:47 doligez Exp $
+# $Id: configure,v 1.266.2.1 2008/11/07 10:34:16 xleroy Exp $
configure_options="$*"
prefix=/usr/local
bytecccompopts="-fno-defer-pop -no-cpp-precomp $gcc_warnings"
mathlib=""
# Tell gcc that we can use 32-bit code addresses for threaded code
- # even if we compile in 64-bit mode
- echo "#define ARCH_CODE32" >> m.h;;
+ # unless we are compiled for a shared library (-fPIC option)
+ echo "#ifndef __PIC__" >> m.h
+ echo "# define ARCH_CODE32" >> m.h
+ echo "#endif" >> m.h;;
*,*-*-beos*)
bytecccompopts="-fno-defer-pop $gcc_warnings"
# No -lm library
mksharedlibrpath="-rpath "
shared_libraries_supported=true;;
i[3456]86-*-darwin*)
- dyld=ld
- if test -f /usr/bin/ld_classic; then
- # The new linker in Mac OS X 10.5 does not support read_only_relocs
- # dyld=/usr/bin/ld_classic XXX FIXME incompatible with X11 libs
- :
- fi
- mksharedlib="$dyld -bundle -flat_namespace -undefined suppress -read_only_relocs suppress"
+ mksharedlib="$bytecc -bundle -flat_namespace -undefined suppress -read_only_relocs suppress"
bytecccompopts="$dl_defs $bytecccompopts"
dl_needs_underscore=false
shared_libraries_supported=true;;
*-apple-darwin*)
mksharedlib="$bytecc -bundle -flat_namespace -undefined suppress"
bytecccompopts="$dl_defs $bytecccompopts"
- #sharedcccompopts="-fnocommon"
dl_needs_underscore=false
shared_libraries_supported=true;;
m88k-*-openbsd*)
i[3456]86-*-solaris*) arch=i386; system=solaris;;
i[3456]86-*-beos*) arch=i386; system=beos;;
i[3456]86-*-cygwin*) arch=i386; system=cygwin;;
- i[3456]86-*-darwin*) arch=i386; system=macosx;;
+ i[3456]86-*-darwin*) if $arch64; then
+ arch=amd64; system=macosx
+ else
+ arch=i386; system=macosx
+ fi;;
i[3456]86-*-gnu*) arch=i386; system=gnu;;
mips-*-irix6*) arch=mips; system=irix;;
hppa1.1-*-hpux*) arch=hppa; system=hpux;;
x86_64-*-freebsd*) arch=amd64; system=freebsd;;
x86_64-*-netbsd*) arch=amd64; system=netbsd;;
x86_64-*-openbsd*) arch=amd64; system=openbsd;;
+ x86_64-*-darwin9.5) arch=amd64; system=macosx;;
esac
# Some platforms exist both in 32-bit and 64-bit variants, not distinguished
*,*,rhapsody,*) nativecccompopts="$gcc_warnings -DDARWIN_VERSION_6 $dl_defs"
if $arch64; then partialld="ld -r -arch ppc64"; fi;;
*,gcc*,cygwin,*) nativecccompopts="$gcc_warnings -U_WIN32";;
+ amd64,gcc*,macosx,*) partialld="ld -r -arch x86_64";;
*,gcc*,*,*) nativecccompopts="$gcc_warnings";;
esac
asppprofflags='-pg -DPROFILING';;
alpha,*,*) as='as'
aspp='gcc -c';;
+ amd64,*,macosx) as='as -arch x86_64'
+ aspp='gcc -arch x86_64 -c';;
amd64,*,*) as='as'
aspp='gcc -c';;
arm,*,*) as='as';
i386,*,linux_elf) profiling='prof';;
i386,*,gnu) profiling='prof';;
i386,*,bsd_elf) profiling='prof';;
+ amd64,*,macosx) profiling='prof';;
i386,*,macosx) profiling='prof';;
sparc,*,solaris)
profiling='prof'
# Determine if system stack overflows can be detected
case "$arch,$system" in
- i386,linux_elf|amd64,linux|power,rhapsody|i386,macosx)
+ i386,linux_elf|amd64,linux|power,rhapsody|amd64,macosx|i386,macosx|amd64,macosx)
echo "System stack overflow can be detected."
echo "#define HAS_STACK_OVERFLOW_DETECTION" >> s.h;;
*)
echo "Cannot detect system stack overflow.";;
esac
-# Determine the target architecture for the "num" library
-
-case "$host" in
- alpha*-*-*) bng_arch=alpha; bng_asm_level=1;;
- i[3456]86-*-*) bng_arch=ia32
- if sh ./trycompile ia32sse2.c
- then bng_asm_level=2
- else bng_asm_level=1
- fi;;
- mips-*-*) bng_arch=mips; bng_asm_level=1;;
- powerpc-*-*) bng_arch=ppc; bng_asm_level=1;;
- sparc*-*-*) bng_arch=sparc; bng_asm_level=1;;
- x86_64-*-*) bng_arch=amd64; bng_asm_level=1;;
- *) bng_arch=generic; bng_asm_level=0;;
+x# Determine the target architecture for the "num" library
+
+case "$arch" in
+ alpha) bng_arch=alpha; bng_asm_level=1;;
+ i386) bng_arch=ia32
+ if sh ./trycompile ia32sse2.c
+ then bng_asm_level=2
+ else bng_asm_level=1
+ fi;;
+ mips) bng_arch=mips; bng_asm_level=1;;
+ power) bng_arch=ppc; bng_asm_level=1;;
+ sparc) bng_arch=sparc; bng_asm_level=1;;
+ amd64) bng_arch=amd64; bng_asm_level=1;;
+ *) bng_arch=generic; bng_asm_level=0;;
esac
echo "BNG_ARCH=$bng_arch" >> Makefile
(* *)
(***********************************************************************)
-(* $Id: optcompile.ml,v 1.56.2.1 2008/10/08 13:07:13 doligez Exp $ *)
+(* $Id: optcompile.ml,v 1.56.2.2 2008/10/17 14:01:35 doligez Exp $ *)
(* The batch compiler *)
Compilenv.save_unit_info cmxfile;
end;
Warnings.check_fatal ();
- Pparse.remove_preprocessed inputfile
+ Pparse.remove_preprocessed inputfile;
+ Stypes.dump (outputprefix ^ ".annot");
with x ->
remove_file objfile;
remove_file cmxfile;
Pparse.remove_preprocessed_if_ast inputfile;
+ Stypes.dump (outputprefix ^ ".annot");
raise x
let c_file name =
;(* *)
;(***********************************************************************)
-;(* $Id: caml.el,v 1.44 2008/08/19 12:54:51 doligez Exp $ *)
+;(* $Id: caml.el,v 1.44.2.1 2008/10/29 12:30:57 doligez Exp $ *)
;;; caml.el --- O'Caml code editing commands for Emacs
;; Hence we add a regexp.
(defconst caml-error-regexp
- "^[A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]"
+ "^[ A-\377]+ \"\\([^\"\n]+\\)\", [A-\377]+ \\([0-9]+\\)[-,:]"
"Regular expression matching the error messages produced by camlc.")
(if (boundp 'compilation-error-regexp-alist)
;; A regexp to extract the range info
(defconst caml-error-chars-regexp
- ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):"
+ ".*, .*, [A-\377]+ \\([0-9]+\\)-\\([0-9]+\\):?"
"Regular expression extracting the character numbers
from an error message produced by camlc.")
(defun caml-string-to-int (x)
(if (fboundp 'string-to-number) (string-to-number x) (string-to-int x)))
-;;itz 04-21-96 somebody didn't get the documetation for next-error
+;;itz 04-21-96 somebody didn't get the documentation for next-error
;;right. When the optional argument is a number n, it should move
;;forward n errors, not reparse.
-\" $Id: ocamlc.m,v 1.12 2008/09/15 14:12:56 doligez Exp $
+\" $Id: ocamlc.m,v 1.12.2.1 2008/10/29 12:38:52 doligez Exp $
.TH OCAMLC 1
is redirected to
an intermediate file, which is compiled. If there are no compilation
errors, the intermediate file is deleted afterwards. The name of this
-file is built from the basename of the source file with the extension
-.ppi for an interface (.mli) file and .ppo for an implementation
+file is built from the basename of the source file with the extension .ppi
+for an interface (.mli) file and .ppo for an implementation
(.ml) file.
.TP
.B \-principal
warnings is emitted. The
.I warning\-list
has the same meaning as for
-the "-w" option: an uppercase character turns the corresponding
+the "\-w" option: an uppercase character turns the corresponding
warning into an error, a lowercase character leaves it as a warning.
The default setting is
.B \-warn\-error\ a
-\" $Id: ocamlopt.m,v 1.10 2008/09/15 14:12:56 doligez Exp $
+\" $Id: ocamlopt.m,v 1.10.2.1 2008/10/29 12:38:52 doligez Exp $
.TH OCAMLOPT 1
.SH NAME
Add the given directory to the list of directories searched for
compiled interface files (.cmi) and compiled object code files
(.cmo). By default, the current directory is searched first, then the
-standard library directory. Directories added with -I are searched
+standard library directory. Directories added with \-I are searched
after the current directory, in the order in which they were given on
the command line, but before the standard library directory.
warnings is emitted. The
.I warning\-list
has the same meaning as for
-the "-w" option: an uppercase character turns the corresponding
+the "\-w" option: an uppercase character turns the corresponding
warning into an error, a lowercase character leaves it as a warning.
The default setting is
.B \-warn\-error\ a
.BR cos ,
.BR sin ,
.B tan
-have their range reduced to [-2^64, 2^64].
+have their range reduced to [\-2^64, 2^64].
.SH OPTIONS FOR THE AMD64 ARCHITECTURE
-\" $Id: ocamlrun.m,v 1.6 2008/09/15 14:12:56 doligez Exp $
+\" $Id: ocamlrun.m,v 1.6.2.1 2008/11/18 10:41:17 doligez Exp $
.TH OCAMLRUN 1
.SH NAME
.IR "The Objective Caml user's manual",
chapter "Standard Library", section "Gc".
.TP
-.BR b
+.B b
Trigger the printing of a stack backtrace
when an uncaught exception aborts the program.
This option takes no argument.
.TP
-.BR p
+.B p
Turn on debugging support for
.BR ocamlyacc -generated
parsers. When this option is on,
the pushdown automaton that executes the parsers prints a
trace of its actions. This option takes no argument.
.TP
+.BR a \ (allocation_policy)
+The policy used for allocating in the OCaml heap. Possible values
+are 0 for the next-fit policy, and 1 for the first-fit
+policy. Next-fit is somewhat faster, but first-fit is better for
+avoiding fragmentation and the associated heap compactions.
+.TP
.BR s \ (minor_heap_size)
The size of the minor heap (in words).
.TP
(* *)
(***********************************************************************)
-(* $Id: myocamlbuild.ml,v 1.23 2008/10/03 15:41:25 ertai Exp $ *)
+(* $Id: myocamlbuild.ml,v 1.23.2.2 2008/10/23 15:29:11 ertai Exp $ *)
open Ocamlbuild_plugin
open Command
let boot_ocamlc = S[ocamlrun; A"boot/ocamlc"; A"-I"; A"boot"; A"-nostdlib"]
-let partial = bool_of_string (getenv ~default:"false" "OCAMLBUILD_PARTIAL");;
+let mixed = Pathname.exists "build/ocamlbuild_mixed_mode";;
-let if_partial_dir dir =
- if partial then ".."/dir else dir;;
+let if_mixed_dir dir =
+ if mixed then ".."/dir else dir;;
let unix_dir =
match Sys.os_type with
- | "Win32" -> if_partial_dir "otherlibs/win32unix"
- | _ -> if_partial_dir "otherlibs/unix";;
+ | "Win32" -> if_mixed_dir "otherlibs/win32unix"
+ | _ -> if_mixed_dir "otherlibs/unix";;
-let threads_dir = if_partial_dir "otherlibs/threads";;
-let systhreads_dir = if_partial_dir "otherlibs/systhreads";;
-let dynlink_dir = if_partial_dir "otherlibs/dynlink";;
-let str_dir = if_partial_dir "otherlibs/str";;
-let toplevel_dir = if_partial_dir "toplevel";;
+let threads_dir = if_mixed_dir "otherlibs/threads";;
+let systhreads_dir = if_mixed_dir "otherlibs/systhreads";;
+let dynlink_dir = if_mixed_dir "otherlibs/dynlink";;
+let str_dir = if_mixed_dir "otherlibs/str";;
+let toplevel_dir = if_mixed_dir "toplevel";;
let ocamlc_solver =
let native_deps = ["ocamlc.opt"; "stdlib/stdlib.cmxa";
dispatch begin function
| Before_hygiene ->
- if partial then
+ if mixed then
let patt = String.concat ","
["asmcomp"; "bytecomp"; "debugger"; "driver";
"lex"; "ocamldoc"; "otherlibs"; "parsing"; "stdlib"; "tools";
List.iter Outcome.ignore_good res
;;
-rule "byte stdlib in partial mode"
- ~stamp:"byte_stdlib_partial_mode"
+rule "byte stdlib in mixed mode"
+ ~stamp:"byte_stdlib_mixed_mode"
~deps:["stdlib/stdlib.mllib"; "stdlib/stdlib.cma";
"stdlib/std_exit.cmo"; "stdlib/libcamlrun"-.-C.a;
"stdlib/camlheader"; "stdlib/camlheader_ur"]
Nop
end;;
-rule "native stdlib in partial mode"
- ~stamp:"native_stdlib_partial_mode"
+rule "native stdlib in mixed mode"
+ ~stamp:"native_stdlib_mixed_mode"
~deps:["stdlib/stdlib.mllib"; "stdlib/stdlib.cmxa";
"stdlib/stdlib"-.-C.a; "stdlib/std_exit.cmx";
"stdlib/std_exit"-.-C.o; "stdlib/libasmrun"-.-C.a;
then A"unix.cma", A"unix.cmxa", S[A"-I"; P unix_dir]
else N,N,N in
let dep_unix_byte, dep_unix_native =
- if link_unix && not partial
+ if link_unix && not mixed
then [unix_dir/"unix.cma"],
[unix_dir/"unix.cmxa"; unix_dir/"unix"-.-C.a]
else [],[] in
let cmos = add_extensions ["cmo"] deps in
let cmxs = add_extensions ["cmx"] deps in
let objs = add_extensions [C.o] deps in
- let dep_dynlink_native =
- if partial then [] else [dynlink_dir/"dynlink.cmxa"; dynlink_dir/"dynlink"-.-C.a]
+ let dep_dynlink_byte, dep_dynlink_native =
+ if mixed
+ then [], []
+ else [dynlink_dir/"dynlink.cma"],
+ [dynlink_dir/"dynlink.cmxa"; dynlink_dir/"dynlink"-.-C.a]
in
rule byte
- ~deps:(camlp4lib_cma::cmos @ dep_unix_byte)
+ ~deps:(camlp4lib_cma::cmos @ dep_unix_byte @ dep_dynlink_byte)
~prod:(add_exe byte)
~insert:(`before "ocaml: cmo* -> byte")
begin fun _ _ ->
- Cmd(S[ocamlc; include_unix; unix_cma; T(tags_of_pathname byte++"ocaml"++"link"++"byte");
+ Cmd(S[ocamlc; A"-I"; P dynlink_dir; A "dynlink.cma"; include_unix; unix_cma;
+ T(tags_of_pathname byte++"ocaml"++"link"++"byte");
P camlp4lib_cma; A"-linkall"; atomize cmos; A"-o"; Px (add_exe byte)])
end;
rule native
~prod:(add_exe native)
~insert:(`before "ocaml: cmx* & o* -> native")
begin fun _ _ ->
- Cmd(S[ocamlopt; A"-I"; P dynlink_dir; A "dynlink.cmxa"; include_unix; unix_cmxa; T(tags_of_pathname native++"ocaml"++"link"++"native");
+ Cmd(S[ocamlopt; A"-I"; P dynlink_dir; A "dynlink.cmxa"; include_unix; unix_cmxa;
+ T(tags_of_pathname native++"ocaml"++"link"++"native");
P camlp4lib_cmxa; A"-linkall"; atomize cmxs; A"-o"; Px (add_exe native)])
end;;
(* *)
(***********************************************************************)
-(* $Id: display.ml,v 1.3 2008/01/11 16:13:16 doligez Exp $ *)
+(* $Id: display.ml,v 1.3.4.1 2008/11/06 15:40:39 ertai Exp $ *)
(* Original author: Berke Durak *)
(* Display *)
open My_std;;
type display = {
di_log_level : int;
- di_log_channel : (Format.formatter * out_channel) option;
+ mutable di_log_channel : (Format.formatter * out_channel) option;
di_channel : out_channel;
di_formatter : Format.formatter;
di_display_line : display_line;
call_if di.di_log_channel
begin fun (fmt, oc) ->
Format.fprintf fmt "# Compilation %ssuccessful.@." (if how = `Error then "un" else "");
- close_out oc
+ close_out oc;
+ di.di_log_channel <- None
end;
match di.di_display_line with
| Classic -> ()
(* *)
(***********************************************************************)
-(* $Id: main.ml,v 1.21 2008/01/11 16:13:16 doligez Exp $ *)
+(* $Id: main.ml,v 1.21.4.1 2008/11/06 15:40:39 ertai Exp $ *)
(* Original author: Berke Durak *)
open My_std
open Log
exception Exit_silently
let clean () =
+ Log.finish ();
Shell.rm_rf !Options.build_dir;
if !Options.make_links then begin
let entry =
(* *)
(***********************************************************************)
-(* $Id: ocaml_specific.ml,v 1.23 2008/08/05 13:06:56 ertai Exp $ *)
+(* $Id: ocaml_specific.ml,v 1.23.2.1 2008/10/22 11:23:57 ertai Exp $ *)
(* Original author: Nicolas Pouillard *)
open My_std
open Format
flag ["ocaml"; "link"; "native"; "output_obj"] (A"-output-obj");;
flag ["ocaml"; "link"; "byte"; "output_obj"] (A"-output-obj");;
flag ["ocaml"; "dtypes"; "compile"] (A "-dtypes");;
+flag ["ocaml"; "annot"; "compile"] (A "-annot");;
flag ["ocaml"; "rectypes"; "compile"] (A "-rectypes");;
flag ["ocaml"; "rectypes"; "infer_interface"] (A "-rectypes");;
flag ["ocaml"; "linkall"; "link"] (A "-linkall");;
(* *)
(***********************************************************************)
-(* $Id: plugin.ml,v 1.4 2008/01/11 16:13:16 doligez Exp $ *)
+(* $Id: plugin.ml,v 1.4.4.1 2008/11/06 15:40:39 ertai Exp $ *)
(* Original author: Nicolas Pouillard *)
open My_std
open Format
if not !Options.just_plugin then
let spec = S[!Options.ocamlrun; P(!Options.build_dir/plugin);
A"-no-plugin"; atomize (List.tl (Array.to_list Sys.argv))] in
+ let () = Log.finish () in
raise (Exit_silently_with_code (sys_command (Command.string_of_command_spec spec)))
end
else
(* *)
(***********************************************************************)
-(* $Id: odoc_html.ml,v 1.64 2008/07/23 08:55:36 guesdon Exp $ *)
+(* $Id: odoc_html.ml,v 1.64.2.1 2008/11/10 13:03:55 guesdon Exp $ *)
(** Generation of html documentation.*)
None
else
match s.[n] with
- | '\n' -> iter_first (n+1)
+ | '\n' -> iter_first (n+1)
| _ -> Some n
in
match iter_first 0 with
(* *)
(***********************************************************************)
-(* $Id: odoc_man.ml,v 1.28 2008/07/23 08:55:36 guesdon Exp $ *)
+(* $Id: odoc_man.ml,v 1.28.2.1 2008/10/29 11:58:35 guesdon Exp $ *)
(** The man pages generator. *)
open Odoc_info
match s.[i] with
'\\' -> Buffer.add_string b "\\(rs"
| '.' -> Buffer.add_string b "\\&."
+ | '\'' -> Buffer.add_string b "\\&'"
+ | '-' -> Buffer.add_string b "\\-"
| c -> Buffer.add_char b c
done;
Buffer.contents b
(** Print groff string for a module comment.*)
method man_of_module_comment b text =
- bs b "\n.pp\n";
+ bs b "\n.PP\n";
self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")];
- bs b "\n.pp\n"
+ bs b "\n.PP\n"
(** Print groff string for a class comment.*)
method man_of_class_comment b text =
- bs b "\n.pp\n";
+ bs b "\n.PP\n";
self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")];
- bs b "\n.pp\n"
+ bs b "\n.PP\n"
(** Print groff string for an included module. *)
method man_of_included_module b m_name im =
(* *)
(***********************************************************************)
-(* $Id: odoc_ocamlhtml.mll,v 1.10 2008/01/11 16:13:16 doligez Exp $ *)
+(* $Id: odoc_ocamlhtml.mll,v 1.10.4.1 2008/11/10 13:03:55 guesdon Exp $ *)
(** Generation of html code to display OCaml code. *)
open Lexing
let store_string_char = Buffer.add_char string_buffer
let get_stored_string () =
let s = Buffer.contents string_buffer in
- String.escaped s
+ s
(** To translate escape sequences *)
(Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48) in
Char.chr(c land 0xFF)
+let char_for_hexa_code lexbuf i =
+ let c = 16 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
+ (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) in
+ Char.chr(c land 0xFF)
+
(** To store the position of the beginning of a string and comment *)
let string_start_pos = ref 0;;
let comment_start_pos = ref [];;
comment_start_pos := l;
comment lexbuf;
}
+(* These filters are useless
| "\""
{ reset_string_buffer();
string_start_pos := Lexing.lexeme_start lexbuf;
raise (Error (Unterminated_string_in_comment, st, st + 2))
end;
comment lexbuf }
- | "''"
- {
- store_comment_char '\'';
- store_comment_char '\'';
- comment lexbuf }
| "'" [^ '\\' '\''] "'"
{
store_comment_char '\'';
store_comment_char(char_for_backslash(Lexing.lexeme_char lexbuf 1)) ;
store_comment_char '\'';
comment lexbuf }
- | "'\\" ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
+ | "\\" ['0'-'9'] ['0'-'9'] ['0'-'9']
{
- store_comment_char '\'';
- store_comment_char '\\';
store_comment_char(char_for_decimal_code lexbuf 1);
+ comment lexbuf }
+ | "\\x" ['0'-'9' 'A'-'Z' 'a'-'z' ] ['0'-'9' 'A'-'Z' 'a'-'z']
+ {
+ store_comment_char(char_for_hexa_code lexbuf 2);
+ string lexbuf }
+ | "''"
+ {
+ store_comment_char '\'';
store_comment_char '\'';
comment lexbuf }
+*)
| eof
{ let st = List.hd !comment_start_pos in
raise (Error (Unterminated_comment, st, st + 2));
{ () }
| '\\' ("\010" | "\013" | "\013\010") [' ' '\009'] *
{ string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
- { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
+ | '\\' ['\\' '"' 'n' 't' 'b' 'r' ]
+ { Buffer.add_string string_buffer (Lexing.lexeme lexbuf) ;
string lexbuf }
| '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
- { store_string_char(char_for_decimal_code lexbuf 1);
+ {
+ Buffer.add_string string_buffer (Lexing.lexeme lexbuf) ;
+ string lexbuf
+ }
+ | '\\' 'x' ['0'-'9' 'A'-'Z' 'a'-'z' ] ['0'-'9' 'A'-'Z' 'a'-'z']
+ { Buffer.add_string string_buffer (Lexing.lexeme lexbuf) ;
string lexbuf }
| eof
{ raise (Error (Unterminated_string,
/* */
/***********************************************************************/
-/* $Id: bigarray.h,v 1.9 2006/01/27 14:33:42 doligez Exp $ */
+/* $Id: bigarray.h,v 1.9.14.1 2008/11/09 09:03:50 xleroy Exp $ */
#ifndef CAML_BIGARRAY_H
#define CAML_BIGARRAY_H
caml_ba_alloc(int flags, int num_dims, void * data, intnat * dim);
CAMLBAextern value caml_ba_alloc_dims(int flags, int num_dims, void * data,
... /*dimensions, with type intnat */);
+CAMLBAextern uintnat caml_ba_byte_size(struct caml_ba_array * b);
#endif
/* */
/***********************************************************************/
-/* $Id: bigarray_stubs.c,v 1.23 2008/01/04 09:52:27 xleroy Exp $ */
+/* $Id: bigarray_stubs.c,v 1.23.4.1 2008/11/09 09:03:51 xleroy Exp $ */
#include <stddef.h>
#include <stdarg.h>
/* Compute the number of bytes for the elements of a big array */
-uintnat caml_ba_byte_size(struct caml_ba_array * b)
+CAMLexport uintnat caml_ba_byte_size(struct caml_ba_array * b)
{
return caml_ba_num_elts(b)
* caml_ba_element_size[b->flags & CAML_BA_KIND_MASK];
CCFLAGS=-I../../../byterun $(TK_DEFS)
+include Makefile.shared
+
ifeq ($(CCOMPTYPE),cc)
-WINDOWS_APP=-ccopt "-Wl,--subsystem,windows"
+WINDOWS_APP=-ccopt "-link -Wl,--subsystem,windows"
else
-WINDOWS_APP=-ccopt "/link /subsystem:windows"
+WINDOWS_APP=-ccopt "-link /subsystem:windows"
endif
-OCAMLBR=threads.cma winmain.$(O) $(WINDOWS_APP)
-
-include Makefile.shared
+XTRAOBJ=winmain.$(O)
+XTRALIBS=threads.cma -custom $(WINDOWS_APP)
dummy.mli:
cp dummyWin.mli dummy.mli
all: ocamlbrowser$(EXE)
ocamlbrowser$(EXE): $(TOPDIR)/toplevel/toplevellib.cma jglib.cma $(OBJ) \
- ../support/lib$(LIBNAME).$(A)
+ ../support/lib$(LIBNAME).$(A) $(XTRAOBJ)
$(CAMLC) -o ocamlbrowser$(EXE) $(INCLUDES) \
$(TOPDIR)/toplevel/toplevellib.cma \
- unix.cma str.cma $(OCAMLBR) $(LIBNAME).cma jglib.cma $(OBJ)
+ unix.cma str.cma $(XTRALIBS) $(LIBNAME).cma jglib.cma \
+ $(OBJ) $(XTRAOBJ)
ocamlbrowser.cma: jglib.cma $(OBJ)
$(CAMLC) -a -o $@ -linkall jglib.cma $(OBJ)
#include <callback.h>
#include <sys.h>
-CAMLextern int __argc;
-CAMLextern char **__argv;
-CAMLextern void caml_expand_command_line(int * argcp, char *** argvp);
+/*CAMLextern int __argc; */
+/* CAMLextern char **__argv; */
+/* CAMLextern void caml_expand_command_line(int * argcp, char *** argvp); */
/* extern void caml_main (char **); */
int WINAPI WinMain(HINSTANCE h, HINSTANCE HPrevInstance,
LPSTR lpCmdLine, int nCmdShow)
{
- caml_expand_command_line(&__argc, &__argv);
- caml_main(__argv);
+ char exe_name[1024];
+ char * argv[2];
+
+ GetModuleFileName(NULL, exe_name, sizeof(exe_name) - 1);
+ exe_name[sizeof(exe_name) - 1] = '0';
+ argv[0] = exe_name;
+ argv[1] = NULL;
+ caml_main(argv);
sys_exit(Val_int(0));
return 0;
}
/* */
/***********************************************************************/
-/* $Id: select.c,v 1.14 2008/07/31 12:09:18 xleroy Exp $ */
+/* $Id: select.c,v 1.14.2.1 2008/10/29 13:38:56 xleroy Exp $ */
#include <mlvalues.h>
#include <alloc.h>
/* Time to wait */
DWORD milliseconds;
+ /* Is there static select data */
+ BOOL hasStaticData = FALSE;
+
/* Wait return */
DWORD waitRet;
iterSelectData = NULL;
iterResult = NULL;
err = 0;
+ hasStaticData = 0;
waitRet = 0;
readfds_len = caml_list_length(readfds);
writefds_len = caml_list_length(writefds);
iterSelectData = lpSelectData;
while (iterSelectData != NULL)
{
+ /* Check if it is static data. If this is the case, launch everything
+ * but don't wait for events. It helps to test if there are events on
+ * any other fd (which are not static), knowing that there is at least
+ * one result (the static data).
+ */
+ if (iterSelectData->EType == SELECT_TYPE_STATIC)
+ {
+ hasStaticData = TRUE;
+ };
+
/* Execute APC */
if (iterSelectData->funcWorker != NULL)
{
if (nEventsCount > 0)
{
/* Waiting for event */
- if (err == 0)
+ if (err == 0 && !hasStaticData)
{
DBUG_PRINT("Waiting for one select worker to be done");
switch (WaitForMultipleObjects(nEventsCount, lpEventsDone, FALSE, milliseconds))
}
}
/* Nothing to monitor but some time to wait. */
- else
+ else if (!hasStaticData)
{
Sleep(milliseconds);
}
(* *)
(***********************************************************************)
-(* $Id: filename.ml,v 1.41 2007/01/09 13:42:17 doligez Exp $ *)
+(* $Id: filename.ml,v 1.41.12.1 2008/11/20 18:36:52 doligez Exp $ *)
let generic_quote quotequote s =
let l = String.length s in
let b = Buffer.create (l + 20) in
Buffer.add_char b '\"';
let rec loop i =
- if i = l then () else
+ if i = l then Buffer.add_char b '\"' else
match s.[i] with
| '\"' -> loop_bs 0 i;
| '\\' -> loop_bs 0 i;
| c -> Buffer.add_char b c; loop (i+1);
and loop_bs n i =
- if i = l then add_bs (2*n) else
- match s.[i] with
- | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1);
- | '\\' -> loop_bs (n+1) (i+1);
- | c -> add_bs n; loop i
+ if i = l then begin
+ Buffer.add_char b '\"';
+ add_bs n;
+ end else begin
+ match s.[i] with
+ | '\"' -> add_bs (2*n+1); Buffer.add_char b '\"'; loop (i+1);
+ | '\\' -> loop_bs (n+1) (i+1);
+ | c -> add_bs n; loop i
+ end
and add_bs n = for j = 1 to n do Buffer.add_char b '\\'; done
in
loop 0;
- Buffer.add_char b '\"';
Buffer.contents b
let has_drive s =
let is_letter = function
(* *)
(***********************************************************************)
-(* $Id: gc.ml,v 1.20 2004/06/14 13:27:36 doligez Exp $ *)
+(* $Id: gc.ml,v 1.20.24.1 2008/11/18 10:24:43 doligez Exp $ *)
type stat = {
minor_words : float;
mutable verbose : int;
mutable max_overhead : int;
mutable stack_limit : int;
+ mutable allocation_policy : int;
};;
external stat : unit -> stat = "caml_gc_stat";;
(* *)
(***********************************************************************)
-(* $Id: gc.mli,v 1.44 2008/02/29 14:21:22 doligez Exp $ *)
+(* $Id: gc.mli,v 1.44.4.1 2008/11/18 10:24:43 doligez Exp $ *)
(** Memory management control and statistics; finalised values. *)
(** The maximum size of the stack (in words). This is only
relevant to the byte-code runtime, as the native code runtime
uses the operating system's stack. Default: 256k. *)
+
+ mutable allocation_policy : int;
+ (** The policy used for allocating in the heap. Possible
+ values are 0 and 1. 0 is the next-fit policy, which is
+ quite fast but can result in fragmentation. 1 is the
+ first-fit policy, which can be slower in some cases but
+ can be better for programs with fragmentation problems.
+ Default: 0. *)
}
(** The GC parameters are given as a [control] record. Note that
these parameters can also be initialised by setting the
(* *)
(***********************************************************************)
-(* $Id: string.ml,v 1.28 2008/07/22 11:29:00 weis Exp $ *)
+(* $Id: string.ml,v 1.28.2.1 2008/11/12 10:53:47 doligez Exp $ *)
(* String operations *)
let index_from s i c =
let l = length s in
- if i < 0 || i >= l then invalid_arg "String.index_from" else
+ if i < 0 || i > l then invalid_arg "String.index_from" else
index_rec s l i c;;
let rec rindex_rec s i c =
let rindex s c = rindex_rec s (length s - 1) c;;
let rindex_from s i c =
- let l = length s in
- if i < 0 || i >= l then invalid_arg "String.rindex_from" else
+ if i < -1 || i >= length s then invalid_arg "String.rindex_from" else
rindex_rec s i c;;
let contains_from s i c =
let l = length s in
- if i < 0 || i >= l then invalid_arg "String.contains_from" else
+ if i < 0 || i > l then invalid_arg "String.contains_from" else
try ignore (index_rec s l i c); true with Not_found -> false;;
-let contains s c =
- let l = length s in
- l <> 0 && contains_from s 0 c;;
+let contains s c = contains_from s 0 c;;
let rcontains_from s i c =
- let l = length s in
- if i < 0 || i >= l then invalid_arg "String.rcontains_from" else
+ if i < 0 || i >= length s then invalid_arg "String.rcontains_from" else
try ignore (rindex_rec s i c); true with Not_found -> false;;
type t = string
(* *)
(***********************************************************************)
-(* $Id: weak.mli,v 1.16 2008/09/17 14:55:30 doligez Exp $ *)
+(* $Id: weak.mli,v 1.16.2.1 2008/11/13 10:39:46 doligez Exp $ *)
(** Arrays of weak pointers and hash tables of weak pointers. *)
type 'a t
(** The type of arrays of weak pointers (weak arrays). A weak
- pointer is a value that the garbage collector may erase at
- any time.
+ pointer is a value that the garbage collector may erase whenever
+ the value is not used any more (through normal pointers) by the
+ program. Note that finalisation functions are run after the
+ weak pointers are erased.
+
A weak pointer is said to be full if it points to a value,
empty if the value was erased by the GC.
# #
#########################################################################
-# $Id: make-package-macosx,v 1.16 2008/02/29 14:21:22 doligez Exp $
+# $Id: make-package-macosx,v 1.16.4.1 2008/10/16 15:57:00 doligez Exp $
cd package-macosx
rm -rf ocaml.pkg ocaml-rw.dmg
cat >resources/ReadMe.txt <<EOF
This package installs Objective Caml version ${VERSION}.
You need Mac OS X 10.5.x (Leopard), with the
-XCode tools (v3.x) installed (and optionally X11).
+XCode tools installed (v3.1.1 or later), and
+optionally X11.
Files will be installed in the following directories:
(* *)
(***********************************************************************)
-(* $Id: opttopdirs.ml,v 1.2 2007/11/06 15:16:56 frisch Exp $ *)
+(* $Id: opttopdirs.ml,v 1.2.4.1 2008/11/19 02:35:40 garrigue Exp $ *)
(* Toplevel directives *)
Hashtbl.add directive_table "principal"
(Directive_bool(fun b -> Clflags.principal := b));
+ Hashtbl.add directive_table "rectypes"
+ (Directive_none(fun () -> Clflags.recursive_types := true));
+
Hashtbl.add directive_table "warnings"
(Directive_string (parse_warnings std_out false));
(* *)
(***********************************************************************)
-(* $Id: topdirs.ml,v 1.66 2006/09/28 21:36:38 xleroy Exp $ *)
+(* $Id: topdirs.ml,v 1.66.14.1 2008/11/19 02:35:40 garrigue Exp $ *)
(* Toplevel directives *)
Hashtbl.add directive_table "principal"
(Directive_bool(fun b -> Clflags.principal := b));
+ Hashtbl.add directive_table "rectypes"
+ (Directive_none(fun () -> Clflags.recursive_types := true));
+
Hashtbl.add directive_table "warnings"
(Directive_string (parse_warnings std_out false));
(* *)
(***********************************************************************)
-(* $Id: ctype.mli,v 1.55 2007/11/01 18:36:43 weis Exp $ *)
+(* $Id: ctype.mli,v 1.55.4.1 2008/10/16 03:05:26 garrigue Exp $ *)
(* Operations on core types *)
val expand_head_once: Env.t -> type_expr -> type_expr
val expand_head: Env.t -> type_expr -> type_expr
+val try_expand_once_opt: Env.t -> type_expr -> type_expr
val expand_head_opt: Env.t -> type_expr -> type_expr
(** The compiler's own version of [expand_head] necessary for type-based
optimisations. *)
(* *)
(***********************************************************************)
-(* $Id: includecore.ml,v 1.35 2007/11/28 22:27:35 weis Exp $ *)
+(* $Id: includecore.ml,v 1.35.4.2 2008/10/16 03:05:26 garrigue Exp $ *)
(* Inclusion checks for the core language *)
end
| _ -> false
-let type_manifest env ty1 params1 ty2 params2 =
+let type_manifest env ty1 params1 ty2 params2 priv2 =
let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
match ty1'.desc, ty2'.desc with
Tvariant row1, Tvariant row2 when is_absrow env (Btype.row_more row2) ->
List.split (List.map (fun (_,_,t1,_,t2) -> t1, t2) pairs) in
Ctype.equal env true (params1 @ tl1) (params2 @ tl2)
| _ ->
- Ctype.equal env true (ty1 :: params1) (ty2 :: params2)
+ let rec check_super ty1 =
+ Ctype.equal env true (ty1 :: params1) (ty2 :: params2) ||
+ priv2 = Private &&
+ try check_super
+ (Ctype.try_expand_once_opt env (Ctype.expand_head env ty1))
+ with Ctype.Cannot_expand -> false
+ in check_super ty1
(* Inclusion between type declarations *)
Ctype.equal env true decl1.type_params decl2.type_params
| (Some ty1, Some ty2) ->
type_manifest env ty1 decl1.type_params ty2 decl2.type_params
+ decl2.type_private
| (None, Some ty2) ->
let ty1 =
Btype.newgenty (Tconstr(Pident id, decl2.type_params, ref Mnil))
(* *)
(***********************************************************************)
-(* $Id: ccomp.ml,v 1.28.4.1 2008/10/15 08:48:51 xleroy Exp $ *)
+(* $Id: ccomp.ml,v 1.28.4.2 2008/10/16 15:57:00 doligez Exp $ *)
(* Compiling C files and building C libraries *)
)
(Filename.quote output_name)
(if !Clflags.gprofile then Config.cc_profile else "")
- (Clflags.std_include_flag "-I")
+ "" (*(Clflags.std_include_flag "-I")*)
(quote_prefixed "-L" !Config.load_path)
files
extra
projects / ocaml.git / commitdiff