Skip to content

Add sv_vstring_get API around PERL_MAGIC_vstring #23075

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 18, 2025
Merged

Add sv_vstring_get API around PERL_MAGIC_vstring #23075

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions MANIFEST
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5217,6 +5217,7 @@ ext/XS-APItest/t/utf8_warn08.t Tests for code in utf8.c
ext/XS-APItest/t/utf8_warn09.t Tests for code in utf8.c
ext/XS-APItest/t/utf8_warn_base.pl Tests for code in utf8.c
ext/XS-APItest/t/valid_identifier.t XS::APItest: tests for valid_identifier_sv()
ext/XS-APItest/t/vstring.t XS::APItest: tests for sv_vstring_*() API
ext/XS-APItest/t/weaken.t XS::APItest: tests for sv_rvweaken() and sv_get_backrefs()
ext/XS-APItest/t/whichsig.t XS::APItest: tests for whichsig() and variants
ext/XS-APItest/t/win32.t Test Win32 specific APIs
Expand Down
28 changes: 22 additions & 6 deletions dist/Storable/Storable.xs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -296,6 +296,23 @@ typedef STRLEN ntag_t;
#define VSTRING_CROAK() CROAK(("Cannot retrieve vstring in this perl"))
#endif

#ifndef sv_vstring_get
#define sv_vstring_get(sv,lenp) S_sv_vstring_get(aTHX_ sv,lenp)
static const char *S_sv_vstring_get(pTHX_ SV *sv, STRLEN *lenp)
{
MAGIC *mg;
if(!SvMAGICAL(sv) || !(mg = mg_find(sv, PERL_MAGIC_vstring)))
return NULL;

*lenp = mg->mg_len;
return mg->mg_ptr;
}
#endif

#ifndef SvVSTRING
#define SvVSTRING(sv,len) (sv_vstring_get(sv, &(len)))
#endif

#ifdef HvPLACEHOLDERS
#define HAS_RESTRICTED_HASHES
#else
Expand Down Expand Up @@ -2583,7 +2600,8 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)

} else if (flags & (SVp_POK | SVp_NOK | SVp_IOK)) {
#ifdef SvVOK
MAGIC *mg;
const char *vstr_pv;
STRLEN vstr_len;
#endif
UV wlen; /* For 64-bit machines */

Expand All @@ -2597,18 +2615,16 @@ static int store_scalar(pTHX_ stcxt_t *cxt, SV *sv)
string:

#ifdef SvVOK
if (SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))) {
if ((vstr_pv = SvVSTRING(sv, vstr_len))) {
/* The macro passes this by address, not value, and a lot of
called code assumes that it's 32 bits without checking. */
const SSize_t len = mg->mg_len;
/* we no longer accept vstrings over I32_SIZE-1, so don't emit
them, also, older Storables handle them badly.
*/
if (len >= I32_MAX) {
if (vstr_len >= I32_MAX) {
CROAK(("vstring too large to freeze"));
}
STORE_PV_LEN((const char *)mg->mg_ptr,
len, SX_VSTRING, SX_LVSTRING);
STORE_PV_LEN(vstr_pv, vstr_len, SX_VSTRING, SX_LVSTRING);
}
#endif

Expand Down
2 changes: 1 addition & 1 deletion dist/Storable/lib/Storable.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ our @EXPORT_OK = qw(
our ($canonical, $forgive_me);

BEGIN {
our $VERSION = '3.35';
our $VERSION = '3.36';
}

our $recursion_limit;
Expand Down
3 changes: 3 additions & 0 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3602,6 +3602,9 @@ Adp |void |sv_vsetpvfn |NN SV * const sv \
|NULLOK SV ** const svargs \
|const Size_t sv_count \
|NULLOK bool * const maybe_tainted
Adp |const char *|sv_vstring_get \
|NN SV * const sv \
|NULLOK STRLEN *lenp
Cipx |void |switch_argstack|NN AV *to
Adp |void |switch_to_global_locale
Adp |bool |sync_locale
Expand Down
1 change: 1 addition & 0 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -849,6 +849,7 @@
# define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c)
# define sv_vsetpvf_mg(a,b,c) Perl_sv_vsetpvf_mg(aTHX_ a,b,c)
# define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
# define sv_vstring_get(a,b) Perl_sv_vstring_get(aTHX_ a,b)
# define switch_argstack(a) Perl_switch_argstack(aTHX_ a)
# define switch_to_global_locale() Perl_switch_to_global_locale(aTHX)
# define sync_locale() Perl_sync_locale(aTHX)
Expand Down
19 changes: 19 additions & 0 deletions ext/XS-APItest/APItest.xs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8200,3 +8200,22 @@ get_savestack_ix()
RETVAL = PL_savestack_ix;
OUTPUT:
RETVAL

MODULE = XS::APItest PACKAGE = XS::APItest::vstring

bool
SvVOK(SV *sv)

SV *
SvVSTRING(SV *sv)
CODE:
{
const char *vstr_pv;
STRLEN vstr_len;
if((vstr_pv = SvVSTRING(sv, vstr_len)))
RETVAL = newSVpvn(vstr_pv, vstr_len);
else
RETVAL = &PL_sv_undef;
}
OUTPUT:
RETVAL
10 changes: 10 additions & 0 deletions ext/XS-APItest/t/vstring.t
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
#!perl

use Test::More tests => 2;
use XS::APItest;

{
my $vstr = v1.23.456;
ok SvVOK($vstr), '$vstr has SvVOK';
is SvVSTRING($vstr), "v1.23.456", 'SvVSTRING()';
}
5 changes: 5 additions & 0 deletions proto.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

36 changes: 32 additions & 4 deletions sv.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4741,10 +4741,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dsv, SV* ssv, const I32 flags)
}
SvFLAGS(dsv) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_UTF8);
{
const MAGIC * const smg = SvVSTRING_mg(ssv);
if (smg) {
sv_magic(dsv, NULL, PERL_MAGIC_vstring,
smg->mg_ptr, smg->mg_len);
const char *vstr_pv;
STRLEN vstr_len;
if ((vstr_pv = SvVSTRING(ssv, vstr_len))) {
sv_magic(dsv, NULL, PERL_MAGIC_vstring, vstr_pv, vstr_len);
SvRMAGICAL_on(dsv);
}
}
Expand Down Expand Up @@ -17891,6 +17891,34 @@ Perl_sv_regex_global_pos_clear(pTHX_ SV *sv)
mg->mg_len = -1;
}

