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