mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-02 00:10:31 +02:00
* always use exceptions to stop the compiler
- remove stop, do_stop
This commit is contained in:
peter
parent
d8ca878d72
commit
9843416e70
@ -27,6 +27,7 @@ unit comphook;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
finput;
|
||||
|
||||
Const
|
||||
@ -96,8 +97,18 @@ type
|
||||
var
|
||||
status : tcompilerstatus;
|
||||
|
||||
type
|
||||
EControlCAbort=class(Exception)
|
||||
constructor Create;
|
||||
end;
|
||||
ECompilerAbort=class(Exception)
|
||||
constructor Create;
|
||||
end;
|
||||
ECompilerAbortSilent=class(Exception)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
{ Default Functions }
|
||||
procedure def_stop(err:longint);
|
||||
Function def_status:boolean;
|
||||
Function def_comment(Level:Longint;const s:string):boolean;
|
||||
function def_internalerror(i:longint):boolean;
|
||||
@ -106,13 +117,6 @@ procedure def_donesymbolinfo;
|
||||
procedure def_extractsymbolinfo;
|
||||
function def_openinputfile(const filename: string): tinputfile;
|
||||
Function def_getnamedfiletime(Const F : String) : Longint;
|
||||
{$ifdef DEBUG}
|
||||
{ allow easy stopping in GDB
|
||||
using
|
||||
b DEF_GDB_STOP
|
||||
cond 1 LEVEL <= 8 }
|
||||
procedure def_gdb_stop(level : longint);
|
||||
{$endif DEBUG}
|
||||
{ Function redirecting for IDE support }
|
||||
type
|
||||
tstopprocedure = procedure(err:longint);
|
||||
@ -127,7 +131,6 @@ type
|
||||
tgetnamedfiletimefunc = function(const filename: string): longint;
|
||||
|
||||
const
|
||||
do_stop : tstopprocedure = @def_stop;
|
||||
do_status : tstatusfunction = @def_status;
|
||||
do_comment : tcommentfunction = @def_comment;
|
||||
do_internalerror : tinternalerrorfunction = @def_internalerror;
|
||||
@ -181,26 +184,42 @@ end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Predefined default Handlers
|
||||
Stopping the compiler
|
||||
****************************************************************************}
|
||||
|
||||
{ predefined handler when then compiler stops }
|
||||
procedure def_stop(err:longint);
|
||||
begin
|
||||
Halt(err);
|
||||
end;
|
||||
constructor EControlCAbort.Create;
|
||||
begin
|
||||
{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
|
||||
inherited Create('Ctrl-C Signaled!');
|
||||
{$ELSE}
|
||||
inherited Create;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$ifdef DEBUG}
|
||||
{ allow easy stopping in GDB
|
||||
using
|
||||
b DEF_GDB_STOP
|
||||
cond 1 LEVEL <= 8 }
|
||||
procedure def_gdb_stop(level : longint);
|
||||
begin
|
||||
{ Its only a dummy for GDB }
|
||||
end;
|
||||
{$endif DEBUG}
|
||||
|
||||
constructor ECompilerAbort.Create;
|
||||
begin
|
||||
{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
|
||||
inherited Create('Compilation Aborted');
|
||||
{$ELSE}
|
||||
inherited Create;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
constructor ECompilerAbortSilent.Create;
|
||||
begin
|
||||
{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
|
||||
inherited Create('Compilation Aborted');
|
||||
{$ELSE}
|
||||
inherited Create;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Predefined default Handlers
|
||||
****************************************************************************}
|
||||
|
||||
function def_status:boolean;
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
@ -336,10 +355,6 @@ begin
|
||||
Writeln(status.reportbugfile,hs);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$ifdef DEBUG}
|
||||
def_gdb_stop(level);
|
||||
{$endif DEBUG}
|
||||
end;
|
||||
|
||||
|
||||
@ -398,7 +413,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.37 2005-02-28 15:38:38 marco
|
||||
Revision 1.38 2005-04-24 21:01:37 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.37 2005/02/28 15:38:38 marco
|
||||
* getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
|
||||
|
||||
Revision 1.36 2005/02/14 17:13:06 peter
|
||||
|
||||
@ -251,7 +251,6 @@ uses
|
||||
var
|
||||
CompilerInitedAfterArgs,
|
||||
CompilerInited : boolean;
|
||||
olddo_stop : tstopprocedure;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
@ -322,12 +321,6 @@ begin
|
||||
CompilerInitedAfterArgs:=true;
|
||||
end;
|
||||
|
||||
procedure minimal_stop(err:longint);
|
||||
begin
|
||||
DoneCompiler;
|
||||
olddo_stop(err);
|
||||
end;
|
||||
|
||||
|
||||
function Compile(const cmd:string):longint;
|
||||
|
||||
@ -417,8 +410,18 @@ begin
|
||||
Message(general_e_compilation_aborted);
|
||||
DoneVerbose;
|
||||
end;
|
||||
on ECompilerAbort do
|
||||
begin
|
||||
Message(general_e_compilation_aborted);
|
||||
DoneVerbose;
|
||||
end;
|
||||
on ECompilerAbortSilent do
|
||||
begin
|
||||
DoneVerbose;
|
||||
end;
|
||||
on Exception do
|
||||
begin
|
||||
{ General catchall, normally not used }
|
||||
Message(general_e_compilation_aborted);
|
||||
DoneVerbose;
|
||||
Raise;
|
||||
@ -443,7 +446,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.59 2005-03-25 21:55:43 jonas
|
||||
Revision 1.60 2005-04-24 21:01:37 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.59 2005/03/25 21:55:43 jonas
|
||||
* removed some unused variables
|
||||
|
||||
Revision 1.58 2005/02/28 15:38:38 marco
|
||||
|
||||
@ -78,6 +78,7 @@ uses
|
||||
{$ENDIF USE_SYSUTILS}
|
||||
version,
|
||||
cutils,cmsgs,
|
||||
comphook,
|
||||
symtable
|
||||
{$ifdef BrowserLog}
|
||||
,browlog
|
||||
@ -137,8 +138,7 @@ begin
|
||||
Option.free;
|
||||
Option:=nil;
|
||||
end;
|
||||
DoneVerbose;
|
||||
Stop(err);
|
||||
raise ECompilerAbortSilent.Create;
|
||||
end;
|
||||
|
||||
|
||||
@ -1920,7 +1920,7 @@ begin
|
||||
{ Write logo }
|
||||
if option.ParaLogo then
|
||||
option.writelogo;
|
||||
|
||||
|
||||
{ Non-core target defines }
|
||||
Option.TargetDefines(true);
|
||||
|
||||
@ -2114,7 +2114,11 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.172 2005-04-15 15:43:54 peter
|
||||
Revision 1.173 2005-04-24 21:01:37 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.172 2005/04/15 15:43:54 peter
|
||||
* -Fe on commandline redirects now all output
|
||||
|
||||
Revision 1.171 2005/03/20 22:36:45 olle
|
||||
|
||||
@ -186,9 +186,9 @@ function aout_sym(const name:string;typ,other:byte;desc:word;
|
||||
|
||||
begin
|
||||
if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
|
||||
Do_Stop($da);
|
||||
internalerror(200504241);
|
||||
if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
|
||||
Do_Stop($da);
|
||||
internalerror(200504242);
|
||||
aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
|
||||
aout_sym_tab[aout_sym_count].typ:=typ;
|
||||
aout_sym_tab[aout_sym_count].other:=other;
|
||||
@ -204,7 +204,7 @@ procedure aout_text_byte(b:byte);
|
||||
|
||||
begin
|
||||
if aout_text_size>=sizeof(aout_text) then
|
||||
Do_Stop($da);
|
||||
internalerror(200504243);
|
||||
aout_text[aout_text_size]:=b;
|
||||
inc(aout_text_size);
|
||||
end;
|
||||
@ -224,7 +224,7 @@ procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
|
||||
|
||||
begin
|
||||
if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
|
||||
Do_Stop($da);
|
||||
internalerror(200504244);
|
||||
aout_treloc_tab[aout_treloc_count].address:=address;
|
||||
aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
|
||||
len shl 25+ext shl 27;
|
||||
@ -517,7 +517,11 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 2005-02-14 17:13:10 peter
|
||||
Revision 1.16 2005-04-24 21:02:10 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.15 2005/02/14 17:13:10 peter
|
||||
* truncate log
|
||||
|
||||
}
|
||||
|
||||
@ -186,9 +186,9 @@ function aout_sym(const name:string;typ,other:byte;desc:word;
|
||||
|
||||
begin
|
||||
if aout_str_size+length(name)+1>sizeof(aout_str_tab) then
|
||||
Stop($da);
|
||||
internalerror(200504245);
|
||||
if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
|
||||
Stop($da);
|
||||
internalerror(200504246);
|
||||
aout_sym_tab[aout_sym_count].strofs:=aout_str_size;
|
||||
aout_sym_tab[aout_sym_count].typ:=typ;
|
||||
aout_sym_tab[aout_sym_count].other:=other;
|
||||
@ -204,7 +204,7 @@ procedure aout_text_byte(b:byte);
|
||||
|
||||
begin
|
||||
if aout_text_size>=sizeof(aout_text) then
|
||||
Stop($da);
|
||||
internalerror(200504247);
|
||||
aout_text[aout_text_size]:=b;
|
||||
inc(aout_text_size);
|
||||
end;
|
||||
@ -224,7 +224,7 @@ procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint);
|
||||
|
||||
begin
|
||||
if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then
|
||||
Stop($da);
|
||||
internalerror(200504248);
|
||||
aout_treloc_tab[aout_treloc_count].address:=address;
|
||||
aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+
|
||||
len shl 25+ext shl 27;
|
||||
@ -517,7 +517,11 @@ initialization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 2005-02-14 17:13:10 peter
|
||||
Revision 1.21 2005-04-24 21:02:10 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.20 2005/02/14 17:13:10 peter
|
||||
* truncate log
|
||||
|
||||
}
|
||||
|
||||
@ -70,18 +70,12 @@ interface
|
||||
const
|
||||
msgfilename : string = '';
|
||||
|
||||
type
|
||||
EControlCAbort=class(Exception)
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
procedure SetRedirectFile(const fn:string);
|
||||
function SetVerbosity(const s:string):boolean;
|
||||
procedure PrepareReport;
|
||||
|
||||
function CheckVerbosity(v:longint):boolean;
|
||||
procedure SetCompileModule(p:tmodulebase);
|
||||
procedure Stop(err:longint);
|
||||
procedure ShowStatus;
|
||||
function ErrorCount:longint;
|
||||
procedure SetErrorFlags(const s:string);
|
||||
@ -124,20 +118,6 @@ var
|
||||
compiling_module : tmodulebase;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Control-C Exception
|
||||
****************************************************************************}
|
||||
|
||||
constructor EControlCAbort.Create;
|
||||
begin
|
||||
{$IFNDEF MACOS_USE_FAKE_SYSUTILS}
|
||||
inherited Create('Ctrl-C Signaled!');
|
||||
{$ELSE}
|
||||
inherited Create;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Extra Handlers for default compiler
|
||||
****************************************************************************}
|
||||
@ -399,17 +379,11 @@ var
|
||||
end;
|
||||
|
||||
|
||||
procedure stop(err:longint);
|
||||
begin
|
||||
do_stop(err);
|
||||
end;
|
||||
|
||||
|
||||
procedure ShowStatus;
|
||||
begin
|
||||
UpdateStatus;
|
||||
if do_status() then
|
||||
stop(1);
|
||||
raise ECompilerAbort.Create;
|
||||
end;
|
||||
|
||||
|
||||
@ -468,7 +442,7 @@ var
|
||||
UpdateStatus;
|
||||
do_internalerror(i);
|
||||
inc(status.errorcount);
|
||||
stop(1);
|
||||
raise ECompilerAbort.Create;
|
||||
end;
|
||||
|
||||
|
||||
@ -493,12 +467,12 @@ var
|
||||
DefaultReplacements(s);
|
||||
{ show comment }
|
||||
if do_comment(l,s) or dostop then
|
||||
stop(1);
|
||||
raise ECompilerAbort.Create;
|
||||
if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
|
||||
begin
|
||||
Message1(unit_f_errors_in_unit,tostr(status.errorcount));
|
||||
status.skip_error:=true;
|
||||
stop(1);
|
||||
raise ECompilerAbort.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -584,12 +558,12 @@ var
|
||||
DefaultReplacements(s);
|
||||
{ show comment }
|
||||
if do_comment(v,s) or dostop then
|
||||
stop(1);
|
||||
raise ECompilerAbort.Create;
|
||||
if (status.errorcount>=status.maxerrorcount) and not status.skip_error then
|
||||
begin
|
||||
Message1(unit_f_errors_in_unit,tostr(status.errorcount));
|
||||
status.skip_error:=true;
|
||||
stop(1);
|
||||
raise ECompilerAbort.Create;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -900,7 +874,11 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.40 2005-02-16 22:39:25 olle
|
||||
Revision 1.41 2005-04-24 21:01:37 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.40 2005/02/16 22:39:25 olle
|
||||
* made macos compile
|
||||
|
||||
Revision 1.39 2005/02/15 19:15:45 peter
|
||||
|
||||
105
ide/fpcompil.pas
105
ide/fpcompil.pas
@ -28,6 +28,9 @@ interface
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
{ We need to include the exceptions from SysUtils, but the types from
|
||||
Objects need to be used. Keep the order SysUtils,Objects }
|
||||
SysUtils,
|
||||
Objects,
|
||||
FInput,
|
||||
Drivers,Views,Dialogs,
|
||||
@ -662,19 +665,6 @@ begin
|
||||
CompilerStatus:=false;
|
||||
end;
|
||||
|
||||
const
|
||||
LONGJMPCALLED = -1;
|
||||
|
||||
procedure CompilerStop(err: longint); {$ifndef FPC}far;{$endif}
|
||||
begin
|
||||
{ $ifdef HasSignal}
|
||||
if StopJmpValid then
|
||||
Longjmp(StopJmp,LONGJMPCALLED)
|
||||
else
|
||||
Halt(err);
|
||||
{ $endif}
|
||||
end;
|
||||
|
||||
Function CompilerGetNamedFileTime(const filename : string) : Longint; {$ifndef FPC}far;{$endif}
|
||||
var t: longint;
|
||||
W: PSourceWindow;
|
||||
@ -723,11 +713,6 @@ begin
|
||||
{ update info messages }
|
||||
if assigned(CompilerStatusDialog) then
|
||||
CompilerStatusDialog^.Update;
|
||||
{$ifdef DEBUG}
|
||||
{$ifndef NODEBUG}
|
||||
// def_gdb_stop(level);
|
||||
{$endif}
|
||||
{$endif DEBUG}
|
||||
{$ifdef redircompiler}
|
||||
RedirEnableAll;
|
||||
{$endif}
|
||||
@ -822,10 +807,7 @@ var
|
||||
s,FileName: string;
|
||||
ErrFile : Text;
|
||||
MustRestartDebugger,
|
||||
StoreStopJumpValid : boolean;
|
||||
StoreStopJmp : Jmp_buf;
|
||||
StoreExitProc : pointer;
|
||||
JmpRet,Error,LinkErrorCount : longint;
|
||||
Error,LinkErrorCount : longint;
|
||||
E : TEvent;
|
||||
DummyView: PView;
|
||||
PPasFile : string[64];
|
||||
@ -884,7 +866,6 @@ begin
|
||||
EatIO;
|
||||
{ hook compiler output }
|
||||
do_status:=@CompilerStatus;
|
||||
do_stop:=@CompilerStop;
|
||||
do_comment:=@CompilerComment;
|
||||
do_openinputfile:=@CompilerOpenInputFile;
|
||||
do_getnamedfiletime:=@CompilerGetNamedFileTime;
|
||||
@ -907,61 +888,27 @@ begin
|
||||
PPasFile:='ppas'+source_info.scriptext;
|
||||
WUtils.DeleteFile(GetExePath+PpasFile);
|
||||
SetStatus('Compiling...');
|
||||
{ $ifdef HasSignal}
|
||||
StoreStopJumpValid:=StopJmpValid;
|
||||
StoreStopJmp:=StopJmp;
|
||||
{ $endif HasSignal}
|
||||
StoreExitProc:=ExitProc;
|
||||
{ $ifdef HasSignal}
|
||||
StopJmpValid:=true;
|
||||
JmpRet:=SetJmp(StopJmp);
|
||||
{ $else
|
||||
JmpRet:=0;
|
||||
$endif HasSignal}
|
||||
if JmpRet=0 then
|
||||
inc(CompileStamp);
|
||||
ResetErrorMessages;
|
||||
{$ifndef NODEBUG}
|
||||
MustRestartDebugger:=false;
|
||||
if assigned(Debugger) then
|
||||
if Debugger^.HasExe then
|
||||
begin
|
||||
inc(CompileStamp);
|
||||
ResetErrorMessages;
|
||||
{$ifndef NODEBUG}
|
||||
MustRestartDebugger:=false;
|
||||
if assigned(Debugger) then
|
||||
if Debugger^.HasExe then
|
||||
begin
|
||||
Debugger^.Reset;
|
||||
MustRestartDebugger:=true;
|
||||
end;
|
||||
{$endif NODEBUG}
|
||||
FpIntF.Compile(FileName,SwitchesPath);
|
||||
SetStatus('Finished compiling...');
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ We need to restore Exitproc to the value
|
||||
it was before calling FPintF.compile PM }
|
||||
ExitProc:=StoreExitProc;
|
||||
Inc(status.errorCount);
|
||||
{ $ifdef HasSignal}
|
||||
Case JmpRet of
|
||||
LONGJMPCALLED : s:='Error';
|
||||
SIGINT : s := 'Interrupted by Ctrl-C';
|
||||
SIGILL : s := 'Illegal instruction';
|
||||
SIGSEGV : s := 'Signal Segmentation violation';
|
||||
SIGFPE : s:='Floating point signal';
|
||||
else
|
||||
s:='Undetermined signal '+inttostr(JmpRet);
|
||||
end;
|
||||
CompilerMessageWindow^.AddMessage(V_error,s+' during compilation','',0,0);
|
||||
{ $endif HasSignal}
|
||||
if JmpRet<>LONGJMPCALLED then
|
||||
begin
|
||||
CompilerMessageWindow^.AddMessage(V_error,'Long jumped out of compilation...','',0,0);
|
||||
SetStatus('Long jumped out of compilation...');
|
||||
end;
|
||||
Debugger^.Reset;
|
||||
MustRestartDebugger:=true;
|
||||
end;
|
||||
{ $ifdef HasSignal}
|
||||
StopJmpValid:=StoreStopJumpValid;
|
||||
StopJmp:=StoreStopJmp;
|
||||
{ $endif HasSignal}
|
||||
{$endif NODEBUG}
|
||||
try
|
||||
FpIntF.Compile(FileName,SwitchesPath);
|
||||
except
|
||||
on ECompilerAbort do
|
||||
CompilerMessageWindow^.AddMessage(V_error,'Error during compilation','',0,0);
|
||||
on E:Exception do
|
||||
CompilerMessageWindow^.AddMessage(V_error,E.Message+' during compilation','',0,0);
|
||||
end;
|
||||
SetStatus('Finished compiling...');
|
||||
|
||||
{ Retrieve created exefile }
|
||||
If GetEXEPath<>'' then
|
||||
EXEFile:=FixFileName(GetEXEPath+NameOf(MainFile)+GetTargetExeExt)
|
||||
@ -1279,7 +1226,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 2005-04-02 23:56:54 hajny
|
||||
Revision 1.40 2005-04-24 21:03:16 peter
|
||||
* always use exceptions to stop the compiler
|
||||
- remove stop, do_stop
|
||||
|
||||
Revision 1.39 2005/04/02 23:56:54 hajny
|
||||
* fix for targets missing exception handler implementation
|
||||
|
||||
Revision 1.38 2005/03/06 13:48:59 florian
|
||||
|
||||
Loading…
Reference in New Issue
Block a user