1 /* Copyright (C) 2001, 2009 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 /* This file is included in vm.c multiple times */
21 #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
22 #define VM_USE_HOOKS 0 /* Various hooks */
23 #define VM_USE_CLOCK 0 /* Bogoclock */
24 #define VM_CHECK_OBJECT 1 /* Check object table */
25 #define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
26 #define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
27 #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
28 #define VM_USE_HOOKS 1
29 #define VM_USE_CLOCK 1
30 #define VM_CHECK_OBJECT 1
31 #define VM_CHECK_FREE_VARIABLES 1
32 #define VM_PUSH_DEBUG_FRAMES 1
34 #error unknown debug engine VM_ENGINE
37 #include "vm-engine.h"
41 VM_NAME (struct scm_vm
*vp
, SCM program
, SCM
*argv
, int nargs
)
44 register scm_byte_t
*ip IP_REG
; /* instruction pointer */
45 register SCM
*sp SP_REG
; /* stack pointer */
46 register SCM
*fp FP_REG
; /* frame pointer */
49 struct scm_objcode
*bp
= NULL
; /* program base pointer */
50 SCM
*free_vars
= NULL
; /* free variables */
51 size_t free_vars_count
= 0; /* length of FREE_VARS */
52 SCM
*objects
= NULL
; /* constant objects */
53 size_t object_count
= 0; /* length of OBJECTS */
54 SCM
*stack_base
= vp
->stack_base
; /* stack base address */
55 SCM
*stack_limit
= vp
->stack_limit
; /* stack limit address */
57 /* Internal variables */
59 long start_time
= scm_c_get_internal_run_time ();
60 SCM finish_args
; /* used both for returns: both in error
61 and normal situations */
63 SCM hook_args
= SCM_EOL
;
66 #ifdef HAVE_LABELS_AS_VALUES
67 static void **jump_table
= NULL
;
70 #if VM_PUSH_DEBUG_FRAMES
71 scm_t_debug_frame debug
;
72 scm_t_debug_info debug_vect_body
;
73 debug
.status
= SCM_VOIDFRAME
;
76 #ifdef HAVE_LABELS_AS_VALUES
77 if (SCM_UNLIKELY (!jump_table
))
80 jump_table
= malloc (SCM_VM_NUM_INSTRUCTIONS
* sizeof(void*));
81 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
82 jump_table
[i
] = &&vm_error_bad_instruction
;
83 #define VM_INSTRUCTION_TO_LABEL 1
84 #include <libguile/vm-expand.h>
85 #include <libguile/vm-i-system.i>
86 #include <libguile/vm-i-scheme.i>
87 #include <libguile/vm-i-loader.i>
88 #undef VM_INSTRUCTION_TO_LABEL
97 program
= vm_make_boot_program (nargs
);
99 #if VM_PUSH_DEBUG_FRAMES
100 debug
.prev
= scm_i_last_debug_frame ();
101 debug
.status
= SCM_APPLYFRAME
;
102 debug
.vect
= &debug_vect_body
;
103 debug
.vect
[0].a
.proc
= program
; /* the boot program */
104 debug
.vect
[0].a
.args
= SCM_EOL
;
105 scm_i_set_last_debug_frame (&debug
);
110 PUSH ((SCM
)fp
); /* dynamic link */
117 /* MV-call frame, function & arguments */
118 PUSH ((SCM
)fp
); /* dynamic link */
122 if (SCM_UNLIKELY (sp
+ nargs
>= stack_limit
))
123 goto vm_error_too_many_args
;
132 #ifndef HAVE_LABELS_AS_VALUES
134 switch ((*ip
++) & SCM_VM_INSTRUCTION_MASK
) {
137 #include "vm-expand.h"
138 #include "vm-i-system.c"
139 #include "vm-i-scheme.c"
140 #include "vm-i-loader.c"
142 #ifndef HAVE_LABELS_AS_VALUES
144 goto vm_error_bad_instruction
;
151 #if VM_PUSH_DEBUG_FRAMES
152 scm_i_set_last_debug_frame (debug
.prev
);
160 vm_error_bad_instruction
:
161 err_msg
= scm_from_locale_string ("VM: Bad instruction: ~s");
162 finish_args
= scm_list_1 (scm_from_uchar (ip
[-1]));
166 err_msg
= scm_from_locale_string ("VM: Unbound variable: ~s");
169 vm_error_wrong_type_arg
:
170 err_msg
= scm_from_locale_string ("VM: Wrong type argument");
171 finish_args
= SCM_EOL
;
174 vm_error_too_many_args
:
175 err_msg
= scm_from_locale_string ("VM: Too many arguments");
176 finish_args
= scm_list_1 (scm_from_int (nargs
));
179 vm_error_wrong_num_args
:
180 /* nargs and program are valid */
182 scm_wrong_num_args (program
);
183 /* shouldn't get here */
186 vm_error_wrong_type_apply
:
188 scm_error (scm_misc_error_key
, FUNC_NAME
, "Wrong type to apply: ~S",
189 scm_list_1 (program
), SCM_BOOL_F
);
192 vm_error_stack_overflow
:
193 err_msg
= scm_from_locale_string ("VM: Stack overflow");
194 finish_args
= SCM_EOL
;
197 vm_error_stack_underflow
:
198 err_msg
= scm_from_locale_string ("VM: Stack underflow");
199 finish_args
= SCM_EOL
;
202 vm_error_improper_list
:
203 err_msg
= scm_from_locale_string ("Expected a proper list, but got object with tail ~s");
208 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "pair");
209 /* shouldn't get here */
212 vm_error_not_a_bytevector
:
214 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "bytevector");
215 /* shouldn't get here */
219 err_msg
= scm_from_locale_string ("Zero values returned to single-valued continuation");
220 finish_args
= SCM_EOL
;
223 vm_error_not_enough_values
:
224 err_msg
= scm_from_locale_string ("Too few values returned to continuation");
225 finish_args
= SCM_EOL
;
228 vm_error_bad_wide_string_length
:
229 err_msg
= scm_from_locale_string ("VM: Bad wide string length: ~S");
233 vm_error_invalid_address
:
234 err_msg
= scm_from_locale_string ("VM: Invalid program address");
235 finish_args
= SCM_EOL
;
241 err_msg
= scm_from_locale_string ("VM: Invalid object table access");
242 finish_args
= SCM_EOL
;
246 #if VM_CHECK_FREE_VARIABLES
247 vm_error_free_variable
:
248 err_msg
= scm_from_locale_string ("VM: Invalid free variable access");
249 finish_args
= SCM_EOL
;
256 scm_ithrow (sym_vm_error
, scm_list_3 (sym_vm_run
, err_msg
, finish_args
),
260 abort (); /* never reached */
265 #undef VM_CHECK_OBJECT
266 #undef VM_CHECK_FREE_VARIABLE
267 #undef VM_PUSH_DEBUG_FRAMES