HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix SCM_SMOB_OBJECT{_,_0_,_1_,_2_,_3_}LOC.
[bpt/guile.git] / libguile / vm-i-scheme.c
CommitLineData
a85c78ea 1/* Copyright (C) 2001, 2009-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
KN		 18
19/* This file is included in vm_engine.c */
20
a80be762
KN		 21\f
22/*
23 * Predicates
24 */
25
93d197be 26#define ARGS1(a1) SCM a1 = sp[0];
11ea1aba
AW		 27#define ARGS2(a1,a2) SCM a1 = sp[-1], a2 = sp[0]; sp--; NULLSTACK (1);
28#define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2; NULLSTACK (2);
93d197be 29
a18e13a5 30#define RETURN(x) do { *sp = x; NEXT; } while (0)
93d197be 31
827dc8dc 32VM_DEFINE_FUNCTION (128, not, "not", 1)
a98cef7e 33{
a80be762 34 ARGS1 (x);
2533f10b 35 RETURN (scm_from_bool (scm_is_false (x)));
17e90c5e
KN		 36}
37
827dc8dc 38VM_DEFINE_FUNCTION (129, not_not, "not-not", 1)
17e90c5e 39{
a80be762 40 ARGS1 (x);
2533f10b 41 RETURN (scm_from_bool (!scm_is_false (x)));
17e90c5e
KN		 42}
43
827dc8dc 44VM_DEFINE_FUNCTION (130, eq, "eq?", 2)
17e90c5e 45{
a80be762 46 ARGS2 (x, y);
5c8cefe5 47 RETURN (scm_from_bool (scm_is_eq (x, y)));
17e90c5e
KN		 48}
49
827dc8dc 50VM_DEFINE_FUNCTION (131, not_eq, "not-eq?", 2)
17e90c5e 51{
a80be762 52 ARGS2 (x, y);
5c8cefe5 53 RETURN (scm_from_bool (!scm_is_eq (x, y)));
17e90c5e
KN		 54}
55
827dc8dc 56VM_DEFINE_FUNCTION (132, nullp, "null?", 1)
17e90c5e 57{
a80be762 58 ARGS1 (x);
2533f10b 59 RETURN (scm_from_bool (scm_is_null (x)));
a98cef7e
KN		 60}
61
827dc8dc 62VM_DEFINE_FUNCTION (133, not_nullp, "not-null?", 1)
a98cef7e 63{
a80be762 64 ARGS1 (x);
2533f10b 65 RETURN (scm_from_bool (!scm_is_null (x)));
a80be762
KN		 66}
67
827dc8dc 68VM_DEFINE_FUNCTION (134, eqv, "eqv?", 2)
a80be762
KN		 69{
70 ARGS2 (x, y);
5c8cefe5 71 if (scm_is_eq (x, y))
a80be762 72 RETURN (SCM_BOOL_T);
a18e13a5 73 if (SCM_IMP (x) || SCM_IMP (y))
a80be762 74 RETURN (SCM_BOOL_F);
a18e13a5
AW		 75 SYNC_REGISTER ();
76 RETURN (scm_eqv_p (x, y));
a80be762
KN		 77}
78
827dc8dc 79VM_DEFINE_FUNCTION (135, equal, "equal?", 2)
a80be762
KN		 80{
81 ARGS2 (x, y);
5c8cefe5 82 if (scm_is_eq (x, y))
a80be762 83 RETURN (SCM_BOOL_T);
a18e13a5 84 if (SCM_IMP (x) || SCM_IMP (y))
a80be762 85 RETURN (SCM_BOOL_F);
a18e13a5
AW		 86 SYNC_REGISTER ();
87 RETURN (scm_equal_p (x, y));
a98cef7e
KN		 88}
89
827dc8dc 90VM_DEFINE_FUNCTION (136, pairp, "pair?", 1)
a98cef7e 91{
a80be762 92 ARGS1 (x);
5c8cefe5 93 RETURN (scm_from_bool (scm_is_pair (x)));
a98cef7e
KN		 94}
95
827dc8dc 96VM_DEFINE_FUNCTION (137, listp, "list?", 1)
a98cef7e 97{
a80be762 98 ARGS1 (x);
9bd48cb1 99 RETURN (scm_from_bool (scm_ilength (x) >= 0));
a98cef7e
KN		 100}
101
cf45ff03
AW		 102VM_DEFINE_FUNCTION (138, symbolp, "symbol?", 1)
103{
104 ARGS1 (x);
105 RETURN (scm_from_bool (scm_is_symbol (x)));
106}
107
108VM_DEFINE_FUNCTION (139, vectorp, "vector?", 1)
109{
110 ARGS1 (x);
111 RETURN (scm_from_bool (SCM_I_IS_VECTOR (x)));
112}
113
a80be762
KN		 114\f
115/*
116 * Basic data
117 */
118
cf45ff03 119VM_DEFINE_FUNCTION (140, cons, "cons", 2)
a98cef7e 120{
a80be762
KN		 121 ARGS2 (x, y);
122 CONS (x, x, y);
123 RETURN (x);
a98cef7e
KN		 124}
125
41e49280 126#define VM_VALIDATE_CONS(x, proc) \
53bdfcf0 127 VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x))
5e390de6 128
cf45ff03 129VM_DEFINE_FUNCTION (141, car, "car", 1)
a98cef7e 130{
a80be762 131 ARGS1 (x);
41e49280 132 VM_VALIDATE_CONS (x, "car");
a80be762 133 RETURN (SCM_CAR (x));
a98cef7e
KN		 134}
135
cf45ff03 136VM_DEFINE_FUNCTION (142, cdr, "cdr", 1)
a98cef7e 137{
a80be762 138 ARGS1 (x);
41e49280 139 VM_VALIDATE_CONS (x, "cdr");
a80be762 140 RETURN (SCM_CDR (x));
a98cef7e
KN		 141}
142
cf45ff03 143VM_DEFINE_INSTRUCTION (143, set_car, "set-car!", 0, 2, 0)
a98cef7e 144{
60ed31d2 145 SCM x, y;
eae2438d 146 POP2 (y, x);
41e49280 147 VM_VALIDATE_CONS (x, "set-car!");
a80be762 148 SCM_SETCAR (x, y);
60ed31d2 149 NEXT;
a98cef7e
KN		 150}
151
cf45ff03 152VM_DEFINE_INSTRUCTION (144, set_cdr, "set-cdr!", 0, 2, 0)
a98cef7e 153{
60ed31d2 154 SCM x, y;
eae2438d 155 POP2 (y, x);
41e49280 156 VM_VALIDATE_CONS (x, "set-cdr!");
a80be762 157 SCM_SETCDR (x, y);
60ed31d2 158 NEXT;
a98cef7e
KN		 159}
160
a80be762
KN		 161\f
162/*
163 * Numeric relational tests
164 */
165
166#undef REL
b2b33168
AW		 167#define REL(crel,srel) \
168 { \
169 ARGS2 (x, y); \
170 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
171 RETURN (scm_from_bool (((scm_t_signed_bits) SCM_UNPACK (x)) \
172 crel ((scm_t_signed_bits) SCM_UNPACK (y)))); \
a18e13a5
AW		 173 SYNC_REGISTER (); \
174 RETURN (srel (x, y)); \
b2b33168 175 }
a80be762 176
cf45ff03 177VM_DEFINE_FUNCTION (145, ee, "ee?", 2)
a80be762
KN		 178{
179 REL (==, scm_num_eq_p);
180}
181
cf45ff03 182VM_DEFINE_FUNCTION (146, lt, "lt?", 2)
a80be762
KN		 183{
184 REL (<, scm_less_p);
185}
186
cf45ff03 187VM_DEFINE_FUNCTION (147, le, "le?", 2)
a80be762
KN		 188{
189 REL (<=, scm_leq_p);
190}
191
cf45ff03 192VM_DEFINE_FUNCTION (148, gt, "gt?", 2)
a80be762
KN		 193{
194 REL (>, scm_gr_p);
195}
196
cf45ff03 197VM_DEFINE_FUNCTION (149, ge, "ge?", 2)
a80be762
KN		 198{
199 REL (>=, scm_geq_p);
200}
201
202\f
203/*
204 * Numeric functions
205 */
206
e78d4bf9 207/* The maximum/minimum tagged integers. */
0c57673a
LC		 208#undef INUM_MAX
209#undef INUM_MIN
cb1482e7 210#undef INUM_STEP
478fa0d5
MW		 211#define INUM_MAX \
212 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
213#define INUM_MIN \
214 ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
cb1482e7
MW		 215#define INUM_STEP \
216 ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
217 - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
e78d4bf9 218
a80be762 219#undef FUNC2
a18e13a5
AW		 220#define FUNC2(CFUNC,SFUNC) \
221{ \
222 ARGS2 (x, y); \
223 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
224 { \
225 scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y);\
226 if (SCM_FIXABLE (n)) \
227 RETURN (SCM_I_MAKINUM (n)); \
228 } \
229 SYNC_REGISTER (); \
230 RETURN (SFUNC (x, y)); \
231}
a80be762 232
0c57673a
LC		 233/* Assembly tagged integer arithmetic routines. This code uses the
234 `asm goto' feature introduced in GCC 4.5. */
235
9f621170
MW		 236#if SCM_GNUC_PREREQ (4, 5) && (defined __x86_64__ || defined __i386__)
237
238# undef _CX
f07fa851 239# if SIZEOF_VOID_P == 8
9f621170 240# define _CX "rcx"
f07fa851 241# elif SIZEOF_VOID_P == 4
9f621170 242# define _CX "ecx"
f07fa851
MW		 243# else
244# error unsupported word size
9f621170 245# endif
0c57673a
LC		 246
247/* The macros below check the CPU's overflow flag to improve fixnum
9f621170
MW		 248 arithmetic. The _CX register (%rcx or %ecx) is explicitly
249 clobbered because `asm goto' can't have outputs, in which case the
250 `r' constraint could be used to let the register allocator choose a
251 register.
0c57673a
LC		 252
253 TODO: Use `cold' label attribute in GCC 4.6.
254 http://gcc.gnu.org/ml/gcc-patches/2010-10/msg01777.html */
255
256# define ASM_ADD(x, y) \
257 { \
9f621170
MW		 258 asm volatile goto ("mov %1, %%"_CX"; " \
259 "test %[tag], %%cl; je %l[slow_add]; " \
260 "test %[tag], %0; je %l[slow_add]; " \
261 "sub %[tag], %%"_CX"; " \
262 "add %0, %%"_CX"; jo %l[slow_add]; " \
263 "mov %%"_CX", (%[vsp])\n" \
0c57673a
LC		 264 : /* no outputs */ \
265 : "r" (x), "r" (y), \
266 [vsp] "r" (sp), [tag] "i" (scm_tc2_int) \
48b6f151 267 : _CX, "memory", "cc" \
0c57673a
LC		 268 : slow_add); \
269 NEXT; \
270 } \
271 slow_add: \
272 do { } while (0)
273
274# define ASM_SUB(x, y) \
275 { \
9f621170
MW		 276 asm volatile goto ("mov %0, %%"_CX"; " \
277 "test %[tag], %%cl; je %l[slow_sub]; " \
278 "test %[tag], %1; je %l[slow_sub]; " \
279 "sub %1, %%"_CX"; jo %l[slow_sub]; " \
280 "add %[tag], %%"_CX"; " \
281 "mov %%"_CX", (%[vsp])\n" \
0c57673a
LC		 282 : /* no outputs */ \
283 : "r" (x), "r" (y), \
284 [vsp] "r" (sp), [tag] "i" (scm_tc2_int) \
48b6f151 285 : _CX, "memory", "cc" \
0c57673a
LC		 286 : slow_sub); \
287 NEXT; \
288 } \
289 slow_sub: \
290 do { } while (0)
291
4fa65b90
MW		 292# define ASM_MUL(x, y) \
293 { \
294 scm_t_signed_bits xx = SCM_I_INUM (x); \
295 asm volatile goto ("mov %1, %%"_CX"; " \
296 "test %[tag], %%cl; je %l[slow_mul]; " \
297 "sub %[tag], %%"_CX"; " \
298 "test %[tag], %0; je %l[slow_mul]; " \
299 "imul %2, %%"_CX"; jo %l[slow_mul]; " \
300 "add %[tag], %%"_CX"; " \
301 "mov %%"_CX", (%[vsp])\n" \
302 : /* no outputs */ \
303 : "r" (x), "r" (y), "r" (xx), \
304 [vsp] "r" (sp), [tag] "i" (scm_tc2_int) \
305 : _CX, "memory", "cc" \
306 : slow_mul); \
307 NEXT; \
308 } \
309 slow_mul: \
310 do { } while (0)
311
0c57673a
LC		 312#endif
313
f91a1864
MW		 314#if SCM_GNUC_PREREQ (4, 5) && defined __arm__
315
316# define ASM_ADD(x, y) \
317 if (SCM_LIKELY (SCM_I_INUMP (x) && SCM_I_INUMP (y))) \
318 { \
319 asm volatile goto ("adds r0, %0, %1; bvs %l[slow_add]; " \
320 "str r0, [%[vsp]]\n" \
321 : /* no outputs */ \
322 : "r" (x), "r" (y - scm_tc2_int), \
323 [vsp] "r" (sp) \
324 : "r0", "memory", "cc" \
325 : slow_add); \
326 NEXT; \
327 } \
328 slow_add: \
329 do { } while (0)
330
331# define ASM_SUB(x, y) \
332 if (SCM_LIKELY (SCM_I_INUMP (x) && SCM_I_INUMP (y))) \
333 { \
334 asm volatile goto ("subs r0, %0, %1; bvs %l[slow_sub]; " \
335 "str r0, [%[vsp]]\n" \
336 : /* no outputs */ \
337 : "r" (x), "r" (y - scm_tc2_int), \
338 [vsp] "r" (sp) \
339 : "r0", "memory", "cc" \
340 : slow_sub); \
341 NEXT; \
342 } \
343 slow_sub: \
344 do { } while (0)
345
afa3c37d
MW		 346# if defined (__ARM_ARCH_3M__) || defined (__ARM_ARCH_4__) \
347 || defined (__ARM_ARCH_4T__) || defined (__ARM_ARCH_5__) \
348 || defined (__ARM_ARCH_5T__) || defined (__ARM_ARCH_5E__) \
349 || defined (__ARM_ARCH_5TE__) || defined (__ARM_ARCH_5TEJ__) \
350 || defined (__ARM_ARCH_6__) || defined (__ARM_ARCH_6J__) \
351 || defined (__ARM_ARCH_6K__) || defined (__ARM_ARCH_6Z__) \
352 || defined (__ARM_ARCH_6ZK__) || defined (__ARM_ARCH_6T2__) \
353 || defined (__ARM_ARCH_6M__) || defined (__ARM_ARCH_7__) \
354 || defined (__ARM_ARCH_7A__) || defined (__ARM_ARCH_7R__) \
355 || defined (__ARM_ARCH_7M__) || defined (__ARM_ARCH_7EM__) \
356 || defined (__ARM_ARCH_8A__)
357
358/* The ARM architectures listed above support the SMULL instruction */
359
360# define ASM_MUL(x, y) \
f91a1864
MW		 361 if (SCM_LIKELY (SCM_I_INUMP (x) && SCM_I_INUMP (y))) \
362 { \
363 scm_t_signed_bits rlo, rhi; \
364 asm ("smull %0, %1, %2, %3\n" \
a85c78ea 365 : "=&r" (rlo), "=&r" (rhi) \
f91a1864
MW		 366 : "r" (SCM_UNPACK (x) - scm_tc2_int), \
367 "r" (SCM_I_INUM (y))); \
368 if (SCM_LIKELY (SCM_SRS (rlo, 31) == rhi)) \
369 RETURN (SCM_PACK (rlo + scm_tc2_int)); \
370 } \
371 do { } while (0)
372
afa3c37d
MW		 373# endif
374
f91a1864 375#endif
0c57673a 376
cf45ff03 377VM_DEFINE_FUNCTION (150, add, "add", 2)
a80be762 378{
0c57673a 379#ifndef ASM_ADD
a80be762 380 FUNC2 (+, scm_sum);
0c57673a
LC		 381#else
382 ARGS2 (x, y);
383 ASM_ADD (x, y);
384 SYNC_REGISTER ();
385 RETURN (scm_sum (x, y));
386#endif
a80be762
KN		 387}
388
cf45ff03 389VM_DEFINE_FUNCTION (151, add1, "add1", 1)
7382f23e
AW		 390{
391 ARGS1 (x);
e78d4bf9 392
cb1482e7
MW		 393 /* Check for overflow. We must avoid overflow in the signed
394 addition below, even if X is not an inum. */
395 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) <= INUM_MAX - INUM_STEP))
7382f23e 396 {
e78d4bf9
LC		 397 SCM result;
398
cb1482e7
MW		 399 /* Add 1 to the integer without untagging. */
400 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) + INUM_STEP);
e78d4bf9
LC		 401
402 if (SCM_LIKELY (SCM_I_INUMP (result)))
a18e13a5 403 RETURN (result);
7382f23e 404 }
e78d4bf9 405
7382f23e
AW		 406 SYNC_REGISTER ();
407 RETURN (scm_sum (x, SCM_I_MAKINUM (1)));
408}
409
cf45ff03 410VM_DEFINE_FUNCTION (152, sub, "sub", 2)
a80be762 411{
0c57673a 412#ifndef ASM_SUB
a80be762 413 FUNC2 (-, scm_difference);
0c57673a
LC		 414#else
415 ARGS2 (x, y);
416 ASM_SUB (x, y);
417 SYNC_REGISTER ();
418 RETURN (scm_difference (x, y));
419#endif
a80be762
KN		 420}
421
cf45ff03 422VM_DEFINE_FUNCTION (153, sub1, "sub1", 1)
7382f23e
AW		 423{
424 ARGS1 (x);
e78d4bf9 425
cb1482e7
MW		 426 /* Check for overflow. We must avoid overflow in the signed
427 subtraction below, even if X is not an inum. */
428 if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) >= INUM_MIN + INUM_STEP))
7382f23e 429 {
e78d4bf9
LC		 430 SCM result;
431
cb1482e7
MW		 432 /* Substract 1 from the integer without untagging. */
433 result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) - INUM_STEP);
e78d4bf9
LC		 434
435 if (SCM_LIKELY (SCM_I_INUMP (result)))
a18e13a5 436 RETURN (result);
7382f23e 437 }
e78d4bf9 438
7382f23e
AW		 439 SYNC_REGISTER ();
440 RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
441}
442
cf45ff03 443VM_DEFINE_FUNCTION (154, mul, "mul", 2)
a80be762
KN		 444{
445 ARGS2 (x, y);
4fa65b90
MW		 446#ifdef ASM_MUL
447 ASM_MUL (x, y);
448#endif
1865ad56 449 SYNC_REGISTER ();
a80be762
KN		 450 RETURN (scm_product (x, y));
451}
452
4fa65b90
MW		 453# undef ASM_ADD
454# undef ASM_SUB
455# undef ASM_MUL
456
cf45ff03 457VM_DEFINE_FUNCTION (155, div, "div", 2)
a80be762
KN		 458{
459 ARGS2 (x, y);
1865ad56 460 SYNC_REGISTER ();
a80be762
KN		 461 RETURN (scm_divide (x, y));
462}
463
cf45ff03 464VM_DEFINE_FUNCTION (156, quo, "quo", 2)
a80be762
KN		 465{
466 ARGS2 (x, y);
1865ad56 467 SYNC_REGISTER ();
a80be762
KN		 468 RETURN (scm_quotient (x, y));
469}
470
cf45ff03 471VM_DEFINE_FUNCTION (157, rem, "rem", 2)
a80be762
KN		 472{
473 ARGS2 (x, y);
1865ad56 474 SYNC_REGISTER ();
a80be762
KN		 475 RETURN (scm_remainder (x, y));
476}
477
cf45ff03 478VM_DEFINE_FUNCTION (158, mod, "mod", 2)
a80be762
KN		 479{
480 ARGS2 (x, y);
1865ad56 481 SYNC_REGISTER ();
a80be762
KN		 482 RETURN (scm_modulo (x, y));
483}
484
cf45ff03 485VM_DEFINE_FUNCTION (159, ash, "ash", 2)
b10d9330
AW		 486{
487 ARGS2 (x, y);
488 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
489 {
490 if (SCM_I_INUM (y) < 0)
ca7b6f68
MW		 491 /* Right shift, will be a fixnum. */
492 RETURN (SCM_I_MAKINUM
493 (SCM_SRS (SCM_I_INUM (x),
494 (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1)
495 ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1)));
8ecd1943
AW		 496 else
497 /* Left shift. See comments in scm_ash. */
498 {
e25f3727 499 scm_t_signed_bits nn, bits_to_shift;
8ecd1943
AW		 500
501 nn = SCM_I_INUM (x);
502 bits_to_shift = SCM_I_INUM (y);
503
504 if (bits_to_shift < SCM_I_FIXNUM_BIT-1
e25f3727 505 && ((scm_t_bits)
8ecd1943
AW		 506 (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
507 <= 1))
03cce0ce
MW		 508 RETURN (SCM_I_MAKINUM (nn < 0
509 ? -(-nn << bits_to_shift)
510 : (nn << bits_to_shift)));
8ecd1943
AW		 511 /* fall through */
512 }
b10d9330
AW		 513 /* fall through */
514 }
515 SYNC_REGISTER ();
516 RETURN (scm_ash (x, y));
517}
518
cf45ff03 519VM_DEFINE_FUNCTION (160, logand, "logand", 2)
b10d9330
AW		 520{
521 ARGS2 (x, y);
a18e13a5 522 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
b2df1682
MW		 523 /* Compute bitwise AND without untagging */
524 RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
a18e13a5
AW		 525 SYNC_REGISTER ();
526 RETURN (scm_logand (x, y));
b10d9330
AW		 527}
528
cf45ff03 529VM_DEFINE_FUNCTION (161, logior, "logior", 2)
b10d9330
AW		 530{
531 ARGS2 (x, y);
a18e13a5 532 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
b2df1682
MW		 533 /* Compute bitwise OR without untagging */
534 RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
a18e13a5
AW		 535 SYNC_REGISTER ();
536 RETURN (scm_logior (x, y));
b10d9330
AW		 537}
538
cf45ff03 539VM_DEFINE_FUNCTION (162, logxor, "logxor", 2)
b10d9330
AW		 540{
541 ARGS2 (x, y);
a18e13a5 542 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
b10d9330 543 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
a18e13a5
AW		 544 SYNC_REGISTER ();
545 RETURN (scm_logxor (x, y));
b10d9330
AW		 546}
547
1e4b834a
AW		 548\f
549/*
827dc8dc 550 * Vectors and arrays
1e4b834a 551 */
aec4a84a 552
cf45ff03 553VM_DEFINE_FUNCTION (163, vector_ref, "vector-ref", 2)
d6f1ce3d 554{
e25f3727 555 scm_t_signed_bits i = 0;
d6f1ce3d 556 ARGS2 (vect, idx);
7b702b53 557 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
d6f1ce3d
AW		 558 && SCM_I_INUMP (idx)
559 && ((i = SCM_I_INUM (idx)) >= 0)
560 && i < SCM_I_VECTOR_LENGTH (vect)))
561 RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
562 else
9b29d607
AW		 563 {
564 SYNC_REGISTER ();
565 RETURN (scm_vector_ref (vect, idx));
566 }
d6f1ce3d
AW		 567}
568
cf45ff03 569VM_DEFINE_INSTRUCTION (164, vector_set, "vector-set", 0, 3, 0)
d6f1ce3d 570{
e25f3727 571 scm_t_signed_bits i = 0;
d6f1ce3d 572 SCM vect, idx, val;
eae2438d 573 POP3 (val, idx, vect);
7b702b53 574 if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
d6f1ce3d
AW		 575 && SCM_I_INUMP (idx)
576 && ((i = SCM_I_INUM (idx)) >= 0)
577 && i < SCM_I_VECTOR_LENGTH (vect)))
578 SCM_I_VECTOR_WELTS (vect)[i] = val;
579 else
9b29d607
AW		 580 {
581 SYNC_REGISTER ();
582 scm_vector_set_x (vect, idx, val);
583 }
d6f1ce3d
AW		 584 NEXT;
585}
586
cf45ff03 587VM_DEFINE_INSTRUCTION (165, make_array, "make-array", 3, -1, 1)
827dc8dc
AW		 588{
589 scm_t_uint32 len;
590 SCM shape, ret;
591
592 len = FETCH ();
593 len = (len << 8) + FETCH ();
594 len = (len << 8) + FETCH ();
595 POP (shape);
596 SYNC_REGISTER ();
384dce46 597 PRE_CHECK_UNDERFLOW (len);
827dc8dc
AW		 598 ret = scm_from_contiguous_array (shape, sp - len + 1, len);
599 DROPN (len);
600 PUSH (ret);
601 NEXT;
602}
603
604\f
605/*
606 * Structs
607 */
41e49280 608#define VM_VALIDATE_STRUCT(obj, proc) \
776491ca 609 VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_struct (proc, obj))
827dc8dc 610
cf45ff03 611VM_DEFINE_FUNCTION (166, struct_p, "struct?", 1)
827dc8dc
AW		 612{
613 ARGS1 (obj);
614 RETURN (scm_from_bool (SCM_STRUCTP (obj)));
615}
616
cf45ff03 617VM_DEFINE_FUNCTION (167, struct_vtable, "struct-vtable", 1)
827dc8dc
AW		 618{
619 ARGS1 (obj);
41e49280 620 VM_VALIDATE_STRUCT (obj, "struct_vtable");
827dc8dc
AW		 621 RETURN (SCM_STRUCT_VTABLE (obj));
622}
623
cf45ff03 624VM_DEFINE_INSTRUCTION (168, make_struct, "make-struct", 2, -1, 1)
827dc8dc
AW		 625{
626 unsigned h = FETCH ();
627 unsigned l = FETCH ();
9a974fd3
AW		 628 scm_t_bits n = ((h << 8U) + l);
629 SCM vtable = sp[-(n - 1)];
630 const SCM *inits = sp - n + 2;
631 SCM ret;
827dc8dc 632
9823fd39
LC		 633 SYNC_REGISTER ();
634
827dc8dc
AW		 635 if (SCM_LIKELY (SCM_STRUCTP (vtable)
636 && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
9a974fd3
AW		 637 && (SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size) + 1
638 == n)
639 && !SCM_VTABLE_INSTANCE_FINALIZER (vtable)))
827dc8dc 640 {
9a974fd3
AW		 641 /* Verily, we are making a simple struct with the right number of
642 initializers, and no finalizer. */
643 ret = scm_words ((scm_t_bits)SCM_STRUCT_DATA (vtable) | scm_tc3_struct,
644 n + 1);
645 SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
646 memcpy (SCM_STRUCT_DATA (ret), inits, (n - 1) * sizeof (SCM));
827dc8dc 647 }
9a974fd3
AW		 648 else
649 ret = scm_c_make_structv (vtable, 0, n - 1, (scm_t_bits *) inits);
650
c99865c1 651 DROPN (n);
9a974fd3 652 PUSH (ret);
827dc8dc 653
9a974fd3 654 NEXT;
827dc8dc
AW		 655}
656
cf45ff03 657VM_DEFINE_FUNCTION (169, struct_ref, "struct-ref", 2)
827dc8dc
AW		 658{
659 ARGS2 (obj, pos);
660
661 if (SCM_LIKELY (SCM_STRUCTP (obj)
662 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
663 SCM_VTABLE_FLAG_SIMPLE)
664 && SCM_I_INUMP (pos)))
665 {
666 SCM vtable;
667 scm_t_bits index, len;
668
e25f3727
AW		 669 /* True, an inum is a signed value, but cast to unsigned it will
670 certainly be more than the length, so we will fall through if
671 index is negative. */
827dc8dc
AW		 672 index = SCM_I_INUM (pos);
673 vtable = SCM_STRUCT_VTABLE (obj);
674 len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
675
676 if (SCM_LIKELY (index < len))
677 {
a18e13a5
AW		 678 scm_t_bits *data = SCM_STRUCT_DATA (obj);
679 RETURN (SCM_PACK (data[index]));
827dc8dc
AW		 680 }
681 }
682
9823fd39 683 SYNC_REGISTER ();
827dc8dc
AW		 684 RETURN (scm_struct_ref (obj, pos));
685}
686
cf45ff03 687VM_DEFINE_FUNCTION (170, struct_set, "struct-set", 3)
827dc8dc
AW		 688{
689 ARGS3 (obj, pos, val);
690
691 if (SCM_LIKELY (SCM_STRUCTP (obj)
692 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
693 SCM_VTABLE_FLAG_SIMPLE)
694 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
695 SCM_VTABLE_FLAG_SIMPLE_RW)
696 && SCM_I_INUMP (pos)))
697 {
698 SCM vtable;
699 scm_t_bits index, len;
700
e25f3727 701 /* See above regarding index being >= 0. */
827dc8dc
AW		 702 index = SCM_I_INUM (pos);
703 vtable = SCM_STRUCT_VTABLE (obj);
704 len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
705 if (SCM_LIKELY (index < len))
706 {
a18e13a5
AW		 707 scm_t_bits *data = SCM_STRUCT_DATA (obj);
708 data[index] = SCM_UNPACK (val);
709 RETURN (val);
827dc8dc
AW		 710 }
711 }
712
9823fd39 713 SYNC_REGISTER ();
827dc8dc
AW		 714 RETURN (scm_struct_set_x (obj, pos, val));
715}
716
717\f
718/*
719 * GOOPS support
720 */
cf45ff03 721VM_DEFINE_FUNCTION (171, class_of, "class-of", 1)
827dc8dc
AW		 722{
723 ARGS1 (obj);
1a461493
AW		 724 if (SCM_INSTANCEP (obj))
725 RETURN (SCM_CLASS_OF (obj));
a18e13a5
AW		 726 SYNC_REGISTER ();
727 RETURN (scm_class_of (obj));
827dc8dc
AW		 728}
729
e25f3727 730/* FIXME: No checking whatsoever. */
cf45ff03 731VM_DEFINE_FUNCTION (172, slot_ref, "slot-ref", 2)
827dc8dc
AW		 732{
733 size_t slot;
734 ARGS2 (instance, idx);
735 slot = SCM_I_INUM (idx);
736 RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot]));
737}
738
e25f3727 739/* FIXME: No checking whatsoever. */
cf45ff03 740VM_DEFINE_INSTRUCTION (173, slot_set, "slot-set", 0, 3, 0)
827dc8dc
AW		 741{
742 SCM instance, idx, val;
743 size_t slot;
eae2438d 744 POP3 (val, idx, instance);
827dc8dc
AW		 745 slot = SCM_I_INUM (idx);
746 SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val);
747 NEXT;
748}
749
750\f
751/*
752 * Bytevectors
753 */
41e49280 754#define VM_VALIDATE_BYTEVECTOR(x, proc) \
53bdfcf0 755 VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x))
e6eb2467
AW		 756
757#define BV_REF_WITH_ENDIANNESS(stem, fn_stem) \
758{ \
759 SCM endianness; \
760 POP (endianness); \
761 if (scm_is_eq (endianness, scm_i_native_endianness)) \
a39b116f 762 goto VM_LABEL (bv_##stem##_native_ref); \
e6eb2467
AW		 763 { \
764 ARGS2 (bv, idx); \
9823fd39 765 SYNC_REGISTER (); \
e6eb2467
AW		 766 RETURN (scm_bytevector_##fn_stem##_ref (bv, idx, endianness)); \
767 } \
768}
769
daccfef4
LC		 770/* Return true (non-zero) if PTR has suitable alignment for TYPE. */
771#define ALIGNED_P(ptr, type) \
1002c774 772 ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
daccfef4 773
cf45ff03 774VM_DEFINE_FUNCTION (174, bv_u16_ref, "bv-u16-ref", 3)
e6eb2467 775BV_REF_WITH_ENDIANNESS (u16, u16)
cf45ff03 776VM_DEFINE_FUNCTION (175, bv_s16_ref, "bv-s16-ref", 3)
e6eb2467 777BV_REF_WITH_ENDIANNESS (s16, s16)
cf45ff03 778VM_DEFINE_FUNCTION (176, bv_u32_ref, "bv-u32-ref", 3)
e6eb2467 779BV_REF_WITH_ENDIANNESS (u32, u32)
cf45ff03 780VM_DEFINE_FUNCTION (177, bv_s32_ref, "bv-s32-ref", 3)
e6eb2467 781BV_REF_WITH_ENDIANNESS (s32, s32)
cf45ff03 782VM_DEFINE_FUNCTION (178, bv_u64_ref, "bv-u64-ref", 3)
e6eb2467 783BV_REF_WITH_ENDIANNESS (u64, u64)
cf45ff03 784VM_DEFINE_FUNCTION (179, bv_s64_ref, "bv-s64-ref", 3)
e6eb2467 785BV_REF_WITH_ENDIANNESS (s64, s64)
cf45ff03 786VM_DEFINE_FUNCTION (180, bv_f32_ref, "bv-f32-ref", 3)
e6eb2467 787BV_REF_WITH_ENDIANNESS (f32, ieee_single)
cf45ff03 788VM_DEFINE_FUNCTION (181, bv_f64_ref, "bv-f64-ref", 3)
e6eb2467
AW		 789BV_REF_WITH_ENDIANNESS (f64, ieee_double)
790
791#undef BV_REF_WITH_ENDIANNESS
792
9823fd39
LC		 793#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
794{ \
e25f3727 795 scm_t_signed_bits i; \
daccfef4 796 const scm_t_ ## type *int_ptr; \
9823fd39 797 ARGS2 (bv, idx); \
daccfef4 798 \
41e49280 799 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
daccfef4
LC		 800 i = SCM_I_INUM (idx); \
801 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
802 \
9823fd39 803 if (SCM_LIKELY (SCM_I_INUMP (idx) \
daccfef4 804 && (i >= 0) \
9823fd39 805 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
daccfef4 806 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
a18e13a5 807 RETURN (SCM_I_MAKINUM (*int_ptr)); \
9823fd39
LC		 808 else \
809 { \
810 SYNC_REGISTER (); \
a18e13a5 811 RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx)); \
9823fd39
LC		 812 } \
813}
814
815#define BV_INT_REF(stem, type, size) \
816{ \
e25f3727 817 scm_t_signed_bits i; \
daccfef4 818 const scm_t_ ## type *int_ptr; \
9823fd39 819 ARGS2 (bv, idx); \
daccfef4 820 \
41e49280 821 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
daccfef4
LC		 822 i = SCM_I_INUM (idx); \
823 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
824 \
9823fd39 825 if (SCM_LIKELY (SCM_I_INUMP (idx) \
daccfef4 826 && (i >= 0) \
9823fd39 827 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
daccfef4
LC		 828 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
829 { \
830 scm_t_ ## type x = *int_ptr; \
9823fd39
LC		 831 if (SCM_FIXABLE (x)) \
832 RETURN (SCM_I_MAKINUM (x)); \
833 else \
834 { \
835 SYNC_REGISTER (); \
836 RETURN (scm_from_ ## type (x)); \
837 } \
838 } \
839 else \
840 { \
841 SYNC_REGISTER (); \
842 RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx)); \
843 } \
844}
845
846#define BV_FLOAT_REF(stem, fn_stem, type, size) \
847{ \
e25f3727 848 scm_t_signed_bits i; \
daccfef4 849 const type *float_ptr; \
9823fd39 850 ARGS2 (bv, idx); \
daccfef4 851 \
41e49280 852 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
daccfef4
LC		 853 i = SCM_I_INUM (idx); \
854 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
855 \
9823fd39
LC		 856 SYNC_REGISTER (); \
857 if (SCM_LIKELY (SCM_I_INUMP (idx) \
daccfef4 858 && (i >= 0) \
9823fd39 859 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
daccfef4
LC		 860 && (ALIGNED_P (float_ptr, type)))) \
861 RETURN (scm_from_double (*float_ptr)); \
9823fd39
LC		 862 else \
863 RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
e6eb2467
AW		 864}
865
cf45ff03 866VM_DEFINE_FUNCTION (182, bv_u8_ref, "bv-u8-ref", 2)
e6eb2467 867BV_FIXABLE_INT_REF (u8, u8, uint8, 1)
cf45ff03 868VM_DEFINE_FUNCTION (183, bv_s8_ref, "bv-s8-ref", 2)
e6eb2467 869BV_FIXABLE_INT_REF (s8, s8, int8, 1)
cf45ff03 870VM_DEFINE_FUNCTION (184, bv_u16_native_ref, "bv-u16-native-ref", 2)
e6eb2467 871BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2)
cf45ff03 872VM_DEFINE_FUNCTION (185, bv_s16_native_ref, "bv-s16-native-ref", 2)
e6eb2467 873BV_FIXABLE_INT_REF (s16, s16_native, int16, 2)
cf45ff03 874VM_DEFINE_FUNCTION (186, bv_u32_native_ref, "bv-u32-native-ref", 2)
dddacb23
LC		 875#if SIZEOF_VOID_P > 4
876BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4)
877#else
e6eb2467 878BV_INT_REF (u32, uint32, 4)
dddacb23 879#endif
cf45ff03 880VM_DEFINE_FUNCTION (187, bv_s32_native_ref, "bv-s32-native-ref", 2)
dddacb23
LC		 881#if SIZEOF_VOID_P > 4
882BV_FIXABLE_INT_REF (s32, s32_native, int32, 4)
883#else
e6eb2467 884BV_INT_REF (s32, int32, 4)
dddacb23 885#endif
cf45ff03 886VM_DEFINE_FUNCTION (188, bv_u64_native_ref, "bv-u64-native-ref", 2)
e6eb2467 887BV_INT_REF (u64, uint64, 8)
cf45ff03 888VM_DEFINE_FUNCTION (189, bv_s64_native_ref, "bv-s64-native-ref", 2)
e6eb2467 889BV_INT_REF (s64, int64, 8)
cf45ff03 890VM_DEFINE_FUNCTION (190, bv_f32_native_ref, "bv-f32-native-ref", 2)
e6eb2467 891BV_FLOAT_REF (f32, ieee_single, float, 4)
cf45ff03 892VM_DEFINE_FUNCTION (191, bv_f64_native_ref, "bv-f64-native-ref", 2)
e6eb2467
AW		 893BV_FLOAT_REF (f64, ieee_double, double, 8)
894
895#undef BV_FIXABLE_INT_REF
896#undef BV_INT_REF
897#undef BV_FLOAT_REF
898
899
900
901#define BV_SET_WITH_ENDIANNESS(stem, fn_stem) \
902{ \
903 SCM endianness; \
904 POP (endianness); \
905 if (scm_is_eq (endianness, scm_i_native_endianness)) \
a39b116f 906 goto VM_LABEL (bv_##stem##_native_set); \
e6eb2467 907 { \
eae2438d 908 SCM bv, idx, val; POP3 (val, idx, bv); \
ad301b6d 909 SYNC_REGISTER (); \
d6f1ce3d
AW		 910 scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \
911 NEXT; \
e6eb2467
AW		 912 } \
913}
914
cf45ff03 915VM_DEFINE_INSTRUCTION (192, bv_u16_set, "bv-u16-set", 0, 4, 0)
e6eb2467 916BV_SET_WITH_ENDIANNESS (u16, u16)
cf45ff03 917VM_DEFINE_INSTRUCTION (193, bv_s16_set, "bv-s16-set", 0, 4, 0)
e6eb2467 918BV_SET_WITH_ENDIANNESS (s16, s16)
cf45ff03 919VM_DEFINE_INSTRUCTION (194, bv_u32_set, "bv-u32-set", 0, 4, 0)
e6eb2467 920BV_SET_WITH_ENDIANNESS (u32, u32)
cf45ff03 921VM_DEFINE_INSTRUCTION (195, bv_s32_set, "bv-s32-set", 0, 4, 0)
e6eb2467 922BV_SET_WITH_ENDIANNESS (s32, s32)
cf45ff03 923VM_DEFINE_INSTRUCTION (196, bv_u64_set, "bv-u64-set", 0, 4, 0)
e6eb2467 924BV_SET_WITH_ENDIANNESS (u64, u64)
cf45ff03 925VM_DEFINE_INSTRUCTION (197, bv_s64_set, "bv-s64-set", 0, 4, 0)
e6eb2467 926BV_SET_WITH_ENDIANNESS (s64, s64)
cf45ff03 927VM_DEFINE_INSTRUCTION (198, bv_f32_set, "bv-f32-set", 0, 4, 0)
e6eb2467 928BV_SET_WITH_ENDIANNESS (f32, ieee_single)
cf45ff03 929VM_DEFINE_INSTRUCTION (199, bv_f64_set, "bv-f64-set", 0, 4, 0)
e6eb2467
AW		 930BV_SET_WITH_ENDIANNESS (f64, ieee_double)
931
932#undef BV_SET_WITH_ENDIANNESS
933
daccfef4
LC		 934#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
935{ \
e25f3727 936 scm_t_signed_bits i, j = 0; \
daccfef4
LC		 937 SCM bv, idx, val; \
938 scm_t_ ## type *int_ptr; \
939 \
eae2438d 940 POP3 (val, idx, bv); \
41e49280 941 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
daccfef4
LC		 942 i = SCM_I_INUM (idx); \
943 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
944 \
945 if (SCM_LIKELY (SCM_I_INUMP (idx) \
946 && (i >= 0) \
947 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
948 && (ALIGNED_P (int_ptr, scm_t_ ## type)) \
949 && (SCM_I_INUMP (val)) \
950 && ((j = SCM_I_INUM (val)) >= min) \
951 && (j <= max))) \
952 *int_ptr = (scm_t_ ## type) j; \
953 else \
ad301b6d
AW		 954 { \
955 SYNC_REGISTER (); \
956 scm_bytevector_ ## fn_stem ## _set_x (bv, idx, val); \
957 } \
daccfef4
LC		 958 NEXT; \
959}
960
961#define BV_INT_SET(stem, type, size) \
962{ \
e25f3727 963 scm_t_signed_bits i = 0; \
daccfef4
LC		 964 SCM bv, idx, val; \
965 scm_t_ ## type *int_ptr; \
966 \
eae2438d 967 POP3 (val, idx, bv); \
41e49280 968 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
daccfef4
LC		 969 i = SCM_I_INUM (idx); \
970 int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
971 \
972 if (SCM_LIKELY (SCM_I_INUMP (idx) \
973 && (i >= 0) \
974 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
975 && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
976 *int_ptr = scm_to_ ## type (val); \
977 else \
ad301b6d
AW		 978 { \
979 SYNC_REGISTER (); \
980 scm_bytevector_ ## stem ## _native_set_x (bv, idx, val); \
981 } \
982 NEXT; \
daccfef4
LC		 983}
984
ad301b6d
AW		 985#define BV_FLOAT_SET(stem, fn_stem, type, size) \
986{ \
987 scm_t_signed_bits i = 0; \
988 SCM bv, idx, val; \
989 type *float_ptr; \
990 \
eae2438d 991 POP3 (val, idx, bv); \
ad301b6d
AW		 992 VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
993 i = SCM_I_INUM (idx); \
994 float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
995 \
996 if (SCM_LIKELY (SCM_I_INUMP (idx) \
997 && (i >= 0) \
998 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
999 && (ALIGNED_P (float_ptr, type)))) \
1000 *float_ptr = scm_to_double (val); \
1001 else \
1002 { \
1003 SYNC_REGISTER (); \
1004 scm_bytevector_ ## fn_stem ## _native_set_x (bv, idx, val); \
1005 } \
1006 NEXT; \
e6eb2467
AW		 1007}
1008
cf45ff03 1009VM_DEFINE_INSTRUCTION (200, bv_u8_set, "bv-u8-set", 0, 3, 0)
e6eb2467 1010BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1)
cf45ff03 1011VM_DEFINE_INSTRUCTION (201, bv_s8_set, "bv-s8-set", 0, 3, 0)
e6eb2467 1012BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1)
cf45ff03 1013VM_DEFINE_INSTRUCTION (202, bv_u16_native_set, "bv-u16-native-set", 0, 3, 0)
d6f1ce3d 1014BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2)
cf45ff03 1015VM_DEFINE_INSTRUCTION (203, bv_s16_native_set, "bv-s16-native-set", 0, 3, 0)
d6f1ce3d 1016BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2)
cf45ff03 1017VM_DEFINE_INSTRUCTION (204, bv_u32_native_set, "bv-u32-native-set", 0, 3, 0)
dddacb23
LC		 1018#if SIZEOF_VOID_P > 4
1019BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4)
1020#else
e6eb2467 1021BV_INT_SET (u32, uint32, 4)
dddacb23 1022#endif
cf45ff03 1023VM_DEFINE_INSTRUCTION (205, bv_s32_native_set, "bv-s32-native-set", 0, 3, 0)
dddacb23
LC		 1024#if SIZEOF_VOID_P > 4
1025BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4)
1026#else
e6eb2467 1027BV_INT_SET (s32, int32, 4)
dddacb23 1028#endif
cf45ff03 1029VM_DEFINE_INSTRUCTION (206, bv_u64_native_set, "bv-u64-native-set", 0, 3, 0)
e6eb2467 1030BV_INT_SET (u64, uint64, 8)
cf45ff03 1031VM_DEFINE_INSTRUCTION (207, bv_s64_native_set, "bv-s64-native-set", 0, 3, 0)
e6eb2467 1032BV_INT_SET (s64, int64, 8)
cf45ff03 1033VM_DEFINE_INSTRUCTION (208, bv_f32_native_set, "bv-f32-native-set", 0, 3, 0)
e6eb2467 1034BV_FLOAT_SET (f32, ieee_single, float, 4)
cf45ff03 1035VM_DEFINE_INSTRUCTION (209, bv_f64_native_set, "bv-f64-native-set", 0, 3, 0)
e6eb2467
AW		 1036BV_FLOAT_SET (f64, ieee_double, double, 8)
1037
1038#undef BV_FIXABLE_INT_SET
1039#undef BV_INT_SET
1040#undef BV_FLOAT_SET
1041
53e28ed9
AW		 1042/*
1043(defun renumber-ops ()
1044 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
1045 (interactive "")
1046 (save-excursion
827dc8dc 1047 (let ((counter 127)) (goto-char (point-min))
53e28ed9
AW		 1048 (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
1049 (replace-match
1050 (number-to-string (setq counter (1+ counter)))
1051 t t nil 1)))))
1052*/
1e4b834a 1053
17e90c5e
KN		 1054/*
1055 Local Variables:
1056 c-file-style: "gnu"
1057 End:
1058*/
Unnamed repository; edit this file 'description' to name the repository.