Add symantic support for the Pascal calling convention via

"__attribute((pascal))" or "__pascal" (and "_pascal" under
-fborland-extensions).  Support still needs to be added to llvm.


git-svn-id: https://llvm.org/svn/llvm-project/cfe/trunk@112939 91177308-0d34-0410-b5e6-96231b3b80d8

16 files changed, 107 insertions, 13 deletions

diff --git a/include/clang/AST/Type.h b/include/clang/AST/Type.h
index 819d7d24a5..92e62a58d4 100644
--- a/include/clang/AST/Type.h
+++ b/include/clang/AST/Type.h
@@ -410,7 +410,8 @@ enum CallingConv {
   CC_C,           // __attribute__((cdecl))
   CC_X86StdCall,  // __attribute__((stdcall))
   CC_X86FastCall, // __attribute__((fastcall))
-  CC_X86ThisCall  // __attribute__((thiscall))
+  CC_X86ThisCall, // __attribute__((thiscall))
+  CC_X86Pascal    // __attribute__((pascal))
 };
 
 
@@ -1928,7 +1929,7 @@ class FunctionType : public Type {
     // The value passed to __attribute__((regparm(x)))
     unsigned RegParm;
     // The calling convention as specified via
-    // __attribute__((cdecl|stdcall|fastcall|thiscall))
+    // __attribute__((cdecl|stdcall|fastcall|thiscall|pascal))
     CallingConv CC;
   };
 
diff --git a/include/clang/Basic/Attr.td b/include/clang/Basic/Attr.td
index 12bd5cfdce..2f2267f7f7 100644
--- a/include/clang/Basic/Attr.td
+++ b/include/clang/Basic/Attr.td
@@ -359,6 +359,10 @@ def ThisCall : Attr {
   let Spellings = ["thiscall", "__thiscall"];
 }
 
+def Pascal : Attr {
+  let Spellings = ["pascal", "__pascal"];
+}
+
 def TransparentUnion : Attr {
   let Spellings = ["transparent_union"];
 }
diff --git a/include/clang/Basic/TokenKinds.def b/include/clang/Basic/TokenKinds.def
index 11bcab9839..dc360adf8f 100644
--- a/include/clang/Basic/TokenKinds.def
+++ b/include/clang/Basic/TokenKinds.def
@@ -186,6 +186,7 @@ PUNCTUATOR(at,                  "@")
 //   KEYCXX0X - This is a C++ keyword introduced to C++ in C++0x
 //   KEYGNU   - This is a keyword if GNU extensions are enabled
 //   KEYMS    - This is a keyword if Microsoft extensions are enabled
+//   KEYBORLAND - This is a keyword if Borland extensions are enabled
 //
 KEYWORD(auto                        , KEYALL)
 KEYWORD(break                       , KEYALL)
@@ -335,6 +336,9 @@ KEYWORD(__fastcall                  , KEYALL)
 KEYWORD(__thiscall                  , KEYALL)
 KEYWORD(__forceinline               , KEYALL)
 
+// Borland Extension.
+KEYWORD(__pascal                    , KEYALL)
+
 // Altivec Extension.
 KEYWORD(__vector                    , KEYALTIVEC)
 KEYWORD(__pixel                     , KEYALTIVEC)
@@ -371,6 +375,9 @@ ALIAS("_fastcall"    , __fastcall , KEYMS)
 ALIAS("_stdcall"     , __stdcall  , KEYMS)
 ALIAS("_thiscall"    , __thiscall , KEYMS)
 
+// Borland Extensions which should be disabled in strict conformance mode.
+ALIAS("_pascal"      , __pascal   , KEYBORLAND)
+
 //===----------------------------------------------------------------------===//
 // Objective-C @-preceeded keywords.
 //===----------------------------------------------------------------------===//
diff --git a/include/clang/Parse/Parser.h b/include/clang/Parse/Parser.h
index f1c1a5b763..41a2fb6157 100644
--- a/include/clang/Parse/Parser.h
+++ b/include/clang/Parse/Parser.h
@@ -1365,6 +1365,7 @@ private:
   AttributeList *ParseGNUAttributes(SourceLocation *EndLoc = 0);
   AttributeList *ParseMicrosoftDeclSpec(AttributeList* CurrAttr = 0);
   AttributeList *ParseMicrosoftTypeAttributes(AttributeList* CurrAttr = 0);
