[Git][ghc/ghc][wip/T17949] 4 commits: T17949 TRACE_user instead of eventlog_enabled

Daneel S. Yaitskov gitlab at gitlab.haskell.org
Sat May 23 01:39:30 UTC 2020



Daneel S. Yaitskov pushed to branch wip/T17949 at Glasgow Haskell Compiler / GHC


Commits:
0d4447ec by Daneel Yaitskov at 2020-05-22T14:09:58-07:00
T17949 TRACE_user instead of eventlog_enabled

- - - - -
271d0ee1 by Daneel Yaitskov at 2020-05-22T18:33:03-07:00
T17949 RTS_DEFAULT macro

- - - - -
93e5960d by Daneel Yaitskov at 2020-05-22T18:34:19-07:00
T17949 fix TRACE_user type

- - - - -
46e71578 by Daneel Yaitskov at 2020-05-22T18:36:54-07:00
T17949 export TRACE_user

- - - - -


6 changed files:

- includes/Rts.h
- libraries/base/Debug/Trace.hs
- rts/Trace.c
- rts/Trace.h
- rts/eventlog/EventLog.c
- rts/eventlog/EventLog.h


Changes:

=====================================
includes/Rts.h
=====================================
@@ -57,8 +57,10 @@ extern "C" {
 // library.
 #if defined(HAS_VISIBILITY_HIDDEN)
 #define RTS_PRIVATE  GNUC3_ATTRIBUTE(visibility("hidden"))
+#define RTS_DEFAULT  GNUC3_ATTRIBUTE(visibility("default"))
 #else
 #define RTS_PRIVATE  /* disabled: RTS_PRIVATE */
+#define RTS_DEFAULT
 #endif
 
 #if __GNUC__ >= 4


=====================================
libraries/base/Debug/Trace.hs
=====================================
@@ -53,6 +53,7 @@ import GHC.Base
 import qualified GHC.Foreign
 import GHC.IO.Encoding
 import GHC.Ptr
+import GHC.Real
 import GHC.Show
 import GHC.Stack
 import Data.List (null, partition)
@@ -75,7 +76,7 @@ import Data.List (null, partition)
 -- Some implementations of these functions may decorate the string that\'s
 -- output to indicate that you\'re tracing.
 
-foreign import ccall "&eventlog_enabled" eventlog_enabled :: Ptr CBool
+foreign import ccall "&TRACE_user" traceUser :: Ptr CInt
 
 -- | The 'whenEventlog' function evals argument action
 -- if RTS eventlog (+RTS -l) is enabled.
@@ -84,8 +85,8 @@ foreign import ccall "&eventlog_enabled" eventlog_enabled :: Ptr CBool
 {-# INLINE whenEventlog #-}
 whenEventlog :: IO () -> IO ()
 whenEventlog logAction = do
-  ee <- peek eventlog_enabled
-  if toBool ee
+  ee <- peek traceUser
+  if 0 < (fromIntegral ee :: Int)
   then logAction
   else return ()
 


=====================================
rts/Trace.c
=====================================
@@ -33,7 +33,9 @@ int TRACE_gc;
 int TRACE_nonmoving_gc;
 int TRACE_spark_sampled;
 int TRACE_spark_full;
-int TRACE_user;
+#endif /* TRACING */
+RTS_DEFAULT int TRACE_user; // used in Debug.Trace
+#if defined(TRACING)
 int TRACE_cap;
 
 #if defined(THREADED_RTS)


=====================================
rts/Trace.h
=====================================
@@ -71,7 +71,7 @@ extern int TRACE_sched;
 extern int TRACE_gc;
 extern int TRACE_spark_sampled;
 extern int TRACE_spark_full;
-/* extern int TRACE_user; */  // only used in Trace.c
+
 extern int TRACE_cap;
 extern int TRACE_nonmoving_gc;
 


=====================================
rts/eventlog/EventLog.c
=====================================
@@ -26,13 +26,8 @@
 #include <unistd.h>
 #endif
 
-#endif /* TRACING */
-
-// for ghc-pkg is build without TRACING
 bool eventlog_enabled;
 
-#if defined(TRACING)
-
 static const EventLogWriter *event_log_writer = NULL;
 
 #define EVENT_LOG_SIZE 2 * (1024 * 1024) // 2MB


=====================================
rts/eventlog/EventLog.h
=====================================
@@ -15,8 +15,6 @@
 
 #include "BeginPrivate.h"
 
-extern bool eventlog_enabled;
-
 #if defined(TRACING)
 
 /*
@@ -24,6 +22,7 @@ extern bool eventlog_enabled;
  */
 extern char *EventTagDesc[];
 
+extern bool eventlog_enabled;
 
 void initEventLogging(void);
 void restartEventLogging(void);



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fca165f00d97179a91c2b95d86a8e5c2400c9c75...46e71578244d3a0433569b3a5a8d63238fb17c30

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fca165f00d97179a91c2b95d86a8e5c2400c9c75...46e71578244d3a0433569b3a5a8d63238fb17c30
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/20200522/3835b1c7/attachment-0001.html>


More information about the ghc-commits mailing list