paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-19 22:05:13 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ If no unit is used, no symbol inside the system unit is used,

Browse Source 
and no language features requiring initialization are used,
    do not initialize units, but just configure the fpu and
    signal handlers.

git-svn-id: trunk@16124 -
This commit is contained in:
daniel 2010-10-10 17:40:39 +00:00
parent f4ec65add8
commit 2139a229d3
15 changed files with 519 additions and 191 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/fmodule.pas
View File

@ -119,6 +119,8 @@ interface
in_global : boolean;
{ Whether a mode switch is still allowed at this point in the parsing.}
mode_switch_allowed,
{ Wether it is allowed to skip unit initializations to create a ultra tiny exe.}
micro_exe_allowed,
{ generate pic helper which loads eip in ecx (for leave procedures) }
requires_ecx_pic_helper,
{ generate pic helper which loads eip in ebx (for non leave procedures) }
@ -473,6 +475,12 @@ implementation
inherited create(n)
else
inherited create('Program');
{Program? Assume by default micro exe mode is possible:}
if target_info.system in systems_linux then
micro_exe_allowed:=not _is_unit {Only Linux rtl supports this a.t.m.}
else
micro_exe_allowed:=false;
mainsource:=stringdup(s);
{ Dos has the famous 8.3 limit :( }
{$ifdef shortasmprefix}

40
compiler/htypechk.pas
View File

@ -169,6 +169,8 @@ interface
procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
function check_micro_exe_forbidden_type(def:Tdef):boolean;
implementation
uses
@ -2770,5 +2772,43 @@ implementation
end;
end;
function check_micro_exe_forbidden_type(def:Tdef):boolean;
var i:longint;
begin
check_micro_exe_forbidden_type:=false;
case def.typ of
filedef:
with Tfiledef(def) do
if filetyp=ft_typed then
check_micro_exe_forbidden_type(typedfiledef);
variantdef:
check_micro_exe_forbidden_type:=true;
stringdef:
if Tstringdef(def).stringtype<>st_shortstring then
check_micro_exe_forbidden_type:=true;
recorddef,
objectdef:
begin
if is_class(def) then
check_micro_exe_forbidden_type:=true
else
with Tabstractrecorddef(def) do
for i:=0 to symtable.deflist.count-1 do
check_micro_exe_forbidden_type(Tdef(symtable.deflist[i]));
end;
arraydef:
check_micro_exe_forbidden_type(Tarraydef(def).elementdef);
orddef:
if Torddef(def).ordtype=uwidechar then
check_micro_exe_forbidden_type:=true;
procvardef:
with Tabstractprocdef(def) do
if paras<>nil then
for i:=0 to paras.count-1 do
check_micro_exe_forbidden_type(Tparavarsym(paras[i]).vardef);
end;
end;
end.

21
compiler/ncgutil.pas
View File

@ -2178,10 +2178,15 @@ implementation
begin
{ initialize units }
cg.allocallcpuregisters(list);
if not(current_module.islibrary) then
cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
{Micro exe mode: If at this point micro exe mode is still allowed
we do not initialize units, so no code is pulled in the exe.}
if not current_module.micro_exe_allowed then
if not(current_module.islibrary) then
cg.a_call_name(list,'FPC_INITIALIZEUNITS',false)
else
cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false)
else
cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
cg.a_call_name(list,'FPC_MICRO_INITIALIZE',false);
cg.deallocallcpuregisters(list);
end;
@ -2196,9 +2201,13 @@ implementation
procedure gen_exit_code(list:TAsmList);
begin
{ call __EXIT for main program }
if (not DLLsource) and
(current_procinfo.procdef.proctypeoption=potype_proginit) then
cg.a_call_name(list,'FPC_DO_EXIT',false);
if (not DLLsource) and (current_procinfo.procdef.proctypeoption=potype_proginit) then
{Micro exe mode: If at this point micro exe mode is still allowed
we call _haltproc directly, so no code is pulled in the exe.}
if current_module.micro_exe_allowed then
cg.a_call_name(list,'_haltproc',false)
else
cg.a_call_name(list,'FPC_DO_EXIT',false);
end;

3
compiler/pdecvar.pas
View File

@ -1248,6 +1248,9 @@ implementation
{$endif}
read_anon_type(hdef,false);
if current_module.micro_exe_allowed then
if check_micro_exe_forbidden_type(hdef) then
current_module.micro_exe_allowed:=false;
for i:=0 to sc.count-1 do
begin
vs:=tabstractvarsym(sc[i]);

11
compiler/pexpr.pas
View File

@ -267,6 +267,7 @@ implementation
in_new_x :
begin
current_module.micro_exe_allowed:=false;
if afterassignment or in_args then
statement_syssym:=new_function
else
@ -275,6 +276,7 @@ implementation
in_dispose_x :
begin
current_module.micro_exe_allowed:=false;
statement_syssym:=new_dispose_statement(false);
end;
@ -676,6 +678,7 @@ implementation
in_readln_x,
in_readstr_x:
begin
current_module.micro_exe_allowed:=false;
if try_to_consume(_LKLAMMER) then
begin
paras:=parse_paras(false,false,_RKLAMMER);
@ -724,6 +727,7 @@ implementation
in_writeln_x,
in_writestr_x :
begin
current_module.micro_exe_allowed:=false;
if try_to_consume(_LKLAMMER) then
begin
paras:=parse_paras(true,false,_RKLAMMER);
@ -867,6 +871,9 @@ implementation
afterassignment:=false;
membercall:=false;
aprocdef:=nil;
if st.moduleid<>current_module.moduleid then
current_module.micro_exe_allowed:=false;
{ when it is a call to a member we need to load the
methodpointer first
@ -2753,6 +2760,10 @@ implementation
updatefpos:=updatefpos or nodechanged;
end;
if current_module.micro_exe_allowed then
if check_micro_exe_forbidden_type(p1.resultdef) then
current_module.micro_exe_allowed:=false;
if assigned(p1) and
updatefpos then
p1.fileinfo:=filepos;

3
compiler/pmodules.pas
View File

@ -744,6 +744,9 @@ implementation
hp2 : tmodule;
unitsym : tunitsym;
begin
{If you use units, you likely need unit initializations.}
current_module.micro_exe_allowed:=false;
consume(_USES);
repeat
s:=pattern;

76
rtl/linux/arm/sighnd.inc
View File

@ -15,37 +15,63 @@
**********************************************************************}
function signr_to_runerrornr(sig:longint;ucontext:Pucontext):word;
begin
signr_to_runerrornr:=0;
case sig of
SIGFPE :
begin
{ don't know how to find the different causes, maybe via xer? }
signr_to_runerrornr := 207;
end;
SIGILL:
if in_edsp_test then
begin
signr_to_runerrornr:=0;
cpu_has_edsp:=false;
inc(uContext^.uc_mcontext.arm_pc,4);
end
else
signr_to_runerrornr:=216;
SIGSEGV :
signr_to_runerrornr:=216;
SIGBUS:
signr_to_runerrornr:=214;
SIGINT:
signr_to_runerrornr:=217;
SIGQUIT:
signr_to_runerrornr:=233;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);cdecl;
var
res : word;
s:string[5];
begin
exitcode:=signr_to_runerrornr(sig,ucontext);
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(longint(ucontext^.uc_mcontext.arm_pc),8)+ {typecast to longint to prevent pulling in int64 support}
lineending);
haltproc(exitcode);
end;
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;
end;
SIGILL:
if in_edsp_test then
begin
res:=0;
cpu_has_edsp:=false;
inc(uContext^.uc_mcontext.arm_pc,4);
end
else
res:=216;
SIGSEGV :
res:=216;
SIGBUS:
res:=214;
SIGINT:
res:=217;
SIGQUIT:
res:=233;
end;
res:=signr_to_runerrornr(sig,ucontext);
reenable_signal(sig);
{ give runtime error at the position where the signal was raised }
if res<>0 then

64
rtl/linux/i386/sighnd.inc
View File

