mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +02:00
* 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.
This commit is contained in:
parent
7439c0b988
commit
abae3119ee
1 changed files with 8 additions and 0 deletions
|
@ -43,6 +43,7 @@
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include "_scm.h"
|
#include "_scm.h"
|
||||||
#include "genio.h"
|
#include "genio.h"
|
||||||
|
#include "procprop.h"
|
||||||
|
|
||||||
#include "gsubr.h"
|
#include "gsubr.h"
|
||||||
|
|
||||||
|
@ -65,6 +66,7 @@
|
||||||
#define GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1])
|
#define GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1])
|
||||||
#define GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2])
|
#define GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2])
|
||||||
|
|
||||||
|
SCM scm_i_name;
|
||||||
static SCM f_gsubr_apply;
|
static SCM f_gsubr_apply;
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
@ -101,6 +103,10 @@ scm_make_gsubr(name, req, opt, rst, fcn)
|
||||||
GSUBR_PROC(cclo) = z;
|
GSUBR_PROC(cclo) = z;
|
||||||
GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
|
GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
|
||||||
SCM_CDR(symcell) = cclo;
|
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;
|
return cclo;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -179,6 +185,8 @@ void
|
||||||
scm_init_gsubr()
|
scm_init_gsubr()
|
||||||
{
|
{
|
||||||
f_gsubr_apply = scm_make_subr(s_gsubr_apply, scm_tc7_lsubr, scm_gsubr_apply);
|
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
|
#ifdef GSUBR_TEST
|
||||||
scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
|
scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
|
||||||
#endif
|
#endif
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue