summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-09-26 20:11:22 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-09-26 20:11:22 +0000
commit74cc85038e5685aa7f9e81e0a9004b0717fb22a5 (patch)
tree8e7c69e7945286e9e7a65a473fb71fb50799fcf3
parent9eb364fccba89d07f1063d373df1aff911288e83 (diff)
downloadguile-74cc85038e5685aa7f9e81e0a9004b0717fb22a5.tar.gz
* Don't use string or vector macros when accessing compiled closures.
-rw-r--r--libguile/ChangeLog16
-rw-r--r--libguile/gsubr.c4
-rw-r--r--libguile/gsubr.h6
-rw-r--r--libguile/procs.c14
-rw-r--r--libguile/procs.h12
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)