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