Fix mcode for i386 Darwin.

9 files changed, 148 insertions, 56 deletions

diff --git a/evaluation.adb b/evaluation.adb
index f5b8870b7..5e47e8664 100644
--- a/evaluation.adb
+++ b/evaluation.adb
@@ -1188,7 +1188,7 @@ package body Evaluation is
          return Null_Iir;
    end Eval_Dyadic_Operator;
 
-   --  Evaluate any array attribute
+   --  Evaluate any array attribute, return the type for the prefix.
    function Eval_Array_Attribute (Attr : Iir) return Iir
    is
       Prefix : Iir;
@@ -2461,6 +2461,9 @@ package body Evaluation is
                --  This linear search is O(n)!
                S := Find_Name_In_List (Literal_List,
                                        Name_Table.Get_Identifier (C));
+               if S = Null_Iir then
+                  return -1;
+               end if;
             when Iir_Kind_Bit_String_Literal =>
                C := Str.Ptr (Idx + 1);
                case C is
diff --git a/ortho/mcode/ortho_code-exprs.adb b/ortho/mcode/ortho_code-exprs.adb
index a98facf45..ecab78283 100644
--- a/ortho/mcode/ortho_code-exprs.adb
+++ b/ortho/mcode/ortho_code-exprs.adb
@@ -181,6 +181,11 @@ package body Ortho_Code.Exprs is
       return O_Dnode (Enodes.Table (Enode).Arg1);
    end Get_Call_Subprg;
 
+   function Get_Stack_Adjust (Enode : O_Enode) return Int32 is
+   begin
+      return Int32 (Enodes.Table (Enode).Arg1);
+   end Get_Stack_Adjust;
+
    function Get_Arg_Link (Enode : O_Enode) return O_Enode is
    begin
       return Enodes.Table (Enode).Arg2;
@@ -1231,7 +1236,7 @@ package body Ortho_Code.Exprs is
 
       New_Enode_Stmt (OE_Ret, Get_Type_Mode (V_Type), Value, O_Enode_Null);
       if not Flag_Debug_Hli then
-         Emit_Jmp (OE_Jump, O_Enode_Null, Cur_Subprg.Exit_Label);
+         New_Allocb_Jump (Cur_Subprg.Exit_Label);
       end if;
    end New_Return_Stmt;
 
@@ -1244,7 +1249,7 @@ package body Ortho_Code.Exprs is
       end if;
 
       if not Flag_Debug_Hli then
-         Emit_Jmp (OE_Jump, O_Enode_Null, Cur_Subprg.Exit_Label);
+         New_Allocb_Jump (Cur_Subprg.Exit_Label);
       else
          New_Enode_Stmt (OE_Ret, Mode_Nil, O_Enode_Null, O_Enode_Null);
       end if;
diff --git a/ortho/mcode/ortho_code-exprs.ads b/ortho/mcode/ortho_code-exprs.ads
index 5c7da6199..9bd4596d7 100644
--- a/ortho/mcode/ortho_code-exprs.ads
+++ b/ortho/mcode/ortho_code-exprs.ads
@@ -111,11 +111,14 @@ package Ortho_Code.Exprs is
       --  ARG1 is subprogram
       --  ARG2 is arguments.
       OE_Call,
-      --  ARG1 is the subprogram.
-      OE_Setup_Frame,
       --  ARG1 is intrinsic operation.
       OE_Intrinsic,
 
+      --  Modify the stack pointer value, to align the stack before pushing
+      --  arguments, or to free the stack.
+      --  ARG1 is the signed offset.
+      OE_Stack_Adjust,
+
       --  Return ARG1 (if not mode_nil) from current subprogram.
       --  ARG1: expression.
       OE_Ret,
@@ -326,6 +329,12 @@ package Ortho_Code.Exprs is
    function Get_Addrl_Frame (Enode : O_Enode) return O_Enode;
    procedure Set_Addrl_Frame (Enode : O_Enode; Frame : O_Enode);
 
+   --  Return the stack adjustment. For positive values, this is the amount of
+   --  bytes to allocate on the stack before pushing arguments, so that the
+   --  stack pointer stays aligned. For negtive values, this is the amount of
+   --  bytes to release on the stack.
+   function Get_Stack_Adjust (Enode : O_Enode) return Int32;
+
    --  Get the subprogram called by ENODE.
    function Get_Call_Subprg (Enode : O_Enode) return O_Dnode;
 
diff --git a/ortho/mcode/ortho_code-x86-abi.adb b/ortho/mcode/ortho_code-x86-abi.adb
index a915f9235..99b75e945 100644
--- a/ortho/mcode/ortho_code-x86-abi.adb
+++ b/ortho/mcode/ortho_code-x86-abi.adb
@@ -463,6 +463,10 @@ package body Ortho_Code.X86.Abi is
             end if;
             Disp_Decl_Name (Get_Call_Subprg (Stmt));
             New_Line;
+         when OE_Stack_Adjust =>
+            Put ("  stack_adjust: ");
+            Put (Int32'Image (Get_Stack_Adjust (Stmt)));
+            New_Line;
          when OE_Intrinsic =>
             Disp_Reg_Op_Name ("intrinsic");
             --Disp_Decl_Name (Get_Call_Subprg (Stmt));
diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb
index 4a9040190..12f1587b0 100644
--- a/ortho/mcode/ortho_code-x86-emits.adb
+++ b/ortho/mcode/ortho_code-x86-emits.adb
@@ -792,20 +792,28 @@ package body Ortho_Code.X86.Emits is
 
    procedure Emit_Setup_Frame (Stmt : O_Enode)
    is
-      use Ortho_Code.Decls;
-      Subprg : O_Dnode;
-      Val : Unsigned_32;
+      Val : constant Int32 := Get_Stack_Adjust (Stmt);
    begin
-      Subprg := Get_Call_Subprg (Stmt);
-      Val := Unsigned_32 (Get_Subprg_Stack (Subprg));
-      --  Pad the stack if necessary.
-      Val := Val and (Flags.Stack_Boundary - 1);
-      if Val /= 0 then
+      if Val > 0 then
          Start_Insn;
          --  subl esp, val
          Gen_B8 (2#100000_11#);
          Gen_B8 (2#11_101_100#);
-         Gen_B8 (Byte (Flags.Stack_Boundary - Val));
+         Gen_B8 (Byte (Val));
+         End_Insn;
+      elsif Val < 0 then
+         Start_Insn;
+         if -Val <= 127 then
+            --  addl esp, val
+            Gen_B8 (2#100000_11#);
+            Gen_B8 (2#11_000_100#);
+            Gen_B8 (Byte (-Val));
+         else
+            --  addl esp, val
+            Gen_B8 (2#100000_01#);
+            Gen_B8 (2#11_000_100#);
+            Gen_Le32 (Unsigned_32 (-Val));
+         end if;
          End_Insn;
       end if;
    end Emit_Setup_Frame;
@@ -815,29 +823,10 @@ package body Ortho_Code.X86.Emits is
       use Ortho_Code.Decls;
       Subprg : O_Dnode;
       Sym : Symbol;
-      Val : Unsigned_32;
    begin
       Subprg := Get_Call_Subprg (Stmt);
       Sym := Get_Decl_Symbol (Subprg);
       Gen_Call (Sym);
-      Val := Unsigned_32 (Get_Subprg_Stack (Subprg));
-      Val := (Val + Flags.Stack_Boundary - 1)
-        and not (Flags.Stack_Boundary - 1);
-      if Val /= 0 then
-         Start_Insn;
-         if Val <= 127 then
-            --  addl esp, val
-            Gen_B8 (2#100000_11#);
-            Gen_B8 (2#11_000_100#);
-            Gen_B8 (Byte (Val));
-         else
-            --  addl esp, val
-            Gen_B8 (2#100000_01#);
-            Gen_B8 (2#11_000_100#);
-            Gen_Le32 (Val);
-         end if;
-         End_Insn;
-      end if;
    end Emit_Call;
 
    procedure Emit_Intrinsic (Stmt : O_Enode)
@@ -1853,12 +1842,8 @@ package body Ortho_Code.X86.Emits is
                when others =>
                   Error_Emit ("emit_insn: oe_arg", Stmt);
             end case;
-         when OE_Setup_Frame =>
-            pragma Warnings (Off);
-            if Flags.Stack_Boundary > 4 then
-               Emit_Setup_Frame (Stmt);
-            end if;
-            pragma Warnings (On);
+         when OE_Stack_Adjust =>
+            Emit_Setup_Frame (Stmt);
          when OE_Call =>
             Emit_Call (Stmt);
          when OE_Intrinsic =>
@@ -2007,7 +1992,11 @@ package body Ortho_Code.X86.Emits is
       Frame_Size : Unsigned_32;
       Saved_Regs_Size : Unsigned_32;
    begin
+      --  Switch to .text section and align the function (to avoid the nested
+      --  function trick and for performance).
       Set_Current_Section (Sect_Text);
+      Gen_Pow_Align (2);
+
       Subprg_Decl := Subprg.D_Decl;
       Sym := Get_Decl_Symbol (Subprg_Decl);
       case Get_Decl_Storage (Subprg_Decl) is
diff --git a/ortho/mcode/ortho_code-x86-insns.adb b/ortho/mcode/ortho_code-x86-insns.adb
index d3ea79233..9ef638505 100644
--- a/ortho/mcode/ortho_code-x86-insns.adb
+++ b/ortho/mcode/ortho_code-x86-insns.adb
@@ -15,6 +15,7 @@
 --  along with GCC; see the file COPYING.  If not, write to the Free
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
+with Interfaces;
 with Ada.Text_IO;
 with Ortho_Code.Abi;
 with Ortho_Code.Decls; use Ortho_Code.Decls;
@@ -72,6 +73,10 @@ package body Ortho_Code.X86.Insns is
    Stack_Offset : Uns32 := 0;
    Stack_Max : Uns32 := 0;
 
+   --  Count how many bytes have been pushed on the stack, during a call. This
+   --  is used to correctly align the stack for nested calls.
+   Push_Offset : Uns32 := 0;
+
    --  STMT is an OE_END statement.
    --  Swap Stack_Offset with Max_Stack of STMT.
    procedure Swap_Stack_Offset (Blk : O_Dnode)
@@ -1004,15 +1009,30 @@ package body Ortho_Code.X86.Insns is
    function Gen_Call (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
                      return O_Enode
    is
+      use Interfaces;
       Left : O_Enode;
       Reg_Res : O_Reg;
+      Subprg : O_Dnode;
+      Push_Size : Uns32;
+      Pad : Uns32;
+      Res_Stmt : O_Enode;
    begin
-      Link_Stmt
-        (New_Enode (OE_Setup_Frame, Mode_Nil, O_Tnode_Null,
-                    O_Enode (Get_Call_Subprg (Stmt)), O_Enode_Null));
+      --  Emit Setup_Frame (to align stack).
+      Subprg := Get_Call_Subprg (Stmt);
+      Push_Size := Uns32 (Get_Subprg_Stack (Subprg));
+      --  Pad the stack if necessary.
+      Pad := (Push_Size + Push_Offset) and Uns32 (Flags.Stack_Boundary - 1);
+      if Pad /= 0 then
+         Pad := Uns32 (Flags.Stack_Boundary) - Pad;
+         Link_Stmt (New_Enode (OE_Stack_Adjust, Mode_Nil, O_Tnode_Null,
+                               O_Enode (Pad), O_Enode_Null));
+      end if;
+      --  The stack has been adjusted by Pad bytes.
+      Push_Offset := Push_Offset + Pad;
+
+      --  Generate code for arguments (if any).
       Left := Get_Arg_Link (Stmt);
       if Left /= O_Enode_Null then
-         --  Generate code for arguments.
          Left := Gen_Insn (Left, R_None, Pnum);
       end if;
 
@@ -1022,9 +1042,22 @@ package body Ortho_Code.X86.Insns is
       Clobber_R32 (R_Cx);
       --  FIXME: fp regs.
 
+      --  Add the call.
       Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt));
       Set_Expr_Reg (Stmt, Reg_Res);
       Link_Stmt (Stmt);
+      Res_Stmt := Stmt;
+
+      if Push_Size + Pad /= 0 then
+         Res_Stmt :=
+           New_Enode (OE_Stack_Adjust, Get_Expr_Mode (Stmt), O_Tnode_Null,
+                      O_Enode (-Int32 (Push_Size + Pad)), O_Enode_Null);
+         Set_Expr_Reg (Res_Stmt, Reg_Res);
+         Link_Stmt (Res_Stmt);
+      end if;
+
+      --  The stack has been restored (just after the call).
+      Push_Offset := Push_Offset - (Push_Size + Pad);
 
       case Reg is
          when R_Any32
@@ -1037,18 +1070,18 @@ package body Ortho_Code.X86.Insns is
            | R_Ax
            | R_St0
            | R_Edx_Eax =>
-            Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum);
-            return Stmt;
+            Reg_Res := Alloc_Reg (Reg_Res, Res_Stmt, Pnum);
+            return Res_Stmt;
          when R_Any_Cc =>
             --  Move to register.
             --  (use the 'test' instruction).
-            Alloc_Cc (Stmt, Pnum);
-            return Insert_Move (Stmt, R_Ne);
+            Alloc_Cc (Res_Stmt, Pnum);
+            return Insert_Move (Res_Stmt, R_Ne);
          when R_None =>
             if Reg_Res /= R_None then
                raise Program_Error;
             end if;
-            return Stmt;
+            return Res_Stmt;
          when others =>
             Error_Gen_Insn (Stmt, Reg);
       end case;
@@ -1621,6 +1654,7 @@ package body Ortho_Code.X86.Insns is
                      return Reload (Stmt, Reg, Pnum);
                   when Mode_U64
                     | Mode_I64 =>
+                     --  FIXME: align stack
                      Insert_Arg (Gen_Insn (Right, R_Irm, Num));
                      Insert_Arg (Gen_Insn (Left, R_Irm, Num));
                      return Insert_Intrinsic (Stmt, R_Edx_Eax, Pnum);
@@ -1821,9 +1855,11 @@ package body Ortho_Code.X86.Insns is
             end if;
             Left := Get_Arg_Link (Stmt);
             if Left /= O_Enode_Null then
-               --  Previous argument.
+               --  Recurse on next argument, so the first argument is pushed
+               --  the last one.
                Left := Gen_Insn (Left, R_None, Pnum);
             end if;
+
             Left := Get_Expr_Operand (Stmt);
             case Get_Expr_Mode (Left) is
                when Mode_F32 .. Mode_F64 =>
@@ -1835,6 +1871,8 @@ package body Ortho_Code.X86.Insns is
             end case;
             Left := Gen_Insn (Left, Reg_Res, Pnum);
             Set_Expr_Operand (Stmt, Left);
+            Push_Offset := Push_Offset +
+              Do_Align (Get_Mode_Size (Get_Expr_Mode (Left)), Mode_U32);
             Link_Stmt (Stmt);
             Free_Insn_Regs (Left);
             return Stmt;
@@ -2010,7 +2048,14 @@ package body Ortho_Code.X86.Insns is
          exit when Get_Expr_Kind (Stmt) = OE_Leave;
          Stmt := N_Stmt;
       end loop;
+
+      --  Keep stack depth for this subprogram.
       Subprg.Stack_Max := Stack_Max;
+
+      --  Sanity check: there must be no remaining pushed bytes.
+      if Push_Offset /= 0 then
+         raise Program_Error with "gen_subprg_insn: push_offset not 0";
+      end if;
    end Gen_Subprg_Insns;
 
 end Ortho_Code.X86.Insns;
diff --git a/sem_expr.adb b/sem_expr.adb
index f008a7bbc..21a05c487 100644
--- a/sem_expr.adb
+++ b/sem_expr.adb
@@ -1760,6 +1760,7 @@ package body Sem_Expr is
 
    --  Semantize LIT whose elements must be of type EL_TYPE, and return
    --  the length.
+   --  FIXME: the errors are reported, but there is no mark of that.
    function Sem_String_Literal (Lit: Iir; El_Type : Iir) return Natural
    is
       function Find_Literal (Etype : Iir_Enumeration_Type_Definition;
diff --git a/sem_names.adb b/sem_names.adb
index da6c749eb..6946eb1f3 100644
--- a/sem_names.adb
+++ b/sem_names.adb
@@ -1252,7 +1252,8 @@ package body Sem_Names is
             --end;
             return;
          when Iir_Kind_Length_Array_Attribute
-           | Iir_Kind_Range_Array_Attribute =>
+           | Iir_Kind_Range_Array_Attribute
+           | Iir_Kind_Reverse_Range_Array_Attribute =>
             Finish_Sem_Array_Attribute (Res, Null_Iir);
             return;
 --          when Iir_Kind_Pos_Attribute =>
@@ -2476,9 +2477,11 @@ package body Sem_Names is
             Res := Create_Iir (Iir_Kind_Reverse_Range_Array_Attribute);
          when Name_Length =>
             Res := Create_Iir (Iir_Kind_Length_Array_Attribute);
+            --  FIXME: Error if ambiguous
             Set_Type (Res, Convertible_Integer_Type_Definition);
          when Name_Ascending =>
             Res := Create_Iir (Iir_Kind_Ascending_Array_Attribute);
+            --  FIXME: Error if ambiguous
             Set_Type (Res, Boolean_Type_Definition);
          when others =>
             raise Internal_Error;
diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c
index 82df5b9b3..80b4058f6 100644
--- a/translate/grt/config/linux.c
+++ b/translate/grt/config/linux.c
@@ -32,9 +32,15 @@
 /* On x86, the stack growns downward.  */
 #define STACK_GROWNS_DOWNWARD 1
 
-#ifdef linux
+#ifdef __linux__
 /* If set, SIGSEGV is caught in order to automatically grow the stacks.  */
 #define EXTEND_STACK 1
+#define STACK_SIGNAL SIGSEGV
+#endif
+#ifdef __APPLE__
+/* If set, SIGSEGV is caught in order to automatically grow the stacks.  */
+#define EXTEND_STACK 1
+#define STACK_SIGNAL SIGBUS
 #endif
 
 /* Defined in Grt.Stacks.  */
@@ -99,6 +105,14 @@ static struct sigaction sigsegv_act;
 #error "Not implemented"
 #endif
 
+#ifdef __APPLE__
+/* Handler for SIGFPE signal, raised in case of overflow (i386).  */
+static void grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
+{
+  grt_overflow_error ();
+}
+#endif
+
 /* Handler for SIGSEGV signal, which grow the stack.  */
 static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
 {
@@ -113,6 +127,7 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
 
   in_handler++;
 
+#ifdef __linux__
 #ifdef __i386__
   /* Linux generates a SIGSEGV (!) for an overflow exception.  */
   if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
@@ -120,16 +135,17 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
       grt_overflow_error ();
     }
 #endif
+#endif
 
   if (info == NULL || grt_get_current_process () == NULL || in_handler > 1)
     {
       /* We loose.  */
-      sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
+      sigaction (STACK_SIGNAL, &prev_sigsegv_act, NULL);
       return;
     }
 
   addr = info->si_addr;
-  
+
   /* Check ADDR belong to the stack.  */
   ctxt = grt_get_current_process ()->cur_sp;
   stack_high = (void *)(ctxt + 1);
@@ -166,7 +182,7 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
 
   ctxt->cur_length = n_len;
 
-  sigaction (SIGSEGV, &sigsegv_act, NULL);
+  sigaction (STACK_SIGNAL, &sigsegv_act, NULL);
 
   in_handler--;
 
@@ -178,7 +194,12 @@ static void grt_signal_setup (void)
 {
   sigsegv_act.sa_sigaction = &grt_sigsegv_handler;
   sigemptyset (&sigsegv_act.sa_mask);
-  sigsegv_act.sa_flags = SA_ONESHOT | SA_ONSTACK | SA_SIGINFO;
+  sigsegv_act.sa_flags = SA_ONSTACK | SA_SIGINFO;
+#ifdef SA_ONESHOT
+  sigsegv_act.sa_flags |= SA_ONESHOT;
+#elif defined (SA_RESETHAND)
+  sigsegv_act.sa_flags |= SA_RESETHAND;
+#endif
 
   /* Use an alternate stack during signals.  */
   sig_stk.ss_sp = sig_stack;
@@ -188,7 +209,19 @@ static void grt_signal_setup (void)
 
   /* We don't care about the return status.
      If the handler is not installed, then some feature are lost.  */
-  sigaction (SIGSEGV, &sigsegv_act, &prev_sigsegv_act);
+  sigaction (STACK_SIGNAL, &sigsegv_act, &prev_sigsegv_act);
+
+#ifdef __APPLE__
+  {
+    struct sigaction sig_ovf_act;
+
+    sig_ovf_act.sa_sigaction = &grt_overflow_handler;
+    sigemptyset (&sig_ovf_act.sa_mask);
+    sig_ovf_act.sa_flags = SA_SIGINFO;
+
+    sigaction (SIGFPE, &sig_ovf_act, NULL);
+  }
+#endif
 }
 #endif