embedding perl

Message-Id: <20030805.205715.113441323.radu@yx.primIT.ro>

p4raw-id: //depot/perl@21514

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);