* always use exceptions to stop the compiler

- remove stop, do_stop

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 }
+     constructor EControlCAbort.Create;
-procedure def_stop(err:longint);
        begin
-  Halt(err);
+{$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

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

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;
+  raise ECompilerAbortSilent.Create;
-  Stop(err);
 end;
 
 
@@ -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

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
 
 }

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
 
 }

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

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;
+  Error,LinkErrorCount : longint;
-  StoreStopJmp : Jmp_buf;
-  StoreExitProc : pointer;
-  JmpRet,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,19 +888,6 @@ 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
-    begin
   inc(CompileStamp);
   ResetErrorMessages;
   {$ifndef NODEBUG}
@@ -931,37 +899,16 @@ $endif HasSignal}
       MustRestartDebugger:=true;
     end;
   {$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...');
-    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;
-    end;
-{ $ifdef HasSignal}
-  StopJmpValid:=StoreStopJumpValid;
-  StopJmp:=StoreStopJmp;
-{ $endif HasSignal}
   { 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