paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 23:59:10 +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
addr:=get_caller_addr(frame);
If ErrorProc<>Nil then
TErrorProc (ErrorProc)(Errno,pointer(addr));
ErrorProc(Errno,pointer(addr));
errorcode:=Errno;
exitcode:=Errno;
erroraddr:=pointer(addr);
@ -487,8 +487,9 @@ Begin
{ Show runtime error }
If erroraddr<>nil Then
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);
Writeln(stdout,'');
End;
{ call system dependent exit code }
System_exit;
@ -537,33 +538,30 @@ End;
*****************************************************************************}
procedure AbstractError;[public,alias : 'FPC_ABSTRACTERROR'];
Type
TAbstractErrorProc=Procedure;
begin
If AbstractErrorProc<>nil then
TAbstractErrorProc(AbstractErrorProc);
AbstractErrorProc();
HandleError(211);
end;
Procedure int_assert(Const Msg,FName:string;LineNo,ErrorAddr:Longint); [{$ifdef HASSAVEREGISTERS}SaveRegisters,{$endif}Public,Alias : 'FPC_ASSERT'];
type
TAssertErrorProc=procedure(const msg,fname:string;lineno,erroraddr:longint);
Procedure int_assert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint); [{$ifdef HASSAVEREGISTERS}SaveRegisters,{$endif}Public,Alias : 'FPC_ASSERT'];
begin
if AssertErrorProc<>nil then
TAssertErrorProc(AssertErrorProc)(Msg,FName,LineNo,ErrorAddr)
AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
else
HandleError(227);
end;
Procedure SysAssert(Const Msg,FName:string;LineNo,ErrorAddr:Longint);
Procedure SysAssert(Const Msg,FName:Shortstring;LineNo,ErrorAddr:Longint);
begin
If msg='' then
write(stderr,'Assertion failed')
else
write(stderr,msg);
writeln(stderr,' (',FName,', line ',LineNo,').');
Writeln(stderr,' (',FName,', line ',LineNo,').');
Writeln(stderr,'');
end;
@ -582,7 +580,11 @@ end;
{
$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
to stderr)

26
rtl/inc/systemh.inc
View File

@ -125,9 +125,6 @@ const
Filemode : byte = 2;
CmdLine : PChar = nil;
Type
TErrorProc = Procedure (ErrNo : Longint; Address : Pointer);
var
{ Standard In- and Output }
Output,
@ -139,8 +136,7 @@ var
StackBottom,
LowestStack,
RandSeed : Cardinal;
{ Error handlers }
ErrorProc : Pointer;
{****************************************************************************
Processor specific routines
@ -369,15 +365,21 @@ Procedure halt;
{*****************************************************************************
Abstract/Assert
Abstract/Assert/Error Handling
*****************************************************************************}
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
AssertErrorProc : Pointer=@SysAssert;
AbstractErrorProc : Pointer=nil;
ErrorProc : TErrorProc = nil;
AbstractErrorProc : TAbstractErrorProc = nil;
AssertErrorProc : TAssertErrorProc = @SysAssert;
{*****************************************************************************
@ -395,7 +397,11 @@ const
{
$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
Revision 1.61 1999/07/05 20:04:28 peter