+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- S C N . S L I T --
--- --
--- B o d y --
--- --
--- $Revision: 1.2.12.1 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
--- --
--- GNAT is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Stringt; use Stringt;
-
-separate (Scn)
-procedure Slit is
-
- Delimiter : Character;
- -- Delimiter (first character of string)
-
- C : Character;
- -- Current source program character
-
- Code : Char_Code;
- -- Current character code value
-
- Err : Boolean;
- -- Error flag for Scan_Wide call
-
- String_Literal_Id : String_Id;
- -- Id for currently scanned string value
-
- Wide_Character_Found : Boolean := False;
- -- Set True if wide character found
-
- procedure Error_Bad_String_Char;
- -- Signal bad character in string/character literal. On entry Scan_Ptr
- -- points to the improper character encountered during the scan. Scan_Ptr
- -- is not modified, so it still points to the bad character on return.
-
- procedure Error_Unterminated_String;
- -- Procedure called if a line terminator character is encountered during
- -- scanning a string, meaning that the string is not properly terminated.
-
- procedure Set_String;
- -- Procedure used to distinguish between string and operator symbol.
- -- On entry the string has been scanned out, and its characters start
- -- at Token_Ptr and end one character before Scan_Ptr. On exit Token
- -- is set to Tok_String_Literal or Tok_Operator_Symbol as appropriate,
- -- and Token_Node is appropriately initialized. In addition, in the
- -- operator symbol case, Token_Name is appropriately set.
-
- ---------------------------
- -- Error_Bad_String_Char --
- ---------------------------
-
- procedure Error_Bad_String_Char is
- C : constant Character := Source (Scan_Ptr);
-
- begin
- if C = HT then
- Error_Msg_S ("horizontal tab not allowed in string");
-
- elsif C = VT or else C = FF then
- Error_Msg_S ("format effector not allowed in string");
-
- elsif C in Upper_Half_Character then
- Error_Msg_S ("(Ada 83) upper half character not allowed");
-
- else
- Error_Msg_S ("control character not allowed in string");
- end if;
- end Error_Bad_String_Char;
-
- -------------------------------
- -- Error_Unterminated_String --
- -------------------------------
-
- procedure Error_Unterminated_String is
- begin
- -- An interesting little refinement. Consider the following examples:
-
- -- A := "this is an unterminated string;
- -- A := "this is an unterminated string &
- -- P(A, "this is a parameter that didn't get terminated);
-
- -- We fiddle a little to do slightly better placement in these cases
- -- also if there is white space at the end of the line we place the
- -- flag at the start of this white space, not at the end. Note that
- -- we only have to test for blanks, since tabs aren't allowed in
- -- strings in the first place and would have caused an error message.
-
- -- Two more cases that we treat specially are:
-
- -- A := "this string uses the wrong terminator'
- -- A := "this string uses the wrong terminator' &
-
- -- In these cases we give a different error message as well
-
- -- We actually reposition the scan pointer to the point where we
- -- place the flag in these cases, since it seems a better bet on
- -- the original intention.
-
- while Source (Scan_Ptr - 1) = ' '
- or else Source (Scan_Ptr - 1) = '&'
- loop
- Scan_Ptr := Scan_Ptr - 1;
- Unstore_String_Char;
- end loop;
-
- -- Check for case of incorrect string terminator, but single quote is
- -- not considered incorrect if the opening terminator misused a single
- -- quote (error message already given).
-
- if Delimiter /= '''
- and then Source (Scan_Ptr - 1) = '''
- then
- Unstore_String_Char;
- Error_Msg ("incorrect string terminator character", Scan_Ptr - 1);
- return;
- end if;
-
- if Source (Scan_Ptr - 1) = ';' then
- Scan_Ptr := Scan_Ptr - 1;
- Unstore_String_Char;
-
- if Source (Scan_Ptr - 1) = ')' then
- Scan_Ptr := Scan_Ptr - 1;
- Unstore_String_Char;
- end if;
- end if;
-
- Error_Msg_S ("missing string quote");
- end Error_Unterminated_String;
-
- ----------------
- -- Set_String --
- ----------------
-
- procedure Set_String is
- Slen : Int := Int (Scan_Ptr - Token_Ptr - 2);
- C1 : Character;
- C2 : Character;
- C3 : Character;
-
- begin
- -- Token_Name is currently set to Error_Name. The following section of
- -- code resets Token_Name to the proper Name_Op_xx value if the string
- -- is a valid operator symbol, otherwise it is left set to Error_Name.
-
- if Slen = 1 then
- C1 := Source (Token_Ptr + 1);
-
- case C1 is
- when '=' =>
- Token_Name := Name_Op_Eq;
-
- when '>' =>
- Token_Name := Name_Op_Gt;
-
- when '<' =>
- Token_Name := Name_Op_Lt;
-
- when '+' =>
- Token_Name := Name_Op_Add;
-
- when '-' =>
- Token_Name := Name_Op_Subtract;
-
- when '&' =>
- Token_Name := Name_Op_Concat;
-
- when '*' =>
- Token_Name := Name_Op_Multiply;
-
- when '/' =>
- Token_Name := Name_Op_Divide;
-
- when others =>
- null;
- end case;
-
- elsif Slen = 2 then
- C1 := Source (Token_Ptr + 1);
- C2 := Source (Token_Ptr + 2);
-
- if C1 = '*' and then C2 = '*' then
- Token_Name := Name_Op_Expon;
-
- elsif C2 = '=' then
-
- if C1 = '/' then
- Token_Name := Name_Op_Ne;
- elsif C1 = '<' then
- Token_Name := Name_Op_Le;
- elsif C1 = '>' then
- Token_Name := Name_Op_Ge;
- end if;
-
- elsif (C1 = 'O' or else C1 = 'o') and then -- OR
- (C2 = 'R' or else C2 = 'r')
- then
- Token_Name := Name_Op_Or;
- end if;
-
- elsif Slen = 3 then
- C1 := Source (Token_Ptr + 1);
- C2 := Source (Token_Ptr + 2);
- C3 := Source (Token_Ptr + 3);
-
- if (C1 = 'A' or else C1 = 'a') and then -- AND
- (C2 = 'N' or else C2 = 'n') and then
- (C3 = 'D' or else C3 = 'd')
- then
- Token_Name := Name_Op_And;
-
- elsif (C1 = 'A' or else C1 = 'a') and then -- ABS
- (C2 = 'B' or else C2 = 'b') and then
- (C3 = 'S' or else C3 = 's')
- then
- Token_Name := Name_Op_Abs;
-
- elsif (C1 = 'M' or else C1 = 'm') and then -- MOD
- (C2 = 'O' or else C2 = 'o') and then
- (C3 = 'D' or else C3 = 'd')
- then
- Token_Name := Name_Op_Mod;
-
- elsif (C1 = 'N' or else C1 = 'n') and then -- NOT
- (C2 = 'O' or else C2 = 'o') and then
- (C3 = 'T' or else C3 = 't')
- then
- Token_Name := Name_Op_Not;
-
- elsif (C1 = 'R' or else C1 = 'r') and then -- REM
- (C2 = 'E' or else C2 = 'e') and then
- (C3 = 'M' or else C3 = 'm')
- then
- Token_Name := Name_Op_Rem;
-
- elsif (C1 = 'X' or else C1 = 'x') and then -- XOR
- (C2 = 'O' or else C2 = 'o') and then
- (C3 = 'R' or else C3 = 'r')
- then
- Token_Name := Name_Op_Xor;
- end if;
-
- end if;
-
- -- If it is an operator symbol, then Token_Name is set. If it is some
- -- other string value, then Token_Name still contains Error_Name.
-
- if Token_Name = Error_Name then
- Token := Tok_String_Literal;
- Token_Node := New_Node (N_String_Literal, Token_Ptr);
- Set_Has_Wide_Character (Token_Node, Wide_Character_Found);
-
- else
- Token := Tok_Operator_Symbol;
- Token_Node := New_Node (N_Operator_Symbol, Token_Ptr);
- Set_Chars (Token_Node, Token_Name);
- end if;
-
- Set_Strval (Token_Node, String_Literal_Id);
-
- end Set_String;
-
-----------
--- Slit --
-----------
-
-begin
- -- On entry, Scan_Ptr points to the opening character of the string which
- -- is either a percent, double quote, or apostrophe (single quote). The
- -- latter case is an error detected by the character literal circuit.
-
- Delimiter := Source (Scan_Ptr);
- Accumulate_Checksum (Delimiter);
- Start_String;
- Scan_Ptr := Scan_Ptr + 1;
-
- -- Loop to scan out characters of string literal
-
- loop
- C := Source (Scan_Ptr);
-
- if C = Delimiter then
- Accumulate_Checksum (C);
- Scan_Ptr := Scan_Ptr + 1;
- exit when Source (Scan_Ptr) /= Delimiter;
- Code := Get_Char_Code (C);
- Accumulate_Checksum (C);
- Scan_Ptr := Scan_Ptr + 1;
-
- else
- if C = '"' and then Delimiter = '%' then
- Error_Msg_S ("quote not allowed in percent delimited string");
- Code := Get_Char_Code (C);
- Scan_Ptr := Scan_Ptr + 1;
-
- elsif (C = ESC
- and then
- Wide_Character_Encoding_Method in WC_ESC_Encoding_Method)
- or else
- (C in Upper_Half_Character
- and then
- Upper_Half_Encoding)
- or else
- (C = '['
- and then
- Source (Scan_Ptr + 1) = '"'
- and then
- Identifier_Char (Source (Scan_Ptr + 2)))
- then
- Scan_Wide (Source, Scan_Ptr, Code, Err);
- Accumulate_Checksum (Code);
-
- if Err then
- Error_Illegal_Wide_Character;
- Code := Get_Char_Code (' ');
- end if;
-
- else
- Accumulate_Checksum (C);
-
- if C not in Graphic_Character then
- if C in Line_Terminator then
- Error_Unterminated_String;
- exit;
-
- elsif C in Upper_Half_Character then
- if Ada_83 then
- Error_Bad_String_Char;
- end if;
-
- else
- Error_Bad_String_Char;
- end if;
- end if;
-
- Code := Get_Char_Code (C);
- Scan_Ptr := Scan_Ptr + 1;
- end if;
- end if;
-
- Store_String_Char (Code);
-
- if not In_Character_Range (Code) then
- Wide_Character_Found := True;
- end if;
- end loop;
-
- String_Literal_Id := End_String;
- Set_String;
- return;
-
-end Slit;
projects / msp430-gcc.git / blobdiff