diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index c0b269c6b5..de64f05d9b 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -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} diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index dfff0dc3b4..ce04b7f7e7 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -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. diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 86d9b1faf7..81c669ea1d 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -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; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 1a266f020c..5d35fadff0 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -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]); diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 7062992c68..e739fd574c 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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; diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 457066e8ae..3b69f22973 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -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; diff --git a/rtl/linux/arm/sighnd.inc b/rtl/linux/arm/sighnd.inc index 53312a9b8f..1617379647 100644 --- a/rtl/linux/arm/sighnd.inc +++ b/rtl/linux/arm/sighnd.inc @@ -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 diff --git a/rtl/linux/i386/sighnd.inc b/rtl/linux/i386/sighnd.inc index a8df8ec0d0..b55c676d59 100644 --- a/rtl/linux/i386/sighnd.inc +++ b/rtl/linux/i386/sighnd.inc @@ -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; + + diff --git a/rtl/linux/m68k/sighnd.inc b/rtl/linux/m68k/sighnd.inc index fcc736926a..8f6b258524 100644 --- a/rtl/linux/m68k/sighnd.inc +++ b/rtl/linux/m68k/sighnd.inc @@ -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); diff --git a/rtl/linux/mips/sighnd.inc b/rtl/linux/mips/sighnd.inc index 16e87686e9..1e281889a1 100644 --- a/rtl/linux/mips/sighnd.inc +++ b/rtl/linux/mips/sighnd.inc @@ -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 diff --git a/rtl/linux/powerpc/sighnd.inc b/rtl/linux/powerpc/sighnd.inc index b69ab8018c..ebf425b8eb 100644 --- a/rtl/linux/powerpc/sighnd.inc +++ b/rtl/linux/powerpc/sighnd.inc @@ -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 diff --git a/rtl/linux/powerpc64/sighnd.inc b/rtl/linux/powerpc64/sighnd.inc index c654e97f45..0256675043 100644 --- a/rtl/linux/powerpc64/sighnd.inc +++ b/rtl/linux/powerpc64/sighnd.inc @@ -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); diff --git a/rtl/linux/sparc/sighnd.inc b/rtl/linux/sparc/sighnd.inc index cfbfc35149..3cafc8b40a 100644 --- a/rtl/linux/sparc/sighnd.inc +++ b/rtl/linux/sparc/sighnd.inc @@ -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 diff --git a/rtl/linux/system.pp b/rtl/linux/system.pp index 6508aa42ad..d52013c9d1 100644 --- a/rtl/linux/system.pp +++ b/rtl/linux/system.pp @@ -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 diff --git a/rtl/linux/x86_64/sighnd.inc b/rtl/linux/x86_64/sighnd.inc index cbab9aea05..d932154691 100644 --- a/rtl/linux/x86_64/sighnd.inc +++ b/rtl/linux/x86_64/sighnd.inc @@ -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;