1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 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 "instructions.h"
48 #include "vm-builtins.h"
50 static int vm_default_engine
= SCM_VM_REGULAR_ENGINE
;
52 /* Unfortunately we can't snarf these: snarfed things are only loaded up from
53 (system vm vm), which might not be loaded before an error happens. */
54 static SCM sym_vm_run
;
55 static SCM sym_vm_error
;
56 static SCM sym_keyword_argument_error
;
57 static SCM sym_regular
;
61 static size_t page_size
;
63 /* The VM has a number of internal assertions that shouldn't normally be
64 necessary, but might be if you think you found a bug in the VM. */
65 /* #define VM_ENABLE_ASSERTIONS */
67 static void vm_expand_stack (struct scm_vm
*vp
, SCM
*new_sp
) SCM_NOINLINE
;
69 /* RESTORE is for the case where we know we have done a PUSH of equal or
70 greater stack size in the past. Otherwise PUSH is the thing, which
71 may expand the stack. */
72 enum vm_increase_sp_kind
{ VM_SP_PUSH
, VM_SP_RESTORE
};
75 vm_increase_sp (struct scm_vm
*vp
, SCM
*new_sp
, enum vm_increase_sp_kind kind
)
77 if (new_sp
<= vp
->sp_max_since_gc
)
83 if (kind
== VM_SP_PUSH
&& new_sp
>= vp
->stack_limit
)
84 vm_expand_stack (vp
, new_sp
);
86 vp
->sp_max_since_gc
= vp
->sp
= new_sp
;
90 vm_push_sp (struct scm_vm
*vp
, SCM
*new_sp
)
92 vm_increase_sp (vp
, new_sp
, VM_SP_PUSH
);
96 vm_restore_sp (struct scm_vm
*vp
, SCM
*new_sp
)
98 vm_increase_sp (vp
, new_sp
, VM_SP_RESTORE
);
107 scm_i_vm_cont_print (SCM x
, SCM port
, scm_print_state
*pstate
)
109 scm_puts_unlocked ("#<vm-continuation ", port
);
110 scm_uintprint (SCM_UNPACK (x
), 16, port
);
111 scm_puts_unlocked (">", port
);
115 scm_i_vm_cont_to_frame (SCM cont
, struct scm_frame
*frame
)
117 struct scm_vm_cont
*data
= SCM_VM_CONT_DATA (cont
);
119 frame
->stack_holder
= data
;
120 frame
->fp_offset
= (data
->fp
+ data
->reloc
) - data
->stack_base
;
121 frame
->sp_offset
= (data
->sp
+ data
->reloc
) - data
->stack_base
;
122 frame
->ip
= data
->ra
;
127 /* Ideally we could avoid copying the C stack if the continuation root
128 is inside VM code, and call/cc was invoked within that same call to
129 vm_run. That's currently not implemented. */
131 scm_i_vm_capture_stack (SCM
*stack_base
, SCM
*fp
, SCM
*sp
, scm_t_uint32
*ra
,
132 scm_t_dynstack
*dynstack
, scm_t_uint32 flags
)
134 struct scm_vm_cont
*p
;
136 p
= scm_gc_malloc (sizeof (*p
), "capture_vm_cont");
137 p
->stack_size
= sp
- stack_base
+ 1;
138 p
->stack_base
= scm_gc_malloc (p
->stack_size
* sizeof (SCM
),
143 memcpy (p
->stack_base
, stack_base
, (sp
+ 1 - stack_base
) * sizeof (SCM
));
144 p
->reloc
= p
->stack_base
- stack_base
;
145 p
->dynstack
= dynstack
;
147 return scm_cell (scm_tc7_vm_cont
, (scm_t_bits
)p
);
150 struct return_to_continuation_data
152 struct scm_vm_cont
*cp
;
156 /* Called with the GC lock to prevent the stack marker from traversing a
157 stack in an inconsistent state. */
159 vm_return_to_continuation_inner (void *data_ptr
)
161 struct return_to_continuation_data
*data
= data_ptr
;
162 struct scm_vm
*vp
= data
->vp
;
163 struct scm_vm_cont
*cp
= data
->cp
;
166 /* We know that there is enough space for the continuation, because we
167 captured it in the past. However there may have been an expansion
168 since the capture, so we may have to re-link the frame
170 reloc
= (vp
->stack_base
- (cp
->stack_base
- cp
->reloc
));
171 vp
->fp
= cp
->fp
+ reloc
;
172 memcpy (vp
->stack_base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
173 vm_restore_sp (vp
, cp
->sp
+ reloc
);
180 SCM
*next_fp
= SCM_FRAME_DYNAMIC_LINK (fp
);
184 SCM_FRAME_SET_DYNAMIC_LINK (fp
, next_fp
);
194 vm_return_to_continuation (struct scm_vm
*vp
, SCM cont
, size_t n
, SCM
*argv
)
196 struct scm_vm_cont
*cp
;
198 struct return_to_continuation_data data
;
200 argv_copy
= alloca (n
* sizeof(SCM
));
201 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
203 cp
= SCM_VM_CONT_DATA (cont
);
207 GC_call_with_alloc_lock (vm_return_to_continuation_inner
, &data
);
209 /* Now we have the continuation properly copied over. We just need to
210 copy the arguments. It is not guaranteed that there is actually
211 space for the arguments, though, so we have to bump the SP first. */
212 vm_push_sp (vp
, vp
->sp
+ 3 + n
);
214 /* Now copy on an empty frame and the return values, as the
215 continuation expects. */
217 SCM
*base
= vp
->sp
+ 1 - 3 - n
;
220 for (i
= 0; i
< 3; i
++)
221 base
[i
] = SCM_BOOL_F
;
223 for (i
= 0; i
< n
; i
++)
224 base
[i
+ 3] = argv_copy
[i
];
230 static struct scm_vm
* thread_vm (scm_i_thread
*t
);
232 scm_i_capture_current_stack (void)
234 scm_i_thread
*thread
;
237 thread
= SCM_I_CURRENT_THREAD
;
238 vp
= thread_vm (thread
);
240 return scm_i_vm_capture_stack (vp
->stack_base
, vp
->fp
, vp
->sp
, vp
->ip
,
241 scm_dynstack_capture_all (&thread
->dynstack
),
245 static void vm_dispatch_apply_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
246 static void vm_dispatch_push_continuation_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
247 static void vm_dispatch_pop_continuation_hook (struct scm_vm
*vp
, SCM
*old_fp
) SCM_NOINLINE
;
248 static void vm_dispatch_next_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
249 static void vm_dispatch_abort_hook (struct scm_vm
*vp
) SCM_NOINLINE
;
252 vm_dispatch_hook (struct scm_vm
*vp
, int hook_num
, SCM
*argv
, int n
)
255 struct scm_frame c_frame
;
257 int saved_trace_level
;
259 hook
= vp
->hooks
[hook_num
];
261 if (SCM_LIKELY (scm_is_false (hook
))
262 || scm_is_null (SCM_HOOK_PROCEDURES (hook
)))
265 saved_trace_level
= vp
->trace_level
;
268 /* Allocate a frame object on the stack. This is more efficient than calling
269 `scm_c_make_frame ()' to allocate on the heap, but it forces hooks to not
270 capture frame objects.
272 At the same time, procedures such as `frame-procedure' make sense only
273 while the stack frame represented by the frame object is visible, so it
274 seems reasonable to limit the lifetime of frame objects. */
276 c_frame
.stack_holder
= vp
;
277 c_frame
.fp_offset
= vp
->fp
- vp
->stack_base
;
278 c_frame
.sp_offset
= vp
->sp
- vp
->stack_base
;
281 /* Arrange for FRAME to be 8-byte aligned, like any other cell. */
282 frame
= alloca (sizeof (*frame
) + 8);
283 frame
= (scm_t_cell
*) ROUND_UP ((scm_t_uintptr
) frame
, 8UL);
285 frame
->word_0
= SCM_PACK (scm_tc7_frame
| (SCM_VM_FRAME_KIND_VM
<< 8));
286 frame
->word_1
= SCM_PACK_POINTER (&c_frame
);
292 args
[0] = SCM_PACK_POINTER (frame
);
293 scm_c_run_hookn (hook
, args
, 1);
299 args
[0] = SCM_PACK_POINTER (frame
);
301 scm_c_run_hookn (hook
, args
, 2);
308 args
= scm_cons (argv
[n
], args
);
309 scm_c_run_hook (hook
, scm_cons (SCM_PACK_POINTER (frame
), args
));
312 vp
->trace_level
= saved_trace_level
;
316 vm_dispatch_apply_hook (struct scm_vm
*vp
)
318 return vm_dispatch_hook (vp
, SCM_VM_APPLY_HOOK
, NULL
, 0);
320 static void vm_dispatch_push_continuation_hook (struct scm_vm
*vp
)
322 return vm_dispatch_hook (vp
, SCM_VM_PUSH_CONTINUATION_HOOK
, NULL
, 0);
324 static void vm_dispatch_pop_continuation_hook (struct scm_vm
*vp
, SCM
*old_fp
)
326 return vm_dispatch_hook (vp
, SCM_VM_POP_CONTINUATION_HOOK
,
327 &SCM_FRAME_LOCAL (old_fp
, 1),
328 SCM_FRAME_NUM_LOCALS (old_fp
, vp
->sp
) - 1);
330 static void vm_dispatch_next_hook (struct scm_vm
*vp
)
332 return vm_dispatch_hook (vp
, SCM_VM_NEXT_HOOK
, NULL
, 0);
334 static void vm_dispatch_abort_hook (struct scm_vm
*vp
)
336 return vm_dispatch_hook (vp
, SCM_VM_ABORT_CONTINUATION_HOOK
,
337 &SCM_FRAME_LOCAL (vp
->fp
, 1),
338 SCM_FRAME_NUM_LOCALS (vp
->fp
, vp
->sp
) - 1);
342 vm_abort (struct scm_vm
*vp
, SCM tag
,
343 size_t nstack
, SCM
*stack_args
, SCM tail
, SCM
*sp
,
344 scm_i_jmp_buf
*current_registers
) SCM_NORETURN
;
347 vm_abort (struct scm_vm
*vp
, SCM tag
,
348 size_t nstack
, SCM
*stack_args
, SCM tail
, SCM
*sp
,
349 scm_i_jmp_buf
*current_registers
)
355 tail_len
= scm_ilength (tail
);
357 scm_misc_error ("vm-engine", "tail values to abort should be a list",
360 argv
= alloca ((nstack
+ tail_len
) * sizeof (SCM
));
361 for (i
= 0; i
< nstack
; i
++)
362 argv
[i
] = stack_args
[i
];
363 for (; i
< nstack
+ tail_len
; i
++, tail
= scm_cdr (tail
))
364 argv
[i
] = scm_car (tail
);
368 scm_c_abort (vp
, tag
, nstack
+ tail_len
, argv
, current_registers
);
371 struct vm_reinstate_partial_continuation_data
374 struct scm_vm_cont
*cp
;
379 vm_reinstate_partial_continuation_inner (void *data_ptr
)
381 struct vm_reinstate_partial_continuation_data
*data
= data_ptr
;
382 struct scm_vm
*vp
= data
->vp
;
383 struct scm_vm_cont
*cp
= data
->cp
;
387 base
= SCM_FRAME_LOCALS_ADDRESS (vp
->fp
);
388 reloc
= cp
->reloc
+ (base
- cp
->stack_base
);
390 memcpy (base
, cp
->stack_base
, cp
->stack_size
* sizeof (SCM
));
392 vp
->fp
= cp
->fp
+ reloc
;
395 /* now relocate frame pointers */
399 SCM_FRAME_LOWER_ADDRESS (fp
) >= base
;
400 fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
401 SCM_FRAME_SET_DYNAMIC_LINK (fp
, SCM_FRAME_DYNAMIC_LINK (fp
) + reloc
);
410 vm_reinstate_partial_continuation (struct scm_vm
*vp
, SCM cont
,
412 scm_t_dynstack
*dynstack
,
413 scm_i_jmp_buf
*registers
)
415 struct vm_reinstate_partial_continuation_data data
;
416 struct scm_vm_cont
*cp
;
421 argv_copy
= alloca (n
* sizeof(SCM
));
422 memcpy (argv_copy
, argv
, n
* sizeof(SCM
));
424 cp
= SCM_VM_CONT_DATA (cont
);
426 vm_push_sp (vp
, SCM_FRAME_LOCALS_ADDRESS (vp
->fp
) + cp
->stack_size
+ n
- 1);
430 GC_call_with_alloc_lock (vm_reinstate_partial_continuation_inner
, &data
);
433 /* Push the arguments. */
434 for (i
= 0; i
< n
; i
++)
435 vp
->sp
[i
+ 1 - n
] = argv_copy
[i
];
437 /* The prompt captured a slice of the dynamic stack. Here we wind
438 those entries onto the current thread's stack. We also have to
439 relocate any prompts that we see along the way. */
443 for (walk
= SCM_DYNSTACK_FIRST (cp
->dynstack
);
444 SCM_DYNSTACK_TAG (walk
);
445 walk
= SCM_DYNSTACK_NEXT (walk
))
447 scm_t_bits tag
= SCM_DYNSTACK_TAG (walk
);
449 if (SCM_DYNSTACK_TAG_TYPE (tag
) == SCM_DYNSTACK_TYPE_PROMPT
)
450 scm_dynstack_wind_prompt (dynstack
, walk
, reloc
, registers
);
452 scm_dynstack_wind_1 (dynstack
, walk
);
462 static void vm_error (const char *msg
, SCM arg
) SCM_NORETURN
;
463 static void vm_error_bad_instruction (scm_t_uint32 inst
) SCM_NORETURN SCM_NOINLINE
;
464 static void vm_error_unbound (SCM sym
) SCM_NORETURN SCM_NOINLINE
;
465 static void vm_error_unbound_fluid (SCM fluid
) SCM_NORETURN SCM_NOINLINE
;
466 static void vm_error_not_a_variable (const char *func_name
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
467 static void vm_error_apply_to_non_list (SCM x
) SCM_NORETURN SCM_NOINLINE
;
468 static void vm_error_kwargs_length_not_even (SCM proc
) SCM_NORETURN SCM_NOINLINE
;
469 static void vm_error_kwargs_invalid_keyword (SCM proc
, SCM obj
) SCM_NORETURN SCM_NOINLINE
;
470 static void vm_error_kwargs_unrecognized_keyword (SCM proc
, SCM kw
) SCM_NORETURN SCM_NOINLINE
;
471 static void vm_error_too_many_args (int nargs
) SCM_NORETURN SCM_NOINLINE
;
472 static void vm_error_wrong_num_args (SCM proc
) SCM_NORETURN SCM_NOINLINE
;
473 static void vm_error_wrong_type_apply (SCM proc
) SCM_NORETURN SCM_NOINLINE
;
474 static void vm_error_stack_underflow (void) SCM_NORETURN SCM_NOINLINE
;
475 static void vm_error_improper_list (SCM x
) SCM_NORETURN SCM_NOINLINE
;
476 static void vm_error_not_a_pair (const char *subr
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
477 static void vm_error_not_a_bytevector (const char *subr
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
478 static void vm_error_not_a_struct (const char *subr
, SCM x
) SCM_NORETURN SCM_NOINLINE
;
479 static void vm_error_not_a_vector (const char *subr
, SCM v
) SCM_NORETURN SCM_NOINLINE
;
480 static void vm_error_out_of_range (const char *subr
, SCM k
) SCM_NORETURN SCM_NOINLINE
;
481 static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE
;
482 static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE
;
483 static void vm_error_wrong_number_of_values (scm_t_uint32 expected
) SCM_NORETURN SCM_NOINLINE
;
484 static void vm_error_continuation_not_rewindable (SCM cont
) SCM_NORETURN SCM_NOINLINE
;
485 static void vm_error_bad_wide_string_length (size_t len
) SCM_NORETURN SCM_NOINLINE
;
488 vm_error (const char *msg
, SCM arg
)
490 scm_throw (sym_vm_error
,
491 scm_list_3 (sym_vm_run
, scm_from_latin1_string (msg
),
492 SCM_UNBNDP (arg
) ? SCM_EOL
: scm_list_1 (arg
)));
493 abort(); /* not reached */
497 vm_error_bad_instruction (scm_t_uint32 inst
)
499 vm_error ("VM: Bad instruction: ~s", scm_from_uint32 (inst
));
503 vm_error_unbound (SCM sym
)
505 scm_error_scm (scm_misc_error_key
, SCM_BOOL_F
,
506 scm_from_latin1_string ("Unbound variable: ~s"),
507 scm_list_1 (sym
), SCM_BOOL_F
);
511 vm_error_unbound_fluid (SCM fluid
)
513 scm_error_scm (scm_misc_error_key
, SCM_BOOL_F
,
514 scm_from_latin1_string ("Unbound fluid: ~s"),
515 scm_list_1 (fluid
), SCM_BOOL_F
);
519 vm_error_not_a_variable (const char *func_name
, SCM x
)
521 scm_error (scm_arg_type_key
, func_name
, "Not a variable: ~S",
522 scm_list_1 (x
), scm_list_1 (x
));
526 vm_error_apply_to_non_list (SCM x
)
528 scm_error (scm_arg_type_key
, "apply", "Apply to non-list: ~S",
529 scm_list_1 (x
), scm_list_1 (x
));
533 vm_error_kwargs_length_not_even (SCM proc
)
535 scm_error_scm (sym_keyword_argument_error
, proc
,
536 scm_from_latin1_string ("Odd length of keyword argument list"),
537 SCM_EOL
, SCM_BOOL_F
);
541 vm_error_kwargs_invalid_keyword (SCM proc
, SCM obj
)
543 scm_error_scm (sym_keyword_argument_error
, proc
,
544 scm_from_latin1_string ("Invalid keyword"),
545 SCM_EOL
, scm_list_1 (obj
));
549 vm_error_kwargs_unrecognized_keyword (SCM proc
, SCM kw
)
551 scm_error_scm (sym_keyword_argument_error
, proc
,
552 scm_from_latin1_string ("Unrecognized keyword"),
553 SCM_EOL
, scm_list_1 (kw
));
557 vm_error_too_many_args (int nargs
)
559 vm_error ("VM: Too many arguments", scm_from_int (nargs
));
563 vm_error_wrong_num_args (SCM proc
)
565 scm_wrong_num_args (proc
);
569 vm_error_wrong_type_apply (SCM proc
)
571 scm_error (scm_arg_type_key
, NULL
, "Wrong type to apply: ~S",
572 scm_list_1 (proc
), scm_list_1 (proc
));
576 vm_error_stack_underflow (void)
578 vm_error ("VM: Stack underflow", SCM_UNDEFINED
);
582 vm_error_improper_list (SCM x
)
584 vm_error ("Expected a proper list, but got object with tail ~s", x
);
588 vm_error_not_a_pair (const char *subr
, SCM x
)
590 scm_wrong_type_arg_msg (subr
, 1, x
, "pair");
594 vm_error_not_a_bytevector (const char *subr
, SCM x
)
596 scm_wrong_type_arg_msg (subr
, 1, x
, "bytevector");
600 vm_error_not_a_struct (const char *subr
, SCM x
)
602 scm_wrong_type_arg_msg (subr
, 1, x
, "struct");
606 vm_error_not_a_vector (const char *subr
, SCM x
)
608 scm_wrong_type_arg_msg (subr
, 1, x
, "vector");
612 vm_error_out_of_range (const char *subr
, SCM k
)
615 scm_out_of_range (subr
, k
);
619 vm_error_no_values (void)
621 vm_error ("Zero values returned to single-valued continuation",
626 vm_error_not_enough_values (void)
628 vm_error ("Too few values returned to continuation", SCM_UNDEFINED
);
632 vm_error_wrong_number_of_values (scm_t_uint32 expected
)
634 vm_error ("Wrong number of values returned to continuation (expected ~a)",
635 scm_from_uint32 (expected
));
639 vm_error_continuation_not_rewindable (SCM cont
)
641 vm_error ("Unrewindable partial continuation", cont
);
645 vm_error_bad_wide_string_length (size_t len
)
647 vm_error ("VM: Bad wide string length: ~S", scm_from_size_t (len
));
653 static SCM vm_boot_continuation
;
654 static SCM vm_builtin_apply
;
655 static SCM vm_builtin_values
;
656 static SCM vm_builtin_abort_to_prompt
;
657 static SCM vm_builtin_call_with_values
;
658 static SCM vm_builtin_call_with_current_continuation
;
660 static const scm_t_uint32 vm_boot_continuation_code
[] = {
661 SCM_PACK_OP_24 (halt
, 0)
664 static const scm_t_uint32 vm_builtin_apply_code
[] = {
665 SCM_PACK_OP_24 (assert_nargs_ge
, 3),
666 SCM_PACK_OP_24 (tail_apply
, 0), /* proc in r1, args from r2 */
669 static const scm_t_uint32 vm_builtin_values_code
[] = {
670 SCM_PACK_OP_24 (return_values
, 0) /* vals from r1 */
673 static const scm_t_uint32 vm_builtin_abort_to_prompt_code
[] = {
674 SCM_PACK_OP_24 (assert_nargs_ge
, 2),
675 SCM_PACK_OP_24 (abort
, 0), /* tag in r1, vals from r2 */
676 /* FIXME: Partial continuation should capture caller regs. */
677 SCM_PACK_OP_24 (return_values
, 0) /* vals from r1 */
680 static const scm_t_uint32 vm_builtin_call_with_values_code
[] = {
681 SCM_PACK_OP_24 (assert_nargs_ee
, 3),
682 SCM_PACK_OP_24 (alloc_frame
, 7),
683 SCM_PACK_OP_12_12 (mov
, 6, 1),
684 SCM_PACK_OP_24 (call
, 6), SCM_PACK_OP_ARG_8_24 (0, 1),
685 SCM_PACK_OP_12_12 (mov
, 0, 2),
686 SCM_PACK_OP_24 (tail_call_shuffle
, 7)
689 static const scm_t_uint32 vm_builtin_call_with_current_continuation_code
[] = {
690 SCM_PACK_OP_24 (assert_nargs_ee
, 2),
691 SCM_PACK_OP_24 (call_cc
, 0)
696 scm_vm_builtin_ref (unsigned idx
)
700 #define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest) \
701 case SCM_VM_BUILTIN_##BUILTIN: return vm_builtin_##builtin;
702 FOR_EACH_VM_BUILTIN(INDEX_TO_NAME
)
709 static SCM scm_sym_values
;
710 static SCM scm_sym_abort_to_prompt
;
711 static SCM scm_sym_call_with_values
;
712 static SCM scm_sym_call_with_current_continuation
;
715 scm_vm_builtin_name_to_index (SCM name
)
716 #define FUNC_NAME "builtin-name->index"
718 SCM_VALIDATE_SYMBOL (1, name
);
720 #define NAME_TO_INDEX(builtin, BUILTIN, req, opt, rest) \
721 if (scm_is_eq (name, scm_sym_##builtin)) \
722 return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN);
723 FOR_EACH_VM_BUILTIN(NAME_TO_INDEX
)
731 scm_vm_builtin_index_to_name (SCM index
)
732 #define FUNC_NAME "builtin-index->name"
736 SCM_VALIDATE_UINT_COPY (1, index
, idx
);
740 #define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest) \
741 case SCM_VM_BUILTIN_##BUILTIN: return scm_sym_##builtin;
742 FOR_EACH_VM_BUILTIN(INDEX_TO_NAME
)
744 default: return SCM_BOOL_F
;
750 scm_init_vm_builtins (void)
752 scm_c_define_gsubr ("builtin-name->index", 1, 0, 0,
753 scm_vm_builtin_name_to_index
);
754 scm_c_define_gsubr ("builtin-index->name", 1, 0, 0,
755 scm_vm_builtin_index_to_name
);
759 scm_i_call_with_current_continuation (SCM proc
)
761 return scm_call_1 (vm_builtin_call_with_current_continuation
, proc
);
769 #define VM_NAME vm_regular_engine
770 #define VM_USE_HOOKS 0
771 #define FUNC_NAME "vm-regular-engine"
772 #include "vm-engine.c"
777 #define VM_NAME vm_debug_engine
778 #define VM_USE_HOOKS 1
779 #define FUNC_NAME "vm-debug-engine"
780 #include "vm-engine.c"
785 typedef SCM (*scm_t_vm_engine
) (scm_i_thread
*current_thread
, struct scm_vm
*vp
,
786 scm_i_jmp_buf
*registers
, int resume
);
788 static const scm_t_vm_engine vm_engines
[SCM_VM_NUM_ENGINES
] =
789 { vm_regular_engine
, vm_debug_engine
};
792 allocate_stack (size_t size
)
793 #define FUNC_NAME "make_vm"
797 if (size
>= ((size_t) -1) / sizeof (SCM
))
800 size
*= sizeof (SCM
);
803 ret
= mmap (NULL
, size
, PROT_READ
| PROT_WRITE
,
804 MAP_PRIVATE
| MAP_ANONYMOUS
, -1, 0);
805 if (ret
== MAP_FAILED
)
813 perror ("allocate_stack failed");
822 free_stack (SCM
*stack
, size_t size
)
824 size
*= sizeof (SCM
);
827 munmap (stack
, size
);
834 expand_stack (SCM
*old_stack
, size_t old_size
, size_t new_size
)
835 #define FUNC_NAME "expand_stack"
837 #if defined MREMAP_MAYMOVE
840 if (new_size
>= ((size_t) -1) / sizeof (SCM
))
843 old_size
*= sizeof (SCM
);
844 new_size
*= sizeof (SCM
);
846 new_stack
= mremap (old_stack
, old_size
, new_size
, MREMAP_MAYMOVE
);
847 if (new_stack
== MAP_FAILED
)
850 return (SCM
*) new_stack
;
854 new_stack
= allocate_stack (new_size
);
858 memcpy (new_stack
, old_stack
, old_size
* sizeof (SCM
));
859 free_stack (old_stack
, old_size
);
866 static struct scm_vm
*
868 #define FUNC_NAME "make_vm"
873 vp
= scm_gc_malloc (sizeof (struct scm_vm
), "vm");
875 vp
->stack_size
= page_size
/ sizeof (SCM
);
876 vp
->stack_base
= allocate_stack (vp
->stack_size
);
878 /* As in expand_stack, we don't have any way to throw an exception
879 if we can't allocate one measely page -- there's no stack to
880 handle it. For now, abort. */
882 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
;
883 vp
->overflow_handler_stack
= SCM_EOL
;
885 vp
->sp
= vp
->stack_base
- 1;
887 vp
->engine
= vm_default_engine
;
889 for (i
= 0; i
< SCM_VM_NUM_HOOKS
; i
++)
890 vp
->hooks
[i
] = SCM_BOOL_F
;
897 return_unused_stack_to_os (struct scm_vm
*vp
)
900 scm_t_uintptr start
= (scm_t_uintptr
) (vp
->sp
+ 1);
901 scm_t_uintptr end
= (scm_t_uintptr
) vp
->stack_limit
;
902 /* The second condition is needed to protect against wrap-around. */
903 if (vp
->sp_max_since_gc
< vp
->stack_limit
&& vp
->sp
< vp
->sp_max_since_gc
)
904 end
= (scm_t_uintptr
) (vp
->sp_max_since_gc
+ 1);
906 start
= ((start
- 1U) | (page_size
- 1U)) + 1U; /* round up */
907 end
= ((end
- 1U) | (page_size
- 1U)) + 1U; /* round up */
909 /* Return these pages to the OS. The next time they are paged in,
910 they will be zeroed. */
916 ret
= madvise ((void *) start
, end
- start
, MADV_DONTNEED
);
917 while (ret
&& errno
== -EAGAIN
);
920 perror ("madvise failed");
923 vp
->sp_max_since_gc
= vp
->sp
;
927 #define DEAD_SLOT_MAP_CACHE_SIZE 32U
928 struct dead_slot_map_cache_entry
931 const scm_t_uint8
*map
;
934 struct dead_slot_map_cache
936 struct dead_slot_map_cache_entry entries
[DEAD_SLOT_MAP_CACHE_SIZE
];
939 static const scm_t_uint8
*
940 find_dead_slot_map (scm_t_uint32
*ip
, struct dead_slot_map_cache
*cache
)
942 /* The lower two bits should be zero. FIXME: Use a better hash
943 function; we don't expose scm_raw_hashq currently. */
944 size_t slot
= (((scm_t_uintptr
) ip
) >> 2) % DEAD_SLOT_MAP_CACHE_SIZE
;
945 const scm_t_uint8
*map
;
947 if (cache
->entries
[slot
].ip
== ip
)
948 map
= cache
->entries
[slot
].map
;
951 map
= scm_find_dead_slot_map_unlocked (ip
);
952 cache
->entries
[slot
].ip
= ip
;
953 cache
->entries
[slot
].map
= map
;
959 /* Mark the VM stack region between its base and its current top. */
961 scm_i_vm_mark_stack (struct scm_vm
*vp
, struct GC_ms_entry
*mark_stack_ptr
,
962 struct GC_ms_entry
*mark_stack_limit
)
965 /* The first frame will be marked conservatively (without a dead
966 slot map). This is because GC can happen at any point within the
967 hottest activation, due to multiple threads or per-instruction
968 hooks, and providing dead slot maps for all points in a program
969 would take a prohibitive amount of space. */
970 const scm_t_uint8
*dead_slots
= NULL
;
971 scm_t_uintptr upper
= (scm_t_uintptr
) GC_greatest_plausible_heap_addr
;
972 scm_t_uintptr lower
= (scm_t_uintptr
) GC_least_plausible_heap_addr
;
973 struct dead_slot_map_cache cache
;
975 memset (&cache
, 0, sizeof (cache
));
977 for (fp
= vp
->fp
, sp
= vp
->sp
; fp
; fp
= SCM_FRAME_DYNAMIC_LINK (fp
))
979 for (; sp
>= &SCM_FRAME_LOCAL (fp
, 0); sp
--)
983 && SCM_UNPACK (elt
) >= lower
&& SCM_UNPACK (elt
) <= upper
)
987 size_t slot
= sp
- &SCM_FRAME_LOCAL (fp
, 0);
988 if (dead_slots
[slot
/ 8U] & (1U << (slot
% 8U)))
990 /* This value may become dead as a result of GC,
991 so we can't just leave it on the stack. */
997 mark_stack_ptr
= GC_mark_and_push ((void *) elt
,
1003 sp
= SCM_FRAME_PREVIOUS_SP (fp
);
1004 /* Inner frames may have a dead slots map for precise marking.
1005 Note that there may be other reasons to not have a dead slots
1006 map, e.g. if all of the frame's slots below the callee frame
1008 dead_slots
= find_dead_slot_map (SCM_FRAME_RETURN_ADDRESS (fp
), &cache
);
1011 return_unused_stack_to_os (vp
);
1013 return mark_stack_ptr
;
1016 /* Free the VM stack, as this thread is exiting. */
1018 scm_i_vm_free_stack (struct scm_vm
*vp
)
1020 free_stack (vp
->stack_base
, vp
->stack_size
);
1021 vp
->stack_base
= vp
->stack_limit
= NULL
;
1025 struct vm_expand_stack_data
1033 vm_expand_stack_inner (void *data_ptr
)
1035 struct vm_expand_stack_data
*data
= data_ptr
;
1037 struct scm_vm
*vp
= data
->vp
;
1038 SCM
*old_stack
, *new_stack
;
1040 scm_t_ptrdiff reloc
;
1042 new_size
= vp
->stack_size
;
1043 while (new_size
< data
->stack_size
)
1045 old_stack
= vp
->stack_base
;
1047 new_stack
= expand_stack (vp
->stack_base
, vp
->stack_size
, new_size
);
1051 vp
->stack_base
= new_stack
;
1052 vp
->stack_size
= new_size
;
1053 vp
->stack_limit
= vp
->stack_base
+ new_size
;
1054 reloc
= vp
->stack_base
- old_stack
;
1061 data
->new_sp
+= reloc
;
1065 SCM
*next_fp
= SCM_FRAME_DYNAMIC_LINK (fp
);
1069 SCM_FRAME_SET_DYNAMIC_LINK (fp
, next_fp
);
1078 static scm_t_ptrdiff
1079 current_overflow_size (struct scm_vm
*vp
)
1081 if (scm_is_pair (vp
->overflow_handler_stack
))
1082 return scm_to_ptrdiff_t (scm_caar (vp
->overflow_handler_stack
));
1087 should_handle_stack_overflow (struct scm_vm
*vp
, scm_t_ptrdiff stack_size
)
1089 scm_t_ptrdiff overflow_size
= current_overflow_size (vp
);
1090 return overflow_size
>= 0 && stack_size
>= overflow_size
;
1094 reset_stack_limit (struct scm_vm
*vp
)
1096 if (should_handle_stack_overflow (vp
, vp
->stack_size
))
1097 vp
->stack_limit
= vp
->stack_base
+ current_overflow_size (vp
);
1099 vp
->stack_limit
= vp
->stack_base
+ vp
->stack_size
;
1102 struct overflow_handler_data
1105 SCM overflow_handler_stack
;
1109 wind_overflow_handler (void *ptr
)
1111 struct overflow_handler_data
*data
= ptr
;
1113 data
->vp
->overflow_handler_stack
= data
->overflow_handler_stack
;
1115 reset_stack_limit (data
->vp
);
1119 unwind_overflow_handler (void *ptr
)
1121 struct overflow_handler_data
*data
= ptr
;
1123 data
->vp
->overflow_handler_stack
= scm_cdr (data
->overflow_handler_stack
);
1125 reset_stack_limit (data
->vp
);
1129 vm_expand_stack (struct scm_vm
*vp
, SCM
*new_sp
)
1131 scm_t_ptrdiff stack_size
= new_sp
+ 1 - vp
->stack_base
;
1133 if (stack_size
> vp
->stack_size
)
1135 struct vm_expand_stack_data data
;
1138 data
.stack_size
= stack_size
;
1139 data
.new_sp
= new_sp
;
1141 if (!GC_call_with_alloc_lock (vm_expand_stack_inner
, &data
))
1142 /* Throw an unwind-only exception. */
1143 scm_report_stack_overflow ();
1145 new_sp
= data
.new_sp
;
1148 vp
->sp_max_since_gc
= vp
->sp
= new_sp
;
1150 if (should_handle_stack_overflow (vp
, stack_size
))
1152 SCM more_stack
, new_limit
;
1154 struct overflow_handler_data data
;
1156 data
.overflow_handler_stack
= vp
->overflow_handler_stack
;
1158 scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE
);
1160 scm_dynwind_rewind_handler (unwind_overflow_handler
, &data
,
1161 SCM_F_WIND_EXPLICITLY
);
1162 scm_dynwind_unwind_handler (wind_overflow_handler
, &data
,
1163 SCM_F_WIND_EXPLICITLY
);
1165 /* Call the overflow handler. */
1166 more_stack
= scm_call_0 (scm_cdar (data
.overflow_handler_stack
));
1168 /* If the overflow handler returns, its return value should be an
1169 integral number of words from the outer stack limit to transfer
1170 to the inner limit. */
1171 if (scm_to_ptrdiff_t (more_stack
) <= 0)
1172 scm_out_of_range (NULL
, more_stack
);
1173 new_limit
= scm_sum (scm_caar (data
.overflow_handler_stack
), more_stack
);
1174 if (scm_is_pair (scm_cdr (data
.overflow_handler_stack
)))
1175 new_limit
= scm_min (new_limit
,
1176 scm_caadr (data
.overflow_handler_stack
));
1178 /* Ensure the new limit is in range. */
1179 scm_to_ptrdiff_t (new_limit
);
1181 /* Increase the limit that we will restore. */
1182 scm_set_car_x (scm_car (data
.overflow_handler_stack
), new_limit
);
1187 return vm_expand_stack (vp
, new_sp
);
1191 static struct scm_vm
*
1192 thread_vm (scm_i_thread
*t
)
1194 if (SCM_UNLIKELY (!t
->vp
))
1203 return thread_vm (SCM_I_CURRENT_THREAD
);
1207 scm_call_n (SCM proc
, SCM
*argv
, size_t nargs
)
1209 scm_i_thread
*thread
;
1212 ptrdiff_t base_frame_size
;
1213 /* Cached variables. */
1214 scm_i_jmp_buf registers
; /* used for prompts */
1217 thread
= SCM_I_CURRENT_THREAD
;
1218 vp
= thread_vm (thread
);
1222 /* Check that we have enough space: 3 words for the boot continuation,
1223 and 3 + nargs for the procedure application. */
1224 base_frame_size
= 3 + 3 + nargs
;
1225 vm_push_sp (vp
, vp
->sp
+ base_frame_size
);
1226 base
= vp
->sp
+ 1 - base_frame_size
;
1228 /* Since it's possible to receive the arguments on the stack itself,
1229 shuffle up the arguments first. */
1230 for (i
= nargs
; i
> 0; i
--)
1231 base
[6 + i
- 1] = argv
[i
- 1];
1233 /* Push the boot continuation, which calls PROC and returns its
1235 base
[0] = SCM_PACK (vp
->fp
); /* dynamic link */
1236 base
[1] = SCM_PACK (vp
->ip
); /* ra */
1237 base
[2] = vm_boot_continuation
;
1239 vp
->ip
= (scm_t_uint32
*) vm_boot_continuation_code
;
1241 /* The pending call to PROC. */
1242 base
[3] = SCM_PACK (vp
->fp
); /* dynamic link */
1243 base
[4] = SCM_PACK (vp
->ip
); /* ra */
1248 int resume
= SCM_I_SETJMP (registers
);
1250 if (SCM_UNLIKELY (resume
))
1252 scm_gc_after_nonlocal_exit ();
1253 /* Non-local return. */
1254 vm_dispatch_abort_hook (vp
);
1257 return vm_engines
[vp
->engine
](thread
, vp
, ®isters
, resume
);
1261 /* Scheme interface */
1263 #define VM_DEFINE_HOOK(n) \
1265 struct scm_vm *vp; \
1266 vp = scm_the_vm (); \
1267 if (scm_is_false (vp->hooks[n])) \
1268 vp->hooks[n] = scm_make_hook (SCM_I_MAKINUM (1)); \
1269 return vp->hooks[n]; \
1272 SCM_DEFINE (scm_vm_apply_hook
, "vm-apply-hook", 0, 0, 0,
1275 #define FUNC_NAME s_scm_vm_apply_hook
1277 VM_DEFINE_HOOK (SCM_VM_APPLY_HOOK
);
1281 SCM_DEFINE (scm_vm_push_continuation_hook
, "vm-push-continuation-hook", 0, 0, 0,
1284 #define FUNC_NAME s_scm_vm_push_continuation_hook
1286 VM_DEFINE_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK
);
1290 SCM_DEFINE (scm_vm_pop_continuation_hook
, "vm-pop-continuation-hook", 0, 0, 0,
1293 #define FUNC_NAME s_scm_vm_pop_continuation_hook
1295 VM_DEFINE_HOOK (SCM_VM_POP_CONTINUATION_HOOK
);
1299 SCM_DEFINE (scm_vm_next_hook
, "vm-next-hook", 0, 0, 0,
1302 #define FUNC_NAME s_scm_vm_next_hook
1304 VM_DEFINE_HOOK (SCM_VM_NEXT_HOOK
);
1308 SCM_DEFINE (scm_vm_abort_continuation_hook
, "vm-abort-continuation-hook", 0, 0, 0,
1311 #define FUNC_NAME s_scm_vm_abort_continuation_hook
1313 VM_DEFINE_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK
);
1317 SCM_DEFINE (scm_vm_trace_level
, "vm-trace-level", 0, 0, 0,
1320 #define FUNC_NAME s_scm_vm_trace_level
1322 return scm_from_int (scm_the_vm ()->trace_level
);
1326 SCM_DEFINE (scm_set_vm_trace_level_x
, "set-vm-trace-level!", 1, 0, 0,
1329 #define FUNC_NAME s_scm_set_vm_trace_level_x
1331 scm_the_vm ()->trace_level
= scm_to_int (level
);
1332 return SCM_UNSPECIFIED
;
1342 symbol_to_vm_engine (SCM engine
, const char *FUNC_NAME
)
1344 if (scm_is_eq (engine
, sym_regular
))
1345 return SCM_VM_REGULAR_ENGINE
;
1346 else if (scm_is_eq (engine
, sym_debug
))
1347 return SCM_VM_DEBUG_ENGINE
;
1349 SCM_MISC_ERROR ("Unknown VM engine: ~a", scm_list_1 (engine
));
1353 vm_engine_to_symbol (int engine
, const char *FUNC_NAME
)
1357 case SCM_VM_REGULAR_ENGINE
:
1359 case SCM_VM_DEBUG_ENGINE
:
1363 SCM_MISC_ERROR ("Unknown VM engine: ~a",
1364 scm_list_1 (scm_from_int (engine
)));
1368 SCM_DEFINE (scm_vm_engine
, "vm-engine", 0, 0, 0,
1371 #define FUNC_NAME s_scm_vm_engine
1373 return vm_engine_to_symbol (scm_the_vm ()->engine
, FUNC_NAME
);
1378 scm_c_set_vm_engine_x (int engine
)
1379 #define FUNC_NAME "set-vm-engine!"
1381 if (engine
< 0 || engine
>= SCM_VM_NUM_ENGINES
)
1382 SCM_MISC_ERROR ("Unknown VM engine: ~a",
1383 scm_list_1 (scm_from_int (engine
)));
1385 scm_the_vm ()->engine
= engine
;
1389 SCM_DEFINE (scm_set_vm_engine_x
, "set-vm-engine!", 1, 0, 0,
1392 #define FUNC_NAME s_scm_set_vm_engine_x
1394 scm_c_set_vm_engine_x (symbol_to_vm_engine (engine
, FUNC_NAME
));
1395 return SCM_UNSPECIFIED
;
1400 scm_c_set_default_vm_engine_x (int engine
)
1401 #define FUNC_NAME "set-default-vm-engine!"
1403 if (engine
< 0 || engine
>= SCM_VM_NUM_ENGINES
)
1404 SCM_MISC_ERROR ("Unknown VM engine: ~a",
1405 scm_list_1 (scm_from_int (engine
)));
1407 vm_default_engine
= engine
;
1411 SCM_DEFINE (scm_set_default_vm_engine_x
, "set-default-vm-engine!", 1, 0, 0,
1414 #define FUNC_NAME s_scm_set_default_vm_engine_x
1416 scm_c_set_default_vm_engine_x (symbol_to_vm_engine (engine
, FUNC_NAME
));
1417 return SCM_UNSPECIFIED
;
1421 /* FIXME: This function makes no sense, but we keep it to make sure we
1422 have a way of switching to the debug or regular VM. */
1423 SCM_DEFINE (scm_call_with_vm
, "call-with-vm", 1, 0, 1,
1424 (SCM proc
, SCM args
),
1425 "Apply @var{proc} to @var{args} in a dynamic extent in which\n"
1426 "@var{vm} is the current VM.")
1427 #define FUNC_NAME s_scm_call_with_vm
1429 return scm_apply_0 (proc
, args
);
1433 SCM_DEFINE (scm_call_with_stack_overflow_handler
,
1434 "call-with-stack-overflow-handler", 3, 0, 0,
1435 (SCM limit
, SCM thunk
, SCM handler
),
1436 "Call @var{thunk} in an environment in which the stack limit has\n"
1437 "been reduced to @var{limit} additional words. If the limit is\n"
1438 "reached, @var{handler} (a thunk) will be invoked in the dynamic\n"
1439 "environment of the error. For the extent of the call to\n"
1440 "@var{handler}, the stack limit and handler are restored to the\n"
1441 "values that were in place when\n"
1442 "@code{call-with-stack-overflow-handler} was called.")
1443 #define FUNC_NAME s_scm_call_with_stack_overflow_handler
1446 scm_t_ptrdiff c_limit
, stack_size
;
1447 struct overflow_handler_data data
;
1451 stack_size
= vp
->sp
- vp
->stack_base
;
1453 c_limit
= scm_to_ptrdiff_t (limit
);
1455 scm_out_of_range (FUNC_NAME
, limit
);
1457 new_limit
= scm_sum (scm_from_ptrdiff_t (stack_size
), limit
);
1458 if (scm_is_pair (vp
->overflow_handler_stack
))
1459 new_limit
= scm_min (new_limit
, scm_caar (vp
->overflow_handler_stack
));
1461 /* Hacky check that the current stack depth plus the limit is within
1462 the range of a ptrdiff_t. */
1463 scm_to_ptrdiff_t (new_limit
);
1466 data
.overflow_handler_stack
=
1467 scm_acons (limit
, handler
, vp
->overflow_handler_stack
);
1469 scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE
);
1471 scm_dynwind_rewind_handler (wind_overflow_handler
, &data
,
1472 SCM_F_WIND_EXPLICITLY
);
1473 scm_dynwind_unwind_handler (unwind_overflow_handler
, &data
,
1474 SCM_F_WIND_EXPLICITLY
);
1476 /* Reset vp->sp_max_since_gc so that the VM checks actually
1478 return_unused_stack_to_os (vp
);
1480 ret
= scm_call_0 (thunk
);
1494 scm_load_compiled_with_vm (SCM file
)
1496 return scm_call_0 (scm_load_thunk_from_file (file
));
1501 scm_init_vm_builtin_properties (void)
1503 /* FIXME: Seems hacky to do this here, but oh well :/ */
1504 scm_sym_apply
= scm_from_utf8_symbol ("apply");
1505 scm_sym_values
= scm_from_utf8_symbol ("values");
1506 scm_sym_abort_to_prompt
= scm_from_utf8_symbol ("abort-to-prompt");
1507 scm_sym_call_with_values
= scm_from_utf8_symbol ("call-with-values");
1508 scm_sym_call_with_current_continuation
=
1509 scm_from_utf8_symbol ("call-with-current-continuation");
1511 #define INIT_BUILTIN(builtin, BUILTIN, req, opt, rest) \
1512 scm_set_procedure_property_x (vm_builtin_##builtin, scm_sym_name, \
1513 scm_sym_##builtin); \
1514 scm_set_procedure_minimum_arity_x (vm_builtin_##builtin, \
1515 SCM_I_MAKINUM (req), \
1516 SCM_I_MAKINUM (opt), \
1517 scm_from_bool (rest));
1518 FOR_EACH_VM_BUILTIN (INIT_BUILTIN
);
1523 scm_bootstrap_vm (void)
1525 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1527 (scm_t_extension_init_func
)scm_init_vm
, NULL
);
1528 scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION
,
1529 "scm_init_vm_builtins",
1530 (scm_t_extension_init_func
)scm_init_vm_builtins
,
1533 page_size
= getpagesize ();
1534 /* page_size should be a power of two. */
1535 if (page_size
& (page_size
- 1))
1538 sym_vm_run
= scm_from_latin1_symbol ("vm-run");
1539 sym_vm_error
= scm_from_latin1_symbol ("vm-error");
1540 sym_keyword_argument_error
= scm_from_latin1_symbol ("keyword-argument-error");
1541 sym_regular
= scm_from_latin1_symbol ("regular");
1542 sym_debug
= scm_from_latin1_symbol ("debug");
1544 vm_boot_continuation
= scm_i_make_program (vm_boot_continuation_code
);
1545 SCM_SET_CELL_WORD_0 (vm_boot_continuation
,
1546 (SCM_CELL_WORD_0 (vm_boot_continuation
)
1547 | SCM_F_PROGRAM_IS_BOOT
));
1549 #define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest) \
1550 vm_builtin_##builtin = scm_i_make_program (vm_builtin_##builtin##_code);
1551 FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN
);
1552 #undef DEFINE_BUILTIN
1558 #ifndef SCM_MAGIC_SNARFER
1559 #include "libguile/vm.x"