use __chkstk on windows system

9 files changed, 142 insertions, 47 deletions

diff --git a/ortho/mcode/ortho_code-disps.adb b/ortho/mcode/ortho_code-disps.adb
index 9afc6b729..d01757632 100644
--- a/ortho/mcode/ortho_code-disps.adb
+++ b/ortho/mcode/ortho_code-disps.adb
@@ -515,7 +515,12 @@ package body Ortho_Code.Disps is
             Put ("var ");
             Disp_Decl_Name (Decl);
             Put (" : ");
-            Disp_Type (Get_Decl_Type (Decl));
+            Dtype := Get_Decl_Type (Decl);
+            Disp_Type (Dtype);
+            if True then
+               Put (" {size="
+                    & Uns32'Image (Types.Get_Type_Size (Dtype)) & "}");
+            end if;
             Put_Line (";");
          when OD_Const =>
             Disp_Decl_Storage (Decl);
@@ -542,6 +547,8 @@ package body Ortho_Code.Disps is
             -- Disp_Decl_Name (Get_Body_Decl (Decl));
             New_Line;
             Disp_Subprg (Indent, Get_Body_Stmt (Decl));
+         when OD_Block =>
+            null;
          when others =>
             Put_Line (Standard_Error, "debug.disp_decl: unknown decl "
                       & OD_Kind'Image (Kind));
diff --git a/ortho/mcode/ortho_code-sysdeps.adb b/ortho/mcode/ortho_code-sysdeps.adb
new file mode 100644
index 000000000..c5e062938
--- /dev/null
+++ b/ortho/mcode/ortho_code-sysdeps.adb
@@ -0,0 +1,6 @@
+package body Ortho_Code.Sysdeps is
+   procedure Init is
+   begin
+      null;
+   end Init;
+end Ortho_Code.Sysdeps;
diff --git a/ortho/mcode/ortho_code-sysdeps.ads b/ortho/mcode/ortho_code-sysdeps.ads
new file mode 100644
index 000000000..e680e4d71
--- /dev/null
+++ b/ortho/mcode/ortho_code-sysdeps.ads
@@ -0,0 +1,4 @@
+package Ortho_Code.Sysdeps is
+   --  OS dependant initializations.
+   procedure Init;
+end Ortho_Code.Sysdeps;
diff --git a/ortho/mcode/ortho_code-x86-abi.adb b/ortho/mcode/ortho_code-x86-abi.adb
index 1515c2e7c..db223849a 100644
--- a/ortho/mcode/ortho_code-x86-abi.adb
+++ b/ortho/mcode/ortho_code-x86-abi.adb
@@ -716,6 +716,9 @@ package body Ortho_Code.X86.Abi is
    function Muldi3 (A, B : Long_Integer) return Long_Integer;
    pragma Import (C, Muldi3, "__muldi3");
 
+   procedure Chkstk (Sz : Integer);
+   pragma Import (C, Chkstk, "_chkstk");
+
    procedure Link_Intrinsics
    is
    begin
@@ -727,5 +730,7 @@ package body Ortho_Code.X86.Abi is
         (Ortho_Code.X86.Emits.Intrinsics_Symbol
          (Ortho_Code.X86.Intrinsic_Div_Ov_I64),
          Divdi3'Address);
+      Binary_File.Memory.Set_Symbol_Address
+        (Ortho_Code.X86.Emits.Chkstk_Symbol, Chkstk'Address);
    end Link_Intrinsics;
 end Ortho_Code.X86.Abi;
diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb
index a85729111..97f389656 100644
--- a/ortho/mcode/ortho_code-x86-emits.adb
+++ b/ortho/mcode/ortho_code-x86-emits.adb
@@ -21,6 +21,7 @@ with Ortho_Code.Types;
 with Ortho_Code.Consts;
 with Ortho_Code.Debug;
 with Ortho_Code.X86.Insns;
+with Ortho_Code.X86.Flags;
 with Ortho_Code.Flags;
 with Ortho_Code.Dwarf;
 with Ortho_Code.Binary; use Ortho_Code.Binary;
@@ -148,32 +149,43 @@ package body Ortho_Code.X86.Emits is
             Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0);
          when OE_Add =>
             declare
+               P : O_Enode;
                L, R : O_Enode;
                S, C : O_Enode;
+               Off : Int32;
             begin
-               L := Get_Expr_Left (N);
-               R := Get_Expr_Right (N);
+               Off := 0;
+               P := N;
                if Sz /= Sz_32l then
                   raise Program_Error;
                end if;
-               if Get_Expr_Kind (L) = OE_Addrg
-                 and then Get_Expr_Kind (R) = OE_Const
-               then
-                  S := L;
-                  C := R;
-               elsif Get_Expr_Kind (R) = OE_Addrg
-                 and then Get_Expr_Kind (L) = OE_Const
-               then
-                  S := R;
-                  C := L;
-               else
-                  raise Program_Error;
-               end if;
-               if Get_Expr_Mode (C) /= Mode_U32 then
-                  raise Program_Error;
-               end if;
+               loop
+                  L := Get_Expr_Left (P);
+                  R := Get_Expr_Right (P);
+
+                  --  Extract the const node.
+                  if Get_Expr_Kind (R) = OE_Const then
+                     S := L;
+                     C := R;
+                  elsif Get_Expr_Kind (L) = OE_Const then
+                     S := R;
+                     C := L;
+                  else
+                     raise Program_Error;
+                  end if;
+                  if Get_Expr_Mode (C) /= Mode_U32 then
+                     raise Program_Error;
+                  end if;
+                  Off := Off + To_Int32 (Get_Expr_Low (C));
+
+                  exit when Get_Expr_Kind (S) = OE_Addrg;
+                  P := S;
+                  if Get_Expr_Kind (P) /= OE_Add then
+                     raise Program_Error;
+                  end if;
+               end loop;
                Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (S)),
-                           Integer_32 (To_Int32 (Get_Expr_Low (C))));
+                           Integer_32 (Off));
             end;
          when others =>
             raise Program_Error;
