diff --git a/.depend b/.depend index a3fc2c9e8..e43116203 100644 --- a/.depend +++ b/.depend @@ -443,14 +443,14 @@ asmcomp/asmlink.cmi: asmcomp/compilenv.cmi asmcomp/clambda.cmi: bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi parsing/asttypes.cmi asmcomp/closure.cmi: bytecomp/lambda.cmi asmcomp/clambda.cmi -asmcomp/cmmgen.cmi: asmcomp/cmm.cmi asmcomp/clambda.cmi asmcomp/cmm.cmi: typing/ident.cmi asmcomp/debuginfo.cmi +asmcomp/cmmgen.cmi: asmcomp/cmm.cmi asmcomp/clambda.cmi asmcomp/codegen.cmi: asmcomp/cmm.cmi asmcomp/comballoc.cmi: asmcomp/mach.cmi asmcomp/compilenv.cmi: typing/ident.cmi asmcomp/clambda.cmi asmcomp/debuginfo.cmi: parsing/location.cmi bytecomp/lambda.cmi -asmcomp/emitaux.cmi: asmcomp/debuginfo.cmi asmcomp/emit.cmi: asmcomp/linearize.cmi asmcomp/cmm.cmi +asmcomp/emitaux.cmi: asmcomp/debuginfo.cmi asmcomp/interf.cmi: asmcomp/mach.cmi asmcomp/linearize.cmi: asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/liveness.cmi: asmcomp/mach.cmi @@ -461,15 +461,17 @@ asmcomp/printlinear.cmi: asmcomp/linearize.cmi asmcomp/printmach.cmi: asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/proc.cmi: asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/reg.cmi: asmcomp/cmm.cmi -asmcomp/reloadgen.cmi: asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/reload.cmi: asmcomp/mach.cmi +asmcomp/reloadgen.cmi: asmcomp/reg.cmi asmcomp/mach.cmi asmcomp/schedgen.cmi: asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/scheduling.cmi: asmcomp/linearize.cmi asmcomp/selectgen.cmi: utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ - typing/ident.cmi asmcomp/cmm.cmi asmcomp/arch.cmo + typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi asmcomp/spill.cmi: asmcomp/mach.cmi asmcomp/split.cmi: asmcomp/mach.cmi +asmcomp/arch.cmo: utils/misc.cmi utils/config.cmi +asmcomp/arch.cmx: utils/misc.cmx utils/config.cmx asmcomp/asmgen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/selection.cmi \ asmcomp/scheduling.cmi asmcomp/reload.cmi asmcomp/reg.cmi \ asmcomp/proc.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \ @@ -524,6 +526,10 @@ asmcomp/closure.cmx: utils/tbl.cmx bytecomp/switch.cmx typing/primitive.cmx \ utils/misc.cmx bytecomp/lambda.cmx typing/ident.cmx asmcomp/debuginfo.cmx \ asmcomp/compilenv.cmx utils/clflags.cmx asmcomp/clambda.cmx \ parsing/asttypes.cmi asmcomp/closure.cmi +asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \ + asmcomp/cmm.cmi +asmcomp/cmm.cmx: typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/arch.cmx \ + asmcomp/cmm.cmi asmcomp/cmmgen.cmo: typing/types.cmi bytecomp/switch.cmi asmcomp/proc.cmi \ typing/primitive.cmi utils/misc.cmi bytecomp/lambda.cmi typing/ident.cmi \ asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ @@ -534,10 +540,6 @@ asmcomp/cmmgen.cmx: typing/types.cmx bytecomp/switch.cmx asmcomp/proc.cmx \ asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ asmcomp/cmm.cmx utils/clflags.cmx asmcomp/clambda.cmx \ parsing/asttypes.cmi asmcomp/arch.cmx asmcomp/cmmgen.cmi -asmcomp/cmm.cmo: typing/ident.cmi asmcomp/debuginfo.cmi asmcomp/arch.cmo \ - asmcomp/cmm.cmi -asmcomp/cmm.cmx: typing/ident.cmx asmcomp/debuginfo.cmx asmcomp/arch.cmx \ - asmcomp/cmm.cmi asmcomp/codegen.cmo: asmcomp/split.cmi asmcomp/spill.cmi asmcomp/reload.cmi \ asmcomp/reg.cmi asmcomp/printmach.cmi asmcomp/printlinear.cmi \ asmcomp/printcmm.cmi asmcomp/liveness.cmi asmcomp/linearize.cmi \ @@ -562,20 +564,22 @@ asmcomp/debuginfo.cmo: parsing/location.cmi bytecomp/lambda.cmi \ asmcomp/debuginfo.cmi asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \ asmcomp/debuginfo.cmi +asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ + asmcomp/mach.cmi parsing/location.cmi asmcomp/linearize.cmi \ + asmcomp/emitaux.cmi asmcomp/debuginfo.cmi utils/config.cmi \ + asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \ + asmcomp/emit.cmi +asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ + asmcomp/mach.cmx parsing/location.cmx asmcomp/linearize.cmx \ + asmcomp/emitaux.cmx asmcomp/debuginfo.cmx utils/config.cmx \ + asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \ + asmcomp/emit.cmi asmcomp/emitaux.cmo: asmcomp/reg.cmi asmcomp/linearize.cmi \ asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/emitaux.cmi asmcomp/emitaux.cmx: asmcomp/reg.cmx asmcomp/linearize.cmx \ asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/emitaux.cmi -asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ - asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \ - asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \ - asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi -asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ - asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \ - asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \ - asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi asmcomp/interf.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/interf.cmi asmcomp/interf.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ @@ -609,39 +613,39 @@ asmcomp/printmach.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printcmm.cmx \ asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/printmach.cmi asmcomp/proc.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ - asmcomp/cmm.cmi utils/ccomp.cmi asmcomp/arch.cmo asmcomp/proc.cmi + utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \ + asmcomp/arch.cmo asmcomp/proc.cmi asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ - asmcomp/cmm.cmx utils/ccomp.cmx asmcomp/arch.cmx asmcomp/proc.cmi + utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \ + asmcomp/arch.cmx asmcomp/proc.cmi asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi +asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reload.cmi +asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reload.cmi asmcomp/reloadgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/reloadgen.cmi asmcomp/reloadgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/reloadgen.cmi -asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \ - asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/reload.cmi -asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \ - asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/reload.cmi asmcomp/schedgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \ asmcomp/linearize.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ asmcomp/schedgen.cmi asmcomp/schedgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \ asmcomp/linearize.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ asmcomp/schedgen.cmi -asmcomp/scheduling.cmo: asmcomp/schedgen.cmi asmcomp/scheduling.cmi -asmcomp/scheduling.cmx: asmcomp/schedgen.cmx asmcomp/scheduling.cmi +asmcomp/scheduling.cmo: asmcomp/schedgen.cmi asmcomp/mach.cmi \ + asmcomp/arch.cmo asmcomp/scheduling.cmi +asmcomp/scheduling.cmx: asmcomp/schedgen.cmx asmcomp/mach.cmx \ + asmcomp/arch.cmx asmcomp/scheduling.cmi asmcomp/selectgen.cmo: utils/tbl.cmi asmcomp/reg.cmi asmcomp/proc.cmi \ - utils/misc.cmi asmcomp/mach.cmi typing/ident.cmi asmcomp/cmm.cmi \ - asmcomp/arch.cmo asmcomp/selectgen.cmi + utils/misc.cmi asmcomp/mach.cmi typing/ident.cmi asmcomp/debuginfo.cmi \ + asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/selectgen.cmi asmcomp/selectgen.cmx: utils/tbl.cmx asmcomp/reg.cmx asmcomp/proc.cmx \ - utils/misc.cmx asmcomp/mach.cmx typing/ident.cmx asmcomp/cmm.cmx \ - asmcomp/arch.cmx asmcomp/selectgen.cmi -asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \ - utils/misc.cmi asmcomp/mach.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \ - asmcomp/selection.cmi -asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \ - utils/misc.cmx asmcomp/mach.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \ - asmcomp/selection.cmi + utils/misc.cmx asmcomp/mach.cmx typing/ident.cmx asmcomp/debuginfo.cmx \ + asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selectgen.cmi +asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi utils/misc.cmi \ + asmcomp/mach.cmi asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/selection.cmi +asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx utils/misc.cmx \ + asmcomp/mach.cmx asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selection.cmi asmcomp/spill.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \ asmcomp/mach.cmi asmcomp/spill.cmi asmcomp/spill.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \ @@ -680,8 +684,6 @@ driver/errors.cmx: utils/warnings.cmx typing/typetexp.cmx typing/typemod.cmx \ parsing/location.cmx parsing/lexer.cmx typing/includemod.cmx \ typing/env.cmx typing/ctype.cmx bytecomp/bytepackager.cmx \ bytecomp/bytelink.cmx bytecomp/bytelibrarian.cmx driver/errors.cmi -driver/main_args.cmo: driver/main_args.cmi -driver/main_args.cmx: driver/main_args.cmi driver/main.cmo: utils/warnings.cmi utils/misc.cmi driver/main_args.cmi \ driver/errors.cmi utils/config.cmi driver/compile.cmi utils/clflags.cmi \ bytecomp/bytepackager.cmi bytecomp/bytelink.cmi \ @@ -690,6 +692,8 @@ driver/main.cmx: utils/warnings.cmx utils/misc.cmx driver/main_args.cmx \ driver/errors.cmx utils/config.cmx driver/compile.cmx utils/clflags.cmx \ bytecomp/bytepackager.cmx bytecomp/bytelink.cmx \ bytecomp/bytelibrarian.cmx driver/main.cmi +driver/main_args.cmo: driver/main_args.cmi +driver/main_args.cmx: driver/main_args.cmi driver/optcompile.cmo: utils/warnings.cmi typing/unused_var.cmi \ typing/typemod.cmi typing/typedtree.cmi bytecomp/translmod.cmi \ bytecomp/simplif.cmi typing/printtyp.cmi bytecomp/printlambda.cmi \ diff --git a/asmcomp/amd64/selection.ml b/asmcomp/amd64/selection.ml index d28fbfb99..d33ae744c 100644 --- a/asmcomp/amd64/selection.ml +++ b/asmcomp/amd64/selection.ml @@ -72,7 +72,7 @@ let rec select_addr exp = end | arg -> (Alinear arg, 0) - + (* Special constraints on operand and result registers *) exception Use_default @@ -87,10 +87,10 @@ let pseudoregs_for_operation op arg res = Iintop(Iadd|Isub|Imul|Iand|Ior|Ixor) | Iaddf|Isubf|Imulf|Idivf -> ([|res.(0); arg.(1)|], res) (* One-address unary operations: arg.(0) and res.(0) must be the same *) - | Iintop_imm((Iadd|Isub|Imul|Iand|Ior|Ixor|Ilsl|Ilsr|Iasr), _) + | Iintop_imm((Iadd|Isub|Imul|Iand|Ior|Ixor|Ilsl|Ilsr|Iasr), _) | Iabsf | Inegf -> (res, res) - | Ispecific(Ifloatarithmem(_,_)) -> + | Ispecific(Ifloatarithmem(_,_)) -> let arg' = Array.copy arg in arg'.(0) <- res.(0); (arg', res) @@ -229,4 +229,3 @@ method insert_op op rs rd = end let fundecl f = (new selector)#emit_fundecl f - diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index 34a2a5a65..15dc67986 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -96,6 +96,7 @@ let prim_size prim args = | Psetfield(f, isptr) -> if isptr then 4 else 1 | Pfloatfield f -> 1 | Psetfloatfield f -> 1 + | Pduprecord _ -> 10 + List.length args | Pccall p -> (if p.prim_alloc then 10 else 4) + List.length args | Praise -> 4 | Pstringlength -> 5 @@ -177,7 +178,7 @@ let lambda_smaller lam threshold = let rec is_pure_clambda = function Uvar v -> true | Uconst cst -> true - | Uprim((Psetglobal _ | Psetfield _ | Psetfloatfield _ | + | Uprim((Psetglobal _ | Psetfield _ | Psetfloatfield _ | Pduprecord _ | Pccall _ | Praise | Poffsetref _ | Pstringsetu | Pstringsets | Parraysetu _ | Parraysets _ | Pbigarrayset _), _, _) -> false | Uprim(p, args, _) -> List.for_all is_pure_clambda args @@ -375,7 +376,7 @@ let bind_params params args body = let rec is_pure = function Lvar v -> true | Lconst cst -> true - | Lprim((Psetglobal _ | Psetfield _ | Psetfloatfield _ | + | Lprim((Psetglobal _ | Psetfield _ | Psetfloatfield _ | Pduprecord _ | Pccall _ | Praise | Poffsetref _ | Pstringsetu | Pstringsets | Parraysetu _ | Parraysets _), _) -> false | Lprim(p, args) -> List.for_all is_pure args diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index 9d65ee9f5..79196cd56 100644 --- a/asmcomp/cmmgen.ml +++ b/asmcomp/cmmgen.ml @@ -624,7 +624,9 @@ let simplif_primitive_32bits = function let simplif_primitive p = match p with - Pbigarrayref(n, Pbigarray_unknown, layout) -> + | Pduprecord _ -> + Pccall (default_prim "caml_obj_dup") + | Pbigarrayref(n, Pbigarray_unknown, layout) -> Pccall (default_prim ("caml_ba_get_" ^ string_of_int n)) | Pbigarrayset(n, Pbigarray_unknown, layout) -> Pccall (default_prim ("caml_ba_set_" ^ string_of_int n)) @@ -822,7 +824,7 @@ let rec transl = function Cop(Capply(typ_addr, dbg), cargs) | Usend(kind, met, obj, args, dbg) -> let call_met obj args clos = - if args = [] then + if args = [] then Cop(Capply(typ_addr, dbg), [get_field clos 0;obj;clos]) else let arity = List.length args + 1 in diff --git a/asmcomp/i386/proc.ml b/asmcomp/i386/proc.ml index 1a6150f4b..4076b4df2 100644 --- a/asmcomp/i386/proc.ml +++ b/asmcomp/i386/proc.ml @@ -94,7 +94,7 @@ let word_addressed = false with negative offsets, starting at -64. Unlike arguments passed on stack, arguments passed in globals do not prevent tail-call elimination. The caller stores arguments - in these globals immediately before the call, and the first thing the + in these globals immediately before the call, and the first thing the callee does is copy them to registers or stack locations. Neither GC nor thread context switches can occur between these two times. *) diff --git a/asmrun/.depend b/asmrun/.depend index ff6da822d..c44d0257d 100644 --- a/asmrun/.depend +++ b/asmrun/.depend @@ -16,6 +16,13 @@ array.o: array.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.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 +backtrace.o: backtrace.c ../byterun/backtrace.h ../byterun/mlvalues.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \ + ../byterun/config.h ../byterun/gc.h ../byterun/mlvalues.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 stack.h callback.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/misc.h ../byterun/config.h ../byterun/fail.h \ @@ -301,12 +308,13 @@ signals.o: signals.c ../byterun/alloc.h ../byterun/misc.h \ signals_osdep.h stack.h ../byterun/sys.h ../byterun/misc.h startup.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/misc.h ../byterun/config.h ../byterun/custom.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/gc.h ../byterun/mlvalues.h \ - ../byterun/gc_ctrl.h ../byterun/misc.h ../byterun/osdeps.h \ - ../byterun/misc.h ../byterun/printexc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/sys.h ../byterun/misc.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/gc.h ../byterun/mlvalues.h ../byterun/gc_ctrl.h \ + ../byterun/misc.h ../byterun/osdeps.h ../byterun/misc.h \ + ../byterun/printexc.h ../byterun/misc.h ../byterun/mlvalues.h \ + ../byterun/sys.h ../byterun/misc.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 \ @@ -366,6 +374,13 @@ array.d.o: array.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.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 +backtrace.d.o: backtrace.c ../byterun/backtrace.h ../byterun/mlvalues.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \ + ../byterun/config.h ../byterun/gc.h ../byterun/mlvalues.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 stack.h callback.d.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/misc.h ../byterun/config.h ../byterun/fail.h \ @@ -651,12 +666,13 @@ signals.d.o: signals.c ../byterun/alloc.h ../byterun/misc.h \ signals_osdep.h stack.h ../byterun/sys.h ../byterun/misc.h startup.d.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/misc.h ../byterun/config.h ../byterun/custom.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/gc.h ../byterun/mlvalues.h \ - ../byterun/gc_ctrl.h ../byterun/misc.h ../byterun/osdeps.h \ - ../byterun/misc.h ../byterun/printexc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/sys.h ../byterun/misc.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/gc.h ../byterun/mlvalues.h ../byterun/gc_ctrl.h \ + ../byterun/misc.h ../byterun/osdeps.h ../byterun/misc.h \ + ../byterun/printexc.h ../byterun/misc.h ../byterun/mlvalues.h \ + ../byterun/sys.h ../byterun/misc.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 \ @@ -716,6 +732,13 @@ array.p.o: array.c ../byterun/alloc.h ../byterun/misc.h ../byterun/config.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 +backtrace.p.o: backtrace.c ../byterun/backtrace.h ../byterun/mlvalues.h \ + ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ + ../byterun/misc.h ../byterun/config.h ../byterun/memory.h \ + ../byterun/config.h ../byterun/gc.h ../byterun/mlvalues.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 stack.h callback.p.o: callback.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ ../byterun/misc.h ../byterun/config.h ../byterun/fail.h \ @@ -1001,12 +1024,13 @@ signals.p.o: signals.c ../byterun/alloc.h ../byterun/misc.h \ signals_osdep.h stack.h ../byterun/sys.h ../byterun/misc.h startup.p.o: startup.c ../byterun/callback.h ../byterun/mlvalues.h \ ../byterun/config.h ../byterun/../config/m.h ../byterun/../config/s.h \ - ../byterun/misc.h ../byterun/config.h ../byterun/custom.h \ - ../byterun/mlvalues.h ../byterun/fail.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/gc.h ../byterun/mlvalues.h \ - ../byterun/gc_ctrl.h ../byterun/misc.h ../byterun/osdeps.h \ - ../byterun/misc.h ../byterun/printexc.h ../byterun/misc.h \ - ../byterun/mlvalues.h ../byterun/sys.h ../byterun/misc.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/gc.h ../byterun/mlvalues.h ../byterun/gc_ctrl.h \ + ../byterun/misc.h ../byterun/osdeps.h ../byterun/misc.h \ + ../byterun/printexc.h ../byterun/misc.h ../byterun/mlvalues.h \ + ../byterun/sys.h ../byterun/misc.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 \ diff --git a/boot/ocamlc b/boot/ocamlc index 73e6c4d61..3e5fd4271 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamllex b/boot/ocamllex index bf049efec..daf6b01b6 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 79f862b97..2cd0c65b0 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -128,15 +128,36 @@ let rec push_dummies n k = match n with type rhs_kind = | RHS_block of int + | RHS_floatblock of int | RHS_nonrec ;; + +let rec check_recordwith_updates id e = + match e with + | Lsequence (Lprim ((Psetfield _ | Psetfloatfield _), [Lvar id2; _]), cont) + -> id2 = id && check_recordwith_updates id cont + | Lvar id2 -> id2 = id + | _ -> false +;; + let rec size_of_lambda = function | Lfunction(kind, params, body) as funct -> RHS_block (1 + IdentSet.cardinal(free_variables funct)) + | Llet (Strict, id, Lprim (Pduprecord (kind, size), _), body) + when check_recordwith_updates id body -> + begin match kind with + | Record_regular -> RHS_block size + | Record_float -> RHS_floatblock size + end | Llet(str, id, arg, body) -> size_of_lambda body | Lletrec(bindings, body) -> size_of_lambda body | Lprim(Pmakeblock(tag, mut), args) -> RHS_block (List.length args) - | Lprim(Pmakearray kind, args) -> RHS_block (List.length args) + | Lprim (Pmakearray (Paddrarray|Pintarray), args) -> + RHS_block (List.length args) + | Lprim (Pmakearray Pfloatarray, args) -> RHS_floatblock (List.length args) + | Lprim (Pmakearray Pgenarray, args) -> assert false + | Lprim (Pduprecord (Record_regular, size), args) -> RHS_block size + | Lprim (Pduprecord (Record_float, size), args) -> RHS_floatblock size | Levent (lam, _) -> size_of_lambda lam | Lsequence (lam, lam') -> size_of_lambda lam' | _ -> RHS_nonrec @@ -171,7 +192,7 @@ let merge_repr ev ev' = let merge_events ev ev' = let (maj, min) = match ev.ev_kind, ev'.ev_kind with - (* Discard pseudo-events *) + (* Discard pseudo-events *) Event_pseudo, _ -> ev', ev | _, Event_pseudo -> ev, ev' (* Keep following event, supposedly more informative *) @@ -205,7 +226,7 @@ let weaken_event ev cont = end | _ -> Kevent ev :: cont - + let add_event ev = function Kevent ev' :: cont -> weaken_event (merge_events ev ev') cont @@ -275,6 +296,7 @@ let comp_primitive p args = | Psetfield(n, ptr) -> Ksetfield n | Pfloatfield n -> Kgetfloatfield n | Psetfloatfield n -> Ksetfloatfield n + | Pduprecord _ -> Kccall("caml_obj_dup", 1) | Pccall p -> Kccall(p.prim_name, p.prim_arity) | Pnegint -> Knegint | Paddint -> Kaddint @@ -472,6 +494,10 @@ let rec comp_expr env exp sz cont = List.map (fun (id, exp) -> (id, exp, size_of_lambda exp)) decl in let rec comp_init new_env sz = function | [] -> comp_nonrec new_env sz ndecl decl_size + | (id, exp, RHS_floatblock blocksize) :: rem -> + Kconst(Const_base(Const_int blocksize)) :: + Kccall("caml_alloc_dummy_float", 1) :: Kpush :: + comp_init (add_var id (sz+1) new_env) (sz+1) rem | (id, exp, RHS_block blocksize) :: rem -> Kconst(Const_base(Const_int blocksize)) :: Kccall("caml_alloc_dummy", 1) :: Kpush :: @@ -481,14 +507,14 @@ let rec comp_expr env exp sz cont = comp_init (add_var id (sz+1) new_env) (sz+1) rem and comp_nonrec new_env sz i = function | [] -> comp_rec new_env sz ndecl decl_size - | (id, exp, RHS_block blocksize) :: rem -> + | (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem -> comp_nonrec new_env sz (i-1) rem | (id, exp, RHS_nonrec) :: rem -> comp_expr new_env exp sz (Kassign (i-1) :: comp_nonrec new_env sz (i-1) rem) and comp_rec new_env sz i = function | [] -> comp_expr new_env body sz (add_pop ndecl cont) - | (id, exp, RHS_block blocksize) :: rem -> + | (id, exp, (RHS_block _ | RHS_floatblock _)) :: rem -> comp_expr new_env exp sz (Kpush :: Kacc i :: Kccall("caml_update_dummy", 2) :: comp_rec new_env sz (i-1) rem) @@ -570,10 +596,10 @@ let rec comp_expr env exp sz cont = comp_args env args sz (comp_primitive p args :: cont) | Lprim(p, args) -> comp_args env args sz (comp_primitive p args :: cont) - | Lstaticcatch (body, (i, vars) , handler) -> + | Lstaticcatch (body, (i, vars) , handler) -> let nvars = List.length vars in let branch1, cont1 = make_branch cont in - let r = + let r = if nvars <> 1 then begin (* general case *) let lbl_handler, cont2 = label_code @@ -612,8 +638,8 @@ let rec comp_expr env exp sz cont = | Ltrywith(body, id, handler) -> let (branch1, cont1) = make_branch cont in let lbl_handler = new_label() in - Kpushtrap lbl_handler :: - comp_expr env body (sz+4) (Kpoptrap :: branch1 :: + Kpushtrap lbl_handler :: + comp_expr env body (sz+4) (Kpoptrap :: branch1 :: Klabel lbl_handler :: Kpush :: comp_expr (add_var id (sz+1) env) handler (sz+1) (add_pop 1 cont1)) | Lifthenelse(cond, ifso, ifnot) -> @@ -643,7 +669,7 @@ let rec comp_expr env exp sz cont = | Lswitch(arg, sw) -> let (branch, cont1) = make_branch cont in let c = ref (discard_dead_code cont1) in -(* Build indirection vectors *) +(* Build indirection vectors *) let store = mk_store Lambda.same in let act_consts = Array.create sw.sw_numconsts 0 and act_blocks = Array.create sw.sw_numblocks 0 in @@ -841,4 +867,3 @@ let compile_phrase expr = let init_code = comp_block empty_env expr 1 [Kreturn 1] in let fun_code = comp_remainder [] in (init_code, fun_code) - diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 8b47cd4f2..b66378c9e 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -28,6 +28,7 @@ type primitive = | Psetfield of int * bool | Pfloatfield of int | Psetfloatfield of int + | Pduprecord of Types.record_representation * int (* External call *) | Pccall of Primitive.description (* Exceptions *) @@ -251,7 +252,7 @@ let rec iter f = function | Lprim(p, args) -> List.iter f args | Lswitch(arg, sw) -> - f arg; + f arg; List.iter (fun (key, case) -> f case) sw.sw_consts; List.iter (fun (key, case) -> f case) sw.sw_blocks; begin match sw.sw_failaction with diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index fb02042f3..6a9c75fd8 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -28,6 +28,7 @@ type primitive = | Psetfield of int * bool | Pfloatfield of int | Psetfloatfield of int + | Pduprecord of Types.record_representation * int (* External call *) | Pccall of Primitive.description (* Exceptions *) @@ -96,7 +97,7 @@ and bigarray_kind = | Pbigarray_float32 | Pbigarray_float64 | Pbigarray_sint8 | Pbigarray_uint8 | Pbigarray_sint16 | Pbigarray_uint16 - | Pbigarray_int32 | Pbigarray_int64 + | Pbigarray_int32 | Pbigarray_int64 | Pbigarray_caml_int | Pbigarray_native_int | Pbigarray_complex32 | Pbigarray_complex64 diff --git a/bytecomp/printlambda.ml b/bytecomp/printlambda.ml index 27c0ff3d5..3f42f7e1e 100644 --- a/bytecomp/printlambda.ml +++ b/bytecomp/printlambda.ml @@ -83,6 +83,12 @@ let print_bigarray name kind ppf layout = | Pbigarray_c_layout -> "C" | Pbigarray_fortran_layout -> "Fortran") +let record_rep ppf r = + match r with + | Record_regular -> fprintf ppf "regular" + | Record_float -> fprintf ppf "float" +;; + let primitive ppf = function | Pidentity -> fprintf ppf "id" | Pignore -> fprintf ppf "ignore" @@ -96,6 +102,7 @@ let primitive ppf = function fprintf ppf "%s%i" instr n | Pfloatfield n -> fprintf ppf "floatfield %i" n | Psetfloatfield n -> fprintf ppf "setfloatfield %i" n + | Pduprecord (rep, size) -> fprintf ppf "duprecord %a %i" record_rep rep size | Pccall p -> fprintf ppf "%s" p.prim_name | Praise -> fprintf ppf "raise" | Psequand -> fprintf ppf "&&" @@ -239,7 +246,7 @@ let rec lam ppf = function if !spc then fprintf ppf "@ " else spc := true; fprintf ppf "@[default:@ %a@]" lam l end in - + fprintf ppf "@[<1>(%s %a@ @[%a@])@]" (match sw.sw_failaction with None -> "switch*" | _ -> "switch") diff --git a/bytecomp/translcore.ml b/bytecomp/translcore.ml index 439c157ce..be60ef5bb 100644 --- a/bytecomp/translcore.ml +++ b/bytecomp/translcore.ml @@ -368,6 +368,7 @@ let check_recursive_lambda idlist lam = List.for_all (check idlist) args | Lprim(Pmakearray(Paddrarray|Pintarray), args) -> List.for_all (check idlist) args + | Lprim (Pmakearray (Pgenarray), args) -> false | Lsequence (lam1, lam2) -> check idlist lam1 && check idlist lam2 | Levent (lam, _) -> check idlist lam | lam -> @@ -385,9 +386,10 @@ let check_recursive_lambda idlist lam = bindings idlist (* reverse-engineering the code generated by transl_record case 2 *) + (* If you change this, you probably need to change Bytegen.size_of_lambda. *) and check_recursive_recordwith idlist = function - | Llet (Strict, id1, Lprim (Pccall prim, [e1]), body) -> - prim = prim_obj_dup && check_top idlist e1 + | Llet (Strict, id1, Lprim (Pduprecord _, [e1]), body) -> + check_top idlist e1 && check_recordwith_updates idlist id1 body | _ -> false @@ -491,7 +493,7 @@ let primitive_is_ccall = function (* Determine if a primitive is a Pccall or will be turned later into a C function call that may raise an exception *) | Pccall _ | Pstringrefs | Pstringsets | Parrayrefs _ | Parraysets _ | - Pbigarrayref _ | Pbigarrayset _ -> true + Pbigarrayref _ | Pbigarrayset _ | Pduprecord _ -> true | _ -> false (* Assertions *) @@ -536,15 +538,15 @@ and transl_exp0 e = let public_send = p.prim_name = "%send" in if public_send || p.prim_name = "%sendself" then let kind = if public_send then Public else Self in - let obj = Ident.create "obj" and meth = Ident.create "meth" in - Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, [])) + let obj = Ident.create "obj" and meth = Ident.create "meth" in + Lfunction(Curried, [obj; meth], Lsend(kind, Lvar meth, Lvar obj, [])) else if p.prim_name = "%sendcache" then - let obj = Ident.create "obj" and meth = Ident.create "meth" in + let obj = Ident.create "obj" and meth = Ident.create "meth" in let cache = Ident.create "cache" and pos = Ident.create "pos" in - Lfunction(Curried, [obj; meth; cache; pos], + Lfunction(Curried, [obj; meth; cache; pos], Lsend(Cached, Lvar meth, Lvar obj, [Lvar cache; Lvar pos])) else - transl_primitive p + transl_primitive p | Texp_ident(path, {val_kind = Val_anc _}) -> raise(Error(e.exp_loc, Free_super_var)) | Texp_ident(path, {val_kind = Val_reg | Val_self _}) -> @@ -576,8 +578,8 @@ and transl_exp0 e = || not !Clflags.native_code && p.prim_name = "%sendcache"in if public_send || p.prim_name = "%sendself" then let kind = if public_send then Public else Self in - let obj = List.hd argl in - wrap (Lsend (kind, List.nth argl 1, obj, [])) + let obj = List.hd argl in + wrap (Lsend (kind, List.nth argl 1, obj, [])) else if p.prim_name = "%sendcache" then match argl with [obj; meth; cache; pos] -> wrap (Lsend(Cached, meth, obj, [cache; pos])) @@ -662,7 +664,7 @@ and transl_exp0 e = let cl = List.map extract_constant ll in let master = match kind with - | Paddrarray | Pintarray -> + | Paddrarray | Pintarray -> Lconst(Const_block(0, cl)) | Pfloatarray -> Lconst(Const_float_array(List.map extract_float cl)) @@ -694,11 +696,11 @@ and transl_exp0 e = | Texp_send(expr, met) -> let obj = transl_exp expr in let lam = - match met with + match met with Tmeth_val id -> Lsend (Self, Lvar id, obj, []) | Tmeth_name nm -> let (tag, cache) = Translobj.meth obj nm in - let kind = if cache = [] then Public else Cached in + let kind = if cache = [] then Public else Cached in Lsend (kind, tag, obj, cache) in event_after e lam @@ -856,8 +858,9 @@ and transl_setinstvar self var expr = [self; transl_path var; transl_exp expr]) and transl_record all_labels repres lbl_expr_list opt_init_expr = + let size = Array.length all_labels in (* Determine if there are "enough" new fields *) - if 3 + 2 * List.length lbl_expr_list >= Array.length all_labels + if 3 + 2 * List.length lbl_expr_list >= size then begin (* Allocate new record with given fields (and remaining fields taken from init_expr if any *) @@ -914,7 +917,7 @@ and transl_record all_labels repres lbl_expr_list opt_init_expr = None -> assert false | Some init_expr -> Llet(Strict, copy_id, - Lprim(Pccall prim_obj_dup, [transl_exp init_expr]), + Lprim(Pduprecord (repres, size), [transl_exp init_expr]), List.fold_right update_field lbl_expr_list (Lvar copy_id)) end end diff --git a/byterun/alloc.c b/byterun/alloc.c index 0a1c5499a..cc19698a8 100644 --- a/byterun/alloc.c +++ b/byterun/alloc.c @@ -153,13 +153,34 @@ CAMLprim value caml_alloc_dummy(value size) return caml_alloc (wosize, 0); } +CAMLprim value caml_alloc_dummy_float (value size) +{ + mlsize_t wosize = Int_val(size) * Double_wosize; + + if (wosize == 0) return Atom(0); + return caml_alloc (wosize, 0); +} + CAMLprim value caml_update_dummy(value dummy, value newval) { mlsize_t size, i; + tag_t tag; + size = Wosize_val(newval); + tag = Tag_val (newval); Assert (size == Wosize_val(dummy)); - Tag_val(dummy) = Tag_val(newval); - for (i = 0; i < size; i++) - caml_modify(&Field(dummy, i), Field(newval, i)); + Assert (tag < No_scan_tag || tag == Double_array_tag); + + Tag_val(dummy) = tag; + if (tag == Double_array_tag){ + size = Wosize_val (newval) / Double_wosize; + for (i = 0; i < size; i++){ + Store_double_field (dummy, i, Double_field (newval, i)); + } + }else{ + for (i = 0; i < size; i++){ + caml_modify (&Field(dummy, i), Field(newval, i)); + } + } return Val_unit; } diff --git a/byterun/compare.c b/byterun/compare.c index 3337f77d0..4cd6df29e 100644 --- a/byterun/compare.c +++ b/byterun/compare.c @@ -199,7 +199,10 @@ static intnat compare_val(value v1, value v2, int total) case Custom_tag: { int res; int (*compare)(value v1, value v2) = Custom_ops_val(v1)->compare; - if (compare == NULL) caml_invalid_argument("equal: abstract value"); + if (compare == NULL) { + compare_free_stack(); + caml_invalid_argument("equal: abstract value"); + } caml_compare_unordered = 0; res = Custom_ops_val(v1)->compare(v1, v2); if (caml_compare_unordered && !total) return UNORDERED; diff --git a/byterun/memory.h b/byterun/memory.h index 6c7427ce1..d3962bfa5 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -277,12 +277,14 @@ CAMLextern struct caml__roots_block *caml_local_roots; /* defined in roots.c */ return; \ }while (0) -#define CAMLreturn(result) do{ \ - value caml__temp_result = (result); \ +#define CAMLreturnT(type, result) do{ \ + type caml__temp_result = (result); \ caml_local_roots = caml__frame; \ return (caml__temp_result); \ }while(0) +#define CAMLreturn(result) CAMLreturnT(value, result) + #define CAMLnoreturn ((void) caml__frame) diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h index 3daf35392..ff44b14ce 100644 --- a/byterun/mlvalues.h +++ b/byterun/mlvalues.h @@ -239,7 +239,7 @@ CAMLextern void caml_Store_double_val (value,double); #define Store_double_field(v,i,d) do{ \ mlsize_t caml__temp_i = (i); \ double caml__temp_d = (d); \ - Store_double_val((value)((double *) v + caml__temp_i), caml__temp_d); \ + Store_double_val((value)((double *) (v) + caml__temp_i), caml__temp_d); \ }while(0) /* Custom blocks. They contain a pointer to a "method suite" diff --git a/emacs/caml-types.el b/emacs/caml-types.el index 6bdfba982..74ec5be9e 100644 --- a/emacs/caml-types.el +++ b/emacs/caml-types.el @@ -45,7 +45,7 @@ Their format is: at least two space characters. - in each block, the two positions are respectively the start and the -- end of the range described by the block. + end of the range described by the block. - in a position, the filename is the name of the file, the first num is the line number, the second num is the offset of the beginning of the line, the third num is the offset of the position itself. diff --git a/man/ocamlc.m b/man/ocamlc.m index bc133e76f..eec9cff97 100644 --- a/man/ocamlc.m +++ b/man/ocamlc.m @@ -205,7 +205,7 @@ redirect the standard output of the compiler to a .mli file, and edit that file to remove all declarations of unexported names. .TP -.BI \-I directory +.BI \-I \ directory 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 diff --git a/ocamldoc/odoc_sig.ml b/ocamldoc/odoc_sig.ml index d089a05b1..36b3b1411 100644 --- a/ocamldoc/odoc_sig.ml +++ b/ocamldoc/odoc_sig.ml @@ -181,18 +181,18 @@ module Analyser = (0, acc) | (name, core_type_list, loc) :: [] -> let s = get_string_of_file - loc.Location.loc_end.Lexing.pos_cnum - pos_limit - in + loc.Location.loc_end.Lexing.pos_cnum + pos_limit + in let (len, comment_opt) = My_ir.just_after_special !file_name s in (len, acc @ [ (name, comment_opt) ]) | (name, core_type_list, loc) :: (name2, core_type_list2, loc2) :: q -> - let pos_end_first = loc.Location.loc_end.Lexing.pos_cnum in - let pos_start_second = loc2.Location.loc_start.Lexing.pos_cnum in - let s = get_string_of_file pos_end_first pos_start_second in - let (_,comment_opt) = My_ir.just_after_special !file_name s in - f (acc @ [name, comment_opt]) + let pos_end_first = loc.Location.loc_end.Lexing.pos_cnum in + let pos_start_second = loc2.Location.loc_start.Lexing.pos_cnum in + let s = get_string_of_file pos_end_first pos_start_second in + let (_,comment_opt) = My_ir.just_after_special !file_name s in + f (acc @ [name, comment_opt]) ((name2, core_type_list2, loc2) :: q) in f [] cons_core_type_list_list @@ -531,8 +531,8 @@ module Analyser = ex_args = List.map (Odoc_env.subst_type env) types_excep_decl ; ex_alias = None ; ex_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; - ex_code = - ( + ex_code = + ( if !Odoc_args.keep_code then Some (get_string_of_file pos_start_ele pos_end_ele) else @@ -595,7 +595,7 @@ module Analyser = in (* get the type kind with the associated comments *) let type_kind = get_type_kind new_env name_comment_list sig_type_decl.Types.type_kind in - let loc_start = type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in + let loc_start = type_decl.Parsetree.ptype_loc.Location.loc_start.Lexing.pos_cnum in let new_end = type_decl.Parsetree.ptype_loc.Location.loc_end.Lexing.pos_cnum + maybe_more in (* associate the comments to each constructor and build the [Type.t_type] *) let new_type = @@ -603,12 +603,12 @@ module Analyser = ty_name = Name.concat current_module_name name ; ty_info = assoc_com ; ty_parameters = - List.map2 (fun p (co,cn,_) -> - (Odoc_env.subst_type new_env p, - co, cn) - ) - sig_type_decl.Types.type_params - sig_type_decl.Types.type_variance; + List.map2 (fun p (co,cn,_) -> + (Odoc_env.subst_type new_env p, + co, cn) + ) + sig_type_decl.Types.type_params + sig_type_decl.Types.type_variance; ty_kind = type_kind ; ty_manifest = (match sig_type_decl.Types.type_manifest with @@ -619,12 +619,12 @@ module Analyser = loc_inter = Some (!file_name,loc_start) ; }; ty_code = - ( - if !Odoc_args.keep_code then - Some (get_string_of_file loc_start new_end) - else - None - ) ; + ( + if !Odoc_args.keep_code then + Some (get_string_of_file loc_start new_end) + else + None + ) ; } in let (maybe_more2, info_after_opt) = @@ -662,15 +662,15 @@ module Analyser = raise (Failure (Odoc_messages.module_not_found current_module_name name)) in let module_kind = analyse_module_kind env complete_name module_type sig_module_type in - let code_intf = - if !Odoc_args.keep_code then - let loc = module_type.Parsetree.pmty_loc in - let st = loc.Location.loc_start.Lexing.pos_cnum in - let en = loc.Location.loc_end.Lexing.pos_cnum in - Some (get_string_of_file st en) - else - None - in + let code_intf = + if !Odoc_args.keep_code then + let loc = module_type.Parsetree.pmty_loc in + let st = loc.Location.loc_start.Lexing.pos_cnum in + let en = loc.Location.loc_end.Lexing.pos_cnum in + Some (get_string_of_file st en) + else + None + in let new_module = { m_name = complete_name ; @@ -681,9 +681,9 @@ module Analyser = m_kind = module_kind ; m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; m_top_deps = [] ; - m_code = None ; - m_code_intf = code_intf ; - m_text_only = false ; + m_code = None ; + m_code_intf = code_intf ; + m_text_only = false ; } in let (maybe_more, info_after_opt) = @@ -701,7 +701,7 @@ module Analyser = (maybe_more, new_env2, [ Element_module new_module ]) | Parsetree.Psig_recmodule decls -> - (* we start by extending the environment *) + (* we start by extending the environment *) let new_env = List.fold_left (fun acc_env -> fun (name, _) -> @@ -713,13 +713,13 @@ module Analyser = with Not_found -> raise (Failure (Odoc_messages.module_not_found current_module_name name)) in - match sig_module_type with + match sig_module_type with (* A VOIR : cela peut-il être Tmty_ident ? dans ce cas, on aurait pas la signature *) Types.Tmty_signature s -> - Odoc_env.add_signature e complete_name ~rel: name s - | _ -> - print_DEBUG "not a Tmty_signature"; - e + Odoc_env.add_signature e complete_name ~rel: name s + | _ -> + print_DEBUG "not a Tmty_signature"; + e ) env decls @@ -729,8 +729,8 @@ module Analyser = [] -> (acc_maybe_more, []) | (name, modtype) :: q -> - let complete_name = Name.concat current_module_name name in - let loc_start = modtype.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let complete_name = Name.concat current_module_name name in + let loc_start = modtype.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in let loc_end = modtype.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in let (assoc_com, ele_comments) = if first then @@ -738,7 +738,7 @@ module Analyser = else get_comments_in_module last_pos - loc_start + loc_start in let pos_limit2 = match q with @@ -752,18 +752,18 @@ module Analyser = raise (Failure (Odoc_messages.module_not_found current_module_name name)) in (* associate the comments to each constructor and build the [Type.t_type] *) - let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in - let code_intf = - if !Odoc_args.keep_code then - let loc = modtype.Parsetree.pmty_loc in - let st = loc.Location.loc_start.Lexing.pos_cnum in - let en = loc.Location.loc_end.Lexing.pos_cnum in - Some (get_string_of_file st en) - else - None - in - let new_module = - { + let module_kind = analyse_module_kind new_env complete_name modtype sig_module_type in + let code_intf = + if !Odoc_args.keep_code then + let loc = modtype.Parsetree.pmty_loc in + let st = loc.Location.loc_start.Lexing.pos_cnum in + let en = loc.Location.loc_end.Lexing.pos_cnum in + Some (get_string_of_file st en) + else + None + in + let new_module = + { m_name = complete_name ; m_type = sig_module_type; m_info = assoc_com ; @@ -772,17 +772,17 @@ module Analyser = m_kind = module_kind ; m_loc = { loc_impl = None ; loc_inter = Some (!file_name, pos_start_ele) } ; m_top_deps = [] ; - m_code = None ; - m_code_intf = code_intf ; - m_text_only = false ; - } - in - let (maybe_more, info_after_opt) = - My_ir.just_after_special + m_code = None ; + m_code_intf = code_intf ; + m_text_only = false ; + } + in + let (maybe_more, info_after_opt) = + My_ir.just_after_special !file_name (get_string_of_file loc_end pos_limit2) - in - new_module.m_info <- merge_infos new_module.m_info info_after_opt ; + in + new_module.m_info <- merge_infos new_module.m_info info_after_opt ; let (maybe_more2, eles) = f maybe_more @@ -869,13 +869,13 @@ module Analyser = | Parsetree.Pmty_with (mt, _) -> f mt.Parsetree.pmty_desc in - let name = (f module_type.Parsetree.pmty_desc) in - let full_name = Odoc_env.full_module_or_module_type_name env name in + let name = (f module_type.Parsetree.pmty_desc) in + let full_name = Odoc_env.full_module_or_module_type_name env name in let im = { im_name = full_name ; im_module = None ; - im_info = comment_opt; + im_info = comment_opt; } in (0, env, [ Element_included_module im ]) (* A VOIR : étendre l'environnement ? avec quoi ? *) @@ -1057,28 +1057,28 @@ module Analyser = | Parsetree.Pmty_functor (_,pmodule_type2, module_type2) -> ( - let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in - let mp_type_code = get_string_of_file loc_start loc_end in - print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); + let mp_type_code = get_string_of_file loc_start loc_end in + print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); match sig_module_type with Types.Tmty_functor (ident, param_module_type, body_module_type) -> - let mp_kind = analyse_module_type_kind env - current_module_name pmodule_type2 param_module_type - in + let mp_kind = analyse_module_type_kind env + current_module_name pmodule_type2 param_module_type + in let param = { mp_name = Name.from_ident ident ; mp_type = Odoc_env.subst_module_type env param_module_type ; - mp_type_code = mp_type_code ; - mp_kind = mp_kind ; + mp_type_code = mp_type_code ; + mp_kind = mp_kind ; } in - let k = analyse_module_type_kind env - current_module_name - module_type2 - body_module_type - in + let k = analyse_module_type_kind env + current_module_name + module_type2 + body_module_type + in Module_type_functor (param, k) | _ -> @@ -1100,7 +1100,7 @@ module Analyser = and analyse_module_kind env current_module_name module_type sig_module_type = match module_type.Parsetree.pmty_desc with Parsetree.Pmty_ident longident -> - let k = analyse_module_type_kind env current_module_name module_type sig_module_type in + let k = analyse_module_type_kind env current_module_name module_type sig_module_type in Module_with ( k, "" ) | Parsetree.Pmty_signature signature -> @@ -1124,26 +1124,26 @@ module Analyser = ( match sig_module_type with Types.Tmty_functor (ident, param_module_type, body_module_type) -> - let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in + let loc_start = pmodule_type2.Parsetree.pmty_loc.Location.loc_start.Lexing.pos_cnum in let loc_end = pmodule_type2.Parsetree.pmty_loc.Location.loc_end.Lexing.pos_cnum in - let mp_type_code = get_string_of_file loc_start loc_end in - print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); - let mp_kind = analyse_module_type_kind env - current_module_name pmodule_type2 param_module_type - in + let mp_type_code = get_string_of_file loc_start loc_end in + print_DEBUG (Printf.sprintf "mp_type_code=%s" mp_type_code); + let mp_kind = analyse_module_type_kind env + current_module_name pmodule_type2 param_module_type + in let param = { mp_name = Name.from_ident ident ; mp_type = Odoc_env.subst_module_type env param_module_type ; - mp_type_code = mp_type_code ; - mp_kind = mp_kind ; + mp_type_code = mp_type_code ; + mp_kind = mp_kind ; } in let k = analyse_module_kind env - current_module_name - module_type2 - body_module_type - in + current_module_name + module_type2 + body_module_type + in Module_functor (param, k) | _ -> @@ -1279,7 +1279,7 @@ module Analyser = raise (Failure "analyse_class_type_kind pas de correspondance dans le match") let analyse_signature source_file input_file - (ast : Parsetree.signature) (signat : Types.signature) = + (ast : Parsetree.signature) (signat : Types.signature) = let complete_source_file = try let curdir = Sys.getcwd () in @@ -1301,13 +1301,13 @@ module Analyser = in let (len,info_opt) = My_ir.first_special !file_name !file in let elements = - analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast + analyse_parsetree Odoc_env.empty signat mod_name len (String.length !file) ast in let code_intf = - if !Odoc_args.keep_code then - Some !file - else - None + if !Odoc_args.keep_code then + Some !file + else + None in { m_name = mod_name ; @@ -1318,9 +1318,9 @@ module Analyser = m_kind = Module_struct elements ; m_loc = { loc_impl = None ; loc_inter = Some (!file_name, 0) } ; m_top_deps = [] ; - m_code = None ; - m_code_intf = code_intf ; - m_text_only = false ; + m_code = None ; + m_code_intf = code_intf ; + m_text_only = false ; } end diff --git a/otherlibs/threads/.depend b/otherlibs/threads/.depend index f44a670ea..a1f84d7a2 100644 --- a/otherlibs/threads/.depend +++ b/otherlibs/threads/.depend @@ -22,21 +22,19 @@ scheduler.o: scheduler.c ../../byterun/alloc.h \ ../../byterun/mlvalues.h ../../byterun/memory.h ../../byterun/sys.h \ ../../byterun/misc.h condition.cmi: ./mutex.cmi -thread.cmi: ./unix.cmi -threadUnix.cmi: ./unix.cmi +thread.cmi: ./unix.cmo +threadUnix.cmi: ./unix.cmo condition.cmo: ./thread.cmi ./mutex.cmi condition.cmi condition.cmx: ./thread.cmx ./mutex.cmx condition.cmi event.cmo: ./mutex.cmi ./condition.cmi event.cmi event.cmx: ./mutex.cmx ./condition.cmx event.cmi -marshal.cmo: ./pervasives.cmi marshal.cmi -marshal.cmx: ./pervasives.cmx marshal.cmi +marshal.cmo: ./pervasives.cmo +marshal.cmx: ./pervasives.cmx mutex.cmo: ./thread.cmi mutex.cmi mutex.cmx: ./thread.cmx mutex.cmi -pervasives.cmo: ./unix.cmi pervasives.cmi -pervasives.cmx: ./unix.cmx pervasives.cmi -thread.cmo: ./unix.cmi thread.cmi +pervasives.cmo: ./unix.cmo +pervasives.cmx: ./unix.cmx +thread.cmo: ./unix.cmo thread.cmi thread.cmx: ./unix.cmx thread.cmi -threadUnix.cmo: ./unix.cmi ./thread.cmi threadUnix.cmi +threadUnix.cmo: ./unix.cmo ./thread.cmi threadUnix.cmi threadUnix.cmx: ./unix.cmx ./thread.cmx threadUnix.cmi -unix.cmo: unix.cmi -unix.cmx: unix.cmi diff --git a/otherlibs/unix/.depend b/otherlibs/unix/.depend index d784fe417..972ec7781 100644 --- a/otherlibs/unix/.depend +++ b/otherlibs/unix/.depend @@ -390,6 +390,11 @@ gmtime.o: gmtime.c ../../byterun/mlvalues.h ../../byterun/compatibility.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 unixsupport.h +isatty.o: isatty.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ + ../../byterun/config.h ../../byterun/../config/m.h \ + ../../byterun/../config/s.h ../../byterun/compatibility.h \ + ../../byterun/misc.h ../../byterun/compatibility.h \ + ../../byterun/config.h unixsupport.h itimer.o: itimer.c ../../byterun/mlvalues.h ../../byterun/compatibility.h \ ../../byterun/config.h ../../byterun/../config/m.h \ ../../byterun/../config/s.h ../../byterun/compatibility.h \ diff --git a/otherlibs/unix/ftruncate.c b/otherlibs/unix/ftruncate.c index 6d9ba450b..661640e35 100644 --- a/otherlibs/unix/ftruncate.c +++ b/otherlibs/unix/ftruncate.c @@ -43,4 +43,7 @@ CAMLprim value unix_ftruncate_64(value fd, value len) CAMLprim value unix_ftruncate(value fd, value len) { invalid_argument("ftruncate not implemented"); } +CAMLprim value unix_ftruncate_64(value fd, value len) +{ invalid_argument("ftruncate not implemented"); } + #endif diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c index b7b7a83d4..c23eb47b5 100644 --- a/otherlibs/unix/truncate.c +++ b/otherlibs/unix/truncate.c @@ -43,4 +43,7 @@ CAMLprim value unix_truncate_64(value path, value len) CAMLprim value unix_truncate(value path, value len) { invalid_argument("truncate not implemented"); } +CAMLprim value unix_truncate_64(value path, value len) +{ invalid_argument("truncate not implemented"); } + #endif diff --git a/stdlib/.depend b/stdlib/.depend index 17d09fb18..fd74a0218 100644 --- a/stdlib/.depend +++ b/stdlib/.depend @@ -91,9 +91,9 @@ random.cmo: ./string.cmi ./pervasives.cmi ./nativeint.cmi ./int64.cmi \ random.cmx: ./string.cmx ./pervasives.cmx ./nativeint.cmx ./int64.cmx \ ./int32.cmx ./digest.cmx ./char.cmx ./array.cmx random.cmi scanf.cmo: ./string.cmi ./printf.cmi ./obj.cmi ./list.cmi ./hashtbl.cmi \ - ./buffer.cmi scanf.cmi + ./buffer.cmi ./array.cmi scanf.cmi scanf.cmx: ./string.cmx ./printf.cmx ./obj.cmx ./list.cmx ./hashtbl.cmx \ - ./buffer.cmx scanf.cmi + ./buffer.cmx ./array.cmx scanf.cmi set.cmo: set.cmi set.cmx: set.cmi sort.cmo: ./array.cmi sort.cmi diff --git a/stdlib/random.mli b/stdlib/random.mli index f1d7d5da0..587a78206 100644 --- a/stdlib/random.mli +++ b/stdlib/random.mli @@ -33,7 +33,7 @@ val bits : unit -> int val int : int -> int (** [Random.int bound] returns a random integer between 0 (inclusive) - and [bound] (exclusive). [bound] must be more than 0 and less + and [bound] (exclusive). [bound] must be greater than 0 and less than 2{^30}. *) val int32 : Int32.t -> Int32.t;; diff --git a/tools/.depend b/tools/.depend index 9205cad5b..14bb331e5 100644 --- a/tools/.depend +++ b/tools/.depend @@ -35,14 +35,18 @@ ocamldep.cmx: ../parsing/syntaxerr.cmx ../parsing/parsetree.cmi \ ../parsing/parse.cmx ../utils/misc.cmx ../parsing/longident.cmx \ ../parsing/location.cmx ../parsing/lexer.cmx ./depend.cmx \ ../utils/config.cmx ../utils/clflags.cmx +ocamlmklib.cmo: ./myocamlbuild_config.cmo +ocamlmklib.cmx: ./myocamlbuild_config.cmx ocamlmktop.cmo: ../utils/ccomp.cmi ocamlmktop.cmx: ../utils/ccomp.cmx -ocamlprof.cmo: ../parsing/syntaxerr.cmi ../parsing/parsetree.cmi \ - ../parsing/parse.cmi ../utils/misc.cmi ../parsing/location.cmi \ - ../parsing/lexer.cmi ../utils/config.cmi ../utils/clflags.cmi -ocamlprof.cmx: ../parsing/syntaxerr.cmx ../parsing/parsetree.cmi \ - ../parsing/parse.cmx ../utils/misc.cmx ../parsing/location.cmx \ - ../parsing/lexer.cmx ../utils/config.cmx ../utils/clflags.cmx +ocamlprof.cmo: ../utils/warnings.cmi ../parsing/syntaxerr.cmi \ + ../parsing/parsetree.cmi ../parsing/parse.cmi ../utils/misc.cmi \ + ../parsing/location.cmi ../parsing/lexer.cmi ../utils/config.cmi \ + ../utils/clflags.cmi +ocamlprof.cmx: ../utils/warnings.cmx ../parsing/syntaxerr.cmx \ + ../parsing/parsetree.cmi ../parsing/parse.cmx ../utils/misc.cmx \ + ../parsing/location.cmx ../parsing/lexer.cmx ../utils/config.cmx \ + ../utils/clflags.cmx primreq.cmo: ../utils/config.cmi ../bytecomp/cmo_format.cmi primreq.cmx: ../utils/config.cmx ../bytecomp/cmo_format.cmi profiling.cmo: profiling.cmi diff --git a/tools/make-package-macosx b/tools/make-package-macosx index 0aa76f279..1839c52c6 100755 --- a/tools/make-package-macosx +++ b/tools/make-package-macosx @@ -102,7 +102,7 @@ mkdir -p resources cat >resources/ReadMe.txt < dumpfile := s), " Use as dump file (default ocamlprof.dump)";