← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/win32/signals.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/win32/signals.pp
2
2
 
3
3
interface
4
4
 
 
5
{$PACKRECORDS C}
 
6
 
5
7
  { Signals }
6
8
  const
7
9
    SIGABRT   = 288;
27
29
    SIG_SETMASK = 2;
28
30
    SIG_UNBLOCK = 3;
29
31
 
30
 
  function SIG_DFL( x: longint) : longint;
31
 
 
32
 
  function SIG_ERR( x: longint) : longint;
33
 
 
34
 
  function SIG_IGN( x: longint) : longint;
 
32
  function SIG_DFL( x: longint) : longint; cdecl;
 
33
 
 
34
  function SIG_ERR( x: longint) : longint; cdecl;
 
35
 
 
36
  function SIG_IGN( x: longint) : longint; cdecl;
35
37
 
36
38
  type
37
39
 
38
 
    SignalHandler  = function (v : longint) : longint;
 
40
    SignalHandler  = function (v : longint) : longint;cdecl;
39
41
 
40
42
    PSignalHandler = ^SignalHandler; { to be compatible with linux.pp }
41
43
 
97
99
  type
98
100
     pexception_record = ^exception_record;
99
101
     EXCEPTION_RECORD  = record
100
 
       ExceptionCode   : longint;
 
102
       ExceptionCode   : cardinal;
101
103
       ExceptionFlags  : longint;
102
104
       ExceptionRecord : pexception_record;
103
105
       ExceptionAddress : pointer;
112
114
     end;
113
115
 
114
116
 
115
 
 
116
117
implementation
117
118
 
118
119
 
150
151
 
151
152
     function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : LPTOP_LEVEL_EXCEPTION_FILTER)
152
153
       : LPTOP_LEVEL_EXCEPTION_FILTER;
153
 
       external 'kernel32' name 'SetUnhandledExceptionFilter';
 
154
       stdcall; external 'kernel32' name 'SetUnhandledExceptionFilter';
154
155
 
155
156
var
156
157
  signal_list : Array[SIGABRT..SIGMAX] of SignalHandler;
157
158
var
158
159
  { value of the stack segment
159
160
    to check if the call stack can be written on exceptions }
160
 
  _SS : longint;
 
161
  _SS : cardinal;
161
162
 
162
163
const
163
164
  fpucw : word = $1332;
164
 
 
165
 
 
166
 
 
167
 
  function Signals_exception_handler(excep :PEXCEPTION_POINTERS) : longint;stdcall;
 
165
  Exception_handler_installed : boolean = false;
 
166
  MAX_Level = 16;
 
167
  except_level : byte = 0;
 
168
var
 
169
  except_eip   : array[0..Max_level-1] of longint;
 
170
  except_signal : array[0..Max_level-1] of longint;
 
171
  reset_fpu    : array[0..max_level-1] of boolean;
 
172
 
 
173
  procedure JumpToHandleSignal;
 
174
    var
 
175
      res, eip, _ebp, sigtype : longint;
 
176
    begin
 
177
      asm
 
178
        movl (%ebp),%eax
 
179
        movl %eax,_ebp
 
180
      end;
 
181
      Writeln('In start of JumpToHandleSignal');
 
182
      if except_level>0 then
 
183
        dec(except_level)
 
184
      else
 
185
        RunError(216);
 
186
      eip:=except_eip[except_level];
 
187
 
 
188
      sigtype:=except_signal[except_level];
 
189
      if reset_fpu[except_level] then
 
190
        asm
 
191
          fninit
 
192
          fldcw   fpucw
 
193
        end;
 
194
      if assigned(System_exception_frame) then
 
195
        { get the handler in front again }
 
196
        asm
 
197
          movl  System_exception_frame,%eax
 
198
          movl  %eax,%fs:(0)
 
199
        end;
 
200
      if (sigtype>=SIGABRT) and (sigtype<=SIGMAX) and
 
201
         (signal_list[sigtype]<>@SIG_DFL) then
 
202
        begin
 
203
          res:=signal_list[sigtype](sigtype);
 
204
        end
 
205
      else
 
206
        res:=0;
 
207
 
 
208
      if res=0 then
 
209
        Begin
 
210
          Writeln('In JumpToHandleSignal');
 
211
          RunError(sigtype);
 
212
        end
 
213
      else
 
214
        { jump back to old code }
 
215
        asm
 
216
          movl eip,%eax
 
217
          push %eax
 
218
          movl _ebp,%eax
 
219
          push %eax
 
220
          leave
 
221
          ret
 
222
        end;
 
223
    end;
 
224
 
 
225
 
 
226
 
 
227
  function Signals_exception_handler
 
