[multiple changes]

2011-11-23  Robert Dewar  <dewar@adacore.com>

	* exp_util.adb, par-ch6.adb, sem_res.adb, par-util.adb: Minor
	reformatting.

2011-11-23  Yannick Moy  <moy@adacore.com>

	* sem_ch13.adb (Analyze_Aspect_Specifications): Place error on
	line of precondition/ postcondition/invariant.
2011-11-23  Pascal Obry  <obry@adacore.com>

	* g-exptty.ads, g-exptty.adb, g-tty.ads, g-tty.adb,
	terminals.c: New files.
	Makefile.rtl: Add these new files.
	* gnat_rm.texi: Add documentation for GNAT.Expect.TTY.
	* gcc-interface/Makefile.in: Add g-exptty, g-tty, terminals.o
	* gcc-interface/Make-lang.in: Update dependencies.

From-SVN: r181655

gcc/ada/ChangeLog

+2011-11-23  Robert Dewar  <dewar@adacore.com>
+
+	* exp_util.adb, par-ch6.adb, sem_res.adb, par-util.adb: Minor
+	reformatting.
+
+2011-11-23  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Place error on
+	line of precondition/ postcondition/invariant.
+2011-11-23  Pascal Obry  <obry@adacore.com>
+
+	* g-exptty.ads, g-exptty.adb, g-tty.ads, g-tty.adb,
+	terminals.c: New files.
+	Makefile.rtl: Add these new files.
+	* gnat_rm.texi: Add documentation for GNAT.Expect.TTY.
+	* gcc-interface/Makefile.in: Add g-exptty, g-tty, terminals.o
+	* gcc-interface/Make-lang.in: Update dependencies.
+
 2011-11-21  Robert Dewar  <dewar@adacore.com>
 
-	* exp_imgv.adb (Expand_Width_Attribute): Handle case of
-	Discard_Names.
+	* exp_imgv.adb (Expand_Width_Attribute): Handle case of Discard_Names.
 	* sem_attr.adb (Eval_Attribute, case Width): Ditto.
 
 2011-11-21  Thomas Quinot  <quinot@adacore.com>

gcc/ada/Makefile.rtl

@@ -404,6 +404,7 @@ GNATRTL_NONTASKING_OBJS= \
   g-except$(objext) \
   g-exctra$(objext) \
   g-expect$(objext) \
+  g-exptty$(objext) \
   g-flocon$(objext) \
   g-heasor$(objext) \
   g-hesora$(objext) \
@@ -450,6 +451,7 @@ GNATRTL_NONTASKING_OBJS= \
   g-timsta$(objext) \
   g-traceb$(objext) \
   g-trasym$(objext) \
+  g-tty$(objext) \
   g-u3spch$(objext) \
   g-utf_32$(objext) \
   g-wispch$(objext) \

gcc/ada/exp_util.adb

@@ -6425,13 +6425,12 @@ package body Exp_Util is
       --  a run-time issue, and the removal is required only to get proper
       --  behavior at run-time.
 
-      --  In the Alfa case, we don't need to remove side effects because we
-      --  only perform formal verification is performed only on expressions
-      --  that are provably side-effect free. If we tried to remove side
-      --  effects in the Alfa case, we would get into a mess since in the case
-      --  of limited types in particular, removal of side effects involves the
-      --  use of access types or references which are not permitted in Alfa
-      --  mode.
+      --  In the Alfa case, we don't need to remove side effects because formal
+      --  verification is performed only on expressions that are provably
+      --  side-effect free. If we tried to remove side effects in the Alfa
+      --  case, we would get into a mess since in the case of limited types in
+      --  particular, removal of side effects involves the use of access types
+      --  or references which are not permitted in Alfa mode.
 
       if not Full_Expander_Active then
          return;

