ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/runtime/nongui/winipc.inc
(Generate patch)

Comparing ibx/trunk/runtime/nongui/winipc.inc (file contents):
Revision 318 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 319 by tony, Thu Feb 25 12:05:40 2021 UTC

# Line 1 | Line 1
1 + {Used by IBIPC and implements System V IPC}
2 +
3 + uses IBMessages;
4 +
5   const
6    MonitorHookNames: array[0..5] of String = (
7      'FB.SQL.MONITOR.Mutex1_0',
# Line 7 | Line 11 | const
11      'FB.SQL.MONITOR.ReadEvent1_0',
12      'FB.SQL.MONITOR.ReadFinishedEvent1_0'
13    );
14 <  cDefaultTimeout = 1000; { 1 seconds }
14 >  cDefaultTimeout = 1000; {seconds }
15  
16   type
13 –  TGlobalInterface = class;
14 –
17    {Interprocess Communication Objects. All platform dependent IPC is abstracted
18     into this set of objects }
19  
20    { TIpcCommon }
21  
22 <  TIpcCommon = class
21 <  private
22 <    function GetSa: PSecurityAttributes;
22 >  TIpcCommon = class(TInterfacedObject)
23    protected
24      class var FInitialiser: boolean;
25      FSa : TSecurityAttributes;
# Line 27 | Line 27 | type
27      Sd : TSecurityDescriptor;
28    public
29      constructor Create;
30 +    function GetSa: PSecurityAttributes;
31      property Sa : PSecurityAttributes read GetSa;
32    end;
33  
# Line 48 | Line 49 | type
49  
50    }
51  
52 <  TSharedMemory = class(TIpcCommon)
52 >  TSharedMemory = class(TIpcCommon,ISharedMemory)
53    private
54 <    FBuffer: PChar;
54 >    FBuffer: PByte;
55      FLastAllocationSize: integer;
56      FUnused: integer;
57 <    FBufptr: PChar;
57 >    FBufptr: PByte;
58      FSharedBuffer: THandle;
59      procedure GetSharedMemory(MemSize: integer);
60    public
61      constructor Create(MemSize: integer);
62      destructor Destroy; override;
63 <    function Allocate(Size: integer): PChar;
64 <    property LastAllocationSize: integer read FLastAllocationSize;
63 >    function Allocate(Size: integer): PByte;
64 >    function GetLastAllocationSize: integer;
65 >    property LastAllocationSize: integer read GetLastAllocationSize;
66    end;
67  
68    {TMutex}
69  
70 <  TMutex = class(TIpcCommon)
70 >  TMutex = class(TIpcCommon, IMutex)
71    private
72      FMutex: THandle;
73    public
# Line 96 | Line 98 | type
98      Always initialised to the Unlocked state
99    }
100  
101 <  TSingleLockGate = class(TIpcCommon)
101 >  TSingleLockGate = class(TIpcCommon,ISingleLockGate)
102    private
101 –    FOwner: TGlobalInterface;
103      FEvent: THandle;
104    public
105 <    constructor Create(EventName: string; AOwner: TGlobalInterface);
105 >    constructor Create(EventName: string);
106      destructor Destroy; override;
107      procedure PassthroughGate;
108      procedure Unlock;
# Line 137 | Line 138 | type
138      Always initialised to the Unlocked state
139    }
140  
141 <  TMultilockGate = class(TIpcCommon)
141 >  TMultilockGate = class(TIpcCommon, IMultilockGate)
142    private
143 +    FSharedMemory: ISharedMemory;
144      FOnGateTimeout: TNotifyEvent;
143 –    FOwner: TGlobalInterface;
145      FEvent: THandle;
146      FLockCount: PInteger;
147      FMutex: TMutex;
147 –   function GetLockCount: integer;
148    public
149 <    constructor Create(EventName: string; AOwner: TGlobalInterface);
149 >    constructor Create(EventName: string; sm: ISharedMemory);
150      destructor Destroy; override;
151      procedure Lock;
152      procedure Unlock;
153      procedure PassthroughGate;
154 +    function GetLockCount: integer;
155 +    function GetOnGateTimeout: TNotifyEvent;
156 +    procedure SetOnGateTimeout(aValue: TNotifyEvent);
157      property LockCount: integer read GetLockCount;
158 <    property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
158 >    property OnGateTimeout: TNotifyEvent read GetOnGateTimeout write SetOnGateTimeout;
159    end;
160  
161 <  { TGlobalInterface }
161 >  { TIPCInterface }
162  
163 <  TGlobalInterface = class(TIpcCommon)
163 >  TIPCInterface = class(TIpcCommon, IIPCInterface)
164    private
165      FMaxBufferSize: integer;
166 <    FSharedMemory: TSharedMemory;
167 <    FWriteLock: TMutex;
168 <    FBuffer: PChar;
166 >    FSharedMemory: ISharedMemory;
167 >    FWriteLock: IMutex;
168 >    FBuffer: PByte;
169      FTraceDataType,
170      FBufferSize: PInteger;
171      FTimeStamp: PDateTime;
172 <    FReadReadyEvent: TMultiLockGate;
173 <    FReadFinishedEvent: TMultiLockGate;
174 <    FDataAvailableEvent: TSingleLockGate;
175 <    FWriterBusyEvent: TSingleLockGate;
172 >    FMsgNumber: PInteger;
173 >    FReadReadyEvent: IMultiLockGate;
174 >    FReadFinishedEvent: IMultiLockGate;
175 >    FDataAvailableEvent: ISingleLockGate;
176 >    FWriterBusyEvent: ISingleLockGate;
177      FMonitorCount: PInteger;
178      procedure HandleGateTimeout(Sender: TObject);
175 –    function GetMonitorCount: integer;
179    public
180      constructor Create;
178 –    destructor Destroy; override;
181      procedure IncMonitorCount;
182      procedure DecMonitorCount;
183      procedure SendTrace(TraceObject: TTraceObject);
184      procedure ReceiveTrace(TraceObject: TTraceObject);
185 <    property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
186 <    property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
187 <    property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
188 <    property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
189 <    property WriteLock: TMutex read FWriteLock;
185 >    function GetDataAvailableEvent: ISingleLockGate;
186 >    function GetWriterBusyEvent: ISingleLockGate;
187 >    function GetReadReadyEvent: IMultiLockGate;
188 >    function GetReadFinishedEvent: IMultiLockGate;
189 >    function GetWriteLock: IMutex;
190 >    function GetMonitorCount: integer;
191 >    function GetSharedMemory: ISharedMemory;
192 >    function GetMaxBufferSize: integer;
193 >    property DataAvailableEvent: ISingleLockGate read GetDataAvailableEvent;
194 >    property WriterBusyEvent: ISingleLockGate read GetWriterBusyEvent;
195 >    property ReadReadyEvent: IMultiLockGate read GetReadReadyEvent;
196 >    property ReadFinishedEvent: IMultiLockGate read GetReadFinishedEvent;
197 >    property WriteLock: IMutex read GetWriteLock;
198      property MonitorCount: integer read GetMonitorCount;
199 <    property SharedMemory: TSharedMemory read FSharedMemory;
200 <    property MaxBufferSize: integer read FMaxBufferSize;
199 >    property SharedMemory: ISharedMemory read GetSharedMemory;
200 >    property MaxBufferSize: integer read GetMaxBufferSize;
201    end;
202  
203   { TSharedMemory }
# Line 225 | Line 235 | begin
235    inherited Destroy;
236   end;
237  
238 < function TSharedMemory.Allocate(Size: integer): PChar;
238 > function TSharedMemory.Allocate(Size: integer): PByte;
239   begin
240    if Size > FUnused then
241        IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
# Line 244 | Line 254 | begin
254    Inc(FBufPtr,Size)
255   end;
256  
257 + function TSharedMemory.GetLastAllocationSize: integer;
258 + begin
259 +  Result := FLastAllocationSize;
260 + end;
261 +
262   { TIpcCommon }
263  
264   function TIpcCommon.GetSa: PSecurityAttributes;
# Line 299 | Line 314 | begin
314   end;
315  
316   { TSingleLockGate }
317 < constructor TSingleLockGate.Create(EventName: string; AOwner: TGlobalInterface);
317 > constructor TSingleLockGate.Create(EventName: string);
318   begin
319    inherited Create;
305 –  FOwner := AOwner;
320    if FInitialiser then
321 <    FEvent := CreateEvent(sa, true, true, PChar(EventName))
321 >    FEvent := CreateEvent(sa, true, true, PAnsiChar(EventName))
322    else
323 <    FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
323 >    FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PAnsiChar(EventName));
324  
325    if FEvent = 0 then
326      IBError(ibxeCannotCreateSharedResource, [GetLastError])
# Line 336 | Line 350 | end;
350  
351   { TMultilockGate }
352  
353 < constructor TMultilockGate.Create(EventName: string; AOwner: TGlobalInterface);
353 > constructor TMultilockGate.Create(EventName: string; sm: ISharedMemory);
354   begin
355    inherited Create;
356 <  FOwner := AOwner;
357 <  FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
356 >  FSharedMemory := sm;
357 >  FLockCount := PInteger(FSharedMemory.Allocate(sizeof(FLockCount)));
358    FMutex := TMutex.Create(EventName + '.Mutex');
359    if FInitialiser then
360    begin
# Line 366 | Line 380 | begin
380    Result := FLockCount^
381   end;
382  
383 + function TMultilockGate.GetOnGateTimeout: TNotifyEvent;
384 + begin
385 +  Result := FOnGateTimeout;
386 + end;
387 +
388 + procedure TMultilockGate.SetOnGateTimeout(AValue: TNotifyEvent);
389 + begin
390 +  FOnGateTimeout := AValue;
391 + end;
392 +
393   procedure TMultilockGate.Lock;
394   begin
395    FMutex.Lock;
# Line 412 | Line 436 | begin
436   end;
437  
438  
439 < { TGlobalInterface }
439 > { TIPCInterface }
440  
441 < function TGlobalInterface.GetMonitorCount: integer;
441 > function TIPCInterface.GetMonitorCount: integer;
442   begin
443    Result := FMonitorCount^
444   end;
445  
446 < procedure TGlobalInterface.HandleGateTimeout(Sender: TObject);
446 > function TIPCInterface.GetSharedMemory: ISharedMemory;
447 > begin
448 >  Result := FSharedMemory;
449 > end;
450 >
451 > function TIPCInterface.GetMaxBufferSize: integer;
452 > begin
453 >  Result := FMaxBufferSize;
454 > end;
455 >
456 > procedure TIPCInterface.HandleGateTimeout(Sender: TObject);
457   begin
458    //writeln(ClassName+': Gate TimeOut');
459    DecMonitorCount
460   end;
461  
462 < constructor TGlobalInterface.Create;
462 > constructor TIPCInterface.Create;
463   begin
464    inherited Create;
465    FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
466  
467    FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]));
468 <  FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],self);
469 <  FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],self);
470 <  FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],self);
468 >  FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2]);
469 >  FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3]);
470 >  FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],FSharedMemory);
471    FReadReadyEvent.OnGateTimeout  := HandleGateTimeout;
472 <  FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],self);
472 >  FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],FSharedMemory);
473    FReadFinishedEvent.OnGateTimeout  := HandleGateTimeout;
474  
475    FMonitorCount := PInteger(FSharedMemory.Allocate(sizeof(FMonitorCount)));
# Line 445 | Line 479 | begin
479    FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
480    FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
481    FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
482 +  FMsgNumber := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
483    FBuffer := FSharedMemory.Allocate(0); //All remaining
484    FMaxBufferSize := FSharedMemory.LastAllocationSize;
485  
486    if FInitialiser then
487    begin
488      FBufferSize^ := 0;
489 <    FDataAvailableEvent.Lock
489 >    FDataAvailableEvent.Lock;
490 >    FMsgNumber^ := 0;
491    end;
492   end;
493  
494 < destructor TGlobalInterface.Destroy;
459 < begin
460 <  if assigned(FWriteLock) then FWriteLock.Free;
461 <  if assigned(FDataAvailableEvent) then FDataAvailableEvent.Free;
462 <  if assigned(FWriterBusyEvent) then FWriterBusyEvent.Free;
463 <  if assigned(FReadReadyEvent) then FReadReadyEvent.Free;
464 <  if assigned(FReadFinishedEvent) then FReadFinishedEvent.Free;
465 <  if assigned(FSharedMemory) then FSharedMemory.Free;
466 <  inherited Destroy;
467 < end;
468 <
469 < procedure TGlobalInterface.IncMonitorCount;
494 > procedure TIPCInterface.IncMonitorCount;
495   begin
496    InterlockedIncrement(FMonitorCount^)
497   end;
498  
499 < procedure TGlobalInterface.DecMonitorCount;
499 > procedure TIPCInterface.DecMonitorCount;
500   begin
501     InterlockedDecrement(FMonitorCount^)
502   end;
503  
504 < procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
504 > procedure TIPCInterface.SendTrace(TraceObject: TTraceObject);
505   begin
506    FTraceDataType^ := Integer(TraceObject.FDataType);
507    FTimeStamp^ := TraceObject.FTimeStamp;
508    FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
509 +  FMsgNumber^ := TraceObject.FMsgNumber;
510    Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
511   end;
512  
513 < procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
513 > procedure TIPCInterface.ReceiveTrace(TraceObject: TTraceObject);
514   begin
515 <  SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
515 >  SetString(TraceObject.FMsg, PAnsiChar(FBuffer), FBufferSize^);
516    TraceObject.FDataType := TTraceFlag(FTraceDataType^);
517    TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
518 +  TraceObject.FMsgNumber := FMsgNumber^;
519 + end;
520 +
521 + function TIPCInterface.GetDataAvailableEvent: ISingleLockGate;
522 + begin
523 +  Result := FDataAvailableEvent;
524 + end;
525 +
526 + function TIPCInterface.GetWriterBusyEvent: ISingleLockGate;
527 + begin
528 +  Result := FWriterBusyEvent;
529 + end;
530 +
531 + function TIPCInterface.GetReadReadyEvent: IMultiLockGate;
532 + begin
533 +  Result := FReadReadyEvent;
534 + end;
535 +
536 + function TIPCInterface.GetReadFinishedEvent: IMultiLockGate;
537 + begin
538 +  Result := FReadFinishedEvent;
539 + end;
540 +
541 + function TIPCInterface.GetWriteLock: IMutex;
542 + begin
543 +  Result := FWriteLock;
544   end;
545  
546  

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines