浏览代码

+ 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 年之前
父节点
当前提交
2139a229d3

+ 8 - 0
compiler/fmodule.pas

@@ -119,6 +119,8 @@ interface
         in_global     : boolean;
         in_global     : boolean;
         { Whether a mode switch is still allowed at this point in the parsing.}
         { Whether a mode switch is still allowed at this point in the parsing.}
         mode_switch_allowed,
         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) }
         { generate pic helper which loads eip in ecx (for leave procedures) }
         requires_ecx_pic_helper,
         requires_ecx_pic_helper,
         { generate pic helper which loads eip in ebx (for non leave procedures) }
         { generate pic helper which loads eip in ebx (for non leave procedures) }
@@ -473,6 +475,12 @@ implementation
          inherited create(n)
          inherited create(n)
         else
         else
          inherited create('Program');
          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);
         mainsource:=stringdup(s);
         { Dos has the famous 8.3 limit :( }
         { Dos has the famous 8.3 limit :( }
 {$ifdef shortasmprefix}
 {$ifdef shortasmprefix}

+ 40 - 0
compiler/htypechk.pas

@@ -169,6 +169,8 @@ interface
 
 
     procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
     procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef);
 
 
+    function check_micro_exe_forbidden_type(def:Tdef):boolean;
+
 implementation
 implementation
 
 
     uses
     uses
@@ -2770,5 +2772,43 @@ implementation
          end;
          end;
       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.
 end.

+ 15 - 6
compiler/ncgutil.pas

@@ -2178,10 +2178,15 @@ implementation
          begin
          begin
            { initialize units }
            { initialize units }
            cg.allocallcpuregisters(list);
            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
            else
-             cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false);
+               cg.a_call_name(list,'FPC_MICRO_INITIALIZE',false);
            cg.deallocallcpuregisters(list);
            cg.deallocallcpuregisters(list);
          end;
          end;
 
 
