#define PERL_IN_UTIL_C
#include "perl.h"
+#ifndef PERL_MICRO
#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
#include <signal.h>
#endif
#ifndef SIG_ERR
# define SIG_ERR ((Sighandler_t) -1)
#endif
+#endif
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
#ifdef I_UNISTD
PerlLIO_close(p[This]);
p[This] = p[that];
}
+ MUTEX_LOCK(&PL_fdpid_mutex);
sv = *av_fetch(PL_fdpid,p[This],TRUE);
+ MUTEX_UNLOCK(&PL_fdpid_mutex);
(void)SvUPGRADE(sv,SVt_IV);
SvIVX(sv) = pid;
PL_forkprocess = pid;
}
#endif
-
+#ifndef PERL_MICRO
#ifdef HAS_SIGACTION
Sighandler_t
}
#endif /* !HAS_SIGACTION */
+#endif /* !PERL_MICRO */
/* VMS' my_pclose() is in VMS.c; same with OS/2 */
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
int saved_win32_errno;
#endif
+ MUTEX_LOCK(&PL_fdpid_mutex);
svp = av_fetch(PL_fdpid,PerlIO_fileno(ptr),TRUE);
+ MUTEX_UNLOCK(&PL_fdpid_mutex);
pid = SvIVX(*svp);
SvREFCNT_dec(*svp);
*svp = &PL_sv_undef;
#ifdef UTS
if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */
#endif
+#ifndef PERL_MICRO
rsignal_save(SIGHUP, SIG_IGN, &hstat);
rsignal_save(SIGINT, SIG_IGN, &istat);
rsignal_save(SIGQUIT, SIG_IGN, &qstat);
+#endif
do {
pid2 = wait4pid(pid, &status, 0);
} while (pid2 == -1 && errno == EINTR);
+#ifndef PERL_MICRO
rsignal_restore(SIGHUP, &hstat);
rsignal_restore(SIGINT, &istat);
rsignal_restore(SIGQUIT, &qstat);
+#endif
if (close_failed) {
SETERRNO(saved_errno, saved_vaxc_errno);
return -1;
return mg;
}
+SV *
+Perl_lock(pTHX_ SV *osv)
+{
+ MAGIC *mg;
+ SV *sv = osv;
+
+ SvLOCK(osv);
+ if (SvROK(sv)) {
+ sv = SvRV(sv);
+ SvUNLOCK(osv);
+ SvLOCK(sv);
+ }
+
+ mg = condpair_magic(sv);
+ MUTEX_LOCK(MgMUTEXP(mg));
+ if (MgOWNER(mg) == thr)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ else {
+ while (MgOWNER(mg))
+ COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+ MgOWNER(mg) = thr;
+ DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
+ PTR2UV(thr), PTR2UV(sv));)
+ MUTEX_UNLOCK(MgMUTEXP(mg));
+ SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
+ }
+ SvUNLOCK(sv);
+ return sv;
+}
+
/*
* Make a new perl thread structure using t as a prototype. Some of the
* fields for the new thread are copied from the prototype thread, t,