scm_sizet (*free) (SCM);
int (*print) (SCM exp, SCM port, scm_print_state *pstate);
SCM (*equalp) (SCM, SCM);
+ SCM (*apply) ();
+ int gsubr_type;
} scm_smob_descriptor;
-/* scm_smobfuns is the argument type for the obsolete function scm_newsmob */
-
-typedef struct scm_smobfuns
-{
- SCM (*mark) (SCM);
- scm_sizet (*free) (SCM);
- int (*print) (SCM exp, SCM port, scm_print_state *pstate);
- SCM (*equalp) (SCM, SCM);
-} scm_smobfuns;
-
\f
#define SCM_NEWSMOB(z, tc, data) \
do { \
SCM_NEWCELL (z); \
- SCM_SETCDR (z, data); \
- SCM_SETCAR (z, tc); \
+ SCM_SET_CELL_WORD_1 ((z), (data)); \
+ SCM_SET_CELL_TYPE ((z), (tc)); \
} while (0)
#define SCM_RETURN_NEWSMOB(tc, data) \
do { SCM __SCM_smob_answer; \
- SCM_NEWSMOB (__SCM_smob_answer, tc, data); \
+ SCM_NEWSMOB (__SCM_smob_answer, (tc), (data)); \
return __SCM_smob_answer; \
} while (0)
#define SCM_NEWSMOB2(z, tc, data1, data2) \
do { \
SCM_NEWCELL2 (z); \
- SCM_SET_CELL_WORD (z, 1, data1); \
- SCM_SET_CELL_WORD (z, 2, data2); \
- SCM_SETCAR (z, tc); \
+ SCM_SET_CELL_WORD_1 ((z), (data1)); \
+ SCM_SET_CELL_WORD_2 ((z), (data2)); \
+ SCM_SET_CELL_TYPE ((z), (tc)); \
} while (0)
#define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
do { SCM __SCM_smob_answer; \
- SCM_NEWSMOB2 (__SCM_smob_answer, tc, data1, data2); \
+ SCM_NEWSMOB2 (__SCM_smob_answer, (tc), (data1), (data2)); \
return __SCM_smob_answer; \
} while (0)
#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
do { \
SCM_NEWCELL2 (z); \
- SCM_SET_CELL_WORD (z, 1, data1); \
- SCM_SET_CELL_WORD (z, 2, data2); \
- SCM_SET_CELL_WORD (z, 3, data3); \
- SCM_SETCAR (z, tc); \
+ SCM_SET_CELL_WORD_1 ((z), (data1)); \
+ SCM_SET_CELL_WORD_2 ((z), (data2)); \
+ SCM_SET_CELL_WORD_3 ((z), (data3)); \
+ SCM_SET_CELL_TYPE ((z), (tc)); \
} while (0)
#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
do { SCM __SCM_smob_answer; \
- SCM_NEWSMOB3 (__SCM_smob_answer, tc, data1, data2, data3); \
+ SCM_NEWSMOB3 (__SCM_smob_answer, (tc), (data1), (data2), (data3)); \
return __SCM_smob_answer; \
} while (0)
-#define SCM_SMOB_DATA(x) SCM_CDR (x)
-#define SCM_SET_SMOB_DATA(x, data) SCM_SETCDR (x, data)
-#define SCM_TC2SMOBNUM(x) (0x0ff & (SCM_UNPACK(x) >> 8))
-#define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CAR (x)))
+#define SCM_SMOB_DATA(x) (SCM_CELL_WORD_1 (x))
+#define SCM_SET_SMOB_DATA(x, data) (SCM_SET_CELL_WORD_1 ((x), (data)))
+#define SCM_TC2SMOBNUM(x) (0x0ff & ((x) >> 8))
+#define SCM_SMOBNUM(x) (SCM_TC2SMOBNUM (SCM_CELL_TYPE (x)))
/* SCM_SMOBNAME can be 0 if name is missing */
-#define SCM_SMOBNAME(smobnum) scm_smobs[smobnum].name
-#define SCM_SMOB_PREDICATE(tag, obj) \
- (SCM_NIMP (obj) && SCM_TYP16 (obj) == (tag))
+#define SCM_SMOBNAME(smobnum) (scm_smobs[smobnum].name)
+#define SCM_SMOB_PREDICATE(tag, obj) (SCM_NIMP (obj) \
+ && SCM_TYP16 (obj) == (tag))
+#define SCM_SMOB_DESCRIPTOR(x) (scm_smobs[SCM_SMOBNUM (x)])
extern int scm_numsmob;
extern scm_smob_descriptor *scm_smobs;
extern scm_sizet scm_smob_free (SCM obj);
extern int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate);
-/* These next two functions are the supported way to create new SMOB types.
-
- scm_make_smob_type is useful if there are no special smob functions
- and the defaults work for mark,free,print,equal_p, or you want to use
- scm_set_smob_{mark,free,print,equalp}, below.
+extern SCM scm_smob_apply_0 (SCM smob);
+extern SCM scm_smob_apply_1 (SCM smob, SCM a1);
+extern SCM scm_smob_apply_2 (SCM smob, SCM a1, SCM a2);
+extern SCM scm_smob_apply_3 (SCM smob, SCM a1, SCM a2, SCM rest);
- scm_make_smob_type_mfpe is ideal if you need to set one or more of
- the special smob functions-- use NULL for when the default function
- is fine
-*/
+/* The following set of functions is the standard way to create new
+ * SMOB types.
+ *
+ * Create a type tag using `scm_make_smob_type', accept default values
+ * for mark, free, print and/or equalp functions, or set your own
+ * values using `scm_set_smob_xxx'.
+ */
extern long scm_make_smob_type (char *name, scm_sizet size);
-extern long scm_make_smob_type_mfpe (char *name, scm_sizet size,
- SCM (*mark) (SCM),
- scm_sizet (*free) (SCM),
- int (*print) (SCM, SCM, scm_print_state*),
- SCM (*equalp) (SCM, SCM));
-
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));
-/* convenience function for registering multiple handler fns */
+extern void scm_set_smob_apply (long tc, SCM (*apply) (), int req, int opt, int rst);
+
+
+/* Functions for registering multiple handler functions simultaneously.
+ *
+ * (There is a discussion among the developers whether or not these
+ * should be deprecated in the future.)
+ */
+
+extern long scm_make_smob_type_mfpe (char *name, scm_sizet size,
+ SCM (*mark) (SCM),
+ scm_sizet (*free) (SCM),
+ int (*print) (SCM, SCM, scm_print_state*),
+ SCM (*equalp) (SCM, SCM));
+
extern void scm_set_smob_mfpe (long tc,
SCM (*mark) (SCM),
scm_sizet (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state*),
SCM (*equalp) (SCM, SCM));
+/* Function for creating smobs */
extern SCM scm_make_smob (long tc);
extern void scm_smob_prehistory (void);
-/* Deprecated function */
-extern long scm_newsmob (const scm_smobfuns *smob);
+\f
#endif /* SMOBH */
HCoop / bpt / guile.git / blobdiff