*** empty log message ***

[bpt/guile.git] / libguile / smob.c

diff --git a/libguile/smob.c b/libguile/smob.c
index 6315ab9..83442c8 100644 (file)
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1998 Free Software Foundation, Inc.
+/*     Copyright (C) 1995, 1996, 1998, 1999 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -38,13 +38,16 @@
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.  */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
 \f
 
 #include <stdio.h>
 #include "_scm.h"
 
 #include "objects.h"
-#include "genio.h"
 
 #ifdef HAVE_MALLOC_H
 #include <malloc.h>
@@ -76,15 +79,13 @@ scm_smob_descriptor *scm_smobs;
    to make their links fail.  */
 
 SCM 
-scm_mark0 (ptr)
-     SCM ptr;
+scm_mark0 (SCM ptr)
 {
   return SCM_BOOL_F;
 }
 
 SCM 
-scm_markcdr (ptr)
-     SCM ptr;
+scm_markcdr (SCM ptr)
 {
   return SCM_CDR (ptr);
 }
@@ -93,8 +94,7 @@ scm_markcdr (ptr)
  */
 
 scm_sizet 
-scm_free0 (ptr)
-     SCM ptr;
+scm_free0 (SCM ptr)
 {
   return 0;
 }
@@ -114,7 +114,7 @@ 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_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
   scm_putc (' ', port);
   scm_intprint (scm_smobs[n].size ? SCM_CDR (exp) : exp, 16, port);
   scm_putc ('>', port);
@@ -153,6 +153,18 @@ scm_make_smob_type (char *name, scm_sizet size)
   return scm_tc7_smob + (scm_numsmob - 1) * 256;
 }
 
+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))
+{
+  long answer = scm_make_smob_type (name, size);
+  scm_set_smob_mfpe (answer, mark, free, print, equalp);
+  return answer;
+}
+
 void
 scm_set_smob_mark (long tc, SCM (*mark) (SCM))
 {
@@ -177,7 +189,21 @@ 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. */
+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))
+{
+  if (mark) scm_set_smob_mark (tc, mark);
+  if (free) scm_set_smob_free (tc, free);
+  if (print) scm_set_smob_print (tc, print);
+  if (equalp) scm_set_smob_equalp (tc, equalp);
+}
+
+/* Deprecated function - use scm_make_smob_type, or scm_make_smob_type_mfpe
+   instead. */
 long 
 scm_newsmob (const scm_smobfuns *smob)
 {
@@ -232,21 +258,22 @@ freeprint (SCM exp,
 void
 scm_smob_prehistory ()
 {
-  long tc;
   scm_numsmob = 0;
   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);
+  scm_make_smob_type_mfpe ("free", 0,
+                          NULL, NULL, freeprint, NULL);
+
+  scm_make_smob_type_mfpe ("flo", 0,    /* freed in gc */
+                          NULL, NULL, scm_floprint, scm_floequal);
+
+  scm_make_smob_type_mfpe ("bigpos", 0,     /* freed in gc */
+                          NULL, NULL, scm_bigprint, scm_bigequal);
+
+  scm_make_smob_type_mfpe ("bigneg", 0,
+                          NULL, NULL, scm_bigprint, scm_bigequal);
+
+  scm_make_smob_type("allocated", 0);
 }