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
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_CHECK_OBJECT 1 /* Check object table */
24 #define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
25 #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
26 #define VM_USE_HOOKS 1
27 #define VM_CHECK_OBJECT 1
28 #define VM_CHECK_FREE_VARIABLES 1
30 #error unknown debug engine VM_ENGINE
33 #include "vm-engine.h"
37 VM_NAME (SCM vm
, SCM program
, SCM
*argv
, int nargs
)
40 register scm_t_uint8
*ip IP_REG
; /* instruction pointer */
41 register SCM
*sp SP_REG
; /* stack pointer */
42 register SCM
*fp FP_REG
; /* frame pointer */
43 struct scm_vm
*vp
= SCM_VM_DATA (vm
);
46 struct scm_objcode
*bp
= NULL
; /* program base pointer */
47 SCM
*objects
= NULL
; /* constant objects */
48 size_t object_count
= 0; /* length of OBJECTS */
49 SCM
*stack_limit
= vp
->stack_limit
; /* stack limit address */
51 SCM dynstate
= SCM_I_CURRENT_THREAD
->dynamic_state
;
52 scm_t_int64 vm_cookie
= vp
->cookie
++;
54 /* Internal variables */
56 SCM finish_args
; /* used both for returns: both in error
57 and normal situations */
58 #ifdef HAVE_LABELS_AS_VALUES
59 static void **jump_table
= NULL
;
62 #ifdef HAVE_LABELS_AS_VALUES
63 if (SCM_UNLIKELY (!jump_table
))
66 jump_table
= malloc (SCM_VM_NUM_INSTRUCTIONS
* sizeof(void*));
67 for (i
= 0; i
< SCM_VM_NUM_INSTRUCTIONS
; i
++)
68 jump_table
[i
] = &&vm_error_bad_instruction
;
69 #define VM_INSTRUCTION_TO_LABEL 1
70 #include <libguile/vm-expand.h>
71 #include <libguile/vm-i-system.i>
72 #include <libguile/vm-i-scheme.i>
73 #include <libguile/vm-i-loader.i>
74 #undef VM_INSTRUCTION_TO_LABEL
83 program
= vm_make_boot_program (nargs
);
87 PUSH ((SCM
)fp
); /* dynamic link */
89 PUSH ((SCM
)ip
); /* ra */
93 ip
= SCM_C_OBJCODE_BASE (bp
);
94 /* MV-call frame, function & arguments */
95 PUSH ((SCM
)fp
); /* dynamic link */
99 if (SCM_UNLIKELY (sp
+ nargs
>= stack_limit
))
100 goto vm_error_too_many_args
;
109 #ifndef HAVE_LABELS_AS_VALUES
111 switch ((*ip
++) & SCM_VM_INSTRUCTION_MASK
) {
114 #include "vm-expand.h"
115 #include "vm-i-system.c"
116 #include "vm-i-scheme.c"
117 #include "vm-i-loader.c"
119 #ifndef HAVE_LABELS_AS_VALUES
121 goto vm_error_bad_instruction
;
134 /* FIXME: need to sync regs before allocating anything, in each case. */
136 vm_error_bad_instruction
:
137 err_msg
= scm_from_locale_string ("VM: Bad instruction: ~s");
138 finish_args
= scm_list_1 (scm_from_uchar (ip
[-1]));
142 err_msg
= scm_from_locale_string ("VM: Unbound variable: ~s");
145 vm_error_wrong_type_arg
:
146 err_msg
= scm_from_locale_string ("VM: Wrong type argument");
147 finish_args
= SCM_EOL
;
150 vm_error_kwargs_length_not_even
:
152 err_msg
= scm_from_locale_string ("Odd length of keyword argument list");
153 scm_error_scm (sym_keyword_argument_error
, program
, err_msg
,
154 SCM_EOL
, SCM_BOOL_F
);
156 vm_error_kwargs_invalid_keyword
:
157 /* FIXME say which one it was */
159 err_msg
= scm_from_locale_string ("Invalid keyword");
160 scm_error_scm (sym_keyword_argument_error
, program
, err_msg
,
161 SCM_EOL
, SCM_BOOL_F
);
163 vm_error_kwargs_unrecognized_keyword
:
164 /* FIXME say which one it was */
166 err_msg
= scm_from_locale_string ("Unrecognized keyword");
167 scm_error_scm (sym_keyword_argument_error
, program
, err_msg
,
168 SCM_EOL
, SCM_BOOL_F
);
170 vm_error_too_many_args
:
171 err_msg
= scm_from_locale_string ("VM: Too many arguments");
172 finish_args
= scm_list_1 (scm_from_int (nargs
));
175 vm_error_wrong_num_args
:
176 /* nargs and program are valid */
178 scm_wrong_num_args (program
);
179 /* shouldn't get here */
182 vm_error_wrong_type_apply
:
184 scm_error (scm_arg_type_key
, FUNC_NAME
, "Wrong type to apply: ~S",
185 scm_list_1 (program
), scm_list_1 (program
));
188 vm_error_stack_overflow
:
189 err_msg
= scm_from_locale_string ("VM: Stack overflow");
190 finish_args
= SCM_EOL
;
193 vm_error_stack_underflow
:
194 err_msg
= scm_from_locale_string ("VM: Stack underflow");
195 finish_args
= SCM_EOL
;
198 vm_error_improper_list
:
199 err_msg
= scm_from_locale_string ("Expected a proper list, but got object with tail ~s");
204 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "pair");
205 /* shouldn't get here */
208 vm_error_not_a_bytevector
:
210 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "bytevector");
211 /* shouldn't get here */
214 vm_error_not_a_struct
:
216 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "struct");
217 /* shouldn't get here */
220 vm_error_not_a_thunk
:
222 scm_wrong_type_arg_msg (FUNC_NAME
, 1, finish_args
, "thunk");
223 /* shouldn't get here */
227 err_msg
= scm_from_locale_string ("Zero values returned to single-valued continuation");
228 finish_args
= SCM_EOL
;
231 vm_error_not_enough_values
:
232 err_msg
= scm_from_locale_string ("Too few values returned to continuation");
233 finish_args
= SCM_EOL
;
236 vm_error_bad_wide_string_length
:
237 err_msg
= scm_from_locale_string ("VM: Bad wide string length: ~S");
241 vm_error_invalid_address
:
242 err_msg
= scm_from_locale_string ("VM: Invalid program address");
243 finish_args
= SCM_EOL
;
249 err_msg
= scm_from_locale_string ("VM: Invalid object table access");
250 finish_args
= SCM_EOL
;
254 #if VM_CHECK_FREE_VARIABLES
255 vm_error_free_variable
:
256 err_msg
= scm_from_locale_string ("VM: Invalid free variable access");
257 finish_args
= SCM_EOL
;
264 scm_ithrow (sym_vm_error
, scm_list_3 (sym_vm_run
, err_msg
, finish_args
),
268 abort (); /* never reached */
272 #undef VM_CHECK_OBJECT
273 #undef VM_CHECK_FREE_VARIABLE