mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

* Don't use string or vector macros when accessing compiled closures.

Browse source
This commit is contained in:
Dirk Herrmann 2000-09-26 20:11:22 +00:00
parent 9eb364fccb
commit 74cc85038e
5 changed files with 42 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/ChangeLog
View file

@ -1,3 +1,19 @@
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> 2000-09-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (scm_adjbig): Use SCM_BDIGITS instead of SCM_CHARS. * numbers.c (scm_adjbig): Use SCM_BDIGITS instead of SCM_CHARS.

4
libguile/gsubr.c
View file

@ -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); fputs("ERROR in scm_make_gsubr: too many args\n", stderr);
exit (1); exit (1);
} }
SCM_GSUBR_PROC (cclo) = scm_make_subr_opt (name, scm_tc7_subr_0, fcn, 0); SCM_SET_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_TYPE (cclo, SCM_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt, rst)));
SCM_SETCDR (symcell, cclo); SCM_SETCDR (symcell, cclo);
#ifdef DEBUG_EXTENSIONS #ifdef DEBUG_EXTENSIONS
if (SCM_REC_PROCNAMES_P) if (SCM_REC_PROCNAMES_P)

6
libguile/gsubr.h
View file

@ -54,8 +54,10 @@
#define SCM_GSUBR_REST(x) ((int)(x)>>8) #define SCM_GSUBR_REST(x) ((int)(x)>>8)
#define SCM_GSUBR_MAX 10 #define SCM_GSUBR_MAX 10
#define SCM_GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1]) #define SCM_GSUBR_TYPE(cclo) (SCM_CCLO_REF ((cclo), 1))
#define SCM_GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2]) #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; extern SCM scm_f_gsubr_apply;

14
libguile/procs.c
View file

@ -153,14 +153,18 @@ scm_mark_subr_table ()
SCM SCM
scm_makcclo (SCM proc, long len) 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; SCM s;
for (i = 0; i < len; ++i)
base [i] = SCM_UNPACK (SCM_UNSPECIFIED);
SCM_NEWCELL (s); SCM_NEWCELL (s);
SCM_DEFER_INTS; SCM_DEFER_INTS;
SCM_SETCHARS (s, scm_must_malloc (len * sizeof (SCM), "compiled-closure")); SCM_SET_CCLO_BASE (s, base);
SCM_SETLENGTH (s, len, scm_tc7_cclo); SCM_SET_CCLO_LENGTH (s, len);
while (--len) SCM_SET_CCLO_SUBR (s, proc);
SCM_VELTS (s)[len] = SCM_UNSPECIFIED;
SCM_CCLO_SUBR (s) = proc;
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return s; return s;
} }

12
libguile/procs.h
View file

@ -74,7 +74,17 @@ typedef struct
#define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x)) #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_SET_SUBRF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
#define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x)) #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_GENERIC(x) (SCM_SUBR_ENTRY (x).generic)
#define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties) #define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties)