mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

* debug.c (scm_make_iloc): Prefer !SCM_<foo> over SCM_N<foo>.

Browse source 
(scm_memcons, scm_mem_to_proc):  When building lists, prefer
scm_list_<n> over scm_cons[2]?.

(scm_mem_to_proc):  Prefer SCM_CONSP over SCM_NIMP.

(scm_procedure_name):  Use SCM_CADR instead of explicit form.

(debugobj_print):  Coerce scm_intprint arg 1 to long, not int.
Thanks to Rob Browning for the patch (see log entry 2001-09-21) -
for some reason his patch didn't make it into the cvs.
This commit is contained in:
Dirk Herrmann 2001-10-11 22:26:25 +00:00
parent 79d34f68e7
commit 37c56aecf8
2 changed files with 23 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

15
libguile/ChangeLog
View file

@ -1,3 +1,18 @@
2001-10-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
* debug.c (scm_make_iloc): Prefer !SCM_<foo> over SCM_N<foo>.
(scm_memcons, scm_mem_to_proc): When building lists, prefer
scm_list_<n> over scm_cons[2]?.
(scm_mem_to_proc): Prefer SCM_CONSP over SCM_NIMP.
(scm_procedure_name): Use SCM_CADR instead of explicit form.
(debugobj_print): Coerce scm_intprint arg 1 to long, not int.
Thanks to Rob Browning for the patch (see log entry 2001-09-21) -
for some reason his patch didn't make it into the cvs.
2001-10-09 Dirk Herrmann <D.Herrmann@tu-bs.de> 2001-10-09 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (mem2decimal_from_point): Cleaned up the parsing a * numbers.c (mem2decimal_from_point): Cleaned up the parsing a

16
libguile/debug.c
View file

@ -47,6 +47,7 @@
#include "libguile/_scm.h" #include "libguile/_scm.h"
#include "libguile/eval.h" #include "libguile/eval.h"
#include "libguile/list.h"
#include "libguile/stackchk.h" #include "libguile/stackchk.h"
#include "libguile/throw.h" #include "libguile/throw.h"
#include "libguile/macros.h" #include "libguile/macros.h"
@ -251,7 +252,7 @@ SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0,
SCM_VALIDATE_INUM (2,binding); SCM_VALIDATE_INUM (2,binding);
return SCM_PACK (SCM_UNPACK (SCM_ILOC00) return SCM_PACK (SCM_UNPACK (SCM_ILOC00)
+ SCM_IFRINC * SCM_INUM (frame) + SCM_IFRINC * SCM_INUM (frame)
+ (SCM_NFALSEP (cdrp) ? SCM_ICDR : 0) + (!SCM_FALSEP (cdrp) ? SCM_ICDR : 0)
+ SCM_IDINC * SCM_INUM (binding)); + SCM_IDINC * SCM_INUM (binding));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -276,7 +277,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0,
/*fixme* environments may be two different but equal top-level envs */ /*fixme* environments may be two different but equal top-level envs */
if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env) if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env)
SCM_MISC_ERROR ("environment mismatch arg1 <-> arg3", SCM_MISC_ERROR ("environment mismatch arg1 <-> arg3",
scm_cons2 (car, env, SCM_EOL)); scm_list_2 (car, env));
else else
env = SCM_MEMOIZED_ENV (car); env = SCM_MEMOIZED_ENV (car);
car = SCM_MEMOIZED_EXP (car); car = SCM_MEMOIZED_EXP (car);
@ -285,7 +286,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0,
{ {
if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env) if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env)
SCM_MISC_ERROR ("environment mismatch arg2 <-> arg3", SCM_MISC_ERROR ("environment mismatch arg2 <-> arg3",
scm_cons2 (cdr, env, SCM_EOL)); scm_list_2 (cdr, env));
else else
env = SCM_MEMOIZED_ENV (cdr); env = SCM_MEMOIZED_ENV (cdr);
cdr = SCM_MEMOIZED_EXP (cdr); cdr = SCM_MEMOIZED_EXP (cdr);
@ -308,9 +309,8 @@ SCM_DEFINE (scm_mem_to_proc, "mem->proc", 1, 0, 0,
SCM_VALIDATE_MEMOIZED (1,obj); SCM_VALIDATE_MEMOIZED (1,obj);
env = SCM_MEMOIZED_ENV (obj); env = SCM_MEMOIZED_ENV (obj);
obj = SCM_MEMOIZED_EXP (obj); obj = SCM_MEMOIZED_EXP (obj);
if (!(SCM_NIMP (obj) && SCM_CAR (obj) == SCM_IM_LAMBDA)) if (!SCM_CONSP (obj) || !SCM_EQ_P (CAR (obj), SCM_IM_LAMBDA))
SCM_MISC_ERROR ("expected lambda expression", SCM_MISC_ERROR ("expected lambda expression", scm_list_1 (obj));
scm_cons (obj, SCM_EOL));
return scm_closure (SCM_CDR (obj), env); return scm_closure (SCM_CDR (obj), env);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -362,7 +362,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
SCM name = scm_procedure_property (proc, scm_sym_name); SCM name = scm_procedure_property (proc, scm_sym_name);
#if 0 #if 0
/* Source property scm_sym_procname not implemented yet... */ /* Source property scm_sym_procname not implemented yet... */
SCM name = scm_source_property (SCM_CAR (SCM_CDR (SCM_CODE (proc))), scm_sym_procname); SCM name = scm_source_property (SCM_CADR (SCM_CODE (proc)), scm_sym_procname);
if (SCM_FALSEP (name)) if (SCM_FALSEP (name))
name = scm_procedure_property (proc, scm_sym_name); name = scm_procedure_property (proc, scm_sym_name);
#endif #endif
@ -521,7 +521,7 @@ static int
debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED) debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED)
{ {
scm_puts ("#<debug-object ", port); scm_puts ("#<debug-object ", port);
scm_intprint ((int) SCM_DEBUGOBJ_FRAME (obj), 16, port); scm_intprint ((long) SCM_DEBUGOBJ_FRAME (obj), 16, port);
scm_putc ('>', port); scm_putc ('>', port);
return 1; return 1;
} }