From 6eafc25151f1491a7fe70e29fb53e40c38bc9d2d Mon Sep 17 00:00:00 2001
From: peter <peter@freepascal.org>
Date: Tue, 26 Oct 1999 12:31:00 +0000
Subject: [PATCH]   * *errorproc are not procvars instead of pointers which
 allows better     error checking for the parameters
 (shortstring<->ansistring)

---
 rtl/inc/system.inc  | 28 +++++++++++++++-------------
 rtl/inc/systemh.inc | 26 ++++++++++++++++----------
 2 files changed, 31 insertions(+), 23 deletions(-)

diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
index 49bab5f570..139894bc68 100644
--- a/rtl/inc/system.inc
+++ b/rtl/inc/system.inc
@@ -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);
+    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)
 
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index 17ebe455aa..5d53b51e1b 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -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