Extensions to the LLVM debug information metadata to support the Fortran

language.  There are several new debug info constructs added here.  They
include the following.

!DIStringType :
Debug clients expect Fortran CHARACTER types to appear as
DW_TAG_string_type in the DWARF. !DIStringType can be used to generate
DWARF for constant and variable sized CHARACTER type variables.  If the
size of a CHARACTER must be computed at run-time, DWARF specifies that
the DW_TAG_string_type has a DW_AT_string_length with a location expression.

!DIFortranArrayType and !DIFortranSubrange :
Debug clients expect Fortran arrays to specify the bounds of their
dimensions in DW_TAG_subrange_types.  Both the lower and upper bounds can
be given by the programmer as constants, variables, a mix of constants
and variables, omitted, or as deferred.  The DWARF standard requires
that these bounds appear in the DW_TAG_subrange_type.  Debug clients
expect variable bounds to be encoded in blocks.

DIFlag{Elemental,Pure,Recursive} :
Flags to support these Fortran procedure prefixes are added.

Author: schweitzpgi

include/llvm/Bitcode/LLVMBitCodes.h

@@ -298,6 +298,9 @@ enum MetadataCodes {
   METADATA_GLOBAL_VAR_EXPR = 37,        // [distinct, var, expr]
   METADATA_INDEX_OFFSET = 38,           // [offset]
   METADATA_INDEX = 39,                  // [bitpos]
+  METADATA_STRING_TYPE = 40,      // [distinct, name, size, align, ...]
+  METADATA_FORTRAN_ARRAY_TYPE = 41, // [distinct, name, [bounds ...], ...]
+  METADATA_FORTRAN_SUBRANGE = 42, // [distinct, lbound, lbnde, ubound, ubnde]
 };
 
 // The constants block (CONSTANTS_BLOCK_ID) describes emission for each

include/llvm/IR/DIBuilder.h

