int
main(int argc, char **argv, char **env)
#endif
{
dVAR;
int exitstatus, i;
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars *plvarsp = init_global_struct();
# ifdef PERL_GLOBAL_STRUCT_PRIVATE
my_vars = my_plvarsp = plvarsp;
# endif
#endif /* PERL_GLOBAL_STRUCT */
(void)env;
#ifndef PERL_USE_SAFE_PUTENV
PL_use_safe_putenv = 0;
#endif /* PERL_USE_SAFE_PUTENV */
/* if user wants control of gprof profiling off by default */
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
PERL_GPROF_MONCONTROL(0);
#ifdef NO_ENV_ARRAY_IN_MAIN
PERL_SYS_INIT3(&argc,&argv,&environ);
#else
PERL_SYS_INIT3(&argc,&argv,&env);
#endif
if (!PL_do_undump) {
my_perl = perl_alloc();
if (!my_perl)
exit(1);
perl_construct(my_perl);
PL_perl_destruct_level = 0;
}
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
if (!exitstatus)
perl_run(my_perl);
/* Unregister our signal handler before destroying my_perl */
for (i = 0; PL_sig_name[i]; i++) {
if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) {
rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL);
}
}
exitstatus = perl_destruct(my_perl);
perl_free(my_perl);
#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
/*
* The old environment may have been freed by perl_free()
* when PERL_TRACK_MEMPOOL is defined, but without having
* been restored by perl_destruct() before (this is only
* done if destruct_level > 0).
*
* It is important to have a valid environment for atexit()
* routines that are eventually called.
*/
environ = env;
#endif
#ifdef PERL_GLOBAL_STRUCT
free_global_struct(plvarsp);
#endif /* PERL_GLOBAL_STRUCT */
PERL_SYS_TERM();
exit(exitstatus);
return exitstatus;
}
int
main(int argc, char **argv, char **env)
#endif
{
dVAR;
int exitstatus, i;
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars *plvarsp = init_global_struct();
# ifdef PERL_GLOBAL_STRUCT_PRIVATE
my_vars = my_plvarsp = plvarsp;
# endif
#endif /* PERL_GLOBAL_STRUCT */
(void)env;
#ifndef PERL_USE_SAFE_PUTENV
PL_use_safe_putenv = 0;
#endif /* PERL_USE_SAFE_PUTENV */
/* if user wants control of gprof profiling off by default */
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */
PERL_GPROF_MONCONTROL(0);
#ifdef NO_ENV_ARRAY_IN_MAIN
PERL_SYS_INIT3(&argc,&argv,&environ);
#else
PERL_SYS_INIT3(&argc,&argv,&env);
#endif
#if defined(USE_ITHREADS)
/* XXX Ideally, this should really be happening in perl_alloc() or
* perl_construct() to keep libperl.a transparently fork()-safe.
* It is currently done here only because Apache/mod_perl have
* problems due to lack of a call to cancel pthread_atfork()
* handlers when shared objects that contain the handlers may
* be dlclose()d. This forces applications that embed perl to
* call PTHREAD_ATFORK() explicitly, but if and only if it hasn't
* been called at least once before in the current process.
* --GSAR 2001-07-20 */
PTHREAD_ATFORK(Perl_atfork_lock,
Perl_atfork_unlock,
Perl_atfork_unlock);
#endif
if (!PL_do_undump) {
my_perl = perl_alloc();
if (!my_perl)
exit(1);
perl_construct(my_perl);
PL_perl_destruct_level = 0;
}
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL);
if (!exitstatus)
perl_run(my_perl);
/* Unregister our signal handler before destroying my_perl */
for (i = 0; PL_sig_name[i]; i++) {
if (rsignal_state(PL_sig_num[i]) == (Sighandler_t) PL_csighandlerp) {
rsignal(PL_sig_num[i], (Sighandler_t) SIG_DFL);
}
}
exitstatus = perl_destruct(my_perl);
perl_free(my_perl);
#if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN)
/*
* The old environment may have been freed by perl_free()
* when PERL_TRACK_MEMPOOL is defined, but without having
* been restored by perl_destruct() before (this is only
* done if destruct_level > 0).
*
* It is important to have a valid environment for atexit()
* routines that are eventually called.
*/
environ = env;
#endif
#ifdef PERL_GLOBAL_STRUCT
free_global_struct(plvarsp);
#endif /* PERL_GLOBAL_STRUCT */
PERL_SYS_TERM();
exit(exitstatus);
return exitstatus;
}
void
S_signals_set_handler(SV* handlersv, SV* namesv)
{
I32 i;
/* Need to be careful with SvREFCNT_dec(), because that can have side
* effects (due to closures). We must make sure that the new disposition
* is in place before it is called.
*/
SV* to_dec = NULL;
STRLEN len;
const char *s;
bool set_to_ignore = FALSE;
bool set_to_default = FALSE;
#ifdef HAS_SIGPROCMASK
sigset_t set, save;
SV* save_sv;
#endif
if ( SvROK(handlersv) ) {
if ( SvTYPE(SvRV(handlersv)) != SVt_PVCV )
Perl_croak(aTHX_ "signal handler should be a code refernce, 'DEFAULT' or 'IGNORE'");
} else {
const char *s = SvOK(handlersv) ? SvPV_const(handlersv, len) : "DEFAULT";
if ( strEQ(s,"IGNORE") )
set_to_ignore = TRUE;
else if (strEQ(s,"DEFAULT"))
set_to_default = TRUE;
else
Perl_croak(aTHX_ "signal handler should be a code reference or 'DEFAULT or 'IGNORE'");
}
if (!PL_psig_ptr) {
Newxz(PL_psig_ptr, SIG_SIZE, SV*);
Newxz(PL_psig_name, SIG_SIZE, SV*);
Newxz(PL_psig_pend, SIG_SIZE, int);
}
s = SvPV_const(namesv,len);
i = whichsig(s); /* ...no, a brick */
if (i <= 0) {
Perl_croak(aTHX_ "No such signal: SIG%s", s);
}
#ifdef HAS_SIGPROCMASK
/* Avoid having the signal arrive at a bad time, if possible. */
sigemptyset(&set);
sigaddset(&set,i);
sigprocmask(SIG_BLOCK, &set, &save);
ENTER;
save_sv = newSVpvn((char *)(&save), sizeof(sigset_t));
SAVEFREESV(save_sv);
SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
#endif
PERL_ASYNC_CHECK();
#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
if (!PL_sig_handlers_initted) Perl_csighandler_init();
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
PL_sig_ignoring[i] = 0;
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
PL_sig_defaulting[i] = 0;
#endif
SvREFCNT_dec(PL_psig_name[i]);
to_dec = PL_psig_ptr[i];
PL_psig_ptr[i] = NULL;
PL_psig_name[i] = newSVpvn(s, len);
SvREADONLY_on(PL_psig_name[i]);
if (SvROK(handlersv)) {
PL_psig_ptr[i] = SvREFCNT_inc(SvRV(handlersv));
(void)rsignal(i, PL_csighandlerp);
#ifdef HAS_SIGPROCMASK
LEAVE;
#endif
if(to_dec)
SvREFCNT_dec(to_dec);
return;
}
if (set_to_ignore) {
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
PL_sig_ignoring[i] = 1;
(void)rsignal(i, PL_csighandlerp);
#else
(void)rsignal(i, (Sighandler_t) SIG_IGN);
#endif
}
else {
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
PL_sig_defaulting[i] = 1;
(void)rsignal(i, PL_csighandlerp);
#else
(void)rsignal(i, (Sighandler_t) SIG_DFL);
#endif
}
#ifdef HAS_SIGPROCMASK
if(i)
LEAVE;
#endif
if(to_dec)
SvREFCNT_dec(to_dec);
}
