+      CmmSwitch arg ids -> genSwitch arg ids bid

+Note [Jump tables]

+~~~~~~~~~~~~~~~~~~

+The x86 backend has a virtual JMP_TBL instruction which payload can be used to

+generate both the jump instruction and the jump table contents. `genSwitch` is

+responsible for generating these JMP_TBL instructions.

+

+Depending on `-fPIC` flag and on the architecture, we generate the following

+jump table variants:

+

+  | Variant |  Arch  | Table's contents                       | Reference to the table |

+  |---------|--------|----------------------------------------|------------------------|

+  |     PIC |  Both  | Relative offset: target_lbl - base_lbl | PIC                    |

+  | Non-PIC | 64-bit | Absolute: target_lbl                   | Non-PIC (rip-relative) |

+  | Non-PIC | 32-bit | Absolute: target_lbl                   | Non-PIC (absolute)     |

+

+For the PIC variant, we store relative entries (`target_lbl - base_lbl`) in the

+jump table. Using absolute entries with PIC would require target_lbl symbols to

+be resolved at link time, hence to be global labels (currently they are local

+labels).

+

+We use the block_id of the code containing the jump as `base_lbl`. It ensures

+that target_lbl and base_lbl are close enough to each others, avoiding

+overflows.

+

+Historical note: in the past we used the table label `table_lbl` as base_lbl. It

+allowed the jumping code to only compute one global address (table_lbl) both to

+read the table and to compute the target address. However:

+ * the table could be too far from the jump and on Windows which only

+   has 32-bit relative relocations (IMAGE_REL_AMD64_REL64 doesn't exist),

+   `dest_lbl - table_lbl` overflowed (see #24016)

+

+ * Mac OS X/x86-64 linker was unable to handle `.quad L1 - L0`

+   relocations if L0 wasn't preceded by a non-anonymous label in its

+   section (which was the case with table_lbl). Hence we used to put the

+   jump table in the .text section in this case.

+

+

+-}

+

+-- | Generate a JMP_TBL instruction

+--

+-- See Note [Jump tables]

+genSwitch :: CmmExpr -> SwitchTargets -> BlockId -> NatM InstrBlock

+genSwitch expr targets bid = do

+

+      (offset, blockIds) = switchTargetsToTable targets

+      ids = map (fmap DestBlockId) blockIds

+

+      is32bit = target32Bit platform

+      fmt = archWordFormat is32bit

+

+  table_lbl <- getNewLabelNat

+  let bid_lbl = blockLbl bid

+  let table_section = Section ReadOnlyData table_lbl

+

+  -- see Note [Jump tables] for a description of the following 3 variants.

+  if

+    | ncgPIC config -> do

+      -- PIC support: store relative offsets in the jump table to allow the code

+      -- to be relocated without updating the table. The table itself and the

+      -- block label used to make the relative labels absolute are read in a PIC

+      -- way (via cmmMakeDynamicReference).

+      (reg,e_code) <- getNonClobberedReg indexExpr -- getNonClobberedReg because it needs to survive across t_code and j_code

+      (tableReg,t_code) <- getNonClobberedReg =<< cmmMakeDynamicReference config DataReference table_lbl

+      (targetReg,j_code) <- getSomeReg =<< cmmMakeDynamicReference config DataReference bid_lbl

+      pure $ e_code `appOL` t_code `appOL` j_code `appOL` toOL

+            [ ADD fmt (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)))

+                      (OpReg targetReg)

+            , JMP_TBL (OpReg targetReg) ids table_section table_lbl (Just bid_lbl)

+            ]

+

+    | not is32bit -> do

+      -- 64-bit non-PIC code

+      (reg,e_code) <- getSomeReg indexExpr

+      tableReg <- getNewRegNat (intFormat (platformWordWidth platform))

+      targetReg <- getNewRegNat (intFormat (platformWordWidth platform))

+      pure $ e_code `appOL` toOL

+            [ LEA fmt (OpAddr (AddrBaseIndex EABaseRip EAIndexNone (ImmCLbl table_lbl))) (OpReg tableReg)

+            , MOV fmt (OpAddr (AddrBaseIndex (EABaseReg tableReg) (EAIndex reg (platformWordSizeInBytes platform)) (ImmInt 0)))

+                      (OpReg targetReg)

+            , JMP_TBL (OpReg targetReg) ids table_section table_lbl Nothing

+            ]

