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