package body GNAT.Serial_Communications is
+ use type Interfaces.C.unsigned;
+
type Port_Data is new int;
subtype unsigned is Interfaces.C.unsigned;
CREAD : constant := 8#0200#;
CSTOPB : constant := 8#0100#;
CRTSCTS : constant := 8#020000000000#;
+ PARENB : constant := 8#00400#;
+ PARODD : constant := 8#01000#;
-- c_cc indexes
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);
---------
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;
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;
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
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);
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;
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");
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;
---------
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;
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");
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.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");
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;
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");
-- --
-- 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- --
---------
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;
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;
-- --
-- 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- --
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
-- 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;
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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
projects / gcc.git / commitdiff