Skip to content

factor out 3 high usage COND_*() API croak() messages on Win32 #23344

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: blead
Choose a base branch
from
Open

factor out 3 high usage COND_*() API croak() messages on Win32 #23344

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6463,6 +6463,9 @@ Cp |int |do_spawn |NN char *cmd
Cp |int |do_spawn_nowait|NN char *cmd
#endif
#if defined(WIN32)
TXpr |void |die_cbrod
TXpr |void |die_csig
TXpr |void |die_cwait
CRTdp |void * |get_context
p |bool |get_win32_message_utf8ness \
|NULLOK const char *string
Expand Down
3 changes: 3 additions & 0 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1767,6 +1767,9 @@
# define quadmath_format_valid Perl_quadmath_format_valid
# endif
# if defined(WIN32)
# define die_cbrod Perl_die_cbrod
# define die_csig Perl_die_csig
# define die_cwait Perl_die_cwait
# define get_win32_message_utf8ness(a) Perl_get_win32_message_utf8ness(aTHX_ a)
# else
# define do_exec3(a,b,c) Perl_do_exec3(aTHX_ a,b,c)
Expand Down
15 changes: 15 additions & 0 deletions proto.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

41 changes: 41 additions & 0 deletions util.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2004,6 +2004,47 @@ Perl_croak_popstack(void)
my_exit(1);
}


/* Helpers for COND_BROADCAST(c), COND_SIGNAL(c), and COND_WAIT(c) macros
which are long and verbose, and get embedded directly in their callers
and have dozens of callsites inside libperl and certain categories of
CPAN XS modules. The other COND_*() macros are very unlikely to ever
be used outside of libperl's perl_construct()/perl_destruct().

The pthreads variants of COND_BROADCAST/COND_SIGNAL/COND_WAIT currently
have assert() style error strings that are too big to factor out. */

#ifdef WIN32

STATIC void
Perl_die_w32err(const char *context)
{
DWORD e = GetLastError();
Perl_croak_nocontext("panic: %s (%ld)", context, e);
}

/* These 3 helpers prevent the same const C string literals appearing in many
.dll files over and over. */
void
Perl_die_cbrod(void)
{
Perl_die_w32err("COND_BROADCAST");
}

void
Perl_die_cwait(void)
{
Perl_die_w32err("COND_WAIT");
}

void
Perl_die_csig(void)
{
Perl_die_w32err("COND_SIGNAL");
}

#endif

/*
=for apidoc warn_sv

Expand Down
14 changes: 9 additions & 5 deletions win32/win32thread.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,10 @@ typedef CRITICAL_SECTION perl_mutex;

#else

/* This backend is unused since
commit d55594aef6 - Gurusamy Sarathy - 11/9/1997 7:57:53 PM
Initial (untested) merge of all non-ansi changes on ansiperl branch */

typedef HANDLE perl_mutex;
# define MUTEX_INIT(m) \
STMT_START { \
Expand All @@ -46,7 +50,7 @@ typedef HANDLE perl_mutex;
Perl_croak_nocontext("panic: MUTEX_DESTROY"); \
} STMT_END

#endif
#endif /* DONT_USE_CRITICAL_SECTION */

/* These macros assume that the mutex associated with the condition
* will always be held before COND_{SIGNAL,BROADCAST,WAIT,DESTROY},
Expand All @@ -57,21 +61,21 @@ typedef HANDLE perl_mutex;
(c)->waiters = 0; \
(c)->sem = Win_CreateSemaphore(NULL,0,LONG_MAX,NULL); \
if ((c)->sem == NULL) \
Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \
Perl_die_cwait(); \
} STMT_END

#define COND_SIGNAL(c) \
STMT_START { \
if ((c)->waiters > 0 && \
ReleaseSemaphore((c)->sem,1,NULL) == 0) \
Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError()); \
Perl_die_csig(); \
} STMT_END

#define COND_BROADCAST(c) \
STMT_START { \
if ((c)->waiters > 0 && \
ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \
Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\
Perl_die_cbrod();\
} STMT_END

#define COND_WAIT(c, m) \
Expand All @@ -82,7 +86,7 @@ typedef HANDLE perl_mutex;
* COND_BROADCAST() on another thread will have seen the\
* right number of waiters (i.e. including this one) */ \
if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\
Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError()); \
Perl_die_cwait(); \
/* XXX there may be an inconsequential race here */ \
MUTEX_LOCK(m); \
(c)->waiters--; \
Expand Down
Loading