mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-22 21:51:44 +02:00
+ Added support for ErrorProc variable. All internal functions are required
to call HandleError instead of runerror from now on. This is necessary for exception support.
This commit is contained in:
michael
parent
f86a9ccb28
commit
4e11459938
@ -181,7 +181,7 @@ __short_on_stack:
|
||||
popl %ebx
|
||||
popl %eax
|
||||
end['EAX','EBX'];
|
||||
RunError(202);
|
||||
HandleError(202);
|
||||
end;
|
||||
|
||||
|
||||
@ -489,13 +489,13 @@ end;
|
||||
|
||||
procedure syscopytodos(addr : longint; len : longint);
|
||||
begin
|
||||
if len > tb_size then runerror(217);
|
||||
if len > tb_size then HandleError(217);
|
||||
sysseg_move(get_ds,addr,dos_selector,tb,len);
|
||||
end;
|
||||
|
||||
procedure syscopyfromdos(addr : longint; len : longint);
|
||||
begin
|
||||
if len > tb_size then runerror(217);
|
||||
if len > tb_size then HandleError(217);
|
||||
sysseg_move(dos_selector,tb,get_ds,addr,len);
|
||||
end;
|
||||
|
||||
@ -627,7 +627,7 @@ begin
|
||||
AllowSlash(p1);
|
||||
AllowSlash(p2);
|
||||
if strlen(p1)+strlen(p2)+3>tb_size then
|
||||
RunError(217);
|
||||
HandleError(217);
|
||||
sysseg_move(get_ds,longint(p2),dos_selector,tb,strlen(p2)+1);
|
||||
sysseg_move(get_ds,longint(p1),dos_selector,tb+strlen(p2)+2,strlen(p1)+1);
|
||||
regs.realedi:=tb and 15;
|
||||
@ -1057,7 +1057,12 @@ Begin
|
||||
End.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1998-07-13 21:19:08 florian
|
||||
Revision 1.13 1998-07-30 13:26:22 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.12 1998/07/13 21:19:08 florian
|
||||
* some problems with ansi string support fixed
|
||||
|
||||
Revision 1.11 1998/07/07 12:33:08 carl
|
||||
|
||||
@ -192,7 +192,7 @@
|
||||
if (pp^.sig<>$DEADBEEF) and (pp^.sig <> $AAAAAAAA) then
|
||||
begin
|
||||
writeln('error in linked list of heap_mem_info');
|
||||
runerror(204);
|
||||
HandleError(204);
|
||||
end
|
||||
|
||||
if pp=p then
|
||||
@ -637,13 +637,13 @@
|
||||
if assigned(heaperror) then
|
||||
begin
|
||||
case call_heaperror(heaperror,size) of
|
||||
0 : runerror(203);
|
||||
0 : HandleError(203);
|
||||
1 : p:=nil;
|
||||
2 : nochmal:=true;
|
||||
end;
|
||||
end
|
||||
else
|
||||
runerror(203);
|
||||
HandleError(203);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -701,7 +701,7 @@ check_new:
|
||||
p:=p-sizeof(heap_mem_info);
|
||||
{ made after heap_switch
|
||||
if not (is_in_getmem_list(p)) then
|
||||
runerror(204); }
|
||||
HandleError(204); }
|
||||
end;
|
||||
{$endif CHECKHEAP}
|
||||
if size=0 then
|
||||
@ -738,7 +738,7 @@ check_new:
|
||||
begin
|
||||
writeln('pointer ',hexstr(longint(@p),8),' at ',
|
||||
hexstr(longint(p),8),' doesn''t points to the heap');
|
||||
runerror(204);
|
||||
HandleError(204);
|
||||
end;
|
||||
end;
|
||||
{$endif TEMPHEAP}
|
||||
@ -746,7 +746,7 @@ check_new:
|
||||
if trace then
|
||||
begin
|
||||
if not (is_in_getmem_list(p)) then
|
||||
runerror(204);
|
||||
HandleError(204);
|
||||
if pheap_mem_info(p)^.sig=$AAAAAAAA then
|
||||
dump_free(p);
|
||||
if pheap_mem_info(p)^.next<>nil then
|
||||
@ -823,7 +823,7 @@ check_new:
|
||||
writeln('pointer to dispose at ',hexstr(longint(p),8),
|
||||
' has already been disposed');
|
||||
{$endif CHECKHEAP}
|
||||
runerror(204);
|
||||
HandleError(204);
|
||||
end;
|
||||
{ connecting two blocks ? }
|
||||
if hp+hp^.size=p then
|
||||
@ -845,7 +845,7 @@ check_new:
|
||||
writeln('pointer to dispose at ',hexstr(longint(p),8),
|
||||
' is too big !!');
|
||||
{$endif CHECKHEAP}
|
||||
runerror(204);
|
||||
HandleError(204);
|
||||
end;
|
||||
break;
|
||||
end
|
||||
@ -1062,7 +1062,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-07-02 14:24:09 michael
|
||||
Revision 1.14 1998-07-30 13:26:21 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.13 1998/07/02 14:24:09 michael
|
||||
Undid carls changes, but renamed _heapsize to _internal_heapsize. Make cycle now works
|
||||
|
||||
Revision 1.11 1998/06/25 09:26:10 daniel
|
||||
|
||||
@ -272,8 +272,8 @@ asm
|
||||
popl %edi
|
||||
ret $4
|
||||
.Lco_re:
|
||||
pushw $210
|
||||
call runerror
|
||||
pushl $210
|
||||
call handleerror
|
||||
end;
|
||||
|
||||
|
||||
@ -523,35 +523,54 @@ asm
|
||||
end ['EAX'];
|
||||
|
||||
|
||||
Procedure HandleError (Errno : longint);[alias : 'handleerror'];
|
||||
{
|
||||
Procedure to handle internal errors, i.e. not user-invoked errors
|
||||
Internal function should ALWAYS call HandleError instead of RunError.
|
||||
}
|
||||
function get_addr : Pointer;assembler;
|
||||
asm
|
||||
movl (%ebp),%eax
|
||||
movl 4(%eax),%eax
|
||||
end;
|
||||
|
||||
function get_error_bp : Longint;assembler;
|
||||
asm
|
||||
movl (%ebp),%eax
|
||||
end;
|
||||
|
||||
begin
|
||||
If ErrorProc<>Nil then
|
||||
TErrorProc (ErrorProc)(Errno,get_addr);
|
||||
errorcode:=Errno;
|
||||
exitcode:=Errno;
|
||||
erroraddr:=Get_addr;
|
||||
DoError := TRUE;
|
||||
errorbase:=get_error_bp;
|
||||
halt(errorcode);
|
||||
end;
|
||||
|
||||
procedure runerror(w : word);[alias: 'runerror'];
|
||||
|
||||
function get_addr : longint;
|
||||
function get_addr : Pointer;assembler;
|
||||
asm
|
||||
movl (%ebp),%eax
|
||||
movl 4(%eax),%eax
|
||||
end;
|
||||
|
||||
begin
|
||||
asm
|
||||
movl (%ebp),%eax
|
||||
movl 4(%eax),%eax
|
||||
movl %eax,__RESULT
|
||||
end ['EAX'];
|
||||
end;
|
||||
function get_error_bp : Longint;assembler;
|
||||
asm
|
||||
movl (%ebp),%eax {%ebp of run_error}
|
||||
end;
|
||||
|
||||
function get_error_bp : longint;
|
||||
|
||||
begin
|
||||
asm
|
||||
movl (%ebp),%eax {%ebp of run_error}
|
||||
movl %eax,__RESULT
|
||||
end ['EAX'];
|
||||
end;
|
||||
|
||||
begin
|
||||
errorcode:=w;
|
||||
exitcode:=w;
|
||||
erroraddr:=pointer(get_addr);
|
||||
DoError := TRUE;
|
||||
errorbase:=get_error_bp;
|
||||
halt(errorcode);
|
||||
end;
|
||||
begin
|
||||
errorcode:=w;
|
||||
exitcode:=w;
|
||||
erroraddr:=pointer(get_addr);
|
||||
DoError := TRUE;
|
||||
errorbase:=get_error_bp;
|
||||
halt(errorcode);
|
||||
end;
|
||||
|
||||
procedure int_iocheck(addr : longint);[public,alias: 'IOCHECK'];
|
||||
var
|
||||
@ -565,12 +584,14 @@ begin
|
||||
l:=ioresult;
|
||||
if l<>0 then
|
||||
begin
|
||||
If ErrorProc<>Nil then
|
||||
TErrorProc(Errorproc)(l,pointer(addr));
|
||||
{$ifndef RTLLITE}
|
||||
writeln('IO-Error ',l,' at 0x',HexStr(addr,8));
|
||||
{$else}
|
||||
writeln('IO-Error ',l,' at ',addr);
|
||||
{$endif}
|
||||
halt(byte(l));
|
||||
Halt(byte(l));
|
||||
end;
|
||||
asm
|
||||
popal
|
||||
@ -587,12 +608,14 @@ begin
|
||||
movl 4(%ebp),%edi
|
||||
movl %edi,addr
|
||||
end;
|
||||
If ErrorProc<>Nil then
|
||||
TErrorProc (ErrorProc)(215,Pointer(Addr));
|
||||
{$ifndef RTLLITE}
|
||||
writeln('Overflow at 0x',HexStr(addr,8));
|
||||
{$else}
|
||||
writeln('Overflow at ',addr);
|
||||
{$endif}
|
||||
RunError(215);
|
||||
HandleError(215);
|
||||
end;
|
||||
|
||||
|
||||
@ -728,7 +751,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.16 1998-07-02 12:55:04 carl
|
||||
Revision 1.17 1998-07-30 13:26:20 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.16 1998/07/02 12:55:04 carl
|
||||
* Put back DoError, DO NOT TOUCH!
|
||||
|
||||
Revision 1.15 1998/07/02 12:19:32 carl
|
||||
|
||||
@ -25,6 +25,8 @@
|
||||
{$i filerec.inc}
|
||||
{$i textrec.inc}
|
||||
|
||||
Procedure HandleError (Errno : Longint); forward;
|
||||
|
||||
type
|
||||
FileFunc = Procedure(var t : TextRec);
|
||||
|
||||
@ -509,7 +511,7 @@ begin
|
||||
write (stderr,msg);
|
||||
writeln (stderr,'(File : ',name,', line ',LineNo,'.');
|
||||
flush (stderr);
|
||||
runerror (227);
|
||||
HandleError (227);
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
@ -527,7 +529,12 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.24 1998-07-28 20:37:45 michael
|
||||
Revision 1.25 1998-07-30 13:26:18 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.24 1998/07/28 20:37:45 michael
|
||||
+ added setjmp/longjmp and exception support
|
||||
|
||||
Revision 1.23 1998/07/23 19:53:20 michael
|
||||
|
||||
@ -93,6 +93,8 @@ const
|
||||
fmAppend = $D7B4;
|
||||
Filemode : byte = 2;
|
||||
|
||||
Type TErrorProc = Procedure (ErrNo : Longint; Address : Pointer);
|
||||
|
||||
var
|
||||
{ Standard In- and Output }
|
||||
Output,
|
||||
@ -104,6 +106,9 @@ var
|
||||
LowestStack,
|
||||
RandSeed : Longint;
|
||||
|
||||
Const
|
||||
ErrorProc : Pointer = nil;
|
||||
|
||||
{****************************************************************************
|
||||
Processor specific routines
|
||||
****************************************************************************}
|
||||
@ -405,7 +410,12 @@ Procedure halt;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 1998-07-28 20:37:47 michael
|
||||
Revision 1.21 1998-07-30 13:26:17 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.20 1998/07/28 20:37:47 michael
|
||||
+ added setjmp/longjmp and exception support
|
||||
|
||||
Revision 1.19 1998/07/20 23:36:57 michael
|
||||
|
||||
@ -60,7 +60,7 @@ Begin
|
||||
fmOutput : Flags:=$1101;
|
||||
fmAppend : Flags:=$1011;
|
||||
else
|
||||
RunError(102);
|
||||
HandleError(102);
|
||||
End;
|
||||
Do_Open(t,PChar(@t.Name),Flags);
|
||||
t.CloseFunc:=@FileCloseFunc;
|
||||
@ -957,7 +957,7 @@ Begin
|
||||
ReadNumeric(f,hs,Base);
|
||||
Val(hs,l,code);
|
||||
If code<>0 Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
End;
|
||||
|
||||
|
||||
@ -969,7 +969,7 @@ Begin
|
||||
If InOutRes <> 0 then exit;
|
||||
Read_Longint(f,ll);
|
||||
If (ll<-32768) or (ll>32767) Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
l:=ll;
|
||||
End;
|
||||
|
||||
@ -982,7 +982,7 @@ Begin
|
||||
If InOutRes <> 0 then exit;
|
||||
Read_Longint(f,ll);
|
||||
If (ll<0) or (ll>$ffff) Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
l:=ll;
|
||||
End;
|
||||
|
||||
@ -995,7 +995,7 @@ Begin
|
||||
If InOutRes <> 0 then exit;
|
||||
Read_Longint(f,ll);
|
||||
If (ll<0) or (ll>255) Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
l:=ll;
|
||||
End;
|
||||
|
||||
@ -1008,7 +1008,7 @@ Begin
|
||||
If InOutRes <> 0 then exit;
|
||||
Read_Longint(f,ll);
|
||||
If (ll<-128) or (ll>127) Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
l:=ll;
|
||||
End;
|
||||
|
||||
@ -1028,7 +1028,7 @@ Begin
|
||||
ReadNumeric(f,hs,Base);
|
||||
val(hs,l,code);
|
||||
If code<>0 Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
End;
|
||||
|
||||
|
||||
@ -1066,7 +1066,7 @@ Begin
|
||||
end;
|
||||
val(hs,d,code);
|
||||
If code<>0 Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
End;
|
||||
|
||||
|
||||
@ -1105,7 +1105,7 @@ Begin
|
||||
end;
|
||||
val(hs,d,code);
|
||||
If code<>0 Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
End;
|
||||
{$endif SUPPORT_EXTENDED}
|
||||
|
||||
@ -1145,7 +1145,7 @@ Begin
|
||||
end;
|
||||
val(hs,d,code);
|
||||
If code<>0 Then
|
||||
RunError(106);
|
||||
HandleError(106);
|
||||
End;
|
||||
{$endif SUPPORT_COMP}
|
||||
|
||||
@ -1185,14 +1185,19 @@ begin
|
||||
TextRec(f).FlushFunc:=@FileWriteFunc;
|
||||
end;
|
||||
else
|
||||
RunError(102);
|
||||
HandleError(102);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1998-07-29 21:44:35 michael
|
||||
Revision 1.19 1998-07-30 13:26:16 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.18 1998/07/29 21:44:35 michael
|
||||
+ Implemented reading/writing of ansistrings
|
||||
|
||||
Revision 1.17 1998/07/19 19:55:33 michael
|
||||
|
||||
@ -646,7 +646,7 @@ end;
|
||||
Procedure SegFaultHandler (Sig : longint);
|
||||
begin
|
||||
if sig=11 then
|
||||
RunError (216);
|
||||
HandleError (216);
|
||||
end;
|
||||
|
||||
|
||||
@ -675,7 +675,12 @@ End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 1998-07-20 23:40:20 michael
|
||||
Revision 1.10 1998-07-30 13:26:15 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.9 1998/07/20 23:40:20 michael
|
||||
changed sbrk to fc_sbrk, to avoid conflicts with C library.
|
||||
|
||||
Revision 1.8 1998/07/13 21:19:14 florian
|
||||
|
||||
@ -52,10 +52,12 @@
|
||||
asm
|
||||
move.b d0,b
|
||||
end;
|
||||
RunError(b);
|
||||
HandleError(b);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
Procedure FillChar(var x; count: longint; value: byte);
|
||||
begin
|
||||
asm
|
||||
@ -332,6 +334,42 @@
|
||||
end ['a0'];
|
||||
end;
|
||||
|
||||
Procedure HandleError (Errno : longint);[alias : 'handleerror'];
|
||||
{
|
||||
Procedure to handle internal errors, i.e. not user-invoked errors
|
||||
Internal function should ALWAYS call HandleError instead of RunError.
|
||||
}
|
||||
function get_addr : pointer;
|
||||
|
||||
begin
|
||||
asm
|
||||
move.l (a6),a0
|
||||
move.l 4(a0),a0
|
||||
move.l a0,@RESULT
|
||||
end ['a0'];
|
||||
end;
|
||||
function get_error_bp : longint;
|
||||
|
||||
begin
|
||||
asm
|
||||
{ get base pointer of error }
|
||||
move.l (a6),d0
|
||||
move.l d0,@RESULT
|
||||
end ['d0'];
|
||||
end;
|
||||
|
||||
begin
|
||||
If ErrorProc<>Nil then
|
||||
TErrorProc (ErrorProc)(Errno,get_addr);
|
||||
errorcode:=Errno;
|
||||
exitcode:=Errno;
|
||||
erroraddr:=Get_addr;
|
||||
DoError := TRUE;
|
||||
errorbase:=get_error_bp;
|
||||
halt(errorcode);
|
||||
end;
|
||||
|
||||
|
||||
procedure runerror(w : word);
|
||||
|
||||
function get_addr : longint;
|
||||
@ -398,7 +436,7 @@
|
||||
move.l d0,addr
|
||||
end;
|
||||
writeln('Overflow at 0x',HexStr(addr,8));
|
||||
RunError(215);
|
||||
HandleError(215);
|
||||
end;
|
||||
|
||||
{ procedure strcopy(dstr,sstr : pointer;len : longint);[public,alias: 'STRCOPY'];}
|
||||
@ -748,7 +786,12 @@ XDEF RE_BOUNDS_CHECK
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 1998-07-10 11:02:41 peter
|
||||
Revision 1.9 1998-07-30 13:26:14 michael
|
||||
+ Added support for ErrorProc variable. All internal functions are required
|
||||
to call HandleError instead of runerror from now on.
|
||||
This is necessary for exception support.
|
||||
|
||||
Revision 1.8 1998/07/10 11:02:41 peter
|
||||
* support_fixed, becuase fixed is not 100% yet for the m68k
|
||||
|
||||
Revision 1.7 1998/07/02 12:20:58 carl
|
||||
|
||||
Loading…
Reference in New Issue
Block a user