ortho: add unbounded records, rework array subtypes.

3 files changed, 119 insertions, 24 deletions

diff --git a/src/ortho/llvm6/llvm-cbindings.cpp b/src/ortho/llvm6/llvm-cbindings.cpp
index 984258592..1841f5f8e 100644
--- a/src/ortho/llvm6/llvm-cbindings.cpp
+++ b/src/ortho/llvm6/llvm-cbindings.cpp
@@ -392,6 +392,9 @@ struct OTnodeBase {
   unsigned long long getSize() const {
     return LLVMABISizeOfType(TheTargetData, Ref);
   }
+  unsigned long long getBitSize() const {
+    return 8 * getSize();
+  }
 };
 
 typedef OTnodeBase *OTnode;
@@ -713,11 +716,11 @@ buildDebugRecordElements(OTnodeRecBase *Atype)
 
   unsigned i = 0;
   for (OFnodeBase *e : Atype->Els) {
-    unsigned off = LLVMOffsetOfElement(TheTargetData, Atype->Ref, i);
+    unsigned bitoff = 8 * LLVMOffsetOfElement(TheTargetData, Atype->Ref, i);
     els[i++] = DBuilder->createMemberType
-      (DebugCurrentSubprg, StringRef(e->Ident.cstr), DebugCurrentFile,
-       DebugCurrentLine, e->FType->getSize(), e->FType->getAlignment(),
-       off, DINode::DIFlags::FlagPublic, e->FType->Dbg);
+      (DebugCurrentSubprg, StringRef(e->Ident.cstr), NULL, 0,
+       e->FType->getBitSize(), /* align */ 0,
+       bitoff, DINode::DIFlags::FlagZero, e->FType->Dbg);
   }
 
   return DBuilder->getOrCreateArray(els);
@@ -744,24 +747,68 @@ finish_record_type(OElementList *Els, OTnode *Res)
     LLVMStructSetBody (Els->RecType->Ref, Types, Els->Count, 0);
     Els->RecType->Bounded = Bounded;
     T = static_cast<OTnodeRecBase *>(Els->RecType);
+    T->Els = std::move(*Els->Els);
 #ifdef USE_DEBUG
     if (FlagDebug) {
       DICompositeType *Dbg;
       Dbg = DBuilder->createStructType
         (DebugCurrentSubprg, T->Dbg->getName(), DebugCurrentFile,
-         DebugCurrentLine, T->getSize(), T->getAlignment(),
-         DINode::DIFlags::FlagPublic, nullptr,
+         DebugCurrentLine, T->getBitSize(), /* Align */ 0,
+         DINode::DIFlags::FlagZero, nullptr,
          buildDebugRecordElements(T));
       llvm::TempMDNode fwd_decl(T->Dbg);
       T->Dbg = DBuilder->replaceTemporary(std::move(fwd_decl), Dbg);
     }
 #endif
   } else {
+    //  Non-completion.
+    //  Debug info are created when the type is declared.
     T = new OTnodeRec(LLVMStructType(Types, Els->Count, 0), Bounded);
+    T->Els = std::move(*Els->Els);
   }
+  *Res = T;
+}
+
+struct OElementSublist {
+  //  Number of fields.
+  unsigned Count;
+  std::vector<OFnodeBase *> *Base_Els;
+  std::vector<OFnodeBase *> *Els;
+};
+
+extern "C" void
+start_record_subtype (OTnodeRec *Rtype, OElementSublist *Elements)
+{
+  *Elements = {0,
+               &Rtype->Els,
+               new std::vector<OFnodeBase *>()};
+}
+
+extern "C" void
+new_subrecord_field(OElementSublist *Elements,
+                    OFnodeRec **El, OTnode Etype)
+{
+  OFnodeBase *Bel = (*Elements->Base_Els)[Elements->Count];
+  *El = new OFnodeRec(Etype, Bel->Ident, Elements->Count);
+  Elements->Els->push_back(*El);
+  Elements->Count++;
+}
+
+extern "C" void
+finish_record_subtype(OElementSublist *Els, OTnode *Res)
+{
+  LLVMTypeRef *Types = new LLVMTypeRef[Els->Count];
+
+  //  Create types array for elements.
+  int i = 0;
+  for (OFnodeBase *Field : *Els->Els) {
+    Types[i++] = Field->FType->Ref;
+  }
+
+  OTnodeRecBase *T;
+  T = new OTnodeRec(LLVMStructType(Types, Els->Count, 0), true);
   T->Els = std::move(*Els->Els);
   *Res = T;
-  delete Els->Els;
 }
 
 extern "C" void
@@ -895,14 +942,14 @@ new_array_type(OTnode ElType, OTnode IndexType)
 }
 
 extern "C" OTnode
