mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 08:59:05 +02:00
* merged
This commit is contained in:
peter
parent
99395db696
commit
ec0a511cfa
@ -671,6 +671,7 @@ do_jmp:
|
||||
push_int (-1);
|
||||
emitcall('FPC_CATCHES');
|
||||
secondpass(p^.t1);
|
||||
emitcall('FPC_POPOBJECTSTACK');
|
||||
end
|
||||
else
|
||||
emitcall('FPC_RERAISE');
|
||||
@ -713,6 +714,7 @@ do_jmp:
|
||||
exprasmlist^.concat(new(pai386,op_ref(A_PUSH,S_L,
|
||||
newreference(ref))));
|
||||
emitcall('FPC_DESTROYEXCEPTION');
|
||||
emitcall('FPC_POPOBJECTSTACK');
|
||||
|
||||
{ clear some stuff }
|
||||
ungetiftemp(ref);
|
||||
@ -793,7 +795,13 @@ do_jmp:
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 1999-05-27 19:44:12 peter
|
||||
Revision 1.40 1999-06-14 00:43:35 peter
|
||||
* merged
|
||||
|
||||
Revision 1.39.2.1 1999/06/14 00:39:29 peter
|
||||
* don't pop object stack in catches, because it's needed for reraise
|
||||
|
||||
Revision 1.39 1999/05/27 19:44:12 peter
|
||||
* removed oldasm
|
||||
* plabel -> pasmlabel
|
||||
* -a switches to source writing automaticly
|
||||
|
||||
@ -406,7 +406,7 @@ begin
|
||||
{ Reallocation is needed... }
|
||||
Temp:=Pointer(NewAnsiString(L));
|
||||
if Length(S)>0 then
|
||||
Move (Pointer(S)^,Temp^,Length(S)+1);
|
||||
Move(Pointer(S)^,Temp^,L);
|
||||
ansistr_decr_ref(Pointer(S));
|
||||
Pointer(S):=Temp;
|
||||
end;
|
||||
@ -785,7 +785,13 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.28 1999-06-09 23:00:16 peter
|
||||
Revision 1.29 1999-06-14 00:47:33 peter
|
||||
* merged
|
||||
|
||||
Revision 1.28.2.1 1999/06/14 00:39:07 peter
|
||||
* setlength finally fixed when l < length(s)
|
||||
|
||||
Revision 1.28 1999/06/09 23:00:16 peter
|
||||
* small ansistring fixes
|
||||
* val_ansistr_sint destsize changed to longint
|
||||
* don't write low/hi ascii with -al
|
||||
|
||||
@ -21,6 +21,7 @@
|
||||
Const
|
||||
{ Type of exception. Currently only one. }
|
||||
FPC_EXCEPTION = 1;
|
||||
|
||||
{ types of frames for the exception address stack }
|
||||
cExceptionFrame = 1;
|
||||
cFinalizeFrame = 2;
|
||||
@ -36,7 +37,7 @@ Type
|
||||
PExceptObject = ^TExceptObject;
|
||||
TExceptObject = record
|
||||
FObject : TObject;
|
||||
addr : pointer;
|
||||
Addr : pointer;
|
||||
Next : PExceptObject;
|
||||
end;
|
||||
|
||||
@ -45,15 +46,15 @@ Type
|
||||
Const
|
||||
CatchAllExceptions = -1;
|
||||
|
||||
Var ExceptAddrStack : PExceptAddr;
|
||||
Var
|
||||
ExceptAddrStack : PExceptAddr;
|
||||
ExceptObjectStack : PExceptObject;
|
||||
|
||||
|
||||
Function PushExceptAddr (Ft: Longint): PJmp_buf ;[Public, Alias : 'FPC_PUSHEXCEPTADDR'];
|
||||
|
||||
var Buf : PJmp_buf;
|
||||
var
|
||||
Buf : PJmp_buf;
|
||||
NewAddr : PExceptAddr;
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In PushExceptAddr');
|
||||
@ -76,11 +77,9 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure PushExceptObj (Obj : TObject; AnAddr : Pointer);
|
||||
|
||||
Procedure PushExceptObj (Obj : TObject; AnAddr : Pointer); [Public, Alias : 'FPC_PUSHEXCEPTOBJECT'];
|
||||
var
|
||||
Newobj : PExceptObject;
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In PushExceptObject');
|
||||
@ -100,17 +99,17 @@ begin
|
||||
ExceptObjectStack^.Addr:=AnAddr;
|
||||
end;
|
||||
|
||||
Procedure DoUnHandledException (Var Obj : TObject; AnAddr : Pointer);
|
||||
|
||||
Procedure DoUnHandledException;
|
||||
begin
|
||||
If ExceptProc<>Nil then
|
||||
If ExceptObjectStack<>Nil then
|
||||
TExceptPRoc(ExceptProc)(Obj,AnAddr);
|
||||
TExceptPRoc(ExceptProc)(ExceptObjectStack^.FObject,ExceptObjectStack^.Addr);
|
||||
RunError(217);
|
||||
end;
|
||||
|
||||
Function Raiseexcept (Obj : TObject; AnAddr : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION'];
|
||||
|
||||
Function Raiseexcept (Obj : TObject; AnAddr : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION'];
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In RaiseException');
|
||||
@ -118,15 +117,14 @@ begin
|
||||
Raiseexcept:=nil;
|
||||
PushExceptObj(Obj,AnAddr);
|
||||
If ExceptAddrStack=Nil then
|
||||
DoUnhandledException (Obj,AnAddr);
|
||||
DoUnhandledException;
|
||||
longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
|
||||
end;
|
||||
|
||||
Procedure PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK'];
|
||||
|
||||
Procedure PopAddrStack;[Public, Alias : 'FPC_POPADDRSTACK'];
|
||||
var
|
||||
hp : PExceptAddr;
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In Popaddrstack');
|
||||
@ -134,7 +132,7 @@ begin
|
||||
If ExceptAddrStack=nil then
|
||||
begin
|
||||
writeln ('At end of ExceptionAddresStack');
|
||||
halt (1);
|
||||
halt (255);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -145,11 +143,10 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure PopObjectStack;
|
||||
|
||||
Procedure PopObjectStack;[Public, Alias : 'FPC_POPOBJECTSTACK'];
|
||||
var
|
||||
hp : PExceptObject;
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In PopObjectstack');
|
||||
@ -169,20 +166,18 @@ end;
|
||||
|
||||
|
||||
Procedure ReRaise;[Public, Alias : 'FPC_RERAISE'];
|
||||
|
||||
begin
|
||||
{$ifdef excdebug}
|
||||
writeln ('In reraise');
|
||||
{$endif}
|
||||
PopAddrStack;
|
||||
If ExceptAddrStack=Nil then
|
||||
DoUnHandledException (ExceptObjectStack^.FObject,
|
||||
ExceptObjectStack^.Addr);
|
||||
DoUnHandledException;
|
||||
longjmp(ExceptAddrStack^.Buf^,FPC_Exception);
|
||||
end;
|
||||
|
||||
Function Catches(Objtype : TExceptObjectClass) : TObject;[Public, Alias : 'FPC_CATCHES'];
|
||||
|
||||
Function Catches(Objtype : TExceptObjectClass) : TObject;[Public, Alias : 'FPC_CATCHES'];
|
||||
begin
|
||||
If ExceptObjectStack=Nil then
|
||||
begin
|
||||
@ -196,17 +191,18 @@ begin
|
||||
begin
|
||||
// catch !
|
||||
Catches:=ExceptObjectStack^.FObject;
|
||||
PopObjectStack;
|
||||
{ this can't be done, because there could be a reraise (PFV)
|
||||
PopObjectStack; }
|
||||
PopAddrStack;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure DestroyException(o : TObject);[Public, Alias : 'FPC_DESTROYEXCEPTION'];
|
||||
|
||||
begin
|
||||
o.Destroy;
|
||||
end;
|
||||
|
||||
|
||||
Procedure InitExceptions;
|
||||
{
|
||||
Initialize exceptionsupport
|
||||
@ -217,7 +213,13 @@ begin
|
||||
end;
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1999-05-13 18:38:26 florian
|
||||
Revision 1.11 1999-06-14 00:47:35 peter
|
||||
* merged
|
||||
|
||||
Revision 1.10.2.1 1999/06/14 00:38:18 peter
|
||||
* don't pop object stack in catches, because it's needed for reraise
|
||||
|
||||
Revision 1.10 1999/05/13 18:38:26 florian
|
||||
* more memory leaks fixed:
|
||||
- exceptaddrobject is now properly disposed
|
||||
- after the end of the on ... do block the exception
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
# implementation files.
|
||||
|
||||
SYSNAMES=systemh heaph mathh filerec textrec system real2str sstrings innr \
|
||||
file typefile text rtti heap astrings objpas objpash
|
||||
file typefile text rtti heap astrings objpas objpash except
|
||||
SYSINCNAMES=$(addsuffix .inc,$(SYSNAMES))
|
||||
|
||||
# Other unit names which can be used for all systems
|
||||
|
||||
Loading…
Reference in New Issue
Block a user