XS.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #define NEED_newRV_noinc
   6 #define NEED_sv_2pv_flags
   7 #include "ppport.h"
   8
   9 #ifndef gv_fetchsv
  10 #define gv_fetchsv(n,f,t) gv_fetchpv(SvPV_nolen(n), f, t)
  11 #endif
  12
  13 #ifndef mro_method_changed_in
  14 #define mro_method_changed_in(x) PL_sub_generation++
  15 #endif
  16
  17 #ifdef newSVhek
  18 #define newSVhe(he) newSVhek(HeKEY_hek(he))
  19 #else
  20 #define newSVhe(he) newSVpv(HePV(he, PL_na), 0)
  21 #endif
  22
  23 #ifndef savesvpv
  24 #define savesvpv(s) savepv(SvPV_nolen(s))
  25 #endif
  26
  27 /* HACK: scalar slots are always populated on perl < 5.10, so treat undef
  28  * as nonexistent. this is consistent with the previous behavior of the pure
  29  * perl version of this module (since this is the behavior that perl sees
  30  * in all versions */
  31 #if PERL_VERSION < 10
  32 #define GvSVOK(g) (GvSV(g) && SvTYPE(GvSV(g)) != SVt_NULL)
  33 #else
  34 #define GvSVOK(g) GvSV(g)
  35 #endif
  36
  37 #define GvAVOK(g) GvAV(g)
  38 #define GvHVOK(g) GvHV(g)
  39 #define GvCVOK(g) GvCVu(g) /* XXX: should this really be GvCVu? or GvCV? */
  40 #define GvIOOK(g) GvIO(g)
  41
  42 /* see above - don't let scalar slots become unpopulated, this breaks
  43  * assumptions in core */
  44 #if PERL_VERSION < 10
  45 #define GvSetSV(g,v) do {               \
  46     SV *_v = (SV*)(v);                  \
  47     SvREFCNT_dec(GvSV(g));              \
  48     if ((GvSV(g) = _v ? _v : newSV(0))) \
  49         GvIMPORTED_SV_on(g);            \
  50 } while (0)
  51 #else
  52 #define GvSetSV(g,v) do {               \
  53     SvREFCNT_dec(GvSV(g));              \
  54     if ((GvSV(g) = (SV*)(v)))           \
  55         GvIMPORTED_SV_on(g);            \
  56 } while (0)
  57 #endif
  58
  59 #define GvSetAV(g,v) do {               \
  60     SvREFCNT_dec(GvAV(g));              \
  61     if ((GvAV(g) = (AV*)(v)))           \
  62         GvIMPORTED_AV_on(g);            \
  63 } while (0)
  64 #define GvSetHV(g,v) do {               \
  65     SvREFCNT_dec(GvHV(g));              \
  66     if ((GvHV(g) = (HV*)(v)))           \
  67         GvIMPORTED_HV_on(g);            \
  68 } while (0)
  69 #define GvSetCV(g,v) do {               \
  70     SvREFCNT_dec(GvCV(g));              \
  71     if ((GvCV(g) = (CV*)(v))) {         \
  72         GvIMPORTED_CV_on(g);            \
  73         GvASSUMECV_on(g);               \
  74     }                                   \
  75     GvCVGEN(g) = 0;                     \
  76     mro_method_changed_in(GvSTASH(g));  \
  77 } while (0)
  78 #define GvSetIO(g,v) do {               \
  79     SvREFCNT_dec(GvIO(g));              \
  80     GvIOp(g) = (IO*)(v);                \
  81 } while (0)
  82
  83 typedef enum {
  84     VAR_NONE = 0,
  85     VAR_SCALAR,
  86     VAR_ARRAY,
  87     VAR_HASH,
  88     VAR_CODE,
  89     VAR_IO,
  90     VAR_GLOB,  /* TODO: unimplemented */
  91     VAR_FORMAT /* TODO: unimplemented */
  92 } vartype_t;
  93
  94 typedef struct {
  95     vartype_t type;
  96     SV *name;
  97 } varspec_t;
  98
  99 static U32 name_hash, namespace_hash, type_hash;
 100 static SV *name_key, *namespace_key, *type_key;
 101
 102 const char *vartype_to_string(vartype_t type)
 103 {
 104     switch (type) {
 105     case VAR_SCALAR:
 106         return "SCALAR";
 107     case VAR_ARRAY:
 108         return "ARRAY";
 109     case VAR_HASH:
 110         return "HASH";
 111     case VAR_CODE:
 112         return "CODE";
 113     case VAR_IO:
 114         return "IO";
 115     default:
 116         return "unknown";
 117     }
 118 }
 119
 120 I32 vartype_to_svtype(vartype_t type)
 121 {
 122     switch (type) {
 123     case VAR_SCALAR:
 124         return SVt_PV; /* or whatever */
 125     case VAR_ARRAY:
 126         return SVt_PVAV;
 127     case VAR_HASH:
 128         return SVt_PVHV;
 129     case VAR_CODE:
 130         return SVt_PVCV;
 131     case VAR_IO:
 132         return SVt_PVIO;
 133     default:
 134         return SVt_NULL;
 135     }
 136 }
 137
 138 vartype_t string_to_vartype(char *vartype)
 139 {
 140     if (strEQ(vartype, "SCALAR")) {
 141         return VAR_SCALAR;
 142     }
 143     else if (strEQ(vartype, "ARRAY")) {
 144         return VAR_ARRAY;
 145     }
 146     else if (strEQ(vartype, "HASH")) {
 147         return VAR_HASH;
 148     }
 149     else if (strEQ(vartype, "CODE")) {
 150         return VAR_CODE;
 151     }
 152     else if (strEQ(vartype, "IO")) {
 153         return VAR_IO;
 154     }
 155     else {
 156         croak("Type must be one of 'SCALAR', 'ARRAY', 'HASH', 'CODE', or 'IO', not '%s'", vartype);
 157     }
 158 }
 159
 160 void _deconstruct_variable_name(SV *variable, varspec_t *varspec)
 161 {
 162     char *varpv;
 163
 164     if (!SvCUR(variable))
 165         croak("You must pass a variable name");
 166
 167     varspec->name = sv_2mortal(newSVsv(variable));
 168
 169     varpv = SvPV_nolen(varspec->name);
 170     switch (varpv[0]) {
 171     case '$':
 172         varspec->type = VAR_SCALAR;
 173         sv_chop(varspec->name, &varpv[1]);
 174         break;
 175     case '@':
 176         varspec->type = VAR_ARRAY;
 177         sv_chop(varspec->name, &varpv[1]);
 178         break;
 179     case '%':
 180         varspec->type = VAR_HASH;
 181         sv_chop(varspec->name, &varpv[1]);
 182         break;
 183     case '&':
 184         varspec->type = VAR_CODE;
 185         sv_chop(varspec->name, &varpv[1]);
 186         break;
 187     default:
 188         varspec->type = VAR_IO;
 189         break;
 190     }
 191 }
 192
 193 void _deconstruct_variable_hash(HV *variable, varspec_t *varspec)
 194 {
 195     HE *val;
 196
 197     val = hv_fetch_ent(variable, name_key, 0, name_hash);
 198     if (!val)
 199         croak("The 'name' key is required in variable specs");
 200
 201     varspec->name = sv_2mortal(newSVsv(HeVAL(val)));
 202
 203     val = hv_fetch_ent(variable, type_key, 0, type_hash);
 204     if (!val)
 205         croak("The 'type' key is required in variable specs");
 206
 207     varspec->type = string_to_vartype(SvPV_nolen(HeVAL(val)));
 208 }
 209
 210 int _valid_for_type(SV *value, vartype_t type)
 211 {
 212     svtype sv_type = SvROK(value) ? SvTYPE(SvRV(value)) : SVt_NULL;
 213
 214     switch (type) {
 215     case VAR_SCALAR:
 216         /* XXX: something weird is going on here - apparently values can
 217          * be SVt_NULL but also be SvROK (and also, SVt_NULL isn't SvOK) */
 218         if (sv_type == SVt_NULL)
 219             return 1;
 220         return SvROK(value) ? SvOK(SvRV(value)) : SvOK(value);
 221     case VAR_ARRAY:
 222         return sv_type == SVt_PVAV;
 223     case VAR_HASH:
 224         return sv_type == SVt_PVHV;
 225     case VAR_CODE:
 226         return sv_type == SVt_PVCV;
 227     case VAR_IO:
 228         return sv_type == SVt_PVIO;
 229     default:
 230         return 0;
 231     }
 232 }
 233
 234 HV *_get_namespace(SV *self)
 235 {
 236     dSP;
 237     SV *ret;
 238
 239     PUSHMARK(SP);
 240     XPUSHs(self);
 241     PUTBACK;
 242
 243     call_method("namespace", G_SCALAR);
 244
 245     SPAGAIN;
 246     ret = POPs;
 247     PUTBACK;
 248
 249     return (HV*)SvRV(ret);
 250 }
 251
 252 SV *_get_name(SV *self)
 253 {
 254     dSP;
 255     SV *ret;
 256
 257     PUSHMARK(SP);
 258     XPUSHs(self);
 259     PUTBACK;
 260
 261     call_method("name", G_SCALAR);
 262
 263     SPAGAIN;
 264     ret = POPs;
 265     PUTBACK;
 266
 267     return ret;
 268 }
 269
 270 void _expand_glob(SV *self, SV *varname)
 271 {
 272     SV *name;
 273
 274     name = newSVsv(_get_name(self));
 275     sv_catpvs(name, "::");
 276     sv_catsv(name, varname);
 277
 278     /* can't use gv_init here, because it screws up @ISA in a way that I
 279      * can't reproduce, but that CMOP triggers */
 280     gv_fetchsv(name, GV_ADD, SVt_NULL);
 281     SvREFCNT_dec(name);
 282 }
 283
 284 SV *_get_symbol(SV *self, varspec_t *variable, int vivify)
 285 {
 286     HV *namespace;
 287     HE *entry;
 288     GV *glob;
 289
 290     namespace = _get_namespace(self);
 291     entry = hv_fetch_ent(namespace, variable->name, vivify, 0);
 292     if (!entry)
 293         return NULL;
 294
 295     glob = (GV*)(HeVAL(entry));
 296     if (!isGV(glob))
 297         _expand_glob(self, variable->name);
 298
 299     if (vivify) {
 300         switch (variable->type) {
 301         case VAR_SCALAR:
 302             if (!GvSVOK(glob))
 303                 GvSetSV(glob, newSV(0));
 304             break;
 305         case VAR_ARRAY:
 306             if (!GvAVOK(glob))
 307                 GvSetAV(glob, newAV());
 308             break;
 309         case VAR_HASH:
 310             if (!GvHVOK(glob))
 311                 GvSetHV(glob, newHV());
 312             break;
 313         case VAR_CODE:
 314             croak("Don't know how to vivify CODE variables");
 315         case VAR_IO:
 316             if (!GvIOOK(glob))
 317                 GvSetIO(glob, newIO());
 318             break;
 319         default:
 320             croak("Unknown type in vivication");
 321         }
 322     }
 323
 324     switch (variable->type) {
 325     case VAR_SCALAR:
 326         return GvSV(glob);
 327     case VAR_ARRAY:
 328         return (SV*)GvAV(glob);
 329     case VAR_HASH:
 330         return (SV*)GvHV(glob);
 331     case VAR_CODE:
 332         return (SV*)GvCV(glob);
 333     case VAR_IO:
 334         return (SV*)GvIO(glob);
 335     default:
 336         return NULL;
 337     }
 338 }
 339
 340 MODULE = Package::Stash::XS  PACKAGE = Package::Stash::XS
 341
 342 PROTOTYPES: DISABLE
 343
 344 SV*
 345 new(class, package_name)
 346     SV *class
 347     SV *package_name
 348   PREINIT:
 349     HV *instance;
 350     HV *namespace;
 351     SV *nsref;
 352   CODE:
 353     if (!SvPOK(package_name))
 354         croak("The constructor argument must be the name of a package");
 355
 356     instance = newHV();
 357
 358     if (!hv_store(instance, "name", 4, SvREFCNT_inc_simple_NN(package_name), 0)) {
 359         SvREFCNT_dec(package_name);
 360         SvREFCNT_dec(instance);
 361         croak("Couldn't initialize the 'name' key, hv_store failed");
 362     }
 363     namespace = gv_stashpv(SvPV_nolen(package_name), GV_ADD);
 364     nsref = newRV_inc((SV*)namespace);
 365     if (!hv_store(instance, "namespace", 9, nsref, 0)) {
 366         SvREFCNT_dec(nsref);
 367         SvREFCNT_dec(instance);
 368         croak("Couldn't initialize the 'namespace' key, hv_store failed");
 369     }
 370
 371     RETVAL = sv_bless(newRV_noinc((SV*)instance), gv_stashsv(class, 0));
 372   OUTPUT:
 373     RETVAL
 374
 375 SV*
 376 name(self)
 377     SV *self
 378   PREINIT:
 379     HE *slot;
 380   CODE:
 381     if (!sv_isobject(self))
 382         croak("Can't call name as a class method");
 383     slot = hv_fetch_ent((HV*)SvRV(self), name_key, 0, name_hash);
 384     RETVAL = slot ? SvREFCNT_inc_simple_NN(HeVAL(slot)) : &PL_sv_undef;
 385   OUTPUT:
 386     RETVAL
 387
 388 SV*
 389 namespace(self)
 390     SV *self
 391   PREINIT:
 392     HE *slot;
 393   CODE:
 394     if (!sv_isobject(self))
 395         croak("Can't call namespace as a class method");
 396     slot = hv_fetch_ent((HV*)SvRV(self), namespace_key, 0, namespace_hash);
 397     RETVAL = slot ? SvREFCNT_inc_simple_NN(HeVAL(slot)) : &PL_sv_undef;
 398   OUTPUT:
 399     RETVAL
 400
 401 void
 402 add_symbol(self, variable, initial=NULL, ...)
 403     SV *self
 404     varspec_t variable
 405     SV *initial
 406   PREINIT:
 407     SV *name;
 408     GV *glob;
 409   CODE:
 410     if (initial && !_valid_for_type(initial, variable.type))
 411         croak("%s is not of type %s",
 412               SvPV_nolen(initial), vartype_to_string(variable.type));
 413
 414     name = newSVsv(_get_name(self));
 415     sv_catpvs(name, "::");
 416     sv_catsv(name, variable.name);
 417
 418     if (items > 2 && (PL_perldb & 0x10) && variable.type == VAR_CODE) {
 419         int i;
 420         char *filename = NULL;
 421         I32 first_line_num = -1, last_line_num = -1;
 422         STRLEN namelen;
 423         SV *dbval;
 424         HV *dbsub;
 425
 426         if ((items - 3) % 2)
 427             croak("add_symbol: Odd number of elements in %%opts");
 428
 429         for (i = 3; i < items; i += 2) {
 430             char *key;
 431             key = SvPV_nolen(ST(i));
 432             if (strEQ(key, "filename")) {
 433                 if (!SvPOK(ST(i + 1)))
 434                     croak("add_symbol: filename must be a string");
 435                 filename = SvPV_nolen(ST(i + 1));
 436             }
 437             else if (strEQ(key, "first_line_num")) {
 438                 if (!SvIOK(ST(i + 1)))
 439                     croak("add_symbol: first_line_num must be an integer");
 440                 first_line_num = SvIV(ST(i + 1));
 441             }
 442             else if (strEQ(key, "last_line_num")) {
 443                 if (!SvIOK(ST(i + 1)))
 444                     croak("add_symbol: last_line_num must be an integer");
 445                 last_line_num = SvIV(ST(i + 1));
 446             }
 447         }
 448
 449         if (!filename || first_line_num == -1) {
 450             if (!filename)
 451                 filename = CopFILE(PL_curcop);
 452             if (first_line_num == -1)
 453                 first_line_num = PL_curcop->cop_line;
 454         }
 455
 456         if (last_line_num == -1)
 457             last_line_num = first_line_num;
 458
 459         /* http://perldoc.perl.org/perldebguts.html#Debugger-Internals */
 460         dbsub = get_hv("DB::sub", 1);
 461         dbval = newSVpvf("%s:%d-%d", filename, first_line_num, last_line_num);
 462         if (!hv_store_ent(dbsub, name, dbval, 0)) {
 463             warn("Failed to update $DB::sub for subroutine %s",
 464                  SvPV_nolen(name));
 465             SvREFCNT_dec(dbval);
 466         }
 467     }
 468
 469     /* GV_ADDMULTI rather than GV_ADD because otherwise you get 'used only
 470      * once' warnings in some situations... i can't reproduce this, but CMOP
 471      * triggers it */
 472     glob = gv_fetchsv(name, GV_ADDMULTI, vartype_to_svtype(variable.type));
 473
 474     if (initial) {
 475         SV *val;
 476
 477         if (SvROK(initial)) {
 478             val = SvRV(initial);
 479             SvREFCNT_inc_simple_void_NN(val);
 480         }
 481         else {
 482             val = newSVsv(initial);
 483         }
 484
 485         switch (variable.type) {
 486         case VAR_SCALAR:
 487             GvSetSV(glob, val);
 488             break;
 489         case VAR_ARRAY:
 490             GvSetAV(glob, val);
 491             break;
 492         case VAR_HASH:
 493             GvSetHV(glob, val);
 494             break;
 495         case VAR_CODE:
 496             GvSetCV(glob, val);
 497             break;
 498         case VAR_IO:
 499             GvSetIO(glob, val);
 500             break;
 501         }
 502     }
 503
 504     SvREFCNT_dec(name);
 505
 506 void
 507 remove_glob(self, name)
 508     SV *self
 509     SV *name
 510   CODE:
 511     hv_delete_ent(_get_namespace(self), name, G_DISCARD, 0);
 512
 513 int
 514 has_symbol(self, variable)
 515     SV *self
 516     varspec_t variable
 517   PREINIT:
 518     HV *namespace;
 519     HE *entry;
 520     SV *val;
 521   CODE:
 522     namespace = _get_namespace(self);
 523     entry = hv_fetch_ent(namespace, variable.name, 0, 0);
 524     if (!entry)
 525         XSRETURN_UNDEF;
 526
 527     val = HeVAL(entry);
 528     if (isGV(val)) {
 529         GV *glob = (GV*)val;
 530         switch (variable.type) {
 531         case VAR_SCALAR:
 532             RETVAL = GvSVOK(glob) ? 1 : 0;
 533             break;
 534         case VAR_ARRAY:
 535             RETVAL = GvAVOK(glob) ? 1 : 0;
 536             break;
 537         case VAR_HASH:
 538             RETVAL = GvHVOK(glob) ? 1 : 0;
 539             break;
 540         case VAR_CODE:
 541             RETVAL = GvCVOK(glob) ? 1 : 0;
 542             break;
 543         case VAR_IO:
 544             RETVAL = GvIOOK(glob) ? 1 : 0;
 545             break;
 546         }
 547     }
 548     else {
 549         RETVAL = (variable.type == VAR_CODE);
 550     }
 551   OUTPUT:
 552     RETVAL
 553
 554 SV*
 555 get_symbol(self, variable)
 556     SV *self
 557     varspec_t variable
 558   PREINIT:
 559     SV *val;
 560   CODE:
 561     val = _get_symbol(self, &variable, 0);
 562     if (!val)
 563         XSRETURN_UNDEF;
 564     RETVAL = newRV_inc(val);
 565   OUTPUT:
 566     RETVAL
 567
 568 SV*
 569 get_or_add_symbol(self, variable)
 570     SV *self
 571     varspec_t variable
 572   PREINIT:
 573     SV *val;
 574   CODE:
 575     val = _get_symbol(self, &variable, 1);
 576     if (!val)
 577         XSRETURN_UNDEF;
 578     RETVAL = newRV_inc(val);
 579   OUTPUT:
 580     RETVAL
 581
 582 void
 583 remove_symbol(self, variable)
 584     SV *self
 585     varspec_t variable
 586   PREINIT:
 587     HV *namespace;
 588     HE *entry;
 589     SV *val;
 590   CODE:
 591     namespace = _get_namespace(self);
 592     entry = hv_fetch_ent(namespace, variable.name, 0, 0);
 593     if (!entry)
 594         XSRETURN_EMPTY;
 595
 596     val = HeVAL(entry);
 597     if (isGV(val)) {
 598         GV *glob = (GV*)val;
 599         switch (variable.type) {
 600         case VAR_SCALAR:
 601             GvSetSV(glob, NULL);
 602             break;
 603         case VAR_ARRAY:
 604             GvSetAV(glob, NULL);
 605             break;
 606         case VAR_HASH:
 607             GvSetHV(glob, NULL);
 608             break;
 609         case VAR_CODE:
 610             GvSetCV(glob, NULL);
 611             break;
 612         case VAR_IO:
 613             GvSetIO(glob, NULL);
 614             break;
 615         }
 616     }
 617     else {
 618         if (variable.type == VAR_CODE) {
 619             hv_delete_ent(namespace, variable.name, G_DISCARD, 0);
 620         }
 621     }
 622
 623 void
 624 list_all_symbols(self, vartype=VAR_NONE)
 625     SV *self
 626     vartype_t vartype
 627   PPCODE:
 628     if (vartype == VAR_NONE) {
 629         HV *namespace;
 630         HE *entry;
 631         int keys;
 632
 633         namespace = _get_namespace(self);
 634         keys = hv_iterinit(namespace);
 635         EXTEND(SP, keys);
 636         while ((entry = hv_iternext(namespace))) {
 637             mPUSHs(newSVhe(entry));
 638         }
 639     }
 640     else {
 641         HV *namespace;
 642         SV *val;
 643         char *key;
 644         I32 len;
 645
 646         namespace = _get_namespace(self);
 647         hv_iterinit(namespace);
 648         while ((val = hv_iternextsv(namespace, &key, &len))) {
 649             GV *gv = (GV*)val;
 650             if (isGV(gv)) {
 651                 switch (vartype) {
 652                 case VAR_SCALAR:
 653                     if (GvSVOK(val))
 654                         mXPUSHp(key, len);
 655                     break;
 656                 case VAR_ARRAY:
 657                     if (GvAVOK(val))
 658                         mXPUSHp(key, len);
 659                     break;
 660                 case VAR_HASH:
 661                     if (GvHVOK(val))
 662                         mXPUSHp(key, len);
 663                     break;
 664                 case VAR_CODE:
 665                     if (GvCVOK(val))
 666                         mXPUSHp(key, len);
 667                     break;
 668                 case VAR_IO:
 669                     if (GvIOOK(val))
 670                         mXPUSHp(key, len);
 671                     break;
 672                 }
 673             }
 674             else if (vartype == VAR_CODE) {
 675                 mXPUSHp(key, len);
 676             }
 677         }
 678     }
 679
 680 void
 681 get_all_symbols(self, vartype=VAR_NONE)
 682     SV *self
 683     vartype_t vartype
 684   PREINIT:
 685     HV *namespace, *ret;
 686     SV *val;
 687     char *key;
 688     I32 len;
 689   PPCODE:
 690     namespace = _get_namespace(self);
 691     ret = newHV();
 692
 693     hv_iterinit(namespace);
 694     while ((val = hv_iternextsv(namespace, &key, &len))) {
 695         GV *gv = (GV*)val;
 696
 697         if (!isGV(gv)) {
 698             SV *keysv = newSVpvn(key, len);
 699             _expand_glob(self, keysv);
 700             SvREFCNT_dec(keysv);
 701         }
 702
 703         switch (vartype) {
 704         case VAR_SCALAR:
 705             if (GvSVOK(val))
 706                 hv_store(ret, key, len, newRV_inc(GvSV(gv)), 0);
 707             break;
 708         case VAR_ARRAY:
 709             if (GvAVOK(val))
 710                 hv_store(ret, key, len, newRV_inc((SV*)GvAV(gv)), 0);
 711             break;
 712         case VAR_HASH:
 713             if (GvHVOK(val))
 714                 hv_store(ret, key, len, newRV_inc((SV*)GvHV(gv)), 0);
 715             break;
 716         case VAR_CODE:
 717             if (GvCVOK(val))
 718                 hv_store(ret, key, len, newRV_inc((SV*)GvCV(gv)), 0);
 719             break;
 720         case VAR_IO:
 721             if (GvIOOK(val))
 722                 hv_store(ret, key, len, newRV_inc((SV*)GvIO(gv)), 0);
 723             break;
 724         case VAR_NONE:
 725             hv_store(ret, key, len, SvREFCNT_inc_simple_NN(val), 0);
 726             break;
 727         }
 728     }
 729
 730     mPUSHs(newRV_noinc((SV*)ret));
 731
 732 BOOT:
 733     {
 734         name_key = newSVpvs("name");
 735         PERL_HASH(name_hash, "name", 4);
 736
 737         namespace_key = newSVpvs("namespace");
 738         PERL_HASH(namespace_hash, "namespace", 9);
 739
 740         type_key = newSVpvs("type");
 741         PERL_HASH(type_hash, "type", 4);
 742     }