@@ -165,6 +165,12 @@ namespace llvm {
     DIBasicType *createBasicType(StringRef Name, uint64_t SizeInBits,
                                  unsigned Encoding);
 
+    /// Create debugging information entry for a string
+    /// type.
+    /// \param Name        Type name.
+    /// \param SizeInBits  Size of the type.
+    DIStringType *createStringType(StringRef Name, uint64_t SizeInBits);
+
     /// Create debugging information entry for a qualified
     /// type, e.g. 'const int'.
     /// \param Tag         Tag identifing type, e.g. dwarf::TAG_volatile_type
@@ -409,6 +415,14 @@ namespace llvm {
     DICompositeType *createArrayType(uint64_t Size, uint32_t AlignInBits,
                                      DIType *Ty, DINodeArray Subscripts);
 
+    /// Create debugging information entry for a Fortran array.
+    /// \param Size         Array size.
+    /// \param AlignInBits  Alignment.
+    /// \param Ty           Element type.
+    /// \param Subscripts   Subscripts.
+    DIFortranArrayType *createFortranArrayType(
+        uint64_t Size, uint32_t AlignInBits, DIType *Ty, DINodeArray Subs);
+
     /// Create debugging information entry for a vector type.
     /// \param Size         Array size.
     /// \param AlignInBits  Alignment.
@@ -487,6 +501,12 @@ namespace llvm {
     /// implicitly uniques the values returned.
     DISubrange *getOrCreateSubrange(int64_t Lo, int64_t Count);
 
+    /// Create a descriptor for a value range.  This
+    /// implicitly uniques the values returned.
+    DIFortranSubrange *getOrCreateFortranSubrange(
+        int64_t CLBound, int64_t CUBound, bool NoUBound, Metadata *Lbound,
+        Metadata * Lbndexp, Metadata *Ubound, Metadata * Ubndexp);
+
     /// Create a new descriptor for the specified variable.
     /// \param Context     Variable scope.
     /// \param Name        Name of the variable.

include/llvm/IR/DebugInfoFlags.def

@@ -43,6 +43,9 @@ HANDLE_DI_FLAG((1 << 18), IntroducedVirtual)
 HANDLE_DI_FLAG((1 << 19), BitField)
 HANDLE_DI_FLAG((1 << 20), NoReturn)
 HANDLE_DI_FLAG((1 << 21), MainSubprogram)
+HANDLE_DI_FLAG((1 << 22), Pure)
+HANDLE_DI_FLAG((1 << 23), Elemental)
+HANDLE_DI_FLAG((1 << 24), Recursive)
 
 // To avoid needing a dedicated value for IndirectVirtualBase, we use
 // the bitwise or of Virtual and FwdDecl, which does not otherwise
@@ -52,7 +55,7 @@ HANDLE_DI_FLAG((1 << 2) | (1 << 5), IndirectVirtualBase)
 #ifdef DI_FLAG_LARGEST_NEEDED
 // intended to be used with ADT/BitmaskEnum.h
 // NOTE: always must be equal to largest flag, check this when adding new flag
-HANDLE_DI_FLAG((1 << 21), Largest)
+HANDLE_DI_FLAG((1 << 24), Largest)
 #undef DI_FLAG_LARGEST_NEEDED
 #endif
 

include/llvm/IR/DebugInfoMetadata.h

@@ -215,10 +215,13 @@ class DINode : public MDNode {
       return false;
     case GenericDINodeKind:
     case DISubrangeKind:
+    case DIFortranSubrangeKind:
     case DIEnumeratorKind:
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:
@@ -363,6 +366,71 @@ class DISubrange : public DINode {
   }
 };
 
+/// Fortran array subrange
+class DIFortranSubrange : public DINode {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  int64_t CLowerBound;
+  int64_t CUpperBound;
+  bool NoUpperBound;
+
+  DIFortranSubrange(LLVMContext &C, StorageType Storage, int64_t CLowerBound,
+                    int64_t CUpperBound, bool NoUpperBound,
+                    ArrayRef<Metadata *> Ops)
+      : DINode(C, DIFortranSubrangeKind, Storage,
+               dwarf::DW_TAG_subrange_type, Ops), CLowerBound(CLowerBound),
+        CUpperBound(CUpperBound), NoUpperBound(NoUpperBound) {}
+  ~DIFortranSubrange() = default;
+
+  static DIFortranSubrange *getImpl(LLVMContext &Context, int64_t CLBound,
+                                    int64_t CUBound, bool NoUpperBound,
+                                    Metadata *Lbound, Metadata *Lbndexp,
+                                    Metadata *Ubound, Metadata *Ubndexp,
+                                    StorageType Storage,
+                                    bool ShouldCreate = true);
+
+  TempDIFortranSubrange cloneImpl() const {
+    return getTemporary(getContext(), getCLowerBound(), getCUpperBound(),
+                        noUpperBound(), getRawLowerBound(),
+                        getRawLowerBoundExpression(), getRawUpperBound(),
+                        getRawUpperBoundExpression());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIFortranSubrange, (int64_t CLB, int64_t CUB, bool NUB,
+                                        Metadata *LBound, Metadata *LBndExp,
+                                        Metadata *UBound, Metadata *UBndExp),
+                    (CLB, CUB, NUB, LBound, LBndExp, UBound, UBndExp))
+
+  TempDIFortranSubrange clone() const { return cloneImpl(); }
+
+  DIVariable *getLowerBound() const {
+    return cast_or_null<DIVariable>(getRawLowerBound());
+  }
+  DIExpression *getLowerBoundExp() const {
+    return cast_or_null<DIExpression>(getRawLowerBoundExpression());
+  }
+  DIVariable *getUpperBound() const {
+    return  cast_or_null<DIVariable>(getRawUpperBound());
+  }
+  DIExpression *getUpperBoundExp() const {
+    return cast_or_null<DIExpression>(getRawUpperBoundExpression());
+  }
+
+  int64_t getCLowerBound() const { return CLowerBound; }
+  int64_t getCUpperBound() const { return CUpperBound; }
+  Metadata *getRawLowerBound() const { return getOperand(0); }
+  Metadata *getRawLowerBoundExpression() const { return getOperand(1); }
+  Metadata *getRawUpperBound() const { return getOperand(2); }
+  Metadata *getRawUpperBoundExpression() const { return getOperand(3); }
+  bool noUpperBound() const { return NoUpperBound; }
+
+  static bool classof(const Metadata *MD) {
+    return MD->getMetadataID() == DIFortranSubrangeKind;
+  }
+};
+
 /// Enumeration value.
 ///
 /// TODO: Add a pointer to the context (DW_TAG_enumeration_type) once that no
@@ -449,8 +517,10 @@ class DIScope : public DINode {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
     case DIFileKind:
     case DICompileUnitKind:
@@ -637,8 +707,10 @@ class DIType : public DIScope {
     default:
       return false;
     case DIBasicTypeKind:
+    case DIStringTypeKind:
     case DIDerivedTypeKind:
     case DICompositeTypeKind:
+    case DIFortranArrayTypeKind:
     case DISubroutineTypeKind:
       return true;
     }
@@ -683,6 +755,12 @@ class DIBasicType : public DIType {
 public:
   DEFINE_MDNODE_GET(DIBasicType, (unsigned Tag, StringRef Name),
                     (Tag, Name, 0, 0, 0))
+  DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, StringRef Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0))
+  DEFINE_MDNODE_GET(DIBasicType,
+                    (unsigned Tag, MDString *Name, uint64_t SizeInBits),
+                    (Tag, Name, SizeInBits, 0, 0))
   DEFINE_MDNODE_GET(DIBasicType,
                     (unsigned Tag, StringRef Name, uint64_t SizeInBits,
                      uint32_t AlignInBits, unsigned Encoding),
@@ -701,6 +779,99 @@ class DIBasicType : public DIType {
   }
 };
 
+/// String type, Fortran CHARACTER(n)
+class DIStringType : public DIType {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  unsigned Encoding;
+
+  DIStringType(LLVMContext &C, StorageType Storage, unsigned Tag,
+               uint64_t SizeInBits, uint32_t AlignInBits, unsigned Encoding,
+               ArrayRef<Metadata *> Ops)
+      : DIType(C, DIStringTypeKind, Storage, Tag, 0, SizeInBits, AlignInBits, 0,
+               FlagZero, Ops),
+        Encoding(Encoding) {}
+  ~DIStringType() = default;
+
+  static DIStringType *getImpl(LLVMContext &Context, unsigned Tag,
+                               StringRef Name, Metadata *StringLength,
+                               Metadata *StrLenExp, uint64_t SizeInBits,
+                               uint32_t AlignInBits, unsigned Encoding,
+                               StorageType Storage, bool ShouldCreate = true) {
+    return getImpl(Context, Tag, getCanonicalMDString(Context, Name),
+                   StringLength, StrLenExp, SizeInBits, AlignInBits, Encoding,
+                   Storage, ShouldCreate);
+  }
+  static DIStringType *getImpl(LLVMContext &Context, unsigned Tag,
+                               MDString *Name, Metadata *StringLength,
+                               Metadata *StrLenExp, uint64_t SizeInBits,
+                               uint32_t AlignInBits, unsigned Encoding,
+                               StorageType Storage, bool ShouldCreate = true);
+
+  TempDIStringType cloneImpl() const {
+    return getTemporary(getContext(), getTag(), getName(), getRawStringLength(),
+                        getRawStringLengthExp(), getSizeInBits(),
+                        getAlignInBits(), getEncoding());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIStringType, (unsigned Tag, StringRef Name),
+                    (Tag, Name, nullptr, nullptr, 0, 0, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, StringRef Name, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, nullptr, nullptr, SizeInBits, AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, MDString *Name, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, nullptr, nullptr, SizeInBits, AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, StringRef Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, MDString *Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, 0))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, StringRef Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits, unsigned Encoding),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, Encoding))
+  DEFINE_MDNODE_GET(DIStringType,
+                    (unsigned Tag, MDString *Name, Metadata *StringLength,
+                     Metadata *StringLengthExp, uint64_t SizeInBits,
+                     uint32_t AlignInBits, unsigned Encoding),
+                    (Tag, Name, StringLength, StringLengthExp, SizeInBits,
+                     AlignInBits, Encoding))
+
+  TempDIStringType clone() const { return cloneImpl(); }
+
+  static bool classof(const Metadata *MD) {
+    return MD->getMetadataID() == DIStringTypeKind;
+  }
+
+  DIVariable *getStringLength() const {
+    return cast_or_null<DIVariable>(getRawStringLength());
+  }
+
+  DIExpression *getStringLengthExp() const {
+    return cast_or_null<DIExpression>(getRawStringLengthExp());
+  }
+
+  unsigned getEncoding() const { return Encoding; }
+
+  Metadata *getRawStringLength() const { return getOperand(3); }
+
+  Metadata *getRawStringLengthExp() const { return getOperand(4); }
+};
+
 /// Derived types.
 ///
 /// This includes qualified types, pointers, references, friends, typedefs, and
