Introduce symbol table API into pad

builtin.c

@@ -692,15 +692,11 @@ static bool S_cv_is_builtin(pTHX_ CV *cv)
 void
 Perl_import_builtin_bundle(pTHX_ U16 ver)
 {
-    SV *ampname = sv_newmortal();
-
     for(int i = 0; builtins[i].name; i++) {
-        sv_setpvf(ampname, "&%s", builtins[i].name);
-
         bool want = (builtins[i].since_ver <= ver);
 
         bool got = false;
-        PADOFFSET off = pad_findmy_sv(ampname, 0);
+        PADOFFSET off = pad_find_my_symbol_pv (Perl_Symbol_Table_Code, builtins[i].name, 0);
         CV *cv;
         if(off != NOT_IN_PAD &&
                 SvTYPE((cv = (CV *)PL_curpad[off])) == SVt_PVCV &&

class.c

@@ -155,7 +155,7 @@ XS(injected_constructor)
             SV *name = ST(i);
             SV *val  = (i+1 < items) ? ST(i+1) : &PL_sv_undef;
 
-            /* TODO: think about sanity-checking name for being 
+            /* TODO: think about sanity-checking name for being
              *   defined
              *   not ref (but overloaded objects?? boo)
              *   not duplicate
@@ -399,10 +399,10 @@ Perl_class_setup_stash(pTHX_ HV *stash)
         /* We don't want to make `$self` visible during the expression but we
          * still need to give it a name. Make it unusable from pure perl
          */
-        PADOFFSET padix = pad_add_name_pvs("$(self)", 0, NULL, NULL);
+        PADOFFSET padix = pad_add_symbol_pvs (Perl_Symbol_Table_Scalar, "(self)", 0, NULL, NULL);
         assert(padix == PADIX_SELF);
 
-        padix = pad_add_name_pvs("%(params)", 0, NULL, NULL);
+        padix = pad_add_symbol_pvs (Perl_Symbol_Table_Hash, "(params)", 0, NULL, NULL);
         assert(padix == PADIX_PARAMS);
 
         PERL_UNUSED_VAR(padix);
@@ -699,7 +699,7 @@ Perl_class_seal_stash(pTHX_ HV *stash)
 
         for(SSize_t i = 0; fieldnames && i <= PadnamelistMAX(fieldnames); i++) {
             PADNAME *pn = PadnamelistARRAY(fieldnames)[i];
-            char sigil = PadnamePV(pn)[0];
+            perl_symbol_table_id sigil = Padname_Symbol_Table (pn);
             PADOFFSET fieldix = PadnameFIELDINFO(pn)->fieldix;
 
             /* Extract the OP_{NEXT,DB}STATE op from the defop so we can
@@ -729,7 +729,7 @@ Perl_class_seal_stash(pTHX_ HV *stash)
 
             U8 op_priv = 0;
             switch(sigil) {
-                case '$':
+                case Perl_Symbol_Table_Scalar:
                     if(paramname) {
                         if(!valop) {
                             SV *message =
@@ -766,11 +766,11 @@ Perl_class_seal_stash(pTHX_ HV *stash)
                     }
                     break;
 
-                case '@':
+                case Perl_Symbol_Table_Array:
                     op_priv = OPpINITFIELD_AV;
                     break;
 
-                case '%':
+                case Perl_Symbol_Table_Hash:
                     op_priv = OPpINITFIELD_HV;
                     break;
 
@@ -843,7 +843,7 @@ Perl_class_prepare_method_parse(pTHX_ CV *cv)
 
     PADOFFSET padix;
 
-    padix = pad_add_name_pvs("$self", 0, NULL, NULL);
+    padix = pad_add_symbol_pvs (Perl_Symbol_Table_Scalar, "self", 0, NULL, NULL);
     assert(padix == PADIX_SELF);
     PERL_UNUSED_VAR(padix);
 
@@ -945,9 +945,9 @@ apply_field_attribute_param(pTHX_ PADNAME *pn, SV *value)
 {
     if(!value)
         /* Default to name minus the sigil */
-        value = newSVpvn_utf8(PadnamePV(pn) + 1, PadnameLEN(pn) - 1, PadnameUTF8(pn));
+        value = newSVpvn_utf8(Padname_Symbol_Name (pn), Padname_Symbol_Name_Length (pn), PadnameUTF8(pn));
 
-    if(PadnamePV(pn)[0] != '$')
+    if(! Padname_Is_Symbol_Table_Scalar (pn))
         croak("Only scalar fields can take a :param attribute");
 
     if(PadnameFIELDINFO(pn)->paramname)
@@ -977,7 +977,7 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
         SvREFCNT_inc(value);
     else
         /* Default to name minus the sigil */
-        value = newSVpvn_utf8(PadnamePV(pn) + 1, PadnameLEN(pn) - 1, PadnameUTF8(pn));
+        value = newSVpvn_utf8(Padname_Symbol_Name (pn), Padname_Symbol_Name_Length (pn), PadnameUTF8(pn));
 
     if(!valid_identifier_sv(value))
         croak("%" SVf_QUOTEDPREFIX " is not a valid name for a generated method", value);
@@ -991,10 +991,17 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
 
     PADOFFSET padix;
 
-    padix = pad_add_name_pvs("$self", 0, NULL, NULL);
+    padix = pad_add_symbol_pvs (Perl_Symbol_Table_Scalar, "self", 0, NULL, NULL);
     assert(padix == PADIX_SELF);
 
-    padix = pad_add_name_pvn(PadnamePV(pn), PadnameLEN(pn), 0, NULL, NULL);
+    padix = pad_add_symbol_pvn (
+        /* symbol_table = */ Padname_Symbol_Table (pn),
+        /* namepv       = */ Padname_Symbol_Name (pn),
+        /* namelen      = */ Padname_Symbol_Name_Length (pn),
+        /* flags        = */ 0,
+        /* typestash    = */ NULL,
+        /* ourstash     = */ NULL
+    );
     intro_my();
 
     OP *methstartop;
@@ -1028,10 +1035,10 @@ apply_field_attribute_reader(pTHX_ PADNAME *pn, SV *value)
     OP *retop;
     {
         OPCODE optype = 0;
-        switch(PadnamePV(pn)[0]) {
-            case '$': optype = OP_PADSV; break;
-            case '@': optype = OP_PADAV; break;
-            case '%': optype = OP_PADHV; break;
+        switch(Padname_Symbol_Table (pn)) {
+            case Perl_Symbol_Table_Scalar: optype = OP_PADSV; break;
+            case Perl_Symbol_Table_Array:  optype = OP_PADAV; break;
+            case Perl_Symbol_Table_Hash:   optype = OP_PADHV; break;
             default: NOT_REACHED;
         }
 
@@ -1238,14 +1245,14 @@ Perl_class_set_field_defop(pTHX_ PADNAME *pn, OPCODE defmode, OP *defop)
 
     forbid_outofblock_ops(defop, "field initialiser expression");
 
-    char sigil = PadnamePV(pn)[0];
+    perl_symbol_table_id sigil = Padname_Symbol_Table (pn);
     switch(sigil) {
-        case '$':
+        case Perl_Symbol_Table_Scalar:
             defop = op_contextualize(defop, G_SCALAR);
             break;
 
-        case '@':
-        case '%':
+        case Perl_Symbol_Table_Array:
+        case Perl_Symbol_Table_Hash:
             defop = op_contextualize(op_force_list(defop), G_LIST);
             break;
     }

dump.c

@@ -166,7 +166,7 @@ Unused or not for public use
 #define PV_BYTE_HEX_LC  "x%02" UVxf
 
 char *
-Perl_pv_escape( pTHX_ SV *dsv, char const * const str, 
+Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
                 const STRLEN count, STRLEN max,
                 STRLEN * const escaped, U32 flags )
 {
@@ -226,43 +226,43 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
             /* This won't alter the UTF-8 flag */
             SvPVCLEAR(dsv);
     }
-    
+
     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
         isuni = 1;
-    
+
     for ( ; pv < end ; pv += readsize ) {
         const UV u= (isuni) ? utf8_to_uvchr_buf((U8*)pv, (U8*) end, &readsize) : (U8)*pv;
         const U8 c = (U8)u;
         const char *source_buf = octbuf;
-        
+
         if ( ( u > 255 )
           || (flags & PERL_PV_ESCAPE_ALL)
           || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM))))
         {
-            if (flags & PERL_PV_ESCAPE_FIRSTCHAR) 
-                chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, 
+            if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
+                chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
                                       "%" UVxf, u);
             else
             if ((flags & PERL_PV_ESCAPE_NON_WC) && isWORDCHAR_uvchr(u)) {
                 chsize = readsize;
                 source_buf = pv;
             }
             else
-                chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, 
+                chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE,
                                       ((flags & PERL_PV_ESCAPE_DWIM) && !isuni)
                                       ? ( use_uc_hex ? ("%c" PV_BYTE_HEX_UC) : ("%c" PV_BYTE_HEX_LC) )
                                       : "%cx{%02" UVxf "}", esc, u);
 
         } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
-            chsize = 1;            
-        } else {         
+            chsize = 1;
+        } else {
             if ( (c == dq) || (c == esc) || !isPRINT(c) ) {
                 chsize = 2;
                 switch (c) {
-                
+
                 case '\\' : /* FALLTHROUGH */
                 case '%'  : if ( c == esc )  {
-                                octbuf[1] = esc;  
+                                octbuf[1] = esc;
                             } else {
                                 chsize = 1;
                             }
@@ -272,10 +272,10 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
                 case '\r' : octbuf[1] = 'r';  break;
                 case '\n' : octbuf[1] = 'n';  break;
                 case '\f' : octbuf[1] = 'f';  break;
-                case '"'  : 
-                        if ( dq == '"' ) 
+                case '"'  :
+                        if ( dq == '"' )
                                 octbuf[1] = '"';
-                        else 
+                        else
                             chsize = 1;
                         break;
                 default:
@@ -323,7 +323,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
                 Perl_sv_catpvf( aTHX_ dsv, "%c", c);
             wrote++;
         }
-        if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) 
+        if ( flags & PERL_PV_ESCAPE_FIRSTCHAR )
             break;
     }
     if (escaped != NULL)
@@ -339,7 +339,7 @@ C<pv_escape()> and supporting quoting and ellipses.
 If the C<PERL_PV_PRETTY_QUOTE> flag is set then the result will be
 double quoted with any double quotes in the string escaped.  Otherwise
 if the C<PERL_PV_PRETTY_LTGT> flag is set then the result be wrapped in
-angle brackets. 
+angle brackets.
 
 If the C<PERL_PV_PRETTY_ELLIPSES> flag is set and not all characters in
 string were output then an ellipsis C<...> will be appended to the
@@ -356,22 +356,22 @@ Returns a pointer to the prettified text as held by C<dsv>.
 =for apidoc Amnh||PERL_PV_PRETTY_LTGT
 =for apidoc Amnh||PERL_PV_PRETTY_ELLIPSES
 
-=cut           
+=cut
 */
 
 char *
-Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, 
-  const STRLEN max, char const * const start_color, char const * const end_color, 
-  const U32 flags ) 
+Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
+  const STRLEN max, char const * const start_color, char const * const end_color,
+  const U32 flags )
 {
     const U8 *quotes = (U8*)((flags & PERL_PV_PRETTY_QUOTE) ? "\"\"" :
                              (flags & PERL_PV_PRETTY_LTGT)  ? "<>" : NULL);
     STRLEN escaped;
     STRLEN max_adjust= 0;
     STRLEN orig_cur;
- 
+
     PERL_ARGS_ASSERT_PV_PRETTY;
-   
+
     if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
         /* This won't alter the UTF-8 flag */
         SvPVCLEAR(dsv);
@@ -380,8 +380,8 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
 
     if ( quotes )
         Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[0]);
