summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRadu Greab <radu@netsoft.ro>2003-08-05 23:57:15 +0300
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2003-10-21 21:21:56 +0000
commitbf9cdc68d248e456c55258025f0d0724ca63226d (patch)
treedf180b40a00a02d3bc0a3ff6eb6e68872cdf6676
parent69fc43e8cc1ab20ea33528914d94e54ac04360ed (diff)
downloadperl-bf9cdc68d248e456c55258025f0d0724ca63226d.tar.gz
embedding perl
Message-Id: <20030805.205715.113441323.radu@yx.primIT.ro> p4raw-id: //depot/perl@21514
-rw-r--r--hv.c1
-rw-r--r--intrpvar.h22
-rw-r--r--perl.c30
-rw-r--r--pod/perlembed.pod22
-rw-r--r--pod/perlintern.pod9
-rw-r--r--sv.c13
6 files changed, 78 insertions, 19 deletions
diff --git a/hv.c b/hv.c
index b786b32f98..7a1d25bf9a 100644
--- a/hv.c
+++ b/hv.c
@@ -104,6 +104,7 @@ Perl_free_tied_hv_pool(pTHX)
he = HeNEXT(he);
del_HE(ohe);
}
+ PL_hv_fetch_ent_mh = Nullhe;
}
#if defined(USE_ITHREADS)
diff --git a/intrpvar.h b/intrpvar.h
index 09709ea123..7017a70f33 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -169,7 +169,7 @@ PERLVAR(Ilastfd, int) /* what to preserve mode on */
PERLVAR(Ioldname, char *) /* what to preserve mode on */
PERLVAR(IArgv, char **) /* stuff to free from do_aexec, vfork safe */
PERLVAR(ICmd, char *) /* stuff to free from do_aexec, vfork safe */
-PERLVAR(Igensym, I32) /* next symbol for getsym() to define */
+PERLVARI(Igensym, I32, 0) /* next symbol for getsym() to define */
PERLVAR(Ipreambled, bool)
PERLVAR(Ipreambleav, AV *)
PERLVARI(Ilaststatval, int, -1)
@@ -233,10 +233,10 @@ PERLVAR(Ieuid, Uid_t) /* current effective user id */
PERLVAR(Igid, Gid_t) /* current real group id */
PERLVAR(Iegid, Gid_t) /* current effective group id */
PERLVAR(Inomemok, bool) /* let malloc context handle nomem */
-PERLVAR(Ian, U32) /* malloc sequence number */
-PERLVAR(Icop_seqmax, U32) /* statement sequence number */
-PERLVAR(Iop_seqmax, U16) /* op sequence number */
-PERLVAR(Ievalseq, U32) /* eval sequence number */
+PERLVARI(Ian, U32, 0) /* malloc sequence number */
+PERLVARI(Icop_seqmax, U32, 0) /* statement sequence number */
+PERLVARI(Iop_seqmax, U16, 0) /* op sequence number */
+PERLVARI(Ievalseq, U32, 0) /* eval sequence number */
PERLVAR(Iorigenviron, char **)
PERLVAR(Iorigalen, U32)
PERLVAR(Ipidstatus, HV *) /* pid-to-status mappings for waitpid */
@@ -290,7 +290,7 @@ PERLVAR(Isv_yes, SV)
#ifdef CSH
PERLVARI(Icshname, char *, CSH)
-PERLVAR(Icshlen, I32)
+PERLVARI(Icshlen, I32, 0)
#endif
PERLVAR(Ilex_state, U32) /* next token is determined */
@@ -342,17 +342,17 @@ PERLVAR(Ilast_lop_op, OPCODE) /* last list operator */
PERLVAR(Iin_my, I32) /* we're compiling a "my" (or "our") declaration */
PERLVAR(Iin_my_stash, HV *) /* declared class of this "my" declaration */
#ifdef FCRYPT
-PERLVAR(Icryptseen, bool) /* has fast crypt() been initialized? */
+PERLVARI(Icryptseen, bool, FALSE) /* has fast crypt() been initialized? */
#endif
PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */
PERLVAR(Idebug, VOL U32) /* flags given to -D switch */
-PERLVAR(Iamagic_generation, long)
+PERLVARI(Iamagic_generation, long, 0)
#ifdef USE_LOCALE_COLLATE
-PERLVAR(Icollation_ix, U32) /* Collation generation index */
+PERLVARI(Icollation_ix, U32, 0) /* Collation generation index */
PERLVAR(Icollation_name,char *) /* Name of current collation */
PERLVARI(Icollation_standard, bool, TRUE)
/* Assume simple collation */
@@ -405,7 +405,7 @@ PERLVAR(Iyychar, int)
PERLVAR(Iyyval, YYSTYPE)
PERLVAR(Iyylval, YYSTYPE)
-PERLVAR(Iglob_index, int)
+PERLVARI(Iglob_index, int, 0)
PERLVAR(Isrand_called, bool)
PERLVARA(Iuudmap,256, char)
PERLVAR(Ibitcount, char *)
@@ -464,7 +464,7 @@ PERLVAR(Ireentrant_buffer, REENTR*) /* here we store the _r buffers */
#endif
-PERLVAR(Isavebegin, bool) /* save BEGINs for compiler */
+PERLVARI(Isavebegin, bool, FALSE) /* save BEGINs for compiler */
PERLVAR(Icustom_op_names, HV*) /* Names of user defined ops */
PERLVAR(Icustom_op_descs, HV*) /* Descriptions of user defined ops */
diff --git a/perl.c b/perl.c
index 4a40aa8417..f1718456c7 100644
--- a/perl.c
+++ b/perl.c
@@ -381,6 +381,7 @@ perl_destruct(pTHXx)
* Non-referenced objects are on their own.
*/
sv_clean_objs();
+ PL_sv_objcount = 0;
}
/* unhook hooks which will soon be, or use, destroyed data */
@@ -506,6 +507,8 @@ perl_destruct(pTHXx)
PL_e_script = Nullsv;
}
+ PL_perldb = 0;
+
/* magical thingies */
SvREFCNT_dec(PL_ofs_sv); /* $, */
@@ -565,6 +568,15 @@ perl_destruct(pTHXx)
PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
+ PL_DBgv = Nullgv;
+ PL_DBline = Nullgv;
+ PL_DBsub = Nullgv;
+ PL_DBsingle = Nullsv;
+ PL_DBtrace = Nullsv;
+ PL_DBsignal = Nullsv;
+ PL_DBassertion = Nullsv;
+ PL_DBcv = Nullcv;
+ PL_dbargs = Nullav;
PL_debstash = Nullhv;
/* reset so print() ends up where we expect */
@@ -599,6 +611,7 @@ perl_destruct(pTHXx)
Safefree(PL_numeric_name);
PL_numeric_name = Nullch;
SvREFCNT_dec(PL_numeric_radix_sv);
+ PL_numeric_radix_sv = Nullsv;
#endif
/* clear utf8 character classes */
@@ -737,6 +750,7 @@ perl_destruct(pTHXx)
#ifdef USE_ITHREADS
/* free the pointer table used for cloning */
ptr_table_free(PL_ptr_table);
+ PL_ptr_table = (PTR_TBL_t*)NULL;
#endif
/* free special SVs */
@@ -780,6 +794,7 @@ perl_destruct(pTHXx)
}
}
#endif
+ PL_sv_count = 0;
#if defined(PERLIO_LAYERS)
@@ -798,18 +813,31 @@ perl_destruct(pTHXx)
SvREADONLY_off(&PL_sv_placeholder);
Safefree(PL_origfilename);
+ PL_origfilename = Nullch;
Safefree(PL_reg_start_tmp);
+ PL_reg_start_tmp = (char**)NULL;
+ PL_reg_start_tmpl = 0;
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
Safefree(PL_reg_poscache);
free_tied_hv_pool();
Safefree(PL_op_mask);
Safefree(PL_psig_ptr);
+ PL_psig_ptr = (SV**)NULL;
Safefree(PL_psig_name);
+ PL_psig_name = (SV**)NULL;
Safefree(PL_bitcount);
+ PL_bitcount = Nullch;
Safefree(PL_psig_pend);
+ PL_psig_pend = (int*)NULL;
+ PL_formfeed = Nullsv;
+ Safefree(PL_ofmt);
+ PL_ofmt = Nullch;
nuke_stacks();
+ PL_tainting = FALSE;
+ PL_taint_warn = FALSE;
PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
+ PL_debug = 0;
DEBUG_P(debprofdump());
@@ -3516,7 +3544,7 @@ Perl_init_debugger(pTHX)
sv_setiv(PL_DBtrace, 0);
PL_DBsignal = GvSV((gv_fetchpv("DB::signal", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsignal, 0);
- PL_DBassertion = GvSV((gv_fetchpv("assertion", GV_ADDMULTI, SVt_PV)));
+ PL_DBassertion = GvSV((gv_fetchpv("DB::assertion", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBassertion, 0);
PL_curstash = ostash;
}
diff --git a/pod/perlembed.pod b/pod/perlembed.pod
index bfa925474a..05feccd1bc 100644
--- a/pod/perlembed.pod
+++ b/pod/perlembed.pod
@@ -381,7 +381,7 @@ returns 1 if the string matches the pattern and 0 otherwise.
Given a pointer to an C<SV> and an C<=~> operation (e.g.,
C<s/bob/robert/g> or C<tr[A-Z][a-z]>), substitute() modifies the string
-within the C<AV> at according to the operation, returning the number of substitutions
+within the C<SV> as according to the operation, returning the number of substitutions
made.
int matches(SV *string, char *pattern, AV **matches);
@@ -841,7 +841,7 @@ Traditionally END blocks have been executed at the end of the perl_run.
This causes problems for applications that never call perl_run. Since
perl 5.7.2 you can specify C<PL_exit_flags |= PERL_EXIT_DESTRUCT_END>
to get the new behaviour. This also enables the running of END blocks if
-the perl_prase fails and C<perl_destruct> will return the exit value.
+the perl_parse fails and C<perl_destruct> will return the exit value.
=head2 Maintaining multiple interpreter instances
@@ -858,14 +858,14 @@ in its entire lifetime.
Setting C<PL_perl_destruct_level> to C<1> makes everything squeaky clean:
- PL_perl_destruct_level = 1;
-
while(1) {
...
/* reset global variables here with PL_perl_destruct_level = 1 */
+ PL_perl_destruct_level = 1;
perl_construct(my_perl);
...
/* clean and reset _everything_ during perl_destruct */
+ PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
...
@@ -873,14 +873,22 @@ Setting C<PL_perl_destruct_level> to C<1> makes everything squeaky clean:
}
When I<perl_destruct()> is called, the interpreter's syntax parse tree
-and symbol tables are cleaned up, and global variables are reset.
+and symbol tables are cleaned up, and global variables are reset. The
+second assignment to C<PL_perl_destruct_level> is needed because
+perl_construct resets it to C<0>.
Now suppose we have more than one interpreter instance running at the
same time. This is feasible, but only if you used the Configure option
C<-Dusemultiplicity> or the options C<-Dusethreads -Duseithreads> when
-building Perl. By default, enabling one of these Configure options
+building perl. By default, enabling one of these Configure options
sets the per-interpreter global variable C<PL_perl_destruct_level> to
-C<1>, so that thorough cleaning is automatic.
+C<1>, so that thorough cleaning is automatic and interpreter variables
+are initialized correctly. Even if you don't intend to run two or
+more interpreters at the same time, but to run them sequentially, like
+in the above example, it is recommended to build perl with the
+C<-Dusemultiplicity> option otherwise some interpreter variables may
+not be initialized correctly between consecutive runs and your
+application may crash.
Using C<-Dusethreads -Duseithreads> rather than C<-Dusemultiplicity>
is more appropriate if you intend to run multiple interpreters
diff --git a/pod/perlintern.pod b/pod/perlintern.pod
index 41ddbbad37..9c977a506f 100644
--- a/pod/perlintern.pod
+++ b/pod/perlintern.pod
@@ -221,6 +221,15 @@ the previous current pad.
=for hackers
Found in file pad.h
+=item PAD_SET_CUR_NOSAVE
+
+like PAD_SET_CUR, but without the save
+
+ void PAD_SET_CUR_NOSAVE (PADLIST padlist, I32 n)
+
+=for hackers
+Found in file pad.h
+
=item PAD_SV
Get the value at offset C<po> in the current pad
diff --git a/sv.c b/sv.c
index f5eab2f52b..a57ed7190c 100644
--- a/sv.c
+++ b/sv.c
@@ -499,78 +499,91 @@ Perl_sv_free_arenas(pTHX)
Safefree(arena);
}
PL_xiv_arenaroot = 0;
+ PL_xiv_root = 0;
for (arena = PL_xnv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xnv_arenaroot = 0;
+ PL_xnv_root = 0;
for (arena = PL_xrv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xrv_arenaroot = 0;
+ PL_xrv_root = 0;
for (arena = PL_xpv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpv_arenaroot = 0;
+ PL_xpv_root = 0;
for (arena = (XPV*)PL_xpviv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpviv_arenaroot = 0;
+ PL_xpviv_root = 0;
for (arena = (XPV*)PL_xpvnv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvnv_arenaroot = 0;
+ PL_xpvnv_root = 0;
for (arena = (XPV*)PL_xpvcv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvcv_arenaroot = 0;
+ PL_xpvcv_root = 0;
for (arena = (XPV*)PL_xpvav_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvav_arenaroot = 0;
+ PL_xpvav_root = 0;
for (arena = (XPV*)PL_xpvhv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvhv_arenaroot = 0;
+ PL_xpvhv_root = 0;
for (arena = (XPV*)PL_xpvmg_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvmg_arenaroot = 0;
+ PL_xpvmg_root = 0;
for (arena = (XPV*)PL_xpvlv_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvlv_arenaroot = 0;
+ PL_xpvlv_root = 0;
for (arena = (XPV*)PL_xpvbm_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_xpvbm_arenaroot = 0;
+ PL_xpvbm_root = 0;
for (arena = (XPV*)PL_he_arenaroot; arena; arena = arenanext) {
arenanext = (XPV*)arena->xpv_pv;
Safefree(arena);
}
PL_he_arenaroot = 0;
+ PL_he_root = 0;
if (PL_nice_chunk)
Safefree(PL_nice_chunk);