Unnecessary VM_HANDLE_INTERRUPTS elision
[bpt/guile.git] / libguile / vm-engine.c
1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
2 *
3 * This library is free software; you can redistribute it and/or
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.
7 *
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
12 *
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
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16 * 02110-1301 USA
17 */
18
19 /* This file is included in vm.c multiple times. */
20
21
22 #define UNPACK_8_8_8(op,a,b,c) \
23 do \
24 { \
25 a = (op >> 8) & 0xff; \
26 b = (op >> 16) & 0xff; \
27 c = op >> 24; \
28 } \
29 while (0)
30
31 #define UNPACK_8_16(op,a,b) \
32 do \
33 { \
34 a = (op >> 8) & 0xff; \
35 b = op >> 16; \
36 } \
37 while (0)
38
39 #define UNPACK_16_8(op,a,b) \
40 do \
41 { \
42 a = (op >> 8) & 0xffff; \
43 b = op >> 24; \
44 } \
45 while (0)
46
47 #define UNPACK_12_12(op,a,b) \
48 do \
49 { \
50 a = (op >> 8) & 0xfff; \
51 b = op >> 20; \
52 } \
53 while (0)
54
55 #define UNPACK_24(op,a) \
56 do \
57 { \
58 a = op >> 8; \
59 } \
60 while (0)
61
62
63 /* Assign some registers by hand. There used to be a bigger list here,
64 but it was never tested, and in the case of x86-32, was a source of
65 compilation failures. It can be revived if it's useful, but my naive
66 hope is that simply annotating the locals with "register" will be a
67 sufficient hint to the compiler. */
68 #ifdef __GNUC__
69 # if defined __x86_64__
70 /* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
71 well. Tell it to keep the jump table in a r12, which is
72 callee-saved. */
73 # define JT_REG asm ("r12")
74 # endif
75 #endif
76
77 #ifndef IP_REG
78 # define IP_REG
79 #endif
80 #ifndef FP_REG
81 # define FP_REG
82 #endif
83 #ifndef JT_REG
84 # define JT_REG
85 #endif
86
87 #define VM_ASSERT(condition, handler) \
88 do { \
89 if (SCM_UNLIKELY (!(condition))) \
90 { \
91 SYNC_IP(); \
92 handler; \
93 } \
94 } while (0)
95
96 #ifdef VM_ENABLE_ASSERTIONS
97 # define ASSERT(condition) VM_ASSERT (condition, abort())
98 #else
99 # define ASSERT(condition)
100 #endif
101
102 #if VM_USE_HOOKS
103 #define RUN_HOOK(exp) \
104 do { \
105 if (SCM_UNLIKELY (vp->trace_level > 0)) \
106 { \
107 SYNC_IP (); \
108 exp; \
109 CACHE_FP (); \
110 } \
111 } while (0)
112 #else
113 #define RUN_HOOK(exp)
114 #endif
115 #define RUN_HOOK0(h) RUN_HOOK (vm_dispatch_##h##_hook (vp))
116 #define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (vp, arg))
117
118 #define APPLY_HOOK() \
119 RUN_HOOK0 (apply)
120 #define PUSH_CONTINUATION_HOOK() \
121 RUN_HOOK0 (push_continuation)
122 #define POP_CONTINUATION_HOOK(old_fp) \
123 RUN_HOOK1 (pop_continuation, old_fp)
124 #define NEXT_HOOK() \
125 RUN_HOOK0 (next)
126 #define ABORT_CONTINUATION_HOOK() \
127 RUN_HOOK0 (abort)
128
129 #define VM_HANDLE_INTERRUPTS \
130 SCM_ASYNC_TICK_WITH_GUARD_CODE (current_thread, SYNC_IP (), CACHE_FP ())
131
132
133 /* Virtual Machine
134
135 This is Guile's new virtual machine. When I say "new", I mean
136 relative to the current virtual machine. At some point it will
137 become "the" virtual machine, and we'll delete this paragraph. As
138 such, the rest of the comments speak as if there's only one VM.
139 In difference from the old VM, local 0 is the procedure, and the
140 first argument is local 1. At some point in the future we should
141 change the fp to point to the procedure and not to local 1.
142
143 <more overview here>
144 */
145
146
147 /* The VM has three state bits: the instruction pointer (IP), the frame
148 pointer (FP), and the top-of-stack pointer (SP). We cache the first
149 two of these in machine registers, local to the VM, because they are
150 used extensively by the VM. As the SP is used more by code outside
151 the VM than by the VM itself, we don't bother caching it locally.
152
153 Since the FP changes infrequently, relative to the IP, we keep vp->fp
154 in sync with the local FP. This would be a big lose for the IP,
155 though, so instead of updating vp->ip all the time, we call SYNC_IP
156 whenever we would need to know the IP of the top frame. In practice,
157 we need to SYNC_IP whenever we call out of the VM to a function that
158 would like to walk the stack, perhaps as the result of an
159 exception.
160
161 One more thing. We allow the stack to move, when it expands.
162 Therefore if you call out to a C procedure that could call Scheme
163 code, or otherwise push anything on the stack, you will need to
164 CACHE_FP afterwards to restore the possibly-changed FP. */
165
166 #define SYNC_IP() vp->ip = (ip)
167
168 #define CACHE_FP() fp = (vp->fp)
169 #define CACHE_REGISTER() \
170 do { \
171 ip = vp->ip; \
172 fp = vp->fp; \
173 } while (0)
174
175
176
177 /* After advancing vp->sp, but before writing any stack slots, check
178 that it is actually in bounds. If it is not in bounds, currently we
179 signal an error. In the future we may expand the stack instead,
180 possibly by moving it elsewhere, therefore no pointer into the stack
181 besides FP is valid across a CHECK_OVERFLOW call. Be careful! */
182 #define CHECK_OVERFLOW() \
183 do { \
184 if (SCM_UNLIKELY (vp->sp >= vp->stack_limit)) \
185 { \
186 SYNC_IP (); \
187 vm_expand_stack (vp); \
188 CACHE_FP (); \
189 } \
190 } while (0)
191
192 /* Reserve stack space for a frame. Will check that there is sufficient
193 stack space for N locals, including the procedure. Invoke after
194 preparing the new frame and setting the fp and ip. */
195 #define ALLOC_FRAME(n) \
196 do { \
197 vp->sp = LOCAL_ADDRESS (n - 1); \
198 CHECK_OVERFLOW (); \
199 } while (0)
200
201 /* Reset the current frame to hold N locals. Used when we know that no
202 stack expansion is needed. */
203 #define RESET_FRAME(n) \
204 do { \
205 vp->sp = LOCAL_ADDRESS (n - 1); \
206 } while (0)
207
208 /* Compute the number of locals in the frame. At a call, this is equal
209 to the number of actual arguments when a function is first called,
210 plus one for the function. */
211 #define FRAME_LOCALS_COUNT_FROM(slot) \
212 (vp->sp + 1 - LOCAL_ADDRESS (slot))
213 #define FRAME_LOCALS_COUNT() \
214 FRAME_LOCALS_COUNT_FROM (0)
215
216 /* Restore registers after returning from a frame. */
217 #define RESTORE_FRAME() \
218 do { \
219 } while (0)
220
221
222 #ifdef HAVE_LABELS_AS_VALUES
223 # define BEGIN_DISPATCH_SWITCH /* */
224 # define END_DISPATCH_SWITCH /* */
225 # define NEXT(n) \
226 do \
227 { \
228 ip += n; \
229 NEXT_HOOK (); \
230 op = *ip; \
231 goto *jump_table[op & 0xff]; \
232 } \
233 while (0)
234 # define VM_DEFINE_OP(opcode, tag, name, meta) \
235 op_##tag:
236 #else
237 # define BEGIN_DISPATCH_SWITCH \
238 vm_start: \
239 NEXT_HOOK (); \
240 op = *ip; \
241 switch (op & 0xff) \
242 {
243 # define END_DISPATCH_SWITCH \
244 }
245 # define NEXT(n) \
246 do \
247 { \
248 ip += n; \
249 goto vm_start; \
250 } \
251 while (0)
252 # define VM_DEFINE_OP(opcode, tag, name, meta) \
253 op_##tag: \
254 case opcode:
255 #endif
256
257 #define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
258 #define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
259 #define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
260
261 #define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
262 #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
263 #define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
264
265 #define RETURN_ONE_VALUE(ret) \
266 do { \
267 SCM val = ret; \
268 SCM *old_fp; \
269 VM_HANDLE_INTERRUPTS; \
270 old_fp = fp; \
271 ip = SCM_FRAME_RETURN_ADDRESS (fp); \
272 fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
273 /* Clear frame. */ \
274 old_fp[-1] = SCM_BOOL_F; \
275 old_fp[-2] = SCM_BOOL_F; \
276 /* Leave proc. */ \
277 SCM_FRAME_LOCAL (old_fp, 1) = val; \
278 vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
279 POP_CONTINUATION_HOOK (old_fp); \
280 NEXT (0); \
281 } while (0)
282
283 /* While we could generate the list-unrolling code here, it's fine for
284 now to just tail-call (apply values vals). */
285 #define RETURN_VALUE_LIST(vals_) \
286 do { \
287 SCM vals = vals_; \
288 VM_HANDLE_INTERRUPTS; \
289 fp[0] = vm_builtin_apply; \
290 fp[1] = vm_builtin_values; \
291 fp[2] = vals; \
292 RESET_FRAME (3); \
293 ip = (scm_t_uint32 *) vm_builtin_apply_code; \
294 goto op_tail_apply; \
295 } while (0)
296
297 #define BR_NARGS(rel) \
298 scm_t_uint32 expected; \
299 UNPACK_24 (op, expected); \
300 if (FRAME_LOCALS_COUNT() rel expected) \
301 { \
302 scm_t_int32 offset = ip[1]; \
303 offset >>= 8; /* Sign-extending shift. */ \
304 NEXT (offset); \
305 } \
306 NEXT (2)
307
308 #define BR_UNARY(x, exp) \
309 scm_t_uint32 test; \
310 SCM x; \
311 UNPACK_24 (op, test); \
312 x = LOCAL_REF (test); \
313 if ((ip[1] & 0x1) ? !(exp) : (exp)) \
314 { \
315 scm_t_int32 offset = ip[1]; \
316 offset >>= 8; /* Sign-extending shift. */ \
317 if (offset < 0) \
318 VM_HANDLE_INTERRUPTS; \
319 NEXT (offset); \
320 } \
321 NEXT (2)
322
323 #define BR_BINARY(x, y, exp) \
324 scm_t_uint16 a, b; \
325 SCM x, y; \
326 UNPACK_12_12 (op, a, b); \
327 x = LOCAL_REF (a); \
328 y = LOCAL_REF (b); \
329 if ((ip[1] & 0x1) ? !(exp) : (exp)) \
330 { \
331 scm_t_int32 offset = ip[1]; \
332 offset >>= 8; /* Sign-extending shift. */ \
333 if (offset < 0) \
334 VM_HANDLE_INTERRUPTS; \
335 NEXT (offset); \
336 } \
337 NEXT (2)
338
339 #define BR_ARITHMETIC(crel,srel) \
340 { \
341 scm_t_uint16 a, b; \
342 SCM x, y; \
343 UNPACK_12_12 (op, a, b); \
344 x = LOCAL_REF (a); \
345 y = LOCAL_REF (b); \
346 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
347 { \
348 scm_t_signed_bits x_bits = SCM_UNPACK (x); \
349 scm_t_signed_bits y_bits = SCM_UNPACK (y); \
350 if ((ip[1] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \
351 { \
352 scm_t_int32 offset = ip[1]; \
353 offset >>= 8; /* Sign-extending shift. */ \
354 if (offset < 0) \
355 VM_HANDLE_INTERRUPTS; \
356 NEXT (offset); \
357 } \
358 NEXT (2); \
359 } \
360 else \
361 { \
362 SCM res; \
363 SYNC_IP (); \
364 res = srel (x, y); \
365 CACHE_FP (); \
366 if ((ip[1] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \
367 { \
368 scm_t_int32 offset = ip[1]; \
369 offset >>= 8; /* Sign-extending shift. */ \
370 if (offset < 0) \
371 VM_HANDLE_INTERRUPTS; \
372 NEXT (offset); \
373 } \
374 NEXT (2); \
375 } \
376 }
377
378 #define ARGS1(a1) \
379 scm_t_uint16 dst, src; \
380 SCM a1; \
381 UNPACK_12_12 (op, dst, src); \
382 a1 = LOCAL_REF (src)
383 #define ARGS2(a1, a2) \
384 scm_t_uint8 dst, src1, src2; \
385 SCM a1, a2; \
386 UNPACK_8_8_8 (op, dst, src1, src2); \
387 a1 = LOCAL_REF (src1); \
388 a2 = LOCAL_REF (src2)
389 #define RETURN(x) \
390 do { LOCAL_SET (dst, x); NEXT (1); } while (0)
391 #define RETURN_EXP(exp) \
392 do { SCM __x; SYNC_IP (); __x = exp; CACHE_FP (); RETURN (__x); } while (0)
393
394 /* The maximum/minimum tagged integers. */
395 #define INUM_MAX \
396 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
397 #define INUM_MIN \
398 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
399 #define INUM_STEP \
400 ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
401 - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
402
403 #define BINARY_INTEGER_OP(CFUNC,SFUNC) \
404 { \
405 ARGS2 (x, y); \
406 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
407 { \
408 scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \
409 if (SCM_FIXABLE (n)) \
410 RETURN (SCM_I_MAKINUM (n)); \
411 } \
412 RETURN_EXP (SFUNC (x, y)); \
413 }
414
415 #define VM_VALIDATE_PAIR(x, proc) \
416 VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x))
417
418 #define VM_VALIDATE_STRUCT(obj, proc) \
419 VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
420
421 #define VM_VALIDATE_BYTEVECTOR(x, proc) \
422 VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x))
423
424 /* Return true (non-zero) if PTR has suitable alignment for TYPE. */
425 #define ALIGNED_P(ptr, type) \
426 ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
427
428 static SCM
429 VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
430 scm_i_jmp_buf *registers, int resume)
431 {
432 /* Instruction pointer: A pointer to the opcode that is currently
433 running. */
434 register scm_t_uint32 *ip IP_REG;
435
436 /* Frame pointer: A pointer into the stack, off of which we index
437 arguments and local variables. Pushed at function calls, popped on
438 returns. */
439 register SCM *fp FP_REG;
440
441 /* Current opcode: A cache of *ip. */
442 register scm_t_uint32 op;
443
444 #ifdef HAVE_LABELS_AS_VALUES
445 static const void *jump_table_[256] = {
446 #define LABEL_ADDR(opcode, tag, name, meta) &&op_##tag,
447 FOR_EACH_VM_OPERATION(LABEL_ADDR)
448 #undef LABEL_ADDR
449 };
450 register const void **jump_table JT_REG;
451 /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
452 load instruction at each instruction dispatch. */
453 jump_table = jump_table_;
454 #endif
455
456 /* Load VM registers. */
457 CACHE_REGISTER ();
458
459 VM_HANDLE_INTERRUPTS;
460
461 /* Usually a call to the VM happens on application, with the boot
462 continuation on the next frame. Sometimes it happens after a
463 non-local exit however; in that case the VM state is all set up,
464 and we have but to jump to the next opcode. */
465 if (SCM_UNLIKELY (resume))
466 NEXT (0);
467
468 apply:
469 while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
470 {
471 SCM proc = SCM_FRAME_PROGRAM (fp);
472
473 if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
474 {
475 LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc));
476 continue;
477 }
478 if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
479 {
480 scm_t_uint32 n = FRAME_LOCALS_COUNT();
481
482 /* Shuffle args up. */
483 RESET_FRAME (n + 1);
484 while (n--)
485 LOCAL_SET (n + 1, LOCAL_REF (n));
486
487 LOCAL_SET (0, SCM_SMOB_DESCRIPTOR (proc).apply_trampoline);
488 continue;
489 }
490
491 SYNC_IP();
492 vm_error_wrong_type_apply (proc);
493 }
494
495 /* Let's go! */
496 ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
497 NEXT (0);
498
499 BEGIN_DISPATCH_SWITCH;
500
501
502 \f
503
504 /*
505 * Call and return
506 */
507
508 /* halt _:24
509 *
510 * Bring the VM to a halt, returning all the values from the stack.
511 */
512 VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
513 {
514 /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
515
516 scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
517 SCM ret;
518
519 if (nvals == 1)
520 ret = LOCAL_REF (4);
521 else
522 {
523 scm_t_uint32 n;
524 ret = SCM_EOL;
525 for (n = nvals; n > 0; n--)
526 ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
527 ret = scm_values (ret);
528 }
529
530 vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
531 vp->sp = SCM_FRAME_PREVIOUS_SP (fp);
532 vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
533
534 return ret;
535 }
536
537 /* call proc:24 _:8 nlocals:24
538 *
539 * Call a procedure. PROC is the local corresponding to a procedure.
540 * The two values below PROC will be overwritten by the saved call
541 * frame data. The new frame will have space for NLOCALS locals: one
542 * for the procedure, and the rest for the arguments which should
543 * already have been pushed on.
544 *
545 * When the call returns, execution proceeds with the next
546 * instruction. There may be any number of values on the return
547 * stack; the precise number can be had by subtracting the address of
548 * PROC from the post-call SP.
549 */
550 VM_DEFINE_OP (1, call, "call", OP2 (U8_U24, X8_U24))
551 {
552 scm_t_uint32 proc, nlocals;
553 SCM *old_fp;
554
555 UNPACK_24 (op, proc);
556 UNPACK_24 (ip[1], nlocals);
557
558 VM_HANDLE_INTERRUPTS;
559
560 old_fp = fp;
561 fp = vp->fp = old_fp + proc;
562 SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
563 SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
564
565 RESET_FRAME (nlocals);
566
567 PUSH_CONTINUATION_HOOK ();
568 APPLY_HOOK ();
569
570 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
571 goto apply;
572
573 ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
574 NEXT (0);
575 }
576
577 /* tail-call nlocals:24
578 *
579 * Tail-call a procedure. Requires that the procedure and all of the
580 * arguments have already been shuffled into position. Will reset the
581 * frame to NLOCALS.
582 */
583 VM_DEFINE_OP (2, tail_call, "tail-call", OP1 (U8_U24))
584 {
585 scm_t_uint32 nlocals;
586
587 UNPACK_24 (op, nlocals);
588
589 VM_HANDLE_INTERRUPTS;
590
591 RESET_FRAME (nlocals);
592
593 APPLY_HOOK ();
594
595 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
596 goto apply;
597
598 ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
599 NEXT (0);
600 }
601
602 /* tail-call/shuffle from:24
603 *
604 * Tail-call a procedure. The procedure should already be set to slot
605 * 0. The rest of the args are taken from the frame, starting at
606 * FROM, shuffled down to start at slot 0. This is part of the
607 * implementation of the call-with-values builtin.
608 */
609 VM_DEFINE_OP (3, tail_call_shuffle, "tail-call/shuffle", OP1 (U8_U24))
610 {
611 scm_t_uint32 n, from, nlocals;
612
613 UNPACK_24 (op, from);
614
615 VM_HANDLE_INTERRUPTS;
616
617 VM_ASSERT (from > 0, abort ());
618 nlocals = FRAME_LOCALS_COUNT ();
619
620 for (n = 0; from + n < nlocals; n++)
621 LOCAL_SET (n + 1, LOCAL_REF (from + n));
622
623 RESET_FRAME (n + 1);
624
625 APPLY_HOOK ();
626
627 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
628 goto apply;
629
630 ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
631 NEXT (0);
632 }
633
634 /* receive dst:12 proc:12 _:8 nlocals:24
635 *
636 * Receive a single return value from a call whose procedure was in
637 * PROC, asserting that the call actually returned at least one
638 * value. Afterwards, resets the frame to NLOCALS locals.
639 */
640 VM_DEFINE_OP (4, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
641 {
642 scm_t_uint16 dst, proc;
643 scm_t_uint32 nlocals;
644 UNPACK_12_12 (op, dst, proc);
645 UNPACK_24 (ip[1], nlocals);
646 VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ());
647 LOCAL_SET (dst, LOCAL_REF (proc + 1));
648 RESET_FRAME (nlocals);
649 NEXT (2);
650 }
651
652 /* receive-values proc:24 allow-extra?:1 _:7 nvalues:24
653 *
654 * Receive a return of multiple values from a call whose procedure was
655 * in PROC. If fewer than NVALUES values were returned, signal an
656 * error. Unless ALLOW-EXTRA? is true, require that the number of
657 * return values equals NVALUES exactly. After receive-values has
658 * run, the values can be copied down via `mov'.
659 */
660 VM_DEFINE_OP (5, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
661 {
662 scm_t_uint32 proc, nvalues;
663 UNPACK_24 (op, proc);
664 UNPACK_24 (ip[1], nvalues);
665 if (ip[1] & 0x1)
666 VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues,
667 vm_error_not_enough_values ());
668 else
669 VM_ASSERT (FRAME_LOCALS_COUNT () == proc + 1 + nvalues,
670 vm_error_wrong_number_of_values (nvalues));
671 NEXT (2);
672 }
673
674 /* return src:24
675 *
676 * Return a value.
677 */
678 VM_DEFINE_OP (6, return, "return", OP1 (U8_U24))
679 {
680 scm_t_uint32 src;
681 UNPACK_24 (op, src);
682 RETURN_ONE_VALUE (LOCAL_REF (src));
683 }
684
685 /* return-values _:24
686 *
687 * Return a number of values from a call frame. This opcode
688 * corresponds to an application of `values' in tail position. As
689 * with tail calls, we expect that the values have already been
690 * shuffled down to a contiguous array starting at slot 1.
691 * We also expect the frame has already been reset.
692 */
693 VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
694 {
695 SCM *old_fp;
696
697 VM_HANDLE_INTERRUPTS;
698
699 old_fp = fp;
700 ip = SCM_FRAME_RETURN_ADDRESS (fp);
701 fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
702
703 /* Clear stack frame. */
704 old_fp[-1] = SCM_BOOL_F;
705 old_fp[-2] = SCM_BOOL_F;
706
707 POP_CONTINUATION_HOOK (old_fp);
708
709 NEXT (0);
710 }
711
712
713 \f
714
715 /*
716 * Specialized call stubs
717 */
718
719 /* subr-call ptr-idx:24
720 *
721 * Call a subr, passing all locals in this frame as arguments. Fetch
722 * the foreign pointer from PTR-IDX, a free variable. Return from the
723 * calling frame. This instruction is part of the trampolines
724 * created in gsubr.c, and is not generated by the compiler.
725 */
726 VM_DEFINE_OP (8, subr_call, "subr-call", OP1 (U8_U24))
727 {
728 scm_t_uint32 ptr_idx;
729 SCM pointer, ret;
730 SCM (*subr)();
731
732 UNPACK_24 (op, ptr_idx);
733
734 pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
735 subr = SCM_POINTER_VALUE (pointer);
736
737 SYNC_IP ();
738
739 switch (FRAME_LOCALS_COUNT_FROM (1))
740 {
741 case 0:
742 ret = subr ();
743 break;
744 case 1:
745 ret = subr (fp[1]);
746 break;
747 case 2:
748 ret = subr (fp[1], fp[2]);
749 break;
750 case 3:
751 ret = subr (fp[1], fp[2], fp[3]);
752 break;
753 case 4:
754 ret = subr (fp[1], fp[2], fp[3], fp[4]);
755 break;
756 case 5:
757 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
758 break;
759 case 6:
760 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
761 break;
762 case 7:
763 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
764 break;
765 case 8:
766 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
767 break;
768 case 9:
769 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]);
770 break;
771 case 10:
772 ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9], fp[10]);
773 break;
774 default:
775 abort ();
776 }
777
778 CACHE_FP ();
779
780 if (SCM_UNLIKELY (SCM_VALUESP (ret)))
781 /* multiple values returned to continuation */
782 RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
783 else
784 RETURN_ONE_VALUE (ret);
785 }
786
787 /* foreign-call cif-idx:12 ptr-idx:12
788 *
789 * Call a foreign function. Fetch the CIF and foreign pointer from
790 * CIF-IDX and PTR-IDX, both free variables. Return from the calling
791 * frame. Arguments are taken from the stack. This instruction is
792 * part of the trampolines created by the FFI, and is not generated by
793 * the compiler.
794 */
795 VM_DEFINE_OP (9, foreign_call, "foreign-call", OP1 (U8_U12_U12))
796 {
797 scm_t_uint16 cif_idx, ptr_idx;
798 SCM closure, cif, pointer, ret;
799
800 UNPACK_12_12 (op, cif_idx, ptr_idx);
801
802 closure = LOCAL_REF (0);
803 cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
804 pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
805
806 SYNC_IP ();
807
808 // FIXME: separate args
809 ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
810
811 CACHE_FP ();
812
813 if (SCM_UNLIKELY (SCM_VALUESP (ret)))
814 /* multiple values returned to continuation */
815 RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
816 else
817 RETURN_ONE_VALUE (ret);
818 }
819
820 /* continuation-call contregs:24
821 *
822 * Return to a continuation, nonlocally. The arguments to the
823 * continuation are taken from the stack. CONTREGS is a free variable
824 * containing the reified continuation. This instruction is part of
825 * the implementation of undelimited continuations, and is not
826 * generated by the compiler.
827 */
828 VM_DEFINE_OP (10, continuation_call, "continuation-call", OP1 (U8_U24))
829 {
830 SCM contregs;
831 scm_t_uint32 contregs_idx;
832
833 UNPACK_24 (op, contregs_idx);
834
835 contregs =
836 SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
837
838 SYNC_IP ();
839 scm_i_check_continuation (contregs);
840 vm_return_to_continuation (scm_i_contregs_vp (contregs),
841 scm_i_contregs_vm_cont (contregs),
842 FRAME_LOCALS_COUNT_FROM (1),
843 LOCAL_ADDRESS (1));
844 scm_i_reinstate_continuation (contregs);
845
846 /* no NEXT */
847 abort ();
848 }
849
850 /* compose-continuation cont:24
851 *
852 * Compose a partial continution with the current continuation. The
853 * arguments to the continuation are taken from the stack. CONT is a
854 * free variable containing the reified continuation. This
855 * instruction is part of the implementation of partial continuations,
856 * and is not generated by the compiler.
857 */
858 VM_DEFINE_OP (11, compose_continuation, "compose-continuation", OP1 (U8_U24))
859 {
860 SCM vmcont;
861 scm_t_uint32 cont_idx;
862
863 UNPACK_24 (op, cont_idx);
864 vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
865
866 SYNC_IP ();
867 VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
868 vm_error_continuation_not_rewindable (vmcont));
869 vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1),
870 LOCAL_ADDRESS (1),
871 &current_thread->dynstack,
872 registers);
873 CACHE_REGISTER ();
874 NEXT (0);
875 }
876
877 /* tail-apply _:24
878 *
879 * Tail-apply the procedure in local slot 0 to the rest of the
880 * arguments. This instruction is part of the implementation of
881 * `apply', and is not generated by the compiler.
882 */
883 VM_DEFINE_OP (12, tail_apply, "tail-apply", OP1 (U8_X24))
884 {
885 int i, list_idx, list_len, nlocals;
886 SCM list;
887
888 VM_HANDLE_INTERRUPTS;
889
890 nlocals = FRAME_LOCALS_COUNT ();
891 // At a minimum, there should be apply, f, and the list.
892 VM_ASSERT (nlocals >= 3, abort ());
893 list_idx = nlocals - 1;
894 list = LOCAL_REF (list_idx);
895 list_len = scm_ilength (list);
896
897 VM_ASSERT (list_len >= 0, vm_error_apply_to_non_list (list));
898
899 nlocals = nlocals - 2 + list_len;
900 ALLOC_FRAME (nlocals);
901
902 for (i = 1; i < list_idx; i++)
903 LOCAL_SET (i - 1, LOCAL_REF (i));
904
905 /* Null out these slots, just in case there are less than 2 elements
906 in the list. */
907 LOCAL_SET (list_idx - 1, SCM_UNDEFINED);
908 LOCAL_SET (list_idx, SCM_UNDEFINED);
909
910 for (i = 0; i < list_len; i++, list = SCM_CDR (list))
911 LOCAL_SET (list_idx - 1 + i, SCM_CAR (list));
912
913 APPLY_HOOK ();
914
915 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
916 goto apply;
917
918 ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
919 NEXT (0);
920 }
921
922 /* call/cc _:24
923 *
924 * Capture the current continuation, and tail-apply the procedure in
925 * local slot 1 to it. This instruction is part of the implementation
926 * of `call/cc', and is not generated by the compiler.
927 */
928 VM_DEFINE_OP (13, call_cc, "call/cc", OP1 (U8_X24))
929 {
930 SCM vm_cont, cont;
931 scm_t_dynstack *dynstack;
932 int first;
933
934 VM_HANDLE_INTERRUPTS;
935
936 SYNC_IP ();
937 dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
938 vm_cont = scm_i_vm_capture_stack (vp->stack_base,
939 SCM_FRAME_DYNAMIC_LINK (fp),
940 SCM_FRAME_PREVIOUS_SP (fp),
941 SCM_FRAME_RETURN_ADDRESS (fp),
942 dynstack,
943 0);
944 /* FIXME: Seems silly to capture the registers here, when they are
945 already captured in the registers local, which here we are
946 copying out to the heap; and likewise, the setjmp(&registers)
947 code already has the non-local return handler. But oh
948 well! */
949 cont = scm_i_make_continuation (&first, vp, vm_cont);
950
951 if (first)
952 {
953 LOCAL_SET (0, LOCAL_REF (1));
954 LOCAL_SET (1, cont);
955 RESET_FRAME (2);
956
957 APPLY_HOOK ();
958
959 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
960 goto apply;
961
962 ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
963 NEXT (0);
964 }
965 else
966 {
967 CACHE_REGISTER ();
968 ABORT_CONTINUATION_HOOK ();
969 NEXT (0);
970 }
971 }
972
973 /* abort _:24
974 *
975 * Abort to a prompt handler. The tag is expected in r1, and the rest
976 * of the values in the frame are returned to the prompt handler.
977 * This corresponds to a tail application of abort-to-prompt.
978 */
979 VM_DEFINE_OP (14, abort, "abort", OP1 (U8_X24))
980 {
981 scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
982
983 ASSERT (nlocals >= 2);
984 /* FIXME: Really we should capture the caller's registers. Until
985 then, manually advance the IP so that when the prompt resumes,
986 it continues with the next instruction. */
987 ip++;
988 SYNC_IP ();
989 vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
990 SCM_EOL, LOCAL_ADDRESS (0), registers);
991
992 /* vm_abort should not return */
993 abort ();
994 }
995
996 /* builtin-ref dst:12 idx:12
997 *
998 * Load a builtin stub by index into DST.
999 */
1000 VM_DEFINE_OP (15, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST)
1001 {
1002 scm_t_uint16 dst, idx;
1003
1004 UNPACK_12_12 (op, dst, idx);
1005 LOCAL_SET (dst, scm_vm_builtin_ref (idx));
1006
1007 NEXT (1);
1008 }
1009
1010
1011 \f
1012
1013 /*
1014 * Function prologues
1015 */
1016
1017 /* br-if-nargs-ne expected:24 _:8 offset:24
1018 * br-if-nargs-lt expected:24 _:8 offset:24
1019 * br-if-nargs-gt expected:24 _:8 offset:24
1020 *
1021 * If the number of actual arguments is not equal, less than, or greater
1022 * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
1023 * the current instruction pointer.
1024 */
1025 VM_DEFINE_OP (16, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
1026 {
1027 BR_NARGS (!=);
1028 }
1029 VM_DEFINE_OP (17, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
1030 {
1031 BR_NARGS (<);
1032 }
1033 VM_DEFINE_OP (18, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
1034 {
1035 BR_NARGS (>);
1036 }
1037
1038 /* assert-nargs-ee expected:24
1039 * assert-nargs-ge expected:24
1040 * assert-nargs-le expected:24
1041 *
1042 * If the number of actual arguments is not ==, >=, or <= EXPECTED,
1043 * respectively, signal an error.
1044 */
1045 VM_DEFINE_OP (19, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
1046 {
1047 scm_t_uint32 expected;
1048 UNPACK_24 (op, expected);
1049 VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
1050 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
1051 NEXT (1);
1052 }
1053 VM_DEFINE_OP (20, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
1054 {
1055 scm_t_uint32 expected;
1056 UNPACK_24 (op, expected);
1057 VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
1058 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
1059 NEXT (1);
1060 }
1061 VM_DEFINE_OP (21, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
1062 {
1063 scm_t_uint32 expected;
1064 UNPACK_24 (op, expected);
1065 VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
1066 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
1067 NEXT (1);
1068 }
1069
1070 /* alloc-frame nlocals:24
1071 *
1072 * Ensure that there is space on the stack for NLOCALS local variables,
1073 * setting them all to SCM_UNDEFINED, except those nargs values that
1074 * were passed as arguments and procedure.
1075 */
1076 VM_DEFINE_OP (22, alloc_frame, "alloc-frame", OP1 (U8_U24))
1077 {
1078 scm_t_uint32 nlocals, nargs;
1079 UNPACK_24 (op, nlocals);
1080
1081 nargs = FRAME_LOCALS_COUNT ();
1082 ALLOC_FRAME (nlocals);
1083 while (nlocals-- > nargs)
1084 LOCAL_SET (nlocals, SCM_UNDEFINED);
1085
1086 NEXT (1);
1087 }
1088
1089 /* reset-frame nlocals:24
1090 *
1091 * Like alloc-frame, but doesn't check that the stack is big enough.
1092 * Used to reset the frame size to something less than the size that
1093 * was previously set via alloc-frame.
1094 */
1095 VM_DEFINE_OP (23, reset_frame, "reset-frame", OP1 (U8_U24))
1096 {
1097 scm_t_uint32 nlocals;
1098 UNPACK_24 (op, nlocals);
1099 RESET_FRAME (nlocals);
1100 NEXT (1);
1101 }
1102
1103 /* assert-nargs-ee/locals expected:12 nlocals:12
1104 *
1105 * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
1106 * number of locals reserved is EXPECTED + NLOCALS.
1107 */
1108 VM_DEFINE_OP (24, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
1109 {
1110 scm_t_uint16 expected, nlocals;
1111 UNPACK_12_12 (op, expected, nlocals);
1112 VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
1113 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
1114 ALLOC_FRAME (expected + nlocals);
1115 while (nlocals--)
1116 LOCAL_SET (expected + nlocals, SCM_UNDEFINED);
1117
1118 NEXT (1);
1119 }
1120
1121 /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
1122 *
1123 * Find the first positional argument after NREQ. If it is greater
1124 * than NPOS, jump to OFFSET.
1125 *
1126 * This instruction is only emitted for functions with multiple
1127 * clauses, and an earlier clause has keywords and no rest arguments.
1128 * See "Case-lambda" in the manual, for more on how case-lambda
1129 * chooses the clause to apply.
1130 */
1131 VM_DEFINE_OP (25, br_if_npos_gt, "br-if-npos-gt", OP3 (U8_U24, X8_U24, X8_L24))
1132 {
1133 scm_t_uint32 nreq, npos;
1134
1135 UNPACK_24 (op, nreq);
1136 UNPACK_24 (ip[1], npos);
1137
1138 /* We can only have too many positionals if there are more
1139 arguments than NPOS. */
1140 if (FRAME_LOCALS_COUNT() > npos)
1141 {
1142 scm_t_uint32 n;
1143 for (n = nreq; n < npos; n++)
1144 if (scm_is_keyword (LOCAL_REF (n)))
1145 break;
1146 if (n == npos && !scm_is_keyword (LOCAL_REF (n)))
1147 {
1148 scm_t_int32 offset = ip[2];
1149 offset >>= 8; /* Sign-extending shift. */
1150 NEXT (offset);
1151 }
1152 }
1153 NEXT (3);
1154 }
1155
1156 /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
1157 *
1158 * flags := allow-other-keys:1 has-rest:1 _:6
1159 *
1160 * Find the last positional argument, and shuffle all the rest above
1161 * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then
1162 * load the constant at KW-OFFSET words from the current IP, and use it
1163 * to bind keyword arguments. If HAS-REST, collect all shuffled
1164 * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear
1165 * the arguments that we shuffled up.
1166 *
1167 * A macro-mega-instruction.
1168 */
1169 VM_DEFINE_OP (26, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32))
1170 {
1171 scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs;
1172 scm_t_int32 kw_offset;
1173 scm_t_bits kw_bits;
1174 SCM kw;
1175 char allow_other_keys, has_rest;
1176
1177 UNPACK_24 (op, nreq);
1178 allow_other_keys = ip[1] & 0x1;
1179 has_rest = ip[1] & 0x2;
1180 UNPACK_24 (ip[1], nreq_and_opt);
1181 UNPACK_24 (ip[2], ntotal);
1182 kw_offset = ip[3];
1183 kw_bits = (scm_t_bits) (ip + kw_offset);
1184 VM_ASSERT (!(kw_bits & 0x7), abort());
1185 kw = SCM_PACK (kw_bits);
1186
1187 nargs = FRAME_LOCALS_COUNT ();
1188
1189 /* look in optionals for first keyword or last positional */
1190 /* starting after the last required positional arg */
1191 npositional = nreq;
1192 while (/* while we have args */
1193 npositional < nargs
1194 /* and we still have positionals to fill */
1195 && npositional < nreq_and_opt
1196 /* and we haven't reached a keyword yet */
1197 && !scm_is_keyword (LOCAL_REF (npositional)))
1198 /* bind this optional arg (by leaving it in place) */
1199 npositional++;
1200 nkw = nargs - npositional;
1201 /* shuffle non-positional arguments above ntotal */
1202 ALLOC_FRAME (ntotal + nkw);
1203 n = nkw;
1204 while (n--)
1205 LOCAL_SET (ntotal + n, LOCAL_REF (npositional + n));
1206 /* and fill optionals & keyword args with SCM_UNDEFINED */
1207 n = npositional;
1208 while (n < ntotal)
1209 LOCAL_SET (n++, SCM_UNDEFINED);
1210
1211 VM_ASSERT (has_rest || (nkw % 2) == 0,
1212 vm_error_kwargs_length_not_even (SCM_FRAME_PROGRAM (fp)));
1213
1214 /* Now bind keywords, in the order given. */
1215 for (n = 0; n < nkw; n++)
1216 if (scm_is_keyword (LOCAL_REF (ntotal + n)))
1217 {
1218 SCM walk;
1219 for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk))
1220 if (scm_is_eq (SCM_CAAR (walk), LOCAL_REF (ntotal + n)))
1221 {
1222 SCM si = SCM_CDAR (walk);
1223 LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32 (si),
1224 LOCAL_REF (ntotal + n + 1));
1225 break;
1226 }
1227 VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
1228 vm_error_kwargs_unrecognized_keyword (SCM_FRAME_PROGRAM (fp),
1229 LOCAL_REF (ntotal + n)));
1230 n++;
1231 }
1232 else
1233 VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (SCM_FRAME_PROGRAM (fp),
1234 LOCAL_REF (ntotal + n)));
1235
1236 if (has_rest)
1237 {
1238 SCM rest = SCM_EOL;
1239 n = nkw;
1240 while (n--)
1241 rest = scm_cons (LOCAL_REF (ntotal + n), rest);
1242 LOCAL_SET (nreq_and_opt, rest);
1243 }
1244
1245 RESET_FRAME (ntotal);
1246
1247 NEXT (4);
1248 }
1249
1250 /* bind-rest dst:24
1251 *
1252 * Collect any arguments at or above DST into a list, and store that
1253 * list at DST.
1254 */
1255 VM_DEFINE_OP (27, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
1256 {
1257 scm_t_uint32 dst, nargs;
1258 SCM rest = SCM_EOL;
1259
1260 UNPACK_24 (op, dst);
1261 nargs = FRAME_LOCALS_COUNT ();
1262
1263 if (nargs <= dst)
1264 {
1265 ALLOC_FRAME (dst + 1);
1266 while (nargs < dst)
1267 LOCAL_SET (nargs++, SCM_UNDEFINED);
1268 }
1269 else
1270 {
1271 while (nargs-- > dst)
1272 {
1273 rest = scm_cons (LOCAL_REF (nargs), rest);
1274 LOCAL_SET (nargs, SCM_UNDEFINED);
1275 }
1276
1277 RESET_FRAME (dst + 1);
1278 }
1279
1280 LOCAL_SET (dst, rest);
1281
1282 NEXT (1);
1283 }
1284
1285
1286 \f
1287
1288 /*
1289 * Branching instructions
1290 */
1291
1292 /* br offset:24
1293 *
1294 * Add OFFSET, a signed 24-bit number, to the current instruction
1295 * pointer.
1296 */
1297 VM_DEFINE_OP (28, br, "br", OP1 (U8_L24))
1298 {
1299 scm_t_int32 offset = op;
1300 offset >>= 8; /* Sign-extending shift. */
1301 NEXT (offset);
1302 }
1303
1304 /* br-if-true test:24 invert:1 _:7 offset:24
1305 *
1306 * If the value in TEST is true for the purposes of Scheme, add
1307 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1308 */
1309 VM_DEFINE_OP (29, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
1310 {
1311 BR_UNARY (x, scm_is_true (x));
1312 }
1313
1314 /* br-if-null test:24 invert:1 _:7 offset:24
1315 *
1316 * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
1317 * signed 24-bit number, to the current instruction pointer.
1318 */
1319 VM_DEFINE_OP (30, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
1320 {
1321 BR_UNARY (x, scm_is_null (x));
1322 }
1323
1324 /* br-if-nil test:24 invert:1 _:7 offset:24
1325 *
1326 * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
1327 * number, to the current instruction pointer.
1328 */
1329 VM_DEFINE_OP (31, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
1330 {
1331 BR_UNARY (x, scm_is_lisp_false (x));
1332 }
1333
1334 /* br-if-pair test:24 invert:1 _:7 offset:24
1335 *
1336 * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
1337 * to the current instruction pointer.
1338 */
1339 VM_DEFINE_OP (32, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
1340 {
1341 BR_UNARY (x, scm_is_pair (x));
1342 }
1343
1344 /* br-if-struct test:24 invert:1 _:7 offset:24
1345 *
1346 * If the value in TEST is a struct, add OFFSET, a signed 24-bit
1347 * number, to the current instruction pointer.
1348 */
1349 VM_DEFINE_OP (33, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
1350 {
1351 BR_UNARY (x, SCM_STRUCTP (x));
1352 }
1353
1354 /* br-if-char test:24 invert:1 _:7 offset:24
1355 *
1356 * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
1357 * to the current instruction pointer.
1358 */
1359 VM_DEFINE_OP (34, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
1360 {
1361 BR_UNARY (x, SCM_CHARP (x));
1362 }
1363
1364 /* br-if-tc7 test:24 invert:1 tc7:7 offset:24
1365 *
1366 * If the value in TEST has the TC7 given in the second word, add
1367 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1368 */
1369 VM_DEFINE_OP (35, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
1370 {
1371 BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
1372 }
1373
1374 /* br-if-eq a:12 b:12 invert:1 _:7 offset:24
1375 *
1376 * If the value in A is eq? to the value in B, add OFFSET, a signed
1377 * 24-bit number, to the current instruction pointer.
1378 */
1379 VM_DEFINE_OP (36, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
1380 {
1381 BR_BINARY (x, y, scm_is_eq (x, y));
1382 }
1383
1384 /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24
1385 *
1386 * If the value in A is eqv? to the value in B, add OFFSET, a signed
1387 * 24-bit number, to the current instruction pointer.
1388 */
1389 VM_DEFINE_OP (37, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
1390 {
1391 BR_BINARY (x, y,
1392 scm_is_eq (x, y)
1393 || (SCM_NIMP (x) && SCM_NIMP (y)
1394 && scm_is_true (scm_eqv_p (x, y))));
1395 }
1396
1397 // FIXME: remove, have compiler inline eqv test instead
1398 /* br-if-equal a:12 b:12 invert:1 _:7 offset:24
1399 *
1400 * If the value in A is equal? to the value in B, add OFFSET, a signed
1401 * 24-bit number, to the current instruction pointer.
1402 */
1403 // FIXME: Should sync_ip before calling out and cache_fp before coming
1404 // back! Another reason to remove this opcode!
1405 VM_DEFINE_OP (38, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
1406 {
1407 BR_BINARY (x, y,
1408 scm_is_eq (x, y)
1409 || (SCM_NIMP (x) && SCM_NIMP (y)
1410 && scm_is_true (scm_equal_p (x, y))));
1411 }
1412
1413 /* br-if-= a:12 b:12 invert:1 _:7 offset:24
1414 *
1415 * If the value in A is = to the value in B, add OFFSET, a signed
1416 * 24-bit number, to the current instruction pointer.
1417 */
1418 VM_DEFINE_OP (39, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
1419 {
1420 BR_ARITHMETIC (==, scm_num_eq_p);
1421 }
1422
1423 /* br-if-< a:12 b:12 invert:1 _:7 offset:24
1424 *
1425 * If the value in A is < to the value in B, add OFFSET, a signed
1426 * 24-bit number, to the current instruction pointer.
1427 */
1428 VM_DEFINE_OP (40, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
1429 {
1430 BR_ARITHMETIC (<, scm_less_p);
1431 }
1432
1433 /* br-if-<= a:12 b:12 invert:1 _:7 offset:24
1434 *
1435 * If the value in A is <= to the value in B, add OFFSET, a signed
1436 * 24-bit number, to the current instruction pointer.
1437 */
1438 VM_DEFINE_OP (41, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
1439 {
1440 BR_ARITHMETIC (<=, scm_leq_p);
1441 }
1442
1443
1444 \f
1445
1446 /*
1447 * Lexical binding instructions
1448 */
1449
1450 /* mov dst:12 src:12
1451 *
1452 * Copy a value from one local slot to another.
1453 */
1454 VM_DEFINE_OP (42, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
1455 {
1456 scm_t_uint16 dst;
1457 scm_t_uint16 src;
1458
1459 UNPACK_12_12 (op, dst, src);
1460 LOCAL_SET (dst, LOCAL_REF (src));
1461
1462 NEXT (1);
1463 }
1464
1465 /* long-mov dst:24 _:8 src:24
1466 *
1467 * Copy a value from one local slot to another.
1468 */
1469 VM_DEFINE_OP (43, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
1470 {
1471 scm_t_uint32 dst;
1472 scm_t_uint32 src;
1473
1474 UNPACK_24 (op, dst);
1475 UNPACK_24 (ip[1], src);
1476 LOCAL_SET (dst, LOCAL_REF (src));
1477
1478 NEXT (2);
1479 }
1480
1481 /* box dst:12 src:12
1482 *
1483 * Create a new variable holding SRC, and place it in DST.
1484 */
1485 VM_DEFINE_OP (44, box, "box", OP1 (U8_U12_U12) | OP_DST)
1486 {
1487 scm_t_uint16 dst, src;
1488 UNPACK_12_12 (op, dst, src);
1489 LOCAL_SET (dst, scm_cell (scm_tc7_variable, SCM_UNPACK (LOCAL_REF (src))));
1490 NEXT (1);
1491 }
1492
1493 /* box-ref dst:12 src:12
1494 *
1495 * Unpack the variable at SRC into DST, asserting that the variable is
1496 * actually bound.
1497 */
1498 VM_DEFINE_OP (45, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
1499 {
1500 scm_t_uint16 dst, src;
1501 SCM var;
1502 UNPACK_12_12 (op, dst, src);
1503 var = LOCAL_REF (src);
1504 VM_ASSERT (SCM_VARIABLEP (var),
1505 vm_error_not_a_variable ("variable-ref", var));
1506 VM_ASSERT (VARIABLE_BOUNDP (var),
1507 vm_error_unbound (SCM_FRAME_PROGRAM (fp), var));
1508 LOCAL_SET (dst, VARIABLE_REF (var));
1509 NEXT (1);
1510 }
1511
1512 /* box-set! dst:12 src:12
1513 *
1514 * Set the contents of the variable at DST to SET.
1515 */
1516 VM_DEFINE_OP (46, box_set, "box-set!", OP1 (U8_U12_U12))
1517 {
1518 scm_t_uint16 dst, src;
1519 SCM var;
1520 UNPACK_12_12 (op, dst, src);
1521 var = LOCAL_REF (dst);
1522 VM_ASSERT (SCM_VARIABLEP (var),
1523 vm_error_not_a_variable ("variable-set!", var));
1524 VARIABLE_SET (var, LOCAL_REF (src));
1525 NEXT (1);
1526 }
1527
1528 /* make-closure dst:24 offset:32 _:8 nfree:24
1529 *
1530 * Make a new closure, and write it to DST. The code for the closure
1531 * will be found at OFFSET words from the current IP. OFFSET is a
1532 * signed 32-bit integer. Space for NFREE free variables will be
1533 * allocated.
1534 */
1535 VM_DEFINE_OP (47, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
1536 {
1537 scm_t_uint32 dst, nfree, n;
1538 scm_t_int32 offset;
1539 SCM closure;
1540
1541 UNPACK_24 (op, dst);
1542 offset = ip[1];
1543 UNPACK_24 (ip[2], nfree);
1544
1545 // FIXME: Assert range of nfree?
1546 closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
1547 SCM_SET_CELL_WORD_1 (closure, ip + offset);
1548 // FIXME: Elide these initializations?
1549 for (n = 0; n < nfree; n++)
1550 SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
1551 LOCAL_SET (dst, closure);
1552 NEXT (3);
1553 }
1554
1555 /* free-ref dst:12 src:12 _:8 idx:24
1556 *
1557 * Load free variable IDX from the closure SRC into local slot DST.
1558 */
1559 VM_DEFINE_OP (48, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
1560 {
1561 scm_t_uint16 dst, src;
1562 scm_t_uint32 idx;
1563 UNPACK_12_12 (op, dst, src);
1564 UNPACK_24 (ip[1], idx);
1565 /* CHECK_FREE_VARIABLE (src); */
1566 LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
1567 NEXT (2);
1568 }
1569
1570 /* free-set! dst:12 src:12 _:8 idx:24
1571 *
1572 * Set free variable IDX from the closure DST to SRC.
1573 */
1574 VM_DEFINE_OP (49, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
1575 {
1576 scm_t_uint16 dst, src;
1577 scm_t_uint32 idx;
1578 UNPACK_12_12 (op, dst, src);
1579 UNPACK_24 (ip[1], idx);
1580 /* CHECK_FREE_VARIABLE (src); */
1581 SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
1582 NEXT (2);
1583 }
1584
1585
1586 \f
1587
1588 /*
1589 * Immediates and statically allocated non-immediates
1590 */
1591
1592 /* make-short-immediate dst:8 low-bits:16
1593 *
1594 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1595 * 0.
1596 */
1597 VM_DEFINE_OP (50, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
1598 {
1599 scm_t_uint8 dst;
1600 scm_t_bits val;
1601
1602 UNPACK_8_16 (op, dst, val);
1603 LOCAL_SET (dst, SCM_PACK (val));
1604 NEXT (1);
1605 }
1606
1607 /* make-long-immediate dst:24 low-bits:32
1608 *
1609 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1610 * 0.
1611 */
1612 VM_DEFINE_OP (51, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
1613 {
1614 scm_t_uint32 dst;
1615 scm_t_bits val;
1616
1617 UNPACK_24 (op, dst);
1618 val = ip[1];
1619 LOCAL_SET (dst, SCM_PACK (val));
1620 NEXT (2);
1621 }
1622
1623 /* make-long-long-immediate dst:24 high-bits:32 low-bits:32
1624 *
1625 * Make an immediate with HIGH-BITS and LOW-BITS.
1626 */
1627 VM_DEFINE_OP (52, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
1628 {
1629 scm_t_uint32 dst;
1630 scm_t_bits val;
1631
1632 UNPACK_24 (op, dst);
1633 #if SIZEOF_SCM_T_BITS > 4
1634 val = ip[1];
1635 val <<= 32;
1636 val |= ip[2];
1637 #else
1638 ASSERT (ip[1] == 0);
1639 val = ip[2];
1640 #endif
1641 LOCAL_SET (dst, SCM_PACK (val));
1642 NEXT (3);
1643 }
1644
1645 /* make-non-immediate dst:24 offset:32
1646 *
1647 * Load a pointer to statically allocated memory into DST. The
1648 * object's memory is will be found OFFSET 32-bit words away from the
1649 * current instruction pointer. OFFSET is a signed value. The
1650 * intention here is that the compiler would produce an object file
1651 * containing the words of a non-immediate object, and this
1652 * instruction creates a pointer to that memory, effectively
1653 * resurrecting that object.
1654 *
1655 * Whether the object is mutable or immutable depends on where it was
1656 * allocated by the compiler, and loaded by the loader.
1657 */
1658 VM_DEFINE_OP (53, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
1659 {
1660 scm_t_uint32 dst;
1661 scm_t_int32 offset;
1662 scm_t_uint32* loc;
1663 scm_t_bits unpacked;
1664
1665 UNPACK_24 (op, dst);
1666 offset = ip[1];
1667 loc = ip + offset;
1668 unpacked = (scm_t_bits) loc;
1669
1670 VM_ASSERT (!(unpacked & 0x7), abort());
1671
1672 LOCAL_SET (dst, SCM_PACK (unpacked));
1673
1674 NEXT (2);
1675 }
1676
1677 /* static-ref dst:24 offset:32
1678 *
1679 * Load a SCM value into DST. The SCM value will be fetched from
1680 * memory, OFFSET 32-bit words away from the current instruction
1681 * pointer. OFFSET is a signed value.
1682 *
1683 * The intention is for this instruction to be used to load constants
1684 * that the compiler is unable to statically allocate, like symbols.
1685 * These values would be initialized when the object file loads.
1686 */
1687 VM_DEFINE_OP (54, static_ref, "static-ref", OP2 (U8_U24, S32))
1688 {
1689 scm_t_uint32 dst;
1690 scm_t_int32 offset;
1691 scm_t_uint32* loc;
1692 scm_t_uintptr loc_bits;
1693
1694 UNPACK_24 (op, dst);
1695 offset = ip[1];
1696 loc = ip + offset;
1697 loc_bits = (scm_t_uintptr) loc;
1698 VM_ASSERT (ALIGNED_P (loc, SCM), abort());
1699
1700 LOCAL_SET (dst, *((SCM *) loc_bits));
1701
1702 NEXT (2);
1703 }
1704
1705 /* static-set! src:24 offset:32
1706 *
1707 * Store a SCM value into memory, OFFSET 32-bit words away from the
1708 * current instruction pointer. OFFSET is a signed value.
1709 */
1710 VM_DEFINE_OP (55, static_set, "static-set!", OP2 (U8_U24, LO32))
1711 {
1712 scm_t_uint32 src;
1713 scm_t_int32 offset;
1714 scm_t_uint32* loc;
1715
1716 UNPACK_24 (op, src);
1717 offset = ip[1];
1718 loc = ip + offset;
1719 VM_ASSERT (ALIGNED_P (loc, SCM), abort());
1720
1721 *((SCM *) loc) = LOCAL_REF (src);
1722
1723 NEXT (2);
1724 }
1725
1726 /* static-patch! _:24 dst-offset:32 src-offset:32
1727 *
1728 * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
1729 * are signed 32-bit values, indicating a memory address as a number
1730 * of 32-bit words away from the current instruction pointer.
1731 */
1732 VM_DEFINE_OP (56, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32))
1733 {
1734 scm_t_int32 dst_offset, src_offset;
1735 void *src;
1736 void** dst_loc;
1737
1738 dst_offset = ip[1];
1739 src_offset = ip[2];
1740
1741 dst_loc = (void **) (ip + dst_offset);
1742 src = ip + src_offset;
1743 VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
1744
1745 *dst_loc = src;
1746
1747 NEXT (3);
1748 }
1749
1750 \f
1751
1752 /*
1753 * Mutable top-level bindings
1754 */
1755
1756 /* There are three slightly different ways to resolve toplevel
1757 variables.
1758
1759 1. A toplevel reference outside of a function. These need to be
1760 looked up when the expression is evaluated -- no later, and no
1761 before. They are looked up relative to the module that is
1762 current when the expression is evaluated. For example:
1763
1764 (if (foo) a b)
1765
1766 The "resolve" instruction resolves the variable (box), and then
1767 access is via box-ref or box-set!.
1768
1769 2. A toplevel reference inside a function. These are looked up
1770 relative to the module that was current when the function was
1771 defined. Unlike code at the toplevel, which is usually run only
1772 once, these bindings benefit from memoized lookup, in which the
1773 variable resulting from the lookup is cached in the function.
1774
1775 (lambda () (if (foo) a b))
1776
1777 The toplevel-box instruction is equivalent to "resolve", but
1778 caches the resulting variable in statically allocated memory.
1779
1780 3. A reference to an identifier with respect to a particular
1781 module. This can happen for primitive references, and
1782 references residualized by macro expansions. These can always
1783 be cached. Use module-box for these.
1784 */
1785
1786 /* current-module dst:24
1787 *
1788 * Store the current module in DST.
1789 */
1790 VM_DEFINE_OP (57, current_module, "current-module", OP1 (U8_U24) | OP_DST)
1791 {
1792 scm_t_uint32 dst;
1793
1794 UNPACK_24 (op, dst);
1795
1796 SYNC_IP ();
1797 LOCAL_SET (dst, scm_current_module ());
1798
1799 NEXT (1);
1800 }
1801
1802 /* resolve dst:24 bound?:1 _:7 sym:24
1803 *
1804 * Resolve SYM in the current module, and place the resulting variable
1805 * in DST.
1806 */
1807 VM_DEFINE_OP (58, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
1808 {
1809 scm_t_uint32 dst;
1810 scm_t_uint32 sym;
1811 SCM var;
1812
1813 UNPACK_24 (op, dst);
1814 UNPACK_24 (ip[1], sym);
1815
1816 SYNC_IP ();
1817 var = scm_lookup (LOCAL_REF (sym));
1818 CACHE_FP ();
1819 if (ip[1] & 0x1)
1820 VM_ASSERT (VARIABLE_BOUNDP (var),
1821 vm_error_unbound (fp[0], LOCAL_REF (sym)));
1822 LOCAL_SET (dst, var);
1823
1824 NEXT (2);
1825 }
1826
1827 /* define! sym:12 val:12
1828 *
1829 * Look up a binding for SYM in the current module, creating it if
1830 * necessary. Set its value to VAL.
1831 */
1832 VM_DEFINE_OP (59, define, "define!", OP1 (U8_U12_U12))
1833 {
1834 scm_t_uint16 sym, val;
1835 UNPACK_12_12 (op, sym, val);
1836 SYNC_IP ();
1837 scm_define (LOCAL_REF (sym), LOCAL_REF (val));
1838 CACHE_FP ();
1839 NEXT (1);
1840 }
1841
1842 /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
1843 *
1844 * Load a SCM value. The SCM value will be fetched from memory,
1845 * VAR-OFFSET 32-bit words away from the current instruction pointer.
1846 * VAR-OFFSET is a signed value. Up to here, toplevel-box is like
1847 * static-ref.
1848 *
1849 * Then, if the loaded value is a variable, it is placed in DST, and control
1850 * flow continues.
1851 *
1852 * Otherwise, we have to resolve the variable. In that case we load
1853 * the module from MOD-OFFSET, just as we loaded the variable.
1854 * Usually the module gets set when the closure is created. The name
1855 * is an offset to a symbol.
1856 *
1857 * We use the module and the symbol to resolve the variable, placing it in
1858 * DST, and caching the resolved variable so that we will hit the cache next
1859 * time.
1860 */
1861 VM_DEFINE_OP (60, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
1862 {
1863 scm_t_uint32 dst;
1864 scm_t_int32 var_offset;
1865 scm_t_uint32* var_loc_u32;
1866 SCM *var_loc;
1867 SCM var;
1868
1869 UNPACK_24 (op, dst);
1870 var_offset = ip[1];
1871 var_loc_u32 = ip + var_offset;
1872 VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
1873 var_loc = (SCM *) var_loc_u32;
1874 var = *var_loc;
1875
1876 if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
1877 {
1878 SCM mod, sym;
1879 scm_t_int32 mod_offset = ip[2]; /* signed */
1880 scm_t_int32 sym_offset = ip[3]; /* signed */
1881 scm_t_uint32 *mod_loc = ip + mod_offset;
1882 scm_t_uint32 *sym_loc = ip + sym_offset;
1883
1884 SYNC_IP ();
1885
1886 VM_ASSERT (ALIGNED_P (mod_loc, SCM), abort());
1887 VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
1888
1889 mod = *((SCM *) mod_loc);
1890 sym = *((SCM *) sym_loc);
1891
1892 /* If the toplevel scope was captured before modules were
1893 booted, use the root module. */
1894 if (scm_is_false (mod))
1895 mod = scm_the_root_module ();
1896
1897 var = scm_module_lookup (mod, sym);
1898 CACHE_FP ();
1899 if (ip[4] & 0x1)
1900 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
1901
1902 *var_loc = var;
1903 }
1904
1905 LOCAL_SET (dst, var);
1906 NEXT (5);
1907 }
1908
1909 /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
1910 *
1911 * Like toplevel-box, except MOD-OFFSET points at the name of a module
1912 * instead of the module itself.
1913 */
1914 VM_DEFINE_OP (61, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
1915 {
1916 scm_t_uint32 dst;
1917 scm_t_int32 var_offset;
1918 scm_t_uint32* var_loc_u32;
1919 SCM *var_loc;
1920 SCM var;
1921
1922 UNPACK_24 (op, dst);
1923 var_offset = ip[1];
1924 var_loc_u32 = ip + var_offset;
1925 VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
1926 var_loc = (SCM *) var_loc_u32;
1927 var = *var_loc;
1928
1929 if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
1930 {
1931 SCM modname, sym;
1932 scm_t_int32 modname_offset = ip[2]; /* signed */
1933 scm_t_int32 sym_offset = ip[3]; /* signed */
1934 scm_t_uint32 *modname_words = ip + modname_offset;
1935 scm_t_uint32 *sym_loc = ip + sym_offset;
1936
1937 SYNC_IP ();
1938
1939 VM_ASSERT (!(((scm_t_uintptr) modname_words) & 0x7), abort());
1940 VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
1941
1942 modname = SCM_PACK ((scm_t_bits) modname_words);
1943 sym = *((SCM *) sym_loc);
1944
1945 if (!scm_module_system_booted_p)
1946 {
1947 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
1948 ASSERT
1949 (scm_is_true
1950 scm_equal_p (modname,
1951 scm_list_2 (SCM_BOOL_T,
1952 scm_from_utf8_symbol ("guile"))));
1953 #endif
1954 var = scm_lookup (sym);
1955 }
1956 else if (scm_is_true (SCM_CAR (modname)))
1957 var = scm_public_lookup (SCM_CDR (modname), sym);
1958 else
1959 var = scm_private_lookup (SCM_CDR (modname), sym);
1960
1961 CACHE_FP ();
1962
1963 if (ip[4] & 0x1)
1964 VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
1965
1966 *var_loc = var;
1967 }
1968
1969 LOCAL_SET (dst, var);
1970 NEXT (5);
1971 }
1972
1973 \f
1974
1975 /*
1976 * The dynamic environment
1977 */
1978
1979 /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
1980 *
1981 * Push a new prompt on the dynamic stack, with a tag from TAG and a
1982 * handler at HANDLER-OFFSET words from the current IP. The handler
1983 * will expect a multiple-value return as if from a call with the
1984 * procedure at PROC-SLOT.
1985 */
1986 VM_DEFINE_OP (62, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
1987 {
1988 scm_t_uint32 tag, proc_slot;
1989 scm_t_int32 offset;
1990 scm_t_uint8 escape_only_p;
1991 scm_t_dynstack_prompt_flags flags;
1992
1993 UNPACK_24 (op, tag);
1994 escape_only_p = ip[1] & 0x1;
1995 UNPACK_24 (ip[1], proc_slot);
1996 offset = ip[2];
1997 offset >>= 8; /* Sign extension */
1998
1999 /* Push the prompt onto the dynamic stack. */
2000 flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
2001 scm_dynstack_push_prompt (&current_thread->dynstack, flags,
2002 LOCAL_REF (tag),
2003 fp - vp->stack_base,
2004 LOCAL_ADDRESS (proc_slot) - vp->stack_base,
2005 ip + offset,
2006 registers);
2007 NEXT (3);
2008 }
2009
2010 /* wind winder:12 unwinder:12
2011 *
2012 * Push wind and unwind procedures onto the dynamic stack. Note that
2013 * neither are actually called; the compiler should emit calls to wind
2014 * and unwind for the normal dynamic-wind control flow. Also note that
2015 * the compiler should have inserted checks that they wind and unwind
2016 * procs are thunks, if it could not prove that to be the case.
2017 */
2018 VM_DEFINE_OP (63, wind, "wind", OP1 (U8_U12_U12))
2019 {
2020 scm_t_uint16 winder, unwinder;
2021 UNPACK_12_12 (op, winder, unwinder);
2022 scm_dynstack_push_dynwind (&current_thread->dynstack,
2023 LOCAL_REF (winder), LOCAL_REF (unwinder));
2024 NEXT (1);
2025 }
2026
2027 /* unwind _:24
2028 *
2029 * A normal exit from the dynamic extent of an expression. Pop the top
2030 * entry off of the dynamic stack.
2031 */
2032 VM_DEFINE_OP (64, unwind, "unwind", OP1 (U8_X24))
2033 {
2034 scm_dynstack_pop (&current_thread->dynstack);
2035 NEXT (1);
2036 }
2037
2038 /* push-fluid fluid:12 value:12
2039 *
2040 * Dynamically bind VALUE to FLUID.
2041 */
2042 VM_DEFINE_OP (65, push_fluid, "push-fluid", OP1 (U8_U12_U12))
2043 {
2044 scm_t_uint32 fluid, value;
2045
2046 UNPACK_12_12 (op, fluid, value);
2047
2048 scm_dynstack_push_fluid (&current_thread->dynstack,
2049 LOCAL_REF (fluid), LOCAL_REF (value),
2050 current_thread->dynamic_state);
2051 NEXT (1);
2052 }
2053
2054 /* pop-fluid _:24
2055 *
2056 * Leave the dynamic extent of a with-fluid* expression, restoring the
2057 * fluid to its previous value.
2058 */
2059 VM_DEFINE_OP (66, pop_fluid, "pop-fluid", OP1 (U8_X24))
2060 {
2061 /* This function must not allocate. */
2062 scm_dynstack_unwind_fluid (&current_thread->dynstack,
2063 current_thread->dynamic_state);
2064 NEXT (1);
2065 }
2066
2067 /* fluid-ref dst:12 src:12
2068 *
2069 * Reference the fluid in SRC, and place the value in DST.
2070 */
2071 VM_DEFINE_OP (67, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
2072 {
2073 scm_t_uint16 dst, src;
2074 size_t num;
2075 SCM fluid, fluids;
2076
2077 UNPACK_12_12 (op, dst, src);
2078 fluid = LOCAL_REF (src);
2079 fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
2080 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
2081 || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
2082 {
2083 /* Punt dynstate expansion and error handling to the C proc. */
2084 SYNC_IP ();
2085 LOCAL_SET (dst, scm_fluid_ref (fluid));
2086 }
2087 else
2088 {
2089 SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
2090 if (scm_is_eq (val, SCM_UNDEFINED))
2091 val = SCM_I_FLUID_DEFAULT (fluid);
2092 VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
2093 vm_error_unbound_fluid (SCM_FRAME_PROGRAM (fp), fluid));
2094 LOCAL_SET (dst, val);
2095 }
2096
2097 NEXT (1);
2098 }
2099
2100 /* fluid-set fluid:12 val:12
2101 *
2102 * Set the value of the fluid in DST to the value in SRC.
2103 */
2104 VM_DEFINE_OP (68, fluid_set, "fluid-set", OP1 (U8_U12_U12))
2105 {
2106 scm_t_uint16 a, b;
2107 size_t num;
2108 SCM fluid, fluids;
2109
2110 UNPACK_12_12 (op, a, b);
2111 fluid = LOCAL_REF (a);
2112 fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
2113 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
2114 || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
2115 {
2116 /* Punt dynstate expansion and error handling to the C proc. */
2117 SYNC_IP ();
2118 scm_fluid_set_x (fluid, LOCAL_REF (b));
2119 }
2120 else
2121 SCM_SIMPLE_VECTOR_SET (fluids, num, LOCAL_REF (b));
2122
2123 NEXT (1);
2124 }
2125
2126
2127 \f
2128
2129 /*
2130 * Strings, symbols, and keywords
2131 */
2132
2133 /* string-length dst:12 src:12
2134 *
2135 * Store the length of the string in SRC in DST.
2136 */
2137 VM_DEFINE_OP (69, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
2138 {
2139 ARGS1 (str);
2140 if (SCM_LIKELY (scm_is_string (str)))
2141 RETURN (SCM_I_MAKINUM (scm_i_string_length (str)));
2142 else
2143 {
2144 SYNC_IP ();
2145 RETURN (scm_string_length (str));
2146 }
2147 }
2148
2149 /* string-ref dst:8 src:8 idx:8
2150 *
2151 * Fetch the character at position IDX in the string in SRC, and store
2152 * it in DST.
2153 */
2154 VM_DEFINE_OP (70, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2155 {
2156 scm_t_signed_bits i = 0;
2157 ARGS2 (str, idx);
2158 if (SCM_LIKELY (scm_is_string (str)
2159 && SCM_I_INUMP (idx)
2160 && ((i = SCM_I_INUM (idx)) >= 0)
2161 && i < scm_i_string_length (str)))
2162 RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, i)));
2163 else
2164 {
2165 SYNC_IP ();
2166 RETURN (scm_string_ref (str, idx));
2167 }
2168 }
2169
2170 /* No string-set! instruction, as there is no good fast path there. */
2171
2172 /* string->number dst:12 src:12
2173 *
2174 * Parse a string in SRC to a number, and store in DST.
2175 */
2176 VM_DEFINE_OP (71, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
2177 {
2178 scm_t_uint16 dst, src;
2179
2180 UNPACK_12_12 (op, dst, src);
2181 SYNC_IP ();
2182 LOCAL_SET (dst,
2183 scm_string_to_number (LOCAL_REF (src),
2184 SCM_UNDEFINED /* radix = 10 */));
2185 NEXT (1);
2186 }
2187
2188 /* string->symbol dst:12 src:12
2189 *
2190 * Parse a string in SRC to a symbol, and store in DST.
2191 */
2192 VM_DEFINE_OP (72, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
2193 {
2194 scm_t_uint16 dst, src;
2195
2196 UNPACK_12_12 (op, dst, src);
2197 SYNC_IP ();
2198 LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src)));
2199 NEXT (1);
2200 }
2201
2202 /* symbol->keyword dst:12 src:12
2203 *
2204 * Make a keyword from the symbol in SRC, and store it in DST.
2205 */
2206 VM_DEFINE_OP (73, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
2207 {
2208 scm_t_uint16 dst, src;
2209 UNPACK_12_12 (op, dst, src);
2210 SYNC_IP ();
2211 LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
2212 NEXT (1);
2213 }
2214
2215 \f
2216
2217 /*
2218 * Pairs
2219 */
2220
2221 /* cons dst:8 car:8 cdr:8
2222 *
2223 * Cons CAR and CDR, and store the result in DST.
2224 */
2225 VM_DEFINE_OP (74, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
2226 {
2227 ARGS2 (x, y);
2228 RETURN (scm_cons (x, y));
2229 }
2230
2231 /* car dst:12 src:12
2232 *
2233 * Place the car of SRC in DST.
2234 */
2235 VM_DEFINE_OP (75, car, "car", OP1 (U8_U12_U12) | OP_DST)
2236 {
2237 ARGS1 (x);
2238 VM_VALIDATE_PAIR (x, "car");
2239 RETURN (SCM_CAR (x));
2240 }
2241
2242 /* cdr dst:12 src:12
2243 *
2244 * Place the cdr of SRC in DST.
2245 */
2246 VM_DEFINE_OP (76, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
2247 {
2248 ARGS1 (x);
2249 VM_VALIDATE_PAIR (x, "cdr");
2250 RETURN (SCM_CDR (x));
2251 }
2252
2253 /* set-car! pair:12 car:12
2254 *
2255 * Set the car of DST to SRC.
2256 */
2257 VM_DEFINE_OP (77, set_car, "set-car!", OP1 (U8_U12_U12))
2258 {
2259 scm_t_uint16 a, b;
2260 SCM x, y;
2261 UNPACK_12_12 (op, a, b);
2262 x = LOCAL_REF (a);
2263 y = LOCAL_REF (b);
2264 VM_VALIDATE_PAIR (x, "set-car!");
2265 SCM_SETCAR (x, y);
2266 NEXT (1);
2267 }
2268
2269 /* set-cdr! pair:12 cdr:12
2270 *
2271 * Set the cdr of DST to SRC.
2272 */
2273 VM_DEFINE_OP (78, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
2274 {
2275 scm_t_uint16 a, b;
2276 SCM x, y;
2277 UNPACK_12_12 (op, a, b);
2278 x = LOCAL_REF (a);
2279 y = LOCAL_REF (b);
2280 VM_VALIDATE_PAIR (x, "set-car!");
2281 SCM_SETCDR (x, y);
2282 NEXT (1);
2283 }
2284
2285
2286 \f
2287
2288 /*
2289 * Numeric operations
2290 */
2291
2292 /* add dst:8 a:8 b:8
2293 *
2294 * Add A to B, and place the result in DST.
2295 */
2296 VM_DEFINE_OP (79, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
2297 {
2298 BINARY_INTEGER_OP (+, scm_sum);
2299 }
2300
2301 /* add1 dst:12 src:12
2302 *
2303 * Add 1 to the value in SRC, and place the result in DST.
2304 */
2305 VM_DEFINE_OP (80, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
2306 {
2307 ARGS1 (x);
2308
2309 /* Check for overflow. We must avoid overflow in the signed
2310 addition below, even if X is not an inum. */
2311 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) <= INUM_MAX - INUM_STEP))
2312 {
2313 SCM result;
2314
2315 /* Add 1 to the integer without untagging. */
2316 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) + INUM_STEP);
2317
2318 if (SCM_LIKELY (SCM_I_INUMP (result)))
2319 RETURN (result);
2320 }
2321
2322 RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (1)));
2323 }
2324
2325 /* sub dst:8 a:8 b:8
2326 *
2327 * Subtract B from A, and place the result in DST.
2328 */
2329 VM_DEFINE_OP (81, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
2330 {
2331 BINARY_INTEGER_OP (-, scm_difference);
2332 }
2333
2334 /* sub1 dst:12 src:12
2335 *
2336 * Subtract 1 from SRC, and place the result in DST.
2337 */
2338 VM_DEFINE_OP (82, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
2339 {
2340 ARGS1 (x);
2341
2342 /* Check for overflow. We must avoid overflow in the signed
2343 subtraction below, even if X is not an inum. */
2344 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) >= INUM_MIN + INUM_STEP))
2345 {
2346 SCM result;
2347
2348 /* Substract 1 from the integer without untagging. */
2349 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) - INUM_STEP);
2350
2351 if (SCM_LIKELY (SCM_I_INUMP (result)))
2352 RETURN (result);
2353 }
2354
2355 RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (1)));
2356 }
2357
2358 /* mul dst:8 a:8 b:8
2359 *
2360 * Multiply A and B, and place the result in DST.
2361 */
2362 VM_DEFINE_OP (83, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
2363 {
2364 ARGS2 (x, y);
2365 RETURN_EXP (scm_product (x, y));
2366 }
2367
2368 /* div dst:8 a:8 b:8
2369 *
2370 * Divide A by B, and place the result in DST.
2371 */
2372 VM_DEFINE_OP (84, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
2373 {
2374 ARGS2 (x, y);
2375 RETURN_EXP (scm_divide (x, y));
2376 }
2377
2378 /* quo dst:8 a:8 b:8
2379 *
2380 * Divide A by B, and place the quotient in DST.
2381 */
2382 VM_DEFINE_OP (85, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
2383 {
2384 ARGS2 (x, y);
2385 RETURN_EXP (scm_quotient (x, y));
2386 }
2387
2388 /* rem dst:8 a:8 b:8
2389 *
2390 * Divide A by B, and place the remainder in DST.
2391 */
2392 VM_DEFINE_OP (86, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
2393 {
2394 ARGS2 (x, y);
2395 RETURN_EXP (scm_remainder (x, y));
2396 }
2397
2398 /* mod dst:8 a:8 b:8
2399 *
2400 * Place the modulo of A by B in DST.
2401 */
2402 VM_DEFINE_OP (87, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
2403 {
2404 ARGS2 (x, y);
2405 RETURN_EXP (scm_modulo (x, y));
2406 }
2407
2408 /* ash dst:8 a:8 b:8
2409 *
2410 * Shift A arithmetically by B bits, and place the result in DST.
2411 */
2412 VM_DEFINE_OP (88, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
2413 {
2414 ARGS2 (x, y);
2415 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2416 {
2417 if (SCM_I_INUM (y) < 0)
2418 /* Right shift, will be a fixnum. */
2419 RETURN (SCM_I_MAKINUM
2420 (SCM_SRS (SCM_I_INUM (x),
2421 (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1)
2422 ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1)));
2423 else
2424 /* Left shift. See comments in scm_ash. */
2425 {
2426 scm_t_signed_bits nn, bits_to_shift;
2427
2428 nn = SCM_I_INUM (x);
2429 bits_to_shift = SCM_I_INUM (y);
2430
2431 if (bits_to_shift < SCM_I_FIXNUM_BIT-1
2432 && ((scm_t_bits)
2433 (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
2434 <= 1))
2435 RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
2436 /* fall through */
2437 }
2438 /* fall through */
2439 }
2440 RETURN_EXP (scm_ash (x, y));
2441 }
2442
2443 /* logand dst:8 a:8 b:8
2444 *
2445 * Place the bitwise AND of A and B into DST.
2446 */
2447 VM_DEFINE_OP (89, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
2448 {
2449 ARGS2 (x, y);
2450 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2451 /* Compute bitwise AND without untagging */
2452 RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
2453 RETURN_EXP (scm_logand (x, y));
2454 }
2455
2456 /* logior dst:8 a:8 b:8
2457 *
2458 * Place the bitwise inclusive OR of A with B in DST.
2459 */
2460 VM_DEFINE_OP (90, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
2461 {
2462 ARGS2 (x, y);
2463 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2464 /* Compute bitwise OR without untagging */
2465 RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
2466 RETURN_EXP (scm_logior (x, y));
2467 }
2468
2469 /* logxor dst:8 a:8 b:8
2470 *
2471 * Place the bitwise exclusive OR of A with B in DST.
2472 */
2473 VM_DEFINE_OP (91, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
2474 {
2475 ARGS2 (x, y);
2476 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
2477 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
2478 RETURN_EXP (scm_logxor (x, y));
2479 }
2480
2481 /* make-vector/immediate dst:8 length:8 init:8
2482 *
2483 * Make a short vector of known size and write it to DST. The vector
2484 * will have space for LENGTH slots, an immediate value. They will be
2485 * filled with the value in slot INIT.
2486 */
2487 VM_DEFINE_OP (92, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
2488 {
2489 scm_t_uint8 dst, init;
2490 scm_t_int32 length, n;
2491 SCM val, vector;
2492
2493 UNPACK_8_8_8 (op, dst, length, init);
2494
2495 val = LOCAL_REF (init);
2496 vector = scm_words (scm_tc7_vector | (length << 8), length + 1);
2497 for (n = 0; n < length; n++)
2498 SCM_SIMPLE_VECTOR_SET (vector, n, val);
2499 LOCAL_SET (dst, vector);
2500 NEXT (1);
2501 }
2502
2503 /* vector-length dst:12 src:12
2504 *
2505 * Store the length of the vector in SRC in DST.
2506 */
2507 VM_DEFINE_OP (93, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
2508 {
2509 ARGS1 (vect);
2510 if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
2511 RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
2512 else
2513 {
2514 SYNC_IP ();
2515 RETURN (scm_vector_length (vect));
2516 }
2517 }
2518
2519 /* vector-ref dst:8 src:8 idx:8
2520 *
2521 * Fetch the item at position IDX in the vector in SRC, and store it
2522 * in DST.
2523 */
2524 VM_DEFINE_OP (94, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2525 {
2526 scm_t_signed_bits i = 0;
2527 ARGS2 (vect, idx);
2528 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
2529 && SCM_I_INUMP (idx)
2530 && ((i = SCM_I_INUM (idx)) >= 0)
2531 && i < SCM_I_VECTOR_LENGTH (vect)))
2532 RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
2533 else
2534 {
2535 SYNC_IP ();
2536 RETURN (scm_vector_ref (vect, idx));
2537 }
2538 }
2539
2540 /* vector-ref/immediate dst:8 src:8 idx:8
2541 *
2542 * Fill DST with the item IDX elements into the vector at SRC. Useful
2543 * for building data types using vectors.
2544 */
2545 VM_DEFINE_OP (95, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
2546 {
2547 scm_t_uint8 dst, src, idx;
2548 SCM v;
2549
2550 UNPACK_8_8_8 (op, dst, src, idx);
2551 v = LOCAL_REF (src);
2552 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v)
2553 && idx < SCM_I_VECTOR_LENGTH (v)))
2554 LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
2555 else
2556 LOCAL_SET (dst, scm_c_vector_ref (v, idx));
2557 NEXT (1);
2558 }
2559
2560 /* vector-set! dst:8 idx:8 src:8
2561 *
2562 * Store SRC into the vector DST at index IDX.
2563 */
2564 VM_DEFINE_OP (96, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
2565 {
2566 scm_t_uint8 dst, idx_var, src;
2567 SCM vect, idx, val;
2568 scm_t_signed_bits i = 0;
2569
2570 UNPACK_8_8_8 (op, dst, idx_var, src);
2571 vect = LOCAL_REF (dst);
2572 idx = LOCAL_REF (idx_var);
2573 val = LOCAL_REF (src);
2574
2575 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
2576 && SCM_I_INUMP (idx)
2577 && ((i = SCM_I_INUM (idx)) >= 0)
2578 && i < SCM_I_VECTOR_LENGTH (vect)))
2579 SCM_I_VECTOR_WELTS (vect)[i] = val;
2580 else
2581 {
2582 SYNC_IP ();
2583 scm_vector_set_x (vect, idx, val);
2584 }
2585 NEXT (1);
2586 }
2587
2588 /* vector-set!/immediate dst:8 idx:8 src:8
2589 *
2590 * Store SRC into the vector DST at index IDX. Here IDX is an
2591 * immediate value.
2592 */
2593 VM_DEFINE_OP (97, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
2594 {
2595 scm_t_uint8 dst, idx, src;
2596 SCM vect, val;
2597
2598 UNPACK_8_8_8 (op, dst, idx, src);
2599 vect = LOCAL_REF (dst);
2600 val = LOCAL_REF (src);
2601
2602 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
2603 && idx < SCM_I_VECTOR_LENGTH (vect)))
2604 SCM_I_VECTOR_WELTS (vect)[idx] = val;
2605 else
2606 {
2607 SYNC_IP ();
2608 scm_vector_set_x (vect, scm_from_uint8 (idx), val);
2609 }
2610 NEXT (1);
2611 }
2612
2613
2614 \f
2615
2616 /*
2617 * Structs and GOOPS
2618 */
2619
2620 /* struct-vtable dst:12 src:12
2621 *
2622 * Store the vtable of SRC into DST.
2623 */
2624 VM_DEFINE_OP (98, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
2625 {
2626 ARGS1 (obj);
2627 VM_VALIDATE_STRUCT (obj, "struct_vtable");
2628 RETURN (SCM_STRUCT_VTABLE (obj));
2629 }
2630
2631 /* allocate-struct/immediate dst:8 vtable:8 nfields:8
2632 *
2633 * Allocate a new struct with VTABLE, and place it in DST. The struct
2634 * will be constructed with space for NFIELDS fields, which should
2635 * correspond to the field count of the VTABLE.
2636 */
2637 VM_DEFINE_OP (99, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
2638 {
2639 scm_t_uint8 dst, vtable, nfields;
2640 SCM ret;
2641
2642 UNPACK_8_8_8 (op, dst, vtable, nfields);
2643
2644 SYNC_IP ();
2645 ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields));
2646 LOCAL_SET (dst, ret);
2647
2648 NEXT (1);
2649 }
2650
2651 /* struct-ref/immediate dst:8 src:8 idx:8
2652 *
2653 * Fetch the item at slot IDX in the struct in SRC, and store it
2654 * in DST. IDX is an immediate unsigned 8-bit value.
2655 */
2656 VM_DEFINE_OP (100, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
2657 {
2658 scm_t_uint8 dst, src, idx;
2659 SCM obj;
2660
2661 UNPACK_8_8_8 (op, dst, src, idx);
2662
2663 obj = LOCAL_REF (src);
2664
2665 if (SCM_LIKELY (SCM_STRUCTP (obj)
2666 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2667 SCM_VTABLE_FLAG_SIMPLE)
2668 && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
2669 scm_vtable_index_size)))
2670 RETURN (SCM_STRUCT_SLOT_REF (obj, idx));
2671
2672 SYNC_IP ();
2673 RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx)));
2674 }
2675
2676 /* struct-set!/immediate dst:8 idx:8 src:8
2677 *
2678 * Store SRC into the struct DST at slot IDX. IDX is an immediate
2679 * unsigned 8-bit value.
2680 */
2681 VM_DEFINE_OP (101, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
2682 {
2683 scm_t_uint8 dst, idx, src;
2684 SCM obj, val;
2685
2686 UNPACK_8_8_8 (op, dst, idx, src);
2687
2688 obj = LOCAL_REF (dst);
2689 val = LOCAL_REF (src);
2690
2691 if (SCM_LIKELY (SCM_STRUCTP (obj)
2692 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2693 SCM_VTABLE_FLAG_SIMPLE)
2694 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
2695 SCM_VTABLE_FLAG_SIMPLE_RW)
2696 && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
2697 scm_vtable_index_size)))
2698 {
2699 SCM_STRUCT_SLOT_SET (obj, idx, val);
2700 NEXT (1);
2701 }
2702
2703 SYNC_IP ();
2704 scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val);
2705 NEXT (1);
2706 }
2707
2708 /* class-of dst:12 type:12
2709 *
2710 * Store the vtable of SRC into DST.
2711 */
2712 VM_DEFINE_OP (102, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
2713 {
2714 ARGS1 (obj);
2715 if (SCM_INSTANCEP (obj))
2716 RETURN (SCM_CLASS_OF (obj));
2717 SYNC_IP ();
2718 RETURN (scm_class_of (obj));
2719 }
2720
2721 VM_DEFINE_OP (103, unused_103, NULL, NOP)
2722 VM_DEFINE_OP (104, unused_104, NULL, NOP)
2723 goto op_unused_255;
2724
2725 \f
2726
2727 /*
2728 * Arrays, packed uniform arrays, and bytevectors.
2729 */
2730
2731 /* load-typed-array dst:8 type:8 shape:8 offset:32 len:32
2732 *
2733 * Load the contiguous typed array located at OFFSET 32-bit words away
2734 * from the instruction pointer, and store into DST. LEN is a byte
2735 * length. OFFSET is signed.
2736 */
2737 VM_DEFINE_OP (105, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
2738 {
2739 scm_t_uint8 dst, type, shape;
2740 scm_t_int32 offset;
2741 scm_t_uint32 len;
2742
2743 UNPACK_8_8_8 (op, dst, type, shape);
2744 offset = ip[1];
2745 len = ip[2];
2746 SYNC_IP ();
2747 LOCAL_SET (dst, scm_from_contiguous_typed_array (LOCAL_REF (type),
2748 LOCAL_REF (shape),
2749 ip + offset, len));
2750 NEXT (3);
2751 }
2752
2753 /* make-array dst:12 type:12 _:8 fill:12 bounds:12
2754 *
2755 * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
2756 */
2757 VM_DEFINE_OP (106, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
2758 {
2759 scm_t_uint16 dst, type, fill, bounds;
2760 UNPACK_12_12 (op, dst, type);
2761 UNPACK_12_12 (ip[1], fill, bounds);
2762 SYNC_IP ();
2763 LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill),
2764 LOCAL_REF (bounds)));
2765 NEXT (2);
2766 }
2767
2768 /* bv-u8-ref dst:8 src:8 idx:8
2769 * bv-s8-ref dst:8 src:8 idx:8
2770 * bv-u16-ref dst:8 src:8 idx:8
2771 * bv-s16-ref dst:8 src:8 idx:8
2772 * bv-u32-ref dst:8 src:8 idx:8
2773 * bv-s32-ref dst:8 src:8 idx:8
2774 * bv-u64-ref dst:8 src:8 idx:8
2775 * bv-s64-ref dst:8 src:8 idx:8
2776 * bv-f32-ref dst:8 src:8 idx:8
2777 * bv-f64-ref dst:8 src:8 idx:8
2778 *
2779 * Fetch the item at byte offset IDX in the bytevector SRC, and store
2780 * it in DST. All accesses use native endianness.
2781 */
2782 #define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
2783 do { \
2784 scm_t_signed_bits i; \
2785 const scm_t_ ## type *int_ptr; \
2786 ARGS2 (bv, idx); \
2787 \
2788 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2789 i = SCM_I_INUM (idx); \
2790 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2791 \
2792 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2793 && (i >= 0) \
2794 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2795 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2796 RETURN (SCM_I_MAKINUM (*int_ptr)); \
2797 else \
2798 { \
2799 SYNC_IP (); \
2800 RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx)); \
2801 } \
2802 } while (0)
2803
2804 #define BV_INT_REF(stem, type, size) \
2805 do { \
2806 scm_t_signed_bits i; \
2807 const scm_t_ ## type *int_ptr; \
2808 ARGS2 (bv, idx); \
2809 \
2810 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2811 i = SCM_I_INUM (idx); \
2812 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2813 \
2814 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2815 && (i >= 0) \
2816 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2817 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2818 { \
2819 scm_t_ ## type x = *int_ptr; \
2820 if (SCM_FIXABLE (x)) \
2821 RETURN (SCM_I_MAKINUM (x)); \
2822 else \
2823 { \
2824 SYNC_IP (); \
2825 RETURN (scm_from_ ## type (x)); \
2826 } \
2827 } \
2828 else \
2829 { \
2830 SYNC_IP (); \
2831 RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx)); \
2832 } \
2833 } while (0)
2834
2835 #define BV_FLOAT_REF(stem, fn_stem, type, size) \
2836 do { \
2837 scm_t_signed_bits i; \
2838 const type *float_ptr; \
2839 ARGS2 (bv, idx); \
2840 \
2841 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2842 i = SCM_I_INUM (idx); \
2843 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2844 \
2845 SYNC_IP (); \
2846 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2847 && (i >= 0) \
2848 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2849 && (ALIGNED_P (float_ptr, type)))) \
2850 RETURN (scm_from_double (*float_ptr)); \
2851 else \
2852 RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
2853 } while (0)
2854
2855 VM_DEFINE_OP (107, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2856 BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
2857
2858 VM_DEFINE_OP (108, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2859 BV_FIXABLE_INT_REF (s8, s8, int8, 1);
2860
2861 VM_DEFINE_OP (109, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2862 BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
2863
2864 VM_DEFINE_OP (110, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2865 BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
2866
2867 VM_DEFINE_OP (111, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2868 #if SIZEOF_VOID_P > 4
2869 BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
2870 #else
2871 BV_INT_REF (u32, uint32, 4);
2872 #endif
2873
2874 VM_DEFINE_OP (112, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2875 #if SIZEOF_VOID_P > 4
2876 BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
2877 #else
2878 BV_INT_REF (s32, int32, 4);
2879 #endif
2880
2881 VM_DEFINE_OP (113, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2882 BV_INT_REF (u64, uint64, 8);
2883
2884 VM_DEFINE_OP (114, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2885 BV_INT_REF (s64, int64, 8);
2886
2887 VM_DEFINE_OP (115, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2888 BV_FLOAT_REF (f32, ieee_single, float, 4);
2889
2890 VM_DEFINE_OP (116, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
2891 BV_FLOAT_REF (f64, ieee_double, double, 8);
2892
2893 /* bv-u8-set! dst:8 idx:8 src:8
2894 * bv-s8-set! dst:8 idx:8 src:8
2895 * bv-u16-set! dst:8 idx:8 src:8
2896 * bv-s16-set! dst:8 idx:8 src:8
2897 * bv-u32-set! dst:8 idx:8 src:8
2898 * bv-s32-set! dst:8 idx:8 src:8
2899 * bv-u64-set! dst:8 idx:8 src:8
2900 * bv-s64-set! dst:8 idx:8 src:8
2901 * bv-f32-set! dst:8 idx:8 src:8
2902 * bv-f64-set! dst:8 idx:8 src:8
2903 *
2904 * Store SRC into the bytevector DST at byte offset IDX. Multibyte
2905 * values are written using native endianness.
2906 */
2907 #define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
2908 do { \
2909 scm_t_uint8 dst, idx, src; \
2910 scm_t_signed_bits i, j = 0; \
2911 SCM bv, scm_idx, val; \
2912 scm_t_ ## type *int_ptr; \
2913 \
2914 UNPACK_8_8_8 (op, dst, idx, src); \
2915 bv = LOCAL_REF (dst); \
2916 scm_idx = LOCAL_REF (idx); \
2917 val = LOCAL_REF (src); \
2918 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
2919 i = SCM_I_INUM (scm_idx); \
2920 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2921 \
2922 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2923 && (i >= 0) \
2924 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2925 && (ALIGNED_P (int_ptr, scm_t_ ## type)) \
2926 && (SCM_I_INUMP (val)) \
2927 && ((j = SCM_I_INUM (val)) >= min) \
2928 && (j <= max))) \
2929 *int_ptr = (scm_t_ ## type) j; \
2930 else \
2931 { \
2932 SYNC_IP (); \
2933 scm_bytevector_ ## fn_stem ## _set_x (bv, scm_idx, val); \
2934 } \
2935 NEXT (1); \
2936 } while (0)
2937
2938 #define BV_INT_SET(stem, type, size) \
2939 do { \
2940 scm_t_uint8 dst, idx, src; \
2941 scm_t_signed_bits i; \
2942 SCM bv, scm_idx, val; \
2943 scm_t_ ## type *int_ptr; \
2944 \
2945 UNPACK_8_8_8 (op, dst, idx, src); \
2946 bv = LOCAL_REF (dst); \
2947 scm_idx = LOCAL_REF (idx); \
2948 val = LOCAL_REF (src); \
2949 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
2950 i = SCM_I_INUM (scm_idx); \
2951 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2952 \
2953 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2954 && (i >= 0) \
2955 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2956 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2957 *int_ptr = scm_to_ ## type (val); \
2958 else \
2959 { \
2960 SYNC_IP (); \
2961 scm_bytevector_ ## stem ## _native_set_x (bv, scm_idx, val); \
2962 } \
2963 NEXT (1); \
2964 } while (0)
2965
2966 #define BV_FLOAT_SET(stem, fn_stem, type, size) \
2967 do { \
2968 scm_t_uint8 dst, idx, src; \
2969 scm_t_signed_bits i; \
2970 SCM bv, scm_idx, val; \
2971 type *float_ptr; \
2972 \
2973 UNPACK_8_8_8 (op, dst, idx, src); \
2974 bv = LOCAL_REF (dst); \
2975 scm_idx = LOCAL_REF (idx); \
2976 val = LOCAL_REF (src); \
2977 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
2978 i = SCM_I_INUM (scm_idx); \
2979 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2980 \
2981 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2982 && (i >= 0) \
2983 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2984 && (ALIGNED_P (float_ptr, type)))) \
2985 *float_ptr = scm_to_double (val); \
2986 else \
2987 { \
2988 SYNC_IP (); \
2989 scm_bytevector_ ## fn_stem ## _native_set_x (bv, scm_idx, val); \
2990 } \
2991 NEXT (1); \
2992 } while (0)
2993
2994 VM_DEFINE_OP (117, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
2995 BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
2996
2997 VM_DEFINE_OP (118, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
2998 BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
2999
3000 VM_DEFINE_OP (119, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
3001 BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
3002
3003 VM_DEFINE_OP (120, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
3004 BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
3005
3006 VM_DEFINE_OP (121, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
3007 #if SIZEOF_VOID_P > 4
3008 BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
3009 #else
3010 BV_INT_SET (u32, uint32, 4);
3011 #endif
3012
3013 VM_DEFINE_OP (122, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
3014 #if SIZEOF_VOID_P > 4
3015 BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
3016 #else
3017 BV_INT_SET (s32, int32, 4);
3018 #endif
3019
3020 VM_DEFINE_OP (123, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
3021 BV_INT_SET (u64, uint64, 8);
3022
3023 VM_DEFINE_OP (124, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
3024 BV_INT_SET (s64, int64, 8);
3025
3026 VM_DEFINE_OP (125, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
3027 BV_FLOAT_SET (f32, ieee_single, float, 4);
3028
3029 VM_DEFINE_OP (126, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
3030 BV_FLOAT_SET (f64, ieee_double, double, 8);
3031
3032 VM_DEFINE_OP (127, unused_127, NULL, NOP)
3033 VM_DEFINE_OP (128, unused_128, NULL, NOP)
3034 VM_DEFINE_OP (129, unused_129, NULL, NOP)
3035 VM_DEFINE_OP (130, unused_130, NULL, NOP)
3036 VM_DEFINE_OP (131, unused_131, NULL, NOP)
3037 VM_DEFINE_OP (132, unused_132, NULL, NOP)
3038 VM_DEFINE_OP (133, unused_133, NULL, NOP)
3039 VM_DEFINE_OP (134, unused_134, NULL, NOP)
3040 VM_DEFINE_OP (135, unused_135, NULL, NOP)
3041 VM_DEFINE_OP (136, unused_136, NULL, NOP)
3042 VM_DEFINE_OP (137, unused_137, NULL, NOP)
3043 VM_DEFINE_OP (138, unused_138, NULL, NOP)
3044 VM_DEFINE_OP (139, unused_139, NULL, NOP)
3045 VM_DEFINE_OP (140, unused_140, NULL, NOP)
3046 VM_DEFINE_OP (141, unused_141, NULL, NOP)
3047 VM_DEFINE_OP (142, unused_142, NULL, NOP)
3048 VM_DEFINE_OP (143, unused_143, NULL, NOP)
3049 VM_DEFINE_OP (144, unused_144, NULL, NOP)
3050 VM_DEFINE_OP (145, unused_145, NULL, NOP)
3051 VM_DEFINE_OP (146, unused_146, NULL, NOP)
3052 VM_DEFINE_OP (147, unused_147, NULL, NOP)
3053 VM_DEFINE_OP (148, unused_148, NULL, NOP)
3054 VM_DEFINE_OP (149, unused_149, NULL, NOP)
3055 VM_DEFINE_OP (150, unused_150, NULL, NOP)
3056 VM_DEFINE_OP (151, unused_151, NULL, NOP)
3057 VM_DEFINE_OP (152, unused_152, NULL, NOP)
3058 VM_DEFINE_OP (153, unused_153, NULL, NOP)
3059 VM_DEFINE_OP (154, unused_154, NULL, NOP)
3060 VM_DEFINE_OP (155, unused_155, NULL, NOP)
3061 VM_DEFINE_OP (156, unused_156, NULL, NOP)
3062 VM_DEFINE_OP (157, unused_157, NULL, NOP)
3063 VM_DEFINE_OP (158, unused_158, NULL, NOP)
3064 VM_DEFINE_OP (159, unused_159, NULL, NOP)
3065 VM_DEFINE_OP (160, unused_160, NULL, NOP)
3066 VM_DEFINE_OP (161, unused_161, NULL, NOP)
3067 VM_DEFINE_OP (162, unused_162, NULL, NOP)
3068 VM_DEFINE_OP (163, unused_163, NULL, NOP)
3069 VM_DEFINE_OP (164, unused_164, NULL, NOP)
3070 VM_DEFINE_OP (165, unused_165, NULL, NOP)
3071 VM_DEFINE_OP (166, unused_166, NULL, NOP)
3072 VM_DEFINE_OP (167, unused_167, NULL, NOP)
3073 VM_DEFINE_OP (168, unused_168, NULL, NOP)
3074 VM_DEFINE_OP (169, unused_169, NULL, NOP)
3075 VM_DEFINE_OP (170, unused_170, NULL, NOP)
3076 VM_DEFINE_OP (171, unused_171, NULL, NOP)
3077 VM_DEFINE_OP (172, unused_172, NULL, NOP)
3078 VM_DEFINE_OP (173, unused_173, NULL, NOP)
3079 VM_DEFINE_OP (174, unused_174, NULL, NOP)
3080 VM_DEFINE_OP (175, unused_175, NULL, NOP)
3081 VM_DEFINE_OP (176, unused_176, NULL, NOP)
3082 VM_DEFINE_OP (177, unused_177, NULL, NOP)
3083 VM_DEFINE_OP (178, unused_178, NULL, NOP)
3084 VM_DEFINE_OP (179, unused_179, NULL, NOP)
3085 VM_DEFINE_OP (180, unused_180, NULL, NOP)
3086 VM_DEFINE_OP (181, unused_181, NULL, NOP)
3087 VM_DEFINE_OP (182, unused_182, NULL, NOP)
3088 VM_DEFINE_OP (183, unused_183, NULL, NOP)
3089 VM_DEFINE_OP (184, unused_184, NULL, NOP)
3090 VM_DEFINE_OP (185, unused_185, NULL, NOP)
3091 VM_DEFINE_OP (186, unused_186, NULL, NOP)
3092 VM_DEFINE_OP (187, unused_187, NULL, NOP)
3093 VM_DEFINE_OP (188, unused_188, NULL, NOP)
3094 VM_DEFINE_OP (189, unused_189, NULL, NOP)
3095 VM_DEFINE_OP (190, unused_190, NULL, NOP)
3096 VM_DEFINE_OP (191, unused_191, NULL, NOP)
3097 VM_DEFINE_OP (192, unused_192, NULL, NOP)
3098 VM_DEFINE_OP (193, unused_193, NULL, NOP)
3099 VM_DEFINE_OP (194, unused_194, NULL, NOP)
3100 VM_DEFINE_OP (195, unused_195, NULL, NOP)
3101 VM_DEFINE_OP (196, unused_196, NULL, NOP)
3102 VM_DEFINE_OP (197, unused_197, NULL, NOP)
3103 VM_DEFINE_OP (198, unused_198, NULL, NOP)
3104 VM_DEFINE_OP (199, unused_199, NULL, NOP)
3105 VM_DEFINE_OP (200, unused_200, NULL, NOP)
3106 VM_DEFINE_OP (201, unused_201, NULL, NOP)
3107 VM_DEFINE_OP (202, unused_202, NULL, NOP)
3108 VM_DEFINE_OP (203, unused_203, NULL, NOP)
3109 VM_DEFINE_OP (204, unused_204, NULL, NOP)
3110 VM_DEFINE_OP (205, unused_205, NULL, NOP)
3111 VM_DEFINE_OP (206, unused_206, NULL, NOP)
3112 VM_DEFINE_OP (207, unused_207, NULL, NOP)
3113 VM_DEFINE_OP (208, unused_208, NULL, NOP)
3114 VM_DEFINE_OP (209, unused_209, NULL, NOP)
3115 VM_DEFINE_OP (210, unused_210, NULL, NOP)
3116 VM_DEFINE_OP (211, unused_211, NULL, NOP)
3117 VM_DEFINE_OP (212, unused_212, NULL, NOP)
3118 VM_DEFINE_OP (213, unused_213, NULL, NOP)
3119 VM_DEFINE_OP (214, unused_214, NULL, NOP)
3120 VM_DEFINE_OP (215, unused_215, NULL, NOP)
3121 VM_DEFINE_OP (216, unused_216, NULL, NOP)
3122 VM_DEFINE_OP (217, unused_217, NULL, NOP)
3123 VM_DEFINE_OP (218, unused_218, NULL, NOP)
3124 VM_DEFINE_OP (219, unused_219, NULL, NOP)
3125 VM_DEFINE_OP (220, unused_220, NULL, NOP)
3126 VM_DEFINE_OP (221, unused_221, NULL, NOP)
3127 VM_DEFINE_OP (222, unused_222, NULL, NOP)
3128 VM_DEFINE_OP (223, unused_223, NULL, NOP)
3129 VM_DEFINE_OP (224, unused_224, NULL, NOP)
3130 VM_DEFINE_OP (225, unused_225, NULL, NOP)
3131 VM_DEFINE_OP (226, unused_226, NULL, NOP)
3132 VM_DEFINE_OP (227, unused_227, NULL, NOP)
3133 VM_DEFINE_OP (228, unused_228, NULL, NOP)
3134 VM_DEFINE_OP (229, unused_229, NULL, NOP)
3135 VM_DEFINE_OP (230, unused_230, NULL, NOP)
3136 VM_DEFINE_OP (231, unused_231, NULL, NOP)
3137 VM_DEFINE_OP (232, unused_232, NULL, NOP)
3138 VM_DEFINE_OP (233, unused_233, NULL, NOP)
3139 VM_DEFINE_OP (234, unused_234, NULL, NOP)
3140 VM_DEFINE_OP (235, unused_235, NULL, NOP)
3141 VM_DEFINE_OP (236, unused_236, NULL, NOP)
3142 VM_DEFINE_OP (237, unused_237, NULL, NOP)
3143 VM_DEFINE_OP (238, unused_238, NULL, NOP)
3144 VM_DEFINE_OP (239, unused_239, NULL, NOP)
3145 VM_DEFINE_OP (240, unused_240, NULL, NOP)
3146 VM_DEFINE_OP (241, unused_241, NULL, NOP)
3147 VM_DEFINE_OP (242, unused_242, NULL, NOP)
3148 VM_DEFINE_OP (243, unused_243, NULL, NOP)
3149 VM_DEFINE_OP (244, unused_244, NULL, NOP)
3150 VM_DEFINE_OP (245, unused_245, NULL, NOP)
3151 VM_DEFINE_OP (246, unused_246, NULL, NOP)
3152 VM_DEFINE_OP (247, unused_247, NULL, NOP)
3153 VM_DEFINE_OP (248, unused_248, NULL, NOP)
3154 VM_DEFINE_OP (249, unused_249, NULL, NOP)
3155 VM_DEFINE_OP (250, unused_250, NULL, NOP)
3156 VM_DEFINE_OP (251, unused_251, NULL, NOP)
3157 VM_DEFINE_OP (252, unused_252, NULL, NOP)
3158 VM_DEFINE_OP (253, unused_253, NULL, NOP)
3159 VM_DEFINE_OP (254, unused_254, NULL, NOP)
3160 VM_DEFINE_OP (255, unused_255, NULL, NOP)
3161 {
3162 vm_error_bad_instruction (op);
3163 abort (); /* never reached */
3164 }
3165
3166 END_DISPATCH_SWITCH;
3167 }
3168
3169
3170 #undef ABORT_CONTINUATION_HOOK
3171 #undef ALIGNED_P
3172 #undef APPLY_HOOK
3173 #undef ARGS1
3174 #undef ARGS2
3175 #undef BEGIN_DISPATCH_SWITCH
3176 #undef BINARY_INTEGER_OP
3177 #undef BR_ARITHMETIC
3178 #undef BR_BINARY
3179 #undef BR_NARGS
3180 #undef BR_UNARY
3181 #undef BV_FIXABLE_INT_REF
3182 #undef BV_FIXABLE_INT_SET
3183 #undef BV_FLOAT_REF
3184 #undef BV_FLOAT_SET
3185 #undef BV_INT_REF
3186 #undef BV_INT_SET
3187 #undef CACHE_REGISTER
3188 #undef CHECK_OVERFLOW
3189 #undef END_DISPATCH_SWITCH
3190 #undef FREE_VARIABLE_REF
3191 #undef INIT
3192 #undef INUM_MAX
3193 #undef INUM_MIN
3194 #undef LOCAL_REF
3195 #undef LOCAL_SET
3196 #undef NEXT
3197 #undef NEXT_HOOK
3198 #undef NEXT_JUMP
3199 #undef POP_CONTINUATION_HOOK
3200 #undef PUSH_CONTINUATION_HOOK
3201 #undef RETURN
3202 #undef RETURN_ONE_VALUE
3203 #undef RETURN_VALUE_LIST
3204 #undef RUN_HOOK
3205 #undef RUN_HOOK0
3206 #undef RUN_HOOK1
3207 #undef SYNC_IP
3208 #undef UNPACK_8_8_8
3209 #undef UNPACK_8_16
3210 #undef UNPACK_16_8
3211 #undef UNPACK_12_12
3212 #undef UNPACK_24
3213 #undef VARIABLE_BOUNDP
3214 #undef VARIABLE_REF
3215 #undef VARIABLE_SET
3216 #undef VM_CHECK_FREE_VARIABLE
3217 #undef VM_CHECK_OBJECT
3218 #undef VM_CHECK_UNDERFLOW
3219 #undef VM_DEFINE_OP
3220 #undef VM_INSTRUCTION_TO_LABEL
3221 #undef VM_USE_HOOKS
3222 #undef VM_VALIDATE_BYTEVECTOR
3223 #undef VM_VALIDATE_PAIR
3224 #undef VM_VALIDATE_STRUCT
3225
3226 /*
3227 (defun renumber-ops ()
3228 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
3229 (interactive "")
3230 (save-excursion
3231 (let ((counter -1)) (goto-char (point-min))
3232 (while (re-search-forward "^ *VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
3233 (replace-match
3234 (number-to-string (setq counter (1+ counter)))
3235 t t nil 1)))))
3236 (renumber-ops)
3237 */
3238 /*
3239 Local Variables:
3240 c-file-style: "gnu"
3241 End:
3242 */