From 42c3898c1d9a5351eaac6ffd792a5d1aaa268435 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Tue, 8 Apr 2008 08:42:41 +0200 Subject: [PATCH] g-sercom.ads, [...] (Data_Rate): Add B115200. 2008-04-08 Pascal Obry * g-sercom.ads, g-sercom.adb (Data_Rate): Add B115200. (Stop_Bits_Number): New type. (Parity_Check): Likewise. (Set): Add parameter to set the number of stop bits and the parity. Parameter timeout is now a duration instead of a plain integer. * g-sercom-linux.adb: Implement the stop bits and parity support for GNU/Linux. Fix handling of timeout, it must be given in tenth of seconds. * g-sercom-mingw.adb: Implement the stop bits and parity support for Windows. Use new s-win32.ads unit instead of declaring Win32 services directly into this body. Update handling of timeout as now a duration. * s-win32.ads, s-winext.ads: New files. From-SVN: r134003 --- gcc/ada/g-sercom-linux.adb | 48 +++--- gcc/ada/g-sercom-mingw.adb | 235 ++++++----------------------- gcc/ada/g-sercom.adb | 17 ++- gcc/ada/g-sercom.ads | 44 +++--- gcc/ada/s-win32.ads | 295 +++++++++++++++++++++++++++++++++++++ gcc/ada/s-winext.ads | 157 ++++++++++++++++++++ 6 files changed, 563 insertions(+), 233 deletions(-) create mode 100644 gcc/ada/s-win32.ads create mode 100644 gcc/ada/s-winext.ads diff --git a/gcc/ada/g-sercom-linux.adb b/gcc/ada/g-sercom-linux.adb index bcb5952f529..cf8f805eb74 100644 --- a/gcc/ada/g-sercom-linux.adb +++ b/gcc/ada/g-sercom-linux.adb @@ -43,6 +43,8 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package body GNAT.Serial_Communications is + use type Interfaces.C.unsigned; + type Port_Data is new int; subtype unsigned is Interfaces.C.unsigned; @@ -63,6 +65,8 @@ package body GNAT.Serial_Communications is CREAD : constant := 8#0200#; CSTOPB : constant := 8#0100#; CRTSCTS : constant := 8#020000000000#; + PARENB : constant := 8#00400#; + PARODD : constant := 8#01000#; -- c_cc indexes @@ -70,16 +74,23 @@ package body GNAT.Serial_Communications is 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#); + (B1200 => 8#000011#, + B2400 => 8#000013#, + B4800 => 8#000014#, + B9600 => 8#000015#, + B19200 => 8#000016#, + B38400 => 8#000017#, + B57600 => 8#010001#, + B115200 => 8#010002#); + + C_Bits : constant array (Data_Bits) of unsigned := + (B7 => 8#040#, B8 => 8#060#); - C_Bits : constant array (Data_Bits) of unsigned := - (B7 => 8#040#, B8 => 8#060#); + C_Stop_Bits : constant array (Stop_Bits_Number) of unsigned := + (One => 0, Two => CSTOPB); + + C_Parity : constant array (Parity_Check) of unsigned := + (None => 0, Odd => PARENB or PARODD, Even => PARENB); procedure Raise_Error (Message : String; Error : Integer := Errno); pragma No_Return (Raise_Error); @@ -168,14 +179,14 @@ package body GNAT.Serial_Communications is --------- procedure Set - (Port : Serial_Port; - Rate : Data_Rate := B9600; - Bits : Data_Bits := B8; - Block : Boolean := True; - Timeout : Integer := 10) + (Port : Serial_Port; + Rate : Data_Rate := B9600; + Bits : Data_Bits := B8; + Stop_Bits : Stop_Bits_Number := One; + Parity : Parity_Check := None; + Block : Boolean := True; + Timeout : Duration := 10.0) is - use type unsigned; - type termios is record c_iflag : unsigned; c_oflag : unsigned; @@ -214,9 +225,10 @@ package body GNAT.Serial_Communications is Current.c_cflag := C_Data_Rate (Rate) or C_Bits (Bits) + or C_Stop_Bits (Stop_Bits) + or C_Parity (Parity) or CLOCAL or CREAD - or CSTOPB or CRTSCTS; Current.c_lflag := 0; Current.c_iflag := 0; @@ -224,7 +236,7 @@ package body GNAT.Serial_Communications is Current.c_ispeed := Data_Rate_Value (Rate); Current.c_ospeed := Data_Rate_Value (Rate); Current.c_cc (VMIN) := char'Val (0); - Current.c_cc (VTIME) := char'Val (Timeout); + Current.c_cc (VTIME) := char'Val (Natural (Timeout * 10)); -- Set port settings diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb index 5cb6e455cfc..76f0aa08954 100644 --- a/gcc/ada/g-sercom-mingw.adb +++ b/gcc/ada/g-sercom-mingw.adb @@ -35,176 +35,24 @@ with Ada.Unchecked_Deallocation; use Ada; with Ada.Streams; use Ada.Streams; -with System; use System; +with System.Win32.Ext; use System, System.Win32, System.Win32.Ext; package body GNAT.Serial_Communications is -- Common types - type HANDLE is new Interfaces.C.long; - type DWORD is new Interfaces.C.unsigned_long; - type WORD is new Interfaces.C.unsigned_short; - subtype PVOID is System.Address; - type BOOL is new Boolean; - for BOOL'Size use Interfaces.C.unsigned_long'Size; - type BYTE is new Interfaces.C.unsigned_char; - subtype CHAR is Interfaces.C.char; - type Port_Data is new HANDLE; - type Bits1 is range 0 .. 2 ** 1 - 1; - type Bits2 is range 0 .. 2 ** 2 - 1; - type Bits17 is range 0 .. 2 ** 17 - 1; - for Bits1'Size use 1; - for Bits2'Size use 2; - for Bits17'Size use 17; + C_Bits : constant array (Data_Bits) of Interfaces.C.unsigned := (8, 7); + C_Parity : constant array (Parity_Check) of Interfaces.C.unsigned := + (None => NOPARITY, Odd => ODDPARITY, Even => EVENPARITY); + C_Stop_Bits : constant array (Stop_Bits_Number) of Interfaces.C.unsigned := + (One => ONESTOPBIT, Two => TWOSTOPBITS); ----------- -- Files -- ----------- - function GetLastError return DWORD; - pragma Import (Stdcall, GetLastError, "GetLastError"); - - GENERIC_READ : constant := 16#80000000#; - GENERIC_WRITE : constant := 16#40000000#; - OPEN_EXISTING : constant := 3; - - type OVERLAPPED is record - Internal : DWORD; - InternalHigh : DWORD; - Offset : DWORD; - OffsetHigh : DWORD; - hEvent : HANDLE; - end record; - - type SECURITY_ATTRIBUTES is record - nLength : DWORD; - pSecurityDescriptor : PVOID; - bInheritHandle : BOOL; - end record; - - function CreateFile - (lpFileName : Address; - dwDesiredAccess : DWORD; - dwShareMode : DWORD; - lpSecurityAttributes : access SECURITY_ATTRIBUTES; - dwCreationDisposition : DWORD; - dwFlagsAndAttributes : DWORD; - hTemplateFile : HANDLE) return HANDLE; - pragma Import (Stdcall, CreateFile, "CreateFileA"); - - function WriteFile - (hFile : HANDLE; - lpBuffer : Address; - nNumberOfBytesToWrite : DWORD; - lpNumberOfBytesWritten : access DWORD; - lpOverlapped : access OVERLAPPED) return BOOL; - pragma Import (Stdcall, WriteFile, "WriteFile"); - - function ReadFile - (hFile : HANDLE; - lpBuffer : Address; - nNumberOfBytesToRead : DWORD; - lpNumberOfBytesRead : access DWORD; - lpOverlapped : access OVERLAPPED) return BOOL; - pragma Import (Stdcall, ReadFile, "ReadFile"); - - function CloseHandle (hObject : HANDLE) return BOOL; - pragma Import (Stdcall, CloseHandle, "CloseHandle"); - - DTR_CONTROL_DISABLE : constant := 16#0#; - RTS_CONTROL_DISABLE : constant := 16#0#; - ODDPARITY : constant := 1; - ONESTOPBIT : constant := 0; - - type DCB is record - DCBLENGTH : DWORD; - BaudRate : DWORD; - fBinary : Bits1; - fParity : Bits1; - fOutxCtsFlow : Bits1; - fOutxDsrFlow : Bits1; - fDtrControl : Bits2; - fDsrSensitivity : Bits1; - fTXContinueOnXoff : Bits1; - fOutX : Bits1; - fInX : Bits1; - fErrorChar : Bits1; - fNull : Bits1; - fRtsControl : Bits2; - fAbortOnError : Bits1; - fDummy2 : Bits17; - wReserved : WORD; - XonLim : WORD; - XoffLim : WORD; - ByteSize : BYTE; - Parity : BYTE; - StopBits : BYTE; - XonChar : CHAR; - XoffChar : CHAR; - ErrorChar : CHAR; - EofChar : CHAR; - EvtChar : CHAR; - wReserved1 : WORD; - end record; - pragma Convention (C, DCB); - - for DCB use record - DCBLENGTH at 0 range 0 .. 31; - BaudRate at 4 range 0 .. 31; - fBinary at 8 range 0 .. 0; - fParity at 8 range 1 .. 1; - fOutxCtsFlow at 8 range 2 .. 2; - fOutxDsrFlow at 8 range 3 .. 3; - fDtrControl at 8 range 4 .. 5; - fDsrSensitivity at 8 range 6 .. 6; - fTXContinueOnXoff at 8 range 7 .. 7; - fOutX at 9 range 0 .. 0; - fInX at 9 range 1 .. 1; - fErrorChar at 9 range 2 .. 2; - fNull at 9 range 3 .. 3; - fRtsControl at 9 range 4 .. 5; - fAbortOnError at 9 range 6 .. 6; - fDummy2 at 9 range 7 .. 23; - wReserved at 12 range 0 .. 15; - XonLim at 14 range 0 .. 15; - XoffLim at 16 range 0 .. 15; - ByteSize at 18 range 0 .. 7; - Parity at 19 range 0 .. 7; - StopBits at 20 range 0 .. 7; - XonChar at 21 range 0 .. 7; - XoffChar at 22 range 0 .. 7; - ErrorChar at 23 range 0 .. 7; - EofChar at 24 range 0 .. 7; - EvtChar at 25 range 0 .. 7; - wReserved1 at 26 range 0 .. 15; - end record; - - type COMMTIMEOUTS is record - ReadIntervalTimeout : DWORD; - ReadTotalTimeoutMultiplier : DWORD; - ReadTotalTimeoutConstant : DWORD; - WriteTotalTimeoutMultiplier : DWORD; - WriteTotalTimeoutConstant : DWORD; - end record; - pragma Convention (C, COMMTIMEOUTS); - - function GetCommState - (hFile : HANDLE; - lpDCB : access DCB) return BOOL; - pragma Import (Stdcall, GetCommState, "GetCommState"); - - function SetCommState - (hFile : HANDLE; - lpDCB : access DCB) return BOOL; - pragma Import (Stdcall, SetCommState, "SetCommState"); - - function SetCommTimeouts - (hFile : HANDLE; - lpCommTimeouts : access COMMTIMEOUTS) return BOOL; - pragma Import (Stdcall, SetCommTimeouts, "SetCommTimeouts"); - procedure Raise_Error (Message : String; Error : DWORD := GetLastError); pragma No_Return (Raise_Error); @@ -222,7 +70,8 @@ package body GNAT.Serial_Communications is if Port.H /= null then Success := CloseHandle (HANDLE (Port.H.all)); Unchecked_Free (Port.H); - if not Success then + + if Success = Win32.FALSE then Raise_Error ("error closing the port"); end if; end if; @@ -257,14 +106,14 @@ package body GNAT.Serial_Communications is Success := CloseHandle (HANDLE (Port.H.all)); end if; - Port.H.all := Port_Data (CreateFile + Port.H.all := CreateFile (lpFileName => C_Name (C_Name'First)'Address, dwDesiredAccess => GENERIC_READ or GENERIC_WRITE, dwShareMode => 0, lpSecurityAttributes => null, - DwCreationDisposition => OPEN_EXISTING, + dwCreationDisposition => OPEN_EXISTING, dwFlagsAndAttributes => 0, - HTemplateFile => 0)); + hTemplateFile => 0); if Port.H.all = 0 then Raise_Error ("cannot open com port"); @@ -297,14 +146,15 @@ package body GNAT.Serial_Communications is Raise_Error ("read: port not opened", 0); end if; - Success := ReadFile - (hFile => HANDLE (Port.H.all), - lpBuffer => Buffer (Buffer'First)'Address, - nNumberOfBytesToRead => DWORD (Buffer'Length), - lpNumberOfBytesRead => Read_Last'Access, - lpOverlapped => null); + Success := + ReadFile + (hFile => HANDLE (Port.H.all), + lpBuffer => Buffer (Buffer'First)'Address, + nNumberOfBytesToRead => DWORD (Buffer'Length), + lpNumberOfBytesRead => Read_Last'Access, + lpOverlapped => null); - if not Success then + if Success = Win32.FALSE then Raise_Error ("read error"); end if; @@ -316,11 +166,13 @@ package body GNAT.Serial_Communications is --------- procedure Set - (Port : Serial_Port; - Rate : Data_Rate := B9600; - Bits : Data_Bits := B8; - Block : Boolean := True; - Timeout : Integer := 10) + (Port : Serial_Port; + Rate : Data_Rate := B9600; + Bits : Data_Bits := B8; + Stop_Bits : Stop_Bits_Number := One; + Parity : Parity_Check := None; + Block : Boolean := True; + Timeout : Duration := 10.0) is Success : BOOL; Com_Time_Out : aliased COMMTIMEOUTS; @@ -333,7 +185,7 @@ package body GNAT.Serial_Communications is Success := GetCommState (HANDLE (Port.H.all), Com_Settings'Access); - if not Success then + if Success = Win32.FALSE then Success := CloseHandle (HANDLE (Port.H.all)); Port.H.all := 0; Raise_Error ("set: cannot get comm state"); @@ -341,6 +193,7 @@ 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; @@ -349,13 +202,13 @@ package body GNAT.Serial_Communications is Com_Settings.fInX := 0; Com_Settings.fRtsControl := RTS_CONTROL_DISABLE; Com_Settings.fAbortOnError := 0; - Com_Settings.ByteSize := BYTE (Bit_Value (Bits)); - Com_Settings.Parity := ODDPARITY; - Com_Settings.StopBits := ONESTOPBIT; + Com_Settings.ByteSize := BYTE (C_Bits (Bits)); + Com_Settings.Parity := BYTE (C_Parity (Parity)); + Com_Settings.StopBits := BYTE (C_Stop_Bits (Stop_Bits)); Success := SetCommState (HANDLE (Port.H.all), Com_Settings'Access); - if not Success then + if Success = Win32.FALSE then Success := CloseHandle (HANDLE (Port.H.all)); Port.H.all := 0; Raise_Error ("cannot set comm state"); @@ -371,11 +224,12 @@ package body GNAT.Serial_Communications is others => 0); end if; - Success := SetCommTimeouts - (hFile => HANDLE (Port.H.all), - lpCommTimeouts => Com_Time_Out'Access); + Success := + SetCommTimeouts + (hFile => HANDLE (Port.H.all), + lpCommTimeouts => Com_Time_Out'Access); - if not Success then + if Success = Win32.FALSE then Raise_Error ("cannot set the timeout"); end if; end Set; @@ -396,14 +250,15 @@ package body GNAT.Serial_Communications is Raise_Error ("write: port not opened", 0); end if; - Success := WriteFile - (hFile => HANDLE (Port.H.all), - lpBuffer => Buffer'Address, - nNumberOfBytesToWrite => DWORD (Buffer'Length), - lpNumberOfBytesWritten => Temp_Last'Access, - lpOverlapped => null); + Success := + WriteFile + (hFile => HANDLE (Port.H.all), + lpBuffer => Buffer'Address, + nNumberOfBytesToWrite => DWORD (Buffer'Length), + lpNumberOfBytesWritten => Temp_Last'Access, + lpOverlapped => null); - if not Boolean (Success) + if Success = Win32.FALSE or else Stream_Element_Offset (Temp_Last) /= Buffer'Length then Raise_Error ("failed to write data"); diff --git a/gcc/ada/g-sercom.adb b/gcc/ada/g-sercom.adb index 920557b2643..ead5c868c6e 100644 --- a/gcc/ada/g-sercom.adb +++ b/gcc/ada/g-sercom.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2007, AdaCore -- +-- Copyright (C) 2007-2008, 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- -- @@ -77,11 +77,13 @@ package body GNAT.Serial_Communications is --------- procedure Set - (Port : Serial_Port; - Rate : Data_Rate := B9600; - Bits : Data_Bits := B8; - Block : Boolean := True; - Timeout : Integer := 10) is + (Port : Serial_Port; + Rate : Data_Rate := B9600; + Bits : Data_Bits := B8; + Stop_Bits : Stop_Bits_Number := One; + Parity : Parity_Check := None; + Block : Boolean := True; + Timeout : Duration := 10.0) is begin Unimplemented; end Set; @@ -124,8 +126,7 @@ package body GNAT.Serial_Communications is procedure Unimplemented is begin - raise Program_Error - with "Serial_Communications not implemented"; + raise Program_Error with "Serial_Communications not implemented"; end Unimplemented; end GNAT.Serial_Communications; diff --git a/gcc/ada/g-sercom.ads b/gcc/ada/g-sercom.ads index bbd8f91e331..3d327cec76f 100644 --- a/gcc/ada/g-sercom.ads +++ b/gcc/ada/g-sercom.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2007, AdaCore -- +-- Copyright (C) 2007-2008, 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- -- @@ -47,12 +47,19 @@ package GNAT.Serial_Communications is function Name (Number : Positive) return Port_Name; -- Returns the port name for the given port number - type Data_Rate is (B1200, B2400, B4800, B9600, B19200, B38400, B57600); + type Data_Rate is + (B1200, B2400, B4800, B9600, B19200, B38400, B57600, B115200); -- Speed of the communication type Data_Bits is (B8, B7); -- Communication bits + type Stop_Bits_Number is (One, Two); + -- One or two stop bits + + type Parity_Check is (None, Even, Odd); + -- Either no parity check or an even or odd parity + type Serial_Port is new Ada.Streams.Root_Stream_Type with private; procedure Open @@ -62,14 +69,18 @@ package GNAT.Serial_Communications is -- opened. procedure Set - (Port : Serial_Port; - Rate : Data_Rate := B9600; - Bits : Data_Bits := B8; - Block : Boolean := True; - Timeout : Integer := 10); + (Port : Serial_Port; + Rate : Data_Rate := B9600; + Bits : Data_Bits := B8; + Stop_Bits : Stop_Bits_Number := One; + Parity : Parity_Check := None; + Block : Boolean := True; + 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. + -- 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). overriding procedure Read (Port : in out Serial_Port; @@ -96,14 +107,13 @@ private end record; Data_Rate_Value : constant array (Data_Rate) of Interfaces.C.unsigned := - (B1200 => 1_200, - B2400 => 2_400, - B4800 => 4_800, - B9600 => 9_600, - B19200 => 19_200, - B38400 => 38_400, - B57600 => 57_600); - - Bit_Value : constant array (Data_Bits) of Interfaces.C.unsigned := (8, 7); + (B1200 => 1_200, + B2400 => 2_400, + B4800 => 4_800, + B9600 => 9_600, + B19200 => 19_200, + B38400 => 38_400, + B57600 => 57_600, + B115200 => 115_200); end GNAT.Serial_Communications; diff --git a/gcc/ada/s-win32.ads b/gcc/ada/s-win32.ads new file mode 100644 index 00000000000..2d2648514b8 --- /dev/null +++ b/gcc/ada/s-win32.ads @@ -0,0 +1,295 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . W I N 3 2 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, 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, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package plus its child provide the low level interface to the Win32 +-- API. The core part of the Win32 API (commont to RTX and Win32) is in this +-- package, and an additional part of the Win32 API which is not supported by +-- RTX is in package System.Win33.Ext. + +with Interfaces.C; + +package System.Win32 is + pragma Pure; + + ------------------- + -- General Types -- + ------------------- + + -- The LARGE_INTEGER type is actually a fixed point type + -- that only can represent integers. The reason for this is + -- easier conversion to Duration or other fixed point types. + -- (See Operations.Clock) + + type LARGE_INTEGER is delta 1.0 range -2.0**63 .. 2.0**63 - 1.0; + + subtype PVOID is Address; + + type HANDLE is new Interfaces.C.long; + + INVALID_HANDLE_VALUE : constant HANDLE := -1; + + type DWORD is new Interfaces.C.unsigned_long; + type WORD is new Interfaces.C.unsigned_short; + type BYTE is new Interfaces.C.unsigned_char; + type LONG is new Interfaces.C.long; + type CHAR is new Interfaces.C.char; + + type BOOL is new Interfaces.C.int; + for BOOL'Size use Interfaces.C.int'Size; + + type Bits1 is range 0 .. 2 ** 1 - 1; + type Bits2 is range 0 .. 2 ** 2 - 1; + type Bits17 is range 0 .. 2 ** 17 - 1; + for Bits1'Size use 1; + for Bits2'Size use 2; + for Bits17'Size use 17; + + FALSE : constant := 0; + TRUE : constant := 1; + + function GetLastError return DWORD; + pragma Import (Stdcall, GetLastError, "GetLastError"); + + ----------- + -- Files -- + ----------- + + GENERIC_READ : constant := 16#80000000#; + GENERIC_WRITE : constant := 16#40000000#; + + CREATE_NEW : constant := 1; + CREATE_ALWAYS : constant := 2; + OPEN_EXISTING : constant := 3; + OPEN_ALWAYS : constant := 4; + TRUNCATE_EXISTING : constant := 5; + + FILE_SHARE_DELETE : constant := 16#00000004#; + FILE_SHARE_READ : constant := 16#00000001#; + FILE_SHARE_WRITE : constant := 16#00000002#; + + FILE_BEGIN : constant := 0; + FILE_CURRENT : constant := 1; + FILE_END : constant := 2; + + PAGE_NOACCESS : constant := 16#0001#; + PAGE_READONLY : constant := 16#0002#; + PAGE_READWRITE : constant := 16#0004#; + PAGE_WRITECOPY : constant := 16#0008#; + PAGE_EXECUTE : constant := 16#0010#; + + FILE_MAP_ALL_ACCESS : constant := 16#F001f#; + FILE_MAP_READ : constant := 4; + FILE_MAP_WRITE : constant := 2; + FILE_MAP_COPY : constant := 1; + + FILE_ADD_FILE : constant := 16#0002#; + FILE_ADD_SUBDIRECTORY : constant := 16#0004#; + FILE_APPEND_DATA : constant := 16#0004#; + FILE_CREATE_PIPE_INSTANCE : constant := 16#0004#; + FILE_DELETE_CHILD : constant := 16#0040#; + FILE_EXECUTE : constant := 16#0020#; + FILE_LIST_DIRECTORY : constant := 16#0001#; + FILE_READ_ATTRIBUTES : constant := 16#0080#; + FILE_READ_DATA : constant := 16#0001#; + FILE_READ_EA : constant := 16#0008#; + FILE_TRAVERSE : constant := 16#0020#; + FILE_WRITE_ATTRIBUTES : constant := 16#0100#; + FILE_WRITE_DATA : constant := 16#0002#; + FILE_WRITE_EA : constant := 16#0010#; + STANDARD_RIGHTS_READ : constant := 16#20000#; + STANDARD_RIGHTS_WRITE : constant := 16#20000#; + SYNCHRONIZE : constant := 16#100000#; + + FILE_ATTRIBUTE_READONLY : constant := 16#00000001#; + FILE_ATTRIBUTE_HIDDEN : constant := 16#00000002#; + FILE_ATTRIBUTE_SYSTEM : constant := 16#00000004#; + FILE_ATTRIBUTE_DIRECTORY : constant := 16#00000010#; + FILE_ATTRIBUTE_ARCHIVE : constant := 16#00000020#; + FILE_ATTRIBUTE_DEVICE : constant := 16#00000040#; + FILE_ATTRIBUTE_NORMAL : constant := 16#00000080#; + FILE_ATTRIBUTE_TEMPORARY : constant := 16#00000100#; + FILE_ATTRIBUTE_SPARSE_FILE : constant := 16#00000200#; + FILE_ATTRIBUTE_REPARSE_POINT : constant := 16#00000400#; + FILE_ATTRIBUTE_COMPRESSED : constant := 16#00000800#; + FILE_ATTRIBUTE_OFFLINE : constant := 16#00001000#; + FILE_ATTRIBUTE_NOT_CONTENT_INDEXED : constant := 16#00002000#; + FILE_ATTRIBUTE_ENCRYPTED : constant := 16#00004000#; + FILE_ATTRIBUTE_VALID_FLAGS : constant := 16#00007fb7#; + FILE_ATTRIBUTE_VALID_SET_FLAGS : constant := 16#000031a7#; + + type OVERLAPPED is record + Internal : DWORD; + InternalHigh : DWORD; + Offset : DWORD; + OffsetHigh : DWORD; + hEvent : HANDLE; + end record; + + type SECURITY_ATTRIBUTES is record + nLength : DWORD; + pSecurityDescriptor : PVOID; + bInheritHandle : BOOL; + end record; + + function CreateFile + (lpFileName : Address; + dwDesiredAccess : DWORD; + dwShareMode : DWORD; + lpSecurityAttributes : access SECURITY_ATTRIBUTES; + dwCreationDisposition : DWORD; + dwFlagsAndAttributes : DWORD; + hTemplateFile : HANDLE) return HANDLE; + pragma Import (Stdcall, CreateFile, "CreateFileA"); + + function GetFileSize + (hFile : HANDLE; + lpFileSizeHigh : access DWORD) return BOOL; + pragma Import (Stdcall, GetFileSize, "GetFileSize"); + + function SetFilePointer + (hFile : HANDLE; + lDistanceToMove : LONG; + lpDistanceToMoveHigh : access LONG; + dwMoveMethod : DWORD) return DWORD; + pragma Import (Stdcall, SetFilePointer, "SetFilePointer"); + + function WriteFile + (hFile : HANDLE; + lpBuffer : Address; + nNumberOfBytesToWrite : DWORD; + lpNumberOfBytesWritten : access DWORD; + lpOverlapped : access OVERLAPPED) return BOOL; + pragma Import (Stdcall, WriteFile, "WriteFile"); + + function ReadFile + (hFile : HANDLE; + lpBuffer : Address; + nNumberOfBytesToRead : DWORD; + lpNumberOfBytesRead : access DWORD; + lpOverlapped : access OVERLAPPED) return BOOL; + pragma Import (Stdcall, ReadFile, "ReadFile"); + + function CloseHandle (hObject : HANDLE) return BOOL; + pragma Import (Stdcall, CloseHandle, "CloseHandle"); + + function CreateFileMapping + (hFile : HANDLE; + lpSecurityAttributes : access SECURITY_ATTRIBUTES; + flProtect : DWORD; + dwMaximumSizeHigh : DWORD; + dwMaximumSizeLow : DWORD; + lpName : Address) return HANDLE; + pragma Import (Stdcall, CreateFileMapping, "CreateFileMappingA"); + + function MapViewOfFile + (hFileMappingObject : HANDLE; + dwDesiredAccess : DWORD; + dwFileOffsetHigh : DWORD; + dwFileOffsetLow : DWORD; + dwNumberOfBytesToMap : DWORD) return System.Address; + pragma Import (Stdcall, MapViewOfFile, "MapViewOfFile"); + + function UnmapViewOfFile (lpBaseAddress : System.Address) return BOOL; + pragma Import (Stdcall, UnmapViewOfFile, "UnmapViewOfFile"); + + ------------------------ + -- System Information -- + ------------------------ + + subtype ProcessorId is DWORD; + + type SYSTEM_INFO is record + dwOemId : DWORD; + dwPageSize : DWORD; + lpMinimumApplicationAddress : PVOID; + lpMaximumApplicationAddress : PVOID; + dwActiveProcessorMask : DWORD; + dwNumberOfProcessors : DWORD; + dwProcessorType : DWORD; + dwAllocationGranularity : DWORD; + dwReserved : DWORD; + end record; + + procedure GetSystemInfo (SI : access SYSTEM_INFO); + pragma Import (Stdcall, GetSystemInfo, "GetSystemInfo"); + + --------------------- + -- Time Management -- + --------------------- + + type SYSTEMTIME is record + wYear : WORD; + wMonth : WORD; + wDayOfWeek : WORD; + wDay : WORD; + wHour : WORD; + wMinute : WORD; + wSecond : WORD; + wMilliseconds : WORD; + end record; + + procedure GetSystemTime (pSystemTime : access SYSTEMTIME); + pragma Import (Stdcall, GetSystemTime, "GetSystemTime"); + + procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer); + pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime"); + + function FileTimeToSystemTime + (lpFileTime : access Long_Long_Integer; + lpSystemTime : access SYSTEMTIME) return BOOL; + pragma Import (Stdcall, FileTimeToSystemTime, "FileTimeToSystemTime"); + + function SystemTimeToFileTime + (lpSystemTime : access SYSTEMTIME; + lpFileTime : access Long_Long_Integer) return BOOL; + pragma Import (Stdcall, SystemTimeToFileTime, "SystemTimeToFileTime"); + + function FileTimeToLocalFileTime + (lpFileTime : access Long_Long_Integer; + lpLocalFileTime : access Long_Long_Integer) return BOOL; + pragma Import (Stdcall, FileTimeToLocalFileTime, "FileTimeToLocalFileTime"); + + function LocalFileTimeToFileTime + (lpFileTime : access Long_Long_Integer; + lpLocalFileTime : access Long_Long_Integer) return BOOL; + pragma Import (Stdcall, LocalFileTimeToFileTime, "LocalFileTimeToFileTime"); + + procedure Sleep (dwMilliseconds : DWORD); + pragma Import (Stdcall, Sleep, External_Name => "Sleep"); + + function QueryPerformanceCounter + (lpPerformanceCount : access LARGE_INTEGER) return BOOL; + pragma Import + (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter"); + +end System.Win32; diff --git a/gcc/ada/s-winext.ads b/gcc/ada/s-winext.ads new file mode 100644 index 00000000000..a0091ff74d3 --- /dev/null +++ b/gcc/ada/s-winext.ads @@ -0,0 +1,157 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . W I N 3 2 . E X T -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2008, 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, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides the part of the low level Win32 interface which is +-- not supported by RTX (but supported by regular Windows platforms). + +package System.Win32.Ext is + pragma Pure; + + --------------------- + -- Time Management -- + --------------------- + + function QueryPerformanceFrequency + (lpFrequency : access LARGE_INTEGER) return Win32.BOOL; + pragma Import + (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency"); + + --------------- + -- Processor -- + --------------- + + function SetThreadIdealProcessor + (hThread : HANDLE; + dwIdealProcessor : ProcessorId) return DWORD; + pragma Import (Stdcall, SetThreadIdealProcessor, "SetThreadIdealProcessor"); + + -------------- + -- Com Port -- + -------------- + + DTR_CONTROL_DISABLE : constant := 16#0#; + RTS_CONTROL_DISABLE : constant := 16#0#; + NOPARITY : constant := 0; + ODDPARITY : constant := 1; + EVENPARITY : constant := 2; + ONESTOPBIT : constant := 0; + TWOSTOPBITS : constant := 2; + + type DCB is record + DCBLENGTH : DWORD; + BaudRate : DWORD; + fBinary : Bits1; + fParity : Bits1; + fOutxCtsFlow : Bits1; + fOutxDsrFlow : Bits1; + fDtrControl : Bits2; + fDsrSensitivity : Bits1; + fTXContinueOnXoff : Bits1; + fOutX : Bits1; + fInX : Bits1; + fErrorChar : Bits1; + fNull : Bits1; + fRtsControl : Bits2; + fAbortOnError : Bits1; + fDummy2 : Bits17; + wReserved : WORD; + XonLim : WORD; + XoffLim : WORD; + ByteSize : BYTE; + Parity : BYTE; + StopBits : BYTE; + XonChar : CHAR; + XoffChar : CHAR; + ErrorChar : CHAR; + EofChar : CHAR; + EvtChar : CHAR; + wReserved1 : WORD; + end record; + pragma Convention (C, DCB); + + for DCB use record + DCBLENGTH at 0 range 0 .. 31; + BaudRate at 4 range 0 .. 31; + fBinary at 8 range 0 .. 0; + fParity at 8 range 1 .. 1; + fOutxCtsFlow at 8 range 2 .. 2; + fOutxDsrFlow at 8 range 3 .. 3; + fDtrControl at 8 range 4 .. 5; + fDsrSensitivity at 8 range 6 .. 6; + fTXContinueOnXoff at 8 range 7 .. 7; + fOutX at 9 range 0 .. 0; + fInX at 9 range 1 .. 1; + fErrorChar at 9 range 2 .. 2; + fNull at 9 range 3 .. 3; + fRtsControl at 9 range 4 .. 5; + fAbortOnError at 9 range 6 .. 6; + fDummy2 at 9 range 7 .. 23; + wReserved at 12 range 0 .. 15; + XonLim at 14 range 0 .. 15; + XoffLim at 16 range 0 .. 15; + ByteSize at 18 range 0 .. 7; + Parity at 19 range 0 .. 7; + StopBits at 20 range 0 .. 7; + XonChar at 21 range 0 .. 7; + XoffChar at 22 range 0 .. 7; + ErrorChar at 23 range 0 .. 7; + EofChar at 24 range 0 .. 7; + EvtChar at 25 range 0 .. 7; + wReserved1 at 26 range 0 .. 15; + end record; + + type COMMTIMEOUTS is record + ReadIntervalTimeout : DWORD; + ReadTotalTimeoutMultiplier : DWORD; + ReadTotalTimeoutConstant : DWORD; + WriteTotalTimeoutMultiplier : DWORD; + WriteTotalTimeoutConstant : DWORD; + end record; + pragma Convention (C, COMMTIMEOUTS); + + function GetCommState + (hFile : HANDLE; + lpDCB : access DCB) return BOOL; + pragma Import (Stdcall, GetCommState, "GetCommState"); + + function SetCommState + (hFile : HANDLE; + lpDCB : access DCB) return BOOL; + pragma Import (Stdcall, SetCommState, "SetCommState"); + + function SetCommTimeouts + (hFile : HANDLE; + lpCommTimeouts : access COMMTIMEOUTS) return BOOL; + pragma Import (Stdcall, SetCommTimeouts, "SetCommTimeouts"); + +end System.Win32.Ext; -- 2.30.2