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

Comparing ibx/trunk/runtime/nongui/sv5ipc.inc (file contents):
Revision 209 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 ISQLMonitor and implements System V IPC}
1 > {Used by IBIPC and implements System V IPC}
2 >
3 > uses IBMessages, ipc, Errors, baseunix;
4  
5   const
6    IPCFileName: string = 'FB.SQL.MONITOR1_0';
# Line 9 | Line 11 | const
11    cReadFinishedEventSemaphore = 4;
12    cDataAvailableEventSemaphore = 6;
13    cWriterBusyEventSemaphore = 8;
14 <  cDefaultTimeout = 1; { 1 seconds }
14 >  cDefaultTimeout = 1000; {seconds }
15  
16   {$IF FPC_FULLVERSION = 30000 }
17   {Fix regression in FPC 3.0.0 ipc.pp unit. Expected to be fixed in fpc 3.0.2}
# Line 24 | Line 26 | SEM_SETALL  = 9;
26   {$ENDIF}
27   {$ENDIF}
28  
27 – {
28 –  The call to semctl in ipc is broken in FPC release 2.4.2 and earlier. Hence
29 –  need to replace with a working libc call. semtimedop is not present in 2.4.2 and earlier.
30 – }
31 –
29   function GetLastErrno: cint;
30   begin
31    Result := fpgetErrno
32   end;
33  
34   type
38 –  TGlobalInterface = class;
35    {Interprocess Communication Objects. All platform dependent IPC is abstracted
36     into this set of objects }
37  
38    { TIpcCommon }
39  
40 <  TIpcCommon = class
41 <   private
46 <    function GetSa: PSecurityAttributes;
47 < protected
40 >  TIpcCommon = class(TInterfacedObject)
41 >  protected
42      FInitialiser: boolean;  static;
43      FSemaphoreSetID: cint;  static;
44      FSharedMemoryID: cint;  static;
# Line 53 | Line 47 | type
47      function GetSemValue(SemNum: integer): cint;
48      procedure SemInit(SemNum, AValue: cint);
49    public
50 +    function GetSa: PSecurityAttributes;
51      property Sa : PSecurityAttributes read GetSa;
52    end;
53  
# Line 76 | Line 71 | type
71      Note that the Linux semaphore set is also created with the shared memory.
72    }
73  
74 <  TSharedMemory = class(TIpcCommon)
74 >  TSharedMemory = class(TIpcCommon,ISharedMemory)
75    private
76 <    FBuffer: PChar;
76 >    FBuffer: PByte;
77      FLastAllocationSize: integer;
78      FUnused: integer;
79 <    FBufptr: PChar;
79 >    FBufptr: PByte;
80 >    FIPCFileName: AnsiString;
81      procedure DropSharedMemory;
82      procedure GetSharedMemory(MemSize: integer);
83    public
84      constructor Create(MemSize: integer);
85      destructor Destroy; override;
86 <    function Allocate(Size: integer): PChar;
87 <    property LastAllocationSize: integer read FLastAllocationSize;
86 >    function Allocate(Size: integer): PByte;
87 >    function GetLastAllocationSize: integer;
88 >    property LastAllocationSize: integer read GetLastAllocationSize;
89    end;
90  
91    {TMutex}
92  
93 <  TMutex = class(TIpcCommon)
93 >  TMutex = class(TIpcCommon,IMutex)
94    private
95      FMutexSemaphore: cint;
96      FLockCount: integer;
# Line 134 | Line 131 | type
131      Always initialised to the Unlocked state
132    }
133  
134 <  TSingleLockGate = class(TIpcCommon)
134 >  TSingleLockGate = class(TIpcCommon,ISingleLockGate)
135    private
136 <    FOwner: TGlobalInterface;
136 >    FSharedMemory: ISharedMemory;
137      FSemaphore: cint;
138      FMutex: cint;
139      FSignalledState: PInteger;
140      FWaitingThreads: PInteger;
141      function GetWaitingThreads: integer;
142    public
143 <    constructor Create(SemNum: cint; AOwner: TGlobalInterface);
143 >    constructor Create(SemNum: cint; sm: ISharedMemory);
144      property WaitingThreads: integer read GetWaitingThreads;
145    public
146      procedure PassthroughGate;
# Line 187 | Line 184 | type
184      Always initialised to the Unlocked state
185    }
186  
187 <  TMultilockGate = class(TIpcCommon)
187 >  TMultilockGate = class(TIpcCommon,IMultiLockGate)
188    private
189 +    FSharedMemory: ISharedMemory;
190      FOnGateTimeout: TNotifyEvent;
193 –    FOwner: TGlobalInterface;
191      FSemaphore: cint;
192      FMutex: cint;
193      FLockCount: PInteger;
194      function GetLockCount: integer;
195    public
196 <    constructor Create(SemNum: cint; AOwner: TGlobalInterface);
196 >    constructor Create(SemNum: cint; sm: ISharedMemory);
197      procedure Lock;
198      procedure Unlock;
199      procedure PassthroughGate;
200 +    function GetOnGateTimeout: TNotifyEvent;
201 +    procedure SetOnGateTimeout(AValue: TNotifyEvent);
202      property LockCount: integer read GetLockCount;
203 <    property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
203 >    property OnGateTimeout: TNotifyEvent read GetOnGateTimeout write SetOnGateTimeout;
204    end;
205  
206 <  { TGlobalInterface }
206 >  { TIPCInterface }
207  
208 <  TGlobalInterface = class(TIpcCommon)
208 >  TIPCInterface = class(TIpcCommon,IIPCInterface)
209    private
210      FMaxBufferSize: integer;
211 <    FSharedMemory: TSharedMemory;
212 <    FWriteLock: TMutex;
213 <    FBuffer: PChar;
211 >    FSharedMemory: ISharedMemory;
212 >    FWriteLock: IMutex;
213 >    FBuffer: PByte;
214      FTraceDataType,
215      FBufferSize: PInteger;
216      FTimeStamp: PDateTime;
217 <    FReadReadyEvent: TMultiLockGate;
218 <    FReadFinishedEvent: TMultiLockGate;
219 <    FDataAvailableEvent: TSingleLockGate;
220 <    FWriterBusyEvent: TSingleLockGate;
221 <    function GetMonitorCount: integer;
217 >    FMsgNumber: PInteger;
218 >    FReadReadyEvent: IMultiLockGate;
219 >    FReadFinishedEvent: IMultiLockGate;
220 >    FDataAvailableEvent: ISingleLockGate;
221 >    FWriterBusyEvent: ISingleLockGate;
222    public
223      constructor Create;
225 –    destructor Destroy; override;
224      procedure IncMonitorCount;
225      procedure DecMonitorCount;
226      procedure SendTrace(TraceObject: TTraceObject);
227      procedure ReceiveTrace(TraceObject: TTraceObject);
228 <    property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
229 <    property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
230 <    property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
231 <    property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
232 <    property WriteLock: TMutex read FWriteLock;
228 >    function GetDataAvailableEvent: ISingleLockGate;
229 >    function GetWriterBusyEvent: ISingleLockGate;
230 >    function GetReadReadyEvent: IMultiLockGate;
231 >    function GetReadFinishedEvent: IMultiLockGate;
232 >    function GetWriteLock: IMutex;
233 >    function GetMonitorCount: integer;
234 >    function GetSharedMemory: ISharedMemory;
235 >    function GetMaxBufferSize: integer;
236 >    property DataAvailableEvent: ISingleLockGate read GetDataAvailableEvent;
237 >    property WriterBusyEvent: ISingleLockGate read GetWriterBusyEvent;
238 >    property ReadReadyEvent: IMultiLockGate read GetReadReadyEvent;
239 >    property ReadFinishedEvent: IMultiLockGate read GetReadFinishedEvent;
240 >    property WriteLock: IMutex read GetWriteLock;
241      property MonitorCount: integer read GetMonitorCount;
242 <    property SharedMemory: TSharedMemory read FSharedMemory;
243 <    property MaxBufferSize: integer read FMaxBufferSize;
242 >    property SharedMemory: ISharedMemory read GetSharedMemory;
243 >    property MaxBufferSize: integer read GetMaxBufferSize;
244    end;
245  
246   { TSharedMemory }
# Line 242 | Line 248 | type
248   procedure TSharedMemory.GetSharedMemory(MemSize: integer);
249   var F: cint;
250   begin
251 +  if GetEnvironmentVariable('FBSQL_IPCFILENAME') <> '' then
252 +    FIPCFileName := GetEnvironmentVariable('FBSQL_IPCFILENAME')
253 +  else
254 +    FIPCFileName := GetTempDir(true) + IPCFileName + '.' + GetEnvironmentVariable('USER');
255 +
256      {Get the Shared Memory and Semaphore IDs from the Global File if it exists
257       or create them and the file otherwise }
258  
259      repeat
260 <      F := fpOpen(IPCFileName, O_WrOnly or O_Creat or O_Excl);
260 >      F := fpOpen(FIPCFileName, O_WrOnly or O_Creat or O_Excl);
261        if F < 0 then
262        begin
263          if fpgetErrno = ESysEEXIST {EEXIST} then
264          begin
265            { looks like it already exists}
266            Sleep(100);
267 <          F := fpOpen(IPCFileName,O_RdOnly);
267 >          F := fpOpen(FIPCFileName,O_RdOnly);
268            if (F < 0) and (fpgetErrno = ESysENOENT {ENOENT}) then
269              {probably just got deleted }
270            else
# Line 309 | Line 320 | begin
320    begin
321      shmctl(FSharedMemoryID,IPC_RMID,nil);
322      semctl(FSemaphoreSetID,0,IPC_RMID,arg);
323 <    DeleteFile(IPCFileName);
323 >    DeleteFile(FIPCFileName);
324    end;
325   end;
326  
# Line 332 | Line 343 | begin
343    inherited Destroy;
344   end;
345  
346 < function TSharedMemory.Allocate(Size: integer): PChar;
346 > function TSharedMemory.Allocate(Size: integer): PByte;
347   begin
348    if Size > FUnused then
349        IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
# Line 351 | Line 362 | begin
362    Inc(FBufPtr,Size)
363   end;
364  
365 + function TSharedMemory.GetLastAllocationSize: integer;
366 + begin
367 +  Result := FLastAllocationSize;
368 + end;
369 +
370   { TIpcCommon }
371  
372   function TIpcCommon.GetSa: PSecurityAttributes;
# Line 377 | Line 393 | begin
393      sembuf.sem_flg := flags or SEM_UNDO;
394      timeout.tv_sec := timeout_secs;
395      timeout.tv_nsec := 0;
396 < {$IFDEF HAS_SEMTIMEDOP}
396 > {$IF declared(semtimedop)}
397      Result := semtimedop(FSemaphoreSetID,@sembuf,1,@timeout);
398   {$ELSE}
399      Result := semop(FSemaphoreSetID,@sembuf,1);    {May hang on race condition}
400 < {$ENDIF}
400 > {$IFEND}
401   end;
402  
403   function TIpcCommon.GetSemValue(SemNum: integer): cint;
# Line 443 | Line 459 | begin
459    Result := FWaitingThreads^
460   end;
461  
462 < constructor TSingleLockGate.Create(SemNum: cint; AOwner: TGlobalInterface);
462 > constructor TSingleLockGate.Create(SemNum: cint; sm: ISharedMemory);
463   begin
464    inherited Create;
465 <  FOwner := AOwner;
466 <  FSignalledState := PInteger(FOwner.SharedMemory.Allocate(sizeof(FSignalledState)));
467 <  FWaitingThreads := PInteger(FOwner.SharedMemory.Allocate(sizeof(FWaitingThreads)));
465 >  FSharedMemory := sm;
466 >  FSignalledState := PInteger(FSharedMemory.Allocate(sizeof(FSignalledState)));
467 >  FWaitingThreads := PInteger(FSharedMemory.Allocate(sizeof(FWaitingThreads)));
468    FSemaphore := SemNum;
469    FMutex := SemNum + 1;
470    if FInitialiser then
# Line 479 | Line 495 | begin
495    begin
496      FSignalledState^ := 1;
497      sem_op(FMutex,-1,0); //Acquire Mutex
498 <    //writeln(ClassName + ': Unlocking' ,FSemaphore);
498 >    {$IFDEF DEBUG}writeln(ClassName + ': Unlocking' ,FSemaphore);{$ENDIF}
499      sem_op(FSemaphore,FWaitingThreads^,0);
500      FWaitingThreads^ := 0;
501      sem_op(FMutex,1,0); //Release Mutex
# Line 490 | Line 506 | procedure TSingleLockGate.Lock;
506   begin
507    if FSignalledState^ = 1 then
508    begin
509 <    //writeln(ClassName + ': Locking Gate ',FSemaphore);
509 >    {$IFDEF DEBUG}writeln(ClassName + ': Locking Gate ',FSemaphore);{$ENDIF}
510      SemInit(FSemaphore,0);
511      FSignalledState^ := 0;
512    end;
# Line 498 | Line 514 | end;
514  
515   { TMultilockGate }
516  
517 < constructor TMultilockGate.Create(SemNum: cint; AOwner: TGlobalInterface);
517 > constructor TMultilockGate.Create(SemNum: cint; sm: ISharedMemory);
518   begin
519    inherited Create;
504 –  FOwner := AOwner;
520    FSemaphore := SemNum;
521    FMutex := SemNum + 1;
522 <  FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
522 >  FSharedMemory := sm;
523 >  FLockCount := PInteger(FSharedMemory.Allocate(sizeof(FLockCount)));
524    if FInitialiser then
525    begin
526      FLockCount^ := 0;
# Line 518 | Line 534 | begin
534    Result := FLockCount^
535   end;
536  
537 + function TMultilockGate.GetOnGateTimeout: TNotifyEvent;
538 + begin
539 +  Result := FOnGateTimeout;
540 + end;
541 +
542 + procedure TMultilockGate.SetOnGateTimeout(AValue: TNotifyEvent);
543 + begin
544 +  FOnGateTimeout := AValue;
545 + end;
546 +
547   procedure TMultilockGate.Lock;
548   begin
549      sem_op(FMutex,-1,0); //Acquire Mutex
550      if FLockCount^ = 0 then
551      begin
552 <      //writeln(ClassName,': Locking ',FSemaphore);
552 >      {$IFDEF DEBUG}writeln(ClassName,': Locking ',FSemaphore);{$ENDIF}
553        SemInit(FSemaphore,0);
554      end;
555      Inc(FLockCount^);
# Line 536 | Line 562 | begin
562      Dec(FLockCount^);
563      if FLockCount^ <= 0 then
564      begin
565 <      //writeln(ClassName,': UnLocking ',FSemaphore);
565 >      {$IFDEF DEBUG}writeln(ClassName,': UnLocking ',FSemaphore);{$ENDIF}
566        SemInit(FSemaphore,1);
567        FLockCount^ := 0
568      end;
# Line 547 | Line 573 | procedure TMultilockGate.PassthroughGate
573   begin
574    if FLockCount^ = 0 then
575      Exit;
576 <  //writeln(ClassName,': Waiting on ',FSemaphore);
576 >  {$IFDEF DEBUG}writeln(ClassName,': Waiting on ',FSemaphore);{$ENDIF}
577    while sem_timedop(FSemaphore,-1,cDefaultTimeout) < 0 do
578    {looks like we lost a reader}
579    begin
580 +    {$IFDEF DEBUG}writeln(ClassName,': reader lost timeout');{$ENDIF}
581      if FLockCount^ > 0 then
582      begin
583        UnLock;
# Line 559 | Line 586 | begin
586      end
587    end;
588    sem_op(FSemaphore,1);
589 <  //writeln(ClassName,': Wait done on ',FSemaphore);
589 >  {$IFDEF DEBUG}writeln(ClassName,': Wait done on ',FSemaphore);{$ENDIF}
590   end;
591  
592  
593 < { TGlobalInterface }
593 > { TIPCInterface }
594  
595 < function TGlobalInterface.GetMonitorCount: integer;
595 > function TIPCInterface.GetMonitorCount: integer;
596   begin
597    Result := GetSemValue(cMonitorCounter)
598   end;
599  
600 < constructor TGlobalInterface.Create;
600 > function TIPCInterface.GetSharedMemory: ISharedMemory;
601 > begin
602 >  Result := FSharedMemory;
603 > end;
604 >
605 > function TIPCInterface.GetMaxBufferSize: integer;
606 > begin
607 >  Result := FMaxBufferSize;
608 > end;
609 >
610 > constructor TIPCInterface.Create;
611   begin
612    inherited Create;
613    FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
614  
615    FWriteLock := TMutex.Create(cMutexSemaphore);
616  
617 <  FDataAvailableEvent := TSingleLockGate.Create(cDataAvailableEventSemaphore,self);
618 <  FWriterBusyEvent := TSingleLockGate.Create(cWriterBusyEventSemaphore,self);
619 <  FReadReadyEvent := TMultiLockGate.Create(cReadReadyEventSemaphore,self);
620 <  FReadFinishedEvent := TMultiLockGate.Create(cReadFinishedEventSemaphore,self);
617 >  FDataAvailableEvent := TSingleLockGate.Create(cDataAvailableEventSemaphore,FSharedMemory);
618 >  FWriterBusyEvent := TSingleLockGate.Create(cWriterBusyEventSemaphore,FSharedMemory);
619 >  FReadReadyEvent := TMultiLockGate.Create(cReadReadyEventSemaphore,FSharedMemory);
620 >  FReadFinishedEvent := TMultiLockGate.Create(cReadFinishedEventSemaphore,FSharedMemory);
621  
622    if FInitialiser then
623      SemInit(cMonitorCounter,0);
624    FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
625    FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
626    FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
627 +  FMsgNumber := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
628    FBuffer := FSharedMemory.Allocate(0); //All remaining
629    FMaxBufferSize := FSharedMemory.LastAllocationSize;
630  
631    if FInitialiser then
632    begin
633      FBufferSize^ := 0;
634 <    FDataAvailableEvent.Lock
634 >    FDataAvailableEvent.Lock;
635 >    FMsgNumber^ := 0;
636    end;
637   end;
638  
639 < destructor TGlobalInterface.Destroy;
601 < begin
602 <  if assigned(FWriteLock) then FWriteLock.Free;
603 <  if assigned(FDataAvailableEvent) then FDataAvailableEvent.Free;
604 <  if assigned(FWriterBusyEvent) then FWriterBusyEvent.Free;
605 <  if assigned(FReadReadyEvent) then FReadReadyEvent.Free;
606 <  if assigned(FReadFinishedEvent) then FReadFinishedEvent.Free;
607 <  if assigned(FSharedMemory) then FSharedMemory.Free;
608 <  inherited Destroy;
609 < end;
610 <
611 < procedure TGlobalInterface.IncMonitorCount;
639 > procedure TIPCInterface.IncMonitorCount;
640   begin
641    sem_op(cMonitorCounter,1);
642   end;
643  
644 < procedure TGlobalInterface.DecMonitorCount;
644 > procedure TIPCInterface.DecMonitorCount;
645   begin
646    sem_op(cMonitorCounter,-1,IPC_NOWAIT);
647   end;
648  
649 < procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
649 > procedure TIPCInterface.SendTrace(TraceObject: TTraceObject);
650   begin
651    FTraceDataType^ := Integer(TraceObject.FDataType);
652    FTimeStamp^ := TraceObject.FTimeStamp;
653 <  FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
653 >  if Length(TraceObject.FMsg) > MaxBufferSize then
654 >    FBufferSize^ := MaxBufferSize
655 >  else
656 >    FBufferSize^ := Length(TraceObject.FMsg);
657 >  FMsgNumber^ := TraceObject.FMsgNumber;
658    Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
659   end;
660  
661 < procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
661 > procedure TIPCInterface.ReceiveTrace(TraceObject: TTraceObject);
662   begin
663 <  SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
663 >  SetString(TraceObject.FMsg, PAnsiChar(FBuffer), FBufferSize^);
664    TraceObject.FDataType := TTraceFlag(FTraceDataType^);
665    TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
666 +  TraceObject.FMsgNumber := FMsgNumber^;
667 + end;
668 +
669 + function TIPCInterface.GetDataAvailableEvent: ISingleLockGate;
670 + begin
671 +  Result := FDataAvailableEvent;
672 + end;
673 +
674 + function TIPCInterface.GetWriterBusyEvent: ISingleLockGate;
675 + begin
676 +  Result := FWriterBusyEvent;
677 + end;
678 +
679 + function TIPCInterface.GetReadReadyEvent: IMultiLockGate;
680 + begin
681 +  Result := FReadReadyEvent;
682 + end;
683 +
684 + function TIPCInterface.GetReadFinishedEvent: IMultiLockGate;
685 + begin
686 +  Result := FReadFinishedEvent;
687 + end;
688 +
689 + function TIPCInterface.GetWriteLock: IMutex;
690 + begin
691 +  Result := FWriteLock;
692   end;
693  
694  

Diff Legend

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