[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: JS: fix thread-related primops

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Apr 20 10:11:07 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00
JS: fix thread-related primops

- - - - -
7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00
CI: Disable abi-test-nightly

See #23269

- - - - -
ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00
Testsuite: don't use obsolescent egrep (#22351)

Recent egrep displays the following message, breaking golden tests:

  egrep: warning: egrep is obsolescent; using grep -E

Switch to using "grep -E" instead

- - - - -
b2ee4388 by Matthew Pickering at 2023-04-20T06:10:54-04:00
hadrian: Pass haddock file arguments in a response file

In !10119 CI was failing on windows because the command line was too
long. We can mitigate this by passing the file arguments to haddock in a
response file.

We can't easily pass all the arguments in a response file because the
`+RTS` arguments can't be placed in the response file.

Fixes #23273

- - - - -
d23b736f by tocic at 2023-04-20T06:10:55-04:00
Fix doc typo in GHC.Read.readList

- - - - -


14 changed files:

- .gitlab-ci.yml
- compiler/GHC/StgToJS/Prim.hs
- docs/users_guide/hints.rst
- hadrian/src/Builder.hs
- hadrian/src/Settings/Builders/Haddock.hs
- libraries/base/GHC/Read.hs
- libraries/base/tests/all.T
- + libraries/base/tests/listThreads1.hs
- + libraries/base/tests/listThreads1.stdout
- rts/js/mem.js
- rts/js/thread.js
- testsuite/tests/cabal/cabal01/Makefile
- testsuite/tests/haddock/perf/Makefile
- testsuite/tests/simplCore/should_compile/Makefile


Changes:

=====================================
.gitlab-ci.yml
=====================================
@@ -484,6 +484,9 @@ abi-test-nightly:
     paths:
       - out
   rules:
+    # This job is broken. Disabling it until some kind soul can finish its
+    # implementation. #23269
+    - when: never
     - if: $NIGHTLY
 
 ############################################################


=====================================
compiler/GHC/StgToJS/Prim.hs
=====================================
@@ -925,7 +925,7 @@ genPrim prof bound ty op = case op of
   IsCurrentThreadBoundOp -> \[r] [] -> PrimInline $ r |= one_
   NoDuplicateOp -> \[] [] -> PrimInline mempty -- don't need to do anything as long as we have eager blackholing
   ThreadStatusOp -> \[stat,cap,locked] [tid] -> PrimInline $ appT [stat, cap, locked] "h$threadStatus" [tid]
-  ListThreadsOp  -> \[r] [] -> PrimInline $ r |= var "h$threads"
+  ListThreadsOp  -> \[r] [] -> PrimInline $ appT [r] "h$listThreads" []
   GetThreadLabelOp -> \[r1, r2] [t] -> PrimInline $ appT [r1, r2] "h$getThreadLabel" [t]
   LabelThreadOp    -> \[] [t,l] -> PrimInline $ t .^ "label" |= l
 


=====================================
docs/users_guide/hints.rst
=====================================
@@ -153,7 +153,7 @@ Use ``SPECIALIZE`` pragmas:
 
     .. code-block:: sh
 
-        $ ghc --show-iface Foo.hi | egrep '^[a-z].*::.*=>'
+        $ ghc --show-iface Foo.hi | grep -E '^[a-z].*::.*=>'
 
 Strict functions are your dear friends:
     And, among other things, lazy pattern-matching is your enemy.


=====================================
hadrian/src/Builder.hs
=====================================
@@ -41,6 +41,7 @@ import Packages
 import GHC.IO.Encoding (getFileSystemEncoding)
 import qualified Data.ByteString as BS
 import qualified GHC.Foreign as GHC
+import GHC.ResponseFile
 
 -- | C compiler can be used in two different modes:
 -- * Compile or preprocess a source file.
@@ -353,6 +354,8 @@ instance H.Builder Builder where
                     Exit _ <- cmd' [path] (buildArgs ++ [input])
                     return ()
 
+                Haddock BuildPackage -> runHaddock path buildArgs buildInputs
+
                 HsCpp    -> captureStdout
 
                 Make dir -> cmd' path ["-C", dir] buildArgs
@@ -385,6 +388,16 @@ instance H.Builder Builder where
 
                 _  -> cmd' [path] buildArgs
 
+-- | Invoke @haddock@ given a path to it and a list of arguments. The arguments
+-- are passed in a response file.
+runHaddock :: FilePath    -- ^ path to @haddock@
+      -> [String]
+      -> [FilePath]  -- ^ input file paths
+      -> Action ()
+runHaddock haddockPath flagArgs fileInputs = withTempFile $ \tmp -> do
+    writeFile' tmp $ escapeArgs fileInputs
+    cmd [haddockPath] flagArgs ('@' : tmp)
+
 -- TODO: Some builders are required only on certain platforms. For example,
 -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
 -- specific optional builders as soon as we can reliably test this feature.


=====================================
hadrian/src/Settings/Builders/Haddock.hs
=====================================
@@ -68,7 +68,6 @@ haddockBuilderArgs = mconcat
                      ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME},"
                      ++ haddock | (p, haddock) <- haddocks_with_versions ]
             , pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ]
-            , getInputs
             , arg "+RTS"
             , arg $ "-t" ++ (statsDir -/- pkgName pkg ++ ".t")
             , arg "--machine-readable"


=====================================
libraries/base/GHC/Read.hs
=====================================
@@ -205,8 +205,8 @@ class Read a where
   -- | The method 'readList' is provided to allow the programmer to
   -- give a specialised way of parsing lists of values.
   -- For example, this is used by the predefined 'Read' instance of