-        
-    if ( start_color != NULL ) 
+
+    if ( start_color != NULL )
         sv_catpv(dsv, start_color);
 
     if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
@@ -396,20 +396,20 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
 
     pv_escape( dsv, str, count, max - max_adjust, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
 
-    if ( end_color != NULL ) 
+    if ( end_color != NULL )
         sv_catpv(dsv, end_color);
 
     if ( quotes )
         Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[1]);
-    
+
     if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) )
             sv_catpvs(dsv, "...");
 
     if ((flags & PERL_PV_PRETTY_EXACTSIZE)) {
         while( SvCUR(dsv) - orig_cur < max )
             sv_catpvs(dsv," ");
     }
- 
+
     return SvPVX(dsv);
 }
 
@@ -795,7 +795,7 @@ S_opdump_link(pTHX_ const OP *base, const OP *o, PerlIO *file)
 =for apidoc_section $debugging
 =for apidoc dump_all
 
-Dumps the entire optree of the current program starting at C<PL_main_root> to 
+Dumps the entire optree of the current program starting at C<PL_main_root> to
 C<STDERR>.  Also dumps the optrees for all visible subroutines in
 C<PL_defstash>.
 
@@ -2047,7 +2047,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     if ((flags & SVs_PADTMP))
             sv_catpvs(d, "PADTMP,");
     append_flags(d, flags, first_sv_flags_names);
