/* ============================================================================
-=head1 Allocation and deallocation of SVs.
-
+=for apidoc_section SV Handling
An SV (or AV, HV, etc.) is allocated in two parts: the head (struct
sv, av, hv...) contains type and reference count information, and for
many types, a pointer to the body (struct xrv, xpv, xpviv...), which
/*
-=head1 SV Manipulation Functions
+=for apidoc_section SV Handling
=for apidoc sv_add_arena
char *start;
const char *end;
const size_t good_arena_size = Perl_malloc_good_size(arena_size);
-#if defined(DEBUGGING) && defined(PERL_GLOBAL_STRUCT)
- dVAR;
-#endif
-#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT)
+#if defined(DEBUGGING)
static bool done_sanity_check;
- /* PERL_GLOBAL_STRUCT cannot coexist with global
- * variables like done_sanity_check. */
if (!done_sanity_check) {
unsigned int i = SVt_LAST;
return RX_WRAPPED(re);
} else {
- const char *const typestr = sv_reftype(referent, 0);
- const STRLEN typelen = strlen(typestr);
+ const char *const typestring = sv_reftype(referent, 0);
+ const STRLEN typelen = strlen(typestring);
UV addr = PTR2UV(referent);
const char *stashname = NULL;
STRLEN stashnamelen = 0; /* hush, gcc */
*--retval = '(';
retval -= typelen;
- memcpy(retval, typestr, typelen);
+ memcpy(retval, typestring, typelen);
if (stashname) {
*--retval = '=';
=for apidoc Amnh||SV_CATUTF8
=for apidoc Amnh||SV_CATBYTES
-=for apidoc Amnh||SV_SMAGIC
=cut
*/
void
Perl_sv_clear(pTHX_ SV *const orig_sv)
{
- dVAR;
HV *stash;
U32 type;
const struct body_details *sv_type_details;
void
Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
{
- dVAR;
PERL_ARGS_ASSERT_SV_FREE2;
#define newSVpvn_utf8(s, len, u) \
newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
-=for apidoc Amnh||SVf_UTF8
=for apidoc Amnh||SVs_TEMP
=cut
SV *
Perl_sv_2mortal(pTHX_ SV *const sv)
{
- dVAR;
if (!sv)
return sv;
if (SvIMMORTAL(sv))
SV *
Perl_newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash)
{
- dVAR;
SV *sv;
bool is_utf8 = FALSE;
const char *const orig_src = src;
Creates a new SV and initializes it with the string formatted like
C<sv_catpvf>.
+=for apidoc newSVpvf_nocontext
+Like C<L</newSVpvf>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+
+=for apidoc vnewSVpvf
+Like C<L</newSVpvf>> but but the arguments are an encapsulated argument list.
+
=cut
*/
Works like C<sv_catpvf> but copies the text into the SV instead of
appending it. Does not handle 'set' magic. See C<L</sv_setpvf_mg>>.
+=for apidoc sv_setpvf_nocontext
+Like C<L</sv_setpvf>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+
=cut
*/
Like C<sv_setpvf>, but also handles 'set' magic.
+=for apidoc sv_setpvf_mg_nocontext
+Like C<L</sv_setpvf_mg>>, but does not take a thread context (C<aTHX>)
+parameter, so is used in situations where the caller doesn't already have the
+thread context.
+
=cut
*/
C<L</sv_catpvf_mg>>. If the original SV was UTF-8, the pattern should be
valid UTF-8; if the original SV was bytes, the pattern should be too.
+=for apidoc sv_catpvf_nocontext
+Like C<L</sv_catpvf>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+
=cut */
void
Like C<sv_catpvf>, but also handles 'set' magic.
+=for apidoc sv_catpvf_mg_nocontext
+Like C<L</sv_catpvf_mg>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+
=cut
*/
/* =========================================================================
-=head1 Cloning an interpreter
+=for apidoc_section Embedding and Interpreter Cloning
=cut
static SV *
S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
{
- dVAR;
SV *dstr;
PERL_ARGS_ASSERT_SV_DUP_COMMON;
ANY *
Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
{
- dVAR;
ANY * const ss = proto_perl->Isavestack;
const I32 max = proto_perl->Isavestack_max + SS_MAXPUSH;
I32 ix = proto_perl->Isavestack_ix;
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = ptr;
break;
+ case SAVEt_HINTS_HH:
+ hv = (const HV *)POPPTR(ss,ix);
+ TOPPTR(nss,ix) = hv_dup_inc(hv, param);
+ /* FALLTHROUGH */
case SAVEt_HINTS:
ptr = POPPTR(ss,ix);
ptr = cophh_copy((COPHH*)ptr);
TOPPTR(nss,ix) = ptr;
i = POPINT(ss,ix);
TOPINT(nss,ix) = i;
- if (i & HINT_LOCALIZE_HH) {
- hv = (const HV *)POPPTR(ss,ix);
- TOPPTR(nss,ix) = hv_dup_inc(hv, param);
- }
break;
case SAVEt_PADSV_AND_MORTALIZE:
longval = (long)POPLONG(ss,ix);
PerlInterpreter *
perl_clone(PerlInterpreter *proto_perl, UV flags)
{
- dVAR;
#ifdef PERL_IMPLICIT_SYS
PERL_ARGS_ASSERT_PERL_CLONE;
PL_cv_has_eval = proto_perl->Icv_has_eval;
-#ifdef FCRYPT
- PL_cryptseen = proto_perl->Icryptseen;
-#endif
-
#ifdef USE_LOCALE_COLLATE
PL_collation_ix = proto_perl->Icollation_ix;
PL_collation_standard = proto_perl->Icollation_standard;
/* Call the ->CLONE method, if it exists, for each of the stashes
identified by sv_dup() above.
*/
- while(av_tindex(param->stashes) != -1) {
+ while(av_count(param->stashes) != 0) {
HV* const stash = MUTABLE_HV(av_shift(param->stashes));
GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0);
if (cloner && GvCV(cloner)) {
void
Perl_clone_params_del(CLONE_PARAMS *param)
{
- /* This seemingly funky ordering keeps the build with PERL_GLOBAL_STRUCT
- happy: */
+ PerlInterpreter *const was = PERL_GET_THX;
PerlInterpreter *const to = param->new_perl;
dTHXa(to);
- PerlInterpreter *const was = PERL_GET_THX;
PERL_ARGS_ASSERT_CLONE_PARAMS_DEL;
CLONE_PARAMS *
Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
{
- dVAR;
/* Need to play this game, as newAV() can call safesysmalloc(), and that
does a dTHX; to get the context from thread local storage.
FIXME - under PERL_CORE Newx(), Safefree() and friends should expand to
void
Perl_init_constants(pTHX)
{
- dVAR;
SvREFCNT(&PL_sv_undef) = SvREFCNT_IMMORTAL;
SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVf_PROTECT|SVt_NULL;
}
/*
-=head1 Unicode Support
+=for apidoc_section Unicode Support
=for apidoc sv_recode_to_utf8
STATIC SV*
S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
{
- dVAR;
HE **array;
I32 i;
/*
+=apidoc_section Warning and Dieing
=for apidoc find_uninit_var
Find the name of the undefined variable (if any) that caused the operator
S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
bool match, const char **desc_p)
{
- dVAR;
SV *sv;
const GV *gv;
const OP *o, *o2, *kid;
return varname(agg_gv, '@', agg_targ,
NULL, index, FUV_SUBSCRIPT_ARRAY);
}
+ /* look for an element not found */
+ if (!SvMAGICAL(sv)) {
+ SV *index_sv = NULL;
+ if (index_targ) {
+ index_sv = PL_curpad[index_targ];
+ }
+ else if (index_gv) {
+ index_sv = GvSV(index_gv);
+ }
+ if (index_sv && !SvMAGICAL(index_sv) && !SvROK(index_sv)) {
+ if (is_hv) {
+ HE *he = hv_fetch_ent(MUTABLE_HV(sv), index_sv, 0, 0);
+ if (!he) {
+ return varname(agg_gv, '%', agg_targ,
+ index_sv, 0, FUV_SUBSCRIPT_HASH);
+ }
+ }
+ else {
+ SSize_t index = SvIV(index_sv);
+ SV * const * const svp =
+ av_fetch(MUTABLE_AV(sv), index, FALSE);
+ if (!svp) {
+ return varname(agg_gv, '@', agg_targ,
+ NULL, index, FUV_SUBSCRIPT_ARRAY);
+ }
+ }
+ }
+ }
if (match)
break;
return varname(agg_gv,
https://perl5.git.perl.org / perl5.git / blobdiff