+ type Header_Symbol is (None, Attr, Conv, Prag);
+ -- A symbol in the header file
+
+ procedure Output_Header_Line (S : Header_Symbol);
+ -- Output header line
+
+ Header_Attr : aliased String := "Attr";
+ Header_Conv : aliased String := "Convention";
+ Header_Prag : aliased String := "Pragma";
+ -- Prefixes used in the header file
+
+ type String_Ptr is access all String;
+ Header_Prefix : constant array (Header_Symbol) of String_Ptr :=
+ (null,
+ Header_Attr'Access,
+ Header_Conv'Access,
+ Header_Prag'Access);
+
+ -- Patterns used in the spec file
+
+ Get_Attr : constant Pattern := Span (' ') & "Attribute_"
+ & Break (",)") * Name1;
+ Get_Conv : constant Pattern := Span (' ') & "Convention_"
+ & Break (",)") * Name1;
+ Get_Prag : constant Pattern := Span (' ') & "Pragma_"
+ & Break (",)") * Name1;
+
+ type Header_Symbol_Counter is array (Header_Symbol) of Natural;
+ Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0);
+
+ Header_Current_Symbol : Header_Symbol := None;
+ Header_Pending_Line : VString := Nul;
+
+ ------------------------
+ -- Output_Header_Line --
+ ------------------------
+
+ procedure Output_Header_Line (S : Header_Symbol) is
+ begin
+ -- Skip all the #define for S-prefixed symbols in the header.
+ -- Of course we are making implicit assumptions:
+ -- (1) No newline between symbols with the same prefix.
+ -- (2) Prefix order is the same as in snames.ads.
+
+ if Header_Current_Symbol /= S then
+ declare
+ Pat : constant String := "#define " & Header_Prefix (S).all;
+ In_Pat : Boolean := False;
+
+ begin
+ if Header_Current_Symbol /= None then
+ Put_Line (OutH, Header_Pending_Line);
+ end if;
+
+ loop
+ Line := Get_Line (InH);
+
+ if Match (Line, Pat) then
+ In_Pat := True;
+ elsif In_Pat then
+ Header_Pending_Line := Line;
+ exit;
+ else
+ Put_Line (OutH, Line);
+ end if;
+ end loop;
+
+ Header_Current_Symbol := S;
+ end;
+ end if;
+
+ -- Now output the line
+
+ Put_Line (OutH, "#define " & Header_Prefix (S).all
+ & "_" & Name1 & (30 - Length (Name1)) * ' '
+ & Header_Counter (S));
+ Header_Counter (S) := Header_Counter (S) + 1;
+ end Output_Header_Line;
+
+-- Start of processing for XSnames
+