xgnatugn.adb

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

           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;

      -----------------------------
      -- Maybe_Rewrite_Extension --
      -----------------------------

      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
                  if (not In_VMS_Section)
                    or else
                    Line (Token.VMS.First .. Token.VMS.Last) /=
                    Line (Token.Non_VMS.First .. Token.Non_VMS.Last)
                  then
                     Warning (Source_File, Token.First,
                              "VMS alternative already determined "
                                & "by conditionals");
                  end if;
               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 : Flag_Type;
            --  Its flag

         begin
            --  If the line starts with @ifset or @ifclear, we try to convert
            --  the following flag to one of our flag 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 := Flag_Type'Value (Arg);
                  Have_Conditional := True;

                  case Flag is
                     when Target_Type =>
                        if Translate (Target_Type'Image (Flag),
                                      Lower_Case_Map)
                                                      /= Arg
                        then
                           Error (Source_File, "flag has to be lowercase");
                        end if;

                     when Edition_Type =>
                        null;
                  end case;
               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 := Flag_Type'Value (Arg);
                  Have_Conditional := True;

                  case Flag is
                     when Target_Type =>
                        if Translate (Target_Type'Image (Flag),
                                      Lower_Case_Map)
                                                      /= Arg
                        then
                           Error (Source_File, "flag has to be lowercase");
                        end if;

                     when Edition_Type =>
                        null;
                  end case;
               exception
                  when Constraint_Error =>
                     Error (Source_File, "unknown flag for '@ifclear'");
               end;
            end if;

            if Have_Conditional and (Flag in Target_Type) 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
              and then (Flag in Target_Type)
            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) or (Flag in Edition_Type) 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;