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
 545                         newschedq = newPyrArray(g->gc, maxsize*2, 0, true);
 546                         newschedq->size = size;
 547
 548                         slotCopy(newschedq->slots, schedq->slots, size);
 549                         assert(IsInt(newschedq->slots));
 550
 551                         SetObject(schedqSlot, newschedq);
 552                         g->gc->GCWrite(queueobj, newschedq);
 553
 554                         schedq = newschedq;
 555                 }
 556         }
 557
 558         addheap(g, schedq, time, item);
 559 }
 560
 561 int prPriorityQueueAdd(struct VMGlobals *g, int numArgsPushed);
 562 int prPriorityQueueAdd(struct VMGlobals *g, int numArgsPushed)
 563 {
 564
 565         PyrSlot *a = g->sp - 2; // priority queue
 566         PyrSlot *b = g->sp - 1; // time
 567         PyrSlot *c = g->sp;             // item
 568
 569         double time;
 570         int err = slotDoubleVal(b, &time);
 571         if (err) return errNone;        // nil is OK, nothing gets added
 572
 573         PriorityQueueAdd(g, slotRawObject(a), c, time);
 574         return errNone;
 575 }
 576
 577
 578 void PriorityQueuePop(VMGlobals *g, PyrObject *queueobj, PyrSlot *result);
 579 void PriorityQueuePop(VMGlobals *g, PyrObject *queueobj, PyrSlot *result)
 580 {
 581         PyrSlot *schedqSlot = queueobj->slots;
 582
 583         if (IsObj(schedqSlot)) {
 584                 PyrObject *schedq = slotRawObject(schedqSlot);
 585                 double time;
 586                 if (!getheap(g, schedq, &time, result)) {
 587                         SetNil(result);
 588                 }
 589         } else {
 590                 SetNil(result);
 591         }
 592 }
 593
 594 void PriorityQueueTop(PyrObject *queueobj, PyrSlot *result);
 595 void PriorityQueueTop(PyrObject *queueobj, PyrSlot *result)
 596 {
 597         PyrSlot *schedqSlot = queueobj->slots;
 598
 599         if (IsObj(schedqSlot)) {
 600                 PyrObject *schedq = slotRawObject(schedqSlot);
 601                 if (schedq->size > 1) {
 602                         slotCopy(result,&schedq->slots[1]);
 603                 } else {
 604                         SetNil(result);
 605                 }
 606         } else {
 607                 SetNil(result);
 608         }
 609 }
 610
 611 void PriorityQueueClear(PyrObject *queueobj);
 612 void PriorityQueueClear(PyrObject *queueobj)
 613 {
 614         PyrSlot *schedqSlot = queueobj->slots;
 615
 616         if (IsObj(schedqSlot)) {
 617                 PyrObject *schedq = slotRawObject(schedqSlot);
 618                 SetInt(schedq->slots, 0); // stability count
 619                 schedq->size = 1;
 620         }
 621 }
 622
 623 bool PriorityQueueEmpty(PyrObject *queueobj);
 624 bool PriorityQueueEmpty(PyrObject *queueobj)
 625 {
 626         PyrSlot *schedqSlot = queueobj->slots;
 627
 628         if (IsObj(schedqSlot)) {
 629                 PyrObject *schedq = slotRawObject(schedqSlot);
 630                 if (schedq->size > 1) {
 631                         return false;
 632                 }
 633         }
 634         return true;
 635 }
 636
 637 int prPriorityQueuePop(struct VMGlobals *g, int numArgsPushed);
 638 int prPriorityQueuePop(struct VMGlobals *g, int numArgsPushed)
 639 {
 640         PyrSlot* a = g->sp;     // priority queue
 641
 642         PriorityQueuePop(g, slotRawObject(a), a);
 643         return errNone;
 644 }
 645
 646 int prPriorityQueueTop(struct VMGlobals *g, int numArgsPushed);
 647 int prPriorityQueueTop(struct VMGlobals *g, int numArgsPushed)
 648 {
 649         PyrSlot* a = g->sp;     // priority queue
 650
 651         PriorityQueueTop(slotRawObject(a), a);
 652         return errNone;
 653 }
 654
 655 int prPriorityQueueClear(struct VMGlobals *g, int numArgsPushed);
 656 int prPriorityQueueClear(struct VMGlobals *g, int numArgsPushed)
 657 {
 658         PyrSlot* a = g->sp;     // priority queue
 659
 660         PriorityQueueClear(slotRawObject(a));
 661         return errNone;
 662 }
 663
 664 int prPriorityQueueEmpty(struct VMGlobals *g, int numArgsPushed);
 665 int prPriorityQueueEmpty(struct VMGlobals *g, int numArgsPushed)
 666 {
 667         PyrSlot *a;
 668
 669         a = g->sp;      // priority queue
 670
 671         if (PriorityQueueEmpty(slotRawObject(a))) {
 672                 SetTrue(a);
 673         } else {
 674                 SetFalse(a);
 675         }
 676         return errNone;
 677 }
 678
 679 void PriorityQueuePostpone(PyrObject* queueobj, double time);
 680 void PriorityQueuePostpone(PyrObject* queueobj, double time)
 681 {
 682         PyrSlot *schedqSlot = queueobj->slots;
 683
 684         if (IsObj(schedqSlot)) {
 685                 PyrObject *schedq = slotRawObject(schedqSlot);
 686                 PyrSlot* slots = schedq->slots;
 687                 for (int i=1; i < schedq->size; i+=3) {
 688                         SetRaw(&slots[i], slotRawFloat(&slots[i]) + time);
 689                 }
 690         }
 691 }
 692
 693 int prPriorityQueuePostpone(struct VMGlobals *g, int numArgsPushed);
 694 int prPriorityQueuePostpone(struct VMGlobals *g, int numArgsPushed)
 695 {
 696         PyrSlot *a = g->sp - 1; // priority queue
 697         PyrSlot *b = g->sp;             // time
 698
 699         double time;
 700         int err = slotDoubleVal(b, &time);
 701         if (err) return err;
 702
 703         PyrObject *queueobj = slotRawObject(a);
 704         PriorityQueuePostpone(queueobj, time);
 705         return errNone;
 706 }
 707
 708
 709 void initListPrimitives();
 710 void initListPrimitives()
 711 {
 712         int base, index;
 713
 714         base = nextPrimitiveIndex();
 715         index = 0;
 716         definePrimitive(base, index++, "_Array_AtIdentityHash", prArray_AtIdentityHash, 2, 0);
 717         definePrimitive(base, index++, "_Array_AtIdentityHashInPairs", prArray_AtIdentityHashInPairs, 2, 0);
 718         definePrimitive(base, index++, "_IdentDict_Put", prIdentDict_Put, 3, 0);
 719         definePrimitive(base, index++, "_IdentDict_PutGet", prIdentDict_PutGet, 3, 0);
 720         definePrimitive(base, index++, "_IdentDict_At", prIdentDict_At, 2, 0);
 721         definePrimitive(base, index++, "_Symbol_envirGet", prSymbol_envirGet, 1, 0);
 722         definePrimitive(base, index++, "_Symbol_envirPut", prSymbol_envirPut, 2, 0);
 723         definePrimitive(base, index++, "_ArrayMultiChannelExpand", prArrayMultiChanExpand, 1, 0);
 724
 725         definePrimitive(base, index++, "_PriorityQueueAdd", prPriorityQueueAdd, 3, 0);
 726         definePrimitive(base, index++, "_PriorityQueuePop", prPriorityQueuePop, 1, 0);
 727         definePrimitive(base, index++, "_PriorityQueueTop", prPriorityQueueTop, 1, 0);
 728         definePrimitive(base, index++, "_PriorityQueueClear", prPriorityQueueClear, 1, 0);
 729         definePrimitive(base, index++, "_PriorityQueueEmpty", prPriorityQueueEmpty, 1, 0);
 730         definePrimitive(base, index++, "_PriorityQueuePostpone", prPriorityQueuePostpone, 2, 0);
 731
 732         definePrimitive(base, index++, "_Event_Delta", prEvent_Delta, 1, 0);
 733 }
 734
 735 void initPatterns();
 736 void initPatterns()
 737 {
 738         PyrSymbol *sym;
 739
 740         ivxIdentDict_array  = instVarOffset("IdentityDictionary", "array");
 741         ivxIdentDict_size   = instVarOffset("IdentityDictionary", "size");
 742         ivxIdentDict_parent = instVarOffset("IdentityDictionary", "parent");
 743         ivxIdentDict_proto = instVarOffset("IdentityDictionary", "proto");
 744         ivxIdentDict_know = instVarOffset("IdentityDictionary", "know");
 745
 746         sym = getsym("IdentityDictionary");
 747         class_identdict = sym ? sym->u.classobj : NULL;
 748         class_identdict_index = slotRawInt(&class_identdict->classIndex);
 749         class_identdict_maxsubclassindex = slotRawInt(&class_identdict->maxSubclassIndex);
 750
 751         class_array_index = slotRawInt(&class_array->classIndex);
 752         class_array_maxsubclassindex = slotRawInt(&class_array->maxSubclassIndex);
 753
 754         s_parent = getsym("parent");
 755         s_proto = getsym("proto");
 756         s_delta = getsym("delta");
 757         s_dur = getsym("dur");
 758         s_stretch = getsym("stretch");
 759
 760 }