1. # The Kernel class and its methods, underlying $*KERNEL, are a work in progress.
  2. # It is very hard to capture data about a changing universe in a stable API.
  3. # If you find errors for your hardware or OS distribution, please report them
  4. # with the values that you expected and how to get them in your situation.
  5. class Kernel does Systemic {
  6. has Str $.release;
  7. has Str $!hardware;
  8. has Str $!arch;
  9. has Int $!bits;
  10. sub uname($opt) {
  11. state $has_uname = "/bin/uname".IO.x || "/usr/bin/uname".IO.x;
  12. $has_uname ?? qqx/uname $opt/.chomp !! 'unknown';
  13. }
  14. submethod BUILD(:$!auth = "unknown" --> Nil) { }
  15. method name {
  16. $!name //= do {
  17. given $*DISTRO.name {
  18. when 'mswin32' {
  19. 'win32'
  20. }
  21. default {
  22. lc uname '-s';
  23. }
  24. }
  25. }
  26. }
  27. method version {
  28. $!version //= Version.new( do {
  29. given $*DISTRO.name {
  30. when 'freebsd' {
  31. uname '-r'; # -K -U not introduced until 10.0
  32. }
  33. when 'macosx' {
  34. my $unamev = uname '-v';
  35. $unamev ~~ m/^Darwin \s+ Kernel \s+ Version \s+ (<[\d\.]>+)/
  36. ?? ~$0
  37. !! $unamev.chomp;
  38. }
  39. default {
  40. given $.name {
  41. when 'linux' {
  42. # somewhat counter-intuitively the '-r' is what
  43. # most people think of the kernel version
  44. uname '-r';
  45. }
  46. default {
  47. uname '-v';
  48. }
  49. }
  50. }
  51. }
  52. } );
  53. }
  54. method release {
  55. $!release //= do {
  56. given $*DISTRO.name {
  57. when any <openbsd netbsd dragonfly> { # needs adapting
  58. uname '-r';
  59. }
  60. default {
  61. uname '-v';
  62. }
  63. }
  64. }
  65. }
  66. method hardware {
  67. $!hardware //= do {
  68. given $*DISTRO.name {
  69. default {
  70. uname '-m';
  71. }
  72. }
  73. }
  74. }
  75. method arch {
  76. $!arch //= do {
  77. given $*DISTRO.name {
  78. when 'raspbian' {
  79. uname '-m';
  80. }
  81. default {
  82. uname '-p';
  83. }
  84. }
  85. }
  86. }
  87. method archname {
  88. self.hardware ~ '-' ~ self.name
  89. }
  90. method bits {
  91. $!bits //= $.hardware ~~ m/_64|w|amd64/ ?? 64 !! 32; # naive approach
  92. }
  93. has @!signals; # Signal
  94. has $!signals-setup-lock = Lock.new;
  95. has $!signals-setup = False;
  96. method signals (Kernel:D:) {
  97. unless $!signals-setup {
  98. $!signals-setup-lock.protect: {
  99. unless $!signals-setup {
  100. my @names;
  101. if self.name eq 'win32' {
  102. # These are the ones libuv emulates on Windows.
  103. @names = flat "", <INT BREAK HUP WINCH>;
  104. } else {
  105. if self.name eq 'openbsd' {
  106. # otherwise it uses a shell buildin
  107. @names = flat "", qx!/bin/kill -l!.words;
  108. }
  109. else {
  110. @names = flat "", qx/kill -l/.words;
  111. }
  112. @names.splice(1,1) if @names[1] eq "0"; # Ubuntu fudge
  113. @names.=map({.uc}) if $*KERNEL.name eq 'dragonfly';
  114. }
  115. for Signal.^enum_value_list -> $signal {
  116. my $name = substr($signal.key,3);
  117. if @names.first( * eq $name, :k ) -> $index {
  118. @!signals[$index] = $signal;
  119. }
  120. }
  121. $!signals-setup = True;
  122. }
  123. }
  124. }
  125. @!signals
  126. }
  127. has %!signals-by-Str;
  128. has $!signals-by-Str-setup = False;
  129. proto method signal (|) {*}
  130. multi method signal(Kernel:D: Str:D $signal --> Int:D) {
  131. unless $!signals-by-Str-setup {
  132. $!signals-setup-lock.protect: {
  133. unless $!signals-by-Str-setup {
  134. nqp::stmts(
  135. (my int $els = @.signals.elems),
  136. (my int $i = -1),
  137. nqp::while(
  138. nqp::isgt_i($els, $i = nqp::add_i($i, 1)),
  139. ($_ := @!signals.AT-POS($i)).defined
  140. && %!signals-by-Str.ASSIGN-KEY(.Str, nqp::decont($i))));
  141. $!signals-by-Str-setup = True;
  142. }
  143. }
  144. }
  145. %!signals-by-Str{$signal} // %!signals-by-Str{"SIG$signal"} // Int;
  146. }
  147. multi method signal(Kernel:D: Signal:D \signal --> Int:D) { signal.value }
  148. multi method signal(Kernel:D: Int:D \signal --> Int:D) { signal }
  149. method cpu-cores() is raw { nqp::cpucores }
  150. method cpu-usage() is raw {
  151. my \rusage = nqp::getrusage();
  152. nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_SEC) * 1000000
  153. + nqp::atpos_i(rusage, nqp::const::RUSAGE_UTIME_MSEC)
  154. + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_SEC) * 1000000
  155. + nqp::atpos_i(rusage, nqp::const::RUSAGE_STIME_MSEC)
  156. }
  157. }
  158. Rakudo::Internals.REGISTER-DYNAMIC: '$*KERNEL', {
  159. PROCESS::<$KERNEL> := Kernel.new;
  160. }