[Git][ghc/ghc][master] 6 commits: Add safe list indexing operator: !?
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Tue Jan 10 07:58:13 UTC 2023
Matthew Pickering pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d53f6f4d by Oleg Grenrus at 2023-01-09T21:11:02-05:00
Add safe list indexing operator: !?
With Joachim's amendments.
Implements https://github.com/haskell/core-libraries-committee/issues/110
- - - - -
cfaf1ad7 by Nicolas Trangez at 2023-01-09T21:11:03-05:00
rts, tests: limit thread name length to 15 bytes
On Linux, `pthread_setname_np` (or rather, the kernel) only allows for
thread names up to 16 bytes, including the terminating null byte.
This commit adds a note pointing this out in `createOSThread`, and fixes
up two instances where a thread name of more than 15 characters long was
used (in the RTS, and in a test-case).
Fixes: #22366
Fixes: https://gitlab.haskell.org/ghc/ghc/-/issues/22366
See: https://gitlab.haskell.org/ghc/ghc/-/issues/22366#note_460796
- - - - -
64286132 by Matthew Pickering at 2023-01-09T21:11:03-05:00
Store bootstrap_llvm_target and use it to set LlvmTarget in bindists
This mirrors some existing logic for the bootstrap_target which
influences how TargetPlatform is set.
As described on #21970 not storing this led to `LlvmTarget` being set incorrectly
and hence the wrong `--target` flag being passed to the C compiler.
Towards #21970
- - - - -
4724e8d1 by Matthew Pickering at 2023-01-09T21:11:04-05:00
Check for FP_LD_NO_FIXUP_CHAINS in installation configure script
Otherwise, when installing from a bindist the C flag isn't passed to the
C compiler.
This completes the fix for #22429
- - - - -
2e926b88 by Georgi Lyubenov at 2023-01-09T21:11:07-05:00
Fix outdated link to Happy section on sequences
- - - - -
146a1458 by Matthew Pickering at 2023-01-09T21:11:07-05:00
Revert "NCG(x86): Compile add+shift as lea if possible."
This reverts commit 20457d775885d6c3df020d204da9a7acfb3c2e5a.
See #22666 and #21777
- - - - -
15 changed files:
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/Parser.y
- configure.ac
- distrib/configure.ac.in
- libraries/base/Data/List.hs
- libraries/base/Data/OldList.hs
- libraries/base/GHC/List.hs
- libraries/base/changelog.md
- m4/ghc_llvm_target.m4
- rts/posix/OSThreads.c
- rts/sm/NonMoving.c
- − testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm
- − testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs
- testsuite/tests/codeGen/should_gen_asm/all.T
- testsuite/tests/rts/pause-resume/pause_resume.c
Changes:
=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1048,29 +1048,10 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
--------------------
add_code :: Width -> CmmExpr -> CmmExpr -> NatM Register
- -- x + imm
add_code rep x (CmmLit (CmmInt y _))
| is32BitInteger y
, rep /= W8 -- LEA doesn't support byte size (#18614)
= add_int rep x y
- -- x + (y << imm)
- add_code rep x y
- -- Byte size is not supported and 16bit size is slow when computed via LEA
- | rep /= W8 && rep /= W16
- -- 2^3 = 8 is the highest multiplicator supported by LEA.
- , Just (x,y,shift_bits) <- get_shift x y
- = add_shiftL rep x y (fromIntegral shift_bits)
- where
- -- x + (y << imm)
- get_shift x (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)])
- | shift_bits <= 3
- = Just (x, y, shift_bits)
- -- (y << imm) + x
- get_shift (CmmMachOp (MO_Shl _w) [y, CmmLit (CmmInt shift_bits _)]) x
- | shift_bits <= 3
- = Just (x, y, shift_bits)
- get_shift _ _
- = Nothing
add_code rep x y = trivialCode rep (ADD format) (Just (ADD format)) x y
where format = intFormat rep
-- TODO: There are other interesting patterns we want to replace
@@ -1085,7 +1066,6 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
sub_code rep x y = trivialCode rep (SUB (intFormat rep)) Nothing x y
-- our three-operand add instruction:
- add_int :: (Width -> CmmExpr -> Integer -> NatM Register)
add_int width x y = do
(x_reg, x_code) <- getSomeReg x
let
@@ -1099,22 +1079,6 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
--
return (Any format code)
- -- x + (y << shift_bits) using LEA
- add_shiftL :: (Width -> CmmExpr -> CmmExpr -> Int -> NatM Register)
- add_shiftL width x y shift_bits = do
- (x_reg, x_code) <- getSomeReg x
- (y_reg, y_code) <- getSomeReg y
- let
- format = intFormat width
- imm = ImmInt 0
- code dst
- = (x_code `appOL` y_code) `snocOL`
- LEA format
- (OpAddr (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg (2 ^ shift_bits)) imm))
- (OpReg dst)
- --
- return (Any format code)
-
----------------------
-- See Note [DIV/IDIV for bytes]
=====================================
compiler/GHC/Parser.y
=====================================
@@ -540,8 +540,9 @@ importdecls
This might seem like an awfully roundabout way to declare a list; plus, to add
insult to injury you have to reverse the results at the end. The answer is that
left recursion prevents us from running out of stack space when parsing long
-sequences. See: https://www.haskell.org/happy/doc/html/sec-sequences.html for
-more guidance.
+sequences. See:
+https://haskell-happy.readthedocs.io/en/latest/using.html#parsing-sequences
+for more guidance.
By adding/removing branches, you can affect what lists are accepted. Here
are the most common patterns, rewritten as regular expressions for clarity:
=====================================
configure.ac
=====================================
@@ -667,6 +667,8 @@ GHC_LLVM_TARGET_SET_VAR
# we intend to pass trough --targets to llvm as is.
LLVMTarget_CPP=` echo "$LlvmTarget"`
AC_SUBST(LLVMTarget_CPP)
+# The target is substituted into the distrib/configure.ac file
+AC_SUBST(LlvmTarget)
dnl ** See whether cc supports --target=<triple> and set
dnl CONF_CC_OPTS_STAGE[012] accordingly.
=====================================
distrib/configure.ac.in
=====================================
@@ -18,6 +18,8 @@ dnl--------------------------------------------------------------------
dnl Various things from the source distribution configure
bootstrap_target=@TargetPlatform@
+bootstrap_llvm_target=@LlvmTarget@
+
TargetHasRTSLinker=@TargetHasRTSLinker@
AC_SUBST(TargetHasRTSLinker)
@@ -169,6 +171,11 @@ FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAG
# Stage 3 won't be supported by cross-compilation
FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE2],[CONF_GCC_LINKER_OPTS_STAGE2],[CONF_LD_LINKER_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2])
+FP_LD_NO_FIXUP_CHAINS([target], [LDFLAGS])
+FP_LD_NO_FIXUP_CHAINS([build], [CONF_GCC_LINKER_OPTS_STAGE0])
+FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE1])
+FP_LD_NO_FIXUP_CHAINS([target], [CONF_GCC_LINKER_OPTS_STAGE2])
+
AC_SUBST(CONF_CC_OPTS_STAGE0)
AC_SUBST(CONF_CC_OPTS_STAGE1)
AC_SUBST(CONF_CC_OPTS_STAGE2)
=====================================
libraries/base/Data/List.hs
=====================================
@@ -127,6 +127,7 @@ module Data.List
-- | These functions treat a list @xs@ as a indexed collection,
-- with indices ranging from 0 to @'length' xs - 1 at .
+ , (!?)
, (!!)
, elemIndex
=====================================
libraries/base/Data/OldList.hs
=====================================
@@ -127,6 +127,7 @@ module Data.OldList
-- | These functions treat a list @xs@ as a indexed collection,
-- with indices ranging from 0 to @'length' xs - 1 at .
+ , (!?)
, (!!)
, elemIndex
=====================================
libraries/base/GHC/List.hs
=====================================
@@ -31,7 +31,7 @@ module GHC.List (
-- Other functions
foldl1', concat, concatMap,
map, (++), filter, lookup,
- head, last, tail, init, uncons, (!!),
+ head, last, tail, init, uncons, (!?), (!!),
scanl, scanl1, scanl', scanr, scanr1,
iterate, iterate', repeat, replicate, cycle,
take, drop, splitAt, takeWhile, dropWhile, span, break, reverse,
@@ -49,7 +49,7 @@ import GHC.Num (Num(..))
import GHC.Num.Integer (Integer)
import GHC.Stack.Types (HasCallStack)
-infixl 9 !!
+infixl 9 !?, !!
infix 4 `elem`, `notElem`
-- $setup
@@ -1370,9 +1370,10 @@ concat = foldr (++) []
-- >>> ['a', 'b', 'c'] !! (-1)
-- *** Exception: Prelude.!!: negative index
--
--- WARNING: This function is partial. You can use
--- <https://hackage.haskell.org/package/safe/docs/Safe.html#v:atMay atMay>
--- instead.
+-- WARNING: This function is partial, and should only be used if you are
+-- sure that the indexing will not fail. Otherwise, use 'Data.List.!?'.
+--
+-- WARNING: This function takes linear time in the index.
#if defined(USE_REPORT_PRELUDE)
(!!) :: [a] -> Int -> a
xs !! n | n < 0 = errorWithoutStackTrace "Prelude.!!: negative index"
@@ -1401,6 +1402,30 @@ xs !! n
_ -> r (k-1)) tooLarge xs n
#endif
+-- | List index (subscript) operator, starting from 0. Returns 'Nothing'
+-- if the index is out of bounds
+--
+-- >>> ['a', 'b', 'c'] !? 0
+-- Just 'a'
+-- >>> ['a', 'b', 'c'] !? 2
+-- Just 'c'
+-- >>> ['a', 'b', 'c'] !? 3
+-- Nothing
+-- >>> ['a', 'b', 'c'] !? (-1)
+-- Nothing
+--
+-- This is the total variant of the partial '!!' operator.
+--
+-- WARNING: This function takes linear time in the index.
+(!?) :: [a] -> Int -> Maybe a
+
+{-# INLINABLE (!?) #-}
+xs !? n
+ | n < 0 = Nothing
+ | otherwise = foldr (\x r k -> case k of
+ 0 -> Just x
+ _ -> r (k-1)) (const Nothing) xs n
+
--------------------------------------------------------------
-- The zip family
--------------------------------------------------------------
=====================================
libraries/base/changelog.md
=====================================
@@ -58,6 +58,8 @@
freeing a `Pool`. (#14762) (#18338)
* `Type.Reflection.Unsafe` is now marked as unsafe.
* Add `Data.Typeable.heqT`, a kind-heterogeneous version of `Data.Typeable.eqT`.
+ * Add `Data.List.!?` per
+ [CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110).
## 4.17.0.0 *August 2022*
=====================================
m4/ghc_llvm_target.m4
=====================================
@@ -50,5 +50,10 @@ AC_DEFUN([GHC_LLVM_TARGET], [
# require it.
AC_DEFUN([GHC_LLVM_TARGET_SET_VAR], [
AC_REQUIRE([FPTOOLS_SET_PLATFORMS_VARS])
- GHC_LLVM_TARGET([$target],[$target_cpu],[$target_vendor],[$target_os],[LlvmTarget])
+ if test "$bootstrap_llvm_target" != ""
+ then
+ LlvmTarget=$bootstrap_llvm_target
+ else
+ GHC_LLVM_TARGET([$target],[$target_cpu],[$target_vendor],[$target_os],[LlvmTarget])
+ fi
])
=====================================
rts/posix/OSThreads.c
=====================================
@@ -218,6 +218,12 @@ start_thread (void *param)
return startProc(startParam);
}
+/* Note: at least on Linux/Glibc, `pthread_setname_np` restricts the name of
+ * a thread to 16 bytes, including the terminating null byte. Hence, make sure
+ * to only pass in names of up to 15 characters. Otherwise,
+ * `pthread_setname_np` when called in `start_thread` will fail with `ERANGE`,
+ * which is not checked for, and the thread won't be named at all.
+ */
int
createOSThread (OSThreadId* pId, const char *name,
OSThreadProc *startProc, void *param)
=====================================
rts/sm/NonMoving.c
=====================================
@@ -1015,7 +1015,7 @@ void nonmovingCollect(StgWeak **dead_weaks, StgTSO **resurrected_threads)
nonmoving_write_barrier_enabled = true;
debugTrace(DEBUG_nonmoving_gc, "Starting concurrent mark thread");
OSThreadId thread;
- if (createOSThread(&thread, "non-moving mark thread",
+ if (createOSThread(&thread, "nonmoving-mark",
nonmovingConcurrentMark, mark_queue) != 0) {
barf("nonmovingCollect: failed to spawn mark thread: %s", strerror(errno));
}
=====================================
testsuite/tests/codeGen/should_gen_asm/AddMulX86.asm deleted
=====================================
@@ -1,46 +0,0 @@
-.section .text
-.align 8
-.align 8
- .quad 8589934604
- .quad 0
- .long 14
- .long 0
-.globl AddMulX86_f_info
-.type AddMulX86_f_info, @function
-AddMulX86_f_info:
-.LcAx:
- leaq (%r14,%rsi,8),%rbx
- jmp *(%rbp)
- .size AddMulX86_f_info, .-AddMulX86_f_info
-.section .data
-.align 8
-.align 1
-.globl AddMulX86_f_closure
-.type AddMulX86_f_closure, @object
-AddMulX86_f_closure:
- .quad AddMulX86_f_info
-.section .text
-.align 8
-.align 8
- .quad 8589934604
- .quad 0
- .long 14
- .long 0
-.globl AddMulX86_g_info
-.type AddMulX86_g_info, @function
-AddMulX86_g_info:
-.LcAL:
- leaq (%r14,%rsi,8),%rbx
- jmp *(%rbp)
- .size AddMulX86_g_info, .-AddMulX86_g_info
-.section .data
-.align 8
-.align 1
-.globl AddMulX86_g_closure
-.type AddMulX86_g_closure, @object
-AddMulX86_g_closure:
- .quad AddMulX86_g_info
-.section .note.GNU-stack,"", at progbits
-.ident "GHC 9.3.20220228"
-
-
=====================================
testsuite/tests/codeGen/should_gen_asm/AddMulX86.hs deleted
=====================================
@@ -1,12 +0,0 @@
-{-# LANGUAGE MagicHash #-}
-
-module AddMulX86 where
-
-import GHC.Exts
-
-f :: Int# -> Int# -> Int#
-f x y =
- x +# (y *# 8#) -- Should result in a lea instruction, which we grep the assembly output for.
-
-g x y =
- (y *# 8#) +# x -- Should result in a lea instruction, which we grep the assembly output for.
=====================================
testsuite/tests/codeGen/should_gen_asm/all.T
=====================================
@@ -10,4 +10,3 @@ test('memset-unroll', is_amd64_codegen, compile_cmp_asm, ['cmm', ''])
test('bytearray-memset-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
test('bytearray-memcpy-unroll', is_amd64_codegen, compile_grep_asm, ['hs', True, ''])
test('T18137', [when(opsys('darwin'), skip), only_ways(llvm_ways)], compile_grep_asm, ['hs', False, '-fllvm -split-sections'])
-test('AddMulX86', is_amd64_codegen, compile_cmp_asm, ['hs', '-dno-typeable-binds'])
=====================================
testsuite/tests/rts/pause-resume/pause_resume.c
=====================================
@@ -187,7 +187,7 @@ void pauseAndResumeViaThread
)
{
OSThreadId threadId;
- createOSThread(&threadId, "Pause and resume thread", &pauseAndResumeViaThread_helper, (void *)count);
+ createOSThread(&threadId, "pause-resume", &pauseAndResumeViaThread_helper, (void *)count);
}
const int TIMEOUT = 1000000; // 1 second
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3fff7512bbf989386faaa1dccafdad1deabde84...146a145835f5c2e82da4dd0bcb90702460505a01
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3fff7512bbf989386faaa1dccafdad1deabde84...146a145835f5c2e82da4dd0bcb90702460505a01
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/20230110/d462fd30/attachment-0001.html>
More information about the ghc-commits
mailing list