aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ortho/debug/ortho_debug-disp.adb5
-rw-r--r--ortho/debug/ortho_debug.adb14
-rw-r--r--ortho/debug/ortho_debug.private.ads4
-rw-r--r--ortho/gcc/ortho-lang.c6
-rw-r--r--ortho/gcc/ortho_gcc.ads5
-rw-r--r--ortho/mcode/ortho_code-consts.adb22
-rw-r--r--ortho/mcode/ortho_code-consts.ads6
-rw-r--r--ortho/mcode/ortho_code-exprs.adb3
-rw-r--r--ortho/mcode/ortho_code-types.adb10
-rw-r--r--ortho/mcode/ortho_code-types.ads3
-rw-r--r--ortho/mcode/ortho_code-x86-abi.ads2
-rw-r--r--ortho/mcode/ortho_code-x86-emits.adb1
-rw-r--r--ortho/mcode/ortho_mcode.ads5
-rw-r--r--ortho/oread/ortho_front.adb26
-rw-r--r--ortho/ortho_nodes.common.ads4
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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-02 20:45:04 +0000