ortho: add new_default_value to initialize a variable.

12 files changed, 75 insertions, 19 deletions

diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb
index 145a4c5e9..f5c76cca5 100644
--- a/src/ortho/debug/ortho_debug-disp.adb
+++ b/src/ortho/debug/ortho_debug-disp.adb
@@ -480,6 +480,12 @@ package body Ortho_Debug.Disp is
             Put ("'[");
             Put_Keyword ("null");
             Put (']');
+         when OC_Default_Lit =>
+            --  Always disp the type of default literals.
+            Disp_Tnode_Name (C.Ctype);
+            Put ("'[");
+            Put_Keyword ("default");
+            Put (']');
          when OC_Enum_Lit =>
             --  Always disp the type of enum literals.
             Disp_Lit (C.Ctype, False, Get_String (C.E_Name));
diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb
index 218fd9671..6e9b2b89d 100644
--- a/src/ortho/debug/ortho_debug.adb
+++ b/src/ortho/debug/ortho_debug.adb
@@ -399,11 +399,20 @@ package body Ortho_Debug is
       if Ltype.Kind /= ON_Access_Type then
          raise Type_Error;
       end if;
-      return  new O_Cnode_Null_Lit_Type'(Kind => OC_Null_Lit,
+      return new O_Cnode_Null_Lit_Type'(Kind => OC_Null_Lit,
                                          Ctype => Ltype,
                                          Ref => False);
    end New_Null_Access;
 
+   function New_Default_Value (Ltype : O_Tnode) return O_Cnode
+   is
+      subtype O_Cnode_Default_Lit_Type is O_Cnode_Type (OC_Default_Lit);
+   begin
+      return new O_Cnode_Default_Lit_Type'(Kind => OC_Default_Lit,
+                                           Ctype => Ltype,
+                                           Ref => False);
+   end New_Default_Value;
+
    function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode
    is
       subtype O_Cnode_Sizeof_Type is O_Cnode_Type (OC_Sizeof_Lit);
diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads
index 7a050321a..a1e711b62 100644
--- a/src/ortho/debug/ortho_debug.private.ads
+++ b/src/ortho/debug/ortho_debug.private.ads
@@ -134,6 +134,7 @@ private
       OC_Sizeof_Lit,
       OC_Alignof_Lit,
       OC_Offsetof_Lit,
+      OC_Default_Lit,
       OC_Aggregate,
       OC_Aggr_Element,
       OC_Union_Aggr,
@@ -162,6 +163,8 @@ private
             E_Name : O_Ident;
          when OC_Null_Lit =>
             null;
+         when OC_Default_Lit =>
+            null;
          when OC_Sizeof_Lit
            | OC_Alignof_Lit =>
             S_Type : O_Tnode;
diff --git a/src/ortho/gcc/ortho-lang.c b/src/ortho/gcc/ortho-lang.c
index b4fdbe388..fc86d799f 100644
--- a/src/ortho/gcc/ortho-lang.c
+++ b/src/ortho/gcc/ortho-lang.c
@@ -1376,7 +1376,6 @@ finish_array_aggr (struct o_array_aggr_list *list, tree *res)
   *res = build_constructor (list->atype, list->elts);
 }
 
-
 tree
 new_union_aggr (tree atype, tree field, tree value)
 {
@@ -1388,6 +1387,12 @@ new_union_aggr (tree atype, tree field, tree value)
 }
 
 tree
