lang/LangPrimSource/PyrListPrim.cpp

   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 #define HASHSYMBOL(sym) (sym >> 5)
  49
  50 #define ISKINDOF(obj, lo, hi)  (\
  51         objClassIndex = slotRawInt(&obj->classptr->classIndex), \
  52         objClassIndex >= lo && objClassIndex <= hi)
  53
  54
  55 int prArrayMultiChanExpand(struct VMGlobals *g, int numArgsPushed)
  56 {
  57         PyrSlot *a, *slot, *slots1, *slots2, *slots3, *slots4;
  58         PyrObject *obj1, *obj2, *obj3, *obj4;
  59         int i, j, size, len, maxlen;
  60
  61         a = g->sp;
  62         obj1 = slotRawObject(a);
  63         size = obj1->size;
  64         slots1 = obj1->slots;
  65         maxlen = 1;
  66         for (j=0; j<size; ++j) {
  67                 slot = slots1 + j;
  68                 if (IsObj(slot)) {
  69                         if (slotRawObject(slot)->classptr == class_array) {
  70                                 len = slotRawObject(slot)->size;
  71                                 maxlen = len > maxlen ? len : maxlen;
  72                         } else if (isKindOf(slotRawObject(slot), class_sequenceable_collection) && (slotRawObject(slot)->classptr != class_string)) {
  73                                 return errFailed; // this primitive only handles Arrays.
  74                         }
  75                 }
  76         }
  77
  78         obj2 = newPyrArray(g->gc, maxlen, 0, true);
  79         obj2->size = maxlen;
  80         slots2 = obj2->slots;
  81         for (i=0; i<maxlen; ++i) {
  82                 obj3 = newPyrArray(g->gc, size, 0, false);
  83                 obj3->size = size;
  84                 SetObject(slots2 + i, obj3);
  85                 slots1 = obj1->slots;
  86                 slots3 = obj3->slots;
  87                 for (j=0; j<size; ++j) {
  88                         slot = slots1 + j;
  89                         if (IsObj(slot)) {
  90                                 if (slotRawObject(slot)->classptr == class_array && slotRawObject(slot)->size > 0) {
  91                                         obj4 = slotRawObject(slot);
  92                                         slots4 = obj4->slots;
  93                                         slotCopy(&slots3[j],&slots4[i % obj4->size]);
  94                                 } else {
  95                                         slotCopy(&slots3[j],slot);
  96                                 }
  97                         } else {
  98                                 slotCopy(&slots3[j],slot);
  99                         }
 100                 }
 101         }
 102
 103         SetObject(a, obj2);
 104
 105         return errNone;
 106 }
 107
 108
 109 int arrayAtIdentityHash(PyrObject *array, PyrSlot *key)
 110 {
 111         PyrSlot *slots, *test;
 112         unsigned int i, start, end, hash, maxHash;
 113
 114         hash = calcHash(key);
 115         maxHash = array->size;
 116         start = hash % maxHash;
 117         end = array->size;
 118         slots = array->slots;
 119         for (i=start; i<end; i++) {
 120                 test = slots + i;
 121                 if (IsNil(test) || SlotEq(test, key))
 122                         return i;
 123         }
 124         end = start - 1;
 125         for (i=0; i<=end; i++) {
 126                 test = slots + i;
 127                 if (IsNil(test) ||  SlotEq(test, key))
 128                         return i;
 129         }
 130         return -1;
 131 }
 132
 133
 134 int prArray_AtIdentityHash(struct VMGlobals *g, int numArgsPushed);
 135 int prArray_AtIdentityHash(struct VMGlobals *g, int numArgsPushed)
 136 {
 137         PyrSlot *a, *b;
 138         PyrObject *array;
 139         int index;
 140
 141         a = g->sp - 1;  // array
 142         b = g->sp;              // key
 143
 144         array = slotRawObject(a);
 145         if(array->size == 0) return errFailed;
 146         index = arrayAtIdentityHash(array, b);
 147         SetInt(a, index);
 148         return errNone;
 149 }
 150
 151
 152 int arrayAtIdentityHashInPairs(PyrObject *array, PyrSlot *key)
 153 {
 154         PyrSlot *slots, *test;
 155         unsigned int i, start, end, hash, maxHash;
 156
 157         hash = calcHash(key);
 158         maxHash = array->size >> 1;
 159         start = (hash % maxHash) << 1;
 160         end = array->size;
 161         slots = array->slots;
 162         for (i=start; i<end; i+=2) {
 163                 test = slots + i;
 164                 if (IsNil(test) || SlotEq(test, key))
 165                         return i;
 166         }
 167         end = start - 2;
 168         for (i=0; i<=end; i+=2) {
 169                 test = slots + i;
 170                 if (IsNil(test) || SlotEq(test, key))
 171                         return i;
 172         }
 173         return -2;
 174 }
 175
 176
 177 int arrayAtIdentityHashInPairsWithHash(PyrObject *array, PyrSlot *key, int hash)
 178 {
 179         PyrSlot *slots, *test;
 180         unsigned int i, start, end, maxHash;
 181
 182         maxHash = array->size >> 1;
 183         start = (hash % maxHash) << 1;
 184         end = array->size;
 185         slots = array->slots;
 186         for (i=start; i<end; i+=2) {
 187                 test = slots + i;
 188                 if (IsNil(test) || SlotEq(test, key))
 189                         return i;
 190         }
 191         end = start - 2;
 192         for (i=0; i<=end; i+=2) {
 193                 test = slots + i;
 194                 if (IsNil(test) || SlotEq(test, key))
 195                         return i;
 196         }
 197         return -2;
 198 }
 199
 200
 201 int identDictPut(struct VMGlobals *g, PyrObject *dict, PyrSlot *key, PyrSlot *value);
 202 int identDictPut(struct VMGlobals *g, PyrObject *dict, PyrSlot *key, PyrSlot *value)
 203 {
 204         PyrSlot *slot, *newslot;
 205         int i, index, size;
 206         PyrObject *array;
 207
 208         bool knows = IsTrue(dict->slots + ivxIdentDict_know);
 209         if (knows && IsSym(key)) {
 210                 if (slotRawSymbol(key) == s_parent) {
 211                         slotCopy(&dict->slots[ivxIdentDict_parent],value);
 212                         g->gc->GCWrite(dict, value);
 213                         return errNone;
 214                 }
 215                 if (slotRawSymbol(key) == s_proto) {
 216                         slotCopy(&dict->slots[ivxIdentDict_proto],value);
 217                         g->gc->GCWrite(dict, value);
 218                         return errNone;
 219                 }
 220         }
 221         array = slotRawObject(&dict->slots[ivxIdentDict_array]);
 222         if (!isKindOf((PyrObject*)array, class_array)) return errFailed;
 223
 224         index = arrayAtIdentityHashInPairs(array, key);
 225         slot = array->slots + index;
 226         slotCopy(&slot[1],value);
 227         g->gc->GCWrite(array, value);
 228         if (IsNil(slot)) {
 229                 slotCopy(slot,key);
 230                 g->gc->GCWrite(array, key);
 231                 size = slotRawInt(&dict->slots[ivxIdentDict_size]) + 1;
 232                 SetRaw(&dict->slots[ivxIdentDict_size], size);
 233                 if (array->size < size*3) {
 234                         PyrObject *newarray;
 235                         newarray = newPyrArray(g->gc, size*3, 0, false);
 236                         newarray->size = ARRAYMAXINDEXSIZE(newarray);
 237                         nilSlots(newarray->slots, newarray->size);
 238                         slot = array->slots;
 239                         for (i=0; i<array->size; i+=2, slot+=2) {
 240                                 if (NotNil(slot)) {
 241                                         index = arrayAtIdentityHashInPairs(newarray, slot);
 242                                         newslot = newarray->slots + index;
 243                                         slotCopy(&newslot[0],&slot[0]);
 244                                         slotCopy(&newslot[1],&slot[1]);
 245                                 }
 246                         }
 247                         SetRaw(&dict->slots[ivxIdentDict_array], newarray);
 248                         g->gc->GCWrite(dict, newarray);
 249                 }
 250         }
 251         return errNone;
 252 }
 253
 254 int prIdentDict_Put(struct VMGlobals *g, int numArgsPushed);
 255 int prIdentDict_Put(struct VMGlobals *g, int numArgsPushed)
 256 {
 257         PyrSlot *a, *b, *c;
 258
 259         a = g->sp - 2;  // dict
 260         b = g->sp - 1;  // key
 261         c = g->sp;              // value
 262         if(IsNil(b)) return errWrongType;
 263         if(IsNil(c)) return errFailed; // will call removeAt
 264         return identDictPut(g, slotRawObject(a), b, c);
 265 }
 266
 267 int prIdentDict_PutGet(struct VMGlobals *g, int numArgsPushed);
 268 int prIdentDict_PutGet(struct VMGlobals *g, int numArgsPushed)
 269 {
 270         PyrSlot *a, *b, *c, *d, *slot, *newslot;
 271         int i, index, size;
 272         PyrObject *dict;
 273         PyrObject *array;
 274
 275         a = g->sp - 2;  // dict
 276         b = g->sp - 1;  // key
 277         c = g->sp;              // value
 278         d = ++g->sp;    // push the stack to save the receiver
 279
 280         slotCopy(d,a);
 281         dict = slotRawObject(d);
 282         array = slotRawObject(&dict->slots[ivxIdentDict_array]);
 283         if (!isKindOf((PyrObject*)array, class_array)) {
 284                 SetNil(a);
 285                 --g->sp;
 286                 return errFailed;
 287         }
 288
 289         index = arrayAtIdentityHashInPairs(array, b);
 290         slot = array->slots + index;
 291         slotCopy(a,&slot[1]);
 292         slotCopy(&slot[1],c);
 293         g->gc->GCWrite(array, c);
 294         if (IsNil(slot)) {
 295                 slotCopy(slot,b);
 296                 g->gc->GCWrite(array, b);
 297                 size = slotRawInt(&dict->slots[ivxIdentDict_size]) + 1;
 298                 SetRaw(&dict->slots[ivxIdentDict_size], size);
 299                 if (array->size < size*3) {
 300                         PyrObject *newarray;
 301                         newarray = newPyrArray(g->gc, size*3, 0, true);
 302                         newarray->size = ARRAYMAXINDEXSIZE(newarray);
 303                         nilSlots(newarray->slots, newarray->size);
 304                         slot = array->slots;
 305                         for (i=0; i<array->size; i+=2, slot+=2) {
 306                                 if (NotNil(slot)) {
 307                                         index = arrayAtIdentityHashInPairs(newarray, slot);
 308                                         newslot = newarray->slots + index;
 309                                         slotCopy(&newslot[0],&slot[0]);
 310                                         slotCopy(&newslot[1],&slot[1]);
 311                                 }
 312                         }
 313                         SetRaw(&dict->slots[ivxIdentDict_array], newarray);
 314                         g->gc->GCWrite(dict, newarray);
 315                 }
 316         }
 317         --g->sp;
 318         return errNone;
 319 }
 320
 321
 322
 323 int prArray_AtIdentityHashInPairs(struct VMGlobals *g, int numArgsPushed);
 324 int prArray_AtIdentityHashInPairs(struct VMGlobals *g, int numArgsPushed)
 325 {
 326         PyrSlot *a, *b;
 327         unsigned int i;
 328
 329         a = g->sp - 1;  // array
 330         b = g->sp;              // key
 331
 332         if(slotRawObject(a)->size < 2) return errFailed;
 333         i = arrayAtIdentityHashInPairs(slotRawObject(a), b);
 334         SetInt(a, i);
 335         return errNone;
 336 }
 337
 338
 339 bool identDict_lookupNonNil(PyrObject *dict, PyrSlot *key, int hash, PyrSlot *result);
 340 bool identDict_lookupNonNil(PyrObject *dict, PyrSlot *key, int hash, PyrSlot *result)
 341 {
 342 again:
 343         PyrSlot *dictslots = dict->slots;
 344         PyrSlot *arraySlot = dictslots + ivxIdentDict_array;
 345
 346         if (isKindOfSlot(arraySlot, class_array)) {
 347                 PyrObject *array = slotRawObject(arraySlot);
 348
 349                 int index = arrayAtIdentityHashInPairsWithHash(array, key, hash);
 350                 if (SlotEq(key, array->slots + index)) {
 351                         slotCopy(result,&array->slots[index + 1]);
 352                         return true;
 353                 }
 354         }
 355
 356         PyrClass *identDictClass = s_identitydictionary->u.classobj;
 357         PyrSlot *parentSlot = dictslots + ivxIdentDict_parent;
 358         PyrSlot * protoSlot = dictslots + ivxIdentDict_proto;
 359         if (isKindOfSlot(parentSlot, identDictClass)) {
 360                 if (isKindOfSlot(protoSlot, identDictClass)) {
 361                         // recursive call.
 362                         if (identDict_lookupNonNil(slotRawObject(protoSlot), key, hash, result)) return true;
 363                 }
 364
 365                 dict = slotRawObject(parentSlot);
 366                 goto again; // tail call
 367         } else {
 368                 if (isKindOfSlot(protoSlot, identDictClass)) {
 369                         dict = slotRawObject(protoSlot);
 370                         goto again; // tail call
 371                 }
 372         }
 373         return false;
 374 }
 375
 376 bool identDict_lookup(PyrObject *dict, PyrSlot *key, int hash, PyrSlot *result);
 377 bool identDict_lookup(PyrObject *dict, PyrSlot *key, int hash, PyrSlot *result)
 378 {
 379 again:
 380         PyrSlot *dictslots = dict->slots;
 381         PyrSlot *arraySlot = dictslots + ivxIdentDict_array;
 382
 383         if (isKindOfSlot(arraySlot, class_array)) {
 384                 PyrObject *array = slotRawObject(arraySlot);
 385
 386                 int index = arrayAtIdentityHashInPairsWithHash(array, key, hash);
 387                 if (SlotEq(key, array->slots + index)) {
 388                         slotCopy(result,&array->slots[index + 1]);
 389                         return true;
 390                 }
 391         }
 392
 393         PyrClass *identDictClass = s_identitydictionary->u.classobj;
 394         PyrSlot *parentSlot = dictslots + ivxIdentDict_parent;
 395         PyrSlot * protoSlot = dictslots + ivxIdentDict_proto;
 396         if (isKindOfSlot(parentSlot, identDictClass)) {
 397                 if (isKindOfSlot(protoSlot, identDictClass)) {
 398                         // recursive call.
 399                         if (identDict_lookup(slotRawObject(protoSlot), key, hash, result)) return true;
 400                 }
 401
 402                 dict = slotRawObject(parentSlot);
 403                 goto again; // tail call
 404         } else {
 405                 if (isKindOfSlot(protoSlot, identDictClass)) {
 406                         dict = slotRawObject(protoSlot);
 407                         goto again; // tail call
 408                 }
 409         }
 410         SetNil(result);
 411         return false;
 412 }
 413
 414 int prIdentDict_At(struct VMGlobals *g, int numArgsPushed);
 415 int prIdentDict_At(struct VMGlobals *g, int numArgsPushed)
 416 {
 417         PyrSlot* a = g->sp - 1;  // dict
 418         PyrSlot* key = g->sp;           // key
 419         PyrObject *dict = slotRawObject(a);
 420
 421         bool knows = IsTrue(dict->slots + ivxIdentDict_know);
 422         if (knows && IsSym(key)) {
 423                 if (slotRawSymbol(key) == s_parent) {
 424                         slotCopy(a,&dict->slots[ivxIdentDict_parent]);
 425                         return errNone;
 426                 }
 427                 if (slotRawSymbol(key) == s_proto) {
 428                         slotCopy(a,&dict->slots[ivxIdentDict_proto]);
 429                         return errNone;
 430                 }
 431         }
 432
 433         identDict_lookup(dict, key, calcHash(key), a);
 434         return errNone;
 435 }
 436
 437 int prSymbol_envirGet(struct VMGlobals *g, int numArgsPushed);
 438 int prSymbol_envirGet(struct VMGlobals *g, int numArgsPushed)
 439 {
 440         PyrSlot *a, result;
 441         int objClassIndex;
 442
 443         a = g->sp;  // key
 444
 445         PyrSlot* currentEnvironmentSlot = &g->classvars->slots[1];
 446         PyrObject *dict = slotRawObject(currentEnvironmentSlot);
 447
 448         if (!IsObj(currentEnvironmentSlot)) return errFailed;
 449
 450         if (!ISKINDOF(dict, class_identdict_index, class_identdict_maxsubclassindex)) return errFailed;
 451
 452         identDict_lookup(dict, a, calcHash(a), &result);
 453         slotCopy(a,&result);
 454
 455         return errNone;
 456 }
 457
 458
 459 int prSymbol_envirPut(struct VMGlobals *g, int numArgsPushed);
 460 int prSymbol_envirPut(struct VMGlobals *g, int numArgsPushed)
 461 {
 462         PyrSlot *a, *b;
 463         int objClassIndex;
 464
 465         a = g->sp - 1;  // key
 466         b = g->sp;  // value
 467
 468         PyrSlot* currentEnvironmentSlot = &g->classvars->slots[1];
 469         PyrObject *dict = slotRawObject(currentEnvironmentSlot);
 470
 471         if (!IsObj(currentEnvironmentSlot)) return errFailed;
 472
 473         if (!ISKINDOF(dict, class_identdict_index, class_identdict_maxsubclassindex)) return errFailed;
 474
 475         int err = identDictPut(g, dict, a, b);
 476         if (err) return err;
 477
 478         slotCopy(a,b);
 479
 480         return errNone;
 481 }
 482
 483
 484 int prEvent_Delta(struct VMGlobals *g, int numArgsPushed);
 485 int prEvent_Delta(struct VMGlobals *g, int numArgsPushed)
 486 {
 487         PyrSlot *a, key, dur, stretch, delta;
 488         double fdur, fstretch;
 489         int err;
 490
 491         a = g->sp;  // dict
 492
 493         SetSymbol(&key, s_delta);
 494         identDict_lookup(slotRawObject(a), &key, calcHash(&key), &delta);
 495
 496         if (NotNil(&delta)) {
 497                 slotCopy(a,&delta);
 498         } else {
 499                 SetSymbol(&key, s_dur);
 500                 identDict_lookup(slotRawObject(a), &key, calcHash(&key), &dur);
 501
 502                 err = slotDoubleVal(&dur, &fdur);
 503                 if (err) {
 504                         if (NotNil(&dur)) return err;
 505                         SetNil(a);
 506                         return errNone;
 507                 }
 508
 509                 SetSymbol(&key, s_stretch);
 510                 identDict_lookup(slotRawObject(a), &key, calcHash(&key), &stretch);
 511
 512                 err = slotDoubleVal(&stretch, &fstretch);
 513                 if (err) {
 514                         if (NotNil(&stretch)) return err;
 515                         SetFloat(a, fdur);
 516                         return errNone;
 517                 }
 518
 519                 SetFloat(a, fdur * fstretch );
 520         }
 521
 522         return errNone;
 523 }
 524
 525 void PriorityQueueAdd(struct VMGlobals *g, PyrObject* queueobj, PyrSlot* item, double time);
 526 void PriorityQueueAdd(struct VMGlobals *g, PyrObject* queueobj, PyrSlot* item, double time)
 527 {
 528         PyrObject *schedq, *newschedq;
 529         int size, maxsize;
 530
 531         PyrSlot *schedqSlot = queueobj->slots;
 532         if (!IsObj(schedqSlot)) {
 533                 size = 32;
 534                 schedq = newPyrArray(g->gc, size, 0, true);
 535                 schedq->size = 1;
 536                 SetInt(schedq->slots + 0, 0); // stability count
 537                 SetObject(schedqSlot, schedq);
 538                 g->gc->GCWrite(queueobj, schedq);
 539         } else {
 540                 schedq = slotRawObject(schedqSlot);
 541                 maxsize = ARRAYMAXINDEXSIZE(schedq);
 542                 size = schedq->size;
 543                 if (size+3 > maxsize) {
 544                         PyrSlot *pslot, *qslot;
 545
 546                         newschedq = newPyrArray(g->gc, maxsize*2, 0, true);
 547                         newschedq->size = size;
 548
 549                         slotCopy(newschedq->slots, schedq->slots, size);
 550                         assert(IsInt(newschedq->slots));
 551
 552                         SetObject(schedqSlot, newschedq);
 553                         g->gc->GCWrite(queueobj, newschedq);
 554
 555                         schedq = newschedq;
 556                 }
 557         }
 558
 559         addheap(g, schedq, time, item);
 560 }
 561
 562 int prPriorityQueueAdd(struct VMGlobals *g, int numArgsPushed);
 563 int prPriorityQueueAdd(struct VMGlobals *g, int numArgsPushed)
 564 {
 565
 566         PyrSlot *a = g->sp - 2; // priority queue
 567         PyrSlot *b = g->sp - 1; // time
 568         PyrSlot *c = g->sp;             // item
 569
 570         double time;
 571         int err = slotDoubleVal(b, &time);
 572         if (err) return errNone;        // nil is OK, nothing gets added
 573
 574         PriorityQueueAdd(g, slotRawObject(a), c, time);
 575         return errNone;
 576 }
 577
 578
 579 void PriorityQueuePop(VMGlobals *g, PyrObject *queueobj, PyrSlot *result);
 580 void PriorityQueuePop(VMGlobals *g, PyrObject *queueobj, PyrSlot *result)
 581 {
 582         PyrSlot *schedqSlot = queueobj->slots;
 583
 584         if (IsObj(schedqSlot)) {
 585                 PyrObject *schedq = slotRawObject(schedqSlot);
 586                 double time;
 587                 if (!getheap(g, schedq, &time, result)) {
 588                         SetNil(result);
 589                 }
 590         } else {
 591                 SetNil(result);
 592         }
 593 }
 594
 595 void PriorityQueueTop(PyrObject *queueobj, PyrSlot *result);
 596 void PriorityQueueTop(PyrObject *queueobj, PyrSlot *result)
 597 {
 598         PyrSlot *schedqSlot = queueobj->slots;
 599
 600         if (IsObj(schedqSlot)) {
 601                 PyrObject *schedq = slotRawObject(schedqSlot);
 602                 if (schedq->size > 1) {
 603                         slotCopy(result,&schedq->slots[1]);
 604                 } else {
 605                         SetNil(result);
 606                 }
 607         } else {
 608                 SetNil(result);
 609         }
 610 }
 611
 612 void PriorityQueueClear(PyrObject *queueobj);
 613 void PriorityQueueClear(PyrObject *queueobj)
 614 {
 615         PyrSlot *schedqSlot = queueobj->slots;
 616
 617         if (IsObj(schedqSlot)) {
 618                 PyrObject *schedq = slotRawObject(schedqSlot);
 619                 SetInt(schedq->slots, 0); // stability count
 620                 schedq->size = 1;
 621         }
 622 }
 623
 624 bool PriorityQueueEmpty(PyrObject *queueobj);
 625 bool PriorityQueueEmpty(PyrObject *queueobj)
 626 {
 627         PyrSlot *schedqSlot = queueobj->slots;
 628
 629         if (IsObj(schedqSlot)) {
 630                 PyrObject *schedq = slotRawObject(schedqSlot);
 631                 if (schedq->size > 1) {
 632                         return false;
 633                 }
 634         }
 635         return true;
 636 }
 637
 638 int prPriorityQueuePop(struct VMGlobals *g, int numArgsPushed);
 639 int prPriorityQueuePop(struct VMGlobals *g, int numArgsPushed)
 640 {
 641         PyrSlot* a = g->sp;     // priority queue
 642
 643         PriorityQueuePop(g, slotRawObject(a), a);
 644         return errNone;
 645 }
 646
 647 int prPriorityQueueTop(struct VMGlobals *g, int numArgsPushed);
 648 int prPriorityQueueTop(struct VMGlobals *g, int numArgsPushed)
 649 {
 650         PyrSlot* a = g->sp;     // priority queue
 651
 652         PriorityQueueTop(slotRawObject(a), a);
 653         return errNone;
 654 }
 655
 656 int prPriorityQueueClear(struct VMGlobals *g, int numArgsPushed);
 657 int prPriorityQueueClear(struct VMGlobals *g, int numArgsPushed)
 658 {
 659         PyrSlot* a = g->sp;     // priority queue
 660
 661         PriorityQueueClear(slotRawObject(a));
 662         return errNone;
 663 }
 664
 665 int prPriorityQueueEmpty(struct VMGlobals *g, int numArgsPushed);
 666 int prPriorityQueueEmpty(struct VMGlobals *g, int numArgsPushed)
 667 {
 668         PyrSlot *a;
 669
 670         a = g->sp;      // priority queue
 671
 672         if (PriorityQueueEmpty(slotRawObject(a))) {
 673                 SetTrue(a);
 674         } else {
 675                 SetFalse(a);
 676         }
 677         return errNone;
 678 }
 679
 680 void PriorityQueuePostpone(PyrObject* queueobj, double time);
 681 void PriorityQueuePostpone(PyrObject* queueobj, double time)
 682 {
 683         PyrSlot *schedqSlot = queueobj->slots;
 684
 685         if (IsObj(schedqSlot)) {
 686                 PyrObject *schedq = slotRawObject(schedqSlot);
 687                 PyrSlot* slots = schedq->slots;
 688                 for (int i=1; i < schedq->size; i+=3) {
 689                         SetRaw(&slots[i], slotRawFloat(&slots[i]) + time);
 690                 }
 691         }
 692 }
 693
 694 int prPriorityQueuePostpone(struct VMGlobals *g, int numArgsPushed);
 695 int prPriorityQueuePostpone(struct VMGlobals *g, int numArgsPushed)
 696 {
 697         PyrSlot *a = g->sp - 1; // priority queue
 698         PyrSlot *b = g->sp;             // time
 699
 700         double time;
 701         int err = slotDoubleVal(b, &time);
 702         if (err) return err;
 703
 704         PyrObject *queueobj = slotRawObject(a);
 705         PriorityQueuePostpone(queueobj, time);
 706         return errNone;
 707 }
 708
 709
 710 void initListPrimitives();
 711 void initListPrimitives()
 712 {
 713         int base, index;
 714
 715         base = nextPrimitiveIndex();
 716         index = 0;
 717         definePrimitive(base, index++, "_Array_AtIdentityHash", prArray_AtIdentityHash, 2, 0);
 718         definePrimitive(base, index++, "_Array_AtIdentityHashInPairs", prArray_AtIdentityHashInPairs, 2, 0);
 719         definePrimitive(base, index++, "_IdentDict_Put", prIdentDict_Put, 3, 0);
 720         definePrimitive(base, index++, "_IdentDict_PutGet", prIdentDict_PutGet, 3, 0);
 721         definePrimitive(base, index++, "_IdentDict_At", prIdentDict_At, 2, 0);
 722         definePrimitive(base, index++, "_Symbol_envirGet", prSymbol_envirGet, 1, 0);
 723         definePrimitive(base, index++, "_Symbol_envirPut", prSymbol_envirPut, 2, 0);
 724         definePrimitive(base, index++, "_ArrayMultiChannelExpand", prArrayMultiChanExpand, 1, 0);
 725
 726         definePrimitive(base, index++, "_PriorityQueueAdd", prPriorityQueueAdd, 3, 0);
 727         definePrimitive(base, index++, "_PriorityQueuePop", prPriorityQueuePop, 1, 0);
 728         definePrimitive(base, index++, "_PriorityQueueTop", prPriorityQueueTop, 1, 0);
 729         definePrimitive(base, index++, "_PriorityQueueClear", prPriorityQueueClear, 1, 0);
 730         definePrimitive(base, index++, "_PriorityQueueEmpty", prPriorityQueueEmpty, 1, 0);
 731         definePrimitive(base, index++, "_PriorityQueuePostpone", prPriorityQueuePostpone, 2, 0);
 732
 733         definePrimitive(base, index++, "_Event_Delta", prEvent_Delta, 1, 0);
 734 }
 735
 736 void initPatterns();
 737 void initPatterns()
 738 {
 739         PyrSymbol *sym;
 740
 741         ivxIdentDict_array  = instVarOffset("IdentityDictionary", "array");
 742         ivxIdentDict_size   = instVarOffset("IdentityDictionary", "size");
 743         ivxIdentDict_parent = instVarOffset("IdentityDictionary", "parent");
 744         ivxIdentDict_proto = instVarOffset("IdentityDictionary", "proto");
 745         ivxIdentDict_know = instVarOffset("IdentityDictionary", "know");
 746
 747         sym = getsym("IdentityDictionary");
 748         class_identdict = sym ? sym->u.classobj : NULL;
 749         class_identdict_index = slotRawInt(&class_identdict->classIndex);
 750         class_identdict_maxsubclassindex = slotRawInt(&class_identdict->maxSubclassIndex);
 751
 752         class_array_index = slotRawInt(&class_array->classIndex);
 753         class_array_maxsubclassindex = slotRawInt(&class_array->maxSubclassIndex);
 754
 755         s_parent = getsym("parent");
 756         s_proto = getsym("proto");
 757         s_delta = getsym("delta");
 758         s_dur = getsym("dur");
 759         s_stretch = getsym("stretch");
 760
 761 }