From 0dfcd5776f3ef89ceaafef6c4730ddac759e3716 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Thu, 16 Aug 2007 18:32:59 +0000
Subject: [PATCH] Document +RTS --info, and make it a Read'able Haskell value

---
 docs/users_guide/runtime_control.xml |   23 +++++++++++++++++++++++
 rts/Makefile                         |   14 +++++++-------
 rts/RtsFlags.c                       |   13 +------------
 rts/RtsUtils.c                       |   20 ++++++++++++++++++++
 rts/RtsUtils.h                       |    2 ++
 5 files changed, 53 insertions(+), 19 deletions(-)

diff --git a/docs/users_guide/runtime_control.xml b/docs/users_guide/runtime_control.xml
index 95365ba..776b65f 100644
--- a/docs/users_guide/runtime_control.xml
+++ b/docs/users_guide/runtime_control.xml
@@ -661,6 +661,29 @@ char *ghc_rts_opts = "-H128m -K1m";
     <filename>ghc/compiler/parser/hschooks.c</filename> in a GHC
     source tree.</para>
   </sect2>
+
+  <sect2>
+    <title>Getting information about the RTS</title>
+
+    <indexterm><primary>RTS</primary></indexterm>
+
+    <para>It is possible to ask the RTS to give some information about
+    itself. To do this, use the <option>--info</option> flag, e.g.</para>
+<screen>
+$ ./a.out +RTS --info
+ [("GHC RTS", "Yes")
+ ,("GHC version", "6.7")
+ ,("RTS way", "rts_p")
+ ,("Host platform", "x86_64-unknown-linux")
+ ,("Build platform", "x86_64-unknown-linux")
+ ,("Target platform", "x86_64-unknown-linux")
+ ,("Compiler unregisterised", "NO")
+ ,("Tables next to code", "YES")
+ ]
+</screen>
+    <para>The information is formatted such that it can be read as a
+    of type <literal>[(String, String)]</literal>.</para>
+  </sect2>
 </sect1>
 
 <!-- Emacs stuff:
diff --git a/rts/Makefile b/rts/Makefile
index 6e8ca54..2bc31b3 100644
--- a/rts/Makefile
+++ b/rts/Makefile
@@ -149,13 +149,13 @@ endif
 endif
 
 RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
-RtsFlags_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
-RtsFlags_CC_OPTS += -DRtsWay=\"rts$(_way)\"
-RtsFlags_CC_OPTS += -DHostPlatform=\"$(HOSTPLATFORM)\"
-RtsFlags_CC_OPTS += -DBuildPlatform=\"$(BUILDPLATFORM)\"
-RtsFlags_CC_OPTS += -DTargetPlatform=\"$(TARGETPLATFORM)\"
-RtsFlags_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\"
-RtsFlags_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\"
+RtsUtils_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
+RtsUtils_CC_OPTS += -DRtsWay=\"rts$(_way)\"
+RtsUtils_CC_OPTS += -DHostPlatform=\"$(HOSTPLATFORM)\"
+RtsUtils_CC_OPTS += -DBuildPlatform=\"$(BUILDPLATFORM)\"
+RtsUtils_CC_OPTS += -DTargetPlatform=\"$(TARGETPLATFORM)\"
+RtsUtils_CC_OPTS += -DGhcUnregisterised=\"$(GhcUnregisterised)\"
+RtsUtils_CC_OPTS += -DGhcEnableTablesNextToCode=\"$(GhcEnableTablesNextToCode)\"
 
 ifeq "$(way)" "mp"
 SRC_HC_OPTS += -I$$PVM_ROOT/include
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index 4c1f739..e8aefd8 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -684,18 +684,7 @@ error = rtsTrue;
                   }
                   else if (strequal("info",
                                &rts_argv[arg][2])) {
-                      char *s;
-                      printf("RTS info:\n");
-                      printf("RTS from GHC " ProjectVersion "\n");
-                      printf("RTS way " RtsWay "\n");
-                      printf("Host platform " HostPlatform "\n");
-                      printf("Build platform " BuildPlatform "\n");
-                      printf("Target platform " TargetPlatform "\n");
-                      s = strcmp(GhcUnregisterised, "YES") == 0 ? "un" : "";
-                      printf("Compiler is %sregisterised\n", s);
-                      s = strcmp(GhcEnableTablesNextToCode, "YES") == 0
-                        ? "" : "not ";
-                      printf("Tables are %snext to code\n", s);
+                      printRtsInfo();
                       exit(0);
                   }
                   else {
diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c
index 94c357e..c730d7a 100644
--- a/rts/RtsUtils.c
+++ b/rts/RtsUtils.c
@@ -460,3 +460,23 @@ int genericRaise(int sig) {
         return raise(sig);
 #endif
 }
+
+static void mkRtsInfoPair(char *key, char *val) {
+    /* XXX should check for "s, \s etc in key and val */
+    printf(" ,(\"%s\", \"%s\")\n", key, val);
+}
+
+void printRtsInfo(void) {
+    /* The first entry is just a hack to make it easy to get the
+     * commas right */
+    printf(" [(\"GHC RTS\", \"Yes\")\n");
+    mkRtsInfoPair("GHC version",             ProjectVersion);
+    mkRtsInfoPair("RTS way",                 RtsWay);
+    mkRtsInfoPair("Host platform",           HostPlatform);
+    mkRtsInfoPair("Build platform",          BuildPlatform);
+    mkRtsInfoPair("Target platform",         TargetPlatform);
+    mkRtsInfoPair("Compiler unregisterised", GhcUnregisterised);
+    mkRtsInfoPair("Tables next to code",     GhcEnableTablesNextToCode);
+    printf(" ]\n");
+}
+
diff --git a/rts/RtsUtils.h b/rts/RtsUtils.h
index cad4216..c29c959 100644
--- a/rts/RtsUtils.h
+++ b/rts/RtsUtils.h
@@ -51,4 +51,6 @@ extern void heapCheckFail( void );
 extern void* __hscore_get_saved_termios(int fd);
 extern void __hscore_set_saved_termios(int fd, void* ts);
 
+void printRtsInfo(void);
+
 #endif /* RTSUTILS_H */
-- 
1.7.10.4