libguile/vm.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 #if HAVE_CONFIG_H
  43 #  include <config.h>
  44 #endif
  45
  46 #include <string.h>
  47 #include "vm-bootstrap.h"
  48 #include "frames.h"
  49 #include "instructions.h"
  50 #include "objcodes.h"
  51 #include "programs.h"
  52 #include "lang.h" /* NULL_OR_NIL_P */
  53 #include "vm.h"
  54
  55 /* I sometimes use this for debugging. */
  56 #define vm_puts(OBJ)                            \
  57 {                                               \
  58   scm_display (OBJ, scm_current_error_port ()); \
  59   scm_newline (scm_current_error_port ());      \
  60 }
  61
  62 /* The VM has a number of internal assertions that shouldn't normally be
  63    necessary, but might be if you think you found a bug in the VM. */
  64 #define VM_ENABLE_ASSERTIONS
  65
  66 /* We can add a mode that ensures that all stack items above the stack pointer
  67    are NULL. This is useful for checking the internal consistency of the VM's
  68    assumptions and its operators, but isn't necessary for normal operation. It
  69    will ensure that assertions are enabled. Slows down the VM by about 30%. */
  70 /* #define VM_ENABLE_STACK_NULLING */
  71
  72 #if defined (VM_ENABLE_STACK_NULLING) && !defined (VM_ENABLE_ASSERTIONS)
  73 #define VM_ENABLE_ASSERTIONS
  74 #endif
  75
  76 \f
  77 /*
  78  * VM Continuation
  79  */
  80
  81 scm_t_bits scm_tc16_vm_cont;
  82
  83 static void
  84 vm_mark_stack (SCM *base, scm_t_ptrdiff size, SCM *fp, scm_t_ptrdiff reloc)
  85 {
  86   SCM *sp, *upper, *lower;
  87   sp = base + size - 1;
  88
  89   while (sp > base && fp)
  90     {
  91       upper = SCM_FRAME_UPPER_ADDRESS (fp);
  92       lower = SCM_FRAME_LOWER_ADDRESS (fp);
  93
  94       for (; sp >= upper; sp--)
  95         if (SCM_NIMP (*sp))
  96           {
  97             if (scm_in_heap_p (*sp))
  98               scm_gc_mark (*sp);
  99             else
 100               fprintf (stderr, "BADNESS: crap on the stack: %p\n", *sp);
 101           }
 102
 103
 104       /* skip ra, mvra */
 105       sp -= 2;
 106
 107       /* update fp from the dynamic link */
 108       fp = (SCM*)*sp-- + reloc;
 109
 110       /* mark from the el down to the lower address */
 111       for (; sp >= lower; sp--)
 112         if (*sp && SCM_NIMP (*sp))
 113           scm_gc_mark (*sp);
 114     }
 115 }
 116
 117 static SCM
 118 vm_cont_mark (SCM obj)
 119 {
 120   struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
 121
 122   if (p->stack_size)
 123     vm_mark_stack (p->stack_base, p->stack_size, p->fp + p->reloc, p->reloc);
 124
 125   return SCM_BOOL_F;
 126 }
 127
 128 static scm_sizet
 129 vm_cont_free (SCM obj)
 130 {
 131   struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
 132
 133   scm_gc_free (p->stack_base, p->stack_size * sizeof (SCM), "stack-base");
 134   scm_gc_free (p, sizeof (struct scm_vm), "vm");
 135
 136   return 0;
 137 }
 138
 139 static SCM
 140 capture_vm_cont (struct scm_vm *vp)
 141 {
 142   struct scm_vm_cont *p = scm_gc_malloc (sizeof (*p), "capture_vm_cont");
 143   p->stack_size = vp->sp - vp->stack_base + 1;
 144   p->stack_base = scm_gc_malloc (p->stack_size * sizeof (SCM),
 145                                  "capture_vm_cont");
 146 #ifdef VM_ENABLE_STACK_NULLING
 147   if (vp->sp >= vp->stack_base)
 148     if (!vp->sp[0] || vp->sp[1])
 149       abort ();
 150   memset (p->stack_base, 0, p->stack_size * sizeof (SCM));
 151 #endif
 152   p->ip = vp->ip;
 153   p->sp = vp->sp;
 154   p->fp = vp->fp;
 155   memcpy (p->stack_base, vp->stack_base, p->stack_size * sizeof (SCM));
 156   p->reloc = p->stack_base - vp->stack_base;
 157   SCM_RETURN_NEWSMOB (scm_tc16_vm_cont, p);
 158 }
 159
 160 static void
 161 reinstate_vm_cont (struct scm_vm *vp, SCM cont)
 162 {
 163   struct scm_vm_cont *p = SCM_VM_CONT_DATA (cont);
 164   if (vp->stack_size < p->stack_size)
 165     {
 166       /* puts ("FIXME: Need to expand"); */
 167       abort ();
 168     }
 169 #ifdef VM_ENABLE_STACK_NULLING
 170   {
 171     scm_t_ptrdiff nzero = (vp->sp - p->sp);
 172     if (nzero > 0)
 173       memset (vp->stack_base + p->stack_size, 0, nzero * sizeof (SCM));
 174     /* actually nzero should always be negative, because vm_reset_stack will
 175        unwind the stack to some point *below* this continuation */
 176   }
 177 #endif
 178   vp->ip = p->ip;
 179   vp->sp = p->sp;
 180   vp->fp = p->fp;
 181   memcpy (vp->stack_base, p->stack_base, p->stack_size * sizeof (SCM));
 182 }
 183
 184 /* In theory, a number of vm instances can be active in the call trace, and we
 185    only want to reify the continuations of those in the current continuation
 186    root. I don't see a nice way to do this -- ideally it would involve dynwinds,
 187    and previous values of the *the-vm* fluid within the current continuation
 188    root. But we don't have access to continuation roots in the dynwind stack.
 189    So, just punt for now -- take the current value of *the-vm*.
 190
 191    While I'm on the topic, ideally we could avoid copying the C stack if the
 192    continuation root is inside VM code, and call/cc was invoked within that same
 193    call to vm_run; but that's currently not implemented.
 194  */
 195 SCM
 196 scm_vm_capture_continuations (void)
 197 {
 198   SCM vm = scm_the_vm ();
 199   return scm_acons (vm, capture_vm_cont (SCM_VM_DATA (vm)), SCM_EOL);
 200 }
 201
 202 void
 203 scm_vm_reinstate_continuations (SCM conts)
 204 {
 205   for (; conts != SCM_EOL; conts = SCM_CDR (conts))
 206     reinstate_vm_cont (SCM_VM_DATA (SCM_CAAR (conts)), SCM_CDAR (conts));
 207 }
 208
 209 struct vm_unwind_data
 210 {
 211   struct scm_vm *vp;
 212   SCM *sp;
 213   SCM *fp;
 214 };
 215
 216 static void
 217 vm_reset_stack (void *data)
 218 {
 219   struct vm_unwind_data *w = data;
 220   struct scm_vm *vp = w->vp;
 221
 222   vp->sp = w->sp;
 223   vp->fp = w->fp;
 224 #ifdef VM_ENABLE_STACK_NULLING
 225   memset (vp->sp + 1, 0, (vp->stack_size - (vp->sp + 1 - vp->stack_base)) * sizeof(SCM));
 226 #endif
 227 }
 228
 229 static void enfalsen_frame (void *p)
 230 {
 231   struct scm_vm *vp = p;
 232   vp->trace_frame = SCM_BOOL_F;
 233 }
 234
 235 static void
 236 vm_dispatch_hook (SCM vm, SCM hook, SCM hook_args)
 237 {
 238   struct scm_vm *vp = SCM_VM_DATA (vm);
 239
 240   if (!SCM_FALSEP (vp->trace_frame))
 241     return;
 242
 243   scm_dynwind_begin (0);
 244   vp->trace_frame = scm_c_make_vm_frame (vm, vp->fp, vp->sp, vp->ip, 0);
 245   scm_dynwind_unwind_handler (enfalsen_frame, vp, SCM_F_WIND_EXPLICITLY);
 246
 247   scm_c_run_hook (hook, hook_args);
 248
 249   scm_dynwind_end ();
 250 }
 251
 252 \f
 253 /*
 254  * VM Internal functions
 255  */
 256
 257 static SCM sym_vm_run;
 258 static SCM sym_vm_error;
 259 static SCM sym_debug;
 260
 261 static scm_byte_t *
 262 vm_fetch_length (scm_byte_t *ip, size_t *lenp)
 263 {
 264   /* NOTE: format defined in system/vm/conv.scm */
 265   *lenp = *ip++;
 266   if (*lenp < 254)
 267     return ip;
 268   else if (*lenp == 254)
 269     {
 270       int b1 = *ip++;
 271       int b2 = *ip++;
 272       *lenp = (b1 << 8) + b2;
 273     }
 274   else
 275     {
 276       int b1 = *ip++;
 277       int b2 = *ip++;
 278       int b3 = *ip++;
 279       int b4 = *ip++;
 280       *lenp = (b1 << 24) + (b2 << 16) + (b3 << 8) + b4;
 281     }
 282   return ip;
 283 }
 284
 285 static SCM
 286 vm_make_boot_program (long len)
 287 {
 288   scm_byte_t bytes[6] = {scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt};
 289   if (SCM_UNLIKELY (len > 255 || len < 0))
 290     abort ();
 291   bytes[1] = (scm_byte_t)len;
 292   return scm_c_make_program (bytes, 6, SCM_BOOL_F, SCM_BOOL_F);
 293 }
 294
 295 \f
 296 /*
 297  * VM
 298  */
 299
 300 #define VM_DEFAULT_STACK_SIZE   (16 * 1024)
 301
 302 #define VM_REGULAR_ENGINE       0
 303 #define VM_DEBUG_ENGINE         1
 304
 305 #if 0
 306 #define VM_NAME   vm_regular_engine
 307 #define VM_ENGINE VM_REGULAR_ENGINE
 308 #include "vm-engine.c"
 309 #undef VM_NAME
 310 #undef VM_ENGINE
 311 #endif
 312
 313 #define VM_NAME   vm_debug_engine
 314 #define VM_ENGINE VM_DEBUG_ENGINE
 315 #include "vm-engine.c"
 316 #undef VM_NAME
 317 #undef VM_ENGINE
 318
 319 scm_t_bits scm_tc16_vm;
 320
 321 static SCM
 322 make_vm (void)
 323 #define FUNC_NAME "make_vm"
 324 {
 325   int i;
 326   struct scm_vm *vp = scm_gc_malloc (sizeof (struct scm_vm), "vm");
 327
 328   vp->stack_size  = VM_DEFAULT_STACK_SIZE;
 329   vp->stack_base  = scm_gc_malloc (vp->stack_size * sizeof (SCM),
 330                                    "stack-base");
 331 #ifdef VM_ENABLE_STACK_NULLING
 332   memset (vp->stack_base, 0, vp->stack_size * sizeof (SCM));
 333 #endif
 334   vp->stack_limit = vp->stack_base + vp->stack_size - 3;
 335   vp->ip          = NULL;
 336   vp->sp          = vp->stack_base - 1;
 337   vp->fp          = NULL;
 338   vp->time        = 0;
 339   vp->clock       = 0;
 340   vp->options     = SCM_EOL;
 341   for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
 342     vp->hooks[i] = SCM_BOOL_F;
 343   vp->trace_frame = SCM_BOOL_F;
 344   SCM_RETURN_NEWSMOB (scm_tc16_vm, vp);
 345 }
 346 #undef FUNC_NAME
 347
 348 static SCM
 349 vm_mark (SCM obj)
 350 {
 351   int i;
 352   struct scm_vm *vp = SCM_VM_DATA (obj);
 353
 354 #ifdef VM_ENABLE_STACK_NULLING
 355   if (vp->sp >= vp->stack_base)
 356     if (!vp->sp[0] || vp->sp[1])
 357       abort ();
 358 #endif
 359
 360   /* mark the stack, precisely */
 361   vm_mark_stack (vp->stack_base, vp->sp + 1 - vp->stack_base, vp->fp, 0);
 362
 363   /* mark other objects  */
 364   for (i = 0; i < SCM_VM_NUM_HOOKS; i++)
 365     scm_gc_mark (vp->hooks[i]);
 366
 367   scm_gc_mark (vp->trace_frame);
 368
 369   return vp->options;
 370 }
 371
 372 static scm_sizet
 373 vm_free (SCM obj)
 374 {
 375   struct scm_vm *vp = SCM_VM_DATA (obj);
 376
 377   scm_gc_free (vp->stack_base, vp->stack_size * sizeof (SCM),
 378                "stack-base");
 379   scm_gc_free (vp, sizeof (struct scm_vm), "vm");
 380
 381   return 0;
 382 }
 383
 384 SCM
 385 scm_vm_apply (SCM vm, SCM program, SCM args)
 386 #define FUNC_NAME "scm_vm_apply"
 387 {
 388   SCM_VALIDATE_PROGRAM (1, program);
 389   return vm_run (vm, program, args);
 390 }
 391 #undef FUNC_NAME
 392
 393 /* Scheme interface */
 394
 395 SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
 396             (void),
 397             "")
 398 #define FUNC_NAME s_scm_vm_version
 399 {
 400   return scm_from_locale_string (PACKAGE_VERSION);
 401 }
 402 #undef FUNC_NAME
 403
 404 SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0,
 405             (void),
 406             "")
 407 #define FUNC_NAME s_scm_the_vm
 408 {
 409   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 410
 411   if (SCM_UNLIKELY (SCM_FALSEP ((t->vm))))
 412     t->vm = make_vm ();
 413
 414   return t->vm;
 415 }
 416 #undef FUNC_NAME
 417
 418
 419 SCM_DEFINE (scm_vm_p, "vm?", 1, 0, 0,
 420             (SCM obj),
 421             "")
 422 #define FUNC_NAME s_scm_vm_p
 423 {
 424   return SCM_BOOL (SCM_VM_P (obj));
 425 }
 426 #undef FUNC_NAME
 427
 428 SCM_DEFINE (scm_make_vm, "make-vm", 0, 0, 0,
 429             (void),
 430             "")
 431 #define FUNC_NAME s_scm_make_vm,
 432 {
 433   return make_vm ();
 434 }
 435 #undef FUNC_NAME
 436
 437 SCM_DEFINE (scm_vm_ip, "vm:ip", 1, 0, 0,
 438             (SCM vm),
 439             "")
 440 #define FUNC_NAME s_scm_vm_ip
 441 {
 442   SCM_VALIDATE_VM (1, vm);
 443   return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->ip);
 444 }
 445 #undef FUNC_NAME
 446
 447 SCM_DEFINE (scm_vm_sp, "vm:sp", 1, 0, 0,
 448             (SCM vm),
 449             "")
 450 #define FUNC_NAME s_scm_vm_sp
 451 {
 452   SCM_VALIDATE_VM (1, vm);
 453   return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->sp);
 454 }
 455 #undef FUNC_NAME
 456
 457 SCM_DEFINE (scm_vm_fp, "vm:fp", 1, 0, 0,
 458             (SCM vm),
 459             "")
 460 #define FUNC_NAME s_scm_vm_fp
 461 {
 462   SCM_VALIDATE_VM (1, vm);
 463   return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm)->fp);
 464 }
 465 #undef FUNC_NAME
 466
 467 #define VM_DEFINE_HOOK(n)                               \
 468 {                                                       \
 469   struct scm_vm *vp;                                    \
 470   SCM_VALIDATE_VM (1, vm);                              \
 471   vp = SCM_VM_DATA (vm);                                \
 472   if (SCM_FALSEP (vp->hooks[n]))                        \
 473     vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1));   \
 474   return vp->hooks[n];                                  \
 475 }
 476
 477 SCM_DEFINE (scm_vm_boot_hook, "vm-boot-hook", 1, 0, 0,
 478             (SCM vm),
 479             "")
 480 #define FUNC_NAME s_scm_vm_boot_hook
 481 {
 482   VM_DEFINE_HOOK (SCM_VM_BOOT_HOOK);
 483 }
 484 #undef FUNC_NAME
 485
 486 SCM_DEFINE (scm_vm_halt_hook, "vm-halt-hook", 1, 0, 0,
 487             (SCM vm),
 488             "")
 489 #define FUNC_NAME s_scm_vm_halt_hook
 490 {
 491   VM_DEFINE_HOOK (SCM_VM_HALT_HOOK);
 492 }
 493 #undef FUNC_NAME
 494
 495 SCM_DEFINE (scm_vm_next_hook, "vm-next-hook", 1, 0, 0,
 496             (SCM vm),
 497             "")
 498 #define FUNC_NAME s_scm_vm_next_hook
 499 {
 500   VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK);
 501 }
 502 #undef FUNC_NAME
 503
 504 SCM_DEFINE (scm_vm_break_hook, "vm-break-hook", 1, 0, 0,
 505             (SCM vm),
 506             "")
 507 #define FUNC_NAME s_scm_vm_break_hook
 508 {
 509   VM_DEFINE_HOOK (SCM_VM_BREAK_HOOK);
 510 }
 511 #undef FUNC_NAME
 512
 513 SCM_DEFINE (scm_vm_enter_hook, "vm-enter-hook", 1, 0, 0,
 514             (SCM vm),
 515             "")
 516 #define FUNC_NAME s_scm_vm_enter_hook
 517 {
 518   VM_DEFINE_HOOK (SCM_VM_ENTER_HOOK);
 519 }
 520 #undef FUNC_NAME
 521
 522 SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 1, 0, 0,
 523             (SCM vm),
 524             "")
 525 #define FUNC_NAME s_scm_vm_apply_hook
 526 {
 527   VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK);
 528 }
 529 #undef FUNC_NAME
 530
 531 SCM_DEFINE (scm_vm_exit_hook, "vm-exit-hook", 1, 0, 0,
 532             (SCM vm),
 533             "")
 534 #define FUNC_NAME s_scm_vm_exit_hook
 535 {
 536   VM_DEFINE_HOOK (SCM_VM_EXIT_HOOK);
 537 }
 538 #undef FUNC_NAME
 539
 540 SCM_DEFINE (scm_vm_return_hook, "vm-return-hook", 1, 0, 0,
 541             (SCM vm),
 542             "")
 543 #define FUNC_NAME s_scm_vm_return_hook
 544 {
 545   VM_DEFINE_HOOK (SCM_VM_RETURN_HOOK);
 546 }
 547 #undef FUNC_NAME
 548
 549 SCM_DEFINE (scm_vm_option, "vm-option", 2, 0, 0,
 550             (SCM vm, SCM key),
 551             "")
 552 #define FUNC_NAME s_scm_vm_option
 553 {
 554   SCM_VALIDATE_VM (1, vm);
 555   return scm_assq_ref (SCM_VM_DATA (vm)->options, key);
 556 }
 557 #undef FUNC_NAME
 558
 559 SCM_DEFINE (scm_set_vm_option_x, "set-vm-option!", 3, 0, 0,
 560             (SCM vm, SCM key, SCM val),
 561             "")
 562 #define FUNC_NAME s_scm_set_vm_option_x
 563 {
 564   SCM_VALIDATE_VM (1, vm);
 565   SCM_VM_DATA (vm)->options
 566     = scm_assq_set_x (SCM_VM_DATA (vm)->options, key, val);
 567   return SCM_UNSPECIFIED;
 568 }
 569 #undef FUNC_NAME
 570
 571 SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
 572             (SCM vm),
 573             "")
 574 #define FUNC_NAME s_scm_vm_stats
 575 {
 576   SCM stats;
 577
 578   SCM_VALIDATE_VM (1, vm);
 579
 580   stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
 581   scm_vector_set_x (stats, SCM_I_MAKINUM (0),
 582                     scm_from_ulong (SCM_VM_DATA (vm)->time));
 583   scm_vector_set_x (stats, SCM_I_MAKINUM (1),
 584                     scm_from_ulong (SCM_VM_DATA (vm)->clock));
 585
 586   return stats;
 587 }
 588 #undef FUNC_NAME
 589
 590 SCM_DEFINE (scm_vm_trace_frame, "vm-trace-frame", 1, 0, 0,
 591             (SCM vm),
 592             "")
 593 #define FUNC_NAME s_scm_vm_trace_frame
 594 {
 595   SCM_VALIDATE_VM (1, vm);
 596   return SCM_VM_DATA (vm)->trace_frame;
 597 }
 598 #undef FUNC_NAME
 599
 600 \f
 601 /*
 602  * Initialize
 603  */
 604
 605 SCM scm_load_compiled_with_vm (SCM file)
 606 {
 607   SCM program = scm_objcode_to_program (scm_load_objcode (file), SCM_EOL);
 608
 609   return vm_run (scm_the_vm (), program, SCM_EOL);
 610 }
 611
 612 void
 613 scm_bootstrap_vm (void)
 614 {
 615   static int strappage = 0;
 616
 617   if (strappage)
 618     return;
 619
 620   scm_bootstrap_frames ();
 621   scm_bootstrap_instructions ();
 622   scm_bootstrap_objcodes ();
 623   scm_bootstrap_programs ();
 624
 625   scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0);
 626   scm_set_smob_mark (scm_tc16_vm_cont, vm_cont_mark);
 627   scm_set_smob_free (scm_tc16_vm_cont, vm_cont_free);
 628
 629   scm_tc16_vm = scm_make_smob_type ("vm", 0);
 630   scm_set_smob_mark (scm_tc16_vm, vm_mark);
 631   scm_set_smob_free (scm_tc16_vm, vm_free);
 632   scm_set_smob_apply (scm_tc16_vm, scm_vm_apply, 1, 0, 1);
 633
 634   scm_c_define ("load-compiled",
 635                 scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0,
 636                                   scm_load_compiled_with_vm));
 637
 638   sym_vm_run = scm_permanent_object (scm_from_locale_symbol ("vm-run"));
 639   sym_vm_error = scm_permanent_object (scm_from_locale_symbol ("vm-error"));
 640   sym_debug = scm_permanent_object (scm_from_locale_symbol ("debug"));
 641
 642   strappage = 1;
 643 }
 644
 645 void
 646 scm_init_vm (void)
 647 {
 648   scm_bootstrap_vm ();
 649
 650 #ifndef SCM_MAGIC_SNARFER
 651 #include "vm.x"
 652 #endif
 653 }
 654
 655 /*
 656   Local Variables:
 657   c-file-style: "gnu"
 658   End:
 659 */