@@ -2196,9 +2201,13 @@ implementation
     procedure gen_exit_code(list:TAsmList);
     procedure gen_exit_code(list:TAsmList);
       begin
       begin
         { call __EXIT for main program }
         { 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;
       end;
 
 
 
 

+ 3 - 0
compiler/pdecvar.pas

@@ -1248,6 +1248,9 @@ implementation
 {$endif}
 {$endif}
 
 
              read_anon_type(hdef,false);
              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
              for i:=0 to sc.count-1 do
                begin
                begin
                  vs:=tabstractvarsym(sc[i]);
                  vs:=tabstractvarsym(sc[i]);

+ 11 - 0
compiler/pexpr.pas

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

+ 3 - 0
compiler/pmodules.pas

@@ -744,6 +744,9 @@ implementation
          hp2     : tmodule;
          hp2     : tmodule;
          unitsym : tunitsym;
          unitsym : tunitsym;
       begin
       begin
+         {If you use units, you likely need unit initializations.}
+         current_module.micro_exe_allowed:=false;
+         
          consume(_USES);
          consume(_USES);
          repeat
          repeat
            s:=pattern;
            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
 begin
-  res:=0;
+  signr_to_runerrornr:=0;
   case sig of
   case sig of
     SIGFPE :
     SIGFPE :
         begin
         begin
           { don't know how to find the different causes, maybe via xer? }
           { don't know how to find the different causes, maybe via xer? }
-          res := 207;
+          signr_to_runerrornr := 207;
         end;
         end;
     SIGILL:
     SIGILL:
         if in_edsp_test then
         if in_edsp_test then
           begin
           begin
-            res:=0;
+            signr_to_runerrornr:=0;
             cpu_has_edsp:=false;
             cpu_has_edsp:=false;
             inc(uContext^.uc_mcontext.arm_pc,4);
             inc(uContext^.uc_mcontext.arm_pc,4);
           end
           end
         else
         else
-          res:=216;
+          signr_to_runerrornr:=216;
     SIGSEGV :
     SIGSEGV :
-        res:=216;
+        signr_to_runerrornr:=216;
     SIGBUS:
     SIGBUS:
-        res:=214;
+        signr_to_runerrornr:=214;
     SIGINT:
     SIGINT:
-        res:=217;
+        signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+        signr_to_runerrornr:=233;
   end;
   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);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }
   if res<>0 then
   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
 begin
-  res:=0;
+  signr_to_runerrornr:=0;
   case sig of
   case sig of
     SIGFPE :
     SIGFPE :
       begin
       begin
         { this is not allways necessary but I don't know yet
         { this is not allways necessary but I don't know yet
           how to tell if it is or not PM }
           how to tell if it is or not PM }
-        res:=200;
+        signr_to_runerrornr:=200;
         if assigned(ucontext^.uc_mcontext.fpstate) then
         if assigned(ucontext^.uc_mcontext.fpstate) then
           begin
           begin
             FpuState:=ucontext^.uc_mcontext.fpstate^.sw;
             FpuState:=ucontext^.uc_mcontext.fpstate^.sw;
@@ -34,40 +35,67 @@ begin
               begin
               begin
                 { first check the more precise options }
                 { first check the more precise options }
                 if (FpuState and FPU_DivisionByZero)<>0 then
                 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
                 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
                 else if (FpuState and FPU_Overflow)<>0 then
-                  res:=205
+                  signr_to_runerrornr:=205
                 else if (FpuState and FPU_Underflow)<>0 then
                 else if (FpuState and FPU_Underflow)<>0 then
-                  res:=206
+                  signr_to_runerrornr:=206
                 else if (FpuState and FPU_Denormal)<>0 then
                 else if (FpuState and FPU_Denormal)<>0 then
-                  res:=216
+                  signr_to_runerrornr:=216
                 else
                 else
-                  res:=207;  {'Coprocessor Error'}
+                  signr_to_runerrornr:=207;  {'Coprocessor Error'}
               end;
               end;
             with ucontext^.uc_mcontext.fpstate^ do
             with ucontext^.uc_mcontext.fpstate^ do
               sw:=sw and not FPU_ExceptionMask;
               sw:=sw and not FPU_ExceptionMask;
           end;
           end;
       end;
       end;
     SIGBUS:
     SIGBUS:
-      res:=214;
+      signr_to_runerrornr:=214;
     SIGILL:
     SIGILL:
       if sse_check then
       if sse_check then
         begin
         begin
           os_supports_sse:=false;
           os_supports_sse:=false;
-          res:=0;
+          signr_to_runerrornr:=0;
           inc(ucontext^.uc_mcontext.eip,3);
           inc(ucontext^.uc_mcontext.eip,3);
         end
         end
       else
       else
-        res:=216;
+        signr_to_runerrornr:=216;
     SIGSEGV :
     SIGSEGV :
-      res:=216;
+      signr_to_runerrornr:=216;
     SIGINT:
     SIGINT:
-        res:=217;
+        signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+        signr_to_runerrornr:=233;
   end;
   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);
   reenable_signal(sig);
 { give runtime error at the position where the signal was raised }
 { give runtime error at the position where the signal was raised }
   if res<>0 then
   if res<>0 then
@@ -79,3 +107,5 @@ begin
   end;
   end;
 end;
 end;
 
 
+
+

+ 47 - 18
rtl/linux/m68k/sighnd.inc

@@ -63,49 +63,78 @@ begin
 end;
 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
 begin
-  res:=0;
+  signr_to_runerrornr:=0;
   case sig of
   case sig of
     SIGFPE :
     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);
           fpustate:=GetFPUState(SigContext);
 
 
           if (FpuState and FPU_All) <> 0 then
           if (FpuState and FPU_All) <> 0 then
             begin
             begin
               { first check the more precise options }
               { first check the more precise options }
               if (FpuState and FPU_DivisionByZero)<>0 then
               if (FpuState and FPU_DivisionByZero)<>0 then
-                res:=200
+                signr_to_runerrornr:=200
               else if (FpuState and FPU_Overflow)<>0 then
               else if (FpuState and FPU_Overflow)<>0 then
-                res:=205
+                signr_to_runerrornr:=205
               else if (FpuState and FPU_Underflow)<>0 then
               else if (FpuState and FPU_Underflow)<>0 then
-                res:=206
+                signr_to_runerrornr:=206
               else if (FpuState and FPU_Denormal)<>0 then
               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
               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
               else if (FpuState and FPU_Invalid)<>0 then
-                res:=216
+                signr_to_runerrornr:=216
               else
               else
