From f0c0141fe4bd478edc8205b1eae793f0474d4aa3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 7 Dec 2010 23:10:41 +0100
Subject: [PATCH] Add `total-processor-count' and `current-processor-count'.

* libguile/posix.c (scm_total_processor_count,
  scm_current_processor_count): New functions.

* libguile/posix.h (scm_total_processor_count,
  scm_current_processor_count): New declarations.

* test-suite/tests/posix.test ("nproc"): New test prefix.

* doc/ref/posix.texi (Processes): Document `total-processor-count' and
  `current-processor-count'.
---
 doc/ref/posix.texi          | 24 ++++++++++++++++++++++++
 libguile/posix.c            | 32 ++++++++++++++++++++++++++++++++
 libguile/posix.h            |  2 ++
 test-suite/tests/posix.test | 13 +++++++++++++
 4 files changed, 71 insertions(+)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 4afc6d0c9..dc9d77b3e 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1856,6 +1856,30 @@ Currently this procedure is only defined on GNU variants
 GNU C Library Reference Manual}).
 @end deffn
 
+@deffn {Scheme Procedure} total-processor-count
+@deffnx {C Function} scm_total_processor_count ()
+Return the total number of processors of the machine, which
+is guaranteed to be at least 1.  A ``processor'' here is a
+thread execution unit, which can be either:
+
+@itemize
+@item an execution core in a (possibly multi-core) chip, in a
+  (possibly multi- chip) module, in a single computer, or
+@item a thread execution unit inside a core in the case of
+  @dfn{hyper-threaded} CPUs.
+@end itemize
+
+Which of the two definitions is used, is unspecified.
+@end deffn
+
+@deffn {Scheme Procedure} current-processor-count
+@deffnx {C Function} scm_current_processor_count ()
+Like @code{total-processor-count}, but return the number of
+processors available to the current process.  See
+@code{setaffinity} and @code{getaffinity} for more
+information.
+@end deffn
+
 
 @node Signals
 @subsection Signals
diff --git a/libguile/posix.c b/libguile/posix.c
index 652f63d7d..95beb6e3e 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -138,6 +138,7 @@ extern char *ttyname();
 #endif
 
 #include <sys/file.h>     /* from Gnulib */
+#include <nproc.h>
 
 /* Some Unix systems don't define these.  CPP hair is dangerous, but
    this seems safe enough... */
@@ -1990,6 +1991,37 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
 
 #endif /* HAVE_SCHED_SETAFFINITY */
 
+SCM_DEFINE (scm_total_processor_count, "total-processor-count", 0, 0, 0,
+	    (void),
+	    "Return the total number of processors of the machine, which\n"
+	    "is guaranteed to be at least 1.  A ``processor'' here is a\n"
+	    "thread execution unit, which can be either:\n\n"
+	    "@itemize\n"
+	    "@item an execution core in a (possibly multi-core) chip, in a\n"
+	    "  (possibly multi- chip) module, in a single computer, or\n"
+	    "@item a thread execution unit inside a core in the case of\n"
+	    "  @dfn{hyper-threaded} CPUs.\n"
+	    "@end itemize\n\n"
+	    "Which of the two definitions is used, is unspecified.\n")
+#define FUNC_NAME s_scm_total_processor_count
+{
+  return scm_from_ulong (num_processors (NPROC_ALL));
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_current_processor_count, "current-processor-count", 0, 0, 0,
+	    (void),
+	    "Like @code{total-processor-count}, but return the number of\n"
+	    "processors available to the current process.  See\n"
+	    "@code{setaffinity} and @code{getaffinity} for more\n"
+	    "information.\n")
+#define FUNC_NAME s_scm_total_processor_count
+{
+  return scm_from_ulong (num_processors (NPROC_CURRENT));
+}
+#undef FUNC_NAME
+
+
 #if HAVE_GETPASS
 SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0, 
             (SCM prompt),
diff --git a/libguile/posix.h b/libguile/posix.h
index aa5e12cbd..e2e19ddd2 100644
--- a/libguile/posix.h
+++ b/libguile/posix.h
@@ -91,6 +91,8 @@ SCM_API SCM scm_sethostname (SCM name);
 SCM_API SCM scm_gethostname (void);
 SCM_API SCM scm_getaffinity (SCM pid);
 SCM_API SCM scm_setaffinity (SCM pid, SCM cpu_set);
+SCM_API SCM scm_total_processor_count (void);
+SCM_API SCM scm_current_processor_count (void);
 SCM_INTERNAL void scm_init_posix (void);
 
 SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex;
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 9679042a6..79f3a92ae 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -198,3 +198,16 @@
           (setaffinity (getpid) mask)
           (equal? mask (getaffinity (getpid))))
         (throw 'unresolved))))
+
+;;
+;; nproc
+;;
+
+(with-test-prefix "nproc"
+
+  (pass-if "total-processor-count"
+    (>= (total-processor-count) 1))
+
+  (pass-if "current-processor-count"
+    (and (>= (current-processor-count) 1)
+         (>= (total-processor-count) (current-processor-count)))))