develooper Front page | perl.perl5.porters | Postings from August 2003

[PATCH @20458] embedding perl

Thread Next
From:
Radu Greab
Date:
August 5, 2003 15:25
Subject:
[PATCH @20458] embedding perl
Message ID:
20030805.205715.113441323.radu@yx.primIT.ro

This patch tries to document that -Dusemultiplicity is recommended when
embedding perl in C and adds initializations of some interpreter
variables, needed when two or more interpreters are run and
-Dusemultiplicity was not used.


Thanks,
Radu Greab


--- perl.orig/hv.c	Sun Jul 27 20:04:09 2003
+++ perl/hv.c	Sat Aug  2 18:00:48 2003
@@ -104,6 +104,7 @@
 	he = HeNEXT(he);
 	del_HE(ohe);
     }
+    PL_hv_fetch_ent_mh = Nullhe;
 }

 #if defined(USE_ITHREADS)
--- perl.orig/intrpvar.h	Mon Jul 28 16:27:55 2003
+++ perl/intrpvar.h	Mon Aug  4 00:23:50 2003
@@ -169,7 +169,7 @@
 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(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 @@

 #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(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(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 @@

 #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 */
--- perl.orig/perl.c	Wed Jul 30 14:25:31 2003
+++ perl/perl.c	Sun Aug  3 23:45:44 2003
@@ -375,6 +375,7 @@
 	 * Non-referenced objects are on their own.
 	 */
 	sv_clean_objs();
+	PL_sv_objcount = 0;
     }

     /* unhook hooks which will soon be, or use, destroyed data */
@@ -498,6 +499,8 @@
 	PL_e_script = Nullsv;
     }

+    PL_perldb = 0;
+
     /* magical thingies */

     SvREFCNT_dec(PL_ofs_sv);	/* $, */
@@ -557,6 +560,15 @@
     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 */
@@ -591,6 +603,7 @@
     Safefree(PL_numeric_name);
     PL_numeric_name = Nullch;
     SvREFCNT_dec(PL_numeric_radix_sv);
+    PL_numeric_radix_sv = Nullsv;
 #endif

     /* clear utf8 character classes */
@@ -729,6 +742,7 @@
 #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 */
@@ -772,6 +786,7 @@
 	}
     }
 #endif
+    PL_sv_count = 0;


 #if defined(PERLIO_LAYERS)
@@ -790,18 +805,31 @@
     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());

@@ -3494,7 +3522,7 @@
     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;
 }
--- perl.orig/sv.c	Tue Jul 29 19:02:46 2003
+++ perl/sv.c	Sat Aug  2 17:29:14 2003
@@ -499,78 +499,91 @@
 	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);
--- perl.orig/pod/perlembed.pod	Sat Apr  5 23:23:08 2003
+++ perl/pod/perlembed.pod	Tue Aug  5 20:42:45 2003
@@ -381,7 +381,7 @@

 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 @@
 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 @@

 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 @@
  }

 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

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About