@ -16,17 +16,18 @@
**********************************************************************}
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var
res,fpustate : word;
function signr_to_runerrornr(sig:longint;ucontext:Pucontext):word;
var fpustate:word;
begin
res:=0;
signr_to_runerrornr:=0;
case sig of
SIGFPE :
begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
res:=200;
signr_to_runerrornr:=200;
if assigned(ucontext^.uc_mcontext.fpstate) then
begin
FpuState:=ucontext^.uc_mcontext.fpstate^.sw;
@ -34,40 +35,67 @@ begin
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
signr_to_runerrornr:=200
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow or FPU_Invalid))<>0 Then
res:=207
signr_to_runerrornr:=207
else if (FpuState and FPU_Overflow)<>0 then
res:=205
signr_to_runerrornr:=205
else if (FpuState and FPU_Underflow)<>0 then
res:=206
signr_to_runerrornr:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
signr_to_runerrornr:=216
else
res:=207; {'Coprocessor Error'}
signr_to_runerrornr:=207; {'Coprocessor Error'}
end;
with ucontext^.uc_mcontext.fpstate^ do
sw:=sw and not FPU_ExceptionMask;
end;
end;
SIGBUS:
res:=214;
signr_to_runerrornr:=214;
SIGILL:
if sse_check then
begin
os_supports_sse:=false;
res:=0;
signr_to_runerrornr:=0;
inc(ucontext^.uc_mcontext.eip,3);
end
else
res:=216;
signr_to_runerrornr:=216;
SIGSEGV :
res:=216;
signr_to_runerrornr:=216;
SIGINT:
res:=217;
signr_to_runerrornr:=217;
SIGQUIT:
res:=233;
signr_to_runerrornr:=233;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);cdecl;
var
s:string[5];
begin
exitcode:=signr_to_runerrornr(sig,ucontext);
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(longint(ucontext^.uc_mcontext.eip),8)+ {typecast to longint to prevent pulling in int64 support}
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var
res : word;
begin
res:=signr_to_runerrornr(sig,ucontext);
reenable_signal(sig);
{ give runtime error at the position where the signal was raised }
if res<>0 then
@ -79,3 +107,5 @@ begin
end;
end;

65
rtl/linux/m68k/sighnd.inc
View File

@ -63,49 +63,78 @@ begin
end;
function signr_to_runerrornr(sig:longint;var sigcontext:Tsigcontext):word;
var fpustate:word;
procedure SignalToRunerror(Sig: longint; Info : pointer; var SigContext: TSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var
res,fpustate : word;
begin
res:=0;
signr_to_runerrornr:=0;
case sig of
SIGFPE :
begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
res:=200;
begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
signr_to_runerrornr:=200;
fpustate:=GetFPUState(SigContext);
if (FpuState and FPU_All) <> 0 then
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
signr_to_runerrornr:=200
else if (FpuState and FPU_Overflow)<>0 then
res:=205
signr_to_runerrornr:=205
else if (FpuState and FPU_Underflow)<>0 then
res:=206
signr_to_runerrornr:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
signr_to_runerrornr:=216
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 then
res:=207
signr_to_runerrornr:=207
else if (FpuState and FPU_Invalid)<>0 then
res:=216
signr_to_runerrornr:=216
else
res:=207; {'Coprocessor Error'}
signr_to_runerrornr:=207; {'Coprocessor Error'}
end;
ResetFPU;
end;
SIGILL,
SIGBUS,
SIGSEGV :
res:=216;
signr_to_runerrornr:=216;
SIGINT:
res:=217;
signr_to_runerrornr:=217;
SIGQUIT:
res:=233;
signr_to_runerrornr:=233;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo;var SigContext: TSigcontext);cdecl;
var
s:string[5];
addr:pointer;
begin
addr:=nil;
exitcode:=signr_to_runerrornr(sig,sigcontext);
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(longint(addr),8)+ {typecast to longint to prevent pulling in int64 support}
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(Sig: longint; Info : pointer; var SigContext: TSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var
res : word;
begin
res:=signr_to_runerrornr(sig,SigContext);
reenable_signal(sig);

56
rtl/linux/mips/sighnd.inc
View File

@ -25,36 +25,32 @@ const
FPE_FLTINV = 7;
FPE_FLTSUB = 8;
function signr_to_runerrornr(sig:longint;siginfo:Psiginfo;var addr:pointer):word;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
var
res : word;
addr : pointer;
begin
res:=0;
addr:=nil;
signr_to_runerrornr:=0;
case sig of
SIGFPE :
begin
addr := siginfo^._sifields._sigfault.si_addr;
res := 207;
signr_to_runerrornr := 207;
case siginfo^.si_code of
FPE_INTDIV:
res:=200;
signr_to_runerrornr:=200;
FPE_INTOVF:
res:=205;
signr_to_runerrornr:=205;
FPE_FLTDIV:
res:=200;
signr_to_runerrornr:=200;
FPE_FLTOVF:
res:=205;
signr_to_runerrornr:=205;
FPE_FLTUND:
res:=206;
signr_to_runerrornr:=206;
FPE_FLTRES,
FPE_FLTINV,
FPE_FLTSUB:
res:=216;
signr_to_runerrornr:=216;
else
res:=207;
signr_to_runerrornr:=207;
end;
end;
SIGILL,
@ -62,9 +58,39 @@ begin
SIGSEGV :
begin
addr := siginfo^._sifields._sigfault.si_addr;
res:=216;
signr_to_runerrornr:=216;
end;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; UContext: Pucontext);cdecl;
var
s:string[5];
begin
addr:=nil;
exitcode:=signr_to_runerrornr(sig,siginfo,addr);
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(longint(ucontext^.uc_mcontext.eip),8)+ {typecast to longint to prevent pulling in int64 support}
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
var
res : word;
addr : pointer;
begin
addr:=nil;
res:=signr_to_runerrornr(sig,siginfo,addr);
reenable_signal(sig);
{ give runtime error at the position where the signal was raised }
if res<>0 then

