home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyThreads.p < prev    next >
Encoding:
Text File  |  1995-10-25  |  2.1 KB  |  96 lines  |  [TEXT/CWIE]
  1. unit MyThreads;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Threads;
  7.  
  8.     var
  9.         active_threads: integer; { YOU MUST DECREMENT active_threads }
  10.         threads_must_die:Boolean;
  11.         has_ThreadManager: boolean;
  12.  
  13.     procedure StartupThreads;
  14.     function MyNewThread (proc: ProcPtr; threadParam: univ Ptr; stack: longint):OSErr; { increments active_thread }
  15.     procedure MyThreadDied; { call when your thread dies to decrement active_threads }
  16.     procedure MyYield;
  17.  
  18. implementation
  19.  
  20.     uses
  21.         Events, GestaltEqu, CodeFragments, 
  22.         MyAssertions, MySystemGlobals, MyStartup, MyUtils;
  23.  
  24.     const
  25.         our_thread_stack = 12288;
  26.         our_thread_options = kCreateIfNeeded + kUsePremadeThread + kFPUNotNeeded;
  27.  
  28.     procedure MyThreadDied;
  29.     begin
  30.         active_threads := active_threads - 1;
  31.     end;
  32.     
  33.     function MyNewThread (proc: ProcPtr; threadParam: univ Ptr; stack: longint):OSErr;
  34.         var
  35.             err:OSerr;
  36.             thread: ThreadID;
  37.     begin
  38.         if stack = 0 then begin
  39.             stack := our_thread_stack;
  40.         end;
  41.         if not has_ThreadManager then begin
  42.             err := -1;
  43.         end else begin
  44.             err := NewThread(kCooperativeThread, proc, threadParam, stack, our_thread_options, nil, thread);
  45.         end;
  46.         if err = noErr then begin
  47.             active_threads := active_threads + 1;
  48.         end;
  49.         MyNewThread := err;
  50.     end;
  51.  
  52.     procedure MyYield;
  53.     begin
  54.         if has_ThreadManager then begin
  55.             Assert(YieldToAnyThread = noErr);
  56.         end;
  57.     end;
  58.  
  59.     procedure FinishMyThreads;{ waits for all threads to complete - ie active_threads=0 }
  60.         var
  61.             er: EventRecord;
  62.             dummy: boolean;
  63.     begin
  64.         threads_must_die := true;
  65.         while active_threads > 0 do begin
  66.             dummy := WaitNextEvent(everyEvent, er, 0, nil);
  67.             MyYield;
  68.         end;
  69.     end;
  70.  
  71.     function HasThreadLib: boolean;
  72.     begin
  73. {$IFC GENERATINGPOWERPC}
  74.         HasThreadLib := longint(@NewThread) <> kUnresolvedCFragSymbolAddress;
  75. {$ELSEC}
  76.         HasThreadLib := true;
  77. {$ENDC}
  78.     end;
  79.  
  80.     function InitThread(var msg: integer): OSStatus;
  81.         var
  82.             gv: longint;
  83.     begin
  84.         msg := msg; { Unused }
  85.         active_threads := 0;
  86.         has_ThreadManager := (Gestalt(gestaltThreadMgrAttr, gv) = noErr) & (TPbtst(gv, gestaltThreadMgrPresent)) & HasThreadLib;
  87.         InitThread := noErr;
  88.     end;
  89.     
  90.     procedure StartupThreads;
  91.     begin
  92.         SetStartup(InitThread, nil, 0, FinishMyThreads);
  93.     end;
  94.     
  95. end.
  96.