228
    (excep_exceptionrecord :PEXCEPTION_RECORD;
 
229
     excep_frame : PEXCEPTION_FRAME;
 
230
     excep_contextrecord : PCONTEXT;
 
231
     dispatch : pointer) : longint;stdcall;
168
232
    var frame,res  : longint;
169
 
        function CallSignal(error,frame : longint;must_reset_fpu : boolean) : longint;
 
233
        function CallSignal(sigtype,frame : longint;must_reset_fpu : boolean) : longint;
170
234
          begin
171
 
            CallSignal:=Exception_Continue_Search;
172
 
{$ifdef i386}
173
 
            if must_reset_fpu then
174
 
              asm
175
 
                fninit
176
 
                fldcw   fpucw
 
235
            writeln(stderr,'CallSignal called');
 
236
            {if frame=0 then
 
237
              begin
 
238
                CallSignal:=1;
 
239
                writeln(stderr,'CallSignal frame is zero');
 
240
              end
 
241
            else    }
 
242
              begin
 
243
                 if except_level >= Max_level then
 
244
                   exit;
 
245
                 except_eip[except_level]:=excep_ContextRecord^.Eip;
 
246
                 except_signal[except_level]:=sigtype;
 
247
                 reset_fpu[except_level]:=must_reset_fpu;
 
248
                 inc(except_level);
 
249
                 {dec(excep^.ContextRecord^.Esp,4);
 
250
                 plongint (excep^.ContextRecord^.Esp)^ := longint(excep^.ContextRecord^.Eip);}
 
251
                 excep_ContextRecord^.Eip:=longint(@JumpToHandleSignal);
 
252
                 excep_ExceptionRecord^.ExceptionCode:=0;
 
253
                 CallSignal:=0;
 
254
                 writeln(stderr,'Exception_Continue_Execution  set');
177
255
              end;
178
 
{$endif i386}
179
 
            if (error>=SIGABRT) and (error<=SIGMAX) and (signal_list[error]<>@SIG_DFL) then
180
 
              res:=signal_list[error](error);
181
 
            if res>=0 then
182
 
              CallSignal:=Exception_Continue_Execution;
183
256
          end;
184
257
 
185
258
    begin
186
 
{$ifdef i386}
187
 
       if excep^.ContextRecord^.SegSs=_SS then
188
 
         frame:=excep^.ContextRecord^.Ebp
 
259
       if excep_ContextRecord^.SegSs=_SS then
 
260
         frame:=excep_ContextRecord^.Ebp
189
261
       else
190
 
{$endif i386}
191
262
         frame:=0;
192
263
       { default : unhandled !}
193
 
       res:=Exception_Continue_Search;
 
264
       res:=1;
194
265
{$ifdef SYSTEMEXCEPTIONDEBUG}
195
266
       if IsConsole then
196
 
         writeln(stderr,'Exception  ',
197
 
           hexstr(excep^.ExceptionRecord^.ExceptionCode,8));
 
267
         writeln(stderr,'Signals exception  ',
 
268
           hexstr(excep_ExceptionRecord^.ExceptionCode,8));
198
269
{$endif SYSTEMEXCEPTIONDEBUG}
199
 
       case excep^.ExceptionRecord^.ExceptionCode of
 
270
       case excep_ExceptionRecord^.ExceptionCode of
200
271
         EXCEPTION_ACCESS_VIOLATION :
201
272
           res:=CallSignal(SIGSEGV,frame,false);
