X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=c24c8e41536655ad6d4ed737719fe14c1363d940;hb=c4a9c09d5b30a93b6241aff3c9915e33e4e41eeb;hp=6206c4490a54c91adc763d1ed1730273143e4f8c;hpb=aa5b165557d6dbcd68fec46d05345cef09320ef1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index 6206c44..c24c8e4 100644 --- a/toke.c +++ b/toke.c @@ -26,9 +26,12 @@ #define yychar (*PL_yycharp) #define yylval (*PL_yylvalp) -static char ident_too_long[] = "Identifier too long"; -static char c_without_g[] = "Use of /c modifier is meaningless without /g"; -static char c_in_subst[] = "Use of /c modifier is meaningless in s///"; +static const char ident_too_long[] = + "Identifier too long"; +static const char c_without_g[] = + "Use of /c modifier is meaningless without /g"; +static const char c_in_subst[] = + "Use of /c modifier is meaningless in s///"; static void restore_rsfp(pTHX_ void *f); #ifndef PERL_NO_UTF16_FILTER @@ -76,7 +79,7 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); #define LEX_KNOWNEXT 0 #ifdef DEBUGGING -static char* lex_state_names[] = { +static const char* const lex_state_names[] = { "KNOWNEXT", "FORMLINE", "INTERPCONST", @@ -104,6 +107,15 @@ static char* lex_state_names[] = { #endif #define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline)) +/* According to some strict interpretations of ANSI C89 one cannot + * cast void pointers to code pointers or vice versa (as filter_add(), + * filter_del(), and filter_read() will want to do). We should still + * be able to use a union for sneaky "casting". */ +typedef union { + XPVIO* iop; + filter_t filter; +} xpvio_filter_u; + /* * Convenience functions to return different tokens and prime the * lexer for the next token. They all take an argument. @@ -199,7 +211,8 @@ enum token_type { TOKENTYPE_GVVAL }; -static struct debug_tokens { int token, type; char *name;} debug_tokens[] = +static struct debug_tokens { const int token, type; const char *name; } + const debug_tokens[] = { { ADDOP, TOKENTYPE_OPNUM, "ADDOP" }, { ANDAND, TOKENTYPE_NONE, "ANDAND" }, @@ -269,13 +282,13 @@ static struct debug_tokens { int token, type; char *name;} debug_tokens[] = /* dump the returned token in rv, plus any optional arg in yylval */ STATIC int -S_tokereport(pTHX_ char* s, I32 rv) +S_tokereport(pTHX_ const char* s, I32 rv) { if (DEBUG_T_TEST) { - char *name = Nullch; + const char *name = Nullch; enum token_type type = TOKENTYPE_NONE; - struct debug_tokens *p; - SV* report = newSVpvn("<== ", 4); + const struct debug_tokens *p; + SV* report = newSVpvn("<== ", 4); for (p = debug_tokens; p->token; p++) { if (p->token == (int)rv) { @@ -297,7 +310,7 @@ S_tokereport(pTHX_ char* s, I32 rv) case TOKENTYPE_GVVAL: /* doesn't appear to be used */ break; case TOKENTYPE_IVAL: - Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", yylval.ival); + Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)yylval.ival); break; case TOKENTYPE_OPNUM: Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)", @@ -314,7 +327,7 @@ S_tokereport(pTHX_ char* s, I32 rv) Perl_sv_catpv(aTHX_ report, "(opval=null)"); break; } - Perl_sv_catpvf(aTHX_ report, " at line %d [", CopLINE(PL_curcop)); + Perl_sv_catpvf(aTHX_ report, " at line %"IVdf" [", (IV)CopLINE(PL_curcop)); if (s - PL_bufptr > 0) sv_catpvn(report, PL_bufptr, s - PL_bufptr); else { @@ -365,7 +378,7 @@ S_ao(pTHX_ int toketype) */ STATIC void -S_no_op(pTHX_ char *what, char *s) +S_no_op(pTHX_ const char *what, char *s) { char *oldbp = PL_bufptr; bool is_first = (PL_oldbufptr == PL_linestart); @@ -380,7 +393,7 @@ S_no_op(pTHX_ char *what, char *s) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\t(Missing semicolon on previous line?)\n"); else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) { - char *t; + const char *t; for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++) ; if (t < PL_bufptr && isSPACE(*t)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), @@ -424,7 +437,6 @@ S_missingterm(pTHX_ char *s) ) { *tmpbuf = '^'; tmpbuf[1] = toCTRL(PL_multi_close); - s = "\\n"; tmpbuf[2] = '\0'; s = tmpbuf; } @@ -442,14 +454,14 @@ S_missingterm(pTHX_ char *s) */ void -Perl_deprecate(pTHX_ char *s) +Perl_deprecate(pTHX_ const char *s) { if (ckWARN(WARN_DEPRECATED)) Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "Use of %s is deprecated", s); } void -Perl_deprecate_old(pTHX_ char *s) +Perl_deprecate_old(pTHX_ const char *s) { /* This function should NOT be called for any new deprecated warnings */ /* Use Perl_deprecate instead */ @@ -460,7 +472,7 @@ Perl_deprecate_old(pTHX_ char *s) /* in its own right. */ if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of %s is deprecated", s); } @@ -484,8 +496,8 @@ S_depcom(pTHX) static void strip_return(SV *sv) { - register char *s = SvPVX(sv); - register char *e = s + SvCUR(sv); + register const char *s = SvPVX_const(sv); + register const char *e = s + SvCUR(sv); /* outer loop optimized to do nothing if there are no CR-LFs */ while (s < e) { if (*s++ == '\r' && *s == '\n') { @@ -506,7 +518,7 @@ strip_return(SV *sv) STATIC I32 S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - I32 count = FILTER_READ(idx+1, sv, maxlen); + const I32 count = FILTER_READ(idx+1, sv, maxlen); if (count > 0 && !maxlen) strip_return(sv); return count; @@ -776,7 +788,7 @@ S_skipspace(pTHX_ register char *s) sv_upgrade(sv, SVt_PVMG); sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr); (void)SvIOK_on(sv); - SvIVX(sv) = 0; + SvIV_set(sv, 0); av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } } @@ -874,7 +886,7 @@ STATIC SV * S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len) { SV *sv = newSVpvn(start,len); - if (UTF && !IN_BYTES && is_utf8_string((U8*)start, len)) + if (UTF && !IN_BYTES && is_utf8_string((const U8*)start, len)) SvUTF8_on(sv); return sv; } @@ -937,10 +949,10 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow */ STATIC void -S_force_ident(pTHX_ register char *s, int kind) +S_force_ident(pTHX_ register const char *s, int kind) { if (s && *s) { - OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); + OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); PL_nextval[PL_nexttoke].opval = o; force_next(WORD); if (kind) { @@ -964,9 +976,9 @@ Perl_str_to_version(pTHX_ SV *sv) NV retval = 0.0; NV nshift = 1.0; STRLEN len; - char *start = SvPVx(sv,len); - bool utf = SvUTF8(sv) ? TRUE : FALSE; - char *end = start + len; + const char *start = SvPVx(sv,len); + const char *end = start + len; + const bool utf = SvUTF8(sv) ? TRUE : FALSE; while (start < end) { STRLEN skip; UV n; @@ -1012,7 +1024,7 @@ S_force_version(pTHX_ char *s, int guessing) ver = cSVOPx(version)->op_sv; if (SvPOK(ver) && !SvNIOK(ver)) { (void)SvUPGRADE(ver, SVt_PVNV); - SvNVX(ver) = str_to_version(ver); + SvNV_set(ver, str_to_version(ver)); SvNOK_on(ver); /* hint that it is a version */ } } @@ -1057,7 +1069,7 @@ S_tokeq(pTHX_ SV *sv) goto finish; d = s; if ( PL_hints & HINT_NEW_STRING ) { - pv = sv_2mortal(newSVpvn(SvPVX(pv), len)); + pv = sv_2mortal(newSVpvn(SvPVX_const(pv), len)); if (SvUTF8(sv)) SvUTF8_on(pv); } @@ -1069,7 +1081,7 @@ S_tokeq(pTHX_ SV *sv) *d++ = *s++; } *d = '\0'; - SvCUR_set(sv, d - SvPVX(sv)); + SvCUR_set(sv, d - SvPVX_const(sv)); finish: if ( PL_hints & HINT_NEW_STRING ) return new_constant(NULL, 0, "q", sv, pv, "q"); @@ -1111,7 +1123,7 @@ S_tokeq(pTHX_ SV *sv) STATIC I32 S_sublex_start(pTHX) { - register I32 op_type = yylval.ival; + const register I32 op_type = yylval.ival; if (op_type == OP_NULL) { yylval.opval = PL_lex_op; @@ -1124,11 +1136,8 @@ S_sublex_start(pTHX) if (SvTYPE(sv) == SVt_PVIV) { /* Overloaded constants, nothing fancy: Convert to SVt_PV: */ STRLEN len; - char *p; - SV *nsv; - - p = SvPV(sv, len); - nsv = newSVpvn(p, len); + const char *p = SvPV(sv, len); + SV * const nsv = newSVpvn(p, len); if (SvUTF8(sv)) SvUTF8_on(nsv); SvREFCNT_dec(sv); @@ -1168,6 +1177,7 @@ S_sublex_start(pTHX) STATIC I32 S_sublex_push(pTHX) { + dVAR; ENTER; PL_lex_state = PL_sublex_info.super_state; @@ -1226,6 +1236,7 @@ S_sublex_push(pTHX) STATIC I32 S_sublex_done(pTHX) { + dVAR; if (!PL_lex_starts++) { SV *sv = newSVpvn("",0); if (SvUTF8(PL_linestr)) @@ -1396,7 +1407,7 @@ S_scan_const(pTHX_ char *start) continue; } - i = d - SvPVX(sv); /* remember current offset */ + i = d - SvPVX_const(sv); /* remember current offset */ SvGROW(sv, SvLEN(sv) + 256); /* never more than 256 chars in a range */ d = SvPVX(sv) + i; /* refresh d after realloc */ d -= 2; /* eat the first char and the - */ @@ -1550,7 +1561,7 @@ S_scan_const(pTHX_ char *start) default: { if (ckWARN(WARN_MISC) && - isALNUM(*s) && + isALNUM(*s) && *s != '_') Perl_warner(aTHX_ packWARN(WARN_MISC), "Unrecognized escape \\%c passed through", @@ -1623,7 +1634,7 @@ S_scan_const(pTHX_ char *start) } } if (hicount) { - STRLEN offset = d - SvPVX(sv); + STRLEN offset = d - SvPVX_const(sv); U8 *src, *dst; d = SvGROW(sv, SvLEN(sv) + hicount + 1) + offset; src = (U8 *)d - 1; @@ -1713,7 +1724,7 @@ S_scan_const(pTHX_ char *start) } #endif if (!has_utf8 && SvUTF8(res)) { - char *ostart = SvPVX(sv); + const char *ostart = SvPVX_const(sv); SvCUR_set(sv, d - ostart); SvPOK_on(sv); *d = '\0'; @@ -1724,7 +1735,7 @@ S_scan_const(pTHX_ char *start) has_utf8 = TRUE; } if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ - char *odest = SvPVX(sv); + const char *odest = SvPVX_const(sv); SvGROW(sv, (SvLEN(sv) + len - (e - s + 4))); d = SvPVX(sv) + (d - odest); @@ -1793,7 +1804,7 @@ S_scan_const(pTHX_ char *start) s += len; if (need > len) { /* encoded value larger than old, need extra space (NOTE: SvCUR() not set here) */ - STRLEN off = d - SvPVX(sv); + STRLEN off = d - SvPVX_const(sv); d = SvGROW(sv, SvLEN(sv) + (need-len)) + off; } d = (char*)uvchr_to_utf8((U8*)d, uv); @@ -1806,7 +1817,7 @@ S_scan_const(pTHX_ char *start) /* terminate the string and set up the sv */ *d = '\0'; - SvCUR_set(sv, d - SvPVX(sv)); + SvCUR_set(sv, d - SvPVX_const(sv)); if (SvCUR(sv) >= SvLEN(sv)) Perl_croak(aTHX_ "panic: constant overflowed allocated space"); @@ -1826,8 +1837,7 @@ S_scan_const(pTHX_ char *start) /* shrink the sv if we allocated more than we used */ if (SvCUR(sv) + 5 < SvLEN(sv)) { - SvLEN_set(sv, SvCUR(sv) + 1); - Renew(SvPVX(sv), SvLEN(sv), char); + SvPV_shrink_to_cur(sv); } /* return the substring (via yylval) only if we parsed anything */ @@ -1906,7 +1916,7 @@ S_intuit_more(pTHX_ register char *s) int weight = 2; /* let's weigh the evidence */ char seen[256]; unsigned char un_char = 255, last_un_char; - char *send = strchr(s,']'); + const char *send = strchr(s,']'); char tmpbuf[sizeof PL_tokenbuf * 4]; if (!send) /* has to be an expression */ @@ -2034,7 +2044,7 @@ S_intuit_method(pTHX_ char *start, GV *gv) if (GvIO(gv)) return 0; if ((cv = GvCVu(gv))) { - char *proto = SvPVX(cv); + const char *proto = SvPVX_const(cv); if (proto) { if (*proto == ';') proto++; @@ -2092,11 +2102,11 @@ S_intuit_method(pTHX_ char *start, GV *gv) * compile-time require of perl5db.pl. */ -STATIC char* +STATIC const char* S_incl_perldb(pTHX) { if (PL_perldb) { - char *pdb = PerlEnv_getenv("PERL5DB"); + const char *pdb = PerlEnv_getenv("PERL5DB"); if (pdb) return pdb; @@ -2127,6 +2137,8 @@ S_incl_perldb(pTHX) SV * Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) { + xpvio_filter_u u; + if (!funcp) return Nullsv; @@ -2134,12 +2146,12 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) PL_rsfp_filters = newAV(); if (!datasv) datasv = NEWSV(255,0); - if (!SvUPGRADE(datasv, SVt_PVIO)) - Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO"); - IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */ + (void)SvUPGRADE(datasv, SVt_PVIO); + u.filter = funcp; + IoANY(datasv) = u.iop; /* stash funcp into spare field */ IoFLAGS(datasv) |= IOf_FAKE_DIRP; DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n", - (void*)funcp, SvPV_nolen(datasv))); + (void*)u.iop, SvPV_nolen(datasv))); av_unshift(PL_rsfp_filters, 1); av_store(PL_rsfp_filters, 0, datasv) ; return(datasv); @@ -2151,12 +2163,18 @@ void Perl_filter_del(pTHX_ filter_t funcp) { SV *datasv; - DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)funcp)); + xpvio_filter_u u; + +#ifdef DEBUGGING + u.filter = funcp; + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)u.iop)); +#endif if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0) return; /* if filter is on top of stack (usual case) just pop it off */ datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters)); - if (IoANY(datasv) == (void *)funcp) { + u.iop = IoANY(datasv); + if (u.filter == funcp) { IoFLAGS(datasv) &= ~IOf_FAKE_DIRP; IoANY(datasv) = (void *)NULL; sv_free(av_pop(PL_rsfp_filters)); @@ -2175,6 +2193,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) { filter_t funcp; SV *datasv = NULL; + xpvio_filter_u u; if (!PL_rsfp_filters) return -1; @@ -2186,7 +2205,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) if (maxlen) { /* Want a block */ int len ; - int old_len = SvCUR(buf_sv) ; + const int old_len = SvCUR(buf_sv); /* ensure buf_sv is large enough */ SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ; @@ -2216,10 +2235,11 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ - funcp = (filter_t)IoANY(datasv); + u.iop = IoANY(datasv); + funcp = u.filter; DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", - idx, (void*)funcp, SvPV_nolen(datasv))); + idx, (void*)u.iop, SvPV_nolen(datasv))); /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ @@ -2247,7 +2267,7 @@ S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) } STATIC HV * -S_find_in_my_stash(pTHX_ char *pkgname, I32 len) +S_find_in_my_stash(pTHX_ const char *pkgname, I32 len) { GV *gv; @@ -2273,7 +2293,7 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len) } #ifdef DEBUGGING - static char* exp_name[] = + static const char* const exp_name[] = { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK", "ATTRTERM", "TERMBLOCK", "TERMORDORDOR" }; @@ -2362,11 +2382,9 @@ Perl_yylex(pTHX) #endif /* handle \E or end of string */ if (PL_bufptr == PL_bufend || PL_bufptr[1] == 'E') { - char oldmod; - /* if at a \E */ if (PL_lex_casemods) { - oldmod = PL_lex_casestack[--PL_lex_casemods]; + const char oldmod = PL_lex_casestack[--PL_lex_casemods]; PL_lex_casestack[PL_lex_casemods] = '\0'; if (PL_bufptr != PL_bufend @@ -2604,14 +2622,14 @@ Perl_yylex(pTHX) /* The count here deliberately includes the NUL that terminates the C string constant. This embeds the opening NUL into the string. */ + const char *splits = PL_splitstr; sv_catpvn(PL_linestr, "our @F=split(q", 15); - s = PL_splitstr; do { /* Need to \ \s */ - if (*s == '\\') - sv_catpvn(PL_linestr, s, 1); - sv_catpvn(PL_linestr, s, 1); - } while (*s++); + if (*splits == '\\') + sv_catpvn(PL_linestr, splits, 1); + sv_catpvn(PL_linestr, splits, 1); + } while (*splits++); /* This loop will embed the trailing NUL of PL_linestr as the last thing it does before terminating. */ @@ -2632,7 +2650,7 @@ Perl_yylex(pTHX) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); - SvIVX(sv) = 0; + SvIV_set(sv, 0); av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } goto retry; @@ -2662,7 +2680,7 @@ Perl_yylex(pTHX) } PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_last_lop = PL_last_uni = Nullch; - sv_setpv(PL_linestr,""); + sv_setpvn(PL_linestr,"",0); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ } /* If it looks like the start of a BOM or raw UTF-16, @@ -2703,7 +2721,7 @@ Perl_yylex(pTHX) if (PL_doextract) { /* Incest with pod. */ if (*s == '=' && strnEQ(s, "=cut", 4)) { - sv_setpv(PL_linestr, ""); + sv_setpvn(PL_linestr, "", 0); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = Nullch; @@ -2719,7 +2737,7 @@ Perl_yylex(pTHX) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); - SvIVX(sv) = 0; + SvIV_set(sv, 0); av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); @@ -2735,7 +2753,7 @@ Perl_yylex(pTHX) d = s + 2; #ifdef ALTERNATE_SHEBANG else { - static char as[] = ALTERNATE_SHEBANG; + static char const as[] = ALTERNATE_SHEBANG; if (*s == as[0] && strnEQ(s, as, sizeof(as) - 1)) d = s + (sizeof(as) - 1); } @@ -2769,8 +2787,8 @@ Perl_yylex(pTHX) else { STRLEN blen; STRLEN llen; - char *bstart = SvPV(CopFILESV(PL_curcop),blen); - char *lstart = SvPV(x,llen); + const char *bstart = SvPV(CopFILESV(PL_curcop),blen); + const char *lstart = SvPV(x,llen); if (llen < blen) { bstart += blen - llen; if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') { @@ -2816,7 +2834,7 @@ Perl_yylex(pTHX) * contains the start of the Perl program. */ if (d && *s != '#') { - char *c = ipath; + const char *c = ipath; while (*c && !strchr("; \t\r\n\f\v#", *c)) c++; if (c < d) @@ -2833,6 +2851,7 @@ Perl_yylex(pTHX) !instr(s,"indir") && instr(PL_origargv[0],"perl")) { + dVAR; char **newargv; *ipathend = '\0'; @@ -2857,18 +2876,18 @@ Perl_yylex(pTHX) } #endif if (d) { - U32 oldpdb = PL_perldb; - bool oldn = PL_minus_n; - bool oldp = PL_minus_p; + const U32 oldpdb = PL_perldb; + const bool oldn = PL_minus_n; + const bool oldp = PL_minus_p; while (*d && !isSPACE(*d)) d++; while (SPACE_OR_TAB(*d)) d++; if (*d++ == '-') { - bool switches_done = PL_doswitches; + const bool switches_done = PL_doswitches; do { - if (*d == 'M' || *d == 'm') { - char *m = d; + if (*d == 'M' || *d == 'm' || *d == 'C') { + const char *m = d; while (*d && !isSPACE(*d)) d++; Perl_croak(aTHX_ "Too late for \"-%.*s\" option", (int)(d - m), m); @@ -2888,7 +2907,7 @@ Perl_yylex(pTHX) /* if we have already added "LINE: while (<>) {", we must not do it again */ { - sv_setpv(PL_linestr, ""); + sv_setpvn(PL_linestr, "", 0); PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); PL_last_lop = PL_last_uni = Nullch; @@ -3179,7 +3198,7 @@ Perl_yylex(pTHX) #else ; /* skip to avoid loading attributes.pm */ #endif - else + else Perl_croak(aTHX_ "The 'unique' attribute may only be applied to 'our' variables"); } @@ -3216,7 +3235,7 @@ Perl_yylex(pTHX) } tmp = (PL_expect == XOPERATOR ? '=' : '{'); /*'}(' for vi */ if (*s != ';' && *s != '}' && *s != tmp && (tmp != '=' || *s != ')')) { - char q = ((*s == '\'') ? '"' : '\''); + const char q = ((*s == '\'') ? '"' : '\''); /* If here for an expression, and parsed no attrs, back off. */ if (tmp == '=' && !attrs) { s = PL_bufptr; @@ -3308,7 +3327,7 @@ Perl_yylex(pTHX) while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; if (*d == '}') { - char minus = (PL_tokenbuf[0] == '-'); + const char minus = (PL_tokenbuf[0] == '-'); s = force_word(s + minus, WORD, FALSE, TRUE, FALSE); if (minus) force_next('-'); @@ -3326,7 +3345,7 @@ Perl_yylex(pTHX) PL_expect = XSTATE; break; default: { - char *t; + const char *t; if (PL_oldoldbufptr == PL_last_lop) PL_lex_brackstack[PL_lex_brackets++] = XTERM; else @@ -3372,7 +3391,7 @@ Perl_yylex(pTHX) && !isALNUM(*t)))) { /* skip q//-like construct */ - char *tmps; + const char *tmps; char open, close, term; I32 brackets = 1; @@ -3538,7 +3557,7 @@ Perl_yylex(pTHX) goto retry; } if (PL_lex_brackets < PL_lex_formbrack) { - char *t; + const char *t; #ifdef PERL_STRICT_CR for (t = s; SPACE_OR_TAB(*t); t++) ; #else @@ -3560,7 +3579,7 @@ Perl_yylex(pTHX) * warn on m:!=~\s+([/?]|[msy]\W|tr\W): */ if (*s == '~' && ckWARN(WARN_SYNTAX)) { - char *t = s+1; + const char *t = s+1; while (t < PL_bufend && isSPACE(*t)) ++t; @@ -3682,9 +3701,9 @@ Perl_yylex(pTHX) (t = strchr(s, '}')) && (t = strchr(t, '='))) { char tmpbuf[sizeof PL_tokenbuf]; - STRLEN len; for (t++; isSPACE(*t); t++) ; if (isIDFIRST_lazy_if(t,UTF)) { + STRLEN len; t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len); for (; isSPACE(*t); t++) ; if (*t == ';' && get_cv(tmpbuf, FALSE)) @@ -3697,7 +3716,7 @@ Perl_yylex(pTHX) PL_expect = XOPERATOR; if (PL_lex_state == LEX_NORMAL && isSPACE((char)tmp)) { - bool islop = (PL_last_lop == PL_oldoldbufptr); + const bool islop = (PL_last_lop == PL_oldoldbufptr); if (!islop || PL_last_lop_op == OP_GREPSTART) PL_expect = XOPERATOR; else if (strchr("$@\"'`q", *s)) @@ -3761,7 +3780,7 @@ Perl_yylex(pTHX) /* Warn about @ where they meant $. */ if (ckWARN(WARN_SYNTAX)) { if (*s == '[' || *s == '{') { - char *t = s + 1; + const char *t = s + 1; while (*t && (isALNUM_lazy_if(t,UTF) || strchr(" \t$#+-'\"", *t))) t++; if (*t == '}' || *t == ']') { @@ -3920,9 +3939,7 @@ Perl_yylex(pTHX) case 'v': if (isDIGIT(s[1]) && PL_expect != XOPERATOR) { - char *start = s; - start++; - start++; + char *start = s + 2; while (isDIGIT(*start) || *start == '_') start++; if (*start == '.' && isDIGIT(start[1])) { @@ -3933,7 +3950,7 @@ Perl_yylex(pTHX) else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE || PL_expect == XTERMORDORDOR)) { - char c = *start; + const char c = *start; GV *gv; *start = '\0'; gv = gv_fetchpv(s, FALSE, SVt_PVCV); @@ -4089,7 +4106,7 @@ Perl_yylex(pTHX) just_a_word: { SV *sv; int pkgname = 0; - char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]); + const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]); /* Get the rest if it looks like a package qualifier */ @@ -4156,7 +4173,7 @@ Perl_yylex(pTHX) yylval.opval->op_private = OPpCONST_BARE; /* UTF-8 package name? */ if (UTF && !IN_BYTES && - is_utf8_string((U8*)SvPVX(sv), SvCUR(sv))) + is_utf8_string((U8*)SvPVX_const(sv), SvCUR(sv))) SvUTF8_on(sv); /* And if "Foo::", then that's what it certainly is. */ @@ -4276,7 +4293,7 @@ Perl_yylex(pTHX) while (*proto == ';') proto++; if (*proto == '&' && *s == '{') { - sv_setpv(PL_subname, PL_curstash ? + sv_setpv(PL_subname, PL_curstash ? "__ANON__" : "__ANON__::__ANON__"); PREBLOCK(LSTOPSUB); } @@ -4329,7 +4346,7 @@ Perl_yylex(pTHX) case KEY___PACKAGE__: yylval.opval = (OP*)newSVOP(OP_CONST, 0, (PL_curstash - ? newSVpv(HvNAME(PL_curstash), 0) + ? newSVpv(HvNAME_get(PL_curstash), 0) : &PL_sv_undef)); TERM(THING); @@ -4339,9 +4356,9 @@ Perl_yylex(pTHX) /*SUPPRESS 560*/ if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D')) { - char *pname = "main"; + const char *pname = "main"; if (PL_tokenbuf[2] == 'D') - pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash); + pname = HvNAME_get(PL_curstash ? PL_curstash : PL_defstash); gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO); GvMULTI_on(gv); if (!GvIO(gv)) @@ -4349,7 +4366,7 @@ Perl_yylex(pTHX) IoIFP(GvIOp(gv)) = PL_rsfp; #if defined(HAS_FCNTL) && defined(F_SETFD) { - int fd = PerlIO_fileno(PL_rsfp); + const int fd = PerlIO_fileno(PL_rsfp); fcntl(fd,F_SETFD,fd >= 3); } #endif @@ -4406,7 +4423,7 @@ Perl_yylex(pTHX) SPAGAIN; name = POPs; PUTBACK; - PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, + PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, Perl_form(aTHX_ ":encoding(%"SVf")", name)); FREETMPS; @@ -4868,7 +4885,7 @@ Perl_yylex(pTHX) case KEY_open: s = skipspace(s); if (isIDFIRST_lazy_if(s,UTF)) { - char *t; + const char *t; for (d = s; isALNUM_lazy_if(d,UTF); d++) ; for (t=d; *t && isSPACE(*t); t++) ; if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) @@ -4939,6 +4956,7 @@ Perl_yylex(pTHX) s = scan_str(s,FALSE,FALSE); if (!s) missingterm((char*)0); + PL_expect = XOPERATOR; force_next(')'); if (SvCUR(PL_lex_stuff)) { OP *words = Nullop; @@ -4948,7 +4966,7 @@ Perl_yylex(pTHX) SV *sv; for (; isSPACE(*d) && len; --len, ++d) ; if (len) { - char *b = d; + const char *b = d; if (!warned && ckWARN(WARN_QW)) { for (; !isSPACE(*d) && len; --len, ++d) { if (*d == ',') { @@ -4991,7 +5009,7 @@ Perl_yylex(pTHX) missingterm((char*)0); yylval.ival = OP_STRINGIFY; if (SvIVX(PL_lex_stuff) == '\'') - SvIVX(PL_lex_stuff) = 0; /* qq'$foo' should intepolate */ + SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should intepolate */ TERM(sublex_start()); case KEY_qr: @@ -5206,7 +5224,7 @@ Perl_yylex(pTHX) SSize_t tboffset = 0; expectation attrful; bool have_name, have_proto, bad_proto; - int key = tmp; + const int key = tmp; s = skipspace(s); @@ -5233,7 +5251,7 @@ Perl_yylex(pTHX) Perl_croak(aTHX_ "Missing name in \"my sub\""); PL_expect = XTERMBLOCK; attrful = XATTRTERM; - sv_setpv(PL_subname,"?"); + sv_setpvn(PL_subname,"?",1); have_name = FALSE; } @@ -5269,7 +5287,7 @@ Perl_yylex(pTHX) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Illegal character in prototype for %"SVf" : %s", PL_subname, d); - SvCUR(PL_lex_stuff) = tmp; + SvCUR_set(PL_lex_stuff, tmp); have_proto = TRUE; s = skipspace(s); @@ -5519,7 +5537,7 @@ S_pending_ident(pTHX) /* might be an "our" variable" */ if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { /* build ops for a bareword */ - SV *sym = newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)), 0); + SV *sym = newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)), 0); sv_catpvn(sym, "::", 2); sv_catpv(sym, PL_tokenbuf+1); yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); @@ -5585,1347 +5603,3312 @@ S_pending_ident(pTHX) return WORD; } -/* Weights are the number of occurrences of that keyword in about 135M of - input to Perl_keyword from a lot of real perl. This routine is about 20% - faster than the routine it replaces. */ +/* + * The following code was generated by perl_keyword.pl. + */ I32 -Perl_keyword (pTHX_ char *name, I32 len) { - /* Initially switch on the length of the name. */ - switch (len) { - case 1: - /* Names all of length 1. */ - /* m q s x y */ - /* Offset 0 gives the best switch position. */ - switch (name[0]) { - case 'm': +Perl_keyword (pTHX_ const char *name, I32 len) +{ + switch (len) + { + case 1: /* 5 tokens of length 1 */ + switch (name[0]) { - return KEY_m; /* Weight 148776 */ + case 'm': + { /* m */ + return KEY_m; + } + + case 'q': + { /* q */ + return KEY_q; + } + + case 's': + { /* s */ + return KEY_s; + } + + case 'x': + { /* x */ + return -KEY_x; + } + + case 'y': + { /* y */ + return KEY_y; + } + + default: + goto unknown; } - break; - case 'q': + + case 2: /* 18 tokens of length 2 */ + switch (name[0]) { - return KEY_q; /* Weight 69076 */ - } - break; - case 's': + case 'd': + if (name[1] == 'o') + { /* do */ + return KEY_do; + } + + goto unknown; + + case 'e': + if (name[1] == 'q') + { /* eq */ + return -KEY_eq; + } + + goto unknown; + + case 'g': + switch (name[1]) + { + case 'e': + { /* ge */ + return -KEY_ge; + } + + case 't': + { /* gt */ + return -KEY_gt; + } + + default: + goto unknown; + } + + case 'i': + if (name[1] == 'f') + { /* if */ + return KEY_if; + } + + goto unknown; + + case 'l': + switch (name[1]) + { + case 'c': + { /* lc */ + return -KEY_lc; + } + + case 'e': + { /* le */ + return -KEY_le; + } + + case 't': + { /* lt */ + return -KEY_lt; + } + + default: + goto unknown; + } + + case 'm': + if (name[1] == 'y') + { /* my */ + return KEY_my; + } + + goto unknown; + + case 'n': + switch (name[1]) + { + case 'e': + { /* ne */ + return -KEY_ne; + } + + case 'o': + { /* no */ + return KEY_no; + } + + default: + goto unknown; + } + + case 'o': + if (name[1] == 'r') + { /* or */ + return -KEY_or; + } + + goto unknown; + + case 'q': + switch (name[1]) + { + case 'q': + { /* qq */ + return KEY_qq; + } + + case 'r': + { /* qr */ + return KEY_qr; + } + + case 'w': + { /* qw */ + return KEY_qw; + } + + case 'x': + { /* qx */ + return KEY_qx; + } + + default: + goto unknown; + } + + case 't': + if (name[1] == 'r') + { /* tr */ + return KEY_tr; + } + + goto unknown; + + case 'u': + if (name[1] == 'c') + { /* uc */ + return -KEY_uc; + } + + goto unknown; + + default: + goto unknown; + } + + case 3: /* 28 tokens of length 3 */ + switch (name[0]) { - return KEY_s; /* Weight 403691 */ + case 'E': + if (name[1] == 'N' && + name[2] == 'D') + { /* END */ + return KEY_END; + } + + goto unknown; + + case 'a': + switch (name[1]) + { + case 'b': + if (name[2] == 's') + { /* abs */ + return -KEY_abs; + } + + goto unknown; + + case 'n': + if (name[2] == 'd') + { /* and */ + return -KEY_and; + } + + goto unknown; + + default: + goto unknown; + } + + case 'c': + switch (name[1]) + { + case 'h': + if (name[2] == 'r') + { /* chr */ + return -KEY_chr; + } + + goto unknown; + + case 'm': + if (name[2] == 'p') + { /* cmp */ + return -KEY_cmp; + } + + goto unknown; + + case 'o': + if (name[2] == 's') + { /* cos */ + return -KEY_cos; + } + + goto unknown; + + default: + goto unknown; + } + + case 'd': + if (name[1] == 'i' && + name[2] == 'e') + { /* die */ + return -KEY_die; + } + + goto unknown; + + case 'e': + switch (name[1]) + { + case 'o': + if (name[2] == 'f') + { /* eof */ + return -KEY_eof; + } + + goto unknown; + + case 'r': + if (name[2] == 'r') + { /* err */ + return -KEY_err; + } + + goto unknown; + + case 'x': + if (name[2] == 'p') + { /* exp */ + return -KEY_exp; + } + + goto unknown; + + default: + goto unknown; + } + + case 'f': + if (name[1] == 'o' && + name[2] == 'r') + { /* for */ + return KEY_for; + } + + goto unknown; + + case 'h': + if (name[1] == 'e' && + name[2] == 'x') + { /* hex */ + return -KEY_hex; + } + + goto unknown; + + case 'i': + if (name[1] == 'n' && + name[2] == 't') + { /* int */ + return -KEY_int; + } + + goto unknown; + + case 'l': + if (name[1] == 'o' && + name[2] == 'g') + { /* log */ + return -KEY_log; + } + + goto unknown; + + case 'm': + if (name[1] == 'a' && + name[2] == 'p') + { /* map */ + return KEY_map; + } + + goto unknown; + + case 'n': + if (name[1] == 'o' && + name[2] == 't') + { /* not */ + return -KEY_not; + } + + goto unknown; + + case 'o': + switch (name[1]) + { + case 'c': + if (name[2] == 't') + { /* oct */ + return -KEY_oct; + } + + goto unknown; + + case 'r': + if (name[2] == 'd') + { /* ord */ + return -KEY_ord; + } + + goto unknown; + + case 'u': + if (name[2] == 'r') + { /* our */ + return KEY_our; + } + + goto unknown; + + default: + goto unknown; + } + + case 'p': + if (name[1] == 'o') + { + switch (name[2]) + { + case 'p': + { /* pop */ + return -KEY_pop; + } + + case 's': + { /* pos */ + return KEY_pos; + } + + default: + goto unknown; + } + } + + goto unknown; + + case 'r': + if (name[1] == 'e' && + name[2] == 'f') + { /* ref */ + return -KEY_ref; + } + + goto unknown; + + case 's': + switch (name[1]) + { + case 'i': + if (name[2] == 'n') + { /* sin */ + return -KEY_sin; + } + + goto unknown; + + case 'u': + if (name[2] == 'b') + { /* sub */ + return KEY_sub; + } + + goto unknown; + + default: + goto unknown; + } + + case 't': + if (name[1] == 'i' && + name[2] == 'e') + { /* tie */ + return KEY_tie; + } + + goto unknown; + + case 'u': + if (name[1] == 's' && + name[2] == 'e') + { /* use */ + return KEY_use; + } + + goto unknown; + + case 'v': + if (name[1] == 'e' && + name[2] == 'c') + { /* vec */ + return -KEY_vec; + } + + goto unknown; + + case 'x': + if (name[1] == 'o' && + name[2] == 'r') + { /* xor */ + return -KEY_xor; + } + + goto unknown; + + default: + goto unknown; } - break; - case 'x': + + case 4: /* 40 tokens of length 4 */ + switch (name[0]) { - return -KEY_x; /* Weight 38549 */ + case 'C': + if (name[1] == 'O' && + name[2] == 'R' && + name[3] == 'E') + { /* CORE */ + return -KEY_CORE; + } + + goto unknown; + + case 'I': + if (name[1] == 'N' && + name[2] == 'I' && + name[3] == 'T') + { /* INIT */ + return KEY_INIT; + } + + goto unknown; + + case 'b': + if (name[1] == 'i' && + name[2] == 'n' && + name[3] == 'd') + { /* bind */ + return -KEY_bind; + } + + goto unknown; + + case 'c': + if (name[1] == 'h' && + name[2] == 'o' && + name[3] == 'p') + { /* chop */ + return -KEY_chop; + } + + goto unknown; + + case 'd': + if (name[1] == 'u' && + name[2] == 'm' && + name[3] == 'p') + { /* dump */ + return -KEY_dump; + } + + goto unknown; + + case 'e': + switch (name[1]) + { + case 'a': + if (name[2] == 'c' && + name[3] == 'h') + { /* each */ + return -KEY_each; + } + + goto unknown; + + case 'l': + if (name[2] == 's' && + name[3] == 'e') + { /* else */ + return KEY_else; + } + + goto unknown; + + case 'v': + if (name[2] == 'a' && + name[3] == 'l') + { /* eval */ + return KEY_eval; + } + + goto unknown; + + case 'x': + switch (name[2]) + { + case 'e': + if (name[3] == 'c') + { /* exec */ + return -KEY_exec; + } + + goto unknown; + + case 'i': + if (name[3] == 't') + { /* exit */ + return -KEY_exit; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 'f': + if (name[1] == 'o' && + name[2] == 'r' && + name[3] == 'k') + { /* fork */ + return -KEY_fork; + } + + goto unknown; + + case 'g': + switch (name[1]) + { + case 'e': + if (name[2] == 't' && + name[3] == 'c') + { /* getc */ + return -KEY_getc; + } + + goto unknown; + + case 'l': + if (name[2] == 'o' && + name[3] == 'b') + { /* glob */ + return KEY_glob; + } + + goto unknown; + + case 'o': + if (name[2] == 't' && + name[3] == 'o') + { /* goto */ + return KEY_goto; + } + + goto unknown; + + case 'r': + if (name[2] == 'e' && + name[3] == 'p') + { /* grep */ + return KEY_grep; + } + + goto unknown; + + default: + goto unknown; + } + + case 'j': + if (name[1] == 'o' && + name[2] == 'i' && + name[3] == 'n') + { /* join */ + return -KEY_join; + } + + goto unknown; + + case 'k': + switch (name[1]) + { + case 'e': + if (name[2] == 'y' && + name[3] == 's') + { /* keys */ + return -KEY_keys; + } + + goto unknown; + + case 'i': + if (name[2] == 'l' && + name[3] == 'l') + { /* kill */ + return -KEY_kill; + } + + goto unknown; + + default: + goto unknown; + } + + case 'l': + switch (name[1]) + { + case 'a': + if (name[2] == 's' && + name[3] == 't') + { /* last */ + return KEY_last; + } + + goto unknown; + + case 'i': + if (name[2] == 'n' && + name[3] == 'k') + { /* link */ + return -KEY_link; + } + + goto unknown; + + case 'o': + if (name[2] == 'c' && + name[3] == 'k') + { /* lock */ + return -KEY_lock; + } + + goto unknown; + + default: + goto unknown; + } + + case 'n': + if (name[1] == 'e' && + name[2] == 'x' && + name[3] == 't') + { /* next */ + return KEY_next; + } + + goto unknown; + + case 'o': + if (name[1] == 'p' && + name[2] == 'e' && + name[3] == 'n') + { /* open */ + return -KEY_open; + } + + goto unknown; + + case 'p': + switch (name[1]) + { + case 'a': + if (name[2] == 'c' && + name[3] == 'k') + { /* pack */ + return -KEY_pack; + } + + goto unknown; + + case 'i': + if (name[2] == 'p' && + name[3] == 'e') + { /* pipe */ + return -KEY_pipe; + } + + goto unknown; + + case 'u': + if (name[2] == 's' && + name[3] == 'h') + { /* push */ + return -KEY_push; + } + + goto unknown; + + default: + goto unknown; + } + + case 'r': + switch (name[1]) + { + case 'a': + if (name[2] == 'n' && + name[3] == 'd') + { /* rand */ + return -KEY_rand; + } + + goto unknown; + + case 'e': + switch (name[2]) + { + case 'a': + if (name[3] == 'd') + { /* read */ + return -KEY_read; + } + + goto unknown; + + case 'c': + if (name[3] == 'v') + { /* recv */ + return -KEY_recv; + } + + goto unknown; + + case 'd': + if (name[3] == 'o') + { /* redo */ + return KEY_redo; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 's': + switch (name[1]) + { + case 'e': + switch (name[2]) + { + case 'e': + if (name[3] == 'k') + { /* seek */ + return -KEY_seek; + } + + goto unknown; + + case 'n': + if (name[3] == 'd') + { /* send */ + return -KEY_send; + } + + goto unknown; + + default: + goto unknown; + } + + case 'o': + if (name[2] == 'r' && + name[3] == 't') + { /* sort */ + return KEY_sort; + } + + goto unknown; + + case 'q': + if (name[2] == 'r' && + name[3] == 't') + { /* sqrt */ + return -KEY_sqrt; + } + + goto unknown; + + case 't': + if (name[2] == 'a' && + name[3] == 't') + { /* stat */ + return -KEY_stat; + } + + goto unknown; + + default: + goto unknown; + } + + case 't': + switch (name[1]) + { + case 'e': + if (name[2] == 'l' && + name[3] == 'l') + { /* tell */ + return -KEY_tell; + } + + goto unknown; + + case 'i': + switch (name[2]) + { + case 'e': + if (name[3] == 'd') + { /* tied */ + return KEY_tied; + } + + goto unknown; + + case 'm': + if (name[3] == 'e') + { /* time */ + return -KEY_time; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 'w': + if (name[1] == 'a') + { + switch (name[2]) + { + case 'i': + if (name[3] == 't') + { /* wait */ + return -KEY_wait; + } + + goto unknown; + + case 'r': + if (name[3] == 'n') + { /* warn */ + return -KEY_warn; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + default: + goto unknown; } - break; - case 'y': + + case 5: /* 36 tokens of length 5 */ + switch (name[0]) { - return KEY_y; /* Weight 567 */ - } - break; - } - break; - case 2: - /* Names all of length 2. */ - /* do eq ge gt if lc le lt my ne no or qq qr qw qx tr uc */ - /* Offset 0 gives the best switch position. */ - switch (name[0]) { - case 'd': - if (name[1] == 'o') { - return KEY_do; /* Weight 96004 */ - } - break; - case 'e': - if (name[1] == 'q') { - return -KEY_eq; /* Weight 797065 */ - } - break; - case 'g': - if (name[1] == 'e') { - return -KEY_ge; /* Weight 5666 */ - } - if (name[1] == 't') { - return -KEY_gt; /* Weight 897 */ - } - break; - case 'i': - if (name[1] == 'f') { - return KEY_if; /* Weight 2482605 */ - } - break; - case 'l': - if (name[1] == 'c') { - return -KEY_lc; /* Weight 38487 */ - } - if (name[1] == 'e') { - return -KEY_le; /* Weight 4052 */ - } - if (name[1] == 't') { - return -KEY_lt; /* Weight 335 */ - } - break; - case 'm': - if (name[1] == 'y') { - return KEY_my; /* Weight 3785925 */ - } - break; - case 'n': - if (name[1] == 'e') { - return -KEY_ne; /* Weight 112906 */ - } - if (name[1] == 'o') { - return KEY_no; /* Weight 61989 */ - } - break; - case 'o': - if (name[1] == 'r') { - return -KEY_or; /* Weight 405163 */ - } - break; - case 'q': - if (name[1] == 'w') { - return KEY_qw; /* Weight 415641 */ - } - if (name[1] == 'q') { - return KEY_qq; /* Weight 55149 */ - } - if (name[1] == 'r') { - return KEY_qr; /* Weight 28519 */ - } - if (name[1] == 'x') { - return KEY_qx; /* Weight 177 */ - } - break; - case 't': - if (name[1] == 'r') { - return KEY_tr; /* Weight 22665 */ - } - break; - case 'u': - if (name[1] == 'c') { - return -KEY_uc; /* Weight 16961 */ + case 'B': + if (name[1] == 'E' && + name[2] == 'G' && + name[3] == 'I' && + name[4] == 'N') + { /* BEGIN */ + return KEY_BEGIN; + } + + goto unknown; + + case 'C': + if (name[1] == 'H' && + name[2] == 'E' && + name[3] == 'C' && + name[4] == 'K') + { /* CHECK */ + return KEY_CHECK; + } + + goto unknown; + + case 'a': + switch (name[1]) + { + case 'l': + if (name[2] == 'a' && + name[3] == 'r' && + name[4] == 'm') + { /* alarm */ + return -KEY_alarm; + } + + goto unknown; + + case 't': + if (name[2] == 'a' && + name[3] == 'n' && + name[4] == '2') + { /* atan2 */ + return -KEY_atan2; + } + + goto unknown; + + default: + goto unknown; + } + + case 'b': + if (name[1] == 'l' && + name[2] == 'e' && + name[3] == 's' && + name[4] == 's') + { /* bless */ + return -KEY_bless; + } + + goto unknown; + + case 'c': + switch (name[1]) + { + case 'h': + switch (name[2]) + { + case 'd': + if (name[3] == 'i' && + name[4] == 'r') + { /* chdir */ + return -KEY_chdir; + } + + goto unknown; + + case 'm': + if (name[3] == 'o' && + name[4] == 'd') + { /* chmod */ + return -KEY_chmod; + } + + goto unknown; + + case 'o': + switch (name[3]) + { + case 'm': + if (name[4] == 'p') + { /* chomp */ + return -KEY_chomp; + } + + goto unknown; + + case 'w': + if (name[4] == 'n') + { /* chown */ + return -KEY_chown; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 'l': + if (name[2] == 'o' && + name[3] == 's' && + name[4] == 'e') + { /* close */ + return -KEY_close; + } + + goto unknown; + + case 'r': + if (name[2] == 'y' && + name[3] == 'p' && + name[4] == 't') + { /* crypt */ + return -KEY_crypt; + } + + goto unknown; + + default: + goto unknown; + } + + case 'e': + if (name[1] == 'l' && + name[2] == 's' && + name[3] == 'i' && + name[4] == 'f') + { /* elsif */ + return KEY_elsif; + } + + goto unknown; + + case 'f': + switch (name[1]) + { + case 'c': + if (name[2] == 'n' && + name[3] == 't' && + name[4] == 'l') + { /* fcntl */ + return -KEY_fcntl; + } + + goto unknown; + + case 'l': + if (name[2] == 'o' && + name[3] == 'c' && + name[4] == 'k') + { /* flock */ + return -KEY_flock; + } + + goto unknown; + + default: + goto unknown; + } + + case 'i': + switch (name[1]) + { + case 'n': + if (name[2] == 'd' && + name[3] == 'e' && + name[4] == 'x') + { /* index */ + return -KEY_index; + } + + goto unknown; + + case 'o': + if (name[2] == 'c' && + name[3] == 't' && + name[4] == 'l') + { /* ioctl */ + return -KEY_ioctl; + } + + goto unknown; + + default: + goto unknown; + } + + case 'l': + switch (name[1]) + { + case 'o': + if (name[2] == 'c' && + name[3] == 'a' && + name[4] == 'l') + { /* local */ + return KEY_local; + } + + goto unknown; + + case 's': + if (name[2] == 't' && + name[3] == 'a' && + name[4] == 't') + { /* lstat */ + return -KEY_lstat; + } + + goto unknown; + + default: + goto unknown; + } + + case 'm': + if (name[1] == 'k' && + name[2] == 'd' && + name[3] == 'i' && + name[4] == 'r') + { /* mkdir */ + return -KEY_mkdir; + } + + goto unknown; + + case 'p': + if (name[1] == 'r' && + name[2] == 'i' && + name[3] == 'n' && + name[4] == 't') + { /* print */ + return KEY_print; + } + + goto unknown; + + case 'r': + switch (name[1]) + { + case 'e': + if (name[2] == 's' && + name[3] == 'e' && + name[4] == 't') + { /* reset */ + return -KEY_reset; + } + + goto unknown; + + case 'm': + if (name[2] == 'd' && + name[3] == 'i' && + name[4] == 'r') + { /* rmdir */ + return -KEY_rmdir; + } + + goto unknown; + + default: + goto unknown; + } + + case 's': + switch (name[1]) + { + case 'e': + if (name[2] == 'm' && + name[3] == 'o' && + name[4] == 'p') + { /* semop */ + return -KEY_semop; + } + + goto unknown; + + case 'h': + if (name[2] == 'i' && + name[3] == 'f' && + name[4] == 't') + { /* shift */ + return -KEY_shift; + } + + goto unknown; + + case 'l': + if (name[2] == 'e' && + name[3] == 'e' && + name[4] == 'p') + { /* sleep */ + return -KEY_sleep; + } + + goto unknown; + + case 'p': + if (name[2] == 'l' && + name[3] == 'i' && + name[4] == 't') + { /* split */ + return KEY_split; + } + + goto unknown; + + case 'r': + if (name[2] == 'a' && + name[3] == 'n' && + name[4] == 'd') + { /* srand */ + return -KEY_srand; + } + + goto unknown; + + case 't': + if (name[2] == 'u' && + name[3] == 'd' && + name[4] == 'y') + { /* study */ + return KEY_study; + } + + goto unknown; + + default: + goto unknown; + } + + case 't': + if (name[1] == 'i' && + name[2] == 'm' && + name[3] == 'e' && + name[4] == 's') + { /* times */ + return -KEY_times; + } + + goto unknown; + + case 'u': + switch (name[1]) + { + case 'm': + if (name[2] == 'a' && + name[3] == 's' && + name[4] == 'k') + { /* umask */ + return -KEY_umask; + } + + goto unknown; + + case 'n': + switch (name[2]) + { + case 'd': + if (name[3] == 'e' && + name[4] == 'f') + { /* undef */ + return KEY_undef; + } + + goto unknown; + + case 't': + if (name[3] == 'i') + { + switch (name[4]) + { + case 'e': + { /* untie */ + return KEY_untie; + } + + case 'l': + { /* until */ + return KEY_until; + } + + default: + goto unknown; + } + } + + goto unknown; + + default: + goto unknown; + } + + case 't': + if (name[2] == 'i' && + name[3] == 'm' && + name[4] == 'e') + { /* utime */ + return -KEY_utime; + } + + goto unknown; + + default: + goto unknown; + } + + case 'w': + switch (name[1]) + { + case 'h': + if (name[2] == 'i' && + name[3] == 'l' && + name[4] == 'e') + { /* while */ + return KEY_while; + } + + goto unknown; + + case 'r': + if (name[2] == 'i' && + name[3] == 't' && + name[4] == 'e') + { /* write */ + return -KEY_write; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; } - break; - } - break; - case 3: - /* Names all of length 3. */ - /* END abs and chr cmp cos die eof err exp for hex int log map not oct ord - our pop pos ref sin sub tie use vec xor */ - /* Offset 0 gives the best switch position. */ - switch (*name++) { - case 'E': - if (name[0] == 'N' && name[1] == 'D') { - return KEY_END; /* Weight 3565 */ + + case 6: /* 33 tokens of length 6 */ + switch (name[0]) + { + case 'a': + if (name[1] == 'c' && + name[2] == 'c' && + name[3] == 'e' && + name[4] == 'p' && + name[5] == 't') + { /* accept */ + return -KEY_accept; + } + + goto unknown; + + case 'c': + switch (name[1]) + { + case 'a': + if (name[2] == 'l' && + name[3] == 'l' && + name[4] == 'e' && + name[5] == 'r') + { /* caller */ + return -KEY_caller; + } + + goto unknown; + + case 'h': + if (name[2] == 'r' && + name[3] == 'o' && + name[4] == 'o' && + name[5] == 't') + { /* chroot */ + return -KEY_chroot; + } + + goto unknown; + + default: + goto unknown; + } + + case 'd': + if (name[1] == 'e' && + name[2] == 'l' && + name[3] == 'e' && + name[4] == 't' && + name[5] == 'e') + { /* delete */ + return KEY_delete; + } + + goto unknown; + + case 'e': + switch (name[1]) + { + case 'l': + if (name[2] == 's' && + name[3] == 'e' && + name[4] == 'i' && + name[5] == 'f') + { /* elseif */ + if(ckWARN_d(WARN_SYNTAX)) + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); + } + + goto unknown; + + case 'x': + if (name[2] == 'i' && + name[3] == 's' && + name[4] == 't' && + name[5] == 's') + { /* exists */ + return KEY_exists; + } + + goto unknown; + + default: + goto unknown; + } + + case 'f': + switch (name[1]) + { + case 'i': + if (name[2] == 'l' && + name[3] == 'e' && + name[4] == 'n' && + name[5] == 'o') + { /* fileno */ + return -KEY_fileno; + } + + goto unknown; + + case 'o': + if (name[2] == 'r' && + name[3] == 'm' && + name[4] == 'a' && + name[5] == 't') + { /* format */ + return KEY_format; + } + + goto unknown; + + default: + goto unknown; + } + + case 'g': + if (name[1] == 'm' && + name[2] == 't' && + name[3] == 'i' && + name[4] == 'm' && + name[5] == 'e') + { /* gmtime */ + return -KEY_gmtime; + } + + goto unknown; + + case 'l': + switch (name[1]) + { + case 'e': + if (name[2] == 'n' && + name[3] == 'g' && + name[4] == 't' && + name[5] == 'h') + { /* length */ + return -KEY_length; + } + + goto unknown; + + case 'i': + if (name[2] == 's' && + name[3] == 't' && + name[4] == 'e' && + name[5] == 'n') + { /* listen */ + return -KEY_listen; + } + + goto unknown; + + default: + goto unknown; + } + + case 'm': + if (name[1] == 's' && + name[2] == 'g') + { + switch (name[3]) + { + case 'c': + if (name[4] == 't' && + name[5] == 'l') + { /* msgctl */ + return -KEY_msgctl; + } + + goto unknown; + + case 'g': + if (name[4] == 'e' && + name[5] == 't') + { /* msgget */ + return -KEY_msgget; + } + + goto unknown; + + case 'r': + if (name[4] == 'c' && + name[5] == 'v') + { /* msgrcv */ + return -KEY_msgrcv; + } + + goto unknown; + + case 's': + if (name[4] == 'n' && + name[5] == 'd') + { /* msgsnd */ + return -KEY_msgsnd; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'p': + if (name[1] == 'r' && + name[2] == 'i' && + name[3] == 'n' && + name[4] == 't' && + name[5] == 'f') + { /* printf */ + return KEY_printf; + } + + goto unknown; + + case 'r': + switch (name[1]) + { + case 'e': + switch (name[2]) + { + case 'n': + if (name[3] == 'a' && + name[4] == 'm' && + name[5] == 'e') + { /* rename */ + return -KEY_rename; + } + + goto unknown; + + case 't': + if (name[3] == 'u' && + name[4] == 'r' && + name[5] == 'n') + { /* return */ + return KEY_return; + } + + goto unknown; + + default: + goto unknown; + } + + case 'i': + if (name[2] == 'n' && + name[3] == 'd' && + name[4] == 'e' && + name[5] == 'x') + { /* rindex */ + return -KEY_rindex; + } + + goto unknown; + + default: + goto unknown; + } + + case 's': + switch (name[1]) + { + case 'c': + if (name[2] == 'a' && + name[3] == 'l' && + name[4] == 'a' && + name[5] == 'r') + { /* scalar */ + return KEY_scalar; + } + + goto unknown; + + case 'e': + switch (name[2]) + { + case 'l': + if (name[3] == 'e' && + name[4] == 'c' && + name[5] == 't') + { /* select */ + return -KEY_select; + } + + goto unknown; + + case 'm': + switch (name[3]) + { + case 'c': + if (name[4] == 't' && + name[5] == 'l') + { /* semctl */ + return -KEY_semctl; + } + + goto unknown; + + case 'g': + if (name[4] == 'e' && + name[5] == 't') + { /* semget */ + return -KEY_semget; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 'h': + if (name[2] == 'm') + { + switch (name[3]) + { + case 'c': + if (name[4] == 't' && + name[5] == 'l') + { /* shmctl */ + return -KEY_shmctl; + } + + goto unknown; + + case 'g': + if (name[4] == 'e' && + name[5] == 't') + { /* shmget */ + return -KEY_shmget; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'o': + if (name[2] == 'c' && + name[3] == 'k' && + name[4] == 'e' && + name[5] == 't') + { /* socket */ + return -KEY_socket; + } + + goto unknown; + + case 'p': + if (name[2] == 'l' && + name[3] == 'i' && + name[4] == 'c' && + name[5] == 'e') + { /* splice */ + return -KEY_splice; + } + + goto unknown; + + case 'u': + if (name[2] == 'b' && + name[3] == 's' && + name[4] == 't' && + name[5] == 'r') + { /* substr */ + return -KEY_substr; + } + + goto unknown; + + case 'y': + if (name[2] == 's' && + name[3] == 't' && + name[4] == 'e' && + name[5] == 'm') + { /* system */ + return -KEY_system; + } + + goto unknown; + + default: + goto unknown; + } + + case 'u': + if (name[1] == 'n') + { + switch (name[2]) + { + case 'l': + switch (name[3]) + { + case 'e': + if (name[4] == 's' && + name[5] == 's') + { /* unless */ + return KEY_unless; + } + + goto unknown; + + case 'i': + if (name[4] == 'n' && + name[5] == 'k') + { /* unlink */ + return -KEY_unlink; + } + + goto unknown; + + default: + goto unknown; + } + + case 'p': + if (name[3] == 'a' && + name[4] == 'c' && + name[5] == 'k') + { /* unpack */ + return -KEY_unpack; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'v': + if (name[1] == 'a' && + name[2] == 'l' && + name[3] == 'u' && + name[4] == 'e' && + name[5] == 's') + { /* values */ + return -KEY_values; + } + + goto unknown; + + default: + goto unknown; } - break; - case 'a': - if (name[0] == 'n' && name[1] == 'd') { - return -KEY_and; /* Weight 284867 */ + + case 7: /* 28 tokens of length 7 */ + switch (name[0]) + { + case 'D': + if (name[1] == 'E' && + name[2] == 'S' && + name[3] == 'T' && + name[4] == 'R' && + name[5] == 'O' && + name[6] == 'Y') + { /* DESTROY */ + return KEY_DESTROY; + } + + goto unknown; + + case '_': + if (name[1] == '_' && + name[2] == 'E' && + name[3] == 'N' && + name[4] == 'D' && + name[5] == '_' && + name[6] == '_') + { /* __END__ */ + return KEY___END__; + } + + goto unknown; + + case 'b': + if (name[1] == 'i' && + name[2] == 'n' && + name[3] == 'm' && + name[4] == 'o' && + name[5] == 'd' && + name[6] == 'e') + { /* binmode */ + return -KEY_binmode; + } + + goto unknown; + + case 'c': + if (name[1] == 'o' && + name[2] == 'n' && + name[3] == 'n' && + name[4] == 'e' && + name[5] == 'c' && + name[6] == 't') + { /* connect */ + return -KEY_connect; + } + + goto unknown; + + case 'd': + switch (name[1]) + { + case 'b': + if (name[2] == 'm' && + name[3] == 'o' && + name[4] == 'p' && + name[5] == 'e' && + name[6] == 'n') + { /* dbmopen */ + return -KEY_dbmopen; + } + + goto unknown; + + case 'e': + if (name[2] == 'f' && + name[3] == 'i' && + name[4] == 'n' && + name[5] == 'e' && + name[6] == 'd') + { /* defined */ + return KEY_defined; + } + + goto unknown; + + default: + goto unknown; + } + + case 'f': + if (name[1] == 'o' && + name[2] == 'r' && + name[3] == 'e' && + name[4] == 'a' && + name[5] == 'c' && + name[6] == 'h') + { /* foreach */ + return KEY_foreach; + } + + goto unknown; + + case 'g': + if (name[1] == 'e' && + name[2] == 't' && + name[3] == 'p') + { + switch (name[4]) + { + case 'g': + if (name[5] == 'r' && + name[6] == 'p') + { /* getpgrp */ + return -KEY_getpgrp; + } + + goto unknown; + + case 'p': + if (name[5] == 'i' && + name[6] == 'd') + { /* getppid */ + return -KEY_getppid; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'l': + if (name[1] == 'c' && + name[2] == 'f' && + name[3] == 'i' && + name[4] == 'r' && + name[5] == 's' && + name[6] == 't') + { /* lcfirst */ + return -KEY_lcfirst; + } + + goto unknown; + + case 'o': + if (name[1] == 'p' && + name[2] == 'e' && + name[3] == 'n' && + name[4] == 'd' && + name[5] == 'i' && + name[6] == 'r') + { /* opendir */ + return -KEY_opendir; + } + + goto unknown; + + case 'p': + if (name[1] == 'a' && + name[2] == 'c' && + name[3] == 'k' && + name[4] == 'a' && + name[5] == 'g' && + name[6] == 'e') + { /* package */ + return KEY_package; + } + + goto unknown; + + case 'r': + if (name[1] == 'e') + { + switch (name[2]) + { + case 'a': + if (name[3] == 'd' && + name[4] == 'd' && + name[5] == 'i' && + name[6] == 'r') + { /* readdir */ + return -KEY_readdir; + } + + goto unknown; + + case 'q': + if (name[3] == 'u' && + name[4] == 'i' && + name[5] == 'r' && + name[6] == 'e') + { /* require */ + return KEY_require; + } + + goto unknown; + + case 'v': + if (name[3] == 'e' && + name[4] == 'r' && + name[5] == 's' && + name[6] == 'e') + { /* reverse */ + return -KEY_reverse; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 's': + switch (name[1]) + { + case 'e': + switch (name[2]) + { + case 'e': + if (name[3] == 'k' && + name[4] == 'd' && + name[5] == 'i' && + name[6] == 'r') + { /* seekdir */ + return -KEY_seekdir; + } + + goto unknown; + + case 't': + if (name[3] == 'p' && + name[4] == 'g' && + name[5] == 'r' && + name[6] == 'p') + { /* setpgrp */ + return -KEY_setpgrp; + } + + goto unknown; + + default: + goto unknown; + } + + case 'h': + if (name[2] == 'm' && + name[3] == 'r' && + name[4] == 'e' && + name[5] == 'a' && + name[6] == 'd') + { /* shmread */ + return -KEY_shmread; + } + + goto unknown; + + case 'p': + if (name[2] == 'r' && + name[3] == 'i' && + name[4] == 'n' && + name[5] == 't' && + name[6] == 'f') + { /* sprintf */ + return -KEY_sprintf; + } + + goto unknown; + + case 'y': + switch (name[2]) + { + case 'm': + if (name[3] == 'l' && + name[4] == 'i' && + name[5] == 'n' && + name[6] == 'k') + { /* symlink */ + return -KEY_symlink; + } + + goto unknown; + + case 's': + switch (name[3]) + { + case 'c': + if (name[4] == 'a' && + name[5] == 'l' && + name[6] == 'l') + { /* syscall */ + return -KEY_syscall; + } + + goto unknown; + + case 'o': + if (name[4] == 'p' && + name[5] == 'e' && + name[6] == 'n') + { /* sysopen */ + return -KEY_sysopen; + } + + goto unknown; + + case 'r': + if (name[4] == 'e' && + name[5] == 'a' && + name[6] == 'd') + { /* sysread */ + return -KEY_sysread; + } + + goto unknown; + + case 's': + if (name[4] == 'e' && + name[5] == 'e' && + name[6] == 'k') + { /* sysseek */ + return -KEY_sysseek; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 't': + if (name[1] == 'e' && + name[2] == 'l' && + name[3] == 'l' && + name[4] == 'd' && + name[5] == 'i' && + name[6] == 'r') + { /* telldir */ + return -KEY_telldir; + } + + goto unknown; + + case 'u': + switch (name[1]) + { + case 'c': + if (name[2] == 'f' && + name[3] == 'i' && + name[4] == 'r' && + name[5] == 's' && + name[6] == 't') + { /* ucfirst */ + return -KEY_ucfirst; + } + + goto unknown; + + case 'n': + if (name[2] == 's' && + name[3] == 'h' && + name[4] == 'i' && + name[5] == 'f' && + name[6] == 't') + { /* unshift */ + return -KEY_unshift; + } + + goto unknown; + + default: + goto unknown; + } + + case 'w': + if (name[1] == 'a' && + name[2] == 'i' && + name[3] == 't' && + name[4] == 'p' && + name[5] == 'i' && + name[6] == 'd') + { /* waitpid */ + return -KEY_waitpid; + } + + goto unknown; + + default: + goto unknown; + } + + case 8: /* 26 tokens of length 8 */ + switch (name[0]) + { + case 'A': + if (name[1] == 'U' && + name[2] == 'T' && + name[3] == 'O' && + name[4] == 'L' && + name[5] == 'O' && + name[6] == 'A' && + name[7] == 'D') + { /* AUTOLOAD */ + return KEY_AUTOLOAD; + } + + goto unknown; + + case '_': + if (name[1] == '_') + { + switch (name[2]) + { + case 'D': + if (name[3] == 'A' && + name[4] == 'T' && + name[5] == 'A' && + name[6] == '_' && + name[7] == '_') + { /* __DATA__ */ + return KEY___DATA__; + } + + goto unknown; + + case 'F': + if (name[3] == 'I' && + name[4] == 'L' && + name[5] == 'E' && + name[6] == '_' && + name[7] == '_') + { /* __FILE__ */ + return -KEY___FILE__; + } + + goto unknown; + + case 'L': + if (name[3] == 'I' && + name[4] == 'N' && + name[5] == 'E' && + name[6] == '_' && + name[7] == '_') + { /* __LINE__ */ + return -KEY___LINE__; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'c': + switch (name[1]) + { + case 'l': + if (name[2] == 'o' && + name[3] == 's' && + name[4] == 'e' && + name[5] == 'd' && + name[6] == 'i' && + name[7] == 'r') + { /* closedir */ + return -KEY_closedir; + } + + goto unknown; + + case 'o': + if (name[2] == 'n' && + name[3] == 't' && + name[4] == 'i' && + name[5] == 'n' && + name[6] == 'u' && + name[7] == 'e') + { /* continue */ + return -KEY_continue; + } + + goto unknown; + + default: + goto unknown; + } + + case 'd': + if (name[1] == 'b' && + name[2] == 'm' && + name[3] == 'c' && + name[4] == 'l' && + name[5] == 'o' && + name[6] == 's' && + name[7] == 'e') + { /* dbmclose */ + return -KEY_dbmclose; + } + + goto unknown; + + case 'e': + if (name[1] == 'n' && + name[2] == 'd') + { + switch (name[3]) + { + case 'g': + if (name[4] == 'r' && + name[5] == 'e' && + name[6] == 'n' && + name[7] == 't') + { /* endgrent */ + return -KEY_endgrent; + } + + goto unknown; + + case 'p': + if (name[4] == 'w' && + name[5] == 'e' && + name[6] == 'n' && + name[7] == 't') + { /* endpwent */ + return -KEY_endpwent; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'f': + if (name[1] == 'o' && + name[2] == 'r' && + name[3] == 'm' && + name[4] == 'l' && + name[5] == 'i' && + name[6] == 'n' && + name[7] == 'e') + { /* formline */ + return -KEY_formline; + } + + goto unknown; + + case 'g': + if (name[1] == 'e' && + name[2] == 't') + { + switch (name[3]) + { + case 'g': + if (name[4] == 'r') + { + switch (name[5]) + { + case 'e': + if (name[6] == 'n' && + name[7] == 't') + { /* getgrent */ + return -KEY_getgrent; + } + + goto unknown; + + case 'g': + if (name[6] == 'i' && + name[7] == 'd') + { /* getgrgid */ + return -KEY_getgrgid; + } + + goto unknown; + + case 'n': + if (name[6] == 'a' && + name[7] == 'm') + { /* getgrnam */ + return -KEY_getgrnam; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'l': + if (name[4] == 'o' && + name[5] == 'g' && + name[6] == 'i' && + name[7] == 'n') + { /* getlogin */ + return -KEY_getlogin; + } + + goto unknown; + + case 'p': + if (name[4] == 'w') + { + switch (name[5]) + { + case 'e': + if (name[6] == 'n' && + name[7] == 't') + { /* getpwent */ + return -KEY_getpwent; + } + + goto unknown; + + case 'n': + if (name[6] == 'a' && + name[7] == 'm') + { /* getpwnam */ + return -KEY_getpwnam; + } + + goto unknown; + + case 'u': + if (name[6] == 'i' && + name[7] == 'd') + { /* getpwuid */ + return -KEY_getpwuid; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'r': + if (name[1] == 'e' && + name[2] == 'a' && + name[3] == 'd') + { + switch (name[4]) + { + case 'l': + if (name[5] == 'i' && + name[6] == 'n') + { + switch (name[7]) + { + case 'e': + { /* readline */ + return -KEY_readline; + } + + case 'k': + { /* readlink */ + return -KEY_readlink; + } + + default: + goto unknown; + } + } + + goto unknown; + + case 'p': + if (name[5] == 'i' && + name[6] == 'p' && + name[7] == 'e') + { /* readpipe */ + return -KEY_readpipe; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 's': + switch (name[1]) + { + case 'e': + if (name[2] == 't') + { + switch (name[3]) + { + case 'g': + if (name[4] == 'r' && + name[5] == 'e' && + name[6] == 'n' && + name[7] == 't') + { /* setgrent */ + return -KEY_setgrent; + } + + goto unknown; + + case 'p': + if (name[4] == 'w' && + name[5] == 'e' && + name[6] == 'n' && + name[7] == 't') + { /* setpwent */ + return -KEY_setpwent; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'h': + switch (name[2]) + { + case 'm': + if (name[3] == 'w' && + name[4] == 'r' && + name[5] == 'i' && + name[6] == 't' && + name[7] == 'e') + { /* shmwrite */ + return -KEY_shmwrite; + } + + goto unknown; + + case 'u': + if (name[3] == 't' && + name[4] == 'd' && + name[5] == 'o' && + name[6] == 'w' && + name[7] == 'n') + { /* shutdown */ + return -KEY_shutdown; + } + + goto unknown; + + default: + goto unknown; + } + + case 'y': + if (name[2] == 's' && + name[3] == 'w' && + name[4] == 'r' && + name[5] == 'i' && + name[6] == 't' && + name[7] == 'e') + { /* syswrite */ + return -KEY_syswrite; + } + + goto unknown; + + default: + goto unknown; + } + + case 't': + if (name[1] == 'r' && + name[2] == 'u' && + name[3] == 'n' && + name[4] == 'c' && + name[5] == 'a' && + name[6] == 't' && + name[7] == 'e') + { /* truncate */ + return -KEY_truncate; + } + + goto unknown; + + default: + goto unknown; + } + + case 9: /* 8 tokens of length 9 */ + switch (name[0]) + { + case 'e': + if (name[1] == 'n' && + name[2] == 'd' && + name[3] == 'n' && + name[4] == 'e' && + name[5] == 't' && + name[6] == 'e' && + name[7] == 'n' && + name[8] == 't') + { /* endnetent */ + return -KEY_endnetent; + } + + goto unknown; + + case 'g': + if (name[1] == 'e' && + name[2] == 't' && + name[3] == 'n' && + name[4] == 'e' && + name[5] == 't' && + name[6] == 'e' && + name[7] == 'n' && + name[8] == 't') + { /* getnetent */ + return -KEY_getnetent; + } + + goto unknown; + + case 'l': + if (name[1] == 'o' && + name[2] == 'c' && + name[3] == 'a' && + name[4] == 'l' && + name[5] == 't' && + name[6] == 'i' && + name[7] == 'm' && + name[8] == 'e') + { /* localtime */ + return -KEY_localtime; + } + + goto unknown; + + case 'p': + if (name[1] == 'r' && + name[2] == 'o' && + name[3] == 't' && + name[4] == 'o' && + name[5] == 't' && + name[6] == 'y' && + name[7] == 'p' && + name[8] == 'e') + { /* prototype */ + return KEY_prototype; + } + + goto unknown; + + case 'q': + if (name[1] == 'u' && + name[2] == 'o' && + name[3] == 't' && + name[4] == 'e' && + name[5] == 'm' && + name[6] == 'e' && + name[7] == 't' && + name[8] == 'a') + { /* quotemeta */ + return -KEY_quotemeta; + } + + goto unknown; + + case 'r': + if (name[1] == 'e' && + name[2] == 'w' && + name[3] == 'i' && + name[4] == 'n' && + name[5] == 'd' && + name[6] == 'd' && + name[7] == 'i' && + name[8] == 'r') + { /* rewinddir */ + return -KEY_rewinddir; + } + + goto unknown; + + case 's': + if (name[1] == 'e' && + name[2] == 't' && + name[3] == 'n' && + name[4] == 'e' && + name[5] == 't' && + name[6] == 'e' && + name[7] == 'n' && + name[8] == 't') + { /* setnetent */ + return -KEY_setnetent; + } + + goto unknown; + + case 'w': + if (name[1] == 'a' && + name[2] == 'n' && + name[3] == 't' && + name[4] == 'a' && + name[5] == 'r' && + name[6] == 'r' && + name[7] == 'a' && + name[8] == 'y') + { /* wantarray */ + return -KEY_wantarray; + } + + goto unknown; + + default: + goto unknown; + } + + case 10: /* 9 tokens of length 10 */ + switch (name[0]) + { + case 'e': + if (name[1] == 'n' && + name[2] == 'd') + { + switch (name[3]) + { + case 'h': + if (name[4] == 'o' && + name[5] == 's' && + name[6] == 't' && + name[7] == 'e' && + name[8] == 'n' && + name[9] == 't') + { /* endhostent */ + return -KEY_endhostent; + } + + goto unknown; + + case 's': + if (name[4] == 'e' && + name[5] == 'r' && + name[6] == 'v' && + name[7] == 'e' && + name[8] == 'n' && + name[9] == 't') + { /* endservent */ + return -KEY_endservent; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 'g': + if (name[1] == 'e' && + name[2] == 't') + { + switch (name[3]) + { + case 'h': + if (name[4] == 'o' && + name[5] == 's' && + name[6] == 't' && + name[7] == 'e' && + name[8] == 'n' && + name[9] == 't') + { /* gethostent */ + return -KEY_gethostent; + } + + goto unknown; + + case 's': + switch (name[4]) + { + case 'e': + if (name[5] == 'r' && + name[6] == 'v' && + name[7] == 'e' && + name[8] == 'n' && + name[9] == 't') + { /* getservent */ + return -KEY_getservent; + } + + goto unknown; + + case 'o': + if (name[5] == 'c' && + name[6] == 'k' && + name[7] == 'o' && + name[8] == 'p' && + name[9] == 't') + { /* getsockopt */ + return -KEY_getsockopt; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + } + + goto unknown; + + case 's': + switch (name[1]) + { + case 'e': + if (name[2] == 't') + { + switch (name[3]) + { + case 'h': + if (name[4] == 'o' && + name[5] == 's' && + name[6] == 't' && + name[7] == 'e' && + name[8] == 'n' && + name[9] == 't') + { /* sethostent */ + return -KEY_sethostent; + } + + goto unknown; + + case 's': + switch (name[4]) + { + case 'e': + if (name[5] == 'r' && + name[6] == 'v' && + name[7] == 'e' && + name[8] == 'n' && + name[9] == 't') + { /* setservent */ + return -KEY_setservent; + } + + goto unknown; + + case 'o': + if (name[5] == 'c' && + name[6] == 'k' && + name[7] == 'o' && + name[8] == 'p' && + name[9] == 't') + { /* setsockopt */ + return -KEY_setsockopt; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + } + + goto unknown; + + case 'o': + if (name[2] == 'c' && + name[3] == 'k' && + name[4] == 'e' && + name[5] == 't' && + name[6] == 'p' && + name[7] == 'a' && + name[8] == 'i' && + name[9] == 'r') + { /* socketpair */ + return -KEY_socketpair; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; } - if (name[0] == 'b' && name[1] == 's') { - return -KEY_abs; /* Weight 7767 */ - } - break; - case 'c': - if (name[0] == 'h' && name[1] == 'r') { - return -KEY_chr; /* Weight 35654 */ - } - if (name[0] == 'm' && name[1] == 'p') { - return -KEY_cmp; /* Weight 6808 */ - } - if (name[0] == 'o' && name[1] == 's') { - return -KEY_cos; /* Weight 447 */ - } - break; - case 'd': - if (name[0] == 'i' && name[1] == 'e') { - return -KEY_die; /* Weight 192203 */ - } - break; - case 'e': - if (name[0] == 'o' && name[1] == 'f') { - return -KEY_eof; /* Weight 1618 */ - } - if (name[0] == 'r' && name[1] == 'r') { - return -KEY_err; /* Weight 522 */ - } - if (name[0] == 'x' && name[1] == 'p') { - return -KEY_exp; /* Weight 423 */ - } - break; - case 'f': - if (name[0] == 'o' && name[1] == 'r') { - return KEY_for; /* Weight 118158 */ - } - break; - case 'h': - if (name[0] == 'e' && name[1] == 'x') { - return -KEY_hex; /* Weight 3629 */ - } - break; - case 'i': - if (name[0] == 'n' && name[1] == 't') { - return -KEY_int; /* Weight 18549 */ - } - break; - case 'l': - if (name[0] == 'o' && name[1] == 'g') { - return -KEY_log; - } - break; - case 'm': - if (name[0] == 'a' && name[1] == 'p') { - return KEY_map; /* Weight 115207 */ - } - break; - case 'n': - if (name[0] == 'o' && name[1] == 't') { - return -KEY_not; /* Weight 55868 */ - } - break; - case 'o': - if (name[0] == 'u' && name[1] == 'r') { - return KEY_our; /* Weight 194417 */ - } - if (name[0] == 'r' && name[1] == 'd') { - return -KEY_ord; /* Weight 22221 */ - } - if (name[0] == 'c' && name[1] == 't') { - return -KEY_oct; /* Weight 4195 */ - } - break; - case 'p': - if (name[0] == 'o' && name[1] == 'p') { - return -KEY_pop; /* Weight 46933 */ - } - if (name[0] == 'o' && name[1] == 's') { - return KEY_pos; /* Weight 5503 */ - } - break; - case 'r': - if (name[0] == 'e' && name[1] == 'f') { - return -KEY_ref; /* Weight 347102 */ - } - break; - case 's': - if (name[0] == 'u' && name[1] == 'b') { - return KEY_sub; /* Weight 2053554 */ - } - if (name[0] == 'i' && name[1] == 'n') { - return -KEY_sin; /* Weight 499 */ - } - break; - case 't': - if (name[0] == 'i' && name[1] == 'e') { - return KEY_tie; /* Weight 10131 */ - } - break; - case 'u': - if (name[0] == 's' && name[1] == 'e') { - return KEY_use; /* Weight 686081 */ - } - break; - case 'v': - if (name[0] == 'e' && name[1] == 'c') { - return -KEY_vec; /* Weight 110566 */ - } - break; - case 'x': - if (name[0] == 'o' && name[1] == 'r') { - return -KEY_xor; /* Weight 619 */ - } - break; - } - break; - case 4: - /* Names all of length 4. */ - /* CORE INIT bind chop dump each else eval exec exit fork getc glob goto - grep join keys kill last link lock next open pack pipe push rand read - recv redo seek send sort sqrt stat tell tied time wait warn */ - /* Offset 0 gives the best switch position. */ - switch (*name++) { - case 'C': - if (!memcmp(name, "ORE", 3)) { - /* C */ - return -KEY_CORE; /* Weight 47391 */ - } - break; - case 'I': - if (!memcmp(name, "NIT", 3)) { - /* I */ - return KEY_INIT; /* Weight 418 */ - } - break; - case 'b': - if (!memcmp(name, "ind", 3)) { - /* b */ - return -KEY_bind; /* Weight 290 */ - } - break; - case 'c': - if (!memcmp(name, "hop", 3)) { - /* c */ - return -KEY_chop; /* Weight 10172 */ - } - break; - case 'd': - if (!memcmp(name, "ump", 3)) { - /* d */ - return -KEY_dump; /* Weight 274 */ - } - break; - case 'e': - if (!memcmp(name, "lse", 3)) { - /* e */ - return KEY_else; /* Weight 527806 */ - } - if (!memcmp(name, "val", 3)) { - /* e */ - return KEY_eval; /* Weight 136977 */ - } - if (!memcmp(name, "ach", 3)) { - /* e */ - return -KEY_each; /* Weight 18414 */ - } - if (!memcmp(name, "xit", 3)) { - /* e */ - return -KEY_exit; /* Weight 8262 */ - } - if (!memcmp(name, "xec", 3)) { - /* e */ - return -KEY_exec; /* Weight 429 */ - } - break; - case 'f': - if (!memcmp(name, "ork", 3)) { - /* f */ - return -KEY_fork; /* Weight 327 */ - } - break; - case 'g': - if (!memcmp(name, "oto", 3)) { - /* g */ - return KEY_goto; /* Weight 109258 */ - } - if (!memcmp(name, "rep", 3)) { - /* g */ - return KEY_grep; /* Weight 75912 */ - } - if (!memcmp(name, "lob", 3)) { - /* g */ - return KEY_glob; /* Weight 2172 */ - } - if (!memcmp(name, "etc", 3)) { - /* g */ - return -KEY_getc; /* Weight 981 */ - } - break; - case 'j': - if (!memcmp(name, "oin", 3)) { - /* j */ - return -KEY_join; /* Weight 130820 */ - } - break; - case 'k': - if (!memcmp(name, "eys", 3)) { - /* k */ - return -KEY_keys; /* Weight 131427 */ - } - if (!memcmp(name, "ill", 3)) { - /* k */ - return -KEY_kill; /* Weight 382 */ - } - break; - case 'l': - if (!memcmp(name, "ast", 3)) { - /* l */ - return KEY_last; /* Weight 95078 */ - } - if (!memcmp(name, "ock", 3)) { - /* l */ - return -KEY_lock; /* Weight 4210 */ - } - if (!memcmp(name, "ink", 3)) { - /* l */ - return -KEY_link; /* Weight 425 */ - } - break; - case 'n': - if (!memcmp(name, "ext", 3)) { - /* n */ - return KEY_next; /* Weight 153355 */ - } - break; - case 'o': - if (!memcmp(name, "pen", 3)) { - /* o */ - return -KEY_open; /* Weight 39060 */ - } - break; - case 'p': - if (!memcmp(name, "ush", 3)) { - /* p */ - return -KEY_push; /* Weight 256975 */ - } - if (!memcmp(name, "ack", 3)) { - /* p */ - return -KEY_pack; /* Weight 14491 */ - } - if (!memcmp(name, "ipe", 3)) { - /* p */ - return -KEY_pipe; /* Weight 344 */ - } - break; - case 'r': - if (!memcmp(name, "ead", 3)) { - /* r */ - return -KEY_read; /* Weight 9434 */ - } - if (!memcmp(name, "edo", 3)) { - /* r */ - return KEY_redo; /* Weight 5219 */ - } - if (!memcmp(name, "and", 3)) { - /* r */ - return -KEY_rand; /* Weight 1824 */ - } - if (!memcmp(name, "ecv", 3)) { - /* r */ - return -KEY_recv; /* Weight 250 */ - } - break; - case 's': - if (!memcmp(name, "tat", 3)) { - /* s */ - return -KEY_stat; /* Weight 36702 */ - } - if (!memcmp(name, "ort", 3)) { - /* s */ - return KEY_sort; /* Weight 36394 */ - } - if (!memcmp(name, "eek", 3)) { - /* s */ - return -KEY_seek; /* Weight 2174 */ - } - if (!memcmp(name, "qrt", 3)) { - /* s */ - return -KEY_sqrt; /* Weight 766 */ - } - if (!memcmp(name, "end", 3)) { - /* s */ - return -KEY_send; /* Weight 496 */ - } - break; - case 't': - if (!memcmp(name, "ime", 3)) { - /* t */ - return -KEY_time; /* Weight 32168 */ - } - if (!memcmp(name, "ied", 3)) { - /* t */ - return KEY_tied; /* Weight 9749 */ - } - if (!memcmp(name, "ell", 3)) { - /* t */ - return -KEY_tell; /* Weight 2578 */ - } - break; - case 'w': - if (!memcmp(name, "arn", 3)) { - /* w */ - return -KEY_warn; /* Weight 91372 */ - } - if (!memcmp(name, "ait", 3)) { - /* w */ - return -KEY_wait; - } - break; - } - break; - case 5: - /* Names all of length 5. */ - /* BEGIN CHECK alarm atan2 bless chdir chmod chomp chown close crypt elsif - fcntl flock index ioctl local lstat mkdir print reset rmdir semop shift - sleep split srand study times umask undef untie until utime while write - */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'C': - if (!memcmp(name, "CHECK", 5)) { - /* ^ */ - return KEY_CHECK; /* Weight 538 */ - } - break; - case 'I': - if (!memcmp(name, "BEGIN", 5)) { - /* ^ */ - return KEY_BEGIN; /* Weight 24125 */ - } - break; - case 'a': - if (!memcmp(name, "local", 5)) { - /* ^ */ - return KEY_local; /* Weight 262973 */ - } - if (!memcmp(name, "lstat", 5)) { - /* ^ */ - return -KEY_lstat; /* Weight 13859 */ - } - break; - case 'c': - if (!memcmp(name, "flock", 5)) { - /* ^ */ - return -KEY_flock; /* Weight 260 */ - } - break; - case 'd': - if (!memcmp(name, "study", 5)) { - /* ^ */ - return KEY_study; /* Weight 1933 */ - } - break; - case 'e': - if (!memcmp(name, "undef", 5)) { - /* ^ */ - return KEY_undef; /* Weight 311156 */ - } - if (!memcmp(name, "index", 5)) { - /* ^ */ - return -KEY_index; /* Weight 51465 */ - } - if (!memcmp(name, "sleep", 5)) { - /* ^ */ - return -KEY_sleep; /* Weight 519 */ - } - if (!memcmp(name, "times", 5)) { - /* ^ */ - return -KEY_times; /* Weight 310 */ - } - if (!memcmp(name, "reset", 5)) { - /* ^ */ - return -KEY_reset; /* Weight 127 */ - } - break; - case 'f': - if (!memcmp(name, "shift", 5)) { - /* ^ */ - return -KEY_shift; /* Weight 904125 */ - } - break; - case 'i': - if (!memcmp(name, "elsif", 5)) { - /* ^ */ - return KEY_elsif; /* Weight 322365 */ - } - if (!memcmp(name, "split", 5)) { - /* ^ */ - return KEY_split; /* Weight 93678 */ - } - if (!memcmp(name, "chdir", 5)) { - /* ^ */ - return -KEY_chdir; /* Weight 20317 */ - } - if (!memcmp(name, "mkdir", 5)) { - /* ^ */ - return -KEY_mkdir; /* Weight 2951 */ - } - if (!memcmp(name, "rmdir", 5)) { - /* ^ */ - return -KEY_rmdir; /* Weight 2493 */ - } - if (!memcmp(name, "until", 5)) { - /* ^ */ - return KEY_until; /* Weight 818 */ - } - if (!memcmp(name, "untie", 5)) { - /* ^ */ - return KEY_untie; /* Weight 420 */ - } - break; - case 'l': - if (!memcmp(name, "while", 5)) { - /* ^ */ - return KEY_while; /* Weight 120305 */ - } - break; - case 'm': - if (!memcmp(name, "chomp", 5)) { - /* ^ */ - return -KEY_chomp; /* Weight 22337 */ - } - if (!memcmp(name, "utime", 5)) { - /* ^ */ - return -KEY_utime; /* Weight 3849 */ - } - break; - case 'n': - if (!memcmp(name, "print", 5)) { - /* ^ */ - return KEY_print; /* Weight 220904 */ - } - if (!memcmp(name, "atan2", 5)) { - /* ^ */ - return -KEY_atan2; /* Weight 350 */ - } - if (!memcmp(name, "srand", 5)) { - /* ^ */ - return -KEY_srand; /* Weight 41 */ - } - break; - case 'o': - if (!memcmp(name, "chmod", 5)) { - /* ^ */ - return -KEY_chmod; /* Weight 18455 */ - } - if (!memcmp(name, "semop", 5)) { - /* ^ */ - return -KEY_semop; - } - break; - case 'p': - if (!memcmp(name, "crypt", 5)) { - /* ^ */ - return -KEY_crypt; /* Weight 8 */ - } - break; - case 'r': - if (!memcmp(name, "alarm", 5)) { - /* ^ */ - return -KEY_alarm; - } - break; - case 's': - if (!memcmp(name, "bless", 5)) { - /* ^ */ - return -KEY_bless; /* Weight 62111 */ - } - if (!memcmp(name, "close", 5)) { - /* ^ */ - return -KEY_close; /* Weight 44077 */ - } - if (!memcmp(name, "umask", 5)) { - /* ^ */ - return -KEY_umask; /* Weight 1658 */ - } - break; - case 't': - if (!memcmp(name, "write", 5)) { - /* ^ */ - return -KEY_write; /* Weight 2525 */ - } - if (!memcmp(name, "fcntl", 5)) { - /* ^ */ - return -KEY_fcntl; /* Weight 1257 */ - } - if (!memcmp(name, "ioctl", 5)) { - /* ^ */ - return -KEY_ioctl; /* Weight 967 */ - } - break; - case 'w': - if (!memcmp(name, "chown", 5)) { - /* ^ */ - return -KEY_chown; /* Weight 34 */ - } - break; - } - break; - case 6: - /* Names all of length 6. */ - /* accept caller chroot delete elseif exists fileno format gmtime length - listen msgctl msgget msgrcv msgsnd printf rename return rindex scalar - select semctl semget shmctl shmget socket splice substr system unless - unlink unpack values */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'a': - if (!memcmp(name, "unpack", 6)) { - /* ^ */ - return -KEY_unpack; /* Weight 7849 */ - } - if (!memcmp(name, "rename", 6)) { - /* ^ */ - return -KEY_rename; /* Weight 4918 */ - } - break; - case 'c': - if (!memcmp(name, "semctl", 6)) { - /* ^ */ - return -KEY_semctl; /* Weight 17 */ - } - if (!memcmp(name, "msgctl", 6)) { - /* ^ */ - return -KEY_msgctl; - } - if (!memcmp(name, "shmctl", 6)) { - /* ^ */ - return -KEY_shmctl; - } - break; - case 'd': - if (!memcmp(name, "rindex", 6)) { - /* ^ */ - return -KEY_rindex; /* Weight 5005 */ - } - break; - case 'e': - if (!memcmp(name, "unless", 6)) { - /* ^ */ - return KEY_unless; /* Weight 913955 */ - } - if (!memcmp(name, "delete", 6)) { - /* ^ */ - return KEY_delete; /* Weight 74966 */ - } - if (!memcmp(name, "select", 6)) { - /* ^ */ - return -KEY_select; /* Weight 12209 */ - } - if (!memcmp(name, "fileno", 6)) { - /* ^ */ - return -KEY_fileno; /* Weight 8591 */ - } - if (!memcmp(name, "accept", 6)) { - /* ^ */ - return -KEY_accept; /* Weight 233 */ - } - if (!memcmp(name, "elseif", 6)) { - /* ^ */ - /* This is somewhat hacky. */ - if(ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); - break; - } - break; - case 'g': - if (!memcmp(name, "length", 6)) { - /* ^ */ - return -KEY_length; /* Weight 163975 */ - } - if (!memcmp(name, "msgget", 6)) { - /* ^ */ - return -KEY_msgget; - } - if (!memcmp(name, "semget", 6)) { - /* ^ */ - return -KEY_semget; - } - if (!memcmp(name, "shmget", 6)) { - /* ^ */ - return -KEY_shmget; - } - break; - case 'i': - if (!memcmp(name, "splice", 6)) { - /* ^ */ - return -KEY_splice; /* Weight 25143 */ - } - if (!memcmp(name, "unlink", 6)) { - /* ^ */ - return -KEY_unlink; /* Weight 18616 */ - } - if (!memcmp(name, "gmtime", 6)) { - /* ^ */ - return -KEY_gmtime; /* Weight 4040 */ - } - break; - case 'k': - if (!memcmp(name, "socket", 6)) { - /* ^ */ - return -KEY_socket; - } - break; - case 'l': - if (!memcmp(name, "caller", 6)) { - /* ^ */ - return -KEY_caller; /* Weight 148457 */ - } - if (!memcmp(name, "scalar", 6)) { - /* ^ */ - return KEY_scalar; /* Weight 43953 */ - } - break; - case 'm': - if (!memcmp(name, "format", 6)) { - /* ^ */ - return KEY_format; /* Weight 1735 */ - } - break; - case 'n': - if (!memcmp(name, "printf", 6)) { - /* ^ */ - return KEY_printf; /* Weight 6874 */ - } - break; - case 'o': - if (!memcmp(name, "chroot", 6)) { - /* ^ */ - return -KEY_chroot; - } - break; - case 'r': - if (!memcmp(name, "msgrcv", 6)) { - /* ^ */ - return -KEY_msgrcv; - } - break; - case 's': - if (!memcmp(name, "exists", 6)) { - /* ^ */ - return KEY_exists; /* Weight 145939 */ - } - if (!memcmp(name, "substr", 6)) { - /* ^ */ - return -KEY_substr; /* Weight 121344 */ - } - if (!memcmp(name, "msgsnd", 6)) { - /* ^ */ - return -KEY_msgsnd; - } - break; - case 't': - if (!memcmp(name, "system", 6)) { - /* ^ */ - return -KEY_system; /* Weight 4326 */ - } - if (!memcmp(name, "listen", 6)) { - /* ^ */ - return -KEY_listen; - } - break; - case 'u': - if (!memcmp(name, "return", 6)) { - /* ^ */ - return KEY_return; /* Weight 1401629 */ - } - if (!memcmp(name, "values", 6)) { - /* ^ */ - return -KEY_values; /* Weight 10110 */ - } - break; - } - break; - case 7: - /* Names all of length 7. */ - /* DESTROY __END__ binmode connect dbmopen defined foreach getpgrp getppid - lcfirst opendir package readdir require reverse seekdir setpgrp shmread - sprintf symlink syscall sysopen sysread sysseek telldir ucfirst unshift - waitpid */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'N': - if (!memcmp(name, "__END__", 7)) { - /* ^ */ - return KEY___END__; /* Weight 112636 */ - } - break; - case 'T': - if (!memcmp(name, "DESTROY", 7)) { - /* ^ */ - return KEY_DESTROY; /* Weight 7 */ - } - break; - case 'c': - if (!memcmp(name, "syscall", 7)) { - /* ^ */ - return -KEY_syscall; /* Weight 560 */ - } - break; - case 'd': - if (!memcmp(name, "readdir", 7)) { - /* ^ */ - return -KEY_readdir; /* Weight 11716 */ - } - break; - case 'e': - if (!memcmp(name, "foreach", 7)) { - /* ^ */ - return KEY_foreach; /* Weight 281720 */ - } - if (!memcmp(name, "reverse", 7)) { - /* ^ */ - return -KEY_reverse; /* Weight 10571 */ - } - break; - case 'h': - if (!memcmp(name, "unshift", 7)) { - /* ^ */ - return -KEY_unshift; /* Weight 36504 */ - } - break; - case 'i': - if (!memcmp(name, "defined", 7)) { - /* ^ */ - return KEY_defined; /* Weight 694277 */ - } - if (!memcmp(name, "sprintf", 7)) { - /* ^ */ - return -KEY_sprintf; /* Weight 72704 */ - } - if (!memcmp(name, "ucfirst", 7)) { - /* ^ */ - return -KEY_ucfirst; /* Weight 1012 */ - } - if (!memcmp(name, "lcfirst", 7)) { - /* ^ */ - return -KEY_lcfirst; /* Weight 165 */ - } - break; - case 'k': - if (!memcmp(name, "package", 7)) { - /* ^ */ - return KEY_package; /* Weight 245661 */ - } - if (!memcmp(name, "seekdir", 7)) { - /* ^ */ - return -KEY_seekdir; /* Weight 20 */ - } - break; - case 'l': - if (!memcmp(name, "symlink", 7)) { - /* ^ */ - return -KEY_symlink; /* Weight 386 */ - } - if (!memcmp(name, "telldir", 7)) { - /* ^ */ - return -KEY_telldir; /* Weight 294 */ - } - break; - case 'm': - if (!memcmp(name, "binmode", 7)) { - /* ^ */ - return -KEY_binmode; /* Weight 12301 */ - } - break; - case 'n': - if (!memcmp(name, "opendir", 7)) { - /* ^ */ - return -KEY_opendir; /* Weight 9007 */ - } - if (!memcmp(name, "connect", 7)) { - /* ^ */ - return -KEY_connect; /* Weight 526 */ - } - break; - case 'o': - if (!memcmp(name, "sysopen", 7)) { - /* ^ */ - return -KEY_sysopen; /* Weight 1230 */ - } - if (!memcmp(name, "dbmopen", 7)) { - /* ^ */ - return -KEY_dbmopen; - } - break; - case 'p': - if (!memcmp(name, "getppid", 7)) { - /* ^ */ - return -KEY_getppid; /* Weight 10 */ - } - if (!memcmp(name, "getpgrp", 7)) { - /* ^ */ - return -KEY_getpgrp; - } - if (!memcmp(name, "setpgrp", 7)) { - /* ^ */ - return -KEY_setpgrp; - } - break; - case 'r': - if (!memcmp(name, "sysread", 7)) { - /* ^ */ - return -KEY_sysread; /* Weight 3729 */ - } - if (!memcmp(name, "shmread", 7)) { - /* ^ */ - return -KEY_shmread; - } - break; - case 's': - if (!memcmp(name, "sysseek", 7)) { - /* ^ */ - return -KEY_sysseek; /* Weight 721 */ - } - break; - case 't': - if (!memcmp(name, "waitpid", 7)) { - /* ^ */ - return -KEY_waitpid; /* Weight 414 */ - } - break; - case 'u': - if (!memcmp(name, "require", 7)) { - /* ^ */ - return KEY_require; /* Weight 375220 */ - } - break; - } - break; - case 8: - /* Names all of length 8. */ - /* AUTOLOAD __DATA__ __FILE__ __LINE__ closedir continue dbmclose endgrent - endpwent formline getgrent getgrgid getgrnam getlogin getpwent getpwnam - getpwuid readline readlink readpipe setgrent setpwent shmwrite shutdown - syswrite truncate */ - /* Offset 3 gives the best switch position. */ - switch (name[3]) { - case 'A': - if (!memcmp(name, "__DATA__", 8)) { - /* ^ */ - return KEY___DATA__; /* Weight 395 */ - } - break; - case 'I': - if (!memcmp(name, "__FILE__", 8)) { - /* ^ */ - return -KEY___FILE__; /* Weight 888 */ - } - if (!memcmp(name, "__LINE__", 8)) { - /* ^ */ - return -KEY___LINE__; /* Weight 209 */ - } - break; - case 'O': - if (!memcmp(name, "AUTOLOAD", 8)) { - /* ^ */ - return KEY_AUTOLOAD; /* Weight 2713 */ - } - break; - case 'c': - if (!memcmp(name, "dbmclose", 8)) { - /* ^ */ - return -KEY_dbmclose; - } - break; - case 'd': - if (!memcmp(name, "readlink", 8)) { - /* ^ */ - return -KEY_readlink; /* Weight 1537 */ - } - if (!memcmp(name, "readline", 8)) { - /* ^ */ - return -KEY_readline; /* Weight 19 */ - } - if (!memcmp(name, "readpipe", 8)) { - /* ^ */ - return -KEY_readpipe; - } - break; - case 'g': - if (!memcmp(name, "getgrgid", 8)) { - /* ^ */ - return -KEY_getgrgid; /* Weight 67 */ - } - if (!memcmp(name, "getgrnam", 8)) { - /* ^ */ - return -KEY_getgrnam; /* Weight 11 */ - } - if (!memcmp(name, "endgrent", 8)) { - /* ^ */ - return -KEY_endgrent; - } - if (!memcmp(name, "getgrent", 8)) { - /* ^ */ - return -KEY_getgrent; - } - if (!memcmp(name, "setgrent", 8)) { - /* ^ */ - return -KEY_setgrent; - } - break; - case 'l': - if (!memcmp(name, "getlogin", 8)) { - /* ^ */ - return -KEY_getlogin; /* Weight 158 */ - } - break; - case 'm': - if (!memcmp(name, "formline", 8)) { - /* ^ */ - return -KEY_formline; /* Weight 959 */ - } - break; - case 'n': - if (!memcmp(name, "truncate", 8)) { - /* ^ */ - return -KEY_truncate; /* Weight 1351 */ - } - break; - case 'p': - if (!memcmp(name, "getpwuid", 8)) { - /* ^ */ - return -KEY_getpwuid; /* Weight 681 */ - } - if (!memcmp(name, "getpwnam", 8)) { - /* ^ */ - return -KEY_getpwnam; /* Weight 483 */ - } - if (!memcmp(name, "getpwent", 8)) { - /* ^ */ - return -KEY_getpwent; /* Weight 12 */ - } - if (!memcmp(name, "endpwent", 8)) { - /* ^ */ - return -KEY_endpwent; - } - if (!memcmp(name, "setpwent", 8)) { - /* ^ */ - return -KEY_setpwent; - } - break; - case 's': - if (!memcmp(name, "closedir", 8)) { - /* ^ */ - return -KEY_closedir; /* Weight 11986 */ - } - break; - case 't': - if (!memcmp(name, "continue", 8)) { - /* ^ */ - return -KEY_continue; /* Weight 2925 */ - } - if (!memcmp(name, "shutdown", 8)) { - /* ^ */ - return -KEY_shutdown; - } - break; - case 'w': - if (!memcmp(name, "syswrite", 8)) { - /* ^ */ - return -KEY_syswrite; /* Weight 4437 */ - } - if (!memcmp(name, "shmwrite", 8)) { - /* ^ */ - return -KEY_shmwrite; - } - break; - } - break; - case 9: - /* Names all of length 9. */ - /* endnetent getnetent localtime prototype quotemeta rewinddir setnetent - wantarray */ - /* Offset 0 gives the best switch position. */ - switch (*name++) { - case 'e': - if (!memcmp(name, "ndnetent", 8)) { - /* e */ - return -KEY_endnetent; - } - break; - case 'g': - if (!memcmp(name, "etnetent", 8)) { - /* g */ - return -KEY_getnetent; - } - break; - case 'l': - if (!memcmp(name, "ocaltime", 8)) { - /* l */ - return -KEY_localtime; /* Weight 7993 */ - } - break; - case 'p': - if (!memcmp(name, "rototype", 8)) { - /* p */ - return KEY_prototype; /* Weight 1602 */ - } - break; - case 'q': - if (!memcmp(name, "uotemeta", 8)) { - /* q */ - return -KEY_quotemeta; /* Weight 3120 */ - } - break; - case 'r': - if (!memcmp(name, "ewinddir", 8)) { - /* r */ - return -KEY_rewinddir; /* Weight 218 */ - } - break; - case 's': - if (!memcmp(name, "etnetent", 8)) { - /* s */ - return -KEY_setnetent; /* Weight 1 */ - } - break; - case 'w': - if (!memcmp(name, "antarray", 8)) { - /* w */ - return -KEY_wantarray; /* Weight 43024 */ - } - break; - } - break; - case 10: - /* Names all of length 10. */ - /* endhostent endservent gethostent getservent getsockopt sethostent - setservent setsockopt socketpair */ - /* Offset 6 gives the best switch position. */ - switch (name[6]) { - case 'k': - if (!memcmp(name, "setsockopt", 10)) { - /* ^ */ - return -KEY_setsockopt; /* Weight 356 */ - } - if (!memcmp(name, "getsockopt", 10)) { - /* ^ */ - return -KEY_getsockopt; /* Weight 243 */ - } - break; - case 'p': - if (!memcmp(name, "socketpair", 10)) { - /* ^ */ - return -KEY_socketpair; - } - break; - case 't': - if (!memcmp(name, "gethostent", 10)) { - /* ^ */ - return -KEY_gethostent; /* Weight 3 */ - } - if (!memcmp(name, "endhostent", 10)) { - /* ^ */ - return -KEY_endhostent; - } - if (!memcmp(name, "sethostent", 10)) { - /* ^ */ - return -KEY_sethostent; - } - break; - case 'v': - if (!memcmp(name, "getservent", 10)) { - /* ^ */ - return -KEY_getservent; /* Weight 4 */ - } - if (!memcmp(name, "endservent", 10)) { - /* ^ */ - return -KEY_endservent; - } - if (!memcmp(name, "setservent", 10)) { - /* ^ */ - return -KEY_setservent; - } - break; - } - break; - case 11: - /* Names all of length 11. */ - /* __PACKAGE__ endprotoent getpeername getpriority getprotoent getsockname - setpriority setprotoent */ - /* Offset 5 gives the best switch position. */ - switch (name[5]) { - case 'K': - if (!memcmp(name, "__PACKAGE__", 11)) { - /* ^ */ - return -KEY___PACKAGE__; /* Weight 36767 */ - } - break; - case 'c': - if (!memcmp(name, "getsockname", 11)) { - /* ^ */ - return -KEY_getsockname; /* Weight 235 */ - } - break; - case 'e': - if (!memcmp(name, "getpeername", 11)) { - /* ^ */ - return -KEY_getpeername; /* Weight 713 */ - } - break; - case 'i': - if (!memcmp(name, "getpriority", 11)) { - /* ^ */ - return -KEY_getpriority; /* Weight 5 */ - } - if (!memcmp(name, "setpriority", 11)) { - /* ^ */ - return -KEY_setpriority; /* Weight 2 */ - } - break; - case 'o': - if (!memcmp(name, "endprotoent", 11)) { - /* ^ */ - return -KEY_endprotoent; - } - if (!memcmp(name, "getprotoent", 11)) { - /* ^ */ - return -KEY_getprotoent; - } - if (!memcmp(name, "setprotoent", 11)) { - /* ^ */ - return -KEY_setprotoent; - } - break; - } - break; - case 12: - /* Names all of length 12. */ - /* getnetbyaddr getnetbyname */ - /* Offset 9 gives the best switch position. */ - switch (name[9]) { - case 'a': - if (!memcmp(name, "getnetbyname", 12)) { - /* ^ */ - return -KEY_getnetbyname; - } - break; - case 'd': - if (!memcmp(name, "getnetbyaddr", 12)) { - /* ^ */ - return -KEY_getnetbyaddr; - } - break; - } - break; - case 13: - /* Names all of length 13. */ - /* gethostbyaddr gethostbyname getservbyname getservbyport */ - /* Offset 10 gives the best switch position. */ - switch (name[10]) { - case 'a': - if (!memcmp(name, "gethostbyname", 13)) { - /* ^ */ - return -KEY_gethostbyname; /* Weight 970 */ - } - if (!memcmp(name, "getservbyname", 13)) { - /* ^ */ - return -KEY_getservbyname; /* Weight 299 */ + + case 11: /* 8 tokens of length 11 */ + switch (name[0]) + { + case '_': + if (name[1] == '_' && + name[2] == 'P' && + name[3] == 'A' && + name[4] == 'C' && + name[5] == 'K' && + name[6] == 'A' && + name[7] == 'G' && + name[8] == 'E' && + name[9] == '_' && + name[10] == '_') + { /* __PACKAGE__ */ + return -KEY___PACKAGE__; + } + + goto unknown; + + case 'e': + if (name[1] == 'n' && + name[2] == 'd' && + name[3] == 'p' && + name[4] == 'r' && + name[5] == 'o' && + name[6] == 't' && + name[7] == 'o' && + name[8] == 'e' && + name[9] == 'n' && + name[10] == 't') + { /* endprotoent */ + return -KEY_endprotoent; + } + + goto unknown; + + case 'g': + if (name[1] == 'e' && + name[2] == 't') + { + switch (name[3]) + { + case 'p': + switch (name[4]) + { + case 'e': + if (name[5] == 'e' && + name[6] == 'r' && + name[7] == 'n' && + name[8] == 'a' && + name[9] == 'm' && + name[10] == 'e') + { /* getpeername */ + return -KEY_getpeername; + } + + goto unknown; + + case 'r': + switch (name[5]) + { + case 'i': + if (name[6] == 'o' && + name[7] == 'r' && + name[8] == 'i' && + name[9] == 't' && + name[10] == 'y') + { /* getpriority */ + return -KEY_getpriority; + } + + goto unknown; + + case 'o': + if (name[6] == 't' && + name[7] == 'o' && + name[8] == 'e' && + name[9] == 'n' && + name[10] == 't') + { /* getprotoent */ + return -KEY_getprotoent; + } + + goto unknown; + + default: + goto unknown; + } + + default: + goto unknown; + } + + case 's': + if (name[4] == 'o' && + name[5] == 'c' && + name[6] == 'k' && + name[7] == 'n' && + name[8] == 'a' && + name[9] == 'm' && + name[10] == 'e') + { /* getsockname */ + return -KEY_getsockname; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 's': + if (name[1] == 'e' && + name[2] == 't' && + name[3] == 'p' && + name[4] == 'r') + { + switch (name[5]) + { + case 'i': + if (name[6] == 'o' && + name[7] == 'r' && + name[8] == 'i' && + name[9] == 't' && + name[10] == 'y') + { /* setpriority */ + return -KEY_setpriority; + } + + goto unknown; + + case 'o': + if (name[6] == 't' && + name[7] == 'o' && + name[8] == 'e' && + name[9] == 'n' && + name[10] == 't') + { /* setprotoent */ + return -KEY_setprotoent; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + default: + goto unknown; } - break; - case 'd': - if (!memcmp(name, "gethostbyaddr", 13)) { - /* ^ */ - return -KEY_gethostbyaddr; /* Weight 68 */ + + case 12: /* 2 tokens of length 12 */ + if (name[0] == 'g' && + name[1] == 'e' && + name[2] == 't' && + name[3] == 'n' && + name[4] == 'e' && + name[5] == 't' && + name[6] == 'b' && + name[7] == 'y') + { + switch (name[8]) + { + case 'a': + if (name[9] == 'd' && + name[10] == 'd' && + name[11] == 'r') + { /* getnetbyaddr */ + return -KEY_getnetbyaddr; + } + + goto unknown; + + case 'n': + if (name[9] == 'a' && + name[10] == 'm' && + name[11] == 'e') + { /* getnetbyname */ + return -KEY_getnetbyname; + } + + goto unknown; + + default: + goto unknown; + } } - break; - case 'o': - if (!memcmp(name, "getservbyport", 13)) { - /* ^ */ - return -KEY_getservbyport; + + goto unknown; + + case 13: /* 4 tokens of length 13 */ + if (name[0] == 'g' && + name[1] == 'e' && + name[2] == 't') + { + switch (name[3]) + { + case 'h': + if (name[4] == 'o' && + name[5] == 's' && + name[6] == 't' && + name[7] == 'b' && + name[8] == 'y') + { + switch (name[9]) + { + case 'a': + if (name[10] == 'd' && + name[11] == 'd' && + name[12] == 'r') + { /* gethostbyaddr */ + return -KEY_gethostbyaddr; + } + + goto unknown; + + case 'n': + if (name[10] == 'a' && + name[11] == 'm' && + name[12] == 'e') + { /* gethostbyname */ + return -KEY_gethostbyname; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + case 's': + if (name[4] == 'e' && + name[5] == 'r' && + name[6] == 'v' && + name[7] == 'b' && + name[8] == 'y') + { + switch (name[9]) + { + case 'n': + if (name[10] == 'a' && + name[11] == 'm' && + name[12] == 'e') + { /* getservbyname */ + return -KEY_getservbyname; + } + + goto unknown; + + case 'p': + if (name[10] == 'o' && + name[11] == 'r' && + name[12] == 't') + { /* getservbyport */ + return -KEY_getservbyport; + } + + goto unknown; + + default: + goto unknown; + } + } + + goto unknown; + + default: + goto unknown; + } } - break; - } - break; - case 14: - if (!memcmp(name, "getprotobyname", 14)) { - return -KEY_getprotobyname; /* Weight 755 */ - } - break; - case 16: - if (!memcmp(name, "getprotobynumber", 16)) { - return -KEY_getprotobynumber; /* Weight 232 */ - } - break; + + goto unknown; + + case 14: /* 1 tokens of length 14 */ + if (name[0] == 'g' && + name[1] == 'e' && + name[2] == 't' && + name[3] == 'p' && + name[4] == 'r' && + name[5] == 'o' && + name[6] == 't' && + name[7] == 'o' && + name[8] == 'b' && + name[9] == 'y' && + name[10] == 'n' && + name[11] == 'a' && + name[12] == 'm' && + name[13] == 'e') + { /* getprotobyname */ + return -KEY_getprotobyname; + } + + goto unknown; + + case 16: /* 1 tokens of length 16 */ + if (name[0] == 'g' && + name[1] == 'e' && + name[2] == 't' && + name[3] == 'p' && + name[4] == 'r' && + name[5] == 'o' && + name[6] == 't' && + name[7] == 'o' && + name[8] == 'b' && + name[9] == 'y' && + name[10] == 'n' && + name[11] == 'u' && + name[12] == 'm' && + name[13] == 'b' && + name[14] == 'e' && + name[15] == 'r') + { /* getprotobynumber */ + return -KEY_getprotobynumber; + } + + goto unknown; + + default: + goto unknown; } + +unknown: return 0; } STATIC void -S_checkcomma(pTHX_ register char *s, char *name, char *what) +S_checkcomma(pTHX_ register char *s, const char *name, const char *what) { - char *w; + const char *w; if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ if (ckWARN(WARN_SYNTAX)) { @@ -6957,7 +8940,7 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) s++; if (*s == ',') { int kw; - *s = '\0'; + *s = '\0'; /* XXX If we didn't do this, we could const a lot of toke.c */ kw = keyword(w, s - w) || get_cv(w, FALSE) != 0; *s = ','; if (kw) @@ -6973,10 +8956,10 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) and type is used with error messages only. */ STATIC SV * -S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, +S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type) { - dSP; + dVAR; dSP; HV *table = GvHV(PL_hintgv); /* ^H */ SV *res; SV **cvp; @@ -7003,7 +8986,7 @@ S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s", (type ? type: "undef"), why1, why2, why3); msgdone: - yyerror(SvPVX(msg)); + yyerror(SvPVX_const(msg)); SvREFCNT_dec(msg); return sv; } @@ -7109,7 +9092,7 @@ S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_packag } STATIC char * -S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni) +S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRLEN destlen, I32 ck_uni) { register char *d; register char *e; @@ -7184,7 +9167,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if (bracket) { if (isSPACE(s[-1])) { while (s < send) { - char ch = *s++; + const char ch = *s++; if (!SPACE_OR_TAB(ch)) { *d = ch; break; @@ -7288,9 +9271,8 @@ STATIC char * S_scan_pat(pTHX_ char *start, I32 type) { PMOP *pm; - char *s; + char *s = scan_str(start,FALSE,FALSE); - s = scan_str(start,FALSE,FALSE); if (!s) Perl_croak(aTHX_ "Search pattern not terminated"); @@ -7306,7 +9288,7 @@ S_scan_pat(pTHX_ char *start, I32 type) pmflag(&pm->op_pmflags,*s++); } /* issue a warning if /c is specified,but /g is not */ - if (ckWARN(WARN_REGEXP) && + if (ckWARN(WARN_REGEXP) && (pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)) { Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g); @@ -7322,6 +9304,7 @@ S_scan_pat(pTHX_ char *start, I32 type) STATIC char * S_scan_subst(pTHX_ char *start) { + dVAR; register char *s; register PMOP *pm; I32 first_start; @@ -7455,10 +9438,12 @@ S_scan_heredoc(pTHX_ register char *s) I32 len; SV *tmpstr; char term; + const char newline[] = "\n"; + const char *found_newline; register char *d; register char *e; char *peek; - int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR)); + const int outer = (PL_rsfp && !(PL_lex_inwhat == OP_SCALAR)); s += 2; d = PL_tokenbuf; @@ -7511,26 +9496,28 @@ S_scan_heredoc(pTHX_ register char *s) } *d = '\0'; PL_bufend = d; - SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr)); + SvCUR_set(PL_linestr, PL_bufend - SvPVX_const(PL_linestr)); s = olds; } #endif - d = "\n"; - if (outer || !(d=ninstr(s,PL_bufend,d,d+1))) - herewas = newSVpvn(s,PL_bufend-s); - else - s--, herewas = newSVpvn(s,d-s); + if ( outer || !(found_newline = ninstr(s,PL_bufend,newline,newline+1)) ) { + herewas = newSVpvn(s,PL_bufend-s); + } + else { + s--; + herewas = newSVpvn(s,found_newline-s); + } s += SvCUR(herewas); tmpstr = NEWSV(87,79); sv_upgrade(tmpstr, SVt_PVIV); if (term == '\'') { op_type = OP_CONST; - SvIVX(tmpstr) = -1; + SvIV_set(tmpstr, -1); } else if (term == '`') { op_type = OP_BACKTICK; - SvIVX(tmpstr) = '\\'; + SvIV_set(tmpstr, '\\'); } CLINE; @@ -7558,7 +9545,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_setpvn(tmpstr,d+1,s-d); s += len - 1; sv_catpvn(herewas,s,bufend-s); - Copy(SvPVX(herewas),bufptr,SvCUR(herewas) + 1,char); + Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char); s = olds; goto retval; @@ -7602,7 +9589,7 @@ S_scan_heredoc(pTHX_ register char *s) { PL_bufend[-2] = '\n'; PL_bufend--; - SvCUR_set(PL_linestr, PL_bufend - SvPVX(PL_linestr)); + SvCUR_set(PL_linestr, PL_bufend - SvPVX_const(PL_linestr)); } else if (PL_bufend[-1] == '\r') PL_bufend[-1] = '\n'; @@ -7616,11 +9603,11 @@ S_scan_heredoc(pTHX_ register char *s) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); - SvIVX(sv) = 0; + SvIV_set(sv, 0); av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv); } if (*s == term && memEQ(s,PL_tokenbuf,len)) { - STRLEN off = PL_bufend - 1 - SvPVX(PL_linestr); + STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr); *(SvPVX(PL_linestr) + off ) = ' '; sv_catsv(PL_linestr,herewas); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); @@ -7635,12 +9622,11 @@ S_scan_heredoc(pTHX_ register char *s) retval: PL_multi_end = CopLINE(PL_curcop); if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) { - SvLEN_set(tmpstr, SvCUR(tmpstr) + 1); - Renew(SvPVX(tmpstr), SvLEN(tmpstr), char); + SvPV_shrink_to_cur(tmpstr); } SvREFCNT_dec(herewas); if (!IN_BYTES) { - if (UTF && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr))) + if (UTF && is_utf8_string((U8*)SvPVX_const(tmpstr), SvCUR(tmpstr))) SvUTF8_on(tmpstr); else if (PL_encoding) sv_recode_to_utf8(tmpstr, PL_encoding); @@ -7752,7 +9738,7 @@ S_scan_inputsymbol(pTHX_ char *start) if ((tmp = pad_findmy(d)) != NOT_IN_PAD) { if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) { SV *sym = sv_2mortal( - newSVpv(HvNAME(PAD_COMPNAME_OURSTASH(tmp)),0)); + newSVpv(HvNAME_get(PAD_COMPNAME_OURSTASH(tmp)),0)); sv_catpvn(sym, "::", 2); sv_catpv(sym, d+1); d = SvPVX(sym); @@ -7902,7 +9888,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) assuming. 79 is the SV's initial length. What a random number. */ sv = NEWSV(87,79); sv_upgrade(sv, SVt_PVIV); - SvIVX(sv) = termcode; + SvIV_set(sv, termcode); (void)SvPOK_only(sv); /* validate pointer */ /* move past delimiter and try to read a complete string */ @@ -7914,10 +9900,10 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) bool cont = TRUE; while (cont) { - int offset = s - SvPVX(PL_linestr); + int offset = s - SvPVX_const(PL_linestr); bool found = sv_cat_decode(sv, PL_encoding, PL_linestr, &offset, (char*)termstr, termlen); - char *ns = SvPVX(PL_linestr) + offset; + const char *ns = SvPVX_const(PL_linestr) + offset; char *svlast = SvEND(sv) - 1; for (; s < ns; s++) { @@ -7929,8 +9915,8 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) else { /* handle quoted delimiters */ if (SvCUR(sv) > 1 && *(svlast-1) == '\\') { - char *t; - for (t = svlast-2; t >= SvPVX(sv) && *t == '\\';) + const char *t; + for (t = svlast-2; t >= SvPVX_const(sv) && *t == '\\';) t--; if ((svlast-1 - t) % 2) { if (!keep_quoted) { @@ -7945,10 +9931,11 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) cont = FALSE; } else { - char *t, *w; + const char *t; + char *w; if (!last) last = SvPVX(sv); - for (w = t = last; t < svlast; w++, t++) { + for (t = w = last; t < svlast; w++, t++) { /* At here, all closes are "was quoted" one, so we don't check PL_multi_close. */ if (*t == '\\') { @@ -7965,7 +9952,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) if (w < t) { *w++ = term; *w = '\0'; - SvCUR_set(sv, w - SvPVX(sv)); + SvCUR_set(sv, w - SvPVX_const(sv)); } last = w; if (--brackets <= 0) @@ -8043,7 +10030,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) } /* terminate the copied string and update the sv's end-of-string */ *to = '\0'; - SvCUR_set(sv, to - SvPVX(sv)); + SvCUR_set(sv, to - SvPVX_const(sv)); /* * this next chunk reads more into the buffer if we're not done yet @@ -8053,18 +10040,18 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) break; /* handle case where we are done yet :-) */ #ifndef PERL_STRICT_CR - if (to - SvPVX(sv) >= 2) { + if (to - SvPVX_const(sv) >= 2) { if ((to[-2] == '\r' && to[-1] == '\n') || (to[-2] == '\n' && to[-1] == '\r')) { to[-2] = '\n'; to--; - SvCUR_set(sv, to - SvPVX(sv)); + SvCUR_set(sv, to - SvPVX_const(sv)); } else if (to[-1] == '\r') to[-1] = '\n'; } - else if (to - SvPVX(sv) == 1 && to[-1] == '\r') + else if (to - SvPVX_const(sv) == 1 && to[-1] == '\r') to[-1] = '\n'; #endif @@ -8088,7 +10075,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); (void)SvIOK_on(sv); - SvIVX(sv) = 0; + SvIV_set(sv, 0); av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv); } @@ -8112,7 +10099,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) /* if we allocated too much space, give some back */ if (SvCUR(sv) + 5 < SvLEN(sv)) { SvLEN_set(sv, SvCUR(sv) + 1); - Renew(SvPVX(sv), SvLEN(sv), char); + SvPV_renew(sv, SvLEN(sv)); } /* decide whether this is the first or second quoted string we've read @@ -8149,16 +10136,16 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) */ char * -Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) +Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) { - register char *s = start; /* current position in buffer */ + register const char *s = start; /* current position in buffer */ register char *d; /* destination in temp buffer */ register char *e; /* end of temp buffer */ NV nv; /* number read, as a double */ SV *sv = Nullsv; /* place to put the converted number */ bool floatit; /* boolean: int or float? */ - char *lastub = 0; /* position of last underbar */ - static char number_too_long[] = "Number too long"; + const char *lastub = 0; /* position of last underbar */ + static char const number_too_long[] = "Number too long"; /* We use the first character to decide what type of number this is */ @@ -8185,17 +10172,18 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) I32 shift; bool overflowed = FALSE; bool just_zero = TRUE; /* just plain 0 or binary number? */ - static NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 }; - static char* bases[5] = { "", "binary", "", "octal", - "hexadecimal" }; - static char* Bases[5] = { "", "Binary", "", "Octal", - "Hexadecimal" }; - static char *maxima[5] = { "", - "0b11111111111111111111111111111111", - "", - "037777777777", - "0xffffffff" }; - char *base, *Base, *max; + static const NV nvshift[5] = { 1.0, 2.0, 4.0, 8.0, 16.0 }; + static const char* const bases[5] = + { "", "binary", "", "octal", "hexadecimal" }; + static const char* const Bases[5] = + { "", "Binary", "", "Octal", "Hexadecimal" }; + static const char* const maxima[5] = + { "", + "0b11111111111111111111111111111111", + "", + "037777777777", + "0xffffffff" }; + const char *base, *Base, *max; /* check for hex */ if (s[1] == 'x') { @@ -8337,7 +10325,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) sv_setuv(sv, u); } if (just_zero && (PL_hints & HINT_NEW_INTEGER)) - sv = new_constant(start, s - start, "integer", + sv = new_constant(start, s - start, "integer", sv, Nullsv, NULL); else if (PL_hints & HINT_NEW_BINARY) sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL); @@ -8525,7 +10513,7 @@ vstring: else lvalp->opval = Nullop; - return s; + return (char *)s; } STATIC char * @@ -8551,7 +10539,7 @@ S_scan_formline(pTHX_ register char *s) } } if (PL_in_eval && !PL_rsfp) { - eol = memchr(s,'\n',PL_bufend-s); + eol = (char *) memchr(s,'\n',PL_bufend-s); if (!eol++) eol = PL_bufend; } @@ -8573,14 +10561,14 @@ S_scan_formline(pTHX_ register char *s) char *end = SvPVX(stuff) + SvCUR(stuff); end[-2] = '\n'; end[-1] = '\0'; - SvCUR(stuff)--; + SvCUR_set(stuff, SvCUR(stuff) - 1); } #endif } else break; } - s = eol; + s = (char*)eol; if (PL_rsfp) { s = filter_gets(PL_linestr, PL_rsfp, 0); PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr); @@ -8604,7 +10592,7 @@ S_scan_formline(pTHX_ register char *s) else PL_lex_state = LEX_FORMLINE; if (!IN_BYTES) { - if (UTF && is_utf8_string((U8*)SvPVX(stuff), SvCUR(stuff))) + if (UTF && is_utf8_string((U8*)SvPVX_const(stuff), SvCUR(stuff))) SvUTF8_on(stuff); else if (PL_encoding) sv_recode_to_utf8(stuff, PL_encoding); @@ -8635,7 +10623,7 @@ S_set_csh(pTHX) I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags) { - I32 oldsavestack_ix = PL_savestack_ix; + const I32 oldsavestack_ix = PL_savestack_ix; CV* outsidecv = PL_compcv; if (PL_compcv) { @@ -8661,7 +10649,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) #pragma segment Perl_yylex #endif int -Perl_yywarn(pTHX_ char *s) +Perl_yywarn(pTHX_ const char *s) { PL_in_eval |= EVAL_WARNONLY; yyerror(s); @@ -8670,10 +10658,10 @@ Perl_yywarn(pTHX_ char *s) } int -Perl_yyerror(pTHX_ char *s) +Perl_yyerror(pTHX_ const char *s) { - char *where = NULL; - char *context = NULL; + const char *where = NULL; + const char *context = NULL; int contlen = -1; SV *msg; @@ -8730,7 +10718,7 @@ Perl_yyerror(pTHX_ char *s) Perl_sv_catpvf(aTHX_ where_sv, "%c", yychar); else Perl_sv_catpvf(aTHX_ where_sv, "\\%03o", yychar & 255); - where = SvPVX(where_sv); + where = SvPVX_const(where_sv); } msg = sv_2mortal(newSVpv(s, 0)); Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ", @@ -8768,8 +10756,7 @@ Perl_yyerror(pTHX_ char *s) STATIC char* S_swallow_bom(pTHX_ U8 *s) { - STRLEN slen; - slen = SvCUR(PL_linestr); + const STRLEN slen = SvCUR(PL_linestr); switch (s[0]) { case 0xFF: if (s[1] == 0xFE) { @@ -8881,8 +10868,8 @@ restore_rsfp(pTHX_ void *f) static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - STRLEN old = SvCUR(sv); - I32 count = FILTER_READ(idx+1, sv, maxlen); + const STRLEN old = SvCUR(sv); + const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, "utf16_textfilter(%p): %d %d (%d)\n", utf16_textfilter, idx, maxlen, (int) count)); @@ -8890,8 +10877,8 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) U8* tmps; I32 newlen; New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - Copy(SvPVX(sv), tmps, old, char); - utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old, + Copy(SvPVX_const(sv), tmps, old, char); + utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, SvCUR(sv) - old, &newlen); sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } @@ -8902,8 +10889,8 @@ utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen) static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - STRLEN old = SvCUR(sv); - I32 count = FILTER_READ(idx+1, sv, maxlen); + const STRLEN old = SvCUR(sv); + const I32 count = FILTER_READ(idx+1, sv, maxlen); DEBUG_P(PerlIO_printf(Perl_debug_log, "utf16rev_textfilter(%p): %d %d (%d)\n", utf16rev_textfilter, idx, maxlen, (int) count)); @@ -8911,8 +10898,8 @@ utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen) U8* tmps; I32 newlen; New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8); - Copy(SvPVX(sv), tmps, old, char); - utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old, + Copy(SvPVX_const(sv), tmps, old, char); + utf16_to_utf8((U8*)SvPVX_const(sv) + old, tmps + old, SvCUR(sv) - old, &newlen); sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old); } @@ -8936,22 +10923,22 @@ passed in, for performance reasons. */ char * -Perl_scan_vstring(pTHX_ char *s, SV *sv) +Perl_scan_vstring(pTHX_ const char *s, SV *sv) { - char *pos = s; - char *start = s; + const char *pos = s; + const char *start = s; if (*pos == 'v') pos++; /* get past 'v' */ while (pos < PL_bufend && (isDIGIT(*pos) || *pos == '_')) pos++; if ( *pos != '.') { /* this may not be a v-string if followed by => */ - char *next = pos; + const char *next = pos; while (next < PL_bufend && isSPACE(*next)) ++next; if ((PL_bufend - next) >= 2 && *next == '=' && next[1] == '>' ) { /* return string not v-string */ sv_setpvn(sv,(char *)s,pos-s); - return pos; + return (char *)pos; } } @@ -8968,7 +10955,7 @@ Perl_scan_vstring(pTHX_ char *s, SV *sv) rev = 0; { /* this is atoi() that tolerates underscores */ - char *end = pos; + const char *end = pos; UV mult = 1; while (--end >= s) { UV orev; @@ -9004,6 +10991,15 @@ Perl_scan_vstring(pTHX_ char *s, SV *sv) sv_magic(sv,NULL,PERL_MAGIC_vstring,(const char*)start, pos-start); SvRMAGICAL_on(sv); } - return s; + return (char *)s; } +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * ex: set ts=8 sts=4 sw=4 noet: + */