Skip to content

R
riscv-gcc-1
Commit 5c558dd9 by Florian Weimer Committed by Florian Weimer
Options

gnat_rm.texi: Do not include texiplus.texi. 

	* 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.

From-SVN: r52569
parent 9dda4cc8
Showing with 1429 additions and 3 deletions
gcc/ada/ChangeLog
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> 2002-04-18 Neil Booth <neil@daikokuya.demon.co.uk>
* gigi.h (incomplete_type_error): Remove. * gigi.h (incomplete_type_error): Remove.
......
gcc/ada/Makefile.in
...@@ -2140,6 +2140,42 @@ nmake.ads : sinfo.ads nmake.adt xnmake.adb ...@@ -2140,6 +2140,42 @@ nmake.ads : sinfo.ads nmake.adt xnmake.adb
$(CP) $^ bldtools $(CP) $^ bldtools
(cd bldtools; gnatmake -q xnmake ; ./xnmake -s ../nmake.ads ) (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 update-sources : treeprs.ads einfo.h sinfo.h nmake.adb nmake.ads
$(CP) $^ $(srcdir) $(CP) $^ $(srcdir)
......
gcc/ada/gnat_rm.texi
\input texinfo @c -*-texinfo-*- \input texinfo @c -*-texinfo-*-
@input texiplus
@c %**start of header @c %**start of header
...@@ -9,7 +8,7 @@ ...@@ -9,7 +8,7 @@
@c o @c o
@c G N A T _ RM o @c G N A T _ RM o
@c o @c o
@c $Revision: 1.254 $ @c $Revision: 1.5 $
@c o @c o
@c Copyright (C) 1995-2002 Free Software Foundation o @c Copyright (C) 1995-2002 Free Software Foundation o
@c o @c o
...@@ -11980,7 +11979,7 @@ attributes are recognized, although only a subset of them can sensibly ...@@ -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 be implemented. The description of pragmas in this reference manual
indicates whether or not they are applicable to non-VMS systems. indicates whether or not they are applicable to non-VMS systems.
@include gfdl.texi @include fdl.texi
@c GNU Free Documentation License @c GNU Free Documentation License
@node Index,,GNU Free Documentation License, Top @node Index,,GNU Free Documentation License, Top
......
gcc/ada/ug_words 0 → 100644
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
gcc/ada/xgnatug.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment