Commit 42c3898c by Pascal Obry Committed by Arnaud Charlet

g-sercom.ads, [...] (Data_Rate): Add B115200.

2008-04-08  Pascal Obry  <obry@adacore.com>

	* 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
parent e68c63e3
......@@ -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
......
......@@ -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;
......@@ -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;
------------------------------------------------------------------------------
-- --
-- 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment