+2015-05-22 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb, sem_intr.adb, exp_ch4.adb, s-rannum.adb,
+ sem_eval.adb, s-fatgen.adb, s-expmod.ads: Remove incorrect hyphen in
+ non-binary.
+ * exp_util.adb: Add comment.
+ * osint-c.ads, osint-c.adb (Set_Library_Info_Name): Move from spec to
+ body.
+ (Set_File_Name): New name for the above.
+ (Create_C_File, Create_H_File, Write_C_File_Info, Write_H_File_Info,
+ Close_C_File, Close_H_File): New procedure.
+ * osint.adb: Minor reformatting.
+ * osint.ads: Minor comment updates.
+
2015-05-22 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb: Minor rewording.
and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer)
-- This transformation is not applicable for a modular type with a
- -- non-binary modulus because we do not handle modular reduction in
+ -- nonbinary modulus because we do not handle modular reduction in
-- a correct manner if we attempt this transformation in this case.
and then not Non_Binary_Modulus (Typ)
if Is_Modular_Integer_Type (Rtyp) then
- -- Non-binary case, we call the special exponentiation routine for
- -- the non-binary case, converting the argument to Long_Long_Integer
+ -- Nonbinary case, we call the special exponentiation routine for
+ -- the nonbinary case, converting the argument to Long_Long_Integer
-- and passing the modulus value. Then the result is converted back
-- to the base type.
-- where Bits is the shift count mod Esize (the mod operation here
-- deals with ludicrous large shift counts, which are apparently OK).
- -- What about non-binary modulus ???
+ -- What about nonbinary modulus ???
declare
Loc : constant Source_Ptr := Sloc (N);
-- where Bits is the shift count mod Esize (the mod operation here
-- deals with ludicrous large shift counts, which are apparently OK).
- -- What about non-binary modulus ???
+ -- What about nonbinary modulus ???
declare
Loc : constant Source_Ptr := Sloc (N);
-- to the word size, since in this case (not (Shift_Right (Mask, bits)))
-- generates all 1'bits.
- -- What about non-binary modulus ???
+ -- What about nonbinary modulus ???
declare
Loc : constant Source_Ptr := Sloc (N);
Next_Elmt (Prim);
- -- Raise Program_Error if no primitive found
+ -- Raise Program_Error if no primitive found. ???This doesn't work as
+ -- advertised if there are no primitives. But fixing that breaks
+ -- Is_Init_Proc_Of in Exp_Ch7, which is expecting Empty in some
+ -- cases.
if No (Prim) then
raise Program_Error;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2015, 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- --
-- output file and Suffix is the desired suffix (dg/rep/xxx for debug/
-- repinfo/list file where xxx is specified extension.
+ procedure Set_File_Name (Ext : String);
+ -- Sets a default file name from the main compiler source name. Ext is
+ -- the extension, e.g. "ali" for a library information file. Used by
+ -- Create_Output_Library_Info, and by the version of Read_Library_Info that
+ -- takes a default file name, and also by Create_C_File and Create_H_File.
+ -- The name is in Name_Buffer (with length in Name_Len) on return.
+
+ ------------------
+ -- Close_C_File --
+ ------------------
+
+ procedure Close_C_File is
+ Status : Boolean;
+
+ begin
+ Close (Output_FD, Status);
+
+ if not Status then
+ Fail
+ ("error while closing file "
+ & Get_Name_String (Output_File_Name));
+ end if;
+ end Close_C_File;
+
----------------------
-- Close_Debug_File --
----------------------
end if;
end Close_Debug_File;
+ ------------------
+ -- Close_H_File --
+ ------------------
+
+ procedure Close_H_File is
+ Status : Boolean;
+
+ begin
+ Close (Output_FD, Status);
+
+ if not Status then
+ Fail
+ ("error while closing file "
+ & Get_Name_String (Output_File_Name));
+ end if;
+ end Close_H_File;
+
---------------------
-- Close_List_File --
---------------------
return Result;
end Create_Auxiliary_File;
+ -------------------
+ -- Create_C_File --
+ -------------------
+
+ procedure Create_C_File is
+ Dummy : Boolean;
+ begin
+ Set_File_Name ("c");
+ Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
+ Create_File_And_Check (Output_FD, Text);
+ end Create_C_File;
+
-----------------------
-- Create_Debug_File --
-----------------------
return Create_Auxiliary_File (Src, "dg");
end Create_Debug_File;
+ -------------------
+ -- Create_H_File --
+ -------------------
+
+ procedure Create_H_File is
+ Dummy : Boolean;
+ begin
+ Set_File_Name ("h");
+ Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
+ Create_File_And_Check (Output_FD, Text);
+ end Create_H_File;
+
----------------------
-- Create_List_File --
----------------------
procedure Create_List_File (S : String) is
- F : File_Name_Type;
- pragma Warnings (Off, F);
+ Dummy : File_Name_Type;
begin
if S (S'First) = '.' then
- F := Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
-
+ Dummy :=
+ Create_Auxiliary_File (Current_Main, S (S'First + 1 .. S'Last));
else
Name_Buffer (1 .. S'Length) := S;
Name_Len := S'Length + 1;
procedure Create_Output_Library_Info is
Dummy : Boolean;
begin
- Set_Library_Info_Name;
+ Set_File_Name (ALI_Suffix.all);
Delete_File (Name_Buffer (1 .. Name_Len), Dummy);
Create_File_And_Check (Output_FD, Text);
end Create_Output_Library_Info;
procedure Open_Output_Library_Info is
begin
- Set_Library_Info_Name;
+ Set_File_Name (ALI_Suffix.all);
Open_File_To_Append_And_Check (Output_FD, Text);
end Open_Output_Library_Info;
procedure Create_Repinfo_File (Src : String) is
Discard : File_Name_Type;
- pragma Warnings (Off, Discard);
begin
Name_Buffer (1 .. Src'Length) := Src;
Name_Len := Src'Length;
-- Read_Library_Info --
-----------------------
- -- Version with default file name
-
procedure Read_Library_Info
(Name : out File_Name_Type;
Text : out Text_Buffer_Ptr)
is
begin
- Set_Library_Info_Name;
+ Set_File_Name (ALI_Suffix.all);
Name := Name_Find;
Text := Read_Library_Info (Name, Fatal_Err => False);
end Read_Library_Info;
- ---------------------------
- -- Set_Library_Info_Name --
- ---------------------------
+ -------------------
+ -- Set_File_Name --
+ -------------------
- procedure Set_Library_Info_Name is
+ procedure Set_File_Name (Ext : String) is
Dot_Index : Natural;
begin
end if;
Name_Buffer (Dot_Index) := '.';
- Name_Buffer (Dot_Index + 1 .. Dot_Index + 3) := ALI_Suffix.all;
- Name_Buffer (Dot_Index + 4) := ASCII.NUL;
- Name_Len := Dot_Index + 3;
- end Set_Library_Info_Name;
+ Name_Buffer (Dot_Index + 1 .. Dot_Index + Ext'Length) := Ext;
+ Name_Buffer (Dot_Index + Ext'Length + 1) := ASCII.NUL;
+ Name_Len := Dot_Index + Ext'Length + 1;
+ end Set_File_Name;
---------------------------------
-- Set_Output_Object_File_Name --
Tree_Write_Initialize (Output_FD);
end Tree_Create;
+ -----------------------
+ -- Write_C_File_Info --
+ -----------------------
+
+ procedure Write_C_File_Info (Info : String) renames Write_Info;
+
-----------------------
-- Write_Debug_Info --
-----------------------
procedure Write_Debug_Info (Info : String) renames Write_Info;
+ -----------------------
+ -- Write_H_File_Info --
+ -----------------------
+
+ procedure Write_H_File_Info (Info : String) renames Write_Info;
+
------------------------
-- Write_Library_Info --
------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2015, 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- --
-- information file for the main source file being compiled. See section
-- above for a discussion of how library information files are stored.
- procedure Set_Library_Info_Name;
- -- Sets a default ALI file name from the main compiler source name. Used by
- -- Create_Output_Library_Info, and by the version of Read_Library_Info that
- -- takes a default file name. The name is in Name_Buffer (with length in
- -- Name_Len) on return from the call.
-
procedure Create_Output_Library_Info;
-- Creates the output library information file for the source file which
-- is currently being compiled (i.e. the file which was most recently
-- text is returned in Text. If the file does not exist, then Text is
-- set to null.
+ --------------------------
+ -- C Translation Output --
+ --------------------------
+
+ -- These routines are used by the compiler when the C translation option
+ -- is activated to write *.c and *.h files to the current object directory.
+ -- Each routine exists in a C and an H form for the two kinds of files.
+ -- Only one of these files can be written at a time.
+
+ procedure Create_C_File;
+ procedure Create_H_File;
+ -- Creates the *.c or *.h file for the source file which is currently
+ -- being compiled (i.e. the file which was most recently returned by
+ -- Next_Main_Source).
+
+ procedure Write_C_File_Info (Info : String);
+ procedure Write_H_File_Info (Info : String);
+ -- Writes the contents of the referenced string to the *.c or *.h file for
+ -- the main source file currently being compiled (i.e. the file which was
+ -- most recently opened with a call to Read_Next_File). Info represents
+ -- a line in the file with a line termination character at the end (which
+ -- is not present in the info string).
+
+ procedure Close_C_File;
+ procedure Close_H_File;
+ -- Closes the file created by Create_C_File or Create_H file, flushing any
+ -- buffers etc. from writes by Write_C_File and Write_H_File;
+
----------------------
-- List File Output --
----------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
procedure Write_With_Check (A : Address; N : Integer) is
Ignore : Boolean;
- pragma Warnings (Off, Ignore);
-
begin
if N = Write (Output_FD, A, N) then
return;
-
else
Write_Str ("error: disk full writing ");
Write_Name_Decoded (Output_File_Name);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
-- The suffix used for the target object files
Output_FD : File_Descriptor;
- -- File descriptor for current library info, list, tree, or binder output
+ -- File descriptor for current library info, list, tree, C, H, or binder
+ -- output. Only one of these is open at a time, so we need only one FD.
Output_File_Name : File_Name_Type;
-- File_Name_Type for name of open file whose FD is in Output_FD, the name
-- for this file. This routine merely constructs the name.
procedure Write_Info (Info : String);
- -- Implementation of Write_Binder_Info, Write_Debug_Info and
- -- Write_Library_Info (identical)
+ -- Implement Write_Binder_Info, Write_Debug_Info, Write_C_File_Info,
+ -- Write_H_File_Info, and Write_Library_Info (identical)
procedure Write_With_Check (A : Address; N : Integer);
-- Writes N bytes from buffer starting at address A to file whose FD is
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
-- --
------------------------------------------------------------------------------
--- This function performs exponentiation of a modular type with non-binary
+-- This function performs exponentiation of a modular type with nonbinary
-- modulus values. Arithmetic is done in Long_Long_Unsigned, with explicit
-- accounting for the modulus value which is passed as the second argument.
-- Note that 1 is a binary modulus (2**0), so the compiler should not (and
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2015, 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- --
------------------------------------------------------------------------------
-- The implementation here is portable to any IEEE implementation. It does
--- not handle non-binary radix, and also assumes that model numbers and
+-- not handle nonbinary radix, and also assumes that model numbers and
-- machine numbers are basically identical, which is not true of all possible
-- floating-point implementations. On a non-IEEE machine, this body must be
-- specialized appropriately, or better still, its generic instantiations
-- integers. Assuming that Real'Machine_Radix = 2, it can deliver all
-- machine values of type Real (as implied by Real'Machine_Mantissa and
-- Real'Machine_Emin), which is not true of the standard method (to
- -- which we fall back for non-binary radix): computing Real(<random
+ -- which we fall back for nonbinary radix): computing Real(<random
-- integer>) / (<max random integer>+1). To do so, we first extract an
-- (M-1)-bit significand (where M is Real'Machine_Mantissa), and then
-- decide on a normalized exponent by repeated coin flips, decrementing
Set_Modular_Size (Bits);
return;
- -- Non-binary case
+ -- Nonbinary case
elsif M_Val < 2 ** Bits then
Check_SPARK_05_Restriction ("modulus should be a power of 2", T);
return;
else
- -- In the non-binary case, set size as per RM 13.3(55)
+ -- In the nonbinary case, set size as per RM 13.3(55)
Set_Modular_Size (Bits);
return;
function From_Bits (B : Bits; T : Entity_Id) return Uint;
-- Converts a bit string of length B'Length to a Uint value to be used for
-- a target of type T, which is a modular type. This procedure includes the
- -- necessary reduction by the modulus in the case of a non-binary modulus
+ -- necessary reduction by the modulus in the case of a nonbinary modulus
-- (for a binary modulus, the bit string is the right length any way so all
-- is well).
begin
-- Negation is equivalent to subtracting from the modulus minus one.
-- For a binary modulus this is equivalent to the ones-complement of
- -- the original value. For non-binary modulus this is an arbitrary
+ -- the original value. For a nonbinary modulus this is an arbitrary
-- but consistent definition.
if Is_Modular_Integer_Type (Typ) then
return;
elsif Non_Binary_Modulus (Typ1) then
- Errint
- ("shifts not allowed for non-binary modular types", Ptyp1, N);
+ Errint ("shifts not allowed for nonbinary modular types", Ptyp1, N);
-- For modular type, modulus must be 2**8, 2**16, 2**32, or 2**64.
-- Don't apply to generic types, since we may not have a modulus value.
projects / gcc.git / commitdiff