1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

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'.
This commit is contained in:
Ludovic Courtès 2010-12-07 23:10:41 +01:00
parent 3ae78cac88
commit f0c0141fe4
4 changed files with 71 additions and 0 deletions

View file

@ -1856,6 +1856,30 @@ Currently this procedure is only defined on GNU variants
GNU C Library Reference Manual}). GNU C Library Reference Manual}).
@end deffn @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 @node Signals
@subsection Signals @subsection Signals

View file

@ -138,6 +138,7 @@ extern char *ttyname();
#endif #endif
#include <sys/file.h> /* from Gnulib */ #include <sys/file.h> /* from Gnulib */
#include <nproc.h>
/* Some Unix systems don't define these. CPP hair is dangerous, but /* Some Unix systems don't define these. CPP hair is dangerous, but
this seems safe enough... */ this seems safe enough... */
@ -1990,6 +1991,37 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
#endif /* HAVE_SCHED_SETAFFINITY */ #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 #if HAVE_GETPASS
SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0, SCM_DEFINE (scm_getpass, "getpass", 1, 0, 0,
(SCM prompt), (SCM prompt),

View file

@ -91,6 +91,8 @@ SCM_API SCM scm_sethostname (SCM name);
SCM_API SCM scm_gethostname (void); SCM_API SCM scm_gethostname (void);
SCM_API SCM scm_getaffinity (SCM pid); SCM_API SCM scm_getaffinity (SCM pid);
SCM_API SCM scm_setaffinity (SCM pid, SCM cpu_set); 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 void scm_init_posix (void);
SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex; SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex;

View file

@ -198,3 +198,16 @@
(setaffinity (getpid) mask) (setaffinity (getpid) mask)
(equal? mask (getaffinity (getpid)))) (equal? mask (getaffinity (getpid))))
(throw 'unresolved)))) (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)))))