diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e75adb756a4..bb501ffd96e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2012-08-06 Thomas Quinot + + * sem_ch4.adb: Minor reformatting. + +2012-08-06 Thomas Quinot + + * s-oscons-tmplt.c, xoscons.adb: Per the Single UNIX Specification, + types cc_t, speed_t, and tcflag_t defined in all are + unsigned types. Add required special handling to have their correct + unsigned values in s-oscons.ads. + +2012-08-06 Thomas Quinot + + * par-ch13.adb: Minor reformatting. + +2012-08-06 Thomas Quinot + + * g-sercom.adb, g-sercom.ads, g-sercom-mingw.adb, g-sercom-linux.adb + (Set): Add Local and Flow_Control settings. + +2012-08-06 Ed Schonberg + + * exp_attr.adb: Suppress saving of 'Old if assertions are not + enabled. + 2012-08-06 Yannick Moy * sem_ch4.adb (Analyze_Selected_Component): Issue an error in diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 6516d3bc199..b0f409d071c 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3379,6 +3379,13 @@ package body Exp_Attr is Asn_Stm : Node_Id; begin + -- If assertions are disabled, no need to create the declaration + -- that preserves the value. + + if not Assertions_Enabled then + return; + end if; + -- Find the nearest subprogram body, ignoring _Preconditions Subp := N; diff --git a/gcc/ada/g-sercom-linux.adb b/gcc/ada/g-sercom-linux.adb index db1aec76553..d485c1b75e3 100644 --- a/gcc/ada/g-sercom-linux.adb +++ b/gcc/ada/g-sercom-linux.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2007-2010, AdaCore -- +-- Copyright (C) 2007-2012, AdaCore -- -- -- -- 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- -- @@ -38,11 +38,14 @@ with Ada.Unchecked_Deallocation; with System; use System; with System.Communication; use System.Communication; with System.CRTL; use System.CRTL; +with System.OS_Constants; with GNAT.OS_Lib; use GNAT.OS_Lib; package body GNAT.Serial_Communications is + package OSC renames System.OS_Constants; + use type Interfaces.C.unsigned; type Port_Data is new int; @@ -54,43 +57,26 @@ package body GNAT.Serial_Communications is function fcntl (fd : int; cmd : int; value : int) return int; pragma Import (C, fcntl, "fcntl"); - O_RDWR : constant := 8#02#; - O_NOCTTY : constant := 8#0400#; - O_NDELAY : constant := 8#04000#; - FNDELAY : constant := O_NDELAY; - F_SETFL : constant := 4; - TCSANOW : constant := 0; - TCIFLUSH : constant := 0; - CLOCAL : constant := 8#04000#; - CREAD : constant := 8#0200#; - CSTOPB : constant := 8#0100#; - CRTSCTS : constant := 8#020000000000#; - PARENB : constant := 8#00400#; - PARODD : constant := 8#01000#; - - -- c_cc indexes - - VTIME : constant := 5; - VMIN : constant := 6; - C_Data_Rate : constant array (Data_Rate) of unsigned := - (B1200 => 8#000011#, - B2400 => 8#000013#, - B4800 => 8#000014#, - B9600 => 8#000015#, - B19200 => 8#000016#, - B38400 => 8#000017#, - B57600 => 8#010001#, - B115200 => 8#010002#); + (B1200 => OSC.B1200, + B2400 => OSC.B2400, + B4800 => OSC.B4800, + B9600 => OSC.B9600, + B19200 => OSC.B19200, + B38400 => OSC.B38400, + B57600 => OSC.B57600, + B115200 => OSC.B115200); C_Bits : constant array (Data_Bits) of unsigned := - (CS7 => 8#040#, CS8 => 8#060#); + (CS7 => OSC.CS7, CS8 => OSC.CS8); C_Stop_Bits : constant array (Stop_Bits_Number) of unsigned := - (One => 0, Two => CSTOPB); + (One => 0, Two => OSC.CSTOPB); C_Parity : constant array (Parity_Check) of unsigned := - (None => 0, Odd => PARENB or PARODD, Even => PARENB); + (None => 0, + Odd => OSC.PARENB or OSC.PARODD, + Even => OSC.PARENB); procedure Raise_Error (Message : String; Error : Integer := Errno); pragma No_Return (Raise_Error); @@ -114,6 +100,8 @@ package body GNAT.Serial_Communications is (Port : out Serial_Port; Name : Port_Name) is + use OSC; + C_Name : constant String := String (Name) & ASCII.NUL; Res : int; @@ -184,8 +172,12 @@ package body GNAT.Serial_Communications is Stop_Bits : Stop_Bits_Number := One; Parity : Parity_Check := None; Block : Boolean := True; + Local : Boolean := True; + Flow : Flow_Control := None; Timeout : Duration := 10.0) is + use OSC; + type termios is record c_iflag : unsigned; c_oflag : unsigned; @@ -229,12 +221,24 @@ package body GNAT.Serial_Communications is or C_Bits (Bits) or C_Stop_Bits (Stop_Bits) or C_Parity (Parity) - or CLOCAL - or CREAD - or CRTSCTS; - Current.c_lflag := 0; + or CREAD; Current.c_iflag := 0; + Current.c_lflag := 0; Current.c_oflag := 0; + + if Local then + Current.c_cflag := Current.c_cflag or CLOCAL; + end if; + + case Flow is + when None => + null; + when RTS_CTS => + Current.c_cflag := Current.c_cflag or CRTSCTS; + when Xon_Xoff => + Current.c_iflag := Current.c_iflag or IXON; + end case; + Current.c_ispeed := Data_Rate_Value (Rate); Current.c_ospeed := Data_Rate_Value (Rate); Current.c_cc (VMIN) := char'Val (0); diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb index df3754b685a..726d21f6bbb 100644 --- a/gcc/ada/g-sercom-mingw.adb +++ b/gcc/ada/g-sercom-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2007-2010, AdaCore -- +-- Copyright (C) 2007-2012, AdaCore -- -- -- -- 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- -- @@ -175,8 +175,12 @@ package body GNAT.Serial_Communications is Stop_Bits : Stop_Bits_Number := One; Parity : Parity_Check := None; Block : Boolean := True; + Local : Boolean := True; + Flow : Flow_Control := None; Timeout : Duration := 10.0) is + pragma Unreferenced (Local); + Success : BOOL; Com_Time_Out : aliased COMMTIMEOUTS; Com_Settings : aliased DCB; @@ -197,13 +201,26 @@ package body GNAT.Serial_Communications is Com_Settings.BaudRate := DWORD (Data_Rate_Value (Rate)); Com_Settings.fParity := 1; Com_Settings.fBinary := Bits1 (System.Win32.TRUE); - Com_Settings.fOutxCtsFlow := 0; Com_Settings.fOutxDsrFlow := 0; Com_Settings.fDsrSensitivity := 0; - Com_Settings.fDtrControl := DTR_CONTROL_DISABLE; - Com_Settings.fOutX := 0; + Com_Settings.fDtrControl := DTR_CONTROL_ENABLE; Com_Settings.fInX := 0; - Com_Settings.fRtsControl := RTS_CONTROL_DISABLE; + Com_Settings.fRtsControl := RTS_CONTROL_ENABLE; + + case Flow is + when None => + Com_Settings.fOutX := 0; + Com_Settings.fOutxCtsFlow := 0; + + when RTS_CTS => + Com_Settings.fOutX := 0; + Com_Settings.fOutxCtsFlow := 1; + + when Xon_Xoff => + Com_Settings.fOutX := 1; + Com_Settings.fOutxCtsFlow := 0; + end case; + Com_Settings.fAbortOnError := 0; Com_Settings.ByteSize := BYTE (C_Bits (Bits)); Com_Settings.Parity := BYTE (C_Parity (Parity)); diff --git a/gcc/ada/g-sercom.adb b/gcc/ada/g-sercom.adb index 0df096522f7..c2b511c59c7 100644 --- a/gcc/ada/g-sercom.adb +++ b/gcc/ada/g-sercom.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2007-2010, AdaCore -- +-- Copyright (C) 2007-2012, AdaCore -- -- -- -- 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- -- @@ -82,6 +82,8 @@ package body GNAT.Serial_Communications is Stop_Bits : Stop_Bits_Number := One; Parity : Parity_Check := None; Block : Boolean := True; + Local : Boolean := True; + Flow : Flow_Control := None; Timeout : Duration := 10.0) is begin diff --git a/gcc/ada/g-sercom.ads b/gcc/ada/g-sercom.ads index 5ea1bb2f7c3..b2a63911e49 100644 --- a/gcc/ada/g-sercom.ads +++ b/gcc/ada/g-sercom.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2007-2010, AdaCore -- +-- Copyright (C) 2007-2012, AdaCore -- -- -- -- 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- -- @@ -62,6 +62,9 @@ package GNAT.Serial_Communications is type Parity_Check is (None, Even, Odd); -- Either no parity check or an even or odd parity + type Flow_Control is (None, RTS_CTS, Xon_Xoff); + -- No flow control, hardware flow control, software flow control + type Serial_Port is new Ada.Streams.Root_Stream_Type with private; procedure Open @@ -77,12 +80,17 @@ package GNAT.Serial_Communications is Stop_Bits : Stop_Bits_Number := One; Parity : Parity_Check := None; Block : Boolean := True; + Local : Boolean := True; + Flow : Flow_Control := None; Timeout : Duration := 10.0); -- The communication port settings. If Block is set then a read call -- will wait for the whole buffer to be filed. If Block is not set then - -- the given Timeout (in seconds) is used. Note that the timeout precision - -- may be limited on some implementation (e.g. on GNU/Linux the maximum - -- precision is a tenth of seconds). + -- the given Timeout (in seconds) is used. If Local is set then modem + -- control lines (in particular DCD) are ignored (not supported on + -- Windows). + + -- Note that the timeout precision may be limited on some implementation + -- (e.g. on GNU/Linux the maximum precision is a tenth of seconds). overriding procedure Read (Port : in out Serial_Port; diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 72ca041e3c0..d3ed8515c38 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -467,7 +467,7 @@ package body Ch13 is Attr_Name := Token_Name; -- Note that the parser must complain in case of an internal - -- attribute names that comes from source since internal names + -- attribute name that comes from source since internal names -- are meant to be used only by the compiler. if not Is_Attribute_Name (Attr_Name) diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 8583784c04a..062f514b461 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -169,6 +169,9 @@ int counter = 0; #define CND(name,comment) \ printf ("\n->CND:$%d:" #name ":$%d:" comment, __LINE__, ((int) _VAL (name))); +#define CNU(name,comment) \ + printf ("\n->CNU:$%d:" #name ":$%u:" comment, __LINE__, ((unsigned int) _VAL (name))); + #define CNS(name,comment) \ printf ("\n->CNS:$%d:" #name ":" name ":" comment, __LINE__); @@ -185,6 +188,13 @@ int counter = 0; : : "i" (__LINE__), "i" ((int) name)); /* Decimal constant in the range of type "int" */ +#define CNU(name, comment) \ + asm volatile("\n->CNU:%0:" #name ":%1:" comment \ + : : "i" (__LINE__), "i" ((int) name)); +/* Decimal constant in the range of type "unsigned int" (note, assembler + * always wants a signed int, we convert back in xoscons). + */ + #define CNS(name, comment) \ asm volatile("\n->CNS:%0:" #name ":" name ":" comment \ : : "i" (__LINE__)); @@ -250,9 +260,9 @@ package System.OS_Constants is /* - ----------------------------- - -- Platform identification -- - ----------------------------- + --------------------------------- + -- General platform parameters -- + --------------------------------- type OS_Type is (Windows, VMS, Other_OS); */ @@ -273,6 +283,10 @@ C("Target_OS", OS_Type, TARGET_OS, "") */ #define Target_Name TARGET CST(Target_Name, "") + +#define sizeof_unsigned_int sizeof (unsigned int) +CND(sizeof_unsigned_int, "Size of unsigned int") + /* ------------------- @@ -630,210 +644,215 @@ CND(TCSANOW, "Immediate") #endif CND(TCIFLUSH, "Flush input") +#ifndef IXON +# define IXON -1 +#endif +CNU(IXON, "Output sw flow control") + #ifndef CLOCAL # define CLOCAL -1 #endif -CND(CLOCAL, "Local") +CNU(CLOCAL, "Local") #ifndef CRTSCTS # define CRTSCTS -1 #endif -CND(CRTSCTS, "Hardware flow control") +CNU(CRTSCTS, "Output hw flow control") #ifndef CREAD # define CREAD -1 #endif -CND(CREAD, "Read") +CNU(CREAD, "Read") #ifndef CS5 # define CS5 -1 #endif -CND(CS5, "5 data bits") +CNU(CS5, "5 data bits") #ifndef CS6 # define CS6 -1 #endif -CND(CS6, "6 data bits") +CNU(CS6, "6 data bits") #ifndef CS7 # define CS7 -1 #endif -CND(CS7, "7 data bits") +CNU(CS7, "7 data bits") #ifndef CS8 # define CS8 -1 #endif -CND(CS8, "8 data bits") +CNU(CS8, "8 data bits") #ifndef CSTOPB # define CSTOPB -1 #endif -CND(CSTOPB, "2 stop bits") +CNU(CSTOPB, "2 stop bits") #ifndef PARENB # define PARENB -1 #endif -CND(PARENB, "Parity enable") +CNU(PARENB, "Parity enable") #ifndef PARODD # define PARODD -1 #endif -CND(PARODD, "Parity odd") +CNU(PARODD, "Parity odd") #ifndef B0 # define B0 -1 #endif -CND(B0, "0 bps") +CNU(B0, "0 bps") #ifndef B50 # define B50 -1 #endif -CND(B50, "50 bps") +CNU(B50, "50 bps") #ifndef B75 # define B75 -1 #endif -CND(B75, "75 bps") +CNU(B75, "75 bps") #ifndef B110 # define B110 -1 #endif -CND(B110, "110 bps") +CNU(B110, "110 bps") #ifndef B134 # define B134 -1 #endif -CND(B134, "134 bps") +CNU(B134, "134 bps") #ifndef B150 # define B150 -1 #endif -CND(B150, "150 bps") +CNU(B150, "150 bps") #ifndef B200 # define B200 -1 #endif -CND(B200, "200 bps") +CNU(B200, "200 bps") #ifndef B300 # define B300 -1 #endif -CND(B300, "300 bps") +CNU(B300, "300 bps") #ifndef B600 # define B600 -1 #endif -CND(B600, "600 bps") +CNU(B600, "600 bps") #ifndef B1200 # define B1200 -1 #endif -CND(B1200, "1200 bps") +CNU(B1200, "1200 bps") #ifndef B1800 # define B1800 -1 #endif -CND(B1800, "1800 bps") +CNU(B1800, "1800 bps") #ifndef B2400 # define B2400 -1 #endif -CND(B2400, "2400 bps") +CNU(B2400, "2400 bps") #ifndef B4800 # define B4800 -1 #endif -CND(B4800, "4800 bps") +CNU(B4800, "4800 bps") #ifndef B9600 # define B9600 -1 #endif -CND(B9600, "9600 bps") +CNU(B9600, "9600 bps") #ifndef B19200 # define B19200 -1 #endif -CND(B19200, "19200 bps") +CNU(B19200, "19200 bps") #ifndef B38400 # define B38400 -1 #endif -CND(B38400, "38400 bps") +CNU(B38400, "38400 bps") #ifndef B57600 # define B57600 -1 #endif -CND(B57600, "57600 bps") +CNU(B57600, "57600 bps") #ifndef B115200 # define B115200 -1 #endif -CND(B115200, "115200 bps") +CNU(B115200, "115200 bps") #ifndef B230400 # define B230400 -1 #endif -CND(B230400, "230400 bps") +CNU(B230400, "230400 bps") #ifndef B460800 # define B460800 -1 #endif -CND(B460800, "460800 bps") +CNU(B460800, "460800 bps") #ifndef B500000 # define B500000 -1 #endif -CND(B500000, "500000 bps") +CNU(B500000, "500000 bps") #ifndef B576000 # define B576000 -1 #endif -CND(B576000, "576000 bps") +CNU(B576000, "576000 bps") #ifndef B921600 # define B921600 -1 #endif -CND(B921600, "921600 bps") +CNU(B921600, "921600 bps") #ifndef B1000000 # define B1000000 -1 #endif -CND(B1000000, "1000000 bps") +CNU(B1000000, "1000000 bps") #ifndef B1152000 # define B1152000 -1 #endif -CND(B1152000, "1152000 bps") +CNU(B1152000, "1152000 bps") #ifndef B1500000 # define B1500000 -1 #endif -CND(B1500000, "1500000 bps") +CNU(B1500000, "1500000 bps") #ifndef B2000000 # define B2000000 -1 #endif -CND(B2000000, "2000000 bps") +CNU(B2000000, "2000000 bps") #ifndef B2500000 # define B2500000 -1 #endif -CND(B2500000, "2500000 bps") +CNU(B2500000, "2500000 bps") #ifndef B3000000 # define B3000000 -1 #endif -CND(B3000000, "3000000 bps") +CNU(B3000000, "3000000 bps") #ifndef B3500000 # define B3500000 -1 #endif -CND(B3500000, "3500000 bps") +CNU(B3500000, "3500000 bps") #ifndef B4000000 # define B4000000 -1 #endif -CND(B4000000, "4000000 bps") +CNU(B4000000, "4000000 bps") /* diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 557d61624b7..d1cdeeabf5f 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4343,9 +4343,8 @@ package body Sem_Ch4 is -- Emit appropriate message. Gigi will replace the -- node subsequently with the appropriate Raise. - -- In Alfa mode, this is an made into an error to - -- simplify the treatment of the formal verification - -- backend. + -- In Alfa mode, this is made into an error to simplify + -- the processing of the formal verification backend. if Alfa_Mode then Apply_Compile_Time_Constraint_Error diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 56ea8a877d9..73e33220081 100644 --- a/gcc/ada/xoscons.adb +++ b/gcc/ada/xoscons.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2008-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2008-2012, 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- -- @@ -73,13 +73,18 @@ procedure XOSCons is type Asm_Info_Kind is (CND, -- Named number (decimal) + CNU, -- Named number (decimal, unsigned) CNS, -- Named number (freeform text) C, -- Constant object TXT); -- Literal text -- Recognized markers found in assembly file. These markers are produced by -- the same-named macros from the C template. + subtype Asm_Int_Kind is Asm_Info_Kind range CND .. CNU; + -- Asm_Info_Kind values with int values in input + subtype Named_Number is Asm_Info_Kind range CND .. CNS; + -- Asm_Info_Kind values with named numbers in output type Asm_Info (Kind : Asm_Info_Kind := TXT) is record Line_Number : Integer; @@ -98,7 +103,7 @@ procedure XOSCons is -- Value for CNS / C constant Int_Value : Int_Value_Type; - -- Value for CND constant + -- Value for CND / CNU constant Comment : String_Access; -- Additional descriptive comment for constant, or free-form text (TXT) @@ -116,6 +121,9 @@ procedure XOSCons is Max_Constant_Type_Len : Natural := 0; -- Lengths of longest name and longest value + Size_Of_Unsigned_Int : Integer := 0; + -- Size of unsigned int on target + type Language is (Lang_Ada, Lang_C); procedure Output_Info @@ -195,11 +203,12 @@ procedure XOSCons is - Info.Constant_Name'Length)); end case; - if Info.Kind = CND then + if Info.Kind in Asm_Int_Kind then if not Info.Int_Value.Positive then Put ("-"); end if; Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left)); + else declare Is_String : constant Boolean := @@ -246,7 +255,7 @@ procedure XOSCons is procedure Find_Colon (Index : in out Integer); -- Increment Index until the next colon in Line - function Parse_Int (S : String) return Int_Value_Type; + function Parse_Int (S : String; K : Asm_Int_Kind) return Int_Value_Type; -- Parse a decimal number, preceded by an optional '$' or '#' character, -- and return its value. @@ -275,9 +284,12 @@ procedure XOSCons is -- Parse_Int -- --------------- - function Parse_Int (S : String) return Int_Value_Type is + function Parse_Int + (S : String; + K : Asm_Int_Kind) return Int_Value_Type + is First : Integer := S'First; - Positive : Boolean; + Result : Int_Value_Type; begin -- On some platforms, immediate integer values are prefixed with -- a $ or # character in assembly output. @@ -287,14 +299,25 @@ procedure XOSCons is end if; if S (First) = '-' then - Positive := False; + Result.Positive := False; First := First + 1; else - Positive := True; + Result.Positive := True; end if; - return (Positive => Positive, - Abs_Value => Long_Unsigned'Value (S (First .. S'Last))); + Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last)); + + if not Result.Positive and then K = CNU then + -- Negative value, but unsigned expected: take 2's complement + -- reciprocical value. + + Result.Abs_Value := ((not Result.Abs_Value) + 1) + and + (Shift_Left (1, Size_Of_Unsigned_Int) - 1); + Result.Positive := True; + end if; + + return Result; exception when E : others => @@ -315,10 +338,10 @@ procedure XOSCons is Find_Colon (Index2); Info.Line_Number := - Integer (Parse_Int (Line (Index1 .. Index2 - 1)).Abs_Value); + Integer (Parse_Int (Line (Index1 .. Index2 - 1), CNU).Abs_Value); case Info.Kind is - when CND | CNS | C => + when CND | CNU | CNS | C => Index1 := Index2 + 1; Find_Colon (Index2); @@ -340,15 +363,24 @@ procedure XOSCons is Find_Colon (Index2); end if; - if Info.Kind = CND then - Info.Int_Value := Parse_Int (Line (Index1 .. Index2 - 1)); - Info.Value_Len := Index2 - Index1 - 1; + if Info.Kind = CND or else Info.Kind = CNU then + Info.Int_Value := + Parse_Int (Line (Index1 .. Index2 - 1), Info.Kind); + Info.Value_Len := Info.Int_Value.Abs_Value'Img'Length - 1; + if not Info.Int_Value.Positive then + Info.Value_Len := Info.Value_Len + 1; + end if; else Info.Text_Value := Field_Alloc; Info.Value_Len := Info.Text_Value'Length; end if; + if Info.Constant_Name.all = "sizeof_unsigned_int" then + Size_Of_Unsigned_Int := + 8 * Integer (Info.Int_Value.Abs_Value); + end if; + when others => null; end case;