1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Michael Van Canneyt,
member of the Free Pascal development team.
Signal handler is arch dependant due to processor to language
exception conversion.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program 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.
**********************************************************************}
function GetHandleErrorAddrFrameAddr: pointer;
begin
result:=@HandleErrorAddrFrame;
end;
{$if not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
Procedure SignalToHandleErrorAddrFrame_ARM(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
asm
{$if FPC_FULLVERSION >= 30200}
.code 32
{$endif}
// the address is of the faulting instruction, and sigreturn will
// skip it -> start with a nop
nop
push {r0,r1,r2,r3}
bl GetHandleErrorAddrFrameAddr
// overwrite last stack slot with new return address
str r0, [sp,#12]
// lr := addr
ldr lr, [sp,#4]
pop {r0,r1,r2,pc}
.text
end;
{$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
{$if FPC_FULLVERSION >= 30200}
Procedure SignalToHandleErrorAddrFrame_Thumb(Errno : longint;addr : CodePointer; frame : Pointer); nostackframe; assembler;
asm
.thumb_func
.code 16
// the address is of the faulting instruction, and sigreturn will
// skip it -> start with a nop
nop
push {r0,r1,r2,r3}
bl GetHandleErrorAddrFrameAddr
// overwrite last stack slot with new return address
str r0, [sp,#12]
// lr := addr
ldr r0, [sp,#4]
mov lr, r0
pop {r0,r1,r2,pc}
.text
{$if not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
.code 32
{$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
end;
{$endif}
procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var
res : word;
begin
res:=0;
case sig of
SIGFPE :
begin
{ don't know how to find the different causes, maybe via xer? }
res := 207;
SysResetFPU;
end;
SIGILL:
{$ifdef FPC_SYSTEM_FPC_MOVE}
if in_edsp_test then
begin
res:=0;
cpu_has_edsp:=false;
inc(uContext^.uc_mcontext.arm_pc,4);
end
else
{$endif FPC_SYSTEM_FPC_MOVE}
res:=216;
SIGSEGV :
res:=216;
SIGBUS:
res:=214;
SIGINT:
res:=217;
SIGQUIT:
res:=233;
end;
{ give runtime error at the position where the signal was raised }
if res<>0 then
begin
ucontext^.uc_mcontext.arm_r0:=res;
ucontext^.uc_mcontext.arm_r1:=uContext^.uc_mcontext.arm_pc;
ucontext^.uc_mcontext.arm_r2:=uContext^.uc_mcontext.arm_fp;
{$if FPC_FULLVERSION >= 30200}
{$if not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
if (ucontext^.uc_mcontext.arm_cpsr and (1 shl 5))=0 then
begin
ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_ARM);
end
else
{$endif not(defined(CPUTHUMB)) and not(defined(CPUTHUMB2))}
begin
ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_Thumb);
end;
{$else}
ucontext^.uc_mcontext.arm_pc:=ptruint(@SignalToHandleErrorAddrFrame_ARM);
{$endif}
end;
end;
|
