File: yokesharemem.pas

package info (click to toggle)
mricron 0.20140804.1~dfsg.1-3
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 13,508 kB
  • sloc: pascal: 114,876; sh: 49; makefile: 35
file content (135 lines) | stat: -rwxr-xr-x 3,956 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
unit yokesharemem;
{$mode objfpc}{$H+}
interface
//http://community.freepascal.org:10000/docs-html/rtl/ipc/shmctl
// call  CreateSharedMem when an application is created and  CloseSharedMem when a program is closed
// along with NInstances, these functions return the number of concurrent instances.
// if a program crashes, the values may not be reset until the next reboot

uses
  forms, classes,
  {$IFDEF UNIX}
  BaseUnix, SysUtils, ipc,dialogs;
 {$ELSE}
   winmemmap;
 {$ENDIF}
 function CreateSharedMem (lApp: TComponent): integer; //returns number of instances after including this one...
 function CloseSharedMem: integer; //returns number of instances after after this one closes
 function NInstances: integer; //returns number of instances
 function SetShareFloats(lXmm,lYmm,lZmm: single): boolean;
 function GetShareFloats(var lXmm,lYmm,lZmm: single): boolean;

implementation

type
  TShareMem =  record
   Instances: integer;
   Xmm,Ymm,Zmm: single;
  end;
  PIntBuffer = ^TShareMem;
var
   gShareIntBuf: PIntBuffer;
   gPrevShare : TShareMem;

function NInstances: integer;
begin
      result := gShareIntBuf^.Instances;
end;

function SetShareFloats(lXmm,lYmm,lZmm: single): boolean;
begin
        gShareIntBuf^.Xmm := lXmm;
        gShareIntBuf^.Ymm := lYmm;
        gShareIntBuf^.Zmm := lZmm;
        gPrevShare :=  gShareIntBuf^;
end;

function GetShareFloats(var lXmm,lYmm,lZmm: single): boolean;
begin
        lXmm := gShareIntBuf^.Xmm;
        lYmm := gShareIntBuf^.Ymm;
        lZmm := gShareIntBuf^.Zmm;
        if (lXmm = gPrevShare.Xmm) and (lYmm = gPrevShare.Ymm) and(lZmm = gPrevShare.Zmm) then
           result := false
        else
            result := true;
        gPrevShare :=  gShareIntBuf^;
end;
{$IFNDEF UNIX} //Windows implementation
var
EMemMap : TEMemMap;

function CreateSharedMem (lApp: TComponent): integer; //returns number of instances after including this one...
var
 I: integer;
begin
  EMemMap:=TEMemMap.Create(lApp{Self});
  EMemMap.CreateMutex('MRICROMUTEX3');
  If NOT EMemMap.MapExisting('MRICROMAP3',SizeOf(TShareMem)) then begin
	gPrevShare.Xmm:=0;
	gPrevShare.Ymm:=0;
        gPrevShare.Zmm:=0;
        gPrevShare.Instances:=0;
        If NOT EMemMap.CreateMemMap('MRICROMAP2',SizeOf(TShareMem),gPrevShare) then
		EMemMap.RaiseMappingException;
         gShareIntBuf := PINtBuffer(EMemMap.MemMap);
  end else
      gShareIntBuf^.Instances := gShareIntBuf^.Instances + 1;
end;


function CloseSharedMem: integer; //returns number of instances after after this one closesb
begin
    EMemMap.Free;
end;

{$ELSE}
var
 fshmid: longint;
 segptr  : Pointer;

function CreateSharedMem (lApp: TComponent): integer; //returns number of instances after including this one...
 var
    key : Tkey;
    new: boolean;
    const ftokpath = '.'#0;
 begin
   key := ftok (pchar(@ftokpath[1]),ord('S'));
  fshmid := shmget(key,SizeOf(TShareMem) {segsize},IPC_CREAT or IPC_EXCL or 438);
  If fshmid=-1 then begin
    //showmessage('Loading existing memory.');
    new := false;
    fshmid := shmget(key,SizeOf(TShareMem){segsize},0);
    If fshmid = -1 then begin
      showmessage ('Shared memory : Error !'+inttostr(fpgeterrno));
      halt(1);
      end
    end
  else begin
    new := true;
    //showmessage ('Creating new shared memory segment.');
  end;
  segptr:=shmat(fshmid,nil,0);
  gShareIntBuf := segptr;
  if new then
     gShareIntBuf^.Instances := 1
  else
      gShareIntBuf^.Instances :=gShareIntBuf^.Instances + 1;
 result :=  gShareIntBuf^.Instances;
end;

function CloseSharedMem: integer;
//returns number of instances after this application quits
begin
  gShareIntBuf^.Instances := gShareIntBuf^.Instances -1;
  result := gShareIntBuf^.Instances;
  if Assigned (segptr) then
    shmdt (segptr);
  if result < 1 then begin //last running instance - close shared memory
    if shmctl (FShmId, IPC_RMID, nil) = -1 then
      Showmessage('unable to release shared memory');
  end;
end;
{$ENDIF}
end.