[Git][ghc/ghc][ghc-9.0] 2 commits: Export SPEC from GHC.Exts (#13681)

[Ben Gamari]

Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC


Commits:
c94c56d5 by Sylvain Henry at 2020-11-10T11:04:03-05:00
Export SPEC from GHC.Exts (#13681)

(cherry picked from commit 4c407f6e71f096835f8671e2d3ea6bda38074314)

- - - - -
d4483f7b by Ben Gamari at 2020-11-14T06:49:57-05:00
rts/linker: Fix relocation overflow in PE linker

Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB
relocation failed to account for the signed nature of the value.
Specifically, the overflow check was:

    uint64_t v;
    v = S + A;
    if (v >> 32) { ... }

However, `v` ultimately needs to fit into 32-bits as a signed value.
Consequently, values `v > 2^31` in fact overflow yet this is not caught
by the existing overflow check.

Here we rewrite the overflow check to rather ensure that
`INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition
between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases
but I am leaving fixing this for future work.

This bug was first noticed by @awson.

Fixes #15808.

(cherry picked from commit 6d21ecee535782f01dba9947a49e282afee25724)

- - - - -


2 changed files:

- libraries/base/GHC/Exts.hs
- rts/linker/PEi386.c


Changes:

=====================================
libraries/base/GHC/Exts.hs
=====================================
@@ -67,7 +67,7 @@ module GHC.Exts
         breakpoint, breakpointCond,
 
         -- * Ids with special behaviour
-        inline, noinline, lazy, oneShot,
+        inline, noinline, lazy, oneShot, SPEC (..),
 
         -- * Running 'RealWorld' state thread
         runRW#,


=====================================
rts/linker/PEi386.c
=====================================
@@ -1952,13 +1952,15 @@ ocResolve_PEi386 ( ObjectCode* oc )
                {
                    uint64_t v;
                    v = S + A;
-                   if (v >> 32) {
+                   // N.B. in the case of the sign-extended relocations we must ensure that v
+                   // fits in a signed 32-bit value. See #15808.
+                   if (((int64_t) v > (int64_t) INT32_MAX) || ((int64_t) v < (int64_t) INT32_MIN)) {
                        copyName (getSymShortName (info, sym), oc,
                                  symbol, sizeof(symbol)-1);
                        S = makeSymbolExtra_PEi386(oc, symIndex, S, (char *)symbol);
                        /* And retry */
                        v = S + A;
-                       if (v >> 32) {
+                       if (((int64_t) v > (int64_t) INT32_MAX) || ((int64_t) v < (int64_t) INT32_MIN)) {
                            barf("IMAGE_REL_AMD64_ADDR32[NB]: High bits are set in %zx for %s",
                                 v, (char *)symbol);
                        }
@@ -1970,14 +1972,14 @@ ocResolve_PEi386 ( ObjectCode* oc )
                {
                    intptr_t v;
                    v = S + (int32_t)A - ((intptr_t)pP) - 4;
-                   if ((v > (intptr_t) INT32_MAX) || (v < (intptr_t) INT32_MIN)) {
+                   if ((v > (int64_t) INT32_MAX) || (v < (int64_t) INT32_MIN)) {
                        /* Make the trampoline then */
                        copyName (getSymShortName (info, sym),
                                  oc, symbol, sizeof(symbol)-1);
                        S = makeSymbolExtra_PEi386(oc, symIndex, S, (char *)symbol);
                        /* And retry */
                        v = S + (int32_t)A - ((intptr_t)pP) - 4;
-                       if ((v > (intptr_t) INT32_MAX) || (v < (intptr_t) INT32_MIN)) {
+                       if ((v > (int64_t) INT32_MAX) || (v < (int64_t) INT32_MIN)) {
                            barf("IMAGE_REL_AMD64_REL32: High bits are set in %zx for %s",
                                 v, (char *)symbol);
                        }



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7fcca77f1b3d315b95de2acc76bdac3512a522ff...d4483f7b81dc7bd3d246fc22728a1ec86570e6e8

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7fcca77f1b3d315b95de2acc76bdac3512a522ff...d4483f7b81dc7bd3d246fc22728a1ec86570e6e8
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201118/9c37ecb7/attachment-0001.html>