1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
{
This file is part of the Free Component Library (FCL)
Copyright (c) 1998 by Florian Klaempfl
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$mode objfpc}
{$h+}
unit syncobjs;
interface
uses
sysutils;
type
PSecurityAttributes = Pointer;
TEventHandle = Pointer;
const
INFINITE = Cardinal(-1);
type
TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
TSynchroObject = class(TObject)
procedure Acquire;virtual;
procedure Release;virtual;
end;
TCriticalSection = class(TSynchroObject)
private
CriticalSection : TRTLCriticalSection;
public
procedure Acquire;override;
procedure Release;override;
procedure Enter;
function TryEnter:boolean;
procedure Leave;
constructor Create;
destructor Destroy;override;
end;
THandleObject = class(TSynchroObject)
protected
FHandle : TEventHandle;
FLastError : Integer;
public
destructor destroy;override;
property Handle : TEventHandle read FHandle;
property LastError : Integer read FLastError;
end;
TEventObject = class(THandleObject)
private
FManualReset: Boolean;
public
constructor Create(EventAttributes : PSecurityAttributes;
AManualReset,InitialState : Boolean;const Name : string);
destructor destroy; override;
procedure ResetEvent;
procedure SetEvent;
function WaitFor(Timeout : Cardinal) : TWaitResult;
Property ManualReset : Boolean read FManualReset;
end;
TEvent = TEventObject;
TSimpleEvent = class(TEventObject)
constructor Create;
end;
implementation
{ ---------------------------------------------------------------------
Real syncobjs implementation
---------------------------------------------------------------------}
{$IFDEF OS2}
type
TBasicEventState = record
FHandle: THandle;
FLastError: longint;
end;
PLocalEventRec = ^TBasicEventState;
{$ENDIF OS2}
procedure TSynchroObject.Acquire;
begin
end;
procedure TSynchroObject.Release;
begin
end;
procedure TCriticalSection.Enter;
begin
Acquire;
end;
procedure TCriticalSection.Leave;
begin
Release;
end;
function TCriticalSection.TryEnter:boolean;
begin
result:=TryEnterCriticalSection(CriticalSection)<>0;
end;
procedure TCriticalSection.Acquire;
begin
EnterCriticalSection(CriticalSection);
end;
procedure TCriticalSection.Release;
begin
LeaveCriticalSection(CriticalSection);
end;
constructor TCriticalSection.Create;
begin
Inherited Create;
InitCriticalSection(CriticalSection);
end;
destructor TCriticalSection.Destroy;
begin
DoneCriticalSection(CriticalSection);
end;
destructor THandleObject.destroy;
begin
end;
constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
AManualReset,InitialState : Boolean;const Name : string);
begin
FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name);
FManualReset:=AManualReset;
end;
destructor TEventObject.destroy;
begin
BasicEventDestroy(Handle);
end;
procedure TEventObject.ResetEvent;
begin
BasicEventResetEvent(Handle);
end;
procedure TEventObject.SetEvent;
begin
BasicEventSetEvent(Handle);
end;
function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
begin
Result := TWaitResult(basiceventWaitFor(Timeout, Handle));
if Result = wrError then
{$IFDEF OS2}
FLastError := PLocalEventRec (Handle)^.FLastError;
{$ELSE OS2}
FLastError := GetLastOSError;
{$ENDIF OS2}
end;
constructor TSimpleEvent.Create;
begin
inherited Create(nil, True, False, '');
end;
end.
|
