This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
amigaos4: neither sched_yield nor pthread_yield
[perl5.git]
/
dist
/
threads
/
threads.xs
diff --git
a/dist/threads/threads.xs
b/dist/threads/threads.xs
index
f6fe7dc
..
3b38367
100644
(file)
--- a/
dist/threads/threads.xs
+++ b/
dist/threads/threads.xs
@@
-28,9
+28,20
@@
#ifndef sv_dup_inc
# define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t))
#endif
#ifndef sv_dup_inc
# define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t))
#endif
+#ifndef PERL_UNUSED_RESULT
+# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
+# else
+# define PERL_UNUSED_RESULT(v) ((void)(v))
+# endif
+#endif
#ifdef USE_ITHREADS
#ifdef USE_ITHREADS
+#if defined(__amigaos4__)
+# undef YIELD
+# define YIELD sleep(0)
+#endif
#ifdef WIN32
# include <windows.h>
/* Supposed to be in Winbase.h */
#ifdef WIN32
# include <windows.h>
/* Supposed to be in Winbase.h */
@@
-346,7
+357,7
@@
S_exit_warning(pTHX)
/* Called from perl_destruct() in each thread. If it's the main thread,
* stop it from freeing everything if there are other threads still running.
*/
/* Called from perl_destruct() in each thread. If it's the main thread,
* stop it from freeing everything if there are other threads still running.
*/
-int
+
STATIC
int
Perl_ithread_hook(pTHX)
{
dMY_POOL;
Perl_ithread_hook(pTHX)
{
dMY_POOL;
@@
-356,7
+367,7
@@
Perl_ithread_hook(pTHX)
/* MAGIC (in mg.h sense) hooks */
/* MAGIC (in mg.h sense) hooks */
-int
+
STATIC
int
ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *)mg->mg_ptr;
ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *)mg->mg_ptr;
@@
-365,7
+376,7
@@
ithread_mg_get(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
return (0);
}
-int
+
STATIC
int
ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *)mg->mg_ptr;
ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
ithread *thread = (ithread *)mg->mg_ptr;
@@
-375,7
+386,7
@@
ithread_mg_free(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
return (0);
}
-int
+
STATIC
int
ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
{
PERL_UNUSED_ARG(param);
ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
{
PERL_UNUSED_ARG(param);
@@
-383,14
+394,17
@@
ithread_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param)
return (0);
}
return (0);
}
-MGVTBL ithread_vtbl = {
+
STATIC const
MGVTBL ithread_vtbl = {
ithread_mg_get, /* get */
0, /* set */
0, /* len */
0, /* clear */
ithread_mg_free, /* free */
0, /* copy */
ithread_mg_get, /* get */
0, /* set */
0, /* len */
0, /* clear */
ithread_mg_free, /* free */
0, /* copy */
- ithread_mg_dup /* dup */
+ ithread_mg_dup, /* dup */
+#if (PERL_VERSION > 8) || (PERL_VERSION == 8 && PERL_SUBVERSION > 8)
+ 0 /* local */
+#endif
};
};
@@
-467,10
+481,10
@@
S_ithread_run(void * arg)
{
ithread *thread = (ithread *)arg;
int jmp_rc = 0;
{
ithread *thread = (ithread *)arg;
int jmp_rc = 0;
- I32 oldscope;
- int exit_app = 0; /* Thread terminated using 'exit' */
- int exit_code = 0;
- int died = 0; /* Thread terminated abnormally */
+
volatile
I32 oldscope;
+
volatile
int exit_app = 0; /* Thread terminated using 'exit' */
+
volatile
int exit_code = 0;
+
volatile
int died = 0; /* Thread terminated abnormally */
dJMPENV;
dJMPENV;
@@
-496,7
+510,7
@@
S_ithread_run(void * arg)
{
AV *params = thread->params;
{
AV *params = thread->params;
- int len = (int)av_len(params)+1;
+
volatile
int len = (int)av_len(params)+1;
int ii;
dSP;
int ii;
dSP;
@@
-711,7
+725,13
@@
S_ithread_create(
PERL_SET_CONTEXT(aTHX);
if (!thread) {
MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
PERL_SET_CONTEXT(aTHX);
if (!thread) {
MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
- PerlLIO_write(PerlIO_fileno(Perl_error_log), PL_no_mem, strlen(PL_no_mem));
+ {
+ int fd = PerlIO_fileno(Perl_error_log);
+ if (fd >= 0) {
+ /* If there's no error_log, we cannot scream about it missing. */
+ PERL_UNUSED_RESULT(PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)));
+ }
+ }
my_exit(1);
}
Zero(thread, 1, ithread);
my_exit(1);
}
Zero(thread, 1, ithread);
@@
-1414,7
+1434,7
@@
ithread_kill(...)
/* Set the signal for the thread */
thread = S_SV_to_ithread(aTHX_ ST(0));
MUTEX_LOCK(&thread->mutex);
/* Set the signal for the thread */
thread = S_SV_to_ithread(aTHX_ ST(0));
MUTEX_LOCK(&thread->mutex);
- if (thread->interp) {
+ if (thread->interp
&& ! (thread->state & PERL_ITHR_FINISHED)
) {
dTHXa(thread->interp);
if (PL_psig_pend && PL_psig_ptr[signal]) {
PL_psig_pend[signal]++;
dTHXa(thread->interp);
if (PL_psig_pend && PL_psig_ptr[signal]) {
PL_psig_pend[signal]++;
@@
-1422,7
+1442,7
@@
ithread_kill(...)
no_handler = 0;
}
} else {
no_handler = 0;
}
} else {
- /* Ignore signal to terminated thread */
+ /* Ignore signal to terminated
/finished
thread */
no_handler = 0;
}
MUTEX_UNLOCK(&thread->mutex);
no_handler = 0;
}
MUTEX_UNLOCK(&thread->mutex);