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