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