[Pkg-ocaml-maint-commits] r2280 - in
trunk/packages/ocaml/trunk/debian: . patches
Samuel Mimram
smimram at costa.debian.org
Sun Dec 11 19:00:48 UTC 2005
Author: smimram
Date: 2005-12-11 19:00:46 +0000 (Sun, 11 Dec 2005)
New Revision: 2280
Added:
trunk/packages/ocaml/trunk/debian/patches/for_pack_static.dpatch
Modified:
trunk/packages/ocaml/trunk/debian/changelog
trunk/packages/ocaml/trunk/debian/control
trunk/packages/ocaml/trunk/debian/patches/00list
Log:
Added a patch to correct cduce's bug.
Modified: trunk/packages/ocaml/trunk/debian/changelog
===================================================================
--- trunk/packages/ocaml/trunk/debian/changelog 2005-12-09 20:29:14 UTC (rev 2279)
+++ trunk/packages/ocaml/trunk/debian/changelog 2005-12-11 19:00:46 UTC (rev 2280)
@@ -1,10 +1,15 @@
ocaml (3.09.0-4) UNRELEASED; urgency=low
+ [ Julien Cristau ]
* debian/rules: the abi-sed rule is phony, we don't want to run configure
twice.
- -- Julien Cristau <julien.cristau at ens-lyon.org> Fri, 9 Dec 2005 17:45:16 +0100
+ [ Samuel Mimram ]
+ * Added for_pack_static.dpatch (from CVS) to correct a bug when linking.
+ * Added myself to uploaders.
+ -- Samuel Mimram <smimram at debian.org> Sun, 11 Dec 2005 19:13:13 +0100
+
ocaml (3.09.0-3) unstable; urgency=low
* Fix build on non-native arches which was broken by the changes to
Modified: trunk/packages/ocaml/trunk/debian/control
===================================================================
--- trunk/packages/ocaml/trunk/debian/control 2005-12-09 20:29:14 UTC (rev 2279)
+++ trunk/packages/ocaml/trunk/debian/control 2005-12-11 19:00:46 UTC (rev 2280)
@@ -2,7 +2,7 @@
Section: devel
Priority: optional
Maintainer: Debian OCaml Maintainers <debian-ocaml-maint at lists.debian.org>
-Uploaders: Sven Luther <luther at debian.org>, Stefano Zacchiroli <zack at debian.org>, Julien Cristau <julien.cristau at ens-lyon.org>
+Uploaders: Sven Luther <luther at debian.org>, Stefano Zacchiroli <zack at debian.org>, Julien Cristau <julien.cristau at ens-lyon.org>, Samuel Mimram <smimram at debian.org>
Build-Depends: debhelper (>> 4.0.2), tcl8.4-dev, tk8.4-dev, libncurses5-dev, libgdbm-dev, dpatch, bzip2, chrpath
Standards-Version: 3.6.2
Modified: trunk/packages/ocaml/trunk/debian/patches/00list
===================================================================
--- trunk/packages/ocaml/trunk/debian/patches/00list 2005-12-09 20:29:14 UTC (rev 2279)
+++ trunk/packages/ocaml/trunk/debian/patches/00list 2005-12-11 19:00:46 UTC (rev 2280)
@@ -3,3 +3,4 @@
man-ocamlmklib
kbsd-gnu
alpha_ld_no-relax
+for_pack_static
Added: trunk/packages/ocaml/trunk/debian/patches/for_pack_static.dpatch
===================================================================
--- trunk/packages/ocaml/trunk/debian/patches/for_pack_static.dpatch 2005-12-09 20:29:14 UTC (rev 2279)
+++ trunk/packages/ocaml/trunk/debian/patches/for_pack_static.dpatch 2005-12-11 19:00:46 UTC (rev 2280)
@@ -0,0 +1,407 @@
+#! /bin/sh /usr/share/dpatch/dpatch-run
+## for_pack_static.dpatch by Alain Frisch and Xavier Leroy
+##
+## All lines beginning with `## DP:' are a description of the patch.
+## DP: Crrect interaction between -for-pack and static approximations.
+## DP: See http://caml.inria.fr/mantis/view.php?id=3825.
+
+ at DPATCH@
+diff -urNad ocaml-3.09.0~/asmcomp/closure.ml ocaml-3.09.0/asmcomp/closure.ml
+--- ocaml-3.09.0~/asmcomp/closure.ml 2005-12-11 19:33:52.000000000 +0100
++++ ocaml-3.09.0/asmcomp/closure.ml 2005-12-11 19:34:29.000000000 +0100
+@@ -10,7 +10,7 @@
+ (* *)
+ (***********************************************************************)
+
+-(* $Id: closure.ml,v 1.48 2005/10/24 09:05:27 xleroy Exp $ *)
++(* $Id: closure.ml,v 1.48.2.2 2005/12/11 10:21:12 xleroy Exp $ *)
+
+ (* Introduction of closures, uncurrying, recognition of direct calls *)
+
+@@ -33,9 +33,18 @@
+ let rec build_closure_env env_param pos = function
+ [] -> Tbl.empty
+ | id :: rem ->
+- Tbl.add id (Uprim(Pfield pos, [Uvar env_param]))
++ Tbl.add id (Uprim(Pfield pos, [Uvar env_param]))
+ (build_closure_env env_param (pos+1) rem)
+
++(* Auxiliary for accessing globals. We change the name of the global
++ to the name of the corresponding asm symbol. This is done here
++ and no longer in Cmmgen so that approximations stored in .cmx files
++ contain the right names if the -for-pack option is active. *)
++
++let getglobal id =
++ Uprim(Pgetglobal (Ident.create_persistent (Compilenv.symbol_for_global id)),
++ [])
++
+ (* Check if a variable occurs in a [clambda] term. *)
+
+ let occurs_var var u =
+@@ -62,7 +71,7 @@
+ | Uwhile(cond, body) -> occurs cond || occurs body
+ | Ufor(id, lo, hi, dir, body) -> occurs lo || occurs hi || occurs body
+ | Uassign(id, u) -> id = var || occurs u
+- | Usend(_, met, obj, args) ->
++ | Usend(_, met, obj, args) ->
+ occurs met || occurs obj || List.exists occurs args
+ and occurs_array a =
+ try
+@@ -103,7 +112,7 @@
+ | _ -> 2 (* arithmetic and comparisons *)
+
+ (* Very raw approximation of switch cost *)
+-
++
+ let lambda_smaller lam threshold =
+ let size = ref 0 in
+ let rec lambda_size lam =
+@@ -276,7 +285,7 @@
+ let bindings1 =
+ List.map (fun (id, rhs) -> (id, Ident.rename id, rhs)) bindings in
+ let sb' =
+- List.fold_right
++ List.fold_right
+ (fun (id, id', _) s -> Tbl.add id (Uvar id') s)
+ bindings1 sb in
+ Uletrec(
+@@ -529,7 +538,8 @@
+ end
+ | Lprim(Pgetglobal id, []) as lam ->
+ check_constant_result lam
+- (Uprim(Pgetglobal id, [])) (Compilenv.global_approx id)
++ (getglobal id)
++ (Compilenv.global_approx id)
+ | Lprim(Pmakeblock(tag, mut) as prim, lams) ->
+ let (ulams, approxs) = List.split (List.map (close fenv cenv) lams) in
+ (Uprim(prim, ulams),
+@@ -547,7 +557,7 @@
+ | Lprim(Psetfield(n, _), [Lprim(Pgetglobal id, []); lam]) ->
+ let (ulam, approx) = close fenv cenv lam in
+ (!global_approx).(n) <- approx;
+- (Uprim(Psetfield(n, false), [Uprim(Pgetglobal id, []); ulam]),
++ (Uprim(Psetfield(n, false), [getglobal id; ulam]),
+ Value_unknown)
+ | Lprim(p, args) ->
+ simplif_prim p (close_list_approx fenv cenv args)
+@@ -558,7 +568,7 @@
+ close_switch fenv cenv sw.sw_consts sw.sw_numconsts sw.sw_failaction
+ and block_index, block_actions =
+ close_switch fenv cenv sw.sw_blocks sw.sw_numblocks sw.sw_failaction in
+- (Uswitch(uarg,
++ (Uswitch(uarg,
+ {us_index_consts = const_index;
+ us_actions_consts = const_actions;
+ us_index_blocks = block_index;
+@@ -579,7 +589,7 @@
+ (uarg, Value_constptr n) ->
+ sequence_constant_expr arg uarg
+ (close fenv cenv (if n = 0 then ifnot else ifso))
+- | (uarg, _ ) ->
++ | (uarg, _ ) ->
+ let (uifso, _) = close fenv cenv ifso in
+ let (uifnot, _) = close fenv cenv ifnot in
+ (Uifthenelse(uarg, uifso, uifnot), Value_unknown)
+diff -urNad ocaml-3.09.0~/asmcomp/cmmgen.ml ocaml-3.09.0/asmcomp/cmmgen.ml
+--- ocaml-3.09.0~/asmcomp/cmmgen.ml 2005-08-01 17:51:09.000000000 +0200
++++ ocaml-3.09.0/asmcomp/cmmgen.ml 2005-12-11 19:37:05.000000000 +0100
+@@ -10,7 +10,7 @@
+ (* *)
+ (***********************************************************************)
+
+-(* $Id: cmmgen.ml,v 1.103 2005/08/01 15:51:09 xleroy Exp $ *)
++(* $Id: cmmgen.ml,v 1.103.2.2 2005/12/11 10:21:12 xleroy Exp $ *)
+
+ (* Translation from closed lambda to C-- *)
+
+@@ -27,7 +27,7 @@
+
+ let bind name arg fn =
+ match arg with
+- Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
++ Cvar _ | Cconst_int _ | Cconst_natint _ | Cconst_symbol _
+ | Cconst_pointer _ | Cconst_natpointer _ -> fn arg
+ | _ -> let id = Ident.create name in Clet(id, arg, fn (Cvar id))
+
+@@ -343,7 +343,7 @@
+ [] -> Cvar id
+ | e1::el -> Csequence(set_fn (Cvar id) (Cconst_int idx) e1,
+ fill_fields (idx + 2) el) in
+- Clet(id,
++ Clet(id,
+ Cop(Cextcall("caml_alloc", typ_addr, true),
+ [Cconst_int wordsize; Cconst_int tag]),
+ fill_fields 1 args)
+@@ -423,7 +423,7 @@
+ int_const n
+ | Const_base(Const_char c) ->
+ Cconst_int(((Char.code c) lsl 1) + 1)
+- | Const_pointer n ->
++ | Const_pointer n ->
+ if n <= max_repr_int && n >= min_repr_int
+ then Cconst_pointer((n lsl 1) + 1)
+ else Cconst_natpointer
+@@ -477,7 +477,7 @@
+ when bi = Pint32 && size_int = 8 && not big_endian ->
+ (* Force sign-extension of low 32 bits *)
+ Cop(Casr, [Cop(Clsl, [contents; Cconst_int 32]); Cconst_int 32])
+- | Cop(Calloc, [hdr; ops; contents]) ->
++ | Cop(Calloc, [hdr; ops; contents]) ->
+ contents
+ | _ ->
+ Cop(Cload(if bi = Pint32 then Thirtytwo_signed else Word),
+@@ -645,7 +645,7 @@
+ let lcases = Array.length cases in
+ let new_cases = Array.create lcases 0 in
+ let store = Switch.mk_store (=) in
+-
++
+ for i = 0 to Array.length cases-1 do
+ let act = cases.(i) in
+ let new_act = store.Switch.act_store act in
+@@ -741,7 +741,7 @@
+ Cvar id as e ->
+ if Ident.same id boxed_id then need_boxed := true; e
+ | Clet(id, arg, body) -> Clet(id, subst arg, subst body)
+- | Cassign(id, arg) ->
++ | Cassign(id, arg) ->
+ if Ident.same id boxed_id then begin
+ assigned := true;
+ Cassign(unboxed_id, subst(unbox_fn arg))
+@@ -759,11 +759,11 @@
+ Cswitch(subst arg, index, Array.map subst cases)
+ | Cloop e -> Cloop(subst e)
+ | Ccatch(nfail, ids, e1, e2) -> Ccatch(nfail, ids, subst e1, subst e2)
+- | Cexit (nfail, el) -> Cexit (nfail, List.map subst el)
++ | Cexit (nfail, el) -> Cexit (nfail, List.map subst el)
+ | Ctrywith(e1, id, e2) -> Ctrywith(subst e1, id, subst e2)
+ | e -> e in
+ let res = subst exp in
+- (res, !need_boxed, !assigned)
++ (res, !need_boxed, !assigned)
+
+ (* Translate an expression *)
+
+@@ -820,20 +820,20 @@
+ Cop(Capply typ_addr, cargs)
+ | Usend(kind, met, obj, args) ->
+ let call_met obj args clos =
+- if args = [] then Cop(Capply typ_addr,[get_field clos 0;obj;clos]) else
+- let arity = List.length args + 1 in
++ if args = [] then Cop(Capply typ_addr,[get_field clos 0;obj;clos]) else
++ let arity = List.length args + 1 in
+ let cargs = Cconst_symbol(apply_function arity) :: obj ::
+- (List.map transl args) @ [clos] in
++ (List.map transl args) @ [clos] in
+ Cop(Capply typ_addr, cargs)
+ in
+ bind "obj" (transl obj) (fun obj ->
+- match kind, args with
+- Self, _ ->
++ match kind, args with
++ Self, _ ->
+ bind "met" (lookup_label obj (transl met)) (call_met obj args)
+- | Cached, cache :: pos :: args ->
++ | Cached, cache :: pos :: args ->
+ call_cached_method obj (transl met) (transl cache) (transl pos)
+ (List.map transl args)
+- | _ ->
++ | _ ->
+ bind "met" (lookup_tag obj (transl met)) (call_met obj args))
+ | Ulet(id, exp, body) ->
+ begin match is_unboxed_number exp with
+@@ -853,7 +853,7 @@
+ | Uprim(prim, args) ->
+ begin match (simplif_primitive prim, args) with
+ (Pgetglobal id, []) ->
+- Cconst_symbol (Compilenv.symbol_for_global id)
++ Cconst_symbol (Ident.name id)
+ | (Pmakeblock(tag, mut), []) ->
+ transl_constant(Const_block(tag, []))
+ | (Pmakeblock(tag, mut), args) ->
+@@ -961,7 +961,7 @@
+ (exit_if_false cond (transl ifso) raise_num)
+ (transl ifnot)
+ | Uifthenelse(Uprim(Psequor, _) as cond, ifso, ifnot) ->
+- let raise_num = next_raise_count () in
++ let raise_num = next_raise_count () in
+ make_catch
+ raise_num
+ (exit_if_true cond raise_num (transl ifnot))
+@@ -1007,7 +1007,7 @@
+ (remove_unit(transl body),
+ Clet(id_prev, Cvar id,
+ Csequence
+- (Cassign(id,
++ (Cassign(id,
+ Cop(inc, [Cvar id; Cconst_int 2])),
+ Cifthenelse
+ (Cop(Ccmpi Ceq, [Cvar id_prev; high]),
+@@ -1152,7 +1152,7 @@
+ | Pintcomp cmp ->
+ tag_int(Cop(Ccmpi(transl_comparison cmp), [transl arg1; transl arg2]))
+ | Pisout ->
+- transl_isout (transl arg1) (transl arg2)
++ transl_isout (transl arg1) (transl arg2)
+ (* Float operations *)
+ | Paddfloat ->
+ box_float(Cop(Caddf,
+@@ -1216,7 +1216,7 @@
+ box_float(
+ bind "index" (transl arg2) (fun idx ->
+ bind "arr" (transl arg1) (fun arr ->
+- Csequence(Cop(Ccheckbound,
++ Csequence(Cop(Ccheckbound,
+ [float_array_length(header arr); idx]),
+ unboxed_float_array_ref arr idx))))
+ end
+@@ -1239,7 +1239,7 @@
+ box_int bi (Cop(Csubi,
+ [transl_unbox_int bi arg1; transl_unbox_int bi arg2]))
+ | Pmulbint bi ->
+- box_int bi (Cop(Cmuli,
++ box_int bi (Cop(Cmuli,
+ [transl_unbox_int bi arg1; transl_unbox_int bi arg2]))
+ | Pdivbint bi ->
+ box_int bi (safe_divmod Cdivi
+@@ -1366,7 +1366,7 @@
+
+ and make_catch ncatch body handler = match body with
+ | Cexit (nexit,[]) when nexit=ncatch -> handler
+-| _ -> Ccatch (ncatch, [], body, handler)
++| _ -> Ccatch (ncatch, [], body, handler)
+
+ and make_catch2 mk_body handler = match handler with
+ | Cexit (_,[])|Ctuple []|Cconst_int _|Cconst_pointer _ ->
+@@ -1377,7 +1377,7 @@
+ nfail
+ (mk_body (Cexit (nfail,[])))
+ handler
+-
++
+ and exit_if_true cond nfail otherwise =
+ match cond with
+ | Uconst (Const_pointer 0) -> otherwise
+@@ -1387,14 +1387,14 @@
+ | Uprim(Psequand, _) ->
+ begin match otherwise with
+ | Cexit (raise_num,[]) ->
+- exit_if_false cond (Cexit (nfail,[])) raise_num
++ exit_if_false cond (Cexit (nfail,[])) raise_num
+ | _ ->
+ let raise_num = next_raise_count () in
+ make_catch
+ raise_num
+ (exit_if_false cond (Cexit (nfail,[])) raise_num)
+ otherwise
+- end
++ end
+ | Uprim(Pnot, [arg]) ->
+ exit_if_false arg otherwise nfail
+ | Uifthenelse (cond, ifso, ifnot) ->
+@@ -1444,7 +1444,7 @@
+ | _ ->
+ let n_index = Array.length index in
+ let actions = Array.map transl cases in
+-
++
+ let inters = ref []
+ and this_high = ref (n_index-1)
+ and this_low = ref (n_index-1)
+@@ -1576,17 +1576,17 @@
+ | Const_base(Const_string s) ->
+ let lbl = new_const_label() in
+ (Clabel_address lbl,
+- Cint(string_header (String.length s)) :: Cdefine_label lbl ::
++ Cint(string_header (String.length s)) :: Cdefine_label lbl ::
+ emit_string_constant s cont)
+ | Const_immstring s ->
+ begin try
+- (Clabel_address (Hashtbl.find immstrings s), cont)
++ (Clabel_address (Hashtbl.find immstrings s), cont)
+ with Not_found ->
+- let lbl = new_const_label() in
+- Hashtbl.add immstrings s lbl;
+- (Clabel_address lbl,
+- Cint(string_header (String.length s)) :: Cdefine_label lbl ::
+- emit_string_constant s cont)
++ let lbl = new_const_label() in
++ Hashtbl.add immstrings s lbl;
++ (Clabel_address lbl,
++ Cint(string_header (String.length s)) :: Cdefine_label lbl ::
++ emit_string_constant s cont)
+ end
+ | Const_base(Const_int32 n) ->
+ let lbl = new_const_label() in
+@@ -1733,22 +1733,22 @@
+ (raise_num, [],
+ Cloop
+ (Clet(
+- mi,
+- Cop(Cor,
+- [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi]); Cconst_int 1]);
+- Cconst_int 1]),
+- Csequence(
+- Cifthenelse
+- (Cop (Ccmpi Clt,
+- [tag;
+- Cop(Cload Word,
+- [Cop(Cadda,
+- [meths; lsl_const (Cvar mi) log2_size_addr])])]),
+- Cassign(hi, Cop(Csubi, [Cvar mi; Cconst_int 2])),
+- Cassign(li, Cvar mi)),
+- Cifthenelse
+- (Cop(Ccmpi Cge, [Cvar li; Cvar hi]), Cexit (raise_num, []),
+- Ctuple [])))),
++ mi,
++ Cop(Cor,
++ [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi]); Cconst_int 1]);
++ Cconst_int 1]),
++ Csequence(
++ Cifthenelse
++ (Cop (Ccmpi Clt,
++ [tag;
++ Cop(Cload Word,
++ [Cop(Cadda,
++ [meths; lsl_const (Cvar mi) log2_size_addr])])]),
++ Cassign(hi, Cop(Csubi, [Cvar mi; Cconst_int 2])),
++ Cassign(li, Cvar mi)),
++ Cifthenelse
++ (Cop(Ccmpi Cge, [Cvar li; Cvar hi]), Cexit (raise_num, []),
++ Ctuple [])))),
+ Ctuple []),
+ Clet (
+ tagged, Cop(Cadda, [lsl_const (Cvar li) log2_size_addr;
+@@ -1811,13 +1811,13 @@
+ Clet (
+ cached, Cop(Cand, [Cop(Cload Word, [cache]); mask]),
+ Clet (
+- real,
++ real,
+ Cifthenelse(Cop(Ccmpa Cne, [tag'; tag]),
+- cache_public_method (Cvar meths) tag cache,
++ cache_public_method (Cvar meths) tag cache,
+ cached_pos),
+ Cop(Cload Word, [Cop(Cadda, [Cop (Cadda, [Cvar real; Cvar meths]);
+ Cconst_int(2*size_addr-1)])]))))
+-
++
+ in
+ let body = Clet(clos', clos, body) in
+ let fun_args =
+@@ -1904,13 +1904,13 @@
+ {fun_name = name2;
+ fun_args = [arg, typ_addr; clos, typ_addr];
+ fun_body = Cop(Calloc,
+- [alloc_closure_header 4;
++ [alloc_closure_header 4;
+ Cconst_symbol(name1 ^ "_" ^ string_of_int (num+1));
+ int_const 1; Cvar arg; Cvar clos]);
+ fun_fast = true}
+ :: intermediate_curry_functions arity (num+1)
+ end
+-
++
+ let curry_function arity =
+ if arity >= 0
+ then intermediate_curry_functions arity 0
Property changes on: trunk/packages/ocaml/trunk/debian/patches/for_pack_static.dpatch
___________________________________________________________________
Name: svn:executable
+ *
More information about the Pkg-ocaml-maint-commits
mailing list