#endif
#ifdef PERL_OBJECT
-CPerlObj*
-perl_alloc(struct IPerlMem* ipM, struct IPerlEnv* ipE,
- struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
- struct IPerlDir* ipD, struct IPerlSock* ipS,
- struct IPerlProc* ipP)
-{
- CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
- if (pPerl != NULL)
- pPerl->Init();
-
- return pPerl;
-}
-#else
+#define perl_construct Perl_construct
+#define perl_parse Perl_parse
+#define perl_run Perl_run
+#define perl_destruct Perl_destruct
+#define perl_free Perl_free
+#endif
#ifdef PERL_IMPLICIT_SYS
PerlInterpreter *
-perl_alloc_using(struct IPerlMem* ipM, struct IPerlEnv* ipE,
+perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
+ struct IPerlMem* ipMP, struct IPerlEnv* ipE,
struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO,
struct IPerlDir* ipD, struct IPerlSock* ipS,
struct IPerlProc* ipP)
{
PerlInterpreter *my_perl;
-
+#ifdef PERL_OBJECT
+ my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd,
+ ipLIO, ipD, ipS, ipP);
+ PERL_SET_INTERP(my_perl);
+#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
PERL_SET_INTERP(my_perl);
Zero(my_perl, 1, PerlInterpreter);
PL_Mem = ipM;
+ PL_MemShared = ipMS;
+ PL_MemParse = ipMP;
PL_Env = ipE;
PL_StdIO = ipStd;
PL_LIO = ipLIO;
PL_Dir = ipD;
PL_Sock = ipS;
PL_Proc = ipP;
+#endif
+
return my_perl;
}
#else
/* New() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
PERL_SET_INTERP(my_perl);
+ Zero(my_perl, 1, PerlInterpreter);
return my_perl;
}
#endif /* PERL_IMPLICIT_SYS */
-#endif /* PERL_OBJECT */
void
perl_construct(pTHXx)
/* Init the real globals (and main thread)? */
if (!PL_linestr) {
-#ifdef USE_THREADS
-
INIT_THREADS;
+#ifdef USE_THREADS
#ifdef ALLOC_THREAD_KEY
ALLOC_THREAD_KEY;
#else
init_i18nl10n(1);
SET_NUMERIC_STANDARD();
+ {
+ U8 *s;
+ PL_patchlevel = NEWSV(0,4);
+ SvUPGRADE(PL_patchlevel, SVt_PVNV);
+ if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127)
+ SvGROW(PL_patchlevel,24);
+ s = (U8*)SvPVX(PL_patchlevel);
+ s = uv_to_utf8(s, (UV)PERL_REVISION);
+ s = uv_to_utf8(s, (UV)PERL_VERSION);
+ s = uv_to_utf8(s, (UV)PERL_SUBVERSION);
+ *s = '\0';
+ SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel));
+ SvPOK_on(PL_patchlevel);
+ SvNVX(PL_patchlevel) = (NV)PERL_REVISION
+ + ((NV)PERL_VERSION / (NV)1000)
#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION
- + ((double) PERL_VERSION / (double) 1000)
- + ((double) PERL_SUBVERSION / (double) 100000));
-#else
- sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION +
- ((double) PERL_VERSION / (double) 1000));
+ + ((NV)PERL_SUBVERSION / (NV)1000000)
#endif
+ ;
+ SvNOK_on(PL_patchlevel); /* dual valued */
+ SvUTF8_on(PL_patchlevel);
+ SvREADONLY_on(PL_patchlevel);
+ }
#if defined(LOCAL_PATCH_COUNT)
PL_localpatches = local_patches; /* For possible -v */
dTHX;
#endif /* USE_THREADS */
+ /* wait for all pseudo-forked children to finish */
+ PERL_WAIT_FOR_CHILDREN;
+
#ifdef USE_THREADS
#ifndef FAKE_THREADS
/* Pass 1 on any remaining threads: detach joinables, join zombies */
goto retry_cleanup;
default:
DEBUG_S(PerlIO_printf(Perl_debug_log,
- "perl_destruct: ignoring %p (state %"UVuf")\n",
- t, (UV)ThrSTATE(t)));
+ "perl_destruct: ignoring %p (state %u)\n",
+ t, ThrSTATE(t)));
MUTEX_UNLOCK(&t->mutex);
/* fall through and out */
}
Safefree(PL_inplace);
PL_inplace = Nullch;
+ SvREFCNT_dec(PL_patchlevel);
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
PL_stderrgv = Nullgv;
PL_last_in_gv = Nullgv;
PL_replgv = Nullgv;
+ PL_debstash = Nullhv;
/* reset so print() ends up where we expect */
setdefout(Nullgv);
+ SvREFCNT_dec(PL_argvout_stack);
+ PL_argvout_stack = Nullav;
+
+ SvREFCNT_dec(PL_fdpid);
+ PL_fdpid = Nullav;
+ SvREFCNT_dec(PL_modglobal);
+ PL_modglobal = Nullhv;
+ SvREFCNT_dec(PL_preambleav);
+ PL_preambleav = Nullav;
+ SvREFCNT_dec(PL_subname);
+ PL_subname = Nullsv;
+ SvREFCNT_dec(PL_linestr);
+ PL_linestr = Nullsv;
+ SvREFCNT_dec(PL_pidstatus);
+ PL_pidstatus = Nullhv;
+ SvREFCNT_dec(PL_toptarget);
+ PL_toptarget = Nullsv;
+ SvREFCNT_dec(PL_bodytarget);
+ PL_bodytarget = Nullsv;
+ PL_formtarget = Nullsv;
+
+ /* clear utf8 character classes */
+ SvREFCNT_dec(PL_utf8_alnum);
+ SvREFCNT_dec(PL_utf8_alnumc);
+ SvREFCNT_dec(PL_utf8_ascii);
+ SvREFCNT_dec(PL_utf8_alpha);
+ SvREFCNT_dec(PL_utf8_space);
+ SvREFCNT_dec(PL_utf8_cntrl);
+ SvREFCNT_dec(PL_utf8_graph);
+ SvREFCNT_dec(PL_utf8_digit);
+ SvREFCNT_dec(PL_utf8_upper);
+ SvREFCNT_dec(PL_utf8_lower);
+ SvREFCNT_dec(PL_utf8_print);
+ SvREFCNT_dec(PL_utf8_punct);
+ SvREFCNT_dec(PL_utf8_xdigit);
+ SvREFCNT_dec(PL_utf8_mark);
+ SvREFCNT_dec(PL_utf8_toupper);
+ SvREFCNT_dec(PL_utf8_tolower);
+ PL_utf8_alnum = Nullsv;
+ PL_utf8_alnumc = Nullsv;
+ PL_utf8_ascii = Nullsv;
+ PL_utf8_alpha = Nullsv;
+ PL_utf8_space = Nullsv;
+ PL_utf8_cntrl = Nullsv;
+ PL_utf8_graph = Nullsv;
+ PL_utf8_digit = Nullsv;
+ PL_utf8_upper = Nullsv;
+ PL_utf8_lower = Nullsv;
+ PL_utf8_print = Nullsv;
+ PL_utf8_punct = Nullsv;
+ PL_utf8_xdigit = Nullsv;
+ PL_utf8_mark = Nullsv;
+ PL_utf8_toupper = Nullsv;
+ PL_utf8_totitle = Nullsv;
+ PL_utf8_tolower = Nullsv;
+
+ if (!specialWARN(PL_compiling.cop_warnings))
+ SvREFCNT_dec(PL_compiling.cop_warnings);
+ PL_compiling.cop_warnings = Nullsv;
+
/* Prepare to destruct main symbol table. */
hv = PL_defstash;
PL_defstash = 0;
SvREFCNT_dec(hv);
+ SvREFCNT_dec(PL_curstname);
+ PL_curstname = Nullsv;
/* clear queued errors */
SvREFCNT_dec(PL_errors);
sv_free_arenas();
/* No SVs have survived, need to clean out */
- PL_linestr = NULL;
- PL_pidstatus = Nullhv;
Safefree(PL_origfilename);
- Safefree(PL_archpat_auto);
Safefree(PL_reg_start_tmp);
if (PL_reg_curpm)
Safefree(PL_reg_curpm);
goto reswitch;
case 'e':
-#ifdef MACOS_TRADITIONAL
- /* ignore -e for Dev:Pseudo argument */
- if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
- break;
-#endif
if (PL_euid != PL_uid || PL_egid != PL_gid)
Perl_croak(aTHX_ "No -e allowed in setuid scripts");
if (!PL_e_script) {
if (!*++s && (s=argv[1]) != Nullch) {
argc--,argv++;
}
- while (s && isSPACE(*s))
- ++s;
if (s && *s) {
- char *e, *p;
- for (e = s; *e && !isSPACE(*e); e++) ;
- p = savepvn(s, e-s);
+ char *p;
+ STRLEN len = strlen(s);
+ p = savepvn(s, len);
incpush(p, TRUE);
- sv_catpv(sv,"-I");
- sv_catpv(sv,p);
- sv_catpv(sv," ");
+ sv_catpvn(sv, "-I", 2);
+ sv_catpvn(sv, p, len);
+ sv_catpvn(sv, " ", 1);
Safefree(p);
- } /* XXX else croak? */
+ }
+ else
+ Perl_croak(aTHX_ "No directory specified for -I");
break;
case 'P':
forbid_setid("-P");
#ifndef SECURE_INTERNAL_GETENV
!PL_tainting &&
#endif
- (s = PerlEnv_getenv("PERL5OPT"))) {
+ (s = PerlEnv_getenv("PERL5OPT")))
+ {
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T')
}
#endif
-#ifdef MACOS_TRADITIONAL
- if (PL_doextract || gAlwaysExtract)
-#else
if (PL_doextract) {
-#endif
find_beginning();
if (cddir && PerlDir_chdir(cddir) < 0)
Perl_croak(aTHX_ "Can't chdir to %s",cddir);
+
}
PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
SETERRNO(0,SS$_NORMAL);
PL_error_count = 0;
-#ifdef MACOS_TRADITIONAL
- if (gSyntaxError = (yyparse() || PL_error_count)) {
- if (PL_minus_c)
- Perl_croak(aTHX_ "%s had compilation errors.\n", MPWFileName(PL_origfilename));
- else {
- Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
- MPWFileName(PL_origfilename));
- }
- }
-#else
if (yyparse() || PL_error_count) {
if (PL_minus_c)
Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
PL_origfilename);
}
}
-#endif
- PL_curcop->cop_line = 0;
+ CopLINE_set(PL_curcop, 0);
PL_curstash = PL_defstash;
PL_preprocess = FALSE;
if (PL_e_script) {
if (PL_do_undump)
my_unexec();
- if (isWARN_ONCE)
+ if (isWARN_ONCE) {
+ SAVECOPFILE(PL_curcop);
+ SAVECOPLINE(PL_curcop);
gv_check(PL_defstash);
+ }
LEAVE;
FREETMPS;
PTR2UV(thr)));
if (PL_minus_c) {
-#ifdef MACOS_TRADITIONAL
- PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", MPWFileName(PL_origfilename));
-#else
PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename);
-#endif
-my_exit(0);
+ my_exit(0);
}
if (PERLDB_SINGLE && PL_DBsingle)
sv_setiv(PL_DBsingle, 1);
/* my_exit() was called */
PL_curstash = PL_defstash;
FREETMPS;
- if (PL_statusvalue)
+ if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
/* NOTREACHED */
/* my_exit() was called */
PL_curstash = PL_defstash;
FREETMPS;
- if (PL_statusvalue)
+ if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
Perl_croak(aTHX_ "Callback called exit");
my_exit_jump();
/* NOTREACHED */
++s;
if (*s) {
char *e, *p;
- for (e = s; *e && !isSPACE(*e); e++) ;
- p = savepvn(s, e-s);
- incpush(p, TRUE);
- Safefree(p);
- s = e;
+ p = s;
+ /* ignore trailing spaces (possibly followed by other switches) */
+ do {
+ for (e = p; *e && !isSPACE(*e); e++) ;
+ p = e;
+ while (isSPACE(*p))
+ p++;
+ } while (*p && *p != '-');
+ e = savepvn(s, e-s);
+ incpush(e, TRUE);
+ Safefree(e);
+ s = p;
+ if (*s == '-')
+ s++;
}
else
- Perl_croak(aTHX_ "No space allowed after -I");
+ Perl_croak(aTHX_ "No directory specified for -I");
return s;
case 'l':
PL_minus_l = TRUE;
sv_catpv(sv, "})");
}
s += strlen(s);
- if (PL_preambleav == NULL)
+ if (!PL_preambleav)
PL_preambleav = newAV();
av_push(PL_preambleav, sv);
}
s++;
return s;
case 'u':
-#ifdef MACOS_TRADITIONAL
- Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh");
-#endif
PL_do_undump = TRUE;
s++;
return s;
s++;
return s;
case 'v':
-#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
- printf("\nThis is perl, version %d.%03d_%02d built for %s",
- PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME);
-#else
- printf("\nThis is perl, version %s built for %s",
- PL_patchlevel, ARCHNAME);
-#endif
+ printf("\nThis is perl, v%"UVuf".%"UVuf".%"UVuf" built for %s",
+ (UV)PERL_REVISION, (UV)PERL_VERSION, (UV)PERL_SUBVERSION, ARCHNAME);
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0)
printf("\n(with %d registered patch%s, see perl -V for more detail)",
#endif
printf("\n\nCopyright 1987-1999, Larry Wall\n");
-#ifdef MACOS_TRADITIONAL
- fputs("Macintosh port Copyright 1991-1999, Matthias Neeracher\n", stdout);
-#endif
#ifdef MSDOS
printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
#endif
# endif
#endif
-#ifdef MACOS_TRADITIONAL
- /* In MacOS time() already returns values in excess of 2**31-1,
- * therefore we patch the integerness away. */
- PL_opargs[OP_TIME] &= ~OA_RETINTEGER;
-#endif
-
}
STATIC void
sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */
sv_setpvn(ERRSV, "", 0);
PL_curstash = PL_defstash;
- PL_compiling.cop_stash = PL_defstash;
+ CopSTASH_set(&PL_compiling, PL_defstash);
PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
/* We must init $/ before switches are processed. */
}
}
- CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename));
+ CopFILE_set(PL_curcop, PL_origfilename);
if (strEQ(PL_origfilename,"-"))
scriptname = "";
if (*fdscript >= 0) {
Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
sv_catpv(cpp, cpp_cfg);
- sv_catpv(sv,"-I");
+ sv_catpvn(sv, "-I", 2);
sv_catpv(sv,PRIVLIB_EXP);
#ifdef MSDOS
PL_statbuf.st_mode & (S_ISUID|S_ISGID))
{
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);
Perl_croak(aTHX_ "Can't do setuid\n");
}
#endif
# if defined(HAS_FSTAT) && \
defined(HAS_USTAT) && \
defined(HAS_GETMNT) && \
- defined(HAS_STRUCT_FS_DATA) &&
+ defined(HAS_STRUCT_FS_DATA) && \
defined(NOSTAT_ONE)
struct stat fdst;
if (fstat(fd, &fdst) == 0) {
if (PL_statbuf.st_mode & S_IWOTH)
Perl_croak(aTHX_ "Setuid/gid script is writable by world");
PL_doswitches = FALSE; /* -s is insecure in suid */
- PL_curcop->cop_line++;
+ CopLINE_inc(PL_curcop);
if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
Perl_croak(aTHX_ "No #! line");
(void)PerlIO_close(PL_rsfp);
#ifndef IAMSUID
/* try again */
- PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+ PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);
#endif
Perl_croak(aTHX_ "Can't do setuid\n");
}
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */
#endif
- PerlProc_execv(Perl_form(aTHX_ "%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
+ PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
+ (UV)PERL_REVISION, (UV)PERL_VERSION,
+ (UV)PERL_SUBVERSION), PL_origargv);/* try again */
Perl_croak(aTHX_ "Can't do setuid\n");
#endif /* IAMSUID */
#else /* !DOSUID */
/* skip forward in input to the real script? */
forbid_setid("-x");
-#ifdef MACOS_TRADITIONAL
- /* Since the Mac OS does not honor !# arguments for us,
- * we do it ourselves. */
- while (PL_doextract || gAlwaysExtract) {
- if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
- if (!gAlwaysExtract)
- Perl_croak(aTHX_ "No Perl script found in input\n");
-
- if (PL_doextract) /* require explicit override ? */
- if (!OverrideExtract(PL_origfilename))
- Perl_croak(aTHX_ "User aborted script\n");
- else
- PL_doextract = FALSE;
-
- /* Pater peccavi, file does not have #! */
- PerlIO_rewind(PL_rsfp);
-
- break;
- }
-#else
while (PL_doextract) {
if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
Perl_croak(aTHX_ "No Perl script found in input\n");
-#endif
if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
- PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */
+ PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */
PL_doextract = FALSE;
while (*s && !(isSPACE (*s) || *s == '#')) s++;
s2 = s;
PL_markstack_ptr = PL_markstack;
PL_markstack_max = PL_markstack + REASONABLE(32);
- SET_MARKBASE;
+ SET_MARK_OFFSET;
New(54,PL_scopestack,REASONABLE(32),I32);
PL_scopestack_ix = 0;
PL_statname = NEWSV(66,0); /* last filename we did stat on */
- if (PL_osname)
- Safefree(PL_osname);
- PL_osname = savepv(OSNAME);
+ if (!PL_osname)
+ PL_osname = savepv(OSNAME);
}
STATIC void
TAINT;
if (tmpgv = gv_fetchpv("0",TRUE, SVt_PV)) {
-#ifdef MACOS_TRADITIONAL
- sv_setpv(GvSV(tmpgv),MPWFileName(PL_origfilename));
- /* $0 is not majick on a Mac */
-#else
sv_setpv(GvSV(tmpgv),PL_origfilename);
magicname("0", "0", 1);
-#endif
}
if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV))
#ifdef OS2
for (; argc > 0; argc--,argv++) {
av_push(GvAVn(PL_argvgv),newSVpv(argv[0],0));
}
- PL_argvout_stack = newAV();
}
if (PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV)) {
HV *hv;
}
TAINT_NOT;
if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
- sv_setiv(GvSV(tmpgv), (IV)getpid());
+ sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
}
STATIC void
#ifdef ARCHLIB_EXP
incpush(ARCHLIB_EXP, FALSE);
#endif
-#ifdef MACOS_TRADITIONAL
- {
- struct stat tmpstatbuf;
- SV * privdir = NEWSV(55, 0);
- char * macperl = getenv("MACPERL") || "";
-
- Perl_sv_setpvf(privdir, "%slib:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE);
- Perl_sv_setpvf(privdir, "%ssite_perl:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush(SvPVX(privdir), TRUE);
-
- SvREFCNT_dec(privdir);
- }
- if (!PL_tainting)
- incpush(":", FALSE);
-#else
#ifndef PRIVLIB_EXP
#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
#endif
if (!PL_tainting)
incpush(".", FALSE);
-#endif /* MACOS_TRADITIONAL */
}
-#if defined(MACOS_TRADITIONAL)
-# define PERLLIB_SEP ','
+#if defined(DOSISH)
+# define PERLLIB_SEP ';'
#else
-# if defined(DOSISH)
-# define PERLLIB_SEP ';'
+# if defined(VMS)
+# define PERLLIB_SEP '|'
# else
-# if defined(VMS)
-# define PERLLIB_SEP '|'
-# else
-# define PERLLIB_SEP ':'
-# endif
+# define PERLLIB_SEP ':'
# endif
-#endif
+#endif
#ifndef PERLLIB_MANGLE
-# define PERLLIB_MANGLE(s,n) (s)
+# define PERLLIB_MANGLE(s,n) (s)
#endif
STATIC void
if (addsubdirs) {
subdir = sv_newmortal();
- if (!PL_archpat_auto) {
- STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel)
- + sizeof("//auto"));
- New(55, PL_archpat_auto, len, char);
-#ifdef MACOS_TRADITIONAL
- sprintf(PL_archpat_auto, "%s:%s:auto:", ARCHNAME, PL_patchlevel);
-#else
- sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel);
-#endif
-#ifdef VMS
- for (len = sizeof(ARCHNAME) + 2;
- PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++)
- if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_';
-#endif
- }
}
/* Break at all separators */
sv_setpv(libdir, PERLLIB_MANGLE(p, 0));
p = Nullch; /* break out */
}
-#ifdef MACOS_TRADITIONAL
- if (!strchr(SvPVX(libdir), ':'))
- sv_insert(libdir, 0, 0, ":", 1);
- if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
- sv_catpv(libdir, ":");
-#endif
/*
* BEFORE pushing libdir onto @INC we may first push version- and
SvPV(libdir,len));
#endif
/* .../archname/version if -d .../archname/version/auto */
- sv_setsv(subdir, libdir);
- sv_catpv(subdir, PL_archpat_auto);
+ Perl_sv_setpvf(aTHX_ subdir, "%_/%s/"PERL_FS_VER_FMT"/auto", libdir,
+ ARCHNAME, (UV)PERL_REVISION,
+ (UV)PERL_VERSION, (UV)PERL_SUBVERSION);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
/* .../archname if -d .../archname/auto */
- sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
- strlen(PL_patchlevel) + 1, "", 0);
+ Perl_sv_setpvf(aTHX_ subdir, "%_/%s/auto", libdir, ARCHNAME);
if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode))
av_push(GvAVn(PL_incgv),
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
dTHR;
- SV *atsv = ERRSV;
- line_t oldline = PL_curcop->cop_line;
+ SV *atsv;
+ line_t oldline = CopLINE(PL_curcop);
CV *cv;
STRLEN len;
int ret;
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
switch (ret) {
case 0:
+ atsv = ERRSV;
(void)SvPV(atsv, len);
if (len) {
+ STRLEN n_a;
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
if (paramList == PL_beginav)
sv_catpv(atsv, "BEGIN failed--compilation aborted");
else
: "END");
while (PL_scopestack_ix > oldscope)
LEAVE;
- Perl_croak(aTHX_ "%s", SvPVX(atsv));
+ Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
}
break;
case 1:
FREETMPS;
PL_curstash = PL_defstash;
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
- if (PL_statusvalue) {
+ CopLINE_set(PL_curcop, oldline);
+ if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
if (paramList == PL_beginav)
Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
else
case 3:
if (PL_restartop) {
PL_curcop = &PL_compiling;
- PL_curcop->cop_line = oldline;
+ CopLINE_set(PL_curcop, oldline);
JMPENV_JUMP(3);
}
PerlIO_printf(Perl_error_log, "panic: restartop\n");
sv_chop(PL_e_script, nl);
return 1;
}
-
projects / p5sagit/p5-mst-13.2.git / blobdiff