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