xgnatugn.adb

理解和实践操作系统的一本好书

   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
      Number_Of_Errors := Number_Of_Errors + 1;

      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
      if Warnings_Enabled then
         Warning (Input, 0, Message);
      end if;
   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 not Warnings_Enabled then
         return;
      end if;

      Number_Of_Warnings := Number_Of_Warnings + 1;

      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  : constant String :=
                      Get_Line (Dictionary_File'Access);
            Split : constant 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;

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

      ----------------
      -- Next_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;

      ------------------
      -- Rewrite_Word --
      ------------------

      procedure Rewrite_Word is
         First_Word : String