development/compilers/freepascal/compiler/catch.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Michael Van Canneyt
   4
   5     Unit to catch segmentation faults and Ctrl-C and exit gracefully
   6     under linux and go32v2
   7
   8     This program is free software; you can redistribute it and/or modify
   9     it under the terms of the GNU General Public License as published by
  10     the Free Software Foundation; either version 2 of the License, or
  11     (at your option) any later version.
  12
  13     This program is distributed in the hope that it will be useful,
  14     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16     GNU General Public License for more details.
  17
  18     You should have received a copy of the GNU General Public License
  19     along with this program; if not, write to the Free Software
  20     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22   *********************************************************************
  23 }
  24 Unit catch;
  25
  26 {$ifdef go32v2}
  27   { go32v2 stack check goes nuts if ss is not the data selector (PM) }
  28   {$S-}
  29 {$endif}
  30
  31
  32 {$ifdef DEBUG}
  33   {$define NOCATCH}
  34 {$endif DEBUG}
  35
  36
  37 interface
  38 uses
  39 {$ifdef linux}
  40 {$define has_signal}
  41   linux,
  42 {$endif}
  43 {$ifdef go32v2}
  44 {$define has_signal}
  45   dpmiexcp,
  46 {$endif}
  47   verbose;
  48
  49
  50 {$ifdef has_signal}
  51 Var
  52   NewSignal,OldSigSegm,
  53   OldSigInt,OldSigFPE : SignalHandler;
  54 {$endif}
  55
  56 Const in_const_evaluation : boolean = false;
  57
  58 Implementation
  59
  60 {$ifdef has_signal}
  61 {$ifdef linux}
  62 Procedure CatchSignal(Sig : Integer);cdecl;
  63 {$else}
  64 Function CatchSignal(Sig : longint):longint;
  65 {$endif}
  66 begin
  67   case Sig of
  68    SIGSEGV : begin
  69              { Temporary message - until we get an error number... }
  70                writeln ('Panic : Internal compiler error, exiting.');
  71                internalerror(9999);
  72              end;
  73     SIGFPE : begin
  74                If in_const_evaluation then
  75                  Writeln('FPE error computing constant expression')
  76                else
  77                  Writeln('FPE error inside compiler');
  78                Stop;
  79              end;
  80     SIGINT : begin
  81                WriteLn('Ctrl-C Signaled!');
  82                Stop;
  83              end;
  84   end;
  85 {$ifndef linux}
  86   CatchSignal:=0;
  87 {$endif}
  88 end;
  89 {$endif def has_signal}
  90
  91
  92 begin
  93 {$ifndef nocatch}
  94 {$ifdef has_signal}
  95 {$ifndef TP}
  96   NewSignal:=SignalHandler(@CatchSignal);
  97 {$else TP}
  98   NewSignal:=SignalHandler(CatchSignal);
  99 {$endif TP}
 100   OldSigSegm:=Signal (SIGSEGV,NewSignal);
 101   OldSigInt:=Signal (SIGINT,NewSignal);
 102   OldSigFPE:=Signal (SIGFPE,NewSignal);
 103 {$endif}
 104 {$endif nocatch}
 105 end.
 106
 107 {
 108   $Log$
 109   Revision 1.1  2002/02/19 08:21:30  sasu
 110   Initial revision
 111
 112   Revision 1.1.2.1  2000/09/10 16:12:20  marco
 113   removed don't catch define for BSD
 114
 115   Revision 1.1  2000/07/13 06:29:44  michael
 116   + Initial import
 117
 118   Revision 1.14  2000/04/07 20:52:24  marco
 119    * For BSD signals are off for now
 120
 121   Revision 1.13  2000/03/20 09:37:51  florian
 122     * catching of exceptions is switched off on all targets if the define
 123       DEBUG is used
 124
 125   Revision 1.12  2000/02/18 12:34:43  pierre
 126    DEBUG implies NOCATCH for go32v2
 127
 128   Revision 1.11  2000/02/09 13:22:45  peter
 129     * log truncated
 130
 131   Revision 1.10  2000/01/07 01:14:20  peter
 132     * updated copyright to 2000
 133
 134   Revision 1.9  1999/08/25 16:41:04  peter
 135     * resources are working again
 136
 137   Revision 1.8  1999/08/10 12:27:15  pierre
 138    * not stack check inside catch !!
 139
 140 }