diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | pod/perlapi.pod | 58 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rw-r--r-- | toke.c | 56 | ||||
| -rw-r--r-- | util.c | 73 |
7 files changed, 119 insertions, 73 deletions
@@ -498,6 +498,7 @@ #define newUNOP Perl_newUNOP #define newWHILEOP Perl_newWHILEOP #define new_stackinfo Perl_new_stackinfo +#define new_vstring Perl_new_vstring #define nextargv Perl_nextargv #define ninstr Perl_ninstr #define oopsCV Perl_oopsCV @@ -2015,6 +2016,7 @@ #define newUNOP(a,b,c) Perl_newUNOP(aTHX_ a,b,c) #define newWHILEOP(a,b,c,d,e,f,g) Perl_newWHILEOP(aTHX_ a,b,c,d,e,f,g) #define new_stackinfo(a,b) Perl_new_stackinfo(aTHX_ a,b) +#define new_vstring(a,b) Perl_new_vstring(aTHX_ a,b) #define nextargv(a) Perl_nextargv(aTHX_ a) #define ninstr(a,b,c,d) Perl_ninstr(aTHX_ a,b,c,d) #define oopsCV(a) Perl_oopsCV(aTHX_ a) @@ -1573,6 +1573,7 @@ Ap |OP* |newWHILEOP |I32 flags|I32 debuggable|LOOP* loop \ |I32 whileline|OP* expr|OP* block|OP* cont Ap |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems +Apd |char* |new_vstring |char *vstr|SV *sv p |PerlIO*|nextargv |GV* gv Ap |char* |ninstr |const char* big|const char* bigend \ |const char* little|const char* lend diff --git a/global.sym b/global.sym index 1130326257..5d0372f591 100644 --- a/global.sym +++ b/global.sym @@ -302,6 +302,7 @@ Perl_newSVsv Perl_newUNOP Perl_newWHILEOP Perl_new_stackinfo +Perl_new_vstring Perl_ninstr Perl_op_free Perl_pad_sv diff --git a/pod/perlapi.pod b/pod/perlapi.pod index fb6d0a669d..ef4ab300ce 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -794,7 +794,7 @@ Found in file cop.h =item HEf_SVKEY This flag, used in the length slot of hash entries and magic structures, -specifies the structure contains a C<SV*> pointer where a C<char*> pointer +specifies the structure contains an C<SV*> pointer where a C<char*> pointer is to be expected. (For information only--not to be used). =for hackers @@ -958,7 +958,7 @@ Found in file hv.c Returns the SV which corresponds to the specified key in the hash. The C<klen> is the length of the key. If C<lval> is set then the fetch will be part of a store. Check that the return value is non-null before -dereferencing it to a C<SV*>. +dereferencing it to an C<SV*>. See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more information on how to use this function on tied hashes. @@ -1553,6 +1553,24 @@ memory is zeroed with C<memzero>. =for hackers Found in file handy.h +=item new_vstring + +Returns a pointer to the next character after the parsed +vstring, as well as updating the passed in sv. + * +Function must be called like + + sv = NEWSV(92,5); + s = new_vstring(s,sv); + +The sv must already be large enough to store the vstring +passed in. + + char* new_vstring(char *vstr, SV *sv) + +=for hackers +Found in file util.c + =item Nullav Null AV pointer. @@ -2220,7 +2238,7 @@ Found in file sv.h =item SvIOK_notUV -Returns a boolean indicating whether the SV contains an signed integer. +Returns a boolean indicating whether the SV contains a signed integer. void SvIOK_notUV(SV* sv) @@ -2282,22 +2300,22 @@ version which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvIVx +=item SvIVX -Coerces the given SV to an integer and returns it. Guarantees to evaluate -sv only once. Use the more efficient C<SvIV> otherwise. +Returns the raw value in the SV's IV slot, without checks or conversions. +Only use when you are sure SvIOK is true. See also C<SvIV()>. - IV SvIVx(SV* sv) + IV SvIVX(SV* sv) =for hackers Found in file sv.h -=item SvIVX +=item SvIVx -Returns the raw value in the SV's IV slot, without checks or conversions. -Only use when you are sure SvIOK is true. See also C<SvIV()>. +Coerces the given SV to an integer and returns it. Guarantees to evaluate +sv only once. Use the more efficient C<SvIV> otherwise. - IV SvIVX(SV* sv) + IV SvIVx(SV* sv) =for hackers Found in file sv.h @@ -2397,22 +2415,22 @@ which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvNVX +=item SvNVx -Returns the raw value in the SV's NV slot, without checks or conversions. -Only use when you are sure SvNOK is true. See also C<SvNV()>. +Coerces the given SV to a double and returns it. Guarantees to evaluate +sv only once. Use the more efficient C<SvNV> otherwise. - NV SvNVX(SV* sv) + NV SvNVx(SV* sv) =for hackers Found in file sv.h -=item SvNVx +=item SvNVX -Coerces the given SV to a double and returns it. Guarantees to evaluate -sv only once. Use the more efficient C<SvNV> otherwise. +Returns the raw value in the SV's NV slot, without checks or conversions. +Only use when you are sure SvNOK is true. See also C<SvNV()>. - NV SvNVx(SV* sv) + NV SvNVX(SV* sv) =for hackers Found in file sv.h @@ -4521,7 +4539,7 @@ Found in file XSUB.h =item XSRETURN_NV -Return an double from an XSUB immediately. Uses C<XST_mNV>. +Return a double from an XSUB immediately. Uses C<XST_mNV>. void XSRETURN_NV(NV nv) @@ -561,6 +561,7 @@ PERL_CALLCONV OP* Perl_newUNOP(pTHX_ I32 type, I32 flags, OP* first); PERL_CALLCONV OP* Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP* loop, I32 whileline, OP* expr, OP* block, OP* cont); PERL_CALLCONV PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems); +PERL_CALLCONV char* Perl_new_vstring(pTHX_ char *vstr, SV *sv); PERL_CALLCONV PerlIO* Perl_nextargv(pTHX_ GV* gv); PERL_CALLCONV char* Perl_ninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend); PERL_CALLCONV OP* Perl_oopsCV(pTHX_ OP* o); @@ -7222,7 +7222,7 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) } if (*s == '.' && isDIGIT(s[1])) { /* oops, it's really a v-string, but without the "v" */ - s = start - 1; + s = start; goto vstring; } } @@ -7316,58 +7316,8 @@ Perl_scan_num(pTHX_ char *start, YYSTYPE* lvalp) /* if it starts with a v, it could be a v-string */ case 'v': vstring: - { - char *pos = s; - pos++; - while (isDIGIT(*pos) || *pos == '_') - pos++; - if (!isALPHA(*pos)) { - UV rev; - U8 tmpbuf[UTF8_MAXLEN+1]; - U8 *tmpend; - s++; /* get past 'v' */ - - sv = NEWSV(92,5); - sv_setpvn(sv, "", 0); - - for (;;) { - if (*s == '0' && isDIGIT(s[1])) - yyerror("Octal number in vector unsupported"); - rev = 0; - { - /* this is atoi() that tolerates underscores */ - char *end = pos; - UV mult = 1; - while (--end >= s) { - UV orev; - if (*end == '_') - continue; - orev = rev; - rev += (*end - '0') * mult; - mult *= 10; - if (orev > rev && ckWARN_d(WARN_OVERFLOW)) - Perl_warner(aTHX_ WARN_OVERFLOW, - "Integer overflow in decimal number"); - } - } - /* Append native character for the rev point */ - tmpend = uvchr_to_utf8(tmpbuf, rev); - sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); - if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev))) - SvUTF8_on(sv); - if (*pos == '.' && isDIGIT(pos[1])) - s = ++pos; - else { - s = pos; - break; - } - while (isDIGIT(*pos) || *pos == '_') - pos++; - } - SvPOK_on(sv); - SvREADONLY_on(sv); - } - } + sv = NEWSV(92,5); /* preallocate storage space */ + s = new_vstring(s,sv); break; } @@ -3884,3 +3884,76 @@ Perl_getcwd_sv(pTHX_ register SV *sv) #endif } +/* +=for apidoc new_vstring + +Returns a pointer to the next character after the parsed +vstring, as well as updating the passed in sv. + * +Function must be called like + + sv = NEWSV(92,5); + s = new_vstring(s,sv); + +The sv must already be large enough to store the vstring +passed in. + +=cut +*/ + +char * +Perl_new_vstring(pTHX_ char *s, SV *sv) +{ + char *pos = s; + if (*pos == 'v') pos++; /* get past 'v' */ + while (isDIGIT(*pos) || *pos == '_') + pos++; + if (!isALPHA(*pos)) { + UV rev; + U8 tmpbuf[UTF8_MAXLEN+1]; + U8 *tmpend; + + if (*s == 'v') s++; /* get past 'v' */ + + sv_setpvn(sv, "", 0); + + for (;;) { + rev = 0; + { + /* this is atoi() that tolerates underscores */ + char *end = pos; + UV mult = 1; + if ( *(s-1) == '_') { + mult = 10; + } + while (--end >= s) { + UV orev; + orev = rev; + rev += (*end - '0') * mult; + mult *= 10; + if (orev > rev && ckWARN_d(WARN_OVERFLOW)) + Perl_warner(aTHX_ WARN_OVERFLOW, + "Integer overflow in decimal number"); + } + } + /* Append native character for the rev point */ + tmpend = uvchr_to_utf8(tmpbuf, rev); + sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); + if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev))) + SvUTF8_on(sv); + if ( (*pos == '.' || *pos == '_') && isDIGIT(pos[1])) + s = ++pos; + else { + s = pos; + break; + } + while (isDIGIT(*pos) ) + pos++; + } + SvPOK_on(sv); + SvREADONLY_on(sv); + } + return s; +} + + |