libguile/smob.c

   1 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21 #ifdef HAVE_CONFIG_H
  22 #  include <config.h>
  23 #endif
  24
  25 #include <stdio.h>
  26 #include <errno.h>
  27
  28 #include "libguile/_scm.h"
  29
  30 #include "libguile/async.h"
  31 #include "libguile/objects.h"
  32 #include "libguile/goops.h"
  33 #include "libguile/ports.h"
  34
  35 #ifdef HAVE_MALLOC_H
  36 #include <malloc.h>
  37 #endif
  38
  39 #include "libguile/smob.h"
  40
  41 #include "libguile/bdw-gc.h"
  42 #include <gc/gc_mark.h>
  43
  44
  45 \f
  46
  47 /* scm_smobs scm_numsmob
  48  * implement a fixed sized array of smob records.
  49  * Indexes into this table are used when generating type
  50  * tags for smobjects (if you know a tag you can get an index and conversely).
  51  */
  52
  53 #define MAX_SMOB_COUNT SCM_I_MAX_SMOB_TYPE_COUNT
  54
  55 long scm_numsmob;
  56 scm_smob_descriptor scm_smobs[MAX_SMOB_COUNT];
  57
  58 /* Lower 16 bit of data must be zero.
  59 */
  60 void
  61 scm_i_set_smob_flags (SCM x, scm_t_bits data)
  62 {
  63   SCM_SET_CELL_WORD_0 (x, (SCM_CELL_WORD_0 (x) & 0xFFFF) | data);
  64 }
  65
  66 void
  67 scm_assert_smob_type (scm_t_bits tag, SCM val)
  68 {
  69   if (!SCM_SMOB_PREDICATE (tag, val))
  70     scm_wrong_type_arg_msg (NULL, 0, val, scm_smobs[SCM_TC2SMOBNUM(tag)].name);
  71 }
  72
  73 /* {Mark}
  74  */
  75
  76 /* This function is vestigial.  It used to be the mark function's
  77    responsibility to set the mark bit on the smob or port, but now the
  78    generic marking routine in gc.c takes care of that, and a zero
  79    pointer for a mark function means "don't bother".  So you never
  80    need scm_mark0.
  81
  82    However, we leave it here because it's harmless to call it, and
  83    people out there have smob code that uses it, and there's no reason
  84    to make their links fail.  */
  85
  86 SCM
  87 scm_mark0 (SCM ptr SCM_UNUSED)
  88 {
  89   return SCM_BOOL_F;
  90 }
  91
  92 SCM
  93 /* Dirk::FIXME: The name markcdr is misleading, since the term cdr should only
  94    be used for real pairs. */
  95 scm_markcdr (SCM ptr)
  96 {
  97   return SCM_CELL_OBJECT_1 (ptr);
  98 }
  99
 100 \f
 101 /* {Free}
 102  */
 103
 104 size_t
 105 scm_free0 (SCM ptr SCM_UNUSED)
 106 {
 107   return 0;
 108 }
 109
 110 \f
 111 /* {Print}
 112  */
 113
 114 int
 115 scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 116 {
 117   long n = SCM_SMOBNUM (exp);
 118   scm_puts ("#<", port);
 119   scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
 120   scm_putc (' ', port);
 121   if (scm_smobs[n].size)
 122     scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
 123   else
 124     scm_uintprint (SCM_UNPACK (exp), 16, port);
 125   scm_putc ('>', port);
 126   return 1;
 127 }
 128
 129 /* {Apply}
 130  */
 131
 132 #define SCM_SMOB_APPLY0(SMOB) \
 133   SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB)
 134 #define SCM_SMOB_APPLY1(SMOB, A1) \
 135   SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1)
 136 #define SCM_SMOB_APPLY2(SMOB, A1, A2) \
 137   SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2)
 138 #define SCM_SMOB_APPLY3(SMOB, A1, A2, A3) \
 139   SCM_SMOB_DESCRIPTOR (SMOB).apply (SMOB, A1, A2, A3)
 140
 141 static SCM
 142 scm_smob_apply_0_010 (SCM smob)
 143 {
 144   return SCM_SMOB_APPLY1 (smob, SCM_UNDEFINED);
 145 }
 146
 147 static SCM
 148 scm_smob_apply_0_020 (SCM smob)
 149 {
 150   return SCM_SMOB_APPLY2 (smob, SCM_UNDEFINED, SCM_UNDEFINED);
 151 }
 152
 153 static SCM
 154 scm_smob_apply_0_030 (SCM smob)
 155 {
 156   return SCM_SMOB_APPLY3 (smob, SCM_UNDEFINED, SCM_UNDEFINED, SCM_UNDEFINED);
 157 }
 158
 159 static SCM
 160 scm_smob_apply_0_001 (SCM smob)
 161 {
 162   return SCM_SMOB_APPLY1 (smob, SCM_EOL);
 163 }
 164
 165 static SCM
 166 scm_smob_apply_0_011 (SCM smob)
 167 {
 168   return SCM_SMOB_APPLY2 (smob, SCM_UNDEFINED, SCM_EOL);
 169 }
 170
 171 static SCM
 172 scm_smob_apply_0_021 (SCM smob)
 173 {
 174   return SCM_SMOB_APPLY3 (smob, SCM_UNDEFINED, SCM_UNDEFINED, SCM_EOL);
 175 }
 176
 177 static SCM
 178 scm_smob_apply_0_error (SCM smob)
 179 {
 180   scm_wrong_num_args (smob);
 181 }
 182
 183 static SCM
 184 scm_smob_apply_1_020 (SCM smob, SCM a1)
 185 {
 186   return SCM_SMOB_APPLY2 (smob, a1, SCM_UNDEFINED);
 187 }
 188
 189 static SCM
 190 scm_smob_apply_1_030 (SCM smob, SCM a1)
 191 {
 192   return SCM_SMOB_APPLY3 (smob, a1, SCM_UNDEFINED, SCM_UNDEFINED);
 193 }
 194
 195 static SCM
 196 scm_smob_apply_1_001 (SCM smob, SCM a1)
 197 {
 198   return SCM_SMOB_APPLY1 (smob, scm_list_1 (a1));
 199 }
 200
 201 static SCM
 202 scm_smob_apply_1_011 (SCM smob, SCM a1)
 203 {
 204   return SCM_SMOB_APPLY2 (smob, a1, SCM_EOL);
 205 }
 206
 207 static SCM
 208 scm_smob_apply_1_021 (SCM smob, SCM a1)
 209 {
 210   return SCM_SMOB_APPLY3 (smob, a1, SCM_UNDEFINED, SCM_EOL);
 211 }
 212
 213 static SCM
 214 scm_smob_apply_1_error (SCM smob, SCM a1 SCM_UNUSED)
 215 {
 216   scm_wrong_num_args (smob);
 217 }
 218
 219 static SCM
 220 scm_smob_apply_2_030 (SCM smob, SCM a1, SCM a2)
 221 {
 222   return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_UNDEFINED);
 223 }
 224
 225 static SCM
 226 scm_smob_apply_2_001 (SCM smob, SCM a1, SCM a2)
 227 {
 228   return SCM_SMOB_APPLY1 (smob, scm_list_2 (a1, a2));
 229 }
 230
 231 static SCM
 232 scm_smob_apply_2_011 (SCM smob, SCM a1, SCM a2)
 233 {
 234   return SCM_SMOB_APPLY2 (smob, a1, scm_list_1 (a2));
 235 }
 236
 237 static SCM
 238 scm_smob_apply_2_021 (SCM smob, SCM a1, SCM a2)
 239 {
 240   return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_EOL);
 241 }
 242
 243 static SCM
 244 scm_smob_apply_2_error (SCM smob, SCM a1 SCM_UNUSED, SCM a2 SCM_UNUSED)
 245 {
 246   scm_wrong_num_args (smob);
 247 }
 248
 249 static SCM
 250 scm_smob_apply_3_030 (SCM smob, SCM a1, SCM a2, SCM rst)
 251 {
 252   if (!scm_is_null (SCM_CDR (rst)))
 253     scm_wrong_num_args (smob);
 254   return SCM_SMOB_APPLY3 (smob, a1, a2, SCM_CAR (rst));
 255 }
 256
 257 static SCM
 258 scm_smob_apply_3_001 (SCM smob, SCM a1, SCM a2, SCM rst)
 259 {
 260   return SCM_SMOB_APPLY1 (smob, scm_cons2 (a1, a2, rst));
 261 }
 262
 263 static SCM
 264 scm_smob_apply_3_011 (SCM smob, SCM a1, SCM a2, SCM rst)
 265 {
 266   return SCM_SMOB_APPLY2 (smob, a1, scm_cons (a2, rst));
 267 }
 268
 269 static SCM
 270 scm_smob_apply_3_021 (SCM smob, SCM a1, SCM a2, SCM rst)
 271 {
 272   return SCM_SMOB_APPLY3 (smob, a1, a2, rst);
 273 }
 274
 275 static SCM
 276 scm_smob_apply_3_error (SCM smob,
 277                         SCM a1 SCM_UNUSED,
 278                         SCM a2 SCM_UNUSED,
 279                         SCM rst SCM_UNUSED)
 280 {
 281   scm_wrong_num_args (smob);
 282 }
 283
 284 \f
 285
 286 scm_t_bits
 287 scm_make_smob_type (char const *name, size_t size)
 288 #define FUNC_NAME "scm_make_smob_type"
 289 {
 290   long new_smob;
 291
 292   SCM_CRITICAL_SECTION_START;
 293   new_smob = scm_numsmob;
 294   if (scm_numsmob != MAX_SMOB_COUNT)
 295     ++scm_numsmob;
 296   SCM_CRITICAL_SECTION_END;
 297
 298   if (new_smob == MAX_SMOB_COUNT)
 299     scm_misc_error (FUNC_NAME, "maximum number of smobs exceeded", SCM_EOL);
 300
 301   scm_smobs[new_smob].name = name;
 302   scm_smobs[new_smob].size = size;
 303
 304   /* Make a class object if Goops is present. */
 305   if (SCM_UNPACK (scm_smob_class[0]) != 0)
 306     scm_smob_class[new_smob] = scm_make_extended_class (name, 0);
 307
 308   return scm_tc7_smob + new_smob * 256;
 309 }
 310 #undef FUNC_NAME
 311
 312
 313 void
 314 scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM))
 315 {
 316   scm_smobs[SCM_TC2SMOBNUM (tc)].mark = mark;
 317 }
 318
 319 void
 320 scm_set_smob_free (scm_t_bits tc, size_t (*free) (SCM))
 321 {
 322   scm_smobs[SCM_TC2SMOBNUM (tc)].free = free;
 323 }
 324
 325 void
 326 scm_set_smob_print (scm_t_bits tc, int (*print) (SCM, SCM, scm_print_state*))
 327 {
 328   scm_smobs[SCM_TC2SMOBNUM (tc)].print = print;
 329 }
 330
 331 void
 332 scm_set_smob_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM))
 333 {
 334   scm_smobs[SCM_TC2SMOBNUM (tc)].equalp = equalp;
 335 }
 336
 337 void
 338 scm_set_smob_apply (scm_t_bits tc, SCM (*apply) (),
 339                     unsigned int req, unsigned int opt, unsigned int rst)
 340 {
 341   SCM (*apply_0) (SCM);
 342   SCM (*apply_1) (SCM, SCM);
 343   SCM (*apply_2) (SCM, SCM, SCM);
 344   SCM (*apply_3) (SCM, SCM, SCM, SCM);
 345   int type = SCM_GSUBR_MAKTYPE (req, opt, rst);
 346
 347   if (rst > 1 || req + opt + rst > 3)
 348     {
 349       puts ("Unsupported smob application type");
 350       abort ();
 351     }
 352
 353   switch (type)
 354     {
 355     case SCM_GSUBR_MAKTYPE (0, 0, 0):
 356       apply_0 = apply; break;
 357     case SCM_GSUBR_MAKTYPE (0, 1, 0):
 358       apply_0 = scm_smob_apply_0_010; break;
 359     case SCM_GSUBR_MAKTYPE (0, 2, 0):
 360       apply_0 = scm_smob_apply_0_020; break;
 361     case SCM_GSUBR_MAKTYPE (0, 3, 0):
 362       apply_0 = scm_smob_apply_0_030; break;
 363     case SCM_GSUBR_MAKTYPE (0, 0, 1):
 364       apply_0 = scm_smob_apply_0_001; break;
 365     case SCM_GSUBR_MAKTYPE (0, 1, 1):
 366       apply_0 = scm_smob_apply_0_011; break;
 367     case SCM_GSUBR_MAKTYPE (0, 2, 1):
 368       apply_0 = scm_smob_apply_0_021; break;
 369     default:
 370       apply_0 = scm_smob_apply_0_error; break;
 371     }
 372
 373   switch (type)
 374     {
 375     case SCM_GSUBR_MAKTYPE (1, 0, 0):
 376     case SCM_GSUBR_MAKTYPE (0, 1, 0):
 377       apply_1 = apply; break;
 378     case SCM_GSUBR_MAKTYPE (1, 1, 0):
 379     case SCM_GSUBR_MAKTYPE (0, 2, 0):
 380       apply_1 = scm_smob_apply_1_020; break;
 381     case SCM_GSUBR_MAKTYPE (1, 2, 0):
 382     case SCM_GSUBR_MAKTYPE (0, 3, 0):
 383       apply_1 = scm_smob_apply_1_030; break;
 384     case SCM_GSUBR_MAKTYPE (0, 0, 1):
 385       apply_1 = scm_smob_apply_1_001; break;
 386     case SCM_GSUBR_MAKTYPE (1, 0, 1):
 387     case SCM_GSUBR_MAKTYPE (0, 1, 1):
 388       apply_1 = scm_smob_apply_1_011; break;
 389     case SCM_GSUBR_MAKTYPE (1, 1, 1):
 390     case SCM_GSUBR_MAKTYPE (0, 2, 1):
 391       apply_1 = scm_smob_apply_1_021; break;
 392     default:
 393       apply_1 = scm_smob_apply_1_error; break;
 394     }
 395
 396   switch (type)
 397     {
 398     case SCM_GSUBR_MAKTYPE (2, 0, 0):
 399     case SCM_GSUBR_MAKTYPE (1, 1, 0):
 400     case SCM_GSUBR_MAKTYPE (0, 2, 0):
 401       apply_2 = apply; break;
 402     case SCM_GSUBR_MAKTYPE (2, 1, 0):
 403     case SCM_GSUBR_MAKTYPE (1, 2, 0):
 404     case SCM_GSUBR_MAKTYPE (0, 3, 0):
 405       apply_2 = scm_smob_apply_2_030; break;
 406     case SCM_GSUBR_MAKTYPE (0, 0, 1):
 407       apply_2 = scm_smob_apply_2_001; break;
 408     case SCM_GSUBR_MAKTYPE (1, 0, 1):
 409     case SCM_GSUBR_MAKTYPE (0, 1, 1):
 410       apply_2 = scm_smob_apply_2_011; break;
 411     case SCM_GSUBR_MAKTYPE (2, 0, 1):
 412     case SCM_GSUBR_MAKTYPE (1, 1, 1):
 413     case SCM_GSUBR_MAKTYPE (0, 2, 1):
 414       apply_2 = scm_smob_apply_2_021; break;
 415     default:
 416       apply_2 = scm_smob_apply_2_error; break;
 417     }
 418
 419   switch (type)
 420     {
 421     case SCM_GSUBR_MAKTYPE (3, 0, 0):
 422     case SCM_GSUBR_MAKTYPE (2, 1, 0):
 423     case SCM_GSUBR_MAKTYPE (1, 2, 0):
 424     case SCM_GSUBR_MAKTYPE (0, 3, 0):
 425       apply_3 = scm_smob_apply_3_030; break;
 426     case SCM_GSUBR_MAKTYPE (0, 0, 1):
 427       apply_3 = scm_smob_apply_3_001; break;
 428     case SCM_GSUBR_MAKTYPE (1, 0, 1):
 429     case SCM_GSUBR_MAKTYPE (0, 1, 1):
 430       apply_3 = scm_smob_apply_3_011; break;
 431     case SCM_GSUBR_MAKTYPE (2, 0, 1):
 432     case SCM_GSUBR_MAKTYPE (1, 1, 1):
 433     case SCM_GSUBR_MAKTYPE (0, 2, 1):
 434       apply_3 = scm_smob_apply_3_021; break;
 435     default:
 436       apply_3 = scm_smob_apply_3_error; break;
 437     }
 438
 439   scm_smobs[SCM_TC2SMOBNUM (tc)].apply   = apply;
 440   scm_smobs[SCM_TC2SMOBNUM (tc)].apply_0 = apply_0;
 441   scm_smobs[SCM_TC2SMOBNUM (tc)].apply_1 = apply_1;
 442   scm_smobs[SCM_TC2SMOBNUM (tc)].apply_2 = apply_2;
 443   scm_smobs[SCM_TC2SMOBNUM (tc)].apply_3 = apply_3;
 444   scm_smobs[SCM_TC2SMOBNUM (tc)].gsubr_type = type;
 445
 446   if (SCM_UNPACK (scm_smob_class[0]) != 0)
 447     scm_i_inherit_applicable (scm_smob_class[SCM_TC2SMOBNUM (tc)]);
 448 }
 449
 450 SCM
 451 scm_make_smob (scm_t_bits tc)
 452 {
 453   scm_t_bits n = SCM_TC2SMOBNUM (tc);
 454   size_t size = scm_smobs[n].size;
 455   scm_t_bits data = (size > 0
 456                      ? (scm_t_bits) scm_gc_malloc (size, SCM_SMOBNAME (n))
 457                      : 0);
 458
 459   SCM_RETURN_NEWSMOB (tc, data);
 460 }
 461
 462
 463 \f
 464 /* Marking SMOBs using user-supplied mark procedures.  */
 465
 466
 467 /* The GC kind used for SMOB types that provide a custom mark procedure.  */
 468 static int smob_gc_kind;
 469
 470
 471 /* The generic SMOB mark procedure that gets called for SMOBs allocated with
 472    `scm_i_new_smob_with_mark_proc ()'.  */
 473 static struct GC_ms_entry *
 474 smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
 475            struct GC_ms_entry *mark_stack_limit, GC_word env)
 476 {
 477   register SCM cell;
 478   register scm_t_bits tc, smobnum;
 479
 480   cell = PTR2SCM (addr);
 481
 482   if (SCM_TYP7 (cell) != scm_tc7_smob)
 483     /* It is likely that the GC passed us a pointer to a free-list element
 484        which we must ignore (see warning in `gc/gc_mark.h').  */
 485     return mark_stack_ptr;
 486
 487   tc = SCM_CELL_WORD_0 (cell);
 488   smobnum = SCM_TC2SMOBNUM (tc);
 489
 490   if (smobnum >= scm_numsmob)
 491     /* The first word looks corrupt.  */
 492     abort ();
 493
 494   mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_1 (cell)),
 495                                      mark_stack_ptr,
 496                                      mark_stack_limit, NULL);
 497   mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_2 (cell)),
 498                                      mark_stack_ptr,
 499                                      mark_stack_limit, NULL);
 500   mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (SCM_CELL_OBJECT_3 (cell)),
 501                                      mark_stack_ptr,
 502                                      mark_stack_limit, NULL);
 503
 504   if (scm_smobs[smobnum].mark)
 505     {
 506       SCM obj;
 507
 508       SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
 509       SCM_I_CURRENT_THREAD->current_mark_stack_limit = mark_stack_limit;
 510
 511       /* Invoke the SMOB's mark procedure, which will in turn invoke
 512          `scm_gc_mark ()', which may modify `current_mark_stack_ptr'.  */
 513       obj = scm_smobs[smobnum].mark (cell);
 514
 515       mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
 516
 517       if (SCM_NIMP (obj))
 518         /* Mark the returned object.  */
 519         mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
 520                                            mark_stack_ptr,
 521                                            mark_stack_limit, NULL);
 522
 523       SCM_I_CURRENT_THREAD->current_mark_stack_limit = NULL;
 524       SCM_I_CURRENT_THREAD->current_mark_stack_ptr = NULL;
 525     }
 526
 527   return mark_stack_ptr;
 528
 529 }
 530
 531 /* Mark object O.  We assume that this function is only called during the
 532    mark phase, i.e., from within `smob_mark ()' or one of its
 533    descendents.  */
 534 void
 535 scm_gc_mark (SCM o)
 536 {
 537 #define CURRENT_MARK_PTR                                                 \
 538   ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_ptr))
 539 #define CURRENT_MARK_LIMIT                                                 \
 540   ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
 541
 542   if (SCM_NIMP (o))
 543     {
 544       /* At this point, the `current_mark_*' fields of the current thread
 545          must be defined (they are set in `smob_mark ()').  */
 546       register struct GC_ms_entry *mark_stack_ptr;
 547
 548       if (!CURRENT_MARK_PTR)
 549         /* The function was not called from a mark procedure.  */
 550         abort ();
 551
 552       mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (o),
 553                                          CURRENT_MARK_PTR, CURRENT_MARK_LIMIT,
 554                                          NULL);
 555       SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
 556     }
 557 #undef CURRENT_MARK_PTR
 558 #undef CURRENT_MARK_LIMIT
 559 }
 560
 561 /* Return a SMOB with typecode TC.  The SMOB type corresponding to TC may
 562    provide a custom mark procedure and it will be honored.  */
 563 SCM
 564 scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits data1,
 565                                scm_t_bits data2, scm_t_bits data3)
 566 {
 567   /* Return a double cell.  */
 568   SCM cell = SCM_PACK (GC_generic_malloc (2 * sizeof (scm_t_cell),
 569                                           smob_gc_kind));
 570
 571   SCM_SET_CELL_WORD_3 (cell, data3);
 572   SCM_SET_CELL_WORD_2 (cell, data2);
 573   SCM_SET_CELL_WORD_1 (cell, data1);
 574   SCM_SET_CELL_WORD_0 (cell, tc);
 575
 576   return cell;
 577 }
 578
 579 \f
 580 /* Finalize SMOB by calling its SMOB type's free function, if any.  */
 581 void
 582 scm_i_finalize_smob (GC_PTR ptr, GC_PTR data)
 583 {
 584   SCM smob;
 585   size_t (* free_smob) (SCM);
 586
 587   smob = PTR2SCM (ptr);
 588 #if 0
 589   printf ("finalizing SMOB %p (smobnum: %u)\n",
 590           ptr, SCM_SMOBNUM (smob));
 591 #endif
 592
 593   free_smob = scm_smobs[SCM_SMOBNUM (smob)].free;
 594   if (free_smob)
 595     free_smob (smob);
 596 }
 597
 598 \f
 599 void
 600 scm_smob_prehistory ()
 601 {
 602   long i;
 603
 604   smob_gc_kind = GC_new_kind (GC_new_free_list (),
 605                               GC_MAKE_PROC (GC_new_proc (smob_mark), 0),
 606                               0,
 607                               /* Clear new objects.  As of version 7.1, libgc
 608                                  doesn't seem to support passing 0 here.  */
 609                               1);
 610
 611   scm_numsmob = 0;
 612   for (i = 0; i < MAX_SMOB_COUNT; ++i)
 613     {
 614       scm_smobs[i].name       = 0;
 615       scm_smobs[i].size       = 0;
 616       scm_smobs[i].mark       = 0;
 617       scm_smobs[i].free       = 0;
 618       scm_smobs[i].print      = scm_smob_print;
 619       scm_smobs[i].equalp     = 0;
 620       scm_smobs[i].apply      = 0;
 621       scm_smobs[i].apply_0    = 0;
 622       scm_smobs[i].apply_1    = 0;
 623       scm_smobs[i].apply_2    = 0;
 624       scm_smobs[i].apply_3    = 0;
 625       scm_smobs[i].gsubr_type = 0;
 626     }
 627 }
 628
 629 /*
 630   Local Variables:
 631   c-file-style: "gnu"
 632   End:
 633 */