Forks-Super
view release on metacpan or search on metacpan
bundle/Sys-CpuAffinity/lib/Sys/CpuAffinity.pm view on Meta::CPAN
my $maxmask = TWO ** $np;
if ($maxmask > 1 && $mask >= $maxmask) {
my $newmask = $mask & ($maxmask - 1);
if ($newmask == 0) {
carp "Sys::CpuAffinity: mask $mask is not valid for system with ",
"$np processors.\n";
return;
} else {
carp "Sys::CpuAffinity: mask $mask adjusted to $newmask for ",
"system with $np processors\n";
$mask = $newmask;
}
}
$_[1] = $mask;
return 1;
}
sub setAffinity {
my ($pid, $mask, %flags) = @_; # %flags reserved for future use
return 0 if ! _sanitize_set_affinity_args($pid, $mask);
return _setAffinity_with_Win32API($pid,$mask)
|| _setAffinity_with_xs_win32($pid,$mask)
|| _setAffinity_with_Win32Process($pid,$mask)
|| _setAffinity_with_taskset($pid,$mask)
|| _setAffinity_with_xs_sched_setaffinity($pid,$mask)
|| _setAffinity_with_BSD_Process_Affinity($pid,$mask)
|| _setAffinity_with_xs_freebsd_setaffinity($pid,$mask)
|| _setAffinity_with_xs_processor_affinity($pid,$mask)
|| _setAffinity_with_pbind($pid,$mask)
|| _setAffinity_with_xs_processor_bind($pid,$mask)
|| _setAffinity_with_xs_pthread_self_setaffinity($pid,$mask)
|| _setAffinity_with_bindprocessor($pid,$mask)
|| _setAffinity_with_cpuset($pid,$mask)
|| _setAffinity_with_xs_irix_sysmp($pid,$mask)
|| 0;
}
our $_NUM_CPUS_CACHED = 0;
sub getNumCpus {
if ($_NUM_CPUS_CACHED) {
return $_NUM_CPUS_CACHED;
}
return $_NUM_CPUS_CACHED =
_getNumCpus_from_xs_Win32API_System_Info()
|| _getNumCpus_from_xs_cpusetGetCPUCount()
|| _getNumCpus_from_proc_cpuinfo()
|| _getNumCpus_from_proc_stat()
|| _getNumCpus_from_lsdev()
|| _getNumCpus_from_bindprocessor()
|| _getNumCpus_from_BSD_Process_Affinity()
|| _getNumCpus_from_sysctl_freebsd()
|| _getNumCpus_from_sysctl()
|| _getNumCpus_from_dmesg_bsd()
|| _getNumCpus_from_xs_solaris()
|| _getNumCpus_from_dmesg_solaris()
|| _getNumCpus_from_psrinfo()
|| _getNumCpus_from_hinv()
|| _getNumCpus_from_hwprefs()
|| _getNumCpus_from_system_profiler()
|| _getNumCpus_from_Win32API_System_Info()
|| _getNumCpus_from_Test_Smoke_SysInfo()
|| _getNumCpus_from_prtconf() # slower than bindprocessor, lsdev
|| _getNumCpus_from_ENV()
|| _getNumCpus_from_taskset()
|| -1;
}
######################################################################
# count processors toolbox
sub _getNumCpus_from_ENV {
# in some OS, the number of processors is part of the default environment
# this also makes it easy to spoof the value (is that good or bad?)
if ($^O eq 'MSWin32' || $^O eq 'cygwin') {
if (defined $ENV{NUMBER_OF_PROCESSORS}) {
_debug("from Windows ENV: nproc=$ENV{NUMBER_OF_PROCESSORS}");
return $ENV{NUMBER_OF_PROCESSORS};
}
}
return 0;
}
our %WIN32_SYSTEM_INFO = ();
our %WIN32API = ();
sub __is_wow64 {
# determines whether this (Windows) program is running the WOW64 emulator
# (to let 32-bit apps run on 64-bit architecture)
# used in _getNumCpus_from_Win32API_System_Info to decide whether to use
# GetSystemInfo or GetNativeSystemInfo in the Windows API.
return 0 if $^O ne 'MSWin32' && $^O ne 'cygwin';
return 0 if !_configModule('Win32::API');
return $Sys::CpuAffinity::IS_WOW64
if $Sys::CpuAffinity::IS_WOW64_INITIALIZED++;
my $hmodule = _win32api('GetModuleHandle', 'kernel32');
return 0 if $hmodule == 0;
my $proc = _win32api('GetProcAddress', $hmodule, 'IsWow64Process');
return 0 if $proc == 0;
my $current = _win32api('GetCurrentProcess');
return 0 if $current == 0; # carp ...
my $bool = 0;
my $result = _win32api('IsWow64Process', $current, $bool);
if ($result != 0) {
$Sys::CpuAffinity::IS_WOW64 = $bool;
}
$Sys::CpuAffinity::IS_WOW64_INITIALIZED++;
return $Sys::CpuAffinity::IS_WOW64;
}
sub _getNumCpus_from_Win32API_System_Info {
return 0 if $^O ne 'MSWin32' && $^O ne 'cygwin';
bundle/Sys-CpuAffinity/lib/Sys/CpuAffinity.pm view on Meta::CPAN
if ($ncpus == 0) {
my $result = qx($cmd -n hw.ncpu 2> /dev/null);
_debug("sysctl[2] result: $result");
$ncpus = 0 + $result;
}
if ($ncpus == 0) {
my $result = qx($cmd -n hw.ncpufound 2> /dev/null);
_debug("sysctl[3] result: $result");
$ncpus = 0 + $result;
}
if ($ncpus == 0) {
my $result = qx($cmd -n hw.availcpu 2> /dev/null);
_debug("sysctl[4] result: $result");
$ncpus = 0 + $result;
}
return $ncpus || 0;
# there are also sysctl/sysctlbyname system calls
}
sub _getNumCpus_from_psrinfo {
return 0 if !_configExternalProgram('psrinfo');
my $cmd = _configExternalProgram('psrinfo');
my @info = qx($cmd 2> /dev/null);
# return scalar grep /core/, qx($cmd -t 2>/dev/null);
return scalar @info;
}
sub _getNumCpus_from_hinv { # NOT TESTED irix
return 0 if $^O =~ /irix/i;
return 0 if !_configExternalProgram('hinv');
my $cmd = _configExternalProgram('hinv');
# test debug
if ($Sys::CpuAffinity::IS_TEST && !$Sys::CpuAffinity::HINV_CALLED++) {
print STDERR "$cmd output:\n";
print STDERR qx($cmd);
print STDERR "\n\n";
print STDERR "$cmd -c processor output:\n";
print STDERR qx($cmd -c processor);
print STDERR "\n\n";
}
# found this in Test::Smoke::SysInfo v0.042 in Test-Smoke-1.43 module
my @processor = qx($cmd -c processor 2> /dev/null);
_debug('"hinv -c processor" output: ', @processor);
my ($cpu_cnt) = grep { /\d+.+processors?$/i } @processor;
my $ncpu = (split ' ', $cpu_cnt)[0];
if ($ncpu == 0) {
# there might be output like:
# PU 30 at Module 001c35/Slot 0/Slice C: 400 Mhz MIPS R12000 Processor
$ncpu = grep { /^CPU / } @processor;
}
return $ncpu;
}
sub _getNumCpus_from_hwprefs {
return 0 if $^O !~ /darwin/i && $^O !~ /MacOS/i;
return 0 if !_configExternalProgram('hwprefs');
my $cmd = _configExternalProgram('hwprefs');
my $result = qx($cmd cpu_count 2> /dev/null);
$result =~ s/\s+$//;
_debug("\"$cmd cpu_count\" output: ", $result);
return $result || 0;
}
sub _getNumCpus_from_system_profiler { # NOT TESTED darwin
return 0 if $^O !~ /darwin/ && $^O !~ /MacOS/i;
return 0 if !_configExternalProgram('system_profiler');
# with help from Test::Smoke::SysInfo
my $cmd = _configExternalProgram('system_profiler');
my $system_profiler_output
= qx($cmd -detailLevel mini SPHardwardDataType 2> /dev/null);
my %system_profiler;
while ($system_profiler_output =~ m/^\s*([\w ]+):\s+(.+)$/gm) {
$system_profiler{uc $1} = $2;
}
my $ncpus = $system_profiler{'NUMBER OF CPUS'};
if (!defined $ncpus) {
$ncpus = $system_profiler{'TOTAL NUMBER OF CORES'};
}
return $ncpus;
}
sub _getNumCpus_from_prtconf {
# solaris has a prtconf command, but I don't think it outputs #cpus.
return 0 if $^O !~ /aix/i;
return 0 if !_configExternalProgram('prtconf');
my $cmd = _configExternalProgram('prtconf');
# prtconf can take a long time to run, so cache the result
our $AIX_prtconf_cache;
if (!defined($AIX_prtconf_cache)) {
my @result = qx($cmd 2> /dev/null);
my ($result) = grep { /Number Of Processors:/ } @result;
return 0 if !$result;
my ($ncpus) = $result =~ /:\s+(\d+)/;
$AIX_prtconf_cache = $ncpus || 0;
}
return $AIX_prtconf_cache;
}
sub _getNumCpus_from_Test_Smoke_SysInfo { # NOT TESTED
return 0 if !_configModule('Test::Smoke::SysInfo');
my $sysinfo = Test::Smoke::SysInfo->new();
if (defined $sysinfo && defined $sysinfo->{_ncpu}) {
# darwin: result might have format "1 [2 cores]", see
# www.cpantesters.org/cpan/report/db6067c4-9a66-11e0-91fb-39e97f60f2f7
$sysinfo->{_ncpu} =~ s/\d+ \[(\d+) cores\]/$1/;
return $sysinfo->{_ncpu};
}
return;
}
sub _getNumCpus_from_taskset {
return 0 if $^O !~ /linux/i;
my $taskset = _configExternalProgram('taskset');
return 0 unless $taskset;
bundle/Sys-CpuAffinity/lib/Sys/CpuAffinity.pm view on Meta::CPAN
Why worry about CPU affinity? See
http://www.ibm.com/developerworks/linux/library/l-affinity.html?ca=dgr-lnxw41Affinity
Other reasons are:
bind expensive processes to subset of CPUs, leaving at least
one CPU for other tasks or other users
See http://www.ibm.com/developerworks/aix/library/au-processinfinity.html
for hints about cpu affinity on AIX
From v0.90, test to get num CPUs failed on Irix.
Rumors of cpu affinity on other systems:
BSD: pthread_setaffinity_np(), pthread_getaffinity_np()
copy XS code from BSD::Resource::Affinity
FreeBSD: /cpuset, cpuset_setaffinity(), cpuset_getaffinity()
NetBSD: /psrset
Irix: /dplace, cpusetXXX() methods (with -lcpuset)
pthread_setrunon_np(int), pthread_getrunon_np(int*) to affine
the current thread with a single CPU.
sysmp(MP_MUSTRUN_PID,cpu_id,process_id)
sysmp(MP_RUNANYWHERE_PID,process_id)
sysmp(MP_GETMUSTRUN_PID,process_id)
for binding a process to a single specific processor
Solaris: /pbind, /psrset, processor_bind(), pset_bind()
using /psrset in this module is not recommended
* processor sets are *exclusive*. processors assigned to a processor set
can only be used by processes assigned to that set
* processor sets can only be changed by sysadmin
* /cpuset in Irix has these same issues (different from /cpuset command
in FreeBSD)
Solaris: Solaris::Lgrp module
lgrp_affinity_set(P_PID,$pid,$lgrp,LGRP_AFF_xxx)
lgrp_affinity_get(P_PID,$pid,$lgrp)
affinity_get
AIX: /bindprocessor, bindprocessor() in <sys/processor.h>
bindprocessor -q lists virtual processors
bindprocessor -s 0 lists available cores
lsdev -Cc processor lists available cores, consistent with bind... -s 0
bindprocessor -u pid unbind process pid
MacOS: thread_policy_set(),thread_policy_get() in <mach/thread_policy.h>
In MacOS it is possible to assign threads to the same
processor, but generally not to assign them to any particular
processor. MacOS is totally unsupported for now.
DragonflyBSD: all CPAN tests are from single-core systems, so who knows
whether any of this code works on that platform.
There also hasn't been a CPAN tester with AIX yet.
how to find the number of processors:
AIX: sysconf(_SC_NPROCESSORS_CONF), sysconf(_SC_NPROCESSORS_ONLN)
prtconf | grep "Number Of Processors:" | cut -d: -f2
Solaris: processor_info(), p_online()
MacOS: hwprefs cpu_count, system_profiler | grep Cores: | cut -d: -f2
do something with `sysctl -a`
AIX: prtconf
solaris also has prtconf, but don't think it has cpu data
BSD also has `sysctl`, they tell me
AIX: `smtctl | grep "Bind processor "` ... not reliable
AIX: `lsdev -Cc processor` -- all processors
AIX: `bindprocessor -q` -- all shares of processors
Some systems have a concept of "processor groups" or "cpu sets"
that can we could either exploit or be exploited by
Some systems have a concept of "strong" affinity and "weak" affinity.
Where the distinction is important, let's use "strong" affinity
by default.
Some systems have a concept of the maximum number of processors that
they can suppport.
Currently (0.91-1.04), constant parameters to Win32 API functions are
hard coded, not extracted from the local header files.
##########################################
Issues in 1.02-1.04
1. darwin: hwprefs and sysctl give different results?
www.cpantesters.org/cpan/report/3982d2fa-9c2a-11e0-a04e-9d9517dc0771
2. openbsd: dmesg_bsd and sysctl give different results?
www.cpantesters.org/cpan/report/84d41dda-9942-11e0-a324-58f41aecacb6
www.cpantesters.org/cpan/report/0c6e981c-a2dd-11e0-a324-58f41aecacb6
3. linux: /usr/bin/taskset available but still cannot count CPUs? (x16)
/www.cpantesters.org/cpan/report/92ab9df8-a6fc-11e0-829d-5250641c9bbe
xs_sched_getaffinity keeps segfaulting (x4)
4. getNumCpus_from_Win32API_System_Info: garbage result on WOW64 systems
Issues in 1.09
1. linux might have more than 64 cpus, so xs_sched_getaffinity_get_affinity
and xs_sched_setaffinity_set_affinity should also work in AV space; see
Linux::CPUAffinity
2. fix setaffinity_processor_bind.xs, getaffinity_processor_bind.xs
for solaris
3. Not tested on Windows 10
4. Solaris XS. processor_bind usage matches old processor_bind man page,
not current page, doesn't look like you can use processor_bind() on
more than one core.
Solaris 11.2 has "Multi-CPU Binding" and we may need to distinguish
between systems that have it and systems that don't.
blogs.oracle.com/observatory/entry/multi_cpu_binding_mcb:
``[MCB] is available through a new API called "processor_affinity(2)"''
( run in 1.281 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )