{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█                                                       █}
{█      Virtual Pascal Examples. Version 1.10            █}
{█      Thread local storage example                     █}
{█      ─────────────────────────────────────────────────█}
{█      Copyright (C) 1996 fPrint UK Ltd                 █}
{█                                                       █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}

program TlsDemo;

{$X+}

{ This example demonstrates the power of Thread Local Storage (TLS)     }
{ While TLS is totally transparent to the programmer, this program      }
{ demonstrated the use of it in multi-threaded programs                 }

Uses
  Use32, Os2Def, Os2Base, Crt, Dos;

{$IFDEF VPDEMO}
  {&Dynamic VP11Demo.Lib}
{$ENDIF}

//
// Since FindFirst/FindNext returns the result in the global DosError
// variable, unpredictable results are returned if TLS is not supported
//
function FindTest( p : Pointer ) : ApiRet;
Var
  ps    : ^String absolute p;
  Info  : SearchRec;
  Count : Integer;
begin
  Count := 0;
  FindFirst( ps^, Archive, Info );
  While DosError = 0 do    // DosError is instanced for every thread
    begin
      Inc( Count );
      DosSleep( 50 );      // Wait a little while
      FindNext( Info );
    end;
  Writeln( 'Thread ',GetThreadID,' found ',Count,' files matching "',ps^,'"' );
end;

procedure TLSDemoProc;
Const
  Data : Array[1..3] of String
       = ( '*.*', '*.EXE', '*.PAS' );
var
  i    : Integer;
  TID  : Array[1..3] of Longint;
  Open : Boolean;
  f    : File;

begin
  WriteLn;
  WriteLn( 'Starting 3 threads searching for files' );

  For i := Low(Data) to High(Data) do
    BeginThread( nil,             // Security attributes
                 16384,           // Stack Size in bytes
                 FindTest,        // Thread routine
                 @Data[i],        // Parameter pointer
                 Create_Ready OR
                 Stack_Committed, // Creation flags
                 TID[i] );        // Thread ID

  // Wait for threads to terminate
  Writeln( 'Press any key to exit ' );
  ReadKey;
  // Kill threads that are not done executing
  For i := Low(Data) to High(Data) do
    KillThread( TID[i] );
end;

begin
  WriteLn('Virtual Pascal TLS Demo      Version 1.10 Copyright (C) 1996 fPrint UK Ltd');

  TLSDemoProc;     // Demo of TLS with DosError
end.