libguile/dump.c

   1 /*      Copyright (C) 2001 Free Software Foundation, Inc.
   2  *
   3  * This program is free software; you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation; either version 2, or (at your option)
   6  * any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this software; see the file COPYING.  If not, write to
  15  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16  * Boston, MA 02111-1307 USA
  17  *
  18  * As a special exception, the Free Software Foundation gives permission
  19  * for additional uses of the text contained in its release of GUILE.
  20  *
  21  * The exception is that, if you link the GUILE library with other files
  22  * to produce an executable, this does not by itself cause the
  23  * resulting executable to be covered by the GNU General Public License.
  24  * Your use of that executable is in no way restricted on account of
  25  * linking the GUILE library code into it.
  26  *
  27  * This exception does not however invalidate any other reasons why
  28  * the executable file might be covered by the GNU General Public License.
  29  *
  30  * This exception applies only to the code released by the
  31  * Free Software Foundation under the name GUILE.  If you copy
  32  * code from other Free Software Foundation releases into a copy of
  33  * GUILE, as the General Public License permits, the exception does
  34  * not apply to the code that you add in this way.  To avoid misleading
  35  * anyone as to the status of such modified files, you must delete
  36  * this exception notice from them.
  37  *
  38  * If you write modifications of your own for GUILE, it is your choice
  39  * whether to permit this exception to apply to your modifications.
  40  * If you do not wish that, delete this exception notice.  */
  41
  42 \f
  43
  44 #include <string.h>
  45 #include <unistd.h>
  46 #include <sys/mman.h>
  47 #include <sys/stat.h>
  48 #include <sys/types.h>
  49
  50 #include "libguile/_scm.h"
  51 #include "libguile/tags.h"
  52 #include "libguile/root.h"
  53 #include "libguile/alist.h"
  54 #include "libguile/smob.h"
  55 #include "libguile/ports.h"
  56 #include "libguile/fports.h"
  57 #include "libguile/strings.h"
  58 #include "libguile/hashtab.h"
  59 #include "libguile/vectors.h"
  60 #include "libguile/validate.h"
  61 #include "libguile/dump.h"
  62
  63 #define SCM_DUMP_COOKIE                 "\x7fGBF-0.1"
  64
  65 #define SCM_DUMP_HASH_SIZE              151
  66 #define SCM_DUMP_IMAGE_SIZE             4096
  67
  68 #define SCM_DUMP_INDEX_TO_WORD(x)       ((scm_bits_t) ((x) << 3))
  69 #define SCM_DUMP_WORD_TO_INDEX(x)       ((long) ((x) >> 3))
  70
  71 struct scm_dump_header {
  72   scm_bits_t cookie;                    /* cookie string */
  73   scm_bits_t version;                   /* version string */
  74   scm_bits_t nobjs;                     /* the number of objects */
  75                                         /* or immediate value */
  76 };
  77
  78 struct scm_dump_object_update {
  79   scm_bits_t id;                        /* object identifier */
  80   scm_bits_t *addr;                     /* object address */
  81   struct scm_dump_object_update *next;  /* next update */
  82 };
  83
  84 struct scm_dump_cell_update {
  85   scm_bits_t id;                        /* object identifier */
  86   SCM cell;                             /* cell */
  87   int n;                                /* 0-3 */
  88   struct scm_dump_cell_update *next;    /* next update */
  89 };
  90
  91 \f
  92 /*
  93  * Dump state
  94  */
  95
  96 static scm_bits_t scm_tc16_dstate;
  97
  98 struct scm_dstate {
  99   /* Memory image */
 100   int mmapped;
 101   scm_sizet image_size;
 102   int image_index;
 103   char *image_base;
 104
 105   /* Object table */
 106   int table_index;
 107   SCM table;
 108
 109   /* Update schedule */
 110   struct scm_dump_object_update *object_updates;
 111   struct scm_dump_cell_update *cell_updates;
 112 };
 113
 114 #define SCM_DSTATE_DATA(d)          ((struct scm_dstate *) SCM_SMOB_DATA (d))
 115 #define SCM_DSTATE_TABLE(d)         (SCM_DSTATE_DATA (d)->table)
 116 #define SCM_DSTATE_TABLE_REF(d,i)   (SCM_VELTS (SCM_DSTATE_TABLE (d))[i])
 117 #define SCM_DSTATE_TABLE_SET(d,i,x) (SCM_VELTS (SCM_DSTATE_TABLE (d))[i] = (x))
 118 #define SCM_DSTATE_OBJECT_UPDATES(d)(SCM_DSTATE_DATA (d)->object_updates)
 119 #define SCM_DSTATE_CELL_UPDATES(d)  (SCM_DSTATE_DATA (d)->cell_updates)
 120
 121 static SCM
 122 make_dstate ()
 123 #define FUNC_NAME "make_dstate"
 124 {
 125   struct scm_dstate *p = SCM_MUST_MALLOC (sizeof (struct scm_dstate));
 126   p->mmapped        = 0;
 127   p->image_size     = SCM_DUMP_IMAGE_SIZE;
 128   p->image_index    = 0;
 129   p->image_base     = SCM_MUST_MALLOC (p->image_size);
 130   p->table_index    = 0;
 131   p->table          = SCM_BOOL_F;
 132   p->object_updates = 0;
 133   p->cell_updates   = 0;
 134   SCM_RETURN_NEWSMOB (scm_tc16_dstate, p);
 135 }
 136 #undef FUNC_NAME
 137
 138 static SCM
 139 make_dstate_by_mmap (int fd)
 140 #define FUNC_NAME "make_dstate_by_mmap"
 141 {
 142   int ret;
 143   char *addr;
 144   struct stat st;
 145   struct scm_dstate *p = SCM_MUST_MALLOC (sizeof (struct scm_dstate));
 146
 147   SCM_SYSCALL (ret = fstat (fd, &st));
 148   if (ret < 0)
 149     SCM_SYSERROR;
 150
 151   SCM_SYSCALL (addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0));
 152   if (addr == MAP_FAILED)
 153     SCM_SYSERROR;
 154
 155   p->mmapped        = 1;
 156   p->image_size     = st.st_size;
 157   p->image_index    = 0;
 158   p->image_base     = addr;
 159   p->table_index    = 0;
 160   p->table          = SCM_BOOL_F;
 161   p->object_updates = 0;
 162   p->cell_updates   = 0;
 163   SCM_RETURN_NEWSMOB (scm_tc16_dstate, p);
 164 }
 165 #undef FUNC_NAME
 166
 167 static SCM
 168 dstate_mark (SCM obj)
 169 {
 170   return SCM_DSTATE_TABLE (obj);
 171 }
 172
 173 static scm_sizet
 174 dstate_free (SCM obj)
 175 #define FUNC_NAME "dstate_free"
 176 {
 177   int size = sizeof (struct scm_dstate);
 178   struct scm_dstate *p = SCM_DSTATE_DATA (obj);
 179
 180   /* Free dump image */
 181   if (p->mmapped)
 182     {
 183       int rv;
 184       SCM_SYSCALL (rv = munmap (p->image_base, p->image_size));
 185       if (rv < 0)
 186         SCM_SYSERROR;
 187     }
 188   else
 189     {
 190       size += p->image_size;
 191       if (p->image_base)
 192         scm_must_free (p->image_base);
 193     }
 194
 195   /* Free update schedules */
 196   while (p->object_updates)
 197     {
 198       struct scm_dump_object_update *next = p->object_updates->next;
 199       scm_must_free (p->object_updates);
 200       size += sizeof (struct scm_dump_object_update);
 201       p->object_updates = next;
 202     }
 203   while (p->cell_updates)
 204     {
 205       struct scm_dump_cell_update *next = p->cell_updates->next;
 206       scm_must_free (p->cell_updates);
 207       size += sizeof (struct scm_dump_cell_update);
 208       p->cell_updates = next;
 209     }
 210
 211   scm_must_free (p);
 212   return size;
 213 }
 214 #undef FUNC_NAME
 215
 216 static void
 217 dstate_extend (struct scm_dstate *p)
 218 {
 219   scm_sizet old_size = p->image_size;
 220   p->image_size *= 2;
 221   p->image_base = scm_must_realloc (p->image_base,
 222                                     old_size,
 223                                     p->image_size,
 224                                     "dstate_extend");
 225 }
 226
 227 \f
 228 /*
 229  * Object indicator
 230  */
 231
 232 static scm_bits_t
 233 scm_object_indicator (SCM obj, SCM dstate)
 234 {
 235   if (SCM_IMP (obj))
 236     {
 237       return SCM_UNPACK (obj);
 238     }
 239   else
 240     {
 241       SCM id = scm_hashq_ref (SCM_DSTATE_TABLE (dstate), obj, SCM_BOOL_F);
 242       if (SCM_FALSEP (id))
 243         return -1;
 244       else
 245         return SCM_DUMP_INDEX_TO_WORD (SCM_INUM (id));
 246     }
 247 }
 248
 249 static SCM
 250 scm_indicator_object (scm_bits_t word, SCM dstate)
 251 {
 252   if (SCM_IMP (SCM_PACK (word)))
 253     return SCM_PACK (word);
 254   else
 255     return SCM_DSTATE_TABLE_REF (dstate, SCM_DUMP_WORD_TO_INDEX (word));
 256 }
 257
 258 \f
 259 /*
 260  * Dump interface
 261  */
 262
 263 /* store functions */
 264
 265 static void
 266 scm_store_pad (SCM dstate)
 267 {
 268   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 269   while (p->image_index + sizeof (scm_bits_t) >= p->image_size)
 270     dstate_extend (p);
 271   while (p->image_index % sizeof (scm_bits_t) != 0)
 272     p->image_base[p->image_index++] = '\0';
 273 }
 274
 275 void
 276 scm_store_string (const char *addr, scm_sizet size, SCM dstate)
 277 {
 278   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 279   while (p->image_index + size + 1 >= p->image_size)
 280     dstate_extend (p);
 281   memcpy (p->image_base + p->image_index, addr, size);
 282   memcpy (p->image_base + p->image_index + size, "\0", 1);
 283   p->image_index += size + 1;
 284   scm_store_pad (dstate);
 285 }
 286
 287 void
 288 scm_store_bytes (const void *addr, scm_sizet size, SCM dstate)
 289 {
 290   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 291   while (p->image_index + size >= p->image_size)
 292     dstate_extend (p);
 293   memcpy (p->image_base + p->image_index, addr, size);
 294   p->image_index += size;
 295   scm_store_pad (dstate);
 296 }
 297
 298 void
 299 scm_store_word (const scm_bits_t word, SCM dstate)
 300 {
 301   scm_store_bytes (&word, sizeof (scm_bits_t), dstate);
 302 }
 303
 304 void
 305 scm_store_object (SCM obj, SCM dstate)
 306 {
 307   scm_bits_t id = scm_object_indicator (obj, dstate);
 308   if (id == -1)
 309     {
 310       /* OBJ is not stored yet.  Do it later */
 311       struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 312       struct scm_dump_object_update *update =
 313         scm_must_malloc (sizeof (struct scm_dump_object_update),
 314                          "scm_store_object");
 315       update->id   = SCM_UNPACK (obj);
 316       update->addr = (scm_bits_t *) p->image_index;
 317       update->next = p->object_updates;
 318       p->object_updates = update;
 319     }
 320   scm_store_word (id, dstate);
 321 }
 322
 323 void
 324 scm_store_cell_object (SCM cell, int n, SCM dstate)
 325 {
 326   scm_store_object (SCM_CELL_OBJECT (cell, n), dstate);
 327 }
 328
 329 /* restore functions */
 330
 331 static void
 332 scm_restore_pad (SCM dstate)
 333 {
 334   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 335   while (p->image_index % sizeof (scm_bits_t) != 0)
 336     p->image_index++;
 337 }
 338
 339 const char *
 340 scm_restore_string (scm_sizet *sizep, SCM dstate)
 341 {
 342   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 343   const char *addr = p->image_base + p->image_index;
 344   *sizep = strlen (addr);
 345   p->image_index += *sizep + 1;
 346   scm_restore_pad (dstate);
 347   return addr;
 348 }
 349
 350 const void *
 351 scm_restore_bytes (scm_sizet size, SCM dstate)
 352 {
 353   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 354   const void *addr = p->image_base + p->image_index;
 355   p->image_index += size;
 356   scm_restore_pad (dstate);
 357   return addr;
 358 }
 359
 360 scm_bits_t
 361 scm_restore_word (SCM dstate)
 362 {
 363   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 364   scm_bits_t word = *(scm_bits_t *) (p->image_base + p->image_index);
 365   p->image_index += sizeof (scm_bits_t);
 366   return word;
 367 }
 368
 369 void
 370 scm_restore_object (SCM *objp, SCM dstate)
 371 {
 372   scm_bits_t id = scm_restore_word (dstate);
 373   *objp = scm_indicator_object (id, dstate);
 374
 375   if (SCM_UNBNDP (*objp))
 376     {
 377       struct scm_dump_object_update *update =
 378         scm_must_malloc (sizeof (struct scm_dump_object_update),
 379                          "scm_restore_object");
 380       update->id   = id;
 381       update->addr = (scm_bits_t *) objp;
 382       update->next = SCM_DSTATE_OBJECT_UPDATES (dstate);
 383       SCM_DSTATE_OBJECT_UPDATES (dstate) = update;
 384     }
 385 }
 386
 387 void
 388 scm_restore_cell_object (SCM cell, int n, SCM dstate)
 389 {
 390   scm_bits_t id = scm_restore_word (dstate);
 391   SCM obj = scm_indicator_object (id, dstate);
 392   SCM_SET_CELL_OBJECT (cell, n, obj);
 393
 394   if (SCM_UNBNDP (obj))
 395     {
 396       struct scm_dump_cell_update *update =
 397         scm_must_malloc (sizeof (struct scm_dump_cell_update),
 398                          "scm_restore_cell_object");
 399       update->id   = id;
 400       update->cell = cell;
 401       update->n    = n;
 402       update->next = SCM_DSTATE_CELL_UPDATES (dstate);
 403       SCM_DSTATE_CELL_UPDATES (dstate) = update;
 404     }
 405 }
 406
 407 \f
 408 /*
 409  * Dump routine
 410  */
 411
 412 static void
 413 scm_dump (SCM obj, SCM dstate)
 414 {
 415   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 416
 417   /* Check if immediate or already dumpped */
 418   if (scm_object_indicator (obj, dstate) != -1)
 419     return;
 420
 421   /* Mark it */
 422   scm_hashq_set_x (p->table, obj, SCM_MAKINUM (p->table_index));
 423   p->table_index++;
 424
 425   if (SCM_SLOPPY_CONSP (obj))
 426     {
 427       scm_store_word (scm_tc3_cons, dstate);
 428       /* Store cdr first in order to avoid a possible deep recursion
 429        * with a long list */
 430       scm_store_cell_object (obj, 1, dstate);
 431       scm_store_cell_object (obj, 0, dstate);
 432       goto next_dump;
 433     }
 434   switch (SCM_TYP7 (obj))
 435     {
 436     case scm_tc7_symbol:
 437       {
 438         scm_store_word (scm_tc7_symbol, dstate);
 439         scm_store_string (SCM_SYMBOL_CHARS (obj),
 440                           SCM_SYMBOL_LENGTH (obj),
 441                           dstate);
 442         return;
 443       }
 444     case scm_tc7_substring:
 445     case scm_tc7_string:
 446       {
 447         scm_store_word (scm_tc7_string, dstate);
 448         scm_store_string (SCM_STRING_CHARS (obj),
 449                           SCM_STRING_LENGTH (obj),
 450                           dstate);
 451         return;
 452       }
 453     case scm_tc7_vector:
 454       {
 455         int i;
 456         int len = SCM_VECTOR_LENGTH (obj);
 457         SCM *base = SCM_VELTS (obj);
 458         scm_store_word (scm_tc7_vector, dstate);
 459         scm_store_word (len, dstate);
 460         for (i = 0; i < len; i++)
 461           scm_store_object (base[i], dstate);
 462         goto next_dump;
 463       }
 464     case scm_tc7_smob:
 465       {
 466         void (*dump) () = SCM_SMOB_DESCRIPTOR (obj).dump;
 467         if (!dump)
 468           goto error;
 469
 470         /* FIXME: SCM_CELL_TYPE may change when undump!! */
 471         scm_store_word (SCM_CELL_TYPE (obj), dstate);
 472         dump (obj, dstate);
 473         goto next_dump;
 474       }
 475     default:
 476     error:
 477       scm_misc_error ("scm_dump_mark", "Cannot dump: ~A", SCM_LIST1 (obj));
 478     }
 479
 480  next_dump:
 481   while (p->object_updates)
 482     {
 483       struct scm_dump_object_update *update = p->object_updates;
 484       p->object_updates = update->next;
 485       scm_dump (SCM_PACK (update->id), dstate);
 486       *(scm_bits_t *) (p->image_base + (int) update->addr) =
 487         scm_object_indicator (SCM_PACK (update->id), dstate);
 488       scm_must_free (update);
 489     }
 490 }
 491
 492 static void
 493 scm_undump (SCM dstate)
 494 {
 495   struct scm_dstate *p = SCM_DSTATE_DATA (dstate);
 496   scm_bits_t tc = scm_restore_word (dstate);
 497   SCM obj;
 498
 499   if (SCM_ITAG3 (SCM_PACK (tc)) == scm_tc3_cons)
 500     {
 501       SCM_NEWCELL (obj);
 502       /* cdr was stored first */
 503       scm_restore_cell_object (obj, 1, dstate);
 504       scm_restore_cell_object (obj, 0, dstate);
 505       goto store_object;
 506     }
 507
 508   switch (SCM_ITAG7 (SCM_PACK (tc)))
 509     {
 510     case scm_tc7_symbol:
 511       {
 512         int len;
 513         const char *mem = scm_restore_string (&len, dstate);
 514         obj = scm_mem2symbol (mem, len);
 515         goto store_object;
 516       }
 517     case scm_tc7_string:
 518       {
 519         int len;
 520         const char *mem = scm_restore_string (&len, dstate);
 521         obj = scm_makfromstr (mem, len, 0);
 522         goto store_object;
 523       }
 524     case scm_tc7_vector:
 525       {
 526         int i;
 527         int len = scm_restore_word (dstate);
 528         SCM *base;
 529         obj = scm_c_make_vector (len, SCM_BOOL_F);
 530         base = SCM_VELTS (obj);
 531         for (i = 0; i < len; i++)
 532           scm_restore_object (&base[i], dstate);
 533         goto store_object;
 534       }
 535     case scm_tc7_smob:
 536       {
 537         SCM (*undump) () = scm_smobs[SCM_TC2SMOBNUM (tc)].undump;
 538         if (!undump)
 539           goto error;
 540         obj = undump (dstate);
 541         goto store_object;
 542       }
 543     default:
 544     error:
 545       scm_misc_error ("scm_undump", "Cannot undump", SCM_EOL);
 546     }
 547
 548  store_object:
 549   SCM_DSTATE_TABLE_SET (dstate, p->table_index, obj);
 550   p->table_index++;
 551 }
 552
 553 \f
 554 /*
 555  * Scheme interface
 556  */
 557
 558 SCM_DEFINE (scm_binary_write, "binary-write", 1, 1, 0,
 559             (SCM obj, SCM port),
 560             "Write OBJ to PORT in a binary format.")
 561 #define FUNC_NAME s_scm_binary_write
 562 {
 563   struct scm_dstate *p;
 564   struct scm_dump_header header;
 565   SCM dstate;
 566
 567   /* Check port */
 568   if (SCM_UNBNDP (port))
 569     port = scm_cur_outp;
 570   else
 571     SCM_VALIDATE_OUTPUT_PORT (2, port);
 572
 573   /* Dump objects */
 574   dstate = make_dstate ();
 575   p = SCM_DSTATE_DATA (dstate);
 576   p->table = scm_c_make_hash_table (SCM_DUMP_HASH_SIZE);
 577   scm_dump (obj, dstate);
 578
 579   /* Write image */
 580   header.cookie  = ((scm_bits_t *) SCM_DUMP_COOKIE)[0];
 581   header.version = ((scm_bits_t *) SCM_DUMP_COOKIE)[1];
 582   header.nobjs   = (p->table_index
 583                     ? SCM_DUMP_INDEX_TO_WORD (p->table_index)
 584                     : SCM_UNPACK (obj));
 585   scm_lfwrite ((const char *) &header, sizeof (struct scm_dump_header), port);
 586   if (p->image_index)
 587     scm_lfwrite (p->image_base, p->image_index, port);
 588
 589   return SCM_UNSPECIFIED;
 590 }
 591 #undef FUNC_NAME
 592
 593 SCM_DEFINE (scm_binary_read, "binary-read", 0, 1, 0,
 594             (SCM port),
 595             "Read an object from PORT in a binary format.")
 596 #define FUNC_NAME s_scm_binary_read
 597 {
 598   int i, nobjs;
 599   struct scm_dstate *p;
 600   struct scm_dump_header *header;
 601   SCM dstate;
 602
 603   /* Check port */
 604   if (SCM_UNBNDP (port))
 605     port = scm_cur_inp;
 606   else
 607     SCM_VALIDATE_INPUT_PORT (1, port);
 608
 609   /* Initialize */
 610   if (SCM_FPORTP (port))
 611     /* Undump with mmap */
 612     dstate = make_dstate_by_mmap (SCM_FPORT_FDES (port));
 613   else
 614     /* Undump with malloc */
 615     SCM_MISC_ERROR ("Not supported yet", SCM_EOL);
 616   p = SCM_DSTATE_DATA (dstate);
 617
 618   /* Read header */
 619   header = (struct scm_dump_header *) p->image_base;
 620   p->image_index += sizeof (struct scm_dump_header);
 621   if (p->image_size < sizeof (*header))
 622     SCM_MISC_ERROR ("Invalid binary format: ~A", SCM_LIST1 (port));
 623   if (header->cookie != ((scm_bits_t *) SCM_DUMP_COOKIE)[0])
 624     SCM_MISC_ERROR ("Invalid binary format: ~A", SCM_LIST1 (port));
 625   if (header->version != ((scm_bits_t *) SCM_DUMP_COOKIE)[1])
 626     SCM_MISC_ERROR ("Unsupported binary version: ~A", SCM_LIST1 (port));
 627
 628   /* Check for immediate */
 629   if (SCM_IMP (SCM_PACK (header->nobjs)))
 630     return SCM_PACK (header->nobjs);
 631
 632   /* Create object table */
 633   nobjs = SCM_DUMP_WORD_TO_INDEX (header->nobjs);
 634   p->table = scm_c_make_vector (nobjs, SCM_UNDEFINED);
 635
 636   /* Undump */
 637   for (i = 0; i < nobjs; i++)
 638     scm_undump (dstate);
 639
 640   /* Update references */
 641   while (p->object_updates)
 642     {
 643       struct scm_dump_object_update *update = p->object_updates;
 644       p->object_updates = update->next;
 645       *(update->addr) = SCM_UNPACK (scm_indicator_object (update->id, dstate));
 646       scm_must_free (update);
 647     }
 648   /* Link objects */
 649   while (p->cell_updates)
 650     {
 651       struct scm_dump_cell_update *update = p->cell_updates;
 652       p->cell_updates = update->next;
 653       SCM_SET_CELL_OBJECT (update->cell,
 654                            update->n,
 655                            scm_indicator_object (update->id, dstate));
 656       scm_must_free (update);
 657     }
 658
 659   /* Return */
 660   {
 661     SCM obj = SCM_DSTATE_TABLE_REF (dstate, 0);
 662     p->table = SCM_BOOL_F;
 663     return obj;
 664   }
 665 }
 666 #undef FUNC_NAME
 667
 668 \f
 669 void
 670 scm_init_dump ()
 671 {
 672   scm_tc16_dstate = scm_make_smob_type ("dstate", 0);
 673   scm_set_smob_mark (scm_tc16_dstate, dstate_mark);
 674   scm_set_smob_free (scm_tc16_dstate, dstate_free);
 675 #ifndef SCM_MAGIC_SNARFER
 676 #include "libguile/dump.x"
 677 #endif
 678 }
 679
 680 /*
 681   Local Variables:
 682   c-file-style: "gnu"
 683   End:
 684 */