From 9276875d7bdfd6b4fd55ef099c0caa55d6e01432 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Tue, 6 Nov 2012 10:03:08 +0000 Subject: [PATCH] xoscons.adb, [...]: Add support for post-processing. 2012-11-06 Pascal Obry * xoscons.adb, xutil.adb, xutil.ads: Add support for post-processing. From-SVN: r193221 --- gcc/ada/ChangeLog | 4 + gcc/ada/xoscons.adb | 259 ++++++++++++++++++++++++++++++++++++++++------------ gcc/ada/xutil.adb | 4 +- gcc/ada/xutil.ads | 2 +- 4 files changed, 206 insertions(+), 63 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 57b91bd..ea56dec 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2012-11-06 Pascal Obry + + * xoscons.adb, xutil.adb, xutil.ads: Add support for post-processing. + 2012-11-06 Yannick Moy * s-bignum.adb (Div_Rem): Fix another bug in step D3. diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index ec452c3..d0f068e 100644 --- a/gcc/ada/xoscons.adb +++ b/gcc/ada/xoscons.adb @@ -33,26 +33,29 @@ -- The generated files are UNIT_NAME.ads and UNIT_NAME.h -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Exceptions; use Ada.Exceptions; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; -with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; +with Ada.Characters.Handling; use Ada.Characters.Handling; +with Ada.Command_Line; use Ada.Command_Line; +with Ada.Exceptions; use Ada.Exceptions; +with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; +with Ada.Strings.Fixed; use Ada.Strings.Fixed; +with Ada.Strings.Maps; use Ada.Strings.Maps; +with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; +with Ada.Text_IO; use Ada.Text_IO; pragma Warnings (Off); -- System.Unsigned_Types is an internal GNAT unit with System.Unsigned_Types; use System.Unsigned_Types; pragma Warnings (On); +with GNAT.String_Split; use GNAT.String_Split; with GNAT.Table; with XUtil; use XUtil; procedure XOSCons is - use ASCII; use Ada.Strings; + use ASCII; Unit_Name : constant String := Argument (1); Tmpl_Name : constant String := Unit_Name & "-tmplt"; @@ -73,6 +76,9 @@ procedure XOSCons is Abs_Value : Long_Unsigned := 0; end record; + function ">" (V1, V2 : Int_Value_Type) return Boolean; + function "<" (V1, V2 : Int_Value_Type) return Boolean; + type Asm_Info_Kind is (CND, -- Named number (decimal) CNU, -- Named number (decimal, unsigned) @@ -129,6 +135,10 @@ procedure XOSCons is type Language is (Lang_Ada, Lang_C); + function Parse_Int (S : String; K : Asm_Int_Kind) return Int_Value_Type; + -- Parse a decimal number, preceded by an optional '$' or '#' character, + -- and return its value. + procedure Output_Info (Lang : Language; OFile : Sfile; @@ -145,6 +155,30 @@ procedure XOSCons is -- If Count is positive, return a string of Count spaces, else return an -- empty string. + --------- + -- ">" -- + --------- + + function ">" (V1, V2 : Int_Value_Type) return Boolean is + P1 : Boolean renames V1.Positive; + P2 : Boolean renames V2.Positive; + A1 : Long_Unsigned renames V1.Abs_Value; + A2 : Long_Unsigned renames V2.Abs_Value; + begin + return (P1 and then not P2) + or else (P1 and then P2 and then A1 > A2) + or else (not P1 and then not P2 and then A1 < A2); + end ">"; + + --------- + -- "<" -- + --------- + + function "<" (V1, V2 : Int_Value_Type) return Boolean is + begin + return not (V1 > V2) and then not (V1 = V2); + end "<"; + ---------------------------- -- Contains_Template_Name -- ---------------------------- @@ -283,10 +317,6 @@ procedure XOSCons is procedure Find_Colon (Index : in out Integer); -- Increment Index until the next colon in Line - function Parse_Int (S : String; K : Asm_Int_Kind) return Int_Value_Type; - -- Parse a decimal number, preceded by an optional '$' or '#' character, - -- and return its value. - ----------------- -- Field_Alloc -- ----------------- @@ -308,53 +338,6 @@ procedure XOSCons is end loop; end Find_Colon; - --------------- - -- Parse_Int -- - --------------- - - function Parse_Int - (S : String; - K : Asm_Int_Kind) return Int_Value_Type - is - First : Integer := S'First; - Result : Int_Value_Type; - - begin - -- On some platforms, immediate integer values are prefixed with - -- a $ or # character in assembly output. - - if S (First) = '$' or else S (First) = '#' then - First := First + 1; - end if; - - if S (First) = '-' then - Result.Positive := False; - First := First + 1; - else - Result.Positive := True; - end if; - - Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last)); - - if not Result.Positive and then K = CNU then - - -- Negative value, but unsigned expected: take 2's complement - -- reciprocical value. - - Result.Abs_Value := ((not Result.Abs_Value) + 1) - and - (Shift_Left (1, Size_Of_Unsigned_Int) - 1); - Result.Positive := True; - end if; - - return Result; - - exception - when others => - Put_Line (Standard_Error, "can't parse decimal value: " & S); - raise; - end Parse_Int; - -- Start of processing for Parse_Asm_Line begin @@ -448,6 +431,153 @@ procedure XOSCons is (Standard_Error, "exception raised: " & Exception_Information (E)); end Parse_Asm_Line; + ---------------- + -- Parse_Cond -- + ---------------- + + procedure Parse_Cond + (If_Line : String; + Cond : Boolean; + Tmpl_File : Ada.Text_IO.File_Type; + Ada_Ofile, C_Ofile : Sfile; + Current_Line : in out Integer) + is + + function Get_Value (Name : String) return Int_Value_Type; + -- Returns the value of the variable Name + + --------------- + -- Get_Value -- + --------------- + + function Get_Value (Name : String) return Int_Value_Type is + begin + if Is_Subset (To_Set (Name), Decimal_Digit_Set) then + return Parse_Int (Name, CND); + + else + for K in 1 .. Asm_Infos.Last loop + if Asm_Infos.Table (K).Constant_Name /= null then + if Name = Asm_Infos.Table (K).Constant_Name.all then + return Asm_Infos.Table (K).Int_Value; + end if; + end if; + end loop; + + -- Not found returns 0 + return (True, 0); + end if; + end Get_Value; + + Sline : Slice_Set; + + Line : String (1 .. 256); + Last : Integer; + + Value1 : Int_Value_Type; + Value2 : Int_Value_Type; + Res : Boolean; + + -- Start of processing for Parse_Cond + + begin + Create (Sline, If_Line, " "); + + if Slice_Count (Sline) /= 4 then + Put_Line (Standard_Error, "can't parse " & If_Line); + end if; + + Value1 := Get_Value (Slice (Sline, 2)); + Value2 := Get_Value (Slice (Sline, 4)); + + if Slice (Sline, 3) = ">" then + Res := Cond and (Value1 > Value2); + + elsif Slice (Sline, 3) = "<" then + Res := Cond and (Value1 < Value2); + + elsif Slice (Sline, 3) = "=" then + Res := Cond and (Value1 = Value2); + + elsif Slice (Sline, 3) = "/=" then + Res := Cond and (Value1 /= Value2); + + else + -- No other operator can be used + + Put_Line (Standard_Error, "unknown operator in " & If_Line); + Res := False; + end if; + + Current_Line := Current_Line + 1; + + loop + Get_Line (Tmpl_File, Line, Last); + Current_Line := Current_Line + 1; + exit when Line (1 .. Last) = "@END_IF"; + + if Line (1 .. 4) = "@IF " then + Parse_Cond + (Line (1 .. Last), Res, + Tmpl_File, Ada_Ofile, C_Ofile, Current_Line); + + elsif Line (1 .. Last) = "@ELSE" then + Res := Cond and not Res; + + elsif Res then + Put_Line (Ada_OFile, Line (1 .. Last)); + Put_Line (C_OFile, Line (1 .. Last)); + end if; + end loop; + end Parse_Cond; + + --------------- + -- Parse_Int -- + --------------- + + function Parse_Int + (S : String; + K : Asm_Int_Kind) return Int_Value_Type + is + First : Integer := S'First; + Result : Int_Value_Type; + + begin + -- On some platforms, immediate integer values are prefixed with + -- a $ or # character in assembly output. + + if S (First) = '$' or else S (First) = '#' then + First := First + 1; + end if; + + if S (First) = '-' then + Result.Positive := False; + First := First + 1; + else + Result.Positive := True; + end if; + + Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last)); + + if not Result.Positive and then K = CNU then + + -- Negative value, but unsigned expected: take 2's complement + -- reciprocical value. + + Result.Abs_Value := ((not Result.Abs_Value) + 1) + and + (Shift_Left (1, Size_Of_Unsigned_Int) - 1); + Result.Positive := True; + end if; + + return Result; + + exception + when others => + Put_Line (Standard_Error, "can't parse decimal value: " & S); + raise; + end Parse_Int; + ------------ -- Spaces -- ------------ @@ -540,6 +670,12 @@ begin if Line (1 .. Last) = "*/" then Put_Line (C_OFile, Line (1 .. Last)); In_Comment := False; + + elsif Last > 4 and then Line (1 .. 4) = "@IF " then + Parse_Cond + (Line (1 .. Last), True, + Tmpl_File, Ada_Ofile, C_Ofile, Current_Line); + else Put_Line (Ada_OFile, Line (1 .. Last)); Put_Line (C_OFile, Line (1 .. Last)); @@ -550,8 +686,11 @@ begin In_Comment := True; elsif Asm_Infos.Table (Current_Info).Line_Number = Current_Line then - Output_Info (Lang_Ada, Ada_OFile, Current_Info); - Output_Info (Lang_C, C_OFile, Current_Info); + if Fixed.Index (Line, "/*NOGEN*/") = 0 then + Output_Info (Lang_Ada, Ada_OFile, Current_Info); + Output_Info (Lang_C, C_OFile, Current_Info); + end if; + Current_Info := Current_Info + 1; end if; diff --git a/gcc/ada/xutil.adb b/gcc/ada/xutil.adb index fbc755c..cdf0b05 100644 --- a/gcc/ada/xutil.adb +++ b/gcc/ada/xutil.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,8 +25,8 @@ package body XUtil is - use Ada.Strings.Unbounded; use Ada.Streams.Stream_IO; + use Ada.Strings.Unbounded; -------------- -- New_Line -- diff --git a/gcc/ada/xutil.ads b/gcc/ada/xutil.ads index b99ca0d..e8f67a9 100644 --- a/gcc/ada/xutil.ads +++ b/gcc/ada/xutil.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- 2.7.4