| blob | ba95fd579112b1598b4f8a739bdc045a67f80b46 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S C N --
6 -- --
7 -- B o d y --
8 -- --
9 -- --
10 -- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
11 -- --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
22 -- --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 -- --
26 ------------------------------------------------------------------------------
47 -- Make control characters visible
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).
54 -----------------------
55 -- Local Subprograms --
56 -----------------------
60 -- This routine accumulates the checksum given character C. During the
61 -- scanning of a source file, this routine is called with every character
62 -- in the source, excluding blanks, and all control characters (except
63 -- that ESC is included in the checksum). Upper case letters not in string
64 -- literals are folded by the caller. See Sinput spec for the documentation
65 -- of the checksum algorithm. Note: checksum values are only used if we
66 -- generate code, so it is not necessary to worry about making the right
67 -- sequence of calls in any error situation.
71 -- This version is identical, except that the argument, C, is a character
72 -- code value instead of a character. This is used when wide characters
73 -- are scanned. We use the character code rather than the ASCII characters
74 -- so that the checksum is independent of wide character encoding method.
78 -- Initialize checksum value
81 -- Called when end of line encountered. Checks that line is not
82 -- too long, and that other style checks for the end of line are met.
85 -- Scan header of file and check that it has an appropriate GNAT-style
86 -- header with a proper license statement. Returns GPL, Unrestricted,
87 -- or Modified_GPL depending on header. If none of these, returns Unknown.
90 -- This function is used for double character tokens like := or <>. It
91 -- checks if the character following Source (Scan_Ptr) is C, and if so
92 -- bumps Scan_Ptr past the pair of characters and returns True. A space
93 -- between the two characters is also recognized with an appropriate
94 -- error message being issued. If C is not present, False is returned.
95 -- Note that Double_Char_Token can only be used for tokens defined in
96 -- the Ada syntax (it's use for error cases like && is not appropriate
97 -- since we do not want a junk message for a case like &-space-&).
100 -- Give illegal character error, Scan_Ptr points to character. On return,
101 -- Scan_Ptr is bumped past the illegal character.
104 -- Give illegal wide character message. On return, Scan_Ptr is bumped
105 -- past the illegal character, which may still leave us pointing to
106 -- junk, not much we can do if the escape sequence is messed up!
109 -- Signal error of excessively long line
112 -- Signal error of double underline character
115 -- This is the procedure for scanning out numeric literals. On entry,
116 -- Scan_Ptr points to the digit that starts the numeric literal (the
117 -- checksum for this character has not been accumulated yet). On return
118 -- Scan_Ptr points past the last character of the numeric literal, Token
119 -- and Token_Node are set appropriately, and the checksum is updated.
122 -- This routine is called with Scan_Ptr pointing to the first character
123 -- of a line. On exit, Scan_Ptr is advanced to the first non-blank
124 -- character of this line (or to the terminating format effector if the
125 -- line contains no non-blank characters), and the returned result is the
126 -- column number of this non-blank character (zero origin), which is the
127 -- value to be stored in the Start_Column scan variable.
130 -- This is the procedure for scanning out string literals. On entry,
131 -- Scan_Ptr points to the opening string quote (the checksum for this
132 -- character has not been accumulated yet). On return Scan_Ptr points
133 -- past the closing quote of the string literal, Token and Token_Node
134 -- are set appropriately, and the checksum is upated.
136 -------------------------
137 -- Accumulate_Checksum --
138 -------------------------
141 begin
146 begin
151 -----------------------
152 -- Check_End_Of_Line --
153 -----------------------
158 begin
160 Error_Long_Line;
167 -----------------------
168 -- Determine_License --
169 -----------------------
175 -- See if current comment contains successive non-blank characters
176 -- matching the contents of S. If so leave Scan_Ptr unchanged and
177 -- return True, otherwise leave Scan_Ptr unchanged and return False.
180 -- Skip to line terminator character
182 --------------
183 -- Contains --
184 --------------
191 begin
198 loop
220 --------------
221 -- Skip_EOL --
222 --------------
225 begin
228 loop
233 -- Start of processing for Determine_License
235 begin
236 loop
239 then
242 else
254 elsif
255 Contains
257 or else
258 Contains
260 then
264 Skip_EOL;
266 Check_End_Of_Line;
268 declare
271 begin
274 -- If we are at start of physical line, update scan pointers
275 -- to reflect the start of the new line.
286 ----------------------------
287 -- Determine_Token_Casing --
288 ----------------------------
291 begin
295 -----------------------
296 -- Double_Char_Token --
297 -----------------------
300 begin
308 then
314 else
319 -----------------------------
320 -- Error_Illegal_Character --
321 -----------------------------
324 begin
329 ----------------------------------
330 -- Error_Illegal_Wide_Character --
331 ----------------------------------
334 begin
336 Error_Msg_S
339 else
340 Error_Msg_S
347 ---------------------
348 -- Error_Long_Line --
349 ---------------------
352 begin
353 Error_Msg
358 -------------------------------
359 -- Error_No_Double_Underline --
360 -------------------------------
363 begin
367 -------------------------
368 -- Initialize_Checksum --
369 -------------------------
372 begin
376 ------------------------
377 -- Initialize_Scanner --
378 ------------------------
380 procedure Initialize_Scanner
383 is
386 begin
387 -- Set up Token_Type values in Names Table entries for reserved keywords
388 -- We use the Pos value of the Token_Type value. Note we are relying on
389 -- the fact that Token_Type'Val (0) is not a reserved word!
461 -- Initialize scan control variables
475 Initialize_Checksum;
477 -- Set default for Comes_From_Source. All nodes built now until we
478 -- reenter the analyzer will have Comes_From_Source set to True
482 -- Check license if GNAT type header possibly present
486 then
490 -- Scan initial token (note this initializes Prev_Token, Prev_Token_Ptr)
492 Scan;
494 -- Clear flags for reserved words used as identifiers
502 ----------
503 -- Nlit --
504 ----------
508 ----------
509 -- Scan --
510 ----------
513 begin
518 -- The following loop runs more than once only if a format effector
519 -- (tab, vertical tab, form feed, line feed, carriage return) is
520 -- encountered and skipped, or some error situation, such as an
521 -- illegal character, is encountered.
523 loop
524 -- Skip past blanks, loop is opened up for speed
566 -- We are now at a non-blank character, which is the first character
567 -- of the token we will scan, and hence the value of Token_Ptr.
571 -- Here begins the main case statement which transfers control on
572 -- the basis of the non-blank character we have encountered.
576 -- Line terminator characters
580 -- Check line too long
582 Check_End_Of_Line;
584 declare
587 begin
590 -- If we are at start of physical line, update scan pointers
591 -- to reflect the start of the new line.
601 -- Horizontal tab, just skip past it
607 -- End of file character, treated as an end of file only if it
608 -- is the last character in the buffer, otherwise it is ignored.
612 Check_End_Of_Line;
616 else
620 -- Ampersand
631 else
637 -- Asterisk (can be multiplication operator or double asterisk
638 -- which is the exponentiation compound delimtier).
649 else
655 -- Colon, which can either be an isolated colon, or part of an
656 -- assignment compound delimiter.
668 then
674 else
681 -- Left parenthesis
690 -- Left bracket
697 else
704 -- Left brace
712 -- Comma
721 -- Dot, which is either an isolated period, or part of a double
722 -- dot compound delimiter sequence. We also check for the case of
723 -- a digit following the period, to give a better error message.
737 else
743 -- Equal, which can either be an equality operator, or part of the
744 -- arrow (=>) compound delimiter.
763 -- Greater than, which can be a greater than operator, greater than
764 -- or equal operator, or first character of a right label bracket.
777 else
783 -- Less than, which can be a less than operator, less than or equal
784 -- operator, or the first character of a left label bracket, or the
785 -- first character of a box (<>) compound delimiter.
803 else
809 -- Minus, which is either a subtraction operator, or the first
810 -- character of double minus starting a comment
825 -- Comment
831 -- Loop to scan comment (this loop runs more than once only if
832 -- a horizontal tab or other non-graphic character is scanned)
834 loop
835 -- Scan to non graphic character (opened up for speed)
837 loop
850 -- Keep going if horizontal tab
856 -- Terminate scan of comment if line terminator
861 -- Terminate scan of comment if end of file encountered
862 -- (embedded EOF character or real last character in file)
867 -- Keep going if character in 80-FF range, or is ESC. These
868 -- characters are allowed in comments by RM-2.1(1), 2.7(2).
869 -- They are allowed even in Ada 83 mode according to the
870 -- approved AI. ESC was added to the AI in June 93.
874 then
877 -- Otherwise we have an illegal comment character
879 else
880 Error_Illegal_Character;
885 -- Note that we do NOT execute a return here, instead we fall
886 -- through to reexecute the scan loop to look for a token.
891 -- Double quote or percent starting a string literal
894 Slit;
897 -- Apostrophe. This can either be the start of a character literal,
898 -- or an isolated apostrophe used in a qualified expression or an
899 -- attribute. We treat it as a character literal if it does not
900 -- follow a right parenthesis, identifier, the keyword ALL or
901 -- a literal. This means that we correctly treat constructs like:
903 -- A := CHARACTER'('A');
905 -- Note that RM-2.2(7) does not require a separator between
906 -- "CHARACTER" and "'" in the above.
912 begin
916 -- Here is where we make the test to distinguish the cases. Treat
917 -- as apostrophe if previous token is an identifier, right paren
918 -- or the reserved word "all" (latter case as in A.all'Address)
919 -- Also treat it as apostrophe after a literal (this catches
920 -- some legitimate cases, like A."abs"'Address, and also gives
921 -- better error behavior for impossible cases like 123'xxx).
927 then
931 -- Otherwise the apostrophe starts a character literal
933 else
934 -- Case of wide character literal with ESC or [ encoding
937 and then
939 or else
941 and then
942 Upper_Half_Encoding)
943 or else
945 and then
947 then
952 Error_Illegal_Wide_Character;
957 else
961 -- If we do not find a closing quote in the expected place then
962 -- assume that we have a misguided attempt at a string literal.
964 -- However, if previous token is RANGE, then we return an
965 -- apostrophe instead since this gives better error recovery
973 else
975 Error_Msg_S
981 -- Otherwise we have a (non-wide) character literal
983 else
989 Error_Illegal_Character;
992 else
993 Error_Illegal_Character;
1001 -- Fall through here with Scan_Ptr updated past the closing
1002 -- quote, and Code set to the Char_Code value for the literal
1015 -- Right parenthesis
1024 -- Right bracket or right brace, treated as right paren
1032 -- Slash (can be division operator or first character of not equal)
1040 else
1046 -- Semicolon
1055 -- Vertical bar
1060 -- Special check for || to give nice message
1068 else
1076 -- Exclamation, replacement character for vertical bar
1087 else
1095 -- Plus
1104 -- Digits starting a numeric literal
1107 Nlit;
1110 Error_Msg_S
1116 -- Lower case letters
1125 -- Upper case letters
1135 -- Underline character
1144 -- Space (not possible, because we scanned past blanks)
1149 -- Characters in top half of ASCII 8-bit chart
1153 -- Wide character case. Note that Scan_Identifier will issue
1154 -- an appropriate message if wide characters are not allowed
1155 -- in identifiers.
1161 -- Otherwise we have OK Latin-1 character
1163 else
1164 -- Upper half characters may possibly be identifier letters
1165 -- but can never be digits, so Identifier_Char can be used
1166 -- to test for a valid start of identifier character.
1171 else
1172 Error_Illegal_Character;
1178 -- ESC character, possible start of identifier if wide characters
1179 -- using ESC encoding are allowed in identifiers, which we can
1180 -- tell by looking at the Identifier_Char flag for ESC, which is
1181 -- only true if these conditions are met.
1186 else
1187 Error_Illegal_Wide_Character;
1190 -- Invalid control characters
1192 when NUL | SOH | STX | ETX | EOT | ENQ | ACK | BEL | BS | SO |
1193 SI | DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN |
1194 EM | FS | GS | RS | US | DEL
1195 =>
1196 Error_Illegal_Character;
1198 -- Invalid graphic characters
1201 Error_Illegal_Character;
1203 -- End switch on non-blank character
1207 -- End loop past format effectors. The exit from this loop is by
1208 -- executing a return statement following completion of token scan
1209 -- (control never falls out of this loop to the code which follows)
1213 -- Identifier scanning routine. On entry, some initial characters
1214 -- of the identifier may have already been stored in Name_Buffer.
1215 -- If so, Name_Len has the number of characters stored. otherwise
1216 -- Name_Len is set to zero on entry.
1220 -- This loop scans as fast as possible past lower half letters
1221 -- and digits, which we expect to be the most common characters.
1223 loop
1226 then
1234 else
1238 -- Open out the loop a couple of times for speed
1242 then
1251 else
1259 then
1267 else
1275 then
1284 else
1294 -- If we fall through, then we have encountered either an underline
1295 -- character, or an extended identifier character (i.e. one from the
1296 -- upper half), or a wide character, or an identifier terminator.
1297 -- The initial test speeds us up in the most common case where we
1298 -- have an identifier terminator. Note that ESC is an identifier
1299 -- character only if a wide character encoding method that uses
1300 -- ESC encoding is active, so if we find an ESC character we know
1301 -- that we have a wide character.
1305 -- Case of underline, check for error cases of double underline,
1306 -- and for a trailing underline character
1317 Error_No_Double_Underline;
1320 else
1327 -- Upper half character
1330 and then not Upper_Half_Encoding
1331 then
1333 Store_Encoded_Character
1338 -- Left bracket not followed by a quote terminates an identifier.
1339 -- This is an error, but we don't want to give a junk error msg
1340 -- about wide characters in this case!
1344 then
1347 -- We know we have a wide character encoding here (the current
1348 -- character is either ESC, left bracket, or an upper half
1349 -- character depending on the encoding method).
1351 else
1352 -- Scan out the wide character and insert the appropriate
1353 -- encoding into the name table entry for the identifier.
1355 declare
1361 begin
1364 -- If error, signal error
1367 Error_Illegal_Wide_Character;
1369 -- If the character scanned is a normal identifier
1370 -- character, then we treat it that way.
1374 then
1377 Store_Encoded_Character
1380 -- Character is not normal identifier character, store
1381 -- it in encoded form.
1383 else
1387 -- Make sure we are allowing wide characters in
1388 -- identifiers. Note that we allow wide character
1389 -- notation for an OK identifier character. This
1390 -- in particular allows bracket or other notation
1391 -- to be used for upper half letters.
1394 Error_Msg
1404 -- Scan of identifier is complete. The identifier is stored in
1405 -- Name_Buffer, and Scan_Ptr points past the last character.
1409 -- Here is where we check if it was a keyword
1413 then
1416 -- Deal with possible style check for non-lower case keyword,
1417 -- but we don't treat ACCESS, DELTA, DIGITS, RANGE as keywords
1418 -- for this purpose if they appear as attribute designators.
1419 -- Actually we only check the first character for speed.
1421 if Style_Check
1424 or else
1429 then
1433 -- We must reset Token_Name since this is not an identifier
1434 -- and if we leave Token_Name set, the parser gets confused
1435 -- because it thinks it is dealing with an identifier instead
1436 -- of the corresponding keyword.
1441 -- It is an identifier after all
1443 else
1451 ---------------------
1452 -- Scan_First_Char --
1453 ---------------------
1458 begin
1459 loop
1467 else
1473 ------------------------------
1474 -- Scan_Reserved_Identifier --
1475 ------------------------------
1480 begin
1481 -- We have in Token_Chars the image of the Token name, i.e. Tok_xxx.
1482 -- This code extracts the xxx and makes an identifier out of it.
1504 ----------------------
1505 -- Set_Start_Column --
1506 ----------------------
1508 -- Note: it seems at first glance a little expensive to compute this value
1509 -- for every source line (since it is certainly not used for all source
1510 -- lines). On the other hand, it doesn't take much more work to skip past
1511 -- the initial white space on the line counting the columns than it would
1512 -- to scan past the white space using the standard scanning circuits.
1517 begin
1518 -- Outer loop scans past horizontal tab characters
1522 -- Inner loop scans past blanks as fast as possible, bumping Scan_Ptr
1523 -- past the blanks and adjusting Start_Column to account for them.
1535 else
1540 else
1545 else
1550 else
1555 else
1560 else
1565 else
1570 -- Outer loop keeps going only if a horizontal tab follows
1576 else
1585 ----------
1586 -- Slit --
1587 ----------