adadecode.c, [...]: New files.

	* adadecode.c, adadecode.h, aux-io.c, s-traces.adb, s-traces.ads,
	s-tratas.adb, s-tratas.ads, sinput-d.adb, sinput-d.ads,
	switch-b.adb, switch-b.ads, switch-c.adb, switch-c.ads,
	switch-m.adb, switch-m.ads : New files.

From-SVN: r50466

gcc/ada/ChangeLog

 2002-03-07  Geert Bosch  <bosch@gnat.com>
 
+	* adadecode.c, adadecode.h, aux-io.c, s-traces.adb, s-traces.ads, 
+	s-tratas.adb, s-tratas.ads, sinput-d.adb, sinput-d.ads, 
+	switch-b.adb, switch-b.ads, switch-c.adb, switch-c.ads, 
+	switch-m.adb, switch-m.ads : New files.
+
+2002-03-07  Geert Bosch  <bosch@gnat.com>
+
 	* 41intnam.ads, 42intnam.ads, 4aintnam.ads, 4cintnam.ads,
 	4dintnam.ads, 4gintnam.ads, 4hintnam.ads, 4lintnam.ads,
 	4mintnam.ads, 4pintnam.ads, 4rintnam.ads, 4sintnam.ads,

gcc/ada/adadecode.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                             G N A T D E C O                              *
+ *                                                                          *
+ *                            $Revision$
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *           Copyright (C) 2001-2002, Free Software Foundation, Inc.        *
+ *                                                                          *
+ * GNAT is free software;  you can  redistribute it  and/or modify it under *
+ * terms of the  GNU General Public License as published  by the Free Soft- *
+ * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+ * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+ * for  more details.  You should have  received  a copy of the GNU General *
+ * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+#ifdef IN_GCC
+#include "config.h"
+#include "system.h"
+#else
+#include <stdio.h>
+#define PARMS(ARGS) ARGS
+#endif
+
+#include "ctype.h"
+#include "adadecode.h"
+
+static void add_verbose	PARAMS ((const char *, char *));
+static int has_prefix	PARAMS ((char *, const char *));
+static int has_suffix	PARAMS ((char *, const char *));
+
+/* Set to nonzero if we have written any verbose info.  */
+static int verbose_info;
+
+/* Add TEXT to end of ADA_NAME, putting a leading " (" or ", ", depending
+   on VERBOSE_INFO.  */
+
+static void add_verbose (text, ada_name)
+     const char *text;
+     char *ada_name;
+{
+  strcat (ada_name, verbose_info ? ", " : " (");
+  strcat (ada_name, text);
+
+  verbose_info = 1;
+}
+
+/* Returns 1 if NAME starts with PREFIX.  */
+
+static int
+has_prefix (name, prefix)
+     char *name;
+     const char *prefix;
+{
+  return strncmp (name, prefix, strlen (prefix)) == 0;
+}
+
+/* Returns 1 if NAME ends with SUFFIX.  */
+
+static int
+has_suffix (name, suffix)
+     char *name;
+     const char *suffix;
+{
+  int nlen = strlen (name);
+  int slen = strlen (suffix);
+
+  return nlen > slen && strncmp (name + nlen - slen, suffix, slen) == 0;
+}
+
+/* This function will return the Ada name from the encoded form.
+   The Ada coding is done in exp_dbug.ads and this is the inverse function.
+   see exp_dbug.ads for full encoding rules, a short description is added
+   below. Right now only objects and routines are handled. There is no support
+   for Ada types.
+
+   CODED_NAME is the encoded entity name.
+
+   ADA_NAME is a pointer to a buffer, it will receive the Ada name. A safe
+   size for this buffer is: strlen (coded_name) * 2 + 60. (60 is for the
+   verbose information).
+
+   VERBOSE is nonzero if more information about the entity is to be
+   added at the end of the Ada name and surrounded by ( and ).
+
+     Coded name           Ada name                verbose info
+  ---------------------------------------------------------------------
+  _ada_xyz                xyz                     library level
+  x__y__z                 x.y.z
+  x__yTKB                 x.y                     task body
+  x__yB                   x.y                     task body
+  x__yX                   x.y                     body nested
+  x__yXb                  x.y                     body nested
+  xTK__y                  x.y                     in task
+  x__y$2                  x.y                     overloaded
+  x__y__3                 x.y                     overloaded
+  x__Oabs                 "abs"
+  x__Oand                 "and"
+  x__Omod                 "mod"
+  x__Onot                 "not"
+  x__Oor                  "or"
+  x__Orem                 "rem"
+  x__Oxor                 "xor"
+  x__Oeq                  "="
+  x__One                  "/="
+  x__Olt                  "<"
+  x__Ole                  "<="
+  x__Ogt                  ">"
+  x__Oge                  ">="
+  x__Oadd                 "+"
+  x__Osubtract            "-"
+  x__Oconcat              "&"
+  x__Omultiply            "*"
+  x__Odivide              "/"
+  x__Oexpon               "**"     */
+
+void
+__gnat_decode (coded_name, ada_name, verbose)
+     const char *coded_name;
+     char *ada_name;
+     int verbose;
+{
+  int lib_subprog = 0;
+  int overloaded = 0;
+  int task_body = 0;
+  int in_task = 0;
+  int body_nested = 0;
+
+  /* Copy the coded name into the ada name string, the rest of the code will
+     just replace or add characters into the ada_name.  */
+  strcpy (ada_name, coded_name);
+
+  /* Check for library level subprogram.  */
+  if (has_prefix (ada_name, "_ada_"))
+    {
+      strcpy (ada_name, ada_name + 5);
+      lib_subprog = 1;
+    }
+
+  /* Check for task body.  */
+  if (has_suffix (ada_name, "TKB"))
+    {
+      ada_name[strlen (ada_name) - 3] = '\0';
+      task_body = 1;
+    }
+
+  if (has_suffix (ada_name, "B"))
+    {
+      ada_name[strlen (ada_name) - 1] = '\0';
+      task_body = 1;
+    }
+
+  /* Check for body-nested entity: X[bn] */
+  if (has_suffix (ada_name, "X"))
+    {
+      ada_name[strlen (ada_name) - 1] = '\0';
+      body_nested = 1;
+    }
+
+  if (has_suffix (ada_name, "Xb"))
+    {
+      ada_name[strlen (ada_name) - 2] = '\0';
+      body_nested = 1;
+    }
+
+  if (has_suffix (ada_name, "Xn"))
+    {
+      ada_name[strlen (ada_name) - 2] = '\0';
+      body_nested = 1;
+    }
+
+  /* Change instance of TK__ (object declared inside a task) to __.  */
+  {
+    char *tktoken;
+
+    while ((tktoken = (char *) strstr (ada_name, "TK__")) != NULL)
+      {
+	strcpy (tktoken, tktoken + 2);
+	in_task = 1;
+      }
+  }
+
+  /* Check for overloading: name terminated by $nn or __nn.  */
+  {
+    int len = strlen (ada_name);
+    int n_digits = 0;
+
+    if (len > 1)
+      while (isdigit ((int) ada_name[(int) len - 1 - n_digits]))
+	n_digits++;
+
+    /* Check if we have $ or __ before digits.  */
+    if (ada_name[len - 1 - n_digits] == '$')
+      {
+	ada_name[len - 1 - n_digits] = '\0';
+	overloaded = 1;
+      }
+    else if (ada_name[len - 1 - n_digits] == '_'
+	     && ada_name[len - 1 - n_digits - 1] == '_')
+      {
+	ada_name[len - 1 - n_digits - 1] = '\0';
+	overloaded = 1;
+      }
+  }
+
+  /* Change all "__" to ".". */
+  {
+    int len = strlen (ada_name);
+    int k = 0;
+
+    while (k < len)
+      {
+	if (ada_name[k] == '_' && ada_name[k+1] == '_')
+	  {
+	    ada_name[k] = '.';
+	    strcpy (ada_name + k + 1, ada_name + k + 2);
+	    len = len - 1;
+	  }
+	k++;
+      }
+  }
+
+  /* Checks for operator name.  */
+  {
+    const char *trans_table[][2]
+      = {{"Oabs", "\"abs\""},  {"Oand", "\"and\""},    {"Omod", "\"mod\""},
+	 {"Onot", "\"not\""},  {"Oor", "\"or\""},      {"Orem", "\"rem\""},
+	 {"Oxor", "\"xor\""},  {"Oeq", "\"=\""},       {"One", "\"/=\""},
+	 {"Olt", "\"<\""},     {"Ole", "\"<=\""},      {"Ogt", "\">\""},
+	 {"Oge", "\">=\""},    {"Oadd", "\"+\""},      {"Osubtract", "\"-\""},
+	 {"Oconcat", "\"&\""}, {"Omultiply", "\"*\""}, {"Odivide", "\"/\""},
+	 {"Oexpon", "\"**\""}, {NULL, NULL} };
+    int k = 0;
+
+    while (1)
+      {
+	char *optoken;
+
+	if ((optoken = (char *) strstr (ada_name, trans_table[k][0])) != NULL)
+	  {
+	    int codedlen = strlen (trans_table[k][0]);
+	    int oplen = strlen (trans_table[k][1]);
+
+	    if (codedlen > oplen)
+	      /* We shrink the space.  */
+	      strcpy (optoken, optoken + codedlen - oplen);
+	    else if (oplen > codedlen)
+	      {
+		/* We need more space.  */
+		int len = strlen (ada_name);
+		int space = oplen - codedlen;
+		int num_to_move = &ada_name[len] - optoken;
+		int t;
+
+		for (t = 0; t < num_to_move; t++)
+		  ada_name[len + space - t - 1] = ada_name[len - t - 1];
+	      }
+
+	    /* Write symbol in the space.  */
+	    strncpy (optoken, trans_table[k][1], oplen);
+	  }
+	else
+	  k++;
+
+	/* Check for table's ending.  */
+	if (trans_table[k][0] == NULL)
+	  break;
+      }
+  }
+
+  /* If verbose mode is on, we add some information to the Ada name.  */
+  if (verbose) 
+    {
+      if (overloaded)
+	add_verbose ("overloaded", ada_name);
+
+      if (lib_subprog)
+	add_verbose ("library level", ada_name);
+
+      if (body_nested)
+	add_verbose ("body nested", ada_name);
+
+      if (in_task)
+	add_verbose ("in task", ada_name);
+
+      if (task_body)
+	add_verbose ("task body", ada_name);
+
+      if (verbose_info == 1)
+	strcat (ada_name, ")");
+    }
+}
+
+char *
+ada_demangle (coded_name)
+     const char *coded_name;
+{
+  char ada_name[2048];
+  char *result;
+
+  __gnat_decode (coded_name, ada_name, 0);
+
+  result = (char *) xmalloc (strlen (ada_name) + 1);
+  strcpy (result, ada_name);
+
+  return result;
+}

gcc/ada/adadecode.h

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                             G N A T D E C O                              *
+ *                                                                          *
+ *                            $Revision$
+ *                                                                          *
+ *                              C Header File                               *
+ *                                                                          *
+ *           Copyright (C) 2001-2002, Free Software Foundation, Inc.        *
+ *                                                                          *
+ * GNAT is free software;  you can  redistribute it  and/or modify it under *
+ * terms of the  GNU General Public License as published  by the Free Soft- *
+ * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+ * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+ * for  more details.  You should have  received  a copy of the GNU General *
+ * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+/* This function will return the Ada name from the encoded form.
+   The Ada coding is done in exp_dbug.ads and this is the inverse function.
+   see exp_dbug.ads for full encoding rules, a short description is added
+   below. Right now only objects and routines are handled. There is no support
+   for Ada types.
+
+   CODED_NAME is the encoded entity name.
+   ADA_NAME is a pointer to a buffer, it will receive the Ada name. A safe
+   size for this buffer is: strlen (coded_name) * 2 + 60. (60 is for the
+   verbose information).
+   VERBOSE is nonzero if more information about the entity is to be
+   added at the end of the Ada name and surrounded by ( and ).  */
+extern void __gnat_decode PARAMS ((const char *, char *, int));
+
+/* ada_demangle is added for COMPATIBILITY ONLY. It has the name of the
+   function used in the binutils and GDB. Always consider using __gnat_decode
+   instead of ada_demangle. Caller must free the pointer returned.  */
+extern char *ada_demangle PARAMS ((const char *));

gcc/ada/aux-io.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT RUN-TIME COMPONENTS                         *
+ *                                                                          *
+ *                              A - T R A N S                               *
+ *                                                                          *
+ *                          C Implementation File                           *
+ *                                                                          *
+ *                            $Revision$
+ *                                                                          *
+ *           Copyright (C) 1992-2001 Free Software Foundation, Inc.         *
+ *                                                                          *
+ * GNAT is free software;  you can  redistribute it  and/or modify it under *
+ * terms of the  GNU General Public License as published  by the Free Soft- *
+ * ware  Foundation;  either version 2,  or (at your option) any later ver- *
+ * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
+ * for  more details.  You should have  received  a copy of the GNU General *
+ * Public License  distributed with GNAT;  see file COPYING.  If not, write *
+ * to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, *
+ * MA 02111-1307, USA.                                                      *
+ *                                                                          *
+ * As a  special  exception,  if you  link  this file  with other  files to *
+ * produce an executable,  this file does not by itself cause the resulting *
+ * executable to be covered by the GNU General Public License. This except- *
+ * ion does not  however invalidate  any other reasons  why the  executable *
+ * file might be covered by the  GNU Public License.                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
+ *                                                                          *
+ ****************************************************************************/
+
+#include <stdio.h>
+
+#ifdef IN_RTS
+#include "tconfig.h"
+#include "tsystem.h"
+#else
+#include "config.h"
+#include "system.h"
+#endif
+
+/* Function wrappers are needed to access the values from Ada which are
+   defined as C macros.  */
+
+FILE *c_stdin         PARAMS ((void));
+FILE *c_stdout        PARAMS ((void));
+FILE *c_stderr        PARAMS ((void));
+int seek_set_function PARAMS ((void));
+int seek_end_function PARAMS ((void));
+void *null_function   PARAMS ((void));
+int c_fileno          PARAMS ((FILE *));
+
+FILE *
+c_stdin () 
+{ 
+  return stdin; 
+}
+
+FILE *
+c_stdout () 
+{ 
+  return stdout;
+}
+
+FILE *
+c_stderr () 
+{ 
+  return stderr;
+}
+
+#ifndef SEEK_SET    /* Symbolic constants for the "fseek" function: */
+#define SEEK_SET 0  /* Set file pointer to offset */
+#define SEEK_CUR 1  /* Set file pointer to its current value plus offset */
+#define SEEK_END 2  /* Set file pointer to the size of the file plus offset */
+#endif
+
+int   
+seek_set_function ()  
+{ 
+  return SEEK_SET; 
+}
+
+int   
+seek_end_function ()  
+{ 
+  return SEEK_END; 
+}
+
+void *null_function ()  
+{ 
+  return NULL;     
+}
+
+int 
+c_fileno (s) 
+     FILE *s;
+{ 
+  return fileno (s); 
+}

gcc/ada/s-traces.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                         S Y S T E M . T R A C E S                        --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--                             $Revision$
+--                                                                          --
+--             Copyright (C) 2001 Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body System.Traces is
+
+   pragma Warnings (Off); -- kill warnings on unreferenced formals
+
+   ---------------------
+   -- Send_Trace_Info --
+   ---------------------
+
+   procedure Send_Trace_Info (Id : Trace_T) is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   ---------------------
+   -- Send_Trace_Info --
+   ---------------------
+
+   procedure Send_Trace_Info (Id : Trace_T; Timeout : Duration) is
+   begin
+      null;
+   end Send_Trace_Info;
+
+end System.Traces;

gcc/ada/s-traces.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                         S Y S T E M . T R A C E S                        --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--                             $Revision$
+--                                                                          --
+--             Copyright (C) 2001 Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package implements functions for traces when tasking is not involved
+
+--  Warning : NO dependencies to tasking should be created here
+
+--  This package, and all its children are used to implement debug
+--  informations
+
+--  A new primitive, Send_Trace_Info (Id : Trace_T; 'data') is introduced.
+--  Trace_T is an event identifier, 'data' are the informations to pass
+--  with the event. Thid procedure is used from within the Runtime to send
+--  debug informations.
+
+--  This primitive is overloaded in System.Traces.Tasking and this package.
+
+--  Send_Trace_Info calls Send_Trace, in System.Traces.Send, which is trarget
+--  dependent, to send the debug informations to a debugger, stream ..
+
+--  To add a new event, just add them to the Trace_T type, and write the
+--  corresponding Send_Trace_Info procedure. It may be required for some
+--  target to modify Send_Trace (eg. VxWorks).
+
+--  To add a new target, just adapt System.Traces.Send to your own purpose.
+
+package System.Traces is
+
+   type Trace_T is
+     (
+      --  Events handled.
+
+      --  Messages
+      --
+      M_Accept_Complete,
+      M_Select_Else,
+      M_RDV_Complete,
+      M_Call_Complete,
+      M_Delay,
+
+      --  Errors
+      --
+      E_Missed,
+      E_Timeout,
+      E_Kill,
+
+      --  Waiting events
+      --
+      W_Call,
+      W_Accept,
+      W_Select,
+      W_Completion,
+      W_Delay,
+      WU_Delay,
+
+      WT_Call,
+      WT_Select,
+      WT_Completion,
+
+      --  Protected objects events
+      --
+      PO_Call,
+      POT_Call,
+      PO_Run,
+      PO_Lock,
+      PO_Unlock,
+      PO_Done,
+
+      --  Task handling events
+      --
+      T_Create,
+      T_Activate,
+      T_Abort,
+      T_Terminate);
+
+   --  Send_Trace_Info procedures
+
+   --  They are overloaded, depending on the parameters passed with
+   --  the event, e.g. Time information, Task name, Accept name ...
+
+   procedure Send_Trace_Info (Id : Trace_T);
+
+   procedure Send_Trace_Info (Id : Trace_T; Timeout : Duration);
+
+end System.Traces;

gcc/ada/s-tratas.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                 S Y S T E M . T R A C E S . T A S K I N G                --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--                             $Revision$
+--                                                                          --
+--             Copyright (C) 2001 Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body System.Traces.Tasking is
+
+   pragma Warnings (Off); -- kill warnings on unreferenced formals
+
+   ---------------------
+   -- Send_Trace_Info --
+   ---------------------
+
+   procedure Send_Trace_Info (Id : Trace_T; Task_Name2 : ST.Task_ID) is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Task_Name2   : ST.Task_ID;
+      Entry_Number : ST.Entry_Index)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Task_Name    : ST.Task_ID;
+      Task_Name2   : ST.Task_ID;
+      Entry_Number : ST.Entry_Index)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id         : Trace_T;
+      Task_Name  : ST.Task_ID;
+      Task_Name2 : ST.Task_ID)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Entry_Number : ST.Entry_Index)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Acceptor     : ST.Task_ID;
+      Entry_Number : ST.Entry_Index;
+      Timeout      : Duration)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Entry_Number : ST.Entry_Index;
+      Timeout      : Duration)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id        : Trace_T;
+      Task_Name : ST.Task_ID;
+      Number    : Integer)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+   procedure Send_Trace_Info
+     (Id        : Trace_T;
+      Task_Name : ST.Task_ID;
+      Number    : Integer;
+      Timeout   : Duration)
+   is
+   begin
+      null;
+   end Send_Trace_Info;
+
+end System.Traces.Tasking;

gcc/ada/s-tratas.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                  S Y S T E M . T R A C E S . T A S K I N G               --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--                             $Revision$
+--                                                                          --
+--             Copyright (C) 2001 Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides all procedures used to implement debug traces
+--  in the case tasking is involved.
+
+--  See System.Traces for an overview of the various files involved in Tracing
+
+--  If tasking is not involved, refer to System.Traces.General
+
+with System.Tasking;
+
+package System.Traces.Tasking is
+
+   package ST renames System.Tasking;
+
+   --  Send_Trace_Info procedures
+
+   --  They are overloaded, depending on the parameters passed with the event
+
+   procedure Send_Trace_Info
+     (Id         : Trace_T;
+      Task_Name2 : ST.Task_ID);
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Task_Name2   : ST.Task_ID;
+      Entry_Number : ST.Entry_Index);
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Task_Name    : ST.Task_ID;
+      Task_Name2   : ST.Task_ID;
+      Entry_Number : ST.Entry_Index);
+
+   procedure Send_Trace_Info
+     (Id         : Trace_T;
+      Task_Name  : ST.Task_ID;
+      Task_Name2 : ST.Task_ID);
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Entry_Number : ST.Entry_Index);
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Acceptor     : ST.Task_ID;
+      Entry_Number : ST.Entry_Index;
+      Timeout      : Duration);
+
+   procedure Send_Trace_Info
+     (Id           : Trace_T;
+      Entry_Number : ST.Entry_Index;
+      Timeout      : Duration);
+
+   procedure Send_Trace_Info
+     (Id         : Trace_T;
+      Task_Name  : ST.Task_ID;
+      Number     : Integer);
+
+   procedure Send_Trace_Info
+     (Id         : Trace_T;
+      Task_Name  : ST.Task_ID;
+      Number     : Integer;
+      Timeout    : Duration);
+end System.Traces.Tasking;

gcc/ada/sinput-d.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S I N P U T . D                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001, Free Software Foundation, Inc.              --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Osint;     use Osint;
+with Osint.C;   use Osint.C;
+
+package body Sinput.D is
+
+   Dfile : Source_File_Index;
+   --  Index of currently active debug source file
+
+   ------------------------
+   -- Close_Debug_Source --
+   ------------------------
+
+   procedure Close_Debug_Source is
+      S    : Source_File_Record renames Source_File.Table (Dfile);
+      Src  : Source_Buffer_Ptr;
+
+   begin
+      Trim_Lines_Table (Dfile);
+      Close_Debug_File;
+
+      --  Now we need to read the file that we wrote and store it
+      --  in memory for subsequent access.
+
+      Read_Source_File
+        (S.Debug_Source_Name, S.Source_First, S.Source_Last, Src);
+      S.Source_Text := Src;
+   end Close_Debug_Source;
+
+   -------------------------
+   -- Create_Debug_Source --
+   -------------------------
+
+   procedure Create_Debug_Source
+     (Source : Source_File_Index;
+      Loc    : out Source_Ptr)
+   is
+   begin
+      Loc := Source_File.Table (Source_File.Last).Source_Last + 1;
+      Source_File.Increment_Last;
+      Dfile := Source_File.Last;
+
+      declare
+         S : Source_File_Record renames Source_File.Table (Dfile);
+
+      begin
+         S := Source_File.Table (Source);
+         S.Debug_Source_Name := Create_Debug_File (S.File_Name);
+         S.Source_First      := Loc;
+         S.Source_Last       := Loc;
+         S.Lines_Table       := null;
+         S.Last_Source_Line  := 1;
+
+         --  Allocate lines table, guess that it needs to be three times
+         --  bigger than the original source (in number of lines).
+
+         Alloc_Line_Tables
+           (S, Int (Source_File.Table (Source).Last_Source_Line * 3));
+         S.Lines_Table (1) := Loc;
+      end;
+   end Create_Debug_Source;
+
+   ----------------------
+   -- Write_Debug_Line --
+   ----------------------
+
+   procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr) is
+      S : Source_File_Record renames Source_File.Table (Dfile);
+
+   begin
+      --  Ignore write request if null line at start of file
+
+      if Str'Length = 0 and then Loc = S.Source_First then
+         return;
+
+      --  Here we write the line, and update the source record entry
+
+      else
+         Write_Debug_Info (Str (Str'First .. Str'Last - 1));
+         Add_Line_Tables_Entry (S, Loc);
+         Loc := Loc - 1 + Source_Ptr (Str'Length + Debug_File_Eol_Length);
+         S.Source_Last := Loc;
+      end if;
+   end Write_Debug_Line;
+
+end Sinput.D;

gcc/ada/sinput-d.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S I N P U T . D                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001, Free Software Foundation, Inc.              --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This child package contains the routines used to write debug source
+--  files. These routines are not in Sinput.L, because they are used only
+--  by the compiler, while Sinput.L is also used by gnatmake.
+
+package Sinput.D is
+
+   ------------------------------------------------
+   -- Subprograms for Writing Debug Source Files --
+   ------------------------------------------------
+
+   procedure Create_Debug_Source
+     (Source : Source_File_Index;
+      Loc    : out Source_Ptr);
+   --  Given a source file, creates a new source file table entry to be used
+   --  for the debug source file output (Debug_Generated_Code switch set).
+   --  Loc is set to the initial Sloc value for the first line. This call
+   --  also creates the debug source output file (using Create_Debug_File).
+
+   procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr);
+   --  This procedure is called to write a line to the debug source file
+   --  previously created by Create_Debug_Source using Write_Debug_Info.
+   --  Str is the source line to be written to the file (it does not include
+   --  an end of line character). On entry Loc is the Sloc value previously
+   --  returned by Create_Debug_Source or Write_Debug_Line, and on exit,
+   --  Sloc is updated to point to the start of the next line to be written,
+   --  taking into account the length of the ternminator that was written by
+   --  Write_Debug_Info.
+
+   procedure Close_Debug_Source;
+   --  This procedure completes the source table entry for the debug file
+   --  previously created by Create_Debug_Source, and written using the
+   --  Write_Debug_Line procedure. It then calls Close_Debug_File to
+   --  complete the writing of the file itself.
+
+end Sinput.D;

gcc/ada/switch-b.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - B                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Debug;    use Debug;
+with Osint;    use Osint;
+with Opt;      use Opt;
+
+with System.WCh_Con; use System.WCh_Con;
+
+package body Switch.B is
+
+   --------------------------
+   -- Scan_Binder_Switches --
+   --------------------------
+
+   procedure Scan_Binder_Switches (Switch_Chars : String) is
+      Ptr : Integer := Switch_Chars'First;
+      Max : Integer := Switch_Chars'Last;
+      C   : Character := ' ';
+
+   begin
+      --  Skip past the initial character (must be the switch character)
+
+      if Ptr = Max then
+         raise Bad_Switch;
+      else
+         Ptr := Ptr + 1;
+      end if;
+
+      --  A little check, "gnat" at the start of a switch is not allowed
+      --  except for the compiler
+
+      if Switch_Chars'Last >= Ptr + 3
+        and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
+      then
+         Osint.Fail ("invalid switch: """, Switch_Chars, """"
+            & " (gnat not needed here)");
+
+      end if;
+
+      --  Loop to scan through switches given in switch string
+
+      while Ptr <= Max loop
+         C := Switch_Chars (Ptr);
+
+         case C is
+
+         --  Processing for A switch
+
+         when 'A' =>
+            Ptr := Ptr + 1;
+
+            Ada_Bind_File := True;
+
+         --  Processing for b switch
+
+         when 'b' =>
+            Ptr := Ptr + 1;
+            Brief_Output := True;
+
+         --  Processing for c switch
+
+         when 'c' =>
+            Ptr := Ptr + 1;
+
+            Check_Only := True;
+
+         --  Processing for C switch
+
+         when 'C' =>
+            Ptr := Ptr + 1;
+
+            Ada_Bind_File := False;
+
+         --  Processing for d switch
+
+         when 'd' =>
+
+            --  Note: for the debug switch, the remaining characters in this
+            --  switch field must all be debug flags, since all valid switch
+            --  characters are also valid debug characters. This switch is not
+            --  documented on purpose because it is only used by the
+            --  implementors.
+
+            --  Loop to scan out debug flags
+
+            while Ptr < Max loop
+               Ptr := Ptr + 1;
+               C := Switch_Chars (Ptr);
+               exit when C = ASCII.NUL or else C = '/' or else C = '-';
+
+               if C in '1' .. '9' or else
+                  C in 'a' .. 'z' or else
+                  C in 'A' .. 'Z'
+               then
+                  Set_Debug_Flag (C);
+               else
+                  raise Bad_Switch;
+               end if;
+            end loop;
+
+            --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
+            --  is for backwards compatibility with old versions and usage.
+
+            if Debug_Flag_XX then
+               Zero_Cost_Exceptions_Set := True;
+               Zero_Cost_Exceptions_Val := True;
+            end if;
+
+            return;
+
+         --  Processing for e switch
+
+         when 'e' =>
+            Ptr := Ptr + 1;
+            Elab_Dependency_Output := True;
+
+         --  Processing for E switch
+
+         when 'E' =>
+            Ptr := Ptr + 1;
+            Exception_Tracebacks := True;
+
+         --  Processing for f switch
+
+         when 'f' =>
+            Ptr := Ptr + 1;
+            Force_RM_Elaboration_Order := True;
+
+         --  Processing for g switch
+
+         when 'g' =>
+            Ptr := Ptr + 1;
+
+            if Ptr <= Max then
+               C := Switch_Chars (Ptr);
+
+               if C in '0' .. '3' then
+                  Debugger_Level :=
+                    Character'Pos
+                      (Switch_Chars (Ptr)) - Character'Pos ('0');
+                  Ptr := Ptr + 1;
+               end if;
+
+            else
+               Debugger_Level := 2;
+            end if;
+
+         --  Processing for h switch
+
+         when 'h' =>
+            Ptr := Ptr + 1;
+            Usage_Requested := True;
+
+         --  Processing for i switch
+
+         when 'i' =>
+            if Ptr = Max then
+               raise Bad_Switch;
+            end if;
+
+            Ptr := Ptr + 1;
+            C := Switch_Chars (Ptr);
+
+            if C in  '1' .. '5'
+              or else C = '8'
+              or else C = 'p'
+              or else C = 'f'
+              or else C = 'n'
+              or else C = 'w'
+            then
+               Identifier_Character_Set := C;
+               Ptr := Ptr + 1;
+            else
+               raise Bad_Switch;
+            end if;
+
+         --  Processing for K switch
+
+         when 'K' =>
+            Ptr := Ptr + 1;
+            Output_Linker_Option_List := True;
+
+         --  Processing for l switch
+
+         when 'l' =>
+            Ptr := Ptr + 1;
+            Elab_Order_Output := True;
+
+         --  Processing for m switch
+
+         when 'm' =>
+            Ptr := Ptr + 1;
+            Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
+
+         --  Processing for n switch
+
+         when 'n' =>
+            Ptr := Ptr + 1;
+            Bind_Main_Program := False;
+
+            --  Note: The -L option of the binder also implies -n, so
+            --  any change here must also be reflected in the processing
+            --  for -L that is found in Gnatbind.Scan_Bind_Arg.
+
+         --  Processing for o switch
+
+         when 'o' =>
+            Ptr := Ptr + 1;
+
+            if Output_File_Name_Present then
+               raise Too_Many_Output_Files;
+
+            else
+               Output_File_Name_Present := True;
+            end if;
+
+         --  Processing for O switch
+
+         when 'O' =>
+            Ptr := Ptr + 1;
+            Output_Object_List := True;
+
+         --  Processing for p switch
+
+         when 'p' =>
+            Ptr := Ptr + 1;
+            Pessimistic_Elab_Order := True;
+
+         --  Processing for q switch
+
+         when 'q' =>
+            Ptr := Ptr + 1;
+            Quiet_Output := True;
+
+         --  Processing for r switch
+
+         when 'r' =>
+            Ptr := Ptr + 1;
+            List_Restrictions := True;
+
+         --  Processing for s switch
+
+         when 's' =>
+            Ptr := Ptr + 1;
+            All_Sources := True;
+            Check_Source_Files := True;
+
+         --  Processing for t switch
+
+         when 't' =>
+            Ptr := Ptr + 1;
+            Tolerate_Consistency_Errors := True;
+
+         --  Processing for T switch
+
+         when 'T' =>
+            Ptr := Ptr + 1;
+            Time_Slice_Set := True;
+            Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
+
+         --  Processing for v switch
+
+         when 'v' =>
+            Ptr := Ptr + 1;
+            Verbose_Mode := True;
+
+         --  Processing for w switch
+
+         when 'w' =>
+
+            --  For the binder we only allow suppress/error cases
+
+            Ptr := Ptr + 1;
+
+            case Switch_Chars (Ptr) is
+
+               when 'e' =>
+                  Warning_Mode  := Treat_As_Error;
+
+               when 's' =>
+                  Warning_Mode  := Suppress;
+
+               when others =>
+                  raise Bad_Switch;
+            end case;
+
+            Ptr := Ptr + 1;
+
+         --  Processing for W switch
+
+         when 'W' =>
+            Ptr := Ptr + 1;
+
+            for J in WC_Encoding_Method loop
+               if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
+                  Wide_Character_Encoding_Method := J;
+                  exit;
+
+               elsif J = WC_Encoding_Method'Last then
+                  raise Bad_Switch;
+               end if;
+            end loop;
+
+            Upper_Half_Encoding :=
+              Wide_Character_Encoding_Method in
+                WC_Upper_Half_Encoding_Method;
+
+            Ptr := Ptr + 1;
+
+         --  Processing for x switch
+
+         when 'x' =>
+            Ptr := Ptr + 1;
+            All_Sources := False;
+            Check_Source_Files := False;
+
+         --  Processing for z switch
+
+         when 'z' =>
+            Ptr := Ptr + 1;
+            No_Main_Subprogram := True;
+
+         --  Ignore extra switch character
+
+         when '/'  =>
+            Ptr := Ptr + 1;
+
+         --  Ignore '-' extra switch caracter, only if it isn't followed by
+         --  'RTS'. If it is, then we must process the 'RTS' switch
+
+         when '-' =>
+
+            if Ptr + 3 <= Max and then
+              Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
+            then
+               Ptr := Ptr + 1;
+
+               if Switch_Chars (Ptr + 3) /= '=' or else
+                 (Switch_Chars (Ptr + 3) = '='
+                  and then Ptr + 4 > Max)
+               then
+                  Osint.Fail ("missing path for --RTS");
+               else
+
+                  --  valid --RTS switch
+                  Opt.No_Stdinc := True;
+                  Opt.RTS_Switch := True;
+
+                  declare
+                     Src_Path_Name : String_Ptr := Get_RTS_Search_Dir
+                       (Switch_Chars (Ptr + 4 .. Switch_Chars'Last), Include);
+                     Lib_Path_Name : String_Ptr := Get_RTS_Search_Dir
+                       (Switch_Chars (Ptr + 4 .. Switch_Chars'Last), Objects);
+                  begin
+                     if Src_Path_Name /= null and then
+                       Lib_Path_Name /= null
+                     then
+                        Add_Search_Dirs (Src_Path_Name, Include);
+                        Add_Search_Dirs (Lib_Path_Name, Objects);
+                        --  we can exit as there can not be another switch
+                        --  after --RTS
+                        exit;
+                     elsif  Src_Path_Name = null
+                       and Lib_Path_Name = null then
+                        Osint.Fail ("RTS path not valid: missing " &
+                                    "adainclude and adalib directories");
+                     elsif Src_Path_Name = null then
+                        Osint.Fail ("RTS path not valid: missing " &
+                                    "adainclude directory");
+                     elsif  Lib_Path_Name = null then
+                        Osint.Fail ("RTS path not valid: missing " &
+                                    "adalib directory");
+                     end if;
+                  end;
+               end if;
+
+            else
+               Ptr := Ptr + 1;
+            end if;
+
+         --  Anything else is an error (illegal switch character)
+
+         when others =>
+            raise Bad_Switch;
+         end case;
+      end loop;
+
+   exception
+      when Bad_Switch =>
+         Osint.Fail ("invalid switch: ", (1 => C));
+
+      when Bad_Switch_Value =>
+         Osint.Fail ("numeric value too big for switch: ", (1 => C));
+
+      when Missing_Switch_Value =>
+         Osint.Fail ("missing numeric value for switch: ", (1 => C));
+
+      when Too_Many_Output_Files =>
+         Osint.Fail ("duplicate -o switch");
+   end Scan_Binder_Switches;
+
+end Switch.B;

gcc/ada/switch-b.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - B                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001 Free Software Foundation, Inc.               --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package scans binder switches. Note that the body of Usage must be
+--  coordinated with the switches that are recognized by this package.
+--  The Usage package also acts as the official documentation for the
+--  switches that are recognized. In addition, package Debug documents
+--  the otherwise undocumented debug switches that are also recognized.
+
+package Switch.B is
+
+   procedure Scan_Binder_Switches (Switch_Chars : String);
+   --  Procedures to scan out binder switches stored in the given string.
+   --  The first character is known to be a valid switch character, and there
+   --  are no blanks or other switch terminator characters in the string, so
+   --  the entire string should consist of valid switch characters, except that
+   --  an optional terminating NUL character is allowed. A bad switch causes
+   --  a fatal error exit and control does not return. The call also sets
+   --  Usage_Requested to True if a ? switch is encountered.
+
+end Switch.B;

gcc/ada/switch-c.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - C                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Debug;    use Debug;
+with Lib;      use Lib;
+with Osint;    use Osint;
+with Opt;      use Opt;
+with Types;    use Types;
+with Validsw;  use Validsw;
+with Stylesw;  use Stylesw;
+
+with System.WCh_Con; use System.WCh_Con;
+
+package body Switch.C is
+
+   -----------------------------
+   -- Scan_Front_End_Switches --
+   -----------------------------
+
+   procedure Scan_Front_End_Switches (Switch_Chars : String) is
+      Switch_Starts_With_Gnat : Boolean;
+      --  True if first four switch characters are "gnat"
+
+      First_Switch : Boolean := True;
+      --  False for all but first switch
+
+      Ptr : Integer := Switch_Chars'First;
+      Max : constant Integer := Switch_Chars'Last;
+      C   : Character := ' ';
+
+      Store_Switch : Boolean  := True;
+      First_Char   : Integer  := Ptr;
+      Storing      : String   := Switch_Chars;
+      First_Stored : Positive := Ptr + 1;
+      --  The above need comments ???
+
+   begin
+      --  Skip past the initial character (must be the switch character)
+
+      if Ptr = Max then
+         raise Bad_Switch;
+      else
+         Ptr := Ptr + 1;
+      end if;
+
+      --  Remove "gnat" from the switch, if present
+
+      Switch_Starts_With_Gnat :=
+        Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
+
+      if Switch_Starts_With_Gnat then
+         Ptr := Ptr + 4;
+         First_Stored := Ptr;
+      end if;
+
+      --  Loop to scan through switches given in switch string
+
+      while Ptr <= Max loop
+         Store_Switch := True;
+         First_Char := Ptr;
+         C := Switch_Chars (Ptr);
+
+         --  Processing for a switch
+
+         case Switch_Starts_With_Gnat is
+
+            when False =>
+            --  There are only two front-end switches that
+            --  do not start with -gnat, namely -I and --RTS
+
+               if Switch_Chars (Ptr) = 'I' then
+                  Store_Switch := False;
+
+                  Ptr := Ptr + 1;
+
+                  if Ptr > Max then
+                     raise Bad_Switch;
+                  end if;
+
+                  --  Find out whether this is a -I- or regular -Ixxx switch
+
+                  if Ptr = Max and then Switch_Chars (Ptr) = '-' then
+                     Look_In_Primary_Dir := False;
+
+                  else
+                     Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
+                  end if;
+
+                  Ptr := Max + 1;
+
+               --  Processing of the --RTS switch. --RTS has been modified by
+               --  gcc and is now of the form -fRTS
+               elsif Ptr + 3 <= Max and then
+                 Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
+               then
+                  Ptr := Ptr + 1;
+
+                  if Ptr + 4 > Max or else Switch_Chars (Ptr + 3) /= '=' then
+                     Osint.Fail ("missing path for --RTS");
+                  else
+
+                     --  valid --RTS switch
+                     Opt.No_Stdinc := True;
+                     Opt.RTS_Switch := True;
+
+                     declare
+                        Src_Path_Name : String_Ptr := Get_RTS_Search_Dir
+                          (Switch_Chars (Ptr + 4 .. Max), Include);
+                        Lib_Path_Name : String_Ptr := Get_RTS_Search_Dir
+                          (Switch_Chars (Ptr + 4 .. Max), Objects);
+                     begin
+                        if Src_Path_Name /= null and then
+                          Lib_Path_Name /= null
+                        then
+                           Add_Search_Dirs (Src_Path_Name, Include);
+                           Add_Search_Dirs (Lib_Path_Name, Objects);
+                           Ptr := Max + 1;
+                        elsif  Src_Path_Name = null
+                          and Lib_Path_Name = null then
+                           Osint.Fail ("RTS path not valid: missing " &
+                                       "adainclude and adalib directories");
+                        elsif Src_Path_Name = null then
+                           Osint.Fail ("RTS path not valid: missing " &
+                                       "adainclude directory");
+                        elsif  Lib_Path_Name = null then
+                           Osint.Fail ("RTS path not valid: missing " &
+                                       "adalib directory");
+                        end if;
+                     end;
+                  end if;
+               else
+                  raise Bad_Switch;
+               end if;
+
+         when True =>
+            --  Process -gnat* options
+
+            case C is
+
+            when 'a' =>
+               Ptr := Ptr + 1;
+               Assertions_Enabled := True;
+
+            --  Processing for A switch
+
+            when 'A' =>
+               Ptr := Ptr + 1;
+               Config_File := False;
+
+            --  Processing for b switch
+
+            when 'b' =>
+               Ptr := Ptr + 1;
+               Brief_Output := True;
+
+            --  Processing for c switch
+
+            when 'c' =>
+               if not First_Switch then
+                  Osint.Fail
+                    ("-gnatc myust be first if combined with other switches");
+               end if;
+
+               Ptr := Ptr + 1;
+               Operating_Mode := Check_Semantics;
+
+            --  Processing for C switch
+
+            when 'C' =>
+               Ptr := Ptr + 1;
+               Compress_Debug_Names := True;
+
+            --  Processing for d switch
+
+            when 'd' =>
+               Store_Switch := False;
+               Storing (First_Stored) := 'd';
+               --  Note: for the debug switch, the remaining characters in this
+               --  switch field must all be debug flags, since all valid switch
+               --  characters are also valid debug characters.
+
+               --  Loop to scan out debug flags
+
+               while Ptr < Max loop
+                  Ptr := Ptr + 1;
+                  C := Switch_Chars (Ptr);
+                  exit when C = ASCII.NUL or else C = '/' or else C = '-';
+
+                  if C in '1' .. '9' or else
+                     C in 'a' .. 'z' or else
+                     C in 'A' .. 'Z'
+                  then
+                     Set_Debug_Flag (C);
+                     Storing (First_Stored + 1) := C;
+                     Store_Compilation_Switch
+                       (Storing (Storing'First .. First_Stored + 1));
+
+                  else
+                     raise Bad_Switch;
+                  end if;
+               end loop;
+
+               --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
+               --  is for backwards compatibility with old versions and usage.
+
+               if Debug_Flag_XX then
+                  Zero_Cost_Exceptions_Set := True;
+                  Zero_Cost_Exceptions_Val := True;
+               end if;
+
+               return;
+
+            --  Processing for D switch
+
+            when 'D' =>
+               Ptr := Ptr + 1;
+
+               --  Note: -gnatD also sets -gnatx (to turn off cross-reference
+               --  generation in the ali file) since otherwise this generation
+               --  gets confused by the "wrong" Sloc values put in the tree.
+
+               Debug_Generated_Code := True;
+               Xref_Active := False;
+               Set_Debug_Flag ('g');
+
+            --  Processing for e switch
+
+            when 'e' =>
+               Ptr := Ptr + 1;
+
+               if Ptr > Max then
+                  raise Bad_Switch;
+               end if;
+
+               case Switch_Chars (Ptr) is
+
+                  --  Configuration pragmas
+
+                  when 'c' =>
+                     Store_Switch := False;
+                     Ptr := Ptr + 1;
+
+                     if Ptr > Max then
+                        raise Bad_Switch;
+                     end if;
+
+                     Config_File_Name :=
+                        new String'(Switch_Chars (Ptr .. Max));
+
+                     return;
+
+                  --  Mapping file
+
+                  when 'm' =>
+                     Store_Switch := False;
+                     Ptr := Ptr + 1;
+
+                     if Ptr > Max then
+                        raise Bad_Switch;
+                     end if;
+
+                     Mapping_File_Name :=
+                       new String'(Switch_Chars (Ptr .. Max));
+                     return;
+
+                  when others =>
+                     raise Bad_Switch;
+               end case;
+
+            --  Processing for E switch
+
+            when 'E' =>
+               Ptr := Ptr + 1;
+               Dynamic_Elaboration_Checks := True;
+
+            --  Processing for f switch
+
+            when 'f' =>
+               Ptr := Ptr + 1;
+               All_Errors_Mode := True;
+
+            --  Processing for F switch
+
+            when 'F' =>
+               Ptr := Ptr + 1;
+               External_Name_Exp_Casing := Uppercase;
+               External_Name_Imp_Casing := Uppercase;
+
+            --  Processing for g switch
+
+            when 'g' =>
+               Ptr := Ptr + 1;
+               GNAT_Mode                := True;
+               Identifier_Character_Set := 'n';
+               Warning_Mode             := Treat_As_Error;
+               Check_Unreferenced       := True;
+               Check_Withs              := True;
+
+               Set_Default_Style_Check_Options;
+
+            --  Processing for G switch
+
+            when 'G' =>
+               Ptr := Ptr + 1;
+               Print_Generated_Code := True;
+
+            --  Processing for h switch
+
+            when 'h' =>
+               Ptr := Ptr + 1;
+               Usage_Requested := True;
+
+            --  Processing for H switch
+
+            when 'H' =>
+               Ptr := Ptr + 1;
+               HLO_Active := True;
+
+            --  Processing for i switch
+
+            when 'i' =>
+               if Ptr = Max then
+                  raise Bad_Switch;
+               end if;
+
+               Ptr := Ptr + 1;
+               C := Switch_Chars (Ptr);
+
+               if C in '1' .. '5'
+                 or else C = '8'
+                 or else C = '9'
+                 or else C = 'p'
+                 or else C = 'f'
+                 or else C = 'n'
+                 or else C = 'w'
+               then
+                  Identifier_Character_Set := C;
+                  Ptr := Ptr + 1;
+
+               else
+                  raise Bad_Switch;
+               end if;
+
+            --  Processing for k switch
+
+            when 'k' =>
+               Ptr := Ptr + 1;
+               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
+
+            --  Processing for l switch
+
+            when 'l' =>
+               Ptr := Ptr + 1;
+               Full_List := True;
+
+            --  Processing for L switch
+
+            when 'L' =>
+               Ptr := Ptr + 1;
+               Zero_Cost_Exceptions_Set := True;
+               Zero_Cost_Exceptions_Val := False;
+
+            --  Processing for m switch
+
+            when 'm' =>
+               Ptr := Ptr + 1;
+               Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
+
+            --  Processing for n switch
+
+            when 'n' =>
+               Ptr := Ptr + 1;
+               Inline_Active := True;
+
+            --  Processing for N switch
+
+            when 'N' =>
+               Ptr := Ptr + 1;
+               Inline_Active := True;
+               Front_End_Inlining := True;
+
+            --  Processing for o switch
+
+            when 'o' =>
+               Ptr := Ptr + 1;
+               Suppress_Options.Overflow_Checks := False;
+               Opt.Enable_Overflow_Checks := True;
+
+            --  Processing for O switch
+
+            when 'O' =>
+               Ptr := Ptr + 1;
+               Output_File_Name_Present := True;
+
+            --  Processing for p switch
+
+            when 'p' =>
+               Ptr := Ptr + 1;
+               Suppress_Options.Access_Checks        := True;
+               Suppress_Options.Accessibility_Checks := True;
+               Suppress_Options.Discriminant_Checks  := True;
+               Suppress_Options.Division_Checks      := True;
+               Suppress_Options.Elaboration_Checks   := True;
+               Suppress_Options.Index_Checks         := True;
+               Suppress_Options.Length_Checks        := True;
+               Suppress_Options.Overflow_Checks      := True;
+               Suppress_Options.Range_Checks         := True;
+               Suppress_Options.Storage_Checks       := True;
+               Suppress_Options.Tag_Checks           := True;
+
+               Validity_Checks_On := False;
+               Opt.Suppress_Checks := True;
+               Opt.Enable_Overflow_Checks := False;
+
+            --  Processing for P switch
+
+            when 'P' =>
+               Ptr := Ptr + 1;
+               Polling_Required := True;
+
+            --  Processing for q switch
+
+            when 'q' =>
+               Ptr := Ptr + 1;
+               Try_Semantics := True;
+
+            --  Processing for q switch
+
+            when 'Q' =>
+               Ptr := Ptr + 1;
+               Force_ALI_Tree_File := True;
+               Try_Semantics := True;
+
+            --  Processing for R switch
+
+            when 'R' =>
+               Ptr := Ptr + 1;
+               Back_Annotate_Rep_Info := True;
+
+               if Ptr <= Max
+                 and then Switch_Chars (Ptr) in '0' .. '9'
+               then
+                  C := Switch_Chars (Ptr);
+
+                  if C in '4' .. '9' then
+                     raise Bad_Switch;
+                  else
+                     List_Representation_Info :=
+                       Character'Pos (C) - Character'Pos ('0');
+                     Ptr := Ptr + 1;
+                  end if;
+
+                  if Ptr <= Max and then Switch_Chars (Ptr) = 's' then
+                     Ptr := Ptr + 1;
+
+                     if List_Representation_Info /= 0 then
+                        List_Representation_Info_To_File := True;
+                     end if;
+                  end if;
+
+               else
+                  List_Representation_Info := 1;
+               end if;
+
+            --  Processing for s switch
+
+            when 's' =>
+               if not First_Switch then
+                  Osint.Fail
+                    ("-gnats myust be first if combined with other switches");
+               end if;
+
+               Ptr := Ptr + 1;
+               Operating_Mode := Check_Syntax;
+
+            --  Processing for t switch
+
+            when 't' =>
+               Ptr := Ptr + 1;
+               Tree_Output := True;
+               Back_Annotate_Rep_Info := True;
+
+            --  Processing for T switch
+
+            when 'T' =>
+               Ptr := Ptr + 1;
+               Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);
+
+            --  Processing for u switch
+
+            when 'u' =>
+               Ptr := Ptr + 1;
+               List_Units := True;
+
+            --  Processing for U switch
+
+            when 'U' =>
+               Ptr := Ptr + 1;
+               Unique_Error_Tag := True;
+
+            --  Processing for v switch
+
+            when 'v' =>
+               Ptr := Ptr + 1;
+               Verbose_Mode := True;
+
+            --  Processing for V switch
+
+            when 'V' =>
+               Store_Switch := False;
+               Storing (First_Stored) := 'V';
+               Ptr := Ptr + 1;
+
+               if Ptr > Max then
+                  raise Bad_Switch;
+
+               else
+                  declare
+                     OK  : Boolean;
+
+                  begin
+                     Set_Validity_Check_Options
+                       (Switch_Chars (Ptr .. Max), OK, Ptr);
+
+                     if not OK then
+                        raise Bad_Switch;
+                     end if;
+
+                     for Index in First_Char + 1 .. Max loop
+                        Storing (First_Stored + 1) :=
+                          Switch_Chars (Index);
+                        Store_Compilation_Switch
+                          (Storing (Storing'First .. First_Stored + 1));
+                     end loop;
+                  end;
+               end if;
+
+               Ptr := Max + 1;
+
+            --  Processing for w switch
+
+            when 'w' =>
+               Store_Switch := False;
+               Storing (First_Stored) := 'w';
+               Ptr := Ptr + 1;
+
+               if Ptr > Max then
+                  raise Bad_Switch;
+               end if;
+
+               while Ptr <= Max loop
+                  C := Switch_Chars (Ptr);
+
+                  case C is
+
+                     when 'a' =>
+                        Constant_Condition_Warnings     := True;
+                        Elab_Warnings                   := True;
+                        Check_Unreferenced              := True;
+                        Check_Withs                     := True;
+                        Check_Unreferenced_Formals      := True;
+                        Implementation_Unit_Warnings    := True;
+                        Ineffective_Inline_Warnings     := True;
+                        Warn_On_Redundant_Constructs    := True;
+
+                     when 'A' =>
+                        Constant_Condition_Warnings     := False;
+                        Elab_Warnings                   := False;
+                        Check_Unreferenced              := False;
+                        Check_Withs                     := False;
+                        Check_Unreferenced_Formals      := False;
+                        Implementation_Unit_Warnings    := False;
+                        Warn_On_Biased_Rounding         := False;
+                        Warn_On_Dereference             := False;
+                        Warn_On_Hiding                  := False;
+                        Warn_On_Redundant_Constructs    := False;
+                        Ineffective_Inline_Warnings     := False;
+
+                     when 'b' =>
+                        Warn_On_Biased_Rounding         := True;
+
+                     when 'B' =>
+                        Warn_On_Biased_Rounding         := False;
+
+                     when 'c' =>
+                        Constant_Condition_Warnings     := True;
+
+                     when 'C' =>
+                        Constant_Condition_Warnings     := False;
+
+                     when 'd' =>
+                        Warn_On_Dereference             := True;
+
+                     when 'D' =>
+                        Warn_On_Dereference             := False;
+
+                     when 'e' =>
+                        Warning_Mode                    := Treat_As_Error;
+
+                     when 'f' =>
+                        Check_Unreferenced_Formals      := True;
+
+                     when 'F' =>
+                        Check_Unreferenced_Formals      := False;
+
+                     when 'h' =>
+                        Warn_On_Hiding                  := True;
+
+                     when 'H' =>
+                        Warn_On_Hiding                  := False;
+
+                     when 'i' =>
+                        Implementation_Unit_Warnings    := True;
+
+                     when 'I' =>
+                        Implementation_Unit_Warnings    := False;
+
+                     when 'l' =>
+                        Elab_Warnings                   := True;
+
+                     when 'L' =>
+                        Elab_Warnings                   := False;
+
+                     when 'o' =>
+                        Address_Clause_Overlay_Warnings := True;
+
+                     when 'O' =>
+                        Address_Clause_Overlay_Warnings := False;
+
+                     when 'p' =>
+                        Ineffective_Inline_Warnings     := True;
+
+                     when 'P' =>
+                        Ineffective_Inline_Warnings     := False;
+
+                     when 'r' =>
+                        Warn_On_Redundant_Constructs    := True;
+
+                     when 'R' =>
+                        Warn_On_Redundant_Constructs    := False;
+
+                     when 's' =>
+                        Warning_Mode                    := Suppress;
+
+                     when 'u' =>
+                        Check_Unreferenced              := True;
+                        Check_Withs                     := True;
+                        Check_Unreferenced_Formals      := True;
+
+                     when 'U' =>
+                        Check_Unreferenced              := False;
+                        Check_Withs                     := False;
+                        Check_Unreferenced_Formals      := False;
+
+                        --  Allow and ignore 'w' so that the old
+                        --  format (e.g. -gnatwuwl) will work.
+
+                     when 'w' =>
+                        null;
+
+                     when others =>
+                        raise Bad_Switch;
+                  end case;
+
+                  if C /= 'w' then
+                     Storing (First_Stored + 1) := C;
+                     Store_Compilation_Switch
+                       (Storing (Storing'First .. First_Stored + 1));
+                  end if;
+
+                  Ptr := Ptr + 1;
+               end loop;
+
+               return;
+
+            --  Processing for W switch
+
+            when 'W' =>
+               Ptr := Ptr + 1;
+
+               if Ptr > Max then
+                  raise Bad_Switch;
+               end if;
+
+               for J in WC_Encoding_Method loop
+                  if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
+                     Wide_Character_Encoding_Method := J;
+                     exit;
+
+                  elsif J = WC_Encoding_Method'Last then
+                     raise Bad_Switch;
+                  end if;
+               end loop;
+
+               Upper_Half_Encoding :=
+                 Wide_Character_Encoding_Method in
+                 WC_Upper_Half_Encoding_Method;
+
+               Ptr := Ptr + 1;
+
+            --  Processing for x switch
+
+            when 'x' =>
+               Ptr := Ptr + 1;
+               Xref_Active := False;
+
+            --  Processing for X switch
+
+            when 'X' =>
+               Ptr := Ptr + 1;
+               Extensions_Allowed := True;
+
+            --  Processing for y switch
+
+            when 'y' =>
+               Ptr := Ptr + 1;
+
+               if Ptr > Max then
+                  Set_Default_Style_Check_Options;
+
+               else
+                  Store_Switch := False;
+                  Storing (First_Stored) := 'y';
+
+                  declare
+                     OK  : Boolean;
+                     Last_Stored : Integer;
+
+                  begin
+                     Set_Style_Check_Options
+                       (Switch_Chars (Ptr .. Max), OK, Ptr);
+
+                     if not OK then
+                        raise Bad_Switch;
+                     end if;
+
+                     Ptr := First_Char + 1;
+
+                     while Ptr <= Max loop
+                        Last_Stored := First_Stored + 1;
+                        Storing (Last_Stored) := Switch_Chars (Ptr);
+
+                        if Switch_Chars (Ptr) = 'M' then
+                           loop
+                              Ptr := Ptr + 1;
+                              exit when Ptr > Max
+                                or else Switch_Chars (Ptr) not in '0' .. '9';
+                              Last_Stored := Last_Stored + 1;
+                              Storing (Last_Stored) := Switch_Chars (Ptr);
+                           end loop;
+
+                        else
+                           Ptr := Ptr + 1;
+                        end if;
+
+                        Store_Compilation_Switch
+                          (Storing (Storing'First .. Last_Stored));
+                     end loop;
+                  end;
+               end if;
+
+            --  Processing for z switch
+
+            when 'z' =>
+               Ptr := Ptr + 1;
+
+               --  Allowed for compiler, only if this is the only
+               --  -z switch, we do not allow multiple occurrences
+
+               if Distribution_Stub_Mode = No_Stubs then
+                  case Switch_Chars (Ptr) is
+                     when 'r' =>
+                        Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
+
+                     when 'c' =>
+                        Distribution_Stub_Mode := Generate_Caller_Stub_Body;
+
+                     when others =>
+                        raise Bad_Switch;
+                  end case;
+
+                  Ptr := Ptr + 1;
+
+               end if;
+
+            --  Processing for Z switch
+
+            when 'Z' =>
+               Ptr := Ptr + 1;
+               Zero_Cost_Exceptions_Set := True;
+               Zero_Cost_Exceptions_Val := True;
+
+            --  Processing for 83 switch
+
+            when '8' =>
+
+               if Ptr = Max then
+                  raise Bad_Switch;
+               end if;
+
+               Ptr := Ptr + 1;
+
+               if Switch_Chars (Ptr) /= '3' then
+                  raise Bad_Switch;
+               else
+                  Ptr := Ptr + 1;
+                  Ada_95 := False;
+                  Ada_83 := True;
+               end if;
+
+            --  Ignore extra switch character
+
+            when '/' | '-' =>
+               Ptr := Ptr + 1;
+
+            --  Anything else is an error (illegal switch character)
+
+            when others =>
+               raise Bad_Switch;
+            end case;
+         end case;
+
+         if Store_Switch then
+            Storing (First_Stored .. First_Stored + Ptr - First_Char - 1) :=
+              Switch_Chars (First_Char .. Ptr - 1);
+            Store_Compilation_Switch
+              (Storing (Storing'First .. First_Stored + Ptr - First_Char - 1));
+         end if;
+
+         First_Switch := False;
+      end loop;
+
+   exception
+      when Bad_Switch =>
+         Osint.Fail ("invalid switch: ", (1 => C));
+
+      when Bad_Switch_Value =>
+         Osint.Fail ("numeric value too big for switch: ", (1 => C));
+
+      when Missing_Switch_Value =>
+         Osint.Fail ("missing numeric value for switch: ", (1 => C));
+
+   end Scan_Front_End_Switches;
+
+end Switch.C;

gcc/ada/switch-c.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - C                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001 Free Software Foundation, Inc.               --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package scans front end switches. Note that the body of Usage must be
+--  coordinated with the switches that are recognized by this package.
+--  The Usage package also acts as the official documentation for the
+--  switches that are recognized. In addition, package Debug documents
+--  the otherwise undocumented debug switches that are also recognized.
+
+package Switch.C is
+
+   procedure Scan_Front_End_Switches (Switch_Chars : String);
+   --  Procedures to scan out front end switches stored in the given string.
+   --  The first character is known to be a valid switch character, and there
+   --  are no blanks or other switch terminator characters in the string, so
+   --  the entire string should consist of valid switch characters, except that
+   --  an optional terminating NUL character is allowed. A bad switch causes
+   --  a fatal error exit and control does not return. The call also sets
+   --  Usage_Requested to True if a ? switch is encountered.
+
+end Switch.C;

gcc/ada/switch-m.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - M                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001-2002 Free Software Foundation, Inc.          --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Debug;    use Debug;
+with Osint;    use Osint;
+with Opt;      use Opt;
+with Table;
+
+package body Switch.M is
+
+   package Normalized_Switches is new Table.Table
+     (Table_Component_Type => String_Access,
+      Table_Index_Type     => Integer,
+      Table_Low_Bound      => 1,
+      Table_Initial        => 20,
+      Table_Increment      => 100,
+      Table_Name           => "Switch.C.Normalized_Switches");
+   --  This table is used to keep the normalized switches, so that they may be
+   --  reused for subsequent invocations of Normalize_Compiler_Switches with
+   --  similar switches.
+
+   Initial_Number_Of_Switches : constant := 10;
+
+   Global_Switches : Argument_List_Access := null;
+   --  Used by function Normalize_Compiler_Switches
+
+   ---------------------------------
+   -- Normalize_Compiler_Switches --
+   ---------------------------------
+
+   procedure Normalize_Compiler_Switches
+     (Switch_Chars : String;
+      Switches     : in out Argument_List_Access;
+      Last         : out Natural)
+   is
+      Switch_Starts_With_Gnat : Boolean;
+
+      Ptr : Integer := Switch_Chars'First;
+      Max : constant Integer := Switch_Chars'Last;
+      C   : Character := ' ';
+
+      First_Char   : Integer := Ptr;
+      Storing      : String := Switch_Chars;
+      First_Stored : Positive := Ptr + 1;
+      Last_Stored  : Positive := First_Stored;
+
+      procedure Add_Switch_Component (S : String);
+      --  Add a new String_Access component in Switches. If a string equal
+      --  to S is already stored in the table Normalized_Switches, use it.
+      --  Other wise add a new component to the table.
+
+      --------------------------
+      -- Add_Switch_Component --
+      --------------------------
+
+      procedure Add_Switch_Component (S : String) is
+      begin
+         --  If Switches is null, allocate a new array
+
+         if Switches = null then
+            Switches := new Argument_List (1 .. Initial_Number_Of_Switches);
+
+         --  otherwise, if Switches is full, extend it
+
+         elsif Last = Switches'Last then
+            declare
+               New_Switches : Argument_List_Access := new Argument_List
+                 (1 .. Switches'Length + Switches'Length);
+            begin
+               New_Switches (1 .. Switches'Length) := Switches.all;
+               Last := Switches'Length;
+               Switches := New_Switches;
+            end;
+         end if;
+
+         --  If this is the first switch, Last designates the first component
+         if Last = 0 then
+            Last := Switches'First;
+
+         else
+            Last := Last + 1;
+         end if;
+
+         --  Look into the table Normalized_Switches for a similar string.
+         --  If one is found, put it at the added component, and return.
+
+         for Index in 1 .. Normalized_Switches.Last loop
+            if S = Normalized_Switches.Table (Index).all then
+               Switches (Last) := Normalized_Switches.Table (Index);
+               return;
+            end if;
+         end loop;
+
+         --  No string equal to S was found in the table Normalized_Switches.
+         --  Add a new component in the table.
+
+         Switches (Last) := new String'(S);
+         Normalized_Switches.Increment_Last;
+         Normalized_Switches.Table (Normalized_Switches.Last) :=
+           Switches (Last);
+      end Add_Switch_Component;
+
+   --  Start of processing for Normalize_Compiler_Switches
+
+   begin
+      Last := 0;
+
+      if Ptr = Max or else Switch_Chars (Ptr) /= '-' then
+         return;
+      end if;
+
+      Ptr := Ptr + 1;
+
+      Switch_Starts_With_Gnat :=
+         Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
+
+      if Switch_Starts_With_Gnat then
+         Ptr := Ptr + 4;
+         First_Stored := Ptr;
+      end if;
+
+      while Ptr <= Max loop
+         First_Char := Ptr;
+         C := Switch_Chars (Ptr);
+
+         --  Processing for a switch
+
+         case Switch_Starts_With_Gnat is
+
+            when False =>
+               --  All switches that don't start with -gnat stay as is
+
+               Add_Switch_Component (Switch_Chars);
+               return;
+
+            when True =>
+
+               case C is
+
+                  --  One-letter switches
+
+                  when 'a' | 'A' | 'b' | 'c' | 'C' | 'D' | 'E' | 'f' |
+                    'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' |
+                    'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' |
+                    'u' | 'U' | 'v' | 'x' | 'X' | 'Z' =>
+                     Storing (First_Stored) := C;
+                     Add_Switch_Component
+                       (Storing (Storing'First .. First_Stored));
+                     Ptr := Ptr + 1;
+
+                  --  One-letter switches followed by a positive number
+
+                  when 'm' | 'T' =>
+                     Storing (First_Stored) := C;
+                     Last_Stored := First_Stored;
+
+                     loop
+                        Ptr := Ptr + 1;
+                        exit when Ptr > Max
+                          or else Switch_Chars (Ptr) not in '0' .. '9';
+                        Last_Stored := Last_Stored + 1;
+                        Storing (Last_Stored) := Switch_Chars (Ptr);
+                     end loop;
+
+                     Add_Switch_Component
+                       (Storing (Storing'First .. Last_Stored));
+
+                  when 'd' =>
+                     Storing (First_Stored) := 'd';
+
+                     while Ptr < Max loop
+                        Ptr := Ptr + 1;
+                        C := Switch_Chars (Ptr);
+                        exit when C = ASCII.NUL or else C = '/'
+                          or else C = '-';
+
+                        if C in '1' .. '9' or else
+                           C in 'a' .. 'z' or else
+                           C in 'A' .. 'Z'
+                        then
+                           Storing (First_Stored + 1) := C;
+                           Add_Switch_Component
+                             (Storing (Storing'First .. First_Stored + 1));
+
+                        else
+                           Last := 0;
+                           return;
+                        end if;
+                     end loop;
+
+                     return;
+
+                  when 'e' =>
+                     --  None of the -gnate switches (-gnatec and -gnatem)
+                     --  need to be store in an ALI file.
+
+                     return;
+
+                  when 'i' =>
+                     Storing (First_Stored) := 'i';
+
+                     Ptr := Ptr + 1;
+
+                     if Ptr > Max then
+                        Last := 0;
+                        return;
+                     end if;
+
+                     C := Switch_Chars (Ptr);
+
+                     if C in '1' .. '5'
+                       or else C = '8'
+                       or else C = 'p'
+                       or else C = 'f'
+                       or else C = 'n'
+                       or else C = 'w'
+                     then
+                        Storing (First_Stored + 1) := C;
+                        Add_Switch_Component
+                          (Storing (Storing'First .. First_Stored + 1));
+                        Ptr := Ptr + 1;
+
+                     else
+                        Last := 0;
+                        return;
+                     end if;
+
+                  --  -gnatR may be followed by '0', '1', '2' or '3',
+                  --  then by 's'
+
+                  when 'R' =>
+                     Last_Stored := First_Stored;
+                     Storing (Last_Stored) := 'R';
+                     Ptr := Ptr + 1;
+
+                     if Ptr <= Max
+                       and then Switch_Chars (Ptr) in '0' .. '9'
+                     then
+                        C := Switch_Chars (Ptr);
+
+                        if C in '4' .. '9' then
+                           Last := 0;
+                           return;
+
+                        else
+                           Last_Stored := Last_Stored + 1;
+                           Storing (Last_Stored) := C;
+                           Ptr := Ptr + 1;
+
+                           if Ptr <= Max
+                             and then Switch_Chars (Ptr) = 's' then
+                              Last_Stored := Last_Stored + 1;
+                              Storing (Last_Stored) := 's';
+                              Ptr := Ptr + 1;
+                           end if;
+                        end if;
+                     end if;
+
+                     Add_Switch_Component
+                       (Storing (Storing'First .. Last_Stored));
+
+                  --  Multiple switches
+
+                  when 'V' | 'w' | 'y' =>
+                     Storing (First_Stored) := C;
+                     Ptr := Ptr + 1;
+
+                     if Ptr > Max then
+                        if C = 'y' then
+                           Add_Switch_Component
+                             (Storing (Storing'First .. First_Stored));
+
+                        else
+                           Last := 0;
+                           return;
+                        end if;
+                     end if;
+
+                     while Ptr <= Max loop
+                        C := Switch_Chars (Ptr);
+                        Ptr := Ptr + 1;
+
+                        --  'w' should be skipped in -gnatw
+
+                        if C /= 'w' or else Storing (First_Stored) /= 'w' then
+
+                           --  -gnatyMxxx
+
+                           if C = 'M'
+                             and then Storing (First_Stored) = 'y' then
+                              Last_Stored := First_Stored + 1;
+                              Storing (Last_Stored) := 'M';
+
+                              while Ptr <= Max loop
+                                 C := Switch_Chars (Ptr);
+                                 exit when C not in '0' .. '9';
+                                 Last_Stored := Last_Stored + 1;
+                                 Storing (Last_Stored) := C;
+                                 Ptr := Ptr + 1;
+                              end loop;
+
+                              --  If there is no digit after -gnatyM,
+                              --  the switch is invalid.
+
+                              if Last_Stored = First_Stored + 1 then
+                                 Last := 0;
+                                 return;
+
+                              else
+                                 Add_Switch_Component
+                                   (Storing (Storing'First .. Last_Stored));
+                              end if;
+
+                           --  All other switches are -gnatxx
+
+                           else
+                              Storing (First_Stored + 1) := C;
+                              Add_Switch_Component
+                                (Storing (Storing'First .. First_Stored + 1));
+                           end if;
+                        end if;
+                     end loop;
+
+                  --  Not a valid switch
+
+                  when others =>
+                     Last := 0;
+                     return;
+
+               end case;
+
+         end case;
+      end loop;
+   end Normalize_Compiler_Switches;
+
+   function Normalize_Compiler_Switches
+     (Switch_Chars : String)
+      return         Argument_List
+   is
+      Last : Natural;
+
+   begin
+      Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last);
+
+      if Last = 0 then
+         return (1 .. 0 => null);
+
+      else
+         return Global_Switches (Global_Switches'First .. Last);
+      end if;
+
+   end Normalize_Compiler_Switches;
+
+   ------------------------
+   -- Scan_Make_Switches --
+   ------------------------
+
+   procedure Scan_Make_Switches (Switch_Chars : String) is
+      Ptr : Integer := Switch_Chars'First;
+      Max : Integer := Switch_Chars'Last;
+      C   : Character := ' ';
+
+   begin
+      --  Skip past the initial character (must be the switch character)
+
+      if Ptr = Max then
+         raise Bad_Switch;
+
+      else
+         Ptr := Ptr + 1;
+      end if;
+
+      --  A little check, "gnat" at the start of a switch is not allowed
+      --  except for the compiler (where it was already removed)
+
+      if Switch_Chars'Length >= Ptr + 3
+        and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
+      then
+         Osint.Fail
+           ("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
+      end if;
+
+      --  Loop to scan through switches given in switch string
+
+      while Ptr <= Max loop
+         C := Switch_Chars (Ptr);
+
+         --  Processing for a switch
+
+         case C is
+
+         when 'a' =>
+            Ptr := Ptr + 1;
+            Check_Readonly_Files := True;
+
+         --  Processing for b switch
+
+         when 'b' =>
+            Ptr := Ptr + 1;
+            Bind_Only := True;
+
+         --  Processing for c switch
+
+         when 'c' =>
+            Ptr := Ptr + 1;
+            Compile_Only := True;
+
+         --  Processing for C switch
+
+         when 'C' =>
+            Ptr := Ptr + 1;
+            Create_Mapping_File := True;
+
+         --  Processing for d switch
+
+         when 'd' =>
+
+            --  Note: for the debug switch, the remaining characters in this
+            --  switch field must all be debug flags, since all valid switch
+            --  characters are also valid debug characters. This switch is not
+            --  documented on purpose because it is only used by the
+            --  implementors.
+
+            --  Loop to scan out debug flags
+
+            while Ptr < Max loop
+               Ptr := Ptr + 1;
+               C := Switch_Chars (Ptr);
+               exit when C = ASCII.NUL or else C = '/' or else C = '-';
+
+               if C in '1' .. '9' or else
+                  C in 'a' .. 'z' or else
+                  C in 'A' .. 'Z'
+               then
+                  Set_Debug_Flag (C);
+               else
+                  raise Bad_Switch;
+               end if;
+            end loop;
+
+            --  Make sure Zero_Cost_Exceptions is set if gnatdX set. This
+            --  is for backwards compatibility with old versions and usage.
+
+            if Debug_Flag_XX then
+               Zero_Cost_Exceptions_Set := True;
+               Zero_Cost_Exceptions_Val := True;
+            end if;
+
+            return;
+
+         --  Processing for f switch
+
+         when 'f' =>
+            Ptr := Ptr + 1;
+            Force_Compilations := True;
+
+         --  Processing for h switch
+
+         when 'h' =>
+            Ptr := Ptr + 1;
+            Usage_Requested := True;
+
+         --  Processing for i switch
+
+         when 'i' =>
+            Ptr := Ptr + 1;
+            In_Place_Mode := True;
+
+         --  Processing for j switch
+
+         when 'j' =>
+            Ptr := Ptr + 1;
+
+            declare
+               Max_Proc : Pos;
+            begin
+               Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
+               Maximum_Processes := Positive (Max_Proc);
+            end;
+
+         --  Processing for k switch
+
+         when 'k' =>
+            Ptr := Ptr + 1;
+            Keep_Going := True;
+
+         --  Processing for l switch
+
+         when 'l' =>
+            Ptr := Ptr + 1;
+            Link_Only := True;
+
+         when 'M' =>
+            Ptr := Ptr + 1;
+            List_Dependencies := True;
+
+         --  Processing for n switch
+
+         when 'n' =>
+            Ptr := Ptr + 1;
+            Do_Not_Execute := True;
+
+         --  Processing for o switch
+
+         when 'o' =>
+            Ptr := Ptr + 1;
+
+            if Output_File_Name_Present then
+               raise Too_Many_Output_Files;
+            else
+               Output_File_Name_Present := True;
+            end if;
+
+         --  Processing for q switch
+
+         when 'q' =>
+            Ptr := Ptr + 1;
+            Quiet_Output := True;
+
+         --  Processing for s switch
+
+         when 's' =>
+            Ptr := Ptr + 1;
+            Check_Switches := True;
+
+         --  Processing for v switch
+
+         when 'v' =>
+            Ptr := Ptr + 1;
+            Verbose_Mode := True;
+
+         --  Processing for z switch
+
+         when 'z' =>
+            Ptr := Ptr + 1;
+            No_Main_Subprogram := True;
+
+         --  Ignore extra switch character
+
+         when '/' | '-' =>
+            Ptr := Ptr + 1;
+
+         --  Anything else is an error (illegal switch character)
+
+         when others =>
+            raise Bad_Switch;
+
+         end case;
+      end loop;
+
+   exception
+      when Bad_Switch =>
+         Osint.Fail ("invalid switch: ", (1 => C));
+
+      when Bad_Switch_Value =>
+         Osint.Fail ("numeric value too big for switch: ", (1 => C));
+
+      when Missing_Switch_Value =>
+         Osint.Fail ("missing numeric value for switch: ", (1 => C));
+
+      when Too_Many_Output_Files =>
+         Osint.Fail ("duplicate -o switch");
+
+   end Scan_Make_Switches;
+
+end Switch.M;

gcc/ada/switch-m.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             S W I T C H - M                              --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                            $Revision$
+--                                                                          --
+--          Copyright (C) 2001 Free Software Foundation, Inc.               --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package scans make switches. Note that the body of Usage must be
+--  coordinated with the switches that are recognized by this package.
+--  The Usage package also acts as the official documentation for the
+--  switches that are recognized. In addition, package Debug documents
+--  the otherwise undocumented debug switches that are also recognized.
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+package Switch.M is
+
+   procedure Scan_Make_Switches (Switch_Chars : String);
+   --  Procedures to scan out binder switches stored in the given string.
+   --  The first character is known to be a valid switch character, and there
+   --  are no blanks or other switch terminator characters in the string, so
+   --  the entire string should consist of valid switch characters, except that
+   --  an optional terminating NUL character is allowed. A bad switch causes
+   --  a fatal error exit and control does not return. The call also sets
+   --  Usage_Requested to True if a ? switch is encountered.
+
+   procedure Normalize_Compiler_Switches
+     (Switch_Chars : String;
+      Switches     : in out Argument_List_Access;
+      Last         : out Natural);
+   --  Takes a compiler switch which potentially is equivalent to more
+   --  that one simple switches and returns the equivalent list of simple
+   --  switches that are stored in an ALI file. Switches will be extended
+   --  if initially null or too short. Last indicates the index in Switches
+   --  of the last simple switch. Last is equal to zero, if it has been
+   --  determined that Switch_Chars is ill-formed or does not contain any
+   --  switch that should be stored in an ALI file. Otherwise, the list of
+   --  simple switches is Switches (Switches'First .. Last).
+   --
+   --    Example: if Switch_Chars is equal to "-gnatAwue", then the list of
+   --    simple switches will have 3 components: -gnatA, -gnatwu, -gnatwe.
+   --
+   --  The String_Access components of Switches should not be deallocated:
+   --  they are shallow copies of components in a table in the body.
+
+   function Normalize_Compiler_Switches
+     (Switch_Chars : String)
+      return         Argument_List;
+   --  Similar to the previous procedure. The return value is the list of
+   --  simple switches. It may be an empty array if it has been determined
+   --  that Switch_Chars is ill-formed or does not contain any switch that
+   --  should be stored in an ALI file. The String_Access components of the
+   --  returned value should not be deallocated.
+
+end Switch.M;