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: DISABLE
 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)
 175         SV* ref
 176         CODE:
 177         shared_sv* shared;
 178         if(SvROK(ref))
 179             ref = SvRV(ref);
 180         shared = Perl_sharedsv_find(aTHX, ref);
 181         if(!shared)
 182            croak("thrcnt can only be used on shared values");
 183         Perl_sharedsv_thrcnt_inc(aTHX_ shared);
 184
 185 void
 186 _thrcnt_dec(ref)
 187         SV* ref
 188         CODE:
 189         shared_sv* shared = (shared_sv*) SvIV(ref);
 190         if(!shared)
 191            croak("thrcnt can only be used on shared values");
 192         Perl_sharedsv_thrcnt_dec(aTHX_ shared);
 193
 194
 195 MODULE = threads::shared                PACKAGE = threads::shared::sv
 196
 197 SV*
 198 new(class, value)
 199         SV* class
 200         SV* value
 201         CODE:
 202         shared_sv* shared = Perl_sharedsv_new(aTHX);
 203         MAGIC* shared_magic;
 204         SV* obj = newSViv((IV)shared);
 205         SHAREDSvEDIT(shared);
 206         SHAREDSvGET(shared) = newSVsv(value);
 207         SHAREDSvRELEASE(shared);
 208         sv_magic(value, 0, PERL_MAGIC_ext, "threads::shared", 16);
 209         shared_magic = mg_find(value, PERL_MAGIC_ext);
 210         shared_magic->mg_virtual = &svtable;
 211         shared_magic->mg_obj = newSViv((IV)shared);
 212         shared_magic->mg_flags |= MGf_REFCOUNTED;
 213         shared_magic->mg_private = 0;
 214         SvMAGICAL_on(value);
 215         RETVAL = obj;
 216         OUTPUT:
 217         RETVAL
 218
 219
 220 MODULE = threads::shared                PACKAGE = threads::shared::av
 221
 222 SV*
 223 new(class, value)
 224         SV* class
 225         SV* value
 226         CODE:
 227         shared_sv* shared = Perl_sharedsv_new(aTHX);
 228         SV* obj = newSViv((IV)shared);
 229         SHAREDSvEDIT(shared);
 230         SHAREDSvGET(shared) = (SV*) newAV();
 231         SHAREDSvRELEASE(shared);
 232         RETVAL = obj;
 233         OUTPUT:
 234         RETVAL
 235
 236 void
 237 STORE(self, index, value)
 238         SV* self
 239         SV* index
 240         SV* value
 241         CODE:
 242         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 243         shared_sv* slot;
 244         SV* aentry;
 245         SV** aentry_;
 246         if(SvROK(value)) {
 247             shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
 248             if(!target) {
 249                  Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
 250             }
 251             value = newRV_noinc(newSViv((IV)target));
 252         }
 253         SHAREDSvLOCK(shared);
 254         aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index), 0);
 255         if(aentry_ && SvIV((*aentry_))) {
 256             aentry = (*aentry_);
 257             slot = (shared_sv*) SvIV(aentry);
 258             if(SvROK(SHAREDSvGET(slot)))
 259                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 260             SHAREDSvEDIT(slot);
 261             sv_setsv(SHAREDSvGET(slot), value);
 262             SHAREDSvRELEASE(slot);
 263         } else {
 264             slot = Perl_sharedsv_new(aTHX);
 265             SHAREDSvEDIT(shared);
 266             SHAREDSvGET(slot) = newSVsv(value);
 267             aentry = newSViv((IV)slot);
 268             av_store((AV*) SHAREDSvGET(shared), SvIV(index), aentry);
 269             SHAREDSvRELEASE(shared);
 270         }
 271         if(SvROK(SHAREDSvGET(slot)))
 272             Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 273
 274         SHAREDSvUNLOCK(shared);
 275
 276 SV*
 277 FETCH(self, index)
 278         SV* self
 279         SV* index
 280         CODE:
 281         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 282         shared_sv* slot;
 283         SV* aentry;
 284         SV** aentry_;
 285         SV* retval;
 286         SHAREDSvLOCK(shared);
 287         aentry_ = av_fetch((AV*) SHAREDSvGET(shared), SvIV(index),0);
 288         if(aentry_) {
 289             aentry = (*aentry_);
 290             if(SvTYPE(aentry) == SVt_NULL) {
 291                 retval = &PL_sv_undef;
 292             } else {
 293                 slot = (shared_sv*) SvIV(aentry);
 294                 if(SvROK(SHAREDSvGET(slot))) {
 295                      shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 296                      retval = shared_sv_attach_sv(NULL,target);
 297                 } else {
 298                      retval = newSVsv(SHAREDSvGET(slot));
 299                 }
 300             }
 301         } else {
 302             retval = &PL_sv_undef;
 303         }
 304         SHAREDSvUNLOCK(shared);
 305         RETVAL = retval;
 306         OUTPUT:
 307         RETVAL
 308
 309 void
 310 PUSH(self, ...)
 311         SV* self
 312         CODE:
 313         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 314         int i;
 315         SHAREDSvLOCK(shared);
 316         for(i = 1; i < items; i++) {
 317             shared_sv* slot = Perl_sharedsv_new(aTHX);
 318             SV* tmp = ST(i);
 319             if(SvROK(tmp)) {
 320                  shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
 321                  if(!target) {
 322                      Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
 323                  }
 324                  tmp = newRV_noinc(newSViv((IV)target));
 325             }
 326             SHAREDSvEDIT(slot);
 327             SHAREDSvGET(slot) = newSVsv(tmp);
 328             av_push((AV*) SHAREDSvGET(shared), newSViv((IV)slot));
 329             SHAREDSvRELEASE(slot);
 330             if(SvROK(SHAREDSvGET(slot)))
 331                 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 332         }
 333         SHAREDSvUNLOCK(shared);
 334
 335 void
 336 UNSHIFT(self, ...)
 337         SV* self
 338         CODE:
 339         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 340         int i;
 341         SHAREDSvLOCK(shared);
 342         SHAREDSvEDIT(shared);
 343         av_unshift((AV*)SHAREDSvGET(shared), items - 1);
 344         SHAREDSvRELEASE(shared);
 345         for(i = 1; i < items; i++) {
 346             shared_sv* slot = Perl_sharedsv_new(aTHX);
 347             SV* tmp = ST(i);
 348             if(SvROK(tmp)) {
 349                  shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(tmp));
 350                  if(!target) {
 351                      Perl_croak(aTHX_ "You cannot assign a non shared reference to an shared array");
 352                  }
 353                  tmp = newRV_noinc(newSViv((IV)target));
 354             }
 355             SHAREDSvEDIT(slot);
 356             SHAREDSvGET(slot) = newSVsv(tmp);
 357             av_store((AV*) SHAREDSvGET(shared), i - 1, newSViv((IV)slot));
 358             SHAREDSvRELEASE(slot);
 359             if(SvROK(SHAREDSvGET(slot)))
 360                 Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 361         }
 362         SHAREDSvUNLOCK(shared);
 363
 364 SV*
 365 POP(self)
 366         SV* self
 367         CODE:
 368         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 369         shared_sv* slot;
 370         SV* retval;
 371         SHAREDSvLOCK(shared);
 372         SHAREDSvEDIT(shared);
 373         retval = av_pop((AV*)SHAREDSvGET(shared));
 374         SHAREDSvRELEASE(shared);
 375         if(retval && SvIV(retval)) {
 376             slot = (shared_sv*) SvIV(retval);
 377             if(SvROK(SHAREDSvGET(slot))) {
 378                  shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 379                  retval = shared_sv_attach_sv(NULL,target);
 380             } else {
 381                  retval = newSVsv(SHAREDSvGET(slot));
 382             }
 383             Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 384         } else {
 385             retval = &PL_sv_undef;
 386         }
 387         SHAREDSvUNLOCK(shared);
 388         RETVAL = retval;
 389         OUTPUT:
 390         RETVAL
 391
 392
 393 SV*
 394 SHIFT(self)
 395         SV* self
 396         CODE:
 397         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 398         shared_sv* slot;
 399         SV* retval;
 400         SHAREDSvLOCK(shared);
 401         SHAREDSvEDIT(shared);
 402         retval = av_shift((AV*)SHAREDSvGET(shared));
 403         SHAREDSvRELEASE(shared);
 404         if(retval && SvIV(retval)) {
 405             slot = (shared_sv*) SvIV(retval);
 406             if(SvROK(SHAREDSvGET(slot))) {
 407                  shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 408                  retval = shared_sv_attach_sv(NULL,target);
 409             } else {
 410                  retval = newSVsv(SHAREDSvGET(slot));
 411             }
 412             Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 413         } else {
 414             retval = &PL_sv_undef;
 415         }
 416         SHAREDSvUNLOCK(shared);
 417         RETVAL = retval;
 418         OUTPUT:
 419         RETVAL
 420
 421 void
 422 CLEAR(self)
 423         SV* self
 424         CODE:
 425         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 426         shared_sv* slot;
 427         SV** svp;
 428         I32 i;
 429         SHAREDSvLOCK(shared);
 430         svp = AvARRAY((AV*)SHAREDSvGET(shared));
 431         i   = AvFILLp((AV*)SHAREDSvGET(shared));
 432         while ( i >= 0) {
 433             if(SvIV(svp[i])) {
 434                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(svp[i]));
 435             }
 436             i--;
 437         }
 438         SHAREDSvEDIT(shared);
 439         av_clear((AV*)SHAREDSvGET(shared));
 440         SHAREDSvRELEASE(shared);
 441         SHAREDSvUNLOCK(shared);
 442
 443 void
 444 EXTEND(self, count)
 445         SV* self
 446         SV* count
 447         CODE:
 448         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 449         SHAREDSvEDIT(shared);
 450         av_extend((AV*)SHAREDSvGET(shared), (I32) SvIV(count));
 451         SHAREDSvRELEASE(shared);
 452
 453
 454
 455
 456 SV*
 457 EXISTS(self, index)
 458         SV* self
 459         SV* index
 460         CODE:
 461         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 462         I32 exists;
 463         SHAREDSvLOCK(shared);
 464         exists = av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index));
 465         if(exists) {
 466             RETVAL = &PL_sv_yes;
 467         } else {
 468             RETVAL = &PL_sv_no;
 469         }
 470         SHAREDSvUNLOCK(shared);
 471
 472 void
 473 STORESIZE(self,count)
 474         SV* self
 475         SV* count
 476         CODE:
 477         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 478         SHAREDSvEDIT(shared);
 479         av_fill((AV*) SHAREDSvGET(shared), (I32) SvIV(count));
 480         SHAREDSvRELEASE(shared);
 481
 482 SV*
 483 FETCHSIZE(self)
 484         SV* self
 485         CODE:
 486         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 487         SHAREDSvLOCK(shared);
 488         RETVAL = newSViv(av_len((AV*) SHAREDSvGET(shared)) + 1);
 489         SHAREDSvUNLOCK(shared);
 490         OUTPUT:
 491         RETVAL
 492
 493 SV*
 494 DELETE(self,index)
 495         SV* self
 496         SV* index
 497         CODE:
 498         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 499         shared_sv* slot;
 500         SHAREDSvLOCK(shared);
 501         if(av_exists((AV*) SHAREDSvGET(shared), (I32) SvIV(index))) {
 502             SV* tmp;
 503             SHAREDSvEDIT(shared);
 504             tmp = av_delete((AV*)SHAREDSvGET(shared), (I32) SvIV(index),0);
 505             SHAREDSvRELEASE(shared);
 506             if(SvIV(tmp)) {
 507                 slot = (shared_sv*) SvIV(tmp);
 508                 if(SvROK(SHAREDSvGET(slot))) {
 509                    shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 510                    RETVAL = shared_sv_attach_sv(NULL,target);
 511                 } else {
 512                    RETVAL = newSVsv(SHAREDSvGET(slot));
 513                 }
 514                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 515             } else {
 516                 RETVAL = &PL_sv_undef;
 517             }
 518         } else {
 519             RETVAL = &PL_sv_undef;
 520         }
 521         SHAREDSvUNLOCK(shared);
 522         OUTPUT:
 523         RETVAL
 524
 525 AV*
 526 SPLICE(self, offset, length, ...)
 527         SV* self
 528         SV* offset
 529         SV* length
 530         CODE:
 531         croak("Splice is not implmented for shared arrays");
 532
 533 MODULE = threads::shared                PACKAGE = threads::shared::hv
 534
 535 SV*
 536 new(class, value)
 537         SV* class
 538         SV* value
 539         CODE:
 540         shared_sv* shared = Perl_sharedsv_new(aTHX);
 541         SV* obj = newSViv((IV)shared);
 542         SHAREDSvEDIT(shared);
 543         SHAREDSvGET(shared) = (SV*) newHV();
 544         SHAREDSvRELEASE(shared);
 545         RETVAL = obj;
 546         OUTPUT:
 547         RETVAL
 548
 549 void
 550 STORE(self, key, value)
 551         SV* self
 552         SV* key
 553         SV* value
 554         CODE:
 555         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 556         shared_sv* slot;
 557         SV* hentry;
 558         SV** hentry_;
 559         STRLEN len;
 560         char* ckey = SvPV(key, len);
 561         SHAREDSvLOCK(shared);
 562         if(SvROK(value)) {
 563             shared_sv* target = Perl_sharedsv_find(aTHX_ SvRV(value));
 564             if(!target) {
 565                 Perl_croak(aTHX_ "You cannot assign a non shared reference to a shared hash");
 566             }
 567             SHAREDSvEDIT(shared);
 568             value = newRV_noinc(newSViv((IV)target));
 569             SHAREDSvRELEASE(shared);
 570         }
 571         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len, 0);
 572         if(hentry_ && SvIV((*hentry_))) {
 573             hentry = (*hentry_);
 574             slot = (shared_sv*) SvIV(hentry);
 575             if(SvROK(SHAREDSvGET(slot)))
 576                 Perl_sharedsv_thrcnt_dec(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 577             SHAREDSvEDIT(slot);
 578             sv_setsv(SHAREDSvGET(slot), value);
 579             SHAREDSvRELEASE(slot);
 580         } else {
 581             slot = Perl_sharedsv_new(aTHX);
 582             SHAREDSvEDIT(shared);
 583             SHAREDSvGET(slot) = newSVsv(value);
 584             hentry = newSViv((IV)slot);
 585             hv_store((HV*) SHAREDSvGET(shared), ckey,len , hentry, 0);
 586             SHAREDSvRELEASE(shared);
 587         }
 588         if(SvROK(SHAREDSvGET(slot)))
 589             Perl_sharedsv_thrcnt_inc(aTHX_ (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot))));
 590         SHAREDSvUNLOCK(shared);
 591
 592
 593 SV*
 594 FETCH(self, key)
 595         SV* self
 596         SV* key
 597         CODE:
 598         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 599         shared_sv* slot;
 600         SV* hentry;
 601         SV** hentry_;
 602         SV* retval;
 603         STRLEN len;
 604         char* ckey = SvPV(key, len);
 605         SHAREDSvLOCK(shared);
 606         hentry_ = hv_fetch((HV*) SHAREDSvGET(shared), ckey, len,0);
 607         if(hentry_) {
 608             hentry = (*hentry_);
 609             if(SvTYPE(hentry) == SVt_NULL) {
 610                 retval = &PL_sv_undef;
 611             } else {
 612                 slot = (shared_sv*) SvIV(hentry);
 613                 if(SvROK(SHAREDSvGET(slot))) {
 614                     shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 615                     retval = shared_sv_attach_sv(NULL, target);
 616                 } else {
 617                     retval = newSVsv(SHAREDSvGET(slot));
 618                 }
 619             }
 620         } else {
 621             retval = &PL_sv_undef;
 622         }
 623         SHAREDSvUNLOCK(shared);
 624         RETVAL = retval;
 625         OUTPUT:
 626         RETVAL
 627
 628 void
 629 CLEAR(self)
 630         SV* self
 631         CODE:
 632         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 633         shared_sv* slot;
 634         HE* entry;
 635         SHAREDSvLOCK(shared);
 636         Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 637         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 638         while(entry) {
 639                 slot = (shared_sv*) SvIV(Perl_hv_iterval(PL_sharedsv_space, (HV*) SHAREDSvGET(shared), entry));
 640                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 641                 entry = Perl_hv_iternext(PL_sharedsv_space,(HV*) SHAREDSvGET(shared));
 642         }
 643         SHAREDSvEDIT(shared);
 644         hv_clear((HV*) SHAREDSvGET(shared));
 645         SHAREDSvRELEASE(shared);
 646         SHAREDSvUNLOCK(shared);
 647
 648 SV*
 649 FIRSTKEY(self)
 650         SV* self
 651         CODE:
 652         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 653         char* key = NULL;
 654         I32 len;
 655         HE* entry;
 656         SHAREDSvLOCK(shared);
 657         Perl_hv_iterinit(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 658         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 659         if(entry) {
 660                 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
 661                 RETVAL = newSVpv(key, len);
 662         } else {
 663              RETVAL = &PL_sv_undef;
 664         }
 665         SHAREDSvUNLOCK(shared);
 666         OUTPUT:
 667         RETVAL
 668
 669
 670 SV*
 671 NEXTKEY(self, oldkey)
 672         SV* self
 673         SV* oldkey
 674         CODE:
 675         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 676         char* key = NULL;
 677         I32 len;
 678         HE* entry;
 679         SHAREDSvLOCK(shared);
 680         entry = Perl_hv_iternext(PL_sharedsv_space, (HV*) SHAREDSvGET(shared));
 681         if(entry) {
 682                 key = Perl_hv_iterkey(PL_sharedsv_space, entry,&len);
 683                 RETVAL = newSVpv(key, len);
 684         } else {
 685              RETVAL = &PL_sv_undef;
 686         }
 687         SHAREDSvUNLOCK(shared);
 688         OUTPUT:
 689         RETVAL
 690
 691
 692 SV*
 693 EXISTS(self, key)
 694         SV* self
 695         SV* key
 696         CODE:
 697         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 698         STRLEN len;
 699         char* ckey = SvPV(key, len);
 700         SHAREDSvLOCK(shared);
 701         if(hv_exists((HV*)SHAREDSvGET(shared), ckey, len)) {
 702                 RETVAL = &PL_sv_yes;
 703         } else {
 704                 RETVAL = &PL_sv_no;
 705         }
 706         SHAREDSvUNLOCK(shared);
 707         OUTPUT:
 708         RETVAL
 709
 710 SV*
 711 DELETE(self, key)
 712         SV* self
 713         SV* key
 714         CODE:
 715         shared_sv* shared = (shared_sv*) SvIV(SvRV(self));
 716         shared_sv* slot;
 717         STRLEN len;
 718         char* ckey = SvPV(key, len);
 719         SV* tmp;
 720         SHAREDSvLOCK(shared);
 721         SHAREDSvEDIT(shared);
 722         tmp = hv_delete((HV*) SHAREDSvGET(shared), ckey, len,0);
 723         SHAREDSvRELEASE(shared);
 724         if(tmp) {
 725                 slot = (shared_sv*) SvIV(tmp);
 726                 if(SvROK(SHAREDSvGET(slot))) {
 727                     shared_sv* target = (shared_sv*) SvIV(SvRV(SHAREDSvGET(slot)));
 728                     RETVAL = shared_sv_attach_sv(NULL, target);
 729                 } else {
 730                     RETVAL = newSVsv(SHAREDSvGET(slot));
 731                 }
 732                 Perl_sharedsv_thrcnt_dec(aTHX_ slot);
 733         } else {
 734                 RETVAL = &PL_sv_undef;
 735         }
 736         SHAREDSvUNLOCK(shared);
 737         OUTPUT:
 738         RETVAL