aboutsummaryrefslogtreecommitdiffstats
path: root/src/ortho/debug/ortho_debug.adb
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2018-10-17 06:18:36 +0200
committerTristan Gingold <tgingold@free.fr>2018-10-21 08:03:37 +0200
commited7ad157dbecc784bb2df44684442e88431db561 (patch)
tree491533354ca2add405e08869f66c1c74622f97d7 /src/ortho/debug/ortho_debug.adb
parent13000af67c96c2a3417fa321daa3fbf50165f54f (diff)
downloadghdl-ed7ad157dbecc784bb2df44684442e88431db561.tar.gz
ghdl-ed7ad157dbecc784bb2df44684442e88431db561.tar.bz2
ghdl-ed7ad157dbecc784bb2df44684442e88431db561.zip
Rework translation of unbounded and complex types.
Diffstat (limited to 'src/ortho/debug/ortho_debug.adb')
-rw-r--r--src/ortho/debug/ortho_debug.adb74
1 files changed, 63 insertions, 11 deletions
diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb
index 3645b89e8..bb32197a4 100644
--- a/src/ortho/debug/ortho_debug.adb
+++ b/src/ortho/debug/ortho_debug.adb
@@ -288,6 +288,14 @@ package body Ortho_Debug is
N.Ref := True;
end Check_Ref;
+ procedure Check_Ref (N : O_Gnode) is
+ begin
+ if N.Ref then
+ raise Syntax_Error;
+ end if;
+ N.Ref := True;
+ end Check_Ref;
+
procedure Check_Complete_Type (T : O_Tnode) is
begin
if not T.Complete then
@@ -928,7 +936,7 @@ package body Ortho_Debug is
| ON_Interface_Decl =>
null;
when others =>
- raise Program_Error;
+ raise Syntax_Error;
end case;
Check_Scope (Obj);
return new O_Lnode_Obj'(Kind => OL_Obj,
@@ -937,8 +945,28 @@ package body Ortho_Debug is
Obj => Obj);
end New_Obj;
+ function New_Global (Decl : O_Dnode) return O_Gnode
+ is
+ subtype O_Gnode_Decl is O_Gnode_Type (OG_Decl);
+ begin
+ case Decl.Kind is
+ when ON_Const_Decl
+ | ON_Var_Decl =>
+ null;
+ when others =>
+ raise Syntax_Error;
+ end case;
+ if Decl.Storage = O_Storage_Local then
+ raise Syntax_Error;
+ end if;
+ return new O_Gnode_Decl'(Kind => OG_Decl,
+ Rtype => Decl.Dtype,
+ Ref => False,
+ Decl => Decl);
+ end New_Global;
+
function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode)
- return O_Lnode
+ return O_Lnode
is
subtype O_Lnode_Indexed is O_Lnode_Type (OL_Indexed_Element);
Res : O_Lnode;
@@ -953,7 +981,7 @@ package body Ortho_Debug is
end New_Indexed_Element;
function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode)
- return O_Lnode
+ return O_Lnode
is
subtype O_Lnode_Slice is O_Lnode_Type (OL_Slice);
Res : O_Lnode;
@@ -995,6 +1023,27 @@ package body Ortho_Debug is
Rec_El => El);
end New_Selected_Element;
+ function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode)
+ return O_Gnode
+ is
+ subtype O_Gnode_Selected_Element is O_Gnode_Type (OG_Selected_Element);
+ begin
+ if Rec.Rtype.Kind /= ON_Record_Type
+ and then Rec.Rtype.Kind /= ON_Union_Type
+ then
+ raise Type_Error;
+ end if;
+ if Rec.Rtype /= El.Parent then
+ raise Type_Error;
+ end if;
+ Check_Ref (Rec);
+ return new O_Gnode_Selected_Element'(Kind => OG_Selected_Element,
+ Rtype => El.Ftype,
+ Ref => False,
+ Rec_Base => Rec,
+ Rec_El => El);
+ end New_Global_Selected_Element;
+
function New_Access_Element (Acc : O_Enode) return O_Lnode
is
subtype O_Lnode_Access_Element is O_Lnode_Type (OL_Access_Element);
@@ -1086,12 +1135,13 @@ package body Ortho_Debug is
Lvalue => Lvalue);
end New_Address;
- function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode)
+ function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode)
return O_Cnode
is
subtype O_Cnode_Address is O_Cnode_Type (OC_Unchecked_Address);
begin
- Check_Scope (Decl);
+ -- FIXME: check Lvalue is a static object.
+ Check_Ref (Lvalue);
if Atype.Kind /= ON_Access_Type then
-- An address is of type access.
raise Type_Error;
@@ -1099,25 +1149,27 @@ package body Ortho_Debug is
return new O_Cnode_Address'(Kind => OC_Unchecked_Address,
Ctype => Atype,
Ref => False,
- Decl => Decl);
+ Addr_Global => Lvalue);
end New_Global_Unchecked_Address;
- function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) return O_Cnode
+ function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode)
+ return O_Cnode
is
subtype O_Cnode_Address is O_Cnode_Type (OC_Address);
begin
- Check_Scope (Decl);
+ -- FIXME: check Lvalue is a static object.
+ Check_Ref (Lvalue);
if Atype.Kind /= ON_Access_Type then
-- An address is of type access.
raise Type_Error;
end if;
- if Get_Base_Type (Decl.Dtype) /= Get_Base_Type (Atype.D_Type) then
+ if Get_Base_Type (Lvalue.Rtype) /= Get_Base_Type (Atype.D_Type) then
raise Type_Error;
end if;
return new O_Cnode_Address'(Kind => OC_Address,
Ctype => Atype,
Ref => False,
- Decl => Decl);
+ Addr_Global => Lvalue);
end New_Global_Address;
function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode)
@@ -1132,7 +1184,7 @@ package body Ortho_Debug is
return new O_Cnode_Subprg_Address'(Kind => OC_Subprogram_Address,
Ctype => Atype,
Ref => False,
- Decl => Subprg);
+ Addr_Decl => Subprg);
end New_Subprogram_Address;
-- Raise TYPE_ERROR is ATYPE is a composite type.