KOLIndy/myindy/MySyncObjs.pas

   1 { *************************************************************************** }
   2 {                                                                             }
   3 { Kylix and Delphi Cross-Platform Visual Component Library                    }
   4 {                                                                             }
   5 { Copyright (c) 1997, 2001 Borland Software Corporation                       }
   6 {                                                                             }
   7 { *************************************************************************** }
   8
   9
  10 unit MySyncObjs;
  11
  12 {$H+,X+}
  13
  14 interface
  15
  16 uses
  17 {$IFDEF MSWINDOWS}
  18   Windows,
  19   Messages;
  20 {$ENDIF}
  21 {$IFDEF LINUX}
  22   Libc;
  23 {$ENDIF}
  24
  25 type
  26 {$IFNDEF MSWINDOWS}
  27   PSecurityAttributes = pointer;
  28 {$ENDIF}
  29
  30   TSynchroObject = class(TObject)
  31   public
  32     procedure Acquire; virtual;
  33     procedure Release; virtual;
  34   end;
  35
  36   THandleObject = class(TSynchroObject)
  37 {$IFDEF MSWINDOWS}
  38   private
  39     FHandle: THandle;
  40     FLastError: Integer;
  41   public
  42     destructor Destroy; override;
  43     property LastError: Integer read FLastError;
  44     property Handle: THandle read FHandle;
  45 {$ENDIF}
  46   end;
  47
  48   TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
  49
  50   TEvent = class(THandleObject)
  51   {$IFDEF LINUX}
  52   private
  53     FEvent: TSemaphore;
  54     FManualReset: Boolean;
  55   {$ENDIF}
  56   public
  57     constructor Create(EventAttributes: PSecurityAttributes; ManualReset,
  58       InitialState: Boolean; const Name: string);
  59     function WaitFor(Timeout: LongWord): TWaitResult;
  60     procedure SetEvent;
  61     procedure ResetEvent;
  62   end;
  63
  64   TSimpleEvent = class(TEvent)
  65   public
  66     constructor Create;
  67   end;
  68
  69   TCriticalSection = class(TSynchroObject)
  70   protected
  71     FSection: TRTLCriticalSection;
  72   public
  73     constructor Create;
  74     destructor Destroy; override;
  75     procedure Acquire; override;
  76     procedure Release; override;
  77     procedure Enter;
  78     procedure Leave;
  79   end;
  80
  81 implementation
  82
  83 { TSynchroObject }
  84
  85 procedure TSynchroObject.Acquire;
  86 begin
  87 end;
  88
  89 procedure TSynchroObject.Release;
  90 begin
  91 end;
  92
  93 { THandleObject }
  94
  95 {$IFDEF MSWINDOWS}
  96 destructor THandleObject.Destroy;
  97 begin
  98   CloseHandle(FHandle);
  99   inherited Destroy;
 100 end;
 101 {$ENDIF}
 102
 103 { TEvent }
 104
 105 constructor TEvent.Create(EventAttributes: PSecurityAttributes; ManualReset,
 106   InitialState: Boolean; const Name: string);
 107 {$IFDEF MSWINDOWS}
 108 begin
 109   FHandle := CreateEvent(EventAttributes, ManualReset, InitialState, PChar(Name));
 110 end;
 111 {$ENDIF}
 112 {$IFDEF LINUX}
 113 var
 114    Value: Integer;
 115 begin
 116    if InitialState then
 117      Value := 1
 118   else
 119     Value := 0;
 120
 121   FManualReset := ManualReset;
 122
 123    sem_init(FEvent, False, Value);
 124 end;
 125 {$ENDIF}
 126
 127 function TEvent.WaitFor(Timeout: LongWord): TWaitResult;
 128 begin
 129 {$IFDEF MSWINDOWS}
 130   case WaitForSingleObject(Handle, Timeout) of
 131     WAIT_ABANDONED: Result := wrAbandoned;
 132     WAIT_OBJECT_0: Result := wrSignaled;
 133     WAIT_TIMEOUT: Result := wrTimeout;
 134     WAIT_FAILED:
 135       begin
 136         Result := wrError;
 137         FLastError := GetLastError;
 138       end;
 139   else
 140     Result := wrError;
 141   end;
 142 {$ENDIF}
 143 {$IFDEF LINUX}
 144   if Timeout = LongWord($FFFFFFFF) then
 145   begin
 146     sem_wait(FEvent);
 147     Result := wrSignaled;
 148   end
 149   else if FManualReset then
 150     sem_post(FEvent)
 151   else
 152     Result := wrError;
 153 {$ENDIF}
 154 end;
 155
 156 procedure TEvent.SetEvent;
 157 {$IFDEF MSWINDOWS}
 158 begin
 159   Windows.SetEvent(Handle);
 160 end;
 161 {$ENDIF}
 162 {$IFDEF LINUX}
 163 var
 164   I: Integer;
 165 begin
 166   sem_getvalue(FEvent, I);
 167   if I = 0 then
 168     sem_post(FEvent);
 169 end;
 170 {$ENDIF}
 171
 172 procedure TEvent.ResetEvent;
 173 begin
 174 {$IFDEF MSWINDOWS}
 175   Windows.ResetEvent(Handle);
 176 {$ENDIF}
 177 {$IFDEF LINUX}
 178   while sem_trywait(FEvent) = 0 do { nothing };
 179 {$ENDIF}
 180 end;
 181
 182 { TSimpleEvent }
 183
 184 constructor TSimpleEvent.Create;
 185 begin
 186   inherited Create(nil, True, False, '');
 187 end;
 188
 189 { TCriticalSection }
 190
 191 constructor TCriticalSection.Create;
 192 begin
 193   inherited Create;
 194   InitializeCriticalSection(FSection);
 195 end;
 196
 197 destructor TCriticalSection.Destroy;
 198 begin
 199   DeleteCriticalSection(FSection);
 200   inherited Destroy;
 201 end;
 202
 203 procedure TCriticalSection.Acquire;
 204 begin
 205   EnterCriticalSection(FSection);
 206 end;
 207
 208 procedure TCriticalSection.Release;
 209 begin
 210   LeaveCriticalSection(FSection);
 211 end;
 212
 213 procedure TCriticalSection.Enter;
 214 begin
 215   Acquire;
 216 end;
 217
 218 procedure TCriticalSection.Leave;
 219 begin
 220   Release;
 221 end;
 222
 223 end.