/* perl.c
*
- * Copyright (c) 1987-2001 Larry Wall
+ * Copyright (c) 1987-2002 Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#else
/*
+=head1 Embedding Functions
+
=for apidoc perl_alloc
Allocates a new Perl interpreter. See L<perlembed>.
perl_alloc(void)
{
PerlInterpreter *my_perl;
+#ifdef USE_5005THREADS
+ dTHX;
+#endif
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
PL_sighandlerp = Perl_sighandler;
PL_pidstatus = newHV();
-
-#ifdef MSDOS
- /*
- * There is no way we can refer to them from Perl so close them to save
- * space. The other alternative would be to provide STDAUX and STDPRN
- * filehandles.
- */
- (void)PerlIO_close(PerlIO_importFILE(stdaux, 0));
- (void)PerlIO_close(PerlIO_importFILE(stdprn, 0));
-#endif
}
PL_rs = newSVpvn("\n", 1);
PL_regex_pad = AvARRAY(PL_regex_padav);
#endif
#ifdef USE_REENTRANT_API
- New(31337, PL_reentrant_buffer,1, REBUF);
- New(31337, PL_reentrant_buffer->tmbuff,1, struct tm);
+ Perl_reentrant_init(aTHX);
#endif
/* Note that strtab is a rather special HV. Assumptions are made
if (!specialCopIO(PL_compiling.cop_io))
SvREFCNT_dec(PL_compiling.cop_io);
PL_compiling.cop_io = Nullsv;
-#ifdef USE_ITHREADS
- Safefree(CopFILE(&PL_compiling));
- CopFILE(&PL_compiling) = Nullch;
- Safefree(CopSTASHPV(&PL_compiling));
-#else
- SvREFCNT_dec(CopFILEGV(&PL_compiling));
- CopFILEGV(&PL_compiling) = Nullgv;
- /* cop_stash is not refcounted */
-#endif
+ CopFILE_free(&PL_compiling);
+ CopSTASH_free(&PL_compiling);
/* Prepare to destruct main symbol table. */
FREETMPS;
if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
if (PL_scopestack_ix != 0)
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
(long)PL_scopestack_ix);
if (PL_savestack_ix != 0)
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced saves: %ld more saves than restores\n",
(long)PL_savestack_ix);
if (PL_tmps_floor != -1)
- Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n",
(long)PL_tmps_floor + 1);
if (cxstack_ix != -1)
- Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced context: %ld more PUSHes than POPs\n",
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n",
(long)cxstack_ix + 1);
}
hent = array[0];
for (;;) {
if (hent && ckWARN_d(WARN_INTERNAL)) {
- Perl_warner(aTHX_ WARN_INTERNAL,
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced string table refcount: (%d) for \"%s\"",
HeVAL(hent) - Nullsv, HeKEY(hent));
HeVAL(hent) = Nullsv;
SvREADONLY_off(&PL_sv_undef);
if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
- Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
+ Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Scalars leaked: %ld\n", (long)PL_sv_count);
#if defined(PERLIO_LAYERS)
/* No more IO - including error messages ! */
#endif /* USE_5005THREADS */
#ifdef USE_REENTRANT_API
- Safefree(PL_reentrant_buffer->tmbuff);
+ Safefree(PL_reentrant_buffer->tmbuf);
Safefree(PL_reentrant_buffer);
#endif
Sighandler_t sigstate = rsignal_state(SIGCHLD);
if (sigstate == SIG_IGN) {
if (ckWARN(WARN_SIGNAL))
- Perl_warner(aTHX_ WARN_SIGNAL,
+ Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
"Can't ignore signal CHLD, forcing to default");
(void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
}
}
/*
+=head1 SV Manipulation Functions
+
=for apidoc p||get_sv
Returns the SV of the specified Perl scalar. If C<create> is set and the
}
/*
+=head1 Array Manipulation Functions
+
=for apidoc p||get_av
Returns the AV of the specified Perl array. If C<create> is set and the
}
/*
+=head1 Hash Manipulation Functions
+
=for apidoc p||get_hv
Returns the HV of the specified Perl hash. If C<create> is set and the
}
/*
+=head1 CV Manipulation Functions
+
=for apidoc p||get_cv
Returns the CV of the specified Perl subroutine. If C<create> is set and
/* Be sure to refetch the stack pointer after calling these routines. */
/*
+
+=head1 Callback Functions
+
=for apidoc p||call_argv
Performs a callback to the specified Perl sub. See L<perlcall>.
/* Require a module. */
/*
+=head1 Embedding Functions
+
=for apidoc p||require_pv
Tells Perl to C<require> the file named by the string argument. It is
forbid_setid("-D");
if (isALPHA(s[1])) {
/* if adding extra options, remember to update DEBUG_MASK */
- static char debopts[] = "psltocPmfrxuLHXDSTR";
+ static char debopts[] = "psltocPmfrxuLHXDSTRJ";
char *d;
for (s++; *s && (d = strchr(debopts,*s)); s++)
PL_debug |= DEBUG_TOP_FLAG;
#else
if (ckWARN_d(WARN_DEBUGGING))
- Perl_warner(aTHX_ WARN_DEBUGGING,
+ Perl_warner(aTHX_ packWARN(WARN_DEBUGGING),
"Recompile perl with -DDEBUGGING to use -D switch\n");
for (s++; isALNUM(*s); s++) ;
#endif
#endif
PerlIO_printf(PerlIO_stdout(),
- "\n\nCopyright 1987-2001, Larry Wall\n");
+ "\n\nCopyright 1987-2002, Larry Wall\n");
#ifdef MACOS_TRADITIONAL
PerlIO_printf(PerlIO_stdout(),
- "\nMac OS port Copyright 1991-2001, Matthias Neeracher;\n"
+ "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
"maintained by Chris Nandor\n");
#endif
#ifdef MSDOS
#ifdef OS2
PerlIO_printf(PerlIO_stdout(),
"\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
- "Version 5 port Copyright (c) 1994-1999, Andreas Kaiser, Ilya Zakharevich\n");
+ "Version 5 port Copyright (c) 1994-2002, Andreas Kaiser, Ilya Zakharevich\n");
#endif
#ifdef atarist
PerlIO_printf(PerlIO_stdout(),
#endif
#ifdef MPE
PerlIO_printf(PerlIO_stdout(),
- "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2001\n");
+ "MPE/iX port Copyright by Mark Klein and Mark Bixby, 1996-2002\n");
#endif
#ifdef OEMVS
PerlIO_printf(PerlIO_stdout(),
#endif
#ifdef __VOS__
PerlIO_printf(PerlIO_stdout(),
- "Stratus VOS port by Paul_Green@stratus.com, 1997-1999\n");
+ "Stratus VOS port by Paul_Green@stratus.com, 1997-2002\n");
#endif
#ifdef __OPEN_VM
PerlIO_printf(PerlIO_stdout(),
#endif
#ifdef EPOC
PerlIO_printf(PerlIO_stdout(),
- "EPOC port by Olaf Flebbe, 1999-2000\n");
+ "EPOC port by Olaf Flebbe, 1999-2002\n");
#endif
#ifdef UNDER_CE
- printf("WINCE port by Rainer Keuchel, 2001\n");
+ printf("WINCE port by Rainer Keuchel, 2001-2002\n");
printf("Built on " __DATE__ " " __TIME__ "\n\n");
wce_hitreturn();
#endif
}
}
-# ifdef USE_ITHREADS
- Safefree(CopFILE(PL_curcop));
-# else
- SvREFCNT_dec(CopFILEGV(PL_curcop));
-# endif
+ CopFILE_free(PL_curcop);
CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
{
char buf[MAXPATHLEN];
int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
- if (len > 0) {
+ /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
+ returning the text "unknown" from the readlink rather than the path
+ to the executable (or returning an error from the readlink). Any valid
+ path has a '/' in it somewhere, so use that to validate the result.
+ See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
+ */
+ if (len > 0 && memchr(buf, '/', len)) {
sv_setpvn(sv,buf,len);
}
else {
projects / p5sagit/p5-mst-13.2.git / blobdiff