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 | ||
a98cef7e KN |
44 | \f |
45 | /* | |
46 | * Basic operations | |
47 | */ | |
48 | ||
17e90c5e KN |
49 | /* This must be the first instruction! */ |
50 | VM_DEFINE_INSTRUCTION (nop, "nop", 0) | |
a98cef7e KN |
51 | { |
52 | NEXT; | |
53 | } | |
54 | ||
17e90c5e | 55 | VM_DEFINE_INSTRUCTION (halt, "halt", 0) |
a98cef7e | 56 | { |
17e90c5e KN |
57 | SCM ret = *sp; |
58 | HALT_HOOK (); | |
59 | FREE_FRAME (); | |
60 | SYNC_ALL (); | |
61 | return ret; | |
a98cef7e KN |
62 | } |
63 | ||
17e90c5e | 64 | VM_DEFINE_INSTRUCTION (drop, "drop", 0) |
a98cef7e | 65 | { |
17e90c5e | 66 | DROP (); |
a98cef7e KN |
67 | NEXT; |
68 | } | |
69 | ||
17e90c5e | 70 | VM_DEFINE_INSTRUCTION (dup, "dup", 0) |
26403690 | 71 | { |
17e90c5e | 72 | PUSH (*sp); |
26403690 KN |
73 | NEXT; |
74 | } | |
75 | ||
17e90c5e KN |
76 | \f |
77 | /* | |
78 | * Object creation | |
79 | */ | |
a98cef7e | 80 | |
17e90c5e | 81 | VM_DEFINE_INSTRUCTION (void, "void", 0) |
a98cef7e | 82 | { |
17e90c5e | 83 | PUSH (SCM_UNSPECIFIED); |
a98cef7e KN |
84 | NEXT; |
85 | } | |
86 | ||
17e90c5e | 87 | VM_DEFINE_INSTRUCTION (mark, "mark", 0) |
a98cef7e | 88 | { |
17e90c5e | 89 | PUSH (SCM_UNDEFINED); |
a98cef7e KN |
90 | NEXT; |
91 | } | |
92 | ||
17e90c5e | 93 | VM_DEFINE_INSTRUCTION (make_true, "make-true", 0) |
a98cef7e | 94 | { |
17e90c5e | 95 | PUSH (SCM_BOOL_T); |
a98cef7e KN |
96 | NEXT; |
97 | } | |
98 | ||
17e90c5e | 99 | VM_DEFINE_INSTRUCTION (make_false, "make-false", 0) |
a98cef7e | 100 | { |
17e90c5e | 101 | PUSH (SCM_BOOL_F); |
a98cef7e KN |
102 | NEXT; |
103 | } | |
104 | ||
17e90c5e | 105 | VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0) |
a98cef7e | 106 | { |
17e90c5e | 107 | PUSH (SCM_EOL); |
a98cef7e KN |
108 | NEXT; |
109 | } | |
110 | ||
17e90c5e | 111 | VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1) |
a98cef7e | 112 | { |
17e90c5e | 113 | PUSH (SCM_MAKINUM ((signed char) FETCH ())); |
a98cef7e KN |
114 | NEXT; |
115 | } | |
116 | ||
17e90c5e | 117 | VM_DEFINE_INSTRUCTION (make_int8_0, "make-int8:0", 0) |
a98cef7e | 118 | { |
17e90c5e | 119 | PUSH (SCM_MAKINUM (0)); |
a98cef7e KN |
120 | NEXT; |
121 | } | |
122 | ||
17e90c5e | 123 | VM_DEFINE_INSTRUCTION (make_int8_1, "make-int8:1", 0) |
a98cef7e | 124 | { |
17e90c5e | 125 | PUSH (SCM_MAKINUM (1)); |
a98cef7e KN |
126 | NEXT; |
127 | } | |
128 | ||
17e90c5e | 129 | VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2) |
a98cef7e | 130 | { |
ea9b4b29 KN |
131 | int h = FETCH (); |
132 | int l = FETCH (); | |
133 | PUSH (SCM_MAKINUM ((signed short) (h << 8) + l)); | |
a98cef7e KN |
134 | NEXT; |
135 | } | |
136 | ||
17e90c5e | 137 | VM_DEFINE_INSTRUCTION (make_char8, "make-char8", 1) |
a98cef7e | 138 | { |
17e90c5e | 139 | PUSH (SCM_MAKE_CHAR (FETCH ())); |
a98cef7e KN |
140 | NEXT; |
141 | } | |
142 | ||
143 | \f | |
144 | /* | |
17e90c5e | 145 | * Variable access |
a98cef7e KN |
146 | */ |
147 | ||
17e90c5e KN |
148 | #define OBJECT_REF(i) objects[i] |
149 | #define OBJECT_SET(i,o) objects[i] = o | |
a98cef7e | 150 | |
17e90c5e KN |
151 | #define LOCAL_REF(i) SCM_VM_FRAME_VARIABLE (fp, i) |
152 | #define LOCAL_SET(i,o) SCM_VM_FRAME_VARIABLE (fp, i) = o | |
a98cef7e | 153 | |
17e90c5e KN |
154 | #define VARIABLE_REF(v) SCM_CDR (v) |
155 | #define VARIABLE_SET(v,o) SCM_SETCDR (v, o) | |
a98cef7e | 156 | |
17e90c5e | 157 | VM_DEFINE_INSTRUCTION (external, "external", 1) |
a98cef7e | 158 | { |
17e90c5e KN |
159 | int n = FETCH (); |
160 | while (n-- > 0) | |
161 | CONS (external, SCM_UNDEFINED, external); | |
162 | NEXT; | |
a98cef7e KN |
163 | } |
164 | ||
17e90c5e | 165 | /* ref */ |
a98cef7e | 166 | |
17e90c5e | 167 | VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1) |
a98cef7e | 168 | { |
17e90c5e KN |
169 | PUSH (OBJECT_REF (FETCH ())); |
170 | NEXT; | |
a98cef7e KN |
171 | } |
172 | ||
17e90c5e | 173 | VM_DEFINE_INSTRUCTION (local_ref, "local-ref", 1) |
a98cef7e | 174 | { |
17e90c5e KN |
175 | PUSH (LOCAL_REF (FETCH ())); |
176 | NEXT; | |
a98cef7e KN |
177 | } |
178 | ||
17e90c5e | 179 | VM_DEFINE_INSTRUCTION (local_ref_0, "local-ref:0", 0) |
a98cef7e | 180 | { |
17e90c5e | 181 | PUSH (LOCAL_REF (0)); |
a98cef7e KN |
182 | NEXT; |
183 | } | |
184 | ||
17e90c5e | 185 | VM_DEFINE_INSTRUCTION (external_ref, "external-ref", 1) |
a98cef7e | 186 | { |
17e90c5e KN |
187 | unsigned int i; |
188 | SCM e = external; | |
189 | for (i = FETCH (); i; i--) | |
190 | e = SCM_CDR (e); | |
191 | PUSH (SCM_CAR (e)); | |
a98cef7e KN |
192 | NEXT; |
193 | } | |
194 | ||
17e90c5e | 195 | VM_DEFINE_INSTRUCTION (module_ref, "module-ref", 1) |
a98cef7e | 196 | { |
17e90c5e KN |
197 | int i = FETCH (); |
198 | SCM o, x = OBJECT_REF (i); | |
199 | o = VARIABLE_REF (x); | |
200 | if (SCM_UNBNDP (o)) | |
201 | { | |
202 | err_args = SCM_LIST1 (SCM_CAR (x)); | |
203 | goto vm_error_unbound; | |
204 | } | |
205 | PUSH (o); | |
a98cef7e KN |
206 | NEXT; |
207 | } | |
208 | ||
17e90c5e | 209 | VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0) |
a98cef7e | 210 | { |
17e90c5e KN |
211 | SCM x = *sp; |
212 | SCM o = VARIABLE_REF (x); | |
213 | if (SCM_UNBNDP (o)) | |
214 | { | |
215 | err_args = SCM_LIST1 (SCM_CAR (x)); | |
216 | goto vm_error_unbound; | |
217 | } | |
218 | *sp = o; | |
a98cef7e KN |
219 | NEXT; |
220 | } | |
221 | ||
17e90c5e KN |
222 | /* set */ |
223 | ||
224 | VM_DEFINE_INSTRUCTION (local_set, "local-set", 1) | |
a98cef7e | 225 | { |
17e90c5e KN |
226 | LOCAL_SET (FETCH (), *sp); |
227 | DROP (); | |
a98cef7e KN |
228 | NEXT; |
229 | } | |
230 | ||
17e90c5e | 231 | VM_DEFINE_INSTRUCTION (external_set, "external-set", 1) |
a98cef7e | 232 | { |
17e90c5e KN |
233 | unsigned int i; |
234 | SCM e = external; | |
235 | for (i = FETCH (); i; i--) | |
236 | e = SCM_CDR (e); | |
237 | SCM_SETCAR (e, *sp); | |
238 | DROP (); | |
a98cef7e KN |
239 | NEXT; |
240 | } | |
241 | ||
17e90c5e | 242 | VM_DEFINE_INSTRUCTION (module_set, "module-set", 1) |
a98cef7e | 243 | { |
17e90c5e KN |
244 | int i = FETCH (); |
245 | SCM x = OBJECT_REF (i); | |
246 | VARIABLE_SET (x, *sp); | |
247 | DROP (); | |
a98cef7e KN |
248 | NEXT; |
249 | } | |
250 | ||
17e90c5e | 251 | VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0) |
a98cef7e | 252 | { |
17e90c5e KN |
253 | VARIABLE_SET (sp[0], sp[1]); |
254 | sp += 2; | |
a98cef7e KN |
255 | NEXT; |
256 | } | |
257 | ||
258 | \f | |
259 | /* | |
260 | * branch and jump | |
261 | */ | |
262 | ||
17e90c5e KN |
263 | #define BR(p) \ |
264 | { \ | |
265 | signed char offset = FETCH (); \ | |
266 | if (p) \ | |
267 | ip += offset; \ | |
268 | DROP (); \ | |
269 | NEXT; \ | |
270 | } | |
271 | ||
272 | VM_DEFINE_INSTRUCTION (br_if, "br-if", 1) | |
a98cef7e | 273 | { |
17e90c5e | 274 | BR (!SCM_FALSEP (*sp)); |
a98cef7e KN |
275 | } |
276 | ||
17e90c5e | 277 | VM_DEFINE_INSTRUCTION (br_if_not, "br-if-not", 1) |
a98cef7e | 278 | { |
17e90c5e | 279 | BR (SCM_FALSEP (*sp)); |
a98cef7e KN |
280 | } |
281 | ||
17e90c5e | 282 | VM_DEFINE_INSTRUCTION (br_if_eq, "br-if-eq", 1) |
a98cef7e | 283 | { |
17e90c5e | 284 | BR (SCM_EQ_P (sp[0], sp--[1])); |
a98cef7e KN |
285 | } |
286 | ||
17e90c5e | 287 | VM_DEFINE_INSTRUCTION (br_if_not_eq, "br-if-not-eq", 1) |
a98cef7e | 288 | { |
17e90c5e KN |
289 | BR (!SCM_EQ_P (sp[0], sp--[1])); |
290 | } | |
291 | ||
292 | VM_DEFINE_INSTRUCTION (br_if_null, "br-if-null", 1) | |
293 | { | |
294 | BR (SCM_NULLP (*sp)); | |
295 | } | |
296 | ||
297 | VM_DEFINE_INSTRUCTION (br_if_not_null, "br-if-not-null", 1) | |
298 | { | |
299 | BR (!SCM_NULLP (*sp)); | |
a98cef7e KN |
300 | } |
301 | ||
17e90c5e | 302 | VM_DEFINE_INSTRUCTION (jump, "jump", 1) |
a98cef7e | 303 | { |
17e90c5e | 304 | ip += (signed char) FETCH (); |
a98cef7e KN |
305 | NEXT; |
306 | } | |
307 | ||
308 | \f | |
309 | /* | |
310 | * Subprogram call | |
311 | */ | |
312 | ||
17e90c5e | 313 | VM_DEFINE_INSTRUCTION (make_closure, "make-closure", 0) |
a98cef7e | 314 | { |
17e90c5e KN |
315 | SYNC (); |
316 | *sp = scm_c_make_vclosure (*sp, external); | |
317 | NEXT; | |
a98cef7e KN |
318 | } |
319 | ||
17e90c5e | 320 | VM_DEFINE_INSTRUCTION (call, "call", 1) |
a98cef7e | 321 | { |
17e90c5e KN |
322 | POP (program); |
323 | nargs = FETCH (); | |
a98cef7e KN |
324 | |
325 | vm_call: | |
326 | /* | |
327 | * Subprogram call | |
328 | */ | |
17e90c5e | 329 | if (SCM_PROGRAM_P (program)) |
a98cef7e | 330 | { |
17e90c5e KN |
331 | CACHE_PROGRAM (); |
332 | INIT_ARGS (); | |
333 | NEW_FRAME (); | |
334 | INIT_VARIABLES (); | |
335 | ENTER_HOOK (); | |
336 | APPLY_HOOK (); | |
a98cef7e KN |
337 | NEXT; |
338 | } | |
339 | /* | |
340 | * Function call | |
341 | */ | |
17e90c5e | 342 | if (!SCM_FALSEP (scm_procedure_p (program))) |
a98cef7e | 343 | { |
17e90c5e KN |
344 | POP_LIST (nargs); |
345 | *sp = scm_apply (program, *sp, SCM_EOL); | |
346 | program = SCM_VM_FRAME_PROGRAM (fp); | |
347 | NEXT; | |
a98cef7e KN |
348 | } |
349 | /* | |
350 | * Continuation call | |
351 | */ | |
17e90c5e | 352 | if (SCM_VM_CONT_P (program)) |
a98cef7e KN |
353 | { |
354 | vm_call_cc: | |
355 | /* Check the number of arguments */ | |
382693fe | 356 | if (nargs != 1) |
17e90c5e | 357 | scm_wrong_num_args (program); |
a98cef7e KN |
358 | |
359 | /* Reinstate the continuation */ | |
17e90c5e KN |
360 | EXIT_HOOK (); |
361 | reinstate_vm_cont (vmp, program); | |
362 | CACHE (); | |
363 | /* We don't need to set the return value here | |
364 | because it is already on the top of the stack. */ | |
a98cef7e KN |
365 | NEXT; |
366 | } | |
367 | ||
17e90c5e | 368 | goto vm_error_wrong_type_apply; |
a98cef7e KN |
369 | } |
370 | ||
17e90c5e | 371 | VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1) |
a98cef7e | 372 | { |
17e90c5e KN |
373 | SCM x; |
374 | POP (x); | |
375 | nargs = FETCH (); | |
376 | ||
377 | SCM_TICK; /* allow interrupt here */ | |
a98cef7e KN |
378 | |
379 | /* | |
17e90c5e | 380 | * Tail recursive call |
a98cef7e | 381 | */ |
17e90c5e | 382 | if (SCM_EQ_P (x, program)) |
a98cef7e | 383 | { |
17e90c5e KN |
384 | INIT_ARGS (); |
385 | ||
386 | /* Move arguments */ | |
387 | if (bp->nargs) | |
a98cef7e | 388 | { |
17e90c5e KN |
389 | int i; |
390 | SCM *base = fp + bp->nlocs; | |
391 | for (i = 0; i < bp->nargs; i++) | |
392 | base[i] = sp[i]; | |
a98cef7e KN |
393 | } |
394 | ||
17e90c5e KN |
395 | ip = bp->base; |
396 | sp = SCM_VM_FRAME_LOWER_ADDRESS (fp); | |
397 | APPLY_HOOK (); | |
a98cef7e KN |
398 | NEXT; |
399 | } | |
17e90c5e KN |
400 | program = x; |
401 | /* | |
402 | * Proper tail call | |
403 | */ | |
404 | if (SCM_PROGRAM_P (program)) | |
405 | { | |
406 | int i; | |
407 | int n = SCM_VM_FRAME_LOWER_ADDRESS (fp) - sp; | |
408 | SCM *base = sp; | |
409 | ||
410 | /* Exit the current frame */ | |
411 | EXIT_HOOK (); | |
412 | FREE_FRAME (); | |
413 | ||
414 | /* Move arguments */ | |
415 | sp -= n; | |
416 | for (i = 0; i < n; i++) | |
417 | sp[i] = base[i]; | |
418 | ||
419 | /* Call the program */ | |
420 | goto vm_call; | |
421 | } | |
a98cef7e KN |
422 | /* |
423 | * Function call | |
424 | */ | |
17e90c5e | 425 | if (!SCM_FALSEP (scm_procedure_p (program))) |
a98cef7e | 426 | { |
17e90c5e KN |
427 | POP_LIST (nargs); |
428 | *sp = scm_apply (program, *sp, SCM_EOL); | |
429 | program = SCM_VM_FRAME_PROGRAM (fp); | |
a98cef7e KN |
430 | goto vm_return; |
431 | } | |
432 | /* | |
433 | * Continuation call | |
434 | */ | |
17e90c5e | 435 | if (SCM_VM_CONT_P (program)) |
a98cef7e KN |
436 | goto vm_call_cc; |
437 | ||
17e90c5e KN |
438 | goto vm_error_wrong_type_apply; |
439 | } | |
440 | ||
441 | VM_DEFINE_INSTRUCTION (call_cc, "call/cc", 1) | |
442 | { | |
443 | SYNC (); | |
444 | PUSH (capture_vm_cont (vmp)); | |
445 | POP (program); | |
446 | nargs = 1; | |
447 | goto vm_call; | |
a98cef7e KN |
448 | } |
449 | ||
17e90c5e | 450 | VM_DEFINE_INSTRUCTION (return, "return", 0) |
a98cef7e | 451 | { |
17e90c5e | 452 | SCM ret; |
a98cef7e | 453 | vm_return: |
17e90c5e KN |
454 | ret = *sp; |
455 | EXIT_HOOK (); | |
456 | RETURN_HOOK (); | |
457 | FREE_FRAME (); | |
458 | ||
459 | /* Cache the last program */ | |
460 | program = SCM_VM_FRAME_PROGRAM (fp); | |
461 | CACHE_PROGRAM (); | |
462 | PUSH (ret); | |
a98cef7e KN |
463 | NEXT; |
464 | } | |
17e90c5e KN |
465 | |
466 | \f | |
467 | /* | |
468 | * Exception handling | |
469 | */ | |
470 | ||
471 | VM_DEFINE_INSTRUCTION (raise, "raise", 1) | |
472 | { | |
473 | } | |
474 | ||
475 | VM_DEFINE_INSTRUCTION (catch, "catch", 0) | |
476 | { | |
477 | } | |
478 | ||
479 | VM_DEFINE_INSTRUCTION (stack_catch, "stach_catch", 0) | |
480 | { | |
481 | } | |
482 | ||
483 | /* | |
484 | Local Variables: | |
485 | c-file-style: "gnu" | |
486 | End: | |
487 | */ |