paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 10:40:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* merged filesearch() fix

Browse Source
This commit is contained in:
peter 2002-01-25 16:23:03 +00:00
parent a45f4354e3
commit 24fdea1ad0
8 changed files with 186 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/go32v2/dpmiexcp.pp
View File

@ -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

11
rtl/go32v2/sysutils.pp
View File

@ -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

38
rtl/objpas/sysutils.inc
View File

@ -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
}
}

13
rtl/os2/sysutils.pp
View File

@ -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 :(
}
}

12
rtl/unix/sysutils.pp
View File

@ -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

144
rtl/win32/signals.pp
View File

@ -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
}

21
rtl/win32/system.pp
View File

@ -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

39
rtl/win32/sysutils.pp
View File

@ -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