paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 12:09:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved StopJmp buffer to fpcatch unit

Browse Source
This commit is contained in:
pierre 2002-03-20 14:48:27 +00:00
parent 47b7e5c5b6
commit 9d5e55dddd
2 changed files with 53 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
ide/fpcatch.pas
View File

@ -47,6 +47,18 @@ Const
Procedure EnableCatchSignals; Procedure EnableCatchSignals;
Procedure DisableCatchSignals; Procedure DisableCatchSignals;
{$ifdef DEBUG}
procedure Generate_SIGSEGV;
procedure Generate_SIGFPE;
{$endif DEBUG}
{$ifndef GABOR}
var
StopJmp : Jmp_Buf;
const
StopJmpValid : boolean = false;
{$endif}
Implementation Implementation
uses uses
@ -65,6 +77,28 @@ uses
Const Const
LastCtrlC : longint = 0; LastCtrlC : longint = 0;
{$ifdef DEBUG}
procedure Generate_SIGSEGV;
var
l : plongint;
begin
{ Force a SIGSEGV }
l:=$ffffffff;
l^:=1;
end;
procedure Generate_SIGFPE;
var
x,y : real;
begin
{ Force a SIGFPE }
y:=-5;
x:=sqrt(y);
end;
{$endif DEBUG}
{$ifdef HasSignal} {$ifdef HasSignal}
{$ifdef Unix} {$ifdef Unix}
Procedure CatchSignal(Sig : Integer);cdecl; Procedure CatchSignal(Sig : Integer);cdecl;
@ -195,7 +229,10 @@ end.
{ {
$Log$ $Log$
Revision 1.3 2001-10-24 14:17:27 pierre Revision 1.4 2002-03-20 14:48:27 pierre
* moved StopJmp buffer to fpcatch unit
Revision 1.3 2001/10/24 14:17:27 pierre
* try to fix the Win2000 mouse problem * try to fix the Win2000 mouse problem
Revision 1.2 2001/08/05 02:01:47 peter Revision 1.2 2001/08/05 02:01:47 peter

24
ide/fpcompil.pas
View File

@ -125,12 +125,6 @@ procedure ParseUserScreen;
procedure RegisterFPCompile; procedure RegisterFPCompile;
{$ifndef GABOR}
var
StopJmp : Jmp_Buf;
const
StopJmpValid : boolean = false;
{$endif}
implementation implementation
@ -149,6 +143,9 @@ uses
{$ifdef win32} {$ifdef win32}
signals, signals,
{$endif} {$endif}
{$ifdef HasSignal}
fpcatch,
{$endif HasSignal}
Dos,Video, Dos,Video,
StdDlg,App,tokens, StdDlg,App,tokens,
{$ifdef FVISION} {$ifdef FVISION}
@ -824,7 +821,9 @@ procedure DoCompile(Mode: TCompileMode);
var var
s,FileName: string; s,FileName: string;
ErrFile : Text; ErrFile : Text;
MustRestartDebugger : boolean; MustRestartDebugger,
StoreStopJumpValid : boolean;
StoreStopJmp : Jmp_buf;
JmpRet,Error,LinkErrorCount : longint; JmpRet,Error,LinkErrorCount : longint;
E : TEvent; E : TEvent;
DummyView: PView; DummyView: PView;
@ -920,6 +919,8 @@ begin
WUtils.DeleteFile(GetExePath+PpasFile); WUtils.DeleteFile(GetExePath+PpasFile);
SetStatus('Compiling...'); SetStatus('Compiling...');
{$ifndef GABOR} {$ifndef GABOR}
StoreStopJumpValid:=StopJmpValid;
StoreStopJmp:=StopJmp;
StopJmpValid:=true; StopJmpValid:=true;
JmpRet:=SetJmp(StopJmp); JmpRet:=SetJmp(StopJmp);
if JmpRet=0 then if JmpRet=0 then
@ -956,7 +957,8 @@ begin
CompilerMessageWindow^.AddMessage(V_error,'Long jumped out of compilation...','',0,0); CompilerMessageWindow^.AddMessage(V_error,'Long jumped out of compilation...','',0,0);
SetStatus('Long jumped out of compilation...'); SetStatus('Long jumped out of compilation...');
end; end;
StopJmpValid:=false; StopJmpValid:=StoreStopJumpValid;
StopJmp:=StoreStopJmp;
{$endif} {$endif}
{ tokens are created and distroyed by compiler.compile !! PM } { tokens are created and distroyed by compiler.compile !! PM }
InitTokens; InitTokens;
@ -1238,6 +1240,7 @@ begin
begin begin
S^.Reset; S^.Reset;
Dispose(S, Done); Dispose(S, Done);
S:=nil;
OK:=true; OK:=true;
end; end;
fileclose:=OK; fileclose:=OK;
@ -1255,7 +1258,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.6 2001-11-13 01:58:34 carl Revision 1.7 2002-03-20 14:48:27 pierre
* moved StopJmp buffer to fpcatch unit
Revision 1.6 2001/11/13 01:58:34 carl
* Range check error fix * Range check error fix
Revision 1.5 2001/10/03 10:21:43 pierre Revision 1.5 2001/10/03 10:21:43 pierre