| blob | c453aaa1cb7d022129a307653b08197164f8bad9 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S C N --
6 -- --
7 -- B o d y --
8 -- --
9 -- $Revision: 1.3 $
10 -- --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 -- --
27 ------------------------------------------------------------------------------
48 -- Make control characters visible
51 -- Flags set True if a given keyword is used as an identifier (used to
52 -- make sure that we only post an error message for incorrect use of a
53 -- keyword as an identifier once for a given keyword).
55 -----------------------
56 -- Local Subprograms --
57 -----------------------
61 -- This routine accumulates the checksum given character C. During the
62 -- scanning of a source file, this routine is called with every character
63 -- in the source, excluding blanks, and all control characters (except
64 -- that ESC is included in the checksum). Upper case letters not in string
65 -- literals are folded by the caller. See Sinput spec for the documentation
66 -- of the checksum algorithm. Note: checksum values are only used if we
67 -- generate code, so it is not necessary to worry about making the right
68 -- sequence of calls in any error situation.
72 -- This version is identical, except that the argument, C, is a character
73 -- code value instead of a character. This is used when wide characters
74 -- are scanned. We use the character code rather than the ASCII characters
75 -- so that the checksum is independent of wide character encoding method.
79 -- Initialize checksum value
82 -- Called when end of line encountered. Checks that line is not
83 -- too long, and that other style checks for the end of line are met.
86 -- Scan header of file and check that it has an appropriate GNAT-style
87 -- header with a proper license statement. Returns GPL, Unrestricted,
88 -- or Modified_GPL depending on header. If none of these, returns Unknown.
91 -- This function is used for double character tokens like := or <>. It
92 -- checks if the character following Source (Scan_Ptr) is C, and if so
93 -- bumps Scan_Ptr past the pair of characters and returns True. A space
94 -- between the two characters is also recognized with an appropriate
95 -- error message being issued. If C is not present, False is returned.
96 -- Note that Double_Char_Token can only be used for tokens defined in
97 -- the Ada syntax (it's use for error cases like && is not appropriate
98 -- since we do not want a junk message for a case like &-space-&).
101 -- Give illegal character error, Scan_Ptr points to character. On return,
102 -- Scan_Ptr is bumped past the illegal character.
105 -- Give illegal wide character message. On return, Scan_Ptr is bumped
106 -- past the illegal character, which may still leave us pointing to
107 -- junk, not much we can do if the escape sequence is messed up!
110 -- Signal error of excessively long line
113 -- Signal error of double underline character
116 -- This is the procedure for scanning out numeric literals. On entry,
117 -- Scan_Ptr points to the digit that starts the numeric literal (the
118 -- checksum for this character has not been accumulated yet). On return
119 -- Scan_Ptr points past the last character of the numeric literal, Token
120 -- and Token_Node are set appropriately, and the checksum is updated.
123 -- This routine is called with Scan_Ptr pointing to the first character
124 -- of a line. On exit, Scan_Ptr is advanced to the first non-blank
125 -- character of this line (or to the terminating format effector if the
126 -- line contains no non-blank characters), and the returned result is the
127 -- column number of this non-blank character (zero origin), which is the
128 -- value to be stored in the Start_Column scan variable.
131 -- This is the procedure for scanning out string literals. On entry,
132 -- Scan_Ptr points to the opening string quote (the checksum for this
133 -- character has not been accumulated yet). On return Scan_Ptr points
134 -- past the closing quote of the string literal, Token and Token_Node
135 -- are set appropriately, and the checksum is upated.
137 -------------------------
138 -- Accumulate_Checksum --
139 -------------------------
142 begin
147 begin
152 -----------------------
153 -- Check_End_Of_Line --
154 -----------------------
159 begin
161 Error_Long_Line;
168 -----------------------
169 -- Determine_License --
170 -----------------------
176 -- See if current comment contains successive non-blank characters
177 -- matching the contents of S. If so leave Scan_Ptr unchanged and
178 -- return True, otherwise leave Scan_Ptr unchanged and return False.
181 -- Skip to line terminator character
183 --------------
184 -- Contains --
185 --------------
192 begin
199 loop
221 --------------
222 -- Skip_EOL --
223 --------------
226 begin
229 loop
234 -- Start of processing for Determine_License
236 begin
237 loop
240 then
243 else
255 elsif
256 Contains
258 or else
259 Contains
261 then
265 Skip_EOL;
267 Check_End_Of_Line;
269 declare
272 begin
275 -- If we are at start of physical line, update scan pointers
276 -- to reflect the start of the new line.
287 ----------------------------
288 -- Determine_Token_Casing --
289 ----------------------------
292 begin
296 -----------------------
297 -- Double_Char_Token --
298 -----------------------
301 begin
309 then
315 else
320 -----------------------------
321 -- Error_Illegal_Character --
322 -----------------------------
325 begin
330 ----------------------------------
331 -- Error_Illegal_Wide_Character --
332 ----------------------------------
335 begin
337 Error_Msg_S
340 else
341 Error_Msg_S
348 ---------------------
349 -- Error_Long_Line --
350 ---------------------
353 begin
354 Error_Msg
359 -------------------------------
360 -- Error_No_Double_Underline --
361 -------------------------------
364 begin
368 -------------------------
369 -- Initialize_Checksum --
370 -------------------------
373 begin
377 ------------------------
378 -- Initialize_Scanner --
379 ------------------------
381 procedure Initialize_Scanner
384 is
387 begin
388 -- Set up Token_Type values in Names Table entries for reserved keywords
389 -- We use the Pos value of the Token_Type value. Note we are relying on
390 -- the fact that Token_Type'Val (0) is not a reserved word!
462 -- Initialize scan control variables
476 Initialize_Checksum;
478 -- Set default for Comes_From_Source. All nodes built now until we
479 -- reenter the analyzer will have Comes_From_Source set to True
483 -- Check license if GNAT type header possibly present
487 then
491 -- Scan initial token (note this initializes Prev_Token, Prev_Token_Ptr)
493 Scan;
495 -- Clear flags for reserved words used as identifiers
503 ----------
504 -- Nlit --
505 ----------
509 ----------
510 -- Scan --
511 ----------
514 begin
519 -- The following loop runs more than once only if a format effector
520 -- (tab, vertical tab, form feed, line feed, carriage return) is
521 -- encountered and skipped, or some error situation, such as an
522 -- illegal character, is encountered.
524 loop
525 -- Skip past blanks, loop is opened up for speed
567 -- We are now at a non-blank character, which is the first character
568 -- of the token we will scan, and hence the value of Token_Ptr.
572 -- Here begins the main case statement which transfers control on
573 -- the basis of the non-blank character we have encountered.
577 -- Line terminator characters
581 -- Check line too long
583 Check_End_Of_Line;
585 declare
588 begin
591 -- If we are at start of physical line, update scan pointers
592 -- to reflect the start of the new line.
602 -- Horizontal tab, just skip past it
608 -- End of file character, treated as an end of file only if it
609 -- is the last character in the buffer, otherwise it is ignored.
613 Check_End_Of_Line;
617 else
621 -- Ampersand
632 else
638 -- Asterisk (can be multiplication operator or double asterisk
639 -- which is the exponentiation compound delimtier).
650 else
656 -- Colon, which can either be an isolated colon, or part of an
657 -- assignment compound delimiter.
669 then
675 else
682 -- Left parenthesis
691 -- Left bracket
698 else
705 -- Left brace
713 -- Comma
722 -- Dot, which is either an isolated period, or part of a double
723 -- dot compound delimiter sequence. We also check for the case of
724 -- a digit following the period, to give a better error message.
738 else
744 -- Equal, which can either be an equality operator, or part of the
745 -- arrow (=>) compound delimiter.
764 -- Greater than, which can be a greater than operator, greater than
765 -- or equal operator, or first character of a right label bracket.
778 else
784 -- Less than, which can be a less than operator, less than or equal
785 -- operator, or the first character of a left label bracket, or the
786 -- first character of a box (<>) compound delimiter.
804 else
810 -- Minus, which is either a subtraction operator, or the first
811 -- character of double minus starting a comment
826 -- Comment
832 -- Loop to scan comment (this loop runs more than once only if
833 -- a horizontal tab or other non-graphic character is scanned)
835 loop
836 -- Scan to non graphic character (opened up for speed)
838 loop
851 -- Keep going if horizontal tab
857 -- Terminate scan of comment if line terminator
862 -- Terminate scan of comment if end of file encountered
863 -- (embedded EOF character or real last character in file)
868 -- Keep going if character in 80-FF range, or is ESC. These
869 -- characters are allowed in comments by RM-2.1(1), 2.7(2).
870 -- They are allowed even in Ada 83 mode according to the
871 -- approved AI. ESC was added to the AI in June 93.
875 then
878 -- Otherwise we have an illegal comment character
880 else
881 Error_Illegal_Character;
886 -- Note that we do NOT execute a return here, instead we fall
887 -- through to reexecute the scan loop to look for a token.
892 -- Double quote or percent starting a string literal
895 Slit;
898 -- Apostrophe. This can either be the start of a character literal,
899 -- or an isolated apostrophe used in a qualified expression or an
900 -- attribute. We treat it as a character literal if it does not
901 -- follow a right parenthesis, identifier, the keyword ALL or
902 -- a literal. This means that we correctly treat constructs like:
904 -- A := CHARACTER'('A');
906 -- Note that RM-2.2(7) does not require a separator between
907 -- "CHARACTER" and "'" in the above.
913 begin
917 -- Here is where we make the test to distinguish the cases. Treat
918 -- as apostrophe if previous token is an identifier, right paren
919 -- or the reserved word "all" (latter case as in A.all'Address)
920 -- Also treat it as apostrophe after a literal (this catches
921 -- some legitimate cases, like A."abs"'Address, and also gives
922 -- better error behavior for impossible cases like 123'xxx).
928 then
932 -- Otherwise the apostrophe starts a character literal
934 else
935 -- Case of wide character literal with ESC or [ encoding
938 and then
940 or else
942 and then
943 Upper_Half_Encoding)
944 or else
946 and then
948 then
953 Error_Illegal_Wide_Character;
958 else
962 -- If we do not find a closing quote in the expected place then
963 -- assume that we have a misguided attempt at a string literal.
965 -- However, if previous token is RANGE, then we return an
966 -- apostrophe instead since this gives better error recovery
974 else
976 Error_Msg_S
982 -- Otherwise we have a (non-wide) character literal
984 else
990 Error_Illegal_Character;
993 else
994 Error_Illegal_Character;
1002 -- Fall through here with Scan_Ptr updated past the closing
1003 -- quote, and Code set to the Char_Code value for the literal
1016 -- Right parenthesis
1025 -- Right bracket or right brace, treated as right paren
1033 -- Slash (can be division operator or first character of not equal)
1041 else
1047 -- Semicolon
1056 -- Vertical bar
1061 -- Special check for || to give nice message
1069 else
1077 -- Exclamation, replacement character for vertical bar
1088 else
1096 -- Plus
1105 -- Digits starting a numeric literal
1108 Nlit;
1111 Error_Msg_S
1117 -- Lower case letters
1126 -- Upper case letters
1136 -- Underline character
1145 -- Space (not possible, because we scanned past blanks)
1150 -- Characters in top half of ASCII 8-bit chart
1154 -- Wide character case. Note that Scan_Identifier will issue
1155 -- an appropriate message if wide characters are not allowed
1156 -- in identifiers.
1162 -- Otherwise we have OK Latin-1 character
1164 else
1165 -- Upper half characters may possibly be identifier letters
1166 -- but can never be digits, so Identifier_Character can be
1167 -- used to test for a valid start of identifier character.
1172 else
1173 Error_Illegal_Character;
1179 -- ESC character, possible start of identifier if wide characters
1180 -- using ESC encoding are allowed in identifiers, which we can
1181 -- tell by looking at the Identifier_Char flag for ESC, which is
1182 -- only true if these conditions are met.
1187 else
1188 Error_Illegal_Wide_Character;
1191 -- Invalid control characters
1193 when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | SO |
1194 SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
1195 EM | FS | GS | RS | US | DEL
1196 =>
1197 Error_Illegal_Character;
1199 -- Invalid graphic characters
1202 Error_Illegal_Character;
1204 -- End switch on non-blank character
1208 -- End loop past format effectors. The exit from this loop is by
1209 -- executing a return statement following completion of token scan
1210 -- (control never falls out of this loop to the code which follows)
1214 -- Identifier scanning routine. On entry, some initial characters
1215 -- of the identifier may have already been stored in Name_Buffer.
1216 -- If so, Name_Len has the number of characters stored. otherwise
1217 -- Name_Len is set to zero on entry.
1221 -- This loop scans as fast as possible past lower half letters
1222 -- and digits, which we expect to be the most common characters.
1224 loop
1227 then
1235 else
1239 -- Open out the loop a couple of times for speed
1243 then
1252 else
1260 then
1268 else
1276 then
1285 else
1295 -- If we fall through, then we have encountered either an underline
1296 -- character, or an extended identifier character (i.e. one from the
1297 -- upper half), or a wide character, or an identifier terminator.
1298 -- The initial test speeds us up in the most common case where we
1299 -- have an identifier terminator. Note that ESC is an identifier
1300 -- character only if a wide character encoding method that uses
1301 -- ESC encoding is active, so if we find an ESC character we know
1302 -- that we have a wide character.
1306 -- Case of underline, check for error cases of double underline,
1307 -- and for a trailing underline character
1318 Error_No_Double_Underline;
1321 else
1328 -- Upper half character
1331 and then not Upper_Half_Encoding
1332 then
1334 Store_Encoded_Character
1339 -- Left bracket not followed by a quote terminates an identifier.
1340 -- This is an error, but we don't want to give a junk error msg
1341 -- about wide characters in this case!
1345 then
1348 -- We know we have a wide character encoding here (the current
1349 -- character is either ESC, left bracket, or an upper half
1350 -- character depending on the encoding method).
1352 else
1353 -- Scan out the wide character and insert the appropriate
1354 -- encoding into the name table entry for the identifier.
1356 declare
1361 begin
1366 Error_Illegal_Wide_Character;
1367 else
1371 -- Make sure we are allowing wide characters in identifiers.
1372 -- Note that we allow wide character notation for an OK
1373 -- identifier character. This in particular allows bracket
1374 -- or other notation to be used for upper half letters.
1377 and then
1379 or else
1381 then
1382 Error_Msg
1391 -- Scan of identifier is complete. The identifier is stored in
1392 -- Name_Buffer, and Scan_Ptr points past the last character.
1396 -- Here is where we check if it was a keyword
1400 then
1403 -- Deal with possible style check for non-lower case keyword,
1404 -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
1405 -- for this purpose if they appear as attribute designators.
1406 -- Actually we only check the first character for speed.
1408 if Style_Check
1411 or else
1416 then
1420 -- We must reset Token_Name since this is not an identifier
1421 -- and if we leave Token_Name set, the parser gets confused
1422 -- because it thinks it is dealing with an identifier instead
1423 -- of the corresponding keyword.
1428 -- It is an identifier after all
1430 else
1438 ---------------------
1439 -- Scan_First_Char --
1440 ---------------------
1445 begin
1446 loop
1454 else
1460 ------------------------------
1461 -- Scan_Reserved_Identifier --
1462 ------------------------------
1467 begin
1468 -- We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
1469 -- This code extracts the xxx and makes an identifier out of it.
1491 ----------------------
1492 -- Set_Start_Column --
1493 ----------------------
1495 -- Note: it seems at first glance a little expensive to compute this value
1496 -- for every source line (since it is certainly not used for all source
1497 -- lines). On the other hand, it doesn't take much more work to skip past
1498 -- the initial white space on the line counting the columns than it would
1499 -- to scan past the white space using the standard scanning circuits.
1504 begin
1505 -- Outer loop scans past horizontal tab characters
1509 -- Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
1510 -- past the blanks and adjusting Start_Column to account for them.
1522 else
1527 else
1532 else
1537 else
1542 else
1547 else
1552 else
1557 -- Outer loop keeps going only if a horizontal tab follows
1563 else
1572 ----------
1573 -- Slit --
1574 ----------