?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
sclang: improve PyrObjectHdr API
[supercollider.git] / lang / LangPrimSource / PyrArrayPrimitives.cpp
blobdc1896e12850f59f5ca326a007a64274547db455
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->IsImmutable()) 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->IsImmutable()) 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->IsImmutable()) 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 int maxelems, elemsize, format, tag, numbytes;
809 int err, ival;
810 double fval;
811
812 a = g->sp - 1;
813 b = g->sp;
814
815 PyrObject *array = slotRawObject(a);
816 if (array->IsImmutable()) return errImmutableObject;
817
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->IsImmutable()) 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->IsImmutable()) 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->IsImmutable()) 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 size = slotRawInt(b);
1655 if (size < 0)
1656 return errFailed;
1657
1658 obj1 = slotRawObject(a);
1659
1660 if(obj1->size > 0) {
1661 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1662 obj2->size = size;
1663 slots = obj2->slots;
1664 // copy first part of list
1665 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1666 if (size > obj1->size) {
1667 // copy second part
1668 m = obj1->size;
1669 for (i=0,j=m; j<size; ++i,++j) {
1670 slotCopy(&slots[j],&slots[i]);
1671 }
1672 }
1673 } else {
1674 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1675 }
1676 SetRaw(a, obj2);
1677 return errNone;
1678 }
1679
1680 int prArrayExtendFold(struct VMGlobals *g, int numArgsPushed)
1681 {
1682 PyrSlot *a, *b, *slots;
1683 PyrObject *obj1, *obj2;
1684 int i, j, m, size;
1685
1686 a = g->sp - 1;
1687 b = g->sp;
1688 if (NotInt(b)) return errWrongType;
1689
1690 size = slotRawInt(b);
1691 if (size < 0)
1692 return errFailed;
1693
1694 obj1 = slotRawObject(a);
1695 if(obj1->size > 0) {
1696 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1697 obj2->size = size;
1698 slots = obj2->slots;
1699 // copy first part of list
1700 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1701 if (size > obj1->size) {
1702 // copy second part
1703 m = obj1->size;
1704 for (i=0,j=m; j<size; ++i,++j) {
1705 slotCopy(&slots[j], &slots[sc_fold(j,0,m-1)]);
1706 }
1707 }
1708 } else {
1709 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1710 }
1711 SetRaw(a, obj2);
1712 return errNone;
1713 }
1714
1715 int prArrayExtendLast(struct VMGlobals *g, int numArgsPushed)
1716 {
1717 PyrSlot *a, *b, *slots, last;
1718 PyrObject *obj1, *obj2;
1719 int i, j, m, size;
1720
1721 a = g->sp - 1;
1722 b = g->sp;
1723 if (NotInt(b)) return errWrongType;
1724
1725 size = slotRawInt(b);
1726 if (size < 0)
1727 return errFailed;
1728
1729 obj1 = slotRawObject(a);
1730 if(obj1->size > 0) {
1731 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1732 obj2->size = size;
1733 slots = obj2->slots;
1734 // copy first part of list
1735 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1736 if (size > obj1->size) {
1737 // copy second part
1738 m = obj1->size;
1739 slotCopy(&last,&slots[m-1]);
1740 for (i=0,j=m; j<size; ++i,++j) {
1741 slotCopy(&slots[j],&last);
1742 }
1743 }
1744 } else {
1745 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1746 }
1747 SetRaw(a, obj2);
1748 return errNone;
1749 }
1750
1751 int prArrayPermute(struct VMGlobals *g, int numArgsPushed)
1752 {
1753 PyrSlot *a, *b, *slots1, *slots2, temp;
1754 PyrObject *obj1, *obj2;
1755 int i, j, m, z, size;
1756
1757 a = g->sp - 1;
1758 b = g->sp;
1759 if (NotInt(b)) return errWrongType;
1760
1761 obj1 = slotRawObject(a);
1762 size = obj1->size;
1763 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1764 obj2->size = size;
1765 slots1 = obj1->slots;
1766 slots2 = obj2->slots;
1767 memcpy(slots2, slots1, size * sizeof(PyrSlot));
1768 z = slotRawInt(b);
1769 for (i=0, m=size; i<size-1; ++i, --m) {
1770 j = i + sc_mod((int)z, (int)(size-i));
1771 z = sc_div(z,size-i);
1772 slotCopy(&temp,&slots2[i]);
1773 slotCopy(&slots2[i],&slots2[j]);
1774 slotCopy(&slots2[j],&temp);
1775 }
1776 SetRaw(a, obj2);
1777 return errNone;
1778 }
1779
1780
1781 int prArrayAllTuples(struct VMGlobals *g, int numArgsPushed)
1782 {
1783 PyrSlot *a, *b, *slots1, *slots2, *slots3;
1784 PyrObject *obj1, *obj2, *obj3;
1785
1786 a = g->sp - 1;
1787 b = g->sp;
1788 if (NotInt(b)) return errWrongType;
1789 int maxSize = slotRawInt(b);
1790
1791 obj1 = slotRawObject(a);
1792 slots1 = obj1->slots;
1793 int newSize = 1;
1794 int tupSize = obj1->size;
1795 for (int i=0; i < tupSize; ++i) {
1796 if (isKindOfSlot(slots1+i, class_array)) {
1797 newSize *= slotRawObject(&slots1[i])->size;
1798 }
1799 }
1800 if (newSize > maxSize) newSize = maxSize;
1801
1802 obj2 = instantiateObject(g->gc, obj1->classptr, newSize, false, true);
1803 slots2 = obj2->slots;
1804 SetObject(b, obj2); // store reference on stack, so both source and destination objects can be reached by the gc
1805
1806 for (int i=0; i < newSize; ++i) {
1807 int k = i;
1808 obj3 = instantiateObject(g->gc, obj1->classptr, tupSize, false, true);
1809 slots3 = obj3->slots;
1810 for (int j=tupSize-1; j >= 0; --j) {
1811 if (isKindOfSlot(slots1+j, class_array)) {
1812 PyrObject *obj4 = slotRawObject(&slots1[j]);
1813 slotCopy(&slots3[j], &obj4->slots[k % obj4->size]);
1814 g->gc->GCWrite(obj3, obj4);
1815 k /= obj4->size;
1816 } else {
1817 slotCopy(&slots3[j], &slots1[j]);
1818 }
1819 }
1820 obj3->size = tupSize;
1821 SetObject(obj2->slots+i, obj3);
1822 g->gc->GCWriteNew(obj2, obj3);
1823 obj2->size++;
1824 }
1825 SetRaw(a, obj2);
1826 return errNone;
1827 }
1828
1829 int prArrayPyramid(struct VMGlobals *g, int numArgsPushed)
1830 {
1831 PyrSlot *a, *b, *slots;
1832 PyrObject *obj1, *obj2;
1833 int i, j, k, n, m, numslots, x;
1834
1835 a = g->sp - 1;
1836 b = g->sp;
1837 if (NotInt(b)) return errWrongType;
1838
1839 obj1 = slotRawObject(a);
1840 slots = obj1->slots;
1841 m = sc_clip(slotRawInt(b), 1, 10);
1842 x = numslots = obj1->size;
1843 switch (m) {
1844 case 1 :
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=0; j<=i; ++j, ++k) {
1849 slotCopy(&obj2->slots[k],&slots[j]);
1850 }
1851 }
1852 obj2->size = k;
1853 break;
1854 case 2 :
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=numslots-1-i; j<=numslots-1; ++j, ++k) {
1859 slotCopy(&obj2->slots[k],&slots[j]);
1860 }
1861 }
1862 obj2->size = k;
1863 break;
1864 case 3 :
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=0; j<=numslots-1-i; ++j, ++k) {
1869 slotCopy(&obj2->slots[k],&slots[j]);
1870 }
1871 }
1872 obj2->size = k;
1873 break;
1874 case 4 :
1875 n = (x*x + x)/2;
1876 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1877 for (i=0,k=0; i<numslots; ++i) {
1878 for (j=i; j<=numslots-1; ++j, ++k) {
1879 slotCopy(&obj2->slots[k],&slots[j]);
1880 }
1881 }
1882 obj2->size = k;
1883 break;
1884 case 5 :
1885 n = x*x;
1886 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1887 for (i=0,k=0; i<numslots; ++i) {
1888 for (j=0; j<=i; ++j, ++k) {
1889 slotCopy(&obj2->slots[k],&slots[j]);
1890 }
1891 }
1892 for (i=0; i<numslots-1; ++i) {
1893 for (j=0; j<=numslots-2-i; ++j, ++k) {
1894 slotCopy(&obj2->slots[k],&slots[j]);
1895 }
1896 }
1897 obj2->size = k;
1898 break;
1899 case 6 :
1900 n = x*x;
1901 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1902 for (i=0,k=0; i<numslots; ++i) {
1903 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1904 slotCopy(&obj2->slots[k],&slots[j]);
1905 }
1906 }
1907 for (i=0; i<numslots-1; ++i) {
1908 for (j=i+1; j<=numslots-1; ++j, ++k) {
1909 slotCopy(&obj2->slots[k],&slots[j]);
1910 }
1911 }
1912 obj2->size = k;
1913 break;
1914 case 7 :
1915 n = x*x + x - 1;
1916 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1917 for (i=0,k=0; i<numslots; ++i) {
1918 for (j=0; j<=numslots-1-i; ++j, ++k) {
1919 slotCopy(&obj2->slots[k],&slots[j]);
1920 }
1921 }
1922 for (i=1; i<numslots; ++i) {
1923 for (j=0; j<=i; ++j, ++k) {
1924 slotCopy(&obj2->slots[k],&slots[j]);
1925 }
1926 }
1927 obj2->size = k;
1928 break;
1929 case 8 :
1930 n = x*x + x - 1;
1931 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1932 for (i=0,k=0; i<numslots; ++i) {
1933 for (j=i; j<=numslots-1; ++j, ++k) {
1934 slotCopy(&obj2->slots[k],&slots[j]);
1935 }
1936 }
1937 for (i=1; i<numslots; ++i) {
1938 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1939 slotCopy(&obj2->slots[k],&slots[j]);
1940 }
1941 }
1942 obj2->size = k;
1943 break;
1944 case 9 :
1945 n = x*x;
1946 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1947 for (i=0,k=0; i<numslots; ++i) {
1948 for (j=0; j<=i; ++j, ++k) {
1949 slotCopy(&obj2->slots[k],&slots[j]);
1950 }
1951 }
1952 for (i=0; i<numslots-1; ++i) {
1953 for (j=i+1; j<=numslots-1; ++j, ++k) {
1954 slotCopy(&obj2->slots[k],&slots[j]);
1955 }
1956 }
1957 obj2->size = k;
1958 break;
1959 case 10 :
1960 n = x*x;
1961 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1962 for (i=0,k=0; i<numslots; ++i) {
1963 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1964 slotCopy(&obj2->slots[k],&slots[j]);
1965 }
1966 }
1967 for (i=0; i<numslots-1; ++i) {
1968 for (j=0; j<=numslots-2-i; ++j, ++k) {
1969 slotCopy(&obj2->slots[k],&slots[j]);
1970 }
1971 }
1972 obj2->size = k;
1973 break;
1974 }
1975 SetRaw(a, obj2);
1976 return errNone;
1977 }
1978
1979 int prArraySlide(struct VMGlobals *g, int numArgsPushed)
1980 {
1981 PyrSlot *a, *b, *c, *slots;
1982 PyrObject *obj1, *obj2;
1983 int h, i, j, k, n, m, numslots, numwin;
1984
1985 a = g->sp - 2;
1986 b = g->sp - 1;
1987 c = g->sp;
1988 if (NotInt(b)) return errWrongType;
1989 if (NotInt(c)) return errWrongType;
1990
1991 obj1 = slotRawObject(a);
1992 slots = obj1->slots;
1993 m = slotRawInt(b);
1994 n = slotRawInt(c);
1995 numwin = (obj1->size + n - m) / n;
1996 numslots = numwin * m;
1997 obj2 = instantiateObject(g->gc, obj1->classptr, numslots, false, true);
1998 for (i=h=k=0; i<numwin; ++i,h+=n) {
1999 for (j=h; j<m+h; ++j) {
2000 slotCopy(&obj2->slots[k++],&slots[j]);
2001 }
2002 }
2003 obj2->size = k;
2004 SetRaw(a, obj2);
2005 return errNone;
2006 }
2007
2008 int prArrayLace(struct VMGlobals *g, int numArgsPushed)
2009 {
2010 PyrSlot *a, *b, *slots, *slot;
2011 PyrObject *obj1, *obj2, *obj3;
2012 int i, j, k, n, m, numLists, len;
2013
2014 a = g->sp - 1;
2015 b = g->sp;
2016 obj1 = slotRawObject(a);
2017 slots = obj1->slots;
2018 numLists = obj1->size;
2019
2020 if(IsNil(b)) {
2021 for (j=0; j<numLists; ++j) {
2022 slot = slots + j;
2023 if(isKindOfSlot(slot, class_array)) {
2024 len = slotRawObject(slot)->size;
2025 if(j==0 || n>len) { n = len; }
2026 } else {
2027 return errFailed; // this primitive only handles Arrays.
2028 }
2029 }
2030 n = n * numLists;
2031
2032 } else if (IsInt(b)) {
2033 n = slotRawInt(b);
2034 } else {
2035 return errWrongType;
2036 }
2037
2038
2039 n = sc_max(1, n);
2040 if(obj1->size > 0) {
2041 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
2042 for (i=j=k=0; i<n; ++i) {
2043 if (IsObj(&slots[k])) {
2044 obj3 = slotRawObject(&slots[k]);
2045 if (isKindOf(obj3, class_list)) {
2046 obj3 = slotRawObject(&obj3->slots[0]); // get the list's array
2047 }
2048 if (obj3 && isKindOf(obj3, class_array)) {
2049 m = j % obj3->size;
2050 slotCopy(&obj2->slots[i],&obj3->slots[m]);
2051 } else {
2052 slotCopy(&obj2->slots[i],&slots[k]);
2053 }
2054 } else {
2055 slotCopy(&obj2->slots[i],&slots[k]);
2056 }
2057 k = (k+1) % obj1->size;
2058 if (k == 0) j++;
2059 }
2060 } else {
2061 obj2 = instantiateObject(g->gc, obj1->classptr, n, true, true);
2062 }
2063 obj2->size = n;
2064 SetRaw(a, obj2);
2065 return errNone;
2066 }
2067
2068 int prArrayContainsSeqColl(struct VMGlobals *g, int numArgsPushed)
2069 {
2070 PyrSlot *a, *slot, *endptr;
2071 PyrObject *obj;
2072 int size;
2073
2074 a = g->sp;
2075 obj = slotRawObject(a);
2076 size = obj->size;
2077 slot = obj->slots - 1;
2078 endptr = slot + size;
2079 while (slot < endptr) {
2080 ++slot;
2081 if (IsObj(slot)) {
2082 if (isKindOf(slotRawObject(slot), class_sequenceable_collection)) {
2083 SetTrue(a);
2084 return errNone;
2085 }
2086 }
2087 }
2088 SetFalse(a);
2089 return errNone;
2090 }
2091
2092 int prArrayNormalizeSum(struct VMGlobals *g, int numArgsPushed)
2093 {
2094 PyrSlot *a, *slots2;
2095 PyrObject *obj1, *obj2;
2096 int i, size, err;
2097 double w, sum, rsum;
2098
2099 a = g->sp;
2100 obj1 = slotRawObject(a);
2101 size = obj1->size;
2102 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
2103 slots2 = obj2->slots;
2104 sum = 0.0;
2105 for (i=0; i<size; ++i) {
2106 err = getIndexedDouble(obj1, i, &w);
2107 if (err) return err;
2108 sum += w;
2109 SetFloat(&slots2[i], w);
2110 }
2111 rsum = 1./sum;
2112 for (i=0; i<size; ++i) {
2113 double d = slotRawFloat(&slots2[i]);
2114 SetRaw(&slots2[i], d * rsum);
2115 }
2116 obj2->size = size;
2117 SetRaw(a, obj2);
2118 return errNone;
2119 }
2120
2121
2122
2123
2124 int prArrayWIndex(struct VMGlobals *g, int numArgsPushed)
2125 {
2126 PyrSlot *a, *slots;
2127 PyrObject *obj;
2128 int i, j, size, err;
2129 double r, w, sum;
2130
2131 a = g->sp;
2132
2133 sum = 0.0;
2134 r = g->rgen->frand();
2135 obj = slotRawObject(a);
2136 size = obj->size;
2137 j = size - 1;
2138 slots = obj->slots;
2139 for (i=0; i<size; ++i) {
2140 err = getIndexedDouble(obj, i, &w);
2141 if (err) return err;
2142 sum += w;
2143 if (sum >= r) {
2144 j = i;
2145 break;
2146 }
2147 }
2148 SetInt(a, j);
2149 return errNone;
2150 }
2151
2152
2153 enum {
2154 shape_Step,
2155 shape_Linear,
2156 shape_Exponential,
2157 shape_Sine,
2158 shape_Welch,
2159 shape_Curve,
2160 shape_Squared,
2161 shape_Cubed
2162 };
2163
2164 enum {
2165 kEnv_initLevel,
2166 kEnv_numStages,
2167 kEnv_releaseNode,
2168 kEnv_loopNode
2169 };
2170
2171 int prArrayEnvAt(struct VMGlobals *g, int numArgsPushed)
2172 {
2173 PyrSlot *a = g->sp - 1;
2174 PyrSlot *b = g->sp;
2175
2176 PyrObject* env = slotRawObject(a);
2177 PyrSlot* slots = env->slots;
2178
2179 // Env:asArray always gives at least 8 array elements
2180 if(env->size < 8) return errFailed;
2181
2182 double time;
2183 int err = slotDoubleVal(b, &time);
2184 if (err) return err;
2185
2186 double begLevel;
2187 err = slotDoubleVal(slots + kEnv_initLevel, &begLevel);
2188 if (err) return err;
2189
2190 int numStages;
2191 err = slotIntVal(slots + kEnv_numStages, &numStages);
2192 if (err) return err;
2193
2194 double begTime = 0.;
2195 double endTime = 0.;
2196
2197 for (int i=0; i<numStages; ++i) {
2198 double dur, endLevel;
2199
2200 slots += 4;
2201
2202 err = slotDoubleVal(slots + 0, &endLevel);
2203 if (err) return err;
2204 err = slotDoubleVal(slots + 1, &dur);
2205 if (err) return err;
2206
2207 endTime += dur;
2208
2209 //post("%d %g %g %g %g %g\n", i, time, begTime, endTime, dur, endLevel);
2210
2211 if (time < endTime) {
2212 int shape;
2213 double curve;
2214
2215 err = slotIntVal(slots + 2, &shape);
2216 if (err) return err;
2217
2218 double level;
2219 double pos = (time - begTime) / dur;
2220
2221 //post(" shape %d pos %g\n", shape, pos);
2222 switch (shape)
2223 {
2224 case shape_Step :
2225 level = endLevel;
2226 break;
2227 case shape_Linear :
2228 default:
2229 level = pos * (endLevel - begLevel) + begLevel;
2230 break;
2231 case shape_Exponential :
2232 level = begLevel * pow(endLevel / begLevel, pos);
2233 break;
2234 case shape_Sine :
2235 level = begLevel + (endLevel - begLevel) * (-cos(pi * pos) * 0.5 + 0.5);
2236 break;
2237 case shape_Welch :
2238 {
2239 if (begLevel < endLevel)
2240 level = begLevel + (endLevel - begLevel) * sin(pi2 * pos);
2241 else
2242 level = endLevel - (endLevel - begLevel) * sin(pi2 - pi2 * pos);
2243 break;
2244 }
2245 case shape_Curve :
2246 err = slotDoubleVal(slots + 3, &curve);
2247 if (err) return err;
2248
2249 if (fabs(curve) < 0.0001) {
2250 level = pos * (endLevel - begLevel) + begLevel;
2251 } else {
2252 double denom = 1. - exp(curve);
2253 double numer = 1. - exp(pos * curve);
2254 level = begLevel + (endLevel - begLevel) * (numer/denom);
2255 }
2256 break;
2257 case shape_Squared :
2258 {
2259 double sqrtBegLevel = sqrt(begLevel);
2260 double sqrtEndLevel = sqrt(endLevel);
2261 double sqrtLevel = pos * (sqrtEndLevel - sqrtBegLevel) + sqrtBegLevel;
2262 level = sqrtLevel * sqrtLevel;
2263 break;
2264 }
2265 case shape_Cubed :
2266 {
2267 double cbrtBegLevel = pow(begLevel, 0.3333333);
2268 double cbrtEndLevel = pow(endLevel, 0.3333333);
2269 double cbrtLevel = pos * (cbrtEndLevel - cbrtBegLevel) + cbrtBegLevel;
2270 level = cbrtLevel * cbrtLevel * cbrtLevel;
2271 break;
2272 }
2273 }
2274 SetFloat(a, level);
2275 return errNone;
2276 }
2277
2278 begTime = endTime;
2279 begLevel = endLevel;
2280 }
2281
2282 SetFloat(a, begLevel);
2283
2284 return errNone;
2285 }
2286
2287
2288 int prArrayIndexOfGreaterThan(struct VMGlobals *g, int numArgsPushed)
2289 {
2290 PyrSlot *a, *b, *slots;
2291 PyrObject *obj;
2292 int i, size, err;
2293 double s, w;
2294
2295 a = g->sp - 1;
2296 b = g->sp;
2297
2298 obj = slotRawObject(a);
2299
2300 size = obj->size;
2301 slots = obj->slots;
2302
2303 err = slotDoubleVal(b, &s);
2304 if (err) return err;
2305
2306 for (i=0; i<size; ++i) {
2307 err = getIndexedDouble(obj, i, &w);
2308 if (err) return err;
2309
2310 if (w > s) {
2311 SetInt(a, i);
2312 return errNone;
2313 }
2314 }
2315
2316 SetNil(a);
2317 return errNone;
2318 }
2319
2320
2321
2322 int prArrayUnlace(struct VMGlobals *g, int numArgsPushed)
2323 {
2324 PyrSlot *a, *b, *c, *slots, *slots2, *slots3;
2325 PyrObject *obj1, *obj2, *obj3;
2326 int i, j, k, clump, numLists, size, size3, err;
2327
2328 a = g->sp - 2;
2329 b = g->sp - 1;
2330 c = g->sp;
2331
2332 obj1 = slotRawObject(a);
2333 slots = obj1->slots;
2334 size = obj1->size;
2335
2336 err = slotIntVal(b, &numLists);
2337 if (err) return err;
2338
2339 err = slotIntVal(c, &clump);
2340 if (err) return err;
2341
2342 obj2 = instantiateObject(g->gc, obj1->classptr, numLists, false, true);
2343 obj2->size = numLists;
2344 slots2 = obj2->slots;
2345
2346 SetObject(b, obj2); // store reference on stack, so both source and destination objects can be reached by the gc
2347
2348 size3 = size / numLists;
2349 size3 = size3 - (size3 % clump);
2350 if(size3 < 1) return errFailed;
2351
2352 for(i=0; i<numLists; ++i) {
2353 obj3 = instantiateObject(g->gc, obj1->classptr, size3, false, true);
2354 obj3->size = size3;
2355 slots3 = obj3->slots;
2356 for(j=0; j<size3; j+=clump) {
2357 for(k=0; k<clump; ++k) {
2358 slotCopy(&slots3[j+k],&slots[i*clump + k + j*numLists]);
2359 }
2360 }
2361 SetObject(slots2 + i, obj3);
2362 }
2363
2364 SetRaw(a, obj2);
2365
2366 return errNone;
2367 }
2368
2369 void initArrayPrimitives();
2370 void initArrayPrimitives()
2371 {
2372 int base, index;
2373
2374 base = nextPrimitiveIndex();
2375 index = 0;
2376
2377 definePrimitive(base, index++, "_BasicSize", basicSize, 1, 0);
2378 definePrimitive(base, index++, "_BasicMaxSize", basicMaxSize, 1, 0);
2379
2380 definePrimitive(base, index++, "_BasicSwap", basicSwap, 3, 0);
2381 definePrimitive(base, index++, "_BasicAt", basicAt, 2, 0);
2382 definePrimitive(base, index++, "_BasicRemoveAt", basicRemoveAt, 2, 0);
2383 definePrimitive(base, index++, "_BasicTakeAt", basicTakeAt, 2, 0);
2384 definePrimitive(base, index++, "_BasicClipAt", basicClipAt, 2, 0);
2385 definePrimitive(base, index++, "_BasicWrapAt", basicWrapAt, 2, 0);
2386 definePrimitive(base, index++, "_BasicFoldAt", basicFoldAt, 2, 0);
2387 definePrimitive(base, index++, "_BasicPut", basicPut, 3, 0);
2388 definePrimitive(base, index++, "_BasicClipPut", basicClipPut, 3, 0);
2389 definePrimitive(base, index++, "_BasicWrapPut", basicWrapPut, 3, 0);
2390 definePrimitive(base, index++, "_BasicFoldPut", basicFoldPut, 3, 0);
2391
2392 definePrimitive(base, index++, "_ArrayExtend", prArrayExtend, 3, 0);
2393 definePrimitive(base, index++, "_ArrayGrow", prArrayGrow, 2, 0);
2394 definePrimitive(base, index++, "_ArrayGrowClear", prArrayGrowClear, 2, 0);
2395 definePrimitive(base, index++, "_ArrayAdd", prArrayAdd, 2, 0);
2396 definePrimitive(base, index++, "_ArrayInsert", prArrayInsert, 3, 0);
2397 definePrimitive(base, index++, "_ArrayFill", prArrayFill, 2, 0);
2398 definePrimitive(base, index++, "_ArrayPop", prArrayPop, 1, 0);
2399 definePrimitive(base, index++, "_ArrayCat", prArrayCat, 2, 0);
2400 definePrimitive(base, index++, "_ArrayPutEach", prArrayPutEach, 3, 0);
2401 definePrimitive(base, index++, "_ArrayAddAll", prArrayAddAll, 2, 0);
2402 definePrimitive(base, index++, "_ArrayPutSeries", prArrayPutSeries, 5, 0);
2403 definePrimitive(base, index++, "_ArrayOverwrite", prArrayOverwrite, 3, 0);
2404 definePrimitive(base, index++, "_ArrayIndexOf", prArrayIndexOf, 2, 0);
2405
2406 definePrimitive(base, index++, "_ArrayNormalizeSum", prArrayNormalizeSum, 1, 0);
2407 definePrimitive(base, index++, "_ArrayWIndex", prArrayWIndex, 1, 0);
2408 definePrimitive(base, index++, "_ArrayReverse", prArrayReverse, 1, 0);
2409 definePrimitive(base, index++, "_ArrayScramble", prArrayScramble, 1, 0);
2410 definePrimitive(base, index++, "_ArrayMirror", prArrayMirror, 1, 0);
2411 definePrimitive(base, index++, "_ArrayMirror1", prArrayMirror1, 1, 0);
2412 definePrimitive(base, index++, "_ArrayMirror2", prArrayMirror2, 1, 0);
2413 definePrimitive(base, index++, "_ArrayRotate", prArrayRotate, 2, 0);
2414 definePrimitive(base, index++, "_ArrayPermute", prArrayPermute, 2, 0);
2415 definePrimitive(base, index++, "_ArrayAllTuples", prArrayAllTuples, 2, 0);
2416 definePrimitive(base, index++, "_ArrayPyramid", prArrayPyramid, 2, 0);
2417 definePrimitive(base, index++, "_ArrayRotate", prArrayRotate, 2, 0);
2418 definePrimitive(base, index++, "_ArrayExtendWrap", prArrayExtendWrap, 2, 0);
2419 definePrimitive(base, index++, "_ArrayExtendFold", prArrayExtendFold, 2, 0);
2420 definePrimitive(base, index++, "_ArrayExtendLast", prArrayExtendLast, 2, 0);
2421 definePrimitive(base, index++, "_ArrayLace", prArrayLace, 2, 0);
2422 definePrimitive(base, index++, "_ArrayStutter", prArrayStutter, 2, 0);
2423 definePrimitive(base, index++, "_ArraySlide", prArraySlide, 3, 0);
2424 definePrimitive(base, index++, "_ArrayContainsSeqColl", prArrayContainsSeqColl, 1, 0);
2425
2426 definePrimitive(base, index++, "_ArrayEnvAt", prArrayEnvAt, 2, 0);
2427 definePrimitive(base, index++, "_ArrayIndexOfGreaterThan", prArrayIndexOfGreaterThan, 2, 0);
2428 definePrimitive(base, index++, "_ArrayUnlace", prArrayUnlace, 3, 0);
2429
2430 }
2431
2432
2433 #if _SC_PLUGINS_
2434
2435 #include "SCPlugin.h"
2436
2437 #pragma export on
2438 extern "C" { SCPlugIn* loadPlugIn(void); }
2439 #pragma export off
2440
2441
2442 // define plug in object
2443 class APlugIn : public SCPlugIn
2444 {
2445 public:
2446 APlugIn();
2447 virtual ~APlugIn();
2448
2449 virtual void AboutToCompile();
2450 };
2451
2452 APlugIn::APlugIn()
2453 {
2454 // constructor for plug in
2455 }
2456
2457 APlugIn::~APlugIn()
2458 {
2459 // destructor for plug in
2460 }
2461
2462 void APlugIn::AboutToCompile()
2463 {
2464 // this is called each time the class library is compiled.
2465 initArrayPrimitives();
2466 }
2467
2468 // This function is called when the plug in is loaded into SC.
2469 // It returns an instance of APlugIn.
2470 SCPlugIn* loadPlugIn()
2471 {
2472 return new APlugIn();
2473 }
2474
2475 #endif
2476