?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Removed silly micro-optimisations that duplicated code unnecessarily.
[panda.git] / src / st-primitives.c
blob78721a08abf2bf0f86c0c3e0dfacb4846ced5966
1 /*
2 * st-primitives.c
3 *
4 * Copyright (C) 2008 Vincent Geddes
5 *
6 * Permission is hereby granted, free of charge, to any person obtaining a copy
7 * of this software and associated documentation files (the "Software"), to deal
8 * in the Software without restriction, including without limitation the rights
9 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
10 * copies of the Software, and to permit persons to whom the Software is
11 * furnished to do so, subject to the following conditions:
12 *
13 * The above copyright notice and this permission notice shall be included in
14 * all copies or substantial portions of the Software.
15 *
16 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
17 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
18 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
19 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
20 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
21 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
22 * THE SOFTWARE.
23 */
24
25 #include "st-primitives.h"
26 #include "st-cpu.h"
27 #include "st-array.h"
28 #include "st-large-integer.h"
29 #include "st-float.h"
30 #include "st-array.h"
31 #include "st-object.h"
32 #include "st-behavior.h"
33 #include "st-context.h"
34 #include "st-method.h"
35 #include "st-symbol.h"
36 #include "st-character.h"
37 #include "st-dictionary.h"
38 #include "st-unicode.h"
39 #include "st-compiler.h"
40
41 #include <math.h>
42 #include <string.h>
43 #include <stdlib.h>
44 #include <setjmp.h>
45 #include <errno.h>
46 #include <fcntl.h>
47 #include <unistd.h>
48 #include <sys/stat.h>
49
50
51 #define ST_PRIMITIVE_FAIL(cpu) \
52 cpu->success = false
53
54
55 static inline void
56 set_success (struct st_cpu *cpu, bool success)
57 {
58 cpu->success = cpu->success && success;
59 }
60
61 static inline int
62 pop_integer (struct st_cpu *cpu)
63 {
64 st_oop object = ST_STACK_POP (cpu);
65
66 if (ST_LIKELY (st_object_is_smi (object)))
67 return st_smi_value (object);
68
69 ST_PRIMITIVE_FAIL (cpu);
70 return 0;
71 }
72
73 static inline int
74 pop_integer32 (struct st_cpu *cpu)
75 {
76 st_oop object = ST_STACK_POP (cpu);
77
78 if (ST_LIKELY (st_object_is_smi (object)))
79 return st_smi_value (object);
80 else if (st_object_class (object) == ST_LARGE_INTEGER_CLASS)
81 return (int) mp_get_int (st_large_integer_value (object));
82
83 ST_PRIMITIVE_FAIL (cpu);
84 return 0;
85 }
86
87 static void
88 SmallInteger_add (struct st_cpu *cpu)
89 {
90 int y = pop_integer (cpu);
91 int x = pop_integer (cpu);
92 int result;
93
94 if (ST_LIKELY (cpu->success)) {
95 result = x + y;
96 if (((result << 1) ^ (result << 2)) >= 0) {
97 ST_STACK_PUSH (cpu, st_smi_new (result));
98 return;
99 } else {
100 ST_PRIMITIVE_FAIL (cpu);
101 }
102 }
103
104 ST_STACK_UNPOP (cpu, 2);
105 }
106
107 static void
108 SmallInteger_sub (struct st_cpu *cpu)
109 {
110 int y = pop_integer (cpu);
111 int x = pop_integer (cpu);
112 int result;
113
114
115 if (ST_LIKELY (cpu->success)) {
116 result = x + y;
117 if (((result << 1) ^ (result << 2)) >= 0) {
118 ST_STACK_PUSH (cpu, st_smi_new (result));
119 return;
120 } else {
121 ST_PRIMITIVE_FAIL (cpu);
122 }
123 }
124
125 ST_STACK_UNPOP (cpu, 2);
126 }
127
128 static void
129 SmallInteger_lt (struct st_cpu *cpu)
130 {
131 int y = pop_integer (cpu);
132 int x = pop_integer (cpu);
133 st_oop result;
134
135 if (ST_LIKELY (cpu->success)) {
136 result = (x < y) ? ST_TRUE : ST_FALSE;
137 ST_STACK_PUSH (cpu, result);
138 return;
139 }
140
141 ST_STACK_UNPOP (cpu, 2);
142 }
143
144 static void
145 SmallInteger_gt (struct st_cpu *cpu)
146 {
147 int y = pop_integer (cpu);
148 int x = pop_integer (cpu);
149 st_oop result;
150
151 if (ST_LIKELY (cpu->success)) {
152 result = (x > y) ? ST_TRUE : ST_FALSE;
153 ST_STACK_PUSH (cpu, result);
154 return;
155 }
156
157 ST_STACK_UNPOP (cpu, 2);
158 }
159
160 static void
161 SmallInteger_le (struct st_cpu *cpu)
162 {
163 int y = pop_integer (cpu);
164 int x = pop_integer (cpu);
165 st_oop result;
166
167 if (ST_LIKELY (cpu->success)) {
168 result = (x <= y) ? ST_TRUE : ST_FALSE;
169 ST_STACK_PUSH (cpu, result);
170 return;
171 }
172
173 ST_STACK_UNPOP (cpu, 2);
174 }
175
176 static void
177 SmallInteger_ge (struct st_cpu *cpu)
178 {
179 int y = pop_integer (cpu);
180 int x = pop_integer (cpu);
181 st_oop result;
182
183 if (ST_LIKELY (cpu->success)) {
184 result = (x >= y) ? ST_TRUE : ST_FALSE;
185 ST_STACK_PUSH (cpu, result);
186 return;
187 }
188
189 ST_STACK_UNPOP (cpu, 2);
190 }
191
192 static void
193 SmallInteger_eq (struct st_cpu *cpu)
194 {
195 int y = pop_integer (cpu);
196 int x = pop_integer (cpu);
197 st_oop result;
198
199 if (ST_LIKELY (cpu->success)) {
200 result = (x == y) ? ST_TRUE : ST_FALSE;
201 ST_STACK_PUSH (cpu, result);
202 return;
203 }
204
205 ST_STACK_UNPOP (cpu, 2);
206 }
207
208 static void
209 SmallInteger_ne (struct st_cpu *cpu)
210 {
211 int y = pop_integer (cpu);
212 int x = pop_integer (cpu);
213 st_oop result;
214
215 if (ST_LIKELY (cpu->success)) {
216 result = (x != y) ? ST_TRUE : ST_FALSE;
217 ST_STACK_PUSH (cpu, result);
218 return;
219 }
220
221 ST_STACK_UNPOP (cpu, 2);
222 }
223
224 static void
225 SmallInteger_mul (struct st_cpu *cpu)
226 {
227 int y = pop_integer (cpu);
228 int x = pop_integer (cpu);
229 int64_t result;
230
231 if (cpu->success) {
232 result = x * y;
233 if (result >= ST_SMALL_INTEGER_MIN && result <= ST_SMALL_INTEGER_MAX) {
234 ST_STACK_PUSH (cpu, st_smi_new ((int) result));
235 return;
236 } else {
237 ST_PRIMITIVE_FAIL (cpu);
238 }
239 }
240
241 ST_STACK_UNPOP (cpu, 2);
242 }
243
244 /* selector: / */
245 static void
246 SmallInteger_div (struct st_cpu *cpu)
247 {
248 int y = pop_integer (cpu);
249 int x = pop_integer (cpu);
250 st_oop result;
251
252 if (ST_LIKELY (cpu->success)) {
253
254 if (y != 0 && x % y == 0) {
255 result = st_smi_new (x / y);
256 ST_STACK_PUSH (cpu, result);
257 return;
258 } else {
259 ST_PRIMITIVE_FAIL (cpu);
260 }
261 }
262
263 ST_STACK_UNPOP (cpu, 2);
264 }
265
266 static void
267 SmallInteger_intDiv (struct st_cpu *cpu)
268 {
269 int y = pop_integer (cpu);
270 int x = pop_integer (cpu);
271 st_oop result;
272
273 if (ST_LIKELY (cpu->success)) {
274
275 if (y != 0) {
276 result = st_smi_new (x / y);
277 ST_STACK_PUSH (cpu, result);
278 return;
279 } else {
280 ST_PRIMITIVE_FAIL (cpu);
281 }
282 }
283
284 ST_STACK_UNPOP (cpu, 2);
285 }
286
287 static void
288 SmallInteger_mod (struct st_cpu *cpu)
289 {
290 int y = pop_integer (cpu);
291 int x = pop_integer (cpu);
292 st_oop result;
293
294 if (ST_LIKELY (cpu->success)) {
295 result = st_smi_new (x % y);
296 ST_STACK_PUSH (cpu, result);
297 return;
298 }
299
300 ST_STACK_UNPOP (cpu, 2);
301 }
302
303 static void
304 SmallInteger_bitOr (struct st_cpu *cpu)
305 {
306 int y = pop_integer (cpu);
307 int x = pop_integer (cpu);
308 st_oop result = ST_NIL;
309
310 if (ST_LIKELY (cpu->success)) {
311 result = st_smi_new (x | y);
312 ST_STACK_PUSH (cpu, result);
313 return;
314 }
315
316 ST_STACK_UNPOP (cpu, 2);
317 }
318
319 static void
320 SmallInteger_bitXor (struct st_cpu *cpu)
321 {
322 int y = pop_integer (cpu);
323 int x = pop_integer (cpu);
324 st_oop result;
325
326 if (ST_LIKELY (cpu->success)) {
327 result = st_smi_new (x ^ y);
328 ST_STACK_PUSH (cpu, result);
329 return;
330 }
331
332 ST_STACK_UNPOP (cpu, 2);
333 }
334
335 static void
336 SmallInteger_bitAnd (struct st_cpu *cpu)
337 {
338 int y = pop_integer (cpu);
339 int x = pop_integer (cpu);
340 st_oop result = ST_NIL;
341
342 if (ST_LIKELY (cpu->success)) {
343 result = st_smi_new (x & y);
344 ST_STACK_PUSH (cpu, result);
345 return;
346 }
347
348 ST_STACK_UNPOP (cpu, 2);
349 }
350
351 static void
352 SmallInteger_bitShift (struct st_cpu *cpu)
353 {
354 int y = pop_integer (cpu);
355 int x = pop_integer (cpu);
356 st_oop result = ST_NIL;
357
358 if (ST_LIKELY (cpu->success)) {
359 if (y > 0)
360 result = st_smi_new (x << y);
361 else if (y < 0)
362 result = st_smi_new (x >> (-y));
363 else
364 result = st_smi_new (x);
365
366 ST_STACK_PUSH (cpu, result);
367 return;
368 }
369
370 ST_STACK_UNPOP (cpu, 2);
371 }
372
373 static void
374 SmallInteger_asFloat (struct st_cpu *cpu)
375 {
376 int x = pop_integer (cpu);
377 st_oop result = ST_NIL;
378
379 if (ST_LIKELY (cpu->success)) {
380 result = st_float_new ((double) x);
381 ST_STACK_PUSH (cpu, result);
382 return;
383 }
384
385 ST_STACK_UNPOP (cpu, 1);
386 }
387
388 static void
389 SmallInteger_asLargeInteger (struct st_cpu *cpu)
390 {
391 int receiver = pop_integer (cpu);
392 mp_int value;
393 st_oop result;
394
395 mp_init_set (&value, abs (receiver));
396
397 if (receiver < 0)
398 mp_neg (&value, &value);
399
400 result = st_large_integer_new (&value);
401 ST_STACK_PUSH (cpu, result);
402 }
403
404 #define VALUE(oop) (&(ST_LARGE_INTEGER(oop)->value))
405
406 /* useful macros to avoid duplication of error-handling code */
407
408 #define OP_PROLOGUE \
409 mp_int value; \
410 mp_init (&value);
411
412
413 #define BINARY_OP(op, a, b) \
414 OP_PROLOGUE \
415 result = op (VALUE (a), VALUE (b), &value);
416
417 #define BINARY_DIV_OP(op, a, b) \
418 OP_PROLOGUE \
419 result = op (VALUE (a), VALUE (b), &value, NULL);
420
421 #define UNARY_OP(op, a) \
422 OP_PROLOGUE \
423 result = op (VALUE (a), &value);
424
425
426 static inline st_oop
427 pop_large_integer (struct st_cpu *cpu)
428 {
429 st_oop object = ST_STACK_POP (cpu);
430
431 set_success (cpu, st_object_class (object) == ST_LARGE_INTEGER_CLASS);
432
433 return object;
434 }
435
436 static void
437 LargeInteger_add (struct st_cpu *cpu)
438 {
439 st_oop b = pop_large_integer (cpu);
440 st_oop a = pop_large_integer (cpu);
441 st_oop result;
442
443 if (!cpu->success) {
444 ST_STACK_UNPOP (cpu, 2);
445 return;
446 }
447
448 BINARY_OP (mp_add, a, b);
449
450 result = st_large_integer_new (&value);
451 ST_STACK_PUSH (cpu, result);
452 }
453
454 static void
455 LargeInteger_sub (struct st_cpu *cpu)
456 {
457 st_oop b = pop_large_integer (cpu);
458 st_oop a = pop_large_integer (cpu);
459 st_oop result;
460
461 if (!cpu->success) {
462 ST_STACK_UNPOP (cpu, 2);
463 return;
464 }
465
466 BINARY_OP (mp_sub, a, b);
467
468 result = st_large_integer_new (&value);
469 ST_STACK_PUSH (cpu, result);
470 }
471
472 static void
473 LargeInteger_mul (struct st_cpu *cpu)
474 {
475 st_oop b = pop_large_integer (cpu);
476 st_oop a = pop_large_integer (cpu);
477 st_oop result;
478
479 if (!cpu->success) {
480 ST_STACK_UNPOP (cpu, 2);
481 return;
482 }
483
484 BINARY_OP (mp_mul, a, b);
485
486 result = st_large_integer_new (&value);
487 ST_STACK_PUSH (cpu, result);
488 }
489
490 static void
491 LargeInteger_div (struct st_cpu *cpu)
492 {
493 st_oop b = pop_large_integer (cpu);
494 st_oop a = pop_large_integer (cpu);
495 mp_int quotient, remainder;
496 st_oop result;
497
498 if (!cpu->success) {
499 ST_STACK_UNPOP (cpu, 2);
500 return;
501 }
502
503 mp_init_multi (&quotient, &remainder, NULL);
504 mp_div (VALUE (a), VALUE (b), &quotient, &remainder);
505
506 int size;
507 char *str;
508
509 mp_radix_size (&remainder, 10, &size);
510 str = st_malloc (size);
511 mp_toradix (&remainder, str, 10);
512
513 if (mp_cmp_d (&remainder, 0) == MP_EQ) {
514 result = st_large_integer_new (&quotient);
515 ST_STACK_PUSH (cpu, result);
516 mp_clear (&remainder);
517 } else {
518 set_success (cpu, false);
519 ST_STACK_UNPOP (cpu, 2);
520 mp_clear_multi (&quotient, &remainder, NULL);
521 }
522 }
523
524 static void
525 LargeInteger_intDiv (struct st_cpu *cpu)
526 {
527 st_oop b = pop_large_integer (cpu);
528 st_oop a = pop_large_integer (cpu);
529 st_oop result;
530
531 if (!cpu->success) {
532 ST_STACK_UNPOP (cpu, 2);
533 return;
534 }
535
536 BINARY_DIV_OP (mp_div, a, b);
537
538 result = st_large_integer_new (&value);
539 ST_STACK_PUSH (cpu, result);
540 }
541
542 static void
543 LargeInteger_mod (struct st_cpu *cpu)
544 {
545 st_oop b = pop_large_integer (cpu);
546 st_oop a = pop_large_integer (cpu);
547 st_oop result;
548
549 if (!cpu->success) {
550 ST_STACK_UNPOP (cpu, 2);
551 return;
552 }
553
554 BINARY_OP (mp_mod, a, b);
555
556 result = st_large_integer_new (&value);
557 ST_STACK_PUSH (cpu, result);
558 }
559
560 static void
561 LargeInteger_gcd (struct st_cpu *cpu)
562 {
563 st_oop b = pop_large_integer (cpu);
564 st_oop a = pop_large_integer (cpu);
565 st_oop result;
566
567 if (!cpu->success) {
568 ST_STACK_UNPOP (cpu, 2);
569 return;
570 }
571
572 BINARY_OP (mp_gcd, a, b);
573
574 result = st_large_integer_new (&value);
575 ST_STACK_PUSH (cpu, result);
576 }
577
578 static void
579 LargeInteger_lcm (struct st_cpu *cpu)
580 {
581 st_oop b = pop_large_integer (cpu);
582 st_oop a = pop_large_integer (cpu);
583 st_oop result;
584
585 if (!cpu->success) {
586 ST_STACK_UNPOP (cpu, 2);
587 return;
588 }
589
590 BINARY_OP (mp_lcm, a, b);
591
592 result = st_large_integer_new (&value);
593 ST_STACK_PUSH (cpu, result);
594 }
595
596 static void
597 LargeInteger_eq (struct st_cpu *cpu)
598 {
599 st_oop b = pop_large_integer (cpu);
600 st_oop a = pop_large_integer (cpu);
601 st_oop result;
602 int relation;
603
604 if (!cpu->success) {
605 ST_STACK_UNPOP (cpu, 2);
606 return;
607 }
608
609 relation = mp_cmp (VALUE (a), VALUE (b));
610 result = (relation == MP_EQ) ? ST_TRUE : ST_FALSE;
611 ST_STACK_PUSH (cpu, result);
612 }
613
614 static void
615 LargeInteger_ne (struct st_cpu *cpu)
616 {
617 st_oop b = pop_large_integer (cpu);
618 st_oop a = pop_large_integer (cpu);
619 st_oop result;
620 int relation;
621
622 if (!cpu->success) {
623 ST_STACK_UNPOP (cpu, 2);
624 return;
625 }
626
627 relation = mp_cmp (VALUE (a), VALUE (b));
628 result = (relation == MP_EQ) ? ST_FALSE : ST_TRUE;
629 ST_STACK_PUSH (cpu, result);
630 }
631
632 static void
633 LargeInteger_lt (struct st_cpu *cpu)
634 {
635 st_oop b = pop_large_integer (cpu);
636 st_oop a = pop_large_integer (cpu);
637 st_oop result;
638 int relation;
639
640 if (!cpu->success) {
641 ST_STACK_UNPOP (cpu, 2);
642 return;
643 }
644
645 relation = mp_cmp (VALUE (a), VALUE (b));
646 result = (relation == MP_LT) ? ST_TRUE : ST_FALSE;
647 ST_STACK_PUSH (cpu, result);
648 }
649
650 static void
651 LargeInteger_gt (struct st_cpu *cpu)
652 {
653 st_oop b = pop_large_integer (cpu);
654 st_oop a = pop_large_integer (cpu);
655
656 st_oop result;
657 int relation;
658
659 if (!cpu->success) {
660 ST_STACK_UNPOP (cpu, 2);
661 return;
662 }
663
664 relation = mp_cmp (VALUE (a), VALUE (b));
665 result = (relation == MP_GT) ? ST_TRUE : ST_FALSE;
666 ST_STACK_PUSH (cpu, result);
667 }
668
669 static void
670 LargeInteger_le (struct st_cpu *cpu)
671 {
672 st_oop b = pop_large_integer (cpu);
673 st_oop a = pop_large_integer (cpu);
674 st_oop result;
675 int relation;
676
677 if (!cpu->success) {
678 ST_STACK_UNPOP (cpu, 2);
679 return;
680 }
681
682 relation = mp_cmp (VALUE (a), VALUE (b));
683 result = (relation == MP_LT || relation == MP_EQ) ? ST_TRUE : ST_FALSE;
684 ST_STACK_PUSH (cpu, result);
685 }
686
687 static void
688 LargeInteger_ge (struct st_cpu *cpu)
689 {
690 st_oop b = pop_large_integer (cpu);
691 st_oop a = pop_large_integer (cpu);
692 st_oop result;
693 int relation;
694
695 if (!cpu->success) {
696 ST_STACK_UNPOP (cpu, 2);
697 return;
698 }
699
700 relation = mp_cmp (VALUE (a), VALUE (b));
701 result = (relation == MP_GT || relation == MP_EQ) ? ST_TRUE : ST_FALSE;
702 ST_STACK_PUSH (cpu, result);
703 }
704
705 static void
706 LargeInteger_squared (struct st_cpu *cpu)
707 {
708 st_oop receiver = pop_large_integer (cpu);
709 st_oop result;
710
711 if (!cpu->success) {
712 ST_STACK_UNPOP (cpu, 1);
713 return;
714 }
715
716 UNARY_OP (mp_sqr, receiver);
717
718 result = st_large_integer_new (&value);
719 ST_STACK_PUSH (cpu, result);
720 }
721
722 static void
723 LargeInteger_bitOr (struct st_cpu *cpu)
724 {
725 st_oop b = pop_large_integer (cpu);
726 st_oop a = pop_large_integer (cpu);
727 st_oop result;
728
729 if (!cpu->success) {
730 ST_STACK_UNPOP (cpu, 2);
731 return;
732 }
733
734 BINARY_OP (mp_or, a, b);
735
736 result = st_large_integer_new (&value);
737 ST_STACK_PUSH (cpu, result);
738 }
739
740 static void
741 LargeInteger_bitAnd (struct st_cpu *cpu)
742 {
743 st_oop b = pop_large_integer (cpu);
744 st_oop a = pop_large_integer (cpu);
745 st_oop result;
746
747 if (!cpu->success) {
748 ST_STACK_UNPOP (cpu, 2);
749 return;
750 }
751
752 BINARY_OP (mp_and, a, b);
753
754 result = st_large_integer_new (&value);
755 ST_STACK_PUSH (cpu, result);
756 }
757
758 static void
759 LargeInteger_bitXor (struct st_cpu *cpu)
760 {
761 st_oop b = pop_large_integer (cpu);
762 st_oop a = pop_large_integer (cpu);
763 st_oop result;
764
765 if (!cpu->success) {
766 ST_STACK_UNPOP (cpu, 2);
767 return;
768 }
769
770 BINARY_OP (mp_xor, a, b);
771
772 result = st_large_integer_new (&value);
773 ST_STACK_PUSH (cpu, result);
774 }
775
776 static void
777 LargeInteger_bitShift (struct st_cpu *cpu)
778 {
779 int displacement = pop_integer32 (cpu);
780 st_oop receiver = pop_large_integer (cpu);
781 st_oop result;
782 mp_int value;
783
784 if (!cpu->success) {
785 ST_STACK_UNPOP (cpu, 2);
786 return;
787 }
788
789 mp_init (&value);
790
791 if (displacement >= 0)
792 mp_mul_2d (VALUE (receiver), displacement, &value);
793 else
794 mp_div_2d (VALUE (receiver), abs (displacement), &value, NULL);
795
796 result = st_large_integer_new (&value);
797 ST_STACK_PUSH (cpu, result);
798 }
799
800 #define ST_DIGIT_RADIX (1L << DIGIT_BIT)
801
802
803 static void
804 LargeInteger_asFloat (struct st_cpu *cpu)
805 {
806 st_oop receiver = pop_large_integer (cpu);
807 char *string;
808 double result;
809 mp_int *m;
810 int i;
811
812 m = st_large_integer_value (receiver);
813 if (m->used == 0) {
814 ST_STACK_PUSH (cpu, st_float_new (0));
815 return;
816 }
817
818 i = m->used;
819 result = DIGIT (m, i);
820 while (--i >= 0)
821 result = (result * ST_DIGIT_RADIX) + DIGIT (m, i);
822
823 if (m->sign == MP_NEG)
824 result = -result;
825
826 ST_STACK_PUSH (cpu, st_float_new (result));
827 }
828
829 static void
830 LargeInteger_printStringBase (struct st_cpu *cpu)
831 {
832 int radix = pop_integer (cpu);
833 st_oop x = pop_large_integer (cpu);
834 char *string;
835 st_oop result;
836
837 if (radix < 2 || radix > 36)
838 set_success (cpu, false);
839
840 if (cpu->success) {
841 string = st_large_integer_to_string (x, radix);
842 result = st_string_new (string);
843 }
844
845 if (cpu->success)
846 ST_STACK_PUSH (cpu, result);
847 else
848 ST_STACK_UNPOP (cpu, 2);
849 }
850
851 static void
852 LargeInteger_hash (struct st_cpu *cpu)
853 {
854 st_oop receiver = ST_STACK_POP (cpu);
855 mp_int *value;
856 int result;
857 const char *c;
858 unsigned int hash;
859 int len;
860
861 value = st_large_integer_value (receiver);
862 c = (const char *) value->dp;
863 len = value->used * sizeof (mp_digit);
864 hash = 5381;
865
866 for(unsigned int i = 0; i < len; i++)
867 if (c[i])
868 hash = ((hash << 5) + hash) + c[i];
869
870 result = hash;
871
872 if (result < 0)
873 result = -result;
874
875 ST_STACK_PUSH (cpu, st_smi_new (result));
876 }
877
878
879 static inline st_oop
880 pop_float (struct st_cpu *cpu)
881 {
882 st_oop object = ST_STACK_POP (cpu);
883
884 set_success (cpu, st_object_class (object) == ST_FLOAT_CLASS);
885
886 return object;
887 }
888
889 static void
890 Float_add (struct st_cpu *cpu)
891 {
892 st_oop y = pop_float (cpu);
893 st_oop x = pop_float (cpu);
894 st_oop result = ST_NIL;
895
896 if (cpu->success)
897 result = st_float_new (st_float_value (x) + st_float_value (y));
898
899 if (cpu->success)
900 ST_STACK_PUSH (cpu, result);
901 else
902 ST_STACK_UNPOP (cpu, 2);
903 }
904
905 static void
906 Float_sub (struct st_cpu *cpu)
907 {
908 st_oop y = pop_float (cpu);
909 st_oop x = pop_float (cpu);
910 st_oop result = ST_NIL;
911
912 if (cpu->success)
913 result = st_float_new (st_float_value (x) - st_float_value (y));
914
915 if (cpu->success)
916 ST_STACK_PUSH (cpu, result);
917 else
918 ST_STACK_UNPOP (cpu, 2);
919 }
920
921 static void
922 Float_lt (struct st_cpu *cpu)
923 {
924 st_oop y = pop_float (cpu);
925 st_oop x = pop_float (cpu);
926 st_oop result = ST_NIL;
927
928 if (cpu->success)
929 result = isless (st_float_value (x), st_float_value (y)) ? ST_TRUE : ST_FALSE;
930
931 if (cpu->success)
932 ST_STACK_PUSH (cpu, result);
933 else
934 ST_STACK_UNPOP (cpu, 2);
935 }
936
937 static void
938 Float_gt (struct st_cpu *cpu)
939 {
940 st_oop y = pop_float (cpu);
941 st_oop x = pop_float (cpu);
942 st_oop result = ST_NIL;
943
944 if (cpu->success)
945 result = isgreater (st_float_value (x), st_float_value (y)) ? ST_TRUE : ST_FALSE;
946
947 if (cpu->success)
948 ST_STACK_PUSH (cpu, result);
949 else
950 ST_STACK_UNPOP (cpu, 2);
951 }
952
953 static void
954 Float_le (struct st_cpu *cpu)
955 {
956 st_oop y = pop_float (cpu);
957 st_oop x = pop_float (cpu);
958 st_oop result = ST_NIL;
959
960 if (cpu->success)
961 result = islessequal (st_float_value (x), st_float_value (y)) ? ST_TRUE : ST_FALSE;
962
963 if (cpu->success)
964 ST_STACK_PUSH (cpu, result);
965 else
966 ST_STACK_UNPOP (cpu, 2);
967 }
968
969 static void
970 Float_ge (struct st_cpu *cpu)
971 {
972 st_oop y = pop_float (cpu);
973 st_oop x = pop_float (cpu);
974 st_oop result = ST_NIL;
975
976 if (cpu->success)
977 result = isgreaterequal (st_float_value (x), st_float_value (y)) ? ST_TRUE : ST_FALSE;
978
979 if (cpu->success)
980 ST_STACK_PUSH (cpu, result);
981 else
982 ST_STACK_UNPOP (cpu, 2);
983 }
984
985 static void
986 Float_eq (struct st_cpu *cpu)
987 {
988 st_oop y = pop_float (cpu);
989 st_oop x = pop_float (cpu);
990 st_oop result = ST_NIL;
991
992 if (cpu->success)
993 result = (st_float_value (x) == st_float_value (y)) ? ST_TRUE : ST_FALSE;
994
995 if (cpu->success)
996 ST_STACK_PUSH (cpu, result);
997 else
998 ST_STACK_UNPOP (cpu, 2);
999 }
1000
1001 static void
1002 Float_ne (struct st_cpu *cpu)
1003 {
1004 st_oop y = pop_float (cpu);
1005 st_oop x = pop_float (cpu);
1006 st_oop result = ST_NIL;
1007
1008 if (cpu->success)
1009 result = (st_float_value (x) != st_float_value (y)) ? ST_TRUE : ST_FALSE;
1010
1011 if (cpu->success)
1012 ST_STACK_PUSH (cpu, result);
1013 else
1014 ST_STACK_UNPOP (cpu, 2);
1015 }
1016
1017 static void
1018 Float_mul (struct st_cpu *cpu)
1019 {
1020 st_oop y = pop_float (cpu);
1021 st_oop x = pop_float (cpu);
1022 st_oop result = ST_NIL;
1023
1024 if (cpu->success)
1025 result = st_float_new (st_float_value (x) * st_float_value (y));
1026
1027 if (cpu->success)
1028 ST_STACK_PUSH (cpu, result);
1029 else
1030 ST_STACK_UNPOP (cpu, 2);
1031 }
1032
1033 static void
1034 Float_div (struct st_cpu *cpu)
1035 {
1036 st_oop y = pop_float (cpu);
1037 st_oop x = pop_float (cpu);
1038 st_oop result = ST_NIL;
1039
1040 set_success (cpu, y != 0);
1041
1042 if (cpu->success)
1043 result = st_float_new (st_float_value (x) / st_float_value (y));
1044
1045 if (cpu->success)
1046 ST_STACK_PUSH (cpu, result);
1047 else
1048 ST_STACK_UNPOP (cpu, 2);
1049 }
1050
1051 static void
1052 Float_sin (struct st_cpu *cpu)
1053 {
1054 st_oop receiver = ST_STACK_POP (cpu);
1055 st_oop result;
1056 double value;
1057
1058 value = st_float_value (receiver);
1059
1060 result = st_float_new (sin (value));
1061
1062 if (cpu->success)
1063 ST_STACK_PUSH (cpu, result);
1064 else
1065 ST_STACK_UNPOP (cpu, 1);
1066 }
1067
1068 static void
1069 Float_cos (struct st_cpu *cpu)
1070 {
1071 st_oop receiver = ST_STACK_POP (cpu);
1072 st_oop result;
1073 double value;
1074
1075 value = st_float_value (receiver);
1076
1077 result = st_float_new (cos (value));
1078
1079 if (cpu->success)
1080 ST_STACK_PUSH (cpu, result);
1081 else
1082 ST_STACK_UNPOP (cpu, 1);
1083 }
1084
1085 static void
1086 Float_tan (struct st_cpu *cpu)
1087 {
1088 st_oop receiver = ST_STACK_POP (cpu);
1089 st_oop result;
1090 double value;
1091
1092 value = st_float_value (receiver);
1093
1094 result = st_float_new (tan (value));
1095
1096 if (cpu->success)
1097 ST_STACK_PUSH (cpu, result);
1098 else
1099 ST_STACK_UNPOP (cpu, 1);
1100 }
1101
1102 static void
1103 Float_arcSin (struct st_cpu *cpu)
1104 {
1105 st_oop receiver = ST_STACK_POP (cpu);
1106 st_oop result;
1107 double value;
1108
1109 value = st_float_value (receiver);
1110
1111 result = st_float_new (asin (value));
1112
1113 if (cpu->success)
1114 ST_STACK_PUSH (cpu, result);
1115 else
1116 ST_STACK_UNPOP (cpu, 1);
1117 }
1118
1119 static void
1120 Float_arcCos (struct st_cpu *cpu)
1121 {
1122 st_oop receiver = ST_STACK_POP (cpu);
1123 st_oop result;
1124 double value;
1125
1126 value = st_float_value (receiver);
1127
1128 result = st_float_new (acos (value));
1129
1130 if (cpu->success)
1131 ST_STACK_PUSH (cpu, result);
1132 else
1133 ST_STACK_UNPOP (cpu, 1);
1134 }
1135
1136 static void
1137 Float_arcTan (struct st_cpu *cpu)
1138 {
1139 st_oop receiver = ST_STACK_POP (cpu);
1140 st_oop result;
1141 double value;
1142
1143 value = st_float_value (receiver);
1144
1145 result = st_float_new (atan (value));
1146
1147 if (cpu->success)
1148 ST_STACK_PUSH (cpu, result);
1149 else
1150 ST_STACK_UNPOP (cpu, 1);
1151 }
1152
1153 static void
1154 Float_sqrt (struct st_cpu *cpu)
1155 {
1156 st_oop receiver = ST_STACK_POP (cpu);
1157 st_oop result;
1158 double value;
1159
1160 value = st_float_value (receiver);
1161
1162 result = st_float_new (sqrt (value));
1163
1164 if (cpu->success)
1165 ST_STACK_PUSH (cpu, result);
1166 else
1167 ST_STACK_UNPOP (cpu, 1);
1168 }
1169
1170 static void
1171 Float_log (struct st_cpu *cpu)
1172 {
1173 st_oop receiver = ST_STACK_POP (cpu);
1174 st_oop result;
1175 double value;
1176
1177 value = st_float_value (receiver);
1178
1179 result = st_float_new (log10 (value));
1180
1181 if (cpu->success)
1182 ST_STACK_PUSH (cpu, result);
1183 else
1184 ST_STACK_UNPOP (cpu, 1);
1185 }
1186
1187 static void
1188 Float_ln (struct st_cpu *cpu)
1189 {
1190 st_oop receiver = ST_STACK_POP (cpu);
1191 st_oop result;
1192 double value;
1193
1194 value = st_float_value (receiver);
1195
1196 result = st_float_new (log (value));
1197
1198 if (cpu->success)
1199 ST_STACK_PUSH (cpu, result);
1200 else
1201 ST_STACK_UNPOP (cpu, 1);
1202 }
1203
1204 static void
1205 Float_exp (struct st_cpu *cpu)
1206 {
1207 st_oop receiver = ST_STACK_POP (cpu);
1208 st_oop result;
1209 double value;
1210
1211 value = st_float_value (receiver);
1212
1213 result = st_float_new (exp (value));
1214
1215 if (cpu->success)
1216 ST_STACK_PUSH (cpu, result);
1217 else
1218 ST_STACK_UNPOP (cpu, 1);
1219 }
1220
1221 static void
1222 Float_truncated (struct st_cpu *cpu)
1223 {
1224 st_oop receiver = ST_STACK_POP (cpu);
1225 int result;
1226
1227 result = (int) trunc (st_float_value (receiver));
1228
1229 ST_STACK_PUSH (cpu, st_smi_new (result));
1230 }
1231
1232 static void
1233 Float_fractionPart (struct st_cpu *cpu)
1234 {
1235 st_oop receiver = ST_STACK_POP (cpu);
1236 double frac_part, int_part;
1237 st_oop result;
1238
1239 frac_part = modf (st_float_value (receiver), &int_part);
1240
1241 result = st_float_new (frac_part);
1242
1243 ST_STACK_PUSH (cpu, result);
1244 }
1245
1246 static void
1247 Float_integerPart (struct st_cpu *cpu)
1248 {
1249 st_oop receiver = ST_STACK_POP (cpu);
1250 double int_part;
1251 st_oop result;
1252
1253 modf (st_float_value (receiver), &int_part);
1254
1255 result = st_smi_new ((int) int_part);
1256 ST_STACK_PUSH (cpu, result);
1257 }
1258
1259 static void
1260 Float_hash (struct st_cpu *cpu)
1261 {
1262 st_oop receiver = ST_STACK_POP (cpu);
1263 unsigned int hash = 0;
1264 int result;
1265 double value;
1266 unsigned char *c;
1267
1268 value = st_float_value (receiver);
1269
1270 if (value == 0)
1271 value = fabs (value);
1272
1273 c = (unsigned char *) & value;
1274 for (int i = 0; i < sizeof (double); i++) {
1275 hash = (hash * 971) ^ c[i];
1276 }
1277
1278 result = hash;
1279
1280 if (result < 0)
1281 result = -result;
1282
1283 ST_STACK_PUSH (cpu, st_smi_new (result));
1284 }
1285
1286 static void
1287 Float_printStringBase (struct st_cpu *cpu)
1288 {
1289 int base = pop_integer(cpu);
1290 st_oop receiver = ST_STACK_POP (cpu);
1291 char *tmp;
1292 st_oop string;
1293
1294 if (!cpu->success ||
1295 !st_object_is_heap (receiver) ||
1296 st_object_format (receiver) != ST_FORMAT_FLOAT) {
1297 cpu->success = false;
1298 ST_STACK_UNPOP (cpu, 2);
1299 return;
1300 }
1301
1302 /* ignore base for the time being */
1303 tmp = st_strdup_printf ("%g", st_float_value (receiver));
1304 string = st_string_new (tmp);
1305 st_free (tmp);
1306
1307 ST_STACK_PUSH (cpu, string);
1308 }
1309
1310 static void
1311 Object_error (struct st_cpu *cpu)
1312 {
1313 st_oop message;
1314 st_oop traceback;
1315 st_oop receiver;
1316
1317 traceback = ST_STACK_POP (cpu);
1318 message = ST_STACK_POP (cpu);
1319 receiver = ST_STACK_POP (cpu);
1320
1321 if (!st_object_is_heap (traceback) ||
1322 st_object_format (traceback) != ST_FORMAT_BYTE_ARRAY) {
1323 /* can't resume execution in this prim */
1324 abort();
1325 }
1326
1327 if (!st_object_is_heap (message) ||
1328 st_object_format (message) != ST_FORMAT_BYTE_ARRAY) {
1329 /* can't resume execution in this prim */
1330 abort();
1331 }
1332
1333 printf ("An error occurred during program execution\n");
1334 printf ("message: %s\n\n", st_byte_array_bytes (message));
1335
1336 printf ("Traceback:\n");
1337 puts (st_byte_array_bytes (traceback));
1338
1339 /* set success to false to signal error */
1340 cpu->success = false;
1341 longjmp (cpu->main_loop, 0);
1342 }
1343
1344 static void
1345 Object_class (struct st_cpu *cpu)
1346 {
1347 st_oop object;
1348
1349 object = ST_STACK_POP (cpu);
1350
1351 ST_STACK_PUSH (cpu, st_object_class (object));
1352 }
1353
1354 static void
1355 Object_identityHash (struct st_cpu *cpu)
1356 {
1357 st_oop object;
1358 st_uint hash;
1359
1360 object = ST_STACK_POP (cpu);
1361
1362 if (st_object_is_smi (object))
1363 hash = st_smi_hash (object);
1364 else if (st_object_is_character (object))
1365 hash = st_character_hash (object);
1366 else {
1367 st_object_set_hashed (object, true);
1368 hash = st_identity_hashtable_hash (memory->ht, object);
1369 }
1370 ST_STACK_PUSH (cpu, st_smi_new (hash));
1371 }
1372
1373 static void
1374 Object_copy (struct st_cpu *cpu)
1375 {
1376 st_oop receiver;
1377 st_oop copy;
1378 st_oop class;
1379 int size;
1380
1381 (void) ST_STACK_POP (cpu);
1382
1383 if (!st_object_is_heap (cpu->message_receiver)) {
1384 ST_STACK_PUSH (cpu, cpu->message_receiver);
1385 return;
1386 }
1387
1388 switch (st_object_format (cpu->message_receiver)) {
1389
1390 case ST_FORMAT_OBJECT:
1391 {
1392 class = ST_OBJECT_CLASS (cpu->message_receiver);
1393 size = st_smi_value (ST_BEHAVIOR_INSTANCE_SIZE (class));
1394 copy = st_object_new (class);
1395 st_oops_copy (ST_OBJECT_FIELDS (copy),
1396 ST_OBJECT_FIELDS (cpu->message_receiver),
1397 size);
1398 break;
1399
1400 }
1401 case ST_FORMAT_ARRAY:
1402 {
1403 size = st_smi_value (ST_ARRAYED_OBJECT (cpu->message_receiver)->size);
1404 copy = st_object_new_arrayed (ST_OBJECT_CLASS (cpu->message_receiver), size);
1405 st_oops_copy (ST_ARRAY (copy)->elements,
1406 ST_ARRAY (cpu->message_receiver)->elements,
1407 size);
1408 break;
1409 }
1410 case ST_FORMAT_BYTE_ARRAY:
1411 {
1412 size = st_smi_value (ST_ARRAYED_OBJECT (cpu->message_receiver)->size);
1413 copy = st_object_new_arrayed (ST_OBJECT_CLASS (cpu->message_receiver), size);
1414 memcpy (st_byte_array_bytes (copy),
1415 st_byte_array_bytes (cpu->message_receiver),
1416 size);
1417 break;
1418 }
1419 case ST_FORMAT_FLOAT_ARRAY:
1420 {
1421 size = st_smi_value (st_arrayed_object_size (cpu->message_receiver));
1422 copy = st_object_new_arrayed (ST_OBJECT_CLASS (cpu->message_receiver), size);
1423 memcpy (st_float_array_elements (copy),
1424 st_float_array_elements (cpu->message_receiver),
1425 sizeof (double) * size);
1426
1427 break;
1428 }
1429 case ST_FORMAT_WORD_ARRAY:
1430 {
1431 size = st_smi_value (st_arrayed_object_size (cpu->message_receiver));
1432 copy = st_object_new_arrayed (ST_OBJECT_CLASS (cpu->message_receiver), size);
1433 memcpy (st_word_array_elements (copy),
1434 st_word_array_elements (cpu->message_receiver),
1435 sizeof (st_uint) * size);
1436 break;
1437 }
1438 case ST_FORMAT_FLOAT:
1439 {
1440 copy = st_object_new (ST_FLOAT_CLASS);
1441 st_float_set_value (copy, st_float_value (cpu->message_receiver));
1442 break;
1443 }
1444 case ST_FORMAT_LARGE_INTEGER:
1445 {
1446 mp_int value;
1447 int result;
1448
1449 copy = st_object_new (ST_LARGE_INTEGER_CLASS);
1450
1451 result = mp_init_copy (st_large_integer_value (copy),
1452 st_large_integer_value (cpu->message_receiver));
1453 if (result != MP_OKAY)
1454 abort ();
1455 break;
1456 }
1457 case ST_FORMAT_HANDLE:
1458
1459 copy = st_object_new (ST_HANDLE_CLASS);
1460 ST_HANDLE_VALUE (copy) = ST_HANDLE_VALUE (cpu->message_receiver);
1461 break;
1462 case ST_FORMAT_CONTEXT:
1463 case ST_FORMAT_INTEGER_ARRAY:
1464 default:
1465 /* not implemented yet */
1466 abort ();
1467 }
1468
1469 ST_STACK_PUSH (cpu, copy);
1470 }
1471
1472 static void
1473 Object_equivalent (struct st_cpu *cpu)
1474 {
1475 st_oop y = ST_STACK_POP (cpu);
1476 st_oop x = ST_STACK_POP (cpu);
1477
1478 ST_STACK_PUSH (cpu, ((x == y) ? ST_TRUE : ST_FALSE));
1479 }
1480
1481 static st_oop
1482 lookup_method (st_oop class, st_oop selector)
1483 {
1484 st_oop method;
1485 st_oop parent = class;
1486 st_uint index;
1487
1488 while (parent != ST_NIL) {
1489 method = st_dictionary_at (ST_BEHAVIOR_METHOD_DICTIONARY (parent), selector);
1490 if (method != ST_NIL)
1491 return method;
1492 parent = ST_BEHAVIOR_SUPERCLASS (parent);
1493 }
1494
1495 return 0;
1496 }
1497
1498 static void
1499 Object_perform (struct st_cpu *cpu)
1500 {
1501 st_oop receiver;
1502 st_oop selector;
1503 st_oop method;
1504 st_uint selector_index;
1505
1506 selector = cpu->message_selector;
1507 cpu->message_selector = cpu->stack[cpu->sp - cpu->message_argcount];
1508 receiver = cpu->message_receiver;
1509
1510 set_success (cpu, st_object_is_symbol (cpu->message_selector));
1511 method = lookup_method (st_object_class (receiver), cpu->message_selector);
1512 set_success (cpu, st_method_get_arg_count (method) == (cpu->message_argcount - 1));
1513
1514 if (cpu->success) {
1515 selector_index = cpu->sp - cpu->message_argcount;
1516
1517 st_oops_move (cpu->stack + selector_index,
1518 cpu->stack + selector_index + 1,
1519 cpu->message_argcount - 1);
1520
1521 cpu->sp -= 1;
1522 cpu->message_argcount -= 1;
1523 cpu->new_method = method;
1524 st_cpu_execute_method ();
1525
1526 } else {
1527 cpu->message_selector = selector;
1528 }
1529 }
1530
1531 static void
1532 Object_perform_withArguments (struct st_cpu *cpu)
1533 {
1534 st_oop receiver;
1535 st_oop selector;
1536 st_oop method;
1537 st_oop array;
1538 int array_size;
1539
1540 array = ST_STACK_POP (cpu);
1541
1542 set_success (cpu, st_object_format (array) == ST_FORMAT_ARRAY);
1543
1544 if (ST_OBJECT_CLASS (cpu->context) == ST_BLOCK_CONTEXT_CLASS)
1545 method = ST_METHOD_CONTEXT_METHOD (ST_BLOCK_CONTEXT_HOME (cpu->context));
1546 else
1547 method = ST_METHOD_CONTEXT_METHOD (cpu->context);
1548
1549 array_size = st_smi_value (st_arrayed_object_size (array));
1550 set_success (cpu, (cpu->sp + array_size - 1) < (st_method_get_large_context (method) ? 32 : 12));
1551
1552 if (cpu->success) {
1553
1554 selector = cpu->message_selector;
1555 cpu->message_selector = ST_STACK_POP (cpu);
1556 receiver = ST_STACK_PEEK (cpu);
1557 cpu->message_argcount = array_size;
1558
1559 set_success (cpu, st_object_is_symbol (cpu->message_selector));
1560
1561 st_oops_copy (cpu->stack + cpu->sp,
1562 st_array_elements (array),
1563 array_size);
1564
1565 cpu->sp += array_size;
1566
1567 method = lookup_method (st_object_class (receiver), cpu->message_selector);
1568 set_success (cpu, st_method_get_arg_count (method) == array_size);
1569
1570 if (cpu->success) {
1571 cpu->new_method = method;
1572 st_cpu_execute_method ();
1573 } else {
1574 cpu->sp -= cpu->message_argcount;
1575 ST_STACK_PUSH (cpu, cpu->message_selector);
1576 ST_STACK_PUSH (cpu, array);
1577 cpu->message_argcount = 2;
1578 cpu->message_selector = selector;
1579 }
1580
1581 } else {
1582 ST_STACK_UNPOP (cpu, 1);
1583 }
1584 }
1585
1586 static void
1587 Behavior_new (struct st_cpu *cpu)
1588 {
1589 st_oop class;
1590 st_oop instance;
1591 int format;
1592
1593 class = ST_STACK_POP (cpu);
1594
1595 switch (st_smi_value (ST_BEHAVIOR_FORMAT (class))) {
1596 case ST_FORMAT_OBJECT:
1597 instance = st_object_allocate (class);
1598 break;
1599 case ST_FORMAT_CONTEXT:
1600 /* not implemented */
1601 abort ();
1602 break;
1603 case ST_FORMAT_FLOAT:
1604 instance = st_float_allocate (class);
1605 break;
1606 case ST_FORMAT_LARGE_INTEGER:
1607 instance = st_large_integer_allocate (class, NULL);
1608 break;
1609 case ST_FORMAT_HANDLE:
1610 instance = st_handle_allocate (class);
1611 break;
1612 default:
1613 /* should not reach */
1614 abort ();
1615 }
1616
1617 ST_STACK_PUSH (cpu, instance);
1618 }
1619
1620 static void
1621 Behavior_newSize (struct st_cpu *cpu)
1622 {
1623 st_oop class;
1624 int size;
1625 int format;
1626 st_oop instance;
1627
1628 size = pop_integer32 (cpu);
1629 class = ST_STACK_POP (cpu);
1630
1631 switch (st_smi_value (ST_BEHAVIOR_FORMAT (class))) {
1632 case ST_FORMAT_ARRAY:
1633 instance = st_array_allocate (class, size);
1634 break;
1635 case ST_FORMAT_BYTE_ARRAY:
1636 instance = st_byte_array_allocate (class, size);
1637 break;
1638 case ST_FORMAT_WORD_ARRAY:
1639 instance = st_word_array_allocate (class, size);
1640 break;
1641 case ST_FORMAT_FLOAT_ARRAY:
1642 instance = st_float_array_allocate (class, size);
1643 break;
1644 case ST_FORMAT_INTEGER_ARRAY:
1645 /* not implemented */
1646 abort ();
1647 break;
1648 default:
1649 /* should not reach */
1650 abort ();
1651 }
1652
1653 ST_STACK_PUSH (cpu, instance);
1654 }
1655
1656 static void
1657 Behavior_compile (struct st_cpu *cpu)
1658 {
1659 st_compiler_error error;
1660 st_oop receiver;
1661 st_oop string;
1662
1663 string = ST_STACK_POP (cpu);
1664 receiver = ST_STACK_POP (cpu);
1665 if (!st_object_is_heap (string) ||
1666 st_object_format (string) != ST_FORMAT_BYTE_ARRAY) {
1667 cpu->success = false;
1668 ST_STACK_UNPOP (cpu, 2);
1669 return;
1670 }
1671
1672 if (!st_compile_string (receiver,
1673 (char *) st_byte_array_bytes (string),
1674 &error)) {
1675 cpu->success = false;
1676 ST_STACK_UNPOP (cpu, 2);
1677 return;
1678 }
1679
1680 ST_STACK_PUSH (cpu, receiver);
1681 }
1682
1683 static void
1684 SequenceableCollection_size (struct st_cpu *cpu)
1685 {
1686 st_oop object;
1687
1688 object = ST_STACK_POP (cpu);
1689
1690 ST_STACK_PUSH (cpu, st_arrayed_object_size (object));
1691 }
1692
1693 static void
1694 Array_at (struct st_cpu *cpu)
1695 {
1696 int index = pop_integer32 (cpu);
1697 st_oop receiver = ST_STACK_POP (cpu);
1698
1699 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1700 set_success (cpu, false);
1701 ST_STACK_UNPOP (cpu, 2);
1702 return;
1703 }
1704
1705 ST_STACK_PUSH (cpu, st_array_at (receiver, index));
1706 }
1707
1708 static void
1709 Array_at_put (struct st_cpu *cpu)
1710 {
1711 st_oop object = ST_STACK_POP (cpu);
1712 int index = pop_integer32 (cpu);
1713 st_oop receiver = ST_STACK_POP (cpu);
1714
1715 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1716 set_success (cpu, false);
1717 ST_STACK_UNPOP (cpu, 3);
1718 return;
1719 }
1720
1721 st_array_at_put (receiver, index, object);
1722 ST_STACK_PUSH (cpu, object);
1723 }
1724
1725 static void
1726 ByteArray_at (struct st_cpu *cpu)
1727 {
1728 int index = pop_integer32 (cpu);
1729 st_oop receiver = ST_STACK_POP (cpu);
1730 st_oop result;
1731
1732 if (!cpu->success) {
1733 ST_STACK_UNPOP (cpu, 2);
1734 return;
1735 }
1736
1737 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1738 set_success (cpu, false);
1739 ST_STACK_UNPOP (cpu, 2);
1740 return;
1741 }
1742
1743 result = st_smi_new (st_byte_array_at (receiver, index));
1744
1745 ST_STACK_PUSH (cpu, result);
1746 }
1747
1748 static void
1749 ByteArray_at_put (struct st_cpu *cpu)
1750 {
1751 int byte = pop_integer (cpu);
1752 int index = pop_integer32 (cpu);
1753 st_oop receiver = ST_STACK_POP (cpu);
1754
1755 if (!cpu->success) {
1756 ST_STACK_UNPOP (cpu, 3);
1757 return;
1758 }
1759
1760 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1761 set_success (cpu, false);
1762 ST_STACK_UNPOP (cpu, 3);
1763 return;
1764 }
1765
1766 st_byte_array_at_put (receiver, index, byte);
1767
1768 ST_STACK_PUSH (cpu, st_smi_new (byte));
1769 }
1770
1771 static void
1772 ByteArray_hash (struct st_cpu *cpu)
1773 {
1774 st_oop receiver = ST_STACK_POP (cpu);
1775 st_uint hash;
1776
1777 hash = st_byte_array_hash (receiver);
1778
1779 ST_STACK_PUSH (cpu, st_smi_new (hash));
1780 }
1781
1782 static void
1783 ByteString_at (struct st_cpu *cpu)
1784 {
1785 int index = pop_integer32 (cpu);
1786 st_oop receiver = ST_STACK_POP (cpu);
1787 st_oop character;
1788 char *charptr;
1789
1790 if (ST_UNLIKELY (!cpu->success)) {
1791 ST_STACK_UNPOP (cpu, 2);
1792 return;
1793 }
1794
1795 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1796 set_success (cpu, false);
1797 ST_STACK_UNPOP (cpu, 2);
1798 return;
1799 }
1800
1801 character = st_character_new (st_byte_array_at (receiver, index));
1802
1803 ST_STACK_PUSH (cpu, character);
1804 }
1805
1806 static void
1807 ByteString_at_put (struct st_cpu *cpu)
1808 {
1809 st_oop character = ST_STACK_POP (cpu);
1810 int index = pop_integer32 (cpu);
1811 st_oop receiver = ST_STACK_POP (cpu);
1812
1813 if (!cpu->success) {
1814 ST_STACK_UNPOP (cpu, 3);
1815 return;
1816 }
1817
1818 set_success (cpu, st_object_class (character) == ST_CHARACTER_CLASS);
1819
1820 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1821 set_success (cpu, false);
1822 ST_STACK_UNPOP (cpu, 3);
1823 return;
1824 }
1825
1826 st_byte_array_at_put (receiver, index, (st_uchar) st_character_value (character));
1827
1828 ST_STACK_PUSH (cpu, character);
1829 }
1830
1831
1832 static void
1833 ByteString_size (struct st_cpu *cpu)
1834 {
1835 st_oop receiver;
1836 st_uint size;
1837
1838 receiver = ST_STACK_POP (cpu);
1839
1840 size = st_arrayed_object_size (receiver);
1841
1842 /* TODO: allow size to go into a LargeInteger on overflow */
1843 ST_STACK_PUSH (cpu, size);
1844 }
1845
1846 static void
1847 ByteString_compare (struct st_cpu *cpu)
1848 {
1849 st_oop argument = ST_STACK_POP (cpu);
1850 st_oop receiver = ST_STACK_POP (cpu);
1851 int order;
1852
1853 if (st_object_format (argument) != ST_FORMAT_BYTE_ARRAY)
1854 set_success (cpu, false);
1855
1856 if (cpu->success)
1857 order = strcmp ((const char *) st_byte_array_bytes (receiver),
1858 (const char *) st_byte_array_bytes (argument));
1859
1860 if (cpu->success)
1861 ST_STACK_PUSH (cpu, st_smi_new (order));
1862 else
1863 ST_STACK_UNPOP (cpu, 2);
1864 }
1865
1866 static void
1867 WideString_at (struct st_cpu *cpu)
1868 {
1869 int index = pop_integer32 (cpu);
1870 st_oop receiver = ST_STACK_POP (cpu);
1871 st_uchar *bytes;
1872 st_unichar c;
1873
1874 if (!cpu->success) {
1875 ST_STACK_UNPOP (cpu, 2);
1876 return;
1877 }
1878
1879 if (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver))) {
1880 set_success (cpu, false);
1881 ST_STACK_UNPOP (cpu, 2);
1882 return;
1883 }
1884
1885 c = st_word_array_at (receiver, index);
1886
1887 ST_STACK_PUSH (cpu, st_character_new (c));
1888 }
1889
1890 static void
1891 WideString_at_put (struct st_cpu *cpu)
1892 {
1893 st_oop character = ST_STACK_POP (cpu);
1894 int index = pop_integer32 (cpu);
1895 st_oop receiver = ST_STACK_POP (cpu);
1896 st_uchar *bytes;
1897 st_unichar c;
1898
1899 if (!cpu->success) {
1900 ST_STACK_UNPOP (cpu, 3);
1901 return;
1902 }
1903
1904 set_success (cpu, st_object_class (character) == ST_CHARACTER_CLASS);
1905
1906 if (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver))) {
1907 set_success (cpu, false);
1908 ST_STACK_UNPOP (cpu, 3);
1909 return;
1910 }
1911
1912 st_word_array_at_put (receiver, index, character);
1913
1914 ST_STACK_PUSH (cpu, character);
1915 }
1916
1917 static void
1918 WordArray_at (struct st_cpu *cpu)
1919 {
1920 st_oop receiver;
1921 int index;
1922 st_uint element;
1923
1924 index = pop_integer32 (cpu);
1925 receiver = ST_STACK_POP (cpu);
1926
1927 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1928 set_success (cpu, false);
1929 ST_STACK_UNPOP (cpu, 2);
1930 return;
1931 }
1932
1933 element = st_word_array_at (receiver, index);
1934
1935 ST_STACK_PUSH (cpu, st_smi_new (element));
1936 }
1937
1938 static void
1939 WordArray_at_put (struct st_cpu *cpu)
1940 {
1941 int value = pop_integer (cpu);
1942 int index = pop_integer32 (cpu);
1943 st_oop receiver = ST_STACK_POP (cpu);
1944
1945 if (!cpu->success) {
1946 ST_STACK_UNPOP (cpu, 3);
1947 return;
1948 }
1949
1950 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1951 set_success (cpu, false);
1952 ST_STACK_UNPOP (cpu, 3);
1953 return;
1954 }
1955
1956 st_word_array_at_put (receiver, index, value);
1957
1958 ST_STACK_PUSH (cpu, st_smi_new (value));
1959 }
1960
1961 static void
1962 FloatArray_at (struct st_cpu *cpu)
1963 {
1964 st_oop receiver;
1965 int index;
1966 double element;
1967
1968 index = pop_integer32 (cpu);
1969 receiver = ST_STACK_POP (cpu);
1970
1971 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1972 set_success (cpu, false);
1973 ST_STACK_UNPOP (cpu, 2);
1974 return;
1975 }
1976
1977 element = st_float_array_at (receiver, index);
1978 ST_STACK_PUSH (cpu, st_float_new (element));
1979 }
1980
1981 static void
1982 FloatArray_at_put (struct st_cpu *cpu)
1983 {
1984 st_oop flt = ST_STACK_POP (cpu);
1985 int index = pop_integer32 (cpu);
1986 st_oop receiver = ST_STACK_POP (cpu);
1987
1988 set_success (cpu, st_object_is_heap (flt) &&
1989 st_object_format (flt) == ST_FORMAT_FLOAT);
1990
1991 if (ST_UNLIKELY (index < 1 || index > st_smi_value (st_arrayed_object_size (receiver)))) {
1992 set_success (cpu, false);
1993 ST_STACK_UNPOP (cpu, 3);
1994 return;
1995 }
1996
1997 if (!cpu->success) {
1998 ST_STACK_UNPOP (cpu, 3);
1999 return;
2000 }
2001
2002 st_float_array_at_put (receiver, index, st_float_value (flt));
2003 ST_STACK_PUSH (cpu, flt);
2004 }
2005
2006 static void
2007 BlockContext_value (struct st_cpu *cpu)
2008 {
2009 st_oop block;
2010 st_uint argcount;
2011 st_oop home;
2012
2013 block = cpu->message_receiver;
2014 argcount = st_smi_value (ST_BLOCK_CONTEXT_ARGCOUNT (block));
2015 if (ST_UNLIKELY (argcount != cpu->message_argcount)) {
2016 cpu->success = false;
2017 return;
2018 }
2019
2020 st_oops_copy (ST_BLOCK_CONTEXT_STACK (block),
2021 cpu->stack + cpu->sp - argcount,
2022 argcount);
2023 cpu->sp -= cpu->message_argcount + 1;
2024
2025 ST_CONTEXT_PART_IP (block) = ST_BLOCK_CONTEXT_INITIALIP (block);
2026 ST_CONTEXT_PART_SP (block) = st_smi_new (argcount);
2027 ST_BLOCK_CONTEXT_CALLER (block) = cpu->context;
2028
2029 st_cpu_set_active_context (block);
2030 }
2031
2032 static void
2033 BlockContext_valueWithArguments (struct st_cpu *cpu)
2034 {
2035 st_oop block;
2036 st_oop values;
2037 int argcount;
2038
2039 block = cpu->message_receiver;
2040 values = ST_STACK_PEEK (cpu);
2041
2042 if (st_object_class (values) != ST_ARRAY_CLASS) {
2043 set_success (cpu, false);
2044 return;
2045 }
2046
2047 argcount = st_smi_value (ST_BLOCK_CONTEXT_ARGCOUNT (block));
2048 if (argcount != st_smi_value (st_arrayed_object_size (values))) {
2049 set_success (cpu, false);
2050 return;
2051 }
2052
2053 st_oops_copy (ST_BLOCK_CONTEXT_STACK (block),
2054 ST_ARRAY (values)->elements,
2055 argcount);
2056
2057 cpu->sp -= cpu->message_argcount + 1;
2058
2059 ST_CONTEXT_PART_IP (block) = ST_BLOCK_CONTEXT_INITIALIP (block);
2060 ST_CONTEXT_PART_SP (block) = st_smi_new (argcount);
2061 ST_BLOCK_CONTEXT_CALLER (block) = cpu->context;
2062
2063 st_cpu_set_active_context (block);
2064 }
2065
2066 static void
2067 System_exitWithResult (struct st_cpu *cpu)
2068 {
2069 /* set success to true to signal that everything was alright */
2070 cpu->success = true;
2071 longjmp (cpu->main_loop, 0);
2072 }
2073
2074 static void
2075 Character_value (struct st_cpu *cpu)
2076 {
2077 st_oop receiver = ST_STACK_POP (cpu);
2078
2079 ST_STACK_PUSH (cpu, st_smi_new (st_character_value (receiver)));
2080 }
2081
2082 static void
2083 Character_characterFor (struct st_cpu *cpu)
2084 {
2085 st_oop receiver;
2086 int value;
2087
2088 value = pop_integer (cpu);
2089 receiver = ST_STACK_POP (cpu);
2090
2091 if (cpu->success)
2092 ST_STACK_PUSH (cpu, st_character_new (value));
2093 else
2094 ST_STACK_UNPOP (cpu, 2);
2095 }
2096
2097 static void
2098 FileStream_open (struct st_cpu *cpu)
2099 {
2100 st_oop filename;
2101 st_oop handle;
2102 char *str;
2103 int flags, mode;
2104 int fd;
2105
2106 mode = pop_integer32 (cpu);
2107 filename = ST_STACK_POP (cpu);
2108 if (st_object_format (filename) != ST_FORMAT_BYTE_ARRAY) {
2109 cpu->success = false;
2110 ST_STACK_UNPOP (cpu, 2);
2111 return;
2112 }
2113
2114 if (mode == 0)
2115 flags = O_RDONLY;
2116 else if (mode == 1)
2117 flags = O_WRONLY;
2118 else {
2119 cpu->success = false;
2120 ST_STACK_UNPOP (cpu, 2);
2121 return;
2122 }
2123
2124 str = st_byte_array_bytes (filename);
2125
2126 fd = open (str, O_WRONLY | O_CREAT, 0644);
2127 if (fd < 0) {
2128 fprintf (stderr, strerror (errno));
2129 cpu->success = false;
2130 ST_STACK_UNPOP (cpu, 2);
2131 return;
2132 }
2133
2134 ftruncate (fd, 0);
2135
2136 /* pop receiver */
2137 (void) ST_STACK_POP (cpu);
2138
2139 handle = st_object_new (ST_HANDLE_CLASS);
2140 ST_HANDLE_VALUE (handle) = fd;
2141
2142 ST_STACK_PUSH (cpu, handle);
2143 }
2144
2145 static void
2146 FileStream_close (struct st_cpu *cpu)
2147 {
2148 st_oop handle;
2149 int fd;
2150
2151 handle = ST_STACK_POP (cpu);
2152 fd = ST_HANDLE_VALUE (handle);
2153
2154 if (close (fd) < 0) {
2155 cpu->success = false;
2156 ST_STACK_UNPOP (cpu, 1);
2157 return;
2158 }
2159
2160 /* leave receiver on stack */
2161
2162 }
2163
2164 static void
2165 FileStream_write (struct st_cpu *cpu)
2166 {
2167 st_oop handle;
2168 st_oop array;
2169 int fd;
2170 char *buffer;
2171 size_t total, size;
2172 ssize_t count;
2173
2174 array = ST_STACK_POP (cpu);
2175 handle = ST_STACK_POP (cpu);
2176 if (st_object_format (array) != ST_FORMAT_BYTE_ARRAY) {
2177 cpu->success = false;
2178 ST_STACK_UNPOP (cpu, 1);
2179 return;
2180 }
2181 if (st_object_format (handle) != ST_FORMAT_HANDLE) {
2182 cpu->success = false;
2183 ST_STACK_UNPOP (cpu, 2);
2184 return;
2185 }
2186
2187 fd = ST_HANDLE_VALUE (handle);
2188 buffer = st_byte_array_bytes (array);
2189 size = st_smi_value (st_arrayed_object_size (array));
2190
2191 total = 0;
2192 while (total < size) {
2193 count = write (fd, buffer + total, size - total);
2194 if (count < 0) {
2195 cpu->success = false;
2196 ST_STACK_UNPOP (cpu, 2);
2197 return;
2198 }
2199 total += count;
2200 }
2201
2202 /* leave receiver on stack */
2203 }
2204
2205 static void
2206 FileStream_seek (struct st_cpu *cpu)
2207 {
2208 /* not implemented yet */
2209 abort ();
2210 }
2211
2212 static void
2213 FileStream_read (struct st_cpu *cpu)
2214 {
2215 /* not implemented yet */
2216 abort ();
2217 }
2218
2219 const struct st_primitive st_primitives[] = {
2220 { "SmallInteger_add", SmallInteger_add },
2221 { "SmallInteger_sub", SmallInteger_sub },
2222 { "SmallInteger_lt", SmallInteger_lt },
2223 { "SmallInteger_gt", SmallInteger_gt },
2224 { "SmallInteger_le", SmallInteger_le },
2225 { "SmallInteger_ge", SmallInteger_ge },
2226 { "SmallInteger_eq", SmallInteger_eq },
2227 { "SmallInteger_ne", SmallInteger_ne },
2228 { "SmallInteger_mul", SmallInteger_mul },
2229 { "SmallInteger_div", SmallInteger_div },
2230 { "SmallInteger_intDiv", SmallInteger_intDiv },
2231 { "SmallInteger_mod", SmallInteger_mod },
2232 { "SmallInteger_bitOr", SmallInteger_bitOr },
2233 { "SmallInteger_bitXor", SmallInteger_bitXor },
2234 { "SmallInteger_bitAnd", SmallInteger_bitAnd },
2235 { "SmallInteger_bitShift", SmallInteger_bitShift },
2236 { "SmallInteger_asFloat", SmallInteger_asFloat },
2237 { "SmallInteger_asLargeInteger", SmallInteger_asLargeInteger },
2238
2239 { "LargeInteger_add", LargeInteger_add },
2240 { "LargeInteger_sub", LargeInteger_sub },
2241 { "LargeInteger_lt", LargeInteger_lt },
2242 { "LargeInteger_gt", LargeInteger_gt },
2243 { "LargeInteger_le", LargeInteger_le },
2244 { "LargeInteger_ge", LargeInteger_ge },
2245 { "LargeInteger_eq", LargeInteger_eq },
2246 { "LargeInteger_ne", LargeInteger_ne },
2247 { "LargeInteger_mul", LargeInteger_mul },
2248 { "LargeInteger_div", LargeInteger_div },
2249 { "LargeInteger_intDiv", LargeInteger_intDiv },
2250 { "LargeInteger_mod", LargeInteger_mod },
2251 { "LargeInteger_gcd", LargeInteger_gcd },
2252 { "LargeInteger_lcm", LargeInteger_lcm },
2253 { "LargeInteger_squared", LargeInteger_squared },
2254 { "LargeInteger_bitOr", LargeInteger_bitOr },
2255 { "LargeInteger_bitXor", LargeInteger_bitXor },
2256 { "LargeInteger_bitAnd", LargeInteger_bitAnd },
2257 { "LargeInteger_bitShift", LargeInteger_bitShift },
2258 { "LargeInteger_printStringBase", LargeInteger_printStringBase },
2259 { "LargeInteger_asFloat", LargeInteger_asFloat },
2260 { "LargeInteger_hash", LargeInteger_hash },
2261
2262 { "Float_add", Float_add },
2263 { "Float_sub", Float_sub },
2264 { "Float_lt", Float_lt },
2265 { "Float_gt", Float_gt },
2266 { "Float_le", Float_le },
2267 { "Float_ge", Float_ge },
2268 { "Float_eq", Float_eq },
2269 { "Float_ne", Float_ne },
2270 { "Float_mul", Float_mul },
2271 { "Float_div", Float_div },
2272 { "Float_exp", Float_exp },
2273 { "Float_sin", Float_sin },
2274 { "Float_cos", Float_cos },
2275 { "Float_tan", Float_tan },
2276 { "Float_arcSin", Float_arcSin },
2277 { "Float_arcCos", Float_arcCos },
2278 { "Float_arcTan", Float_arcTan },
2279 { "Float_ln", Float_ln },
2280 { "Float_log", Float_log },
2281 { "Float_sqrt", Float_sqrt },
2282 { "Float_truncated", Float_truncated },
2283 { "Float_fractionPart", Float_fractionPart },
2284 { "Float_integerPart", Float_integerPart },
2285 { "Float_hash", Float_hash },
2286 { "Float_printStringBase", Float_printStringBase },
2287
2288 { "Object_error", Object_error },
2289 { "Object_class", Object_class },
2290 { "Object_identityHash", Object_identityHash },
2291 { "Object_copy", Object_copy },
2292 { "Object_equivalent", Object_equivalent },
2293 { "Object_perform", Object_perform },
2294 { "Object_perform_withArguments", Object_perform_withArguments },
2295
2296 { "Behavior_new", Behavior_new },
2297 { "Behavior_newSize", Behavior_newSize },
2298 { "Behavior_compile", Behavior_compile },
2299
2300
2301 { "SequenceableCollection_size", SequenceableCollection_size },
2302
2303 { "Array_at", Array_at },
2304 { "Array_at_put", Array_at_put },
2305
2306 { "ByteArray_at", ByteArray_at },
2307 { "ByteArray_at_put", ByteArray_at_put },
2308 { "ByteArray_hash", ByteArray_hash },
2309
2310 { "ByteString_at", ByteString_at },
2311 { "ByteString_at_put", ByteString_at_put },
2312 { "ByteString_size", ByteString_size },
2313 { "ByteString_compare", ByteString_compare },
2314
2315 { "WideString_at", WideString_at },
2316 { "WideString_at_put", WideString_at_put },
2317
2318 { "WordArray_at", WordArray_at },
2319 { "WordArray_at_put", WordArray_at_put },
2320
2321 { "FloatArray_at", FloatArray_at },
2322 { "FloatArray_at_put", FloatArray_at_put },
2323
2324 { "System_exitWithResult", System_exitWithResult },
2325
2326 { "Character_value", Character_value },
2327 { "Character_characterFor", Character_characterFor },
2328
2329 { "BlockContext_value", BlockContext_value },
2330 { "BlockContext_valueWithArguments", BlockContext_valueWithArguments },
2331
2332 { "FileStream_open", FileStream_open },
2333 { "FileStream_close", FileStream_close },
2334 { "FileStream_read", FileStream_read },
2335 { "FileStream_write", FileStream_write },
2336 { "FileStream_seek", FileStream_seek },
2337
2338 };
2339
2340 /* returns 0 if there no primitive function corresponding
2341 * to the given name */
2342 int
2343 st_primitive_index_for_name (const char *name)
2344 {
2345 st_assert (name != NULL);
2346 for (int i = 0; i < ST_N_ELEMENTS (st_primitives); i++)
2347 if (streq (name, st_primitives[i].name))
2348 return i;
2349 return -1;
2350 }
2351
A Smalltalk implementation