destruct_level = PL_perl_destruct_level;
#ifdef DEBUGGING
{
- char *s;
+ const char *s;
if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
const int i = atoi(s);
if (destruct_level < i)
while (i) {
SV *resv = ary[--i];
- REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
if (SvFLAGS(resv) & SVf_BREAK) {
/* this is PL_reg_curpm, already freed
else if(SvREPADTMP(resv)) {
SvREPADTMP_off(resv);
}
- else {
+ else if(SvIOKp(resv)) {
+ REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
ReREFCNT_dec(re);
}
}
SvREFCNT_dec(PL_strtab);
#ifdef USE_ITHREADS
- /* free the pointer table used for cloning */
+ /* free the pointer tables used for cloning */
ptr_table_free(PL_ptr_table);
PL_ptr_table = (PTR_TBL_t*)NULL;
+ ptr_table_free(PL_shared_hek_table);
+ PL_shared_hek_table = (PTR_TBL_t*)NULL;
#endif
/* free special SVs */
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != SVTYPEMASK) {
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
- " flags=0x08%"UVxf
+ " flags=0x%"UVxf
" refcnt=%"UVuf pTHX__FORMAT "\n"
"\tallocated at %s:%d %s %s%s\n",
sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
/* As the absolutely last thing, free the non-arena SV for mess() */
if (PL_mess_sv) {
+ /* we know that type == SVt_PVMG */
+
/* it could have accumulated taint magic */
- if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
- MAGIC* mg;
- MAGIC* moremagic;
- for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
- moremagic = mg->mg_moremagic;
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
- && mg->mg_len >= 0)
- Safefree(mg->mg_ptr);
- Safefree(mg);
- }
+ MAGIC* mg;
+ MAGIC* moremagic;
+ for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
+ moremagic = mg->mg_moremagic;
+ if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
+ && mg->mg_len >= 0)
+ Safefree(mg->mg_ptr);
+ Safefree(mg);
}
+
/* we know that type >= SVt_PV */
- SvOOK_off(PL_mess_sv);
- Safefree(SvPVX(PL_mess_sv));
+ SvPV_free(PL_mess_sv);
Safefree(SvANY(PL_mess_sv));
Safefree(PL_mess_sv);
PL_mess_sv = Nullsv;
/* provide destructors to clean up the thread key when libperl is unloaded */
#ifndef WIN32 /* handled during DLL_PROCESS_DETACH in win32/perllib.c */
-#if defined(__hpux) && !defined(__GNUC__)
+#if defined(__hpux) && __ux_version > 1020 && !defined(__GNUC__)
#pragma fini "perl_fini"
#endif
-#if defined(__GNUC__) && defined(__attribute__)
-/* want to make sure __attribute__ works here even
- * for -Dd_attribut=undef builds.
- */
-#undef __attribute__
+static void
+#if defined(__GNUC__)
+__attribute__((destructor))
#endif
-
-static void __attribute__((destructor))
-perl_fini()
+perl_fini(void)
{
dVAR;
if (PL_curinterp)
/* we're trying to emulate pp_entertry() here */
{
register PERL_CONTEXT *cx;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
ENTER;
SAVETMPS;
if (flags & G_KEEPERR)
PL_in_eval |= EVAL_KEEPERR;
else
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
}
PL_markstack_ptr++;
call_body((OP*)&myop, FALSE);
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
break;
case 1:
STATUS_ALL_FAILURE;
UNOP myop; /* fake syntax tree node */
volatile I32 oldmark = SP - PL_stack_base;
volatile I32 retval = 0;
- I32 oldscope;
int ret;
OP* oldop = PL_op;
dJMPENV;
Zero(PL_op, 1, UNOP);
EXTEND(PL_stack_sp, 1);
*++PL_stack_sp = sv;
- oldscope = PL_scopestack_ix;
if (!(flags & G_NOARGS))
myop.op_flags = OPf_STACKED;
call_body((OP*)&myop,TRUE);
retval = PL_stack_sp - (PL_stack_base + oldmark);
if (!(flags & G_KEEPERR))
- sv_setpv(ERRSV,"");
+ sv_setpvn(ERRSV,"",0);
break;
case 1:
STATUS_ALL_FAILURE;
"-d[:debugger] run program under debugger",
"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
"-e program one line of program (several -e's allowed, omit programfile)",
+#ifdef USE_SITECUSTOMIZE
"-f don't do $sitelib/sitecustomize.pl at startup",
+#endif
"-F/pattern/ split() pattern for -a switch (//'s are optional)",
"-i[extension] edit <> files in place (makes backup if extension supplied)",
"-Idirectory specify @INC/#include directory (several -I's allowed)",
"-l[octal] enable line ending processing, specifies line terminator",
-"-[mM][-]module execute `use/no module...' before executing program",
-"-n assume 'while (<>) { ... }' loop around program",
+"-[mM][-]module execute \"use/no module...\" before executing program",
+"-n assume \"while (<>) { ... }\" loop around program",
"-p assume loop like -n but print line also, like sed",
"-P run program through C preprocessor before compilation",
"-s enable rudimentary parsing for switches after programfile",
for (; isALNUM(**s); (*s)++) ;
}
else if (givehelp) {
- const char **p = usage_msgd;
+ char **p = (char **)usage_msgd;
while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
}
# ifdef EBCDIC
Perl_moreswitches(pTHX_ char *s)
{
dVAR;
- STRLEN numlen;
UV rschar;
switch (*s) {
case '0':
{
I32 flags = 0;
+ STRLEN numlen;
SvREFCNT_dec(PL_rs);
if (s[1] == 'x' && s[2]) {
- char *e;
+ const char *e = s+=2;
U8 *tmps;
- for (s += 2, e = s; *e; e++);
+ while (*e)
+ e++;
numlen = e - s;
flags = PERL_SCAN_SILENT_ILLDIGIT;
rschar = (U32)grok_hex(s, &numlen, &flags, NULL);
}
if (isDIGIT(*s)) {
I32 flags = 0;
+ STRLEN numlen;
PL_ors_sv = newSVpvn("\n",1);
numlen = 3 + (*s == '0');
*SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
Perl may be copied only under the terms of either the Artistic License or the\n\
GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
Complete documentation for Perl, including FAQ lists, should be found on\n\
-this system using `man perl' or `perldoc perl'. If you have access to the\n\
+this system using \"man perl\" or \"perldoc perl\". If you have access to the\n\
Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
my_exit(0);
case 'w':
SvREFCNT_dec(GvHV(gv));
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
SvREADONLY_on(gv);
- HvNAME(PL_defstash) = savepvn("main", 4);
+ Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
GvMULTI_on(PL_incgv);
PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
#else
int exitstatus;
if (errno & 255)
- STATUS_POSIX_SET(errno);
+ STATUS_UNIX_SET(errno);
else {
- exitstatus = STATUS_POSIX >> 8;
+ exitstatus = STATUS_UNIX >> 8;
if (exitstatus & 255)
- STATUS_POSIX_SET(exitstatus);
+ STATUS_UNIX_SET(exitstatus);
else
- STATUS_POSIX_SET(255);
+ STATUS_UNIX_SET(255);
}
#endif
my_exit_jump();
sv_chop(PL_e_script, nl);
return 1;
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff