* gnat_rm.texi: Do not include texiplus.texi. Include fdl.texi

	instead of gfdl.texi

	* xgnatug.adb, ug_words: New files.

	* Makefile.in (doc, dvi): New targets.  Build gnat_ug_*,
        gnat_rm and gnat-style manuals.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@52569 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 1429 insertions, 3 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fbcdc5391da..a17d36093e6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2002-04-21  Florian Weimer  <fw@deneb.enyo.de>
+
+	* gnat_rm.texi: Do not include texiplus.texi.  Include fdl.texi
+	instead of gfdl.texi
+
+	* xgnatug.adb, ug_words: New files.
+
+	* Makefile.in (doc, dvi): New targets.  Build gnat_ug_*,
+        gnat_rm and gnat-style manuals.
+
 2002-04-18  Neil Booth  <neil@daikokuya.demon.co.uk>
 
 	* gigi.h (incomplete_type_error): Remove.
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index 8a053144a62..4d73f9ca768 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -2140,6 +2140,42 @@ nmake.ads :  sinfo.ads nmake.adt xnmake.adb
 	$(CP) $^ bldtools
 	(cd bldtools; gnatmake -q xnmake ; ./xnmake -s ../nmake.ads )
 
+# We remove the generated .texi files to force regeneration.
+doctools/xgnatug : xgnatug.adb
+	-$(MKDIR) doctools
+	$(CP) $^ doctools
+	(cd doctools ; gnatmake -q xgnatug)
+	-rm gnat_ug_*.texi
+
+# We cannot list the dependency on the xgnatug binary here because we
+# have to (a) use the VPATH feature, and (b) include the target flag.
+gnat_ug_vms.texi : gnat_ug.texi ug_words
+	doctools/xgnatug vms $^
+
+gnat_ug_wnt.texi : gnat_ug.texi ug_words
+	doctools/xgnatug wnt $^
+
+gnat_ug_unx.texi : gnat_ug.texi ug_words
+	doctools/xgnatug unx $^
+
+gnat_ug_vxw.texi : gnat_ug.texi ug_words
+	doctools/xgnatug vxworks $^
+
+%.info : %.texi
+	$(MAKEINFO) -I $(srcdir)/../doc/include -o $@ $<
+
+%.dvi : %.texi
+	$(TEXI2DVI) -I $(srcdir)/../doc/include $<
+
+# List the dependency on the xgnatug binary explicitly (see above).
+doc : doctools/xgnatug \
+	gnat_ug_vms.info gnat_ug_wnt.info gnat_ug_unx.info gnat_ug_vxw.info \
+	gnat_rm.info gnat-style.info
+
+dvi : doctools/xgnatug \
+	gnat_ug_vms.dvi gnat_ug_wnt.dvi gnat_ug_unx.dvi gnat_ug_vxw.dvi \
+	gnat_rm.dvi gnat-style.dvi
+
 update-sources : treeprs.ads einfo.h sinfo.h nmake.adb nmake.ads
 	$(CP) $^ $(srcdir)
 
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 78ac26670f1..7d27ca9f642 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1,5 +1,4 @@
 \input texinfo   @c -*-texinfo-*-
-@input texiplus
 
 @c %**start of header
 
@@ -9,7 +8,7 @@
 @c                                                                            o
 @c                              G N A T _ RM                                  o
 @c                                                                            o
-@c                            $Revision: 1.254 $
+@c                            $Revision: 1.5 $
 @c                                                                            o
 @c              Copyright (C) 1995-2002 Free Software Foundation              o
 @c                                                                            o
@@ -11980,7 +11979,7 @@ attributes are recognized, although only a subset of them can sensibly
 be implemented.  The description of pragmas in this reference manual
 indicates whether or not they are applicable to non-VMS systems.
 
-@include gfdl.texi
+@include fdl.texi
 @c GNU Free Documentation License
 
 @node Index,,GNU Free Documentation License, Top
diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words
new file mode 100644
index 00000000000..708a7fe48bc
--- /dev/null
+++ b/gcc/ada/ug_words
@@ -0,0 +1,134 @@
+Ada_Switches            ^ Ada_Qualifiers
+b_                      ^ B_
+b~                      ^ B$
+cc1                     ^ CC1
+Cc1                     ^ CC1
+Default_Switches        ^ Default_Qualifiers
+emacs                   ^ EMACS
+Emacs                   ^ EMACS
+gdb                     ^ GDB
+Gdb                     ^ GDB
+gnat1                   ^ GNAT1
+Gnat1                   ^ GNAT1
+gnatbind                ^ GNAT BIND
+Gnatbind                ^ GNAT BIND
+gnatchop                ^ GNAT CHOP
+Gnatchop                ^ GNAT CHOP
+gnatelim                ^ GNAT ELIM
+Gnatelim                ^ GNAT ELIM
+gnatf                   ^ GNAT XREF
+Gnatf                   ^ GNAT XREF
+gnatfind                ^ GNAT FIND
+Gnatfind                ^ GNAT FIND
+gnatkr                  ^ GNAT KRUNCH
+Gnatkr                  ^ GNAT KRUNCH
+gnatlbr                 ^ GNAT LIBRARY
+Gnatlbr                 ^ GNAT LIBRARY
+gnatlink                ^ GNAT LINK
+Gnatlink                ^ GNAT LINK
+gnatls                  ^ GNAT LIST
+Gnatls                  ^ GNAT LIST
+gnatmake                ^ GNAT MAKE
+Gnatmake                ^ GNAT MAKE
+gnatprep                ^ GNAT PREPROCESS
+Gnatprep                ^ GNAT PREPROCESS
+gnatpsta                ^ GNAT STANDARD
+Gnatpsta                ^ GNAT STANDARD
+gnatstub                ^ GNAT STUB
+Gnatstub                ^ GNAT STUB
+gnatxref                ^ GNAT XREF
+Gnatxref                ^ GNAT XREF
+gcc                     ^ GNAT COMPILE
+gcc -c                  ^ GNAT COMPILE
+-gnata                  ^ /CHECKS=ASSERTIONS
+-gnatb                  ^ /WARNINGS=BRIEF
+-gnatc                  ^ /NOLOAD
+-gnatdc                 ^ /TRACE_UNITS
+-gnatdO                 ^ /REPORT_ERRORS=IMMEDIATE
+-gnatC                  ^ /COMPRESS_NAMES
+-gnatD                  ^ /XDEBUG
+-gnatE                  ^ /CHECKS=ELABORATION
+-gnatf                  ^ /REPORT_ERRORS=FULL
+-gnatF                  ^ /UPPERCASE_EXTERNALS
+-gnatg                  ^ /STYLE=GNAT
+-gnatG                  ^ /EXPAND_SOURCE
+-gnatk                  ^ /FILE_NAME_MAX_LENGTH
+-gnatl                  ^ /LIST
+-gnatm                  ^ /ERROR_LIMIT
+-gnatm2                 ^ /ERROR_LIMIT=2
+-gnatn                  ^ /INLINE=PRAGMA
+-gnato                  ^ /CHECKS=OVERFLOW
+-gnatp                  ^ /CHECKS=SUPPRESS_ALL
+-gnatP                  ^ /POLLING_ENABLE
+-gnatr                  ^ /STYLE=REFERENCE_MANUAL
+-gnatR                  ^ /REPRESENTATION_INFO
+-gnatR0                 ^ /REPRESENTATION_INFO=NONE
+-gnatR1                 ^ /REPRESENTATION_INFO=ARRAYS
+-gnatR2                 ^ /REPRESENTATION_INFO=OBJECTS
+-gnatR3                 ^ /REPRESENTATION_INFO=SYMBOLIC
+-gnatq                  ^ /TRY_SEMANTICS
+-gnatQ                  ^ /FORCE_ALI
+-gnats                  ^ /SYNTAX_ONLY
+-gnatt                  ^ /TREE_OUTPUT
+-gnatu                  ^ /UNITS_LIST
+-gnatU                  ^ /UNIQUE_ERROR_TAG
+-gnatv                  ^ /REPORT_ERRORS=VERBOSE
+-gnatV                  ^ /VALIDITY_CHECKING
+-gnatV0                 ^ /VALIDITY_CHECKING=NONE
+-gnatVd                 ^ /VALIDITY_CHECKING=RM
+-gnatVf                 ^ /VALIDITY_CHECKING=FULL
+-gnatwa                 ^ /WARNINGS=OPTIONAL
+-gnatwA                 ^ /WARNINGS=NOOPTIONAL
+-gnatwb                 ^ /WARNINGS=BIASED_ROUNDING
+-gnatwB                 ^ /WARNINGS=NOBIASED_ROUNDING
+-gnatwc                 ^ /WARNINGS=CONDITIONALS
+-gnatwC                 ^ /WARNINGS=NOCONDITIONALS
+-gnatwd                 ^ /WARNINGS=IMPLICIT_DEREFERENCE
+-gnatwD                 ^ /WARNINGS=NOIMPLICIT_DEREFERENCE
+-gnatwe                 ^ /WARNINGS=ERROR
+-gnatwf                 ^ /WARNINGS=UNREFERENCED_FORMALS
+-gnatwF                 ^ /WARNINGS=NOUNREFERENCED_FORMALS
+-gnatwh                 ^ /WARNINGS=HIDING
+-gnatwH                 ^ /WARNINGS=NOHIDING
+-gnatwi                 ^ /WARNINGS=IMPLEMENTATION
+-gnatwI                 ^ /WARNINGS=NOIMPLEMENTATION
+-gnatwl                 ^ /WARNINGS=ELABORATION
+-gnatwL                 ^ /WARNINGS=NOELABORATION
+-gnatwo                 ^ /WARNINGS=OVERLAYS
+-gnatwO                 ^ /WARNINGS=NOOVERLAYS
+-gnatwr                 ^ /WARNINGS=REDUNDANT
+-gnatwR                 ^ /WARNINGS=NOREDUNDANT
+-gnatws                 ^ /WARNINGS=SUPPRESS
+-gnatwu                 ^ /WARNINGS=UNUSED
+-gnatwU                 ^ /WARNINGS=NOUNUSED
+-gnatW8                 ^ /WIDE_CHARACTER_ENCODING=UTF8
+-gnatW?                 ^ /WIDE_CHARACTER_ENCODING=?
+-gnaty                  ^ /STYLE=
+-gnatzr                 ^ /DISTRIBUTION_STUBS=RECEIVER
+-gnatzs                 ^ /DISTRIBUTION_STUBS=SENDER
+-gnat83                 ^ /83
+-gnat95                 ^ /95
+-gnatx                  ^ /XREF=SUPPRESS
+-gnatX                  ^ /EXTENSIONS_ALLOWED
+--RTS                   ^ /RUNTIME_SYSTEM
+mode_switches           ^ mode_qualifiers
+switch                  ^ qualifier
+switches                ^ qualifiers
+Switch                  ^ Qualifier
+Switches                ^ Qualifiers
+switch-related          ^ qualifier-related
+stdout                  ^ SYS$OUTPUT
+stderr                  ^ SYS$ERROR
+-bargs                  ^ /BINDER_QUALIFIERS
+-cargs                  ^ /COMPILER_QUALIFIERS
+-largs                  ^ /LINKER_QUALIFIERS
+-aIDIR                  ^ /SOURCE_SEARCH=direc
+-aODIR                  ^ /OBJECT_SEARCH=direc
+-IDIR                   ^ /SEARCH=direc
+-nostdinc               ^ /NOSTD_INCLUDES
+-nostdlib               ^ /NOSTD_LIBRARIES
+-pFILE                  ^ /PROJECT=file
+-O0                     ^ /OPTIMIZE=NONE
+-O1                     ^ /OPTIMIZE=SOME
+-O2                     ^ /OPTIMIZE=ALL
+-O3                     ^ /OPTIMIZE=INLINING
diff --git a/gcc/ada/xgnatug.adb b/gcc/ada/xgnatug.adb
new file mode 100644
index 00000000000..81f94394ab0
--- /dev/null
+++ b/gcc/ada/xgnatug.adb
@@ -0,0 +1,1247 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                          GNAT SYSTEM UTILITIES                           --
+--                                                                          --
+--                              X G N A T U G                               --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 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.                                                      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This utility is used to process the source of gnat_ug.texi to make a
+--  version suitable for running through standard Texinfo processor. It takes
+--  three arguments. The first one is the target type of the manual, which
+--  can be one of:
+--
+--     unx       GNU
+--     vms       OpenVMS
+--     wnt       Mirosoft Windows
+--     vxworks   Embedded Platforms
+--
+--  The second parameter is the file name of the Texinfo file to be
+--  preprocessed.
+--
+--  The third parameter is the name of the word list.  This file is used for
+--  rewriting the VMS edition.  Each line contains a word mapping: The source
+--  word in the first column, the target words in the second column.  The
+--  columns are separated by a '^' character.  When preprocessing for VMS, the
+--  first word is replaced with the second.  (Words consist of letters,
+--  digits, and the four characters "?-_~". A sequence of multiple words can
+--  be replaced if they listed in the first column, separated by a single
+--  space character.  If multiple words are to be replaced, there has to be
+--  replacement for each prefix.)
+--
+--  The fourth parameter is the name of the output file.  It defaults to
+--  gnat_ug_unx.texi, gnat_ug_vms.texi, gnat_ug_wnt.texi or gnat_ug_vxw.texi,
+--  depending on the target.
+--
+--  The following steps are performed:
+--
+--     In VMS mode
+--
+--       Any occurrences of ^alpha^beta^ are replaced by beta. The sequence
+--       must fit on a single line, and there can only be one occurrence on a
+--       line.
+--
+--       Any occurrences of a word in the Ug_Words list are replaced by the
+--       appropriate vms equivalents. Note that replacements do not occur
+--       within ^alpha^beta^ sequences.
+--
+--       Any occurence of [filename].extension, where extension one of the
+--       following:
+--
+--           "o", "ads", "adb", "ali", "ada", "atb", "ats", "adc", "c"
+--
+--
+--       replaced by the appropriate VMS names (all upper case with .o
+--       replaced .OBJ). Note that replacements do not occur within
+--       ^alpha^beta^ sequences.
+--
+--     In UNX, VXWORKS or WNT mode
+--
+--       Any occurrences of ^alpha^beta^ are replaced by alpha. The sequence
+--       must fit on a single line.
+--
+--     In all modes
+--
+--       The sequence ^^^ is replaced by a single ^. This escape sequence
+--       must be used if the literal character ^ is to appear in the
+--       output. A line containing this escape sequence may not also contain
+--       a ^alpha^beta^ sequence.
+--
+--       Recognize @ifset and @ifclear (this is because we have menu problems
+--       if we let makeinfo handle the ifset/ifclear pairs
+
+with Ada.Command_Line; use Ada.Command_Line;
+with Ada.Strings; use Ada.Strings;
+with Ada.Strings.Fixed; use Ada.Strings.Fixed;
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+with Ada.Strings.Maps; use Ada.Strings.Maps;
+with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants;
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Spitbol; use GNAT.Spitbol;
+with GNAT.Spitbol.Table_VString; use GNAT.Spitbol.Table_VString;
+
+procedure Xgnatug is
+
+   procedure Usage;
+   --  Print usage information.  Invoked if an invalid command line is
+   --  encountered.
+
+   Output_File : File_Type;
+   --  The preprocessed output is written to this file.
+
+   type Input_File is record
+      Name : VString;
+      Data : File_Type;
+      Line : Natural := 0;
+   end record;
+   --  Records information on an input file.  Name and Line are used
+   --  in error messages, Line is updated automatically by Get_Line.
+
+   function Get_Line (Input : access Input_File) return String;
+   --  Returns a line from Input and performs the necessary
+   --  line-oriented checks (length, character set, trailing spaces).
+
+   Have_Errors : Boolean := False;
+   procedure Error
+     (Input        : Input_File;
+      At_Character : Natural;
+      Message      : String);
+   procedure Error
+     (Input        : Input_File;
+      Message      : String);
+   --  Prints a message reporting an error on line Input.Line.  If
+   --  At_Character is not 0, indicate the exact character at which
+   --  the error occurs.
+
+   procedure Warning
+     (Input        : Input_File;
+      At_Character : Natural;
+      Message      : String);
+   procedure Warning
+     (Input        : Input_File;
+      Message      : String);
+   --  Like Error, but just print a warning message.
+
+   Dictionary_File : aliased Input_File;
+   procedure Read_Dictionary_File;
+   --  Dictionary_File is opened using the name given on the command
+   --  line.  It contains the replacements for the Ug_Words list.
+   --  Read_Dictionary_File reads Dictionary_File and fills the
+   --  Ug_Words table.
+
+   Source_File : aliased Input_File;
+   procedure Process_Source_File;
+   --  Source_File is opened using the name given on the command line.
+   --  It contains the Texinfo source code.  Process_Source_File
+   --  performs the necessary replacements.
+
+   type Target_Type is (VMS, WNT, UNX, VXWORKS);
+   Target : Target_Type;
+   --  The target for which preprocessing is performed: VMS, Windows,
+   --  GNU, and embedded platforms ("UNX" and "VXWORKS" are misnomers).
+   --  The Target avariable is initialized using the command line.
+
+   Valid_Characters : constant Character_Set
+     := To_Set (Span => (' ',  '~'));
+   --  This array controls which characters are permitted in the input
+   --  file (after line breaks have been removed).  Valid characters
+   --  are all printable ASCII characters and the space character.
+
+   Word_Characters : constant Character_Set
+     := (To_Set (Ranges => (('0', '9'), ('a', 'z'), ('A', 'Z')))
+         or To_Set ("?-_~"));
+   --  The characters which are permitted in words.  Other (valid)
+   --  characters are assumed to be delimiters between words.  Note that
+   --  this set has to include all characters of the source words of the
+   --  Ug_Words dictionary.
+
+   Reject_Trailing_Spaces : constant Boolean := True;
+   --  Controls whether Xgnatug rejects superfluous space characters
+   --  at the end of lines.
+
+   Maximum_Line_Length : constant Positive := 2000;
+   Fatal_Line_Length_Limit : constant Positive := 5000;
+   Fatal_Line_Length : exception;
+   --  If Maximum_Line_Length is exceeded in an input file, an error
+   --  message is printed.  If Fatal_Line_Length is exceeded,
+   --  execution terminates with a Fatal_Line_Length exception.
+
+   VMS_Escape_Character : constant Character := '^';
+   --  The character used to mark VMS alternatives (^alpha^beta^).
+
+   Extensions : GNAT.Spitbol.Table_VString.Table (20);
+   procedure Initialize_Extensions;
+   --  This table records extensions and their replacement for
+   --  rewriting filenames in the VMS version of the manual.
+
+   function Is_Extension (Extension : String) return Boolean;
+   function Get_Replacement_Extension (Extension : String) return String;
+   --  These functions query the replacement table.  Is_Extension
+   --  checks if the given string is a known extension.
+   --  Get_Replacement returns the replacement extension.
+
+   Ug_Words : GNAT.Spitbol.Table_VString.Table (200);
+   function Is_Known_Word (Word : String) return Boolean;
+   function Get_Replacement_Word (Word : String) return String;
+   --  The Ug_Words table lists replacement words for the VMS version
+   --  of the manual.  Is_Known_Word and Get_Replacement_Word query
+   --  this table.  The table is filled using Read_Dictionary_File.
+
+   function Rewrite_Source_Line (Line : String) return String;
+   --  This subprogram takes a line and rewrites it according to Target.
+   --  It relies on information in Source_File to generate error messages.
+
+   type Conditional is (Set, Clear);
+   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type);
+   procedure Pop_Conditional (Cond : Conditional);
+   --  These subprograms deal with conditional processing (@ifset/@ifclear).
+   --  They rely on information in Source_File to generate error messages.
+
+   function Currently_Excluding return Boolean;
+   --  Returns true if conditional processing directives imply that the
+   --  current line should not be included in the output.
+
+   function VMS_Context_Determined return Boolean;
+   --  Returns true if, in the current conditional preprocessing context, we
+   --  always have a VMS or a non-VMS version, regardless of the value of
+   --  Target.
+
+   procedure Check_No_Pending_Conditional;
+   --  Checks that all preprocessing directives have been properly matched by
+   --  their @end counterpart.  If this is not the case, print an error
+   --  message.
+
+   --  The following definitions implement a stack to track the conditional
+   --  preprocessing context.
+
+   type Conditional_Context is record
+      Starting_Line : Positive;
+      Cond          : Conditional;
+      Flag          : Target_Type;
+      Excluding     : Boolean;
+   end record;
+
+   Conditional_Stack_Depth : constant := 3;
+   Conditional_Stack : array (1 .. Conditional_Stack_Depth)
+     of Conditional_Context;
+   Conditional_TOS : Natural := 0;
+   --  Pointer to the Top Of Stack for Conditional_Stack.
+
+   -----------------------------------
+   -- Implementation of Subprograms --
+   -----------------------------------
+
+   -----------
+   -- Usage --
+   -----------
+
+   procedure Usage is
+   begin
+      Put_Line (Standard_Error,
+                "usage: xgnatug TARGET SOURCE DICTIONARY [OUTFILE]");
+      New_Line;
+      Put_Line (Standard_Error, "TARGET is one of:");
+      for T in Target_Type'Range loop
+         Put_Line (Standard_Error, "  " & Target_Type'Image (T));
+      end loop;
+      New_Line;
+      Put_Line (Standard_Error, "SOURCE is the source file to process.");
+      New_Line;
+      Put_Line (Standard_Error, "DICTIONARY is the name of a file "
+                & "that contains word replacements");
+      Put_Line (Standard_Error, "for the VMS version.");
+      New_Line;
+      Put_Line (Standard_Error,
+                "OUT-FILE, if present, is the output file to be created;");
+      Put_Line (Standard_Error,
+                "If OUT-FILE is absent, the output file is one of " &
+                "gnat_ug_unx.texi, ");
+      Put_Line (Standard_Error,
+                "gnat_ug_vms.texi, gnat_ug_wnt.texi or gnat_ug_vxw.texi, " &
+                "depending on TARGET.");
+   end Usage;
+
+   --------------
+   -- Get_Line --
+   --------------
+
+   function Get_Line (Input : access Input_File) return String is
+      Line_Buffer : String (1 .. Fatal_Line_Length_Limit);
+      Last        : Natural;
+
+   begin
+      Input.Line := Input.Line + 1;
+      Get_Line (Input.Data, Line_Buffer, Last);
+      if Last = Line_Buffer'Last then
+         Error (Input.all, "line exceeds fatal line length limit");
+         raise Fatal_Line_Length;
+      end if;
+
+      declare
+         Line : String renames Line_Buffer (Line_Buffer'First .. Last);
+
+      begin
+         for J in Line'Range loop
+            if not Is_In (Line (J), Valid_Characters) then
+               Error (Input.all, J, "invalid character");
+               exit;
+            end if;
+         end loop;
+
+         if Line'Length > Maximum_Line_Length then
+            Warning (Input.all, Maximum_Line_Length + 1, "line too long");
+         end if;
+
+         if Reject_Trailing_Spaces
+           and then Line'Length > 0
+           and then Line (Line'Last) = ' '
+         then
+            Error (Input.all, Line'Last, "trailing space character");
+         end if;
+
+         return Trim (Line, Right);
+      end;
+   end Get_Line;
+
+   -----------
+   -- Error --
+   -----------
+
+   procedure Error
+     (Input        : Input_File;
+      Message      : String)
+   is
+   begin
+      Error (Input, 0, Message);
+   end Error;
+
+   procedure Error
+     (Input        : Input_File;
+      At_Character : Natural;
+      Message      : String)
+   is
+      Line_Image : constant String := Integer'Image (Input.Line);
+      At_Character_Image : constant String := Integer'Image (At_Character);
+      --  These variables are required because we have to drop the leading
+      --  space character.
+
+   begin
+      Have_Errors := True;
+      if At_Character > 0 then
+         Put_Line (Standard_Error,
+                   S (Input.Name) & ':'
+                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':'
+                   & At_Character_Image (At_Character_Image'First + 1
+                                         .. At_Character_Image'Last)
+                   & ": "
+                   & Message);
+      else
+         Put_Line (Standard_Error,
+                   S (Input.Name) & ':'
+                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last)
+                   & ": "
+                   & Message);
+      end if;
+   end Error;
+
+   -------------
+   -- Warning --
+   -------------
+
+   procedure Warning
+     (Input        : Input_File;
+      Message      : String)
+   is
+   begin
+      Warning (Input, 0, Message);
+   end Warning;
+
+   procedure Warning
+     (Input        : Input_File;
+      At_Character : Natural;
+      Message      : String)
+   is
+      Line_Image : constant String := Integer'Image (Input.Line);
+      At_Character_Image : constant String := Integer'Image (At_Character);
+      --  These variables are required because we have to drop the leading
+      --  space character.
+
+   begin
+      if At_Character > 0 then
+         Put_Line (Standard_Error,
+                   S (Input.Name) & ':'
+                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last) & ':'
+                   & At_Character_Image (At_Character_Image'First + 1
+                                         .. At_Character_Image'Last)
+                   & ": warning: "
+                   & Message);
+      else
+         Put_Line (Standard_Error,
+                   S (Input.Name) & ':'
+                   & Line_Image (Line_Image'First + 1 .. Line_Image'Last)
+                   & ": warning: "
+                   & Message);
+      end if;
+   end Warning;
+
+   --------------------------
+   -- Read_Dictionary_File --
+   --------------------------
+
+   procedure Read_Dictionary_File is
+   begin
+      while not End_Of_File (Dictionary_File.Data) loop
+         declare
+            Line  : String := Get_Line (Dictionary_File'Access);
+            Split : Natural := Index (Line, (1 => VMS_Escape_Character));
+
+         begin
+            if Line'Length = 0 then
+               Error (Dictionary_File, "empty line in dictionary file");
+            elsif Line (Line'First) = ' ' then
+               Error (Dictionary_File, 1, "line starts with space character");
+            elsif Split = 0 then
+               Error (Dictionary_File, "line does not contain "
+                      & VMS_Escape_Character & " character");
+            else
+               declare
+                  Source : constant String
+                    := Trim (Line (1 .. Split - 1), Both);
+                  Target : constant String
+                    := Trim (Line (Split + 1 .. Line'Last), Both);
+                  Two_Spaces : constant Natural
+                    := Index (Source, "  ");
+                  Non_Word_Character : constant Natural
+                    := Index (Source, Word_Characters or To_Set (" "),
+                              Outside);
+
+               begin
+                  if Two_Spaces /= 0 then
+                     Error (Dictionary_File, Two_Spaces,
+                            "multiple space characters in source word");
+                  end if;
+
+                  if Non_Word_Character /= 0 then
+                     Error (Dictionary_File, Non_Word_Character,
+                            "illegal character in source word");
+                  end if;
+
+                  if Source'Length = 0 then
+                     Error (Dictionary_File, "source is empty");
+                  elsif Target'Length = 0 then
+                     Error (Dictionary_File, "target is empty");
+                  else
+                     Set (Ug_Words, Source, V (Target));
+
+                     --  Ensure that if Source is a sequence of words
+                     --  "WORD1 WORD2 ...", we already have a mapping for
+                     --  "WORD1".
+
+                     for J in Source'Range loop
+                        if Source (J) = ' ' then
+                           declare
+                              Prefix : String renames Source (Source'First
+                                                              .. J - 1);
+
+                           begin
+                              if not Is_Known_Word (Prefix) then
+                                 Error (Dictionary_File,
+                                        "prefix '" & Prefix
+                                        & "' not known at this point");
+                              end if;
+                           end;
+                        end if;
+                     end loop;
+                  end if;
+               end;
+            end if;
+         end;
+      end loop;
+   end Read_Dictionary_File;
+
+   -------------------------
+   -- Process_Source_Line --
+   -------------------------
+
+   function Rewrite_Source_Line (Line : String) return String is
+
+      --  We use a simple lexer to split the line into tokens:
+      --
+      --    Word             consisting entirely of Word_Characters
+      --    VMS_Alternative  ^alpha^beta^ replacement (but not ^^^)
+      --    Space            a space character
+      --    Other            everything else (sequence of non-word characters)
+      --    VMS_Error        incomplete VMS alternative
+      --    End_Of_Line      no more characters on this line
+      --
+      --   A sequence of three VMS_Escape_Characters is automatically
+      --   collapsed to an Other token.
+
+      type Token_Span is record
+         First, Last : Positive;
+      end record;
+      --  The character range covered by a token in Line.
+
+      type Token_Kind is (End_Of_Line, Word, Other,
+                          VMS_Alternative, VMS_Error);
+      type Token_Record (Kind : Token_Kind := End_Of_Line) is record
+         First : Positive;
+         case Kind is
+            when Word | Other =>
+               Span : Token_Span;
+            when VMS_Alternative =>
+               Non_VMS, VMS : Token_Span;
+            when VMS_Error | End_Of_Line =>
+               null;
+         end case;
+      end record;
+
+      Input_Position : Positive := Line'First;
+      Token : Token_Record;
+      --  The position of the next character to be processed by Next_Token.
+
+      procedure Next_Token;
+      --  Returns the next token in Line, starting at Input_Position.
+
+      Rewritten_Line : VString;
+      --  Collects the line as it is rewritten.
+
+      procedure Rewrite_Word;
+      --  The current token is assumed to be a Word.  When processing the VMS
+      --  version of the manual, additional tokens are gathered to check if
+      --  we have a file name or a sequence of known words.
+
+      procedure Maybe_Rewrite_Extension;
+      --  The current token is assumed to be Other.  When processing the VMS
+      --  version of the manual and the token represents a single dot ".",
+      --  the following word is rewritten according to the rules for
+      --  extensions.
+
+      VMS_Token_Seen : Boolean := False;
+      --  This is set to true if a VMS_Alternative has been encountered, or a
+      --  ^^^ token.
+
+      procedure Next_Token is
+         Remaining_Line : String renames Line (Input_Position .. Line'Last);
+         Last_Character : Natural;
+
+      begin
+         if Remaining_Line'Length = 0 then
+            Token := (End_Of_Line, Remaining_Line'First);
+            return;
+         end if;
+
+         --  ^alpha^beta^, the VMS_Alternative case.
+
+         if Remaining_Line (Remaining_Line'First) = VMS_Escape_Character then
+            declare
+               VMS_Second_Character, VMS_Third_Character : Natural;
+
+            begin
+               if VMS_Token_Seen then
+                  Error (Source_File, Remaining_Line'First,
+                         "multiple " & VMS_Escape_Character
+                         & " characters on a single line");
+               else
+                  VMS_Token_Seen := True;
+               end if;
+
+               --  Find the second and third escape character.  If one of
+               --  them is not present, generate an error token.
+
+               VMS_Second_Character
+                 := Index (Remaining_Line (Remaining_Line'First + 1
+                                           .. Remaining_Line'Last),
+                           (1 => VMS_Escape_Character));
+               if VMS_Second_Character = 0 then
+                  Input_Position := Remaining_Line'Last + 1;
+                  Token := (VMS_Error, Remaining_Line'First);
+                  return;
+               end if;
+
+               VMS_Third_Character
+                 := Index (Remaining_Line (VMS_Second_Character + 1
+                                           .. Remaining_Line'Last),
+                           (1 => VMS_Escape_Character));
+               if VMS_Third_Character = 0 then
+                  Input_Position := Remaining_Line'Last + 1;
+                  Token := (VMS_Error, Remaining_Line'First);
+                  return;
+               end if;
+
+               --  Consume all the characters we are about to include in
+               --  the token.
+
+               Input_Position := VMS_Third_Character + 1;
+
+               --  Check if we are in a ^^^ situation, and return an Other
+               --  token in this case.
+
+               if Remaining_Line'First + 1 = VMS_Second_Character
+                 and then Remaining_Line'First + 2 = VMS_Third_Character
+               then
+                  Token := (Other, Remaining_Line'First,
+                            (Remaining_Line'First, Remaining_Line'First));
+                  return;
+               end if;
+
+               Token := (VMS_Alternative, Remaining_Line'First,
+                         (Remaining_Line'First + 1, VMS_Second_Character - 1),
+                         (VMS_Second_Character + 1, VMS_Third_Character - 1));
+               return;
+            end;
+         end if;                        --  VMS_Alternative
+
+         --  The Word case.  Search for characters not in Word_Characters.
+         --  We have found a word if the first non-word character is not
+         --  the first character in Remaining_Line, i.e. if Remaining_Line
+         --  starts with a word character.
+
+         Last_Character := Index (Remaining_Line, Word_Characters, Outside);
+         if Last_Character /= Remaining_Line'First then
+
+
+            --  If we haven't found a character which is not in
+            --  Word_Characters, all remaining characters are part of the
+            --  current Word token.
+
+            if Last_Character = 0 then
+               Last_Character := Remaining_Line'Last + 1;
+            end if;
+
+            Input_Position := Last_Character;
+            Token := (Word, Remaining_Line'First,
+                      (Remaining_Line'First, Last_Character - 1));
+            return;
+         end if;
+
+         --  Remaining characters are in the Other category.  To speed
+         --  up processing, we collect them together if there are several
+         --  of them.
+
+         Input_Position := Last_Character + 1;
+         Token :=  (Other, Remaining_Line'First,
+                    (Remaining_Line'First, Last_Character));
+      end Next_Token;
+
+      procedure Rewrite_Word is
+         First_Word : String
+           renames Line (Token.Span.First .. Token.Span.Last);
+
+      begin
+         --  We do not perform any error checking below, so we can just skip
+         --  all processing for the non-VMS version.
+
+         if Target /= VMS then
+            Append (Rewritten_Line, First_Word);
+            Next_Token;
+            return;
+         end if;
+
+         if Is_Known_Word (First_Word) then
+
+            --  If we have a word from the dictionary, we look for the
+            --  longest possible sequence we can rewrite.
+
+            declare
+               Seq : Token_Span := Token.Span;
+               Lost_Space : Boolean := False;
+
+            begin
+               Next_Token;
+               loop
+                  if Token.Kind = Other
+                    and then Line (Token.Span.First .. Token.Span.Last) = " "
+                  then
+                     Next_Token;
+                     if Token.Kind /= Word
+                       or else not Is_Known_Word (Line (Seq.First
+                                                        .. Token.Span.Last))
+                     then
+                        --  When we reach this point, the following
+                        --  conditions are true:
+                        --
+                        --  Seq is a known word.
+                        --  The previous token was a space character.
+                        --  Seq extended to the current token is not a
+                        --  known word.
+
+                        Lost_Space := True;
+                        exit;
+
+                     else
+
+                        --  Extend Seq to cover the current (known) word.
+
+                        Seq.Last := Token.Span.Last;
+                        Next_Token;
+                     end if;
+
+                  else
+                     --  When we reach this point, the following conditions
+                     --  are true:
+                     --
+                     --  Seq is a known word.
+                     --  The previous token was a word.
+                     --  The current token is not a space character.
+
+                     exit;
+                  end if;
+               end loop;
+
+               --  Rewrite Seq, and add the lost space if necessary.
+
+               Append (Rewritten_Line,
+                       Get_Replacement_Word (Line (Seq.First .. Seq.Last)));
+               if Lost_Space then
+                  Append (Rewritten_Line, ' ');
+               end if;
+
+               --  The unknown token will be processed during the
+               --  next iteration of the main loop.
+               return;
+            end;
+         end if;
+
+         Next_Token;
+         if Token.Kind = Other
+           and then Line (Token.Span.First .. Token.Span.Last) = "."
+         then
+
+            --  Deal with extensions.
+
+            Next_Token;
+            if Token.Kind = Word
+              and then Is_Extension (Line (Token.Span.First
+                                           .. Token.Span.Last))
+            then
+               --  We have discovered a file extension.  Convert the file
+               --  name to upper case.
+
+               Append (Rewritten_Line,
+                       Translate (First_Word, Upper_Case_Map) & '.');
+               Append (Rewritten_Line,
+                       Get_Replacement_Extension
+                       (Line (Token.Span.First .. Token.Span.Last)));
+               Next_Token;
+            else
+               --  We already have: Word ".", followed by an unknown
+               --  token.
+
+               Append (Rewritten_Line, First_Word & '.');
+
+               --  The unknown token will be processed during the next
+               --  iteration of the main loop.
+            end if;
+
+
+         else
+            --  We have an unknown Word, followed by an unknown token.
+            --  The unknown token will be processed by the outer loop.
+
+            Append (Rewritten_Line, First_Word);
+         end if;
+      end Rewrite_Word;
+
+      procedure Maybe_Rewrite_Extension is
+      begin
+         --  Again, we need no special processing in the non-VMS case.
+
+         if Target = VMS
+           and then Line (Token.Span.First .. Token.Span.Last) = "."
+         then
+            --  This extension is not preceded by a word, otherwise
+            --  Rewrite_Word would have handled it.
+
+            Next_Token;
+            if Token.Kind = Word
+              and then Is_Extension (Line (Token.Span.First
+                                           .. Token.Span.Last))
+            then
+               Append (Rewritten_Line, '.' & Get_Replacement_Extension
+                       (Line (Token.Span.First .. Token.Span.Last)));
+               Next_Token;
+            else
+               Append (Rewritten_Line, '.');
+            end if;
+         else
+            Append (Rewritten_Line, Line (Token.Span.First
+                                          .. Token.Span.Last));
+            Next_Token;
+         end if;
+      end Maybe_Rewrite_Extension;
+
+      --  Start of processing for Process_Source_Line
+
+   begin
+      --  The following parser recognizes the following special token
+      --  sequences:
+      --
+      --     Word "." Word    rewrite as file name if second word is extension
+      --     Word " " Word    rewrite as a single word using Ug_Words table
+
+      Next_Token;
+      loop
+         case Token.Kind is
+            when End_Of_Line =>
+               exit;
+
+            when Word  =>
+               Rewrite_Word;
+
+            when Other =>
+               Maybe_Rewrite_Extension;
+
+            when VMS_Alternative =>
+               if VMS_Context_Determined then
+                  Warning (Source_File, Token.First,
+                           "VMS alternative already determined "
+                           & "by conditionals");
+               end if;
+               if Target = VMS then
+                  Append (Rewritten_Line, Line (Token.VMS.First
+                                                .. Token.VMS.Last));
+               else
+                  Append (Rewritten_Line, Line (Token.Non_VMS.First
+                                                .. Token.Non_VMS.Last));
+               end if;
+               Next_Token;
+
+            when VMS_Error =>
+               Error (Source_File, Token.First, "invalid VMS alternative");
+               Next_Token;
+         end case;
+      end loop;
+      return S (Rewritten_Line);
+   end Rewrite_Source_Line;
+
+   -------------------------
+   -- Process_Source_File --
+   -------------------------
+
+   procedure Process_Source_File is
+      Ifset : constant String := "@ifset ";
+      Ifclear : constant String := "@ifclear ";
+      Endsetclear : constant String := "@end ";
+      --  Strings to be recognized for conditional processing.
+
+   begin
+      while not End_Of_File (Source_File.Data) loop
+         declare
+            Line : constant String := Get_Line (Source_File'Access);
+            Rewritten : constant String := Rewrite_Source_Line (Line);
+            --  We unconditionally rewrite the line so that we can check the
+            --  syntax of all lines, and not only those which are actually
+            --  included in the output.
+
+            Have_Conditional : Boolean := False;
+            --  True if we have encountered a conditional preprocessing
+            --  directive.
+            Cond : Conditional;
+            --  The kind of the directive.
+            Flag : Target_Type;
+            --  Its flag.
+
+         begin
+            --  If the line starts with @ifset or @ifclear, we try to convert
+            --  the following flag to one of our target types.  If we fail,
+            --  Have_Conditional remains False.
+
+            if Line'Length >= Ifset'Length
+              and then Line (1 .. Ifset'Length) = Ifset
+            then
+               Cond := Set;
+               declare
+                  Arg : constant String
+                    := Trim (Line (Ifset'Length + 1 .. Line'Last), Both);
+
+               begin
+                  Flag := Target_Type'Value (Arg);
+                  if Translate (Target_Type'Image (Flag), Lower_Case_Map)
+                    /= Arg
+                  then
+                     Error (Source_File, "flag has to be lowercase");
+                  end if;
+                  Have_Conditional := True;
+               exception
+                  when Constraint_Error =>
+                     Error (Source_File, "unknown flag for '@ifset'");
+               end;
+
+            elsif Line'Length >= Ifclear'Length
+              and then Line (1 .. Ifclear'Length) = Ifclear
+            then
+               Cond := Clear;
+               declare
+                  Arg : constant String
+                    := Trim (Line (Ifclear'Length + 1 .. Line'Last), Both);
+
+               begin
+                  Flag := Target_Type'Value (Arg);
+                  if Translate (Target_Type'Image (Flag), Lower_Case_Map)
+                    /= Arg
+                  then
+                     Error (Source_File, "flag has to be lowercase");
+                  end if;
+                  Have_Conditional := True;
+               exception
+                  when Constraint_Error =>
+                     Error (Source_File, "unknown flag for '@ifclear'");
+               end;
+            end if;
+
+            if Have_Conditional then
+               --  We create a new conditional context and suppress the
+               --  directive in the output.
+
+               Push_Conditional (Cond, Flag);
+
+            elsif Line'Length >= Endsetclear'Length
+              and then Line (1 .. Endsetclear'Length) = Endsetclear
+            then
+               --  The '@end ifset'/'@end ifclear' case is handled here.  We
+               --  have to pop the conditional context.
+
+               declare
+                  First, Last : Natural;
+               begin
+                  Find_Token (Source => Line (Endsetclear'Length + 1
+                                              .. Line'Length),
+                              Set    => Letter_Set,
+                              Test   => Inside,
+                              First  => First,
+                              Last   => Last);
+                  if Last = 0 then
+                     Error (Source_File, "'@end' without argument");
+                  else
+                     if Line (First .. Last) = "ifset" then
+                        Have_Conditional := True;
+                        Cond := Set;
+                     elsif Line (First .. Last) = "ifclear" then
+                        Have_Conditional := True;
+                        Cond := Clear;
+                     end if;
+
+                     if Have_Conditional then
+                        Pop_Conditional (Cond);
+                     end if;
+
+                     --  We fall through to the ordinary case for other @end
+                     --  directives.
+                  end if;               --  @end without argument
+               end;
+            end if;                     --  Have_Conditional
+
+            if not Have_Conditional then
+               --  The ordinary case.
+               if not Currently_Excluding then
+                  Put_Line (Output_File, Rewritten);
+               end if;
+            end if;
+         end;
+      end loop;
+      Check_No_Pending_Conditional;
+   end Process_Source_File;
+
+   ---------------------------
+   -- Initialize_Extensions --
+   ---------------------------
+
+   procedure Initialize_Extensions is
+
+      procedure Add (Extension : String);
+      --  Adds an extension which is replaced with itself (in upper
+      --  case).
+
+      procedure Add (Extension, Replacement : String);
+      --  Adds an extension with a custom replacement.
+
+      procedure Add (Extension : String) is
+      begin
+         Add (Extension, Translate (Extension, Upper_Case_Map));
+      end Add;
+
+      procedure Add (Extension, Replacement : String) is
+      begin
+         Set (Extensions, Extension, V (Replacement));
+      end Add;
+
+      --  Start of processing for Initialize_Extensions
+
+   begin
+      --  To avoid performance degradation, increase the constant in the
+      --  definition of Extensions above if you add more extensions here.
+
+      Add ("o", "OBJ");
+      Add ("ads");
+      Add ("adb");
+      Add ("ali");
+      Add ("ada");
+      Add ("atb");
+      Add ("ats");
+      Add ("adc");
+      Add ("c");
+   end Initialize_Extensions;
+
+   ------------------
+   -- Is_Extension --
+   ------------------
+
+   function Is_Extension (Extension : String) return Boolean is
+   begin
+      return Present (Extensions, Extension);
+   end Is_Extension;
+
+   -------------------------------
+   -- Get_Replacement_Extension --
+   -------------------------------
+
+   function Get_Replacement_Extension (Extension : String) return String is
+   begin
+      return S (Get (Extensions, Extension));
+   end Get_Replacement_Extension;
+
+   -------------------
+   -- Is_Known_Word --
+   -------------------
+
+   function Is_Known_Word (Word : String) return Boolean is
+   begin
+      return Present (Ug_Words, Word);
+   end Is_Known_Word;
+
+   --------------------------
+   -- Get_Replacement_Word --
+   --------------------------
+
+   function Get_Replacement_Word (Word : String) return String is
+   begin
+      return S (Get (Ug_Words, Word));
+   end Get_Replacement_Word;
+
+   ----------------------
+   -- Push_Conditional --
+   ----------------------
+
+   procedure Push_Conditional (Cond : Conditional; Flag : Target_Type) is
+      Will_Exclude : Boolean;
+   begin
+      --  If we are already in an excluding context, inherit this property,
+      --  otherwise calculate it from scratch.
+
+      if Conditional_TOS > 0
+        and then Conditional_Stack (Conditional_TOS).Excluding
+      then
+         Will_Exclude := True;
+      else
+         case Cond is
+            when Set =>
+               Will_Exclude := Flag /= Target;
+            when Clear =>
+               Will_Exclude := Flag = Target;
+         end case;
+      end if;
+
+      --  Check if the current directive is pointless because of a previous,
+      --  enclosing directive.
+
+      for J in 1 .. Conditional_TOS loop
+         if Conditional_Stack (J).Flag = Flag then
+            Warning (Source_File, "directive without effect because of line"
+                     & Integer'Image (Conditional_Stack (J).Starting_Line));
+         end if;
+      end loop;
+      Conditional_TOS := Conditional_TOS + 1;
+      Conditional_Stack (Conditional_TOS)
+        := (Starting_Line => Source_File.Line,
+            Cond          => Cond,
+            Flag          => Flag,
+            Excluding     => Will_Exclude);
+   end Push_Conditional;
+
+   ---------------------
+   -- Pop_Conditional --
+   ---------------------
+
+   procedure Pop_Conditional (Cond : Conditional) is
+   begin
+      if Conditional_TOS > 0 then
+         case Cond is
+            when Set =>
+               if Conditional_Stack (Conditional_TOS).Cond /= Set then
+                  Error (Source_File,
+                         "'@end ifset' does not match '@ifclear' at line"
+                         & Integer'Image (Conditional_Stack
+                                          (Conditional_TOS).Starting_Line));
+               end if;
+            when Clear =>
+               if Conditional_Stack (Conditional_TOS).Cond /= Clear then
+                  Error (Source_File,
+                         "'@end ifclear' does not match '@ifset' at line"
+                         & Integer'Image (Conditional_Stack
+                                          (Conditional_TOS).Starting_Line));
+               end if;
+         end case;
+         Conditional_TOS := Conditional_TOS - 1;
+      else
+         case Cond is
+            when Set =>
+               Error (Source_File,
+                      "'@end ifset' without corresponding '@ifset'");
+            when Clear =>
+               Error (Source_File,
+                      "'@end ifclear' without corresponding '@ifclear'");
+         end case;
+      end if;
+   end Pop_Conditional;
+
+   -------------------------
+   -- Currently_Excluding --
+   -------------------------
+
+   function Currently_Excluding return Boolean is
+   begin
+      return Conditional_TOS > 0
+        and then Conditional_Stack (Conditional_TOS).Excluding;
+   end Currently_Excluding;
+
+   ----------------------------
+   -- VMS_Context_Determined --
+   ----------------------------
+
+   function VMS_Context_Determined return Boolean is
+   begin
+      for J in 1 .. Conditional_TOS loop
+         if Conditional_Stack (J).Flag = VMS then
+            return True;
+         end if;
+      end loop;
+      return False;
+   end VMS_Context_Determined;
+
+   ----------------------------------
+   -- Check_No_Pending_Conditional --
+   ----------------------------------
+
+   procedure Check_No_Pending_Conditional is
+   begin
+      for J in 1 .. Conditional_TOS loop
+         case Conditional_Stack (J).Cond is
+            when Set =>
+               Error (Source_File, "Missing '@end ifset' for '@ifset' at line"
+                      & Integer'Image (Conditional_Stack (J).Starting_Line));
+            when Clear =>
+               Error (Source_File,
+                      "Missing '@end ifclear' for '@ifclear' at line"
+                      & Integer'Image (Conditional_Stack (J).Starting_Line));
+         end case;
+      end loop;
+   end Check_No_Pending_Conditional;
+
+   ------------------
+   -- Main Program --
+   ------------------
+
+   Valid_Command_Line : Boolean;
+   Output_File_Name   : VString;
+
+begin
+   Initialize_Extensions;
+
+   Valid_Command_Line := Argument_Count in 3 .. 4;
+
+   --  First argument: Target.
+
+   if Valid_Command_Line then
+      begin
+         Target := Target_Type'Value (Argument (1));
+      exception
+         when Constraint_Error =>
+            Valid_Command_Line := False;
+      end;
+   end if;
+
+   --  Second argument: Source_File.
+
+   if Valid_Command_Line then
+      begin
+         Source_File.Name := V (Argument (2));
+         Open (Source_File.Data, In_File, Argument (2));
+      exception
+         when Name_Error =>
+            Valid_Command_Line := False;
+      end;
+   end if;
+
+   --  Third argument: Dictionary_File.
+
+   if Valid_Command_Line then
+      begin
+         Dictionary_File.Name := V (Argument (3));
+         Open (Dictionary_File.Data, In_File, Argument (3));
+      exception
+         when Name_Error =>
+            Valid_Command_Line := False;
+      end;
+   end if;
+
+   --  Fourth argument: Output_File.
+
+   if Valid_Command_Line then
+      if Argument_Count = 4 then
+         Output_File_Name := V (Argument (4));
+      else
+         case Target is
+            when VMS =>
+               Output_File_Name := V ("gnat_ug_vms.texi");
+            when WNT =>
+               Output_File_Name := V ("gnat_ug_wnt.texi");
+            when UNX =>
+               Output_File_Name := V ("gnat_ug_unx.texi");
+            when VXWORKS =>
+               Output_File_Name := V ("gnat_ug_vxw.texi");
+         end case;
+      end if;
+
+      begin
+         Create (Output_File, Out_File, S (Output_File_Name));
+      exception
+         when Name_Error | Use_Error =>
+            Valid_Command_Line := False;
+      end;
+   end if;
+
+   if not Valid_Command_Line then
+      Usage;
+      Set_Exit_Status (Failure);
+   else
+      Read_Dictionary_File;
+      Close (Dictionary_File.Data);
+
+      --  Main processing starts here.
+
+      Process_Source_File;
+      Close (Output_File);
+      Close (Source_File.Data);
+      if Have_Errors then
+         Set_Exit_Status (Failure);
+      else
+         Set_Exit_Status (Success);
+      end if;
+   end if;
+end Xgnatug;