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