1 /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
19 /* This file is included in vm.c multiple times. */
22 #define UNPACK_8_8_8(op,a,b,c) \
25 a = (op >> 8) & 0xff; \
26 b = (op >> 16) & 0xff; \
31 #define UNPACK_8_16(op,a,b) \
34 a = (op >> 8) & 0xff; \
39 #define UNPACK_16_8(op,a,b) \
42 a = (op >> 8) & 0xffff; \
47 #define UNPACK_12_12(op,a,b) \
50 a = (op >> 8) & 0xfff; \
55 #define UNPACK_24(op,a) \
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. */
69 # if defined __x86_64__
70 /* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
71 well. Tell it to keep the jump table in a r12, which is
73 # define JT_REG asm ("r12")
87 #define VM_ASSERT(condition, handler) \
89 if (SCM_UNLIKELY (!(condition))) \
96 #ifdef VM_ENABLE_ASSERTIONS
97 # define ASSERT(condition) VM_ASSERT (condition, abort())
99 # define ASSERT(condition)
103 #define RUN_HOOK(exp) \
105 if (SCM_UNLIKELY (vp->trace_level > 0)) \
113 #define RUN_HOOK(exp)
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))
118 #define APPLY_HOOK() \
120 #define PUSH_CONTINUATION_HOOK() \
121 RUN_HOOK0 (push_continuation)
122 #define POP_CONTINUATION_HOOK(old_fp) \
123 RUN_HOOK1 (pop_continuation, old_fp)
124 #define NEXT_HOOK() \
126 #define ABORT_CONTINUATION_HOOK() \
129 #define VM_HANDLE_INTERRUPTS \
130 SCM_ASYNC_TICK_WITH_GUARD_CODE (current_thread, SYNC_IP (), CACHE_FP ())
135 This is Guile's new virtual machine. When I say "new", I mean
136 relative to the current virtual machine. At some point it will
137 become "the" virtual machine, and we'll delete this paragraph. As
138 such, the rest of the comments speak as if there's only one VM.
139 In difference from the old VM, local 0 is the procedure, and the
140 first argument is local 1. At some point in the future we should
141 change the fp to point to the procedure and not to local 1.
147 /* The VM has three state bits: the instruction pointer (IP), the frame
148 pointer (FP), and the top-of-stack pointer (SP). We cache the first
149 two of these in machine registers, local to the VM, because they are
150 used extensively by the VM. As the SP is used more by code outside
151 the VM than by the VM itself, we don't bother caching it locally.
153 Since the FP changes infrequently, relative to the IP, we keep vp->fp
154 in sync with the local FP. This would be a big lose for the IP,
155 though, so instead of updating vp->ip all the time, we call SYNC_IP
156 whenever we would need to know the IP of the top frame. In practice,
157 we need to SYNC_IP whenever we call out of the VM to a function that
158 would like to walk the stack, perhaps as the result of an
161 One more thing. We allow the stack to move, when it expands.
162 Therefore if you call out to a C procedure that could call Scheme
163 code, or otherwise push anything on the stack, you will need to
164 CACHE_FP afterwards to restore the possibly-changed FP. */
166 #define SYNC_IP() vp->ip = (ip)
168 #define CACHE_FP() fp = (vp->fp)
169 #define CACHE_REGISTER() \
177 /* After advancing vp->sp, but before writing any stack slots, check
178 that it is actually in bounds. If it is not in bounds, currently we
179 signal an error. In the future we may expand the stack instead,
180 possibly by moving it elsewhere, therefore no pointer into the stack
181 besides FP is valid across a CHECK_OVERFLOW call. Be careful! */
182 #define CHECK_OVERFLOW() \
184 if (SCM_UNLIKELY (vp->sp >= vp->stack_limit)) \
187 vm_expand_stack (vp); \
192 /* Reserve stack space for a frame. Will check that there is sufficient
193 stack space for N locals, including the procedure. Invoke after
194 preparing the new frame and setting the fp and ip. */
195 #define ALLOC_FRAME(n) \
197 vp->sp = LOCAL_ADDRESS (n - 1); \
201 /* Reset the current frame to hold N locals. Used when we know that no
202 stack expansion is needed. */
203 #define RESET_FRAME(n) \
205 vp->sp = LOCAL_ADDRESS (n - 1); \
208 /* Compute the number of locals in the frame. At a call, this is equal
209 to the number of actual arguments when a function is first called,
210 plus one for the function. */
211 #define FRAME_LOCALS_COUNT_FROM(slot) \
212 (vp->sp + 1 - LOCAL_ADDRESS (slot))
213 #define FRAME_LOCALS_COUNT() \
214 FRAME_LOCALS_COUNT_FROM (0)
216 /* Restore registers after returning from a frame. */
217 #define RESTORE_FRAME() \
222 #ifdef HAVE_LABELS_AS_VALUES
223 # define BEGIN_DISPATCH_SWITCH /* */
224 # define END_DISPATCH_SWITCH /* */
231 goto *jump_table[op & 0xff]; \
234 # define VM_DEFINE_OP(opcode, tag, name, meta) \
237 # define BEGIN_DISPATCH_SWITCH \
243 # define END_DISPATCH_SWITCH \
252 # define VM_DEFINE_OP(opcode, tag, name, meta) \
257 #define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
258 #define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
259 #define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
261 #define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
262 #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
263 #define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
265 #define RETURN_ONE_VALUE(ret) \
269 VM_HANDLE_INTERRUPTS; \
271 ip = SCM_FRAME_RETURN_ADDRESS (fp); \
272 fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
274 old_fp[-1] = SCM_BOOL_F; \
275 old_fp[-2] = SCM_BOOL_F; \
277 SCM_FRAME_LOCAL (old_fp, 1) = val; \
278 vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
279 POP_CONTINUATION_HOOK (old_fp); \
283 /* While we could generate the list-unrolling code here, it's fine for
284 now to just tail-call (apply values vals). */
285 #define RETURN_VALUE_LIST(vals_) \
288 VM_HANDLE_INTERRUPTS; \
289 fp[0] = vm_builtin_apply; \
290 fp[1] = vm_builtin_values; \
293 ip = (scm_t_uint32 *) vm_builtin_apply_code; \
294 goto op_tail_apply; \
297 #define BR_NARGS(rel) \
298 scm_t_uint32 expected; \
299 UNPACK_24 (op, expected); \
300 if (FRAME_LOCALS_COUNT() rel expected) \
302 scm_t_int32 offset = ip[1]; \
303 offset >>= 8; /* Sign-extending shift. */ \
308 #define BR_UNARY(x, exp) \
311 UNPACK_24 (op, test); \
312 x = LOCAL_REF (test); \
313 if ((ip[1] & 0x1) ? !(exp) : (exp)) \
315 scm_t_int32 offset = ip[1]; \
316 offset >>= 8; /* Sign-extending shift. */ \
318 VM_HANDLE_INTERRUPTS; \
323 #define BR_BINARY(x, y, exp) \
326 UNPACK_12_12 (op, a, b); \
329 if ((ip[1] & 0x1) ? !(exp) : (exp)) \
331 scm_t_int32 offset = ip[1]; \
332 offset >>= 8; /* Sign-extending shift. */ \
334 VM_HANDLE_INTERRUPTS; \
339 #define BR_ARITHMETIC(crel,srel) \
343 UNPACK_12_12 (op, a, b); \
346 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
348 scm_t_signed_bits x_bits = SCM_UNPACK (x); \
349 scm_t_signed_bits y_bits = SCM_UNPACK (y); \
350 if ((ip[1] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \
352 scm_t_int32 offset = ip[1]; \
353 offset >>= 8; /* Sign-extending shift. */ \
355 VM_HANDLE_INTERRUPTS; \
366 if ((ip[1] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \
368 scm_t_int32 offset = ip[1]; \
369 offset >>= 8; /* Sign-extending shift. */ \
371 VM_HANDLE_INTERRUPTS; \
379 scm_t_uint16 dst, src; \
381 UNPACK_12_12 (op, dst, src); \
383 #define ARGS2(a1, a2) \
384 scm_t_uint8 dst, src1, src2; \
386 UNPACK_8_8_8 (op, dst, src1, src2); \
387 a1 = LOCAL_REF (src1); \
388 a2 = LOCAL_REF (src2)
390 do { LOCAL_SET (dst, x); NEXT (1); } while (0)
391 #define RETURN_EXP(exp) \
392 do { SCM __x; SYNC_IP (); __x = exp; CACHE_FP (); RETURN (__x); } while (0)
394 /* The maximum/minimum tagged integers. */
396 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
398 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
400 ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
401 - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
403 #define BINARY_INTEGER_OP(CFUNC,SFUNC) \
406 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
408 scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \
409 if (SCM_FIXABLE (n)) \
410 RETURN (SCM_I_MAKINUM (n)); \
412 RETURN_EXP (SFUNC (x, y)); \
415 #define VM_VALIDATE_PAIR(x, proc) \
416 VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x))
418 #define VM_VALIDATE_STRUCT(obj, proc) \
419 VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
421 #define VM_VALIDATE_BYTEVECTOR(x, proc) \
422 VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x))
424 /* Return true (non-zero) if PTR has suitable alignment for TYPE. */
425 #define ALIGNED_P(ptr, type) \
426 ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
429 VM_NAME (scm_i_thread
*current_thread
, struct scm_vm
*vp
,
430 scm_i_jmp_buf
*registers
, int resume
)
432 /* Instruction pointer: A pointer to the opcode that is currently
434 register scm_t_uint32
*ip IP_REG
;
436 /* Frame pointer: A pointer into the stack, off of which we index
437 arguments and local variables. Pushed at function calls, popped on
439 register SCM
*fp FP_REG
;
441 /* Current opcode: A cache of *ip. */
442 register scm_t_uint32 op
;
444 #ifdef HAVE_LABELS_AS_VALUES
445 static const void *jump_table_
[256] = {
446 #define LABEL_ADDR(opcode, tag, name, meta) &&op_##tag,
447 FOR_EACH_VM_OPERATION(LABEL_ADDR
)
450 register const void **jump_table JT_REG
;
451 /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
452 load instruction at each instruction dispatch. */
453 jump_table
= jump_table_
;
456 /* Load VM registers. */
459 VM_HANDLE_INTERRUPTS
;
461 /* Usually a call to the VM happens on application, with the boot
462 continuation on the next frame. Sometimes it happens after a
463 non-local exit however; in that case the VM state is all set up,
464 and we have but to jump to the next opcode. */
465 if (SCM_UNLIKELY (resume
))
469 while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp
)))
471 SCM proc
= SCM_FRAME_PROGRAM (fp
);
473 if (SCM_STRUCTP (proc
) && SCM_STRUCT_APPLICABLE_P (proc
))
475 LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc
));
478 if (SCM_HAS_TYP7 (proc
, scm_tc7_smob
) && SCM_SMOB_APPLICABLE_P (proc
))
480 scm_t_uint32 n
= FRAME_LOCALS_COUNT();
482 /* Shuffle args up. */
485 LOCAL_SET (n
+ 1, LOCAL_REF (n
));
487 LOCAL_SET (0, SCM_SMOB_DESCRIPTOR (proc
).apply_trampoline
);
492 vm_error_wrong_type_apply (proc
);
496 ip
= SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp
));
499 BEGIN_DISPATCH_SWITCH
;
510 * Bring the VM to a halt, returning all the values from the stack.
512 VM_DEFINE_OP (0, halt
, "halt", OP1 (U8_X24
))
514 /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
516 scm_t_uint32 nvals
= FRAME_LOCALS_COUNT_FROM (4);
525 for (n
= nvals
; n
> 0; n
--)
526 ret
= scm_cons (LOCAL_REF (4 + n
- 1), ret
);
527 ret
= scm_values (ret
);
530 vp
->ip
= SCM_FRAME_RETURN_ADDRESS (fp
);
531 vp
->sp
= SCM_FRAME_PREVIOUS_SP (fp
);
532 vp
->fp
= SCM_FRAME_DYNAMIC_LINK (fp
);
537 /* call proc:24 _:8 nlocals:24
539 * Call a procedure. PROC is the local corresponding to a procedure.
540 * The two values below PROC will be overwritten by the saved call
541 * frame data. The new frame will have space for NLOCALS locals: one
542 * for the procedure, and the rest for the arguments which should
543 * already have been pushed on.
545 * When the call returns, execution proceeds with the next
546 * instruction. There may be any number of values on the return
547 * stack; the precise number can be had by subtracting the address of
548 * PROC from the post-call SP.
550 VM_DEFINE_OP (1, call
, "call", OP2 (U8_U24
, X8_U24
))
552 scm_t_uint32 proc
, nlocals
;
555 UNPACK_24 (op
, proc
);
556 UNPACK_24 (ip
[1], nlocals
);
558 VM_HANDLE_INTERRUPTS
;
561 fp
= vp
->fp
= old_fp
+ proc
;
562 SCM_FRAME_SET_DYNAMIC_LINK (fp
, old_fp
);
563 SCM_FRAME_SET_RETURN_ADDRESS (fp
, ip
+ 2);
565 RESET_FRAME (nlocals
);
567 PUSH_CONTINUATION_HOOK ();
570 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp
))))
573 ip
= SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp
));
577 /* tail-call nlocals:24
579 * Tail-call a procedure. Requires that the procedure and all of the
580 * arguments have already been shuffled into position. Will reset the
583 VM_DEFINE_OP (2, tail_call
, "tail-call", OP1 (U8_U24
))
585 scm_t_uint32 nlocals
;
587 UNPACK_24 (op
, nlocals
);
589 VM_HANDLE_INTERRUPTS
;
591 RESET_FRAME (nlocals
);
595 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp
))))
598 ip
= SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp
));
602 /* tail-call/shuffle from:24
604 * Tail-call a procedure. The procedure should already be set to slot
605 * 0. The rest of the args are taken from the frame, starting at
606 * FROM, shuffled down to start at slot 0. This is part of the
607 * implementation of the call-with-values builtin.
609 VM_DEFINE_OP (3, tail_call_shuffle
, "tail-call/shuffle", OP1 (U8_U24
))
611 scm_t_uint32 n
, from
, nlocals
;
613 UNPACK_24 (op
, from
);
615 VM_HANDLE_INTERRUPTS
;
617 VM_ASSERT (from
> 0, abort ());
618 nlocals
= FRAME_LOCALS_COUNT ();
620 for (n
= 0; from
+ n
< nlocals
; n
++)
621 LOCAL_SET (n
+ 1, LOCAL_REF (from
+ n
));
627 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp
))))
630 ip
= SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp
));
634 /* receive dst:12 proc:12 _:8 nlocals:24
636 * Receive a single return value from a call whose procedure was in
637 * PROC, asserting that the call actually returned at least one
638 * value. Afterwards, resets the frame to NLOCALS locals.
640 VM_DEFINE_OP (4, receive
, "receive", OP2 (U8_U12_U12
, X8_U24
) | OP_DST
)
642 scm_t_uint16 dst
, proc
;
643 scm_t_uint32 nlocals
;
644 UNPACK_12_12 (op
, dst
, proc
);
645 UNPACK_24 (ip
[1], nlocals
);
646 VM_ASSERT (FRAME_LOCALS_COUNT () > proc
+ 1, vm_error_no_values ());
647 LOCAL_SET (dst
, LOCAL_REF (proc
+ 1));
648 RESET_FRAME (nlocals
);
652 /* receive-values proc:24 allow-extra?:1 _:7 nvalues:24
654 * Receive a return of multiple values from a call whose procedure was
655 * in PROC. If fewer than NVALUES values were returned, signal an
656 * error. Unless ALLOW-EXTRA? is true, require that the number of
657 * return values equals NVALUES exactly. After receive-values has
658 * run, the values can be copied down via `mov'.
660 VM_DEFINE_OP (5, receive_values
, "receive-values", OP2 (U8_U24
, B1_X7_U24
))
662 scm_t_uint32 proc
, nvalues
;
663 UNPACK_24 (op
, proc
);
664 UNPACK_24 (ip
[1], nvalues
);
666 VM_ASSERT (FRAME_LOCALS_COUNT () > proc
+ nvalues
,
667 vm_error_not_enough_values ());
669 VM_ASSERT (FRAME_LOCALS_COUNT () == proc
+ 1 + nvalues
,
670 vm_error_wrong_number_of_values (nvalues
));
678 VM_DEFINE_OP (6, return, "return", OP1 (U8_U24
))
682 RETURN_ONE_VALUE (LOCAL_REF (src
));
685 /* return-values _:24
687 * Return a number of values from a call frame. This opcode
688 * corresponds to an application of `values' in tail position. As
689 * with tail calls, we expect that the values have already been
690 * shuffled down to a contiguous array starting at slot 1.
691 * We also expect the frame has already been reset.
693 VM_DEFINE_OP (7, return_values
, "return-values", OP1 (U8_X24
))
697 VM_HANDLE_INTERRUPTS
;
700 ip
= SCM_FRAME_RETURN_ADDRESS (fp
);
701 fp
= vp
->fp
= SCM_FRAME_DYNAMIC_LINK (fp
);
703 /* Clear stack frame. */
704 old_fp
[-1] = SCM_BOOL_F
;
705 old_fp
[-2] = SCM_BOOL_F
;
707 POP_CONTINUATION_HOOK (old_fp
);
716 * Specialized call stubs
719 /* subr-call ptr-idx:24
721 * Call a subr, passing all locals in this frame as arguments. Fetch
722 * the foreign pointer from PTR-IDX, a free variable. Return from the
723 * calling frame. This instruction is part of the trampolines
724 * created in gsubr.c, and is not generated by the compiler.
726 VM_DEFINE_OP (8, subr_call
, "subr-call", OP1 (U8_U24
))
728 scm_t_uint32 ptr_idx
;
732 UNPACK_24 (op
, ptr_idx
);
734 pointer
= SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx
);
735 subr
= SCM_POINTER_VALUE (pointer
);
737 VM_HANDLE_INTERRUPTS
;
740 switch (FRAME_LOCALS_COUNT_FROM (1))
749 ret
= subr (fp
[1], fp
[2]);
752 ret
= subr (fp
[1], fp
[2], fp
[3]);
755 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4]);
758 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4], fp
[5]);
761 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4], fp
[5], fp
[6]);
764 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4], fp
[5], fp
[6], fp
[7]);
767 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4], fp
[5], fp
[6], fp
[7], fp
[8]);
770 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4], fp
[5], fp
[6], fp
[7], fp
[8], fp
[9]);
773 ret
= subr (fp
[1], fp
[2], fp
[3], fp
[4], fp
[5], fp
[6], fp
[7], fp
[8], fp
[9], fp
[10]);
781 if (SCM_UNLIKELY (SCM_VALUESP (ret
)))
782 /* multiple values returned to continuation */
783 RETURN_VALUE_LIST (scm_struct_ref (ret
, SCM_INUM0
));
785 RETURN_ONE_VALUE (ret
);
788 /* foreign-call cif-idx:12 ptr-idx:12
790 * Call a foreign function. Fetch the CIF and foreign pointer from
791 * CIF-IDX and PTR-IDX, both free variables. Return from the calling
792 * frame. Arguments are taken from the stack. This instruction is
793 * part of the trampolines created by the FFI, and is not generated by
796 VM_DEFINE_OP (9, foreign_call
, "foreign-call", OP1 (U8_U12_U12
))
798 scm_t_uint16 cif_idx
, ptr_idx
;
799 SCM closure
, cif
, pointer
, ret
;
801 UNPACK_12_12 (op
, cif_idx
, ptr_idx
);
803 closure
= LOCAL_REF (0);
804 cif
= SCM_PROGRAM_FREE_VARIABLE_REF (closure
, cif_idx
);
805 pointer
= SCM_PROGRAM_FREE_VARIABLE_REF (closure
, ptr_idx
);
808 VM_HANDLE_INTERRUPTS
;
810 // FIXME: separate args
811 ret
= scm_i_foreign_call (scm_cons (cif
, pointer
), LOCAL_ADDRESS (1));
815 if (SCM_UNLIKELY (SCM_VALUESP (ret
)))
816 /* multiple values returned to continuation */
817 RETURN_VALUE_LIST (scm_struct_ref (ret
, SCM_INUM0
));
819 RETURN_ONE_VALUE (ret
);
822 /* continuation-call contregs:24
824 * Return to a continuation, nonlocally. The arguments to the
825 * continuation are taken from the stack. CONTREGS is a free variable
826 * containing the reified continuation. This instruction is part of
827 * the implementation of undelimited continuations, and is not
828 * generated by the compiler.
830 VM_DEFINE_OP (10, continuation_call
, "continuation-call", OP1 (U8_U24
))
833 scm_t_uint32 contregs_idx
;
835 UNPACK_24 (op
, contregs_idx
);
838 SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx
);
841 scm_i_check_continuation (contregs
);
842 vm_return_to_continuation (scm_i_contregs_vp (contregs
),
843 scm_i_contregs_vm_cont (contregs
),
844 FRAME_LOCALS_COUNT_FROM (1),
846 scm_i_reinstate_continuation (contregs
);
852 /* compose-continuation cont:24
854 * Compose a partial continution with the current continuation. The
855 * arguments to the continuation are taken from the stack. CONT is a
856 * free variable containing the reified continuation. This
857 * instruction is part of the implementation of partial continuations,
858 * and is not generated by the compiler.
860 VM_DEFINE_OP (11, compose_continuation
, "compose-continuation", OP1 (U8_U24
))
863 scm_t_uint32 cont_idx
;
865 UNPACK_24 (op
, cont_idx
);
866 vmcont
= SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx
);
869 VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont
),
870 vm_error_continuation_not_rewindable (vmcont
));
871 vm_reinstate_partial_continuation (vp
, vmcont
, FRAME_LOCALS_COUNT_FROM (1),
873 ¤t_thread
->dynstack
,
881 * Tail-apply the procedure in local slot 0 to the rest of the
882 * arguments. This instruction is part of the implementation of
883 * `apply', and is not generated by the compiler.
885 VM_DEFINE_OP (12, tail_apply
, "tail-apply", OP1 (U8_X24
))
887 int i
, list_idx
, list_len
, nlocals
;
890 VM_HANDLE_INTERRUPTS
;
892 nlocals
= FRAME_LOCALS_COUNT ();
893 // At a minimum, there should be apply, f, and the list.
894 VM_ASSERT (nlocals
>= 3, abort ());
895 list_idx
= nlocals
- 1;
896 list
= LOCAL_REF (list_idx
);
897 list_len
= scm_ilength (list
);
899 VM_ASSERT (list_len
>= 0, vm_error_apply_to_non_list (list
));
901 nlocals
= nlocals
- 2 + list_len
;
902 ALLOC_FRAME (nlocals
);
904 for (i
= 1; i
< list_idx
; i
++)
905 LOCAL_SET (i
- 1, LOCAL_REF (i
));
907 /* Null out these slots, just in case there are less than 2 elements
909 LOCAL_SET (list_idx
- 1, SCM_UNDEFINED
);
910 LOCAL_SET (list_idx
, SCM_UNDEFINED
);
912 for (i
= 0; i
< list_len
; i
++, list
= SCM_CDR (list
))
913 LOCAL_SET (list_idx
- 1 + i
, SCM_CAR (list
));
917 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp
))))
920 ip
= SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp
));
926 * Capture the current continuation, and tail-apply the procedure in
927 * local slot 1 to it. This instruction is part of the implementation
928 * of `call/cc', and is not generated by the compiler.
930 VM_DEFINE_OP (13, call_cc
, "call/cc", OP1 (U8_X24
))
933 scm_t_dynstack
*dynstack
;
936 VM_HANDLE_INTERRUPTS
;
939 dynstack
= scm_dynstack_capture_all (¤t_thread
->dynstack
);
940 vm_cont
= scm_i_vm_capture_stack (vp
->stack_base
,
941 SCM_FRAME_DYNAMIC_LINK (fp
),
942 SCM_FRAME_PREVIOUS_SP (fp
),
943 SCM_FRAME_RETURN_ADDRESS (fp
),
946 /* FIXME: Seems silly to capture the registers here, when they are
947 already captured in the registers local, which here we are
948 copying out to the heap; and likewise, the setjmp(®isters)
949 code already has the non-local return handler. But oh
951 cont
= scm_i_make_continuation (&first
, vp
, vm_cont
);
955 LOCAL_SET (0, LOCAL_REF (1));
961 if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp
))))
964 ip
= SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp
));
970 ABORT_CONTINUATION_HOOK ();
977 * Abort to a prompt handler. The tag is expected in r1, and the rest
978 * of the values in the frame are returned to the prompt handler.
979 * This corresponds to a tail application of abort-to-prompt.
981 VM_DEFINE_OP (14, abort
, "abort", OP1 (U8_X24
))
983 scm_t_uint32 nlocals
= FRAME_LOCALS_COUNT ();
985 ASSERT (nlocals
>= 2);
986 /* FIXME: Really we should capture the caller's registers. Until
987 then, manually advance the IP so that when the prompt resumes,
988 it continues with the next instruction. */
991 vm_abort (vp
, LOCAL_REF (1), nlocals
- 2, LOCAL_ADDRESS (2),
992 SCM_EOL
, LOCAL_ADDRESS (0), registers
);
994 /* vm_abort should not return */
998 /* builtin-ref dst:12 idx:12
1000 * Load a builtin stub by index into DST.
1002 VM_DEFINE_OP (15, builtin_ref
, "builtin-ref", OP1 (U8_U12_U12
) | OP_DST
)
1004 scm_t_uint16 dst
, idx
;
1006 UNPACK_12_12 (op
, dst
, idx
);
1007 LOCAL_SET (dst
, scm_vm_builtin_ref (idx
));
1016 * Function prologues
1019 /* br-if-nargs-ne expected:24 _:8 offset:24
1020 * br-if-nargs-lt expected:24 _:8 offset:24
1021 * br-if-nargs-gt expected:24 _:8 offset:24
1023 * If the number of actual arguments is not equal, less than, or greater
1024 * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
1025 * the current instruction pointer.
1027 VM_DEFINE_OP (16, br_if_nargs_ne
, "br-if-nargs-ne", OP2 (U8_U24
, X8_L24
))
1031 VM_DEFINE_OP (17, br_if_nargs_lt
, "br-if-nargs-lt", OP2 (U8_U24
, X8_L24
))
1035 VM_DEFINE_OP (18, br_if_nargs_gt
, "br-if-nargs-gt", OP2 (U8_U24
, X8_L24
))
1040 /* assert-nargs-ee expected:24
1041 * assert-nargs-ge expected:24
1042 * assert-nargs-le expected:24
1044 * If the number of actual arguments is not ==, >=, or <= EXPECTED,
1045 * respectively, signal an error.
1047 VM_DEFINE_OP (19, assert_nargs_ee
, "assert-nargs-ee", OP1 (U8_U24
))
1049 scm_t_uint32 expected
;
1050 UNPACK_24 (op
, expected
);
1051 VM_ASSERT (FRAME_LOCALS_COUNT () == expected
,
1052 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp
)));
1055 VM_DEFINE_OP (20, assert_nargs_ge
, "assert-nargs-ge", OP1 (U8_U24
))
1057 scm_t_uint32 expected
;
1058 UNPACK_24 (op
, expected
);
1059 VM_ASSERT (FRAME_LOCALS_COUNT () >= expected
,
1060 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp
)));
1063 VM_DEFINE_OP (21, assert_nargs_le
, "assert-nargs-le", OP1 (U8_U24
))
1065 scm_t_uint32 expected
;
1066 UNPACK_24 (op
, expected
);
1067 VM_ASSERT (FRAME_LOCALS_COUNT () <= expected
,
1068 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp
)));
1072 /* alloc-frame nlocals:24
1074 * Ensure that there is space on the stack for NLOCALS local variables,
1075 * setting them all to SCM_UNDEFINED, except those nargs values that
1076 * were passed as arguments and procedure.
1078 VM_DEFINE_OP (22, alloc_frame
, "alloc-frame", OP1 (U8_U24
))
1080 scm_t_uint32 nlocals
, nargs
;
1081 UNPACK_24 (op
, nlocals
);
1083 nargs
= FRAME_LOCALS_COUNT ();
1084 ALLOC_FRAME (nlocals
);
1085 while (nlocals
-- > nargs
)
1086 LOCAL_SET (nlocals
, SCM_UNDEFINED
);
1091 /* reset-frame nlocals:24
1093 * Like alloc-frame, but doesn't check that the stack is big enough.
1094 * Used to reset the frame size to something less than the size that
1095 * was previously set via alloc-frame.
1097 VM_DEFINE_OP (23, reset_frame
, "reset-frame", OP1 (U8_U24
))
1099 scm_t_uint32 nlocals
;
1100 UNPACK_24 (op
, nlocals
);
1101 RESET_FRAME (nlocals
);
1105 /* assert-nargs-ee/locals expected:12 nlocals:12
1107 * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
1108 * number of locals reserved is EXPECTED + NLOCALS.
1110 VM_DEFINE_OP (24, assert_nargs_ee_locals
, "assert-nargs-ee/locals", OP1 (U8_U12_U12
))
1112 scm_t_uint16 expected
, nlocals
;
1113 UNPACK_12_12 (op
, expected
, nlocals
);
1114 VM_ASSERT (FRAME_LOCALS_COUNT () == expected
,
1115 vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp
)));
1116 ALLOC_FRAME (expected
+ nlocals
);
1118 LOCAL_SET (expected
+ nlocals
, SCM_UNDEFINED
);
1123 /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
1125 * Find the first positional argument after NREQ. If it is greater
1126 * than NPOS, jump to OFFSET.
1128 * This instruction is only emitted for functions with multiple
1129 * clauses, and an earlier clause has keywords and no rest arguments.
1130 * See "Case-lambda" in the manual, for more on how case-lambda
1131 * chooses the clause to apply.
1133 VM_DEFINE_OP (25, br_if_npos_gt
, "br-if-npos-gt", OP3 (U8_U24
, X8_U24
, X8_L24
))
1135 scm_t_uint32 nreq
, npos
;
1137 UNPACK_24 (op
, nreq
);
1138 UNPACK_24 (ip
[1], npos
);
1140 /* We can only have too many positionals if there are more
1141 arguments than NPOS. */
1142 if (FRAME_LOCALS_COUNT() > npos
)
1145 for (n
= nreq
; n
< npos
; n
++)
1146 if (scm_is_keyword (LOCAL_REF (n
)))
1148 if (n
== npos
&& !scm_is_keyword (LOCAL_REF (n
)))
1150 scm_t_int32 offset
= ip
[2];
1151 offset
>>= 8; /* Sign-extending shift. */
1158 /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
1160 * flags := allow-other-keys:1 has-rest:1 _:6
1162 * Find the last positional argument, and shuffle all the rest above
1163 * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then
1164 * load the constant at KW-OFFSET words from the current IP, and use it
1165 * to bind keyword arguments. If HAS-REST, collect all shuffled
1166 * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear
1167 * the arguments that we shuffled up.
1169 * A macro-mega-instruction.
1171 VM_DEFINE_OP (26, bind_kwargs
, "bind-kwargs", OP4 (U8_U24
, U8_U24
, X8_U24
, N32
))
1173 scm_t_uint32 nreq
, nreq_and_opt
, ntotal
, npositional
, nkw
, n
, nargs
;
1174 scm_t_int32 kw_offset
;
1177 char allow_other_keys
, has_rest
;
1179 UNPACK_24 (op
, nreq
);
1180 allow_other_keys
= ip
[1] & 0x1;
1181 has_rest
= ip
[1] & 0x2;
1182 UNPACK_24 (ip
[1], nreq_and_opt
);
1183 UNPACK_24 (ip
[2], ntotal
);
1185 kw_bits
= (scm_t_bits
) (ip
+ kw_offset
);
1186 VM_ASSERT (!(kw_bits
& 0x7), abort());
1187 kw
= SCM_PACK (kw_bits
);
1189 nargs
= FRAME_LOCALS_COUNT ();
1191 /* look in optionals for first keyword or last positional */
1192 /* starting after the last required positional arg */
1194 while (/* while we have args */
1196 /* and we still have positionals to fill */
1197 && npositional
< nreq_and_opt
1198 /* and we haven't reached a keyword yet */
1199 && !scm_is_keyword (LOCAL_REF (npositional
)))
1200 /* bind this optional arg (by leaving it in place) */
1202 nkw
= nargs
- npositional
;
1203 /* shuffle non-positional arguments above ntotal */
1204 ALLOC_FRAME (ntotal
+ nkw
);
1207 LOCAL_SET (ntotal
+ n
, LOCAL_REF (npositional
+ n
));
1208 /* and fill optionals & keyword args with SCM_UNDEFINED */
1211 LOCAL_SET (n
++, SCM_UNDEFINED
);
1213 VM_ASSERT (has_rest
|| (nkw
% 2) == 0,
1214 vm_error_kwargs_length_not_even (SCM_FRAME_PROGRAM (fp
)));
1216 /* Now bind keywords, in the order given. */
1217 for (n
= 0; n
< nkw
; n
++)
1218 if (scm_is_keyword (LOCAL_REF (ntotal
+ n
)))
1221 for (walk
= kw
; scm_is_pair (walk
); walk
= SCM_CDR (walk
))
1222 if (scm_is_eq (SCM_CAAR (walk
), LOCAL_REF (ntotal
+ n
)))
1224 SCM si
= SCM_CDAR (walk
);
1225 LOCAL_SET (SCM_I_INUMP (si
) ? SCM_I_INUM (si
) : scm_to_uint32 (si
),
1226 LOCAL_REF (ntotal
+ n
+ 1));
1229 VM_ASSERT (scm_is_pair (walk
) || allow_other_keys
,
1230 vm_error_kwargs_unrecognized_keyword (SCM_FRAME_PROGRAM (fp
),
1231 LOCAL_REF (ntotal
+ n
)));
1235 VM_ASSERT (has_rest
, vm_error_kwargs_invalid_keyword (SCM_FRAME_PROGRAM (fp
),
1236 LOCAL_REF (ntotal
+ n
)));
1243 rest
= scm_cons (LOCAL_REF (ntotal
+ n
), rest
);
1244 LOCAL_SET (nreq_and_opt
, rest
);
1247 RESET_FRAME (ntotal
);
1254 * Collect any arguments at or above DST into a list, and store that
1257 VM_DEFINE_OP (27, bind_rest
, "bind-rest", OP1 (U8_U24
) | OP_DST
)
1259 scm_t_uint32 dst
, nargs
;
1262 UNPACK_24 (op
, dst
);
1263 nargs
= FRAME_LOCALS_COUNT ();
1267 ALLOC_FRAME (dst
+ 1);
1269 LOCAL_SET (nargs
++, SCM_UNDEFINED
);
1273 while (nargs
-- > dst
)
1275 rest
= scm_cons (LOCAL_REF (nargs
), rest
);
1276 LOCAL_SET (nargs
, SCM_UNDEFINED
);
1279 RESET_FRAME (dst
+ 1);
1282 LOCAL_SET (dst
, rest
);
1291 * Branching instructions
1296 * Add OFFSET, a signed 24-bit number, to the current instruction
1299 VM_DEFINE_OP (28, br
, "br", OP1 (U8_L24
))
1301 scm_t_int32 offset
= op
;
1302 offset
>>= 8; /* Sign-extending shift. */
1306 /* br-if-true test:24 invert:1 _:7 offset:24
1308 * If the value in TEST is true for the purposes of Scheme, add
1309 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1311 VM_DEFINE_OP (29, br_if_true
, "br-if-true", OP2 (U8_U24
, B1_X7_L24
))
1313 BR_UNARY (x
, scm_is_true (x
));
1316 /* br-if-null test:24 invert:1 _:7 offset:24
1318 * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
1319 * signed 24-bit number, to the current instruction pointer.
1321 VM_DEFINE_OP (30, br_if_null
, "br-if-null", OP2 (U8_U24
, B1_X7_L24
))
1323 BR_UNARY (x
, scm_is_null (x
));
1326 /* br-if-nil test:24 invert:1 _:7 offset:24
1328 * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
1329 * number, to the current instruction pointer.
1331 VM_DEFINE_OP (31, br_if_nil
, "br-if-nil", OP2 (U8_U24
, B1_X7_L24
))
1333 BR_UNARY (x
, scm_is_lisp_false (x
));
1336 /* br-if-pair test:24 invert:1 _:7 offset:24
1338 * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
1339 * to the current instruction pointer.
1341 VM_DEFINE_OP (32, br_if_pair
, "br-if-pair", OP2 (U8_U24
, B1_X7_L24
))
1343 BR_UNARY (x
, scm_is_pair (x
));
1346 /* br-if-struct test:24 invert:1 _:7 offset:24
1348 * If the value in TEST is a struct, add OFFSET, a signed 24-bit
1349 * number, to the current instruction pointer.
1351 VM_DEFINE_OP (33, br_if_struct
, "br-if-struct", OP2 (U8_U24
, B1_X7_L24
))
1353 BR_UNARY (x
, SCM_STRUCTP (x
));
1356 /* br-if-char test:24 invert:1 _:7 offset:24
1358 * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
1359 * to the current instruction pointer.
1361 VM_DEFINE_OP (34, br_if_char
, "br-if-char", OP2 (U8_U24
, B1_X7_L24
))
1363 BR_UNARY (x
, SCM_CHARP (x
));
1366 /* br-if-tc7 test:24 invert:1 tc7:7 offset:24
1368 * If the value in TEST has the TC7 given in the second word, add
1369 * OFFSET, a signed 24-bit number, to the current instruction pointer.
1371 VM_DEFINE_OP (35, br_if_tc7
, "br-if-tc7", OP2 (U8_U24
, B1_U7_L24
))
1373 BR_UNARY (x
, SCM_HAS_TYP7 (x
, (ip
[1] >> 1) & 0x7f));
1376 /* br-if-eq a:12 b:12 invert:1 _:7 offset:24
1378 * If the value in A is eq? to the value in B, add OFFSET, a signed
1379 * 24-bit number, to the current instruction pointer.
1381 VM_DEFINE_OP (36, br_if_eq
, "br-if-eq", OP2 (U8_U12_U12
, B1_X7_L24
))
1383 BR_BINARY (x
, y
, scm_is_eq (x
, y
));
1386 /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24
1388 * If the value in A is eqv? to the value in B, add OFFSET, a signed
1389 * 24-bit number, to the current instruction pointer.
1391 VM_DEFINE_OP (37, br_if_eqv
, "br-if-eqv", OP2 (U8_U12_U12
, B1_X7_L24
))
1395 || (SCM_NIMP (x
) && SCM_NIMP (y
)
1396 && scm_is_true (scm_eqv_p (x
, y
))));
1399 // FIXME: remove, have compiler inline eqv test instead
1400 /* br-if-equal a:12 b:12 invert:1 _:7 offset:24
1402 * If the value in A is equal? to the value in B, add OFFSET, a signed
1403 * 24-bit number, to the current instruction pointer.
1405 // FIXME: Should sync_ip before calling out and cache_fp before coming
1406 // back! Another reason to remove this opcode!
1407 VM_DEFINE_OP (38, br_if_equal
, "br-if-equal", OP2 (U8_U12_U12
, B1_X7_L24
))
1411 || (SCM_NIMP (x
) && SCM_NIMP (y
)
1412 && scm_is_true (scm_equal_p (x
, y
))));
1415 /* br-if-= a:12 b:12 invert:1 _:7 offset:24
1417 * If the value in A is = to the value in B, add OFFSET, a signed
1418 * 24-bit number, to the current instruction pointer.
1420 VM_DEFINE_OP (39, br_if_ee
, "br-if-=", OP2 (U8_U12_U12
, B1_X7_L24
))
1422 BR_ARITHMETIC (==, scm_num_eq_p
);
1425 /* br-if-< a:12 b:12 invert:1 _:7 offset:24
1427 * If the value in A is < to the value in B, add OFFSET, a signed
1428 * 24-bit number, to the current instruction pointer.
1430 VM_DEFINE_OP (40, br_if_lt
, "br-if-<", OP2 (U8_U12_U12
, B1_X7_L24
))
1432 BR_ARITHMETIC (<, scm_less_p
);
1435 /* br-if-<= a:12 b:12 invert:1 _:7 offset:24
1437 * If the value in A is <= to the value in B, add OFFSET, a signed
1438 * 24-bit number, to the current instruction pointer.
1440 VM_DEFINE_OP (41, br_if_le
, "br-if-<=", OP2 (U8_U12_U12
, B1_X7_L24
))
1442 BR_ARITHMETIC (<=, scm_leq_p
);
1449 * Lexical binding instructions
1452 /* mov dst:12 src:12
1454 * Copy a value from one local slot to another.
1456 VM_DEFINE_OP (42, mov
, "mov", OP1 (U8_U12_U12
) | OP_DST
)
1461 UNPACK_12_12 (op
, dst
, src
);
1462 LOCAL_SET (dst
, LOCAL_REF (src
));
1467 /* long-mov dst:24 _:8 src:24
1469 * Copy a value from one local slot to another.
1471 VM_DEFINE_OP (43, long_mov
, "long-mov", OP2 (U8_U24
, X8_U24
) | OP_DST
)
1476 UNPACK_24 (op
, dst
);
1477 UNPACK_24 (ip
[1], src
);
1478 LOCAL_SET (dst
, LOCAL_REF (src
));
1483 /* box dst:12 src:12
1485 * Create a new variable holding SRC, and place it in DST.
1487 VM_DEFINE_OP (44, box
, "box", OP1 (U8_U12_U12
) | OP_DST
)
1489 scm_t_uint16 dst
, src
;
1490 UNPACK_12_12 (op
, dst
, src
);
1491 LOCAL_SET (dst
, scm_cell (scm_tc7_variable
, SCM_UNPACK (LOCAL_REF (src
))));
1495 /* box-ref dst:12 src:12
1497 * Unpack the variable at SRC into DST, asserting that the variable is
1500 VM_DEFINE_OP (45, box_ref
, "box-ref", OP1 (U8_U12_U12
) | OP_DST
)
1502 scm_t_uint16 dst
, src
;
1504 UNPACK_12_12 (op
, dst
, src
);
1505 var
= LOCAL_REF (src
);
1506 VM_ASSERT (SCM_VARIABLEP (var
),
1507 vm_error_not_a_variable ("variable-ref", var
));
1508 VM_ASSERT (VARIABLE_BOUNDP (var
),
1509 vm_error_unbound (SCM_FRAME_PROGRAM (fp
), var
));
1510 LOCAL_SET (dst
, VARIABLE_REF (var
));
1514 /* box-set! dst:12 src:12
1516 * Set the contents of the variable at DST to SET.
1518 VM_DEFINE_OP (46, box_set
, "box-set!", OP1 (U8_U12_U12
))
1520 scm_t_uint16 dst
, src
;
1522 UNPACK_12_12 (op
, dst
, src
);
1523 var
= LOCAL_REF (dst
);
1524 VM_ASSERT (SCM_VARIABLEP (var
),
1525 vm_error_not_a_variable ("variable-set!", var
));
1526 VARIABLE_SET (var
, LOCAL_REF (src
));
1530 /* make-closure dst:24 offset:32 _:8 nfree:24
1532 * Make a new closure, and write it to DST. The code for the closure
1533 * will be found at OFFSET words from the current IP. OFFSET is a
1534 * signed 32-bit integer. Space for NFREE free variables will be
1537 VM_DEFINE_OP (47, make_closure
, "make-closure", OP3 (U8_U24
, L32
, X8_U24
) | OP_DST
)
1539 scm_t_uint32 dst
, nfree
, n
;
1543 UNPACK_24 (op
, dst
);
1545 UNPACK_24 (ip
[2], nfree
);
1547 // FIXME: Assert range of nfree?
1548 closure
= scm_words (scm_tc7_program
| (nfree
<< 16), nfree
+ 2);
1549 SCM_SET_CELL_WORD_1 (closure
, ip
+ offset
);
1550 // FIXME: Elide these initializations?
1551 for (n
= 0; n
< nfree
; n
++)
1552 SCM_PROGRAM_FREE_VARIABLE_SET (closure
, n
, SCM_BOOL_F
);
1553 LOCAL_SET (dst
, closure
);
1557 /* free-ref dst:12 src:12 _:8 idx:24
1559 * Load free variable IDX from the closure SRC into local slot DST.
1561 VM_DEFINE_OP (48, free_ref
, "free-ref", OP2 (U8_U12_U12
, X8_U24
) | OP_DST
)
1563 scm_t_uint16 dst
, src
;
1565 UNPACK_12_12 (op
, dst
, src
);
1566 UNPACK_24 (ip
[1], idx
);
1567 /* CHECK_FREE_VARIABLE (src); */
1568 LOCAL_SET (dst
, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src
), idx
));
1572 /* free-set! dst:12 src:12 _:8 idx:24
1574 * Set free variable IDX from the closure DST to SRC.
1576 VM_DEFINE_OP (49, free_set
, "free-set!", OP2 (U8_U12_U12
, X8_U24
))
1578 scm_t_uint16 dst
, src
;
1580 UNPACK_12_12 (op
, dst
, src
);
1581 UNPACK_24 (ip
[1], idx
);
1582 /* CHECK_FREE_VARIABLE (src); */
1583 SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst
), idx
, LOCAL_REF (src
));
1591 * Immediates and statically allocated non-immediates
1594 /* make-short-immediate dst:8 low-bits:16
1596 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1599 VM_DEFINE_OP (50, make_short_immediate
, "make-short-immediate", OP1 (U8_U8_I16
) | OP_DST
)
1604 UNPACK_8_16 (op
, dst
, val
);
1605 LOCAL_SET (dst
, SCM_PACK (val
));
1609 /* make-long-immediate dst:24 low-bits:32
1611 * Make an immediate whose low bits are LOW-BITS, and whose top bits are
1614 VM_DEFINE_OP (51, make_long_immediate
, "make-long-immediate", OP2 (U8_U24
, I32
))
1619 UNPACK_24 (op
, dst
);
1621 LOCAL_SET (dst
, SCM_PACK (val
));
1625 /* make-long-long-immediate dst:24 high-bits:32 low-bits:32
1627 * Make an immediate with HIGH-BITS and LOW-BITS.
1629 VM_DEFINE_OP (52, make_long_long_immediate
, "make-long-long-immediate", OP3 (U8_U24
, A32
, B32
) | OP_DST
)
1634 UNPACK_24 (op
, dst
);
1635 #if SIZEOF_SCM_T_BITS > 4
1640 ASSERT (ip
[1] == 0);
1643 LOCAL_SET (dst
, SCM_PACK (val
));
1647 /* make-non-immediate dst:24 offset:32
1649 * Load a pointer to statically allocated memory into DST. The
1650 * object's memory is will be found OFFSET 32-bit words away from the
1651 * current instruction pointer. OFFSET is a signed value. The
1652 * intention here is that the compiler would produce an object file
1653 * containing the words of a non-immediate object, and this
1654 * instruction creates a pointer to that memory, effectively
1655 * resurrecting that object.
1657 * Whether the object is mutable or immutable depends on where it was
1658 * allocated by the compiler, and loaded by the loader.
1660 VM_DEFINE_OP (53, make_non_immediate
, "make-non-immediate", OP2 (U8_U24
, N32
) | OP_DST
)
1665 scm_t_bits unpacked
;
1667 UNPACK_24 (op
, dst
);
1670 unpacked
= (scm_t_bits
) loc
;
1672 VM_ASSERT (!(unpacked
& 0x7), abort());
1674 LOCAL_SET (dst
, SCM_PACK (unpacked
));
1679 /* static-ref dst:24 offset:32
1681 * Load a SCM value into DST. The SCM value will be fetched from
1682 * memory, OFFSET 32-bit words away from the current instruction
1683 * pointer. OFFSET is a signed value.
1685 * The intention is for this instruction to be used to load constants
1686 * that the compiler is unable to statically allocate, like symbols.
1687 * These values would be initialized when the object file loads.
1689 VM_DEFINE_OP (54, static_ref
, "static-ref", OP2 (U8_U24
, S32
))
1694 scm_t_uintptr loc_bits
;
1696 UNPACK_24 (op
, dst
);
1699 loc_bits
= (scm_t_uintptr
) loc
;
1700 VM_ASSERT (ALIGNED_P (loc
, SCM
), abort());
1702 LOCAL_SET (dst
, *((SCM
*) loc_bits
));
1707 /* static-set! src:24 offset:32
1709 * Store a SCM value into memory, OFFSET 32-bit words away from the
1710 * current instruction pointer. OFFSET is a signed value.
1712 VM_DEFINE_OP (55, static_set
, "static-set!", OP2 (U8_U24
, LO32
))
1718 UNPACK_24 (op
, src
);
1721 VM_ASSERT (ALIGNED_P (loc
, SCM
), abort());
1723 *((SCM
*) loc
) = LOCAL_REF (src
);
1728 /* static-patch! _:24 dst-offset:32 src-offset:32
1730 * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
1731 * are signed 32-bit values, indicating a memory address as a number
1732 * of 32-bit words away from the current instruction pointer.
1734 VM_DEFINE_OP (56, static_patch
, "static-patch!", OP3 (U8_X24
, LO32
, L32
))
1736 scm_t_int32 dst_offset
, src_offset
;
1743 dst_loc
= (void **) (ip
+ dst_offset
);
1744 src
= ip
+ src_offset
;
1745 VM_ASSERT (ALIGNED_P (dst_loc
, void*), abort());
1755 * Mutable top-level bindings
1758 /* There are three slightly different ways to resolve toplevel
1761 1. A toplevel reference outside of a function. These need to be
1762 looked up when the expression is evaluated -- no later, and no
1763 before. They are looked up relative to the module that is
1764 current when the expression is evaluated. For example:
1768 The "resolve" instruction resolves the variable (box), and then
1769 access is via box-ref or box-set!.
1771 2. A toplevel reference inside a function. These are looked up
1772 relative to the module that was current when the function was
1773 defined. Unlike code at the toplevel, which is usually run only
1774 once, these bindings benefit from memoized lookup, in which the
1775 variable resulting from the lookup is cached in the function.
1777 (lambda () (if (foo) a b))
1779 The toplevel-box instruction is equivalent to "resolve", but
1780 caches the resulting variable in statically allocated memory.
1782 3. A reference to an identifier with respect to a particular
1783 module. This can happen for primitive references, and
1784 references residualized by macro expansions. These can always
1785 be cached. Use module-box for these.
1788 /* current-module dst:24
1790 * Store the current module in DST.
1792 VM_DEFINE_OP (57, current_module
, "current-module", OP1 (U8_U24
) | OP_DST
)
1796 UNPACK_24 (op
, dst
);
1799 LOCAL_SET (dst
, scm_current_module ());
1804 /* resolve dst:24 bound?:1 _:7 sym:24
1806 * Resolve SYM in the current module, and place the resulting variable
1809 VM_DEFINE_OP (58, resolve
, "resolve", OP2 (U8_U24
, B1_X7_U24
) | OP_DST
)
1815 UNPACK_24 (op
, dst
);
1816 UNPACK_24 (ip
[1], sym
);
1819 var
= scm_lookup (LOCAL_REF (sym
));
1822 VM_ASSERT (VARIABLE_BOUNDP (var
),
1823 vm_error_unbound (fp
[0], LOCAL_REF (sym
)));
1824 LOCAL_SET (dst
, var
);
1829 /* define! sym:12 val:12
1831 * Look up a binding for SYM in the current module, creating it if
1832 * necessary. Set its value to VAL.
1834 VM_DEFINE_OP (59, define
, "define!", OP1 (U8_U12_U12
))
1836 scm_t_uint16 sym
, val
;
1837 UNPACK_12_12 (op
, sym
, val
);
1839 scm_define (LOCAL_REF (sym
), LOCAL_REF (val
));
1844 /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
1846 * Load a SCM value. The SCM value will be fetched from memory,
1847 * VAR-OFFSET 32-bit words away from the current instruction pointer.
1848 * VAR-OFFSET is a signed value. Up to here, toplevel-box is like
1851 * Then, if the loaded value is a variable, it is placed in DST, and control
1854 * Otherwise, we have to resolve the variable. In that case we load
1855 * the module from MOD-OFFSET, just as we loaded the variable.
1856 * Usually the module gets set when the closure is created. The name
1857 * is an offset to a symbol.
1859 * We use the module and the symbol to resolve the variable, placing it in
1860 * DST, and caching the resolved variable so that we will hit the cache next
1863 VM_DEFINE_OP (60, toplevel_box
, "toplevel-box", OP5 (U8_U24
, S32
, S32
, N32
, B1_X31
) | OP_DST
)
1866 scm_t_int32 var_offset
;
1867 scm_t_uint32
* var_loc_u32
;
1871 UNPACK_24 (op
, dst
);
1873 var_loc_u32
= ip
+ var_offset
;
1874 VM_ASSERT (ALIGNED_P (var_loc_u32
, SCM
), abort());
1875 var_loc
= (SCM
*) var_loc_u32
;
1878 if (SCM_UNLIKELY (!SCM_VARIABLEP (var
)))
1881 scm_t_int32 mod_offset
= ip
[2]; /* signed */
1882 scm_t_int32 sym_offset
= ip
[3]; /* signed */
1883 scm_t_uint32
*mod_loc
= ip
+ mod_offset
;
1884 scm_t_uint32
*sym_loc
= ip
+ sym_offset
;
1888 VM_ASSERT (ALIGNED_P (mod_loc
, SCM
), abort());
1889 VM_ASSERT (ALIGNED_P (sym_loc
, SCM
), abort());
1891 mod
= *((SCM
*) mod_loc
);
1892 sym
= *((SCM
*) sym_loc
);
1894 /* If the toplevel scope was captured before modules were
1895 booted, use the root module. */
1896 if (scm_is_false (mod
))
1897 mod
= scm_the_root_module ();
1899 var
= scm_module_lookup (mod
, sym
);
1902 VM_ASSERT (VARIABLE_BOUNDP (var
), vm_error_unbound (fp
[0], sym
));
1907 LOCAL_SET (dst
, var
);
1911 /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
1913 * Like toplevel-box, except MOD-OFFSET points at the name of a module
1914 * instead of the module itself.
1916 VM_DEFINE_OP (61, module_box
, "module-box", OP5 (U8_U24
, S32
, N32
, N32
, B1_X31
) | OP_DST
)
1919 scm_t_int32 var_offset
;
1920 scm_t_uint32
* var_loc_u32
;
1924 UNPACK_24 (op
, dst
);
1926 var_loc_u32
= ip
+ var_offset
;
1927 VM_ASSERT (ALIGNED_P (var_loc_u32
, SCM
), abort());
1928 var_loc
= (SCM
*) var_loc_u32
;
1931 if (SCM_UNLIKELY (!SCM_VARIABLEP (var
)))
1934 scm_t_int32 modname_offset
= ip
[2]; /* signed */
1935 scm_t_int32 sym_offset
= ip
[3]; /* signed */
1936 scm_t_uint32
*modname_words
= ip
+ modname_offset
;
1937 scm_t_uint32
*sym_loc
= ip
+ sym_offset
;
1941 VM_ASSERT (!(((scm_t_uintptr
) modname_words
) & 0x7), abort());
1942 VM_ASSERT (ALIGNED_P (sym_loc
, SCM
), abort());
1944 modname
= SCM_PACK ((scm_t_bits
) modname_words
);
1945 sym
= *((SCM
*) sym_loc
);
1947 if (!scm_module_system_booted_p
)
1949 #ifdef VM_ENABLE_PARANOID_ASSERTIONS
1952 scm_equal_p (modname
,
1953 scm_list_2 (SCM_BOOL_T
,
1954 scm_from_utf8_symbol ("guile"))));
1956 var
= scm_lookup (sym
);
1958 else if (scm_is_true (SCM_CAR (modname
)))
1959 var
= scm_public_lookup (SCM_CDR (modname
), sym
);
1961 var
= scm_private_lookup (SCM_CDR (modname
), sym
);
1966 VM_ASSERT (VARIABLE_BOUNDP (var
), vm_error_unbound (fp
[0], sym
));
1971 LOCAL_SET (dst
, var
);
1978 * The dynamic environment
1981 /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
1983 * Push a new prompt on the dynamic stack, with a tag from TAG and a
1984 * handler at HANDLER-OFFSET words from the current IP. The handler
1985 * will expect a multiple-value return as if from a call with the
1986 * procedure at PROC-SLOT.
1988 VM_DEFINE_OP (62, prompt
, "prompt", OP3 (U8_U24
, B1_X7_U24
, X8_L24
))
1990 scm_t_uint32 tag
, proc_slot
;
1992 scm_t_uint8 escape_only_p
;
1993 scm_t_dynstack_prompt_flags flags
;
1995 UNPACK_24 (op
, tag
);
1996 escape_only_p
= ip
[1] & 0x1;
1997 UNPACK_24 (ip
[1], proc_slot
);
1999 offset
>>= 8; /* Sign extension */
2001 /* Push the prompt onto the dynamic stack. */
2002 flags
= escape_only_p
? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY
: 0;
2003 scm_dynstack_push_prompt (¤t_thread
->dynstack
, flags
,
2005 fp
- vp
->stack_base
,
2006 LOCAL_ADDRESS (proc_slot
) - vp
->stack_base
,
2012 /* wind winder:12 unwinder:12
2014 * Push wind and unwind procedures onto the dynamic stack. Note that
2015 * neither are actually called; the compiler should emit calls to wind
2016 * and unwind for the normal dynamic-wind control flow. Also note that
2017 * the compiler should have inserted checks that they wind and unwind
2018 * procs are thunks, if it could not prove that to be the case.
2020 VM_DEFINE_OP (63, wind
, "wind", OP1 (U8_U12_U12
))
2022 scm_t_uint16 winder
, unwinder
;
2023 UNPACK_12_12 (op
, winder
, unwinder
);
2024 scm_dynstack_push_dynwind (¤t_thread
->dynstack
,
2025 LOCAL_REF (winder
), LOCAL_REF (unwinder
));
2031 * A normal exit from the dynamic extent of an expression. Pop the top
2032 * entry off of the dynamic stack.
2034 VM_DEFINE_OP (64, unwind
, "unwind", OP1 (U8_X24
))
2036 scm_dynstack_pop (¤t_thread
->dynstack
);
2040 /* push-fluid fluid:12 value:12
2042 * Dynamically bind VALUE to FLUID.
2044 VM_DEFINE_OP (65, push_fluid
, "push-fluid", OP1 (U8_U12_U12
))
2046 scm_t_uint32 fluid
, value
;
2048 UNPACK_12_12 (op
, fluid
, value
);
2050 scm_dynstack_push_fluid (¤t_thread
->dynstack
,
2051 LOCAL_REF (fluid
), LOCAL_REF (value
),
2052 current_thread
->dynamic_state
);
2058 * Leave the dynamic extent of a with-fluid* expression, restoring the
2059 * fluid to its previous value.
2061 VM_DEFINE_OP (66, pop_fluid
, "pop-fluid", OP1 (U8_X24
))
2063 /* This function must not allocate. */
2064 scm_dynstack_unwind_fluid (¤t_thread
->dynstack
,
2065 current_thread
->dynamic_state
);
2069 /* fluid-ref dst:12 src:12
2071 * Reference the fluid in SRC, and place the value in DST.
2073 VM_DEFINE_OP (67, fluid_ref
, "fluid-ref", OP1 (U8_U12_U12
) | OP_DST
)
2075 scm_t_uint16 dst
, src
;
2079 UNPACK_12_12 (op
, dst
, src
);
2080 fluid
= LOCAL_REF (src
);
2081 fluids
= SCM_I_DYNAMIC_STATE_FLUIDS (current_thread
->dynamic_state
);
2082 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid
))
2083 || ((num
= SCM_I_FLUID_NUM (fluid
)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids
)))
2085 /* Punt dynstate expansion and error handling to the C proc. */
2087 LOCAL_SET (dst
, scm_fluid_ref (fluid
));
2091 SCM val
= SCM_SIMPLE_VECTOR_REF (fluids
, num
);
2092 if (scm_is_eq (val
, SCM_UNDEFINED
))
2093 val
= SCM_I_FLUID_DEFAULT (fluid
);
2094 VM_ASSERT (!scm_is_eq (val
, SCM_UNDEFINED
),
2095 vm_error_unbound_fluid (SCM_FRAME_PROGRAM (fp
), fluid
));
2096 LOCAL_SET (dst
, val
);
2102 /* fluid-set fluid:12 val:12
2104 * Set the value of the fluid in DST to the value in SRC.
2106 VM_DEFINE_OP (68, fluid_set
, "fluid-set", OP1 (U8_U12_U12
))
2112 UNPACK_12_12 (op
, a
, b
);
2113 fluid
= LOCAL_REF (a
);
2114 fluids
= SCM_I_DYNAMIC_STATE_FLUIDS (current_thread
->dynamic_state
);
2115 if (SCM_UNLIKELY (!SCM_FLUID_P (fluid
))
2116 || ((num
= SCM_I_FLUID_NUM (fluid
)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids
)))
2118 /* Punt dynstate expansion and error handling to the C proc. */
2120 scm_fluid_set_x (fluid
, LOCAL_REF (b
));
2123 SCM_SIMPLE_VECTOR_SET (fluids
, num
, LOCAL_REF (b
));
2132 * Strings, symbols, and keywords
2135 /* string-length dst:12 src:12
2137 * Store the length of the string in SRC in DST.
2139 VM_DEFINE_OP (69, string_length
, "string-length", OP1 (U8_U12_U12
) | OP_DST
)
2142 if (SCM_LIKELY (scm_is_string (str
)))
2143 RETURN (SCM_I_MAKINUM (scm_i_string_length (str
)));
2147 RETURN (scm_string_length (str
));
2151 /* string-ref dst:8 src:8 idx:8
2153 * Fetch the character at position IDX in the string in SRC, and store
2156 VM_DEFINE_OP (70, string_ref
, "string-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2158 scm_t_signed_bits i
= 0;
2160 if (SCM_LIKELY (scm_is_string (str
)
2161 && SCM_I_INUMP (idx
)
2162 && ((i
= SCM_I_INUM (idx
)) >= 0)
2163 && i
< scm_i_string_length (str
)))
2164 RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str
, i
)));
2168 RETURN (scm_string_ref (str
, idx
));
2172 /* No string-set! instruction, as there is no good fast path there. */
2174 /* string->number dst:12 src:12
2176 * Parse a string in SRC to a number, and store in DST.
2178 VM_DEFINE_OP (71, string_to_number
, "string->number", OP1 (U8_U12_U12
) | OP_DST
)
2180 scm_t_uint16 dst
, src
;
2182 UNPACK_12_12 (op
, dst
, src
);
2185 scm_string_to_number (LOCAL_REF (src
),
2186 SCM_UNDEFINED
/* radix = 10 */));
2190 /* string->symbol dst:12 src:12
2192 * Parse a string in SRC to a symbol, and store in DST.
2194 VM_DEFINE_OP (72, string_to_symbol
, "string->symbol", OP1 (U8_U12_U12
) | OP_DST
)
2196 scm_t_uint16 dst
, src
;
2198 UNPACK_12_12 (op
, dst
, src
);
2200 LOCAL_SET (dst
, scm_string_to_symbol (LOCAL_REF (src
)));
2204 /* symbol->keyword dst:12 src:12
2206 * Make a keyword from the symbol in SRC, and store it in DST.
2208 VM_DEFINE_OP (73, symbol_to_keyword
, "symbol->keyword", OP1 (U8_U12_U12
) | OP_DST
)
2210 scm_t_uint16 dst
, src
;
2211 UNPACK_12_12 (op
, dst
, src
);
2213 LOCAL_SET (dst
, scm_symbol_to_keyword (LOCAL_REF (src
)));
2223 /* cons dst:8 car:8 cdr:8
2225 * Cons CAR and CDR, and store the result in DST.
2227 VM_DEFINE_OP (74, cons
, "cons", OP1 (U8_U8_U8_U8
) | OP_DST
)
2230 RETURN (scm_cons (x
, y
));
2233 /* car dst:12 src:12
2235 * Place the car of SRC in DST.
2237 VM_DEFINE_OP (75, car
, "car", OP1 (U8_U12_U12
) | OP_DST
)
2240 VM_VALIDATE_PAIR (x
, "car");
2241 RETURN (SCM_CAR (x
));
2244 /* cdr dst:12 src:12
2246 * Place the cdr of SRC in DST.
2248 VM_DEFINE_OP (76, cdr
, "cdr", OP1 (U8_U12_U12
) | OP_DST
)
2251 VM_VALIDATE_PAIR (x
, "cdr");
2252 RETURN (SCM_CDR (x
));
2255 /* set-car! pair:12 car:12
2257 * Set the car of DST to SRC.
2259 VM_DEFINE_OP (77, set_car
, "set-car!", OP1 (U8_U12_U12
))
2263 UNPACK_12_12 (op
, a
, b
);
2266 VM_VALIDATE_PAIR (x
, "set-car!");
2271 /* set-cdr! pair:12 cdr:12
2273 * Set the cdr of DST to SRC.
2275 VM_DEFINE_OP (78, set_cdr
, "set-cdr!", OP1 (U8_U12_U12
))
2279 UNPACK_12_12 (op
, a
, b
);
2282 VM_VALIDATE_PAIR (x
, "set-car!");
2291 * Numeric operations
2294 /* add dst:8 a:8 b:8
2296 * Add A to B, and place the result in DST.
2298 VM_DEFINE_OP (79, add
, "add", OP1 (U8_U8_U8_U8
) | OP_DST
)
2300 BINARY_INTEGER_OP (+, scm_sum
);
2303 /* add1 dst:12 src:12
2305 * Add 1 to the value in SRC, and place the result in DST.
2307 VM_DEFINE_OP (80, add1
, "add1", OP1 (U8_U12_U12
) | OP_DST
)
2311 /* Check for overflow. We must avoid overflow in the signed
2312 addition below, even if X is not an inum. */
2313 if (SCM_LIKELY ((scm_t_signed_bits
) SCM_UNPACK (x
) <= INUM_MAX
- INUM_STEP
))
2317 /* Add 1 to the integer without untagging. */
2318 result
= SCM_PACK ((scm_t_signed_bits
) SCM_UNPACK (x
) + INUM_STEP
);
2320 if (SCM_LIKELY (SCM_I_INUMP (result
)))
2324 RETURN_EXP (scm_sum (x
, SCM_I_MAKINUM (1)));
2327 /* sub dst:8 a:8 b:8
2329 * Subtract B from A, and place the result in DST.
2331 VM_DEFINE_OP (81, sub
, "sub", OP1 (U8_U8_U8_U8
) | OP_DST
)
2333 BINARY_INTEGER_OP (-, scm_difference
);
2336 /* sub1 dst:12 src:12
2338 * Subtract 1 from SRC, and place the result in DST.
2340 VM_DEFINE_OP (82, sub1
, "sub1", OP1 (U8_U12_U12
) | OP_DST
)
2344 /* Check for overflow. We must avoid overflow in the signed
2345 subtraction below, even if X is not an inum. */
2346 if (SCM_LIKELY ((scm_t_signed_bits
) SCM_UNPACK (x
) >= INUM_MIN
+ INUM_STEP
))
2350 /* Substract 1 from the integer without untagging. */
2351 result
= SCM_PACK ((scm_t_signed_bits
) SCM_UNPACK (x
) - INUM_STEP
);
2353 if (SCM_LIKELY (SCM_I_INUMP (result
)))
2357 RETURN_EXP (scm_difference (x
, SCM_I_MAKINUM (1)));
2360 /* mul dst:8 a:8 b:8
2362 * Multiply A and B, and place the result in DST.
2364 VM_DEFINE_OP (83, mul
, "mul", OP1 (U8_U8_U8_U8
) | OP_DST
)
2367 RETURN_EXP (scm_product (x
, y
));
2370 /* div dst:8 a:8 b:8
2372 * Divide A by B, and place the result in DST.
2374 VM_DEFINE_OP (84, div
, "div", OP1 (U8_U8_U8_U8
) | OP_DST
)
2377 RETURN_EXP (scm_divide (x
, y
));
2380 /* quo dst:8 a:8 b:8
2382 * Divide A by B, and place the quotient in DST.
2384 VM_DEFINE_OP (85, quo
, "quo", OP1 (U8_U8_U8_U8
) | OP_DST
)
2387 RETURN_EXP (scm_quotient (x
, y
));
2390 /* rem dst:8 a:8 b:8
2392 * Divide A by B, and place the remainder in DST.
2394 VM_DEFINE_OP (86, rem
, "rem", OP1 (U8_U8_U8_U8
) | OP_DST
)
2397 RETURN_EXP (scm_remainder (x
, y
));
2400 /* mod dst:8 a:8 b:8
2402 * Place the modulo of A by B in DST.
2404 VM_DEFINE_OP (87, mod
, "mod", OP1 (U8_U8_U8_U8
) | OP_DST
)
2407 RETURN_EXP (scm_modulo (x
, y
));
2410 /* ash dst:8 a:8 b:8
2412 * Shift A arithmetically by B bits, and place the result in DST.
2414 VM_DEFINE_OP (88, ash
, "ash", OP1 (U8_U8_U8_U8
) | OP_DST
)
2417 if (SCM_I_INUMP (x
) && SCM_I_INUMP (y
))
2419 if (SCM_I_INUM (y
) < 0)
2420 /* Right shift, will be a fixnum. */
2421 RETURN (SCM_I_MAKINUM
2422 (SCM_SRS (SCM_I_INUM (x
),
2423 (-SCM_I_INUM (y
) <= SCM_I_FIXNUM_BIT
-1)
2424 ? -SCM_I_INUM (y
) : SCM_I_FIXNUM_BIT
-1)));
2426 /* Left shift. See comments in scm_ash. */
2428 scm_t_signed_bits nn
, bits_to_shift
;
2430 nn
= SCM_I_INUM (x
);
2431 bits_to_shift
= SCM_I_INUM (y
);
2433 if (bits_to_shift
< SCM_I_FIXNUM_BIT
-1
2435 (SCM_SRS (nn
, (SCM_I_FIXNUM_BIT
-1 - bits_to_shift
)) + 1)
2437 RETURN (SCM_I_MAKINUM (nn
<< bits_to_shift
));
2442 RETURN_EXP (scm_ash (x
, y
));
2445 /* logand dst:8 a:8 b:8
2447 * Place the bitwise AND of A and B into DST.
2449 VM_DEFINE_OP (89, logand
, "logand", OP1 (U8_U8_U8_U8
) | OP_DST
)
2452 if (SCM_I_INUMP (x
) && SCM_I_INUMP (y
))
2453 /* Compute bitwise AND without untagging */
2454 RETURN (SCM_PACK (SCM_UNPACK (x
) & SCM_UNPACK (y
)));
2455 RETURN_EXP (scm_logand (x
, y
));
2458 /* logior dst:8 a:8 b:8
2460 * Place the bitwise inclusive OR of A with B in DST.
2462 VM_DEFINE_OP (90, logior
, "logior", OP1 (U8_U8_U8_U8
) | OP_DST
)
2465 if (SCM_I_INUMP (x
) && SCM_I_INUMP (y
))
2466 /* Compute bitwise OR without untagging */
2467 RETURN (SCM_PACK (SCM_UNPACK (x
) | SCM_UNPACK (y
)));
2468 RETURN_EXP (scm_logior (x
, y
));
2471 /* logxor dst:8 a:8 b:8
2473 * Place the bitwise exclusive OR of A with B in DST.
2475 VM_DEFINE_OP (91, logxor
, "logxor", OP1 (U8_U8_U8_U8
) | OP_DST
)
2478 if (SCM_I_INUMP (x
) && SCM_I_INUMP (y
))
2479 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x
) ^ SCM_I_INUM (y
)));
2480 RETURN_EXP (scm_logxor (x
, y
));
2483 /* make-vector/immediate dst:8 length:8 init:8
2485 * Make a short vector of known size and write it to DST. The vector
2486 * will have space for LENGTH slots, an immediate value. They will be
2487 * filled with the value in slot INIT.
2489 VM_DEFINE_OP (92, make_vector_immediate
, "make-vector/immediate", OP1 (U8_U8_U8_U8
) | OP_DST
)
2491 scm_t_uint8 dst
, init
;
2492 scm_t_int32 length
, n
;
2495 UNPACK_8_8_8 (op
, dst
, length
, init
);
2497 val
= LOCAL_REF (init
);
2498 vector
= scm_words (scm_tc7_vector
| (length
<< 8), length
+ 1);
2499 for (n
= 0; n
< length
; n
++)
2500 SCM_SIMPLE_VECTOR_SET (vector
, n
, val
);
2501 LOCAL_SET (dst
, vector
);
2505 /* vector-length dst:12 src:12
2507 * Store the length of the vector in SRC in DST.
2509 VM_DEFINE_OP (93, vector_length
, "vector-length", OP1 (U8_U12_U12
) | OP_DST
)
2512 if (SCM_LIKELY (SCM_I_IS_VECTOR (vect
)))
2513 RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect
)));
2517 RETURN (scm_vector_length (vect
));
2521 /* vector-ref dst:8 src:8 idx:8
2523 * Fetch the item at position IDX in the vector in SRC, and store it
2526 VM_DEFINE_OP (94, vector_ref
, "vector-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2528 scm_t_signed_bits i
= 0;
2530 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect
)
2531 && SCM_I_INUMP (idx
)
2532 && ((i
= SCM_I_INUM (idx
)) >= 0)
2533 && i
< SCM_I_VECTOR_LENGTH (vect
)))
2534 RETURN (SCM_I_VECTOR_ELTS (vect
)[i
]);
2538 RETURN (scm_vector_ref (vect
, idx
));
2542 /* vector-ref/immediate dst:8 src:8 idx:8
2544 * Fill DST with the item IDX elements into the vector at SRC. Useful
2545 * for building data types using vectors.
2547 VM_DEFINE_OP (95, vector_ref_immediate
, "vector-ref/immediate", OP1 (U8_U8_U8_U8
) | OP_DST
)
2549 scm_t_uint8 dst
, src
, idx
;
2552 UNPACK_8_8_8 (op
, dst
, src
, idx
);
2553 v
= LOCAL_REF (src
);
2554 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v
)
2555 && idx
< SCM_I_VECTOR_LENGTH (v
)))
2556 LOCAL_SET (dst
, SCM_I_VECTOR_ELTS (LOCAL_REF (src
))[idx
]);
2558 LOCAL_SET (dst
, scm_c_vector_ref (v
, idx
));
2562 /* vector-set! dst:8 idx:8 src:8
2564 * Store SRC into the vector DST at index IDX.
2566 VM_DEFINE_OP (96, vector_set
, "vector-set!", OP1 (U8_U8_U8_U8
))
2568 scm_t_uint8 dst
, idx_var
, src
;
2570 scm_t_signed_bits i
= 0;
2572 UNPACK_8_8_8 (op
, dst
, idx_var
, src
);
2573 vect
= LOCAL_REF (dst
);
2574 idx
= LOCAL_REF (idx_var
);
2575 val
= LOCAL_REF (src
);
2577 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect
)
2578 && SCM_I_INUMP (idx
)
2579 && ((i
= SCM_I_INUM (idx
)) >= 0)
2580 && i
< SCM_I_VECTOR_LENGTH (vect
)))
2581 SCM_I_VECTOR_WELTS (vect
)[i
] = val
;
2585 scm_vector_set_x (vect
, idx
, val
);
2590 /* vector-set!/immediate dst:8 idx:8 src:8
2592 * Store SRC into the vector DST at index IDX. Here IDX is an
2595 VM_DEFINE_OP (97, vector_set_immediate
, "vector-set!/immediate", OP1 (U8_U8_U8_U8
))
2597 scm_t_uint8 dst
, idx
, src
;
2600 UNPACK_8_8_8 (op
, dst
, idx
, src
);
2601 vect
= LOCAL_REF (dst
);
2602 val
= LOCAL_REF (src
);
2604 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect
)
2605 && idx
< SCM_I_VECTOR_LENGTH (vect
)))
2606 SCM_I_VECTOR_WELTS (vect
)[idx
] = val
;
2610 scm_vector_set_x (vect
, scm_from_uint8 (idx
), val
);
2622 /* struct-vtable dst:12 src:12
2624 * Store the vtable of SRC into DST.
2626 VM_DEFINE_OP (98, struct_vtable
, "struct-vtable", OP1 (U8_U12_U12
) | OP_DST
)
2629 VM_VALIDATE_STRUCT (obj
, "struct_vtable");
2630 RETURN (SCM_STRUCT_VTABLE (obj
));
2633 /* allocate-struct/immediate dst:8 vtable:8 nfields:8
2635 * Allocate a new struct with VTABLE, and place it in DST. The struct
2636 * will be constructed with space for NFIELDS fields, which should
2637 * correspond to the field count of the VTABLE.
2639 VM_DEFINE_OP (99, allocate_struct_immediate
, "allocate-struct/immediate", OP1 (U8_U8_U8_U8
) | OP_DST
)
2641 scm_t_uint8 dst
, vtable
, nfields
;
2644 UNPACK_8_8_8 (op
, dst
, vtable
, nfields
);
2647 ret
= scm_allocate_struct (LOCAL_REF (vtable
), SCM_I_MAKINUM (nfields
));
2648 LOCAL_SET (dst
, ret
);
2653 /* struct-ref/immediate dst:8 src:8 idx:8
2655 * Fetch the item at slot IDX in the struct in SRC, and store it
2656 * in DST. IDX is an immediate unsigned 8-bit value.
2658 VM_DEFINE_OP (100, struct_ref_immediate
, "struct-ref/immediate", OP1 (U8_U8_U8_U8
) | OP_DST
)
2660 scm_t_uint8 dst
, src
, idx
;
2663 UNPACK_8_8_8 (op
, dst
, src
, idx
);
2665 obj
= LOCAL_REF (src
);
2667 if (SCM_LIKELY (SCM_STRUCTP (obj
)
2668 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj
,
2669 SCM_VTABLE_FLAG_SIMPLE
)
2670 && idx
< SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj
),
2671 scm_vtable_index_size
)))
2672 RETURN (SCM_STRUCT_SLOT_REF (obj
, idx
));
2675 RETURN (scm_struct_ref (obj
, SCM_I_MAKINUM (idx
)));
2678 /* struct-set!/immediate dst:8 idx:8 src:8
2680 * Store SRC into the struct DST at slot IDX. IDX is an immediate
2681 * unsigned 8-bit value.
2683 VM_DEFINE_OP (101, struct_set_immediate
, "struct-set!/immediate", OP1 (U8_U8_U8_U8
))
2685 scm_t_uint8 dst
, idx
, src
;
2688 UNPACK_8_8_8 (op
, dst
, idx
, src
);
2690 obj
= LOCAL_REF (dst
);
2691 val
= LOCAL_REF (src
);
2693 if (SCM_LIKELY (SCM_STRUCTP (obj
)
2694 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj
,
2695 SCM_VTABLE_FLAG_SIMPLE
)
2696 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj
,
2697 SCM_VTABLE_FLAG_SIMPLE_RW
)
2698 && idx
< SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj
),
2699 scm_vtable_index_size
)))
2701 SCM_STRUCT_SLOT_SET (obj
, idx
, val
);
2706 scm_struct_set_x (obj
, SCM_I_MAKINUM (idx
), val
);
2710 /* class-of dst:12 type:12
2712 * Store the vtable of SRC into DST.
2714 VM_DEFINE_OP (102, class_of
, "class-of", OP1 (U8_U12_U12
) | OP_DST
)
2717 if (SCM_INSTANCEP (obj
))
2718 RETURN (SCM_CLASS_OF (obj
));
2720 RETURN (scm_class_of (obj
));
2723 VM_DEFINE_OP (103, unused_103
, NULL
, NOP
)
2724 VM_DEFINE_OP (104, unused_104
, NULL
, NOP
)
2730 * Arrays, packed uniform arrays, and bytevectors.
2733 /* load-typed-array dst:8 type:8 shape:8 offset:32 len:32
2735 * Load the contiguous typed array located at OFFSET 32-bit words away
2736 * from the instruction pointer, and store into DST. LEN is a byte
2737 * length. OFFSET is signed.
2739 VM_DEFINE_OP (105, load_typed_array
, "load-typed-array", OP3 (U8_U8_U8_U8
, N32
, U32
) | OP_DST
)
2741 scm_t_uint8 dst
, type
, shape
;
2745 UNPACK_8_8_8 (op
, dst
, type
, shape
);
2749 LOCAL_SET (dst
, scm_from_contiguous_typed_array (LOCAL_REF (type
),
2755 /* make-array dst:12 type:12 _:8 fill:12 bounds:12
2757 * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
2759 VM_DEFINE_OP (106, make_array
, "make-array", OP2 (U8_U12_U12
, X8_U12_U12
) | OP_DST
)
2761 scm_t_uint16 dst
, type
, fill
, bounds
;
2762 UNPACK_12_12 (op
, dst
, type
);
2763 UNPACK_12_12 (ip
[1], fill
, bounds
);
2765 LOCAL_SET (dst
, scm_make_typed_array (LOCAL_REF (type
), LOCAL_REF (fill
),
2766 LOCAL_REF (bounds
)));
2770 /* bv-u8-ref dst:8 src:8 idx:8
2771 * bv-s8-ref dst:8 src:8 idx:8
2772 * bv-u16-ref dst:8 src:8 idx:8
2773 * bv-s16-ref dst:8 src:8 idx:8
2774 * bv-u32-ref dst:8 src:8 idx:8
2775 * bv-s32-ref dst:8 src:8 idx:8
2776 * bv-u64-ref dst:8 src:8 idx:8
2777 * bv-s64-ref dst:8 src:8 idx:8
2778 * bv-f32-ref dst:8 src:8 idx:8
2779 * bv-f64-ref dst:8 src:8 idx:8
2781 * Fetch the item at byte offset IDX in the bytevector SRC, and store
2782 * it in DST. All accesses use native endianness.
2784 #define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
2786 scm_t_signed_bits i; \
2787 const scm_t_ ## type *int_ptr; \
2790 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2791 i = SCM_I_INUM (idx); \
2792 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2794 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2796 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2797 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2798 RETURN (SCM_I_MAKINUM (*int_ptr)); \
2802 RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx)); \
2806 #define BV_INT_REF(stem, type, size) \
2808 scm_t_signed_bits i; \
2809 const scm_t_ ## type *int_ptr; \
2812 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2813 i = SCM_I_INUM (idx); \
2814 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2816 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2818 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2819 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2821 scm_t_ ## type x = *int_ptr; \
2822 if (SCM_FIXABLE (x)) \
2823 RETURN (SCM_I_MAKINUM (x)); \
2827 RETURN (scm_from_ ## type (x)); \
2833 RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx)); \
2837 #define BV_FLOAT_REF(stem, fn_stem, type, size) \
2839 scm_t_signed_bits i; \
2840 const type *float_ptr; \
2843 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
2844 i = SCM_I_INUM (idx); \
2845 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2848 if (SCM_LIKELY (SCM_I_INUMP (idx) \
2850 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2851 && (ALIGNED_P (float_ptr, type)))) \
2852 RETURN (scm_from_double (*float_ptr)); \
2854 RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
2857 VM_DEFINE_OP (107, bv_u8_ref
, "bv-u8-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2858 BV_FIXABLE_INT_REF (u8
, u8
, uint8
, 1);
2860 VM_DEFINE_OP (108, bv_s8_ref
, "bv-s8-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2861 BV_FIXABLE_INT_REF (s8
, s8
, int8
, 1);
2863 VM_DEFINE_OP (109, bv_u16_ref
, "bv-u16-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2864 BV_FIXABLE_INT_REF (u16
, u16_native
, uint16
, 2);
2866 VM_DEFINE_OP (110, bv_s16_ref
, "bv-s16-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2867 BV_FIXABLE_INT_REF (s16
, s16_native
, int16
, 2);
2869 VM_DEFINE_OP (111, bv_u32_ref
, "bv-u32-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2870 #if SIZEOF_VOID_P > 4
2871 BV_FIXABLE_INT_REF (u32
, u32_native
, uint32
, 4);
2873 BV_INT_REF (u32
, uint32
, 4);
2876 VM_DEFINE_OP (112, bv_s32_ref
, "bv-s32-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2877 #if SIZEOF_VOID_P > 4
2878 BV_FIXABLE_INT_REF (s32
, s32_native
, int32
, 4);
2880 BV_INT_REF (s32
, int32
, 4);
2883 VM_DEFINE_OP (113, bv_u64_ref
, "bv-u64-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2884 BV_INT_REF (u64
, uint64
, 8);
2886 VM_DEFINE_OP (114, bv_s64_ref
, "bv-s64-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2887 BV_INT_REF (s64
, int64
, 8);
2889 VM_DEFINE_OP (115, bv_f32_ref
, "bv-f32-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2890 BV_FLOAT_REF (f32
, ieee_single
, float, 4);
2892 VM_DEFINE_OP (116, bv_f64_ref
, "bv-f64-ref", OP1 (U8_U8_U8_U8
) | OP_DST
)
2893 BV_FLOAT_REF (f64
, ieee_double
, double, 8);
2895 /* bv-u8-set! dst:8 idx:8 src:8
2896 * bv-s8-set! dst:8 idx:8 src:8
2897 * bv-u16-set! dst:8 idx:8 src:8
2898 * bv-s16-set! dst:8 idx:8 src:8
2899 * bv-u32-set! dst:8 idx:8 src:8
2900 * bv-s32-set! dst:8 idx:8 src:8
2901 * bv-u64-set! dst:8 idx:8 src:8
2902 * bv-s64-set! dst:8 idx:8 src:8
2903 * bv-f32-set! dst:8 idx:8 src:8
2904 * bv-f64-set! dst:8 idx:8 src:8
2906 * Store SRC into the bytevector DST at byte offset IDX. Multibyte
2907 * values are written using native endianness.
2909 #define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
2911 scm_t_uint8 dst, idx, src; \
2912 scm_t_signed_bits i, j = 0; \
2913 SCM bv, scm_idx, val; \
2914 scm_t_ ## type *int_ptr; \
2916 UNPACK_8_8_8 (op, dst, idx, src); \
2917 bv = LOCAL_REF (dst); \
2918 scm_idx = LOCAL_REF (idx); \
2919 val = LOCAL_REF (src); \
2920 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
2921 i = SCM_I_INUM (scm_idx); \
2922 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2924 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2926 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2927 && (ALIGNED_P (int_ptr, scm_t_ ## type)) \
2928 && (SCM_I_INUMP (val)) \
2929 && ((j = SCM_I_INUM (val)) >= min) \
2931 *int_ptr = (scm_t_ ## type) j; \
2935 scm_bytevector_ ## fn_stem ## _set_x (bv, scm_idx, val); \
2940 #define BV_INT_SET(stem, type, size) \
2942 scm_t_uint8 dst, idx, src; \
2943 scm_t_signed_bits i; \
2944 SCM bv, scm_idx, val; \
2945 scm_t_ ## type *int_ptr; \
2947 UNPACK_8_8_8 (op, dst, idx, src); \
2948 bv = LOCAL_REF (dst); \
2949 scm_idx = LOCAL_REF (idx); \
2950 val = LOCAL_REF (src); \
2951 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
2952 i = SCM_I_INUM (scm_idx); \
2953 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2955 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2957 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2958 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
2959 *int_ptr = scm_to_ ## type (val); \
2963 scm_bytevector_ ## stem ## _native_set_x (bv, scm_idx, val); \
2968 #define BV_FLOAT_SET(stem, fn_stem, type, size) \
2970 scm_t_uint8 dst, idx, src; \
2971 scm_t_signed_bits i; \
2972 SCM bv, scm_idx, val; \
2975 UNPACK_8_8_8 (op, dst, idx, src); \
2976 bv = LOCAL_REF (dst); \
2977 scm_idx = LOCAL_REF (idx); \
2978 val = LOCAL_REF (src); \
2979 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
2980 i = SCM_I_INUM (scm_idx); \
2981 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
2983 if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
2985 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
2986 && (ALIGNED_P (float_ptr, type)))) \
2987 *float_ptr = scm_to_double (val); \
2991 scm_bytevector_ ## fn_stem ## _native_set_x (bv, scm_idx, val); \
2996 VM_DEFINE_OP (117, bv_u8_set
, "bv-u8-set!", OP1 (U8_U8_U8_U8
))
2997 BV_FIXABLE_INT_SET (u8
, u8
, uint8
, 0, SCM_T_UINT8_MAX
, 1);
2999 VM_DEFINE_OP (118, bv_s8_set
, "bv-s8-set!", OP1 (U8_U8_U8_U8
))
3000 BV_FIXABLE_INT_SET (s8
, s8
, int8
, SCM_T_INT8_MIN
, SCM_T_INT8_MAX
, 1);
3002 VM_DEFINE_OP (119, bv_u16_set
, "bv-u16-set!", OP1 (U8_U8_U8_U8
))
3003 BV_FIXABLE_INT_SET (u16
, u16_native
, uint16
, 0, SCM_T_UINT16_MAX
, 2);
3005 VM_DEFINE_OP (120, bv_s16_set
, "bv-s16-set!", OP1 (U8_U8_U8_U8
))
3006 BV_FIXABLE_INT_SET (s16
, s16_native
, int16
, SCM_T_INT16_MIN
, SCM_T_INT16_MAX
, 2);
3008 VM_DEFINE_OP (121, bv_u32_set
, "bv-u32-set!", OP1 (U8_U8_U8_U8
))
3009 #if SIZEOF_VOID_P > 4
3010 BV_FIXABLE_INT_SET (u32
, u32_native
, uint32
, 0, SCM_T_UINT32_MAX
, 4);
3012 BV_INT_SET (u32
, uint32
, 4);
3015 VM_DEFINE_OP (122, bv_s32_set
, "bv-s32-set!", OP1 (U8_U8_U8_U8
))
3016 #if SIZEOF_VOID_P > 4
3017 BV_FIXABLE_INT_SET (s32
, s32_native
, int32
, SCM_T_INT32_MIN
, SCM_T_INT32_MAX
, 4);
3019 BV_INT_SET (s32
, int32
, 4);
3022 VM_DEFINE_OP (123, bv_u64_set
, "bv-u64-set!", OP1 (U8_U8_U8_U8
))
3023 BV_INT_SET (u64
, uint64
, 8);
3025 VM_DEFINE_OP (124, bv_s64_set
, "bv-s64-set!", OP1 (U8_U8_U8_U8
))
3026 BV_INT_SET (s64
, int64
, 8);
3028 VM_DEFINE_OP (125, bv_f32_set
, "bv-f32-set!", OP1 (U8_U8_U8_U8
))
3029 BV_FLOAT_SET (f32
, ieee_single
, float, 4);
3031 VM_DEFINE_OP (126, bv_f64_set
, "bv-f64-set!", OP1 (U8_U8_U8_U8
))
3032 BV_FLOAT_SET (f64
, ieee_double
, double, 8);
3034 VM_DEFINE_OP (127, unused_127
, NULL
, NOP
)
3035 VM_DEFINE_OP (128, unused_128
, NULL
, NOP
)
3036 VM_DEFINE_OP (129, unused_129
, NULL
, NOP
)
3037 VM_DEFINE_OP (130, unused_130
, NULL
, NOP
)
3038 VM_DEFINE_OP (131, unused_131
, NULL
, NOP
)
3039 VM_DEFINE_OP (132, unused_132
, NULL
, NOP
)
3040 VM_DEFINE_OP (133, unused_133
, NULL
, NOP
)
3041 VM_DEFINE_OP (134, unused_134
, NULL
, NOP
)
3042 VM_DEFINE_OP (135, unused_135
, NULL
, NOP
)
3043 VM_DEFINE_OP (136, unused_136
, NULL
, NOP
)
3044 VM_DEFINE_OP (137, unused_137
, NULL
, NOP
)
3045 VM_DEFINE_OP (138, unused_138
, NULL
, NOP
)
3046 VM_DEFINE_OP (139, unused_139
, NULL
, NOP
)
3047 VM_DEFINE_OP (140, unused_140
, NULL
, NOP
)
3048 VM_DEFINE_OP (141, unused_141
, NULL
, NOP
)
3049 VM_DEFINE_OP (142, unused_142
, NULL
, NOP
)
3050 VM_DEFINE_OP (143, unused_143
, NULL
, NOP
)
3051 VM_DEFINE_OP (144, unused_144
, NULL
, NOP
)
3052 VM_DEFINE_OP (145, unused_145
, NULL
, NOP
)
3053 VM_DEFINE_OP (146, unused_146
, NULL
, NOP
)
3054 VM_DEFINE_OP (147, unused_147
, NULL
, NOP
)
3055 VM_DEFINE_OP (148, unused_148
, NULL
, NOP
)
3056 VM_DEFINE_OP (149, unused_149
, NULL
, NOP
)
3057 VM_DEFINE_OP (150, unused_150
, NULL
, NOP
)
3058 VM_DEFINE_OP (151, unused_151
, NULL
, NOP
)
3059 VM_DEFINE_OP (152, unused_152
, NULL
, NOP
)
3060 VM_DEFINE_OP (153, unused_153
, NULL
, NOP
)
3061 VM_DEFINE_OP (154, unused_154
, NULL
, NOP
)
3062 VM_DEFINE_OP (155, unused_155
, NULL
, NOP
)
3063 VM_DEFINE_OP (156, unused_156
, NULL
, NOP
)
3064 VM_DEFINE_OP (157, unused_157
, NULL
, NOP
)
3065 VM_DEFINE_OP (158, unused_158
, NULL
, NOP
)
3066 VM_DEFINE_OP (159, unused_159
, NULL
, NOP
)
3067 VM_DEFINE_OP (160, unused_160
, NULL
, NOP
)
3068 VM_DEFINE_OP (161, unused_161
, NULL
, NOP
)
3069 VM_DEFINE_OP (162, unused_162
, NULL
, NOP
)
3070 VM_DEFINE_OP (163, unused_163
, NULL
, NOP
)
3071 VM_DEFINE_OP (164, unused_164
, NULL
, NOP
)
3072 VM_DEFINE_OP (165, unused_165
, NULL
, NOP
)
3073 VM_DEFINE_OP (166, unused_166
, NULL
, NOP
)
3074 VM_DEFINE_OP (167, unused_167
, NULL
, NOP
)
3075 VM_DEFINE_OP (168, unused_168
, NULL
, NOP
)
3076 VM_DEFINE_OP (169, unused_169
, NULL
, NOP
)
3077 VM_DEFINE_OP (170, unused_170
, NULL
, NOP
)
3078 VM_DEFINE_OP (171, unused_171
, NULL
, NOP
)
3079 VM_DEFINE_OP (172, unused_172
, NULL
, NOP
)
3080 VM_DEFINE_OP (173, unused_173
, NULL
, NOP
)
3081 VM_DEFINE_OP (174, unused_174
, NULL
, NOP
)
3082 VM_DEFINE_OP (175, unused_175
, NULL
, NOP
)
3083 VM_DEFINE_OP (176, unused_176
, NULL
, NOP
)
3084 VM_DEFINE_OP (177, unused_177
, NULL
, NOP
)
3085 VM_DEFINE_OP (178, unused_178
, NULL
, NOP
)
3086 VM_DEFINE_OP (179, unused_179
, NULL
, NOP
)
3087 VM_DEFINE_OP (180, unused_180
, NULL
, NOP
)
3088 VM_DEFINE_OP (181, unused_181
, NULL
, NOP
)
3089 VM_DEFINE_OP (182, unused_182
, NULL
, NOP
)
3090 VM_DEFINE_OP (183, unused_183
, NULL
, NOP
)
3091 VM_DEFINE_OP (184, unused_184
, NULL
, NOP
)
3092 VM_DEFINE_OP (185, unused_185
, NULL
, NOP
)
3093 VM_DEFINE_OP (186, unused_186
, NULL
, NOP
)
3094 VM_DEFINE_OP (187, unused_187
, NULL
, NOP
)
3095 VM_DEFINE_OP (188, unused_188
, NULL
, NOP
)
3096 VM_DEFINE_OP (189, unused_189
, NULL
, NOP
)
3097 VM_DEFINE_OP (190, unused_190
, NULL
, NOP
)
3098 VM_DEFINE_OP (191, unused_191
, NULL
, NOP
)
3099 VM_DEFINE_OP (192, unused_192
, NULL
, NOP
)
3100 VM_DEFINE_OP (193, unused_193
, NULL
, NOP
)
3101 VM_DEFINE_OP (194, unused_194
, NULL
, NOP
)
3102 VM_DEFINE_OP (195, unused_195
, NULL
, NOP
)
3103 VM_DEFINE_OP (196, unused_196
, NULL
, NOP
)
3104 VM_DEFINE_OP (197, unused_197
, NULL
, NOP
)
3105 VM_DEFINE_OP (198, unused_198
, NULL
, NOP
)
3106 VM_DEFINE_OP (199, unused_199
, NULL
, NOP
)
3107 VM_DEFINE_OP (200, unused_200
, NULL
, NOP
)
3108 VM_DEFINE_OP (201, unused_201
, NULL
, NOP
)
3109 VM_DEFINE_OP (202, unused_202
, NULL
, NOP
)
3110 VM_DEFINE_OP (203, unused_203
, NULL
, NOP
)
3111 VM_DEFINE_OP (204, unused_204
, NULL
, NOP
)
3112 VM_DEFINE_OP (205, unused_205
, NULL
, NOP
)
3113 VM_DEFINE_OP (206, unused_206
, NULL
, NOP
)
3114 VM_DEFINE_OP (207, unused_207
, NULL
, NOP
)
3115 VM_DEFINE_OP (208, unused_208
, NULL
, NOP
)
3116 VM_DEFINE_OP (209, unused_209
, NULL
, NOP
)
3117 VM_DEFINE_OP (210, unused_210
, NULL
, NOP
)
3118 VM_DEFINE_OP (211, unused_211
, NULL
, NOP
)
3119 VM_DEFINE_OP (212, unused_212
, NULL
, NOP
)
3120 VM_DEFINE_OP (213, unused_213
, NULL
, NOP
)
3121 VM_DEFINE_OP (214, unused_214
, NULL
, NOP
)
3122 VM_DEFINE_OP (215, unused_215
, NULL
, NOP
)
3123 VM_DEFINE_OP (216, unused_216
, NULL
, NOP
)
3124 VM_DEFINE_OP (217, unused_217
, NULL
, NOP
)
3125 VM_DEFINE_OP (218, unused_218
, NULL
, NOP
)
3126 VM_DEFINE_OP (219, unused_219
, NULL
, NOP
)
3127 VM_DEFINE_OP (220, unused_220
, NULL
, NOP
)
3128 VM_DEFINE_OP (221, unused_221
, NULL
, NOP
)
3129 VM_DEFINE_OP (222, unused_222
, NULL
, NOP
)
3130 VM_DEFINE_OP (223, unused_223
, NULL
, NOP
)
3131 VM_DEFINE_OP (224, unused_224
, NULL
, NOP
)
3132 VM_DEFINE_OP (225, unused_225
, NULL
, NOP
)
3133 VM_DEFINE_OP (226, unused_226
, NULL
, NOP
)
3134 VM_DEFINE_OP (227, unused_227
, NULL
, NOP
)
3135 VM_DEFINE_OP (228, unused_228
, NULL
, NOP
)
3136 VM_DEFINE_OP (229, unused_229
, NULL
, NOP
)
3137 VM_DEFINE_OP (230, unused_230
, NULL
, NOP
)
3138 VM_DEFINE_OP (231, unused_231
, NULL
, NOP
)
3139 VM_DEFINE_OP (232, unused_232
, NULL
, NOP
)
3140 VM_DEFINE_OP (233, unused_233
, NULL
, NOP
)
3141 VM_DEFINE_OP (234, unused_234
, NULL
, NOP
)
3142 VM_DEFINE_OP (235, unused_235
, NULL
, NOP
)
3143 VM_DEFINE_OP (236, unused_236
, NULL
, NOP
)
3144 VM_DEFINE_OP (237, unused_237
, NULL
, NOP
)
3145 VM_DEFINE_OP (238, unused_238
, NULL
, NOP
)
3146 VM_DEFINE_OP (239, unused_239
, NULL
, NOP
)
3147 VM_DEFINE_OP (240, unused_240
, NULL
, NOP
)
3148 VM_DEFINE_OP (241, unused_241
, NULL
, NOP
)
3149 VM_DEFINE_OP (242, unused_242
, NULL
, NOP
)
3150 VM_DEFINE_OP (243, unused_243
, NULL
, NOP
)
3151 VM_DEFINE_OP (244, unused_244
, NULL
, NOP
)
3152 VM_DEFINE_OP (245, unused_245
, NULL
, NOP
)
3153 VM_DEFINE_OP (246, unused_246
, NULL
, NOP
)
3154 VM_DEFINE_OP (247, unused_247
, NULL
, NOP
)
3155 VM_DEFINE_OP (248, unused_248
, NULL
, NOP
)
3156 VM_DEFINE_OP (249, unused_249
, NULL
, NOP
)
3157 VM_DEFINE_OP (250, unused_250
, NULL
, NOP
)
3158 VM_DEFINE_OP (251, unused_251
, NULL
, NOP
)
3159 VM_DEFINE_OP (252, unused_252
, NULL
, NOP
)
3160 VM_DEFINE_OP (253, unused_253
, NULL
, NOP
)
3161 VM_DEFINE_OP (254, unused_254
, NULL
, NOP
)
3162 VM_DEFINE_OP (255, unused_255
, NULL
, NOP
)
3164 vm_error_bad_instruction (op
);
3165 abort (); /* never reached */
3168 END_DISPATCH_SWITCH
;
3172 #undef ABORT_CONTINUATION_HOOK
3177 #undef BEGIN_DISPATCH_SWITCH
3178 #undef BINARY_INTEGER_OP
3179 #undef BR_ARITHMETIC
3183 #undef BV_FIXABLE_INT_REF
3184 #undef BV_FIXABLE_INT_SET
3189 #undef CACHE_REGISTER
3190 #undef CHECK_OVERFLOW
3191 #undef END_DISPATCH_SWITCH
3192 #undef FREE_VARIABLE_REF
3201 #undef POP_CONTINUATION_HOOK
3202 #undef PUSH_CONTINUATION_HOOK
3204 #undef RETURN_ONE_VALUE
3205 #undef RETURN_VALUE_LIST
3215 #undef VARIABLE_BOUNDP
3218 #undef VM_CHECK_FREE_VARIABLE
3219 #undef VM_CHECK_OBJECT
3220 #undef VM_CHECK_UNDERFLOW
3222 #undef VM_INSTRUCTION_TO_LABEL
3224 #undef VM_VALIDATE_BYTEVECTOR
3225 #undef VM_VALIDATE_PAIR
3226 #undef VM_VALIDATE_STRUCT
3229 (defun renumber-ops ()
3230 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
3233 (let ((counter -1)) (goto-char (point-min))
3234 (while (re-search-forward "^ *VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
3236 (number-to-string (setq counter (1+ counter)))