202
273
         { EXCEPTION_BREAKPOINT = $80000003;
245
316
         EXCEPTION_PRIV_INSTRUCTION,
246
317
         EXCEPTION_IN_PAGE_ERROR,
247
318
         EXCEPTION_SINGLE_STEP : res:=CallSignal(SIGSEGV,frame,false);
 
319
         { Ignore EXCEPTION_INVALID_HANDLE exceptions }
 
320
         EXCEPTION_INVALID_HANDLE : res:=0;
248
321
         end;
249
322
       Signals_exception_handler:=res;
250
323
    end;
251
324
 
252
325
 
 
326
    function API_signals_exception_handler(except : PEXCEPTION_POINTERS) : longint; stdcall;
 
327
    begin
 
328
      API_signals_exception_handler:=Signals_exception_handler(
 
329
        @except^.ExceptionRecord,
 
330
        nil,
 
331
        @except^.ContextRecord,
 
332
        nil);
 
333
    end;
 
334
 
 
335
 
 
336
const
 
337
  PreviousHandler : LPTOP_LEVEL_EXCEPTION_FILTER = nil;
 
338
  Prev_Handler : pointer = nil;
 
339
  Prev_fpc_handler : pointer = nil;
 
340
 
253
341
  procedure install_exception_handler;
254
342
{$ifdef SYSTEMEXCEPTIONDEBUG}
255
343
    var
256
344
      oldexceptaddr,newexceptaddr : longint;
257
345
{$endif SYSTEMEXCEPTIONDEBUG}
258
346
    begin
 
347
      if Exception_handler_installed then
 
348
        exit;
 
349
      if assigned(System_exception_frame) then
 
350
        begin
 
351
          prev_fpc_handler:=System_exception_frame^.handler;
 
352
          System_exception_frame^.handler:=@Signals_exception_handler;
 
353
          { get the handler in front again }
 
354
          asm
 
355
            movl  %fs:(0),%eax
 
356
            movl  %eax,prev_handler
 
357
            movl  System_exception_frame,%eax
 
358
            movl  %eax,%fs:(0)
 
359
          end;
 
360
          Exception_handler_installed:=true;
 
361
          exit;
 
362
        end;
259
363
{$ifdef SYSTEMEXCEPTIONDEBUG}
260
364
      asm
261
365
        movl $0,%eax
263
367
        movl %eax,oldexceptaddr
264
368
      end;
265
369
{$endif SYSTEMEXCEPTIONDEBUG}
266
 
      SetUnhandledExceptionFilter(@Signals_exception_handler);
 
370
      PreviousHandler:=SetUnhandledExceptionFilter(@API_signals_exception_handler);
267
371
{$ifdef SYSTEMEXCEPTIONDEBUG}
268
372
      asm
269
373
        movl $0,%eax
271
375
        movl %eax,newexceptaddr
272
376
      end;
273
377
      if IsConsole then
274
 
        writeln(stderr,'Old exception  ',hexstr(oldexceptaddr,8),
275
 
          ' new exception  ',hexstr(newexceptaddr,8));
 
378
        begin
 
379
          writeln(stderr,'Old exception  ',hexstr(oldexceptaddr,8),
 
380
            ' new exception  ',hexstr(newexceptaddr,8));
 
381
          writeln('SetUnhandledExceptionFilter returned ',hexstr(longint(PreviousHandler),8));
 
382
        end;
276
383
{$endif SYSTEMEXCEPTIONDEBUG}
 
384
      Exception_handler_installed := true;
277
385
    end;
278
386
 
279
387
  procedure remove_exception_handler;
280
388
    begin
281
 
      SetUnhandledExceptionFilter(nil);
 
389
      if not Exception_handler_installed then
 
390
        exit;
 
391
      if assigned(System_exception_frame) then
 
392
        begin
 
393
          if assigned(prev_fpc_handler) then
 
394
            System_exception_frame^.handler:=prev_fpc_handler;
 
395
          prev_fpc_handler:=nil;
 
396
          { restore old handler order again }
 
397
          if assigned(prev_handler) then
 
398
            asm
 
399
            movl  prev_handler,%eax
 
400
            movl  %eax,%fs:(0)
 
401
            end;
 
402
          prev_handler:=nil;
 
403
          Exception_handler_installed:=false;
 
404
          exit;
 
405
        end;
 
406
      SetUnhandledExceptionFilter(PreviousHandler);
 
407
      PreviousHandler:=nil;
 
408
      Exception_handler_installed:=false;
282
409
    end;
283
410
 
284
411
 
285
 
function SIG_ERR(x:longint):longint;
 
412
function SIG_ERR(x:longint):longint; cdecl;
286
413
begin
287
414
  SIG_ERR:=-1;
288
415
end;
289
416
 
290
417
 
291
 
function SIG_IGN(x:longint):longint;
 
418
function SIG_IGN(x:longint):longint; cdecl;
292
419
begin
293
420
  SIG_IGN:=-1;
294
421
end;
295
422
 
296
423
 
297
 
function SIG_DFL(x:longint):longint;
 
424
function SIG_DFL(x:longint):longint; cdecl;
298
425
begin
299
426
  SIG_DFL:=0;
300
427
end;
308
435
     signal:=@SIG_ERR;
309
436
     runerror(201);
310
437
   end;
 
438
  if not Exception_handler_installed then
 
439
    install_exception_handler;
311
440
  temp := signal_list[sig];
312
441
  signal_list[sig] := func;
313
442
  signal:=temp;
318
447
  i : longint;
319
448
initialization
320
449
 
321
 
{$ifdef i386}
322
450
  asm
323
451
    xorl %eax,%eax
324
452
    movw %ss,%ax
325
453
    movl %eax,_SS
326
454
  end;
327
 
{$endif i386}
328
455
 
329
456
  for i:=SIGABRT to SIGMAX do
330
457
    signal_list[i]:=@SIG_DFL;
331
 
  install_exception_handler;
 
458
 
 
459
  {install_exception_handler;
 
460
   delay this to first use
 
461
  as other units also might install their handlers PM }
332
462
 
333
463
finalization
334
464
 
335
465
  remove_exception_handler;
336
 
end.
 
 
b'\\ No newline at end of file'
 
466
end.