1 /* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
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.
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.
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
28 #include "libguile/bdw-gc.h"
29 #include <gc/gc_mark.h>
34 #include "instructions.h"
39 /* I sometimes use this for debugging. */
40 #define vm_puts(OBJ) \
42 scm_display (OBJ, scm_current_error_port ()); \
43 scm_newline (scm_current_error_port ()); \
46 /* The VM has a number of internal assertions that shouldn't normally be
47 necessary, but might be if you think you found a bug in the VM. */
48 #define VM_ENABLE_ASSERTIONS
50 /* We can add a mode that ensures that all stack items above the stack pointer
51 are NULL. This is useful for checking the internal consistency of the VM's
52 assumptions and its operators, but isn't necessary for normal operation. It
53 will ensure that assertions are enabled. Slows down the VM by about 30%. */
54 /* NB! If you enable this, search for NULLING in throw.c */
55 /* #define VM_ENABLE_STACK_NULLING */
57 /* #define VM_ENABLE_PARANOID_ASSERTIONS */
59 #if defined (VM_ENABLE_STACK_NULLING) && !defined (VM_ENABLE_ASSERTIONS)
60 #define VM_ENABLE_ASSERTIONS
63 /* When defined, arrange so that the GC doesn't scan the VM stack beyond its
64 current SP. This should help avoid excess data retention. See
65 http://thread.gmane.org/gmane.comp.programming.garbage-collection.boehmgc/3001
67 #define VM_ENABLE_PRECISE_STACK_GC_SCAN
69 /* Size in SCM objects of the stack reserve. The reserve is used to run
70 exception handling code in case of a VM stack overflow. */
71 #define VM_STACK_RESERVE_SIZE 512
80 scm_i_vm_cont_print (SCM x
, SCM port
, scm_print_state
*pstate
)
82 scm_puts ("#<vm-continuation ", port
);
83 scm_uintprint (SCM_UNPACK (x
), 16, port
);
87 /* In theory, a number of vm instances can be active in the call trace, and we
88 only want to reify the continuations of those in the current continuation
89 root. I don't see a nice way to do this -- ideally it would involve dynwinds,
90 and previous values of the *the-vm* fluid within the current continuation
91 root. But we don't have access to continuation roots in the dynwind stack.
92 So, just punt for now, we just capture the continuation for the current VM.
94 While I'm on the topic, ideally we could avoid copying the C stack if the
95 continuation root is inside VM code, and call/cc was invoked within that same
96 call to vm_run; but that's currently not implemented.
99 scm_i_vm_capture_stack (SCM
*stack_base
, SCM
*fp
, SCM
*sp
, scm_t_uint8
*ra
,
100 scm_t_uint8
*mvra
, scm_t_uint32 flags
)
102 struct scm_vm_cont
*p
;
104 p
= scm_gc_malloc (sizeof (*p
), "capture_vm_cont");
105 p
->stack_size
= sp
- stack_base
+ 1;
106 p
->stack_base
= scm_gc_malloc (p
->stack_size
* sizeof (SCM
),
108 #if defined(VM_ENABLE_STACK_NULLING) && 0
109 /* Tail continuations leave their frame on the stack for subsequent
110 application, but don't capture the frame -- so there are some elements on
111 the stack then, and this check doesn't work, so disable it for now. */
112 if (sp
>= vp
->stack_base
)
113 if (!vp
->sp
[0] || vp
->sp
[1])
115 memset (p
->stack_base
, 0, p
->stack_size
* sizeof (SCM
));
121 memcpy (p
->stack_base
, stack_base
, (sp
+ 1 - stack_base
) * sizeof (SCM
));
122 p
->reloc
= p
->stack_base
- stack_base
;
124 return scm_cell (scm_tc7_vm_cont
, (scm_t_bits
)p
);
128 vm_return_to_continuation (SCM vm
, SCM cont
, size_t n
, SCM
*argv
)
131 struct scm_vm_cont
*cp
;
134 argv_copy
= alloca (n
* sizeof(SCM
));
135 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
137 vp
= SCM_VM_DATA (vm
);
138 cp
= SCM_VM_CONT_DATA (cont
);
140 if (n
== 0 && !cp
->mvra
)
141 scm_misc_error (NULL
, "Too few values returned to continuation",
144 if (vp
->stack_size
< cp
->stack_size
+ n
+ 1)
145 scm_misc_error ("vm-engine", "not enough space to reinstate continuation",
146 scm_list_2 (vm
, cont
));
148 #ifdef VM_ENABLE_STACK_NULLING
150 scm_t_ptrdiff nzero
= (vp
->sp
- cp
->sp
);
152 memset (vp
->stack_base
+ cp
->stack_size
, 0, nzero
* sizeof (SCM
));
153 /* actually nzero should always be negative, because vm_reset_stack will
154 unwind the stack to some point *below* this continuation */
159 memcpy (vp
->stack_base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
161 if (n
== 1 || !cp
->mvra
)
165 *vp
->sp
= argv_copy
[0];
170 for (i
= 0; i
< n
; i
++)
173 *vp
->sp
= argv_copy
[i
];
176 *vp
->sp
= scm_from_size_t (n
);
182 scm_i_vm_capture_continuation (SCM vm
)
184 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
185 return scm_i_vm_capture_stack (vp
->stack_base
, vp
->fp
, vp
->sp
, vp
->ip
, NULL
, 0);
189 vm_dispatch_hook (SCM vm
, int hook_num
)
193 struct scm_frame c_frame
;
194 scm_t_aligned_cell frame
;
197 vp
= SCM_VM_DATA (vm
);
198 hook
= vp
->hooks
[hook_num
];
200 if (SCM_LIKELY (scm_is_false (hook
))
201 || scm_is_null (SCM_HOOK_PROCEDURES (hook
)))
206 /* Allocate a frame object on the stack. This is more efficient than calling
207 `scm_c_make_frame ()' to allocate on the heap, but it forces hooks to not
208 capture frame objects.
210 At the same time, procedures such as `frame-procedure' make sense only
211 while the stack frame represented by the frame object is visible, so it
212 seems reasonable to limit the lifetime of frame objects. */
214 c_frame
.stack_holder
= vm
;
219 frame
.cell
.word_0
= SCM_PACK (scm_tc7_frame
);
220 frame
.cell
.word_1
= PTR2SCM (&c_frame
);
221 args
[0] = PTR2SCM (&frame
);
223 scm_c_run_hookn (hook
, args
, 1);
228 static void vm_abort (SCM vm
, size_t n
, scm_t_int64 cookie
) SCM_NORETURN
;
230 vm_abort (SCM vm
, size_t n
, scm_t_int64 vm_cookie
)
234 SCM tag
, tail
, *argv
;
236 /* FIXME: VM_ENABLE_STACK_NULLING */
237 tail
= *(SCM_VM_DATA (vm
)->sp
--);
239 tail_len
= scm_ilength (tail
);
241 scm_misc_error ("vm-engine", "tail values to abort should be a list",
244 tag
= SCM_VM_DATA (vm
)->sp
[-n
];
245 argv
= alloca ((n
+ tail_len
) * sizeof (SCM
));
246 for (i
= 0; i
< n
; i
++)
247 argv
[i
] = SCM_VM_DATA (vm
)->sp
[-(n
-1-i
)];
248 for (; i
< n
+ tail_len
; i
++, tail
= scm_cdr (tail
))
249 argv
[i
] = scm_car (tail
);
250 /* NULLSTACK (n + 1) */
251 SCM_VM_DATA (vm
)->sp
-= n
+ 1;
253 scm_c_abort (vm
, tag
, n
+ tail_len
, argv
, vm_cookie
);
257 vm_reinstate_partial_continuation (SCM vm
, SCM cont
, SCM intwinds
,
258 size_t n
, SCM
*argv
, scm_t_int64 vm_cookie
)
261 struct scm_vm_cont
*cp
;
262 SCM
*argv_copy
, *base
;
265 argv_copy
= alloca (n
* sizeof(SCM
));
266 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
268 vp
= SCM_VM_DATA (vm
);
269 cp
= SCM_VM_CONT_DATA (cont
);
270 base
= SCM_FRAME_UPPER_ADDRESS (vp
->fp
) + 1;
272 #define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base))
274 if ((base
- vp
->stack_base
) + cp
->stack_size
+ n
+ 1 > vp
->stack_size
)
275 scm_misc_error ("vm-engine",
276 "not enough space to instate partial continuation",
277 scm_list_2 (vm
, cont
));
279 memcpy (base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
281 /* now relocate frame pointers */
284 for (fp
= RELOC (cp
->fp
);
285 SCM_FRAME_LOWER_ADDRESS (fp
) > base
;
286 fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
287 SCM_FRAME_SET_DYNAMIC_LINK (fp
, RELOC (SCM_FRAME_DYNAMIC_LINK (fp
)));
290 vp
->sp
= base
- 1 + cp
->stack_size
;
291 vp
->fp
= RELOC (cp
->fp
);
294 /* now push args. ip is in a MV context. */
295 for (i
= 0; i
< n
; i
++)
298 *vp
->sp
= argv_copy
[i
];
301 *vp
->sp
= scm_from_size_t (n
);
303 /* Finally, rewind the dynamic state.
305 We have to treat prompts specially, because we could be rewinding the
306 dynamic state from a different thread, or just a different position on the
307 C and/or VM stack -- so we need to reset the jump buffers so that an abort
308 comes back here, with appropriately adjusted sp and fp registers. */
311 SCM newwinds
= scm_i_dynwinds ();
312 for (; scm_is_pair (intwinds
); intwinds
= scm_cdr (intwinds
), delta
--)
314 SCM x
= scm_car (intwinds
);
315 if (SCM_PROMPT_P (x
))
316 /* the jmpbuf will be reset by our caller */
317 x
= scm_c_make_prompt (SCM_PROMPT_TAG (x
),
318 RELOC (SCM_PROMPT_REGISTERS (x
)->fp
),
319 RELOC (SCM_PROMPT_REGISTERS (x
)->sp
),
320 SCM_PROMPT_REGISTERS (x
)->ip
,
321 SCM_PROMPT_ESCAPE_P (x
),
324 newwinds
= scm_cons (x
, newwinds
);
326 scm_dowinds (newwinds
, delta
);
333 * VM Internal functions
336 /* Unfortunately we can't snarf these: snarfed things are only loaded up from
337 (system vm vm), which might not be loaded before an error happens. */
338 static SCM sym_vm_run
, sym_vm_error
, sym_keyword_argument_error
, sym_debug
;
341 scm_i_vm_print (SCM x
, SCM port
, scm_print_state
*pstate
)
343 const struct scm_vm
*vm
;
345 vm
= SCM_VM_DATA (x
);
347 scm_puts ("#<vm ", port
);
350 case SCM_VM_REGULAR_ENGINE
:
351 scm_puts ("regular-engine ", port
);
354 case SCM_VM_DEBUG_ENGINE
:
355 scm_puts ("debug-engine ", port
);
359 scm_puts ("unknown-engine ", port
);
361 scm_uintprint (SCM_UNPACK (x
), 16, port
);
362 scm_puts (">", port
);
366 really_make_boot_program (long nargs
)
369 scm_t_uint8 text
[] = { scm_op_mv_call
, 0, 0, 0, 1,
370 scm_op_make_int8_1
, scm_op_halt
};
371 struct scm_objcode
*bp
;
374 if (SCM_UNLIKELY (nargs
> 255 || nargs
< 0))
375 scm_misc_error ("vm-engine", "too many args when making boot procedure",
376 scm_list_1 (scm_from_long (nargs
)));
378 text
[1] = (scm_t_uint8
)nargs
;
380 bp
= scm_malloc (sizeof (struct scm_objcode
) + sizeof (text
));
381 memcpy (SCM_C_OBJCODE_BASE (bp
), text
, sizeof (text
));
382 bp
->len
= sizeof(text
);
385 u8vec
= scm_c_take_bytevector ((scm_t_int8
*)bp
,
386 sizeof (struct scm_objcode
) + sizeof (text
));
387 ret
= scm_make_program (scm_bytecode_to_objcode (u8vec
),
388 SCM_BOOL_F
, SCM_BOOL_F
);
389 SCM_SET_CELL_WORD_0 (ret
, SCM_CELL_WORD_0 (ret
) | SCM_F_PROGRAM_IS_BOOT
);
393 #define NUM_BOOT_PROGS 8
395 vm_make_boot_program (long nargs
)
397 static SCM programs
[NUM_BOOT_PROGS
] = { 0, };
399 if (SCM_UNLIKELY (!programs
[0]))
402 for (i
= 0; i
< NUM_BOOT_PROGS
; i
++)
403 programs
[i
] = really_make_boot_program (i
);
406 if (SCM_LIKELY (nargs
< NUM_BOOT_PROGS
))
407 return programs
[nargs
];
409 return really_make_boot_program (nargs
);
418 resolve_variable (SCM what
, SCM program_module
)
420 if (SCM_LIKELY (scm_is_symbol (what
)))
422 if (SCM_LIKELY (scm_module_system_booted_p
423 && scm_is_true (program_module
)))
425 return scm_module_lookup (program_module
, what
);
428 SCM v
= scm_sym2var (what
, SCM_BOOL_F
, SCM_BOOL_F
);
429 if (scm_is_false (v
))
430 scm_misc_error (NULL
, "unbound variable: ~S", scm_list_1 (what
));
438 /* compilation of @ or @@
439 `what' is a three-element list: (MODNAME SYM INTERFACE?)
440 INTERFACE? is #t if we compiled @ or #f if we compiled @@
442 mod
= scm_resolve_module (SCM_CAR (what
));
443 if (scm_is_true (SCM_CADDR (what
)))
444 mod
= scm_module_public_interface (mod
);
445 if (scm_is_false (mod
))
446 scm_misc_error (NULL
, "no such module: ~S",
447 scm_list_1 (SCM_CAR (what
)));
449 return scm_module_lookup (mod
, SCM_CADR (what
));
453 #define VM_DEFAULT_STACK_SIZE (64 * 1024)
455 #define VM_NAME vm_regular_engine
456 #define FUNC_NAME "vm-regular-engine"
457 #define VM_ENGINE SCM_VM_REGULAR_ENGINE
458 #include "vm-engine.c"
463 #define VM_NAME vm_debug_engine
464 #define FUNC_NAME "vm-debug-engine"
465 #define VM_ENGINE SCM_VM_DEBUG_ENGINE
466 #include "vm-engine.c"
471 static const scm_t_vm_engine vm_engines
[] =
472 { vm_regular_engine
, vm_debug_engine
};
474 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
476 /* The GC "kind" for the VM stack. */
477 static int vm_stack_gc_kind
;
483 #define FUNC_NAME "make_vm"
488 vp
= scm_gc_malloc (sizeof (struct scm_vm
), "vm");
490 vp
->stack_size
= VM_DEFAULT_STACK_SIZE
;
492 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
493 vp
->stack_base
= (SCM
*)
494 GC_generic_malloc (vp
->stack_size
* sizeof (SCM
), vm_stack_gc_kind
);
496 /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
498 *vp
->stack_base
= PTR2SCM (vp
);
502 vp
->stack_base
= scm_gc_malloc (vp
->stack_size
* sizeof (SCM
),
506 #ifdef VM_ENABLE_STACK_NULLING
507 memset (vp
->stack_base
, 0, vp
->stack_size
* sizeof (SCM
));
509 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
- VM_STACK_RESERVE_SIZE
;
511 vp
->sp
= vp
->stack_base
- 1;
513 vp
->engine
= SCM_VM_DEBUG_ENGINE
;
514 vp
->options
= SCM_EOL
;
516 for (i
= 0; i
< SCM_VM_NUM_HOOKS
; i
++)
517 vp
->hooks
[i
] = SCM_BOOL_F
;
519 return scm_cell (scm_tc7_vm
, (scm_t_bits
)vp
);
523 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
525 /* Mark the VM stack region between its base and its current top. */
526 static struct GC_ms_entry
*
527 vm_stack_mark (GC_word
*addr
, struct GC_ms_entry
*mark_stack_ptr
,
528 struct GC_ms_entry
*mark_stack_limit
, GC_word env
)
531 const struct scm_vm
*vm
;
533 /* The first word of the VM stack should contain a pointer to the
535 vm
= * ((struct scm_vm
**) addr
);
538 || (SCM
*) addr
!= vm
->stack_base
- 1)
539 /* ADDR must be a pointer to a free-list element, which we must ignore
540 (see warning in <gc/gc_mark.h>). */
541 return mark_stack_ptr
;
543 for (word
= (GC_word
*) vm
->stack_base
; word
<= (GC_word
*) vm
->sp
; word
++)
544 mark_stack_ptr
= GC_MARK_AND_PUSH ((* (GC_word
**) word
),
545 mark_stack_ptr
, mark_stack_limit
,
548 return mark_stack_ptr
;
551 #endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
555 scm_c_vm_run (SCM vm
, SCM program
, SCM
*argv
, int nargs
)
557 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
558 return vm_engines
[vp
->engine
](vm
, program
, argv
, nargs
);
561 SCM_DEFINE (scm_vm_apply
, "vm-apply", 3, 0, 0,
562 (SCM vm
, SCM program
, SCM args
),
564 #define FUNC_NAME s_scm_vm_apply
569 SCM_VALIDATE_VM (1, vm
);
570 SCM_VALIDATE_PROC (2, program
);
572 nargs
= scm_ilength (args
);
573 if (SCM_UNLIKELY (nargs
< 0))
574 scm_wrong_type_arg_msg (FUNC_NAME
, 3, args
, "list");
576 argv
= alloca(nargs
* sizeof(SCM
));
577 for (i
= 0; i
< nargs
; i
++)
579 argv
[i
] = SCM_CAR (args
);
580 args
= SCM_CDR (args
);
583 return scm_c_vm_run (vm
, program
, argv
, nargs
);
587 /* Scheme interface */
589 SCM_DEFINE (scm_vm_version
, "vm-version", 0, 0, 0,
592 #define FUNC_NAME s_scm_vm_version
594 return scm_from_locale_string (PACKAGE_VERSION
);
598 SCM_DEFINE (scm_the_vm
, "the-vm", 0, 0, 0,
601 #define FUNC_NAME s_scm_the_vm
603 scm_i_thread
*t
= SCM_I_CURRENT_THREAD
;
605 if (SCM_UNLIKELY (scm_is_false ((t
->vm
))))
613 SCM_DEFINE (scm_vm_p
, "vm?", 1, 0, 0,
616 #define FUNC_NAME s_scm_vm_p
618 return scm_from_bool (SCM_VM_P (obj
));
622 SCM_DEFINE (scm_make_vm
, "make-vm", 0, 0, 0,
625 #define FUNC_NAME s_scm_make_vm,
631 SCM_DEFINE (scm_vm_ip
, "vm:ip", 1, 0, 0,
634 #define FUNC_NAME s_scm_vm_ip
636 SCM_VALIDATE_VM (1, vm
);
637 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->ip
);
641 SCM_DEFINE (scm_vm_sp
, "vm:sp", 1, 0, 0,
644 #define FUNC_NAME s_scm_vm_sp
646 SCM_VALIDATE_VM (1, vm
);
647 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->sp
);
651 SCM_DEFINE (scm_vm_fp
, "vm:fp", 1, 0, 0,
654 #define FUNC_NAME s_scm_vm_fp
656 SCM_VALIDATE_VM (1, vm
);
657 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->fp
);
661 #define VM_DEFINE_HOOK(n) \
664 SCM_VALIDATE_VM (1, vm); \
665 vp = SCM_VM_DATA (vm); \
666 if (scm_is_false (vp->hooks[n])) \
667 vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
668 return vp->hooks[n]; \
671 SCM_DEFINE (scm_vm_apply_hook
, "vm-apply-hook", 1, 0, 0,
674 #define FUNC_NAME s_scm_vm_apply_hook
676 VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK
);
680 SCM_DEFINE (scm_vm_push_continuation_hook
, "vm-push-continuation-hook", 1, 0, 0,
683 #define FUNC_NAME s_scm_vm_push_continuation_hook
685 VM_DEFINE_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK
);
689 SCM_DEFINE (scm_vm_pop_continuation_hook
, "vm-pop-continuation-hook", 1, 0, 0,
692 #define FUNC_NAME s_scm_vm_pop_continuation_hook
694 VM_DEFINE_HOOK (SCM_VM_POP_CONTINUATION_HOOK
);
698 SCM_DEFINE (scm_vm_next_hook
, "vm-next-hook", 1, 0, 0,
701 #define FUNC_NAME s_scm_vm_next_hook
703 VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK
);
707 SCM_DEFINE (scm_vm_abort_continuation_hook
, "vm-abort-continuation-hook", 1, 0, 0,
710 #define FUNC_NAME s_scm_vm_abort_continuation_hook
712 VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK
);
716 SCM_DEFINE (scm_vm_restore_continuation_hook
, "vm-restore-continuation-hook", 1, 0, 0,
719 #define FUNC_NAME s_scm_vm_restore_continuation_hook
721 VM_DEFINE_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK
);
725 SCM_DEFINE (scm_vm_option
, "vm-option", 2, 0, 0,
728 #define FUNC_NAME s_scm_vm_option
730 SCM_VALIDATE_VM (1, vm
);
731 return scm_assq_ref (SCM_VM_DATA (vm
)->options
, key
);
735 SCM_DEFINE (scm_set_vm_option_x
, "set-vm-option!", 3, 0, 0,
736 (SCM vm
, SCM key
, SCM val
),
738 #define FUNC_NAME s_scm_set_vm_option_x
740 SCM_VALIDATE_VM (1, vm
);
741 SCM_VM_DATA (vm
)->options
742 = scm_assq_set_x (SCM_VM_DATA (vm
)->options
, key
, val
);
743 return SCM_UNSPECIFIED
;
747 SCM_DEFINE (scm_vm_trace_level
, "vm-trace-level", 1, 0, 0,
750 #define FUNC_NAME s_scm_vm_trace_level
752 SCM_VALIDATE_VM (1, vm
);
753 return scm_from_int (SCM_VM_DATA (vm
)->trace_level
);
757 SCM_DEFINE (scm_set_vm_trace_level_x
, "set-vm-trace-level!", 2, 0, 0,
760 #define FUNC_NAME s_scm_set_vm_trace_level_x
762 SCM_VALIDATE_VM (1, vm
);
763 SCM_VM_DATA (vm
)->trace_level
= scm_to_int (level
);
764 return SCM_UNSPECIFIED
;
773 SCM
scm_load_compiled_with_vm (SCM file
)
775 SCM program
= scm_make_program (scm_load_objcode (file
),
776 SCM_BOOL_F
, SCM_BOOL_F
);
778 return scm_c_vm_run (scm_the_vm (), program
, NULL
, 0);
782 scm_bootstrap_vm (void)
784 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
786 (scm_t_extension_init_func
)scm_init_vm
, NULL
);
788 sym_vm_run
= scm_from_locale_symbol ("vm-run");
789 sym_vm_error
= scm_from_locale_symbol ("vm-error");
790 sym_keyword_argument_error
= scm_from_locale_symbol ("keyword-argument-error");
791 sym_debug
= scm_from_locale_symbol ("debug");
793 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
795 GC_new_kind (GC_new_free_list (),
796 GC_MAKE_PROC (GC_new_proc (vm_stack_mark
), 0),
805 #ifndef SCM_MAGIC_SNARFER
806 #include "libguile/vm.x"