← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/ide/fpcatch.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/ide/fpcatch.pas
 
1
{
 
2
    Copyright (c) 1997-98 by Michael Van Canneyt
 
3
 
 
4
    Unit to catch segmentation faults and Ctrl-C and exit gracefully
 
5
    under linux and go32v2
 
6
 
 
7
    See the file COPYING.FPC, included in this distribution,
 
8
    for details about the copyright.
 
9
 
 
10
    This program is distributed in the hope that it will be useful,
 
11
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
13
 
 
14
 **********************************************************************}
 
15
Unit fpcatch;
 
16
interface
 
17
 
 
18
{$i globdir.inc}
 
19
 
 
20
{$ifdef Unix}
 
21
uses
 
22
  {$ifdef VER1_0}
 
23
    linux;
 
24
  {$else}
 
25
    baseunix,
 
26
    unix;
 
27
  {$endif}
 
28
{$endif}
 
29
{$ifdef go32v2}
 
30
uses
 
31
  dpmiexcp;
 
32
{$endif}
 
33
{$ifdef Windows}
 
34
uses
 
35
  windows
 
36
  {$ifdef HasSignal}
 
37
    ,signals
 
38
  {$endif}
 
39
  ;
 
40
{$endif}
 
41
 
 
42
{$ifdef HasSignal}
 
43
Var
 
44
  NewSignal,OldSigSegm,OldSigILL,
 
45
  OldSigInt,OldSigFPE : SignalHandler;
 
46
{$endif}
 
47
 
 
48
Const
 
49
  CtrlCPressed : Boolean = false;
 
50
 
 
51
Procedure EnableCatchSignals;
 
52
Procedure DisableCatchSignals;
 
53
 
 
54
{$ifdef DEBUG}
 
55
procedure Generate_SIGSEGV;
 
56
procedure Generate_SIGFPE;
 
57
{$endif DEBUG}
 
58
 
 
59
var
 
60
  StopJmp : Jmp_Buf;
 
61
const
 
62
  StopJmpValid : boolean = false;
 
63
 
 
64
{$IFNDEF HASSIGNAL}
 
65
const
 
66
  SIGABRT   = 288;
 
67
  SIGFPE    = 289;
 
68
  SIGILL    = 290;
 
69
  SIGSEGV   = 291;
 
70
  SIGTERM   = 292;
 
71
  SIGALRM   = 293;
 
72
  SIGHUP    = 294;
 
73
  SIGINT    = 295;
 
74
  SIGKILL   = 296;
 
75
  SIGPIPE   = 297;
 
76
  SIGQUIT   = 298;
 
77
  SIGUSR1   = 299;
 
78
  SIGUSR2   = 300;
 
79
  SIGNOFP   = 301;
 
80
  SIGTRAP   = 302;
 
81
  SIGTIMR   = 303;    { Internal for setitimer (SIGALRM, SIGPROF) }
 
82
  SIGPROF   = 304;
 
83
  SIGMAX    = 320;
 
84
 
 
85
  SIG_BLOCK   = 1;
 
86
  SIG_SETMASK = 2;
 
87
  SIG_UNBLOCK = 3;
 
88
{$ENDIF HASSIGNAL}
 
89
 
 
90
 
 
91
Implementation
 
92
 
 
93
uses
 
94
  keyboard,
 
95
  drivers,
 
96
  FVConsts,
 
97
  dos,app,msgbox,
 
98
  FPCompil,FPIDE;
 
99
 
 
100
Const
 
101
  LastCtrlC : longint = 0;
 
102
 
 
103
 
 
104
{$ifdef useresstrings}
 
105
resourcestring
 
106
{$else}
 
107
const
 
108
{$endif}
 
109
      msg_quitconfirm         = 'Do You really want to quit?';
 
110
 
 
111
{$ifdef DEBUG}
 
112
 
 
113
procedure Generate_SIGSEGV;
 
114
var
 
115
  l : plongint;
 
116
begin
 
117
  { Force a SIGSEGV }
 
118
  l:=pointer (ptrint ($ffffffff));
 
119
  l^:=1;
 
120
end;
 
121
 
 
122
procedure Generate_SIGFPE;
 
123
var
 
124
  x,y : real;
 
125
begin
 
126
  { Force a SIGFPE }
 
127
  y:=-5;
 
128
  x:=sqrt(y);
 
129
end;
 
130
 
 
131
{$endif DEBUG}
 
132
 
 
133
{$ifdef HasSignal}
 
134
{$ifndef SignalIsFunction}
 
135
Procedure Catchsignal(Sig : Longint);cdecl;
 
136
{$else SignalIsFunction}
 
137
  {$ifdef SignalIsCdecl}
 
138
  Function Catchsignal(Sig : longint):longint; cdecl;
 
139
  {$else not SignalIsCdecl}
 
140
  Function Catchsignal(Sig : longint):longint;
 
141
  {$endif not SignalIsCdecl}
 
142
{$endif SignalIsFunction}
 
143
var MustQuit: boolean;
 
144
begin
 
145
  case Sig of
 
146
   SIGSEGV : begin
 
147
               if StopJmpValid then
 
148
                 LongJmp(StopJmp,SIGSEGV);
 
149
               if Assigned(Application) then IDEApp.Done;
 
150
               Writeln('Internal SIGSEGV Error caught');
 