+  AttributeList *ParseBorlandTypeAttributes(AttributeList* CurrAttr = 0);
   void ParseTypeofSpecifier(DeclSpec &DS);
   void ParseDecltypeSpecifier(DeclSpec &DS);
   
diff --git a/include/clang/Sema/AttributeList.h b/include/clang/Sema/AttributeList.h
index c067b0ccd7..53316477e1 100644
--- a/include/clang/Sema/AttributeList.h
+++ b/include/clang/Sema/AttributeList.h
@@ -102,6 +102,7 @@ public:
     AT_ownership_returns,  // Clang-specific.
     AT_ownership_takes,    // Clang-specific.
     AT_packed,
+    AT_pascal,
     AT_pure,
     AT_regparm,
     AT_section,
diff --git a/lib/AST/Type.cpp b/lib/AST/Type.cpp
index c2fc69fd2d..ca10532e72 100644
--- a/lib/AST/Type.cpp
+++ b/lib/AST/Type.cpp
@@ -1005,6 +1005,7 @@ llvm::StringRef FunctionType::getNameForCallConv(CallingConv CC) {
   case CC_X86StdCall: return "stdcall";
   case CC_X86FastCall: return "fastcall";
   case CC_X86ThisCall: return "thiscall";
+  case CC_X86Pascal: return "pascal";
   }
 }
 
diff --git a/lib/AST/TypePrinter.cpp b/lib/AST/TypePrinter.cpp
index eaffa5d3b1..d3a6b64553 100644
--- a/lib/AST/TypePrinter.cpp
+++ b/lib/AST/TypePrinter.cpp
@@ -299,6 +299,9 @@ void TypePrinter::PrintFunctionProto(const FunctionProtoType *T,
   case CC_X86ThisCall:
     S += " __attribute__((thiscall))";
     break;
+  case CC_X86Pascal:
+    S += " __attribute__((pascal))";
+    break;
   }
   if (Info.getNoReturn())
     S += " __attribute__((noreturn))";
diff --git a/lib/Basic/IdentifierTable.cpp b/lib/Basic/IdentifierTable.cpp
index e0d8571676..6b673e39d3 100644
--- a/lib/Basic/IdentifierTable.cpp
+++ b/lib/Basic/IdentifierTable.cpp
@@ -73,7 +73,8 @@ namespace {
     KEYMS = 32,
     BOOLSUPPORT = 64,
     KEYALTIVEC = 128,
-    KEYNOMS = 256
+    KEYNOMS = 256,
+    KEYBORLAND = 512
   };
 }
 
@@ -95,6 +96,7 @@ static void AddKeyword(llvm::StringRef Keyword,
   else if (LangOpts.C99 && (Flags & KEYC99)) AddResult = 2;
   else if (LangOpts.GNUKeywords && (Flags & KEYGNU)) AddResult = 1;
   else if (LangOpts.Microsoft && (Flags & KEYMS)) AddResult = 1;
+  else if (LangOpts.Borland && (Flags & KEYBORLAND)) AddResult = 1;
   else if (LangOpts.Bool && (Flags & BOOLSUPPORT)) AddResult = 2;
   else if (LangOpts.AltiVec && (Flags & KEYALTIVEC)) AddResult = 2;
   else if (!LangOpts.Microsoft && (Flags & KEYNOMS)) AddResult = 2;
diff --git a/lib/CodeGen/CGCall.cpp b/lib/CodeGen/CGCall.cpp
index f698d146f1..475dfa5c10 100644
--- a/lib/CodeGen/CGCall.cpp
+++ b/lib/CodeGen/CGCall.cpp
@@ -36,6 +36,7 @@ static unsigned ClangCallConvToLLVMCallConv(CallingConv CC) {
   case CC_X86StdCall: return llvm::CallingConv::X86_StdCall;
   case CC_X86FastCall: return llvm::CallingConv::X86_FastCall;
   case CC_X86ThisCall: return llvm::CallingConv::X86_ThisCall;
+  // TODO: add support for CC_X86Pascal to llvm
   }
 }
 
