Permalink
Browse files

Initial implementation

  • Loading branch information...
1 parent 7fe60f7 commit cf0a204c221312d0157a5dbb9e264623baabf59b @Leont committed Jan 6, 2012
Showing with 244 additions and 31 deletions.
  1. +15 −0 Build.PL
  2. +4 −31 dist.ini
  3. +63 −0 lib/POSIX/RT/Scheduler.pm
  4. +156 −0 lib/POSIX/RT/Scheduler.xs
  5. +6 −0 script/idle
View
@@ -0,0 +1,15 @@
+use strict;
+use warnings;
+use Devel::CheckLib;
+use Module::Build;
+
+my @extra_linker_flags = map { "-l$_" } grep { check_lib(lib => $_) } qw/rt/;
+
+my $builder = Module::Build->new(
+ module_name => 'POSIX::RT::Scheduler',
+ ##{ $plugin->get_prereqs ##}
+ ##{ $plugin->get_default('share_dir') ##}
+ extra_linker_flags => \@extra_linker_flags,
+);
+
+$builder->create_build_script();
View
@@ -4,35 +4,8 @@ license = Perl_5
copyright_holder = Leon Timmermans
copyright_year = 2011
-
-[@BasicWithoutMM]
-[ModuleBuild]
-mb_version = 0.28
-
-;Meta
-[AutoPrereqs]
-[Prereqs / BuildRequires]
-ExtUtils::CBuilder = 0
-[MetaJSON]
-[MetaResources]
-[Repository]
-[Bugtracker]
-[MinimumPerl]
-[Git::NextVersion]
-
-;Munging
-[PodWeaver]
-[PkgVersion]
-
-;Testing
-[PodSyntaxTests]
-[PodCoverageTests]
-[Test::Kwalitee]
-[Test::Compile]
-
-;Releasing
-[NextRelease]
-[Signature]
-[CheckChangesHasContent]
-[@Git]
+[@LEONT::XS]
+use_custom = 1
+[PPPort]
+filename = lib/POSIX/RT/ppport.h
@@ -7,3 +7,66 @@ use XSLoader;
XSLoader::load(__PACKAGE__, __PACKAGE__->VERSION);
1;
+
+#ABSTRACT: POSIX Scheduler support functions
+
+__END__
+
+=head1 SYNOPSIS
+
+ sched_setscheduler($pid, 'rr', 10);
+
+=head1 DESCRIPTION
+
+This module allows one to set the scheduler and the scheduler priority of processes.
+
+The following scheduler policies are supported:
+
+=over 4
+
+=item * C<other>
+
+This is the default non-real-time scheduler. It doesn't have a real-time priority
+
+=item * C<fifo>
+
+This is a real-time scheduler. A fifo scheduled process runs until either it is blocked by an I/O request, it is preempted by a higher priority process, or it calls C<sched_yield>.
+
+=item * C<rr>
+
+Round-robin scheduling. This is similar to fifo scheduling, except that after a specified amount of time the thread will be
+
+=item * C<batch>
+
+A Linux specific scheduler, useful for keeping CPU-intensive processes at normal priority without sacrificing interactivity.
+
+=item * C<idle>
+
+A Linux specific scheduler that causes a process to be scheduled only when there's no other (non-idle scheduled) process available for running.
+
+=back
+
+=func sched_getscheduler($pid)
+
+Get the scheduler for C<$pid>.
+
+=func sched_setscheduler($pid, $policy, $priority = 0)
+
+Set the scheduler for C<$pid> to C<$policy>, with priority C<$priority> if applicable. C<$priority> must be within the inclusive priority range for the scheduling policy specified by policy. If C<$pid> is zero, the current process is retrieved
+
+=func sched_getpriority($pid)
+
+Return the real-time priority of C<$pid> as an integer value.
+
+=func sched_setpriority($pid, $priority)
+
+Set the real-time priority of C<$pid> to C<$priority>.
+
+=func sched_priority_range($policy)
+
+This function returns the (inclusive) minimal and maximal values allowed for C<$policy>.
+
+=func sched_yield()
+
+Yield execution to the next waiting process or thread. Note that if the current process/thread is the highest priority runnable real-time scheduled process/thread available, this will be a no-op.
+
@@ -0,0 +1,156 @@
+#if defined linux
+# ifndef _GNU_SOURCE
+# define _GNU_SOURCE
+# endif
+# define GNU_STRERROR_R
+#endif
+
+#include <sched.h>
+
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+
+static void get_sys_error(char* buffer, size_t buffer_size) {
+#ifdef _GNU_SOURCE
+ const char* message = strerror_r(errno, buffer, buffer_size);
+ if (message != buffer) {
+ memcpy(buffer, message, buffer_size -1);
+ buffer[buffer_size] = '\0';
+ }
+#else
+ strerror_r(errno, buffer, buffer_size);
+#endif
+}
+
+static void S_die_sys(pTHX_ const char* format) {
+ char buffer[128];
+ get_sys_error(buffer, sizeof buffer);
+ Perl_croak(aTHX_ format, buffer);
+}
+#define die_sys(format) S_die_sys(aTHX_ format)
+
+#define add_entry(name, value) STMT_START { \
+ hv_stores(scheds, name, newSViv(value)); \
+ av_store(names, value, newSVpvs(name));\
+ } STMT_END
+
+#define identifiers_key "POSIX::RT::Scheduler::identifiers"
+#define names_key "POSIX::RT::Scheduler::names"
+
+static int get_policy(pTHX_ SV* name) {
+ HV* policies = (HV*)*hv_fetchs(PL_modglobal, names_key, 0);
+ HE* ret = hv_fetch_ent(policies, name, 0, 0);
+ if (ret == NULL)
+ Perl_croak(aTHX_ "");
+ return SvIV(HeVAL(ret));
+}
+static SV* get_name(pTHX_ int policy) {
+ AV* names = (AV*)*hv_fetchs(PL_modglobal, names_key, 0);
+ SV** ret = av_fetch(names, policy, 0);
+ if (ret == NULL || *ret == NULL)
+ Perl_croak(aTHX_ "");
+ return *ret;
+}
+
+MODULE = POSIX::RT::Scheduler PACKAGE = POSIX::RT::Scheduler
+
+BOOT:
+ {
+ HV* scheds = newHV();
+ AV* names = newAV();
+ add_entry("other", SCHED_OTHER);
+#ifdef SCHED_BATCH
+ add_entry("batch", SCHED_BATCH);
+#endif
+#ifdef SCHED_IDLE
+ add_entry("idle", SCHED_IDLE);
+#endif
+#ifdef SCHED_FIFO
+ add_entry("fifo", SCHED_FIFO);
+#endif
+#ifdef SCHED_RR
+ add_entry("rr", SCHED_RR);
+#endif
+ hv_stores(PL_modglobal, identifiers_key, (SV*)scheds);
+ hv_stores(PL_modglobal, names_key, (SV*)names);
+ }
+
+
+SV*
+sched_getscheduler(pid)
+ int pid;
+ PREINIT:
+ int ret;
+ HV* scheds;
+ CODE:
+ ret = sched_getscheduler(pid);
+ if (ret == -1)
+ die_sys("Couldn't get scheduler: %s");
+ RETVAL = get_name(ret);
+ OUTPUT:
+ RETVAL
+
+SV*
+sched_setscheduler(pid, policy, arg = 0)
+ int pid;
+ SV* policy;
+ int arg;
+ PREINIT:
+ int ret, real_policy;
+ struct sched_param param;
+ CODE:
+ real_policy = get_policy(policy);
+ param.sched_priority = arg;
+ ret = sched_setscheduler(pid, real_policy, &param);
+ if (ret == -1)
+ die_sys("Couldn't set scheduler: %s");
+ RETVAL =
+#ifdef linux
+ (ret == 0) ? sv_2mortal(newSVpvs("0 but true")) :
+#endif
+ get_name(ret);
+ OUTPUT:
+ RETVAL
+
+IV
+sched_getpriority(pid)
+ int pid;
+ PREINIT:
+ struct sched_param param;
+ CODE:
+ sched_getparam(pid, &param);
+ RETVAL = param.sched_priority;
+ OUTPUT:
+ RETVAL
+
+void
+sched_setpriority(pid, priority)
+ int pid;
+ int priority;
+ PREINIT:
+ int ret;
+ struct sched_param param;
+ CODE:
+ param.sched_priority = priority;
+ ret = sched_getparam(pid, &param);
+ if (ret == -1)
+ die_sys("Couldn't set scheduler priority: %s");
+
+void
+sched_priority_range(policy)
+ SV* policy;
+ PREINIT:
+ int real_policy;
+ PPCODE:
+ real_policy = get_policy(policy);
+ mXPUSHi(sched_get_priority_min(real_policy));
+ mXPUSHi(sched_get_priority_max(real_policy));
+ PUTBACK;
+
+void
+sched_yield()
+ CODE:
+ sched_yield();
View
@@ -0,0 +1,6 @@
+use strict;
+use warnings;
+use POSIX::RT::Scheduler 'sched_setscheduler';
+
+sched_setscheduler($$, 'idle') or warn "Couldn't make self idle-scheduled: $!";
+exec @ARGV;

0 comments on commit cf0a204

Please sign in to comment.