summaryrefslogtreecommitdiff
path: root/ortho
diff options
context:
space:
mode:
Diffstat (limited to 'ortho')
-rw-r--r--ortho/debug/ortho_debug.adb6
-rw-r--r--ortho/gcc/ortho-lang.c4
-rw-r--r--ortho/gcc/ortho_gcc.ads7
-rw-r--r--ortho/mcode/ortho_code-consts.adb6
-rw-r--r--ortho/mcode/ortho_code-consts.ads7
-rw-r--r--ortho/mcode/ortho_code-types.adb9
-rw-r--r--ortho/mcode/ortho_code-types.ads3
-rw-r--r--ortho/mcode/ortho_mcode.ads7
-rw-r--r--ortho/oread/ortho_front.adb3
-rw-r--r--ortho/ortho_nodes.common.ads7
10 files changed, 42 insertions, 17 deletions
diff --git a/ortho/debug/ortho_debug.adb b/ortho/debug/ortho_debug.adb
index 74c8078..023729b 100644
--- a/ortho/debug/ortho_debug.adb
+++ b/ortho/debug/ortho_debug.adb
@@ -437,13 +437,17 @@ package body Ortho_Debug is
S_Type => Atype);
end New_Alignof;
- function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode
+ function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode
is
subtype O_Cnode_Offsetof_Type is O_Cnode_Type (OC_Offsetof_Lit);
begin
if Rtype.Kind /= ON_Unsigned_Type then
raise Type_Error;
end if;
+ if Field.Parent /= Rec_Type then
+ raise Type_Error;
+ end if;
return new O_Cnode_Offsetof_Type'(Kind => OC_Offsetof_Lit,
Ctype => Rtype,
Ref => False,
diff --git a/ortho/gcc/ortho-lang.c b/ortho/gcc/ortho-lang.c
index 5404afb..fe02dbc 100644
--- a/ortho/gcc/ortho-lang.c
+++ b/ortho/gcc/ortho-lang.c
@@ -1442,13 +1442,15 @@ new_access_element (tree acc)
}
tree
-new_offsetof (tree field, tree rtype)
+new_offsetof (tree rec_type, tree field, tree rtype)
{
tree off;
tree bit_off;
HOST_WIDE_INT pos;
tree res;
+ gcc_assert (DECL_CONTEXT (field) == rec_type);
+
off = DECL_FIELD_OFFSET (field);
/* The offset must be a constant. */
diff --git a/ortho/gcc/ortho_gcc.ads b/ortho/gcc/ortho_gcc.ads
index 31005ae..d01caee 100644
--- a/ortho/gcc/ortho_gcc.ads
+++ b/ortho/gcc/ortho_gcc.ads
@@ -237,9 +237,10 @@ package Ortho_Gcc is
-- 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;
+ -- Returns the offset of FIELD in its record REC_TYPE. The result is a
+ -- literal of unsigned type or access type RTYPE.
+ function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode;
-- Get an element of an array.
-- INDEX must be of the type of the array index.
diff --git a/ortho/mcode/ortho_code-consts.adb b/ortho/mcode/ortho_code-consts.adb
index 1122b8e..d09a13c 100644
--- a/ortho/mcode/ortho_code-consts.adb
+++ b/ortho/mcode/ortho_code-consts.adb
@@ -496,8 +496,12 @@ package body Ortho_Code.Consts is
return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype;
end Get_Alignof_Type;
- function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Cnode is
+ function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode is
begin
+ if Get_Field_Parent (Field) /= Rec_Type then
+ raise Syntax_Error;
+ end if;
return New_Unsigned_Literal
(Rtype, Unsigned_64 (Get_Field_Offset (Field)));
end New_Offsetof;
diff --git a/ortho/mcode/ortho_code-consts.ads b/ortho/mcode/ortho_code-consts.ads
index 7059b56..0076bc6 100644
--- a/ortho/mcode/ortho_code-consts.ads
+++ b/ortho/mcode/ortho_code-consts.ads
@@ -126,9 +126,10 @@ package Ortho_Code.Consts is
-- 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;
+ -- Returns the offset of FIELD in its record REC_TYPE. The result is a
+ -- literal of unsigned type or access type RTYPE.
+ function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode;
procedure Disp_Stats;
diff --git a/ortho/mcode/ortho_code-types.adb b/ortho/mcode/ortho_code-types.adb
index d157228..e0c070c 100644
--- a/ortho/mcode/ortho_code-types.adb
+++ b/ortho/mcode/ortho_code-types.adb
@@ -77,6 +77,7 @@ package body Ortho_Code.Types is
Table_Increment => 100);
type Field_Type is record
+ Parent : O_Tnode;
Ident : O_Ident;
Ftype : O_Tnode;
Offset : Uns32;
@@ -226,6 +227,11 @@ package body Ortho_Code.Types is
Fnodes.Table (Field).Offset := Offset;
end Set_Field_Offset;
+ function Get_Field_Parent (Field : O_Fnode) return O_Tnode is
+ begin
+ return Fnodes.Table (Field).Parent;
+ end Get_Field_Parent;
+
function Get_Field_Type (Field : O_Fnode) return O_Tnode is
begin
return Fnodes.Table (Field).Ftype;
@@ -592,7 +598,8 @@ package body Ortho_Code.Types is
begin
Elements.Off := Do_Align (Elements.Off, Etype);
- Fnodes.Append (Field_Type'(Ident => Ident,
+ Fnodes.Append (Field_Type'(Parent => Elements.Res,
+ Ident => Ident,
Ftype => Etype,
Offset => Elements.Off,
Next => O_Fnode_Null));
diff --git a/ortho/mcode/ortho_code-types.ads b/ortho/mcode/ortho_code-types.ads
index 86a6c2c..da65498 100644
--- a/ortho/mcode/ortho_code-types.ads
+++ b/ortho/mcode/ortho_code-types.ads
@@ -93,6 +93,9 @@ package Ortho_Code.Types is
function Get_Type_Bool_False (Atype : O_Tnode) return O_Cnode;
function Get_Type_Bool_True (Atype : O_Tnode) return O_Cnode;
+ -- Return the union/record type which contains FIELD.
+ function Get_Field_Parent (Field : O_Fnode) return O_Tnode;
+
-- Get the offset of FIELD in its record/union.
function Get_Field_Offset (Field : O_Fnode) return Uns32;
procedure Set_Field_Offset (Field : O_Fnode; Offset : Uns32);
diff --git a/ortho/mcode/ortho_mcode.ads b/ortho/mcode/ortho_mcode.ads
index ea06573..369e743 100644
--- a/ortho/mcode/ortho_mcode.ads
+++ b/ortho/mcode/ortho_mcode.ads
@@ -280,9 +280,10 @@ package Ortho_Mcode is
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
+ -- Returns the offset of FIELD in its record REC_TYPE. The result is a
+ -- literal of unsigned type or access type RTYPE.
+ function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode
renames Ortho_Code.Consts.New_Offsetof;
-- Get an element of an array.
diff --git a/ortho/oread/ortho_front.adb b/ortho/oread/ortho_front.adb
index c6e1234..0d3e178 100644
--- a/ortho/oread/ortho_front.adb
+++ b/ortho/oread/ortho_front.adb
@@ -1244,7 +1244,8 @@ package body Ortho_Front is
Next_Expect (Tok_Ident);
Rec_Field := Find_Field_By_Name (Rec_Type.Decl_Dtype);
Next_Expect (Tok_Right_Paren);
- return New_Offsetof (Rec_Field.Field_Fnode,
+ return New_Offsetof (Rec_Type.Decl_Dtype.Type_Onode,
+ Rec_Field.Field_Fnode,
Atype.Type_Onode);
end Parse_Offsetof;
diff --git a/ortho/ortho_nodes.common.ads b/ortho/ortho_nodes.common.ads
index 9e29d37..ee26f60 100644
--- a/ortho/ortho_nodes.common.ads
+++ b/ortho/ortho_nodes.common.ads
@@ -171,9 +171,10 @@ package ORTHO_NODES is
-- 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;
+ -- Returns the offset of FIELD in its record REC_TYPE. The result is a
+ -- literal of unsigned type or access type RTYPE.
+ function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode)
+ return O_Cnode;
-- Get the address of a subprogram.
function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
generated by cgit (git 2.34.1) at 2024-12-22 03:43:10 +0000