77
rtl/linux/powerpc/sighnd.inc
View File

@ -15,35 +15,64 @@
**********************************************************************}
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var
res : word;
{ fpustate: longint; }
function signr_to_runerrornr(sig:longint;siginfo:Psiginfo):word;
begin
res:=0;
case sig of
SIGFPE :
case (SigInfo^.si_code) of
FPE_FLTDIV : signr_to_runerrornr := 200;
FPE_FLTOVF : signr_to_runerrornr := 205;
FPE_FLTUND : signr_to_runerrornr := 206;
else
signr_to_runerrornr := 207;
end;
SIGBUS :
signr_to_runerrornr:=214;
SIGILL,
SIGSEGV :
signr_to_runerrornr:=216;
SIGINT:
signr_to_runerrornr:=217;
SIGQUIT:
signr_to_runerrornr:=233;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; context: Pucontext);cdecl;
var
s:string[5];
begin
exitcode:=signr_to_runerrornr(sig,siginfo);
{$ifndef FPUNONE}
{ exception flags are turned off by kernel }
fpc_enable_ppc_fpu_exceptions;
{$endif}
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(longint(context^.uc_mcontext.pt_regs^.nip),8)+ {typecast to longint to prevent pulling in int64 support}
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var
res : word;
begin
res:=signr_to_runerrornr(sig,siginfo);
{$ifndef FPUNONE}
{ exception flags are turned off by kernel }
fpc_enable_ppc_fpu_exceptions;
{$endif}
case sig of
SIGFPE :
case (SigInfo^.si_code) of
FPE_FLTDIV : res := 200;
FPE_FLTOVF : res := 205;
FPE_FLTUND : res := 206;
else
res := 207;
end;
SIGBUS :
res:=214;
SIGILL,
SIGSEGV :
res:=216;
SIGINT:
res:=217;
SIGQUIT:
res:=233;
end;
reenable_signal(sig);
{ give runtime error at the position where the signal was raised }
if res<>0 then

68
rtl/linux/powerpc64/sighnd.inc
View File

@ -15,34 +15,60 @@
**********************************************************************}
function signr_to_runerrornr(sig:longint;siginfo:Psiginfo):word;
begin
case sig of
SIGFPE :
case (SigInfo^.si_code) of
FPE_FLTDIV : signr_to_runerrornr := 200;
FPE_FLTOVF : signr_to_runerrornr := 205;
FPE_FLTUND : signr_to_runerrornr := 206;
else
signr_to_runerrornr := 207;
end;
SIGBUS :
signr_to_runerrornr:=214;
SIGILL,
SIGSEGV :
signr_to_runerrornr:=216;
SIGINT:
signr_to_runerrornr:=217;
SIGQUIT:
signr_to_runerrornr:=233;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; context: Pucontext);cdecl;
var
s:string[5];
begin
exitcode:=signr_to_runerrornr(sig,siginfo);
{ exception flags are turned off by kernel }
fpc_enable_ppc_fpu_exceptions;
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(context^.uc_mcontext.gp_regs[PT_NIP],16)+
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var
res : word;
begin
res:=0;
res:=signr_to_runerrornr(sig,siginfo);
{ exception flags are turned off by kernel }
fpc_enable_ppc_fpu_exceptions;
case sig of
SIGFPE :
{ distuingish between different FPU exceptions }
case (SigInfo^.si_code) of
FPE_FLTDIV : res := 200;
FPE_FLTOVF : res := 205;
FPE_FLTUND : res := 206;
else
res := 207;
end;
SIGBUS :
res:=214;
SIGILL,
SIGSEGV :
res:=216;
SIGINT:
res:=217;
SIGQUIT:
res:=233;
end;
{ reenable signal }
reenable_signal(sig);

