ext/threads/shared/shared.xs

   1
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6
   7 void shared_sv_attach_sv (SV* sv, shared_sv* shared) {
   8     HV* shared_hv = get_hv("threads::shared::shared", FALSE);
   9     SV* id = newSViv((IV)shared);
  10     STRLEN length = sv_len(id);
  11     SV* tiedobject;
  12     SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
  13     if(tiedobject_) {
  14         tiedobject = (*tiedobject_);
  15         SvROK_on(sv);
  16         SvRV(sv) = SvRV(tiedobject);
  17
  18     } else {
  19         croak("die\n");
  20     }
  21 }
  22
  23
  24 int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
  25     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
  26     SHAREDSvLOCK(shared);
  27     if(mg->mg_private != shared->index) {
  28         if(SvROK(SHAREDSvGET(shared))) {
  29             shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
  30             shared_sv_attach_sv(sv, target);
  31         } else {
  32             sv_setsv(sv, SHAREDSvGET(shared));
  33         }
  34         mg->mg_private = shared->index;
  35     }
  36     SHAREDSvUNLOCK(shared);
  37
  38     return 0;
  39 }
  40
  41 int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
  42     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
  43     SHAREDSvLOCK(shared);
  44     if(SvROK(SHAREDSvGET(shared)))
  45         Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
  46     if(SvROK(sv)) {
  47         shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
  48         if(!target) {
  49             sv_setsv(sv,SHAREDSvGET(shared));
  50             SHAREDSvUNLOCK(shared);
  51             Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
  52         }
  53         SHAREDSvEDIT(shared);
  54         Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
  55         SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
  56     } else {
  57             SHAREDSvEDIT(shared);
  58         sv_setsv(SHAREDSvGET(shared), sv);
  59     }
  60     shared->index++;
  61     mg->mg_private = shared->index;
  62     SHAREDSvRELEASE(shared);
  63     if(SvROK(SHAREDSvGET(shared)))
  64        Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
  65     SHAREDSvUNLOCK(shared);
  66     return 0;
  67 }
  68
  69 int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
  70     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
  71     if(!shared)
  72         return 0;
  73     Perl_sharedsv_thrcnt_dec(aTHX_ shared);
  74 }
  75
  76 MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
  77                   MEMBER_TO_FPTR(shared_sv_store_mg),
  78                   0,
  79                   0,
  80                   MEMBER_TO_FPTR(shared_sv_destroy_mg)
  81 };
  82
  83 MODULE = threads::shared                PACKAGE = threads::shared
  84
  85
  86 PROTOTYPES: DISABLE
  87
  88
  89 SV*
  90 ptr(ref)
  91         SV* ref
  92         CODE:
  93         RETVAL = newSViv(SvIV(SvRV(ref)));
  94         OUTPUT:
  95         RETVAL
  96
  97
  98 SV*
  99 _thrcnt(ref)
 100         SV* ref
 101         CODE:
 102         shared_sv* shared = Perl_sharedsv_find(aTHX, ref);
 103         if(!shared)
 104            croak("thrcnt can only be used on shared values");
 105         SHAREDSvLOCK(shared);
 106         RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
 107         SHAREDSvUNLOCK(shared);
 108         OUTPUT:
 109         RETVAL
 110
 111
 112 void
 113 thrcnt_inc(ref)
 114         SV* ref
 115         CODE:
 116         shared_sv* shared;
 117         if(SvROK(ref))
 118             ref = SvRV(ref);
 119         shared = Perl_sharedsv_find(aTHX, ref);
 120         if(!shared)
 121            croak("thrcnt can only be used on shared values");
 122         Perl_sharedsv_thrcnt_inc(aTHX_ shared);
 123
 124
 125 MODULE = threads::shared                PACKAGE = threads::shared::sv
 126
 127 SV*
 128 new(class, value)
 129         SV* class
 130         SV* value
 131         CODE:
 132         shared_sv* shared = Perl_sharedsv_new(aTHX);
 133         MAGIC* shared_magic;
 134         SV* obj = newSViv((IV)shared);
 135         SHAREDSvEDIT(shared);
 136         SHAREDSvGET(shared) = newSVsv(value);
 137         SHAREDSvRELEASE(shared);
 138         sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
 139         shared_magic = mg_find(value, PERL_MAGIC_ext);
 140         shared_magic->mg_virtual = &svtable;
 141         shared_magic->mg_obj = newSViv((IV)shared);
 142         shared_magic->mg_flags |= MGf_REFCOUNTED;
 143         shared_magic->mg_private = 0;
 144         SvMAGICAL_on(value);
 145         RETVAL = obj;
 146         OUTPUT:
 147         RETVAL
 148
 149
 150 MODULE = threads::shared                PACKAGE = threads::shared::av
 151
 152 SV*
 153 new(class, value)
 154         SV* class
 155         SV* value
 156         CODE:
 157         shared_sv* shared = Perl_sharedsv_new(aTHX);
 158         SV* obj = newSViv((IV)shared);
 159         SHAREDSvEDIT(shared);
 160         SHAREDSvGET(shared) = (SV*) newAV();
 161         SHAREDSvRELEASE(shared);
 162         RETVAL = obj;
 163         OUTPUT:
 164         RETVAL
 165
 166 void
 167 STORE(self, index, value)
 168         SV* self
 169         SV* index
 170         SV* value
 171         CODE:
 172         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 173         shared_sv* slot;
 174         SV* aentry;
 175         SV** aentry_;
 176         SHAREDSvLOCK(shared);
 177         aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
 178         if(aentry_ && SvIV((*aentry_))) {
 179             aentry = (*aentry_);
 180             slot = (shared_sv*) SvIV(aentry);
 181             if(SvROK(SHAREDSvGET(slot)))
 182                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 183             SHAREDSvEDIT(slot);
 184             sv_setsv(SHAREDSvGET(slot), value);
 185             SHAREDSvRELEASE(slot);
 186         } else {
 187             slot = Perl_sharedsv_new(aTHX);
 188             SHAREDSvEDIT(shared);
 189             SHAREDSvGET(slot) = newSVsv(value);
 190             aentry = newSViv((IV)slot);
 191             av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
 192             SHAREDSvRELEASE(shared);
 193         }
 194         SHAREDSvUNLOCK(shared);
 195
 196 SV*
 197 FETCH(self, index)
 198         SV* self
 199         SV* index
 200         CODE:
 201         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 202         shared_sv* slot;
 203         SV* aentry;
 204         SV** aentry_;
 205         SV* retval;
 206         SHAREDSvLOCK(shared);
 207         aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
 208         if(aentry_) {
 209             aentry = (*aentry_);
 210             if(SvTYPE(aentry) == SVt_NULL) {
 211                 retval = &PL_sv_undef;
 212             } else {
 213                 slot = (shared_sv*) SvIV(aentry);
 214                 retval = newSVsv(SHAREDSvGET(slot));
 215             }
 216         } else {
 217             retval = &PL_sv_undef;
 218         }
 219         SHAREDSvUNLOCK(shared);
 220         RETVAL = retval;
 221         OUTPUT:
 222         RETVAL
 223
 224 void
 225 PUSH(self, ...)
 226         SV* self
 227         CODE:
 228         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 229         int i;
 230         SHAREDSvLOCK(shared);
 231         for(i = 1; i < items; i++) {
 232             shared_sv* slot = Perl_sharedsv_new(aTHX);
 233             SV* tmp = ST(i);
 234             SHAREDSvEDIT(slot);
 235             SHAREDSvGET(slot) = newSVsv(tmp);
 236             av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
 237             SHAREDSvRELEASE(slot);
 238         }
 239         SHAREDSvUNLOCK(shared);
 240
 241 void
 242 UNSHIFT(self, ...)
 243         SV* self
 244         CODE:
 245         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 246         int i;
 247         SHAREDSvLOCK(shared);
 248         SHAREDSvEDIT(shared);
 249         av_unshift((AV*)SHAREDSvGET(shared), items - 1);
 250         SHAREDSvRELEASE(shared);
 251         for(i = 1; i < items; i++) {
 252             shared_sv* slot = Perl_sharedsv_new(aTHX);
 253             SV* tmp = ST(i);
 254             SHAREDSvEDIT(slot);
 255             SHAREDSvGET(slot) = newSVsv(tmp);
 256             av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
 257             SHAREDSvRELEASE(slot);
 258         }
 259         SHAREDSvUNLOCK(shared);
 260
 261 SV*
 262 POP(self)
 263         SV* self
 264         CODE:
 265         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 266         shared_sv* slot;
 267         SV* retval;
 268         SHAREDSvLOCK(shared);
 269         SHAREDSvEDIT(shared);
 270         retval = av_pop((AV*)SHAREDSvGET(shared));
 271         SHAREDSvRELEASE(shared);
 272         if(retval && SvIV(retval)) {
 273             slot = (shared_sv*) SvIV(retval);
 274             retval = newSVsv(SHAREDSvGET(slot));
 275             Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 276         } else {
 277             retval = &PL_sv_undef;
 278         }
 279         SHAREDSvUNLOCK(shared);
 280         RETVAL = retval;
 281         OUTPUT:
 282         RETVAL
 283
 284
 285 SV*
 286 SHIFT(self)
 287         SV* self
 288         CODE:
 289         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 290         shared_sv* slot;
 291         SV* retval;
 292         SHAREDSvLOCK(shared);
 293         SHAREDSvEDIT(shared);
 294         retval = av_shift((AV*)SHAREDSvGET(shared));
 295         SHAREDSvRELEASE(shared);
 296         if(retval && SvIV(retval)) {
 297             slot = (shared_sv*) SvIV(retval);
 298             retval = newSVsv(SHAREDSvGET(slot));
 299             Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 300         } else {
 301             retval = &PL_sv_undef;
 302         }
 303         SHAREDSvUNLOCK(shared);
 304         RETVAL = retval;
 305         OUTPUT:
 306         RETVAL
 307
 308 void
 309 CLEAR(self)
 310         SV* self
 311         CODE:
 312         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 313         shared_sv* slot;
 314         SV** svp;
 315         I32 i;
 316         SHAREDSvLOCK(shared);
 317         svp = AvARRAY((AV*)SHAREDSvGET(shared));
 318         i   = AvFILLp((AV*)SHAREDSvGET(shared));
 319         while ( i >= 0) {
 320             if(SvIV(svp[i])) {
 321                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
 322             }
 323             i--;
 324         }
 325         SHAREDSvEDIT(shared);
 326         av_clear((AV*)SHAREDSvGET(shared));
 327         SHAREDSvRELEASE(shared);
 328         SHAREDSvUNLOCK(shared);
 329
 330 void
 331 EXTEND(self, count)
 332         SV* self
 333         SV* count
 334         CODE:
 335         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 336         SHAREDSvEDIT(shared);
 337         av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
 338         SHAREDSvRELEASE(shared);
 339
 340
 341
 342
 343 SV*
 344 EXISTS(self, index)
 345         SV* self
 346         SV* index
 347         CODE:
 348         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 349         I32 exists;
 350         SHAREDSvLOCK(shared);
 351         exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
 352         if(exists) {
 353             RETVAL = &PL_sv_yes;
 354         } else {
 355             RETVAL = &PL_sv_no;
 356         }
 357         SHAREDSvUNLOCK(shared);
 358
 359 void
 360 STORESIZE(self,count)
 361         SV* self
 362         SV* count
 363         CODE:
 364         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 365         SHAREDSvEDIT(shared);
 366         av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
 367         SHAREDSvRELEASE(shared);
 368
 369 SV*
 370 FETCHSIZE(self)
 371         SV* self
 372         CODE:
 373         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 374         SHAREDSvLOCK(shared);
 375         RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
 376         SHAREDSvUNLOCK(shared);
 377         OUTPUT:
 378         RETVAL
 379
 380 SV*
 381 DELETE(self,index)
 382         SV* self
 383         SV* index
 384         CODE:
 385         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 386         shared_sv* slot;
 387         SHAREDSvLOCK(shared);
 388         if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
 389             SV* tmp;
 390             SHAREDSvEDIT(shared);
 391             tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
 392             SHAREDSvRELEASE(shared);
 393             if(SvIV(tmp)) {
 394                 slot = (shared_sv*) SvIV(tmp);
 395                 RETVAL = newSVsv(SHAREDSvGET(slot));
 396                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 397             } else {
 398                 RETVAL = &PL_sv_undef;
 399             }
 400         } else {
 401             RETVAL = &PL_sv_undef;
 402         }
 403         SHAREDSvUNLOCK(shared);
 404         OUTPUT:
 405         RETVAL
 406
 407 AV*
 408 SPLICE(self, offset, length, ...)
 409         SV* self
 410         SV* offset
 411         SV* length
 412         CODE:
 413         croak("Splice is not implmented for shared arrays");
 414
 415 MODULE = threads::shared                PACKAGE = threads::shared::hv
 416
 417 SV*
 418 new(class, value)
 419         SV* class
 420         SV* value
 421         CODE:
 422         shared_sv* shared = Perl_sharedsv_new(aTHX);
 423         SV* obj = newSViv((IV)shared);
 424         SHAREDSvEDIT(shared);
 425         SHAREDSvGET(shared) = (SV*) newHV();
 426         SHAREDSvRELEASE(shared);
 427         RETVAL = obj;
 428         OUTPUT:
 429         RETVAL
 430
 431 void
 432 STORE(self, key, value)
 433         SV* self
 434         SV* key
 435         SV* value
 436         CODE:
 437         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 438         shared_sv* slot;
 439         SV* hentry;
 440         SV** hentry_;
 441         STRLEN len;
 442         char* ckey = SvPV(key, len);
 443         SHAREDSvLOCK(shared);
 444         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
 445         if(hentry_ && SvIV((*hentry_))) {
 446             hentry = (*hentry_);
 447             slot = (shared_sv*) SvIV(hentry);
 448             if(SvROK(SHAREDSvGET(slot)))
 449                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 450             SHAREDSvEDIT(slot);
 451             sv_setsv(SHAREDSvGET(slot), value);
 452             SHAREDSvRELEASE(slot);
 453         } else {
 454             slot = Perl_sharedsv_new(aTHX);
 455             SHAREDSvEDIT(shared);
 456             SHAREDSvGET(slot) = newSVsv(value);
 457             hentry = newSViv((IV)slot);
 458             hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
 459             SHAREDSvRELEASE(shared);
 460         }
 461         SHAREDSvUNLOCK(shared);
 462
 463
 464 SV*
 465 FETCH(self, key)
 466         SV* self
 467         SV* key
 468         CODE:
 469         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 470         shared_sv* slot;
 471         SV* hentry;
 472         SV** hentry_;
 473         SV* retval;
 474         STRLEN len;
 475         char* ckey = SvPV(key, len);
 476         SHAREDSvLOCK(shared);
 477         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
 478         if(hentry_) {
 479             hentry = (*hentry_);
 480             if(SvTYPE(hentry) == SVt_NULL) {
 481                 retval = &PL_sv_undef;
 482             } else {
 483                 slot = (shared_sv*) SvIV(hentry);
 484                 retval = newSVsv(SHAREDSvGET(slot));
 485             }
 486         } else {
 487             retval = &PL_sv_undef;
 488         }
 489         SHAREDSvUNLOCK(shared);
 490         RETVAL = retval;
 491         OUTPUT:
 492         RETVAL
 493
 494 void
 495 CLEAR(self)
 496         SV* self
 497         CODE:
 498         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 499         shared_sv* slot;
 500         HE* entry;
 501         SHAREDSvLOCK(shared);
 502         Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 503         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 504         while(entry) {
 505                 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
 506                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 507                 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
 508         }
 509         SHAREDSvEDIT(shared);
 510         hv_clear((HV*) SHAREDSvGET(shared));
 511         SHAREDSvRELEASE(shared);
 512         SHAREDSvUNLOCK(shared);
 513
 514 SV*
 515 FIRSTKEY(self)
 516         SV* self
 517         CODE:
 518         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 519         char* key = NULL;
 520         I32 len;
 521         HE* entry;
 522         SHAREDSvLOCK(shared);
 523         Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 524         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 525         if(entry) {
 526                 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
 527                 RETVAL = newSVpv(key, len);
 528         } else {
 529              RETVAL = &PL_sv_undef;
 530         }
 531         SHAREDSvUNLOCK(shared);
 532         OUTPUT:
 533         RETVAL
 534
 535
 536 SV*
 537 NEXTKEY(self, oldkey)
 538         SV* self
 539         SV* oldkey
 540         CODE:
 541         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 542         char* key = NULL;
 543         I32 len;
 544         HE* entry;
 545         SHAREDSvLOCK(shared);
 546         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 547         if(entry) {
 548                 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
 549                 RETVAL = newSVpv(key, len);
 550         } else {
 551              RETVAL = &PL_sv_undef;
 552         }
 553         SHAREDSvUNLOCK(shared);
 554         OUTPUT:
 555         RETVAL
 556
 557
 558 SV*
 559 EXISTS(self, key)
 560         SV* self
 561         SV* key
 562         CODE:
 563         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 564         STRLEN len;
 565         char* ckey = SvPV(key, len);
 566         SHAREDSvLOCK(shared);
 567         if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
 568                 RETVAL = &PL_sv_yes;
 569         } else {
 570                 RETVAL = &PL_sv_no;
 571         }
 572         SHAREDSvUNLOCK(shared);
 573         OUTPUT:
 574         RETVAL
 575
 576 SV*
 577 DELETE(self, key)
 578         SV* self
 579         SV* key
 580         CODE:
 581         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 582         shared_sv* slot;
 583         STRLEN len;
 584         char* ckey = SvPV(key, len);
 585         SV* tmp;
 586         SHAREDSvLOCK(shared);
 587         SHAREDSvEDIT(shared);
 588         tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
 589         SHAREDSvRELEASE(shared);
 590         if(tmp) {
 591                 slot = SvIV(tmp);
 592                 RETVAL = newSVsv(SHAREDSvGET(slot));
 593                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 594         } else {
 595                 RETVAL = &PL_sv_undef;
 596         }
 597         SHAREDSvUNLOCK(shared);
 598         OUTPUT:
 599         RETVAL