paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 16:19:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

* *errorproc are not procvars instead of pointers which allows better

Browse Source 
error checking for the parameters (shortstring<->ansistring)
This commit is contained in:
peter 1999-10-26 12:31:00 +00:00
parent 503d5a1cfa
commit 6eafc25151
2 changed files with 31 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/inc/system.inc
View File

@ -410,7 +410,7 @@ var
begin begin
addr:=get_caller_addr(frame); addr:=get_caller_addr(frame);
If ErrorProc<>Nil then If ErrorProc<>Nil then
TErrorProc (ErrorProc)(Errno,pointer(addr)); ErrorProc(Errno,pointer(addr));
errorcode:=Errno; errorcode:=Errno;
exitcode:=Errno; exitcode:=Errno;
erroraddr:=pointer(addr); erroraddr:=pointer(addr);
@ -487,8 +487,9 @@ Begin
{ Show runtime error } { Show runtime error }
If erroraddr<>nil Then If erroraddr<>nil Then
Begin Begin
Writeln(stdout,'Run time error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8)); Writeln(stdout,'Runtime error ',Errorcode,' at 0x',hexstr(Longint(Erroraddr),8));
dump_stack(stdout,ErrorBase); dump_stack(stdout,ErrorBase);
Writeln(stdout,'');
End; End;
{ call system dependent exit code } { call system dependent exit code }
System_exit; System_exit;
@ -537,33 +538,30 @@ End;
*****************************************************************************} *****************************************************************************}
procedure AbstractError;[public,alias : 'FPC_ABSTRACTERROR']; procedure AbstractError;[public,alias : 'FPC_ABSTRACTERROR'];
Type
TAbstractErrorProc=Procedure;
begin begin
If AbstractErrorProc<>nil then If AbstractErrorProc<>nil then
TAbstractErrorProc(AbstractErrorProc); AbstractErrorProc();
HandleError(211); HandleError(211);
end; end;
Procedure int_assert(Const Msg,FName:string;LineNo,ErrorAddr:Longint); [{$ifdef HASSAVEREGISTERS}SaveRegisters,{$endif}Public,Alias : 'FPC_ASSERT']; Procedure int_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); [{$ifdef HASSAVEREGISTERS}SaveRegisters,{$endif}Public,Alias : 'FPC_ASSERT'];
type
TAssertErrorProc=procedure(const msg,fname:string;lineno,erroraddr:longint);
begin begin
if AssertErrorProc<>nil then if AssertErrorProc<>nil then
TAssertErrorProc(AssertErrorProc)(Msg,FName,LineNo,ErrorAddr) AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
else else
HandleError(227); HandleError(227);
end; end;
Procedure SysAssert(Const Msg,FName:string;LineNo,ErrorAddr:Longint); Procedure SysAssert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint);
begin begin
If msg='' then If msg='' then
write(stderr,'Assertion failed') write(stderr,'Assertion failed')
else else
write(stderr,msg); write(stderr,msg);
writeln(stderr,' (',FName,', line ',LineNo,').'); Writeln(stderr,' (',FName,', line ',LineNo,').');
Writeln(stderr,'');
end; end;
@ -582,7 +580,11 @@ end;
{ {
$Log$ $Log$
Revision 1.67 1999-09-18 16:05:12 jonas Revision 1.68 1999-10-26 12:31:00 peter
* *errorproc are not procvars instead of pointers which allows better
error checking for the parameters (shortstring<->ansistring)
Revision 1.67 1999/09/18 16:05:12 jonas
* dump_stack now actually dumps its info to f (was still hardcoded * dump_stack now actually dumps its info to f (was still hardcoded
to stderr) to stderr)

26
rtl/inc/systemh.inc
View File

@ -125,9 +125,6 @@ const
Filemode : byte = 2; Filemode : byte = 2;
CmdLine : PChar = nil; CmdLine : PChar = nil;
Type
TErrorProc = Procedure (ErrNo : Longint; Address : Pointer);
var var
{ Standard In- and Output } { Standard In- and Output }
Output, Output,
@ -139,8 +136,7 @@ var
StackBottom, StackBottom,
LowestStack, LowestStack,
RandSeed : Cardinal; RandSeed : Cardinal;
{ Error handlers }
ErrorProc : Pointer;
{**************************************************************************** {****************************************************************************
Processor specific routines Processor specific routines
@ -369,15 +365,21 @@ Procedure halt;
{***************************************************************************** {*****************************************************************************
Abstract/Assert Abstract/Assert/Error Handling
*****************************************************************************} *****************************************************************************}
procedure AbstractError; procedure AbstractError;
Procedure SysAssert(Const Msg,FName:string;LineNo,ErrorAddr:Longint); Procedure SysAssert(Const Msg,FName:ShortString;LineNo,ErrorAddr:Longint);
{ Error handlers }
Type
TErrorProc = Procedure (ErrNo : Longint; Address : Pointer);
TAbstractErrorProc = Procedure;
TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno,erroraddr:longint);
const const
AssertErrorProc : Pointer=@SysAssert; ErrorProc : TErrorProc = nil;
AbstractErrorProc : Pointer=nil; AbstractErrorProc : TAbstractErrorProc = nil;
AssertErrorProc : TAssertErrorProc = @SysAssert;
{***************************************************************************** {*****************************************************************************
@ -395,7 +397,11 @@ const
{ {
$Log$ $Log$
Revision 1.62 1999-08-19 11:16:13 peter Revision 1.63 1999-10-26 12:31:00 peter
* *errorproc are not procvars instead of pointers which allows better
error checking for the parameters (shortstring<->ansistring)
Revision 1.62 1999/08/19 11:16:13 peter
* settextbuf size is now longint * settextbuf size is now longint
Revision 1.61 1999/07/05 20:04:28 peter Revision 1.61 1999/07/05 20:04:28 peter