60
rtl/linux/sparc/sighnd.inc
View File

@ -15,48 +15,76 @@
**********************************************************************}
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var
res : word;
addr : pointer;
function signr_to_runerrornr(sig:longint;siginfo:Psiginfo;var addr:pointer):word;
begin
res:=0;
addr:=nil;
signr_to_runerrornr:=0;
case sig of
SIGFPE :
begin
addr := siginfo^._sifields._sigfault._addr;
case siginfo^.si_code of
FPE_INTDIV:
res:=200;
signr_to_runerrornr:=200;
FPE_INTOVF:
res:=205;
signr_to_runerrornr:=205;
FPE_FLTDIV:
res:=200;
signr_to_runerrornr:=200;
FPE_FLTOVF:
res:=205;
signr_to_runerrornr:=205;
FPE_FLTUND:
res:=206;
signr_to_runerrornr:=206;
else
res:=207;
signr_to_runerrornr:=207;
end;
end;
SIGBUS :
begin
addr := siginfo^._sifields._sigfault._addr;
res:=214;
signr_to_runerrornr:=214;
end;
SIGILL,
SIGSEGV :
begin
addr := siginfo^._sifields._sigfault._addr;
res:=216;
signr_to_runerrornr:=216;
end;
SIGINT:
res:=217;
signr_to_runerrornr:=217;
SIGQUIT:
res:=233;
signr_to_runerrornr:=233;
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; SigContext: PSigcontext);cdecl;
var
s:string[5];
addr:pointer;
begin
addr:=nil;
exitcode:=signr_to_runerrornr(sig,siginfo,addr);
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(longint(addr),8)+ {typecast to longint to prevent pulling in int64 support}
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);public name '_FPC_DEFAULTSIGHANDLER';cdecl;
var
res : word;
addr : pointer;
begin
addr:=nil;
res:=signr_to_runerrornr(sig,siginfo,addr);
reenable_signal(sig);
{ give runtime error at the position where the signal was raised }
if res<>0 then

45
rtl/linux/system.pp
View File

@ -212,6 +212,13 @@ begin
get_cmdline:=calculated_cmdline;
end;
procedure write_micro(const s:shortstring);
begin
fpsyscall(syscall_nr_write,Tsysparam(1),Tsysparam(@s[1]),Tsysparam(length(s)));
end;
{*****************************************************************************
SystemUnit Initialization
*****************************************************************************}
@ -240,7 +247,7 @@ end;
{$i sighnd.inc}
procedure InstallDefaultSignalHandler(signum: longint; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
procedure InstallDefaultSignalHandler(signum: longint; sighandler: SigActionHandler; out oldact: SigActionRec); public name '_FPC_INSTALLDEFAULTSIGHANDLER';
var
act: SigActionRec;
begin
@ -248,7 +255,7 @@ begin
{ all flags and information set to zero }
FillChar(act, sizeof(SigActionRec),0);
{ initialize handler }
act.sa_handler := SigActionHandler(@SignalToRunError);
act.sa_handler := sighandler;
act.sa_flags:=SA_SIGINFO;
FpSigAction(signum,@act,@oldact);
end;
@ -259,12 +266,20 @@ var
oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
Procedure InstallSignals;
procedure InstallSignals;
begin
InstallDefaultSignalHandler(SIGFPE,oldsigfpe);
InstallDefaultSignalHandler(SIGSEGV,oldsigsegv);
InstallDefaultSignalHandler(SIGBUS,oldsigbus);
InstallDefaultSignalHandler(SIGILL,oldsigill);
InstallDefaultSignalHandler(SIGFPE,SigActionHandler(@SignalToRunerror),oldsigfpe);
InstallDefaultSignalHandler(SIGSEGV,SigActionHandler(@SignalToRunerror),oldsigsegv);
InstallDefaultSignalHandler(SIGBUS,SigActionHandler(@SignalToRunerror),oldsigbus);
InstallDefaultSignalHandler(SIGILL,SigActionHandler(@SignalToRunerror),oldsigill);
end;
procedure InstallSignals_microexe;
begin
InstallDefaultSignalHandler(SIGFPE,SigActionHandler(@SignalToAbort),oldsigfpe);
InstallDefaultSignalHandler(SIGSEGV,SigActionHandler(@SignalToAbort),oldsigsegv);
InstallDefaultSignalHandler(SIGBUS,SigActionHandler(@SignalToAbort),oldsigbus);
InstallDefaultSignalHandler(SIGILL,SigActionHandler(@SignalToAbort),oldsigill);
end;
procedure SysInitStdIO;
@ -329,6 +344,22 @@ begin
result := stklen;
end;
procedure micro_init;public name 'FPC_MICRO_INITIALIZE';
begin
{$ifndef FPUNONE}
SysResetFPU;
SysInitFPU;
{$if defined(cpupowerpc)}
// some PPC kernels set the exception bits FE0/FE1 in the MSR to zero,
// disabling all FPU exceptions. Enable them again.
fpprctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE);
{$endif}
{$endif}
{ Set up signals handlers (may be needed by init code to test cpu features) }
InstallSignals_microexe;
end;
var
initialstkptr : Pointer;external name '__stkptr';
begin