@@ -100,6 +101,9 @@ static CallingConv getCallingConventionForDecl(const Decl *D) {
   if (D->hasAttr<ThisCallAttr>())
     return CC_X86ThisCall;
 
+  if (D->hasAttr<PascalAttr>())
+    return CC_X86Pascal;
+
   return CC_C;
 }
 
diff --git a/lib/CodeGen/MicrosoftCXXABI.cpp b/lib/CodeGen/MicrosoftCXXABI.cpp
index b718cf74c5..9407335e32 100644
--- a/lib/CodeGen/MicrosoftCXXABI.cpp
+++ b/lib/CodeGen/MicrosoftCXXABI.cpp
@@ -919,6 +919,7 @@ void MicrosoftCXXNameMangler::mangleCallingConvention(const FunctionType *T) {
   switch (T->getCallConv()) {
     case CC_Default:
     case CC_C: Out << 'A'; break;
+    case CC_X86Pascal: Out << 'C'; break;
     case CC_X86ThisCall: Out << 'E'; break;
     case CC_X86StdCall: Out << 'G'; break;
     case CC_X86FastCall: Out << 'I'; break;
diff --git a/lib/Parse/ParseDecl.cpp b/lib/Parse/ParseDecl.cpp
index 0c68f7664e..555fcf0dec 100644
--- a/lib/Parse/ParseDecl.cpp
+++ b/lib/Parse/ParseDecl.cpp
@@ -293,6 +293,17 @@ AttributeList* Parser::ParseMicrosoftTypeAttributes(AttributeList *CurrAttr) {
   return CurrAttr;
 }
 
+AttributeList* Parser::ParseBorlandTypeAttributes(AttributeList *CurrAttr) {
+  // Treat these like attributes
+  while (Tok.is(tok::kw___pascal)) {
+    IdentifierInfo *AttrName = Tok.getIdentifierInfo();
+    SourceLocation AttrNameLoc = ConsumeToken();
+    CurrAttr = new AttributeList(AttrName, AttrNameLoc, 0, AttrNameLoc, 0,
+                                 SourceLocation(), 0, 0, CurrAttr, true);
+  }
+  return CurrAttr;
+}
+
 /// ParseDeclaration - Parse a full 'declaration', which consists of
 /// declaration-specifiers, some number of declarators, and a semicolon.
 /// 'Context' should be a Declarator::TheContext value.  This returns the
@@ -1207,6 +1218,11 @@ void Parser::ParseDeclarationSpecifiers(DeclSpec &DS,
       DS.AddAttributes(ParseMicrosoftTypeAttributes());
       continue;
 
+    // Borland single token adornments.
+    case tok::kw___pascal:
+      DS.AddAttributes(ParseBorlandTypeAttributes());
+      continue;
+
     // storage-class-specifier
     case tok::kw_typedef:
       isInvalid = DS.SetStorageClassSpec(DeclSpec::SCS_typedef, Loc, PrevSpec,
@@ -1683,6 +1699,7 @@ bool Parser::ParseOptionalTypeSpecifier(DeclSpec &DS, bool& isInvalid,
 
     isInvalid = DS.SetTypeSpecType(DeclSpec::TST_auto, Loc, PrevSpec, DiagID);
     break;
+
   case tok::kw___ptr64:
   case tok::kw___w64:
   case tok::kw___cdecl:
@@ -1692,6 +1709,10 @@ bool Parser::ParseOptionalTypeSpecifier(DeclSpec &DS, bool& isInvalid,
     DS.AddAttributes(ParseMicrosoftTypeAttributes());
     return true;
 
+  case tok::kw___pascal:
+    DS.AddAttributes(ParseBorlandTypeAttributes());
+    return true;
+
   default:
     // Not a type-specifier; do nothing.
     return false;
@@ -2268,6 +2289,7 @@ bool Parser::isTypeSpecifierQualifier() {
   case tok::kw___thiscall:
   case tok::kw___w64:
   case tok::kw___ptr64:
+  case tok::kw___pascal:
     return true;
   }
 }
@@ -2376,6 +2398,7 @@ bool Parser::isDeclarationSpecifier() {
   case tok::kw___w64:
   case tok::kw___ptr64:
   case tok::kw___forceinline:
+  case tok::kw___pascal:
     return true;
   }
 }
@@ -2427,15 +2450,19 @@ bool Parser::isConstructorDeclarator() {
 }
 
 /// ParseTypeQualifierListOpt
-///       type-qualifier-list: [C99 6.7.5]
-///         type-qualifier
-/// [GNU]   attributes                        [ only if AttributesAllowed=true ]
-///         type-qualifier-list type-qualifier
-/// [GNU]   type-qualifier-list attributes    [ only if AttributesAllowed=true ]
-/// [C++0x] attribute-specifier[opt] is allowed before cv-qualifier-seq
-///           if CXX0XAttributesAllowed = true
+///          type-qualifier-list: [C99 6.7.5]
+///            type-qualifier
+/// [vendor]   attributes                        
+///              [ only if VendorAttributesAllowed=true ]
+///            type-qualifier-list type-qualifier
+/// [vendor]   type-qualifier-list attributes    
+///              [ only if VendorAttributesAllowed=true ]
+/// [C++0x]    attribute-specifier[opt] is allowed before cv-qualifier-seq
+///              [ only if CXX0XAttributesAllowed=true ]
+/// Note: vendor can be GNU, MS, etc.
 ///
-void Parser::ParseTypeQualifierListOpt(DeclSpec &DS, bool GNUAttributesAllowed,
+void Parser::ParseTypeQualifierListOpt(DeclSpec &DS,
+                                       bool VendorAttributesAllowed,
                                        bool CXX0XAttributesAllowed) {
   if (getLang().CPlusPlus0x && isCXX0XAttributeSpecifier()) {
     SourceLocation Loc = Tok.getLocation();
@@ -2476,13 +2503,19 @@ void Parser::ParseTypeQualifierListOpt(DeclSpec &DS, bool GNUAttributesAllowed,
     case tok::kw___stdcall:
     case tok::kw___fastcall:
     case tok::kw___thiscall:
-      if (GNUAttributesAllowed) {
+      if (VendorAttributesAllowed) {
         DS.AddAttributes(ParseMicrosoftTypeAttributes());
         continue;
       }
       goto DoneWithTypeQuals;
+    case tok::kw___pascal:
+      if (VendorAttributesAllowed) {
+        DS.AddAttributes(ParseBorlandTypeAttributes());
+        continue;
+      }
+      goto DoneWithTypeQuals;
     case tok::kw___attribute:
-      if (GNUAttributesAllowed) {
+      if (VendorAttributesAllowed) {
         DS.AddAttributes(ParseGNUAttributes());
         continue; // do *not* consume the next token!
       }
@@ -2867,6 +2900,10 @@ void Parser::ParseParenDeclarator(Declarator &D) {
        Tok.is(tok::kw___w64) || Tok.is(tok::kw___ptr64)) {
     AttrList.reset(ParseMicrosoftTypeAttributes(AttrList.take()));
   }
+  // Eat any Borland extensions.
+  if  (Tok.is(tok::kw___pascal)) {
+    AttrList.reset(ParseBorlandTypeAttributes(AttrList.take()));
+  }
 
   // If we haven't past the identifier yet (or where the identifier would be
   // stored, if this is an abstract declarator), then this is probably just
diff --git a/lib/Parse/ParseTentative.cpp b/lib/Parse/ParseTentative.cpp
index 17273a0cf6..c22d99fa9d 100644
--- a/lib/Parse/ParseTentative.cpp
+++ b/lib/Parse/ParseTentative.cpp
@@ -757,6 +757,10 @@ Parser::TPResult Parser::isCXXDeclarationSpecifier() {
   case tok::kw___ptr64:
   case tok::kw___forceinline:
     return TPResult::True();
+
+    // Borland
+  case tok::kw___pascal:
+    return TPResult::True();
   
     // AltiVec
   case tok::kw___vector:
diff --git a/lib/Sema/AttributeList.cpp b/lib/Sema/AttributeList.cpp
index 3f34aa67ae..8ccb2ca586 100644
--- a/lib/Sema/AttributeList.cpp
+++ b/lib/Sema/AttributeList.cpp
@@ -126,9 +126,11 @@ AttributeList::Kind AttributeList::getKind(const IdentifierInfo *Name) {
     .Case("init_priority", AT_init_priority)
     .Case("no_instrument_function", AT_no_instrument_function)
     .Case("thiscall", AT_thiscall)
+    .Case("pascal", AT_pascal)
     .Case("__cdecl", AT_cdecl)
     .Case("__stdcall", AT_stdcall)
     .Case("__fastcall", AT_fastcall)
     .Case("__thiscall", AT_thiscall)
+    .Case("__pascal", AT_pascal)
     .Default(UnknownAttribute);
 }
diff --git a/lib/Sema/SemaDeclAttr.cpp b/lib/Sema/SemaDeclAttr.cpp
index f987067a31..25af73ae13 100644
--- a/lib/Sema/SemaDeclAttr.cpp
+++ b/lib/Sema/SemaDeclAttr.cpp
@@ -1986,6 +1986,9 @@ static void HandleCallConvAttr(Decl *d, const AttributeList &Attr, Sema &S) {
   case AttributeList::AT_cdecl:
     d->addAttr(::new (S.Context) CDeclAttr(Attr.getLoc(), S.Context));
     return;
+  case AttributeList::AT_pascal:
+    d->addAttr(::new (S.Context) PascalAttr(Attr.getLoc(), S.Context));
+    return;
   default:
     llvm_unreachable("unexpected attribute kind");
     return;
@@ -2294,6 +2297,7 @@ static void ProcessDeclAttribute(Scope *scope, Decl *D,
   case AttributeList::AT_cdecl:
   case AttributeList::AT_fastcall:
   case AttributeList::AT_thiscall:
+  case AttributeList::AT_pascal:
     HandleCallConvAttr(D, Attr, S);
     break;
   default:
diff --git a/lib/Sema/SemaType.cpp b/lib/Sema/SemaType.cpp
index 92439ff0da..aa30b5c2da 100644
--- a/lib/Sema/SemaType.cpp
+++ b/lib/Sema/SemaType.cpp
@@ -1901,6 +1901,7 @@ bool ProcessFnAttr(Sema &S, QualType &Type, const AttributeList &Attr) {
   case AttributeList::AT_fastcall: CC = CC_X86FastCall; break;
   case AttributeList::AT_stdcall: CC = CC_X86StdCall; break;
   case AttributeList::AT_thiscall: CC = CC_X86ThisCall; break;
+  case AttributeList::AT_pascal: CC = CC_X86Pascal; break;
   default: llvm_unreachable("unexpected attribute kind"); return false;
   }
 
@@ -2028,6 +2029,7 @@ void ProcessTypeAttributeList(Sema &S, QualType &Result,
     case AttributeList::AT_fastcall:
     case AttributeList::AT_stdcall:
     case AttributeList::AT_thiscall:
+    case AttributeList::AT_pascal:
     case AttributeList::AT_regparm:
       // Don't process these on the DeclSpec.
       if (IsDeclSpec ||
diff --git a/test/SemaCXX/borland-extensions.cpp b/test/SemaCXX/borland-extensions.cpp
index 703222eb54..c33527c7a0 100644
--- a/test/SemaCXX/borland-extensions.cpp
+++ b/test/SemaCXX/borland-extensions.cpp
@@ -4,3 +4,23 @@
 
 // 1. test  -fborland-extensions
 int dummy_function() { return 0; }
+
+// 2. test __pascal
+int _pascal f2();
+
+float __pascal gi2(int, int); 
+template<typename T> T g2(T (__pascal * const )(int, int)) { return 0; }
+
+struct M {
+    int __pascal addP();
+    float __pascal subtractP(); 
+};
+template<typename T> int h2(T (__pascal M::* const )()) { return 0; }
+void m2() {
+    int i; float f;
+    i = f2();
+    f = gi2(2, i);
+    f = g2(gi2);
+    i = h2<int>(&M::addP);
+    f = h2(&M::subtractP);
+}