ext/threads/shared/shared.xs

   1
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5
   6 MGVTBL svtable;
   7
   8 SV* shared_sv_attach_sv (SV* sv, shared_sv* shared) {
   9     HV* shared_hv = get_hv("threads::shared::shared", FALSE);
  10     SV* id = newSViv((IV)shared);
  11     STRLEN length = sv_len(id);
  12     SV* tiedobject;
  13     SV** tiedobject_ = hv_fetch(shared_hv, SvPV(id,length), length, 0);
  14     if(tiedobject_) {
  15         tiedobject = (*tiedobject_);
  16         if(sv) {
  17             SvROK_on(sv);
  18             SvRV(sv) = SvRV(tiedobject);
  19         } else {
  20             sv = newRV(SvRV(tiedobject));
  21         }
  22     } else {
  23         switch(SvTYPE(SHAREDSvGET(shared))) {
  24             case SVt_PVAV: {
  25                 SV* weakref;
  26                 SV* obj_ref = newSViv(0);
  27                 SV* obj = newSVrv(obj_ref,"threads::shared::av");
  28                 AV* hv = newAV();
  29                 sv_setiv(obj,(IV)shared);
  30                 weakref = newRV((SV*)hv);
  31                 sv = newRV_noinc((SV*)hv);
  32                 sv_rvweaken(weakref);
  33                 sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
  34                 hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
  35                 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
  36             }
  37             break;
  38             case SVt_PVHV: {
  39                 SV* weakref;
  40                 SV* obj_ref = newSViv(0);
  41                 SV* obj = newSVrv(obj_ref,"threads::shared::hv");
  42                 HV* hv = newHV();
  43                 sv_setiv(obj,(IV)shared);
  44                 weakref = newRV((SV*)hv);
  45                 sv = newRV_noinc((SV*)hv);
  46                 sv_rvweaken(weakref);
  47                 sv_magic((SV*) hv, obj_ref, PERL_MAGIC_tied, Nullch, 0);
  48                 hv_store(shared_hv, SvPV(id,length), length, weakref, 0);
  49                 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
  50             }
  51             break;
  52             default: {
  53                 MAGIC* shared_magic;
  54                 SV* value = newSVsv(SHAREDSvGET(shared));
  55                 SV* obj = newSViv((IV)shared);
  56                 sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
  57                 shared_magic = mg_find(value, PERL_MAGIC_ext);
  58                 shared_magic->mg_virtual = &svtable;
  59                 shared_magic->mg_obj = newSViv((IV)shared);
  60                 shared_magic->mg_flags |= MGf_REFCOUNTED;
  61                 shared_magic->mg_private = 0;
  62                 SvMAGICAL_on(value);
  63                 sv = newRV_noinc(value);
  64                 value = newRV(value);
  65                 sv_rvweaken(value);
  66                 hv_store(shared_hv, SvPV(id,length),length, value, 0);
  67                 Perl_sharedsv_thrcnt_inc(aTHX_ shared);
  68             }
  69
  70         }
  71     }
  72     return sv;
  73 }
  74
  75
  76 int shared_sv_fetch_mg (pTHX_ SV* sv, MAGIC *mg) {
  77     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
  78     SHAREDSvLOCK(shared);
  79     if(mg->mg_private != shared->index) {
  80         if(SvROK(SHAREDSvGET(shared))) {
  81             shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared)));
  82             shared_sv_attach_sv(sv, target);
  83         } else {
  84             sv_setsv(sv, SHAREDSvGET(shared));
  85         }
  86         mg->mg_private = shared->index;
  87     }
  88     SHAREDSvUNLOCK(shared);
  89
  90     return 0;
  91 }
  92
  93 int shared_sv_store_mg (pTHX_ SV* sv, MAGIC *mg) {
  94     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
  95     SHAREDSvLOCK(shared);
  96     if(SvROK(SHAREDSvGET(shared)))
  97         Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
  98     if(SvROK(sv)) {
  99         shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(sv));
 100         if(!target) {
 101             sv_setsv(sv,SHAREDSvGET(shared));
 102             SHAREDSvUNLOCK(shared);
 103             Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared scalar");
 104         }
 105         SHAREDSvEDIT(shared);
 106         Perl_sv_free(PL_sharedsv_space,SHAREDSvGET(shared));
 107         SHAREDSvGET(shared) = newRV_noinc(newSViv((IV)target));
 108     } else {
 109             SHAREDSvEDIT(shared);
 110         sv_setsv(SHAREDSvGET(shared), sv);
 111     }
 112     shared->index++;
 113     mg->mg_private = shared->index;
 114     SHAREDSvRELEASE(shared);
 115     if(SvROK(SHAREDSvGET(shared)))
 116        Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(shared))));
 117     SHAREDSvUNLOCK(shared);
 118     return 0;
 119 }
 120
 121 int shared_sv_destroy_mg (pTHX_ SV* sv, MAGIC *mg) {
 122     shared_sv* shared = (shared_sv*) SvIV(mg->mg_obj);
 123     if(!shared)
 124         return 0;
 125     {
 126         HV* shared_hv = get_hv("threads::shared::shared", FALSE);
 127         SV* id = newSViv((IV)shared);
 128         STRLEN length = sv_len(id);
 129         hv_delete(shared_hv, SvPV(id,length), length,0);
 130     }
 131     Perl_sharedsv_thrcnt_dec(aTHX_ shared);
 132 }
 133
 134 MGVTBL svtable = {MEMBER_TO_FPTR(shared_sv_fetch_mg),
 135                   MEMBER_TO_FPTR(shared_sv_store_mg),
 136                   0,
 137                   0,
 138                   MEMBER_TO_FPTR(shared_sv_destroy_mg)
 139 };
 140
 141 MODULE = threads::shared                PACKAGE = threads::shared
 142
 143
 144 PROTOTYPES: ENABLE
 145
 146
 147 SV*
 148 ptr(ref)
 149         SV* ref
 150         CODE:
 151         RETVAL = newSViv(SvIV(SvRV(ref)));
 152         OUTPUT:
 153         RETVAL
 154
 155
 156 SV*
 157 _thrcnt(ref)
 158         SV* ref
 159         CODE:
 160         shared_sv* shared;
 161         if(SvROK(ref))
 162             ref = SvRV(ref);
 163         shared = Perl_sharedsv_find(aTHX, ref);
 164         if(!shared)
 165            croak("thrcnt can only be used on shared values");
 166         SHAREDSvLOCK(shared);
 167         RETVAL = newSViv(SvREFCNT(SHAREDSvGET(shared)));
 168         SHAREDSvUNLOCK(shared);
 169         OUTPUT:
 170         RETVAL
 171
 172
 173 void
 174 thrcnt_inc(ref,perl)
 175         SV* ref
 176         SV* perl
 177         CODE:
 178         shared_sv* shared;
 179         PerlInterpreter* origperl = (PerlInterpreter*) SvIV(perl);
 180         PerlInterpreter* oldperl = PERL_GET_CONTEXT;
 181         if(SvROK(ref))
 182             ref = SvRV(ref);
 183         shared = Perl_sharedsv_find(aTHX, ref);
 184         if(!shared)
 185            croak("thrcnt can only be used on shared values");
 186         PERL_SET_CONTEXT(origperl);
 187         Perl_sharedsv_thrcnt_inc(aTHX_ shared);
 188         PERL_SET_CONTEXT(oldperl);
 189
 190 void
 191 _thrcnt_dec(ref)
 192         SV* ref
 193         CODE:
 194         shared_sv* shared = (shared_sv*) SvIV(ref);
 195         if(!shared)
 196            croak("thrcnt can only be used on shared values");
 197         Perl_sharedsv_thrcnt_dec(aTHX_ shared);
 198
 199 void
 200 unlock_enabled(ref)
 201         SV* ref
 202         PROTOTYPE: \[$@%]
 203         CODE:
 204         shared_sv* shared;
 205         if(SvROK(ref))
 206             ref = SvRV(ref);
 207         shared = Perl_sharedsv_find(aTHX, ref);
 208         if(!shared)
 209            croak("unlock can only be used on shared values");
 210         SHAREDSvUNLOCK(shared);
 211
 212 void
 213 lock_enabled(ref)
 214         SV* ref
 215         CODE:
 216         shared_sv* shared;
 217         if(SvROK(ref))
 218             ref = SvRV(ref);
 219         shared = Perl_sharedsv_find(aTHX, ref);
 220         if(!shared)
 221            croak("lock can only be used on shared values");
 222         SHAREDSvLOCK(shared);
 223
 224
 225 void
 226 cond_wait_enabled(ref)
 227         SV* ref
 228         PROTOTYPE: \[$@%]
 229         CODE:
 230         shared_sv* shared;
 231         int locks;
 232         if(SvROK(ref))
 233             ref = SvRV(ref);
 234         shared = Perl_sharedsv_find(aTHX_ ref);
 235         if(!shared)
 236             croak("cond_wait can only be used on shared values");
 237         if(shared->owner != PERL_GET_CONTEXT)
 238             croak("You need a lock before you can cond_wait");
 239         MUTEX_LOCK(&shared->mutex);
 240         shared->owner = NULL;
 241         locks = shared->locks = 0;
 242         COND_WAIT(&shared->user_cond, &shared->mutex);
 243         shared->owner = PERL_GET_CONTEXT;
 244         shared->locks = locks;
 245         MUTEX_UNLOCK(&shared->mutex);
 246
 247 void cond_signal_enabled(ref)
 248         SV* ref
 249         PROTOTYPE: \[$@%]
 250         CODE:
 251         shared_sv* shared;
 252         if(SvROK(ref))
 253             ref = SvRV(ref);
 254         shared = Perl_sharedsv_find(aTHX_ ref);
 255         if(!shared)
 256             croak("cond_signal can only be used on shared values");
 257         COND_SIGNAL(&shared->user_cond);
 258
 259
 260 void cond_broadcast_enabled(ref)
 261         SV* ref
 262         PROTOTYPE: \[$@%]
 263         CODE:
 264         shared_sv* shared;
 265         if(SvROK(ref))
 266             ref = SvRV(ref);
 267         shared = Perl_sharedsv_find(aTHX_ ref);
 268         if(!shared)
 269             croak("cond_broadcast can only be used on shared values");
 270         COND_BROADCAST(&shared->user_cond);
 271
 272 MODULE = threads::shared                PACKAGE = threads::shared::sv
 273
 274 SV*
 275 new(class, value)
 276         SV* class
 277         SV* value
 278         CODE:
 279         shared_sv* shared = Perl_sharedsv_new(aTHX);
 280         MAGIC* shared_magic;
 281         SV* obj = newSViv((IV)shared);
 282         SHAREDSvEDIT(shared);
 283         SHAREDSvGET(shared) = newSVsv(value);
 284         SHAREDSvRELEASE(shared);
 285         sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
 286         shared_magic = mg_find(value, PERL_MAGIC_ext);
 287         shared_magic->mg_virtual = &svtable;
 288         shared_magic->mg_obj = newSViv((IV)shared);
 289         shared_magic->mg_flags |= MGf_REFCOUNTED;
 290         shared_magic->mg_private = 0;
 291         SvMAGICAL_on(value);
 292         RETVAL = obj;
 293         OUTPUT:
 294         RETVAL
 295
 296
 297 MODULE = threads::shared                PACKAGE = threads::shared::av
 298
 299 SV*
 300 new(class, value)
 301         SV* class
 302         SV* value
 303         CODE:
 304         shared_sv* shared = Perl_sharedsv_new(aTHX);
 305         SV* obj = newSViv((IV)shared);
 306         SHAREDSvEDIT(shared);
 307         SHAREDSvGET(shared) = (SV*) newAV();
 308         SHAREDSvRELEASE(shared);
 309         RETVAL = obj;
 310         OUTPUT:
 311         RETVAL
 312
 313 void
 314 STORE(self, index, value)
 315         SV* self
 316         SV* index
 317         SV* value
 318         CODE:
 319         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 320         shared_sv* slot;
 321         SV* aentry;
 322         SV** aentry_;
 323         if(SvROK(value)) {
 324             shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
 325             if(!target) {
 326                  Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
 327             }
 328             value = newRV_noinc(newSViv((IV)target));
 329         }
 330         SHAREDSvLOCK(shared);
 331         aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
 332         if(aentry_ && SvIV((*aentry_))) {
 333             aentry = (*aentry_);
 334             slot = (shared_sv*) SvIV(aentry);
 335             if(SvROK(SHAREDSvGET(slot)))
 336                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 337             SHAREDSvEDIT(slot);
 338             sv_setsv(SHAREDSvGET(slot), value);
 339             SHAREDSvRELEASE(slot);
 340         } else {
 341             slot = Perl_sharedsv_new(aTHX);
 342             SHAREDSvEDIT(shared);
 343             SHAREDSvGET(slot) = newSVsv(value);
 344             aentry = newSViv((IV)slot);
 345             av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
 346             SHAREDSvRELEASE(shared);
 347         }
 348         if(SvROK(SHAREDSvGET(slot)))
 349             Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 350
 351         SHAREDSvUNLOCK(shared);
 352
 353 SV*
 354 FETCH(self, index)
 355         SV* self
 356         SV* index
 357         CODE:
 358         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 359         shared_sv* slot;
 360         SV* aentry;
 361         SV** aentry_;
 362         SV* retval;
 363         SHAREDSvLOCK(shared);
 364         aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
 365         if(aentry_) {
 366             aentry = (*aentry_);
 367             if(SvTYPE(aentry) == SVt_NULL) {
 368                 retval = &PL_sv_undef;
 369             } else {
 370                 slot = (shared_sv*) SvIV(aentry);
 371                 if(SvROK(SHAREDSvGET(slot))) {
 372                      shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 373                      retval = shared_sv_attach_sv(NULL,target);
 374                 } else {
 375                      retval = newSVsv(SHAREDSvGET(slot));
 376                 }
 377             }
 378         } else {
 379             retval = &PL_sv_undef;
 380         }
 381         SHAREDSvUNLOCK(shared);
 382         RETVAL = retval;
 383         OUTPUT:
 384         RETVAL
 385
 386 void
 387 PUSH(self, ...)
 388         SV* self
 389         CODE:
 390         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 391         int i;
 392         SHAREDSvLOCK(shared);
 393         for(i = 1; i < items; i++) {
 394             shared_sv* slot = Perl_sharedsv_new(aTHX);
 395             SV* tmp = ST(i);
 396             if(SvROK(tmp)) {
 397                  shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
 398                  if(!target) {
 399                      Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
 400                  }
 401                  tmp = newRV_noinc(newSViv((IV)target));
 402             }
 403             SHAREDSvEDIT(slot);
 404             SHAREDSvGET(slot) = newSVsv(tmp);
 405             av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
 406             SHAREDSvRELEASE(slot);
 407             if(SvROK(SHAREDSvGET(slot)))
 408                 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 409         }
 410         SHAREDSvUNLOCK(shared);
 411
 412 void
 413 UNSHIFT(self, ...)
 414         SV* self
 415         CODE:
 416         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 417         int i;
 418         SHAREDSvLOCK(shared);
 419         SHAREDSvEDIT(shared);
 420         av_unshift((AV*)SHAREDSvGET(shared), items - 1);
 421         SHAREDSvRELEASE(shared);
 422         for(i = 1; i < items; i++) {
 423             shared_sv* slot = Perl_sharedsv_new(aTHX);
 424             SV* tmp = ST(i);
 425             if(SvROK(tmp)) {
 426                  shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
 427                  if(!target) {
 428                      Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
 429                  }
 430                  tmp = newRV_noinc(newSViv((IV)target));
 431             }
 432             SHAREDSvEDIT(slot);
 433             SHAREDSvGET(slot) = newSVsv(tmp);
 434             av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
 435             SHAREDSvRELEASE(slot);
 436             if(SvROK(SHAREDSvGET(slot)))
 437                 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 438         }
 439         SHAREDSvUNLOCK(shared);
 440
 441 SV*
 442 POP(self)
 443         SV* self
 444         CODE:
 445         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 446         shared_sv* slot;
 447         SV* retval;
 448         SHAREDSvLOCK(shared);
 449         SHAREDSvEDIT(shared);
 450         retval = av_pop((AV*)SHAREDSvGET(shared));
 451         SHAREDSvRELEASE(shared);
 452         if(retval && SvIV(retval)) {
 453             slot = (shared_sv*) SvIV(retval);
 454             if(SvROK(SHAREDSvGET(slot))) {
 455                  shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 456                  retval = shared_sv_attach_sv(NULL,target);
 457             } else {
 458                  retval = newSVsv(SHAREDSvGET(slot));
 459             }
 460             Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 461         } else {
 462             retval = &PL_sv_undef;
 463         }
 464         SHAREDSvUNLOCK(shared);
 465         RETVAL = retval;
 466         OUTPUT:
 467         RETVAL
 468
 469
 470 SV*
 471 SHIFT(self)
 472         SV* self
 473         CODE:
 474         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 475         shared_sv* slot;
 476         SV* retval;
 477         SHAREDSvLOCK(shared);
 478         SHAREDSvEDIT(shared);
 479         retval = av_shift((AV*)SHAREDSvGET(shared));
 480         SHAREDSvRELEASE(shared);
 481         if(retval && SvIV(retval)) {
 482             slot = (shared_sv*) SvIV(retval);
 483             if(SvROK(SHAREDSvGET(slot))) {
 484                  shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 485                  retval = shared_sv_attach_sv(NULL,target);
 486             } else {
 487                  retval = newSVsv(SHAREDSvGET(slot));
 488             }
 489             Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 490         } else {
 491             retval = &PL_sv_undef;
 492         }
 493         SHAREDSvUNLOCK(shared);
 494         RETVAL = retval;
 495         OUTPUT:
 496         RETVAL
 497
 498 void
 499 CLEAR(self)
 500         SV* self
 501         CODE:
 502         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 503         shared_sv* slot;
 504         SV** svp;
 505         I32 i;
 506         SHAREDSvLOCK(shared);
 507         svp = AvARRAY((AV*)SHAREDSvGET(shared));
 508         i   = AvFILLp((AV*)SHAREDSvGET(shared));
 509         while ( i >= 0) {
 510             if(SvIV(svp[i])) {
 511                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
 512             }
 513             i--;
 514         }
 515         SHAREDSvEDIT(shared);
 516         av_clear((AV*)SHAREDSvGET(shared));
 517         SHAREDSvRELEASE(shared);
 518         SHAREDSvUNLOCK(shared);
 519
 520 void
 521 EXTEND(self, count)
 522         SV* self
 523         SV* count
 524         CODE:
 525         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 526         SHAREDSvEDIT(shared);
 527         av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
 528         SHAREDSvRELEASE(shared);
 529
 530
 531
 532
 533 SV*
 534 EXISTS(self, index)
 535         SV* self
 536         SV* index
 537         CODE:
 538         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 539         I32 exists;
 540         SHAREDSvLOCK(shared);
 541         exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
 542         if(exists) {
 543             RETVAL = &PL_sv_yes;
 544         } else {
 545             RETVAL = &PL_sv_no;
 546         }
 547         SHAREDSvUNLOCK(shared);
 548
 549 void
 550 STORESIZE(self,count)
 551         SV* self
 552         SV* count
 553         CODE:
 554         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 555         SHAREDSvEDIT(shared);
 556         av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
 557         SHAREDSvRELEASE(shared);
 558
 559 SV*
 560 FETCHSIZE(self)
 561         SV* self
 562         CODE:
 563         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 564         SHAREDSvLOCK(shared);
 565         RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
 566         SHAREDSvUNLOCK(shared);
 567         OUTPUT:
 568         RETVAL
 569
 570 SV*
 571 DELETE(self,index)
 572         SV* self
 573         SV* index
 574         CODE:
 575         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 576         shared_sv* slot;
 577         SHAREDSvLOCK(shared);
 578         if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
 579             SV* tmp;
 580             SHAREDSvEDIT(shared);
 581             tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
 582             SHAREDSvRELEASE(shared);
 583             if(SvIV(tmp)) {
 584                 slot = (shared_sv*) SvIV(tmp);
 585                 if(SvROK(SHAREDSvGET(slot))) {
 586                    shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 587                    RETVAL = shared_sv_attach_sv(NULL,target);
 588                 } else {
 589                    RETVAL = newSVsv(SHAREDSvGET(slot));
 590                 }
 591                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 592             } else {
 593                 RETVAL = &PL_sv_undef;
 594             }
 595         } else {
 596             RETVAL = &PL_sv_undef;
 597         }
 598         SHAREDSvUNLOCK(shared);
 599         OUTPUT:
 600         RETVAL
 601
 602 AV*
 603 SPLICE(self, offset, length, ...)
 604         SV* self
 605         SV* offset
 606         SV* length
 607         CODE:
 608         croak("Splice is not implmented for shared arrays");
 609
 610 MODULE = threads::shared                PACKAGE = threads::shared::hv
 611
 612 SV*
 613 new(class, value)
 614         SV* class
 615         SV* value
 616         CODE:
 617         shared_sv* shared = Perl_sharedsv_new(aTHX);
 618         SV* obj = newSViv((IV)shared);
 619         SHAREDSvEDIT(shared);
 620         SHAREDSvGET(shared) = (SV*) newHV();
 621         SHAREDSvRELEASE(shared);
 622         RETVAL = obj;
 623         OUTPUT:
 624         RETVAL
 625
 626 void
 627 STORE(self, key, value)
 628         SV* self
 629         SV* key
 630         SV* value
 631         CODE:
 632         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 633         shared_sv* slot;
 634         SV* hentry;
 635         SV** hentry_;
 636         STRLEN len;
 637         char* ckey = SvPV(key, len);
 638         SHAREDSvLOCK(shared);
 639         if(SvROK(value)) {
 640             shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
 641             if(!target) {
 642                 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
 643             }
 644             SHAREDSvEDIT(shared);
 645             value = newRV_noinc(newSViv((IV)target));
 646             SHAREDSvRELEASE(shared);
 647         }
 648         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
 649         if(hentry_ && SvIV((*hentry_))) {
 650             hentry = (*hentry_);
 651             slot = (shared_sv*) SvIV(hentry);
 652             if(SvROK(SHAREDSvGET(slot)))
 653                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 654             SHAREDSvEDIT(slot);
 655             sv_setsv(SHAREDSvGET(slot), value);
 656             SHAREDSvRELEASE(slot);
 657         } else {
 658             slot = Perl_sharedsv_new(aTHX);
 659             SHAREDSvEDIT(shared);
 660             SHAREDSvGET(slot) = newSVsv(value);
 661             hentry = newSViv((IV)slot);
 662             hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
 663             SHAREDSvRELEASE(shared);
 664         }
 665         if(SvROK(SHAREDSvGET(slot)))
 666             Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 667         SHAREDSvUNLOCK(shared);
 668
 669
 670 SV*
 671 FETCH(self, key)
 672         SV* self
 673         SV* key
 674         CODE:
 675         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 676         shared_sv* slot;
 677         SV* hentry;
 678         SV** hentry_;
 679         SV* retval;
 680         STRLEN len;
 681         char* ckey = SvPV(key, len);
 682         SHAREDSvLOCK(shared);
 683         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
 684         if(hentry_) {
 685             hentry = (*hentry_);
 686             if(SvTYPE(hentry) == SVt_NULL) {
 687                 retval = &PL_sv_undef;
 688             } else {
 689                 slot = (shared_sv*) SvIV(hentry);
 690                 if(SvROK(SHAREDSvGET(slot))) {
 691                     shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 692                     retval = shared_sv_attach_sv(NULL, target);
 693                 } else {
 694                     retval = newSVsv(SHAREDSvGET(slot));
 695                 }
 696             }
 697         } else {
 698             retval = &PL_sv_undef;
 699         }
 700         SHAREDSvUNLOCK(shared);
 701         RETVAL = retval;
 702         OUTPUT:
 703         RETVAL
 704
 705 void
 706 CLEAR(self)
 707         SV* self
 708         CODE:
 709         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 710         shared_sv* slot;
 711         HE* entry;
 712         SHAREDSvLOCK(shared);
 713         Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 714         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 715         while(entry) {
 716                 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
 717                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 718                 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
 719         }
 720         SHAREDSvEDIT(shared);
 721         hv_clear((HV*) SHAREDSvGET(shared));
 722         SHAREDSvRELEASE(shared);
 723         SHAREDSvUNLOCK(shared);
 724
 725 SV*
 726 FIRSTKEY(self)
 727         SV* self
 728         CODE:
 729         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 730         char* key = NULL;
 731         I32 len;
 732         HE* entry;
 733         SHAREDSvLOCK(shared);
 734         Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 735         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 736         if(entry) {
 737                 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
 738                 RETVAL = newSVpv(key, len);
 739         } else {
 740              RETVAL = &PL_sv_undef;
 741         }
 742         SHAREDSvUNLOCK(shared);
 743         OUTPUT:
 744         RETVAL
 745
 746
 747 SV*
 748 NEXTKEY(self, oldkey)
 749         SV* self
 750         SV* oldkey
 751         CODE:
 752         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 753         char* key = NULL;
 754         I32 len;
 755         HE* entry;
 756         SHAREDSvLOCK(shared);
 757         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 758         if(entry) {
 759                 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
 760                 RETVAL = newSVpv(key, len);
 761         } else {
 762              RETVAL = &PL_sv_undef;
 763         }
 764         SHAREDSvUNLOCK(shared);
 765         OUTPUT:
 766         RETVAL
 767
 768
 769 SV*
 770 EXISTS(self, key)
 771         SV* self
 772         SV* key
 773         CODE:
 774         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 775         STRLEN len;
 776         char* ckey = SvPV(key, len);
 777         SHAREDSvLOCK(shared);
 778         if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
 779                 RETVAL = &PL_sv_yes;
 780         } else {
 781                 RETVAL = &PL_sv_no;
 782         }
 783         SHAREDSvUNLOCK(shared);
 784         OUTPUT:
 785         RETVAL
 786
 787 SV*
 788 DELETE(self, key)
 789         SV* self
 790         SV* key
 791         CODE:
 792         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 793         shared_sv* slot;
 794         STRLEN len;
 795         char* ckey = SvPV(key, len);
 796         SV* tmp;
 797         SHAREDSvLOCK(shared);
 798         SHAREDSvEDIT(shared);
 799         tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
 800         SHAREDSvRELEASE(shared);
 801         if(tmp) {
 802                 slot = (shared_sv*) SvIV(tmp);
 803                 if(SvROK(SHAREDSvGET(slot))) {
 804                     shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 805                     RETVAL = shared_sv_attach_sv(NULL, target);
 806                 } else {
 807                     RETVAL = newSVsv(SHAREDSvGET(slot));
 808                 }
 809                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 810         } else {
 811                 RETVAL = &PL_sv_undef;
 812         }
 813         SHAREDSvUNLOCK(shared);
 814         OUTPUT:
 815         RETVAL