Add Alignof constant to get the alignment of a type.

15 files changed, 105 insertions, 11 deletions

diff --git a/ortho/debug/ortho_debug-disp.adb b/ortho/debug/ortho_debug-disp.adb
index be75122..60218bf 100644
--- a/ortho/debug/ortho_debug-disp.adb
+++ b/ortho/debug/ortho_debug-disp.adb
@@ -450,6 +450,11 @@ package body Ortho_Debug.Disp is
             Put ("'sizeof (");
             Disp_Tnode_Name (C.S_Type);
             Put (")");
+         when OC_Alignof_Lit =>
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'alignof (");
+            Disp_Tnode_Name (C.S_Type);
+            Put (")");
          when OC_Offsetof_Lit =>
             Disp_Tnode_Name (C.Ctype);
             Put ("'offsetof (");
diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
index e2307b9..723fe3c 100644
--- a/ortho/debug/ortho_debug.adb
+++ b/ortho/debug/ortho_debug.adb
@@ -425,6 +425,20 @@ package body Ortho_Debug is
                                       S_Type => Atype);
    end New_Sizeof;
 
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Alignof_Type is O_Cnode_Type (OC_Alignof_Lit);
+   begin
+      if Rtype.Kind /= ON_Unsigned_Type then
+         raise Type_Error;
+      end if;
+      Check_Complete_Type (Atype);
+      return new O_Cnode_Alignof_Type'(Kind => OC_Alignof_Lit,
+                                       Ctype => Rtype,
+                                       Ref => False,
+                                       S_Type => Atype);
+   end New_Alignof;
+
    function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
    is
       subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit);
diff --git a/ortho/debug/ortho_debug.private.ads b/ortho/debug/ortho_debug.private.ads
index 03489c5..79fd7b3 100644
--- a/ortho/debug/ortho_debug.private.ads
+++ b/ortho/debug/ortho_debug.private.ads
@@ -119,6 +119,7 @@ private
       OC_Enum_Lit,
       OC_Null_Lit,
       OC_Sizeof_Lit,
+      OC_Alignof_Lit,
       OC_Offsetof_Lit,
       OC_Aggregate,
       OC_Aggr_Element,
@@ -148,7 +149,8 @@ private
             E_Name : O_Ident;
          when OC_Null_Lit =>
             null;
-         when OC_Sizeof_Lit =>
+         when OC_Sizeof_Lit
+           | OC_Alignof_Lit =>
             S_Type : O_Tnode;
          when OC_Offsetof_Lit =>
             Off_Field : O_Fnode;
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index 370bdd6..900ca17 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -1431,6 +1431,12 @@ new_sizeof (tree atype, tree rtype)
  return fold (build1 (NOP_EXPR, rtype, size));
 }
 
+tree
+new_alignof (tree atype, tree rtype)
+{
+  return build_int_cstu (rtype, TYPE_ALIGN_UNIT (atype));
+}
+
 /* Convert the array expression EXP to a pointer.  */
 static tree array_to_pointer_conversion (tree exp);
 
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
index 9b53568..31005ae 100644
--- a/ortho/gcc/ortho_gcc.ads
+++ b/ortho/gcc/ortho_gcc.ads
@@ -233,6 +233,10 @@ package Ortho_Gcc is
    --  ATYPE cannot be an unconstrained array type.
    function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
    --  Returns the offset of FIELD in its record.  The result is a literal
    --  of unsigned type RTYPE.
    function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
@@ -598,6 +602,7 @@ private
    pragma Import (C, New_Access_Element);
 
    pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Alignof);
    pragma Import (C, New_Offsetof);
 
    pragma Import (C, New_Address);
diff --git a/ortho/mcode/ortho_code-consts.adb b/ortho/mcode/ortho_code-consts.adb
index b9a6512..c6d2020 100644
--- a/ortho/mcode/ortho_code-consts.adb
+++ b/ortho/mcode/ortho_code-consts.adb
@@ -468,6 +468,27 @@ package body Ortho_Code.Consts is
       return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
    end Get_Sizeof_Type;
 
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+   is
+      function To_Cnode_Common is new Ada.Unchecked_Conversion
+        (Source => Cnode_Sizeof, Target => Cnode_Common);
+
+      Res : O_Cnode;
+   begin
+      if Debug.Flag_Debug_Hli then
+         Cnodes.Append (Cnode_Common'(Kind => OC_Alignof,
+                                      Lit_Type => Rtype));
+         Res := Cnodes.Last;
+         Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype,
+                                                       Pad => 0)));
+         return Res;
+      else
+         return New_Unsigned_Literal
+           (Rtype, Unsigned_64 (Get_Type_Align_Bytes (Atype)));
+      end if;
+   end New_Alignof;
+
+
    function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode is
    begin
       return New_Unsigned_Literal
@@ -492,6 +513,7 @@ package body Ortho_Code.Consts is
            | OC_Record
            | OC_Union
            | OC_Sizeof
