* merged filesearch() fix

rtl/go32v2/dpmiexcp.pp

@@ -1262,7 +1262,7 @@ end;
 
 
 procedure djgpp_exception_setup;
-[alias : '___djgpp_exception_setup'];
+[public,alias : '___djgpp_exception_setup'];
 var
   temp_kbd,
   temp_npx    : pointer;
@@ -1495,7 +1495,10 @@ end;
 {$endif IN_SYSTEM}
 {
   $Log$
-  Revision 1.7  2001-11-24 14:42:19  carl
+  Revision 1.8  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+  Revision 1.7  2001/11/24 14:42:19  carl
   * completely moerged (except for smartlink option) from fixes branch
 
 

rtl/go32v2/sysutils.pp

@@ -429,12 +429,6 @@ begin
 end;
 
 
-Function FileSearch (Const Name, DirList : String) : String;
-begin
-  result := DOS.FSearch(Name, DirList);
-end;
-
-
 {****************************************************************************
                               Disk Functions
 ****************************************************************************}
@@ -714,7 +708,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.7  2002-01-19 11:57:55  peter
+  Revision 1.8  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+  Revision 1.7  2002/01/19 11:57:55  peter
     * merged fixes
 
   Revision 1.6  2001/10/25 21:23:49  peter

rtl/objpas/sysutils.inc

@@ -28,7 +28,36 @@
   { Read filename handling functions implementation }
   {$i fina.inc}
 
-  { Read String Handling functions implementation }
+    Function FileSearch (Const Name, DirList : String) : String;
+    Var
+      I : longint;
+      Temp : String;
+    begin
+      Result:='';
+      temp:=Dirlist;
+      repeat
+        While (Length(Temp)>0) and (Temp[1]=PathSeparator) do
+          Delete(Temp,1,1);
+        I:=pos(PathSep,Temp);
+        If I<>0 then
+          begin
+            Result:=Copy (Temp,1,i-1);
+            system.Delete(Temp,1,I);
+          end
+        else
+          begin
+            Result:=Temp;
+            Temp:='';
+          end;
+        If (Length(Result)>0) and (result[length(result)]<>DirectorySeparator) then
+          Result:=Result+DirectorySeparator;
+        Result:=Result+name;
+        If not FileExists(Result) Then
+         Result:='';
+      until (length(temp)=0) or (length(result)<>0);
+    end;
+
+      { Read String Handling functions implementation }
   {$i sysstr.inc}
 
   { Read date & Time function implementations }
@@ -330,7 +359,10 @@ end;
 
 {
   $Log$
-  Revision 1.7  2001-10-22 21:40:55  peter
+  Revision 1.8  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+  Revision 1.7  2001/10/22 21:40:55  peter
     * InterLocked routines added
 
   Revision 1.6  2001/08/19 21:02:02  florian
@@ -351,4 +383,4 @@ end;
   Revision 1.2  2000/08/20 15:46:46  peter
     * sysutils.pp moved to target and merged with disk.inc, filutil.inc
 
-}
+}

rtl/os2/sysutils.pp

@@ -684,12 +684,6 @@ end;
 end;
 
 
-function FileSearch (const Name, DirList: string): string;
-begin
-    Result := Dos.FSearch (Name, DirList);
-end;
-
-
 {****************************************************************************
                               Disk Functions
 ****************************************************************************}
@@ -950,7 +944,10 @@ end.
 
 {
   $Log$
-  Revision 1.14  2001-12-16 19:08:20  hajny
+  Revision 1.15  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+  Revision 1.14  2001/12/16 19:08:20  hajny
     * uses DosCalls replaced with direct declarations
 
   Revision 1.13  2001/10/25 21:23:49  peter
@@ -998,4 +995,4 @@ end.
   Revision 1.1.2.1  2000/08/20 15:08:32  peter
     * forgot the add command :(
 
-}
+}

rtl/unix/sysutils.pp

@@ -290,13 +290,6 @@ begin
 end;
 
 
