catch.pas 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. {
  2. $Id$
  3. Copyright (c) 1997-98 by Michael Van Canneyt
  4. Unit to catch segmentation faults and Ctrl-C and exit gracefully
  5. under linux and go32v2
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  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. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. *********************************************************************
  18. }
  19. Unit catch;
  20. interface
  21. uses
  22. {$ifdef linux}
  23. {$define has_signal}
  24. linux,
  25. {$endif}
  26. {$ifdef go32v2}
  27. {$define has_signal}
  28. dpmiexcp,
  29. {$endif}
  30. verbose;
  31. {$ifdef has_signal}
  32. Var
  33. NewSignal,OldSigSegm,
  34. OldSigInt,OldSigFPE : SignalHandler;
  35. {$endif}
  36. Const in_const_evaluation : boolean = false;
  37. Implementation
  38. {$ifdef has_signal}
  39. {$ifdef linux}
  40. Procedure CatchSignal(Sig : Integer);cdecl;
  41. {$else}
  42. Function CatchSignal(Sig : longint):longint;
  43. {$endif}
  44. begin
  45. case Sig of
  46. SIGSEGV : begin
  47. { Temporary message - until we get an error number... }
  48. writeln ('Panic : Internal compiler error, exiting.');
  49. internalerror(9999);
  50. end;
  51. SIGFPE : begin
  52. If in_const_evaluation then
  53. Writeln('FPE error computing constant expression')
  54. else
  55. Writeln('FPE error inside compiler');
  56. Stop;
  57. end;
  58. SIGINT : begin
  59. WriteLn('Ctrl-C Signaled!');
  60. Stop;
  61. end;
  62. end;
  63. {$ifndef linux}
  64. CatchSignal:=0;
  65. {$endif}
  66. end;
  67. {$endif def has_signal}
  68. begin
  69. {$ifdef has_signal}
  70. {$ifndef TP}
  71. NewSignal:=SignalHandler(@CatchSignal);
  72. {$else TP}
  73. NewSignal:=SignalHandler(CatchSignal);
  74. {$endif TP}
  75. OldSigSegm:=Signal (SIGSEGV,NewSignal);
  76. OldSigInt:=Signal (SIGINT,NewSignal);
  77. OldSigFPE:=Signal (SIGFPE,NewSignal);
  78. {$endif}
  79. end.
  80. {
  81. $Log$
  82. Revision 1.6 1999-06-02 22:44:05 pierre
  83. * previous wrong log corrected
  84. Revision 1.5 1999/06/02 22:25:28 pierre
  85. * added SIGFPE
  86. Revision 1.4 1999/01/28 19:42:03 peter
  87. * mssing endif added
  88. Revision 1.3 1999/01/27 13:20:37 pierre
  89. * slightly rewritten code
  90. Revision 1.2 1998/09/08 13:01:09 michael
  91. Adapted to changed Signal call
  92. Revision 1.1.1.1 1998/03/25 11:18:12 root
  93. * Restored version
  94. Revision 1.5 1998/03/10 01:17:15 peter
  95. * all files have the same header
  96. * messages are fully implemented, EXTDEBUG uses Comment()
  97. + AG... files for the Assembler generation
  98. Revision 1.4 1998/03/02 01:48:07 peter
  99. * renamed target_DOS to target_GO32V1
  100. + new verbose system, merged old errors and verbose units into one new
  101. verbose.pas, so errors.pas is obsolete
  102. Revision 1.3 1998/02/13 10:34:37 daniel
  103. * Made Motorola version compilable.
  104. * Fixed optimizer
  105. Revision 1.2 1998/01/27 23:34:35 peter
  106. + SIGINT capture with exit. It works for linux and go32v2 (last one
  107. not 100% yet)
  108. Revision 1.1.1.1 1997/11/27 08:32:51 michael
  109. FPC Compiler CVS start
  110. }