+           | OC_Alignof
            | OC_Address
            | OC_Subprg_Address =>
             raise Syntax_Error;
diff --git a/ortho/mcode/ortho_code-consts.ads b/ortho/mcode/ortho_code-consts.ads
index a97c93e..603a8a1 100644
--- a/ortho/mcode/ortho_code-consts.ads
+++ b/ortho/mcode/ortho_code-consts.ads
@@ -21,7 +21,7 @@ package Ortho_Code.Consts is
    type OC_Kind is (OC_Signed, OC_Unsigned, OC_Float, OC_Lit, OC_Null,
                     OC_Array, OC_Record, OC_Union,
                     OC_Subprg_Address, OC_Address,
-                    OC_Sizeof);
+                    OC_Sizeof, OC_Alignof);
 
    function Get_Const_Kind (Cst : O_Cnode) return OC_Kind;
 
@@ -119,6 +119,10 @@ package Ortho_Code.Consts is
    --  ATYPE cannot be an unconstrained array type.
    function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
    --  Returns the offset of FIELD in its record.  The result is a literal
    --  of unsigned type RTYPE.
    function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;
diff --git a/ortho/mcode/ortho_code-exprs.adb b/ortho/mcode/ortho_code-exprs.adb
index b784059..4f71407 100644
--- a/ortho/mcode/ortho_code-exprs.adb
+++ b/ortho/mcode/ortho_code-exprs.adb
@@ -714,7 +714,8 @@ package body Ortho_Code.Exprs is
             when OC_Array
               | OC_Record
               | OC_Union
-              | OC_Sizeof =>
+              | OC_Sizeof
+              | OC_Alignof =>
                raise Syntax_Error;
          end case;
       end if;
diff --git a/ortho/mcode/ortho_code-types.adb b/ortho/mcode/ortho_code-types.adb
index 1a505b7..7956965 100644
--- a/ortho/mcode/ortho_code-types.adb
+++ b/ortho/mcode/ortho_code-types.adb
@@ -105,10 +105,10 @@ package body Ortho_Code.Types is
       return Tnodes.Table (Atype).Align;
    end Get_Type_Align;
 
-   function Get_Type_Align_Byte (Atype : O_Tnode) return Uns32 is
+   function Get_Type_Align_Bytes (Atype : O_Tnode) return Uns32 is
    begin
       return 2 ** Get_Type_Align (Atype);
-   end Get_Type_Align_Byte;
+   end Get_Type_Align_Bytes;
 
    function Get_Type_Mode (Atype : O_Tnode) return Mode_Type is
    begin
@@ -569,19 +569,17 @@ package body Ortho_Code.Types is
 
    function Do_Align (Off : Uns32; Atype : O_Tnode) return Uns32
    is
-      Msk : Uns32;
+      Msk : constant Uns32 := Get_Type_Align_Bytes (Atype) - 1;
    begin
       --  Align.
-      Msk := Get_Type_Align_Byte (Atype) - 1;
       return (Off + Msk) and (not Msk);
    end Do_Align;
 
    function Do_Align (Off : Uns32; Mode : Mode_Type) return Uns32
    is
-      Msk : Uns32;
+      Msk : constant Uns32 := (2 ** Mode_Align (Mode)) - 1;
    begin
       --  Align.
-      Msk := Get_Mode_Size (Mode) - 1;
       return (Off + Msk) and (not Msk);
    end Do_Align;
 
diff --git a/ortho/mcode/ortho_code-types.ads b/ortho/mcode/ortho_code-types.ads
index 73a493e..c8d8cc0 100644
--- a/ortho/mcode/ortho_code-types.ads
+++ b/ortho/mcode/ortho_code-types.ads
@@ -39,6 +39,9 @@ package Ortho_Code.Types is
    type Mode_Align_Array is array (Mode_Type) of Small_Natural;
    function Get_Type_Align (Atype : O_Tnode) return Small_Natural;
 
+   --  Alignment for ATYPE in bytes.
+   function Get_Type_Align_Bytes (Atype : O_Tnode) return Uns32;
+
    --  Return true is the type was incomplete at creation.
    --  (it may - or not - have been completed later).
    function Get_Type_Deferred (Atype : O_Tnode) return Boolean;
diff --git a/ortho/mcode/ortho_code-x86-abi.ads b/ortho/mcode/ortho_code-x86-abi.ads
index 11768dc..e974438 100644
--- a/ortho/mcode/ortho_code-x86-abi.ads
+++ b/ortho/mcode/ortho_code-x86-abi.ads
@@ -28,7 +28,7 @@ package Ortho_Code.X86.Abi is
       Mode_U16 | Mode_I16 => 1,
       Mode_U32 | Mode_I32 | Mode_F32 | Mode_P32 => 2,
       Mode_U64 | Mode_I64 => 2,
