-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Sort (Container : in out List) is
- procedure Partition
- (Pivot : in Node_Access;
- Back : in Node_Access);
+ procedure Partition (Pivot : Node_Access; Back : Node_Access);
procedure Sort (Front, Back : Node_Access);
-- Partition --
---------------
- procedure Partition
- (Pivot : Node_Access;
- Back : Node_Access)
- is
+ procedure Partition (Pivot : Node_Access; Back : Node_Access) is
Node : Node_Access := Pivot.Next;
begin
procedure Query_Element
(Position : Cursor;
- Process : not null access procedure (Element : in Element_Type))
+ Process : not null access procedure (Element : Element_Type))
is
begin
if Position.Node = null then
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
with procedure Swap (Left, Right : Index_Type) is <>;
procedure Ada.Containers.Generic_Anonymous_Array_Sort
- (First, Last : in Index_Type'Base);
+ (First, Last : Index_Type'Base);
pragma Pure (Ada.Containers.Generic_Anonymous_Array_Sort);
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Iterate
(Container : List;
- Process : not null access procedure (Position : in Cursor))
+ Process : not null access procedure (Position : Cursor))
is
C : List renames Container'Unrestricted_Access.all;
B : Natural renames C.Busy;
procedure Query_Element
(Position : Cursor;
- Process : not null access procedure (Element : in Element_Type))
+ Process : not null access procedure (Element : Element_Type))
is
begin
if Position.Node = null then
procedure Reverse_Iterate
(Container : List;
- Process : not null access procedure (Position : in Cursor))
+ Process : not null access procedure (Position : Cursor))
is
C : List renames Container'Unrestricted_Access.all;
B : Natural renames C.Busy;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Iterate
(Container : Vector;
- Process : not null access procedure (Position : in Cursor))
+ Process : not null access procedure (Position : Cursor))
is
V : Vector renames Container'Unrestricted_Access.all;
B : Natural renames V.Busy;
procedure Query_Element
(Container : Vector;
Index : Index_Type;
- Process : not null access procedure (Element : in Element_Type))
+ Process : not null access procedure (Element : Element_Type))
is
V : Vector renames Container'Unrestricted_Access.all;
B : Natural renames V.Busy;
procedure Query_Element
(Position : Cursor;
- Process : not null access procedure (Element : in Element_Type))
+ Process : not null access procedure (Element : Element_Type))
is
begin
if Position.Container = null then
procedure Reverse_Iterate
(Container : Vector;
- Process : not null access procedure (Position : in Cursor))
+ Process : not null access procedure (Position : Cursor))
is
V : Vector renames Container'Unrestricted_Access.all;
B : Natural renames V.Busy;
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, 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- --
-- Environment_Value --
-----------------------
- function Environment_Value (Number : in Positive) return String is
+ function Environment_Value (Number : Positive) return String is
procedure Fill_Env (E : System.Address; Env_Num : Integer);
pragma Import (C, Fill_Env, "__gnat_fill_env");
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, 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- --
-- variables in the environment of the program invoking the function.
-- Otherwise it returns 0. And that's a lot of environment.
- function Environment_Value (Number : in Positive) return String;
+ function Environment_Value (Number : Positive) return String;
-- If the external execution environment supports passing the environment
-- to a program, then Environment_Value returns an implementation-defined
-- value corresponding to the value at relative position Number. If Number
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2006, 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- --
-- Remove_Argument --
---------------------
- procedure Remove_Argument (Number : in Positive) is
+ procedure Remove_Argument (Number : Positive) is
begin
Initialize;
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2006, 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- --
package Ada.Command_Line.Remove is
pragma Preelaborate;
- procedure Remove_Argument (Number : in Positive);
+ procedure Remove_Argument (Number : Positive);
-- Removes the argument identified by Number, which must be in the
-- range 1 .. Argument_Count (i.e. an in range argument number which
-- reflects removals). If Number is out of range Constraint_Error
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Argument --
--------------
- function Argument (Number : in Positive) return String is
+ function Argument (Number : Positive) return String is
Num : Positive;
begin
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Divide
- (Dividend : in Dividend_Type;
- Divisor : in Divisor_Type;
+ (Dividend : Dividend_Type;
+ Divisor : Divisor_Type;
Quotient : out Quotient_Type;
Remainder : out Remainder_Type)
is
-- not have convention Intrinsic.
procedure Divide
- (Dividend : in Dividend_Type;
- Divisor : in Divisor_Type;
+ (Dividend : Dividend_Type;
+ Divisor : Divisor_Type;
Quotient : out Quotient_Type;
Remainder : out Remainder_Type);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
type Remainder_Type is delta <> digits <>;
procedure Divide
- (Dividend : in Dividend_Type;
- Divisor : in Divisor_Type;
+ (Dividend : Dividend_Type;
+ Divisor : Divisor_Type;
Quotient : out Quotient_Type;
Remainder : out Remainder_Type);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Create
(File : in out File_Type;
- Mode : in File_Mode := Inout_File;
- Name : in String := "";
- Form : in String := "")
+ Mode : File_Mode := Inout_File;
+ Name : String := "";
+ Form : String := "")
is
begin
DIO.Create (FP (File), To_FCB (Mode), Name, Form);
-- End_Of_File --
-----------------
- function End_Of_File (File : in File_Type) return Boolean is
+ function End_Of_File (File : File_Type) return Boolean is
begin
return DIO.End_Of_File (FP (File));
end End_Of_File;
-- Form --
----------
- function Form (File : in File_Type) return String is
+ function Form (File : File_Type) return String is
begin
return FIO.Form (AP (File));
end Form;
-- Index --
-----------
- function Index (File : in File_Type) return Positive_Count is
+ function Index (File : File_Type) return Positive_Count is
begin
return Positive_Count (DIO.Index (FP (File)));
end Index;
-- Is_Open --
-------------
- function Is_Open (File : in File_Type) return Boolean is
+ function Is_Open (File : File_Type) return Boolean is
begin
return FIO.Is_Open (AP (File));
end Is_Open;
-- Mode --
----------
- function Mode (File : in File_Type) return File_Mode is
+ function Mode (File : File_Type) return File_Mode is
begin
return To_DIO (FIO.Mode (AP (File)));
end Mode;
-- Name --
----------
- function Name (File : in File_Type) return String is
+ function Name (File : File_Type) return String is
begin
return FIO.Name (AP (File));
end Name;
procedure Open
(File : in out File_Type;
- Mode : in File_Mode;
- Name : in String;
- Form : in String := "")
+ Mode : File_Mode;
+ Name : String;
+ Form : String := "")
is
begin
DIO.Open (FP (File), To_FCB (Mode), Name, Form);
----------
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Element_Type;
- From : in Positive_Count)
+ From : Positive_Count)
is
begin
-- For a non-constrained variant record type, we read into an
end if;
end Read;
- procedure Read (File : in File_Type; Item : out Element_Type) is
+ procedure Read (File : File_Type; Item : out Element_Type) is
begin
-- Same processing for unconstrained case as above
-- Reset --
-----------
- procedure Reset (File : in out File_Type; Mode : in File_Mode) is
+ procedure Reset (File : in out File_Type; Mode : File_Mode) is
begin
DIO.Reset (FP (File), To_FCB (Mode));
end Reset;
-- Set_Index --
---------------
- procedure Set_Index (File : in File_Type; To : in Positive_Count) is
+ procedure Set_Index (File : File_Type; To : Positive_Count) is
begin
DIO.Set_Index (FP (File), DPCount (To));
end Set_Index;
-- Size --
----------
- function Size (File : in File_Type) return Count is
+ function Size (File : File_Type) return Count is
begin
return Count (DIO.Size (FP (File)));
end Size;
-----------
procedure Write
- (File : in File_Type;
- Item : in Element_Type;
- To : in Positive_Count)
+ (File : File_Type;
+ Item : Element_Type;
+ To : Positive_Count)
is
begin
DIO.Set_Index (FP (File), DPCount (To));
DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
end Write;
- procedure Write (File : in File_Type; Item : in Element_Type) is
+ procedure Write (File : File_Type; Item : Element_Type) is
begin
DIO.Write (FP (File), Item'Address, Item'Size / SU, Zeroes);
end Write;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Create
(File : in out File_Type;
- Mode : in File_Mode := Inout_File;
- Name : in String := "";
- Form : in String := "");
+ Mode : File_Mode := Inout_File;
+ Name : String := "";
+ Form : String := "");
procedure Open
(File : in out File_Type;
- Mode : in File_Mode;
- Name : in String;
- Form : in String := "");
+ Mode : File_Mode;
+ Name : String;
+ Form : String := "");
procedure Close (File : in out File_Type);
procedure Delete (File : in out File_Type);
- procedure Reset (File : in out File_Type; Mode : in File_Mode);
+ procedure Reset (File : in out File_Type; Mode : File_Mode);
procedure Reset (File : in out File_Type);
- function Mode (File : in File_Type) return File_Mode;
- function Name (File : in File_Type) return String;
- function Form (File : in File_Type) return String;
+ function Mode (File : File_Type) return File_Mode;
+ function Name (File : File_Type) return String;
+ function Form (File : File_Type) return String;
- function Is_Open (File : in File_Type) return Boolean;
+ function Is_Open (File : File_Type) return Boolean;
---------------------------------
-- Input and Output Operations --
---------------------------------
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Element_Type;
- From : in Positive_Count);
+ From : Positive_Count);
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Element_Type);
procedure Write
- (File : in File_Type;
- Item : in Element_Type;
- To : in Positive_Count);
+ (File : File_Type;
+ Item : Element_Type;
+ To : Positive_Count);
procedure Write
- (File : in File_Type;
- Item : in Element_Type);
+ (File : File_Type;
+ Item : Element_Type);
- procedure Set_Index (File : in File_Type; To : in Positive_Count);
+ procedure Set_Index (File : File_Type; To : Positive_Count);
- function Index (File : in File_Type) return Positive_Count;
- function Size (File : in File_Type) return Count;
+ function Index (File : File_Type) return Positive_Count;
+ function Size (File : File_Type) return Count;
- function End_Of_File (File : in File_Type) return Boolean;
+ function End_Of_File (File : File_Type) return Boolean;
----------------
-- Exceptions --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Set_Im --
------------
- procedure Set_Im (X : in out Complex; Im : in Real'Base) is
+ procedure Set_Im (X : in out Complex; Im : Real'Base) is
begin
X.Im := Im;
end Set_Im;
- procedure Set_Im (X : out Imaginary; Im : in Real'Base) is
+ procedure Set_Im (X : out Imaginary; Im : Real'Base) is
begin
X := Imaginary (Im);
end Set_Im;
-- Set_Re --
------------
- procedure Set_Re (X : in out Complex; Re : in Real'Base) is
+ procedure Set_Re (X : in out Complex; Re : Real'Base) is
begin
X.Re := Re;
end Set_Re;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
function Im (X : Complex) return Real'Base;
function Im (X : Imaginary) return Real'Base;
- procedure Set_Re (X : in out Complex; Re : in Real'Base);
- procedure Set_Im (X : in out Complex; Im : in Real'Base);
- procedure Set_Im (X : out Imaginary; Im : in Real'Base);
+ procedure Set_Re (X : in out Complex; Re : Real'Base);
+ procedure Set_Im (X : in out Complex; Im : Real'Base);
+ procedure Set_Im (X : out Imaginary; Im : Real'Base);
function Compose_From_Cartesian (Re, Im : Real'Base) return Complex;
function Compose_From_Cartesian (Re : Real'Base) return Complex;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Local Subprograms --
-----------------------
- procedure Euclid (P, Q : in Int; X, Y : out Int; GCD : out Int);
+ procedure Euclid (P, Q : Int; X, Y : out Int; GCD : out Int);
function Euclid (P, Q : Int) return Int;
-- Euclid --
------------
- procedure Euclid (P, Q : in Int; X, Y : out Int; GCD : out Int) is
+ procedure Euclid (P, Q : Int; X, Y : out Int; GCD : out Int) is
XT : Int := 1;
YT : Int := 0;
procedure Recur
- (P, Q : in Int; -- a (i-1), a (i)
- X, Y : in Int; -- x (i), y (i)
+ (P, Q : Int; -- a (i-1), a (i)
+ X, Y : Int; -- x (i), y (i)
XP, YP : in out Int; -- x (i-1), y (i-1)
GCD : out Int);
procedure Recur
- (P, Q : in Int;
- X, Y : in Int;
+ (P, Q : Int;
+ X, Y : Int;
XP, YP : in out Int;
GCD : out Int)
is
- Quo : Int := P / Q; -- q <-- |_ a (i-1) / a (i) _|
+ Quo : Int := P / Q; -- q <-- |_ a (i-1) / a (i) _|
XT : Int := X; -- x (i)
YT : Int := Y; -- y (i)
-- Version that works from given initiator value
- procedure Reset (Gen : in Generator; Initiator : in Integer) is
+ procedure Reset (Gen : Generator; Initiator : Integer) is
Genp : constant Pointer := Gen.Gen_State'Unrestricted_Access;
X1, X2 : Int;
-- Save --
----------
- procedure Save (Gen : in Generator; To_State : out State) is
+ procedure Save (Gen : Generator; To_State : out State) is
begin
To_State := Gen.Gen_State;
end Save;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Max_Image_Width : constant := 80;
- function Image (Of_State : State) return String;
+ function Image (Of_State : State) return String;
function Value (Coded_State : String) return State;
private
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Create
(File : in out File_Type;
- Mode : in File_Mode := Out_File;
- Name : in String := "";
- Form : in String := "")
+ Mode : File_Mode := Out_File;
+ Name : String := "";
+ Form : String := "")
is
begin
SIO.Create (FP (File), To_FCB (Mode), Name, Form);
-- End_Of_File --
-----------------
- function End_Of_File (File : in File_Type) return Boolean is
+ function End_Of_File (File : File_Type) return Boolean is
begin
return FIO.End_Of_File (AP (File));
end End_Of_File;
-- Form --
----------
- function Form (File : in File_Type) return String is
+ function Form (File : File_Type) return String is
begin
return FIO.Form (AP (File));
end Form;
-- Is_Open --
-------------
- function Is_Open (File : in File_Type) return Boolean is
+ function Is_Open (File : File_Type) return Boolean is
begin
return FIO.Is_Open (AP (File));
end Is_Open;
-- Mode --
----------
- function Mode (File : in File_Type) return File_Mode is
+ function Mode (File : File_Type) return File_Mode is
begin
return To_SIO (FIO.Mode (AP (File)));
end Mode;
-- Name --
----------
- function Name (File : in File_Type) return String is
+ function Name (File : File_Type) return String is
begin
return FIO.Name (AP (File));
end Name;
procedure Open
(File : in out File_Type;
- Mode : in File_Mode;
- Name : in String;
- Form : in String := "")
+ Mode : File_Mode;
+ Name : String;
+ Form : String := "")
is
begin
SIO.Open (FP (File), To_FCB (Mode), Name, Form);
-- Read --
----------
- procedure Read (File : in File_Type; Item : out Element_Type) is
+ procedure Read (File : File_Type; Item : out Element_Type) is
Siz : constant size_t := (Item'Size + SU - 1) / SU;
Rsiz : size_t;
-- Reset --
-----------
- procedure Reset (File : in out File_Type; Mode : in File_Mode) is
+ procedure Reset (File : in out File_Type; Mode : File_Mode) is
begin
FIO.Reset (AP (File), To_FCB (Mode));
end Reset;
-- Write --
-----------
- procedure Write (File : in File_Type; Item : in Element_Type) is
+ procedure Write (File : File_Type; Item : Element_Type) is
Siz : constant size_t := (Item'Size + SU - 1) / SU;
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Create
(File : in out File_Type;
- Mode : in File_Mode := Out_File;
- Name : in String := "";
- Form : in String := "");
+ Mode : File_Mode := Out_File;
+ Name : String := "";
+ Form : String := "");
procedure Open
(File : in out File_Type;
- Mode : in File_Mode;
- Name : in String;
- Form : in String := "");
+ Mode : File_Mode;
+ Name : String;
+ Form : String := "");
procedure Close (File : in out File_Type);
procedure Delete (File : in out File_Type);
- procedure Reset (File : in out File_Type; Mode : in File_Mode);
+ procedure Reset (File : in out File_Type; Mode : File_Mode);
procedure Reset (File : in out File_Type);
- function Mode (File : in File_Type) return File_Mode;
- function Name (File : in File_Type) return String;
- function Form (File : in File_Type) return String;
+ function Mode (File : File_Type) return File_Mode;
+ function Name (File : File_Type) return String;
+ function Form (File : File_Type) return String;
- function Is_Open (File : in File_Type) return Boolean;
+ function Is_Open (File : File_Type) return Boolean;
---------------------------------
-- Input and output operations --
---------------------------------
- procedure Read (File : in File_Type; Item : out Element_Type);
- procedure Write (File : in File_Type; Item : in Element_Type);
+ procedure Read (File : File_Type; Item : out Element_Type);
+ procedure Write (File : File_Type; Item : Element_Type);
- function End_Of_File (File : in File_Type) return Boolean;
+ function End_Of_File (File : File_Type) return Boolean;
----------------
-- Exceptions --
-- Input and Output Operations --
---------------------------------
- procedure Read (Buffer : in Buffer_Type; Item : out Element_Type);
+ procedure Read (Buffer : Buffer_Type; Item : out Element_Type);
- procedure Write (Buffer : out Buffer_Type; Item : in Element_Type);
+ procedure Write (Buffer : out Buffer_Type; Item : Element_Type);
----------------
-- Exceptions --
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Write
(Stream : in out Root_Stream_Type;
- Item : in Stream_Element_Array)
+ Item : Stream_Element_Array)
is abstract;
private
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- --
------------------------------------------------------------------------------
-with Interfaces.C_Streams; use Interfaces.C_Streams;
-with System; use System;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+
+with System; use System;
with System.File_IO;
with System.Soft_Links;
with System.CRTL;
+
with Unchecked_Conversion;
with Unchecked_Deallocation;
-- Local Subprograms --
-----------------------
- procedure Set_Position (File : in File_Type);
+ procedure Set_Position (File : File_Type);
-- Sets file position pointer according to value of current index
-------------------
function AFCB_Allocate (Control_Block : Stream_AFCB) return FCB.AFCB_Ptr is
pragma Warnings (Off, Control_Block);
-
begin
return new Stream_AFCB;
end AFCB_Allocate;
procedure AFCB_Close (File : access Stream_AFCB) is
pragma Warnings (Off, File);
-
begin
null;
end AFCB_Close;
procedure Create
(File : in out File_Type;
- Mode : in File_Mode := Out_File;
- Name : in String := "";
- Form : in String := "")
+ Mode : File_Mode := Out_File;
+ Name : String := "";
+ Form : String := "")
is
Dummy_File_Control_Block : Stream_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
-- End_Of_File --
-----------------
- function End_Of_File (File : in File_Type) return Boolean is
+ function End_Of_File (File : File_Type) return Boolean is
begin
FIO.Check_Read_Status (AP (File));
return Count (File.Index) > Size (File);
-- Form --
----------
- function Form (File : in File_Type) return String is
+ function Form (File : File_Type) return String is
begin
return FIO.Form (AP (File));
end Form;
-- Index --
-----------
- function Index (File : in File_Type) return Positive_Count is
+ function Index (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return Count (File.Index);
-- Is_Open --
-------------
- function Is_Open (File : in File_Type) return Boolean is
+ function Is_Open (File : File_Type) return Boolean is
begin
return FIO.Is_Open (AP (File));
end Is_Open;
-- Mode --
----------
- function Mode (File : in File_Type) return File_Mode is
+ function Mode (File : File_Type) return File_Mode is
begin
return To_SIO (FIO.Mode (AP (File)));
end Mode;
-- Name --
----------
- function Name (File : in File_Type) return String is
+ function Name (File : File_Type) return String is
begin
return FIO.Name (AP (File));
end Name;
procedure Open
(File : in out File_Type;
- Mode : in File_Mode;
- Name : in String;
- Form : in String := "")
+ Mode : File_Mode;
+ Name : String;
+ Form : String := "")
is
Dummy_File_Control_Block : Stream_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
----------
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset;
- From : in Positive_Count)
+ From : Positive_Count)
is
begin
Set_Index (File, From);
end Read;
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset)
is
-- Reset --
-----------
- procedure Reset (File : in out File_Type; Mode : in File_Mode) is
+ procedure Reset (File : in out File_Type; Mode : File_Mode) is
begin
FIO.Check_File_Open (AP (File));
-- Set_Index --
---------------
- procedure Set_Index (File : in File_Type; To : in Positive_Count) is
+ procedure Set_Index (File : File_Type; To : Positive_Count) is
begin
FIO.Check_File_Open (AP (File));
File.Index := Count (To);
-- Set_Mode --
--------------
- procedure Set_Mode (File : in out File_Type; Mode : in File_Mode) is
+ procedure Set_Mode (File : in out File_Type; Mode : File_Mode) is
begin
FIO.Check_File_Open (AP (File));
-- Set_Position --
------------------
- procedure Set_Position (File : in File_Type) is
+ procedure Set_Position (File : File_Type) is
use type System.CRTL.long;
begin
if fseek (File.Stream,
-- Size --
----------
- function Size (File : in File_Type) return Count is
+ function Size (File : File_Type) return Count is
begin
FIO.Check_File_Open (AP (File));
-- Stream --
------------
- function Stream (File : in File_Type) return Stream_Access is
+ function Stream (File : File_Type) return Stream_Access is
begin
FIO.Check_File_Open (AP (File));
return Stream_Access (File);
-----------
procedure Write
- (File : in File_Type;
- Item : in Stream_Element_Array;
- To : in Positive_Count)
+ (File : File_Type;
+ Item : Stream_Element_Array;
+ To : Positive_Count)
is
begin
Set_Index (File, To);
Write (File, Item);
end Write;
- procedure Write (File : in File_Type; Item : in Stream_Element_Array) is
+ procedure Write
+ (File : File_Type;
+ Item : Stream_Element_Array)
+ is
begin
FIO.Check_Write_Status (AP (File));
procedure Write
(File : in out Stream_AFCB;
- Item : in Ada.Streams.Stream_Element_Array)
+ Item : Ada.Streams.Stream_Element_Array)
is
begin
Write (File'Unchecked_Access, Item);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Create
(File : in out File_Type;
- Mode : in File_Mode := Out_File;
- Name : in String := "";
- Form : in String := "");
+ Mode : File_Mode := Out_File;
+ Name : String := "";
+ Form : String := "");
procedure Open
(File : in out File_Type;
- Mode : in File_Mode;
- Name : in String;
- Form : in String := "");
+ Mode : File_Mode;
+ Name : String;
+ Form : String := "");
procedure Close (File : in out File_Type);
procedure Delete (File : in out File_Type);
- procedure Reset (File : in out File_Type; Mode : in File_Mode);
+ procedure Reset (File : in out File_Type; Mode : File_Mode);
procedure Reset (File : in out File_Type);
- function Mode (File : in File_Type) return File_Mode;
- function Name (File : in File_Type) return String;
- function Form (File : in File_Type) return String;
+ function Mode (File : File_Type) return File_Mode;
+ function Name (File : File_Type) return String;
+ function Form (File : File_Type) return String;
- function Is_Open (File : in File_Type) return Boolean;
- function End_Of_File (File : in File_Type) return Boolean;
+ function Is_Open (File : File_Type) return Boolean;
+ function End_Of_File (File : File_Type) return Boolean;
- function Stream (File : in File_Type) return Stream_Access;
+ function Stream (File : File_Type) return Stream_Access;
-----------------------------
-- Input-Output Operations --
-----------------------------
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset;
- From : in Positive_Count);
+ From : Positive_Count);
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
procedure Write
- (File : in File_Type;
- Item : in Stream_Element_Array;
- To : in Positive_Count);
+ (File : File_Type;
+ Item : Stream_Element_Array;
+ To : Positive_Count);
procedure Write
- (File : in File_Type;
- Item : in Stream_Element_Array);
+ (File : File_Type;
+ Item : Stream_Element_Array);
----------------------------------------
-- Operations on Position within File --
----------------------------------------
- procedure Set_Index (File : in File_Type; To : in Positive_Count);
+ procedure Set_Index (File : File_Type; To : Positive_Count);
- function Index (File : in File_Type) return Positive_Count;
- function Size (File : in File_Type) return Count;
+ function Index (File : File_Type) return Positive_Count;
+ function Size (File : File_Type) return Count;
- procedure Set_Mode (File : in out File_Type; Mode : in File_Mode);
+ procedure Set_Mode (File : in out File_Type; Mode : File_Mode);
-- Note: The parameter file is IN OUT in the RM, but this is clearly
-- an oversight, and was intended to be IN, see AI95-00057.
procedure Write
(File : in out Stream_AFCB;
- Item : in Ada.Streams.Stream_Element_Array);
+ Item : Ada.Streams.Stream_Element_Array);
-- Write operation used when Stream_IO file is treated directly as Stream
end Ada.Streams.Stream_IO;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 sorted, discontiguous form is canonical, so equality can be used
- function "=" (Left, Right : in Wide_Character_Set) return Boolean is
+ function "=" (Left, Right : Wide_Character_Set) return Boolean is
begin
return Left.Set.all = Right.Set.all;
end "=";
---------------
function To_Ranges
- (Set : in Wide_Character_Set) return Wide_Character_Ranges
+ (Set : Wide_Character_Set) return Wide_Character_Ranges
is
begin
return Set.Set.all;
end if;
end loop;
- if Result (N).High < Result (N).Low then
+ if N > 0 and then Result (N).High < Result (N).Low then
N := N - 1;
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
(Span : Wide_Character_Range) return Wide_Character_Set;
function To_Ranges
- (Set : in Wide_Character_Set) return Wide_Character_Ranges;
+ (Set : Wide_Character_Set) return Wide_Character_Ranges;
---------------------------------------
-- Operations on Wide Character Sets --
---------------------------------------
- function "=" (Left, Right : in Wide_Character_Set) return Boolean;
+ function "=" (Left, Right : Wide_Character_Set) return Boolean;
function "not"
(Right : Wide_Character_Set) return Wide_Character_Set;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
end Count;
function Count
- (Source : in Wide_String;
- Set : Wide_Maps.Wide_Character_Set) return Natural
+ (Source : Wide_String;
+ Set : Wide_Maps.Wide_Character_Set) return Natural
is
N : Natural := 0;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 sorted, discontiguous form is canonical, so equality can be used
- function "=" (Left, Right : in Wide_Wide_Character_Set) return Boolean is
+ function "=" (Left, Right : Wide_Wide_Character_Set) return Boolean is
begin
return Left.Set.all = Right.Set.all;
end "=";
---------------
function To_Ranges
- (Set : in Wide_Wide_Character_Set) return Wide_Wide_Character_Ranges
+ (Set : Wide_Wide_Character_Set) return Wide_Wide_Character_Ranges
is
begin
return Set.Set.all;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- Operations on Wide Character Sets --
---------------------------------------
- function "=" (Left, Right : in Wide_Wide_Character_Set) return Boolean;
+ function "=" (Left, Right : Wide_Wide_Character_Set) return Boolean;
function "not"
(Right : Wide_Wide_Character_Set) return Wide_Wide_Character_Set;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
generic
type Attribute is private;
- Initial_Value : in Attribute;
+ Initial_Value : Attribute;
package Ada.Task_Attributes is
function Value
(T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task)
- return Attribute;
+ Ada.Task_Identification.Current_Task) return Attribute;
function Reference
(T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task)
- return Attribute_Handle;
+ Ada.Task_Identification.Current_Task) return Attribute_Handle;
procedure Set_Value
(Val : Attribute;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Blank_When_Zero --
---------------------
- function Blank_When_Zero (Pic : in Picture) return Boolean is
+ function Blank_When_Zero (Pic : Picture) return Boolean is
begin
return Pic.Contents.Original_BWZ;
end Blank_When_Zero;
-- Expand --
------------
- function Expand (Picture : in String) return String is
+ function Expand (Picture : String) return String is
Result : String (1 .. MAX_PICSIZE);
Picture_Index : Integer := Picture'First;
Result_Index : Integer := Result'First;
Currency_Symbol : String;
Fill_Character : Character;
Separator_Character : Character;
- Radix_Point : Character)
- return String
+ Radix_Point : Character) return String
is
Attrs : Number_Attributes := Parse_Number_String (Number);
Position : Integer;
-- The following ensures that we return B and not b being careful not
-- to break things which expect lower case b for blank. See CXF3A02.
- function Pic_String (Pic : in Picture) return String is
+ function Pic_String (Pic : Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
Pic.Contents.Picture.Expanded;
begin
procedure Debug_Start (Name : String);
pragma Inline (Debug_Start);
- procedure Debug_Integer (Value : in Integer; S : String);
+ procedure Debug_Integer (Value : Integer; S : String);
pragma Inline (Debug_Integer);
procedure Trailing_Currency;
-- Debug_Integer --
-------------------
- procedure Debug_Integer (Value : in Integer; S : String) is
+ procedure Debug_Integer (Value : Integer; S : String) is
use Ada.Text_IO; -- needed for >
begin
----------------
function To_Picture
- (Pic_String : in String;
- Blank_When_Zero : in Boolean := False)
- return Picture
+ (Pic_String : String;
+ Blank_When_Zero : Boolean := False) return Picture
is
Result : Picture;
-----------
function Valid
- (Pic_String : in String;
- Blank_When_Zero : in Boolean := False)
- return Boolean
+ (Pic_String : String;
+ Blank_When_Zero : Boolean := False) return Boolean
is
begin
declare
-- False only if Blank_When_Zero is True but the pic string has a '*'
- return not Blank_When_Zero or
- Strings_Fixed.Index (Expanded_Pic, "*") = 0;
+ return not Blank_When_Zero
+ or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
end;
exception
-----------
function Image
- (Item : in Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark)
- return String
+ (Item : Num;
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark) return String
is
begin
return Format_Number
------------
function Length
- (Pic : in Picture;
- Currency : in String := Default_Currency)
- return Natural
+ (Pic : Picture;
+ Currency : String := Default_Currency) return Natural
is
Picstr : constant String := Pic_String (Pic);
V_Adjust : Integer := 0;
---------
procedure Put
- (File : in Text_IO.File_Type;
- Item : in Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark)
+ (File : Text_IO.File_Type;
+ Item : Num;
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark)
is
begin
Text_IO.Put (File, Image (Item, Pic,
end Put;
procedure Put
- (Item : in Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark)
+ (Item : Num;
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark)
is
begin
Text_IO.Put (Image (Item, Pic,
procedure Put
(To : out String;
- Item : in Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark)
+ Item : Num;
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark)
is
Result : constant String :=
Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
function Valid
(Item : Num;
- Pic : in Picture;
- Currency : in String := Default_Currency)
- return Boolean
+ Pic : Picture;
+ Currency : String := Default_Currency) return Boolean
is
begin
declare
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
type Picture is private;
function Valid
- (Pic_String : in String;
- Blank_When_Zero : in Boolean := False)
- return Boolean;
+ (Pic_String : String;
+ Blank_When_Zero : Boolean := False) return Boolean;
function To_Picture
- (Pic_String : in String;
- Blank_When_Zero : in Boolean := False)
- return Picture;
+ (Pic_String : String;
+ Blank_When_Zero : Boolean := False) return Picture;
- function Pic_String (Pic : in Picture) return String;
- function Blank_When_Zero (Pic : in Picture) return Boolean;
+ function Pic_String (Pic : Picture) return String;
+ function Blank_When_Zero (Pic : Picture) return Boolean;
Max_Picture_Length : constant := 64;
generic
type Num is delta <> digits <>;
- Default_Currency : in String := Editing.Default_Currency;
- Default_Fill : in Character := Editing.Default_Fill;
- Default_Separator : in Character := Editing.Default_Separator;
- Default_Radix_Mark : in Character := Editing.Default_Radix_Mark;
+ Default_Currency : String := Editing.Default_Currency;
+ Default_Fill : Character := Editing.Default_Fill;
+ Default_Separator : Character := Editing.Default_Separator;
+ Default_Radix_Mark : Character := Editing.Default_Radix_Mark;
package Decimal_Output is
function Length
- (Pic : in Picture;
- Currency : in String := Default_Currency)
- return Natural;
+ (Pic : Picture;
+ Currency : String := Default_Currency) return Natural;
function Valid
(Item : Num;
- Pic : in Picture;
- Currency : in String := Default_Currency)
- return Boolean;
+ Pic : Picture;
+ Currency : String := Default_Currency) return Boolean;
function Image
(Item : Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark)
- return String;
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark) return String;
procedure Put
- (File : in Ada.Text_IO.File_Type;
+ (File : Ada.Text_IO.File_Type;
Item : Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark);
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark);
procedure Put
(Item : Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark);
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark);
procedure Put
(To : out String;
Item : Num;
- Pic : in Picture;
- Currency : in String := Default_Currency;
- Fill : in Character := Default_Fill;
- Separator : in Character := Default_Separator;
- Radix_Mark : in Character := Default_Radix_Mark);
+ Pic : Picture;
+ Currency : String := Default_Currency;
+ Fill : Character := Default_Fill;
+ Separator : Character := Default_Separator;
+ Radix_Mark : Character := Default_Radix_Mark);
end Decimal_Output;
Currency_Symbol : String;
Fill_Character : Character;
Separator_Character : Character;
- Radix_Point : Character)
- return String;
+ Radix_Point : Character) return String;
-- Formats number according to Pic
- function Expand (Picture : in String) return String;
+ function Expand (Picture : String) return String;
end Ada.Text_IO.Editing;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
ItemR : out Long_Long_Float;
ItemI : out Long_Long_Float;
Width : Field)
----------
procedure Gets
- (From : in String;
+ (From : String;
ItemR : out Long_Long_Float;
ItemI : out Long_Long_Float;
Last : out Positive)
(To : out String;
ItemR : Long_Long_Float;
ItemI : Long_Long_Float;
- Aft : in Field;
- Exp : in Field)
+ Aft : Field;
+ Exp : Field)
is
I_String : String (1 .. 3 * Field'Last);
R_String : String (1 .. 3 * Field'Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
package Ada.Text_IO.Complex_Aux is
procedure Get
- (File : in File_Type;
+ (File : File_Type;
ItemR : out Long_Long_Float;
ItemI : out Long_Long_Float;
Width : Field);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
package body Ada.Text_IO.Complex_IO is
+ use Complex_Types;
+
package Aux renames Ada.Text_IO.Complex_Aux;
subtype LLF is Long_Long_Float;
---------
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Complex_Types.Complex;
- Width : in Field := 0)
+ Width : Field := 0)
is
- Real_Item : Real'Base;
- Imag_Item : Real'Base;
+ Real_Item : Real'Base;
+ Imag_Item : Real'Base;
begin
Aux.Get (File, LLF (Real_Item), LLF (Imag_Item), Width);
procedure Get
(Item : out Complex_Types.Complex;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_In, Item, Width);
---------
procedure Get
- (From : in String;
+ (From : String;
Item : out Complex_Types.Complex;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Complex_Types.Complex;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (File : File_Type;
+ Item : Complex_Types.Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Put (File, LLF (Re (Item)), LLF (Im (Item)), Fore, Aft, Exp);
---------
procedure Put
- (Item : in Complex_Types.Complex;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Complex_Types.Complex;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Current_Out, Item, Fore, Aft, Exp);
procedure Put
(To : out String;
- Item : in Complex_Types.Complex;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ Item : Complex_Types.Complex;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Puts (To, LLF (Re (Item)), LLF (Im (Item)), Aft, Exp);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-------------
function Get_Dec
- (File : in File_Type;
- Width : in Field;
- Scale : Integer)
- return Integer
+ (File : File_Type;
+ Width : Field;
+ Scale : Integer) return Integer
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer;
-------------
function Get_LLD
- (File : in File_Type;
- Width : in Field;
- Scale : Integer)
- return Long_Long_Integer
+ (File : File_Type;
+ Width : Field;
+ Scale : Integer) return Long_Long_Integer
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer;
--------------
function Gets_Dec
- (From : in String;
+ (From : String;
Last : access Positive;
- Scale : Integer)
- return Integer
+ Scale : Integer) return Integer
is
Pos : aliased Integer;
Item : Integer;
--------------
function Gets_LLD
- (From : in String;
+ (From : String;
Last : access Positive;
- Scale : Integer)
- return Long_Long_Integer
+ Scale : Integer) return Long_Long_Integer
is
Pos : aliased Integer;
Item : Long_Long_Integer;
-------------
procedure Put_Dec
- (File : in File_Type;
- Item : in Integer;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field;
+ (File : File_Type;
+ Item : Integer;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field;
Scale : Integer)
is
Buf : String (1 .. Field'Last);
-------------
procedure Put_LLD
- (File : in File_Type;
- Item : in Long_Long_Integer;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field;
+ (File : File_Type;
+ Item : Long_Long_Integer;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field;
Scale : Integer)
is
Buf : String (1 .. Field'Last);
procedure Puts_Dec
(To : out String;
- Item : in Integer;
- Aft : in Field;
- Exp : in Field;
+ Item : Integer;
+ Aft : Field;
+ Exp : Field;
Scale : Integer)
is
Buf : String (1 .. Field'Last);
procedure Puts_LLD
(To : out String;
- Item : in Long_Long_Integer;
- Aft : in Field;
- Exp : in Field;
+ Item : Long_Long_Integer;
+ Aft : Field;
+ Exp : Field;
Scale : Integer)
is
Buf : String (1 .. Field'Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
private package Ada.Text_IO.Decimal_Aux is
function Get_Dec
- (File : in File_Type;
- Width : in Field;
- Scale : Integer)
- return Integer;
+ (File : File_Type;
+ Width : Field;
+ Scale : Integer) return Integer;
function Get_LLD
- (File : in File_Type;
- Width : in Field;
- Scale : Integer)
- return Long_Long_Integer;
+ (File : File_Type;
+ Width : Field;
+ Scale : Integer) return Long_Long_Integer;
procedure Put_Dec
(File : File_Type;
Item : Integer;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field;
Scale : Integer);
procedure Put_LLD
- (File : in File_Type;
- Item : in Long_Long_Integer;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field;
+ (File : File_Type;
+ Item : Long_Long_Integer;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field;
Scale : Integer);
function Gets_Dec
- (From : in String;
+ (From : String;
Last : access Positive;
- Scale : Integer)
- return Integer;
+ Scale : Integer) return Integer;
function Gets_LLD
- (From : in String;
+ (From : String;
Last : access Positive;
- Scale : Integer)
- return Long_Long_Integer;
+ Scale : Integer) return Long_Long_Integer;
procedure Puts_Dec
(To : out String;
- Item : in Integer;
- Aft : in Field;
- Exp : in Field;
+ Item : Integer;
+ Aft : Field;
+ Exp : Field;
Scale : Integer);
procedure Puts_LLD
(To : out String;
- Item : in Long_Long_Integer;
- Aft : in Field;
- Exp : in Field;
+ Item : Long_Long_Integer;
+ Aft : Field;
+ Exp : Field;
Scale : Integer);
end Ada.Text_IO.Decimal_Aux;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
pragma Unsuppress (Range_Check);
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_In, Item, Width);
end Get;
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
if Num'Size > Integer'Size then
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Current_Out, Item, Fore, Aft, Exp);
procedure Put
(To : out String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
if Num'Size > Integer'Size then
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Exp : Field := 0;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Get);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Puts
- (To : out String;
- Item : in String;
- Set : Type_Set)
+ (To : out String;
+ Item : String;
+ Set : Type_Set)
is
Ptr : Natural;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- using the given Width and Set parameters (Item is always in upper case).
procedure Puts
- (To : out String;
- Item : in String;
- Set : Type_Set);
+ (To : out String;
+ Item : String;
+ Set : Type_Set);
-- Stores the enumeration literal image stored in Item to the string To,
-- padding with trailing spaces if necessary to fill To. Set is used to
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Get --
---------
- procedure Get (File : in File_Type; Item : out Enum) is
+ procedure Get (File : File_Type; Item : out Enum) is
Buf : String (1 .. Enum'Width);
Buflen : Natural;
end Get;
procedure Get
- (From : in String;
+ (From : String;
Item : out Enum;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting)
+ (File : File_Type;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
is
Image : constant String := Enum'Image (Item);
end Put;
procedure Put
- (Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting)
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
is
begin
Put (Current_Out, Item, Width, Set);
procedure Put
(To : out String;
- Item : in Enum;
- Set : in Type_Set := Default_Setting)
+ Item : Enum;
+ Set : Type_Set := Default_Setting)
is
Image : constant String := Enum'Image (Item);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Width : Field := 0;
Default_Setting : Type_Set := Upper_Case;
- procedure Get (File : in File_Type; Item : out Enum);
+ procedure Get (File : File_Type; Item : out Enum);
procedure Get (Item : out Enum);
procedure Put
- (File : in File_Type;
- Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting);
+ (File : File_Type;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
procedure Put
- (Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting);
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
procedure Get
- (From : in String;
+ (From : String;
Item : out Enum;
Last : out Positive);
procedure Put
(To : out String;
- Item : in Enum;
- Set : in Type_Set := Default_Setting);
+ Item : Enum;
+ Set : Type_Set := Default_Setting);
end Ada.Text_IO.Enumeration_IO;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Exp : Field := 0;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Get);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
with Ada.Text_IO.Generic_Aux; use Ada.Text_IO.Generic_Aux;
-with System.Img_Real; use System.Img_Real;
-with System.Val_Real; use System.Val_Real;
+with System.Img_Real; use System.Img_Real;
+with System.Val_Real; use System.Val_Real;
package body Ada.Text_IO.Float_Aux is
---------
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Float;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
----------
procedure Gets
- (From : in String;
+ (From : String;
Item : out Long_Long_Float;
Last : out Positive)
is
---------------
procedure Load_Real
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Long_Long_Float;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field)
+ (File : File_Type;
+ Item : Long_Long_Float;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field)
is
Buf : String (1 .. 3 * Field'Last + 2);
Ptr : Natural := 0;
procedure Puts
(To : out String;
- Item : in Long_Long_Float;
- Aft : in Field;
- Exp : in Field)
+ Item : Long_Long_Float;
+ Aft : Field;
+ Exp : Field)
is
Buf : String (1 .. 3 * Field'Last + 2);
Ptr : Natural := 0;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
private package Ada.Text_IO.Float_Aux is
procedure Load_Real
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load a possibly signed
-- real literal value from the input file into Buf, starting at Ptr + 1.
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Float;
- Width : in Field);
+ Width : Field);
procedure Put
- (File : in File_Type;
- Item : in Long_Long_Float;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field);
+ (File : File_Type;
+ Item : Long_Long_Float;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field);
procedure Gets
- (From : in String;
+ (From : String;
Item : out Long_Long_Float;
Last : out Positive);
procedure Puts
(To : out String;
- Item : in Long_Long_Float;
- Aft : in Field;
- Exp : in Field);
+ Item : Long_Long_Float;
+ Aft : Field;
+ Exp : Field);
end Ada.Text_IO.Float_Aux;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
pragma Unsuppress (Range_Check);
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
pragma Unsuppress (Range_Check);
end Get;
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Put (File, Long_Long_Float (Item), Fore, Aft, Exp);
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Put (Current_Out, Long_Long_Float (Item), Fore, Aft, Exp);
procedure Put
(To : out String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Puts (To, Long_Long_Float (Item), Aft, Exp);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Exp : Field := 3;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
private
pragma Inline (Get);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Load_Width
(File : File_Type;
- Width : in Field;
+ Width : Field;
Buf : out String;
Ptr : in out Integer);
-- Loads exactly Width characters, unless a line mark is encountered first
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Load_Integer
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load a possibly signed
-------------
procedure Get_Int
- (File : in File_Type;
+ (File : File_Type;
Item : out Integer;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
-------------
procedure Get_LLI
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Integer;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
--------------
procedure Gets_Int
- (From : in String;
+ (From : String;
Item : out Integer;
Last : out Positive)
is
--------------
procedure Gets_LLI
- (From : in String;
+ (From : String;
Item : out Long_Long_Integer;
Last : out Positive)
is
------------------
procedure Load_Integer
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
-------------
procedure Put_Int
- (File : in File_Type;
- Item : in Integer;
- Width : in Field;
- Base : in Number_Base)
+ (File : File_Type;
+ Item : Integer;
+ Width : Field;
+ Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, Width));
Ptr : Natural := 0;
-------------
procedure Put_LLI
- (File : in File_Type;
- Item : in Long_Long_Integer;
- Width : in Field;
- Base : in Number_Base)
+ (File : File_Type;
+ Item : Long_Long_Integer;
+ Width : Field;
+ Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, Width));
Ptr : Natural := 0;
procedure Puts_Int
(To : out String;
- Item : in Integer;
- Base : in Number_Base)
+ Item : Integer;
+ Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, To'Length));
Ptr : Natural := 0;
procedure Puts_LLI
(To : out String;
- Item : in Long_Long_Integer;
- Base : in Number_Base)
+ Item : Long_Long_Integer;
+ Base : Number_Base)
is
Buf : String (1 .. Integer'Max (Field'Last, To'Length));
Ptr : Natural := 0;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
private package Ada.Text_IO.Integer_Aux is
procedure Get_Int
- (File : in File_Type;
+ (File : File_Type;
Item : out Integer;
- Width : in Field);
+ Width : Field);
procedure Get_LLI
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Integer;
- Width : in Field);
+ Width : Field);
procedure Put_Int
- (File : in File_Type;
- Item : in Integer;
- Width : in Field;
- Base : in Number_Base);
+ (File : File_Type;
+ Item : Integer;
+ Width : Field;
+ Base : Number_Base);
procedure Put_LLI
- (File : in File_Type;
- Item : in Long_Long_Integer;
- Width : in Field;
- Base : in Number_Base);
+ (File : File_Type;
+ Item : Long_Long_Integer;
+ Width : Field;
+ Base : Number_Base);
procedure Gets_Int
- (From : in String;
+ (From : String;
Item : out Integer;
Last : out Positive);
procedure Gets_LLI
- (From : in String;
+ (From : String;
Item : out Long_Long_Integer;
Last : out Positive);
procedure Puts_Int
(To : out String;
- Item : in Integer;
- Base : in Number_Base);
+ Item : Integer;
+ Base : Number_Base);
procedure Puts_LLI
(To : out String;
- Item : in Long_Long_Integer;
- Base : in Number_Base);
+ Item : Long_Long_Integer;
+ Base : Number_Base);
end Ada.Text_IO.Integer_Aux;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
-- We depend on a range check to get Data_Error
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
-- We depend on a range check to get Data_Error
end Get;
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
if Need_LLI then
end Put;
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
if Need_LLI then
procedure Put
(To : out String;
- Item : in Num;
- Base : in Number_Base := Default_Base)
+ Item : Num;
+ Base : Number_Base := Default_Base)
is
begin
if Need_LLI then
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Base : Number_Base := 10;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out String;
- Item : in Num;
- Base : in Number_Base := Default_Base);
+ Item : Num;
+ Base : Number_Base := Default_Base);
private
pragma Inline (Get);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
pragma Unsuppress (Range_Check);
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
pragma Unsuppress (Range_Check);
end Get;
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
end Put;
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
procedure Put
(To : out String;
- Item : in Num;
- Base : in Number_Base := Default_Base)
+ Item : Num;
+ Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
-- --
-- S p e c --
-- --
--- Copyright (C) 1993-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1993-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Base : Number_Base := 10;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Get
- (From : in String;
+ (From : String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out String;
- Item : in Num;
- Base : in Number_Base := Default_Base);
+ Item : Num;
+ Base : Number_Base := Default_Base);
private
pragma Inline (Get);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Stream --
------------
- function Stream (File : in File_Type) return Stream_Access is
+ function Stream (File : File_Type) return Stream_Access is
begin
System.File_IO.Check_File_Open (FCB.AFCB_Ptr (File));
return Stream_Access (File);
type Stream_Access is access all Streams.Root_Stream_Type'Class;
- function Stream (File : in File_Type) return Stream_Access;
+ function Stream (File : File_Type) return Stream_Access;
end Ada.Text_IO.Text_Streams;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : File_Type;
+ (File : File_Type;
Item : out Complex;
- Width : Field := 0)
+ Width : Field := 0)
is
Real_Item : Real'Base;
Imag_Item : Real'Base;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-------------
function Get_Dec
- (File : File_Type;
- Width : Field;
- Scale : Integer)
- return Integer
+ (File : File_Type;
+ Width : Field;
+ Scale : Integer) return Integer
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer;
-------------
function Get_LLD
- (File : File_Type;
- Width : Field;
- Scale : Integer)
- return Long_Long_Integer
+ (File : File_Type;
+ Width : Field;
+ Scale : Integer) return Long_Long_Integer
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer;
function Gets_Dec
(From : String;
Last : access Positive;
- Scale : Integer)
- return Integer
+ Scale : Integer) return Integer
is
Pos : aliased Integer;
Item : Integer;
function Gets_LLD
(From : String;
Last : access Positive;
- Scale : Integer)
- return Long_Long_Integer
+ Scale : Integer) return Long_Long_Integer
is
Pos : aliased Integer;
Item : Long_Long_Integer;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
function Get_Dec
(File : File_Type;
Width : Field;
- Scale : Integer)
- return Integer;
+ Scale : Integer) return Integer;
function Get_LLD
(File : File_Type;
Width : Field;
- Scale : Integer)
- return Long_Long_Integer;
+ Scale : Integer) return Long_Long_Integer;
function Gets_Dec
(From : String;
Last : access Positive;
- Scale : Integer)
- return Integer;
+ Scale : Integer) return Integer;
function Gets_LLD
(From : String;
Last : access Positive;
- Scale : Integer)
- return Long_Long_Integer;
+ Scale : Integer) return Long_Long_Integer;
procedure Put_Dec
(File : File_Type;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Decimal_Aux;
+
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
---------
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
if Num'Size > Integer'Size then
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
if Num'Size > Integer'Size then
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
pragma Unreferenced (Fore);
-- ??? how come this is unreferenced, sounds wrong ???
procedure Put
(To : out Wide_String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
S : String (To'First .. To'Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Exp : Field := 3;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
end Ada.Wide_Text_IO.Decimal_IO;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Blank_When_Zero --
---------------------
- function Blank_When_Zero (Pic : in Picture) return Boolean is
+ function Blank_When_Zero (Pic : Picture) return Boolean is
begin
return Pic.Contents.Original_BWZ;
end Blank_When_Zero;
-- Expand --
------------
- function Expand (Picture : in String) return String is
+ function Expand (Picture : String) return String is
Result : String (1 .. MAX_PICSIZE);
Picture_Index : Integer := Picture'First;
Result_Index : Integer := Result'First;
Sign_Position : Integer := Pic.Sign_Position; -- may float.
- Answer : Wide_String (1 .. Pic.Picture.Length);
- Last : Integer;
- Currency_Pos : Integer := Pic.Start_Currency;
+ Answer : Wide_String (1 .. Pic.Picture.Length);
+ Last : Integer;
+ Currency_Pos : Integer := Pic.Start_Currency;
Dollar : Boolean := False;
-- Overridden immediately if necessary
-- The following ensures that we return B and not b being careful not
-- to break things which expect lower case b for blank. See CXF3A02.
- function Pic_String (Pic : in Picture) return String is
+ function Pic_String (Pic : Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
Pic.Contents.Picture.Expanded;
begin
Format_Rec.Original_BWZ := Blank_When_Zero;
Precalculate (Format_Rec);
- -- False only if Blank_When_0 is True but the pic string
- -- has a '*'
+ -- False only if Blank_When_0 is True but the pic string has a '*'
- return not Blank_When_Zero or
- Strings_Fixed.Index (Expanded_Pic, "*") = 0;
+ return not Blank_When_Zero
+ or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
end;
exception
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
(Pic_String : String;
Blank_When_Zero : Boolean := False) return Picture;
- function Pic_String (Pic : in Picture) return String;
- function Blank_When_Zero (Pic : in Picture) return Boolean;
+ function Pic_String (Pic : Picture) return String;
+ function Blank_When_Zero (Pic : Picture) return Boolean;
Max_Picture_Length : constant := 64;
Radix_Point : Wide_Character) return Wide_String;
-- Formats number according to Pic
- function Expand (Picture : in String) return String;
+ function Expand (Picture : String) return String;
end Ada.Wide_Text_IO.Editing;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Puts
- (To : out Wide_String;
- Item : in Wide_String;
- Set : Type_Set)
+ (To : out Wide_String;
+ Item : Wide_String;
+ Set : Type_Set)
is
Ptr : Natural;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- using the given Width and Set parameters (Item is always in upper case).
procedure Puts
- (To : out Wide_String;
- Item : in Wide_String;
- Set : Type_Set);
+ (To : out Wide_String;
+ Item : Wide_String;
+ Set : Type_Set);
-- Stores the enumeration literal image stored in Item to the string To,
-- padding with trailing spaces if necessary to fill To. Set is used to
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Get --
---------
- procedure Get (File : in File_Type; Item : out Enum) is
+ procedure Get (File : File_Type; Item : out Enum) is
Buf : Wide_String (1 .. Enum'Width);
Buflen : Natural;
end Get;
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Enum;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting)
+ (File : File_Type;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
is
Image : constant Wide_String := Enum'Wide_Image (Item);
end Put;
procedure Put
- (Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting)
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting)
is
begin
Put (Current_Output, Item, Width, Set);
procedure Put
(To : out Wide_String;
- Item : in Enum;
- Set : in Type_Set := Default_Setting)
+ Item : Enum;
+ Set : Type_Set := Default_Setting)
is
Image : constant Wide_String := Enum'Wide_Image (Item);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Width : Field := 0;
Default_Setting : Type_Set := Upper_Case;
- procedure Get (File : in File_Type; Item : out Enum);
+ procedure Get (File : File_Type; Item : out Enum);
procedure Get (Item : out Enum);
procedure Put
- (File : in File_Type;
- Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting);
+ (File : File_Type;
+ Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
procedure Put
- (Item : in Enum;
- Width : in Field := Default_Width;
- Set : in Type_Set := Default_Setting);
+ (Item : Enum;
+ Width : Field := Default_Width;
+ Set : Type_Set := Default_Setting);
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Enum;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : in Enum;
- Set : in Type_Set := Default_Setting);
+ Item : Enum;
+ Set : Type_Set := Default_Setting);
end Ada.Wide_Text_IO.Enumeration_IO;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Aux.Get (TFT (File), Long_Long_Float (Item), Width);
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Put (TFT (File), Long_Long_Float (Item), Fore, Aft, Exp);
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Current_Output, Item, Fore, Aft, Exp);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
S : String (To'First .. To'Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Exp : Field := 0;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
end Ada.Wide_Text_IO.Fixed_IO;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Float;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
----------
procedure Gets
- (From : in String;
+ (From : String;
Item : out Long_Long_Float;
Last : out Positive)
is
---------------
procedure Load_Real
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Long_Long_Float;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field)
+ (File : File_Type;
+ Item : Long_Long_Float;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
procedure Puts
(To : out String;
- Item : in Long_Long_Float;
- Aft : in Field;
- Exp : in Field)
+ Item : Long_Long_Float;
+ Aft : Field;
+ Exp : Field)
is
- Buf : String (1 .. Field'Last);
- Ptr : Natural := 0;
+ Buf : String (1 .. Field'Last);
+ Ptr : Natural := 0;
begin
Set_Image_Real (Item, Buf, Ptr, Fore => 1, Aft => Aft, Exp => Exp);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
private package Ada.Wide_Text_IO.Float_Aux is
procedure Load_Real
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load a possibly signed
-- real literal value from the input file into Buf, starting at Ptr + 1.
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Float;
- Width : in Field);
+ Width : Field);
procedure Gets
- (From : in String;
+ (From : String;
Item : out Long_Long_Float;
Last : out Positive);
procedure Put
- (File : in File_Type;
- Item : in Long_Long_Float;
- Fore : in Field;
- Aft : in Field;
- Exp : in Field);
+ (File : File_Type;
+ Item : Long_Long_Float;
+ Fore : Field;
+ Aft : Field;
+ Exp : Field);
procedure Puts
(To : out String;
- Item : in Long_Long_Float;
- Aft : in Field;
- Exp : in Field);
+ Item : Long_Long_Float;
+ Aft : Field;
+ Exp : Field);
end Ada.Wide_Text_IO.Float_Aux;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
------------------------------------------------------------------------------
with Ada.Wide_Text_IO.Float_Aux;
+
with System.WCh_Con; use System.WCh_Con;
with System.WCh_WtS; use System.WCh_WtS;
---------
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Aux.Get (TFT (File), Long_Long_Float (Item), Width);
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Aux.Put (TFT (File), Long_Long_Float (Item), Fore, Aft, Exp);
end Put;
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
begin
Put (Current_Output, Item, Fore, Aft, Exp);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp)
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp)
is
S : String (To'First .. To'Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Exp : Field := 3;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (File : File_Type;
+ Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Put
- (Item : in Num;
- Fore : in Field := Default_Fore;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ (Item : Num;
+ Fore : Field := Default_Fore;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Aft : in Field := Default_Aft;
- Exp : in Field := Default_Exp);
+ Item : Num;
+ Aft : Field := Default_Aft;
+ Exp : Field := Default_Exp);
end Ada.Wide_Text_IO.Float_IO;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Load_Width
(File : File_Type;
- Width : in Field;
+ Width : Field;
Buf : out String;
Ptr : in out Integer);
-- Loads exactly Width characters, unless a line mark is encountered first
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
-with System.Img_BIU; use System.Img_BIU;
-with System.Img_Int; use System.Img_Int;
-with System.Img_LLB; use System.Img_LLB;
-with System.Img_LLI; use System.Img_LLI;
-with System.Img_LLW; use System.Img_LLW;
-with System.Img_WIU; use System.Img_WIU;
-with System.Val_Int; use System.Val_Int;
-with System.Val_LLI; use System.Val_LLI;
+with System.Img_BIU; use System.Img_BIU;
+with System.Img_Int; use System.Img_Int;
+with System.Img_LLB; use System.Img_LLB;
+with System.Img_LLI; use System.Img_LLI;
+with System.Img_LLW; use System.Img_LLW;
+with System.Img_WIU; use System.Img_WIU;
+with System.Val_Int; use System.Val_Int;
+with System.Val_LLI; use System.Val_LLI;
package body Ada.Wide_Text_IO.Integer_Aux is
-----------------------
procedure Load_Integer
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-------------
procedure Get_Int
- (File : in File_Type;
+ (File : File_Type;
Item : out Integer;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
-------------
procedure Get_LLI
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Integer;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Ptr : aliased Integer := 1;
--------------
procedure Gets_Int
- (From : in String;
+ (From : String;
Item : out Integer;
Last : out Positive)
is
--------------
procedure Gets_LLI
- (From : in String;
+ (From : String;
Item : out Long_Long_Integer;
Last : out Positive)
is
------------------
procedure Load_Integer
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
-------------
procedure Put_Int
- (File : in File_Type;
- Item : in Integer;
- Width : in Field;
- Base : in Number_Base)
+ (File : File_Type;
+ Item : Integer;
+ Width : Field;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
-------------
procedure Put_LLI
- (File : in File_Type;
- Item : in Long_Long_Integer;
- Width : in Field;
- Base : in Number_Base)
+ (File : File_Type;
+ Item : Long_Long_Integer;
+ Width : Field;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
procedure Puts_Int
(To : out String;
- Item : in Integer;
- Base : in Number_Base)
+ Item : Integer;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
procedure Puts_LLI
(To : out String;
- Item : in Long_Long_Integer;
- Base : in Number_Base)
+ Item : Long_Long_Integer;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
private package Ada.Wide_Text_IO.Integer_Aux is
procedure Get_Int
- (File : in File_Type;
+ (File : File_Type;
Item : out Integer;
- Width : in Field);
+ Width : Field);
procedure Get_LLI
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Integer;
- Width : in Field);
+ Width : Field);
procedure Gets_Int
- (From : in String;
+ (From : String;
Item : out Integer;
Last : out Positive);
procedure Gets_LLI
- (From : in String;
+ (From : String;
Item : out Long_Long_Integer;
Last : out Positive);
procedure Put_Int
- (File : in File_Type;
- Item : in Integer;
- Width : in Field;
- Base : in Number_Base);
+ (File : File_Type;
+ Item : Integer;
+ Width : Field;
+ Base : Number_Base);
procedure Put_LLI
- (File : in File_Type;
- Item : in Long_Long_Integer;
- Width : in Field;
- Base : in Number_Base);
+ (File : File_Type;
+ Item : Long_Long_Integer;
+ Width : Field;
+ Base : Number_Base);
procedure Puts_Int
(To : out String;
- Item : in Integer;
- Base : in Number_Base);
+ Item : Integer;
+ Base : Number_Base);
procedure Puts_LLI
(To : out String;
- Item : in Long_Long_Integer;
- Base : in Number_Base);
+ Item : Long_Long_Integer;
+ Base : Number_Base);
end Ada.Wide_Text_IO.Integer_Aux;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
if Need_LLI then
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
if Need_LLI then
end Put;
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
Put (Current_Output, Item, Width, Base);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Base : in Number_Base := Default_Base)
+ Item : Num;
+ Base : Number_Base := Default_Base)
is
S : String (To'First .. To'Last);
Default_Base : Number_Base := 10;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Base : in Number_Base := Default_Base);
+ Item : Num;
+ Base : Number_Base := Default_Base);
end Ada.Wide_Text_IO.Integer_IO;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
with Ada.Wide_Text_IO.Generic_Aux; use Ada.Wide_Text_IO.Generic_Aux;
-with System.Img_BIU; use System.Img_BIU;
-with System.Img_Uns; use System.Img_Uns;
-with System.Img_LLB; use System.Img_LLB;
-with System.Img_LLU; use System.Img_LLU;
-with System.Img_LLW; use System.Img_LLW;
-with System.Img_WIU; use System.Img_WIU;
-with System.Val_Uns; use System.Val_Uns;
-with System.Val_LLU; use System.Val_LLU;
+with System.Img_BIU; use System.Img_BIU;
+with System.Img_Uns; use System.Img_Uns;
+with System.Img_LLB; use System.Img_LLB;
+with System.Img_LLU; use System.Img_LLU;
+with System.Img_LLW; use System.Img_LLW;
+with System.Img_WIU; use System.Img_WIU;
+with System.Val_Uns; use System.Val_Uns;
+with System.Val_LLU; use System.Val_LLU;
package body Ada.Wide_Text_IO.Modular_Aux is
-----------------------
procedure Load_Modular
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural);
-- This is an auxiliary routine that is used to load an possibly signed
-------------
procedure Get_LLU
- (File : in File_Type;
+ (File : File_Type;
Item : out Long_Long_Unsigned;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
-------------
procedure Get_Uns
- (File : in File_Type;
+ (File : File_Type;
Item : out Unsigned;
- Width : in Field)
+ Width : Field)
is
Buf : String (1 .. Field'Last);
Stop : Integer := 0;
--------------
procedure Gets_LLU
- (From : in String;
+ (From : String;
Item : out Long_Long_Unsigned;
Last : out Positive)
is
--------------
procedure Gets_Uns
- (From : in String;
+ (From : String;
Item : out Unsigned;
Last : out Positive)
is
------------------
procedure Load_Modular
- (File : in File_Type;
+ (File : File_Type;
Buf : out String;
Ptr : in out Natural)
is
-------------
procedure Put_LLU
- (File : in File_Type;
- Item : in Long_Long_Unsigned;
- Width : in Field;
- Base : in Number_Base)
+ (File : File_Type;
+ Item : Long_Long_Unsigned;
+ Width : Field;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
-------------
procedure Put_Uns
- (File : in File_Type;
- Item : in Unsigned;
- Width : in Field;
- Base : in Number_Base)
+ (File : File_Type;
+ Item : Unsigned;
+ Width : Field;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
procedure Puts_LLU
(To : out String;
- Item : in Long_Long_Unsigned;
- Base : in Number_Base)
+ Item : Long_Long_Unsigned;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
procedure Puts_Uns
(To : out String;
- Item : in Unsigned;
- Base : in Number_Base)
+ Item : Unsigned;
+ Base : Number_Base)
is
Buf : String (1 .. Field'Last);
Ptr : Natural := 0;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1997 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
package U renames System.Unsigned_Types;
procedure Get_Uns
- (File : in File_Type;
+ (File : File_Type;
Item : out U.Unsigned;
- Width : in Field);
+ Width : Field);
procedure Get_LLU
- (File : in File_Type;
+ (File : File_Type;
Item : out U.Long_Long_Unsigned;
- Width : in Field);
+ Width : Field);
procedure Gets_Uns
- (From : in String;
+ (From : String;
Item : out U.Unsigned;
Last : out Positive);
procedure Gets_LLU
- (From : in String;
+ (From : String;
Item : out U.Long_Long_Unsigned;
Last : out Positive);
procedure Put_Uns
- (File : in File_Type;
- Item : in U.Unsigned;
- Width : in Field;
- Base : in Number_Base);
+ (File : File_Type;
+ Item : U.Unsigned;
+ Width : Field;
+ Base : Number_Base);
procedure Put_LLU
- (File : in File_Type;
- Item : in U.Long_Long_Unsigned;
- Width : in Field;
- Base : in Number_Base);
+ (File : File_Type;
+ Item : U.Long_Long_Unsigned;
+ Width : Field;
+ Base : Number_Base);
procedure Puts_Uns
(To : out String;
- Item : in U.Unsigned;
- Base : in Number_Base);
+ Item : U.Unsigned;
+ Base : Number_Base);
procedure Puts_LLU
(To : out String;
- Item : in U.Long_Long_Unsigned;
- Base : in Number_Base);
+ Item : U.Long_Long_Unsigned;
+ Base : Number_Base);
end Ada.Wide_Text_IO.Modular_Aux;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
if Num'Size > Unsigned'Size then
procedure Get
(Item : out Num;
- Width : in Field := 0)
+ Width : Field := 0)
is
begin
Get (Current_Input, Item, Width);
end Get;
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive)
is
---------
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
if Num'Size > Unsigned'Size then
end Put;
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base)
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base)
is
begin
Put (Current_Output, Item, Width, Base);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Base : in Number_Base := Default_Base)
+ Item : Num;
+ Base : Number_Base := Default_Base)
is
S : String (To'First .. To'Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Default_Base : Number_Base := 10;
procedure Get
- (File : in File_Type;
+ (File : File_Type;
Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Get
(Item : out Num;
- Width : in Field := 0);
+ Width : Field := 0);
procedure Put
- (File : in File_Type;
- Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (File : File_Type;
+ Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Put
- (Item : in Num;
- Width : in Field := Default_Width;
- Base : in Number_Base := Default_Base);
+ (Item : Num;
+ Width : Field := Default_Width;
+ Base : Number_Base := Default_Base);
procedure Get
- (From : in Wide_String;
+ (From : Wide_String;
Item : out Num;
Last : out Positive);
procedure Put
(To : out Wide_String;
- Item : in Num;
- Base : in Number_Base := Default_Base);
+ Item : Num;
+ Base : Number_Base := Default_Base);
end Ada.Wide_Text_IO.Modular_IO;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Get
- (File : File_Type;
+ (File : File_Type;
Item : out Complex;
- Width : Field := 0)
+ Width : Field := 0)
is
Real_Item : Real'Base;
Imag_Item : Real'Base;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Blank_When_Zero --
---------------------
- function Blank_When_Zero (Pic : in Picture) return Boolean is
+ function Blank_When_Zero (Pic : Picture) return Boolean is
begin
return Pic.Contents.Original_BWZ;
end Blank_When_Zero;
-- Expand --
------------
- function Expand (Picture : in String) return String is
+ function Expand (Picture : String) return String is
Result : String (1 .. MAX_PICSIZE);
Picture_Index : Integer := Picture'First;
Result_Index : Integer := Result'First;
Sign_Position : Integer := Pic.Sign_Position; -- may float.
- Answer : Wide_Wide_String (1 .. Pic.Picture.Length);
- Last : Integer;
- Currency_Pos : Integer := Pic.Start_Currency;
+ Answer : Wide_Wide_String (1 .. Pic.Picture.Length);
+ Last : Integer;
+ Currency_Pos : Integer := Pic.Start_Currency;
Dollar : Boolean := False;
-- Overridden immediately if necessary
-- The following ensures that we return B and not b being careful not
-- to break things which expect lower case b for blank. See CXF3A02.
- function Pic_String (Pic : in Picture) return String is
+ function Pic_String (Pic : Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
Pic.Contents.Picture.Expanded;
begin
Format_Rec.Original_BWZ := Blank_When_Zero;
Precalculate (Format_Rec);
- -- False only if Blank_When_0 is True but the pic string
- -- has a '*'
+ -- False only if Blank_When_0 is True but the pic string has a '*'
- return not Blank_When_Zero or
- Strings_Fixed.Index (Expanded_Pic, "*") = 0;
+ return not Blank_When_Zero
+ or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
end;
exception
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
(Pic_String : String;
Blank_When_Zero : Boolean := False) return Picture;
- function Pic_String (Pic : in Picture) return String;
- function Blank_When_Zero (Pic : in Picture) return Boolean;
+ function Pic_String (Pic : Picture) return String;
+ function Blank_When_Zero (Pic : Picture) return Boolean;
Max_Picture_Length : constant := 64;
Radix_Point : Wide_Wide_Character) return Wide_Wide_String;
-- Formats number according to Pic
- function Expand (Picture : in String) return String;
+ function Expand (Picture : String) return String;
end Ada.Wide_Wide_Text_IO.Editing;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Puts
- (To : out Wide_Wide_String;
- Item : Wide_Wide_String;
- Set : Type_Set)
+ (To : out Wide_Wide_String;
+ Item : Wide_Wide_String;
+ Set : Type_Set)
is
Ptr : Natural;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- using the given Width and Set parameters (Item is always in upper case).
procedure Puts
- (To : out Wide_Wide_String;
- Item : Wide_Wide_String;
- Set : Type_Set);
+ (To : out Wide_Wide_String;
+ Item : Wide_Wide_String;
+ Set : Type_Set);
-- Stores the enumeration literal image stored in Item to the string To,
-- padding with trailing spaces if necessary to fill To. Set is used to
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Decompose
(RT : R;
- X : in T;
+ X : T;
Fraction : out T;
Exponent : out UI;
Mode : Rounding_Mode := Round);
procedure Decompose_Int
(RT : R;
- X : in T;
+ X : T;
Fraction : out UI;
Exponent : out UI;
Mode : Rounding_Mode);
procedure Decompose
(RT : R;
- X : in T;
+ X : T;
Fraction : out T;
Exponent : out UI;
Mode : Rounding_Mode := Round)
procedure Decompose_Int
(RT : R;
- X : in T;
+ X : T;
Fraction : out UI;
Exponent : out UI;
Mode : Rounding_Mode)
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
package Exp_Dist is
- procedure Add_RAST_Features (Vis_Decl : in Node_Id);
+ procedure Add_RAST_Features (Vis_Decl : Node_Id);
-- Build and add bodies for dereference and 'Access subprograms for a
-- remote access to subprogram type. Vis_Decl is the declaration node for
-- the RAS type.
- procedure Add_RACW_Features (RACW_Type : in Entity_Id);
+ procedure Add_RACW_Features (RACW_Type : Entity_Id);
-- Add RACW features. If the RACW and the designated type are not in the
-- same scope, then Add_RACW_Primitive_Declarations_And_Bodies is called
-- automatically since we do know the primitive list already.
procedure Add_RACW_Primitive_Declarations_And_Bodies
- (Designated_Type : in Entity_Id;
- Insertion_Node : in Node_Id;
- Decls : in List_Id);
+ (Designated_Type : Entity_Id;
+ Insertion_Node : Node_Id;
+ Decls : List_Id);
-- Add primitive for the stub type, and the RPC receiver. The declarations
-- are inserted after insertion_Node, while the bodies are appened at the
-- end of Decls.
procedure Remote_Types_Tagged_Full_View_Encountered
- (Full_View : in Entity_Id);
+ (Full_View : Entity_Id);
-- When a full view with a private view is encountered in a Remote_Types
-- package and corresponds to a tagged type, then this procedure is called
-- to generate the needed RACW features if it is needed.
- procedure RACW_Type_Is_Asynchronous (RACW_Type : in Entity_Id);
+ procedure RACW_Type_Is_Asynchronous (RACW_Type : Entity_Id);
-- This subprogram must be called when it is detected that the RACW type
-- is asynchronous.
- procedure Expand_Calling_Stubs_Bodies (Unit_Node : in Node_Id);
+ procedure Expand_Calling_Stubs_Bodies (Unit_Node : Node_Id);
-- Call the expansion phase for the calling stubs. The code will be added
-- at the end of the compilation unit, which is a package spec.
- procedure Expand_Receiving_Stubs_Bodies (Unit_Node : in Node_Id);
+ procedure Expand_Receiving_Stubs_Bodies (Unit_Node : Node_Id);
-- Call the expansion phase for the calling stubs. The code will be added
-- at the end of the compilation unit, which may be either a package spec
-- or a package body.
- procedure Expand_All_Calls_Remote_Subprogram_Call (N : in Node_Id);
+ procedure Expand_All_Calls_Remote_Subprogram_Call (N : Node_Id);
-- Rewrite a call to a subprogram located in a Remote_Call_Interface
-- package on which the pragma All_Calls_Remote applies so that it
-- goes through the PCS. N is either an N_Procedure_Call_Statement
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, 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- --
-- to the assignment statement) or Is_Out_Actual (where it points to
-- the procedure call statement).
- procedure Build_Full_Name
- (E : in Entity_Id;
- N : out String_Id);
+ procedure Build_Full_Name (E : Entity_Id; N : out String_Id);
-- Build the fully qualified string name of a shared variable
function On_Lhs_Of_Assignment (N : Node_Id) return Boolean;
-- Build_Full_Name --
---------------------
- procedure Build_Full_Name
- (E : in Entity_Id;
- N : out String_Id)
- is
+ procedure Build_Full_Name (E : Entity_Id; N : out String_Id) is
procedure Build_Name (E : Entity_Id);
- -- This is a recursive routine used to construct the fully
- -- qualified string name of the package corresponding to the
- -- shared variable.
+ -- This is a recursive routine used to construct the fully qualified
+ -- string name of the package corresponding to the shared variable.
+
+ ----------------
+ -- Build_Name --
+ ----------------
procedure Build_Name (E : Entity_Id) is
begin
Store_String_Chars (Name_Buffer (1 .. Name_Len));
end Build_Name;
+ -- Start of processing for Build_Full_Name
+
begin
Start_String;
Build_Name (E);
while First < SP'Last
and then (SP (First) = CR
- or else SP (First) = LF
- or else SP (First) = EOF)
+ or else SP (First) = LF
+ or else SP (First) = EOF)
loop
First := First + 1;
end loop;
-- --
-- B o d y --
-- --
--- Copyright (C) 2003-2005, AdaCore --
+-- Copyright (C) 2003-2006, AdaCore --
-- --
-- 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- --
-- Insert --
------------
- entry Insert (Item : in Element) when Count /= Capacity is
+ entry Insert (Item : Element) when Count /= Capacity is
begin
Values (Next_In) := Item;
Next_In := (Next_In mod Capacity) + 1;
-- --
-- S p e c --
-- --
--- Copyright (C) 2003-2005, AdaCore --
+-- Copyright (C) 2003-2006, AdaCore --
-- --
-- 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- --
is
pragma Priority (Ceiling);
- entry Insert (Item : in Element);
+ entry Insert (Item : Element);
-- Insert Item into the buffer, blocks caller until space is available
entry Remove (Item : out Element);
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2005, AdaCore --
+-- Copyright (C) 2000-2006, AdaCore --
-- --
-- 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- --
type Format is abstract tagged null record;
- function Output (Mode : in Format'Class) return String;
+ function Output (Mode : Format'Class) return String;
function Variable
(Mode : Format;
Name : String;
Value : String) return String;
- function New_Line (IO : in Format) return String;
+ function New_Line (IO : Format) return String;
- function Title (IO : in Format; Str : in String) return String;
+ function Title (IO : Format; Str : String) return String;
- function Header (IO : in Format; Str : in String) return String;
+ function Header (IO : Format; Str : String) return String;
end HTML_IO;
Name : String;
Value : String) return String;
- function New_Line (IO : in Format) return String;
+ function New_Line (IO : Format) return String;
- function Title (IO : in Format; Str : in String) return String;
+ function Title (IO : Format; Str : String) return String;
- function Header (IO : in Format; Str : in String) return String;
+ function Header (IO : Format; Str : String) return String;
end Text_IO;
-- Output --
------------
- function Output (Mode : in Format'Class) return String is
+ function Output (Mode : Format'Class) return String is
Result : Unbounded_String;
begin
NL : constant String := (1 => ASCII.LF);
- function Bold (S : in String) return String;
+ function Bold (S : String) return String;
-- Returns S as an HTML bold string
- function Italic (S : in String) return String;
+ function Italic (S : String) return String;
-- Returns S as an HTML italic string
----------
-- Bold --
----------
- function Bold (S : in String) return String is
+ function Bold (S : String) return String is
begin
return "<b>" & S & "</b>";
end Bold;
-- Header --
------------
- function Header (IO : in Format; Str : in String) return String is
+ function Header (IO : Format; Str : String) return String is
pragma Unreferenced (IO);
begin
return "<h2>" & Str & "</h2>" & NL;
-- Italic --
------------
- function Italic (S : in String) return String is
+ function Italic (S : String) return String is
begin
return "<i>" & S & "</i>";
end Italic;
-- New_Line --
--------------
- function New_Line (IO : in Format) return String is
+ function New_Line (IO : Format) return String is
pragma Unreferenced (IO);
begin
return "<br>" & NL;
-- Title --
-----------
- function Title (IO : in Format; Str : in String) return String is
+ function Title (IO : Format; Str : String) return String is
pragma Unreferenced (IO);
begin
return "<p align=center><font size=+2>" & Str & "</font></p>" & NL;
-- Header --
------------
- function Header (IO : in Format; Str : in String) return String is
+ function Header (IO : Format; Str : String) return String is
begin
return "*** " & Str & New_Line (IO);
end Header;
-- New_Line --
--------------
- function New_Line (IO : in Format) return String is
+ function New_Line (IO : Format) return String is
pragma Unreferenced (IO);
begin
return String'(1 => ASCII.LF);
-- Title --
-----------
- function Title (IO : in Format; Str : in String) return String is
+ function Title (IO : Format; Str : String) return String is
Spaces : constant Natural := (80 - Str'Length) / 2;
Indent : constant String (1 .. Spaces) := (others => ' ');
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, AdaCore --
+-- Copyright (C) 2000-2006, AdaCore --
-- --
-- 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- --
-- previously allocated larger table). Init must be called before using
-- the table. Init is convenient in reestablishing a table for new use.
- function Last (T : in Instance) return Table_Index_Type;
+ function Last (T : Instance) return Table_Index_Type;
pragma Inline (Last);
-- Returns the current value of the last used entry in the table,
-- which can then be used as a subscript for Table. Note that the
for J in Args'Range loop
Arg := new String (1 .. Args (J)'Length + 1);
- Arg (1 .. Args (J)'Length) := Args (J).all;
- Arg (Arg'Last) := ASCII.NUL;
- Arg_List (J + 2 - Args'First) := Arg.all'Access;
+ Arg (1 .. Args (J)'Length) := Args (J).all;
+ Arg (Arg'Last) := ASCII.NUL;
+ Arg_List (J + 2 - Args'First) := Arg.all'Access;
end loop;
Arg_List (Arg_List'Last) := null;
Pipe1 : in out Pipe_Type;
Pipe2 : in out Pipe_Type;
Pipe3 : in out Pipe_Type;
- Cmd : in String;
- Args : in System.Address)
+ Cmd : String;
+ Args : System.Address)
is
pragma Warnings (Off, Pid);
-- --
-- B o d y --
-- --
--- Copyright (C) 1995-2005, AdaCore --
+-- Copyright (C) 1995-2006, AdaCore --
-- --
-- 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- --
Put (Current_Out, C);
end Put;
- procedure Put (File : in File_Type; C : Character) is
+ procedure Put (File : File_Type; C : Character) is
procedure Put_Char (C : Character);
pragma Import (C, Put_Char, "put_char");
-- Set_Output --
----------------
- procedure Set_Output (File : in File_Type) is
+ procedure Set_Output (File : File_Type) is
begin
Current_Out := File;
end Set_Output;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2005, AdaCore --
+-- Copyright (C) 2002-2006, AdaCore --
-- --
-- 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 Build_Identical_Keys_Sets
(Table : in out Vertex_Table_Type;
Last : in out Natural;
- Pos : in Natural);
+ Pos : Natural);
-- Build a list of keys subsets that are identical with the current
-- position selection plus Pos. Once this routine is called, reduced
-- words are sorted by subsets and each item (First, Last) in Sets
procedure Build_Identical_Keys_Sets
(Table : in out Vertex_Table_Type;
Last : in out Natural;
- Pos : in Natural)
+ Pos : Natural)
is
S : constant Vertex_Table_Type := Table (1 .. Last);
C : constant Natural := Pos;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, AdaCore --
+-- Copyright (C) 1998-2006, AdaCore --
-- --
-- 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- --
-- Copy --
----------
- procedure Copy (From : in Table; To : in out Table) is
+ procedure Copy (From : Table; To : in out Table) is
Elmt : Hash_Element_Ptr;
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 1997-2005, AdaCore --
+-- Copyright (C) 1997-2006, AdaCore --
-- --
-- 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- --
-- Clears all the elements of the given table, freeing associated
-- storage. On return T is an empty table with no elements.
- procedure Copy (From : in Table; To : in out Table);
+ procedure Copy (From : Table; To : in out Table);
-- First all the elements of table To are cleared (as described for
-- the Clear procedure above), then all the elements of table From
-- are copied into To. In the case where the tables From and To have
-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2006, 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- --
-- Check --
-----------
- procedure Check (Filename : in String) is
+ procedure Check (Filename : String) is
begin
if not Is_Regular_File (Filename) then
Raise_Exception
procedure Parse_Command_Line is
- procedure Add_File (Filename : in String);
+ procedure Add_File (Filename : String);
-- Add one file to the list of file to handle
- procedure Add_Files_From_List (List_Filename : in String);
+ procedure Add_Files_From_List (List_Filename : String);
-- Add the files listed in List_Filename (one by line) to the list
-- of file to handle
-- Add_File --
--------------
- procedure Add_File (Filename : in String) is
+ procedure Add_File (Filename : String) is
begin
if Is_Ali (Filename) then
Check (Filename);
-- Add_Files_From_List --
-------------------------
- procedure Add_Files_From_List (List_Filename : in String) is
+ procedure Add_Files_From_List (List_Filename : String) is
File : File_Type;
Buffer : String (1 .. 500);
Last : Natural;
type char_array is array (size_t range <>) of aliased char;
for char_array'Component_Size use CHAR_BIT;
- function Is_Nul_Terminated (Item : in char_array) return Boolean;
+ function Is_Nul_Terminated (Item : char_array) return Boolean;
function To_C
(Item : String;
-- indicating procedures and functions. If the operation is abstract,
-- these letters are replaced in the xref by 'x' and 'y' respectively.
- Xref_Entity_Letters : array (Entity_Kind) of Character := (
- E_Void => ' ',
- E_Variable => '*',
- E_Component => '*',
- E_Constant => '*',
- E_Discriminant => '*',
-
- E_Loop_Parameter => '*',
- E_In_Parameter => '*',
- E_Out_Parameter => '*',
- E_In_Out_Parameter => '*',
- E_Generic_In_Out_Parameter => '*',
-
- E_Generic_In_Parameter => '*',
- E_Named_Integer => 'N',
- E_Named_Real => 'N',
- E_Enumeration_Type => 'E', -- B for boolean
- E_Enumeration_Subtype => 'E', -- B for boolean
-
- E_Signed_Integer_Type => 'I',
- E_Signed_Integer_Subtype => 'I',
- E_Modular_Integer_Type => 'M',
- E_Modular_Integer_Subtype => 'M',
- E_Ordinary_Fixed_Point_Type => 'O',
-
- E_Ordinary_Fixed_Point_Subtype => 'O',
- E_Decimal_Fixed_Point_Type => 'D',
- E_Decimal_Fixed_Point_Subtype => 'D',
- E_Floating_Point_Type => 'F',
- E_Floating_Point_Subtype => 'F',
-
- E_Access_Type => 'P',
- E_Access_Subtype => 'P',
- E_Access_Attribute_Type => 'P',
- E_Allocator_Type => ' ',
- E_General_Access_Type => 'P',
-
- E_Access_Subprogram_Type => 'P',
- E_Access_Protected_Subprogram_Type => 'P',
- E_Anonymous_Access_Subprogram_Type => ' ',
+ Xref_Entity_Letters : array (Entity_Kind) of Character :=
+ (E_Void => ' ',
+ E_Variable => '*',
+ E_Component => '*',
+ E_Constant => '*',
+ E_Discriminant => '*',
+
+ E_Loop_Parameter => '*',
+ E_In_Parameter => '*',
+ E_Out_Parameter => '*',
+ E_In_Out_Parameter => '*',
+ E_Generic_In_Out_Parameter => '*',
+
+ E_Generic_In_Parameter => '*',
+ E_Named_Integer => 'N',
+ E_Named_Real => 'N',
+ E_Enumeration_Type => 'E', -- B for boolean
+ E_Enumeration_Subtype => 'E', -- B for boolean
+
+ E_Signed_Integer_Type => 'I',
+ E_Signed_Integer_Subtype => 'I',
+ E_Modular_Integer_Type => 'M',
+ E_Modular_Integer_Subtype => 'M',
+ E_Ordinary_Fixed_Point_Type => 'O',
+
+ E_Ordinary_Fixed_Point_Subtype => 'O',
+ E_Decimal_Fixed_Point_Type => 'D',
+ E_Decimal_Fixed_Point_Subtype => 'D',
+ E_Floating_Point_Type => 'F',
+ E_Floating_Point_Subtype => 'F',
+
+ E_Access_Type => 'P',
+ E_Access_Subtype => 'P',
+ E_Access_Attribute_Type => 'P',
+ E_Allocator_Type => ' ',
+ E_General_Access_Type => 'P',
+
+ E_Access_Subprogram_Type => 'P',
+ E_Access_Protected_Subprogram_Type => 'P',
+ E_Anonymous_Access_Subprogram_Type => ' ',
E_Anonymous_Access_Protected_Subprogram_Type => ' ',
- E_Anonymous_Access_Type => ' ',
- E_Array_Type => 'A',
- E_Array_Subtype => 'A',
-
- E_String_Type => 'S',
- E_String_Subtype => 'S',
- E_String_Literal_Subtype => ' ',
- E_Class_Wide_Type => 'C',
-
- E_Class_Wide_Subtype => 'C',
- E_Record_Type => 'R',
- E_Record_Subtype => 'R',
- E_Record_Type_With_Private => 'R',
- E_Record_Subtype_With_Private => 'R',
-
- E_Private_Type => '+',
- E_Private_Subtype => '+',
- E_Limited_Private_Type => '+',
- E_Limited_Private_Subtype => '+',
- E_Incomplete_Type => '+',
-
- E_Task_Type => 'T',
- E_Task_Subtype => 'T',
- E_Protected_Type => 'W',
- E_Protected_Subtype => 'W',
- E_Exception_Type => ' ',
-
- E_Subprogram_Type => ' ',
- E_Enumeration_Literal => 'n',
- E_Function => 'V',
- E_Operator => 'V',
- E_Procedure => 'U',
-
- E_Entry => 'Y',
- E_Entry_Family => 'Y',
- E_Block => 'q',
- E_Entry_Index_Parameter => '*',
- E_Exception => 'X',
-
- E_Generic_Function => 'v',
- E_Generic_Package => 'k',
- E_Generic_Procedure => 'u',
- E_Label => 'L',
- E_Loop => 'l',
-
- E_Package => 'K',
+ E_Anonymous_Access_Type => ' ',
+
+ E_Array_Type => 'A',
+ E_Array_Subtype => 'A',
+ E_String_Type => 'S',
+ E_String_Subtype => 'S',
+ E_String_Literal_Subtype => ' ',
+
+ E_Class_Wide_Type => 'C',
+ E_Class_Wide_Subtype => 'C',
+ E_Record_Type => 'R',
+ E_Record_Subtype => 'R',
+ E_Record_Type_With_Private => 'R',
+
+ E_Record_Subtype_With_Private => 'R',
+ E_Private_Type => '+',
+ E_Private_Subtype => '+',
+ E_Limited_Private_Type => '+',
+ E_Limited_Private_Subtype => '+',
+
+ E_Incomplete_Type => '+',
+ E_Task_Type => 'T',
+ E_Task_Subtype => 'T',
+ E_Protected_Type => 'W',
+ E_Protected_Subtype => 'W',
+
+ E_Exception_Type => ' ',
+ E_Subprogram_Type => ' ',
+ E_Enumeration_Literal => 'n',
+ E_Function => 'V',
+ E_Operator => 'V',
+
+ E_Procedure => 'U',
+ E_Entry => 'Y',
+ E_Entry_Family => 'Y',
+ E_Block => 'q',
+ E_Entry_Index_Parameter => '*',
+
+ E_Exception => 'X',
+ E_Generic_Function => 'v',
+ E_Generic_Package => 'k',
+ E_Generic_Procedure => 'u',
+ E_Label => 'L',
+
+ E_Loop => 'l',
+ E_Package => 'K',
-- The following entities are not ones to which we gather
-- cross-references, since it does not make sense to do so
-- Indeed the occurrence of the body entity is considered to
-- be a reference to the spec entity.
- E_Package_Body => ' ',
- E_Protected_Object => ' ',
- E_Protected_Body => ' ',
- E_Task_Body => ' ',
- E_Subprogram_Body => ' ');
+ E_Package_Body => ' ',
+ E_Protected_Object => ' ',
+ E_Protected_Body => ' ',
+ E_Task_Body => ' ',
+ E_Subprogram_Body => ' ');
-- The following table is for information purposes. It shows the
-- use of each character appearing as an entity type.
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2006, 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 Compile
(Source_Id : Other_Source_Id;
- Data : in Project_Data;
+ Data : Project_Data;
Local_Errors : in out Boolean)
is
Source : Other_Source :=
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Get_Dll_Name --
------------------
- function Get_Dll_Name (Lib_Filename : in String) return String is
+ function Get_Dll_Name (Lib_Filename : String) return String is
begin
if MDLL.Fil.Get_Ext (Lib_Filename) = "" then
return Lib_Filename & ".dll";
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, AdaCore --
+-- Copyright (C) 2001-2006, AdaCore --
-- --
-- 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- --
return String
is
use Strings.Fixed;
+
J : constant Natural :=
Index (Source => Filename,
Pattern => ".",
-- Get_Ext --
-------------
- function Get_Ext (Filename : in String) return String is
+ function Get_Ext (Filename : String) return String is
use Strings.Fixed;
J : constant Natural :=
function Is_Archive (Filename : String) return Boolean is
Ext : constant String := Get_Ext (Filename);
-
begin
return Target.Is_Archive_Ext (Ext);
end Is_Archive;
-- Is_C --
----------
- function Is_C (Filename : in String) return Boolean is
+ function Is_C (Filename : String) return Boolean is
Ext : constant String := Get_Ext (Filename);
-
begin
return Target.Is_C_Ext (Ext);
end Is_C;
-- Is_Obj --
------------
- function Is_Obj (Filename : in String) return Boolean is
+ function Is_Obj (Filename : String) return Boolean is
Ext : constant String := Get_Ext (Filename);
-
begin
return Target.Is_Object_Ext (Ext);
end Is_Obj;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2005, AdaCore --
+-- Copyright (C) 2002-2006, AdaCore --
-- --
-- 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- --
Full_Output_File : constant String :=
Ext_To (Output_File, Archive_Ext);
- Arguments : OS_Lib.Argument_List_Access;
-
- Success : Boolean;
-
+ Arguments : OS_Lib.Argument_List_Access;
+ Success : Boolean;
Line_Length : Natural := 0;
begin
-- Delete_File --
-----------------
- procedure Delete_File (Filename : in String) is
- File : constant String := Filename & ASCII.Nul;
+ procedure Delete_File (Filename : String) is
+ File : constant String := Filename & ASCII.Nul;
Success : Boolean;
begin
Lib_Opt : constant OS_Lib.String_Access :=
new String'(Dynamic_Option);
- Driver : String_Access;
+ Driver : String_Access;
+
begin
Utl.Initialize;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2005, AdaCore --
+-- Copyright (C) 2001-2006, AdaCore --
-- --
-- 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- --
package MLib.Utl is
- procedure Delete_File (Filename : in String);
+ procedure Delete_File (Filename : String);
-- Delete the file Filename
-- Why is this different from the standard OS_Lib routine???
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Is_Readonly_Library --
-------------------------
- function Is_Readonly_Library (File : in File_Name_Type) return Boolean is
+ function Is_Readonly_Library (File : File_Name_Type) return Boolean is
begin
Get_Name_String (File);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- If current unit is a child unit spec, load its parent. If the child unit
-- is loaded through a limited with, the parent must be as well.
- elsif Nkind (Unit (Curunit)) = N_Package_Declaration
+ elsif Nkind (Unit (Curunit)) = N_Package_Declaration
or else Nkind (Unit (Curunit)) = N_Subprogram_Declaration
or else Nkind (Unit (Curunit)) in N_Generic_Declaration
or else Nkind (Unit (Curunit)) in N_Generic_Instantiation
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, 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- --
-- Call Setenv, after calling To_Host_File_Spec
function Ultimate_Extension_Of
- (Project : in Project_Id; In_Tree : Project_Tree_Ref) return Project_Id;
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return Project_Id;
-- Return a project that is either Project or an extended ancestor of
-- Project that itself is not extended.
---------------------------
function Ultimate_Extension_Of
- (Project : Project_Id; In_Tree : Project_Tree_Ref) return Project_Id
+ (Project : Project_Id;
+ In_Tree : Project_Tree_Ref) return Project_Id
is
Result : Project_Id := Project;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, 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- --
-- Restore --
-------------
- procedure Restore (S : in Comment_State) is
+ procedure Restore (S : Comment_State) is
begin
End_Of_Line_Node := S.End_Of_Line_Node;
Previous_Line_Node := S.Previous_Line_Node;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, 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- --
-- Save in variable S the comment state. Called before scanning a new
-- project file.
- procedure Restore (S : in Comment_State);
+ procedure Restore (S : Comment_State);
-- Restore the comment state to a previously saved value. Called after
-- scanning a project file.
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2006, 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- --
-- Open --
----------
- procedure Open (File : out Text_File; Name : in String) is
+ procedure Open (File : out Text_File; Name : String) is
FD : File_Descriptor;
File_Name : String (1 .. Name'Length + 1);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
pragma Inline (Hi);
-- High order half of 64-bit value
- procedure Sub3 (X1, X2, X3 : in out Uns32; Y1, Y2, Y3 : in Uns32);
+ procedure Sub3 (X1, X2, X3 : in out Uns32; Y1, Y2, Y3 : Uns32);
-- Computes X1&X2&X3 := X1&X2&X3 - Y1&Y1&Y3 with mod 2**96 wrap
function To_Neg_Int (A : Uns64) return Int64;
D (3) := Lo (T2) or Hi (T3);
D (4) := Lo (T3);
- -- Loop to compute quotient digits, runs twice for Qd(1) and Qd(2).
+ -- Loop to compute quotient digits, runs twice for Qd(1) and Qd(2)
for J in 0 .. 1 loop
-- Sub3 --
----------
- procedure Sub3 (X1, X2, X3 : in out Uns32; Y1, Y2, Y3 : in Uns32) is
+ procedure Sub3 (X1, X2, X3 : in out Uns32; Y1, Y2, Y3 : Uns32) is
begin
if Y3 > X3 then
if X2 = 0 then
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, 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- --
function Create_AST_Handler
(Taskid : Ada.Task_Identification.Task_Id;
- Entryno : Natural)
- return System.Aux_DEC.AST_Handler;
+ Entryno : Natural) return System.Aux_DEC.AST_Handler;
-- This function implements the appropriate semantics for a use of the
-- AST_Entry pragma. See body for details of implementation approach.
-- The parameters are the Task_Id for the task containing the entry
-- and the entry Index for the specified entry.
procedure Expand_AST_Packet_Pool
- (Requested_Packets : in Natural;
+ (Requested_Packets : Natural;
Actual_Number : out Natural;
Total_Number : out Natural);
-- This function takes a request for zero or more extra AST packets and
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Clear_Interlocked
(Bit : in out Boolean;
Old_Value : out Boolean;
- Retry_Count : in Natural;
+ Retry_Count : Natural;
Success_Flag : out Boolean)
is
pragma Warnings (Off, Retry_Count);
procedure Set_Interlocked
(Bit : in out Boolean;
Old_Value : out Boolean;
- Retry_Count : in Natural;
+ Retry_Count : Natural;
Success_Flag : out Boolean)
is
pragma Warnings (Off, Retry_Count);
---------------------
procedure Add_Interlocked
- (Addend : in Short_Integer;
- Augend : in out Aligned_Word;
- Sign : out Integer)
+ (Addend : Short_Integer;
+ Augend : in out Aligned_Word;
+ Sign : out Integer)
is
begin
SSL.Lock_Task.all;
----------------
procedure Add_Atomic
- (To : in out Aligned_Integer;
- Amount : in Integer)
+ (To : in out Aligned_Integer;
+ Amount : Integer)
is
begin
SSL.Lock_Task.all;
procedure Add_Atomic
(To : in out Aligned_Integer;
- Amount : in Integer;
- Retry_Count : in Natural;
+ Amount : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean)
is
end Add_Atomic;
procedure Add_Atomic
- (To : in out Aligned_Long_Integer;
- Amount : in Long_Integer)
+ (To : in out Aligned_Long_Integer;
+ Amount : Long_Integer)
is
begin
SSL.Lock_Task.all;
procedure Add_Atomic
(To : in out Aligned_Long_Integer;
- Amount : in Long_Integer;
- Retry_Count : in Natural;
+ Amount : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean)
is
function From_LU is new Unchecked_Conversion (LU, Long_Integer);
procedure And_Atomic
- (To : in out Aligned_Integer;
- From : in Integer)
+ (To : in out Aligned_Integer;
+ From : Integer)
is
begin
SSL.Lock_Task.all;
procedure And_Atomic
(To : in out Aligned_Integer;
- From : in Integer;
- Retry_Count : in Natural;
+ From : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean)
is
end And_Atomic;
procedure And_Atomic
- (To : in out Aligned_Long_Integer;
- From : in Long_Integer)
+ (To : in out Aligned_Long_Integer;
+ From : Long_Integer)
is
begin
SSL.Lock_Task.all;
procedure And_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer;
- Retry_Count : in Natural;
+ From : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean)
is
---------------
procedure Or_Atomic
- (To : in out Aligned_Integer;
- From : in Integer)
+ (To : in out Aligned_Integer;
+ From : Integer)
is
begin
SSL.Lock_Task.all;
procedure Or_Atomic
(To : in out Aligned_Integer;
- From : in Integer;
- Retry_Count : in Natural;
+ From : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean)
is
end Or_Atomic;
procedure Or_Atomic
- (To : in out Aligned_Long_Integer;
- From : in Long_Integer)
+ (To : in out Aligned_Long_Integer;
+ From : Long_Integer)
is
begin
SSL.Lock_Task.all;
procedure Or_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer;
- Retry_Count : in Natural;
+ From : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean)
is
------------
procedure Insqhi
- (Item : in Address;
- Header : in Address;
+ (Item : Address;
+ Header : Address;
Status : out Insq_Status)
is
Hedr : constant QR_Ptr := To_QR_Ptr (Header);
------------
procedure Remqhi
- (Header : in Address;
+ (Header : Address;
Item : out Address;
Status : out Remq_Status)
is
------------
procedure Insqti
- (Item : in Address;
- Header : in Address;
+ (Item : Address;
+ Header : Address;
Status : out Insq_Status)
is
Hedr : constant QR_Ptr := To_QR_Ptr (Header);
------------
procedure Remqti
- (Header : in Address;
+ (Header : Address;
Item : out Address;
Status : out Remq_Status)
is
-- --
-- S p e c --
-- --
--- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1996-2006, 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- --
type Unsigned_Quadword_Array is
array (Integer range <>) of Unsigned_Quadword;
- function To_Address (X : Integer) return Address;
+ function To_Address (X : Integer) return Address;
pragma Pure_Function (To_Address);
function To_Address_Long (X : Unsigned_Longword) return Address;
pragma Pure_Function (To_Address_Long);
- function To_Integer (X : Address) return Integer;
+ function To_Integer (X : Address) return Integer;
function To_Unsigned_Longword (X : Address) return Unsigned_Longword;
function To_Unsigned_Longword (X : AST_Handler) return Unsigned_Longword;
procedure Clear_Interlocked
(Bit : in out Boolean;
Old_Value : out Boolean;
- Retry_Count : in Natural;
+ Retry_Count : Natural;
Success_Flag : out Boolean);
procedure Set_Interlocked
(Bit : in out Boolean;
Old_Value : out Boolean;
- Retry_Count : in Natural;
+ Retry_Count : Natural;
Success_Flag : out Boolean);
procedure Add_Interlocked
- (Addend : in Short_Integer;
+ (Addend : Short_Integer;
Augend : in out Aligned_Word;
Sign : out Integer);
procedure Add_Atomic
(To : in out Aligned_Integer;
- Amount : in Integer);
+ Amount : Integer);
procedure Add_Atomic
(To : in out Aligned_Integer;
- Amount : in Integer;
- Retry_Count : in Natural;
+ Amount : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean);
procedure Add_Atomic
(To : in out Aligned_Long_Integer;
- Amount : in Long_Integer);
+ Amount : Long_Integer);
procedure Add_Atomic
(To : in out Aligned_Long_Integer;
- Amount : in Long_Integer;
- Retry_Count : in Natural;
+ Amount : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean);
procedure And_Atomic
(To : in out Aligned_Integer;
- From : in Integer);
+ From : Integer);
procedure And_Atomic
(To : in out Aligned_Integer;
- From : in Integer;
- Retry_Count : in Natural;
+ From : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean);
procedure And_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer);
+ From : Long_Integer);
procedure And_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer;
- Retry_Count : in Natural;
+ From : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean);
procedure Or_Atomic
(To : in out Aligned_Integer;
- From : in Integer);
+ From : Integer);
procedure Or_Atomic
(To : in out Aligned_Integer;
- From : in Integer;
- Retry_Count : in Natural;
+ From : Integer;
+ Retry_Count : Natural;
Old_Value : out Integer;
Success_Flag : out Boolean);
procedure Or_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer);
+ From : Long_Integer);
procedure Or_Atomic
(To : in out Aligned_Long_Integer;
- From : in Long_Integer;
- Retry_Count : in Natural;
+ From : Long_Integer;
+ Retry_Count : Natural;
Old_Value : out Long_Integer;
Success_Flag : out Boolean);
OK_Empty => +2);
procedure Insqhi
- (Item : in Address;
- Header : in Address;
+ (Item : Address;
+ Header : Address;
Status : out Insq_Status);
procedure Remqhi
- (Header : in Address;
+ (Header : Address;
Item : out Address;
Status : out Remq_Status);
procedure Insqti
- (Item : in Address;
- Header : in Address;
+ (Item : Address;
+ Header : Address;
Status : out Insq_Status);
procedure Remqti
- (Header : in Address;
+ (Header : Address;
Item : out Address;
Status : out Remq_Status);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1996, 2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Dereference
(Pool : in out Checked_Pool;
- Storage_Address : in Address;
- Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
- Alignment : in System.Storage_Elements.Storage_Count)
+ Storage_Address : Address;
+ Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+ Alignment : System.Storage_Elements.Storage_Count)
is abstract;
-- Called implicitly each time a pointer to a checked pool is dereferenced
-- All parameters in the profile are compatible with the profile of
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- --
------------------------------------------------------------------------------
-with Ada.IO_Exceptions; use Ada.IO_Exceptions;
-with Interfaces.C_Streams; use Interfaces.C_Streams;
-with System; use System;
+with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+with System; use System;
with System.CRTL;
with System.File_IO;
with System.Soft_Links;
-- Local Subprograms --
-----------------------
- procedure Set_Position (File : in File_Type);
+ procedure Set_Position (File : File_Type);
-- Sets file position pointer according to value of current index
-------------------
procedure Create
(File : in out File_Type;
- Mode : in FCB.File_Mode := FCB.Inout_File;
- Name : in String := "";
- Form : in String := "")
+ Mode : FCB.File_Mode := FCB.Inout_File;
+ Name : String := "";
+ Form : String := "")
is
Dummy_File_Control_Block : Direct_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
-- End_Of_File --
-----------------
- function End_Of_File (File : in File_Type) return Boolean is
+ function End_Of_File (File : File_Type) return Boolean is
begin
FIO.Check_Read_Status (AP (File));
return Count (File.Index) > Size (File);
-- Index --
-----------
- function Index (File : in File_Type) return Positive_Count is
+ function Index (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return Count (File.Index);
procedure Open
(File : in out File_Type;
- Mode : in FCB.File_Mode;
- Name : in String;
- Form : in String := "")
+ Mode : FCB.File_Mode;
+ Name : String;
+ Form : String := "")
is
Dummy_File_Control_Block : Direct_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
----------
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : Address;
- Size : in Interfaces.C_Streams.size_t;
- From : in Positive_Count)
+ Size : Interfaces.C_Streams.size_t;
+ From : Positive_Count)
is
begin
Set_Index (File, From);
end Read;
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : Address;
- Size : in Interfaces.C_Streams.size_t)
+ Size : Interfaces.C_Streams.size_t)
is
begin
FIO.Check_Read_Status (AP (File));
-- Reset --
-----------
- procedure Reset (File : in out File_Type; Mode : in FCB.File_Mode) is
+ procedure Reset (File : in out File_Type; Mode : FCB.File_Mode) is
begin
FIO.Reset (AP (File), Mode);
File.Index := 1;
-- Set_Index --
---------------
- procedure Set_Index (File : in File_Type; To : in Positive_Count) is
+ procedure Set_Index (File : File_Type; To : Positive_Count) is
begin
FIO.Check_File_Open (AP (File));
File.Index := Count (To);
-- Set_Position --
------------------
- procedure Set_Position (File : in File_Type) is
+ procedure Set_Position (File : File_Type) is
begin
if fseek
(File.Stream, long (File.Bytes) *
-- Size --
----------
- function Size (File : in File_Type) return Count is
+ function Size (File : File_Type) return Count is
begin
FIO.Check_File_Open (AP (File));
File.Last_Op := Op_Other;
procedure Write
(File : File_Type;
Item : Address;
- Size : in Interfaces.C_Streams.size_t;
+ Size : Interfaces.C_Streams.size_t;
Zeroes : System.Storage_Elements.Storage_Array)
is
procedure Write
(File : in out Direct_AFCB;
- Item : in Ada.Streams.Stream_Element_Array)
+ Item : Ada.Streams.Stream_Element_Array)
is
begin
raise Program_Error;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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
(File : in out Direct_AFCB;
- Item : in Ada.Streams.Stream_Element_Array);
+ Item : Ada.Streams.Stream_Element_Array);
-- Required overriding of Write, not actually used for Direct_IO
type File_Type is access all Direct_AFCB;
procedure Create
(File : in out File_Type;
- Mode : in FCB.File_Mode := FCB.Inout_File;
- Name : in String := "";
- Form : in String := "");
+ Mode : FCB.File_Mode := FCB.Inout_File;
+ Name : String := "";
+ Form : String := "");
- function End_Of_File (File : in File_Type) return Boolean;
+ function End_Of_File (File : File_Type) return Boolean;
- function Index (File : in File_Type) return Positive_Count;
+ function Index (File : File_Type) return Positive_Count;
procedure Open
(File : in out File_Type;
- Mode : in FCB.File_Mode;
- Name : in String;
- Form : in String := "");
+ Mode : FCB.File_Mode;
+ Name : String;
+ Form : String := "");
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : System.Address;
- Size : in Interfaces.C_Streams.size_t;
- From : in Positive_Count);
+ Size : Interfaces.C_Streams.size_t;
+ From : Positive_Count);
procedure Read
- (File : in File_Type;
+ (File : File_Type;
Item : System.Address;
- Size : in Interfaces.C_Streams.size_t);
+ Size : Interfaces.C_Streams.size_t);
- procedure Reset (File : in out File_Type; Mode : in FCB.File_Mode);
+ procedure Reset (File : in out File_Type; Mode : FCB.File_Mode);
procedure Reset (File : in out File_Type);
- procedure Set_Index (File : in File_Type; To : in Positive_Count);
+ procedure Set_Index (File : File_Type; To : Positive_Count);
- function Size (File : in File_Type) return Count;
+ function Size (File : File_Type) return Count;
procedure Write
- (File : in File_Type;
+ (File : File_Type;
Item : System.Address;
- Size : in Interfaces.C_Streams.size_t;
+ Size : Interfaces.C_Streams.size_t;
Zeroes : System.Storage_Elements.Storage_Array);
-- Note: Zeroes is the buffer of zeroes used to fill out partial records
-- --
-- B o d y --
-- --
--- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2005, AdaCore --
+-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNARL 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- --
-- Shutdown --
--------------
- function Shutdown (M : in String) return Boolean is
+ function Shutdown (M : String) return Boolean is
begin
Write (2, Shutdown_Message'Address, Shutdown_Message'Length);
Write (2, M'Address, M'Length);
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2005, AdaCore --
+-- Copyright (C) 1995-2006, AdaCore --
-- --
-- GNARL 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- --
package System.Error_Reporting is
pragma Preelaborate;
- function Shutdown (M : in String) return Boolean;
- -- Perform emergency shutdown of the entire program.
- -- Msg is an error message to be printed to the console.
- -- This is to be used only for nonrecoverable errors.
+ function Shutdown (M : String) return Boolean;
+ -- Perform emergency shutdown of the entire program. Msg is an error
+ -- message to be printed to the console. This is to be used only for
+ -- nonrecoverable errors.
end System.Error_Reporting;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- a controlled type introduced for this purpose.
procedure Finalize (V : in out File_IO_Clean_Up_Type);
- -- This is the finalize operation that is used to do the cleanup.
+ -- This is the finalize operation that is used to do the cleanup
File_IO_Clean_Up_Object : File_IO_Clean_Up_Type;
pragma Warnings (Off, File_IO_Clean_Up_Object);
text_translation_required : Boolean;
pragma Import
(C, text_translation_required, "__gnat_text_translation_required");
- -- If true, add appropriate suffix to control string for Open.
+ -- If true, add appropriate suffix to control string for Open
-----------------------
-- Local Subprograms --
-- Form --
----------
- function Form (File : in AFCB_Ptr) return String is
+ function Form (File : AFCB_Ptr) return String is
begin
if File = null then
raise Status_Error;
-- Is_Open --
-------------
- function Is_Open (File : in AFCB_Ptr) return Boolean is
+ function Is_Open (File : AFCB_Ptr) return Boolean is
begin
return (File /= null);
end Is_Open;
-- Mode --
----------
- function Mode (File : in AFCB_Ptr) return File_Mode is
+ function Mode (File : AFCB_Ptr) return File_Mode is
begin
if File = null then
raise Status_Error;
-- Name --
----------
- function Name (File : in AFCB_Ptr) return String is
+ function Name (File : AFCB_Ptr) return String is
begin
if File = null then
raise Status_Error;
procedure Open
(File_Ptr : in out AFCB_Ptr;
- Dummy_FCB : in AFCB'Class;
+ Dummy_FCB : AFCB'Class;
Mode : File_Mode;
Name : String;
Form : String;
procedure Tmp_Name (Buffer : Address);
pragma Import (C, Tmp_Name, "__gnat_tmp_name");
- -- set buffer (a String address) with a temporary filename.
+ -- set buffer (a String address) with a temporary filename
Stream : FILEs := C_Stream;
-- Stream which we open in response to this request
Namestr (Name'Length + 1) := ASCII.NUL;
end if;
- -- Get full name in accordance with the advice of RM A.8.2(22).
+ -- Get full name in accordance with the advice of RM A.8.2(22)
full_name (Namestr'Address, Fullname'Address);
procedure Read_Buf
(File : AFCB_Ptr;
Buf : Address;
- Siz : in Interfaces.C_Streams.size_t;
+ Siz : Interfaces.C_Streams.size_t;
Count : out Interfaces.C_Streams.size_t)
is
begin
-- Reset --
-----------
- -- The reset which does not change the mode simply does a rewind.
+ -- The reset which does not change the mode simply does a rewind
procedure Reset (File : in out AFCB_Ptr) is
begin
-- not permitted except for regular files (since otherwise there
-- is no name for the freopen, and in any case it seems meaningless)
- procedure Reset (File : in out AFCB_Ptr; Mode : in File_Mode) is
+ procedure Reset (File : in out AFCB_Ptr; Mode : File_Mode) is
Fopstr : aliased Fopen_String;
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 Open
(File_Ptr : in out FCB.AFCB_Ptr;
- Dummy_FCB : in FCB.AFCB'Class;
+ Dummy_FCB : FCB.AFCB'Class;
Mode : FCB.File_Mode;
Name : String;
Form : String;
procedure Delete (File : in out FCB.AFCB_Ptr);
-- The indicated file is unlinked
- procedure Reset (File : in out FCB.AFCB_Ptr; Mode : in FCB.File_Mode);
- -- The file is reset, and the mode changed as indicated.
+ procedure Reset (File : in out FCB.AFCB_Ptr; Mode : FCB.File_Mode);
+ -- The file is reset, and the mode changed as indicated
procedure Reset (File : in out FCB.AFCB_Ptr);
-- The files is reset, and the mode is unchanged
- function Mode (File : in FCB.AFCB_Ptr) return FCB.File_Mode;
+ function Mode (File : FCB.AFCB_Ptr) return FCB.File_Mode;
-- Returns the mode as supplied by create, open or reset
- function Name (File : in FCB.AFCB_Ptr) return String;
+ function Name (File : FCB.AFCB_Ptr) return String;
-- Returns the file name as supplied by Open or Create. Raises Use_Error
-- if used with temporary files or standard files.
- function Form (File : in FCB.AFCB_Ptr) return String;
+ function Form (File : FCB.AFCB_Ptr) return String;
-- Returns the form as supplied by create, open or reset
-- The string is normalized to all lower case letters.
- function Is_Open (File : in FCB.AFCB_Ptr) return Boolean;
+ function Is_Open (File : FCB.AFCB_Ptr) return Boolean;
-- Determines if file is open or not
----------------------
procedure Read_Buf
(File : FCB.AFCB_Ptr;
Buf : Address;
- Siz : in Interfaces.C_Streams.size_t;
+ Siz : Interfaces.C_Streams.size_t;
Count : out Interfaces.C_Streams.size_t);
-- Reads Siz bytes from File.Stream into Buf. The caller has checked
-- that the file is open in read mode. Device Error is raised if an error
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
- Item : in Root_Controlled)
+ Item : Root_Controlled)
is
begin
null;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
- Item : in Root_Controlled);
+ Item : Root_Controlled);
procedure Read
(Stream : not null access Ada.Streams.Root_Stream_Type'Class;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2005, AdaCore --
+-- Copyright (C) 1999-2006, AdaCore --
-- --
-- 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 Create_Lock
(Lock : out Lock_Type;
- Name : in String)
+ Name : String)
is
L : Lock_Type;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2006, 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- --
-- Create_Lock --
-----------------
- procedure Create_Lock (Lock : out Lock_Type; Name : in String) is
+ procedure Create_Lock (Lock : out Lock_Type; Name : String) is
L : Lock_Type;
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2006, 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- --
package System.Global_Locks is
Lock_Error : exception;
- -- Exception raised if a request cannot be executed on a lock.
+ -- Exception raised if a request cannot be executed on a lock
type Lock_Type is private;
-- Such a lock is a global lock between partitions. This lock is
Null_Lock : constant Lock_Type;
-- This needs comments ???
- procedure Create_Lock (Lock : out Lock_Type; Name : in String);
+ procedure Create_Lock (Lock : out Lock_Type; Name : String);
-- Create or retrieve a global lock for the current partition using
-- its Name.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- Set_Output --
----------------
- procedure Set_Output (File : in File_Type) is
+ procedure Set_Output (File : File_Type) is
begin
Current_Out := File;
end Set_Output;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
function Standard_Error return File_Type;
function Standard_Output return File_Type;
- procedure Set_Output (File : in File_Type);
+ procedure Set_Output (File : File_Type);
private
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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 presence of a master partition to run a test which is otherwise not
-- distributed.
--- The GLADE distribution package includes a replacement for this file.
+-- The GLADE distribution package includes a replacement for this file
with Ada.Exceptions; use Ada.Exceptions;
procedure Write
(Stream : in out Params_Stream_Type;
- Item : in Ada.Streams.Stream_Element_Array)
+ Item : Ada.Streams.Stream_Element_Array)
is
begin
Raise_Exception (Program_Error'Identity, Msg);
------------
procedure Do_RPC
- (Partition : in Partition_ID;
+ (Partition : Partition_ID;
Params : access Params_Stream_Type;
Result : access Params_Stream_Type)
is
------------
procedure Do_APC
- (Partition : in Partition_ID;
+ (Partition : Partition_ID;
Params : access Params_Stream_Type)
is
begin
----------------------------
procedure Establish_RPC_Receiver
- (Partition : in Partition_ID;
- Receiver : in RPC_Receiver)
+ (Partition : Partition_ID;
+ Receiver : RPC_Receiver)
is
begin
null;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-1998 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Write
(Stream : in out Params_Stream_Type;
- Item : in Ada.Streams.Stream_Element_Array);
+ Item : Ada.Streams.Stream_Element_Array);
-- Synchronous call
procedure Do_RPC
- (Partition : in Partition_ID;
+ (Partition : Partition_ID;
Params : access Params_Stream_Type;
Result : access Params_Stream_Type);
-- Asynchronous call
procedure Do_APC
- (Partition : in Partition_ID;
+ (Partition : Partition_ID;
Params : access Params_Stream_Type);
- -- The handler for incoming RPCs.
+ -- The handler for incoming RPCs
type RPC_Receiver is
access procedure
Result : access Params_Stream_Type);
procedure Establish_RPC_Receiver (
- Partition : in Partition_ID;
- Receiver : in RPC_Receiver);
+ Partition : Partition_ID;
+ Receiver : RPC_Receiver);
private
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-------------------
function AFCB_Allocate
- (Control_Block : Sequential_AFCB)
- return FCB.AFCB_Ptr
+ (Control_Block : Sequential_AFCB) return FCB.AFCB_Ptr
is
pragma Warnings (Off, Control_Block);
procedure Create
(File : in out File_Type;
- Mode : in FCB.File_Mode := FCB.Out_File;
- Name : in String := "";
- Form : in String := "")
+ Mode : FCB.File_Mode := FCB.Out_File;
+ Name : String := "";
+ Form : String := "")
is
Dummy_File_Control_Block : Sequential_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
procedure Open
(File : in out File_Type;
- Mode : in FCB.File_Mode;
- Name : in String;
- Form : in String := "")
+ Mode : FCB.File_Mode;
+ Name : String;
+ Form : String := "")
is
Dummy_File_Control_Block : Sequential_AFCB;
pragma Warnings (Off, Dummy_File_Control_Block);
procedure Write
(File : in out Sequential_AFCB;
- Item : in Ada.Streams.Stream_Element_Array)
+ Item : Ada.Streams.Stream_Element_Array)
is
begin
raise Program_Error;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- No additional fields required for Sequential_IO
function AFCB_Allocate
- (Control_Block : Sequential_AFCB)
- return FCB.AFCB_Ptr;
+ (Control_Block : Sequential_AFCB) return FCB.AFCB_Ptr;
procedure AFCB_Close (File : access Sequential_AFCB);
procedure AFCB_Free (File : access Sequential_AFCB);
procedure Write
(File : in out Sequential_AFCB;
- Item : in Ada.Streams.Stream_Element_Array);
+ Item : Ada.Streams.Stream_Element_Array);
-- Required overriding of Write, not actually used for Sequential_IO
type File_Type is access all Sequential_AFCB;
procedure Create
(File : in out File_Type;
- Mode : in FCB.File_Mode := FCB.Out_File;
- Name : in String := "";
- Form : in String := "");
+ Mode : FCB.File_Mode := FCB.Out_File;
+ Name : String := "";
+ Form : String := "");
procedure Open
(File : in out File_Type;
- Mode : in FCB.File_Mode;
- Name : in String;
- Form : in String := "");
+ Mode : FCB.File_Mode;
+ Name : String;
+ Form : String := "");
end System.Sequential_IO;
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, 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- --
-- value. The storage is created by this call if it does not
-- already exist.
- procedure Shared_Var_Close (Var : in SIO.Stream_Access);
+ procedure Shared_Var_Close (Var : SIO.Stream_Access);
-- This routine signals the end of a read/assign operation. It can
-- be useful to embrace a read/write operation between a call to
-- open and a call to close which protect the whole operation.
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
procedure Allocate
(Pool : in out Root_Storage_Pool;
Storage_Address : out Address;
- Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
- Alignment : in System.Storage_Elements.Storage_Count)
+ Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+ Alignment : System.Storage_Elements.Storage_Count)
is abstract;
procedure Deallocate
(Pool : in out Root_Storage_Pool;
- Storage_Address : in Address;
- Size_In_Storage_Elements : in System.Storage_Elements.Storage_Count;
- Alignment : in System.Storage_Elements.Storage_Count)
+ Storage_Address : Address;
+ Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
+ Alignment : System.Storage_Elements.Storage_Count)
is abstract;
function Storage_Size
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- W_AD --
----------
- procedure W_AD (Stream : not null access RST; Item : in Fat_Pointer) is
+ procedure W_AD (Stream : not null access RST; Item : Fat_Pointer) is
T : constant S_AD := From_AD (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_AD;
-- W_AS --
----------
- procedure W_AS (Stream : not null access RST; Item : in Thin_Pointer) is
+ procedure W_AS (Stream : not null access RST; Item : Thin_Pointer) is
T : constant S_AS := From_AS (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_AS;
-- W_B --
---------
- procedure W_B (Stream : not null access RST; Item : in Boolean) is
+ procedure W_B (Stream : not null access RST; Item : Boolean) is
T : S_B;
-
begin
T (1) := Boolean'Pos (Item);
Ada.Streams.Write (Stream.all, T);
-- W_C --
---------
- procedure W_C (Stream : not null access RST; Item : in Character) is
+ procedure W_C (Stream : not null access RST; Item : Character) is
T : S_C;
-
begin
T (1) := Character'Pos (Item);
Ada.Streams.Write (Stream.all, T);
-- W_F --
---------
- procedure W_F (Stream : not null access RST; Item : in Float) is
+ procedure W_F (Stream : not null access RST; Item : Float) is
T : constant S_F := From_F (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_F;
-- W_I --
---------
- procedure W_I (Stream : not null access RST; Item : in Integer) is
+ procedure W_I (Stream : not null access RST; Item : Integer) is
T : constant S_I := From_I (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_I;
-- W_LF --
----------
- procedure W_LF (Stream : not null access RST; Item : in Long_Float) is
+ procedure W_LF (Stream : not null access RST; Item : Long_Float) is
T : constant S_LF := From_LF (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_LF;
-- W_LI --
----------
- procedure W_LI (Stream : not null access RST; Item : in Long_Integer) is
+ procedure W_LI (Stream : not null access RST; Item : Long_Integer) is
T : constant S_LI := From_LI (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_LI;
-- W_LLF --
-----------
- procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float) is
+ procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float) is
T : constant S_LLF := From_LLF (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_LLF;
-----------
procedure W_LLI
- (Stream : not null access RST; Item : in Long_Long_Integer)
+ (Stream : not null access RST; Item : Long_Long_Integer)
is
T : constant S_LLI := From_LLI (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_LLI;
-----------
procedure W_LLU
- (Stream : not null access RST; Item : in UST.Long_Long_Unsigned)
+ (Stream : not null access RST; Item : UST.Long_Long_Unsigned)
is
T : constant S_LLU := From_LLU (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_LLU;
----------
procedure W_LU
- (Stream : not null access RST; Item : in UST.Long_Unsigned)
+ (Stream : not null access RST; Item : UST.Long_Unsigned)
is
T : constant S_LU := From_LU (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_LU;
-- W_SF --
----------
- procedure W_SF (Stream : not null access RST; Item : in Short_Float) is
+ procedure W_SF (Stream : not null access RST; Item : Short_Float) is
T : constant S_SF := From_SF (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_SF;
-- W_SI --
----------
- procedure W_SI (Stream : not null access RST; Item : in Short_Integer) is
+ procedure W_SI (Stream : not null access RST; Item : Short_Integer) is
T : constant S_SI := From_SI (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_SI;
-----------
procedure W_SSI
- (Stream : not null access RST; Item : in Short_Short_Integer)
+ (Stream : not null access RST; Item : Short_Short_Integer)
is
T : constant S_SSI := From_SSI (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_SSI;
-----------
procedure W_SSU
- (Stream : not null access RST; Item : in UST.Short_Short_Unsigned)
+ (Stream : not null access RST; Item : UST.Short_Short_Unsigned)
is
T : constant S_SSU := From_SSU (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_SSU;
----------
procedure W_SU
- (Stream : not null access RST; Item : in UST.Short_Unsigned)
+ (Stream : not null access RST; Item : UST.Short_Unsigned)
is
T : constant S_SU := From_SU (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_SU;
-- W_U --
---------
- procedure W_U (Stream : not null access RST; Item : in UST.Unsigned) is
+ procedure W_U (Stream : not null access RST; Item : UST.Unsigned) is
T : constant S_U := From_U (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_U;
-- W_WC --
----------
- procedure W_WC (Stream : not null access RST; Item : in Wide_Character) is
+ procedure W_WC (Stream : not null access RST; Item : Wide_Character) is
T : constant S_WC := From_WC (Item);
-
begin
Ada.Streams.Write (Stream.all, T);
end W_WC;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- between 'Write and 'Output because there are no discriminants
-- or bounds to be written.
- procedure W_AD (Stream : not null access RST; Item : in Fat_Pointer);
- procedure W_AS (Stream : not null access RST; Item : in Thin_Pointer);
- procedure W_B (Stream : not null access RST; Item : in Boolean);
- procedure W_C (Stream : not null access RST; Item : in Character);
- procedure W_F (Stream : not null access RST; Item : in Float);
- procedure W_I (Stream : not null access RST; Item : in Integer);
- procedure W_LF (Stream : not null access RST; Item : in Long_Float);
- procedure W_LI (Stream : not null access RST; Item : in Long_Integer);
- procedure W_LLF (Stream : not null access RST; Item : in Long_Long_Float);
- procedure W_LLI (Stream : not null access RST; Item : in Long_Long_Integer);
+ procedure W_AD (Stream : not null access RST; Item : Fat_Pointer);
+ procedure W_AS (Stream : not null access RST; Item : Thin_Pointer);
+ procedure W_B (Stream : not null access RST; Item : Boolean);
+ procedure W_C (Stream : not null access RST; Item : Character);
+ procedure W_F (Stream : not null access RST; Item : Float);
+ procedure W_I (Stream : not null access RST; Item : Integer);
+ procedure W_LF (Stream : not null access RST; Item : Long_Float);
+ procedure W_LI (Stream : not null access RST; Item : Long_Integer);
+ procedure W_LLF (Stream : not null access RST; Item : Long_Long_Float);
+ procedure W_LLI (Stream : not null access RST; Item : Long_Long_Integer);
procedure W_LLU (Stream : not null access RST;
- Item : in UST.Long_Long_Unsigned);
- procedure W_LU (Stream : not null access RST; Item : in UST.Long_Unsigned);
- procedure W_SF (Stream : not null access RST; Item : in Short_Float);
- procedure W_SI (Stream : not null access RST; Item : in Short_Integer);
+ Item : UST.Long_Long_Unsigned);
+ procedure W_LU (Stream : not null access RST; Item : UST.Long_Unsigned);
+ procedure W_SF (Stream : not null access RST; Item : Short_Float);
+ procedure W_SI (Stream : not null access RST; Item : Short_Integer);
procedure W_SSI (Stream : not null access RST;
- Item : in Short_Short_Integer);
+ Item : Short_Short_Integer);
procedure W_SSU (Stream : not null access RST;
- Item : in UST.Short_Short_Unsigned);
+ Item : UST.Short_Short_Unsigned);
procedure W_SU (Stream : not null access RST;
- Item : in UST.Short_Unsigned);
- procedure W_U (Stream : not null access RST; Item : in UST.Unsigned);
- procedure W_WC (Stream : not null access RST; Item : in Wide_Character);
+ Item : UST.Short_Unsigned);
+ procedure W_U (Stream : not null access RST; Item : UST.Unsigned);
+ procedure W_WC (Stream : not null access RST; Item : Wide_Character);
----------------------------
-- Composite Input/Output --
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
---------------------------
function Enqueue_Duration
- (T : in Duration;
- D : Delay_Block_Access)
- return Boolean
+ (T : Duration;
+ D : Delay_Block_Access) return Boolean
is
begin
if T <= 0.0 then
while Timer_Queue.Succ.Resume_Time <= Now loop
- -- Dequeue the waiting task from the front of the queue.
+ -- Dequeue the waiting task from the front of the queue
pragma Debug (System.Tasking.Debug.Trace
(Timer_Server_ID, "Timer service: waking up waiting task", 'E'));
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
type Delay_Block_Access is access all Delay_Block;
function Enqueue_Duration
- (T : in Duration;
+ (T : Duration;
D : Delay_Block_Access) return Boolean;
-- Enqueue the specified relative delay. Returns True if the delay has
-- been enqueued, False if it has already expired. If the delay has been
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
with System.Tasking.Initialization;
function System.Tasking.Async_Delays.Enqueue_RT
- (T : in Ada.Real_Time.Time;
+ (T : Ada.Real_Time.Time;
D : Delay_Block_Access) return Boolean
is
use type Ada.Real_Time.Time; -- for "=" operator
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
with System.Storage_Elements;
-- Needed for initializing Stack_Info.Size
-with System.Parameters;
--- Used for Adjust_Storage_Size
-
package body System.Tasking is
package STPO renames System.Task_Primitives.Operations;
(Parameters.Adjust_Storage_Size (Stack_Size));
end if;
- -- Link the task into the list of all tasks.
+ -- Link the task into the list of all tasks
T.Common.All_Tasks_Link := All_Tasks_List;
All_Tasks_List := T;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
use Protected_Objects;
use Protected_Objects.Entries;
- -- Entry Queues implemented as doubly linked list.
+ -- Entry Queues implemented as doubly linked list
Queuing_Policy : Character;
pragma Import (C, Queuing_Policy, "__gl_queuing_policy");
-- Return number of calls on the waiting queue of E
- function Count_Waiting (E : in Entry_Queue) return Natural is
+ function Count_Waiting (E : Entry_Queue) return Natural is
Count : Natural;
Temp : Entry_Call_Link;
-- Return the head of entry_queue E
- function Head (E : in Entry_Queue) return Entry_Call_Link is
+ function Head (E : Entry_Queue) return Entry_Call_Link is
begin
pragma Assert (Check_Queue (E));
return E.Head;
Broadcast_Program_Error (Self_ID, Object, null);
end;
- -- If a call was selected, dequeue it and return it for service.
+ -- If a call was selected, dequeue it and return it for service
if Entry_Call /= null then
Temp_Call := Entry_Call;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- GNARL 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 Dequeue (E : in out Entry_Queue; Call : Entry_Call_Link);
-- Dequeue Call from entry_queue E
- function Head (E : in Entry_Queue) return Entry_Call_Link;
- -- Return the head of entry_queue E
+ function Head (E : Entry_Queue) return Entry_Call_Link;
pragma Inline (Head);
+ -- Return the head of entry_queue E
procedure Dequeue_Head
(E : in out Entry_Queue;
-- Remove and return the head of entry_queue E
function Onqueue (Call : Entry_Call_Link) return Boolean;
- -- Return True if Call is on any entry_queue at all
pragma Inline (Onqueue);
+ -- Return True if Call is on any entry_queue at all
- function Count_Waiting (E : in Entry_Queue) return Natural;
+ function Count_Waiting (E : Entry_Queue) return Natural;
-- Return number of calls on the waiting queue of E
procedure Select_Task_Entry_Call
-- Open_Alternative will be True if there were any open alternatives
procedure Select_Protected_Entry_Call
- (Self_ID : Task_Id;
- Object : POE.Protection_Entries_Access;
- Call : out Entry_Call_Link);
+ (Self_ID : Task_Id;
+ Object : POE.Protection_Entries_Access;
+ Call : out Entry_Call_Link);
-- Select an entry of a protected object
procedure Enqueue_Call (Entry_Call : Entry_Call_Link);
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, 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- --
-- if the two characters are not a valid EUC encoding.
procedure JIS_To_EUC
- (J : in Wide_Character;
+ (J : Wide_Character;
EUC1 : out Character;
EUC2 : out Character);
-- the input code is assumed to be in an appropriate range.
procedure JIS_To_Shift_JIS
- (J : in Wide_Character;
+ (J : Wide_Character;
SJ1 : out Character;
SJ2 : out Character);
-- Given a wide character code in JIS form, produce the corresponding
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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 child package contains a procedure to load files.
+-- This child package contains a procedure to load files
-- It is used by Sinput.P to load project files, and by GPrep to load
-- preprocessor definition files and input files.
package Sinput.C is
function Load_File (Path : String) return Source_File_Index;
- -- Load a file into memory and Initialize the Scans state.
+ -- Load a file into memory and Initialize the Scans state
end Sinput.C;
-- S p e c --
-- (OpenVMS GCC_ZCX DEC Threads Version) --
-- --
--- Copyright (C) 2002-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- Special VMS Interfaces --
----------------------------
- procedure Lib_Stop (I : in Integer);
+ procedure Lib_Stop (I : Integer);
pragma Interface (C, Lib_Stop);
pragma Import_Procedure (Lib_Stop, "LIB$STOP", Mechanism => (Value));
-- Interface to VMS condition handling. Used by RTSfind and pragma
-- S p e c --
-- (OpenVMS DEC Threads Version) --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- Special VMS Interfaces --
----------------------------
- procedure Lib_Stop (I : in Integer);
+ procedure Lib_Stop (I : Integer);
pragma Interface (C, Lib_Stop);
pragma Import_Procedure (Lib_Stop, "LIB$STOP", Mechanism => (Value));
-- Interface to VMS condition handling. Used by RTSfind and pragma
-- S p e c --
-- (OpenVMS 64bit GCC_ZCX DEC Threads Version) --
-- --
--- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- Special VMS Interfaces --
----------------------------
- procedure Lib_Stop (I : in Integer);
+ procedure Lib_Stop (I : Integer);
pragma Interface (C, Lib_Stop);
pragma Import_Procedure (Lib_Stop, "LIB$STOP", Mechanism => (Value));
-- Interface to VMS condition handling. Used by RTSfind and pragma
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, 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- --
function Get_File
(File : File_Reference;
- With_Dir : in Boolean := False;
+ With_Dir : Boolean := False;
Strip : Natural := 0) return String
is
Tmp : GNAT.OS_Lib.String_Access;
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, 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 .ali files.
procedure Open
- (Name : in String;
+ (Name : String;
File : out ALI_File;
- Dependencies : in Boolean := False);
+ Dependencies : Boolean := False);
-- Open a new ALI file. If Dependencies is True, the insert every library
-- file 'with'ed in the files database (used for gnatxref)
-- Print_Unused --
------------------
- procedure Print_Unused (Full_Path_Name : in Boolean) is
+ procedure Print_Unused (Full_Path_Name : Boolean) is
Decls : constant Declaration_Array_Access := Get_Declarations;
Decl : Declaration_Reference;
Arr : Reference_Array_Access;
-- Print_Vi --
--------------
- procedure Print_Vi (Full_Path_Name : in Boolean) is
+ procedure Print_Vi (Full_Path_Name : Boolean) is
Tab : constant Character := ASCII.HT;
Decls : constant Declaration_Array_Access :=
Get_Declarations (Sorted => False);
-- Print_Xref --
----------------
- procedure Print_Xref (Full_Path_Name : in Boolean) is
+ procedure Print_Xref (Full_Path_Name : Boolean) is
Decls : constant Declaration_Array_Access := Get_Declarations;
Decl : Declaration_Reference;
procedure New_Line80;
-- Go to start of new line
- procedure Print80 (S : in String);
+ procedure Print80 (S : String);
-- Print the text, respecting the 80 columns rule
procedure Print_Ref (Line, Column : String);
-- Print80 --
-------------
- procedure Print80 (S : in String) is
+ procedure Print80 (S : String) is
Align : Natural := Margin - (Integer (Column) mod Margin);
begin
-- --
-- S p e c --
-- --
--- Copyright (C) 1998-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2006, 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 Print_Gnatfind
- (References : in Boolean;
- Full_Path_Name : in Boolean);
- procedure Print_Unused (Full_Path_Name : in Boolean);
- procedure Print_Vi (Full_Path_Name : in Boolean);
- procedure Print_Xref (Full_Path_Name : in Boolean);
+ (References : Boolean;
+ Full_Path_Name : Boolean);
+ procedure Print_Unused (Full_Path_Name : Boolean);
+ procedure Print_Vi (Full_Path_Name : Boolean);
+ procedure Print_Xref (Full_Path_Name : Boolean);
-- The actual print procedures. These functions step through the symbol
-- table and print all the symbols if they match the files given on the
-- command line (they already match the entities if they are in the
-- General Algorithms --
------------------------
- function Default_Project_File (Dir_Name : in String) return String;
+ function Default_Project_File (Dir_Name : String) return String;
-- Returns the default Project file name for the directory Dir_Name
procedure Search
projects / gcc.git / commitdiff