Public API:
- sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas()
+ sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas()
=cut
=for apidoc sv_2bool
This function is only called on magical items, and is only used by
-sv_true() or its macro equivalent.
+sv_true() or its macro equivalent.
=cut
*/
if (!ssv)
return;
if ((spv = SvPV(ssv, slen))) {
- bool sutf8 = DO_UTF8(ssv);
- bool dutf8;
+ /* sutf8 and dutf8 were type bool, but under USE_ITHREADS,
+ gcc version 2.95.2 20000220 (Debian GNU/Linux) for
+ Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
+ get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though
+ dsv->sv_flags doesn't have that bit set.
+ Andy Dougherty 12 Oct 2001
+ */
+ I32 sutf8 = DO_UTF8(ssv);
+ I32 dutf8;
if (SvGMAGICAL(dsv) && (flags & SV_GMAGIC))
mg_get(dsv);
register STDCHAR *bp;
register I32 cnt;
I32 i = 0;
+ I32 rspara = 0;
SV_CHECK_THINKFIRST(sv);
(void)SvUPGRADE(sv, SVt_PV);
SvSCREAM_off(sv);
- if (RsSNARF(PL_rs)) {
+ if (PL_curcop == &PL_compiling) {
+ /* we always read code in line mode */
+ rsptr = "\n";
+ rslen = 1;
+ }
+ else if (RsSNARF(PL_rs)) {
rsptr = NULL;
rslen = 0;
}
else if (RsPARA(PL_rs)) {
rsptr = "\n\n";
rslen = 2;
+ rspara = 1;
}
else {
/* Get $/ i.e. PL_rs into same encoding as stream wants */
rslast = rslen ? rsptr[rslen - 1] : '\0';
- if (RsPARA(PL_rs)) { /* have to do this both before and after */
+ if (rspara) { /* have to do this both before and after */
do { /* to make sure file boundaries work right */
if (PerlIO_eof(fp))
return 0;
}
}
- if (RsPARA(PL_rs)) { /* have to do this both before and after */
+ if (rspara) { /* have to do this both before and after */
while (i != EOF) { /* to make sure file boundaries work right */
i = PerlIO_getc(fp);
if (i != '\n') {
return sv_2pv(sv, lp);
}
+/* For -DCRIPPLED_CC only. See also C<sv_2pv_flags()>.
+ */
+
+char *
+Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
+{
+ if (SvPOK(sv)) {
+ *lp = SvCUR(sv);
+ return SvPVX(sv);
+ }
+ return sv_2pv_flags(sv, lp, 0);
+}
+
/*
=for apidoc sv_pvn_force
char c;
int i;
unsigned base = 0;
- IV iv;
- UV uv;
+ IV iv = 0;
+ UV uv = 0;
NV nv;
STRLEN have;
STRLEN need;
if (!veclen)
continue;
if (vec_utf)
- iv = (IV)utf8n_to_uvchr(vecstr, veclen, &ulen, 0);
+ uv = utf8n_to_uvchr(vecstr, veclen, &ulen, UTF8_ALLOW_ANYUV);
else {
- iv = *vecstr;
+ uv = *vecstr;
ulen = 1;
}
vecstr += ulen;
veclen -= ulen;
+ if (plus)
+ esignbuf[esignlen++] = plus;
}
else if (args) {
switch (intsize) {
#endif
}
}
- if (iv >= 0) {
- uv = iv;
- if (plus)
- esignbuf[esignlen++] = plus;
- }
- else {
- uv = -iv;
- esignbuf[esignlen++] = '-';
+ if ( !vectorize ) /* we already set uv above */
+ {
+ if (iv >= 0) {
+ uv = iv;
+ if (plus)
+ esignbuf[esignlen++] = plus;
+ }
+ else {
+ uv = -iv;
+ esignbuf[esignlen++] = '-';
+ }
}
base = 10;
goto integer;
if (!veclen)
continue;
if (vec_utf)
- uv = utf8n_to_uvchr(vecstr, veclen, &ulen, 0);
+ uv = utf8n_to_uvchr(vecstr, veclen, &ulen, UTF8_ALLOW_ANYUV);
else {
uv = *vecstr;
ulen = 1;
#define gv_dup_inc(s,t) (GV*)SvREFCNT_inc(sv_dup((SV*)s,t))
#define SAVEPV(p) (p ? savepv(p) : Nullch)
#define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch)
-
+
/* Duplicate a regexp. Required reading: pregcomp() and pregfree() in
regcomp.c. AMS 20010712 */
REGEXP *
-Perl_re_dup(pTHX_ REGEXP *r, clone_params *param)
+Perl_re_dup(pTHX_ REGEXP *r, CLONE_PARAMS *param)
{
REGEXP *ret;
int i, len, npar;
/* duplicate a file handle */
PerlIO *
-Perl_fp_dup(pTHX_ PerlIO *fp, char type)
+Perl_fp_dup(pTHX_ PerlIO *fp, char type, CLONE_PARAMS *param)
{
PerlIO *ret;
if (!fp)
return ret;
/* create anew and remember what it is */
- ret = PerlIO_fdupopen(aTHX_ fp);
+ ret = PerlIO_fdupopen(aTHX_ fp, param);
ptr_table_store(PL_ptr_table, fp, ret);
return ret;
}
/* duplicate a typeglob */
GP *
-Perl_gp_dup(pTHX_ GP *gp, clone_params* param)
+Perl_gp_dup(pTHX_ GP *gp, CLONE_PARAMS* param)
{
GP *ret;
if (!gp)
/* duplicate a chain of magic */
MAGIC *
-Perl_mg_dup(pTHX_ MAGIC *mg, clone_params* param)
+Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS* param)
{
MAGIC *mgprev = (MAGIC*)NULL;
MAGIC *mgret;
/* duplicate an SV of any type (including AV, HV etc) */
SV *
-Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
+Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param)
{
SV *dstr;
SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1);
else
SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */
- IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr));
+ IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr), param);
if (IoOFP(sstr) == IoIFP(sstr))
IoOFP(dstr) = IoIFP(dstr);
else
- IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr));
+ IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr), param);
/* PL_rsfp_filters entries have fake IoDIRP() */
if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP))
IoDIRP(dstr) = dirp_dup(IoDIRP(sstr));
/* duplicate a context */
PERL_CONTEXT *
-Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, clone_params* param)
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max, CLONE_PARAMS* param)
{
PERL_CONTEXT *ncxs;
/* duplicate a stack info structure */
PERL_SI *
-Perl_si_dup(pTHX_ PERL_SI *si, clone_params* param)
+Perl_si_dup(pTHX_ PERL_SI *si, CLONE_PARAMS* param)
{
PERL_SI *nsi;
/* duplicate the save stack */
ANY *
-Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, clone_params* param)
+Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
{
ANY *ss = proto_perl->Tsavestack;
I32 ix = proto_perl->Tsavestack_ix;
TOPPTR(nss,ix) = gp = gp_dup(gp, param);
(void)GpREFCNT_inc(gp);
gv = (GV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = gv_dup_inc(c, param);
+ TOPPTR(nss,ix) = gv_dup_inc(gv, param);
c = (char*)POPPTR(ss,ix);
TOPPTR(nss,ix) = pv_dup(c);
iv = POPIV(ss,ix);
* their pointers copied. */
IV i;
- clone_params* param = (clone_params*) malloc(sizeof(clone_params));
+ CLONE_PARAMS* param = (CLONE_PARAMS*) malloc(sizeof(CLONE_PARAMS));
PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
PERL_SET_THX(my_perl);
PL_Proc = ipP;
#else /* !PERL_IMPLICIT_SYS */
IV i;
- clone_params* param = (clone_params*) malloc(sizeof(clone_params));
+ CLONE_PARAMS* param = (CLONE_PARAMS*) malloc(sizeof(CLONE_PARAMS));
PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
PERL_SET_THX(my_perl);
PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
}
-
param->stashes = newAV(); /* Setup array of objects to call clone on */
+#ifdef PERLIO_LAYERS
+ /* Clone PerlIO tables as soon as we can handle general xx_dup() */
+ PerlIO_clone(aTHX_ proto_perl, param);
+#endif
PL_envgv = gv_dup(proto_perl->Ienvgv, param);
PL_incgv = gv_dup(proto_perl->Iincgv, param);
{
I32 len = av_len((AV*)proto_perl->Iregex_padav);
SV** regexen = AvARRAY((AV*)proto_perl->Iregex_padav);
- for(i = 0; i <= len; i++) {
- av_push(PL_regex_padav,
- SvREFCNT_inc(
- newSViv((IV)re_dup((REGEXP *)
- SvIVX(regexen[i]), param))
- ));
+ av_push(PL_regex_padav,
+ sv_dup_inc(regexen[0],param));
+ for(i = 1; i <= len; i++) {
+ if(SvREPADTMP(regexen[i])) {
+ av_push(PL_regex_padav, sv_dup_inc(regexen[i], param));
+ } else {
+ av_push(PL_regex_padav,
+ SvREFCNT_inc(
+ newSViv(PTR2IV(re_dup(INT2PTR(REGEXP *,
+ SvIVX(regexen[i])), param)))
+ ));
+ }
}
}
PL_regex_pad = AvARRAY(PL_regex_padav);
PL_curstname = sv_dup_inc(proto_perl->Icurstname, param);
PL_beginav = av_dup_inc(proto_perl->Ibeginav, param);
+ PL_beginav_save = av_dup_inc(proto_perl->Ibeginav_save, param);
PL_endav = av_dup_inc(proto_perl->Iendav, param);
PL_checkav = av_dup_inc(proto_perl->Icheckav, param);
PL_initav = av_dup_inc(proto_perl->Iinitav, param);
else
PL_exitlist = (PerlExitListEntry*)NULL;
PL_modglobal = hv_dup_inc(proto_perl->Imodglobal, param);
+ PL_custom_op_names = hv_dup_inc(proto_perl->Icustom_op_names,param);
+ PL_custom_op_descs = hv_dup_inc(proto_perl->Icustom_op_descs,param);
PL_profiledata = NULL;
- PL_rsfp = fp_dup(proto_perl->Irsfp, '<');
+ PL_rsfp = fp_dup(proto_perl->Irsfp, '<', param);
/* PL_rsfp_filters entries have fake IoDIRP() */
PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters, param);
PL_tainted = proto_perl->Ttainted;
PL_curpm = proto_perl->Tcurpm; /* XXX No PMOP ref count */
- PL_nrs = sv_dup_inc(proto_perl->Tnrs, param);
PL_rs = sv_dup_inc(proto_perl->Trs, param);
PL_last_in_gv = gv_dup(proto_perl->Tlast_in_gv, param);
PL_ofs_sv = sv_dup_inc(proto_perl->Tofs_sv, param);
PL_reg_re = (regexp*)NULL;
PL_reg_ganch = Nullch;
PL_reg_sv = Nullsv;
- PL_reg_sv_utf8 = FALSE;
+ PL_reg_match_utf8 = FALSE;
PL_reg_magic = (MAGIC*)NULL;
PL_reg_oldpos = 0;
PL_reg_oldcurpm = (PMOP*)NULL;
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
}
-
+
/* Call the ->CLONE method, if it exists, for each of the stashes
identified by sv_dup() above.
*/
}
#endif /* USE_ITHREADS */
+
https://perl5.git.perl.org / perl5.git / blobdiff