gcc/ada/g-exptty.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                      G N A T . E X P E C T . T T Y                       --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                    Copyright (C) 2000-2011, 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- --
+-- ware  Foundation;  either version 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with System; use System;
+
+package body GNAT.Expect.TTY is
+
+   On_Windows : constant Boolean := Directory_Separator = '\';
+   --  True when on Windows
+
+   -----------
+   -- Close --
+   -----------
+
+   overriding procedure Close
+     (Descriptor : in out TTY_Process_Descriptor;
+      Status     : out Integer)
+   is
+      procedure Terminate_Process (Process : System.Address);
+      pragma Import (C, Terminate_Process, "__gnat_terminate_process");
+
+      function Waitpid (Process : System.Address) return Integer;
+      pragma Import (C, Waitpid, "__gnat_waitpid");
+      --  Wait for a specific process id, and return its exit code
+
+      procedure Free_Process (Process : System.Address);
+      pragma Import (C, Free_Process, "__gnat_free_process");
+
+      procedure Close_TTY (Process : System.Address);
+      pragma Import (C, Close_TTY, "__gnat_close_tty");
+
+   begin
+      --  If we haven't already closed the process
+
+      if Descriptor.Process = System.Null_Address then
+         Status := -1;
+
+      else
+         if Descriptor.Input_Fd /= Invalid_FD then
+            Close (Descriptor.Input_Fd);
+         end if;
+
+         if Descriptor.Error_Fd /= Descriptor.Output_Fd
+           and then Descriptor.Error_Fd /= Invalid_FD
+         then
+            Close (Descriptor.Error_Fd);
+         end if;
+
+         if Descriptor.Output_Fd /= Invalid_FD then
+            Close (Descriptor.Output_Fd);
+         end if;
+
+         --  Send a Ctrl-C to the process first. This way, if the
+         --  launched process is a "sh" or "cmd", the child processes
+         --  will get terminated as well. Otherwise, terminating the
+         --  main process brutally will leave the children running.
+
+         Interrupt (Descriptor);
+         delay 0.05;
+
+         Terminate_Process (Descriptor.Process);
+         Status := Waitpid (Descriptor.Process);
+
+         if not On_Windows then
+            Close_TTY (Descriptor.Process);
+         end if;
+
+         Free_Process (Descriptor.Process'Address);
+         Descriptor.Process := System.Null_Address;
+
+         GNAT.OS_Lib.Free (Descriptor.Buffer);
+         Descriptor.Buffer_Size := 0;
+      end if;
+   end Close;
+
+   overriding procedure Close (Descriptor : in out TTY_Process_Descriptor) is
+      Status : Integer;
+   begin
+      Close (Descriptor, Status);
+   end Close;
+
+   -----------------------------
+   -- Close_Pseudo_Descriptor --
+   -----------------------------
+
+   procedure Close_Pseudo_Descriptor
+     (Descriptor : in out TTY_Process_Descriptor)
+   is
+   begin
+      Descriptor.Buffer_Size := 0;
+      GNAT.OS_Lib.Free (Descriptor.Buffer);
+   end Close_Pseudo_Descriptor;
+
+   ---------------
+   -- Interrupt --
+   ---------------
+
+   overriding procedure Interrupt
+     (Descriptor : in out TTY_Process_Descriptor)
+   is
+      procedure Internal (Process : System.Address);
+      pragma Import (C, Internal, "__gnat_interrupt_process");
+   begin
+      if Descriptor.Process /= System.Null_Address then
+         Internal (Descriptor.Process);
+      end if;
+   end Interrupt;
+
+   procedure Interrupt (Pid : Integer) is
+      procedure Internal (Pid : Integer);
+      pragma Import (C, Internal, "__gnat_interrupt_pid");
+   begin
+      Internal (Pid);
+   end Interrupt;
+
+   -----------------------
+   -- Pseudo_Descriptor --
+   -----------------------
+
+   procedure Pseudo_Descriptor
+     (Descriptor  : out TTY_Process_Descriptor'Class;
+      TTY         : GNAT.TTY.TTY_Handle;
+      Buffer_Size : Natural := 4096) is
+   begin
+      Descriptor.Input_Fd  := GNAT.TTY.TTY_Descriptor (TTY);
+      Descriptor.Output_Fd := Descriptor.Input_Fd;
+
+      --  Create the buffer
+
+      Descriptor.Buffer_Size := Buffer_Size;
+
+      if Buffer_Size /= 0 then
+         Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
+      end if;
+   end Pseudo_Descriptor;
+
+   ----------
+   -- Send --
+   ----------
+
+   overriding procedure Send
+     (Descriptor   : in out TTY_Process_Descriptor;
+      Str          : String;
+      Add_LF       : Boolean := True;
+      Empty_Buffer : Boolean := False)
+   is
+      Header : String (1 .. 5);
+      Length : Natural;
+      Ret    : Natural;
+
+      procedure Internal
+        (Process : System.Address;
+         S       : in out String;
+         Length  : Natural;
+         Ret     : out Natural);
+      pragma Import (C, Internal, "__gnat_send_header");
+
+   begin
+      Length := Str'Length;
+
+      if Add_LF then
+         Length := Length + 1;
+      end if;
+
+      Internal (Descriptor.Process, Header, Length, Ret);
+
+      if Ret = 1 then
+
+         --  Need to use the header
+
+         GNAT.Expect.Send
+           (Process_Descriptor (Descriptor),
+            Header & Str, Add_LF, Empty_Buffer);
+
+      else
+         GNAT.Expect.Send
+           (Process_Descriptor (Descriptor),
+            Str, Add_LF, Empty_Buffer);
+      end if;
+   end Send;
+
+   --------------
+   -- Set_Size --
+   --------------
+
+   procedure Set_Size
+     (Descriptor : in out TTY_Process_Descriptor'Class;
+      Rows       : Natural;
+      Columns    : Natural)
+   is
+      procedure Internal (Process : System.Address; R, C : Integer);
+      pragma Import (C, Internal, "__gnat_setup_winsize");
+   begin
+      if Descriptor.Process /= System.Null_Address then
+         Internal (Descriptor.Process, Rows, Columns);
+      end if;
+   end Set_Size;
+
+   ---------------------------
+   -- Set_Up_Communications --
+   ---------------------------
+
+   overriding procedure Set_Up_Communications
+     (Pid        : in out TTY_Process_Descriptor;
+      Err_To_Out : Boolean;
+      Pipe1      : access Pipe_Type;
+      Pipe2      : access Pipe_Type;
+      Pipe3      : access Pipe_Type)
+   is
+      pragma Unreferenced (Err_To_Out, Pipe1, Pipe2, Pipe3);
+
+      function Internal (Process : System.Address) return Integer;
+      pragma Import (C, Internal, "__gnat_setup_communication");
+
+   begin
+      if Internal (Pid.Process'Address) /= 0 then
+         raise Invalid_Process with "cannot setup communication.";
+      end if;
+   end Set_Up_Communications;
+
+   ---------------------------------
+   -- Set_Up_Child_Communications --
+   ---------------------------------
+
+   overriding procedure Set_Up_Child_Communications
+     (Pid   : in out TTY_Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type;
+      Cmd   : String;
+      Args  : System.Address)
+   is
+      pragma Unreferenced (Pipe1, Pipe2, Pipe3, Cmd);
+      function Internal
+        (Process : System.Address; Argv : System.Address; Use_Pipes : Integer)
+         return Process_Id;
+      pragma Import (C, Internal, "__gnat_setup_child_communication");
+
+   begin
+      Pid.Pid := Internal (Pid.Process, Args, Boolean'Pos (Pid.Use_Pipes));
+   end Set_Up_Child_Communications;
+
+   ----------------------------------
+   -- Set_Up_Parent_Communications --
+   ----------------------------------
+
+   overriding procedure Set_Up_Parent_Communications
+     (Pid   : in out TTY_Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type)
+   is
+      pragma Unreferenced (Pipe1, Pipe2, Pipe3);
+
+      procedure Internal
+        (Process  : System.Address;
+         Inputfp  : out File_Descriptor;
+         Outputfp : out File_Descriptor;
+         Errorfp  : out File_Descriptor;
+         Pid      : out Process_Id);
+      pragma Import (C, Internal, "__gnat_setup_parent_communication");
+
+   begin
+      Internal
+        (Pid.Process, Pid.Input_Fd, Pid.Output_Fd, Pid.Error_Fd, Pid.Pid);
+   end Set_Up_Parent_Communications;
+
+   -------------------
+   -- Set_Use_Pipes --
+   -------------------
+
+   procedure Set_Use_Pipes
+     (Descriptor : in out TTY_Process_Descriptor;
+      Use_Pipes  : Boolean) is
+   begin
+      Descriptor.Use_Pipes := Use_Pipes;
+   end Set_Use_Pipes;
+
+end GNAT.Expect.TTY;

gcc/ada/g-exptty.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                      G N A T . E X P E C T . T T Y                       --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                    Copyright (C) 2000-2011, 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- --
+-- ware  Foundation;  either version 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with GNAT.TTY;
+
+with System;
+
+package GNAT.Expect.TTY is
+
+   ------------------
+   --  TTY_Process --
+   ------------------
+
+   type TTY_Process_Descriptor is new Process_Descriptor with private;
+   --  Similar to Process_Descriptor, with the parent set up as a full terminal
+   --  (Unix sense, see tty(4)).
+
+   procedure Pseudo_Descriptor
+     (Descriptor  : out TTY_Process_Descriptor'Class;
+      TTY         : GNAT.TTY.TTY_Handle;
+      Buffer_Size : Natural := 4096);
+   --  Given a terminal descriptor (TTY), create a pseudo process descriptor
+   --  to be used with GNAT.Expect.
+   --
+   --  Note that it is invalid to call Close, Interrupt, Send_Signal on the
+   --  resulting descriptor. To deallocate memory associated with Process,
+   --  call Close_Pseudo_Descriptor instead.
+
+   procedure Close_Pseudo_Descriptor
+     (Descriptor : in out TTY_Process_Descriptor);
+   --  Free memory and ressources associated with Descriptor. Will *not*
+   --  close the associated TTY, it is the caller's responsibility to call
+   --  GNAT.TTY.Close_TTY.
+
+   procedure Interrupt (Pid : Integer);
+   --  Interrupt a process given its pid
+
+   overriding procedure Send
+     (Descriptor   : in out TTY_Process_Descriptor;
+      Str          : String;
+      Add_LF       : Boolean := True;
+      Empty_Buffer : Boolean := False);
+   --  See parent
+   --  What does that comment mean??? what is "parent" here
+
+   procedure Set_Use_Pipes
+     (Descriptor : in out TTY_Process_Descriptor;
+      Use_Pipes  : Boolean);
+   --  Tell Expect.TTY whether to use Pipes or Console (on windows). Needs to
+   --  be set before spawning the process. Default is to use Pipes.
+
+   procedure Set_Size
+     (Descriptor : in out TTY_Process_Descriptor'Class;
+      Rows       : Natural;
+      Columns    : Natural);
+   --  Sets up the size of the terminal as reported to the spawned process
+
+private
+
+   --  All declarations in the private part must be fully commented ???
+
+   overriding procedure Close
+     (Descriptor : in out TTY_Process_Descriptor;
+      Status     : out Integer);
+
+   overriding procedure Close
+     (Descriptor : in out TTY_Process_Descriptor);
+
+   overriding procedure Interrupt (Descriptor : in out TTY_Process_Descriptor);
+   --  When we use pseudo-terminals, we do not need to use signals to
+   --  interrupt the debugger, we can simply send the appropriate character.
+   --  This provides a better support for remote debugging for instance.
+
+   procedure Set_Up_Communications
+     (Pid        : in out TTY_Process_Descriptor;
+      Err_To_Out : Boolean;
+      Pipe1      : access Pipe_Type;
+      Pipe2      : access Pipe_Type;
+      Pipe3      : access Pipe_Type);
+
+   procedure Set_Up_Parent_Communications
+     (Pid   : in out TTY_Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type);
+
+   procedure Set_Up_Child_Communications
+     (Pid   : in out TTY_Process_Descriptor;
+      Pipe1 : in out Pipe_Type;
+      Pipe2 : in out Pipe_Type;
+      Pipe3 : in out Pipe_Type;
+      Cmd   : String;
+      Args  : System.Address);
+
+   type TTY_Process_Descriptor is new Process_Descriptor with record
+      Process   : System.Address;  --  Underlying structure used in C
+      Use_Pipes : Boolean := True;
+   end record;
+
+end GNAT.Expect.TTY;

gcc/ada/g-tty.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                             G N A T . T T Y                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2002-2011, 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- --
+-- ware  Foundation;  either version 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Interfaces.C.Strings; use Interfaces.C.Strings;
+
+package body GNAT.TTY is
+
+   use System;
+
+   procedure Check_TTY (Handle : TTY_Handle);
+   --  Check the validity of Handle. Raise Program_Error if ttys are not
+   --  supported. Raise Constraint_Error if Handle is an invalid handle.
+
+   ------------------
+   -- Allocate_TTY --
+   ------------------
+
+   procedure Allocate_TTY (Handle : out TTY_Handle) is
+      function Internal return System.Address;
+      pragma Import (C, Internal, "__gnat_new_tty");
+
+   begin
+      if not TTY_Supported then
+         raise Program_Error;
+      end if;
+
+      Handle.Handle := Internal;
+   end Allocate_TTY;
+
+   ---------------
+   -- Check_TTY --
+   ---------------
+
+   procedure Check_TTY (Handle : TTY_Handle) is
+   begin
+      if not TTY_Supported then
+         raise Program_Error;
+      elsif Handle.Handle = System.Null_Address then
+         raise Constraint_Error;
+      end if;
+   end Check_TTY;
+
+   ---------------
+   -- Close_TTY --
+   ---------------
+
+   procedure Close_TTY (Handle : in out TTY_Handle) is
+      procedure Internal (Handle : System.Address);
+      pragma Import (C, Internal, "__gnat_close_tty");
+   begin
+      Check_TTY (Handle);
+      Internal (Handle.Handle);
+      Handle.Handle := System.Null_Address;
+   end Close_TTY;
+
+   ---------------
+   -- Reset_TTY --
+   ---------------
+
+   procedure Reset_TTY (Handle : TTY_Handle) is
+      procedure Internal (Handle : System.Address);
+      pragma Import (C, Internal, "__gnat_reset_tty");
+   begin
+      Check_TTY (Handle);
+      Internal (Handle.Handle);
+   end Reset_TTY;
+
+   --------------------
+   -- TTY_Descriptor --
+   --------------------
+
+   function TTY_Descriptor
+     (Handle : TTY_Handle) return GNAT.OS_Lib.File_Descriptor
+   is
+      function Internal
+        (Handle : System.Address) return GNAT.OS_Lib.File_Descriptor;
+      pragma Import (C, Internal, "__gnat_tty_fd");
+   begin
+      Check_TTY (Handle);
+      return Internal (Handle.Handle);
+   end TTY_Descriptor;
+
+   --------------
+   -- TTY_Name --
+   --------------
+
+   function TTY_Name (Handle : TTY_Handle) return String is
+      function Internal (Handle : System.Address) return chars_ptr;
+      pragma Import (C, Internal, "__gnat_tty_name");
+   begin
+      Check_TTY (Handle);
+      return Value (Internal (Handle.Handle));
+   end TTY_Name;
+
+   -------------------
+   -- TTY_Supported --
+   -------------------
+
+   function TTY_Supported return Boolean is
+      function Internal return Integer;
+      pragma Import (C, Internal, "__gnat_tty_supported");
+   begin
+      return Internal /= 0;
+   end TTY_Supported;
+
+end GNAT.TTY;

gcc/ada/g-tty.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                             G N A T . T T Y                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 2002-2011, 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- --
+-- ware  Foundation;  either version 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides control over pseudo terminals (ttys)
+
+--  This package is only supported on unix systems. See function TTY_Supported
+--  to test dynamically whether other functions of this package can be called.
+
+with System;
+
+with GNAT.OS_Lib;
+
+package GNAT.TTY is
+
+   type TTY_Handle is private;
+   --  Handle for a tty descriptor
+
+   function TTY_Supported return Boolean;
+   --  If True, the other functions of this package can be called. Otherwise,
+   --  all functions in this package will raise Program_Error if called.
+
+   procedure Allocate_TTY (Handle : out TTY_Handle);
+   --  Allocate a new tty
+
+   procedure Reset_TTY (Handle : TTY_Handle);
+   --  Reset settings of a given tty
+
+   procedure Close_TTY (Handle : in out TTY_Handle);
+   --  Close a given tty
+
+   function TTY_Name (Handle : TTY_Handle) return String;
+   --  Return the external name of a tty. The name depends on the tty handling
+   --  on the given target. It will typically look like: "/dev/ptya1"
+
+   function TTY_Descriptor
+     (Handle : TTY_Handle) return GNAT.OS_Lib.File_Descriptor;
+   --  Return the low level descriptor associated with Handle
+
+private
+
+   type TTY_Handle is record
+      Handle : System.Address := System.Null_Address;
+   end record;
+
+end GNAT.TTY;

gcc/ada/gcc-interface/Make-lang.in

@@ -2617,9 +2617,9 @@ ada/exp_util.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
    ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
    ada/lib-sort.adb ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
    ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
-   ada/opt.ads ada/output.ads ada/put_alfa.ads ada/restrict.ads \
-   ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
-   ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
+   ada/opt.ads ada/opt.adb ada/output.ads ada/put_alfa.ads \
+   ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
+   ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
    ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch11.ads \
    ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads \
    ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads \

gcc/ada/gcc-interface/Makefile.in

@@ -2213,12 +2213,13 @@ LIBGNAT_SRCS = adadecode.c adadecode.h adaint.c adaint.h	\
   argv.c cio.c cstreams.c errno.c exit.c cal.c ctrl_c.c env.c env.h	\
   arit64.c raise.h raise.c sysdep.c aux-io.c init.c initialize.c	\
   locales.c seh_init.c final.c tracebak.c tb-alvms.c tb-alvxw.c         \
-  tb-gcc.c expect.c mkdir.c socket.c gsocket.h targext.c $(EXTRA_LIBGNAT_SRCS)
+  tb-gcc.c expect.c mkdir.c socket.c gsocket.h targext.c \
+  terminals.c $(EXTRA_LIBGNAT_SRCS)
 
 LIBGNAT_OBJS = adadecode.o adaint.o argv.o cio.o cstreams.o ctrl_c.o	\
   errno.o exit.o env.o raise.o sysdep.o aux-io.o init.o initialize.o	\
   locales.o seh_init.o cal.o arit64.o final.o tracebak.o expect.o       \
-  mkdir.o socket.o targext.o $(EXTRA_LIBGNAT_OBJS)
+  mkdir.o socket.o targext.o terminals.o $(EXTRA_LIBGNAT_OBJS)
 
 # NOTE ??? - when the -I option for compiling Ada code is made to work,
 #  the library installation will change and there will be a
@@ -2859,6 +2860,7 @@ socket.o  : socket.c gsocket.h
 sysdep.o  : sysdep.c
 raise.o   : raise.c raise.h
 sigtramp-ppcvxw.o : sigtramp-ppcvxw.c sigtramp.h
+terminals.o : terminals.c
 vx_stack_info.o : vx_stack_info.c
 
 raise-gcc.o : raise-gcc.c raise.h

gcc/ada/gnat_rm.texi

@@ -374,6 +374,7 @@ The GNAT Library
 * GNAT.Exception_Traces (g-exctra.ads)::
 * GNAT.Exceptions (g-except.ads)::
 * GNAT.Expect (g-expect.ads)::
+* GNAT.Expect.TTY (g-exptty.ads)::
 * GNAT.Float_Control (g-flocon.ads)::
 * GNAT.Heap_Sort (g-heasor.ads)::
 * GNAT.Heap_Sort_A (g-hesora.ads)::
@@ -14187,6 +14188,7 @@ of GNAT, and will generate a warning message.
 * GNAT.Exception_Traces (g-exctra.ads)::
 * GNAT.Exceptions (g-except.ads)::
 * GNAT.Expect (g-expect.ads)::
+* GNAT.Expect.TTY (g-exptty.ads)::
 * GNAT.Float_Control (g-flocon.ads)::
 * GNAT.Heap_Sort (g-heasor.ads)::
 * GNAT.Heap_Sort_A (g-hesora.ads)::
@@ -15054,6 +15056,16 @@ is implemented on all native GNAT ports except for OpenVMS@.
 It is not implemented for cross ports, and in particular is not
 implemented for VxWorks or LynxOS@.
 
+@node GNAT.Expect.TTY (g-exptty.ads)
+@section @code{GNAT.Expect.TTY} (@file{g-exptty.ads})
+@cindex @code{GNAT.Expect.TTY} (@file{g-exptty.ads})
+
+@noindent
+As GNAT.Expect but using pseudo-terminal.
+Currently @code{GNAT.Expect.TTY} is implemented on all native GNAT
+ports except for OpenVMS@. It is not implemented for cross ports, and
+in particular is not implemented for VxWorks or LynxOS@.
+
 @node GNAT.Float_Control (g-flocon.ads)
 @section @code{GNAT.Float_Control} (@file{g-flocon.ads})
 @cindex @code{GNAT.Float_Control} (@file{g-flocon.ads})

gcc/ada/par-ch6.adb

@@ -1681,7 +1681,7 @@ package body Ch6 is
 
          if Ada_Version < Ada_2012 then
             Error_Msg_SC -- CODEFIX
-              ("ALIASED not allowed in extended return in Ada2012?");
+              ("ALIASED not allowed in extended return in Ada 2012?");
          else
             Error_Msg_SC -- CODEFIX
               ("ALIASED not allowed in extended return");

gcc/ada/par-util.adb

@@ -174,7 +174,7 @@ package body Util is
 
    procedure Check_Future_Keyword is
    begin
-      --  Ada 2005 (AI-284): Compiling in Ada95 mode we warn that INTERFACE,
+      --  Ada 2005 (AI-284): Compiling in Ada 95 mode we warn that INTERFACE,
       --  OVERRIDING, and SYNCHRONIZED are new reserved words.
 
       if Ada_Version = Ada_95

gcc/ada/sem_ch13.adb

@@ -728,8 +728,9 @@ package body Sem_Ch13 is
             A_Id : constant Aspect_Id  := Get_Aspect_Id (Nam);
             Anod : Node_Id;
 
-            Eloc : Source_Ptr := Sloc (Expr);
-            --  Source location of expression, modified when we split PPC's
+            Eloc : Source_Ptr := No_Location;
+            --  Source location of expression, modified when we split PPC's. It
+            --  is set below when Expr is present.
 
             procedure Check_False_Aspect_For_Derived_Type;
             --  This procedure checks for the case of a false aspect for a
@@ -804,6 +805,18 @@ package body Sem_Ch13 is
                goto Continue;
             end if;
 
+            --  Set the source location of expression, used in the case of
+            --  a failed precondition/postcondition or invariant. Note that
+            --  the source location of the expression is not usually the best
+            --  choice here. For example, it gets located on the last AND
+            --  keyword in a chain of boolean expressiond AND'ed together.
+            --  It is best to put the message on the first character of the
+            --  assertion, which is the effect of the First_Node call here.
+
+            if Present (Expr) then
+               Eloc := Sloc (First_Node (Expr));
+            end if;
+
             --  Check restriction No_Implementation_Aspect_Specifications
 
             if Impl_Defined_Aspects (A_Id) then

gcc/ada/sem_res.adb

@@ -2811,7 +2811,7 @@ package body Sem_Res is
          --  default expression mode (the Freeze_Expression routine tests this
          --  flag and only freezes static types if it is set).
 
-         --  AI05-177 (Ada2012): Expression functions do not freeze. Only
+         --  Ada 2012 (AI05-177): Expression functions do not freeze. Only
          --  their use (in an expanded call) freezes.
 
          if Ekind (Current_Scope) /= E_Function

gcc/ada/terminals.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT RUN-TIME COMPONENTS                         *
+ *                                                                          *
+ *                            T E R M I N A L S                             *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                     Copyright (C) 2008-2011, 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- *
+ * ware  Foundation;  either version 3,  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.                                     *
+ *                                                                          *
+ * As a special exception under Section 7 of GPL version 3, you are granted *
+ * additional permissions described in the GCC Runtime Library Exception,   *
+ * version 3.1, as published by the Free Software Foundation.               *
+ *                                                                          *
+ * You should have received a copy of the GNU General Public License and    *
+ * a copy of the GCC Runtime Library Exception along with this program;     *
+ * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
+ * <http://www.gnu.org/licenses/>.                                          *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc.      *
+ *                                                                          *
+ ****************************************************************************/
+
+/* First all usupported platforms. Add stubs for exported routines. */
+
+#if defined (VMS) || defined (__vxworks) || defined (__Lynx__)
+
+void * __gnat_new_tty (void) { return (void*)0; }
+char * __gnat_tty_name (void* t) { return (char*)0; }
+int    __gnat_interrupt_pid (int pid) { return -1; }
+int    __gnat_interrupt_process (void* desc) { return -1; }
+int    __gnat_setup_communication (void** desc) { return -1; }
+void   __gnat_setup_parent_communication
+         (void* d, int* i, int* o, int*e, int*p) { return -1; }
+int    __gnat_setup_child_communication
+         (void* d, char **n, int u) { return -1; }
+int    __gnat_terminate_process (void *desc) { return -1; }
+int    __gnat_tty_fd (void* t) { return -1; }
+int    __gnat_tty_supported (void) { return 0; }
+int    __gnat_tty_waitpid (void *desc) { return 1; }
+void   __gnat_close_tty (void* t) {}
+void   __gnat_free_process (void** process) {}
+void   __gnat_reset_tty (void* t) {}
+void   __gnat_send_header (void* d, char h[5], int s, int *r) {}
+void   __gnat_setup_winsize (void *desc, int rows, int columns) {}
+
+/* For Windows platforms. */
+
+#elif defined(_WIN32)
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <windows.h>
+
+#define MAXPATHLEN 1024
+
+#define NILP(x) ((x) == 0)
+#define Qnil 0
+#define report_file_error(x, y) fprintf (stderr, "Error: %s\n", x);
+#define INTEGERP(x) 1
+#define XINT(x) x
+
+struct TTY_Process {
+  int pid;           /* Number of this process */
+  PROCESS_INFORMATION procinfo;
+  HANDLE w_infd, w_outfd;
+  HANDLE w_forkin, w_forkout;
+  BOOL usePipe;
+};
+
+/* Control whether create_child cause the process to inherit GPS'
+   error mode setting.  The default is 1, to minimize the possibility of
+   subprocesses blocking when accessing unmounted drives.  */
+static int Vw32_start_process_inherit_error_mode = 1;
+
+/* Control whether spawnve quotes arguments as necessary to ensure
+   correct parsing by child process.  Because not all uses of spawnve
+   are careful about constructing argv arrays, we make this behaviour
+   conditional (off by default, since a similar operation is already done
+   in g-expect.adb by calling Normalize_Argument). */
+static int Vw32_quote_process_args = 0;
+
+static DWORD AbsoluteSeek(HANDLE, DWORD);
+static VOID  ReadBytes(HANDLE, LPVOID, DWORD);
+
+#define XFER_BUFFER_SIZE 2048
+
+/* This tell if the executable we're about to launch uses a GUI interface. */
+/* if we can't determine it, we will return true */
+static int
+is_gui_app (char *exe)
+{
+  HANDLE hImage;
+
+  DWORD  bytes;
+  DWORD  iSection;
+  DWORD  SectionOffset;
+  DWORD  CoffHeaderOffset;
+  DWORD  MoreDosHeader[16];
+  CHAR   *file;
+  size_t nlen;
+
+  ULONG  ntSignature;
+
+  IMAGE_DOS_HEADER      image_dos_header;
+  IMAGE_FILE_HEADER     image_file_header;
+  IMAGE_OPTIONAL_HEADER image_optional_header;
+  IMAGE_SECTION_HEADER  image_section_header;
+
+  /*
+   *  Open the reference file.
+  */
+  nlen = strlen (exe);
+  file = exe;
+  if (nlen > 2) {
+    if (exe[0] == '"') {
+      /* remove quotes */
+      nlen -= 2;
+      file = malloc ((nlen + 1) * sizeof (char));
+      memcpy (file, &exe[1], nlen);
+      file [nlen] = '\0';
+    }
+  }
+  hImage = CreateFile(file,
+                      GENERIC_READ,
+                      FILE_SHARE_READ,
+                      NULL,
+                      OPEN_EXISTING,
+                      FILE_ATTRIBUTE_NORMAL,
+                      NULL);
+
+  if (file != exe) {
+    free (file);
+  }
+
+  if (INVALID_HANDLE_VALUE == hImage)
+    {
+      report_file_error ("Could not open exe: ", Qnil);
+      report_file_error (exe, Qnil);
+      report_file_error ("\n", Qnil);
+      CloseHandle (hImage);
+      return -1;
+    }
+
+  /*
+   *  Read the MS-DOS image header.
+   */
+  ReadBytes(hImage, &image_dos_header, sizeof(IMAGE_DOS_HEADER));
+
+  if (IMAGE_DOS_SIGNATURE != image_dos_header.e_magic)
+    {
+      report_file_error("Sorry, I do not understand this file.\n", Qnil);
+      CloseHandle (hImage);
+      return -1;
+    }
+
+  /*
+   *  Read more MS-DOS header.       */
+  ReadBytes(hImage, MoreDosHeader, sizeof(MoreDosHeader));
+   /*
+   *  Get actual COFF header.
+   */
+  CoffHeaderOffset = AbsoluteSeek(hImage, image_dos_header.e_lfanew) +
+                     sizeof(ULONG);
+  if (CoffHeaderOffset < 0) {
+    CloseHandle (hImage);
+    return -1;
+  }
+
+  ReadBytes (hImage, &ntSignature, sizeof(ULONG));
+
+  if (IMAGE_NT_SIGNATURE != ntSignature)
+    {
+      report_file_error ("Missing NT signature. Unknown file type.\n", Qnil);
+      CloseHandle (hImage);
+      return -1;
+    }
+
+  SectionOffset = CoffHeaderOffset + IMAGE_SIZEOF_FILE_HEADER +
+    IMAGE_SIZEOF_NT_OPTIONAL_HEADER;
+
+  ReadBytes(hImage, &image_file_header, IMAGE_SIZEOF_FILE_HEADER);
+
+  /*
+   *  Read optional header.
+   */
+  ReadBytes(hImage,
+            &image_optional_header,
+            IMAGE_SIZEOF_NT_OPTIONAL_HEADER);
+
+  CloseHandle (hImage);
+
+  switch (image_optional_header.Subsystem)
+    {
+    case IMAGE_SUBSYSTEM_UNKNOWN:
+        return 1;
+        break;
+
+    case IMAGE_SUBSYSTEM_NATIVE:
+        return 1;
+        break;
+
+    case IMAGE_SUBSYSTEM_WINDOWS_GUI:
+        return 1;
+        break;
+
+    case IMAGE_SUBSYSTEM_WINDOWS_CUI:
+        return 0;
+        break;
+
+    case IMAGE_SUBSYSTEM_OS2_CUI:
+        return 0;
+        break;
+
+    case IMAGE_SUBSYSTEM_POSIX_CUI:
+        return 0;
+        break;
+
+    default:
+        /* Unknown, return GUI app to be preservative: if yes, it will be
+           correctly launched, if no, it will be launched, and a console will
+           be also displayed, which is not a big deal */
+        return 1;
+        break;
+    }
+
+}
+
+static DWORD
+AbsoluteSeek (HANDLE hFile, DWORD offset)
+{
+    DWORD newOffset;
+
+    newOffset = SetFilePointer (hFile, offset, NULL, FILE_BEGIN);
+
+    if (newOffset == 0xFFFFFFFF)
+      return -1;
+    else
+      return newOffset;
+}
+
+static VOID
+ReadBytes (HANDLE hFile, LPVOID buffer, DWORD size)
+{
+  DWORD bytes;
+
+  if (!ReadFile(hFile, buffer, size, &bytes, NULL))
+    {
+      size = 0;
+      return;
+    }
+  else if (size != bytes)
+    {
+      return;
+    }
+}
+
+static int
+nt_spawnve (char *exe, char **argv, char *env, struct TTY_Process *process)
+{
+  STARTUPINFO start;
+  SECURITY_ATTRIBUTES sec_attrs;
+  SECURITY_DESCRIPTOR sec_desc;
+  DWORD flags;
+  char dir[ MAXPATHLEN ];
+  int pid;
+  int is_gui, use_cmd;
+  char *cmdline, *parg, **targ;
+  int do_quoting = 0;
+  char escape_char;
+  int arglen;
+
+  /* we have to do some conjuring here to put argv and envp into the
+     form CreateProcess wants...  argv needs to be a space separated/null
+     terminated list of parameters, and envp is a null
+     separated/double-null terminated list of parameters.
+
+     Additionally, zero-length args and args containing whitespace or
+     quote chars need to be wrapped in double quotes - for this to work,
+     embedded quotes need to be escaped as well.  The aim is to ensure
+     the child process reconstructs the argv array we start with
+     exactly, so we treat quotes at the beginning and end of arguments
+     as embedded quotes.
+
+     Note that using backslash to escape embedded quotes requires
+     additional special handling if an embedded quote is already
+     preceeded by backslash, or if an arg requiring quoting ends with
+     backslash.  In such cases, the run of escape characters needs to be
+     doubled.  For consistency, we apply this special handling as long
+     as the escape character is not quote.
+
+     Since we have no idea how large argv and envp are likely to be we
+     figure out list lengths on the fly and allocate them.  */
+
+  if (!NILP (Vw32_quote_process_args))
+    {
+      do_quoting = 1;
+      /* Override escape char by binding w32-quote-process-args to
+	 desired character, or use t for auto-selection.  */
+      if (INTEGERP (Vw32_quote_process_args))
+	escape_char = XINT (Vw32_quote_process_args);
+      else
+	escape_char = '\\';
+    }
+
+  /* do argv...  */
+  arglen = 0;
+  targ = argv;
+  while (*targ)
+    {
+      char *p = *targ;
+      int need_quotes = 0;
+      int escape_char_run = 0;
+
+      if (*p == 0)
+	need_quotes = 1;
+      for ( ; *p; p++)
+	{
+	  if (*p == '"')
+	    {
+	      /* allow for embedded quotes to be escaped */
+	      arglen++;
+	      need_quotes = 1;
+	      /* handle the case where the embedded quote is already escaped */
+	      if (escape_char_run > 0)
+		{
+		  /* To preserve the arg exactly, we need to double the
+		     preceding escape characters (plus adding one to
+		     escape the quote character itself).  */
+		  arglen += escape_char_run;
+		}
+	    }
+	  else if (*p == ' ' || *p == '\t')
+	    {
+	      need_quotes = 1;
+	    }
+
+	  if (*p == escape_char && escape_char != '"')
+	    escape_char_run++;
+	  else
+	    escape_char_run = 0;
+	}
+      if (need_quotes)
+	{
+	  arglen += 2;
+	  /* handle the case where the arg ends with an escape char - we
+	     must not let the enclosing quote be escaped.  */
+	  if (escape_char_run > 0)
+	    arglen += escape_char_run;
+	}
+      arglen += strlen (*targ) + 1;
+      targ++;
+    }
+
+  is_gui = is_gui_app (argv[0]);
+  use_cmd = FALSE;
+
+  if (is_gui == -1) {
+    /* could not determine application type. Try launching with "cmd /c" */
+    is_gui = FALSE;
+    arglen += 7;
+    use_cmd = TRUE;
+  }
+
+  cmdline = (char*)malloc (arglen + 1);
+  targ = argv;
+  parg = cmdline;
+
+  if (use_cmd == TRUE) {
+    strcpy (parg, "cmd /c ");
+    parg += 7;
+  }
+
+  while (*targ)
+    {
+      char * p = *targ;
+      int need_quotes = 0;
+
+      if (*p == 0)
+	need_quotes = 1;
+
+      if (do_quoting)
+	{
+	  for ( ; *p; p++)
+	    if (*p == ' ' || *p == '\t' || *p == '"')
+	      need_quotes = 1;
+	}
+      if (need_quotes)
+	{
+	  int escape_char_run = 0;
+	  char * first;
+	  char * last;
+
+	  p = *targ;
+	  first = p;
+	  last = p + strlen (p) - 1;
+	  *parg++ = '"';
+	  for ( ; *p; p++)
+	    {
+	      if (*p == '"')
+		{
+		  /* double preceding escape chars if any */
+		  while (escape_char_run > 0)
+		    {
+		      *parg++ = escape_char;
+		      escape_char_run--;
+		    }
+		  /* escape all quote chars, even at beginning or end */
+		  *parg++ = escape_char;
+		}
+	      *parg++ = *p;
+
+	      if (*p == escape_char && escape_char != '"')
+		escape_char_run++;
+	      else
+		escape_char_run = 0;
+	    }
+	  /* double escape chars before enclosing quote */
+	  while (escape_char_run > 0)
+	    {
+	      *parg++ = escape_char;
+	      escape_char_run--;
+	    }
+	  *parg++ = '"';
+	}
+      else
+	{
+	  strcpy (parg, *targ);
+	  parg += strlen (*targ);
+	}
+      *parg++ = ' ';
+      targ++;
+    }
+  *--parg = '\0';
+
+  memset (&start, 0, sizeof (start));
+  start.cb = sizeof (start);
+
+  if (process->usePipe == TRUE) {
+    start.dwFlags = STARTF_USESTDHANDLES;
+    start.hStdInput = process->w_forkin;
+    start.hStdOutput = process->w_forkout;
+    /* child's stderr is always redirected to outfd */
+    start.hStdError = process->w_forkout;
+  } else {
+    start.dwFlags = STARTF_USESTDHANDLES;
+    /* We only need to redirect stderr/stdout here. Stdin will be forced to
+       the spawned process console by explaunch */
+    start.hStdInput = NULL;
+    start.hStdOutput = process->w_forkout;
+    start.hStdError = process->w_forkout;
+  }
+
+  /* Explicitly specify no security */
+  if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
+    goto EH_Fail;
+  if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
+    goto EH_Fail;
+  sec_attrs.nLength = sizeof (sec_attrs);
+  sec_attrs.lpSecurityDescriptor = &sec_desc;
+  sec_attrs.bInheritHandle = FALSE;
+
+  /* creating a new console allow easier close. Do not use
+     CREATE_NEW_PROCESS_GROUP as this results in disabling Ctrl+C */
+  flags = CREATE_NEW_CONSOLE;
+  if (NILP (Vw32_start_process_inherit_error_mode))
+    flags |= CREATE_DEFAULT_ERROR_MODE;
+
+  /* if app is not a gui application, hide the console */
+  if (is_gui == FALSE) {
+    start.dwFlags |= STARTF_USESHOWWINDOW;
+    start.wShowWindow = SW_HIDE;
+  }
+
+  /* Set initial directory to null character to use current directory */
+  if (!CreateProcess (NULL, cmdline, &sec_attrs, NULL, TRUE,
+		      flags, env, NULL, &start, &process->procinfo))
+    goto EH_Fail;
+
+  pid = (int) process->procinfo.hProcess;
+  process->pid=pid;
+
+  return pid;
+
+ EH_Fail:
+  return -1;
+}
+
+/*************************
+ ** __gnat_send_header ()
+ *************************/
+
+#define EXP_SLAVE_CREATE 'c'
+#define EXP_SLAVE_KEY    'k'
+#define EXP_SLAVE_MOUSE  'm'
+#define EXP_SLAVE_WRITE  'w'
+#define EXP_SLAVE_KILL   'x'
+
+#define EXP_KILL_TERMINATE  0x1
+#define EXP_KILL_CTRL_C     0x2
+#define EXP_KILL_CTRL_BREAK 0x4
+
+void
+__gnat_send_header (struct TTY_Process* p, char header[5], int size, int *ret)
+{
+  if (p->usePipe == FALSE) {
+    header[0] = EXP_SLAVE_WRITE;
+    header[1] = size & 0xff;
+    header[2] = (size & 0xff00) >> 8;
+    header[3] = (size & 0xff0000) >> 16;
+    header[4] = (size & 0xff000000) >> 24;
+    *ret = 1;
+  } else {
+    *ret = 0;
+  }
+}
+
+/**********************************
+ **  __gnat_setup_communication ()
+ **********************************/
+
+int
+__gnat_setup_communication (struct TTY_Process** process_out) /* output param */
+{
+  struct TTY_Process* process;
+
+  process = (struct TTY_Process*)malloc (sizeof (struct TTY_Process));
+  ZeroMemory (process, sizeof (struct TTY_Process));
+  *process_out = process;
+
+  return 0;
+}
+
+#define EXP_PIPE_BASENAME "\\\\.\\pipe\\ExpectPipe"
+
+int
+__gnat_setup_child_communication
+  (struct TTY_Process* process,
+   char** argv,
+   int Use_Pipes)
+{
+  int cpid;
+  HANDLE parent;
+  SECURITY_ATTRIBUTES sec_attrs;
+  char slavePath [MAX_PATH];
+  char **nargv;
+  int argc;
+  int i;
+  char pipeNameIn[100];
+  HANDLE hSlaveInDrv = NULL; /* Handle to communicate with slave driver */
+
+  parent = GetCurrentProcess ();
+
+  /* Set inheritance for the pipe handles */
+  sec_attrs.nLength = sizeof (SECURITY_ATTRIBUTES);
+  sec_attrs.bInheritHandle = TRUE;
+  sec_attrs.lpSecurityDescriptor = NULL;
+
+  if (Use_Pipes) {
+    /* Create in and out pipes */
+    if (!CreatePipe (&process->w_forkin, &process->w_infd, &sec_attrs, 0))
+      report_file_error ("Creation of child's IN handle", Qnil);
+    if (!CreatePipe (&process->w_outfd, &process->w_forkout, &sec_attrs, 0))
+      report_file_error ("Creation of child's OUT handle", Qnil);
+
+    /* Do not inherit the parent's side of the pipes */
+    SetHandleInformation (&process->w_infd, HANDLE_FLAG_INHERIT, 0);
+    SetHandleInformation (&process->w_outfd, HANDLE_FLAG_INHERIT, 0);
+
+    /* use native argv */
+    nargv = argv;
+    process->usePipe = TRUE;
+
+  } else {
+    static int pipeNameId = 0;
+
+    process->w_infd = NULL;
+
+    /* We create a named pipe for Input, as we handle input by sending special
+       commands to the explaunch process, that uses it to feed the actual input
+       of the process */
+    sprintf(pipeNameIn, "%sIn%08x_%08x", EXP_PIPE_BASENAME,
+	    GetCurrentProcessId(), pipeNameId);
+    pipeNameId++;
+
+    hSlaveInDrv = CreateNamedPipe(pipeNameIn,
+				  PIPE_ACCESS_OUTBOUND,
+				  PIPE_TYPE_BYTE | PIPE_WAIT, 1, 8192, 8192,
+				  20000, NULL);
+    if (hSlaveInDrv == NULL)  goto end;
+
+    if (!CreatePipe (&process->w_outfd, &process->w_forkout, &sec_attrs, 0))
+      report_file_error ("Creation of child's OUT handle", Qnil);
+
+    if (SearchPath (NULL, "explaunch.exe", NULL,
+                    MAX_PATH, slavePath, NULL) == 0) goto end;
+
+    for (argc=0; argv[argc] != NULL; argc++) ;
+    nargv = (char **) malloc (sizeof (char*) * (argc + 3));
+    nargv[0] = slavePath;
+    nargv[1] = pipeNameIn;
+
+    for (i = 0; i <= argc; i++) nargv[i + 2] = argv[i];
+    process->usePipe = FALSE;
+  }
+
+  /* Spawn the child. */
+  cpid = nt_spawnve (nargv[0], nargv, NULL, process);
+
+  /* close the duplicated handles passed to the child */
+  CloseHandle (process->w_forkout);
+
+  if (process->usePipe == TRUE) {
+    CloseHandle (process->w_forkin);
+
+  } else {
+    UCHAR buf[8];		/* enough space for child status info */
+    DWORD count;
+    BOOL bRet;
+    DWORD dwRet;
+
+    /*
+     * Wait for connection with the slave driver
+     */
+    bRet = ConnectNamedPipe(hSlaveInDrv, NULL);
+    if (bRet == FALSE) {
+      dwRet = GetLastError();
+      if (dwRet == ERROR_PIPE_CONNECTED) {
+	;
+      } else {
+	goto end;
+      }
+    }
+
+    process->w_infd = hSlaveInDrv;
+
+    /*
+     * wait for slave driver to initialize before allowing user to send to it
+     */
+    bRet = ReadFile(process->w_outfd, buf, 8, &count, NULL);
+    if (bRet == FALSE) {
+      cpid = -1;
+    }
+
+    dwRet = buf[0] | (buf[1] << 8) | (buf[2] << 16) | (buf[3] << 24);
+    if (dwRet != 0) {
+      cpid = -1;
+    }
+
+    cpid = buf[4] | (buf[5] << 8) | (buf[6] << 16) | (buf[7] << 24);
+    process->pid = cpid;
+  }
+
+  if (cpid == -1)
+    /* An error occurred while trying to spawn the process.  */
+    report_file_error ("Spawning child process", Qnil);
+
+  return cpid;
+ end:
+  if (hSlaveInDrv != NULL)
+    CloseHandle (hSlaveInDrv);
+  return -1;
+}
+
+void
+__gnat_setup_parent_communication
+  (struct TTY_Process* process,
+   int* in,
+   int* out,
+   int* err,
+   int* pid)
+{
+  *in = _open_osfhandle ((long) process->w_infd, 0);
+  *out = _open_osfhandle ((long) process->w_outfd, 0);
+  /* child's stderr is always redirected to outfd */
+  *err = *out;
+  *pid = process->pid;
+}
+
+typedef struct _child_process
+{
+  HWND                 hwnd;
+  PROCESS_INFORMATION *procinfo;
+} child_process;
+
+/* The major and minor versions of NT.  */
+static int w32_major_version;
+static int w32_minor_version;
+
+/* Distinguish between Windows NT and Windows 95.  */
+static enum {OS_UNKNOWN, OS_WIN95, OS_NT} os_subtype = OS_UNKNOWN;
+
+/* Cache information describing the NT system for later use.  */
+static void
+cache_system_info (void)
+{
+  union
+    {
+      struct info
+        {
+          char  major;
+          char  minor;
+          short platform;
+        } info;
+      DWORD data;
+    } version;
+
+  /* Cache the version of the operating system.  */
+  version.data = GetVersion ();
+  w32_major_version = version.info.major;
+  w32_minor_version = version.info.minor;
+
+  if (version.info.platform & 0x8000)
+    os_subtype = OS_WIN95;
+  else
+    os_subtype = OS_NT;
+}
+
+static BOOL CALLBACK
+find_child_console (HWND hwnd, child_process * cp)
+{
+  DWORD thread_id;
+  DWORD process_id;
+
+  thread_id = GetWindowThreadProcessId (hwnd, &process_id);
+  if (process_id == cp->procinfo->dwProcessId)
+    {
+      char window_class[32];
+
+      GetClassName (hwnd, window_class, sizeof (window_class));
+      if (strcmp (window_class,
+                  (os_subtype == OS_WIN95)
+                  ? "tty"
+                  : "ConsoleWindowClass") == 0)
+        {
+          cp->hwnd = hwnd;
+          return FALSE;
+        }
+    }
+  /* keep looking */
+  return TRUE;
+}
+
+int
+__gnat_interrupt_process (struct TTY_Process* p)
+{
+  char buf[2];
+  DWORD written;
+  BOOL bret;
+
+  if (p->usePipe == TRUE) {
+    bret = FALSE;
+  } else {
+    buf[0] = EXP_SLAVE_KILL;
+    buf[1] = EXP_KILL_CTRL_C;
+    bret = WriteFile (p->w_infd, buf, 2, &written, NULL);
+  }
+
+  if (bret == FALSE) {
+    return __gnat_interrupt_pid (p->procinfo.dwProcessId);
+  }
+  return 0;
+}
+
+int
+__gnat_interrupt_pid (int pid)
+{
+  volatile child_process cp;
+  int rc = 0;
+
+  cp.procinfo = (LPPROCESS_INFORMATION) malloc (sizeof (PROCESS_INFORMATION));
+  cp.procinfo->dwProcessId = pid;
+
+  if (os_subtype == OS_UNKNOWN)
+    cache_system_info ();
+
+  /* Try to locate console window for process. */
+  EnumWindows ((WNDENUMPROC) find_child_console, (LPARAM) &cp);
+
+  if (cp.hwnd)
+    {
+      BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
+      /* Retrieve Ctrl-C scancode */
+      BYTE vk_break_code = 'C';
+      BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
+      HWND foreground_window;
+
+      foreground_window = GetForegroundWindow ();
+      if (foreground_window)
+        {
+          /* NT 5.0, and apparently also Windows 98, will not allow
+             a Window to be set to foreground directly without the
+             user's involvement. The workaround is to attach
+             ourselves to the thread that owns the foreground
+             window, since that is the only thread that can set the
+             foreground window.  */
+          DWORD foreground_thread, child_thread;
+
+          foreground_thread =
+            GetWindowThreadProcessId (foreground_window, NULL);
+          if (foreground_thread == GetCurrentThreadId ()
+              || !AttachThreadInput (GetCurrentThreadId (),
+                                     foreground_thread, TRUE))
+            foreground_thread = 0;
+
+          child_thread = GetWindowThreadProcessId (cp.hwnd, NULL);
+          if (child_thread == GetCurrentThreadId ()
+              || !AttachThreadInput (GetCurrentThreadId (),
+                                     child_thread, TRUE))
+            child_thread = 0;
+
+          /* Set the foreground window to the child.  */
+          if (SetForegroundWindow (cp.hwnd))
+            {
+              /* Generate keystrokes as if user had typed Ctrl-Break or
+                 Ctrl-C.  */
+              keybd_event (VK_CONTROL, control_scan_code, 0, 0);
+              keybd_event (vk_break_code, break_scan_code,
+                (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
+              keybd_event (vk_break_code, break_scan_code,
+                (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
+                 | KEYEVENTF_KEYUP, 0);
+              keybd_event (VK_CONTROL, control_scan_code, KEYEVENTF_KEYUP, 0);
+
+              /* Sleep for a bit to give time for the main frame to respond
+              to focus change events.  */
+              Sleep (100);
+
+              SetForegroundWindow (foreground_window);
+            }
+          /* Detach from the foreground and child threads now that
+             the foreground switching is over.  */
+          if (foreground_thread)
+	    AttachThreadInput (GetCurrentThreadId (), foreground_thread, FALSE);
+	  if (child_thread)
+            AttachThreadInput (GetCurrentThreadId (), child_thread, FALSE);
+        }
+    }
+  /* Ctrl-Break is NT equivalent of SIGINT.  */
+  else if (!GenerateConsoleCtrlEvent
+             (CTRL_BREAK_EVENT, cp.procinfo->dwProcessId))
+    {
+      errno = EINVAL;
+      rc = -1;
+    }
+
+  free (cp.procinfo);
+  return rc;
+}
+
+/* kill a process, as this implementation use CreateProcess on Win32 we need
+   to use Win32 TerminateProcess API */
+int
+__gnat_terminate_process (struct TTY_Process* p)
+{
+  char buf[2];
+  DWORD written;
+  BOOL bret;
+
+  if (p->usePipe == TRUE) {
+    bret = FALSE;
+  } else {
+    buf[0] = EXP_SLAVE_KILL;
+    buf[1] = EXP_KILL_TERMINATE;
+    bret = WriteFile (p->w_infd, buf, 2, &written, NULL);
+  }
+
+  if (bret == FALSE) {
+    if (!TerminateProcess (p->procinfo.hProcess, 1))
+      return -1;
+    else
+      return 0;
+  } else
+    return 0;
+}
+
+/* wait for process pid to terminate and return the process status. This
+   implementation is different from the adaint.c one for Windows as it uses
+   the Win32 API instead of the C one. */
+
+int
+__gnat_tty_waitpid (struct TTY_Process* p)
+{
+  DWORD exitcode;
+  DWORD res;
+  HANDLE proc_hand = p->procinfo.hProcess;
+
+  res = WaitForSingleObject (proc_hand, 0);
+  GetExitCodeProcess (proc_hand, &exitcode);
+
+  CloseHandle (p->procinfo.hThread);
+  CloseHandle (p->procinfo.hProcess);
+
+  /* No need to close the handles: they were closed on the ada side */
+
+  return (int) exitcode;
+}
+
+/********************************
+ **  __gnat_free_process ()
+ ********************************/
+
+void
+__gnat_free_process (struct TTY_Process** process)
+{
+  free (*process);
+  *process = NULL;
+}
+
+/* TTY handling */
+
+typedef struct {
+  int tty_fd;        /* descriptor for the tty */
+  char tty_name[24]; /* Name of TTY device */
+} TTY_Handle;
+
+int
+__gnat_tty_supported (void)
+{
+  return 0;
+}
+
+/* Return the tty name associated with p */
+
+char *
+__gnat_tty_name (TTY_Handle* t)
+{
+  return t->tty_name;
+}
+
+int
+__gnat_tty_fd (TTY_Handle* t)
+{
+  return t->tty_fd;
+}
+
+TTY_Handle*
+__gnat_new_tty (void)
+{
+  return (TTY_Handle*)0;
+}
+
+void
+__gnat_reset_tty (TTY_Handle* t)
+{
+  return;
+}
+
+void
+__gnat_close_tty (TTY_Handle* t)
+{
+  free (t);
+}
+
+void
+__gnat_setup_winsize (void *desc, int rows, int columns)
+{
+}
+
+#else /* defined(_WIN32, implementatin for all UNIXes */
+
+/* First defined some macro to identify easily some systems */
+#if defined (__FreeBSD__) \
+ || defined (__OpenBSD__) \
+ || defined (__NetBSD__)  \
+ || defined (__DragonFly__)
+#   define FREEBSD
+#endif
+#if defined (__alpha__) && defined (__osf__)
+#   define OSF1
+#endif
+#if defined (__mips) && defined (__sgi)
+#   define IRIX
+#endif
+
+/* Include every system header we need */
+#define _GNU_SOURCE
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+/* On some system termio is either absent or including it will disable termios
+   (HP-UX) */
+#if ! defined (__hpux__) && ! defined (FREEBSD) && ! defined (__APPLE__)
+#   include <termio.h>
+#endif
+
+#include <sys/ioctl.h>
+#include <termios.h>
+#include <fcntl.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <unistd.h>
+#if defined (sun)
+#   include <sys/stropts.h>
+#endif
+#if defined (FREEBSD) || defined (sun)
+#   include <sys/signal.h>
+#endif
+#if defined (__hpux__)
+#   include <sys/termio.h>
+#   include <sys/stropts.h>
+#endif
+
+#define CDISABLE _POSIX_VDISABLE
+
+/* On HP-UX and Sun system, there is a bzero function but with a different
+   signature. Use memset instead */
+#if defined (__hpux__) || defined (sun) || defined (_AIX)
+#   define bzero(s,n) memset (s,0,n)
+#endif
+
+/* POSIX does not specify how to open the master side of a terminal.Several
+   methods are available (system specific):
+      1- using a cloning device (USE_CLONE_DEVICE)
+      2- getpt                  (USE_GETPT)
+      3- openpty                (USE_OPENPTY)
+      4- _getpty                (USE_GETPTY)
+
+   When using the cloning device method, the macro USE_CLONE_DEVICE should
+   contains a full path to the adequate device.
+
+   When a new system is about to be supported, one of the previous macro should
+   be set otherwise allocate_pty_desc will return an error
+*/
+
+/* Configurable part */
+#if defined (__APPLE__) || defined (FREEBSD)
+#define USE_OPENPTY
+#elif defined (IRIX)
+#define USE_GETPTY
+#elif defined (linux)
+#define USE_GETPT
+#elif defined (sun)
+#define USE_CLONE_DEVICE "/dev/ptmx"
+#elif defined (_AIX)
+#define USE_CLONE_DEVICE "/dev/ptc"
+#elif defined (OSF1)
+/* On Tru64, the systems offers various interfaces to open a terminal:
+    - /dev/ptmx: this the system V driver (stream based),
+    - /dev/ptmx_bsd: the non stream based clone device,
+    - the openpty function which use BSD interface.
+
+   Using directly /dev/ptmx_bsd on Tru64 5.1B seems to consume all the
+   available slave ptys (why ?). When using openpty it seems that the function
+   handles the creation of entries in /dev/pts when necessary and so avoid this
+   starvation issue. The pty man entry suggests also to use openpty.
+*/
+#define USE_OPENPTY
+#elif defined (__hpux__)
+/* On HP-UX we use the streamed version. Using the non streamed version is not
+   recommanded (through "/dev/ptym/clone"). Indeed it seems that there are
+   issues to detect process terminations. */
+#define USE_CLONE_DEVICE "/dev/ptmx"
+#endif
+
+/* structure that holds information about the terminal used and the process
+   connected on the slave side */
+typedef struct pty_desc_struct {
+   int  master_fd;     /* fd of the master side if the terminal */
+   int  slave_fd;      /* fd of the slave side */
+   char slave_name[32];   /* filename of the slave side */
+   int  child_pid;     /* PID of the child process connected to the slave side
+                         of the terminal */
+} pty_desc;
+
+/* allocate_pty_desc - allocate a pseudo terminal
+ *
+ * PARAMETERS
+ *   out desc  returned pointer to a pty_desc structure containing information
+ *             about the opened pseudo terminal
+ * RETURN VALUE
+ *   -1        if failed
+ *    0        if ok
+ * COMMENTS
+ *   If the function is successful we should have at least the master side fd
+ *   and the slave side filename. On some system, the slave side will also be
+ *   opened. If this is not the case the slave side will be open once we are in
+ *   the child process (note that opening the slave side at this stage will
+ *   failed...).
+ */
+
+extern char* ptsname (int);
+
+static int
+allocate_pty_desc (pty_desc **desc) {
+
+   pty_desc *result;
+   int  status      =  0;
+   int  slave_fd    = -1;
+   int  master_fd   = -1;
+   char *slave_name = NULL;
+
+#ifdef USE_GETPT
+  master_fd = getpt ();
+#elif defined (USE_OPENPTY)
+  status = openpty (&master_fd, &slave_fd, NULL, NULL, NULL);
+#elif defined (USE_GETPTY)
+  slave_name = _getpty (&master_fd, O_RDWR | O_NDELAY, 0600, 0);
+  if (slave_name == NULL) status = -1;
+#elif defined (USE_CLONE_DEVICE)
+  master_fd = open (USE_CLONE_DEVICE, O_RDWR | O_NONBLOCK, 0);
+#else
+  printf ("[error]: terminal support is not configured\n");
+  return -1;
+#endif
+
+  /* at this stage we should have the master side fd and status should be 0 */
+  if (status != 0 || master_fd < 0)
+    {
+      /* If this is not the case close all opened files and return -1 */
+      printf ("[error]: cannot allocate master side of the pty\n");
+      if (master_fd >= 0) close (master_fd);
+      if (slave_fd  >= 0) close (slave_fd);
+      *desc = NULL;
+      return -1;
+    }
+
+  /* retrieve the file name of the slave side if necessary */
+  if (slave_name == NULL) slave_name = (char *) ptsname (master_fd);
+
+  /* Now we should have slave file name */
+  if (slave_name == NULL)
+    {
+      /* If not the case close any opened file and return - 1 */
+      printf ("[error]: cannot allocate slave side of the pty\n");
+      if (master_fd >= 0) close (master_fd);
+      if (slave_fd  >= 0) close (slave_fd);
+      *desc = NULL;
+      return -1;
+    }
+
+  /* grant access to the slave side */
+  grantpt (master_fd);
+  /* unlock the terminal */
+  unlockpt (master_fd);
+
+  /* set desc and return 0 */
+  result = malloc (sizeof (pty_desc));
+  result->master_fd  = master_fd;
+  result->slave_fd   = slave_fd;
+  /* the string returned by ptsname or _getpty is a static allocated string. So
+     we should make a copy */
+  strncpy (result->slave_name, slave_name, sizeof (result->slave_name));
+  result->slave_name[sizeof (result->slave_name) - 1] = '\0';
+  result->child_pid  = -1;
+  *desc=result;
+  return 0;
+}
+
+/* some utility macro that make the code of child_setup_tty easier to read */
+#define __enable(a, b) ((a) |= (b))
+#define __disable(a, b) ((a) &= ~(b))
+
+/* some properties do not exist on all systems. Set their value to 0 in that
+   case */
+#ifndef IUCLC
+#define IUCLC 0
+#endif
+#ifndef OLCUC
+#define OLCUC 0
+#endif
+#ifndef NLDLY
+#define NLDLY 0
+#define CRDLY 0
+#define TABDLY 0
+#define BSDLY 0
+#define VTDLY 0
+#define FFDLY 0
+#endif
+
+/* child_setup_tty - set terminal properties
+ *
+ * PARAMETERS
+ *   file descriptor of the slave side of the terminal
+ *
+ * RETURN VALUE
+ *   0 if success, any other value if failed.
+ *
+ * COMMENTS
+ *   None
+ */
+static int
+child_setup_tty (int fd)
+{
+  struct termios s;
+  int    status;
+
+  /* ensure that s is filled with 0 */
+  bzero (&s, sizeof (&s));
+
+  /* Get the current terminal settings */
+  status = tcgetattr (fd, &s);
+  if (status != 0) return -1;
+
+  /* Adjust input modes */
+  __disable (s.c_iflag, IUCLC);    /* don't transform to lower case */
+  __disable (s.c_iflag, ISTRIP);   /* don't delete 8th bit */
+
+  /* Adjust output modes */
+  __enable  (s.c_oflag, OPOST);    /* enable postprocessing */
+  __disable (s.c_oflag, ONLCR);    /* don't map LF to CR-LF */
+  __disable (s.c_oflag, NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY);
+                                   /* disable delays */
+  __disable (s.c_oflag, OLCUC);    /* don't transform to upper case */
+
+  /* Adjust control modes */
+  s.c_cflag = (s.c_cflag & ~CSIZE) | CS8; /* Don't strip 8th bit */
+
+  /* Adjust local modes */
+  __disable (s.c_lflag, ECHO);     /* disable echo */
+  __enable  (s.c_lflag, ISIG);     /* enable signals */
+  __enable  (s.c_lflag, ICANON);   /* erase/kill/eof processing */
+
+  /* Adjust control characters */
+  /* IMPORTANT: we need to ensure that Ctrl-C will trigger an interrupt signal
+     otherwise send_signal_via_characters will fail */
+  s.c_cc[VEOF]   = 04;         /* insure that EOF is Control-D */
+  s.c_cc[VERASE] = CDISABLE;   /* disable erase processing */
+  s.c_cc[VKILL]  = CDISABLE;   /* disable kill processing */
+  s.c_cc[VQUIT]  = 28;         /* Control-\ */
+  s.c_cc[VINTR]  = 03;         /* Control-C */
+  s.c_cc[VEOL]   = CDISABLE;
+  s.c_cc[VSUSP]  = 26;         /* Control-Z */
+
+  /* push our changes */
+  status = tcsetattr (fd, TCSADRAIN, &s);
+  return status;
+}
+
+/* __gnat_setup_communication - interface to the external world. Should be
+ * called before forking. On Unixes this function only call allocate_pty_desc.
+ * The Windows implementation (in different part of this file) is very
+ * different.
+ *
+ * PARAMETERS
+ *  out desc   returned pointer to a pty_desc structure
+ * RETURN VALUE
+ *  0 if success, -1 otherwise
+ */
+int __gnat_setup_communication (pty_desc** desc) {
+  return allocate_pty_desc (desc);
+}
+
+/* __gnat_setup_parent_communication - interface to the external world. Should
+ * be called after forking in the parent process
+ *
+ * PARAMETERS
+ *   out in_fd
+     out out_fd
+     out err_fd fds corresponding to the parent side of the
+                terminal
+     in pid_out child process pid
+ * RETRUN VALUE
+ *  0
+ */
+void
+__gnat_setup_parent_communication
+  (pty_desc *desc,
+   int*     in_fd,  /* input */
+   int*     out_fd, /* output */
+   int*     err_fd, /* error */
+   int*     pid_out)
+{
+
+  *in_fd = desc->master_fd;
+  *out_fd= desc->master_fd;
+  *err_fd= desc->master_fd;
+  desc->child_pid = *pid_out;
+}
+
+/* __gnat_setup_winsize - Sets up the size of the terminal
+ * This lets the process know the size of the terminal
+ */
+
+void __gnat_setup_winsize (pty_desc *desc, int rows, int columns) {
+#ifdef TIOCGWINSZ
+  struct winsize s;
+  s.ws_row = (unsigned short)rows;
+  s.ws_col = (unsigned short)columns;
+  s.ws_xpixel = 0;
+  s.ws_ypixel = 0;
+  ioctl (desc->master_fd, TIOCSWINSZ, &s);
+#ifdef SIGWINCH
+  if (desc->child_pid > 0) {
+     /* Let the process know about the change in size */
+     kill (desc->child_pid, SIGWINCH);
+  }
+#endif
+#endif
+}
+
+/* __gnat_setup_child_communication - interface to external world. Should be
+ * called after forking in the child process. On Unixes, this function
+ * first adjust the line setting, set standard output, input and error and
+ * then spawn the program.
+ *
+ * PARAMETERS
+ *   desc      a pty_desc structure containing the pty parameters
+ *   new_argv  argv of the program to be spawned
+ * RETURN VALUE
+ *   this function should not return
+ */
+int
+__gnat_setup_child_communication
+   (pty_desc *desc,
+    char **new_argv,
+    int Use_Pipes)
+{
+  int status;
+  int pid = getpid ();
+
+  setsid ();
+
+  /* open the slave side of the terminal if necessary */
+  if (desc->slave_fd == -1)
+#if defined (_AIX)
+    /* On AIX, if the slave process is not opened with O_NDELAY or O_NONBLOCK
+       then we might have some processes hanging on I/O system calls. Not sure
+       we can do that for all platforms so do it only on AIX for the moment.
+       On AIX O_NONBLOCK and O_NDELAY have slightly different meanings. When
+       reading on the slave fd, in case there is no data available, if O_NDELAY
+       is set then 0 is returned. If O_NON_BLOCK is -1 is returned. It seems
+       that interactive programs such as GDB prefer the O_NDELAY behavior.
+       We chose O_NONBLOCK because it allows us to make the distinction
+       between a true EOF and an EOF returned because there is no data
+       available to be read.  */
+    desc->slave_fd = open (desc->slave_name, O_RDWR | O_NONBLOCK, 0);
+#else
+    desc->slave_fd = open (desc->slave_name, O_RDWR, 0);
+#endif
+
+#if defined (sun) || defined (__hpux__)
+  /* On systems such as Solaris we are using stream. We need to push the right
+     "modules" in order to get the expected terminal behaviors. Otherwise
+     functionalities such as termios are not available.  */
+  ioctl (desc->slave_fd, I_PUSH, "ptem");
+  ioctl (desc->slave_fd, I_PUSH, "ldterm");
+  ioctl (desc->slave_fd, I_PUSH, "ttcompat");
+#endif
+
+#ifdef TIOCSCTTY
+  /* make the tty the controling terminal */
+  status = ioctl (desc->slave_fd, TIOCSCTTY, 0);
+#endif
+
+  /* adjust tty settings */
+  child_setup_tty (desc->slave_fd);
+  __gnat_setup_winsize (desc, 24, 80); /* To prevent errors in some shells */
+
+  /* stdin, stdout and stderr should be now our tty */
+  dup2 (desc->slave_fd, 0);
+  dup2 (desc->slave_fd, 1);
+  dup2 (desc->slave_fd, 2);
+  if (desc->slave_fd > 2) close (desc->slave_fd);
+
+  /* adjust process group settings */
+  status = setpgid (pid, pid);
+  status = tcsetpgrp (0, pid);
+
+  /* launch the program */
+  execvp (new_argv[0], new_argv);
+
+  /* return the pid */
+  return pid;
+}
+
+/* send_signal_via_characters - Send a characters that will trigger a signal
+ * in the child process.
+ *
+ * PARAMETERS
+ *  desc  a pty_desc structure containing terminal information
+ *  int   a signal number
+ * RETURN VALUE
+ *  None
+ */
+static void
+send_signal_via_characters
+  (pty_desc *desc,
+   int signal_number)
+{
+  char ctrl_c         = 03;
+  char ctrl_backslash = 28;
+  char ctrl_Z         = 26;
+
+  switch (signal_number)
+    {
+      case SIGINT:
+	write (desc->master_fd, &ctrl_c, 1); return;
+      case SIGQUIT:
+	write (desc->master_fd, &ctrl_backslash, 1); return;
+      case SIGTSTP:
+	write (desc->master_fd, &ctrl_Z, 1); return;
+    }
+}
+
+/* __gnat_interrupt_process - interrupt the child process
+ *
+ * PARAMETERS
+ *   desc a pty_desc structure
+ */
+int
+__gnat_interrupt_process (pty_desc *desc)
+{
+  send_signal_via_characters (desc, SIGINT);
+  return 0;
+}
+
+/* __gnat_interrupt_pid - interrupt a process group
+ *
+ * PARAMETERS
+ *   pid  pid of the process to interrupt
+ */
+int
+__gnat_interrupt_pid (int pid)
+{
+  kill (-pid, SIGINT);
+  return 0;
+}
+
+/* __gnat_terminate_process - kill a child process
+ *
+ * PARAMETERS
+ *   desc pty_desc structure
+ */
+int __gnat_terminate_process (pty_desc *desc)
+{
+  return kill (desc->child_pid, SIGKILL);
+}
+
+/* __gnat_tty_waitpid - wait for the child proces to die
+ *
+ * PARAMETERS
+ *   desc pty_desc structure
+ * RETURN VALUE
+ *   exit status of the child process
+ */
+int
+__gnat_tty_waitpid (pty_desc *desc)
+{
+  int status = 0;
+  waitpid (desc->child_pid, &status, 0);
+  return WEXITSTATUS (status);
+}
+
+/* __gnat_tty_supported - Are tty supported ?
+ *
+ * RETURN VALUE
+ *   always 1 on Unix systems
+ */
+int
+__gnat_tty_supported (void)
+{
+  return 1;
+}
+
+/* __gnat_free_process - free a pty_desc structure
+ *
+ * PARAMETERS
+ *   in out desc: a pty desc structure
+ */
+void
+__gnat_free_process (pty_desc** desc)
+{
+  free (*desc);
+  *desc = NULL;
+}
+
+/* __gnat_send_header - dummy function. this interface is only used on Windows */
+void
+__gnat_send_header (pty_desc* desc, char header[5], int size, int *ret)
+{
+  *ret = 0;
+}
+
+/* __gnat_reset_tty - reset line setting
+ *
+ * PARAMETERS
+ *   desc: a pty_desc structure
+ */
+void
+__gnat_reset_tty (pty_desc* desc)
+{
+  child_setup_tty (desc->master_fd);
+}
+
+/* __gnat_new_tty - allocate a new terminal
+ *
+ * RETURN VALUE
+ *   a pty_desc structure
+ */
+pty_desc *
+__gnat_new_tty (void)
+{
+  int status;
+  pty_desc* desc;
+  status = allocate_pty_desc (&desc);
+  child_setup_tty (desc->master_fd);
+  return desc;
+}
+
+/* __gnat_close_tty - close a terminal
+ *
+ * PARAMETERS
+ *   desc  a pty_desc strucure
+ */
+void __gnat_close_tty (pty_desc* desc)
+{
+  if (desc->master_fd >= 0) close (desc->master_fd);
+  if (desc->slave_fd  >= 0) close (desc->slave_fd);
+}
+
+/* __gnat_tty_name - return slave side device name
+ *
+ * PARAMETERS
+ *   desc  a pty_desc strucure
+ * RETURN VALUE
+ *   a string
+ */
+char *
+__gnat_tty_name (pty_desc* desc)
+{
+  return desc->slave_name;
+}
+
+/* __gnat_tty_name - return master side fd
+ *
+ * PARAMETERS
+ *   desc  a pty_desc strucure
+ * RETURN VALUE
+ *   a fd
+ */
+int
+__gnat_tty_fd (pty_desc* desc)
+{
+  return desc->master_fd;
+}
+
+#endif /* WIN32 */