Commit | Line | Data |
---|---|---|
a98cef7e KN |
1 | /* Copyright (C) 2000 Free Software Foundation, Inc. |
2 | * | |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program is distributed in the hope that it will be useful, | |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
16 | * Boston, MA 02111-1307 USA | |
17 | * | |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
40 | * If you do not wish that, delete this exception notice. */ | |
41 | ||
42 | /* This file is included in vm_engine.c */ | |
43 | ||
44 | /* | |
45 | * VM Options | |
46 | */ | |
47 | ||
48 | #undef VM_USE_BOOT_HOOK | |
49 | #undef VM_USE_HALT_HOOK | |
50 | #undef VM_USE_NEXT_HOOK | |
51 | #undef VM_USE_CALL_HOOK | |
52 | #undef VM_USE_APPLY_HOOK | |
53 | #undef VM_USE_RETURN_HOOK | |
54 | #undef VM_INIT_LOCAL_VARIABLES | |
55 | #undef VM_CHECK_LINK | |
56 | #undef VM_CHECK_BINDING | |
57 | #undef VM_CHECK_PROGRAM_COUNTER | |
58 | ||
59 | #if VM_ENGINE == SCM_VM_REGULAR_ENGINE | |
60 | #define VM_USE_BOOT_HOOK 0 | |
61 | #define VM_USE_HALT_HOOK 0 | |
62 | #define VM_USE_NEXT_HOOK 0 | |
63 | #define VM_USE_CALL_HOOK 0 | |
64 | #define VM_USE_APPLY_HOOK 0 | |
65 | #define VM_USE_RETURN_HOOK 0 | |
66 | #define VM_INIT_LOCAL_VARIABLES 0 | |
67 | #define VM_CHECK_LINK 0 | |
68 | #define VM_CHECK_BINDING 1 | |
69 | #define VM_CHECK_PROGRAM_COUNTER 0 | |
70 | #else | |
71 | #if VM_ENGINE == SCM_VM_DEBUG_ENGINE | |
72 | #define VM_USE_BOOT_HOOK 1 | |
73 | #define VM_USE_HALT_HOOK 1 | |
74 | #define VM_USE_NEXT_HOOK 1 | |
75 | #define VM_USE_CALL_HOOK 1 | |
76 | #define VM_USE_APPLY_HOOK 1 | |
77 | #define VM_USE_RETURN_HOOK 1 | |
78 | #define VM_INIT_LOCAL_VARIABLES 1 | |
79 | #define VM_CHECK_LINK 1 | |
80 | #define VM_CHECK_BINDING 1 | |
81 | #define VM_CHECK_PROGRAM_COUNTER 1 | |
82 | #endif | |
83 | #endif | |
84 | ||
85 | #undef VM_USE_HOOK | |
86 | #if VM_USE_BOOT_HOOK || VM_USE_HALT_HOOK || VM_USE_NEXT_HOOK \ | |
87 | || VM_USE_CALL_HOOK || VM_USE_APPLY_HOOK || VM_USE_RETURN_HOOK | |
88 | #define VM_USE_HOOK 1 | |
89 | #else | |
90 | #define VM_USE_HOOK 0 | |
91 | #endif | |
92 | ||
93 | \f | |
94 | /* | |
95 | * Type checking | |
96 | */ | |
97 | ||
98 | #define VM_ASSERT_PROGRAM(OBJ) SCM_VALIDATE_PROGRAM (1, OBJ) | |
99 | ||
100 | #undef VM_ASSERT_BOUND | |
101 | #if VM_CHECK_BINDING | |
102 | #define VM_ASSERT_BOUND(CELL) \ | |
103 | if (SCM_UNBNDP (SCM_CDR (CELL))) \ | |
104 | SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CAR (CELL))) | |
105 | #else | |
106 | #define VM_ASSERT_BOUND(CELL) | |
107 | #endif | |
108 | ||
109 | #undef VM_ASSERT_LINK | |
110 | #if VM_CHECK_LINK | |
111 | #define VM_ASSERT_LINK(OBJ) \ | |
112 | if (SCM_FALSEP (OBJ)) \ | |
113 | SCM_MISC_ERROR ("VM broken link", SCM_EOL) | |
114 | #else | |
115 | #define VM_ASSERT_LINK(OBJ) | |
116 | #endif | |
117 | ||
118 | \f | |
119 | /* | |
120 | * Hooks | |
121 | */ | |
122 | ||
123 | #undef VM_BOOT_HOOK | |
124 | #if VM_USE_BOOT_HOOK | |
125 | #define VM_BOOT_HOOK() SYNC (); scm_c_run_hook (vmp->boot_hook, hook_args) | |
126 | #else | |
127 | #define VM_BOOT_HOOK() | |
128 | #endif | |
129 | ||
130 | #undef VM_HALT_HOOK | |
131 | #if VM_USE_HALT_HOOK | |
132 | #define VM_HALT_HOOK() SYNC (); scm_c_run_hook (vmp->halt_hook, hook_args) | |
133 | #else | |
134 | #define VM_HALT_HOOK() | |
135 | #endif | |
136 | ||
137 | #undef VM_NEXT_HOOK | |
138 | #if VM_USE_NEXT_HOOK | |
139 | #define VM_NEXT_HOOK() SYNC (); scm_c_run_hook (vmp->next_hook, hook_args) | |
140 | #else | |
141 | #define VM_NEXT_HOOK() | |
142 | #endif | |
143 | ||
144 | #undef VM_CALL_HOOK | |
145 | #if VM_USE_CALL_HOOK | |
146 | #define VM_CALL_HOOK() SYNC (); scm_c_run_hook (vmp->call_hook, hook_args) | |
147 | #else | |
148 | #define VM_CALL_HOOK() | |
149 | #endif | |
150 | ||
151 | #undef VM_APPLY_HOOK | |
152 | #if VM_USE_APPLY_HOOK | |
153 | #define VM_APPLY_HOOK() SYNC (); scm_c_run_hook (vmp->apply_hook, hook_args) | |
154 | #else | |
155 | #define VM_APPLY_HOOK() | |
156 | #endif | |
157 | ||
158 | #undef VM_RETURN_HOOK | |
159 | #if VM_USE_RETURN_HOOK | |
160 | #define VM_RETURN_HOOK() SYNC (); scm_c_run_hook (vmp->return_hook, hook_args) | |
161 | #else | |
162 | #define VM_RETURN_HOOK() | |
163 | #endif | |
164 | ||
165 | \f | |
166 | /* | |
167 | * Basic operations | |
168 | */ | |
169 | ||
170 | #define LOAD() \ | |
171 | { \ | |
172 | ac = vmp->ac; \ | |
173 | pc = vmp->pc; \ | |
174 | sp = vmp->sp; \ | |
175 | fp = vmp->fp; \ | |
176 | stack_base = vmp->stack_base; \ | |
177 | stack_limit = vmp->stack_limit; \ | |
178 | } | |
179 | ||
180 | #define SYNC() \ | |
181 | { \ | |
182 | vmp->ac = ac; \ | |
183 | vmp->pc = pc; \ | |
184 | vmp->sp = sp; \ | |
185 | vmp->fp = fp; \ | |
186 | } | |
187 | ||
188 | #define FETCH() *pc++ | |
189 | ||
190 | #define CONS(X,Y,Z) \ | |
191 | { \ | |
192 | SCM cell; \ | |
193 | SYNC (); \ | |
194 | SCM_NEWCELL (cell); \ | |
195 | SCM_SET_CELL_OBJECT_0 (cell, Y); \ | |
196 | SCM_SET_CELL_OBJECT_1 (cell, Z); \ | |
197 | X = cell; \ | |
198 | } | |
199 | ||
200 | #define VM_SETUP_ARGS2() an = 2; a2 = ac; POP (ac); | |
201 | #define VM_SETUP_ARGS3() an = 3; a3 = ac; POP (a2); POP (ac); | |
202 | #define VM_SETUP_ARGS4() an = 4; a4 = ac; POP (a3); POP (a2); POP (ac); | |
203 | #define VM_SETUP_ARGSN() an = SCM_INUM (FETCH ()); | |
204 | ||
205 | \f | |
206 | /* | |
207 | * Stack operation | |
208 | */ | |
209 | ||
210 | #define PUSH(X) \ | |
211 | { \ | |
212 | if (sp < stack_base) \ | |
213 | SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \ | |
214 | *sp-- = (X); \ | |
215 | } | |
216 | ||
217 | #define POP(X) \ | |
218 | { \ | |
219 | if (sp == stack_limit) \ | |
220 | SCM_MISC_ERROR ("FIXME: Stack underflow", SCM_EOL); \ | |
221 | (X) = *++sp; \ | |
222 | } | |
223 | ||
224 | #define POP_LIST(N,L) \ | |
225 | { \ | |
226 | while (N-- > 0) \ | |
227 | { \ | |
228 | SCM obj; \ | |
229 | POP (obj); \ | |
230 | CONS (L, obj, L); \ | |
231 | } \ | |
232 | } | |
233 | ||
234 | \f | |
235 | /* | |
236 | * Frame allocation | |
237 | */ | |
238 | ||
239 | /* an = the number of arguments */ | |
240 | #define VM_SETUP_ARGS(PROG,NREQS,RESTP) \ | |
241 | { \ | |
242 | if (RESTP) \ | |
243 | /* have a rest argument */ \ | |
244 | { \ | |
245 | SCM list; \ | |
246 | if (an < NREQS) \ | |
247 | scm_wrong_num_args (PROG); \ | |
248 | \ | |
249 | /* Construct the rest argument list */ \ | |
250 | an -= NREQS; /* the number of rest arguments */ \ | |
251 | list = SCM_EOL; /* list of the rest arguments */ \ | |
252 | POP_LIST (an, list); \ | |
253 | PUSH (list); \ | |
254 | } \ | |
255 | else \ | |
256 | /* not have a rest argument */ \ | |
257 | { \ | |
258 | if (an != NREQS) \ | |
259 | scm_wrong_num_args (PROG); \ | |
260 | } \ | |
261 | } | |
262 | ||
263 | #define VM_EXPORT_ARGS(FP,PROG) \ | |
264 | { \ | |
265 | int *exts = SCM_PROGRAM_EXTS (PROG); \ | |
266 | if (exts) \ | |
267 | { \ | |
268 | int n = exts[0]; \ | |
269 | while (n-- > 0) \ | |
270 | SCM_VM_EXTERNAL_VARIABLE (SCM_PROGRAM_ENV (PROG), n) \ | |
271 | = SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]); \ | |
272 | } \ | |
273 | } | |
274 | ||
275 | #undef VM_FRAME_INIT_VARIABLES | |
276 | #if VM_INIT_LOCAL_VARIABLES | |
277 | /* This is necessary when creating frame objects for debugging */ | |
278 | #define VM_FRAME_INIT_VARIABLES(FP,NVARS) \ | |
279 | { \ | |
280 | int i; \ | |
281 | for (i = 0; i < NVARS; i++) \ | |
282 | SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED; \ | |
283 | } | |
284 | #else | |
285 | #define VM_FRAME_INIT_VARIABLES(FP,NVARS) | |
286 | #endif | |
287 | ||
288 | #define VM_NEW_FRAME(FP,PROG,DL,SP,RA) \ | |
289 | { \ | |
290 | int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */ \ | |
291 | int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \ | |
292 | int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \ | |
293 | \ | |
294 | VM_SETUP_ARGS (PROG, nreqs, restp); \ | |
295 | if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1) \ | |
296 | SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \ | |
297 | sp -= nvars + SCM_VM_FRAME_DATA_SIZE; \ | |
298 | FP = sp + SCM_VM_FRAME_DATA_SIZE + 1; \ | |
299 | SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars); \ | |
300 | SCM_VM_FRAME_PROGRAM (FP) = PROG; \ | |
301 | SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL; \ | |
302 | SCM_VM_FRAME_STACK_POINTER (FP) = SP; \ | |
303 | SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA; \ | |
304 | VM_FRAME_INIT_VARIABLES (FP, nvars); \ | |
305 | VM_EXPORT_ARGS (FP, PROG); \ | |
306 | } | |
307 | ||
308 | \f | |
309 | /* | |
310 | * Goto next | |
311 | */ | |
312 | ||
313 | #undef VM_PROGRAM_COUNTER_CHECK | |
314 | #if VM_CHECK_PROGRAM_COUNTER | |
315 | #define VM_PROGRAM_COUNTER_CHECK() \ | |
316 | { \ | |
317 | SCM prog = SCM_VM_FRAME_PROGRAM (fp); \ | |
318 | if (pc < SCM_PROGRAM_BASE (prog) \ | |
319 | || pc >= (SCM_PROGRAM_BASE (prog) + SCM_PROGRAM_SIZE (prog))) \ | |
320 | SCM_MISC_ERROR ("VM accessed invalid program address", SCM_EOL); \ | |
321 | } | |
322 | #else | |
323 | #define VM_PROGRAM_COUNTER_CHECK() | |
324 | #endif | |
325 | ||
326 | #undef VM_GOTO_NEXT | |
327 | #if HAVE_LABELS_AS_VALUES | |
328 | #if VM_ENGINE == SCM_VM_DEBUG_ENGINE | |
329 | #define VM_GOTO_NEXT() goto *SCM_CODE_TO_DEBUG_ADDR (FETCH ()) | |
330 | #else /* not SCM_VM_DEBUG_ENGINE */ | |
331 | #define VM_GOTO_NEXT() goto *SCM_CODE_TO_ADDR (FETCH ()) | |
332 | #endif | |
333 | #else /* not HAVE_LABELS_AS_VALUES */ | |
334 | #define VM_GOTO_NEXT() goto vm_start | |
335 | #endif | |
336 | ||
337 | #define NEXT \ | |
338 | { \ | |
339 | VM_PROGRAM_COUNTER_CHECK (); \ | |
340 | VM_NEXT_HOOK (); \ | |
341 | VM_GOTO_NEXT (); \ | |
342 | } | |
343 | ||
344 | /* Just an abbreviation */ | |
345 | #define RETURN(X) { ac = (X); NEXT; } |