-new_constrained_array_type(OTnodeArr *ArrType, OCnode *Length)
+new_array_subtype(OTnodeArr *ArrType, OTnode ElType, OCnode *Length)
 {
   OTnodeArr *Res;
   unsigned Len = LLVMConstIntGetZExtValue(Length->Ref);
 
-  Res = new OTnodeArr(LLVMArrayType(ArrType->ElType->Ref, Len),
-                      ArrType->ElType->Bounded,
-                      ArrType->ElType);
+  Res = new OTnodeArr(LLVMArrayType(ElType->Ref, Len),
+                      ElType->Bounded,
+                      ElType);
 
 #ifdef USE_DEBUG
   if (FlagDebug)
@@ -960,14 +1007,14 @@ new_type_decl(OIdent Ident, OTnode Atype)
       if (static_cast<OTnodeAccBase*>(Atype)->Acc == nullptr) {
         //  Still incomplete
         Atype->Dbg = DBuilder->createPointerType
-          (nullptr, Atype->getSize(), 0, None, StringRef(Ident.cstr));
+          (nullptr, Atype->getBitSize(), 0, None, StringRef(Ident.cstr));
         break;
       }
       // Fallthrough
     case OTKAccess:
       Atype->Dbg = DBuilder->createPointerType
         (static_cast<OTnodeAcc*>(Atype)->Acc->Dbg,
-         Atype->getSize(), 0, None, StringRef(Ident.cstr));
+         Atype->getBitSize(), 0, None, StringRef(Ident.cstr));
       break;
 
     case OTKArray:
@@ -981,7 +1028,7 @@ new_type_decl(OIdent Ident, OTnode Atype)
     case OTKRecord:
       Atype->Dbg = DBuilder->createStructType
         (DebugCurrentSubprg, StringRef(Ident.cstr), DebugCurrentFile,
-         DebugCurrentLine, Atype->getSize(), Atype->getAlignment(),
+         DebugCurrentLine, Atype->getBitSize(), /* align */ 0,
          DINode::DIFlags::FlagPublic, nullptr,
          buildDebugRecordElements(static_cast<OTnodeRecBase *>(Atype)));
       break;
@@ -995,13 +1042,14 @@ new_type_decl(OIdent Ident, OTnode Atype)
         for (OFnodeBase *e : static_cast<OTnodeUnion *>(Atype)->Els) {
           els[i++] = DBuilder->createMemberType
             (DebugCurrentSubprg, StringRef(e->Ident.cstr), DebugCurrentFile,
-             DebugCurrentLine, e->FType->getSize(), e->FType->getAlignment(),
-             0, DINode::DIFlags::FlagPublic, e->FType->Dbg);
+             DebugCurrentLine, e->FType->getBitSize(),
+             e->FType->getAlignment(), 0, DINode::DIFlags::FlagPublic,
+             e->FType->Dbg);
         }
 
         Atype->Dbg = DBuilder->createUnionType
           (DebugCurrentSubprg, StringRef(Ident.cstr), DebugCurrentFile,
-           DebugCurrentLine, Atype->getSize(), Atype->getAlignment(),
+           DebugCurrentLine, Atype->getBitSize(), Atype->getAlignment(),
            DINode::DIFlags::FlagPublic, DBuilder->getOrCreateArray(els));
       }
       break;
@@ -1121,6 +1169,12 @@ new_sizeof(OTnode Atype, OTnode Rtype)
 }
 
 extern "C" OCnode
