HCoop
/
bpt
/
guile.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
* * backtrace.c (scm_display_application): New procedure:
[bpt/guile.git]
/
libguile
/
gsubr.c
diff --git
a/libguile/gsubr.c
b/libguile/gsubr.c
index
4dd37a3
..
b69a6c4
100644
(file)
--- a/
libguile/gsubr.c
+++ b/
libguile/gsubr.c
@@
-43,6
+43,7
@@
#include <stdio.h>
#include "_scm.h"
#include "genio.h"
#include <stdio.h>
#include "_scm.h"
#include "genio.h"
+#include "procprop.h"
#include "gsubr.h"
\f
#include "gsubr.h"
\f
@@
-65,11
+66,9
@@
#define GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1])
#define GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2])
#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;
static SCM f_gsubr_apply;
-#ifdef __STDC__
-SCM
-scm_make_gsubr(char *name, int req, int opt, int rst, SCM (*fcn)())
-#else
+
SCM
scm_make_gsubr(name, req, opt, rst, fcn)
char *name;
SCM
scm_make_gsubr(name, req, opt, rst, fcn)
char *name;
@@
-77,7
+76,6
@@
scm_make_gsubr(name, req, opt, rst, fcn)
int opt;
int rst;
SCM (*fcn)();
int opt;
int rst;
SCM (*fcn)();
-#endif
{
switch GSUBR_MAKTYPE(req, opt, rst) {
case GSUBR_MAKTYPE(0, 0, 0): return scm_make_subr(name, scm_tc7_subr_0, fcn);
{
switch GSUBR_MAKTYPE(req, opt, rst) {
case GSUBR_MAKTYPE(0, 0, 0): return scm_make_subr(name, scm_tc7_subr_0, fcn);
@@
-101,10
+99,14
@@
scm_make_gsubr(name, req, opt, rst, fcn)
tmp = 0;
SCM_NEWCELL(z);
SCM_SUBRF(z) = fcn;
tmp = 0;
SCM_NEWCELL(z);
SCM_SUBRF(z) = fcn;
- SCM_
CAR(z) = tmp + scm_tc7_subr_0
;
+ SCM_
SETCAR (z, tmp + scm_tc7_subr_0)
;
GSUBR_PROC(cclo) = z;
GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
GSUBR_PROC(cclo) = z;
GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
- SCM_CDR(symcell) = cclo;
+ SCM_SETCDR (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;
}
}
@@
-112,14
+114,10
@@
scm_make_gsubr(name, req, opt, rst, fcn)
SCM_PROC(s_gsubr_apply, "gsubr-apply", 0, 0, 1, scm_gsubr_apply);
SCM_PROC(s_gsubr_apply, "gsubr-apply", 0, 0, 1, scm_gsubr_apply);
-#ifdef __STDC__
-SCM
-scm_gsubr_apply(SCM args)
-#else
+
SCM
scm_gsubr_apply(args)
SCM args;
SCM
scm_gsubr_apply(args)
SCM args;
-#endif
{
SCM self = SCM_CAR(args);
SCM (*fcn)() = SCM_SUBRF(GSUBR_PROC(self));
{
SCM self = SCM_CAR(args);
SCM (*fcn)() = SCM_SUBRF(GSUBR_PROC(self));
@@
-182,15
+180,13
@@
gsubr_21l(req1, req2, opt, rst)
#endif
#endif
-#ifdef __STDC__
-void
-scm_init_gsubr(void)
-#else
+
void
scm_init_gsubr()
void
scm_init_gsubr()
-#endif
{
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
scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
#endif
#ifdef GSUBR_TEST
scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
#endif