?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
scide: implement selectionLength for openDocument
[supercollider.git] / lang / LangPrimSource / PyrArrayPrimitives.cpp
blob79747d1bca077f6df8e074230661ece9cb6db8df
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 (obj->IsImmutable()) return errImmutableObject;
457 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
458 return errNotAnIndexableObject;
459
460 if (NotObj(a)) return errWrongType;
461 int err = slotIntVal(b, &index);
462
463 if (!err) {
464 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
465 return putIndexedSlot(g, obj, c, index);
466 } else if (isKindOfSlot(b, class_arrayed_collection)) {
467 PyrObject *indexArray = slotRawObject(b);
468 int size = slotRawObject(b)->size;
469
470 for (int i=0; i<size; ++i) {
471 int index;
472 int err = getIndexedInt(indexArray, i, &index);
473 if (err) return err;
474 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
475 err = putIndexedSlot(g, obj, c, index);
476 if (err) return err;
477 }
478 return errNone;
479 } else return errIndexNotAnInteger;
480 }
481
482 int basicClipPut(struct VMGlobals *g, int numArgsPushed)
483 {
484 PyrSlot *a, *b, *c;
485 int index;
486 PyrObject *obj;
487
488 a = g->sp - 2;
489 b = g->sp - 1;
490 c = g->sp;
491
492 obj = slotRawObject(a);
493 if (obj->IsImmutable()) return errImmutableObject;
494 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
495 return errNotAnIndexableObject;
496
497 if (NotObj(a)) return errWrongType;
498 int err = slotIntVal(b, &index);
499
500 if (!err) {
501 index = sc_clip(index, 0, obj->size - 1);
502 return putIndexedSlot(g, obj, c, index);
503 } else if (isKindOfSlot(b, class_arrayed_collection)) {
504 PyrObject *indexArray = slotRawObject(b);
505 int size = slotRawObject(b)->size;
506
507 for (int i=0; i<size; ++i) {
508 int index;
509 int err = getIndexedInt(indexArray, i, &index);
510 if (err) return err;
511 index = sc_clip(index, 0, obj->size - 1);
512 err = putIndexedSlot(g, obj, c, index);
513 if (err) return err;
514 }
515 return errNone;
516 } else return errIndexNotAnInteger;
517 }
518
519 int basicWrapPut(struct VMGlobals *g, int numArgsPushed)
520 {
521 PyrSlot *a, *b, *c;
522 int index;
523 PyrObject *obj;
524
525 a = g->sp - 2;
526 b = g->sp - 1;
527 c = g->sp;
528
529 obj = slotRawObject(a);
530 if (obj->IsImmutable()) return errImmutableObject;
531 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
532 return errNotAnIndexableObject;
533
534 if (NotObj(a)) return errWrongType;
535 int err = slotIntVal(b, &index);
536
537 if (!err) {
538 index = sc_mod((int)index, (int)obj->size);
539 return putIndexedSlot(g, obj, c, index);
540 } else if (isKindOfSlot(b, class_arrayed_collection)) {
541 PyrObject *indexArray = slotRawObject(b);
542 int size = slotRawObject(b)->size;
543
544 for (int i=0; i<size; ++i) {
545 int index;
546 int err = getIndexedInt(indexArray, i, &index);
547 if (err) return err;
548 index = sc_mod((int)index, (int)obj->size);
549 err = putIndexedSlot(g, obj, c, index);
550 if (err) return err;
551 }
552 return errNone;
553 } else return errIndexNotAnInteger;
554 }
555
556 int basicFoldPut(struct VMGlobals *g, int numArgsPushed)
557 {
558 PyrSlot *a, *b, *c;
559 int index;
560 PyrObject *obj;
561
562 a = g->sp - 2;
563 b = g->sp - 1;
564 c = g->sp;
565
566 obj = slotRawObject(a);
567 if (obj->IsImmutable()) return errImmutableObject;
568 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
569 return errNotAnIndexableObject;
570
571 if (NotObj(a)) return errWrongType;
572 int err = slotIntVal(b, &index);
573
574 if (!err) {
575 index = sc_fold(index, 0, obj->size-1);
576 return putIndexedSlot(g, obj, c, index);
577 } else if (isKindOfSlot(b, class_arrayed_collection)) {
578 PyrObject *indexArray = slotRawObject(b);
579 int size = slotRawObject(b)->size;
580
581 for (int i=0; i<size; ++i) {
582 int index;
583 int err = getIndexedInt(indexArray, i, &index);
584 if (err) return err;
585 index = sc_fold(index, 0, obj->size-1);
586 err = putIndexedSlot(g, obj, c, index);
587 if (err) return err;
588 }
589 return errNone;
590 } else return errIndexNotAnInteger;
591 }
592
593 int prArrayPutEach(struct VMGlobals *g, int numArgsPushed)
594 {
595 PyrSlot *a, *b, *c;
596 PyrObject *obj;
597
598 a = g->sp - 2;
599 b = g->sp - 1;
600 c = g->sp;
601
602 obj = slotRawObject(a);
603 if (obj->IsImmutable()) return errImmutableObject;
604 if (!(slotRawInt(&obj->classptr->classFlags) & classHasIndexableInstances))
605 return errNotAnIndexableObject;
606
607 if (!isKindOfSlot(b, class_arrayed_collection)) return errWrongType;
608 if (!isKindOfSlot(c, class_arrayed_collection)) return errWrongType;
609
610 PyrSlot *indices = slotRawObject(b)->slots;
611 PyrSlot *values = slotRawObject(c)->slots;
612 int size = slotRawObject(b)->size;
613 int valsize = slotRawObject(c)->size;
614
615 for (int i=0; i<size; ++i) {
616 int index;
617 int err = slotIntVal(indices + i, &index);
618 if (err) return err;
619 if (index < 0 || index >= obj->size) return errIndexOutOfRange;
620 int valindex = sc_mod(i, valsize);
621 err = putIndexedSlot(g, obj, values + valindex, index);
622 if (err) return err;
623 }
624
625 return errNone;
626 }
627
628
629 int prArrayAssocAt(struct VMGlobals *g, int numArgsPushed)
630 {
631 PyrSlot *a, *b;
632 PyrObject *obj;
633 bool found = false;
634
635 a = g->sp - 1;
636 b = g->sp;
637
638 obj = slotRawObject(a);
639
640 int size = obj->size;
641 if (obj->obj_format == obj_slot) {
642 PyrSlot *slots = obj->slots;
643 for (int i=0; i<size; i+=2) {
644 if (SlotEq(slots+i, b)) {
645 if (i+1 >= size) return errFailed;
646 slotCopy(a,&slots[i+1]);
647 found = true;
648 break;
649 }
650 }
651 } else {
652 PyrSlot slot;
653 for (int i=0; i<size; i+=2) {
654 getIndexedSlot(obj, &slot, i);
655 if (SlotEq(&slot, b)) {
656 if (i+1 >= size) return errFailed;
657 getIndexedSlot(obj, &slot, i+1);
658 slotCopy(a,&slot);
659 found = true;
660 break;
661 }
662 }
663 }
664 if (!found) SetNil(a);
665
666 return errNone;
667 }
668
669
670 int prArrayAssocPut(struct VMGlobals *g, int numArgsPushed)
671 {
672 PyrSlot *a, *b, *c;
673 PyrObject *obj;
674 bool found = false;
675
676 a = g->sp - 2;
677 b = g->sp - 1;
678 c = g->sp;
679
680 obj = slotRawObject(a);
681 if (obj->IsImmutable()) return errImmutableObject;
682
683 int size = obj->size;
684 if (obj->obj_format == obj_slot) {
685 PyrSlot *slots = obj->slots;
686 for (int i=0; i<size; i+=2) {
687 if (SlotEq(slots+i, b)) {
688 if (i+1 >= size) return errFailed;
689 slotCopy(&slots[i+1],c);
690 g->gc->GCWrite(obj, c);
691 found = true;
692 break;
693 }
694 }
695 } else {
696 PyrSlot slot;
697 for (int i=0; i<size; i+=2) {
698 getIndexedSlot(obj, &slot, i);
699 if (SlotEq(&slot, b)) {
700 if (i+1 >= size) return errFailed;
701 putIndexedSlot(g, obj, &slot, i+1);
702 g->gc->GCWrite(obj, c);
703 found = true;
704 break;
705 }
706 }
707 }
708 if (!found) SetNil(a);
709
710 return errNone;
711 }
712
713 int prArrayIndexOf(struct VMGlobals *g, int numArgsPushed)
714 {
715 PyrSlot *a, *b;
716 PyrObject *obj;
717 bool found = false;
718
719 a = g->sp - 1;
720 b = g->sp;
721
722 obj = slotRawObject(a);
723
724 int size = obj->size;
725 if (obj->obj_format == obj_slot) {
726 PyrSlot *slots = obj->slots;
727 for (int i=0; i<size; ++i) {
728 if (SlotEq(slots+i, b)) {
729 SetInt(a, i);
730 found = true;
731 break;
732 }
733 }
734 } else {
735 PyrSlot slot;
736 for (int i=0; i<size; ++i) {
737 getIndexedSlot(obj, &slot, i);
738 if (SlotEq(&slot, b)) {
739 SetInt(a, i);
740 found = true;
741 break;
742 }
743 }
744 }
745 if (!found) SetNil(a);
746
747 return errNone;
748 }
749
750
751 int prArrayPutSeries(struct VMGlobals *g, int numArgsPushed)
752 {
753 PyrSlot *a, *b, *c, *d, *e;
754
755 a = g->sp - 4;
756 b = g->sp - 3;
757 c = g->sp - 2;
758 d = g->sp - 1;
759 e = g->sp;
760
761 PyrObject *inobj = slotRawObject(a);
762 if (inobj->IsImmutable()) return errImmutableObject;
763
764 int size = inobj->size;
765
766 if (NotInt(b) && NotNil(b)) return errWrongType;
767 if (NotInt(c) && NotNil(c)) return errWrongType;
768 if (NotInt(d) && NotNil(d)) return errWrongType;
769
770 int first = IsInt(b) ? slotRawInt(b) : 0;
771 int last = IsInt(d) ? slotRawInt(d) : size - 1;
772 int second = IsInt(c) ? slotRawInt(c) : (first < last ? first + 1 : first - 1);
773
774 int step = second - first;
775
776 first = sc_clip(first, 0, size-1);
777 last = sc_clip(last, 0, size-1);
778
779 int err = errNone;
780
781 if (step == 0) return errFailed;
782 if (step == 1) {
783 for (int i=first; i<=last; ++i) {
784 err = putIndexedSlot(g, inobj, e, i);
785 if (err) return err;
786 }
787 } else if (step == -1) {
788 for (int i=last; i>=first; --i) {
789 err = putIndexedSlot(g, inobj, e, i);
790 if (err) return err;
791 }
792 } else if (step > 0) {
793 int length = (last - first) / 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 } else if (step < 0) {
800 int length = (first - last) / -step + 1;
801
802 for (int i=first, j=0; j<length; i+=step, ++j) {
803 err = putIndexedSlot(g, inobj, e, i);
804 if (err) return err;
805 }
806 }
807 return errNone;
808 }
809
810
811 int prArrayAdd(struct VMGlobals *g, int numArgsPushed)
812 {
813 PyrSlot *a, *b, *slots;
814 int maxelems, elemsize, format, tag, numbytes;
815 int err, ival;
816 double fval;
817
818 a = g->sp - 1;
819 b = g->sp;
820
821 PyrObject *array = slotRawObject(a);
822 if (array->IsImmutable()) return errImmutableObject;
823
824 format = slotRawObject(a)->obj_format;
825 tag = gFormatElemTag[format];
826 /*if (tag > 0) {
827 if (GetTag(b) != tag) return errWrongType;
828 } else if (tag == 0) {
829 if (NotFloat(b)) return errWrongType;
830 } // else format is obj_slot, any tag is acceptable*/
831 elemsize = gFormatElemSize[format];
832 maxelems = MAXINDEXSIZE(array);
833 if (array->size >= maxelems || array->IsImmutable()) {
834 numbytes = sizeof(PyrSlot) << (array->obj_sizeclass + 1);
835 array = g->gc->New(numbytes, 0, format, true);
836 array->classptr = slotRawObject(a)->classptr;
837 array->size = slotRawObject(a)->size;
838 memcpy(array->slots, slotRawObject(a)->slots, slotRawObject(a)->size * elemsize);
839 SetRaw(a, array);
840 }
841 slots = array->slots;
842 switch (format) {
843 case obj_slot :
844 slotCopy(&slots[array->size++],b);
845 g->gc->GCWrite(array, b);
846 break;
847 case obj_int32 :
848 err = slotIntVal(b, &ival);
849 if (err) return err;
850 ((int32*)slots)[array->size++] = ival;
851 break;
852 case obj_int16 :
853 err = slotIntVal(b, &ival);
854 if (err) return err;
855 ((int16*)slots)[array->size++] = ival;
856 break;
857 case obj_int8 :
858 err = slotIntVal(b, &ival);
859 if (err) return err;
860 ((int8*)slots)[array->size++] = ival;
861 break;
862 case obj_char :
863 if (NotChar(b)) return errWrongType;
864 ((char*)slots)[array->size++] = slotRawChar(b);
865 break;
866 case obj_symbol :
867 if (NotSym(b)) return errWrongType;
868 ((PyrSymbol**)slots)[array->size++] = slotRawSymbol(b);
869 break;
870 case obj_float :
871 err = slotDoubleVal(b, &fval);
872 if (err) return err;
873 ((float*)slots)[array->size++] = fval;
874 break;
875 case obj_double :
876 err = slotDoubleVal(b, &fval);
877 if (err) return err;
878 ((double*)slots)[array->size++] = fval;
879 break;
880 }
881 return errNone;
882 }
883
884 int prArrayInsert(struct VMGlobals *g, int numArgsPushed)
885 {
886 PyrSlot *a, *b, *c, *slots1, *slots2;
887 PyrObject *array, *oldarray;
888 int err, ival;
889 double fval;
890
891 a = g->sp - 2; // array
892 b = g->sp - 1; // index
893 c = g->sp; // value
894 if (NotInt(b)) return errWrongType;
895
896 array = slotRawObject(a);
897 const int format = slotRawObject(a)->obj_format;
898 const int tag = gFormatElemTag[format];
899
900 const int size = array->size;
901 int index = slotRawInt(b);
902 index = sc_clip(index, 0, size);
903 const int remain = size - index;
904
905 const int elemsize = gFormatElemSize[format];
906 const int maxelems = MAXINDEXSIZE(array);
907 if (size+1 > maxelems || array->IsImmutable()) {
908 oldarray = array;
909
910 const int numbytes = sizeof(PyrSlot) << (array->obj_sizeclass + 1);
911 array = g->gc->New(numbytes, 0, format, true);
912
913 array->classptr = oldarray->classptr;
914
915 array->size = size+1;
916 SetRaw(a, array);
917 slots1 = array->slots;
918 slots2 = oldarray->slots;
919 if (index)
920 memcpy(slots1, slots2, index * elemsize);
921
922 switch (format) {
923 case obj_slot :
924
925 slotCopy(&slots1[index],c);
926 if (remain) memcpy(slots1 + index + 1, slots2 + index, remain * elemsize);
927 if (!g->gc->ObjIsGrey(array)) g->gc->ToGrey(array);
928 break;
929 case obj_int32 :
930 err = slotIntVal(c, &ival);
931 if (err) return err;
932 ((int32*)slots1)[index] = ival;
933 if (remain) {
934 memcpy((int*)slots1 + index + 1, (int*)slots2 + index,
935 remain * elemsize);
936 }
937 break;
938 case obj_int16 :
939 err = slotIntVal(c, &ival);
940 if (err) return err;
941 ((int16*)slots1)[index] = ival;
942 if (remain) {
943 memcpy((short*)slots1 + index + 1, (short*)slots2 + index,
944 remain * elemsize);
945 }
946 break;
947 case obj_int8 :
948 err = slotIntVal(c, &ival);
949 if (err) return err;
950 ((int8*)slots1)[index] = ival;
951 if (remain) {
952 memcpy((char*)slots1 + index + 1, (char*)slots2 + index,
953 remain * elemsize);
954 }
955 break;
956 case obj_char :
957 if (NotChar(c)) return errWrongType;
958 ((char*)slots1)[index] = slotRawInt(c);
959 if (remain) {
960 memcpy((char*)slots1 + index + 1, (char*)slots2 + index,
961 remain * elemsize);
962 }
963 break;
964 case obj_symbol :
965 if (NotSym(c)) return errWrongType;
966 ((PyrSymbol**)slots1)[index] = slotRawSymbol(c);
967 if (remain) {
968 memcpy((int*)slots1 + index + 1, (int*)slots2 + index,
969 remain * elemsize);
970 }
971 break;
972 case obj_float :
973 err = slotDoubleVal(c, &fval);
974 if (err) return err;
975 ((float*)slots1)[index] = fval;
976 if (remain) {
977 memcpy((float*)slots1 + index + 1, (float*)slots2 + index,
978 remain * elemsize);
979 }
980 break;
981 case obj_double :
982 err = slotDoubleVal(c, &fval);
983 if (err) return err;
984 ((double*)slots1)[index] = fval;
985 if (remain) {
986 memcpy((double*)slots1 + index + 1, (double*)slots2 + index,
987 remain * elemsize);
988 }
989 break;
990 }
991 } else {
992 array->size = size+1;
993 slots1 = array->slots;
994 switch (format) {
995 case obj_slot :
996 if (remain) memmove(slots1 + index + 1, slots1 + index, remain * elemsize);
997 slotCopy(&slots1[index],c);
998 if (!g->gc->ObjIsGrey(array)) g->gc->ToGrey(array);
999 break;
1000 case obj_int32 :
1001 if (remain) {
1002 memmove((int*)slots1 + index + 1, (int*)slots1 + index,
1003 remain * elemsize);
1004 }
1005 err = slotIntVal(c, &ival);
1006 if (err) return err;
1007 ((int32*)slots1)[index] = ival;
1008 break;
1009 case obj_int16 :
1010 if (remain) {
1011 memmove((short*)slots1 + index + 1, (short*)slots1 + index,
1012 remain * elemsize);
1013 }
1014 err = slotIntVal(c, &ival);
1015 if (err) return err;
1016 ((int16*)slots1)[index] = ival;
1017 break;
1018 case obj_int8 :
1019 if (remain) {
1020 memmove((char*)slots1 + index + 1, (char*)slots1 + index,
1021 remain * elemsize);
1022 }
1023 err = slotIntVal(c, &ival);
1024 if (err) return err;
1025 ((int8*)slots1)[index] = ival;
1026 break;
1027 case obj_char :
1028 if (remain) {
1029 memmove((char*)slots1 + index + 1, (char*)slots1 + index,
1030 remain * elemsize);
1031 }
1032 if (NotChar(c)) return errWrongType;
1033 ((char*)slots1)[index] = slotRawInt(c);
1034 break;
1035 case obj_symbol :
1036 if (remain) {
1037 memmove((int*)slots1 + index + 1, (int*)slots1 + index,
1038 remain * elemsize);
1039 }
1040 if (NotSym(c)) return errWrongType;
1041 ((PyrSymbol**)slots1)[index] = slotRawSymbol(c);
1042 break;
1043 case obj_float :
1044 if (remain) {
1045 memmove((float*)slots1 + index + 1, (float*)slots1 + index,
1046 remain * elemsize);
1047 }
1048 err = slotDoubleVal(c, &fval);
1049 if (err) return err;
1050 ((float*)slots1)[index] = fval;
1051 break;
1052 case obj_double :
1053 if (remain) {
1054 memmove((double*)slots1 + index + 1, (double*)slots1 + index,
1055 remain * elemsize);
1056 }
1057 err = slotDoubleVal(c, &fval);
1058 if (err) return err;
1059 ((double*)slots1)[index] = fval;
1060 break;
1061 }
1062 }
1063 return errNone;
1064 }
1065
1066
1067 int prArrayFill(struct VMGlobals *g, int numArgsPushed)
1068 {
1069 PyrSlot *a, *b, *slots;
1070 PyrObject *array;
1071 PyrSymbol *sym;
1072 int i;
1073 int format, tag;
1074 int err, ival;
1075 double fval;
1076
1077
1078 a = g->sp - 1;
1079 b = g->sp;
1080
1081 array = slotRawObject(a);
1082 format = slotRawObject(a)->obj_format;
1083 tag = gFormatElemTag[format];
1084 /*if (tag > 0) {
1085 if (GetTag(b) != tag) return errWrongType;
1086 } else if (tag == 0) {
1087 if (NotFloat(b)) return errWrongType;
1088 } // else format is obj_slot, any tag is acceptable*/
1089 slots = array->slots;
1090 switch (format) {
1091 case obj_slot :
1092 if (array->IsImmutable()) return errImmutableObject;
1093 for (i=0; i<array->size; ++i) {
1094 slotCopy(&slots[i],b);
1095 }
1096 g->gc->GCWrite(array, b);
1097 break;
1098 case obj_int32 :
1099 err = slotIntVal(b, &ival);
1100 if (err) return err;
1101 for (i=0; i<array->size; ++i) {
1102 ((int32*)slots)[i] = ival;
1103 }
1104 break;
1105 case obj_int16 :
1106 err = slotIntVal(b, &ival);
1107 if (err) return err;
1108 for (i=0; i<array->size; ++i) {
1109 ((int16*)slots)[i] = ival;
1110 }
1111 break;
1112 case obj_int8 :
1113 err = slotIntVal(b, &ival);
1114 if (err) return err;
1115 for (i=0; i<array->size; ++i) {
1116 ((int8*)slots)[i] = ival;
1117 }
1118 break;
1119 case obj_char :
1120 if (NotChar(b)) return errWrongType;
1121 ival = slotRawInt(b);
1122 for (i=0; i<array->size; ++i) {
1123 ((char*)slots)[i] = ival;
1124 }
1125 break;
1126 case obj_symbol :
1127 if (NotSym(b)) return errWrongType;
1128 sym = slotRawSymbol(b);
1129 for (i=0; i<array->size; ++i) {
1130 ((PyrSymbol**)slots)[i] = sym;
1131 }
1132 break;
1133 case obj_float :
1134 err = slotDoubleVal(b, &fval);
1135 if (err) return err;
1136 for (i=0; i<array->size; ++i) {
1137 ((float*)slots)[i] = fval;
1138 }
1139 break;
1140 case obj_double :
1141 err = slotDoubleVal(b, &fval);
1142 if (err) return err;
1143 for (i=0; i<array->size; ++i) {
1144 ((double*)slots)[i] = fval;
1145 }
1146 break;
1147 }
1148 return errNone;
1149 }
1150
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
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) || aobj->IsImmutable()) {
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 {
1294 PyrSlot *a, *b;
1295 PyrObject *obj, *aobj;
1296 int numbytes, elemsize, format;
1297
1298 a = g->sp - 1;
1299 b = g->sp;
1300
1301 if (NotInt(b)) return errWrongType;
1302 if (slotRawInt(b) <= 0) return errNone;
1303 aobj = slotRawObject(a);
1304
1305 if (aobj->size + slotRawInt(b) <= MAXINDEXSIZE(aobj)) return errNone;
1306
1307 format = aobj->obj_format;
1308 elemsize = gFormatElemSize[format];
1309 numbytes = ((aobj->size + slotRawInt(b)) * elemsize);
1310
1311 obj = g->gc->New(numbytes, 0, format, true);
1312 obj->classptr = aobj->classptr;
1313 obj->size = aobj->size;
1314 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1315 SetRaw(a, obj);
1316
1317 return errNone;
1318 }
1319
1320 int prArrayGrowClear(struct VMGlobals *g, int numArgsPushed)
1321 {
1322 PyrSlot *a, *b;
1323 PyrObject *obj, *aobj;
1324 int numbytes, elemsize, format;
1325
1326 a = g->sp - 1;
1327 b = g->sp;
1328
1329 if (NotInt(b)) return errWrongType;
1330 if (slotRawInt(b) <= 0) return errNone;
1331 aobj = slotRawObject(a);
1332
1333 if (aobj->size + slotRawInt(b) <= MAXINDEXSIZE(aobj) && aobj->IsMutable()) {
1334 obj = aobj;
1335 } else {
1336 format = aobj->obj_format;
1337 elemsize = gFormatElemSize[format];
1338 numbytes = ((aobj->size + slotRawInt(b)) * elemsize);
1339
1340 obj = g->gc->New(numbytes, 0, format, true);
1341 obj->classptr = aobj->classptr;
1342 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1343 }
1344
1345 if (obj->obj_format == obj_slot) {
1346 nilSlots(obj->slots + aobj->size, slotRawInt(b));
1347 } else {
1348 memset((char*)(obj->slots) + aobj->size * gFormatElemSize[format],
1349 0, slotRawInt(b) * gFormatElemSize[format]);
1350 }
1351 obj->size = aobj->size + slotRawInt(b);
1352 SetRaw(a, obj);
1353
1354 return errNone;
1355 }
1356
1357 int prArrayCat(struct VMGlobals *g, int numArgsPushed)
1358 {
1359 PyrSlot *a, *b;
1360 PyrObject *obj, *aobj, *bobj;
1361 int elemsize, size;
1362 int numbytes, format;
1363
1364 a = g->sp - 1;
1365 b = g->sp;
1366
1367 if (NotObj(b) || slotRawObject(a)->classptr != slotRawObject(b)->classptr) return errWrongType;
1368 aobj = slotRawObject(a);
1369 bobj = slotRawObject(b);
1370 size = aobj->size + bobj->size;
1371 format = aobj->obj_format;
1372 assert(aobj->obj_format == bobj->obj_format);
1373 elemsize = gFormatElemSize[format];
1374 numbytes = (size * elemsize);
1375
1376 obj = g->gc->New(numbytes, 0, format, true);
1377 obj->classptr = aobj->classptr;
1378 obj->size = size;
1379 memcpy(obj->slots, aobj->slots, aobj->size * elemsize);
1380 memcpy((char*)obj->slots + aobj->size * elemsize,
1381 bobj->slots, bobj->size * elemsize);
1382 SetObject(a, obj);
1383
1384 return errNone;
1385 }
1386
1387
1388 int prArrayAddAll(struct VMGlobals *g, int numArgsPushed)
1389 {
1390 PyrSlot *a, *b;
1391 PyrObject *obj, *aobj;
1392 int elemsize, newindexedsize, newsizebytes, asize, bsize;
1393 int format;
1394
1395 a = g->sp - 1;
1396 b = g->sp;
1397
1398 if (NotObj(b) || slotRawObject(a)->classptr != slotRawObject(b)->classptr) return errWrongType;
1399 aobj = slotRawObject(a);
1400
1401 format = aobj->obj_format;
1402 elemsize = gFormatElemSize[format];
1403 asize = aobj->size;
1404 bsize = slotRawObject(b)->size;
1405 newindexedsize = asize + bsize;
1406 newsizebytes = newindexedsize * elemsize;
1407
1408 if (newindexedsize > MAXINDEXSIZE(aobj) || aobj->IsImmutable()) {
1409 obj = g->gc->New(newsizebytes, 0, format, true);
1410 obj->classptr = aobj->classptr;
1411 memcpy(obj->slots, aobj->slots, asize * elemsize);
1412 SetObject(a, obj);
1413 } else {
1414 obj = aobj;
1415 if (format == obj_slot && !g->gc->ObjIsGrey(obj))
1416 g->gc->ToGrey(obj);
1417 }
1418 obj->size = newindexedsize;
1419 memcpy((char*)obj->slots + asize * elemsize, slotRawObject(b)->slots, bsize * elemsize);
1420 return errNone;
1421 }
1422
1423
1424 int prArrayOverwrite(struct VMGlobals *g, int numArgsPushed)
1425 {
1426 PyrSlot *a, *b, *c;
1427 PyrObject *obj, *aobj;
1428 int err, elemsize, newindexedsize, newsizebytes, pos, asize, bsize;
1429 int format;
1430
1431 a = g->sp - 2;
1432 b = g->sp - 1;
1433 c = g->sp; // pos
1434
1435 if (NotObj(b) || slotRawObject(a)->classptr != slotRawObject(b)->classptr) return errWrongType;
1436 err = slotIntVal(c, &pos);
1437 if (err) return errWrongType;
1438 if (pos < 0 || pos > slotRawObject(a)->size) return errIndexOutOfRange;
1439
1440 aobj = slotRawObject(a);
1441 format = aobj->obj_format;
1442 elemsize = gFormatElemSize[format];
1443 asize = aobj->size;
1444 bsize = slotRawObject(b)->size;
1445 newindexedsize = pos + bsize;
1446 newindexedsize = sc_max(asize, newindexedsize);
1447 newsizebytes = newindexedsize * elemsize;
1448
1449 if (newindexedsize > MAXINDEXSIZE(aobj) || aobj->IsImmutable()) {
1450 obj = g->gc->New(newsizebytes, 0, format, true);
1451 obj->classptr = aobj->classptr;
1452 memcpy(obj->slots, aobj->slots, asize * elemsize);
1453 SetObject(a, obj);
1454 } else {
1455 obj = aobj;
1456 if (format == obj_slot && !g->gc->ObjIsGrey(obj))
1457 g->gc->ToGrey(obj);
1458
1459 }
1460 obj->size = newindexedsize;
1461 memcpy((char*)(obj->slots) + pos * elemsize, slotRawObject(b)->slots, bsize * elemsize);
1462
1463 return errNone;
1464 }
1465
1466 int prArrayReverse(struct VMGlobals *g, int numArgsPushed)
1467 {
1468 PyrSlot *a, *slots1, *slots2;
1469 PyrObject *obj1, *obj2;
1470 int i, j, size;
1471
1472 a = g->sp;
1473 obj1 = slotRawObject(a);
1474 size = obj1->size;
1475 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1476 slots1 = obj1->slots;
1477 slots2 = obj2->slots;
1478 for (i=0, j=size-1; i<size; ++i,--j) {
1479 slotCopy(&slots2[j],&slots1[i]);
1480 }
1481 obj2->size = size;
1482 SetRaw(a, obj2);
1483 return errNone;
1484 }
1485
1486 int prArrayScramble(struct VMGlobals *g, int numArgsPushed)
1487 {
1488 PyrSlot *a, *slots1, *slots2, temp;
1489 PyrObject *obj1, *obj2;
1490 int i, j, k, m, size;
1491
1492 a = g->sp;
1493 obj1 = slotRawObject(a);
1494 size = obj1->size;
1495 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1496 slots1 = obj1->slots;
1497 slots2 = obj2->slots;
1498 memcpy(slots2, slots1, size * sizeof(PyrSlot));
1499 if (size > 1) {
1500 k = size;
1501 for (i=0, m=k; i<k-1; ++i, --m) {
1502 j = i + g->rgen->irand(m);
1503 slotCopy(&temp,&slots2[i]);
1504 slotCopy(&slots2[i],&slots2[j]);
1505 slotCopy(&slots2[j],&temp);
1506 }
1507 }
1508 obj2->size = size;
1509 SetRaw(a, obj2);
1510 return errNone;
1511 }
1512
1513 int prArrayRotate(struct VMGlobals *g, int numArgsPushed)
1514 {
1515 PyrSlot *a, *b, *slots;
1516 PyrObject *obj1, *obj2;
1517 int i, j, n, size;
1518
1519 a = g->sp - 1;
1520 b = g->sp;
1521 if (NotInt(b)) return errWrongType;
1522
1523 obj1 = slotRawObject(a);
1524 size = obj1->size;
1525 n = sc_mod((int)slotRawInt(b), (int)size);
1526 slots = obj1->slots;
1527 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1528 for (i=0, j=n; i<size; ++i) {
1529 slotCopy(&obj2->slots[j],&slots[i]);
1530 if (++j >= size) j=0;
1531 }
1532 obj2->size = size;
1533 SetRaw(a, obj2);
1534 return errNone;
1535 }
1536
1537 int prArrayStutter(struct VMGlobals *g, int numArgsPushed)
1538 {
1539 PyrSlot *a, *b, *slots1, *slots2;
1540 PyrObject *obj1, *obj2;
1541 int i, j, k, m, n, size;
1542
1543 a = g->sp - 1;
1544 b = g->sp;
1545 if (NotInt(b)) return errWrongType;
1546
1547 obj1 = slotRawObject(a);
1548 n = slotRawInt(b);
1549 m = obj1->size;
1550 size = m * n;
1551 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1552 slots1 = obj1->slots;
1553 slots2 = obj2->slots;
1554 for (i=0,j=0; i<m; ++i) {
1555 for (k=0; k<n; ++k,++j) {
1556 slotCopy(&slots2[j],&slots1[i]);
1557 }
1558 }
1559 obj2->size = size;
1560 SetRaw(a, obj2);
1561 return errNone;
1562 }
1563
1564 int prArrayMirror(struct VMGlobals *g, int numArgsPushed)
1565 {
1566 PyrSlot *a, *slots;
1567 PyrObject *obj1, *obj2;
1568 int i, j, k, size;
1569
1570 a = g->sp;
1571
1572 obj1 = slotRawObject(a);
1573 slots = obj1->slots;
1574 size = obj1->size * 2 - 1;
1575 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1576 obj2->size = size;
1577 // copy first part of list
1578 memcpy(obj2->slots, slots, obj1->size * sizeof(PyrSlot));
1579 // copy second part
1580 k = size/2;
1581 for (i=0, j=size-1; i<k; ++i,--j) {
1582 slotCopy(&obj2->slots[j],&slots[i]);
1583 }
1584 SetRaw(a, obj2);
1585 return errNone;
1586 }
1587
1588 int prArrayMirror1(struct VMGlobals *g, int numArgsPushed)
1589 {
1590 PyrSlot *a, *slots;
1591 PyrObject *obj1, *obj2;
1592 int i, j, k, size;
1593
1594 a = g->sp;
1595
1596 obj1 = slotRawObject(a);
1597 slots = obj1->slots;
1598 size = obj1->size * 2 - 2;
1599 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1600 obj2->size = size;
1601 // copy first part of list
1602 memcpy(obj2->slots, slots, obj1->size * sizeof(PyrSlot));
1603 // copy second part
1604 k = size/2;
1605 for (i=1, j=size-1; i<k; ++i,--j) {
1606 slotCopy(&obj2->slots[j],&slots[i]);
1607 }
1608 SetRaw(a, obj2);
1609 return errNone;
1610 }
1611
1612 int prArrayMirror2(struct VMGlobals *g, int numArgsPushed)
1613 {
1614 PyrSlot *a, *slots;
1615 PyrObject *obj1, *obj2;
1616 int i, j, k, size;
1617
1618 a = g->sp;
1619
1620 obj1 = slotRawObject(a);
1621 slots = obj1->slots;
1622 size = obj1->size * 2;
1623 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1624 obj2->size = size;
1625 // copy first part of list
1626 memcpy(obj2->slots, slots, obj1->size * sizeof(PyrSlot));
1627 // copy second part
1628 k = size/2;
1629 for (i=0, j=size-1; i<k; ++i,--j) {
1630 slotCopy(&obj2->slots[j],&slots[i]);
1631 }
1632 SetRaw(a, obj2);
1633 return errNone;
1634 }
1635
1636
1637 int prArrayExtendWrap(struct VMGlobals *g, int numArgsPushed)
1638 {
1639 PyrSlot *a, *b, *slots;
1640 PyrObject *obj1, *obj2;
1641 int i, j, m, size;
1642
1643 a = g->sp - 1;
1644 b = g->sp;
1645 if (NotInt(b)) return errWrongType;
1646
1647 size = slotRawInt(b);
1648 if (size < 0)
1649 return errFailed;
1650
1651 obj1 = slotRawObject(a);
1652
1653 if(obj1->size > 0) {
1654 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1655 obj2->size = size;
1656 slots = obj2->slots;
1657 // copy first part of list
1658 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1659 if (size > obj1->size) {
1660 // copy second part
1661 m = obj1->size;
1662 for (i=0,j=m; j<size; ++i,++j) {
1663 slotCopy(&slots[j],&slots[i]);
1664 }
1665 }
1666 } else {
1667 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1668 }
1669 SetRaw(a, obj2);
1670 return errNone;
1671 }
1672
1673 int prArrayExtendFold(struct VMGlobals *g, int numArgsPushed)
1674 {
1675 PyrSlot *a, *b, *slots;
1676 PyrObject *obj1, *obj2;
1677 int i, j, m, size;
1678
1679 a = g->sp - 1;
1680 b = g->sp;
1681 if (NotInt(b)) return errWrongType;
1682
1683 size = slotRawInt(b);
1684 if (size < 0)
1685 return errFailed;
1686
1687 obj1 = slotRawObject(a);
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 size = slotRawInt(b);
1719 if (size < 0)
1720 return errFailed;
1721
1722 obj1 = slotRawObject(a);
1723 if(obj1->size > 0) {
1724 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1725 obj2->size = size;
1726 slots = obj2->slots;
1727 // copy first part of list
1728 memcpy(slots, obj1->slots, sc_min(size, obj1->size) * sizeof(PyrSlot));
1729 if (size > obj1->size) {
1730 // copy second part
1731 m = obj1->size;
1732 slotCopy(&last,&slots[m-1]);
1733 for (i=0,j=m; j<size; ++i,++j)
1734 slotCopy(&slots[j],&last);
1735
1736 }
1737 } else {
1738 obj2 = instantiateObject(g->gc, obj1->classptr, size, true, true);
1739 }
1740 SetRaw(a, obj2);
1741 return errNone;
1742 }
1743
1744 int prArrayPermute(struct VMGlobals *g, int numArgsPushed)
1745 {
1746 PyrSlot *a, *b, *slots1, *slots2, temp;
1747 PyrObject *obj1, *obj2;
1748 int i, j, m, z, size;
1749
1750 a = g->sp - 1;
1751 b = g->sp;
1752 if (NotInt(b)) return errWrongType;
1753
1754 obj1 = slotRawObject(a);
1755 size = obj1->size;
1756 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
1757 obj2->size = size;
1758 slots1 = obj1->slots;
1759 slots2 = obj2->slots;
1760 memcpy(slots2, slots1, size * sizeof(PyrSlot));
1761 z = slotRawInt(b);
1762 for (i=0, m=size; i<size-1; ++i, --m) {
1763 j = i + sc_mod((int)z, (int)(size-i));
1764 z = sc_div(z,size-i);
1765 slotCopy(&temp,&slots2[i]);
1766 slotCopy(&slots2[i],&slots2[j]);
1767 slotCopy(&slots2[j],&temp);
1768 }
1769 SetRaw(a, obj2);
1770 return errNone;
1771 }
1772
1773
1774 int prArrayAllTuples(struct VMGlobals *g, int numArgsPushed)
1775 {
1776 PyrSlot *a, *b, *slots1, *slots2, *slots3;
1777 PyrObject *obj1, *obj2, *obj3;
1778
1779 a = g->sp - 1;
1780 b = g->sp;
1781 if (NotInt(b)) return errWrongType;
1782 int maxSize = slotRawInt(b);
1783
1784 obj1 = slotRawObject(a);
1785 slots1 = obj1->slots;
1786 int newSize = 1;
1787 int tupSize = obj1->size;
1788 for (int i=0; i < tupSize; ++i) {
1789 if (isKindOfSlot(slots1+i, class_array)) {
1790 newSize *= slotRawObject(&slots1[i])->size;
1791 }
1792 }
1793 if (newSize > maxSize) newSize = maxSize;
1794
1795 obj2 = instantiateObject(g->gc, obj1->classptr, newSize, false, true);
1796 slots2 = obj2->slots;
1797 SetObject(b, obj2); // store reference on stack, so both source and destination objects can be reached by the gc
1798
1799 for (int i=0; i < newSize; ++i) {
1800 int k = i;
1801 obj3 = instantiateObject(g->gc, obj1->classptr, tupSize, false, true);
1802 slots3 = obj3->slots;
1803 for (int j=tupSize-1; j >= 0; --j) {
1804 if (isKindOfSlot(slots1+j, class_array)) {
1805 PyrObject *obj4 = slotRawObject(&slots1[j]);
1806 slotCopy(&slots3[j], &obj4->slots[k % obj4->size]);
1807 g->gc->GCWrite(obj3, obj4);
1808 k /= obj4->size;
1809 } else {
1810 slotCopy(&slots3[j], &slots1[j]);
1811 }
1812 }
1813 obj3->size = tupSize;
1814 SetObject(obj2->slots+i, obj3);
1815 g->gc->GCWriteNew(obj2, obj3);
1816 obj2->size++;
1817 }
1818 SetRaw(a, obj2);
1819 return errNone;
1820 }
1821
1822 int prArrayPyramid(struct VMGlobals *g, int numArgsPushed)
1823 {
1824 PyrSlot *a, *b, *slots;
1825 PyrObject *obj1, *obj2;
1826 int i, j, k, n, m, numslots, x;
1827
1828 a = g->sp - 1;
1829 b = g->sp;
1830 if (NotInt(b)) return errWrongType;
1831
1832 obj1 = slotRawObject(a);
1833 slots = obj1->slots;
1834 m = sc_clip(slotRawInt(b), 1, 10);
1835 x = numslots = obj1->size;
1836 switch (m) {
1837 case 1 :
1838 n = (x*x + x)/2;
1839 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1840 for (i=0,k=0; i<numslots; ++i) {
1841 for (j=0; j<=i; ++j, ++k) {
1842 slotCopy(&obj2->slots[k],&slots[j]);
1843 }
1844 }
1845 obj2->size = k;
1846 break;
1847 case 2 :
1848 n = (x*x + x)/2;
1849 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1850 for (i=0,k=0; i<numslots; ++i) {
1851 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1852 slotCopy(&obj2->slots[k],&slots[j]);
1853 }
1854 }
1855 obj2->size = k;
1856 break;
1857 case 3 :
1858 n = (x*x + x)/2;
1859 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1860 for (i=0,k=0; i<numslots; ++i) {
1861 for (j=0; j<=numslots-1-i; ++j, ++k) {
1862 slotCopy(&obj2->slots[k],&slots[j]);
1863 }
1864 }
1865 obj2->size = k;
1866 break;
1867 case 4 :
1868 n = (x*x + x)/2;
1869 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1870 for (i=0,k=0; i<numslots; ++i) {
1871 for (j=i; j<=numslots-1; ++j, ++k) {
1872 slotCopy(&obj2->slots[k],&slots[j]);
1873 }
1874 }
1875 obj2->size = k;
1876 break;
1877 case 5 :
1878 n = x*x;
1879 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1880 for (i=0,k=0; i<numslots; ++i) {
1881 for (j=0; j<=i; ++j, ++k) {
1882 slotCopy(&obj2->slots[k],&slots[j]);
1883 }
1884 }
1885 for (i=0; i<numslots-1; ++i) {
1886 for (j=0; j<=numslots-2-i; ++j, ++k) {
1887 slotCopy(&obj2->slots[k],&slots[j]);
1888 }
1889 }
1890 obj2->size = k;
1891 break;
1892 case 6 :
1893 n = x*x;
1894 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1895 for (i=0,k=0; i<numslots; ++i) {
1896 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1897 slotCopy(&obj2->slots[k],&slots[j]);
1898 }
1899 }
1900 for (i=0; i<numslots-1; ++i) {
1901 for (j=i+1; j<=numslots-1; ++j, ++k) {
1902 slotCopy(&obj2->slots[k],&slots[j]);
1903 }
1904 }
1905 obj2->size = k;
1906 break;
1907 case 7 :
1908 n = x*x + x - 1;
1909 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1910 for (i=0,k=0; i<numslots; ++i) {
1911 for (j=0; j<=numslots-1-i; ++j, ++k) {
1912 slotCopy(&obj2->slots[k],&slots[j]);
1913 }
1914 }
1915 for (i=1; i<numslots; ++i) {
1916 for (j=0; j<=i; ++j, ++k) {
1917 slotCopy(&obj2->slots[k],&slots[j]);
1918 }
1919 }
1920 obj2->size = k;
1921 break;
1922 case 8 :
1923 n = x*x + x - 1;
1924 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1925 for (i=0,k=0; i<numslots; ++i) {
1926 for (j=i; j<=numslots-1; ++j, ++k) {
1927 slotCopy(&obj2->slots[k],&slots[j]);
1928 }
1929 }
1930 for (i=1; i<numslots; ++i) {
1931 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1932 slotCopy(&obj2->slots[k],&slots[j]);
1933 }
1934 }
1935 obj2->size = k;
1936 break;
1937 case 9 :
1938 n = x*x;
1939 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1940 for (i=0,k=0; i<numslots; ++i) {
1941 for (j=0; j<=i; ++j, ++k) {
1942 slotCopy(&obj2->slots[k],&slots[j]);
1943 }
1944 }
1945 for (i=0; i<numslots-1; ++i) {
1946 for (j=i+1; j<=numslots-1; ++j, ++k) {
1947 slotCopy(&obj2->slots[k],&slots[j]);
1948 }
1949 }
1950 obj2->size = k;
1951 break;
1952 case 10 :
1953 n = x*x;
1954 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
1955 for (i=0,k=0; i<numslots; ++i) {
1956 for (j=numslots-1-i; j<=numslots-1; ++j, ++k) {
1957 slotCopy(&obj2->slots[k],&slots[j]);
1958 }
1959 }
1960 for (i=0; i<numslots-1; ++i) {
1961 for (j=0; j<=numslots-2-i; ++j, ++k) {
1962 slotCopy(&obj2->slots[k],&slots[j]);
1963 }
1964 }
1965 obj2->size = k;
1966 break;
1967 }
1968 SetRaw(a, obj2);
1969 return errNone;
1970 }
1971
1972 int prArraySlide(struct VMGlobals *g, int numArgsPushed)
1973 {
1974 PyrSlot *a, *b, *c, *slots;
1975 PyrObject *obj1, *obj2;
1976 int h, i, j, k, n, m, numslots, numwin;
1977
1978 a = g->sp - 2;
1979 b = g->sp - 1;
1980 c = g->sp;
1981 if (NotInt(b)) return errWrongType;
1982 if (NotInt(c)) return errWrongType;
1983
1984 obj1 = slotRawObject(a);
1985 slots = obj1->slots;
1986 m = slotRawInt(b);
1987 n = slotRawInt(c);
1988 numwin = (obj1->size + n - m) / n;
1989 numslots = numwin * m;
1990 obj2 = instantiateObject(g->gc, obj1->classptr, numslots, false, true);
1991 for (i=h=k=0; i<numwin; ++i,h+=n) {
1992 for (j=h; j<m+h; ++j) {
1993 slotCopy(&obj2->slots[k++],&slots[j]);
1994 }
1995 }
1996 obj2->size = k;
1997 SetRaw(a, obj2);
1998 return errNone;
1999 }
2000
2001 int prArrayLace(struct VMGlobals *g, int numArgsPushed)
2002 {
2003 PyrSlot *a, *b, *slots, *slot;
2004 PyrObject *obj1, *obj2, *obj3;
2005 int i, j, k, n, m, numLists, len;
2006
2007 a = g->sp - 1;
2008 b = g->sp;
2009 obj1 = slotRawObject(a);
2010 slots = obj1->slots;
2011 numLists = obj1->size;
2012
2013 if(IsNil(b)) {
2014 for (j=0; j<numLists; ++j) {
2015 slot = slots + j;
2016 if(isKindOfSlot(slot, class_array)) {
2017 len = slotRawObject(slot)->size;
2018 if(j==0 || n>len) { n = len; }
2019 } else {
2020 return errFailed; // this primitive only handles Arrays.
2021 }
2022 }
2023 n = n * numLists;
2024
2025 } else if (IsInt(b)) {
2026 n = slotRawInt(b);
2027 } else {
2028 return errWrongType;
2029 }
2030
2031
2032 n = sc_max(1, n);
2033 if(obj1->size > 0) {
2034 obj2 = instantiateObject(g->gc, obj1->classptr, n, false, true);
2035 for (i=j=k=0; i<n; ++i) {
2036 if (IsObj(&slots[k])) {
2037 obj3 = slotRawObject(&slots[k]);
2038 if (isKindOf(obj3, class_list)) {
2039 obj3 = slotRawObject(&obj3->slots[0]); // get the list's array
2040 }
2041 if (obj3 && isKindOf(obj3, class_array)) {
2042 m = j % obj3->size;
2043 slotCopy(&obj2->slots[i],&obj3->slots[m]);
2044 } else {
2045 slotCopy(&obj2->slots[i],&slots[k]);
2046 }
2047 } else {
2048 slotCopy(&obj2->slots[i],&slots[k]);
2049 }
2050 k = (k+1) % obj1->size;
2051 if (k == 0) j++;
2052 }
2053 } else {
2054 obj2 = instantiateObject(g->gc, obj1->classptr, n, true, true);
2055 }
2056 obj2->size = n;
2057 SetRaw(a, obj2);
2058 return errNone;
2059 }
2060
2061 int prArrayContainsSeqColl(struct VMGlobals *g, int numArgsPushed)
2062 {
2063 PyrSlot *a, *slot, *endptr;
2064 PyrObject *obj;
2065 int size;
2066
2067 a = g->sp;
2068 obj = slotRawObject(a);
2069 size = obj->size;
2070 slot = obj->slots - 1;
2071 endptr = slot + size;
2072 while (slot < endptr) {
2073 ++slot;
2074 if (IsObj(slot)) {
2075 if (isKindOf(slotRawObject(slot), class_sequenceable_collection)) {
2076 SetTrue(a);
2077 return errNone;
2078 }
2079 }
2080 }
2081 SetFalse(a);
2082 return errNone;
2083 }
2084
2085 int prArrayNormalizeSum(struct VMGlobals *g, int numArgsPushed)
2086 {
2087 PyrSlot *a, *slots2;
2088 PyrObject *obj1, *obj2;
2089 int i, size, err;
2090 double w, sum, rsum;
2091
2092 a = g->sp;
2093 obj1 = slotRawObject(a);
2094 size = obj1->size;
2095 obj2 = instantiateObject(g->gc, obj1->classptr, size, false, true);
2096 slots2 = obj2->slots;
2097 sum = 0.0;
2098 for (i=0; i<size; ++i) {
2099 err = getIndexedDouble(obj1, i, &w);
2100 if (err) return err;
2101 sum += w;
2102 SetFloat(&slots2[i], w);
2103 }
2104 rsum = 1./sum;
2105 for (i=0; i<size; ++i) {
2106 double d = slotRawFloat(&slots2[i]);
2107 SetRaw(&slots2[i], d * rsum);
2108 }
2109 obj2->size = size;
2110 SetRaw(a, obj2);
2111 return errNone;
2112 }
2113
2114
2115
2116
2117 int prArrayWIndex(struct VMGlobals *g, int numArgsPushed)
2118 {
2119 PyrSlot *a, *slots;
2120 PyrObject *obj;
2121 int i, j, size, err;
2122 double r, w, sum;
2123
2124 a = g->sp;
2125
2126 sum = 0.0;
2127 r = g->rgen->frand();
2128 obj = slotRawObject(a);
2129 size = obj->size;
2130 j = size - 1;
2131 slots = obj->slots;
2132 for (i=0; i<size; ++i) {
2133 err = getIndexedDouble(obj, i, &w);
2134 if (err) return err;
2135 sum += w;
2136 if (sum >= r) {
2137 j = i;
2138 break;
2139 }
2140 }
2141 SetInt(a, j);
2142 return errNone;
2143 }
2144
2145
2146 enum {
2147 shape_Step,
2148 shape_Linear,
2149 shape_Exponential,
2150 shape_Sine,
2151 shape_Welch,
2152 shape_Curve,
2153 shape_Squared,
2154 shape_Cubed
2155 };
2156
2157 enum {
2158 kEnv_initLevel,
2159 kEnv_numStages,
2160 kEnv_releaseNode,
2161 kEnv_loopNode
2162 };
2163
2164 int prArrayEnvAt(struct VMGlobals *g, int numArgsPushed)
2165 {
2166 PyrSlot *a = g->sp - 1;
2167 PyrSlot *b = g->sp;
2168
2169 PyrObject* env = slotRawObject(a);
2170 PyrSlot* slots = env->slots;
2171
2172 // Env:asArray always gives at least 8 array elements
2173 if(env->size < 8) return errFailed;
2174
2175 double time;
2176 int err = slotDoubleVal(b, &time);
2177 if (err) return err;
2178
2179 double begLevel;
2180 err = slotDoubleVal(slots + kEnv_initLevel, &begLevel);
2181 if (err) return err;
2182
2183 int numStages;
2184 err = slotIntVal(slots + kEnv_numStages, &numStages);
2185 if (err) return err;
2186
2187 double begTime = 0.;
2188 double endTime = 0.;
2189
2190 for (int i=0; i<numStages; ++i) {
2191 double dur, endLevel;
2192
2193 slots += 4;
2194
2195 err = slotDoubleVal(slots + 0, &endLevel);
2196 if (err) return err;
2197 err = slotDoubleVal(slots + 1, &dur);
2198 if (err) return err;
2199
2200 endTime += dur;
2201
2202 //post("%d %g %g %g %g %g\n", i, time, begTime, endTime, dur, endLevel);
2203
2204 if (time < endTime) {
2205 int shape;
2206 double curve;
2207
2208 err = slotIntVal(slots + 2, &shape);
2209 if (err) return err;
2210
2211 double level;
2212 double pos = (time - begTime) / dur;
2213
2214 //post(" shape %d pos %g\n", shape, pos);
2215 switch (shape)
2216 {
2217 case shape_Step :
2218 level = endLevel;
2219 break;
2220 case shape_Linear :
2221 default:
2222 level = pos * (endLevel - begLevel) + begLevel;
2223 break;
2224 case shape_Exponential :
2225 level = begLevel * pow(endLevel / begLevel, pos);
2226 break;
2227 case shape_Sine :
2228 level = begLevel + (endLevel - begLevel) * (-cos(pi * pos) * 0.5 + 0.5);
2229 break;
2230 case shape_Welch :
2231 {
2232 if (begLevel < endLevel)
2233 level = begLevel + (endLevel - begLevel) * sin(pi2 * pos);
2234 else
2235 level = endLevel - (endLevel - begLevel) * sin(pi2 - pi2 * pos);
2236 break;
2237 }
2238 case shape_Curve :
2239 err = slotDoubleVal(slots + 3, &curve);
2240 if (err) return err;
2241
2242 if (fabs(curve) < 0.0001) {
2243 level = pos * (endLevel - begLevel) + begLevel;
2244 } else {
2245 double denom = 1. - exp(curve);
2246 double numer = 1. - exp(pos * curve);
2247 level = begLevel + (endLevel - begLevel) * (numer/denom);
2248 }
2249 break;
2250 case shape_Squared :
2251 {
2252 double sqrtBegLevel = sqrt(begLevel);
2253 double sqrtEndLevel = sqrt(endLevel);
2254 double sqrtLevel = pos * (sqrtEndLevel - sqrtBegLevel) + sqrtBegLevel;
2255 level = sqrtLevel * sqrtLevel;
2256 break;
2257 }
2258 case shape_Cubed :
2259 {
2260 double cbrtBegLevel = pow(begLevel, 0.3333333);
2261 double cbrtEndLevel = pow(endLevel, 0.3333333);
2262 double cbrtLevel = pos * (cbrtEndLevel - cbrtBegLevel) + cbrtBegLevel;
2263 level = cbrtLevel * cbrtLevel * cbrtLevel;
2264 break;
2265 }
2266 }
2267 SetFloat(a, level);
2268 return errNone;
2269 }
2270
2271 begTime = endTime;
2272 begLevel = endLevel;
2273 }
2274
2275 SetFloat(a, begLevel);
2276
2277 return errNone;
2278 }
2279
2280
2281 int prArrayIndexOfGreaterThan(struct VMGlobals *g, int numArgsPushed)
2282 {
2283 PyrSlot *a, *b, *slots;
2284 PyrObject *obj;
2285 int i, size, err;
2286 double s, w;
2287
2288 a = g->sp - 1;
2289 b = g->sp;
2290
2291 obj = slotRawObject(a);
2292
2293 size = obj->size;
2294 slots = obj->slots;
2295
2296 err = slotDoubleVal(b, &s);
2297 if (err) return err;
2298
2299 for (i=0; i<size; ++i) {
2300 err = getIndexedDouble(obj, i, &w);
2301 if (err) return err;
2302
2303 if (w > s) {
2304 SetInt(a, i);
2305 return errNone;
2306 }
2307 }
2308
2309 SetNil(a);
2310 return errNone;
2311 }
2312
2313
2314
2315 int prArrayUnlace(struct VMGlobals *g, int numArgsPushed)
2316 {
2317 PyrSlot *a, *b, *c, *slots, *slots2, *slots3;
2318 PyrObject *obj1, *obj2, *obj3;
2319 int i, j, k, clump, numLists, size, size3, err;
2320
2321 a = g->sp - 2;
2322 b = g->sp - 1;
2323 c = g->sp;
2324
2325 obj1 = slotRawObject(a);
2326 slots = obj1->slots;
2327 size = obj1->size;
2328
2329 err = slotIntVal(b, &numLists);
2330 if (err) return err;
2331
2332 err = slotIntVal(c, &clump);
2333 if (err) return err;
2334
2335 obj2 = instantiateObject(g->gc, obj1->classptr, numLists, false, true);
2336 obj2->size = numLists;
2337 slots2 = obj2->slots;
2338
2339 SetObject(b, obj2); // store reference on stack, so both source and destination objects can be reached by the gc
2340
2341 size3 = size / numLists;
2342 size3 = size3 - (size3 % clump);
2343 if(size3 < 1) return errFailed;
2344
2345 for(i=0; i<numLists; ++i) {
2346 obj3 = instantiateObject(g->gc, obj1->classptr, size3, false, true);
2347 obj3->size = size3;
2348 slots3 = obj3->slots;
2349 for(j=0; j<size3; j+=clump) {
2350 for(k=0; k<clump; ++k) {
2351 slotCopy(&slots3[j+k],&slots[i*clump + k + j*numLists]);
2352 }
2353 }
2354 SetObject(slots2 + i, obj3);
2355 }
2356
2357 SetRaw(a, obj2);
2358
2359 return errNone;
2360 }
2361
2362 void initArrayPrimitives()
2363 {
2364 int base, index;
2365
2366 base = nextPrimitiveIndex();
2367 index = 0;
2368
2369 definePrimitive(base, index++, "_BasicSize", basicSize, 1, 0);
2370 definePrimitive(base, index++, "_BasicMaxSize", basicMaxSize, 1, 0);
2371
2372 definePrimitive(base, index++, "_BasicSwap", basicSwap, 3, 0);
2373 definePrimitive(base, index++, "_BasicAt", basicAt, 2, 0);
2374 definePrimitive(base, index++, "_BasicRemoveAt", basicRemoveAt, 2, 0);
2375 definePrimitive(base, index++, "_BasicTakeAt", basicTakeAt, 2, 0);
2376 definePrimitive(base, index++, "_BasicClipAt", basicClipAt, 2, 0);
2377 definePrimitive(base, index++, "_BasicWrapAt", basicWrapAt, 2, 0);
2378 definePrimitive(base, index++, "_BasicFoldAt", basicFoldAt, 2, 0);
2379 definePrimitive(base, index++, "_BasicPut", basicPut, 3, 0);
2380 definePrimitive(base, index++, "_BasicClipPut", basicClipPut, 3, 0);
2381 definePrimitive(base, index++, "_BasicWrapPut", basicWrapPut, 3, 0);
2382 definePrimitive(base, index++, "_BasicFoldPut", basicFoldPut, 3, 0);
2383
2384 definePrimitive(base, index++, "_ArrayExtend", prArrayExtend, 3, 0);
2385 definePrimitive(base, index++, "_ArrayGrow", prArrayGrow, 2, 0);
2386 definePrimitive(base, index++, "_ArrayGrowClear", prArrayGrowClear, 2, 0);
2387 definePrimitive(base, index++, "_ArrayAdd", prArrayAdd, 2, 0);
2388 definePrimitive(base, index++, "_ArrayInsert", prArrayInsert, 3, 0);
2389 definePrimitive(base, index++, "_ArrayFill", prArrayFill, 2, 0);
2390 definePrimitive(base, index++, "_ArrayPop", prArrayPop, 1, 0);
2391 definePrimitive(base, index++, "_ArrayCat", prArrayCat, 2, 0);
2392 definePrimitive(base, index++, "_ArrayPutEach", prArrayPutEach, 3, 0);
2393 definePrimitive(base, index++, "_ArrayAddAll", prArrayAddAll, 2, 0);
2394 definePrimitive(base, index++, "_ArrayPutSeries", prArrayPutSeries, 5, 0);
2395 definePrimitive(base, index++, "_ArrayOverwrite", prArrayOverwrite, 3, 0);
2396 definePrimitive(base, index++, "_ArrayIndexOf", prArrayIndexOf, 2, 0);
2397
2398 definePrimitive(base, index++, "_ArrayNormalizeSum", prArrayNormalizeSum, 1, 0);
2399 definePrimitive(base, index++, "_ArrayWIndex", prArrayWIndex, 1, 0);
2400 definePrimitive(base, index++, "_ArrayReverse", prArrayReverse, 1, 0);
2401 definePrimitive(base, index++, "_ArrayScramble", prArrayScramble, 1, 0);
2402 definePrimitive(base, index++, "_ArrayMirror", prArrayMirror, 1, 0);
2403 definePrimitive(base, index++, "_ArrayMirror1", prArrayMirror1, 1, 0);
2404 definePrimitive(base, index++, "_ArrayMirror2", prArrayMirror2, 1, 0);
2405 definePrimitive(base, index++, "_ArrayRotate", prArrayRotate, 2, 0);
2406 definePrimitive(base, index++, "_ArrayPermute", prArrayPermute, 2, 0);
2407 definePrimitive(base, index++, "_ArrayAllTuples", prArrayAllTuples, 2, 0);
2408 definePrimitive(base, index++, "_ArrayPyramid", prArrayPyramid, 2, 0);
2409 definePrimitive(base, index++, "_ArrayRotate", prArrayRotate, 2, 0);
2410 definePrimitive(base, index++, "_ArrayExtendWrap", prArrayExtendWrap, 2, 0);
2411 definePrimitive(base, index++, "_ArrayExtendFold", prArrayExtendFold, 2, 0);
2412 definePrimitive(base, index++, "_ArrayExtendLast", prArrayExtendLast, 2, 0);
2413 definePrimitive(base, index++, "_ArrayLace", prArrayLace, 2, 0);
2414 definePrimitive(base, index++, "_ArrayStutter", prArrayStutter, 2, 0);
2415 definePrimitive(base, index++, "_ArraySlide", prArraySlide, 3, 0);
2416 definePrimitive(base, index++, "_ArrayContainsSeqColl", prArrayContainsSeqColl, 1, 0);
2417
2418 definePrimitive(base, index++, "_ArrayEnvAt", prArrayEnvAt, 2, 0);
2419 definePrimitive(base, index++, "_ArrayIndexOfGreaterThan", prArrayIndexOfGreaterThan, 2, 0);
2420 definePrimitive(base, index++, "_ArrayUnlace", prArrayUnlace, 3, 0);
2421
2422 }
2423
2424
2425 #if _SC_PLUGINS_
2426
2427 #include "SCPlugin.h"
2428
2429 #pragma export on
2430 extern "C" { SCPlugIn* loadPlugIn(void); }
2431 #pragma export off
2432
2433
2434 // define plug in object
2435 class APlugIn : public SCPlugIn
2436 {
2437 public:
2438 APlugIn();
2439 virtual ~APlugIn();
2440
2441 virtual void AboutToCompile();
2442 };
2443
2444 APlugIn::APlugIn()
2445 {
2446 // constructor for plug in
2447 }
2448
2449 APlugIn::~APlugIn()
2450 {
2451 // destructor for plug in
2452 }
2453
2454 void APlugIn::AboutToCompile()
2455 {
2456 // this is called each time the class library is compiled.
2457 initArrayPrimitives();
2458 }
2459
2460 // This function is called when the plug in is loaded into SC.
2461 // It returns an instance of APlugIn.
2462 SCPlugIn* loadPlugIn()
2463 {
2464 return new APlugIn();
2465 }
2466
2467 #endif
2468