-                res:=207;  {'Coprocessor Error'}
+                signr_to_runerrornr:=207;  {'Coprocessor Error'}
             end;
             end;
           ResetFPU;
           ResetFPU;
         end;
         end;
     SIGILL,
     SIGILL,
     SIGBUS,
     SIGBUS,
     SIGSEGV :
     SIGSEGV :
-        res:=216;
+        signr_to_runerrornr:=216;
     SIGINT:
     SIGINT:
-        res:=217;
+        signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+        signr_to_runerrornr:=233;
   end;
   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);
   reenable_signal(sig);
 
 

+ 41 - 15
rtl/linux/mips/sighnd.inc

@@ -25,36 +25,32 @@ const
   FPE_FLTINV = 7;
   FPE_FLTINV = 7;
   FPE_FLTSUB = 8;
   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
 begin
-  res:=0;
-  addr:=nil;
+  signr_to_runerrornr:=0;
   case sig of
   case sig of
     SIGFPE :
     SIGFPE :
         begin
         begin
           addr := siginfo^._sifields._sigfault.si_addr;
           addr := siginfo^._sifields._sigfault.si_addr;
-          res := 207;
+          signr_to_runerrornr := 207;
           case  siginfo^.si_code of
           case  siginfo^.si_code of
             FPE_INTDIV:
             FPE_INTDIV:
-              res:=200;
+              signr_to_runerrornr:=200;
             FPE_INTOVF:
             FPE_INTOVF:
-              res:=205;
+              signr_to_runerrornr:=205;
             FPE_FLTDIV:
             FPE_FLTDIV:
-              res:=200;
+              signr_to_runerrornr:=200;
             FPE_FLTOVF:
             FPE_FLTOVF:
-              res:=205;
+              signr_to_runerrornr:=205;
             FPE_FLTUND:
             FPE_FLTUND:
-              res:=206;
+              signr_to_runerrornr:=206;
             FPE_FLTRES,
             FPE_FLTRES,
             FPE_FLTINV,
             FPE_FLTINV,
             FPE_FLTSUB:
             FPE_FLTSUB:
-              res:=216;
+              signr_to_runerrornr:=216;
             else
             else
-              res:=207;
+              signr_to_runerrornr:=207;
           end;
           end;
         end;
         end;
     SIGILL,
     SIGILL,
@@ -62,9 +58,39 @@ begin
     SIGSEGV :
     SIGSEGV :
         begin
         begin
           addr := siginfo^._sifields._sigfault.si_addr;
           addr := siginfo^._sifields._sigfault.si_addr;
-          res:=216;
+          signr_to_runerrornr:=216;
         end;
         end;
   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);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }
   if res<>0 then
   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
 begin
-  res:=0;
-{$ifndef FPUNONE}
-  { exception flags are turned off by kernel }
-  fpc_enable_ppc_fpu_exceptions;
-{$endif}
   case sig of
   case sig of
     SIGFPE :
     SIGFPE :
       case (SigInfo^.si_code) of
       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
         else
-          res := 207;
+          signr_to_runerrornr := 207;
       end;
       end;
     SIGBUS :
     SIGBUS :
-      res:=214;
+      signr_to_runerrornr:=214;
     SIGILL,
     SIGILL,
     SIGSEGV :
     SIGSEGV :
-      res:=216;
+      signr_to_runerrornr:=216;
     SIGINT:
     SIGINT:
-        res:=217;
+      signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+      signr_to_runerrornr:=233;
   end;
   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);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }
   if res<>0 then
   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
   case sig of
     SIGFPE :
     SIGFPE :
-      { distuingish between different FPU exceptions }
       case (SigInfo^.si_code) of
       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
         else
-          res := 207;
+          signr_to_runerrornr := 207;
       end;
       end;
     SIGBUS :
     SIGBUS :
-      res:=214;
+      signr_to_runerrornr:=214;
     SIGILL,
     SIGILL,
     SIGSEGV :
     SIGSEGV :
-      res:=216;
+      signr_to_runerrornr:=216;
     SIGINT:
     SIGINT:
-        res:=217;
+      signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+      signr_to_runerrornr:=233;
   end;
   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 }
   reenable_signal(sig);
   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
 begin
