summaryrefslogtreecommitdiff
path: root/perl.c
diff options
context:
space:
mode:
Diffstat (limited to 'perl.c')
-rw-r--r--perl.c83
1 files changed, 82 insertions, 1 deletions
diff --git a/perl.c b/perl.c
index 02a889d33d..78fb2e3a70 100644
--- a/perl.c
+++ b/perl.c
@@ -194,6 +194,9 @@ void
Perl_sys_init(int* argc, char*** argv)
{
dVAR;
+
+ PERL_ARGS_ASSERT_SYS_INIT;
+
PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
PERL_UNUSED_ARG(argv);
PERL_SYS_INIT_BODY(argc, argv);
@@ -203,6 +206,9 @@ void
Perl_sys_init3(int* argc, char*** argv, char*** env)
{
dVAR;
+
+ PERL_ARGS_ASSERT_SYS_INIT3;
+
PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
PERL_UNUSED_ARG(argv);
PERL_UNUSED_ARG(env);
@@ -228,6 +234,9 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
struct IPerlProc* ipP)
{
PerlInterpreter *my_perl;
+
+ PERL_ARGS_ASSERT_PERL_ALLOC_USING;
+
/* Newx() needs interpreter, so call malloc() instead */
my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
S_init_tls_and_interp(my_perl);
@@ -288,11 +297,14 @@ void
perl_construct(pTHXx)
{
dVAR;
- PERL_UNUSED_ARG(my_perl);
+
+ PERL_ARGS_ASSERT_PERL_CONSTRUCT;
+
#ifdef MULTIPLICITY
init_interp();
PL_perl_destruct_level = 1;
#else
+ PERL_UNUSED_ARG(my_perl);
if (PL_perl_destruct_level > 0)
init_interp();
#endif
@@ -478,6 +490,8 @@ Perl_dump_sv_child(pTHX_ SV *sv)
int returned_errno;
unsigned char buffer[256];
+ PERL_ARGS_ASSERT_DUMP_SV_CHILD;
+
if(sock == -1 || debug_fd == -1)
return;
@@ -580,7 +594,10 @@ perl_destruct(pTHXx)
pid_t child;
#endif
+ PERL_ARGS_ASSERT_PERL_DESTRUCT;
+#ifndef MULTIPLICITY
PERL_UNUSED_ARG(my_perl);
+#endif
/* wait for all pseudo-forked children to finish */
PERL_WAIT_FOR_CHILDREN;
@@ -1346,6 +1363,8 @@ perl_free(pTHXx)
{
dVAR;
+ PERL_ARGS_ASSERT_PERL_FREE;
+
if (PL_veto_cleanup)
return;
@@ -1490,7 +1509,10 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
int ret;
dJMPENV;
+ PERL_ARGS_ASSERT_PERL_PARSE;
+#ifndef MULTIPLICITY
PERL_UNUSED_ARG(my_perl);
+#endif
#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now "
@@ -2271,7 +2293,10 @@ perl_run(pTHXx)
int ret = 0;
dJMPENV;
+ PERL_ARGS_ASSERT_PERL_RUN;
+#ifndef MULTIPLICITY
PERL_UNUSED_ARG(my_perl);
+#endif
oldscope = PL_scopestack_ix;
#ifdef VMS
@@ -2389,6 +2414,9 @@ SV*
Perl_get_sv(pTHX_ const char *name, I32 create)
{
GV *gv;
+
+ PERL_ARGS_ASSERT_GET_SV;
+
gv = gv_fetchpv(name, create, SVt_PV);
if (gv)
return GvSV(gv);
@@ -2411,6 +2439,9 @@ AV*
Perl_get_av(pTHX_ const char *name, I32 create)
{
GV* const gv = gv_fetchpv(name, create, SVt_PVAV);
+
+ PERL_ARGS_ASSERT_GET_AV;
+
if (create)
return GvAVn(gv);
if (gv)
@@ -2434,6 +2465,9 @@ HV*
Perl_get_hv(pTHX_ const char *name, I32 create)
{
GV* const gv = gv_fetchpv(name, create, SVt_PVHV);
+
+ PERL_ARGS_ASSERT_GET_HV;
+
if (create)
return GvHVn(gv);
if (gv)
@@ -2466,6 +2500,9 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
/* XXX this is probably not what they think they're getting.
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
+
+ PERL_ARGS_ASSERT_GET_CVN_FLAGS;
+
if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
return newSUB(start_subparse(FALSE, 0),
@@ -2480,6 +2517,8 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
CV*
Perl_get_cv(pTHX_ const char *name, I32 flags)
{
+ PERL_ARGS_ASSERT_GET_CV;
+
return get_cvn_flags(name, strlen(name), flags);
}
@@ -2505,6 +2544,8 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
dVAR;
dSP;
+ PERL_ARGS_ASSERT_CALL_ARGV;
+
PUSHMARK(SP);
if (argv) {
while (*argv) {
@@ -2529,6 +2570,8 @@ Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
/* name of the subroutine */
/* See G_* flags in cop.h */
{
+ PERL_ARGS_ASSERT_CALL_PV;
+
return call_sv((SV*)get_cv(sub_name, TRUE), flags);
}
@@ -2546,6 +2589,8 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
/* name of the subroutine */
/* See G_* flags in cop.h */
{
+ PERL_ARGS_ASSERT_CALL_METHOD;
+
return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
}
@@ -2574,6 +2619,8 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
OP* const oldop = PL_op;
dJMPENV;
+ PERL_ARGS_ASSERT_CALL_SV;
+
if (flags & G_DISCARD) {
ENTER;
SAVETMPS;
@@ -2705,6 +2752,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
OP* const oldop = PL_op;
dJMPENV;
+ PERL_ARGS_ASSERT_EVAL_SV;
+
if (flags & G_DISCARD) {
ENTER;
SAVETMPS;
@@ -2791,6 +2840,8 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
dSP;
SV* sv = newSVpv(p, 0);
+ PERL_ARGS_ASSERT_EVAL_PV;
+
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
@@ -2824,6 +2875,9 @@ Perl_require_pv(pTHX_ const char *pv)
dVAR;
dSP;
SV* sv;
+
+ PERL_ARGS_ASSERT_REQUIRE_PV;
+
PUSHSTACKi(PERLSI_REQUIRE);
PUTBACK;
sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
@@ -2837,6 +2891,8 @@ Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
{
register GV * const gv = gv_fetchpv(sym, GV_ADD, SVt_PV);
+ PERL_ARGS_ASSERT_MAGICNAME;
+
if (gv)
sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
}
@@ -2881,6 +2937,8 @@ NULL
};
const char * const *p = usage_msg;
+ PERL_ARGS_ASSERT_USAGE;
+
PerlIO_printf(PerlIO_stdout(),
"\nUsage: %s [switches] [--] [programfile] [arguments]",
name);
@@ -2923,6 +2981,9 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
NULL
};
int i = 0;
+
+ PERL_ARGS_ASSERT_GET_DEBUG_OPTS;
+
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
@@ -2961,6 +3022,8 @@ Perl_moreswitches(pTHX_ const char *s)
dVAR;
UV rschar;
+ PERL_ARGS_ASSERT_MORESWITCHES;
+
switch (*s) {
case '0':
{
@@ -3504,6 +3567,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch,
int fdscript = -1;
dVAR;
+ PERL_ARGS_ASSERT_OPEN_SCRIPT;
+
if (PL_e_script) {
PL_origfilename = savepvs("-e");
}
@@ -3786,6 +3851,8 @@ S_validate_suid(pTHX_ const char *validarg,
dVAR;
const char *s, *s2;
+ PERL_ARGS_ASSERT_VALIDATE_SUID;
+
/* do we need to emulate setuid on scripts? */
/* This code is for those BSD systems that have setuid #! scripts disabled
@@ -4164,6 +4231,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
STATIC void
S_validate_suid(pTHX_ PerlIO *rsfp)
{
+ PERL_ARGS_ASSERT_VALIDATE_SUID;
+
if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */
# ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
@@ -4191,6 +4260,8 @@ S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
int maclines = 0;
#endif
+ PERL_ARGS_ASSERT_FIND_BEGINNING;
+
/* skip forward in input to the real script? */
#ifdef MACOS_TRADITIONAL
@@ -4496,6 +4567,9 @@ void
Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
{
dVAR;
+
+ PERL_ARGS_ASSERT_INIT_ARGV_SYMBOLS;
+
argc--,argv++; /* skip name of script */
if (PL_doswitches) {
for (; argc > 0 && **argv == '-'; argc--,argv++) {
@@ -4538,6 +4612,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
dVAR;
GV* tmpgv;
+ PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
+
PL_toptarget = newSV_type(SVt_PVFM);
sv_setpvn(PL_toptarget, "", 0);
PL_bodytarget = newSV_type(SVt_PVFM);
@@ -4768,6 +4844,9 @@ S_incpush_if_exists(pTHX_ SV *dir)
{
dVAR;
Stat_t tmpstatbuf;
+
+ PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS;
+
if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
S_ISDIR(tmpstatbuf.st_mode)) {
av_push(GvAVn(PL_incgv), dir);
@@ -5011,6 +5090,8 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
int ret;
dJMPENV;
+ PERL_ARGS_ASSERT_CALL_LIST;
+
while (av_len(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
if (PL_savebegin) {
View Lorry Controller Status