fcl-passrc: moved ReadNextPascalToken to fpscanner

packages/fcl-passrc/src/pparser.pp

@@ -509,10 +509,6 @@ Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
 Function IsProcModifier(S : String; Out PM : TProcedureModifier) : Boolean;
 Function IsCallingConvention(S : String; out CC : TCallingConvention) : Boolean;
 Function TokenToAssignKind( tk : TToken) : TAssignKind;
-{$ifndef pas2js}
-procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
-  NestedComments: boolean; SkipDirectives: boolean);
-{$endif}
 
 implementation
 
@@ -680,274 +676,6 @@ begin
   end;
 end;
 
-{$ifndef pas2js}
-procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
-  NestedComments: boolean; SkipDirectives: boolean);
-const
-  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
-  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
-var
-  c1:char;
-  CommentLvl: Integer;
-  Src: PChar;
-begin
-  Src:=Position;
-  // read till next atom
-  while true do
-    begin
-    case Src^ of
-    #0: break;
-    #1..#32:  // spaces and special characters
-      inc(Src);
-    #$EF:
-      if (Src[1]=#$BB)
-      and (Src[2]=#$BF) then
-        begin
-        // skip UTF BOM
-        inc(Src,3);
-        end
-      else
-        break;
-    '{':    // comment start or compiler directive
-      if (Src[1]='$') and (not SkipDirectives) then
-        // compiler directive
-        break
-      else begin
-        // Pascal comment => skip
-        CommentLvl:=1;
-        while true do
-          begin
-          inc(Src);
-          case Src^ of
-          #0: break;
-          '{':
-            if NestedComments then
-              inc(CommentLvl);
-          '}':
-            begin
-            dec(CommentLvl);
-            if CommentLvl=0 then
-              begin
-              inc(Src);
-              break;
-              end;
-            end;
-          end;
-        end;
-      end;
-    '/':  // comment or real division
-      if (Src[1]='/') then
-        begin
-        // comment start -> read til line end
-        inc(Src);
-        while not (Src^ in [#0,#10,#13]) do
-          inc(Src);
-        end
-      else
-        break;
-    '(':  // comment, bracket or compiler directive
-      if (Src[1]='*') then
-        begin
-        if (Src[2]='$') and (not SkipDirectives) then
-          // compiler directive
-          break
-        else
-          begin
-          // comment start -> read til comment end
-          inc(Src,2);
-          CommentLvl:=1;
-          while true do
-            begin
-            case Src^ of
-            #0: break;
-            '(':
-              if NestedComments and (Src[1]='*') then
-                inc(CommentLvl);
-            '*':
-              if (Src[1]=')') then
-                begin
-                dec(CommentLvl);
-                if CommentLvl=0 then
-                  begin
-                  inc(Src,2);
-                  break;
-                  end;
-                inc(Position);
-                end;
-            end;
-            inc(Src);
-            end;
-        end;
-      end else
-        // round bracket open
-        break;
-    else
-      break;
-    end;
-    end;
-  // read token
-  TokenStart:=Src;
-  c1:=Src^;
-  case c1 of
-  #0:
-    ;
-  'A'..'Z','a'..'z','_':
-    begin
-    // identifier
-    inc(Src);
-    while Src^ in IdentChars do
-      inc(Src);
-    end;
-  '0'..'9': // number
-    begin
-    inc(Src);
-    // read numbers
-    while (Src^ in ['0'..'9']) do
-      inc(Src);
-    if (Src^='.') and (Src[1]<>'.') then
-      begin
-      // real type number
-      inc(Src);
-      while (Src^ in ['0'..'9']) do
-        inc(Src);
-      end;
-    if (Src^ in ['e','E']) then
-      begin
-      // read exponent
-      inc(Src);
-      if (Src^='-') then inc(Src);
-      while (Src^ in ['0'..'9']) do
-        inc(Src);
-      end;
-    end;
-  '''','#','`':  // string constant
-    while true do
-      case Src^ of
-      #0: break;
-      '#':
-        begin
-        inc(Src);
-        while Src^ in ['0'..'9'] do
-          inc(Src);
-        end;
-      '''':
-        begin
-        inc(Src);
-        while not (Src^ in ['''',#0,#10,#13]) do
-          inc(Src);
-        if Src^='''' then
-          inc(Src);
-        end;
-      '`':
-        begin
-        inc(Src);
-        while not (Src^ in ['`',#0]) do
-          inc(Src);
-        if Src^='''' then
-          inc(Src);
-        end;
-      else
-        break;
-      end;
-  '$':  // hex constant
-    begin
-    inc(Src);
-    while Src^ in HexNumberChars do
-      inc(Src);
-    end;
-  '&':  // octal constant or keyword as identifier (e.g. &label)
-    begin
-    inc(Src);
-    if Src^ in ['0'..'7'] then
-      while Src^ in ['0'..'7'] do
-        inc(Src)
-    else
-      while Src^ in IdentChars do
-        inc(Src);
-    end;
-  '{':  // compiler directive (it can't be a comment, because see above)
-    begin
-    CommentLvl:=1;
-    while true do
-      begin
-      inc(Src);
-      case Src^ of
-      #0: break;
-      '{':
-        if NestedComments then
-          inc(CommentLvl);
-      '}':
-        begin
-        dec(CommentLvl);
-        if CommentLvl=0 then
-          begin
-          inc(Src);
-          break;
-          end;
-        end;
-      end;
-      end;
-    end;
-  '(':  // bracket or compiler directive
-    if (Src[1]='*') then
-      begin
-      // compiler directive -> read til comment end
-      inc(Src,2);
-      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
-        inc(Src);
-      inc(Src,2);
-      end
-    else
-      // round bracket open
-      inc(Src);
-  #192..#255:
-    begin
-    // read UTF8 character
-    inc(Src);
-    if ((ord(c1) and %11100000) = %11000000) then
-      begin
-      // could be 2 byte character
-      if (ord(Src[0]) and %11000000) = %10000000 then
-        inc(Src);
-      end
-    else if ((ord(c1) and %11110000) = %11100000) then
-      begin
-      // could be 3 byte character
-      if ((ord(Src[0]) and %11000000) = %10000000)
-      and ((ord(Src[1]) and %11000000) = %10000000) then
-        inc(Src,2);
-      end
-    else if ((ord(c1) and %11111000) = %11110000) then
-      begin
-      // could be 4 byte character
-      if ((ord(Src[0]) and %11000000) = %10000000)
-      and ((ord(Src[1]) and %11000000) = %10000000)
-      and ((ord(Src[2]) and %11000000) = %10000000) then
-        inc(Src,3);
-      end;
-    end;
-  else
-    inc(Src);
-    case c1 of
-    '<': if Src^ in ['>','='] then inc(Src);
-    '.': if Src^='.' then inc(Src);
-    '@':
-      if Src^='@' then
-        begin
-        // @@ label
-        repeat
-          inc(Src);
-        until not (Src^ in IdentChars);
-        end
-    else
-      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
-        inc(Src);
-    end;
-  end;
-  Position:=Src;
-end;
-{$endif}
-
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
 var

packages/fcl-passrc/src/pscanner.pp

@@ -1256,6 +1256,9 @@ function ExtractFileUnitName(aFilename: string): string;
 procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of const);
 function SafeFormat(const Fmt: string; Args: array of const): string;
 
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+
 implementation
 
 const
@@ -1438,6 +1441,272 @@ begin
   end;
 end;
 
+procedure ReadNextPascalToken(var Position: PChar; out TokenStart: PChar;
+  NestedComments: boolean; SkipDirectives: boolean);
+const
+  IdentChars = ['a'..'z','A'..'Z','_','0'..'9'];
+  HexNumberChars = ['0'..'9','a'..'f','A'..'F'];
+var
+  c1:char;
+  CommentLvl: Integer;
+  Src: PChar;
+begin
+  Src:=Position;
+  // read till next atom
+  while true do
+    begin
+    case Src^ of
+    #0: break;
+    #1..#32:  // spaces and special characters
+      inc(Src);
+    #$EF:
+      if (Src[1]=#$BB)
+      and (Src[2]=#$BF) then
+        begin
+        // skip UTF BOM
+        inc(Src,3);
+        end
+      else
+        break;
+    '{':    // comment start or compiler directive
+      if (Src[1]='$') and (not SkipDirectives) then
+        // compiler directive
+        break
+      else begin
+        // Pascal comment => skip
+        CommentLvl:=1;
+        while true do
+          begin
+          inc(Src);
+          case Src^ of
+          #0: break;
+          '{':
+            if NestedComments then
+              inc(CommentLvl);
+          '}':
+            begin
+            dec(CommentLvl);
+            if CommentLvl=0 then
+              begin
+              inc(Src);
+              break;
+              end;
+            end;
+          end;
+        end;
+      end;
+    '/':  // comment or real division
+      if (Src[1]='/') then
+        begin
+        // comment start -> read til line end
+        inc(Src);
+        while not (Src^ in [#0,#10,#13]) do
+          inc(Src);
+        end
+      else
+        break;
+    '(':  // comment, bracket or compiler directive
+      if (Src[1]='*') then
+        begin
+        if (Src[2]='$') and (not SkipDirectives) then
+          // compiler directive
+          break
+        else
+          begin
+          // comment start -> read til comment end
+          inc(Src,2);
+          CommentLvl:=1;
+          while true do
+            begin
+            case Src^ of
+            #0: break;
+            '(':
+              if NestedComments and (Src[1]='*') then
+                inc(CommentLvl);
+            '*':
+              if (Src[1]=')') then
+                begin
+                dec(CommentLvl);
+                if CommentLvl=0 then
+                  begin
+                  inc(Src,2);
+                  break;
+                  end;
+                inc(Position);
+                end;
+            end;
+            inc(Src);
+            end;
+        end;
+      end else
+        // round bracket open
+        break;
+    else
+      break;
+    end;
+    end;
+  // read token
+  TokenStart:=Src;
+  c1:=Src^;
+  case c1 of
+  #0:
+    ;
+  'A'..'Z','a'..'z','_':
+    begin
+    // identifier
+    inc(Src);
+    while Src^ in IdentChars do
+      inc(Src);
+    end;
+  '0'..'9': // number
+    begin
+    inc(Src);
+    // read numbers
+    while (Src^ in ['0'..'9']) do
+      inc(Src);
+    if (Src^='.') and (Src[1]<>'.') then
+      begin
+      // real type number
+      inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    if (Src^ in ['e','E']) then
+      begin
+      // read exponent
+      inc(Src);
+      if (Src^='-') then inc(Src);
+      while (Src^ in ['0'..'9']) do
+        inc(Src);
+      end;
+    end;
+  '''','#','`':  // string constant
+    while true do
+      case Src^ of
+      #0: break;
+      '#':
+        begin
+        inc(Src);
+        while Src^ in ['0'..'9'] do
+          inc(Src);
+        end;
+      '''':
+        begin
+        inc(Src);
+        while not (Src^ in ['''',#0,#10,#13]) do
+          inc(Src);
+        if Src^='''' then
+          inc(Src);
+        end;
+      '`':
+        begin
+        inc(Src);
+        while not (Src^ in ['`',#0]) do
+          inc(Src);
+        if Src^='''' then
+          inc(Src);
+        end;
+      else
+        break;
+      end;
+  '$':  // hex constant
+    begin
+    inc(Src);
+    while Src^ in HexNumberChars do
+      inc(Src);
+    end;
+  '&':  // octal constant or keyword as identifier (e.g. &label)
+    begin
+    inc(Src);
+    if Src^ in ['0'..'7'] then
+      while Src^ in ['0'..'7'] do
+        inc(Src)
+    else
+      while Src^ in IdentChars do
+        inc(Src);
+    end;
+  '{':  // compiler directive (it can't be a comment, because see above)
+    begin
+    CommentLvl:=1;
+    while true do
+      begin
+      inc(Src);
+      case Src^ of
+      #0: break;
+      '{':
+        if NestedComments then
+          inc(CommentLvl);
+      '}':
+        begin
+        dec(CommentLvl);
+        if CommentLvl=0 then
+          begin
+          inc(Src);
+          break;
+          end;
+        end;
+      end;
+      end;
+    end;
+  '(':  // bracket or compiler directive
+    if (Src[1]='*') then
+      begin
+      // compiler directive -> read til comment end
+      inc(Src,2);
+      while (Src^<>#0) and ((Src^<>'*') or (Src[1]<>')')) do
+        inc(Src);
+      inc(Src,2);
+      end
+    else
+      // round bracket open
+      inc(Src);
+  #192..#255:
+    begin
+    // read UTF8 character
+    inc(Src);
+    if ((ord(c1) and %11100000) = %11000000) then
+      begin
+      // could be 2 byte character
+      if (ord(Src[0]) and %11000000) = %10000000 then
+        inc(Src);
+      end
+    else if ((ord(c1) and %11110000) = %11100000) then
+      begin
+      // could be 3 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000) then
+        inc(Src,2);
+      end
+    else if ((ord(c1) and %11111000) = %11110000) then
+      begin
+      // could be 4 byte character
+      if ((ord(Src[0]) and %11000000) = %10000000)
+      and ((ord(Src[1]) and %11000000) = %10000000)
+      and ((ord(Src[2]) and %11000000) = %10000000) then
+        inc(Src,3);
+      end;
+    end;
+  else
+    inc(Src);
+    case c1 of
+    '<': if Src^ in ['>','='] then inc(Src);
+    '.': if Src^='.' then inc(Src);
+    '@':
+      if Src^='@' then
+        begin
+        // @@ label
+        repeat
+          inc(Src);
+        until not (Src^ in IdentChars);
+        end
+    else
+      if (Src^='=') and (c1 in [':','+','-','/','*','<','>']) then
+        inc(Src);
+    end;
+  end;
+  Position:=Src;
+end;
+
 type
   TIncludeStackItem = class
     SourceFile: TLineReader;