From 04cd83fb46bee1e7a7b37be95bee73449af9c8b8 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Fri, 24 Jul 2020 18:31:11 +0200 Subject: ortho: add unbounded records, rework array subtypes. --- src/ortho/llvm6/llvm-cbindings.cpp | 88 +++++++++++++++++++++++++++------- src/ortho/llvm6/ortho_llvm.ads | 40 +++++++++++++--- src/ortho/llvm6/ortho_llvm.private.ads | 15 +++++- 3 files changed, 119 insertions(+), 24 deletions(-) (limited to 'src/ortho/llvm6') 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(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 *Base_Els; + std::vector *Els; +}; + +extern "C" void +start_record_subtype (OTnodeRec *Rtype, OElementSublist *Elements) +{ + *Elements = {0, + &Rtype->Els, + new std::vector()}; +} + +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(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(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(Atype))); break; @@ -995,13 +1042,14 @@ new_type_decl(OIdent Ident, OTnode Atype) for (OFnodeBase *e : static_cast(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; @@ -1120,6 +1168,12 @@ new_sizeof(OTnode Atype, OTnode Rtype) return constToConst(Rtype, LLVMABISizeOfType(TheTargetData, Atype->Ref)); } +extern "C" OCnode +new_record_sizeof(OTnode Atype, OTnode Rtype) +{ + return new_sizeof(Atype, Rtype); +} + extern "C" OCnode new_alignof(OTnode Atype, OTnode Rtype) { 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); -- cgit v1.2.3