HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Remove potential "uninitialized variable" GCC warnings.
[bpt/guile.git] / libguile / vm-i-scheme.c
CommitLineData
60ed31d2 1/* Copyright (C) 2001, 2009 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
53e28ed9 32VM_DEFINE_FUNCTION (80, not, "not", 1)
a98cef7e 33{
a80be762
KN		 34 ARGS1 (x);
35 RETURN (SCM_BOOL (SCM_FALSEP (x)));
17e90c5e
KN		 36}
37
53e28ed9 38VM_DEFINE_FUNCTION (81, not_not, "not-not", 1)
17e90c5e 39{
a80be762
KN		 40 ARGS1 (x);
41 RETURN (SCM_BOOL (!SCM_FALSEP (x)));
17e90c5e
KN		 42}
43
53e28ed9 44VM_DEFINE_FUNCTION (82, eq, "eq?", 2)
17e90c5e 45{
a80be762
KN		 46 ARGS2 (x, y);
47 RETURN (SCM_BOOL (SCM_EQ_P (x, y)));
17e90c5e
KN		 48}
49
53e28ed9 50VM_DEFINE_FUNCTION (83, not_eq, "not-eq?", 2)
17e90c5e 51{
a80be762
KN		 52 ARGS2 (x, y);
53 RETURN (SCM_BOOL (!SCM_EQ_P (x, y)));
17e90c5e
KN		 54}
55
53e28ed9 56VM_DEFINE_FUNCTION (84, nullp, "null?", 1)
17e90c5e 57{
a80be762
KN		 58 ARGS1 (x);
59 RETURN (SCM_BOOL (SCM_NULLP (x)));
a98cef7e
KN		 60}
61
53e28ed9 62VM_DEFINE_FUNCTION (85, not_nullp, "not-null?", 1)
a98cef7e 63{
a80be762
KN		 64 ARGS1 (x);
65 RETURN (SCM_BOOL (!SCM_NULLP (x)));
66}
67
53e28ed9 68VM_DEFINE_FUNCTION (86, eqv, "eqv?", 2)
a80be762
KN		 69{
70 ARGS2 (x, y);
71 if (SCM_EQ_P (x, y))
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
53e28ed9 79VM_DEFINE_FUNCTION (87, equal, "equal?", 2)
a80be762
KN		 80{
81 ARGS2 (x, y);
82 if (SCM_EQ_P (x, y))
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
53e28ed9 90VM_DEFINE_FUNCTION (88, pairp, "pair?", 1)
a98cef7e 91{
a80be762
KN		 92 ARGS1 (x);
93 RETURN (SCM_BOOL (SCM_CONSP (x)));
a98cef7e
KN		 94}
95
53e28ed9 96VM_DEFINE_FUNCTION (89, listp, "list?", 1)
a98cef7e 97{
a80be762
KN		 98 ARGS1 (x);
99 RETURN (SCM_BOOL (scm_ilength (x) >= 0));
a98cef7e
KN		 100}
101
a80be762
KN		 102\f
103/*
104 * Basic data
105 */
106
53e28ed9 107VM_DEFINE_FUNCTION (90, 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
53e28ed9 120VM_DEFINE_FUNCTION (91, 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
53e28ed9 127VM_DEFINE_FUNCTION (92, 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
60ed31d2 134VM_DEFINE_INSTRUCTION (93, 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
60ed31d2 144VM_DEFINE_INSTRUCTION (94, 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
LC		 163 if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
164 RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y))); \
17d1b4bf
AW		 165 SYNC_REGISTER (); \
166 RETURN (srel (x, y)); \
a80be762
KN		 167}
168
53e28ed9 169VM_DEFINE_FUNCTION (95, ee, "ee?", 2)
a80be762
KN		 170{
171 REL (==, scm_num_eq_p);
172}
173
53e28ed9 174VM_DEFINE_FUNCTION (96, lt, "lt?", 2)
a80be762
KN		 175{
176 REL (<, scm_less_p);
177}
178
53e28ed9 179VM_DEFINE_FUNCTION (97, le, "le?", 2)
a80be762
KN		 180{
181 REL (<=, scm_leq_p);
182}
183
53e28ed9 184VM_DEFINE_FUNCTION (98, gt, "gt?", 2)
a80be762
KN		 185{
186 REL (>, scm_gr_p);
187}
188
53e28ed9 189VM_DEFINE_FUNCTION (99, 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
53e28ed9 213VM_DEFINE_FUNCTION (100, add, "add", 2)
a80be762
KN		 214{
215 FUNC2 (+, scm_sum);
216}
217
53e28ed9 218VM_DEFINE_FUNCTION (101, sub, "sub", 2)
a80be762
KN		 219{
220 FUNC2 (-, scm_difference);
221}
222
53e28ed9 223VM_DEFINE_FUNCTION (102, mul, "mul", 2)
a80be762
KN		 224{
225 ARGS2 (x, y);
1865ad56 226 SYNC_REGISTER ();
a80be762
KN		 227 RETURN (scm_product (x, y));
228}
229
53e28ed9 230VM_DEFINE_FUNCTION (103, div, "div", 2)
a80be762
KN		 231{
232 ARGS2 (x, y);
1865ad56 233 SYNC_REGISTER ();
a80be762
KN		 234 RETURN (scm_divide (x, y));
235}
236
53e28ed9 237VM_DEFINE_FUNCTION (104, quo, "quo", 2)
a80be762
KN		 238{
239 ARGS2 (x, y);
1865ad56 240 SYNC_REGISTER ();
a80be762
KN		 241 RETURN (scm_quotient (x, y));
242}
243
53e28ed9 244VM_DEFINE_FUNCTION (105, rem, "rem", 2)
a80be762
KN		 245{
246 ARGS2 (x, y);
1865ad56 247 SYNC_REGISTER ();
a80be762
KN		 248 RETURN (scm_remainder (x, y));
249}
250
53e28ed9 251VM_DEFINE_FUNCTION (106, mod, "mod", 2)
a80be762
KN		 252{
253 ARGS2 (x, y);
1865ad56 254 SYNC_REGISTER ();
a80be762
KN		 255 RETURN (scm_modulo (x, y));
256}
257
1e4b834a
AW		 258\f
259/*
260 * GOOPS support
261 */
53e28ed9 262VM_DEFINE_FUNCTION (107, slot_ref, "slot-ref", 2)
1e4b834a
AW		 263{
264 size_t slot;
265 ARGS2 (instance, idx);
266 slot = SCM_I_INUM (idx);
267 RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot]));
268}
269
60ed31d2 270VM_DEFINE_INSTRUCTION (108, slot_set, "slot-set", 0, 3, 0)
1e4b834a 271{
60ed31d2 272 SCM instance, idx, val;
1e4b834a 273 size_t slot;
60ed31d2
AW		 274 POP (val);
275 POP (idx);
276 POP (instance);
1e4b834a
AW		 277 slot = SCM_I_INUM (idx);
278 SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val);
60ed31d2 279 NEXT;
1e4b834a
AW		 280}
281
d6f1ce3d
AW		 282VM_DEFINE_FUNCTION (109, vector_ref, "vector-ref", 2)
283{
d10c572e 284 long i = 0;
d6f1ce3d
AW		 285 ARGS2 (vect, idx);
286 if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
287 && SCM_I_INUMP (idx)
288 && ((i = SCM_I_INUM (idx)) >= 0)
289 && i < SCM_I_VECTOR_LENGTH (vect)))
290 RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
291 else
292 RETURN (scm_vector_ref (vect, idx));
293}
294
295VM_DEFINE_INSTRUCTION (110, vector_set, "vector-set", 0, 3, 0)
296{
d10c572e 297 long i = 0;
d6f1ce3d
AW		 298 SCM vect, idx, val;
299 POP (val); POP (idx); POP (vect);
300 if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
301 && SCM_I_INUMP (idx)
302 && ((i = SCM_I_INUM (idx)) >= 0)
303 && i < SCM_I_VECTOR_LENGTH (vect)))
304 SCM_I_VECTOR_WELTS (vect)[i] = val;
305 else
306 scm_vector_set_x (vect, idx, val);
307 NEXT;
308}
309
e6eb2467
AW		 310#define VM_VALIDATE_BYTEVECTOR(x) \
311 if (SCM_UNLIKELY (!SCM_BYTEVECTOR_P (x))) \
312 { finish_args = x; \
313 goto vm_error_not_a_bytevector; \
314 }
315
316#define BV_REF_WITH_ENDIANNESS(stem, fn_stem) \
317{ \
318 SCM endianness; \
319 POP (endianness); \
320 if (scm_is_eq (endianness, scm_i_native_endianness)) \
321 goto VM_LABEL (bv_##stem##_native_ref); \
322 { \
323 ARGS2 (bv, idx); \
324 RETURN (scm_bytevector_##fn_stem##_ref (bv, idx, endianness)); \
325 } \
326}
327
d6f1ce3d 328VM_DEFINE_FUNCTION (111, bv_u16_ref, "bv-u16-ref", 3)
e6eb2467 329BV_REF_WITH_ENDIANNESS (u16, u16)
d6f1ce3d 330VM_DEFINE_FUNCTION (112, bv_s16_ref, "bv-s16-ref", 3)
e6eb2467 331BV_REF_WITH_ENDIANNESS (s16, s16)
d6f1ce3d 332VM_DEFINE_FUNCTION (113, bv_u32_ref, "bv-u32-ref", 3)
e6eb2467 333BV_REF_WITH_ENDIANNESS (u32, u32)
d6f1ce3d 334VM_DEFINE_FUNCTION (114, bv_s32_ref, "bv-s32-ref", 3)
e6eb2467 335BV_REF_WITH_ENDIANNESS (s32, s32)
d6f1ce3d 336VM_DEFINE_FUNCTION (115, bv_u64_ref, "bv-u64-ref", 3)
e6eb2467 337BV_REF_WITH_ENDIANNESS (u64, u64)
d6f1ce3d 338VM_DEFINE_FUNCTION (116, bv_s64_ref, "bv-s64-ref", 3)
e6eb2467 339BV_REF_WITH_ENDIANNESS (s64, s64)
d6f1ce3d 340VM_DEFINE_FUNCTION (117, bv_f32_ref, "bv-f32-ref", 3)
e6eb2467 341BV_REF_WITH_ENDIANNESS (f32, ieee_single)
d6f1ce3d 342VM_DEFINE_FUNCTION (118, bv_f64_ref, "bv-f64-ref", 3)
e6eb2467
AW		 343BV_REF_WITH_ENDIANNESS (f64, ieee_double)
344
345#undef BV_REF_WITH_ENDIANNESS
346
347#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
348{ \
d10c572e 349 long i = 0; \
e6eb2467
AW		 350 ARGS2 (bv, idx); \
351 VM_VALIDATE_BYTEVECTOR (bv); \
352 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 353 && ((i = SCM_I_INUM (idx)) >= 0) \
e6eb2467
AW		 354 && (i < SCM_BYTEVECTOR_LENGTH (bv)) \
355 && (i % size == 0))) \
356 RETURN (SCM_I_MAKINUM (*(scm_t_##type*) \
357 (SCM_BYTEVECTOR_CONTENTS (bv) + i))); \
358 else \
359 RETURN (scm_bytevector_##fn_stem##_ref (bv, idx)); \
360}
361
362#define BV_INT_REF(stem, type, size) \
363{ \
d10c572e 364 long i = 0; \
e6eb2467
AW		 365 ARGS2 (bv, idx); \
366 VM_VALIDATE_BYTEVECTOR (bv); \
367 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 368 && ((i = SCM_I_INUM (idx)) >= 0) \
e6eb2467
AW		 369 && (i < SCM_BYTEVECTOR_LENGTH (bv)) \
370 && (i % size == 0))) \
371 { scm_t_##type x = (*(scm_t_##type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)); \
372 if (SCM_FIXABLE (x)) \
373 RETURN (SCM_I_MAKINUM (x)); \
374 else \
375 RETURN (scm_from_##type (x)); \
376 } \
377 else \
378 RETURN (scm_bytevector_##stem##_native_ref (bv, idx)); \
379}
380
381#define BV_FLOAT_REF(stem, fn_stem, type, size) \
382{ \
d10c572e 383 long i = 0; \
e6eb2467
AW		 384 ARGS2 (bv, idx); \
385 VM_VALIDATE_BYTEVECTOR (bv); \
386 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 387 && ((i = SCM_I_INUM (idx)) >= 0) \
e6eb2467
AW		 388 && (i < SCM_BYTEVECTOR_LENGTH (bv)) \
389 && (i % size == 0))) \
390 RETURN (scm_from_double ((*(type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)))); \
391 else \
392 RETURN (scm_bytevector_##fn_stem##_native_ref (bv, idx)); \
393}
394
d6f1ce3d 395VM_DEFINE_FUNCTION (119, bv_u8_ref, "bv-u8-ref", 2)
e6eb2467 396BV_FIXABLE_INT_REF (u8, u8, uint8, 1)
d6f1ce3d 397VM_DEFINE_FUNCTION (120, bv_s8_ref, "bv-s8-ref", 2)
e6eb2467 398BV_FIXABLE_INT_REF (s8, s8, int8, 1)
d6f1ce3d 399VM_DEFINE_FUNCTION (121, bv_u16_native_ref, "bv-u16-native-ref", 2)
e6eb2467 400BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2)
d6f1ce3d 401VM_DEFINE_FUNCTION (122, bv_s16_native_ref, "bv-s16-native-ref", 2)
e6eb2467 402BV_FIXABLE_INT_REF (s16, s16_native, int16, 2)
d6f1ce3d 403VM_DEFINE_FUNCTION (123, bv_u32_native_ref, "bv-u32-native-ref", 2)
e6eb2467
AW		 404/* FIXME: u32 is always a fixnum on 64-bit builds */
405BV_INT_REF (u32, uint32, 4)
d6f1ce3d 406VM_DEFINE_FUNCTION (124, bv_s32_native_ref, "bv-s32-native-ref", 2)
e6eb2467 407BV_INT_REF (s32, int32, 4)
d6f1ce3d 408VM_DEFINE_FUNCTION (125, bv_u64_native_ref, "bv-u64-native-ref", 2)
e6eb2467 409BV_INT_REF (u64, uint64, 8)
d6f1ce3d 410VM_DEFINE_FUNCTION (126, bv_s64_native_ref, "bv-s64-native-ref", 2)
e6eb2467 411BV_INT_REF (s64, int64, 8)
d6f1ce3d 412VM_DEFINE_FUNCTION (127, bv_f32_native_ref, "bv-f32-native-ref", 2)
e6eb2467 413BV_FLOAT_REF (f32, ieee_single, float, 4)
d6f1ce3d 414VM_DEFINE_FUNCTION (128, bv_f64_native_ref, "bv-f64-native-ref", 2)
e6eb2467
AW		 415BV_FLOAT_REF (f64, ieee_double, double, 8)
416
417#undef BV_FIXABLE_INT_REF
418#undef BV_INT_REF
419#undef BV_FLOAT_REF
420
421
422
423#define BV_SET_WITH_ENDIANNESS(stem, fn_stem) \
424{ \
425 SCM endianness; \
426 POP (endianness); \
427 if (scm_is_eq (endianness, scm_i_native_endianness)) \
428 goto VM_LABEL (bv_##stem##_native_set); \
429 { \
d6f1ce3d
AW		 430 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
431 scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \
432 NEXT; \
e6eb2467
AW		 433 } \
434}
435
d6f1ce3d 436VM_DEFINE_INSTRUCTION (129, bv_u16_set, "bv-u16-set", 0, 4, 0)
e6eb2467 437BV_SET_WITH_ENDIANNESS (u16, u16)
d6f1ce3d 438VM_DEFINE_INSTRUCTION (130, bv_s16_set, "bv-s16-set", 0, 4, 0)
e6eb2467 439BV_SET_WITH_ENDIANNESS (s16, s16)
d6f1ce3d 440VM_DEFINE_INSTRUCTION (131, bv_u32_set, "bv-u32-set", 0, 4, 0)
e6eb2467 441BV_SET_WITH_ENDIANNESS (u32, u32)
d6f1ce3d 442VM_DEFINE_INSTRUCTION (132, bv_s32_set, "bv-s32-set", 0, 4, 0)
e6eb2467 443BV_SET_WITH_ENDIANNESS (s32, s32)
d6f1ce3d 444VM_DEFINE_INSTRUCTION (133, bv_u64_set, "bv-u64-set", 0, 4, 0)
e6eb2467 445BV_SET_WITH_ENDIANNESS (u64, u64)
d6f1ce3d 446VM_DEFINE_INSTRUCTION (134, bv_s64_set, "bv-s64-set", 0, 4, 0)
e6eb2467 447BV_SET_WITH_ENDIANNESS (s64, s64)
d6f1ce3d 448VM_DEFINE_INSTRUCTION (135, bv_f32_set, "bv-f32-set", 0, 4, 0)
e6eb2467 449BV_SET_WITH_ENDIANNESS (f32, ieee_single)
d6f1ce3d 450VM_DEFINE_INSTRUCTION (136, bv_f64_set, "bv-f64-set", 0, 4, 0)
e6eb2467
AW		 451BV_SET_WITH_ENDIANNESS (f64, ieee_double)
452
453#undef BV_SET_WITH_ENDIANNESS
454
455#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
456{ \
d10c572e 457 long i = 0, j = 0; \
39141c87 458 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
e6eb2467
AW		 459 VM_VALIDATE_BYTEVECTOR (bv); \
460 if (SCM_LIKELY (SCM_I_INUMP (idx) \
39141c87 461 && ((i = SCM_I_INUM (idx)) >= 0) \
e6eb2467
AW		 462 && (i < SCM_BYTEVECTOR_LENGTH (bv)) \
463 && (i % size == 0) \
464 && (SCM_I_INUMP (val)) \
39141c87 465 && ((j = SCM_I_INUM (val)) >= min) \
e6eb2467
AW		 466 && (j <= max))) \
467 *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = (scm_t_##type)j; \
468 else \
469 scm_bytevector_##fn_stem##_set_x (bv, idx, val); \
470 NEXT; \
471}
472
473#define BV_INT_SET(stem, type, size) \
474{ \
d10c572e 475 long i = 0; \
39141c87 476 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
e6eb2467
AW		 477 VM_VALIDATE_BYTEVECTOR (bv); \
478 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 479 && ((i = SCM_I_INUM (idx)) >= 0) \
e6eb2467
AW		 480 && (i < SCM_BYTEVECTOR_LENGTH (bv)) \
481 && (i % size == 0))) \
482 *(scm_t_##type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_##type (val); \
483 else \
484 scm_bytevector_##stem##_native_set_x (bv, idx, val); \
485 NEXT; \
486}
487
488#define BV_FLOAT_SET(stem, fn_stem, type, size) \
489{ \
d10c572e 490 long i = 0; \
39141c87 491 SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
e6eb2467
AW		 492 VM_VALIDATE_BYTEVECTOR (bv); \
493 if (SCM_LIKELY (SCM_I_INUMP (idx) \
d6f1ce3d 494 && ((i = SCM_I_INUM (idx)) >= 0) \
e6eb2467
AW		 495 && (i < SCM_BYTEVECTOR_LENGTH (bv)) \
496 && (i % size == 0))) \
497 *(type*) (SCM_BYTEVECTOR_CONTENTS (bv) + i) = scm_to_double (val); \
498 else \
499 scm_bytevector_##fn_stem##_native_set_x (bv, idx, val); \
39141c87 500 NEXT; \
e6eb2467
AW		 501}
502
d6f1ce3d 503VM_DEFINE_INSTRUCTION (137, bv_u8_set, "bv-u8-set", 0, 3, 0)
e6eb2467 504BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1)
d6f1ce3d 505VM_DEFINE_INSTRUCTION (138, bv_s8_set, "bv-s8-set", 0, 3, 0)
e6eb2467 506BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1)
d6f1ce3d
AW		 507VM_DEFINE_INSTRUCTION (139, bv_u16_native_set, "bv-u16-native-set", 0, 3, 0)
508BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2)
509VM_DEFINE_INSTRUCTION (140, bv_s16_native_set, "bv-s16-native-set", 0, 3, 0)
510BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2)
511VM_DEFINE_INSTRUCTION (141, bv_u32_native_set, "bv-u32-native-set", 0, 3, 0)
e6eb2467
AW		 512/* FIXME: u32 is always a fixnum on 64-bit builds */
513BV_INT_SET (u32, uint32, 4)
d6f1ce3d 514VM_DEFINE_INSTRUCTION (142, bv_s32_native_set, "bv-s32-native-set", 0, 3, 0)
e6eb2467 515BV_INT_SET (s32, int32, 4)
d6f1ce3d 516VM_DEFINE_INSTRUCTION (143, bv_u64_native_set, "bv-u64-native-set", 0, 3, 0)
e6eb2467 517BV_INT_SET (u64, uint64, 8)
d6f1ce3d 518VM_DEFINE_INSTRUCTION (144, bv_s64_native_set, "bv-s64-native-set", 0, 3, 0)
e6eb2467 519BV_INT_SET (s64, int64, 8)
d6f1ce3d 520VM_DEFINE_INSTRUCTION (145, bv_f32_native_set, "bv-f32-native-set", 0, 3, 0)
e6eb2467 521BV_FLOAT_SET (f32, ieee_single, float, 4)
d6f1ce3d 522VM_DEFINE_INSTRUCTION (146, bv_f64_native_set, "bv-f64-native-set", 0, 3, 0)
e6eb2467
AW		 523BV_FLOAT_SET (f64, ieee_double, double, 8)
524
525#undef BV_FIXABLE_INT_SET
526#undef BV_INT_SET
527#undef BV_FLOAT_SET
528
53e28ed9
AW		 529/*
530(defun renumber-ops ()
531 "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
532 (interactive "")
533 (save-excursion
534 (let ((counter 79)) (goto-char (point-min))
535 (while (re-search-forward "^VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
536 (replace-match
537 (number-to-string (setq counter (1+ counter)))
538 t t nil 1)))))
539*/
1e4b834a 540
17e90c5e
KN		 541/*
542 Local Variables:
543 c-file-style: "gnu"
544 End:
545*/
Unnamed repository; edit this file 'description' to name the repository.