CodeTools, JCF: Support more procedure directives. Issue #28462, patch from Jeppe Johansen.

git-svn-id: trunk@49591 -

components/codetools/keywordfunclists.pas

@@ -898,6 +898,7 @@ begin
     Add('FAR'          ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('FORWARD'      ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('INLINE'       ,{$ifdef FPC}@{$endif}AllwaysTrue);
+    Add('INTERRUPT'    ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('IOCHECK'      ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('LIBRARY'      ,{$ifdef FPC}@{$endif}AllwaysTrue);
     Add('LOCAL'        ,{$ifdef FPC}@{$endif}AllwaysTrue);

components/codetools/pascalparsertool.pas

@@ -1778,6 +1778,8 @@ begin
         SaveRaiseCharExpectedButAtomFound(':');
       ReadNextAtom;
       ReadConstant(true,false,[]);
+    end else if UpAtomIs('INTERRUPT') then begin
+      ReadNextAtom;
     end else if UpAtomIs('SYSCALL') then begin
       ReadNextAtom;
       AtomIsIdentifierSaveE;

components/jcf2/Parse/BuildParseTree.pas

@@ -248,6 +248,7 @@ type
     procedure RecogniseHintDirectives;
     procedure RecognisePropertyDirectives;
     procedure RecogniseExternalProcDirective;
+    function RecognisePublicProcDirective: boolean;
 
     procedure RecogniseAttributes;
 
@@ -3950,6 +3951,12 @@ begin
         begin
           RecogniseExternalProcDirective;
         end;
+        ttPublic:
+        begin
+          { Break the loop if we have found a class visibility "public" }
+          if not RecognisePublicProcDirective then
+            break;
+        end;
         ttDispId:
         begin
           Recognise(ttDispId);
@@ -3981,14 +3988,20 @@ begin
   { right, i'll fake this one
 
     ExternalProcDirective ->
-      External ["'" libname "'" ["name" "'" procname "'"]]
+      External ["'" libname "'"] ["name" "'" procname "'"]
 
       also allow "index expr"
   }
   PushNode(nExternalDirective);
 
   Recognise(ttExternal);
-  if fcTokenList.FirstSolidTokenType in (IdentiferTokens + [ttQuotedLiteralString]) then
+
+  if fcTokenList.FirstSolidTokenType = ttName then
+  begin
+    Recognise(ttName);
+    RecogniseConstantExpression;
+  end
+  else if fcTokenList.FirstSolidTokenType in (IdentiferTokens + [ttQuotedLiteralString]) then
   begin
     Recognise((IdentiferTokens + [ttQuotedLiteralString]));
 
@@ -4008,6 +4021,27 @@ begin
   PopNode;
 end;
 
+function TBuildParseTree.RecognisePublicProcDirective: boolean;
+begin
+  {
+    PublicProcDirective ->
+      Public ["name" "'" symname "'"]
+  }
+  result:=false;
+  if TopNode.HasParentNode([nClassBody, nObjectType]) then
+    exit;
+
+  Recognise(ttPublic);
+
+  if fcTokenList.FirstSolidTokenType = ttName then
+  begin
+    Recognise(ttName);
+    RecogniseConstantExpression;
+  end;
+
+  result:=true;
+end;
+
 procedure TBuildParseTree.RecogniseObjectType;
 begin
   { ObjectType -> OBJECT [ObjHeritage] [ObjFieldList] [MethodList] END

components/jcf2/Parse/Tokens.pas

@@ -190,6 +190,7 @@ type
     ttReintroduce,
     ttGeneric,
     ttCVar,
+    ttNostackframe,
     // used in asm
     ttOffset,
     ttPtr,
@@ -216,6 +217,7 @@ type
     { Additional Free Pascal directives }
     ttExperimental,
     ttUnimplemented,
+    ttInterrupt,
 
     { built-in constants }
     ttNil,
@@ -361,7 +363,8 @@ const
     ttNear, ttDynamic, ttExport, ttOverride, ttResident, ttLocal,
     ttOverload, ttReintroduce,
     ttDeprecated, ttLibrary, ttPlatform, ttExperimental, ttUnimplemented,
-    ttStatic, ttFinal, ttVarArgs, ttUnsafe, ttEnumerator];
+    ttStatic, ttFinal, ttVarArgs, ttUnsafe, ttEnumerator, ttNostackframe, ttInterrupt,
+    ttPublic];
 
   ClassDirectives: TTokenTypeSet =
     [ttPrivate, ttProtected, ttPublic, ttPublished, ttAutomated, ttStrict];
@@ -684,6 +687,7 @@ begin
   AddKeyword('reintroduce', wtReservedWordDirective, ttReintroduce);
 
   AddKeyword('cvar', wtReservedWordDirective, ttCVar);
+  AddKeyword('nostackframe', wtReservedWordDirective, ttNostackframe);
 
   // asm
   AddKeyword('offset', wtReservedWordDirective, ttOffset);
@@ -712,6 +716,7 @@ begin
   { Additional Free Pascal directives }
   AddKeyword('experimental', wtReservedWordDirective, ttExperimental);
   AddKeyword('unimplemented', wtReservedWordDirective, ttUnimplemented);
+  AddKeyword('interrupt', wtReservedWordDirective, ttInterrupt);
 
   { operators that are words not symbols }
   AddKeyword('and', wtOperator, ttAnd);