@@ -1016,23 +1028,27 @@ package body Ortho_Code.X86.Emits is
          raise Program_Error;
       end if;
       --  Align stack on word.
-      --  Add reg, 3
+      --  Add reg, (stack_boundary - 1)
       Start_Insn;
       Gen_B8 (2#1000_0011#);
       Gen_B8 (2#11_000_000# + To_Reg32 (Reg));
-      Gen_B8 (3);
+      Gen_B8 (Byte (X86.Flags.Stack_Boundary - 1));
       End_Insn;
-      --  and reg, ~3
+      --  and reg, ~(stack_boundary - 1)
       Start_Insn;
       Gen_B8 (2#1000_0001#);
       Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
-      Gen_Le32 (not 3);
-      End_Insn;
-      --  subl esp, reg
-      Start_Insn;
-      Gen_B8 (2#0001_1011#);
-      Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+      Gen_Le32 (not (X86.Flags.Stack_Boundary - 1));
       End_Insn;
+      if X86.Flags.Flag_Alloca_Call then
+         Gen_Call (Chkstk_Symbol);
+      else
+         --  subl esp, reg
+         Start_Insn;
+         Gen_B8 (2#0001_1011#);
+         Gen_B8 (2#11_100_000# + To_Reg32 (Reg));
+         End_Insn;
+      end if;
       --  movl reg, esp
       Start_Insn;
       Gen_B8 (2#1000_1001#);
@@ -1945,10 +1961,11 @@ package body Ortho_Code.X86.Emits is
       use Ortho_Code.Decls;
       use Binary_File;
       use Interfaces;
-      use Flags;
+      use Ortho_Code.Flags;
       Sym : Symbol;
       Subprg_Decl : O_Dnode;
       Is_Global : Boolean;
+      Frame_Size : Unsigned_32;
    begin
       Set_Current_Section (Sect_Text);
       Subprg_Decl := Subprg.D_Decl;
@@ -1964,10 +1981,14 @@ package body Ortho_Code.X86.Emits is
       Set_Symbol_Pc (Sym, Is_Global);
       Subprg_Pc := Get_Current_Pc;
 
---        if Flag_Debug = Debug_Dwarf then
---           Dwarf.Emit_Prolog (Subprg);
---           Set_Current_Section (Sect_Text);
---        end if;
+      --  Compute frame size.
+      --  8 bytes are used by return address and saved frame pointer.
+      Frame_Size := Unsigned_32 (Subprg.Stack_Max) + 8;
+      --  Align.
+      Frame_Size := (Frame_Size + X86.Flags.Stack_Boundary - 1)
+        and not (X86.Flags.Stack_Boundary - 1);
+      --  The 8 bytes are already allocated.
+      Frame_Size := Frame_Size - 8;
 
       --  Emit prolog.
       --  push %ebp
@@ -1980,18 +2001,29 @@ package body Ortho_Code.X86.Emits is
       Gen_B8 (2#11_100_101#);
       End_Insn;
       --  subl XXX, %esp
-      if Subprg.Stack_Max /= 0 then
-         Start_Insn;
-         if Subprg.Stack_Max < 128 then
-            Gen_B8 (2#100000_11#);
-            Gen_B8 (2#11_101_100#);
-            Gen_B8 (Byte (Subprg.Stack_Max));
+      if Frame_Size /= 0 then
+         if not X86.Flags.Flag_Alloca_Call
+            or else Frame_Size <= 4096
+         then
+            Start_Insn;
+            if Frame_Size < 128 then
+               Gen_B8 (2#100000_11#);
+               Gen_B8 (2#11_101_100#);
+               Gen_B8 (Byte (Frame_Size));
+            else
+               Gen_B8 (2#100000_01#);
+               Gen_B8 (2#11_101_100#);
+               Gen_Le32 (Frame_Size);
+            end if;
+            End_Insn;
          else
-            Gen_B8 (2#100000_01#);
-            Gen_B8 (2#11_101_100#);
-            Gen_Le32 (Unsigned_32 (Subprg.Stack_Max));
+            --  mov stack_size,%eax
+            Start_Insn;
+            Gen_B8 (2#1011_1_000#);
+            Gen_Le32 (Frame_Size);
+            End_Insn;
+            Gen_Call (Chkstk_Symbol);
          end if;
-         End_Insn;
       end if;
 
       if Flag_Profile then
@@ -2009,7 +2041,7 @@ package body Ortho_Code.X86.Emits is
       use Binary_File;
       use Ortho_Code.Decls;
       use Ortho_Code.Types;
-      use Flags;
+      use Ortho_Code.Flags;
       Decl : O_Dnode;
    begin
       --  Restore registers.
@@ -2210,6 +2242,10 @@ package body Ortho_Code.X86.Emits is
          Mcount_Symbol := Create_Symbol (Get_Identifier ("mcount"));
       end if;
 
+      if X86.Flags.Flag_Alloca_Call then
+         Chkstk_Symbol := Create_Symbol (Get_Identifier ("__chkstk"));
+      end if;
+
       Intrinsics_Symbol (Intrinsic_Mul_Ov_U64) :=
         Create_Symbol (Get_Identifier ("__muldi3"));
       Intrinsics_Symbol (Intrinsic_Div_Ov_U64) :=
diff --git a/ortho/mcode/ortho_code-x86-emits.ads b/ortho/mcode/ortho_code-x86-emits.ads
index dbad1c12f..9ddb43ee5 100644
--- a/ortho/mcode/ortho_code-x86-emits.ads
+++ b/ortho/mcode/ortho_code-x86-emits.ads
@@ -31,5 +31,6 @@ package Ortho_Code.X86.Emits is
    Intrinsics_Symbol : Intrinsic_Symbols_Map;
 
    Mcount_Symbol : Symbol;
+   Chkstk_Symbol : Symbol;
 end Ortho_Code.X86.Emits;
 
diff --git a/ortho/mcode/ortho_code-x86-flags.ads b/ortho/mcode/ortho_code-x86-flags.ads
new file mode 100644
index 000000000..44179a443
--- /dev/null
+++ b/ortho/mcode/ortho_code-x86-flags.ads
@@ -0,0 +1,28 @@
+--  X86 ABI flags.
+--  Copyright (C) 2006 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+--  WARRANTY; without even the implied warranty of MERCHANTABILITY or
+--  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+--  for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  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; use Interfaces;
+
+package Ortho_Code.X86.Flags is
+   --  If true, OE_Alloca calls __chkstk (Windows), otherwise OE_Alloc
+   --  modifies ESP directly.
+   Flag_Alloca_Call : Boolean := False;
+
+   --  Prefered stack alignment.
+   --  Must be a power of 2.
+   Stack_Boundary : Unsigned_32 := 2 ** 3;
+end Ortho_Code.X86.Flags;
diff --git a/ortho/mcode/ortho_code-x86-insns.adb b/ortho/mcode/ortho_code-x86-insns.adb
index 4278bdc02..cc83afa40 100644
--- a/ortho/mcode/ortho_code-x86-insns.adb
+++ b/ortho/mcode/ortho_code-x86-insns.adb
@@ -20,6 +20,7 @@ with Ortho_Code.Abi;
 with Ortho_Code.Decls; use Ortho_Code.Decls;
 with Ortho_Code.Types; use Ortho_Code.Types;
 with Ortho_Code.Debug;
+with Ortho_Code.X86.Flags;
 
 package body Ortho_Code.X86.Insns is
    procedure Link_Stmt (Stmt : O_Enode)
@@ -1104,11 +1105,16 @@ package body Ortho_Code.X86.Insns is
                  | R_Irm
                  | R_Any32 =>
                   Num := Get_Insn_Num;
-                  Left := Gen_Insn (Left, R_Any32, Num);
+                  if X86.Flags.Flag_Alloca_Call then
+                     Reg_L := R_Ax;
+                  else
+                     Reg_L := R_Any32;
+                  end if;
+                  Left := Gen_Insn (Left, Reg_L, Num);
                   Set_Expr_Operand (Stmt, Left);
                   Link_Stmt (Left);
                   Free_Insn_Regs (Left);
-                  Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
+                  Set_Expr_Reg (Stmt, Alloc_Reg (Reg_L, Stmt, Pnum));
                   Link_Stmt (Stmt);
                when others =>
                   Error_Gen_Insn (Stmt, Reg);
diff --git a/ortho/mcode/ortho_mcode.adb b/ortho/mcode/ortho_mcode.adb
index 6c91f268c..bc4dc3215 100644
--- a/ortho/mcode/ortho_mcode.adb
+++ b/ortho/mcode/ortho_mcode.adb
@@ -18,6 +18,7 @@
 with Ortho_Code.Abi;
 with Ada.Text_IO;
 with Ortho_Code.Debug;
+with Ortho_Code.Sysdeps;
 with Ortho_Ident;
 with Binary_File;
 
@@ -88,6 +89,7 @@ package body Ortho_Mcode is
       if New_Access_Type (O_Tnode_Null) /= O_Tnode_Ptr then
          raise Program_Error;
       end if;
+      Ortho_Code.Sysdeps.Init;
       --  Do not finish the access, since this creates an infinite recursion
       --  in gdb (at least for GDB 6.3).
       --Finish_Access_Type (O_Tnode_Ptr, O_Tnode_Ptr);