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

Annotation of /trunk/lsignal.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (hide annotations)
Fri Mar 28 03:18:52 2014 UTC (4 years, 8 months ago) by beware
File size: 6971 byte(s)
fix spelling mistakes
1 plugwash 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 plugwash 60 baseunix,unix,unixutil,sockets,
18 plugwash 1 {$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 plugwash 10
41 plugwash 1 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 beware 136 // so USING something unlikely to cause collisions in the global namespace
120 plugwash 1 // is a good idea
121     procedure lsignal_handler( Sig : Integer);cdecl;
122     var
123     currentsignal : tlsignal;
124     begin
125 beware 136 // writeln('in lsignal_handler');
126 plugwash 1 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 beware 136 // writeln('left lsignal_handler');
137 plugwash 1 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 plugwash 78 saction : sigactionrec = (sa_handler:sigactionhandler(lsignal_handler);sa_flags:0);
160 plugwash 1 {$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 plugwash 10 {$ifdef ver1_0}
197     saction.sa_mask := blockset[0];
198     {$else}
199 plugwash 1 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.22