Commit | Line | Data |
---|---|---|
1cc0b6ad | 1 | /* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. |
a98cef7e | 2 | * |
560b9c25 | 3 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
a98cef7e | 7 | * |
53befeb7 NJ |
8 | * This library is distributed in the hope that it will be useful, but |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
560b9c25 AW |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
a98cef7e | 12 | * |
560b9c25 AW |
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 | |
53befeb7 NJ |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
16 | * 02110-1301 USA | |
560b9c25 | 17 | */ |
a98cef7e | 18 | |
6d14383e AW |
19 | /* This file is included in vm.c multiple times */ |
20 | ||
21 | #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE) | |
22 | #define VM_USE_HOOKS 0 /* Various hooks */ | |
eae2438d AW |
23 | #define VM_CHECK_OBJECT 0 /* Check object table */ |
24 | #define VM_CHECK_FREE_VARIABLES 0 /* Check free variable access */ | |
25 | #define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */ | |
6d14383e AW |
26 | #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) |
27 | #define VM_USE_HOOKS 1 | |
eae2438d AW |
28 | #define VM_CHECK_OBJECT 0 |
29 | #define VM_CHECK_FREE_VARIABLES 0 | |
30 | #define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */ | |
6d14383e AW |
31 | #else |
32 | #error unknown debug engine VM_ENGINE | |
33 | #endif | |
a98cef7e | 34 | |
83495480 | 35 | #include "vm-engine.h" |
a98cef7e | 36 | |
238e7a11 | 37 | |
a98cef7e | 38 | static SCM |
7656f194 | 39 | VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) |
a98cef7e | 40 | { |
17e90c5e | 41 | /* VM registers */ |
2fb924f6 | 42 | register scm_t_uint8 *ip IP_REG; /* instruction pointer */ |
17e90c5e KN |
43 | register SCM *sp SP_REG; /* stack pointer */ |
44 | register SCM *fp FP_REG; /* frame pointer */ | |
7656f194 | 45 | struct scm_vm *vp = SCM_VM_DATA (vm); |
a98cef7e | 46 | |
d608d68d | 47 | /* Cache variables */ |
53e28ed9 | 48 | struct scm_objcode *bp = NULL; /* program base pointer */ |
17e90c5e | 49 | SCM *objects = NULL; /* constant objects */ |
eae2438d | 50 | #if VM_CHECK_OBJECT |
2fda0242 | 51 | size_t object_count = 0; /* length of OBJECTS */ |
eae2438d | 52 | #endif |
3d5ee0cd | 53 | SCM *stack_limit = vp->stack_limit; /* stack limit address */ |
2d026f04 | 54 | |
a2a6c0e3 | 55 | scm_i_thread *current_thread = SCM_I_CURRENT_THREAD; |
2d026f04 | 56 | scm_t_int64 vm_cookie = vp->cookie++; |
a98cef7e | 57 | |
d608d68d | 58 | /* Internal variables */ |
ef24c01b | 59 | int nvalues = 0; |
41e49280 | 60 | const char *func_name = NULL; /* used for error reporting */ |
e06e857c AW |
61 | SCM finish_args; /* used both for returns: both in error |
62 | and normal situations */ | |
53e28ed9 | 63 | #ifdef HAVE_LABELS_AS_VALUES |
37a5970c | 64 | static const void **jump_table_pointer = NULL; |
e06e857c | 65 | #endif |
37a5970c | 66 | |
e06e857c | 67 | #ifdef HAVE_LABELS_AS_VALUES |
37a5970c LC |
68 | register const void **jump_table JT_REG; |
69 | ||
70 | if (SCM_UNLIKELY (!jump_table_pointer)) | |
53e28ed9 AW |
71 | { |
72 | int i; | |
37a5970c | 73 | jump_table_pointer = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof (void*)); |
53e28ed9 | 74 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) |
37a5970c | 75 | jump_table_pointer[i] = &&vm_error_bad_instruction; |
53e28ed9 | 76 | #define VM_INSTRUCTION_TO_LABEL 1 |
37a5970c | 77 | #define jump_table jump_table_pointer |
aeeff258 AW |
78 | #include <libguile/vm-expand.h> |
79 | #include <libguile/vm-i-system.i> | |
80 | #include <libguile/vm-i-scheme.i> | |
81 | #include <libguile/vm-i-loader.i> | |
37a5970c | 82 | #undef jump_table |
53e28ed9 AW |
83 | #undef VM_INSTRUCTION_TO_LABEL |
84 | } | |
37a5970c LC |
85 | |
86 | /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one | |
87 | load instruction at each instruction dispatch. */ | |
88 | jump_table = jump_table_pointer; | |
53e28ed9 AW |
89 | #endif |
90 | ||
3d5ee0cd KN |
91 | /* Initialization */ |
92 | { | |
499a4c07 KN |
93 | SCM prog = program; |
94 | ||
95 | /* Boot program */ | |
6d14383e | 96 | program = vm_make_boot_program (nargs); |
a98cef7e | 97 | |
3d5ee0cd KN |
98 | /* Initial frame */ |
99 | CACHE_REGISTER (); | |
b2b33168 AW |
100 | PUSH (SCM_PACK (fp)); /* dynamic link */ |
101 | PUSH (SCM_PACK (0)); /* mvra */ | |
102 | PUSH (SCM_PACK (ip)); /* ra */ | |
499a4c07 | 103 | CACHE_PROGRAM (); |
3616e9e9 | 104 | PUSH (program); |
03e6c165 | 105 | fp = sp + 1; |
3dbbe28d | 106 | ip = SCM_C_OBJCODE_BASE (bp); |
b7946e9e | 107 | /* MV-call frame, function & arguments */ |
b2b33168 AW |
108 | PUSH (SCM_PACK (0)); /* dynamic link */ |
109 | PUSH (SCM_PACK (0)); /* mvra */ | |
110 | PUSH (SCM_PACK (0)); /* ra */ | |
3616e9e9 | 111 | PUSH (prog); |
6d14383e AW |
112 | if (SCM_UNLIKELY (sp + nargs >= stack_limit)) |
113 | goto vm_error_too_many_args; | |
114 | while (nargs--) | |
115 | PUSH (*argv++); | |
3d5ee0cd | 116 | } |
a98cef7e KN |
117 | |
118 | /* Let's go! */ | |
53e28ed9 | 119 | NEXT; |
a98cef7e KN |
120 | |
121 | #ifndef HAVE_LABELS_AS_VALUES | |
17e90c5e | 122 | vm_start: |
53e28ed9 | 123 | switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) { |
a98cef7e KN |
124 | #endif |
125 | ||
83495480 AW |
126 | #include "vm-expand.h" |
127 | #include "vm-i-system.c" | |
128 | #include "vm-i-scheme.c" | |
129 | #include "vm-i-loader.c" | |
a98cef7e KN |
130 | |
131 | #ifndef HAVE_LABELS_AS_VALUES | |
53e28ed9 AW |
132 | default: |
133 | goto vm_error_bad_instruction; | |
a98cef7e KN |
134 | } |
135 | #endif | |
136 | ||
e06e857c AW |
137 | |
138 | vm_done: | |
139 | SYNC_ALL (); | |
e06e857c AW |
140 | return finish_args; |
141 | ||
17e90c5e KN |
142 | /* Errors */ |
143 | { | |
e06e857c AW |
144 | SCM err_msg; |
145 | ||
f6a8e791 AW |
146 | /* FIXME: need to sync regs before allocating anything, in each case. */ |
147 | ||
53e28ed9 | 148 | vm_error_bad_instruction: |
501cf7d6 | 149 | err_msg = scm_from_latin1_string ("VM: Bad instruction: ~s"); |
da8b4747 | 150 | finish_args = scm_list_1 (scm_from_uchar (ip[-1])); |
53e28ed9 AW |
151 | goto vm_error; |
152 | ||
17e90c5e | 153 | vm_error_unbound: |
d1079217 AW |
154 | /* FINISH_ARGS should be the name of the unbound variable. */ |
155 | SYNC_ALL (); | |
501cf7d6 | 156 | err_msg = scm_from_latin1_string ("Unbound variable: ~s"); |
d1079217 AW |
157 | scm_error_scm (scm_misc_error_key, program, err_msg, |
158 | scm_list_1 (finish_args), SCM_BOOL_F); | |
17e90c5e KN |
159 | goto vm_error; |
160 | ||
ef94624e BT |
161 | vm_error_unbound_fluid: |
162 | SYNC_ALL (); | |
501cf7d6 | 163 | err_msg = scm_from_latin1_string ("Unbound fluid: ~s"); |
ef94624e BT |
164 | scm_error_scm (scm_misc_error_key, program, err_msg, |
165 | scm_list_1 (finish_args), SCM_BOOL_F); | |
166 | goto vm_error; | |
167 | ||
dce0252b AW |
168 | vm_error_not_a_variable: |
169 | SYNC_ALL (); | |
170 | scm_error (scm_arg_type_key, func_name, "Not a variable: ~S", | |
171 | scm_list_1 (finish_args), scm_list_1 (finish_args)); | |
172 | goto vm_error; | |
173 | ||
41e49280 | 174 | vm_error_apply_to_non_list: |
1cc0b6ad | 175 | SYNC_ALL (); |
41e49280 | 176 | scm_error (scm_arg_type_key, "apply", "Apply to non-list: ~S", |
1cc0b6ad | 177 | scm_list_1 (finish_args), scm_list_1 (finish_args)); |
4c9ad01d KN |
178 | goto vm_error; |
179 | ||
7e01997e | 180 | vm_error_kwargs_length_not_even: |
f6a8e791 | 181 | SYNC_ALL (); |
501cf7d6 | 182 | err_msg = scm_from_latin1_string ("Odd length of keyword argument list"); |
f6a8e791 AW |
183 | scm_error_scm (sym_keyword_argument_error, program, err_msg, |
184 | SCM_EOL, SCM_BOOL_F); | |
7e01997e AW |
185 | |
186 | vm_error_kwargs_invalid_keyword: | |
f6a8e791 AW |
187 | /* FIXME say which one it was */ |
188 | SYNC_ALL (); | |
501cf7d6 | 189 | err_msg = scm_from_latin1_string ("Invalid keyword"); |
f6a8e791 AW |
190 | scm_error_scm (sym_keyword_argument_error, program, err_msg, |
191 | SCM_EOL, SCM_BOOL_F); | |
7e01997e AW |
192 | |
193 | vm_error_kwargs_unrecognized_keyword: | |
f6a8e791 AW |
194 | /* FIXME say which one it was */ |
195 | SYNC_ALL (); | |
501cf7d6 | 196 | err_msg = scm_from_latin1_string ("Unrecognized keyword"); |
f6a8e791 AW |
197 | scm_error_scm (sym_keyword_argument_error, program, err_msg, |
198 | SCM_EOL, SCM_BOOL_F); | |
7e01997e | 199 | |
6d14383e | 200 | vm_error_too_many_args: |
501cf7d6 | 201 | err_msg = scm_from_latin1_string ("VM: Too many arguments"); |
da8b4747 | 202 | finish_args = scm_list_1 (scm_from_int (nargs)); |
6d14383e AW |
203 | goto vm_error; |
204 | ||
17e90c5e | 205 | vm_error_wrong_num_args: |
9a8cc8e7 | 206 | /* nargs and program are valid */ |
0570c3f1 | 207 | SYNC_ALL (); |
9a8cc8e7 AW |
208 | scm_wrong_num_args (program); |
209 | /* shouldn't get here */ | |
17e90c5e KN |
210 | goto vm_error; |
211 | ||
212 | vm_error_wrong_type_apply: | |
7ea9a0a7 | 213 | SYNC_ALL (); |
41e49280 | 214 | scm_error (scm_arg_type_key, NULL, "Wrong type to apply: ~S", |
5f161164 | 215 | scm_list_1 (program), scm_list_1 (program)); |
17e90c5e KN |
216 | goto vm_error; |
217 | ||
ac02b386 | 218 | vm_error_stack_overflow: |
501cf7d6 | 219 | err_msg = scm_from_latin1_string ("VM: Stack overflow"); |
e06e857c | 220 | finish_args = SCM_EOL; |
f1046e6b LC |
221 | if (stack_limit < vp->stack_base + vp->stack_size) |
222 | /* There are VM_STACK_RESERVE_SIZE bytes left. Make them available so | |
223 | that `throw' below can run on this VM. */ | |
224 | vp->stack_limit = vp->stack_base + vp->stack_size; | |
17e90c5e | 225 | goto vm_error; |
17e90c5e | 226 | |
ac02b386 | 227 | vm_error_stack_underflow: |
501cf7d6 | 228 | err_msg = scm_from_latin1_string ("VM: Stack underflow"); |
e06e857c | 229 | finish_args = SCM_EOL; |
17e90c5e KN |
230 | goto vm_error; |
231 | ||
1f40459f | 232 | vm_error_improper_list: |
501cf7d6 | 233 | err_msg = scm_from_latin1_string ("Expected a proper list, but got object with tail ~s"); |
1f40459f AW |
234 | goto vm_error; |
235 | ||
5e390de6 AW |
236 | vm_error_not_a_pair: |
237 | SYNC_ALL (); | |
41e49280 | 238 | scm_wrong_type_arg_msg (func_name, 1, finish_args, "pair"); |
5e390de6 AW |
239 | /* shouldn't get here */ |
240 | goto vm_error; | |
241 | ||
e6eb2467 AW |
242 | vm_error_not_a_bytevector: |
243 | SYNC_ALL (); | |
41e49280 | 244 | scm_wrong_type_arg_msg (func_name, 1, finish_args, "bytevector"); |
e6eb2467 AW |
245 | /* shouldn't get here */ |
246 | goto vm_error; | |
247 | ||
bd91ecce LC |
248 | vm_error_not_a_struct: |
249 | SYNC_ALL (); | |
41e49280 | 250 | scm_wrong_type_arg_msg (func_name, 1, finish_args, "struct"); |
bd91ecce LC |
251 | /* shouldn't get here */ |
252 | goto vm_error; | |
253 | ||
4f66bcde AW |
254 | vm_error_not_a_thunk: |
255 | SYNC_ALL (); | |
41e49280 | 256 | scm_wrong_type_arg_msg ("dynamic-wind", 1, finish_args, "thunk"); |
4f66bcde AW |
257 | /* shouldn't get here */ |
258 | goto vm_error; | |
259 | ||
a222b0fa | 260 | vm_error_no_values: |
501cf7d6 | 261 | err_msg = scm_from_latin1_string ("Zero values returned to single-valued continuation"); |
e06e857c | 262 | finish_args = SCM_EOL; |
a222b0fa AW |
263 | goto vm_error; |
264 | ||
d51406fe | 265 | vm_error_not_enough_values: |
501cf7d6 | 266 | err_msg = scm_from_latin1_string ("Too few values returned to continuation"); |
e06e857c | 267 | finish_args = SCM_EOL; |
d51406fe AW |
268 | goto vm_error; |
269 | ||
b3950ad6 | 270 | vm_error_continuation_not_rewindable: |
501cf7d6 | 271 | err_msg = scm_from_latin1_string ("Unrewindable partial continuation"); |
b3950ad6 AW |
272 | finish_args = scm_cons (finish_args, SCM_EOL); |
273 | goto vm_error; | |
274 | ||
94ff26b9 | 275 | vm_error_bad_wide_string_length: |
501cf7d6 | 276 | err_msg = scm_from_latin1_string ("VM: Bad wide string length: ~S"); |
94ff26b9 AW |
277 | goto vm_error; |
278 | ||
56a3dcd4 | 279 | #ifdef VM_CHECK_IP |
ac02b386 | 280 | vm_error_invalid_address: |
501cf7d6 | 281 | err_msg = scm_from_latin1_string ("VM: Invalid program address"); |
e06e857c | 282 | finish_args = SCM_EOL; |
17e90c5e | 283 | goto vm_error; |
ac02b386 KN |
284 | #endif |
285 | ||
0b5f0e49 LC |
286 | #if VM_CHECK_OBJECT |
287 | vm_error_object: | |
501cf7d6 | 288 | err_msg = scm_from_latin1_string ("VM: Invalid object table access"); |
e06e857c | 289 | finish_args = SCM_EOL; |
0b5f0e49 LC |
290 | goto vm_error; |
291 | #endif | |
292 | ||
57ab0671 AW |
293 | #if VM_CHECK_FREE_VARIABLES |
294 | vm_error_free_variable: | |
501cf7d6 | 295 | err_msg = scm_from_latin1_string ("VM: Invalid free variable access"); |
8d90b356 AW |
296 | finish_args = SCM_EOL; |
297 | goto vm_error; | |
298 | #endif | |
299 | ||
17e90c5e KN |
300 | vm_error: |
301 | SYNC_ALL (); | |
a52b2d3d | 302 | |
da8b4747 LC |
303 | scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args), |
304 | 1); | |
17e90c5e KN |
305 | } |
306 | ||
a98cef7e KN |
307 | abort (); /* never reached */ |
308 | } | |
6d14383e AW |
309 | |
310 | #undef VM_USE_HOOKS | |
6d14383e | 311 | #undef VM_CHECK_OBJECT |
57ab0671 | 312 | #undef VM_CHECK_FREE_VARIABLE |
eae2438d | 313 | #undef VM_CHECK_UNDERFLOW |
17e90c5e KN |
314 | |
315 | /* | |
316 | Local Variables: | |
317 | c-file-style: "gnu" | |
318 | End: | |
319 | */ |