1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014, 2015 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
19 /* For mremap(2) on GNU/Linux systems. */
33 #ifdef HAVE_SYS_MMAN_H
37 #include "libguile/bdw-gc.h"
38 #include <gc/gc_mark.h>
43 #include "gc-inline.h"
44 #include "instructions.h"
49 #include "vm-builtins.h"
51 static int vm_default_engine
= SCM_VM_REGULAR_ENGINE
;
53 /* Unfortunately we can't snarf these: snarfed things are only loaded up from
54 (system vm vm), which might not be loaded before an error happens. */
55 static SCM sym_vm_run
;
56 static SCM sym_vm_error
;
57 static SCM sym_keyword_argument_error
;
58 static SCM sym_regular
;
62 static size_t page_size
;
64 /* The VM has a number of internal assertions that shouldn't normally be
65 necessary, but might be if you think you found a bug in the VM. */
66 /* #define VM_ENABLE_ASSERTIONS */
68 static void vm_expand_stack (struct scm_vm
*vp
, SCM
*new_sp
) SCM_NOINLINE
;
70 /* RESTORE is for the case where we know we have done a PUSH of equal or
71 greater stack size in the past. Otherwise PUSH is the thing, which
72 may expand the stack. */
73 enum vm_increase_sp_kind
{ VM_SP_PUSH
, VM_SP_RESTORE
};
76 vm_increase_sp (struct scm_vm
*vp
, SCM
*new_sp
, enum vm_increase_sp_kind kind
)
78 if (new_sp
<= vp
->sp_max_since_gc
)
84 if (kind
== VM_SP_PUSH
&& new_sp
>= vp
->stack_limit
)
85 vm_expand_stack (vp
, new_sp
);
87 vp
->sp_max_since_gc
= vp
->sp
= new_sp
;
91 vm_push_sp (struct scm_vm
*vp
, SCM
*new_sp
)
93 vm_increase_sp (vp
, new_sp
, VM_SP_PUSH
);
97 vm_restore_sp (struct scm_vm
*vp
, SCM
*new_sp
)
99 vm_increase_sp (vp
, new_sp
, VM_SP_RESTORE
);
108 scm_i_vm_cont_print (SCM x
, SCM port
, scm_print_state
*pstate
)
110 scm_puts_unlocked ("#<vm-continuation ", port
);
111 scm_uintprint (SCM_UNPACK (x
), 16, port
);
112 scm_puts_unlocked (">", port
);
116 scm_i_vm_cont_to_frame (SCM cont
, struct scm_frame
*frame
)
118 struct scm_vm_cont
*data
= SCM_VM_CONT_DATA (cont
);
120 frame
->stack_holder
= data
;
121 frame
->fp_offset
= (data
->fp
+ data
->reloc
) - data
->stack_base
;
122 frame
->sp_offset
= (data
->sp
+ data
->reloc
) - data
->stack_base
;
123 frame
->ip
= data
->ra
;
128 /* Ideally we could avoid copying the C stack if the continuation root
129 is inside VM code, and call/cc was invoked within that same call to
130 vm_run. That's currently not implemented. */
132 scm_i_vm_capture_stack (SCM
*stack_base
, SCM
*fp
, SCM
*sp
, scm_t_uint32
*ra
,
133 scm_t_dynstack
*dynstack
, scm_t_uint32 flags
)
135 struct scm_vm_cont
*p
;
137 p
= scm_gc_malloc (sizeof (*p
), "capture_vm_cont");
138 p
->stack_size
= sp
- stack_base
+ 1;
139 p
->stack_base
= scm_gc_malloc (p
->stack_size
* sizeof (SCM
),
144 memcpy (p
->stack_base
, stack_base
, (sp
+ 1 - stack_base
) * sizeof (SCM
));
145 p
->reloc
= p
->stack_base
- stack_base
;
146 p
->dynstack
= dynstack
;
148 return scm_cell (scm_tc7_vm_cont
, (scm_t_bits
)p
);
151 struct return_to_continuation_data
153 struct scm_vm_cont
*cp
;
157 /* Called with the GC lock to prevent the stack marker from traversing a
158 stack in an inconsistent state. */
160 vm_return_to_continuation_inner (void *data_ptr
)
162 struct return_to_continuation_data
*data
= data_ptr
;
163 struct scm_vm
*vp
= data
->vp
;
164 struct scm_vm_cont
*cp
= data
->cp
;
167 /* We know that there is enough space for the continuation, because we
168 captured it in the past. However there may have been an expansion
169 since the capture, so we may have to re-link the frame
171 reloc
= (vp
->stack_base
- (cp
->stack_base
- cp
->reloc
));
172 vp
->fp
= cp
->fp
+ reloc
;
173 memcpy (vp
->stack_base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
174 vm_restore_sp (vp
, cp
->sp
+ reloc
);
181 SCM
*next_fp
= SCM_FRAME_DYNAMIC_LINK (fp
);
185 SCM_FRAME_SET_DYNAMIC_LINK (fp
, next_fp
);
195 vm_return_to_continuation (struct scm_vm
*vp
, SCM cont
, size_t n
, SCM
*argv
)
197 struct scm_vm_cont
*cp
;
199 struct return_to_continuation_data data
;
201 argv_copy
= alloca (n
* sizeof(SCM
));
202 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
204 cp
= SCM_VM_CONT_DATA (cont
);
208 GC_call_with_alloc_lock (vm_return_to_continuation_inner
, &data
);
210 /* Now we have the continuation properly copied over. We just need to
211 copy the arguments. It is not guaranteed that there is actually
212 space for the arguments, though, so we have to bump the SP first. */
213 vm_push_sp (vp
, vp
->sp
+ 3 + n
);
215 /* Now copy on an empty frame and the return values, as the
216 continuation expects. */
218 SCM
*base
= vp
->sp
+ 1 - 3 - n
;
221 for (i
= 0; i
< 3; i
++)
222 base
[i
] = SCM_BOOL_F
;
224 for (i
= 0; i
< n
; i
++)
225 base
[i
+ 3] = argv_copy
[i
];
231 static struct scm_vm
* thread_vm (scm_i_thread
*t
);
233 scm_i_capture_current_stack (void)
235 scm_i_thread
*thread
;
238 thread
= SCM_I_CURRENT_THREAD
;
239 vp
= thread_vm (thread
);
241 return scm_i_vm_capture_stack (vp
->stack_base
, vp
->fp
, vp
->sp
, vp
->ip
,
242 scm_dynstack_capture_all (&thread
->dynstack
),
246 static void vm_dispatch_apply_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
247 static void vm_dispatch_push_continuation_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
248 static void vm_dispatch_pop_continuation_hook (struct scm_vm
*vp
, SCM
*old_fp
) SCM_NOINLINE
;
249 static void vm_dispatch_next_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
250 static void vm_dispatch_abort_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
253 vm_dispatch_hook (struct scm_vm
*vp
, int hook_num
, SCM
*argv
, int n
)
256 struct scm_frame c_frame
;
258 int saved_trace_level
;
260 hook
= vp
->hooks
[hook_num
];
262 if (SCM_LIKELY (scm_is_false (hook
))
263 || scm_is_null (SCM_HOOK_PROCEDURES (hook
)))
266 saved_trace_level
= vp
->trace_level
;
269 /* Allocate a frame object on the stack. This is more efficient than calling
270 `scm_c_make_frame ()' to allocate on the heap, but it forces hooks to not
271 capture frame objects.
273 At the same time, procedures such as `frame-procedure' make sense only
274 while the stack frame represented by the frame object is visible, so it
275 seems reasonable to limit the lifetime of frame objects. */
277 c_frame
.stack_holder
= vp
;
278 c_frame
.fp_offset
= vp
->fp
- vp
->stack_base
;
279 c_frame
.sp_offset
= vp
->sp
- vp
->stack_base
;
282 /* Arrange for FRAME to be 8-byte aligned, like any other cell. */
283 frame
= alloca (sizeof (*frame
) + 8);
284 frame
= (scm_t_cell
*) ROUND_UP ((scm_t_uintptr
) frame
, 8UL);
286 frame
->word_0
= SCM_PACK (scm_tc7_frame
| (SCM_VM_FRAME_KIND_VM
<< 8));
287 frame
->word_1
= SCM_PACK_POINTER (&c_frame
);
293 args
[0] = SCM_PACK_POINTER (frame
);
294 scm_c_run_hookn (hook
, args
, 1);
300 args
[0] = SCM_PACK_POINTER (frame
);
302 scm_c_run_hookn (hook
, args
, 2);
309 args
= scm_cons (argv
[n
], args
);
310 scm_c_run_hook (hook
, scm_cons (SCM_PACK_POINTER (frame
), args
));
313 vp
->trace_level
= saved_trace_level
;
317 vm_dispatch_apply_hook (struct scm_vm
*vp
)
319 return vm_dispatch_hook (vp
, SCM_VM_APPLY_HOOK
, NULL
, 0);
321 static void vm_dispatch_push_continuation_hook (struct scm_vm
*vp
)
323 return vm_dispatch_hook (vp
, SCM_VM_PUSH_CONTINUATION_HOOK
, NULL
, 0);
325 static void vm_dispatch_pop_continuation_hook (struct scm_vm
*vp
, SCM
*old_fp
)
327 return vm_dispatch_hook (vp
, SCM_VM_POP_CONTINUATION_HOOK
,
328 &SCM_FRAME_LOCAL (old_fp
, 1),
329 SCM_FRAME_NUM_LOCALS (old_fp
, vp
->sp
) - 1);
331 static void vm_dispatch_next_hook (struct scm_vm
*vp
)
333 return vm_dispatch_hook (vp
, SCM_VM_NEXT_HOOK
, NULL
, 0);
335 static void vm_dispatch_abort_hook (struct scm_vm
*vp
)
337 return vm_dispatch_hook (vp
, SCM_VM_ABORT_CONTINUATION_HOOK
,
338 &SCM_FRAME_LOCAL (vp
->fp
, 1),
339 SCM_FRAME_NUM_LOCALS (vp
->fp
, vp
->sp
) - 1);
343 vm_abort (struct scm_vm
*vp
, SCM tag
,
344 size_t nstack
, SCM
*stack_args
, SCM tail
, SCM
*sp
,
345 scm_i_jmp_buf
*current_registers
) SCM_NORETURN
;
348 vm_abort (struct scm_vm
*vp
, SCM tag
,
349 size_t nstack
, SCM
*stack_args
, SCM tail
, SCM
*sp
,
350 scm_i_jmp_buf
*current_registers
)
356 tail_len
= scm_ilength (tail
);
358 scm_misc_error ("vm-engine", "tail values to abort should be a list",
361 argv
= alloca ((nstack
+ tail_len
) * sizeof (SCM
));
362 for (i
= 0; i
< nstack
; i
++)
363 argv
[i
] = stack_args
[i
];
364 for (; i
< nstack
+ tail_len
; i
++, tail
= scm_cdr (tail
))
365 argv
[i
] = scm_car (tail
);
369 scm_c_abort (vp
, tag
, nstack
+ tail_len
, argv
, current_registers
);
372 struct vm_reinstate_partial_continuation_data
375 struct scm_vm_cont
*cp
;
380 vm_reinstate_partial_continuation_inner (void *data_ptr
)
382 struct vm_reinstate_partial_continuation_data
*data
= data_ptr
;
383 struct scm_vm
*vp
= data
->vp
;
384 struct scm_vm_cont
*cp
= data
->cp
;
388 base
= SCM_FRAME_LOCALS_ADDRESS (vp
->fp
);
389 reloc
= cp
->reloc
+ (base
- cp
->stack_base
);
391 memcpy (base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
393 vp
->fp
= cp
->fp
+ reloc
;
396 /* now relocate frame pointers */
400 SCM_FRAME_LOWER_ADDRESS (fp
) >= base
;
401 fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
402 SCM_FRAME_SET_DYNAMIC_LINK (fp
, SCM_FRAME_DYNAMIC_LINK (fp
) + reloc
);
411 vm_reinstate_partial_continuation (struct scm_vm
*vp
, SCM cont
,
413 scm_t_dynstack
*dynstack
,
414 scm_i_jmp_buf
*registers
)
416 struct vm_reinstate_partial_continuation_data data
;
417 struct scm_vm_cont
*cp
;
422 argv_copy
= alloca (n
* sizeof(SCM
));
423 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
425 cp
= SCM_VM_CONT_DATA (cont
);
427 vm_push_sp (vp
, SCM_FRAME_LOCALS_ADDRESS (vp
->fp
) + cp
->stack_size
+ n
- 1);
431 GC_call_with_alloc_lock (vm_reinstate_partial_continuation_inner
, &data
);
434 /* Push the arguments. */
435 for (i
= 0; i
< n
; i
++)
436 vp
->sp
[i
+ 1 - n
] = argv_copy
[i
];
438 /* The prompt captured a slice of the dynamic stack. Here we wind
439 those entries onto the current thread's stack. We also have to
440 relocate any prompts that we see along the way. */
444 for (walk
= SCM_DYNSTACK_FIRST (cp
->dynstack
);
445 SCM_DYNSTACK_TAG (walk
);
446 walk
= SCM_DYNSTACK_NEXT (walk
))
448 scm_t_bits tag
= SCM_DYNSTACK_TAG (walk
);
450 if (SCM_DYNSTACK_TAG_TYPE (tag
) == SCM_DYNSTACK_TYPE_PROMPT
)
451 scm_dynstack_wind_prompt (dynstack
, walk
, reloc
, registers
);
453 scm_dynstack_wind_1 (dynstack
, walk
);
463 static void vm_error (const char *msg
, SCM arg
) SCM_NORETURN
;
464 static void vm_error_bad_instruction (scm_t_uint32 inst
) SCM_NORETURN SCM_NOINLINE
;
465 static void vm_error_unbound (SCM sym
) SCM_NORETURN SCM_NOINLINE
;
466 static void vm_error_unbound_fluid (SCM fluid
) SCM_NORETURN SCM_NOINLINE
;
467 static void vm_error_not_a_variable (const char *func_name
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
468 static void vm_error_apply_to_non_list (SCM x
) SCM_NORETURN SCM_NOINLINE
;
469 static void vm_error_kwargs_length_not_even (SCM proc
) SCM_NORETURN SCM_NOINLINE
;
470 static void vm_error_kwargs_invalid_keyword (SCM proc
, SCM obj
) SCM_NORETURN SCM_NOINLINE
;
471 static void vm_error_kwargs_unrecognized_keyword (SCM proc
, SCM kw
) SCM_NORETURN SCM_NOINLINE
;
472 static void vm_error_too_many_args (int nargs
) SCM_NORETURN SCM_NOINLINE
;
473 static void vm_error_wrong_num_args (SCM proc
) SCM_NORETURN SCM_NOINLINE
;
474 static void vm_error_wrong_type_apply (SCM proc
) SCM_NORETURN SCM_NOINLINE
;
475 static void vm_error_stack_underflow (void) SCM_NORETURN SCM_NOINLINE
;
476 static void vm_error_improper_list (SCM x
) SCM_NORETURN SCM_NOINLINE
;
477 static void vm_error_not_a_pair (const char *subr
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
478 static void vm_error_not_a_bytevector (const char *subr
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
479 static void vm_error_not_a_struct (const char *subr
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
480 static void vm_error_not_a_vector (const char *subr
, SCM v
) SCM_NORETURN SCM_NOINLINE
;
481 static void vm_error_out_of_range (const char *subr
, SCM k
) SCM_NORETURN SCM_NOINLINE
;
482 static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE
;
483 static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE
;
484 static void vm_error_wrong_number_of_values (scm_t_uint32 expected
) SCM_NORETURN SCM_NOINLINE
;
485 static void vm_error_continuation_not_rewindable (SCM cont
) SCM_NORETURN SCM_NOINLINE
;
486 static void vm_error_bad_wide_string_length (size_t len
) SCM_NORETURN SCM_NOINLINE
;
489 vm_error (const char *msg
, SCM arg
)
491 scm_throw (sym_vm_error
,
492 scm_list_3 (sym_vm_run
, scm_from_latin1_string (msg
),
493 SCM_UNBNDP (arg
) ? SCM_EOL
: scm_list_1 (arg
)));
494 abort(); /* not reached */
498 vm_error_bad_instruction (scm_t_uint32 inst
)
500 vm_error ("VM: Bad instruction: ~s", scm_from_uint32 (inst
));
504 vm_error_unbound (SCM sym
)
506 scm_error_scm (scm_misc_error_key
, SCM_BOOL_F
,
507 scm_from_latin1_string ("Unbound variable: ~s"),
508 scm_list_1 (sym
), SCM_BOOL_F
);
512 vm_error_unbound_fluid (SCM fluid
)
514 scm_error_scm (scm_misc_error_key
, SCM_BOOL_F
,
515 scm_from_latin1_string ("Unbound fluid: ~s"),
516 scm_list_1 (fluid
), SCM_BOOL_F
);
520 vm_error_not_a_variable (const char *func_name
, SCM x
)
522 scm_error (scm_arg_type_key
, func_name
, "Not a variable: ~S",
523 scm_list_1 (x
), scm_list_1 (x
));
527 vm_error_apply_to_non_list (SCM x
)
529 scm_error (scm_arg_type_key
, "apply", "Apply to non-list: ~S",
530 scm_list_1 (x
), scm_list_1 (x
));
534 vm_error_kwargs_length_not_even (SCM proc
)
536 scm_error_scm (sym_keyword_argument_error
, proc
,
537 scm_from_latin1_string ("Odd length of keyword argument list"),
538 SCM_EOL
, SCM_BOOL_F
);
542 vm_error_kwargs_invalid_keyword (SCM proc
, SCM obj
)
544 scm_error_scm (sym_keyword_argument_error
, proc
,
545 scm_from_latin1_string ("Invalid keyword"),
546 SCM_EOL
, scm_list_1 (obj
));
550 vm_error_kwargs_unrecognized_keyword (SCM proc
, SCM kw
)
552 scm_error_scm (sym_keyword_argument_error
, proc
,
553 scm_from_latin1_string ("Unrecognized keyword"),
554 SCM_EOL
, scm_list_1 (kw
));
558 vm_error_too_many_args (int nargs
)
560 vm_error ("VM: Too many arguments", scm_from_int (nargs
));
564 vm_error_wrong_num_args (SCM proc
)
566 scm_wrong_num_args (proc
);
570 vm_error_wrong_type_apply (SCM proc
)
572 scm_error (scm_arg_type_key
, NULL
, "Wrong type to apply: ~S",
573 scm_list_1 (proc
), scm_list_1 (proc
));
577 vm_error_stack_underflow (void)
579 vm_error ("VM: Stack underflow", SCM_UNDEFINED
);
583 vm_error_improper_list (SCM x
)
585 vm_error ("Expected a proper list, but got object with tail ~s", x
);
589 vm_error_not_a_pair (const char *subr
, SCM x
)
591 scm_wrong_type_arg_msg (subr
, 1, x
, "pair");
595 vm_error_not_a_bytevector (const char *subr
, SCM x
)
597 scm_wrong_type_arg_msg (subr
, 1, x
, "bytevector");
601 vm_error_not_a_struct (const char *subr
, SCM x
)
603 scm_wrong_type_arg_msg (subr
, 1, x
, "struct");
607 vm_error_not_a_vector (const char *subr
, SCM x
)
609 scm_wrong_type_arg_msg (subr
, 1, x
, "vector");
613 vm_error_out_of_range (const char *subr
, SCM k
)
616 scm_out_of_range (subr
, k
);
620 vm_error_no_values (void)
622 vm_error ("Zero values returned to single-valued continuation",
627 vm_error_not_enough_values (void)
629 vm_error ("Too few values returned to continuation", SCM_UNDEFINED
);
633 vm_error_wrong_number_of_values (scm_t_uint32 expected
)
635 vm_error ("Wrong number of values returned to continuation (expected ~a)",
636 scm_from_uint32 (expected
));
640 vm_error_continuation_not_rewindable (SCM cont
)
642 vm_error ("Unrewindable partial continuation", cont
);
646 vm_error_bad_wide_string_length (size_t len
)
648 vm_error ("VM: Bad wide string length: ~S", scm_from_size_t (len
));
654 static SCM vm_boot_continuation
;
655 static SCM vm_builtin_apply
;
656 static SCM vm_builtin_values
;
657 static SCM vm_builtin_abort_to_prompt
;
658 static SCM vm_builtin_call_with_values
;
659 static SCM vm_builtin_call_with_current_continuation
;
661 static const scm_t_uint32 vm_boot_continuation_code
[] = {
662 SCM_PACK_OP_24 (halt
, 0)
665 static const scm_t_uint32 vm_builtin_apply_code
[] = {
666 SCM_PACK_OP_24 (assert_nargs_ge
, 3),
667 SCM_PACK_OP_24 (tail_apply
, 0), /* proc in r1, args from r2 */
670 static const scm_t_uint32 vm_builtin_values_code
[] = {
671 SCM_PACK_OP_24 (return_values
, 0) /* vals from r1 */
674 static const scm_t_uint32 vm_builtin_abort_to_prompt_code
[] = {
675 SCM_PACK_OP_24 (assert_nargs_ge
, 2),
676 SCM_PACK_OP_24 (abort
, 0), /* tag in r1, vals from r2 */
677 /* FIXME: Partial continuation should capture caller regs. */
678 SCM_PACK_OP_24 (return_values
, 0) /* vals from r1 */
681 static const scm_t_uint32 vm_builtin_call_with_values_code
[] = {
682 SCM_PACK_OP_24 (assert_nargs_ee
, 3),
683 SCM_PACK_OP_24 (alloc_frame
, 7),
684 SCM_PACK_OP_12_12 (mov
, 6, 1),
685 SCM_PACK_OP_24 (call
, 6), SCM_PACK_OP_ARG_8_24 (0, 1),
686 SCM_PACK_OP_12_12 (mov
, 0, 2),
687 SCM_PACK_OP_24 (tail_call_shuffle
, 7)
690 static const scm_t_uint32 vm_builtin_call_with_current_continuation_code
[] = {
691 SCM_PACK_OP_24 (assert_nargs_ee
, 2),
692 SCM_PACK_OP_24 (call_cc
, 0)
697 scm_vm_builtin_ref (unsigned idx
)
701 #define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest) \
702 case SCM_VM_BUILTIN_##BUILTIN: return vm_builtin_##builtin;
703 FOR_EACH_VM_BUILTIN(INDEX_TO_NAME
)
710 static SCM scm_sym_values
;
711 static SCM scm_sym_abort_to_prompt
;
712 static SCM scm_sym_call_with_values
;
713 static SCM scm_sym_call_with_current_continuation
;
716 scm_vm_builtin_name_to_index (SCM name
)
717 #define FUNC_NAME "builtin-name->index"
719 SCM_VALIDATE_SYMBOL (1, name
);
721 #define NAME_TO_INDEX(builtin, BUILTIN, req, opt, rest) \
722 if (scm_is_eq (name, scm_sym_##builtin)) \
723 return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN);
724 FOR_EACH_VM_BUILTIN(NAME_TO_INDEX
)
732 scm_vm_builtin_index_to_name (SCM index
)
733 #define FUNC_NAME "builtin-index->name"
737 SCM_VALIDATE_UINT_COPY (1, index
, idx
);
741 #define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest) \
742 case SCM_VM_BUILTIN_##BUILTIN: return scm_sym_##builtin;
743 FOR_EACH_VM_BUILTIN(INDEX_TO_NAME
)
745 default: return SCM_BOOL_F
;
751 scm_init_vm_builtins (void)
753 scm_c_define_gsubr ("builtin-name->index", 1, 0, 0,
754 scm_vm_builtin_name_to_index
);
755 scm_c_define_gsubr ("builtin-index->name", 1, 0, 0,
756 scm_vm_builtin_index_to_name
);
760 scm_i_call_with_current_continuation (SCM proc
)
762 return scm_call_1 (vm_builtin_call_with_current_continuation
, proc
);
770 #define VM_NAME vm_regular_engine
771 #define VM_USE_HOOKS 0
772 #define FUNC_NAME "vm-regular-engine"
773 #include "vm-engine.c"
778 #define VM_NAME vm_debug_engine
779 #define VM_USE_HOOKS 1
780 #define FUNC_NAME "vm-debug-engine"
781 #include "vm-engine.c"
786 typedef SCM (*scm_t_vm_engine
) (scm_i_thread
*current_thread
, struct scm_vm
*vp
,
787 scm_i_jmp_buf
*registers
, int resume
);
789 static const scm_t_vm_engine vm_engines
[SCM_VM_NUM_ENGINES
] =
790 { vm_regular_engine
, vm_debug_engine
};
793 allocate_stack (size_t size
)
794 #define FUNC_NAME "make_vm"
798 if (size
>= ((size_t) -1) / sizeof (SCM
))
801 size
*= sizeof (SCM
);
804 ret
= mmap (NULL
, size
, PROT_READ
| PROT_WRITE
,
805 MAP_PRIVATE
| MAP_ANONYMOUS
, -1, 0);
806 if (ret
== MAP_FAILED
)
814 perror ("allocate_stack failed");
823 free_stack (SCM
*stack
, size_t size
)
825 size
*= sizeof (SCM
);
828 munmap (stack
, size
);
835 expand_stack (SCM
*old_stack
, size_t old_size
, size_t new_size
)
836 #define FUNC_NAME "expand_stack"
838 #if defined MREMAP_MAYMOVE
841 if (new_size
>= ((size_t) -1) / sizeof (SCM
))
844 old_size
*= sizeof (SCM
);
845 new_size
*= sizeof (SCM
);
847 new_stack
= mremap (old_stack
, old_size
, new_size
, MREMAP_MAYMOVE
);
848 if (new_stack
== MAP_FAILED
)
851 return (SCM
*) new_stack
;
855 new_stack
= allocate_stack (new_size
);
859 memcpy (new_stack
, old_stack
, old_size
* sizeof (SCM
));
860 free_stack (old_stack
, old_size
);
867 static struct scm_vm
*
869 #define FUNC_NAME "make_vm"
874 vp
= scm_gc_malloc (sizeof (struct scm_vm
), "vm");
876 vp
->stack_size
= page_size
/ sizeof (SCM
);
877 vp
->stack_base
= allocate_stack (vp
->stack_size
);
879 /* As in expand_stack, we don't have any way to throw an exception
880 if we can't allocate one measely page -- there's no stack to
881 handle it. For now, abort. */
883 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
;
884 vp
->overflow_handler_stack
= SCM_EOL
;
886 vp
->sp
= vp
->stack_base
- 1;
888 vp
->engine
= vm_default_engine
;
890 for (i
= 0; i
< SCM_VM_NUM_HOOKS
; i
++)
891 vp
->hooks
[i
] = SCM_BOOL_F
;
898 return_unused_stack_to_os (struct scm_vm
*vp
)
901 scm_t_uintptr start
= (scm_t_uintptr
) (vp
->sp
+ 1);
902 scm_t_uintptr end
= (scm_t_uintptr
) vp
->stack_limit
;
903 /* The second condition is needed to protect against wrap-around. */
904 if (vp
->sp_max_since_gc
< vp
->stack_limit
&& vp
->sp
< vp
->sp_max_since_gc
)
905 end
= (scm_t_uintptr
) (vp
->sp_max_since_gc
+ 1);
907 start
= ((start
- 1U) | (page_size
- 1U)) + 1U; /* round up */
908 end
= ((end
- 1U) | (page_size
- 1U)) + 1U; /* round up */
910 /* Return these pages to the OS. The next time they are paged in,
911 they will be zeroed. */
917 ret
= madvise ((void *) start
, end
- start
, MADV_DONTNEED
);
918 while (ret
&& errno
== -EAGAIN
);
921 perror ("madvise failed");
924 vp
->sp_max_since_gc
= vp
->sp
;
928 #define DEAD_SLOT_MAP_CACHE_SIZE 32U
929 struct dead_slot_map_cache_entry
932 const scm_t_uint8
*map
;
935 struct dead_slot_map_cache
937 struct dead_slot_map_cache_entry entries
[DEAD_SLOT_MAP_CACHE_SIZE
];
940 static const scm_t_uint8
*
941 find_dead_slot_map (scm_t_uint32
*ip
, struct dead_slot_map_cache
*cache
)
943 /* The lower two bits should be zero. FIXME: Use a better hash
944 function; we don't expose scm_raw_hashq currently. */
945 size_t slot
= (((scm_t_uintptr
) ip
) >> 2) % DEAD_SLOT_MAP_CACHE_SIZE
;
946 const scm_t_uint8
*map
;
948 if (cache
->entries
[slot
].ip
== ip
)
949 map
= cache
->entries
[slot
].map
;
952 map
= scm_find_dead_slot_map_unlocked (ip
);
953 cache
->entries
[slot
].ip
= ip
;
954 cache
->entries
[slot
].map
= map
;
960 /* Mark the VM stack region between its base and its current top. */
962 scm_i_vm_mark_stack (struct scm_vm
*vp
, struct GC_ms_entry
*mark_stack_ptr
,
963 struct GC_ms_entry
*mark_stack_limit
)
966 /* The first frame will be marked conservatively (without a dead
967 slot map). This is because GC can happen at any point within the
968 hottest activation, due to multiple threads or per-instruction
969 hooks, and providing dead slot maps for all points in a program
970 would take a prohibitive amount of space. */
971 const scm_t_uint8
*dead_slots
= NULL
;
972 scm_t_uintptr upper
= (scm_t_uintptr
) GC_greatest_plausible_heap_addr
;
973 scm_t_uintptr lower
= (scm_t_uintptr
) GC_least_plausible_heap_addr
;
974 struct dead_slot_map_cache cache
;
976 memset (&cache
, 0, sizeof (cache
));
978 for (fp
= vp
->fp
, sp
= vp
->sp
; fp
; fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
980 for (; sp
>= &SCM_FRAME_LOCAL (fp
, 0); sp
--)
984 && SCM_UNPACK (elt
) >= lower
&& SCM_UNPACK (elt
) <= upper
)
988 size_t slot
= sp
- &SCM_FRAME_LOCAL (fp
, 0);
989 if (dead_slots
[slot
/ 8U] & (1U << (slot
% 8U)))
991 /* This value may become dead as a result of GC,
992 so we can't just leave it on the stack. */
993 *sp
= SCM_UNSPECIFIED
;
998 mark_stack_ptr
= GC_mark_and_push ((void *) elt
,
1004 sp
= SCM_FRAME_PREVIOUS_SP (fp
);
1005 /* Inner frames may have a dead slots map for precise marking.
1006 Note that there may be other reasons to not have a dead slots
1007 map, e.g. if all of the frame's slots below the callee frame
1009 dead_slots
= find_dead_slot_map (SCM_FRAME_RETURN_ADDRESS (fp
), &cache
);
1012 return_unused_stack_to_os (vp
);
1014 return mark_stack_ptr
;
1017 /* Free the VM stack, as this thread is exiting. */
1019 scm_i_vm_free_stack (struct scm_vm
*vp
)
1021 free_stack (vp
->stack_base
, vp
->stack_size
);
1022 vp
->stack_base
= vp
->stack_limit
= NULL
;
1026 struct vm_expand_stack_data
1034 vm_expand_stack_inner (void *data_ptr
)
1036 struct vm_expand_stack_data
*data
= data_ptr
;
1038 struct scm_vm
*vp
= data
->vp
;
1039 SCM
*old_stack
, *new_stack
;
1041 scm_t_ptrdiff reloc
;
1043 new_size
= vp
->stack_size
;
1044 while (new_size
< data
->stack_size
)
1046 old_stack
= vp
->stack_base
;
1048 new_stack
= expand_stack (vp
->stack_base
, vp
->stack_size
, new_size
);
1052 vp
->stack_base
= new_stack
;
1053 vp
->stack_size
= new_size
;
1054 vp
->stack_limit
= vp
->stack_base
+ new_size
;
1055 reloc
= vp
->stack_base
- old_stack
;
1062 data
->new_sp
+= reloc
;
1066 SCM
*next_fp
= SCM_FRAME_DYNAMIC_LINK (fp
);
1070 SCM_FRAME_SET_DYNAMIC_LINK (fp
, next_fp
);
1079 static scm_t_ptrdiff
1080 current_overflow_size (struct scm_vm
*vp
)
1082 if (scm_is_pair (vp
->overflow_handler_stack
))
1083 return scm_to_ptrdiff_t (scm_caar (vp
->overflow_handler_stack
));
1088 should_handle_stack_overflow (struct scm_vm
*vp
, scm_t_ptrdiff stack_size
)
1090 scm_t_ptrdiff overflow_size
= current_overflow_size (vp
);
1091 return overflow_size
>= 0 && stack_size
>= overflow_size
;
1095 reset_stack_limit (struct scm_vm
*vp
)
1097 if (should_handle_stack_overflow (vp
, vp
->stack_size
))
1098 vp
->stack_limit
= vp
->stack_base
+ current_overflow_size (vp
);
1100 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
;
1103 struct overflow_handler_data
1106 SCM overflow_handler_stack
;
1110 wind_overflow_handler (void *ptr
)
1112 struct overflow_handler_data
*data
= ptr
;
1114 data
->vp
->overflow_handler_stack
= data
->overflow_handler_stack
;
1116 reset_stack_limit (data
->vp
);
1120 unwind_overflow_handler (void *ptr
)
1122 struct overflow_handler_data
*data
= ptr
;
1124 data
->vp
->overflow_handler_stack
= scm_cdr (data
->overflow_handler_stack
);
1126 reset_stack_limit (data
->vp
);
1130 vm_expand_stack (struct scm_vm
*vp
, SCM
*new_sp
)
1132 scm_t_ptrdiff stack_size
= new_sp
+ 1 - vp
->stack_base
;
1134 if (stack_size
> vp
->stack_size
)
1136 struct vm_expand_stack_data data
;
1139 data
.stack_size
= stack_size
;
1140 data
.new_sp
= new_sp
;
1142 if (!GC_call_with_alloc_lock (vm_expand_stack_inner
, &data
))
1143 /* Throw an unwind-only exception. */
1144 scm_report_stack_overflow ();
1146 new_sp
= data
.new_sp
;
1149 vp
->sp_max_since_gc
= vp
->sp
= new_sp
;
1151 if (should_handle_stack_overflow (vp
, stack_size
))
1153 SCM more_stack
, new_limit
;
1155 struct overflow_handler_data data
;
1157 data
.overflow_handler_stack
= vp
->overflow_handler_stack
;
1159 scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE
);
1161 scm_dynwind_rewind_handler (unwind_overflow_handler
, &data
,
1162 SCM_F_WIND_EXPLICITLY
);
1163 scm_dynwind_unwind_handler (wind_overflow_handler
, &data
,
1164 SCM_F_WIND_EXPLICITLY
);
1166 /* Call the overflow handler. */
1167 more_stack
= scm_call_0 (scm_cdar (data
.overflow_handler_stack
));
1169 /* If the overflow handler returns, its return value should be an
1170 integral number of words from the outer stack limit to transfer
1171 to the inner limit. */
1172 if (scm_to_ptrdiff_t (more_stack
) <= 0)
1173 scm_out_of_range (NULL
, more_stack
);
1174 new_limit
= scm_sum (scm_caar (data
.overflow_handler_stack
), more_stack
);
1175 if (scm_is_pair (scm_cdr (data
.overflow_handler_stack
)))
1176 new_limit
= scm_min (new_limit
,
1177 scm_caadr (data
.overflow_handler_stack
));
1179 /* Ensure the new limit is in range. */
1180 scm_to_ptrdiff_t (new_limit
);
1182 /* Increase the limit that we will restore. */
1183 scm_set_car_x (scm_car (data
.overflow_handler_stack
), new_limit
);
1188 return vm_expand_stack (vp
, new_sp
);
1192 static struct scm_vm
*
1193 thread_vm (scm_i_thread
*t
)
1195 if (SCM_UNLIKELY (!t
->vp
))
1204 return thread_vm (SCM_I_CURRENT_THREAD
);
1208 scm_call_n (SCM proc
, SCM
*argv
, size_t nargs
)
1210 scm_i_thread
*thread
;
1213 ptrdiff_t base_frame_size
;
1214 /* Cached variables. */
1215 scm_i_jmp_buf registers
; /* used for prompts */
1218 thread
= SCM_I_CURRENT_THREAD
;
1219 vp
= thread_vm (thread
);
1223 /* Check that we have enough space: 3 words for the boot continuation,
1224 and 3 + nargs for the procedure application. */
1225 base_frame_size
= 3 + 3 + nargs
;
1226 vm_push_sp (vp
, vp
->sp
+ base_frame_size
);
1227 base
= vp
->sp
+ 1 - base_frame_size
;
1229 /* Since it's possible to receive the arguments on the stack itself,
1230 shuffle up the arguments first. */
1231 for (i
= nargs
; i
> 0; i
--)
1232 base
[6 + i
- 1] = argv
[i
- 1];
1234 /* Push the boot continuation, which calls PROC and returns its
1236 base
[0] = SCM_PACK (vp
->fp
); /* dynamic link */
1237 base
[1] = SCM_PACK (vp
->ip
); /* ra */
1238 base
[2] = vm_boot_continuation
;
1240 vp
->ip
= (scm_t_uint32
*) vm_boot_continuation_code
;
1242 /* The pending call to PROC. */
1243 base
[3] = SCM_PACK (vp
->fp
); /* dynamic link */
1244 base
[4] = SCM_PACK (vp
->ip
); /* ra */
1249 int resume
= SCM_I_SETJMP (registers
);
1251 if (SCM_UNLIKELY (resume
))
1253 scm_gc_after_nonlocal_exit ();
1254 /* Non-local return. */
1255 vm_dispatch_abort_hook (vp
);
1258 return vm_engines
[vp
->engine
](thread
, vp
, ®isters
, resume
);
1262 /* Scheme interface */
1264 #define VM_DEFINE_HOOK(n) \
1266 struct scm_vm *vp; \
1267 vp = scm_the_vm (); \
1268 if (scm_is_false (vp->hooks[n])) \
1269 vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
1270 return vp->hooks[n]; \
1273 SCM_DEFINE (scm_vm_apply_hook
, "vm-apply-hook", 0, 0, 0,
1276 #define FUNC_NAME s_scm_vm_apply_hook
1278 VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK
);
1282 SCM_DEFINE (scm_vm_push_continuation_hook
, "vm-push-continuation-hook", 0, 0, 0,
1285 #define FUNC_NAME s_scm_vm_push_continuation_hook
1287 VM_DEFINE_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK
);
1291 SCM_DEFINE (scm_vm_pop_continuation_hook
, "vm-pop-continuation-hook", 0, 0, 0,
1294 #define FUNC_NAME s_scm_vm_pop_continuation_hook
1296 VM_DEFINE_HOOK (SCM_VM_POP_CONTINUATION_HOOK
);
1300 SCM_DEFINE (scm_vm_next_hook
, "vm-next-hook", 0, 0, 0,
1303 #define FUNC_NAME s_scm_vm_next_hook
1305 VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK
);
1309 SCM_DEFINE (scm_vm_abort_continuation_hook
, "vm-abort-continuation-hook", 0, 0, 0,
1312 #define FUNC_NAME s_scm_vm_abort_continuation_hook
1314 VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK
);
1318 SCM_DEFINE (scm_vm_trace_level
, "vm-trace-level", 0, 0, 0,
1321 #define FUNC_NAME s_scm_vm_trace_level
1323 return scm_from_int (scm_the_vm ()->trace_level
);
1327 SCM_DEFINE (scm_set_vm_trace_level_x
, "set-vm-trace-level!", 1, 0, 0,
1330 #define FUNC_NAME s_scm_set_vm_trace_level_x
1332 scm_the_vm ()->trace_level
= scm_to_int (level
);
1333 return SCM_UNSPECIFIED
;
1343 symbol_to_vm_engine (SCM engine
, const char *FUNC_NAME
)
1345 if (scm_is_eq (engine
, sym_regular
))
1346 return SCM_VM_REGULAR_ENGINE
;
1347 else if (scm_is_eq (engine
, sym_debug
))
1348 return SCM_VM_DEBUG_ENGINE
;
1350 SCM_MISC_ERROR ("Unknown VM engine: ~a", scm_list_1 (engine
));
1354 vm_engine_to_symbol (int engine
, const char *FUNC_NAME
)
1358 case SCM_VM_REGULAR_ENGINE
:
1360 case SCM_VM_DEBUG_ENGINE
:
1364 SCM_MISC_ERROR ("Unknown VM engine: ~a",
1365 scm_list_1 (scm_from_int (engine
)));
1369 SCM_DEFINE (scm_vm_engine
, "vm-engine", 0, 0, 0,
1372 #define FUNC_NAME s_scm_vm_engine
1374 return vm_engine_to_symbol (scm_the_vm ()->engine
, FUNC_NAME
);
1379 scm_c_set_vm_engine_x (int engine
)
1380 #define FUNC_NAME "set-vm-engine!"
1382 if (engine
< 0 || engine
>= SCM_VM_NUM_ENGINES
)
1383 SCM_MISC_ERROR ("Unknown VM engine: ~a",
1384 scm_list_1 (scm_from_int (engine
)));
1386 scm_the_vm ()->engine
= engine
;
1390 SCM_DEFINE (scm_set_vm_engine_x
, "set-vm-engine!", 1, 0, 0,
1393 #define FUNC_NAME s_scm_set_vm_engine_x
1395 scm_c_set_vm_engine_x (symbol_to_vm_engine (engine
, FUNC_NAME
));
1396 return SCM_UNSPECIFIED
;
1401 scm_c_set_default_vm_engine_x (int engine
)
1402 #define FUNC_NAME "set-default-vm-engine!"
1404 if (engine
< 0 || engine
>= SCM_VM_NUM_ENGINES
)
1405 SCM_MISC_ERROR ("Unknown VM engine: ~a",
1406 scm_list_1 (scm_from_int (engine
)));
1408 vm_default_engine
= engine
;
1412 SCM_DEFINE (scm_set_default_vm_engine_x
, "set-default-vm-engine!", 1, 0, 0,
1415 #define FUNC_NAME s_scm_set_default_vm_engine_x
1417 scm_c_set_default_vm_engine_x (symbol_to_vm_engine (engine
, FUNC_NAME
));
1418 return SCM_UNSPECIFIED
;
1422 /* FIXME: This function makes no sense, but we keep it to make sure we
1423 have a way of switching to the debug or regular VM. */
1424 SCM_DEFINE (scm_call_with_vm
, "call-with-vm", 1, 0, 1,
1425 (SCM proc
, SCM args
),
1426 "Apply @var{proc} to @var{args} in a dynamic extent in which\n"
1427 "@var{vm} is the current VM.")
1428 #define FUNC_NAME s_scm_call_with_vm
1430 return scm_apply_0 (proc
, args
);
1434 SCM_DEFINE (scm_call_with_stack_overflow_handler
,
1435 "call-with-stack-overflow-handler", 3, 0, 0,
1436 (SCM limit
, SCM thunk
, SCM handler
),
1437 "Call @var{thunk} in an environment in which the stack limit has\n"
1438 "been reduced to @var{limit} additional words. If the limit is\n"
1439 "reached, @var{handler} (a thunk) will be invoked in the dynamic\n"
1440 "environment of the error. For the extent of the call to\n"
1441 "@var{handler}, the stack limit and handler are restored to the\n"
1442 "values that were in place when\n"
1443 "@code{call-with-stack-overflow-handler} was called.")
1444 #define FUNC_NAME s_scm_call_with_stack_overflow_handler
1447 scm_t_ptrdiff c_limit
, stack_size
;
1448 struct overflow_handler_data data
;
1452 stack_size
= vp
->sp
- vp
->stack_base
;
1454 c_limit
= scm_to_ptrdiff_t (limit
);
1456 scm_out_of_range (FUNC_NAME
, limit
);
1458 new_limit
= scm_sum (scm_from_ptrdiff_t (stack_size
), limit
);
1459 if (scm_is_pair (vp
->overflow_handler_stack
))
1460 new_limit
= scm_min (new_limit
, scm_caar (vp
->overflow_handler_stack
));
1462 /* Hacky check that the current stack depth plus the limit is within
1463 the range of a ptrdiff_t. */
1464 scm_to_ptrdiff_t (new_limit
);
1467 data
.overflow_handler_stack
=
1468 scm_acons (limit
, handler
, vp
->overflow_handler_stack
);
1470 scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE
);
1472 scm_dynwind_rewind_handler (wind_overflow_handler
, &data
,
1473 SCM_F_WIND_EXPLICITLY
);
1474 scm_dynwind_unwind_handler (unwind_overflow_handler
, &data
,
1475 SCM_F_WIND_EXPLICITLY
);
1477 /* Reset vp->sp_max_since_gc so that the VM checks actually
1479 return_unused_stack_to_os (vp
);
1481 ret
= scm_call_0 (thunk
);
1495 scm_load_compiled_with_vm (SCM file
)
1497 return scm_call_0 (scm_load_thunk_from_file (file
));
1502 scm_init_vm_builtin_properties (void)
1504 /* FIXME: Seems hacky to do this here, but oh well :/ */
1505 scm_sym_apply
= scm_from_utf8_symbol ("apply");
1506 scm_sym_values
= scm_from_utf8_symbol ("values");
1507 scm_sym_abort_to_prompt
= scm_from_utf8_symbol ("abort-to-prompt");
1508 scm_sym_call_with_values
= scm_from_utf8_symbol ("call-with-values");
1509 scm_sym_call_with_current_continuation
=
1510 scm_from_utf8_symbol ("call-with-current-continuation");
1512 #define INIT_BUILTIN(builtin, BUILTIN, req, opt, rest) \
1513 scm_set_procedure_property_x (vm_builtin_##builtin, scm_sym_name, \
1514 scm_sym_##builtin); \
1515 scm_set_procedure_minimum_arity_x (vm_builtin_##builtin, \
1516 SCM_I_MAKINUM (req), \
1517 SCM_I_MAKINUM (opt), \
1518 scm_from_bool (rest));
1519 FOR_EACH_VM_BUILTIN (INIT_BUILTIN
);
1524 scm_bootstrap_vm (void)
1526 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1528 (scm_t_extension_init_func
)scm_init_vm
, NULL
);
1529 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1530 "scm_init_vm_builtins",
1531 (scm_t_extension_init_func
)scm_init_vm_builtins
,
1534 page_size
= getpagesize ();
1535 /* page_size should be a power of two. */
1536 if (page_size
& (page_size
- 1))
1539 sym_vm_run
= scm_from_latin1_symbol ("vm-run");
1540 sym_vm_error
= scm_from_latin1_symbol ("vm-error");
1541 sym_keyword_argument_error
= scm_from_latin1_symbol ("keyword-argument-error");
1542 sym_regular
= scm_from_latin1_symbol ("regular");
1543 sym_debug
= scm_from_latin1_symbol ("debug");
1545 vm_boot_continuation
= scm_i_make_program (vm_boot_continuation_code
);
1546 SCM_SET_CELL_WORD_0 (vm_boot_continuation
,
1547 (SCM_CELL_WORD_0 (vm_boot_continuation
)
1548 | SCM_F_PROGRAM_IS_BOOT
));
1550 #define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest) \
1551 vm_builtin_##builtin = scm_i_make_program (vm_builtin_##builtin##_code);
1552 FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN
);
1553 #undef DEFINE_BUILTIN
1559 #ifndef SCM_MAGIC_SNARFER
1560 #include "libguile/vm.x"