From: Doug MacEachern Date: Fri, 3 Jan 1997 20:42:04 +0000 (-0500) Subject: 5.003_18: perl_{con,des}truct fixes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=316c7b3d7b47e3143f94c7f8621e854c519d1e87;p=p5sagit%2Fp5-mst-13.2.git 5.003_18: perl_{con,des}truct fixes Here's my current patch to clean/reset global variables. I trust more work needs to be done in this area, there are comments that might help if something pops up down the line. I did not test MULTIPLICITY extensively, but a simple test case seems to work, I've added that to perlembed.pod. A *huge* _thank you_ to Chip for your help in this area, 5.004 will make many once frusterated embedders very happy! p5p-msgid: <199701032042.PAA06766@postman.osf.org> --- diff --git a/perl.c b/perl.c index 9b3a506..47903be 100644 --- a/perl.c +++ b/perl.c @@ -34,6 +34,45 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n"; #endif #endif +#ifdef USE_LOCALE_COLLATE +#define I_REINIT_LOCALE_C \ + collation_standard = TRUE; \ + collxfrm_mult = 2 +#else +#define I_REINIT_LOCALE_C +#endif + +#ifdef USE_LOCALE_NUMERIC +#define I_REINIT_LOCALE_N \ + numeric_standard = TRUE; \ + numeric_local = TRUE +#else +#define I_REINIT_LOCALE_N +#endif + +#define I_REINIT \ + chopset = " \n-"; \ + copline = NOLINE; \ + curcop = &compiling; \ + curcopdb = NULL; \ + cxstack_ix = -1; \ + cxstack_max = 128; \ + dbargs = 0; \ + dlmax = 128; \ + laststatval = -1; \ + laststype = OP_STAT; \ + maxscream = -1; \ + maxsysfd = MAXSYSFD; \ + statname = Nullsv; \ + tmps_floor = -1; \ + tmps_ix = -1; \ + op_mask = NULL; \ + dlmax = 128; \ + laststatval = -1; \ + laststype = OP_STAT; \ + I_REINIT_LOCALE_C; \ + I_REINIT_LOCALE_N + static void find_beginning _((void)); static void forbid_setid _((char *)); static void incpush _((char *)); @@ -105,19 +144,12 @@ register PerlInterpreter *sv_interp; } #ifdef MULTIPLICITY - chopset = " \n-"; - copline = NOLINE; - curcop = &compiling; - dbargs = 0; - dlmax = 128; - laststatval = -1; - laststype = OP_STAT; - maxscream = -1; - maxsysfd = MAXSYSFD; - rsfp = Nullfp; - statname = Nullsv; - tmps_floor = -1; - perl_destruct_level = 1; +I_REINIT; +perl_destruct_level = 1; +#else + if(perl_destruct_level > 0) { + I_REINIT; + } #endif init_ids(); @@ -208,21 +240,178 @@ register PerlInterpreter *sv_interp; setdefout(Nullgv); - sv_free(nrs); - nrs = Nullsv; + /* script file pointer */ + if(rsfp) { + (void)PerlIO_close(rsfp); + rsfp = Nullfp; + } - sv_free(lastscream); - lastscream = Nullsv; + /* Package::DATA, etc */ + /* sv_clean_all() will remove these from the registry + if(rsfp_filters) { + sv_free((SV*)rsfp_filters); + rsfp_filters = Nullav; + } + */ + + /* pseudo environmental stuff */ + /* sv_clean_all() takes care of %ENV, %SIG + envgv = Nullgv; + siggv = Nullgv; + sv_free((SV*)incgv); + incgv = Nullgv; + */ + + /* switches */ + preprocess = FALSE; + minus_n = FALSE; + minus_p = FALSE; + minus_l = FALSE; + minus_a = FALSE; + minus_F = FALSE; + doswitches = FALSE; + dowarn = FALSE; + doextract = FALSE; + sawampersand = FALSE; /* must save all match strings */ + sawstudy = FALSE; /* do fbm_instr on all strings */ + sawvec = FALSE; + unsafe = FALSE; + if(inplace) { + Safefree(inplace); + inplace = Nullch; + } + if(e_tmpname) { + Safefree(e_tmpname); + e_tmpname = Nullch; + } + if (e_fp) { + PerlIO_close(e_fp); + e_fp = Nullfp; + } + + /* magical thingies */ + if (ofs) { /* $, */ + Safefree(ofs); + ofs = Nullch; + } + if (ors) { /* $\ */ + Safefree(ors); + ors = Nullch; + } + multiline = 0; /* $* */ sv_free(statname); statname = Nullsv; - statgv = Nullgv; - laststatval = -1; + /*statgv = Nullgv;*/ + + /* shortcuts to various I/O objects */ - sv_free((SV*)beginav); - beginav = Nullav; - sv_free((SV*)endav); - endav = Nullav; + sv_free((SV*)stdingv); + stdingv = Nullgv; + /* + if(last_in_gv) { + sv_free((SV*)last_in_gv); + last_in_gv = Nullgv; + } + */ + /* defgv, aka *_ should be taken care of elsewhere */ + + /* @ARGV */ + if(SvREFCNT(argvgv)) { + sv_free((SV*)argvgv); + argvgv = Nullgv; + } + /* reset so print() ends up where we expect */ + sv_free((SV*)defoutgv); + defoutgv = Nullgv; + + /* be sure to get rid of -i inplace fds */ + if(argvoutgv) { + sv_free((SV*)argvoutgv); + argvoutgv = Nullgv; + } + +#if 0 /* just about all regexp stuff, seems to be ok */ + /* shortcuts to regexp stuff */ + if(leftgv) { + sv_free((SV*)leftgv); + leftgv = Nullgv; + } + if(ampergv) { + sv_free((SV*)ampergv); + ampergv = Nullgv; + } + SAVEFREEOP(curpm); + SAVEFREEOP(oldlastpm); /* for saving regexp context during debugger */ + + regprecomp = NULL; /* uncompiled string. */ + regparse = NULL; /* Input-scan pointer. */ + regxend = NULL; /* End of input for compile */ + regnpar = 0; /* () count. */ + regcode = NULL; /* Code-emit pointer; ®dummy = don't. */ + regsize = 0; /* Code size. */ + regnaughty = 0; /* How bad is this pattern? */ + regsawback = 0; /* Did we see \1, ...? */ + + reginput = NULL; /* String-input pointer. */ + regbol = NULL; /* Beginning of input, for ^ check. */ + regeol = NULL; /* End of input, for $ check. */ + regstartp = (char **)NULL; /* Pointer to startp array. */ + regendp = (char **)NULL; /* Ditto for endp. */ + reglastparen = 0; /* Similarly for lastparen. */ + regtill = NULL; /* How far we are required to go. */ + regflags = 0; /* are we folding, multilining? */ + regprev = (char)NULL; /* char before regbol, \n if none */ +#endif /* if 0 */ + + /* clean up after study() */ + if(lastscream) { + sv_free(lastscream); + lastscream = Nullsv; + } + if(screamfirst) { + Safefree(screamfirst); + screamfirst = 0; + } + if(screamnext) { + Safefree(screamnext); + screamnext = 0; + } + + /* shortcuts to misc objects */ + sv_free((SV*)errgv); + errgv = Nullgv; + + sv_free(nrs); + nrs = Nullsv; + + /* symbol tables */ + if(beginav) { + sv_free((SV*)beginav); /* names of BEGIN subroutines */ + beginav = Nullav; + } + if(endav) { + sv_free((SV*)endav); /* names of END subroutines */ + endav = Nullav; + } + + /* subprocess state */ + /* keep fd-to-pid mappings for my_popen */ + /* don't, CORE::stat() will core dump + sv_free((SV*)fdpid); + fdpid = Nullav; + */ + /* keep pid-to-status mappings for waitpid */ + sv_free((SV*)pidstatus); + pidstatus = Nullhv; + + /* statics for shared library purposes */ + + /* temp stack during pp_sort() */ + if(sortstack) { + sv_free((SV*)sortstack); + sortstack = Nullav; + } /* Prepare to destruct main symbol table. */ diff --git a/perl.h b/perl.h index f048d73..d816785 100644 --- a/perl.h +++ b/perl.h @@ -1663,7 +1663,7 @@ IEXT char * Ie_tmpname; IEXT PerlIO * Ie_fp; IEXT U32 Iperldb; /* This value may be raised by extensions for testing purposes */ -IEXT int Iperl_destruct_level IINIT(1); /* 0=none, 1=full, 2=full with checks */ +IEXT int Iperl_destruct_level IINIT(0); /* 0=none, 1=full, 2=full with checks */ /* magical thingies */ IEXT Time_t Ibasetime; /* $^T */ diff --git a/pod/perlembed.pod b/pod/perlembed.pod index 30c6e0a..04d088b 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -51,6 +51,8 @@ L L +L + L This documentation is UNIX specific. @@ -126,7 +128,6 @@ In a sense, perl (the C program) is a good example of embedding Perl from the source distribution. Here's a bastardized, non-portable version of I containing the essentials of embedding: - #include #include /* from the Perl distribution */ #include /* from the Perl distribution */ @@ -173,12 +174,12 @@ calling I. =head2 Calling a Perl subroutine from your C program -To call individual Perl subroutines, you'll need to remove the call to -I and replace it with a call to I. +To call individual Perl subroutines, you can use any of the B +functions documented in the L man page. +In this example we'll use I. That's shown below, in a program I'll call I. - #include #include #include @@ -186,13 +187,16 @@ That's shown below, in a program I'll call I. int main(int argc, char **argv, char **env) { + char *args[] = { NULL }; my_perl = perl_alloc(); perl_construct(my_perl); perl_parse(my_perl, NULL, argc, argv, NULL); - /*** This replaces perl_run() ***/ - perl_call_argv("showtime", G_DISCARD | G_NOARGS, argv); + /*** skipping perl_run() ***/ + + perl_call_argv("showtime", G_DISCARD | G_NOARGS, args); + perl_destruct(my_perl); perl_free(my_perl); } @@ -220,8 +224,15 @@ yielding the number of seconds that elapsed between January 1, 1970 (the beginning of the UNIX epoch), and the moment I began writing this sentence. -If you want to pass some arguments to the Perl subroutine, or -you want to access the return value, you'll need to manipulate the +Note that in this particular case we are not required to call I, +however, in general it's considered good practice to ensure proper +initialization of library code including execution of all object C +methods and package C blocks. + +If you want to pass some arguments to the Perl subroutine, you may add +strings to the C terminated C list passed to I. +In order to pass arguments of another data type and/or examine return values +of the subroutine you'll need to manipulate the Perl stack, demonstrated in the last section of this document: L @@ -235,7 +246,7 @@ flag to L. Arguably, this is the only routine you'll ever need to execute snippets of Perl code from within your C program. Your string can be as long as you wish; it can contain multiple statements; it can -use L or L to include external Perl +include L, L and L to include external Perl files. Our I lets us evaluate individual Perl strings, and then @@ -243,7 +254,6 @@ extract variables for coercion into C types. The following program, I, executes three Perl strings, extracting an C from the first, a C from the second, and a C from the third. - #include #include #include @@ -263,7 +273,7 @@ the first, a C from the second, and a C from the third. perl_construct( my_perl ); perl_parse(my_perl, NULL, 3, embedding, NULL); - + perl_run(my_perl); /** Treat $a as an integer **/ perl_eval("$a = 3; $a **= 2"); printf("a = %d\n", SvIV(perl_get_sv("a", FALSE))); @@ -320,7 +330,6 @@ returning the number of matches found. Here's a sample program, I, that uses all three (long lines have been wrapped here): - #include #include #include static PerlInterpreter *my_perl; @@ -401,6 +410,8 @@ been wrapped here): my_perl = perl_alloc(); perl_construct( my_perl ); perl_parse(my_perl, NULL, 3, embedding, NULL); + perl_run(my_perl); + text = (char *) malloc(sizeof(char) * 486); /** A long string follows! **/ sprintf(text, "%s", "When he is at a convenience store and the bill \ comes to some amount like 76 cents, Maynard is aware that there is \ @@ -496,7 +507,6 @@ I that contains all the perlguts necessary to push the two arguments into I and to pop the return value out. Take a deep breath... - #include #include #include @@ -532,6 +542,7 @@ deep breath... sprintf(my_argv[1], "power.pl"); perl_parse(my_perl, NULL, argc, my_argv, NULL); + perl_run(my_perl); PerlPower(3, 4); /*** Compute 3 ** 4 ***/ @@ -644,7 +655,7 @@ reduce symbol table growth. my $eval = qq{package $package; sub handler { $sub; }}; { # hide our variables within this block - my($r,$filename,$mtime,$package,$sub); + my($filename,$mtime,$package,$sub); eval $eval; } die $@ if $@; @@ -740,6 +751,104 @@ Now run: foo says: hello Enter file name: ^C +=head2 Maintaining multiple interpreter instances + +The previous examples have gone through several steps to startup, use and +shutdown an embedded Perl interpreter. Certain applications may require +more than one instance of an interpreter to be created during the lifespan +of a single process. Such an application may take different approaches in +it's use of interpreter objects. For example, a particular transaction may +want to create an interpreter instance, then release any resources associated +with the object once the transaction is completed. When a single process +does this once, resources are released upon exit of the program and the next +time it starts, the interpreter's global state is fresh. + +In the same process, the program must take care to ensure that these +actions take place before constructing a new interpreter. By default, the +global variable C is set to C<0> since extra cleaning +is not needed when a program constructs a single interpreter, such as the +perl executable itself in C or some such. + +You can tell Perl to make everything squeeky clean by setting +C to C<1>. + + perl_destruct_level = 1; /* perl global variable */ + while(1) { + ... + /* reset global variables here with perl_destruct_level = 1 */ + perl_contruct(my_perl); + ... + /* clean and reset _everything_ during perl_destruct */ + perl_destruct(my_perl); /* ah, nice and fresh */ + perl_free(my_perl); + ... + /* let's go do it again! */ + } + +Now, when I is called, the interpreter's syntax parsetree +and symbol tables are cleaned out, along with reseting global variables. + +So, we've seen how to startup and shutdown an interpreter more than once +in the same process, but there was only one instance in existance at any +one time. Hmm, wonder if we can have more than one interpreter instance +running at the _same_ time? +Indeed this is possible, however when you build Perl, you must compile with +C<-DMULTIPLICITY>. + +It's a little tricky for the Perl runtime to handle multiple interpreters, +introducing some overhead that most programs with a single interpreter don't +get burdened with. When you compile with C<-DMULTIPLICITY>, by default, +C is set to C<1> for each interpreter. + +Let's give it a try: + + + #include + #include + + + /* we're going to embed two interpreters */ + /* we're going to embed two interpreters */ + + + #define SAY_HELLO "-e", "print qq(Hi, I'm $^X\n)" + + + int main(int argc, char **argv, char **env) + { + PerlInterpreter + *one_perl = perl_alloc(), + *two_perl = perl_alloc(); + char *one_args[] = { "one_perl", SAY_HELLO }; + char *two_args[] = { "two_perl", SAY_HELLO }; + + perl_construct(one_perl); + perl_construct(two_perl); + + perl_parse(one_perl, NULL, 3, one_args, (char **)NULL); + perl_parse(two_perl, NULL, 3, two_args, (char **)NULL); + + perl_run(one_perl); + perl_run(two_perl); + + perl_destruct(one_perl); + perl_destruct(two_perl); + + perl_free(one_perl); + perl_free(two_perl); + } + + +Compile as usual: + + % cc -o multiplicity multiplicity.c `perl -MExtUtils::Embed -e ccopts -e ldopts` + +Run it, Run it: + + % multiplicity + Hi, I'm one_perl + Hi, I'm two_perl + =head2 Using Perl modules, which themselves use C libraries, from your C program If you've played with the examples above and tried to embed a script diff --git a/t/op/sysio.t b/t/op/sysio.t index 554fdf5..0f546b2 100755 --- a/t/op/sysio.t +++ b/t/op/sysio.t @@ -168,6 +168,8 @@ close(I); unlink $outfile; +chdir('..'); + 1; # eof