1 /**
2  * The fiber module provides OS-indepedent lightweight threads aka fibers.
3  *
4  * Copyright: Copyright Sean Kelly 2005 - 2012.
5  * License: Distributed under the
6  *      $(LINK2 http://www.boost.org/LICENSE_1_0.txt, Boost Software License 1.0).
7  *    (See accompanying file LICENSE)
8  * Authors:   Sean Kelly, Walter Bright, Alex Rønne Petersen, Martin Nowak
9  * Source:    $(DRUNTIMESRC core/thread/fiber.d)
10  */
11 
12 module core.thread.fiber;
13 
14 import core.thread.osthread;
15 import core.thread.threadgroup;
16 import core.thread.types;
17 import core.thread.context;
18 
19 import core.memory : pageSize;
20 
21 ///////////////////////////////////////////////////////////////////////////////
22 // Fiber Platform Detection
23 ///////////////////////////////////////////////////////////////////////////////
24 
25 version (GNU)
26 {
27     import gcc.builtins;
28     version (GNU_StackGrowsDown)
29         version = StackGrowsDown;
30 }
31 else
32 {
33     // this should be true for most architectures
34     version = StackGrowsDown;
35 }
36 
37 version (Windows)
38 {
39     import core.stdc.stdlib : malloc, free;
40     import core.sys.windows.winbase;
41     import core.sys.windows.winnt;
42 }
43 
44 private
45 {
46     version (D_InlineAsm_X86)
47     {
48         version (Windows)
49             version = AsmX86_Windows;
50         else version (Posix)
51             version = AsmX86_Posix;
52 
53         version = AlignFiberStackTo16Byte;
54     }
55     else version (D_InlineAsm_X86_64)
56     {
57         version (Windows)
58         {
59             version = AsmX86_64_Windows;
60             version = AlignFiberStackTo16Byte;
61         }
62         else version (Posix)
63         {
64             version = AsmX86_64_Posix;
65             version = AlignFiberStackTo16Byte;
66         }
67     }
68     else version (PPC)
69     {
70         version (OSX)
71         {
72             version = AsmPPC_Darwin;
73             version = AsmExternal;
74             version = AlignFiberStackTo16Byte;
75         }
76         else version (Posix)
77         {
78             version = AsmPPC_Posix;
79             version = AsmExternal;
80         }
81     }
82     else version (PPC64)
83     {
84         version (OSX)
85         {
86             version = AsmPPC_Darwin;
87             version = AsmExternal;
88             version = AlignFiberStackTo16Byte;
89         }
90         else version (Posix)
91         {
92             version = AlignFiberStackTo16Byte;
93         }
94     }
95     else version (MIPS_O32)
96     {
97         version (Posix)
98         {
99             version = AsmMIPS_O32_Posix;
100             version = AsmExternal;
101         }
102     }
103     else version (AArch64)
104     {
105         version (Posix)
106         {
107             version = AsmAArch64_Posix;
108             version = AsmExternal;
109             version = AlignFiberStackTo16Byte;
110         }
111     }
112     else version (ARM)
113     {
114         version (Posix)
115         {
116             version = AsmARM_Posix;
117             version = AsmExternal;
118         }
119     }
120     else version (SPARC)
121     {
122         // NOTE: The SPARC ABI specifies only doubleword alignment.
123         version = AlignFiberStackTo16Byte;
124     }
125     else version (SPARC64)
126     {
127         version = AlignFiberStackTo16Byte;
128     }
129     else version (LoongArch64)
130     {
131         version = AsmLoongArch64_Posix;
132         version = AsmExternal;
133     }
134 
135     version (Posix)
136     {
137         version (AsmX86_Windows)    {} else
138         version (AsmX86_Posix)      {} else
139         version (AsmX86_64_Windows) {} else
140         version (AsmX86_64_Posix)   {} else
141         version (AsmExternal)       {} else
142         {
143             // NOTE: The ucontext implementation requires architecture specific
144             //       data definitions to operate so testing for it must be done
145             //       by checking for the existence of ucontext_t rather than by
146             //       a version identifier.  Please note that this is considered
147             //       an obsolescent feature according to the POSIX spec, so a
148             //       custom solution is still preferred.
149             import core.sys.posix.ucontext;
150         }
151     }
152 }
153 
154 ///////////////////////////////////////////////////////////////////////////////
155 // Fiber Entry Point and Context Switch
156 ///////////////////////////////////////////////////////////////////////////////
157 
158 private
159 {
160     import core.atomic : atomicStore, cas, MemoryOrder;
161     import core.exception : onOutOfMemoryError;
162     import core.stdc.stdlib : abort;
163 
164     extern (C) void fiber_entryPoint() nothrow
165     {
166         Fiber   obj = Fiber.getThis();
167         assert( obj );
168 
169         assert( Thread.getThis().m_curr is obj.m_ctxt );
170         atomicStore!(MemoryOrder.raw)(*cast(shared)&Thread.getThis().m_lock, false);
171         obj.m_ctxt.tstack = obj.m_ctxt.bstack;
172         obj.m_state = Fiber.State.EXEC;
173 
174         try
175         {
176             obj.run();
177         }
178         catch ( Throwable t )
179         {
180             obj.m_unhandled = t;
181         }
182 
183         static if ( __traits( compiles, ucontext_t ) )
184           obj.m_ucur = &obj.m_utxt;
185 
186         obj.m_state = Fiber.State.TERM;
187         obj.switchOut();
188     }
189 
190   // Look above the definition of 'class Fiber' for some information about the implementation of this routine
191   version (AsmExternal)
192   {
193       extern (C) void fiber_switchContext( void** oldp, void* newp ) nothrow @nogc;
194       version (AArch64)
195           extern (C) void fiber_trampoline() nothrow;
196   }
197   else
198     extern (C) void fiber_switchContext( void** oldp, void* newp ) nothrow @nogc
199     {
200         // NOTE: The data pushed and popped in this routine must match the
201         //       default stack created by Fiber.initStack or the initial
202         //       switch into a new context will fail.
203 
204         version (AsmX86_Windows)
205         {
206             asm pure nothrow @nogc
207             {
208                 naked;
209 
210                 // save current stack state
211                 push EBP;
212                 mov  EBP, ESP;
213                 push EDI;
214                 push ESI;
215                 push EBX;
216                 push dword ptr FS:[0];
217                 push dword ptr FS:[4];
218                 push dword ptr FS:[8];
219                 push EAX;
220 
221                 // store oldp again with more accurate address
222                 mov EAX, dword ptr 8[EBP];
223                 mov [EAX], ESP;
224                 // load newp to begin context switch
225                 mov ESP, dword ptr 12[EBP];
226 
227                 // load saved state from new stack
228                 pop EAX;
229                 pop dword ptr FS:[8];
230                 pop dword ptr FS:[4];
231                 pop dword ptr FS:[0];
232                 pop EBX;
233                 pop ESI;
234                 pop EDI;
235                 pop EBP;
236 
237                 // 'return' to complete switch
238                 pop ECX;
239                 jmp ECX;
240             }
241         }
242         else version (AsmX86_64_Windows)
243         {
244             asm pure nothrow @nogc
245             {
246                 naked;
247 
248                 // save current stack state
249                 // NOTE: When changing the layout of registers on the stack,
250                 //       make sure that the XMM registers are still aligned.
251                 //       On function entry, the stack is guaranteed to not
252                 //       be aligned to 16 bytes because of the return address
253                 //       on the stack.
254                 push RBP;
255                 mov  RBP, RSP;
256                 push R12;
257                 push R13;
258                 push R14;
259                 push R15;
260                 push RDI;
261                 push RSI;
262                 // 7 registers = 56 bytes; stack is now aligned to 16 bytes
263                 sub RSP, 160;
264                 movdqa [RSP + 144], XMM6;
265                 movdqa [RSP + 128], XMM7;
266                 movdqa [RSP + 112], XMM8;
267                 movdqa [RSP + 96], XMM9;
268                 movdqa [RSP + 80], XMM10;
269                 movdqa [RSP + 64], XMM11;
270                 movdqa [RSP + 48], XMM12;
271                 movdqa [RSP + 32], XMM13;
272                 movdqa [RSP + 16], XMM14;
273                 movdqa [RSP], XMM15;
274                 push RBX;
275                 xor  RAX,RAX;
276                 push qword ptr GS:[RAX];
277                 push qword ptr GS:8[RAX];
278                 push qword ptr GS:16[RAX];
279 
280                 // store oldp
281                 mov [RCX], RSP;
282                 // load newp to begin context switch
283                 mov RSP, RDX;
284 
285                 // load saved state from new stack
286                 pop qword ptr GS:16[RAX];
287                 pop qword ptr GS:8[RAX];
288                 pop qword ptr GS:[RAX];
289                 pop RBX;
290                 movdqa XMM15, [RSP];
291                 movdqa XMM14, [RSP + 16];
292                 movdqa XMM13, [RSP + 32];
293                 movdqa XMM12, [RSP + 48];
294                 movdqa XMM11, [RSP + 64];
295                 movdqa XMM10, [RSP + 80];
296                 movdqa XMM9, [RSP + 96];
297                 movdqa XMM8, [RSP + 112];
298                 movdqa XMM7, [RSP + 128];
299                 movdqa XMM6, [RSP + 144];
300                 add RSP, 160;
301                 pop RSI;
302                 pop RDI;
303                 pop R15;
304                 pop R14;
305                 pop R13;
306                 pop R12;
307                 pop RBP;
308 
309                 // 'return' to complete switch
310                 pop RCX;
311                 jmp RCX;
312             }
313         }
314         else version (AsmX86_Posix)
315         {
316             asm pure nothrow @nogc
317             {
318                 naked;
319 
320                 // save current stack state
321                 push EBP;
322                 mov  EBP, ESP;
323                 push EDI;
324                 push ESI;
325                 push EBX;
326                 push EAX;
327 
328                 // store oldp again with more accurate address
329                 mov EAX, dword ptr 8[EBP];
330                 mov [EAX], ESP;
331                 // load newp to begin context switch
332                 mov ESP, dword ptr 12[EBP];
333 
334                 // load saved state from new stack
335                 pop EAX;
336                 pop EBX;
337                 pop ESI;
338                 pop EDI;
339                 pop EBP;
340 
341                 // 'return' to complete switch
342                 pop ECX;
343                 jmp ECX;
344             }
345         }
346         else version (AsmX86_64_Posix)
347         {
348             asm pure nothrow @nogc
349             {
350                 naked;
351 
352                 // save current stack state
353                 push RBP;
354                 mov  RBP, RSP;
355                 push RBX;
356                 push R12;
357                 push R13;
358                 push R14;
359                 push R15;
360 
361                 // store oldp
362                 mov [RDI], RSP;
363                 // load newp to begin context switch
364                 mov RSP, RSI;
365 
366                 // load saved state from new stack
367                 pop R15;
368                 pop R14;
369                 pop R13;
370                 pop R12;
371                 pop RBX;
372                 pop RBP;
373 
374                 // 'return' to complete switch
375                 pop RCX;
376                 jmp RCX;
377             }
378         }
379         else static if ( __traits( compiles, ucontext_t ) )
380         {
381             Fiber   cfib = Fiber.getThis();
382             void*   ucur = cfib.m_ucur;
383 
384             *oldp = &ucur;
385             swapcontext( **(cast(ucontext_t***) oldp),
386                           *(cast(ucontext_t**)  newp) );
387         }
388         else
389             static assert(0, "Not implemented");
390     }
391 }
392 
393 
394 ///////////////////////////////////////////////////////////////////////////////
395 // Fiber
396 ///////////////////////////////////////////////////////////////////////////////
397 /*
398  * Documentation of Fiber internals:
399  *
400  * The main routines to implement when porting Fibers to new architectures are
401  * fiber_switchContext and initStack. Some version constants have to be defined
402  * for the new platform as well, search for "Fiber Platform Detection and Memory Allocation".
403  *
404  * Fibers are based on a concept called 'Context'. A Context describes the execution
405  * state of a Fiber or main thread which is fully described by the stack, some
406  * registers and a return address at which the Fiber/Thread should continue executing.
407  * Please note that not only each Fiber has a Context, but each thread also has got a
408  * Context which describes the threads stack and state. If you call Fiber fib; fib.call
409  * the first time in a thread you switch from Threads Context into the Fibers Context.
410  * If you call fib.yield in that Fiber you switch out of the Fibers context and back
411  * into the Thread Context. (However, this is not always the case. You can call a Fiber
412  * from within another Fiber, then you switch Contexts between the Fibers and the Thread
413  * Context is not involved)
414  *
415  * In all current implementations the registers and the return address are actually
416  * saved on a Contexts stack.
417  *
418  * The fiber_switchContext routine has got two parameters:
419  * void** a:  This is the _location_ where we have to store the current stack pointer,
420  *            the stack pointer of the currently executing Context (Fiber or Thread).
421  * void*  b:  This is the pointer to the stack of the Context which we want to switch into.
422  *            Note that we get the same pointer here as the one we stored into the void** a
423  *            in a previous call to fiber_switchContext.
424  *
425  * In the simplest case, a fiber_switchContext rountine looks like this:
426  * fiber_switchContext:
427  *     push {return Address}
428  *     push {registers}
429  *     copy {stack pointer} into {location pointed to by a}
430  *     //We have now switch to the stack of a different Context!
431  *     copy {b} into {stack pointer}
432  *     pop {registers}
433  *     pop {return Address}
434  *     jump to {return Address}
435  *
436  * The GC uses the value returned in parameter a to scan the Fibers stack. It scans from
437  * the stack base to that value. As the GC dislikes false pointers we can actually optimize
438  * this a little: By storing registers which can not contain references to memory managed
439  * by the GC outside of the region marked by the stack base pointer and the stack pointer
440  * saved in fiber_switchContext we can prevent the GC from scanning them.
441  * Such registers are usually floating point registers and the return address. In order to
442  * implement this, we return a modified stack pointer from fiber_switchContext. However,
443  * we have to remember that when we restore the registers from the stack!
444  *
445  * --------------------------- <= Stack Base
446  * |          Frame          | <= Many other stack frames
447  * |          Frame          |
448  * |-------------------------| <= The last stack frame. This one is created by fiber_switchContext
449  * | registers with pointers |
450  * |                         | <= Stack pointer. GC stops scanning here
451  * |   return address        |
452  * |floating point registers |
453  * --------------------------- <= Real Stack End
454  *
455  * fiber_switchContext:
456  *     push {registers with pointers}
457  *     copy {stack pointer} into {location pointed to by a}
458  *     push {return Address}
459  *     push {Floating point registers}
460  *     //We have now switch to the stack of a different Context!
461  *     copy {b} into {stack pointer}
462  *     //We now have to adjust the stack pointer to point to 'Real Stack End' so we can pop
463  *     //the FP registers
464  *     //+ or - depends on if your stack grows downwards or upwards
465  *     {stack pointer} = {stack pointer} +- ({FPRegisters}.sizeof + {return address}.sizeof}
466  *     pop {Floating point registers}
467  *     pop {return Address}
468  *     pop {registers with pointers}
469  *     jump to {return Address}
470  *
471  * So the question now is which registers need to be saved? This depends on the specific
472  * architecture ABI of course, but here are some general guidelines:
473  * - If a register is callee-save (if the callee modifies the register it must saved and
474  *   restored by the callee) it needs to be saved/restored in switchContext
475  * - If a register is caller-save it needn't be saved/restored. (Calling fiber_switchContext
476  *   is a function call and the compiler therefore already must save these registers before
477  *   calling fiber_switchContext)
478  * - Argument registers used for passing parameters to functions needn't be saved/restored
479  * - The return register needn't be saved/restored (fiber_switchContext hasn't got a return type)
480  * - All scratch registers needn't be saved/restored
481  * - The link register usually needn't be saved/restored (but sometimes it must be cleared -
482  *   see below for details)
483  * - The frame pointer register - if it exists - is usually callee-save
484  * - All current implementations do not save control registers
485  *
486  * What happens on the first switch into a Fiber? We never saved a state for this fiber before,
487  * but the initial state is prepared in the initStack routine. (This routine will also be called
488  * when a Fiber is being resetted). initStack must produce exactly the same stack layout as the
489  * part of fiber_switchContext which saves the registers. Pay special attention to set the stack
490  * pointer correctly if you use the GC optimization mentioned before. the return Address saved in
491  * initStack must be the address of fiber_entrypoint.
492  *
493  * There's now a small but important difference between the first context switch into a fiber and
494  * further context switches. On the first switch, Fiber.call is used and the returnAddress in
495  * fiber_switchContext will point to fiber_entrypoint. The important thing here is that this jump
496  * is a _function call_, we call fiber_entrypoint by jumping before it's function prologue. On later
497  * calls, the user used yield() in a function, and therefore the return address points into a user
498  * function, after the yield call. So here the jump in fiber_switchContext is a _function return_,
499  * not a function call!
500  *
501  * The most important result of this is that on entering a function, i.e. fiber_entrypoint, we
502  * would have to provide a return address / set the link register once fiber_entrypoint
503  * returns. Now fiber_entrypoint does never return and therefore the actual value of the return
504  * address / link register is never read/used and therefore doesn't matter. When fiber_switchContext
505  * performs a _function return_ the value in the link register doesn't matter either.
506  * However, the link register will still be saved to the stack in fiber_entrypoint and some
507  * exception handling / stack unwinding code might read it from this stack location and crash.
508  * The exact solution depends on your architecture, but see the ARM implementation for a way
509  * to deal with this issue.
510  *
511  * The ARM implementation is meant to be used as a kind of documented example implementation.
512  * Look there for a concrete example.
513  *
514  * FIXME: fiber_entrypoint might benefit from a @noreturn attribute, but D doesn't have one.
515  */
516 
517 /**
518  * This class provides a cooperative concurrency mechanism integrated with the
519  * threading and garbage collection functionality.  Calling a fiber may be
520  * considered a blocking operation that returns when the fiber yields (via
521  * Fiber.yield()).  Execution occurs within the context of the calling thread
522  * so synchronization is not necessary to guarantee memory visibility so long
523  * as the same thread calls the fiber each time.  Please note that there is no
524  * requirement that a fiber be bound to one specific thread.  Rather, fibers
525  * may be freely passed between threads so long as they are not currently
526  * executing.  Like threads, a new fiber thread may be created using either
527  * derivation or composition, as in the following example.
528  *
529  * Warning:
530  * Status registers are not saved by the current implementations. This means
531  * floating point exception status bits (overflow, divide by 0), rounding mode
532  * and similar stuff is set per-thread, not per Fiber!
533  *
534  * Warning:
535  * On ARM FPU registers are not saved if druntime was compiled as ARM_SoftFloat.
536  * If such a build is used on a ARM_SoftFP system which actually has got a FPU
537  * and other libraries are using the FPU registers (other code is compiled
538  * as ARM_SoftFP) this can cause problems. Druntime must be compiled as
539  * ARM_SoftFP in this case.
540  *
541  * Authors: Based on a design by Mikola Lysenko.
542  */
543 class Fiber
544 {
545     ///////////////////////////////////////////////////////////////////////////
546     // Initialization
547     ///////////////////////////////////////////////////////////////////////////
548 
549     version (Windows)
550         // exception handling walks the stack, invoking DbgHelp.dll which
551         // needs up to 16k of stack space depending on the version of DbgHelp.dll,
552         // the existence of debug symbols and other conditions. Avoid causing
553         // stack overflows by defaulting to a larger stack size
554         enum defaultStackPages = 8;
555     else version (OSX)
556     {
557         version (X86_64)
558             // libunwind on macOS 11 now requires more stack space than 16k, so
559             // default to a larger stack size. This is only applied to X86 as
560             // the pageSize is still 4k, however on AArch64 it is 16k.
561             enum defaultStackPages = 8;
562         else
563             enum defaultStackPages = 4;
564     }
565     else
566         enum defaultStackPages = 4;
567 
568     /**
569      * Initializes a fiber object which is associated with a static
570      * D function.
571      *
572      * Params:
573      *  fn = The fiber function.
574      *  sz = The stack size for this fiber.
575      *  guardPageSize = size of the guard page to trap fiber's stack
576      *                  overflows. Beware that using this will increase
577      *                  the number of mmaped regions on platforms using mmap
578      *                  so an OS-imposed limit may be hit.
579      *
580      * In:
581      *  fn must not be null.
582      */
583     this( void function() fn, size_t sz = pageSize * defaultStackPages,
584           size_t guardPageSize = pageSize ) nothrow
585     in
586     {
587         assert( fn );
588     }
589     do
590     {
591         allocStack( sz, guardPageSize );
592         reset( fn );
593     }
594 
595 
596     /**
597      * Initializes a fiber object which is associated with a dynamic
598      * D function.
599      *
600      * Params:
601      *  dg = The fiber function.
602      *  sz = The stack size for this fiber.
603      *  guardPageSize = size of the guard page to trap fiber's stack
604      *                  overflows. Beware that using this will increase
605      *                  the number of mmaped regions on platforms using mmap
606      *                  so an OS-imposed limit may be hit.
607      *
608      * In:
609      *  dg must not be null.
610      */
611     this( void delegate() dg, size_t sz = pageSize * defaultStackPages,
612           size_t guardPageSize = pageSize ) nothrow
613     {
614         allocStack( sz, guardPageSize );
615         reset( cast(void delegate() const) dg );
616     }
617 
618 
619     /**
620      * Cleans up any remaining resources used by this object.
621      */
622     ~this() nothrow @nogc
623     {
624         // NOTE: A live reference to this object will exist on its associated
625         //       stack from the first time its call() method has been called
626         //       until its execution completes with State.TERM.  Thus, the only
627         //       times this dtor should be called are either if the fiber has
628         //       terminated (and therefore has no active stack) or if the user
629         //       explicitly deletes this object.  The latter case is an error
630         //       but is not easily tested for, since State.HOLD may imply that
631         //       the fiber was just created but has never been run.  There is
632         //       not a compelling case to create a State.INIT just to offer a
633         //       means of ensuring the user isn't violating this object's
634         //       contract, so for now this requirement will be enforced by
635         //       documentation only.
636         freeStack();
637     }
638 
639 
640     ///////////////////////////////////////////////////////////////////////////
641     // General Actions
642     ///////////////////////////////////////////////////////////////////////////
643 
644 
645     /**
646      * Transfers execution to this fiber object.  The calling context will be
647      * suspended until the fiber calls Fiber.yield() or until it terminates
648      * via an unhandled exception.
649      *
650      * Params:
651      *  rethrow = Rethrow any unhandled exception which may have caused this
652      *            fiber to terminate.
653      *
654      * In:
655      *  This fiber must be in state HOLD.
656      *
657      * Throws:
658      *  Any exception not handled by the joined thread.
659      *
660      * Returns:
661      *  Any exception not handled by this fiber if rethrow = false, null
662      *  otherwise.
663      */
664     // Not marked with any attributes, even though `nothrow @nogc` works
665     // because it calls arbitrary user code. Most of the implementation
666     // is already `@nogc nothrow`, but in order for `Fiber.call` to
667     // propagate the attributes of the user's function, the Fiber
668     // class needs to be templated.
669     final Throwable call( Rethrow rethrow = Rethrow.yes )
670     {
671         return rethrow ? call!(Rethrow.yes)() : call!(Rethrow.no);
672     }
673 
674     /// ditto
675     final Throwable call( Rethrow rethrow )()
676     {
677         callImpl();
678         if ( m_unhandled )
679         {
680             Throwable t = m_unhandled;
681             m_unhandled = null;
682             static if ( rethrow )
683                 throw t;
684             else
685                 return t;
686         }
687         return null;
688     }
689 
690     private void callImpl() nothrow @nogc
691     in
692     {
693         assert( m_state == State.HOLD );
694     }
695     do
696     {
697         Fiber   cur = getThis();
698 
699         static if ( __traits( compiles, ucontext_t ) )
700             m_ucur = cur ? &cur.m_utxt : &Fiber.sm_utxt;
701 
702         setThis( this );
703         this.switchIn();
704         setThis( cur );
705 
706         static if ( __traits( compiles, ucontext_t ) )
707             m_ucur = null;
708 
709         // NOTE: If the fiber has terminated then the stack pointers must be
710         //       reset.  This ensures that the stack for this fiber is not
711         //       scanned if the fiber has terminated.  This is necessary to
712         //       prevent any references lingering on the stack from delaying
713         //       the collection of otherwise dead objects.  The most notable
714         //       being the current object, which is referenced at the top of
715         //       fiber_entryPoint.
716         if ( m_state == State.TERM )
717         {
718             m_ctxt.tstack = m_ctxt.bstack;
719         }
720     }
721 
722     /// Flag to control rethrow behavior of $(D $(LREF call))
723     enum Rethrow : bool { no, yes }
724 
725     /**
726      * Resets this fiber so that it may be re-used, optionally with a
727      * new function/delegate.  This routine should only be called for
728      * fibers that have terminated, as doing otherwise could result in
729      * scope-dependent functionality that is not executed.
730      * Stack-based classes, for example, may not be cleaned up
731      * properly if a fiber is reset before it has terminated.
732      *
733      * In:
734      *  This fiber must be in state TERM or HOLD.
735      */
736     final void reset() nothrow @nogc
737     in
738     {
739         assert( m_state == State.TERM || m_state == State.HOLD );
740     }
741     do
742     {
743         m_ctxt.tstack = m_ctxt.bstack;
744         m_state = State.HOLD;
745         initStack();
746         m_unhandled = null;
747     }
748 
749     /// ditto
750     final void reset( void function() fn ) nothrow @nogc
751     {
752         reset();
753         m_call  = fn;
754     }
755 
756     /// ditto
757     final void reset( void delegate() dg ) nothrow @nogc
758     {
759         reset();
760         m_call  = dg;
761     }
762 
763     ///////////////////////////////////////////////////////////////////////////
764     // General Properties
765     ///////////////////////////////////////////////////////////////////////////
766 
767 
768     /// A fiber may occupy one of three states: HOLD, EXEC, and TERM.
769     enum State
770     {
771         /** The HOLD state applies to any fiber that is suspended and ready to
772         be called. */
773         HOLD,
774         /** The EXEC state will be set for any fiber that is currently
775         executing. */
776         EXEC,
777         /** The TERM state is set when a fiber terminates. Once a fiber
778         terminates, it must be reset before it may be called again. */
779         TERM
780     }
781 
782 
783     /**
784      * Gets the current state of this fiber.
785      *
786      * Returns:
787      *  The state of this fiber as an enumerated value.
788      */
789     final @property State state() const @safe pure nothrow @nogc
790     {
791         return m_state;
792     }
793 
794 
795     ///////////////////////////////////////////////////////////////////////////
796     // Actions on Calling Fiber
797     ///////////////////////////////////////////////////////////////////////////
798 
799 
800     /**
801      * Forces a context switch to occur away from the calling fiber.
802      */
803     static void yield() nothrow @nogc
804     {
805         Fiber   cur = getThis();
806         assert( cur, "Fiber.yield() called with no active fiber" );
807         assert( cur.m_state == State.EXEC );
808 
809         static if ( __traits( compiles, ucontext_t ) )
810           cur.m_ucur = &cur.m_utxt;
811 
812         cur.m_state = State.HOLD;
813         cur.switchOut();
814         cur.m_state = State.EXEC;
815     }
816 
817 
818     /**
819      * Forces a context switch to occur away from the calling fiber and then
820      * throws obj in the calling fiber.
821      *
822      * Params:
823      *  t = The object to throw.
824      *
825      * In:
826      *  t must not be null.
827      */
828     static void yieldAndThrow( Throwable t ) nothrow @nogc
829     in
830     {
831         assert( t );
832     }
833     do
834     {
835         Fiber   cur = getThis();
836         assert( cur, "Fiber.yield() called with no active fiber" );
837         assert( cur.m_state == State.EXEC );
838 
839         static if ( __traits( compiles, ucontext_t ) )
840           cur.m_ucur = &cur.m_utxt;
841 
842         cur.m_unhandled = t;
843         cur.m_state = State.HOLD;
844         cur.switchOut();
845         cur.m_state = State.EXEC;
846     }
847 
848 
849     ///////////////////////////////////////////////////////////////////////////
850     // Fiber Accessors
851     ///////////////////////////////////////////////////////////////////////////
852 
853 
854     /**
855      * Provides a reference to the calling fiber or null if no fiber is
856      * currently active.
857      *
858      * Returns:
859      *  The fiber object representing the calling fiber or null if no fiber
860      *  is currently active within this thread. The result of deleting this object is undefined.
861      */
862     static Fiber getThis() @safe nothrow @nogc
863     {
864         return sm_this;
865     }
866 
867 
868     ///////////////////////////////////////////////////////////////////////////
869     // Static Initialization
870     ///////////////////////////////////////////////////////////////////////////
871 
872 
873     version (Posix)
874     {
875         static this()
876         {
877             static if ( __traits( compiles, ucontext_t ) )
878             {
879               int status = getcontext( &sm_utxt );
880               assert( status == 0 );
881             }
882         }
883     }
884 
885 private:
886 
887     //
888     // Fiber entry point.  Invokes the function or delegate passed on
889     // construction (if any).
890     //
891     final void run()
892     {
893         m_call();
894     }
895 
896     //
897     // Standard fiber data
898     //
899     Callable            m_call;
900     bool                m_isRunning;
901     Throwable           m_unhandled;
902     State               m_state;
903 
904 
905 private:
906     ///////////////////////////////////////////////////////////////////////////
907     // Stack Management
908     ///////////////////////////////////////////////////////////////////////////
909 
910 
911     //
912     // Allocate a new stack for this fiber.
913     //
914     final void allocStack( size_t sz, size_t guardPageSize ) nothrow
915     in
916     {
917         assert( !m_pmem && !m_ctxt );
918     }
919     do
920     {
921         // adjust alloc size to a multiple of pageSize
922         sz += pageSize - 1;
923         sz -= sz % pageSize;
924 
925         // NOTE: This instance of Thread.Context is dynamic so Fiber objects
926         //       can be collected by the GC so long as no user level references
927         //       to the object exist.  If m_ctxt were not dynamic then its
928         //       presence in the global context list would be enough to keep
929         //       this object alive indefinitely.  An alternative to allocating
930         //       room for this struct explicitly would be to mash it into the
931         //       base of the stack being allocated below.  However, doing so
932         //       requires too much special logic to be worthwhile.
933         m_ctxt = new StackContext;
934 
935         version (Windows)
936         {
937             // reserve memory for stack
938             m_pmem = VirtualAlloc( null,
939                                    sz + guardPageSize,
940                                    MEM_RESERVE,
941                                    PAGE_NOACCESS );
942             if ( !m_pmem )
943                 onOutOfMemoryError();
944 
945             version (StackGrowsDown)
946             {
947                 void* stack = m_pmem + guardPageSize;
948                 void* guard = m_pmem;
949                 void* pbase = stack + sz;
950             }
951             else
952             {
953                 void* stack = m_pmem;
954                 void* guard = m_pmem + sz;
955                 void* pbase = stack;
956             }
957 
958             // allocate reserved stack segment
959             stack = VirtualAlloc( stack,
960                                   sz,
961                                   MEM_COMMIT,
962                                   PAGE_READWRITE );
963             if ( !stack )
964                 onOutOfMemoryError();
965 
966             if (guardPageSize)
967             {
968                 // allocate reserved guard page
969                 guard = VirtualAlloc( guard,
970                                       guardPageSize,
971                                       MEM_COMMIT,
972                                       PAGE_READWRITE | PAGE_GUARD );
973                 if ( !guard )
974                     onOutOfMemoryError();
975             }
976 
977             m_ctxt.bstack = pbase;
978             m_ctxt.tstack = pbase;
979             m_size = sz;
980         }
981         else
982         {
983             version (Posix) import core.sys.posix.sys.mman; // mmap, MAP_ANON
984 
985             static if ( __traits( compiles, ucontext_t ) )
986             {
987                 // Stack size must be at least the minimum allowable by the OS.
988                 if (sz < MINSIGSTKSZ)
989                     sz = MINSIGSTKSZ;
990             }
991 
992             static if ( __traits( compiles, mmap ) )
993             {
994                 // Allocate more for the memory guard
995                 sz += guardPageSize;
996 
997                 int mmap_flags = MAP_PRIVATE | MAP_ANON;
998                 version (OpenBSD)
999                     mmap_flags |= MAP_STACK;
1000 
1001                 m_pmem = mmap( null,
1002                                sz,
1003                                PROT_READ | PROT_WRITE,
1004                                mmap_flags,
1005                                -1,
1006                                0 );
1007                 if ( m_pmem == MAP_FAILED )
1008                     m_pmem = null;
1009             }
1010             else static if ( __traits( compiles, valloc ) )
1011             {
1012                 m_pmem = valloc( sz );
1013             }
1014             else static if ( __traits( compiles, malloc ) )
1015             {
1016                 m_pmem = malloc( sz );
1017             }
1018             else
1019             {
1020                 m_pmem = null;
1021             }
1022 
1023             if ( !m_pmem )
1024                 onOutOfMemoryError();
1025 
1026             version (StackGrowsDown)
1027             {
1028                 m_ctxt.bstack = m_pmem + sz;
1029                 m_ctxt.tstack = m_pmem + sz;
1030                 void* guard = m_pmem;
1031             }
1032             else
1033             {
1034                 m_ctxt.bstack = m_pmem;
1035                 m_ctxt.tstack = m_pmem;
1036                 void* guard = m_pmem + sz - guardPageSize;
1037             }
1038             m_size = sz;
1039 
1040             static if ( __traits( compiles, mmap ) )
1041             {
1042                 if (guardPageSize)
1043                 {
1044                     // protect end of stack
1045                     if ( mprotect(guard, guardPageSize, PROT_NONE) == -1 )
1046                         abort();
1047                 }
1048             }
1049             else
1050             {
1051                 // Supported only for mmap allocated memory - results are
1052                 // undefined if applied to memory not obtained by mmap
1053             }
1054         }
1055 
1056         Thread.add( m_ctxt );
1057     }
1058 
1059 
1060     //
1061     // Free this fiber's stack.
1062     //
1063     final void freeStack() nothrow @nogc
1064     in
1065     {
1066         assert( m_pmem && m_ctxt );
1067     }
1068     do
1069     {
1070         // NOTE: m_ctxt is guaranteed to be alive because it is held in the
1071         //       global context list.
1072         Thread.slock.lock_nothrow();
1073         scope(exit) Thread.slock.unlock_nothrow();
1074         Thread.remove( m_ctxt );
1075 
1076         version (Windows)
1077         {
1078             VirtualFree( m_pmem, 0, MEM_RELEASE );
1079         }
1080         else
1081         {
1082             import core.sys.posix.sys.mman; // munmap
1083 
1084             static if ( __traits( compiles, mmap ) )
1085             {
1086                 munmap( m_pmem, m_size );
1087             }
1088             else static if ( __traits( compiles, valloc ) )
1089             {
1090                 free( m_pmem );
1091             }
1092             else static if ( __traits( compiles, malloc ) )
1093             {
1094                 free( m_pmem );
1095             }
1096         }
1097         m_pmem = null;
1098         m_ctxt = null;
1099     }
1100 
1101 
1102     //
1103     // Initialize the allocated stack.
1104     // Look above the definition of 'class Fiber' for some information about the implementation of this routine
1105     //
1106     final void initStack() nothrow @nogc
1107     in
1108     {
1109         assert( m_ctxt.tstack && m_ctxt.tstack == m_ctxt.bstack );
1110         assert( cast(size_t) m_ctxt.bstack % (void*).sizeof == 0 );
1111     }
1112     do
1113     {
1114         void* pstack = m_ctxt.tstack;
1115         scope( exit )  m_ctxt.tstack = pstack;
1116 
1117         void push( size_t val ) nothrow
1118         {
1119             version (StackGrowsDown)
1120             {
1121                 pstack -= size_t.sizeof;
1122                 *(cast(size_t*) pstack) = val;
1123             }
1124             else
1125             {
1126                 pstack += size_t.sizeof;
1127                 *(cast(size_t*) pstack) = val;
1128             }
1129         }
1130 
1131         // NOTE: On OS X the stack must be 16-byte aligned according
1132         // to the IA-32 call spec. For x86_64 the stack also needs to
1133         // be aligned to 16-byte according to SysV AMD64 ABI.
1134         version (AlignFiberStackTo16Byte)
1135         {
1136             version (StackGrowsDown)
1137             {
1138                 pstack = cast(void*)(cast(size_t)(pstack) - (cast(size_t)(pstack) & 0x0F));
1139             }
1140             else
1141             {
1142                 pstack = cast(void*)(cast(size_t)(pstack) + (cast(size_t)(pstack) & 0x0F));
1143             }
1144         }
1145 
1146         version (AsmX86_Windows)
1147         {
1148             version (StackGrowsDown) {} else static assert( false );
1149 
1150             // On Windows Server 2008 and 2008 R2, an exploit mitigation
1151             // technique known as SEHOP is activated by default. To avoid
1152             // hijacking of the exception handler chain, the presence of a
1153             // Windows-internal handler (ntdll.dll!FinalExceptionHandler) at
1154             // its end is tested by RaiseException. If it is not present, all
1155             // handlers are disregarded, and the program is thus aborted
1156             // (see http://blogs.technet.com/b/srd/archive/2009/02/02/
1157             // preventing-the-exploitation-of-seh-overwrites-with-sehop.aspx).
1158             // For new threads, this handler is installed by Windows immediately
1159             // after creation. To make exception handling work in fibers, we
1160             // have to insert it for our new stacks manually as well.
1161             //
1162             // To do this, we first determine the handler by traversing the SEH
1163             // chain of the current thread until its end, and then construct a
1164             // registration block for the last handler on the newly created
1165             // thread. We then continue to push all the initial register values
1166             // for the first context switch as for the other implementations.
1167             //
1168             // Note that this handler is never actually invoked, as we install
1169             // our own one on top of it in the fiber entry point function.
1170             // Thus, it should not have any effects on OSes not implementing
1171             // exception chain verification.
1172 
1173             alias fp_t = void function(); // Actual signature not relevant.
1174             static struct EXCEPTION_REGISTRATION
1175             {
1176                 EXCEPTION_REGISTRATION* next; // sehChainEnd if last one.
1177                 fp_t handler;
1178             }
1179             enum sehChainEnd = cast(EXCEPTION_REGISTRATION*) 0xFFFFFFFF;
1180 
1181             __gshared static fp_t finalHandler = null;
1182             if ( finalHandler is null )
1183             {
1184                 static EXCEPTION_REGISTRATION* fs0() nothrow
1185                 {
1186                     asm pure nothrow @nogc
1187                     {
1188                         naked;
1189                         mov EAX, FS:[0];
1190                         ret;
1191                     }
1192                 }
1193                 auto reg = fs0();
1194                 while ( reg.next != sehChainEnd ) reg = reg.next;
1195 
1196                 // Benign races are okay here, just to avoid re-lookup on every
1197                 // fiber creation.
1198                 finalHandler = reg.handler;
1199             }
1200 
1201             // When linking with /safeseh (supported by LDC, but not DMD)
1202             // the exception chain must not extend to the very top
1203             // of the stack, otherwise the exception chain is also considered
1204             // invalid. Reserving additional 4 bytes at the top of the stack will
1205             // keep the EXCEPTION_REGISTRATION below that limit
1206             size_t reserve = EXCEPTION_REGISTRATION.sizeof + 4;
1207             pstack -= reserve;
1208             *(cast(EXCEPTION_REGISTRATION*)pstack) =
1209                 EXCEPTION_REGISTRATION( sehChainEnd, finalHandler );
1210             auto pChainEnd = pstack;
1211 
1212             push( cast(size_t) &fiber_entryPoint );                 // EIP
1213             push( cast(size_t) m_ctxt.bstack - reserve );           // EBP
1214             push( 0x00000000 );                                     // EDI
1215             push( 0x00000000 );                                     // ESI
1216             push( 0x00000000 );                                     // EBX
1217             push( cast(size_t) pChainEnd );                         // FS:[0]
1218             push( cast(size_t) m_ctxt.bstack );                     // FS:[4]
1219             push( cast(size_t) m_ctxt.bstack - m_size );            // FS:[8]
1220             push( 0x00000000 );                                     // EAX
1221         }
1222         else version (AsmX86_64_Windows)
1223         {
1224             // Using this trampoline instead of the raw fiber_entryPoint
1225             // ensures that during context switches, source and destination
1226             // stacks have the same alignment. Otherwise, the stack would need
1227             // to be shifted by 8 bytes for the first call, as fiber_entryPoint
1228             // is an actual function expecting a stack which is not aligned
1229             // to 16 bytes.
1230             static void trampoline()
1231             {
1232                 asm pure nothrow @nogc
1233                 {
1234                     naked;
1235                     sub RSP, 32; // Shadow space (Win64 calling convention)
1236                     call fiber_entryPoint;
1237                     xor RCX, RCX; // This should never be reached, as
1238                     jmp RCX;      // fiber_entryPoint must never return.
1239                 }
1240             }
1241 
1242             push( cast(size_t) &trampoline );                       // RIP
1243             push( 0x00000000_00000000 );                            // RBP
1244             push( 0x00000000_00000000 );                            // R12
1245             push( 0x00000000_00000000 );                            // R13
1246             push( 0x00000000_00000000 );                            // R14
1247             push( 0x00000000_00000000 );                            // R15
1248             push( 0x00000000_00000000 );                            // RDI
1249             push( 0x00000000_00000000 );                            // RSI
1250             push( 0x00000000_00000000 );                            // XMM6 (high)
1251             push( 0x00000000_00000000 );                            // XMM6 (low)
1252             push( 0x00000000_00000000 );                            // XMM7 (high)
1253             push( 0x00000000_00000000 );                            // XMM7 (low)
1254             push( 0x00000000_00000000 );                            // XMM8 (high)
1255             push( 0x00000000_00000000 );                            // XMM8 (low)
1256             push( 0x00000000_00000000 );                            // XMM9 (high)
1257             push( 0x00000000_00000000 );                            // XMM9 (low)
1258             push( 0x00000000_00000000 );                            // XMM10 (high)
1259             push( 0x00000000_00000000 );                            // XMM10 (low)
1260             push( 0x00000000_00000000 );                            // XMM11 (high)
1261             push( 0x00000000_00000000 );                            // XMM11 (low)
1262             push( 0x00000000_00000000 );                            // XMM12 (high)
1263             push( 0x00000000_00000000 );                            // XMM12 (low)
1264             push( 0x00000000_00000000 );                            // XMM13 (high)
1265             push( 0x00000000_00000000 );                            // XMM13 (low)
1266             push( 0x00000000_00000000 );                            // XMM14 (high)
1267             push( 0x00000000_00000000 );                            // XMM14 (low)
1268             push( 0x00000000_00000000 );                            // XMM15 (high)
1269             push( 0x00000000_00000000 );                            // XMM15 (low)
1270             push( 0x00000000_00000000 );                            // RBX
1271             push( 0xFFFFFFFF_FFFFFFFF );                            // GS:[0]
1272             version (StackGrowsDown)
1273             {
1274                 push( cast(size_t) m_ctxt.bstack );                 // GS:[8]
1275                 push( cast(size_t) m_ctxt.bstack - m_size );        // GS:[16]
1276             }
1277             else
1278             {
1279                 push( cast(size_t) m_ctxt.bstack );                 // GS:[8]
1280                 push( cast(size_t) m_ctxt.bstack + m_size );        // GS:[16]
1281             }
1282         }
1283         else version (AsmX86_Posix)
1284         {
1285             push( 0x00000000 );                                     // Return address of fiber_entryPoint call
1286             push( cast(size_t) &fiber_entryPoint );                 // EIP
1287             push( cast(size_t) m_ctxt.bstack );                     // EBP
1288             push( 0x00000000 );                                     // EDI
1289             push( 0x00000000 );                                     // ESI
1290             push( 0x00000000 );                                     // EBX
1291             push( 0x00000000 );                                     // EAX
1292         }
1293         else version (AsmX86_64_Posix)
1294         {
1295             push( 0x00000000_00000000 );                            // Return address of fiber_entryPoint call
1296             push( cast(size_t) &fiber_entryPoint );                 // RIP
1297             push( cast(size_t) m_ctxt.bstack );                     // RBP
1298             push( 0x00000000_00000000 );                            // RBX
1299             push( 0x00000000_00000000 );                            // R12
1300             push( 0x00000000_00000000 );                            // R13
1301             push( 0x00000000_00000000 );                            // R14
1302             push( 0x00000000_00000000 );                            // R15
1303         }
1304         else version (AsmPPC_Posix)
1305         {
1306             version (StackGrowsDown)
1307             {
1308                 pstack -= int.sizeof * 5;
1309             }
1310             else
1311             {
1312                 pstack += int.sizeof * 5;
1313             }
1314 
1315             push( cast(size_t) &fiber_entryPoint );     // link register
1316             push( 0x00000000 );                         // control register
1317             push( 0x00000000 );                         // old stack pointer
1318 
1319             // GPR values
1320             version (StackGrowsDown)
1321             {
1322                 pstack -= int.sizeof * 20;
1323             }
1324             else
1325             {
1326                 pstack += int.sizeof * 20;
1327             }
1328 
1329             assert( (cast(size_t) pstack & 0x0f) == 0 );
1330         }
1331         else version (AsmPPC_Darwin)
1332         {
1333             version (StackGrowsDown) {}
1334             else static assert(false, "PowerPC Darwin only supports decrementing stacks");
1335 
1336             uint wsize = size_t.sizeof;
1337 
1338             // linkage + regs + FPRs + VRs
1339             uint space = 8 * wsize + 20 * wsize + 18 * 8 + 12 * 16;
1340             (cast(ubyte*)pstack - space)[0 .. space] = 0;
1341 
1342             pstack -= wsize * 6;
1343             *cast(size_t*)pstack = cast(size_t) &fiber_entryPoint; // LR
1344             pstack -= wsize * 22;
1345 
1346             // On Darwin PPC64 pthread self is in R13 (which is reserved).
1347             // At present, it is not safe to migrate fibers between threads, but if that
1348             // changes, then updating the value of R13 will also need to be handled.
1349             version (PPC64)
1350               *cast(size_t*)(pstack + wsize) = cast(size_t) Thread.getThis().m_addr;
1351             assert( (cast(size_t) pstack & 0x0f) == 0 );
1352         }
1353         else version (AsmMIPS_O32_Posix)
1354         {
1355             version (StackGrowsDown) {}
1356             else static assert(0);
1357 
1358             /* We keep the FP registers and the return address below
1359              * the stack pointer, so they don't get scanned by the
1360              * GC. The last frame before swapping the stack pointer is
1361              * organized like the following.
1362              *
1363              *     |-----------|<= frame pointer
1364              *     |    $gp    |
1365              *     |   $s0-8   |
1366              *     |-----------|<= stack pointer
1367              *     |    $ra    |
1368              *     |  align(8) |
1369              *     |  $f20-30  |
1370              *     |-----------|
1371              *
1372              */
1373             enum SZ_GP = 10 * size_t.sizeof; // $gp + $s0-8
1374             enum SZ_RA = size_t.sizeof;      // $ra
1375             version (MIPS_HardFloat)
1376             {
1377                 enum SZ_FP = 6 * 8;          // $f20-30
1378                 enum ALIGN = -(SZ_FP + SZ_RA) & (8 - 1);
1379             }
1380             else
1381             {
1382                 enum SZ_FP = 0;
1383                 enum ALIGN = 0;
1384             }
1385 
1386             enum BELOW = SZ_FP + ALIGN + SZ_RA;
1387             enum ABOVE = SZ_GP;
1388             enum SZ = BELOW + ABOVE;
1389 
1390             (cast(ubyte*)pstack - SZ)[0 .. SZ] = 0;
1391             pstack -= ABOVE;
1392             *cast(size_t*)(pstack - SZ_RA) = cast(size_t)&fiber_entryPoint;
1393         }
1394         else version (AsmLoongArch64_Posix)
1395         {
1396             version (StackGrowsDown) {}
1397             else static assert(0);
1398 
1399             // Like others, FP registers and return address (ra) are kept
1400             // below the saved stack top (tstack) to hide from GC scanning.
1401             // The newp stack should look like this on LoongArch64:
1402             // 18: fp     <- pstack
1403             // ...
1404             //  9: s0     <- newp tstack
1405             //  8: ra     [&fiber_entryPoint]
1406             //  7: fs7
1407             // ...
1408             //  1: fs1
1409             //  0: fs0
1410             pstack -= 10 * size_t.sizeof; // skip s0-s8 and fp
1411             // set $ra
1412             push( cast(size_t) &fiber_entryPoint );
1413             pstack += size_t.sizeof;
1414         }
1415         else version (AsmAArch64_Posix)
1416         {
1417             // Like others, FP registers and return address (lr) are kept
1418             // below the saved stack top (tstack) to hide from GC scanning.
1419             // fiber_switchContext expects newp sp to look like this:
1420             //   19: x19
1421             //   ...
1422             //    9: x29 (fp)  <-- newp tstack
1423             //    8: x30 (lr)  [&fiber_entryPoint]
1424             //    7: d8
1425             //   ...
1426             //    0: d15
1427 
1428             version (StackGrowsDown) {}
1429             else
1430                 static assert(false, "Only full descending stacks supported on AArch64");
1431 
1432             // Only need to set return address (lr).  Everything else is fine
1433             // zero initialized.
1434             pstack -= size_t.sizeof * 11;    // skip past x19-x29
1435             push(cast(size_t) &fiber_trampoline); // see threadasm.S for docs
1436             pstack += size_t.sizeof;         // adjust sp (newp) above lr
1437         }
1438         else version (AsmARM_Posix)
1439         {
1440             /* We keep the FP registers and the return address below
1441              * the stack pointer, so they don't get scanned by the
1442              * GC. The last frame before swapping the stack pointer is
1443              * organized like the following.
1444              *
1445              *   |  |-----------|<= 'frame starts here'
1446              *   |  |     fp    | (the actual frame pointer, r11 isn't
1447              *   |  |   r10-r4  |  updated and still points to the previous frame)
1448              *   |  |-----------|<= stack pointer
1449              *   |  |     lr    |
1450              *   |  | 4byte pad |
1451              *   |  |   d15-d8  |(if FP supported)
1452              *   |  |-----------|
1453              *   Y
1454              *   stack grows down: The pointer value here is smaller than some lines above
1455              */
1456             // frame pointer can be zero, r10-r4 also zero initialized
1457             version (StackGrowsDown)
1458                 pstack -= int.sizeof * 8;
1459             else
1460                 static assert(false, "Only full descending stacks supported on ARM");
1461 
1462             // link register
1463             push( cast(size_t) &fiber_entryPoint );
1464             /*
1465              * We do not push padding and d15-d8 as those are zero initialized anyway
1466              * Position the stack pointer above the lr register
1467              */
1468             pstack += int.sizeof * 1;
1469         }
1470         else static if ( __traits( compiles, ucontext_t ) )
1471         {
1472             getcontext( &m_utxt );
1473             m_utxt.uc_stack.ss_sp   = m_pmem;
1474             m_utxt.uc_stack.ss_size = m_size;
1475             makecontext( &m_utxt, &fiber_entryPoint, 0 );
1476             // NOTE: If ucontext is being used then the top of the stack will
1477             //       be a pointer to the ucontext_t struct for that fiber.
1478             push( cast(size_t) &m_utxt );
1479         }
1480         else
1481             static assert(0, "Not implemented");
1482     }
1483 
1484 
1485     StackContext*   m_ctxt;
1486     size_t          m_size;
1487     void*           m_pmem;
1488 
1489     static if ( __traits( compiles, ucontext_t ) )
1490     {
1491         // NOTE: The static ucontext instance is used to represent the context
1492         //       of the executing thread.
1493         static ucontext_t       sm_utxt = void;
1494         ucontext_t              m_utxt  = void;
1495         ucontext_t*             m_ucur  = null;
1496     }
1497 
1498 
1499 private:
1500     ///////////////////////////////////////////////////////////////////////////
1501     // Storage of Active Fiber
1502     ///////////////////////////////////////////////////////////////////////////
1503 
1504 
1505     //
1506     // Sets a thread-local reference to the current fiber object.
1507     //
1508     static void setThis( Fiber f ) nothrow @nogc
1509     {
1510         sm_this = f;
1511     }
1512 
1513     static Fiber sm_this;
1514 
1515 
1516 private:
1517     ///////////////////////////////////////////////////////////////////////////
1518     // Context Switching
1519     ///////////////////////////////////////////////////////////////////////////
1520 
1521 
1522     //
1523     // Switches into the stack held by this fiber.
1524     //
1525     final void switchIn() nothrow @nogc
1526     {
1527         Thread  tobj = Thread.getThis();
1528         void**  oldp = &tobj.m_curr.tstack;
1529         void*   newp = m_ctxt.tstack;
1530 
1531         // NOTE: The order of operations here is very important.  The current
1532         //       stack top must be stored before m_lock is set, and pushContext
1533         //       must not be called until after m_lock is set.  This process
1534         //       is intended to prevent a race condition with the suspend
1535         //       mechanism used for garbage collection.  If it is not followed,
1536         //       a badly timed collection could cause the GC to scan from the
1537         //       bottom of one stack to the top of another, or to miss scanning
1538         //       a stack that still contains valid data.  The old stack pointer
1539         //       oldp will be set again before the context switch to guarantee
1540         //       that it points to exactly the correct stack location so the
1541         //       successive pop operations will succeed.
1542         *oldp = getStackTop();
1543         atomicStore!(MemoryOrder.raw)(*cast(shared)&tobj.m_lock, true);
1544         tobj.pushContext( m_ctxt );
1545 
1546         fiber_switchContext( oldp, newp );
1547 
1548         // NOTE: As above, these operations must be performed in a strict order
1549         //       to prevent Bad Things from happening.
1550         tobj.popContext();
1551         atomicStore!(MemoryOrder.raw)(*cast(shared)&tobj.m_lock, false);
1552         tobj.m_curr.tstack = tobj.m_curr.bstack;
1553     }
1554 
1555 
1556     //
1557     // Switches out of the current stack and into the enclosing stack.
1558     //
1559     final void switchOut() nothrow @nogc
1560     {
1561         Thread  tobj = Thread.getThis();
1562         void**  oldp = &m_ctxt.tstack;
1563         void*   newp = tobj.m_curr.within.tstack;
1564 
1565         // NOTE: The order of operations here is very important.  The current
1566         //       stack top must be stored before m_lock is set, and pushContext
1567         //       must not be called until after m_lock is set.  This process
1568         //       is intended to prevent a race condition with the suspend
1569         //       mechanism used for garbage collection.  If it is not followed,
1570         //       a badly timed collection could cause the GC to scan from the
1571         //       bottom of one stack to the top of another, or to miss scanning
1572         //       a stack that still contains valid data.  The old stack pointer
1573         //       oldp will be set again before the context switch to guarantee
1574         //       that it points to exactly the correct stack location so the
1575         //       successive pop operations will succeed.
1576         *oldp = getStackTop();
1577         atomicStore!(MemoryOrder.raw)(*cast(shared)&tobj.m_lock, true);
1578 
1579         fiber_switchContext( oldp, newp );
1580 
1581         // NOTE: As above, these operations must be performed in a strict order
1582         //       to prevent Bad Things from happening.
1583         // NOTE: If use of this fiber is multiplexed across threads, the thread
1584         //       executing here may be different from the one above, so get the
1585         //       current thread handle before unlocking, etc.
1586         tobj = Thread.getThis();
1587         atomicStore!(MemoryOrder.raw)(*cast(shared)&tobj.m_lock, false);
1588         tobj.m_curr.tstack = tobj.m_curr.bstack;
1589     }
1590 }
1591 
1592 ///
1593 unittest {
1594     int counter;
1595 
1596     class DerivedFiber : Fiber
1597     {
1598         this()
1599         {
1600             super( &run );
1601         }
1602 
1603     private :
1604         void run()
1605         {
1606             counter += 2;
1607         }
1608     }
1609 
1610     void fiberFunc()
1611     {
1612         counter += 4;
1613         Fiber.yield();
1614         counter += 8;
1615     }
1616 
1617     // create instances of each type
1618     Fiber derived = new DerivedFiber();
1619     Fiber composed = new Fiber( &fiberFunc );
1620 
1621     assert( counter == 0 );
1622 
1623     derived.call();
1624     assert( counter == 2, "Derived fiber increment." );
1625 
1626     composed.call();
1627     assert( counter == 6, "First composed fiber increment." );
1628 
1629     counter += 16;
1630     assert( counter == 22, "Calling context increment." );
1631 
1632     composed.call();
1633     assert( counter == 30, "Second composed fiber increment." );
1634 
1635     // since each fiber has run to completion, each should have state TERM
1636     assert( derived.state == Fiber.State.TERM );
1637     assert( composed.state == Fiber.State.TERM );
1638 }
1639 
1640 version (CoreUnittest)
1641 {
1642     class TestFiber : Fiber
1643     {
1644         this()
1645         {
1646             super(&run);
1647         }
1648 
1649         void run()
1650         {
1651             foreach (i; 0 .. 1000)
1652             {
1653                 sum += i;
1654                 Fiber.yield();
1655             }
1656         }
1657 
1658         enum expSum = 1000 * 999 / 2;
1659         size_t sum;
1660     }
1661 
1662     void runTen()
1663     {
1664         TestFiber[10] fibs;
1665         foreach (ref fib; fibs)
1666             fib = new TestFiber();
1667 
1668         bool cont;
1669         do {
1670             cont = false;
1671             foreach (fib; fibs) {
1672                 if (fib.state == Fiber.State.HOLD)
1673                 {
1674                     fib.call();
1675                     cont |= fib.state != Fiber.State.TERM;
1676                 }
1677             }
1678         } while (cont);
1679 
1680         foreach (fib; fibs)
1681         {
1682             assert(fib.sum == TestFiber.expSum);
1683         }
1684     }
1685 }
1686 
1687 
1688 // Single thread running separate fibers
1689 unittest
1690 {
1691     runTen();
1692 }
1693 
1694 
1695 // Multiple threads running separate fibers
1696 unittest
1697 {
1698     auto group = new ThreadGroup();
1699     foreach (_; 0 .. 4)
1700     {
1701         group.create(&runTen);
1702     }
1703     group.joinAll();
1704 }
1705 
1706 
1707 // Multiple threads running shared fibers
1708 unittest
1709 {
1710     shared bool[10] locks;
1711     TestFiber[10] fibs;
1712 
1713     void runShared()
1714     {
1715         bool cont;
1716         do {
1717             cont = false;
1718             foreach (idx; 0 .. 10)
1719             {
1720                 if (cas(&locks[idx], false, true))
1721                 {
1722                     if (fibs[idx].state == Fiber.State.HOLD)
1723                     {
1724                         fibs[idx].call();
1725                         cont |= fibs[idx].state != Fiber.State.TERM;
1726                     }
1727                     locks[idx] = false;
1728                 }
1729                 else
1730                 {
1731                     cont = true;
1732                 }
1733             }
1734         } while (cont);
1735     }
1736 
1737     foreach (ref fib; fibs)
1738     {
1739         fib = new TestFiber();
1740     }
1741 
1742     auto group = new ThreadGroup();
1743     foreach (_; 0 .. 4)
1744     {
1745         group.create(&runShared);
1746     }
1747     group.joinAll();
1748 
1749     foreach (fib; fibs)
1750     {
1751         assert(fib.sum == TestFiber.expSum);
1752     }
1753 }
1754 
1755 
1756 // Test exception handling inside fibers.
1757 unittest
1758 {
1759     enum MSG = "Test message.";
1760     string caughtMsg;
1761     (new Fiber({
1762         try
1763         {
1764             throw new Exception(MSG);
1765         }
1766         catch (Exception e)
1767         {
1768             caughtMsg = e.msg;
1769         }
1770     })).call();
1771     assert(caughtMsg == MSG);
1772 }
1773 
1774 
1775 unittest
1776 {
1777     int x = 0;
1778 
1779     (new Fiber({
1780         x++;
1781     })).call();
1782     assert( x == 1 );
1783 }
1784 
1785 nothrow unittest
1786 {
1787     new Fiber({}).call!(Fiber.Rethrow.no)();
1788 }
1789 
1790 unittest
1791 {
1792     new Fiber({}).call(Fiber.Rethrow.yes);
1793     new Fiber({}).call(Fiber.Rethrow.no);
1794 }
1795 
1796 unittest
1797 {
1798     enum MSG = "Test message.";
1799 
1800     try
1801     {
1802         (new Fiber(function() {
1803             throw new Exception( MSG );
1804         })).call();
1805         assert( false, "Expected rethrown exception." );
1806     }
1807     catch ( Throwable t )
1808     {
1809         assert( t.msg == MSG );
1810     }
1811 }
1812 
1813 // Test exception chaining when switching contexts in finally blocks.
1814 unittest
1815 {
1816     static void throwAndYield(string msg) {
1817       try {
1818         throw new Exception(msg);
1819       } finally {
1820         Fiber.yield();
1821       }
1822     }
1823 
1824     static void fiber(string name) {
1825       try {
1826         try {
1827           throwAndYield(name ~ ".1");
1828         } finally {
1829           throwAndYield(name ~ ".2");
1830         }
1831       } catch (Exception e) {
1832         assert(e.msg == name ~ ".1");
1833         assert(e.next);
1834         assert(e.next.msg == name ~ ".2");
1835         assert(!e.next.next);
1836       }
1837     }
1838 
1839     auto first = new Fiber(() => fiber("first"));
1840     auto second = new Fiber(() => fiber("second"));
1841     first.call();
1842     second.call();
1843     first.call();
1844     second.call();
1845     first.call();
1846     second.call();
1847     assert(first.state == Fiber.State.TERM);
1848     assert(second.state == Fiber.State.TERM);
1849 }
1850 
1851 // Test Fiber resetting
1852 unittest
1853 {
1854     static string method;
1855 
1856     static void foo()
1857     {
1858         method = "foo";
1859     }
1860 
1861     void bar()
1862     {
1863         method = "bar";
1864     }
1865 
1866     static void expect(Fiber fib, string s)
1867     {
1868         assert(fib.state == Fiber.State.HOLD);
1869         fib.call();
1870         assert(fib.state == Fiber.State.TERM);
1871         assert(method == s); method = null;
1872     }
1873     auto fib = new Fiber(&foo);
1874     expect(fib, "foo");
1875 
1876     fib.reset();
1877     expect(fib, "foo");
1878 
1879     fib.reset(&foo);
1880     expect(fib, "foo");
1881 
1882     fib.reset(&bar);
1883     expect(fib, "bar");
1884 
1885     fib.reset(function void(){method = "function";});
1886     expect(fib, "function");
1887 
1888     fib.reset(delegate void(){method = "delegate";});
1889     expect(fib, "delegate");
1890 }
1891 
1892 // Test unsafe reset in hold state
1893 unittest
1894 {
1895     auto fib = new Fiber(function {ubyte[2048] buf = void; Fiber.yield();}, 4096);
1896     foreach (_; 0 .. 10)
1897     {
1898         fib.call();
1899         assert(fib.state == Fiber.State.HOLD);
1900         fib.reset();
1901     }
1902 }
1903 
1904 // stress testing GC stack scanning
1905 unittest
1906 {
1907     import core.memory;
1908     import core.time : dur;
1909 
1910     static void unreferencedThreadObject()
1911     {
1912         static void sleep() { Thread.sleep(dur!"msecs"(100)); }
1913         auto thread = new Thread(&sleep).start();
1914     }
1915     unreferencedThreadObject();
1916     GC.collect();
1917 
1918     static class Foo
1919     {
1920         this(int value)
1921         {
1922             _value = value;
1923         }
1924 
1925         int bar()
1926         {
1927             return _value;
1928         }
1929 
1930         int _value;
1931     }
1932 
1933     static void collect()
1934     {
1935         auto foo = new Foo(2);
1936         assert(foo.bar() == 2);
1937         GC.collect();
1938         Fiber.yield();
1939         GC.collect();
1940         assert(foo.bar() == 2);
1941     }
1942 
1943     auto fiber = new Fiber(&collect);
1944 
1945     fiber.call();
1946     GC.collect();
1947     fiber.call();
1948 
1949     // thread reference
1950     auto foo = new Foo(2);
1951 
1952     void collect2()
1953     {
1954         assert(foo.bar() == 2);
1955         GC.collect();
1956         Fiber.yield();
1957         GC.collect();
1958         assert(foo.bar() == 2);
1959     }
1960 
1961     fiber = new Fiber(&collect2);
1962 
1963     fiber.call();
1964     GC.collect();
1965     fiber.call();
1966 
1967     static void recurse(size_t cnt)
1968     {
1969         --cnt;
1970         Fiber.yield();
1971         if (cnt)
1972         {
1973             auto fib = new Fiber(() { recurse(cnt); });
1974             fib.call();
1975             GC.collect();
1976             fib.call();
1977         }
1978     }
1979     fiber = new Fiber(() { recurse(20); });
1980     fiber.call();
1981 }
1982 
1983 
1984 version (AsmX86_64_Windows)
1985 {
1986     // Test Windows x64 calling convention
1987     unittest
1988     {
1989         void testNonvolatileRegister(alias REG)()
1990         {
1991             auto zeroRegister = new Fiber(() {
1992                 mixin("asm pure nothrow @nogc { naked; xor "~REG~", "~REG~"; ret; }");
1993             });
1994             long after;
1995 
1996             mixin("asm pure nothrow @nogc { mov "~REG~", 0xFFFFFFFFFFFFFFFF; }");
1997             zeroRegister.call();
1998             mixin("asm pure nothrow @nogc { mov after, "~REG~"; }");
1999 
2000             assert(after == -1);
2001         }
2002 
2003         void testNonvolatileRegisterSSE(alias REG)()
2004         {
2005             auto zeroRegister = new Fiber(() {
2006                 mixin("asm pure nothrow @nogc { naked; xorpd "~REG~", "~REG~"; ret; }");
2007             });
2008             long[2] before = [0xFFFFFFFF_FFFFFFFF, 0xFFFFFFFF_FFFFFFFF], after;
2009 
2010             mixin("asm pure nothrow @nogc { movdqu "~REG~", before; }");
2011             zeroRegister.call();
2012             mixin("asm pure nothrow @nogc { movdqu after, "~REG~"; }");
2013 
2014             assert(before == after);
2015         }
2016 
2017         testNonvolatileRegister!("R12")();
2018         testNonvolatileRegister!("R13")();
2019         testNonvolatileRegister!("R14")();
2020         testNonvolatileRegister!("R15")();
2021         testNonvolatileRegister!("RDI")();
2022         testNonvolatileRegister!("RSI")();
2023         testNonvolatileRegister!("RBX")();
2024 
2025         testNonvolatileRegisterSSE!("XMM6")();
2026         testNonvolatileRegisterSSE!("XMM7")();
2027         testNonvolatileRegisterSSE!("XMM8")();
2028         testNonvolatileRegisterSSE!("XMM9")();
2029         testNonvolatileRegisterSSE!("XMM10")();
2030         testNonvolatileRegisterSSE!("XMM11")();
2031         testNonvolatileRegisterSSE!("XMM12")();
2032         testNonvolatileRegisterSSE!("XMM13")();
2033         testNonvolatileRegisterSSE!("XMM14")();
2034         testNonvolatileRegisterSSE!("XMM15")();
2035     }
2036 }
2037 
2038 
2039 version (D_InlineAsm_X86_64)
2040 {
2041     unittest
2042     {
2043         void testStackAlignment()
2044         {
2045             void* pRSP;
2046             asm pure nothrow @nogc
2047             {
2048                 mov pRSP, RSP;
2049             }
2050             assert((cast(size_t)pRSP & 0xF) == 0);
2051         }
2052 
2053         auto fib = new Fiber(&testStackAlignment);
2054         fib.call();
2055     }
2056 }