From: Samuel Mimram Date: Sun, 11 Dec 2005 19:00:46 +0000 (+0000) Subject: Added a patch to correct cduce's bug. X-Git-Tag: archive/raspbian/4.08.1-4+rpi1~3^2~687 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=4c13dd0042fbd997fa399831c73d4c9ee5b0aebd;p=ocaml.git Added a patch to correct cduce's bug. --- diff --git a/debian/changelog b/debian/changelog index 2bdf8a4a..a030a5c3 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,9 +1,14 @@ 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 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 Sun, 11 Dec 2005 19:13:13 +0100 ocaml (3.09.0-3) unstable; urgency=low diff --git a/debian/control b/debian/control index bacdb86b..a61fedb7 100644 --- a/debian/control +++ b/debian/control @@ -2,7 +2,7 @@ Source: ocaml Section: devel Priority: optional Maintainer: Debian OCaml Maintainers -Uploaders: Sven Luther , Stefano Zacchiroli , Julien Cristau +Uploaders: Sven Luther , Stefano Zacchiroli , Julien Cristau , Samuel Mimram Build-Depends: debhelper (>> 4.0.2), tcl8.4-dev, tk8.4-dev, libncurses5-dev, libgdbm-dev, dpatch, bzip2, chrpath Standards-Version: 3.6.2 diff --git a/debian/patches/00list b/debian/patches/00list index de6b7552..3f494358 100644 --- a/debian/patches/00list +++ b/debian/patches/00list @@ -3,3 +3,4 @@ objinfo man-ocamlmklib kbsd-gnu alpha_ld_no-relax +for_pack_static diff --git a/debian/patches/for_pack_static.dpatch b/debian/patches/for_pack_static.dpatch new file mode 100755 index 00000000..ba60467c --- /dev/null +++ b/debian/patches/for_pack_static.dpatch @@ -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. + +@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