diff --git a/compiler/comphook.pas b/compiler/comphook.pas index 3ffc561b24..fe2e7a8518 100644 --- a/compiler/comphook.pas +++ b/compiler/comphook.pas @@ -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 diff --git a/compiler/compiler.pas b/compiler/compiler.pas index 480092e62a..894a3ac047 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -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 diff --git a/compiler/options.pas b/compiler/options.pas index d3bc384e22..6e9332bef2 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -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 diff --git a/compiler/systems/t_emx.pas b/compiler/systems/t_emx.pas index 4254313c98..5b5c4cfab7 100644 --- a/compiler/systems/t_emx.pas +++ b/compiler/systems/t_emx.pas @@ -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 } diff --git a/compiler/systems/t_os2.pas b/compiler/systems/t_os2.pas index 00a5beafd4..435b289a8f 100644 --- a/compiler/systems/t_os2.pas +++ b/compiler/systems/t_os2.pas @@ -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 } diff --git a/compiler/verbose.pas b/compiler/verbose.pas index 45ad6582e6..74df72bd71 100644 --- a/compiler/verbose.pas +++ b/compiler/verbose.pas @@ -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 diff --git a/ide/fpcompil.pas b/ide/fpcompil.pas index 5e1eca35bd..713e2bbb11 100644 --- a/ide/fpcompil.pas +++ b/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