From 9dd5943c06deae102810328783be7201f7e57999 Mon Sep 17 00:00:00 2001 From: Mikael Djurfeldt Date: Sun, 23 May 1999 09:57:31 +0000 Subject: [PATCH] * smob.c, smob.h (scm_make_smob_type): New interface to smob types (supersedes scm_newsmob). (scm_set_smob_mark, scm_set_smob_free, scm_set_smob_print, scm_set_smob_equalp): New functions. Sets smob functions. (SCM_NEWSMOB): New macro. Creates smob objects. (scm_make_smob): New function. Creates smob objects and mallocates memory. (scm_smob_free, scm_smob_print): Default free and print functions. * markers.c, markers.h: Removed. (Contents moved to smob.c, smob.h.) --- libguile/smob.c | 196 ++++++++++++++++++++++++++++++++++++------------ libguile/smob.h | 52 ++++++++++--- 2 files changed, 190 insertions(+), 58 deletions(-) diff --git a/libguile/smob.c b/libguile/smob.c index 2f40cfc65..6315ab979 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -43,14 +43,15 @@ #include #include "_scm.h" -#include "smob.h" - #include "objects.h" +#include "genio.h" #ifdef HAVE_MALLOC_H #include #endif +#include "smob.h" + /* scm_smobs scm_numsmob @@ -59,30 +60,92 @@ * tags for smobjects (if you know a tag you can get an index and conversely). */ int scm_numsmob; -scm_smobfuns *scm_smobs; +scm_smob_descriptor *scm_smobs; +/* {Mark} + */ + +/* This function is vestigial. It used to be the mark function's + responsibility to set the mark bit on the smob or port, but now the + generic marking routine in gc.c takes care of that, and a zero + pointer for a mark function means "don't bother". So you never + need scm_mark0. + + However, we leave it here because it's harmless to call it, and + people out there have smob code that uses it, and there's no reason + to make their links fail. */ + +SCM +scm_mark0 (ptr) + SCM ptr; +{ + return SCM_BOOL_F; +} + +SCM +scm_markcdr (ptr) + SCM ptr; +{ + return SCM_CDR (ptr); +} + +/* {Free} + */ + +scm_sizet +scm_free0 (ptr) + SCM ptr; +{ + return 0; +} + +scm_sizet +scm_smob_free (SCM obj) +{ + scm_must_free ((char *) SCM_CDR (obj)); + return scm_smobs[SCM_SMOBNUM (obj)].size; +} + +/* {Print} + */ + +int +scm_smob_print (SCM exp, SCM port, scm_print_state *pstate) +{ + int n = SCM_SMOBNUM (exp); + scm_puts ("#<", port); + scm_puts (SCM_SMOBNAME (n), port); + scm_putc (' ', port); + scm_intprint (scm_smobs[n].size ? SCM_CDR (exp) : exp, 16, port); + scm_putc ('>', port); + return 1; +} long -scm_newsmob (smob) - const scm_smobfuns *smob; +scm_make_smob_type (char *name, scm_sizet size) { char *tmp; if (255 <= scm_numsmob) goto smoberr; SCM_DEFER_INTS; - SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_smobs, (1 + scm_numsmob) * sizeof (scm_smobfuns))); + SCM_SYSCALL (tmp = (char *) realloc ((char *) scm_smobs, + (1 + scm_numsmob) + * sizeof (scm_smob_descriptor))); if (tmp) { - scm_smobs = (scm_smobfuns *) tmp; - scm_smobs[scm_numsmob].mark = smob->mark; - scm_smobs[scm_numsmob].free = smob->free; - scm_smobs[scm_numsmob].print = smob->print; - scm_smobs[scm_numsmob].equalp = smob->equalp; + scm_smobs = (scm_smob_descriptor *) tmp; + scm_smobs[scm_numsmob].name = name; + scm_smobs[scm_numsmob].size = size; + scm_smobs[scm_numsmob].mark = 0; + scm_smobs[scm_numsmob].free = (size == 0 ? scm_free0 : scm_smob_free); + scm_smobs[scm_numsmob].print = scm_smob_print; + scm_smobs[scm_numsmob].equalp = 0; scm_numsmob++; } SCM_ALLOW_INTS; if (!tmp) - smoberr:scm_wta (SCM_MAKINUM ((long) scm_numsmob), (char *) SCM_NALLOC, "newsmob"); + smoberr:scm_wta (SCM_MAKINUM ((long) scm_numsmob), + (char *) SCM_NALLOC, "scm_make_smob_type"); /* Make a class object if Goops is present. */ if (scm_smob_class) scm_smob_class[scm_numsmob - 1] @@ -90,6 +153,64 @@ scm_newsmob (smob) return scm_tc7_smob + (scm_numsmob - 1) * 256; } +void +scm_set_smob_mark (long tc, SCM (*mark) (SCM)) +{ + scm_smobs[SCM_TC2SMOBNUM (tc)].mark = mark; +} + +void +scm_set_smob_free (long tc, scm_sizet (*free) (SCM)) +{ + scm_smobs[SCM_TC2SMOBNUM (tc)].free = free; +} + +void +scm_set_smob_print (long tc, int (*print) (SCM, SCM, scm_print_state*)) +{ + scm_smobs[SCM_TC2SMOBNUM (tc)].print = print; +} + +void +scm_set_smob_equalp (long tc, SCM (*equalp) (SCM, SCM)) +{ + scm_smobs[SCM_TC2SMOBNUM (tc)].equalp = equalp; +} + +/* Deprecated function - use scm_make_smob_type instead. */ +long +scm_newsmob (const scm_smobfuns *smob) +{ + long tc = scm_make_smob_type (0, 0); + scm_set_smob_mark (tc, smob->mark); + scm_set_smob_free (tc, smob->free); + scm_set_smob_print (tc, smob->print); + scm_set_smob_equalp (tc, smob->equalp); + return tc; +} + + +SCM +scm_make_smob (long tc) +{ + int n = SCM_TC2SMOBNUM (tc); + scm_sizet size = scm_smobs[n].size; + SCM z; + SCM_NEWCELL (z); + if (size != 0) + { +#if 0 + SCM_ASSERT (scm_smobs[n].mark == 0, + 0, + "forbidden operation for smobs with GC data, use SCM_NEWSMOB", + SCM_SMOBNAME (n)); +#endif + SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n))); + } + SCM_SETCAR (z, tc); + return z; +} + /* {Initialization for i/o types, float, bignum, the type of free cells} */ @@ -108,43 +229,24 @@ freeprint (SCM exp, } -static const scm_smobfuns freecell = -{ - 0, - scm_free0, - freeprint, - 0 -}; - -static const scm_smobfuns flob = -{ - 0, - /*flofree*/ 0, - scm_floprint, - scm_floequal -}; - -static const scm_smobfuns bigob = -{ - 0, - /*bigfree*/ 0, - scm_bigprint, - scm_bigequal -}; - - - - void scm_smob_prehistory () { + long tc; scm_numsmob = 0; - scm_smobs = (scm_smobfuns *) malloc (7 * sizeof (scm_smobfuns)); - - /* WARNING: These scm_newsmob calls must be done in this order */ - scm_newsmob (&freecell); - scm_newsmob (&flob); - scm_newsmob (&bigob); - scm_newsmob (&bigob); /* n.b.: two smobs, one smobfuns */ + scm_smobs = ((scm_smob_descriptor *) + malloc (7 * sizeof (scm_smob_descriptor))); + + /* WARNING: These scm_make_smob_type calls must be done in this order */ + tc = scm_make_smob_type ("free", 0); + scm_set_smob_print (tc, freeprint); + tc = scm_make_smob_type ("flo", 0); /* freed in gc */ + scm_set_smob_print (tc, scm_floprint); + scm_set_smob_equalp (tc, scm_floequal); + tc = scm_make_smob_type ("bigpos", 0); /* freed in gc */ + scm_set_smob_print (tc, scm_bigprint); + scm_set_smob_equalp (tc, scm_bigequal); + tc = scm_make_smob_type ("bigneg", 0); + scm_set_smob_print (tc, scm_bigprint); + scm_set_smob_equalp (tc, scm_bigequal); } - diff --git a/libguile/smob.h b/libguile/smob.h index df3310352..ff294640e 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -47,6 +47,20 @@ #include "libguile/print.h" +/* This is the internal representation of a smob type */ + +typedef struct scm_smob_descriptor +{ + char *name; + scm_sizet size; + SCM (*mark) SCM_P ((SCM)); + scm_sizet (*free) SCM_P ((SCM)); + int (*print) SCM_P ((SCM exp, SCM port, scm_print_state *pstate)); + SCM (*equalp) SCM_P ((SCM, SCM)); +} scm_smob_descriptor; + +/* scm_smobfuns is the argument type for the obsolete function scm_newsmob */ + typedef struct scm_smobfuns { SCM (*mark) SCM_P ((SCM)); @@ -57,24 +71,40 @@ typedef struct scm_smobfuns +#define SCM_NEWSMOB(z, tc, data) \ +{ \ + SCM_NEWCELL (z); \ + SCM_SETCDR (z, data); \ + SCM_SETCAR (z, tc); \ +} \ + +#define SCM_SMOB_DATA(x) SCM_CDR (x) +#define SCM_SET_SMOB_DATA(x, data) SCM_SETCDR (x, data) #define SCM_TC2SMOBNUM(x) (0x0ff & ((x) >> 8)) #define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CAR (x))) -#define SCM_SMOBNAME(smobnum) 0 /* Smobs don't have names yet. */ +#define SCM_SMOBNAME(smobnum) scm_smobs[smobnum].name extern int scm_numsmob; -extern scm_smobfuns *scm_smobs; +extern scm_smob_descriptor *scm_smobs; -/* Everyone who uses smobs needs to print. */ -#include "libguile/ports.h" -#include "libguile/genio.h" +extern SCM scm_mark0 SCM_P ((SCM ptr)); +extern SCM scm_markcdr SCM_P ((SCM ptr)); +extern scm_sizet scm_free0 SCM_P ((SCM ptr)); +extern scm_sizet scm_smob_free (SCM obj); +extern int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate); +extern long scm_make_smob_type (char *name, scm_sizet size); +extern void scm_set_smob_mark (long tc, SCM (*mark) (SCM)); +extern void scm_set_smob_free (long tc, scm_sizet (*free) (SCM)); +extern void scm_set_smob_print (long tc, int (*print) (SCM, + SCM, + scm_print_state*)); +extern void scm_set_smob_equalp (long tc, SCM (*equalp) (SCM, SCM)); +extern SCM scm_make_smob (long tc); +extern void scm_smob_prehistory (void); -/* ... and they all need to GC. */ -#include "libguile/markers.h" - - -extern long scm_newsmob SCM_P ((const scm_smobfuns *smob)); -extern void scm_smob_prehistory SCM_P ((void)); +/* Deprecated function */ +extern long scm_newsmob (const scm_smobfuns *smob); #endif /* SMOBH */ -- 2.20.1