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