diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1996-10-14 20:27:45 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1996-10-14 20:27:45 +0000 |
commit | abae3119eeef16f936aa3c3e7330198e227a604d (patch) | |
tree | 6603aab6a9b5f525d0cad26a4753a10758226675 | |
parent | 7439c0b9882bcd0aa19797480a0cd18af243a160 (diff) | |
download | guile-abae3119eeef16f936aa3c3e7330198e227a604d.tar.gz |
* eval.c: scm_i_name moved to gsubr.c
(scm_m_define): Record names of all kinds of procedure
objects. (Earlier, only closures were recorded.)
* gsubr.c: Added global scm_i_name. Added #include "procprop.h".
(scm_make_gsubr): Record names of compiled closures.
-rw-r--r-- | libguile/gsubr.c | 8 |
1 files changed, 8 insertions, 0 deletions
diff --git a/libguile/gsubr.c b/libguile/gsubr.c index 5032488c7..3a4d21aec 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -43,6 +43,7 @@ #include <stdio.h> #include "_scm.h" #include "genio.h" +#include "procprop.h" #include "gsubr.h" @@ -65,6 +66,7 @@ #define GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1]) #define GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2]) +SCM scm_i_name; static SCM f_gsubr_apply; SCM @@ -101,6 +103,10 @@ scm_make_gsubr(name, req, opt, rst, fcn) GSUBR_PROC(cclo) = z; GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst)); SCM_CDR(symcell) = cclo; +#ifdef DEBUG_EXTENSIONS + if (SCM_REC_PROCNAMES_P) + scm_set_procedure_property_x (cclo, scm_i_name, SCM_CAR (symcell)); +#endif return cclo; } } @@ -179,6 +185,8 @@ void scm_init_gsubr() { f_gsubr_apply = scm_make_subr(s_gsubr_apply, scm_tc7_lsubr, scm_gsubr_apply); + scm_i_name = SCM_CAR (scm_sysintern ("name", SCM_UNDEFINED)); + scm_permanent_object (scm_i_name); #ifdef GSUBR_TEST scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */ #endif |