1. # Thread represents an OS-level thread. While it could be used directly, it
  2. # is not the preferred way to work in Perl 6. It's a building block for the
  3. # interesting things.
  4. my class Thread {
  5. # The VM-level thread handle.
  6. has Mu $!vm_thread;
  7. # Is the thread's lifetime bounded by that of the application, such
  8. # that when it exits, so does the thread?
  9. has Bool $.app_lifetime;
  10. # Thread's (user-defined) name.
  11. has Str $.name;
  12. my atomicint $started;
  13. my atomicint $aborted;
  14. my atomicint $completed;
  15. my atomicint $joined;
  16. my atomicint $yields;
  17. my atomicint $highest_id;
  18. submethod BUILD(
  19. :&code!,
  20. Bool() :$!app_lifetime = False,
  21. Str() :$!name = "<anon>"
  22. --> Nil
  23. ) {
  24. constant THREAD_ERROR = 'Could not create a new Thread: ';
  25. $!vm_thread := nqp::newthread(
  26. anon sub THREAD-ENTRY() {
  27. my $*THREAD = self;
  28. CONTROL {
  29. default {
  30. ++⚛$aborted;
  31. my Mu $vm-ex := nqp::getattr(nqp::decont($_), Exception, '$!ex');
  32. nqp::getcomp('perl6').handle-control($vm-ex);
  33. }
  34. }
  35. code();
  36. ++⚛$completed;
  37. },
  38. $!app_lifetime ?? 1 !! 0);
  39. $highest_id ⚛= nqp::threadid($!vm_thread);
  40. CATCH {
  41. when X::AdHoc {
  42. .payload.starts-with(THREAD_ERROR)
  43. ?? X::Exhausted.new(
  44. :what<thread>,
  45. :reason(.payload.substr(THREAD_ERROR.chars))
  46. ).throw
  47. !! .rethrow
  48. }
  49. }
  50. }
  51. method start(Thread:U: &code, *%adverbs) {
  52. Thread.new(:&code, |%adverbs).run()
  53. }
  54. method run(Thread:D:) {
  55. ++⚛$started;
  56. nqp::threadrun($!vm_thread);
  57. self
  58. }
  59. method id(Thread:D:) {
  60. nqp::p6box_i(nqp::threadid($!vm_thread));
  61. }
  62. method finish(Thread:D:) {
  63. nqp::threadjoin($!vm_thread);
  64. ++⚛$joined;
  65. self
  66. }
  67. method join(Thread:D:) {
  68. self.finish
  69. }
  70. multi method Numeric(Thread:D:) {
  71. self.id
  72. }
  73. multi method Str(Thread:D:) {
  74. "Thread<$.id>($.name)"
  75. }
  76. multi method gist(Thread:D:) {
  77. "Thread #$.id" ~ ($!name ne '<anon>' ?? " ($!name)" !! '')
  78. }
  79. method yield(Thread:U: --> Nil) {
  80. ++⚛$yields;
  81. nqp::threadyield();
  82. }
  83. method is-initial-thread(--> Bool) {
  84. nqp::p6bool(
  85. nqp::iseq_i(
  86. nqp::threadid(
  87. nqp::if(nqp::isconcrete(self),$!vm_thread,nqp::currentthread)
  88. ),
  89. nqp::threadid(Rakudo::Internals.INITTHREAD)
  90. )
  91. )
  92. }
  93. method usage(Thread:U:) is raw {
  94. nqp::list_i($started,$aborted,$completed,$joined,$yields,$highest_id)
  95. }
  96. }
  97. Rakudo::Internals.REGISTER-DYNAMIC: '$*THREAD', {
  98. my $init_thread := nqp::create(Thread);
  99. nqp::bindattr($init_thread, Thread, '$!vm_thread',
  100. Rakudo::Internals.INITTHREAD);
  101. nqp::bindattr($init_thread, Thread, '$!app_lifetime', False);
  102. nqp::bindattr($init_thread, Thread, '$!name', 'Initial thread');
  103. PROCESS::<$THREAD> := $init_thread;
  104. }