gcc/ada/terminals.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                         GNAT RUN-TIME COMPONENTS                         *
   4  *                                                                          *
   5  *                            T E R M I N A L S                             *
   6  *                                                                          *
   7  *                          C Implementation File                           *
   8  *                                                                          *
   9  *                     Copyright (C) 2008-2023, AdaCore                     *
  10  *                                                                          *
  11  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  12  * terms of the  GNU General Public License as published  by the Free Soft- *
  13  * ware  Foundation;  either version 3,  or (at your option) any later ver- *
  14  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  15  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
  16  * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
  17  *                                                                          *
  18  * As a special exception under Section 7 of GPL version 3, you are granted *
  19  * additional permissions described in the GCC Runtime Library Exception,   *
  20  * version 3.1, as published by the Free Software Foundation.               *
  21  *                                                                          *
  22  * You should have received a copy of the GNU General Public License and    *
  23  * a copy of the GCC Runtime Library Exception along with this program;     *
  24  * see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    *
  25  * <http://www.gnu.org/licenses/>.                                          *
  26  *                                                                          *
  27  * GNAT was originally developed  by the GNAT team at  New York University. *
  28  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  29  *                                                                          *
  30  ****************************************************************************/
  31
  32 #define ATTRIBUTE_UNUSED __attribute__((unused))
  33
  34 /* First all usupported platforms. Add stubs for exported routines. */
  35
  36 #if defined (VMS) || defined (__vxworks) || defined (__Lynx__) \
  37   || defined (__ANDROID__) || defined (__PikeOS__) || defined(__DJGPP__)
  38
  39 void *
  40 __gnat_new_tty (void)
  41 {
  42   return (void*)0;
  43 }
  44
  45 char *
  46 __gnat_tty_name (void* t ATTRIBUTE_UNUSED)
  47 {
  48   return (char*)0;
  49 }
  50
  51 int
  52 __gnat_interrupt_pid (int pid ATTRIBUTE_UNUSED)
  53 {
  54   return -1;
  55 }
  56
  57 int
  58 __gnat_interrupt_process (void* desc ATTRIBUTE_UNUSED)
  59 {
  60   return -1;
  61 }
  62
  63 int
  64 __gnat_setup_communication (void** desc ATTRIBUTE_UNUSED)
  65 {
  66   return -1;
  67 }
  68
  69 void
  70 __gnat_setup_parent_communication (void *d ATTRIBUTE_UNUSED,
  71                                    int *i ATTRIBUTE_UNUSED,
  72                                    int *o ATTRIBUTE_UNUSED,
  73                                    int *e ATTRIBUTE_UNUSED,
  74                                    int *p ATTRIBUTE_UNUSED)
  75 {
  76 }
  77
  78 int
  79 __gnat_setup_child_communication (void *d ATTRIBUTE_UNUSED,
  80                                   char **n ATTRIBUTE_UNUSED,
  81                                   int u ATTRIBUTE_UNUSED)
  82 {
  83   return -1;
  84 }
  85
  86 int
  87 __gnat_terminate_process (void *desc ATTRIBUTE_UNUSED)
  88 {
  89   return -1;
  90 }
  91
  92 int
  93 __gnat_terminate_pid (int pid ATTRIBUTE_UNUSED)
  94 {
  95   return -1;
  96 }
  97
  98 int
  99 __gnat_tty_fd (void* t ATTRIBUTE_UNUSED)
 100 {
 101   return -1;
 102 }
 103
 104 int
 105 __gnat_tty_supported (void)
 106 {
 107   return 0;
 108 }
 109
 110 int
 111 __gnat_tty_waitpid (void *desc ATTRIBUTE_UNUSED, int blocking)
 112 {
 113   return 1;
 114 }
 115
 116 void
 117 __gnat_close_tty (void* t ATTRIBUTE_UNUSED)
 118 {
 119 }
 120
 121 void
 122 __gnat_free_process (void** process ATTRIBUTE_UNUSED)
 123 {
 124 }
 125
 126 void
 127 __gnat_reset_tty (void* t ATTRIBUTE_UNUSED)
 128 {
 129 }
 130
 131 void
 132 __gnat_send_header (void* d ATTRIBUTE_UNUSED,
 133                     char h[5] ATTRIBUTE_UNUSED,
 134                     int s ATTRIBUTE_UNUSED,
 135                     int *r ATTRIBUTE_UNUSED)
 136 {
 137 }
 138
 139 void
 140 __gnat_setup_winsize (void *desc ATTRIBUTE_UNUSED,
 141                       int rows ATTRIBUTE_UNUSED,
 142                       int columns ATTRIBUTE_UNUSED)
 143 {
 144 }
 145
 146 /* For Windows platforms. */
 147
 148 #elif defined(_WIN32)
 149
 150 #include <errno.h>
 151 #include <stdio.h>
 152 #include <stdlib.h>
 153
 154 #define WIN32_LEAN_AND_MEAN
 155 #include <windows.h>
 156 #include <winternl.h>
 157 #include <io.h>
 158
 159 #define MAXPATHLEN 1024
 160
 161 #define NILP(x) ((x) == 0)
 162 #define Qnil 0
 163 #define report_file_error(x, y) fprintf (stderr, "Error: %s\n", x);
 164 #define INTEGERP(x) 1
 165 #define XINT(x) x
 166
 167 struct TTY_Process {
 168   int pid;           /* Number of this process */
 169   PROCESS_INFORMATION procinfo;
 170   HANDLE w_infd, w_outfd;
 171   HANDLE w_forkin, w_forkout;
 172   BOOL usePipe;
 173 };
 174
 175 /* Control whether create_child cause the process to inherit GNAT Studio'
 176    error mode setting.  The default is 1, to minimize the possibility of
 177    subprocesses blocking when accessing unmounted drives.  */
 178 static int Vw32_start_process_inherit_error_mode = 1;
 179
 180 /* Control whether spawnve quotes arguments as necessary to ensure
 181    correct parsing by child process.  Because not all uses of spawnve
 182    are careful about constructing argv arrays, we make this behavior
 183    conditional (off by default, since a similar operation is already done
 184    in g-expect.adb by calling Normalize_Argument). */
 185 static int Vw32_quote_process_args = 0;
 186
 187 static DWORD AbsoluteSeek(HANDLE, DWORD);
 188 static VOID  ReadBytes(HANDLE, LPVOID, DWORD);
 189
 190 #define XFER_BUFFER_SIZE 2048
 191
 192 /* This tell if the executable we're about to launch uses a GUI interface. */
 193 /* if we can't determine it, we will return true */
 194 static int
 195 is_gui_app (char *exe)
 196 {
 197   HANDLE hImage;
 198
 199   DWORD  CoffHeaderOffset;
 200   DWORD  MoreDosHeader[16];
 201   CHAR   *file;
 202   size_t nlen;
 203
 204   ULONG  ntSignature;
 205
 206   IMAGE_DOS_HEADER      image_dos_header;
 207   IMAGE_FILE_HEADER     image_file_header;
 208   IMAGE_OPTIONAL_HEADER image_optional_header;
 209
 210   /*
 211    *  Open the reference file.
 212   */
 213   nlen = strlen (exe);
 214   file = exe;
 215   if (nlen > 2) {
 216     if (exe[0] == '"') {
 217       /* remove quotes */
 218       nlen -= 2;
 219       file = malloc ((nlen + 1) * sizeof (char));
 220       memcpy (file, &exe[1], nlen);
 221       file [nlen] = '\0';
 222     }
 223   }
 224   hImage = CreateFile(file,
 225                       GENERIC_READ,
 226                       FILE_SHARE_READ,
 227                       NULL,
 228                       OPEN_EXISTING,
 229                       FILE_ATTRIBUTE_NORMAL,
 230                       NULL);
 231
 232   if (file != exe) {
 233     free (file);
 234   }
 235
 236   if (INVALID_HANDLE_VALUE == hImage)
 237     {
 238       report_file_error ("Could not open exe: ", Qnil);
 239       report_file_error (exe, Qnil);
 240       report_file_error ("\n", Qnil);
 241       CloseHandle (hImage);
 242       return -1;
 243     }
 244
 245   /*
 246    *  Read the MS-DOS image header.
 247    */
 248   ReadBytes(hImage, &image_dos_header, sizeof(IMAGE_DOS_HEADER));
 249
 250   if (IMAGE_DOS_SIGNATURE != image_dos_header.e_magic)
 251     {
 252       report_file_error("Sorry, I do not understand this file.\n", Qnil);
 253       CloseHandle (hImage);
 254       return -1;
 255     }
 256
 257   /*
 258    *  Read more MS-DOS header.       */
 259   ReadBytes(hImage, MoreDosHeader, sizeof(MoreDosHeader));
 260    /*
 261    *  Get actual COFF header.
 262    */
 263   CoffHeaderOffset = AbsoluteSeek(hImage, image_dos_header.e_lfanew) +
 264                      sizeof(ULONG);
 265   if (CoffHeaderOffset == (DWORD) -1) {
 266     CloseHandle (hImage);
 267     return -1;
 268   }
 269
 270   ReadBytes (hImage, &ntSignature, sizeof(ULONG));
 271
 272   if (IMAGE_NT_SIGNATURE != ntSignature)
 273     {
 274       report_file_error ("Missing NT signature. Unknown file type.\n", Qnil);
 275       CloseHandle (hImage);
 276       return -1;
 277     }
 278
 279   ReadBytes(hImage, &image_file_header, IMAGE_SIZEOF_FILE_HEADER);
 280
 281   /*
 282    *  Read optional header.
 283    */
 284   ReadBytes(hImage,
 285             &image_optional_header,
 286             IMAGE_SIZEOF_NT_OPTIONAL_HEADER);
 287
 288   CloseHandle (hImage);
 289
 290   switch (image_optional_header.Subsystem)
 291     {
 292     case IMAGE_SUBSYSTEM_UNKNOWN:
 293         return 1;
 294
 295     case IMAGE_SUBSYSTEM_NATIVE:
 296         return 1;
 297
 298     case IMAGE_SUBSYSTEM_WINDOWS_GUI:
 299         return 1;
 300
 301     case IMAGE_SUBSYSTEM_WINDOWS_CUI:
 302         return 0;
 303
 304     case IMAGE_SUBSYSTEM_OS2_CUI:
 305         return 0;
 306
 307     case IMAGE_SUBSYSTEM_POSIX_CUI:
 308         return 0;
 309
 310     default:
 311         /* Unknown, return GUI app to be preservative: if yes, it will be
 312            correctly launched, if no, it will be launched, and a console will
 313            be also displayed, which is not a big deal */
 314         return 1;
 315     }
 316
 317 }
 318
 319 static DWORD
 320 AbsoluteSeek (HANDLE hFile, DWORD offset)
 321 {
 322     DWORD newOffset;
 323
 324     newOffset = SetFilePointer (hFile, offset, NULL, FILE_BEGIN);
 325
 326     if (newOffset == 0xFFFFFFFF)
 327       return -1;
 328     else
 329       return newOffset;
 330 }
 331
 332 static VOID
 333 ReadBytes (HANDLE hFile, LPVOID buffer, DWORD size)
 334 {
 335   DWORD bytes;
 336
 337   if (!ReadFile(hFile, buffer, size, &bytes, NULL))
 338     {
 339       size = 0;
 340       return;
 341     }
 342   else if (size != bytes)
 343     {
 344       return;
 345     }
 346 }
 347
 348 static int
 349 nt_spawnve (char *exe ATTRIBUTE_UNUSED, char **argv, char *env,
 350             struct TTY_Process *process)
 351 {
 352   STARTUPINFO start;
 353   SECURITY_ATTRIBUTES sec_attrs;
 354   SECURITY_DESCRIPTOR sec_desc;
 355   DWORD flags;
 356   int pid;
 357   int is_gui, use_cmd;
 358   char *cmdline, *parg, **targ;
 359   int do_quoting = 0;
 360   char escape_char = 0;
 361   int arglen;
 362
 363   /* we have to do some conjuring here to put argv and envp into the
 364      form CreateProcess wants...  argv needs to be a space separated/null
 365      terminated list of parameters, and envp is a null
 366      separated/double-null terminated list of parameters.
 367
 368      Additionally, zero-length args and args containing whitespace or
 369      quote chars need to be wrapped in double quotes - for this to work,
 370      embedded quotes need to be escaped as well.  The aim is to ensure
 371      the child process reconstructs the argv array we start with
 372      exactly, so we treat quotes at the beginning and end of arguments
 373      as embedded quotes.
 374
 375      Note that using backslash to escape embedded quotes requires
 376      additional special handling if an embedded quote is already
 377      preceded by backslash, or if an arg requiring quoting ends with
 378      backslash.  In such cases, the run of escape characters needs to be
 379      doubled.  For consistency, we apply this special handling as long
 380      as the escape character is not quote.
 381
 382      Since we have no idea how large argv and envp are likely to be we
 383      figure out list lengths on the fly and allocate them.  */
 384
 385   if (!NILP (Vw32_quote_process_args))
 386     {
 387       do_quoting = 1;
 388       /* Override escape char by binding w32-quote-process-args to
 389          desired character, or use t for auto-selection.  */
 390       if (INTEGERP (Vw32_quote_process_args))
 391         escape_char = XINT (Vw32_quote_process_args);
 392       else
 393         escape_char = '\\';
 394     }
 395
 396   /* do argv...  */
 397   arglen = 0;
 398   targ = argv;
 399   while (*targ)
 400     {
 401       char *p = *targ;
 402       int need_quotes = 0;
 403       int escape_char_run = 0;
 404
 405       if (*p == 0)
 406         need_quotes = 1;
 407       for ( ; *p; p++)
 408         {
 409           if (*p == '"')
 410             {
 411               /* allow for embedded quotes to be escaped */
 412               arglen++;
 413               need_quotes = 1;
 414               /* handle the case where the embedded quote is already escaped */
 415               if (escape_char_run > 0)
 416                 {
 417                   /* To preserve the arg exactly, we need to double the
 418                      preceding escape characters (plus adding one to
 419                      escape the quote character itself).  */
 420                   arglen += escape_char_run;
 421                 }
 422             }
 423           else if (*p == ' ' || *p == '\t')
 424             {
 425               need_quotes = 1;
 426             }
 427
 428           if (*p == escape_char && escape_char != '"')
 429             escape_char_run++;
 430           else
 431             escape_char_run = 0;
 432         }
 433       if (need_quotes)
 434         {
 435           arglen += 2;
 436           /* handle the case where the arg ends with an escape char - we
 437              must not let the enclosing quote be escaped.  */
 438           if (escape_char_run > 0)
 439             arglen += escape_char_run;
 440         }
 441       arglen += strlen (*targ) + 1;
 442       targ++;
 443     }
 444
 445   is_gui = is_gui_app (argv[0]);
 446   use_cmd = FALSE;
 447
 448   if (is_gui == -1) {
 449     /* could not determine application type. Try launching with "cmd /c" */
 450     is_gui = FALSE;
 451     arglen += 7;
 452     use_cmd = TRUE;
 453   }
 454
 455   cmdline = (char*)malloc (arglen + 1);
 456   targ = argv;
 457   parg = cmdline;
 458
 459   if (use_cmd == TRUE) {
 460     strcpy (parg, "cmd /c ");
 461     parg += 7;
 462   }
 463
 464   while (*targ)
 465     {
 466       char * p = *targ;
 467       int need_quotes = 0;
 468
 469       if (*p == 0)
 470         need_quotes = 1;
 471
 472       if (do_quoting)
 473         {
 474           for ( ; *p; p++)
 475             if (*p == ' ' || *p == '\t' || *p == '"')
 476               need_quotes = 1;
 477         }
 478       if (need_quotes)
 479         {
 480           int escape_char_run = 0;
 481
 482           p = *targ;
 483           *parg++ = '"';
 484           for ( ; *p; p++)
 485             {
 486               if (*p == '"')
 487                 {
 488                   /* double preceding escape chars if any */
 489                   while (escape_char_run > 0)
 490                     {
 491                       *parg++ = escape_char;
 492                       escape_char_run--;
 493                     }
 494                   /* escape all quote chars, even at beginning or end */
 495                   *parg++ = escape_char;
 496                 }
 497               *parg++ = *p;
 498
 499               if (*p == escape_char && escape_char != '"')
 500                 escape_char_run++;
 501               else
 502                 escape_char_run = 0;
 503             }
 504           /* double escape chars before enclosing quote */
 505           while (escape_char_run > 0)
 506             {
 507               *parg++ = escape_char;
 508               escape_char_run--;
 509             }
 510           *parg++ = '"';
 511         }
 512       else
 513         {
 514           strcpy (parg, *targ);
 515           parg += strlen (*targ);
 516         }
 517       *parg++ = ' ';
 518       targ++;
 519     }
 520   *--parg = '\0';
 521
 522   memset (&start, 0, sizeof (start));
 523   start.cb = sizeof (start);
 524
 525   if (process->usePipe == TRUE) {
 526     start.dwFlags = STARTF_USESTDHANDLES;
 527     start.hStdInput = process->w_forkin;
 528     start.hStdOutput = process->w_forkout;
 529     /* child's stderr is always redirected to outfd */
 530     start.hStdError = process->w_forkout;
 531   } else {
 532     start.dwFlags = STARTF_USESTDHANDLES;
 533     /* We only need to redirect stderr/stdout here. Stdin will be forced to
 534        the spawned process console by explaunch */
 535     start.hStdInput = NULL;
 536     start.hStdOutput = process->w_forkout;
 537     start.hStdError = process->w_forkout;
 538   }
 539
 540   /* Explicitly specify no security */
 541   if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
 542     goto EH_Fail;
 543   if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
 544     goto EH_Fail;
 545   sec_attrs.nLength = sizeof (sec_attrs);
 546   sec_attrs.lpSecurityDescriptor = &sec_desc;
 547   sec_attrs.bInheritHandle = FALSE;
 548
 549   /* creating a new console allow easier close. Do not use
 550      CREATE_NEW_PROCESS_GROUP as this results in disabling Ctrl+C */
 551   flags = CREATE_NEW_CONSOLE;
 552   if (NILP (Vw32_start_process_inherit_error_mode))
 553     flags |= CREATE_DEFAULT_ERROR_MODE;
 554
 555   /* if app is not a gui application, hide the console */
 556   if (is_gui == FALSE) {
 557     start.dwFlags |= STARTF_USESHOWWINDOW;
 558     start.wShowWindow = SW_HIDE;
 559   }
 560
 561   /* Set initial directory to null character to use current directory */
 562   if (!CreateProcess (NULL, cmdline, &sec_attrs, NULL, TRUE,
 563                       flags, env, NULL, &start, &process->procinfo))
 564     goto EH_Fail;
 565
 566   pid = (int) (intptr_t) process->procinfo.hProcess;
 567   process->pid = pid;
 568
 569   return pid;
 570
 571  EH_Fail:
 572   return -1;
 573 }
 574
 575 /*************************
 576  ** __gnat_send_header ()
 577  *************************/
 578
 579 #define EXP_SLAVE_CREATE 'c'
 580 #define EXP_SLAVE_KEY    'k'
 581 #define EXP_SLAVE_MOUSE  'm'
 582 #define EXP_SLAVE_WRITE  'w'
 583 #define EXP_SLAVE_KILL   'x'
 584
 585 #define EXP_KILL_TERMINATE  0x1
 586 #define EXP_KILL_CTRL_C     0x2
 587 #define EXP_KILL_CTRL_BREAK 0x4
 588
 589 void
 590 __gnat_send_header (struct TTY_Process* p, char header[5], int size, int *ret)
 591 {
 592   if (p->usePipe == FALSE) {
 593     header[0] = EXP_SLAVE_WRITE;
 594     header[1] = size & 0xff;
 595     header[2] = (size & 0xff00) >> 8;
 596     header[3] = (size & 0xff0000) >> 16;
 597     header[4] = (size & 0xff000000) >> 24;
 598     *ret = 1;
 599   } else {
 600     *ret = 0;
 601   }
 602 }
 603
 604 /**********************************
 605  **  __gnat_setup_communication ()
 606  **********************************/
 607
 608 int
 609 __gnat_setup_communication (struct TTY_Process** process_out) /* output param */
 610 {
 611   struct TTY_Process* process;
 612
 613   process = (struct TTY_Process*)malloc (sizeof (struct TTY_Process));
 614   ZeroMemory (process, sizeof (struct TTY_Process));
 615   *process_out = process;
 616
 617   return 0;
 618 }
 619
 620 #define EXP_PIPE_BASENAME "\\\\.\\pipe\\ExpectPipe"
 621
 622 int
 623 __gnat_setup_child_communication
 624   (struct TTY_Process* process,
 625    char** argv,
 626    int Use_Pipes)
 627 {
 628   int cpid;
 629   SECURITY_ATTRIBUTES sec_attrs;
 630   char slavePath [MAX_PATH];
 631   char **nargv;
 632   int argc;
 633   int i;
 634   char pipeNameIn[100];
 635   HANDLE hSlaveInDrv = NULL; /* Handle to communicate with slave driver */
 636
 637   /* Set inheritance for the pipe handles */
 638   sec_attrs.nLength = sizeof (SECURITY_ATTRIBUTES);
 639   sec_attrs.bInheritHandle = TRUE;
 640   sec_attrs.lpSecurityDescriptor = NULL;
 641
 642   if (Use_Pipes) {
 643     /* Create in and out pipes */
 644     if (!CreatePipe (&process->w_forkin, &process->w_infd, &sec_attrs, 0))
 645       report_file_error ("Creation of child's IN handle", Qnil);
 646     if (!CreatePipe (&process->w_outfd, &process->w_forkout, &sec_attrs, 0))
 647       report_file_error ("Creation of child's OUT handle", Qnil);
 648
 649     /* Do not inherit the parent's side of the pipes */
 650     SetHandleInformation (&process->w_infd, HANDLE_FLAG_INHERIT, 0);
 651     SetHandleInformation (&process->w_outfd, HANDLE_FLAG_INHERIT, 0);
 652
 653     /* use native argv */
 654     nargv = argv;
 655     process->usePipe = TRUE;
 656
 657   } else {
 658     static int pipeNameId = 0;
 659
 660     process->w_infd = NULL;
 661
 662     /* We create a named pipe for Input, as we handle input by sending special
 663        commands to the explaunch process, that uses it to feed the actual input
 664        of the process */
 665     sprintf(pipeNameIn, "%sIn%08lx_%08x", EXP_PIPE_BASENAME,
 666             GetCurrentProcessId(), pipeNameId);
 667     pipeNameId++;
 668
 669     hSlaveInDrv = CreateNamedPipe(pipeNameIn,
 670                                   PIPE_ACCESS_OUTBOUND,
 671                                   PIPE_TYPE_BYTE | PIPE_WAIT, 1, 8192, 8192,
 672                                   20000, NULL);
 673     if (hSlaveInDrv == NULL)  goto end;
 674
 675     if (!CreatePipe (&process->w_outfd, &process->w_forkout, &sec_attrs, 0))
 676       report_file_error ("Creation of child's OUT handle", Qnil);
 677
 678     if (SearchPath (NULL, "explaunch.exe", NULL,
 679                     MAX_PATH, slavePath, NULL) == 0) goto end;
 680
 681     for (argc=0; argv[argc] != NULL; argc++) ;
 682     nargv = (char **) malloc (sizeof (char*) * (argc + 3));
 683     nargv[0] = slavePath;
 684     nargv[1] = pipeNameIn;
 685
 686     for (i = 0; i <= argc; i++) nargv[i + 2] = argv[i];
 687     process->usePipe = FALSE;
 688   }
 689
 690   /* Spawn the child. */
 691   cpid = nt_spawnve (nargv[0], nargv, NULL, process);
 692
 693   /* close the duplicated handles passed to the child */
 694   CloseHandle (process->w_forkout);
 695
 696   if (process->usePipe == TRUE) {
 697     CloseHandle (process->w_forkin);
 698
 699   } else {
 700     UCHAR buf[8];               /* enough space for child status info */
 701     DWORD count;
 702     BOOL bRet;
 703     DWORD dwRet;
 704
 705     /*
 706      * Wait for connection with the slave driver
 707      */
 708     bRet = ConnectNamedPipe(hSlaveInDrv, NULL);
 709     if (bRet == FALSE) {
 710       dwRet = GetLastError();
 711       if (dwRet == ERROR_PIPE_CONNECTED) {
 712         ;
 713       } else {
 714         goto end;
 715       }
 716     }
 717
 718     process->w_infd = hSlaveInDrv;
 719
 720     /*
 721      * wait for slave driver to initialize before allowing user to send to it
 722      */
 723     bRet = ReadFile(process->w_outfd, buf, 8, &count, NULL);
 724     if (bRet == FALSE) {
 725       cpid = -1;
 726     }
 727
 728     dwRet = buf[0] | (buf[1] << 8) | (buf[2] << 16) | (buf[3] << 24);
 729     if (dwRet != 0) {
 730       cpid = -1;
 731     }
 732
 733     cpid = buf[4] | (buf[5] << 8) | (buf[6] << 16) | (buf[7] << 24);
 734     process->pid = cpid;
 735   }
 736
 737   if (cpid == -1)
 738     /* An error occurred while trying to spawn the process.  */
 739     report_file_error ("Spawning child process", Qnil);
 740
 741   return cpid;
 742  end:
 743   if (hSlaveInDrv != NULL)
 744     CloseHandle (hSlaveInDrv);
 745   return -1;
 746 }
 747
 748 void
 749 __gnat_setup_parent_communication
 750   (struct TTY_Process* process,
 751    int* in,
 752    int* out,
 753    int* err,
 754    int* pid)
 755 {
 756   *in = _open_osfhandle ((intptr_t) process->w_infd, 0);
 757   *out = _open_osfhandle ((intptr_t) process->w_outfd, 0);
 758   /* child's stderr is always redirected to outfd */
 759   *err = *out;
 760   *pid = process->pid;
 761 }
 762
 763 typedef struct _child_process
 764 {
 765   HWND                 hwnd;
 766   PROCESS_INFORMATION *procinfo;
 767 } child_process;
 768
 769 /* The major and minor versions of NT.  */
 770 static int w32_major_version;
 771 static int w32_minor_version;
 772
 773 /* Distinguish between Windows NT and Windows 95.  */
 774 static enum {OS_UNKNOWN, OS_WIN95, OS_NT} os_subtype = OS_UNKNOWN;
 775
 776 /* Cache information describing the NT system for later use.  */
 777 static void
 778 cache_system_info (void)
 779 {
 780   union
 781     {
 782       struct info
 783         {
 784           char  major;
 785           char  minor;
 786           short platform;
 787         } info;
 788       DWORD data;
 789     } version;
 790
 791   /* Cache the version of the operating system.  */
 792   version.data = GetVersion ();
 793   w32_major_version = version.info.major;
 794   w32_minor_version = version.info.minor;
 795
 796   if (version.info.platform & 0x8000)
 797     os_subtype = OS_WIN95;
 798   else
 799     os_subtype = OS_NT;
 800 }
 801
 802 static WINBOOL CALLBACK
 803 find_child_console (HWND hwnd, LPARAM param)
 804 {
 805   child_process *cp = (child_process *) param;
 806   DWORD process_id;
 807
 808   (void) GetWindowThreadProcessId (hwnd, &process_id);
 809   if (process_id == cp->procinfo->dwProcessId)
 810     {
 811       char window_class[32];
 812
 813       GetClassName (hwnd, window_class, sizeof (window_class));
 814       if (strcmp (window_class,
 815                   (os_subtype == OS_WIN95)
 816                   ? "tty"
 817                   : "ConsoleWindowClass") == 0)
 818         {
 819           cp->hwnd = hwnd;
 820           return FALSE;
 821         }
 822     }
 823   /* keep looking */
 824   return TRUE;
 825 }
 826
 827 int
 828 __gnat_interrupt_pid (int pid)
 829 {
 830   volatile child_process cp;
 831   int rc = 0;
 832
 833   cp.procinfo = (LPPROCESS_INFORMATION) malloc (sizeof (PROCESS_INFORMATION));
 834   cp.procinfo->dwProcessId = pid;
 835
 836   if (os_subtype == OS_UNKNOWN)
 837     cache_system_info ();
 838
 839   /* Try to locate console window for process. */
 840   EnumWindows ((WNDENUMPROC) find_child_console, (LPARAM) &cp);
 841
 842   if (cp.hwnd)
 843     {
 844       BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
 845       /* Retrieve Ctrl-C scancode */
 846       BYTE vk_break_code = 'C';
 847       BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
 848       HWND foreground_window;
 849
 850       foreground_window = GetForegroundWindow ();
 851       if (foreground_window)
 852         {
 853           /* NT 5.0, and apparently also Windows 98, will not allow
 854              a Window to be set to foreground directly without the
 855              user's involvement. The workaround is to attach
 856              ourselves to the thread that owns the foreground
 857              window, since that is the only thread that can set the
 858              foreground window.  */
 859           DWORD foreground_thread, child_thread;
 860
 861           foreground_thread =
 862             GetWindowThreadProcessId (foreground_window, NULL);
 863           if (foreground_thread == GetCurrentThreadId ()
 864               || !AttachThreadInput (GetCurrentThreadId (),
 865                                      foreground_thread, TRUE))
 866             foreground_thread = 0;
 867
 868           child_thread = GetWindowThreadProcessId (cp.hwnd, NULL);
 869           if (child_thread == GetCurrentThreadId ()
 870               || !AttachThreadInput (GetCurrentThreadId (),
 871                                      child_thread, TRUE))
 872             child_thread = 0;
 873
 874           /* Set the foreground window to the child.  */
 875           if (SetForegroundWindow (cp.hwnd))
 876             {
 877               /* Generate keystrokes as if user had typed Ctrl-Break or
 878                  Ctrl-C.  */
 879               keybd_event (VK_CONTROL, control_scan_code, 0, 0);
 880               keybd_event (vk_break_code, break_scan_code,
 881                 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
 882               keybd_event (vk_break_code, break_scan_code,
 883                 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
 884                  | KEYEVENTF_KEYUP, 0);
 885               keybd_event (VK_CONTROL, control_scan_code, KEYEVENTF_KEYUP, 0);
 886
 887               /* Sleep for a bit to give time for the main frame to respond
 888               to focus change events.  */
 889               Sleep (100);
 890
 891               SetForegroundWindow (foreground_window);
 892             }
 893           /* Detach from the foreground and child threads now that
 894              the foreground switching is over.  */
 895           if (foreground_thread)
 896             AttachThreadInput (GetCurrentThreadId (), foreground_thread, FALSE);
 897           if (child_thread)
 898             AttachThreadInput (GetCurrentThreadId (), child_thread, FALSE);
 899         }
 900     }
 901   /* Ctrl-Break is NT equivalent of SIGINT.  */
 902   else if (!GenerateConsoleCtrlEvent
 903              (CTRL_BREAK_EVENT, cp.procinfo->dwProcessId))
 904     {
 905       errno = EINVAL;
 906       rc = -1;
 907     }
 908
 909   free (cp.procinfo);
 910   return rc;
 911 }
 912
 913 int
 914 __gnat_interrupt_process (struct TTY_Process* p)
 915 {
 916   char buf[2];
 917   DWORD written;
 918   BOOL bret;
 919
 920   if (p->usePipe == TRUE) {
 921     bret = FALSE;
 922   } else {
 923     buf[0] = EXP_SLAVE_KILL;
 924     buf[1] = EXP_KILL_CTRL_C;
 925     bret = WriteFile (p->w_infd, buf, 2, &written, NULL);
 926   }
 927
 928   if (bret == FALSE) {
 929     return __gnat_interrupt_pid (p->procinfo.dwProcessId);
 930   }
 931   return 0;
 932 }
 933
 934 /* kill a process, as this implementation use CreateProcess on Win32 we need
 935    to use Win32 TerminateProcess API */
 936 int
 937 __gnat_terminate_process (struct TTY_Process* p)
 938 {
 939   char buf[2];
 940   DWORD written;
 941   BOOL bret;
 942
 943   if (p->usePipe == TRUE) {
 944     bret = FALSE;
 945   } else {
 946     buf[0] = EXP_SLAVE_KILL;
 947     buf[1] = EXP_KILL_TERMINATE;
 948     bret = WriteFile (p->w_infd, buf, 2, &written, NULL);
 949   }
 950
 951   if (bret == FALSE) {
 952     if (!TerminateProcess (p->procinfo.hProcess, 1))
 953       return -1;
 954     else
 955       return 0;
 956   } else
 957     return 0;
 958 }
 959
 960 typedef struct {
 961   DWORD dwProcessId;
 962   HANDLE hwnd;
 963 } pid_struct;
 964
 965 static WINBOOL CALLBACK
 966 find_process_handle (HWND hwnd, LPARAM param)
 967 {
 968   pid_struct *ps = (pid_struct *) param;
 969   DWORD process_id;
 970
 971   (void) GetWindowThreadProcessId (hwnd, &process_id);
 972   if (process_id == ps->dwProcessId)
 973     {
 974       ps->hwnd = hwnd;
 975       return FALSE;
 976     }
 977   /* keep looking */
 978   return TRUE;
 979 }
 980
 981 int
 982 __gnat_terminate_pid (int pid)
 983 {
 984   pid_struct ps;
 985
 986   ps.dwProcessId = pid;
 987   ps.hwnd = 0;
 988   EnumWindows ((WNDENUMPROC) find_process_handle, (LPARAM) &ps);
 989
 990   if (ps.hwnd)
 991     {
 992       if (!TerminateProcess (ps.hwnd, 1))
 993         return -1;
 994       else
 995         return 0;
 996     }
 997
 998   return -1;
 999 }
1000
1001 /* wait for process pid to terminate and return the process status. This
1002    implementation is different from the adaint.c one for Windows as it uses
1003    the Win32 API instead of the C one. */
1004
1005 int
1006 __gnat_tty_waitpid (struct TTY_Process* p, int blocking)
1007 {
1008   DWORD exitcode;
1009   HANDLE hprocess = p->procinfo.hProcess;
1010
1011   if (blocking) {
1012      /* Wait is needed on Windows only in blocking mode. */
1013      WaitForSingleObject (hprocess, 0);
1014   }
1015
1016   GetExitCodeProcess (hprocess, &exitcode);
1017
1018   if (exitcode == STILL_ACTIVE) {
1019      /* If process is still active return -1. */
1020      exitcode = -1;
1021   } else {
1022      /* Process is dead, so handle to process and main thread can be closed. */
1023      CloseHandle (p->procinfo.hThread);
1024      CloseHandle (hprocess);
1025   }
1026
1027   /* No need to close the handles: they were closed on the ada side */
1028   return (int) exitcode;
1029 }
1030
1031 /********************************
1032  **  __gnat_free_process ()
1033  ********************************/
1034
1035 void
1036 __gnat_free_process (struct TTY_Process** process)
1037 {
1038   free (*process);
1039   *process = NULL;
1040 }
1041
1042 /* TTY handling */
1043
1044 typedef struct {
1045   int tty_fd;        /* descriptor for the tty */
1046   char tty_name[24]; /* Name of TTY device */
1047 } TTY_Handle;
1048
1049 int
1050 __gnat_tty_supported (void)
1051 {
1052   return 0;
1053 }
1054
1055 /* Return the tty name associated with p */
1056
1057 char *
1058 __gnat_tty_name (TTY_Handle* t)
1059 {
1060   return t->tty_name;
1061 }
1062
1063 int
1064 __gnat_tty_fd (TTY_Handle* t)
1065 {
1066   return t->tty_fd;
1067 }
1068
1069 TTY_Handle*
1070 __gnat_new_tty (void)
1071 {
1072   return (TTY_Handle*)0;
1073 }
1074
1075 void
1076 __gnat_reset_tty (TTY_Handle* t ATTRIBUTE_UNUSED)
1077 {
1078 }
1079
1080 void
1081 __gnat_close_tty (TTY_Handle* t)
1082 {
1083   free (t);
1084 }
1085
1086 void
1087 __gnat_setup_winsize (void *desc ATTRIBUTE_UNUSED,
1088   int rows ATTRIBUTE_UNUSED, int columns ATTRIBUTE_UNUSED)
1089 {
1090 }
1091
1092 #else /* defined(_WIN32, implementatin for all UNIXes */
1093
1094 /* First defined some macro to identify easily some systems */
1095 #if defined (__FreeBSD__) \
1096  || defined (__OpenBSD__) \
1097  || defined (__NetBSD__)  \
1098  || defined (__DragonFly__)
1099 #   define BSD
1100 #endif
1101
1102 /* Include every system header we need */
1103 #define _GNU_SOURCE
1104 #include <errno.h>
1105 #include <stdio.h>
1106 #include <stdlib.h>
1107 #include <sys/ioctl.h>
1108 #include <termios.h>
1109 #include <fcntl.h>
1110 #include <string.h>
1111 #include <sys/stat.h>
1112 #include <sys/types.h>
1113 #include <sys/wait.h>
1114 #include <unistd.h>
1115 #if defined (__sun__)
1116 #   include <sys/stropts.h>
1117 #endif
1118 #if defined (BSD) || defined (__sun__)
1119 #   include <sys/signal.h>
1120 #endif
1121 #if defined (__hpux__)
1122 #   include <sys/stropts.h>
1123 #endif
1124
1125 #define CDISABLE _POSIX_VDISABLE
1126
1127 /* POSIX does not specify how to open the master side of a terminal.Several
1128    methods are available (system specific):
1129       1- using a cloning device (USE_CLONE_DEVICE)
1130       2- getpt                  (USE_GETPT)
1131       3- openpty                (USE_OPENPTY)
1132
1133    When using the cloning device method, the macro USE_CLONE_DEVICE should
1134    contains a full path to the adequate device.
1135
1136    When a new system is about to be supported, one of the previous macro should
1137    be set otherwise allocate_pty_desc will return an error
1138 */
1139
1140 /* Configurable part */
1141 #if defined (__APPLE__) || defined (BSD)
1142 #define USE_OPENPTY
1143 #elif defined (__linux__)
1144 #define USE_GETPT
1145 #elif defined (__sun__)
1146 #define USE_CLONE_DEVICE "/dev/ptmx"
1147 #elif defined (_AIX)
1148 #define USE_CLONE_DEVICE "/dev/ptc"
1149 #elif defined (__hpux__)
1150 /* On HP-UX we use the streamed version. Using the non streamed version is not
1151    recommanded (through "/dev/ptym/clone"). Indeed it seems that there are
1152    issues to detect process terminations. */
1153 #define USE_CLONE_DEVICE "/dev/ptmx"
1154 #endif
1155
1156 /* structure that holds information about the terminal used and the process
1157    connected on the slave side */
1158 typedef struct pty_desc_struct {
1159    int  master_fd;     /* fd of the master side if the terminal */
1160    int  slave_fd;      /* fd of the slave side */
1161    char slave_name[32];   /* filename of the slave side */
1162    int  child_pid;     /* PID of the child process connected to the slave side
1163                          of the terminal */
1164 } pty_desc;
1165
1166 /* allocate_pty_desc - allocate a pseudo terminal
1167  *
1168  * PARAMETERS
1169  *   out desc  returned pointer to a pty_desc structure containing information
1170  *             about the opened pseudo terminal
1171  * RETURN VALUE
1172  *   -1        if failed
1173  *    0        if ok
1174  * COMMENTS
1175  *   If the function is successful we should have at least the master side fd
1176  *   and the slave side filename. On some system, the slave side will also be
1177  *   opened. If this is not the case the slave side will be open once we are in
1178  *   the child process (note that opening the slave side at this stage will
1179  *   failed...).
1180  */
1181
1182 extern char* ptsname (int);
1183
1184 static int
1185 allocate_pty_desc (pty_desc **desc) {
1186
1187    pty_desc *result;
1188    int  status      =  0;
1189    int  slave_fd    = -1;
1190    int  master_fd   = -1;
1191    char *slave_name = NULL;
1192
1193 #ifdef USE_GETPT
1194   master_fd = getpt ();
1195 #elif defined (USE_OPENPTY)
1196   status = openpty (&master_fd, &slave_fd, NULL, NULL, NULL);
1197 #elif defined (USE_CLONE_DEVICE)
1198   master_fd = open (USE_CLONE_DEVICE, O_RDWR | O_NONBLOCK, 0);
1199 #else
1200   printf ("[error]: terminal support is not configured\n");
1201   return -1;
1202 #endif
1203
1204   /* at this stage we should have the master side fd and status should be 0 */
1205   if (status != 0 || master_fd < 0)
1206     {
1207       /* If this is not the case close all opened files and return -1 */
1208       printf ("[error]: cannot allocate master side of the pty\n");
1209       if (master_fd >= 0) close (master_fd);
1210       if (slave_fd  >= 0) close (slave_fd);
1211       *desc = NULL;
1212       return -1;
1213     }
1214
1215   /* retrieve the file name of the slave side if necessary */
1216   if (slave_name == NULL) slave_name = (char *) ptsname (master_fd);
1217
1218   /* Now we should have slave file name */
1219   if (slave_name == NULL)
1220     {
1221       /* If not the case close any opened file and return - 1 */
1222       printf ("[error]: cannot allocate slave side of the pty\n");
1223       if (master_fd >= 0) close (master_fd);
1224       if (slave_fd  >= 0) close (slave_fd);
1225       *desc = NULL;
1226       return -1;
1227     }
1228
1229 #if !defined(__rtems__)
1230   /* grant access to the slave side */
1231   grantpt (master_fd);
1232   /* unlock the terminal */
1233   unlockpt (master_fd);
1234 #endif
1235
1236   /* set desc and return 0 */
1237   result = malloc (sizeof (pty_desc));
1238   result->master_fd  = master_fd;
1239   result->slave_fd   = slave_fd;
1240   /* the string returned by ptsname or _getpty is a static allocated string. So
1241      we should make a copy */
1242   strncpy (result->slave_name, slave_name, sizeof (result->slave_name) - 1);
1243   result->slave_name[sizeof (result->slave_name) - 1] = '\0';
1244   result->child_pid  = -1;
1245   *desc=result;
1246   return 0;
1247 }
1248
1249 /* some utility macro that make the code of child_setup_tty easier to read */
1250 #define __enable(a, b) ((a) |= (b))
1251 #define __disable(a, b) ((a) &= ~(b))
1252
1253 /* some properties do not exist on all systems. Set their value to 0 in that
1254    case */
1255 #ifndef IUCLC
1256 #define IUCLC 0
1257 #endif
1258 #ifndef OLCUC
1259 #define OLCUC 0
1260 #endif
1261 #ifndef NLDLY
1262 #define NLDLY 0
1263 #define CRDLY 0
1264 #define TABDLY 0
1265 #define BSDLY 0
1266 #define VTDLY 0
1267 #define FFDLY 0
1268 #endif
1269
1270 /* child_setup_tty - set terminal properties
1271  *
1272  * PARAMETERS
1273  *   file descriptor of the slave side of the terminal
1274  *
1275  * RETURN VALUE
1276  *   0 if success, any other value if failed.
1277  *
1278  * COMMENTS
1279  *   None
1280  */
1281 static int
1282 child_setup_tty (int fd)
1283 {
1284   struct termios s;
1285   int    status;
1286
1287   /* Ensure that s is filled with 0.
1288
1289      Note that we avoid using bzero for a few reasons:
1290        - On HP-UX and Sun system, there is a bzero function but with
1291          a different signature, thus making the use of bzero more
1292          complicated on these platforms (we used to define a bzero
1293          macro that rewrote calls to bzero into calls to memset);
1294        - bzero is deprecated (marked as LEGACY in POSIX.1-2001).  */
1295   memset (&s, 0, sizeof (s));
1296
1297   /* Get the current terminal settings */
1298   status = tcgetattr (fd, &s);
1299   if (status != 0) return -1;
1300
1301   /* Adjust input modes */
1302   __disable (s.c_iflag, IUCLC);    /* don't transform to lower case */
1303   __disable (s.c_iflag, ISTRIP);   /* don't delete 8th bit */
1304
1305   /* Adjust output modes */
1306   __enable  (s.c_oflag, OPOST);    /* enable postprocessing */
1307   __disable (s.c_oflag, ONLCR);    /* don't map LF to CR-LF */
1308   __disable (s.c_oflag, NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY);
1309                                    /* disable delays */
1310   __disable (s.c_oflag, OLCUC);    /* don't transform to upper case */
1311
1312   /* Adjust control modes */
1313   s.c_cflag = (s.c_cflag & ~CSIZE) | CS8; /* Don't strip 8th bit */
1314
1315   /* Adjust local modes */
1316   __disable (s.c_lflag, ECHO);     /* disable echo */
1317   __enable  (s.c_lflag, ISIG);     /* enable signals */
1318   __enable  (s.c_lflag, ICANON);   /* erase/kill/eof processing */
1319
1320   /* Adjust control characters */
1321   /* IMPORTANT: we need to ensure that Ctrl-C will trigger an interrupt signal
1322      otherwise send_signal_via_characters will fail */
1323   s.c_cc[VEOF]   = 04;         /* insure that EOF is Control-D */
1324   s.c_cc[VERASE] = CDISABLE;   /* disable erase processing */
1325   s.c_cc[VKILL]  = CDISABLE;   /* disable kill processing */
1326   s.c_cc[VQUIT]  = 28;         /* Control-\ */
1327   s.c_cc[VINTR]  = 03;         /* Control-C */
1328   s.c_cc[VEOL]   = CDISABLE;
1329   s.c_cc[VSUSP]  = 26;         /* Control-Z */
1330
1331   /* push our changes */
1332   status = tcsetattr (fd, TCSADRAIN, &s);
1333   return status;
1334 }
1335
1336 /* __gnat_setup_communication - interface to the external world. Should be
1337  * called before forking. On Unixes this function only call allocate_pty_desc.
1338  * The Windows implementation (in different part of this file) is very
1339  * different.
1340  *
1341  * PARAMETERS
1342  *  out desc   returned pointer to a pty_desc structure
1343  * RETURN VALUE
1344  *  0 if success, -1 otherwise
1345  */
1346 int __gnat_setup_communication (pty_desc** desc) {
1347   return allocate_pty_desc (desc);
1348 }
1349
1350 /* __gnat_setup_parent_communication - interface to the external world. Should
1351  * be called after forking in the parent process
1352  *
1353  * PARAMETERS
1354  *   out in_fd
1355      out out_fd
1356      out err_fd fds corresponding to the parent side of the
1357                 terminal
1358      in pid_out child process pid
1359  * RETRUN VALUE
1360  *  0
1361  */
1362 void
1363 __gnat_setup_parent_communication
1364   (pty_desc *desc,
1365    int*     in_fd,  /* input */
1366    int*     out_fd, /* output */
1367    int*     err_fd, /* error */
1368    int*     pid_out)
1369 {
1370
1371   *in_fd = desc->master_fd;
1372   *out_fd= desc->master_fd;
1373   *err_fd= desc->master_fd;
1374   desc->child_pid = *pid_out;
1375 }
1376
1377 /* __gnat_setup_winsize - Sets up the size of the terminal
1378  * This lets the process know the size of the terminal
1379  */
1380
1381 void __gnat_setup_winsize (pty_desc *desc, int rows, int columns) {
1382 #ifdef TIOCGWINSZ
1383   struct winsize s;
1384   s.ws_row = (unsigned short)rows;
1385   s.ws_col = (unsigned short)columns;
1386   s.ws_xpixel = 0;
1387   s.ws_ypixel = 0;
1388   ioctl (desc->master_fd, TIOCSWINSZ, &s);
1389 #ifdef SIGWINCH
1390   if (desc->child_pid > 0) {
1391      /* Let the process know about the change in size */
1392      kill (desc->child_pid, SIGWINCH);
1393   }
1394 #endif
1395 #endif
1396 }
1397
1398 /* __gnat_setup_child_communication - interface to external world. Should be
1399  * called after forking in the child process. On Unixes, this function
1400  * first adjust the line setting, set standard output, input and error and
1401  * then spawn the program.
1402  *
1403  * PARAMETERS
1404  *   desc      a pty_desc structure containing the pty parameters
1405  *   new_argv  argv of the program to be spawned
1406  * RETURN VALUE
1407  *   this function should not return
1408  */
1409 int
1410 __gnat_setup_child_communication
1411    (pty_desc *desc,
1412     char **new_argv,
1413     int Use_Pipes ATTRIBUTE_UNUSED)
1414 {
1415   int status;
1416   int pid = getpid ();
1417
1418   setsid ();
1419
1420   /* open the slave side of the terminal if necessary */
1421   if (desc->slave_fd == -1)
1422 #if defined (_AIX)
1423     /* On AIX, if the slave process is not opened with O_NDELAY or O_NONBLOCK
1424        then we might have some processes hanging on I/O system calls. Not sure
1425        we can do that for all platforms so do it only on AIX for the moment.
1426        On AIX O_NONBLOCK and O_NDELAY have slightly different meanings. When
1427        reading on the slave fd, in case there is no data available, if O_NDELAY
1428        is set then 0 is returned. If O_NON_BLOCK is -1 is returned. It seems
1429        that interactive programs such as GDB prefer the O_NDELAY behavior.
1430        We chose O_NONBLOCK because it allows us to make the distinction
1431        between a true EOF and an EOF returned because there is no data
1432        available to be read.  */
1433     desc->slave_fd = open (desc->slave_name, O_RDWR | O_NONBLOCK, 0);
1434 #else
1435     desc->slave_fd = open (desc->slave_name, O_RDWR, 0);
1436 #endif
1437
1438 #if defined (__sun__) || defined (__hpux__)
1439   /* On systems such as Solaris we are using stream. We need to push the right
1440      "modules" in order to get the expected terminal behaviors. Otherwise
1441      functionalities such as termios are not available.  */
1442   ioctl (desc->slave_fd, I_PUSH, "ptem");
1443   ioctl (desc->slave_fd, I_PUSH, "ldterm");
1444   ioctl (desc->slave_fd, I_PUSH, "ttcompat");
1445 #endif
1446
1447 #ifdef TIOCSCTTY
1448   /* make the tty the controlling terminal */
1449   if ((status = ioctl (desc->slave_fd, TIOCSCTTY, 0)) == -1)
1450     _exit (1);
1451 #endif
1452
1453   /* adjust tty settings */
1454   child_setup_tty (desc->slave_fd);
1455   __gnat_setup_winsize (desc, 24, 80); /* To prevent errors in some shells */
1456
1457   /* stdin, stdout and stderr should be now our tty */
1458   dup2 (desc->slave_fd, 0);
1459   dup2 (desc->slave_fd, 1);
1460   dup2 (desc->slave_fd, 2);
1461   if (desc->slave_fd > 2) close (desc->slave_fd);
1462
1463   /* adjust process group settings */
1464   /* ignore failures of the following two commands as the context might not
1465    * allow making those changes. */
1466   setpgid (pid, pid);
1467   tcsetpgrp (0, pid);
1468
1469   /* launch the program */
1470   execvp (new_argv[0], new_argv);
1471
1472   _exit (1);
1473 }
1474
1475 /* send_signal_via_characters - Send a characters that will trigger a signal
1476  * in the child process.
1477  *
1478  * PARAMETERS
1479  *  desc  a pty_desc structure containing terminal information
1480  *  int   a signal number
1481  * RETURN VALUE
1482  *  None
1483  */
1484 static void
1485 send_signal_via_characters
1486   (pty_desc *desc,
1487    int signal_number)
1488 {
1489   char ctrl_c         = 03;
1490   char ctrl_backslash = 28;
1491   char ctrl_Z         = 26;
1492
1493   switch (signal_number)
1494     {
1495       case SIGINT:
1496         write (desc->master_fd, &ctrl_c, 1); return;
1497       case SIGQUIT:
1498         write (desc->master_fd, &ctrl_backslash, 1); return;
1499       case SIGTSTP:
1500         write (desc->master_fd, &ctrl_Z, 1); return;
1501     }
1502 }
1503
1504 /* __gnat_interrupt_process - interrupt the child process
1505  *
1506  * PARAMETERS
1507  *   desc a pty_desc structure
1508  */
1509 int
1510 __gnat_interrupt_process (pty_desc *desc)
1511 {
1512   send_signal_via_characters (desc, SIGINT);
1513   return 0;
1514 }
1515
1516 /* __gnat_interrupt_pid - interrupt a process group
1517  *
1518  * PARAMETERS
1519  *   pid  pid of the process to interrupt
1520  */
1521 int
1522 __gnat_interrupt_pid (int pid)
1523 {
1524   kill (-pid, SIGINT);
1525   return 0;
1526 }
1527
1528 /* __gnat_terminate_process - kill a child process
1529  *
1530  * PARAMETERS
1531  *   desc pty_desc structure
1532  */
1533 int __gnat_terminate_process (pty_desc *desc)
1534 {
1535   return kill (desc->child_pid, SIGKILL);
1536 }
1537
1538 /* __gnat_terminate_pid - kill a process
1539  *
1540  * PARAMETERS
1541  *   pid unix process id
1542  */
1543 int
1544 __gnat_terminate_pid (int pid)
1545 {
1546   return kill (pid, SIGKILL);
1547 }
1548
1549 /* __gnat_tty_waitpid - wait for the child process to die
1550  *
1551  * PARAMETERS
1552  *   desc pty_desc structure
1553  * RETURN VALUE
1554  *   exit status of the child process
1555  */
1556 int
1557 __gnat_tty_waitpid (pty_desc *desc, int blocking)
1558 {
1559   int status = -1;
1560   int options = 0;
1561
1562   if (blocking) {
1563      options = 0;
1564   } else {
1565      options = WNOHANG;
1566   }
1567   waitpid (desc->child_pid, &status, options);
1568   if WIFEXITED (status) {
1569      status = WEXITSTATUS (status);
1570   }
1571   return status;
1572 }
1573
1574 /* __gnat_tty_supported - Are tty supported ?
1575  *
1576  * RETURN VALUE
1577  *   always 1 on Unix systems
1578  */
1579 int
1580 __gnat_tty_supported (void)
1581 {
1582   return 1;
1583 }
1584
1585 /* __gnat_free_process - free a pty_desc structure
1586  *
1587  * PARAMETERS
1588  *   in out desc: a pty desc structure
1589  */
1590 void
1591 __gnat_free_process (pty_desc** desc)
1592 {
1593   free (*desc);
1594   *desc = NULL;
1595 }
1596
1597 /* __gnat_send_header - dummy function. this interface is only used on Windows */
1598 void
1599 __gnat_send_header (pty_desc* desc ATTRIBUTE_UNUSED,
1600                     char header[5] ATTRIBUTE_UNUSED,
1601                     int size ATTRIBUTE_UNUSED,
1602                     int *ret ATTRIBUTE_UNUSED)
1603 {
1604   *ret = 0;
1605 }
1606
1607 /* __gnat_reset_tty - reset line setting
1608  *
1609  * PARAMETERS
1610  *   desc: a pty_desc structure
1611  */
1612 void
1613 __gnat_reset_tty (pty_desc* desc)
1614 {
1615   child_setup_tty (desc->master_fd);
1616 }
1617
1618 /* __gnat_new_tty - allocate a new terminal
1619  *
1620  * RETURN VALUE
1621  *   a pty_desc structure
1622  */
1623 pty_desc *
1624 __gnat_new_tty (void)
1625 {
1626   int status;
1627   pty_desc* desc = NULL;
1628   if ((status = allocate_pty_desc (&desc)))
1629     child_setup_tty (desc->master_fd);
1630   return desc;
1631 }
1632
1633 /* __gnat_close_tty - close a terminal
1634  *
1635  * PARAMETERS
1636  *   desc  a pty_desc strucure
1637  */
1638 void __gnat_close_tty (pty_desc* desc)
1639 {
1640   if (desc->master_fd >= 0) { close (desc->master_fd); desc->master_fd = -1; }
1641   if (desc->slave_fd  >= 0) { close (desc->slave_fd);  desc->slave_fd  = -1; }
1642 }
1643
1644 /* __gnat_tty_name - return slave side device name
1645  *
1646  * PARAMETERS
1647  *   desc  a pty_desc strucure
1648  * RETURN VALUE
1649  *   a string
1650  */
1651 char *
1652 __gnat_tty_name (pty_desc* desc)
1653 {
1654   return desc->slave_name;
1655 }
1656
1657 /* __gnat_tty_name - return master side fd
1658  *
1659  * PARAMETERS
1660  *   desc  a pty_desc strucure
1661  * RETURN VALUE
1662  *   a fd
1663  */
1664 int
1665 __gnat_tty_fd (pty_desc* desc)
1666 {
1667   return desc->master_fd;
1668 }
1669
1670 #endif /* WIN32 */