/[lcore]/trunk/lsignal.pas
ViewVC logotype

Contents of /trunk/lsignal.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (show annotations)
Fri Mar 28 03:18:52 2014 UTC (3 years, 8 months ago) by beware
File size: 6971 byte(s)
fix spelling mistakes
1 {lsocket.pas}
2
3 {signal code by plugwash}
4
5 { Copyright (C) 2005 Bas Steendijk and Peter Green
6 For conditions of distribution and use, see copyright notice in zlib_license.txt
7 which is included in the package
8 ----------------------------------------------------------------------------- }
9
10 unit lsignal;
11 {$mode delphi}
12 interface
13 uses sysutils,
14 {$ifdef VER1_0}
15 linux,
16 {$else}
17 baseunix,unix,unixutil,sockets,
18 {$endif}
19 classes,lcore,lloopback;
20
21 type
22 tsignalevent=procedure(sender:tobject;signal:integer) of object;
23 tlsignal=class(tcomponent)
24 public
25 onsignal : tsignalevent ;
26 prevsignal : tlsignal ;
27 nextsignal : tlsignal ;
28
29 constructor create(aowner:tcomponent);override;
30 destructor destroy;override;
31 end;
32
33
34 procedure starthandlesignal(signal:integer);
35
36 var
37 firstsignal : tlsignal;
38 blockset : sigset;
39 signalloopback : tlloopback ;
40
41 implementation
42 {$include unixstuff.inc}
43
44 constructor tlsignal.create;
45 begin
46 inherited create(AOwner);
47 nextsignal := firstsignal;
48 prevsignal := nil;
49
50 if assigned(nextsignal) then nextsignal.prevsignal := self;
51 firstsignal := self;
52
53 //interval := 1000;
54 //enabled := true;
55 //released := false;
56 end;
57
58 destructor tlsignal.destroy;
59 begin
60 if prevsignal <> nil then begin
61 prevsignal.nextsignal := nextsignal;
62 end else begin
63 firstsignal := nextsignal;
64 end;
65 if nextsignal <> nil then begin
66 nextsignal.prevsignal := prevsignal;
67 end;
68 inherited destroy;
69 end;
70 {$ifdef linux}
71 {$ifdef ver1_9_8}
72 {$define needsignalworkaround}
73 {$endif}
74 {$ifdef ver2_0_0}
75 {$define needsignalworkaround}
76 {$endif}
77 {$ifdef ver2_0_2}
78 {$define needsignalworkaround}
79 {$endif}
80 {$endif}
81 {$ifdef needsignalworkaround}
82 //using the 1.9.6 version of this stuff because the 1.9.8 and 2.0.0 versions seem broken
83 type
84 TSysParam = Longint;
85 TSysResult = longint;
86 const
87 syscall_nr_sigaction = 67;
88 //function Do_SysCall(sysnr:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL0';
89 //function Do_SysCall(sysnr,param1:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL1';
90 //function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL2';
91 function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL3';
92 //function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL4';
93 //function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall; {$endif} external name 'FPC_SYSCALL5';
94
95 function Fpsigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint;// [public, alias : 'FPC_SYSC_SIGACTION'];
96 {
97 Change action of process upon receipt of a signal.
98 Signum specifies the signal (all except SigKill and SigStop).
99 If Act is non-nil, it is used to specify the new action.
100 If OldAct is non-nil the previous action is saved there.
101 }
102 begin
103 //writeln('fucking');
104 {$ifdef RTSIGACTION}
105 {$ifdef cpusparc}
106 { Sparc has an extra stub parameter }
107 Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(PtrInt(@Fprt_sigreturn_stub)-8),TSysParam(8));
108 {$else cpusparc}
109 Fpsigaction:=do_syscall(syscall_nr_rt_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact),TSysParam(8));
110 {$endif cpusparc}
111 {$else RTSIGACTION}
112 //writeln('nice');
113 Fpsigaction:=do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(act),TSysParam(oact));
114 {$endif RTSIGACTION}
115 end;
116 {$endif}
117
118 // cdecl procedures are not name mangled
119 // so USING something unlikely to cause collisions in the global namespace
120 // is a good idea
121 procedure lsignal_handler( Sig : Integer);cdecl;
122 var
123 currentsignal : tlsignal;
124 begin
125 // writeln('in lsignal_handler');
126 currentsignal := firstsignal;
127 while assigned(currentsignal) do begin
128 if assigned(currentsignal.onsignal) then currentsignal.onsignal(currentsignal,sig);
129 currentsignal := currentsignal.nextsignal;
130
131 end;
132 // writeln('about to send down signalloopback');
133 if assigned(signalloopback) then begin
134 signalloopback.sendstr(' ');
135 end;
136 // writeln('left lsignal_handler');
137 end;
138
139 {$ifdef freebsd}
140
141 {$if (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))}
142 procedure lsignal_handler2(signal:longint;info:PSigInfo;context:psigcontext); cdecl;
143 {$else}
144 procedure lsignal_handler2(signal:longint;var info:TSigInfo_t;var context:SigContextRec); cdecl;
145 {$endif}
146
147 begin
148 lsignal_handler(signal);
149 end;
150 {$endif}
151
152
153 const
154 allbitsset=-1;
155 {$ifdef ver1_0}
156 saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
157 {$else}
158 {$ifdef darwin}
159 saction : sigactionrec = (sa_handler:sigactionhandler(lsignal_handler);sa_flags:0);
160 {$else}
161 {$ifdef freebsd}
162 //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
163 {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
164 saction : sigactionrec = (sa_handler:lsignal_handler2;sa_flags:0);
165 {$else}
166 saction : sigactionrec = (sa_handler:tsigaction(lsignal_handler);sa_flags:0);
167 {$endif}
168
169 {$else}
170 {$ifdef ver1_9_2}
171 saction : sigactionrec = (handler:(sh:lsignal_handler);sa_flags:0);
172 {$else}
173 //version number is FPC_VERSION.FPC_RELEASE.FPC_PATCH
174 {$if (FPC_VERSION>2) or ((FPC_VERSION=2) and (FPC_RELEASE>0)) or ((FPC_VERSION=2) and (fpc_release=0) and (fpc_patch>=2))}
175 saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_4}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler);sa_flags:0;sa_restorer:nil);
176 {$else}
177 saction : sigactionrec = (sa_handler:{$ifndef ver1_9_6}{$ifndef ver1_9_4}{$ifndef ver1_0}SigActionHandler{$endif}{$endif}{$endif}(lsignal_handler));
178 {$endif}
179 {$endif}
180 {$endif}
181 {$endif}
182 {$endif}
183 procedure starthandlesignal(signal:integer);
184 begin
185 if signal in ([0..31]-[sigkill,sigstop]) then begin
186 sigprocmask(SIG_BLOCK,@blockset,nil);
187 sigaction(signal,@saction,nil)
188 end else begin
189 raise exception.create('invalid signal number')
190 end;
191 end;
192
193 initialization
194 fillchar(blockset,sizeof(blockset),0);
195 blockset[0] := $FFFFFFFF - (1 shl sigstop) - (1 shl sigkill) - (1 shl sigsegv);
196 {$ifdef ver1_0}
197 saction.sa_mask := blockset[0];
198 {$else}
199 saction.sa_mask := blockset;
200 {$endif}
201 end.

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5