1168404Spjd------------------------------------------------------------------------------ 2168404Spjd-- -- 3168404Spjd-- GNAT SYSTEM UTILITIES -- 4168404Spjd-- -- 5168404Spjd-- X S N A M E S T -- 6168404Spjd-- -- 7168404Spjd-- B o d y -- 8168404Spjd-- -- 9168404Spjd-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- 10168404Spjd-- -- 11168404Spjd-- GNAT is free software; you can redistribute it and/or modify it under -- 12168404Spjd-- terms of the GNU General Public License as published by the Free Soft- -- 13168404Spjd-- ware Foundation; either version 3, or (at your option) any later ver- -- 14168404Spjd-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15168404Spjd-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16168404Spjd-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17168404Spjd-- for more details. You should have received a copy of the GNU General -- 18168404Spjd-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19168404Spjd-- http://www.gnu.org/licenses for a complete copy of the license. -- 20168404Spjd-- -- 21168404Spjd-- GNAT was originally developed by the GNAT team at New York University. -- 22219089Spjd-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23307279Smav-- -- 24168404Spjd------------------------------------------------------------------------------ 25168404Spjd 26168404Spjd-- This utility is used to make a new version of the Snames package when new 27168404Spjd-- names are added. This version reads a template file from snames.ads-tmpl in 28168404Spjd-- which the numbers are all written as $, and generates a new version of the 29168404Spjd-- spec file snames.ads (written to snames.ns). It also reads snames.adb-tmpl 30168404Spjd-- and generates an updated body (written to snames.nb), and snames.h-tmpl and 31168404Spjd-- generates an updated C header file (written to snames.nh). 32168404Spjd 33168404Spjdwith Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 34168404Spjdwith Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; 35168404Spjdwith Ada.Strings.Maps; use Ada.Strings.Maps; 36168404Spjdwith Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; 37168404Spjdwith Ada.Text_IO; use Ada.Text_IO; 38168404Spjdwith Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; 39262093Savg 40262093Savgwith GNAT.Spitbol; use GNAT.Spitbol; 41262093Savgwith GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; 42209962Smm 43262093Savgwith XUtil; use XUtil; 44168404Spjd 45277553Sdelphijprocedure XSnamesT is 46277553Sdelphij 47269773Sdelphij subtype VString is GNAT.Spitbol.VString; 48262093Savg 49269773Sdelphij InS : Ada.Text_IO.File_Type; 50269773Sdelphij InB : Ada.Text_IO.File_Type; 51269773Sdelphij InH : Ada.Text_IO.File_Type; 52262093Savg 53269773Sdelphij OutS : Ada.Streams.Stream_IO.File_Type; 54269773Sdelphij OutB : Ada.Streams.Stream_IO.File_Type; 55269773Sdelphij OutH : Ada.Streams.Stream_IO.File_Type; 56269773Sdelphij 57262093Savg A, B : VString := Nul; 58307279Smav Line : VString := Nul; 59307279Smav Name0 : VString := Nul; 60307279Smav Name1 : VString := Nul; 61307279Smav Oval : VString := Nul; 62307279Smav Restl : VString := Nul; 63307279Smav 64185029Spjd Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name0 65269773Sdelphij & Span (' ') * B 66307279Smav & ": constant Name_Id := N + $;" 67269773Sdelphij & Rest * Restl; 68269773Sdelphij 69269773Sdelphij Get_Name : constant Pattern := "Name_" & Rest * Name1; 70168404Spjd Chk_Low : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1); 71269773Sdelphij Findu : constant Pattern := Span ('u') * A; 72269773Sdelphij 73269773Sdelphij Val : Natural; 74269773Sdelphij 75269773Sdelphij Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_"); 76269773Sdelphij 77307279Smav M : Match_Result; 78307279Smav 79307279Smav type Header_Symbol is (None, Name, Attr, Conv, Prag); 80168404Spjd -- A symbol in the header file 81269773Sdelphij 82269773Sdelphij procedure Output_Header_Line (S : Header_Symbol); 83269773Sdelphij -- Output header line 84269773Sdelphij 85269773Sdelphij Header_Name : aliased String := "Name"; 86269773Sdelphij Header_Attr : aliased String := "Attr"; 87262093Savg Header_Conv : aliased String := "Convention"; 88219089Spjd Header_Prag : aliased String := "Pragma"; 89269773Sdelphij -- Prefixes used in the header file 90269773Sdelphij 91269773Sdelphij type String_Ptr is access all String; 92269773Sdelphij Header_Prefix : constant array (Header_Symbol) of String_Ptr := 93307279Smav (null, 94269773Sdelphij Header_Name'Access, 95269773Sdelphij Header_Attr'Access, 96269773Sdelphij Header_Conv'Access, 97269773Sdelphij Header_Prag'Access); 98307279Smav 99307279Smav -- Patterns used in the spec file 100168404Spjd 101168404Spjd Get_Attr : constant Pattern := Span (' ') & "Attribute_" 102168404Spjd & Break (",)") * Name1; 103168404Spjd Get_Conv : constant Pattern := Span (' ') & "Convention_" 104168404Spjd & Break (",)") * Name1; 105168404Spjd Get_Prag : constant Pattern := Span (' ') & "Pragma_" 106 & Break (",)") * Name1; 107 108 type Header_Symbol_Counter is array (Header_Symbol) of Natural; 109 Header_Counter : Header_Symbol_Counter := (0, 0, 0, 0, 0); 110 111 Header_Current_Symbol : Header_Symbol := None; 112 Header_Pending_Line : VString := Nul; 113 114 ------------------------ 115 -- Output_Header_Line -- 116 ------------------------ 117 118 procedure Output_Header_Line (S : Header_Symbol) is 119 function Make_Value (V : Integer) return String; 120 -- Build the definition for the current macro (Names are integers 121 -- offset to N, while other items are enumeration values). 122 123 ---------------- 124 -- Make_Value -- 125 ---------------- 126 127 function Make_Value (V : Integer) return String is 128 begin 129 if S = Name then 130 return "(First_Name_Id + 256 + " & V & ")"; 131 else 132 return "" & V; 133 end if; 134 end Make_Value; 135 136 -- Start of processing for Output_Header_Line 137 138 begin 139 -- Skip all the #define for S-prefixed symbols in the header. 140 -- Of course we are making implicit assumptions: 141 -- (1) No newline between symbols with the same prefix. 142 -- (2) Prefix order is the same as in snames.ads. 143 144 if Header_Current_Symbol /= S then 145 declare 146 Name2 : VString; 147 Pat : constant Pattern := "#define " 148 & Header_Prefix (S).all 149 & Break (' ') * Name2; 150 In_Pat : Boolean := False; 151 152 begin 153 if Header_Current_Symbol /= None then 154 Put_Line (OutH, Header_Pending_Line); 155 end if; 156 157 loop 158 Line := Get_Line (InH); 159 160 if Match (Line, Pat) then 161 In_Pat := True; 162 elsif In_Pat then 163 Header_Pending_Line := Line; 164 exit; 165 else 166 Put_Line (OutH, Line); 167 end if; 168 end loop; 169 170 Header_Current_Symbol := S; 171 end; 172 end if; 173 174 -- Now output the line 175 176 -- Note that we must ensure at least one space between macro name and 177 -- parens, otherwise the parenthesized value gets treated as an argument 178 -- specification. 179 180 Put_Line (OutH, "#define " & Header_Prefix (S).all 181 & "_" & Name1 182 & (30 - Natural'Min (29, Length (Name1))) * ' ' 183 & Make_Value (Header_Counter (S))); 184 Header_Counter (S) := Header_Counter (S) + 1; 185 end Output_Header_Line; 186 187-- Start of processing for XSnames 188 189begin 190 Open (InS, In_File, "snames.ads-tmpl"); 191 Open (InB, In_File, "snames.adb-tmpl"); 192 Open (InH, In_File, "snames.h-tmpl"); 193 194 -- Note that we do not generate snames.{ads,adb,h} directly. Instead 195 -- we output them to snames.n{s,b,h} so that Makefiles can use 196 -- move-if-change to not touch previously generated files if the 197 -- new ones are identical. 198 199 Create (OutS, Out_File, "snames.ns"); 200 Create (OutB, Out_File, "snames.nb"); 201 Create (OutH, Out_File, "snames.nh"); 202 203 Put_Line (OutH, "#ifdef __cplusplus"); 204 Put_Line (OutH, "extern ""C"" {"); 205 Put_Line (OutH, "#endif"); 206 207 Anchored_Mode := True; 208 Val := 0; 209 210 loop 211 Line := Get_Line (InB); 212 exit when Match (Line, " Preset_Names"); 213 Put_Line (OutB, Line); 214 end loop; 215 216 Put_Line (OutB, Line); 217 218 LoopN : while not End_Of_File (InS) loop 219 Line := Get_Line (InS); 220 221 if not Match (Line, Name_Ref) then 222 Put_Line (OutS, Line); 223 224 if Match (Line, Get_Attr) then 225 Output_Header_Line (Attr); 226 elsif Match (Line, Get_Conv) then 227 Output_Header_Line (Conv); 228 elsif Match (Line, Get_Prag) then 229 Output_Header_Line (Prag); 230 end if; 231 else 232 233 if Match (Name0, "Last_") then 234 Oval := Lpad (V (Val - 1), 3, '0'); 235 else 236 Oval := Lpad (V (Val), 3, '0'); 237 end if; 238 239 Put_Line 240 (OutS, A & Name0 & B & ": constant Name_Id := N + " 241 & Oval & ';' & Restl); 242 243 if Match (Name0, Get_Name) then 244 Name0 := Name1; 245 Val := Val + 1; 246 247 if Match (Name0, Findu, M) then 248 Replace (M, Translate (A, Xlate_U_Und)); 249 Translate (Name0, Lower_Case_Map); 250 251 elsif not Match (Name0, "Op_", "") then 252 Translate (Name0, Lower_Case_Map); 253 254 else 255 Name0 := 'O' & Translate (Name0, Lower_Case_Map); 256 end if; 257 258 if not Match (Name0, Chk_Low) then 259 Put_Line (OutB, " """ & Name0 & "#"" &"); 260 end if; 261 262 Output_Header_Line (Name); 263 end if; 264 end if; 265 end loop LoopN; 266 267 loop 268 Line := Get_Line (InB); 269 exit when Match (Line, " ""#"";"); 270 end loop; 271 272 Put_Line (OutB, Line); 273 274 while not End_Of_File (InB) loop 275 Line := Get_Line (InB); 276 Put_Line (OutB, Line); 277 end loop; 278 279 Put_Line (OutH, Header_Pending_Line); 280 while not End_Of_File (InH) loop 281 Line := Get_Line (InH); 282 Put_Line (OutH, Line); 283 end loop; 284 285 Put_Line (OutH, "#ifdef __cplusplus"); 286 Put_Line (OutH, "}"); 287 Put_Line (OutH, "#endif"); 288end XSnamesT; 289