Browse Source

+ If no unit is used, no symbol inside the system unit is used,
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 -

daniel 15 years ago
parent
commit
2139a229d3

+ 8 - 0
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}

+ 40 - 0
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.

+ 15 - 6
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;
 
 

+ 3 - 0
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]);

+ 11 - 0
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;

+ 3 - 0
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;

+ 38 - 12
rtl/linux/arm/sighnd.inc

@@ -15,37 +15,63 @@
 
  **********************************************************************}
 
+function signr_to_runerrornr(sig:longint;ucontext:Pucontext):word;
 
-procedure SignalToRunerror(Sig: longint; { _a2,_a3,_a4 : dword; } SigContext: PSigInfo; uContext : PuContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
-
-var
-  res : word;
 begin
-  res:=0;
+  signr_to_runerrornr:=0;
   case sig of
     SIGFPE :
         begin
           { don't know how to find the different causes, maybe via xer? }
-          res := 207;
+          signr_to_runerrornr := 207;
         end;
     SIGILL:
         if in_edsp_test then
           begin
-            res:=0;
+            signr_to_runerrornr:=0;
             cpu_has_edsp:=false;
             inc(uContext^.uc_mcontext.arm_pc,4);
           end
         else
-          res:=216;
+          signr_to_runerrornr:=216;
     SIGSEGV :
-        res:=216;
+        signr_to_runerrornr:=216;
     SIGBUS:
-        res:=214;
+        signr_to_runerrornr:=214;
     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
+  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:=signr_to_runerrornr(sig,ucontext);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   if res<>0 then

+ 47 - 17
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;
 
+
+

+ 47 - 18
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);
 

+ 41 - 15
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

+ 46 - 17
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;
-{$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;
+        FPE_FLTDIV : signr_to_runerrornr := 200;
+        FPE_FLTOVF : signr_to_runerrornr := 205;
+        FPE_FLTUND : signr_to_runerrornr := 206;
         else
-          res := 207;
+          signr_to_runerrornr := 207;
       end;
     SIGBUS :
-      res:=214;
+      signr_to_runerrornr:=214;
     SIGILL,
     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; 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}
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   if res<>0 then

+ 42 - 16
rtl/linux/powerpc64/sighnd.inc

@@ -15,34 +15,60 @@
 
  **********************************************************************}
 
-procedure SignalToRunerror(sig : longint; SigInfo: PSigInfo; context: PUContext); public name '_FPC_DEFAULTSIGHANDLER'; cdecl;
-var
-  res : word;
-begin
-  res:=0;
+function signr_to_runerrornr(sig:longint;siginfo:Psiginfo):word;
 
-  { exception flags are turned off by kernel }
-  fpc_enable_ppc_fpu_exceptions;
+begin
   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;
+        FPE_FLTDIV : signr_to_runerrornr := 200;
+        FPE_FLTOVF : signr_to_runerrornr := 205;
+        FPE_FLTUND : signr_to_runerrornr := 206;
         else
-          res := 207;
+          signr_to_runerrornr := 207;
       end;
     SIGBUS :
-      res:=214;
+      signr_to_runerrornr:=214;
     SIGILL,
     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; 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:=signr_to_runerrornr(sig,siginfo);
+
+  { exception flags are turned off by kernel }
+  fpc_enable_ppc_fpu_exceptions;
 
   { reenable signal }
   reenable_signal(sig);

+ 44 - 16
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

+ 38 - 7
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

+ 71 - 42
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;