HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
doc: Update "Multi-Threading" node.
[bpt/guile.git] / libguile / vm-i-scheme.c
CommitLineData
73788ca8 1/* Copyright (C) 2001, 2009, 2010 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
AW		 29
30#define RETURN(x) do { *sp = x; NEXT; } while (0)
31
827dc8dc 32VM_DEFINE_FUNCTION (128, not, "not", 1)
a98cef7e 33{
a80be762 34 ARGS1 (x);
9bd48cb1 35 RETURN (scm_from_bool (scm_is_false_or_nil (x)));
17e90c5e
KN		 36}
37
827dc8dc 38VM_DEFINE_FUNCTION (129, not_not, "not-not", 1)
17e90c5e 39{
a80be762 40 ARGS1 (x);
9bd48cb1 41 RETURN (scm_from_bool (!scm_is_false_or_nil (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);
9bd48cb1 59 RETURN (scm_from_bool (scm_is_null_or_nil (x)));
a98cef7e
KN		 60}
61
827dc8dc 62VM_DEFINE_FUNCTION (133, not_nullp, "not-null?", 1)
a98cef7e 63{
a80be762 64 ARGS1 (x);
9bd48cb1 65 RETURN (scm_from_bool (!scm_is_null_or_nil (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
KN		 72 RETURN (SCM_BOOL_T);
73 if (SCM_IMP (x) || SCM_IMP (y))
74 RETURN (SCM_BOOL_F);
1865ad56 75 SYNC_REGISTER ();
a80be762
KN		 76 RETURN (scm_eqv_p (x, y));
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
KN		 83 RETURN (SCM_BOOL_T);
84 if (SCM_IMP (x) || SCM_IMP (y))
85 RETURN (SCM_BOOL_F);
1865ad56 86 SYNC_REGISTER ();
a80be762 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
a80be762
KN		 102\f
103/*
104 * Basic data
105 */
106
827dc8dc 107VM_DEFINE_FUNCTION (138, cons, "cons", 2)
a98cef7e 108{
a80be762
KN		 109 ARGS2 (x, y);
110 CONS (x, x, y);
111 RETURN (x);
a98cef7e
KN		 112}
113
5e390de6
AW		 114#define VM_VALIDATE_CONS(x) \
115 if (SCM_UNLIKELY (!scm_is_pair (x))) \
e06e857c 116 { finish_args = x; \
5e390de6
AW		 117 goto vm_error_not_a_pair; \
118 }
119
827dc8dc 120VM_DEFINE_FUNCTION (139, car, "car", 1)
a98cef7e 121{
a80be762 122 ARGS1 (x);
5e390de6 123 VM_VALIDATE_CONS (x);
a80be762 124 RETURN (SCM_CAR (x));
a98cef7e
KN		 125}
126
827dc8dc 127VM_DEFINE_FUNCTION (140, cdr, "cdr", 1)
a98cef7e 128{
a80be762 129 ARGS1 (x);
5e390de6 130 VM_VALIDATE_CONS (x);
a80be762 131 RETURN (SCM_CDR (x));
a98cef7e
KN		 132}
133
827dc8dc 134VM_DEFINE_INSTRUCTION (141, set_car, "set-car!", 0, 2, 0)
a98cef7e 135{
60ed31d2
AW		 136 SCM x, y;
137 POP (y);
138 POP (x);
5e390de6 139 VM_VALIDATE_CONS (x);
a80be762 140 SCM_SETCAR (x, y);
60ed31d2 141 NEXT;
a98cef7e
KN		 142}
143
827dc8dc 144VM_DEFINE_INSTRUCTION (142, set_cdr, "set-cdr!", 0, 2, 0)
a98cef7e 145{
60ed31d2
AW		 146 SCM x, y;
147 POP (y);
148 POP (x);
5e390de6 149 VM_VALIDATE_CONS (x);
a80be762 150 SCM_SETCDR (x, y);
60ed31d2 151 NEXT;
a98cef7e
KN		 152}
153
a80be762
KN		 154\f
155/*
156 * Numeric relational tests
157 */
158
159#undef REL
d8eeb67c
LC		 160#define REL(crel,srel) \
161{ \
162 ARGS2 (x, y); \
2d80426a 163 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
9bd48cb1 164 RETURN (scm_from_bool (SCM_I_INUM (x) crel SCM_I_INUM (y))); \
17d1b4bf
AW		 165 SYNC_REGISTER (); \
166 RETURN (srel (x, y)); \
a80be762
KN		 167}
168
827dc8dc 169VM_DEFINE_FUNCTION (143, ee, "ee?", 2)
a80be762
KN		 170{
171 REL (==, scm_num_eq_p);
172}
173
827dc8dc 174VM_DEFINE_FUNCTION (144, lt, "lt?", 2)
a80be762
KN		 175{
176 REL (<, scm_less_p);
177}
178
827dc8dc 179VM_DEFINE_FUNCTION (145, le, "le?", 2)
a80be762
KN		 180{
181 REL (<=, scm_leq_p);
182}
183
827dc8dc 184VM_DEFINE_FUNCTION (146, gt, "gt?", 2)
a80be762
KN		 185{
186 REL (>, scm_gr_p);
187}
188
827dc8dc 189VM_DEFINE_FUNCTION (147, ge, "ge?", 2)
a80be762
KN		 190{
191 REL (>=, scm_geq_p);
192}
193
194\f
195/*
196 * Numeric functions
197 */
198
a80be762
KN		 199#undef FUNC2
200#define FUNC2(CFUNC,SFUNC) \
201{ \
d8eeb67c 202 ARGS2 (x, y); \
2d80426a 203 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
a80be762 204 { \
c0ee3245 205 scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y);\
a80be762 206 if (SCM_FIXABLE (n)) \
2d80426a 207 RETURN (SCM_I_MAKINUM (n)); \
a80be762 208 } \
b2642276 209 SYNC_REGISTER (); \
a80be762
KN		 210 RETURN (SFUNC (x, y)); \
211}
212
827dc8dc 213VM_DEFINE_FUNCTION (148, add, "add", 2)
a80be762
KN		 214{
215 FUNC2 (+, scm_sum);
216}
217
827dc8dc 218VM_DEFINE_FUNCTION (149, add1, "add1", 1)
7382f23e
AW		 219{
220 ARGS1 (x);
221 if (SCM_I_INUMP (x))
222 {
223 scm_t_int64 n = SCM_I_INUM (x) + 1;
224 if (SCM_FIXABLE (n))
225 RETURN (SCM_I_MAKINUM (n));
226 }
227 SYNC_REGISTER ();
228 RETURN (scm_sum (x, SCM_I_MAKINUM (1)));
229}
230
827dc8dc 231VM_DEFINE_FUNCTION (150, sub, "sub", 2)
a80be762
KN		 232{
233 FUNC2 (-, scm_difference);
234}
235
827dc8dc 236VM_DEFINE_FUNCTION (151, sub1, "sub1", 1)
7382f23e
AW		 237{
238 ARGS1 (x);
239 if (SCM_I_INUMP (x))
240 {
241 scm_t_int64 n = SCM_I_INUM (x) - 1;
242 if (SCM_FIXABLE (n))
243 RETURN (SCM_I_MAKINUM (n));
244 }
245 SYNC_REGISTER ();
246 RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
247}
248
827dc8dc 249VM_DEFINE_FUNCTION (152, mul, "mul", 2)
a80be762
KN		 250{
251 ARGS2 (x, y);
1865ad56 252 SYNC_REGISTER ();
a80be762
KN		 253 RETURN (scm_product (x, y));
254}
255
827dc8dc 256VM_DEFINE_FUNCTION (153, div, "div", 2)
a80be762
KN		 257{
258 ARGS2 (x, y);
1865ad56 259 SYNC_REGISTER ();
a80be762
KN		 260 RETURN (scm_divide (x, y));
261}
262
827dc8dc 263VM_DEFINE_FUNCTION (154, quo, "quo", 2)
a80be762
KN		 264{
265 ARGS2 (x, y);
1865ad56 266 SYNC_REGISTER ();
a80be762
KN		 267 RETURN (scm_quotient (x, y));
268}
269
827dc8dc 270VM_DEFINE_FUNCTION (155, rem, "rem", 2)
a80be762
KN		 271{
272 ARGS2 (x, y);
1865ad56 273 SYNC_REGISTER ();
a80be762
KN		 274 RETURN (scm_remainder (x, y));
275}
276
827dc8dc 277VM_DEFINE_FUNCTION (156, mod, "mod", 2)
a80be762
KN		 278{
279 ARGS2 (x, y);
1865ad56 280 SYNC_REGISTER ();
a80be762
KN		 281 RETURN (scm_modulo (x, y));
282}
283
827dc8dc 284VM_DEFINE_FUNCTION (157, ash, "ash", 2)
b10d9330
AW		 285{
286 ARGS2 (x, y);
287 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
288 {
289 if (SCM_I_INUM (y) < 0)
290 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y)));
291 else if ((SCM_I_INUM (x) << SCM_I_INUM (y)) >> SCM_I_INUM (y)
292 == SCM_I_INUM (x))
293 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) << SCM_I_INUM (y)));
294 /* fall through */
295 }
296 SYNC_REGISTER ();
297 RETURN (scm_ash (x, y));
298}
299
827dc8dc 300VM_DEFINE_FUNCTION (158, logand, "logand", 2)
b10d9330
AW		 301{
302 ARGS2 (x, y);
303 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
304 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) & SCM_I_INUM (y)));
305 SYNC_REGISTER ();
306 RETURN (scm_logand (x, y));
307}
308
827dc8dc 309VM_DEFINE_FUNCTION (159, logior, "logior", 2)
b10d9330
AW		 310{
311 ARGS2 (x, y);
312 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
313 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) | SCM_I_INUM (y)));
314 SYNC_REGISTER ();
315 RETURN (scm_logior (x, y));
316}
317
827dc8dc 318VM_DEFINE_FUNCTION (160, logxor, "logxor", 2)
b10d9330
AW		 319{
320 ARGS2 (x, y);
321 if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
322 RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
323 SYNC_REGISTER ();
324 RETURN (scm_logxor (x, y));
325}
326
1e4b834a
AW		 327\f
328/*
827dc8dc 329 * Vectors and arrays
1e4b834a 330 */
aec4a84a 331
827dc8dc 332VM_DEFINE_FUNCTION (161, vector_ref, "vector-ref", 2)
d6f1ce3d 333{
d10c572e 334 long i = 0;
d6f1ce3d
AW		 335 ARGS2 (vect, idx);
336 if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
337 && SCM_I_INUMP (idx)
338 && ((i = SCM_I_INUM (idx)) >= 0)
339 && i < SCM_I_VECTOR_LENGTH (vect)))
340 RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
341 else
9b29d607
AW		 342 {
343 SYNC_REGISTER ();
344 RETURN (scm_vector_ref (vect, idx));
345 }
d6f1ce3d
AW		 346}
347
827dc8dc 348VM_DEFINE_INSTRUCTION (162, vector_set, "vector-set", 0, 3, 0)
d6f1ce3d 349{
d10c572e 350 long i = 0;
d6f1ce3d
AW		 351 SCM vect, idx, val;
352 POP (val); POP (idx); POP (vect);
353 if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
354 && SCM_I_INUMP (idx)
355 && ((i = SCM_I_INUM (idx)) >= 0)
356 && i < SCM_I_VECTOR_LENGTH (vect)))
357 SCM_I_VECTOR_WELTS (vect)[i] = val;
358 else
9b29d607
AW		 359 {
360 SYNC_REGISTER ();
361 scm_vector_set_x (vect, idx, val);
362 }
d6f1ce3d
AW		 363 NEXT;
364}
365
827dc8dc
AW		 366VM_DEFINE_INSTRUCTION (163, make_array, "make-array", 3, -1, 1)
367{
368 scm_t_uint32 len;
369 SCM shape, ret;
370
371 len = FETCH ();
372 len = (len << 8) + FETCH ();
373 len = (len << 8) + FETCH ();
374 POP (shape);
375 SYNC_REGISTER ();
376 ret = scm_from_contiguous_array (shape, sp - len + 1, len);
377 DROPN (len);
378 PUSH (ret);
379 NEXT;
380}
381
382\f
383/*
384 * Structs
385 */
386#define VM_VALIDATE_STRUCT(obj) \
387 if (SCM_UNLIKELY (!SCM_STRUCTP (obj))) \
388 { \
389 finish_args = (obj); \
390 goto vm_error_not_a_struct; \
391 }
392
393VM_DEFINE_FUNCTION (164, struct_p, "struct?", 1)
394{
395 ARGS1 (obj);
396 RETURN (scm_from_bool (SCM_STRUCTP (obj)));
397}
398
399VM_DEFINE_FUNCTION (165, struct_vtable, "struct-vtable", 1)
400{
401 ARGS1 (obj);
402 VM_VALIDATE_STRUCT (obj);
403 RETURN (SCM_STRUCT_VTABLE (obj));
404}
405
406VM_DEFINE_INSTRUCTION (166, make_struct, "make-struct", 2, -1, 1)
407{
408 unsigned h = FETCH ();
409 unsigned l = FETCH ();
410 scm_t_bits n_args = ((h << 8U) + l);
411 SCM vtable = sp[1 - n_args], n_tail = sp[2 - n_args];
412 const SCM *inits = sp - n_args + 3;
413
414 sp -= n_args - 1;
415
416 if (SCM_LIKELY (SCM_STRUCTP (vtable)
417 && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
418 && SCM_I_INUMP (n_tail)))
419 {
420 scm_t_bits n_inits, len;
421
422 n_inits = SCM_I_INUM (n_tail) + n_args - 2;
423 len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
424
425 if (SCM_LIKELY (n_inits == len))
426 {
427 SCM obj;
428
429 obj = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), n_inits);
430 memcpy (SCM_STRUCT_DATA (obj), inits, n_inits * sizeof (SCM));
431
432 RETURN (obj);
433 }
434 }
435
436 SYNC_REGISTER ();
437 RETURN (scm_c_make_structv (vtable, scm_to_size_t (n_tail),
438 n_args - 2, (scm_t_bits *) inits));
439}
440
441VM_DEFINE_FUNCTION (167, struct_ref, "struct-ref", 2)
442{
443 ARGS2 (obj, pos);
444
445 if (SCM_LIKELY (SCM_STRUCTP (obj)
446 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
447 SCM_VTABLE_FLAG_SIMPLE)
448 && SCM_I_INUMP (pos)))
449 {
450 SCM vtable;
451 scm_t_bits index, len;
452
453 index = SCM_I_INUM (pos);
454 vtable = SCM_STRUCT_VTABLE (obj);
455 len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
456
457 if (SCM_LIKELY (index < len))
458 {
459 scm_t_bits *data = SCM_STRUCT_DATA (obj);
460 RETURN (SCM_PACK (data[index]));
461 }
462 }
463
464 RETURN (scm_struct_ref (obj, pos));
465}
466
467VM_DEFINE_FUNCTION (168, struct_set, "struct-set", 3)
468{
469 ARGS3 (obj, pos, val);
470
471 if (SCM_LIKELY (SCM_STRUCTP (obj)
472 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
473 SCM_VTABLE_FLAG_SIMPLE)
474 && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
475 SCM_VTABLE_FLAG_SIMPLE_RW)
476 && SCM_I_INUMP (pos)))
477 {
478 SCM vtable;
479 scm_t_bits index, len;
480
481 index = SCM_I_INUM (pos);
482 vtable = SCM_STRUCT_VTABLE (obj);
483 len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
484 if (SCM_LIKELY (index < len))
485 {
486 scm_t_bits *data = SCM_STRUCT_DATA (obj);
487 data[index] = SCM_UNPACK (val);
488 RETURN (val);
489 }
490 }
491
492 RETURN (scm_struct_set_x (obj, pos, val));
493}
494
495\f
496/*
497 * GOOPS support
498 */
499VM_DEFINE_FUNCTION (169, class_of, "class-of", 1)
500{
501 ARGS1 (obj);
502 RETURN (SCM_INSTANCEP (obj) ? SCM_CLASS_OF (obj) : scm_class_of (obj));
503}
504
505VM_DEFINE_FUNCTION (170, slot_ref, "slot-ref", 2)
506{
507 size_t slot;
508 ARGS2 (instance, idx);
509 slot = SCM_I_INUM (idx);
510 RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot]));
511}
512
513VM_DEFINE_INSTRUCTION (171, slot_set, "slot-set", 0, 3, 0)
514{
515 SCM instance, idx, val;
516 size_t slot;
517 POP (val);
518 POP (idx);
519 POP (instance);
520 slot = SCM_I_INUM (idx);
521 SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val);
522 NEXT;
523}
524
525\f
526/*
527 * Bytevectors
528 */
e6eb2467
AW		 529#define VM_VALIDATE_BYTEVECTOR(x) \
530 if (SCM_UNLIKELY (!SCM_BYTEVECTOR_P (x))) \
531 { finish_args = x; \
532 goto vm_error_not_a_bytevector; \
533 }
534
535#define BV_REF_WITH_ENDIANNESS(stem, fn_stem) \
536{ \
537 SCM endianness; \
538 POP (endianness); \
539 if (scm_is_eq (endianness, scm_i_native_endianness)) \
540 goto VM_LABEL (bv_##stem##_native_ref); \
541 { \
542 ARGS2 (bv, idx); \
543 RETURN (scm_bytevector_##fn_stem##_ref (bv, idx, endianness)); \
544 } \
545}
546
827dc8dc 547VM_DEFINE_FUNCTION (172, bv_u16_ref, "bv-u16-ref", 3)
e6eb2467 548BV_REF_WITH_ENDIANNESS (u16, u16)
827dc8dc 549VM_DEFINE_FUNCTION (173, bv_s16_ref, "bv-s16-ref", 3)
e6eb2467 550BV_REF_WITH_ENDIANNESS (s16, s16)
827dc8dc 551VM_DEFINE_FUNCTION (174, bv_u32_ref, "bv-u32-ref", 3)
e6eb2467 552BV_REF_WITH_ENDIANNESS (u32, u32)
827dc8dc 553VM_DEFINE_FUNCTION (175, bv_s32_ref, "bv-s32-ref", 3)
e6eb2467 554BV_REF_WITH_ENDIANNESS (s32, s32)
827dc8dc 555VM_DEFINE_FUNCTION (176, bv_u64_ref, "bv-u64-ref", 3)
e6eb2467 556BV_REF_WITH_ENDIANNESS (u64, u64)
827dc8dc 557VM_DEFINE_FUNCTION (177, bv_s64_ref, "bv-s64-ref", 3)
e6eb2467 558BV_REF_WITH_ENDIANNESS (s64, s64)
827dc8dc 559VM_DEFINE_FUNCTION (178, bv_f32_ref, "bv-f32-ref", 3)
e6eb2467 560BV_REF_WITH_ENDIANNESS (f32, ieee_single)
827dc8dc 561VM_DEFINE_FUNCTION (179, bv_f64_ref, "bv-f64-ref", 3)
e6eb2467
AW		 562BV_REF_WITH_ENDIANNESS (f64, ieee_double)
563
564#undef BV_REF_WITH_ENDIANNESS
565
566#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
567{ \
d10c572e 568 long i = 0; \
e6eb2467
AW		 569 ARGS2 (bv, idx); \
570 VM_VALIDATE_BYTEVECTOR (bv); \
571 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 572 && ((i = SCM_I_INUM (idx)) >= 0) \
cec1d4e3 573 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
e6eb2467
AW		 574 && (i % size == 0))) \
575 RETURN (SCM_I_MAKINUM (*(scm_t_##type*) \
576 (SCM_BYTEVECTOR_CONTENTS (bv) + i))); \
577 else \
578 RETURN (scm_bytevector_##fn_stem##_ref (bv, idx)); \
579}
580
581#define BV_INT_REF(stem, type, size) \
582{ \
d10c572e 583 long i = 0; \
e6eb2467
AW		 584 ARGS2 (bv, idx); \
585 VM_VALIDATE_BYTEVECTOR (bv); \
586 if (SCM_LIKELY (SCM_I_INUMP (idx) \
cec1d4e3
AW		 587 && ((i = SCM_I_INUM (idx)) >= 0) \
588 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
e6eb2467
AW		 589 && (i % size == 0))) \
590 { scm_t_##type x = (*(scm_t_##type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)); \
591 if (SCM_FIXABLE (x)) \
592 RETURN (SCM_I_MAKINUM (x)); \
593 else \
594 RETURN (scm_from_##type (x)); \
595 } \
596 else \
597 RETURN (scm_bytevector_##stem##_native_ref (bv, idx)); \
598}
599
600#define BV_FLOAT_REF(stem, fn_stem, type, size) \
601{ \
d10c572e 602 long i = 0; \
e6eb2467
AW		 603 ARGS2 (bv, idx); \
604 VM_VALIDATE_BYTEVECTOR (bv); \
605 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 606 && ((i = SCM_I_INUM (idx)) >= 0) \
cec1d4e3 607 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
e6eb2467
AW		 608 && (i % size == 0))) \
609 RETURN (scm_from_double ((*(type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)))); \
610 else \
611 RETURN (scm_bytevector_##fn_stem##_native_ref (bv, idx)); \
612}
613
827dc8dc 614VM_DEFINE_FUNCTION (180, bv_u8_ref, "bv-u8-ref", 2)
e6eb2467 615BV_FIXABLE_INT_REF (u8, u8, uint8, 1)
827dc8dc 616VM_DEFINE_FUNCTION (181, bv_s8_ref, "bv-s8-ref", 2)
e6eb2467 617BV_FIXABLE_INT_REF (s8, s8, int8, 1)
827dc8dc 618VM_DEFINE_FUNCTION (182, bv_u16_native_ref, "bv-u16-native-ref", 2)
e6eb2467 619BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2)
827dc8dc 620VM_DEFINE_FUNCTION (183, bv_s16_native_ref, "bv-s16-native-ref", 2)
e6eb2467 621BV_FIXABLE_INT_REF (s16, s16_native, int16, 2)
827dc8dc 622VM_DEFINE_FUNCTION (184, bv_u32_native_ref, "bv-u32-native-ref", 2)
dddacb23
LC		 623#if SIZEOF_VOID_P > 4
624BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4)
625#else
e6eb2467 626BV_INT_REF (u32, uint32, 4)
dddacb23 627#endif
827dc8dc 628VM_DEFINE_FUNCTION (185, bv_s32_native_ref, "bv-s32-native-ref", 2)
dddacb23
LC		 629#if SIZEOF_VOID_P > 4
630BV_FIXABLE_INT_REF (s32, s32_native, int32, 4)
631#else
e6eb2467 632BV_INT_REF (s32, int32, 4)
dddacb23 633#endif
827dc8dc 634VM_DEFINE_FUNCTION (186, bv_u64_native_ref, "bv-u64-native-ref", 2)
e6eb2467 635BV_INT_REF (u64, uint64, 8)
827dc8dc 636VM_DEFINE_FUNCTION (187, bv_s64_native_ref, "bv-s64-native-ref", 2)
e6eb2467 637BV_INT_REF (s64, int64, 8)
827dc8dc 638VM_DEFINE_FUNCTION (188, bv_f32_native_ref, "bv-f32-native-ref", 2)
e6eb2467 639BV_FLOAT_REF (f32, ieee_single, float, 4)
827dc8dc 640VM_DEFINE_FUNCTION (189, bv_f64_native_ref, "bv-f64-native-ref", 2)
e6eb2467
AW		 641BV_FLOAT_REF (f64, ieee_double, double, 8)
642
643#undef BV_FIXABLE_INT_REF
644#undef BV_INT_REF
645#undef BV_FLOAT_REF
646
647
648
649#define BV_SET_WITH_ENDIANNESS(stem, fn_stem) \
650{ \
651 SCM endianness; \
652 POP (endianness); \
653 if (scm_is_eq (endianness, scm_i_native_endianness)) \
654 goto VM_LABEL (bv_##stem##_native_set); \
655 { \
d6f1ce3d
AW		 656 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
657 scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \
658 NEXT; \
e6eb2467
AW		 659 } \
660}
661
827dc8dc 662VM_DEFINE_INSTRUCTION (190, bv_u16_set, "bv-u16-set", 0, 4, 0)
e6eb2467 663BV_SET_WITH_ENDIANNESS (u16, u16)
827dc8dc 664VM_DEFINE_INSTRUCTION (191, bv_s16_set, "bv-s16-set", 0, 4, 0)
e6eb2467 665BV_SET_WITH_ENDIANNESS (s16, s16)
827dc8dc 666VM_DEFINE_INSTRUCTION (192, bv_u32_set, "bv-u32-set", 0, 4, 0)
e6eb2467 667BV_SET_WITH_ENDIANNESS (u32, u32)
827dc8dc 668VM_DEFINE_INSTRUCTION (193, bv_s32_set, "bv-s32-set", 0, 4, 0)
e6eb2467 669BV_SET_WITH_ENDIANNESS (s32, s32)
827dc8dc 670VM_DEFINE_INSTRUCTION (194, bv_u64_set, "bv-u64-set", 0, 4, 0)
e6eb2467 671BV_SET_WITH_ENDIANNESS (u64, u64)
827dc8dc 672VM_DEFINE_INSTRUCTION (195, bv_s64_set, "bv-s64-set", 0, 4, 0)
e6eb2467 673BV_SET_WITH_ENDIANNESS (s64, s64)
827dc8dc 674VM_DEFINE_INSTRUCTION (196, bv_f32_set, "bv-f32-set", 0, 4, 0)
e6eb2467 675BV_SET_WITH_ENDIANNESS (f32, ieee_single)
827dc8dc 676VM_DEFINE_INSTRUCTION (197, bv_f64_set, "bv-f64-set", 0, 4, 0)
e6eb2467
AW		 677BV_SET_WITH_ENDIANNESS (f64, ieee_double)
678
679#undef BV_SET_WITH_ENDIANNESS
680
681#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
682{ \
d10c572e 683 long i = 0, j = 0; \
39141c87 684 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
e6eb2467
AW		 685 VM_VALIDATE_BYTEVECTOR (bv); \
686 if (SCM_LIKELY (SCM_I_INUMP (idx) \
39141c87 687 && ((i = SCM_I_INUM (idx)) >= 0) \
cec1d4e3 688 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
e6eb2467
AW		 689 && (i % size == 0) \
690 && (SCM_I_INUMP (val)) \
39141c87 691 && ((j = SCM_I_INUM (val)) >= min) \
e6eb2467
AW		 692 && (j <= max))) \
693 *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = (scm_t_##type)j; \
694 else \
695 scm_bytevector_##fn_stem##_set_x (bv, idx, val); \
696 NEXT; \
697}
698
699#define BV_INT_SET(stem, type, size) \
700{ \
d10c572e 701 long i = 0; \
39141c87 702 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
e6eb2467
AW		 703 VM_VALIDATE_BYTEVECTOR (bv); \
704 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 705 && ((i = SCM_I_INUM (idx)) >= 0) \
cec1d4e3 706 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
e6eb2467
AW		 707 && (i % size == 0))) \
708 *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_##type (val); \
709 else \
710 scm_bytevector_##stem##_native_set_x (bv, idx, val); \
711 NEXT; \
712}
713
714#define BV_FLOAT_SET(stem, fn_stem, type, size) \
715{ \
d10c572e 716 long i = 0; \
39141c87 717 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
e6eb2467
AW		 718 VM_VALIDATE_BYTEVECTOR (bv); \
719 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 720 && ((i = SCM_I_INUM (idx)) >= 0) \
cec1d4e3 721 && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
e6eb2467
AW		 722 && (i % size == 0))) \
723 *(type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_double (val); \
724 else \
725 scm_bytevector_##fn_stem##_native_set_x (bv, idx, val); \
39141c87 726 NEXT; \
e6eb2467
AW		 727}
728
827dc8dc 729VM_DEFINE_INSTRUCTION (198, bv_u8_set, "bv-u8-set", 0, 3, 0)
e6eb2467 730BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1)
827dc8dc 731VM_DEFINE_INSTRUCTION (199, bv_s8_set, "bv-s8-set", 0, 3, 0)
e6eb2467 732BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1)
827dc8dc 733VM_DEFINE_INSTRUCTION (200, bv_u16_native_set, "bv-u16-native-set", 0, 3, 0)
d6f1ce3d 734BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2)
827dc8dc 735VM_DEFINE_INSTRUCTION (201, bv_s16_native_set, "bv-s16-native-set", 0, 3, 0)
d6f1ce3d 736BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2)
827dc8dc 737VM_DEFINE_INSTRUCTION (202, bv_u32_native_set, "bv-u32-native-set", 0, 3, 0)
dddacb23
LC		 738#if SIZEOF_VOID_P > 4
739BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4)
740#else
e6eb2467 741BV_INT_SET (u32, uint32, 4)
dddacb23 742#endif
827dc8dc 743VM_DEFINE_INSTRUCTION (203, bv_s32_native_set, "bv-s32-native-set", 0, 3, 0)
dddacb23
LC		 744#if SIZEOF_VOID_P > 4
745BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4)
746#else
e6eb2467 747BV_INT_SET (s32, int32, 4)
dddacb23 748#endif
827dc8dc 749VM_DEFINE_INSTRUCTION (204, bv_u64_native_set, "bv-u64-native-set", 0, 3, 0)
e6eb2467 750BV_INT_SET (u64, uint64, 8)
827dc8dc 751VM_DEFINE_INSTRUCTION (205, bv_s64_native_set, "bv-s64-native-set", 0, 3, 0)
e6eb2467 752BV_INT_SET (s64, int64, 8)
827dc8dc 753VM_DEFINE_INSTRUCTION (206, bv_f32_native_set, "bv-f32-native-set", 0, 3, 0)
e6eb2467 754BV_FLOAT_SET (f32, ieee_single, float, 4)
827dc8dc 755VM_DEFINE_INSTRUCTION (207, bv_f64_native_set, "bv-f64-native-set", 0, 3, 0)
e6eb2467
AW		 756BV_FLOAT_SET (f64, ieee_double, double, 8)
757
758#undef BV_FIXABLE_INT_SET
759#undef BV_INT_SET
760#undef BV_FLOAT_SET
761
53e28ed9
AW		 762/*
763(defun renumber-ops ()
764 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
765 (interactive "")
766 (save-excursion
827dc8dc 767 (let ((counter 127)) (goto-char (point-min))
53e28ed9
AW		 768 (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
769 (replace-match
770 (number-to-string (setq counter (1+ counter)))
771 t t nil 1)))))
772*/
1e4b834a 773
17e90c5e
KN		 774/*
775 Local Variables:
776 c-file-style: "gnu"
777 End:
778*/
Unnamed repository; edit this file 'description' to name the repository.