diff options
| author | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-04 15:26:15 +0000 |
|---|---|---|
| committer | bstarynk <bstarynk@138bc75d-0d04-0410-961f-82ee72b054a4> | 2013-01-04 15:26:15 +0000 |
| commit | 5ce83a5981fcbc23147441444c8d25c99b86d621 (patch) | |
| tree | 666f5c3bcb642148d5e5e2303684d9cb7fe77c21 /gcc | |
| parent | 214836396bf46677219b5999d41c87e4a175616c (diff) | |
| download | gcc-5ce83a5981fcbc23147441444c8d25c99b86d621.tar.gz | |
2013-01-04 Basile Starynkevitch <basile@starynkevitch.net>
* melt/warmelt-normal.melt (normalize_tuple): Better debug.
Use foreach_in_list, not list_every.
* melt/warmelt-outobj.melt (outpucod_objchecksignal): Use
output_raw_location.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@194908 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ChangeLog.MELT | 8 | ||||
| -rw-r--r-- | gcc/melt/warmelt-normal.melt | 25 | ||||
| -rw-r--r-- | gcc/melt/warmelt-outobj.melt | 6 |
3 files changed, 26 insertions, 13 deletions
diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT index 1f2c941772e..5e36a599c03 100644 --- a/gcc/ChangeLog.MELT +++ b/gcc/ChangeLog.MELT @@ -1,6 +1,14 @@ 2013-01-04 Basile Starynkevitch <basile@starynkevitch.net> + + * melt/warmelt-normal.melt (normalize_tuple): Better debug. + Use foreach_in_list, not list_every. + + * melt/warmelt-outobj.melt (outpucod_objchecksignal): Use + output_raw_location. + +2013-01-04 Basile Starynkevitch <basile@starynkevitch.net> * testsuite/melt/tmatch-tuple.melt: Uopdate comment giving command. Use matchalt. diff --git a/gcc/melt/warmelt-normal.melt b/gcc/melt/warmelt-normal.melt index 9089da7c1ff..ad0fad2b315 100644 --- a/gcc/melt/warmelt-normal.melt +++ b/gcc/melt/warmelt-normal.melt @@ -1,7 +1,7 @@ ;; file warmelt-normal.melt -*- Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (comment "*** - Copyright 2008 - 2012 Free Software Foundation, Inc. + Copyright 2008 - 2013 Free Software Foundation, Inc. Contributed by Basile Starynkevitch <basile@starynkevitch.net> This file is part of GCC. @@ -1200,7 +1200,7 @@ routine procedures.}# ;;; normalize a tuple - returning a tuple & a bindinglist (defun normalize_tuple (tup env ncx psloc) - (debug "normalize_tuple tup=" tup " psloc=" psloc) + (debug "normalize_tuple start tup=" tup " psloc=" psloc) (shortbacktrace_dbg "normalize_tuple" 8) (assert_msg "check env" (is_a env class_environment)) (assert_msg "check nctxt" (is_a ncx class_normalization_context)) @@ -1210,21 +1210,24 @@ routine procedures.}# (res (multiple_map tup (lambda (comp :long ix) - (debug "normalize_tuple comp=" comp " ix=" ix) + (debug "normalize_tuple/lambda comp=" comp " ix=" ix) (multicall (norcomp nbinds) (normal_exp comp env ncx psloc) - (debug "normalize_tuple norcomp=" norcomp " nbinds=" nbinds " for comp=" comp " ix=" ix) + (debug "normalize_tuple/lambda norcomp=" norcomp + "\n* nbinds=" nbinds + "\n* for comp=" comp + "\n ix=" ix) (assert_msg "check nbinds" (is_list_or_null nbinds)) (assert_msg "check norcomp not nrep_expr" (is_not_a norcomp class_nrep_expression)) (if (is_list nbinds) - (list_every - nbinds - (lambda (bnd) - (assert_msg "check bnd" (is_a bnd class_any_binding)) - (assert_msg "check bindlist" (is_list bindlist)) - (list_append bindlist bnd) - )) + (foreach_in_list + (nbinds) + (curpair bnd) + (assert_msg "check bnd" (is_a bnd class_any_binding)) + (assert_msg "check bindlist" (is_list bindlist)) + (list_append bindlist bnd) + ) ) norcomp )))) diff --git a/gcc/melt/warmelt-outobj.melt b/gcc/melt/warmelt-outobj.melt index d493cd7022e..96cad5bcc0c 100644 --- a/gcc/melt/warmelt-outobj.melt +++ b/gcc/melt/warmelt-outobj.melt @@ -1,7 +1,7 @@ ;; file warmelt-outobj.melt -*- Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (comment "*** - Copyright (C) 2008 - 2012 Free Software Foundation, Inc. + Copyright (C) 2008 - 2013 Free Software Foundation, Inc. Contributed by Basile Starynkevitch <basile@starynkevitch.net> This file is part of GCC. @@ -2625,7 +2625,9 @@ meltmarking_$ONAME (struct melt_callframe_st*fp, int marking) { (assert_msg "check ochi" (is_a obchi class_objchecksignal)) (let ( (oloc (unsafe_get_field :obi_loc obchi)) ) - (if oloc (output_location oloc implbuf depth "checksignal")) + ;; We use output_raw_location because out_location would pollute + ;; too much the callstack. + (if oloc (output_raw_location oloc implbuf depth "checksignal")) (add2out implbuf " MELT_CHECK_SIGNAL();") (add2sbuf_indentnl implbuf depth) )) |