+new_default_value (tree atype)
+{
+  return build_constructor (atype, NULL);
+}
+
+tree
 new_indexed_element (tree arr, tree index)
 {
   ortho_mark_addressable (arr);
diff --git a/src/ortho/gcc/ortho_gcc.ads b/src/ortho/gcc/ortho_gcc.ads
index ab7e0e3d0..7332ceb21 100644
--- a/src/ortho/gcc/ortho_gcc.ads
+++ b/src/ortho/gcc/ortho_gcc.ads
@@ -138,6 +138,10 @@ package Ortho_Gcc is
    --  Create a null access literal.
    function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
 
+   --  Create a literal with default (null) values.  Can only be used to
+   --  define the initial value of a static decalaration.
+   function New_Default_Value (Ltype : O_Tnode) return O_Cnode;
+
    --  Build a record/array aggregate.
    --  The aggregate is constant, and therefore can be only used to initialize
    --  constant declaration.
@@ -634,6 +638,7 @@ private
    pragma Import (C, New_Array_Aggr_El);
    pragma Import (C, Finish_Array_Aggr);
    pragma Import (C, New_Union_Aggr);
+   pragma Import (C, New_Default_Value);
 
    pragma Import (C, New_Indexed_Element);
    pragma Import (C, New_Slice);
diff --git a/src/ortho/gcc/ortho_gcc.private.ads b/src/ortho/gcc/ortho_gcc.private.ads
index 615c8aa13..fcbc59129 100644
--- a/src/ortho/gcc/ortho_gcc.private.ads
+++ b/src/ortho/gcc/ortho_gcc.private.ads
@@ -202,6 +202,7 @@ private
    pragma Import (C, New_Array_Aggr_El);
    pragma Import (C, Finish_Array_Aggr);
    pragma Import (C, New_Union_Aggr);
+   pragma Import (C, New_Default_Value);
 
    pragma Import (C, New_Indexed_Element);
    pragma Import (C, New_Slice);
diff --git a/src/ortho/llvm/llvm-core.ads b/src/ortho/llvm/llvm-core.ads
index 4a72d5d19..7ec85c284 100644
--- a/src/ortho/llvm/llvm-core.ads
+++ b/src/ortho/llvm/llvm-core.ads
@@ -318,6 +318,9 @@ package LLVM.Core is
    function VoidType return TypeRef;
    function LabelType return TypeRef;
 
+   -- See Module::dump.
+   procedure DumpType(T : TypeRef);
+
    -- Values ------------------------------------------------------------
    -- The bulk of LLVM's object model consists of values, which comprise a very
    -- rich type hierarchy.
@@ -998,6 +1001,7 @@ private
 
    pragma Import (C, VoidType, "LLVMVoidType");
    pragma Import (C, LabelType, "LLVMLabelType");
+   pragma Import (C, DumpType, "LLVMDumpType");
 
    pragma Import (C, TypeOf, "LLVMTypeOf");
    pragma Import (C, GetValueName, "LLVMGetValueName");
diff --git a/src/ortho/llvm/ortho_code_main.adb b/src/ortho/llvm/ortho_code_main.adb
index b44081fe8..b84dfbbd2 100644
--- a/src/ortho/llvm/ortho_code_main.adb
+++ b/src/ortho/llvm/ortho_code_main.adb
@@ -72,19 +72,6 @@ procedure Ortho_Code_Main is
    Features : constant Cstring := Empty_Cstring;
    Reloc : constant RelocMode := RelocDefault;
 
-   procedure Dump_Llvm
-   is
-      use LLVM.Analysis;
-      Msg : aliased Cstring;
-   begin
-      DumpModule (Module);
-      if LLVM.Analysis.VerifyModule
-        (Module, PrintMessageAction, Msg'Access) /= 0
-      then
-         null;
-      end if;
-   end Dump_Llvm;
-
    function To_String (C : Cstring) return String is
       function Strlen (C : Cstring) return Natural;
       pragma Import (C, Strlen);
@@ -296,7 +283,7 @@ begin
    --  Ortho_Mcode.Finish;
 
    if Flag_Dump_Llvm then
-      Dump_Llvm;
+      DumpModule (Module);
    end if;
 
    --  Verify module.
@@ -391,7 +378,7 @@ begin
 
       end;
    else
-      Dump_Llvm;
+      DumpModule (Module);
    end if;
 
    Set_Exit_Status (Success);
diff --git a/src/ortho/llvm/ortho_llvm.adb b/src/ortho/llvm/ortho_llvm.adb
index 8106f9d7d..3075b8bca 100644
--- a/src/ortho/llvm/ortho_llvm.adb
+++ b/src/ortho/llvm/ortho_llvm.adb
@@ -946,9 +946,15 @@ package body Ortho_LLVM is
      (List : in out O_Record_Aggr_List;
       Res : out O_Cnode)
    is
+      V : ValueRef;
    begin
-      Res := (LLVM => ConstStruct (List.Vals.all, List.Len, 0),
-              Ctype => List.Atype);
+      if List.Atype.Kind = ON_Incomplete_Record_Type then
+         V := ConstNamedStruct (Get_LLVM_Type (List.Atype),
+                                List.Vals.all, List.Len);
+      else
+         V := ConstStruct (List.Vals.all, List.Len, 0);
+      end if;
+      Res := (LLVM => V, Ctype => List.Atype);
       Free (List.Vals);
    end Finish_Record_Aggr;
 
@@ -1028,6 +1034,16 @@ package body Ortho_LLVM is
       end if;
    end New_Union_Aggr;
 
+   -----------------------
+   -- New_Default_Value --
+   -----------------------
+
+   function New_Default_Value (Ltype : O_Tnode) return O_Cnode is
+   begin
+      return O_Cnode'(LLVM => ConstNull (Ltype.LLVM),
+                      Ctype => Ltype);
+   end New_Default_Value;
+
    ----------------
    -- New_Sizeof --
    ----------------
diff --git a/src/ortho/llvm/ortho_llvm.ads b/src/ortho/llvm/ortho_llvm.ads
index 3f77a86b9..1dca66f4e 100644
--- a/src/ortho/llvm/ortho_llvm.ads
+++ b/src/ortho/llvm/ortho_llvm.ads
@@ -161,6 +161,10 @@ package Ortho_LLVM is
    --  Create a null access literal.
    function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
 
+   --  Create a literal with default (null) values.  Can only be used to
+   --  define the initial value of a static decalaration.
+   function New_Default_Value (Ltype : O_Tnode) return O_Cnode;
+
    --  Build a record/array aggregate.
    --  The aggregate is constant, and therefore can be only used to initialize
    --  constant declaration.
diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb
index 6ba026221..0ef96914e 100644
--- a/src/ortho/oread/ortho_front.adb
+++ b/src/ortho/oread/ortho_front.adb
@@ -1417,6 +1417,8 @@ package body Ortho_Front is
             end;
          when Tok_Null =>
             Res := New_Null_Access (Atype.Type_Onode);
+         when Tok_Default =>
+            Res := New_Default_Value (Atype.Type_Onode);
          when others =>
             Parse_Error ("bad primary expression: " & Token_Type'Image (Tok));
             return O_Cnode_Null;
@@ -2422,6 +2424,11 @@ package body Ortho_Front is
             --return Parse_Primary_Expression (Atype);
             return Parse_Typed_Literal (Atype);
          when Type_Record =>
+            if Tok = Tok_Ident then
+               --  Default value ?
+               return Parse_Typed_Literal (Atype);
+            end if;
+
             declare
                Constr : O_Record_Aggr_List;
                Field : Node_Acc;
@@ -2452,7 +2459,12 @@ package body Ortho_Front is
                Next_Token;
                return Res;
             end;
+
          when Type_Union =>
+            if Tok = Tok_Ident then
+               --  Default value ?
+               return Parse_Typed_Literal (Atype);
+            end if;
             declare
                Field : Node_Acc;
             begin
diff --git a/src/ortho/ortho_nodes.common.ads b/src/ortho/ortho_nodes.common.ads
index a40323656..d0f22b720 100644
--- a/src/ortho/ortho_nodes.common.ads
+++ b/src/ortho/ortho_nodes.common.ads
@@ -132,6 +132,10 @@ package ORTHO_NODES is
    --  Create a null access literal.
    function New_Null_Access (Ltype : O_Tnode) return O_Cnode;
 
+   --  Create a literal with default (null) values.  Can only be used to
+   --  define the initial value of a static decalaration.
+   function New_Default_Value (Ltype : O_Tnode) return O_Cnode;
+
    --  Build a record/array aggregate.
    --  The aggregate is constant, and therefore can be only used to initialize
    --  constant declaration.