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