[Git][ghc/ghc][wip/T14334] compiler/ByteCode: Allow 2^32 local labels

[Ben Gamari]

Ben Gamari pushed to branch wip/T14334 at Glasgow Haskell Compiler / GHC


Commits:
61222af1 by Ben Gamari at 2020-10-14T21:54:24-04:00
compiler/ByteCode: Allow 2^32 local labels

This widens LocalLabel to 2^16, avoiding the crash observed in #14334.

Closes #14334.

- - - - -


3 changed files:

- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/CoreToByteCode.hs


Changes:

=====================================
compiler/GHC/ByteCode/Asm.hs
=====================================
@@ -177,7 +177,9 @@ assembleBCO platform (ProtoBCO { protoBCOName       = nm
       -- this BCO to be long.
       (n_insns0, lbl_map0) = inspectAsm platform False initial_offset asm
       ((n_insns, lbl_map), long_jumps)
-        | isLarge n_insns0 = (inspectAsm platform True initial_offset asm, True)
+        | isLarge (fromIntegral $ Map.size lbl_map0)
+          || isLarge n_insns0
+                    = (inspectAsm platform True initial_offset asm, True)
         | otherwise = ((n_insns0, lbl_map0), False)
 
       env :: LocalLabel -> Word


=====================================
compiler/GHC/ByteCode/Instr.hs
=====================================
@@ -50,7 +50,8 @@ data ProtoBCO a
         protoBCOFFIs       :: [FFIInfo]
    }
 
-newtype LocalLabel = LocalLabel { getLocalLabel :: Word16 }
+-- | A local block label (e.g. identifying a case alternative).
+newtype LocalLabel = LocalLabel { getLocalLabel :: Word32 }
   deriving (Eq, Ord)
 
 instance Outputable LocalLabel where


=====================================
compiler/GHC/CoreToByteCode.hs
=====================================
@@ -1966,7 +1966,7 @@ data BcM_State
         { bcm_hsc_env :: HscEnv
         , uniqSupply  :: UniqSupply      -- for generating fresh variable names
         , thisModule  :: Module          -- current module (for breakpoints)
-        , nextlabel   :: Word16          -- for generating local labels
+        , nextlabel   :: Word32          -- for generating local labels
         , ffis        :: [FFIInfo]       -- ffi info blocks, to free later
                                          -- Should be free()d when it is GCd
         , modBreaks   :: Maybe ModBreaks -- info about breakpoints
@@ -2038,7 +2038,7 @@ getLabelBc
                         panic "getLabelBc: Ran out of labels"
                     return (st{nextlabel = nl + 1}, LocalLabel nl)
 
-getLabelsBc :: Word16 -> BcM [LocalLabel]
+getLabelsBc :: Word32 -> BcM [LocalLabel]
 getLabelsBc n
   = BcM $ \st -> let ctr = nextlabel st
                  in return (st{nextlabel = ctr+n}, coerce [ctr .. ctr+n-1])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61222af1a92d896b31ed8e3c44746b9b98082615

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61222af1a92d896b31ed8e3c44746b9b98082615
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/20201014/d1de8a88/attachment-0001.html>