diff options
Diffstat (limited to 'src/ortho/debug')
-rw-r--r-- | src/ortho/debug/ortho_debug-disp.adb | 2 | ||||
-rw-r--r-- | src/ortho/debug/ortho_debug.adb | 54 | ||||
-rw-r--r-- | src/ortho/debug/ortho_debug.private.ads | 15 |
3 files changed, 36 insertions, 35 deletions
diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb index bcca8dbd1..145a4c5e9 100644 --- a/src/ortho/debug/ortho_debug-disp.adb +++ b/src/ortho/debug/ortho_debug-disp.adb @@ -885,7 +885,7 @@ package body Ortho_Debug.Disp is Put (" : "); Disp_Tnode_Name (Decl.Dtype); Put_Line (";"); - when ON_Const_Value => + when ON_Init_Value => Put_Keyword ("constant"); Put (" "); Disp_Ident (Decl.Name); diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb index 00bfcbc5c..218fd9671 100644 --- a/src/ortho/debug/ortho_debug.adb +++ b/src/ortho/debug/ortho_debug.adb @@ -1265,58 +1265,57 @@ package body Ortho_Debug is Storage => Storage, Scope => Current_Decl_Scope.Parent, Lineno => 0, - Const_Value => O_Dnode_Null); + Value_Decl => O_Dnode_Null); Add_Decl (Res); end New_Const_Decl; - procedure Start_Const_Value (Const : in out O_Dnode) + procedure Start_Init_Value (Decl : in out O_Dnode) is - subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value); + subtype O_Dnode_Init_Value is O_Dnode_Type (ON_Init_Value); N : O_Dnode; begin - if Const.Const_Value /= O_Dnode_Null then + if Decl.Value_Decl /= O_Dnode_Null then -- Constant already has a value. raise Syntax_Error; end if; - if Const.Storage = O_Storage_External then - -- An external constant must not have a value. + if Decl.Storage = O_Storage_External then + -- An external variable/constant cannot have a value. raise Syntax_Error; end if; -- FIXME: check scope is the same. - N := new O_Dnode_Const_Value'(Kind => ON_Const_Value, - Name => Const.Name, - Next => null, - Dtype => Const.Dtype, - Storage => Const.Storage, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Const_Decl => Const, - Value => O_Cnode_Null); - Const.Const_Value := N; + N := new O_Dnode_Init_Value'(Kind => ON_Init_Value, + Name => Decl.Name, + Next => null, + Dtype => Decl.Dtype, + Storage => Decl.Storage, + Scope => Current_Decl_Scope.Parent, + Lineno => 0, + Init_Decl => Decl, + Value => O_Cnode_Null); + Decl.Value_Decl := N; Add_Decl (N, False); - end Start_Const_Value; + end Start_Init_Value; - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) - is + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode) is begin - if Const.Const_Value = O_Dnode_Null then - -- Start_Const_Value not called. + if Decl.Value_Decl = O_Dnode_Null then + -- Start_Init_Value not called. raise Syntax_Error; end if; - if Const.Const_Value.Value /= O_Cnode_Null then - -- Finish_Const_Value already called. + if Decl.Value_Decl.Value /= O_Cnode_Null then + -- Finish_Init_Value already called. raise Syntax_Error; end if; if Val = O_Cnode_Null then -- No value or bad type. raise Type_Error; end if; - Check_Type (Val.Ctype, Const.Dtype); - Const.Const_Value.Value := Val; - end Finish_Const_Value; + Check_Type (Val.Ctype, Decl.Dtype); + Decl.Value_Decl.Value := Val; + end Finish_Init_Value; procedure New_Var_Decl (Res : out O_Dnode; @@ -1334,7 +1333,8 @@ package body Ortho_Debug is Dtype => Atype, Storage => Storage, Lineno => 0, - Scope => Current_Decl_Scope.Parent); + Scope => Current_Decl_Scope.Parent, + Value_Decl => O_Dnode_Null); Add_Decl (Res); end New_Var_Decl; diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads index 2a733526c..7a050321a 100644 --- a/src/ortho/debug/ortho_debug.private.ads +++ b/src/ortho/debug/ortho_debug.private.ads @@ -48,7 +48,7 @@ private (ON_Type_Decl, ON_Completed_Type_Decl, ON_Const_Decl, ON_Var_Decl, ON_Interface_Decl, ON_Function_Decl, ON_Function_Body, - ON_Const_Value, + ON_Init_Value, ON_Debug_Line_Decl, ON_Debug_Comment_Decl, ON_Debug_Filename_Decl); type O_Dnode_Type (<>); @@ -70,13 +70,14 @@ private null; when ON_Completed_Type_Decl => null; - when ON_Const_Decl => - Const_Value : O_Dnode; - when ON_Const_Value => - Const_Decl : O_Dnode; + when ON_Const_Decl + | ON_Var_Decl => + -- Corresponding declaration for initial value (if any). + Value_Decl : O_Dnode; + when ON_Init_Value => + -- Corresponding declaration of the object. + Init_Decl : O_Dnode; Value : O_Cnode; - when ON_Var_Decl => - null; when ON_Function_Decl => Interfaces : O_Dnode; Func_Body : O_Dnode; |