ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/nongui/sv5ipc.inc

Comparing ibx/trunk/runtime/nongui/sv5ipc.inc (file contents):
Revision 321 by tony, Thu Feb 25 12:10:07 2021 UTC vs.
Revision 322 by tony, Thu Feb 25 12:12:20 2021 UTC

#	Line 38 | Line 38 | type
38		{ TIpcCommon }
39
40		TIpcCommon = class(TInterfacedObject)
41	–	protected
42	–	class var FSemaphoreSetID: cint;  {Initialised by TSharedMemory. Used by other classes}
43	–	function sem_op(SemNum, op: integer; flags: cshort = 0): cint;
44	–	function sem_timedop(SemNum, op: integer; timeout_secs: integer; flags: cshort = 0): cint;
45	–	function GetSemValue(SemNum: integer): cint;
46	–	procedure SemInit(SemNum, AValue: cint);
41		public
42		function GetSa: PSecurityAttributes;
43		property Sa : PSecurityAttributes read GetSa;
#	Line 74 | Line 68 | type
68		function IsInitialiser: boolean;
69		function Allocate(Size: integer): PByte;
70		function GetLastAllocationSize: integer;
71	+	function sem_op(SemNum, op: integer; flags: cshort = 0): cint;
72	+	function sem_timedop(SemNum, op: integer; timeout_secs: integer; flags: cshort = 0): cint;
73	+	function GetSemValue(SemNum: integer): cint;
74	+	procedure SemInit(SemNum, AValue: cint);
75		property LastAllocationSize: integer read GetLastAllocationSize;
76		end;
77
78		TSharedMemory = class(TIpcCommon,ISharedMemory)
79		private
80		FSharedMemoryID: cint;
81	+	FSemaphoreSetID: cint;
82		FBuffer: PByte;
83		FLastAllocationSize: integer;
84		FUnused: integer;
#	Line 94 | Line 93 | type
93		function Allocate(Size: integer): PByte;
94		function GetLastAllocationSize: integer;
95		function IsInitialiser: boolean;
96	+	function sem_op(SemNum, op: integer; flags: cshort = 0): cint;
97	+	function sem_timedop(SemNum, op: integer; timeout_secs: integer; flags: cshort = 0): cint;
98	+	function GetSemValue(SemNum: integer): cint;
99	+	procedure SemInit(SemNum, AValue: cint);
100		property LastAllocationSize: integer read GetLastAllocationSize;
101		end;
102
#	Line 101 | Line 104 | type
104
105		TMutex = class(TIpcCommon,IMutex)
106		private
107	+	FSharedMemory: ISharedMemory;
108		FMutexSemaphore: cint;
109		FLockCount: integer;
110		public
111	<	constructor Create(SemNumber: cint; IsInitialiser: boolean);
111	>	constructor Create(SemNumber: cint; sm: ISharedMemory);
112		procedure Lock;
113		procedure Unlock;
114		end;
#	Line 379 | Line 383 | begin
383		Result := FInitialiser;
384		end;
385
386	<	{ TIpcCommon }
383	<
384	<	function TIpcCommon.GetSa: PSecurityAttributes;
385	<	begin
386	<	Result := nil
387	<	end;
388	<
389	<	function TIpcCommon.sem_op(SemNum, op: integer; flags: cshort): cint;
386	>	function TSharedMemory.sem_op(SemNum, op: integer; flags: cshort): cint;
387		var sembuf: TSEMbuf;
388		begin
389		sembuf.sem_num := SemNum;
#	Line 395 | Line 392 | begin
392		Result := semop(FSemaphoreSetID,@sembuf,1);
393		end;
394
395	<	function TIpcCommon.sem_timedop(SemNum, op: integer; timeout_secs: integer;
395	>	function TSharedMemory.sem_timedop(SemNum, op: integer; timeout_secs: integer;
396		flags: cshort): cint;
397		var sembuf: TSEMbuf;
398		timeout: TimeSpec;
#	Line 412 | Line 409 | begin
409		{$IFEND}
410		end;
411
412	<	function TIpcCommon.GetSemValue(SemNum: integer): cint;
412	>	function TSharedMemory.GetSemValue(SemNum: integer): cint;
413		var args :TSEMun;
414		begin
415		Result := semctl(FSemaphoreSetID,SemNum,SEM_GETVAL,args);
#	Line 420 | Line 417 | begin
417		IBError(ibxeSV5APIError,['GetSemValue: '+strError(GetLastErrno)]);
418		end;
419
420	<	procedure TIpcCommon.SemInit(SemNum, AValue: cint);
420	>	procedure TSharedMemory.SemInit(SemNum, AValue: cint);
421		var args :TSEMun;
422		begin
423		//writeln('Initialising ',SemNum,' to ',AValue);
#	Line 431 | Line 428 | begin
428
429		end;
430
431	+	{ TIpcCommon }
432	+
433	+	function TIpcCommon.GetSa: PSecurityAttributes;
434	+	begin
435	+	Result := nil
436	+	end;
437	+
438		{ TMutex }
439
440	<	constructor TMutex.Create(SemNumber: cint; IsInitialiser: boolean);
440	>	constructor TMutex.Create(SemNumber: cint; sm: ISharedMemory);
441		begin
442		inherited Create;
443	+	FSharedMemory := sm;
444		FMutexSemaphore := SemNumber;
445	<	if IsInitialiser then
446	<	SemInit(FMutexSemaphore,1)
445	>	if FSharedMemory.IsInitialiser then
446	>	FSharedMemory.SemInit(FMutexSemaphore,1)
447		end;
448
449		{ Obtain ownership of the Mutex and prevent other threads from accessing protected resource }
#	Line 447 | Line 452 | procedure TMutex.Lock;
452		begin
453		//writeln('Lock: Entering Mutex ',FMutexSemaphore,' LockCount=',FLockCount,' State = ',GetSemValue(FMutexSemaphore));
454		if FLockCount = 0 then
455	<	sem_op(FMutexSemaphore,-1);
455	>	FSharedMemory.sem_op(FMutexSemaphore,-1);
456		Inc(FLockCount);
457		//writeln('Lock: Mutex Exit');
458		end;
#	Line 460 | Line 465 | begin
465		if FLockCount = 0 then Exit;
466		Dec(FLockCount);
467		if FLockCount = 0 then
468	<	sem_op(FMutexSemaphore,1);
468	>	FSharedMemory.sem_op(FMutexSemaphore,1);
469		//writeln('UnLock: Mutex Exit',' State = ',GetSemValue(FMutexSemaphore));
470		end;
471
#	Line 483 | Line 488 | begin
488		begin
489		FSignalledState^ := 1;
490		FWaitingThreads^ := 0;
491	<	SemInit(FSemaphore,0);
492	<	SemInit(FMutex,1);
491	>	FSharedMemory.SemInit(FSemaphore,0);
492	>	FSharedMemory.SemInit(FMutex,1);
493		end;
494		end;
495
#	Line 492 | Line 497 | procedure TSingleLockGate.PassthroughGat
497		begin
498		if FSignalledState^ = 0 then
499		begin
500	<	sem_op(FMutex,-1,0); //Acquire Mutex
500	>	FSharedMemory.sem_op(FMutex,-1,0); //Acquire Mutex
501		Inc(FWaitingThreads^);
502	<	sem_op(FMutex,1,0); //Release Mutex
502	>	FSharedMemory.sem_op(FMutex,1,0); //Release Mutex
503		//writeln(ClassName + ': Wait State Entered ',FSemaphore,' = ',GetSemValue(FSemaphore));
504	<	sem_op(FSemaphore,-1,0); //Enter Wait
504	>	FSharedMemory.sem_op(FSemaphore,-1,0); //Enter Wait
505		//writeln(ClassName + ': Wait State Ends ',FSemaphore);
506		end;
507		end;
#	Line 506 | Line 511 | begin
511		if FSignalledState^ = 0 then
512		begin
513		FSignalledState^ := 1;
514	<	sem_op(FMutex,-1,0); //Acquire Mutex
514	>	FSharedMemory.sem_op(FMutex,-1,0); //Acquire Mutex
515		{$IFDEF DEBUG}writeln(ClassName + ': Unlocking' ,FSemaphore);{$ENDIF}
516	<	sem_op(FSemaphore,FWaitingThreads^,0);
516	>	FSharedMemory.sem_op(FSemaphore,FWaitingThreads^,0);
517		FWaitingThreads^ := 0;
518	<	sem_op(FMutex,1,0); //Release Mutex
518	>	FSharedMemory.sem_op(FMutex,1,0); //Release Mutex
519		end;
520		end;
521
#	Line 519 | Line 524 | begin
524		if FSignalledState^ = 1 then
525		begin
526		{$IFDEF DEBUG}writeln(ClassName + ': Locking Gate ',FSemaphore);{$ENDIF}
527	<	SemInit(FSemaphore,0);
527	>	FSharedMemory.SemInit(FSemaphore,0);
528		FSignalledState^ := 0;
529		end;
530		end;
#	Line 536 | Line 541 | begin
541		if FSharedMemory.IsInitialiser then
542		begin
543		FLockCount^ := 0;
544	<	SemInit(FSemaphore,1);
545	<	SemInit(FMutex,1);
544	>	FSharedMemory.SemInit(FSemaphore,1);
545	>	FSharedMemory.SemInit(FMutex,1);
546		end;
547		end;
548
#	Line 558 | Line 563 | end;
563
564		procedure TMultilockGate.Lock;
565		begin
566	<	sem_op(FMutex,-1,0); //Acquire Mutex
566	>	FSharedMemory.sem_op(FMutex,-1,0); //Acquire Mutex
567		if FLockCount^ = 0 then
568		begin
569		{$IFDEF DEBUG}writeln(ClassName,': Locking ',FSemaphore);{$ENDIF}
570	<	SemInit(FSemaphore,0);
570	>	FSharedMemory.SemInit(FSemaphore,0);
571		end;
572		Inc(FLockCount^);
573	<	sem_op(FMutex,1,0); //Release Mutex
573	>	FSharedMemory.sem_op(FMutex,1,0); //Release Mutex
574		end;
575
576		procedure TMultilockGate.Unlock;
577		begin
578	<	sem_op(FMutex,-1,0); //Acquire Mutex
578	>	FSharedMemory.sem_op(FMutex,-1,0); //Acquire Mutex
579		Dec(FLockCount^);
580		if FLockCount^ <= 0 then
581		begin
582		{$IFDEF DEBUG}writeln(ClassName,': UnLocking ',FSemaphore);{$ENDIF}
583	<	SemInit(FSemaphore,1);
583	>	FSharedMemory.SemInit(FSemaphore,1);
584		FLockCount^ := 0
585		end;
586	<	sem_op(FMutex,1,0); //Release Mutex
586	>	FSharedMemory.sem_op(FMutex,1,0); //Release Mutex
587		end;
588
589		procedure TMultilockGate.PassthroughGate;
#	Line 586 | Line 591 | begin
591		if FLockCount^ = 0 then
592		Exit;
593		{$IFDEF DEBUG}writeln(ClassName,': Waiting on ',FSemaphore);{$ENDIF}
594	<	while sem_timedop(FSemaphore,-1,cDefaultTimeout) < 0 do
594	>	while FSharedMemory.sem_timedop(FSemaphore,-1,cDefaultTimeout) < 0 do
595		{looks like we lost a reader}
596		begin
597		{$IFDEF DEBUG}writeln(ClassName,': reader lost timeout');{$ENDIF}
#	Line 597 | Line 602 | begin
602		OnGateTimeout(self)
603		end
604		end;
605	<	sem_op(FSemaphore,1);
605	>	FSharedMemory.sem_op(FSemaphore,1);
606		{$IFDEF DEBUG}writeln(ClassName,': Wait done on ',FSemaphore);{$ENDIF}
607		end;
608
#	Line 606 | Line 611 | end;
611
612		function TIPCInterface.GetMonitorCount: integer;
613		begin
614	<	Result := GetSemValue(cMonitorCounter)
614	>	Result := FSharedMemory.GetSemValue(cMonitorCounter)
615		end;
616
617		function TIPCInterface.GetMaxBufferSize: integer;
#	Line 619 | Line 624 | begin
624		inherited Create;
625		FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
626
627	<	FWriteLock := TMutex.Create(cMutexSemaphore,FSharedMemory.IsInitialiser);
627	>	FWriteLock := TMutex.Create(cMutexSemaphore,FSharedMemory);
628
629		FDataAvailableEvent := TSingleLockGate.Create(cDataAvailableEventSemaphore,FSharedMemory);
630		FWriterBusyEvent := TSingleLockGate.Create(cWriterBusyEventSemaphore,FSharedMemory);
#	Line 627 | Line 632 | begin
632		FReadFinishedEvent := TMultiLockGate.Create(cReadFinishedEventSemaphore,FSharedMemory);
633
634		if FSharedMemory.IsInitialiser then
635	<	SemInit(cMonitorCounter,0);
635	>	FSharedMemory.SemInit(cMonitorCounter,0);
636		FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
637		FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
638		FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
#	Line 645 | Line 650 | end;
650
651		procedure TIPCInterface.IncMonitorCount;
652		begin
653	<	sem_op(cMonitorCounter,1);
653	>	FSharedMemory.sem_op(cMonitorCounter,1);
654		end;
655
656		procedure TIPCInterface.DecMonitorCount;
657		begin
658	<	sem_op(cMonitorCounter,-1,IPC_NOWAIT);
658	>	FSharedMemory.sem_op(cMonitorCounter,-1,IPC_NOWAIT);
659		end;
660
661		procedure TIPCInterface.SendTrace(TraceObject: TTraceObject);

Diff Legend

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