[ViewVC] Diff of: public/ibx/trunk/runtime/nongui/winipc.inc

Comparing ibx/trunk/runtime/nongui/winipc.inc (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 321 by tony, Thu Feb 25 12:10:07 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 = 10000; {milli 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;
24		FSa : TSecurityAttributes;
25		private
26		Sd : TSecurityDescriptor;
27		public
28		constructor Create;
29	+	function GetSa: PSecurityAttributes;
30		property Sa : PSecurityAttributes read GetSa;
31		end;
32
#	Line 48 \| Line 48 \| type
48
49		}
50
51	<	TSharedMemory = class(TIpcCommon)
51	>	ISharedMemory = interface
52	>	['{db77bdd4-233a-4c9c-9212-dd7945e2e57c}']
53	>	function IsInitialiser: boolean;
54	>	function Allocate(Size: integer): PByte;
55	>	function GetLastAllocationSize: integer;
56	>	property LastAllocationSize: integer read GetLastAllocationSize;
57	>	end;
58	>
59	>
60	>	TSharedMemory = class(TIpcCommon,ISharedMemory)
61		private
62	<	FBuffer: PChar;
62	>	FBuffer: PByte;
63		FLastAllocationSize: integer;
64		FUnused: integer;
65	<	FBufptr: PChar;
65	>	FBufptr: PByte;
66		FSharedBuffer: THandle;
67	+	FInitialiser: boolean;
68		procedure GetSharedMemory(MemSize: integer);
69		public
70		constructor Create(MemSize: integer);
71		destructor Destroy; override;
72	<	function Allocate(Size: integer): PChar;
73	<	property LastAllocationSize: integer read FLastAllocationSize;
72	>	function Allocate(Size: integer): PByte;
73	>	function GetLastAllocationSize: integer;
74	>	function IsInitialiser: boolean;
75	>	property LastAllocationSize: integer read GetLastAllocationSize;
76		end;
77
78		{TMutex}
79
80	<	TMutex = class(TIpcCommon)
80	>	TMutex = class(TIpcCommon, IMutex)
81		private
82		FMutex: THandle;
83		public
84	<	constructor Create(MutexName: string);
84	>	constructor Create(MutexName: string; IsInitialiser: boolean);
85		destructor Destroy; override;
86		procedure Lock;
87		procedure Unlock;
#	Line 96 \| Line 108 \| type
108		Always initialised to the Unlocked state
109		}
110
111	<	TSingleLockGate = class(TIpcCommon)
111	>	TSingleLockGate = class(TIpcCommon,ISingleLockGate)
112		private
101	–	FOwner: TGlobalInterface;
113		FEvent: THandle;
114		public
115	<	constructor Create(EventName: string; AOwner: TGlobalInterface);
115	>	constructor Create(EventName: string; IsInitialiser: boolean);
116		destructor Destroy; override;
117		procedure PassthroughGate;
118		procedure Unlock;
#	Line 137 \| Line 148 \| type
148		Always initialised to the Unlocked state
149		}
150
151	<	TMultilockGate = class(TIpcCommon)
151	>	TMultilockGate = class(TIpcCommon, IMultilockGate)
152		private
153	+	FSharedMemory: ISharedMemory;
154		FOnGateTimeout: TNotifyEvent;
143	–	FOwner: TGlobalInterface;
155		FEvent: THandle;
156		FLockCount: PInteger;
157		FMutex: TMutex;
147	–	function GetLockCount: integer;
158		public
159	<	constructor Create(EventName: string; AOwner: TGlobalInterface);
159	>	constructor Create(EventName: string; sm: ISharedMemory);
160		destructor Destroy; override;
161		procedure Lock;
162		procedure Unlock;
163		procedure PassthroughGate;
164	+	function GetLockCount: integer;
165	+	function GetOnGateTimeout: TNotifyEvent;
166	+	procedure SetOnGateTimeout(aValue: TNotifyEvent);
167		property LockCount: integer read GetLockCount;
168	<	property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
168	>	property OnGateTimeout: TNotifyEvent read GetOnGateTimeout write SetOnGateTimeout;
169		end;
170
171	<	{ TGlobalInterface }
171	>	{ TIPCInterface }
172
173	<	TGlobalInterface = class(TIpcCommon)
173	>	TIPCInterface = class(TIpcCommon, IIPCInterface)
174		private
175		FMaxBufferSize: integer;
176	<	FSharedMemory: TSharedMemory;
177	<	FWriteLock: TMutex;
178	<	FBuffer: PChar;
176	>	FSharedMemory: ISharedMemory;
177	>	FWriteLock: IMutex;
178	>	FBuffer: PByte;
179		FTraceDataType,
180		FBufferSize: PInteger;
181		FTimeStamp: PDateTime;
182	<	FReadReadyEvent: TMultiLockGate;
183	<	FReadFinishedEvent: TMultiLockGate;
184	<	FDataAvailableEvent: TSingleLockGate;
185	<	FWriterBusyEvent: TSingleLockGate;
182	>	FMsgNumber: PInteger;
183	>	FReadReadyEvent: IMultiLockGate;
184	>	FReadFinishedEvent: IMultiLockGate;
185	>	FDataAvailableEvent: ISingleLockGate;
186	>	FWriterBusyEvent: ISingleLockGate;
187		FMonitorCount: PInteger;
188		procedure HandleGateTimeout(Sender: TObject);
175	–	function GetMonitorCount: integer;
189		public
190		constructor Create;
178	–	destructor Destroy; override;
191		procedure IncMonitorCount;
192		procedure DecMonitorCount;
193		procedure SendTrace(TraceObject: TTraceObject);
194		procedure ReceiveTrace(TraceObject: TTraceObject);
195	<	property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
196	<	property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
197	<	property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
198	<	property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
199	<	property WriteLock: TMutex read FWriteLock;
195	>	function GetDataAvailableEvent: ISingleLockGate;
196	>	function GetWriterBusyEvent: ISingleLockGate;
197	>	function GetReadReadyEvent: IMultiLockGate;
198	>	function GetReadFinishedEvent: IMultiLockGate;
199	>	function GetWriteLock: IMutex;
200	>	function GetMonitorCount: integer;
201	>	function GetMaxBufferSize: integer;
202	>	property DataAvailableEvent: ISingleLockGate read GetDataAvailableEvent;
203	>	property WriterBusyEvent: ISingleLockGate read GetWriterBusyEvent;
204	>	property ReadReadyEvent: IMultiLockGate read GetReadReadyEvent;
205	>	property ReadFinishedEvent: IMultiLockGate read GetReadFinishedEvent;
206	>	property WriteLock: IMutex read GetWriteLock;
207		property MonitorCount: integer read GetMonitorCount;
208	<	property SharedMemory: TSharedMemory read FSharedMemory;
190	<	property MaxBufferSize: integer read FMaxBufferSize;
208	>	property MaxBufferSize: integer read GetMaxBufferSize;
209		end;
210
211		{ TSharedMemory }
#	Line 225 \| Line 243 \| begin
243		inherited Destroy;
244		end;
245
246	<	function TSharedMemory.Allocate(Size: integer): PChar;
246	>	function TSharedMemory.Allocate(Size: integer): PByte;
247		begin
248		if Size > FUnused then
249		IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
#	Line 244 \| Line 262 \| begin
262		Inc(FBufPtr,Size)
263		end;
264
265	+	function TSharedMemory.GetLastAllocationSize: integer;
266	+	begin
267	+	Result := FLastAllocationSize;
268	+	end;
269	+
270	+	function TSharedMemory.IsInitialiser: boolean;
271	+	begin
272	+	Result := FInitialiser;
273	+	end;
274	+
275		{ TIpcCommon }
276
277		function TIpcCommon.GetSa: PSecurityAttributes;
#	Line 266 \| Line 294 \| end;
294
295		{ TMutex }
296
297	<	constructor TMutex.Create(MutexName: string);
297	>	constructor TMutex.Create(MutexName: string; IsInitialiser: boolean);
298		begin
299		inherited Create;
300	<	if FInitialiser then
300	>	if IsInitialiser then
301		FMutex := CreateMutex(sa, False, PChar(MutexName))
302		else
303		FMutex := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MutexName));
#	Line 299 \| Line 327 \| begin
327		end;
328
329		{ TSingleLockGate }
330	<	constructor TSingleLockGate.Create(EventName: string; AOwner: TGlobalInterface);
330	>	constructor TSingleLockGate.Create(EventName: string; IsInitialiser: boolean);
331		begin
332		inherited Create;
333	<	FOwner := AOwner;
334	<	if FInitialiser then
307	<	FEvent := CreateEvent(sa, true, true, PChar(EventName))
333	>	if IsInitialiser then
334	>	FEvent := CreateEvent(sa, true, true, PAnsiChar(EventName))
335		else
336	<	FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
336	>	FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PAnsiChar(EventName));
337
338		if FEvent = 0 then
339		IBError(ibxeCannotCreateSharedResource, [GetLastError])
#	Line 336 \| Line 363 \| end;
363
364		{ TMultilockGate }
365
366	<	constructor TMultilockGate.Create(EventName: string; AOwner: TGlobalInterface);
366	>	constructor TMultilockGate.Create(EventName: string; sm: ISharedMemory);
367		begin
368		inherited Create;
369	<	FOwner := AOwner;
370	<	FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
371	<	FMutex := TMutex.Create(EventName + '.Mutex');
372	<	if FInitialiser then
369	>	FSharedMemory := sm;
370	>	FLockCount := PInteger(FSharedMemory.Allocate(sizeof(FLockCount)));
371	>	FMutex := TMutex.Create(EventName + '.Mutex',FSharedMemory.IsInitialiser);
372	>	if FSharedMemory.IsInitialiser then
373		begin
374		FEvent := CreateEvent(sa, true, true, PChar(EventName));
375		FLockCount^ := 0;
#	Line 366 \| Line 393 \| begin
393		Result := FLockCount^
394		end;
395
396	+	function TMultilockGate.GetOnGateTimeout: TNotifyEvent;
397	+	begin
398	+	Result := FOnGateTimeout;
399	+	end;
400	+
401	+	procedure TMultilockGate.SetOnGateTimeout(aValue: TNotifyEvent);
402	+	begin
403	+	FOnGateTimeout := AValue;
404	+	end;
405	+
406		procedure TMultilockGate.Lock;
407		begin
408		FMutex.Lock;
#	Line 412 \| Line 449 \| begin
449		end;
450
451
452	<	{ TGlobalInterface }
452	>	{ TIPCInterface }
453
454	<	function TGlobalInterface.GetMonitorCount: integer;
454	>	function TIPCInterface.GetMonitorCount: integer;
455		begin
456		Result := FMonitorCount^
457		end;
458
459	<	procedure TGlobalInterface.HandleGateTimeout(Sender: TObject);
459	>	function TIPCInterface.GetMaxBufferSize: integer;
460	>	begin
461	>	Result := FMaxBufferSize;
462	>	end;
463	>
464	>	procedure TIPCInterface.HandleGateTimeout(Sender: TObject);
465		begin
466		//writeln(ClassName+': Gate TimeOut');
467		DecMonitorCount
468		end;
469
470	<	constructor TGlobalInterface.Create;
470	>	constructor TIPCInterface.Create;
471		begin
472		inherited Create;
473		FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
474
475	<	FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]));
476	<	FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],self);
477	<	FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],self);
478	<	FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],self);
475	>	FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]),FSharedMemory.IsInitialiser);
476	>	FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],FSharedMemory.IsInitialiser);
477	>	FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],FSharedMemory.IsInitialiser);
478	>	FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],FSharedMemory);
479		FReadReadyEvent.OnGateTimeout := HandleGateTimeout;
480	<	FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],self);
480	>	FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],FSharedMemory);
481		FReadFinishedEvent.OnGateTimeout := HandleGateTimeout;
482
483		FMonitorCount := PInteger(FSharedMemory.Allocate(sizeof(FMonitorCount)));
484
485	<	if FInitialiser then
485	>	if FSharedMemory.IsInitialiser then
486		FMonitorCount^ := 0;
487		FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
488		FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
489		FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
490	+	FMsgNumber := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
491		FBuffer := FSharedMemory.Allocate(0); //All remaining
492		FMaxBufferSize := FSharedMemory.LastAllocationSize;
493
494	<	if FInitialiser then
494	>	if FSharedMemory.IsInitialiser then
495		begin
496		FBufferSize^ := 0;
497	<	FDataAvailableEvent.Lock
497	>	FDataAvailableEvent.Lock;
498	>	FMsgNumber^ := 0;
499		end;
500		end;
501
502	<	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;
502	>	procedure TIPCInterface.IncMonitorCount;
503		begin
504		InterlockedIncrement(FMonitorCount^)
505		end;
506
507	<	procedure TGlobalInterface.DecMonitorCount;
507	>	procedure TIPCInterface.DecMonitorCount;
508		begin
509		InterlockedDecrement(FMonitorCount^)
510		end;
511
512	<	procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
512	>	procedure TIPCInterface.SendTrace(TraceObject: TTraceObject);
513		begin
514		FTraceDataType^ := Integer(TraceObject.FDataType);
515		FTimeStamp^ := TraceObject.FTimeStamp;
516		FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
517	+	FMsgNumber^ := TraceObject.FMsgNumber;
518		Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
519		end;
520
521	<	procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
521	>	procedure TIPCInterface.ReceiveTrace(TraceObject: TTraceObject);
522		begin
523	<	SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
523	>	SetString(TraceObject.FMsg, PAnsiChar(FBuffer), FBufferSize^);
524		TraceObject.FDataType := TTraceFlag(FTraceDataType^);
525		TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
526	+	TraceObject.FMsgNumber := FMsgNumber^;
527	+	end;
528	+
529	+	function TIPCInterface.GetDataAvailableEvent: ISingleLockGate;
530	+	begin
531	+	Result := FDataAvailableEvent;
532	+	end;
533	+
534	+	function TIPCInterface.GetWriterBusyEvent: ISingleLockGate;
535	+	begin
536	+	Result := FWriterBusyEvent;
537	+	end;
538	+
539	+	function TIPCInterface.GetReadReadyEvent: IMultiLockGate;
540	+	begin
541	+	Result := FReadReadyEvent;
542	+	end;
543	+
544	+	function TIPCInterface.GetReadFinishedEvent: IMultiLockGate;
545	+	begin
546	+	Result := FReadFinishedEvent;
547	+	end;
548	+
549	+	function TIPCInterface.GetWriteLock: IMutex;
550	+	begin
551	+	Result := FWriteLock;
552		end;
553
554

Diff Legend

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

Comparing ibx/trunk/runtime/nongui/winipc.inc (file contents): Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs. Revision 321 by tony, Thu Feb 25 12:10:07 2021 UTC

Diff Legend

Comparing ibx/trunk/runtime/nongui/winipc.inc (file contents):
Revision 209 by tony, Wed Mar 14 12:48:51 2018 UTC vs.
Revision 321 by tony, Thu Feb 25 12:10:07 2021 UTC