#endif
#endif
-#ifndef NO_MATHOMS
-/* This reference ensures that the mathoms are linked with perl */
-extern void Perl_mathoms(void);
-void Perl_mathoms_ref(void);
-void Perl_mathoms_ref(void) {
- Perl_mathoms();
-}
-#endif
-
static void
S_init_tls_and_interp(PerlInterpreter *my_perl)
{
if (!PL_linestr) {
PL_curcop = &PL_compiling; /* needed by ckWARN, right away */
- PL_linestr = NEWSV(65,79);
+ PL_linestr = newSV(79);
sv_upgrade(PL_linestr,SVt_PVIV);
if (!SvREADONLY(&PL_sv_undef)) {
#endif
}
- PL_rs = newSVpvn("\n", 1);
+ PL_rs = newSVpvs("\n");
init_stacks();
PL_fdpid = newAV(); /* for remembering popen pids by fd */
PL_modglobal = newHV(); /* pointers to per-interpreter module globals */
- PL_errors = newSVpvn("",0);
+ PL_errors = newSVpvs("");
sv_setpvn(PERL_DEBUG_PAD(0), "", 0); /* For regex debugging. */
sv_setpvn(PERL_DEBUG_PAD(1), "", 0); /* ext/re needs these */
sv_setpvn(PERL_DEBUG_PAD(2), "", 0); /* even without DEBUGGING. */
}
PL_main_start = Nullop;
SvREFCNT_dec(PL_main_cv);
- PL_main_cv = Nullcv;
+ PL_main_cv = NULL;
PL_dirty = TRUE;
/* Tell PerlIO we are about to tear things apart in case
PL_unsafe = FALSE;
Safefree(PL_inplace);
- PL_inplace = Nullch;
+ PL_inplace = NULL;
SvREFCNT_dec(PL_patchlevel);
if (PL_e_script) {
PL_multiline = 0; /* $* */
Safefree(PL_osname); /* $^O */
- PL_osname = Nullch;
+ PL_osname = NULL;
SvREFCNT_dec(PL_statname);
PL_statname = Nullsv;
/* float buffer */
Safefree(PL_efloatbuf);
- PL_efloatbuf = Nullch;
+ PL_efloatbuf = NULL;
PL_efloatsize = 0;
/* startup and shutdown function lists */
PL_DBtrace = Nullsv;
PL_DBsignal = Nullsv;
PL_DBassertion = Nullsv;
- PL_DBcv = Nullcv;
+ PL_DBcv = NULL;
PL_dbargs = NULL;
PL_debstash = NULL;
/* free locale stuff */
#ifdef USE_LOCALE_COLLATE
Safefree(PL_collation_name);
- PL_collation_name = Nullch;
+ PL_collation_name = NULL;
#endif
#ifdef USE_LOCALE_NUMERIC
Safefree(PL_numeric_name);
- PL_numeric_name = Nullch;
+ PL_numeric_name = NULL;
SvREFCNT_dec(PL_numeric_radix_sv);
PL_numeric_radix_sv = Nullsv;
#endif
HE * const next = HeNEXT(hent);
Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
"Unbalanced string table refcount: (%ld) for \"%s\"",
- (long)(HeVAL(hent) - Nullsv), HeKEY(hent));
+ (long)hent->he_valu.hent_refcount, HeKEY(hent));
Safefree(hent);
hent = next;
}
SvREADONLY_off(&PL_sv_undef);
Safefree(PL_origfilename);
- PL_origfilename = Nullch;
+ PL_origfilename = NULL;
Safefree(PL_reg_start_tmp);
PL_reg_start_tmp = (char**)NULL;
PL_reg_start_tmpl = 0;
Safefree(PL_psig_name);
PL_psig_name = (SV**)NULL;
Safefree(PL_bitcount);
- PL_bitcount = Nullch;
+ PL_bitcount = NULL;
Safefree(PL_psig_pend);
PL_psig_pend = (int*)NULL;
PL_formfeed = Nullsv;
void
Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
{
+ dVAR;
Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry);
PL_exitlist[PL_exitlistlen].fn = fn;
PL_exitlist[PL_exitlistlen].ptr = ptr;
STATIC void
S_set_caret_X(pTHX) {
- GV* tmpgv = gv_fetchpv("\030",TRUE, SVt_PV); /* $^X */
+ dVAR;
+ GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
if (tmpgv) {
#ifdef HAS_PROCSELFEXE
S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
PL_origargc = argc;
PL_origargv = argv;
- {
+ if (PL_origalen != 0) {
+ PL_origalen = 1; /* don't use old PL_origalen if perl_parse() is called again */
+ }
+ else {
/* Set PL_origalen be the sum of the contiguous argv[]
* elements plus the size of the env in case that it is
* contiguous with the argv[]. This is used in mg.c:Perl_magic_set()
}
}
/* Can we grab env area too to be used as the area for $0? */
- if (PL_origenviron) {
+ if (s && PL_origenviron) {
if ((PL_origenviron[0] == s + 1
#ifdef OS2
|| (PL_origenviron[0] == s + 9 && (s += 8))
s = PL_origenviron[0];
while (*s) s++;
#endif
- my_setenv("NoNe SuCh", Nullch);
+ my_setenv("NoNe SuCh", NULL);
/* Force copy of environment. */
for (i = 1; PL_origenviron[i]; i++) {
if (PL_origenviron[i] == s + 1
}
}
}
- PL_origalen = s - PL_origargv[0] + 1;
+ PL_origalen = s ? s - PL_origargv[0] + 1 : 0;
}
if (PL_do_undump) {
}
PL_main_start = Nullop;
SvREFCNT_dec(PL_main_cv);
- PL_main_cv = Nullcv;
+ PL_main_cv = NULL;
time(&PL_basetime);
oldscope = PL_scopestack_ix;
const char *validarg = "";
register SV *sv;
register char *s;
- const char *cddir = Nullch;
+ const char *cddir = NULL;
#ifdef USE_SITECUSTOMIZE
bool minus_f = FALSE;
#endif
PL_fdscript = -1;
PL_suidscript = -1;
sv_setpvn(PL_linestr,"",0);
- sv = newSVpvn("",0); /* first used for -I flags */
+ sv = newSVpvs(""); /* first used for -I flags */
SAVEFREESV(sv);
init_main_stash();
#endif
forbid_setid("-e");
if (!PL_e_script) {
- PL_e_script = newSVpvn("",0);
+ PL_e_script = newSVpvs("");
filter_add(read_e_script, NULL);
}
if (*++s)
}
else
Perl_croak(aTHX_ "No code specified for -%c", *s);
- sv_catpv(PL_e_script, "\n");
+ sv_catpvs(PL_e_script, "\n");
break;
case 'f':
case 'I': /* -I handled both here and in moreswitches() */
forbid_setid("-I");
- if (!*++s && (s=argv[1]) != Nullch) {
+ if (!*++s && (s=argv[1]) != NULL) {
argc--,argv++;
}
if (s && *s) {
STRLEN len = strlen(s);
const char * const p = savepvn(s, len);
incpush(p, TRUE, TRUE, FALSE, FALSE);
- sv_catpvn(sv, "-I", 2);
+ sv_catpvs(sv, "-I");
sv_catpvn(sv, p, len);
- sv_catpvn(sv, " ", 1);
+ sv_catpvs(sv, " ");
Safefree(p);
}
else
if (!PL_preambleav)
PL_preambleav = newAV();
av_push(PL_preambleav,
- newSVpv("use Config;",0));
+ newSVpvs("use Config;"));
if (*++s != ':') {
STRLEN opts;
- opts_prog = newSVpv("print Config::myconfig(),",0);
+ opts_prog = newSVpvs("print Config::myconfig(),");
#ifdef VMS
- sv_catpv(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
+ sv_catpvs(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
#else
- sv_catpv(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
+ sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
#endif
opts = SvCUR(opts_prog);
# ifdef PL_OP_SLAB_ALLOC
" PL_OP_SLAB_ALLOC"
# endif
-# ifdef SPRINTF_RETURNS_STRLEN
- " SPRINTF_RETURNS_STRLEN"
-# endif
# ifdef THREADS_HAVE_PIDS
" THREADS_HAVE_PIDS"
# endif
/* break the line before that space */
opts = space - pv;
- sv_insert(opts_prog, opts, 0,
- "\\n ", 25);
+ Perl_sv_insert(aTHX_ opts_prog, opts, 0,
+ STR_WITH_LEN("\\n "));
}
- sv_catpv(opts_prog,"\\n\",");
+ sv_catpvs(opts_prog,"\\n\",");
#if defined(LOCAL_PATCH_COUNT)
if (LOCAL_PATCH_COUNT > 0) {
int i;
- sv_catpv(opts_prog,
+ sv_catpvs(opts_prog,
"\" Locally applied patches:\\n\",");
for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
if (PL_localpatches[i])
__DATE__);
# endif
#endif
- sv_catpv(opts_prog, "; $\"=\"\\n \"; "
+ sv_catpvs(opts_prog, "; $\"=\"\\n \"; "
"@env = map { \"$_=\\\"$ENV{$_}\\\"\" } "
"sort grep {/^PERL/} keys %ENV; ");
#ifdef __CYGWIN__
- sv_catpv(opts_prog,
+ sv_catpvs(opts_prog,
"push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
#endif
- sv_catpv(opts_prog,
+ sv_catpvs(opts_prog,
"print \" \\%ENV:\\n @env\\n\" if @env;"
"print \" \\@INC:\\n @INC\\n\";");
}
PL_taint_warn = FALSE;
}
else {
- char *popt_copy = Nullch;
+ char *popt_copy = NULL;
while (s && *s) {
char *d;
while (isSPACE(*s))
argc++,argv--;
scriptname = BIT_BUCKET; /* don't look for script or read stdin */
}
- else if (scriptname == Nullch) {
+ else if (scriptname == NULL) {
#ifdef MSDOS
if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
moreswitches("h");
}
- PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
+ PL_main_cv = PL_compcv = (CV*)newSV(0);
sv_upgrade((SV *)PL_compcv, SVt_PVCV);
CvUNIQUE_on(PL_compcv);
(fp = IoOFP(io)))
PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8");
if ((PL_unicode & PERL_UNICODE_INOUT_FLAG) &&
- (sv = GvSV(gv_fetchpv("\017PEN", TRUE, SVt_PV)))) {
+ (sv = GvSV(gv_fetchpvs("\017PEN", GV_ADD|GV_NOTQUAL,
+ SVt_PV)))) {
U32 in = PL_unicode & PERL_UNICODE_IN_FLAG;
U32 out = PL_unicode & PERL_UNICODE_OUT_FLAG;
if (in) {
int
perl_run(pTHXx)
{
+ dVAR;
I32 oldscope;
int ret = 0;
dJMPENV;
STATIC void
S_run_body(pTHX_ I32 oldscope)
{
+ dVAR;
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
PL_sawampersand ? "Enabling" : "Omitting"));
Nullop);
if (gv)
return GvCVu(gv);
- return Nullcv;
+ return NULL;
}
/* Be sure to refetch the stack pointer after calling these routines. */
/* See G_* flags in cop.h */
/* null terminated arg list */
{
+ dVAR;
dSP;
PUSHMARK(SP);
STATIC void
S_call_body(pTHX_ const OP *myop, bool is_eval)
{
+ dVAR;
if (PL_op == myop) {
if (is_eval)
PL_op = Perl_pp_entereval(aTHX); /* this doesn't do a POPMARK */
/* See G_* flags in cop.h */
{
+ dVAR;
dSP;
UNOP myop; /* fake syntax tree node */
volatile I32 oldmark = SP - PL_stack_base;
SV*
Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
{
+ dVAR;
dSP;
SV* sv = newSVpv(p, 0);
void
Perl_require_pv(pTHX_ const char *pv)
{
- SV* sv;
+ dVAR;
dSP;
+ SV* sv;
PUSHSTACKi(PERLSI_REQUIRE);
PUTBACK;
sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
void
Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
{
- register GV * const gv = gv_fetchpv(sym,TRUE, SVt_PV);
+ register GV * const gv = gv_fetchpv(sym, GV_ADD, SVt_PV);
if (gv)
sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
numlen = 0;
s--;
}
- PL_rs = newSVpvn("", 0);
+ PL_rs = newSVpvs("");
SvGROW(PL_rs, (STRLEN)(UNISKIP(rschar) + 1));
tmps = (U8*)SvPVX(PL_rs);
uvchr_to_utf8(tmps, rschar);
if (rschar & ~((U8)~0))
PL_rs = &PL_sv_undef;
else if (!rschar && numlen >= 2)
- PL_rs = newSVpvn("", 0);
+ PL_rs = newSVpvs("");
else {
char ch = (char)rschar;
PL_rs = newSVpvn(&ch, 1);
in the fashion that -MSome::Mod does. */
if (*s == ':' || *s == '=') {
const char *start;
- SV * const sv = newSVpv("use Devel::", 0);
+ SV * const sv = newSVpvs("use Devel::");
start = ++s;
/* We now allow -d:Module=Foo,Bar */
while(isALNUM(*s) || *s==':') ++s;
Safefree(PL_inplace);
#if defined(__CYGWIN__) /* do backup extension automagically */
if (*(s+1) == '\0') {
- PL_inplace = savepv(".bak");
+ PL_inplace = savepvs(".bak");
return s+1;
}
#endif /* __CYGWIN__ */
if (isDIGIT(*s)) {
I32 flags = 0;
STRLEN numlen;
- PL_ors_sv = newSVpvn("\n",1);
+ PL_ors_sv = newSVpvs("\n");
numlen = 3 + (*s == '0');
*SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
s += numlen;
}
else {
if (RsPARA(PL_rs)) {
- PL_ors_sv = newSVpvn("\n\n",2);
+ PL_ors_sv = newSVpvs("\n\n");
}
else {
PL_ors_sv = newSVsv(PL_rs);
s++;
{
char * const start = s;
- SV * const sv = newSVpv("use assertions::activate", 24);
+ SV * const sv = newSVpvs("use assertions::activate");
while(isALNUM(*s) || *s == ':') ++s;
if (s != start) {
- sv_catpvn(sv, "::", 2);
+ sv_catpvs(sv, "::");
sv_catpvn(sv, start, s-start);
}
if (*s == '=') {
if (*(start-1) == 'm') {
if (*s != '\0')
Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
- sv_catpv( sv, " ()");
+ sv_catpvs( sv, " ()");
}
} else {
if (s == start)
Perl_croak(aTHX_ "Module name required with -%c option",
s[-1]);
sv_catpvn(sv, start, s-start);
- sv_catpv(sv, " split(/,/,q");
- sv_catpvn(sv, "\0)", 1); /* Use NUL as q//-delimiter. */
+ sv_catpvs(sv, " split(/,/,q");
+ sv_catpvs(sv, "\0"); /* Use NUL as q//-delimiter. */
sv_catpv(sv, ++s);
- sv_catpvn(sv, "\0)", 2);
+ sv_catpvs(sv, "\0)");
}
s += strlen(s);
if (!PL_preambleav)
upg_version(PL_patchlevel);
#if !defined(DGUX)
PerlIO_printf(PerlIO_stdout(),
- Perl_form(aTHX_ "\nThis is perl, %"SVf" built for %s",
+ Perl_form(aTHX_ "\nThis is perl, %"SVf
+#ifdef PERL_PATCHNUM
+ " DEVEL" STRINGIFY(PERL_PATCHNUM)
+#endif
+ " built for %s",
vstringify(PL_patchlevel),
ARCHNAME));
#else /* DGUX */
default:
Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
}
- return Nullch;
+ return NULL;
}
/* compliments of Tom Christiansen */
extern int etext;
prog = newSVpv(BIN_EXP, 0);
- sv_catpv(prog, "/perl");
+ sv_catpvs(prog, "/perl");
file = newSVpv(PL_origfilename, 0);
- sv_catpv(file, ".perldump");
+ sv_catpvs(file, ".perldump");
unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
/* unexec prints msg to stderr in case of failure */
# ifdef VMS
# include <lib$routines.h>
lib$signal(SS$_DEBUG); /* ssdef.h #included from vmsish.h */
+# elif defined(WIN32) || defined(__CYGWIN__)
+ Perl_croak(aTHX_ "dump is not supported");
# else
ABORT(); /* for use with undump */
# endif
STATIC void
S_init_interp(pTHX)
{
-
+ dVAR;
#ifdef MULTIPLICITY
# define PERLVAR(var,type)
# define PERLVARA(var,n,type)
STATIC void
S_init_main_stash(pTHX)
{
+ dVAR;
GV *gv;
PL_curstash = PL_defstash = newHV();
/* We know that the string "main" will be in the global shared string
table, so it's a small saving to use it rather than allocate another
8 bytes. */
- PL_curstname = newSVpvn_share("main", 4, 0);
- gv = gv_fetchpv("main::",TRUE, SVt_PVHV);
+ PL_curstname = newSVpvs_share("main");
+ gv = gv_fetchpvs("main::", GV_ADD|GV_NOTQUAL, SVt_PVHV);
/* If we hadn't caused another reference to "main" to be in the shared
string table above, then it would be worth reordering these two,
because otherwise all we do is delete "main" from it as a consequence
hv_name_set(PL_defstash, "main", 4, 0);
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
SvREADONLY_on(gv);
- PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
+ PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL,
+ SVt_PVAV)));
SvREFCNT_inc(PL_incgv); /* Don't allow it to be freed */
GvMULTI_on(PL_incgv);
- PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
+ PL_hintgv = gv_fetchpvs("\010", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^H */
GvMULTI_on(PL_hintgv);
- PL_defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
+ PL_defgv = gv_fetchpvs("_", GV_ADD|GV_NOTQUAL, SVt_PVAV);
SvREFCNT_inc(PL_defgv);
- PL_errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+ PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD|GV_NOTQUAL, SVt_PV));
SvREFCNT_inc(PL_errgv);
GvMULTI_on(PL_errgv);
- PL_replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */
+ PL_replgv = gv_fetchpvs("\022", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^R */
GvMULTI_on(PL_replgv);
(void)Perl_form(aTHX_ "%240s",""); /* Preallocate temp - for immediate signals. */
#ifdef PERL_DONT_CREATE_GVSV
sv_setpvn(ERRSV, "", 0);
PL_curstash = 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));
+ PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
+ PL_globalstash = GvHV(gv_fetchpvs("CORE::GLOBAL::", GV_ADDMULTI,
+ SVt_PVHV));
/* We must init $/ before switches are processed. */
sv_setpvn(get_sv("/", TRUE), "\n", 1);
}
PL_suidscript = -1;
if (PL_e_script) {
- PL_origfilename = savepvn("-e", 2);
+ PL_origfilename = savepvs("-e");
}
else {
/* if find_script() returns, it returns a malloc()-ed value */
#else /* IAMSUID */
else if (PL_preprocess) {
const char * const cpp_cfg = CPPSTDIN;
- SV * const cpp = newSVpvn("",0);
- SV * const cmd = NEWSV(0,0);
+ SV * const cpp = newSVpvs("");
+ SV * const cmd = newSV(0);
if (cpp_cfg[0] == 0) /* PERL_MICRO? */
Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
sv_catpv(cpp, cpp_cfg);
# ifndef VMS
- sv_catpvn(sv, "-I", 2);
+ sv_catpvs(sv, "-I");
sv_catpv(sv,PRIVLIB_EXP);
# endif
PL_doswitches = FALSE; /* -s is insecure in suid */
/* PSz 13 Nov 03 But -s was caught elsewhere ... so unsetting it here is useless(?!) */
CopLINE_inc(PL_curcop);
+ if (sv_gets(PL_linestr, PL_rsfp, 0) == NULL)
+ Perl_croak(aTHX_ "No #! line");
linestr = SvPV_nolen_const(PL_linestr);
- if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
- strnNE(linestr,"#!",2) ) /* required even on Sys V */
+ /* required even on Sys V */
+ if (!*linestr || !linestr[1] || strnNE(linestr,"#!",2))
Perl_croak(aTHX_ "No #! line");
- linestr+=2;
+ linestr += 2;
s = linestr;
/* PSz 27 Feb 04 */
/* Sanity check on line length */
STATIC void
S_find_beginning(pTHX)
{
+ dVAR;
register char *s;
register const char *s2;
#ifdef MACOS_TRADITIONAL
/* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
while (PL_doextract || gMacPerl_AlwaysExtract) {
- if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
+ if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == NULL) {
if (!gMacPerl_AlwaysExtract)
Perl_croak(aTHX_ "No Perl script found in input\n");
}
#else
while (PL_doextract) {
- if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
+ if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == NULL)
Perl_croak(aTHX_ "No Perl script found in input\n");
#endif
s2 = s;
STATIC void
S_init_ids(pTHX)
{
+ dVAR;
PL_uid = PerlProc_getuid();
PL_euid = PerlProc_geteuid();
PL_gid = PerlProc_getgid();
STATIC void
S_forbid_setid(pTHX_ const char *s)
{
+ dVAR;
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
if (PL_euid != PL_uid)
Perl_croak(aTHX_ "No %s allowed while running setuid", s);
void
Perl_init_debugger(pTHX)
{
+ dVAR;
HV * const ostash = PL_curstash;
PL_curstash = PL_debstash;
- PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("DB::args", GV_ADDMULTI, SVt_PVAV))));
+ PL_dbargs = GvAV(gv_AVadd((gv_fetchpvs("DB::args", GV_ADDMULTI,
+ SVt_PVAV))));
AvREAL_off(PL_dbargs);
- PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
- PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
- PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
- PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
+ PL_DBgv = gv_fetchpvs("DB::DB", GV_ADDMULTI, SVt_PVGV);
+ PL_DBline = gv_fetchpvs("DB::dbline", GV_ADDMULTI, SVt_PVAV);
+ PL_DBsub = gv_HVadd(gv_fetchpvs("DB::sub", GV_ADDMULTI, SVt_PVHV));
+ PL_DBsingle = GvSV((gv_fetchpvs("DB::single", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsingle, 0);
- PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
+ PL_DBtrace = GvSV((gv_fetchpvs("DB::trace", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBtrace, 0);
- PL_DBsignal = GvSV((gv_fetchpv("DB::signal", GV_ADDMULTI, SVt_PV)));
+ PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBsignal, 0);
- PL_DBassertion = GvSV((gv_fetchpv("DB::assertion", GV_ADDMULTI, SVt_PV)));
+ PL_DBassertion = GvSV((gv_fetchpvs("DB::assertion", GV_ADDMULTI, SVt_PV)));
sv_setiv(PL_DBassertion, 0);
PL_curstash = ostash;
}
void
Perl_init_stacks(pTHX)
{
+ dVAR;
/* start with 128-item stack and 8K cxstack */
PL_curstackinfo = new_stackinfo(REASONABLE(128),
REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
STATIC void
S_nuke_stacks(pTHX)
{
+ dVAR;
while (PL_curstackinfo->si_next)
PL_curstackinfo = PL_curstackinfo->si_next;
while (PL_curstackinfo) {
STATIC void
S_init_lexer(pTHX)
{
+ dVAR;
PerlIO *tmpfp;
tmpfp = PL_rsfp;
PL_rsfp = Nullfp;
lex_start(PL_linestr);
PL_rsfp = tmpfp;
- PL_subname = newSVpvn("main",4);
+ PL_subname = newSVpvs("main");
}
STATIC void
S_init_predump_symbols(pTHX)
{
+ dVAR;
GV *tmpgv;
IO *io;
sv_setpvn(get_sv("\"", TRUE), " ", 1);
- PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
+ PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stdingv);
io = GvIOp(PL_stdingv);
IoTYPE(io) = IoTYPE_RDONLY;
IoIFP(io) = PerlIO_stdin();
- tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
+ tmpgv = gv_fetchpvs("stdin", GV_ADD|GV_NOTQUAL, SVt_PV);
GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
- tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
+ tmpgv = gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(tmpgv);
io = GvIOp(tmpgv);
IoTYPE(io) = IoTYPE_WRONLY;
IoOFP(io) = IoIFP(io) = PerlIO_stdout();
setdefout(tmpgv);
- tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
+ tmpgv = gv_fetchpvs("stdout", GV_ADD|GV_NOTQUAL, SVt_PV);
GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
- PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
+ PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD|GV_NOTQUAL, SVt_PVIO);
GvMULTI_on(PL_stderrgv);
io = GvIOp(PL_stderrgv);
IoTYPE(io) = IoTYPE_WRONLY;
IoOFP(io) = IoIFP(io) = PerlIO_stderr();
- tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
+ tmpgv = gv_fetchpvs("stderr", GV_ADD|GV_NOTQUAL, SVt_PV);
GvMULTI_on(tmpgv);
GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
- PL_statname = NEWSV(66,0); /* last filename we did stat on */
+ PL_statname = newSV(0); /* last filename we did stat on */
Safefree(PL_osname);
PL_osname = savepv(OSNAME);
void
Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
{
+ dVAR;
argc--,argv++; /* skip name of script */
if (PL_doswitches) {
for (; argc > 0 && **argv == '-'; argc--,argv++) {
break;
}
if ((s = strchr(argv[0], '='))) {
- *s++ = '\0';
- sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
+ const char *const start_name = argv[0] + 1;
+ sv_setpv(GvSV(gv_fetchpvn_flags(start_name, s - start_name,
+ TRUE, SVt_PV)), s + 1);
}
else
- sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
+ sv_setiv(GvSV(gv_fetchpv(argv[0]+1, GV_ADD, SVt_PV)),1);
}
}
- if ((PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV))) {
+ if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD|GV_NOTQUAL, SVt_PVAV))) {
GvMULTI_on(PL_argvgv);
(void)gv_AVadd(PL_argvgv);
av_clear(GvAVn(PL_argvgv));
dVAR;
GV* tmpgv;
- PL_toptarget = NEWSV(0,0);
+ PL_toptarget = newSV(0);
sv_upgrade(PL_toptarget, SVt_PVFM);
sv_setpvn(PL_toptarget, "", 0);
- PL_bodytarget = NEWSV(0,0);
+ PL_bodytarget = newSV(0);
sv_upgrade(PL_bodytarget, SVt_PVFM);
sv_setpvn(PL_bodytarget, "", 0);
PL_formtarget = PL_bodytarget;
init_argv_symbols(argc,argv);
- if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {
+ if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) {
#ifdef MACOS_TRADITIONAL
/* $0 is not majick on a Mac */
sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename));
magicname("0", "0", 1);
#endif
}
- if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
+ if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) {
HV *hv;
GvMULTI_on(PL_envgv);
hv = GvHVn(PL_envgv);
# endif
)
{
- environ[0] = Nullch;
+ environ[0] = NULL;
}
if (env) {
char** origenv = environ;
#endif /* !PERL_MICRO */
}
TAINT_NOT;
- if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
+ if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
SvREADONLY_on(GvSV(tmpgv));
STATIC void
S_init_perllib(pTHX)
{
+ dVAR;
char *s;
if (!PL_tainting) {
#ifndef VMS
#ifdef MACOS_TRADITIONAL
{
Stat_t tmpstatbuf;
- SV * privdir = NEWSV(55, 0);
+ SV * privdir = newSV(0);
char * macperl = PerlEnv_getenv("MACPERL");
if (!macperl)
STATIC SV *
S_incpush_if_exists(pTHX_ SV *dir)
{
+ dVAR;
Stat_t tmpstatbuf;
if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode)) {
av_push(GvAVn(PL_incgv), dir);
- dir = NEWSV(0,0);
+ dir = newSV(0);
}
return dir;
}
S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
bool canrelocate)
{
+ dVAR;
SV *subdir = Nullsv;
const char *p = dir;
return;
if (addsubdirs || addoldvers) {
- subdir = NEWSV(0,0);
+ subdir = newSV(0);
}
/* Break at all separators */
while (p && *p) {
- SV *libdir = NEWSV(55,0);
+ SV *libdir = newSV(0);
const char *s;
/* skip any consecutive separators */
if (usesep) {
while ( *p == PERLLIB_SEP ) {
/* Uncomment the next line for PATH semantics */
- /* av_push(GvAVn(PL_incgv), newSVpvn(".", 1)); */
+ /* av_push(GvAVn(PL_incgv), newSVpvs(".")); */
p++;
}
}
- if ( usesep && (s = strchr(p, PERLLIB_SEP)) != Nullch ) {
+ if ( usesep && (s = strchr(p, PERLLIB_SEP)) != NULL ) {
sv_setpvn(libdir, PERLLIB_MANGLE(p, (STRLEN)(s - p)),
(STRLEN)(s - p));
p = s + 1;
}
else {
sv_setpv(libdir, PERLLIB_MANGLE(p, 0));
- p = Nullch; /* break out */
+ p = NULL; /* break out */
}
#ifdef MACOS_TRADITIONAL
if (!strchr(SvPVX(libdir), ':')) {
sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0));
}
if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
- sv_catpv(libdir, ":");
+ sv_catpvs(libdir, ":");
#endif
/* Do the if() outside the #ifdef to avoid warnings about an unused
char *unix;
STRLEN len;
- if ((unix = tounixspec_ts(SvPV(libdir,len),Nullch)) != Nullch) {
+ if ((unix = tounixspec_ts(SvPV(libdir,len),NULL)) != NULL) {
len = strlen(unix);
while (unix[len-1] == '/') len--; /* Cosmetic */
sv_usepvn(libdir,unix,len);
* because sv_setpvn does SvTAINT and the taint
* fields thread selfness being set.
*/
- PL_toptarget = NEWSV(0,0);
+ PL_toptarget = newSV(0);
sv_upgrade(PL_toptarget, SVt_PVFM);
sv_setpvn(PL_toptarget, "", 0);
- PL_bodytarget = NEWSV(0,0);
+ PL_bodytarget = newSV(0);
sv_upgrade(PL_bodytarget, SVt_PVFM);
sv_setpvn(PL_bodytarget, "", 0);
PL_formtarget = PL_bodytarget;
- thr->errsv = newSVpvn("", 0);
+ thr->errsv = newSVpvs("");
(void) find_threadsv("@"); /* Ensure $@ is initialised early */
PL_maxscream = -1;
PL_curcop = &PL_compiling;
CopLINE_set(PL_curcop, oldline);
if (paramList == PL_beginav)
- sv_catpv(atsv, "BEGIN failed--compilation aborted");
+ sv_catpvs(atsv, "BEGIN failed--compilation aborted");
else
Perl_sv_catpvf(aTHX_ atsv,
"%s failed--call queue aborted",
STATIC void *
S_call_list_body(pTHX_ CV *cv)
{
+ dVAR;
PUSHMARK(PL_stack_sp);
call_sv((SV*)cv, G_EVAL|G_DISCARD);
return NULL;
void
Perl_my_exit(pTHX_ U32 status)
{
+ dVAR;
DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
thr, (unsigned long) status));
switch (status) {
void
Perl_my_failure_exit(pTHX)
{
+ dVAR;
#ifdef VMS
/* We have been called to fall on our sword. The desired exit code
* should be already set in STATUS_UNIX, but could be shifted over
static I32
read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
{
+ dVAR;
const char * const p = SvPVX_const(PL_e_script);
const char *nl = strchr(p, '\n');
https://perl5.git.perl.org / perl5.git / blobdiff