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