{...... (код приведен специально без заголовка)}



TYPE
  Item = POINTER TO RECORD
     time: LONGINT;
     thread, num: INTEGER;
     next: Item;
     ballast: ARRAY 100000 OF BYTE;
  END;

CONST
  MaxItemsCount = 1000;
   
VAR
  CriticalSection: WinApi.RTL_CRITICAL_SECTION;
  ItemListFront, ItemListBack: Item;
  items_count: INTEGER;
  t0: LONGINT;
   
PROCEDURE Action(IpParameter: INTEGER): INTEGER;
VAR x: Item; num: INTEGER;
BEGIN
  num := 0;
  WHILE items_count < MaxItemsCount DO
     WinApi.EnterCriticalSection(CriticalSection);
     IF items_count < MaxItemsCount THEN
        NEW(x);
        IF x # NIL THEN
           INC(items_count); INC(num);
           x.time := WinApi.GetTickCount() - t0;
           x.thread := IpParameter;
           x.num := num;
           IF ItemListBack # NIL THEN ItemListBack.next := x END;
           ItemListBack := x;
           IF ItemListFront = NIL THEN ItemListFront := ItemListBack END
        END
     END;
     WinApi.LeaveCriticalSection(CriticalSection);
     WinApi.Sleep(100)
  END;
  WinApi.ExitThread(0); RETURN 0
END Action;

PROCEDURE Main*;
CONST N = 1000;
VAR
  a, i: INTEGER;
  h: ARRAY N OF WinApi.HANDLE;
  t: ARRAY N OF INTEGER;
  x: Item;
BEGIN
  items_count := 0; ItemListFront := NIL; ItemListBack := NIL;
  WinApi.InitializeCriticalSection(CriticalSection);
  t0 := WinApi.GetTickCount();
  FOR i := 0 TO N-1 DO h[i] := WinApi.CreateThread(NIL, 0, Action, i+1, {}, t[i]) END;
  FOR i := 0 TO N-1 DO a := WinApi.WaitForSingleObject(h[i], WinApi.INFINITE) END;
  FOR i := 0 TO N-1 DO a := WinApi.CloseHandle(h[i]) END;
  WinApi.DeleteCriticalSection(CriticalSection);
  StdLog.Ln; StdLog.String('Items count = '); StdLog.Int(items_count); StdLog.Ln;
  x := ItemListFront; i := 1;
  WHILE x # NIL DO
     StdLog.Int(i); StdLog.String(")");
     StdLog.Int(x.thread); StdLog.Int(x.num); StdLog.Int(x.time); StdLog.Ln;
     INC(i); x := x.next
  END;
  ItemListFront := NIL; ItemListBack := NIL;
END Main;

END TestThreads2.