-  -- the 'Char' type, where values of type 'String' should be are
-  -- expected to use double quotes, rather than square brackets.
+  -- the 'Char' type, where values of type 'String' are expected to
+  -- use double quotes, rather than square brackets.
   readList     :: ReadS [a]
 
   -- | Proposed replacement for 'readsPrec' using new-style parsers (GHC only).


=====================================
libraries/base/tests/all.T
=====================================
@@ -294,6 +294,7 @@ test('T19719', normal, compile_and_run, [''])
 test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring'])
 test('T22816', normal, compile_and_run, [''])
 test('trace', normal, compile_and_run, [''])
-test('listThreads', js_broken(22261), compile_and_run, [''])
+test('listThreads', normal, compile_and_run, [''])
+test('listThreads1', normal, compile_and_run, [''])
 test('inits1tails1', normal, compile_and_run, [''])
 test('CLC149', normal, compile, [''])


=====================================
libraries/base/tests/listThreads1.hs
=====================================
@@ -0,0 +1,6 @@
+module Main where
+
+import GHC.Conc.Sync
+
+main :: IO ()
+main = listThreads >>= print


=====================================
libraries/base/tests/listThreads1.stdout
=====================================
@@ -0,0 +1 @@
+[ThreadId 1]


=====================================
rts/js/mem.js
=====================================
@@ -1455,11 +1455,3 @@ function h$pext64(src_b, src_a, mask_b, mask_a) {
  }
  RETURN_UBX_TUP2(dst_b, dst_a);
 }
-
-function h$getThreadLabel(t) {
-  if (t.label) {
-    RETURN_UBX_TUP2(1, t.label);
-  } else {
-    RETURN_UBX_TUP2(0, 0);
-  }
-}


=====================================
rts/js/thread.js
=====================================
@@ -106,8 +106,8 @@ function h$Thread() {
 #endif
 }
 
-function h$rts_getThreadId(t) {
-  return t.tid;
+function h$rts_getThreadId(t) { // returns a CULLong
+  RETURN_UBX_TUP2((t.tid / Math.pow(2,32))>>>0, (t.tid & 0xFFFFFFFF)>>>0);
 }
 
 function h$cmp_thread(t1,t2) {
@@ -121,13 +121,35 @@ function h$threadString(t) {
   if(t === null) {
     return "<no thread>";
   } else if(t.label) {
-    var str = h$decodeUtf8z(t.label[0], t.label[1]);
+    var str = h$decodeUtf8z(t.label, 0);
     return str + " (" + t.tid + ")";
   } else {
     return (""+t.tid);
   }
 }
 
+function h$getThreadLabel(t) {
+  if (t.label) {
+    RETURN_UBX_TUP2(1, t.label);
+  } else {
+    RETURN_UBX_TUP2(0, 0);
+  }
+}
+
+function h$listThreads() {
+  var r = h$newArray(0,null);
+
+  if (h$currentThread) r.push(h$currentThread);
+
+  var threads_iter = h$threads.iter();
+  while ((t = threads_iter()) !== null) r.push(t);
+
+  var blocked_iter = h$blocked.iter();
+  while ((t = blocked_iter.next()) !== null) r.push(t);
+
+  return r;
+}
+
 function h$fork(a, inherit) {
   h$r1 = h$forkThread(a, inherit);
   return h$yield();
@@ -1134,7 +1156,7 @@ function h$main(a) {
   t.stack[8] = a;
   t.stack[9] = h$return;
   t.sp = 9;
-  t.label = [h$encodeUtf8("main"), 0];
+  t.label = h$encodeUtf8("main");
   h$wakeupThread(t);
   h$startMainLoop();
   return t;


=====================================
testsuite/tests/cabal/cabal01/Makefile
=====================================
@@ -5,7 +5,7 @@ include $(TOP)/mk/test.mk
 # Find all the env variables starting with CI_ to unset them.
 # Otherwise, we might run into environment length limitations on Windows.
 # (See `xargs --show-limits`.)
-VARS_TO_UNSET := $(shell env | grep ^CI_ | egrep -o '^[^=]+')
+VARS_TO_UNSET := $(shell env | grep ^CI_ | grep -E -o '^[^=]+')
 unexport $(VARS_TO_UNSET)
 
 clean:


=====================================
testsuite/tests/haddock/perf/Makefile
=====================================
@@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk
 
 # We accept a 5% increase in parser allocations due to -haddock
 haddock_parser_perf :
-	WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | egrep -o 'alloc=[0-9]+' | cut -c7-  ) ; \
-	WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | egrep -o 'alloc=[0-9]+' | cut -c7-  ) ;  \
+	WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7-  ) ; \
+	WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7-  ) ;  \
 	  awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }"
 
 # Similarly for the renamer
 haddock_renamer_perf :
-	WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | egrep -o 'alloc=[0-9]+' | cut -c7-  ) ; \
-	WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | egrep -o 'alloc=[0-9]+' | cut -c7-  ) ;  \
+	WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7-  ) ; \
+	WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7-  ) ;  \
 	  awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }"


=====================================
testsuite/tests/simplCore/should_compile/Makefile
=====================================
@@ -61,7 +61,7 @@ T13367:
 
 T8832:
 	$(RM) -f T8832.o T8832.hi
-	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-ticks T8832.hs | egrep '^[a-zA-Z0-9]+ ='
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-ticks T8832.hs | grep -E '^[a-zA-Z0-9]+ ='
 
 T12603:
 	$(RM) -f T12603.o T12603.hi



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2f069877ea226532565298685893ae848b25c3c...d23b736fb66c62fe1a6da08cf03431880e90980b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2f069877ea226532565298685893ae848b25c3c...d23b736fb66c62fe1a6da08cf03431880e90980b
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/20230420/f1fc4f93/attachment-0001.html>


More information about the ghc-commits mailing list