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
27 #include "libguile/bdw-gc.h"
28 #include <gc/gc_mark.h>
33 #include "instructions.h"
36 #include "lang.h" /* NULL_OR_NIL_P */
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
76 scm_i_vm_cont_print (SCM x
, SCM port
, scm_print_state
*pstate
)
78 scm_puts ("#<vm-continuation ", port
);
79 scm_uintprint (SCM_UNPACK (x
), 16, port
);
83 /* In theory, a number of vm instances can be active in the call trace, and we
84 only want to reify the continuations of those in the current continuation
85 root. I don't see a nice way to do this -- ideally it would involve dynwinds,
86 and previous values of the *the-vm* fluid within the current continuation
87 root. But we don't have access to continuation roots in the dynwind stack.
88 So, just punt for now, we just capture the continuation for the current VM.
90 While I'm on the topic, ideally we could avoid copying the C stack if the
91 continuation root is inside VM code, and call/cc was invoked within that same
92 call to vm_run; but that's currently not implemented.
95 scm_i_vm_capture_stack (SCM
*stack_base
, SCM
*fp
, SCM
*sp
, scm_t_uint8
*ra
,
96 scm_t_uint8
*mvra
, scm_t_uint32 flags
)
98 struct scm_vm_cont
*p
;
100 p
= scm_gc_malloc (sizeof (*p
), "capture_vm_cont");
101 p
->stack_size
= sp
- stack_base
+ 1;
102 p
->stack_base
= scm_gc_malloc (p
->stack_size
* sizeof (SCM
),
104 #if defined(VM_ENABLE_STACK_NULLING) && 0
105 /* Tail continuations leave their frame on the stack for subsequent
106 application, but don't capture the frame -- so there are some elements on
107 the stack then, and this check doesn't work, so disable it for now. */
108 if (sp
>= vp
->stack_base
)
109 if (!vp
->sp
[0] || vp
->sp
[1])
111 memset (p
->stack_base
, 0, p
->stack_size
* sizeof (SCM
));
117 memcpy (p
->stack_base
, stack_base
, (sp
+ 1 - stack_base
) * sizeof (SCM
));
118 p
->reloc
= p
->stack_base
- stack_base
;
120 return scm_cell (scm_tc7_vm_cont
, (scm_t_bits
)p
);
124 vm_return_to_continuation (SCM vm
, SCM cont
, size_t n
, SCM
*argv
)
127 struct scm_vm_cont
*cp
;
130 argv_copy
= alloca (n
* sizeof(SCM
));
131 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
133 vp
= SCM_VM_DATA (vm
);
134 cp
= SCM_VM_CONT_DATA (cont
);
136 if (n
== 0 && !cp
->mvra
)
137 scm_misc_error (NULL
, "Too few values returned to continuation",
140 if (vp
->stack_size
< cp
->stack_size
+ n
+ 1)
141 scm_misc_error ("vm-engine", "not enough space to reinstate continuation",
142 scm_list_2 (vm
, cont
));
144 #ifdef VM_ENABLE_STACK_NULLING
146 scm_t_ptrdiff nzero
= (vp
->sp
- cp
->sp
);
148 memset (vp
->stack_base
+ cp
->stack_size
, 0, nzero
* sizeof (SCM
));
149 /* actually nzero should always be negative, because vm_reset_stack will
150 unwind the stack to some point *below* this continuation */
155 memcpy (vp
->stack_base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
157 if (n
== 1 || !cp
->mvra
)
161 *vp
->sp
= argv_copy
[0];
166 for (i
= 0; i
< n
; i
++)
169 *vp
->sp
= argv_copy
[i
];
172 *vp
->sp
= scm_from_size_t (n
);
178 scm_i_vm_capture_continuation (SCM vm
)
180 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
181 return scm_i_vm_capture_stack (vp
->stack_base
, vp
->fp
, vp
->sp
, vp
->ip
, NULL
, 0);
185 vm_dispatch_hook (SCM vm
, int hook_num
)
191 vp
= SCM_VM_DATA (vm
);
192 hook
= vp
->hooks
[hook_num
];
194 if (SCM_LIKELY (scm_is_false (hook
))
195 || scm_is_null (SCM_HOOK_PROCEDURES (hook
)))
199 frame
= scm_c_make_frame (vm
, vp
->fp
, vp
->sp
, vp
->ip
, 0);
200 scm_c_run_hookn (hook
, &frame
, 1);
204 static void vm_abort (SCM vm
, size_t n
, scm_t_int64 cookie
) SCM_NORETURN
;
206 vm_abort (SCM vm
, size_t n
, scm_t_int64 vm_cookie
)
210 SCM tag
, tail
, *argv
;
212 /* FIXME: VM_ENABLE_STACK_NULLING */
213 tail
= *(SCM_VM_DATA (vm
)->sp
--);
215 tail_len
= scm_ilength (tail
);
217 scm_misc_error ("vm-engine", "tail values to abort should be a list",
220 tag
= SCM_VM_DATA (vm
)->sp
[-n
];
221 argv
= alloca ((n
+ tail_len
) * sizeof (SCM
));
222 for (i
= 0; i
< n
; i
++)
223 argv
[i
] = SCM_VM_DATA (vm
)->sp
[-(n
-1-i
)];
224 for (; i
< n
+ tail_len
; i
++, tail
= scm_cdr (tail
))
225 argv
[i
] = scm_car (tail
);
226 /* NULLSTACK (n + 1) */
227 SCM_VM_DATA (vm
)->sp
-= n
+ 1;
229 scm_c_abort (vm
, tag
, n
+ tail_len
, argv
, vm_cookie
);
233 vm_reinstate_partial_continuation (SCM vm
, SCM cont
, SCM intwinds
,
234 size_t n
, SCM
*argv
, scm_t_int64 vm_cookie
)
237 struct scm_vm_cont
*cp
;
238 SCM
*argv_copy
, *base
;
241 argv_copy
= alloca (n
* sizeof(SCM
));
242 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
244 vp
= SCM_VM_DATA (vm
);
245 cp
= SCM_VM_CONT_DATA (cont
);
246 base
= SCM_FRAME_UPPER_ADDRESS (vp
->fp
) + 1;
248 #define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base))
250 if ((base
- vp
->stack_base
) + cp
->stack_size
+ n
+ 1 > vp
->stack_size
)
251 scm_misc_error ("vm-engine",
252 "not enough space to instate partial continuation",
253 scm_list_2 (vm
, cont
));
255 memcpy (base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
257 /* now relocate frame pointers */
260 for (fp
= RELOC (cp
->fp
);
261 SCM_FRAME_LOWER_ADDRESS (fp
) > base
;
262 fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
263 SCM_FRAME_SET_DYNAMIC_LINK (fp
, RELOC (SCM_FRAME_DYNAMIC_LINK (fp
)));
266 vp
->sp
= base
- 1 + cp
->stack_size
;
267 vp
->fp
= RELOC (cp
->fp
);
270 /* now push args. ip is in a MV context. */
271 for (i
= 0; i
< n
; i
++)
274 *vp
->sp
= argv_copy
[i
];
277 *vp
->sp
= scm_from_size_t (n
);
279 /* Finally, rewind the dynamic state.
281 We have to treat prompts specially, because we could be rewinding the
282 dynamic state from a different thread, or just a different position on the
283 C and/or VM stack -- so we need to reset the jump buffers so that an abort
284 comes back here, with appropriately adjusted sp and fp registers. */
287 SCM newwinds
= scm_i_dynwinds ();
288 for (; scm_is_pair (intwinds
); intwinds
= scm_cdr (intwinds
), delta
--)
290 SCM x
= scm_car (intwinds
);
291 if (SCM_PROMPT_P (x
))
292 /* the jmpbuf will be reset by our caller */
293 x
= scm_c_make_prompt (SCM_PROMPT_TAG (x
),
294 RELOC (SCM_PROMPT_REGISTERS (x
)->fp
),
295 RELOC (SCM_PROMPT_REGISTERS (x
)->sp
),
296 SCM_PROMPT_REGISTERS (x
)->ip
,
297 SCM_PROMPT_ESCAPE_P (x
),
300 newwinds
= scm_cons (x
, newwinds
);
302 scm_dowinds (newwinds
, delta
);
309 * VM Internal functions
312 /* Unfortunately we can't snarf these: snarfed things are only loaded up from
313 (system vm vm), which might not be loaded before an error happens. */
314 static SCM sym_vm_run
, sym_vm_error
, sym_keyword_argument_error
, sym_debug
;
317 scm_i_vm_print (SCM x
, SCM port
, scm_print_state
*pstate
)
319 scm_puts ("#<vm ", port
);
320 scm_uintprint (SCM_UNPACK (x
), 16, port
);
321 scm_puts (">", port
);
325 really_make_boot_program (long nargs
)
328 scm_t_uint8 text
[] = { scm_op_mv_call
, 0, 0, 0, 1,
329 scm_op_make_int8_1
, scm_op_halt
};
330 struct scm_objcode
*bp
;
333 if (SCM_UNLIKELY (nargs
> 255 || nargs
< 0))
334 scm_misc_error ("vm-engine", "too many args when making boot procedure",
335 scm_list_1 (scm_from_long (nargs
)));
337 text
[1] = (scm_t_uint8
)nargs
;
339 bp
= scm_malloc (sizeof (struct scm_objcode
) + sizeof (text
));
340 memcpy (SCM_C_OBJCODE_BASE (bp
), text
, sizeof (text
));
341 bp
->len
= sizeof(text
);
344 u8vec
= scm_c_take_bytevector ((scm_t_int8
*)bp
,
345 sizeof (struct scm_objcode
) + sizeof (text
));
346 ret
= scm_make_program (scm_bytecode_to_objcode (u8vec
),
347 SCM_BOOL_F
, SCM_BOOL_F
);
348 SCM_SET_CELL_WORD_0 (ret
, SCM_CELL_WORD_0 (ret
) | SCM_F_PROGRAM_IS_BOOT
);
352 #define NUM_BOOT_PROGS 8
354 vm_make_boot_program (long nargs
)
356 static SCM programs
[NUM_BOOT_PROGS
] = { 0, };
358 if (SCM_UNLIKELY (!programs
[0]))
361 for (i
= 0; i
< NUM_BOOT_PROGS
; i
++)
362 programs
[i
] = really_make_boot_program (i
);
365 if (SCM_LIKELY (nargs
< NUM_BOOT_PROGS
))
366 return programs
[nargs
];
368 return really_make_boot_program (nargs
);
377 resolve_variable (SCM what
, SCM program_module
)
379 if (SCM_LIKELY (scm_is_symbol (what
)))
381 if (SCM_LIKELY (scm_module_system_booted_p
382 && scm_is_true (program_module
)))
384 return scm_module_lookup (program_module
, what
);
387 SCM v
= scm_sym2var (what
, SCM_BOOL_F
, SCM_BOOL_F
);
388 if (scm_is_false (v
))
389 scm_misc_error (NULL
, "unbound variable: ~S", scm_list_1 (what
));
397 /* compilation of @ or @@
398 `what' is a three-element list: (MODNAME SYM INTERFACE?)
399 INTERFACE? is #t if we compiled @ or #f if we compiled @@
401 mod
= scm_resolve_module (SCM_CAR (what
));
402 if (scm_is_true (SCM_CADDR (what
)))
403 mod
= scm_module_public_interface (mod
);
404 if (scm_is_false (mod
))
405 scm_misc_error (NULL
, "no such module: ~S",
406 scm_list_1 (SCM_CAR (what
)));
408 return scm_module_lookup (mod
, SCM_CADR (what
));
412 #define VM_DEFAULT_STACK_SIZE (64 * 1024)
414 #define VM_NAME vm_regular_engine
415 #define FUNC_NAME "vm-regular-engine"
416 #define VM_ENGINE SCM_VM_REGULAR_ENGINE
417 #include "vm-engine.c"
422 #define VM_NAME vm_debug_engine
423 #define FUNC_NAME "vm-debug-engine"
424 #define VM_ENGINE SCM_VM_DEBUG_ENGINE
425 #include "vm-engine.c"
430 static const scm_t_vm_engine vm_engines
[] =
431 { vm_regular_engine
, vm_debug_engine
};
433 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
435 /* The GC "kind" for the VM stack. */
436 static int vm_stack_gc_kind
;
442 #define FUNC_NAME "make_vm"
447 vp
= scm_gc_malloc (sizeof (struct scm_vm
), "vm");
449 vp
->stack_size
= VM_DEFAULT_STACK_SIZE
;
451 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
452 vp
->stack_base
= (SCM
*)
453 GC_generic_malloc (vp
->stack_size
* sizeof (SCM
), vm_stack_gc_kind
);
455 /* Keep a pointer to VP so that `vm_stack_mark ()' can know what the stack
457 *vp
->stack_base
= PTR2SCM (vp
);
461 vp
->stack_base
= scm_gc_malloc (vp
->stack_size
* sizeof (SCM
),
465 #ifdef VM_ENABLE_STACK_NULLING
466 memset (vp
->stack_base
, 0, vp
->stack_size
* sizeof (SCM
));
468 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
;
470 vp
->sp
= vp
->stack_base
- 1;
472 vp
->engine
= SCM_VM_DEBUG_ENGINE
;
473 vp
->options
= SCM_EOL
;
475 for (i
= 0; i
< SCM_VM_NUM_HOOKS
; i
++)
476 vp
->hooks
[i
] = SCM_BOOL_F
;
478 return scm_cell (scm_tc7_vm
, (scm_t_bits
)vp
);
482 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
484 /* Mark the VM stack region between its base and its current top. */
485 static struct GC_ms_entry
*
486 vm_stack_mark (GC_word
*addr
, struct GC_ms_entry
*mark_stack_ptr
,
487 struct GC_ms_entry
*mark_stack_limit
, GC_word env
)
490 const struct scm_vm
*vm
;
492 /* The first word of the VM stack should contain a pointer to the
494 vm
= * ((struct scm_vm
**) addr
);
497 || (SCM
*) addr
!= vm
->stack_base
- 1
498 || vm
->stack_limit
- vm
->stack_base
!= vm
->stack_size
)
499 /* ADDR must be a pointer to a free-list element, which we must ignore
500 (see warning in <gc/gc_mark.h>). */
501 return mark_stack_ptr
;
503 for (word
= (GC_word
*) vm
->stack_base
; word
<= (GC_word
*) vm
->sp
; word
++)
504 mark_stack_ptr
= GC_MARK_AND_PUSH ((* (GC_word
**) word
),
505 mark_stack_ptr
, mark_stack_limit
,
508 return mark_stack_ptr
;
511 #endif /* VM_ENABLE_PRECISE_STACK_GC_SCAN */
515 scm_c_vm_run (SCM vm
, SCM program
, SCM
*argv
, int nargs
)
517 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
518 return vm_engines
[vp
->engine
](vm
, program
, argv
, nargs
);
521 SCM_DEFINE (scm_vm_apply
, "vm-apply", 3, 0, 0,
522 (SCM vm
, SCM program
, SCM args
),
524 #define FUNC_NAME s_scm_vm_apply
529 SCM_VALIDATE_VM (1, vm
);
530 SCM_VALIDATE_PROC (2, program
);
532 nargs
= scm_ilength (args
);
533 if (SCM_UNLIKELY (nargs
< 0))
534 scm_wrong_type_arg_msg (FUNC_NAME
, 3, args
, "list");
536 argv
= alloca(nargs
* sizeof(SCM
));
537 for (i
= 0; i
< nargs
; i
++)
539 argv
[i
] = SCM_CAR (args
);
540 args
= SCM_CDR (args
);
543 return scm_c_vm_run (vm
, program
, argv
, nargs
);
547 /* Scheme interface */
549 SCM_DEFINE (scm_vm_version
, "vm-version", 0, 0, 0,
552 #define FUNC_NAME s_scm_vm_version
554 return scm_from_locale_string (PACKAGE_VERSION
);
558 SCM_DEFINE (scm_the_vm
, "the-vm", 0, 0, 0,
561 #define FUNC_NAME s_scm_the_vm
563 scm_i_thread
*t
= SCM_I_CURRENT_THREAD
;
565 if (SCM_UNLIKELY (scm_is_false ((t
->vm
))))
573 SCM_DEFINE (scm_vm_p
, "vm?", 1, 0, 0,
576 #define FUNC_NAME s_scm_vm_p
578 return scm_from_bool (SCM_VM_P (obj
));
582 SCM_DEFINE (scm_make_vm
, "make-vm", 0, 0, 0,
585 #define FUNC_NAME s_scm_make_vm,
591 SCM_DEFINE (scm_vm_ip
, "vm:ip", 1, 0, 0,
594 #define FUNC_NAME s_scm_vm_ip
596 SCM_VALIDATE_VM (1, vm
);
597 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->ip
);
601 SCM_DEFINE (scm_vm_sp
, "vm:sp", 1, 0, 0,
604 #define FUNC_NAME s_scm_vm_sp
606 SCM_VALIDATE_VM (1, vm
);
607 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->sp
);
611 SCM_DEFINE (scm_vm_fp
, "vm:fp", 1, 0, 0,
614 #define FUNC_NAME s_scm_vm_fp
616 SCM_VALIDATE_VM (1, vm
);
617 return scm_from_ulong ((unsigned long) SCM_VM_DATA (vm
)->fp
);
621 #define VM_DEFINE_HOOK(n) \
624 SCM_VALIDATE_VM (1, vm); \
625 vp = SCM_VM_DATA (vm); \
626 if (scm_is_false (vp->hooks[n])) \
627 vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
628 return vp->hooks[n]; \
631 SCM_DEFINE (scm_vm_boot_hook
, "vm-boot-hook", 1, 0, 0,
634 #define FUNC_NAME s_scm_vm_boot_hook
636 VM_DEFINE_HOOK (SCM_VM_BOOT_HOOK
);
640 SCM_DEFINE (scm_vm_halt_hook
, "vm-halt-hook", 1, 0, 0,
643 #define FUNC_NAME s_scm_vm_halt_hook
645 VM_DEFINE_HOOK (SCM_VM_HALT_HOOK
);
649 SCM_DEFINE (scm_vm_next_hook
, "vm-next-hook", 1, 0, 0,
652 #define FUNC_NAME s_scm_vm_next_hook
654 VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK
);
658 SCM_DEFINE (scm_vm_break_hook
, "vm-break-hook", 1, 0, 0,
661 #define FUNC_NAME s_scm_vm_break_hook
663 VM_DEFINE_HOOK (SCM_VM_BREAK_HOOK
);
667 SCM_DEFINE (scm_vm_enter_hook
, "vm-enter-hook", 1, 0, 0,
670 #define FUNC_NAME s_scm_vm_enter_hook
672 VM_DEFINE_HOOK (SCM_VM_ENTER_HOOK
);
676 SCM_DEFINE (scm_vm_apply_hook
, "vm-apply-hook", 1, 0, 0,
679 #define FUNC_NAME s_scm_vm_apply_hook
681 VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK
);
685 SCM_DEFINE (scm_vm_exit_hook
, "vm-exit-hook", 1, 0, 0,
688 #define FUNC_NAME s_scm_vm_exit_hook
690 VM_DEFINE_HOOK (SCM_VM_EXIT_HOOK
);
694 SCM_DEFINE (scm_vm_return_hook
, "vm-return-hook", 1, 0, 0,
697 #define FUNC_NAME s_scm_vm_return_hook
699 VM_DEFINE_HOOK (SCM_VM_RETURN_HOOK
);
703 SCM_DEFINE (scm_vm_option
, "vm-option", 2, 0, 0,
706 #define FUNC_NAME s_scm_vm_option
708 SCM_VALIDATE_VM (1, vm
);
709 return scm_assq_ref (SCM_VM_DATA (vm
)->options
, key
);
713 SCM_DEFINE (scm_set_vm_option_x
, "set-vm-option!", 3, 0, 0,
714 (SCM vm
, SCM key
, SCM val
),
716 #define FUNC_NAME s_scm_set_vm_option_x
718 SCM_VALIDATE_VM (1, vm
);
719 SCM_VM_DATA (vm
)->options
720 = scm_assq_set_x (SCM_VM_DATA (vm
)->options
, key
, val
);
721 return SCM_UNSPECIFIED
;
725 SCM_DEFINE (scm_vm_trace_level
, "vm-trace-level", 1, 0, 0,
728 #define FUNC_NAME s_scm_vm_trace_level
730 SCM_VALIDATE_VM (1, vm
);
731 return scm_from_int (SCM_VM_DATA (vm
)->trace_level
);
735 SCM_DEFINE (scm_set_vm_trace_level_x
, "set-vm-trace-level!", 2, 0, 0,
738 #define FUNC_NAME s_scm_set_vm_trace_level_x
740 SCM_VALIDATE_VM (1, vm
);
741 SCM_VM_DATA (vm
)->trace_level
= scm_to_int (level
);
742 return SCM_UNSPECIFIED
;
751 SCM
scm_load_compiled_with_vm (SCM file
)
753 SCM program
= scm_make_program (scm_load_objcode (file
),
754 SCM_BOOL_F
, SCM_BOOL_F
);
756 return scm_c_vm_run (scm_the_vm (), program
, NULL
, 0);
760 scm_bootstrap_vm (void)
762 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
764 (scm_t_extension_init_func
)scm_init_vm
, NULL
);
766 sym_vm_run
= scm_from_locale_symbol ("vm-run");
767 sym_vm_error
= scm_from_locale_symbol ("vm-error");
768 sym_keyword_argument_error
= scm_from_locale_symbol ("keyword-argument-error");
769 sym_debug
= scm_from_locale_symbol ("debug");
771 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
773 GC_new_kind (GC_new_free_list (),
774 GC_MAKE_PROC (GC_new_proc (vm_stack_mark
), 0),
783 #ifndef SCM_MAGIC_SNARFER
784 #include "libguile/vm.x"