-  res:=0;
-  addr:=nil;
+  signr_to_runerrornr:=0;
   case sig of
   case sig of
     SIGFPE :
     SIGFPE :
         begin
         begin
           addr := siginfo^._sifields._sigfault._addr;
           addr := siginfo^._sifields._sigfault._addr;
           case  siginfo^.si_code of
           case  siginfo^.si_code of
             FPE_INTDIV:
             FPE_INTDIV:
-              res:=200;
+              signr_to_runerrornr:=200;
             FPE_INTOVF:
             FPE_INTOVF:
-              res:=205;
+              signr_to_runerrornr:=205;
             FPE_FLTDIV:
             FPE_FLTDIV:
-              res:=200;
+              signr_to_runerrornr:=200;
             FPE_FLTOVF:
             FPE_FLTOVF:
-              res:=205;
+              signr_to_runerrornr:=205;
             FPE_FLTUND:
             FPE_FLTUND:
-              res:=206;
+              signr_to_runerrornr:=206;
             else
             else
-              res:=207;
+              signr_to_runerrornr:=207;
           end;
           end;
         end;
         end;
     SIGBUS :
     SIGBUS :
         begin
         begin
           addr := siginfo^._sifields._sigfault._addr;
           addr := siginfo^._sifields._sigfault._addr;
-          res:=214;
+          signr_to_runerrornr:=214;
         end;
         end;
     SIGILL,
     SIGILL,
     SIGSEGV :
     SIGSEGV :
         begin
         begin
           addr := siginfo^._sifields._sigfault._addr;
           addr := siginfo^._sifields._sigfault._addr;
-          res:=216;
+          signr_to_runerrornr:=216;
         end;
         end;
     SIGINT:
     SIGINT:
-        res:=217;
+        signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+        signr_to_runerrornr:=233;
   end;
   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);
   reenable_signal(sig);
   { give runtime error at the position where the signal was raised }
   { give runtime error at the position where the signal was raised }
   if res<>0 then
   if res<>0 then

+ 38 - 7
rtl/linux/system.pp

@@ -212,6 +212,13 @@ begin
   get_cmdline:=calculated_cmdline;
   get_cmdline:=calculated_cmdline;
 end;
 end;
 
 
+procedure write_micro(const s:shortstring);
+
+begin
+  fpsyscall(syscall_nr_write,Tsysparam(1),Tsysparam(@s[1]),Tsysparam(length(s)));
+end;
+
+
 {*****************************************************************************
 {*****************************************************************************
                          SystemUnit Initialization
                          SystemUnit Initialization
 *****************************************************************************}
 *****************************************************************************}
@@ -240,7 +247,7 @@ end;
 
 
 {$i sighnd.inc}
 {$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
 var
   act: SigActionRec;
   act: SigActionRec;
 begin
 begin
@@ -248,7 +255,7 @@ begin
   { all flags and information set to zero }
   { all flags and information set to zero }
   FillChar(act, sizeof(SigActionRec),0);
   FillChar(act, sizeof(SigActionRec),0);
   { initialize handler                    }
   { initialize handler                    }
-  act.sa_handler := SigActionHandler(@SignalToRunError);
+  act.sa_handler := sighandler;
   act.sa_flags:=SA_SIGINFO;
   act.sa_flags:=SA_SIGINFO;
   FpSigAction(signum,@act,@oldact);
   FpSigAction(signum,@act,@oldact);
 end;
 end;
@@ -259,12 +266,20 @@ var
   oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
   oldsigbus: SigActionRec; public name '_FPC_OLDSIGBUS';
   oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
   oldsigill: SigActionRec; public name '_FPC_OLDSIGILL';
 
 
-Procedure InstallSignals;
+procedure InstallSignals;
 begin
 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;
 end;
 
 
 procedure SysInitStdIO;
 procedure SysInitStdIO;
@@ -329,6 +344,22 @@ begin
     result := stklen;
     result := stklen;
 end;
 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
 var
   initialstkptr : Pointer;external name '__stkptr';
   initialstkptr : Pointer;external name '__stkptr';
 begin
 begin

+ 71 - 42
rtl/linux/x86_64/sighnd.inc

@@ -32,50 +32,79 @@ function GetFPUState(const SigContext : TSigContext) : word;
   end;
   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:
     SIGINT:
-        res:=217;
+      signr_to_runerrornr:=217;
     SIGQUIT:
     SIGQUIT:
-        res:=233;
+      signr_to_runerrornr:=233;
     end;
     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;