1------------------------------------------------------------------------------ 2-- -- 3-- GNAT SYSTEM UTILITIES -- 4-- -- 5-- X S N A M E S T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26-- This utility is used to make a new version of the Snames package when new 27-- names are added. This version reads a template file from snames.ads-tmpl in 28-- which the numbers are all written as $, and generates a new version of the 29-- spec file snames.ads (written to snames.ns). It also reads snames.adb-tmpl 30-- and generates an updated body (written to snames.nb), and snames.h-tmpl and 31-- generates an updated C header file (written to snames.nh). 32 33with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 34with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; 35with Ada.Strings.Maps; use Ada.Strings.Maps; 36with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; 37with Ada.Text_IO; use Ada.Text_IO; 38with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; 39 40with GNAT.Spitbol; use GNAT.Spitbol; 41with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; 42 43with XUtil; use XUtil; 44 45procedure XSnamesT is 46 47 subtype VString is GNAT.Spitbol.VString; 48 49 InS : Ada.Text_IO.File_Type; 50 InB : Ada.Text_IO.File_Type; 51 InH : Ada.Text_IO.File_Type; 52 53 OutS : Ada.Streams.Stream_IO.File_Type; 54 OutB : Ada.Streams.Stream_IO.File_Type; 55 OutH : Ada.Streams.Stream_IO.File_Type; 56 57 A, B : VString := Nul; 58 Line : VString := Nul; 59 Name0 : VString := Nul; 60 Name1 : VString := Nul; 61 Oval : VString := Nul; 62 Restl : VString := Nul; 63 64 Name_Ref : constant Pattern := Span (' ') * A & Break (' ') * Name0 65 & Span (' ') * B 66 & ": constant Name_Id := N + $;" 67 & Rest * Restl; 68 69 Get_Name : constant Pattern := "Name_" & Rest * Name1; 70 Chk_Low : constant Pattern := Pos (0) & Any (Lower_Set) & Rest & Pos (1); 71 Findu : constant Pattern := Span ('u') * A; 72 73 Val : Natural; 74 75 Xlate_U_Und : constant Character_Mapping := To_Mapping ("u", "_"); 76 77 M : Match_Result; 78 79 type Header_Symbol is (None, Name, Attr, Conv, Prag); 80 -- A symbol in the header file 81 82 procedure Output_Header_Line (S : Header_Symbol); 83 -- Output header line 84 85 Header_Name : aliased String := "Name"; 86 Header_Attr : aliased String := "Attr"; 87 Header_Conv : aliased String := "Convention"; 88 Header_Prag : aliased String := "Pragma"; 89 -- Prefixes used in the header file 90 91 type String_Ptr is access all String; 92 Header_Prefix : constant array (Header_Symbol) of String_Ptr := 93 (null, 94 Header_Name'Access, 95 Header_Attr'Access, 96 Header_Conv'Access, 97 Header_Prag'Access); 98 99 -- Patterns used in the spec file 100 101 Get_Attr : constant Pattern := Span (' ') & "Attribute_" 102 & Break (",)") * Name1; 103 Get_Conv : constant Pattern := Span (' ') & "Convention_" 104 & Break (",)") * Name1; 105 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