113
rtl/linux/x86_64/sighnd.inc
View File

@ -32,50 +32,79 @@ function GetFPUState(const SigContext : TSigContext) : word;
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var
res,fpustate : word;
begin
res:=0;
case sig of
SIGFPE :
begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
res:=200;
fpustate:=GetFPUState(SigContext^);
if (FpuState and FPU_All) <> 0 then
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
res:=200
else if (FpuState and FPU_Overflow)<>0 then
res:=205
else if (FpuState and FPU_Underflow)<>0 then
res:=206
else if (FpuState and FPU_Denormal)<>0 then
res:=216
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 Then
res:=207
else if (FpuState and FPU_Invalid)<>0 then
res:=216
else
res:=207; {'Coprocessor Error'}
end;
SysResetFPU;
end;
SIGILL,
SIGBUS,
SIGSEGV:
res:=216;
function signr_to_runerrornr(sig:longint;context:Psigcontext):word;
var fpustate:word;
begin
signr_to_runerrornr:=0;
case sig of
SIGFPE :
begin
{ this is not allways necessary but I don't know yet
how to tell if it is or not PM }
signr_to_runerrornr:=200;
fpustate:=GetFPUState(context^);
if (FpuState and FPU_All) <> 0 then
begin
{ first check the more precise options }
if (FpuState and FPU_DivisionByZero)<>0 then
signr_to_runerrornr:=200
else if (FpuState and FPU_Overflow)<>0 then
signr_to_runerrornr:=205
else if (FpuState and FPU_Underflow)<>0 then
signr_to_runerrornr:=206
else if (FpuState and FPU_Denormal)<>0 then
signr_to_runerrornr:=216
else if (FpuState and (FPU_StackOverflow or FPU_StackUnderflow))<>0 Then
signr_to_runerrornr:=207
else if (FpuState and FPU_Invalid)<>0 then
signr_to_runerrornr:=216
else
signr_to_runerrornr:=207; {'Coprocessor Error'}
end;
SysResetFPU;
end;
SIGILL,
SIGBUS,
SIGSEGV:
signr_to_runerrornr:=216;
SIGINT:
res:=217;
signr_to_runerrornr:=217;
SIGQUIT:
res:=233;
signr_to_runerrornr:=233;
end;
reenable_signal(sig);
if res<>0 then
HandleErrorAddrFrame(res,pointer(SigContext^.rip),pointer(SigContext^.rbp));
end;
end;
procedure SignalToAbort(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext);cdecl;
var
s:string[5];
begin
exitcode:=signr_to_runerrornr(sig,sigcontext);
reenable_signal(sig);
{I had written a small stack dumper, but decided to remove it, because programs that
activate the microexe mode are most likely exe size benchmarks. In the case they are not
they are likely so primitive that it is unlikely that they require a stackdump to debug.
dump_stack_micro(pointer(ucontext^.uc_mcontext.eip));}
{Write runtime error message.}
int_str(exitcode,s); {int_str instead of str pulls in less code}
write_micro('Runtime error '+s+' at $'+
hexstr(sigcontext^.rip,16)+
lineending);
haltproc(exitcode);
end;
procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; SigContext: PSigContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
var
res,fpustate : word;
begin
res:=signr_to_runerrornr(sig,SigContext);
reenable_signal(sig);
if res<>0 then
HandleErrorAddrFrame(res,pointer(SigContext^.rip),pointer(SigContext^.rbp));
end;