+

+    | otherwise -> do

+      -- 32-bit non-PIC code is a straightforward jump to &table[entry].

+      (reg,e_code) <- getSomeReg indexExpr

+      pure $ e_code `appOL` unitOL

+            ( JMP_TBL (OpAddr (AddrBaseIndex EABaseNone (EAIndex reg (platformWordSizeInBytes platform)) (ImmCLbl table_lbl)))

+                      ids table_section table_lbl Nothing

+            )

+generateJumpTableForInstr config = \case

+  JMP_TBL _ ids section table_lbl mrel_lbl ->

+    let getBlockId (DestBlockId id) = id

+        getBlockId _ = panic "Non-Label target in Jump Table"

+        block_ids = map (fmap getBlockId) ids

+

+        jumpTable = case mrel_lbl of

+          Nothing      -> map mk_absolute block_ids           -- absolute entries

+          Just rel_lbl -> map (mk_relative rel_lbl) block_ids -- offsets relative to rel_lbl

+

+        mk_absolute = \case

+          Nothing      -> CmmStaticLit (CmmInt 0 (ncgWordWidth config))

+          Just blockid -> CmmStaticLit (CmmLabel (blockLbl blockid))

+

+        mk_relative rel_lbl = \case

+          Nothing      -> CmmStaticLit (CmmInt 0 (ncgWordWidth config))

+          Just blockid -> CmmStaticLit (CmmLabelDiffOff (blockLbl blockid) rel_lbl 0 (ncgWordWidth config))

+

+    in Just (CmmData section (mkAlignment 1, CmmStaticsRaw table_lbl jumpTable))

+

+  _ -> Nothing

+                      !(Maybe CLabel) -- Label used to compute relative offsets. Otherwise we store absolute addresses.

+    JMP_TBL op _ _ _ _  -> mkRU (use_R addrFmt op []) []

+    JMP_TBL op ids s tl jl -> JMP_TBL (patchOp op) ids s tl jl

+    JXX _ target            -> bid == target

+    JMP_TBL _ targets _ _ _ -> all isTargetBid targets

+    _                       -> False

+        JXX _ id            -> [id]

+        JMP_TBL _ ids _ _ _ -> [id | Just (DestBlockId id) <- ids]

+        _                   -> []

+        JMP_TBL op ids section table_lbl rel_lbl

+          -> JMP_TBL op (map (fmap (patchJumpDest patchF)) ids) section table_lbl rel_lbl

+    shortcutJump' fn _ (JMP_TBL addr blocks section table_lbl rel_lbl) =

+        in  JMP_TBL addr blocks' section table_lbl rel_lbl

+   JMP_TBL op _ _ _ _

+    Generate position-independent code (PIC). This code can be put into shared

+    libraries and is sometimes required by operating systems, e.g. systems using

+    Address Space Layout Randomization (ASLR).

+    executable. To link the final executable use :ghc-flag:`-pie`.

+getArgs = mconcat [ defaultBuilderArgs, defaultPackageArgs, getExtraArgs ]

+    // dll_name might be deallocated, we need to copy it to have a stable reference to the contents

+    // See #26613

+    size_t size = wcslen(dll_name) + 1;

+    pathchar* dll_name_copy = stgMallocBytes(size * sizeof(pathchar), "addLoadedDll");

+    wcsncpy(dll_name_copy, dll_name, size);

+    insertHashTable_(cache->hash, (StgWord) dll_name_copy, instance, hash_path);

+module Main (main) where

+

+data Command

+  = Command1

+  | Command2

+  | Command3

+  | Command4

+  | Command5

+  | Command6 -- Commenting this line works with -fPIC, uncommenting leads to a crash.

+

+main :: IO ()

+main = do

+  let x = case cmd of

+           Command1 -> 1 :: Int

+           Command2 -> 2

+           Command3 -> 3

+           Command4 -> 4

+           Command5 -> 5

+           Command6 -> 6

+  putStrLn (show x)

+

+{-# NOINLINE cmd #-}

+cmd :: Command

+cmd = Command6

+6

+test('T24016', normal, compile_and_run, ['-O1 -fPIC'])