-Function FileSearch (Const Name, DirList : String) : String;
-
-begin
-  FileSearch:=Unix.FSearch(Name,Dirlist);
-end;
-
-
 {****************************************************************************
                               Disk Functions
 ****************************************************************************}
@@ -473,7 +466,10 @@ end.
 {
 
   $Log$
-  Revision 1.11  2001-10-25 21:23:49  peter
+  Revision 1.12  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+  Revision 1.11  2001/10/25 21:23:49  peter
     * added 64bit fileseek
 
   Revision 1.10  2001/06/03 20:19:09  peter

rtl/win32/signals.pp

@@ -1,7 +1,12 @@
+{
+  $Id$
+}
 unit signals;
 
 interface
 
+{$PACKRECORDS C}
+
   { Signals }
   const
     SIGABRT   = 288;
@@ -112,7 +117,6 @@ interface
      end;
 
 
-
 implementation
 
 
@@ -169,20 +173,19 @@ var
   except_signal : array[0..Max_level-1] of longint;
   reset_fpu    : array[0..max_level-1] of boolean;
 
-
   procedure JumpToHandleSignal;
     var
-      res, eip, ebp, sigtype : longint;
+      res, eip, _ebp, sigtype : longint;
     begin
       asm
-        pushal
         movl (%ebp),%eax
-        movl %eax,ebp
+        movl %eax,_ebp
       end;
+      Writeln('In start of JumpToHandleSignal');
       if except_level>0 then
         dec(except_level)
       else
-        exit;
+        RunError(216);
       eip:=except_eip[except_level];
 
       sigtype:=except_signal[except_level];
@@ -191,6 +194,12 @@ var
           fninit
           fldcw   fpucw
         end;
+      if assigned(System_exception_frame) then
+        { get the handler in front again }
+        asm
+          movl  System_exception_frame,%eax
+          movl  %eax,%fs:(0)
+        end;
       if (sigtype>=SIGABRT) and (sigtype<=SIGMAX) and
          (signal_list[sigtype]<>@SIG_DFL) then
         begin
@@ -200,56 +209,68 @@ var
         res:=0;
 
       if res=0 then
-        RunError(sigtype)
+        Begin
+          Writeln('In JumpToHandleSignal');
+          RunError(sigtype);
+        end
       else
         { jump back to old code }
         asm
-          popal
           movl eip,%eax
-          movl %eax,4(%ebp)
+          push %eax
+          movl _ebp,%eax
+          push %eax
+          leave
           ret
         end;
     end;
 
 
 
-  function Signals_exception_handler(excep :PEXCEPTION_POINTERS) : longint;stdcall;
+  function Signals_exception_handler
+    (excep_exceptionrecord :PEXCEPTION_RECORD;
+     excep_frame : PEXCEPTION_FRAME;
+     excep_contextrecord : PCONTEXT;
+     dispatch : pointer) : longint;stdcall;
     var frame,res  : longint;
         function CallSignal(sigtype,frame : longint;must_reset_fpu : boolean) : longint;
           begin
-            if frame=0 then
-              CallSignal:=Exception_Continue_Search
-            else
+            writeln(stderr,'CallSignal called');
+            {if frame=0 then
+              begin
+                CallSignal:=1;
+                writeln(stderr,'CallSignal frame is zero');
+              end
+            else    }
               begin
                  if except_level >= Max_level then
                    exit;
-                 except_eip[except_level]:=excep^.ContextRecord^.Eip;
+                 except_eip[except_level]:=excep_ContextRecord^.Eip;
                  except_signal[except_level]:=sigtype;
                  reset_fpu[except_level]:=must_reset_fpu;
                  inc(except_level);
-                 dec(excep^.ContextRecord^.Esp,4);
-                 plongint (excep^.ContextRecord^.Esp)^ := excep^.ContextRecord^.Eip;
-                 excep^.ContextRecord^.Eip:=longint(@JumpToHandleSignal);
-                 CallSignal:=Exception_Continue_Execution;
-
+                 {dec(excep^.ContextRecord^.Esp,4);
+                 plongint (excep^.ContextRecord^.Esp)^ := longint(excep^.ContextRecord^.Eip);}
+                 excep_ContextRecord^.Eip:=longint(@JumpToHandleSignal);
+                 excep_ExceptionRecord^.ExceptionCode:=0;
+                 CallSignal:=0;
+                 writeln(stderr,'Exception_Continue_Execution  set');
               end;
           end;
 
     begin
-{$ifdef i386}
-       if excep^.ContextRecord^.SegSs=_SS then
-         frame:=excep^.ContextRecord^.Ebp
+       if excep_ContextRecord^.SegSs=_SS then
+         frame:=excep_ContextRecord^.Ebp
        else
-{$endif i386}
          frame:=0;
        { default : unhandled !}
-       res:=Exception_Continue_Search;
+       res:=1;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
        if IsConsole then
-         writeln(stderr,'Exception  ',
-           hexstr(excep^.ExceptionRecord^.ExceptionCode,8));
+         writeln(stderr,'Signals exception  ',
+           hexstr(excep_ExceptionRecord^.ExceptionCode,8));
 {$endif SYSTEMEXCEPTIONDEBUG}
-       case excep^.ExceptionRecord^.ExceptionCode of
+       case excep_ExceptionRecord^.ExceptionCode of
          EXCEPTION_ACCESS_VIOLATION :
            res:=CallSignal(SIGSEGV,frame,false);
          { EXCEPTION_BREAKPOINT = $80000003;
@@ -303,6 +324,21 @@ var
     end;
 
 
+    function API_signals_exception_handler(except : PEXCEPTION_POINTERS) : longint;
+    begin
+      API_signals_exception_handler:=Signals_exception_handler(
+        @except^.ExceptionRecord,
+        nil,
+        @except^.ContextRecord,
+        nil);
+    end;
+
+
+const
+  PreviousHandler : LPTOP_LEVEL_EXCEPTION_FILTER = nil;
+  Prev_Handler : pointer = nil;
+  Prev_fpc_handler : pointer = nil;
+
   procedure install_exception_handler;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
     var
@@ -311,6 +347,20 @@ var
     begin
       if Exception_handler_installed then
         exit;
+      if assigned(System_exception_frame) then
+        begin
+          prev_fpc_handler:=System_exception_frame^.handler;
+          System_exception_frame^.handler:=@Signals_exception_handler;
+          { get the handler in front again }
+          asm
+            movl  %fs:(0),%eax
+            movl  %eax,prev_handler
+            movl  System_exception_frame,%eax
+            movl  %eax,%fs:(0)
+          end;
+          Exception_handler_installed:=true;
+          exit;
+        end;
 {$ifdef SYSTEMEXCEPTIONDEBUG}
       asm
         movl $0,%eax
@@ -318,7 +368,7 @@ var
         movl %eax,oldexceptaddr
       end;
 {$endif SYSTEMEXCEPTIONDEBUG}
-      SetUnhandledExceptionFilter(@Signals_exception_handler);
+      PreviousHandler:=SetUnhandledExceptionFilter(@API_signals_exception_handler);
 {$ifdef SYSTEMEXCEPTIONDEBUG}
       asm
         movl $0,%eax
@@ -326,8 +376,11 @@ var
         movl %eax,newexceptaddr
       end;
       if IsConsole then
-        writeln(stderr,'Old exception  ',hexstr(oldexceptaddr,8),
-          ' new exception  ',hexstr(newexceptaddr,8));
+        begin
+          writeln(stderr,'Old exception  ',hexstr(oldexceptaddr,8),
+            ' new exception  ',hexstr(newexceptaddr,8));
+          writeln('SetUnhandledExceptionFilter returned ',hexstr(longint(PreviousHandler),8));
+        end;
 {$endif SYSTEMEXCEPTIONDEBUG}
       Exception_handler_installed := true;
     end;
@@ -336,7 +389,24 @@ var
     begin
       if not Exception_handler_installed then
         exit;
-      SetUnhandledExceptionFilter(nil);
+      if assigned(System_exception_frame) then
+        begin
+          if assigned(prev_fpc_handler) then
+            System_exception_frame^.handler:=prev_fpc_handler;
+          prev_fpc_handler:=nil;
+          { restore old handler order again }
+          if assigned(prev_handler) then
+            asm
+            movl  prev_handler,%eax
+            movl  %eax,%fs:(0)
+            end;
+          prev_handler:=nil;
+          Exception_handler_installed:=false;
+          exit;
+        end;
+      SetUnhandledExceptionFilter(PreviousHandler);
+      PreviousHandler:=nil;
+      Exception_handler_installed:=false;
     end;
 
 
@@ -378,22 +448,26 @@ var
   i : longint;
 initialization
 
-{$ifdef i386}
   asm
     xorl %eax,%eax
     movw %ss,%ax
     movl %eax,_SS
   end;
-{$endif i386}
 
   for i:=SIGABRT to SIGMAX do
     signal_list[i]:=@SIG_DFL;
 
-  { install_exception_handler;
-  delay this to first use
+  {install_exception_handler;
+   delay this to first use
   as other units also might install their handlers PM }
 
 finalization
 
   remove_exception_handler;
 end.
+{
+  $Log$
+  Revision 1.4  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+}

rtl/win32/system.pp

@@ -71,6 +71,7 @@ const
 
    { Thread count for DLL }
    Thread_count : longint = 0;
+   System_exception_frame : PEXCEPTION_FRAME =nil;
 
 type
   TStartupInfo=packed record
@@ -94,6 +95,12 @@ type
     hStdError : longint;
   end;
 
+  PEXCEPTION_FRAME = ^TEXCEPTION_FRAME;
+  TEXCEPTION_FRAME = record
+    next : PEXCEPTION_FRAME;
+    handler : pointer;
+  end;
+
 var
 { C compatible arguments }
   argc  : longint;
@@ -976,6 +983,15 @@ procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
      { This strange construction is needed to solve the _SS problem
        with a smartlinked syswin32 (PFV) }
      asm
+         { allocate space for an excption frame }
+        pushl $0
+        pushl %fs:(0)
+        { movl  %esp,%fs:(0)
+          but don't insert it as it doesn't
+          point to anything yet
+          this will be used in signals unit }
+        movl %esp,%eax
+        movl %eax,System_exception_frame
         pushl %ebp
         xorl %ebp,%ebp
         movl %esp,%eax
@@ -1567,7 +1583,10 @@ end.
 
 {
   $Log$
-  Revision 1.22  2001-12-02 17:21:25  peter
+  Revision 1.23  2002-01-25 16:23:03  peter
+    * merged filesearch() fix
+
+  Revision 1.22  2001/12/02 17:21:25  peter
     * merged fixes from 1.0
 
   Revision 1.21  2001/11/08 16:16:54  florian

rtl/win32/sysutils.pp

@@ -273,40 +273,6 @@ begin
 end;
 
 
-Function FileSearch (Const Name, DirList : String) : String;
-Var
-  I : longint;
-  Temp : String;
-begin
-  { check if the file specified exists }
-  If FileExists(Name) Then
-   begin
-     Result:=Name;
-     exit;
-   end;
-  Result:='';
-  temp:=Dirlist;
-  repeat
-    I:=pos(';',Temp);
-    If I<>0 then
-      begin
-        Result:=Copy (Temp,1,i-1);
-        system.Delete(Temp,1,I);
-      end
-    else
-      begin
-        Result:=Temp;
-        Temp:='';
-      end;
-    If (result<>'') and (result[length(result)]<>'\') then
-      Result:=Result+'\';
-    Result:=Result+name;
-    If not FileExists(Result) Then
-     Result:='';
-  until (Temp='') or (Result<>'');
-end;
-
-
 {****************************************************************************
                               Disk Functions
 ****************************************************************************}
@@ -686,7 +652,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.11  2001-12-11 23:10:18  carl
+  Revision 1.12  2002-01-25 16:23:04  peter
+    * merged filesearch() fix
+
+  Revision 1.11  2001/12/11 23:10:18  carl
   * Range check error fix
 
   Revision 1.10  2001/10/25 21:23:49  peter