Change 13028 by jhi@alpha on 2001/11/15 21:21:29
Subject: [PATCH] v-strings as Objects Step 1
From: John Peacock <[EMAIL PROTECTED]>
Date: Thu, 15 Nov 2001 12:41:04 -0500
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/embed.h#305 edit
.... //depot/perl/embed.pl#294 edit
.... //depot/perl/global.sym#185 edit
.... //depot/perl/pod/perlapi.pod#106 edit
.... //depot/perl/proto.h#347 edit
.... //depot/perl/toke.c#398 edit
.... //depot/perl/util.c#299 edit
Differences ...
==== //depot/perl/embed.h#305 (text+w) ====
Index: perl/embed.h
--- perl/embed.h.~1~ Thu Nov 15 14:30:06 2001
+++ perl/embed.h Thu Nov 15 14:30:06 2001
@@ -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)
==== //depot/perl/embed.pl#294 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Thu Nov 15 14:30:06 2001
+++ perl/embed.pl Thu Nov 15 14:30:06 2001
@@ -1573,6 +1573,7 @@
|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
==== //depot/perl/global.sym#185 (text+w) ====
Index: perl/global.sym
--- perl/global.sym.~1~ Thu Nov 15 14:30:06 2001
+++ perl/global.sym Thu Nov 15 14:30:06 2001
@@ -302,6 +302,7 @@
Perl_newUNOP
Perl_newWHILEOP
Perl_new_stackinfo
+Perl_new_vstring
Perl_ninstr
Perl_op_free
Perl_pad_sv
==== //depot/perl/pod/perlapi.pod#106 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Thu Nov 15 14:30:06 2001
+++ perl/pod/perlapi.pod Thu Nov 15 14:30:06 2001
@@ -794,7 +794,7 @@
=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 @@
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 @@
=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 @@
=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 @@
=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 @@
=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 @@
=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)
==== //depot/perl/proto.h#347 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Thu Nov 15 14:30:06 2001
+++ perl/proto.h Thu Nov 15 14:30:06 2001
@@ -561,6 +561,7 @@
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);
==== //depot/perl/toke.c#398 (text) ====
Index: perl/toke.c
--- perl/toke.c.~1~ Thu Nov 15 14:30:06 2001
+++ perl/toke.c Thu Nov 15 14:30:06 2001
@@ -7222,7 +7222,7 @@
}
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 @@
/* 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;
}
==== //depot/perl/util.c#299 (text) ====
Index: perl/util.c
--- perl/util.c.~1~ Thu Nov 15 14:30:06 2001
+++ perl/util.c Thu Nov 15 14:30:06 2001
@@ -3884,3 +3884,76 @@
#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;
+}
+
+
End of Patch.