-    if (flags & SVf_ROK)  {	
+    if (flags & SVf_ROK)  {
                                 sv_catpvs(d, "ROK,");
         if (SvWEAKREF(sv))	sv_catpvs(d, "WEAKREF,");
     }
@@ -2350,7 +2350,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
             if (ents) {
                 HE *const *const last = ents + HvMAX(sv);
                 count = last + 1 - ents;
-                
+
                 do {
                     if (!*ents)
                         --count;
@@ -3056,8 +3056,8 @@ S_append_padvar(pTHX_ PADOFFSET off, CV *cv, SV *out, int n,
         {
             STRLEN cur = SvCUR(out);
             Perl_sv_catpvf(aTHX_ out, "[%" UTF8f,
-                                 UTF8fARG(1, PadnameLEN(sv) - 1,
-                                          PadnamePV(sv) + 1));
+                                 UTF8fARG(1, Padname_Symbol_Name_Length (sv),
+                                          Padname_Symbol_Name (sv)));
             if (is_scalar)
                 SvPVX(out)[cur] = '$';
         }
@@ -3375,7 +3375,7 @@ Perl_op_class(pTHX_ const OP *o)
             return OPclass_SVOP;
 #endif
     }
-    
+
 #ifdef USE_ITHREADS
     if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
         o->op_type == OP_RCATLINE)
@@ -3412,7 +3412,7 @@ Perl_op_class(pTHX_ const OP *o)
 
     case OA_PVOP_OR_SVOP:
         /*
-         * Character translations (tr///) are usually a PVOP, keeping a 
+         * Character translations (tr///) are usually a PVOP, keeping a
          * pointer to a table of shorts used to look up translations.
          * Under utf8, however, a simple table isn't practical; instead,
          * the OP is an SVOP (or, under threads, a PADOP),