/*
=for apidoc sv_vstring_get

If the given SV has vstring magic, stores the length of it into the variable
addressed by C<lenp>, and returns the string pointer. If not, returns
C<NULL>.

If a pointer is returned to the caller, it will point to memory owned by the
SV itself. The caller is not responsible for freeing it after this call,
though it will not remain valid for longer than the lifetime of the SV itself.
The caller should take a copy of it if it needs to be accessed after this
time.

=cut
*/

const char *
Perl_sv_vstring_get(pTHX_ SV * const sv, STRLEN *lenp)
{
Copy link
Contributor

@bulk88 bulk88 Mar 6, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why is retval of Perl_sv_vstring_get of type bool and not of type STRLEN?

What does if(SvVOK(sv) && SvVCUR(sv) == 0) { NOOP; } mean on a PP/XS/C level?

why not move arg 3 STRLEN *lenp to retval?

Code like if(!len) { die("bad input"); } has universal meaning.

if(1) {
        sv_setpvs(TARG, "0 but true");
        XPUSHTARG;
        RETURN;
    }

is very rare in Perl/all SW dev.

Copy link
Contributor Author

@leonerd leonerd Mar 7, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why is retval of Perl_sv_vstring_get of type bool and not of type STRLEN?

It matches the similar API shape I added with sv_regex_global_pos_get().

Copy link
Contributor

@mohawk2 mohawk2 Mar 7, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I like the idea of more use of retvals where no ambiguity is possible. Should sv_regex_global_pos_get() also return its STRLEN?

Copy link
Contributor

@bulk88 bulk88 Jun 19, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

sv_regex_global_pos_get()

bool
Perl_sv_regex_global_pos_get(pTHX_ SV *sv, STRLEN *posp, U32 flags)
{

HELL YEAH.
getpos

Although int Perl_magic_getpos(interpreter *my_perl, sv *sv, magic *mg) is too tiny and too simple to have this defect. MSVC for len as in pv = SvPV(sv, len); will redundantly re-read len over and over from C stack memory, because C stack auto var len ESCAPED!!!! any and all C functions in Perl's virtual address space can unpredictably rewrite the value inside C stack auto len stored in real C stack memory (not a register).

So it would be beneficial on all ABI/CPU arcs, to return STRLEN *posp either as the 1 and only retval, and eliminate the bool. or say retval -1 is failure, everything else is success (retval 0 length is success ??? idk this area of API).

Backup option, return by copy a C struct with 2 members, bool and STRLEN. Now caller func frame has ABI proof nothing can ever rewrite STRLEN, and STRLEN can be upgraded to a non-vol register for the rest of this func body.

Also lets us be reasonable, unless STRLEN type is transporting a ptr size integer holding a CSRNG value, we know the sign bit aka 0x8000_0000 2GB or 0x8000_0000_0000_0000 aka 9,223,372,036,854,775,808 9 quintillionB will always be zero in the retval, and not the user's string length. After that assumption, STRLEN can transport a 1 bit bool, and a 31 bit or 63 bit integer, inside 1 CPU register, inside 1 C retval.

PERL_ARGS_ASSERT_SV_VSTRING_GET;

MAGIC *mg = SvVSTRING_mg(sv);
if(!mg) return NULL;

if(lenp) *lenp = mg->mg_len;
return mg->mg_ptr;
}

/*
* ex: set ts=8 sts=4 sw=4 et:
*/
15 changes: 15 additions & 0 deletions sv.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2843,6 +2843,21 @@ Create a new IO, setting the reference count to 1.
# define gv_dup_inc(s,t) MUTABLE_GV(sv_dup_inc((const SV *)s,t))
#endif

/*
=for apidoc Am|const char *|SvVSTRING |SV* sv|STRLEN len

If the given SV has vstring magic, stores the length of it into the variable
C<len>, and returns the string pointer. If not, returns C<NULL>.

This is a wrapper around the C<sv_vstring_get> function that conveniently
takes the address of the C<len> variable, in a form similar to the C<SvPV>
macro family.

=cut
*/

#define SvVSTRING(sv, len) (sv_vstring_get(sv, &(len)))

/*
* ex: set ts=8 sts=4 sw=4 et:
*/
Loading