X-Git-Url: https://oss.titaniummirror.com/gitweb?a=blobdiff_plain;f=gcc%2Fada%2Fscn-slit.adb;fp=gcc%2Fada%2Fscn-slit.adb;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=65e6c91d7cfdc2deaba1e002c774de6b06aac9ec;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/ada/scn-slit.adb b/gcc/ada/scn-slit.adb deleted file mode 100644 index 65e6c91d..00000000 --- a/gcc/ada/scn-slit.adb +++ /dev/null @@ -1,373 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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;