-      Mode_F64 => 2,
+      Mode_F64 => 2, -- 2 for SVR4-ABI and Darwin, 3 for Windows.
       Mode_Blk | Mode_X1 | Mode_Nil | Mode_P64 => 0,
       Mode_B2 => 0);
 
diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb
index 12f1587..ad1ef55 100644
--- a/ortho/mcode/ortho_code-x86-emits.adb
+++ b/ortho/mcode/ortho_code-x86-emits.adb
@@ -2233,6 +2233,7 @@ package body Ortho_Code.X86.Emits is
                end loop;
             end;
          when OC_Sizeof
+           | OC_Alignof
            | OC_Union =>
             raise Program_Error;
       end case;
diff --git a/ortho/mcode/ortho_mcode.ads b/ortho/mcode/ortho_mcode.ads
index 9ea4c89..ea06573 100644
--- a/ortho/mcode/ortho_mcode.ads
+++ b/ortho/mcode/ortho_mcode.ads
@@ -275,6 +275,11 @@ package Ortho_Mcode is
    function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
      renames Ortho_Code.Consts.New_Sizeof;
 
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
+     renames Ortho_Code.Consts.New_Alignof;
+
    --  Returns the offset of FIELD in its record.  The result is a literal
    --  of unsigned type RTYPE.
    function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
diff --git a/ortho/oread/ortho_front.adb b/ortho/oread/ortho_front.adb
index 8bc5de8..c6e1234 100644
--- a/ortho/oread/ortho_front.adb
+++ b/ortho/oread/ortho_front.adb
@@ -132,7 +132,7 @@ package body Ortho_Front is
       if Buf (Pos) = NUL then
          --  Read line.
          Buf_Len := Read (Fd, Buf'Address, Buf'Length - 1);
-         if Buf_Len <= 0 then
+         if Buf_Len = 0 then
             --  End of file.
             return NUL;
          end if;
@@ -212,6 +212,7 @@ package body Ortho_Front is
    Id_Subprg_Addr : Syment_Acc;
    Id_Conv : Syment_Acc;
    Id_Sizeof : Syment_Acc;
+   Id_Alignof : Syment_Acc;
    Id_Alloca : Syment_Acc;
    Id_Offsetof : Syment_Acc;
 
@@ -1263,6 +1264,22 @@ package body Ortho_Front is
       return Res;
    end Parse_Sizeof;
 
+   function Parse_Alignof (Atype : Node_Acc) return O_Cnode
+   is
+      Res : O_Cnode;
+   begin
+      Next_Expect (Tok_Left_Paren);
+      Next_Token;
+      if Tok /= Tok_Ident then
+         Parse_Error ("type name expected");
+      end if;
+      Res := New_Alignof
+        (Get_Decl (Token_Sym).Decl_Dtype.Type_Onode,
+         Atype.Type_Onode);
+      Next_Expect (Tok_Right_Paren);
+      return Res;
+   end Parse_Alignof;
+
    function Parse_Typed_Literal (Atype : Node_Acc) return O_Cnode
    is
       Res : O_Cnode;
@@ -1325,6 +1342,8 @@ package body Ortho_Front is
                         Res := Parse_Offsetof (N);
                      elsif Token_Sym = Id_Sizeof then
                         Res := Parse_Sizeof (N);
+                     elsif Token_Sym = Id_Alignof then
+                        Res := Parse_Alignof (N);
                      elsif Token_Sym = Id_Conv then
                         Next_Expect (Tok_Left_Paren);
                         Next_Token;
@@ -1412,6 +1431,10 @@ package body Ortho_Front is
                Res := New_Lit (Parse_Sizeof (Name.Decl_Dtype));
                Next_Token;
                return Res;
+            elsif Token_Sym = Id_Alignof then
+               Res := New_Lit (Parse_Alignof (Name.Decl_Dtype));
+               Next_Token;
+               return Res;
             elsif Token_Sym = Id_Alloca then
                Next_Expect (Tok_Left_Paren);
                Next_Token;
@@ -2614,6 +2637,7 @@ package body Ortho_Front is
       Id_Subprg_Addr := New_Symbol ("subprg_addr");
       Id_Conv := New_Symbol ("conv");
       Id_Sizeof := New_Symbol ("sizeof");
+      Id_Alignof := New_Symbol ("alignof");
       Id_Alloca := New_Symbol ("alloca");
       Id_Offsetof := New_Symbol ("offsetof");
 
diff --git a/ortho/ortho_nodes.common.ads b/ortho/ortho_nodes.common.ads
index e16b0a2..9e29d37 100644
--- a/ortho/ortho_nodes.common.ads
+++ b/ortho/ortho_nodes.common.ads
@@ -167,6 +167,10 @@ package ORTHO_NODES is
    --  ATYPE cannot be an unconstrained array type.
    function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
+   --  Returns the alignment in bytes for ATYPE.  The result is a literal of
+   --  unsgined type RTYPE.
+   function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
+
    --  Returns the offset of FIELD in its record.  The result is a literal
    --  of unsigned type RTYPE.
    function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode;