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 #include "PyrKernel.h"
22 #include "PyrKernelProto.h"
23 #include "PyrPrimitive.h"
24 #include "PyrPrimitiveProto.h"
25 #include "PyrSymbol.h"
26 #include "PyrListPrim.h"
27 #include "SC_InlineUnaryOp.h"
28 #include "SC_InlineBinaryOp.h"
29 #include "PyrSignal.h"
30 #include "PyrMessage.h"
31 #include "PyrSched.h"
32 #include "SC_RGen.h"
33 #include "SCBase.h"
34 #include <stdlib.h>
35 #include <string.h>
36
37 int objectPerform(VMGlobals* g, int numArgsPushed);
38
39 int ivxIdentDict_array, ivxIdentDict_size, ivxIdentDict_parent, ivxIdentDict_proto, ivxIdentDict_know;
40
41 int class_array_index, class_array_maxsubclassindex;
42 int class_identdict_index, class_identdict_maxsubclassindex;
43
44 PyrClass* class_identdict;
45 PyrSymbol *s_proto, *s_parent;
46 PyrSymbol *s_delta, *s_dur, *s_stretch;
47
48 // used in prEvent_IsRest
49 PyrSymbol *s_type, *s_rest, *s_empty, *s_r, *s_isRest;
50 PyrClass *class_rest, *class_metarest;
51
52 #define HASHSYMBOL(sym) (sym >> 5)
53
54 #define ISKINDOF(obj, lo, hi) \
55 (objClassIndex = slotRawInt(&obj->classptr->classIndex), objClassIndex >= lo && objClassIndex <= hi)
56
57
prArrayMultiChanExpand(struct VMGlobals * g,int numArgsPushed)58 int prArrayMultiChanExpand(struct VMGlobals* g, int numArgsPushed) {
59 PyrSlot *a, *slot, *slots1, *slots2, *slots3, *slots4;
60 PyrObject *obj1, *obj2, *obj3, *obj4;
61 int i, j, size, len, maxlen;
62
63 a = g->sp;
64 obj1 = slotRawObject(a);
65 size = obj1->size;
66 slots1 = obj1->slots;
67 maxlen = 1;
68 for (j = 0; j < size; ++j) {
69 slot = slots1 + j;
70 if (IsObj(slot)) {
71 if (slotRawObject(slot)->classptr == class_array) {
72 len = slotRawObject(slot)->size;
73 maxlen = len > maxlen ? len : maxlen;
74 } else if (isKindOf(slotRawObject(slot), class_sequenceable_collection)
75 && (slotRawObject(slot)->classptr != class_string)) {
76 return errFailed; // this primitive only handles Arrays.
77 }
78 }
79 }
80
81 obj2 = newPyrArray(g->gc, maxlen, 0, true);
82 // push obj2 onto the stack so it's not collected
83 // we can't just set in a here as we still need obj1's slots below, so we need to ensure it isn't collected
84 ++g->sp; // advance the stack to avoid overwriting receiver
85 SetObject(g->sp, obj2);
86 slots2 = obj2->slots;
87 for (i = 0; i < maxlen; ++i) {
88 obj3 = newPyrArray(g->gc, size, 0, true);
89 obj3->size = size;
90 SetObject(slots2 + i, obj3);
91 g->gc->GCWriteNew(obj2, obj3); // we know obj3 is white so we can use GCWriteNew
92 obj2->size++;
93 slots1 = obj1->slots;
94 slots3 = obj3->slots;
95 for (j = 0; j < size; ++j) {
96 slot = slots1 + j;
97 if (IsObj(slot)) {
98 if (slotRawObject(slot)->classptr == class_array && slotRawObject(slot)->size > 0) {
99 PyrSlot* slotToCopy;
100 obj4 = slotRawObject(slot);
101 slots4 = obj4->slots;
102 slotToCopy = &slots4[i % obj4->size];
103 slotCopy(&slots3[j], slotToCopy);
104 g->gc->GCWrite(obj3, slotToCopy);
105 } else {
106 slotCopy(&slots3[j], slot);
107 g->gc->GCWrite(obj3, slot);
108 }
109 } else {
110 slotCopy(&slots3[j], slot); // we don't need GCWrite here, as slot is not an object
111 }
112 }
113 }
114
115 --g->sp; // pop the stack back to the receiver slot since we stored ojb2 there above
116 SetObject(a, obj2); // now we can set the result in a
117 return errNone;
118 }
119
120
arrayAtIdentityHash(PyrObject * array,PyrSlot * key)121 int arrayAtIdentityHash(PyrObject* array, PyrSlot* key) {
122 PyrSlot *slots, *test;
123 unsigned int i, start, end, hash, maxHash;
124
125 hash = calcHash(key);
126 maxHash = array->size;
127 start = hash % maxHash;
128 end = array->size;
129 slots = array->slots;
130 for (i = start; i < end; i++) {
131 test = slots + i;
132 if (IsNil(test) || SlotEq(test, key))
133 return i;
134 }
135 end = start - 1;
136 for (i = 0; i <= end; i++) {
137 test = slots + i;
138 if (IsNil(test) || SlotEq(test, key))
139 return i;
140 }
141 return -1;
142 }
143
144
145 int prArray_AtIdentityHash(struct VMGlobals* g, int numArgsPushed);
prArray_AtIdentityHash(struct VMGlobals * g,int numArgsPushed)146 int prArray_AtIdentityHash(struct VMGlobals* g, int numArgsPushed) {
147 PyrSlot *a, *b;
148 PyrObject* array;
149 int index;
150
151 a = g->sp - 1; // array
152 b = g->sp; // key
153
154 array = slotRawObject(a);
155 if (array->size == 0)
156 return errFailed;
157 index = arrayAtIdentityHash(array, b);
158 SetInt(a, index);
159 return errNone;
160 }
161
162
arrayAtIdentityHashInPairs(PyrObject * array,PyrSlot * key)163 int arrayAtIdentityHashInPairs(PyrObject* array, PyrSlot* key) {
164 PyrSlot *slots, *test;
165 unsigned int i, start, end, hash, maxHash;
166
167 hash = calcHash(key);
168 maxHash = array->size >> 1;
169 start = (hash % maxHash) << 1;
170 end = array->size;
171 slots = array->slots;
172 for (i = start; i < end; i += 2) {
173 test = slots + i;
174 if (IsNil(test) || SlotEq(test, key))
175 return i;
176 }
177 end = start - 2;
178 for (i = 0; i <= end; i += 2) {
179 test = slots + i;
180 if (IsNil(test) || SlotEq(test, key))
181 return i;
182 }
183 return -2;
184 }
185
186
arrayAtIdentityHashInPairsWithHash(PyrObject * array,PyrSlot * key,int hash)187 int arrayAtIdentityHashInPairsWithHash(PyrObject* array, PyrSlot* key, int hash) {
188 PyrSlot *slots, *test;
189 unsigned int i, start, end, maxHash;
190
191 maxHash = array->size >> 1;
192 start = (hash % maxHash) << 1;
193 end = array->size;
194 slots = array->slots;
195 for (i = start; i < end; i += 2) {
196 test = slots + i;
197 if (IsNil(test) || SlotEq(test, key))
198 return i;
199 }
200 end = start - 2;
201 for (i = 0; i <= end; i += 2) {
202 test = slots + i;
203 if (IsNil(test) || SlotEq(test, key))
204 return i;
205 }
206 return -2;
207 }
208
209
210 int identDictPut(struct VMGlobals* g, PyrObject* dict, PyrSlot* key, PyrSlot* value);
identDictPut(struct VMGlobals * g,PyrObject * dict,PyrSlot * key,PyrSlot * value)211 int identDictPut(struct VMGlobals* g, PyrObject* dict, PyrSlot* key, PyrSlot* value) {
212 PyrSlot *slot, *newslot;
213 int i, index, size;
214 PyrObject* array;
215
216 bool knows = IsTrue(dict->slots + ivxIdentDict_know);
217 if (knows && IsSym(key)) {
218 if (slotRawSymbol(key) == s_parent) {
219 slotCopy(&dict->slots[ivxIdentDict_parent], value);
220 g->gc->GCWrite(dict, value);
221 return errNone;
222 }
223 if (slotRawSymbol(key) == s_proto) {
224 slotCopy(&dict->slots[ivxIdentDict_proto], value);
225 g->gc->GCWrite(dict, value);
226 return errNone;
227 }
228 }
229 array = slotRawObject(&dict->slots[ivxIdentDict_array]);
230 if (array->IsImmutable())
231 return errImmutableObject;
232 if (!isKindOf((PyrObject*)array, class_array))
233 return errFailed;
234
235 index = arrayAtIdentityHashInPairs(array, key);
236 slot = array->slots + index;
237 slotCopy(&slot[1], value);
238 g->gc->GCWrite(array, value);
239 if (IsNil(slot)) {
240 slotCopy(slot, key);
241 g->gc->GCWrite(array, key);
242 size = slotRawInt(&dict->slots[ivxIdentDict_size]) + 1;
243 SetRaw(&dict->slots[ivxIdentDict_size], size);
244 if (array->size < size * 3) {
245 PyrObject* newarray;
246 newarray = newPyrArray(g->gc, size * 3, 0, false);
247 newarray->size = ARRAYMAXINDEXSIZE(newarray);
248 nilSlots(newarray->slots, newarray->size);
249 slot = array->slots;
250 for (i = 0; i < array->size; i += 2, slot += 2) {
251 if (NotNil(slot)) {
252 index = arrayAtIdentityHashInPairs(newarray, slot);
253 newslot = newarray->slots + index;
254 slotCopy(&newslot[0], &slot[0]);
255 slotCopy(&newslot[1], &slot[1]);
256 }
257 }
258 SetRaw(&dict->slots[ivxIdentDict_array], newarray);
259 g->gc->GCWriteNew(dict, newarray); // we know newarray is white so we can use GCWriteNew
260 }
261 }
262 return errNone;
263 }
264
265 int prIdentDict_Put(struct VMGlobals* g, int numArgsPushed);
prIdentDict_Put(struct VMGlobals * g,int numArgsPushed)266 int prIdentDict_Put(struct VMGlobals* g, int numArgsPushed) {
267 PyrSlot *a, *b, *c;
268
269 a = g->sp - 2; // dict
270 b = g->sp - 1; // key
271 c = g->sp; // value
272 if (IsNil(b))
273 return errWrongType;
274 if (IsNil(c))
275 return errFailed; // will call removeAt
276 return identDictPut(g, slotRawObject(a), b, c);
277 }
278
279 int prIdentDict_PutGet(struct VMGlobals* g, int numArgsPushed);
prIdentDict_PutGet(struct VMGlobals * g,int numArgsPushed)280 int prIdentDict_PutGet(struct VMGlobals* g, int numArgsPushed) {
281 PyrSlot *a, *b, *c, *d, *slot, *newslot;
282 int i, index, size;
283 PyrObject* dict;
284 PyrObject* array;
285
286 a = g->sp - 2; // dict
287 b = g->sp - 1; // key
288 c = g->sp; // value
289 d = ++g->sp; // push the stack to save the receiver
290
291 slotCopy(d, a);
292 dict = slotRawObject(d);
293 array = slotRawObject(&dict->slots[ivxIdentDict_array]);
294 if (!isKindOf((PyrObject*)array, class_array)) {
295 SetNil(a);
296 --g->sp;
297 return errFailed;
298 }
299
300 index = arrayAtIdentityHashInPairs(array, b);
301 slot = array->slots + index;
302 slotCopy(a, &slot[1]);
303 slotCopy(&slot[1], c);
304 g->gc->GCWrite(array, c);
305 if (IsNil(slot)) {
306 slotCopy(slot, b);
307 g->gc->GCWrite(array, b);
308 size = slotRawInt(&dict->slots[ivxIdentDict_size]) + 1;
309 SetRaw(&dict->slots[ivxIdentDict_size], size);
310 if (array->size < size * 3) {
311 PyrObject* newarray;
312 newarray = newPyrArray(g->gc, size * 3, 0, true);
313 newarray->size = ARRAYMAXINDEXSIZE(newarray);
314 nilSlots(newarray->slots, newarray->size);
315 slot = array->slots;
316 for (i = 0; i < array->size; i += 2, slot += 2) {
317 if (NotNil(slot)) {
318 index = arrayAtIdentityHashInPairs(newarray, slot);
319 newslot = newarray->slots + index;
320 slotCopy(&newslot[0], &slot[0]);
321 slotCopy(&newslot[1], &slot[1]);
322 }
323 }
324 SetRaw(&dict->slots[ivxIdentDict_array], newarray);
325 g->gc->GCWriteNew(dict, newarray); // we know newarray is white so we can use GCWriteNew
326 }
327 }
328 --g->sp;
329 return errNone;
330 }
331
332
333 int prArray_AtIdentityHashInPairs(struct VMGlobals* g, int numArgsPushed);
prArray_AtIdentityHashInPairs(struct VMGlobals * g,int numArgsPushed)334 int prArray_AtIdentityHashInPairs(struct VMGlobals* g, int numArgsPushed) {
335 PyrSlot *a, *b;
336 unsigned int i;
337
338 a = g->sp - 1; // array
339 b = g->sp; // key
340
341 if (slotRawObject(a)->size < 2)
342 return errFailed;
343 i = arrayAtIdentityHashInPairs(slotRawObject(a), b);
344 SetInt(a, i);
345 return errNone;
346 }
347
348
349 bool identDict_lookupNonNil(PyrObject* dict, PyrSlot* key, int hash, PyrSlot* result);
identDict_lookupNonNil(PyrObject * dict,PyrSlot * key,int hash,PyrSlot * result)350 bool identDict_lookupNonNil(PyrObject* dict, PyrSlot* key, int hash, PyrSlot* result) {
351 again:
352 PyrSlot* dictslots = dict->slots;
353 PyrSlot* arraySlot = dictslots + ivxIdentDict_array;
354
355 if (isKindOfSlot(arraySlot, class_array)) {
356 PyrObject* array = slotRawObject(arraySlot);
357
358 int index = arrayAtIdentityHashInPairsWithHash(array, key, hash);
359 if (SlotEq(key, array->slots + index)) {
360 slotCopy(result, &array->slots[index + 1]);
361 return true;
362 }
363 }
364
365 PyrClass* identDictClass = s_identitydictionary->u.classobj;
366 PyrSlot* parentSlot = dictslots + ivxIdentDict_parent;
367 PyrSlot* protoSlot = dictslots + ivxIdentDict_proto;
368 if (isKindOfSlot(parentSlot, identDictClass)) {
369 if (isKindOfSlot(protoSlot, identDictClass)) {
370 // recursive call.
371 if (identDict_lookupNonNil(slotRawObject(protoSlot), key, hash, result))
372 return true;
373 }
374
375 dict = slotRawObject(parentSlot);
376 goto again; // tail call
377 } else {
378 if (isKindOfSlot(protoSlot, identDictClass)) {
379 dict = slotRawObject(protoSlot);
380 goto again; // tail call
381 }
382 }
383 return false;
384 }
385
386 bool identDict_lookup(PyrObject* dict, PyrSlot* key, int hash, PyrSlot* result);
identDict_lookup(PyrObject * dict,PyrSlot * key,int hash,PyrSlot * result)387 bool identDict_lookup(PyrObject* dict, PyrSlot* key, int hash, PyrSlot* result) {
388 again:
389 PyrSlot* dictslots = dict->slots;
390 PyrSlot* arraySlot = dictslots + ivxIdentDict_array;
391
392 if (isKindOfSlot(arraySlot, class_array)) {
393 PyrObject* array = slotRawObject(arraySlot);
394
395 int index = arrayAtIdentityHashInPairsWithHash(array, key, hash);
396 if (SlotEq(key, array->slots + index)) {
397 slotCopy(result, &array->slots[index + 1]);
398 return true;
399 }
400 }
401
402 PyrClass* identDictClass = s_identitydictionary->u.classobj;
403 PyrSlot* parentSlot = dictslots + ivxIdentDict_parent;
404 PyrSlot* protoSlot = dictslots + ivxIdentDict_proto;
405 if (isKindOfSlot(parentSlot, identDictClass)) {
406 if (isKindOfSlot(protoSlot, identDictClass)) {
407 // recursive call.
408 if (identDict_lookup(slotRawObject(protoSlot), key, hash, result))
409 return true;
410 }
411
412 dict = slotRawObject(parentSlot);
413 goto again; // tail call
414 } else {
415 if (isKindOfSlot(protoSlot, identDictClass)) {
416 dict = slotRawObject(protoSlot);
417 goto again; // tail call
418 }
419 }
420 SetNil(result);
421 return false;
422 }
423
424 int prIdentDict_At(struct VMGlobals* g, int numArgsPushed);
prIdentDict_At(struct VMGlobals * g,int numArgsPushed)425 int prIdentDict_At(struct VMGlobals* g, int numArgsPushed) {
426 PyrSlot* a = g->sp - 1; // dict
427 PyrSlot* key = g->sp; // key
428 PyrObject* dict = slotRawObject(a);
429
430 bool knows = IsTrue(dict->slots + ivxIdentDict_know);
431 if (knows && IsSym(key)) {
432 if (slotRawSymbol(key) == s_parent) {
433 slotCopy(a, &dict->slots[ivxIdentDict_parent]);
434 return errNone;
435 }
436 if (slotRawSymbol(key) == s_proto) {
437 slotCopy(a, &dict->slots[ivxIdentDict_proto]);
438 return errNone;
439 }
440 }
441
442 identDict_lookup(dict, key, calcHash(key), a);
443 return errNone;
444 }
445
446 int prSymbol_envirGet(struct VMGlobals* g, int numArgsPushed);
prSymbol_envirGet(struct VMGlobals * g,int numArgsPushed)447 int prSymbol_envirGet(struct VMGlobals* g, int numArgsPushed) {
448 PyrSlot *a, result;
449 int objClassIndex;
450
451 a = g->sp; // key
452
453 PyrSlot* currentEnvironmentSlot = &g->classvars->slots[1];
454 PyrObject* dict = slotRawObject(currentEnvironmentSlot);
455
456 if (!IsObj(currentEnvironmentSlot))
457 return errFailed;
458
459 if (!ISKINDOF(dict, class_identdict_index, class_identdict_maxsubclassindex))
460 return errFailed;
461
462 identDict_lookup(dict, a, calcHash(a), &result);
463 slotCopy(a, &result);
464
465 return errNone;
466 }
467
468
469 int prSymbol_envirPut(struct VMGlobals* g, int numArgsPushed);
prSymbol_envirPut(struct VMGlobals * g,int numArgsPushed)470 int prSymbol_envirPut(struct VMGlobals* g, int numArgsPushed) {
471 PyrSlot *a, *b;
472 int objClassIndex;
473
474 a = g->sp - 1; // key
475 b = g->sp; // value
476
477 PyrSlot* currentEnvironmentSlot = &g->classvars->slots[1];
478 PyrObject* dict = slotRawObject(currentEnvironmentSlot);
479
480 if (!IsObj(currentEnvironmentSlot))
481 return errFailed;
482
483 if (!ISKINDOF(dict, class_identdict_index, class_identdict_maxsubclassindex))
484 return errFailed;
485
486 int err = identDictPut(g, dict, a, b);
487 if (err)
488 return err;
489
490 slotCopy(a, b);
491
492 return errNone;
493 }
494
495
496 int prEvent_Delta(struct VMGlobals* g, int numArgsPushed);
prEvent_Delta(struct VMGlobals * g,int numArgsPushed)497 int prEvent_Delta(struct VMGlobals* g, int numArgsPushed) {
498 PyrSlot *a, key, dur, stretch, delta;
499 double fdur, fstretch;
500 int err;
501 PyrClass* restClass = getsym("Rest")->u.classobj;
502 PyrSlot* slot;
503
504 a = g->sp; // dict
505
506 SetSymbol(&key, s_delta);
507 identDict_lookup(slotRawObject(a), &key, calcHash(&key), &delta);
508
509 if (NotNil(&delta)) {
510 if (isKindOfSlot(&delta, restClass)) {
511 slot = slotRawObject(&delta)->slots;
512 err = slotDoubleVal(slot, &fdur);
513 } else {
514 err = slotDoubleVal(&delta, &fdur);
515 }
516 if (err) {
517 return err;
518 } else {
519 SetFloat(a, fdur);
520 return errNone;
521 }
522 } else {
523 SetSymbol(&key, s_dur);
524 identDict_lookup(slotRawObject(a), &key, calcHash(&key), &dur);
525 err = slotDoubleVal(&dur, &fdur);
526 if (err) {
527 if (IsNil(&dur)) {
528 SetNil(g->sp);
529 return errNone;
530 } else if (isKindOfSlot(&dur, restClass)) {
531 slot = slotRawObject(&dur)->slots;
532 err = slotDoubleVal(slot, &fdur);
533 if (err)
534 return err;
535 } else {
536 return errWrongType;
537 }
538 }
539 SetSymbol(&key, s_stretch);
540 identDict_lookup(slotRawObject(a), &key, calcHash(&key), &stretch);
541
542 err = slotDoubleVal(&stretch, &fstretch);
543 if (err) {
544 if (NotNil(&stretch)) {
545 if (isKindOfSlot(&stretch, restClass)) {
546 slot = slotRawObject(&stretch)->slots;
547 err = slotDoubleVal(slot, &fstretch);
548 if (err)
549 return err;
550 } else {
551 return errWrongType;
552 }
553 } else {
554 SetFloat(a, fdur);
555 return errNone;
556 }
557 }
558
559 SetFloat(a, fdur * fstretch);
560 }
561
562 return errNone;
563 }
564
565 /// Returns whether the slot is considered a rest for \c Event.isRest.
slotIsRestlike(PyrSlot * slot)566 static bool slotIsRestlike(PyrSlot* slot) {
567 PyrSymbol* slotSym;
568 if (isKindOfSlot(slot, class_rest) || isKindOfSlot(slot, class_metarest)) {
569 return true;
570 } else if (!slotSymbolVal(slot, &slotSym)) {
571 return slotSym == s_empty || slotSym == s_r || slotSym == s_rest;
572 }
573 // why no 'else'?
574 // slotSymbolVal nonzero return = not a symbol;
575 // non-symbols don't indicate rests, so, ignore them.
576
577 return false;
578 }
579
580 /// Returns whether the dictionary has an entry with a 'restlike' value (see \c slotIsRestlike).
dictHasRestlikeValue(PyrObject * array)581 static bool dictHasRestlikeValue(PyrObject* array) {
582 auto finalSlot = array->slots + array->size;
583
584 // odd-numered slots are values
585 for (auto slot = array->slots + 1; slot < finalSlot; slot += 2)
586 if (slotIsRestlike(slot))
587 return true;
588
589 return false;
590 }
591
592 int prEvent_IsRest(struct VMGlobals* g, int numArgsPushed);
prEvent_IsRest(struct VMGlobals * g,int numArgsPushed)593 int prEvent_IsRest(struct VMGlobals* g, int numArgsPushed) {
594 PyrSlot* dictslots = slotRawObject(g->sp)->slots;
595 PyrSlot* arraySlot = dictslots + ivxIdentDict_array;
596 static int isRestCount = 0;
597
598 if (!isKindOfSlot(arraySlot, class_array)) {
599 return errWrongType;
600 }
601
602 PyrSlot key, typeSlot;
603 PyrSymbol* typeSym;
604 // easy tests first: 'this[\type] == \rest'
605 SetSymbol(&key, s_type);
606 identDict_lookup(slotRawObject(g->sp), &key, calcHash(&key), &typeSlot);
607 if (!slotSymbolVal(&typeSlot, &typeSym) && typeSym == s_rest) {
608 SetBool(g->sp, 1);
609 return errNone;
610 }
611
612 // and, 'this[\isRest] == true'
613 SetSymbol(&key, s_isRest);
614 identDict_lookup(slotRawObject(g->sp), &key, calcHash(&key), &typeSlot);
615 if (IsTrue(&typeSlot)) {
616 if (isRestCount == 0)
617 post("\nWARNING: Setting isRest to true in an event is deprecated. See the Rest helpfile for supported "
618 "ways to specify rests.\n\n");
619 isRestCount = (isRestCount + 1) % 100;
620 SetBool(g->sp, 1);
621 return errNone;
622 }
623
624 // failing those, scan slot values for something rest-like
625 PyrObject* array = slotRawObject(arraySlot);
626 SetBool(g->sp, dictHasRestlikeValue(array) ? 1 : 0);
627 return errNone;
628 }
629
630 void PriorityQueueAdd(struct VMGlobals* g, PyrObject* queueobj, PyrSlot* item, double time);
PriorityQueueAdd(struct VMGlobals * g,PyrObject * queueobj,PyrSlot * item,double time)631 void PriorityQueueAdd(struct VMGlobals* g, PyrObject* queueobj, PyrSlot* item, double time) {
632 PyrObject *schedq, *newschedq;
633 int size, maxsize;
634
635 PyrSlot* schedqSlot = queueobj->slots;
636 if (!IsObj(schedqSlot)) {
637 size = 32;
638 schedq = newPyrArray(g->gc, size, 0, true);
639 schedq->size = 1;
640 SetInt(schedq->slots + 0, 0); // stability count
641 SetObject(schedqSlot, schedq);
642 g->gc->GCWriteNew(queueobj, schedq); // we know schedq is white so we can use GCWriteNew
643 } else {
644 schedq = slotRawObject(schedqSlot);
645 maxsize = ARRAYMAXINDEXSIZE(schedq);
646 size = schedq->size;
647 if (size + 3 > maxsize) {
648 newschedq = newPyrArray(g->gc, maxsize * 2, 0, true);
649 newschedq->size = size;
650
651 slotCopy(newschedq->slots, schedq->slots, size);
652 assert(IsInt(newschedq->slots));
653
654 SetObject(schedqSlot, newschedq);
655 g->gc->GCWriteNew(queueobj, newschedq); // we know newschedq is white so we can use GCWriteNew
656
657 schedq = newschedq;
658 }
659 }
660
661 addheap(g, schedq, time, item);
662 }
663
664 int prPriorityQueueAdd(struct VMGlobals* g, int numArgsPushed);
prPriorityQueueAdd(struct VMGlobals * g,int numArgsPushed)665 int prPriorityQueueAdd(struct VMGlobals* g, int numArgsPushed) {
666 PyrSlot* a = g->sp - 2; // priority queue
667 PyrSlot* b = g->sp - 1; // time
668 PyrSlot* c = g->sp; // item
669
670 double time;
671 int err = slotDoubleVal(b, &time);
672 if (err)
673 return errNone; // nil is OK, nothing gets added
674
675 PriorityQueueAdd(g, slotRawObject(a), c, time);
676 return errNone;
677 }
678
679
680 void PriorityQueuePop(VMGlobals* g, PyrObject* queueobj, PyrSlot* result);
PriorityQueuePop(VMGlobals * g,PyrObject * queueobj,PyrSlot * result)681 void PriorityQueuePop(VMGlobals* g, PyrObject* queueobj, PyrSlot* result) {
682 PyrSlot* schedqSlot = queueobj->slots;
683
684 if (IsObj(schedqSlot)) {
685 PyrObject* schedq = slotRawObject(schedqSlot);
686 double time;
687 if (!getheap(g, schedq, &time, result)) {
688 SetNil(result);
689 }
690 } else {
691 SetNil(result);
692 }
693 }
694
695 void PriorityQueueTop(PyrObject* queueobj, PyrSlot* result);
PriorityQueueTop(PyrObject * queueobj,PyrSlot * result)696 void PriorityQueueTop(PyrObject* queueobj, PyrSlot* result) {
697 PyrSlot* schedqSlot = queueobj->slots;
698
699 if (IsObj(schedqSlot)) {
700 PyrObject* schedq = slotRawObject(schedqSlot);
701 if (schedq->size > 1) {
702 slotCopy(result, &schedq->slots[1]);
703 } else {
704 SetNil(result);
705 }
706 } else {
707 SetNil(result);
708 }
709 }
710
711 void PriorityQueueClear(PyrObject* queueobj);
PriorityQueueClear(PyrObject * queueobj)712 void PriorityQueueClear(PyrObject* queueobj) {
713 PyrSlot* schedqSlot = queueobj->slots;
714
715 if (IsObj(schedqSlot)) {
716 PyrObject* schedq = slotRawObject(schedqSlot);
717 SetInt(schedq->slots, 0); // stability count
718 schedq->size = 1;
719 }
720 }
721
722 bool PriorityQueueEmpty(PyrObject* queueobj);
PriorityQueueEmpty(PyrObject * queueobj)723 bool PriorityQueueEmpty(PyrObject* queueobj) {
724 PyrSlot* schedqSlot = queueobj->slots;
725
726 if (IsObj(schedqSlot)) {
727 PyrObject* schedq = slotRawObject(schedqSlot);
728 if (schedq->size > 1) {
729 return false;
730 }
731 }
732 return true;
733 }
734
735 int prPriorityQueuePop(struct VMGlobals* g, int numArgsPushed);
prPriorityQueuePop(struct VMGlobals * g,int numArgsPushed)736 int prPriorityQueuePop(struct VMGlobals* g, int numArgsPushed) {
737 PyrSlot* a = g->sp; // priority queue
738
739 PriorityQueuePop(g, slotRawObject(a), a);
740 return errNone;
741 }
742
743 int prPriorityQueueTop(struct VMGlobals* g, int numArgsPushed);
prPriorityQueueTop(struct VMGlobals * g,int numArgsPushed)744 int prPriorityQueueTop(struct VMGlobals* g, int numArgsPushed) {
745 PyrSlot* a = g->sp; // priority queue
746
747 PriorityQueueTop(slotRawObject(a), a);
748 return errNone;
749 }
750
751 int prPriorityQueueClear(struct VMGlobals* g, int numArgsPushed);
prPriorityQueueClear(struct VMGlobals * g,int numArgsPushed)752 int prPriorityQueueClear(struct VMGlobals* g, int numArgsPushed) {
753 PyrSlot* a = g->sp; // priority queue
754
755 PriorityQueueClear(slotRawObject(a));
756 return errNone;
757 }
758
759 int prPriorityQueueEmpty(struct VMGlobals* g, int numArgsPushed);
prPriorityQueueEmpty(struct VMGlobals * g,int numArgsPushed)760 int prPriorityQueueEmpty(struct VMGlobals* g, int numArgsPushed) {
761 PyrSlot* a;
762
763 a = g->sp; // priority queue
764
765 if (PriorityQueueEmpty(slotRawObject(a))) {
766 SetTrue(a);
767 } else {
768 SetFalse(a);
769 }
770 return errNone;
771 }
772
773 void PriorityQueuePostpone(PyrObject* queueobj, double time);
PriorityQueuePostpone(PyrObject * queueobj,double time)774 void PriorityQueuePostpone(PyrObject* queueobj, double time) {
775 PyrSlot* schedqSlot = queueobj->slots;
776
777 if (IsObj(schedqSlot)) {
778 PyrObject* schedq = slotRawObject(schedqSlot);
779 PyrSlot* slots = schedq->slots;
780 for (int i = 1; i < schedq->size; i += 3) {
781 SetRaw(&slots[i], slotRawFloat(&slots[i]) + time);
782 }
783 }
784 }
785
786 int prPriorityQueuePostpone(struct VMGlobals* g, int numArgsPushed);
prPriorityQueuePostpone(struct VMGlobals * g,int numArgsPushed)787 int prPriorityQueuePostpone(struct VMGlobals* g, int numArgsPushed) {
788 PyrSlot* a = g->sp - 1; // priority queue
789 PyrSlot* b = g->sp; // time
790
791 double time;
792 int err = slotDoubleVal(b, &time);
793 if (err)
794 return err;
795
796 PyrObject* queueobj = slotRawObject(a);
797 PriorityQueuePostpone(queueobj, time);
798 return errNone;
799 }
800
801
802 void initListPrimitives();
initListPrimitives()803 void initListPrimitives() {
804 int base, index;
805
806 base = nextPrimitiveIndex();
807 index = 0;
808 definePrimitive(base, index++, "_Array_AtIdentityHash", prArray_AtIdentityHash, 2, 0);
809 definePrimitive(base, index++, "_Array_AtIdentityHashInPairs", prArray_AtIdentityHashInPairs, 2, 0);
810 definePrimitive(base, index++, "_IdentDict_Put", prIdentDict_Put, 3, 0);
811 definePrimitive(base, index++, "_IdentDict_PutGet", prIdentDict_PutGet, 3, 0);
812 definePrimitive(base, index++, "_IdentDict_At", prIdentDict_At, 2, 0);
813 definePrimitive(base, index++, "_Symbol_envirGet", prSymbol_envirGet, 1, 0);
814 definePrimitive(base, index++, "_Symbol_envirPut", prSymbol_envirPut, 2, 0);
815 definePrimitive(base, index++, "_ArrayMultiChannelExpand", prArrayMultiChanExpand, 1, 0);
816
817 definePrimitive(base, index++, "_PriorityQueueAdd", prPriorityQueueAdd, 3, 0);
818 definePrimitive(base, index++, "_PriorityQueuePop", prPriorityQueuePop, 1, 0);
819 definePrimitive(base, index++, "_PriorityQueueTop", prPriorityQueueTop, 1, 0);
820 definePrimitive(base, index++, "_PriorityQueueClear", prPriorityQueueClear, 1, 0);
821 definePrimitive(base, index++, "_PriorityQueueEmpty", prPriorityQueueEmpty, 1, 0);
822 definePrimitive(base, index++, "_PriorityQueuePostpone", prPriorityQueuePostpone, 2, 0);
823
824 definePrimitive(base, index++, "_Event_Delta", prEvent_Delta, 1, 0);
825 definePrimitive(base, index++, "_Event_IsRest", prEvent_IsRest, 1, 0);
826 }
827
828 void initPatterns();
initPatterns()829 void initPatterns() {
830 PyrSymbol* sym;
831
832 ivxIdentDict_array = instVarOffset("IdentityDictionary", "array");
833 ivxIdentDict_size = instVarOffset("IdentityDictionary", "size");
834 ivxIdentDict_parent = instVarOffset("IdentityDictionary", "parent");
835 ivxIdentDict_proto = instVarOffset("IdentityDictionary", "proto");
836 ivxIdentDict_know = instVarOffset("IdentityDictionary", "know");
837
838 sym = getsym("IdentityDictionary");
839 class_identdict = sym ? sym->u.classobj : nullptr;
840 class_identdict_index = slotRawInt(&class_identdict->classIndex);
841 class_identdict_maxsubclassindex = slotRawInt(&class_identdict->maxSubclassIndex);
842
843 class_array_index = slotRawInt(&class_array->classIndex);
844 class_array_maxsubclassindex = slotRawInt(&class_array->maxSubclassIndex);
845
846 s_parent = getsym("parent");
847 s_proto = getsym("proto");
848 s_delta = getsym("delta");
849 s_dur = getsym("dur");
850 s_stretch = getsym("stretch");
851
852 // used in prEvent_IsRest
853 s_type = getsym("type");
854 s_rest = getsym("rest");
855 s_empty = getsym("");
856 s_r = getsym("r");
857 s_isRest = getsym("isRest");
858
859 class_rest = getsym("Rest")->u.classobj;
860 class_metarest = getsym("Meta_Rest")->u.classobj;
861 }
862