embedding perl
Radu Greab [Tue, 5 Aug 2003 20:57:15 +0000 (23:57 +0300)]
Message-Id: <20030805.205715.113441323.radu@yx.primIT.ro>

p4raw-id: //depot/perl@21514

hv.c
intrpvar.h
perl.c
pod/perlembed.pod
pod/perlintern.pod
sv.c

diff --git a/hv.c b/hv.c
index b786b32..7a1d25b 100644 (file)
--- 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)
index 09709ea..7017a70 100644 (file)
@@ -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 4a40aa8..f171845 100644 (file)
--- 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;
 }
index bfa9254..05feccd 100644 (file)
@@ -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
index 41ddbba..9c977a5 100644 (file)
@@ -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 f5eab2f..a57ed71 100644 (file)
--- 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);