?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
bumping version to 3.5-rc1
[supercollider.git] / lang / LangPrimSource / PyrArrayPrimitives.cpp
blobccac012f4f52dd4b378a2986429277ad4f726bba
1 /*
2 SuperCollider real time audio synthesis system
3 Copyright (c) 2002 James McCartney. All rights reserved.
4 http://www.audiosynth.com
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 */
20 /*
21
22 Primitives for Arrays.
23
24 */
25
26 #include "GC.h"
27 #include "PyrKernel.h"
28 #include "PyrPrimitive.h"
29 #include "SC_InlineBinaryOp.h"
30 #include "SC_Constants.h"
31 #include <string.h>
32
33 int basicSize(VMGlobals *g, int numArgsPushed);
34 int basicMaxSize(VMGlobals *g, int numArgsPushed);
35
36 int basicSwap(struct VMGlobals *g, int numArgsPushed);
37 int basicAt(VMGlobals *g, int numArgsPushed);
38 int basicRemoveAt(VMGlobals *g, int numArgsPushed);
39 int basicClipAt(VMGlobals *g, int numArgsPushed);
40 int basicWrapAt(VMGlobals *g, int numArgsPushed);
41 int basicFoldAt(VMGlobals *g, int numArgsPushed);
42 int basicPut(VMGlobals *g, int numArgsPushed);
43 int basicClipPut(VMGlobals *g, int numArgsPushed);
44 int basicWrapPut(VMGlobals *g, int numArgsPushed);
45 int basicFoldPut(VMGlobals *g, int numArgsPushed);
46
47 int prArrayAdd(VMGlobals *g, int numArgsPushed);
48 int prArrayFill(VMGlobals *g, int numArgsPushed);
49 int prArrayPop(VMGlobals *g, int numArgsPushed);
50 int prArrayGrow(VMGlobals *g, int numArgsPushed);
51 int prArrayCat(VMGlobals *g, int numArgsPushed);
52
53 int prArrayReverse(VMGlobals *g, int numArgsPushed);
54 int prArrayScramble(VMGlobals *g, int numArgsPushed);
55 int prArrayRotate(VMGlobals *g, int numArgsPushed);
56 int prArrayStutter(VMGlobals *g, int numArgsPushed);
57 int prArrayMirror(VMGlobals *g, int numArgsPushed);
58 int prArrayMirror1(VMGlobals *g, int numArgsPushed);
59 int prArrayMirror2(VMGlobals *g, int numArgsPushed);
60 int prArrayExtendWrap(VMGlobals *g, int numArgsPushed);
61 int prArrayExtendFold(VMGlobals *g, int numArgsPushed);
62 int prArrayPermute(VMGlobals *g, int numArgsPushed);
63 int prArrayPyramid(VMGlobals *g, int numArgsPushed);
64 int prArraySlide(VMGlobals *g, int numArgsPushed);
65 int prArrayLace(VMGlobals *g, int numArgsPushed);
66 int prArrayContainsSeqColl(VMGlobals *g, int numArgsPushed);
67 int prArrayWIndex(VMGlobals *g, int numArgsPushed);
68 int prArrayNormalizeSum(VMGlobals *g, int numArgsPushed);
69 int prArrayIndexOfGreaterThan(VMGlobals *g, int numArgsPushed);
70
71
72 int basicSize(struct VMGlobals *g, int numArgsPushed)
73 {
74 PyrSlot *a;
75 PyrObject *obj;
76
77 a = g->sp;
78 if (NotObj(a)) {
79 SetInt(a, 0);
80 return errNone;
81 }
82 obj = slotRawObject(a);
83 SetInt(a, obj->size);
84 return errNone;
85 }
86
87 int basicMaxSize(struct VMGlobals *g, int numArgsPushed)
88 {
89 PyrSlot *a;
90 PyrObject *obj;
91 int maxsize;
92
93 a = g->sp;
94 if (NotObj(a)) {
95 SetInt(a, 0);
96 return errNone;
97 }
98 obj = slotRawObject(a);
99 maxsize = MAXINDEXSIZE(obj);
100 SetInt(a, maxsize);
101 return errNone;
102 }
103
104 int basicSwap(struct VMGlobals *g, int numArgsPushed)
105 {
106 PyrSlot *a, *b, *c, tempi, tempj;
107 int i, j;
108 PyrObject *obj;
109
110 a = g->sp - 2;
111 b = g->sp - 1;
112 c = g->sp;
113
114 if (NotObj(a)) return errWrongType;
115 if (NotInt(b)) return errIndexNotAnInteger;
116 if (NotInt(c)) return errIndexNotAnInteger;
117 obj = slotRawObject(a);
118 if (obj->obj_flags & obj_immutable) return errImmutableObject;
119 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
120 return errNotAnIndexableObject;
121 i = slotRawInt(b);
122 j = slotRawInt(c);
123 if (i < 0 || i >= obj->size) return errIndexOutOfRange;
124 if (j < 0 || j >= obj->size) return errIndexOutOfRange;
125 getIndexedSlot(obj, &tempi, i);
126 getIndexedSlot(obj, &tempj, j);
127 putIndexedSlot(g, obj, &tempi, j);
128 putIndexedSlot(g, obj, &tempj, i);
129 // in case it is partial scan obj
130 g->gc->GCWrite(obj, &tempi);
131 g->gc->GCWrite(obj, &tempj);
132
133 return errNone;
134 }
135
136 int getIndexedInt(PyrObject *obj, int index, int *value);
137 void DumpBackTrace(VMGlobals *g);
138
139 int basicAt(struct VMGlobals *g, int numArgsPushed)
140 {
141 PyrSlot *a, *b;
142 int index;
143 PyrObject *obj;
144
145 a = g->sp - 1;
146 b = g->sp;
147
148 if (NotObj(a)) return errWrongType;
149 obj = slotRawObject(a);
150 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
151 return errNotAnIndexableObject;
152
153 int err = slotIntVal(b, &index);
154 if (!err) {
155 if (index < 0 || index >= obj->size) {
156 slotCopy(a,&o_nil);
157 } else {
158 getIndexedSlot(obj, a, index);
159 }
160 } else if (isKindOfSlot(b, class_arrayed_collection)) {
161 PyrObject *indexArray = slotRawObject(b);
162 int size = indexArray->size;
163 PyrObject *outArray = newPyrArray(g->gc, size, 0, true);
164 PyrSlot *outArraySlots = outArray->slots;
165 for (int i=0; i<size; ++i) {
166 int err = getIndexedInt(indexArray, i, &index);
167 if (err) return err;
168 if (index < 0 || index >= obj->size) {
169 slotCopy(&outArraySlots[i],&o_nil);
170 } else {
171 getIndexedSlot(obj, outArraySlots + i, index);
172 }
173 }
174 outArray->size = size;
175 SetObject(a, outArray);
176 } else {
177 return errIndexNotAnInteger;
178 }
179 return errNone;
180 }
181
182 int basicRemoveAt(struct VMGlobals *g, int numArgsPushed)
183 {
184 PyrSlot *a, *b;
185 int index, length, elemsize;
186 PyrObject *obj;
187 void *ptr;
188
189 a = g->sp - 1;
190 b = g->sp;
191
192 if (NotObj(a)) return errWrongType;
193 int err = slotIntVal(b, &index);
194 if (err) return errWrongType;
195
196 obj = slotRawObject(a);
197 if (obj->obj_flags & obj_immutable) return errImmutableObject;
198 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
199 return errNotAnIndexableObject;
200
201 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
202 switch (obj->obj_format) {
203 default :
204 case obj_slot :
205 ptr = obj->slots + index;
206 slotCopy(a, (PyrSlot*)ptr);
207 break;
208 case obj_double :
209 ptr = obj->slots + index;
210 SetFloat(a, *(double*)ptr);
211 break;
212 case obj_float :
213 ptr = ((float*)(obj->slots)) + index;
214 SetFloat(a, *(float*)ptr);
215 break;
216 case obj_int32 :
217 ptr = ((int32*)(obj->slots)) + index;
218 SetInt(a, *(int32*)ptr);
219 break;
220 case obj_int16 :
221 ptr = ((int16*)(obj->slots)) + index;
222 SetInt(a, *(int16*)ptr);
223 break;
224 case obj_int8 :
225 ptr = ((int8*)(obj->slots)) + index;
226 SetInt(a, *(int8*)ptr);
227 break;
228 case obj_symbol :
229 ptr = ((int*)(obj->slots)) + index;
230 SetSymbol(a, *(PyrSymbol**)ptr);
231 break;
232 case obj_char :
233 ptr = ((unsigned char*)(obj->slots)) + index;
234 SetChar(a, *(unsigned char*)ptr);
235 break;
236 }
237 length = obj->size - index - 1;
238 if (length > 0) {
239 elemsize = gFormatElemSize[obj->obj_format];
240 memmove(ptr, (char*)ptr + elemsize, length * elemsize);
241 if (obj->obj_format <= obj_slot) {
242 // might be partial scan object
243 g->gc->GCWrite(obj, obj->slots + index);
244 }
245 }
246 obj->size -- ;
247 return errNone;
248 }
249
250
251 int basicTakeAt(struct VMGlobals *g, int numArgsPushed);
252 int basicTakeAt(struct VMGlobals *g, int numArgsPushed)
253 {
254 PyrSlot *a, *b;
255 int index, lastIndex;
256 PyrObject *obj;
257
258 a = g->sp - 1;
259 b = g->sp;
260
261 if (NotObj(a)) return errWrongType;
262 int err = slotIntVal(b, &index);
263 if (err) return errWrongType;
264
265 obj = slotRawObject(a);
266 if (obj->obj_flags & obj_immutable) return errImmutableObject;
267 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
268 return errNotAnIndexableObject;
269
270 lastIndex = obj->size - 1;
271 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
272 switch (obj->obj_format) {
273 case obj_slot : {
274 PyrSlot* ptr = obj->slots + index;
275 PyrSlot* lastptr = obj->slots + lastIndex;
276 slotCopy(a, ptr);
277 *ptr = *lastptr;
278 // might be partial scan obj
279 g->gc->GCWrite(obj, ptr);
280 } break;
281 case obj_double : {
282 PyrSlot* ptr = obj->slots + index;
283 PyrSlot* lastptr = obj->slots + lastIndex;
284 SetFloat(a, *(double*)ptr);
285 *ptr = *lastptr;
286 // might be partial scan obj
287 g->gc->GCWrite(obj, ptr);
288 } break;
289 case obj_float : {
290 float* ptr = ((float*)(obj->slots)) + index;
291 float* lastptr = ((float*)(obj->slots)) + lastIndex;
292 SetFloat(a, *(float*)ptr);
293 *ptr = *lastptr;
294 } break;
295 case obj_int32 : {
296 int32* ptr = ((int32*)(obj->slots)) + index;
297 int32* lastptr = ((int32*)(obj->slots)) + lastIndex;
298 SetInt(a, *(int32*)ptr);
299 *ptr = *lastptr;
300 } break;
301 case obj_int16 : {
302 int16* ptr = ((int16*)(obj->slots)) + index;
303 int16* lastptr = ((int16*)(obj->slots)) + lastIndex;
304 SetInt(a, *(int16*)ptr);
305 *ptr = *lastptr;
306 } break;
307 case obj_int8 : {
308 int8* ptr = ((int8*)(obj->slots)) + index;
309 int8* lastptr = ((int8*)(obj->slots)) + lastIndex;
310 SetInt(a, *(int8*)ptr);
311 *ptr = *lastptr;
312 } break;
313 case obj_symbol : {
314 int32* ptr = ((int32*)(obj->slots)) + index;
315 int32* lastptr = ((int32*)(obj->slots)) + lastIndex;
316 SetSymbol(a, *(PyrSymbol**)ptr);
317 *ptr = *lastptr;
318 } break;
319 case obj_char : {
320 unsigned char* ptr = ((unsigned char*)(obj->slots)) + index;
321 unsigned char* lastptr = ((unsigned char*)(obj->slots)) + lastIndex;
322 SetChar(a, *(unsigned char*)ptr);
323 *ptr = *lastptr;
324 } break;
325 }
326 obj->size -- ;
327 return errNone;
328 }
329
330 int basicWrapAt(struct VMGlobals *g, int numArgsPushed)
331 {
332 PyrSlot *a, *b;
333 int index;
334 PyrObject *obj;
335 a = g->sp - 1;
336 b = g->sp;
337
338 if (NotObj(a)) return errWrongType;
339 obj = slotRawObject(a);
340 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
341 return errNotAnIndexableObject;
342
343 if(obj->size==0) {SetNil(a); return errNone; }
344
345 int err = slotIntVal(b, &index);
346
347 if (!err) {
348 index = sc_mod((int)index, (int)obj->size);
349 getIndexedSlot(obj, a, index);
350 } else if (isKindOfSlot(b, class_arrayed_collection)) {
351 PyrObject *indexArray = slotRawObject(b);
352 int size = indexArray->size;
353 PyrObject *outArray = newPyrArray(g->gc, size, 0, true);
354 PyrSlot *outArraySlots = outArray->slots;
355 for (int i=0; i<size; ++i) {
356 int err = getIndexedInt(indexArray, i, &index);
357 if (err) return err;
358 index = sc_mod((int)index, (int)obj->size);
359 getIndexedSlot(obj, outArraySlots + i, index);
360 }
361 outArray->size = size;
362 SetObject(a, outArray);
363 } else return errIndexNotAnInteger;
364
365 return errNone;
366 }
367
368 int basicFoldAt(struct VMGlobals *g, int numArgsPushed)
369 {
370 PyrSlot *a, *b;
371 int index;
372 PyrObject *obj;
373 a = g->sp - 1;
374 b = g->sp;
375
376 if (NotObj(a)) return errWrongType;
377 obj = slotRawObject(a);
378 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
379 return errNotAnIndexableObject;
380
381 if(obj->size==0) {SetNil(a); return errNone; }
382
383 int err = slotIntVal(b, &index);
384
385 if (!err) {
386 index = sc_fold(index, 0, obj->size-1);
387 getIndexedSlot(obj, a, index);
388 } else if (isKindOfSlot(b, class_arrayed_collection)) {
389 PyrObject *indexArray = slotRawObject(b);
390 int size = indexArray->size;
391 PyrObject *outArray = newPyrArray(g->gc, size, 0, true);
392 PyrSlot *outArraySlots = outArray->slots;
393 for (int i=0; i<size; ++i) {
394 int err = getIndexedInt(indexArray, i, &index);
395 if (err) return err;
396 index = sc_fold(index, 0, obj->size-1);
397 getIndexedSlot(obj, outArraySlots + i, index);
398 }
399 outArray->size = size;
400 SetObject(a, outArray);
401 } else return errIndexNotAnInteger;
402
403 return errNone;
404 }
405
406 int basicClipAt(struct VMGlobals *g, int numArgsPushed)
407 {
408 PyrSlot *a, *b;
409 int index;
410 PyrObject *obj;
411 a = g->sp - 1;
412 b = g->sp;
413
414 if (NotObj(a)) return errWrongType;
415 obj = slotRawObject(a);
416 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
417 return errNotAnIndexableObject;
418
419 if(obj->size==0) {SetNil(a); return errNone; }
420
421 int err = slotIntVal(b, &index);
422
423 if (!err) {
424 index = sc_clip(index, 0, obj->size - 1);
425 getIndexedSlot(obj, a, index);
426 } else if (isKindOfSlot(b, class_arrayed_collection)) {
427 PyrObject *indexArray = slotRawObject(b);
428 int size = indexArray->size;
429 PyrObject *outArray = newPyrArray(g->gc, size, 0, true);
430 PyrSlot *outArraySlots = outArray->slots;
431 for (int i=0; i<size; ++i) {
432 int err = getIndexedInt(indexArray, i, &index);
433 if (err) return err;
434 index = sc_clip(index, 0, obj->size - 1);
435 getIndexedSlot(obj, outArraySlots + i, index);
436 }
437 outArray->size = size;
438 SetObject(a, outArray);
439 } else return errIndexNotAnInteger;
440
441 return errNone;
442 }
443
444
445 int basicPut(struct VMGlobals *g, int numArgsPushed)
446 {
447 PyrSlot *a, *b, *c;
448 int index;
449 PyrObject *obj;
450
451 a = g->sp - 2;
452 b = g->sp - 1;
453 c = g->sp;
454
455 obj = slotRawObject(a);
456 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
457 return errNotAnIndexableObject;
458
459 if (NotObj(a)) return errWrongType;
460 int err = slotIntVal(b, &index);
461
462 if (!err) {
463 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
464 return putIndexedSlot(g, obj, c, index);
465 } else if (isKindOfSlot(b, class_arrayed_collection)) {
466 PyrObject *indexArray = slotRawObject(b);
467 int size = slotRawObject(b)->size;
468
469 for (int i=0; i<size; ++i) {
470 int index;
471 int err = getIndexedInt(indexArray, i, &index);
472 if (err) return err;
473 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
474 err = putIndexedSlot(g, obj, c, index);
475 if (err) return err;
476 }
477 return errNone;
478 } else return errIndexNotAnInteger;
479 }
480
481 int basicClipPut(struct VMGlobals *g, int numArgsPushed)
482 {
483 PyrSlot *a, *b, *c;
484 int index;
485 PyrObject *obj;
486
487 a = g->sp - 2;
488 b = g->sp - 1;
489 c = g->sp;
490
491 obj = slotRawObject(a);
492 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
493 return errNotAnIndexableObject;
494
495 if (NotObj(a)) return errWrongType;
496 int err = slotIntVal(b, &index);
497
498 if (!err) {
499 index = sc_clip(index, 0, obj->size - 1);
500 return putIndexedSlot(g, obj, c, index);
501 } else if (isKindOfSlot(b, class_arrayed_collection)) {
502 PyrObject *indexArray = slotRawObject(b);
503 int size = slotRawObject(b)->size;
504
505 for (int i=0; i<size; ++i) {
506 int index;
507 int err = getIndexedInt(indexArray, i, &index);
508 if (err) return err;
509 index = sc_clip(index, 0, obj->size - 1);
510 err = putIndexedSlot(g, obj, c, index);
511 if (err) return err;
512 }
513 return errNone;
514 } else return errIndexNotAnInteger;
515 }
516
517 int basicWrapPut(struct VMGlobals *g, int numArgsPushed)
518 {
519 PyrSlot *a, *b, *c;
520 int index;
521 PyrObject *obj;
522
523 a = g->sp - 2;
524 b = g->sp - 1;
525 c = g->sp;
526
527 obj = slotRawObject(a);
528 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
529 return errNotAnIndexableObject;
530
531 if (NotObj(a)) return errWrongType;
532 int err = slotIntVal(b, &index);
533
534 if (!err) {
535 index = sc_mod((int)index, (int)obj->size);
536 return putIndexedSlot(g, obj, c, index);
537 } else if (isKindOfSlot(b, class_arrayed_collection)) {
538 PyrObject *indexArray = slotRawObject(b);
539 int size = slotRawObject(b)->size;
540
541 for (int i=0; i<size; ++i) {
542 int index;
543 int err = getIndexedInt(indexArray, i, &index);
544 if (err) return err;
545 index = sc_mod((int)index, (int)obj->size);
546 err = putIndexedSlot(g, obj, c, index);
547 if (err) return err;
548 }
549 return errNone;
550 } else return errIndexNotAnInteger;
551 }
552
553 int basicFoldPut(struct VMGlobals *g, int numArgsPushed)
554 {
555 PyrSlot *a, *b, *c;
556 int index;
557 PyrObject *obj;
558
559 a = g->sp - 2;
560 b = g->sp - 1;
561 c = g->sp;
562
563 obj = slotRawObject(a);
564 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
565 return errNotAnIndexableObject;
566
567 if (NotObj(a)) return errWrongType;
568 int err = slotIntVal(b, &index);
569
570 if (!err) {
571 index = sc_fold(index, 0, obj->size-1);
572 return putIndexedSlot(g, obj, c, index);
573 } else if (isKindOfSlot(b, class_arrayed_collection)) {
574 PyrObject *indexArray = slotRawObject(b);
575 int size = slotRawObject(b)->size;
576
577 for (int i=0; i<size; ++i) {
578 int index;
579 int err = getIndexedInt(indexArray, i, &index);
580 if (err) return err;
581 index = sc_fold(index, 0, obj->size-1);
582 err = putIndexedSlot(g, obj, c, index);
583 if (err) return err;
584 }
585 return errNone;
586 } else return errIndexNotAnInteger;
587 }
588
589 int prArrayPutEach(struct VMGlobals *g, int numArgsPushed)
590 {
591 PyrSlot *a, *b, *c;
592 PyrObject *obj;
593
594 a = g->sp - 2;
595 b = g->sp - 1;
596 c = g->sp;
597
598 obj = slotRawObject(a);
599 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
600 return errNotAnIndexableObject;
601
602 if (!isKindOfSlot(b, class_arrayed_collection)) return errWrongType;
603 if (!isKindOfSlot(c, class_arrayed_collection)) return errWrongType;
604
605 PyrSlot *indices = slotRawObject(b)->slots;
606 PyrSlot *values = slotRawObject(c)->slots;
607 int size = slotRawObject(b)->size;
608 int valsize = slotRawObject(c)->size;
609
610 for (int i=0; i<size; ++i) {
611 int index;
612 int err = slotIntVal(indices + i, &index);
613 if (err) return err;
614 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
615 int valindex = sc_mod(i, valsize);
616 err = putIndexedSlot(g, obj, values + valindex, index);
617 if (err) return err;
618 }
619
620 return errNone;
621 }
622
623
624 int prArrayAssocAt(struct VMGlobals *g, int numArgsPushed)
625 {
626 PyrSlot *a, *b;
627 PyrObject *obj;
628 bool found = false;
629
630 a = g->sp - 1;
631 b = g->sp;
632
633 obj = slotRawObject(a);
634
635 int size = obj->size;
636 if (obj->obj_format == obj_slot) {
637 PyrSlot *slots = obj->slots;
638 for (int i=0; i<size; i+=2) {
639 if (SlotEq(slots+i, b)) {
640 if (i+1 >= size) return errFailed;
641 slotCopy(a,&slots[i+1]);
642 found = true;
643 break;
644 }
645 }
646 } else {
647 PyrSlot slot;
648 for (int i=0; i<size; i+=2) {
649 getIndexedSlot(obj, &slot, i);
650 if (SlotEq(&slot, b)) {
651 if (i+1 >= size) return errFailed;
652 getIndexedSlot(obj, &slot, i+1);
653 slotCopy(a,&slot);
654 found = true;
655 break;
656 }
657 }
658 }
659 if (!found) SetNil(a);
660
661 return errNone;
662 }
663
664
665 int prArrayAssocPut(struct VMGlobals *g, int numArgsPushed)
666 {
667 PyrSlot *a, *b, *c;
668 PyrObject *obj;
669 bool found = false;
670
671 a = g->sp - 2;
672 b = g->sp - 1;
673 c = g->sp;
674
675 obj = slotRawObject(a);
676
677 int size = obj->size;
678 if (obj->obj_format == obj_slot) {
679 PyrSlot *slots = obj->slots;
680 for (int i=0; i<size; i+=2) {
681 if (SlotEq(slots+i, b)) {
682 if (i+1 >= size) return errFailed;
683 slotCopy(&slots[i+1],c);
684 g->gc->GCWrite(obj, c);
685 found = true;
686 break;
687 }
688 }
689 } else {
690 PyrSlot slot;
691 for (int i=0; i<size; i+=2) {
692 getIndexedSlot(obj, &slot, i);
693 if (SlotEq(&slot, b)) {
694 if (i+1 >= size) return errFailed;
695 putIndexedSlot(g, obj, &slot, i+1);
696 g->gc->GCWrite(obj, c);
697 found = true;
698 break;
699 }
700 }
701 }
702 if (!found) SetNil(a);
703
704 return errNone;
705 }
706
707 int prArrayIndexOf(struct VMGlobals *g, int numArgsPushed)
708 {
709 PyrSlot *a, *b;
710 PyrObject *obj;
711 bool found = false;
712
713 a = g->sp - 1;
714 b = g->sp;
715
716 obj = slotRawObject(a);
717
718 int size = obj->size;
719 if (obj->obj_format == obj_slot) {
720 PyrSlot *slots = obj->slots;
721 for (int i=0; i<size; ++i) {
722 if (SlotEq(slots+i, b)) {
723 SetInt(a, i);
724 found = true;
725 break;
726 }
727 }
728 } else {
729 PyrSlot slot;
730 for (int i=0; i<size; ++i) {
731 getIndexedSlot(obj, &slot, i);
732 if (SlotEq(&slot, b)) {
733 SetInt(a, i);
734 found = true;
735 break;
736 }
737 }
738 }
739 if (!found) SetNil(a);
740
741 return errNone;
742 }
743
744
745 int prArrayPutSeries(struct VMGlobals *g, int numArgsPushed)
746 {
747 PyrSlot *a, *b, *c, *d, *e;
748
749 a = g->sp - 4;
750 b = g->sp - 3;
751 c = g->sp - 2;
752 d = g->sp - 1;
753 e = g->sp;
754
755 PyrObject *inobj = slotRawObject(a);
756
757 int size = inobj->size;
758
759 if (NotInt(b) && NotNil(b)) return errWrongType;
760 if (NotInt(c) && NotNil(c)) return errWrongType;
761 if (NotInt(d) && NotNil(d)) return errWrongType;
762
763 int first = IsInt(b) ? slotRawInt(b) : 0;
764 int last = IsInt(d) ? slotRawInt(d) : size - 1;
765 int second = IsInt(c) ? slotRawInt(c) : (first < last ? first + 1 : first - 1);
766
767 int step = second - first;
768
769 first = sc_clip(first, 0, size-1);
770 last = sc_clip(last, 0, size-1);
771
772 int err = errNone;
773
774 if (step == 0) return errFailed;
775 if (step == 1) {
776 for (int i=first; i<=last; ++i) {
777 err = putIndexedSlot(g, inobj, e, i);
778 if (err) return err;
779 }
780 } else if (step == -1) {
781 for (int i=last; i>=first; --i) {
782 err = putIndexedSlot(g, inobj, e, i);
783 if (err) return err;
784 }
785 } else if (step > 0) {
786 int length = (last - first) / step + 1;
787
788 for (int i=first, j=0; j<length; i+=step, ++j) {
789 err = putIndexedSlot(g, inobj, e, i);
790 if (err) return err;
791 }
792 } else if (step < 0) {
793 int length = (first - last) / -step + 1;
794
795 for (int i=first, j=0; j<length; i+=step, ++j) {
796 err = putIndexedSlot(g, inobj, e, i);
797 if (err) return err;
798 }
799 }
800 return errNone;
801 }
802
803
804 int prArrayAdd(struct VMGlobals *g, int numArgsPushed);
805 int prArrayAdd(struct VMGlobals *g, int numArgsPushed)
806 {
807 PyrSlot *a, *b, *slots;
808 PyrObject *array;
809 int maxelems, elemsize, format, tag, numbytes;
810 int err, ival;
811 double fval;
812
813 a = g->sp - 1;
814 b = g->sp;
815
816 array = slotRawObject(a);
817 if (array->obj_flags & obj_immutable) return errImmutableObject;
818 format = slotRawObject(a)->obj_format;
819 tag = gFormatElemTag[format];
820 /*if (tag > 0) {
821 if (GetTag(b) != tag) return errWrongType;
822 } else if (tag == 0) {
823 if (NotFloat(b)) return errWrongType;
824 } // else format is obj_slot, any tag is acceptable*/
825 elemsize = gFormatElemSize[format];
826 maxelems = MAXINDEXSIZE(array);
827 if (array->size >= maxelems) {
828 numbytes = sizeof(PyrSlot) << (array->obj_sizeclass + 1);
829 array = g->gc->New(numbytes, 0, format, true);
830 array->classptr = slotRawObject(a)->classptr;
831 array->size = slotRawObject(a)->size;
832 memcpy(array->slots, slotRawObject(a)->slots, slotRawObject(a)->size * elemsize);
833 SetRaw(a, array);
834 }
835 slots = array->slots;
836 switch (format) {
837 case obj_slot :
838 slotCopy(&slots[array->size++],b);
839 g->gc->GCWrite(array, b);
840 break;
841 case obj_int32 :
842 err = slotIntVal(b, &ival);
843 if (err) return err;
844 ((int32*)slots)[array->size++] = ival;
845 break;
846 case obj_int16 :
847 err = slotIntVal(b, &ival);
848 if (err) return err;
849 ((int16*)slots)[array->size++] = ival;
850 break;
851 case obj_int8 :
852 err = slotIntVal(b, &ival);
853 if (err) return err;
854 ((int8*)slots)[array->size++] = ival;
855 break;
856 case obj_char :
857 if (NotChar(b)) return errWrongType;
858 ((char*)slots)[array->size++] = slotRawChar(b);
859 break;
860 case obj_symbol :
861 if (NotSym(b)) return errWrongType;
862 ((PyrSymbol**)slots)[array->size++] = slotRawSymbol(b);
863 break;
864 case obj_float :
865 err = slotDoubleVal(b, &fval);
866 if (err) return err;
867 ((float*)slots)[array->size++] = fval;
868 break;
869 case obj_double :
870 err = slotDoubleVal(b, &fval);
871 if (err) return err;
872 ((double*)slots)[array->size++] = fval;
873 break;
874 }
875 return errNone;
876 }
877
878
879 int prArrayInsert(struct VMGlobals *g, int numArgsPushed);
880 int prArrayInsert(struct VMGlobals *g, int numArgsPushed)
881 {
882 PyrSlot *a, *b, *c, *slots1, *slots2;
883 PyrObject *array, *oldarray;
884 int maxelems, elemsize, format, tag;
885 int err, ival, size, index, remain, numbytes;
886 double fval;
887
888 a = g->sp - 2; // array
889 b = g->sp - 1; // index
890 c = g->sp; // value
891 if (NotInt(b)) return errWrongType;
892
893 array = slotRawObject(a);
894 if (array->obj_flags & obj_immutable) return errImmutableObject;
895 format = slotRawObject(a)->obj_format;
896 tag = gFormatElemTag[format];
897
898 size = array->size;
899 index = slotRawInt(b);
900 index = sc_clip(index, 0, size);
901 remain = size - index;
902
903 elemsize = gFormatElemSize[format];
904 maxelems = MAXINDEXSIZE(array);
905 if (size+1 > maxelems) {
906 oldarray = array;
907
908 numbytes = sizeof(PyrSlot) << (array->obj_sizeclass + 1);
909 array = g->gc->New(numbytes, 0, format, true);
910
911 array->classptr = oldarray->classptr;
912
913 array->size = size+1;
914 SetRaw(a, array);
915 slots1 = array->slots;
916 slots2 = oldarray->slots;
917 if (index) {
918 memcpy(slots1, slots2, index * elemsize);
919 }
920
921 switch (format) {
922 case obj_slot :
923
924 slotCopy(&slots1[index],c);
925 if (remain) memcpy(slots1 + index + 1, slots2 + index, remain * elemsize);
926 if (!g->gc->ObjIsGrey(array)) g->gc->ToGrey(array);
927 break;
928 case obj_int32 :
929 err = slotIntVal(c, &ival);
930 if (err) return err;
931 ((int32*)slots1)[index] = ival;
932 if (remain) {
933 memcpy((int*)slots1 + index + 1, (int*)slots2 + index,
934 remain * elemsize);
935 }
936 break;
937 case obj_int16 :
938 err = slotIntVal(c, &ival);
939 if (err) return err;
940 ((int16*)slots1)[index] = ival;
941 if (remain) {
942 memcpy((short*)slots1 + index + 1, (short*)slots2 + index,
943 remain * elemsize);
944 }
945 break;
946 case obj_int8 :
947 err = slotIntVal(c, &ival);
948 if (err) return err;
949 ((int8*)slots1)[index] = ival;
950 if (remain) {
951 memcpy((char*)slots1 + index + 1, (char*)slots2 + index,
952 remain * elemsize);
953 }
954 break;
955 case obj_char :
956 if (NotChar(c)) return errWrongType;
957 ((char*)slots1)[index] = slotRawInt(c);
958 if (remain) {
959 memcpy((char*)slots1 + index + 1, (char*)slots2 + index,
960 remain * elemsize);
961 }
962 break;
963 case obj_symbol :
964 if (NotSym(c)) return errWrongType;
965 ((PyrSymbol**)slots1)[index] = slotRawSymbol(c);
966 if (remain) {
967 memcpy((int*)slots1 + index + 1, (int*)slots2 + index,
968 remain * elemsize);
969 }
970 break;
971 case obj_float :
972 err = slotDoubleVal(c, &fval);
973 if (err) return err;
974 ((float*)slots1)[index] = fval;
975 if (remain) {
976 memcpy((float*)slots1 + index + 1, (float*)slots2 + index,
977 remain * elemsize);
978 }
979 break;
980 case obj_double :
981 err = slotDoubleVal(c, &fval);
982 if (err) return err;
983 ((double*)slots1)[index] = fval;
984 if (remain) {
985 memcpy((double*)slots1 + index + 1, (double*)slots2 + index,
986 remain * elemsize);
987 }
988 break;
989 }
990 } else {
991 array->size = size+1;
992 slots1 = array->slots;
993 switch (format) {
994 case obj_slot :
995 if (remain) memmove(slots1 + index + 1, slots1 + index, remain * elemsize);
996 slotCopy(&slots1[index],c);
997 if (!g->gc->ObjIsGrey(array)) g->gc->ToGrey(array);
998 break;
999 case obj_int32 :
1000 if (remain) {
1001 memmove((int*)slots1 + index + 1, (int*)slots1 + index,
1002 remain * elemsize);
1003 }
1004 err = slotIntVal(c, &ival);
1005 if (err) return err;
1006 ((int32*)slots1)[index] = ival;
1007 break;
1008 case obj_int16 :
1009 if (remain) {
1010 memmove((short*)slots1 + index + 1, (short*)slots1 + index,
1011 remain * elemsize);
1012 }
1013 err = slotIntVal(c, &ival);
1014 if (err) return err;
1015 ((int16*)slots1)[index] = ival;
1016 break;
1017 case obj_int8 :
1018 if (remain) {
1019 memmove((char*)slots1 + index + 1, (char*)slots1 + index,
1020 remain * elemsize);
1021 }
1022 err = slotIntVal(c, &ival);
1023 if (err) return err;
1024 ((int8*)slots1)[index] = ival;
1025 break;
1026 case obj_char :
1027 if (remain) {
1028 memmove((char*)slots1 + index + 1, (char*)slots1 + index,
1029 remain * elemsize);
1030 }
1031 if (NotChar(c)) return errWrongType;
1032 ((char*)slots1)[index] = slotRawInt(c);
1033 break;
1034 case obj_symbol :
1035 if (remain) {
1036 memmove((int*)slots1 + index + 1, (int*)slots1 + index,
1037 remain * elemsize);
1038 }
1039 if (NotSym(c)) return errWrongType;
1040 ((PyrSymbol**)slots1)[index] = slotRawSymbol(c);
1041 break;
1042 case obj_float :
1043 if (remain) {
1044 memmove((float*)slots1 + index + 1, (float*)slots1 + index,
1045 remain * elemsize);
1046 }
1047 err = slotDoubleVal(c, &fval);
1048 if (err) return err;
1049 ((float*)slots1)[index] = fval;
1050 break;
1051 case obj_double :
1052 if (remain) {
1053 memmove((double*)slots1 + index + 1, (double*)slots1 + index,
1054 remain * elemsize);
1055 }
1056 err = slotDoubleVal(c, &fval);
1057 if (err) return err;
1058 ((double*)slots1)[index] = fval;
1059 break;
1060 }
1061 }
1062 return errNone;
1063 }
1064
1065 int prArrayFill(struct VMGlobals *g, int numArgsPushed);
1066 int prArrayFill(struct VMGlobals *g, int numArgsPushed)
1067 {
1068 PyrSlot *a, *b, *slots;
1069 PyrObject *array;
1070 PyrSymbol *sym;
1071 int i;
1072 int format, tag;
1073 int err, ival;
1074 double fval;
1075
1076
1077 a = g->sp - 1;
1078 b = g->sp;
1079
1080 array = slotRawObject(a);
1081 format = slotRawObject(a)->obj_format;
1082 tag = gFormatElemTag[format];
1083 /*if (tag > 0) {
1084 if (GetTag(b) != tag) return errWrongType;
1085 } else if (tag == 0) {
1086 if (NotFloat(b)) return errWrongType;
1087 } // else format is obj_slot, any tag is acceptable*/
1088 slots = array->slots;
1089 switch (format) {
1090 case obj_slot :
1091 if (array->obj_flags & obj_immutable) return errImmutableObject;
1092 for (i=0; i<array->size; ++i) {
1093 slotCopy(&slots[i],b);
1094 }
1095 g->gc->GCWrite(array, b);
1096 break;
1097 case obj_int32 :
1098 err = slotIntVal(b, &ival);
1099 if (err) return err;
1100 for (i=0; i<array->size; ++i) {
1101 ((int32*)slots)[i] = ival;
1102 }
1103 break;
1104 case obj_int16 :
1105 err = slotIntVal(b, &ival);
1106 if (err) return err;
1107 for (i=0; i<array->size; ++i) {
1108 ((int16*)slots)[i] = ival;
1109 }
1110 break;
1111 case obj_int8 :
1112 err = slotIntVal(b, &ival);
1113 if (err) return err;
1114 for (i=0; i<array->size; ++i) {
1115 ((int8*)slots)[i] = ival;
1116 }
1117 break;
1118 case obj_char :
1119 if (NotChar(b)) return errWrongType;
1120 ival = slotRawInt(b);
1121 for (i=0; i<array->size; ++i) {
1122 ((char*)slots)[i] = ival;
1123 }
1124 break;
1125 case obj_symbol :
1126 if (NotSym(b)) return errWrongType;
1127 sym = slotRawSymbol(b);
1128 for (i=0; i<array->size; ++i) {
1129 ((PyrSymbol**)slots)[i] = sym;
1130 }
1131 break;
1132 case obj_float :
1133 err = slotDoubleVal(b, &fval);
1134 if (err) return err;
1135 for (i=0; i<array->size; ++i) {
1136 ((float*)slots)[i] = fval;
1137 }
1138 break;
1139 case obj_double :
1140 err = slotDoubleVal(b, &fval);
1141 if (err) return err;
1142 for (i=0; i<array->size; ++i) {
1143 ((double*)slots)[i] = fval;
1144 }
1145 break;
1146 }
1147 return errNone;
1148 }
1149
1150 int prArrayPop(struct VMGlobals *g, int numArgsPushed);
1151 int prArrayPop(struct VMGlobals *g, int numArgsPushed)
1152 {
1153 PyrSlot *a, *slots;
1154 PyrObject *array;
1155 int z;
1156 int format;
1157 PyrSymbol *sym;
1158
1159 a = g->sp;
1160
1161 array = slotRawObject(a);
1162 if (array->obj_flags & obj_immutable) return errImmutableObject;
1163 if (array->size > 0) {
1164 format = array->obj_format;
1165 slots = array->slots;
1166 switch (format) {
1167 case obj_slot :
1168 slotCopy(a,&slots[--array->size]);
1169 break;
1170 case obj_int32 :
1171 z = ((int32*)slots)[--array->size];
1172 SetInt(a, z);
1173 break;
1174 case obj_int16 :
1175 z = ((int16*)slots)[--array->size];
1176 SetInt(a, z);
1177 break;
1178 case obj_int8 :
1179 z = ((int8*)slots)[--array->size];
1180 SetInt(a, z);
1181 break;
1182 case obj_char :
1183 z = ((char*)slots)[--array->size];
1184 SetChar(a, z);
1185 break;
1186 case obj_symbol :
1187 sym = ((PyrSymbol**)slots)[--array->size];
1188 SetSymbol(a, sym);
1189 break;
1190 case obj_float :
1191 SetFloat(a, ((float*)slots)[--array->size]);
1192 break;
1193 case obj_double :
1194 SetFloat(a, slotRawFloat(&slots[--array->size]));
1195 break;
1196 }
1197 } else {
1198 slotCopy(a,&o_nil);
1199 }
1200 return errNone;
1201 }
1202
1203 int prArrayExtend(struct VMGlobals *g, int numArgsPushed);
1204 int prArrayExtend(struct VMGlobals *g, int numArgsPushed)
1205 {
1206 int numbytes, elemsize, format;
1207 int err;
1208
1209 PyrSlot *a = g->sp - 2; // array
1210 PyrSlot *b = g->sp - 1; // size
1211 PyrSlot *c = g->sp; // filler item
1212
1213
1214 if (NotInt(b)) return errWrongType;
1215 PyrObject* aobj = slotRawObject(a);
1216 if (slotRawInt(b) <= aobj->size) {
1217 aobj->size = slotRawInt(b);
1218 return errNone;
1219 }
1220
1221 format = aobj->obj_format;
1222 if (slotRawInt(b) > MAXINDEXSIZE(aobj)) {
1223 elemsize = gFormatElemSize[format];
1224 numbytes = slotRawInt(b) * elemsize;
1225
1226 PyrObject *obj = g->gc->New(numbytes, 0, format, true);
1227 obj->classptr = aobj->classptr;
1228 obj->size = aobj->size;
1229 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1230 aobj = obj;
1231 SetRaw(a, aobj);
1232 }
1233
1234
1235 int fillSize = slotRawInt(b) - aobj->size;
1236 int32 ival;
1237 float fval;
1238 double dval;
1239
1240 PyrSlot *slots = aobj->slots;
1241 switch (format) {
1242 case obj_slot :
1243 fillSlots(slots + aobj->size, fillSize, c);
1244 g->gc->GCWrite(aobj, c);
1245 break;
1246 case obj_int32 : {
1247 int32* ptr = (int32*)slots + aobj->size;
1248 err = slotIntVal(c, &ival);
1249 if (err) return err;
1250 for (int i=0; i<fillSize; ++i) ptr[i] = ival;
1251 } break;
1252 case obj_int16 : {
1253 int16* ptr = (int16*)slots + aobj->size;
1254 err = slotIntVal(c, &ival);
1255 if (err) return err;
1256 for (int i=0; i<fillSize; ++i) ptr[i] = ival;
1257 } break;
1258 case obj_int8 : {
1259 int8* ptr = (int8*)slots + aobj->size;
1260 err = slotIntVal(c, &ival);
1261 if (err) return err;
1262 for (int i=0; i<fillSize; ++i) ptr[i] = ival;
1263 } break;
1264 case obj_char : {
1265 char* ptr = (char*)slots + aobj->size;
1266 if (NotChar(c)) return errWrongType;
1267 ival = slotRawChar(c);
1268 for (int i=0; i<fillSize; ++i) ptr[i] = ival;
1269 } break;
1270 case obj_symbol : {
1271 PyrSymbol** ptr = (PyrSymbol**)slots + aobj->size;
1272 if (NotSym(c)) return errWrongType;
1273 PyrSymbol *sym = slotRawSymbol(c);
1274 for (int i=0; i<fillSize; ++i) ptr[i] = sym;
1275 } break;
1276 case obj_float : {
1277 float* ptr = (float*)slots + aobj->size;
1278 err = slotFloatVal(c, &fval);
1279 for (int i=0; i<fillSize; ++i) ptr[i] = fval;
1280 } break;
1281 case obj_double : {
1282 double* ptr = (double*)slots + aobj->size;
1283 err = slotDoubleVal(c, &dval);
1284 for (int i=0; i<fillSize; ++i) ptr[i] = dval;
1285 } break;
1286 }
1287
1288 aobj->size = slotRawInt(b);
1289 return errNone;
1290 }
1291
1292 int prArrayGrow(struct VMGlobals *g, int numArgsPushed);
1293 int prArrayGrow(struct VMGlobals *g, int numArgsPushed)
1294 {
1295 PyrSlot *a, *b;
1296 PyrObject *obj, *aobj;
1297 int numbytes, elemsize, format;
1298
1299 a = g->sp - 1;
1300 b = g->sp;
1301
1302 if (NotInt(b)) return errWrongType;
1303 if (slotRawInt(b) <= 0) return errNone;
1304 aobj = slotRawObject(a);
1305
1306 if (aobj->size + slotRawInt(b) <= MAXINDEXSIZE(aobj)) return errNone;
1307
1308 format = aobj->obj_format;
1309 elemsize = gFormatElemSize[format];
1310 numbytes = ((aobj->size + slotRawInt(b)) * elemsize);
1311
1312 obj = g->gc->New(numbytes, 0, format, true);
1313 obj->classptr = aobj->classptr;
1314 obj->size = aobj->size;
1315 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1316 SetRaw(a, obj);
1317
1318 return errNone;
1319 }
1320
1321 int prArrayGrowClear(struct VMGlobals *g, int numArgsPushed);
1322 int prArrayGrowClear(struct VMGlobals *g, int numArgsPushed)
1323 {
1324 PyrSlot *a, *b;
1325 PyrObject *obj, *aobj;
1326 int numbytes, elemsize, format;
1327
1328 a = g->sp - 1;
1329 b = g->sp;
1330
1331 if (NotInt(b)) return errWrongType;
1332 if (slotRawInt(b) <= 0) return errNone;
1333 aobj = slotRawObject(a);
1334
1335 if (aobj->size + slotRawInt(b) <= MAXINDEXSIZE(aobj)) {
1336 obj = aobj;
1337 } else {
1338 format = aobj->obj_format;
1339 elemsize = gFormatElemSize[format];
1340 numbytes = ((aobj->size + slotRawInt(b)) * elemsize);
1341
1342 obj = g->gc->New(numbytes, 0, format, true);
1343 obj->classptr = aobj->classptr;
1344 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1345 }
1346
1347 if (obj->obj_format == obj_slot) {
1348 nilSlots(obj->slots + aobj->size, slotRawInt(b));
1349 } else {
1350 memset((char*)(obj->slots) + aobj->size * gFormatElemSize[format],
1351 0, slotRawInt(b) * gFormatElemSize[format]);
1352 }
1353 obj->size = aobj->size + slotRawInt(b);
1354 SetRaw(a, obj);
1355
1356 return errNone;
1357 }
1358
1359 int prArrayCat(struct VMGlobals *g, int numArgsPushed);
1360 int prArrayCat(struct VMGlobals *g, int numArgsPushed)
1361 {
1362 PyrSlot *a, *b;
1363 PyrObject *obj, *aobj, *bobj;
1364 int elemsize, size;
1365 int numbytes, format;
1366
1367 a = g->sp - 1;
1368 b = g->sp;
1369
1370 if (NotObj(b) || slotRawObject(a)->classptr != slotRawObject(b)->classptr) return errWrongType;
1371 aobj = slotRawObject(a);
1372 bobj = slotRawObject(b);
1373 size = aobj->size + bobj->size;
1374 format = aobj->obj_format;
1375 assert(aobj->obj_format == bobj->obj_format);
1376 elemsize = gFormatElemSize[format];
1377 numbytes = (size * elemsize);
1378
1379 obj = g->gc->New(numbytes, 0, format, true);
1380 obj->classptr = aobj->classptr;
1381 obj->size = size;
1382 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1383 memcpy((char*)obj->slots + aobj->size * elemsize,
1384 bobj->slots, bobj->size * elemsize);
1385 SetObject(a, obj);
1386
1387 return errNone;
1388 }
1389
1390
1391 int prArrayAddAll(struct VMGlobals *g, int numArgsPushed);
1392 int prArrayAddAll(struct VMGlobals *g, int numArgsPushed)
1393 {
1394 PyrSlot *a, *b;
1395 PyrObject *obj, *aobj;
1396 int elemsize, newindexedsize, newsizebytes, asize, bsize;
1397 int format;
1398
1399 a = g->sp - 1;
1400 b = g->sp;
1401
1402 if (NotObj(b) || slotRawObject(a)->classptr != slotRawObject(b)->classptr) return errWrongType;
1403 aobj = slotRawObject(a);
1404 format = aobj->obj_format;
1405 elemsize = gFormatElemSize[format];
1406 asize = aobj->size;
1407 bsize = slotRawObject(b)->size;
1408 newindexedsize = asize + bsize;
1409 newsizebytes = newindexedsize * elemsize;
1410
1411 if (newindexedsize > MAXINDEXSIZE(aobj)) {
1412 obj = g->gc->New(newsizebytes, 0, format, true);
1413 obj->classptr = aobj->classptr;
1414 memcpy(obj->slots, aobj->slots, asize * elemsize);
1415 SetObject(a, obj);
1416 } else {
1417 obj = aobj;
1418 if (format == obj_slot && !g->gc->ObjIsGrey(obj)) {
1419 g->gc->ToGrey(obj);
1420 }
1421 }
1422 obj->size = newindexedsize;
1423 memcpy((char*)obj->slots + asize * elemsize,
1424 slotRawObject(b)->slots, bsize * elemsize);
1425 return errNone;
1426 }
1427
1428
1429 int prArrayOverwrite(struct VMGlobals *g, int numArgsPushed);
1430 int prArrayOverwrite(struct VMGlobals *g, int numArgsPushed)
1431 {
1432 PyrSlot *a, *b, *c;
1433 PyrObject *obj, *aobj;
1434 int err, elemsize, newindexedsize, newsizebytes, pos, asize, bsize;
1435 int format;
1436
1437 a = g->sp - 2;
1438 b = g->sp - 1;
1439 c = g->sp; // pos
1440
1441 if (NotObj(b) || slotRawObject(a)->classptr != slotRawObject(b)->classptr) return errWrongType;
1442 err = slotIntVal(c, &pos);
1443 if (err) return errWrongType;
1444 if (pos < 0 || pos > slotRawObject(a)->size) return errIndexOutOfRange;
1445
1446 aobj = slotRawObject(a);
1447 format = aobj->obj_format;
1448 elemsize = gFormatElemSize[format];
1449 asize = aobj->size;
1450 bsize = slotRawObject(b)->size;
1451 newindexedsize = pos + bsize;
1452 newindexedsize = sc_max(asize, newindexedsize);
1453 newsizebytes = newindexedsize * elemsize;
1454
1455 if (newindexedsize > MAXINDEXSIZE(aobj)) {
1456 obj = g->gc->New(newsizebytes, 0, format, true);
1457 obj->classptr = aobj->classptr;
1458 memcpy(obj->slots, aobj->slots, asize * elemsize);
1459 SetObject(a, obj);
1460 } else {
1461 obj = aobj;
1462 if (format == obj_slot && !g->gc->ObjIsGrey(obj)) {
1463 g->gc->ToGrey(obj);
1464 }
1465 }
1466 obj->size = newindexedsize;
1467 memcpy((char*)(obj->slots) + pos * elemsize,
1468 slotRawObject(b)->slots, bsize * elemsize);
1469
1470 return errNone;
1471 }
1472
1473 int prArrayReverse(struct VMGlobals *g, int numArgsPushed)
1474 {
1475 PyrSlot *a, *slots1, *slots2;
1476 PyrObject *obj1, *obj2;
1477 int i, j, size;
1478
1479 a = g->sp;
1480 obj1 = slotRawObject(a);
1481 size = obj1->size;
1482 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1483 slots1 = obj1->slots;
1484 slots2 = obj2->slots;
1485 for (i=0, j=size-1; i<size; ++i,--j) {
1486 slotCopy(&slots2[j],&slots1[i]);
1487 }
1488 obj2->size = size;
1489 SetRaw(a, obj2);
1490 return errNone;
1491 }
1492
1493 int prArrayScramble(struct VMGlobals *g, int numArgsPushed)
1494 {
1495 PyrSlot *a, *slots1, *slots2, temp;
1496 PyrObject *obj1, *obj2;
1497 int i, j, k, m, size;
1498
1499 a = g->sp;
1500 obj1 = slotRawObject(a);
1501 size = obj1->size;
1502 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1503 slots1 = obj1->slots;
1504 slots2 = obj2->slots;
1505 memcpy(slots2, slots1, size * sizeof(PyrSlot));
1506 if (size > 1) {
1507 k = size;
1508 for (i=0, m=k; i<k-1; ++i, --m) {
1509 j = i + g->rgen->irand(m);
1510 slotCopy(&temp,&slots2[i]);
1511 slotCopy(&slots2[i],&slots2[j]);
1512 slotCopy(&slots2[j],&temp);
1513 }
1514 }
1515 obj2->size = size;
1516 SetRaw(a, obj2);
1517 return errNone;
1518 }
1519
1520 int prArrayRotate(struct VMGlobals *g, int numArgsPushed)
1521 {
1522 PyrSlot *a, *b, *slots;
1523 PyrObject *obj1, *obj2;
1524 int i, j, n, size;
1525
1526 a = g->sp - 1;
1527 b = g->sp;
1528 if (NotInt(b)) return errWrongType;
1529
1530 obj1 = slotRawObject(a);
1531 size = obj1->size;
1532 n = sc_mod((int)slotRawInt(b), (int)size);
1533 slots = obj1->slots;
1534 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1535 for (i=0, j=n; i<size; ++i) {
1536 slotCopy(&obj2->slots[j],&slots[i]);
1537 if (++j >= size) j=0;
1538 }
1539 obj2->size = size;
1540 SetRaw(a, obj2);
1541 return errNone;
1542 }
1543
1544 int prArrayStutter(struct VMGlobals *g, int numArgsPushed)
1545 {
1546 PyrSlot *a, *b, *slots1, *slots2;
1547 PyrObject *obj1, *obj2;
1548 int i, j, k, m, n, size;
1549
1550 a = g->sp - 1;
1551 b = g->sp;
1552 if (NotInt(b)) return errWrongType;
1553
1554 obj1 = slotRawObject(a);
1555 n = slotRawInt(b);
1556 m = obj1->size;
1557 size = m * n;
1558 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1559 slots1 = obj1->slots;
1560 slots2 = obj2->slots;
1561 for (i=0,j=0; i<m; ++i) {
1562 for (k=0; k<n; ++k,++j) {
1563 slotCopy(&slots2[j],&slots1[i]);
1564 }
1565 }
1566 obj2->size = size;
1567 SetRaw(a, obj2);
1568 return errNone;
1569 }
1570
1571 int prArrayMirror(struct VMGlobals *g, int numArgsPushed)
1572 {
1573 PyrSlot *a, *slots;
1574 PyrObject *obj1, *obj2;
1575 int i, j, k, size;
1576
1577 a = g->sp;
1578
1579 obj1 = slotRawObject(a);
1580 slots = obj1->slots;
1581 size = obj1->size * 2 - 1;
1582 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1583 obj2->size = size;
1584 // copy first part of list
1585 memcpy(obj2->slots, slots, obj1->size * sizeof(PyrSlot));
1586 // copy second part
1587 k = size/2;
1588 for (i=0, j=size-1; i<k; ++i,--j) {
1589 slotCopy(&obj2->slots[j],&slots[i]);
1590 }
1591 SetRaw(a, obj2);
1592 return errNone;
1593 }
1594
1595 int prArrayMirror1(struct VMGlobals *g, int numArgsPushed)
1596 {
1597 PyrSlot *a, *slots;
1598 PyrObject *obj1, *obj2;
1599 int i, j, k, size;
1600
1601 a = g->sp;
1602
1603 obj1 = slotRawObject(a);
1604 slots = obj1->slots;
1605 size = obj1->size * 2 - 2;
1606 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1607 obj2->size = size;
1608 // copy first part of list
1609 memcpy(obj2->slots, slots, obj1->size * sizeof(PyrSlot));
1610 // copy second part
1611 k = size/2;
1612 for (i=1, j=size-1; i<k; ++i,--j) {
1613 slotCopy(&obj2->slots[j],&slots[i]);
1614 }
1615 SetRaw(a, obj2);
1616 return errNone;
1617 }
1618
1619 int prArrayMirror2(struct VMGlobals *g, int numArgsPushed)
1620 {
1621 PyrSlot *a, *slots;
1622 PyrObject *obj1, *obj2;
1623 int i, j, k, size;
1624
1625 a = g->sp;
1626
1627 obj1 = slotRawObject(a);
1628 slots = obj1->slots;
1629 size = obj1->size * 2;
1630 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1631 obj2->size = size;
1632 // copy first part of list
1633 memcpy(obj2->slots, slots, obj1->size * sizeof(PyrSlot));
1634 // copy second part
1635 k = size/2;
1636 for (i=0, j=size-1; i<k; ++i,--j) {
1637 slotCopy(&obj2->slots[j],&slots[i]);
1638 }
1639 SetRaw(a, obj2);
1640 return errNone;
1641 }
1642
1643
1644 int prArrayExtendWrap(struct VMGlobals *g, int numArgsPushed)
1645 {
1646 PyrSlot *a, *b, *slots;
1647 PyrObject *obj1, *obj2;
1648 int i, j, m, size;
1649
1650 a = g->sp - 1;
1651 b = g->sp;
1652 if (NotInt(b)) return errWrongType;
1653
1654 obj1 = slotRawObject(a);
1655 size = slotRawInt(b);
1656 if(obj1->size > 0) {
1657 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1658 obj2->size = size;
1659 slots = obj2->slots;
1660 // copy first part of list
1661 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1662 if (size > obj1->size) {
1663 // copy second part
1664 m = obj1->size;
1665 for (i=0,j=m; j<size; ++i,++j) {
1666 slotCopy(&slots[j],&slots[i]);
1667 }
1668 }
1669 } else {
1670 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1671 }
1672 SetRaw(a, obj2);
1673 return errNone;
1674 }
1675
1676 int prArrayExtendFold(struct VMGlobals *g, int numArgsPushed)
1677 {
1678 PyrSlot *a, *b, *slots;
1679 PyrObject *obj1, *obj2;
1680 int i, j, m, size;
1681
1682 a = g->sp - 1;
1683 b = g->sp;
1684 if (NotInt(b)) return errWrongType;
1685
1686 obj1 = slotRawObject(a);
1687 size = slotRawInt(b);
1688 if(obj1->size > 0) {
1689 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1690 obj2->size = size;
1691 slots = obj2->slots;
1692 // copy first part of list
1693 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1694 if (size > obj1->size) {
1695 // copy second part
1696 m = obj1->size;
1697 for (i=0,j=m; j<size; ++i,++j) {
1698 slotCopy(&slots[j], &slots[sc_fold(j,0,m-1)]);
1699 }
1700 }
1701 } else {
1702 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1703 }
1704 SetRaw(a, obj2);
1705 return errNone;
1706 }
1707
1708 int prArrayExtendLast(struct VMGlobals *g, int numArgsPushed)
1709 {
1710 PyrSlot *a, *b, *slots, last;
1711 PyrObject *obj1, *obj2;
1712 int i, j, m, size;
1713
1714 a = g->sp - 1;
1715 b = g->sp;
1716 if (NotInt(b)) return errWrongType;
1717
1718 obj1 = slotRawObject(a);
1719 size = slotRawInt(b);
1720 if(obj1->size > 0) {
1721 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1722 obj2->size = size;
1723 slots = obj2->slots;
1724 // copy first part of list
1725 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1726 if (size > obj1->size) {
1727 // copy second part
1728 m = obj1->size;
1729 slotCopy(&last,&slots[m-1]);
1730 for (i=0,j=m; j<size; ++i,++j) {
1731 slotCopy(&slots[j],&last);
1732 }
1733 }
1734 } else {
1735 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1736 }
1737 SetRaw(a, obj2);
1738 return errNone;
1739 }
1740
1741 int prArrayPermute(struct VMGlobals *g, int numArgsPushed)
1742 {
1743 PyrSlot *a, *b, *slots1, *slots2, temp;
1744 PyrObject *obj1, *obj2;
1745 int i, j, m, z, size;
1746
1747 a = g->sp - 1;
1748 b = g->sp;
1749 if (NotInt(b)) return errWrongType;
1750
1751 obj1 = slotRawObject(a);
1752 size = obj1->size;
1753 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1754 obj2->size = size;
1755 slots1 = obj1->slots;
1756 slots2 = obj2->slots;
1757 memcpy(slots2, slots1, size * sizeof(PyrSlot));
1758 z = slotRawInt(b);
1759 for (i=0, m=size; i<size-1; ++i, --m) {
1760 j = i + sc_mod((int)z, (int)(size-i));
1761 z = sc_div(z,size-i);
1762 slotCopy(&temp,&slots2[i]);
1763 slotCopy(&slots2[i],&slots2[j]);
1764 slotCopy(&slots2[j],&temp);
1765 }
1766 SetRaw(a, obj2);
1767 return errNone;
1768 }
1769
1770
1771 int prArrayAllTuples(struct VMGlobals *g, int numArgsPushed)
1772 {
1773 PyrSlot *a, *b, *slots1, *slots2, *slots3;
1774 PyrObject *obj1, *obj2, *obj3;
1775
1776 a = g->sp - 1;
1777 b = g->sp;
1778 if (NotInt(b)) return errWrongType;
1779 int maxSize = slotRawInt(b);
1780
1781 obj1 = slotRawObject(a);
1782 slots1 = obj1->slots;
1783 int newSize = 1;
1784 int tupSize = obj1->size;
1785 for (int i=0; i < tupSize; ++i) {
1786 if (isKindOfSlot(slots1+i, class_array)) {
1787 newSize *= slotRawObject(&slots1[i])->size;
1788 }
1789 }
1790 if (newSize > maxSize) newSize = maxSize;
1791
1792 obj2 = instantiateObject(g->gc, obj1->classptr, newSize, false, true);
1793 slots2 = obj2->slots;
1794 SetObject(b, obj2); // store reference on stack, so both source and destination objects can be reached by the gc
1795
1796 for (int i=0; i < newSize; ++i) {
1797 int k = i;
1798 obj3 = instantiateObject(g->gc, obj1->classptr, tupSize, false, true);
1799 slots3 = obj3->slots;
1800 for (int j=tupSize-1; j >= 0; --j) {
1801 if (isKindOfSlot(slots1+j, class_array)) {
1802 PyrObject *obj4 = slotRawObject(&slots1[j]);
1803 slotCopy(&slots3[j], &obj4->slots[k % obj4->size]);
1804 g->gc->GCWrite(obj3, obj4);
1805 k /= obj4->size;
1806 } else {
1807 slotCopy(&slots3[j], &slots1[j]);
1808 }
1809 }
1810 obj3->size = tupSize;
1811 SetObject(obj2->slots+i, obj3);
1812 g->gc->GCWriteNew(obj2, obj3);
1813 obj2->size++;
1814 }
1815 SetRaw(a, obj2);
1816 return errNone;
1817 }
1818
1819 int prArrayPyramid(struct VMGlobals *g, int numArgsPushed)
1820 {
1821 PyrSlot *a, *b, *slots;
1822 PyrObject *obj1, *obj2;
1823 int i, j, k, n, m, numslots, x;
1824
1825 a = g->sp - 1;
1826 b = g->sp;
1827 if (NotInt(b)) return errWrongType;
1828
1829 obj1 = slotRawObject(a);
1830 slots = obj1->slots;
1831 m = sc_clip(slotRawInt(b), 1, 10);
1832 x = numslots = obj1->size;
1833 switch (m) {
1834 case 1 :
1835 n = (x*x + x)/2;
1836 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1837 for (i=0,k=0; i<numslots; ++i) {
1838 for (j=0; j<=i; ++j, ++k) {
1839 slotCopy(&obj2->slots[k],&slots[j]);
1840 }
1841 }
1842 obj2->size = k;
1843 break;
1844 case 2 :
1845 n = (x*x + x)/2;
1846 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1847 for (i=0,k=0; i<numslots; ++i) {
1848 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1849 slotCopy(&obj2->slots[k],&slots[j]);
1850 }
1851 }
1852 obj2->size = k;
1853 break;
1854 case 3 :
1855 n = (x*x + x)/2;
1856 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1857 for (i=0,k=0; i<numslots; ++i) {
1858 for (j=0; j<=numslots-1-i; ++j, ++k) {
1859 slotCopy(&obj2->slots[k],&slots[j]);
1860 }
1861 }
1862 obj2->size = k;
1863 break;
1864 case 4 :
1865 n = (x*x + x)/2;
1866 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1867 for (i=0,k=0; i<numslots; ++i) {
1868 for (j=i; j<=numslots-1; ++j, ++k) {
1869 slotCopy(&obj2->slots[k],&slots[j]);
1870 }
1871 }
1872 obj2->size = k;
1873 break;
1874 case 5 :
1875 n = x*x;
1876 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1877 for (i=0,k=0; i<numslots; ++i) {
1878 for (j=0; j<=i; ++j, ++k) {
1879 slotCopy(&obj2->slots[k],&slots[j]);
1880 }
1881 }
1882 for (i=0; i<numslots-1; ++i) {
1883 for (j=0; j<=numslots-2-i; ++j, ++k) {
1884 slotCopy(&obj2->slots[k],&slots[j]);
1885 }
1886 }
1887 obj2->size = k;
1888 break;
1889 case 6 :
1890 n = x*x;
1891 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1892 for (i=0,k=0; i<numslots; ++i) {
1893 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1894 slotCopy(&obj2->slots[k],&slots[j]);
1895 }
1896 }
1897 for (i=0; i<numslots-1; ++i) {
1898 for (j=i+1; j<=numslots-1; ++j, ++k) {
1899 slotCopy(&obj2->slots[k],&slots[j]);
1900 }
1901 }
1902 obj2->size = k;
1903 break;
1904 case 7 :
1905 n = x*x + x - 1;
1906 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1907 for (i=0,k=0; i<numslots; ++i) {
1908 for (j=0; j<=numslots-1-i; ++j, ++k) {
1909 slotCopy(&obj2->slots[k],&slots[j]);
1910 }
1911 }
1912 for (i=1; i<numslots; ++i) {
1913 for (j=0; j<=i; ++j, ++k) {
1914 slotCopy(&obj2->slots[k],&slots[j]);
1915 }
1916 }
1917 obj2->size = k;
1918 break;
1919 case 8 :
1920 n = x*x + x - 1;
1921 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1922 for (i=0,k=0; i<numslots; ++i) {
1923 for (j=i; j<=numslots-1; ++j, ++k) {
1924 slotCopy(&obj2->slots[k],&slots[j]);
1925 }
1926 }
1927 for (i=1; i<numslots; ++i) {
1928 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1929 slotCopy(&obj2->slots[k],&slots[j]);
1930 }
1931 }
1932 obj2->size = k;
1933 break;
1934 case 9 :
1935 n = x*x;
1936 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1937 for (i=0,k=0; i<numslots; ++i) {
1938 for (j=0; j<=i; ++j, ++k) {
1939 slotCopy(&obj2->slots[k],&slots[j]);
1940 }
1941 }
1942 for (i=0; i<numslots-1; ++i) {
1943 for (j=i+1; j<=numslots-1; ++j, ++k) {
1944 slotCopy(&obj2->slots[k],&slots[j]);
1945 }
1946 }
1947 obj2->size = k;
1948 break;
1949 case 10 :
1950 n = x*x;
1951 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1952 for (i=0,k=0; i<numslots; ++i) {
1953 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1954 slotCopy(&obj2->slots[k],&slots[j]);
1955 }
1956 }
1957 for (i=0; i<numslots-1; ++i) {
1958 for (j=0; j<=numslots-2-i; ++j, ++k) {
1959 slotCopy(&obj2->slots[k],&slots[j]);
1960 }
1961 }
1962 obj2->size = k;
1963 break;
1964 }
1965 SetRaw(a, obj2);
1966 return errNone;
1967 }
1968
1969 int prArraySlide(struct VMGlobals *g, int numArgsPushed)
1970 {
1971 PyrSlot *a, *b, *c, *slots;
1972 PyrObject *obj1, *obj2;
1973 int h, i, j, k, n, m, numslots, numwin;
1974
1975 a = g->sp - 2;
1976 b = g->sp - 1;
1977 c = g->sp;
1978 if (NotInt(b)) return errWrongType;
1979 if (NotInt(c)) return errWrongType;
1980
1981 obj1 = slotRawObject(a);
1982 slots = obj1->slots;
1983 m = slotRawInt(b);
1984 n = slotRawInt(c);
1985 numwin = (obj1->size + n - m) / n;
1986 numslots = numwin * m;
1987 obj2 = instantiateObject(g->gc, obj1->classptr, numslots, false, true);
1988 for (i=h=k=0; i<numwin; ++i,h+=n) {
1989 for (j=h; j<m+h; ++j) {
1990 slotCopy(&obj2->slots[k++],&slots[j]);
1991 }
1992 }
1993 obj2->size = k;
1994 SetRaw(a, obj2);
1995 return errNone;
1996 }
1997
1998 int prArrayLace(struct VMGlobals *g, int numArgsPushed)
1999 {
2000 PyrSlot *a, *b, *slots, *slot;
2001 PyrObject *obj1, *obj2, *obj3;
2002 int i, j, k, n, m, numLists, len;
2003
2004 a = g->sp - 1;
2005 b = g->sp;
2006 obj1 = slotRawObject(a);
2007 slots = obj1->slots;
2008 numLists = obj1->size;
2009
2010 if(IsNil(b)) {
2011 for (j=0; j<numLists; ++j) {
2012 slot = slots + j;
2013 if(isKindOfSlot(slot, class_array)) {
2014 len = slotRawObject(slot)->size;
2015 if(j==0 || n>len) { n = len; }
2016 } else {
2017 return errFailed; // this primitive only handles Arrays.
2018 }
2019 }
2020 n = n * numLists;
2021
2022 } else if (IsInt(b)) {
2023 n = slotRawInt(b);
2024 } else {
2025 return errWrongType;
2026 }
2027
2028
2029 n = sc_max(1, n);
2030 if(obj1->size > 0) {
2031 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
2032 for (i=j=k=0; i<n; ++i) {
2033 if (IsObj(&slots[k])) {
2034 obj3 = slotRawObject(&slots[k]);
2035 if (isKindOf(obj3, class_list)) {
2036 obj3 = slotRawObject(&obj3->slots[0]); // get the list's array
2037 }
2038 if (obj3 && isKindOf(obj3, class_array)) {
2039 m = j % obj3->size;
2040 slotCopy(&obj2->slots[i],&obj3->slots[m]);
2041 } else {
2042 slotCopy(&obj2->slots[i],&slots[k]);
2043 }
2044 } else {
2045 slotCopy(&obj2->slots[i],&slots[k]);
2046 }
2047 k = (k+1) % obj1->size;
2048 if (k == 0) j++;
2049 }
2050 } else {
2051 obj2 = instantiateObject(g->gc, obj1->classptr, n, true, true);
2052 }
2053 obj2->size = n;
2054 SetRaw(a, obj2);
2055 return errNone;
2056 }
2057
2058 int prArrayContainsSeqColl(struct VMGlobals *g, int numArgsPushed)
2059 {
2060 PyrSlot *a, *slot, *endptr;
2061 PyrObject *obj;
2062 int size;
2063
2064 a = g->sp;
2065 obj = slotRawObject(a);
2066 size = obj->size;
2067 slot = obj->slots - 1;
2068 endptr = slot + size;
2069 while (slot < endptr) {
2070 ++slot;
2071 if (IsObj(slot)) {
2072 if (isKindOf(slotRawObject(slot), class_sequenceable_collection)) {
2073 SetTrue(a);
2074 return errNone;
2075 }
2076 }
2077 }
2078 SetFalse(a);
2079 return errNone;
2080 }
2081
2082 int prArrayNormalizeSum(struct VMGlobals *g, int numArgsPushed)
2083 {
2084 PyrSlot *a, *slots2;
2085 PyrObject *obj1, *obj2;
2086 int i, size, err;
2087 double w, sum, rsum;
2088
2089 a = g->sp;
2090 obj1 = slotRawObject(a);
2091 size = obj1->size;
2092 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
2093 slots2 = obj2->slots;
2094 sum = 0.0;
2095 for (i=0; i<size; ++i) {
2096 err = getIndexedDouble(obj1, i, &w);
2097 if (err) return err;
2098 sum += w;
2099 SetFloat(&slots2[i], w);
2100 }
2101 rsum = 1./sum;
2102 for (i=0; i<size; ++i) {
2103 double d = slotRawFloat(&slots2[i]);
2104 SetRaw(&slots2[i], d * rsum);
2105 }
2106 obj2->size = size;
2107 SetRaw(a, obj2);
2108 return errNone;
2109 }
2110
2111
2112
2113
2114 int prArrayWIndex(struct VMGlobals *g, int numArgsPushed)
2115 {
2116 PyrSlot *a, *slots;
2117 PyrObject *obj;
2118 int i, j, size, err;
2119 double r, w, sum;
2120
2121 a = g->sp;
2122
2123 sum = 0.0;
2124 r = g->rgen->frand();
2125 obj = slotRawObject(a);
2126 size = obj->size;
2127 j = size - 1;
2128 slots = obj->slots;
2129 for (i=0; i<size; ++i) {
2130 err = getIndexedDouble(obj, i, &w);
2131 if (err) return err;
2132 sum += w;
2133 if (sum >= r) {
2134 j = i;
2135 break;
2136 }
2137 }
2138 SetInt(a, j);
2139 return errNone;
2140 }
2141
2142
2143 enum {
2144 shape_Step,
2145 shape_Linear,
2146 shape_Exponential,
2147 shape_Sine,
2148 shape_Welch,
2149 shape_Curve,
2150 shape_Squared,
2151 shape_Cubed
2152 };
2153
2154 enum {
2155 kEnv_initLevel,
2156 kEnv_numStages,
2157 kEnv_releaseNode,
2158 kEnv_loopNode
2159 };
2160
2161 int prArrayEnvAt(struct VMGlobals *g, int numArgsPushed)
2162 {
2163 PyrSlot *a = g->sp - 1;
2164 PyrSlot *b = g->sp;
2165
2166 PyrObject* env = slotRawObject(a);
2167 PyrSlot* slots = env->slots;
2168
2169 // Env:asArray always gives at least 8 array elements
2170 if(env->size < 8) return errFailed;
2171
2172 double time;
2173 int err = slotDoubleVal(b, &time);
2174 if (err) return err;
2175
2176 double begLevel;
2177 err = slotDoubleVal(slots + kEnv_initLevel, &begLevel);
2178 if (err) return err;
2179
2180 int numStages;
2181 err = slotIntVal(slots + kEnv_numStages, &numStages);
2182 if (err) return err;
2183
2184 double begTime = 0.;
2185 double endTime = 0.;
2186
2187 for (int i=0; i<numStages; ++i) {
2188 double dur, endLevel;
2189
2190 slots += 4;
2191
2192 err = slotDoubleVal(slots + 0, &endLevel);
2193 if (err) return err;
2194 err = slotDoubleVal(slots + 1, &dur);
2195 if (err) return err;
2196
2197 endTime += dur;
2198
2199 //post("%d %g %g %g %g %g\n", i, time, begTime, endTime, dur, endLevel);
2200
2201 if (time < endTime) {
2202 int shape;
2203 double curve;
2204
2205 err = slotIntVal(slots + 2, &shape);
2206 if (err) return err;
2207
2208 double level;
2209 double pos = (time - begTime) / dur;
2210
2211 //post(" shape %d pos %g\n", shape, pos);
2212 switch (shape)
2213 {
2214 case shape_Step :
2215 level = endLevel;
2216 break;
2217 case shape_Linear :
2218 default:
2219 level = pos * (endLevel - begLevel) + begLevel;
2220 break;
2221 case shape_Exponential :
2222 level = begLevel * pow(endLevel / begLevel, pos);
2223 break;
2224 case shape_Sine :
2225 level = begLevel + (endLevel - begLevel) * (-cos(pi * pos) * 0.5 + 0.5);
2226 break;
2227 case shape_Welch :
2228 {
2229 if (begLevel < endLevel)
2230 level = begLevel + (endLevel - begLevel) * sin(pi2 * pos);
2231 else
2232 level = endLevel - (endLevel - begLevel) * sin(pi2 - pi2 * pos);
2233 break;
2234 }
2235 case shape_Curve :
2236 err = slotDoubleVal(slots + 3, &curve);
2237 if (err) return err;
2238
2239 if (fabs(curve) < 0.0001) {
2240 level = pos * (endLevel - begLevel) + begLevel;
2241 } else {
2242 double denom = 1. - exp(curve);
2243 double numer = 1. - exp(pos * curve);
2244 level = begLevel + (endLevel - begLevel) * (numer/denom);
2245 }
2246 break;
2247 case shape_Squared :
2248 {
2249 double sqrtBegLevel = sqrt(begLevel);
2250 double sqrtEndLevel = sqrt(endLevel);
2251 double sqrtLevel = pos * (sqrtEndLevel - sqrtBegLevel) + sqrtBegLevel;
2252 level = sqrtLevel * sqrtLevel;
2253 break;
2254 }
2255 case shape_Cubed :
2256 {
2257 double cbrtBegLevel = pow(begLevel, 0.3333333);
2258 double cbrtEndLevel = pow(endLevel, 0.3333333);
2259 double cbrtLevel = pos * (cbrtEndLevel - cbrtBegLevel) + cbrtBegLevel;
2260 level = cbrtLevel * cbrtLevel * cbrtLevel;
2261 break;
2262 }
2263 }
2264 SetFloat(a, level);
2265 return errNone;
2266 }
2267
2268 begTime = endTime;
2269 begLevel = endLevel;
2270 }
2271
2272 SetFloat(a, begLevel);
2273
2274 return errNone;
2275 }
2276
2277
2278 int prArrayIndexOfGreaterThan(struct VMGlobals *g, int numArgsPushed)
2279 {
2280 PyrSlot *a, *b, *slots;
2281 PyrObject *obj;
2282 int i, size, err;
2283 double s, w;
2284
2285 a = g->sp - 1;
2286 b = g->sp;
2287
2288 obj = slotRawObject(a);
2289
2290 size = obj->size;
2291 slots = obj->slots;
2292
2293 err = slotDoubleVal(b, &s);
2294 if (err) return err;
2295
2296 for (i=0; i<size; ++i) {
2297 err = getIndexedDouble(obj, i, &w);
2298 if (err) return err;
2299
2300 if (w > s) {
2301 SetInt(a, i);
2302 return errNone;
2303 }
2304 }
2305
2306 SetNil(a);
2307 return errNone;
2308 }
2309
2310
2311
2312 int prArrayUnlace(struct VMGlobals *g, int numArgsPushed)
2313 {
2314 PyrSlot *a, *b, *c, *slots, *slots2, *slots3;
2315 PyrObject *obj1, *obj2, *obj3;
2316 int i, j, k, clump, numLists, size, size3, err;
2317
2318 a = g->sp - 2;
2319 b = g->sp - 1;
2320 c = g->sp;
2321
2322 obj1 = slotRawObject(a);
2323 slots = obj1->slots;
2324 size = obj1->size;
2325
2326 err = slotIntVal(b, &numLists);
2327 if (err) return err;
2328
2329 err = slotIntVal(c, &clump);
2330 if (err) return err;
2331
2332 obj2 = instantiateObject(g->gc, obj1->classptr, numLists, false, true);
2333 obj2->size = numLists;
2334 slots2 = obj2->slots;
2335
2336 SetObject(b, obj2); // store reference on stack, so both source and destination objects can be reached by the gc
2337
2338 size3 = size / numLists;
2339 size3 = size3 - (size3 % clump);
2340 if(size3 < 1) return errFailed;
2341
2342 for(i=0; i<numLists; ++i) {
2343 obj3 = instantiateObject(g->gc, obj1->classptr, size3, false, true);
2344 obj3->size = size3;
2345 slots3 = obj3->slots;
2346 for(j=0; j<size3; j+=clump) {
2347 for(k=0; k<clump; ++k) {
2348 slotCopy(&slots3[j+k],&slots[i*clump + k + j*numLists]);
2349 }
2350 }
2351 SetObject(slots2 + i, obj3);
2352 }
2353
2354 SetRaw(a, obj2);
2355
2356 return errNone;
2357 }
2358
2359 void initArrayPrimitives();
2360 void initArrayPrimitives()
2361 {
2362 int base, index;
2363
2364 base = nextPrimitiveIndex();
2365 index = 0;
2366
2367 definePrimitive(base, index++, "_BasicSize", basicSize, 1, 0);
2368 definePrimitive(base, index++, "_BasicMaxSize", basicMaxSize, 1, 0);
2369
2370 definePrimitive(base, index++, "_BasicSwap", basicSwap, 3, 0);
2371 definePrimitive(base, index++, "_BasicAt", basicAt, 2, 0);
2372 definePrimitive(base, index++, "_BasicRemoveAt", basicRemoveAt, 2, 0);
2373 definePrimitive(base, index++, "_BasicTakeAt", basicTakeAt, 2, 0);
2374 definePrimitive(base, index++, "_BasicClipAt", basicClipAt, 2, 0);
2375 definePrimitive(base, index++, "_BasicWrapAt", basicWrapAt, 2, 0);
2376 definePrimitive(base, index++, "_BasicFoldAt", basicFoldAt, 2, 0);
2377 definePrimitive(base, index++, "_BasicPut", basicPut, 3, 0);
2378 definePrimitive(base, index++, "_BasicClipPut", basicClipPut, 3, 0);
2379 definePrimitive(base, index++, "_BasicWrapPut", basicWrapPut, 3, 0);
2380 definePrimitive(base, index++, "_BasicFoldPut", basicFoldPut, 3, 0);
2381
2382 definePrimitive(base, index++, "_ArrayExtend", prArrayExtend, 3, 0);
2383 definePrimitive(base, index++, "_ArrayGrow", prArrayGrow, 2, 0);
2384 definePrimitive(base, index++, "_ArrayGrowClear", prArrayGrowClear, 2, 0);
2385 definePrimitive(base, index++, "_ArrayAdd", prArrayAdd, 2, 0);
2386 definePrimitive(base, index++, "_ArrayInsert", prArrayInsert, 3, 0);
2387 definePrimitive(base, index++, "_ArrayFill", prArrayFill, 2, 0);
2388 definePrimitive(base, index++, "_ArrayPop", prArrayPop, 1, 0);
2389 definePrimitive(base, index++, "_ArrayCat", prArrayCat, 2, 0);
2390 definePrimitive(base, index++, "_ArrayPutEach", prArrayPutEach, 3, 0);
2391 definePrimitive(base, index++, "_ArrayAddAll", prArrayAddAll, 2, 0);
2392 definePrimitive(base, index++, "_ArrayPutSeries", prArrayPutSeries, 5, 0);
2393 definePrimitive(base, index++, "_ArrayOverwrite", prArrayOverwrite, 3, 0);
2394 definePrimitive(base, index++, "_ArrayIndexOf", prArrayIndexOf, 2, 0);
2395
2396 definePrimitive(base, index++, "_ArrayNormalizeSum", prArrayNormalizeSum, 1, 0);
2397 definePrimitive(base, index++, "_ArrayWIndex", prArrayWIndex, 1, 0);
2398 definePrimitive(base, index++, "_ArrayReverse", prArrayReverse, 1, 0);
2399 definePrimitive(base, index++, "_ArrayScramble", prArrayScramble, 1, 0);
2400 definePrimitive(base, index++, "_ArrayMirror", prArrayMirror, 1, 0);
2401 definePrimitive(base, index++, "_ArrayMirror1", prArrayMirror1, 1, 0);
2402 definePrimitive(base, index++, "_ArrayMirror2", prArrayMirror2, 1, 0);
2403 definePrimitive(base, index++, "_ArrayRotate", prArrayRotate, 2, 0);
2404 definePrimitive(base, index++, "_ArrayPermute", prArrayPermute, 2, 0);
2405 definePrimitive(base, index++, "_ArrayAllTuples", prArrayAllTuples, 2, 0);
2406 definePrimitive(base, index++, "_ArrayPyramid", prArrayPyramid, 2, 0);
2407 definePrimitive(base, index++, "_ArrayRotate", prArrayRotate, 2, 0);
2408 definePrimitive(base, index++, "_ArrayExtendWrap", prArrayExtendWrap, 2, 0);
2409 definePrimitive(base, index++, "_ArrayExtendFold", prArrayExtendFold, 2, 0);
2410 definePrimitive(base, index++, "_ArrayExtendLast", prArrayExtendLast, 2, 0);
2411 definePrimitive(base, index++, "_ArrayLace", prArrayLace, 2, 0);
2412 definePrimitive(base, index++, "_ArrayStutter", prArrayStutter, 2, 0);
2413 definePrimitive(base, index++, "_ArraySlide", prArraySlide, 3, 0);
2414 definePrimitive(base, index++, "_ArrayContainsSeqColl", prArrayContainsSeqColl, 1, 0);
2415
2416 definePrimitive(base, index++, "_ArrayEnvAt", prArrayEnvAt, 2, 0);
2417 definePrimitive(base, index++, "_ArrayIndexOfGreaterThan", prArrayIndexOfGreaterThan, 2, 0);
2418 definePrimitive(base, index++, "_ArrayUnlace", prArrayUnlace, 3, 0);
2419
2420 }
2421
2422
2423 #if _SC_PLUGINS_
2424
2425 #include "SCPlugin.h"
2426
2427 #pragma export on
2428 extern "C" { SCPlugIn* loadPlugIn(void); }
2429 #pragma export off
2430
2431
2432 // define plug in object
2433 class APlugIn : public SCPlugIn
2434 {
2435 public:
2436 APlugIn();
2437 virtual ~APlugIn();
2438
2439 virtual void AboutToCompile();
2440 };
2441
2442 APlugIn::APlugIn()
2443 {
2444 // constructor for plug in
2445 }
2446
2447 APlugIn::~APlugIn()
2448 {
2449 // destructor for plug in
2450 }
2451
2452 void APlugIn::AboutToCompile()
2453 {
2454 // this is called each time the class library is compiled.
2455 initArrayPrimitives();
2456 }
2457
2458 // This function is called when the plug in is loaded into SC.
2459 // It returns an instance of APlugIn.
2460 SCPlugIn* loadPlugIn()
2461 {
2462 return new APlugIn();
2463 }
2464
2465 #endif
2466