From 6ea62109bc8fe1ef9e5482435df3099cf3bfc40d Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 3 Aug 2023 13:33:28 +1000
Subject: [PATCH] mingw 32-bit: realign the stack in our callbacks

A default 32-bit mingw build assumes the stack is 16 byte aligned,
which appears to be a problem with gcc.

With quadmath enabled, libgcc includes instructions that require
16-byte alignment and access relative to the stack pointer, and
when the stack isn't aligned, results in a crash.

To prevent that add the force_align_arg_pointer attribute to our
callbacks for 32-bit gcc on Windows.
---
 dist/threads/lib/threads.pm |  4 ++--
 dist/threads/threads.xs     |  2 +-
 mg.c                        |  1 +
 perl.h                      | 27 +++++++++++++++++++++++++++
 win32/perlhost.h            |  1 +
 5 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm
index 06485b3a121e9..2c02ba3a28062 100644
--- a/dist/threads/lib/threads.pm
+++ b/dist/threads/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '2.37';      # remember to update version in POD!
+our $VERSION = '2.38';      # remember to update version in POD!
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 2.37
+This document describes threads version 2.38
 
 =head1 WARNING
 
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 92c5fd8fe4ddb..fdcdc294ff4b2 100644
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -535,11 +535,11 @@ S_jmpenv_run(pTHX_ int action, ithread *thread,
     return jmp_rc;
 }
 
-
 /* Starts executing the thread.
  * Passed as the C level function to run in the new thread.
  */
 #ifdef WIN32
+PERL_STACK_REALIGN
 STATIC THREAD_RET_TYPE
 S_ithread_run(LPVOID arg)
 #else
diff --git a/mg.c b/mg.c
index 899cc4a2d2998..4b6d4ab622667 100644
--- a/mg.c
+++ b/mg.c
@@ -1526,6 +1526,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 }
 
 
+PERL_STACK_REALIGN
 #ifdef PERL_USE_3ARG_SIGHANDLER
 Signal_t
 Perl_csighandler(int sig, Siginfo_t *sip, void *uap)
diff --git a/perl.h b/perl.h
index a96537d88f0ac..b5379cd72e9f2 100644
--- a/perl.h
+++ b/perl.h
@@ -9099,6 +9099,33 @@ END_EXTERN_C
 
 #define PERL_PARSE_ERROR_COUNT(f)     (f)
 
+
+/* Work around
+
+  https://github.com/Perl/perl5/issues/21313
+
+  Where gcc when generating code  for 32-bit windows assumes the stack
+  is 16 byte aligned, where the system doesn't guarantee that.
+
+  The code generated by gcc itself does maintain 16 byte alignment,
+  but callbacks from the CRT or Windows APIs don't, so calls to
+  code that is generated to SSE instructions (like the quadmath code
+  by default), crashes when called from a callback.
+
+  Since other code other than quadmath might use SSE instructions,
+  also enable this outside of quadmath builds.
+
+  This change is a little risky: if an XS module uses callbacks
+  and those callbacks may also produce alignment errors, if that
+  becomes a problem we'll need to use the nuclear option: building
+  32-bit perl with -mstackrealign.
+*/
+#if defined(WIN32) && !defined(WIN64) && defined(__GNUC__)
+#  define PERL_STACK_REALIGN __attribute__((force_align_arg_pointer))
+#else
+#  define PERL_STACK_REALIGN
+#endif
+
 /*
 
    (KEEP THIS LAST IN perl.h!)
diff --git a/win32/perlhost.h b/win32/perlhost.h
index e6ef46f809cbb..9a2e24ccd3f07 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -1692,6 +1692,7 @@ PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
 }
 
 #ifdef USE_ITHREADS
+PERL_STACK_REALIGN
 static THREAD_RET_TYPE
 win32_start_child(LPVOID arg)
 {