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);
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);
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);
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
int returned_errno;
unsigned char buffer[256];
+ PERL_ARGS_ASSERT_DUMP_SV_CHILD;
+
if(sock == -1 || debug_fd == -1)
return;
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;
{
dVAR;
+ PERL_ARGS_ASSERT_PERL_FREE;
+
if (PL_veto_cleanup)
return;
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 "
int ret = 0;
dJMPENV;
+ PERL_ARGS_ASSERT_PERL_RUN;
+#ifndef MULTIPLICITY
PERL_UNUSED_ARG(my_perl);
+#endif
oldscope = PL_scopestack_ix;
#ifdef VMS
if (!DEBUG_q_TEST)
PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
#endif
- DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
- PTR2UV(thr)));
if (PL_minus_c) {
#ifdef MACOS_TRADITIONAL
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);
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)
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)
/* 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),
CV*
Perl_get_cv(pTHX_ const char *name, I32 flags)
{
+ PERL_ARGS_ASSERT_GET_CV;
+
return get_cvn_flags(name, strlen(name), flags);
}
dVAR;
dSP;
+ PERL_ARGS_ASSERT_CALL_ARGV;
+
PUSHMARK(SP);
if (argv) {
while (*argv) {
/* 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);
}
/* 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);
}
*/
I32
-Perl_call_sv(pTHX_ SV *sv, I32 flags)
+Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
/* See G_* flags in cop.h */
{
dVAR; dSP;
OP* const oldop = PL_op;
dJMPENV;
+ PERL_ARGS_ASSERT_CALL_SV;
+
if (flags & G_DISCARD) {
ENTER;
SAVETMPS;
OP* const oldop = PL_op;
dJMPENV;
+ PERL_ARGS_ASSERT_EVAL_SV;
+
if (flags & G_DISCARD) {
ENTER;
SAVETMPS;
dSP;
SV* sv = newSVpv(p, 0);
+ PERL_ARGS_ASSERT_EVAL_PV;
+
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
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);
{
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);
}
};
const char * const *p = usage_msg;
+ PERL_ARGS_ASSERT_USAGE;
+
PerlIO_printf(PerlIO_stdout(),
"\nUsage: %s [switches] [--] [programfile] [arguments]",
name);
" H Hash dump -- usurps values()",
" X Scratchpad allocation",
" D Cleaning up",
- " S Thread synchronization",
" T Tokenising",
" R Include reference counts of dumped variables (eg when using -Ds)",
" J Do not s,t,P-debug (Jump over) opcodes within package DB",
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";
dVAR;
UV rschar;
+ PERL_ARGS_ASSERT_MORESWITCHES;
+
switch (*s) {
case '0':
{
int fdscript = -1;
dVAR;
+ PERL_ARGS_ASSERT_OPEN_SCRIPT;
+
if (PL_e_script) {
PL_origfilename = savepvs("-e");
}
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
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 */
int maclines = 0;
#endif
+ PERL_ARGS_ASSERT_FIND_BEGINNING;
+
/* skip forward in input to the real script? */
#ifdef MACOS_TRADITIONAL
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++) {
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);
{
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);
int ret;
dJMPENV;
+ PERL_ARGS_ASSERT_CALL_LIST;
+
while (av_len(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
if (PL_savebegin) {
Perl_my_exit(pTHX_ U32 status)
{
dVAR;
- DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
- (void*)thr, (unsigned long) status));
switch (status) {
case 0:
STATUS_ALL_SUCCESS;