Commit | Line | Data |
---|---|---|
6f16379e | 1 | /* Copyright (C) 2001, 2009, 2010 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 */ | |
6d14383e | 23 | #define VM_CHECK_OBJECT 1 /* Check object table */ |
57ab0671 | 24 | #define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */ |
6d14383e AW |
25 | #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) |
26 | #define VM_USE_HOOKS 1 | |
6d14383e | 27 | #define VM_CHECK_OBJECT 1 |
57ab0671 | 28 | #define VM_CHECK_FREE_VARIABLES 1 |
6d14383e AW |
29 | #else |
30 | #error unknown debug engine VM_ENGINE | |
31 | #endif | |
a98cef7e | 32 | |
83495480 | 33 | #include "vm-engine.h" |
a98cef7e | 34 | |
238e7a11 | 35 | |
a98cef7e | 36 | static SCM |
7656f194 | 37 | VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) |
a98cef7e | 38 | { |
17e90c5e | 39 | /* VM registers */ |
2fb924f6 | 40 | register scm_t_uint8 *ip IP_REG; /* instruction pointer */ |
17e90c5e KN |
41 | register SCM *sp SP_REG; /* stack pointer */ |
42 | register SCM *fp FP_REG; /* frame pointer */ | |
7656f194 | 43 | struct scm_vm *vp = SCM_VM_DATA (vm); |
a98cef7e | 44 | |
d608d68d | 45 | /* Cache variables */ |
53e28ed9 | 46 | struct scm_objcode *bp = NULL; /* program base pointer */ |
17e90c5e | 47 | SCM *objects = NULL; /* constant objects */ |
2fda0242 | 48 | size_t object_count = 0; /* length of OBJECTS */ |
3d5ee0cd | 49 | SCM *stack_limit = vp->stack_limit; /* stack limit address */ |
a98cef7e | 50 | |
d608d68d | 51 | /* Internal variables */ |
ef24c01b | 52 | int nvalues = 0; |
e06e857c AW |
53 | SCM finish_args; /* used both for returns: both in error |
54 | and normal situations */ | |
53e28ed9 AW |
55 | #ifdef HAVE_LABELS_AS_VALUES |
56 | static void **jump_table = NULL; | |
e06e857c | 57 | #endif |
53e28ed9 | 58 | |
e06e857c | 59 | #ifdef HAVE_LABELS_AS_VALUES |
53e28ed9 AW |
60 | if (SCM_UNLIKELY (!jump_table)) |
61 | { | |
62 | int i; | |
f775e51b | 63 | jump_table = malloc (SCM_VM_NUM_INSTRUCTIONS * sizeof(void*)); |
53e28ed9 AW |
64 | for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) |
65 | jump_table[i] = &&vm_error_bad_instruction; | |
66 | #define VM_INSTRUCTION_TO_LABEL 1 | |
aeeff258 AW |
67 | #include <libguile/vm-expand.h> |
68 | #include <libguile/vm-i-system.i> | |
69 | #include <libguile/vm-i-scheme.i> | |
70 | #include <libguile/vm-i-loader.i> | |
53e28ed9 AW |
71 | #undef VM_INSTRUCTION_TO_LABEL |
72 | } | |
73 | #endif | |
74 | ||
3d5ee0cd KN |
75 | /* Initialization */ |
76 | { | |
499a4c07 KN |
77 | SCM prog = program; |
78 | ||
79 | /* Boot program */ | |
6d14383e | 80 | program = vm_make_boot_program (nargs); |
a98cef7e | 81 | |
3d5ee0cd KN |
82 | /* Initial frame */ |
83 | CACHE_REGISTER (); | |
03e6c165 | 84 | PUSH ((SCM)fp); /* dynamic link */ |
03e6c165 | 85 | PUSH (0); /* mvra */ |
6c6a4439 | 86 | PUSH ((SCM)ip); /* ra */ |
499a4c07 | 87 | CACHE_PROGRAM (); |
3616e9e9 | 88 | PUSH (program); |
03e6c165 | 89 | fp = sp + 1; |
3dbbe28d | 90 | ip = SCM_C_OBJCODE_BASE (bp); |
b7946e9e AW |
91 | /* MV-call frame, function & arguments */ |
92 | PUSH ((SCM)fp); /* dynamic link */ | |
b7946e9e | 93 | PUSH (0); /* mvra */ |
6c6a4439 | 94 | PUSH (0); /* ra */ |
3616e9e9 | 95 | PUSH (prog); |
6d14383e AW |
96 | if (SCM_UNLIKELY (sp + nargs >= stack_limit)) |
97 | goto vm_error_too_many_args; | |
98 | while (nargs--) | |
99 | PUSH (*argv++); | |
3d5ee0cd | 100 | } |
a98cef7e KN |
101 | |
102 | /* Let's go! */ | |
17e90c5e | 103 | BOOT_HOOK (); |
53e28ed9 | 104 | NEXT; |
a98cef7e KN |
105 | |
106 | #ifndef HAVE_LABELS_AS_VALUES | |
17e90c5e | 107 | vm_start: |
53e28ed9 | 108 | switch ((*ip++) & SCM_VM_INSTRUCTION_MASK) { |
a98cef7e KN |
109 | #endif |
110 | ||
83495480 AW |
111 | #include "vm-expand.h" |
112 | #include "vm-i-system.c" | |
113 | #include "vm-i-scheme.c" | |
114 | #include "vm-i-loader.c" | |
a98cef7e KN |
115 | |
116 | #ifndef HAVE_LABELS_AS_VALUES | |
53e28ed9 AW |
117 | default: |
118 | goto vm_error_bad_instruction; | |
a98cef7e KN |
119 | } |
120 | #endif | |
121 | ||
e06e857c AW |
122 | |
123 | vm_done: | |
124 | SYNC_ALL (); | |
e06e857c AW |
125 | return finish_args; |
126 | ||
17e90c5e KN |
127 | /* Errors */ |
128 | { | |
e06e857c AW |
129 | SCM err_msg; |
130 | ||
f6a8e791 AW |
131 | /* FIXME: need to sync regs before allocating anything, in each case. */ |
132 | ||
53e28ed9 | 133 | vm_error_bad_instruction: |
7ea9a0a7 | 134 | err_msg = scm_from_locale_string ("VM: Bad instruction: ~s"); |
da8b4747 | 135 | finish_args = scm_list_1 (scm_from_uchar (ip[-1])); |
53e28ed9 AW |
136 | goto vm_error; |
137 | ||
17e90c5e | 138 | vm_error_unbound: |
7ea9a0a7 | 139 | err_msg = scm_from_locale_string ("VM: Unbound variable: ~s"); |
17e90c5e KN |
140 | goto vm_error; |
141 | ||
4c9ad01d | 142 | vm_error_wrong_type_arg: |
fa19602c | 143 | err_msg = scm_from_locale_string ("VM: Wrong type argument"); |
e06e857c | 144 | finish_args = SCM_EOL; |
4c9ad01d KN |
145 | goto vm_error; |
146 | ||
7e01997e | 147 | vm_error_kwargs_length_not_even: |
f6a8e791 AW |
148 | SYNC_ALL (); |
149 | err_msg = scm_from_locale_string ("Odd length of keyword argument list"); | |
150 | scm_error_scm (sym_keyword_argument_error, program, err_msg, | |
151 | SCM_EOL, SCM_BOOL_F); | |
7e01997e AW |
152 | |
153 | vm_error_kwargs_invalid_keyword: | |
f6a8e791 AW |
154 | /* FIXME say which one it was */ |
155 | SYNC_ALL (); | |
156 | err_msg = scm_from_locale_string ("Invalid keyword"); | |
157 | scm_error_scm (sym_keyword_argument_error, program, err_msg, | |
158 | SCM_EOL, SCM_BOOL_F); | |
7e01997e AW |
159 | |
160 | vm_error_kwargs_unrecognized_keyword: | |
f6a8e791 AW |
161 | /* FIXME say which one it was */ |
162 | SYNC_ALL (); | |
163 | err_msg = scm_from_locale_string ("Unrecognized keyword"); | |
164 | scm_error_scm (sym_keyword_argument_error, program, err_msg, | |
165 | SCM_EOL, SCM_BOOL_F); | |
7e01997e | 166 | |
6d14383e AW |
167 | vm_error_too_many_args: |
168 | err_msg = scm_from_locale_string ("VM: Too many arguments"); | |
da8b4747 | 169 | finish_args = scm_list_1 (scm_from_int (nargs)); |
6d14383e AW |
170 | goto vm_error; |
171 | ||
17e90c5e | 172 | vm_error_wrong_num_args: |
9a8cc8e7 | 173 | /* nargs and program are valid */ |
0570c3f1 | 174 | SYNC_ALL (); |
9a8cc8e7 AW |
175 | scm_wrong_num_args (program); |
176 | /* shouldn't get here */ | |
17e90c5e KN |
177 | goto vm_error; |
178 | ||
179 | vm_error_wrong_type_apply: | |
7ea9a0a7 | 180 | SYNC_ALL (); |
5f161164 AW |
181 | scm_error (scm_arg_type_key, FUNC_NAME, "Wrong type to apply: ~S", |
182 | scm_list_1 (program), scm_list_1 (program)); | |
17e90c5e KN |
183 | goto vm_error; |
184 | ||
ac02b386 | 185 | vm_error_stack_overflow: |
fa19602c | 186 | err_msg = scm_from_locale_string ("VM: Stack overflow"); |
e06e857c | 187 | finish_args = SCM_EOL; |
17e90c5e | 188 | goto vm_error; |
17e90c5e | 189 | |
ac02b386 | 190 | vm_error_stack_underflow: |
fa19602c | 191 | err_msg = scm_from_locale_string ("VM: Stack underflow"); |
e06e857c | 192 | finish_args = SCM_EOL; |
17e90c5e KN |
193 | goto vm_error; |
194 | ||
1f40459f | 195 | vm_error_improper_list: |
7ea9a0a7 | 196 | err_msg = scm_from_locale_string ("Expected a proper list, but got object with tail ~s"); |
1f40459f AW |
197 | goto vm_error; |
198 | ||
5e390de6 AW |
199 | vm_error_not_a_pair: |
200 | SYNC_ALL (); | |
e06e857c | 201 | scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "pair"); |
5e390de6 AW |
202 | /* shouldn't get here */ |
203 | goto vm_error; | |
204 | ||
e6eb2467 AW |
205 | vm_error_not_a_bytevector: |
206 | SYNC_ALL (); | |
207 | scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "bytevector"); | |
208 | /* shouldn't get here */ | |
209 | goto vm_error; | |
210 | ||
bd91ecce LC |
211 | vm_error_not_a_struct: |
212 | SYNC_ALL (); | |
213 | scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "struct"); | |
214 | /* shouldn't get here */ | |
215 | goto vm_error; | |
216 | ||
4f66bcde AW |
217 | vm_error_not_a_thunk: |
218 | SYNC_ALL (); | |
219 | scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "thunk"); | |
220 | /* shouldn't get here */ | |
221 | goto vm_error; | |
222 | ||
a222b0fa | 223 | vm_error_no_values: |
7ea9a0a7 | 224 | err_msg = scm_from_locale_string ("Zero values returned to single-valued continuation"); |
e06e857c | 225 | finish_args = SCM_EOL; |
a222b0fa AW |
226 | goto vm_error; |
227 | ||
d51406fe | 228 | vm_error_not_enough_values: |
7ea9a0a7 | 229 | err_msg = scm_from_locale_string ("Too few values returned to continuation"); |
e06e857c | 230 | finish_args = SCM_EOL; |
d51406fe AW |
231 | goto vm_error; |
232 | ||
94ff26b9 AW |
233 | vm_error_bad_wide_string_length: |
234 | err_msg = scm_from_locale_string ("VM: Bad wide string length: ~S"); | |
235 | goto vm_error; | |
236 | ||
56a3dcd4 | 237 | #ifdef VM_CHECK_IP |
ac02b386 | 238 | vm_error_invalid_address: |
fa19602c | 239 | err_msg = scm_from_locale_string ("VM: Invalid program address"); |
e06e857c | 240 | finish_args = SCM_EOL; |
17e90c5e | 241 | goto vm_error; |
ac02b386 KN |
242 | #endif |
243 | ||
0b5f0e49 LC |
244 | #if VM_CHECK_OBJECT |
245 | vm_error_object: | |
246 | err_msg = scm_from_locale_string ("VM: Invalid object table access"); | |
e06e857c | 247 | finish_args = SCM_EOL; |
0b5f0e49 LC |
248 | goto vm_error; |
249 | #endif | |
250 | ||
57ab0671 AW |
251 | #if VM_CHECK_FREE_VARIABLES |
252 | vm_error_free_variable: | |
253 | err_msg = scm_from_locale_string ("VM: Invalid free variable access"); | |
8d90b356 AW |
254 | finish_args = SCM_EOL; |
255 | goto vm_error; | |
256 | #endif | |
257 | ||
17e90c5e KN |
258 | vm_error: |
259 | SYNC_ALL (); | |
a52b2d3d | 260 | |
da8b4747 LC |
261 | scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args), |
262 | 1); | |
17e90c5e KN |
263 | } |
264 | ||
a98cef7e KN |
265 | abort (); /* never reached */ |
266 | } | |
6d14383e AW |
267 | |
268 | #undef VM_USE_HOOKS | |
6d14383e | 269 | #undef VM_CHECK_OBJECT |
57ab0671 | 270 | #undef VM_CHECK_FREE_VARIABLE |
17e90c5e KN |
271 | |
272 | /* | |
273 | Local Variables: | |
274 | c-file-style: "gnu" | |
275 | End: | |
276 | */ |