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
;
196 int saved_trace_level
;
198 vp
= SCM_VM_DATA (vm
);
199 hook
= vp
->hooks
[hook_num
];
201 if (SCM_LIKELY (scm_is_false (hook
))
202 || scm_is_null (SCM_HOOK_PROCEDURES (hook
)))
205 saved_trace_level
= vp
->trace_level
;
208 /* Allocate a frame object on the stack. This is more efficient than calling
209 `scm_c_make_frame ()' to allocate on the heap, but it forces hooks to not
210 capture frame objects.
212 At the same time, procedures such as `frame-procedure' make sense only
213 while the stack frame represented by the frame object is visible, so it
214 seems reasonable to limit the lifetime of frame objects. */
216 c_frame
.stack_holder
= vm
;
222 /* Arrange for FRAME to be 8-byte aligned, like any other cell. */
223 frame
= alloca (sizeof (*frame
) + 8);
224 frame
= (scm_t_cell
*) ROUND_UP ((scm_t_uintptr
) frame
, 8UL);
226 frame
->word_0
= SCM_PACK (scm_tc7_frame
);
227 frame
->word_1
= PTR2SCM (&c_frame
);
228 args
[0] = PTR2SCM (frame
);
230 scm_c_run_hookn (hook
, args
, 1);
232 vp
->trace_level
= saved_trace_level
;
235 static void vm_abort (SCM vm
, size_t n
, scm_t_int64 cookie
) SCM_NORETURN
;
237 vm_abort (SCM vm
, size_t n
, scm_t_int64 vm_cookie
)
241 SCM tag
, tail
, *argv
;
243 /* FIXME: VM_ENABLE_STACK_NULLING */
244 tail
= *(SCM_VM_DATA (vm
)->sp
--);
246 tail_len
= scm_ilength (tail
);
248 scm_misc_error ("vm-engine", "tail values to abort should be a list",
251 tag
= SCM_VM_DATA (vm
)->sp
[-n
];
252 argv
= alloca ((n
+ tail_len
) * sizeof (SCM
));
253 for (i
= 0; i
< n
; i
++)
254 argv
[i
] = SCM_VM_DATA (vm
)->sp
[-(n
-1-i
)];
255 for (; i
< n
+ tail_len
; i
++, tail
= scm_cdr (tail
))
256 argv
[i
] = scm_car (tail
);
257 /* NULLSTACK (n + 1) */
258 SCM_VM_DATA (vm
)->sp
-= n
+ 1;
260 scm_c_abort (vm
, tag
, n
+ tail_len
, argv
, vm_cookie
);
264 vm_reinstate_partial_continuation (SCM vm
, SCM cont
, SCM intwinds
,
265 size_t n
, SCM
*argv
, scm_t_int64 vm_cookie
)
268 struct scm_vm_cont
*cp
;
269 SCM
*argv_copy
, *base
;
272 argv_copy
= alloca (n
* sizeof(SCM
));
273 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
275 vp
= SCM_VM_DATA (vm
);
276 cp
= SCM_VM_CONT_DATA (cont
);
277 base
= SCM_FRAME_UPPER_ADDRESS (vp
->fp
) + 1;
279 #define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base))
281 if ((base
- vp
->stack_base
) + cp
->stack_size
+ n
+ 1 > vp
->stack_size
)
282 scm_misc_error ("vm-engine",
283 "not enough space to instate partial continuation",
284 scm_list_2 (vm
, cont
));
286 memcpy (base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
288 /* now relocate frame pointers */
291 for (fp
= RELOC (cp
->fp
);
292 SCM_FRAME_LOWER_ADDRESS (fp
) > base
;
293 fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
294 SCM_FRAME_SET_DYNAMIC_LINK (fp
, RELOC (SCM_FRAME_DYNAMIC_LINK (fp
)));
297 vp
->sp
= base
- 1 + cp
->stack_size
;
298 vp
->fp
= RELOC (cp
->fp
);
301 /* now push args. ip is in a MV context. */
302 for (i
= 0; i
< n
; i
++)
305 *vp
->sp
= argv_copy
[i
];
308 *vp
->sp
= scm_from_size_t (n
);
310 /* Finally, rewind the dynamic state.
312 We have to treat prompts specially, because we could be rewinding the
313 dynamic state from a different thread, or just a different position on the
314 C and/or VM stack -- so we need to reset the jump buffers so that an abort
315 comes back here, with appropriately adjusted sp and fp registers. */
318 SCM newwinds
= scm_i_dynwinds ();
319 for (; scm_is_pair (intwinds
); intwinds
= scm_cdr (intwinds
), delta
--)
321 SCM x
= scm_car (intwinds
);
322 if (SCM_PROMPT_P (x
))
323 /* the jmpbuf will be reset by our caller */
324 x
= scm_c_make_prompt (SCM_PROMPT_TAG (x
),
325 RELOC (SCM_PROMPT_REGISTERS (x
)->fp
),
326 RELOC (SCM_PROMPT_REGISTERS (x
)->sp
),
327 SCM_PROMPT_REGISTERS (x
)->ip
,
328 SCM_PROMPT_ESCAPE_P (x
),
331 newwinds
= scm_cons (x
, newwinds
);
333 scm_dowinds (newwinds
, delta
);
340 * VM Internal functions
343 /* Unfortunately we can't snarf these: snarfed things are only loaded up from
344 (system vm vm), which might not be loaded before an error happens. */
345 static SCM sym_vm_run
, sym_vm_error
, sym_keyword_argument_error
, sym_debug
;
348 scm_i_vm_print (SCM x
, SCM port
, scm_print_state
*pstate
)
350 const struct scm_vm
*vm
;
352 vm
= SCM_VM_DATA (x
);
354 scm_puts ("#<vm ", port
);
357 case SCM_VM_REGULAR_ENGINE
:
358 scm_puts ("regular-engine ", port
);
361 case SCM_VM_DEBUG_ENGINE
:
362 scm_puts ("debug-engine ", port
);
366 scm_puts ("unknown-engine ", port
);
368 scm_uintprint (SCM_UNPACK (x
), 16, port
);
369 scm_puts (">", port
);
373 really_make_boot_program (long nargs
)
376 scm_t_uint8 text
[] = { scm_op_mv_call
, 0, 0, 0, 1,
377 scm_op_make_int8_1
, scm_op_halt
};
378 struct scm_objcode
*bp
;
381 if (SCM_UNLIKELY (nargs
> 255 || nargs
< 0))
382 scm_misc_error ("vm-engine", "too many args when making boot procedure",
383 scm_list_1 (scm_from_long (nargs
)));
385 text
[1] = (scm_t_uint8
)nargs
;
387 bp
= scm_malloc (sizeof (struct scm_objcode
) + sizeof (text
));
388 memcpy (SCM_C_OBJCODE_BASE (bp
), text
, sizeof (text
));
389 bp
->len
= sizeof(text
);
392 u8vec
= scm_c_take_bytevector ((scm_t_int8
*)bp
,
393 sizeof (struct scm_objcode
) + sizeof (text
));
394 ret
= scm_make_program (scm_bytecode_to_objcode (u8vec
),
395 SCM_BOOL_F
, SCM_BOOL_F
);
396 SCM_SET_CELL_WORD_0 (ret
, SCM_CELL_WORD_0 (ret
) | SCM_F_PROGRAM_IS_BOOT
);
400 #define NUM_BOOT_PROGS 8
402 vm_make_boot_program (long nargs
)
404 static SCM programs
[NUM_BOOT_PROGS
] = { 0, };
406 if (SCM_UNLIKELY (!programs
[0]))
409 for (i
= 0; i
< NUM_BOOT_PROGS
; i
++)
410 programs
[i
] = really_make_boot_program (i
);
413 if (SCM_LIKELY (nargs
< NUM_BOOT_PROGS
))
414 return programs
[nargs
];
416 return really_make_boot_program (nargs
);
425 resolve_variable (SCM what
, SCM program_module
)
427 if (SCM_LIKELY (scm_is_symbol (what
)))
429 if (SCM_LIKELY (scm_module_system_booted_p
430 && scm_is_true (program_module
)))
432 return scm_module_lookup (program_module
, what
);
435 SCM v
= scm_sym2var (what
, SCM_BOOL_F
, SCM_BOOL_F
);
436 if (scm_is_false (v
))
437 scm_misc_error (NULL
, "unbound variable: ~S", scm_list_1 (what
));
445 /* compilation of @ or @@
446 `what' is a three-element list: (MODNAME SYM INTERFACE?)
447 INTERFACE? is #t if we compiled @ or #f if we compiled @@
449 mod
= scm_resolve_module (SCM_CAR (what
));
450 if (scm_is_true (SCM_CADDR (what
)))
451 mod
= scm_module_public_interface (mod
);
452 if (scm_is_false (mod
))
453 scm_misc_error (NULL
, "no such module: ~S",
454 scm_list_1 (SCM_CAR (what
)));
456 return scm_module_lookup (mod
, SCM_CADR (what
));
460 #define VM_DEFAULT_STACK_SIZE (64 * 1024)
462 #define VM_NAME vm_regular_engine
463 #define FUNC_NAME "vm-regular-engine"
464 #define VM_ENGINE SCM_VM_REGULAR_ENGINE
465 #include "vm-engine.c"
470 #define VM_NAME vm_debug_engine
471 #define FUNC_NAME "vm-debug-engine"
472 #define VM_ENGINE SCM_VM_DEBUG_ENGINE
473 #include "vm-engine.c"
478 static const scm_t_vm_engine vm_engines
[] =
479 { vm_regular_engine
, vm_debug_engine
};
481 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
483 /* The GC "kind" for the VM stack. */
484 static int vm_stack_gc_kind
;
490 #define FUNC_NAME "make_vm"
495 vp
= scm_gc_malloc (sizeof (struct scm_vm
), "vm");
497 vp
->stack_size
= VM_DEFAULT_STACK_SIZE
;
499 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
500 vp
->stack_base
= (SCM
*)
501 GC_generic_malloc (vp
->stack_size
* sizeof (SCM
), vm_stack_gc_kind
);
503 /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
505 *vp
->stack_base
= PTR2SCM (vp
);
509 vp
->stack_base
= scm_gc_malloc (vp
->stack_size
* sizeof (SCM
),
513 #ifdef VM_ENABLE_STACK_NULLING
514 memset (vp
->stack_base
, 0, vp
->stack_size
* sizeof (SCM
));
516 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
- VM_STACK_RESERVE_SIZE
;
518 vp
->sp
= vp
->stack_base
- 1;
520 vp
->engine
= SCM_VM_DEBUG_ENGINE
;
522 for (i
= 0; i
< SCM_VM_NUM_HOOKS
; i
++)
523 vp
->hooks
[i
] = SCM_BOOL_F
;
525 return scm_cell (scm_tc7_vm
, (scm_t_bits
)vp
);
529 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
531 /* Mark the VM stack region between its base and its current top. */
532 static struct GC_ms_entry
*
533 vm_stack_mark (GC_word
*addr
, struct GC_ms_entry
*mark_stack_ptr
,
534 struct GC_ms_entry
*mark_stack_limit
, GC_word env
)
537 const struct scm_vm
*vm
;
539 /* The first word of the VM stack should contain a pointer to the
541 vm
= * ((struct scm_vm
**) addr
);
544 || (SCM
*) addr
!= vm
->stack_base
- 1)
545 /* ADDR must be a pointer to a free-list element, which we must ignore
546 (see warning in <gc/gc_mark.h>). */
547 return mark_stack_ptr
;
549 for (word
= (GC_word
*) vm
->stack_base
; word
<= (GC_word
*) vm
->sp
; word
++)
550 mark_stack_ptr
= GC_MARK_AND_PUSH ((* (GC_word
**) word
),
551 mark_stack_ptr
, mark_stack_limit
,
554 return mark_stack_ptr
;
557 #endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
561 scm_c_vm_run (SCM vm
, SCM program
, SCM
*argv
, int nargs
)
563 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
564 return vm_engines
[vp
->engine
](vm
, program
, argv
, nargs
);
567 SCM_DEFINE (scm_vm_apply
, "vm-apply", 3, 0, 0,
568 (SCM vm
, SCM program
, SCM args
),
570 #define FUNC_NAME s_scm_vm_apply
575 SCM_VALIDATE_VM (1, vm
);
576 SCM_VALIDATE_PROC (2, program
);
578 nargs
= scm_ilength (args
);
579 if (SCM_UNLIKELY (nargs
< 0))
580 scm_wrong_type_arg_msg (FUNC_NAME
, 3, args
, "list");
582 argv
= alloca(nargs
* sizeof(SCM
));
583 for (i
= 0; i
< nargs
; i
++)
585 argv
[i
] = SCM_CAR (args
);
586 args
= SCM_CDR (args
);
589 return scm_c_vm_run (vm
, program
, argv
, nargs
);
593 /* Scheme interface */
597 thread_vm (scm_i_thread
*t
)
599 if (SCM_UNLIKELY (scm_is_false (t
->vm
)))
605 SCM_DEFINE (scm_thread_vm
, "thread-vm", 1, 0, 0,
607 "Return @var{thread}'s VM.")
608 #define FUNC_NAME s_scm_thread_vm
610 SCM_VALIDATE_THREAD (1, thread
);
612 return thread_vm (SCM_I_THREAD_DATA (thread
));
616 SCM_DEFINE (scm_set_thread_vm_x
, "set-thread-vm!", 2, 0, 0,
617 (SCM thread
, SCM vm
),
618 "Set @var{thread}'s VM to @var{vm}. Warning: Code being\n"
619 "executed by @var{thread}'s current VM won't automatically\n"
620 "switch to @var{vm}.")
621 #define FUNC_NAME s_scm_set_thread_vm_x
625 SCM_VALIDATE_THREAD (1, thread
);
626 SCM_VALIDATE_VM (2, vm
);
628 t
= SCM_I_THREAD_DATA (thread
);
631 return SCM_UNSPECIFIED
;
635 SCM_DEFINE (scm_the_vm
, "the-vm", 0, 0, 0,
637 "Return the current thread's VM.")
638 #define FUNC_NAME s_scm_the_vm
640 return thread_vm (SCM_I_CURRENT_THREAD
);
645 SCM_DEFINE (scm_vm_p
, "vm?", 1, 0, 0,
648 #define FUNC_NAME s_scm_vm_p
650 return scm_from_bool (SCM_VM_P (obj
));
654 SCM_DEFINE (scm_make_vm
, "make-vm", 0, 0, 0,
657 #define FUNC_NAME s_scm_make_vm,
663 SCM_DEFINE (scm_vm_ip
, "vm:ip", 1, 0, 0,
666 #define FUNC_NAME s_scm_vm_ip
668 SCM_VALIDATE_VM (1, vm
);
669 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->ip
);
673 SCM_DEFINE (scm_vm_sp
, "vm:sp", 1, 0, 0,
676 #define FUNC_NAME s_scm_vm_sp
678 SCM_VALIDATE_VM (1, vm
);
679 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->sp
);
683 SCM_DEFINE (scm_vm_fp
, "vm:fp", 1, 0, 0,
686 #define FUNC_NAME s_scm_vm_fp
688 SCM_VALIDATE_VM (1, vm
);
689 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->fp
);
693 #define VM_DEFINE_HOOK(n) \
696 SCM_VALIDATE_VM (1, vm); \
697 vp = SCM_VM_DATA (vm); \
698 if (scm_is_false (vp->hooks[n])) \
699 vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
700 return vp->hooks[n]; \
703 SCM_DEFINE (scm_vm_apply_hook
, "vm-apply-hook", 1, 0, 0,
706 #define FUNC_NAME s_scm_vm_apply_hook
708 VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK
);
712 SCM_DEFINE (scm_vm_push_continuation_hook
, "vm-push-continuation-hook", 1, 0, 0,
715 #define FUNC_NAME s_scm_vm_push_continuation_hook
717 VM_DEFINE_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK
);
721 SCM_DEFINE (scm_vm_pop_continuation_hook
, "vm-pop-continuation-hook", 1, 0, 0,
724 #define FUNC_NAME s_scm_vm_pop_continuation_hook
726 VM_DEFINE_HOOK (SCM_VM_POP_CONTINUATION_HOOK
);
730 SCM_DEFINE (scm_vm_next_hook
, "vm-next-hook", 1, 0, 0,
733 #define FUNC_NAME s_scm_vm_next_hook
735 VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK
);
739 SCM_DEFINE (scm_vm_abort_continuation_hook
, "vm-abort-continuation-hook", 1, 0, 0,
742 #define FUNC_NAME s_scm_vm_abort_continuation_hook
744 VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK
);
748 SCM_DEFINE (scm_vm_restore_continuation_hook
, "vm-restore-continuation-hook", 1, 0, 0,
751 #define FUNC_NAME s_scm_vm_restore_continuation_hook
753 VM_DEFINE_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK
);
757 SCM_DEFINE (scm_vm_trace_level
, "vm-trace-level", 1, 0, 0,
760 #define FUNC_NAME s_scm_vm_trace_level
762 SCM_VALIDATE_VM (1, vm
);
763 return scm_from_int (SCM_VM_DATA (vm
)->trace_level
);
767 SCM_DEFINE (scm_set_vm_trace_level_x
, "set-vm-trace-level!", 2, 0, 0,
770 #define FUNC_NAME s_scm_set_vm_trace_level_x
772 SCM_VALIDATE_VM (1, vm
);
773 SCM_VM_DATA (vm
)->trace_level
= scm_to_int (level
);
774 return SCM_UNSPECIFIED
;
783 SCM
scm_load_compiled_with_vm (SCM file
)
785 SCM program
= scm_make_program (scm_load_objcode (file
),
786 SCM_BOOL_F
, SCM_BOOL_F
);
788 return scm_c_vm_run (scm_the_vm (), program
, NULL
, 0);
792 scm_bootstrap_vm (void)
794 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
796 (scm_t_extension_init_func
)scm_init_vm
, NULL
);
798 sym_vm_run
= scm_from_locale_symbol ("vm-run");
799 sym_vm_error
= scm_from_locale_symbol ("vm-error");
800 sym_keyword_argument_error
= scm_from_locale_symbol ("keyword-argument-error");
801 sym_debug
= scm_from_locale_symbol ("debug");
803 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
805 GC_new_kind (GC_new_free_list (),
806 GC_MAKE_PROC (GC_new_proc (vm_stack_mark
), 0),
815 #ifndef SCM_MAGIC_SNARFER
816 #include "libguile/vm.x"