home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / scn.adb < prev    next >
Text File  |  1996-09-28  |  48KB  |  1,329 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                                  S C N                                   --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.78 $                             --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with Atree;    use Atree;
  26. with Csets;    use Csets;
  27. with Debug;    use Debug;
  28. with Errout;   use Errout;
  29. with Features; use Features;
  30. with Lib;      use Lib;
  31. with Namet;    use Namet;
  32. with Opt;      use Opt;
  33. with Output;   use Output;
  34. with Scans;    use Scans;
  35. with Sinput;   use Sinput;
  36. with Sinfo;    use Sinfo;
  37. with Snames;   use Snames;
  38. with Style;
  39. with Widechar; use Widechar;
  40.  
  41. with System.Parameters;
  42. with System.WCh_Con; use System.WCh_Con;
  43.  
  44. package body Scn is
  45.  
  46.    use Ascii;
  47.    --  Make control characters visible
  48.  
  49.    Used_As_Identifier : array (Token_Type) of Boolean;
  50.    --  Flags set True if a given keyword is used as an identifier (used to
  51.    --  make sure that we only post an error message for incorrect use of a
  52.    --  keyword as an identifier once for a given keyword).
  53.  
  54.    Max_Allowed_Line_Length : Nat := System.Parameters.Max_Line_Length;
  55.    --  Maximum allowed line length (maybe reset by Style.Set_Max_Line_Length)
  56.  
  57.    -----------------------
  58.    -- Local Subprograms --
  59.    -----------------------
  60.  
  61.    function Double_Char_Token (C : Character) return Boolean;
  62.    --  This function is used for double character tokens like := or <>. It
  63.    --  checks if the character following Source (Scan_Ptr) is C, and if so
  64.    --  bumps Scan_Ptr past the pair of characters and returns True. A space
  65.    --  between the two characters is also recognized with an appropriate
  66.    --  error message being issued. If C is not present, False is returned.
  67.    --  Note that Double_Char_Token can only be used for tokens defined in
  68.    --  the Ada syntax.
  69.  
  70.    procedure Error_Illegal_Character;
  71.    --  Give illegal character error, Scan_Ptr points to character. On return,
  72.    --  Scan_Ptr is bumped past the illegal character.
  73.  
  74.    procedure Error_Illegal_Wide_Character;
  75.    --  Give illegal character in wide character escape sequence message. On
  76.    --  return, Scan_Ptr is bumped past the illegal character, which may still
  77.    --  leave us pointing to junk, not much we can do if the escape sequence
  78.    --  is messed up!
  79.  
  80.    procedure Error_Long_Line;
  81.    --  Signal error of excessively long line
  82.  
  83.    procedure Error_No_Double_Underline;
  84.    --  Signal error of double underline character
  85.  
  86.    procedure Nlit;
  87.    --  This is the procedure for scanning out numeric literals
  88.  
  89.    function Set_Start_Column return Column_Number;
  90.    --  This routine is called with Scan_Ptr pointing to the first character
  91.    --  of a line. On exit, Scan_Ptr is advanced to the first non-blank
  92.    --  character of this line (or to the terminating format effector if the
  93.    --  line contains no non-blank characters), and the returned result is the
  94.    --  column number of this non-blank character (zero origin), which is the
  95.    --  value to be stored in the Start_Column scan variable.
  96.  
  97.    procedure Slit;
  98.    --  This is the procedure for scanning out string literals
  99.  
  100.    --------------
  101.    -- Subunits --
  102.    --------------
  103.  
  104.    --  For some reason, these must come early in the file or we run into an
  105.    --  infinite loop in GNAT, to be looked at some time ???
  106.  
  107.    procedure Nlit is separate;
  108.  
  109.    procedure Slit is separate;
  110.  
  111.    ----------------------------
  112.    -- Determine_Token_Casing --
  113.    ----------------------------
  114.  
  115.    function Determine_Token_Casing return Casing_Type is
  116.  
  117.       All_Lower : Boolean := True;
  118.       --  Set False if upper case letter found
  119.  
  120.       All_Upper : Boolean := True;
  121.       --  Set False if lower case letter found
  122.  
  123.       Mixed : Boolean := True;
  124.       --  Set False if exception to mixed case rule found (lower case letter
  125.       --  at start or after underline, or upper case letter elsewhere).
  126.  
  127.       Decisive : Boolean := False;
  128.       --  Set True if at least one instance of letter not after underline
  129.  
  130.       After_Und : Boolean := True;
  131.       --  True at start of string, and after an underline character
  132.  
  133.    begin
  134.       for S in Token_Ptr .. Scan_Ptr - 1 loop
  135.          if Source (S) = '_' or else Source (S) = '.' then
  136.             After_Und := True;
  137.  
  138.          elsif Is_Lower_Case_Letter (Source (S)) then
  139.             All_Upper := False;
  140.  
  141.             if not After_Und then
  142.                Decisive := True;
  143.             else
  144.                After_Und := False;
  145.                Mixed := False;
  146.             end if;
  147.  
  148.          elsif Is_Upper_Case_Letter (Source (S)) then
  149.             All_Lower := False;
  150.  
  151.             if not After_Und then
  152.                Decisive := True;
  153.                Mixed := False;
  154.             else
  155.                After_Und := False;
  156.             end if;
  157.          end if;
  158.       end loop;
  159.  
  160.       --  Now we can figure out the result from the flags we set in that loop
  161.  
  162.       if All_Lower then
  163.          return All_Lower_Case;
  164.  
  165.       elsif not Decisive then
  166.          return Unknown;
  167.  
  168.       elsif All_Upper then
  169.          return All_Upper_Case;
  170.  
  171.       elsif Mixed then
  172.          return Mixed_Case;
  173.  
  174.       else
  175.          return Unknown;
  176.       end if;
  177.    end Determine_Token_Casing;
  178.  
  179.    -----------------------
  180.    -- Double_Char_Token --
  181.    -----------------------
  182.  
  183.    function Double_Char_Token (C : Character) return Boolean is
  184.    begin
  185.       if Source (Scan_Ptr + 1) = C then
  186.          Scan_Ptr := Scan_Ptr + 2;
  187.          return True;
  188.  
  189.       elsif Source (Scan_Ptr + 1) = ' '
  190.         and then Source (Scan_Ptr + 2) = C
  191.       then
  192.          Scan_Ptr := Scan_Ptr + 1;
  193.          Error_Msg_S ("no space allowed here");
  194.          Scan_Ptr := Scan_Ptr + 2;
  195.          return True;
  196.  
  197.       else
  198.          return False;
  199.       end if;
  200.    end Double_Char_Token;
  201.  
  202.    -----------------------------
  203.    -- Error_Illegal_Character --
  204.    -----------------------------
  205.  
  206.    procedure Error_Illegal_Character is
  207.    begin
  208.       Error_Msg_S ("illegal character");
  209.       Scan_Ptr := Scan_Ptr + 1;
  210.    end Error_Illegal_Character;
  211.  
  212.    ----------------------------------
  213.    -- Error_Illegal_Wide_Character --
  214.    ----------------------------------
  215.  
  216.    procedure Error_Illegal_Wide_Character is
  217.    begin
  218.       Error_Msg_S ("illegal character in wide character escape sequence");
  219.       Scan_Ptr := Scan_Ptr + 1;
  220.    end Error_Illegal_Wide_Character;
  221.  
  222.    ---------------------
  223.    -- Error_Long_Line --
  224.    ---------------------
  225.  
  226.    procedure Error_Long_Line is
  227.    begin
  228.       Error_Msg ("this line is too long", Current_Line_Start);
  229.    end Error_Long_Line;
  230.  
  231.    -------------------------------
  232.    -- Error_No_Double_Underline --
  233.    -------------------------------
  234.  
  235.    procedure Error_No_Double_Underline is
  236.    begin
  237.       Error_Msg_S ("two consecutive underlines not permitted");
  238.    end Error_No_Double_Underline;
  239.  
  240.    ------------------------
  241.    -- Initialize_Scanner --
  242.    ------------------------
  243.  
  244.    procedure Initialize_Scanner (Unit : Unit_Number_Type) is
  245.    begin
  246.       --  Set up Token_Type values in Names Table entries for reserved keywords
  247.       --  We use the Pos value of the Token_Type value. Note we are relying on
  248.       --  the fact that Token_Type'Val (0) is not a reserved word!
  249.  
  250.       Set_Name_Table_Byte (Name_Abort,      Token_Type'Pos (Tok_Abort));
  251.       Set_Name_Table_Byte (Name_Abs,        Token_Type'Pos (Tok_Abs));
  252.       Set_Name_Table_Byte (Name_Abstract,   Token_Type'Pos (Tok_Abstract));
  253.       Set_Name_Table_Byte (Name_Accept,     Token_Type'Pos (Tok_Accept));
  254.       Set_Name_Table_Byte (Name_Access,     Token_Type'Pos (Tok_Access));
  255.       Set_Name_Table_Byte (Name_And,        Token_Type'Pos (Tok_And));
  256.       Set_Name_Table_Byte (Name_Aliased,    Token_Type'Pos (Tok_Aliased));
  257.       Set_Name_Table_Byte (Name_All,        Token_Type'Pos (Tok_All));
  258.       Set_Name_Table_Byte (Name_Array,      Token_Type'Pos (Tok_Array));
  259.       Set_Name_Table_Byte (Name_At,         Token_Type'Pos (Tok_At));
  260.       Set_Name_Table_Byte (Name_Begin,      Token_Type'Pos (Tok_Begin));
  261.       Set_Name_Table_Byte (Name_Body,       Token_Type'Pos (Tok_Body));
  262.       Set_Name_Table_Byte (Name_Case,       Token_Type'Pos (Tok_Case));
  263.       Set_Name_Table_Byte (Name_Constant,   Token_Type'Pos (Tok_Constant));
  264.       Set_Name_Table_Byte (Name_Declare,    Token_Type'Pos (Tok_Declare));
  265.       Set_Name_Table_Byte (Name_Delay,      Token_Type'Pos (Tok_Delay));
  266.       Set_Name_Table_Byte (Name_Delta,      Token_Type'Pos (Tok_Delta));
  267.       Set_Name_Table_Byte (Name_Digits,     Token_Type'Pos (Tok_Digits));
  268.       Set_Name_Table_Byte (Name_Do,         Token_Type'Pos (Tok_Do));
  269.       Set_Name_Table_Byte (Name_Else,       Token_Type'Pos (Tok_Else));
  270.       Set_Name_Table_Byte (Name_Elsif,      Token_Type'Pos (Tok_Elsif));
  271.       Set_Name_Table_Byte (Name_End,        Token_Type'Pos (Tok_End));
  272.       Set_Name_Table_Byte (Name_Entry,      Token_Type'Pos (Tok_Entry));
  273.       Set_Name_Table_Byte (Name_Exception,  Token_Type'Pos (Tok_Exception));
  274.       Set_Name_Table_Byte (Name_Exit,       Token_Type'Pos (Tok_Exit));
  275.       Set_Name_Table_Byte (Name_For,        Token_Type'Pos (Tok_For));
  276.       Set_Name_Table_Byte (Name_Function,   Token_Type'Pos (Tok_Function));
  277.       Set_Name_Table_Byte (Name_Generic,    Token_Type'Pos (Tok_Generic));
  278.       Set_Name_Table_Byte (Name_Goto,       Token_Type'Pos (Tok_Goto));
  279.       Set_Name_Table_Byte (Name_If,         Token_Type'Pos (Tok_If));
  280.       Set_Name_Table_Byte (Name_In,         Token_Type'Pos (Tok_In));
  281.       Set_Name_Table_Byte (Name_Is,         Token_Type'Pos (Tok_Is));
  282.       Set_Name_Table_Byte (Name_Limited,    Token_Type'Pos (Tok_Limited));
  283.       Set_Name_Table_Byte (Name_Loop,       Token_Type'Pos (Tok_Loop));
  284.       Set_Name_Table_Byte (Name_Mod,        Token_Type'Pos (Tok_Mod));
  285.       Set_Name_Table_Byte (Name_New,        Token_Type'Pos (Tok_New));
  286.       Set_Name_Table_Byte (Name_Not,        Token_Type'Pos (Tok_Not));
  287.       Set_Name_Table_Byte (Name_Null,       Token_Type'Pos (Tok_Null));
  288.       Set_Name_Table_Byte (Name_Of,         Token_Type'Pos (Tok_Of));
  289.       Set_Name_Table_Byte (Name_Or,         Token_Type'Pos (Tok_Or));
  290.       Set_Name_Table_Byte (Name_Others,     Token_Type'Pos (Tok_Others));
  291.       Set_Name_Table_Byte (Name_Out,        Token_Type'Pos (Tok_Out));
  292.       Set_Name_Table_Byte (Name_Package,    Token_Type'Pos (Tok_Package));
  293.       Set_Name_Table_Byte (Name_Pragma,     Token_Type'Pos (Tok_Pragma));
  294.       Set_Name_Table_Byte (Name_Private,    Token_Type'Pos (Tok_Private));
  295.       Set_Name_Table_Byte (Name_Procedure,  Token_Type'Pos (Tok_Procedure));
  296.       Set_Name_Table_Byte (Name_Protected,  Token_Type'Pos (Tok_Protected));
  297.       Set_Name_Table_Byte (Name_Raise,      Token_Type'Pos (Tok_Raise));
  298.       Set_Name_Table_Byte (Name_Range,      Token_Type'Pos (Tok_Range));
  299.       Set_Name_Table_Byte (Name_Record,     Token_Type'Pos (Tok_Record));
  300.       Set_Name_Table_Byte (Name_Rem,        Token_Type'Pos (Tok_Rem));
  301.       Set_Name_Table_Byte (Name_Renames,    Token_Type'Pos (Tok_Renames));
  302.       Set_Name_Table_Byte (Name_Requeue,    Token_Type'Pos (Tok_Requeue));
  303.       Set_Name_Table_Byte (Name_Return,     Token_Type'Pos (Tok_Return));
  304.       Set_Name_Table_Byte (Name_Reverse,    Token_Type'Pos (Tok_Reverse));
  305.       Set_Name_Table_Byte (Name_Select,     Token_Type'Pos (Tok_Select));
  306.       Set_Name_Table_Byte (Name_Separate,   Token_Type'Pos (Tok_Separate));
  307.       Set_Name_Table_Byte (Name_Subtype,    Token_Type'Pos (Tok_Subtype));
  308.       Set_Name_Table_Byte (Name_Tagged,     Token_Type'Pos (Tok_Tagged));
  309.       Set_Name_Table_Byte (Name_Task,       Token_Type'Pos (Tok_Task));
  310.       Set_Name_Table_Byte (Name_Terminate,  Token_Type'Pos (Tok_Terminate));
  311.       Set_Name_Table_Byte (Name_Then,       Token_Type'Pos (Tok_Then));
  312.       Set_Name_Table_Byte (Name_Type,       Token_Type'Pos (Tok_Type));
  313.       Set_Name_Table_Byte (Name_Until,      Token_Type'Pos (Tok_Until));
  314.       Set_Name_Table_Byte (Name_Use,        Token_Type'Pos (Tok_Use));
  315.       Set_Name_Table_Byte (Name_When,       Token_Type'Pos (Tok_When));
  316.       Set_Name_Table_Byte (Name_While,      Token_Type'Pos (Tok_While));
  317.       Set_Name_Table_Byte (Name_With,       Token_Type'Pos (Tok_With));
  318.       Set_Name_Table_Byte (Name_Xor,        Token_Type'Pos (Tok_Xor));
  319.  
  320.       --  Initialize scan control variables
  321.  
  322.       Current_Source_File       := Source_Index (Unit);
  323.       Source                    := Source_Text (Current_Source_File);
  324.       Current_Source_Unit       := Unit;
  325.       Scan_Ptr                  := Source_First (Current_Source_File);
  326.       Token                     := No_Token;
  327.       Token_Ptr                 := Scan_Ptr;
  328.       Current_Line_Start        := Scan_Ptr;
  329.       Token_Node                := Empty;
  330.       Token_Name                := No_Name;
  331.       Start_Column              := Set_Start_Column;
  332.       First_Non_Blank_Location  := Scan_Ptr;
  333.  
  334.       if Style_Check then
  335.          Style.Set_Max_Line_Length (Max_Allowed_Line_Length);
  336.       end if;
  337.  
  338.       --  Set default for Comes_From_Source. All nodes built now until we
  339.       --  reenter the analyzer will have Comes_From_Source set to True
  340.  
  341.       Set_Comes_From_Source_Default (True);
  342.  
  343.       --  Scan initial token (note this initializes Prev_Token, Prev_Token_Ptr)
  344.  
  345.       Scan;
  346.  
  347.       --  Clear flags for reserved words used as indentifiers
  348.  
  349.       for I in Token_Type loop
  350.          Used_As_Identifier (I) := False;
  351.       end loop;
  352.  
  353.    end Initialize_Scanner;
  354.  
  355.    ----------
  356.    -- Scan --
  357.    ----------
  358.  
  359.    procedure Scan is
  360.    begin
  361.       Prev_Token := Token;
  362.       Prev_Token_Ptr := Token_Ptr;
  363.       Token_Name := Error_Name;
  364.  
  365.       --  The following loop runs more than once only if a format effector
  366.       --  (tab, vertical tab, form  feed, line feed, carriage return) is
  367.       --  encountered and skipped, or some error situation, such as an
  368.       --  illegal character, is encountered.
  369.  
  370.       loop
  371.          --  Skip past blanks, loop is opened up for speed
  372.  
  373.          while Source (Scan_Ptr) = ' ' loop
  374.  
  375.             if Source (Scan_Ptr + 1) /= ' ' then
  376.                Scan_Ptr := Scan_Ptr + 1;
  377.                exit;
  378.             end if;
  379.  
  380.             if Source (Scan_Ptr + 2) /= ' ' then
  381.                Scan_Ptr := Scan_Ptr + 2;
  382.                exit;
  383.             end if;
  384.  
  385.             if Source (Scan_Ptr + 3) /= ' ' then
  386.                Scan_Ptr := Scan_Ptr + 3;
  387.                exit;
  388.             end if;
  389.  
  390.             if Source (Scan_Ptr + 4) /= ' ' then
  391.                Scan_Ptr := Scan_Ptr + 4;
  392.                exit;
  393.             end if;
  394.  
  395.             if Source (Scan_Ptr + 5) /= ' ' then
  396.                Scan_Ptr := Scan_Ptr + 5;
  397.                exit;
  398.             end if;
  399.  
  400.             if Source (Scan_Ptr + 6) /= ' ' then
  401.                Scan_Ptr := Scan_Ptr + 6;
  402.                exit;
  403.             end if;
  404.  
  405.             if Source (Scan_Ptr + 7) /= ' ' then
  406.                Scan_Ptr := Scan_Ptr + 7;
  407.                exit;
  408.             end if;
  409.  
  410.             Scan_Ptr := Scan_Ptr + 8;
  411.          end loop;
  412.  
  413.          --  We are now at a non-blank character, which is the first character
  414.          --  of the token we will scan, and hence the value of Token_Ptr.
  415.  
  416.          Token_Ptr := Scan_Ptr;
  417.  
  418.          --  Here begins the main case statement which transfers control on
  419.          --  the basis of the non-blank character we have encountered.
  420.  
  421.          case Source (Scan_Ptr) is
  422.  
  423.          --  Line terminator characters
  424.  
  425.          when CR | LF | FF | VT => Line_Terminator_Case : begin
  426.             if Int (Scan_Ptr) - Int (Current_Line_Start)
  427.                            > Max_Allowed_Line_Length
  428.             then
  429.                Error_Long_Line;
  430.             end if;
  431.  
  432.             if Style_Check then Style.Check_Line_Terminator; end if;
  433.  
  434.             declare
  435.                Physical : Boolean;
  436.  
  437.             begin
  438.                Skip_Line_Terminators (Scan_Ptr, Physical);
  439.  
  440.                --  If we are at start of physical line, update scan pointers
  441.                --  to reflect the start of the new line.
  442.  
  443.                if Physical then
  444.                   Current_Line_Start       := Scan_Ptr;
  445.                   Start_Column             := Set_Start_Column;
  446.                   First_Non_Blank_Location := Scan_Ptr;
  447.                end if;
  448.             end;
  449.          end Line_Terminator_Case;
  450.  
  451.          --  Horizontal tab, just skip past it
  452.  
  453.          when HT =>
  454.             if Style_Check then Style.Check_HT; end if;
  455.             Scan_Ptr := Scan_Ptr + 1;
  456.  
  457.          --  End of file character
  458.  
  459.          when EOF =>
  460.             Token := Tok_EOF;
  461.             return;
  462.  
  463.          --  Ampersand
  464.  
  465.          when '&' =>
  466.             if Source (Scan_Ptr + 1) = '&' then
  467.                Error_Msg_S ("'&'& should be `AND THEN`");
  468.                Scan_Ptr := Scan_Ptr + 2;
  469.                Token := Tok_And;
  470.                return;
  471.  
  472.             else
  473.                Scan_Ptr := Scan_Ptr + 1;
  474.                Token := Tok_Ampersand;
  475.                return;
  476.             end if;
  477.  
  478.          --  Asterisk (can be multiplication operator or double asterisk
  479.          --  which is the exponentiation compound delimtier).
  480.  
  481.          when '*' =>
  482.             if Source (Scan_Ptr + 1) = '*' then
  483.                Scan_Ptr := Scan_Ptr + 2;
  484.                Token := Tok_Double_Asterisk;
  485.                return;
  486.  
  487.             else
  488.                Scan_Ptr := Scan_Ptr + 1;
  489.                Token := Tok_Asterisk;
  490.                return;
  491.             end if;
  492.  
  493.          --  Colon, which can either be an isolated colon, or part of an
  494.          --  assignment compound delimiter.
  495.  
  496.          when ':' =>
  497.             if Double_Char_Token ('=') then
  498.                Token := Tok_Colon_Equal;
  499.                if Style_Check then Style.Check_Colon_Equal; end if;
  500.                return;
  501.  
  502.             elsif Source (Scan_Ptr + 1) = '-'
  503.               and then Source (Scan_Ptr + 2) /= '-'
  504.             then
  505.                Token := Tok_Colon_Equal;
  506.                Error_Msg (":- should be :=", Scan_Ptr);
  507.                Scan_Ptr := Scan_Ptr + 2;
  508.                return;
  509.  
  510.             else
  511.                Scan_Ptr := Scan_Ptr + 1;
  512.                Token := Tok_Colon;
  513.                if Style_Check then Style.Check_Colon; end if;
  514.                return;
  515.             end if;
  516.  
  517.          --  Left parenthesis
  518.  
  519.          when '(' =>
  520.             Scan_Ptr := Scan_Ptr + 1;
  521.             Token := Tok_Left_Paren;
  522.             if Style_Check then Style.Check_Left_Paren; end if;
  523.             return;
  524.  
  525.          --  Left bracket or left brace, treated as left paren
  526.  
  527.          when '[' | '{' =>
  528.             Error_Msg_S ("illegal character, replaced by ""(""");
  529.             Scan_Ptr := Scan_Ptr + 1;
  530.             Token := Tok_Left_Paren;
  531.             return;
  532.  
  533.          --  Comma
  534.  
  535.          when ',' =>
  536.             Scan_Ptr := Scan_Ptr + 1;
  537.             Token := Tok_Comma;
  538.             if Style_Check then Style.Check_Comma; end if;
  539.             return;
  540.  
  541.          --  Dot, which is either an isolated period, or part of a double
  542.          --  dot compound delimiter sequence. We also check for the case of
  543.          --  a digit following the period, to give a better error message.
  544.  
  545.          when '.' =>
  546.             if Source (Scan_Ptr + 1) = '.' then
  547.                Scan_Ptr := Scan_Ptr + 2;
  548.                Token := Tok_Dot_Dot;
  549.                if Style_Check then Style.Check_Dot_Dot; end if;
  550.                return;
  551.  
  552.             elsif Source (Scan_Ptr + 1) in '0' .. '9' then
  553.                Error_Msg_S ("numeric literal cannot start with point");
  554.                Scan_Ptr := Scan_Ptr + 1;
  555.  
  556.             else
  557.                Scan_Ptr := Scan_Ptr + 1;
  558.                Token := Tok_Dot;
  559.                return;
  560.             end if;
  561.  
  562.          --  Equal, which can either be an equality operator, or part of the
  563.          --  arrow (=>) compound delimiter.
  564.  
  565.          when '=' =>
  566.             if Double_Char_Token ('>') then
  567.                Token := Tok_Arrow;
  568.                if Style_Check then Style.Check_Arrow; end if;
  569.                return;
  570.  
  571.             elsif Source (Scan_Ptr + 1) = '=' then
  572.                Error_Msg_S ("== should be =");
  573.                Scan_Ptr := Scan_Ptr + 1;
  574.             end if;
  575.  
  576.             Scan_Ptr := Scan_Ptr + 1;
  577.             Token := Tok_Equal;
  578.             return;
  579.  
  580.          --  Greater than, which can be a greater than operator, greater than
  581.          --  or equal operator, or first character of a right label bracket.
  582.  
  583.          when '>' =>
  584.             if Double_Char_Token ('=') then
  585.                Token := Tok_Greater_Equal;
  586.                return;
  587.  
  588.             elsif Double_Char_Token ('>') then
  589.                Token := Tok_Greater_Greater;
  590.                return;
  591.  
  592.             else
  593.                Scan_Ptr := Scan_Ptr + 1;
  594.                Token := Tok_Greater;
  595.                return;
  596.             end if;
  597.  
  598.          --  Less than, which can be a less than operator, less than or equal
  599.          --  operator, or the first character of a left label bracket, or the
  600.          --  first character of a box (<>) compound delimiter.
  601.  
  602.          when '<' =>
  603.             if Double_Char_Token ('=') then
  604.                Token := Tok_Less_Equal;
  605.                return;
  606.  
  607.             elsif Double_Char_Token ('>') then
  608.                Token := Tok_Box;
  609.                if Style_Check then Style.Check_Box; end if;
  610.                return;
  611.  
  612.             elsif Double_Char_Token ('<') then
  613.                Token := Tok_Less_Less;
  614.                return;
  615.  
  616.             else
  617.                Scan_Ptr := Scan_Ptr + 1;
  618.                Token := Tok_Less;
  619.                return;
  620.             end if;
  621.  
  622.          --  Minus, which is either a subtraction operator, or the first
  623.          --  character of double minus starting a comment
  624.  
  625.          when '-' => Minus_Case : begin
  626.             if Source (Scan_Ptr + 1) = '>' then
  627.                Error_Msg_S ("-> should be =>");
  628.                Scan_Ptr := Scan_Ptr + 2;
  629.                Token := Tok_Arrow;
  630.                return;
  631.  
  632.             elsif Source (Scan_Ptr + 1) /= '-' then
  633.                Scan_Ptr := Scan_Ptr + 1;
  634.                Token := Tok_Minus;
  635.                return;
  636.  
  637.             --  Comment
  638.  
  639.             else -- Source (Scan_Ptr + 1) = '-' then
  640.                if Style_Check then Style.Check_Comment; end if;
  641.                Scan_Ptr := Scan_Ptr + 2;
  642.  
  643.                --  Loop to scan comment (this loop runs more than once only if
  644.                --  a horizontal tab or other non-graphic character is scanned)
  645.  
  646.                loop
  647.                   --  Scan to non graphic character (opened up for speed)
  648.  
  649.                   loop
  650.                      exit when Source (Scan_Ptr) not in Graphic_Character;
  651.                      Scan_Ptr := Scan_Ptr + 1;
  652.                      exit when Source (Scan_Ptr) not in Graphic_Character;
  653.                      Scan_Ptr := Scan_Ptr + 1;
  654.                      exit when Source (Scan_Ptr) not in Graphic_Character;
  655.                      Scan_Ptr := Scan_Ptr + 1;
  656.                      exit when Source (Scan_Ptr) not in Graphic_Character;
  657.                      Scan_Ptr := Scan_Ptr + 1;
  658.                      exit when Source (Scan_Ptr) not in Graphic_Character;
  659.                      Scan_Ptr := Scan_Ptr + 1;
  660.                   end loop;
  661.  
  662.                   --  Keep going if horizontal tab
  663.  
  664.                   if Source (Scan_Ptr) = HT then
  665.                      if Style_Check then Style.Check_HT; end if;
  666.                      Scan_Ptr := Scan_Ptr + 1;
  667.  
  668.                   --  Terminate scan of comment if line terminator or EOF
  669.  
  670.                   elsif Source (Scan_Ptr) in Line_Terminator
  671.                      or else Source (Scan_Ptr) = EOF
  672.                   then
  673.                      if Int (Scan_Ptr) - Int (Current_Line_Start) >
  674.                                            Max_Allowed_Line_Length
  675.                      then
  676.                         Error_Long_Line;
  677.                      end if;
  678.  
  679.                      exit;
  680.  
  681.                   --  Terminate scan of comment if end of file encountered
  682.                   --  (embedded EOF character or real last character in file)
  683.  
  684.                   elsif Source (Scan_Ptr) = EOF then
  685.                      exit;
  686.  
  687.                   --  Keep going if character in 80-FF range. These characters
  688.                   --  are allowed in comments according to the approved AI.
  689.                   --  Also allow ESC, which just got added to the AI (June 93)
  690.  
  691.                   elsif Source (Scan_Ptr) in Upper_Half_Character
  692.                     or else Source (Scan_Ptr) = ESC
  693.                   then
  694.                      Scan_Ptr := Scan_Ptr + 1;
  695.  
  696.                   --  Otherwise we have an illegal comment character
  697.  
  698.                   else
  699.                      Error_Illegal_Character;
  700.                   end if;
  701.  
  702.                end loop;
  703.  
  704.                --  Note that we do NOT execute a return here, instead we fall
  705.                --  through to reexecute the scan loop to look for a token.
  706.  
  707.             end if;
  708.          end Minus_Case;
  709.  
  710.          --  Double quote or percent starting a string constant
  711.  
  712.          when '"' | '%' =>
  713.             Slit;
  714.             return;
  715.  
  716.          --  Apostrophe. This can either be the start of a character literal,
  717.          --  or an isolated apostrophe used in a qualified expression or an
  718.          --  attribute. We treat it as a character literal if it does not
  719.          --  follow a right parenthesis, identifier or literal. This means
  720.          --  that we correctly treat constructs like:
  721.  
  722.          --    A := CHARACTER'('A');
  723.  
  724.          --  which appears to be illegal according to 2.2(2) (since the rule
  725.          --  there would seem to require separators to avoid the confusion
  726.          --  with the character literal), but all compilers accept the above
  727.          --  statement, and there are at least six ACVC tests that use this
  728.          --  type of lexical sequence, expecting it to be legal, so in fact
  729.          --  all compilers must accept this and we must too!
  730.  
  731.          when ''' => Char_Literal_Case : declare
  732.             Code : Char_Code;
  733.             Err  : Boolean;
  734.  
  735.          begin
  736.             Scan_Ptr := Scan_Ptr + 1;
  737.  
  738.             --  Here is where we make the test to distinguish the cases. Treat
  739.             --  as apostrophe if previous token is an identifier, right paren
  740.             --  or the reserved word "all" (latter case as in A.all'Address)
  741.             --  Also treat it as apostrophe after a literal (wrong anyway, but
  742.             --  that's probably the better choice).
  743.  
  744.             if Prev_Token = Tok_Identifier
  745.                or else Prev_Token = Tok_Right_Paren
  746.                or else Prev_Token = Tok_All
  747.                or else Prev_Token in Token_Class_Literal
  748.             then
  749.                Token := Tok_Apostrophe;
  750.                return;
  751.  
  752.             --  Otherwise the apostrophe starts a character literal
  753.  
  754.             else
  755.                --  Case of wide character literal
  756.  
  757.                if (Source (Scan_Ptr) = ESC
  758.                     and then Wide_Character_Encoding_Method /= WCEM_None)
  759.                  or else (Upper_Half_Encoding
  760.                             and then Source (Scan_Ptr) in Upper_Half_Character)
  761.  
  762.                then
  763.                   Note_Feature (Wide_Characters_And_Strings, Scan_Ptr);
  764.                   Scan_Wide (Source, Scan_Ptr, Code, Err);
  765.  
  766.                   if Err then
  767.                      Error_Illegal_Wide_Character;
  768.                   end if;
  769.  
  770.                   if Source (Scan_Ptr) /= ''' then
  771.                      Error_Msg_S ("missing apostrophe");
  772.                   else
  773.                      Scan_Ptr := Scan_Ptr + 1;
  774.                   end if;
  775.  
  776.                --  If we do not find a closing quote in the expected place then
  777.                --  assume that we have a misguided attempt at a string literal.
  778.  
  779.                elsif Source (Scan_Ptr + 1) /= ''' then
  780.                   Scan_Ptr := Scan_Ptr - 1;
  781.                   Error_Msg_S
  782.                     ("strings are delimited by double quote character");
  783.                   Scn.Slit;
  784.                   return;
  785.  
  786.                --  Otherwise we have a (non-wide) character literal
  787.  
  788.                else
  789.                   if Source (Scan_Ptr) not in Graphic_Character then
  790.                      if Source (Scan_Ptr) in Upper_Half_Character then
  791.                         Note_Feature (Latin_1, Scan_Ptr);
  792.  
  793.                         if Ada_83 then
  794.                            Error_Illegal_Character;
  795.                         end if;
  796.  
  797.                      else
  798.                         Error_Illegal_Character;
  799.                      end if;
  800.                   end if;
  801.  
  802.                   Code := Get_Char_Code (Source (Scan_Ptr));
  803.                   Scan_Ptr := Scan_Ptr + 2;
  804.                end if;
  805.  
  806.                --  Fall through here with Scan_Ptr updated past the closing
  807.                --  quote, and Code set to the Char_Code value for the literal
  808.  
  809.                Token := Tok_Char_Literal;
  810.                Token_Node := New_Node (N_Character_Literal, Token_Ptr);
  811.                Set_Char_Literal_Value (Token_Node, Code);
  812.                Set_Character_Literal_Name (Code);
  813.                Token_Name := Name_Find;
  814.                Set_Chars (Token_Node, Token_Name);
  815.                return;
  816.             end if;
  817.          end Char_Literal_Case;
  818.  
  819.          --  Right parenthesis
  820.  
  821.          when ')' =>
  822.             Scan_Ptr := Scan_Ptr + 1;
  823.             Token := Tok_Right_Paren;
  824.             if Style_Check then Style.Check_Right_Paren; end if;
  825.             return;
  826.  
  827.          --  Right bracket or right brace, treated as right paren
  828.  
  829.          when ']' | '}' =>
  830.             Error_Msg_S ("illegal character, replaced by "")""");
  831.             Scan_Ptr := Scan_Ptr + 1;
  832.             Token := Tok_Right_Paren;
  833.             return;
  834.  
  835.          --  Slash (can be division operator or first character of not equal)
  836.  
  837.          when '/' =>
  838.             if Double_Char_Token ('=') then
  839.                Token := Tok_Not_Equal;
  840.                return;
  841.             else
  842.                Scan_Ptr := Scan_Ptr + 1;
  843.                Token := Tok_Slash;
  844.                return;
  845.             end if;
  846.  
  847.          --  Semicolon
  848.  
  849.          when ';' =>
  850.             Scan_Ptr := Scan_Ptr + 1;
  851.             Token := Tok_Semicolon;
  852.             if Style_Check then Style.Check_Semicolon; end if;
  853.             return;
  854.  
  855.          --  Vertical bar
  856.  
  857.          when '|' => Vertical_Bar_Case : begin
  858.  
  859.             --  Special check for || to give nice message
  860.  
  861.             if Source (Scan_Ptr + 1) = '|' then
  862.                Error_Msg_S ("""||"" should be `OR ELSE`");
  863.                Scan_Ptr := Scan_Ptr + 2;
  864.                Token := Tok_Or;
  865.                return;
  866.  
  867.             else
  868.                Scan_Ptr := Scan_Ptr + 1;
  869.                Token := Tok_Vertical_Bar;
  870.                if Style_Check then Style.Check_Vertical_Bar; end if;
  871.                return;
  872.             end if;
  873.          end Vertical_Bar_Case;
  874.  
  875.          --  Exclamation, replacement character for vertical bar
  876.  
  877.          when '!' => Exclamation_Case : begin
  878.             if Source (Scan_Ptr + 1) = '=' then
  879.                Error_Msg_S ("'!= should be /=");
  880.                Scan_Ptr := Scan_Ptr + 2;
  881.                Token := Tok_Not_Equal;
  882.                return;
  883.  
  884.             else
  885.                Scan_Ptr := Scan_Ptr + 1;
  886.                Token := Tok_Vertical_Bar;
  887.                return;
  888.             end if;
  889.  
  890.          end Exclamation_Case;
  891.  
  892.          --  Plus
  893.  
  894.          when '+' => Plus_Case : begin
  895.             Scan_Ptr := Scan_Ptr + 1;
  896.             Token := Tok_Plus;
  897.             return;
  898.          end Plus_Case;
  899.  
  900.          --  Digits starting a numeric constant
  901.  
  902.          when '0' .. '9' =>
  903.             Nlit;
  904.  
  905.             if Identifier_Char (Source (Scan_Ptr)) then
  906.                Error_Msg_S
  907.                  ("delimiter required between literal and identifier");
  908.             end if;
  909.  
  910.             return;
  911.  
  912.          --  Lower case letters
  913.  
  914.          when 'a' .. 'z' =>
  915.             Name_Len := 1;
  916.             Name_Buffer (1) := Source (Scan_Ptr);
  917.             Scan_Ptr := Scan_Ptr + 1;
  918.             goto Scan_Identifier;
  919.  
  920.          --  Upper case letters
  921.  
  922.          when 'A' .. 'Z' =>
  923.             Name_Len := 1;
  924.             Name_Buffer (1) :=
  925.               Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
  926.             Scan_Ptr := Scan_Ptr + 1;
  927.             goto Scan_Identifier;
  928.  
  929.          --  Underline character
  930.  
  931.          when '_' =>
  932.             Error_Msg_S ("identifier cannot start with underline");
  933.             Name_Len := 1;
  934.             Name_Buffer (1) := '_';
  935.             Scan_Ptr := Scan_Ptr + 1;
  936.             goto Scan_Identifier;
  937.  
  938.          --  Space (not possible, because we scanned past blanks)
  939.  
  940.          when ' ' =>
  941.             pragma Assert (False); null;
  942.  
  943.          --  Characters in top half of ASCII 8-bit chart
  944.  
  945.          when Upper_Half_Character =>
  946.  
  947.             --  If wide character, then illegal, not allowed outside literal
  948.  
  949.             if Upper_Half_Encoding then
  950.                Error_Illegal_Character;
  951.  
  952.             --  Otherwise we have OK Latin-1 character
  953.  
  954.             else
  955.                Note_Feature (Latin_1, Scan_Ptr);
  956.  
  957.                --  Upper half characters may possibly be identifier letters
  958.                --  but can never be digits, so Identifier_Character can be
  959.                --  used to test for a valid start of identifier character.
  960.  
  961.                if Identifier_Char (Source (Scan_Ptr)) then
  962.                   Name_Len := 0;
  963.                   goto Scan_Identifier;
  964.                else
  965.                   Error_Illegal_Character;
  966.                end if;
  967.             end if;
  968.  
  969.          when ESC =>
  970.             --  ESC character, possible start of identifier if wide characters
  971.             --  are allowed in identifiers, which we can tell by looking at
  972.             --  the Identifier_Char flag for ESC.
  973.  
  974.             if Identifier_Char (ESC) then
  975.                Name_Len := 0;
  976.                goto Scan_Identifier;
  977.             else
  978.                Error_Illegal_Wide_Character;
  979.             end if;
  980.  
  981.          --  Invalid control characters
  982.  
  983.          when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS  | SO  |
  984.               SI  | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
  985.               EM  | FS  | GS  | RS  | US  | DEL
  986.          => Error_Illegal_Character;
  987.  
  988.          --  Invalid graphic characters
  989.  
  990.          when '#' | '$' | '?' | '@' | '`' | '\' | '^' | '~' =>
  991.             Error_Illegal_Character;
  992.  
  993.          --  End switch on non-blank character
  994.  
  995.          end case;
  996.  
  997.       --  End loop past format effectors. The exit from this loop is by
  998.       --  executing a return statement following completion of token scan
  999.       --  (control never falls out of this loop to the code which follows)
  1000.  
  1001.       end loop;
  1002.  
  1003.       --  Identifier scanning routine. On entry, some initial characters
  1004.       --  of the identifier may have already been stored in Name_Buffer.
  1005.       --  If so, Name_Len has the number of characters stored. otherwise
  1006.       --  Name_Len is set to zero on entry.
  1007.  
  1008.       <<Scan_Identifier>>
  1009.  
  1010.          --  This loop scans as fast as possible past lower half letters
  1011.          --  and digits, which we expect to be the most common characters.
  1012.  
  1013.          loop
  1014.             if Source (Scan_Ptr) in 'a' .. 'z'
  1015.               or else Source (Scan_Ptr) in '0' .. '9'
  1016.             then
  1017.                Name_Buffer (Name_Len + 1) := Source (Scan_Ptr);
  1018.  
  1019.             elsif Source (Scan_Ptr) in 'A' .. 'Z' then
  1020.                Name_Buffer (Name_Len + 1) :=
  1021.                  Character'Val (Character'Pos (Source (Scan_Ptr)) + 32);
  1022.             else
  1023.                exit;
  1024.             end if;
  1025.  
  1026.             --  Open out the loop a couple of times for speed
  1027.  
  1028.             if Source (Scan_Ptr + 1) in 'a' .. 'z'
  1029.               or else Source (Scan_Ptr + 1) in '0' .. '9'
  1030.             then
  1031.                Name_Buffer (Name_Len + 2) := Source (Scan_Ptr + 1);
  1032.  
  1033.             elsif Source (Scan_Ptr + 1) in 'A' .. 'Z' then
  1034.                Name_Buffer (Name_Len + 2) :=
  1035.                  Character'Val (Character'Pos (Source (Scan_Ptr + 1)) + 32);
  1036.             else
  1037.                Scan_Ptr := Scan_Ptr + 1;
  1038.                Name_Len := Name_Len + 1;
  1039.                exit;
  1040.             end if;
  1041.  
  1042.             if Source (Scan_Ptr + 2) in 'a' .. 'z'
  1043.               or else Source (Scan_Ptr + 2) in '0' .. '9'
  1044.             then
  1045.                Name_Buffer (Name_Len + 3) := Source (Scan_Ptr + 2);
  1046.  
  1047.             elsif Source (Scan_Ptr + 2) in 'A' .. 'Z' then
  1048.                Name_Buffer (Name_Len + 3) :=
  1049.                  Character'Val (Character'Pos (Source (Scan_Ptr + 2)) + 32);
  1050.             else
  1051.                Scan_Ptr := Scan_Ptr + 2;
  1052.                Name_Len := Name_Len + 2;
  1053.                exit;
  1054.             end if;
  1055.  
  1056.             if Source (Scan_Ptr + 3) in 'a' .. 'z'
  1057.               or else Source (Scan_Ptr + 3) in '0' .. '9'
  1058.             then
  1059.                Name_Buffer (Name_Len + 4) := Source (Scan_Ptr + 3);
  1060.  
  1061.             elsif Source (Scan_Ptr + 3) in 'A' .. 'Z' then
  1062.                Name_Buffer (Name_Len + 4) :=
  1063.                  Character'Val (Character'Pos (Source (Scan_Ptr + 3)) + 32);
  1064.             else
  1065.                Scan_Ptr := Scan_Ptr + 3;
  1066.                Name_Len := Name_Len + 3;
  1067.                exit;
  1068.             end if;
  1069.  
  1070.             Scan_Ptr := Scan_Ptr + 4;
  1071.             Name_Len := Name_Len + 4;
  1072.          end loop;
  1073.  
  1074.          --  If we fall through, then we have encountered either an underline
  1075.          --  character, or an extended identifier character (i.e. one from the
  1076.          --  upper half), or a wide character, or an identifier terminator.
  1077.          --  The initial test speeds us up in the most common case where we
  1078.          --  have an identifier terminator. Note that ESC is an identifier
  1079.          --  character only if a wide character encoding method is active.
  1080.  
  1081.          if Identifier_Char (Source (Scan_Ptr)) then
  1082.  
  1083.             --  Case of underline, check for error cases of double underline,
  1084.             --  and for a trailing underline character
  1085.  
  1086.             if Source (Scan_Ptr) = '_' then
  1087.                Name_Len := Name_Len + 1;
  1088.                Name_Buffer (Name_Len) := '_';
  1089.  
  1090.                if Identifier_Char (Source (Scan_Ptr + 1)) then
  1091.                   Scan_Ptr := Scan_Ptr + 1;
  1092.  
  1093.                   if Source (Scan_Ptr) = '_' then
  1094.                      Error_No_Double_Underline;
  1095.                   end if;
  1096.  
  1097.                else
  1098.                   Error_Msg_S ("identifier cannot end with underline");
  1099.                   Scan_Ptr := Scan_Ptr + 1;
  1100.                end if;
  1101.  
  1102.             --  We know we have either an ESC or an upper half character.
  1103.             --  First test for wide character case.
  1104.  
  1105.             elsif (Source (Scan_Ptr) = ESC
  1106.                     and then Wide_Character_Encoding_Method /= WCEM_None)
  1107.               or else Upper_Half_Encoding
  1108.             then
  1109.                if Identifier_Character_Set /= 'w' then
  1110.                   Error_Msg_S ("wide character not allowed in identifier");
  1111.                end if;
  1112.  
  1113.                --  Scan out the wide character and insert the appropriate
  1114.                --  encoding into the name table entry for the identifier.
  1115.  
  1116.                declare
  1117.                   Code : Char_Code;
  1118.                   Err  : Boolean;
  1119.  
  1120.                begin
  1121.                   Note_Feature (Wide_Characters_And_Strings, Scan_Ptr);
  1122.                   Scan_Wide (Source, Scan_Ptr, Code, Err);
  1123.  
  1124.                   if Err then
  1125.                      Error_Illegal_Wide_Character;
  1126.                   else
  1127.                      Store_Encoded_Character (Code);
  1128.                   end if;
  1129.                end;
  1130.  
  1131.             --  Case of an extended character from the upper half. We insert
  1132.             --  the appropriate encoding of the character, folded to lower
  1133.             --  case (see Namet for details of the encoding).
  1134.  
  1135.             else
  1136.                Note_Feature (Latin_1, Scan_Ptr);
  1137.                Store_Encoded_Character
  1138.                  (Get_Char_Code (Fold_Lower (Source (Scan_Ptr))));
  1139.                Scan_Ptr := Scan_Ptr + 1;
  1140.             end if;
  1141.  
  1142.             --  In all above cases, keep scanning identifier characters
  1143.  
  1144.             goto Scan_Identifier;
  1145.          end if;
  1146.  
  1147.          --  Scan of identifier is complete. The identifier is stored in
  1148.          --  Name_Buffer, and Scan_Ptr points past the last character.
  1149.  
  1150.          Token_Name := Name_Find;
  1151.  
  1152.          --  Here is where we check if it was a keyword
  1153.  
  1154.          if Get_Name_Table_Byte (Token_Name) /= 0
  1155.            and then (Ada_95 or else Token_Name not in Ada_95_Reserved_Words)
  1156.          then
  1157.             Token := Token_Type'Val (Get_Name_Table_Byte (Token_Name));
  1158.  
  1159.             --  Deal with possible style check for non-lower case keyword,
  1160.             --  but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
  1161.             --  for this purpose if they appear as attribute designators.
  1162.             --  Actually we only check the first character for speed.
  1163.  
  1164.             if Style_Check
  1165.               and then Source (Token_Ptr) <= 'Z'
  1166.               and then (Prev_Token /= Tok_Apostrophe
  1167.                           or else
  1168.                             (Token /= Tok_Access
  1169.                                and then Token /= Tok_Delta
  1170.                                and then Token /= Tok_Digits
  1171.                                and then Token /= Tok_Range))
  1172.             then
  1173.                Style.Non_Lower_Case_Keyword;
  1174.             end if;
  1175.  
  1176.             --  We must reset Token_Name since this is not an identifier
  1177.             --  and if we leave Token_Name set, the parser gets confused
  1178.             --  because it thinks it is dealing with an identifier instead
  1179.             --  of the corresponding keyword.
  1180.  
  1181.             Token_Name := No_Name;
  1182.             return;
  1183.  
  1184.          --  It is an identifier after all
  1185.  
  1186.          else
  1187.             Token_Node := New_Node (N_Identifier, Token_Ptr);
  1188.             Set_Chars (Token_Node, Token_Name);
  1189.             Token := Tok_Identifier;
  1190.             return;
  1191.          end if;
  1192.    end Scan;
  1193.  
  1194.    ---------------------
  1195.    -- Scan_First_Char --
  1196.    ---------------------
  1197.  
  1198.    function Scan_First_Char return Source_Ptr is
  1199.       Ptr : Source_Ptr := Current_Line_Start;
  1200.  
  1201.    begin
  1202.       loop
  1203.          if Source (Ptr) = ' ' then
  1204.             Ptr := Ptr + 1;
  1205.  
  1206.          elsif Source (Ptr) = HT then
  1207.             if Style_Check then Style.Check_HT; end if;
  1208.             Ptr := Ptr + 1;
  1209.  
  1210.          else
  1211.             return Ptr;
  1212.          end if;
  1213.       end loop;
  1214.    end Scan_First_Char;
  1215.  
  1216.    ------------------------------
  1217.    -- Scan_Reserved_Identifier --
  1218.    ------------------------------
  1219.  
  1220.    procedure Scan_Reserved_Identifier (Force_Msg : Boolean) is
  1221.       Token_Chars : constant String := Token_Type'Image (Token);
  1222.  
  1223.    begin
  1224.       --  We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
  1225.       --  This code extracts the xxx and makes an identifier out of it.
  1226.  
  1227.       Name_Len := 0;
  1228.  
  1229.       for J in 5 .. Token_Chars'Length loop
  1230.          Name_Len := Name_Len + 1;
  1231.          Name_Buffer (Name_Len) := Fold_Lower (Token_Chars (J));
  1232.       end loop;
  1233.  
  1234.       Token_Name := Name_Find;
  1235.  
  1236.       if not Used_As_Identifier (Token) or else Force_Msg then
  1237.          Error_Msg_Name_1 := Token_Name;
  1238.          Error_Msg_SC ("reserved word* cannot be used as identifier!");
  1239.          Used_As_Identifier (Token) := True;
  1240.       end if;
  1241.  
  1242.       Token := Tok_Identifier;
  1243.       Token_Node := New_Node (N_Identifier, Token_Ptr);
  1244.       Set_Chars (Token_Node, Token_Name);
  1245.    end Scan_Reserved_Identifier;
  1246.  
  1247.    ----------------------
  1248.    -- Set_Start_Column --
  1249.    ----------------------
  1250.  
  1251.    --  Note: it seems at first glance a little expensive to compute this value
  1252.    --  for every source line (since it is certainly not used for all source
  1253.    --  lines). On the other hand, it doesn't take much more work to skip past
  1254.    --  the initial white space on the line counting the columns than it would
  1255.    --  to scan past the white space using the standard scanning circuits.
  1256.  
  1257.    function Set_Start_Column return Column_Number is
  1258.       Start_Column : Column_Number := 0;
  1259.  
  1260.    begin
  1261.       --  Outer loop scans past horizontal tab characters
  1262.  
  1263.       Tabs_Loop : loop
  1264.  
  1265.          --  Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
  1266.          --  past the blanks and adjusting Start_Column to account for them.
  1267.  
  1268.          Blanks_Loop : loop
  1269.             if Source (Scan_Ptr) = ' ' then
  1270.                if Source (Scan_Ptr + 1) = ' ' then
  1271.                   if Source (Scan_Ptr + 2) = ' ' then
  1272.                      if Source (Scan_Ptr + 3) = ' ' then
  1273.                         if Source (Scan_Ptr + 4) = ' ' then
  1274.                            if Source (Scan_Ptr + 5) = ' ' then
  1275.                               if Source (Scan_Ptr + 6) = ' ' then
  1276.                                  Scan_Ptr := Scan_Ptr + 7;
  1277.                                  Start_Column := Start_Column + 7;
  1278.                               else
  1279.                                  Scan_Ptr := Scan_Ptr + 6;
  1280.                                  Start_Column := Start_Column + 6;
  1281.                                  exit Blanks_Loop;
  1282.                               end if;
  1283.                            else
  1284.                               Scan_Ptr := Scan_Ptr + 5;
  1285.                               Start_Column := Start_Column + 5;
  1286.                               exit Blanks_Loop;
  1287.                            end if;
  1288.                         else
  1289.                            Scan_Ptr := Scan_Ptr + 4;
  1290.                            Start_Column := Start_Column + 4;
  1291.                            exit Blanks_Loop;
  1292.                         end if;
  1293.                      else
  1294.                         Scan_Ptr := Scan_Ptr + 3;
  1295.                         Start_Column := Start_Column + 3;
  1296.                         exit Blanks_Loop;
  1297.                      end if;
  1298.                   else
  1299.                      Scan_Ptr := Scan_Ptr + 2;
  1300.                      Start_Column := Start_Column + 2;
  1301.                      exit Blanks_Loop;
  1302.                   end if;
  1303.                else
  1304.                   Scan_Ptr := Scan_Ptr + 1;
  1305.                   Start_Column := Start_Column + 1;
  1306.                   exit Blanks_Loop;
  1307.                end if;
  1308.             else
  1309.                exit Blanks_Loop;
  1310.             end if;
  1311.          end loop Blanks_Loop;
  1312.  
  1313.          --  Outer loop keeps going only if a horizontal tab follows
  1314.  
  1315.          if Source (Scan_Ptr) = HT then
  1316.             if Style_Check then Style.Check_HT; end if;
  1317.             Scan_Ptr := Scan_Ptr + 1;
  1318.             Start_Column := (Start_Column / 8) * 8 + 8;
  1319.          else
  1320.             exit Tabs_Loop;
  1321.          end if;
  1322.  
  1323.       end loop Tabs_Loop;
  1324.  
  1325.       return Start_Column;
  1326.    end Set_Start_Column;
  1327.  
  1328. end Scn;
  1329.