+new_record_sizeof(OTnode Atype, OTnode Rtype)
+{
+  return new_sizeof(Atype, Rtype);
+}
+
+extern "C" OCnode
 new_alignof(OTnode Atype, OTnode Rtype)
 {
   return constToConst
diff --git a/src/ortho/llvm6/ortho_llvm.ads b/src/ortho/llvm6/ortho_llvm.ads
index b342140dc..74bae8ed5 100644
--- a/src/ortho/llvm6/ortho_llvm.ads
+++ b/src/ortho/llvm6/ortho_llvm.ads
@@ -98,8 +98,8 @@ package Ortho_LLVM is
 
    --  Build a record type.
    procedure Start_Record_Type (Elements : out O_Element_List);
-   --  Add a field in the record; not constrained array are prohibited, since
-   --  its size is unlimited.
+   --  Add a field in the record.  Unconstrained fields must be at the end,
+   --  and cannot be followed by a constrained one.
    procedure New_Record_Field
      (Elements : in out O_Element_List;
       El : out O_Fnode;
@@ -108,6 +108,17 @@ package Ortho_LLVM is
    procedure Finish_Record_Type
      (Elements : in out O_Element_List; Res : out O_Tnode);
 
+   type O_Element_Sublist is limited private;
+
+   --  Build a record subtype.
+   --  Re-declare only unconstrained fields with a subtype of them.
+   procedure Start_Record_Subtype
+     (Rtype : O_Tnode; Elements : out O_Element_Sublist);
+   procedure New_Subrecord_Field
+     (Elements : in out O_Element_Sublist; El : out O_Fnode; Etype : O_Tnode);
+   procedure Finish_Record_Subtype
+     (Elements : in out O_Element_Sublist; Res : out O_Tnode);
+
    -- Build an uncomplete record type:
    -- First call NEW_UNCOMPLETE_RECORD_TYPE, which returns a record type.
    -- This type can be declared or used to define access types on it.
@@ -139,8 +150,8 @@ package Ortho_LLVM is
      return O_Tnode;
 
    --  Build a constrained array type.
-   function New_Constrained_Array_Type (Atype : O_Tnode; Length : O_Cnode)
-     return O_Tnode;
+   function New_Array_Subtype
+     (Atype : O_Tnode; El_Type : O_Tnode; Length : O_Cnode) return O_Tnode;
 
    --  Build a scalar type; size may be 8, 16, 32 or 64.
    function New_Unsigned_Type (Size : Natural) return O_Tnode;
@@ -213,9 +224,13 @@ package Ortho_LLVM is
 
    --  Returns the size in bytes of ATYPE.  The result is a literal of
    --  unsigned type RTYPE
-   --  ATYPE cannot be an unconstrained array type.
+   --  ATYPE cannot be an unconstrained type.
    function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode;
 
+   --  Get the size of the bounded part of a record.
+   function New_Record_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;
@@ -668,6 +683,14 @@ private
    end record;
    pragma Convention (C, O_Element_List);
 
+   type O_Element_Sublist is record
+      --  Number of fields.
+      Count : Natural;
+      Base_Els : O_Element_Vec;
+      Els : O_Element_Vec;
+   end record;
+   pragma Convention (C, O_Element_Sublist);
+
    type ValueRefArray_Acc is access Opaque_Type;
    pragma Convention (C, ValueRefArray_Acc);
 
@@ -770,6 +793,10 @@ private
    pragma Import (C, New_Uncomplete_Record_Type);
    pragma Import (C, Start_Uncomplete_Record_Type);
 
+   pragma Import (C, Start_Record_Subtype);
+   pragma Import (C, New_Subrecord_Field);
+   pragma Import (C, Finish_Record_Subtype);
+
    pragma Import (C, Start_Union_Type);
    pragma Import (C, New_Union_Field);
    pragma Import (C, Finish_Union_Type);
@@ -782,7 +809,7 @@ private
    pragma Import (C, Finish_Access_Type);
 
    pragma Import (C, New_Array_Type);
-   pragma Import (C, New_Constrained_Array_Type);
+   pragma Import (C, New_Array_Subtype);
 
    pragma Import (C, New_Boolean_Type);
    pragma Import (C, Start_Enum_Type);
@@ -804,6 +831,7 @@ private
    pragma Import (C, New_Access_Element);
 
    pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Record_Sizeof);
    pragma Import (C, New_Alignof);
    pragma Import (C, New_Offsetof);
 
diff --git a/src/ortho/llvm6/ortho_llvm.private.ads b/src/ortho/llvm6/ortho_llvm.private.ads
index 7a873d8bf..35fdefe0e 100644
--- a/src/ortho/llvm6/ortho_llvm.private.ads
+++ b/src/ortho/llvm6/ortho_llvm.private.ads
@@ -222,6 +222,14 @@ private
    end record;
    pragma Convention (C, O_Element_List);
 
+   type O_Element_Sublist is record
+      --  Number of fields.
+      Count : Natural;
+      Base_Els : O_Element_Vec;
+      Els : O_Element_Vec;
+   end record;
+   pragma Convention (C, O_Element_Sublist);
+
    type ValueRefArray_Acc is access Opaque_Type;
    pragma Convention (C, ValueRefArray_Acc);
 
@@ -324,6 +332,10 @@ private
    pragma Import (C, New_Uncomplete_Record_Type);
    pragma Import (C, Start_Uncomplete_Record_Type);
 
+   pragma Import (C, Start_Record_Subtype);
+   pragma Import (C, New_Subrecord_Field);
+   pragma Import (C, Finish_Record_Subtype);
+
    pragma Import (C, Start_Union_Type);
    pragma Import (C, New_Union_Field);
    pragma Import (C, Finish_Union_Type);
@@ -336,7 +348,7 @@ private
    pragma Import (C, Finish_Access_Type);
 
    pragma Import (C, New_Array_Type);
-   pragma Import (C, New_Constrained_Array_Type);
+   pragma Import (C, New_Array_Subtype);
 
    pragma Import (C, New_Boolean_Type);
    pragma Import (C, Start_Enum_Type);
@@ -358,6 +370,7 @@ private
    pragma Import (C, New_Access_Element);
 
    pragma Import (C, New_Sizeof);
+   pragma Import (C, New_Record_Sizeof);
    pragma Import (C, New_Alignof);
    pragma Import (C, New_Offsetof);