From: Radu Greab Date: Tue, 5 Aug 2003 20:57:15 +0000 (+0300) Subject: embedding perl X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf9cdc68d248e456c55258025f0d0724ca63226d;p=p5sagit%2Fp5-mst-13.2.git embedding perl Message-Id: <20030805.205715.113441323.radu@yx.primIT.ro> p4raw-id: //depot/perl@21514 --- diff --git a/hv.c b/hv.c index b786b32..7a1d25b 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 09709ea..7017a70 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 4a40aa8..f171845 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 bfa9254..05feccd 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 and an C<=~> operation (e.g., C or C), substitute() modifies the string -within the C at according to the operation, returning the number of substitutions +within the C 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 to get the new behaviour. This also enables the running of END blocks if -the perl_prase fails and C will return the exit value. +the perl_parse fails and C will return the exit value. =head2 Maintaining multiple interpreter instances @@ -858,14 +858,14 @@ in its entire lifetime. Setting C 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 to C<1> makes everything squeaky clean: } When I 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 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 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 41ddbba..9c977a5 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 in the current pad diff --git a/sv.c b/sv.c index f5eab2f..a57ed71 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);