diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-09-26 20:11:22 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-09-26 20:11:22 +0000 |
commit | 74cc85038e5685aa7f9e81e0a9004b0717fb22a5 (patch) | |
tree | 8e7c69e7945286e9e7a65a473fb71fb50799fcf3 | |
parent | 9eb364fccba89d07f1063d373df1aff911288e83 (diff) | |
download | guile-74cc85038e5685aa7f9e81e0a9004b0717fb22a5.tar.gz |
* Don't use string or vector macros when accessing compiled closures.
-rw-r--r-- | libguile/ChangeLog | 16 | ||||
-rw-r--r-- | libguile/gsubr.c | 4 | ||||
-rw-r--r-- | libguile/gsubr.h | 6 | ||||
-rw-r--r-- | libguile/procs.c | 14 | ||||
-rw-r--r-- | libguile/procs.h | 12 |
5 files changed, 42 insertions, 10 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 4f61dbcce..59e083f2e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,21 @@ 2000-09-26 Dirk Herrmann <D.Herrmann@tu-bs.de> + * procs.h (SCM_CCLO_LENGTH, SCM_SET_CCLO_LENGTH, SCM_CCLO_BASE, + SCM_SET_CCLO_BASE, SCM_CCLO_REF, SCM_CCLO_SET, SCM_CCLO_SUBR, + SCM_SET_CCLO_SUBR): Added resp. changed such that none of the + macros SCM_CHARS, SCM_SETCHARS, SCM_VELTS and SCM_LENGTH have to + be used with compiled closures any more. + + * procs.c (scm_makcclo), gsubr.h (SCM_GSUBR_TYPE, SCM_GSUBR_PROC): + Replace uses of SCM_CHARS, SCM_SETCHARS and SCM_VELTS with regards + to compiled closures. + + * gsubr.h (SCM_SET_GSUBR_TYPE, SCM_SET_GSUBR_PROC): Added. + + * gsubr.c (scm_make_gsubr): Use them. + +2000-09-26 Dirk Herrmann <D.Herrmann@tu-bs.de> + * numbers.c (scm_adjbig): Use SCM_BDIGITS instead of SCM_CHARS. (big2str, scm_bigprint): Use SCM_STRING_CHARS instead of diff --git a/libguile/gsubr.c b/libguile/gsubr.c index 3b77dee1b..cccbabc29 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -83,8 +83,8 @@ scm_make_gsubr(const char *name,int req,int opt,int rst,SCM (*fcn)()) fputs("ERROR in scm_make_gsubr: too many args\n", stderr); exit (1); } - SCM_GSUBR_PROC (cclo) = scm_make_subr_opt (name, scm_tc7_subr_0, fcn, 0); - SCM_GSUBR_TYPE (cclo) = SCM_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt, rst)); + SCM_SET_GSUBR_PROC (cclo, scm_make_subr_opt (name, scm_tc7_subr_0, fcn, 0)); + SCM_SET_GSUBR_TYPE (cclo, SCM_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt, rst))); SCM_SETCDR (symcell, cclo); #ifdef DEBUG_EXTENSIONS if (SCM_REC_PROCNAMES_P) diff --git a/libguile/gsubr.h b/libguile/gsubr.h index be7b4d5af..90153c30a 100644 --- a/libguile/gsubr.h +++ b/libguile/gsubr.h @@ -54,8 +54,10 @@ #define SCM_GSUBR_REST(x) ((int)(x)>>8) #define SCM_GSUBR_MAX 10 -#define SCM_GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1]) -#define SCM_GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2]) +#define SCM_GSUBR_TYPE(cclo) (SCM_CCLO_REF ((cclo), 1)) +#define SCM_SET_GSUBR_TYPE(cclo, type) (SCM_CCLO_SET ((cclo), 1, (type))) +#define SCM_GSUBR_PROC(cclo) (SCM_CCLO_REF ((cclo), 2)) +#define SCM_SET_GSUBR_PROC(cclo, proc) (SCM_CCLO_SET ((cclo), 2, (proc))) extern SCM scm_f_gsubr_apply; diff --git a/libguile/procs.c b/libguile/procs.c index 456cd19f0..f979cd097 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -153,14 +153,18 @@ scm_mark_subr_table () SCM scm_makcclo (SCM proc, long len) { + scm_bits_t *base = scm_must_malloc (len * sizeof (scm_bits_t), "compiled-closure"); + unsigned long i; SCM s; + + for (i = 0; i < len; ++i) + base [i] = SCM_UNPACK (SCM_UNSPECIFIED); + SCM_NEWCELL (s); SCM_DEFER_INTS; - SCM_SETCHARS (s, scm_must_malloc (len * sizeof (SCM), "compiled-closure")); - SCM_SETLENGTH (s, len, scm_tc7_cclo); - while (--len) - SCM_VELTS (s)[len] = SCM_UNSPECIFIED; - SCM_CCLO_SUBR (s) = proc; + SCM_SET_CCLO_BASE (s, base); + SCM_SET_CCLO_LENGTH (s, len); + SCM_SET_CCLO_SUBR (s, proc); SCM_ALLOW_INTS; return s; } diff --git a/libguile/procs.h b/libguile/procs.h index 942385d7d..0a3de0374 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -74,7 +74,17 @@ typedef struct #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x)) #define SCM_SET_SUBRF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x)) -#define SCM_CCLO_SUBR(x) (SCM_VELTS(x)[0]) + +#define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8) +#define SCM_SET_CCLO_LENGTH(x, v) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + scm_tc7_cclo)) +#define SCM_CCLO_BASE(x) ((scm_bits_t *) SCM_CELL_WORD_1 (x)) +#define SCM_SET_CCLO_BASE(x, v) (SCM_SET_CELL_WORD_1 ((x), (v))) + +#define SCM_CCLO_REF(x, i) (SCM_PACK (SCM_CCLO_BASE (x) [i])) +#define SCM_CCLO_SET(x, i, v) (SCM_CCLO_BASE (x) [i] = SCM_UNPACK (v)) + +#define SCM_CCLO_SUBR(x) (SCM_CCLO_REF ((x), 0)) +#define SCM_SET_CCLO_SUBR(x, v) (SCM_CCLO_SET ((x), 0, (v))) #define SCM_SUBR_GENERIC(x) (SCM_SUBR_ENTRY (x).generic) #define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties) |