diff options
| -rw-r--r-- | ortho/debug/ortho_debug-disp.adb | 5 | ||||
| -rw-r--r-- | ortho/debug/ortho_debug.adb | 14 | ||||
| -rw-r--r-- | ortho/debug/ortho_debug.private.ads | 4 | ||||
| -rw-r--r-- | ortho/gcc/ortho-lang.c | 6 | ||||
| -rw-r--r-- | ortho/gcc/ortho_gcc.ads | 5 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-consts.adb | 22 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-consts.ads | 6 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-exprs.adb | 3 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-types.adb | 10 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-types.ads | 3 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-x86-abi.ads | 2 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-x86-emits.adb | 1 | ||||
| -rw-r--r-- | ortho/mcode/ortho_mcode.ads | 5 | ||||
| -rw-r--r-- | ortho/oread/ortho_front.adb | 26 | ||||
| -rw-r--r-- | ortho/ortho_nodes.common.ads | 4 | 
15 files changed, 105 insertions, 11 deletions
diff --git a/ortho/debug/ortho_debug-disp.adb b/ortho/debug/ortho_debug-disp.adb index be75122e3..60218bf32 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 e2307b9e4..723fe3cd6 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 03489c549..79fd7b3d9 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 370bdd633..900ca17ae 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 9b5356863..31005ae6c 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 b9a65122a..c6d2020d8 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 a97c93e6b..603a8a197 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 b78405922..4f7140753 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 1a505b750..79569653d 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 73a493e58..c8d8cc03f 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 11768dcd9..e974438ce 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 12f1587b0..ad1ef559b 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 9ea4c898a..ea06573a6 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 8bc5de882..c6e1234cc 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 e16b0a20b..9e29d372b 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;  | 