@@ -988,6 +1159,90 @@ class DICompositeType : public DIType {
   }
 };
 
+/// Fortran array types.
+class DIFortranArrayType : public DIType {
+  friend class LLVMContextImpl;
+  friend class MDNode;
+
+  DIFortranArrayType(LLVMContext &C, StorageType Storage, unsigned Tag,
+                     unsigned Line, uint64_t SizeInBits, uint32_t AlignInBits,
+                     uint64_t OffsetInBits, DIFlags Flags,
+                     ArrayRef<Metadata *> Ops)
+      : DIType(C, DIFortranArrayTypeKind, Storage, Tag, Line, SizeInBits,
+               AlignInBits, OffsetInBits, Flags, Ops) {}
+  ~DIFortranArrayType() = default;
+
+  static DIFortranArrayType *
+  getImpl(LLVMContext &Context, unsigned Tag, StringRef Name, Metadata *File,
+          unsigned Line, DIScopeRef Scope, DITypeRef BaseType,
+          uint64_t SizeInBits, uint32_t AlignInBits, uint64_t OffsetInBits,
+          DIFlags Flags, DINodeArray Elements, StorageType Storage,
+          bool ShouldCreate = true) {
+    return getImpl(
+        Context, Tag, getCanonicalMDString(Context, Name), File, Line, Scope,
+        BaseType, SizeInBits, AlignInBits, OffsetInBits, Flags, Elements.get(),
+        Storage, ShouldCreate);
+  }
+  static DIFortranArrayType *
+  getImpl(LLVMContext &Context, unsigned Tag, MDString *Name, Metadata *File,
+          unsigned Line, Metadata *Scope, Metadata *BaseType,
+          uint64_t SizeInBits, uint32_t AlignInBits, uint64_t OffsetInBits,
+          DIFlags Flags, Metadata *Elements, StorageType Storage,
+          bool ShouldCreate = true);
+
+  TempDIFortranArrayType cloneImpl() const {
+    return getTemporary(getContext(), getTag(), getName(), getFile(), getLine(),
+                        getScope(), getBaseType(), getSizeInBits(),
+                        getAlignInBits(), getOffsetInBits(), getFlags(),
+                        getElements());
+  }
+
+public:
+  DEFINE_MDNODE_GET(DIFortranArrayType,
+                    (unsigned Tag, StringRef Name, DIFile *File, unsigned Line,
+                     DIScopeRef Scope, DITypeRef BaseType, uint64_t SizeInBits,
+                     uint32_t AlignInBits, uint64_t OffsetInBits,
+                     DIFlags Flags, DINodeArray Elements),
+                    (Tag, Name, File, Line, Scope, BaseType, SizeInBits,
+                     AlignInBits, OffsetInBits, Flags, Elements))
+  DEFINE_MDNODE_GET(DIFortranArrayType,
+                    (unsigned Tag, MDString *Name, Metadata *File,
+                     unsigned Line, Metadata *Scope, Metadata *BaseType,
+                     uint64_t SizeInBits, uint32_t AlignInBits,
+                     uint64_t OffsetInBits, DIFlags Flags, Metadata *Elements),
+                    (Tag, Name, File, Line, Scope, BaseType, SizeInBits,
+                     AlignInBits, OffsetInBits, Flags, Elements))
+
+  TempDIFortranArrayType clone() const { return cloneImpl(); }
+
+  DITypeRef getBaseType() const { return DITypeRef(getRawBaseType()); }
+  DINodeArray getElements() const {
+    return cast_or_null<MDTuple>(getRawElements());
+  }
+
+  Metadata *getRawBaseType() const { return getOperand(3); }
+  Metadata *getRawElements() const { return getOperand(4); }
+
+  /// Replace operands.
+  ///
+  /// If this \a isUniqued() and not \a isResolved(), on a uniquing collision
+  /// this will be RAUW'ed and deleted.  Use a \a TrackingMDRef to keep track
+  /// of its movement if necessary.
+  /// @{
+  void replaceElements(DINodeArray Elements) {
+#ifndef NDEBUG
+    for (DINode *Op : getElements())
+      assert(is_contained(Elements->operands(), Op) &&
+             "Lost a member during member list replacement");
+#endif
+    replaceOperandWith(4, Elements.get());
+  }
+
+  static bool classof(const Metadata *MD) {
+    return MD->getMetadataID() == DIFortranArrayTypeKind;
+  }
+};
+
 /// Type array for a subprogram.
 ///
 /// TODO: Fold the array of types in directly as operands.
@@ -1601,6 +1856,9 @@ class DISubprogram : public DILocalScope {
   bool isExplicit() const { return getFlags() & FlagExplicit; }
   bool isPrototyped() const { return getFlags() & FlagPrototyped; }
   bool isMainSubprogram() const { return getFlags() & FlagMainSubprogram; }
+  bool isPure() const { return getFlags() & FlagPure; }
+  bool isElemental() const { return getFlags() & FlagElemental; }
+  bool isRecursive() const { return getFlags() & FlagRecursive; }
 
   /// Check if this is reference-qualified.
   ///