151
{$ifndef DEBUG}
 
152
               Halt;
 
153
{$else DEBUG}
 
154
               RunError(216);
 
155
{$endif DEBUG}
 
156
             end;
 
157
    SIGFPE : begin
 
158
                if StopJmpValid then
 
159
                  LongJmp(StopJmp,SIGFPE);
 
160
               if Assigned(Application) then IDEApp.Done;
 
161
               Writeln('Internal SIGFPE Error caught');
 
162
{$ifndef DEBUG}
 
163
               Halt;
 
164
{$else DEBUG}
 
165
               RunError(207);
 
166
{$endif DEBUG}
 
167
             end;
 
168
    SIGILL : begin
 
169
                if StopJmpValid then
 
170
                  LongJmp(StopJmp,SIGILL);
 
171
               if Assigned(Application) then IDEApp.Done;
 
172
               Writeln('Internal SIGILL Error caught');
 
173
{$ifndef DEBUG}
 
174
               Halt;
 
175
{$else DEBUG}
 
176
               RunError(216);
 
177
{$endif DEBUG}
 
178
             end;
 
179
    SIGINT : begin
 
180
               if StopJmpValid then
 
181
                 LongJmp(StopJmp,SIGINT);
 
182
               IF NOT CtrlCPressed and Assigned(Application) then
 
183
                 begin
 
184
                   MustQuit:=false;
 
185
{$ifdef FPC}
 
186
                   if GetDosTicks>LastCtrlC+10 then
 
187
                     begin
 
188
                       CtrlCPressed:=true;
 
189
                       Keyboard.PutKeyEvent((kbCtrl shl 16) or kbCtrlC);
 
190
                       LastCtrlC:=GetDosTicks;
 
191
                     end;
 
192
{$endif FPC}
 
193
                 end
 
194
               else
 
195
                 begin
 
196
                   if Assigned(Application) then
 
197
                     MustQuit:=MessageBox(#3+msg_QuitConfirm,nil,mferror+mfyesbutton+mfnobutton)=cmYes
 
198
                   else
 
199
                     MustQuit:=true;
 
200
                 end;
 
201
               if MustQuit then
 
202
                begin
 
203
                  if Assigned(Application) then IDEApp.Done;
 
204
{$ifndef DEBUG}
 
205
                  Halt;
 
206
{$else DEBUG}
 
207
                  RunError(216);
 
208
{$endif DEBUG}
 
209
                end;
 
210
             end;
 
211
  end;
 
212
{$ifdef SignalIsFunction}
 
213
  CatchSignal:=0;
 
214
{$endif SignalIsFunction}
 
215
end;
 
216
{$endif def HasSignal}
 
217
 
 
218
 
 
219
Const
 
220
  CatchSignalsEnabled : boolean = false;
 
221
 
 
222
Procedure EnableCatchSignals;
 
223
{$ifdef Windows}
 
224
  var Mode: DWORD;
 
225
{$endif Windows}
 
226
begin
 
227
  if CatchSignalsEnabled then
 
228
    exit;
 
229
{$ifdef Windows}
 
230
  if GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @Mode) then
 
231
    begin
 
232
{$ifdef DEBUG}
 
233
      Writeln(stderr,'Starting value of ConsoleMode is $',hexstr(Mode,8));
 
234
{$endif DEBUG}
 
235
      SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)),
 
236
        (Mode or ENABLE_MOUSE_INPUT) and not ENABLE_PROCESSED_INPUT);
 
237
{$ifdef DEBUG}
 
238
    end
 
239
  else
 
240
    begin
 
241
      Writeln(stderr,'Call to GetConsoleMode failed, GetLastError=',
 
242
        GetLastError);
 
243
{$endif DEBUG}
 
244
    end;
 
245
{$endif Windows}
 
246
{$ifdef go32v2}
 
247
  {
 
248
    I think that it was an error to put that here PM
 
249
    djgpp_set_ctrl_c(false);
 
250
    at least since that this is now handled in fpusrscr.pas unit
 
251
  }
 
252
{$endif go32v2}
 
253
{$ifdef HasSignal}
 
254
{$ifndef TP}
 
255
  NewSignal:=@CatchSignal;
 
256
{$else TP}
 
257
  NewSignal:=SignalHandler(CatchSignal);
 
258
{$endif TP}
 
259
  OldSigSegm:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGSEGV,NewSignal);
 
260
  OldSigInt:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGINT,NewSignal);
 
261
  OldSigFPE:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGFPE,NewSignal);
 
262
  OldSigILL:={$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGILL,NewSignal);
 
263
  CatchSignalsEnabled:=true;
 
264
{$endif}
 
265
end;
 
266
 
 
267
Procedure DisableCatchSignals;
 
268
begin
 
269
{$ifdef HasSignal}
 
270
  if not CatchSignalsEnabled then
 
271
    exit;
 
272
  {$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGSEGV,OldSigSegm);
 
273
  {$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGINT,OldSigInt);
 
274
  {$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGFPE,OldSigFPE);
 
275
  {$ifdef unix}{$ifdef ver1_0}Signal{$else}fpSignal{$endif}{$else}Signal{$endif}(SIGILL,OldSigILL);
 
276
  CatchSignalsEnabled:=false;
 
277
{$endif}
 
278
end;
 
279
 
 
280
end.