|
|
@@ -0,0 +1,822 @@
|
|
|
+{
|
|
|
+ This file is part of the Free Pascal run time library.
|
|
|
+ Translated to Pascal by Jonas Maebe,
|
|
|
+ member of the Free Pascal development team
|
|
|
+
|
|
|
+ This file is based on the source code of libsupc++ from GCC 4.2.1.
|
|
|
+
|
|
|
+ See below for details about the copyright. While it is GPLv2 rather
|
|
|
+ than LGPLv2 like the rest of the FPC RTL, it has the same linking
|
|
|
+ exception as the rest of the FPC RTL and hence it can be used in the
|
|
|
+ same way.
|
|
|
+
|
|
|
+ **********************************************************************}
|
|
|
+
|
|
|
+// -*- C++ -*- The GNU C++ exception personality routine.
|
|
|
+// Copyright (C) 2001, 2002, 2003, 2006 Free Software Foundation, Inc.
|
|
|
+//
|
|
|
+// This file is part of GCC.
|
|
|
+//
|
|
|
+// GCC is free software; you can redistribute it and/or modify
|
|
|
+// it under the terms of the GNU General Public License as published by
|
|
|
+// the Free Software Foundation; either version 2, or (at your option)
|
|
|
+// any later version.
|
|
|
+//
|
|
|
+// GCC is distributed in the hope that it will be useful,
|
|
|
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
+// GNU General Public License for more details.
|
|
|
+//
|
|
|
+// You should have received a copy of the GNU General Public License
|
|
|
+// along with GCC; see the file COPYING. If not, write to
|
|
|
+// the Free Software Foundation, 51 Franklin Street, Fifth Floor,
|
|
|
+// Boston, MA 02110-1301, USA.
|
|
|
+
|
|
|
+// As a special exception, you may use this file as part of a free software
|
|
|
+// library without restriction. Specifically, if other files instantiate
|
|
|
+// templates or use macros or inline functions from this file, or you compile
|
|
|
+// this file and link it with other files to produce an executable, this
|
|
|
+// file does not by itself cause the resulting executable to be covered by
|
|
|
+// the GNU General Public License. This exception does not however
|
|
|
+// invalidate any other reasons why the executable file might be covered by
|
|
|
+// the GNU General Public License.
|
|
|
+
|
|
|
+
|
|
|
+{$packrecords c}
|
|
|
+
|
|
|
+{$if (defined(CPUARMEL) or defined(CPUARMHF)) and not defined(darwin)}
|
|
|
+{$define __ARM_EABI_UNWINDER__}
|
|
|
+{$error add ARM EABI unwinder support}
|
|
|
+{$endif}
|
|
|
+
|
|
|
+function FPC_psabieh_GetExceptionWrapper(exceptionObject: PFPC_Unwind_Exception): PExceptObject; inline;
|
|
|
+ begin
|
|
|
+ { go to end of the wrapped exception (it's the last field in PFPC_Unwind_Exception), then to the start }
|
|
|
+ result:=PExceptObject(exceptionObject+1)-1;
|
|
|
+ end;
|
|
|
+
|
|
|
+procedure _Unwind_DeleteException(context:PFPC_Unwind_Context);cdecl;external;
|
|
|
+function _Unwind_GetGR(context:PFPC_Unwind_Context; index:cint):PtrUInt;cdecl;external;
|
|
|
+procedure _Unwind_SetGR(context:PFPC_Unwind_Context; index:cint; new_value:PtrUInt);cdecl;external;
|
|
|
+function _Unwind_GetIP(context:PFPC_Unwind_Context):PtrUInt;cdecl;external;
|
|
|
+procedure _Unwind_SetIP(_para1:PFPC_Unwind_Context; new_value:PtrUInt);cdecl;external;
|
|
|
+function _Unwind_GetRegionStart(context:PFPC_Unwind_Context):PtrUInt;cdecl;external;
|
|
|
+function _Unwind_GetLanguageSpecificData(context:PFPC_Unwind_Context):PtrUInt;cdecl;external;
|
|
|
+
|
|
|
+function _Unwind_GetDataRelBase(context:PFPC_Unwind_Context):PtrUInt;cdecl;external;
|
|
|
+function _Unwind_GetTextRelBase(context:PFPC_Unwind_Context):PtrUInt;cdecl;external;
|
|
|
+
|
|
|
+{ _Unwind_Backtrace() is a gcc extension that walks the stack and calls the }
|
|
|
+{ _Unwind_Trace_Fn once per frame until it reaches the bottom of the stack }
|
|
|
+{ or the _Unwind_Trace_Fn function returns something other than _URC_NO_REASON. }
|
|
|
+{ }
|
|
|
+type
|
|
|
+ FPC_Unwind_Trace_Fn = function (_para1:PFPC_Unwind_Context; _para2:pointer):FPC_Unwind_Reason_Code;cdecl;
|
|
|
+
|
|
|
+function _Unwind_Backtrace(_para1:FPC_Unwind_Trace_Fn; _para2:pointer):FPC_Unwind_Reason_Code;cdecl;weakexternal;
|
|
|
+
|
|
|
+{ _Unwind_GetCFA is a gcc extension that can be called from within a personality }
|
|
|
+{ handler to get the CFA (stack pointer before call) of current frame. }
|
|
|
+{ }
|
|
|
+function _Unwind_GetCFA(_para1:PFPC_Unwind_Context):PtrUInt;cdecl;weakexternal;
|
|
|
+
|
|
|
+const
|
|
|
+ DW_EH_PE_absptr = $00;
|
|
|
+ DW_EH_PE_omit = $ff;
|
|
|
+
|
|
|
+ DW_EH_PE_uleb128 = $01;
|
|
|
+ DW_EH_PE_udata2 = $02;
|
|
|
+ DW_EH_PE_udata4 = $03;
|
|
|
+ DW_EH_PE_udata8 = $04;
|
|
|
+ DW_EH_PE_sleb128 = $09;
|
|
|
+ DW_EH_PE_sdata2 = $0A;
|
|
|
+ DW_EH_PE_sdata4 = $0B;
|
|
|
+ DW_EH_PE_sdata8 = $0C;
|
|
|
+ DW_EH_PE_signed = $08;
|
|
|
+
|
|
|
+ DW_EH_PE_pcrel = $10;
|
|
|
+ DW_EH_PE_textrel = $20;
|
|
|
+ DW_EH_PE_datarel = $30;
|
|
|
+ DW_EH_PE_funcrel = $40;
|
|
|
+ DW_EH_PE_aligned = $50;
|
|
|
+
|
|
|
+ DW_EH_PE_indirect = $80;
|
|
|
+
|
|
|
+function FPC_psabieh_size_of_encoded_value(encoding: byte): longint;
|
|
|
+ begin
|
|
|
+ if encoding = DW_EH_PE_omit then
|
|
|
+ exit(0);
|
|
|
+
|
|
|
+ case (encoding and 7) of
|
|
|
+ DW_EH_PE_absptr:
|
|
|
+ exit(sizeof(pointer));
|
|
|
+ DW_EH_PE_udata2:
|
|
|
+ exit(2);
|
|
|
+ DW_EH_PE_udata4:
|
|
|
+ exit(4);
|
|
|
+ DW_EH_PE_udata8:
|
|
|
+ exit(8);
|
|
|
+ else
|
|
|
+ halt(217);
|
|
|
+ end
|
|
|
+ end;
|
|
|
+
|
|
|
+{ Given an encoding and an _Unwind_Context, return the base to which
|
|
|
+ the encoding is relative. This base may then be passed to
|
|
|
+ read_encoded_value_with_base for use when the _Unwind_Context is
|
|
|
+ not available. }
|
|
|
+
|
|
|
+function FPC_psabieh_base_of_encoded_value (encoding: byte; context: PFPC_Unwind_Context): PtrUInt;
|
|
|
+ begin
|
|
|
+ if encoding = DW_EH_PE_omit then
|
|
|
+ exit(0);
|
|
|
+
|
|
|
+ case (encoding and $70) of
|
|
|
+ DW_EH_PE_absptr,
|
|
|
+ DW_EH_PE_pcrel,
|
|
|
+ DW_EH_PE_aligned:
|
|
|
+ exit(0);
|
|
|
+ DW_EH_PE_textrel:
|
|
|
+ exit(_Unwind_GetTextRelBase(context));
|
|
|
+ DW_EH_PE_datarel:
|
|
|
+ exit(_Unwind_GetDataRelBase(context));
|
|
|
+ DW_EH_PE_funcrel:
|
|
|
+ exit(_Unwind_GetRegionStart(context));
|
|
|
+ else
|
|
|
+ halt(217);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+function fpc_read_uleb128 (p: PByte; out val: PTRUInt): PByte;
|
|
|
+ var
|
|
|
+ shift: longint;
|
|
|
+ b: byte;
|
|
|
+ res: PtrUInt;
|
|
|
+ begin
|
|
|
+ shift:=0;
|
|
|
+
|
|
|
+ res:=0;
|
|
|
+ repeat
|
|
|
+ b:=p^;
|
|
|
+ inc(p);
|
|
|
+ res:=res or (PtrUInt(b and $7f) shl shift);
|
|
|
+ inc(shift,7);
|
|
|
+ until (b and $80)<>0;
|
|
|
+
|
|
|
+ val:=res;
|
|
|
+ result:=p;
|
|
|
+ end;
|
|
|
+
|
|
|
+function fpc_read_sleb128 (p: PByte; out val: PtrInt): PByte;
|
|
|
+ var
|
|
|
+ shift: longint;
|
|
|
+ b: byte;
|
|
|
+ res: PtrUInt;
|
|
|
+ begin
|
|
|
+ shift:=0;
|
|
|
+
|
|
|
+ res:=0;
|
|
|
+ repeat
|
|
|
+ b:=p^;
|
|
|
+ inc(p);
|
|
|
+ res:=res or (PtrUInt(b and $7f) shl shift);
|
|
|
+ inc(shift,7);
|
|
|
+ until (b and $80)<>0;
|
|
|
+ if (shift<8*(sizeof(res))) and
|
|
|
+ ((b and $40)<>0) then
|
|
|
+ res:=res or -(PtrUInt(1) shl shift);
|
|
|
+
|
|
|
+ val:=PTRInt(res);
|
|
|
+ result:=p;
|
|
|
+ end;
|
|
|
+
|
|
|
+function FPC_psabieh_read_encoded_value_with_base (encoding: byte; base: PtrUInt; p: PByte; out val: PtrUInt): PByte;
|
|
|
+ var
|
|
|
+ res: PtrUInt;
|
|
|
+ tmpres: PtrInt;
|
|
|
+ alignedp: PPtrUint;
|
|
|
+ begin
|
|
|
+ if encoding=DW_EH_PE_aligned then
|
|
|
+ begin
|
|
|
+ alignedp:=PPtrUint(align(PtrUInt(p),sizeof(PtrUint)));
|
|
|
+ res:=alignedp^;
|
|
|
+ result:=PByte(alignedp)+sizeof(PtrUInt);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ case encoding and $0f of
|
|
|
+ DW_EH_PE_absptr:
|
|
|
+ begin
|
|
|
+ res:=unaligned(PPtrUint(p)^);
|
|
|
+ result:=p+sizeof(PtrUInt);
|
|
|
+ end;
|
|
|
+ DW_EH_PE_uleb128:
|
|
|
+ begin
|
|
|
+ result:=fpc_read_uleb128(p,res);
|
|
|
+ end;
|
|
|
+ DW_EH_PE_sleb128:
|
|
|
+ begin
|
|
|
+ result:=fpc_read_sleb128(p,tmpres);
|
|
|
+ res:=PtrUInt(tmpres);;
|
|
|
+ end;
|
|
|
+ DW_EH_PE_udata2:
|
|
|
+ begin
|
|
|
+ res:=unaligned(pword(p)^);
|
|
|
+ result:=p+2;
|
|
|
+ end;
|
|
|
+ DW_EH_PE_udata4:
|
|
|
+ begin
|
|
|
+ res:=unaligned(pdword(p)^);
|
|
|
+ result:=p+4;
|
|
|
+ end;
|
|
|
+ DW_EH_PE_udata8:
|
|
|
+ begin
|
|
|
+ res:=unaligned(pqword(p)^);
|
|
|
+ result:=p+8;
|
|
|
+ end;
|
|
|
+ DW_EH_PE_sdata2:
|
|
|
+ begin
|
|
|
+ res:=PtrUInt(unaligned(psmallint(p)^));
|
|
|
+ result:=p+2;
|
|
|
+ end;
|
|
|
+ DW_EH_PE_sdata4:
|
|
|
+ begin
|
|
|
+ res:=PtrUInt(unaligned(plongint(p)^));
|
|
|
+ result:=p+4;
|
|
|
+ end;
|
|
|
+ DW_EH_PE_sdata8:
|
|
|
+ begin
|
|
|
+ res:=PtrUInt(unaligned(pint64(p)^));
|
|
|
+ result:=p+8;
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ halt(217);
|
|
|
+ end;
|
|
|
+ if res<>0 then
|
|
|
+ begin
|
|
|
+ if (encoding and $70)=DW_EH_PE_pcrel then
|
|
|
+ inc(res,PtrUInt(p))
|
|
|
+ else
|
|
|
+ inc(res, base);
|
|
|
+ if (encoding and DW_EH_PE_indirect)<>0 then
|
|
|
+ res:=PPtrUInt(res)^;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ val:=res;
|
|
|
+ end;
|
|
|
+
|
|
|
+function FPC_psabieh_read_encoded_value (context: PFPC_Unwind_Context; encoding: byte; p: PByte; out val: PtrUInt): PByte; inline;
|
|
|
+ begin
|
|
|
+ result:=FPC_psabieh_read_encoded_value_with_base(encoding,FPC_psabieh_base_of_encoded_value(encoding,context),p,val);
|
|
|
+ end;
|
|
|
+
|
|
|
+type
|
|
|
+ FPC_psabieh_lsda_header_info = record
|
|
|
+ Start: PtrUInt;
|
|
|
+ LPStart: PtrUInt;
|
|
|
+ ttype_base: PtrUInt;
|
|
|
+ TType: Pointer;
|
|
|
+ action_table: pointer;
|
|
|
+ ttype_encoding: byte;
|
|
|
+ call_site_encoding: byte;
|
|
|
+ end;
|
|
|
+
|
|
|
+function FPC_psabieh_parse_lsda_header(context: PFPC_Unwind_Context; p: PByte; out info: FPC_psabieh_lsda_header_info): PByte;
|
|
|
+ var
|
|
|
+ tmp: PTRUint;
|
|
|
+ lpstart_encoding: byte;
|
|
|
+ begin
|
|
|
+ if assigned(context) then
|
|
|
+ info.Start:=_Unwind_GetRegionStart(context)
|
|
|
+ else
|
|
|
+ info.Start:=0;
|
|
|
+
|
|
|
+ // Find @LPStart, the base to which landing pad offsets are relative.
|
|
|
+ lpstart_encoding:=p^;
|
|
|
+ inc(p);
|
|
|
+ if lpstart_encoding<>DW_EH_PE_omit then
|
|
|
+ p:=FPC_psabieh_read_encoded_value(context,lpstart_encoding,p,info.LPStart)
|
|
|
+ else
|
|
|
+ info.LPStart:=info.Start;
|
|
|
+
|
|
|
+ // Find @TType, the base of the handler and exception spec type data.
|
|
|
+ info.ttype_encoding:=p^;
|
|
|
+ inc(p);
|
|
|
+ if info.ttype_encoding<>DW_EH_PE_omit then
|
|
|
+ begin
|
|
|
+ p:=fpc_read_uleb128(p,tmp);
|
|
|
+ info.TType:=p+tmp;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ info.TType:=nil;
|
|
|
+
|
|
|
+ // The encoding and length of the call-site table; the action table
|
|
|
+ // immediately follows.
|
|
|
+ info.call_site_encoding:=p^;
|
|
|
+ inc(p);
|
|
|
+ p:=fpc_read_uleb128(p,tmp);
|
|
|
+ info.action_table:=p+tmp;
|
|
|
+
|
|
|
+ result:=p;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+// Return an element from a type table.
|
|
|
+function FPC_psabieh_get_ttype_entry(const info: FPC_psabieh_lsda_header_info; i: PtrUInt): TClass;
|
|
|
+ var
|
|
|
+ ptr: PtrUInt;
|
|
|
+ begin
|
|
|
+ i:=i*FPC_psabieh_size_of_encoded_value(info.ttype_encoding);
|
|
|
+ FPC_psabieh_read_encoded_value_with_base(info.ttype_encoding,info.ttype_base,info.TType-i,ptr);
|
|
|
+ result:=TClass(ptr);
|
|
|
+ end;
|
|
|
+
|
|
|
+function FPC_psabieh_can_catch(catch_type: TClass; thrown: TObject): boolean;
|
|
|
+ begin
|
|
|
+ result:=thrown is catch_type
|
|
|
+ end;
|
|
|
+
|
|
|
+// Return true if THROW_TYPE matches one if the filter types.
|
|
|
+function FPC_psabieh_check_exception_spec(const info: FPC_psabieh_lsda_header_info; thrown: TObject; filter_value: PtrInt): boolean;
|
|
|
+ var
|
|
|
+ e: PByte;
|
|
|
+ catch_type: TClass;
|
|
|
+ tmp: PtrUInt;
|
|
|
+ begin
|
|
|
+ e:=info.TType - filter_value - 1;
|
|
|
+ repeat
|
|
|
+ e:=fpc_read_uleb128(e,tmp);
|
|
|
+ // Zero signals the end of the list. If we've not found
|
|
|
+ // a match by now, then we've failed the specification.
|
|
|
+ if tmp=0 then
|
|
|
+ exit(false);
|
|
|
+
|
|
|
+ // Match a ttype entry.
|
|
|
+ catch_type:=FPC_psabieh_get_ttype_entry(info,tmp);
|
|
|
+
|
|
|
+ until thrown is catch_type;
|
|
|
+ result:=true;
|
|
|
+ end;
|
|
|
+
|
|
|
+// Save stage1 handler information in the exception object
|
|
|
+procedure FPC_psabieh_save_caught_exception(ue_header: PFPC_Unwind_Exception;
|
|
|
+ handler_switch_value: longint;
|
|
|
+ language_specific_data: PByte;
|
|
|
+ landing_pad: PtrUInt);
|
|
|
+ var
|
|
|
+ xh: PExceptObject;
|
|
|
+ begin
|
|
|
+ xh:=FPC_psabieh_GetExceptionWrapper(ue_header);
|
|
|
+ xh^.handler_switch_value:=handler_switch_value;
|
|
|
+ xh^.language_specific_data:=language_specific_data;
|
|
|
+ xh^.landing_pad:=landing_pad;
|
|
|
+ end;
|
|
|
+
|
|
|
+// Restore the catch handler information saved during phase1.
|
|
|
+procedure FPC_psabieh_restore_caught_exception(ue_header: PFPC_Unwind_Exception;
|
|
|
+ out handler_switch_value: longint;
|
|
|
+ out language_specific_data: PByte;
|
|
|
+ out landing_pad: PtrUInt);
|
|
|
+ var
|
|
|
+ xh: PExceptObject;
|
|
|
+ begin
|
|
|
+ xh:=FPC_psabieh_GetExceptionWrapper(ue_header);
|
|
|
+ handler_switch_value:=xh^.handler_switch_value;
|
|
|
+ language_specific_data:=xh^.language_specific_data;
|
|
|
+ landing_pad:=xh^.landing_pad;
|
|
|
+ end;
|
|
|
+
|
|
|
+function FPC_psabieh_find_action_record(const info: FPC_psabieh_lsda_header_info; var p: PByte; const ip: PTRUint; var landing_pad: PtrUInt; var action_record: PByte): boolean;
|
|
|
+ var
|
|
|
+ cs_start, cs_len, cs_lp: PtrUint{_Unwind_Ptr};
|
|
|
+ cs_action: PtrUInt {_Unwind_Word};
|
|
|
+ begin
|
|
|
+ result:=false;
|
|
|
+ while (p<info.action_table) do
|
|
|
+ begin
|
|
|
+ // Note that all call-site encodings are "absolute" displacements.
|
|
|
+ p:=FPC_psabieh_read_encoded_value (nil, info.call_site_encoding, p, cs_start);
|
|
|
+ p:=FPC_psabieh_read_encoded_value (nil, info.call_site_encoding, p, cs_len);
|
|
|
+ p:=FPC_psabieh_read_encoded_value (nil, info.call_site_encoding, p, cs_lp);
|
|
|
+ p:=FPC_read_uleb128 (p, &cs_action);
|
|
|
+
|
|
|
+ // The table is sorted, so if we've passed the ip, stop.
|
|
|
+ if ip<(info.Start+cs_start) then
|
|
|
+ p:=info.action_table
|
|
|
+ else if ip<(info.Start+cs_start+cs_len) then
|
|
|
+ begin
|
|
|
+ if cs_lp<>0 then
|
|
|
+ landing_pad:=info.LPStart+cs_lp;
|
|
|
+ if cs_action<>0 then
|
|
|
+ action_record:=info.action_table+cs_action-1;
|
|
|
+ result:=true;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+
|
|
|
+// Return true if the filter spec is empty, ie throw().
|
|
|
+
|
|
|
+function fpc_psabieh_empty_exception_spec(const info: FPC_psabieh_lsda_header_info; const filter_value: PtrInt {_Unwind_Sword}): boolean;
|
|
|
+ var
|
|
|
+ e: PByte;
|
|
|
+ tmp: PtrUInt;
|
|
|
+ begin
|
|
|
+ e:=PByte(info.ttype - filter_value - 1);
|
|
|
+ e:=fpc_read_uleb128(e,tmp);
|
|
|
+ result:=tmp = 0;
|
|
|
+ end;
|
|
|
+
|
|
|
+type
|
|
|
+ FPC_psabieh_found_handler_type = (
|
|
|
+ found_nothing,
|
|
|
+ found_terminate,
|
|
|
+ found_cleanup,
|
|
|
+ found_handler
|
|
|
+ );
|
|
|
+
|
|
|
+function FPC_psabieh_find_handler(const info: FPC_psabieh_lsda_header_info; const foreign_exception: boolean; actions: FPC_Unwind_Action; thrown: TObject; var action_record: PByte; var handler_switch_value: longint): FPC_psabieh_found_handler_type;
|
|
|
+ var
|
|
|
+ ar_filter, ar_disp: PtrInt;
|
|
|
+ catch_type: TClass;
|
|
|
+ throw_type: TOBject;
|
|
|
+ saw_cleanup, saw_handler: boolean;
|
|
|
+ p: PByte;
|
|
|
+ begin
|
|
|
+ saw_cleanup:=false;
|
|
|
+ saw_handler:=false;
|
|
|
+
|
|
|
+ // During forced unwinding, we only run cleanups. With a foreign
|
|
|
+ // exception class, there's no exception type.
|
|
|
+ if ((actions and FPC_UA_FORCE_UNWIND)<>0) or
|
|
|
+ foreign_exception then
|
|
|
+ throw_type:=nil
|
|
|
+ else
|
|
|
+ throw_type:=thrown;
|
|
|
+
|
|
|
+ while true do
|
|
|
+ begin
|
|
|
+ p:=action_record;
|
|
|
+ p:=fpc_read_sleb128(p,ar_filter);
|
|
|
+ fpc_read_sleb128(p,ar_disp);
|
|
|
+
|
|
|
+ if ar_filter=0 then
|
|
|
+ begin
|
|
|
+ // Zero filter values are cleanups.
|
|
|
+ saw_cleanup:=true;
|
|
|
+ end
|
|
|
+ else if ar_filter>0 then
|
|
|
+ begin
|
|
|
+ // Positive filter values are handlers.
|
|
|
+ catch_type:=FPC_psabieh_get_ttype_entry(info,ar_filter);
|
|
|
+
|
|
|
+ // Null catch type is a catch-all handler; we can catch foreign
|
|
|
+ // exceptions with this. Otherwise we must match types.
|
|
|
+ if not assigned(catch_type) or
|
|
|
+ (assigned(throw_type) and
|
|
|
+ (throw_type is catch_type)) then
|
|
|
+ begin
|
|
|
+ saw_handler:=true;
|
|
|
+ break;
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ // Negative filter values are exception specifications.
|
|
|
+ // ??? How do foreign exceptions fit in? As far as I can
|
|
|
+ // see we can't match because there's no __cxa_exception
|
|
|
+ // object to stuff bits in for __cxa_call_unexpected to use.
|
|
|
+ // Allow them iff the exception spec is non-empty. I.e.
|
|
|
+ // a throw() specification results in __unexpected.
|
|
|
+ if (assigned(throw_type) and
|
|
|
+ not FPC_psabieh_check_exception_spec(info,thrown,ar_filter)) or
|
|
|
+ (not assigned(throw_type) and
|
|
|
+ FPC_psabieh_empty_exception_spec(info,ar_filter)) then
|
|
|
+ begin
|
|
|
+ saw_handler:=true;
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if ar_disp=0 then
|
|
|
+ break;
|
|
|
+ action_record:=p+ar_disp;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if saw_handler then
|
|
|
+ begin
|
|
|
+ handler_switch_value:=ar_filter;
|
|
|
+ result:=found_handler;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if saw_cleanup then
|
|
|
+ result:=found_cleanup
|
|
|
+ else
|
|
|
+ result:=found_nothing;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+{$ifdef FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+procedure __gxx_personality_v0(version: cint; actions: FPC_Unwind_Action; exceptionClass: cuint64; libunwind_exception: PFPC_Unwind_Exception; context: PFPC_Unwind_Context); cdecl; external;
|
|
|
+{$endif FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+
|
|
|
+function FPC_psabieh_personality_v0(version: cint; actions: FPC_Unwind_Action; exceptionClass: cuint64; libunwind_exception: PFPC_Unwind_Exception; context: PFPC_Unwind_Context): FPC_Unwind_Reason_Code; cdecl;
|
|
|
+ var
|
|
|
+ WrappedException: PExceptObject;
|
|
|
+ found_type: FPC_psabieh_found_handler_type;
|
|
|
+ info: FPC_psabieh_lsda_header_info;
|
|
|
+ language_specific_data: PByte;
|
|
|
+ action_record: PByte;
|
|
|
+ p: PByte;
|
|
|
+ landing_pad, ip: PtrUInt;
|
|
|
+ handler_switch_value: longint;
|
|
|
+ foreign_exception: boolean;
|
|
|
+ begin
|
|
|
+ { unsupported version -> failure }
|
|
|
+ if version<>1 then
|
|
|
+ begin
|
|
|
+ result:=FPC_URC_FATAL_PHASE1_ERROR;
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { foreign exception type -> let c++ runtime handle it }
|
|
|
+ foreign_exception:=exceptionClass<>FPC_psabieh_exceptionClass_ID.u;
|
|
|
+{$ifdef FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+ if foreign_exception then
|
|
|
+ begin
|
|
|
+ result:=__gxx_personality_v0(version, actions, exceptionClass, libunwind_exception, context)
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+{$endif FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+
|
|
|
+ WrappedException:=FPC_psabieh_GetExceptionWrapper(libunwind_exception);
|
|
|
+
|
|
|
+ // Shortcut for phase 2 found handler for domestic exception.
|
|
|
+ if (actions=(FPC_UA_CLEANUP_PHASE or FPC_UA_HANDLER_FRAME)) and
|
|
|
+ not foreign_exception then
|
|
|
+ begin
|
|
|
+ FPC_psabieh_restore_caught_exception(libunwind_exception,handler_switch_value,
|
|
|
+ language_specific_data,landing_pad);
|
|
|
+ if landing_pad<>0 then
|
|
|
+ found_type:=found_handler
|
|
|
+ else
|
|
|
+ found_type:=found_terminate;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ language_specific_data:=PByte(_Unwind_GetLanguageSpecificData(context));
|
|
|
+
|
|
|
+ // If no LSDA, then there are no handlers or cleanups.
|
|
|
+ if not assigned(language_specific_data) then
|
|
|
+ begin
|
|
|
+ exit(FPC_URC_CONTINUE_UNWIND);
|
|
|
+ end;
|
|
|
+
|
|
|
+ // Parse the LSDA header.
|
|
|
+ p:=FPC_psabieh_parse_lsda_header(context,language_specific_data,info);
|
|
|
+ info.ttype_base:=FPC_psabieh_base_of_encoded_value(info.ttype_encoding,context);
|
|
|
+ ip:=_Unwind_GetIP(context);
|
|
|
+ dec(ip);
|
|
|
+ landing_pad:=0;
|
|
|
+ action_record:=nil;
|
|
|
+ handler_switch_value:=0;
|
|
|
+
|
|
|
+ // Search the call-site table for the action associated with this IP.
|
|
|
+ if FPC_psabieh_find_action_record(info,p,ip,landing_pad,action_record) then
|
|
|
+ begin
|
|
|
+ if landing_pad=0 then
|
|
|
+ begin
|
|
|
+ // If ip is present, and has a null landing pad, there are
|
|
|
+ // no cleanups or handlers to be run.
|
|
|
+ found_type:=found_nothing;
|
|
|
+ end
|
|
|
+ else if action_record=nil then
|
|
|
+ begin
|
|
|
+ // If ip is present, has a non-null landing pad, and a null
|
|
|
+ // action table offset, then there are only cleanups present.
|
|
|
+ // Cleanups use a zero switch value, as set above.
|
|
|
+ found_type:=found_cleanup;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ // Otherwise we have a catch handler or exception specification.
|
|
|
+ found_type:=FPC_psabieh_find_handler(info,foreign_exception,actions,WrappedException^.FObject,action_record,handler_switch_value);
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ // If ip is not present in the table, call terminate. This is for
|
|
|
+ // a destructor inside a cleanup, or a library routine the compiler
|
|
|
+ // was not expecting to throw.
|
|
|
+ found_type:=found_terminate;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if found_type=found_nothing then
|
|
|
+ exit(FPC_URC_CONTINUE_UNWIND);
|
|
|
+
|
|
|
+ if (actions and FPC_UA_SEARCH_PHASE)<>0 then
|
|
|
+ begin
|
|
|
+ if found_type=found_cleanup then
|
|
|
+ exit(FPC_URC_CONTINUE_UNWIND);
|
|
|
+
|
|
|
+ if not foreign_exception then
|
|
|
+ begin
|
|
|
+ // For domestic exceptions, we cache data from phase 1 for phase 2.
|
|
|
+ FPC_psabieh_save_caught_exception(libunwind_exception,
|
|
|
+ handler_switch_value,language_specific_data,
|
|
|
+ landing_pad);
|
|
|
+ end;
|
|
|
+ exit(FPC_URC_HANDLER_FOUND);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if ((actions and FPC_UA_FORCE_UNWIND)<>0) or
|
|
|
+ foreign_exception then
|
|
|
+ begin
|
|
|
+ if found_type=found_terminate then
|
|
|
+ halt(217)
|
|
|
+ { can only perform cleanups when force-unwinding }
|
|
|
+ else if handler_switch_value<0 then
|
|
|
+ begin
|
|
|
+ RunError(217)
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if found_type=found_terminate then
|
|
|
+ halt(217);
|
|
|
+ end;
|
|
|
+ { For targets with pointers smaller than the word size, we must extend the
|
|
|
+ pointer, and this extension is target dependent. }
|
|
|
+ {$if sizeof(pointer)<>sizeof(SizeInt)}
|
|
|
+ {$error Add support for extending pointer values}
|
|
|
+ {$endif}
|
|
|
+ _Unwind_SetGR(context,fpc_eh_return_data_regno(0),libunwind_exception);
|
|
|
+ _Unwind_SetGR (context,fpc_eh_return_data_regno(1),handler_switch_value);
|
|
|
+ _Unwind_SetIP(context,landing_pad);
|
|
|
+ result:=FPC_URC_INSTALL_CONTEXT;
|
|
|
+ end;
|
|
|
+
|
|
|
+//////////////////////////////
|
|
|
+///// Raising an exception
|
|
|
+//////////////////////////////
|
|
|
+
|
|
|
+procedure FPC_psabieh_ExceptionCleanUp(reason: FPC_Unwind_Reason_Code; exc:PFPC_Unwind_Exception); cdecl;
|
|
|
+ var
|
|
|
+ ExceptWrapper: PExceptObject;
|
|
|
+ begin
|
|
|
+ // If we haven't been caught by a foreign handler, then this is
|
|
|
+ // some sort of unwind error. In that case just die immediately.
|
|
|
+ // _Unwind_DeleteException in the HP-UX IA64 libunwind library
|
|
|
+ // returns _URC_NO_REASON and not _URC_FOREIGN_EXCEPTION_CAUGHT
|
|
|
+ // like the GCC _Unwind_DeleteException function does.
|
|
|
+ if (reason<>FPC_URC_FOREIGN_EXCEPTION_CAUGHT) and
|
|
|
+ (reason<>FPC_URC_NO_REASON) then
|
|
|
+ halt(217);
|
|
|
+
|
|
|
+ ExceptWrapper:=FPC_psabieh_GetExceptionWrapper(exc);
|
|
|
+ ExceptWrapper^.FObject.free;
|
|
|
+ ExceptWrapper^.FObject:=nil;
|
|
|
+ Dispose(ExceptWrapper);
|
|
|
+ end;
|
|
|
+
|
|
|
+function PushExceptObject(Obj : TObject; AnAddr : CodePointer; AFrame : Pointer): PExceptObject; forward;
|
|
|
+
|
|
|
+{$define FPC_SYSTEM_HAS_RAISEEXCEPTION}
|
|
|
+procedure fpc_RaiseException(Obj: TObject; AnAddr: CodePointer; AFrame: Pointer); compilerproc;
|
|
|
+var
|
|
|
+ _ExceptObjectStack : PExceptObject;
|
|
|
+ _ExceptAddrstack : PExceptAddr;
|
|
|
+ ExceptWrapper: PExceptObject;
|
|
|
+begin
|
|
|
+{$ifdef excdebug}
|
|
|
+ writeln ('In psabieh RaiseException');
|
|
|
+{$endif}
|
|
|
+ if ExceptTryLevel<>0 then
|
|
|
+ Halt(217);
|
|
|
+ ExceptTryLevel:=1;
|
|
|
+ ExceptWrapper:=PushExceptObject(Obj,AnAddr,AFrame);
|
|
|
+ ExceptWrapper^.unwind_exception.exception_class:=FPC_psabieh_exceptionClass_ID.u;
|
|
|
+ ExceptWrapper^.unwind_exception.exception_cleanup:=@FPC_psabieh_ExceptionCleanUp;
|
|
|
+ { if PushExceptObject causes another exception, the following won't be executed,
|
|
|
+ causing halt upon entering this routine recursively. }
|
|
|
+ ExceptTryLevel:=0;
|
|
|
+ _ExceptObjectStack:=ExceptObjectStack;
|
|
|
+ if (RaiseProc <> nil) and (_ExceptObjectStack <> nil) then
|
|
|
+ with _ExceptObjectStack^ do
|
|
|
+ RaiseProc(FObject,Addr,FrameCount,Frames);
|
|
|
+ _Unwind_RaiseException(@ExceptWrapper^.unwind_exception);
|
|
|
+ // should never return
|
|
|
+ Halt(217);
|
|
|
+end;
|
|
|
+
|
|
|
+{$ifdef FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+function __cxa_begin_catch(exc:PFPC_Unwind_Exception): pointer; cdecl; external;
|
|
|
+{$endif FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+
|
|
|
+function FPC_psabi_begin_catch(exc:PFPC_Unwind_Exception): pointer; cdecl; compilerproc;
|
|
|
+ var
|
|
|
+ ExceptWrapper: PExceptObject;
|
|
|
+ _ExceptObjectStack : PExceptObject;
|
|
|
+ count: longint;
|
|
|
+ begin
|
|
|
+ _ExceptObjectStack:=ExceptObjectStack;
|
|
|
+ // hand off foreign exceptions to the C++ runtime
|
|
|
+ if exc^.exception_class<>FPC_psabieh_exceptionClass_ID.u then
|
|
|
+ begin
|
|
|
+ // Can't link foreign exceptions with our stack
|
|
|
+ if assigned(_ExceptObjectStack) then
|
|
|
+ halt(217);
|
|
|
+ // This is a wrong conversion, but as long as afterwards we only access
|
|
|
+ // fields of PFPC_Unwind_Exception, it's fine
|
|
|
+ _ExceptObjectStack:=FPC_psabieh_GetExceptionWrapper(exc);
|
|
|
+{$ifdef FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+ result:=__cxa_begin_catch(exc);
|
|
|
+{$else}
|
|
|
+ // ??? No sensible value to return; we don't know what the
|
|
|
+ // object is, much less where it is in relation to the header.
|
|
|
+ result:=nil;
|
|
|
+{$endif}
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ ExceptWrapper:=FPC_psabieh_GetExceptionWrapper(exc);
|
|
|
+
|
|
|
+ count:=ExceptWrapper^.refcount;
|
|
|
+ // Count is less than zero if this exception was rethrown from an
|
|
|
+ // immediately enclosing region.
|
|
|
+ if count < 0 then
|
|
|
+ count:=-count+1
|
|
|
+ else
|
|
|
+ inc(count);
|
|
|
+ ExceptWrapper^.refcount:=count;
|
|
|
+// globals->uncaughtExceptions -= 1;
|
|
|
+ if _ExceptObjectStack<>ExceptWrapper then
|
|
|
+ begin
|
|
|
+ ExceptWrapper^.Next:=_ExceptObjectStack;
|
|
|
+ _ExceptObjectStack:=ExceptWrapper;
|
|
|
+ end;
|
|
|
+
|
|
|
+ result:= ExceptWrapper^.FObject;
|
|
|
+{$ifdef __ARM_EABI_UNWINDER__}
|
|
|
+ _Unwind_Complete(ExceptWrapper);
|
|
|
+{$endif}
|
|
|
+ end;
|
|
|
+
|
|
|
+{$ifdef FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+procedure __cxa_end_catch; cdecl; external;
|
|
|
+{$endif FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+
|
|
|
+procedure FPC_psabi_end_catch; cdecl; compilerproc;
|
|
|
+ var
|
|
|
+ _ExceptObjectStack: PExceptObject;
|
|
|
+ refcount: longint;
|
|
|
+ begin
|
|
|
+ _ExceptObjectStack:=ExceptObjectStack;
|
|
|
+ // A rethrow of a foreign exception will be removed from the
|
|
|
+ // the exception stack immediately by __cxa_rethrow.
|
|
|
+ if not assigned(_ExceptObjectStack) then
|
|
|
+ exit;
|
|
|
+
|
|
|
+ // Pass foreign exception to the C++ runtime
|
|
|
+ if _ExceptObjectStack^.unwind_exception.exception_class<>FPC_psabieh_exceptionClass_ID.u then
|
|
|
+ begin
|
|
|
+ { remove foreign exception; since we never link multiple foreign
|
|
|
+ exceptions, we know the stack is now empty }
|
|
|
+ ExceptObjectStack:=nil;
|
|
|
+{$ifdef FPC_PSABIEH_CPLUSPLUSSUPPORT}
|
|
|
+ __cxa_end_catch();
|
|
|
+{$else}
|
|
|
+ _Unwind_DeleteException(@_ExceptObjectStack^.unwind_exception);
|
|
|
+{$endif}
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ refcount:=_ExceptObjectStack^.refcount;
|
|
|
+ if refcount<0 then
|
|
|
+ begin
|
|
|
+ // This exception was rethrown. Decrement the (inverted) catch
|
|
|
+ // count and remove it from the chain when it reaches zero.
|
|
|
+ inc(refcount);
|
|
|
+ if refcount = 0 then
|
|
|
+ ExceptObjectStack:=_ExceptObjectStack^.next;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ dec(refcount);
|
|
|
+ if refcount=0 then
|
|
|
+ begin
|
|
|
+ // Handling for this exception is complete. Destroy the object.
|
|
|
+ ExceptObjectStack:=_ExceptObjectStack^.next;
|
|
|
+ _Unwind_DeleteException(@_ExceptObjectStack^.unwind_exception);
|
|
|
+ exit;
|
|
|
+ end
|
|
|
+ else if refcount<0 then
|
|
|
+ begin
|
|
|
+ // A bug in the exception handling library or compiler.
|
|
|
+ halt(217);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ _ExceptObjectStack^.refcount:=refcount;
|
|
|
+ end;
|
Jonas Maebe